include ratfor.def
/************************************************************************
*	string	-process the ratfor string statement			*
*									*
*	usage:	call string						*
*	notes:								*
*									*
*	1. Strings can only be used where declarative statements are	*
*	used.								*
************************************************************************/
subroutine string
implicit integer(a-z)
include string.cmm
integer gettok,scan
byte character_name(MAXTOKEN)
byte string_name(MAXFORVARNAME)		#holds name, always short
byte real_name(MAXTOKEN)		#the real name, used for length
byte temp(10)
logical instal,foo,find

if(^find("CHARACTER",character_name))	#get definition of "character"
	call synerr(S_NO_CHAR)

ii = scan(real_name)			#get name for later
call pbstr(real_name)			#and put it back

ii = string_ptr(string_used+1)			#get next free position
if(gettok(string_buf(ii)) != LEXIDENT) {	#error...
	call synerr(S_ILL_STRING)
	repeat				#flush rest of line
		i = gettok(string_buf(ii))
	until(i == NEWLINE | i == LEXSEMICOL | i == EOF)
	return
	}

ii = length(string_buf(ii)) + ii + 1		#point past end of name

if(gettok(string_buf(ii)) != LEXSTRING) {	#get definition
	call synerr(S_ILL_STRING)
	repeat
		i = gettok(string_buf(ii))
	until(i == newline | i == LEXSEMICOL | i == EOF)
	return
	}

jj = ii						#where to copy to
ii = ii + 1					#point past opening quote
string_begin = jj				#save for later

for(;string_buf(ii) != 0;{ii = ii + 1;jj = jj + 1})
	if(string_buf(ii) == "'" & string_buf(ii+1) == "'") {
		ii = ii + 1
		string_buf(jj) = "'"
		}
	else if(string_buf(ii) == '\') {
		ii = ii + 1
		j = doback(string_buf(ii),len)
		ii = ii + len - 1
		if(j == -2) {			#a newline
			string_buf(jj) = CR
			jj = jj + 1
			string_buf(jj) = LF
			}
		else	{
			if(j <= 127)
				string_buf(jj) = j
			else			#to avoid overflow errors
				string_buf(jj) = (-1 .xor. @377) | j
			}
		}
	else
		string_buf(jj) = string_buf(ii)

string_used = string_used + 1		#update pointers
string_ptr(string_used+1) = jj-1	#point at closing quote

repeat					#flush line
	j = gettok(string_buf(jj))
until(j == newline | j == LEXSEMICOL | j == EOF)

call outtab				#generate code
call outstr(character_name)		#whatever character is

i = string_ptr(string_used)
call outstr(string_buf(i))		#put out declaration

call outch(LPAREN)
call ita(jj-string_begin,temp)		#make ascii string
call outstr(temp)			#bracketed number
call outch(RPAREN)			#the string "character foo(xx)"
call outdon

call concat(real_name,'_LENGTH')	#create length name
call delete(real_name)			#done to avoid error in next line
call ita(jj-string_begin-1,temp)
foo = instal(real_name,temp)

return
end