include <ctype.h>
include "calcnoise.h"

define	YYMAXDEPTH	64
define	YYOPLEN		1
define	yyparse		parsenoise

define	BLANK		' '

# Tokens generated by xyacc have been moved calcnoise.h

define	yyclearin	yychar = -1
define	yyerrok		yyerrflag = 0
define	YYMOVE		call amovi (Memi[$1], Memi[$2], YYOPLEN)
define	YYERRCODE	256

# line 222 "compnoise.y"


#* HISTORY *
#* B.Simon	30-Mar-95	original
#* B.Simon	30-May-95	added nread

# COMPNOISE -- Compile a noise expression into pseudocode

procedure compnoise (expr, exptime, nread, pcode, maxcode)

char	expr[ARB]	# i: noise expression
real	exptime		# i: exposure time
int	nread		# i: number of readouts
int	pcode[ARB]	# o: pseudocode instructions
int	maxcode		# i: length of instruction array
#--
include "compnoise.com"

int	len, debug
pointer	sp, code, line, ch

data	debug	/ NO /

int	strlen(), parsenoise()

extern	lexnoise

begin
	# Allocate memory for temporary arrays

	len = strlen (expr) 

	call smark (sp)
	call salloc (code, maxcode, TY_INT)
	call salloc (line, len, TY_CHAR)

	# Initialize parsing common block

	icode = code
	ncode = maxcode
	readout = nread
	time = exptime

	# Parse expression to produce pseudocode

	ch = line
	call strcpy (expr, Memc[line], len)

	if (parsenoise (ch, debug, lexnoise) == ERR) {
	    call eprintf ("%s\n%*t^\n")
	    call pargstr (Memc[line])
	    call pargi (ch-line)

	    call error (1, "Syntax error in noise expression")
	}

	# Clean up and return pseudocode array

	call amovi (Memi[code], pcode, maxcode)
	call sfree (sp)

end

# LEXNOISE -- Lexical analyzer for noise expression

int procedure lexnoise (ch, value)

pointer	ch		# u: Pointer to current char in expression
pointer	value		# i: Pointer to current token value
#--
include "compnoise.com"

char	token[SZ_TOKEN]
int	ic, nc, type, itype, functype[5], symtype[7]
real	const

string	funclist  "n,t,x,sqrt,log"
string	symlist   "()+-*/&"

data	functype  / N_READ, N_TIME, N_FLUX, N_SQRT, N_LOG /
data	symtype   / N_LPAR, N_RPAR, N_ADD, N_SUB, N_MUL, N_DIV, N_MAG /

int	ctor(), stridx(), word_match()

begin
	# Skip over leading white space 

	while (Memc[ch] <= BLANK) {
	    if (Memc[ch] == EOS)
		break

	    ch = ch + 1
	}

	# Determine token type from leading character

	if (Memc[ch] == '.' || IS_DIGIT(Memc[ch])) {
	    # Token is a number

	    ic = 1
	    nc = ctor (Memc[ch], ic, const)
	    nc = min (nc, SZ_TOKEN)
	    call strcpy (Memc[ch], token, nc)

	    type = N_NUM

	    call salloc (Memi[value], 1, TY_REAL)
	    Memr[Memi[value]] = const

	} else if (IS_ALPHA(Memc[ch])) {
	    # Token is a variable or function name

	    for (ic = 0; ic < SZ_TOKEN; ic = ic + 1) {
		if (! IS_ALNUM(Memc[ch+ic]))
		    break

		token[ic+1] = Memc[ch+ic]
	    }

	    token[ic+1] = EOS
	    nc = ic

	    # Determine token type by consulting list

	    call strlwr (token)
	    itype = word_match (token, funclist)

	    if (itype == 0) {
		type = N_WRONG
	    } else {
		type = functype[itype]
	    }

	    Memi[value] = NULL

	} else {
	    # Token is an operator
	    # Get symbol type from list

	    itype = stridx (Memc[ch], symlist)
	    if (itype == 0) {
		if (Memc[ch] == EOS) {
		    type = N_DONE
		} else {
		    type = N_WRONG
		}

	    } else {
		type = symtype[itype]
	    }

	    # Distinguish between multiplication and exponentiation

	    nc = 1
	    if (Memc[ch] == '*') {
		if (Memc[ch+1] == '*') {
		    type = N_EXP
		    nc = 2
		}
	    }

	    Memi[value] = NULL
	}

	ch = ch + nc
	return (type)
end

procedure add_const (const)

real	const		# i: real constant to be added to code
#--
include "compnoise.com"

char	token[SZ_TOKEN]
int	ic

begin
	call add_pcode (N_NUM)

	call sprintf (token, SZ_TOKEN, "%g")
	call pargr (const)

	ic = 0
	repeat {
	    if (ncode == 0) 
		call error (1, "Noise expression too complex")

	    ic = ic + 1
	    Memi[icode] = token[ic]

	    icode = icode + 1
	    ncode = ncode - 1
	} until (token[ic] == EOS)

end

procedure add_pcode (pcode)

int	pcode		# i:pseudocode instruction
#--
include "compnoise.com"

begin
	if (ncode == 0) 
	    call error (1, "Noise expression too complex")

	Memi[icode] = pcode
	icode = icode + 1
	ncode = ncode - 1

end

define	YYNPROD		19
define	YYLAST		82
# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.

# Parser for yacc output, translated to the IRAF SPP language.  The contents
# of this file form the bulk of the source of the parser produced by Yacc.
# Yacc recognizes several macros in the yaccpar input source and replaces
# them as follows:
#	A	user suppled "global" definitions and declarations
# 	B	parser tables
# 	C	user supplied actions (reductions)
# The remainder of the yaccpar code is not changed.

define	yystack_	10		# statement labels for gotos
define	yynewstate_	20
define	yydefault_	30
define	yyerrlab_	40
define	yyabort_	50

define	YYFLAG		(-1000)		# defs used in user actions
define	YYERROR		goto yyerrlab_
define	YYACCEPT	return (OK)
define	YYABORT		return (ERR)


# YYPARSE -- Parse the input stream, returning OK if the source is
# syntactically acceptable (i.e., if compilation is successful),
# otherwise ERR.  The parameters YYMAXDEPTH and YYOPLEN must be
# supplied by the caller in the %{ ... %} section of the Yacc source.
# The token value stack is a dynamically allocated array of operand
# structures, with the length and makeup of the operand structure being
# application dependent.

int procedure yyparse (fd, yydebug, yylex)

int	fd			# stream to be parsed
bool	yydebug			# print debugging information?
int	yylex()			# user-supplied lexical input function
extern	yylex()

short	yys[YYMAXDEPTH]		# parser stack -- stacks tokens
pointer	yyv			# pointer to token value stack
pointer	yyval			# value returned by action
pointer	yylval			# value of token
int	yyps			# token stack pointer
pointer	yypv			# value stack pointer
int	yychar			# current input token number
int	yyerrflag		# error recovery flag
int	yynerrs			# number of errors

short	yyj, yym		# internal variables
pointer	yysp, yypvt
short	yystate, yyn
int	yyxi, i
errchk	salloc, yylex


include "compnoise.com"

short	yyexca[6]
data	(yyexca(i),i=  1,  6)	/  -1,   1,   0,  -1,  -2,   0/
short	yyact[82]
data	(yyact(i),i=  1,  8)	/   4,  13,  12,  15,   7,   8,   2,  35/
data	(yyact(i),i=  9, 16)	/   5,   6,  10,  11,   1,  34,   9,  23/
data	(yyact(i),i= 17, 24)	/  20,  18,  19,  16,  17,  15,  20,  18/
data	(yyact(i),i= 25, 32)	/  19,  16,  17,  15,  33,  18,  19,  16/
data	(yyact(i),i= 33, 40)	/  17,  15,  16,  17,  15,  20,  18,  19/
data	(yyact(i),i= 41, 48)	/  16,  17,  15,  14,  22,   0,   0,   0/
data	(yyact(i),i= 49, 56)	/   0,  20,  18,  19,  16,  17,  15,  13/
data	(yyact(i),i= 57, 64)	/  12,   3,   7,   8,   0,   0,   5,   6/
data	(yyact(i),i= 65, 72)	/  10,  11,   0,  21,   9,   0,  24,   0/
data	(yyact(i),i= 73, 80)	/   0,  25,  26,  27,  28,  29,  30,   0/
data	(yyact(i),i= 81, 82)	/  31,  32/
short	yypact[36]
data	(yypact(i),i=  1,  8)	/-256,-1000,-1000,-219,-1000,-1000,-1000,-1000/
data	(yypact(i),i=  9, 16)	/-1000,-202,-214,-243,-202,-1000,-1000,-202/
data	(yypact(i),i= 17, 24)	/-202,-202,-202,-202,-202,-1000,-202,-202/
data	(yypact(i),i= 25, 32)	/-231,-270,-270,-270,-237,-237,-240,-246/
data	(yypact(i),i= 33, 36)	/-252,-1000,-1000,-1000/
short	yypgo[3]
data	(yypgo(i),i=  1,  3)	/   0,  12,  57/
short	yyr1[19]
data	(yyr1(i),i=  1,  8)	/   0,   1,   1,   1,   2,   2,   2,   2/
data	(yyr1(i),i=  9, 16)	/   2,   2,   2,   2,   2,   2,   2,   2/
data	(yyr1(i),i= 17, 19)	/   2,   2,   2/
short	yyr2[19]
data	(yyr2(i),i=  1,  8)	/   0,   1,   2,   1,   1,   1,   1,   1/
data	(yyr2(i),i=  9, 16)	/   2,   3,   3,   3,   3,   3,   3,   4/
data	(yyr2(i),i= 17, 19)	/   4,   3,   1/
short	yychk[36]
data	(yychk(i),i=  1,  8)	/-1000,  -1, 262,  -2, 256, 264, 265, 260/
data	(yychk(i),i=  9, 16)	/ 261, 270, 266, 267, 258, 257, 262, 273/
data	(yychk(i),i= 17, 24)	/ 271, 272, 269, 270, 268,  -2, 258, 258/
data	(yychk(i),i= 25, 32)	/  -2,  -2,  -2,  -2,  -2,  -2,  -2,  -2/
data	(yychk(i),i= 33, 36)	/  -2, 259, 259, 259/
short	yydef[36]
data	(yydef(i),i=  1,  8)	/   0,  -2,   1,   0,   3,   4,   5,   6/
data	(yydef(i),i=  9, 16)	/   7,   0,   0,   0,   0,  18,   2,   0/
data	(yydef(i),i= 17, 24)	/   0,   0,   0,   0,   0,   8,   0,   0/
data	(yydef(i),i= 25, 32)	/   0,   9,  10,  11,  12,  13,  14,   0/
data	(yydef(i),i= 33, 36)	/   0,  17,  15,  16/

begin
	call smark (yysp)
	call salloc (yyv, (YYMAXDEPTH+2) * YYOPLEN, TY_STRUCT)

	# Initialization.  The first element of the dynamically allocated
	# token value stack (yyv) is used for yyval, the second for yylval,
	# and the actual stack starts with the third element.

	yystate = 0
	yychar = -1
	yynerrs = 0
	yyerrflag = 0
	yyps = 0
	yyval = yyv
	yylval = yyv + YYOPLEN
	yypv = yylval

yystack_
	# SHIFT -- Put a state and value onto the stack.  The token and
	# value stacks are logically the same stack, implemented as two
	# separate arrays.

	if (yydebug) {
	    call printf ("state %d, char 0%o\n")
		call pargs (yystate)
		call pargi (yychar)
	}
	yyps = yyps + 1
	yypv = yypv + YYOPLEN
	if (yyps > YYMAXDEPTH) {
	    call sfree (yysp)
	    call eprintf ("yacc stack overflow\n")
	    return (ERR)
	}
	yys[yyps] = yystate
	YYMOVE (yyval, yypv)

yynewstate_
	# Process the new state.
	yyn = yypact[yystate+1]

	if (yyn <= YYFLAG)
	    goto yydefault_			# simple state

	# The variable "yychar" is the lookahead token.
	if (yychar < 0) {
	    yychar = yylex (fd, yylval)
	    if (yychar < 0)
		yychar = 0
	}
	yyn = yyn + yychar
	if (yyn < 0 || yyn >= YYLAST)
	    goto yydefault_

	yyn = yyact[yyn+1]
	if (yychk[yyn+1] == yychar) {		# valid shift
	    yychar = -1
	    YYMOVE (yylval, yyval)
	    yystate = yyn
	    if (yyerrflag > 0)
		yyerrflag = yyerrflag - 1
	    goto yystack_
	}

yydefault_
	# Default state action.

	yyn = yydef[yystate+1]
	if (yyn == -2) {
	    if (yychar < 0) {
		yychar = yylex (fd, yylval)
		if (yychar < 0)
		    yychar = 0
	    }

	    # Look through exception table.
	    yyxi = 1
	    while ((yyexca[yyxi] != (-1)) || (yyexca[yyxi+1] != yystate))
		yyxi = yyxi + 2
	    for (yyxi=yyxi+2;  yyexca[yyxi] >= 0;  yyxi=yyxi+2) {
		if (yyexca[yyxi] == yychar)
		    break
	    }

	    yyn = yyexca[yyxi+1]
	    if (yyn < 0) {
		call sfree (yysp)
		return (OK)			# ACCEPT -- all done
	    }
	}


	# SYNTAX ERROR -- resume parsing if possible.

	if (yyn == 0) {
	    switch (yyerrflag) {
	    case 0, 1, 2:
		if (yyerrflag == 0) {		# brand new error
		    call eprintf ("syntax error\n")
yyerrlab_
		    yynerrs = yynerrs + 1
		    # fall through...
		}

	    # case 1:
	    # case 2: incompletely recovered error ... try again
		yyerrflag = 3

		# Find a state where "error" is a legal shift action.
		while (yyps >= 1) {
		    yyn = yypact[yys[yyps]+1] + YYERRCODE
		    if ((yyn >= 0) && (yyn < YYLAST) &&
			(yychk[yyact[yyn+1]+1] == YYERRCODE)) {
			    # Simulate a shift of "error".
			    yystate = yyact[yyn+1]
			    goto yystack_
		    }
		    yyn = yypact[yys[yyps]+1]

		    # The current yyps has no shift on "error", pop stack.
		    if (yydebug) {
			call printf ("error recovery pops state %d, ")
			    call pargs (yys[yyps])
			call printf ("uncovers %d\n")
			    call pargs (yys[yyps-1])
		    }
		    yyps = yyps - 1
		    yypv = yypv - YYOPLEN
		}

		# ABORT -- There is no state on the stack with an error shift.
yyabort_
		call sfree (yysp)
		return (ERR)


	    case 3: # No shift yet; clobber input char.

		if (yydebug) {
		    call printf ("error recovery discards char %d\n")
			call pargi (yychar)
		}

		if (yychar == 0)
		    goto yyabort_		# don't discard EOF, quit
		yychar = -1
		goto yynewstate_		# try again in the same state
	    }
	}


	# REDUCE -- Reduction by production yyn.

	if (yydebug) {
	    call printf ("reduce %d\n")
		call pargs (yyn)
	}
	yyps  = yyps - yyr2[yyn+1]
	yypvt = yypv
	yypv  = yypv - yyr2[yyn+1] * YYOPLEN
	YYMOVE (yypv + YYOPLEN, yyval)
	yym   = yyn

	# Consult goto table to find next state.
	yyn = yyr1[yyn+1]
	yyj = yypgo[yyn+1] + yys[yyps] + 1
	if (yyj >= YYLAST)
	    yystate = yyact[yypgo[yyn+1]+1]
	else {
	    yystate = yyact[yyj+1]
	    if (yychk[yystate+1] != -yyn)
		yystate = yyact[yypgo[yyn+1]+1]
	}

	# Perform action associated with the grammar rule, if any.
	switch (yym) {
	    
case 1:
# line 32 "compnoise.y"
{
		    # Blank expression
		    call add_pcode (N_DONE)
		    return (OK)
		}
case 2:
# line 37 "compnoise.y"
{
		    # End of expression; successful parse
		    if (Memi[yypvt-YYOPLEN] != NULL) 
			call add_const (Memr[Memi[yypvt-YYOPLEN]])

		    call add_pcode (N_DONE)
		    return (OK)
		}
case 3:
# line 45 "compnoise.y"
{
		    # Error exit
		    return (ERR)
		}
case 4:
# line 51 "compnoise.y"
{
		    call salloc (Memi[yyval], 1, TY_REAL)
		    Memr[Memi[yyval]] = Memr[Memi[yypvt]]
		}
case 5:
# line 55 "compnoise.y"
{
		    # Push a variable
		    call add_pcode (N_FLUX)
		    Memi[yyval] = NULL
		}
case 6:
# line 60 "compnoise.y"
{
		    call salloc (Memi[yyval], 1, TY_REAL)
		    Memr[Memi[yyval]] = readout
		}
case 7:
# line 64 "compnoise.y"
{
		    call salloc (Memi[yyval], 1, TY_REAL)
		    Memr[Memi[yyval]] = time
		}
case 8:
# line 68 "compnoise.y"
{
		    # Negation
		    if (Memi[yypvt-YYOPLEN] != NULL) {
			call salloc (Memi[yyval], 1, TY_REAL)
			Memr[Memi[yyval]] = - Memr[Memi[yypvt-YYOPLEN]]
		    } else {
			call add_pcode (N_NEG)
			Memi[yyval] = NULL
		    }
		}
case 9:
# line 78 "compnoise.y"
{
		    # Exponentiation
		    if (Memi[yypvt-2*YYOPLEN] != NULL && Memi[yypvt] != NULL) {
			call salloc (Memi[yyval], 1, TY_REAL)
			Memr[Memi[yyval]] = Memr[Memi[yypvt-2*YYOPLEN]] ** Memr[Memi[yypvt]]

		    } else {
			if (Memi[yypvt-2*YYOPLEN] != NULL) {
			    call add_const (Memr[Memi[yypvt-2*YYOPLEN]])
			    call add_pcode (N_SWAP)
			}

			if (Memi[yypvt] != NULL)
			    call add_const (Memr[Memi[yypvt]])

			call add_pcode (N_EXP)
			Memi[yyval] = NULL
		    }
		}
case 10:
# line 97 "compnoise.y"
{
		    # Multiplication
		    if (Memi[yypvt-2*YYOPLEN] != NULL && Memi[yypvt] != NULL) {
			call salloc (Memi[yyval], 1, TY_REAL)
			Memr[Memi[yyval]] = Memr[Memi[yypvt-2*YYOPLEN]] * Memr[Memi[yypvt]]

		    } else {
			if (Memi[yypvt-2*YYOPLEN] != NULL)
			    call add_const (Memr[Memi[yypvt-2*YYOPLEN]])

			if (Memi[yypvt] != NULL)
			    call add_const (Memr[Memi[yypvt]])

			call add_pcode (N_MUL)
			Memi[yyval] = NULL
		    }
		}
case 11:
# line 114 "compnoise.y"
{
		    # Division
		    if (Memi[yypvt-2*YYOPLEN] != NULL && Memi[yypvt] != NULL) {
			call salloc (Memi[yyval], 1, TY_REAL)
			Memr[Memi[yyval]] = Memr[Memi[yypvt-2*YYOPLEN]] / Memr[Memi[yypvt]]

		    } else {
			if (Memi[yypvt-2*YYOPLEN] != NULL) {
			    call add_const (Memr[Memi[yypvt-2*YYOPLEN]])
			    call add_pcode (N_SWAP)
			}

			if (Memi[yypvt] != NULL)
			    call add_const (Memr[Memi[yypvt]])

			call add_pcode (N_DIV)
			Memi[yyval] = NULL
		    }
		}
case 12:
# line 133 "compnoise.y"
{
		    # Addition
		    if (Memi[yypvt-2*YYOPLEN] != NULL && Memi[yypvt] != NULL) {
			call salloc (Memi[yyval], 1, TY_REAL)
			Memr[Memi[yyval]] = Memr[Memi[yypvt-2*YYOPLEN]] + Memr[Memi[yypvt]]

		    } else {
			if (Memi[yypvt-2*YYOPLEN] != NULL)
			    call add_const (Memr[Memi[yypvt-2*YYOPLEN]])

			if (Memi[yypvt] != NULL)
			    call add_const (Memr[Memi[yypvt]])

			call add_pcode (N_ADD)
			Memi[yyval] = NULL
		    }
		}
case 13:
# line 150 "compnoise.y"
{
		    # Subtraction
		    if (Memi[yypvt-2*YYOPLEN] != NULL && Memi[yypvt] != NULL) {
			call salloc (Memi[yyval], 1, TY_REAL)
			Memr[Memi[yyval]] = Memr[Memi[yypvt-2*YYOPLEN]] - Memr[Memi[yypvt]]

		    } else {
			if (Memi[yypvt-2*YYOPLEN] != NULL) {
			    call add_const (Memr[Memi[yypvt-2*YYOPLEN]])
			    call add_pcode (N_SWAP)
			}

			if (Memi[yypvt] != NULL)
			    call add_const (Memr[Memi[yypvt]])

			call add_pcode (N_SUB)
			Memi[yyval] = NULL
		    }
		}
case 14:
# line 169 "compnoise.y"
{
		    # Magnitude (sqrt (a**2 + b**2))
		    if (Memi[yypvt-2*YYOPLEN] != NULL && Memi[yypvt] != NULL) {
			call salloc (Memi[yyval], 1, TY_REAL)
			Memr[Memi[yyval]] = sqrt (Memr[Memi[yypvt-2*YYOPLEN]] ** 2 + 
					       Memr[Memi[yypvt]] ** 2  )

		    } else {
			if (Memi[yypvt-2*YYOPLEN] != NULL)
			    call add_const (Memr[Memi[yypvt-2*YYOPLEN]])

			if (Memi[yypvt] != NULL)
			    call add_const (Memr[Memi[yypvt]])

			call add_pcode (N_MAG)
			Memi[yyval] = NULL
		    }
		}
case 15:
# line 187 "compnoise.y"
{
		    # Square root
		    if (Memi[yypvt-YYOPLEN] != NULL) {
			call salloc (Memi[yyval], 1, TY_REAL)
			Memr[Memi[yyval]] = sqrt (Memr[Memi[yypvt-YYOPLEN]])
		    } else {
			call add_pcode (N_SQRT)
			Memi[yyval] = NULL
		    }
		}
case 16:
# line 197 "compnoise.y"
{
		    # Natural logarithm
		    if (Memi[yypvt-YYOPLEN] != NULL) {
			call salloc (Memi[yyval], 1, TY_REAL)
			Memr[Memi[yyval]] = alog (Memr[Memi[yypvt-YYOPLEN]])
		    } else {
			call add_pcode (N_LOG)
			Memi[yyval] = NULL
		    }
		}
case 17:
# line 207 "compnoise.y"
{
		    # Parenthesized expression, no-op
		    if (Memi[yypvt-YYOPLEN] != NULL) {
		    	call salloc (Memi[yyval], 1, TY_REAL)
		    	Memr[Memi[yyval]] = Memr[Memi[yypvt-YYOPLEN]]
		    } else {
			Memi[yyval] = NULL
		    }
		}
case 18:
# line 216 "compnoise.y"
{
		    call eprintf ("Unrecognized token\n")
		    return (ERR)
		}	}

	goto yystack_				# stack new state and value
end