// BLEX0.bcpl - BCPL Compiler -- Lexical Analyzer,Main Program // Copyright Xerox Corporation 1980 // Swinehart, 5-9-77 Fast getframe, return // last modified by Butterfield, May 9, 1979 2:15 PM // - Rch, OpenSource, CloseSource, add -G switch (not SWGetLINEs) - 2/2 // - OpenSource, CloseSource, discardable symbols - 1/23 // - GetMax, increase to 20 - 1/19/79 // ReadSource Main program of LEX // LEXreport Report errors from LEX phase // Rch Read the next source char from INPUT into Ch // OpenSource Open a source stream and remember any previous stream's state // Closesource Close the current source stream, restore any previous stream // DictionaryEntry Make an entry in the Dictionary get "blexx" //---------------------------------------------------------------------------- static //---------------------------------------------------------------------------- [ V = nil //vector filled by Readsymb in LEX and by Nextsymb in CAE Symb = nil //output of Readsymb and Nextsymb GetV = nil //stack for nested GET files GetP = 0 //pointer into GetV Ch = nil //output of Rch Chline = -1 //line pointer of char read by Rch LineV = nil //circular buffer for source input LineP = 0 //pointer into LineV ///*DCS* Compiled Declarations LexLength = 0 ///* # bytes in Lex File ///*DCS* command line manifests bp = 0 ] //---------------------------------------------------------------------------- manifest //---------------------------------------------------------------------------- [ dictionarySize = #7777 GetMax = 20 //max number of nested GET files GetN = 3 //size if a GetV entry GetT = GetMax*GetN-1 //length of GetV (-1) getF = 0; getS = 1; getD = 2; // file, stream, and dictionary GetV offsets LineMax = 120 //size of the circular line buffer ] //---------------------------------------------------------------------------- let ReadSource() be //---------------------------------------------------------------------------- [ if SWDebug do WriteS("LEX*n") // *** Allocate source file maintenance tables *** let v = vec GetT; GetV = v // The stack for nested GET files let v = vec LineMax; LineV = v // The circular line buffer for i = 0 to LineMax do LineV!i = 0 let v = vec Vmax; V = v // The information for a lexeme Chline = -1 // *** Allocate Dictionary *** Dictionary = Newvec(dictionarySize); Dictionary!0 = ($z-$a+1)*2+1; for i = 1 to Dictionary!0 do Dictionary!i = 0 ///*DCS* Precompiled Declarations if SWUseDecl then ReadDecl() ///* All Communications Global Movestring(SourceName, GetnameV!GetnameP) SourceStream = OpenInput(GetnameV!GetnameP) SourceLength = lv GetnameV!(GetnameP+1); rv SourceLength = -1 Curfile = GetnameP; Curline = Chline; test SWPrepare ifnot [ LexStream = OpenTemp($l, false); if SWUseDecl then ReadLex(); ] ifso LexStream = OpenOutput(DECLName) ///*DCS* ** process command line manifests ** if SWParamset then enterparams() // **** READ SOURCE **** [ Readsymb() ] repeatuntil Symb eq END // ** clean up ** test SWPrepare ifso [ /// ** DCS ** if LexLength&1 ne 0 then LexWrite(LINE); // must be even! CloseOutput(LexStream) DictStream = OpenOutput(DICTName) ] ifnot DictStream = OpenTemp($d, false) DictLength = Dictionary!0 ///*DCS* Precompiled Declarations if SWPrepare then WriteDecl() ///* All communications Global ///* Enhanced Performance WriteSequential(DictStream, Dictionary,DictLength) test SWPrepare ifso CloseOutput(DictStream) ifnot ResetStream(DictStream, $d) ] //---------------------------------------------------------------------------- and DictionaryEntry(Name) = valof //---------------------------------------------------------------------------- // The Dictionary chain table contains the pointers to 52 chains // Each chain is sorted (increasing) // The name blocks contain // pointer to next link (or 0) // extra word (unused at present, set to 0 on creation) // n words for the packed string ///*DCS* Symbol Table Compaction, during NCG Phase ///* When symbol first entered, virgin bit of its link field is ///* set. When symbol is again seen, virgin bit cleared. During ///* NCG, only non-virgin symbols will be allowed into core. [ let n,c,p,q = nil,nil,nil,nil //length, first char, and two pointers n = Length(Name)/Bytesperword; c = Char(Name,1) test $a le c & c le $z // Get the header index of the first char then c = (c - $a) * 2 + 1 or test $A le c & c le $Z then c = (c - $A) * 2 + 2 or resultis 0 // A non-alphabetic initial char?? q = c + 1 p = Dictionary!(q-1) until p eq 0 do [ let i = 0 while Dictionary!(p+i) eq Name!i do [ if i eq n do ///*DCS* symbol seen again. [ c = Dictionary!(p-1) if c< LineMax do i = 0 if LineV!i eq $*n do [ j = i; LineV!i = 0; break ] if i eq LineP do [ WriteS("..."); break ] ] repeat // Print last few lines. [ i = i+1 if i > LineMax do i = 0 WW(LineV!i) if LineV!i eq $*n do [ j = i; LineV!i = 0 ] ] repeatuntil i eq LineP unless j eq -1 do LineV!j = $*n WW($*n) ] let m = selecton n into [ default: 0 case 1: "TOO MANY *"GET*" FILES" case 2: "DICTIONARY IS TOO BIG" case 3: 0 case 4: "ILLEGAL *"GET*"" case 5: "TOO MANY NESTED *"GET*" FILES" case 6: "ILLEGAL NUMERIC CONSTANT" case 7: "BRACKET LABEL TOO LONG" case 8: "ILLEGAL CHARACTER" case 9: "STRING TOO LONG" case 10: "ILLEGAL CHARACTER FOLLOWS *"***"" case 11: "NAME TOO LONG" case 12: "ILLEGAL SWITCH or TOO MANY SOURCE FILES" ] BCPLreport(n, m) if SWHelp do Help("LEX REPORT") if n le 5 goto Abort Ostream = OutputStream ] //---------------------------------------------------------------------------- and Rch() be // Read the next char //---------------------------------------------------------------------------- [ Readch(SourceStream, lv Ch) //Readch returns #777 at end of stream,so Endofstream() is no more //if Endofstream(SourceStream) do Ch = #777 // Pass special EOF char to Readsymb if GetP eq 0 % SWGetLINEs then Chline = Chline+1; rv SourceLength = rv SourceLength + 1 // Step character count if SWOneCase do if $a le Ch & Ch le $z do Ch = Ch + ($A-$a) if SWList do [ WW(Ch);WriteO(Ch);WW($*n) if Ch eq $*n & not SWLexTrace do [ WriteO(Chline+1); WW($*s) ] ] // store the char into circular line buffer (for error reports) LineP = LineP+1; if LineP gr LineMax do LineP = 0; LineV!LineP = Ch; ] //---------------------------------------------------------------------------- and OpenSource(Name, discardSymbols; numargs na) be // Open a source stream //---------------------------------------------------------------------------- [ if SWGetLINEs then [ if GetlineP gr GetlineT do [ LEXreport(1) ] GetlineV!GetlineP = Chline; GetlineV!(GetlineP+1) = Curfile GetlineV!(GetlineP+2) = rv SourceLength; GetlineP = GetlineP + GetlineN ] if GetP gr GetT do [ LEXreport(5) ] GetV!GetP = Curfile; GetV!(GetP+1) = SourceStream; GetP = GetP + GetN GetnameP = GetnameP + GetnameN; if GetnameP gr GetnameT do [ LEXreport(1) ] Unpackstring(Name, filename); // use global filename vector for FixFileName FixFileName(Name, "", SourceDevice) // Tack on the device if any Movestring(Name, GetnameV!GetnameP) SourceStream = OpenInput(GetnameV!GetnameP) SourceLength = lv GetnameV!(GetnameP+1); rv SourceLength = -1 Curfile = GetnameP GetV!(GetP-GetN+getD) = ((na ls 2 % not discardSymbols)? 0, Dictionary!0); ] //---------------------------------------------------------------------------- and CloseSource() = valof // Close the current stream, reopen the last //---------------------------------------------------------------------------- // returns true if there is no last [ if SWGetLINEs % GetP eq 0 then [ if GetlineP gr GetlineT do [ LEXreport(1) ] GetlineV!GetlineP = Chline; GetlineV!(GetlineP+1) = Curfile GetlineV!(GetlineP+2) = rv SourceLength; GetlineP = GetlineP + GetlineN ] if GetP eq 0 then [ V!0 = 0; resultis true; ] CloseInput(SourceStream, GetnameV!Curfile) GetP = GetP - GetN; Curfile = GetV!GetP SourceStream = GetV!(GetP+1); SourceLength = lv GetnameV!(Curfile + 1) let newEnd = GetV!(GetP+getD); V!0 = newEnd; if newEnd ne 0 then [ for i = 2 to ($z-$a+1)*2+1 do [ let q = i; while q ne 0 do [ let p = (Dictionary!(q-1))< default: endcase ] ReadCOMCM() ] Rch = orch if fn then [ FirstName = true UpperCase = uc SWUpperCase = swu ] ] //---------------------------------------------------------------------------- and Getch() be //---------------------------------------------------------------------------- [ bp = bp + 1 Ch = bp>filename!0? 0, filename!bp ]