#-h- lex.all 228984 ascii 15-Jan-84 21:26:07 #-h- lex.doc 10030 ascii 05Jan84 07:45:57 .pl 64 .m1 2 .m2 3 .m3 3 .m4 3 .po 10 .rm 62 .bp 1 .in 0 .he ^lex(1)^^lex(1)^ .fo ^^- # -^^ .in 5 .sp .ne 2 .fi .ti -5 NAME .br lex - lexical analyzer generator .sp .ne 2 .fi .ti -5 SYNOPSIS .br .nf lex [-d] [-v] [file] ... .sp .ne 2 .fi .ti -5 DESCRIPTION .br .ne 6 .sp 2 .bd .ul 1. Flags .ne 3 .sp .in +4 .ta 4 .ti -4 -v verbose mode; output usage statistics at the end .in -4 .ne 3 .sp .in +4 .ta 4 .ti -4 -d debug mode; output debug information during runtime .in -4 .ne 6 .sp 2 .bd .ul 2. Overview. .ne 3 .sp Lex generates a program from its input files to perform simple lexical analyis of text. The input files to lex (standard input default) contain regular expressions which the generated program will search the text for. The input files also contain actions (ratfor program fragments) which will be executed when their corresponding regular expression is matched. .ne 3 .sp The output from lex is a ratfor program defining the integer function lexscan. When the generated program containing lexscan is compiled, linked, and executed, it will search its input text for strings matching the regular expressions, and execute the corresponding action. Text that is not matched by any expression is simply copied to the output. .ne 3 .sp Here is a diagram of the situation: .sp .nf .in +4 regular +---------+ expressions, ----> | lex | ----> lexscan actions +---------+ : ................: +---------+ text ----> | lexscan | ----> output +---------+ .sp .fi .in -4 As a simple example, the following lex input is converted into a ratfor program which folds upper case to lower, removes blanks and tabs at the end of lines, and replaces multiple blanks and tabs by single blanks: .sp .nf .in +4 character buf(MAXLINE) ~~ [A-Z]+ { call lexgtext( buf, MAXLINE ) call fold( buf ) call putlin( buf, STDOUT ) } [ @t]+$ [ @t]+ call putc( ' ' ) ~~ DRIVER(massage) integer x, lexscan x = lexscan(0) DRETURN end .sp .fi .in -4 .ne 6 .sp 2 .bd .ul 3. Source format. .ne 3 .sp The general form of a lex input file is: .sp .nf .in +4 (definitions) ~~ (rules) ~~ (user routines) .sp .fi .in -4 Any or all of the three sections may be empty, and if the user routines section is empty, the second "~~" may be left out; if both the rules section and the user routines section is empty, both tildes may be left out. The shortest legal lex input is an empty file. The program generated from this simply copies its input to its output. .ne 6 .sp 2 .ul 3.1 Definitions section. .ne 3 .sp The definitions section can contain the following forms of definitions: .ne 3 .sp .in +8 .ta 7r .ti -8 (1) Name definitions .in -8 .ne 3 .sp .in +8 .ta 7r .ti -8 (2) Ratfor definitions. .in -8 .ne 3 .sp .in +8 .ta 7r .ti -8 (3) Start condition definitions. .in -8 .ne 3 .sp The formats are as follows. .ne 3 .sp .ul Name definitions, in the form .sp .nf .in +4 (name) (translation) .sp .fi .in -4 For example, .sp .nf .in +4 DIGIT [0-9] LETTER [a-zA-Z] IDENT {LETTER}({LETTER}|{DIGIT})* .sp .fi .in -4 Names may be made up of any printable characters, except that they must not begin with a digit. Name definitions must start in column 1. .ne 3 .sp .ul Ratfor definitions, in the form .sp .nf .in +4 (whitespace) (code) .sp .fi .in -4 Anything that does not start in column 1 is assumed to be code and is copied to the output file at the beginning of the function lexscan. Since the actions defined in the rules section (see below) are also placed within lexscan, this is the place to put ratfor defines, declarations, common blocks, and whatnot. .ne 3 .sp Ratfor definitions which must start in column 1 can be entered in the following form: .sp .nf .in +4 ~{ (code) ~} .sp .fi .in -4 .ne 3 .sp .ul Start condition definitions, given in the form .sp .nf .in +4 ~S (name1) (name2) ... .sp .fi .in -4 Start conditions are referenced in the rules section by beginning a regular expression with "", and by the special action "BEGIN(name)". They specify that the rule they are prefixed to is active only at certain times. .ne 3 .sp .ul Comments (lines beginning with a '#' in column 1) are ignored. .ne 6 .sp 2 .ul 3.2 Rules section. .ne 3 .sp Lines in the rules section have the form .sp .nf .in +4 (expression) (action) .sp .fi .in -4 .ne 6 .sp 2 .ul 3.2.1 Regular expressions. .ne 3 .sp Regular expressions in lex are .ul different from the regular expressions in ch, find, and ed. There is a common subset of operators which are exactly the same in all four programs, but lex also allows a number of new operators which the other programs don't know about. .ne 3 .sp The following are the operators which are common to all four programs: .sp .nf .in +4 c the character "c". [...] character class - any one of these characters. [x-z] a character class specified as a range. [!...] negated character class - any character but these. ? any character but NEWLINE. %e an e at the beginning of a line. e$ an e at the end of a line. e* 0, 1, 2, ... instances of e. @c a "c", even if c is an operator. @xxx any valid escape sequence (see esc(2)) .sp .fi .in -4 Here are the operators which are unique to lex: .sp .nf .in +4 "xyz" xyz, even if it contains operators. e+ 1, 2, 3, ... instances of e. e|f an e or an f. (e) an e. Used to group operators, like in arithmetic. e/f an e, but only if followed by f. {xx} the translation of xx from the definitions section. e{m,n} m through n occurrences of e. e{m,} m or more occurences of e. e{m} exactly m occurences of e. e\ an optional e e an e when lex is in start condition a. .sp .fi .in -4 .ne 6 .sp 2 .ul 3.2.2 Actions. .ne 3 .sp Actions are ratfor program fragments. If they are more that one line long, they may be continued on the following lines by enclosing them in braces. .ne 3 .sp The actions can pass a integer value back to the main program by saying "return( value )", and can pass other values back via common variables. .ne 3 .sp The following special routines are available to actions: .ne 3 .sp .in +20 .ta 20 .ti -20 ECHO A macro which simply writes the current matched text to STDOUT. .in -20 .ne 3 .sp .in +20 .ta 20 .ti -20 lexgtext(buf,len) A subroutine which will place the matched text into the argument buf, which had size len. .in -20 .ne 3 .sp .in +20 .ta 20 .ti -20 lexmore A subroutine which can be called to indicate that the next input expression recognized is to be tacked on to the end of the current text, instead of replacing it. .in -20 .ne 3 .sp .in +20 .ta 20 .ti -20 lexless( n ) A subroutine which can be called to indicate that not all the characters matched by the currently successful expression are wanted right now. The argument n indicates the number of characters to be retained. .in -20 .ne 3 .sp .in +20 .ta 20 .ti -20 lexreject Means "go to the next alternative". A subroutine which causes whatever rule was second choice after the current rule to be executed instead. .in -20 .ne 3 .sp .in +20 .ta 20 .ti -20 BEGIN(name) A macro which tells lex to enter start condition "name". Until the next BEGIN action is executed, rules with the start condition "name" will be active. Rules with other start conditions will be inactive. Rules with no start conditions at all are always active. To go back to the normal state where only the rules with no start conditions are active, do a "call BEGIN(0)". .in -20 .ne 3 .sp These routines may be replaced by others versions as desired by the user. See lexlb(2). .ne 6 .sp 2 .ul 3.3 User routines section. .ne 3 .sp This section is simply copied verbatim to the output program. Any user-written subroutines or functions referenced by the actions may be put here. The main program may also be put here, or, if the user prefers, the main program and auxillary routines may be compiled seperately and linked in. .ne 6 .sp 2 .bd .ul 4. Debugging Lex Programs .ne 3 .sp The -d flag will cause the code's debug actions to be compiled in. The debug actions are to write to the error output lines of the form: .sp .nf .in +4 --accepting #-- .sp .fi .in -4 each time a rule matches, where # is the number of the rule (starting with the first rule being numbered 1). A rule numbered one greater than the last user rule is the default rule which matches any character and echoes it to the standard output. A rule number two greater than the last user rule is the rule which matches end-of-file. .sp .ne 2 .fi .ti -5 FILES .br .%lib/lexskel skeleton program to be filled out .%incl/lexskcom common block for lexskel .%lib/lexlb support routines library to link to .sp .ne 2 .fi .ti -5 SEE ALSO .br .nf lextut(tutorial), lexlb(2). Unix(TM) manual entries for lex(1). "Principles of Compiler Design", Aho and Ullman, chapter 3. "LEX - a lexical analyzer generator", M. E. Lesk and E. Schmidt. .sp .ne 2 .fi .ti -5 AUTHOR(S) .br Vern Paxson. Evolved from an original implementation by Jef Poskanzer, with the help of many ideas from Van Jacobson. .sp .ne 2 .fi .ti -5 BUGS/DEFICIENCIES .br .ne 3 .sp The action routines lexmore, lexless, and lexreject have not been implemented. .ne 3 .sp If a literal dash ('-') is to appear in a character class, it must be the first character class element, or it must be escaped. .ne 3 .sp A literal left brace ('{') appearing anywhere in a rule must be escaped, including within quotes or character classes. .ne 3 .sp Trailing context must have a fixed size (i.e. no use of '*', '|', '+', '{m,n}', '{m,}', or '\' operators). .ne 3 .sp There must be no whitespace between the macro invocation of BEGIN and its argument. That is, "BEGIN( x )" is incorrect; "BEGIN(x)" is correct. .ne 3 .sp Name definitions within quotes or character classes (e.g. '[a-z{DIGIT}]') will introduce extraneous parentheses (if DIGIT in the previous example were defined to be '0-9', then the resulting character class would be '[a-z(0-9)]'). #-t- lex.doc 10030 ascii 05Jan84 07:45:57 #-h- lex.inc 11735 ascii 05Jan84 07:45:59 #-h- bsdef 1107 ascii 05Jan84 07:45:29 # bsdef - defines for bslb #nolist define(BS_NUMBITS_OFFSET,1) define(BS_NUMINTS_OFFSET,2) # number of integer words in bit string define(BS_BITS_OFFSET,3) define(BS_EXTRASIZE,2) define(BS_MAX_LOOP_NESTING,10) ifdef(VAX) define(BITS_IN_INTEGER,32) define(BS_NIL,0) # not a possible value returned from memalloc enddef ifdef(MODCOMP) define(BITS_IN_INTEGER,16) define(BS_NIL,-1) enddef ifdef(PDP10) define(BITS_IN_INTEGER,36) define(BS_NIL,0) enddef # maximum number of integer words in bit string; enough for 5000 bits define(MAX_BS_SIZE,arith(arith(5000,/,BITS_IN_INTEGER),+,1)) # must include "bscom" and call bslbinit to use the following macro define(BS_WORD_FROM_BITPOS,bwmap(($1)+1)) # generates a bitword with bit $1 set # must include "bscom" to use the following macro # if the passed argument corresponds to the cache, invalidate the cache define(BS_STOP_CACHE,{ if ( curlvl != 0 ) if ( bsptr(curlvl) == $1 ) cacheinvalid = .true. }) define(BS_BITNUM_DECOMP,{ $2 = ($1) / BITS_IN_INTEGER $3 = mod($1,BITS_IN_INTEGER) }) # returns bitword and bit positions #list #-t- bsdef 1107 ascii 05Jan84 07:45:29 #-h- lexdef 10368 ascii 05Jan84 07:45:29 # # Symbol definitions for lex. # # modification history # -------------------- # 01b tab 28nov83 .changed DATAINDENTSTR to always be 6 spaces # 01a vp ??????? .written # ifdef(VAX) define(NOIMPLICIT,implicit none) # maximum number of characters per line recognized by Fortran compiler define(DATALINEWIDTH,72) enddef ifnotdef(VAX) define(NOIMPLICIT,) define(DATALINEWIDTH,72) enddef # string to indent Fortran data statements with define(DATAINDENTSTR," ") # width of dataindent string in Fortran columns define(DATAINDENTWIDTH,6) # value pushed back by scanner and later read to associate action # in the generated machine with reading an EOF define(EOF_PUSH_BACK_SYM,-2) # returns true if an nfa state has an epsilon out-transition slot # that can be used. define(FREE_EPSILON,(transchar($1) == SYM_EPSILON & trans2($1) == NO_TRANSITION & finalst($1) != $1)) # returns true if an nfa state has an epsilon out-transition character # and both slots are free define(SUPER_FREE_EPSILON,(transchar($1) == SYM_EPSILON & trans1($1) == NO_TRANSITION)) # maximum size of stack of nfa states that need to be visited in epsclosure define(EPSCLOSURESTKSIZE,200) #define(DUMPFA,) # comment in to dump NFA define(NIL,0) define(JAM,-1) define(NO_TRANSITION,NIL) define(UNIQUE,-1) define(ITER_INFINITY,-1) # highest number symbol of any type - ceiling on number of start conditions define(MAX_SYMBOL,161) define(MIN_SYMBOL,1) # character class numbers grow more negative, starting with zero define(LASTCCLINIT,0) define(MAXCCLS,127) define(MAX_REAL_SYMBOL,127) # maximum number of nfa states define(MNS,2000) define(MAX_DFAS,1000) define(DEFBASE,MAX_DFAS) # maximum number of nxt/chk pairs define(MAX_XPAIRS,5000) define(SYM_EPSILON,incr(MAX_REAL_SYMBOL)) define(SYM_EOF,incr(SYM_EPSILON)) define(SYM_BOL,incr(SYM_EOF)) # start conditions grow upwards, starting with one greater than the # '%' pseudo start-condition define(LASTSCINIT,SYM_BOL) # maximum number of start conditions. This number should be the same # as MAX_SYMBOL define(MAXSC,arith(LASTSCINIT,+,30)) define(ONE_STACK_SIZE,500) define(SAME_TRANS,-1) # the percentage the number of out-transitions a state must be of the # number of equivalence classes in order to be considered for table # compaction by using protos define(PROTO_SIZE_PERCENTAGE,15) # the percentage the number of homogeneous out-transitions of a state # must be of the number of total out-transitions of the state in order # that the state's transition table is first compared with a potential # template of the most common out-transition instead of with the first # proto in the proto queue define(CHECK_COM_PERCENTAGE,50) # the percentage the number of differences between a state's transition # table and the proto it was first compared with must be of the total # number of out-transitions of the state in order to keep the first # proto as a good match and not search any further define(FIRST_MATCH_DIFF_PERCENTAGE,10) # the percentage the number of differences between a state's transition # table and the most similar proto must be of the state's total number # of out-transitions to use the proto as an acceptable close match define(ACCEPTABLE_DIFF_PERCENTAGE,50) # the percentage the number of homogenous out-transitions of a state # must be of the number of total out-transitions of the state in order # to consider making a template from the state define(TEMPLATE_SAME_PERCENTAGE,60) # the percentage the number of differences between a state's transition # table and the most similar proto must be of the state's total number # of out-transitions to create a new proto from the state define(NEW_PROTO_DIFF_PERCENTAGE,20) # the percentage the total number of out-transitions of a state must be # of the number of equivalence classes in order to consider trying to # fit the transition table into "holes" inside the nxt/chk table. define(INTERIOR_FIT_PERCENTAGE,15) # size of region set aside to cache the complete transition table of # protos on the proto queue to enable quick comparisons define(PROT_SAVE_SIZE,2000) # maximum number of saved protos (protos on the proto queue) define(MSP,50) # maximum number of lex rules allowed in section 2 define(MAXRULES,300) # Declarations and common blocks for lex global variables. # Common block for flags # printstats is the -v flag # syntaxerror is true if a syntax error has been found # endseen is true if the scanner has pushed back the default patterns # ddebug is the -d flag define(LEX_FLAGS,logical printstats,syntaxerror,endseen,ddebug common/lstats/ printstats,syntaxerror,endseen,ddebug) # Common block used in the lex input routines. # datapos is characters on current output line # skelfile is fd of the skeleton file # fileq is a queue containing the files to be processed # infile is the current input file # pbstack is the push-back stack # filenum is the current input file number # linenum is the current input line number # lastch is last character read define(LEX_IO,integer datapos,skelfile,fileq,infile,pbstack,filenum,linenum character lastch common /lexio/ datapos,skelfile,fileq,infile,pbstack,filenum,linenum,lastch) # Common block for stack of states having only one out-transition # onestate is state number # onesym is transition symbol # onenext is target state # onedef is the default base entry # onesp is stack pointer define(LEX_1STACK,integer onestate(ONE_STACK_SIZE),onesym(ONE_STACK_SIZE), onenext(ONE_STACK_SIZE),onedef(ONE_STACK_SIZE),onesp common /lex1st/ onestate,onesym,onenext,onedef,onesp) # Common block of nfa machine data # accnum is the number of the last accepting state # firstst is physically the first state of a fragment # lastst is the last physical state of fragment # finalst is the last logical state of fragment # transchar is the transition character # trans1 is the transition state # trans2 is the 2nd transition state for epsilons # accptnum is the accepting number # lastnfa is the last nfa state number created # optsc is the first state of a fragment which represents all start # conditions as optional # free is the 'or' of all rules not bound by start-conditions # bound is the 'or' of all rules bound by start-conditions define(LEX_NFA_DECL,integer accnum,firstst(MNS),lastst(MNS),finalst(MNS), transchar(MNS),trans1(MNS),trans2(MNS),accptnum(MNS),lastnfa,optsc,free,bound) define(LEX_NFA_COM,common/lexnfa/ accnum,firstst,lastst,finalst,transchar, trans1,trans2,accptnum,lastnfa,optsc,free,bound) define(LEX_NFA,LEX_NFA_DECL LEX_NFA_COM) # Common block for protos # numtemps is the number of templates created # numprots is the number of protos created # protprev is the backlink to a more-recently used proto # protnext is the forward link to a less-recently used proto # prottbl is the base/def table entry for proto # protcomst is the common state of proto # firstprot is the number of the most recently used proto # lastprot is the number of the least recently used proto # protsave contains the entire state array for protos define(LEX_PROT_DECL,integer numtemps,numprots,protprev(MSP),protnext(MSP), prottbl(MSP),protcomst(MSP),firstprot,lastprot,protsave(PROT_SAVE_SIZE)) define(LEX_PROT_COM,common/lexprt/ numtemps,numprots,protprev,protnext,prottbl, protcomst,firstprot,lastprot,protsave) define(LEX_PROT,LEX_PROT_DECL LEX_PROT_COM) # Common block for managing equivalence classes # numecs is the number of equivalence classes # nextecm is the forward link of Equivalenc Class members # ecgroup is the state/nextstate or backward link of EC members # nummecs is the number of meta-equivalence classes (used to compress # templates) # tecfwd is the forward link of meta-equivalence classes members # tecbck is the backward link of MEC's define(LEX_ECS,integer numecs,nextecm(MAX_SYMBOL),ecgroup(MAX_SYMBOL), nummecs,tecfwd(MAX_SYMBOL),tecbck(MAX_SYMBOL) common/lexecs/ numecs,nextecm,ecgroup,nummecs,tecfwd,tecbck) # Common block of dfa machine data # lastdfa is the last dfa state number created # nxt is the state to enter upon reading character # chk is the check value to see if 'nxt' applies # base is the offset into 'nxt' for given state # def is where to go if 'chk' disallows 'nxt' entry # defbase is the offset into 'base' for default 'jam' state # tblend is the last 'nxt/chk' table entry being used # firstfree is the first empty entry in 'nxt/chk' table # lasttemp is the number of last template created # dss is the nfa state set for each dfa # das is the accepting set for each dfa # dhash is the dfa state hash value # numas is the number of accepting states created; note that this # is not necessarily the same value as accnum # numsnpairs is the number of state/nextstate transition pairs # jambase is the position in base/def where the default jam table starts define(LEX_DFA_DECL,integer lastdfa,nxt(MAX_XPAIRS),chk(MAX_XPAIRS), base(MAX_DFAS),def(MAX_DFAS),defbase,tblend,firstfree,lasttemp,dss(MAX_DFAS), das(MAX_DFAS),dhash(MAX_DFAS),numas,numsnpairs,jambase) define(LEX_DFA_COM,common/lexdfa/ lastdfa,nxt,chk,base,def,defbase,tblend, firstfree,lasttemp,dss,das,dhash,numas,numsnpairs,jambase) define(LEX_DFA,LEX_DFA_DECL LEX_DFA_COM) # Common block for ccl information # lastccl is the ccl index of the last create ccl (gets more negative # with more ccls) # cclmap maps a ccl index to its set pointer define(LEX_CCL,integer lastccl,cclmap(MAXCCLS) common /lexccl/ lastccl, cclmap) # Common block for miscellaneous information # starttime is the real-time when we started # endtime is the real-time when we ended # lastsc is the last start condition created to date # sectnum is the section number currently being parsed # nummt is the number of empty nxt/chk table entries # trailnum is an array containing the number of trailing context # characters for each rule define(LEX_MISC,character starttime(15),endtime(15) integer lastsc,sectnum,nummt, trailnum(MAXRULES) common/lexmsc/ starttime,endtime,lastsc,sectnum,nummt,trailnum) #-t- lexdef 10368 ascii 05Jan84 07:45:29 #-t- lex.inc 11735 ascii 05Jan84 07:45:59 #-h- lex.y 77936 ascii 05Jan84 07:46:02 ############################################################################### # # L E X # ############################################################################### # # version date initials remarks # ------- ---- -------- ------------------------------------------------------- # 01f 6nov83 tab Fixed version 01e so debug define wouldn't get ouput # more than once. Changed pathopen to open. # 01e 24oct83 tab Added -d flag so skelout would output debug string # if -d arg specified. # 01d 15Oct83 VP Fixed uninitialized string in 'optstring1' production # 01c 08Oct83 VP Fixed bug in checking for table overflow in cmptmps() # 01b 06Sep83 VP Added code to construct meta-equivalence classes to # be used to compress template tables. Added cmptmps() # and cre8ecs(). # Fixed bug in mkentry() which could allow a negative # base address to be generated. # Removed 'total number of transitions' parameter # to mktemp(). # Changed mkeccl() to take a bit-string pointer instead # of a character class as argument. # Miscellaneous tidying. # # 01a 22Aug83 VP Written. Original version by Jef Poskanzer. # ############################################################################### # Lex grammar: # SPACE has to be an explicit token because Yacc does not allow # ' ' as a token %token CHAR 1 DIG 2 SECTEND 3 SCDECL 4 CODESEQBEG 5 CODESEQEND 6 SPACE 32 %{ include "bsdef" # for MAX_BS_SIZE definition in snstods include "lexdef" define(ENDSYM,0) define(INFINITY,-1) define(CHAR,1) define(DIG,2) define(SECTEND,3) define(SCDECL,4) define(CODESEQBEG,5) define(CODESEQEND,6) integer link, mkor, sclookup, mkstate, mkopt, copysingl, mkposcl, mkclos, mkrep integer pat, scnum, scstate, nmptr, eps, trailcnt integer cclp, i character nmstr(MAXLINE), ch logical trailingcontext LEX_NFA LEX_MISC %} %% goal : initlex sect1 sect1end sect2 | initlex sect1end sect2 ; initlex : %{ # initialize for processing rules # bound is the 'or' of all states which are # bound to start conditions. free is the 'or' # of all states which are not bound to start # conditions. # NIL is a hack that is checked for # in mkor and link bound = NIL free = NIL %} ; sect1 : sect1 s1object | s1object | yyerror %{ call synerr( "unknown error processing section 1" ) %} ; s1object : SCDECL whitespace namelist1 optwhitespace '@n' | CODESEQBEG freechars CODESEQEND optwhitespace '@n' | name whitespace string1 '@n' %{ call strim(nmstr($3)) call ndinstal( nmstr($1), nmstr($3) ) nmptr = 0 %} | whitespace optstring1 '@n' %{ call printf( "%s@n", nmstr($2) ) nmptr = 0 %} | '#' optwhitespace optstring1 '@n' %{ nmptr = 0 %} | '@n' ; sect1end : SECTEND %{ # cleanup for end of section 1 call printf( "lexminsc = %d@n", LASTSCINIT+1 ) call printf( "lexmaxsc = %d@n", lastsc ) call printf( "define(SYM_BOL,%d)@n", SYM_BOL ) call printf( "define(SYM_EOF,%d)@n", SYM_EOF ) call skelout sectnum = 2 %} ; sect2 : sect2 initforrule lexrule ruleend | initforrule lexrule ruleend ; initforrule : %{ # initialize for a parse of one rule nmptr = 0 trailingcontext = .false. trailcnt = 0 %} ; lexrule : scon bol re eol %{ pat = link( $3, $4 ) pat = link( $2, pat ) pat = link( $1, pat ) call accept( pat ) trailnum(accnum) = trailcnt call copyaction bound = mkor( bound, pat ) %} | bol re eol %{ pat = link( $2, $3 ) pat = link( $1, pat ) call accept( pat ) trailnum(accnum) = trailcnt call copyaction free = mkor( free, pat ) %} | %{ # the empty production allows # blanks lines in the lex input %} | yyerror %{ call synerr( "unrecognized rule" ) %} ; scon : '<' namelist2 '>' %{ $$ = $2 %} ; namelist1 : namelist1 SPACE name %{ call scinstal( nmstr($3) ) nmptr = 0 %} | name %{ call scinstal( nmstr($1) ) nmptr = 0 %} | yyerror %{ call synerr( "bad start condition list" ) %} ; namelist2 : namelist2 ',' name %{ if ( sclookup( nmstr($3), scnum ) != YES ) { call synerr( "undeclared start condition" ) $$ = $1 } else { scstate = mkstate( scnum ) $$ = mkor( $1, scstate ) } nmptr = 0 %} | name %{ if ( sclookup( nmstr($1), scnum ) != YES ) call synerr( "undeclared start condition" ) else $$ = mkstate( scnum ) nmptr = 0 %} | yyerror %{ call synerr( "bad start condition list" ) $$ = mkstate( SYM_EPSILON ) %} ; name : name namechar %{ nmstr(nmptr) = $2 nmptr = nmptr + 1 nmstr(nmptr) = EOS $$ = $1 %} | CHAR %{ nmptr = nmptr + 1 $$ = nmptr nmstr(nmptr) = $1 nmptr = nmptr + 1 nmstr(nmptr) = EOS %} ; bol : '%' %{ $$ = mkstate( SYM_BOL ) %} | %{ # rules which aren't tied to the beginning of a line # can still match at the beginning of a line, so add # an optional '%' $$ = mkopt( mkstate( SYM_BOL ) ) %} ; eol : '$' %{ if (trailingcontext) { call synerr( "trailing context used twice" ) $$ = mkstate( SYM_EPSILON ) } else { trailingcontext = .true. trailcnt = 1 eps = mkstate( SYM_EPSILON ) $$ = link( eps, mkstate( '@n' ) ) } %} | %{ $$ = mkstate( SYM_EPSILON ) %} ; re : re '|' series %{ if ( trailingcontext ) call synerr( "variable length trailing _ context not allowed" ) $$ = mkor( $1, $3 ) %} | re2 series %{ $$ = link( $1, $2 ) %} | series %{ $$ = $1 %} ; re2 : re '/' %{ # this rule is separate from the others for 're' so # that the reduction will occur before the trailing # series is parsed if (trailingcontext) call synerr( "trailing context used twice" ) else trailingcontext = .true. $$ = $1 %} ; series : series singleton %{ # this is where concatenation of adjacent patterns # gets done $$ = link( $1, $2 ) %} | singleton %{ $$ = $1 %} ; singleton : singleton '*' %{ if ( trailingcontext ) call synerr( "variable length trailing _ context not allowed" ) $$ = mkclos( $1 ) %} | singleton '+' %{ if ( trailingcontext ) call synerr( "variable length trailing _ context not allowed" ) $$ = mkposcl( $1 ) %} | singleton '\' %{ if ( trailingcontext ) call synerr( "variable length trailing _ context not allowed" ) $$ = mkopt( $1 ) %} | singleton '{' number ',' number '}' %{ if ( trailingcontext ) call synerr( "variable length trailing _ context not allowed" ) if ($3 > $5) { call synerr( "bad iteration values" ) $$ = $1 } else $$ = mkrep( $1, $3, $5 ) %} | singleton '{' number ',' '}' %{ if ( trailingcontext ) call synerr( "variable length trailing _ context not allowed" ) $$ = mkrep( $1, $3, INFINITY ) %} | singleton '{' number '}' %{ if ( trailingcontext ) trailcnt = trailcnt + $3 $$ = link( $1, copysingl( $1, $3-1 ) ) %} | '?' %{ call cclinit( cclp ) call ccladd( cclp, '@n' ) # '?' doesn't match newline call cclnegate( cclp ) if ( trailingcontext ) trailcnt = trailcnt + 1 $$ = mkstate( cclp ) %} | '[' ccl ']' %{ if ( trailingcontext ) trailcnt = trailcnt + 1 $$ = mkstate( $2 ) %} | '[' '!' ccl ']' %{ call ccladd( $3, '@n' ) # negated ccls don't match # newline call cclnegate( $3 ) if ( trailingcontext ) trailcnt = trailcnt + 1 $$ = mkstate( $3 ) %} | '"' string2 '"' %{ $$ = $2 %} | '(' re ')' %{ $$ = $2 %} | normal %{ if ( trailingcontext ) trailcnt = trailcnt + 1 $$ = mkstate( $1 ) %} ; number : number DIG %{ $$ = $1 * 10 + ($2 - '0') %} | DIG %{ $$ = $1 - '0' %} ; ccl : ccl cclchar '-' cclchar %{ if ($2 > $4) call synerr( "negative range in character class" ) else for ( i=$2; i <= $4; i=i+1 ) call ccladd( $1, i ) $$ = $1 %} | ccl cclchar %{ call ccladd( $1, $2 ) $$ = $1 %} | firstcclchar '-' cclchar %{ call cclinit( cclp ) if ($1 > $3) call synerr( "negative range in character class" ) else for ( i=$1; i <= $3; i=i+1 ) call ccladd( cclp, i ) $$ = cclp %} | firstcclchar %{ call cclinit( cclp ) call ccladd( cclp, $1 ) $$ = cclp %} | yyerror %{ call synerr( "error in character class" ) call cclinit( cclp ) $$ = cclp %} ; freechars : freechars almostany %{ # used to copy ratfor code blocks appearing in section 1 call putc( $2 ) %} | almostany %{ call putc( $1 ) %} ; optstring1 : string1 | %{ nmptr = nmptr + 1 nmstr(nmptr) = EOS $$ = nmptr %} ; string1 : string1 stringchar %{ nmstr(nmptr) = $2 nmptr = nmptr + 1 nmstr(nmptr) = EOS $$ = $1 %} | string1 '"' %{ nmstr(nmptr) = $2 nmptr = nmptr + 1 nmstr(nmptr) = EOS $$ = $1 %} | ']' %{ nmptr = nmptr + 1 $$ = nmptr nmstr(nmptr) = $1 nmptr = nmptr + 1 nmstr(nmptr) = EOS %} | subcharset %{ # note that string1's cannot begin with whitespace nmptr = nmptr + 1 $$ = nmptr nmstr(nmptr) = $1 nmptr = nmptr + 1 nmstr(nmptr) = EOS %} ; string2 : string2 stringchar %{ pat = mkstate( $2 ) if ( trailingcontext ) trailcnt = trailcnt + 1 $$ = link( $1, pat ) %} | %{ $$ = mkstate( SYM_EPSILON ) %} ; optwhitespace : whitespace | ; ruleend : SPACE | '@t' | '@n' ; whitespace : whitespace SPACE | whitespace '@t' | SPACE | '@t' ; normal : namechar | ',' | '#' | '-' | '!' | ']' ; namechar : CHAR | DIG ; cclchar : basecharset | '!' | '"' | SPACE ; firstcclchar : basecharset | '"' | '-' | SPACE ; almostany : stringchar | '"' | '@n' ; stringchar : subcharset | ']' | SPACE | '@t' ; subcharset : basecharset | '-' | '!' ; basecharset : '<' | '>' | ',' | '%' | '$' | '|' | '/' | '*' | '#' | '+' | '\' | '{' | '}' | '?' | '[' | '(' | ')' | CHAR | DIG ; %% ############################################################################### # ### lex - main program # # synopsis (from the shell) # lex [-v] [file ...] # DRIVER(lex) NOIMPLICIT integer ndfa, dfa, state1 LEX_FLAGS # Initialize. call lexinit # Read in the input file(s). call readin( state1 ) if ( ! syntaxerror ) { # Convert the ndfa to a dfa. call ntod( state1 ) # Generate the ratfor state transition tables from the dfa. call gentabs( state1 ) } # Terminate. call lexend DRETURN end ### accept - add an accepting state to a machine # # synopsis # # call accept( mach ) # # the global ACCNUM is incremented and the new value becomes `mach's # accepting number # subroutine accept( mach ) NOIMPLICIT integer mach, astate, mkstate, link LEX_NFA accnum = accnum + 1 if ( accnum > MAXRULES ) call error( "accept: too many rules" ) # hang the accepting number off an epsilon state. if it is associated # with a state that has a non-epsilon out-transition, then the state # will accept BEFORE it makes that transition, i.e. one character too soon if ( transchar(finalst(mach)) == SYM_EPSILON ) accptnum(finalst(mach)) = accnum else { astate = mkstate( SYM_EPSILON ) accptnum(astate) = accnum mach = link( mach, astate ) } return end ### bldtbl - build table entries for dfa state # # synopsis # integer state(MAX_SYMBOL), statenum, totaltrans, comstate, comfreq # call bldtbl( state, statenum, totaltrans, comstate, comfreq ) # # State is the 'statenum'th dfa state. It is indexed by equivalence class and # gives the number of the state to enter for a given equivalence class. # totaltrans is the total number of transitions out of the state. Comstate # is that state which is the destination of the most transitions out of State. # Comfreq is how many transitions there are out of State to Comstate. # # A note on terminology: # "protos" are transition tables which have a high probability of # either being redundant (a state processed later will have an identical # transition table) or nearly redundant (a state processed later will have # many of the same out-transitions). A 'most recently used' queue of # protos is kept around with the hope that most states will find a proto # which is similar enough to be usable, and therefore compacting the # output tables. # "templates" are a special type of proto. If a transition table is # homogenous or nearly homogenous (all transitions go to the same destination) # then the odds are good that future states will also go to the same destination # state on basically the same character set. These homogenous states are # so common when dealing with large rule sets that they merit special # attention. If the transition table were simply made into a proto, then # (typically) each subsequent, similar state will differ from the proto # for two out-transitions. One of these out-transitions will be that # character on which the proto does not go to the common destination, # and one will be that character on which the state does not go to the # common destination. Templates, on the other hand, go to the common # state on EVERY transition character, and therefore cost only one # difference. # subroutine bldtbl( state, statenum, totaltrans, comstate, comfreq ) NOIMPLICIT integer state(ARB), statenum, totaltrans, comstate, comfreq LEX_ECS LEX_PROT integer extptr, extrct(MAX_SYMBOL,2) integer otherextptr, mindiff, minprot, tbldiff, i, d logical checkcom # If extptr is 1 then the first array of extrct holds the result of the # 'best difference' to date, which is those transitions which occur in # 'state' but not in the proto which, to date, has the fewest differences # between itself and 'state'. If extptr is 2 then the second array of # extrct hold the best difference. The two arrays are used to toggle # between so that the best difference to date can be kept around and # also a difference just created by checking against a candidate 'best' # proto. extptr = 1 # if the state has too few out-transitions, don't bother trying to # compact its tables if ( (totaltrans * 100) < (numecs * PROTO_SIZE_PERCENTAGE) ) call mkentry( state, statenum, DEFBASE, totaltrans ) else { # checkcom is true if we should only check 'state' against # protos which have the same 'comstate' value checkcom = comfreq * 100 > totaltrans * CHECK_COM_PERCENTAGE minprot = firstprot mindiff = totaltrans if ( checkcom ) { # find first proto which has the same 'comstate' for ( i=firstprot; i != NIL; i=protnext(i) ) if ( protcomst(i) == comstate ) { minprot = i mindiff = tbldiff( state, minprot, extrct(1,extptr) ) break } } else { # since we've decided that the most common destination out # of 'state' does not occur with a high enough frequency, # we set the 'comstate' to zero, assuring that if this state # is entered into the proto list, it will not be considered # a template. comstate = 0 if ( firstprot != NIL ) { minprot = firstprot mindiff = tbldiff( state, minprot, extrct(1,extptr) ) } } # we now have the first interesting proto in 'minprot'. If # it matches within the tolerances set for the first proto, # we don't want to bother scanning the rest of the proto list # to see if we have any other reasonable matches. if ( mindiff * 100 > totaltrans * FIRST_MATCH_DIFF_PERCENTAGE ) { # not a good enough match. Scan the rest of the protos for ( i=minprot; i != NIL; i=protnext(i) ) { d = tbldiff( state, i, extrct(1,3 - extptr) ) if ( d < mindiff ) { extptr = 3 - extptr mindiff = d minprot = i } } } # check if the proto we've decided on as our best bet is close # enough to the state we want to match to be usable if ( mindiff * 100 > totaltrans * ACCEPTABLE_DIFF_PERCENTAGE ) { # no good. If the state is homogeneous enough, we make a # template out of it. Otherwise, we make a proto. if ( comfreq * 100 >= totaltrans * TEMPLATE_SAME_PERCENTAGE ) call mktemp( state, statenum, comstate ) else { call mkprot( state, statenum, comstate ) call mkentry( state, statenum, DEFBASE, totaltrans ) } } else { # use the proto call mkentry( extrct(1,extptr), statenum, prottbl(minprot), mindiff ) # if this state was sufficiently different from the proto # we built it from, make it, too, a proto if ( mindiff * 100 >= totaltrans * NEW_PROTO_DIFF_PERCENTAGE ) call mkprot( state, statenum, comstate ) # since mkprot added a new proto to the proto queue, it's possible # that 'minprot' is no longer on the proto queue (if it happened # to have been the last entry, it would have been bumped off). # If it's not there, then the new proto took its physical place # (though logically the new proto is at the beginning of the # queue), so in that case the following call will do nothing. call mv2front( minprot ) } } return end ### ccladd - add a single character to a ccl # # synopsis # integer cclp # character ch # call ccladd( cclp, ch ) # subroutine ccladd( cclp, ch ) NOIMPLICIT integer cclp, getcclset character ch integer int int = ch call bsbset( getcclset( cclp ), int ) return end ### cclinit - make an empty ccl # # synopsis # integer cclp # call cclinit ( cclp ) # subroutine cclinit ( cclp ) NOIMPLICIT integer cclp, cclset call bsinit( cclset, MAX_REAL_SYMBOL ) call mkcclmap( cclset, cclp ) return end ### cclnegate - negate a ccl # # synopsis # integer cclp # call cclnegate( ccl ) # subroutine cclnegate( cclp ) NOIMPLICIT integer cclp, getcclset, cclset, i cclset = getcclset( cclp ) call bscomp( cclset ) # special hack: bscomp negates ALL the bits in cclset, including # possibly some bits which are not legal characters. So clear # any such bits. for ( i=0; i < MIN_SYMBOL; i=i+1 ) call bsbclr( cclset, i ) return end ### ccl2ecl - convert character classes to set of equivalence classes # # synopsis # call ccl2ecl # subroutine ccl2ecl NOIMPLICIT LEX_ECS LEX_CCL integer i, ecset, cclp, ccls, bsloopinit, cclm, getcclset logical bsnext, c2einit data c2einit /.true./ if ( c2einit ) { call bsinit( ecset, MAX_REAL_SYMBOL ) c2einit = .false. } for ( i=LASTCCLINIT-1; i >= lastccl; i=i-1 ) { # we loop through each character class, and for each character # in the class, add the character's equivalence class to the # new 'character' class we are creating. Thus when we are all # done, character classes will really consist of collections # of equivalence classes cclp = getcclset( i ) for ( ccls=bsloopinit( cclp ); bsnext( ccls, cclm ); ) if ( ecgroup(cclm) > 0 ) call bsbset( ecset, ecgroup(cclm) ) call bsendloop( ccls ) call bscopy( ecset, cclp ) call bszero( ecset ) } return end ### cmptmps - compress template table entries # # synopsis # call cmptmps # # template tables are compressed by using the 'template equivalence # classes', which are collections of transition character equivalence # classes which always appear together in templates - really meta-equivalence # classes. until this point, the tables for templates have been stored # up at the top end of the nxt array; they will now be compressed and have # table entries made for them. # subroutine cmptmps NOIMPLICIT LEX_ECS LEX_DFA integer cre8ecs, tmp(MAX_SYMBOL), i, j, totaltrans, trans # the last template created by mktemp() will occupy the lowest # location in the nxt/chk tables of all the templates. So we # can check it to see if the tables have overflowed. if ( lasttemp != DEFBASE ) if ( base(lasttemp) <= tblend ) call error( "cmptmps: state tables overflowed" ) # create equivalence classes base on data gathered on template # transitions nummecs = cre8ecs( tecfwd, tecbck, numecs ) # loop through each BASE() slot assigned to a template for ( i=lasttemp; i < DEFBASE; i=i+1 ) { totaltrans = 0 # number of non-jam transitions out of this template for ( j=1; j <= numecs; j=j+1 ) { trans = nxt(base(i)+j) if ( trans != 0 ) { # non-jam transition totaltrans = totaltrans + 1 } # the absolute value of tecbck is the meta-equivalence class # of a given equivalence class, as set up by cre8ecs tmp(abs( tecbck(j) )) = trans } # it is assumed (in a rather subtle way) in the skeleton that # the DEF() entry for all templates is the jam template, i.e. # templates never default to other non-jam table entries (e.g. # another template) call mkentry( tmp, i, DEFBASE, totaltrans ) } return end ### copline - copy the rest of the current input line to the output # # synopsis # call copline # subroutine copline NOIMPLICIT character ch, lgetc repeat { if ( lgetc(ch) == EOF ) { # Put the EOF back - it should never get read. call ungetc( ch ) break } call putc( ch ) if ( ch == '@n' ) break } return end ### copyaction - copy action corresponding to a rule to output file # # synopsis # # call copyaction # # note: copyaction ASSUMES that the global accnum is the accepting # number corresponding with the rule action. # subroutine copyaction NOIMPLICIT integer bracelevel character ch1, lgetc LEX_IO LEX_NFA LEX_MISC string casestr " case " # the parser will have read the character after the rule we have # just processed in order to tell that it needed to reduce. we put that # character back so it can be copied appropriately to the output. # this is especially important if the character was a newline. call ungetc( lastch ) # Output the case label. call printf( "%s%d:@n", casestr, accnum ) if ( trailnum(accnum) > 0 ) { # do trailing context magic to not match the trailing characters call printf( "curbufp = mod( curbufp+BUFSIZE-%d, BUFSIZE ) + 1@n", trailnum(accnum)+1 ) } # Copy the ratfor action to the output file, matching {}s. bracelevel = 0 repeat { ch1 = lgetc( ch1 ) if ( ch1 == EOF ) { # Oh no! We have read an end of file! Put it back, quick! call ungetc( ch1 ) break } call putc( ch1 ) if ( ch1 == '{' ) bracelevel = bracelevel + 1 else if ( ch1 == '}' ) bracelevel = bracelevel - 1 else if ( (ch1 == '@n' & bracelevel <= 0) ) break } call putc( '@n' ) return end ### copysingl - make a given number of copies of a singleton machine # # synopsis # # newsng = copysingl( singl, num ) # # newsng - a new singleton composed of `num' copies of `singl' # singl - a singleton machine # num - the number of copies of `singl' to be present in `newsng' # integer function copysingl( singl, num ) NOIMPLICIT integer singl, num integer copy, dupmachine, link, i, mkstate copy = mkstate( SYM_EPSILON ) for ( i=1; i <= num; i=i+1 ) copy = link( copy, dupmachine( singl ) ) return ( copy ) end ### cre8ecs - associate equivalence class numbers with class members # # synopsis # integer cre8ecs # number of classes = cre8ecs( fwd, bck, num ) # # fwd is the forward linked-list of equivalence class members. bck # is the backward linked-list, and num is the number of class members. # Returned is the number of classes. # integer function cre8ecs( fwd, bck, num ) NOIMPLICIT integer fwd(ARB), bck(ARB), num integer i, j, numcl numcl = 0 # create equivalence class numbers. From now on, abs( bck(x) ) # is the equivalence class number for object x. If bck(x) # is positive, then x is the representative of its equivalence # class. for ( i=1; i <= num; i=i+1 ) if ( bck(i) == NIL ) { numcl = numcl + 1 bck(i) = numcl for ( j=fwd(i); j != NIL; j=fwd(j) ) bck(j) = -numcl } return ( numcl ) end ### dataflush - flush generated data statements # # synopsis # call dataflush # subroutine dataflush NOIMPLICIT LEX_IO call printf( "@n" ) # reset the number of data statements written on the current line datapos = 0 return end ### dumpnfa - debugging routine to write out an nfa # # synopsis # integer state1 # call dumpnfa( state1 ) # subroutine dumpnfa( state1 ) NOIMPLICIT integer state1 integer tlp, sym, tsp1, tsp2 integer anum, ns LEX_NFA call fprintf( ERROUT, "dumpnfa: ******************** beginning dump of nfa at %d@n", state1 ) for ( ns=firstst(state1); ns <= lastst(state1); ns=ns+1 ) { call fprintf( ERROUT, "state # %4d@t", ns ) sym = transchar(ns) tsp1 = trans1(ns) tsp2 = trans2(ns) anum = accptnum(ns) call fprintf( ERROUT, "%3d: %4d, %4d", sym, tsp1, tsp2 ) if ( anum != NIL ) call fprintf( ERROUT, " [%d]", anum ) call fprintf( ERROUT, "@n" ) } call remark( "dumpnfa: ******************** end of dump" ) return end ### dupmachine - make a duplicate of a given machine # # synopsis # # copy = dupmachine( mach ) # # copy - holds duplicate of `mach' # mach - machine to be duplicated # # note that the copy of `mach' is NOT an exact duplicate; rather, all the # transition states values are adjusted so that the copy is self-contained, # as the original should have been. Also note that the original MUST be # contiguous, with its low and high states accessible by the arrays # firstst and lastst # integer function dupmachine( mach ) NOIMPLICIT integer mach LEX_NFA integer i, state, mkstate, init for ( i=firstst(mach); i <= lastst(mach); i=i+1 ) { state = mkstate( transchar(i) ) if (trans1(i) != NO_TRANSITION) { call mkxtion( finalst(state), trans1(i) + state - i ) if ( transchar(i) == SYM_EPSILON & trans2(i) != NO_TRANSITION ) call mkxtion( finalst(state), trans2(i) + state - i ) } } init = mach + state - i + 1 firstst(init) = firstst(mach) + state - i + 1 finalst(init) = finalst(mach) + state - i + 1 lastst(init) = lastst(mach) + state - i + 1 return ( init ) end ### eatline - read and discard the rest of the current input line # # synopsis # call eatline # subroutine eatline NOIMPLICIT character ch, lgetc repeat { if ( lgetc( ch ) == EOF ) { # Put the EOF back - it should never get read. call ungetc( ch ) break } if ( ch == '@n' ) break } return end ### epsclosure - construct the epsilon closure of a set of ndfa states # # synopsis # integer t, u, accset, nacc, hashval # call epsclosure( t, u, accset, nacc, hashval ) # # NOTES # the epsilon closure is the set of all states reachable by an arbitrary # number of epsilon transitions which themselves do not have epsilon # transitions going out, unioned with the set of states which have non-null # accepting numbers # hashval is the hash value for the dfa corresponding to the state set # subroutine epsclosure( t, u, accset, nacc, hashval ) NOIMPLICIT integer t, u, accset, nacc, hashval integer bslp, ns, transsym, tsp, nfaccnum, visited integer bsloopinit, wlp, stkpos, stk(EPSCLOSURESTKSIZE) logical bsnext, bsbtst, epsinit LEX_NFA data epsinit /.true./ if ( epsinit ) { # visited keeps track of which states have already been processed call bsinit( visited, lastnfa ) epsinit = .false. } call bszero( u ) call bszero( accset ) nacc = 0 stkpos = 0 hashval = 0 for ( bslp=bsloopinit( t ); bsnext( bslp, ns ); ) { stkpos = stkpos + 1 if ( stkpos > EPSCLOSURESTKSIZE ) call error( "epsclosure: stack overflow" ) stk(stkpos) = ns } call bsendloop( bslp ) while ( stkpos > 0 ) { ns = stk(stkpos) # return any accepting states encountered, along with a count nfaccnum = accptnum(ns) if ( nfaccnum != NIL ) { call bsbset( accset, nfaccnum ) nacc = nacc + 1 call bsbset( u, ns ) if ( ! bsbtst( visited, ns ) ) hashval = hashval + ns } transsym = transchar(ns) tsp = trans1(ns) if ( transsym == SYM_EPSILON ) { if ( tsp != NO_TRANSITION ) { if ( ! bsbtst( visited, tsp ) ) stk(stkpos) = tsp else stkpos = stkpos - 1 tsp = trans2(ns) if ( tsp != NO_TRANSITION ) if ( ! bsbtst( visited, tsp ) ) { stkpos = stkpos + 1 if ( stkpos > EPSCLOSURESTKSIZE ) call error( "epsclosure: stack overflow" ) stk(stkpos) = tsp } } else stkpos = stkpos - 1 } else { call bsbset( u, ns ) if ( ! bsbtst( visited, ns ) ) hashval = hashval + ns stkpos = stkpos - 1 } call bsbset( visited, ns ) } call bszero( visited ) return end ### escseq - turn an escaped character into the correct plain character # # synopsis # character pch, escseq, ech # pch = escseq( ech ) # character function escseq( ch ) NOIMPLICIT character ch integer i character lgetc, esc character esctemplate(6) # big enough for the largest possible # escape sequence, plus an EOS # we read ahead enough characters to ensure that we can recognize # the largest possible escape sequence (which is "@0xxx"), hand # the resultant string to esc(), and the put back those characters # which weren't part of the escape sequence esctemplate(1) = '@@' esctemplate(2) = ch for ( i=3; i <= 5; i=i+1 ) if ( lgetc( esctemplate(i) ) == EOF ) { call ungetc( EOF ) break } esctemplate(i) = EOS i = 1 escseq = esc( esctemplate, i ) call pbstr( esctemplate(i+1) ) return end ### gentabs - generate ratfor data statements for the transition tables # # synopsis # integer state1 # call gentabs( state1 ) # subroutine gentabs( state1 ) NOIMPLICIT integer state1 integer bsloopinit logical bsnext, bsempty, bsbtst integer i, j, nstate, naccepting, aslp, anum character alist, accept, basearray, defarray, nextarray, checkarray character ecarray, ch, lgetc, matcharray LEX_DFA LEX_ECS LEX_MISC LEX_PROT string arydecl "integer %c(%d)@n" nummt = 0 alist = 'L' accept = 'A' ecarray = 'E' matcharray = 'M' basearray = 'B' defarray = 'D' nextarray = 'N' checkarray = 'C' call skelout # Generate declaration statements for acclists and accepting. call printf( arydecl, alist, lastdfa ) call printf( arydecl, accept, numas ) call printf( arydecl, ecarray, lastsc ) call printf( arydecl, matcharray, numecs ) call printf( arydecl, basearray, lastdfa + numtemps ) call printf( arydecl, defarray, lastdfa + numtemps ) call printf( arydecl, nextarray, tblend ) call printf( arydecl, checkarray, tblend ) call printf( "define(JAMBASE,%d)@n", jambase ) call printf( "define(STARTSTATE,%d)@n", state1 ) # the first template begins right after the default jam table, # which itself begins right after the last dfa call printf( "define(FIRST_TEMPLATE_BASE,%d)@n", lastdfa + 2 ) nstate = 0 naccepting = 0 # write out the accepting lists. Note that if desired, these could # be written out in snstods as the dfa states are created, since they # aren't needed any later than that. for ( i=1; i <= lastdfa; i=i+1 ) { if ( bsempty( das(i) ) ) call mkdata( alist, i, NIL ) else { naccepting = naccepting + 1 call mkdata( alist, i, naccepting ) for ( aslp=bsloopinit( das(i) ); bsnext( aslp, anum ); ) { call mkdata( accept, naccepting, anum ) naccepting = naccepting + 1 } call bsendloop( aslp ) call mkdata( accept, naccepting, NIL ) } } call dataflush # write out equivalence classes for ( i=MIN_SYMBOL; i <= lastsc; i=i+1 ) call mkdata( ecarray, i, abs( ecgroup(i) ) ) call dataflush # write out meta-equivalence classes (used to index templates with) for ( i=1; i <= numecs; i=i+1 ) call mkdata( matcharray, i, abs( tecbck(i) ) ) call dataflush for ( i=1; i <= lastdfa; i=i+1 ) { if ( base(i) == JAM ) base(i) = jambase call mkdata( basearray, i, base(i) ) if ( def(i) > lastdfa ) # template reference def(i) = MAX_DFAS - def(i) + lastdfa + 1 call mkdata( defarray, i, def(i) ) } # shift templates down to be adjacent with the rest of the table # entries for ( i=1; i <= numtemps; i=i+1 ) { call mkdata( basearray, i + lastdfa, base(MAX_DFAS - i + 1) ) if ( def(MAX_DFAS - i + 1) > lastdfa ) # template reference def(MAX_DFAS - i + 1) = MAX_DFAS - def(MAX_DFAS - i + 1) + lastdfa + 1 call mkdata( defarray, i + lastdfa, def(MAX_DFAS - i + 1 ) ) } call dataflush for ( i=1; i <= tblend; i=i+1 ) { call mkdata( nextarray, i, nxt(i) ) if ( chk(i) == 0 ) nummt = nummt + 1 if ( chk(i) > lastdfa ) # template reference chk(i) = MAX_DFAS - chk(i) + lastdfa + 1 call mkdata( checkarray, i, chk(i) ) } call dataflush call skelout # copy remainder of input to output for ( ch=lgetc( ch ); ch != EOF; ch=lgetc( ch ) ) call putc( ch ) return end ### getcclset - return set pointer corresponding to passed ccl index # # synopsis # integer getcclset, cclp, cclsetptr # cclsetptr = getcclset( cclp ) # integer function getcclset( cclp ) NOIMPLICIT integer cclp LEX_CCL return ( cclmap(-cclp) ) end ### getuntil - read characters until a specified character is found # # synopsis # logical chfound, getuntil # integer idx, strlen # character termch, str(strlen) # chfound = getuntil ( termch, str, idx, strlen ) # logical function getuntil ( termch, str, idx, strlen ) NOIMPLICIT character termch, str(ARB) integer idx, strlen character lgetc, ch repeat { ch = lgetc( ch ) if ( ch == termch | ch == '@n' | ch == EOF | idx+1 > strlen ) break str(idx) = ch idx = idx + 1 } str(idx) = EOS getuntil = ( ch == termch ) call ungetc( ch ) # put back the terminator return end ### inittbl - initialize transition tables # # synopsis # call inittbl # # Initializes 'firstfree' to be one beyond the end of the table. Initializes # all 'chk' entries to be zero. Note that templates are built starting # at the END of the base/def tables. They are shifted down to be contiguous # with the non-template entries during table generation. # subroutine inittbl NOIMPLICIT LEX_DFA LEX_ECS LEX_PROT integer i for ( i = numecs + 1; i <= MAX_XPAIRS; i=i+1 ) chk(i) = 0 tblend = 0 firstfree = tblend + 1 lasttemp = DEFBASE # set up doubly-linked meta-equivalence classes # these are sets of equivalence classes which all have identical # transitions out of TEMPLATES tecbck(1) = NIL for ( i=2; i <= numecs; i=i+1 ) { tecbck(i) = i - 1 tecfwd(i-1) = i } tecfwd(numecs) = NIL return end ### inpinit - initialize the lex input routines # # synopsis # call inpinit # # DESCRIPTION # Reads in the file name arguments (if any), opens them all, and saves # the file identifiers on a queue. # subroutine inpinit NOIMPLICIT character argbuf(MAXLINE) integer i, getarg, fd, open, quefremove logical queempty LEX_IO call queinit( fileq ) call stkinit( pbstack ) # Read in all the file arguments, open the files, and put them in a queue. for ( i=1; getarg(i, argbuf, MAXLINE) != EOF; i=i+1 ) { if ( argbuf(1) == '-' & argbuf(2) == EOS ) fd = STDIN else { fd = open( argbuf, READ ) if ( fd == ERR ) call cant( argbuf ) } call quebinsert( fileq, fd ) } if ( queempty( fileq ) ) { # There were no file arguments - just process standard input. infile = STDIN filenum = 0 # filenum == 0 means STDIN, no arguments given } else { # Remove the first file from the queue. infile = quefremove( fileq ) filenum = 1 } linenum = 1 return end ### lexend - terminate lex # # synopsis # call lexend # subroutine lexend NOIMPLICIT LEX_MISC LEX_IO LEX_DFA LEX_NFA LEX_PROT LEX_ECS LEX_FLAGS call close( skelfile ) call quedestroy( fileq ) call stkdestroy( pbstack ) call gtime( endtime ) if ( printstats ) { call fprintf( ERROUT, "Usage statistics:@n" ) call fprintf( ERROUT, " started at %s, finished at %s@n", starttime, endtime ) call fprintf( ERROUT, " NFA size = %d states, DFA size = %d states@n", lastnfa, lastdfa ) call fprintf( ERROUT, " %d state/nextstate pairs created@n", numsnpairs ) call fprintf( ERROUT, " %d base/def entries created@n", lastdfa + numtemps ) call fprintf( ERROUT, " %d nxt/chk entries created@n", tblend ) call fprintf( ERROUT, " %d empty table entries@n", nummt ) call fprintf( ERROUT, " %d protos created@n", numprots ) call fprintf( ERROUT, " %d templates created@n", numtemps ) call fprintf( ERROUT, " %d equivalence classes created@n", numecs ) call fprintf( ERROUT, " %d meta-equivalence classes created@n@n", nummecs ) call bsstats } return end ### lexinit - initialize lex # # synopsis # call lexinit # subroutine lexinit NOIMPLICIT integer getarg, i, open, mkstate character arg(MAXLINE), clower LEX_FLAGS LEX_IO LEX_1STACK LEX_NFA LEX_DFA LEX_PROT LEX_ECS LEX_CCL LEX_MISC string skelname "~/.%lib/lexskel" printstats = .false. syntaxerror = .false. ddebug = .false. call bslbinit # Read flags. repeat { if ( getarg( 1, arg, MAXLINE ) == EOF ) break if ( arg(1) != '-' | arg(2) == EOS ) break for ( i=2; arg(i) != EOS; i=i+1 ) { if ( clower(arg(i)) == 'v' ) printstats = .true. else if ( arg(i) == 'd' ) ddebug = .true. else { call putlin( "unknown flag: ", ERROUT ) call error( arg ) } } call delarg( 1 ) } # Initialize ccl indices. It is ASSUMED here that ccl indices # are all less than valid character values, and that they grow # downward (become more negative as more and more are allocated) lastccl = LASTCCLINIT # initialize the start condition book-keeping lastsc = LASTSCINIT # Initialize the lex input routines. call inpinit # Initialize the statistics. call gtime( starttime ) # Open the lexskel file. skelfile = open( skelname, READ ) if ( skelfile == ERR ) call cant( skelname ) lastdfa = 0 lastnfa = 0 optsc = mkstate( SYM_EPSILON ) accnum = 0 numas = 0 numsnpairs = 0 numecs = 0 endseen = .false. datapos = 0 sectnum = 1 onesp = 0 numprots = 0 firstprot = NIL lastprot = 1 # used in mkprot so that the first proto goes in slot 1 # of the proto queue # set up doubly-linked equivalence classes ecgroup(MIN_SYMBOL) = NIL for ( i=MIN_SYMBOL+1; i <= MAX_SYMBOL; i=i+1 ) { ecgroup(i) = i - 1 nextecm(i-1) = i } nextecm(MAX_SYMBOL) = NIL return end ### lgetc - read a character from the input file(s) # # synopsis # character ch, lgetc # ch = lgetc( ch ) # character function lgetc( ch ) NOIMPLICIT character ch character getch logical stkempty, queempty integer stkpop, quefremove, ich LEX_IO if ( stkempty( pbstack ) ) { # Nothing on the push-back stack - read in a new character. repeat { ch = getch( ch, infile ) if ( ch != EOF | queempty( fileq ) ) break infile = quefremove( fileq ) filenum = filenum + 1 linenum = 1 } } else { # The push-back has something on it - pop it and return it. ich = stkpop( pbstack ) ch = ich } if ( ch == '@n' ) linenum = linenum + 1 lgetc = ch return end ### link - connect two machines together # # synopsis # # new = link( first, last ) # # new - a machine constructed by connecting first to last # first - the machine whose successor is to be `last' # last - the machine whose predecessor is to be `first' # # note: this routine concatenates the machine `first' with the machine # `last' to produce a machine `new' which will pattern-match first `first' # and then `last', and will fail if either of the sub-patterns fails. # FIRST is set to `new' by the operation. `last' is unmolested. # integer function link( first, last ) NOIMPLICIT integer first, last LEX_NFA if ( first == NIL ) return ( last ) else if ( last == NIL ) return ( first ) else { call mkxtion( finalst(first), last ) finalst(first) = finalst(last) lastst(first) = max( lastst(first), lastst(last) ) firstst(first) = min( firstst(first), firstst(last) ) return ( first ) } end ### mkcclmap - create map entry connecting ccl index with set pointer # # synopsis # integer cclp, cclsetptr # call mkcclmap( cclsetptr, cclp ) subroutine mkcclmap( cclsetptr, cclp ) NOIMPLICIT integer cclsetptr, cclp LEX_CCL lastccl = lastccl - 1 # ccl numbers DECREASE; essentially, any transition # number that is non-negative is a character, # whereas any negative transition number is a # ccl index if ( (-lastccl) > MAXCCLS ) call error( "mkcclmap: Too many character classes" ) cclmap(-lastccl) = cclsetptr cclp = lastccl return end ### mkclos - convert a machine into a closure # # synopsis # new = mkclos( state ) # # new - a new state which matches the closure of 'state' # integer function mkclos( state ) NOIMPLICIT integer state integer mkopt, mkposcl return ( mkopt( mkposcl( state ) ) ) end ### mkdata - generate a data statement # # synopsis # character name # integer arrayelm, value # call mkdata( name, arrayelm, value ) # # generates a data statement initializing "name(arrayelm)" to "value" # Note that name is only a character; NOT a string # subroutine mkdata( name, arrayelm, value ) NOIMPLICIT character name integer arrayelm, value integer numdigs, datalen LEX_IO string dindent DATAINDENTSTR # figure out length of data statement to be written. 6 is the constant # overhead of a one character name, '(' and ')' to delimit the array # reference, a '/' and a '/' to delimit the value, and room for a # blank or a comma between this data statement and the previous one datalen = 6 + numdigs( arrayelm ) + numdigs( value ) if ( datalen + datapos >= DATALINEWIDTH | datapos == 0 ) { if ( datapos != 0 ) call dataflush # precede data statement with '%' so rat4 preprocessor doesn't have # to bother looking at it call printf( "%%%sDATA ", dindent ) # 4 is the constant overhead of writing out the word 'DATA' datapos = DATAINDENTWIDTH + 4 + datalen } else { call printf( "," ) datapos = datapos + datalen } call printf( "%c(%d)/%d/", name, arrayelm, value ) return end ### mkdeftbl - make the default, 'jam' table entries # # synopsis # call mkdeftbl # subroutine mkdeftbl NOIMPLICIT LEX_ECS LEX_DFA LEX_PROT integer i for ( i=1; i <= numecs; i=i+1 ) { nxt(tblend + i) = 0 chk(tblend + i) = DEFBASE } jambase = tblend base(DEFBASE) = jambase def(DEFBASE) = -1 # should generate a run-time array bounds check if # ever used as a default tblend = tblend + numecs numtemps = numtemps + 1 return end ### mkeccl - update equivalence classes based on character class xtions # # synopsis # integer ccls, fwd(MAX_REAL_SYMBOL), bck(MAX_REAL_SYMBOL) # call mkeccl( ccls, fwd, bck ) # # where ccls is a bit-string pointer containing elements of the character # class, fwd is the forward link-list of equivalent characters, and # bck is the backward link-list # subroutine mkeccl( ccls, fwd, bck ) NOIMPLICIT integer ccls, fwd(ARB), bck(ARB) integer bsloopinit, cclp, getcclset, oldec, newec integer cclm, i, ccopy, firstcclm logical bsnext, bsbtnc, ecclinit data ecclinit /.true./ if ( ecclinit ) { call bsinit( ccopy, MAX_REAL_SYMBOL ) ecclinit = .false. } call bscopy( ccls, ccopy ) cclp = bsloopinit( ccopy ) if ( bsnext( cclp, firstcclm ) ) { cclm = firstcclm repeat # for all characters in ccl { oldec = bck(cclm) newec = cclm for ( i=fwd(cclm); i != NIL & i <= MAX_REAL_SYMBOL; i=fwd(i) ) if ( bsbtnc( ccopy, i ) ) { # link into new equivalence class bck(i) = newec fwd(newec) = i newec = i } else { # link to old equivalence class bck(i) = oldec if ( oldec != NIL ) fwd(oldec) = i oldec = i } if ( bck(cclm) != NIL | oldec != bck(cclm) ) { bck(cclm) = NIL fwd(oldec) = NIL } fwd(newec) = NIL } until (! bsnext( cclp, cclm )) call bsendloop( cclp ) } return end ### mkechar - create equivalence class for single character # # synopsis # integer tch, fwd(MAX_SYMBOL), bck(MAX_SYMBOL) # call mkechar( tch, fwd, bck ) # subroutine mkechar( tch, fwd, bck ) NOIMPLICIT integer tch, fwd(ARB), bck(ARB) # if until now the character has been a proper subset of # an equivalence class, break it away to create a new ec if ( fwd(tch) != NIL ) bck(fwd(tch)) = bck(tch) if ( bck(tch) != NIL ) fwd(bck(tch)) = fwd(tch) fwd(tch) = NIL bck(tch) = NIL return end ### mkentry - create base/def and nxt/chk entries for transition array # # synopsis # integer state(MAX_SYMBOL), statenum, deflink, totaltrans # call mkentry( state, statenum, deflink, totaltrans ) # # 'state' is the transition array, 'statenum' is the offset to be used into # the base/def tables, and 'deflink' is the entry to put in the 'def' table # entry. If 'deflink' is equal to 'DEFBASE', then no attempt will be made # to fit zero entries of 'state' (i.e. jam entries) into the table. It is # assumed that by linking to 'DEFBASE' they will be taken care of. In any # case, entries in 'state' marking transitions to 'SAME_TRANS' are treated # as though they will be taken care of by whereever 'deflink' points. # 'totaltrans' is the total number of transitions out of the state. If it # is below a certain threshold, the tables are searched for an interior # spot that will accomodate the state array. # subroutine mkentry( state, statenum, deflink, totaltrans ) NOIMPLICIT integer state(ARB), statenum, deflink, totaltrans LEX_ECS LEX_DFA integer minec, maxec, i, tblbase, baseaddr, tbllast if ( totaltrans == 0 ) { # there are no out-transitions if ( deflink == DEFBASE ) base(statenum) = JAM else base(statenum) = 0 def(statenum) = deflink return } for ( minec=1; minec <= numecs; minec = minec + 1 ) { if ( state(minec) != SAME_TRANS ) if ( state(minec) != 0 | deflink != DEFBASE ) break } if ( totaltrans == 1 ) { # there's only one out-transition. Save it for later to fill # in holes in the tables. call stack1( statenum, minec, state(minec), deflink ) return } for ( maxec=numecs; maxec > 0; maxec=maxec-1 ) { if ( state(maxec) != SAME_TRANS ) if ( state(maxec) != 0 | deflink != DEFBASE ) break } # Whether we try to fit the state table in the middle of the table # entries we have already generated, or if we just take the state # table at the end of the nxt/chk tables, we must make sure that we # have a valid base address (i.e. non-negative). Note that not only are # negative base addresses dangerous at run-time (because indexing the # next array with one and a low-valued character might generate an # array-out-of-bounds error message), but at compile-time negative # base addresses denote TEMPLATES. # find the first transition of state that we need to worry about. if ( totaltrans * 100 <= numecs * INTERIOR_FIT_PERCENTAGE ) { # attempt to squeeze it into the middle of the tabls baseaddr = firstfree while ( baseaddr < minec ) { # using baseaddr would result in a negative base address below # find the next free slot for ( baseaddr=baseaddr+1; chk(baseaddr) != 0; baseaddr=baseaddr+1 ) ; } for ( i=minec; i <= maxec; i=i+1 ) if ( state(i) != SAME_TRANS ) if ( state(i) != 0 | deflink != DEFBASE ) if ( chk(baseaddr + i - minec) != 0 ) { for ( baseaddr=baseaddr+1; chk(baseaddr) != 0; baseaddr=baseaddr+1 ) ; # reset the loop counter so we'll start all # over again next time it's incremented i = minec - 1 } } else { # ensure that the base address we eventually generate is non-negative baseaddr = max( tblend + 1, minec ) } tblbase = baseaddr - minec tbllast = tblbase + maxec base(statenum) = tblbase def(statenum) = deflink for ( i=minec; i <= maxec; i=i+1 ) if ( state(i) != SAME_TRANS ) if ( state(i) != 0 | deflink != DEFBASE ) { nxt(tblbase + i) = state(i) chk(tblbase + i) = statenum } if ( baseaddr == firstfree ) # find next free slot in tables for ( firstfree=firstfree+1; chk(firstfree) != 0; firstfree=firstfree+1 ) ; tblend = max( tblend, tbllast ) return end ### mk1tbl - create table entries for a state (or state fragment) which # has only one out-transition # # synopsis # integer state, sym, onenxt, onedef # call mk1tbl( state, sym, onenxt, onedef ) # subroutine mk1tbl( state, sym, onenxt, onedef ) NOIMPLICIT integer state, sym, onenxt, onedef LEX_DFA while ( chk(firstfree) != 0 | firstfree < sym ) firstfree = firstfree + 1 base(state) = firstfree - sym def(state) = onedef chk(firstfree) = state nxt(firstfree) = onenxt if ( firstfree > tblend ) { tblend = firstfree firstfree = firstfree + 1 } return end ### mkopt - make a machine optional # # synopsis # # new = mkopt( mach ) # # new - a machine which optionally matches whatever `mach' matched # mach - the machine to make optional # # notes: # 1. mach must be the last machine created # 2. mach is destroyed by the call # integer function mkopt( mach ) NOIMPLICIT integer mach LEX_NFA integer eps, mkstate, link if ( transchar(finalst(mach)) != SYM_EPSILON ) { eps = mkstate( SYM_EPSILON ) mach = link( mach, eps ) } if ( ! FREE_EPSILON( mach ) ) { eps = mkstate( SYM_EPSILON ) mach = link( eps, mach ) } call mkxtion( mach, finalst(mach) ) return ( mach ) end ### mkor - make a machine that matches either one of two machines # # synopsis # # new = mkor( first, second ) # # new - a machine which matches either `first's pattern or `second's # first, second - machines whose patterns are to be `or'ed (the | operator) # # note that first and second are both destroyed by the operation # the code is rather convoluted because an attempt is made to minimize # the number of epsilon states needed # integer function mkor( first, second ) NOIMPLICIT integer first, second LEX_NFA integer mkstate, link, orbeg, eps, orend if ( first == NIL ) return ( second ) else if ( second == NIL ) return ( first ) else { if ( FREE_EPSILON( first ) ) { orbeg = first call mkxtion( orbeg, second ) } else if ( FREE_EPSILON( second ) ) { orbeg = second call mkxtion( orbeg, first ) } else { eps = mkstate( SYM_EPSILON ) first = link( eps, first ) orbeg = first call mkxtion( orbeg, second ) } if ( transchar( finalst(first) ) == SYM_EPSILON & accptnum( finalst(first) ) == NIL ) { orend = finalst(first) call mkxtion( finalst(second), orend ) } else if ( transchar( finalst(second) ) == SYM_EPSILON & accptnum( finalst(second) ) == NIL ) { orend = finalst(second) call mkxtion( finalst(first), orend ) } else { eps = mkstate( SYM_EPSILON ) first = link( first, eps ) orend = finalst(first) call mkxtion( finalst(second), orend ) } } finalst(orbeg) = orend return ( orbeg ) end ### mkposcl - convert a machine into a positive closure # # synopsis # new = mkposcl( state ) # # new - a machine matching the positive closure of 'state' # integer function mkposcl( state ) NOIMPLICIT integer state LEX_NFA integer mkstate, link, eps if ( SUPER_FREE_EPSILON( finalst(state) ) ) { call mkxtion( finalst(state), state ) mkposcl = state } else { eps = mkstate( SYM_EPSILON ) call mkxtion( eps, state ) mkposcl = link( state, eps ) } return end ### mkprot - create new proto entry # # synopsis # integer state(MAX_SYMBOL), statenum, comstate # call mkprot( state, statenum, comstate ) # subroutine mkprot( state, statenum, comstate ) NOIMPLICIT integer state(ARB), statenum, comstate LEX_PROT LEX_ECS integer i, slot, tblbase numprots = numprots + 1 if ( numprots > MSP | numecs * numprots > PROT_SAVE_SIZE ) { # gotta make room for the new proto by dropping last entry in # the queue slot = lastprot lastprot = protprev(lastprot) protnext(lastprot) = NIL } else slot = numprots protnext(slot) = firstprot if ( firstprot != NIL ) protprev(firstprot) = slot firstprot = slot prottbl(slot) = statenum protcomst(slot) = comstate # copy state into save area so it can be compared with rapidly tblbase = numecs * (slot - 1) for ( i=1; i <= numecs; i=i+1 ) protsave(tblbase+i) = state(i) return end ### mkrep - make a replicated machine # # synopsis # new = mkrep( mach, lb, ub ) # # new - a machine that matches whatever 'mach' matched from 'lb' # number of times to 'ub' number of times # # note # if 'ub' is INFINITY then 'new' matches 'lb' or more occurances of 'mach' # integer function mkrep( mach, lb, ub ) NOIMPLICIT integer mach, lb, ub integer base, copysingl, dupmachine, link, mkclos, tail, mkstate, mkopt integer copy, i base = copysingl( mach, lb-1 ) if ( ub == INFINITY ) { copy = dupmachine( mach ) mach = link( mach, link( base, mkclos( copy ) ) ) } else { tail = mkstate( SYM_EPSILON ) for ( i=lb; i < ub; i=i+1 ) { copy = dupmachine( mach ) tail = mkopt( link( copy, tail ) ) } mach = link( mach, link( base, tail ) ) } return ( mach ) end ### mkstate - create a state with a transition on a given symbol # # synopsis # # state = mkstate( sym ) # # state - a new state matching `sym' # sym - the symbol the new state is to have an out-transition on # # note that this routine makes new states in ascending order through the # state array (and increments LASTNFA accordingly). The routine DUPMACHINE # relies on machines being made in ascending order and that they are # CONTIGUOUS. Change it and you will have to rewrite DUPMACHINE (kludge # that it admittedly is) # integer function mkstate( sym ) NOIMPLICIT integer sym, getcclset LEX_NFA LEX_ECS lastnfa = lastnfa + 1 if (lastnfa > MNS) call error( "mkstate: machine too large" ) transchar(lastnfa) = sym trans1(lastnfa) = NO_TRANSITION trans2(lastnfa) = NO_TRANSITION accptnum(lastnfa) = NIL firstst(lastnfa) = lastnfa finalst(lastnfa) = lastnfa lastst(lastnfa) = lastnfa # fix up equivalence classes base on this transition. Note that any # character which has its own transition gets its own equivalence class. # Thus only characters which are only in character classes have a chance # at being in the same equivalence class. E.g. "a|b" puts 'a' and 'b' # into two different equivalence classes. "[ab]" puts them in the same # equivalence class (barring other differences elsewhere in the input. if ( sym < 0 ) call mkeccl( getcclset( sym ), nextecm, ecgroup ) else if ( sym != SYM_EPSILON ) call mkechar( sym, nextecm, ecgroup ) return ( lastnfa ) end ### mktemp - create a template entry based on a state, and connect the state # to it # # synopsis # integer state(MAX_SYMBOL), statenum, comstate, totaltrans # call mktemp( state, statenum, comstate, totaltrans ) # subroutine mktemp( state, statenum, comstate ) NOIMPLICIT integer state(ARB), statenum, comstate LEX_PROT LEX_ECS LEX_DFA integer i, tbldiff, numdiff, tmpbase, transset, tmp(MAX_SYMBOL) logical mktinit data mktinit /.true./ if ( mktinit ) { # we make the bitstring MAX_REAL_SYMBOL in size instead of # numecs because mkeccl is going to copy the bitstring into # another of MAX_REAL_SYMBOL size, and the bitstring library # gets upset if the destination of a copy is not the same size # as the source call bsinit( transset, MAX_REAL_SYMBOL ) mktinit = .false. } lasttemp = lasttemp - 1 numtemps = numtemps + 1 call bszero( transset ) # calculate where we will temporarily store the transition table # of the template in the NXT() array. The final transition table # gets created by cmptmps() tmpbase = MAX_XPAIRS - numtemps * numecs # store at end of table base(lasttemp) = tmpbase for ( i=1; i <= numecs; i=i+1 ) if ( state(i) == 0 ) nxt(tmpbase+i) = 0 else { call bsbset( transset, i ) nxt(tmpbase+i) = comstate } call mkeccl( transset, tecfwd, tecbck ) call mkprot( nxt(tmpbase+1), lasttemp, comstate ) # we rely on the fact that mkprot adds things to the beginning # of the proto queue numdiff = tbldiff( state, firstprot, tmp ) call mkentry( tmp, statenum, lasttemp, numdiff ) return end ### mkxtion - make a transition from one state to another # # synopsis # # call mkxtion( statefrom, stateto ) # # statefrom - the state from which the transition is to be made # stateto - the state to which the transition is to be made # subroutine mkxtion( statefrom, stateto ) NOIMPLICIT integer statefrom, stateto LEX_NFA if ( trans1(statefrom) == NO_TRANSITION ) trans1(statefrom) = stateto else { if ( (transchar(statefrom) != SYM_EPSILON) | (trans2(statefrom) != NO_TRANSITION) ) call error( "mkxtion: too many transitions" ) else trans2(statefrom) = stateto } return end ### mv2front - move proto queue element to front of queue # # synopsis # integer qelm # call mv2front( qelm ) # subroutine mv2front( qelm ) NOIMPLICIT integer qelm LEX_PROT if ( firstprot != qelm ) { if ( qelm == lastprot ) lastprot = protprev(lastprot) protnext(protprev(qelm)) = protnext(qelm) if ( protnext(qelm) != NIL ) protprev(protnext(qelm)) = protprev(qelm) protprev(qelm) = NIL protnext(qelm) = firstprot protprev(firstprot) = qelm firstprot = qelm } return end ### ndinstal - install a name definition # # synopsis # character nd(...), def(...) # call ndinstal( nd, def ) # subroutine ndinstal( nd, def ) NOIMPLICIT character nd(ARB), def(ARB), nd2(MAXLINE) integer lookup string ndpre "n" if ( lookup( nd, nd2 ) == YES ) call synerr( "name defined twice" ) else { call concat( ndpre, nd, nd2 ) call instal( nd2, def ) } return end ### ndlookup - lookup a name definition # # synopsis # character nd(...), def(...) # integer ndlookup # YESfound/NOnotfound = ndlookup( nd, def ) # integer function ndlookup( nd, def ) NOIMPLICIT character nd(ARB), def(ARB), nd2(MAXLINE) integer lookup string ndpre "n" call concat( ndpre, nd, nd2 ) ndlookup = lookup( nd2, def ) return end ### ntod - convert an ndfa to a dfa # # synopsis # integer state1 # call ntod( state1 ) # # state1 is the initial state of the ndfa to be converted # upon return, state1 is the initial state of the constructed dfa # subroutine ntod( state1 ) NOIMPLICIT integer state1 integer todo, nset, accset, ecloset, symlist, ds, sl, nacc, newds integer quefremove, bsloopinit, duplist(MAX_SYMBOL), sym, hashval integer targfreq(MAX_SYMBOL), targstate(MAX_SYMBOL), state(MAX_SYMBOL) integer targptr, numuniq, totaltrans, i, comstate, comfreq, targ, lastsym logical bsnext, queempty, new, bsbtst LEX_DFA LEX_NFA LEX_ECS LEX_1STACK data duplist /MAX_SYMBOL*NIL/ ifdef (DUMPFA) call remark( "ntod: dumping n" ) call dumpnfa( state1 ) enddef call queinit( todo ) # dfa states still to be processed call bsinit( nset, lastnfa ) # pre E-closed nfa state set # corresponding to dfa call bsinit( ecloset, lastnfa ) # post E-closed nfa state set call bsinit( accset, accnum ) # accepting numbers of DFA call bsinit( symlist, MAX_REAL_SYMBOL ) # symbols with 'out' xtions from DFA call inittbl # create the first state call bsbset( nset, state1 ) call epsclosure( nset, ecloset, accset, nacc, hashval ) call snstods( ecloset, accset, hashval, state1, new ) if ( nacc > 0 ) numas = numas + nacc + 1 call quefinsert( todo, state1 ) while ( ! queempty( todo ) ) { targptr = 0 numuniq = 0 totaltrans = 0 for ( i=1; i <= numecs; i=i+1 ) state(i) = 0 ds = quefremove( todo ) call sympartition( ds, symlist, duplist ) for ( sl=bsloopinit( symlist ); bsnext( sl, sym ); ) { if ( duplist(sym) == NIL ) { # symbol has unique out-transitions call symfollowset( ds, sym, nset ) call epsclosure( nset, ecloset, accset, nacc, hashval ) call snstods( ecloset, accset, hashval, newds, new ) state(sym) = newds if ( new ) { call quebinsert( todo, newds ) if ( nacc > 0 ) numas = numas + nacc + 1 } targptr = targptr + 1 targfreq(targptr) = 1 targstate(targptr) = newds lastsym = sym numuniq = numuniq + 1 } else { # sym's equivalence class has the same transitions # as duplist(sym)'s equivalence class targ = state(duplist(sym)) state(sym) = targ i = 0 # update frequency count for destination state repeat i = i + 1 until (targstate(i) == targ) targfreq(i) = targfreq(i) + 1 } totaltrans = totaltrans + 1 duplist(sym) = NIL } call bsendloop( sl ) numsnpairs = numsnpairs + totaltrans # determine which destination state is the most common, and # how many transitions to it there are comfreq = 0 comstate = 0 for ( i=1; i <= targptr; i=i+1 ) if ( targfreq(i) > comfreq ) { comfreq = targfreq(i) comstate = targstate(i) } call bldtbl( state, ds, totaltrans, comstate, comfreq ) } call cmptmps # create compressed template entries # create tables for all the states with only one out-transition while ( onesp > 0 ) { call mk1tbl( onestate(onesp), onesym(onesp), onenext(onesp), onedef(onesp) ) onesp = onesp - 1 } call mkdeftbl call quedestroy( todo ) call bsdestroy( nset ) call bsdestroy( accset ) call bsdestroy( ecloset ) call bsdestroy( symlist ) return end ### numdigs - number of digits in number # # synopsis # integer numdigs, x # num = numdigs( x ) # # NOTE # only works for non-negative numbers less than 1,000,000 # integer function numdigs( x ) NOIMPLICIT integer x if ( x < 10 ) return 1 else if ( x < 100 ) return 2 else if ( x < 1000 ) return 3 else if ( x < 10000 ) return 4 else if ( x < 100000 ) return 5 else return 6 end ### pbstr - push a string back # # synopsis # character str(...) # call pbstr( str ) # subroutine pbstr( str ) NOIMPLICIT character str(ARB) integer i, length for ( i=length( str ); i > 0; i=i-1 ) call ungetc( str(i) ) return end ### peek - take a peek at the next character in the input stream # # synopsis # character ch, peek # ch = peek( ch ) # character function peek( ch ) NOIMPLICIT character ch character lgetc ch = lgetc( ch ) call ungetc( ch ) peek = ch return end ### readin - read in the rules section of the input file(s) # # synopsis # call readin( state1 ) # subroutine readin( state1 ) NOIMPLICIT integer state1 LEX_MISC LEX_NFA LEX_ECS LEX_FLAGS integer yyparse, sts, link, mkopt, mkor, cre8ecs, i, j call skelout if ( ddebug ) call putlin( "define(LXDDEBUG,)@n", STDOUT ) if ( yyparse( sts ) == ERR ) call error( "readin: fatal error occured while parsing rules" ) # until now, optsc hasn't really been optional. optsc = mkopt( optsc ) free = link( optsc, free ) state1 = mkor( bound, free ) numecs = cre8ecs( nextecm, ecgroup, lastsc ) call ccl2ecl return end ### scinstal - make a start condition # # synopsis # character str(...) # call scinstal( str ) # subroutine scinstal( str ) NOIMPLICIT character str(ARB), str2(MAXLINE), numstr(10) integer num, sclookup, itoc, mkstate, mkor, sc string scpre "s" LEX_MISC LEX_NFA if ( sclookup( str, num ) == YES ) call synerr( "start condition declared twice" ) else { lastsc = lastsc + 1 if ( lastsc > MAXSC ) call error( "scinstal: too many start conditions" ) call printf( "define(YYLEX_SC_%s,%d)@n", str, lastsc ) call concat( scpre, str, str2 ) call itoc( lastsc, numstr, 10 ) call instal( str2, numstr ) sc = mkstate( lastsc ) optsc = mkor( optsc, sc ) } return end ### sclookup - lookup the number associated with a start condition # # synopsis # character str(...), scnum # integer sclookup # YESfound/NOnotfound = sclookup( str, scnum ) # integer function sclookup( str, scnum ) NOIMPLICIT character str(ARB), numstr(10), str2(MAXLINE) integer scnum, i, ctoi, lookup string scpre "s" call concat( scpre, str, str2 ) sclookup = lookup( str2, numstr ) if ( sclookup == YES ) { i = 1 scnum = ctoi( numstr, i ) } return end ### skelout - write out one section of the lexskel file # # synopsis # call skelout # # DESCRIPTION # Copies from skelfile to STDOUT until a line beginning with "~~" or # EOF is found. # subroutine skelout NOIMPLICIT character buf(MAXLINE) integer getlin LEX_FLAGS LEX_IO while ( getlin ( buf, skelfile ) != EOF ) if ( buf(1) == '~' & buf(2) == '~' ) break else call putlin ( buf, STDOUT ) return end ### snstods - converts a set of ndfa states into a dfa state # # synopsis # integer sns, newds, accset, hashval # logical new # call snstods( sns, accset, hashval, newds, new ) # subroutine snstods( sns, accset, hashval, newds, new ) NOIMPLICIT integer sns, accset, hashval, newds logical new logical bsareq integer i, snsbs(MAX_BS_SIZE), dssbs(MAX_BS_SIZE) integer numsints, numdints LEX_DFA LEX_NFA call bsgetbs( sns, snsbs, numsints ) for ( i=1; i <= lastdfa; i=i+1 ) if ( hashval == dhash(i) ) { call bsgetbs( dss(i), dssbs, numdints ) if ( bsareq( snsbs, dssbs, numsints ) ) { new = .false. newds = i return } } # make a new dfa lastdfa = lastdfa + 1 if ( lastdfa > MAX_DFAS ) call error( "snstods: DFA too large" ) newds = lastdfa dss(newds) = sns das(newds) = accset dhash(newds) = hashval new = .true. call bsinit( sns, lastnfa ) call bsinit( accset, accnum ) return end ### stack1 - save states with only one out-transition to be processed later # # synopsis # integer statenum, sym, nextstate, deflink # call stack1( statenum, sym, nextstate, deflink ) # # if there's room for another state one the 'one-transition' stack, the # state is pushed onto it, to be processed later by mk1tbl. If there's # no room, we process the sucker right now. # subroutine stack1( statenum, sym, nextstate, deflink ) NOIMPLICIT integer statenum, sym, nextstate, deflink LEX_1STACK LEX_DFA if ( onesp >= ONE_STACK_SIZE ) call mk1tbl( statenum, sym, nextstate, deflink ) else { onesp = onesp + 1 onestate(onesp) = statenum onesym(onesp) = sym onenext(onesp) = nextstate onedef(onesp) = deflink } return end ### symfollowset - follow the symbol transitions one step # # synopsis # integer ds, transsym, nset # call symfollowset( ds, transsym, nset ) # subroutine symfollowset( ds, transsym, nset ) NOIMPLICIT integer ds, transsym, nset integer slp, ns, tsp, sym integer bsloopinit, getcclset, ccllist logical bsnext, bsbtst LEX_NFA LEX_DFA LEX_ECS call bszero( nset ) for ( slp=bsloopinit(dss(ds)); bsnext(slp,ns); ) { # for each ndfa state ns in the state set of ds sym = transchar(ns) tsp = trans1(ns) if ( sym < MIN_SYMBOL & transsym <= MAX_REAL_SYMBOL ) { ccllist = getcclset( sym ) if ( bsbtst( ccllist, transsym ) ) call bsbset( nset, tsp ) } else if ( ecgroup(sym) == transsym ) call bsbset( nset, tsp ) } call bsendloop( slp ) return end ### sympartition - partition characters with same out-transitions # # synopsis # integer ds, symlist, duplist(MAX_SYMBOL) # call bsinit( symlist, MAX_SYMBOL ) # call sympartition( ds, symlist, duplist ) # subroutine sympartition( ds, symlist, duplist ) NOIMPLICIT integer ds, symlist, duplist(MAX_SYMBOL) integer nss, bsloopinit, tch, ccls, cclp, getcclset, oldec, newec, duptbls integer cclm, i, ccopy, firstcclm, ns, dupfwd(MAX_SYMBOL) logical bsnext, bsbtnc LEX_NFA LEX_DFA LEX_ECS LEX_CCL # partitioning is done by creating equivalence classes for those # characters which have out-transitions from the given state. Thus # we are really creating equivalence classes of equivalence classes. for ( i=MIN_SYMBOL; i <= MAX_SYMBOL; i=i+1 ) { # initialize equivalence class list duplist(i) = i - 1 dupfwd(i) = i + 1 } duplist(MIN_SYMBOL) = NIL dupfwd(MAX_SYMBOL) = NIL call bszero( symlist ) for ( nss=bsloopinit( dss(ds) ); bsnext( nss, ns ); ) { tch = transchar(ns) if ( tch != SYM_EPSILON ) { if ( tch < lastccl | tch > MAX_SYMBOL | tch == LASTCCLINIT ) call error( "sympartition: bad transition character detected" ) if ( tch >= MIN_SYMBOL ) { # character transition call mkechar( ecgroup(tch), dupfwd, duplist ) call bsbset( symlist, ecgroup(tch) ) } else { # character class call mkeccl( getcclset( tch ), dupfwd, duplist ) call bsor( symlist, getcclset( tch ), symlist ) } } } call bsendloop( nss ) return end ### synerr - report a syntax error # # synopsis # character str(ARB) # call synerr( str ) # subroutine synerr( str ) NOIMPLICIT character str LEX_FLAGS LEX_IO syntaxerror = .true. call fprintf( ERROUT, "Syntax error at line %d", linenum ) if ( filenum != 0 ) call fprintf( ERROUT, " of file %d", filenum ) call fprintf( ERROUT, ": %s@n", str ) return end ### tbldiff - compute differences between two state tables # # synopsis # integer state(MAX_SYMBOL), pr, ext(MAX_SYMBOL) # integer tbldiff, numdifferences # numdifferences = tbldiff( state, pr, ext ) # # 'state' is the state array which is to be extracted from the 'pr'th # proto. 'pr' is both the number of the proto we are extracting from # and an index into the save area where we can find the proto's complete # state table. Each entry in 'state' which differs from the corresponding # entry of 'pr' will appear in 'ext'. # Entries which are the same in both 'state' and 'pr' will be marked # as transitions to 'SAME_TRANS' in 'ext'. The total number of differences # between 'state' and 'pr' is returned as function value. Note that this # number is 'numecs' minus the number of 'SAME_TRANS' entries in 'ext'. # integer function tbldiff( state, pr, ext ) NOIMPLICIT integer state(ARB), pr, ext(ARB) LEX_ECS LEX_PROT integer i, numdiff, tblbase numdiff = 0 tblbase = numecs * (pr - 1) for ( i=1; i <= numecs; i=i+1 ) if ( protsave(tblbase + i) == state(i) ) ext(i) = SAME_TRANS else { ext(i) = state(i) numdiff = numdiff + 1 } return numdiff end ### ungetc - push a character back onto the input stream # # synopsis # character ch # call ungetc( ch ) # subroutine ungetc( ch ) NOIMPLICIT character ch LEX_IO integer ich ich = ch if ( ch == '@n' ) linenum = linenum - 1 call stkpush( pbstack, ich ) return end ### yylex - scan for a regular expression token # # synopsis # # token = yylex( value ) # # token - return token found # value - return value of token; the actual character read # integer function yylex( value ) NOIMPLICIT integer value integer ndlookup, idx logical getuntil character type, lgetc, peek, str1(MAXLINE), str2(MAXLINE), escseq LEX_IO LEX_MISC LEX_FLAGS repeat # to process nested macro definitions { lastch = lgetc( lastch ) value = lastch switch ( lastch ) { case EOF: call ungetc( lastch ) if ( ! endseen ) # insert section-end token into input stream call pbstr( "~~@n" ) else return ENDSYM case '{': if ( type( peek( lastch ) ) == DIG | sectnum == 1 ) return '{' idx = 1 if ( ! getuntil ( '}', str1, idx, MAXLINE ) ) call synerr( "missing } in macro expansion" ) else { lastch = lgetc( lastch ) # eat the closing brace if ( ndlookup( str1, str2 ) != YES ) call synerr( "undefined macro" ) else { # push back def. in parenthesis call ungetc( ')' ) call pbstr( str2 ) call ungetc( '(' ) } } case '0', '1', '2', '3', '4', '5', '6', '7', '8', '9': return DIG case '~': if ( sectnum == 1 ) { lastch = lgetc( lastch ) switch( lastch ) { case '~': return SECTEND case 's','S': return SCDECL case '{': return CODESEQBEG case '}': return CODESEQEND default: call ungetc( lastch ) lastch = '~' return CHAR } } else if (peek( lastch ) == '~') { if ( ! endseen ) { # push back default action call pbstr( " return( EOF )@n~" ) call ungetc( EOF_PUSH_BACK_SYM ) call pbstr( "@n[@^a-@0177] ECHO@n" ) endseen = .true. } else { call eatline return ENDSYM } } else return CHAR case EOF_PUSH_BACK_SYM: value = SYM_EOF return CHAR case '@@': if ( sectnum != 1 ) { lastch = escseq( lgetc( lastch ) ) value = lastch } return CHAR case '/', '|', '<', '>', ',', '$', '*', '+', '%', '\', '}', '?', '[', ']', '"', '(', ')', '-', '!', '#', ' ', '@t', '@n': return lastch default: return CHAR } } # should never get this far call error( "yylex: error in ratfor compiler" ) return end #-t- lex.y 77936 ascii 05Jan84 07:46:02 #-h- lex.r 123300 ascii 05Jan84 07:46:12 include yypdef subroutine yysem( yyprod ) integer yyprod include "bsdef" # for MAX_BS_SIZE definition in snstods include "lexdef" define(ENDSYM,0) define(INFINITY,-1) define(CHAR,1) define(DIG,2) define(SECTEND,3) define(SCDECL,4) define(CODESEQBEG,5) define(CODESEQEND,6) integer link, mkor, sclookup, mkstate, mkopt, copysingl, mkposcl, mkclos, mkrep integer pat, scnum, scstate, nmptr, eps, trailcnt integer cclp, i character nmstr(MAXLINE), ch logical trailingcontext LEX_NFA LEX_MISC integer yysta, yytok, yyval, yyerrok, yyerct, yylexval integer yymaxstack, yystkp, yysstk, yyvstk, yytstk common /yymicm/ yyval, yytok, yyerrok, yysta, yystkp, yymaxstack, yylexval, yyerct common /yysscm/ yysstk( 25) common /yytscm/ yytstk( 25) common /yyvscm/ yyvstk( 25) switch ( yyprod ) { case 4: bound = NIL free = NIL case 7: call synerr( "unknown error processing section 1" ) case 10: call strim(nmstr(yyvstk(yystkp -1) )) call ndinstal( nmstr(yyvstk(yystkp -3) ), nmstr(yyvstk(yystkp -1) ) ) nmptr = 0 case 11: call printf( "%s@n", nmstr(yyvstk(yystkp -1) ) ) nmptr = 0 case 12: nmptr = 0 case 14: call printf( "lexminsc = %d@n", LASTSCINIT+1 ) call printf( "lexmaxsc = %d@n", lastsc ) call printf( "define(SYM_BOL,%d)@n", SYM_BOL ) call printf( "define(SYM_EOF,%d)@n", SYM_EOF ) call skelout sectnum = 2 case 17: nmptr = 0 trailingcontext = .false. trailcnt = 0 case 18: pat = link( yyvstk(yystkp -1) , yyvstk(yystkp) ) pat = link( yyvstk(yystkp -2) , pat ) pat = link( yyvstk(yystkp -3) , pat ) call accept( pat ) trailnum(accnum) = trailcnt call copyaction bound = mkor( bound, pat ) case 19: pat = link( yyvstk(yystkp -1) , yyvstk(yystkp) ) pat = link( yyvstk(yystkp -2) , pat ) call accept( pat ) trailnum(accnum) = trailcnt call copyaction free = mkor( free, pat ) case 20: case 21: call synerr( "unrecognized rule" ) case 22: yyval = yyvstk(yystkp -1) case 23: call scinstal( nmstr(yyvstk(yystkp) ) ) nmptr = 0 case 24: call scinstal( nmstr(yyvstk(yystkp) ) ) nmptr = 0 case 25: call synerr( "bad start condition list" ) case 26: if ( sclookup( nmstr(yyvstk(yystkp) ), scnum ) != YES ) { call synerr( "undeclared start condition" ) yyval = yyvstk(yystkp -2) } else { scstate = mkstate( scnum ) yyval = mkor( yyvstk(yystkp -2) , scstate ) } nmptr = 0 case 27: if ( sclookup( nmstr(yyvstk(yystkp) ), scnum ) != YES ) call synerr( "undeclared start condition" ) else yyval = mkstate( scnum ) nmptr = 0 case 28: call synerr( "bad start condition list" ) yyval = mkstate( SYM_EPSILON ) case 29: nmstr(nmptr) = yyvstk(yystkp) nmptr = nmptr + 1 nmstr(nmptr) = EOS yyval = yyvstk(yystkp -1) case 30: nmptr = nmptr + 1 yyval = nmptr nmstr(nmptr) = yyvstk(yystkp) nmptr = nmptr + 1 nmstr(nmptr) = EOS case 31: yyval = mkstate( SYM_BOL ) case 32: yyval = mkopt( mkstate( SYM_BOL ) ) case 33: if (trailingcontext) { call synerr( "trailing context used twice" ) yyval = mkstate( SYM_EPSILON ) } else { trailingcontext = .true. trailcnt = 1 eps = mkstate( SYM_EPSILON ) yyval = link( eps, mkstate( '@n' ) ) } case 34: yyval = mkstate( SYM_EPSILON ) case 35: if ( trailingcontext ) call synerr( "variable length trailing _ context not allowed" ) yyval = mkor( yyvstk(yystkp -2) , yyvstk(yystkp) ) case 36: yyval = link( yyvstk(yystkp -1) , yyvstk(yystkp) ) case 37: yyval = yyvstk(yystkp) case 38: if (trailingcontext) call synerr( "trailing context used twice" ) else trailingcontext = .true. yyval = yyvstk(yystkp -1) case 39: yyval = link( yyvstk(yystkp -1) , yyvstk(yystkp) ) case 40: yyval = yyvstk(yystkp) case 41: if ( trailingcontext ) call synerr( "variable length trailing _ context not allowed" ) yyval = mkclos( yyvstk(yystkp -1) ) case 42: if ( trailingcontext ) call synerr( "variable length trailing _ context not allowed" ) yyval = mkposcl( yyvstk(yystkp -1) ) case 43: if ( trailingcontext ) call synerr( "variable length trailing _ context not allowed" ) yyval = mkopt( yyvstk(yystkp -1) ) case 44: if ( trailingcontext ) call synerr( "variable length trailing _ context not allowed" ) if (yyvstk(yystkp -3) > yyvstk(yystkp -1) ) { call synerr( "bad iteration values" ) yyval = yyvstk(yystkp -5) } else yyval = mkrep( yyvstk(yystkp -5) , yyvstk(yystkp -3) , yyvstk(yystkp -1) ) case 45: if ( trailingcontext ) call synerr( "variable length trailing _ context not allowed" ) yyval = mkrep( yyvstk(yystkp -4) , yyvstk(yystkp -2) , INFINITY ) case 46: if ( trailingcontext ) trailcnt = trailcnt + yyvstk(yystkp -1) yyval = link( yyvstk(yystkp -3) , copysingl( yyvstk(yystkp -3) , yyvstk(yystkp -1) -1 ) ) case 47: call cclinit( cclp ) call ccladd( cclp, '@n' ) # '?' doesn't match newline call cclnegate( cclp ) if ( trailingcontext ) trailcnt = trailcnt + 1 yyval = mkstate( cclp ) case 48: if ( trailingcontext ) trailcnt = trailcnt + 1 yyval = mkstate( yyvstk(yystkp -1) ) case 49: call ccladd( yyvstk(yystkp -1) , '@n' ) # negated ccls don't match call cclnegate( yyvstk(yystkp -1) ) if ( trailingcontext ) trailcnt = trailcnt + 1 yyval = mkstate( yyvstk(yystkp -1) ) case 50: yyval = yyvstk(yystkp -1) case 51: yyval = yyvstk(yystkp -1) case 52: if ( trailingcontext ) trailcnt = trailcnt + 1 yyval = mkstate( yyvstk(yystkp) ) case 53: yyval = yyvstk(yystkp -1) * 10 + (yyvstk(yystkp) - '0') case 54: yyval = yyvstk(yystkp) - '0' case 55: if (yyvstk(yystkp -2) > yyvstk(yystkp) ) call synerr( "negative range in character class" ) else for ( i=yyvstk(yystkp -2) ; i <= yyvstk(yystkp) ; i=i+1 ) call ccladd( yyvstk(yystkp -3) , i ) yyval = yyvstk(yystkp -3) case 56: call ccladd( yyvstk(yystkp -1) , yyvstk(yystkp) ) yyval = yyvstk(yystkp -1) case 57: call cclinit( cclp ) if (yyvstk(yystkp -2) > yyvstk(yystkp) ) call synerr( "negative range in character class" ) else for ( i=yyvstk(yystkp -2) ; i <= yyvstk(yystkp) ; i=i+1 ) call ccladd( cclp, i ) yyval = cclp case 58: call cclinit( cclp ) call ccladd( cclp, yyvstk(yystkp) ) yyval = cclp case 59: call synerr( "error in character class" ) call cclinit( cclp ) yyval = cclp case 60: call putc( yyvstk(yystkp) ) case 61: call putc( yyvstk(yystkp) ) case 63: nmptr = nmptr + 1 nmstr(nmptr) = EOS yyval = nmptr case 64: nmstr(nmptr) = yyvstk(yystkp) nmptr = nmptr + 1 nmstr(nmptr) = EOS yyval = yyvstk(yystkp -1) case 65: nmstr(nmptr) = yyvstk(yystkp) nmptr = nmptr + 1 nmstr(nmptr) = EOS yyval = yyvstk(yystkp -1) case 66: nmptr = nmptr + 1 yyval = nmptr nmstr(nmptr) = yyvstk(yystkp) nmptr = nmptr + 1 nmstr(nmptr) = EOS case 67: nmptr = nmptr + 1 yyval = nmptr nmstr(nmptr) = yyvstk(yystkp) nmptr = nmptr + 1 nmstr(nmptr) = EOS case 68: pat = mkstate( yyvstk(yystkp) ) if ( trailingcontext ) trailcnt = trailcnt + 1 yyval = link( yyvstk(yystkp -1) , pat ) case 69: yyval = mkstate( SYM_EPSILON ) default:; } return end ############################################################################### # ### lex - main program # # synopsis (from the shell) # lex [-v] [file ...] # DRIVER(lex) NOIMPLICIT integer ndfa, dfa, state1 LEX_FLAGS # Initialize. call lexinit # Read in the input file(s). call readin( state1 ) if ( ! syntaxerror ) { # Convert the ndfa to a dfa. call ntod( state1 ) # Generate the ratfor state transition tables from the dfa. call gentabs( state1 ) } # Terminate. call lexend DRETURN end ### accept - add an accepting state to a machine # # synopsis # # call accept( mach ) # # the global ACCNUM is incremented and the new value becomes `mach's # accepting number # subroutine accept( mach ) NOIMPLICIT integer mach, astate, mkstate, link LEX_NFA accnum = accnum + 1 if ( accnum > MAXRULES ) call error( "accept: too many rules" ) # hang the accepting number off an epsilon state. if it is associated # with a state that has a non-epsilon out-transition, then the state # will accept BEFORE it makes that transition, i.e. one character too soon if ( transchar(finalst(mach)) == SYM_EPSILON ) accptnum(finalst(mach)) = accnum else { astate = mkstate( SYM_EPSILON ) accptnum(astate) = accnum mach = link( mach, astate ) } return end ### bldtbl - build table entries for dfa state # # synopsis # integer state(MAX_SYMBOL), statenum, totaltrans, comstate, comfreq # call bldtbl( state, statenum, totaltrans, comstate, comfreq ) # # State is the 'statenum'th dfa state. It is indexed by equivalence class and # gives the number of the state to enter for a given equivalence class. # totaltrans is the total number of transitions out of the state. Comstate # is that state which is the destination of the most transitions out of State. # Comfreq is how many transitions there are out of State to Comstate. # # A note on terminology: # "protos" are transition tables which have a high probability of # either being redundant (a state processed later will have an identical # transition table) or nearly redundant (a state processed later will have # many of the same out-transitions). A 'most recently used' queue of # protos is kept around with the hope that most states will find a proto # which is similar enough to be usable, and therefore compacting the # output tables. # "templates" are a special type of proto. If a transition table is # homogenous or nearly homogenous (all transitions go to the same destination) # then the odds are good that future states will also go to the same destination # state on basically the same character set. These homogenous states are # so common when dealing with large rule sets that they merit special # attention. If the transition table were simply made into a proto, then # (typically) each subsequent, similar state will differ from the proto # for two out-transitions. One of these out-transitions will be that # character on which the proto does not go to the common destination, # and one will be that character on which the state does not go to the # common destination. Templates, on the other hand, go to the common # state on EVERY transition character, and therefore cost only one # difference. # subroutine bldtbl( state, statenum, totaltrans, comstate, comfreq ) NOIMPLICIT integer state(ARB), statenum, totaltrans, comstate, comfreq LEX_ECS LEX_PROT integer extptr, extrct(MAX_SYMBOL,2) integer otherextptr, mindiff, minprot, tbldiff, i, d logical checkcom # If extptr is 1 then the first array of extrct holds the result of the # 'best difference' to date, which is those transitions which occur in # 'state' but not in the proto which, to date, has the fewest differences # between itself and 'state'. If extptr is 2 then the second array of # extrct hold the best difference. The two arrays are used to toggle # between so that the best difference to date can be kept around and # also a difference just created by checking against a candidate 'best' # proto. extptr = 1 # if the state has too few out-transitions, don't bother trying to # compact its tables if ( (totaltrans * 100) < (numecs * PROTO_SIZE_PERCENTAGE) ) call mkentry( state, statenum, DEFBASE, totaltrans ) else { # checkcom is true if we should only check 'state' against # protos which have the same 'comstate' value checkcom = comfreq * 100 > totaltrans * CHECK_COM_PERCENTAGE minprot = firstprot mindiff = totaltrans if ( checkcom ) { # find first proto which has the same 'comstate' for ( i=firstprot; i != NIL; i=protnext(i) ) if ( protcomst(i) == comstate ) { minprot = i mindiff = tbldiff( state, minprot, extrct(1,extptr) ) break } } else { # since we've decided that the most common destination out # of 'state' does not occur with a high enough frequency, # we set the 'comstate' to zero, assuring that if this state # is entered into the proto list, it will not be considered # a template. comstate = 0 if ( firstprot != NIL ) { minprot = firstprot mindiff = tbldiff( state, minprot, extrct(1,extptr) ) } } # we now have the first interesting proto in 'minprot'. If # it matches within the tolerances set for the first proto, # we don't want to bother scanning the rest of the proto list # to see if we have any other reasonable matches. if ( mindiff * 100 > totaltrans * FIRST_MATCH_DIFF_PERCENTAGE ) { # not a good enough match. Scan the rest of the protos for ( i=minprot; i != NIL; i=protnext(i) ) { d = tbldiff( state, i, extrct(1,3 - extptr) ) if ( d < mindiff ) { extptr = 3 - extptr mindiff = d minprot = i } } } # check if the proto we've decided on as our best bet is close # enough to the state we want to match to be usable if ( mindiff * 100 > totaltrans * ACCEPTABLE_DIFF_PERCENTAGE ) { # no good. If the state is homogeneous enough, we make a # template out of it. Otherwise, we make a proto. if ( comfreq * 100 >= totaltrans * TEMPLATE_SAME_PERCENTAGE ) call mktemp( state, statenum, comstate ) else { call mkprot( state, statenum, comstate ) call mkentry( state, statenum, DEFBASE, totaltrans ) } } else { # use the proto call mkentry( extrct(1,extptr), statenum, prottbl(minprot), mindiff ) # if this state was sufficiently different from the proto # we built it from, make it, too, a proto if ( mindiff * 100 >= totaltrans * NEW_PROTO_DIFF_PERCENTAGE ) call mkprot( state, statenum, comstate ) # since mkprot added a new proto to the proto queue, it's possible # that 'minprot' is no longer on the proto queue (if it happened # to have been the last entry, it would have been bumped off). # If it's not there, then the new proto took its physical place # (though logically the new proto is at the beginning of the # queue), so in that case the following call will do nothing. call mv2front( minprot ) } } return end ### ccladd - add a single character to a ccl # # synopsis # integer cclp # character ch # call ccladd( cclp, ch ) # subroutine ccladd( cclp, ch ) NOIMPLICIT integer cclp, getcclset character ch integer int int = ch call bsbset( getcclset( cclp ), int ) return end ### cclinit - make an empty ccl # # synopsis # integer cclp # call cclinit ( cclp ) # subroutine cclinit ( cclp ) NOIMPLICIT integer cclp, cclset call bsinit( cclset, MAX_REAL_SYMBOL ) call mkcclmap( cclset, cclp ) return end ### cclnegate - negate a ccl # # synopsis # integer cclp # call cclnegate( ccl ) # subroutine cclnegate( cclp ) NOIMPLICIT integer cclp, getcclset, cclset, i cclset = getcclset( cclp ) call bscomp( cclset ) # special hack: bscomp negates ALL the bits in cclset, including # possibly some bits which are not legal characters. So clear # any such bits. for ( i=0; i < MIN_SYMBOL; i=i+1 ) call bsbclr( cclset, i ) return end ### ccl2ecl - convert character classes to set of equivalence classes # # synopsis # call ccl2ecl # subroutine ccl2ecl NOIMPLICIT LEX_ECS LEX_CCL integer i, ecset, cclp, ccls, bsloopinit, cclm, getcclset logical bsnext, c2einit data c2einit /.true./ if ( c2einit ) { call bsinit( ecset, MAX_REAL_SYMBOL ) c2einit = .false. } for ( i=LASTCCLINIT-1; i >= lastccl; i=i-1 ) { # we loop through each character class, and for each character # in the class, add the character's equivalence class to the # new 'character' class we are creating. Thus when we are all # done, character classes will really consist of collections # of equivalence classes cclp = getcclset( i ) for ( ccls=bsloopinit( cclp ); bsnext( ccls, cclm ); ) if ( ecgroup(cclm) > 0 ) call bsbset( ecset, ecgroup(cclm) ) call bsendloop( ccls ) call bscopy( ecset, cclp ) call bszero( ecset ) } return end ### cmptmps - compress template table entries # # synopsis # call cmptmps # # template tables are compressed by using the 'template equivalence # classes', which are collections of transition character equivalence # classes which always appear together in templates - really meta-equivalence # classes. until this point, the tables for templates have been stored # up at the top end of the nxt array; they will now be compressed and have # table entries made for them. # subroutine cmptmps NOIMPLICIT LEX_ECS LEX_DFA integer cre8ecs, tmp(MAX_SYMBOL), i, j, totaltrans, trans # the last template created by mktemp() will occupy the lowest # location in the nxt/chk tables of all the templates. So we # can check it to see if the tables have overflowed. if ( lasttemp != DEFBASE ) if ( base(lasttemp) <= tblend ) call error( "cmptmps: state tables overflowed" ) # create equivalence classes base on data gathered on template # transitions nummecs = cre8ecs( tecfwd, tecbck, numecs ) # loop through each BASE() slot assigned to a template for ( i=lasttemp; i < DEFBASE; i=i+1 ) { totaltrans = 0 # number of non-jam transitions out of this template for ( j=1; j <= numecs; j=j+1 ) { trans = nxt(base(i)+j) if ( trans != 0 ) { # non-jam transition totaltrans = totaltrans + 1 } # the absolute value of tecbck is the meta-equivalence class # of a given equivalence class, as set up by cre8ecs tmp(abs( tecbck(j) )) = trans } # it is assumed (in a rather subtle way) in the skeleton that # the DEF() entry for all templates is the jam template, i.e. # templates never default to other non-jam table entries (e.g. # another template) call mkentry( tmp, i, DEFBASE, totaltrans ) } return end ### copline - copy the rest of the current input line to the output # # synopsis # call copline # subroutine copline NOIMPLICIT character ch, lgetc repeat { if ( lgetc(ch) == EOF ) { # Put the EOF back - it should never get read. call ungetc( ch ) break } call putc( ch ) if ( ch == '@n' ) break } return end ### copyaction - copy action corresponding to a rule to output file # # synopsis # # call copyaction # # note: copyaction ASSUMES that the global accnum is the accepting # number corresponding with the rule action. # subroutine copyaction NOIMPLICIT integer bracelevel character ch1, lgetc LEX_IO LEX_NFA LEX_MISC string casestr " case " # the parser will have read the character after the rule we have # just processed in order to tell that it needed to reduce. we put that # character back so it can be copied appropriately to the output. # this is especially important if the character was a newline. call ungetc( lastch ) # Output the case label. call printf( "%s%d:@n", casestr, accnum ) if ( trailnum(accnum) > 0 ) { # do trailing context magic to not match the trailing characters call printf( "curbufp = mod( curbufp+BUFSIZE-%d, BUFSIZE ) + 1@n", trailnum(accnum)+1 ) } # Copy the ratfor action to the output file, matching {}s. bracelevel = 0 repeat { ch1 = lgetc( ch1 ) if ( ch1 == EOF ) { # Oh no! We have read an end of file! Put it back, quick! call ungetc( ch1 ) break } call putc( ch1 ) if ( ch1 == '{' ) bracelevel = bracelevel + 1 else if ( ch1 == '}' ) bracelevel = bracelevel - 1 else if ( (ch1 == '@n' & bracelevel <= 0) ) break } call putc( '@n' ) return end ### copysingl - make a given number of copies of a singleton machine # # synopsis # # newsng = copysingl( singl, num ) # # newsng - a new singleton composed of `num' copies of `singl' # singl - a singleton machine # num - the number of copies of `singl' to be present in `newsng' # integer function copysingl( singl, num ) NOIMPLICIT integer singl, num integer copy, dupmachine, link, i, mkstate copy = mkstate( SYM_EPSILON ) for ( i=1; i <= num; i=i+1 ) copy = link( copy, dupmachine( singl ) ) return ( copy ) end ### cre8ecs - associate equivalence class numbers with class members # # synopsis # integer cre8ecs # number of classes = cre8ecs( fwd, bck, num ) # # fwd is the forward linked-list of equivalence class members. bck # is the backward linked-list, and num is the number of class members. # Returned is the number of classes. # integer function cre8ecs( fwd, bck, num ) NOIMPLICIT integer fwd(ARB), bck(ARB), num integer i, j, numcl numcl = 0 # create equivalence class numbers. From now on, abs( bck(x) ) # is the equivalence class number for object x. If bck(x) # is positive, then x is the representative of its equivalence # class. for ( i=1; i <= num; i=i+1 ) if ( bck(i) == NIL ) { numcl = numcl + 1 bck(i) = numcl for ( j=fwd(i); j != NIL; j=fwd(j) ) bck(j) = -numcl } return ( numcl ) end ### dataflush - flush generated data statements # # synopsis # call dataflush # subroutine dataflush NOIMPLICIT LEX_IO call printf( "@n" ) # reset the number of data statements written on the current line datapos = 0 return end ### dumpnfa - debugging routine to write out an nfa # # synopsis # integer state1 # call dumpnfa( state1 ) # subroutine dumpnfa( state1 ) NOIMPLICIT integer state1 integer tlp, sym, tsp1, tsp2 integer anum, ns LEX_NFA call fprintf( ERROUT, "dumpnfa: ******************** beginning dump of nfa at %d@n", state1 ) for ( ns=firstst(state1); ns <= lastst(state1); ns=ns+1 ) { call fprintf( ERROUT, "state # %4d@t", ns ) sym = transchar(ns) tsp1 = trans1(ns) tsp2 = trans2(ns) anum = accptnum(ns) call fprintf( ERROUT, "%3d: %4d, %4d", sym, tsp1, tsp2 ) if ( anum != NIL ) call fprintf( ERROUT, " [%d]", anum ) call fprintf( ERROUT, "@n" ) } call remark( "dumpnfa: ******************** end of dump" ) return end ### dupmachine - make a duplicate of a given machine # # synopsis # # copy = dupmachine( mach ) # # copy - holds duplicate of `mach' # mach - machine to be duplicated # # note that the copy of `mach' is NOT an exact duplicate; rather, all the # transition states values are adjusted so that the copy is self-contained, # as the original should have been. Also note that the original MUST be # contiguous, with its low and high states accessible by the arrays # firstst and lastst # integer function dupmachine( mach ) NOIMPLICIT integer mach LEX_NFA integer i, state, mkstate, init for ( i=firstst(mach); i <= lastst(mach); i=i+1 ) { state = mkstate( transchar(i) ) if (trans1(i) != NO_TRANSITION) { call mkxtion( finalst(state), trans1(i) + state - i ) if ( transchar(i) == SYM_EPSILON & trans2(i) != NO_TRANSITION ) call mkxtion( finalst(state), trans2(i) + state - i ) } } init = mach + state - i + 1 firstst(init) = firstst(mach) + state - i + 1 finalst(init) = finalst(mach) + state - i + 1 lastst(init) = lastst(mach) + state - i + 1 return ( init ) end ### eatline - read and discard the rest of the current input line # # synopsis # call eatline # subroutine eatline NOIMPLICIT character ch, lgetc repeat { if ( lgetc( ch ) == EOF ) { # Put the EOF back - it should never get read. call ungetc( ch ) break } if ( ch == '@n' ) break } return end ### epsclosure - construct the epsilon closure of a set of ndfa states # # synopsis # integer t, u, accset, nacc, hashval # call epsclosure( t, u, accset, nacc, hashval ) # # NOTES # the epsilon closure is the set of all states reachable by an arbitrary # number of epsilon transitions which themselves do not have epsilon # transitions going out, unioned with the set of states which have non-null # accepting numbers # hashval is the hash value for the dfa corresponding to the state set # subroutine epsclosure( t, u, accset, nacc, hashval ) NOIMPLICIT integer t, u, accset, nacc, hashval integer bslp, ns, transsym, tsp, nfaccnum, visited integer bsloopinit, wlp, stkpos, stk(EPSCLOSURESTKSIZE) logical bsnext, bsbtst, epsinit LEX_NFA data epsinit /.true./ if ( epsinit ) { # visited keeps track of which states have already been processed call bsinit( visited, lastnfa ) epsinit = .false. } call bszero( u ) call bszero( accset ) nacc = 0 stkpos = 0 hashval = 0 for ( bslp=bsloopinit( t ); bsnext( bslp, ns ); ) { stkpos = stkpos + 1 if ( stkpos > EPSCLOSURESTKSIZE ) call error( "epsclosure: stack overflow" ) stk(stkpos) = ns } call bsendloop( bslp ) while ( stkpos > 0 ) { ns = stk(stkpos) # return any accepting states encountered, along with a count nfaccnum = accptnum(ns) if ( nfaccnum != NIL ) { call bsbset( accset, nfaccnum ) nacc = nacc + 1 call bsbset( u, ns ) if ( ! bsbtst( visited, ns ) ) hashval = hashval + ns } transsym = transchar(ns) tsp = trans1(ns) if ( transsym == SYM_EPSILON ) { if ( tsp != NO_TRANSITION ) { if ( ! bsbtst( visited, tsp ) ) stk(stkpos) = tsp else stkpos = stkpos - 1 tsp = trans2(ns) if ( tsp != NO_TRANSITION ) if ( ! bsbtst( visited, tsp ) ) { stkpos = stkpos + 1 if ( stkpos > EPSCLOSURESTKSIZE ) call error( "epsclosure: stack overflow" ) stk(stkpos) = tsp } } else stkpos = stkpos - 1 } else { call bsbset( u, ns ) if ( ! bsbtst( visited, ns ) ) hashval = hashval + ns stkpos = stkpos - 1 } call bsbset( visited, ns ) } call bszero( visited ) return end ### escseq - turn an escaped character into the correct plain character # # synopsis # character pch, escseq, ech # pch = escseq( ech ) # character function escseq( ch ) NOIMPLICIT character ch integer i character lgetc, esc character esctemplate(6) # big enough for the largest possible # escape sequence, plus an EOS # we read ahead enough characters to ensure that we can recognize # the largest possible escape sequence (which is "@0xxx"), hand # the resultant string to esc(), and the put back those characters # which weren't part of the escape sequence esctemplate(1) = '@@' esctemplate(2) = ch for ( i=3; i <= 5; i=i+1 ) if ( lgetc( esctemplate(i) ) == EOF ) { call ungetc( EOF ) break } esctemplate(i) = EOS i = 1 escseq = esc( esctemplate, i ) call pbstr( esctemplate(i+1) ) return end ### gentabs - generate ratfor data statements for the transition tables # # synopsis # integer state1 # call gentabs( state1 ) # subroutine gentabs( state1 ) NOIMPLICIT integer state1 integer bsloopinit logical bsnext, bsempty, bsbtst integer i, j, nstate, naccepting, aslp, anum character alist, accept, basearray, defarray, nextarray, checkarray character ecarray, ch, lgetc, matcharray LEX_DFA LEX_ECS LEX_MISC LEX_PROT string arydecl "integer %c(%d)@n" nummt = 0 alist = 'L' accept = 'A' ecarray = 'E' matcharray = 'M' basearray = 'B' defarray = 'D' nextarray = 'N' checkarray = 'C' call skelout # Generate declaration statements for acclists and accepting. call printf( arydecl, alist, lastdfa ) call printf( arydecl, accept, numas ) call printf( arydecl, ecarray, lastsc ) call printf( arydecl, matcharray, numecs ) call printf( arydecl, basearray, lastdfa + numtemps ) call printf( arydecl, defarray, lastdfa + numtemps ) call printf( arydecl, nextarray, tblend ) call printf( arydecl, checkarray, tblend ) call printf( "define(JAMBASE,%d)@n", jambase ) call printf( "define(STARTSTATE,%d)@n", state1 ) # the first template begins right after the default jam table, # which itself begins right after the last dfa call printf( "define(FIRST_TEMPLATE_BASE,%d)@n", lastdfa + 2 ) nstate = 0 naccepting = 0 # write out the accepting lists. Note that if desired, these could # be written out in snstods as the dfa states are created, since they # aren't needed any later than that. for ( i=1; i <= lastdfa; i=i+1 ) { if ( bsempty( das(i) ) ) call mkdata( alist, i, NIL ) else { naccepting = naccepting + 1 call mkdata( alist, i, naccepting ) for ( aslp=bsloopinit( das(i) ); bsnext( aslp, anum ); ) { call mkdata( accept, naccepting, anum ) naccepting = naccepting + 1 } call bsendloop( aslp ) call mkdata( accept, naccepting, NIL ) } } call dataflush # write out equivalence classes for ( i=MIN_SYMBOL; i <= lastsc; i=i+1 ) call mkdata( ecarray, i, abs( ecgroup(i) ) ) call dataflush # write out meta-equivalence classes (used to index templates with) for ( i=1; i <= numecs; i=i+1 ) call mkdata( matcharray, i, abs( tecbck(i) ) ) call dataflush for ( i=1; i <= lastdfa; i=i+1 ) { if ( base(i) == JAM ) base(i) = jambase call mkdata( basearray, i, base(i) ) if ( def(i) > lastdfa ) # template reference def(i) = MAX_DFAS - def(i) + lastdfa + 1 call mkdata( defarray, i, def(i) ) } # shift templates down to be adjacent with the rest of the table # entries for ( i=1; i <= numtemps; i=i+1 ) { call mkdata( basearray, i + lastdfa, base(MAX_DFAS - i + 1) ) if ( def(MAX_DFAS - i + 1) > lastdfa ) # template reference def(MAX_DFAS - i + 1) = MAX_DFAS - def(MAX_DFAS - i + 1) + lastdfa + 1 call mkdata( defarray, i + lastdfa, def(MAX_DFAS - i + 1 ) ) } call dataflush for ( i=1; i <= tblend; i=i+1 ) { call mkdata( nextarray, i, nxt(i) ) if ( chk(i) == 0 ) nummt = nummt + 1 if ( chk(i) > lastdfa ) # template reference chk(i) = MAX_DFAS - chk(i) + lastdfa + 1 call mkdata( checkarray, i, chk(i) ) } call dataflush call skelout # copy remainder of input to output for ( ch=lgetc( ch ); ch != EOF; ch=lgetc( ch ) ) call putc( ch ) return end ### getcclset - return set pointer corresponding to passed ccl index # # synopsis # integer getcclset, cclp, cclsetptr # cclsetptr = getcclset( cclp ) # integer function getcclset( cclp ) NOIMPLICIT integer cclp LEX_CCL return ( cclmap(-cclp) ) end ### getuntil - read characters until a specified character is found # # synopsis # logical chfound, getuntil # integer idx, strlen # character termch, str(strlen) # chfound = getuntil ( termch, str, idx, strlen ) # logical function getuntil ( termch, str, idx, strlen ) NOIMPLICIT character termch, str(ARB) integer idx, strlen character lgetc, ch repeat { ch = lgetc( ch ) if ( ch == termch | ch == '@n' | ch == EOF | idx+1 > strlen ) break str(idx) = ch idx = idx + 1 } str(idx) = EOS getuntil = ( ch == termch ) call ungetc( ch ) # put back the terminator return end ### inittbl - initialize transition tables # # synopsis # call inittbl # # Initializes 'firstfree' to be one beyond the end of the table. Initializes # all 'chk' entries to be zero. Note that templates are built starting # at the END of the base/def tables. They are shifted down to be contiguous # with the non-template entries during table generation. # subroutine inittbl NOIMPLICIT LEX_DFA LEX_ECS LEX_PROT integer i for ( i = numecs + 1; i <= MAX_XPAIRS; i=i+1 ) chk(i) = 0 tblend = 0 firstfree = tblend + 1 lasttemp = DEFBASE # set up doubly-linked meta-equivalence classes # these are sets of equivalence classes which all have identical # transitions out of TEMPLATES tecbck(1) = NIL for ( i=2; i <= numecs; i=i+1 ) { tecbck(i) = i - 1 tecfwd(i-1) = i } tecfwd(numecs) = NIL return end ### inpinit - initialize the lex input routines # # synopsis # call inpinit # # DESCRIPTION # Reads in the file name arguments (if any), opens them all, and saves # the file identifiers on a queue. # subroutine inpinit NOIMPLICIT character argbuf(MAXLINE) integer i, getarg, fd, open, quefremove logical queempty LEX_IO call queinit( fileq ) call stkinit( pbstack ) # Read in all the file arguments, open the files, and put them in a queue. for ( i=1; getarg(i, argbuf, MAXLINE) != EOF; i=i+1 ) { if ( argbuf(1) == '-' & argbuf(2) == EOS ) fd = STDIN else { fd = open( argbuf, READ ) if ( fd == ERR ) call cant( argbuf ) } call quebinsert( fileq, fd ) } if ( queempty( fileq ) ) { # There were no file arguments - just process standard input. infile = STDIN filenum = 0 # filenum == 0 means STDIN, no arguments given } else { # Remove the first file from the queue. infile = quefremove( fileq ) filenum = 1 } linenum = 1 return end ### lexend - terminate lex # # synopsis # call lexend # subroutine lexend NOIMPLICIT LEX_MISC LEX_IO LEX_DFA LEX_NFA LEX_PROT LEX_ECS LEX_FLAGS call close( skelfile ) call quedestroy( fileq ) call stkdestroy( pbstack ) call gtime( endtime ) if ( printstats ) { call fprintf( ERROUT, "Usage statistics:@n" ) call fprintf( ERROUT, " started at %s, finished at %s@n", starttime, endtime ) call fprintf( ERROUT, " NFA size = %d states, DFA size = %d states@n", lastnfa, lastdfa ) call fprintf( ERROUT, " %d state/nextstate pairs created@n", numsnpairs ) call fprintf( ERROUT, " %d base/def entries created@n", lastdfa + numtemps ) call fprintf( ERROUT, " %d nxt/chk entries created@n", tblend ) call fprintf( ERROUT, " %d empty table entries@n", nummt ) call fprintf( ERROUT, " %d protos created@n", numprots ) call fprintf( ERROUT, " %d templates created@n", numtemps ) call fprintf( ERROUT, " %d equivalence classes created@n", numecs ) call fprintf( ERROUT, " %d meta-equivalence classes created@n@n", nummecs ) call bsstats } return end ### lexinit - initialize lex # # synopsis # call lexinit # subroutine lexinit NOIMPLICIT integer getarg, i, open, mkstate character arg(MAXLINE), clower LEX_FLAGS LEX_IO LEX_1STACK LEX_NFA LEX_DFA LEX_PROT LEX_ECS LEX_CCL LEX_MISC string skelname "~/.%lib/lexskel" printstats = .false. syntaxerror = .false. ddebug = .false. call bslbinit # Read flags. repeat { if ( getarg( 1, arg, MAXLINE ) == EOF ) break if ( arg(1) != '-' | arg(2) == EOS ) break for ( i=2; arg(i) != EOS; i=i+1 ) { if ( clower(arg(i)) == 'v' ) printstats = .true. else if ( arg(i) == 'd' ) ddebug = .true. else { call putlin( "unknown flag: ", ERROUT ) call error( arg ) } } call delarg( 1 ) } # Initialize ccl indices. It is ASSUMED here that ccl indices # are all less than valid character values, and that they grow # downward (become more negative as more and more are allocated) lastccl = LASTCCLINIT # initialize the start condition book-keeping lastsc = LASTSCINIT # Initialize the lex input routines. call inpinit # Initialize the statistics. call gtime( starttime ) # Open the lexskel file. skelfile = open( skelname, READ ) if ( skelfile == ERR ) call cant( skelname ) lastdfa = 0 lastnfa = 0 optsc = mkstate( SYM_EPSILON ) accnum = 0 numas = 0 numsnpairs = 0 numecs = 0 endseen = .false. datapos = 0 sectnum = 1 onesp = 0 numprots = 0 firstprot = NIL lastprot = 1 # used in mkprot so that the first proto goes in slot 1 # of the proto queue # set up doubly-linked equivalence classes ecgroup(MIN_SYMBOL) = NIL for ( i=MIN_SYMBOL+1; i <= MAX_SYMBOL; i=i+1 ) { ecgroup(i) = i - 1 nextecm(i-1) = i } nextecm(MAX_SYMBOL) = NIL return end ### lgetc - read a character from the input file(s) # # synopsis # character ch, lgetc # ch = lgetc( ch ) # character function lgetc( ch ) NOIMPLICIT character ch character getch logical stkempty, queempty integer stkpop, quefremove, ich LEX_IO if ( stkempty( pbstack ) ) { # Nothing on the push-back stack - read in a new character. repeat { ch = getch( ch, infile ) if ( ch != EOF | queempty( fileq ) ) break infile = quefremove( fileq ) filenum = filenum + 1 linenum = 1 } } else { # The push-back has something on it - pop it and return it. ich = stkpop( pbstack ) ch = ich } if ( ch == '@n' ) linenum = linenum + 1 lgetc = ch return end ### link - connect two machines together # # synopsis # # new = link( first, last ) # # new - a machine constructed by connecting first to last # first - the machine whose successor is to be `last' # last - the machine whose predecessor is to be `first' # # note: this routine concatenates the machine `first' with the machine # `last' to produce a machine `new' which will pattern-match first `first' # and then `last', and will fail if either of the sub-patterns fails. # FIRST is set to `new' by the operation. `last' is unmolested. # integer function link( first, last ) NOIMPLICIT integer first, last LEX_NFA if ( first == NIL ) return ( last ) else if ( last == NIL ) return ( first ) else { call mkxtion( finalst(first), last ) finalst(first) = finalst(last) lastst(first) = max( lastst(first), lastst(last) ) firstst(first) = min( firstst(first), firstst(last) ) return ( first ) } end ### mkcclmap - create map entry connecting ccl index with set pointer # # synopsis # integer cclp, cclsetptr # call mkcclmap( cclsetptr, cclp ) subroutine mkcclmap( cclsetptr, cclp ) NOIMPLICIT integer cclsetptr, cclp LEX_CCL lastccl = lastccl - 1 # ccl numbers DECREASE; essentially, any transition # number that is non-negative is a character, # whereas any negative transition number is a # ccl index if ( (-lastccl) > MAXCCLS ) call error( "mkcclmap: Too many character classes" ) cclmap(-lastccl) = cclsetptr cclp = lastccl return end ### mkclos - convert a machine into a closure # # synopsis # new = mkclos( state ) # # new - a new state which matches the closure of 'state' # integer function mkclos( state ) NOIMPLICIT integer state integer mkopt, mkposcl return ( mkopt( mkposcl( state ) ) ) end ### mkdata - generate a data statement # # synopsis # character name # integer arrayelm, value # call mkdata( name, arrayelm, value ) # # generates a data statement initializing "name(arrayelm)" to "value" # Note that name is only a character; NOT a string # subroutine mkdata( name, arrayelm, value ) NOIMPLICIT character name integer arrayelm, value integer numdigs, datalen LEX_IO string dindent DATAINDENTSTR # figure out length of data statement to be written. 6 is the constant # overhead of a one character name, '(' and ')' to delimit the array # reference, a '/' and a '/' to delimit the value, and room for a # blank or a comma between this data statement and the previous one datalen = 6 + numdigs( arrayelm ) + numdigs( value ) if ( datalen + datapos >= DATALINEWIDTH | datapos == 0 ) { if ( datapos != 0 ) call dataflush # precede data statement with '%' so rat4 preprocessor doesn't have # to bother looking at it call printf( "%%%sDATA ", dindent ) # 4 is the constant overhead of writing out the word 'DATA' datapos = DATAINDENTWIDTH + 4 + datalen } else { call printf( "," ) datapos = datapos + datalen } call printf( "%c(%d)/%d/", name, arrayelm, value ) return end ### mkdeftbl - make the default, 'jam' table entries # # synopsis # call mkdeftbl # subroutine mkdeftbl NOIMPLICIT LEX_ECS LEX_DFA LEX_PROT integer i for ( i=1; i <= numecs; i=i+1 ) { nxt(tblend + i) = 0 chk(tblend + i) = DEFBASE } jambase = tblend base(DEFBASE) = jambase def(DEFBASE) = -1 # should generate a run-time array bounds check if # ever used as a default tblend = tblend + numecs numtemps = numtemps + 1 return end ### mkeccl - update equivalence classes based on character class xtions # # synopsis # integer ccls, fwd(MAX_REAL_SYMBOL), bck(MAX_REAL_SYMBOL) # call mkeccl( ccls, fwd, bck ) # # where ccls is a bit-string pointer containing elements of the character # class, fwd is the forward link-list of equivalent characters, and # bck is the backward link-list # subroutine mkeccl( ccls, fwd, bck ) NOIMPLICIT integer ccls, fwd(ARB), bck(ARB) integer bsloopinit, cclp, getcclset, oldec, newec integer cclm, i, ccopy, firstcclm logical bsnext, bsbtnc, ecclinit data ecclinit /.true./ if ( ecclinit ) { call bsinit( ccopy, MAX_REAL_SYMBOL ) ecclinit = .false. } call bscopy( ccls, ccopy ) cclp = bsloopinit( ccopy ) if ( bsnext( cclp, firstcclm ) ) { cclm = firstcclm repeat # for all characters in ccl { oldec = bck(cclm) newec = cclm for ( i=fwd(cclm); i != NIL & i <= MAX_REAL_SYMBOL; i=fwd(i) ) if ( bsbtnc( ccopy, i ) ) { # link into new equivalence class bck(i) = newec fwd(newec) = i newec = i } else { # link to old equivalence class bck(i) = oldec if ( oldec != NIL ) fwd(oldec) = i oldec = i } if ( bck(cclm) != NIL | oldec != bck(cclm) ) { bck(cclm) = NIL fwd(oldec) = NIL } fwd(newec) = NIL } until (! bsnext( cclp, cclm )) call bsendloop( cclp ) } return end ### mkechar - create equivalence class for single character # # synopsis # integer tch, fwd(MAX_SYMBOL), bck(MAX_SYMBOL) # call mkechar( tch, fwd, bck ) # subroutine mkechar( tch, fwd, bck ) NOIMPLICIT integer tch, fwd(ARB), bck(ARB) # if until now the character has been a proper subset of # an equivalence class, break it away to create a new ec if ( fwd(tch) != NIL ) bck(fwd(tch)) = bck(tch) if ( bck(tch) != NIL ) fwd(bck(tch)) = fwd(tch) fwd(tch) = NIL bck(tch) = NIL return end ### mkentry - create base/def and nxt/chk entries for transition array # # synopsis # integer state(MAX_SYMBOL), statenum, deflink, totaltrans # call mkentry( state, statenum, deflink, totaltrans ) # # 'state' is the transition array, 'statenum' is the offset to be used into # the base/def tables, and 'deflink' is the entry to put in the 'def' table # entry. If 'deflink' is equal to 'DEFBASE', then no attempt will be made # to fit zero entries of 'state' (i.e. jam entries) into the table. It is # assumed that by linking to 'DEFBASE' they will be taken care of. In any # case, entries in 'state' marking transitions to 'SAME_TRANS' are treated # as though they will be taken care of by whereever 'deflink' points. # 'totaltrans' is the total number of transitions out of the state. If it # is below a certain threshold, the tables are searched for an interior # spot that will accomodate the state array. # subroutine mkentry( state, statenum, deflink, totaltrans ) NOIMPLICIT integer state(ARB), statenum, deflink, totaltrans LEX_ECS LEX_DFA integer minec, maxec, i, tblbase, baseaddr, tbllast if ( totaltrans == 0 ) { # there are no out-transitions if ( deflink == DEFBASE ) base(statenum) = JAM else base(statenum) = 0 def(statenum) = deflink return } for ( minec=1; minec <= numecs; minec = minec + 1 ) { if ( state(minec) != SAME_TRANS ) if ( state(minec) != 0 | deflink != DEFBASE ) break } if ( totaltrans == 1 ) { # there's only one out-transition. Save it for later to fill # in holes in the tables. call stack1( statenum, minec, state(minec), deflink ) return } for ( maxec=numecs; maxec > 0; maxec=maxec-1 ) { if ( state(maxec) != SAME_TRANS ) if ( state(maxec) != 0 | deflink != DEFBASE ) break } # Whether we try to fit the state table in the middle of the table # entries we have already generated, or if we just take the state # table at the end of the nxt/chk tables, we must make sure that we # have a valid base address (i.e. non-negative). Note that not only are # negative base addresses dangerous at run-time (because indexing the # next array with one and a low-valued character might generate an # array-out-of-bounds error message), but at compile-time negative # base addresses denote TEMPLATES. # find the first transition of state that we need to worry about. if ( totaltrans * 100 <= numecs * INTERIOR_FIT_PERCENTAGE ) { # attempt to squeeze it into the middle of the tabls baseaddr = firstfree while ( baseaddr < minec ) { # using baseaddr would result in a negative base address below # find the next free slot for ( baseaddr=baseaddr+1; chk(baseaddr) != 0; baseaddr=baseaddr+1 ) ; } for ( i=minec; i <= maxec; i=i+1 ) if ( state(i) != SAME_TRANS ) if ( state(i) != 0 | deflink != DEFBASE ) if ( chk(baseaddr + i - minec) != 0 ) { for ( baseaddr=baseaddr+1; chk(baseaddr) != 0; baseaddr=baseaddr+1 ) ; # reset the loop counter so we'll start all # over again next time it's incremented i = minec - 1 } } else { # ensure that the base address we eventually generate is non-negative baseaddr = max( tblend + 1, minec ) } tblbase = baseaddr - minec tbllast = tblbase + maxec base(statenum) = tblbase def(statenum) = deflink for ( i=minec; i <= maxec; i=i+1 ) if ( state(i) != SAME_TRANS ) if ( state(i) != 0 | deflink != DEFBASE ) { nxt(tblbase + i) = state(i) chk(tblbase + i) = statenum } if ( baseaddr == firstfree ) # find next free slot in tables for ( firstfree=firstfree+1; chk(firstfree) != 0; firstfree=firstfree+1 ) ; tblend = max( tblend, tbllast ) return end ### mk1tbl - create table entries for a state (or state fragment) which # has only one out-transition # # synopsis # integer state, sym, onenxt, onedef # call mk1tbl( state, sym, onenxt, onedef ) # subroutine mk1tbl( state, sym, onenxt, onedef ) NOIMPLICIT integer state, sym, onenxt, onedef LEX_DFA while ( chk(firstfree) != 0 | firstfree < sym ) firstfree = firstfree + 1 base(state) = firstfree - sym def(state) = onedef chk(firstfree) = state nxt(firstfree) = onenxt if ( firstfree > tblend ) { tblend = firstfree firstfree = firstfree + 1 } return end ### mkopt - make a machine optional # # synopsis # # new = mkopt( mach ) # # new - a machine which optionally matches whatever `mach' matched # mach - the machine to make optional # # notes: # 1. mach must be the last machine created # 2. mach is destroyed by the call # integer function mkopt( mach ) NOIMPLICIT integer mach LEX_NFA integer eps, mkstate, link if ( transchar(finalst(mach)) != SYM_EPSILON ) { eps = mkstate( SYM_EPSILON ) mach = link( mach, eps ) } if ( ! FREE_EPSILON( mach ) ) { eps = mkstate( SYM_EPSILON ) mach = link( eps, mach ) } call mkxtion( mach, finalst(mach) ) return ( mach ) end ### mkor - make a machine that matches either one of two machines # # synopsis # # new = mkor( first, second ) # # new - a machine which matches either `first's pattern or `second's # first, second - machines whose patterns are to be `or'ed (the | operator) # # note that first and second are both destroyed by the operation # the code is rather convoluted because an attempt is made to minimize # the number of epsilon states needed # integer function mkor( first, second ) NOIMPLICIT integer first, second LEX_NFA integer mkstate, link, orbeg, eps, orend if ( first == NIL ) return ( second ) else if ( second == NIL ) return ( first ) else { if ( FREE_EPSILON( first ) ) { orbeg = first call mkxtion( orbeg, second ) } else if ( FREE_EPSILON( second ) ) { orbeg = second call mkxtion( orbeg, first ) } else { eps = mkstate( SYM_EPSILON ) first = link( eps, first ) orbeg = first call mkxtion( orbeg, second ) } if ( transchar( finalst(first) ) == SYM_EPSILON & accptnum( finalst(first) ) == NIL ) { orend = finalst(first) call mkxtion( finalst(second), orend ) } else if ( transchar( finalst(second) ) == SYM_EPSILON & accptnum( finalst(second) ) == NIL ) { orend = finalst(second) call mkxtion( finalst(first), orend ) } else { eps = mkstate( SYM_EPSILON ) first = link( first, eps ) orend = finalst(first) call mkxtion( finalst(second), orend ) } } finalst(orbeg) = orend return ( orbeg ) end ### mkposcl - convert a machine into a positive closure # # synopsis # new = mkposcl( state ) # # new - a machine matching the positive closure of 'state' # integer function mkposcl( state ) NOIMPLICIT integer state LEX_NFA integer mkstate, link, eps if ( SUPER_FREE_EPSILON( finalst(state) ) ) { call mkxtion( finalst(state), state ) mkposcl = state } else { eps = mkstate( SYM_EPSILON ) call mkxtion( eps, state ) mkposcl = link( state, eps ) } return end ### mkprot - create new proto entry # # synopsis # integer state(MAX_SYMBOL), statenum, comstate # call mkprot( state, statenum, comstate ) # subroutine mkprot( state, statenum, comstate ) NOIMPLICIT integer state(ARB), statenum, comstate LEX_PROT LEX_ECS integer i, slot, tblbase numprots = numprots + 1 if ( numprots > MSP | numecs * numprots > PROT_SAVE_SIZE ) { # gotta make room for the new proto by dropping last entry in # the queue slot = lastprot lastprot = protprev(lastprot) protnext(lastprot) = NIL } else slot = numprots protnext(slot) = firstprot if ( firstprot != NIL ) protprev(firstprot) = slot firstprot = slot prottbl(slot) = statenum protcomst(slot) = comstate # copy state into save area so it can be compared with rapidly tblbase = numecs * (slot - 1) for ( i=1; i <= numecs; i=i+1 ) protsave(tblbase+i) = state(i) return end ### mkrep - make a replicated machine # # synopsis # new = mkrep( mach, lb, ub ) # # new - a machine that matches whatever 'mach' matched from 'lb' # number of times to 'ub' number of times # # note # if 'ub' is INFINITY then 'new' matches 'lb' or more occurances of 'mach' # integer function mkrep( mach, lb, ub ) NOIMPLICIT integer mach, lb, ub integer base, copysingl, dupmachine, link, mkclos, tail, mkstate, mkopt integer copy, i base = copysingl( mach, lb-1 ) if ( ub == INFINITY ) { copy = dupmachine( mach ) mach = link( mach, link( base, mkclos( copy ) ) ) } else { tail = mkstate( SYM_EPSILON ) for ( i=lb; i < ub; i=i+1 ) { copy = dupmachine( mach ) tail = mkopt( link( copy, tail ) ) } mach = link( mach, link( base, tail ) ) } return ( mach ) end ### mkstate - create a state with a transition on a given symbol # # synopsis # # state = mkstate( sym ) # # state - a new state matching `sym' # sym - the symbol the new state is to have an out-transition on # # note that this routine makes new states in ascending order through the # state array (and increments LASTNFA accordingly). The routine DUPMACHINE # relies on machines being made in ascending order and that they are # CONTIGUOUS. Change it and you will have to rewrite DUPMACHINE (kludge # that it admittedly is) # integer function mkstate( sym ) NOIMPLICIT integer sym, getcclset LEX_NFA LEX_ECS lastnfa = lastnfa + 1 if (lastnfa > MNS) call error( "mkstate: machine too large" ) transchar(lastnfa) = sym trans1(lastnfa) = NO_TRANSITION trans2(lastnfa) = NO_TRANSITION accptnum(lastnfa) = NIL firstst(lastnfa) = lastnfa finalst(lastnfa) = lastnfa lastst(lastnfa) = lastnfa # fix up equivalence classes base on this transition. Note that any # character which has its own transition gets its own equivalence class. # Thus only characters which are only in character classes have a chance # at being in the same equivalence class. E.g. "a|b" puts 'a' and 'b' # into two different equivalence classes. "[ab]" puts them in the same # equivalence class (barring other differences elsewhere in the input. if ( sym < 0 ) call mkeccl( getcclset( sym ), nextecm, ecgroup ) else if ( sym != SYM_EPSILON ) call mkechar( sym, nextecm, ecgroup ) return ( lastnfa ) end ### mktemp - create a template entry based on a state, and connect the state # to it # # synopsis # integer state(MAX_SYMBOL), statenum, comstate, totaltrans # call mktemp( state, statenum, comstate, totaltrans ) # subroutine mktemp( state, statenum, comstate ) NOIMPLICIT integer state(ARB), statenum, comstate LEX_PROT LEX_ECS LEX_DFA integer i, tbldiff, numdiff, tmpbase, transset, tmp(MAX_SYMBOL) logical mktinit data mktinit /.true./ if ( mktinit ) { # we make the bitstring MAX_REAL_SYMBOL in size instead of # numecs because mkeccl is going to copy the bitstring into # another of MAX_REAL_SYMBOL size, and the bitstring library # gets upset if the destination of a copy is not the same size # as the source call bsinit( transset, MAX_REAL_SYMBOL ) mktinit = .false. } lasttemp = lasttemp - 1 numtemps = numtemps + 1 call bszero( transset ) # calculate where we will temporarily store the transition table # of the template in the NXT() array. The final transition table # gets created by cmptmps() tmpbase = MAX_XPAIRS - numtemps * numecs # store at end of table base(lasttemp) = tmpbase for ( i=1; i <= numecs; i=i+1 ) if ( state(i) == 0 ) nxt(tmpbase+i) = 0 else { call bsbset( transset, i ) nxt(tmpbase+i) = comstate } call mkeccl( transset, tecfwd, tecbck ) call mkprot( nxt(tmpbase+1), lasttemp, comstate ) # we rely on the fact that mkprot adds things to the beginning # of the proto queue numdiff = tbldiff( state, firstprot, tmp ) call mkentry( tmp, statenum, lasttemp, numdiff ) return end ### mkxtion - make a transition from one state to another # # synopsis # # call mkxtion( statefrom, stateto ) # # statefrom - the state from which the transition is to be made # stateto - the state to which the transition is to be made # subroutine mkxtion( statefrom, stateto ) NOIMPLICIT integer statefrom, stateto LEX_NFA if ( trans1(statefrom) == NO_TRANSITION ) trans1(statefrom) = stateto else { if ( (transchar(statefrom) != SYM_EPSILON) | (trans2(statefrom) != NO_TRANSITION) ) call error( "mkxtion: too many transitions" ) else trans2(statefrom) = stateto } return end ### mv2front - move proto queue element to front of queue # # synopsis # integer qelm # call mv2front( qelm ) # subroutine mv2front( qelm ) NOIMPLICIT integer qelm LEX_PROT if ( firstprot != qelm ) { if ( qelm == lastprot ) lastprot = protprev(lastprot) protnext(protprev(qelm)) = protnext(qelm) if ( protnext(qelm) != NIL ) protprev(protnext(qelm)) = protprev(qelm) protprev(qelm) = NIL protnext(qelm) = firstprot protprev(firstprot) = qelm firstprot = qelm } return end ### ndinstal - install a name definition # # synopsis # character nd(...), def(...) # call ndinstal( nd, def ) # subroutine ndinstal( nd, def ) NOIMPLICIT character nd(ARB), def(ARB), nd2(MAXLINE) integer lookup string ndpre "n" if ( lookup( nd, nd2 ) == YES ) call synerr( "name defined twice" ) else { call concat( ndpre, nd, nd2 ) call instal( nd2, def ) } return end ### ndlookup - lookup a name definition # # synopsis # character nd(...), def(...) # integer ndlookup # YESfound/NOnotfound = ndlookup( nd, def ) # integer function ndlookup( nd, def ) NOIMPLICIT character nd(ARB), def(ARB), nd2(MAXLINE) integer lookup string ndpre "n" call concat( ndpre, nd, nd2 ) ndlookup = lookup( nd2, def ) return end ### ntod - convert an ndfa to a dfa # # synopsis # integer state1 # call ntod( state1 ) # # state1 is the initial state of the ndfa to be converted # upon return, state1 is the initial state of the constructed dfa # subroutine ntod( state1 ) NOIMPLICIT integer state1 integer todo, nset, accset, ecloset, symlist, ds, sl, nacc, newds integer quefremove, bsloopinit, duplist(MAX_SYMBOL), sym, hashval integer targfreq(MAX_SYMBOL), targstate(MAX_SYMBOL), state(MAX_SYMBOL) integer targptr, numuniq, totaltrans, i, comstate, comfreq, targ, lastsym logical bsnext, queempty, new, bsbtst LEX_DFA LEX_NFA LEX_ECS LEX_1STACK data duplist /MAX_SYMBOL*NIL/ ifdef (DUMPFA) call remark( "ntod: dumping n" ) call dumpnfa( state1 ) enddef call queinit( todo ) # dfa states still to be processed call bsinit( nset, lastnfa ) # pre E-closed nfa state set # corresponding to dfa call bsinit( ecloset, lastnfa ) # post E-closed nfa state set call bsinit( accset, accnum ) # accepting numbers of DFA call bsinit( symlist, MAX_REAL_SYMBOL ) # symbols with 'out' xtions from DFA call inittbl # create the first state call bsbset( nset, state1 ) call epsclosure( nset, ecloset, accset, nacc, hashval ) call snstods( ecloset, accset, hashval, state1, new ) if ( nacc > 0 ) numas = numas + nacc + 1 call quefinsert( todo, state1 ) while ( ! queempty( todo ) ) { targptr = 0 numuniq = 0 totaltrans = 0 for ( i=1; i <= numecs; i=i+1 ) state(i) = 0 ds = quefremove( todo ) call sympartition( ds, symlist, duplist ) for ( sl=bsloopinit( symlist ); bsnext( sl, sym ); ) { if ( duplist(sym) == NIL ) { # symbol has unique out-transitions call symfollowset( ds, sym, nset ) call epsclosure( nset, ecloset, accset, nacc, hashval ) call snstods( ecloset, accset, hashval, newds, new ) state(sym) = newds if ( new ) { call quebinsert( todo, newds ) if ( nacc > 0 ) numas = numas + nacc + 1 } targptr = targptr + 1 targfreq(targptr) = 1 targstate(targptr) = newds lastsym = sym numuniq = numuniq + 1 } else { # sym's equivalence class has the same transitions # as duplist(sym)'s equivalence class targ = state(duplist(sym)) state(sym) = targ i = 0 # update frequency count for destination state repeat i = i + 1 until (targstate(i) == targ) targfreq(i) = targfreq(i) + 1 } totaltrans = totaltrans + 1 duplist(sym) = NIL } call bsendloop( sl ) numsnpairs = numsnpairs + totaltrans # determine which destination state is the most common, and # how many transitions to it there are comfreq = 0 comstate = 0 for ( i=1; i <= targptr; i=i+1 ) if ( targfreq(i) > comfreq ) { comfreq = targfreq(i) comstate = targstate(i) } call bldtbl( state, ds, totaltrans, comstate, comfreq ) } call cmptmps # create compressed template entries # create tables for all the states with only one out-transition while ( onesp > 0 ) { call mk1tbl( onestate(onesp), onesym(onesp), onenext(onesp), onedef(onesp) ) onesp = onesp - 1 } call mkdeftbl call quedestroy( todo ) call bsdestroy( nset ) call bsdestroy( accset ) call bsdestroy( ecloset ) call bsdestroy( symlist ) return end ### numdigs - number of digits in number # # synopsis # integer numdigs, x # num = numdigs( x ) # # NOTE # only works for non-negative numbers less than 1,000,000 # integer function numdigs( x ) NOIMPLICIT integer x if ( x < 10 ) return 1 else if ( x < 100 ) return 2 else if ( x < 1000 ) return 3 else if ( x < 10000 ) return 4 else if ( x < 100000 ) return 5 else return 6 end ### pbstr - push a string back # # synopsis # character str(...) # call pbstr( str ) # subroutine pbstr( str ) NOIMPLICIT character str(ARB) integer i, length for ( i=length( str ); i > 0; i=i-1 ) call ungetc( str(i) ) return end ### peek - take a peek at the next character in the input stream # # synopsis # character ch, peek # ch = peek( ch ) # character function peek( ch ) NOIMPLICIT character ch character lgetc ch = lgetc( ch ) call ungetc( ch ) peek = ch return end ### readin - read in the rules section of the input file(s) # # synopsis # call readin( state1 ) # subroutine readin( state1 ) NOIMPLICIT integer state1 LEX_MISC LEX_NFA LEX_ECS LEX_FLAGS integer yyparse, sts, link, mkopt, mkor, cre8ecs, i, j call skelout if ( ddebug ) call putlin( "define(LXDDEBUG,)@n", STDOUT ) if ( yyparse( sts ) == ERR ) call error( "readin: fatal error occured while parsing rules" ) # until now, optsc hasn't really been optional. optsc = mkopt( optsc ) free = link( optsc, free ) state1 = mkor( bound, free ) numecs = cre8ecs( nextecm, ecgroup, lastsc ) call ccl2ecl return end ### scinstal - make a start condition # # synopsis # character str(...) # call scinstal( str ) # subroutine scinstal( str ) NOIMPLICIT character str(ARB), str2(MAXLINE), numstr(10) integer num, sclookup, itoc, mkstate, mkor, sc string scpre "s" LEX_MISC LEX_NFA if ( sclookup( str, num ) == YES ) call synerr( "start condition declared twice" ) else { lastsc = lastsc + 1 if ( lastsc > MAXSC ) call error( "scinstal: too many start conditions" ) call printf( "define(YYLEX_SC_%s,%d)@n", str, lastsc ) call concat( scpre, str, str2 ) call itoc( lastsc, numstr, 10 ) call instal( str2, numstr ) sc = mkstate( lastsc ) optsc = mkor( optsc, sc ) } return end ### sclookup - lookup the number associated with a start condition # # synopsis # character str(...), scnum # integer sclookup # YESfound/NOnotfound = sclookup( str, scnum ) # integer function sclookup( str, scnum ) NOIMPLICIT character str(ARB), numstr(10), str2(MAXLINE) integer scnum, i, ctoi, lookup string scpre "s" call concat( scpre, str, str2 ) sclookup = lookup( str2, numstr ) if ( sclookup == YES ) { i = 1 scnum = ctoi( numstr, i ) } return end ### skelout - write out one section of the lexskel file # # synopsis # call skelout # # DESCRIPTION # Copies from skelfile to STDOUT until a line beginning with "~~" or # EOF is found. # subroutine skelout NOIMPLICIT character buf(MAXLINE) integer getlin LEX_FLAGS LEX_IO while ( getlin ( buf, skelfile ) != EOF ) if ( buf(1) == '~' & buf(2) == '~' ) break else call putlin ( buf, STDOUT ) return end ### snstods - converts a set of ndfa states into a dfa state # # synopsis # integer sns, newds, accset, hashval # logical new # call snstods( sns, accset, hashval, newds, new ) # subroutine snstods( sns, accset, hashval, newds, new ) NOIMPLICIT integer sns, accset, hashval, newds logical new logical bsareq integer i, snsbs(MAX_BS_SIZE), dssbs(MAX_BS_SIZE) integer numsints, numdints LEX_DFA LEX_NFA call bsgetbs( sns, snsbs, numsints ) for ( i=1; i <= lastdfa; i=i+1 ) if ( hashval == dhash(i) ) { call bsgetbs( dss(i), dssbs, numdints ) if ( bsareq( snsbs, dssbs, numsints ) ) { new = .false. newds = i return } } # make a new dfa lastdfa = lastdfa + 1 if ( lastdfa > MAX_DFAS ) call error( "snstods: DFA too large" ) newds = lastdfa dss(newds) = sns das(newds) = accset dhash(newds) = hashval new = .true. call bsinit( sns, lastnfa ) call bsinit( accset, accnum ) return end ### stack1 - save states with only one out-transition to be processed later # # synopsis # integer statenum, sym, nextstate, deflink # call stack1( statenum, sym, nextstate, deflink ) # # if there's room for another state one the 'one-transition' stack, the # state is pushed onto it, to be processed later by mk1tbl. If there's # no room, we process the sucker right now. # subroutine stack1( statenum, sym, nextstate, deflink ) NOIMPLICIT integer statenum, sym, nextstate, deflink LEX_1STACK LEX_DFA if ( onesp >= ONE_STACK_SIZE ) call mk1tbl( statenum, sym, nextstate, deflink ) else { onesp = onesp + 1 onestate(onesp) = statenum onesym(onesp) = sym onenext(onesp) = nextstate onedef(onesp) = deflink } return end ### symfollowset - follow the symbol transitions one step # # synopsis # integer ds, transsym, nset # call symfollowset( ds, transsym, nset ) # subroutine symfollowset( ds, transsym, nset ) NOIMPLICIT integer ds, transsym, nset integer slp, ns, tsp, sym integer bsloopinit, getcclset, ccllist logical bsnext, bsbtst LEX_NFA LEX_DFA LEX_ECS call bszero( nset ) for ( slp=bsloopinit(dss(ds)); bsnext(slp,ns); ) { # for each ndfa state ns in the state set of ds sym = transchar(ns) tsp = trans1(ns) if ( sym < MIN_SYMBOL & transsym <= MAX_REAL_SYMBOL ) { ccllist = getcclset( sym ) if ( bsbtst( ccllist, transsym ) ) call bsbset( nset, tsp ) } else if ( ecgroup(sym) == transsym ) call bsbset( nset, tsp ) } call bsendloop( slp ) return end ### sympartition - partition characters with same out-transitions # # synopsis # integer ds, symlist, duplist(MAX_SYMBOL) # call bsinit( symlist, MAX_SYMBOL ) # call sympartition( ds, symlist, duplist ) # subroutine sympartition( ds, symlist, duplist ) NOIMPLICIT integer ds, symlist, duplist(MAX_SYMBOL) integer nss, bsloopinit, tch, ccls, cclp, getcclset, oldec, newec, duptbls integer cclm, i, ccopy, firstcclm, ns, dupfwd(MAX_SYMBOL) logical bsnext, bsbtnc LEX_NFA LEX_DFA LEX_ECS LEX_CCL # partitioning is done by creating equivalence classes for those # characters which have out-transitions from the given state. Thus # we are really creating equivalence classes of equivalence classes. for ( i=MIN_SYMBOL; i <= MAX_SYMBOL; i=i+1 ) { # initialize equivalence class list duplist(i) = i - 1 dupfwd(i) = i + 1 } duplist(MIN_SYMBOL) = NIL dupfwd(MAX_SYMBOL) = NIL call bszero( symlist ) for ( nss=bsloopinit( dss(ds) ); bsnext( nss, ns ); ) { tch = transchar(ns) if ( tch != SYM_EPSILON ) { if ( tch < lastccl | tch > MAX_SYMBOL | tch == LASTCCLINIT ) call error( "sympartition: bad transition character detected" ) if ( tch >= MIN_SYMBOL ) { # character transition call mkechar( ecgroup(tch), dupfwd, duplist ) call bsbset( symlist, ecgroup(tch) ) } else { # character class call mkeccl( getcclset( tch ), dupfwd, duplist ) call bsor( symlist, getcclset( tch ), symlist ) } } } call bsendloop( nss ) return end ### synerr - report a syntax error # # synopsis # character str(ARB) # call synerr( str ) # subroutine synerr( str ) NOIMPLICIT character str LEX_FLAGS LEX_IO syntaxerror = .true. call fprintf( ERROUT, "Syntax error at line %d", linenum ) if ( filenum != 0 ) call fprintf( ERROUT, " of file %d", filenum ) call fprintf( ERROUT, ": %s@n", str ) return end ### tbldiff - compute differences between two state tables # # synopsis # integer state(MAX_SYMBOL), pr, ext(MAX_SYMBOL) # integer tbldiff, numdifferences # numdifferences = tbldiff( state, pr, ext ) # # 'state' is the state array which is to be extracted from the 'pr'th # proto. 'pr' is both the number of the proto we are extracting from # and an index into the save area where we can find the proto's complete # state table. Each entry in 'state' which differs from the corresponding # entry of 'pr' will appear in 'ext'. # Entries which are the same in both 'state' and 'pr' will be marked # as transitions to 'SAME_TRANS' in 'ext'. The total number of differences # between 'state' and 'pr' is returned as function value. Note that this # number is 'numecs' minus the number of 'SAME_TRANS' entries in 'ext'. # integer function tbldiff( state, pr, ext ) NOIMPLICIT integer state(ARB), pr, ext(ARB) LEX_ECS LEX_PROT integer i, numdiff, tblbase numdiff = 0 tblbase = numecs * (pr - 1) for ( i=1; i <= numecs; i=i+1 ) if ( protsave(tblbase + i) == state(i) ) ext(i) = SAME_TRANS else { ext(i) = state(i) numdiff = numdiff + 1 } return numdiff end ### ungetc - push a character back onto the input stream # # synopsis # character ch # call ungetc( ch ) # subroutine ungetc( ch ) NOIMPLICIT character ch LEX_IO integer ich ich = ch if ( ch == '@n' ) linenum = linenum - 1 call stkpush( pbstack, ich ) return end ### yylex - scan for a regular expression token # # synopsis # # token = yylex( value ) # # token - return token found # value - return value of token; the actual character read # integer function yylex( value ) NOIMPLICIT integer value integer ndlookup, idx logical getuntil character type, lgetc, peek, str1(MAXLINE), str2(MAXLINE), escseq LEX_IO LEX_MISC LEX_FLAGS repeat # to process nested macro definitions { lastch = lgetc( lastch ) value = lastch switch ( lastch ) { case EOF: call ungetc( lastch ) if ( ! endseen ) # insert section-end token into input stream call pbstr( "~~@n" ) else return ENDSYM case '{': if ( type( peek( lastch ) ) == DIG | sectnum == 1 ) return '{' idx = 1 if ( ! getuntil ( '}', str1, idx, MAXLINE ) ) call synerr( "missing } in macro expansion" ) else { lastch = lgetc( lastch ) # eat the closing brace if ( ndlookup( str1, str2 ) != YES ) call synerr( "undefined macro" ) else { # push back def. in parenthesis call ungetc( ')' ) call pbstr( str2 ) call ungetc( '(' ) } } case '0', '1', '2', '3', '4', '5', '6', '7', '8', '9': return DIG case '~': if ( sectnum == 1 ) { lastch = lgetc( lastch ) switch( lastch ) { case '~': return SECTEND case 's','S': return SCDECL case '{': return CODESEQBEG case '}': return CODESEQEND default: call ungetc( lastch ) lastch = '~' return CHAR } } else if (peek( lastch ) == '~') { if ( ! endseen ) { # push back default action call pbstr( " return( EOF )@n~" ) call ungetc( EOF_PUSH_BACK_SYM ) call pbstr( "@n[@^a-@0177] ECHO@n" ) endseen = .true. } else { call eatline return ENDSYM } } else return CHAR case EOF_PUSH_BACK_SYM: value = SYM_EOF return CHAR case '@@': if ( sectnum != 1 ) { lastch = escseq( lgetc( lastch ) ) value = lastch } return CHAR case '/', '|', '<', '>', ',', '$', '*', '+', '%', '\', '}', '?', '[', ']', '"', '(', ')', '-', '!', '#', ' ', '@t', '@n': return lastch default: return CHAR } } # should never get this far call error( "yylex: error in ratfor compiler" ) return end block data integer yyerrok, yylexval, yymaxstack, yystkp integer yysta, yytok, yyval, yyerct common /yymicm/ yyval, yytok, yyerrok, yysta, yystkp, yymaxstack, yylexval, yyerct data yystkp, yymaxstack /1, 25/ data yyerrok, yyval, yytok, yysta /NO, 0, YYENDTOK, 1/ end % block data % integer tran, ftrn, ent, fred, nset, dbg % integer prod, lhs, len, lset, finalstate, ls % common /yyfrcm/ fred( 168) % common /yynscm/ nset( 134) % common /yyltcm/ lset( 28) % common /yyprcm/ prod( 134) % common /yylncm/ len( 123) % common /yylhcm/ lhs( 123) % common /yyftcm/ ftrn( 168) % common /yytrcm/ finalstate, tran( 647) % common /yyencm/ dbg, ent( 168) % common /yylscm/ ls( 391) % data finalstate, dbg/ 5, 0/ % data tran(1 )/2 /,tran(2 )/3 /,tran(3 )/4 / % data tran(4 )/5 /,tran(5 )/6 /,tran(6 )/7 / % data tran(7 )/8 /,tran(8 )/9 /,tran(9 )/10 / % data tran(10 )/11 /,tran(11 )/12 /,tran(12 )/13 / % data tran(13 )/14 /,tran(14 )/15 /,tran(15 )/16 / % data tran(16 )/17 /,tran(17 )/18 /,tran(18 )/19 / % data tran(19 )/8 /,tran(20 )/13 /,tran(21 )/20 / % data tran(22 )/21 /,tran(23 )/22 /,tran(24 )/23 / % data tran(25 )/24 /,tran(26 )/25 /,tran(27 )/26 / % data tran(28 )/27 /,tran(29 )/28 /,tran(30 )/29 / % data tran(31 )/30 /,tran(32 )/31 /,tran(33 )/32 / % data tran(34 )/33 /,tran(35 )/34 /,tran(36 )/35 / % data tran(37 )/36 /,tran(38 )/37 /,tran(39 )/38 / % data tran(40 )/39 /,tran(41 )/40 /,tran(42 )/41 / % data tran(43 )/42 /,tran(44 )/43 /,tran(45 )/44 / % data tran(46 )/45 /,tran(47 )/46 /,tran(48 )/47 / % data tran(49 )/48 /,tran(50 )/49 /,tran(51 )/50 / % data tran(52 )/51 /,tran(53 )/52 /,tran(54 )/8 / % data tran(55 )/13 /,tran(56 )/53 /,tran(57 )/8 / % data tran(58 )/54 /,tran(59 )/55 /,tran(60 )/13 / % data tran(61 )/56 /,tran(62 )/57 /,tran(63 )/6 / % data tran(64 )/7 /,tran(65 )/8 /,tran(66 )/9 / % data tran(67 )/10 /,tran(68 )/11 /,tran(69 )/12 / % data tran(70 )/13 /,tran(71 )/15 /,tran(72 )/58 / % data tran(73 )/59 /,tran(74 )/19 /,tran(75 )/60 / % data tran(76 )/61 /,tran(77 )/22 /,tran(78 )/23 / % data tran(79 )/25 /,tran(80 )/26 /,tran(81 )/27 / % data tran(82 )/28 /,tran(83 )/29 /,tran(84 )/30 / % data tran(85 )/31 /,tran(86 )/32 /,tran(87 )/33 / % data tran(88 )/34 /,tran(89 )/35 /,tran(90 )/36 / % data tran(91 )/37 /,tran(92 )/62 /,tran(93 )/63 / % data tran(94 )/41 /,tran(95 )/42 /,tran(96 )/43 / % data tran(97 )/44 /,tran(98 )/45 /,tran(99 )/46 / % data tran(100 )/64 /,tran(101 )/49 /,tran(102 )/65 / % data tran(103 )/66 /,tran(104 )/67 /,tran(105 )/22 / % data tran(106 )/23 /,tran(107 )/25 /,tran(108 )/26 / % data tran(109 )/27 /,tran(110 )/28 /,tran(111 )/29 / % data tran(112 )/30 /,tran(113 )/31 /,tran(114 )/32 / % data tran(115 )/33 /,tran(116 )/34 /,tran(117 )/35 / % data tran(118 )/36 /,tran(119 )/37 /,tran(120 )/63 / % data tran(121 )/41 /,tran(122 )/42 /,tran(123 )/43 / % data tran(124 )/44 /,tran(125 )/45 /,tran(126 )/46 / % data tran(127 )/49 /,tran(128 )/68 /,tran(129 )/66 / % data tran(130 )/67 /,tran(131 )/62 /,tran(132 )/64 / % data tran(133 )/22 /,tran(134 )/23 /,tran(135 )/24 / % data tran(136 )/25 /,tran(137 )/26 /,tran(138 )/27 / % data tran(139 )/28 /,tran(140 )/29 /,tran(141 )/30 / % data tran(142 )/31 /,tran(143 )/32 /,tran(144 )/33 / % data tran(145 )/34 /,tran(146 )/35 /,tran(147 )/36 / % data tran(148 )/37 /,tran(149 )/38 /,tran(150 )/39 / % data tran(151 )/40 /,tran(152 )/41 /,tran(153 )/42 / % data tran(154 )/43 /,tran(155 )/44 /,tran(156 )/45 / % data tran(157 )/69 /,tran(158 )/46 /,tran(159 )/47 / % data tran(160 )/70 /,tran(161 )/49 /,tran(162 )/51 / % data tran(163 )/52 /,tran(164 )/62 /,tran(165 )/9 / % data tran(166 )/64 /,tran(167 )/71 /,tran(168 )/72 / % data tran(169 )/73 /,tran(170 )/22 /,tran(171 )/23 / % data tran(172 )/25 /,tran(173 )/26 /,tran(174 )/27 / % data tran(175 )/28 /,tran(176 )/29 /,tran(177 )/30 / % data tran(178 )/31 /,tran(179 )/32 /,tran(180 )/33 / % data tran(181 )/34 /,tran(182 )/35 /,tran(183 )/36 / % data tran(184 )/37 /,tran(185 )/62 /,tran(186 )/63 / % data tran(187 )/41 /,tran(188 )/42 /,tran(189 )/43 / % data tran(190 )/44 /,tran(191 )/45 /,tran(192 )/46 / % data tran(193 )/64 /,tran(194 )/49 /,tran(195 )/74 / % data tran(196 )/67 /,tran(197 )/60 /,tran(198 )/75 / % data tran(199 )/76 /,tran(200 )/77 /,tran(201 )/78 / % data tran(202 )/79 /,tran(203 )/80 /,tran(204 )/81 / % data tran(205 )/82 /,tran(206 )/83 /,tran(207 )/22 / % data tran(208 )/23 /,tran(209 )/84 /,tran(210 )/25 / % data tran(211 )/26 /,tran(212 )/27 /,tran(213 )/28 / % data tran(214 )/29 /,tran(215 )/30 /,tran(216 )/31 / % data tran(217 )/32 /,tran(218 )/33 /,tran(219 )/34 / % data tran(220 )/35 /,tran(221 )/36 /,tran(222 )/37 / % data tran(223 )/39 /,tran(224 )/40 /,tran(225 )/41 / % data tran(226 )/42 /,tran(227 )/43 /,tran(228 )/44 / % data tran(229 )/45 /,tran(230 )/46 /,tran(231 )/47 / % data tran(232 )/49 /,tran(233 )/85 /,tran(234 )/52 / % data tran(235 )/86 /,tran(236 )/8 /,tran(237 )/13 / % data tran(238 )/87 /,tran(239 )/21 /,tran(240 )/54 / % data tran(241 )/55 /,tran(242 )/56 /,tran(243 )/8 / % data tran(244 )/88 /,tran(245 )/89 /,tran(246 )/21 / % data tran(247 )/22 /,tran(248 )/23 /,tran(249 )/84 / % data tran(250 )/25 /,tran(251 )/26 /,tran(252 )/27 / % data tran(253 )/28 /,tran(254 )/29 /,tran(255 )/30 / % data tran(256 )/31 /,tran(257 )/32 /,tran(258 )/33 / % data tran(259 )/34 /,tran(260 )/35 /,tran(261 )/36 / % data tran(262 )/37 /,tran(263 )/90 /,tran(264 )/39 / % data tran(265 )/40 /,tran(266 )/41 /,tran(267 )/42 / % data tran(268 )/43 /,tran(269 )/44 /,tran(270 )/45 / % data tran(271 )/46 /,tran(272 )/47 /,tran(273 )/49 / % data tran(274 )/85 /,tran(275 )/52 /,tran(276 )/82 / % data tran(277 )/9 /,tran(278 )/91 /,tran(279 )/92 / % data tran(280 )/93 /,tran(281 )/94 /,tran(282 )/95 / % data tran(283 )/96 /,tran(284 )/97 /,tran(285 )/98 / % data tran(286 )/99 /,tran(287 )/100 /,tran(288 )/101 / % data tran(289 )/102 /,tran(290 )/54 /,tran(291 )/55 / % data tran(292 )/103 /,tran(293 )/104 /,tran(294 )/105 / % data tran(295 )/106 /,tran(296 )/107 /,tran(297 )/108 / % data tran(298 )/109 /,tran(299 )/110 /,tran(300 )/111 / % data tran(301 )/112 /,tran(302 )/77 /,tran(303 )/113 / % data tran(304 )/76 /,tran(305 )/77 /,tran(306 )/78 / % data tran(307 )/79 /,tran(308 )/114 /,tran(309 )/81 / % data tran(310 )/115 /,tran(311 )/9 /,tran(312 )/116 / % data tran(313 )/117 /,tran(314 )/54 /,tran(315 )/55 / % data tran(316 )/56 /,tran(317 )/118 /,tran(318 )/119 / % data tran(319 )/120 /,tran(320 )/94 /,tran(321 )/95 / % data tran(322 )/96 /,tran(323 )/97 /,tran(324 )/98 / % data tran(325 )/99 /,tran(326 )/100 /,tran(327 )/101 / % data tran(328 )/102 /,tran(329 )/54 /,tran(330 )/55 / % data tran(331 )/103 /,tran(332 )/104 /,tran(333 )/121 / % data tran(334 )/106 /,tran(335 )/107 /,tran(336 )/108 / % data tran(337 )/22 /,tran(338 )/122 /,tran(339 )/123 / % data tran(340 )/25 /,tran(341 )/26 /,tran(342 )/27 / % data tran(343 )/28 /,tran(344 )/29 /,tran(345 )/30 / % data tran(346 )/31 /,tran(347 )/32 /,tran(348 )/124 / % data tran(349 )/34 /,tran(350 )/35 /,tran(351 )/36 / % data tran(352 )/37 /,tran(353 )/41 /,tran(354 )/42 / % data tran(355 )/43 /,tran(356 )/44 /,tran(357 )/45 / % data tran(358 )/46 /,tran(359 )/125 /,tran(360 )/126 / % data tran(361 )/127 /,tran(362 )/128 /,tran(363 )/129 / % data tran(364 )/130 /,tran(365 )/131 /,tran(366 )/132 / % data tran(367 )/133 /,tran(368 )/94 /,tran(369 )/95 / % data tran(370 )/96 /,tran(371 )/97 /,tran(372 )/98 / % data tran(373 )/99 /,tran(374 )/100 /,tran(375 )/101 / % data tran(376 )/102 /,tran(377 )/54 /,tran(378 )/55 / % data tran(379 )/103 /,tran(380 )/104 /,tran(381 )/134 / % data tran(382 )/108 /,tran(383 )/94 /,tran(384 )/95 / % data tran(385 )/96 /,tran(386 )/97 /,tran(387 )/98 / % data tran(388 )/99 /,tran(389 )/100 /,tran(390 )/101 / % data tran(391 )/102 /,tran(392 )/54 /,tran(393 )/55 / % data tran(394 )/103 /,tran(395 )/104 /,tran(396 )/135 / % data tran(397 )/136 /,tran(398 )/137 /,tran(399 )/138 / % data tran(400 )/139 /,tran(401 )/94 /,tran(402 )/95 / % data tran(403 )/96 /,tran(404 )/97 /,tran(405 )/98 / % data tran(406 )/99 /,tran(407 )/100 /,tran(408 )/101 / % data tran(409 )/102 /,tran(410 )/54 /,tran(411 )/55 / % data tran(412 )/103 /,tran(413 )/104 /,tran(414 )/140 / % data tran(415 )/106 /,tran(416 )/107 /,tran(417 )/108 / % data tran(418 )/109 /,tran(419 )/110 /,tran(420 )/111 / % data tran(421 )/141 /,tran(422 )/54 /,tran(423 )/55 / % data tran(424 )/56 /,tran(425 )/9 /,tran(426 )/142 / % data tran(427 )/22 /,tran(428 )/23 /,tran(429 )/143 / % data tran(430 )/25 /,tran(431 )/26 /,tran(432 )/27 / % data tran(433 )/28 /,tran(434 )/29 /,tran(435 )/30 / % data tran(436 )/31 /,tran(437 )/32 /,tran(438 )/33 / % data tran(439 )/34 /,tran(440 )/35 /,tran(441 )/36 / % data tran(442 )/37 /,tran(443 )/39 /,tran(444 )/40 / % data tran(445 )/41 /,tran(446 )/42 /,tran(447 )/43 / % data tran(448 )/44 /,tran(449 )/45 /,tran(450 )/46 / % data tran(451 )/47 /,tran(452 )/49 /,tran(453 )/144 / % data tran(454 )/52 /,tran(455 )/145 /,tran(456 )/131 / % data tran(457 )/132 /,tran(458 )/22 /,tran(459 )/123 / % data tran(460 )/25 /,tran(461 )/26 /,tran(462 )/27 / % data tran(463 )/28 /,tran(464 )/29 /,tran(465 )/30 / % data tran(466 )/31 /,tran(467 )/32 /,tran(468 )/124 / % data tran(469 )/34 /,tran(470 )/35 /,tran(471 )/36 / % data tran(472 )/37 /,tran(473 )/41 /,tran(474 )/42 / % data tran(475 )/43 /,tran(476 )/44 /,tran(477 )/45 / % data tran(478 )/46 /,tran(479 )/125 /,tran(480 )/126 / % data tran(481 )/127 /,tran(482 )/146 /,tran(483 )/129 / % data tran(484 )/22 /,tran(485 )/147 /,tran(486 )/148 / % data tran(487 )/25 /,tran(488 )/26 /,tran(489 )/27 / % data tran(490 )/28 /,tran(491 )/29 /,tran(492 )/30 / % data tran(493 )/31 /,tran(494 )/32 /,tran(495 )/34 / % data tran(496 )/35 /,tran(497 )/36 /,tran(498 )/37 / % data tran(499 )/149 /,tran(500 )/41 /,tran(501 )/42 / % data tran(502 )/43 /,tran(503 )/44 /,tran(504 )/45 / % data tran(505 )/46 /,tran(506 )/150 /,tran(507 )/151 / % data tran(508 )/152 /,tran(509 )/153 /,tran(510 )/94 / % data tran(511 )/95 /,tran(512 )/96 /,tran(513 )/97 / % data tran(514 )/98 /,tran(515 )/99 /,tran(516 )/100 / % data tran(517 )/101 /,tran(518 )/102 /,tran(519 )/54 / % data tran(520 )/55 /,tran(521 )/103 /,tran(522 )/104 / % data tran(523 )/154 /,tran(524 )/108 /,tran(525 )/94 / % data tran(526 )/95 /,tran(527 )/96 /,tran(528 )/97 / % data tran(529 )/98 /,tran(530 )/99 /,tran(531 )/100 / % data tran(532 )/101 /,tran(533 )/102 /,tran(534 )/54 / % data tran(535 )/55 /,tran(536 )/103 /,tran(537 )/104 / % data tran(538 )/135 /,tran(539 )/136 /,tran(540 )/137 / % data tran(541 )/138 /,tran(542 )/139 /,tran(543 )/155 / % data tran(544 )/156 /,tran(545 )/130 /,tran(546 )/131 / % data tran(547 )/132 /,tran(548 )/157 /,tran(549 )/54 / % data tran(550 )/55 /,tran(551 )/56 /,tran(552 )/22 / % data tran(553 )/147 /,tran(554 )/148 /,tran(555 )/25 / % data tran(556 )/26 /,tran(557 )/27 /,tran(558 )/28 / % data tran(559 )/29 /,tran(560 )/30 /,tran(561 )/31 / % data tran(562 )/32 /,tran(563 )/34 /,tran(564 )/35 / % data tran(565 )/36 /,tran(566 )/37 /,tran(567 )/158 / % data tran(568 )/41 /,tran(569 )/42 /,tran(570 )/43 / % data tran(571 )/44 /,tran(572 )/45 /,tran(573 )/46 / % data tran(574 )/150 /,tran(575 )/151 /,tran(576 )/152 / % data tran(577 )/159 /,tran(578 )/22 /,tran(579 )/147 / % data tran(580 )/148 /,tran(581 )/25 /,tran(582 )/26 / % data tran(583 )/27 /,tran(584 )/28 /,tran(585 )/29 / % data tran(586 )/30 /,tran(587 )/31 /,tran(588 )/32 / % data tran(589 )/34 /,tran(590 )/35 /,tran(591 )/36 / % data tran(592 )/37 /,tran(593 )/41 /,tran(594 )/42 / % data tran(595 )/43 /,tran(596 )/44 /,tran(597 )/45 / % data tran(598 )/46 /,tran(599 )/150 /,tran(600 )/151 / % data tran(601 )/160 /,tran(602 )/94 /,tran(603 )/95 / % data tran(604 )/96 /,tran(605 )/97 /,tran(606 )/98 / % data tran(607 )/99 /,tran(608 )/100 /,tran(609 )/101 / % data tran(610 )/102 /,tran(611 )/54 /,tran(612 )/55 / % data tran(613 )/103 /,tran(614 )/104 /,tran(615 )/135 / % data tran(616 )/161 /,tran(617 )/162 /,tran(618 )/163 / % data tran(619 )/22 /,tran(620 )/147 /,tran(621 )/148 / % data tran(622 )/25 /,tran(623 )/26 /,tran(624 )/27 / % data tran(625 )/28 /,tran(626 )/29 /,tran(627 )/30 / % data tran(628 )/31 /,tran(629 )/32 /,tran(630 )/34 / % data tran(631 )/35 /,tran(632 )/36 /,tran(633 )/37 / % data tran(634 )/41 /,tran(635 )/42 /,tran(636 )/43 / % data tran(637 )/44 /,tran(638 )/45 /,tran(639 )/46 / % data tran(640 )/150 /,tran(641 )/151 /,tran(642 )/164 / % data tran(643 )/165 /,tran(644 )/155 /,tran(645 )/166 / % data tran(646 )/167 /,tran(647 )/163 / % data ftrn(1 )/1 /,ftrn(2 )/2 /,ftrn(3 )/4 / % data ftrn(4 )/5 /,ftrn(5 )/19 /,ftrn(6 )/19 / % data ftrn(7 )/23 /,ftrn(8 )/23 /,ftrn(9 )/23 / % data ftrn(10 )/23 /,ftrn(11 )/54 /,ftrn(12 )/57 / % data ftrn(13 )/57 /,ftrn(14 )/57 /,ftrn(15 )/57 / % data ftrn(16 )/63 /,ftrn(17 )/63 /,ftrn(18 )/75 / % data ftrn(19 )/77 /,ftrn(20 )/105 /,ftrn(21 )/131 / % data ftrn(22 )/133 /,ftrn(23 )/133 /,ftrn(24 )/133 / % data ftrn(25 )/133 /,ftrn(26 )/133 /,ftrn(27 )/133 / % data ftrn(28 )/133 /,ftrn(29 )/133 /,ftrn(30 )/133 / % data ftrn(31 )/133 /,ftrn(32 )/133 /,ftrn(33 )/133 / % data ftrn(34 )/133 /,ftrn(35 )/133 /,ftrn(36 )/133 / % data ftrn(37 )/133 /,ftrn(38 )/133 /,ftrn(39 )/133 / % data ftrn(40 )/133 /,ftrn(41 )/133 /,ftrn(42 )/133 / % data ftrn(43 )/133 /,ftrn(44 )/133 /,ftrn(45 )/133 / % data ftrn(46 )/133 /,ftrn(47 )/133 /,ftrn(48 )/133 / % data ftrn(49 )/133 /,ftrn(50 )/133 /,ftrn(51 )/164 / % data ftrn(52 )/164 /,ftrn(53 )/164 /,ftrn(54 )/170 / % data ftrn(55 )/170 /,ftrn(56 )/170 /,ftrn(57 )/170 / % data ftrn(58 )/197 /,ftrn(59 )/197 /,ftrn(60 )/199 / % data ftrn(61 )/205 /,ftrn(62 )/206 /,ftrn(63 )/206 / % data ftrn(64 )/206 /,ftrn(65 )/206 /,ftrn(66 )/207 / % data ftrn(67 )/235 /,ftrn(68 )/235 /,ftrn(69 )/236 / % data ftrn(70 )/240 /,ftrn(71 )/240 /,ftrn(72 )/240 / % data ftrn(73 )/243 /,ftrn(74 )/247 /,ftrn(75 )/276 / % data ftrn(76 )/277 /,ftrn(77 )/281 /,ftrn(78 )/281 / % data ftrn(79 )/281 /,ftrn(80 )/298 /,ftrn(81 )/302 / % data ftrn(82 )/304 /,ftrn(83 )/310 /,ftrn(84 )/310 / % data ftrn(85 )/310 /,ftrn(86 )/310 /,ftrn(87 )/310 / % data ftrn(88 )/311 /,ftrn(89 )/313 /,ftrn(90 )/314 / % data ftrn(91 )/314 /,ftrn(92 )/314 /,ftrn(93 )/317 / % data ftrn(94 )/319 /,ftrn(95 )/319 /,ftrn(96 )/320 / % data ftrn(97 )/320 /,ftrn(98 )/337 /,ftrn(99 )/337 / % data ftrn(100 )/337 /,ftrn(101 )/337 /,ftrn(102 )/364 / % data ftrn(103 )/364 /,ftrn(104 )/364 /,ftrn(105 )/364 / % data ftrn(106 )/368 /,ftrn(107 )/383 /,ftrn(108 )/397 / % data ftrn(109 )/401 /,ftrn(110 )/401 /,ftrn(111 )/401 / % data ftrn(112 )/401 /,ftrn(113 )/401 /,ftrn(114 )/418 / % data ftrn(115 )/422 /,ftrn(116 )/422 /,ftrn(117 )/425 / % data ftrn(118 )/425 /,ftrn(119 )/427 /,ftrn(120 )/427 / % data ftrn(121 )/455 /,ftrn(122 )/458 /,ftrn(123 )/484 / % data ftrn(124 )/484 /,ftrn(125 )/484 /,ftrn(126 )/484 / % data ftrn(127 )/484 /,ftrn(128 )/484 /,ftrn(129 )/509 / % data ftrn(130 )/510 /,ftrn(131 )/510 /,ftrn(132 )/510 / % data ftrn(133 )/525 /,ftrn(134 )/525 /,ftrn(135 )/539 / % data ftrn(136 )/543 /,ftrn(137 )/543 /,ftrn(138 )/543 / % data ftrn(139 )/543 /,ftrn(140 )/545 /,ftrn(141 )/549 / % data ftrn(142 )/549 /,ftrn(143 )/552 /,ftrn(144 )/552 / % data ftrn(145 )/552 /,ftrn(146 )/552 /,ftrn(147 )/577 / % data ftrn(148 )/577 /,ftrn(149 )/577 /,ftrn(150 )/577 / % data ftrn(151 )/577 /,ftrn(152 )/577 /,ftrn(153 )/578 / % data ftrn(154 )/602 /,ftrn(155 )/616 /,ftrn(156 )/616 / % data ftrn(157 )/619 /,ftrn(158 )/619 /,ftrn(159 )/619 / % data ftrn(160 )/643 /,ftrn(161 )/643 /,ftrn(162 )/646 / % data ftrn(163 )/646 /,ftrn(164 )/646 /,ftrn(165 )/646 / % data ftrn(166 )/646 /,ftrn(167 )/648 / % data ftrn(168 )/648 / % data ent(1 )/34 /,ent(2 )/0 /,ent(3 )/261/ % data ent(4 )/262/,ent(5 )/0 /,ent(6 )/35 / % data ent(7 )/10 /,ent(8 )/9 /,ent(9 )/1 / % data ent(10 )/5 /,ent(11 )/4 /,ent(12 )/3 / % data ent(13 )/32 /,ent(14 )/-1 /,ent(15 )/271/ % data ent(16 )/266/,ent(17 )/263/,ent(18 )/264/ % data ent(19 )/267/,ent(20 )/269/,ent(21 )/267/ % data ent(22 )/60 /,ent(23 )/33 /,ent(24 )/34 / % data ent(25 )/35 /,ent(26 )/36 /,ent(27 )/37 / % data ent(28 )/40 /,ent(29 )/41 /,ent(30 )/42 / % data ent(31 )/43 /,ent(32 )/44 /,ent(33 )/45 / % data ent(34 )/47 /,ent(35 )/63 /,ent(36 )/91 / % data ent(37 )/92 /,ent(38 )/10 /,ent(39 )/9 / % data ent(40 )/93 /,ent(41 )/123/,ent(42 )/124/ % data ent(43 )/125/,ent(44 )/62 /,ent(45 )/1 / % data ent(46 )/2 /,ent(47 )/32 /,ent(48 )/292/ % data ent(49 )/295/,ent(50 )/270/,ent(51 )/293/ % data ent(52 )/294/,ent(53 )/267/,ent(54 )/1 / % data ent(55 )/2 /,ent(56 )/282/,ent(57 )/267/ % data ent(58 )/266/,ent(59 )/264/,ent(60 )/274/ % data ent(61 )/265/,ent(62 )/9 /,ent(63 )/93 / % data ent(64 )/32 /,ent(65 )/273/,ent(66 )/272/ % data ent(67 )/294/,ent(68 )/273/,ent(69 )/6 / % data ent(70 )/292/,ent(71 )/-1 /,ent(72 )/271/ % data ent(73 )/268/,ent(74 )/272/,ent(75 )/265/ % data ent(76 )/60 /,ent(77 )/37 /,ent(78 )/-1 / % data ent(79 )/278/,ent(80 )/275/,ent(81 )/277/ % data ent(82 )/274/,ent(83 )/10 /,ent(84 )/34 / % data ent(85 )/293/,ent(86 )/10 /,ent(87 )/269/ % data ent(88 )/32 /,ent(89 )/269/,ent(90 )/10 / % data ent(91 )/-1 /,ent(92 )/271/,ent(93 )/281/ % data ent(94 )/33 /,ent(95 )/34 /,ent(96 )/35 / % data ent(97 )/40 /,ent(98 )/44 /,ent(99 )/45 / % data ent(100 )/63 /,ent(101 )/91 /,ent(102 )/93 / % data ent(103 )/282/,ent(104 )/289/,ent(105 )/279/ % data ent(106 )/284/,ent(107 )/283/,ent(108 )/285/ % data ent(109 )/10 /,ent(110 )/9 /,ent(111 )/32 / % data ent(112 )/276/,ent(113 )/278/,ent(114 )/275/ % data ent(115 )/10 /,ent(116 )/271/,ent(117 )/10 / % data ent(118 )/44 /,ent(119 )/62 /,ent(120 )/288/ % data ent(121 )/279/,ent(122 )/33 /,ent(123 )/34 / % data ent(124 )/45 /,ent(125 )/32 /,ent(126 )/-1 / % data ent(127 )/295/,ent(128 )/287/,ent(129 )/291/ % data ent(130 )/36 /,ent(131 )/47 /,ent(132 )/124/ % data ent(133 )/280/,ent(134 )/283/,ent(135 )/285/ % data ent(136 )/42 /,ent(137 )/43 /,ent(138 )/92 / % data ent(139 )/123/,ent(140 )/279/,ent(141 )/276/ % data ent(142 )/271/,ent(143 )/34 /,ent(144 )/293/ % data ent(145 )/41 /,ent(146 )/287/,ent(147 )/33 / % data ent(148 )/34 /,ent(149 )/93 /,ent(150 )/32 / % data ent(151 )/295/,ent(152 )/290/,ent(153 )/45 / % data ent(154 )/283/,ent(155 )/2 /,ent(156 )/286/ % data ent(157 )/280/,ent(158 )/93 /,ent(159 )/45 / % data ent(160 )/290/,ent(161 )/44 /,ent(162 )/125/ % data ent(163 )/2 /,ent(164 )/290/,ent(165 )/125/ % data ent(166 )/286/,ent(167 )/125/ % data ent(168 )/759/ % data fred(1 )/1 /,fred(2 )/1 /,fred(3 )/2 / % data fred(4 )/2 /,fred(5 )/2 /,fred(6 )/3 / % data fred(7 )/4 /,fred(8 )/5 /,fred(9 )/6 / % data fred(10 )/7 /,fred(11 )/7 /,fred(12 )/7 / % data fred(13 )/8 /,fred(14 )/9 /,fred(15 )/10 / % data fred(16 )/10 /,fred(17 )/11 /,fred(18 )/11 / % data fred(19 )/12 /,fred(20 )/13 /,fred(21 )/14 / % data fred(22 )/15 /,fred(23 )/16 /,fred(24 )/17 / % data fred(25 )/18 /,fred(26 )/19 /,fred(27 )/20 / % data fred(28 )/21 /,fred(29 )/22 /,fred(30 )/23 / % data fred(31 )/24 /,fred(32 )/25 /,fred(33 )/26 / % data fred(34 )/27 /,fred(35 )/28 /,fred(36 )/29 / % data fred(37 )/30 /,fred(38 )/31 /,fred(39 )/32 / % data fred(40 )/33 /,fred(41 )/34 /,fred(42 )/35 / % data fred(43 )/36 /,fred(44 )/37 /,fred(45 )/38 / % data fred(46 )/39 /,fred(47 )/40 /,fred(48 )/41 / % data fred(49 )/42 /,fred(50 )/43 /,fred(51 )/43 / % data fred(52 )/44 /,fred(53 )/45 /,fred(54 )/45 / % data fred(55 )/46 /,fred(56 )/47 /,fred(57 )/48 / % data fred(58 )/48 /,fred(59 )/49 /,fred(60 )/50 / % data fred(61 )/52 /,fred(62 )/54 /,fred(63 )/55 / % data fred(64 )/56 /,fred(65 )/57 /,fred(66 )/57 / % data fred(67 )/58 /,fred(68 )/59 /,fred(69 )/59 / % data fred(70 )/60 /,fred(71 )/61 /,fred(72 )/62 / % data fred(73 )/63 /,fred(74 )/64 /,fred(75 )/64 / % data fred(76 )/66 /,fred(77 )/66 /,fred(78 )/67 / % data fred(79 )/68 /,fred(80 )/68 /,fred(81 )/68 / % data fred(82 )/69 /,fred(83 )/71 /,fred(84 )/72 / % data fred(85 )/73 /,fred(86 )/74 /,fred(87 )/75 / % data fred(88 )/75 /,fred(89 )/76 /,fred(90 )/76 / % data fred(91 )/77 /,fred(92 )/78 /,fred(93 )/79 / % data fred(94 )/79 /,fred(95 )/80 /,fred(96 )/81 / % data fred(97 )/82 /,fred(98 )/82 /,fred(99 )/83 / % data fred(100 )/84 /,fred(101 )/85 /,fred(102 )/85 / % data fred(103 )/86 /,fred(104 )/87 /,fred(105 )/88 / % data fred(106 )/89 /,fred(107 )/89 /,fred(108 )/90 / % data fred(109 )/91 /,fred(110 )/92 /,fred(111 )/93 / % data fred(112 )/94 /,fred(113 )/95 /,fred(114 )/95 / % data fred(115 )/95 /,fred(116 )/96 /,fred(117 )/97 / % data fred(118 )/98 /,fred(119 )/98 /,fred(120 )/99 / % data fred(121 )/99 /,fred(122 )/99 /,fred(123 )/99 / % data fred(124 )/100 /,fred(125 )/101 /,fred(126 )/102 / % data fred(127 )/103 /,fred(128 )/104 /,fred(129 )/104 / % data fred(130 )/105 /,fred(131 )/106 /,fred(132 )/107 / % data fred(133 )/107 /,fred(134 )/108 /,fred(135 )/109 / % data fred(136 )/110 /,fred(137 )/111 /,fred(138 )/112 / % data fred(139 )/113 /,fred(140 )/113 /,fred(141 )/114 / % data fred(142 )/115 /,fred(143 )/116 /,fred(144 )/117 / % data fred(145 )/118 /,fred(146 )/119 /,fred(147 )/119 / % data fred(148 )/120 /,fred(149 )/121 /,fred(150 )/122 / % data fred(151 )/123 /,fred(152 )/124 /,fred(153 )/125 / % data fred(154 )/125 /,fred(155 )/126 /,fred(156 )/127 / % data fred(157 )/127 /,fred(158 )/128 /,fred(159 )/129 / % data fred(160 )/129 /,fred(161 )/130 /,fred(162 )/130 / % data fred(163 )/131 /,fred(164 )/132 /,fred(165 )/133 / % data fred(166 )/134 /,fred(167 )/134 / % data fred(168 )/135 / % data nset(1 )/18 /,nset(2 )/27 /,nset(3 )/8 / % data nset(4 )/17 /,nset(5 )/6 /,nset(6 )/21 / % data nset(7 )/10 /,nset(8 )/6 /,nset(9 )/17 / % data nset(10 )/17 /,nset(11 )/10 /,nset(12 )/25 / % data nset(13 )/25 /,nset(14 )/8 /,nset(15 )/7 / % data nset(16 )/7 /,nset(17 )/7 /,nset(18 )/7 / % data nset(19 )/7 /,nset(20 )/7 /,nset(21 )/7 / % data nset(22 )/7 /,nset(23 )/7 /,nset(24 )/7 / % data nset(25 )/7 /,nset(26 )/7 /,nset(27 )/7 / % data nset(28 )/7 /,nset(29 )/7 /,nset(30 )/7 / % data nset(31 )/7 /,nset(32 )/7 /,nset(33 )/7 / % data nset(34 )/7 /,nset(35 )/7 /,nset(36 )/7 / % data nset(37 )/7 /,nset(38 )/7 /,nset(39 )/7 / % data nset(40 )/7 /,nset(41 )/7 /,nset(42 )/7 / % data nset(43 )/7 /,nset(44 )/7 /,nset(45 )/12 / % data nset(46 )/12 /,nset(47 )/21 /,nset(48 )/17 / % data nset(49 )/10 /,nset(50 )/24 /,nset(51 )/15 / % data nset(52 )/27 /,nset(53 )/10 /,nset(54 )/6 / % data nset(55 )/4 /,nset(56 )/6 /,nset(57 )/25 / % data nset(58 )/4 /,nset(59 )/25 /,nset(60 )/7 / % data nset(61 )/24 /,nset(62 )/24 /,nset(63 )/25 / % data nset(64 )/27 /,nset(65 )/10 /,nset(66 )/15 / % data nset(67 )/24 /,nset(68 )/15 /,nset(69 )/24 / % data nset(70 )/15 /,nset(71 )/17 /,nset(72 )/4 / % data nset(73 )/4 /,nset(74 )/17 /,nset(75 )/24 / % data nset(76 )/17 /,nset(77 )/22 /,nset(78 )/22 / % data nset(79 )/13 /,nset(80 )/3 /,nset(81 )/13 / % data nset(82 )/13 /,nset(83 )/13 /,nset(84 )/13 / % data nset(85 )/13 /,nset(86 )/13 /,nset(87 )/13 / % data nset(88 )/24 /,nset(89 )/19 /,nset(90 )/11 / % data nset(91 )/5 /,nset(92 )/5 /,nset(93 )/5 / % data nset(94 )/5 /,nset(95 )/17 /,nset(96 )/24 / % data nset(97 )/17 /,nset(98 )/16 /,nset(99 )/1 / % data nset(100 )/1 /,nset(101 )/1 /,nset(102 )/2 / % data nset(103 )/1 /,nset(104 )/2 /,nset(105 )/24 / % data nset(106 )/15 /,nset(107 )/24 /,nset(108 )/19 / % data nset(109 )/11 /,nset(110 )/13 /,nset(111 )/13 / % data nset(112 )/13 /,nset(113 )/24 /,nset(114 )/5 / % data nset(115 )/22 /,nset(116 )/13 /,nset(117 )/3 / % data nset(118 )/13 /,nset(119 )/1 /,nset(120 )/1 / % data nset(121 )/13 /,nset(122 )/1 /,nset(123 )/1 / % data nset(124 )/2 /,nset(125 )/19 /,nset(126 )/20 / % data nset(127 )/24 /,nset(128 )/13 /,nset(129 )/2 / % data nset(130 )/13 /,nset(131 )/20 /,nset(132 )/2 / % data nset(133 )/13 /,nset(134 )/13 / % data prod(1 )/4 /,prod(2 )/1 /,prod(3 )/71 / % data prod(4 )/13 /,prod(5 )/78 /,prod(6 )/30 / % data prod(7 )/14 /,prod(8 )/77 /,prod(9 )/7 / % data prod(10 )/6 /,prod(11 )/17 /,prod(12 )/63 / % data prod(13 )/63 /,prod(14 )/70 /,prod(15 )/105 / % data prod(16 )/104 /,prod(17 )/96 /,prod(18 )/113 / % data prod(19 )/109 /,prod(20 )/108 /,prod(21 )/120 / % data prod(22 )/121 /,prod(23 )/112 /,prod(24 )/114 / % data prod(25 )/107 /,prod(26 )/103 /,prod(27 )/111 / % data prod(28 )/118 /,prod(29 )/119 /,prod(30 )/115 / % data prod(31 )/97 /,prod(32 )/101 /,prod(33 )/99 / % data prod(34 )/116 /,prod(35 )/110 /,prod(36 )/117 / % data prod(37 )/106 /,prod(38 )/122 /,prod(39 )/123 / % data prod(40 )/100 /,prod(41 )/61 /,prod(42 )/102 / % data prod(43 )/95 /,prod(44 )/98 /,prod(45 )/85 / % data prod(46 )/86 /,prod(47 )/29 /,prod(48 )/5 / % data prod(49 )/17 /,prod(50 )/20 /,prod(51 )/32 / % data prod(52 )/3 /,prod(53 )/17 /,prod(54 )/76 / % data prod(55 )/66 /,prod(56 )/75 /,prod(57 )/62 / % data prod(58 )/67 /,prod(59 )/71 /,prod(60 )/60 / % data prod(61 )/25 /,prod(62 )/24 /,prod(63 )/71 / % data prod(64 )/2 /,prod(65 )/17 /,prod(66 )/31 / % data prod(67 )/21 /,prod(68 )/32 /,prod(69 )/20 / % data prod(70 )/32 /,prod(71 )/11 /,prod(72 )/65 / % data prod(73 )/64 /,prod(74 )/12 /,prod(75 )/77 / % data prod(76 )/10 /,prod(77 )/28 /,prod(78 )/27 / % data prod(79 )/83 /,prod(80 )/69 /,prod(81 )/81 / % data prod(82 )/80 /,prod(83 )/82 /,prod(84 )/47 / % data prod(85 )/84 /,prod(86 )/79 /,prod(87 )/52 / % data prod(88 )/34 /,prod(89 )/37 /,prod(90 )/40 / % data prod(91 )/74 /,prod(92 )/73 /,prod(93 )/72 / % data prod(94 )/16 /,prod(95 )/9 /,prod(96 )/23 / % data prod(97 )/8 /,prod(98 )/22 /,prod(99 )/92 / % data prod(100 )/93 /,prod(101 )/94 /,prod(102 )/59 / % data prod(103 )/91 /,prod(104 )/58 /,prod(105 )/33 / % data prod(106 )/38 /,prod(107 )/19 /,prod(108 )/36 / % data prod(109 )/39 /,prod(110 )/41 /,prod(111 )/42 / % data prod(112 )/43 /,prod(113 )/34 /,prod(114 )/15 / % data prod(115 )/26 /,prod(116 )/50 /,prod(117 )/68 / % data prod(118 )/51 /,prod(119 )/88 /,prod(120 )/89 / % data prod(121 )/48 /,prod(122 )/90 /,prod(123 )/87 / % data prod(124 )/56 /,prod(125 )/35 /,prod(126 )/54 / % data prod(127 )/18 /,prod(128 )/49 /,prod(129 )/57 / % data prod(130 )/46 /,prod(131 )/53 /,prod(132 )/55 / % data prod(133 )/45 /,prod(134 )/44 / % data lhs(1 )/260/,lhs(2 )/261/,lhs(3 )/261/,lhs(4 )/262/ % data lhs(5 )/263/,lhs(6 )/263/,lhs(7 )/263/,lhs(8 )/266/ % data lhs(9 )/266/,lhs(10 )/266/,lhs(11 )/266/,lhs(12 )/266/ % data lhs(13 )/266/,lhs(14 )/264/,lhs(15 )/265/,lhs(16 )/265/ % data lhs(17 )/274/,lhs(18 )/275/,lhs(19 )/275/,lhs(20 )/275/ % data lhs(21 )/275/,lhs(22 )/277/,lhs(23 )/268/,lhs(24 )/268/ % data lhs(25 )/268/,lhs(26 )/281/,lhs(27 )/281/,lhs(28 )/281/ % data lhs(29 )/271/,lhs(30 )/271/,lhs(31 )/278/,lhs(32 )/278/ % data lhs(33 )/280/,lhs(34 )/280/,lhs(35 )/279/,lhs(36 )/279/ % data lhs(37 )/279/,lhs(38 )/284/,lhs(39 )/283/,lhs(40 )/283/ % data lhs(41 )/285/,lhs(42 )/285/,lhs(43 )/285/,lhs(44 )/285/ % data lhs(45 )/285/,lhs(46 )/285/,lhs(47 )/285/,lhs(48 )/285/ % data lhs(49 )/285/,lhs(50 )/285/,lhs(51 )/285/,lhs(52 )/285/ % data lhs(53 )/286/,lhs(54 )/286/,lhs(55 )/287/,lhs(56 )/287/ % data lhs(57 )/287/,lhs(58 )/287/,lhs(59 )/287/,lhs(60 )/270/ % data lhs(61 )/270/,lhs(62 )/273/,lhs(63 )/273/,lhs(64 )/272/ % data lhs(65 )/272/,lhs(66 )/272/,lhs(67 )/272/,lhs(68 )/288/ % data lhs(69 )/288/,lhs(70 )/269/,lhs(71 )/269/,lhs(72 )/276/ % data lhs(73 )/276/,lhs(74 )/276/,lhs(75 )/267/,lhs(76 )/267/ % data lhs(77 )/267/,lhs(78 )/267/,lhs(79 )/289/,lhs(80 )/289/ % data lhs(81 )/289/,lhs(82 )/289/,lhs(83 )/289/,lhs(84 )/289/ % data lhs(85 )/282/,lhs(86 )/282/,lhs(87 )/290/,lhs(88 )/290/ % data lhs(89 )/290/,lhs(90 )/290/,lhs(91 )/291/,lhs(92 )/291/ % data lhs(93 )/291/,lhs(94 )/291/,lhs(95 )/292/,lhs(96 )/292/ % data lhs(97 )/292/,lhs(98 )/293/,lhs(99 )/293/,lhs(100)/293/ % data lhs(101)/293/,lhs(102)/294/,lhs(103)/294/,lhs(104)/294/ % data lhs(105)/295/,lhs(106)/295/,lhs(107)/295/,lhs(108)/295/ % data lhs(109)/295/,lhs(110)/295/,lhs(111)/295/,lhs(112)/295/ % data lhs(113)/295/,lhs(114)/295/,lhs(115)/295/,lhs(116)/295/ % data lhs(117)/295/,lhs(118)/295/,lhs(119)/295/,lhs(120)/295/ % data lhs(121)/295/,lhs(122)/295/,lhs(123)/295/ % data len(1 )/3 /,len(2 )/4 /,len(3 )/3 /,len(4 )/0 / % data len(5 )/2 /,len(6 )/1 /,len(7 )/1 /,len(8 )/5 / % data len(9 )/5 /,len(10 )/4 /,len(11 )/3 /,len(12 )/4 / % data len(13 )/1 /,len(14 )/1 /,len(15 )/4 /,len(16 )/3 / % data len(17 )/0 /,len(18 )/4 /,len(19 )/3 /,len(20 )/0 / % data len(21 )/1 /,len(22 )/3 /,len(23 )/3 /,len(24 )/1 / % data len(25 )/1 /,len(26 )/3 /,len(27 )/1 /,len(28 )/1 / % data len(29 )/2 /,len(30 )/1 /,len(31 )/1 /,len(32 )/0 / % data len(33 )/1 /,len(34 )/0 /,len(35 )/3 /,len(36 )/2 / % data len(37 )/1 /,len(38 )/2 /,len(39 )/2 /,len(40 )/1 / % data len(41 )/2 /,len(42 )/2 /,len(43 )/2 /,len(44 )/6 / % data len(45 )/5 /,len(46 )/4 /,len(47 )/1 /,len(48 )/3 / % data len(49 )/4 /,len(50 )/3 /,len(51 )/3 /,len(52 )/1 / % data len(53 )/2 /,len(54 )/1 /,len(55 )/4 /,len(56 )/2 / % data len(57 )/3 /,len(58 )/1 /,len(59 )/1 /,len(60 )/2 / % data len(61 )/1 /,len(62 )/1 /,len(63 )/0 /,len(64 )/2 / % data len(65 )/2 /,len(66 )/1 /,len(67 )/1 /,len(68 )/2 / % data len(69 )/0 /,len(70 )/1 /,len(71 )/0 /,len(72 )/1 / % data len(73 )/1 /,len(74 )/1 /,len(75 )/2 /,len(76 )/2 / % data len(77 )/1 /,len(78 )/1 /,len(79 )/1 /,len(80 )/1 / % data len(81 )/1 /,len(82 )/1 /,len(83 )/1 /,len(84 )/1 / % data len(85 )/1 /,len(86 )/1 /,len(87 )/1 /,len(88 )/1 / % data len(89 )/1 /,len(90 )/1 /,len(91 )/1 /,len(92 )/1 / % data len(93 )/1 /,len(94 )/1 /,len(95 )/1 /,len(96 )/1 / % data len(97 )/1 /,len(98 )/1 /,len(99 )/1 /,len(100)/1 / % data len(101)/1 /,len(102)/1 /,len(103)/1 /,len(104)/1 / % data len(105)/1 /,len(106)/1 /,len(107)/1 /,len(108)/1 / % data len(109)/1 /,len(110)/1 /,len(111)/1 /,len(112)/1 / % data len(113)/1 /,len(114)/1 /,len(115)/1 /,len(116)/1 / % data len(117)/1 /,len(118)/1 /,len(119)/1 /,len(120)/1 / % data len(121)/1 /,len(122)/1 /,len(123)/1 / % data lset( 1)/ 1/ % data lset(2 )/25 /,lset(3 )/48 /,lset(4 )/73 / % data lset(5 )/99 /,lset(6 )/117 /,lset(7 )/143 / % data lset(8 )/170 /,lset(9 )/193 /,lset(10 )/218 / % data lset(11 )/235 /,lset(12 )/253 /,lset(13 )/276 / % data lset(14 )/298 /,lset(15 )/319 /,lset(16 )/330 / % data lset(17 )/342 /,lset(18 )/350 /,lset(19 )/359 / % data lset(20 )/366 /,lset(21 )/369 /,lset(22 )/376 / % data lset(23 )/378 /,lset(24 )/383 /,lset(25 )/386 / % data lset(26 )/387 /,lset(27 )/391 /,lset(28 )/392 / % data ls(1 )/60 /,ls(2 )/33 /,ls(3 )/34 / % data ls(4 )/35 /,ls(5 )/36 /,ls(6 )/37 / % data ls(7 )/40 /,ls(8 )/41 /,ls(9 )/42 / % data ls(10 )/43 /,ls(11 )/44 /,ls(12 )/45 / % data ls(13 )/47 /,ls(14 )/63 /,ls(15 )/91 / % data ls(16 )/92 /,ls(17 )/93 /,ls(18 )/123 / % data ls(19 )/124 /,ls(20 )/125 /,ls(21 )/62 / % data ls(22 )/1 /,ls(23 )/2 /,ls(24 )/32 / % data ls(25 )/60 /,ls(26 )/33 /,ls(27 )/34 / % data ls(28 )/35 /,ls(29 )/36 /,ls(30 )/37 / % data ls(31 )/40 /,ls(32 )/41 /,ls(33 )/42 / % data ls(34 )/43 /,ls(35 )/44 /,ls(36 )/47 / % data ls(37 )/63 /,ls(38 )/91 /,ls(39 )/92 / % data ls(40 )/93 /,ls(41 )/123 /,ls(42 )/124 / % data ls(43 )/125 /,ls(44 )/62 /,ls(45 )/1 / % data ls(46 )/2 /,ls(47 )/32 /,ls(48 )/60 / % data ls(49 )/33 /,ls(50 )/34 /,ls(51 )/35 / % data ls(52 )/36 /,ls(53 )/37 /,ls(54 )/40 / % data ls(55 )/41 /,ls(56 )/42 /,ls(57 )/43 / % data ls(58 )/44 /,ls(59 )/45 /,ls(60 )/47 / % data ls(61 )/63 /,ls(62 )/91 /,ls(63 )/92 / % data ls(64 )/9 /,ls(65 )/93 /,ls(66 )/123 / % data ls(67 )/124 /,ls(68 )/125 /,ls(69 )/62 / % data ls(70 )/1 /,ls(71 )/2 /,ls(72 )/32 / % data ls(73 )/60 /,ls(74 )/33 /,ls(75 )/34 / % data ls(76 )/35 /,ls(77 )/36 /,ls(78 )/37 / % data ls(79 )/40 /,ls(80 )/41 /,ls(81 )/42 / % data ls(82 )/43 /,ls(83 )/44 /,ls(84 )/45 / % data ls(85 )/47 /,ls(86 )/63 /,ls(87 )/91 / % data ls(88 )/92 /,ls(89 )/10 /,ls(90 )/9 / % data ls(91 )/93 /,ls(92 )/123 /,ls(93 )/124 / % data ls(94 )/125 /,ls(95 )/62 /,ls(96 )/1 / % data ls(97 )/2 /,ls(98 )/32 /,ls(99 )/60 / % data ls(100 )/33 /,ls(101 )/34 /,ls(102 )/35 / % data ls(103 )/37 /,ls(104 )/40 /,ls(105 )/44 / % data ls(106 )/45 /,ls(107 )/63 /,ls(108 )/91 / % data ls(109 )/10 /,ls(110 )/9 /,ls(111 )/93 / % data ls(112 )/1 /,ls(113 )/2 /,ls(114 )/32 / % data ls(115 )/0 /,ls(116 )/-1 /,ls(117 )/60 / % data ls(118 )/33 /,ls(119 )/35 /,ls(120 )/36 / % data ls(121 )/37 /,ls(122 )/40 /,ls(123 )/41 / % data ls(124 )/42 /,ls(125 )/43 /,ls(126 )/44 / % data ls(127 )/45 /,ls(128 )/47 /,ls(129 )/63 / % data ls(130 )/91 /,ls(131 )/92 /,ls(132 )/10 / % data ls(133 )/9 /,ls(134 )/93 /,ls(135 )/123 / % data ls(136 )/124 /,ls(137 )/125 /,ls(138 )/62 / % data ls(139 )/1 /,ls(140 )/2 /,ls(141 )/32 / % data ls(142 )/-1 /,ls(143 )/60 /,ls(144 )/33 / % data ls(145 )/34 /,ls(146 )/35 /,ls(147 )/36 / % data ls(148 )/37 /,ls(149 )/40 /,ls(150 )/41 / % data ls(151 )/42 /,ls(152 )/43 /,ls(153 )/44 / % data ls(154 )/45 /,ls(155 )/47 /,ls(156 )/63 / % data ls(157 )/91 /,ls(158 )/92 /,ls(159 )/10 / % data ls(160 )/9 /,ls(161 )/93 /,ls(162 )/123 / % data ls(163 )/124 /,ls(164 )/125 /,ls(165 )/62 / % data ls(166 )/1 /,ls(167 )/6 /,ls(168 )/2 / % data ls(169 )/32 /,ls(170 )/60 /,ls(171 )/33 / % data ls(172 )/35 /,ls(173 )/36 /,ls(174 )/37 / % data ls(175 )/40 /,ls(176 )/41 /,ls(177 )/42 / % data ls(178 )/43 /,ls(179 )/44 /,ls(180 )/45 / % data ls(181 )/47 /,ls(182 )/63 /,ls(183 )/91 / % data ls(184 )/92 /,ls(185 )/10 /,ls(186 )/93 / % data ls(187 )/123 /,ls(188 )/124 /,ls(189 )/125 / % data ls(190 )/62 /,ls(191 )/1 /,ls(192 )/2 / % data ls(193 )/60 /,ls(194 )/33 /,ls(195 )/35 / % data ls(196 )/36 /,ls(197 )/37 /,ls(198 )/40 / % data ls(199 )/41 /,ls(200 )/42 /,ls(201 )/43 / % data ls(202 )/44 /,ls(203 )/45 /,ls(204 )/47 / % data ls(205 )/63 /,ls(206 )/91 /,ls(207 )/92 / % data ls(208 )/10 /,ls(209 )/9 /,ls(210 )/93 / % data ls(211 )/123 /,ls(212 )/124 /,ls(213 )/125 / % data ls(214 )/62 /,ls(215 )/1 /,ls(216 )/2 / % data ls(217 )/32 /,ls(218 )/60 /,ls(219 )/33 / % data ls(220 )/34 /,ls(221 )/35 /,ls(222 )/37 / % data ls(223 )/40 /,ls(224 )/44 /,ls(225 )/45 / % data ls(226 )/63 /,ls(227 )/91 /,ls(228 )/10 / % data ls(229 )/9 /,ls(230 )/93 /,ls(231 )/1 / % data ls(232 )/2 /,ls(233 )/32 /,ls(234 )/-1 / % data ls(235 )/33 /,ls(236 )/34 /,ls(237 )/35 / % data ls(238 )/36 /,ls(239 )/40 /,ls(240 )/41 / % data ls(241 )/44 /,ls(242 )/45 /,ls(243 )/47 / % data ls(244 )/63 /,ls(245 )/91 /,ls(246 )/10 / % data ls(247 )/9 /,ls(248 )/93 /,ls(249 )/124 / % data ls(250 )/1 /,ls(251 )/2 /,ls(252 )/32 / % data ls(253 )/33 /,ls(254 )/34 /,ls(255 )/35 / % data ls(256 )/36 /,ls(257 )/40 /,ls(258 )/41 / % data ls(259 )/42 /,ls(260 )/43 /,ls(261 )/44 / % data ls(262 )/45 /,ls(263 )/47 /,ls(264 )/63 / % data ls(265 )/91 /,ls(266 )/92 /,ls(267 )/10 / % data ls(268 )/9 /,ls(269 )/93 /,ls(270 )/123 / % data ls(271 )/124 /,ls(272 )/62 /,ls(273 )/1 / % data ls(274 )/2 /,ls(275 )/32 /,ls(276 )/33 / % data ls(277 )/34 /,ls(278 )/35 /,ls(279 )/36 / % data ls(280 )/40 /,ls(281 )/41 /,ls(282 )/42 / % data ls(283 )/43 /,ls(284 )/44 /,ls(285 )/45 / % data ls(286 )/47 /,ls(287 )/63 /,ls(288 )/91 / % data ls(289 )/92 /,ls(290 )/10 /,ls(291 )/9 / % data ls(292 )/93 /,ls(293 )/123 /,ls(294 )/124 / % data ls(295 )/1 /,ls(296 )/2 /,ls(297 )/32 / % data ls(298 )/33 /,ls(299 )/34 /,ls(300 )/35 / % data ls(301 )/36 /,ls(302 )/40 /,ls(303 )/42 / % data ls(304 )/43 /,ls(305 )/44 /,ls(306 )/45 / % data ls(307 )/47 /,ls(308 )/63 /,ls(309 )/91 / % data ls(310 )/92 /,ls(311 )/10 /,ls(312 )/9 / % data ls(313 )/93 /,ls(314 )/123 /,ls(315 )/124 / % data ls(316 )/1 /,ls(317 )/2 /,ls(318 )/32 / % data ls(319 )/33 /,ls(320 )/34 /,ls(321 )/35 / % data ls(322 )/40 /,ls(323 )/44 /,ls(324 )/45 / % data ls(325 )/63 /,ls(326 )/91 /,ls(327 )/93 / % data ls(328 )/1 /,ls(329 )/2 /,ls(330 )/33 / % data ls(331 )/34 /,ls(332 )/35 /,ls(333 )/37 / % data ls(334 )/40 /,ls(335 )/44 /,ls(336 )/45 / % data ls(337 )/63 /,ls(338 )/91 /,ls(339 )/93 / % data ls(340 )/1 /,ls(341 )/2 /,ls(342 )/35 / % data ls(343 )/10 /,ls(344 )/9 /,ls(345 )/1 / % data ls(346 )/5 /,ls(347 )/4 /,ls(348 )/3 / % data ls(349 )/32 /,ls(350 )/35 /,ls(351 )/10 / % data ls(352 )/9 /,ls(353 )/1 /,ls(354 )/5 / % data ls(355 )/4 /,ls(356 )/3 /,ls(357 )/32 / % data ls(358 )/-1 /,ls(359 )/36 /,ls(360 )/41 / % data ls(361 )/47 /,ls(362 )/10 /,ls(363 )/9 / % data ls(364 )/124 /,ls(365 )/32 /,ls(366 )/44 / % data ls(367 )/125 /,ls(368 )/2 /,ls(369 )/44 / % data ls(370 )/10 /,ls(371 )/9 /,ls(372 )/62 / % data ls(373 )/1 /,ls(374 )/2 /,ls(375 )/32 / % data ls(376 )/44 /,ls(377 )/62 /,ls(378 )/10 / % data ls(379 )/9 /,ls(380 )/1 /,ls(381 )/2 / % data ls(382 )/32 /,ls(383 )/10 /,ls(384 )/9 / % data ls(385 )/32 /,ls(386 )/10 /,ls(387 )/9 / % data ls(388 )/1 /,ls(389 )/2 /,ls(390 )/32 / % data ls(391 )/0 / % end #-t- lex.r 123300 ascii 05Jan84 07:46:12 #-h- missing 5329 ascii 15-Jan-84 21:22:11 ### appchr - append character onto the end of a string # # synopsis # call appchr( char, str ) # # passed # char: character to be added # str: character array of string char is to be added to # # returned # str with char appended onto the end # subroutine appchr( char, str ) character char, str(ARB) integer length call chcopy( char, str, length( str ) + 1 ) return end ### gitoc - convert integer n to string (base b) # # synopsis # number = gitoc (n, nstring, size, b) # # description # converts integer n to string (base b) # if b is not valid the number is given base 10 # if the whole number will not fit result is truncated on left # (the sign may also be omitted) # # passed # n - number to convert # size - size of nstring # b - the base to convert the string to # # returned # nstring - the result # gitoc - the number of characters required to represent the integer integer function gitoc (n, nstring, size, b) integer n character nstring(ARB) integer size integer b integer absval integer base integer i integer j integer t integer d string digits "0123456789abcdefghijklmnopqrstuvwxyz" integer mod absval = abs(n) if (b < 2 | b > 36) base = 10 else base = b i = 1 nstring(i) = EOS repeat { i = i + 1 d = mod (absval, base) nstring(i) = digits(d+1) absval = absval / base } until (absval == 0 | i >= size) if (n < 0 & i < size) { i = i + 1 nstring(i) = '-' } for (j = 1; j < i; j = j + 1) { t = nstring(i) nstring(i) = nstring(j) nstring(j) = t i = i - 1 } gitoc = i - 1 return end ### gtime - get current local time in tools format # # call gtime ( tstring ) # # description # returns the current time in the local time zone # into 'tstring' # # the time will be returned in the form # hh:mm:ss.hh # # returned # tstring - the time tstring in standard format subroutine gtime ( tstring ) character tstring(ARB) integer vector(7) integer item # get system time into vector call getnow ( vector ) # format string call prints ( tstring, "%02d:%02d:%02d.%02d", vector(4), # hours vector(5), # minutes vector(6), # seconds vector(7) / 10 ) # hundredths (convert from thousands) return end ### panic - output a message and stop # # synopsis # call panic(msg) # # description # writes out the passed msg to error output and then halts, without # doing any sort of cleanup (i.e. no call to endr4 is made) subroutine panic(msg) character msg(ARB) call remark(msg) stop 10 continue #modcomp fortran strikes again... return end ### rtoc - Convert a real number to a character string. # # synopsis # length = rtoc ( number, str, size ) # # description # converts the real number 'number' to a character string 'str' # length 'size'. # # passed # number - the real to be converted to character form # maxlen - the maximum length of the character string # # returned # length - the length of the character string, not # including EOS # integer function rtoc ( val, str, maxlen ) define(PRECIS,6) # precision in decimal digits of floating point numbers define(RNDCONST,0.555555) # rounding constant for floating point numbers implicit integer (a-z) real val, rval, pten, minval character str(maxlen) real aexp, res indx = 1 rval = val if ( rval < 0. ) { call addset ( '-', str, indx, maxlen ) rval = -rval } # round the value to whatever is appropriate for the # floating point precision. if ( rval == 0. ) { ndig = 1 exp = 0 } else { exp = alog10 ( rval ) + 0.00001 #add fudge factor # the following redundent calculation steps are for the modcomp. aexp = exp res = 10 ** aexp while (res > 10 * rval) { exp = exp - 1 aexp = exp res = 10 ** aexp } ndig = exp + 1 } pexp = 0 if ( ndig > PRECIS ) { # number needs a trailing exponent - scale it and # compute the exponent. pexp = ( exp / 3 ) * 3 exp = exp - pexp rval = rval / 10.**pexp } else if ( ndig <= 0 ) { pexp = ( exp / 3 - 1 ) * 3 exp = exp - pexp - 1 rval = rval / 10.**pexp } minval = 10. ** ( exp - PRECIS + 1 ) rval = rval + ( RNDCONST * minval ) # convert the integer part of the number. pten = 10. ** exp for ( ; exp >= 0; exp = exp - 1 ) { d = rval / pten call addset ( d + '0', str, indx, maxlen ) rval = rval - ( d * pten ) pten = pten / 10. } # if there's any fractional part, convert it. if ( rval >= minval ) { call addset ( '.', str, indx, maxlen ) while ( rval >= minval ) { minval = minval * 10. rval = rval * 10. d = rval call addset ( d + '0', str, indx, maxlen ) rval = rval - float ( ifix ( rval ) ) } } # if there's an exponent, add it. if ( pexp != 0 ) { call addset ( 'e', str, indx, maxlen ) k = itoc (pexp, str(indx), maxlen - indx) } else str(indx) = EOS return ( indx - 1 ) end #-t- missing 5329 ascii 15-Jan-84 21:22:11 #-t- lex.all 228984 ascii 15-Jan-84 21:26:07 #-h- lexskel.all 7345 ascii 05Jan84 07:52:20 #-h- lexskel.inc 648 ascii 05Jan84 07:49:15 #-h- lexskcom 518 ascii 05Jan84 07:49:00 # incl/lexskcom - common block for lib/lexskel define(BUFSIZE,1000) integer buffer(BUFSIZE) # circular buffer integer begbufp # char before first char in this run integer curbufp # last char processed integer endbufp # last char read in integer machcond # current start condition integer lexminsc # minimum value of start condition integer lexmaxsc # maximum value of start condition common /lexskl/ buffer, begbufp, curbufp, endbufp, machcond, lexminsc, lexmaxsc #-t- lexskcom 518 ascii 05Jan84 07:49:00 #-t- lexskel.inc 648 ascii 05Jan84 07:49:15 #-h- lexskel 6437 ascii 05Jan84 07:49:16 ############################################################################### # # # A lexical scanner generated by lex. # # # ############################################################################### # # version date initials remarks # ------- ---- -------- ------------------------------------------------------- # 01d 06nov83 tab .Changed lex debug constant to LXDDEBUG. Changed # lexscan to call lexinit the first time called. # 01c 21Oct83 tab .took out debug define, now done in lex with -d flag. # 01b 06sep83 VP .modified to use 'match' table of meta-equivalence # classes when indexing nxt/chk entries of templates # .added revision history # define(NIL,0) # don't change this value without changing it in lex define(BEGIN,call lexbegin(YYLEX_SC_$1)) define(ECHO,call lexecho) define(YYLEX_SC_0,0) integer function lexscan ( scanarg ) integer scanarg integer lexinterp, lextoken logical firstcall include "lexskcom" data firstcall /.true./ ~~ Section 1 code goes here. if ( firstcall ) { call lexinit firstcall = .false. } repeat { lextoken = lexinterp ( 0 ) ifdef(LXDDEBUG) call fprintf( ERROUT, "--accepting %d--@n", lextoken ) enddef switch ( lextoken ) { ~~ Case statements and user actions go here. } } return end ### lexinterp - run the machine to recognize a token # integer function lexinterp ( dummy ) integer dummy integer curstate, sym integer statebuf(BUFSIZE) # parallel to buffer, storing state numbers include "lexskcom" character lexinput integer bufp # the state machine is represented by several arrays. 'l' is indexed # by state number and gives a pointer into the 'a' array, which has # a list of those accepting numbers for the given state, terminated # by a 0 (NIL) value. 'b' and 'd' implement a base/default pair # which is indexed by state number. 'b' gives an index into the # next/check array, and 'd' gives a default base value (index into # 'b') to use if the index given by 'b' does not have the transition # information associated with it. 'n' and 'c' are the next/check # data structures. 'n' is indexed by the sum of the base index # given by 'b' for a given state and the equivalence class of the # input character, given by indexing the 'e' array with the character # read. If indexing 'c' with the same value as 'n' was indexed by # reveals that the Check value does not equal the value the base # array ('b') was index with, then that means that the Next value # given by 'n' is invalid. It is in this latter case that the default # value given by 'd' is used to determine a new base. 'm' is used # only for base values which correspond to Templates (those base # addresses indexed by numbers greater than FIRST_TEMPLATE_BASE). # It provides a mapping of equivalence class to meta-equivalence # class; the next/check pair for a template is determined by adding # the template's base value ( 'b(x)' where x is the template number ) # to the meta-equivalence class number ( 'm(e(inputchar))' ). This # somewhat weird 2-level equivalence class provides compression of # templates. ~~ declarations and data statements for state machine go here # Initialize this run. curstate = STARTSTATE begbufp = curbufp if ( buffer(curbufp) == '@n' ) { buffer(curbufp) = SYM_BOL curbufp = mod(curbufp+BUFSIZE-2,BUFSIZE)+1 } if ( machcond != 0 ) { buffer(curbufp) = machcond curbufp = mod(curbufp+BUFSIZE-2,BUFSIZE)+1 } # Simulate the machine until it jams. repeat { # Get the next character, either by reading it in, or if there # are some still left over from the last run, by simply advancing # curbufp. if ( endbufp == curbufp ) { endbufp = mod ( endbufp, BUFSIZE ) + 1 if ( endbufp == begbufp ) call error ( "lexinterp: buffer overflow" ) buffer(endbufp) = lexinput ( buffer(endbufp) ) } curbufp = mod ( curbufp, BUFSIZE ) + 1 sym = buffer(curbufp) if ( sym == EOF ) sym = SYM_EOF sym = e(sym) while ( c(b(curstate)+sym) != curstate ) { curstate = d(curstate) # it is Assumed that templates are NEVER chained; that means # that the default value for a template is ALWAYS the JAMBASE. # this means that if we are about to index into the base/def # pair for a template, we can change the 'sym' from being # the equivalence class of the input character to being the # meta-equivalence class of the input character. If the template # fails to Check, we will then default to the JAMBASE, which will # jam no matter what it is indexed with, including meta-equivalence # classes. if ( curstate >= FIRST_TEMPLATE_BASE ) sym = m(sym) } curstate = n(b(curstate)+sym) statebuf(curbufp) = curstate if ( curstate == 0 ) { # put back the character we just read curbufp = mod(curbufp+BUFSIZE-2,BUFSIZE)+1 break } if ( b(curstate) == JAMBASE ) break } # The machine has jammed. Figure out which pattern was accepted. for ( bufp=curbufp; bufp != begbufp; bufp=mod(bufp+BUFSIZE-2,BUFSIZE)+1 ) { lp = l(statebuf(bufp)) if ( lp != NIL ) { curbufp = bufp return ( a(lp) ) } } call remark ( "lexinterp: jammed with NO accepting states _ - shouldn't happen" ) call printf( "begbufp = %d, curbufp = %d, dump follows:@n", begbufp, curbufp ) for ( bufp=begbufp; bufp != mod(curbufp,BUFSIZE)+1; bufp=mod(bufp,BUFSIZE)+1) call printf( "statebuf[%d] = %d@n", bufp, statebuf(bufp) ) DRETURN return end ############################################################################### # # # User routines. # # # ############################################################################### # Section 3 code goes here. #-t- lexskel 6437 ascii 05Jan84 07:49:16 #-t- lexskel.all 7345 ascii 05Jan84 07:52:20 #-h- lexlb.all 5206 ascii 05Jan84 07:52:21 #-h- lexlb.doc 2314 ascii 05Jan84 07:51:13 .pl 64 .m1 2 .m2 3 .m3 3 .m4 3 .po 10 .rm 62 .bp 1 .in 0 .he ^lexlb(2)^%^lexlb(2)^ .fo ^^- # -^^ .in 5 .sp .ne 2 .fi .ti -5 NAME .br lexlb - lex scanner library .sp .ne 2 .fi .ti -5 SYNOPSIS .br .nf call lexinit call lexgtext( str, strlen ) call lexecho c = lexinput( c ) call lexbegin( sc ) i = lexscan( dummy ) .sp .ne 2 .fi .ti -5 DESCRIPTION .br .ne 3 .sp This library contains support routines for programs generated by the Lex tool. They are accessed by linking with the library .bd lexlb, and are used by any program written by Lex. The routines are: .ne 3 .sp .in +13 .ta 13 .ti -13 lexinit Initializes the scanner. Lexinit is called automatically the first time lexscan is invoked. Can be called by user to restart the scanner (i.e zero start conditions, set scanner up so that an initial beginning of line pattern (%) will be matched, and flush all scanning buffers). .in -13 .ne 3 .sp .in +13 .ta 13 .ti -13 lexgtext Returns in "str" the text of the most-recently matched pattern, but not more than "strlen" characters. .in -13 .ne 3 .sp .in +13 .ta 13 .ti -13 lexecho Writes the text of the most-recently matched pattern to the standard output. Accessible from lex programs via the macro .bd ECHO. .in -13 .ne 3 .sp .in +13 .ta 13 .ti -13 lexinput Returns the next input character from the standard input both as function value and in its argument. .in -13 .ne 3 .sp .in +13 .ta 13 .ti -13 lexbegin Begins the start condition numbered "sc". Accessible from lex programs via the macro .bd BEGIN. .in -13 .ne 3 .sp .in +13 .ta 13 .ti -13 lexscan Scans the input stream until a rule which has action associated with it to return is matched; also returns if an end of file is read. Function value is whatever value is associated with the return action. For an end of file, function value is EOF. .in -13 .ne 3 .sp Note that other versions of these routines may be used by putting the alternate code in the "user routines" section of a lex input file. .sp .ne 2 .fi .ti -5 SEE ALSO .br .nf lex(1), lextut(tutorial) .sp .ne 2 .fi .ti -5 FILES .br lexskcom - include file for common block .sp .ne 2 .fi .ti -5 AUTHOR(S) .br Vern Paxson and Jef Poskanzer. .sp .ne 2 .fi .ti -5 BUGS/DEFICIENCIES .br Other routines should be added to the library, particularly .bd lexmore, lexless, and .bd lexreject. #-t- lexlb.doc 2314 ascii 05Jan84 07:51:13 #-h- lexlb.inc 648 ascii 05Jan84 07:51:15 #-h- lexskcom 518 ascii 05Jan84 07:50:50 # incl/lexskcom - common block for lib/lexskel define(BUFSIZE,1000) integer buffer(BUFSIZE) # circular buffer integer begbufp # char before first char in this run integer curbufp # last char processed integer endbufp # last char read in integer machcond # current start condition integer lexminsc # minimum value of start condition integer lexmaxsc # maximum value of start condition common /lexskl/ buffer, begbufp, curbufp, endbufp, machcond, lexminsc, lexmaxsc #-t- lexskcom 518 ascii 05Jan84 07:50:50 #-t- lexlb.inc 648 ascii 05Jan84 07:51:15 #-h- lexlb 1854 ascii 05Jan84 07:51:16 ############################################################################### # # L E X L B # ############################################################################### # # version date initials remarks # ------- ------- -------- --------------------------------------------------- # 01a 29Jun83 VP,JP written # ############################################################################### ### lexinit - initialize for a lex scan # subroutine lexinit include "lexskcom" curbufp = 1 buffer(curbufp) = '@n' # so an initial `%' pattern will match endbufp = curbufp machcond = 0 return end ### lexgtext - get the current text string # # passed: # str: the string to return the token in # strlen: the length of str # # returns: # str: the token # subroutine lexgtext( str, strlen ) character str(ARB) integer strlen integer i, bufp, nextbufp include "lexskcom" bufp = mod( begbufp, BUFSIZE ) + 1 nextbufp = mod( curbufp, BUFSIZE ) + 1 for ( i=1; i < strlen & bufp != nextbufp; i=i+1 ) { str(i) = buffer(bufp) bufp = mod( bufp, BUFSIZE ) + 1 } str(i) = EOS return end ### lexecho - echo the current text onto STDOUT # subroutine lexecho integer bp, nbp include "lexskcom" nbp = mod( curbufp, BUFSIZE ) + 1 for ( bp = mod( begbufp, BUFSIZE ) + 1; bp != nbp; bp = mod( bp, BUFSIZE ) + 1 ) call putc( buffer(bp) ) return end ### lexinput - return next input character # character function lexinput( c ) character c, getc return getc( c ) end ### lexbegin - enter a start condition # subroutine lexbegin( sc ) integer sc include "lexskcom" if ( (sc < lexminsc | sc > lexmaxsc) & sc != 0 ) call error( "lexbegin: bad start condition" ) else machcond = sc return end #-t- lexlb 1854 ascii 05Jan84 07:51:16 #-t- lexlb.all 5206 ascii 05Jan84 07:52:21