%%s 13/19/275
%%d D 1.3 31-Jul-83 17:19:54 tools 3 2
%%c Fixed bug in ftntok which caused scan to terminate if variables of the
%%c form
%%c 
%%c end_of_file = 2
%%c 
%%c were seen.
%%s 7/7/287
%%d D 1.2 15-Jun-83 12:43:43 sventek 2 1
%%c Removed trailing periods from quoted strings, as they are no longer needed.
%%s 0/0/0
%%d D 1.1 13-Jun-83 09:49:49 sventek 1 0
%%c Initial distribution of ratp2, the second pass of the ratfor preprocessor.
%%c This program re-orders FORTRAN statements to conform with ANSI-66.
%%T
%%I 1
#-h- cratp2           292  asc  13-jun-83 09:47:06  sventek (joseph sventek)
#common for ratp2
character buf   # line hold buffer
integer ptr     # index of starts of lines
integer type    # kind of each line
integer nextp   # next line pos pointer
integer stb   # symbol table pointer
common /ratp2c/ buf(MAXBUF),ptr(MAXSAVE),type(MAXSAVE),
                nextp, stb
%%D 2
#-h- ratp2.r         5651  asc  13-jun-83 09:47:07  sventek (joseph sventek)
%%E 2
%%I 2
%%D 3
#-h- ratp2.r         5651  asc  15-jun-83 12:43:22  sventek (joseph sventek)
%%E 3
%%E 2
%%I 3
#-h- ratp2.r         5592  asc  31-jul-83 17:18:58  tools (lblh csam sventek)
%%E 3
#-h- defns            488  asc  06-may-83 16:09:36  sventek (joseph sventek)
#
#	If you are generating the bootstrap version of ratp2, you must
#	uncomment the following line
#
#define(DO_BOOTSTRAP,)
#
define(HEAD,1)
define(END,2)
define(BODY,3)
define(PROG,4)
define(TYPE,5)
define(COMN,6)
define(EQUI,7)
define(DAT,8)
define(DOUBLE,9)
define(BLOCK,10)
define(PRECISION,11)
define(WRONG,12)

define(MAXNAMES,10)
ifdef(DO_BOOTSTRAP)
   define(MAXBUF,10000)
   define(MAXSAVE,500)
elsedef
   define(MAXBUF,20000)
   define(MAXSAVE,1000)
enddef
define(Mem_size,500)

%%D 2
#-h- main             451  asc  06-may-83 17:13:04  sventek (joseph sventek)
%%E 2
%%I 2
#-h- main             454  asc  15-jun-83 12:43:00  sventek (joseph sventek)
%%E 2
DRIVER(ratp2)

ifnotdef(DO_BOOTSTRAP)
integer getarg, open
integer i, fd
character buf(FILENAMESIZE)

%%D 2
call query ("usage: ratp2 [files].")
%%E 2
%%I 2
call query ("usage: ratp2 [files] ...")
%%E 2
for (i=1; getarg(i, buf, FILENAMESIZE) != EOF; i=i+1)
	{
	if (buf(1) == '-' & buf(2) == EOS)
		fd = STDIN
	else
		fd = open(buf, READ)
	if (fd == ERR)
		call cant (buf)
	call fsort (fd, STDOUT)
	if (fd != STDIN)
		call close (fd)
	}
if (i == 1)		# no files given
enddef

	call fsort (STDIN, STDOUT)

DRETURN
end
#-h- fsort            745  asc  15-apr-83 13:26:01  sventek (joseph sventek)
subroutine fsort(ifd,ofd)
integer ifd,ofd
integer len, i
integer kind
character line(MAXLINE)
integer getlin, lookup, mktabl
integer gcode

DS_DECL(Mem,Mem_size)

include cratp2

call dsinit(Mem_size)
nextp = 1
ptr(nextp) = 1
kind = WRONG
stb = mktabl (1)
call initfs (stb)
for(len=getlin(line,ifd);len!=EOF;len=getlin(line,ifd))
	{
	i = 1
        call skipbl(line, i)
        if (line(i) == '@n')		# line is blank
		next;
	if (len>6 & line(6)!= ' ' & line(6)!= '0' & line(6)!= '@t')
		{ # continuation line
		# kind = kind
		}
	else
		kind = gcode(line)
	call keepln(line,kind)
	if (kind==END)
		{
		call sflush (ofd)
		nextp = 1
		ptr(nextp) = 1
		kind = WRONG
		}
	}
if (nextp > 1)				# flush accumulated stuff
	call sflush (ofd)

return
end
%%D 3
#-h- ftntok           866  asc  05-may-83 11:57:40  sventek (joseph sventek)
%%E 3
%%I 3
#-h- ftntok           806  asc  31-jul-83 17:18:52  tools (lblh csam sventek)
%%E 3
# ftntok - routine to return next FORTRAN token in `token', incrementing
#          `i'.  The token is folded to lower case and the length is
#          returned as the function value
integer function ftntok(line, i, token)

%%D 3
character line(ARB), token(ARB)
%%E 3
%%I 3
character line(ARB), token(ARB), c
%%E 3
integer i, j
%%D 3

ifnotdef(IS_LETTER)
%%E 3
character type
%%D 3
enddef
%%E 3

call skipbl(line, i)		# skip leading blanks and tabs
%%D 3
ifdef(IS_LETTER)
for (j = 1; IS_LETTER(line(i)); j = j + 1)
elsedef
for (j = 1; type(line(i)) == LETTER; j = j + 1)
enddef
   {
   token(j) = line(i)
   i = i + 1
   }
%%E 3
%%I 3
j = 1
if (type(line(i)) == LETTER)	# get token if starts with alpha
   repeat
      {
      token(j) = line(i)
      j = j + 1
      i = i + 1
      c = type(line(i))
      }
   until (c != LETTER & c != DIGIT & c != '_')
%%E 3
token(j) = EOS
if (line(i) == '*')		# handle type*N declarations
   repeat
      i = i + 1
%%D 3
ifdef(IS_LETTER)
   until (! IS_DIGIT(line(i)))	# skip to first non-digit
elsedef
%%E 3
   until (type(line(i)) != DIGIT)	# skip to first non-digit
%%D 3
enddef
%%E 3
call fold(token)		# lower case for future comparisons
return(j - 1)			# return length

end
#-h- gcode            563  asc  15-apr-83 13:26:03  sventek (joseph sventek)
integer function gcode(line)
character line(ARB), word(MAXLINE)
integer i, len, code
integer lookup, ftntok
integer tmp

include cratp2

i = 1
if (ftntok(line, i, word) == 0)
        return(BODY)
if (lookup(word, code, stb) == NO)
	return(BODY)
if (code==BLOCK | code==DOUBLE)
	{
	tmp = code
	len = ftntok(line,i,word)
	if (lookup(word,code, stb) == NO)
		return(BODY)
	if (tmp==BLOCK & code==DAT)
		return(PROG)
	else if(tmp==DOUBLE & code==PRECISION)
		return(TYPE)
	else
		return(BODY)
	}
else
	return(code)
return(BODY) # no path here but supress message
end
#-h- initfs          1100  asc  06-may-83 17:19:23  sventek (joseph sventek)
subroutine initfs (tb)

integer tb		# symbol table pointer
integer junk
integer enter

string send	"end"
string sprog	"program"
string ssub	"subroutine"
string sfunc	"function"
string sblck	"block"
string sdata	"data"
string sint	"integer"
string sreal	"real"
string sdoubl	"double"
string sprec	"precision"
string slog	"logical"
string scompl	"complex"
string schar	"character"
string sbyte	"byte"
string sext	"external"
string sdim	"dimension"
string simpl	"implicit"
string scom	"common"
string sequ	"equivalence"


junk = enter(sprog, PROG, tb)
junk = enter(ssub, PROG, tb)
junk = enter(sblck, BLOCK, tb)
junk = enter(scom, COMN, tb)
junk = enter(sfunc, TYPE, tb)
junk = enter(sint, TYPE, tb)
junk = enter(sreal, TYPE, tb)
junk = enter(slog, TYPE, tb)
junk = enter(scompl, TYPE, tb)
junk = enter(schar, TYPE, tb)
junk = enter(sbyte, TYPE, tb)
junk = enter(sdim, TYPE, tb)
junk = enter(sext, TYPE, tb)
junk = enter(simpl, TYPE, tb)
junk = enter(sequ, EQUI, tb)
junk = enter(sdata, DAT, tb)
junk = enter(sdoubl, DOUBLE, tb)
junk = enter(sprec, PRECISION, tb)
junk = enter(send, END, tb)
return
end
%%D 2
#-h- keepln           399  asc  15-apr-83 13:26:05  sventek (joseph sventek)
%%E 2
%%I 2
#-h- keepln           396  asc  15-jun-83 12:43:01  sventek (joseph sventek)
%%E 2
subroutine keepln(line,kind)
character line(ARB)
integer length
integer i,j
integer kind

include cratp2

if (kind == WRONG)
%%D 2
	call error("ratp2 sequence error.")
%%E 2
%%I 2
	call error("ratp2 sequence error")
%%E 2
if (nextp == MAXSAVE)
%%D 2
	call error("too many decl lines.")
%%E 2
%%I 2
	call error("too many decl lines")
%%E 2
type(nextp) = kind
i = ptr(nextp)
j = length(line)
if (i+j >= MAXBUF)
%%D 2
	call error("too many decl chars.")
%%E 2
%%I 2
	call error("too many decl chars")
%%E 2
call scopy(line,1,buf,i)
nextp = nextp + 1
ptr(nextp) = i+j+1
return
end
#-h- sflush           423  asc  15-apr-83 13:26:06  sventek (joseph sventek)
subroutine sflush(fd)
integer fd,j,p
integer i,kind, ord(MAXNAMES)

include cratp2

data ord(1)/PROG/, ord(2)/TYPE/, ord(3)/COMN/, ord(4)/EQUI/,
     ord(5)/DAT/, ord(6)/BODY/, ord(7)/END/, ord(8)/WRONG/

for (i=1; ord(i) != WRONG; i=i+1)  # step thru kinds
	{
	kind = ord(i)
	for (p=1; p<nextp; p=p+1)  # step thru saved lines
	if (type(p) == kind)
		{  # take it
		j = ptr(p)
		call putlin(buf(j),fd)
		}
	}
return
end


#-h- ratp2.fmt        519  asc  13-jun-83 09:47:10  sventek (joseph sventek)
.so ~bin/manhdr
.hd Ratp2 (1) 10-May-83
Ratfor second pass processor
.sy
ratp2 [file] ... >outfile
.ds
`ratp2' is the second pass of the new pre-processor.
It's function is to re-order the output of the first pass to be ANSI-66
compliant.
It's input is simply FORTRAN code, and all statements between successive
END statements are re-ordered.
If filename arguments are not provided, it reads from standard input.
.sa
ratfor, the ratfor preprocessor, for descriptions of the language.
.au
Phil Scherrer wrote ratp2.
.bu
%%E 1