OCODE(!1)
SEND TO(!)
CHAIN(FIND#CGMX)
BIN
LIST
PROGRAM(CGMX)
SWITCH(2)
TREESIZE(9000)
TRACE
INCLUDE(%BTRACE)
INCLUDE(LIB2,%BDEBUG,%BEDSFILES,%BSYSTEM,%BTYROUTINE,%BSWITCHES)
INCLUDE(%BTRACESAVE,%BEXECUTE)
*
// SEG 1

GET "NHEAD0"

GET "NHEAD2"


GLOBAL $( READN:69 $)

GLOBAL $(
            OPTION:125; PRINTING:126; STACKDEPTH:127
            SEG:143; SEGMAX:144
            CG1900:225
            READOP:229
            CREATESEMICOMPFILE:242
          CLOSESEMICOMPFILE:243
            PACK1900:256
            TRACENAMES:267
SWAP:270
BASICLIB:271
            READSTEERING:275; RS:276; READSTEERINGLINE:277
            INPUTFILE:278
            PLANFILE:279; SEMICOMPFILE:280
            WRITEBUCKET:400
            WRITESTEERINGBUCKET:401; WRITEMASTERSEGMENT:402
            NEXTCELL:107
            CUECHAIN:141
            LIBLIST:146; SEGNAME:147
            NEWCELL:238
            LIST:244
            STRING:247
       $)
GLOBAL $( GXV:341;
          GSEG:342
          PRIORITY:344
                     GSCFV:345; GBINV:346; GNAMEV:347
                     MODE:348
         $)


GLOBAL $( START:1 $)
GLOBAL $( PROGRAM:100 $)
GLOBAL $( REPORTGLOBALS:90;  PROGRAMMAP:92;  TRACE:53 $)
//  OPTION                   EFFECT
//  ......                   ......

//   0
//    1
//    2                      FULL CONSOLIDATOR LISTING

//    3                      CODE GENERATOR GIVES A PRINTOUT OF SIZE ETC
//    4                      FUNCTION NAME AT HEAD OF FUNCTIONS
//    5                      PRODUCE "PLAN"
//    6
//    7
//    8
//    9
//   10                      WHEN "GTRACEA" USED, PARAMETERS VIA TAPE-READER
//   11                      PRINT STACK AFTER EACH OCODE SYMBOL
//   12                      PRINT FULL VECTOR
//   13                      WRITE OP NUMBER
//   14
//   15
//   16                      PERFORM TRACENAMES
//   17                      PRINT CHARACTERS AS READ IN
//   18                      DO "WRITEOP" ON OP AFTER EACH OCODE SYMBOL
//   19                      STACKDEPTH IS FIRST NUMBER TO BE READ
//   20
//   21                      'MACHINE CODE' VERSION OF 'DEP'
//   22                      PRINT EACH BUCKET OUTPUT TO DISC
//   23                      REPORT SPACE USED BY 'NEWCELL'

MANIFEST $( FREESTORESIZE = 1100 $)
  START:
PROGRAM:
$(1

          LET OPT = VEC 23

          AND BINV = VEC 5
          AND SCFV = VEC 5
          AND SEGV = VEC 14
          AND SEGNAMEV = VEC 14

         LET V = VEC FREESTORESIZE

          IF ENTRYUSED = 5 LOGAND INIT.X.REGS!0 = 0 DO $( TY.HALT("LD")
                                                          GOTO START $)
          OPTION := OPT
          FOR I = 0 TO 23 DO OPTION!I := SW.TEST(I)
          INITIALIZEIO();
          MONITOR := CREATEOUTPUT(20)
          OUTPUT := MONITOR
          IF OPTION!3 DO WRITEF("*NCODE GENERATION BY CGMX MK %N%C*N*N",4,'C')
         SETUPVECASFREESTORE(V, FREESTORESIZE)
          GBINV, GSCFV := BINV, SCFV
          GXV := INIT.X.REGS
          CUECHAIN := 0
         LIBLIST := 0
          GSEG := SEGV
          !GBINV, !GSCFV := 0, 0
          GNAMEV := STRING("BXXX")
        SEGNAME := SEGNAMEV
        RV SEGNAME := 0
          INPUT := 0
          INPUTFILE := 0
          REPORTCOUNT, REPORTMAX := 0, 250
          NEXTCELL := 0                // NEWCELL WILL FIND NEW CELLS FROM FREE
                                       // STORAGE WHEN NEXTCELL IS ZERO
          SEMICOMPFILE := 0
          PRIORITY := 50
          BASICLIB := 0
          TEST ENTRYUSED = 5 THEN INPUT, INPUTFILE := FINDFILE(GXV), INPUT
                                  OR INPUT := FINDINPUT(30*ENTRYUSED)



          SEG := 0
          SEGMAX := -1
          MODE := 0       // PROGRAM MODE WORD. NO MODE CHECKS, INITIALLY DBM
                            // (DOUBLES AS SEGMENT MODE WORD SO WATCH IT !)
          READSTEERING()

// DEBUGGING CODE
          STACKDEPTH := 0
          PRINTING :=          OPTION!11 LOGOR
                               OPTION!12 LOGOR
                               OPTION!13 LOGOR
                               OPTION!17 LOGOR
                               OPTION!18
          IF OPTION!19 LOGOR OPTION!16 DO $( LET A = INPUT
                                          IF ENTRYUSED = 5 DO
                                              INPUT := FINDINPUT(30)
                                          IF OPTION!16 DO TRACENAMES()
                                          IF OPTION!19 DO STACKDEPTH := READN()
                                          INPUT := A
                                       $)
          IF OPTION!14 DO $( REPORTGLOBALS(0,0); PROGRAMMAP() $)

// END OF DEBUGGING CODE

          IF INPUTFILE = 0 DO INPUTFILE := !GXV = 0 -> INPUT,FINDFILE(GXV)
          INPUT := INPUTFILE
             $( LET L = LV LIBLIST
                UNTIL RV L = 0 DO L := RV L + 1
                RV L:= NEWCELL(BASICLIB = 0 ->
                              [LIST(3, STRING("SUBGROUPSRB1"),0,1)], BASICLIB,
                         0)
             $)

        IF RV SEGNAME = 0 DO SEGNAME := GNAMEV             // DEFAULT SEGMENT
                                                           // NAME IS PROGNAME

          IF !GSCFV = 0 DO $( REPORT (5,"NO FILE SPECIFIED FOR SEMICOMPILED")
                              FINISH $)
                                 $( LET N = CREATEFILE(GSCFV)
                                    SEMICOMPFILE := CREATESEMICOMPFILE(N)
                                    WRITESTEERINGBUCKET(SEMICOMPFILE)
                                 $)

             WRITEMASTERSEGMENT()
          IF OPTION!3 DO WRITEF("*NPROGRAM %S*N", GNAMEV)


          CG1900()

          OUTPUT := MONITOR

                                  IF OPTION!3 DO
                                  WRITEF("LAST BUCKET USED OF '%S' WAS %N.*N",
                                                           GSCFV,
                                                           (!SEMICOMPFILE)!5-1)
                                  CLOSESEMICOMPFILE(SEMICOMPFILE)

                 IF OPTION!7   $( LET V = VEC 7
                                  V!0 := #01
                                  V!1 := 6 << 15 LOGOR 32
                                  PACK1900(GSCFV, V+2, 12)
                                  V!5 := 0
                                 V!7 := 0
                                 V!6 := 2                  // STEERING BUCKET
                                  TY.CHAINPROG("FI#XPCK", V)
                               $)
          UNLESS REPORTCOUNT = 0 DO TY.CHAINPROG("FI#SCPR", 0, 0)
          TY.DELETE("HH")
$)1

.
//SEG2
GET "NHEAD0"
GLOBAL $( OPTION:125 $)
GLOBAL $( CH : 58 $)
GLOBAL $( READSTEERING:275; RS:276; READSTEERINGLINE:277 $)
LET READ()  = VALOF $(
                             READCH(INPUT, LV CH)
                             IF OPTION!3 DO UNLESS CH = '*E' DO WRITEC(CH)
                         RESULTIS CH
                    $)
LET READSTEERING() BE
      $( READ() REPEATUNTIL CH = '*E' LOGOR CH = '**'
         IF CH = '*E' DO $( REPORT(0,"STEERING MISSING"); FINISH $)
         $(
            READ()
            IF CH = '**' BREAK
            UNLESS CH = '#' DO $( REPORT(1,"'#' MISSING IN STEERING"); FINISH $)
            READSTEERINGLINE()
            READ() REPEATWHILE CH <= ' '
            IF CH = '*E' BREAK
            UNLESS CH = '**' DO $( REPORT(3,"'**' MISSING IN STEERING LINE")
                                   FINISH $)
         $) REPEAT
         UNTIL CH = '*N' LOGOR CH = '*E' DO READ()
         $)

.
// SEG3
GET "NHEAD0"
GLOBAL $( CH : 58 $)
GLOBAL $(
           OPTION:125
           CUECHAIN:141
           SEG:143
           SEGMAX:144
           LIBLIST:146
           SEGNAME: 147
           NEWCELL : 238
           LIST:244
           STRING:247
           GXV:341
           GSEG:342
           GSCFV:345
           GBINV:346
           GNAMEV:347
           MODE:348
           INPUTFILE:278
       $)
GLOBAL $( GREL :142; STVQ:111; SCF5:249; SCFIELD:250 $)
MANIFEST $( ABS = #40; PRI= #73 $)
GLOBAL $( PRIORITY:344 $)
GLOBAL $( BASICLIB : 271 $)
GLOBAL $( READSTEERING:275; RS:276 ; READSTEERINGLINE:277 $)
STATIC $( ISTERMINATOR = FALSE $)
LET READ() = VALOF              $( LET A = READCH(INPUT, LV CH)
                                   IF CH = '*E' DO $( REPORT(0, "STEERING *<
                                                             *>MISSING OR *<
                                                             *>INCORRECT TERM*<
                                                             *>INATOR.COMPILAT*<
                                                             *>ION ABORTED.")
                                                      FINISH
                                                   $)
                                   IF OPTION!3 DO WRITEC(CH)
    ISTERMINATOR    := (CH <= ' ') LOGOR
                       (CH = '(') LOGOR
                       (CH = ':') LOGOR
                       (CH = ',') LOGOR
                       (CH = '**')
                                   RESULTIS A
                                $)

LET RS(W, N) = VALOF $( LET V = VEC 255
                        AND I = 0
                        READ() REPEATWHILE CH LE ' '
                        WHILE
                        CH = '-' LOGOR
                        CH = '%' LOGOR
                        CH = ' ' LOGOR
                       CH = '!' LOGOR
                        [ 'A' LE CH LE 'Z' ] LOGOR
                        [ '0' LE CH LE '9' ] DO
                                       $( I := I + 1
                                          V!I := CH
                                          READ()
                        IF I GE N BREAK
                                       $)
                        V!0 := I LE N -> I, N
                        PACKSTRING(V, W)
                        RESULTIS W
                     $)

AND RF(V) = RS(V, 12)

LET RN() = VALOF
            $( LET A, SIGN, N = 0, 1, 2
               UNTIL CH = '-' LOGOR
                     CH = '+' LOGOR
                     CH = '#' LOGOR
                     '0' LE CH LE '9' DO READ()
               IF CH = '#' DO N := 0
               IF CH = '-' DO SIGN := - 1
               IF CH = '+' LOGOR CH = '-' LOGOR CH = '#'
                                       DO $( READ() REPEATWHILE CH LE ' ' $)
                 $(
                  A := (A << 3)  + A*N + CH - '0'
                  READ()
               $)           REPEATWHILE '0' LE CH LE '9'
               RESULTIS A*SIGN
            $)

LET SKIPCHTO(X) BE UNTIL CH = X LOGOR CH = '*N' DO $( READ()
                                                   IF CH = X BREAK
                                                   IF CH = '(' DO SKIPCHTO(')')
                                                $)

AND SKIPCHPAST(X) BE $( SKIPCHTO(X); UNLESS CH = '*N' DO READ() $)
AND SKIPBLANKS() BE WHILE CH LE ' ' LOGAND CH NE '*N' DO READ()


AND NEWCUE(A,B,C,D) BE CUECHAIN := NEWCELL(LIST(4,STRING(A),B,C,D), CUECHAIN)

STATIC $( T=0 $)
LET NEXTSYMB() BE
      $( FOR I = 0 TO 4 DO T!I := 0
         SKIPBLANKS()
        UNTIL ISTERMINATOR DO
               $( T!0 := T!0 + 1
                  IF T!0 <= 4 DO T!(T!0) := CH
                  READ()
               $)
         SKIPBLANKS()
      $)

LET READSTEERINGLINE() BE
      $(RS
         LET V = VEC 255
         AND BOOLEAN = TRUE
         AND TVEC = VEC 4
         LET A, B, C, D = ?, ?, ?, ?
         T := TVEC
          ISTERMINATOR := TRUE
          $( IF ISTERMINATOR READ()
             NEXTSYMB()
             A, B, C, D := T!1, T!2, T!3, T!4
                SWITCHON A INTO
                $(
 CASE 'A':
           IF B='L' & C='T' $( LET X = RN()                          // ALTER
                               SKIPCHPAST(',')
                               IF X >= 0 DO X!(X<8 -> INIT.X.REGS, 0) := RN()
                               ENDCASE
                            $)
           IF B='P' & C='P' DO $( OPTION!6 := BOOLEAN                // APPEND
                                  GOTO BINARYOUTPUTFILES
                               $)
           ENDCASE
 CASE 'B':
           IF B='A' & C='S' GOTO LIBRARIES                           // BASICLIB
           IF B='I' & C='N' DO                                       // BIN
                               $( UNTIL ISTERMINATOR     DO NEXTSYMB()
                                  IF CH = ':' LOGOR CH = '(' DO
                                                 GOTO BINARYOUTPUTFILES
                                  OPTION!7 := BOOLEAN
                                  ENDCASE
                               $)
           ENDCASE
 CASE 'D':
           IF B='E' & C='B' DO GOTO TRACING                          // DEBUG PL
           IF B='U' & C='M' DO                                       // DUMP ON
BINARYOUTPUTFILES:             $(
                                  UNTIL ISTERMINATOR     DO NEXTSYMB()
                                  RF(GBINV)
                                  OPTION!7 := BOOLEAN
                                  ENDCASE
                               $)
           ENDCASE
 CASE 'I':
           IF B='N' & C='C' DO
                            TEST D='L' THEN GOTO CUES                // INCLUDE
                         OR IF D = 0 DO GOTO LIBRARIES               // INC
           ENDCASE
 CASE 'L':
           IF B='I' & C='B' DO                                       // LIB
LIBRARIES:                     $(

                                  LET L = @ LIBLIST
                           AND CELL = LIST(3, 0, 0, 0)
                                  UNTIL ISTERMINATOR     DO NEXTSYMB()
                        RS(V, 12)
                        CELL!0 := STRING(V)
                        IF CH = '.' DO $( SKIPBLANKS()
                                          RS(V, 12)
                                          CELL!1 := STRING(V)
                                       $)
                                  CELL!2 := ( A = 'S' LOGOR A = 'I' ) -> 0,1
                                  TEST A = 'B' THEN BASICLIB := CELL
                        OR $( UNTIL RV L = 0 DO L := RV L + 1
                              RV L := NEWCELL(CELL, 0)
                           $)
                        ENDCASE
                        $)
           ENDCASE
 CASE 'M':
           IF B='A' & C='S' DO $( MODE := MODE LOGOR #00004000          // MASTER
                                  GOTO SEGMENTNAME
                               $)
           ENDCASE
 CASE 'N':
           IF B = 'O' & C = 'T' DO $( BOOLEAN := FALSE; LOOP  $)     // NOT
           IF B = 'A' & C = 'M' DO $(                                // NAME
                                  RS(SEGNAME, 40)
                                  SKIPCHTO('/')
                                  IF CH = '*N' ENDCASE
                                  READ()
                                  SEG := RN()
                                  SKIPCHTO('/')
                                  IF CH = '*N' ENDCASE
                                  READ()
                                  SEGMAX := RN()
                                  ENDCASE
                               $)
 CASE 'O':
           IF B='C' & C='O' DO GOTO MAINFILE                         // OCODE
           IF [B='M' & C='I'] LOGOR // OMIT
              [B='V' & C='E'] DO                                     // OVERLAY
CUES :                         $( LET X= 0
                                  IF B='V' DO $( X := RN()
                                                 SKIPCHPAST('/')
                                                 X := ( X<< 15 ) LOGOR RN()
                                                 SKIPCHTO(',')
                                              $)
                                  SKIPBLANKS()
                                      $( NEWCUE(RS(V,40), B='N' -> 0,
                                                          B='M' -> #01,
                                                          #05,0,X)
                                     SKIPBLANKS()
                                  $)             REPEATWHILE CH = ','
                                  ENDCASE
                               $)
           ENDCASE
 CASE 'P':
           IF B='R' DO TEST C='I'
           THEN                $( PRIORITY := RN()                   // PRIORITY
                                  ENDCASE
                               $)
           OR IF C='O'         $( RS(GNAMEV, 4); ENDCASE $)          // PROGRAM
           ENDCASE
CASE 'R':
           IF B='E' & C='A' DO                                       // READFROM
MAINFILE:                      $(
                                  UNTIL ISTERMINATOR     DO NEXTSYMB()
                        RS(GXV, 12)
                                  IF A = 'R' DO $( SKIPCHTO('*N')
                                         INPUTFILE := FINDFILE(GXV)
                                         INPUT := INPUTFILE
                                         $)
                               $)
           IF B='U' & C='N' DO $( OPTION!8 := BOOLEAN                // RUN
                                  ENDCASE
                               $)
           ENDCASE
 CASE 'S':
           IF [ B='/' & C='C' ] LOGOR // S/C
              [ B='E' & C='N' ] DO                                   // SEND TO
                               $(
                                  UNTIL ISTERMINATOR     DO NEXTSYMB()
                                  RF(GSCFV)
                               $)
           IF B = 'E' DO TEST  C='G' THEN                            // SEGMENT
SEGMENTNAME:                   $(
                                  UNTIL ISTERMINATOR     DO NEXTSYMB()
                                  RS(GSEG,40)
                                       ENDCASE
                               $)
           OR
           IF C = 'M' DO GOTO LIBRARIES                              // SEMICOMP
           IF B = 'P' & C='A' DO                                     // SPACE
                               $(
                        NEWCUE(STRING("%BSTACK"), #43, RN(), 0)
                       NEWCUE(STRING("%BFIXEDSAVE"), 0, 0, 0)
                        ENDCASE
                               $)
           IF B='W' & C='I' DO $(                                    // SWITCHES
                                 $( OPTION!RN() := BOOLEAN
                                     SKIPBLANKS() $) REPEATWHILE CH = ','
                                  ENDCASE
                               $)
           ENDCASE
 CASE 'T':
           IF B='R' & C='A' DO                                       // TRACE
TRACING:                       $(
                                  OPTION!4 := BOOLEAN
                                  NEWCUE("%BTRACE", 0, 0, 0)
                                  ENDCASE
                               $)
           ENDCASE
             $)
                SKIPCHTO(',')
                BOOLEAN := TRUE
      $) REPEATUNTIL CH = '*N'
      $)RS
.
//SEG4

GET "NHEAD2"

GET "CGHEAD"
GLOBAL $( PRIORITY:344 $)
LET WRITEMASTERSEGMENT() BE
      $( LET V = VEC 255
         UNPACKSTRING(GNAMEV, V)
         TITLEREC(#03, #00003400, "%BSTEERSEG")  //SEG.DATA  TITLE
                                                 // DBM,15 OR 22 AM, MASTER SEG
         TERMINREC(#04, TABLE 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0)
         TITLEREC(#33, #00003400, "%BSTEERSEG")  //SEG.DATA  TITLE
         PRIORITYNAMEREC(PRIORITY/10, PRIORITY REM 10,
                                      GNAMEV, MODE)
		
         CUECHAIN := NEWCELL(LIST(4, STRING("%BSTEERSEG"),#41, 0, 0),CUECHAIN)

         UNTIL CUECHAIN = 0 DO $( LET C = CUECHAIN
                                  LET B = C!0
                                  LET S = B!0
                                  CUECHAIN := C!1
                                  FREECELL(C)
                                  SLCUEREC(B!1, B!2, S,B!3)
                                  RETURNVEC(S, (RV S>> 16) / 3)
                               $)
         TERMINREC(#34,TABLE 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0)
      $)
.
// SEG 5
GET "CGHEAD"
LET SCAN() BE
             $(SCAN
                   GLOBAL $( OPTION:125 $)
                   GLOBAL $( READN:69 $)
                   LET S = OPTION!18 LOGOR OPTION!13 LOGOR OPTION!12 LOGOR OPTION!11
                   AND SAVEADDRESS = 0           // TO SAVE STVQ FOR 'SAVE'
                    UNTIL OP = C.END DO
                    $(LOOP
                           SWITCHON OP INTO
                           $(SW DEFAULT:
                                            REPORT(388,"DEFAULT LABEL HIT IN *<
                                                      *>*'SCAN*'. OP = %N*N",
                                                                         OP)
                                            ENDCASE
                                CASE C.TRUE:
                                            LOADT(NUMBER, TRUE)
                                            ENDCASE
                                CASE C.FALSE:
                                            LOADT(NUMBER, FALSE)
                                            ENDCASE
                                CASE C.RV:
                                            CGRV()
                                            ENDCASE
                                CASE C.FNAP:
                                            CGAPPLY(OP, READN())
                                            LOADT(XREG, 4)
                                            ENDCASE
                                CASE C.MULT:
                                CASE C.DIV:
                                CASE C.REM:
                                            CGDIV.OR.REM.OR.MULT(OP)
                                            ENDCASE
                                CASE C.PLUS:
                                            OP := READOP()
                                             CGPLUS(OP=C.RV->IREG,
                                                   OP = C.STIND -> IREG,
                                                                XREG)
                                            LOOP
                                CASE C.MINUS:
                                            CGMINUS()
                                            ENDCASE
                                CASE C.NOT:
                                            $( LET R = MOVETOANYR(ARG1)
                                               ASSEMBLE(ERX,R,CELLC(#77777777),
                                                                     0, LT)
                                            $)
                                            ENDCASE
                                CASE C.EQ:
                                CASE C.NE:
                                CASE C.LS:
                                CASE C.GR:
                                CASE C.LE:
                                CASE C.GE:
                                            $(  LET RELOP = OP
                                                OP := READOP()
                                                TEST OP = C.JF LOGOR OP = C.JT

                                                 IFSO
                                                  $( CGJTJF(RELOP,OP,READL())
                                                          ENDCASE  $)

                                                 IFNOT $( CGREL(RELOP)
                                                          LOOP  $)
                                            $)
                                CASE C.NEG:
                                            $( LET R = MOVETOANYR(ARG1)
                                               ASSEMBLE(NGX, R, R, 0, ABS)
                                            $)
                                            ENDCASE
                                CASE C.LSHIFT:
                                            CGSHIFT(SLL)
                                            ENDCASE
                                CASE C.RSHIFT:
                                            CGSHIFT(SRL)
                                            ENDCASE
                                CASE C.LOGAND:
                                            CGLOGOP(OP, ANDX)
                                            ENDCASE
                                CASE C.LOGOR:
                                            CGLOGOP(OP, ORX)
                                            ENDCASE
                                CASE C.EQV:
                                            CGLOGOP(OP, ERX)
                                            ENDCASE
                                CASE C.NEQV:
                                            CGLOGOP(OP, ERX)
                                            ENDCASE
                                CASE C.LP :
                                            LOADT(LOCAL, READN() )
                                            ENDCASE
                                CASE C.LG :
                                            $( LET N = READN()
                                               IF N > GMAX DO GMAX := N
                                               LOADT(C.GLOBAL, N)
                                            $)
                                            ENDCASE
                                CASE C.LN :
                                            LOADT(NUMBER, READN() )
                                            ENDCASE
                                CASE C.LSTR:
                                            $( LET V = VEC 255
                                               V!0 := READN()
                                               FOR I = 1 TO V!0 DO V!I :=READN()
                                               CGSTRING(V) $)
                                            ENDCASE
                                CASE C.LL :
                                            LOADT(LABEL, READL())
                                            ENDCASE
                                CASE C.LLP:
                                            LOADLV(READN(), VP)
                                            ENDCASE
                                CASE C.LLG:
                                            $( LET N = READN()
                                               IF N > GMAX DO GMAX := N
                                               LOADLV(N, VG)
                                            $)
                                            ENDCASE
                                CASE C.LLL:
                                            LOADLV(LABV!READL() - #77777, VD)
                                            ENDCASE
                                CASE C.RTAP:
                                            CGAPPLY(OP, READN())
                                            ENDCASE
                                CASE C.GOTO:STORE(0,SSP-2)
                                            ASSEMBLE(EXIT, MOVETOANYR(ARG1), 0,
                                                               0, ABS)
                                            INITSTACK(SSP-1)
                                            ENDCASE
                                CASE C.FINISH:
                                            FRER(1, IREG)
                                            STORE(0, SSP - 1)
                                            ASSEMBLE(CALL, 1, BFINI, 0, 0)

                                            ENDCASE
                                CASE C.SWITCHON:
                                            $( LET U = VEC 200
                                               AND V = VEC 200
                                               U!0, V!0 := READN(), READL()
                                               FOR I = 1 TO U!0 DO
                                                       $( U!I, V!I := READN(),
                                                                     READL() $)
                                               CGSWITCH(U, V)
                                            $)
                                            ENDCASE
                                CASE C.GLOBAL:
                                            $( LET U = VEC 250
                                               AND V = VEC 250
                                               AND N = READN()
                                               FOR I=1 TO N DO $( U!I :=READN()
                                                                  V!I := READL()
                                                               $)
                                               CGGLOBAL (N, U, V)
                                            $)

                                            RETURN



                                CASE C.SP :
                                            STOREIN(READN(), VP)
                                            ENDCASE
                                CASE C.SG :
                                            $( LET N = READN()
                                               IF N > GMAX DO GMAX := N
                                               STOREIN(N, VG)
                                            $)
                                            ENDCASE
                                CASE C.SL :
                                            STOREIN(LABV!READL() - #77777, VD)
                                            ENDCASE
                                CASE C.STIND:
                                            STOREI()
                                            ENDCASE
                                CASE C.JUMP:
                                            STORE(0, SSP)
                                            ASSEMBLE(BRN, NONE, READL(),0,LABEL)
                                            ENDCASE
                                CASE C.JT :
                                CASE C.JF :
                                            STORE(0, SSP-2)
                                            $( LET R=MOVETOANYR(ARG1)

                                               ASSEMBLE(OP=C.JT->BNZ,BZE, R,
                                                         READL(), 0, LABEL)
                                               STACK(SSP-1)
                                            $)
                                            ENDCASE
                                CASE C.LAB:
                                            STORE(0, SSP)
                                            INITSTACK(SSP)
                                            FULL!1, FULL!3 := 0, 0
                                            WRLAB(READL())
                                            ENDCASE
                                CASE C.STACK:
                                            STACK(READN())
                                            ENDCASE
                                CASE C.STORE:
                                            STORE(0, SSP)
                                            INITSTACK(SSP)
                                            ENDCASE
                                CASE C.RSTACK:
                                            STACK(READN())
                                            LOADT(XREG, 4)
                                            ENDCASE
                                CASE C.ENTRY:
                                            $( LET N = READN()
                                               AND L = READL()
                                               AND V = VEC 255
                                               FOR I = 1 TO N DO V!I := READN()
                                               V!0 := N
                                              CGENTRY(L, V, LV SAVEADDRESS)
                                            $)
                                            ENDCASE
                                CASE C.SAVE:
                                            $( LET A = READN()
                                               INITSTACK(A)
                                               UNLESS OPTION!4 ENDCASE
                                               SCF5(PRI, SAVEADDRESS)
                                               SCF5(ABS, A)
                                               SCF5(PRI, STVQ)
                                            $)
                                            ENDCASE
                                CASE C.FNRN:
                                            MOVETOR(4, ARG1)
                                            SSP := SSP - 1
                                            IF OPTION!4 DO

//                                             SET BIT 1 OF SAVED P.POINTER FOR
//                                             TRACING

                                               $( LET R = NEXTR()
                                                  ASSEMBLE(LDCT,R,#200,0,ABS)
                                                  ASSEMBLE(ORS, R, 0, 2, ABS)
                                               $)
                                CASE C.RTRN:
                                            FRER(1, IREG)
                                            FRER(3, IREG)
                                            ASSEMBLE(BRN, NONE, BRETU, 0, 0)
                                            INITSTACK(SSP)
                                            ENDCASE
                                CASE C.RES:
                                            STORE(0, SSP-2)
                                            MOVETOR(4, ARG1)
                                            ASSEMBLE(BRN,NONE, READL(),0,LABEL)
                                            STACK(SSP-1)
                                            ENDCASE
                                CASE C.DATALAB:
                                            LABV!READL() := DATAP/2 + #77777
                                            ENDCASE
                                CASE C.ITEML:
                                            CELL(LABEL, READL())
                                            ENDCASE
                                CASE C.ITEMN:
                                            CELL(NUMBER, READN())
                                            ENDCASE
                                CASE C.STOP:
                                            RETURN

                           $)SW

                   IF S DO SUMMARIZESTATE()
                    OP := READOP()
                    $)LOOP
             $)SCAN




.
//SEG6
GET "CGHEAD"
GLOBAL $( RELV:105 $)
MANIFEST $( TABLESIZE = 100 $)
MANIFEST $( R2 = #55; R3 = #56; R4 = #57 $)
LET CGSTART() BE
          $(
             FOR I = 0 TO 15 DO RELV!I := 0
             SCSTART()
             GREL := R1
             VG!2 := GREL
             SCFIELD(GREL - #44,  GVEC)
             B.A.SET(BSAVE, R2)
             B.A.SET(BRETU, R3)
             SCF5(PRI, 0)

             ASSEMBLE(BRN, NONE, 0, 0, LABEL)

             IF OPTION!4 DO  $( COMPNUM(TRUE)
                                COMPNUM(RV "%%")
                             $)
          $)


AND CGEND() BE $( LET LTS = 0

                  SCF5(LTI, 0)
                  UNTIL DATAT = 0 DO $( LET T = DATAT!1 & #37777777
                                        TEST T = DATAT!1
                                        THEN COMPLP(!DATAT)
                                        OR   COMPAD(!DATAT, LT)
                                        FREECELL(DATAT)
                                        DATAT := T
                                        LTS := LTS + 1
                                     $)
                  UNLESS DATAP REM TABLESIZE = 0 DO
                          $( SCF5(LPI, (DATAP - DATAP REM TABLESIZE) / 2 )
                             FOR I = DATAV BY 2 TO DATAV + DATAP REM TABLESIZE-2
                             DO (I!1 = NUMBER -> COMPLP, COMPAD)[I!2, LP]
                          $)
                  $( LET T = BATABLE
                     UNTIL T = 0 DO $( B.A.SET(T!0, ABS)   // CLEAR A B A CHAIN
                                       T := T!1
                                    $)
                  $)
                  GCUE!2 := GMAX + 1
                  SCUE!2 := STVQ
                  SCF5(PRI, STVQ)
                  RELV!(PR-ABS) := STVQ
                  RELV!(LP-ABS) :=DATAP/2
                  RELV!(LT-ABS) :=LTS
                  SCEND()
               $)
.
//SEG7
GET "CGHEAD"
GET "NHEAD2"
MANIFEST $( TABLESIZE = 100 $)
LET CG1900() BE
         $(1 LET SEGCOUNT = 0
             LET R = VEC 15
             LET V = VEC 15
             LET RELS = R
             RELV := V
             R!1 := "LW"
             R!2 := "LV"
             R!3 := "LR"
             R!4 := "LP"
             R!5 := "LT"
             R!6 := "RR"
             R!7 := "UP"
             R!8 := "UR"
             R!9 := "UV"
             R!10:= "RC"
             R!11:= "PR"
             R!12:= "R1"
             R!13:= "R2"
             R!14:= "R3"
             R!15:= "R4"
             LABV := NEWVEC (LABT)

             DATAV := NEWVEC(TABLESIZE)          // STATICS & STRINGS

             TEMPV := NEWVEC (TEMPT)
             BATABLE := 0


           $( LET V = VEC 20
              AND U = VEC 20
              AND C, T = CUECHAIN, BATABLE
              V!1 := LV BKORE;         U!1 := "%BKORE"
              V!2 := LV BRETU;         U!2 := "%BRETURN"
              V!3 := LV BSAVE;         U!3 := "%BSAVE"
              V!4 := LV BFINI;         U!4 := "%BFINISH"
              V!5 := LV BSWIT;         U!5 := "%BSWITCHON"
              V!6 := LV BEXEC;         U!6 := "%BEXECUTE"

              FOR I = 1 TO 6 DO $( U!I := STRING(U!I)
                                  RV (V!I) := LIST(3, U!I, 0, ABS)
                                   T := NEWCELL(RV (V!I), T)
                                   C := NEWCELL(LIST(4, U!I, #00, 0, 0), C)
                                $)

              GVEC := STRING("%BGLOBALVEC")
              GCUE := LIST(4, GVEC, #33, 0, 0)
              C := NEWCELL(GCUE, C)

              BATABLE := T
              CUECHAIN := C
           $)



             FULL := TABLE 0, 0, 2, 0, 0, 0, 0, 0
             V1 := TABLE 0, 0, 0
             V2 := TABLE 0, 0, 0
             VP := TABLE 0, 2, ABS
             VG := TABLE 0, 0, 0
             VD := TABLE 0, 0, DREL


             UNTIL SEGCOUNT = SEGMAX DO

             $(
              LET T = BATABLE
              AND C = CUECHAIN

              SEGCOUNT := SEGCOUNT + 1
              SEG := SEG + 1
              SSP, DATAP := 0, 0
             DATAT := 0                          // CHAIN OF CONSTANTS
              STVQ := 0
              MODE := #00003000        // SEGMENT MODE- DBM,15 OR 22 AM
              GMAX := 0
              FOR I = 0 TO 7 DO FULL!I := 0
              FULL!2 := 2


         ! GSEG := 0
              SCUE := LIST(4, GSEG, #41, 0, 0)
              CUECHAIN := NEWCELL(SCUE, CUECHAIN)


             FOR I = 0 TO LABT DO LABV!I := 0
             OP := READOP()
              IF RV GSEG = 0 APPENDN(SEGNAME, GSEG, SEG)
             IF OP = C.STOP LOGOR OP = C.END BREAK

              CGSTART(SEG)
              INITSTACK(2)
              SCAN()
              CGEND(SEG)

              IF OPTION!3 DO $( WRITEF("*NSEGMENT '%S'*N", SCUE!0)
                                WRITEF("*N*TLPC*T%N*T%S*N", GCUE!2, GCUE!0)
                                FOR I = 1 TO 11 DO
                                       UNLESS RELV!I = 0 DO
                                           WRITEF("*T%S*T%N*N", RELS!I, RELV!I)
                             $)
              UNTIL BATABLE = T  DO                        // CLEAR BATABLE
                                $( LET T = BATABLE
                                   BATABLE := BATABLE!1
                                   FREECELL(T)
                                $)
              UNTIL CUECHAIN = C DO
                                 $( LET C = CUECHAIN
                                  RETURNVEC(C!0,3) //RETURN CUE BLOCK
                                  CUECHAIN:=CUECHAIN!1
                                  FREECELL(C)
                                  $)  $)
                $)1
.
// SEG8
GET "CGHEAD"
LET READOP()=VALOF
      $(1 LET A,I = 0,0

          RCH() REPEATWHILE CH <= ' '
          IF CH = '*E' RESULTIS C.END
          IF '0' <= CH <= '9' DO $( $( A := A*10 + CH - '0'
                                       RCH()
                                       IF CH <  '0' LOGOR CH = '*E' RESULTIS A
                                    $) REPEAT
                                 $)
          WHILE 'A' LE CH LE 'Z' LOGAND I LE 4 DO
               $( A := A * 5 + CH - 'A'
               I := I+1
               RCH()         $)
         WHILE 'A' LE CH LE 'Z' DO RCH()
         IF CH > '*S' DO REPORT(303, "ATTEMPT TO READ INVALID OPCODE")
         SWITCHON A  INTO  $(
      DEFAULT:RESULTIS C.ERROR
     CASE 2361: RESULTIS C.DATALAB
     CASE 136: RESULTIS C.DIV
     CASE 36: RESULTIS C.EQ
     CASE 4709: RESULTIS C.ENTRY
     CASE 201: RESULTIS C.EQV
     CASE 168: RESULTIS C.END
     CASE 3494: RESULTIS C.FALSE
     CASE 965: RESULTIS C.FNAP
    CASE 1048: RESULTIS C.FNRN
     CASE 4508: RESULTIS C.FINISH
     CASE 1209: RESULTIS C.GOTO
     CASE 34: RESULTIS C.GE
     CASE 47: RESULTIS C.GR
     CASE 5480: RESULTIS C.GLOBAL
     CASE 7546: RESULTIS C.ITEML
    CASE 7548: RESULTIS C.ITEMN
     CASE 1700: RESULTIS C.JUMP
     CASE  50: RESULTIS C.JF
     CASE 64: RESULTIS C.JT
     CASE 59: RESULTIS C.LE
     CASE 68: RESULTIS C.LN
     CASE 61 : RESULTIS C.LG
     CASE 70: RESULTIS C.LP
     CASE 66: RESULTIS C.LL
    CASE 73: RESULTIS C.LS
     CASE 276: RESULTIS C.LAB
   CASE 336: RESULTIS C.LLG
     CASE 341: RESULTIS C.LLL
     CASE 345: RESULTIS C.LLP
     CASE 8788: RESULTIS C.LOGAND
     CASE 8862: RESULTIS C.LOGOR
     CASE 9345: RESULTIS C.LSHIFT
     CASE 1937: RESULTIS C.LSTR
     CASE 8943: RESULTIS C.MINUS
     CASE 2074: RESULTIS C.MULT
     CASE 69: RESULTIS C.NE
     CASE 351:RESULTIS C.NEG
     CASE 1826: RESULTIS C.NEQV
     CASE 414: RESULTIS C.NOT
     CASE 2268: RESULTIS C.PLUS
     CASE 463: RESULTIS C.RES
     CASE 457: RESULTIS C.REM
     CASE 2615: RESULTIS C.RTAP
     CASE 13352: RESULTIS C.RSTACK
     CASE 2698: RESULTIS C.RTRN
     CASE 13095: RESULTIS C.RSHIFT
     CASE 106: RESULTIS C.RV
     CASE 96: RESULTIS C.SG
     CASE 105: RESULTIS C.SP
     CASE 101: RESULTIS C.SL
     CASE 13893: RESULTIS C.STIND
     CASE 13645: RESULTIS C.STACK
     CASE 2359: RESULTIS C.SAVE
     CASE 14297: RESULTIS C.SWITCHON
     CASE 14064 : RESULTIS C.STORE
      CASE 458: RESULTIS C.REM               // REN
     CASE 2810: RESULTIS  C.STOP
     CASE 2904: RESULTIS C.TRUE
    $)1

.
// SEG 9
GET "NHEAD1"


GLOBAL $( READSTEERING:275; RS:276; READSTEERINGLINE:277 $)
GLOBAL $( CH:58
          RCH:68
          READN:69
          READL:231
          OPTION:125
          SWAP:270
       $)
LET READN() = VALOF
        $(1 LET A,B      = 0,FALSE

          RCH() REPEATWHILE CH LE '*S'
          IF CH='+' LOGOR CH='-' DO $( IF CH='-' DO B:=TRUE
                                       RCH() $)
      UNLESS '0' LE CH LE '9' DO REPORT(301, "ATTEMPT TO READ INVALID NUMBER*<
                                            *> CH = %N*N", CH)
      TEST B
              THEN WHILE '0' LE CH LE '9' DO $( A := A*10-CH+'0'    // '-'
                                                RCH()   $)
                OR WHILE '0' LE CH LE '9' DO $( A:= A*10+CH-'0'    // '+'
                                                RCH()   $)
       RESULTIS A
     $)1

AND READL() = VALOF
      $(1 LET A = 0
          RCH() REPEATWHILE CH LE '*S'
         UNLESS CH = 'L' DO REPORT(302, "ATTEMPT TO READ INVALID LABEL")
          RCH()
          WHILE '0' LE CH LE '9' DO
            $( A := A * 10 + CH - '0'
               RCH()   $)
          RESULTIS A $)1
AND RCH() BE $(RCH
          READCH(INPUT,LV CH)
          IF CH = '/' DO CH := '*N'
          IF CH = '**' DO $( IF OPTION!3 DO WRITEC(CH)
                             READCH(INPUT, LV CH)
                             TEST CH = '#' THEN $( IF OPTION!3 DO WRITEC(CH)
                                                   READSTEERINGLINE() $)
                                 OR UNTIL CH = '**' LOGOR
                                          CH = '*E' LOGOR
                                          CH = '*N' DO READCH(INPUT, LV CH)
                             GOTO RCH
                          $)
         GOTO L
     L:  L := OPTION!17   -> M, N; GOTO L
     N:  RETURN
     M:  TEST CH = '*E' THEN $( SWAP()
                                WRITES("*N****ENDSTREAMCH*****N")
                                SWAP() $)
                        OR WRITECH(MONITOR, CH)
$)RCH

.
// SEG10
GET "NHEAD1"


GLOBAL $( P.POINTER:28; CFN:29 $)
GLOBAL $( SWAP:270 $)
LET SWAP() BE $( LET A = OUTPUT
                 OUTPUT, MONITOR := MONITOR, A
              $)
AND REPORT(N,S,A,B,C,D,E,F,G,H,I,J,K,L,M) BE
      $( SWAP()
         WRITEF("*N**** REPORT %N FROM '%S' *N", N, CFN(P.POINTER()) )
         WRITEF(S, A,B,C,D,E,F,G,H,I,J,K,L,M)
         NEWLINE()
         REPORTCOUNT := REPORTCOUNT + 1
         IF REPORTCOUNT GR REPORTMAX DO $( WRITES("REPORT FINISH*N")
                                           FINISH $)
         SWAP()
      $)
.
// SEG 11
.
// SEG 12
GET "CGHEAD"

LET LOCALCODE(F, R, K) BE
      $( TEST K < 4096 THEN ASSEMBLE(F, R, K, 2, ABS)
         OR
            $( LET L = K REM 4096
               LET M = K - L
               LET I = FULL!1 = M -> 1,
                       FULL!3 = M -> 3,
                       VALOF $( LET I = NEXTIR()
                                SET(I, M)
                                FULL!I := M
                                ASSEMBLE(ADX, I, 2, 0, ABS)
                                RESULTIS I $)
               ASSEMBLE(F, R, L, I, ABS)
            $)
      $)
LET STACK(N) BE
          $( IF N = SSP RETURN
             TEST N >= SSP+3
             IFSO            STORE(0, SSP)

             IFNOT TEST N > SSP
             IFSO            UNTIL N = SSP DO LOADT(LOCAL, SSP)

             IFNOT           $( UNTIL N = SSP LOGOR ARG2=TEMPV DO
                                                 $( ARG1 := ARG2
                                                    ARG2 := ARG2 - TEMPSIZE
                                                    SSP := SSP - 1
                                                 $)
                                IF N = SSP-1 DO $( H1!ARG1 := H1!ARG2
                                                    H2!ARG1 := H2!ARG2
                                                    H3!ARG1 := H3!ARG2
                                                    H4!ARG1 := H4!ARG2
                                                    H5!ARG1 := H5!ARG2

                                                    SSP := N

                                                    H1!ARG2 := LOCAL
                                                    H2!ARG2 := FALSE
                                                    H3!ARG2 := SSP - 2
                                                    H4!ARG2 := 0
                                                    H5!ARG2 := SSP - 2
                                                 $)
                             $)

             UNLESS N = SSP DO INITSTACK(N)

         $)
AND    STORE(P,R)      BE      $( LET T=TEMPV
                       UNTIL T GR ARG1 DO $( LET S=H5!T
                                       IF S GR R RETURN
                                       IF S GE P DO STORET(T)
                               T:=T + TEMPSIZE         $)
                                            $)
LET STOREIN(K, V) BE
         $( LET F, R = STOZ, NONE

            UNLESS ISZERO(ARG1) DO F, R := STO, MOVETOANYR(ARG1)
            TEST V = VP THEN LOCALCODE(F, R, K)
                        OR   ASSEMBLE(F, R, K, 0, V!2)
            STACK(SSP-1)
         $)
AND STORET(X) BE
         $( IF (H1!X=LOCAL & NOT H2!X & H4!X=0 & H3!X=H5!X)  RETURN
            $( LET F, N = STOZ, NONE
               UNLESS ISZERO(X) DO $( F := STO
                                     N := H1!X=XREG -> H3!X, NEXTR()
                                     MOVETOR(N, X) $)
               LOCALCODE(F, N, H5!X)
               H1!X,H2!X, H3!X, H4!X := LOCAL, FALSE, H5!X, 0
            $)
         $)
AND LOADLV(K, V) BE
         $( LET R=NEXTR()
            TEST V = VP THEN LOCALCODE(LDN, R, K)
                        OR   ASSEMBLE(LDN, R, K, 0, V!2)
            LOADT(XREG, R)
         $)

 .
// SEG 13
GET "CGHEAD"

GLOBAL $( DATALABEL:196 $)
LET WRLAB(N) BE
          $(
             UNLESS SEMICOMPFILE = 0 DO $( EMPTY(- LABV!N)
                                           LABV!N := STVQ
                                        $)
                $)
LET CELLCL(K, TYPE) = VALOF
              $( LET T = LV DATAT
                 AND I, MASK = 0, TYPE = CONST -> 0, #40000000
                 UNTIL(!T&#37777777) = 0 DO  // SEARCH CHAIN
                    $( T := !T
                       IF (!T = K) & (MASK = (T!1 & #40000000)) RESULTIS I
                       T, I := T+1, I+1
                    $)
                 !T := !T LOGOR NEWCELL(K, MASK)
               RESULTIS I
              $)
MANIFEST $( TABLESIZE = 100 $)
LET CELL(TYPE, N) = VALOF
                $( LET P = (DATAP REM TABLESIZE) + DATAV
                   P!1, P!2 := TYPE, N
                   DATAP := DATAP + 2
                   IF DATAP REM TABLESIZE = 0 DO  // TABLE FULL
                          $( LET Q =(DATAP - TABLESIZE)/2   // LOWER PRESETS
                                                            // OUTPUT SO FAR

                             SCF5(LPI, Q)
                             FOR I = DATAV BY 2 TO DATAV + TABLESIZE - 2 DO
                           $(
                                 TEST I!1 = NUMBER THEN COMPLP(I!2)
                               OR DATALABEL(I!2, Q)         // I!2 IS A LABEL
                              Q := Q + 1
                           $)
                             SCF5(PRI, STVQ)
                          $)
                   RESULTIS (DATAP - 2) / 2
                $)
LET CELLC(K) = CELLCL(K, CONST)
AND CELLL(K) = CELLCL(K, LCONST)
.
// SEG 14
GET "CGHEAD"

//LET NEXTPARAM() = VALOF $( PARAMNUMBER := PARAMNUMBER + 1
//                           RESULTIS PARAMNUMBER
//                       $)
LET INITSTACK(N) BE $( ARG1,ARG2 := TEMPV + TEMPSIZE,TEMPV
                       UNLESS -225< SSP-N<225 DO $( ASSEMBLE(CALL,1,BKORE,0,0)
                                                    COMPNUM(N)
                                                    FULL!1 := 0
                                                 $)
                       SSP := N

   H1!ARG2,H2!ARG2,H3!ARG2,H4!ARG2  ,H5!ARG2 :=LOCAL,FALSE,SSP-2,0,SSP-2
  H1!ARG1,H2!ARG1,H3!ARG1,H4!ARG1,H5!ARG1 := LOCAL,FALSE,SSP-1,0,SSP-1
           $)

LET    LOADT(A,B)      BE
               $(      ARG2:=ARG1;     ARG1:=ARG1+TEMPSIZE
       H1!ARG1,H2!ARG1,H3!ARG1,H4!ARG1,H5!ARG1:=A,FALSE,B,0,SSP
               SSP:=SSP+1      $)

AND    LOSE1(R) BE
               $(      SSP:=SSP-1
       TEST ARG2=TEMPV
      THEN H1!ARG2,H2!ARG2,H3!ARG2,H4!ARG2,H5!ARG2:=LOCAL,FALSE,SSP-2 ,
                                               0,SSP-2
       OR      ARG1,ARG2:=ARG2,ARG2-TEMPSIZE

               H1!ARG1, H2!ARG1,H3!ARG1:= XREG,FALSE,R
               H4!ARG1,H5!ARG1:=0,SSP-1        $)

LET STOREI() BE

          $( LET K, R, F = 0, NONE, STOZ

             UNLESS ISZERO(ARG2) DO  R, F := MOVETOANYR(ARG2), STO

             UNLESS H2!ARG1 DO K, H4!ARG1 := H4!ARG1, 0

             H2!V1 := MOVETOANYIR(ARG1)
             FILLA(K, V1)
             H3!V1 := ABS
             OUTINSTR(F, R, V1)
             STACK(SSP-2)
          $)

.
// SEG 15
GET "CGHEAD"

LET CGAPPLY(OP, S) BE
        $( STORE(0, SSP-2)
           FRER(1, IREG)
           FRER(3, IREG)
           MOVETOIR(3, ARG1)
           ASSEMBLE(CALL, 1, BSAVE, 0, 0)
           COMPNUM(S)
            FULL!1, FULL!3 := 0, 0
           STACK(S)
         $)
MANIFEST $( RATIO = 3 $)
LET CGSWITCH(K, L) BE                  // K IS VECTOR OF CONSTANTS, L LABELS
                                       //  K!0 = LENGTH, L!0 = DEFAULT LABEL
         $( LET N = K!0
           AND DFAULT = L!0
           AND SWAP = FALSE
           $( SWAP := FALSE
              FOR I = 1 TO N-1 DO IF K!I > K!(I+1) DO
                                $( LET A, B = K!(I+1), L!(I+1)
                                   K!(I+1), L!(I+1) := K!I, L!I
                                   K!I, L!I := A, B
                                   SWAP := TRUE
                                $)
              $) REPEATWHILE SWAP


           STORE(0, SSP-2)
           FULL!1, FULL!3 := 0, 0
           TEST K!N <= K!1 + RATIO*N

           THEN

           $(DIRECT
              LET I, R = 1, MOVETOANYR(ARG1)
              RKCODE(SBX, R, K!1)      // SUBTRACT LOWER LIMIT
              ASSEMBLE(BNG, R, DFAULT, 0, LABEL) // VALUE TOO SMALL
              ASSEMBLE(TXL, R, CELLC(K!N-K!1+1), 0, LT)
              ASSEMBLE(BCC, NONE, DFAULT, 0, LABEL)
                                                 // TO DEFAULT IF TOO LARGE
              ASSEMBLE(CALL, 1, STVQ+1, 0, PREL) // GET PROGRAM COUNTER IN X1
              ASSEMBLE(ADX, 1, R, 0, ABS)        // AND ADD THE OFFSET
              ASSEMBLE(LDX, R, 3, 1, ABS)        // PICK UP LABEL FROM CASES
              ASSEMBLE(EXIT, R, 0, 0, ABS)       // AND EXIT TO IT

              // NOW THE CASE TABLE - EACH ENTRY IS A LABEL OR DEFAULT

              FOR M = K!1 TO K!N DO
                              TEST K!I = M
                              THEN $( COMPAD(L!I, PREL);
                                      I := I + 1 REPEATWHILE M=K!I $)
                              OR   COMPAD(DFAULT, PREL)
           $)DIRECT

           OR                                    // LARGE RANGE - USE SUBROUTINE

           $(SUBROUTINE
           MOVETOR(4, ARG1)
           ASSEMBLE(CALL, 1, BSWIT, 0, 0)
           COMPNUM(N)
           COMPAD(DFAULT, PREL)
           FOR I = 1 TO N DO $( COMPNUM(K!I); COMPAD(L!I, PREL) $)
           $)SUBROUTINE
           INITSTACK(SSP-1)
         $)
.
// SEG 16
GET "CGHEAD"

LET CGGLOBAL(N, G, L) BE
        $(
           WRLAB(0)
           ASSEMBLE(BRN, NONE, BEXEC, 0, 0)      // IN CASE OF SKIP-DOWN
           FOR I = 1 TO N DO   $( LET A = G!I
                                  IF A > GMAX DO GMAX := A
                                  SCF5( GREL+#20, A)
                                                                 // RELATEVISER
                                  SCF5(PREL, LABV!(L!I))
                               $)
         $)
LET CGENTRY(L, V, SAVEADDRESS) BE
        $( WRLAB(L)
           UNLESS OPTION!4 RETURN
           ASSEMBLE(BRN, NONE, [V!0 / 3]  + 4 + STVQ , 0, PREL)
           RV SAVEADDRESS := STVQ
           COMPNUM(0)                  // TO BE OVERWRITTEN WITH SAVESPACE
           COMPNUM(TRUE)
           $( LET S = VEC [255 /3 + 1]
              PACKSTRING(V, S)
              FOR I = 0  TO  (V!0)/3  DO COMPNUM(S!I)
           $)
        $)
LET CGSTRING(V) BE $( LET S = VEC [ 255   /3] + 1
                      AND P = DATAP/2
                      PACKSTRING(V, S)
                      FOR I = 0 TO [(V!0) / 3 ] DO CELL(NUMBER, S!I)
                      $( LET R = NEXTR()
                         ASSEMBLE(LDN, R, P, 0, DREL)
                         LOADT(XREG, R)
                      $)
                   $)
LET CGSHIFT(F) BE $( LET N = MOVETOANYR(ARG2)
                     TEST ISCONST(ARG1) THEN ASSEMBLE(F,N,H3!ARG1+H4!ARG1,0,ABS)
                                        OR   $( MOVETOANYIR(ARG1)
                                                ASSEMBLE(F,N,H4!ARG1,H3!ARG1,
                                                                     ABS)
                                              $)
                     LOSE1(N)
                   $)
LET CGLOGOP(OP, F) BE $( LET A1, A2 = ARG1, ARG2
                         IF INR(ARG1) DO A1, A2 := ARG2, ARG1
                         $( LET N = MOVETOANYR(A2)
                         TEST ISCONST(A1) THEN RKCODE(F, N, H3!A1)
                                            OR COMPILE(F, N, A1)
                         IF OP = C.EQV DO ASSEMBLE(ERX, N, CELLC(TRUE), 0, LT)
                         LOSE1(N)
                     $)
                   $)
.
// SEG 17
GET "CGHEAD"

LET CGJTJF(RELOP, OP, L) BE
         $( LET ONEZERO = ISZERO(ARG1) LOGOR ISZERO(ARG2)
            AND ONECONSTANT = ISCONST(ARG1) LOGOR ISCONST(ARG2)
            LET A1, A2 = ARG1, ARG2

            LET LESS = RELOP = C.LS LOGOR RELOP = C.LE
            AND GELS = RELOP = C.GE LOGOR RELOP = C.LS

            STORE(0, SSP-3)

            IF ONECONSTANT DO TEST ONEZERO
                             IFSO    IF ISZERO(ARG2) DO A1, A2 := ARG2, ARG1
                            IFNOT    IF ISCONST(ARG2) DO A1, A2 := ARG2, ARG1

            TEST ONEZERO THEN $( LET R = MOVETOANYR(A2)
                                 AND OPTABLE = VALOF $( SWITCHON RELOP INTO
                                             $( CASE C.EQ:RESULTIS TABLE
                                                          0  , BZE, 0  ,
                                                          0  , BNZ, 0  ,
                                                          0  , BZE, 0  ,
                                                          0  , BNZ, 0
                                                CASE C.NE:RESULTIS TABLE
                                                          0  , BNZ, 0  ,
                                                          0  , BZE, 0  ,
                                                          0  , BNZ, 0  ,
                                                          0  , BZE, 0
                                                CASE C.GE:RESULTIS TABLE
                                                          0  , BPZ, 0  ,
                                                          0  , BNG, 0  ,
                                                          0  , BNG, BZE,
                                                          BZE, BPZ, 0
                                                CASE C.GR:RESULTIS TABLE
                                                          BZE, BPZ, 0  ,
                                                          0  , BNG, BZE,
                                                          0  , BNG, 0  ,
                                                          0  , BPZ, 0
                                                CASE C.LS:RESULTIS TABLE
                                                          0  , BNG, 0  ,
                                                          0  , BPZ, 0  ,
                                                          BZE, BPZ, 0  ,
                                                          0  , BNG, BZE
                                                CASE C.LE:RESULTIS TABLE
                                                          0  , BNG, BZE,
                                                          BZE, BPZ, 0  ,
                                                          0  , BPZ, 0  ,
                                                          0  , BNG, 0
CASE 0:
                                             $)
                                          $)


           $( LET INSTRUCTIONS = OPTABLE +[(OP=C.JT->0, 1) + (ARG1=A1->0,2)]* 3
              AND SKIPCODE , CODE, EXTRACODE = H1!INSTRUCTIONS, H2!INSTRUCTIONS,
                                                               H3!INSTRUCTIONS
              UNLESS SKIPCODE = 0 DO ASSEMBLE(SKIPCODE, R, STVQ+(EXTRACODE=0->2,
                                                            3),0, PREL)
              ASSEMBLE(CODE, R, L, 0, LABEL)
              UNLESS EXTRACODE=0 DO ASSEMBLE(EXTRACODE, R, L, 0, LABEL)
           $)
                              $)

            OR TEST RELOP = C.EQ LOGOR RELOP = C.NE
                       THEN   $( LET R = MOVETOANYR(A2)
                                 AND POS = [OP=C.JT] EQV [RELOP = C.EQ]
                                 TEST ONECONSTANT
                                       IFSO $( RKCODE(SBX,R,H3!A1+H4!A1)
                                               ASSEMBLE(POS-> BZE, BNZ,R,
                                                                    L, 0, LABEL)
                                            $)
                                       IFNOT $( COMPILE(TXU,R,A1)
                                                ASSEMBLE(POS -> BCC, BCS, NONE,
                                                                    L, 0, LABEL)
                                             $)
                              $)

            OR TEST ONECONSTANT
                       IFSO   $( LET R = MOVETOANYR(A2)
                                 AND N = ([A1 = ARG2 ] EQV  GELS)  ->  1,  0
                                 ASSEMBLE(ERX, R, CELLC(#40000000), 0, LT)

                                 ASSEMBLE(TXL, R, CELLC(#40000000 NEQV
                                                        [H3!A1 + H4!A1 + N]),
                                                       0, LT)

                                 ASSEMBLE([OP=C.JT] EQV LESS EQV ARG1 = A1 ->
                                                                   BCS, BCC,
                                                       NONE, L, 0, LABEL)
                              $)
                       IFNOT  $( LET R, S = MOVETOANYR(ARG2), MOVETOANYR(ARG1)
                                 AND LSGR = RELOP = C.LS LOGOR RELOP = C.GR
                                 ASSEMBLE(ERX, R, CELLC(#40000000), 0, LT)
                                 ASSEMBLE(ERX, S, CELLC(#40000000), 0, LT)
                                 TEST RELOP=C.GE LOGOR RELOP=C.LS
                                      IFSO  ASSEMBLE(TXL,R,S,0,ABS)
                                      IFNOT ASSEMBLE(TXL,S,R,0,ABS)
                                 ASSEMBLE(OP=C.JT EQV LSGR -> BCS, BCC,
                                                       NONE, L, 0, LABEL)
                              $)


           STACK(SSP-2)
        $)

.
// SEG 18
GET "CGHEAD"

LET RKCODE(OP, R, K) BE                          // OP CAN BE ADX,LDX,NGX,SBX,
                                                 // ANDX, ORX, ERX.
         $( IF K = 0 & (OP=ORX LOGOR OP=SBX LOGOR OP=ADX) RETURN
            TEST K GE 0 IFSO TEST K < 4096 THEN ASSEMBLE(OP+DIRECT,R,K,0,ABS)
                                           OR   ASSEMBLE(OP, R, CELLC(K), 0, LT)
                        IFNOT $( IF K > - 4096 DO SWITCHON OP INTO
                                                 $( CASE LDX:
                                                        ASSEMBLE(NGN,R,-K,0,ABS)
                                                         RETURN
                                                    CASE ADX:
                                                        ASSEMBLE(SBN,R,-K,0,ABS)
                                                         RETURN
                                                    CASE NGX:
                                                        ASSEMBLE(LDN,R,-K,0,ABS)
                                                         RETURN
                                                    CASE SBX:
                                                        ASSEMBLE(ADN,R,-K,0,ABS)
                                                         RETURN
                                                 $)

                                 ASSEMBLE(OP, R, CELLC(K), 0, LT )
                              $)
         $)

LET MOVETO(N, X, REG) = VALOF
           $(MOVE LET K = H4!X
                  UNLESS [H1!X=REG & H3!X=N ] DO  FRER(N, REG)
                  TEST H2!X   IFSO           COMPILE(LDX, N, X)

                             IFNOT  $( TEST H1!X = REG IFSO UNLESS H3!X = N DO
                                                      ASSEMBLE(LDX,N,H3!X,0,ABS)

                                                       IFNOT $( H4!X := 0
                                                                TEST ISCONST(X)
                                                                IFSO SET(N,H3!X)
                                                                IFNOT
                                                                COMPILE(LDX,N,X)
                                                             $)
                                       UNLESS K = 0 DO RKCODE(ADX,N,K)
                                    $)

                  H1!X, H2!X, H3!X, H4!X := REG, FALSE, N, 0
                  RESULTIS N
           $)MOVE



LET MOVETOR(R, X) = MOVETO(R, X, XREG)

AND MOVETOIR(R, X) = VALOF $( LET N = MOVETO(R, X, IREG)
                              FULL!N := 0
                              RESULTIS N
                           $)

LET MOVETOANYR(X) = MOVETO(H1!X=XREG->H3!X, NEXTR(),  X, XREG)

AND MOVETOANYIR(X) = VALOF $( LET N = MOVETO(H1!X=IREG->H3!X, NEXTIR(),  X,IREG)
                              FULL!N := 0
                              RESULTIS N
                           $)


AND FRER(R, REG) BE $( FULL!R := 0
                       FOR X = TEMPV TO ARG1 BY TEMPSIZE DO IF H1!X=REG & H3!X=R
                                                         DO $( STORET(X)
                                                               RETURN
                                                            $)
                    $)
.
// SEG 19
GET "CGHEAD"

LET SET(R, K) BE RKCODE(LDX, R, K)



LET FILLA(K, V) BE
      $( TEST 0 LE K LE 4095 IFSO H1!V := K
         IFNOT
           $( LET R = H2!V
              LET L = K - K REM 4096
              TEST R = 2 THEN $( R := FULL!1 = L -> 1,
                                      FULL!3 = L -> 3,
                                      VALOF $( LET I = NEXTIR()
                                               SET(I, L)
                                               ASSEMBLE(ADX, I, 2, 0, ABS)
                                               FULL!I := L
                                               RESULTIS I
                                            $)
                                 H2!V := R
                              $)
                         OR   RKCODE(ADX, R, L)
              H1!V := K - L
           $)
      $)

LET ADDR(X, V) = VALOF
         $(  LET K=H4!X
             H1!V, H2!V, H3!V := 0, 0, ABS
             IF H2!X DO $( H2!X := FALSE
                           H4!X := 0
                           $( LET R = MOVETOANYIR(X)
                              H2!V := R
                              H3!V := ABS
                              FILLA(K, V)
                              RESULTIS V
                           $)
                        $)


             UNLESS H1!X = NUMBER LOGOR K = 0 DO $( STORET(X)
                                                 H2!V := 2
                                                 H3!V := ABS
                                                 FILLA(H5!X, V)
                                                 RESULTIS V
                                              $)

             SWITCHON H1!X INTO
                            $( CASE ?:      REPORT(311,"INVALID TYPE IN ADDR: *<
                                                      *>X=%N, V=%N*N****X IS *<
                                                      *>%D8%D8%D8%D8%D8,*N*****<
                                                      *>V IS %D8%D8%D8*N",
                                                      X,V,H1!X,H2!X,H3!X,H4!X,
                                                      H5!X,H1!V,H2!V,H3!V)
                                            RESULTIS V

                               CASE NUMBER: H1!V := CELLC(H3!X + K)
                                           H3!V := LT
                                            RESULTIS V
                               CASE IREG:
                               CASE XREG:
                                            H1!V := H3!X
                                            RESULTIS V
                               CASE C.GLOBAL:
                                            H1!V := H3!X
                                            H3!V := GREL
                                            RESULTIS V
                               CASE LABEL:  H1!V := LABV![H3!X] - #77777
                                            H3!V := DREL
                                            RESULTIS V
                               CASE LOCAL:  H2!V := 2
                                            FILLA(H3!X,V)
                                            RESULTIS V
                            $)
         $)

.
// SEG 20
GET "CGHEAD"

GLOBAL $( CGDIV.OR.REM.OR.MULT:235 $)
LET CGPLUS(REG) BE
         $( LET A1, A2 = ARG1, ARG2
            LET MOVE = REG = XREG -> MOVETOANYR, MOVETOANYIR
            IF ISCONST(ARG2) DO A1, A2 := ARG2, ARG1
            TEST ISCONST(A1)

               IFSO $( IF H1!A2 = LOCAL & H3!A2 = SSP-1 DO MOVE(A2)
                       UNLESS ISZERO(A1) DO $( IF H2!A2 = TRUE DO MOVE(A2)
                                               H4!A2 := H4!A2 + H3!A1 + H4!A1
                                            $)
                       UNLESS A2 = ARG2 DO FOR I = H1 TO H4 DO ARG2!I := A2!I
                       STACK(SSP-1)
                    $)

         IFNOT $(  IF  INR(ARG1) DO A1,A2:=ARG2,ARG1
                        $( LET R = MOVE(A2)
                           COMPILE(ADX, R, A1)
                             LOSE1(R)
                   H1!ARG1 := REG
                        $)
                    $)
         $)

LET CGRV() BE $( IF H2!ARG1 = TRUE DO MOVETOANYR(ARG1)
                 H2!ARG1 := TRUE
              $)

LET  CGDIV.OR.REM.OR.MULT(OP) BE
      $( LET A1, A2 = ARG1, ARG2
         AND R, S = ?, ?
         IF ISCONST(A1) & ISCONST(A2) DO $( LET A, B = H3!ARG1 , H3!ARG2
                                            H3!ARG2 := OP = C.MULT -> A*B,
                                                       OP = C.DIV -> B/A,
                                                       B REM A
                                            STACK(SSP - 1)
                                            RETURN
                                         $)
            TEST OP = C.MULT THEN $( IF INR(ARG1) DO A1, A2 := ARG2, ARG1
                                     R, S := MOVETOANYR(A2), R+1 REM 8
                                     FRER(S, XREG)
                                     COMPILE(MPY, R, A1)
                                     ASSEMBLE(BZE,R,STVQ+2,0,PREL)
                                     ASSEMBLE(ORX,S,CELLC(#40000000),0,LT)
                                  $)
                             OR   $( R, S := 4, 5
                                     FRER(R, XREG)
                                     MOVETOR(S, ARG2)
                                     COMPILE(DVS, R, ARG1)
                                  $)
         LOSE1(OP = C.REM -> R, S)
      $)
LET CGMINUS() BE $(
                    IF ISCONST(ARG1) & ISCONST(ARG2) DO $( H3!ARG2 := H3!ARG2 -
                                                                    H3!ARG1
                                                        STACK(SSP - 1)
                                                        RETURN $)
                    $( LET N = MOVETOANYR(ARG2)
                       TEST ISCONST(ARG1) THEN RKCODE(SBX, N, H3!ARG1)
                                          OR COMPILE(SBX, N, ARG1)
                       LOSE1(N)
                    $)
                 $)
.
// SEG 21
GET "CGHEAD"

LET CGREL(OP) BE
         $( LET R = ?
            STORE(0, SSP-3)
            R := MOVETOANYR(ARG2)
            TEST OP = C.EQ LOGOR OP = C.NE
                   IFSO COMPILE(TXU, R, ARG1)
                   IFNOT $( LET R1 = MOVETOANYR(ARG1)
                           ASSEMBLE(ERX, R , CELLC(#40000000), 0, LT)
                           ASSEMBLE(ERX, R1, CELLC(#40000000), 0, LT)
                            TEST OP = C.LS LOGOR OP=C.GE THEN
                                                      ASSEMBLE(TXL,R ,R1,0,ABS)
                                                      OR
                                                      ASSEMBLE(TXL,R1,R ,0,ABS)
                         $)

            TEST OP = C.NE LOGOR OP=C.LS LOGOR OP=C.GR THEN
                                                 ASSEMBLE(NGN,R,0,0,ABS)
                                                 OR
                                                 $( ASSEMBLE(LDN,R,0,0,ABS)
                                                    ASSEMBLE(SBN,R,1,0,ABS)
                                                 $)
            STACK(SSP-2)
            LOADT(XREG, R)
         $)
.
// SEG 22

GET "CGHEAD"

LET ISZERO(X) = H1!X=NUMBER & H2!X=FALSE & (H3!X + H4!X = 0)
AND ISCONST(X) = H1!X=NUMBER & H2!X=FALSE
AND INR(X)  = H1!X=XREG & H2!X=FALSE
AND INIR(X) = H1!X=IREG & H2!X=FALSE


LET ISFREE(R)  =     VALOF $( FOR X= ARG1 BY -TEMPSIZE TO TEMPV        DO
                                    $( LET TYPE = H1!X
                                       IF (TYPE=XREG LOGOR TYPE=IREG) & H3!X=R
                                                              RESULTIS FALSE
                                    $)
                              RESULTIS FULL!R = 0
                          $)
LET NEXTR()=VALOF $(
                     FOR I = 4 TO 7 DO IF ISFREE(I) RESULTIS I
                     STORE(0, SSP-3)
                     RESULTIS NEXTR()
                     $)


AND NEXTIR() = VALOF $(
                               IF ISFREE(1) RESULTIS 1
                               IF ISFREE(3) RESULTIS 3
                               TEST (FULL!1 = 0 & FULL!3 = 0) // IE BOTH CONTAIN
                                                              // PARTIAL RESULTS
                               THEN STORE(0, SSP-1)   // STORE PARTIAL RESULTS
                               OR        // ONE CONTAINS A STACK OFF-SET
                               FULL!(FULL!1=0 -> 3, 1) := 0
                               RESULTIS NEXTIR()
                           $)
.
// SEG23

GET "CGHEAD"

STATIC $( BKT = 0
         BKT1 = 0
         NODE = 0
         PTR = 0
         REC = 0
         ENDREC = 0
         MOD = 0
         WORD = 0
         RECORDS = 0
      $)

LET OUTBUCKET() BE $( LET L = REC - BKT
                      IF L = 2 RETURN
                      NODE!3 := L
                      RV BKT := 0
                      BKT!1 := L LOGOR #02000000
                      WRITEBUCKET(NODE)
                      RECORDS, REC := 0, BKT + 2
                      NODE!5 := NODE!5 + 1
                   $)
LET DEP(CH) BE $(
                  LET T = TABLE
                          #40020002,   // LDX   4  2(2)
                          #10000000,   // LDX   1  MOD
                          #41610000,   // DCH   4  0(1)
                          #13200000,   // BCHX  1  *+1
                          #10400000,   // STO   1  MOD
                          #10020001,   // LDX   1  1(2)
                          #20020000,   // LDX   2  0(2)
                          #13500000    // EXIT  1  0

                  T!1 := T!1 LOGOR LV MOD
                  T!3 := T!3 LOGOR (T+4)
                  T!4 := T!4 LOGOR LV MOD

                  DEP := T
                  GOTO DEP
               $)

LET DEP0(CH) BE WORD, DEP, MOD := CH << 18, DEP1, PTR LOGOR #20000000
AND DEP1(CH) BE WORD, DEP, MOD := WORD LOGOR (CH << 12), DEP2, PTR LOGOR #40000000

AND DEP2(CH) BE WORD, DEP, MOD := WORD LOGOR (CH << 6), DEP3, PTR LOGOR #60000000

AND DEP3(CH) BE $( RV PTR := WORD LOGOR CH
                   DEP := DEP0
                   PTR := PTR + 1
                   MOD := PTR
                $)

LET NEWRECORD(TYPE) BE $( UNLESS ENDREC DO ENDRECORD()
                          IF RECORDS = 7 DO OUTBUCKET()
                          RECORDS := RECORDS + 1
                          ENDREC := FALSE
                          !REC := 18
                          PTR := REC + 1
                          DEP := DEP0
                          MOD := PTR
                          DEP(TYPE)
                          DEP(17)       // S/C RECORD WORD COUNT
                       $)
AND ENDRECORD() BE $(  DEP(#04)
                       UNLESS DEP = DEP0 DO !PTR := WORD
                       $( LET N = 0
                          FOR I = REC+1 TO REC + 16 DO N := N + RV I
                          REC!17 := - N                    // CHECKSUM
                       $)
                       REC := REC + 18
                       ENDREC := TRUE
                   $)
LET SCFIELD(TYPE, S) BE
                  $( LET V = VEC 255
                     UNPACKSTRING(S, V)
                     IF PTR >= REC + 16 - (V!0)/4 DO NEWRECORD(0)
                     DEP(TYPE)
                     FOR I = 1 TO V!0 DO $( LET X = V!I - ' '
                                            IF X < ' ' DO X := X NEQV #20
                                            DEP(X)
                                         $)
                     DEP(#20)
                  $)
LET OCTFIELD(N) BE
                     $( LET OCT(N) BE $( UNLESS N>>3 = 0 DO OCT(N>>3);
                                         DEP(N & #7)
                                      $)
                        OCT(N)
                        DEP(#20)
                     $)
AND NAMEFIELD(S) BE $( LET V = VEC 255
                       UNPACKSTRING(S, V)
                       FOR I = 1 TO V!0 DO $( LET X = V!I - ' '
                                              IF X < ' ' DO X := X NEQV #20
                                              DEP(X)
                                           $)
               DEP(#20)
              $)
STATIC $( DDBKT = 0 $)
LET CLOSESEMICOMPFILE(M) BE $(1 IF M = 0 RETURN
                             $(
                                LET N = ! M
                                UNLESS ENDREC DO ENDRECORD()
                                UNLESS RECORDS = 0 DO OUTBUCKET()
                                 $( LET A, B, C = N!3, N!4, N!5
                                   BKT1!15 := N!5 - BKT1!14      // SIZE
                                    N!3, N!4, N!5 :=BKT1!1& #7777, BKT1, DDBKT
                                   WRITEBUCKET(N)
                                   N!3, N!4, N!5 := A, B, C
                                $)
                                 $( LET V = VEC 7
                                    V!6 := N!6
                                    EXECUTE(#66740000 LOGOR // PERI 6
                                            (TABLE #40601000,0,0),
                                             V, V)
                                 $)
                                    N!11 := -1
                            $)1
LET SCSTART() BE $( TITLEREC(#03,                          // SEMI-COMPILED DATA
                                                           // LEADER RECORD.
                             MODE,
                             GSEG)
                    NEWRECORD(0)
                 $)
AND SCEND() BE $( SCF1( END)
                  SCF1(END)                                // SEMI-COMPILED DATA
                                                           // RECORD TERMINATOR.
                  ENDRECORD()
                  TERMINREC(#04,RELV)
                           TITLEREC(#33, MODE, GSEG)
                  WRITECUES(CUECHAIN)
                  TERMINREC(#34,RELV)
               $)
LET TITLEREC(TYPE, N, S) BE $( NEWRECORD(TYPE)
                               OCTFIELD(N)
                               NAMEFIELD(S)
                               ENDRECORD()
                            $)
AND TERMINREC(TYPE, V) BE
         $( NEWRECORD(TYPE)
            FOR I = 1 TO 10 DO OCTFIELD(V=0->0, V!I)
            ENDRECORD()
            IF TYPE = #34 DO OUTBUCKET()
         $)
AND SCF1(A) BE $( IF MOD = [(REC + 16) LOGOR #60000000] DO NEWRECORD(0)
                  DEP(A)
               $)
AND SCF5(A, B) BE $( LET R = MOD & #17777777
                     IF R >= REC + 15 DO UNLESS R = REC + 15 & MOD > 0
                                                       DO NEWRECORD(0)
                    DEP(A)
                    DEP(B >> 18)
                    DEP([B >> 12] & #77)
                    DEP([B >>  6] & #77)
                    DEP(B & #77)
                 $)
LET SLCUEREC(TYPE, VALUE, S, N) BE $( NEWRECORD(#37)
                                      OCTFIELD((TYPE<<18) LOGOR VALUE)
                                      NAMEFIELD(S)
                                                                 OCTFIELD(N)
                                   $)
LET PRIORITYNAMEREC(D1, D2, NAME) BE
                   $( NEWRECORD(#30)
                OCTFIELD(MODE LOGOR
                                D1 << 6 LOGOR // DIGIT 1 OF PRIORITY
                                 D2           )           // DIGIT 2
                      NAMEFIELD(NAME)
                      ENDRECORD()
                   $)
LET CREATESEMICOMPFILE(M) = VALOF $(1 IF M = 0 RESULTIS 0
                                  $( LET N = ! M
                                     BKT := N!4
                                     REC := BKT + 2
                                     ENDREC := TRUE
                                     IF OPTION!22 DO DEP0 := DEP
                                     DDBKT := N!5
                                     N!5 := N!5 + 1
                                     RECORDS := 0
                                     N!7, N!8, N!9 := REC, REC, 34
                                     NODE := N
                                     BKT1 := TABLE 0,
                                                   #02000023,
                                                   8,
                                                 #43575560,      //"COMP"
                                                 #57465154,    //"OFIL"
                                                 #45202020,    //"E   "
                                                 0,
                                                 1,
                                                 0,
                                                 0,
                                                 9,
                                                 #63654262,    //'SUBR'
                                                 #57656451,    //'OUTI'
                                                 #56456320,    //,NES ,
                                                 ?,
                                                 ?,
                                                 0,
                                                 1,
                                                 #42040000    //'B400'
                                       BKT1!14 := N!5      //START OF DATA
                             RESULTIS M
                                                 $)1
.
// SEG 24
GET "CGHEAD"
GLOBAL $( DATALABEL:196 $)
LET ASSEMBLE(OP, X, N, M, TYPE) BE
          $(
                           LET WORD = [X=NONE -> 0, X<<21] LOGOR (M<<12) LOGOR OP
                           TEST TYPE = LABEL
                           THEN TEST LABV!N > 0
                                THEN SCF5(PREL, LABV!N LOGOR WORD)
                                OR   $( BRANCHAHEAD(LABV + N)
                                        SCF5(ABS, WORD)
                                     $)
                           OR   TEST TYPE = 0
                                THEN $( TYPE := N!2
                                        IF TYPE = ABS DO BRANCHAHEAD(N+1)
                                        SCF5(TYPE, WORD)
                                     $)
                                OR   SCF5(TYPE, WORD LOGOR N)
             STVQ := STVQ + 1
          $)
LET COMPNUM(N) BE $(
                     SCF5(ABS, N)
                     STVQ := STVQ + 1
                  $)
AND COMPAD(L, REL) BE $(
                         LET N = LABV!L
                         TEST N > 0              // LABEL VALUE KNOWN
                         THEN SCF5(N<#77777-> PREL, LP,N REM #77777)
                         OR   $( SCF5(ABS, 0)    // REL IS PREL IN THIS CASE
                                 BRANCHAHEAD(L+LABV)
                              $)
                         IF REL = PREL DO STVQ := STVQ + 1
                      $)
LET COMPLP(N) BE SCF5(ABS, N)
AND DATALABEL(L, I) BE $( LET N = LABV!L
                          TEST N > 0
                           THEN SCF5(N<#77777 -> PREL, LP,N REM #77777)
                             OR $( SCF5(ABS, 0)
                                   LABV!L := -NEWCELL(#20000000 LOGOR I, -N)
                                $)
                       $)
LET OUTINSTR(OP, X, V) BE ASSEMBLE(OP, X, V!0, V!1, V!2)
LET COMPILE(OP, X, ARG) BE TEST INR(ARG)
                           THEN ASSEMBLE(OP, X, H3!ARG, 0, ABS)
                           OR OUTINSTR(OP, X, ADDR(ARG, V1))
.
// SEG 25
GET "CGHEAD"
GLOBAL $( PACK1900:256 $)
STATIC $( REC = 0
          BKT = 0
          NODE = 0
       $)
LET RECORD(NN,A, B, C, D, E, F, G, H, I, J, K, L, M, N, O, P, Q, R, S, T, U, V)
= VALOF
          $( LET PP = LV NN
//
//           OUTPUT AN 'N' PARAMETER IF BUCKET FULL
//
             IF REC+NN > BKT+126 DO $( REC!0, REC!1 :=2, #56000000 LOGOR
                                                              (NODE!5+1)
                                       NODE!3 := REC - BKT + 2
                                       WRITEBUCKET(NODE)
                                       NODE!5 := NODE!5 + 1
                                       REC := BKT + 2
                                    $)
             FOR I = 0 TO NN DO REC!I := PP!I
             REC := REC + NN
             RESULTIS REC - NN
          $)
LET WRITESTEERINGBUCKET(N) BE
         $( LET FNO = 0                          // NEXT FILE REFERENCE NO.
             NODE := !N
             BKT := NODE!4
             REC := BKT + 2
             BKT!0, BKT!1 := 0, #00020002
//           INPUT FILE- REF.NO. = 0 - "PSEUDO" SUBFILE
             $( LET R = RECORD(7, #63000000 LOGOR FNO,// "S" PARAM.FILE NO. 0
                                  #00000001,     // FILE 0.S/F FOUND BY XPCK.
                                  0,             // UNDEFINED.
                                  0,             // FIRST SUBFILE
                                  0,
                                  0)
              $)
             RECORD(2, #51000000 LOGOR FNO)                   // "I" PARAM. INCL.
             FNO := FNO + 1
//           BINARY OUTPUT FILE(IF SPECIFIED) REF.NO. = 2 - SET UP AS COMPOSITE.
             UNLESS !GBINV=-1 LOGOR
                    !GBINV=0 DO $( LET R = RECORD(7, #46000000 LOGOR FNO,
                                                     #04,        // OUTPUT
                                                     #07700040,
                                                     ?,          // FILENAME
                                                     ?,
                                                     ?)
                                   AND S = RECORD(8, #63000000 LOGOR FNO,  // 'S' PA
                                                                 // S/F REF.NO 2
                                                     (FNO << 18) LOGOR
                                                      (OPTION!6 -> 0, // APPEND
                                                                #10), // NEW S/F
                                                     0,
                                                     0,          // DEFAULT
                                                     0,          // S/F NAME
                                                     0,
                                                     0)
                                   PACK1900(GBINV, R+4, 12)
                                  FNO := FNO + 1
                               $)
//           LIBRARY FILES
             $( LET L = LIBLIST
                UNTIL L=0 DO
                     $( LET CELL = L!0
                        LET R = RECORD(7,
                                       #46000000 LOGOR FNO ,        // 'F' PARAM
                                       #01,                      // INPUT ONLY
                                       #07700040,
                                       ?,
                                       ?,
                                       ?)
                        AND S = RECORD(7,
                                       #63000000 LOGOR FNO,         // 'S' PARAM.
                                       (FNO << 18) LOGOR #01,       // INPUT
                                       0,                        // (UNDEFINED)
                                       0,
                                       0,
                                       0)
                        PACK1900 (CELL!0, R + 4, 12)             // FILENAME
                        UNLESS CELL!1 = 0 DO
                              PACK1900 (CELL!1, S + 4, 12)       //SUBFILE
                        RECORD(2, #51000000 LOGOR CELL!2 << 6 LOGOR FNO)
                                                                 // 'I' PARAM
                        L := L!1
                        FNO := FNO + 1
                     $)
            $)
//          CONSOLIDATAOR LISTING LEVELS
             RECORD(2, #61000000 LOGOR [                           // 'Q' PARAMETER
                                    OPTION!2 -> #13,             // LIST
                                    OPTION!1 -> #23,             // LISTNAMES
                                    OPTION!0 -> #03,             // SHORTLIST
                                    #05)                         // ERRORLIST
                                    ]
// 'D' PARAMETER - XPCK DELETES 'FI#PROG#FILE' IF OPTION!8
              IF OPTION!8 DO RECORD(3,#44000000, #27000000)
             RECORD(0)                           // TERMINATOR
             NODE!3 := REC - BKT + 1
             WRITEBUCKET(NODE)
             NODE!5 := NODE!5 + 1
          $)
.
// SEG 26
GLOBAL $( OPTION:125 $)
GLOBAL $( WRITEBUCKET:400 $)
GET "GLOBALS"

GLOBAL $( PACK1900:256 $)
LET PACK1900(SOURCE,TARGET,LENGTH) BE
            $( LET U = VEC 255
               UNLESS LENGTH REM 4 = 0 DO LENGTH  := (LENGTH /4) *4 + 4
               FOR I = 1 TO LENGTH DO U!I := ' '
               UNPACKSTRING(SOURCE, U)
               FOR I = 1 TO LENGTH DO U!I := U!I < 'A' -> (U!I - ' ') NEQV #20,
                                             U!I - ' '
               $( LET J = 1
                  FOR I = TARGET TO TARGET + (LENGTH/4) - 1 DO
                                       $( RV I := ((U!J) << 18) LOGOR
                                                  ((U!(J+1)) << 12) LOGOR
                                                  ((U!(J+2)) <<  6) LOGOR
                                                  U!(J+3)
                                          J := J + 4
                                       $)
               $)
            $)
LET WRITEBUCKET(NODE) BE
          $(1
            $( LET U = TABLE 0, 0, 0, 0, 0, 0, 0, 0
               U!3, U!6 := NODE, NODE!6
               NODE!2 := 0
               IF OPTION!21 DO $( LET A = OUTPUT
                                OUTPUT := MONITOR
                                WRITEF("*NBUCKET NO. %N*NHEADER **%O8  **%O8*N",
                                        NODE!5,NODE!4!0,NODE!4!1)
                                FOR I = NODE!4 + 2 TO NODE!3 + NODE!4 BY 4 DO
                                  WRITEF("%O8  %O8  %O8  %O8*N",I!0,I!1,I!2,I!3)
                                  OUTPUT := A
                             $)
               EXECUTE(#66770001, U, U)                    // PERI  6  1(3)
               EXECUTE(#66400406, U, U)                    // SUSBY 6  262
               UNLESS[NODE!2 & #14000000]= 0 DO $( NODE!11 := 0
                                                    TY.HALT("E6")
                                                    FINISH $)
               IF [ NODE!2 & #01000000 ] = 0   BREAK
               EXTEND(NODE) $) REPEAT
         $)1
AND EXTEND(NODE) BE $(
                    TY.DISPLAY('FILE TO BE EXTENDED')
$( LET N = NODE
                    WRITEF("NODE:*N#%O8*N#%O8*N#%O8*N#%O8*N#%O8*N#%O8*N",
                             N!1, N!2, N!3, N!4, N!5, N!6)
                    FINISH
$)
                    $)
.
// SEG 27

GLOBAL $(
	WRITECUES: 239
	SLCUEREC: 253
$)

LET WRITECUES (cuechain) BE

	WHILE cuechain NE 0 DO $(

		LET cue = cuechain!0
		LET s = cue!0
		LET type = cue!1
		LET value = cue!2
		LET n = cue!3

		SLCUEREC (type, value, s, n)

		cuechain := cuechain!1
	$)


GLOBAL $(
	STVQ: 111
	FREECELL: 245
	SCF5: 249
	EMPTY: 259
$)

LET EMPTY (label) BE $(

	IF label EQ 0 RETURN

	// Why isn't this a REPEATWHILE?  Would save jump, 1 test.

	WHILE label NE 0 DO $(

		LET p = label!0

		TEST (p & #20000000) EQ 0
		THEN
			SCF5 (59, p)
		OR
			SCF5 (52, p & #7777)

		SCF5 (0, #77777)

		SCF5 (43, STVQ)

		$(
			LET q = label
			label := q!1
			FREECELL (q)
		$)
	$)

	SCF5 (59, STVQ)
$)


GLOBAL $(
	BRANCHAHEAD: 258
	NEWCELL: 238
$)

// The variable "unused" exists in the orignal version, as can
// be seen by the stack usage in the call to NEWCELL.

LET BRANCHAHEAD (ADDR) BE $(
	LET unused = ?
	!ADDR := - NEWCELL (STVQ, -!ADDR)
$)


GLOBAL $(
	B.A.SET: 188
	SCFIELD: 250
$)

LET B.A.SET (label, region) BE $(

	LET p, q = label!0, - label!1	// 4(2), 5(2)
	LET r = label!2			// 6(2)

	IF r = 32 THEN r := 47

	IF q NE 0 THEN SCFIELD (r - 36, p)

	WHILE q NE 0 DO $(

		SCF5 (59, !q)
		SCF5 (0, 32767)
		SCF5 (r, 0)

		$(
			LET s = q	// 7(2)
			q := s!1
			FREECELL (s)
		$)
	$)

	label!1 := 0

	IF label!2 NE region LOGAND region NE 32 THEN
		SCFIELD (region - 36, p)

	label!2 := region
$)

.

// SEG 28


GLOBAL $(
	STRING:247
	NEWVEC:80
$)

LET STRING (str) = VALOF $(
	LET len = ((!str) >> 16) / 3
	AND s = NEWVEC (len)
	FOR i = 0 TO len DO s!i := str!i
	RESULTIS s
$)


GLOBAL $(
	PACKSTRING: 66
	UNPACKSTRING: 67
	APPENDN: 246
$)

LET APPENDN (string, dest, num) BE $(

	LET n = num < 0 -> -num, num
	LET v = VEC 255
	UNPACKSTRING (string, v)

	$(
		LET e = v + !v + 1	// END OF STRING
		LET p = e

		// Append sign if -ve

		IF n NE num THEN $(
			!e := '-'
			e := e + 1
			p := p + 1
		$)

		// GET DIGITS.  Since we get them
		// IN REVERSE ORDER WE SHUFFLE DOWN
		// THE ONES WE ALREADY HAVE, INSERTING
		// THE NEW ONE AT "e".

		$(
			LET q = p

			// MAKE SPACE FOR NEXT DIGIT

			WHILE q NE e DO $(
				!q := !(q - 1)
				q := q - 1
			$)

			// GET NEXT DIGIT

			!e := (n REM 10) + '0'
			p := p + 1
			n := n / 10

		$) REPEATWHILE n

		!v := p - v - 1

		PACKSTRING (v, dest)
	$)
$)


MANIFEST $(
	head = 0
	tail = 1
	len = 2
	end = 0
$)

GLOBAL $(	
	OPTION:125
	NEXTCELL:107
	FREECELL:245
	NEWCELL:238
	FS:87
	REPORTFREESTORESTATE:88
$)

MANIFEST $(
	alloc = 25 * len - 1
$)


LET NEWCELL (car, cdr) = VALOF $(

	LET ret = NEXTCELL

	IF NEXTCELL = end DO $(

		UNLESS OPTION!23 = 0 DO REPORTFREESTORESTATE (FS)

		NEXTCELL := NEWVEC (alloc)
		ret := NEXTCELL

		$(
			LET p = @ ret!tail
			LET last = ret + (alloc - 1)
	
			WHILE p <= last DO $(
				!p := p + 1	// POINT TAIL AT NEXT CELL
				p := p + len	// MOVE TO NEXT CELL
			$)

			ret!alloc := end	// SET END OF LIST
		$)

	$)

	NEXTCELL := NEXTCELL!tail

	ret!head := car
	ret!tail := cdr

	RESULTIS ret
$)


LET FREECELL (cell) BE $(
	cell!tail := NEXTCELL
	NEXTCELL := cell
$)


GLOBAL $(
	LIST: 244
$)

LET LIST (len, a, ?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?) = VALOF $(
	LET pv, pa = NEWVEC (len - 1), @a
	LET i, n = 0, len - 1

	WHILE i <= n DO $(
		pv!i := pa!i
		i := i + 1
	$)

	RESULTIS pv
$)


.


// SEG 29


GET "CGHEAD"

LET WRITEOP(X) = VALOF
       SWITCHON X INTO
          $( DEFAULT: RESULTIS "**** UNKNOWN OCODE SYMBOL : %N"
               CASE C.MULT:      RESULTIS "MULT"
               CASE C.DIV:       RESULTIS "DIV"
               CASE C.REM:       RESULTIS "REM"
               CASE C.PLUS:      RESULTIS "PLUS"
               CASE C.MINUS:     RESULTIS "MINUS"
               CASE C.EQ:        RESULTIS "EQ"
               CASE C.NE:        RESULTIS "NE"
               CASE C.LS:        RESULTIS "LS"
               CASE C.GR:        RESULTIS "GR"
               CASE C.LE:        RESULTIS "LE"
               CASE C.GE:        RESULTIS "GE"
               CASE C.LSHIFT:    RESULTIS "LSHIFT"
               CASE C.RSHIFT:    RESULTIS "RSHIFT"
               CASE C.LOGAND:    RESULTIS "LOGAND"
               CASE C.LOGOR:     RESULTIS "LOGOR"
               CASE C.EQV:       RESULTIS "EQV"
               CASE C.NEQV:      RESULTIS "NEQV"
               CASE C.NEG:       RESULTIS "NEG"
               CASE C.NOT:       RESULTIS "NOT"
               CASE C.RV:        RESULTIS "RV"
               CASE C.TRUE:      RESULTIS "TRUE"
               CASE C.FALSE:     RESULTIS "FALSE"
               CASE C.LP:        RESULTIS "LP"
               CASE C.LG:        RESULTIS "LG"
               CASE C.LN:        RESULTIS "LN"
               CASE C.LSTR:      RESULTIS "LSTR"
               CASE C.LL:        RESULTIS "LL"
               CASE C.LLP:       RESULTIS "LLP"
               CASE C.LLG:       RESULTIS "LLG"
               CASE C.LLL:       RESULTIS "LLL"
               CASE C.SP:        RESULTIS "SP"
               CASE C.SG:        RESULTIS "SG"
               CASE C.SL:        RESULTIS "SL"
               CASE C.STIND:     RESULTIS "STIND"
               CASE C.JUMP:      RESULTIS "JUMP"
               CASE C.JT:        RESULTIS "JT"
               CASE C.JF:        RESULTIS "JF"
               CASE C.GOTO:      RESULTIS "GOTO"
               CASE C.LAB:       RESULTIS "LAB"
               CASE C.STACK:     RESULTIS "STACK"
               CASE C.STORE:     RESULTIS "STORE"
               CASE C.ENTRY:     RESULTIS "ENTRY"
               CASE C.SAVE:      RESULTIS "SAVE"
               CASE C.FNAP:      RESULTIS "FNAP"
               CASE C.FNRN:      RESULTIS "FNRN"
               CASE C.RTAP:      RESULTIS "RTAP"
               CASE C.RTRN:      RESULTIS "RTRN"
               CASE C.RES:       RESULTIS "RES"
               CASE C.RSTACK:    RESULTIS "RSTACK"
               CASE C.FINISH:    RESULTIS "FINISH"
               CASE C.SWITCHON:  RESULTIS "SWITCHON"
               CASE C.GLOBAL:    RESULTIS "GLOBAL"
               CASE C.DATALAB:   RESULTIS "DATALAB"
               CASE C.ITEML:     RESULTIS "ITEML"
               CASE C.ITEMN:     RESULTIS "ITEMN"
	  $)

.

// SEG 30

GET "CGHEAD"

GLOBAL $(
	OPTION:125; PRINTING:126; STACKDEPTH:127
	WRITEOP:230
	PRINTSTACK:260
$)

LET SUMMARIZESTATE() BE $(
	SWAP ();
	IF PRINTING DO NEWLINE()
	IF OPTION!18 DO $(
		WRITEF (WRITEOP (OP), OP)
		NEWLINE ()
	$)
	IF OPTION!13 DO
		WRITEF ("*TOP = %N", OP)
	IF OPTION!12 DO
		WRITEF ("*TFULL VECTOR: %N %N %N %N %N %N %N %N *<
			*>*TV1 : %N %N %N %N %N *<
			*>*TV2 : %N %N %N %N %N ",
			FULL!0, FULL!1, FULL!2, FULL!3,
			FULL!4, FULL!5, FULL!6, FULL!7,
			V1!0, V1!1, V1!2, V1!3, V1!4,
			V2!0, V2!1, V2!2, V2!3, V2!4)
	IF OPTION!11 DO
		PRINTSTACK (STACKDEPTH)
	IF PRINTING DO NEWLINE ()
	SWAP ()
$)

.

// SEG 31

GET "CGHEAD"

LET PRINTSTACK (depth) BE $(
	SWAP ()
	WRITEF ("*N****STACK STATE: SSP = %D5   *>
		*<ARG2 = %D5   ARG1 = %D5   TEMPV = %D5*N",
		SSP, ARG2, ARG1, TEMPV)
	TEST depth = 0
	THEN
		WRITES ("****COMPLETE STACK*N")
	OR
		WRITEF ("****TOP %N ELEMENTS PRINTED*N", depth)
	$(
		LET p = (depth = 0) -> TEMPV, ARG1 - (depth -1) * TEMPSIZE
		LET q = ARG1
		WHILE p <= q DO $(
			LET r = p!0
			LET s = p!1
			WRITED (p, 8)
			FOR t = 0 TO TEMPSIZE - 1 DO WRITED (p!t, 6)
			WRITEF ("*T%S*T%S*N",
				r = LOCAL -> "LOCAL",
				r = C.GLOBAL -> "GLOBAL",
				r = NUMBER -> "NUMBER",
				r = XREG -> "XREG",
				r = IREG -> "IREG",
				r = LABEL -> "LABEL",
				"??????",
				s -> "TRUE", "FALSE")
			p := p + TEMPSIZE
		$)
	$)
	FOR i = 0 TO 99 DO WRITEC ('.')
	NEWLINE ()
	SWAP ()
$)


.

// SEG 32


GET "CGHEAD"
GET "NHEAD0"

GLOBAL $(
	TRACE:53
	TRACENAMES:267
$)

LET TRACENAMES() BE $(
	LET READ(ch) BE READCH (INPUT, ch)
	LET c = 0
	AND v = VEC 255
	AND w = VEC 100
	LET p, q = SYSTEM.DATA.BLOCK!7, SYSTEM.DATA.BLOCK!8!0
	SWAP ()
	WRITES ("*NFUNCTIONS TO BE TRACED.*N*N")
	$(
		LET r = q
		LET s = 0
		LET t = FALSE
		READ (@c) REPEATWHILE c NE '**' LOGAND c < 'A'
		IF c = '**' LOGOR c EQ 255 BREAK
		$(
			s := s + 1
			v!s := c
			READ (@c)
		$) REPEATWHILE (c >= '0' LOGOR c EQ '.') LOGAND c NE 255
		v!0 := s
		PACKSTRING (v, w)
		$(
			r := r - 1 REPEATWHILE r!0 NE -1 LOGAND p NE r
			IF r EQ p BREAK
			$(
				LET u = (r!1) >> 16
				IF u NE s LOOP
				t := VALOF $(
					LET a, b = 0, u / 3
					WHILE a <= b DO $(
						IF !(r + 1 + a) NE w!a
							RESULTIS FALSE
						a := a + 1
					$)
					RESULTIS TRUE
				$)
			$)
		$) REPEATWHILE t = FALSE
		TEST r EQ p
		THEN
			WRITEF ("*N*T*TFUNCTION %S NOT FOUND*N", w)
		OR $(
			TRACE (r - 2)
			WRITEF ("%S*N", w)
		$)
	$) REPEATWHILE c NE '**' LOGAND c NE 255
	IF c = 255 DO WRITES("*N*T*TENDOFSTREAM READ*N")
	WRITES ("*NEND OF TRACENAMES*N*P")
	SWAP ()
$)

.
// SEG 33

// This is a smaller version of %BLIB0 in SUBGROUPSRB1

GET "NHEAD0"
GET "CGHEAD"

GLOBAL $( NEXTCH:59; $)


LET PACKSTRING(V,S) BE
   $( LET N = !V & #377
         $( LET A,B,C = V!0,0,0
            UNLESS N < 1 DO B := V!1
            UNLESS N < 2 DO C := V!2
            !S := A << 16 LOGOR B << 8 LOGOR C
            S,V,N := S+1,V+3,N-3
         $) REPEATUNTIL N < 0
   $)

AND UNPACKSTRING(S,V) BE
   $( LET W = !S
      LET N = W >> 16
      LET J = 16
      FOR I = 0 TO N DO
         $( V!I := W >> J & #377
            TEST J = 0 THEN $( S,J := S+1,16; W := !S $)
                        OR       J := J - 8
         $)
   $)

AND WRITES(S) BE
   $( LET W = !S
      LET N = W >> 16
         $( IF N = 0 RETURN
            WRITECH(OUTPUT, W >> 8)
            IF N = 1 RETURN
            WRITECH(OUTPUT, W)
            IF N = 2 RETURN
            S,N := S+1,N-3
            W := !S
            WRITECH(OUTPUT, W >> 16)
         $) REPEAT
   $)

AND WRITEC(CH) BE WRITECH(OUTPUT,CH)

AND WRITEN(N) BE TEST N < 0 THEN $( WRITEC('-');
                                    TEST -N < 0 THEN WRITES("8388608")
                                                 OR  WRITEPN(-N)
                                 $)
                             OR                      WRITEPN( N)

AND WRITEPN(N) BE $( IF N > 9 DO WRITEPN( N/10 )
                     WRITECH(OUTPUT, N REM 10 + '0' ) $)

AND WRITEO(N,W) BE
      IF W > 0 DO
         $( WRITEO( N >> 3 , W - 1 )
            WRITECH(OUTPUT, ( N & #7 ) + '0' )
         $)

AND WRITED(N,W) BE
   $( LET V = VEC 8
      LET C = 0
      LET S = N < 0
      LET M = S -> -N , N
      IF M < 0 DO
         $( FOR I = 9 TO W DO WRITECH(OUTPUT,' ')
            WRITES("-8388608")
            RETURN
         $)
      $( C := C + 1; V!C := M REM 10 + '0'; M := M/10 $) REPEATUNTIL M = 0
      IF S DO $( C := C + 1; V!C := '-' $)
      WHILE W > C DO $( WRITECH(OUTPUT,' '); W := W - 1 $)
      $( WRITECH(OUTPUT,V!C); C := C - 1 $) REPEATUNTIL C = 0
   $)

AND WRITEF(FORMAT,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?) BE
   $( LET V = VEC 255
      AND Q = @FORMAT
      UNPACKSTRING(FORMAT,V)
      FOR P = V + 1 TO V + V!0 DO
         $( LET K = !P
            TEST K # '%' THEN WRITEC(K)
                          OR  $( LET F,N = ?,?
                                 P := P + 1
                                 SWITCHON !P INTO
                                    $( DEFAULT : WRITEC(!P);  LOOP
                                       CASE 'S': F := WRITES; ENDCASE
                                       CASE 'C': F := WRITEC; ENDCASE
                                       CASE 'N': F := WRITEN; ENDCASE
                                       CASE 'O': F := WRITEO; GOTO M
                                       CASE 'I':
                                       CASE 'D': F := WRITED;
                                    M: P := P + 1; N := !P - '0' $)
                                       Q := Q + 1; F(!Q,N)
                              $)
         $)
   $)

AND NEWLINE() BE WRITECH(OUTPUT,'*N')

LET TERMINATE() BE FINISH

//	****

