// BLEX1.bcpl - BCPL Compiler -- Lexical Analyzer, Part 1.
// Copyright Xerox Corporation 1980
// Last modified on Wed 01 Nov 72 0009.49 by jec.
// Last modified by Butterfield, February 12, 1979 4:23 PM
// - reformatting; Readsymb, get from - 1/23/79
// - Readsymb, convert get names to lowercase for DictionaryEntry - 1/26
// Readsymb Read the next lexical token and write it on the LEX file
get "blexx" // Declarations of values for lexemes.
//----------------------------------------------------------------------------
static // Scalars used by LEX
//----------------------------------------------------------------------------
[
ReadAhead = false // true if a token has been read ahead into ExtraItem.
ExtraItem = nil // Holds a token that has been read ahead, if any.
LastItem = 0 // Holds last item processed by LexOut
NewLineptr = 0 // holds pointer to last $*N seen
NLPending = false // true if a newline was just seen
Chkind = Empty // Character type, as in above manifest declaration.
]
// The following routine is the lexical processor for BCPL. Calling it causes the next lexeme
// to be read from the input stream and the appropriate canonic symbol to be stored into Symb.
// In addition, there may be data in the V-vector, as follows...
// Symb V!0 V!1, V!2, ...
// NUMBER value
// CHARCONST value
// NAME dict pointer
// STRINGCONST n n words of the string, packed.
// SECTBRA n the label, as a packed string n words long
// SECTKET n ditto
// Readsymb writes out the lexeme on the LEX file, along with the necessary
// information from V. Nextsymb in CAE reads this file and puts the info back into V.
// This routine also handles the preprocessor rules regarding insertion of
// SEMICOLON and DO where needed, and processes the GET directive.
// This routine also handles the elimintation of control characters
// which are added to formatted files by BRAVO 9/16/75
//----------------------------------------------------------------------------
let Readsymb() be
//----------------------------------------------------------------------------
[
let getList = false; // used to indicate within get a, b, ... from "file"
manifest
[
getFirst = 1; getNew = 2; getOld = 3;
getFrom = 3; getNewFrom = 5; getOldFrom = 6;
]
static [ outflag = true; T = nil ]
if ReadAhead do // Do we already have a symbol in hand?
[ ReadAhead=false; LexOut(ExtraItem); return; ] // Yes, return it.
let Vp = 0; V!0 = 0 // Counter of characters read.
unless Chkind eq Empty goto M
Next: // Come here to read next character.
Rch();
L:
Chkind = Kind(Ch)
M:
Curline = Chline // Set the line pointer for the char last read
switchon Chkind into // What sort of character is it?
[
case Ignorable: // Skip spaces and such.
[ Rch() repeatwhile Ch eq $*s % Ch eq $*t; goto L ]
case Digit: [ let n = DoNumber(10); return; ]
case BravoTail: // Bravo formatting information follows ↑Z up to *n
[ Rch() repeatuntil Ch eq $*n % Ch eq #777; goto L; ]
case Capital: // Start of an identifier
case Small: // Start of a possible reserved word
[
static [ FirstName = true; UpperCase = false ]
let SmallSW = Chkind eq Small // To remember if it is all lower case
let DigitSW = false // To remember if it has a digit in it
[
switchon Chkind into
[
default: break // Not a character that is in identifiers.
case Digit: DigitSW = true
case Capital: SmallSW = false
case Small: // Might still be reserved
if Vp ge Vmax break // Name too long.
Vp = Vp + 1; V!Vp = Ch // Store the character.
Rch(); Chkind = Kind(Ch) // Read the next one.
]
] repeat
if Vp > NAMELENGTH do [ LEXreport(11); Vp = NAMELENGTH ]
V!0 = Vp; // The word has been scanned.
if SWUpperCase then for i = 1 to V!0 do
if $a le V!i & V!i le $z do V!i = V!i+($A-$a)
if SWLowerCase then for i = 1 to V!0 do //currently never set
if $A le V!i & V!i le $Z do V!i = V!i+($a-$A)
let Name = vec NAMELENGTH/Bytesperword; Packstring(V,Name)
if FirstName do
[
if SWUpperCase % not SmallSW do SWUpperCase, UpperCase = true, true
FirstName = false
]
if UpperCase & not DigitSW do
[
for i = 1 to V!0 do if $A le V!i & V!i le $Z do V!i = V!i + ($a-$A)
SmallSW = true
]
let r = 0 // see if it's a reserved word
if SmallSW do r = ReservedWord()
if getList ne false then test getList gr getFrom
ifnot
[
let entry = DictionaryEntry(Name)
let new = Dictionary!(entry-1)<<SYMPTR.Virgin
if getList eq getFirst then getList = new? getNew, getOld;
if getList ne (new? getNew, getOld) then LEXreport(4);
test Ch eq $,
ifnot getList = getList + getFrom;
ifso Rch();
while Ch eq $*s % Ch eq $*t % Ch eq $*n do Rch();
Chkind = Kind(Ch);
if Chkind ne Capital & Chkind ne Small then LEXreport(4);
Vp = 0; goto M;
]
ifso
[
while Ch eq $*s % Ch eq $*t % Ch eq $*n do Rch();
test r eq FROM & Ch eq $*"
ifnot LEXreport(4);
ifso
[
let new = GetFilename(Name, getList eq getOldFrom);
test getList eq getNewFrom
ifnot if new then LEXreport(4);
ifso
[ OpenSource(Name, true); Chkind=Empty; Readsymb(); ]
]
return;
]
switchon r into // handle "get", "newname", and "from"
[
case GET:
[
while Ch eq $*s % Ch eq $*t do Rch()
if Ch ne $*" then
[
Chkind = Kind(Ch);
if Chkind ne Capital & Chkind ne Small then LEXreport(4);
getList = getFirst; Vp = 0; goto M;
]
if GetFilename(Name) then
[ OpenSource(Name); Chkind = Empty; Readsymb(); ]
return;
]
case NEWNAME:
[
outflag = false; Readsymb(); outflag = true
V!0 = -(Dictionary!(T-1)<<SYMPTR.Virgin); LexOut(NUMBER)
return
]
default: // not 0, "get", "newname", or "from"
[ LexOut(r); return; ]
case FROM: // from is only reserved in get
case 0: // not a reserved word
]
T = DictionaryEntry(Name) // not reserved, so look the name up
V!0 = T // and return the dict pointer
if outflag then LexOut(NAME) // with a NAME lexeme
return
]
default: // not simple, branch on the character rather than the type.
]
Chkind = Empty // Mark the character as having been used.
switchon Ch into
[
case $#: // An octal number.
[
Rch(); unless $0 le Ch & Ch le $7 do LEXreport(6)
let n = DoNumber(8); return
]
case $[:
case $]:
[
let x = Ch and VV = vec BRACKETLENGTH // Remember what it was.
[
Rch(); Chkind = Kind(Ch); unless Chkind ge Digit break
Vp = Vp + 1; if Vp ge Vmax break; VV!Vp = Ch
] repeat
if Vp gr BRACKETLENGTH do [ LEXreport(7); Vp = BRACKETLENGTH ]
test Vp eq 0
ifso LexOut(x eq $[ ? SECTBRA, SECTKET)
ifnot // Pack the label (test backwards to keep brackets balanced)
[ VV!0=Vp; Packstring(VV, V); LexOut(x eq $] ? NAMEKET, NAMEBRA) ]
return
]
case $@: LexOut(RV); return
case $.: LexOut(DOT); return
case $(: LexOut(RBRA); return
case $): LexOut(RKET); return
case $+: LexOut(PLUS); return
case $,: LexOut(COMMA); return
case $;: LexOut(SEMICOLON); return
case $&: LexOut(LOGAND); return
case $%: LexOut(LOGOR); return
case $=:
[
Rch(); if Ch eq $> do [ LexOut(HEFALUMP); return ]
LexOut(ASS); Chkind = Kind(Ch); return
]
case $<:
[
Rch(); if Ch eq $< do [ LexOut(LEFTLUMP); return ]
if Ch eq $= do [ LexOut(LE); return ]
LexOut(LS); Chkind = Kind(Ch); return
]
case $>:
[
Rch()
if Ch eq $> do [ LexOut(RIGHTLUMP); return ]
if Ch eq $= do [ LexOut(GE); return ]
LexOut(GR); Chkind = Kind(Ch); return
]
case $**: LexOut(MULT) ; return
case $/: // Division or comment
[
Rch()
if Ch ne $/ do [ LexOut(DIV); Chkind = Kind(Ch); return ] // Division.
Rch() repeatuntil Ch eq $*n % Ch eq #777 // Skip a comment.
goto L // Process the terminator as the char just read
]
case #12: // Line Feed -- like *n
case #14: // Form Feed -- like *n
case $*n: NLPending = true; NewLineptr = Curline; goto Next
case $!: LexOut(VECAP) ; return
case $?: LexOut(COND) ; return
case $-: LexOut(MINUS); return
case $:: LexOut(COLON); return
case $↑: LexOut(UPLUMP); return
case $*": // String quote and
case $$: DoString(); return // Character constant.
case #777: // End of a file.
EOF:
[
let done = CloseSource();
if V!0 ne 0 % done & not SWPrepare then
[ LexWrite(SEMICOLON); LexOut(END); ]
if done then [ Symb = END; return ]; Ch = $*n; goto L // fake a *n
]
default:
[
LEXreport(8)
WriteS("The character is *""); WW(Ch)
WriteS("*" and has ascii code "); WriteO(Ch)
WriteS(" octal*n")
goto Next
]
]
]
//----------------------------------------------------------------------------
and GetFilename(name, parenthesize; numargs na) = valof
//----------------------------------------------------------------------------
[
let Vp = 1;
[ Rch(); if $A le Ch & Ch le $Z do Ch = Ch+($a-$A); V!Vp = Ch; Vp = Vp+1 ]
repeatuntil Ch eq $*" % Ch eq $*n
unless Ch eq $*" do [ LEXreport(4) ] // include the "
V!0 = Vp - 1; Packstring(V, name)
///*DCS* two functions:
///* 1) notify user of gets, as they are got
///* 2) ignore all but first request for same get file prints
///* -- "foo" for first get, "(foo)" for subsequent ones
///* enters foo" into Dictionary, in order to tell.
let T = DictionaryEntry(name)
let new = Dictionary!(T-1)<<SYMPTR.Virgin ne 0
name!0 = ((name!0 rshift 8 - 1) lshift 8) +(name!0 & 377b); WW($*s)
if na ls 2 then parenthesize = not new
test parenthesize
ifso [ WW($(); WriteS(name); WW($)); ]
ifnot [ WriteS(name); ]
resultis new
]