include ratfor.def
/************************************************************************
*	for	-the code for the for statement				*
*									*
*	The code in this file produces code for the FOR statement.	*
************************************************************************/
/************************************************************************
*	forgen	-code for the beginning of the for statement		*
*									*
*	useage:	call forgen(lab)					*
*	where:	lab	<>the label returned for next statement		*
************************************************************************/
subroutine forgen(lab)
integer lab
character str(MAXFORSTAT),rein(MAXFORSTAT),query(MAXFORSTAT)
character token(MAXTOKEN),name(6),null(4)
integer gettok
data null/NEWLINE,SEMICOL,NEWLINE,EOS/	#a null statement
 
call outcon(0)				#for could be labeled
lab = labgen(3) + 1			#generate three labels

if(gettok(token) <> LEXLPAREN) {
	call synerr(S_MIS_LPAREN)
	call pbstr(token)
	}

call gather(str,LEXSEMICOL)		#get the initialization
call gather(query,LEXSEMICOL)		#get the condition
call remove(query,NEWLINE)
call gather(rein,LEXRPAREN)		#get the reinitialization

call fornam(name)			#get a name
if(^instal(name,rein)) {		#save reinitialization
	call synerr(F_FOR_REIN)
	call ratout
	}
call fornam(name)			#get another name
if(^instal(name,query)) {		#save condition
	call synerr(F_FOR_TST)
	call ratout
	}
if(length(str) == 0)			#true if no initialization
	call pbstr(null)
else	{
	call putchr(NEWLINE)
	call pbstr(str)			#else push back initialization
	}
return
end

/************************************************************************
*	fortst	-generate code for conditional part of for		*
*									*
*	useage:	call fortst(lab)					*
*	where:	lab	=the label on the stack for LEXFORINIT		*
************************************************************************/
subroutine fortst(lab)
integer lab
character name(6),query(maxforstat)
logical find

call endfor(name)			#get name
if(^find(name,query)) {		#get condition
	call synerr(F_FOR_TST)
	call ratout
	}
call delete(name)			#delete entry
if(length(query) <= 0)
	call outcon(lab-1)
else {
	call outnum(lab-1)
	call outtab
	call outstr('IF(.NOT.(')
	call outstr(query)
	call outstr('))GOTO')
	call outnum(lab+1)
	call outdon
	}
return
end

/************************************************************************
*	fors	-closing code for for statement				*
*									*
*	useage:	call fors(lab)						*
*	where:	lab	=the label for next statement			*
************************************************************************/
subroutine fors(lab)
character str(MAXFORSTAT),name(6),outstr(MAXFORSTAT)
character new(2)
logical find
integer length,iindex
data outstr(1)/LBRACE/
data new/NEWLINE,EOS/
define	RB	"}"

call endfor(name)			#get the name
if(^find(name,str)) {		#get the reinitialization
	call synerr(F_FOR_REIN)
	call ratout
	}
call delete(name)

call ita(lab,outstr(2))			#generate next label
call concat(outstr,' ')			#a space
if(length(str) > 0)			#is there reinitialization?
	call concat(outstr,str)		# yes, then concat on
else
	call concat(outstr,'CONTINUE')	# otherwise, just a continue
call concat(outstr,new)

call concat(outstr,'GOTO ')		#goto beginning of for
call ita(lab-1,outstr(iindex(outstr,EOS)))
call concat(outstr,new)
call ita(lab+1,outstr(iindex(outstr,EOS)))#generate break label
call concat(outstr,' CONTINUE')
call concat(outstr,RB)
call pbstr(outstr)

return
end					#goodnight Sherman


/************************************************************************
*	gather	-gather up a string from input				*
*									*
*	useage:	call gather(str,delim)					*
*	where:	str	=the string returned, EOS terminated		*
*		delim	=the lexical type of the token to stop on	*
************************************************************************/
subroutine gather(str,delim)
character str(MAXFORSTAT),token(MAXTOKEN),temp(MAXFORSTAT)
integer delim
integer gettok
character sp(2)
data sp/SPACE,EOS/

str(1) = EOS
for(i = gettok(token);i <> delim;i = gettok(token)) {
	if(i == EOF) {
		call synerr(S_EOF)
		break
		}
	if(i == LEXLPAREN | i == LEXBEGIN) {
		call pbstr(token)
		call parens(temp)
		call concat(str,temp)
		}
	else
		call concat(str,token)
	call concat(str,sp)
	}
return
end

/************************************************************************
* parens -- reads in balanced parens or brackets to a string		*
*									*
*	useage	call parens(str)					*
*		where	str	is the ascii string returned		*
*	note	Parens is designed for the for statement.  All tokens	*
*		are concatenated on a string with white space between	*
*		them so that they can be safely rescanned.		*
*									*
* coded by G Beckamnn, 3-Aug-79						*
************************************************************************/
subroutine parens(str)
character str(MAXFORSTAT),tok(MAXTOKEN),sp(2)
integer gettok
integer paren,braces
data sp/BLANK,EOS/


paren = 0				#initialize these
braces = 0
str(1) = EOS

for(i = gettok(tok);i ^= EOF;i = gettok(tok)) [
	if(i == LEXLPAREN) [		#keep count of parens
		paren = paren + 1
		call concat(str,tok)	#put token on string
		]
	else if(i == LEXRPAREN) [
		paren = paren - 1
		if(paren < 0) [
			call synerr(S_UNBAL_PARENS)
			break
			]
		call concat(str,tok)	#put token on string
		]
	else if(i == LEXBEGIN) [	#keep track of brackets
		braces = braces + 1
		call concat(str,tok)	#put token on string
		]
	else if(i == LEXEND) [
		braces = braces - 1
		if(braces < 0) [
			call synerr(S_UNBAL_BRACES)
			break
			]
		call concat(str,tok)	#put token on string
		]
	else	[			#if token is not a (,),[,or ]
		call concat(str,tok)	#put token on string 
		call concat(str,sp)	#put space behind token
		]
	if(paren == 0 & braces == 0)	#check to see if parens and braces 
		return			#are balanced and exit if so
	]

call synerr(S_EOF)
type *,'parens'
return
end


/************************************************************************
* fornam	-gets the name for for					*
************************************************************************/
subroutine fornam(name)
character name(6)
include forgen.cmm

storit(5) = storit(5) - 1
if(storit(5) <= 0) {
	call synerr(F_FOR_NEST)
	call ratout
	}
do i = 1,6
	name(i) = storit(i)

return
end

/************************************************************************
* endfor -- returns the name for find in for closing | decrements name*
*									*
*	useage	call endfor(name)					*
*		where	name	is the ascii string containing the name	*
*									*
* coded by G Beckamnn, 3-Aug-79						*
************************************************************************/
subroutine endfor(name)
character name(6)
include forgen.cmm

do i = 1,6
	name(i) = storit(i)
storit(5) = storit(5) + 1
return
end