// 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
  ]