// 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<<SYMPTR.Virgin then // record # non-virgin symbs., size.
[
Dictionary!(p-1) = c<<SYMPTR.link // No longer virgin
RealSymCount = RealSymCount+1
RealSymSize = RealSymSize + (n+1) + 1
]
resultis p
]
i = i + 1
]
if Dictionary!(p+i) gr Name!i break
q = p
p = (Dictionary!(q-1))<<SYMPTR.link
]
//enter the symbol
p = Dictionary!0 + 1; Dictionary!0 = Dictionary!0 + (n+1) + 1
if Dictionary!0 gr dictionarySize then LEXreport(2)
Dictionary!(p-1) = Dictionary!(q-1)
(Dictionary!(p-1))<<SYMPTR.Virgin = 1
(Dictionary!(q-1))<<SYMPTR.link = p
for i = 0 to n do Dictionary!(p+i) = Name!i
resultis p // and return the pointer
]
///*DCS* End of BLEX changes for BNCG Symbol Table Compaction
//----------------------------------------------------------------------------
and LEXreport(n) be // Report LEX errors
//----------------------------------------------------------------------------
[ static [ LastCharPtr = -1 ] // Line pointer for last error message.
Ostream = ErrorStream
WW($*n)
unless Curline eq LastCharPtr do
[ LastCharPtr = Curline // Remember where this error occurred.
unless Curfile eq 0 do // Identify any file other than the initial one.
[ WriteS(" in file "); WriteS( GetnameV!Curfile); WW($*n) ]
let i, j = LineP, -1
// Skip up to next newline.
[ i = i+1
if i > 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))<<SYMPTR.link; if p ge newEnd then
[
while p ge newEnd do p = (Dictionary!(p-1))<<SYMPTR.link;
(Dictionary!(q-1))<<SYMPTR.link = p;
]
q = p;
]
]
Dictionary!0 = newEnd;
]
resultis false
]
//----------------------------------------------------------------------------
and enterparams() be
//----------------------------------------------------------------------------
///*DCS* read command line manifests
[
let fn, uc, swu = FirstName, UpperCase, SWUpperCase
// danger! won't swap!
let orch = Rch
Rch = Getch
let value = true //default manifest value
ReadCOMCM() // processor name, global switches
ReadCOMCM() // first file name
while filename!0 ne -1 do
[
bp = 0
for i = 1 to sw!0 do switchon sw!i into
[
case $S: // DCS 5-9-77 value for fast getframe, return
Rch()
SWFastFrame = DoNumber(-8) // get value (see just below)
unless SWAlto do SWFastFrame = 0 // ignore on Nova
endcase
case $V:
Rch()
value = DoNumber(-10) // get value, don't write to BL file
endcase
case $M:
LexOut(MANIFEST)
if ReadAhead then Readsymb() // force manifest
Readsymb()
LexOut(ASS) // manifest name = value
V!0 = value
LexOut(NUMBER)
LexOut(SEMICOLON)
NLPending = true // hedge bets, generate <cr>
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
]