// BLEX2.bcpl - BCPL Complier -- Lexical Analyzer,part 2
// Copyright Xerox Corporation 1980
// Swinehart, 5-10-77: docase exp, remove wenn, dann, sonst, probieren
// last modified by Butterfield, May 8, 1979 7:24 PM
// - incorporate Paxton's unsigned compares under SWUnsignedCompares - 5/8
// - LexWrite, formatting and write symbol information with END - 1/24
// - add from for use by get a, b, ... from "file" - 1/23/79
// Paxton, 9-14-78: unsigned compares
// ReservedWord // Look up string as a reserved word
// *veq // Test for string equality
// * local to this file
get "blexx"
static [ W = nil //pointer to the string that veq compares its argument with
N = nil //length of this string
]
let ReservedWord(Name) = valof
[ unless V!0 gr 1 resultis 0 // All reserved words have at least two letters
let w = vec (NAMELENGTH/Bytesperword); W = w
let ch = V!1 // The first char of the word
V!1 = V!0 - 1; Packstring(V+1,W); N = V!1/Bytesperword // The rest of the word
V!1 = ch // Restore V for use in Readsymb
resultis selecton ch into // Look up the word
[ default: 0
case $a: ( veq("nd" )?AND,
( veq("bort" )?ABORT,
0))
case $b: ( veq("e" )?BE,
( veq("y" )?BY,
( veq("reak" )?BREAK,
( veq("it" )?BIT,
( veq("yte" )?BYTE,
( veq("lank" )?BLANK,
0))))))
case $c: ( veq("ase" )?CASE,
( veq("ompileif" )?COMPILEIF,
( veq("ompiletest")?COMPILETEST,
0)))
///*DCS* add compileif, compiletest
case $d: ( veq("efault" )?DEFAULT,
( veq("o" )?DO,
( veq("ocase" )?DOCASE,
0)))
case $e: ( veq("q" )?EQ,
( veq("qv" )?EQV,
( veq("xternal" )?EXT,
( veq("ndcase" )?ENDCASE,
0))))
case $f: ( veq("or" )?FOR,
( veq("alse" )?FALSE,
( veq("inish" )?FINISH,
( veq("rom" )?FROM,
0))))
case $g: ( veq("e" )?GE,
( veq("r" )?GR,
( veq("et" )?GET,
( veq("oto" )?GOTO,
0))))
case $h: (0)
case $i: ( veq("f" )?IF,
( veq("fso" )?IFSO,
( veq("fnot" )?IFNOT,
( veq("nto" )?INTO,
0))))
case $j: (0)
case $k: (0)
case $l: ( veq("et" )?LET,
( veq("e" )?LE,
( veq("s" )?LS,
( veq("v" )?LV,
( veq("oop" )?LOOP,
( veq("ogand" )?LOGAND,
( veq("ogor" )?LOGOR,
( veq("ogeqv" )?EQV,
( veq("ogxor" )?NEQV,
( veq("shift" )?LSHIFT,
0))))))))))
case $m: ( veq("anifest" )?MANIFEST,
0)
case $n: ( veq("e" )?NE,
( veq("eg" )?NEG,
( veq("il" )?NIL,
( veq("ot" )?NOT,
( veq("eqv" )?NEQV,
( veq("umargs" )?NUMARGS,
( veq("ewname" )?NEWNAME,
0)))))))
case $o: ( veq("r" )?OR,
( veq("ffset" )?OFFSET,
0))
case $p: (0)
case $q: (0)
case $r: ( veq("v" )?RV,
( veq("eturn" )?RETURN,
( veq("esultis" )?RESULTIS,
( veq("epeat" )?REPEAT,
( veq("epeatwhile" )?REPEATWHILE,
( veq("epeatuntil" )?REPEATUNTIL,
( veq("em" )?REM,
( veq("shift" )?RSHIFT,
0))))))))
case $s: ( veq("witchon" )?SWITCHON,
( veq("tatic" )?STATIC,
( veq("ize" )?SIZE,
( veq("tep" )?BY,
( veq("electon" )?SELECTON,
( veq("tructure" )?STRUCTURE,
0))))))
case $t: ( veq("o" )?TO,
( veq("est" )?TEST,
( veq("rue" )?TRUE,
( veq("hen" )?DO,
( veq("able" )?TABLE,
0)))))
case $u: ( veq("nless" )?UNLESS,
( veq("ntil" )?UNTIL,
(SWUnsignedCompares & veq("ls" )?ULS,
(SWUnsignedCompares & veq("le" )?ULE,
(SWUnsignedCompares & veq("gr" )?UGR,
(SWUnsignedCompares & veq("ge" )?UGE,
0))))))
case $v: ( veq("ec" )?VEC,
( veq("alof" )?VALOF,
0))
case $w: ( veq("hile" )?WHILE,
( veq("ord" )?WORD,
0))
case $x: ( veq("or" )?NEQV,
0)
case $y: (0)
case $z: (0)
]
]
and veq(s) = valof // Compare the arg to W
[ unless rv W eq rv s resultis false // Quick test on first words (including length)
let w = W + 1
s = s + 1
for i = 1 to N do
[ unless rv w eq rv s resultis false
w = w + 1; s = s + 1
]
resultis true
]
// The parameter Item of the following routine contains a lexeme and the data for insertion
// of SEMICOLON or DO, packed like this...
// bits 2-3 (0 ? never, 1 ? may, 2 ? must) begin a command
// bits 4-5 (0 ? never, 1 ? may, 2 ? must) end a command
// bits 8-15 the numeric lexeme itself.
// Two kinds of processing are done...
// 1.If last item may or must end a command and this item may begin a command and a NEWLINE
// has intervened between them, insert a SEMICOLON before this item.
// 2. If last item may end a command and this one must begin one, insert a DO before this one.
// The lexeme is written on the LEX file (one byte)
// followed by the V information,if any
// followed by the line pointer
and LexOut(Item) be // Include canonic symbol Item in the lexical stream.
[ Symb = Item // Unpack the lexeme fields
let Beg = (Item & #1400) rshift 8 // (this item) doesn"t, may, does begin a command
and End = (LastItem & #6000) rshift 10 // (the last item) doesn"t, may, does end a command
test NLPending
ifso if Beg>0 & End>0 do // We have a carr.ret. between commands
[ ReadAhead, ExtraItem = true, Item // Remember this item
Symb = SEMICOLON; LexWrite(Symb) // and output a SEMICOLON
]
ifnot if Beg eq 2 & End eq 1 do // We are at the start of a command and need a DO
[ ReadAhead, ExtraItem = true, Item // Remember this item
Symb = DO; LexWrite(Symb) // and output a DO
]
if NLPending do LexWrite(LINE)
unless ReadAhead do LexWrite(Item) // If no extra item, output the lexeme
LastItem = Item // Remember this item for next time
NLPending = false // Reset NLPending
]
//----------------------------------------------------------------------------
and LexWrite(item) be // Write the lexeme, perhaps with info from V
//----------------------------------------------------------------------------
[
switchon item into
[
case AND: case DO: case OR: case IFSO: case IFNOT: case INTO:
LexWrite(SEMICOLON);
]
Writech(LexStream, item & #377); LexLength = LexLength + 1;
if SWLexTrace do [ WriteS("*t*******s"); ]
switchon item into
[
case NAME:
[
Writeaddr(LexStream, V!0); LexLength = LexLength + 2;
if SWLexTrace then
[ WriteS("NAME "); WriteS(lv (Dictionary!(V!0))); WriteO(V!0); ]
endcase
]
case LINE:
[
Writeaddr(LexStream, NewLineptr+1); LexLength = LexLength + 2;
if SWLexTrace then
[ WriteS("LINE "); WriteO(NewLineptr+1); ]
endcase
]
case END:
[
Writeaddr(LexStream, V!0); LexLength = LexLength + 2;
if SWLexTrace then [ WriteS("END "); WriteO(V!0); ]
endcase
]
case CHARCONST: case NUMBER:
[
Writeword(LexStream, V!0); LexLength = LexLength + 2;
if SWLexTrace then [ WriteN(item & #377); WW($*s); WriteO(V!0); ]
endcase
]
case NAMEBRA: case NAMEKET: case STRINGCONST:
[
for i = 0 to Length(V)/Bytesperword do
[ Writeword(LexStream, V!i); LexLength = LexLength + 2; ]
if SWLexTrace then [ WriteN(item & #377); WW($*s); WriteS(V); ]
endcase
]
default: if SWLexTrace then WriteN(item & #377);
]
if SWLexTrace then WW($*n);
]
and DoString() be
[ let Type = Ch // Remember what it was.
and Vp = 0 // A counter
and VV = vec StringLength // A place to put the characters of the string.
[ Rch()
if Ch eq Type & Type eq $*" do // Just read the end of a string.
[ VV!0 = Vp; Packstring(VV, V) // Pack the string into V.
LexOut(STRINGCONST)
return
]
if Vp > StringLength % Ch eq #777 % Ch eq $*n do
[ LEXreport(9)
V!0 = "?"!0
LexOut(STRINGCONST)
return
]
if Ch eq $** do
[ Rch()
Ch = valof
[ switchon Ch into
[ default: LEXreport(10); resultis Ch
case $*": resultis #42
case $**: resultis #52
case $C: case $c: resultis #15
case $L: case $l: resultis #12
case $S: case $s: resultis #40 // space
case $T: case $t: resultis #11
case $N: case $n: resultis #15 // new line
case $0: case $1: case $2: case $3: // Octal escape.
case $4: case $5: case $6: case $7:
[ let t = Ch & 7
Rch()
t = (t lshift 3) + (Ch&7)
Rch()
t = (t lshift 3) + (Ch&7)
unless t le #377 do LEXreport(6)
resultis t
]
]
]
]
Vp = Vp + 1; VV!Vp = Ch // Store the character.
if Type eq $*" loop // Keep reading a string constant.
V!0 = Ch; LexOut(CHARCONST)
return
]
repeat
]
and Kind(Chr) = valof
[ if Chr ge $a & Chr le $z resultis Small
if Chr ge $A & Chr le $Z resultis Capital
if Chr ge $0 & Chr le $9 resultis Digit
if Chr eq $*s % Chr eq $*t % Chr eq 0 resultis Ignorable
if Chr eq #32 resultis BravoTail // ↑Z
resultis Simple
]
and DoNumber(radix) = valof
[ let n = 0
///*DCS* for command line manifests -- see LEX0
let flag = false
if radix < 0 then
[
flag = true
radix = -radix
]
V!0 = 0
while $0 le Ch & Ch ls ($0 + radix) do
[ V!0 = V!0 + 1; V!(V!0) = Ch; Rch() ]
if V!0 gr 6 do LEXreport(6)
test Ch eq $B % Ch eq $b
ifnot test radix eq 8
then n = Ovalue(V) or n = Dvalue(V)
ifso [ n = Ovalue(V)
let m = 0
Rch()
if $0 le Ch & Ch le $9 do
[ m = Ch-$0
Rch()
if $0 le Ch & Ch le $9 do
[ m = m*10 + (Ch-$0)
Rch()
]
]
unless m le 15 do LEXreport(6)
let t = n lshift m
unless (t rshift m) eq n do LEXreport(6)
n = t
]
///*DCS* flag test for command line manifests
V!0 = n; unless flag do LexOut(NUMBER)
Chkind = Kind(Ch)
resultis n
]
and Ovalue(v) = valof
[ let n = 0
for i = 1 to v!0 do
[ unless $0 le v!i & v!i le $7 do [ LEXreport(6); resultis n ]
let t = (n lshift 3) + (v!i-$0)
unless (t rshift 3) eq n do [ LEXreport(6); resultis t ]
n = t
]
resultis n
]
and Dvalue(v) = valof
[ let n = 0
for i = 1 to v!0 do
[ unless $0 le v!i & v!i le $9 do [ LEXreport(6); resultis n ]
let t = n*10 + (v!i-$0)
unless t/10 eq n do [ LEXreport(6); resultis t ]
n = t
]
resultis n
]