GET "SY:BCPLIB"
 
MANIFEST $(
TREEMAX=6000
$)
 
 
STATIC $(
REPORTCOUNT=0
BCPL=0
OCODE=0
LIST=0
LINE=0
LINEP=0
LINELENGTH=0
LINECOUNT=0
DATASET=0
CSIBLOCK=0
GETCSI=0
DEFAULTERROR=0
ENDC.P=0
ENDC.L=0
OUTPUTTING=0
INPUTOPEN=0
LISTBCPL=0
$)
 
GLOBAL $(
//OPTIONS
PRINTINGNAMES=61
PRINTINGTREE=60
LISTGET=62
//
GETTING:70
PERFORMGET:71
CONSOLE:72
REPORTERROR:73
REPORTMAX:74
RCH:75
CH:76
MARKERROR:77
FORMTREE:78
PRINTTREE:79
PRINTNAMES:80
COMPILEAE:81
LISTING:82
$)
 
LET MOREINPUT() = VALOF 
    $( IF INPUTOPEN $( CLOSE(INPUT); INPUTOPEN := FALSE $)
       UNLESS GETTING
       $( ERROR := SWERR
          DATASET := PARSEINPUT(CSIBLOCK,0)
          ERROR := DEFAULTERROR
          IF DATASET = 0 RESULTIS FALSE
          ERROR := IOPERR
          BCPL := OPENINPUT(DATASET,IDFNB(),120)
          ERROR := DEFAULTERROR $)
       INPUT := BCPL
       INPUTOPEN := TRUE
       GETTING := FALSE
       LISTING := LISTBCPL
       RESULTIS TRUE $)
 
AND RDLINE() BE
    $( READREC(INPUT,LINE)
       TEST ENDOFFILE(INPUT)
       THEN TEST MOREINPUT()
            THEN RDLINE()
            OR   ENDJOB(0)
       OR   $( LINELENGTH := LINE%0
               IF LISTING
               $( IF LINECOUNT REM 60 = 0 WRITES("*P*N")
                  LINECOUNT := LINECOUNT+1
                  WRITED(LINECOUNT,3)
                  WRITES("  ")
                  WRITES(LINE)
                  NEWLINE() $)
               UNPACKSTRING(LINE, LINE)
               LINEP := 1 $) $)
 
AND RCH() BE
    $( IF LINEP=0 RDLINE()
       TEST LINEP>LINELENGTH
       THEN $( CH := '*N'; LINEP := 0 $)
       OR   $( CH := LINE%LINEP; LINEP := LINEP+1 $) $)
 
AND MARKERROR() BE
    $( TEST LISTING
       THEN FOR I=1 TO 5 WRITEC('*S')
       OR   $( FOR I=1 TO LINELENGTH WRITEC(LINE%I)
               NEWLINE() $)
       FOR I=2 TO LINEP WRITEC('*S')
       WRITES("^*N") $)
 
AND PERFORMGET(S) BE
    $( ERROR := GETERR
       GETCSI := ANALYZE(S)
       DATASET := PARSEOUTPUT(GETCSI,0)
       INPUT := OPENINPUT(DATASET,GDFNB(),120)
       UNHEAP(GETCSI)
       GETTING := TRUE
       IF LISTING LISTING := LISTGET
       LISTGET := FALSE
       ERROR := DEFAULTERROR 
       RDLINE()
       RCH() $)
 
AND DUMMY() BE $(
    CODE "	.MCALL	NMBLK$"
    CODE "IDFN:	NMBLK$	INPUT,BCL"
    CODE "ODFN:	NMBLK$	OUTPUT,OCO"
    CODE "LDFN:	NMBLK$	OUTPUT,LST"
    CODE "GDFN:	NMBLK$	BCPLIB,GET"
    CODE "	.MCALL	CSI$SW,CSI$ND"
    CODE "SWTB:	CSI$SW	TR,-1,GV+120."
    CODE "	CSI$SW	NA,-1,GV+122."
    CODE "	CSI$SW	GE,-1,GV+124."
    CODE "	CSI$ND"  $)
 
AND IDFNB() BE CODE "	MOV	#IDFN/2,R0"
 
AND ODFNB() BE CODE "	MOV	#ODFN/2,R0"
 
AND LDFNB() BE CODE "	MOV	#LDFN/2,R0"
 
AND GDFNB() BE CODE "	MOV	#GDFN/2,R0"
 
AND SWITCH() BE CODE "	MOV	#SWTB/2,R0"
 
AND CMLERR() BE
    $( WRITES("COMMAND LINE ERROR*N")
       ENDWRITE(CONSOLE)
       FINISH $)
 
AND SYNERR() BE ENDJOB("SYNTAX ERROR")
 
AND SWERR()  BE ENDJOB("ILLEGAL SWITCH")
 
AND OOPERR() BE ENDJOB("OPEN FAIL ON OUTPUT FILE")
 
AND LOPERR() BE ENDJOB("OPEN FAIL ON LIST FILE")
 
AND IOPERR() BE ENDJOB("OPEN FAIL ON INPUT FILE")
 
AND GETERR() BE
    $( UNHEAP(GETCSI)
       ENDJOB("FAILURE IN 'GET'") $)
 
AND REPORTERROR(S,M) BE
    $( WRITES(S)
       WRITES(M)
       NEWLINE()
       REPORTCOUNT := REPORTCOUNT+1
       IF REPORTCOUNT GE REPORTMAX ENDJOB(0) $)
 
AND ENDJOB(S) BE
    $( OUTPUT := CONSOLE
       TEST S=0
       THEN IF REPORTCOUNT>0
            $( WRITES("COMPILATION ")
               WRITES(REPORTCOUNT GE REPORTMAX -> "ABORTED", "FAILED")
               WRITES(" - ")
               WRITEN(REPORTCOUNT)
               WRITES(" ERROR")
               UNLESS REPORTCOUNT=1 WRITEC('S')
               NEWLINE() $)
       OR $( WRITES("BCPL -- "); WRITES(S); NEWLINE() $)
       LONGJUMP(ENDC.P, ENDC.L) $)
 
START:
$(S   LET OB = VEC 120
      LET LB = VEC 120
      LET IB = VEC 120
      LET CB = VEC 41
      LET OS = VEC STREAMSIZE
      LET TS = VEC STREAMSIZE
      LET T  = VEC TREEMAX
      LET COMMAND = 0
      LINE := IB
      OCODE := OS
      OCODE%BUFFER := OB
      OCODE%ENDOF := ENDOFFILE
      OCODE%TRANSFER := WRITEREC
      LIST := TS
      LIST%BUFFER := LB
      LIST%ENDOF := ENDOFFILE
      LIST%TRANSFER := WRITEREC
      INITIALIZEIO()
      CONSOLE := CREATEOUTPUT("TI:")
      ENDC.P, ENDC.L := LEVEL(), ENDC
      DEFAULTERROR := ERROR
 
NEXT: OUTPUT := CONSOLE
      REPORTCOUNT, REPORTMAX := 0, 6
      LISTING, OUTPUTTING := FALSE, FALSE
      GETTING, INPUTOPEN := FALSE, FALSE
      PRINTINGNAMES, PRINTINGTREE := FALSE, FALSE
      LISTGET, LISTBCPL := FALSE, FALSE
      ERROR := CMLERR
      COMMAND := READCOMMAND("BCPL>", CB)
      IF COMMAND=0 GOTO EXIT
      ERROR := SYNERR
      CSIBLOCK := ANALYZE(COMMAND)
      UNLESS MOREINPUT() SYNERR()
      ERROR := SWERR
      DATASET := PARSEOUTPUT(CSIBLOCK,0)
      UNLESS DATASET=0
      $( ERROR := OOPERR
         OCODE%FILE := OPENOUTPUT(DATASET,ODFNB(),120)
         OCODE%POINTER := 0
         OUTPUTTING := TRUE $)
      ERROR := SWERR
      DATASET := PARSEOUTPUT(CSIBLOCK,SWITCH())
      UNLESS DATASET=0
      $( ERROR := LOPERR
         LIST%FILE := OPENOUTPUT(DATASET,LDFNB(),120)
         LIST%POINTER := 0
         LISTBCPL := TRUE
         LISTING := TRUE $)
      ERROR := DEFAULTERROR
      $( LET A = 0
         OUTPUT := LISTING -> LIST, CONSOLE
         LINECOUNT, LINEP := 0, 0
         A := FORMTREE(T)
         IF PRINTINGTREE PRINTTREE(A)
         IF PRINTINGNAMES PRINTNAMES()
         OUTPUT := OCODE
         IF OUTPUTTING COMPILEAE(A) $) REPEAT
ENDC: IF LISTBCPL CLOSE(LIST%FILE)
      IF OUTPUTTING CLOSE(OCODE%FILE)
      IF GETTING CLOSE(INPUT)
      IF INPUTOPEN CLOSE(BCPL)
      UNHEAP(CSIBLOCK)
      GOTO NEXT
 
EXIT: ENDWRITE(CONSOLE)
      FINISH $)S
.
 

//\*   /DGIM/TPP1   15.7  6/5 


GET  "SY:TSYN.GET"
 
LET NEXTSYMB() BE 
$(1   NLPENDING := FALSE 
NEXT:
 
    SWITCHON CH INTO 
 
    $( CASE '*P': 
       CASE '*N': NLPENDING := TRUE  // IGNORABLE CHARACTERS 
       CASE '*T': 
       CASE 0: 
         CASE #15:  // CARRIAGE RETURN
       CASE '*S': RCH() REPEATWHILE CH='*S' 
                  GOTO NEXT 
 
       CASE '0':CASE '1':CASE '2':CASE '3':CASE '4': 
       CASE '5':CASE '6':CASE '7':CASE '8':CASE '9': 
             DECVAL := CH - '0' 
             OCTVAL := DECVAL 
             SYMB := S.NUMBER 
 
             $( RCH() 
                UNLESS '0' LE CH LE '9' RETURN 
                DECVAL := DECVAL*10 + CH - '0' 
                OCTVAL := (OCTVAL<<3) + CH - '0'  $) REPEAT
 
       CASE 'A':CASE 'B':CASE 'C':CASE 'D':CASE 'E': 
       CASE 'F':CASE 'G':CASE 'H':CASE 'I':CASE 'J': 
       CASE 'K':CASE 'L':CASE 'M':CASE 'N':CASE 'O': 
       CASE 'P':CASE 'Q':CASE 'R':CASE 'S':CASE 'T': 
       CASE 'U':CASE 'V':CASE 'W':CASE 'X':CASE 'Y': 
       CASE 'Z': 
       CASE #141:CASE #142:CASE #143:CASE #144:
       CASE #145:CASE #146:CASE #147:CASE #150:
       CASE #151:CASE #152:CASE #153:CASE #154:
       CASE #155:CASE #156:CASE #157:CASE #160:
       CASE #161:CASE #162:CASE #163:CASE #164:
       CASE #165:CASE #166:CASE #167:CASE #170:
       CASE #171:CASE #172:
              RDTAG() 
              SYMB := LOOKUPWORD() 
              IF SYMB=S.GET DO
              $( NEXTSYMB()
                 UNLESS SYMB=S.STRING $( REPORT(97); GOTO NEXT $)
                 TEST GETTING
                 THEN REPORT(93)
                 OR   PERFORMGET(WORDV)
                 GOTO NEXT $)
              RETURN 
 
       CASE '$': RCH() 
                 IF CH='8' DO $( SYMB := S.OCT; GOTO L  $) 
                 IF CH='(' \/ CH=')' DO 
                       $( SYMB := CH='(' -> S.LSECT, S.RSECT 
                          CH := '$' 
                          RDTAG() 
                          LOOKUPWORD() 
                          RETURN   $) 
 
                 REPORT(91) 
                 RCH() 
                 GOTO NEXT 
 
       CASE #173:
       CASE #175: SYMB := CH=#173 -> S.LSECT, S.RSECT
                 CH := '$'
                 RDTAG()
                 LOOKUPWORD()
                 RETURN
 
       CASE '[': 
       CASE '(': SYMB := S.LPAREN; GOTO L 
       CASE ']': 
       CASE ')': RCH()
                 IF CH='.' DO $( RCH() REPEATUNTIL CH='(' \/ CH='['
                                 SYMB := S.COMMA
                                 GOTO L  $)
                 SYMB := S.RPAREN
                 RETURN
       CASE '#': SYMB := S.OCT; GOTO L 
       CASE #176: SYMB := S.NOT; GOTO L
       CASE '+': SYMB := S.PLUS; GOTO L 
       CASE ',': SYMB := S.COMMA; GOTO L 
       CASE '!': SYMB := S.INFIX; GOTO L
       CASE '@': SYMB := S.LV; GOTO L 
       CASE '&': SYMB := S.LOGAND; GOTO L 
       CASE '=': SYMB := S.EQ; GOTO L 
       CASE '|':
       CASE '%': SYMB := S.VECAP; GOTO L 
       CASE '**': SYMB := S.MULT; GOTO L 
       CASE ';': RCH()
                 IF CH=';' DO $( SYMB := S.SEQ; GOTO L $)
                 SYMB := S.SEMICOLON
                 RETURN
 
       CASE '/': RCH() 
                 IF CH='\' DO $( SYMB := S.LOGAND; GOTO L $) 
                 IF CH='**' DO $( $( RCH() REPEATUNTIL CH='**'
                                     RCH(); IF CH='/' BREAK $) REPEAT
                                  RCH(); GOTO NEXT $)
                 UNLESS CH='/' DO $( SYMB := S.DIV; RETURN  $) 
 
        RCH() REPEATUNTIL CH='*N' 
                 GOTO NEXT 
 
       CASE '\': RCH() 
                 IF CH='/' DO $( SYMB := S.LOGOR; GOTO L  $) 
                 IF CH='=' DO $( SYMB := S.NE; GOTO L  $) 
                 SYMB := S.NOT 
                 RETURN 
 
       CASE '<': RCH() 
                 IF CH='=' DO $( SYMB := S.LE; GOTO L  $) 
                 IF CH='<' DO $( SYMB := S.LSHIFT; GOTO L $) 
                 IF CH='>' DO $( SYMB := S.SEQ; GOTO L $)
                 SYMB := S.LS 
                 RETURN 
 
       CASE '>': RCH() 
                 IF CH='=' DO $( SYMB := S.GE; GOTO L  $) 
                 IF CH='>' DO $( SYMB := S.RSHIFT; GOTO L  $) 
                 SYMB := S.GR 
                 RETURN 
 
       CASE '-': RCH() 
                 IF CH='>' DO $( SYMB := S.COND; GOTO L  $) 
                 SYMB := S.MINUS 
                 RETURN 
 
       CASE ':': RCH() 
                 IF CH='=' DO $( SYMB := S.ASS; GOTO L  $) 
                 SYMB := S.COLON 
                 RETURN 
 
        CASE '*'':CASE '*"': 
             $(1 LET QUOTE = CH 
                 LET LENGTH = 0
              $( RCH() 
                 IF CH=QUOTE \/ LENGTH=255 DO 
                        $( UNLESS CH=QUOTE DO REPORT(95) 
                           TEST LENGTH=1 & CH='*'' 
                           THEN SYMB := S.CHAR
                           OR $( WORDV%0 := LENGTH
                                 PACKSTRING(WORDV, WORDV)
                                 WORDLENGTH := (LENGTH+3)/2
                                 SYMB := S.STRING $)
                           GOTO L   $) 
 
 
                 IF CH='**' DO 
                        $( RCH() 
                           CH := CH='N' -> 10,
                                 CH='S' -> 32,
                                 CH='T' -> 9,
                                 CH='P' -> 12,
                                 CH='E' -> 26,
                                 CH='C' -> 13,
                                 CH='L' -> 10,
                                 CH='^' -> VALOF $( RCH(); RESULTIS CH&31 $),
                                 CH $)
 
                 DECVAL := CH 
                 LENGTH := LENGTH+1
                 WORDV%LENGTH := CH  $) REPEAT  $)1 
 
 
 
       CASE '.': SYMB := S.END
                 RETURN

       DEFAULT:    CH := '*S' 
                   REPORT(94) 
                   GOTO NEXT     
 
       L: RCH()   $)1 
 
.

 

//\*   /DGIM/TPP2   20.13  5/5 


GET  "SY:TSYN.GET"
 
LET DECLSYSWORDS() BE 
 
     $( LET V = WORDV 
 
        LET D(S, ITEM) BE $( LET LENGTH = S%0  
                             WORDLENGTH := (LENGTH+3)/2 
                             WORDV := S 
                             LOOKUPWORD() 
                             WORDNODE%0 := ITEM  $) 
 
        D('AND', S.AND) 
 
        D('BE', S.BE) 
        D('BREAK', S.BREAK) 
        D('BY', S.BY) 
 
        D('CASE', S.CASE) 
        D('CODE', S.CODE)
 
        D('DO', S.DO) 
        D('DEFAULT', S.DEFAULT) 
 
        D('EQ', S.EQ) 
        D('EQV', S.EQV) 
        D('ENDCASE', S.ENDCASE) 
 
        D('FALSE', S.FALSE) 
        D('FOR', S.FOR) 
        D('FINISH', S.FINISH) 
 
        D('GOTO', S.GOTO) 
        D('GE', S.GE) 
        D('GR', S.GR) 
        D('GLOBAL', S.GLOBAL) 
        D('GET', S.GET) 
 
        D('IF', S.IF) 
        D('INTO', S.INTO) 
        D('IS', S.BE)
 
        D('LET', S.LET) 
        D('LV', S.LV) 
        D('LE', S.LE) 
        D('LS', S.LS) 
        D('LOGOR', S.LOGOR) 
        D('LOGAND', S.LOGAND) 
        D('LOOP', S.LOOP)
        D('LSHIFT', S.LSHIFT) 
 
        D('MANIFEST', S.MANIFEST) 
 
        D('NE', S.NE) 
        D('NOT', S.NOT) 
        D('NEQV', S.NEQV) 
 
        D('OR', S.OR) 
 
        D('RESULTIS', S.RESULTIS) 
        D('RETURN', S.RETURN) 
        D('REM', S.REM) 
        D('RSHIFT', S.RSHIFT) 
        D('RV', S.RV) 
        D('REPEAT', S.REPEAT) 
        D('REPEATWHILE', S.REPEATWHILE) 
        D('REPEATUNTIL', S.REPEATUNTIL) 
 
        D('SWITCHON', S.SWITCHON) 
        D('STATIC', S.STATIC) 
 
        D('TO', S.TO) 
        D('TEST', S.TEST) 
        D('TRUE', S.TRUE) 
        D('THEN', S.DO) 
        D('TABLE', S.TABLE) 
 
        D('UNTIL', S.UNTIL) 
        D('UNLESS', S.UNLESS) 
 
        D('VEC', S.VEC) 
        D('VALOF', S.VALOF) 
 
        D('WHERE', S.WHERE)
        D('WHILE', S.WHILE) 
 
        D('$', 0); NULLTAG := WORDNODE 
 
        WORDV := V    $) 
 
 
 
AND LOOKUPWORD() = VALOF 
 
    $(1 LET M = LV NAMETREE 
 
  NEXT: WORDNODE := RV M 
        IF WORDNODE NE 0 DO 
            $(2 LET P = WORDNODE+3 
 
                FOR I = 0 TO WORDLENGTH-1 DO 
                  $( LET X, Y = P%I, WORDV%I 
                     IF X>Y DO $( M := WORDNODE+1; GOTO NEXT  $) 
                     IF X<Y DO $( M := WORDNODE+2; GOTO NEXT $)  $) 
 
                RESULTIS WORDNODE%0   $)2 
 
        WORDNODE := NEWVEC(WORDLENGTH+2) 
        WORDNODE%0, WORDNODE%1, WORDNODE%2 := S.NAME, 0, 0 
        FOR I = 0 TO WORDLENGTH-1 DO WORDNODE%(I+3) := WORDV%I 
        RV M := WORDNODE 
        RESULTIS S.NAME    $)1 
 
AND RDTAG() BE
    $(  LET LENGTH = 1
        $( WORDV%LENGTH := CH
           RCH()
           UNLESS 'A' LE CH LE 'Z' \/
                  '0' LE CH LE '9' \/
                  #141 LE CH LE #172 \/
                  CH = '.' BREAK
           LENGTH := LENGTH+1 $) REPEAT
        WORDV%0 := LENGTH
        WORDLENGTH := (LENGTH+3)/2
        PACKSTRING(WORDV, WORDV) $)
.

 


 

//\*   /DGIM/TCAE0   14.18  6/5 


GET  "SY:TSYN.GET"
 
LET NEWVEC(N) = VALOF 
    $( TREEP := TREEP - N - 1 
       IF TREEP LE TREEVEC DO 
                $( REPORTMAX := 0 
                   REPORT(98)  $) 
        RESULTIS TREEP  $) 
 
AND LIST1(X) = VALOF 
    $( LET P = NEWVEC(0) 
       P%0 := X 
       RESULTIS P  $) 
 
AND LIST2(X, Y) = VALOF 
     $( LET P = NEWVEC(1) 
        P%0, P%1 := X, Y 
        RESULTIS P   $) 
 
AND LIST3(X, Y, Z) = VALOF 
     $( LET P = NEWVEC(2) 
        P%0, P%1, P%2 := X, Y, Z 
        RESULTIS P     $) 
 
AND LIST4(X, Y, Z, T) = VALOF 
     $( LET P = NEWVEC(3) 
        P%0, P%1, P%2, P%3 := X, Y, Z, T 
        RESULTIS P   $) 
 
AND LIST5(X, Y, Z, T, U) = VALOF 
     $( LET P = NEWVEC(4) 
        P%0, P%1, P%2, P%3, P%4 := X, Y, Z, T, U 
        RESULTIS P   $) 
 
AND LIST6(X, Y, Z, T, U, V) = VALOF 
     $( LET P = NEWVEC(5) 
        P%0, P%1, P%2, P%3, P%4, P%5 := X, Y, Z, T, U, V 
        RESULTIS P  $) 
 
AND CAEREPORT(N) BE 
     $( MARKERROR()
        REPORTERROR("******  SYNTAX ERROR, ",MESSAGE(N))
        NLPENDING := FALSE
        UNTIL SYMB=S.LSECT \/ SYMB=S.RSECT \/ 
              SYMB=S.LET \/ SYMB=S.AND \/  
              SYMB=S.END \/ NLPENDING 
                     NEXTSYMB() 
        LONGJUMP(REC.P, REC.L)   $) 
 
AND FORMTREE(T) =  VALOF 
     $( LET V = VEC 100
        LET R = REPORT 
        LET A = 0
        WORDV := V
        REPORT := CAEREPORT 
        TREEVEC := T
        TREEP := TREEVEC+TREEMAX
        NAMETREE := 0 
        DECLSYSWORDS() 
 
        REC.P, REC.L := LEVEL(), L 
 
        RCH() 
     L: NEXTSYMB() 
        A := RDBLOCKBODY() 
        UNLESS SYMB=S.END DO $( REPORT(99); GOTO L  $) 
 
        IF LISTING $(
        WRITES("TREESIZE = ")
        WRITEN(TREEVEC+TREEMAX-TREEP)
        NEWLINE() $)
        REPORT := R 
        RESULTIS A        $) 
 
AND PRINTTREE(A) BE
     $( WRITES("*NAE TREE*N-------*N")
        PLIST(A,0,20)
        NEWLINE() $)
 
AND PRINTNAMES() BE
     $( LET P(T) BE
        $( IF T=0 RETURN
           P(T%1)
           IF T%0 = S.NAME $( WRITES(T+3); NEWLINE() $)
           P(T%2) $)
        WRITES("*NNAMES*N-----*N")
        P(NAMETREE) $)
 
 
 
AND MESSAGE(N) = VALOF 
         $( SWITCHON N INTO 
 
         $( DEFAULT: RESULTIS "UNKNOWN ERROR"
 
            CASE 91: RESULTIS  "'8'  '(' OR ')' EXPECTED"  
           CASE 93: RESULTIS  "NESTED GET"
            CASE 94: RESULTIS  "ILLEGAL CHARACTER"  
            CASE 95: RESULTIS  "STRING TOO LONG"  
            CASE 97: RESULTIS  "STRING EXPECTED"  
            CASE 98: RESULTIS  "PROGRAM TOO LARGE"  
            CASE 99: RESULTIS  "INCORRECT TERMINATION"  
 
            CASE 1:CASE 8:CASE 40:CASE 43: CASE 64: 
                     RESULTIS  "NAME EXPECTED"  
            CASE 2:CASE 6: RESULTIS  "'$(' EXPECTED"  
            CASE 4:CASE 7: RESULTIS  "'$)' EXPECTED"  
            CASE 9: RESULTIS  "UNTAGGED '$)' MISMATCH"  
            CASE 32: RESULTIS  "EXPRESSION MISSING"  
            CASE 33: RESULTIS  "ERROR IN OCTAL NUMBER"  
            CASE 15:CASE 19:CASE 41: RESULTIS  "')' MISSING"  
            CASE 30: RESULTIS  "',' MISSING"  
            CASE 42: RESULTIS  "'=' OR 'BE' EXPECTED"  
            CASE 44: RESULTIS  "'=' OR '(' EXPECTED"  
            CASE 50: RESULTIS  "ERROR IN LABEL"  
            CASE 51: RESULTIS  "':=' OR ':' EXPECTED"  
            CASE 54: RESULTIS  "'OR' EXPECTED"  
            CASE 57: RESULTIS  "'=' EXPECTED"  
            CASE 58: RESULTIS  "'TO' EXPECTED"  
            CASE 60: RESULTIS  "'INTO' EXPECTED"  
            CASE 61:CASE 62: RESULTIS  "':' EXPECTED"  
                        $)  $) 
 
 
 
.

 

//\*   /DGIM/TCAE1   21.41  5/5 


GET  "SY:TSYN.GET"
 
LET RDBLOCKBODY() = VALOF 
    $(1 LET P, L = REC.P, REC.L 
        LET A = 0 
 
        REC.P, REC.L := LEVEL(), RECOVER 
 
        SWITCHON SYMB INTO 
     $( CASE S.MANIFEST: 
        CASE S.STATIC: 
        CASE S.GLOBAL: 
            $(  LET OP = SYMB 
                NEXTSYMB() 
                A := RDSECT(RDCDEFS) 
                A := LIST3(OP, A, RDBLOCKBODY()) 
                GOTO RET  $) 
 
        CASE S.LET: NEXTSYMB() 
                    A := RDEF() 
           RECOVER: WHILE SYMB=S.AND DO 
                          $( NEXTSYMB() 
                             A := LIST3(S.AND, A, RDEF())  $) 
                    A := LIST3(S.LET, A, RDBLOCKBODY()) 
                    GOTO RET 
 
        DEFAULT: A := RDSEQ() 
 
          RET:   REC.P, REC.L := P, L 
                 RESULTIS A   $)1 
 
AND RDSEQ() = VALOF 
    $( LET A = 0 
       IGNORE(S.SEMICOLON) 
       A := RCOM() 
       IF SYMB=S.RSECT \/ SYMB=S.END \/ A=0 RESULTIS A 
       RESULTIS LIST3(S.SEQ, A, RDSEQ())   $) 
 
 
 
AND RDCDEFS() = VALOF 
    $(1 LET A, B = 0, 0 
 
        $( B := RNAME() 
           IGNORE(S.EQ) 
           IGNORE(S.COLON) 
           A := LIST4(S.CONSTDEF, A, B, REXP(0)) 
           IGNORE(S.SEMICOLON) $) REPEATWHILE SYMB=S.NAME 
 
        RESULTIS A  $)1 
 
AND RDSECT(R) = VALOF 
    $(  LET TAG, A = WORDNODE, 0 
        CHECKFOR(S.LSECT, 6) 
        A := R() 
        UNLESS SYMB=S.RSECT DO 
                $( REPORT(7) 
                   UNTIL SYMB=S.RSECT \/ SYMB=S.END DO NEXTSYMB() $) 
        TEST TAG=WORDNODE 
             THEN NEXTSYMB() 
               OR IF WORDNODE=NULLTAG DO  
                      $( SYMB := 0 
                         REPORT(9)  $) 
        RESULTIS A   $) 
 
 
AND RNAMELIST() = VALOF 
    $(  LET A = RNAME() 
        UNLESS SYMB=S.COMMA RESULTIS A 
        NEXTSYMB() 
        RESULTIS LIST3(S.COMMA, A, RNAMELIST())   $) 
 
 
AND RNAME() = VALOF 
    $( LET A = WORDNODE 
       CHECKFOR(S.NAME, 8) 
       RESULTIS A  $) 
 
AND IGNORE(ITEM) BE 
    $( IF SYMB=ITEM DO NEXTSYMB()  $) 
 
AND CHECKFOR(ITEM, N) BE 
      $( UNLESS SYMB=ITEM DO REPORT(N) 
         NEXTSYMB()  $) 
.

 

//\*   /DGIM/TCAE2   12.34  2/9 


GET  "SY:TSYN.GET"
 
LET RBEXP() = VALOF 
  $(1   LET A, OP = 0, SYMB 
 
        SWITCHON SYMB INTO 
 
    $(  DEFAULT: REPORT(32) 
                 NEXTSYMB() 
                 RESULTIS LIST2(S.NUMBER, 0) 
 
        CASE S.TRUE: 
        CASE S.FALSE: 
        CASE S.NAME:  A := WORDNODE 
                      NEXTSYMB() 
                      RESULTIS A 
 
        CASE S.STRING: 
                A := NEWVEC(WORDLENGTH) 
                A%0 := S.STRING 
                FOR I = 0 TO WORDLENGTH-1 DO A%(I+1) := WORDV%I 
                NEXTSYMB() 
                RESULTIS A 
 
        CASE S.OCT: 
                NEXTSYMB() 
                UNLESS SYMB=S.NUMBER DO REPORT(33) 
                DECVAL := OCTVAL 
 
        CASE S.CHAR: 
        CASE S.NUMBER: 
                A := LIST2(S.NUMBER, DECVAL) 
                NEXTSYMB() 
                RESULTIS A 
 
        CASE S.LPAREN: NEXTSYMB() 
                     A := REXP(0) 
                     CHECKFOR(S.RPAREN, 15) 
                     RESULTIS A 
 
        CASE S.CODE: NEXTSYMB()
                     RESULTIS LIST2(OP, REXP(0))
 
        CASE S.VALOF: NEXTSYMB() 
                      RESULTIS LIST2(S.VALOF, RCOM()) 
 
        CASE S.VECAP: OP := S.RV 
        CASE S.LV: 
        CASE S.RV: NEXTSYMB(); RESULTIS LIST2(OP, REXP(35)) 
 
        CASE S.PLUS: NEXTSYMB(); RESULTIS REXP(34) 
 
        CASE S.MINUS: NEXTSYMB() 
                      A := REXP(34) 
                      TEST H1%A=S.NUMBER 
                          THEN H2%A := - H2%A 
                            OR A := LIST2(S.NEG, A) 
                      RESULTIS A 
 
        CASE S.NOT: NEXTSYMB(); RESULTIS LIST2(S.NOT, REXP(24)) 
 
        CASE S.TABLE: NEXTSYMB(); RESULTIS LIST2(S.TABLE, REXP(11))  $)1 
 
 
 
AND REXP(N) = VALOF 
    $(1 LET A = RBEXP() 
 
        LET B, C, P, Q = 0, 0, 0, 0 
 
  L: $( LET OP = SYMB 
        IF NLPENDING RESULTIS A 
        SWITCHON OP INTO 
    $(B DEFAULT: RESULTIS A 
 
        CASE S.LPAREN: NEXTSYMB() 
                     B := 0 
                     UNLESS SYMB=S.RPAREN DO B := REXP(0) 
                     CHECKFOR(S.RPAREN, 19) 
                     A := LIST3(S.FNAP, A, B) 
                     GOTO L 
 
        CASE S.INFIX: IF N GE 40 RESULTIS A
                      NEXTSYMB()
                      B := WORDNODE
                      CHECKFOR(S.NAME, 43)
                      A := LIST3(S.FNAP, B, LIST3(S.COMMA, A, REXP(40)))
                      GOTO L
 
        CASE S.VECAP: P := 40; GOTO LASSOC 
 
        CASE S.REM:CASE S.MULT:CASE S.DIV: P := 35; GOTO LASSOC 
 
        CASE S.PLUS:CASE S.MINUS: P := 34; GOTO LASSOC 
 
        CASE S.EQ:CASE S.NE: 
        CASE S.LE:CASE S.GE: 
        CASE S.LS:CASE S.GR: 
                IF N GE 30 RESULTIS A 
 
            $(R NEXTSYMB() 
                B := REXP(30) 
                A := LIST3(OP, A, B) 
                TEST C=0 THEN C :=  A 
                           OR C := LIST3(S.LOGAND, C, A) 
                A, OP := B, SYMB  $)R REPEATWHILE S.EQ LE OP LE S.GE 
 
                A := C 
                GOTO L 
 
        CASE S.LSHIFT:CASE S.RSHIFT: P, Q := 25, 30; GOTO DIADIC 
 
        CASE S.LOGAND: P := 23; GOTO LASSOC 
 
        CASE S.LOGOR: P := 22; GOTO LASSOC 
 
        CASE S.EQV:CASE S.NEQV: P := 21; GOTO LASSOC 
 
        CASE S.COND: 
                IF N GE 13 RESULTIS A 
                NEXTSYMB() 
                B := REXP(12) 
                CHECKFOR(S.COMMA, 30) 
                A := LIST4(S.COND, A, B, REXP(12)) 
                GOTO L 
 
        CASE S.COMMA: P, Q := 12, 11; GOTO DIADIC 
 
 
        LASSOC: Q := P 
 
        DIADIC: IF N GE P RESULTIS A 
                NEXTSYMB() 
                A := LIST3(OP, A, REXP(Q)) 
                GOTO L                     $)B     $)1 
 
.

 

//\*   /DGIM/TCAE3   12.30  25/6 


GET  "SY:TSYN.GET"
 
LET RDEF() = VALOF 
    $(1 LET N = RNAMELIST() 
        SWITCHON SYMB INTO 
     $( CASE S.LPAREN: 
             $( LET A = 0 
                NEXTSYMB() 
                UNLESS H1%N=S.NAME DO REPORT(40) 
                IF SYMB=S.NAME DO A := RNAMELIST() 
                CHECKFOR(S.RPAREN, 41) 
                IF SYMB=S.BE DO 
                     $( NEXTSYMB() 
                        RESULTIS LIST5(S.RTDEF, N, A, RCOM(), 0)  $) 
 
                IF SYMB=S.EQ DO 
                     $( NEXTSYMB() 
                        RESULTIS LIST5(S.FNDEF, N, A, REXP(0), 0)  $) 
 
                REPORT(42) 
                RESULTIS LIST3(S.VALDEF, N, N)  $) 
 
        DEFAULT: REPORT(44) 
 
        CASE S.EQ: 
             $( LET OP = S.VALDEF 
                NEXTSYMB() 
                IF SYMB=S.VEC DO 
                     $( OP := S.VECDEF 
                        NEXTSYMB() 
                        UNLESS H1%N=S.NAME DO REPORT(43)  $) 
                RESULTIS LIST3(OP, N, REXP(0))  $)1 
 
.

 

//\*   /DGIM/TCAE4   14.57  10/4 


GET  "SY:TSYN.GET"
 
LET RBCOM() = VALOF 
   $(1 LET A, B, OP = 0, 0, SYMB 
 
        SWITCHON SYMB INTO 
     $( DEFAULT: RESULTIS 0 
 
        CASE S.NAME:CASE S.NUMBER:CASE S.STRING:CASE S.CHAR: 
        CASE S.TRUE:CASE S.FALSE:CASE S.LV:CASE S.RV:CASE S.VECAP: 
        CASE S.LPAREN:CASE S.VALOF:CASE S.PLUS:CASE S.MINUS: 
        // THESE ARE ALL THE SYMBOL WHICH CAN START AN EXPRESSION 
                A := REXP(0) 
                IF SYMB=S.ASS DO  
                       $( NEXTSYMB() 
                          RESULTIS LIST3(S.ASS, A, REXP(0))  $) 
 
                IF SYMB=S.COLON DO 
                     $( UNLESS H1%A=S.NAME DO REPORT(50) 
                        NEXTSYMB() 
                        RESULTIS LIST4(S.COLON, A, RCOM(), 0)  $) 
 
                IF H1%A=S.FNAP DO 
                     $( H1%A := S.RTAP 
                        RESULTIS A  $) 
 
                REPORT(51) 
                RESULTIS A 
 
        CASE S.GOTO:CASE S.RESULTIS:CASE S.CODE:
                NEXTSYMB() 
                RESULTIS LIST2(OP, REXP(0)) 
 
        CASE S.IF:CASE S.UNLESS: 
        CASE S.WHILE:CASE S.UNTIL: 
                NEXTSYMB() 
                A := REXP(0) 
                IGNORE(S.DO) 
                RESULTIS LIST3(OP, A, RCOM()) 
 
        CASE S.TEST: 
                NEXTSYMB() 
                A := REXP(0) 
                IGNORE(S.DO) 
                B := RCOM() 
                CHECKFOR(S.OR, 54) 
                RESULTIS LIST4(S.TEST, A, B, RCOM()) 
 
        CASE S.FOR: 
            $(  LET I, J, K = 0, 0, 0 
                NEXTSYMB() 
                A := RNAME() 
                CHECKFOR(S.EQ, 57) 
                I := REXP(0) 
                CHECKFOR(S.TO, 58) 
                J := REXP(0) 
                IF SYMB=S.BY DO $( NEXTSYMB() 
                                   K := REXP(0)  $) 
                IGNORE(S.DO) 
                RESULTIS LIST6(S.FOR, A, I, J, K, RCOM())  $) 
 
        CASE S.BREAK:CASE S.RETURN:CASE S.FINISH:CASE S.ENDCASE:CASE S.LOOP:
                A := WORDNODE 
                NEXTSYMB() 
                RESULTIS A 
 
        CASE S.SWITCHON: 
                NEXTSYMB() 
                A := REXP(0) 
                CHECKFOR(S.INTO, 60) 
                RESULTIS LIST3(S.SWITCHON, A, RCOM()) 
 
        CASE S.CASE: 
                NEXTSYMB() 
                A := REXP(0) 
                CHECKFOR(S.COLON, 61) 
                RESULTIS LIST3(S.CASE, A, RCOM()) 
 
        CASE S.DEFAULT: 
                NEXTSYMB() 
                CHECKFOR(S.COLON, 62) 
                RESULTIS LIST2(S.DEFAULT, RCOM()) 
 
        CASE S.LSECT: 
                RESULTIS RDSECT(RDBLOCKBODY)   $)1 
 
 
AND RCOM() = VALOF 
    $(1 LET A = RBCOM() 
        WHILE SYMB=S.SEQ DO 
        $( NEXTSYMB(); A := LIST3(S.SEQ, A, RBCOM()) $)
 
        WHILE SYMB=S.REPEAT \/ SYMB=S.REPEATWHILE \/ 
              SYMB=S.REPEATUNTIL \/ SYMB=S.WHERE DO 
                  $( LET OP = SYMB 
                     NEXTSYMB() 
                     IF OP=S.WHERE DO
                      $( LET B = RDEF()
                         WHILE SYMB=S.AND DO
                         $( NEXTSYMB(); B := LIST3(S.AND, B, RDEF()) $)
                         RESULTIS LIST3(S.LET, B, A) $)
                     TEST OP=S.REPEAT 
                         THEN A := LIST2(OP, A) 
                           OR A := LIST3(OP, A, REXP(0))   $) 
 
        RESULTIS A  $)1 
 
.

 

//\*   /DGIM/TPLIST   12.9  10/4 


GET  "SY:TSYN.GET"
 
STATIC $( S=0 $)
 
LET PLIST(X, N, D) BE 
    $(1 LET SIZE = 0 
        LET V = TABLE 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0 
 
        IF X=0 DO $( WRITES("NIL>") 
                     RETURN  $) 
 
        SWITCHON H1%X INTO 
    $(  CASE S.NUMBER: 
                WRITEN(H2%X) 
		WRITEC('>')
                RETURN 
 
        CASE S.NAME: 
                WRITES(X+3) 
		WRITEC('>')
                RETURN 
 
        CASE S.STRING: 
                WRITEC('"') 
                WRITES(X+1) 
                WRITES('">') 
                RETURN 
 
        CASE S.FOR: 
                SIZE := SIZE + 2 
 
        CASE S.COND:CASE S.FNDEF:CASE S.RTDEF: 
        CASE S.TEST:CASE S.CONSTDEF: 
                SIZE := SIZE + 1 
 
        CASE S.VECAP:CASE S.FNAP: 
        CASE S.MULT:CASE S.DIV:CASE S.REM:CASE S.PLUS:CASE S.MINUS: 
        CASE S.EQ:CASE S.NE:CASE S.LS:CASE S.GR:CASE S.LE:CASE S.GE: 
        CASE S.LSHIFT:CASE S.RSHIFT:CASE S.LOGAND:CASE S.LOGOR: 
        CASE S.EQV:CASE S.NEQV:CASE S.COMMA: 
        CASE S.AND:CASE S.VALDEF:CASE S.VECDEF: 
        CASE S.ASS:CASE S.RTAP:CASE S.COLON:CASE S.IF:CASE S.UNLESS: 
        CASE S.WHILE:CASE S.UNTIL:CASE S.REPEATWHILE: 
        CASE S.REPEATUNTIL: 
        CASE S.SWITCHON:CASE S.CASE:CASE S.SEQ:CASE S.LET: 
        CASE S.MANIFEST:CASE S.STATIC:CASE S.GLOBAL: 
                SIZE := SIZE + 1 
 
        CASE S.VALOF:CASE S.LV:CASE S.RV:CASE S.NEG:CASE S.NOT: 
        CASE S.TABLE:CASE S.GOTO:CASE S.RESULTIS:CASE S.REPEAT: 
        CASE S.CODE:
                SIZE := SIZE + 1 
 
        CASE S.BREAK:CASE S.RETURN:CASE S.FINISH:CASE S.ENDCASE: 
        CASE S.TRUE:CASE S.FALSE:CASE S.LOOP:
        DEFAULT: 
                SIZE := SIZE + 1 
 
                IF N=D DO $( WRITES("ETC>") 
                             RETURN  $) 
 
                WRITES(VALOF SWITCHON H1%X INTO $(
        CASE S.FNDEF:   RESULTIS "FNDEF"
        CASE S.RTDEF:   RESULTIS "RTDEF"
        CASE S.CONSTDEF:RESULTIS "CONSTDEF"
        CASE S.VECDEF:  RESULTIS "VECDEF"
        CASE S.VALDEF:  RESULTIS "VALDEF"
        CASE S.FNAP:    RESULTIS "FNAP"
        CASE S.RTAP:    RESULTIS "RTAP"
        CASE S.SEQ:     RESULTIS "SEQ"
        CASE S.COND:    RESULTIS "->"
        CASE S.ASS:     RESULTIS ":="
        CASE S.MULT:    RESULTIS "**"
        CASE S.DIV:     RESULTIS "/"
        CASE S.VECAP:   RESULTIS "%"
        CASE S.PLUS:    RESULTIS "+"
        CASE S.MINUS:   RESULTIS "-"
        CASE S.COLON:   RESULTIS ":"
        CASE S.COMMA:   RESULTIS ","
        DEFAULT:        IF IN(NAMETREE,H1%X) RESULTIS S
                        WRITEN(H1%X); RESULTIS "-OP" $) )
		WRITEC('>')
                FOR I = 2 TO SIZE DO 
                     $( NEWLINE() 
			V%N := I=SIZE -> "  `", "  |"
                        FOR J=0 TO N DO WRITES(V%J) 
                        WRITES("-<") 
                        V%N := I=SIZE->"   ","  |"   
                        PLIST(H1%(X+I-1), N+1, D)  $) 
                RETURN  $)1 
 
AND IN(T,X) = VALOF
    $( IF T=0 RESULTIS FALSE
       IF T%0=S.NAME RESULTIS FALSE
       IF T%0=X $( S := T+3;  RESULTIS TRUE $)
       RESULTIS IN(T%1,X) \/ IN(T%2,X) $)
.