1 EXTEND 2 ! Proaram Name : BNF & ! Package Name : BNF & ! Purpose : BNF Compiler & ! Institution : Seattle Pacific University & ! Date written : 18-Dec-82 & ! Written by : Greg Matthews and Alan Conroy & ! Version : 2 & ! Revision : A & ! Edit : 0 & ! TO THE GLORY OF GOD & ! & ! ******************************************************* & ! * * & ! * M 0 D I F I C A T 1 0 N H I S T 0 R Y * & ! * * & ! * DATE BY REASON * & ! * * & ! ******************************************************* & ! & ! ******************************************************* & ! * * & ! * P R 0 G R A M P U R P 0 S E * & ! * * & ! ******************************************************* & ! & ! This is the compiler for BNF lexical descriptions. See & ! manual for specifics. & ! & ! ******************************************************* & ! * * & ! * V A R I A B L E T A B L E * & ! * * & ! ******************************************************* & ! & ! A Dummy variable used for VAL, etc & ! A$ Dummy variable used for comparisons & ! etc. & ! A% Dummy variable used for INSTR, etc. & ! B% Same as A% & ! C% Same as A% & ! CCL% Flag that is set when the CCL entry & ! is used. & ! Character$ The current (or last) character & ! retrieved from the source file. & ! Character% The ASCII value of Character$ & ! Current.line$ The current source line as it is & ! built one character at a time for & ! output to the list file & ! Current.production% Used for loop through the sub- & ! productions of the current production & ! Current.switch$ The value of the current switch that & ! we are parsing & ! Dummy% Dummy variable used for returning & ! values from functions which really & ! don't return values, etc & ! End.of.source% True if the ".END" was found in the & ! source file by the parser. & ! Errlocation%(x) The third parameter of FNError$. & ! It is the location in Current.line$ & ! where the caret (^) is to be printed & ! under. & ! Errnum% The first parameter of FNError$. & ! It is the error number to be used & ! in the lookup in tne Error$ array & ! which contains the error texts. & ! Error$(x) The array which contains the error & ! texts for current line. & ! Errors% The error counter. Also used as an & ! error flag in the parsing of the & ! command line. & ! Errtype% The second parameter of FNError$. & ! This flag is tested and if true, & ! the error function will print the & ! error and exit the program; if false & ! the error function simply returns the & ! requested error message. & ! Extra$ Any extra input after the source file & ! name and before switches (illegal) & ! Filename$ The name of the source file (without & ! the extension or period. ) & ! FL.EOF% A flag that is set when the end of & ! the input source file is reached. & ! Following.productions% The number of subproductions to follow & ! the current indirect terminal we're & ! looking at & ! Free% Pointer to the first free loaction in & ! the heap. & ! Heap$ Used for symbol table lists. & ! Identifier% The sequence number of the name node & ! in the symbol table to be passed to & ! the parser. & ! In$ The command line for the compilation & ! Job% The current job's number & ! Keyword$ Holds name of keyword & ! Keyword% Loop variable for reading-in keywords & ! Keywords% The number of keywords in data & ! statements. & ! Length.of.terminal% Used to hold the length of the & ! terminal symbol after reading data & ! and before placing it into the & ! Production$ array & ! Lexival% The value of the current token passed & ! back to the lexical analyzer from & ! the scanner. & ! List.line% The number of the current line for & ! printing out to the list file & ! List.production% The number of the current production & ! being examined, for printing out to & ! the source file & ! List.sub.production% The number of the current sub- & ! production for printing out to the & ! list file & ! Lst$ The name of the list file. & ! Match.compare$ The string that last matched the & ! character(s) the during production & ! matching. & ! Match.compare% The length of Match.compare$ & ! Non.terminal% The value of the production for the & ! non-terminal at the current production & ! during the reading-in of data. & ! Number.following% The number of sub-productions to & ! follow the current production when & ! reading in data. & ! Number.of.productions% The number of productions residing & ! in the data statements & ! Number.of.tokens% The number of tokens residing in & ! the data statements. & ! Object$ The name of the object file. & ! OK% Boolean value used during switch & ! parsing, to say whether or not the & ! switch is valid. & ! Operand$ The "cleaned-up" version of In$. & ! (no switches, extra files, etc) & ! Position% The current position in Switch$ & ! that we are at when parsing the & ! switches & ! Previous.production% The last production we were at & ! (0 if none or unknown) & ! Previous.sub.production% The last subproduction we were at & ! (in Previous.production%) & ! Print. inhibit% The number of characters to ignore & ! during the listing-print-out to & ! avoid double-printing them. Happens & ! only if we had to jump back to the & ! last production. & ! Production$(n) The set of productions (1 to n) & ! PSF% Flag that is set when the PSF Chain & ! entry is used. & ! Replace.char% A boolean value: & ! TRUE = Backup source-input pointer & ! one character & ! FALSE = Input routine works normally & ! Scan.production% The current production (never a & ! subproduction) where we are during & ! the scan. & ! Sequence% The current number for sequence & ! numbers handed out during additions & ! to the symbol table. & ! Source$ The name of the source file & ! Source.input$ The data fielded for the source file & ! (input) buffer. & ! Source.position% The current position of the input & ! pointer in Source.input$ & ! Source.record% The current position of the buffer & ! for the source file (record number) & ! Source.size The size of the Source file (in & ! 512kb blocks). & ! Stack%(n) The stack. & ! Switch$ The list of all switches entered as- & ! part of the command line & ! Switch$(n) The list of valid switches & ! Switches% The number of switches existing in & ! the Switch$ array & ! Symbol$ Originally the name of the & ! symbol-table (Xref) file & ! later, the literal representation & ! of the current symbol referred to & ! by Lexival% & ! Temp$ The name of the temporary (immediate) & ! file & ! Term$ The string value for the terminal 1eft & ! after being read in from data & ! Term% Used for loop when building Term$ & ! Terminal.value% Read from data once for each terminal & ! value & ! Tree.identifier% Pointer to the first node in tne heap & ! where the identifier list is. & ! Tree.literal% Pointer to the first node in the heap & ! where the literal list is. & ! Warnings% The warning counter. & ! & ! ******************************************************* & ! * * & ! * F I L E D E S C R I P T I O N S * & ! * * & ! ******************************************************* & ! & ! Channel Description & ! 1 _KB:BNF.CMD Keyboard for command & ! line and error printing & ! 2 Temp$ The intermediate code & ! (TEMPnn.TMP) file (nn is the job & ! number) & ! 3 Source$ The source (input) file & ! 4 Symbol$ The symbol/Xref (output) & ! file & ! 5 Lst$ The List (output) file & ! 6 Object$ The object (target output) & ! file & ! 12 Stack%(n%,2%) Temp file for stack. & ! (0,0) indicates the top of stack & ! & ! ******************************************************* & ! * * & ! * W H O D O N E I T * & ! * * & ! ******************************************************* & ! & ! LEXICAL ANALYZER Greg & ! Search routine Greg & ! PARSER: & ! .ASSIGN Greg & ! TRAVERSE FUNCTION Greg & ! ALLOCATE FUNCTION Greg & ! FREE FUNCTION Greg & ! LINK FUNCTION Greg & ! ERROR INITIALIZATION Greg & ! ERROR FUNCTION Greg & ! GET CHARACTER Greggie-poo & 3 ! ******************************************************* & ! * * & ! * D I M E N S I O N S T A T E M E N T S * & ! * * & ! ******************************************************* & ! & 4 ! ******************************************************* & ! * * & ! * C O N S T A N T D E C L A R A T I O N S * & ! * * & ! ******************************************************* & ! & .DEFINE .True%=-1% ! Standard boolean TRUE value \ .DEFINE .False%=0% ! Standard boolean FALSE value & 5 DIM #12%, Stack%(8192%,2%) & \ DIM Production$(94%), Constant$(94%), Production.table$(94%), & Token%(255%,2%), Index%(2%,94%), Error$(10%) 6 ON ERROR GOTO 29000 ! Set up standard error trap 7 .DEFINE .Production%=0% ! First subscript for stack & \ .DEFINE .Sub.Production%=1% ! Second subscript for stack & \ .DEFINE .Part%=2% ! Third subscript for stack & \ .DEFINE .Name.type%=1% ! Name Type flag. & \ .DEFINE .Data.type%=2% ! Data type flag. & \ .DEFINE .Nil%=O% ! End of list symbol & \ .DEFINE .Stack.size%=100% ! Size of stack & 10 GOSUB 28000 ! initiailze tiies) etc & \ PRINT #1%,'BNF V02A',DATE$(0%);' ';TIME$(O%) UNLESS CCL% 20 Errors%=0% ! Reset error flag & \ IF NOT CCL% & THEN & PRINT #1%,'* '; ! Display prompt & INPUT LINE #1%,In$ ! Get input 30 In$=CVT$$(In$,189%) & \ PRINT #1%,'' IF CCPOS(1%) & \ GOTO 20 IF LEN(In$)=0% 50 Operand$=In$ & \ GOSUB 400 ! Parse filename & IF Errors% & THEN & GOTO 32767 IF CCL% & \ GOTO 20 60 IF LEN(Switch$)>0% & THEN & GOSUB 300 ! Parse switches & \ IF Errors% & THEN & GOTO 32767 IF CCL% & \ GOTO 20 70 Source$=Source$+'.BNF' IF INSTR(1%,Source$,'.')=0% & \ Symbol$=Symbol$+'.STB' IF INSTR(1%,Symbol$,'.')=0% & \ Lst$=Lst$+'.LST' IF INSTR(1%,Lst$,'.')=0% & \ Object$=Object$+'.OBJ' IF INSTR(1%,Object$,'.')=0% & ! Place default extensions on the end of those filenames that have no & ! extension & \ IF LEN(Extra$)>0% & THEN & PRINT #1%,'?Too many source files' & \ GOTO 20 IF CCL% & \ GOTO 32767 80 OPEN Source$ FOR INPUT AS FILE 3%, RECORDSIZE 1536% Open source file 81 A$=SYS(CHR$(l2%)) & \ Source.size=(ASCII(MID(A$,4%,1%))*65536) & +(ASCII(MID(A$,14%,1%))*256) & + ASCII(MID(A$,13%,1%)) 90 OPEN Symbol$ FOR OUTPUT AS FILE 4% ! Open symbol file 91 PRINT #4%,STRING$(2%,10%) & \ PRINT #4%,'BNF cross-reference of ';Source$;' on ';DATE$(0);' at ',TIME$(0) & \ PRINT #4%,'' & \ PRINT #4%,'Production','Sub-productions','Status','Sequence','Line(s)' & \ PRINT #4%,'' 100 OPEN Lst$ FOR OUTPUT AS FILE 5% ! Open list file 101 PRINT #5%,STRING$(2%,10%) & \ PRINT #5%,'BNF compilation of ';Source$;' on ';DATE$(0%);' at ';TIME$(0) & \ PRINT #5%,'' & \ PRINT #5%,'Line', 'Production','Sub-production','Statement' & \ PRINT #5%,'' 110 OPEN Object$ FOR OUTPUT AS FILE 6% ! Open object file 120 Errors%,Warnings%=O% ! Reset error and warning flags & \ Source.record%=O% & \ GET #3% & \ FIELD #3%,1536% AS Source.input$ & \ LSET Source.input$=STRING$(512%,O%)+LEFT(Source.input$,1024%) & \ GOSUB 1000 ! Call the lexical analyzer & 200 ! Wrap-up & PRINT #5%,'' & \ PRINT #5%,'Errors detected:';Errors% & \ PRINT #5%,"Warnings: ';Warnings% & \ PRINT #1%,'' & \ PRINT #1%,'Errors detected:';Errors% IF Lst$<>'KB:.LST'' & \ PRINT #1%,'Warnings: ';Warnings% IF Lst$<>'KB:.LST' & ! Display errors and warnings & \ GOSUB 20000 ! Print the cross-reference listing & \ CLOSE 1%,2%,3%,4%,5%,6% ! Close files & \ GOTO 32767 ! and end & 300 ! Parse swlitches 340 Position%=11% & \ RETURN IF Position%>LEN(Switch$) & \ OK%=.False% & \ A%=INSTR(Position%+1%,Switch$+'/','/') & \ Current.switch$=MID(Switch$,Position%+1%,A%-Position%-1%) & \ B%=INSTR(1%,Current.switch$+',',',')-1% & \ Position%=A% & \ FOR A%=I% TO Switches% & IF LEFT(Switch$(A%),1%)='.' & THEN & IF LEFT(Current.switch$,B%)=RIGHT(Switch$(A%), 2) & THEN & 340 & ELSE & 360 341 NEXT A% 342 ! Look for ":#" and ":$" directives & C%=INSTR(1%,Switch$(A%),':') & \ IF C%=0% & THEN & 350 & ELSE & IF LEFT(Current. switch$,B%) <> & LEFT(Switch$(A%),C%) & THEN & 350 & ELSE & A$=RIGHT(Switch$(A%),C%+1%) & \ IF A$<>'#' AND A$<>'$' & THEN & 350 & ELSE & IF A$='$' & THEN & OK%=.True% & \ GOTO 350 345 A$=RIGHT(LEFT(Current.switch$,B%),C%+1%) & \ A=VAL(A$) & \ OK%=.True% 350 IF LEFT(Current.switch$,B%)<>Switch$(A%) AND OK%=.False% & THEN & 360 & ELSE & GOTO 340 360 PRINT #1%,'?Switch error - /';Current.switch$ & \ Errors%=.True% & \ RETURN 400 ! Parse filename & \ Operand$=CVT$$(Operand$,-1%) & \ A%=INSTR(1%,Operand$,'=') & \ IF A%=0% & THEN & PRINT #1%,'?Missing file specification' & \ Errors%=.True% & \ RETURN 401 Source$=RIGHT(Operand$,A%+1%) & \ Operand$=LEFT(Operand$,A%-1%) & \ A$=SYS(CHR$(6%)+CHR$(-23%)+Source$) 402 Switch$=RIGHT(Source$,LEN(Source$)-RECOUNT+I%) & \ Source$=LEFT(Source$,LEN(Source$)-RECOUNT) & \ A%=INSTR(1%,Operand$+',',',') & \ Object$=LEFT(Operand$,A%-1%) & \ Lst$=RIGHT(Operand$,A%+1%) 410 A$=SYS(CHR$(6%)+CHR$(-10%)+Object$) 420 A%=INSTR(1%,Lst$+',',',') & \ Symbol$=RIGHT(Lst$,A%+1%) & \ Lst$=LEFT(Lst$,A%-1%) & \ A$=SYS(CHR$(6%)+CHR$(-10%)+Lst$) 425 A$=SYS(CHR$(6%)+CHR$(-10%)+Symbol$) IF LEN(Symbol$)>0% 427 A%=INSTR(1%,Source$+'.','.') & \ Filename$=LEFT(Source$,A%-1%) & \ A%=INSTR(1%,Filename$+':',':') & \ Filename$=RIGHT(Filename$,A%+1%) IF A% or '' and capitalize all letters & \ GOTO 1020 ! Jump over sequence number finder routine. & IF ((Lex.tmp%<>60%) AND (Lex.tmp%<>39%)) ! if we don't & ! have a literal or an identifier. & \ IF Lex.tmp%=39% ! If it's a terminal & THEN Lex.search%=1% ! then it's a literal. & ELSE IF LEFT(Symbol$,1%)="<" ! Else if it's a comment & THEN 1020 ! then jump over sequence & ELSE Lex.search%=2% ! Else it's an identifier. 1010 GOSUB 1100 ! Go search the tahle & \ IF Identifier%<>0% ! If it wasn't in the table... & THEN 1017 & ELSE & Sequence.identifier%=Sequence.identifier%+1% & IF Lex.search%=2% & \ Sequence.literal%=Sequence.literal%+1% & IF Lex.search%=1% & ! Increment the proper sequence number & \ Sequence%=Sequence.identifier% & IF Lex.search%=2% & \ Sequence%=Sequence.literal% & IF Lex.search%=1% & ! Put the proper value into the sequence number variable & \ Lex.type%=Lex.search% & & \ Lex.type%=3% IF Lex.type%=2% & & \ Lex.add$=CHR$(.Name.type%)+CVT%$(Sequence%)+ & CHR$(LEN(Symbol$))+ & Symbol$+STRING$(2%,0%)+CHR$(Lex.type%)+STRING$(6%,0%) & ! Build the string to add, & \ Lex.add.ptr%=FNAllocate%(Lex.add$) ! Add it, & \ Index%(Lex.search%,Sequence%)=Lex.add.ptr% ! Remember & ! the Alamo, I mean, the pointer for this sequence & \ 1F link.root%<>0% & THEN & 1015 & ELSE & IF Lex. search%=1% & THEN & Tree.Literal%=Lex.add.ptr% & \ GOTO 1016 1014 ! ELSE & Tree.identifier%=Lex.add.ptr% & \ GOTO 1016 1015 Lex.tmp%=FNLink%(Link.root%,Lex.add.ptr%,Link.type$) & ! Link it in, 1016 Identifier%=Sequence% ! and Get the sequence number. 1017 ! Add/modify data node for current line & Root%=Index%(Lex.search%,Identifier%) & \ Data.node%=FNTraverse%(Root%,'D') 1018 IF Data.node%=0% ! If a data node for the current line is absent & THEN & Data.node$=CHR$(2%)+CVT%$(List.line%)+CVT%$(l%)+ & STRING$(3%,0%) ! Create one & \ Data.ptr%=FNAllocate%(Data.node$) ! add it, & \ Lex.tmp%=FNLink%(Root%,Data.ptr%,'D') ! and link it & \ GOTO 1020 ! in. 1019 ! See if this node is for the current line & IF ASCII(MID(Heap$,Data.node%+l%,1%))<>List.line% & THEN ! If not, try again & Root%=Data.node% & \ Data.node%=FNTraverse%(Data.node%,'D') & \ GOTO 1018 1020 GOSUB 2000 ! Go to the Parser. & \ GOTO 1000 ! Go back and do it all again. 1090 RETURN ! End of Lexical Analyzer. & 1110 ! ! ******************************************************* ! * * ! * S E A R C H R O U T I N E * ! * * ! ******************************************************* ! ! This routine searches the table for the passed node. If it ! finds it, it returns the sequence number of the node. If it ! doesn't find it, it returns the information needed to add the ! node to the table, and link it up in the correct place. ! ! LOCAL VARIABLES: ! ! Old.start.ptr% Used to store root node if link will ! need to be done. ! Search.compare$ Value in current node that is being- ! checked against the node we're ! searching for. ! Start.ptr% Pointer to current node that is being ! checked against the node were ! searching for. Identifier%=0% ! Initialize sequence number to zero. \ Link.root%=0% ! Initialize link.root to nil \ IF ((Lex.search%=1%) OR (Lex.search%=2%)) THEN 1110 ELSE PRINT CHR$(7%);"?Search routine error - invalid Lex.search% var" \ GOTO 32767 ! If we don't have a literal or an identifier ! bomb out, otherwise continue. 1110 IF Lex.search%=I% If we have a literal THEN IF Tree.literal%=0% ! then if it's the first... THEN RETURN ! then go back. ELSE Start.ptr%=Tree.literal%! Else, start at the top. ELSE Start.ptr%=Tree.identifier% 1120 Search.compare$=MID(Heap$,Start.ptr%+4%,(ASCII(MID(Heap$,Start.ptr% +3%,1%)))) ! Get the string to compare. \ IF Search.compare$=Symbol$ ! If we found it THEN 1140 ! then jump to the end. ELSE IF Search.compare$0% ! If there was a right node... THEN 1120 ! then continue searching. ELSE Link.root%=Old.start.ptr% ! Else, we need ! to add it, so get the needed data... \ Link.type$="R" \ RETURN ! and return. 1130 IF Search.compare$>Symbol$ ! If we're after it... THEN Old.start.ptr%=Start.ptr% ! then save the root, \ Start.ptr%=FNTraverse%(Start.ptr%,"L") ! and get the left node \ IF Start. ptr%,<>0% ! If there was a left node. THEN 1120 ! then continue searching. ELSE Link.root%=Old.start.ptr% ! Else, we need to ! add it, so get the needed data... \ Link.type$="L" RETURN and return. 1140 Identifier%=CVT$%(MID(Heap$,Start.ptr%+1%,2%)) ! Get the sequence \ RETURN ! End of search routine. 2000 ! & ! ******************************************************* & ! * * & ! * P A R S E R R O U T I N E * & ! * * & ! ******************************************************* & ! & ! This routine does the syntax analysis and generates the & ! intermediate code. This is called by the lexical analyzer, & ! and is passed lexical information for each token from the & ! source file. & ! & RETURN IF Lexival%=8% OR (Lexival%=2% AND LEFT(Symbol$,1%)='<') & ! Return if a blank or a comment & \ ON Stage% GOTO & 2010, ! .ASSIGN & 3000, ! Productions & 4000, ! .KEYWORD & 5000, ! .TOKEN & 6000 ! .END & 2010 ! & ! ******************************************************* & ! * * & ! * A S S I G N P A R S E R * & ! * * & ! ******************************************************* & ! & ! This routine parses the .ASSIGN stage of the BNF Source. It & ! also builds the Constant Table for those defined by the .ASSIGN & ! Statements and writes the data to be used by the cross-reference & ! listing. & ! & Assign.part%=Assign.part%+1% ! Increment part flag & \ IF Assign.part%>4% ! If we're over the top & THEN Assign.part%=0% ! Then go back to the bottom & \ GOTO 2010 ! and try again 2020 ON Assign.part% GOTO & 2030, ! .ASSIGN & 2040, ! Constant & 2090, ! Assignop & 2100 ! Value 2030 IF Symbol$=".ASSIGN" ! If we got a ASSIGN & THEN RETURN ! Then we're okay & ELSE Stage%=Stage%+l% ! Else increment stage counter & \ GOTO 2000 ! and go to beginning of Parser 2040 IF Lexival%<>2% ! If we havent got a production & THEN PRINT #5%, FNError$(3%,.False%,LEN(Current.line$)) & ! Then print error & Stage%=Stage%+1% & \ GOTO 2000 ! and go to beginning of Parser 2050 Constant.sequence%=rdentifier% ! Save sequence number & \ Constant.ptr%=FNSecond%(Index%(2%,Identifier%))+2% ! Find type flag & \ Heap$=LEFT(Heap$,Constant.ptr%-1%)+CHR$(2%)+RIGHT(Heap$,Constant.ptr%+1%) & ! Set it to constant & \ Constant.old.ptr%=Index%(2%,Identifier%) ! Save root & \ Constant.ptr%=FNTraverse%(Constant.old.ptr%,"D") ! Get data node 2060 IF Constant.ptr%=0% ! If no data node & THEN 2070 ! Then skip & ELSE IF CVT$%(MID(Heap$,Constant.ptr%+1%,2%))=List.line% & ! Else if we're on the right one & THEN 2080 ! Then skip & ELSE Constant.old.ptr%=Constant.ptr% ! Else save root & \ Constant.ptr%=FNTraverse%(Constant.ptr%,"D") & \ GOTO 2060 ! Get next and try again 2070 Constant.add$=CHR$(.Data.type%)+CVT%$(List.line%)+CVT%$(0%)+STRING$(3%, & ! Build string to add & \ Constant.ptr%=FNAllocate%(Constant.add$) ! Add it & \ Constant.tmp%=FNLink%(Constant.old.ptr%,Constant.ptr%,"D") ! Link 2080 Heap$=LEFT(Heap$,Constant.ptr%+2%)+CVT%$(CVT$%(MID(Heap$,Constant.ptr% & +3%,2%))+1%)+CHR$(1%)+RIGHT(Heap$,Constant.ptr%+6%) & ! Increment number of references and set use flag to & ! defined & \ RETURN ! We're done 2090 IF Symbol$="::=" ! If we have an assignop & THEN RETURN ! Then we're okay & ELSE PRINT #5%, FNError$(3%,.False%,LEN(Current.line$)) & ! Else print error & \ Stage%=Stage%+1% ! Increment stage counter & \ GOTO 2000 ! and go to beginning of Parser 2100 IF Lexival%<>7% ! If we don't have a value & THEN PRINT #5%, FNError$(3%,.False%,LEN(Current.line$)) & ! Then print error & Stage%=Stage%+1% ! Increment stage counter & GOTO 2000 ! and go to beginning of Parser 2110 Constant$(Constant.sequence%)=Symbol$ & ! Write information to Constant Table & \ RETURN ! we-re oune 3000 ! & ! ******************************************************* & ! * * & ! * P R O D U C T I O N P A R S E R * & ! * * & ! ******************************************************* & ! & ! This routine parses the Production portion of the BNF Source. & ! & ON Production.state%+1% GOTO 3010,3100,3200,3300,3400 & 3010 ! PRODUCTION STATE 0 - Starting point & IF Lexival%=l% & THEN Stage%=Stage%+l% & \ GOTO 2000 3020 IF Lexival%<>2% ! If no production & THEN PRINT #5%, FNError$(3%,.False%,LEN(Current.line$)) & \ RETURN 3030 ! Check for previous assignment & Node%=Index%(2%,Identifier%) & \ Type%=ASCII(MID(Heap$,FNSecond%(Node%)+2%,1%)) & \ IF (Type% AND 7%)<>0% AND (Type% AND 7%)<>3% ! If predefined & THEN PRINT #5%, FNError$(7%,.False%,LEN(Current.line$)) & \ RETURN 3040 ! Follow data links to the current line & & Data.node%=FNTraverse%(Node%,'D') & & \ Node%=Data.node% 3050 IF Data.node%=0% & THEN & PRINT '?Corrupt symbol table' & \ GOTO 32767 3060 IF CVT$%(MID(Heap$,Data.node%+l%,2%))<>List.line% & THEN & Node%=Data.node% & \ Data.node%=FNTraverse%(Data.node%,'D') & \ GOTO 3060 3070 Use%=ASCII(MID(Heap$,Data.node%+5%,l%)) & \ IF (Use% AND 1%) & THEN & PRINT #5%,FNError$(3%,.False%,LEN(Current.line$)) & \ RETURN 3080 Heap$=LEFT(Heap$,Data.node%+4%)+CHR$(Use% OR 1%)+ & RIGHT(Heap$,Data.node%+6%) & \ List.production%=List.production%+1% & \ Production$='' & \ List.sub.production%=0% & \ Production.set%=Identifier% ! Save production number & \ Production.state%=1% & \ RETURN & 3100 ! PRODUCTION STATE 1 - Just parsed production & IF Lexival%=3% ! Parse & THEN Production.state%=2% & \ RETURN 3110 PRINT #5%, FNError$(8%,.False%,LEN(Current.line$)) & \ Stage%=Stage%+1% & \ GOTO 3500 3200 ! PRODUCTION STATE 2 - Just parsed ::= & IF Lexival%<>2% AND Lexival%<>5% ! If not a valid terminal & THEN PRINT #5%, FNError$(3%,.False%,IFN(Current.line$)) & \ Stage%=Stage%+1% & \ GOTO 3500 3205 List.sub,production%=List.sub.production%+1% 3210 IF Lexival%=5% ! If a literal & THEN Production$=Production$+CVT%$(LEN(Symbol$)) & \ Production$=Production$+CVT%$(ASCII(MID(Symbol$,A%,1%))) & FOR A%=l% TO LEN(Symbol$) & \ Production.state%=3% & \ PETURN 3220 Production$=CVT%$(I%)+CVT%$(-Identifier%) & \ Production.state%=3% & \ RETURN 3300 ! PRODUCTION STATE 3 - Just parsed terminal & IF Lexival%=4% ! If it's a | & THEN & Production.table$(Production.set%)=Production.table$(P & +CVT%$(0%)+Production$ & \ Production$='' & \ Production.state%=2% & \ RETURN 3310 IF Lexival%<>2% ! If not a production & THEN Stage%=Stage%+1% & \ Production.table$(Production.set%)=Production.table$(Production & CVT%$(O%)+Production$ & \ GOTO 3500 3320 Production$=CVT%$(Identifier%)+Production$ & \ Production$='' & \ Production.state%=4% & \ RETURN & 3400 ! PRODUCTION STATE 4 - Just parsed non-terminal & IF Lexival%<>4% AND Lexival%<>3% ! If not ::= or | & THEN Production.table$(Production.set%)=Production.table$(Production & +Production$ & \ IF Lexival%<>2% ! If not a production & THEN Stage%=Stage%+1% & \ GOTO 3500 3410 IF Lexival%=2% ! If a production & THEN Production.state%=0% ! Let state 0 set everything up & \ Production.table$(Production.set%)=Production.table$(Production & Production$ ! Finish up this production & \ GOTO 2000 3420 IF Lexival%=3% ! If a ::= & THEN Production.table$(Production.set%)=Production.table$(Production & CVT%$(0%)+RIGHT(Production$,3%) & \ Production.set%=CVT$%(Production$) & \ Production$='' & \ List.production%=List.production%+1% & \ List.sub.production%=0% & \ Production.state%=2% & \ RETURN 3430 Production.state%=2% ! Otherwise it's a | & \ Production.table$(Production.set%)=Production.table$(Production.set%)+ & \ Production$='' & \ RETURN & 3500 ! Check indirect terminals to make sure they're really terminals & Current.prodUCtion%=0% & \ List.production%=0% & \ List.sub.production%=0% 3510 Current.production%=Current.production%+1% & \ GOTO 2000 & IF LEN(Production.table$(Current.production%))=0% & \ Check.production%=CVT$%(MID(Production.table$(Current.production%),5%, 2 & \ GOTO 3510 & IF Check.production>=0% & \ Check.production%=-Check.production% & \ IF CVT$%(MID(Production.table$(Check.production%),5%,2%))<0% OR & CVT$%(Production.table$(Check.production%))<>0% & THEN PRINT #5%, FNError$(9%,.False%,0%);" - ";MID(Heap$, & Index%(2%,Current.production%)+4%,ASCII(MID(Heap$, & Index%(2%,Current.production%)+3%,1%))) & \ GOTO 3510 & 4000 ! & ! ******************************************************* & ! * * & ! * P A R S E K E Y W O R D * & ! * * & ! ******************************************************* & ! & ! This routine parses the KEYWORD section of the BNF Source. & ! & ON Keyword.state%+1% GOTO 4010,4100,4200 4010 ! KEYWORD STATE 0 - Just starting & IF Lexival%<>1% ! If not a directive & THEN Stage%=Stage%+I% & \ GOTO 2000 4020 IF Symbol$<>".KEYWORD" ! If wrong directive & THEN Stage%=Stage%+1% & \ GOTO 2000 ! Skip this stage 4030 Keyword.state%=Keyword.state%+1% & \ RETURN ! Prepare for next state and exit 4100 ! Just parsed .KEYWORD or comma & IF Lexival%<>5% ! If not a literal & THEN PRINT #5%, FNError$(6%,.False%,LEN(Current.line$)) & \ Keyword.state%=1% & \ GOTO 2000 4110 Keyword$=Keyword$+CVT%$(LEN(Symbol$))+Symbol$ & \ Keyword.state%=2% & \ RETURN 4200 ! Just parsed literal & IF Lexival%<>9% ! If not a comma, go to next stage & THEN Stage%=Stage%+1% & \ GOTO 2000 4210 Keyword.state%=1% & \ RETURN & 4000 ! & ! ******************************************************* & ! * * & ! * P A R S E T O K E N * & ! * * & ! ******************************************************* & ! & ! This routine parses the TOKEN section of the BNF Source and & ! builds the Token Table. & ! & Token.part%=Token.part%+1% ! Increment part flag & \ IF Token.part%>8% ! If we're over the top & THEN Token.part%=2% ! Then reset & \ GOTO 5000 ! and try again 5010 ON Token.part% GOTO & 5020, ! .TOKEN & 5030, ! ::= & 5040, ! | & 5060, ! Terminal (indirect possible) & 5100, ! comma #1 & 5110, ! Nonterminal & 5130, ! comma #2 & 5140 ! Value 5020 Token.first%=.True% ! Set first flag & \ IF Symbol$=".TOKEN" ! If we have a TOKEN & THEN RETURN ! Then we're okay & ELSE PRINT #5%, FNError$(10%,.False%,LEN(Current.line$)) & ! Else print error & \ Stage%=Stage%+1% ! Increment stage counter & \ GOTO 2000 ! and go to beginning of Parse 5030 IF Symbol$="::=" ! If we have a ::= & THEN RETURN ! Then we're okay & ELSE PRINT #5%, FNError$(8%,.False%,LEN(Current.line$)) & ! Else print error & \ Stage%=Stage%+1% ! Increment stage counter & \ GOTO 2000 ! and go to beginning of Parse 5040 IF Token.first%=.True% ! If first flag set & THEN Token.first%=.False% ! Then unset it & \ GOTO 5000 ! and skip this part 5050 IF Lexival%=4% ! If it's a separator & THEN RETURN ! Then we're okay & ELSE Stage%=Stage%+1% ! Else increment stage counter & \ GOTO 2000 ! and go to beginning of Parse 5060 IF ((Lexival%<>5%) AND (Lexival%<>2%)) ! If it's not a terminal & ! or an indirect terminal & THEN PRINT #5%, FNError$(3%,.False%,LEN(Current.line$)) & \ Stage%=Stage%+1% ! Increment stage counter & \ GOTO 2000 ! and go to beginning of Parse 5070 ! Need to check if indirect terminal, and if a legal indirect & ! terminal. If so, need to save info for storing in Token Table. & RETURN ! We're done 5100 IF Lexival%=9% ! If it's a comma & THEN RETURN ! Then we're okay & ELSE PRINT #5%, FNError$(3%,.False%,LEN(Current.line$)) & ! Else print error & \ Stage%=Stage%+1% ! Increment stage counter \ GOTO 2000 ! and go to beginning of Parse & 5110 IF Lexival%<>2% ! If it's not a nonterminal & THEN PRINT #5%, FNError$(3%,.False%,LEN(Current.line$)) & ! Then print error & \ Stage%=Stage%+1% ! Increment stage counter & \ GOTO 2000 ! and go to beginning of Parser 5120 ! Need to save info for storing in Token Table. & RETURN ! We're done 5130 GOTO 5100 ! Why write the same routine twice? 5140 IF Lexiva1%<>7% ! If it's not a value & THEN PRINT #5%, FNError$(3%,.False%,LEN(Current.line$)) & ! Then print error & \ Stage%=Stage%+1% ! Increment stage counter \ GOTO 2000 ! and go to beginning of Parse & 5150 ! Need to write info to Token Table. RETURN ! We're done 6000 ! & ! ******************************************************* & ! * * & ! * P A R S E E N D * & ! * * & ! ******************************************************* & ! & ! This routine parses the .END part of the BNF Source. & ! & IF Lexival%<>1% ! Wait for directive & THEN PRINT #5%,FNError$(4%,.False%,LEN(Current.line$)) & \ RETURN 6010 IF Symbol$<>".END" & THEN PRINT #5%,FNError$(4%,.False%,LEN(Current.line$)) & \ RETURN 6020 End.of.source%=.True% & \ CLOSE 3% ! Check for undefined symbols & \ FOR Current.production%=1% TO Sequence.identifier%-1% & \ Type%=ASCII(MID(Heap$,FNSecond%(Index%(2%,Current.production%) & +2%,1%)) & & \ GOTO 6050 IF (Type%<>0% AND 7%) AND (Type%<>3% AND 7%) & ! Ignore if a literal, constant! or a keyword & \ Defined%=.False% & \ Data.node%=FNTraverse%(Index%(2%,Current.production%),"D") 6030 IF Data.node%=0% & THEN 6040 & ELSE IF (ASCII(MID(Heap$,Data.node%+5%,1%)) AND 1%)=1% & THEN Defined%=.True% & ELSE Data. node%=FNTraverse%(Data.node%, "D") & \ GOTO 6030 6040 IF NOT Defined% & THEN PRINT #5%, FNError$(5%,.False%,0%);" - <";MID(Heap$, & Index%(2%,Current.production%)+4%, & ASCII(MID(Heap$,Index%(2%,Current.production%) & +3%,1%)));'>' 6050 NEXT Current.production% & RETURN ! Done with parsing & 6000 ! & ! ******************************************************* & ! * * & ! * P R I N T C R O S S - R E F E R E N C E * & ! * * & ! ******************************************************* & ! & ! This routine prints the cross-reference listing (see BNF & ! manual for the significance of what is printed). & ! & Xref.node%=Tree.identifier% ! Start at root & 20010 Xref.next%=FNTraverse%(Xref.node%,'L') & \ IF Xref.next%<>.Nil% & THEN ! If not at end of left side & Dummy%=FNPush%(Xref.node%) ! Push current node & \ Xref.node%=Xref.next% ! traverse link to next node & \ GOTO 20010 ! Now go try again 20020 ! At this point, the left pointer is nil, so print the current node & GOSUB 20050 20025 Xref.next%=FNTraverse%(Xref.node%,'R') & ! Find next "right" node & \ IF Xref.next%<>.Nil% & THEN ! Move right if possible & Dummy%=FNPush%(-Xref.node%) & \ Xref.node%=Xref.next% & \ GOTO 20010 20030 IF NOT FNEmpty% & THEN & Xref.node%=FNPop% ! Backup one node (if any) & \ IF Xref.node%<0% ! If already have gone right & THEN ! from here, backup more & 20030 & ELSE ! Otherwise, continue & 20020 20040 RETURN ! Exit - we're done 20050 ! Print Statistics on current node & PRINT #4%,'<';MID(Heap$,Xref.node%+4%,ASCII(MID(Heap$,Xref.node%+3%,2%) & CVT$%(MID(Heap$,ASCII(MID(Heap$,Xref.node%+3%,1%))+Xref.node%+4%,2% & CVT$%(MID(Heap$,Xref.node%+1%,2%)), & \ Data.node%=FNTraverse%(Xref.node%,'D') & \ Data.node$='' & \ IF Data.node%=.Nil% ! If no references to print & & THEN & PRINT #4%,'*' ! Notify user of this & \ RETURN ! and exit, otherwise print stats 20060 Data.node$=Data.node$+NUMI$(CVT$%(MID(Heap$,.Data.node%+1,2%))) & \ Data.number%=CVT$%(MID(Heap$,Data.node%+3%,2%)) & \ Data.node$=Data.node$+'( '+NUM1$(Data.number%)+')' & IF Data.number%>1% ! Notify user of multiple ref's (if any) & \ Data.node$=Data.node$+',' & \ Data.node%=FNTraverse%(Data.node%, 'D') & \ GOTO 20060 IF Data.node%<>.Nil% ! Loop for next only if more 20070 PRINT #4%,LEFT(Data.node$,LEN(Data.node$)-1%) & \ RETURN ! We've printed the stats for this variable so exit 20900 DEF* FNPop% ! This routine returns the next value on the stack & \ PRINT '?Stack underflow' IF Stack%(0%)=0% & \ FNPop%=Stack%(Stack%(0%)) & \ Stack%(0%)=Stack%(0%)-1% IF Stack%(0%)>0% & \ FNEND & 20910 DEF* FNPush%(X%) & ! This function pushes values onto the stack & \ IF Stack%(0%)=.Stack.size% & THEN ! If exceeded stack, give an error & PRINT '?Stack overflow' & \ GOTO 20930 ! and end 20920 Stack%(0%)=Stack%(0%)+l% & Stack%(Stack%(0%))=X% ! Push value 20930 FNEND & 20940 DEF* FNEmpty% & ! This function returns TRUE if the stack is empty & IF Stack%(0%)=0% & THEN & FNEmpty%=.True% & ELSE & FNEmpty%=.False% 20950 FNEND & 21000 ! & ! ******************************************************* & ! * * & ! * F U N C T I O N : F N T r a v e r s e % * & ! * * & ! ******************************************************* & ! & ! This function is passed a pointer to a node and a speci- & ! fication as to which of that node's pointers to return. & ! & ! LOCAL VARIABLES: & ! & ! Traverse.node% Pointer to node to look up pointer in & ! Traverse.ptr% Position of the pointer to return in & ! Heap$. & ! Traverse.type$ Specification as to which of the & ! node's pointers to return. & DEF* FNTraverse%(Traverse.node%,Traverse.type$) & \ FNTraverse%=0% ! Initialize to zero. & \ IF ASCII(MID(Heap$,Traverse.node%,1%))=.Data.type% & THEN 21010 ! If this is a data type then skip the name & ! type routine. & ELSE Traverse.ptr%=Traverse.node%+3% ! Else... & \ Traverse.ptr%=Traverse.ptr%+(ASCII(MID(Heap$, & Traverse.ptr%,1%)))+4% & \ Traverse.ptr%=Traverse.ptr%+((INSTR(1%,"DLR", & Traverse. type$)-1%)*2%) & ! find the pointer we want to return. & \ FNTraverse%=CVT$%(MID(Heap$,Traverse.ptr%,2%)) & ! Return it. & \ GOTO 21090 ! Jump to end of function. 21010 IF ((Traverse.type$="L") OR (Traverse.type$="R")) & THEN PRINT CHR$(7%);"?Can't use L or R for data node" & ! If the dolt tries get an incorrect pointe- & ! tell him to knock it off. & \ GOTO 21090 ! Jump to end of function. 21020 Traverse.ptr%=Traverse.node%+6% ! Find the pointer we want & ! return. & FNTraverse%=CVT$%(MID(Heap$,Traverse.ptr%,2%)) ! Return it. 21090 FNEND & 21000 ! & ! ******************************************************* & ! * * & ! * F U N C T I O N : F N A l l o c a t e % * & ! * * & ! ******************************************************* & ! & ! This function adds a new data chunk to Heap$. It returns the & ! pointer position of the node created. & ! & ! LOCAL VARIABLES: & ! & ! Allocate.data$ String to be added to to the symbol & ! table. & ! Allocate.ptr% Pointer value of the string added. & ! & DEF* FNA1_!ocate%(Allocate.data$) & A1locate.ptr%=FNFree%(LEN(Allocate.data$)) ! Call FNFree% & ! to find next large enough free & ! block. 22010 Heap$=LEFT(Heap$,Allocate.ptr%-l%)+Allocate.data$+ & RIGHT(Heap$,Allocate.ptr%) ! Add the data to the & ! table. & Tree.literal%=Allocate.ptr% ! Set literal pointer to this & ! record & IF (ASCII(MID(Allocate.data$,ASCII(MID(Allocate.data$, & ! if it's a terminal & AND (Tree.literal%=0%)) ! and we haven't set & ! it already. & Tree.identifier%=Allocate.ptr% ! Set identifier pointer to & ! this record & IF (ASCII(MID(Allocate.data$,ASCII(MID(Allocate.data$,4%, 1%) & ! If it's an identifier & AND (Tree.identifier%)=0%) ! and we haven't set the he & FNAllocate%=Allocate.ptr% ! Return pointer position. 22090 FNEND & 22100 ! & ! ******************************************************* & ! * * & ! * F U N C T I O N : F N F r e e % * & ! * * & ! ******************************************************* & ! & ! This function returns the first free block that is large & ! enough to accomodate the data string to add to the table. & ! & ! LOCAL VARIABLES: & ! & ! Free.size% Size of node for which to find a free & ! block. & ! & DEF* FNFree%(Free.size%)=LEN(Heap$)+1% ! Right now this function & ! just returns the current length & ! of the table plus one which is & ! where we will put the data. & 22100 ! & ! ******************************************************* & ! * * & ! * F U N C T I O N : F N L i n k * & ! * * & ! ******************************************************* & ! & ! This function is given a father node, a son node, and & ! which pointer of the father node should point to the son & ! node, from which it links the father to the son. It returns & ! nothing. & ! & ! LOCAL VARIABLES: & ! & ! Link.new.node% Pointer to the son node to which & ! the father node is told to point. & ! Link.ptr% Position of pointer to change in & ! father node. & ! Link.root% Pointer to the father node. Also & ! used in the Search routine but only & ! as the father node parameter passed & ! to FNLink%. & ! Link.type$ Specification as to which of the & ! father's pointers should point to & ! the son. Also used in the Search & ! routine but only as the link-type & ! parameter passed to FNLink%. & ! & DEF* FNLink%(Link.root%,Link.new.node%,Link.type$) & \ GOTO 22290 ! Exit the function... & \ IF Link.type$="" ! if no pointer specified. & \ IF ASCII(MID(Heap$,Link.root%,1%))=.Data.type% & THEN 22210 ! If this is a data type then skip the name & ! type routine. & ELSE Link.ptr%=Link.root%+3% ! Else... & \ Link.ptr%=Link.ptr%+(ASCII(MID(Heap$,Link.ptr%,1%))+4% & \ Link.ptr%=Link.ptr%+((INSTR(1%,"DLR",Link.type$)-l%)*2% & ! find the pointer we want to change. & \ Heap$=LEFT(Heap$,Link.ptr%-1%)+CVT%$(Link.new.node%) & +RIGHT(Heap$,Link.ptr%+2%) & ! Change it. & \ GOTO 22290 ! Jump to end of function. 22210 IF ((Link.type$="L") OR (Link.type$="R")) & THEN PRINT CHR$(7%);"?Can't use L or R for data node" & ! If the idiot tries to use an invalid & ! pointer, tell him he can't. & \ GOTO 22290 ! Jump to end of function. 22220 Link.ptr%=Link.root%+6% ! Find the pointer we want to change. & \ Heap$=LEFT(Heap$,Link.ptr%-1%)+CVT%$(Link.new.node%) & +RIGHT(Heap$,Link.ptr%+2%) ! Change it. 22290 FNLink%=0% ! Return nothing. & \ FNEND & 22100 ! & ! ******************************************************* & ! * * & ! * S C A N N E R R O U T I N E * & ! * * & ! ******************************************************* & ! & ! This routine obtains the next character from the source file, & ! follows the transition tables in memory and generates a token & ! for the character(s) or prints an error. If the error occurs & ! when the scanner is just beginning a new token, the error will & ! be ?Unrecognized symbol. If the error is after a token has begun & ! to be recognizedp the error will be ?Unexpected symbol. & ! & Symbol$='' ! Zero-out symbol string before beginning & \ Previous.production%=0% ! No previous productions 23010 Character$=FNGet.char$ ! Get next character & \ IF Character$=CHR$(26%) OR LEN(Character$)=0% ! End scan if EOF & THEN & FL.EDF%=.True% & \ RETURN 23015 GOTO 23070 IF LEN(Symbol$)>0% ! If we've already begun a token, don't & ! bother trying to start a new one. & ! Otherwise, start a bi-search of the starting states & \ Scan.low%=0% & \ Scan.high%=128% 23020 Scan.current%=((Scan.high%-Scan.low%)/2%)+Scan.low% & \ IF (Scan.1ow%=Scan.high%-1%) AND & (ASCII(Character$)<>Token%(Scan.current%,.Character.value%)) & THEN ! If no match & PRINT #5%,Current.line$;Character$ & \ Current.line$=SPACE$(LEN(Current.line$)+1%) & \ PRINT #5%,FNError$(0%,0%,LEN(Current.line$)) & ! then print error & \ RETURN ! and end 23030 IF Scan.current%>Number.of.tokens% & THEN & Scan. high%=Scan.current% & \ GOTO 23020 23040 IF ASCII(Character$)Token%(Scan.current%,.Character.value%) & THEN & Scan.low%=Scan.current% & \ GOTO 23020 23060 Scan.production%=Token%(Scan.current%,.Production%) 23070 Following.productions%=CVT$%(LEFT(Productions(Scan.production%),2%)) & ! Determine the number of subproductions for the current production & \ FOR Current.production%=1% TO Following.productions%+1% & \ IF FNMatch%(Current.production%) & THEN ! If there is a match with the current character & Previous.production%=Scan.production% & \ Previous.sub.production%=Current.production% & \ Match.compare%=LEN(Match.compare$) & ! Remember where we were in case we're on a & ! wild goose chase. & \ Scan.production% = & CVT$%(MID(Production$(Scan.production%+Curr & ! now jump to the next production & \ GOTO 23010 UNLESS Scan.production%=0% & \ Lexival%=Token%(Scan.current%,.Token.value%) & \ RETURN ! Return with token value 23080 NEXT Current.production% & IF Previous. production%>0% ! If there is no match, and there was a & ! previous proauction & THEN ! then backtrack one step to it & Scan.production%=Previous.production% & \ Current.production%=Previous.sub.production% & \ Previous. production%=0% ! Don't know what wtas before & \ Source. position%=Source.position%-Match.compare% ! Back & \ Character$=MID(Source.input$,Source.position%,1%) & \ Print.inhibit%=Match.compare% ! Prevent listing re- & ! print of characters & \ Symbol$=LEFT(Symbol$,LEN(Symbol$)-Match.compare%) & \ GOTO 23080 23085 PRINT #5%,.FNError$(I%,0%,LEN(Current.line$)+1%) & \ RETURN ! Print error and end & 23090 ! & ! ******************************************************* & ! * * & ! * F U N C T I O N : F N M a t c h % * & ! * * & ! ******************************************************* & ! & ! This checks for matching characters between the current character & ! position and the current production. & ! This is called by the scanner and also calls to FNCvt$ and the & ! list routine. It first checks for an indirect terminal reference & ! and then checks all pre-defined types (e.g. ), and & ! finally checks for a direct terminal (literals such as '<>'). & ! & ! LOCAL VARIABLES: & ! & ! Match% Dummy variable used for loops, etc & ! Match.current% Used for main loop & ! Match.production% Passed to function as the current & ! sub-production in Scan.production% & ! Match.temp$ The length of the terminal and the & ! terminal itself from production array & ! Match.term$ The terminal from Match.temp$ & ! Match.term% The value of the first part of the & ! terminal & ! Match.term.length% Length of the terminal & ! & DEF* FNMatch%(Match.production%) & \ Match.temp$=RIGHT(Production$(Scan.production%+Match.production%-1%),5%) & \ Match.term.length%=ASCII(Match.temp$) ! Get length of term & \ Match.term$=RIGHT(Match.temp$,2%) ! Get terminal value & \ Match.term%=CVT$%(LEFT(Match.term$,2%)) ! Get numerical value of the & ! first part of the terminal & \ IF Match.term%>=0% ! If not an indirect terminal reference & THEN ! then skip this section & 23110 23095 ! else look for a matching indirect terminal & FOR Match.current%=1% TO & CVT$%(LEFT(Production$(ABS(Match.term%)),2%))+1% & \ Match.compare$ = & FNCvt$(RIGHT(Production$(ABS(Match.production%) & IF MID(Source.input$,Source.position%,LEN(Match. & Match.compare$ & THEN & Character$=FNGet.char$ & FOR Match% = & 1% TO & LEN(Match.compare & ! Move input pointer ahead if & ! this was a multi-character & ! terminal symbol & \ GOTO 23140 23100 NEXT Match.current% & \ FNMatch%=.False% & \ GOTO 23190 ! If no match, exit 23110 IF Match.term%=256% ! If & THEN ! then return true no matter what the character is & Match. compare$=Character$ & \ GOTO 23140 23120 ! If we get to here, that means that we're looking at a direct & ! terminal (literal) & Match.compare$=FNCvt$(Match.term$) & \ IF MID(Source.input$,Source.position%,LEN(Match.compare$))=Match.compare & THEN & Character$=FNGet.char$ & FOR Match%=1% TO LEN(Match.compare$)-1% & ! Move tne input poinuer forward if this was a multi- & ! character terminal symbol & \ GOTO 23140 23130 FNMatch%=.False% & GOTO 23190 23140 FNMatch%=.True% & \ Current.line$=Current.line$+RIGHT(Match.compare$,Print.inhibit%+1%) & \ Print.inhibit%=Print.inhibit%-LEN(Match-compare$) ! Don't reprint & \ Print.inhibit%=0% IF Print.inhibit%<0% & \ Symbol$=Symbol$+Match.compare$ & ! Gersnafful the character(s) for listing and the symbol string & \ GOSUB 24000 & ! Print the line if there's a vertical paper movement 23190 FNEND & 23200 ! & ! ******************************************************* & ! * * & ! * F U N C T I O N : F N C v t $ * & ! * * & ! ******************************************************* & ! & ! Converts from a string of CVT%$'s to a string of CHR$'s. & ! & ! LOCAL VARIABLES: & ! & ! Cvt.input$ The source string to convert & ! which is passed. & ! Cvt.loop% Loop counter & ! Cvt.out$ The target (decoded) string & ! which is returned. & DEF* FNCVT$(Cvt.input$) & \ Cvt.out$='' & \ Cvt.out$=CVT.out$+CHR$(CVT$%(MID(Cvt.input$,Cvt.loop%,2%))) & FOR Cvt.loop%=1% TO LEN(Cvt.input$) STEP 2% & \ FNCvt$=Cvt.out$ & \ FNEND & 23200 ! & ! ******************************************************* & ! * * & ! * P R I N T L I S T I N G * & ! * * & ! ******************************************************* & ! & ! This routine prints the string containing the current line. & ! The line is only printed if it contains a vertical paper movement & ! and it is printed only up to that point. As many lines are printed & ! as there are vertical paper movements. The appriopriate counters & ! are incremented. & ! & A%=INSTR(1%,Current-line$,CHR$(10%)) & \ B%=INSTR(1%,Current.line$,CHR$(11%)) & \ C%=INSTR(1%,Current.line$,CHR$(12%)) & ! Check for vertical paper movement characters & \ RETURN IF A%=0% AND B%=0% AND C%=0% ! Exit if no vertical movement & \ A%=LEN(Current.line$) IF A%=0% & \ B%=LEN(Current.line$) IF B%=0% & \ C%=LEN(Current.line$) IF C%=0% & \ A%=B% IF B%0% ! Make sure we're at the beginning & ! of the next line 24025 GOTO 24000 ! Go back for next character & 24030 ! & ! ******************************************************* & ! * * & ! * F U N C T I O N : F N N u m $ * & ! * * & ! ******************************************************* & ! & ! Return a string value for a number, blank if zero (0) & ! & ! LOCAL VARIABLES: & ! & ! Num.number$ The NUM1$ of Number% initially & ! and a space if that is "0" & ! Number% The number passed to this & ! function. & DEF* FNNum$(Number%) & \ Num.number$=NUM1$(Number%) & \ Num.number$=' ' IF Number%=0% & \ FNNum$=Num.number$ & \ FNEND & 25000 ! & ! ******************************************************* & ! * * & ! * S E T U P E R R O R T E X T * & ! * * & ! ******************************************************* & ! & ! This routine simply sets up the error messages as strings & ! & Error$(0%)='?Unrecognized symbol' & \ Error$(1%)='?Unexpected symbol' & \ Error$(2%)='%".END" missing' & \ Error$(3%)='?Syntax error' & \ Error$(4%)='?".END" expected' & \ Error$(5%1='?Undefined symbol' & \ Error$(6%)="? ' expected" & \ Error$(7%)='?Multiply defined symbol' & \ Error$(8%)='?"::=" expected' & \ RETURN & 26000 ! & ! ******************************************************* & ! * * & ! * F U N C T I O N : F N E r r o r $ * & ! * * & ! ******************************************************* & ! & ! This function does one of the two following tasks: & ! 1) If its second parameter, Errtype%, is false, it & ! returns the text for the error number passed to & ! it through the first parameter, Errnum%, and incre- & ! ments either the error or warning counter, whichever & ! is appropriate; & ! 2) If its second parameter is true, it prints the & ! error text for the first parameter, and exits from & ! the program. & ! & DEF* FNError$(Errnum%,Errtype%,Errlocation%) ! Function FNError$ & \ PRINT #5%,,,,SPACE$ (Errlocation%-1%);'^' & UNLESS Errlocation%=0% & \ IF Errtype%=.True% ! If the error-type-flag is set & THEN FNError$='' ! Return null string, & \ PRINT #5%, Error$ (Errnum%) ! print the error, & \ GOTO 32767 ! and exit from the program. 26010 FNError$=Error$(Errnum%) ! Return error text & \ Errors%=Errors%+1% ! Increment error counter & IF ASCII(Error$(Errnum%))=63% ! if it begins with a & \ Warnings%=Warnings%+1% ! Increment warning counter & IF ASCII(Error$(Errnum%))=37% ! if it begins with a 26090 FNEND ! End of function FNError$ & 27000 ! & ! ******************************************************* & ! * * & ! * F U N C T I O N : F N G e t . c h a r $ * & ! * * & ! ******************************************************* & ! & ! This function returns the next character in the source & ! line unless: & ! 1) The replace-character-flag is set, in which case it & ! returns the previous character again; & ! 2) The end-of-file-flag is set, in which case it returns & ! a null string. & ! & DEF* FNGet.char$ ! Function FNGet.char$ & \ IF Replace.char%=.True% ! If the replace-character-flag & THEN FNGet.char$=Character$ ! Return the previous character & \ GOTO 27090 ! and jump to the end of the f & 27010 IF FL.EOF%=.True% ! If the end-of-file-flag is set & THEN FNGet.char$='' ! Return null string & \ GOTO 27090 ! and jump to the end of the f 27020 Source.position%=Source.position%+1% ! Increment the source & ! line position pointer & FNGet.char$=MID(Source.input$,Source.position%,1%) & ! Return character pointed to & IF Source.position%<1024% ! If we're not pointing to the & ! last character in the line & THEN 27090 ! Jump to the end of the function. 27030 Source.record%=Source.record%+1% ! Increment source record & \ IF Source.record%+1%>Source.size ! If past EOF & THEN & FL.EOF%=.True% & \ GOTO 27010 27040 GET #3%, RECORD Source.record% ! Get next source line & Source.position%=512% ! Set source line position pointer & ! beginning of line 27090 FNEND ! End of function FNGet.char$ & 28000 ! & ! ******************************************************* & ! * * & ! * S E T U P R O U T I N E * & ! * * & ! ******************************************************* & ! & ! This routine sets up the keyboard and temporary files, & ! and then proceeds to read in the data needed for compilation. & ! This routine takes about 1 CPU second to execute on a PDP 11/45. & ! & ! LOCAL VARIABLES: & ! & ! Production.number% Used as loop variable in reading in & ! the production information. & ! Open KB & OPEN '_KB:BNF.CMD' AS FILE 1% & \ Job%=ACII(SYS(CHR$(6%)+CHR$(9%)+CHR$(0%)))/2% & \ Temp$='TEMP'+NUMI$(Job%)+'.TMP' & \ OPEN Temp$ AS FILE 2% & \ Stack%(94%)=0% ! Pre-extend virtual array & ! The Keyboard is now open on channel 1 and the temporary file is open & ! on channel 2 & \ Switches%=0% ! We have no switches allowed & \ Replace.char%=.False% & \ Character$='' & \ Source.position%=512% & \ GOSUB 25000 & \ RESTORE & \ READ Number.of.tokens% ! Read-in starting state information & \ READ Token%(Token%,.Character.value%), & Token%(Token%,.Production%), & Token%(Token%,.Token.value%) & FOR Token%=1% TO Number.of.tokens% & \ READ Number.of.productions% ! Read-in production information & \ FOR Production.number%=1% TO Number.of.productions% & \ READ Number.following%, Non.terminal%, Length.of.terminal% & \ Term$='' & \ FOR Term%=1% TO Length.of.terminal% & \ READ Terminal.value% & \ Term$=Term$+CVT%$(Terminal.value%) & \ NEXT Term% & \ Production$(Production.number%)=CVT%$(Number.following%)+ & CVT%$(Non.terminal%)+ & CHR$(Length.of.terminal%)+ & Term$ & \ NEXT Production.number% & \ READ Keywords% ! Read-in the keywords & \ READ Keyword$ & \ Heap$=CHR$(1%)+CVT%$(1%)+CHR$(LEN(Keyword$))+Keyword$+ & STRING$(2%,0%)+CHR$(4%)+STRING$(6%,0%) ! Add first keyword to & \ Index%(2%,1%)=1% & \ Free%=LEN(Heap$)+1% & \ Tree.literal%=0% & \ Tree.identifier%=1% ! Set up heap pointers & \ End.of.source%=.False% ! Set up false EOS & \ Sequence%=Keywords%+1% ! Set up starting sequence number & \ Stack%(0%)=0% ! Set up stack & \ Keyword.state%=0% ! Initialize where we are in the keyword, & \ Production.state%=0% ! production, assign, and token sections. & \ Assign.part%,Token.part%=0% & \ Stage%=1% ! Set the stage for parsing & \ RETURN & 28980 DEF* FNSecond%(Node%) & ! This function will return the location of the byte follow- & ! ing the variable-length name, in the node specified by & ! Node% & \ Second%=ASCII(MID(Heap$,Node%+3%,1%)) & \ FNSecond%=Node%+Second%+4% & \ FNEND & 28990 DEF* FNerr$=RIGHT(SYS(CHR$(6%)+CHR$(9%)+CHR$(ERR)),3%) & 29000 ! & ! ******************************************************* & ! * * & ! * E R R O R H A N D L I N G * & ! * * & ! ******************************************************* & ! & 29020 IF ERR=2 AND ERL=401 & THEN & PRINT #1%,'?Illegal file name - ';Source$ & \ Errors%=-1% & \ RESUME 430 29030 IF ERR=2 AND ERL=410 & THEN & PRINT #1%,?Illegal file name - ';Object$ & \ Errors%=-1% & \ RESUME 430 29040 IF ERR=2 AND ERL=420 & THEN & PRINT #1%,'?Illegal file name - ';Lst$ & \ Errors%=-1% & \ RESUME 430 29045 IF ERR=2 AND ERL=425 & THEN & PRINT #1%,'?Illegal file name - ';Symbol$ & \ Errors%=-1% & \ RESUME 430 29050 IF ERL=20 AND ERR=11 & THEN & RESUME 32767 29060 IF ERL=80 & THEN & PRINT #1%,FNerr$;' - ';Source$ & \ RESUME 20 29070 IF ERL=90 & THEN & PRINT #1%,FNerr$; ' - ';Symbol$ & \ RESUME 20 29080 IF ERL=100 & THEN & PRINT #1%,FNerr$; ' - '; Lst$ & \ RESUME 20 29090 IF ERL=110 & THEN & PRINT #1%,FNerr$;' - ';Object$ & \ RESUME 20 29500 IF ERR=11% AND ERL=27040% ! If we got an end-of-file & ! error at line 27040 & THEN FL.EOF%=.True% ! Set the end-of-file-flag & \ RESUME 27010 ! and resume at exit point. 29990 PRINT FNerr$;' at line';ERL & \ GOTO 32767 & 30000 ! & ! ******************************************************* & ! * * & ! * C C L E N T R Y P O I N T * & ! * * & ! ******************************************************* & ! & CCL% = -1% & 30010 In$=SYS(CHR$(7%)) & \ A%=INSTR(1%,In$+' ', ' ') & \ In$=RIGHT(In$,A%+1%) & \ CCL%=0% IF LEN(ln$)=0% & \ GOTO 1 & 31000 ! & ! ******************************************************* & ! * * & ! * P S F C H A I N E N T R Y P O I N T * & ! * * & ! ******************************************************* & ! & PSF% = -1% & 32000 ! & ! ******************************************************* & ! * * & ! * D A T A S T A T E M E N T S * & ! * * & ! ******************************************************* & ! & ! The data in the following statements is in three (3) sections. & ! The first section has the range of line numbers from 32001 to & ! 32076. The second section has the rest of the data statements & ! from 32077 to 32171. The third section is from 32172 onward. The & ! first piece of data in each section is the number of sets of data & ! that will follow. The first section is the starting-state values & ! and has the form (for each set of data, or each starting state): & ! ,, & ! The second section is the data for each production and has the form & ! (for each production): & ! ,, & ! , & ! The Terminal symbol list is a series of numbers that are the & ! ASCII values for the characters in the terminal. The length of the & ! terminal (in numbers) is specified by the number of sub-productions & ! following. & ! If a terminal is greater than 255, it is a BNF special case & ! terminal. The BNF special terminals are as follows: & ! & ! Number Meaning & ! ------ ------- & ! 256 = Any character is accepted in this & ! location & ! & ! If a terminal is less than zero (0), it is an indirect terminal & ! (reference to terminal). The absolute value is the production that & ! has many sub-productions which are all terminals. & ! The third section of data is the keyword list and consists only & ! of the list of keywords. The very first piece of data is the number & ! of keywords. & ! & 32077 DATA 93 32078 DATA 52,0,1,65 32079 DATA 51,0,1,66 32080 DATA 50,0,1,67 32081 DATA 49,0,1,68 32082 DATA 48,0,1,69 32083 DATA 47,0,1,70 32084 DATA 46,0,1,71 32085 DATA 45,0,1,72 32086 DATA 44,0,1,73 32087 DATA 43,0,1,74 32088 DATA 42,0,1,75 32089 DATA 41,0,1,76 32090 DATA 40,0,1,77 32091 DATA 39,0,1,78 32092 DATA 38,0,1,79 32093 DATA 37,0,1,80 32094 DATA 36,0,1,81 32095 DATA 35,0,1,82 32096 DATA 34,0,1,83 32097 DATA 33,0,1,84 32098 DATA 32,0,1,85 32099 DATA 31,0,1,86 32100 DATA 30,0,1,87 32101 DATA 29,0,1,88 32102 DATA 28,0,1,89 32103 DATA 27,0,1,90 32104 DATA 26,0,1,97 32105 DATA 25,0,1,98 32106 DATA 24,0,l,99 32107 DATA 23,0,1,100 32108 DATA 22,0,1,101 32109 DATA 21,0,1,102 32110 DATA 20,0,1,103 32111 DATA 19,0,1,104 32112 DATA 18,0,1,105 32113 DATA 17,0,1,106 32114 DATA 16,0,1,107 32115 DATA 15,0,1,108 32116 DATA 14,0,1,109 32117 DATA 13,0,1,110 32118 DATA 12,0,1,111 32119 DATA 11,0,1,112 32120 DATA 10,0,1,113 32121 DATA 9,0,1,114 32122 DATA 8,0,1,115 32123 DATA 7,0,1,116 32124 DATA 6,0,1,117 32125 DATA 5,0,1,118 32126 DATA 4,0,1,119 32127 DATA 3,0,1,120 32128 DATA 2,0,1,121 32129 DATA 1,0,1,122 32130 DATA 0,0,1,45 32131 DATA 9,0,1,48 32132 DATA 8,0,1,49 32133 DATA 7,0,1,50 32134 DATA 6,0,1,51 32135 DATA 5,0,1,52 32136 DATA 4,0,1,53 32137 DATA 3,0,1,54 32138 DATA 2,0,1,55 32139 DATA 1,0,1,56 32140 DATA 0,0,1,57 32141 DATA 0,0,3,58,58,61 32142 DATA 0,75,1,46 32143 DATA 1,68,2,60,60 32144 DATA 0,70,1,60 32145 DATA 1,0,2,62,62 32146 DATA 0,68,1,256 32147 DATA 1,72,1,-l 32148 DATA 0,72,1,-54 32149 DATA 2,0,1,62 32150 DATA 1,72,1,-l 32151 DATA 0,72,1,-54 32152 DATA 3,75,1,-l 32153 DATA 2,0,1,-l 32154 DATA 1,75,1,-54 32155 DATA 0,0,1,-54 32156 DATA 7,0,1,32 32157 DATA 6,0,1,13 32158 DATA 5,0,1,10 32159 DATA 4,0,1,12 32160 DATA 3,0,1,9 32161 DATA 2,0,1,11 32162 DATA 1,0,1,27 32163 DATA 0,0,1,0 32164 DATA 0,0,1,124 32165 DATA 0,89,1,39 32166 DATA 1,0,1,39 32167 DATA 0,89,1,256 32168 DATA 1,91,1,-54 32169 DATA 0,0,1,-54 32170 DATA 0,0,1,44 32172 DATA 1 32173 DATA 'ANYCHAR' & 32767 A%$ = SYS(CHR$(9%)) & \ END