#-h- yacc.all 18389 ascii 15-Jan-84 21:01:10 #-h- yacc.doc 3692 ascii 04Jan84 09:18:01 .pl 64 .m1 2 .m2 3 .m3 3 .m4 3 .po 10 .rm 62 .bp 1 .in 0 .he ^yacc(1)^%^yacc(1)^ .fo ^^- # -^^ .in 5 .sp .ne 2 .fi .ti -5 NAME .br yacc - compile and optionally link yacc source .sp .ne 2 .fi .ti -5 SYNOPSIS .br .nf yacc [-lvrsp] [-e] file [libraries ...] .sp .ne 2 .fi .ti -5 DESCRIPTION .br Yacc is a tool to generate, compile, and optionally link parsers. The first argument which is not a flag is assumed to be the name of the grammar source file. Any subsequent arguments are assumed to be the name of libraries. These library names, along with any unrecognized flags, and the generated parser code, are passed to the tool rc. Yacc recognizes the following flags: .ne 3 .sp .in +6 .ta 5r .ti -6 -l produce a listing of the yacc input source onto standard output. .in -6 .ne 3 .sp .in +6 .ta 5r .ti -6 -v produce a listing onto standard output containing the specified file's symbols and their definitions, the grammar productions, a vocabulary cross-reference, and state sets used to build the parse tables which drive the generated parser. .in -6 .ne 3 .sp .in +6 .ta 5r .ti -6 -r produce a listing of the generated code onto standard output by passing a '-l' flag to .ul rc. .in -6 .ne 3 .sp .in +6 .ta 5r .ti -6 -s do not delete 'src/name.r'; the ratfor code generated from 'file', where 'name' is the simple-most file name of 'file'. .in -6 .ne 3 .sp .in +6 .ta 5r .ti -6 -p enables the generated parser to run in debug mode. This means that while the while the generated parser is parsing, a listing of the shifts and reduces being performed is written to error output, along with the relevant parse stacks. .in -6 .ne 3 .sp .in +6 .ta 5r .ti -6 -e allows the user to specify the parser stack sizes. "n" is the specified size, for example, '-e50' would set the stack sizes to 50. If no size is specified a default size is used. .in -6 .sp .ne 2 .fi .ti -5 FILES .br /usr/incl/yytblc .ne 3 .sp /usr/lib/yyplb. Yacc-generated programs must be linked with this file. The library is automatically linked with if the invocation of yacc creates an executable (i.e. the .bd rc flags .bd -b and .bd -c are not specified). .sp .ne 2 .fi .ti -5 SEE ALSO .br .nf lrgen(1), yaclr(1), rc(1), lip(1), yyplb(2), yc(T) "Yacc: Yet Another Compiler-Compiler" by S.C. Johnson "LR - Automatic Parser Generator and LR(1) Parser" by C. Wetherall and A. Shannon. .sp .ne 2 .fi .ti -5 AUTHOR(S) .br Theresa Breckon .sp .ne 2 .fi .ti -5 BUGS/DEFICIENCIES .br .ne 3 .sp .in +6 .ta 5r .ti -6 1. Generated ratfor code is written onto 'src/name.r', where 'name' is the simple-most file name of 'file'. This could wipe out an existing file. One solution would be to add a '-n name' flag to rc, where the binary could be written to a specified 'bin/name', instead of always using the default source name. .in -6 .ne 3 .sp .in +6 .ta 5r .ti -6 2. The parse tables generated by lrgen are kept in common blocks in the include file yytblc. Since these common blocks must be included in code that is created before the parse tables are created, the size of the each of the tables is set to 1 in the common blocks. Lrgen then outputs the same common blocks, with the correct size blocks. However, trying to debug any code that contains the 1-dimensioned tables will result in errors like "array bounds exceeded". .in -6 .sp .ne 2 .fi .ti -5 DIAGNOSTICS .br .ne 3 .sp .in +6 .ta 5r .ti -6 Illegal Language Construct - a point in the parse was reached where no SHIFT or REDUCE was possible. .in -6 .ne 3 .sp .in +6 .ta 5r .ti -6 Tried to Associate Non-associating Operator - a sentence of the form "e1 OP e2 OP e3" was recognized, where OP was defined as non-associating in the grammar definition. #-t- yacc.doc 3692 ascii 04Jan84 09:18:01 #-h- yacc 13391 ascii 15-Jan-84 20:58:24 ### yacc - compile and optionally link yacc source # # MODIFICATION HISTORY # -------------------- # 03b dpm 15jan84 .removed "extra" right brace from line 332 so # we can make it through RatFor without complaint. # 03a tab 22dec83 .changed to not use search paths for TOYS tape. # 02d vp 23jun83 .modified to discriminate between failed spawns # and child abortions, morbid as that sounds # .ratfixed # .changed call to unique to call mkuniq # 02c ant 01jun83 .changed subroutine name from scratf to unique. # 02b tab 17dec82 .fixed calls to close to use the word 'call'!!! # 02a tab 20oct82 .changed so semantics and user routines aren't passed # to lrgen. (used -s flag in yaclr). Added -e flag. # Added search paths for spawn to yaclr, rc, and lip. # Used LIP for listing instead of PR. # 01A TAB 15JUL82 .WRITTEN # # SYNOPSIS # -------- # yacc [-vlprs] [-e] yaccfile [libraries .... ] # -v: print LR parse listing from lrgen to STDOUT # -l: spawn to "pr -ln yaccfile" # -p: set parser in debug mode # -r: pass '-l' flag, along with any unrecognized flags, the # [library...] names and the generated code, to rc. # -s: keep rat4 code of semantics in src/name.r, where name # is the last simple name of "yaccfile" # -e: user specified parse stack size, 'n'. # yaccfile: yacc source read from here # libraries: optional libraries to link semantic code with # # DESCRIPTION # ----------- # YACC translates the yacc source in 'yaccfile' to LRGEN input form. If # the '-l' flag is specified, YACC spawns to PR to print a listing # of the input file onto standard output. YACC then spawns to YACLR # and to LRGEN, which creates the code to be compiled. If the # '-v' flag is specified, an informational listing about the generated # parse tables is output to STDOUT. The source code is put on # src/name.r, where name is the last simple name of 'yaccfile'. # YACC then spawns to RC to compile src/name.r. If the '-r' flag # is specified, the '-l' flag, along with any other unrecognized flags # on specified the command line and the library names, are passed to RC. # After compiling src/name.r, # if the '-s' flag is not specified, src/name.r will be removed. # If the '-p' flag is specified, a flag in the parser is set, so that # when the parser is invoked, each shift and reduction are printed # to ERROUT, along with the state stacks. # The '-e' flag is passed to YACLR. If specified, it sets the parse # stack sizes. DRIVER(yacc) integer lrlist # lrgen listing flag integer rclist # rat4 listing wanted integer liplist # lip listing flag integer srcflag # keep-source flag integer spawn # spawn to a shell command character desc(PIDSIZE) # process id returned by spawn integer getarg, lastsn, open, getlin integer stdlfn # logical name for scratch file integer spwnstatus # status returned by spawn() character arg(MAXLINE) string srcfile(FILENAMESIZE) "src/" character lrfile(FILENAMESIZE) # lrgen input filename character stfile(FILENAMESIZE) # standard output filename integer ycind # yaclr argument string index integer lrind # lrgen argument string index integer scind # source file name index integer rcind # rc argument string index integer i string lrseed "lrg" # used to create lrgen input file string stseed "std" # used to create stdout file string rcpath "/usr/bin/rc" #ratfor compiler searchpath string ycpath "/usr/bin/yaclr" #yaclr search path string lrpath "/usr/bin/lrgen" #lrgen search path string dotr ".r" # source file name suffix character ycargs(MAXLINE) # yaclr argument string character rcargs(MAXLINE) # rc argument string string lrargs(MAXLINE) "<" # lrgen argument string string lflag "-l " # rc listing flag string sflag "-s " # yaclr src file output flag string pflag "-p " # parse debug flag string parslb "yyplb " # parse library string errstr "??" # errout redirection string stdstr ">" # stdout redirection string stdapp ">>" # stdout redirection string newstr " " # spawn argument seperator string noycspwn "yacc: couldn't spawn to yaclr command." string badycspwn "yacc: yaclr aborted." string nolrspwn "yacc: couldn't spawn to lrgen command." string badlrspwn "yacc: lrgen aborted." string norcspwn "yacc: couldn't spawn to rc command." string badrcspwn "yacc: rc aborted." string usage "yacc [-lvprs] file [libraries ...]" rcind = 1 ycind = 1 lrind = 2 liplist = NO lrlist = NO srcflag = NO rclist = NO ### process command line arguments if ( getarg( 1, arg, MAXLINE ) == EOF ) call error( usage ) i = 2 while ( arg(1) == '-' ) # get all flags { switch ( arg(i) ) { case 'e': # parse stk size specifd call stcopy( arg, 1, ycargs, ycind ) # pass flag to yaclr ycargs(ycind) = '@n' # spawn argument seprator ycind = ycind + 1 call delarg( 1 ) # get next argument if ( getarg( 1, arg, MAXLINE ) == EOF ) call error( usage ) i = 1 case 'p': call stcopy( pflag, 1, ycargs, ycind ) case 'l': liplist = YES # lip listing on case 'v': lrlist = YES # lrgen listing on call stcopy(lflag, 1, ycargs, ycind) # add -l to yc args case 's': srcflag = YES # keep source around case 'r': rclist = YES # rat4 listing wanted call stcopy(lflag, 1, rcargs, rcind) # add -l flag to rc args case EOS: call delarg(1) if ( getarg( 1, arg, MAXLINE ) == EOF ) call error( usage ) i = 1 default: # copy unknown flag to rc's args rcargs(rcind) = '-' rcargs(rcind+1) = arg(i) rcargs(rcind+2) = '@n' rcind = rcind + 3 } i = i + 1 } ### create standard output scratch file call mkuniq( stseed, stfile ) # truncate scratch file name if any semicolons found for ( i = 1; stfile(i) != EOS & stfile(i) != ';'; i = i + 1 ) ; stfile(i) = EOS ### create yaclr output and lrgen input scratch file name call mkuniq( lrseed, lrfile ) # truncate scratch file name if any semicolons found for ( i = 1; lrfile(i) != EOS & lrfile(i) != ';'; i = i + 1 ) ; lrfile(i) = EOS ### create source file name by appending arg's last simple name to "src/" call delarg(1) scind = 5 for ( i = lastsn(arg); arg(i) != EOS & arg(i) != '.'; i = i + 1 ) { srcfile(scind) = arg(i) scind = scind + 1 } call scopy( dotr, 1, srcfile, scind ) # append .r to src name ### if listing wanted, create and spawn to lip command if ( liplist == YES ) call mklist( arg, stfile, liplist ) ##################################################################### ### create yaclr arguments and spawn to yaclr. ### ### yaclr [-l] [-p] -s "srcfile" > "lrfile" ### call stcopy( sflag, 1, ycargs, ycind ) # copy -s flag to yaclr call stcopy( srcfile, 1, ycargs, ycind ) # copy src file name call stcopy( newstr, 1, ycargs, ycind ) # copy arg seperator call stcopy( arg, 1, ycargs, ycind ) # copy grammar file name call stcopy( newstr, 1, ycargs, ycind ) call stcopy( stdstr, 1, ycargs, ycind ) # copy stdout redirection call stcopy( lrfile, 1, ycargs, ycind ) # copy scratch file name call stcopy( newstr, 1, ycargs, ycind ) spwnstatus = spawn( ycpath, ycargs, desc, WAIT ) if ( spwnstatus != OK ) { call remove( lrfile ) call remove( stfile ) if ( spwnstatus == ERR ) call error( noycspwn ) else call error( badycspwn ) } ############################################################### ### create lrgen arguments and spawn to lrgen ### ### lrgen < "lrfile" [? "stfile"] >> "srcfile" ### call stcopy( lrfile, 1, lrargs, lrind ) # copy yaclr output call stcopy( newstr, 1, lrargs, lrind ) if ( lrlist == YES ) # lrgen listing wanted { call stcopy( errstr, 1, lrargs, lrind ) # copy errout redirction call stcopy( stfile, 1, lrargs, lrind ) # copy scratch file name call stcopy( newstr, 1, lrargs, lrind ) } call stcopy( stdapp, 1, lrargs, lrind ) # copy stdout append call stcopy( srcfile, 1, lrargs, lrind ) # copy src file name call stcopy( newstr, 1, lrargs, lrind ) spwnstatus = spawn( lrpath, lrargs, desc, WAIT ) if ( spwnstatus != OK ) { call remove( lrfile ) # remove it call remove( stfile ) if ( spwnstatus == ERR ) call error( nolrspwn ) # fatal error else call error( badlrspwn ) } ### build rc command, using rest of command arguments as library names call stcopy( srcfile, 1, rcargs, rcind ) # copy src file name call stcopy( newstr, 1, rcargs, rcind ) call stcopy( parslb, 1, rcargs, rcind ) # copy parse library name while ( getarg( 1, arg, MAXLINE ) != EOF ) # get library names { call delarg(1) call stcopy( arg, 1, rcargs, rcind ) # copy library name call stcopy( newstr, 1, rcargs, rcind ) } if ( rclist == YES ) # rat4 listing wanted { call stcopy( stdapp, 1, rcargs, rcind ) # stdout redirection call stcopy( stfile, 1, rcargs, rcind ) # scratch file name call stcopy( newstr, 1, rcargs, rcind ) } spwnstatus = spawn( rcpath, rcargs, desc, WAIT ) if ( spwnstatus == ERR ) { rclist = NO call remark( norcspwn ) # not a fatal error } else if ( spwnstatus == CHILD_ERROR ) { rclist = NO call remark( badrcspwn ) } ### if source file not wanted, remove it if ( srcflag == NO ) call remove( srcfile ) ### if any listings wanted, output scratch file and remove it if ( lrlist == YES | rclist == YES | liplist == YES ) { stdlfn = open( stfile, READ ) # open the file for read if ( stdlfn == ERR ) call cant( stfile ) while ( getlin( arg, stdlfn ) != EOF ) # read a line call putlin( arg, STDOUT ) # write a line to STDOUT } call remove( stfile ) call remove( lrfile ) DRETURN end ### mklist - spawn to lip to list input file # # synopsis: # call mklist( arg, stfile, liplist ) # subroutine mklist( arg, stfile, liplist ) character arg(ARB), stfile(ARB) integer liplist character lipargs(MAXLINE) # lip argument string character desc(PIDSIZE) # process id returned by spawn integer lipind # lip argument string index integer spwnstatus # status returned by spawn() integer spawn, i string lippath "/usr/bin/lip" # lip search path string nolipspwn "yacc: couldn't spawn to lip command." string badlipspwn "yacc: lip aborted." string newstr " " string stdstr ">" lipind = 1 call stcopy( arg, 1, lipargs, lipind ) # copy file name call stcopy( newstr, 1, lipargs, lipind ) call stcopy( stdstr, 1, lipargs, lipind ) # copy stdout redirection call stcopy( stfile, 1, lipargs, lipind ) # copy scratch file name spwnstatus = spawn( lippath, lipargs, desc, WAIT ) if ( spwnstatus == ERR ) { liplist = NO call remark( nolipspwn ) # not fatal error } else if ( spwnstatus == CHILD_ERROR ) { liplist = NO call remark( badlipspwn ) } return end #-t- yacc 13391 ascii 15-Jan-84 20:58:24 #-h- lastsn 908 ascii 15-Jan-84 21:00:37 ### lastsn - get the last simple name from a full pathname # # synopsis # ptr = lastsn( fname ) # # passed # fname: character array of file name # # returned # ptr; integer pointer to position of first character of the last # simple name in the file name # # examples # ( "xxx.yyy;zzz" ) --> 1 # ( "xxx/yyy" ) --> 5 # ( "/xxx/yyy/zzz" ) --> 10 # ( "[.xxx]yyy" ) --> 7 # ( "www:[xxx.yyy]zzz" ) --> 14 # ( "xxx:yyy" ) --> 5 integer function lastsn( s ) # return an index into s of the last simple name of the full # pathname. Note that the pathname in s # can be either a files 11 file name or a st file name. integer i, length character s( ARB ) # find end of filename, march backwards... for( i = length( s ); i > 0; i = i - 1 ) { if( (s(i) == '/') | (s(i) == ']') | (s(i) == ':') ) break # found beginning of file name } return( i + 1 ) end #-t- lastsn 908 ascii 15-Jan-84 21:00:37 #-t- yacc.all 18389 ascii 15-Jan-84 21:01:10 #-h- yaclr.all 38931 ascii 07Jan84 11:52:39 #-h- yaclr.doc 7053 ascii 05Jan84 08:15:30 .pl 64 .m1 2 .m2 3 .m3 3 .m4 3 .po 10 .rm 62 .bp 1 .in 0 .he ^yaclr(1)^%^yaclr(1)^ .fo ^^- # -^^ .in 5 .sp .ne 2 .fi .ti -5 NAME .br yaclr - translates yacc source to lrgen source .sp .ne 2 .fi .ti -5 SYNOPSIS .br .nf yaclr [-l] [-p] [-e] [-s sfile] gfile .sp .ne 2 .fi .ti -5 DESCRIPTION .br Yaclr translates a yacc grammar specification into one accepted by the .ul lrgen tool. If no input is given, or the filename '-' appears, the standard input will be read. The '-l' flag causes yaclr to output a control character with the lrgen grammar which signals the lrgen tool to produce a listing containing the following information: .ne 3 .sp .in +6 .ta 5r .ti -6 - the lrgen grammar symbols and their definitions'. .in -6 .ne 3 .sp .in +6 .ta 5r .ti -6 - the grammar productions in BNF format. .in -6 .ne 3 .sp .in +6 .ta 5r .ti -6 - a vocabulary cross-reference. .in -6 .ne 3 .sp .in +6 .ta 5r .ti -6 - the configuration sets used to build the LR parse tables which drive the generated LR parser, along with a listing of all the conflicts for each state, even though these conflicts may have been resolved by precedence and associativity declarations. .in -6 .ne 3 .sp The '-p' flag causes yaclr to output a different control character, which causes lrgen to set a flag in the generated parser to put it into debug mode. This means that while the generated parser is parsing, a listing of the shifts and reduces being performed will be written to error output, along with the relevant parse stacks. .ne 3 .sp The '-e' flag is used to specify the stack sizes for the parser, for example, '-e50' would set the stack sizes to 50. If no stack size is set, a default size is used. .ne 3 .sp The '-s' flag causes yaclr to output the semantic routine and the programs section to the file "sfile". Otherwise this code is output to standard output along with the lrgen grammar. .ne 3 .sp A yacc grammar specification consists of three sections: declarations, grammar rules, and programs. The sections are seperated by double percent '%%' marks. A full grammar specification would look like: .sp .nf .in +4 declarations %% rules %% programs .sp .fi .in -4 Blanks, tabs, and newlines are ignored, except that they may not appear in any nonterminal or terminal (token) names. Comments are allowed in the specification, they begin with '#', as in ratfor. All special characters described here must be delimited by blanks or tabs. .ne 3 .sp The declarations section can contain any combination of token declarations and semantic declarations or definitions. Tokens must be declared in the declarations section using one of the four keywords; .bd %token, %left, %right, or .bd %nonassoc. See the manual entry, yc(T), for further explanations of these keywords. Token names, as well as nonterminal names, may be of arbitrary length, and may be made up of letters, dot ".", underscore "_", and non-initial digits. Upper and lower case letters are not distinct. The token definitions, or numbers, can be chosen by yaclr or by the user. .ne 3 .sp To assign a token number to a token, the first appearance of the token name in the declarations section can be immediately followed by a nonnegative integer. This integer is taken to be the token number of the name. Names not defined by this mechanism will get a default token number, chosen by yaclr. These default numbers start at 258. Any literals (single characters enclosed in single quotes), found in the productions are categorized as terminals. Their default token number is the numerical value of the literal character in ascii. The atsign "@" is an escape character for literals. The following escaped literals are recognized: .sp .nf .in +4 '@n' newline '@r' return '@@' atsign '@t' tab '@b' backspace '@f' formfeed '@'' single qoute '@c' c, where c is any other character .sp .fi .in -4 .ne 3 .sp Semantic declarations and definitions can also appear in the declarations section. They must be enclosed in the marks "%{" and "%}". For example, .sp .nf .in +4 %{ include symbols #tools definitions integer ctoi #converts char to integer integer getlin #gets next line %} .sp .fi .in -4 could be placed in the declarations section. These declarations and definitions are made known to all of the semantic actions specified in the rules section. Thus, in the above example, the definitions in the include file 'symbols' and the functions 'ctoi' and 'getlin' would be defined for all of the semantic actions specified. Yaclr's parser uses names beginning with 'yy'; the semantic code should avoid such names. .ne 3 .sp The rules section is made up of one or more grammar rules. A grammar rule has the form: .sp .nf .in +4 LHS : BODY ; .sp .fi .in -4 LHS represents a nonterminal name, and BODY represents a sequence of zero or more terminals, (tokens), and nonterminals. All grammar rules having the same left hand side must be grouped together using the vertical bar '|': .sp .nf .in +4 A : B C D | E F | G ; .sp .fi .in -4 With each grammar rule, the user may associate a semantic action to be performed each time the rule is recognized by the parser. Each action must be surrounded by two lines, the first line containing the mark '%{', and the last line containing the mark '%}'. These actions may return values and may obtain values from previous actions. An action is any legal ratfor statement and as such can do input and output, call subroutines and functions, and alter variables. For example, .sp .nf .in +4 A : YYY ZZZ %{ #THIS IS AN ACTION i = i + 1 call putdec( i, 10 ) %} .sp .fi .in -4 To make an action return a value to the parser, set the psuedo-variable '$$' to the value. For example, if for some rule you only wanted to return the value 1, follow the rule with the action .sp .nf .in +4 %{ $$ = 1 %} .sp .fi .in -4 To obtain values returned by previous actions, use the psuedo-variables '$1', '$2', ..., which refer to the values returned by the parts of the right hand side of the rule, from left to right. Thus, if the rule is .sp .nf .in +4 expression : term '+' factor %{ $$ = $1 + $3 %} .sp .fi .in -4 then '$1' has the value returned by the semantic action for 'term', and '$3' for 'factor'. The value returned for 'expression' would be '$$', or the result of adding '$1' and '$3'. By default, the value of a rule is the value of the first element on the right hand side, i.e $1. All values are assumed to be integer. .ne 3 .sp The last section contains ratfor subroutines and functions. This section is optional. It will probably contain such user-supplied routines as the lexical analyzer, yylex, and the main program which will drive the generated parser, yyparse. .sp .ne 2 .fi .ti -5 FILES .br none .sp .ne 2 .fi .ti -5 SEE ALSO .br .nf "Yacc: Yet Another Compiler-Compiler" by S. C. Johnson "LR - Automatic Parser Generator and LR(1) Parser" by C. Wetherell and A. Shannon. yc(T), yacc(1), lrgen(1), yyplb(2) .sp .ne 2 .fi .ti -5 AUTHOR(S) .br Theresa Breckon #-t- yaclr.doc 7053 ascii 05Jan84 08:15:30 #-h- yaclr.inc 1565 ascii 05Jan84 08:15:31 #-h- yypdef 149 ascii 05Jan84 08:14:12 ### yypdef - definitions for parse subroutines define(YYSTDEFAULT,25) define(YYENDTOK,0) define(YYERROR,-1) define(YYERRTRAN,-2) define(YYNOTRAN,0) #-t- yypdef 149 ascii 05Jan84 08:14:12 #-h- ylincom 1156 ascii 05Jan84 08:14:12 ### ylincom - include file containing input common for yaclr integer yymaxstack #maximum parse stack size integer ynewln #flag for new line integer lrlist #flag for lrgen listing integer dbg #flag for parse debug listing integer toklfn #logical name for token scratch file integer rullfn #logical name for rule scratch file integer litfound(MAXLIT) #array flags if literal was found integer grlfn #grammar file logical name character tokname(MAXLINE) #token scratch file name character rulname(MAXLINE) #rule scratch file name integer ylinct #input line count integer yind #input line index character yline(MAXLINE) #input line integer tokdefault #current default definition used common /ylincom/ ylinct, yind, yline, tokdefault, lrlist, toklfn, dbg, rullfn, grlfn, tokname, rulname, ynewln, litfound, yymaxstack #-t- ylincom 1156 ascii 05Jan84 08:14:12 #-t- yaclr.inc 1565 ascii 05Jan84 08:15:31 #-h- yaclr 29923 ascii 05Jan84 08:15:32 ### yaclr - translates yacc source to lr source # # MODIFICATION HISTORY # -------------------- # 03d vp 24Aug83 Ratfixed # Removed generation of "include symbols" statement # Changed call to unique to mkuniq # 03c ant 01jun83 Changed the subroutine name scratf to unique. # 03b tab 16mar83 Added newline and declaration of yysta to be output # at the end of string 'int1' in routine 'addswitch'. # 03a tab 07jan83 Changed escape character from '/' to '@'. # Changed open of -s file to a create. # 02b tab 17dec82 Moved block data to be printed after printing all # semantics, placed parse stack commons in yysem # printout, all this so code is portable on MODCRAP. # 02a tab 21oct82 Added -e flag. Added break after reading in file name. # Added -s flag so semantics wasn't always written # to STDOUT. # 01e tab 27Aug82 added token declaration for yyerror. # 01d tab 30jul82 changed to allow literals in decl section, added # associativity controls to declaration section. # 01c tab 16jul82 added removal of scratch files, switched end semantics # from '}%' to '%}'. deleted input echo flag # 01c tab 14jul82 combined output of semantics, tokens, and rules. # 01b tab 06Jul82 added rest of flags. added brackets to literals. # 01a tab 03Jun82 written # # SYNOPSIS # -------- # yaclr [-l] [-p] [-e] [-s sfile] [grfile] # # -l: set lrgen flag for listing # -p: set lrgen flag for parser debug listing # -e: set parser stack sizes to 'n' # -s: src file, "sfile", specified # # grfile - input file containing yacc grammar # sfile - If specified, where the semantics and user-supplied # routines are output to. # # DESCRIPTION # ----------- # Yaclr reads the yacc source from 'grfile'. If no grammar file # is specified or '-' is, the yacc source is read from STDIN. # The translated LR grammar is written to STDOUT. # If a src file is specified with the -s flag, the semantic routine # and any user-supplied routines from the grammar input are output # to "sfile", otherwise they are ouput to STDOUT. # # The parse library common data is initialized in a block data statement # which YACLR outputs, along with the semantic routine. If the '-e' flag # is specified, the parse stacks are dimensioned to be 'n' instead of # the default stack size # # # include yypdef define(TOKEN,1) #identifier for token input section define(SEMBEGIN,2) #identifier for semantics, '%{' define(ENDSECTION,3) #identifier for end of section, '%%' define(STARTDEF,259) #start of default token definitions define(ARETURN,13) #ascii for return, or control-M define(FORMFEED,12) #ascii for formfeed or control-L define(MAXLIT,300) DRIVER(yaclr) include ylincom integer getarg #gets arguments from command line character arg(MAXLINE) integer srclfn #index for source file integer open, ctoi, create string usage "yaclr [-e] [-l] [-p] [-s sfile] grfile" grlfn = STDIN srclfn = STDOUT #default for semantic output yymaxstack = YYSTDEFAULT #default for parse stack sizes lrlist = NO dbg = NO # get all arguments from command line while ( getarg( 1, arg, MAXLINE ) != EOF ) { call delarg( 1 ) #delete the current argument switch ( arg(1) ) { case '-': #check for listing flags switch ( arg(2) ) { case 'e': #parse stack size specified i = 3 yymaxstack = ctoi( arg, i ) case 's': #source file specified if ( getarg( 1, arg, MAXLINE ) == EOF ) call error( usage ) srclfn = create( arg, WRITE ) if ( srclfn == ERR ) call cant( arg ) call delarg( 1 ) case 'l': #lrgen listing wanted lrlist = YES case 'p': dbg = YES case EOS:; #STDIN input file default: call error( usage ) #unimplemented flag } default: #should be grammar file grlfn = open( arg, READ ) if ( grlfn == ERR ) call cant( arg ) break } } call inpinit #initialize input parameters call decls( srclfn ) #process declarations call rules( srclfn ) #process rules section call output( srclfn ) #output transformation DRETURN end ### addswitch - add switch statement to semantic routine # # SYNOPSIS # -------- # call addswitch( srclfn ) # # subroutine addswitch( srclfn ) integer srclfn include ylincom string int1 "integer yysta, yytok, yyval, yyerrok, yyerct, yylexval@n" string int2 "integer yymaxstack, yystkp, yysstk, yyvstk, yytstk@N" string mi1str "common /yymicm/ yyval, yytok, yyerrok, yysta,@N" string mi2str "yystkp, yymaxstack, yylexval, yyerct@N" string scm "common /yysscm/ yysstk(" string tcm ")@ncommon /yytscm/ yytstk(" string vcm ")@ncommon /yyvscm/ yyvstk(" string swistr ")@n switch ( yyprod )@n" string brstr " {@n" call putlin( int1, srclfn ) call putlin( int2, srclfn ) call putlin( mi1str, srclfn ) call putlin( mi2str, srclfn ) call putlin( scm, srclfn ) call putint( yymaxstack, 10, srclfn ) call putlin( tcm, srclfn ) call putint( yymaxstack, 10, srclfn ) call putlin( vcm, srclfn ) call putint( yymaxstack, 10, srclfn ) call putlin( swistr, srclfn ) call putlin( brstr, srclfn ) return end ### brackit - put brackets around literal and output to specified file # # call brackit( lfn ) # # lfn - specified logical file name # subroutine brackit( lfn ) integer lfn include ylincom character c string litbeg " <" string slastr " <\" string litend "> " string andstr " &" c = yline(yind+1) switch( c ) { case '>', '<', '&': call putlin( andstr, lfn ) call putch( c, lfn ) call putch( ' ', lfn ) case '@@': call putlin( slastr, lfn ) call putch( yline(yind+2), lfn ) call putlin( litend, lfn ) default: call putlin( litbeg, lfn ) call putch( c, lfn ) call putlin( litend, lfn ) } return end ### decls - processes declarations section of yacc source # # SYNOPSIS # -------- # call decls( srclfn ) # # subroutine decls( srclfn ) integer srclfn include ylincom string badchar "Bad control char in declaration section." integer section #returns next section type string lreop " &P@n" string decleof "yaclr: unexpected EOF found in declaration section." string errtok "@n%token yyerror " call seminit( srclfn ) #initialize semantic routine call putlin( errtok, toklfn ) #error token declaration call putint( YYERROR, 5, toklfn ) call putch( '@n', toklfn ) repeat { call getsection( section ) #get type of next line switch ( section ) { case TOKEN: #list of tokens call tokenline #process them case SEMBEGIN: #semantic code call semantics( srclfn ) #output semantic declarations case ENDSECTION: #end of declaration section return case EOF: call fatal( decleof ) #unexpected EOF default: call syntxerr( badchar ) call getyline } } return end ### fatal - print message, remove scratch files and abort # # call fatal( messg ) # subroutine fatal( messg ) character messg(MAXLINE) include ylincom call remove( tokname ) #remove token scratch file call remove( rulname ) #remove rules scratch file call error( messg ) return end ### fileout - output file to standard output # # call fileout( lfn, fname ) # lfn - logical file name # fname - name of file to output # subroutine fileout( lfn, fname ) integer lfn character fname(MAXLINE) integer open, getlin character line(MAXLINE) call close( lfn ) #close file lfn = open( fname, READ ) #open scratch for read while ( getlin( line, lfn ) != EOF ) call putlin( line, STDOUT ) return end ### getasc - returns ascii value for literal # # sts = getasc( asc ) # sts - OK if legal literal, ERR otherwise # asc - computed ascii value for literal # integer function getasc( asc ) integer asc include ylincom string noendq "no end quote found after literal character" string unknwnesc "unrecognized escaped literal character" getasc = OK switch ( yline(yind+1) ) #literal char or back slash { case '@@': if ( yline(yind+3) != '@'' ) #no end quote { getasc = ERR call syntxerr( noendq ) } else switch ( yline(yind+2) ) #escaped literals { case 'n': #newline asc = '@n' case 'r': #return asc = ARETURN case 't': #tab character asc = '@t' case 'b': #backspace character asc = '@b' case 'f': #formfeed asc = FORMFEED default: asc = yline(yind+2) #return escaped character } default: if ( yline(yind+2) != '@'' ) { getasc = ERR call syntxerr( noendq ) } else asc = yline(yind+1) #MAY NOT BE PORTABLE } return end ### getsection - determines type of next section of input # # SYNOPSIS # -------- # call getsection( section ) # # section - type of next section # # DESCRIPTION # ----------- # Checks the current characters of the current line to determine # the type of section. The three sections checked for are TOKEN, ( '%token', # '%left', '%right', and '%nonassoc' ), # SEMBEGIN, ('%{'), and ENDSECTION, ('%%'). # subroutine getsection( section ) integer section include ylincom integer sequal #tests if strings are equal string tokstr "%token" string rigstr "%right" string lefstr "%left" string nonstr "%nonassoc" string semstr "%{" string endstr "%%" if ( yline(yind) == EOF ) section = EOF else if ( sequal( yline(yind), semstr ) == YES ) section = SEMBEGIN else if ( sequal( yline(yind), endstr ) == YES ) section = ENDSECTION else if ( sequal( yline(yind), tokstr ) == YES | sequal( yline(yind), rigstr ) == YES | sequal( yline(yind), lefstr ) == YES | sequal( yline(yind), nonstr ) == YES ) section = TOKEN else section = ERR return end ### getword - get next word from input # # call getword # # Increments line index to next non-blank character. Skips over blank # lines. subroutine getword include ylincom if ( yline(yind) != EOF ) { #skip over current word for ( ; yline(yind) != '@t' & yline(yind) != '@n' & yline(yind) != EOS & yline(yind) != ' '; yind = yind + 1 ); call skipbl( yline, yind ) #skip the blanks #get the next non-blank line if ( yline(yind) == EOS | yline(yind) == '@n' | yline(yind) == '#' ) call getyline } return end ### getyline - get next non-empty line from input # # call getyline subroutine getyline include ylincom integer getlin ynewln = YES #set newline flag yline(yind) = EOS while ( yline(yind) == EOS | yline(yind) == '@n' | yline(yind) == '#' ) { yind = 1 if ( getlin( yline, grlfn ) == EOF ) yline(yind) = EOF else { ylinct = ylinct + 1 call skipbl( yline, yind ) } } return end ### inpinit - initialize input data structures # # call inpinit # subroutine inpinit include ylincom integer create string rseed "rul" string tseed "tok" string lsinput "&R &X@n" string dbchar "&3@n" for ( i = 1; i <= MAXLIT; i = i + 1 ) #fill literal array with NOs litfound(i) = NO tokdefault = STARTDEF #default definitions for terminals ylinct = 0 #input line count yind = 1 call getyline #get first non-empty input line #create scratch file for productions call mkuniq( rseed, rulname ) rullfn = create( rulname, WRITE ) if ( rullfn == ERR ) call cant( rulname ) #create scratch file for tokens call mkuniq( tseed, tokname ) toklfn = create( tokname, WRITE ) if ( toklfn == ERR ) { call remove( rulname ) #remove rules scratch file call cant( tokname ) } if ( lrlist == YES ) #if lrgen listing requested call putlin( lsinput, toklfn ) #output control chars if ( dbg == YES ) #if parser debug wanted call putlin( dbchar, toklfn ) #output control chars return end ### output - output results to standard output # # call output( srclfn ) # # Output user-defined routines, token definitions, and production rules # to the file pointed to by the index, "srclfn". # subroutine output( srclfn ) integer srclfn include ylincom integer getlin character line(MAXLINE) string lreop "@n&P@n" string lreog "@n&G@n" call semend( srclfn ) #end semantic routine #output user-supplied semantic routines to standard output if ( yline(yind) != EOF ) while ( getlin( line, grlfn ) != EOF ) call putlin( line, srclfn ) ### output parse block data statements call separse( srclfn ) call putlin( lreog, rullfn ) #output end of grammar call putlin( lreop, toklfn ) #same for tokens call fileout( toklfn, tokname ) #output token defs call fileout( rullfn, rulname ) #output rules call remove ( tokname ) #remove token scratch file call remove ( rulname ) #remove rules scratch file return end ### putliteral - outputs literal to token file and to production file # # call putliteral # # The literal and it's ascii value are output to the token file as a # token and it's definition, respectively. The literal is also # output to the rules file, since it was encountered in the productions subroutine putliteral include ylincom integer asc #integer conversion of literal integer getasc #computes ascii value of literal string tokstr "@n%token " if ( getasc( asc ) == OK ) #get ascii value for literal { if ( litfound( asc ) == NO ) #literal not defined in decls { #output literal and its ascii value to token list litfound(asc) = YES #mark literal as defined call putlin( tokstr, toklfn ) call brackit( toklfn ) call putint( asc, 5, toklfn ) #output ascii value } #output literal to production file call brackit( rullfn ) } call getword #read past literal return end ### putvstk - outputs array element corresponding to the current '$n' # # call putvstk( length, srclfn ) # length - length of productions right hand side # srclfn - index of file to output to # # Outputs " yyvstk(yystkp - 'n') " to "srclfn", where 'n' # corresponds to the $n's place on the stack subroutine putvstk( length, srclfn ) integer length, srclfn include ylincom integer n #'n' in '$n' integer i, ctoi string stkstr "yyvstk(yystkp" string paren ") " i = yind + 1 #where 'n' is in yline n = ctoi( yline, i ) - length #convert 'n' to integer call putlin( stkstr, srclfn ) if ( n != 0 ) #not top of stack call putint( n, 3, srclfn ) call putlin( paren, srclfn ) return end ### putword - ouputs current input word to specified lfn # # call putword( lfn ) # # After ouputting the word, PUTWORD positions the input line index # to the first character of the next input word and also # outputs any delimiter characters found subroutine putword( lfn ) integer lfn include ylincom if ( yline(yind) == EOF ) return #output ascii word for ( ; yline(yind) != EOS & yline(yind) != '@n' & yline(yind) != '@t' & yline(yind) != ' '; yind = yind + 1 ) call putch( yline(yind), lfn ) #output delimiters for ( ; yline(yind) == ' ' | yline(yind) == '@t'; yind = yind + 1 ) call putch( yline(yind), lfn ) #check for blank lines if ( yline(yind) == EOS | yline(yind) == '@n' ) { call putch( '@n', lfn ) call getyline #get next non-blank line } return end ### rules - process rules section of yacc source file # # SYNOPSIS # -------- # call rules( srclfn ) # # # DESCRIPTION # ----------- # Output processed rules to scratch file. Output any literals to token # scratch file so they will be with the rest of the tokens. Convert all # '$$'s to 'yyval'. Convert all '$n's to 'yystk(yystkp - length + n)'. # subroutine rules( srclfn ) integer srclfn include ylincom integer prodnum #number of current production integer length #length of current right hand side string lreop " &P@n" string lreog " &G@n" string lralt " &A@n" prodnum = 1 #number of current production length = 0 #length of current RHS call addswitch( srclfn ) #add switch stmnt to semantics call getyline #get next input line #process rules section looking for key characters repeat { switch ( yline(yind) ) { case '@'': call putliteral #process literal token length = length + 1 case ':': #new left hand side prodnum = prodnum + 1 #another production length = 0 #new Right Hand Side call getword #get next input word case '|': #alternate production prodnum = prodnum + 1 length = 0 call putlin( lralt, rullfn ) #output LR's alternate char call getword #get next input word case ';': #end of production call putlin( lreop, rullfn ) #output LR's end production char call getword #get next input word case '%': if ( yline(yind+1) == '{' ) #semantic section call semcase( prodnum, length, srclfn ) else if ( yline(yind+1) == '%' ) #end of rules section return else { call syntxerr( "illegal character after percent sign." ) call getword } case EOF: return default: length = length + 1 #assume grammar word call putword( rullfn ) #output word } } return end ### semantics - output semantic declarations to semantic file # # call semantics( srclfn ) # # If semantics requested, words are output to "srclfn" until '}%' found # otherwise, the words are skipped up to and including '}%'. subroutine semantics( srclfn ) integer srclfn include ylincom call getword #get first word #process code until end of semantics reached, '}%' while ( ( yline(yind) != '%' | yline(yind+1) != '}' ) & yline(yind) != EOF ) call putword( srclfn ) call getword #read past '}%' return end ### semcase - output a case statement for the semantic routine # # SYNOPSIS # -------- # call semcase( prodnum, length, srclfn ) # prodnum - production number to do the case test on # subroutine semcase( prodnum, length, srclfn ) integer prodnum, length, srclfn include ylincom integer index #checks character set membership character str(10) #string to hold production number string yyvstr "yyval " string headst " " string digits "0123456789" string casestr "@n case " string colonstr ":@n" #output the 'case X:' line call putlin( casestr, srclfn ) call putint( prodnum, 10, srclfn ) call putlin( colonstr, srclfn ) call getword #get next input word #pass through semantic code looking for significant characters repeat { if ( ynewln == YES ) #check for newline { call putlin( headst, srclfn ) #output indentation ynewln = NO #reset newline flag } switch ( yline(yind) ) { case '$': #look for '$$'s and '$n's if ( yline(yind+1) == '$' ) #found '$$' { call putlin( yyvstr, srclfn ) #output 'yyval' yind = yind + 2 #read past $$ } else if ( index( digits, yline(yind+1) ) != 0 ) { #found a '$n' call putvstk(length, srclfn) #output array element #read past $n for ( yind = yind + 2; index( digits, yline(yind) ) != 0; yind = yind + 1 ) ; } else { call putch( yline(yind), srclfn ) yind = yind + 1 } case '%': #end of semantic code if ( yline(yind+1) == '}' ) { call getword #read past '}%' call putch( '@n', srclfn ) return } else { call putch( yline(yind), srclfn ) yind = yind + 1 } case '@n', EOS: call putword( srclfn ) #output newline default: { call putch( yline(yind), srclfn ) yind = yind + 1 } } } return end ### semend - add end statements to semantic routine # # SYNOPSIS # -------- # call semend( srclfn ) # # subroutine semend( srclfn ) integer srclfn string defstr "@n default:;@n" string brstr " }@n" string retstr "@nreturn@n" string endstr "end@n" call putlin( defstr, srclfn ) call putlin( brstr, srclfn ) call putlin( retstr, srclfn ) call putlin( endstr, srclfn ) return end ### seminit - initialize semantics routine in semantics file # # SYNOPSIS # -------- # call seminit( srclfn ) # # This routine outputs the block data statement to initialize the parse # common variables. It also outputs the beginning of the semantic routine. # subroutine seminit( srclfn ) integer srclfn string semincl "@ninclude yypdef@n" string semsub "@nsubroutine yysem( yyprod )@n" string prdecl "integer yyprod@n" call putlin( semincl, srclfn ) call putlin( semsub, srclfn ) call putlin( prdecl, srclfn ) return end ### separse - print parse block data statement # subroutine separse( srclfn ) integer srclfn include ylincom string blk "block data@N" string int1 "integer yyerrok, yylexval, yymaxstack, yystkp@N" string int2 "integer yysta, yytok, yyval, yyerct@N" string micm "common /yymicm/ yyval, yytok, yyerrok, yysta, yystkp,@N" string m2cm "yymaxstack, yylexval, yyerct@n" string d1 "data yystkp, yymaxstack /1," string d3 "/@Ndata yyerrok, yyval, yytok, yysta /NO, 0, YYENDTOK, 1/@Nend@N" call putlin( blk, srclfn ) call putlin( int1, srclfn ) call putlin( int2, srclfn ) call putlin( micm, srclfn ) call putlin( m2cm, srclfn ) call putlin( d1, srclfn ) call putint( yymaxstack, 10, srclfn ) call putlin( d3, srclfn ) return end ### sequal - determine if two strings are equal # # sts = sequal( str1, str2 ) # sts - YES if strings match, NO otherwise # str1 - first string, doesn't contain an EOS # str2 - string with the EOS # integer function sequal( str1, str2 ) character str1(ARB), str2(ARB) integer i sequal = YES for ( i = 1; str2(i) != EOS & sequal == YES; i = i + 1 ) if ( str1(i) != str2(i) ) sequal = NO return end ### syntxerr - print message and line number for syntax error # # SYNOPSIS # -------- # call syntxerr( msg ) # # msg - ascii error message # subroutine syntxerr( msg ) character msg(MAXLINE) include ylincom string linstr "@nLINE " string colstr ": " call putlin( linstr, ERROUT ) call putint( ylinct, 5, ERROUT ) call putlin( colstr, ERROUT ) call putlin( msg, ERROUT ) call putch( '@n', ERROUT ) return end ### tokenline - process line of token declarations # # call tokenline # # Outputs the token keyword ( %token, %left, %right, or %nonassoc ), # and the token names following the keyword. If no # definition follows a token name, then a default definition will be # output, otherwise the specified definition will be output. subroutine tokenline include ylincom integer index #checks for character set membership integer litvalue #ascii value of literal integer getasc #returns the ascii value of a literal character str(MAXLINE) #string for default definition string digits "0123456789" call putword( toklfn ) #get and output the token keyword #process each token name found repeat { if ( yline(yind) == '%' | yline(yind) == EOF ) #end of tokens return if ( yline(yind) == '@'' ) #found a literal { if ( getasc( litvalue ) == OK ) #determine the literal { litfound(litvalue) = YES #mark literal as found call brackit( toklfn ) #output literal call getword #get definition #check for literal definition if ( index( digits, yline(yind) ) != 0 ) call putword( toklfn ) #output definition else #no def specified { call putint( litvalue, 5, toklfn ) #use default value call putch( ' ', toklfn ) } } else #bad literal found call getword #read past it } else { call putword( toklfn ) #output token if ( index( digits, yline(yind) ) != 0 ) #definition found call putword( toklfn ) #output defnition else { tokdefault = tokdefault + 1 call itoc( tokdefault, str, 10 ) #default definitn call putlin( str, toklfn ) call putch( ' ', toklfn ) } } } call putch( '@n', toklfn ) return end #-t- yaclr 29923 ascii 05Jan84 08:15:32 #-t- yaclr.all 38931 ascii 07Jan84 11:52:39 #-h- lrgen.all 61796 ascii 15-Jan-84 21:01:20 #-h- lrgen.doc 1537 ascii 05Jan84 08:18:16 .pl 64 .m1 2 .m2 3 .m3 3 .m4 3 .po 10 .rm 62 .bp 1 .in 0 .he ^lrgen(1)^%^lrgen(1)^ .fo ^^- # -^^ .in 5 .sp .ne 2 .fi .ti -5 NAME .br lrgen - translates LR grammar into parse tables. .sp .ne 2 .fi .ti -5 SYNOPSIS .br .nf lrgen .sp .ne 2 .fi .ti -5 DESCRIPTION .br Lrgen reads a modified LR grammar specification from standard input, and writes to standard output the generated parse tables. The output of yaclr is usually piped to this tool. .ne 3 .sp Input to lrgen is the same as the input to LR, with one extension. See the paper on LR (mentioned in "see also" section) for a full description on LR input. The extension to the LR input consists of an extra section. The sections are seperated by a line containing only the characters "&P". .ne 3 .sp The first section contains token declarations. These declarations look exactly like the yacc token declarations, except literals must be in the LR form, (enclosed in brackets). The second section contains the LR grammar productions. These are as described in the LR paper. .ne 3 .sp The generated parse tables are output as fortran data arrays in common blocks. These tables are meant to be used in conjunction with the parse library, yyplb. .sp .ne 2 .fi .ti -5 FILES .br none .sp .ne 2 .fi .ti -5 SEE ALSO .br .nf yaclr(1), yyplb(2), yc(T), yacc(1) "Yacc: Yet Another Compiler-Compiler" by S.C. Johnson "LR - Automatic Parser Generator and LR(1) Parser" by C. Wetherall and A. Shannon. .sp .ne 2 .fi .ti -5 AUTHOR(S) .br Theresa Breckon .sp .ne 2 .fi .ti -5 BUGS/DEFICIENCIES .br #-t- lrgen.doc 1537 ascii 05Jan84 08:18:16 #-h- lrgen.inc 2609 ascii 05Jan84 08:18:17 #-h- lrgen.c 1737 ascii 05Jan84 08:18:00 ### include file for the tool "lrgen". v01a 5Sep82 VJ #nolist # # MODIFICATION HISTORY # -------------------- # v01c 16sep82 TAB .parameterized array lengths # v01b 09sep82 TAB .declared character arrays to be character, rearranged # to suit MODCOMP's order pickiness # v01a 05sep82 VJ .written integer yydefs, yylastok, yytprec, yyassoc, yyrprec dimension headcs(MAXTOKS), headen(MAXTOKS) integer adequt integer garbag integer grmend, altend, prdend, curlhs, prdptr, curprd integer hashpt integer headcs, headen integer lftuse, rgtuse, frsprd, prodcn, prdind integer lngvcb, lngprd integer qhead, qtail integer scrtch integer sstptr, sthead, shdptr character sstore, linbuf integer thedpt, basis, tran, red integer toggle integer vocab, goal common/adqcom/adequt common/anacom/nxttrn, nxtred, ncsets, listcs, ifinal, indbas, lencsl, lsets common/grmflg/grmend, prdend, altend, curlhs, prdptr, curprd common/lstcom/garbag, lstptr common/qcom/qhead, qtail common/readcm/linbuf(MAXLINE), linptr, lineno common/s1/sstore(MAXTOKCHARS), sthead( arith(MAXTOKS,+,1)) common/s2/hashpt(MAXHASH) common/s3/lftuse(MAXTOKS), rgtuse(MAXTOKS), frsprd(MAXTOKS), nprods(MAXTOKS), prodcn(MAXPRODCHARS), prdind(MAXPRODS), vocab(MAXTOKS) common/s4/item(MAXLISTS), nxt(MAXLISTS) common/s5/nullnt(MAXTOKS), thedpt(MAXTOKS), basis(MAXBASIS), tran(MAXTRANS), red(MAXREDS) common/scrcom/scrtch(MAXSTATESET) common/ystring/sstptr, shdptr common/tabcom/nvoc, numprd, goal, nterms, nstate common/togcom/toggle(256) common/yyddss/yydefs(MAXTOKS), yylastok, yytprec(MAXTOKS), yyassoc(MAXTOKS), yyrprec(MAXTOKS) equivalence(rgtuse(1), headcs(1)), (lftuse(1), headen(1)) #list #-t- lrgen.c 1737 ascii 05Jan84 08:18:00 #-h- lrgdef 612 ascii 05Jan84 08:18:00 ### lrgdef - definitions for lrgen arrays in common, lrgen.c # # MODIFICATION HISTORY # -------------------- # 01c 12jul83 jc .ratfixed # 01b 17dec82 tab .added modification history, reduced MAXBASIS # from 6000 to 5000 # 01a ?????? tab .written # define(LFTANG,'<') define(RGTANG,'>') define(MAXSTATESET,1000) define(MAXTOKS,500) define(MINDEFAULT,259) define(NOTOKEN,arith(MAXTOKS,+,MINDEFAULT)) define(MAXTOKCHARS,2000) define(MAXPRODS,500) define(MAXPRODCHARS,3000) define(MAXHASH,512) define(MAXLISTS,3000) define(MAXBASIS,5000) define(MAXTRANS,3000) define(MAXREDS,3000) #-t- lrgdef 612 ascii 05Jan84 08:18:00 #-t- lrgen.inc 2609 ascii 05Jan84 08:18:17 #-h- lrgen 57256 ascii 15-Jan-84 20:59:15 include lrgdef define(FFEED, 12) # lrgen - generate lr parse table from a BNF grammar. # # (this a ratfor version of the LR parser generator, originally # developed at LLNL and later substantially modified by Theresa # Breckon of LBL-RTSG to conform with UNIX YACC). # # revision history # -------- ------- # v04d dpm 15jan84 .removed "call exit" from between DRETURN and end to # avoid "unreachable statement" compiler diagnostic. # v04c tab 17nov83 .changed ratfor ignore-lines to begin with percent signs. # v04b jic 26jul83 .ratfixed. # v04a tab 20oct82 .deleted call to rdsemn (read semantics) # v03j tab 16sep82 .Parameterized all tables. # v03i tab 07sep82 .fixed little bugs from transformation. "&B" # is no longer allowed for excaped BLANK, since # it never worked in the first place. Changed all IO # to standard tools IO.Deleted GENTAB and TABLEU. # v03h vj 06sep82 .transformed from fortrash to ratfor # v03g tab 01sep82 .allowed tabs in grammar specification. # v03f tab 30aug82 .changed all name of error routine to yyerror # v03e tab 23aug82 .added &3 toggle, to set flag for parser to be in # debug mode. # v03f tab 15jul82 .added call in main to rdsemn to read in semantics. # changed defaults of grammar listing (&r) and xref # listing (&x) to off, made printing of confiq sets # dependent on "&x". DRIVER(lrgen) include "lrgen.c" # # # init intializes the toggle array for the listing options call init # # rdgram reads in the grammar definition from standard input call rdgram # # fndgol finds the start symbol for the user-specified grammar call fndgol # # sortgm sorts the grammar token references alphabetically, # with terminal tokens first, and non-terminals last. call sortgm # # conect checks that all grammar terminals and non-terminals # are connected to the goal symbol. call conect # # ground checks that all non-terminals can be reduced to # some terminal sentence of the grammar. call ground # # toggle n lists the grammar neatly and then quits (initially off) # toggle r lists the grammar neatly (initially off) # if (toggle('N')!=0 | toggle('R')==0) call prntgm # # toggle x causes a cross-reference to be printed (initially off) # if (toggle('X')==0) call xref if (toggle('N')!=0) call exit # # analyz produces the lr parse tables for the grammar call analyz # # pntset checks for conflicts and prints the configuration sets, # if the listing toggle, &x, is set. call pntset # # chncsl chains together the context sets for the transition states. call chncsl # # # ****** warning: the routines which output lrltran tables; gentab, # and which output unformatted tables; tableu, # have been deleted # toggle k outputs the tables in ansi 66 format (initially on) # toggle l outputs the tables unformatted (initially off) # if (toggle('K')!=0) call tablea DRETURN end ### block data statement initializing all the array pointers # block data include "lrgen.c" data adequt/1/ data shdptr/0/ data linptr/1/ data linbuf(1)/'@n'/ data sstptr/0/ data lineno/0/ data garbag/0/,lstptr/0/ data nstate,indbas/0,1/ data nxttrn,nxtred/1,1/ data ncsets/0/ data qhead,qtail/0,0/ data yytprec, yyassoc, yyrprec / MAXTOKS*0, MAXTOKS*0, MAXTOKS*0 / end ### addbas - create the header for a state set # subroutine addbas(iptr,npr,ndot,nset) string msg "BASIS AREA OVERFLOW" include "lrgen.c" # # if (indbas+2>MAXBASIS) call yyerror(msg,19,2) else { basis(iptr+1) = basis(iptr+1)+1 basis(indbas) = npr basis(indbas+1) = ndot basis(indbas+2) = nset item(nset) = item(nset)+1 indbas = indbas+3 } return end subroutine additl(iarg,lptr,ichnge) include "lrgen.c" # # adds the single item iarg into the list pointed to by lptr. # ichnge = 0 last = 0 i = lptr while (i>0) { if (iarg==item(i)) return if (iarg0) { call additl(item(i),lptr2,ichn) if (ichn!=0) ichnge = 1 i = nxt(i) } return end subroutine addred(ibasis,iprod,icntxt,maxr) string msg "REDUCTION ARRAY OVERFLOW" include "lrgen.c" # i = ibasis+(3*basis(ibasis+1))+6 if (basis(i)>=maxr) call yyerror(msg,24,2) else { j = (2*basis(i))+basis(i+1) red(j) = iprod red(j+1) = icntxt basis(i) = basis(i)+1 item(icntxt) = item(icntxt)+1 } return end subroutine addtrn(ibasis,itran,imax) string msg "TRANSITION ARRAY OVERFLOW" include "lrgen.c" # i = ibasis+(3*basis(ibasis+1))+4 if (basis(i)>=imax) call yyerror(msg,25,2) else { ii = basis(i+1)+basis(i) tran(ii) = itran basis(i) = basis(i)+1 } return end subroutine analyz include "lrgen.c" # call fndnul call genthd # do i = 1,nterms headcs(i) = 0 # call newbas(i) call new(nptr) ii = prdind(1) item(nptr) = prodcn(ii+2) call newcs(nptr,n) call addbas(i,1,1,n) call endbas(i) repeat { call complt(i,jmax) call sortcg(jmax) call trnred(i,jmax) call deque(i) } until(i<=0) return end subroutine bildhp include "lrgen.c" # iend = nvoc/2 do i = 1,iend { j = iend-i+1 call hepify(j,nvoc) } return end subroutine bildst(ichar) character ichar string msg "STRING STORAGE OVERFLOW." include "lrgen.c" # sstptr = sstptr+1 if (sstptr>MAXTOKCHARS) call yyerror(msg,24,12) else sstore(sstptr) = ichar return end subroutine chncsl string msg "CHNCSL ERROR" include "lrgen.c" # # find the first context set chain. # lsets = 0 ncsets = 0 do i = 1,nterms if (headcs(i)!=0) go to 10 call yyerror(msg,12,2) 10 call new(nptr) lencsl = nptr listcs = headcs(i) iptr = headcs(i) repeat { ncsets = ncsets+1 ii = item(iptr) item(ii) = ncsets ii = item(iptr) ii = nxt(ii) item(nptr) = lenlst(ii) lsets = lsets+item(nptr) lptr = nptr call new(nxt(nptr)) nptr = nxt(nptr) last = iptr iptr = nxt(iptr) if (iptr==0) { repeat { if (i>=nterms) break 2 i = i+1 } until(headcs(i)!=0) nxt(last) = headcs(i) iptr = headcs(i) } } nxt(lptr) = 0 call rel(nptr) return end subroutine chrcmp(iptr1,iptr2,irslt) character ichar1, ichar2 include "lrgen.c" # ichar1 = sstore(iptr1) ichar2 = sstore(iptr2) irslt = 0 if (ichar1>ichar2) irslt = 1 if (ichar1nterms) { # # generate the context set which is the same for all the immediate # transitions from this production. # call imtrcs(i,iptr) # # add all the un-marked productions with the left hand side equal # to the non-terminal to the right of the dot. union in the new # context set if the production has already been included. # kstart = frsprd(lhs) kend = kstart+nprods(lhs)-1 do k = kstart,kend if (mark(k)!=0) { ii = mark(k) call csun(iptr,scrtch(ii),ich) if (ich!=0) ichang = 1 } else { if (j+3> MAXSTATESET) go to 20 mark(k) = j+3 scrtch(j+1) = k scrtch(j+2) = 1 scrtch(j+3) = iptr item(iptr) = item(iptr)+1 j = j+3 ichang = 1 } # # the call to delete the context set deletes the "extra" reference # to the set and deletes the set completely from the list space if # if it was never referenced. remember that as a result of the call # to imtrcs, iptr had its ref count incremented. # call delcs(iptr) } } i = i+3 } until(i>=j) } until(ichang==0) maxset = j return } 20 call yyerror(msg,27,2) return end ### conect - check if all tokens are connected to the goal symbol # subroutine conect integer stack,cnectd dimension stack(MAXTOKS),cnectd(MAXTOKS) character line(MAXLINE) string hdg "NOT CONNECTED TO GOAL SYMBOL" include "lrgen.c" equivalence(stack(1),scrtch(1)),(cnectd(1),scrtch( arith(MAXTOKS,+,1))) # do i = 1,nvoc cnectd(i) = 0 istkpt = 1 stack(1) = prodcn(1) ii = prodcn(1) cnectd(ii) = 1 repeat { isym = stack(istkpt) istkpt = istkpt-1 if (isym>nterms) { ii = frsprd(isym) ibase = prdind(ii)+1 iend = nprods(isym) do i = 1,iend { if (prodcn(ibase)!=0) { jend = prodcn(ibase) do j = 1,jend { ii = ibase+j jsym = prodcn(ii) if (cnectd(jsym)==0) { cnectd(jsym) = 1 istkpt = istkpt+1 stack(istkpt) = jsym } } } ibase = ibase+prodcn(ibase)+2 } } } until(istkpt<=0) do i = 1,nvoc if (cnectd(i)==0) { j = 1 call movstr(vocab(i),line,j,90) line(j) = ' ' do k = 1,29 { j = j+1 line(j) = hdg(k) } call yyerror(line,j,1) } return end subroutine copyl(lptr1,lptr2) include "lrgen.c" # # copys the list pointed to by lptr1 to a list pointed to by lptr2. # lptr2 = 0 if (lptr1!=0) { call new(nptr) item(nptr) = item(lptr1) last = nptr lptr2 = nptr i = nxt(lptr1) while (i>0) { call new(nptr) item(nptr) = item(i) nxt(last) = nptr last = nptr i = nxt(i) } } return end subroutine csun(iptr1,iptr2,ich) include "lrgen.c" # ich = 0 if (iptr1!=iptr2) { call copyl(nxt(iptr2),head) call addltl(nxt(iptr1),head,ich) call delcs(iptr2) call newcs(head,iptr2) } return end subroutine delcs(iptr) include "lrgen.c" # if (item(iptr)>1) item(iptr) = item(iptr)-1 else { ii = nxt(iptr) ii = item(ii) i = headcs(ii) last = 0 repeat { if (i==0) go to 40 if (item(i)==iptr) break 1 last = i i = nxt(i) } if (last!=0) nxt(last) = nxt(i) else { ii = nxt(iptr) ii = item(ii) headcs(ii) = nxt(i) } nxt(i) = 0 call rel(i) 40 call rel(iptr) } return end subroutine deque(iptr) include "lrgen.c" # iptr = qhead if (qhead!=0) { qhead = basis(qhead+2) basis(iptr+2) = -1 } return end subroutine endbas(iptr) string msg "CONFIGURATION SET OVERFLOW" include "lrgen.c" # indbas = indbas+4 if (indbas>MAXBASIS) call yyerror(msg,26,2) else do i = 1,4 { ii = indbas+i-5 basis(ii) = 0 } return end subroutine endred(ibasis) include "lrgen.c" # i = ibasis + ( 3 * basis(ibasis+1) ) + 6 j = ( 2 * basis(i)) + basis(i+1) if (j>nxtred) nxtred = j return end subroutine endtrn(ibasis) include "lrgen.c" # i = ibasis+(3*basis(ibasis+1))+4 j = basis(i)+basis(i+1) if (j>nxttrn) nxttrn = j return end subroutine enque(iptr) include "lrgen.c" # if (basis(iptr+2)==(-1)) { basis(iptr+2) = 0 if (qhead!=0) { basis(qtail+2) = iptr qtail = iptr } else { qhead = iptr qtail = iptr } } return end ### enter - enter a new vocabulary item into character storage array # subroutine enter(iptr,irslt) integer hashof string msg "HASH TABLE OVERFLOW" include "lrgen.c" data probes/0./,nentrs/0/ nentrs = nentrs+1 i = hashof(iptr)+1 if (hashpt(i)==0) { hashpt(i) = iptr irslt = iptr probes = probes+1. } else { do j = 1, MAXHASH { if (i+j-1> MAXHASH) i = i- MAXHASH k = i+j-1 probes = probes+1. if (hashpt(k)==0) go to 50 call strcmp(iptr,hashpt(k),icomp) if (icomp==0) go to 60 } #hash table overflow. call yyerror(msg1,19,12) return 50 hashpt(k) = iptr irslt = iptr return 60 irslt = hashpt(k) } return end subroutine yyerror(msg,msgcnt,ibad) character msg(ARB) string err1 "@n *** FATAL " string err2 "@n *** WARNING " string err3 " at line " string err4 " char " include "lrgen.c" # jbad = ibad if (jbad>9) jbad = jbad-10 if (jbad!=0) if (jbad==1) call putlin( err2, ERROUT ) else call putlin( err1, ERROUT ) call putlin( msg, ERROUT ) if (ibad>=10) { # # insert the line number and character position. # call putlin( err3, ERROUT ) call putint( lineno, 4, ERROUT ) call putlin( err4, ERROUT ) call putint( linptr, 4, ERROUT ) } call putch( '@n', ERROUT) # # if comment or warning, return. otherwise stop here. # if (jbad>=2) call exit return end subroutine findls character line(MAXLINE) string hdg "LHS:" string msg "USED IN TWO SETS OF DEFINITIONS." include "lrgen.c" # call scan(itoken) if (itoken!=0) { if (lftuse(itoken)!=0) { # # itoken is used in two sets of definitions. # i = 1 call movstr(itoken,line,i,50) i = i+1 do j = 1,33 { line(i) = msg(j) i = i+1 } call yyerror(line,i-1,12) } lftuse(itoken) = 1 curlhs = itoken frsprd(itoken) = curprd+1 nprods(itoken) = 0 if (toggle('1')!=0) { line(1) = ' ' do i = 1,4 line(i+1) = hdg(i) i = 7 call movstr(itoken,line,i,120) call output(line,i-1) } } return end subroutine findrs integer lastprec character line(MAXLINE) string hdg "RHS:" string msg1 "TOO MANY PRODUCTIONS." string msg2 "GRAMMAR TOO LARGE." include "lrgen.c" # if (curprd>=MAXPRODS) call yyerror(msg1,21,12) curprd = curprd+1 lastprec = 0 prdind(curprd) = prdptr nprods(curlhs) = nprods(curlhs)+1 prodcn(prdptr) = curlhs prodcn(prdptr+1) = 0 repeat { call scan(itoken) if (itoken!=0) { if (itoken<=yylastok) lastprec = yytprec(itoken) rgtuse(itoken) = 1 prodcn(prdptr+1) = prodcn(prdptr+1)+1 i = prodcn(prdptr+1)+prdptr+1 if (i>MAXPRODCHARS) call yyerror(msg2,18,12) prodcn(i) = itoken if (toggle('1')!=0) { line(1) = ' ' do i = 1,4 line(i+1) = hdg(i) i = 7 call movstr(itoken,line,i,120) call output(line,i-1) } } } until(altend!=0) yyrprec(curprd) = lastprec prdptr = prdptr+prodcn(prdptr+1)+2 return end subroutine fndgol string msg(MAXLINE) "EXTRA GOAL SYMBOL. " include "lrgen.c" # goal = 0 do i = 3,nvoc if (lftuse(i)!=0) if (rgtuse(i)!=1) if (goal==0) goal = i else { j = 20 call movstr(i,msg,j,80) msg(j) = EOS call yyerror(msg,j,1) } if (goal==0) { ii = prdind(2) goal = prodcn(ii) } prodcn(4) = goal return end ### fndnul - mark all potentially null non-terminals. # subroutine fndnul character line(MAXLINE) string hdg " POTENTIALLY NULL NON-TERMINALS" include "lrgen.c" # mark nullnt(i) if vocabulary(i) is potentially null. this really # applys just to non-terminals so the terminals will never be marked. # for each non-terminal not already marked check each of its right # hand sides to be null or composed of non-terminals that # are all marked. if so, mark the non-terminal, indicate a change and # check the next. continue this while there is a change. do i = 1, MAXTOKS nullnt(i) = 0 repeat { ichnge = 0 kstart = nterms+1 do k = kstart,nvoc if (nullnt(k)!=1) { istart = frsprd(k) iend = istart+nprods(k)-1 do i = istart,iend { ii = prdind(i)+1 if (prodcn(ii)==0) go to 70 jstart = prdind(i)+2 ii = prdind(i)+1 jend = prdind(i)+prodcn(ii)+1 do j = jstart,jend { ii = prodcn(j) if (nullnt(ii)==0) next 2 } go to 70 } next 1 70 ichnge = 1 nullnt(k) = 1 } } until(ichnge==0) if (toggle('2')!=0) { do i = 1,32 line(i) = hdg(i) call output(line,32) i = 4 do k = kstart,nvoc if (nullnt(k)!=0) { if (iyylength(vocab(k))+i>120) { call output(line,i-1) i = 4 } call movstr(vocab(k),line,i,120) i = i+1 } call output(line,i-1) } return end ### genthd - generate sets containing possible terminal heads # subroutine genthd integer reset dimension reset(MAXTOKS) string hdg(MAXLINE) " THE THEAD SETS" include "lrgen.c" equivalence(scrtch(200),reset(1)) # do i = 1,MAXTOKS thedpt(i) = 0 # # the theads for a terminal symbol is that symbol. # do i = 1,nterms call additl(i,thedpt(i),ichn) repeat { ichnge = 0 do i = 1,numprd { j = prdind(i) kstart = j+2 kend = kstart+prodcn(j+1)-1 if (kstart<=kend) do k = kstart,kend { if (prodcn(k)!=prodcn(j)) { ii = prodcn(k) jj = prodcn(j) call addltl(thedpt(ii),thedpt(jj),ichn) if (ichn!=0) ichnge = 1 } ii = prodcn(k) if (nullnt(ii)==0) break 1 } } } until(ichnge==0) # # now pack up the sets. if two sets are identical then they will be # shared. this is okay because the thead sets never change once generated. # istart = nterms+1 do i = istart,nvoc reset(i) = 0 iend = nvoc-1 do i = istart,iend if (reset(i)==0) { jstart = i+1 do j = jstart,nvoc if (reset(j)==0) if (lcompr(thedpt(i),thedpt(j))!=0) { call rel(thedpt(j)) thedpt(j) = thedpt(i) reset(j) = 1 } } # if (toggle('2')!=0) { call output(hdg,15) kstart = nterms+1 do k = kstart,nvoc { i = 4 call movstr(vocab(k),hdg,i,120) i = i+2 iptr = thedpt(k) while (iptr>0) { ii = item(iptr) if (iyylength(vocab(ii))+i>120) { call output(hdg,i-1) i = 10 } ii = item(iptr) call movstr(vocab(ii),hdg,i,120) i = i+1 iptr = nxt(iptr) } call output(hdg,i-1) } } return end ### ground - find all non-grounded non-terminals, i.e. can't be reduced # subroutine ground include "lrgen.c" integer change,grnded dimension grnded(MAXTOKS) equivalence(grnded(1),scrtch(1)) string hdg(MAXLINE) " NOT GROUNDED: " # # first mark all the terminals grounded. # do i = 1,nterms grnded(i) = 1 istart = nterms+1 do i = istart,nvoc grnded(i) = 0 repeat { change = 0 do i = istart,nvoc if (grnded(i)==0) { ii = frsprd(i) ibase = prdind(ii)+1 jend = nprods(i) do j = 1,jend { if (prodcn(ibase)==0) go to 90 kend = prodcn(ibase) do k = 1,kend { ii = ibase+k ii = prodcn(ii) if (grnded(ii)==0) go to 80 } go to 90 80 ibase = ibase+prodcn(ibase)+2 } next 1 90 grnded(i) = 1 change = 1 } } until(change==0) # # print out the un-grounded symbols. # do i = istart,nvoc if (grnded(i)==0) { j = 16 call movstr(vocab(i),hdg,j,100) hdg(j) = EOS call yyerror(hdg,j,1) } return end ### hashof - return computed hash number for token string # integer function hashof(i) include "lrgen.c" ii = sthead(i) itemp1 = sstore(ii) ii = sthead(i+1)-1 itemp2 = sstore(ii) itemp = itemp1*itemp2 hashof = iabs(itemp-( MAXHASH*(itemp/ MAXHASH))) return end subroutine hepify(iptr,imax) include "lrgen.c" # i = iptr while (2*i<=imax) { i0 = vocab(i) i1 = vocab(2*i) j = 2*i if (2*i+1<=imax) { i2 = vocab(2*i+1) if (less(i1,i2)!=0) { i1 = i2 j = (i*2)+1 } } if (less(i0,i1)==0) break 1 itemp = vocab(i) vocab(i) = vocab(j) vocab(j) = itemp i = j } return end subroutine imtrcs(ibasis,iptr) include "lrgen.c" # generates context sets for immediate transitions. # # the immediate transition context set is a set the theads of the # substring of symbols in the production following the symbol after # the dot unioned with the context set of the production if that # substring is null or potentially null. # ii = scrtch(ibasis) i = prdind(ii) # # if there is no substring just return the context set # of the production. # if (scrtch(ibasis+1)+1>prodcn(i+1)) { iptr = scrtch(ibasis+2) item(iptr) = item(iptr)+1 } else { istart = scrtch(ibasis+1)+i+2 iend = prodcn(i+1)+i+1 ii = prodcn(istart) call copyl(thedpt(ii),ip) ii = prodcn(istart) if (nullnt(ii)!=0) { if (istart!=iend) { istart = istart+1 do i = istart,iend { ii = prodcn(i) call addltl(thedpt(ii),ip,ich) if (nullnt(ii)==0) go to 100 } } ii = scrtch(ibasis+2) call addltl(nxt(ii),ip,ich) } 100 call newcs(ip,iptr) } return end subroutine init # include "lrgen.c" # # initialize the toggle array do i = 1,256 toggle(i) = 0 # # change some defaults of the toggles # first, turn off &j (don't produce lrltran tables) call setcon('J') # next, turn on &k (produce fortran 66 tables) call setcon('K') # next, turn off grammar listing -tab call setcon('R') # next, turn off xref listing -tab call setcon('X') return end function lcompr(iptr1,iptr2) include "lrgen.c" # lcompr = 1 if (iptr1!=iptr2) { i1 = iptr1 i2 = iptr2 while (i1!=0 & i2!=0) { if (item(i1)!=item(i2)) go to 110 i1 = nxt(i1) i2 = nxt(i2) } if (i1==i2) return 110 lcompr = 0 } return end function iyylength(iptr) include "lrgen.c" # iyylength = sthead(iptr+1)-sthead(iptr) return end function lenlst(ihead) include "lrgen.c" # returns the length of the list pointed to by ihead. # iptr = ihead icnt = 0 while (iptr>0) { icnt = icnt+1 iptr = nxt(iptr) } lenlst = icnt return end function less(iptr1,iptr2) include "lrgen.c" # less = 0 if (lftuse(iptr1)==lftuse(iptr2)) { call strcmp(iptr1,iptr2,irslt) if (irslt<0) less = 1 } else if (lftuse(iptr1)==0) less = 1 return end function lint(iptr1,iptr2) include "lrgen.c" # returns 1 if there is a common item in the two lists, 0 otherwise. # i1 = iptr1 i2 = iptr2 lint = 0 repeat { if (i1==0 | i2==0) return if (item(i1)==item(i2)) break 1 if (item(i1)=MAXLISTS) call yyerror(msg,20,2) else { lstptr = lstptr+1 iptr = lstptr } else if (item(garbag)==0) { iptr = garbag garbag = nxt(garbag) } else { iptr = item(garbag) item(garbag) = nxt(iptr) } item(iptr) = 0 nxt(iptr) = 0 return end subroutine newbas(index) include "lrgen.c" string msg "BASIS AREA OVERFLOW" # # if (indbas+10>MAXBASIS) call yyerror(msg,19,2) else { nstate = nstate+1 basis(indbas) = nstate basis(indbas+1) = 0 basis(indbas+2) = -1 basis(indbas+3) = 0 index = indbas indbas = indbas+4 } return end subroutine newcs(is,iptr) include "lrgen.c" # ii = item(is) ihead = headcs(ii) i = ihead repeat { if (i==0) go to 140 ii = item(i) if (lcompr(nxt(ii),is)!=0) break 1 i = nxt(i) } iptr = item(i) item(iptr) = item(iptr)+1 call rel(is) return 140 call new(iptr) item(iptr) = 1 nxt(iptr) = is call new(i) item(i) = iptr nxt(i) = ihead ii = item(is) headcs(ii) = i return end subroutine newred(ibasis,imax) include "lrgen.c" # # set imax to the maximum number of reductions there is space for. # i = ibasis+(3*basis(ibasis+1))+6 imax = basis(i) # # if space was previously allocated for the reductions for this basis # set then reuse that space. the length required will never change # since the reductions are based on the completed basis and the basis # is never changed, only its context sets. # if (basis(i+1)==0) { imax = MAXREDS-nxtred+1 basis(i+1) = nxtred } basis(i) = 0 return end subroutine newtrn(ibasis,imax) include "lrgen.c" # # set imax to the maximum number of transitions there is space for. # i = ibasis+(3*basis(ibasis+1))+4 imax = basis(i) # # if space was previously allocated for the transitions for this basis # set then reuse that space. the length required will never change # since the transitions are based on the completed basis and the basis # is never changed, only its context sets. # if (basis(i+1)==0) { imax = MAXTRANS-nxttrn+1 basis(i+1) = nxttrn } basis(i) = 0 return end subroutine nxtchr(ichar,ispecl) character ichar character delims(4) character specls(4) character itemp string msg "ILLEGAL AMPERSAND DOUBLE" include "lrgen.c" data delims /'@n', '@t', ' ', EOS / data specls /'&', LFTANG, RGTANG, EOS / repeat { if ( linbuf(linptr) == EOS | linbuf(linptr) == '@n' ) { ispecl = 1 ichar = ' ' call newlin return } itemp = linbuf(linptr) if (itemp!='&') break 1 linptr = linptr+1 if ( index( delims, itemp ) != 0 | itemp == EOS ) { call yyerror(msg,24,11) if ( itemp != EOS & itemp != '@n' ) linptr = linptr+1 } else { itemp = linbuf(linptr) if ( index( specls, itemp ) != 0 ) { ichar = itemp ispecl = 1 linptr = linptr + 1 return } else { if (itemp!= 'C') go to 150 linptr = 1 linbuf(1) = '@n' } } } if (itemp==LFTANG) { ispecl = 2 ichar = 0 linptr = linptr + 1 return } else { if (itemp!=RGTANG) go to 170 ispecl = 3 ichar = 0 go to 180 } 150 if (itemp!= 'A') { if (itemp != 'P') if (itemp== 'G') grmend = 1 else { call setcon(itemp) ichar = 0 ispecl = 5 go to 180 } prdend = 1 } altend = 1 ispecl = 4 ichar = 0 go to 180 170 ichar = itemp ispecl = 1 180 linptr = linptr+1 return end subroutine output(line,nchars) include "lrgen.c" character line(MAXLINE) j = nchars + 1 line(j) = EOS call putlin( line, ERROUT ) call putch( '@n', ERROUT ) # do i = 1,j line(i) = ' ' return end # subroutine pntbas(iprod,idot,iptr) include "lrgen.c" character line(MAXLINE) # # first print the left side of the production. # l = 2 length = itoc( iprod, line(l), 5 ) line(l + length) = ' ' l = 9 ibase = prdind(iprod) ii = prodcn(ibase) call movstr(vocab(ii),line,l,120) line(l+1) = ':' line(l+2) = ':' line(l+3) = '=' # # print out the right side of the production. insert the dot before # the idot-th right hand side symbol. # l = l+5 istart = ibase+2 iend = prodcn(ibase+1)+ibase+1 j = 1 do i = istart,iend { ii = prodcn(i) if (iyylength(vocab(ii))+l>118) { call output(line,l-1) l = 17 } if (j==idot) { line(l) = '.' l = l+2 } call movstr(vocab(ii),line,l,120) l = l+1 j = j+1 } if (j==idot) { line(l) = '.' l = l+2 } call output(line,l-1) if (iptr!=0) { # # now print the associated context set. # ip = iptr l = 11 repeat { ii = item(ip) if (iyylength(vocab(ii))+l>=121) { call output(line,l-1) l = 12 } call movstr(vocab(ii),line,l,120) l = l+1 ip = nxt(ip) } until(ip==0) call output(line,l-1) } return end subroutine pntset character line(MAXLINE) integer z string hdg "@N@N *** THE STATE SETS ***@N@N" string hdg1 "@N@Nstate:" string hdg2 " THE TRANSITIONS:@N" string hdg3 " THE REDUCTIONS:@N" string msg1 " *** SHIFT/REDUCE conflict with state" string msg2 " *** REDUCE/REDUCE conflict with rule" string err "THIS GRAMMAR IS NOT LR(1)" include "lrgen.c" # z = 'X' call new(itemp) # # if the listing toggle isn't set, don't print heading if (toggle(z)==0) { do i = 1,120 line(i) = ' ' call putlin( hdg, ERROUT ) } # i = 1 n = 1 repeat { # # if the listing toggles isn't set, don't output listing heading if (toggle(z)==0) { call putlin( hdg1, ERROUT ) call putint( basis(i), 5, ERROUT ) call putch( '@n', ERROUT ) } # iend = basis(i+1) i = i+4 if (basis(i)==1 & basis(i+1)>3) ifinal = basis(i-4) do j = 1,iend { ii = basis(i+2) # # if the listing toggle is set, print lr(1) items if (toggle(z)==0) call pntbas(basis(i),basis(i+1),nxt(ii)) # call delcs(basis(i+2)) i = i+3 } # # print the transitions ... # # # if the listing toggle isn't set, don't print the transitions if (toggle(z)==0) { # jstart = basis(i+1) jend = jstart+basis(i)-1 if (jstart<=jend) { call putlin( hdg2, ERROUT ) do j = jstart,jend,18 { kstart = j kend = j+17 if (kend>jend) kend = jend do k = kstart,kend { ii = tran(k) call putint( basis(ii), 5, ERROUT ) } call putch( '@n', ERROUT ) } } } i = i+2 jstart = basis(i+1) jend = jstart+(2*basis(i))-1 if (jstart<=jend) { # # if the listing toggle isn't set, don't print the reduction if (toggle(z)==0) { # call putlin( hdg3, ERROUT ) } # do j = jstart,jend,2 { # # if the listing toggle isn't set, don't print the # context set for the reduction if (toggle(z)==0) { # l = 10 length = itoc( red(j), line(l), 5 ) line(l + length) = ' ' l = l+8 # # print the context set for this reduction. # ii = red(j+1) iptr = nxt(ii) repeat { ii = item(iptr) if (iyylength(vocab(ii))+l>=121) { call output(line,l-1) l = 20 } ii = item(iptr) call movstr(vocab(ii),line,l,120) l = l+1 iptr = nxt(iptr) } until(iptr==0) call output(line,l-1) } # # test for conflicts in the state. # lstrt = basis(i-1) lend = lstrt+basis(i-2)-1 if (lstrt<=lend) do l = lstrt,lend { ii = tran(l) jj = basis(ii+4) ii = prdind(jj)+basis(ii+5) item(itemp) = prodcn(ii) ii = red(j+1) if (lint(itemp,nxt(ii))!=0) { adequt = 0 if (toggle(z)==0) { ii = tran(l) call putlin( msg1, ERROUT ) call putint( basis(ii), 5, ERROUT ) call putch( '@n', ERROUT ) } # # got a shift-reduce conflict, call shtred to resolve it call shtred(red(j),l,item(itemp)) } } if (j!=jstart) { lend = j-2 do l = jstart,lend,2 { ii = red(l+1) jj = red(j+1) if (lint(nxt(ii),nxt(jj))!=0) { adequt = 0 if (toggle(z)==0) { call putlin( msg2, ERROUT ) call putint( red(l), 5, ERROUT ) call putch( '@n', ERROUT ) } # # got a reduce-reduce conflict, call redred to resolve it call redred(j,l) } } } } } i = i+2 n = n+1 } until(n>nstate) call rel(itemp) return end subroutine prntgm character line(MAXLINE) character m integer length, itoc string hdg "@N*** TERMINALS *** " string hdg2 " *** NON-TERMINALS ***@N" string hdg3 "@N *** THE PRODUCTIONS ***@N" include "lrgen.c" # # output a formfeed character before printing vocabulary # call putch( FFEED, ERROUT ) #output form feed # # output the heading for the terminals and non-terminals. # do i = 1,120 line(i) = ' ' call putlin( hdg, ERROUT ) call putlin( hdg2, ERROUT ) # # print out the terminals and non-terminals. # iend = nvoc-nterms if (nterms>iend) iend = nterms do i = 1,iend { j = 7 if (i<=nterms) { length = itoc( yydefs(i), line, 5 ) line(length + 1) = ' ' call movstr(vocab(i),line,j,120) j = j+1 } if (nterms+i<=nvoc) { if (j<46) j = 46 length = itoc( yydefs(nterms + i), line(j), 5 ) line(j+length) = ' ' j = j+5 ii = nterms+i call movstr(vocab(ii),line,j,120) } call output(line,j-1) } # # print the productions heading. # call putlin( hdg3, ERROUT ) # # print out the productions. # i = 1 repeat { j = 7 ii = prdind(i) lhs = prodcn(ii) call movstr(vocab(lhs),line,j,120) line(j+1) = ':' line(j+2) = ':' istart = j+3 m = '=' kend = nprods(lhs) do k = 1,kend { j = 1 length = itoc( i, line(j), 5 ) line(j+length) = ' ' line(istart) = m m = '/' j = istart+2 ibase = prdind(i)+1 np = prodcn(ibase) if (np!=0) { l = 1 repeat { ii = ibase+l ii = prodcn(ii) call movstr(vocab(ii),line,j,120) j = j+1 l = l+1 if (l>np) break 1 ii = ibase+l ii = prodcn(ii) if (iyylength(vocab(ii))+j>121) { call output(line,j-1) j = istart+5 } } } call output(line,j-1) i = i+1 } } until(i>numprd) return end ### rdgram - read in the grammar rules # subroutine rdgram include "lrgen.c" string str "end" do i = 1, MAXHASH hashpt(i) = 0 do i = 1, MAXTOKS { lftuse(i) = 0 rgtuse(i) = 0 } # # insert the first production. # grmend = 0 prdend = 0 call scopy( str, 1, sstore, 1 ) sstptr = 23 sthead(1) = 1 sthead(2) = 4 sthead(3) = 24 shdptr = 2 call enter(1,i) call enter(2,i) frsprd(2) = 1 nprods(2) = 1 prdind(1) = 1 prodcn(1) = 2 prodcn(2) = 3 prodcn(3) = 1 prodcn(5) = 1 prdptr = 6 lftuse(2) = 1 rgtuse(1) = 1 curprd = 1 # # read in the tokens and their definitions -tab # call gettokens while (grmend==0) { call findls while (prdend==0) call findrs } # # count the terminals. # nterms = 0 do i = 1,shdptr if (lftuse(i)==0) if (rgtuse(i)!=0) nterms = nterms+1 nvoc = shdptr numprd = curprd return end subroutine rel(iptr) include "lrgen.c" # item(iptr) = nxt(iptr) nxt(iptr) = garbag garbag = iptr return end subroutine scan(ientry) character stopsc, ichar character delims(3) string msg1 "TOO MANY LITERAL STRINGS" string msg2 "ISOLATED RIGHT ANGLE BRACKET" string msg3 "ISOLATED LEFT ANGLE BRACKET" string msg4 "MISSING RIGHT ANGLE BRACKET" include "lrgen.c" data delims /' ', '@t', EOS/ # altend = 0 prdend = 0 grmend = 0 ientry = 0 shdptr = shdptr+1 if (shdptr>MAXTOKS) call yyerror(msg1,24,12) repeat { call nxtchr(ichar,itype) if ( itype == 4 ) #production end break 1 #just ignore it else if ( itype != 5 ) #not grammar end { switch ( itype ) { case 1: #regular character if ( index( delims, ichar ) == 0 ) stopsc = ' ' case 2: ichar = LFTANG stopsc = RGTANG case 3: call yyerror(msg2,28,10) ichar = RGTANG } if ( index( delims, ichar ) == 0 ) #not a delimiter { call bildst(ichar) repeat { call nxtchr(ichar,itype) switch(itype) { case 1: if ( stopsc == ' ' & index( delims, ichar ) != 0 ) break 1 call bildst(ichar) case 2: call yyerror(msg3,27,10) call bildst(LFTANG) case 3: call bildst(RGTANG) if (stopsc==RGTANG) break 1 call yyerror(msg2,28,10) case 4: if (stopsc==RGTANG) call yyerror(msg4,27,10) break 1 case 5: } } if (sstptr0) do i = 1,iend,3 { jstart = i+3 do j = jstart,nsets,3 { # # if either both configs are reduce configs or the second one is then # no exchange should take place. a config is a reduce config if the dot # is at the end of the production. # ii = scrtch(j) ii = prdind(ii)+1 if (scrtch(j+1)<=prodcn(ii)) { # # if the first config is a reduce and the second isnt, exchange. # ii = scrtch(i) ii = prdind(ii)+1 if (scrtch(i+1)<=prodcn(ii)) { # # otherwise compare the symbols after the dot. # ii = scrtch(i) ii = prdind(ii)+scrtch(i+1)+1 jj = scrtch(j) jj = prdind(jj)+scrtch(j+1)+1 if (prodcn(jj)>prodcn(ii)) next 1 } do k = 1,3 { ii = i+k-1 jj = j+k-1 itemp = scrtch(ii) scrtch(ii) = scrtch(jj) scrtch(jj) = itemp } } } } return end ### sortgm - sort grammar so alphabetically, seperating terminals followed by # non-terminals # subroutine sortgm include "lrgen.c" integer xlate dimension xlate(MAXTOKS),moved(MAXTOKS) equivalence(scrtch(1),xlate(1)),(scrtch( arith(MAXTOKS,+,1)),moved(1)) # the vocabulary items are sorted into terminal non-terminal order, # alphabetically within each group, using a heap sort. do i = 1,nvoc vocab(i) = i call bildhp iend = nvoc-1 do i = 1,iend { ii = nvoc-i+1 itemp = vocab(ii) vocab(ii) = vocab(1) vocab(1) = itemp call hepify(1,nvoc-i) } # now that the vocabulary is sorted build a translation table and # translate from the original token numbers to the sorted numbers. do i = 1,nvoc { ii = vocab(i) xlate(ii) = i moved(i) = 0 } i = 1 k = 0 repeat { ii = prodcn(i) prodcn(i) = xlate(ii) istart = i+2 iend = prodcn(i+1)+i+1 if (iend>=istart) do j = istart,iend { ii = prodcn(j) prodcn(j) = xlate(ii) } i = i+prodcn(i+1)+2 k = k+1 } until(k>=numprd) goal = xlate(goal) # now reorder arrays indexed by token number. do i = 1,nvoc { j = i n1 = frsprd(j) n2 = nprods(j) n3 = yydefs(j) n4 = yyassoc(j) n5 = yytprec(j) while (moved(j)!=1) { k = xlate(j) m1 = frsprd(k) m2 = nprods(k) m3 = yydefs(k) m4 = yyassoc(k) m5 = yytprec(k) frsprd(k) = n1 nprods(k) = n2 yydefs(k) = n3 yyassoc(k) = n4 yytprec(k) = n5 moved(j) = 1 n1 = m1 n2 = m2 n3 = m3 n4 = m4 n5 = m5 j = k } } return end subroutine strcmp(iptr1,iptr2,irslt) include "lrgen.c" # irslt = 0 i1 = sthead(iptr1)-1 i2 = sthead(iptr2)-1 len1 = sthead(iptr1+1)-i1-1 len2 = sthead(iptr2+1)-i2-1 iend = len1 if (len2iend) jend = iend do j = jstart,jend { call tablnum( j, line(l), 6, ')' ) l = l+7 ii = tran(j) # # check for shift/reduce flags in tran array if (ii<0) call tablnum( -(basis(-ii)), line(l), 6, '/' ) else if ( ii > 0 ) call tablnum( basis(ii), line(l), 6, '/' ) else call tablnum( nstate + 1, line(l), 6, '/' ) # l = l+12 } line(l-6) = '@n' line(l-5) = EOS call putlin( line, STDOUT ) } # # k = -2 index = 1 for ( i = 6; i <= 44; i = i + 19 ) { call scopy( msg7, 1, msg6, i ) msg6(i + 4) = '(' } do i = 1,nstate,3 { call scopy( msg6, 1, line, 8 ) l = 18 jstart = i jend = i+2 if (jend>nstate) jend = nstate do j = jstart,jend { call tablnum( index, line(l), 6, ')' ) index = index+1 l = l+7 k = k+(3*basis(k+4))+8 call tablnum( basis(k), line(l), 6, '/' ) l = l+12 } line(l-6) = '@n' line(l-5) = EOS call putlin( line, STDOUT ) } call scopy( msg6, 1, line, 8 ) line( 31 ) = '@n' line(32) = EOS call tablnum( nstate + 1, line(18), 6,')' ) call tablnum( basis(k) + basis(k-1), line(25), 6, '/' ) call putlin( line, STDOUT ) # # k = 5 do i = 1,nstate,3 { call scopy( msg8, 1, line, 8 ) l = 17 jstart = i jend = i+2 if (jend>nstate) jend = nstate do j = jstart,jend { call tablnum(j,line(l), 6, ')') l = l+7 ii = basis(k) ii = prdind(ii)+basis(k+1) ient = yydefs(prodcn(ii)) k = k+(3*basis(k-3))+8 call tablnum(ient,line(l), 4, '/') l = l+9 } line(l-5) = '@n' line(l-4) = EOS call putlin( line, STDOUT ) } # # output the last element of the state_tokens array, so that it # contains something that could never be recognized as a token. # call scopy( mnot, 1, line, 8 ) call tablnum( nstate+1, line(17), 6, ')' ) call tablnum( NOTOKEN, line(24), 4, '/' ) call putlin( line, STDOUT ) # # k = 0 index = 1 for ( i = 6; i <= 44; i = i + 19 ) { call scopy( msg9, 1, msg6, i ) msg6(i + 4) = '(' } do i = 1,nstate,3 { call scopy( msg6, 1, line, 8 ) l = 18 jstart = i jend = i+2 if (jend>nstate) jend = nstate do j = jstart,jend { call tablnum(index,line(l), 6, ')') index = index+1 l = l+7 k = k+(3*basis(k+2))+8 call tablnum( (basis(k)+1)/2, line(l), 6, '/' ) l = l+12 } line(l-6) = '@n' line(l-5) = EOS call putlin( line, STDOUT ) } call scopy( msg6, 1, line, 8 ) line(31) = '@n' line(32) = EOS call tablnum(index,line(18), 6, ')') call tablnum(((2*basis(k-1))+basis(k)+1)/2,line(25), 6, '/') call putlin( line, STDOUT ) # # index = 1 iend = nxtred-1 for ( i = 6; i <= 44; i = i + 19 ) { call scopy( msg10, 1, msg6, i ) msg6(i + 4) = '(' } do i = 2,iend,6 { call scopy( msg6, 1, line, 8 ) l = 18 jstart = i jend = i+4 if (jend>iend) jend = iend do j = jstart,jend,2 { call tablnum(index, line(l), 6, ')') index = index+1 l = l+7 ii = red(j) call tablnum(item(ii),line(l), 6, '/') l = l+12 } line(l-6) = '@n' line(l-5) = EOS call putlin( line, STDOUT ) } # # index = 1 for ( i = 6; i <= 44; i = i + 19 ) { call scopy( msg11, 1, msg6, i ) msg6(i + 4) = '(' } do i = 1,iend,6 { call scopy( msg6, 1, line, 8 ) l = 18 jstart = i jend = i+4 if (jend>iend) jend = iend do j = jstart,jend,2 { call tablnum(index,line(l), 6, ')') index = index+1 l = l+7 call tablnum(red(j),line(l), 6, '/') l = l+12 } line(l-6) = '@n' line(l-5) = EOS call putlin( line, STDOUT ) } # # index = 1 k = 1 do i = 1,numprd,4 { call scopy( msg12, 1, line, 8 ) l = 17 jstart = i jend = i+3 if (jend>numprd) jend = numprd do j = jstart,jend { call tablnum(index,line(l), 4, ')') index = index+1 l = l+5 call tablnum(yydefs(prodcn(k)),line(l), 4, '/') l = l+9 k = k+prodcn(k+1)+2 } line(l-5) = '@n' line(l-4) = EOS call putlin( line, STDOUT ) } # # index = 1 k = 2 for ( i = 6; i <= 48; i = i + 14 ) { call scopy( msg13, 1, msg12, i ) msg12(i + 3) = '(' } do i = 1,numprd,4 { call scopy( msg12, 1, line, 8 ) l = 17 jstart = i jend = i+3 if (jend>numprd) jend = numprd do j = jstart,jend { call tablnum(index,line(l), 4, ')') l = l+5 index = index+1 call tablnum(prodcn(k),line(l), 4, '/') l = l+9 k = k+prodcn(k)+2 } line(l-5) = '@n' line(l-4) = EOS call putlin( line, STDOUT ) } # # iptr = lencsl iend = ncsets+1 call scopy( msg14, 1, line, 8 ) line(29) = '@n' line(30) = EOS line(20) = '1' line(27) = '1' call putlin( line, STDOUT ) last = 1 do i = 2,iend,3 { call scopy( msg14, 1, line, 8 ) l = 18 jstart = i jend = i+2 if (jend>iend) jend = iend do j = jstart,jend { call tablnum(j,line(l), 4, ')') l = l+5 last = last+item(iptr) call tablnum(last,line(l), 6, '/') l = l+12 iptr = nxt(iptr) } line(l-6) = '@n' line(l-5) = EOS call putlin( line, STDOUT ) } # # lptr = listcs index = 1 ii = item(lptr) iptr = nxt(ii) repeat { do i = 1,3 { while (iptr<=0) { lptr = nxt(lptr) if (lptr<=0) break 2 ii = item(lptr) iptr = nxt(ii) } if (i==1) { call scopy( msg15, 1, line, 8 ) l = 16 } call tablnum(index,line(l), 6, ')') index = index+1 l = l+7 call tablnum(yydefs(item(iptr)),line(l), 6, '/') l = l+10 iptr = nxt(iptr) } line(l-4) = '@n' line(l-3) = EOS call putlin( line, STDOUT ) if (lptr<=0) break 1 } # # output the end of the block data -tab # call blkend return end subroutine tablnum( num, line, limit, char ) integer num, limit character line(ARB), char integer itoc, length length = itoc( num, line, limit ) if ( length == limit - 1 ) line(length + 1) = char else line(length + 1) = ' ' return end subroutine trnred(ibasis,jmax) include "lrgen.c" # i = 1 call newtrn(ibasis,maxt) ii = scrtch(i) ii = prdind(ii)+1 if (scrtch(i+1)<=prodcn(ii)) repeat { ii = scrtch(i) ii = prdind(ii)+scrtch(i+1)+1 lhs = prodcn(ii) call newbas(nbasis) repeat { call addbas(nbasis,scrtch(i),scrtch(i+1)+1,scrtch(i+2)) call delcs(scrtch(i+2)) i = i+3 ipath = 0 if (i>jmax) go to 220 ii = scrtch(i) ii = prdind(ii)+1 if (scrtch(i+1)>prodcn(ii)) go to 220 ii = scrtch(i) ii = prdind(ii)+scrtch(i+1)+1 } until(lhs!=prodcn(ii)) ipath = 1 220 call endbas(nbasis) call merge(nbasis,nb,ich) if (ich!=0) call enque(nb) call addtrn(ibasis,nb,maxt) } until(ipath==0) call endtrn(ibasis) call newred(ibasis,maxr) if (i<=jmax) repeat { call addred(ibasis,scrtch(i),scrtch(i+2),maxr) call delcs(scrtch(i+2)) i = i+3 } until(i>=jmax) call endred(ibasis) return end ### xref - produce a cross-reference listing of tokens and productions # subroutine xref include "lrgen.c" character line(MAXLINE) dimension lsthed(MAXTOKS) equivalence(lsthed(1),scrtch(1)) string hdg "@N@N *** A VOCABULARY CROSS-REFERENCE ***@N@N" # do i = 1,nvoc lsthed(i) = 0 # i = numprd repeat { j = prdind(i) call new(link) item(link) = -i ii = prodcn(j) nxt(link) = lsthed(ii) lsthed(ii) = link kend = prodcn(j+1) if (kend>0) do k = 1,kend { call new(link) item(link) = i ii = j+k+1 ii = prodcn(ii) nxt(link) = lsthed(ii) lsthed(ii) = link } i = i-1 } until(i<=0) # # now print the cross reference lists ... # do j = 1,120 line(j) = ' ' call putlin( hdg, ERROUT ) # do i = 1,nvoc { l = 2 call movstr(vocab(i),line,l,120) l = ((l+4)/5)*5 lstart = l if (lstart>20) lstart = 20 n = lsthed(i) while (n!=0) { if (l>=110) { call output(line,l-1) l = lstart } length = itoc( item(n), line(l), 5 ) line(l+length) = ' ' l = l+5 n = nxt(n) } call output(line,l-1) call rel(lsthed(i)) } return end #-t- lrgen 57256 ascii 15-Jan-84 20:59:15 #-t- lrgen.all 61796 ascii 15-Jan-84 21:01:20 #-h- yyplb.all 22969 ascii 07Jan84 11:52:51 #-h- yyplb.doc 3116 ascii 05Jan84 08:21:03 .pl 64 .m1 2 .m2 3 .m3 3 .m4 3 .po 10 .rm 62 .bp 1 .in 0 .he ^yyplb(2)^%^yyplb(2)^ .fo ^^- # -^^ .in 5 .sp .ne 2 .fi .ti -5 NAME .br yyplb - yacc parser library .sp .ne 2 .fi .ti -5 SYNOPSIS .br .nf sts = yyparse( value ) rule = yyfdrd( state, token ) call yydored( rule ) state = yyfdtr( state, token ) call yydotr( state ) sts = yyperr( msg ) .sp .ne 2 .fi .ti -5 DESCRIPTION .br .ne 3 .sp This library contains the parse driver routine for yacc. It is compiled with the parse code generated by yacc from the grammar input file. All of the routines and the global variables in yyplb begin with the letters 'yy'. This is done to avoid conflicts with the code provided by the user in the yacc grammar file. .ne 3 .sp .bd .ne 3 .sp .in +6 .ta 5r .ti -6 yyparse - The main program, usually supplied by the user in the grammar file, must call the parse driver routine, yyparse. If the parse was successful, yyparse returns OK, otherwise ERR. The value of the last reduction is returned in 'value'. .bd .in -6 .ne 3 .sp .in +6 .ta 5r .ti -6 yyfdrd - This routine determines if a reduction should be done considering the current 'state' and the lookahead 'token'. If a reduction is possible, the number of the grammar rule to be reduced is returned, otherwise -1 is returned. .bd .in -6 .ne 3 .sp .in +6 .ta 5r .ti -6 yydored - This routine does the reduction for 'rule'. It pops N symbols off the parse stacks, where N is the number of LHS symbols in the grammar rule, 'rule'. Yydored then pushes the RHS symbol of 'rule' onto the token stack, and finds and pushes the goto state onto the state stack. .bd .in -6 .ne 3 .sp .in +6 .ta 5r .ti -6 yyfdtr - This routine determines if a transition, or shift, is possible considering the current 'state' and the lookahead 'token'. If a shift is possible, the state to shift to is returned, otherwise -1 is returned. .bd .in -6 .ne 3 .sp .in +6 .ta 5r .ti -6 yydotr - This routine does a shift, or transition, to 'state'. It pushes 'state' and the lookahead token on to the parse stacks. .bd .in -6 .ne 3 .sp .in +6 .ta 5r .ti -6 yyperr - This is the error-recovery routine. It pops the parse stacks, until a state is found from which it is legal to shift the error token, .bd yyerror. If no such state is found, yyperr returns ERR, otherwise the state is left on top of the state stack and the error token is made the lookahead token, so that the next parse action will be to shift the error token and continue parsing. The parser is put into error-recovery mode until three tokens have been successfully read and shifted. When in error-recovery mode, no parse errors are reported. The original error message, 'msg', is written to ERROUT. .in -6 .ne 3 .sp The declarations for the parse stacks and current parse values are kept in common blocks in the include file .bd incl/yypcom. The declarations for the parse tables generated by yacc are kept in common blocks in the include file .bd incl/yytblc. .sp .ne 2 .fi .ti -5 SEE ALSO .br .nf yc(T), yacc(1) .sp .ne 2 .fi .ti -5 FILES .br incl/yypcom, incl/yytblc .sp .ne 2 .fi .ti -5 AUTHOR(S) .br Theresa Breckon #-t- yyplb.doc 3116 ascii 05Jan84 08:21:03 #-h- yyplb.inc 1657 ascii 05Jan84 08:21:03 #-h- yypcom 1020 ascii 05Jan84 08:20:34 ### yypcom - common for yacc parse driver routines # integer yyval #token value from yysem integer yylexval #token value from yylex integer yytok #token number integer yymaxstack #parse stack sizes integer yyerrok #error recovery flag integer yyerct #recovery error count integer yysta #current state integer yysstk #state stack integer yyvstk #value stack integer yytstk #token stack integer yystkp #stack pointer common /yysscm/ yysstk(1) common /yytscm/ yytstk(1) common /yyvscm/ yyvstk(1) common /yymicm/ yyval, yytok, yyerrok, yysta, yystkp, yymaxstack, yylexval, yyerct #-t- yypcom 1020 ascii 05Jan84 08:20:34 #-h- yytblc 377 ascii 05Jan84 08:20:34 integer yyfred, yynset, yylset, yyls, yyprod, yylen, yylhs, yyftrn, yyfinal, yytran, yyent, yydbg common /yyfrcm/ yyfred(1) common /yynscm/ yynset(1) common /yyltcm/ yylset(1) common /yylscm/ yyls(1) common /yyprcm/ yyprod(1) common /yylncm/ yylen(1) common /yylhcm/ yylhs(1) common /yyftcm/ yyftrn(1) common /yytrcm/ yyfinal, yytran(1) common /yyencm/ yydbg, yyent(1) #-t- yytblc 377 ascii 05Jan84 08:20:34 #-t- yyplb.inc 1657 ascii 05Jan84 08:21:03 #-h- yyplb 17806 ascii 05Jan84 08:21:04 ### yyplb - LR parser routines # # MODIFICATION HISTORY # -------------------- # 03b sd 22sep83 .Ratfixed # 03a tab 07jan83 .Changed Illegal Expression error message. # 02a tab 12oct82 .changed routine putstks to yyputstks. # .changed yylex value parameter name from "yyval" to # "yylexval", so it wouldn't get clobbered by yydored # Changed yyparse to return last reduction's value in # yyparse's parameter. Made yyperr check for 3 tokens. # 01d tab 25aug82 .added checks for non-associative transitions, # and error recovery # 01c tab 19jul82 .added yypinit call to yyparse # 01b tab 07jul82 .translated from fortran code to rat4, change all # subroutine and common variable names to start with 'yy' # 01A TAB 18MAY82 .translated from fortran code PARSER.FOR delivered # LRGEN from LLL. Added value stack #. # DESCRIPTION # ----------- # Dimension statements required by the particular grammar do change # from one grammar to another and are generated by the lr routine # for insertion in the routines that use the common blocks. # # A lexical analyzer is required, but is not provided in this # set of routines. A reference is made to the lexical analysis # routine, yylex, in the routines yyparse and yyperr, to indicate # where the call should be made. The scanner routine should read the # next token on the input and return the token number. # If there is a value associated with the token, it should be assigned # to the integer parameter of 'yylex'. # Fancier error correction routines may require # that a queue of tokens be kept. revision of routines yyperr, # yydotran, and yyparse would probably be necessary to handle # the expanded method for handling tokens. # include "yypdef" ### yypinit - initialize parser variables # # synopsis # call yypinit # # This is the place to initialize all the variables that the parser # needs. Make sure the scanner is ready to read. # The state stack, current state, and stack pointer are all preset. # The first token this parser expects is YYENDTOK. subroutine yypinit include "yypcom" #common containing parse data structures yysta = 1 #intialize current state yylexval = 0 #intialize token value yytok = YYENDTOK #intialize first token yysstk(1) = 1 #initialize state stack yyvstk(1) = 0 #initialize value stack yystkp = 1 #initialize state stack pointer return end ### yyparse - does the actual parsing of the input # # SYNOPSIS # -------- # sts = yyparse( value ) # sts - ERR if couldn't recover from error, OK otherwise # value - value of last production reduced # # DESCRIPTION # ----------- # This is the actual parsing loop. For the current state, yysta, # and the current lookahead, yytok, a shift or tranisition is attempted. # If that legal, the shift is performed and the next token is retrieved. # If no shift is legal, a reduction is attempted. If no reduction is possible # an error has occured and the error recovery routines are called. # The error recovery routine may either recover sufficiently to # resume a parse at the top of the loop, or will fail and die. A call # to yylex, which returns the next token on the input stream, # is called only after a successful read transition, as no symbols # are read when a reduction is performed. The parse stops successfully # on two conditions. First, when the reduction performed is number one, # you have reduced to the system goal symbol. This should normally # not occur, though, because you should stop successfully when # you transfer to the final state, yyfinal. # integer function yyparse( retvalue ) integer retvalue include "yypcom" #parse global data structures include "yytblc" #LR table arrays, contains final state integer prod #production num for reduction attempting integer yyfdrd #tries to find possible reduction integer yyperr #tries to do error recovery integer yyfdtr #tries to find possible transition integer state #new state to transfer to integer yylex #lexical analyzer string illconerr "Illegal Language Construct." string nonasserr "Tried To Associate Non-Associating Operator." string shstr "NEXT ACTION: shift to state" string rdstr "NEXT ACTION: reduce by production" yyerrok = NO #reset error recovery flag yyparse = OK call yypinit #initialize parser structures while ( yyparse != ERR ) #parse loop {#parse state = yyfdtr( yysta, yytok ) #test for transition if ( state >= 0 ) #found transition {#dotran if ( yydbg == YES ) #debug mode on { call putlin( shstr, ERROUT ) call putint( state, 5, ERROUT ) call yyputstks } call yydotran( state ) #do the transition if ( state == yyfinal ) #transition to final state { retvalue = yyval return } else #more parsing to be done { yytok = yylex( yylexval ) #call the lexical analyzer if ( yyerrok == YES ) #trying to recover from erro call yyrecover } }#dotran else if ( state == YYERRTRAN ) #nonassociable association yyparse = yyperr( nonasserr ) #try to recover from error else {#dored prod = yyfdrd( yysta, yytok ) #find reduction if ( prod < 0 ) #no reduction yyparse = yyperr( illconerr ) #try to recover from err else #reduction found { if ( yydbg == YES ) { call putlin( rdstr, ERROUT ) call putint( prod, 5, ERROUT ) call yyputstks } call yydored( prod ) #do the reduction if ( prod == 1 ) #start symbol reduced { retvalue = yyval return } } }#dored }#parse retvalue = yyval return end ### yyputstks - output parsing stacks # # This routine is called only if the yydbg flag is set to YES in the main # calling program subroutine yyputstks include "yypcom" string s1 "@n CURRENT state:" string s2 ", token:" string s2a ", value:" string s3 "@n ************* S T A C K S *************@n" string s4 " state token value@n" string s5 " ----- ----- -----@n" call putch('@n', ERROUT) call putlin( s1, ERROUT ) call putint( yysta, 5, ERROUT ) call putlin(s2, ERROUT ) call putint( yytok, 5, ERROUT ) call putlin( s2a, ERROUT ) call putint( yylexval, 5, ERROUT ) call putch('@n', ERROUT) call putlin( s3, ERROUT ) call putch('@n', ERROUT) call putlin( s4, ERROUT ) call putlin( s5, ERROUT ) for ( i = yystkp; i >= 1; i = i - 1 ) { call putint( yysstk(i), 12, ERROUT ) call putint( yytstk(i), 17, ERROUT ) call putint( yyvstk(i), 17, ERROUT ) call putch('@n', ERROUT) } call putch('@n', ERROUT) call putch('@n', ERROUT) return end ### yyfdrd - find reduction corresponding to state stack # # SYNOPSIS # -------- # call yyfdrd( state, token ) # # state - current state # token - lookahead token # # DESCRIPTION # ----------- # If a reduction should be done when in state 'state' looking ahead at # symbol 'token', the production number is returned. Otherwise, a -1 is # returned. No reduction should be made if the token is a # non-terminal. This is true because the parser makes all reductions # possible for a given token before it reads the next symbol. If a # reduction were possible looking ahead to a non-terminal, then a # symbol must have been read before the reductions were finished on # this token, which will not happen. # The 'yyfred' vector gives for the state the first and last indices in the # 'yynset' vector that must be scanned. The 'yynset' vector gives the # lookahead set number. If the bit for the token is set in the # lookahead set bit vector, then the production number found in vector # 'yyprod' is returned. # integer function yyfdrd( state, token ) integer state, token include "yytblc" #commons for LR table vectors integer start #first index for scanning lookahead set integer end #last index for scanning lookahead set integer jstart #first lookahead bit index integer jend #last lookahead bit index integer i, j start = yyfred(state) #get first set index end = yyfred(state + 1) - 1 #get last set index yyfdrd = -1 if ( start <= end ) #there is a lookahead set #look through lookahead set for the symbol 'token' for ( i = start; i <= end ; i = i + 1 ) { j = yynset(i) #get lookahead set number jstart = yylset(j) #1st lookahead bit index jend = yylset(j + 1) - 1 #last lookahead bit indx #search for 'token' bit set for ( j = jstart; j <= jend; j = j + 1 ) if ( yyls(j) == token ) #token found { yyfdrd = yyprod(i) #return production number return } } return end ### yydored - does a reduction # # SYNOPSIS # -------- # call yydored( prod ) # prod - production number of production being reduced # # DESCRIPTION # ----------- # # The reduction for production prod is performed by first finding # the new position for the stack pointer, by subtracting the length # of the production, found in the yylen vector for the production # number, from the stack pointer. The semantic routines are then # called into action by calling yysem with the production # number. The stacks are then adjusted # accordingly, a transition is made to the left hand side of # the production, found in vector yylhs, and the state on the top # of the stack. The current state is set to the state on the top # of the stack, the stack pointer is reset, and the routine returns. # subroutine yydored( prod ) integer prod include "yytblc" include "yypcom" integer leptr #new stack pointer integer yyfdtr #finds next transition state string stkovf "Syntactic Stack Overflow" leptr = yystkp - yylen(prod) + 1 #get new stack pointer if ( leptr > yymaxstack ) #check stack overflow call yyperr( stkovf, 1, 24 ) #call error routine else { yyval = yyvstk( leptr ) #default is '$1' call yysem( prod ) #call semantics routine yyvstk(leptr) = yyval #put token value on stack yytstk(leptr) = yylhs(prod) #put LHS token on stack yysta = yyfdtr( yysstk(leptr - 1), yylhs(prod) ) yysstk(leptr) = yysta #put goto state on stack yystkp = leptr #reset stack pointer } return end ### yyfdtr - find next transition to do # # SYNOPSIS # -------- # # newstate = yyfdtr( state, token ) # state - current state # token - lookahead token # newstate - goto state of transition, or -1 if no legal transition # # DESCRIPTION # ----------- # This function decides whether a read transition should be # performed when in state 'state' looking at symbol 'token'. For the state # 'state', you may transfer to the 'newstate' given in the yytran vector # if the entrance symbol for that transition is the same as the # symbol you want to read; 'token'. The yyftrn vector gives the beginning # and ending positions in the yytran vector for legal read # transitions in the state 'state'. If 'token' is not found in the # entrance symbols for legal read transitions for 'state', a # -1 is returned. # integer function yyfdtr( state, token ) integer state, token include "yytblc" integer start #1st index into state vector integer end #last index into state vector integer i, j yyfdtr = -1 start = yyftrn(state) #get first index end = yyftrn(state + 1) - 1 #get last index if ( start <= end ) #got some transitions #read through transition set for lookahead symbol 'token' for ( i = start; i <= end; i = i + 1 ) { j = yytran(i) #possible trans state if ( token == yyent( iabs(j) ) ) #see if token matches { if ( j < 0 ) #if non-associative yyfdtr = YYERRTRAN #return error else yyfdtr = j #else, return state return } } return end ### yydotran - do a shift transition # # SYNOPSIS # -------- # # call yydotran( state ) # state - corresponding shift state # # DESCRIPTION # ----------- # The transition to state 'state' is performed by incrementing # the stackpointer and stacking the token, it's value, and 'state'. Further #parallel stacks may be maintained in this routine. # subroutine yydotran ( state ) integer state include "yypcom" string ovflerr "Syntactic Stack Overflow" yystkp = yystkp + 1 if ( yystkp > yymaxstack ) #test for stack ovflw call yyperr( ovflerr, 1, 24 ) #call error routine else { yytstk(yystkp) = yytok #stack lookahead token yyvstk(yystkp) = yylexval #stack it's value yysstk(yystkp) = state #stack transition state yysta = state #make it the current state } return end ### yyperr - error recovery routine # # SYNOPSIS # -------- # call yyperr( errmsg ) # errmsg - character array error message # # DESCRIPTION # ----------- # YYPERR attempts error recovery by popping states off the state stack, # until a state is found from which it is legal to shift the ERROR token. # If no such state is found, the parser returns ERR. # If the state is found; the parser returns OK, # the state is left on top of the stack, and the ERROR # token is made the next lookahead token. The error recovery flag, yyerrok, # is set and is not reset until 3 tokens have been successfully # read and shifted. While this flag # is set, any more errors found will only result in the lookahead # token being discarded and a new one read in. This is done to hopefully # not print a zillion error messages for one error. # integer function yyperr ( msg ) character msg(MAXLINE) include "yypcom" integer state, i integer yylex #returns next token integer yyfdtr #finds transition on token yyperr = OK if ( yyerrok == YES ) #still in recovery mode { if ( yytok == YYENDTOK ) #couldn't recover from error yyperr = ERR else yytok = yylex( yylexval ) #just disregard current token } else { state = -1 #test each state to see if it contains a transition on YYERROR for ( i = yystkp; i > 0 & state < 0; i = i - 1 ) state = yyfdtr( yysstk(i), YYERROR ) #test for transition if ( state < 0 ) #didn't find recovery state yyperr = ERR #couldn't recover from error else { yyerrok = YES #set error recovery flag yyerct = 0 #initialize recovery count yytok = YYERROR #set lookahead to err token yystkp = i + 1 #pop all other states off yysta = yysstk(yystkp) #reset current state } call remark( msg ) #print error message } return end ### yyrecover - try to recover from parse error # # If three tokens have been successfully read and shifted, reset # error recovery flag. # subroutine yyrecover include "yypcom" if ( yyerct == 3 ) yyerrok = NO else yyerct = yyerct + 1 return end #-t- yyplb 17806 ascii 05Jan84 08:21:04 #-t- yyplb.all 22969 ascii 07Jan84 11:52:51 #-h- lrglb.all 27001 ascii 07Jan84 11:52:54 #-h- lrglb.inc 2888 ascii 07Jan84 11:50:46 #-h- lrgdef 612 ascii 07Jan84 11:50:15 ### lrgdef - definitions for lrgen arrays in common, lrgen.c # # MODIFICATION HISTORY # -------------------- # 01c 12jul83 jc .ratfixed # 01b 17dec82 tab .added modification history, reduced MAXBASIS # from 6000 to 5000 # 01a ?????? tab .written # define(LFTANG,'<') define(RGTANG,'>') define(MAXSTATESET,1000) define(MAXTOKS,500) define(MINDEFAULT,259) define(NOTOKEN,arith(MAXTOKS,+,MINDEFAULT)) define(MAXTOKCHARS,2000) define(MAXPRODS,500) define(MAXPRODCHARS,3000) define(MAXHASH,512) define(MAXLISTS,3000) define(MAXBASIS,5000) define(MAXTRANS,3000) define(MAXREDS,3000) #-t- lrgdef 612 ascii 07Jan84 11:50:15 #-h- yypdef 149 ascii 07Jan84 11:50:15 ### yypdef - definitions for parse subroutines define(YYSTDEFAULT,25) define(YYENDTOK,0) define(YYERROR,-1) define(YYERRTRAN,-2) define(YYNOTRAN,0) #-t- yypdef 149 ascii 07Jan84 11:50:15 #-h- lrgen.c 1737 ascii 07Jan84 11:50:16 ### include file for the tool "lrgen". v01a 5Sep82 VJ #nolist # # MODIFICATION HISTORY # -------------------- # v01c 16sep82 TAB .parameterized array lengths # v01b 09sep82 TAB .declared character arrays to be character, rearranged # to suit MODCOMP's order pickiness # v01a 05sep82 VJ .written integer yydefs, yylastok, yytprec, yyassoc, yyrprec dimension headcs(MAXTOKS), headen(MAXTOKS) integer adequt integer garbag integer grmend, altend, prdend, curlhs, prdptr, curprd integer hashpt integer headcs, headen integer lftuse, rgtuse, frsprd, prodcn, prdind integer lngvcb, lngprd integer qhead, qtail integer scrtch integer sstptr, sthead, shdptr character sstore, linbuf integer thedpt, basis, tran, red integer toggle integer vocab, goal common/adqcom/adequt common/anacom/nxttrn, nxtred, ncsets, listcs, ifinal, indbas, lencsl, lsets common/grmflg/grmend, prdend, altend, curlhs, prdptr, curprd common/lstcom/garbag, lstptr common/qcom/qhead, qtail common/readcm/linbuf(MAXLINE), linptr, lineno common/s1/sstore(MAXTOKCHARS), sthead( arith(MAXTOKS,+,1)) common/s2/hashpt(MAXHASH) common/s3/lftuse(MAXTOKS), rgtuse(MAXTOKS), frsprd(MAXTOKS), nprods(MAXTOKS), prodcn(MAXPRODCHARS), prdind(MAXPRODS), vocab(MAXTOKS) common/s4/item(MAXLISTS), nxt(MAXLISTS) common/s5/nullnt(MAXTOKS), thedpt(MAXTOKS), basis(MAXBASIS), tran(MAXTRANS), red(MAXREDS) common/scrcom/scrtch(MAXSTATESET) common/ystring/sstptr, shdptr common/tabcom/nvoc, numprd, goal, nterms, nstate common/togcom/toggle(256) common/yyddss/yydefs(MAXTOKS), yylastok, yytprec(MAXTOKS), yyassoc(MAXTOKS), yyrprec(MAXTOKS) equivalence(rgtuse(1), headcs(1)), (lftuse(1), headen(1)) #list #-t- lrgen.c 1737 ascii 07Jan84 11:50:16 #-t- lrglb.inc 2888 ascii 07Jan84 11:50:46 #-h- lrglb 23853 ascii 07Jan84 11:50:47 ### lrglb - library of rat4 routines for lrgen code # # MODIFICATION HISTORY # -------------------- # 03c tab 17nov83 .changed rat4 ignore-lines to begin with percent sign. # 03b jic 18Jul83 .ratfixed. # 03a tab 07jan83 .fixed SHIFT/REDUCE error msg to print out correct # token number in routine srerr. Also stopped printing # precedences and assocs in this routine because these # values will always be zero (that's what causes the # SH/RED conflict in the first place). # 02a tab 12oct82 .deleted subroutine rdsemn. # 01g tab 09sep82 .changed all IO to standard tools IO, no longer need # chrind, ffeed, nequal, or putout. Moved block data # statement contents to lrgen's. # 01f tab 30aug82 .added % to block data so rat4 would ignore it. # 01e tab 25aug82 .added code for MODCOMP and VAX input, output masks # and added error token code # 01d tab 02Aug82 .added gettokens and associated routines for doing # token precedence and associativity # 01c tab 15jul82 .added routine rdsemn, to be called in main to read # in the semantics and write them to ERROUT. # 01b tab 12jul82 .added routine blkbeg and blkend,, to be called in # lrgen routine TABLEA, to begin and end the block data # statement containing the LR table arrays # 01A TAB 08JUL82 .WRITTEN # # DESCRIPTION # ----------- # This library was created to make use of the software tools manifests, # so the lrgen code would be portable between machines include lrgdef include yypdef define(ENDTOK,1) #LRGEN's token def for end-token define(STARTOK,2) #LRGEN's token def for start-symbol define(NONE,0) #no precedence or associativity define(RIGHT,1) #right association define(LEFT,2) #left association define(NON,3) #no associativity allowed define(TOK,4) #flag for token keyword ### blkbeg - output beginning of block data statement containing LR tbl arrays # # call blkbeg # # outputs declaration and common statements for each of the LR table arrays # The statements are in fortran (hence the rat4 escape char '%'), becuz # the modcomp rat4 can't handle large block data statements subroutine blkbeg include "lrgen.c" string blbeg "@n% block data@n" string int1 "integer tran, ftrn, ent, fred, nset, dbg@n" string int2 "integer prod, lhs, len, lset, finalstate, ls@n" string com1 "common /yyfrcm/ fred(" string com2 "common /yynscm/ nset(" string com3 "common /yyltcm/ lset(" string com4 "common /yyprcm/ prod(" string com5 "common /yylncm/ len(" string com6 "common /yylhcm/ lhs(" string com7 "common /yyftcm/ ftrn(" string com8 "common /yytrcm/ finalstate, tran(" string com9 "common /yyencm/ dbg, ent(" string blanks "% " string com10 "common /yylscm/ ls(" string comend ")@n" string findat "data finalstate, dbg/" string finend "/@n" call putlin( blbeg, STDOUT ) call putlin( blanks, STDOUT ) call putlin( int1, STDOUT ) call putlin( blanks, STDOUT ) call putlin( int2, STDOUT ) call putlin( blanks, STDOUT ) call putlin( com1, STDOUT ) call putint( nstate+1, 5, STDOUT ) call putlin( comend, STDOUT ) call putlin( blanks, STDOUT ) call putlin( com2, STDOUT ) call putint( (nxtred-1)/2, 5, STDOUT ) call putlin( comend, STDOUT ) call putlin( blanks, STDOUT ) call putlin( com3, STDOUT ) call putint( ncsets+1, 5, STDOUT ) call putlin( comend, STDOUT ) call putlin( blanks, STDOUT ) call putlin( com4, STDOUT ) call putint( (nxtred-1)/2, 5, STDOUT ) call putlin( comend, STDOUT ) call putlin( blanks, STDOUT ) call putlin( com5, STDOUT ) call putint( numprd, 5, STDOUT ) call putlin( comend, STDOUT ) call putlin( blanks, STDOUT ) call putlin( com6, STDOUT ) call putint( numprd, 5, STDOUT ) call putlin( comend, STDOUT ) call putlin( blanks, STDOUT ) call putlin( com7, STDOUT ) call putint( nstate+1, 5, STDOUT ) call putlin( comend, STDOUT ) call putlin( blanks, STDOUT ) call putlin( com8, STDOUT ) call putint( nxttrn-1, 5, STDOUT ) call putlin( comend, STDOUT ) call putlin( blanks, STDOUT ) call putlin( com9, STDOUT ) call putint( nstate+1, 5, STDOUT ) call putlin( comend, STDOUT ) call putlin( blanks, STDOUT ) call putlin( com10, STDOUT ) call putint( lsets, 5, STDOUT ) call putlin( comend, STDOUT ) call putlin( blanks, STDOUT ) call putlin( findat, STDOUT ) call putint( ifinal, 5, STDOUT ) call putc( ',' ) if ( toggle('3') != 0 ) call putint( YES, 3, STDOUT ) else call putint( NO, 3, STDOUT ) call putlin( finend, STDOUT ) return end ### blkend - outputs END of block data statement # # call blkend # # outputs "END" to ERROUT subroutine blkend string bend "% end@n" call putlin( bend, STDOUT ) ### DEBUGGING LRGEN CODE #call info return end ### findmatch - determines conflicting token in 2 rules' token sets # # ptr = findmatch ( set1, set2 ) # ptr - ptr to conflicting token in set1 # set1 - set ptr for losing rule in conflict # set2 - set ptr for winning rule # integer function findmatch( set1, set2 ) integer set1, set2 include "lrgen.c" integer ys2 ys2 = set2 findmatch = set1 while ( ys2 != 0 ) #until a match is found { if ( item(ys2) == item(findmatch) ) #found a match ys2 = 0 else if ( item(ys2) < item(findmatch) ) #none match item(ys2) ys2 = nxt(ys2) else findmatch = nxt(findmatch) } return end ### getint - turns definition into integer and deletes def from token tables # # num = getint( def ) # num - computed integer definition # def - pointer into token tables for definition, returned by scan # integer function getint( def ) integer def integer length #number of digits in def character larray(10) #character definition integer i, ctoi #converts char to int include "lrgen.c" ### get string containing character definition length = ( sstptr - sthead(shdptr) ) + 1 for ( i = 0; i < length; i = i + 1 ) larray(i+1) = sstore(sthead(def) + i) larray(length+1) = EOS ### convert character representation to an integer i = 1 getint = ctoi( larray, i ) ### delete definition from token tables sstptr = sthead(shdptr) - 1 shdptr = shdptr - 1 return end ### getsection - identifies token section by keyword # # call getsection( section ) # section - LEFT: if '%left' keyword recognized # RIGHT: if '%right' keyword recognized # NON: if '%nonassoc' keyword # TOK: if '%token' keyword # ERR: otherwise # subroutine getsection( section ) integer section character larray(MAXLINE) integer equal, len include "lrgen.c" string tk "token" string lf "left" string rt "right" string no "nonassoc" i = sthead(shdptr) #pointer to keyword len = ( sthead(shdptr+1) - sthead(shdptr) ) - 1 section = ERR if ( sstore(i) == '%' ) #check first letter { for ( j = 1; j <= len; j = j + 1 ) #get keyword string larray(j) = sstore(i + j) #from string storage larray(len + 1) = EOS #add end of string char if ( equal( larray, tk ) == YES ) #if '%token' keyword section = TOK else if ( equal( larray, lf ) == YES ) #check for %left section = LEFT else if ( equal( larray, rt ) == YES ) #check for %right section = RIGHT else if ( equal( larray, no ) == YES ) #check for %nonassoc section = NON } if ( section != ERR ) #got a keyword { sstptr = sthead(shdptr) - 1 #delete from token tables shdptr = shdptr - 1 } return end ### gettokens - read in token declarations # # call gettokens # # Reads in tokens and their definitions. Gets precedence and associativity # values for the tokens that have them # subroutine gettokens integer maxdefault #default token value integer token #token returned by scan integer num #integer definition value integer def #definition returned by scan integer getint #converts definitn to integer integer curprec #current precedence level integer prec #precedence of current line integer curassoc #associativity of curren line integer section #associativity flag #declarations for LRGEN common variables include "lrgen.c" #initialize variables for user declared terminals maxdefault = MINDEFAULT #first token default curprec = NONE #currnt preced level prec = NONE curassoc = NONE #current associativty call scan( token ) #get first word #read in all token names and their definitions and precedences #stop when '&P' encountered while ( prdend == 0 ) { call getsection( section ) #determine keyword switch ( section ) { case LEFT: #left associativity curassoc = LEFT prec = prec + 1 #increment precedence curprec = prec # level case RIGHT: #right assoc (%right) curassoc = RIGHT prec = prec + 1 #increment level curprec = prec case NON: #non-associative curassoc = NON # (%nonassoc) prec = prec + 1 #increase prec-level curprec = prec case TOK: #no associativity curassoc = NONE # (%token) curprec = NONE #don't increase p-level default: #not a keyword call scan( def ) #must be definition yylastok = token #flag last token num = getint( def ) #get integer definition yydefs(token) = num yytprec(token) = curprec #precedence level yyassoc(token) = curassoc #token's associativity if ( num > maxdefault ) #get maximum default maxdefault = num rgtuse(token) = 1 #flag as terminal } call scan( token ) #read in next token } #fill in the rest of the arrays with default values yydefs(ENDTOK) = YYENDTOK #end-token definition yydefs(STARTOK) = maxdefault + 1 #start-symbol def maxdefault = maxdefault + 2 for ( i = shdptr + 1; i <= 500; i = i + 1 ) { yydefs(i) = maxdefault maxdefault = maxdefault + 1 } return end ### info - print table information before printing tables in TABLEA # subroutine info include "lrgen.c" # string sp10 " " # string sp30 " " # string sp20 " " string lenstr "@NLENCSL:" string ncsstr ", NCSETS:" string numstr ", NUMPRD:" string nvostr "@N NVOC:" string nxtstr ", NXTRED:" string prdstr ", PRDPTR:" string lststr "@NLSTPTR:" string ltokstr "@nYYLASTOK: " string indstr ", INDBAS:" string sststr ", SSTPTR:" string shdstr "@NSHDPTR:" string nxttstr ", NXTTRN:" # string basstr "@n@n HEADCS ITEM NEXT@N" # string bass2 "@n@nBASIS@n" # string prostr "@N@N PRDIND PRODCN@N" # string prline "@N TPREC ASSOC RPREC@N" # string lasstr "@n@n TRAN YYDEFS THEDPT RED@N" call putlin( ltokstr, ERROUT ) call putint( yylastok, 5, ERROUT ) call putch('@n', ERROUT ) call putlin( lenstr, ERROUT ) call putint( lencsl, 5, ERROUT ) call putlin( ncsstr, ERROUT ) call putint( ncsets, 5, ERROUT ) call putlin( numstr, ERROUT ) call putint( numprd, 5, ERROUT ) call putlin( nvostr, ERROUT ) call putint( nvoc, 5, ERROUT ) call putlin( nxtstr, ERROUT ) call putint( nxtred, 5, ERROUT ) call putlin( prdstr, ERROUT ) call putint( prdptr, 5, ERROUT ) call putlin( lststr, ERROUT ) call putint( lstptr, 5, ERROUT ) call putlin( indstr, ERROUT ) call putint( indbas, 5, ERROUT ) call putlin( sststr, ERROUT ) call putint( sstptr, 5, ERROUT ) call putlin( shdstr, ERROUT ) call putint( shdptr, 5, ERROUT ) call putlin( nxttstr, ERROUT ) call putint( nxttrn, 5, ERROUT ) call putch( '@n', ERROUT ) # call putlin( bass2, ERROUT ) # for ( i = 1; i <= indbas; i = i + 20 ) # { # jend = i + 19 # for ( j = i; j <= jend & j <= indbas; j = j + 1 ) # call putint( basis(j), 5, ERROUT ) # call putch( NEWLINE, ERROUT ) # } # call putlin( basstr, ERROUT ) # for ( i = 1; i <= lstptr; i = i + 1 ) # { # call putint( headcs(i), 15, ERROUT ) # call putint( item(i), 15, ERROUT ) # call putint( nxt(i), 15, ERROUT ) # call putch( NEWLINE, ERROUT ) # } # call putlin( prostr, ERROUT ) # for ( i = 1; i <= numprd | i <= prdptr; i = i + 1 ) # { # if ( i <= numprd ) # call putint( prdind(i), 20, ERROUT ) # else # call putlin( sp20, ERROUT ) # if ( i <= prdptr ) # call putint( prodcn(i), 20, ERROUT ) # call putch( NEWLINE, ERROUT ) # } # call putlin( lasstr, ERROUT ) # for ( i = 1; i <= nxttrn | i <= nvoc | i <= nxtred; i = i + 1 ) # { # if ( i <= nxttrn ) # call putint( tran(i), 10, ERROUT ) # else # call putlin( sp10, ERROUT ) # if ( i <= nvoc ) # { # call putint( yydefs(i), 15, ERROUT ) # call putint( thedpt(i), 15, ERROUT ) # } # else # call putlin( sp30, ERROUT ) # if ( i<= nxtred ) # call putint( red(i), 15, ERROUT ) # call putch( NEWLINE, ERROUT ) # } # call putlin( prline, ERROUT ) # for ( i = 1; i <= nvoc; i = i + 1 ) # { # call putint( yytprec(i), 10, ERROUT ) # call putint( yyassoc(i), 10, ERROUT ) # call putint( yyrprec(i), 10, ERROUT ) # call putch( NEWLINE, ERROUT ) # } return end ### newlin - lrgen input routine # # call newlin # # Calls getlin to read in next line from STDIN. # subroutine newlin integer getlin string unexpeof "lrgen: unexpected end of file in input source." include "lrgen.c" while ( linbuf(linptr) == EOS | linbuf(linptr) == '@n' ) { if ( getlin( linbuf, STDIN ) == EOF ) call error( unexpeof ) linptr = 1 lineno = lineno + 1 call skipbl( linbuf, linptr ) } return end ### redred - try to resolve a reduce-reduce conflict # # call redred( lastrule, firstrule ) # # lastrule - last rule that will be tested by parser # firstrule - first rule to be recognized by parser # # Redred determines if the conflict can be resolved by rule precedence. # It it can, the conflict is resolved. # Otherwise, a warning message is printed and the the conflict is resolved # in favor of the earliest input rule. If the 'firstrule' is the # earliest input, nothing need be done, since by default the parser # will reduce by the correct rule, otherwise a new follow set must # be created for 'firstrule', without the conflicting token. This is # so the parser won't reduce by the 'firstrule', because it won't find # the token in 'firstrules' follow set. # subroutine redred( r2, r1 ) integer r1, r2 include "lrgen.c" #first determine if both rules have a precedence if ( yyrprec(red(r1)) == NONE | yyrprec(red(r2)) == NONE ) { #Can't resolve conflict by precedence rules, so print #a warning message. call rrerr( red(r1), red(r2) ) #If the first rule was not the first rule input, create #a new lookahead set for the 1st rule, minus the conflicting token if ( red(r2) < red(r1) ) call rradd( r1, r2 ) } #Both rules have precedence, so make sure the first rule has #the highest precedence. If not, delete conflicting token from #lookahead set for the first (and losing) rule. else if ( yyrprec(red(r2)) > yyrprec(red(r1)) ) #2nd rule wins call rradd( r1, r2 ) #new lookahead set else if ( yyrprec(red(r2)) == yyrprec(red(r1)) ) #same precedecnce { if ( red(r2) < red(r1) ) #1st rule loses call rradd( r1, r2 ) } return end ### rradd - creates a new token set for the first rule, minus a token # # call rradd( r1, r2 ) # r1 - ptr to rule that needs a new set # r2 - ptr to rule that won the conflict # # RRadd creates a new token set for 'r1', minus the token which caused # the Reduce/Reduce conflict between 'r1' and 'r2'. # subroutine rradd( r1, r2 ) integer r1, r2 integer set1 #ptr to set for r1 integer set2 #ptr to token set for r2 integer findmatch #checks if conflicting token integer ylstptr #ptr into list of token sets integer nptr #ptr to new entry in set list integer lenptr #ptr into list of set lengths integer lptr #new entry in list of lengths string nosets "-rradd: no context sets found to resolve REDUCE/REDUCE ." include "lrgen.c" set1 = red(r1+1) #get 1st token set ptr set2 = red(r2+1) #get 2nd token set ptr #Add a new entry into the list of pointers for the token sets. #Create a new header for the new token set. for ( i = 1; i <= nterms & headcs(i) == 0; i = i + 1 ); if ( i > nterms ) call error( nosets ) for ( ylstptr = headcs(i); nxt(ylstptr) != 0; ylstptr = nxt(ylstptr) ); call new( nxt(ylstptr) ) #add new pointer entry call new( nptr ) #header for new set item(nxt(ylstptr)) = nptr #connect to pointer list red(r1+1) = nptr #connect with rule 'r1' #Copy all entries in set1 into new set, except the conflicting token while ( nxt(set1) != 0 ) #while more entries { set1 = nxt(set1) #get next entry from set1 if ( findmatch( set1, nxt(set2) ) == NO ) #check if token conflicts { #copy into new set call new( nxt(nptr) ) #get new entry for new set nptr = nxt(nptr) item(nptr) = item(set1) #copy token into new entry } } return end ### rrerr - print warning message for unresolved reduce/reduce conflict # # call rrerr( r1, r2 ) # r1, r2 - ptrs for conflicting rules # subroutine rrerr( r1, r2 ) integer r1, r2 string warnstr "@nWARNING: Unresolved REDUCE/REDUCE conflict." string rulstr "@n Conflict involves rules:" string defstr "@n Default is to reduce by rule:" call putlin( warnstr, ERROUT ) call putlin( rulstr, ERROUT ) call putint( r1, 5, ERROUT ) call putch( ',', ERROUT ) call putint( r2, 5, ERROUT ) call putlin( defstr, ERROUT ) if ( r1 < r2 ) call putint( r1, 5, ERROUT ) else call putint( r2, 5, ERROUT ) call putch( '@n', ERROUT ) return end ### shtred - determines and resolves SHIFT/REDUCE conflicts # # call shtred( rule, trnptr, token ) # rule - ptr for rule involved in conflict # trnptr - ptr for transition state involved in conflict # token - conflicting token # # Shtred determines if both the rule and token involved in the conflict # have precedence. If not, a warning message is printed and a shift # is done by default. If both have precedence and the token has greater # precedence, nothing is done since a SHIFT is always attempted first # by the parser. If the rule wins, the transition state is deleted from # the list of transitions. If the rule and the token have equal # precedence, the associativity of the token resolves the conflict. # If the token is left associative a REDUCE is done, right associativity # means SHIFT which is done by default by the parser. If the token # was declared to be NON-ASSOCIATIVE, the state is flagged and # the parser will catch any attempt to associate the token. # subroutine shtred( rule, trnptr, token ) integer rule, trnptr, token integer state include "lrgen.c" state = basis(tran(trnptr)) #state to SHIFT to if ( yyrprec(rule) == NONE | yytprec(token) == NONE ) call srerr( rule, state, token ) else if ( yyrprec(rule) > yytprec(token) ) tran(trnptr) = YYNOTRAN else if ( yyrprec(rule) == yytprec(token) ) switch ( yyassoc(token) ) { case LEFT: tran(trnptr) = YYNOTRAN case NON: tran(trnptr) = -tran(trnptr) #flag as non-associative default:; } return end ### srerr - print warning message of unresolved SHIFT/REDUCE conflict # # call srerr( rule, state, token) # rule - number of rule involved in SHIFT/REDUCE conflict # state - number of state involved in conflict # subroutine srerr( rule, state, token) integer state, rule, token string warnstr "@nWARNING: Unresolved SHIFT/REDUCE conflict." string invstr "@n State, Rule, and Token involved are:" string andstr ", and" string defstr "@n Default action is to SHIFT.@n" include "lrgen.c" call putlin( warnstr, ERROUT) call putlin( invstr, ERROUT ) call putint( state, 5, ERROUT ) call putch( ',', ERROUT ) call putint( rule, 5, ERROUT ) call putlin( andstr, ERROUT ) call putint( yydefs(token), 5, ERROUT ) call putlin( defstr, ERROUT ) call putch( '@n', ERROUT ) return end #-t- lrglb 23853 ascii 07Jan84 11:50:47 #-t- lrglb.all 27001 ascii 07Jan84 11:52:54