/************************************************************************
*	the switch/case code						*
*									*
*	Things to know:							*
*	1. This code uses the fact that if a value in a computed goto	*
*	is outside of the range of the label list, that the next 	*
*	statement is executed.						*
************************************************************************/


/************************************************************************
*	switch	-ye olde switch/case statement				*
*									*
*	The code is generated as follows:				*
*	1. Get two labels.						*
*	2. Collect expression and save it				*
*	3. generate goto first label					*
*	4. Set up case pointers						*
*	5. return							*
************************************************************************/
subroutine switch(lab)
include ratfor.def
include case.cmm			#everything you need for case/switch
integer lab,labgen
integer gettok,temp
character token(MAXTOKEN),str(MAXTOKEN),name(6)
logical instal

lab = labgen(2)
call outgo(lab)				#branch around everything
if(gettok(token) ^= LEXLPAREN) {	#need a parenthesis
	call pbstr(token)
	call synerr(S_MIS_LPAREN)
	}
call putchr(LPAREN)			#push back left paren
str(1) = EOS
call parens(str)			#collect balanced parenthesis

call casnam(name)			#get name for instal
if(^instal(name,str)) {			#save string
	call synerr(F_CASE_NAME)
	call ratout
	}
temp = casesp + casel(1,casesp) + 1	#find new slot
if(temp >= MAXCASE) {			#an error, no room
	call synerr(F_CASE_BIG)
	call ratout
	}
casel(1,temp) = 0			#initially no case labs
casel(2,temp) = casesp			#save link back
casesp = temp				#set casesp
return
end



/************************************************************************
*	casnam	-generate a name for switch expressions			*
************************************************************************/
subroutine casnam(name)
character name(6)
include case.cmm

namcas(5) = namcas(5) - 1
if(namcas(5) <= 0) {
	call synerr(F_CASE_NEST)
	call ratout
	}
do i = 1,6
	name(i) = namcas(i)
return
end

/************************************************************************
*	endcas	-retreive a name for switch expressions			*
************************************************************************/
subroutine endcas(name)
character name(6)
include case.cmm
do i = 1,6
	name(i) = namcas(i)
namcas(5) = namcas(5) + 1
return
end


/************************************************************************
*	case	-generate code for a case				*
*									*
*	1. Get the value, has to be LEXNUMBER or LEXSTRING.		*
*	2. Check to see that next token is a LEXSEMICOL			*
*	3. Generate a label and stack the label and the value		*
*	   Labels are inserted sorted.					*
************************************************************************/
subroutine case
include case.cmm
integer gettok
character token(MAXTOKEN)
integer temp,lab,labgen,ati,doback

temp = gettok(token)
if(temp == LEXNUMBER)				#convert to a number
	temp = ati(token)
else if(temp == LEXSTRING) {
	if(token(2) == '\') {
		temp = doback(token(3),len)
		if(temp < 0) {
			call synerr(S_CASE_VAL)
			return
			}
		}
	else
		temp = token(2)
	}
else	{
	call synerr(S_CASE_VAL)
	return
	}
if(gettok(token) ^= LEXCOLON)	{		#must have a semicolon
	call synerr(S_CASE_SEMI)
	call pbstr(token)
	}

for(i = casesp + 1;i <= (casel(1,casesp) + casesp);i = i + 1)
	if(casel(1,i) == temp)break		#look for a duplicate
if(i <= (casel(1,casesp) + casesp)) {
	call synerr(S_CASE_DUP)
	return
	}
	
lab = labgen(1)					#get a label
if(casesp + casel(1,casesp) + 2 > MAXCASE) {	#check for too many cases
	call synerr(F_CASE_BIG)			#write it out
	call ratout
	}
casel(1,casesp) = casel(1,casesp) + 1		#a new entry
i = casesp + casel(1,casesp)			#find position
casel(1,i) = temp				#save value and label
casel(2,i) = lab
call outcon(lab)
for(;i > casesp + 1;i = i - 1)
	if(casel(1,i) < casel(1,i-1))		#compare
		do jj = 1,2 {
			temp = casel(jj,i)
			casel(jj,i) = casel(jj,i-1)
			casel(jj,i-1) = temp
			}
return
end



/************************************************************************
*	ecase	-generate code for the end of a case/switch		*
*									*
*	1. Sort the case labels						*
*	2. Generate goto(lab+1)						*
*	3. Generate lab <tab> goto(					*
*	4. Generate labels for the computed goto			*
*	5. Get the expression						*
*	6. Normalize							*
*	7. Print out normalized expression				*
*	8. Generate goto default, if a default was specified		*
*	9. Generate lab continue.					*
************************************************************************/
subroutine ecase(lab)
include case.cmm
integer lab,begin,ending
character str(MAXTOKEN),name(6)
integer default_label,subtract_val,temp
logical find

call endcas(name)			#get the name
if(^find(name,str)) {
	call synerr(F_CASE_NAME)
	call ratout
	}
call delete(name)
if(casel(1,casesp) == 0) {		#no case labels
	casesp = casel(2,casesp)	#unstack
	return
	}
call outgo(lab+1)			#branch around computed goto
call outnum(lab)			#label for goto
call outtab
call outstr('GOTO(')
begin = casesp + 1			#list begins here
ending = casesp + casel(1,casesp)	#the list ends here

if(casel(1,begin) == DEFAULT_MAGIC) {	#a default was specified
	default_label = casel(2,begin)
	begin = begin + 1		#list is one shorter
	}
else
	default_label = lab + 1		#otherwise default is break

subtract_val = casel(1,begin) - 1	#this is the normalization value

for(i = 1;begin <= ending;i = i + 1) {
	for(;i < (casel(1,begin) - subtract_val);i = i + 1) {
		call outnum(default_label)	#write out default label
		call outch(COMMA)
		}
	call outnum(casel(2,begin))		#write out actual label
	begin = begin + 1
	if(begin <= ending)call outch(COMMA)
	}
call outch(RPAREN)				#close it out
call outstr(str)				#write out expression
call outch(MINUS)
call outnum(subtract_val)
call outdon
call outtab					#deal with defaults
call outgo(default_label)
call outcon(lab+1)				#the break code
casesp = casel(2,casesp)			#unstack
return
end