include ratfor.def
/************************************************************************
*	parse	-ye olde parser						*
*									*
*	useage:	call parse						*
*	note:								*
*		1. The state is kept on the stacks labval and lextyp	*
*	with stack pointer sp.						*
*		2. Parse expects that the output file is opened on	*
*	lun OUTLUN, that the input file is open on unit #1, that the	*
*	variable LUN is set to 1, and that INNAME(1) has the input	*
*	file name.							*
*		3. Statements can be divided into three general classes:*
*		a. Those that begin statements, examples are if,for...	*
*		b. Those that end statements, },until...		*
*		c. Those that change the context of the generated code	*
*		  but do not produce code directly,define,include...	*
*		4. For statements are special. Because of the way	*
*	initializations are handled two items are pushed onto the stack.*
************************************************************************/
subroutine parse
character token (MAXTOKEN)
integer gettok
integer temp					#guess what... a temp value
integer lab					#label value

integer labval (MAXSTACK), lextyp (MAXSTACK)	#the context stacks
integer sp					#the stack pointer

 
sp = 1						#initialize stack pointer
lextyp (1) = EOF				#we are done when EOF is found
for(temp = gettok (token) ; temp ^= EOF ; temp = gettok (token)) {
	switch (temp) {				#dispatch on token type
		case NEWLINE:			#skip newlines
			next
		case LEXNUMBER:			#a label
			call labelc (token)
			next
		case LEXDEFINE:			#define statement
			call defgen
			next
		case LEXINCLUDE:		#include statement
			call incgen
			next
		case LEXLABEL:			#label statement
			call labels
			next
		case LEXCASE:			#case statement
			call case
			next
		case LEXUNDEFINE:		#undefine
			call undef
			next
		case LEXSTRING_STAT:		#ratfor string
			call string
			next

		case LEXIF:			#if statement
			call ifcode (lab)
			break
		case LEXFOR:			#for statement
			call forgen (lab)
			break
		case LEXDO:			#do statement
			call docode (lab)
			break
		case LEXWHILE:			#while statement
			call whilec (lab)
			break
		case LEXREPEAT:			#repeat
			call repc (lab)
			break
		case LEXELSE:			#else
			if (lextyp (sp) ^= LEXIF) {	  #must if before
				call synerr (S_ILL_ELSE)
				next		#ignore, get next token
				}
			call elseif (labval (sp))
			break
		case LEXBREAK:
		case LEXNEXT:
			call brknxt (sp, lextyp, labval, temp)
			break
		case LEXSWITCH:
			call switch (lab)
			break
		case LEXEND_STAT:		#fortran end statement
			call endstr
		case LEXIDENT:			#all others
			call otherc (token)
		} 				#end of case

	/*  do we stack things?  */
	if (temp == LEXIF   | temp == LEXWHILE  |
	    temp == LEXELSE | temp == LEXSWITCH |
	    temp == LEXFOR  | temp == LEXREPEAT |
	    temp == LEXDO   | temp == LEXBEGIN ) {
		sp = sp + 1
		if (sp > MAXSTACK)
			call synerr (S_STACK_OVR)	#stack overflow
		lextyp (sp) = temp
		labval (sp) = lab
		if (temp == LEXFOR) {	#push on another
			sp = sp + 1
			if(sp > MAXSTACK)
				call synerr (S_STACK_OVR)
			lextyp (sp) = LEXFORINIT
			labval (sp) = lab
			}
		}
	else	{
		if(temp == LEXEND) {
			if (lextyp (sp) == LEXBEGIN)	#lexend must balance
				sp = sp - 1		 
			else	call synerr (S_ILL_RBRACE)
			}
		call unstak (sp, lextyp, labval)
		}
	}				# of for
if (sp ^= 1)
	call synerr (S_EOF)
return
end