 (*$L-*)
 (************************************************************************
  *                                                                      *
  *                                                                      *
  *   PCODE_ASSEMBLER                                                    *
  *   ---------------                                                    *
  *                                                                      *
  *                                                                      *
  *   COPYRIGHT 1978, STANFORD LINEAR ACCELERATOR CENTER.                *
  *                                                                      *
  *                                                                      *
  *   THIS PROGRAM ASSEMBLES THE OUTPUT OF THE SLAC 'PASCAL'  COMPILER   *
  *   AS GENERATED BY 'WYL.CG.PAS.PASZMOD', INTO THE SO CALLED I_CODE,   *
  *   A  COMPACT  INTERPRETIVE  CODE  DESIGNED  FOR  A MICRO PROCESSOR   *
  *   ENVIRONMENT.                                                       *
  *                                                                      *
  *   THE ASSEMBLER READS IN THE 'PRR' OUTPUT OF THE  PASCAL  COMPILER   *
  *   (AS  'INPUT' , THE MAIN INPUT FILE) AND THE CALL FREQUENCY TABLE   *
  *   FILE 'QRR' (AS ITS 'PRD'     INPUT  FILE)  AND  SENDS  ITS  MAIN   *
  *   OUTPUT , AN "INTEL" LOAD FORMAT OBJECT, TO 'PRR'    OUTPUT FILE.   *
  *   OTHER  MESSAGES  AND  RELATED  STATISTICS APPEAR ON THE 'OUTPUT'   *
  *   FILE,                                                              *
  *                                                                      *
  *   IN  ADDITION,  THE  ASSEMBLER   SWITCH   'TRACE'   CAUSES   EACH   *
  *   INSTRUCTION  TO  BE  PRINTED  ON THE OUTPUT FILE, AS IT IS BEING   *
  *   PROCESSED AND THE 'DUMP' SWITCH  WILL  GENERATE  A  DECIMAL  (AS   *
  *   OPPOSED  TO  HEXADECIMAL)  VERSION  OF  THE  OBJECT  CODE.   THE   *
  *   P_INSTRUCTIONS  'TON'  AND  'TOF'  MAY  BE  USED  TO SELECTIVELY   *
  *   SET/RESET THE 'TRACE'  SWITCH,  IF  ONE  WANTS  TO  EXAMINE  THE   *
  *   TRANSLATION  OF A PART OF THE PROGRAM WITHOUT GENERATING A LARGE   *
  *   NUMBER OF OUTPUT RECORDS.                                          *
  *                                                                      *
  *   THOUGH THE OBJECT CODE IS ENTIRELY  RELOCATABLE,  THE  ASSEMBLER   *
  *   CONSTANT 'CODE_ORG' DETERMINES THE LOADING ADDRESS FOR THE CODE,   *
  *   AND  THE "PROEDURE ADDRESS TABLE" IMMEDIATELY FOLLOWS THE THE      *
  *   OBJECT CODE.                                                       *
  *   A SMALL TABLE WITH FOUR ENTRIES IS APPENDED TO THE END OF THE      *
  *   "OBJECT" FILE. THE ENTRIES OF THIS TABLE POINT TO THE ENTRY POINT  *
  *   OF THE "MAINBLK", THE BEGINING OF THE PROCEDURE ADDRESS TABLE,     *
  *   THE END OF THE PROCEDURE ADDRESS TABLE AND THE END OF THE "STAK"   *
  *   (OR THE BEGINING OF THE HEAP) OF THE SIMULATED MACHINE.            *
  *                                                                      *
  *                                                                      *
  *   THE ERROR MESSAGES  OF  THE  THIS  PROGRAM  MAY  BE  INTERPRETED   *
  *   ACCORDING TO THE FOLLOWING TABLE.                                  *
  *                                                                      *
  *                                                                      *
  *   ERROR(101 --> 'LOD' REAL OPERAND.                                  *
  *   ERROR(102 --> 'LOD' OFFSET TOO LARGE.                              *
  *   ERROR(104 --> 'STR' OFFSET TOO LARGE.                              *
  *   ERROR(105 --> STRING TOO LONG.                                     *
  *   ERROR(106 --> 'LDA' OFFSET TOO LARGE.                              *
  *   ERROR(107 --> 'IND R' REAL OPERAND.                                *
  *   ERROR(108 --> 'STR R' REAL OPERAND.                                *
  *   ERROR(110 --> 'IND ' OFFSET TOO LARGE.                             *
  *   ERROR(112 --> UNDEFINED PROC.                                      *
  *   ERROR(113 --> UNDEFINIED CSP.                                      *
  *   ERROR(114 --> 'MOV' OPERAND TOO LARGE.                             *
  *   ERROR(118 --> LABEL TOO LARGE , IN UPDATELBL.                      *
  *   ERROR(119 --> DUPLICATE LABEL DEF.                                 *
  *   ERROR(122 --> MULTIPLE DEFS.                                       *
  *   ERROR(123 --> SET TYPE PROCEDURE.                                  *
  *   ERROR(124 --> REAL TYPE PROCEDURE.                                 *
  *   ERROR(125 --> INCORRECT VARIABLE ALIGNMENT (ODD DISPLACEMENT).     *
  *   ERROR(127 --> PROCEDURE NEST LEVEL TOO DEEP.                       *
  *   ERROR(128 --> BAD CODE 'BYTE' DETECTED WHILE OUTPUTING OBJECT.     *
  *   ERROR(130 --> COMPARE REAL OPERANDS.                               *
  *   ERROR(135 --> NEGATIVE CONST.                                      *
  *   ERROR(140 --> 'LDC R' REAL OPERAND.                                *
  *   ERROR(141 --> 'CHK' INSTR.                                         *
  *   ERROR(144 --> '''' IN STRING.                                      *
  *   ERROR(146 --> 'NEW' OPERAND TOO LARGE.                             *
  *   ERROR(152 --> INSTRUCTION NOT YET IMPLEMENTED.                     *
  *   ERROR(154 --> REAL ARITHMETIC INSTRUCTIONS.                        *
  *   ERROR(160 --> UNDEFINED/ILLEGAL OPCODE.                            *
  *                                                                      *
  *                                                                      *
  *                                                                      *
  *                                                                      *
  *                                                                      *
  *                                                                      *
  *                           SASSAN HAZEGHI                             *
  *                                                                      *
  *                           COMPUTATION RESEARCH GROUP                 *
  *                           STANFORD LINEAR ACCELERATOR CENTER         *
  *                           STANFORD, CA. 94305.                       *
  *                                                                      *
  *                                                                      *
  *                                                                      *
  *                           UPDATED :    15-JAN-78                     *
  *                                         3-FEB-78                     *
  *                                        12-MAY-78                     *
  *                                                                      *
  *                                                                      *
  ************************************************************************)



PROGRAM PCODE_ASSEMBLER;


(*----------------------------------------------------------------------------*)


CONST
       CODE_ORG    = 3584 ;   (* LOADING ADR. FOR CODE  / AS IN INTERPRETER *)
       FIX_AREA    = 8 ;      (* SIZE OF THE TABLE PRECEDDING CODE *)
       STK_LEN     = 4096 ;   (* ESTIMATED SIZE OF RUNTIME STACK *)
       HEAP_END    = 31232 ;  (* END OF HEAP RELATIVE TO PCODE_ORG *)
       LNKAREA     = 8 ;      (* SIZE OF PROC. LINKAGE AREA *)
       ICMAX       = 4000;    (* PROCEDURE SIZE LIMIT *)
       LARGEINT    = 32767 ;  (* = 2**15 -1 *)
       MAXINT      = 32768 ;  (* = 2**15 -1 *)
       MAXADR      = MAXINT ;
       MAXSLEN     = 20 ;
       MAXPROC     = 99 ;
       MINPROC     = 0 ;
       MINLBL      = 0 ;
       MAXLBL      = 220 ;
       SPCNT       =  30 ;   (* COUNT OF STANDARD PROCS *)
       PTRSIZE     = 2 ;     (* HAS TO BE UPDATED FOR DIFFERENT DATA SIZES*)
       FUNCRSLT    = 0 ;     (* LOCATION (OFF MP) OF THE FUNC RESULT *)
       GLOBAL      = 0 ;     (* GLOBAL LEVEL*)
       BLNK3       = '   ' ;  BLNK8 = '        ' ;
       ABS         = 32 ;     (* CURRENT VALUE OF THE ASCII BIASS *)

       (* P-CODE INSTRUCTION MNEMONICS *)
       "
       PABI =  0 ;   PABR =  1 ;   PADI =  2 ;   PADR =  3 ;
       PAND =  4 ;   PCHK =  5 ;   PCHR =  6 ;   PCSP =  7 ;
       PCUP =  8 ;   PDEC =  9 ;   PDEF = 10 ;   PDIF = 11 ;
       PDVI = 12 ;   PDVR = 13 ;   PENT = 14 ;   PEOF = 15 ;
       PEQU = 16 ;   PFJP = 17 ;   PFLO = 18 ;   PFLT = 19 ;
       PGEQ = 20 ;   PGRT = 21 ;   PINC = 22 ;   PIND = 23 ;
       PINN = 24 ;   PINT = 25 ;   PIOR = 26 ;   PIXA = 27 ;
       PLAO = 28 ;   PLCA = 29 ;   PLDA = 30 ;   PLDC = 31 ;
       PLDO = 32 ;   PLEQ = 33 ;   PLES = 34 ;   PLOC = 35 ;
       PLOD = 36 ;   PMOD = 37 ;   PMOV = 38 ;   PMPI = 39 ;
       PMPR = 40 ;   PMST = 41 ;   PNEQ = 42 ;   PNEW = 43 ;
       PNGI = 44 ;   PNGR = 45 ;   PNOT = 46 ;   PODD = 47 ;
       PORD = 48 ;   PPRE = 49 ;   PRET = 50 ;   PRST = 51 ;
       PSAV = 52 ;   PSBI = 53 ;   PSBR = 54 ;   PSGS = 55 ;
       PSQI = 56 ;   PSQR = 57 ;   PSRO = 58 ;   PSTO = 59 ;
       PLSA = 60 ;   PSTR = 61 ;   PUJP = 62 ;   PXJP = 63 ;
       PTON = 64 ;   PTRC = 65 ;   PSUC = 66 ;   PUNI = 67 ;
       PTOF = 68 ;   PLCI = 69 ;   PSTP = 70 ;   PBGN = 71 ;
       PNOP = 72 ; "

       QGET =  1 ;  QPUT =  2 ;  QRES =  3 ;  QREW =  4 ;
       QRDC =  5 ;  QWRI =  6 ;  QWRO =  7 ;  QWRR =  8 ;
       QWRC =  9 ;  QWRS = 10 ;  QPAK = 11 ;  QRDB = 12 ;
       QWRB = 13 ;  QRDR = 14 ;  QSIN = 15 ;  QCOS = 16 ;
       QEXP = 17 ;  QSQT = 18 ;  QLOG = 19 ;  QATN = 20 ;
       QCLK = 21 ;  QWLN = 22 ;  QRLN = 23 ;  QRDI = 24 ;
       QEOF = 25 ;  QELN = 26 ;  QRDS = 27 ;  QTRP = 28 ;
       QXIT = 29 ;  QEIO = 30 ;  QNOP = 24 ;

       PABI =  0 ;  PABR =  1 ;  PADI =  2 ;  PADR =  3 ;
       PAND =  4 ;  PDIF =  5 ;  PDVI =  6 ;  PDVR =  7 ;
       PSBR =  8 ;  PFLO =  9 ;  PFLT = 10 ;  PINN = 11 ;
       PINT = 12 ;  PIOR = 13 ;  PMOD = 14 ;  PMPI = 15 ;
       PMPR = 16 ;  PNGI = 17 ;  PNGR = 18 ;  PNOT = 19 ;
       PODD = 20 ;  PSBI = 21 ;  PDEC = 22 ;  PINC = 23 ;
       PSQI = 24 ;  PSQR = 25 ;  PSTO = 26 ;  PTRC = 27 ;
       PUNI = 28 ;  PSGS = 29 ;  PCSP = 30 ;  PLOC = 31 ;
       PENT = 32 ;  PFJP = 33 ;  PUJP = 34 ;  PIND = 35 ;
       PIXA = 36 ;  PLSA = 37 ;  PLCA = 38 ;  PTON = 39 ;
       PMOV = 40 ;  PMST = 41 ;  PRET = 42 ;  PSTP = 43 ;
       PXJP = 44 ;  PCHK = 45 ;  PCUP = 46 ;  PEQU = 47 ;
       PGEQ = 48 ;  PGRT = 49 ;  PLDA = 50 ;  PLDC = 51 ;
       PLEQ = 52 ;  PLES = 53 ;  PLOD = 54 ;  PNEQ = 55 ;
       PSTR = 56 ;  PTOF = 57 ;  PNEW = 58 ;  PSAV = 59 ;
       PRST = 60 ;  PORD = 61 ;  PCHR = 62 ;  PDEF = 63 ;
       PNOP = 64 ;

       (* Z- OPCODES MNEMONICS          *)

       ZLDC1   =   0 ;
       ZLDC2   =  32 ;
       ZLDC    =  33 ;
       ZLDC8   =  34 ;
       ZLODG2  =  35 ;
       ZLOD    =  36 ;
       ZLOD8   =  37 ;
       ZREAL   =  38 ;
       ZSTP    =  39 ;
       ZCUP    =  40 ;
       ZCSP    =  41 ;
       ZIND    =  42 ;
       ZINDS   =  43 ;
       ZLDALG  =  44 ;
    "  ZLDAL   =  45 ;  "
       ZIXA    =  46 ;
       ZSPWRP  =  47 ;
       ZSTRLG  =  48 ;
       ZSTR    =  49 ;
       ZSTRS   =  50 ;
       ZMVP    =  51 ;
       ZADIC   =  52 ;
       ZLDA    =  53 ;
       ZLCA    =  54 ;
       ZXJP    =  55 ;
       ZCMPM   =  56 ;
       ZEQU    =  57 ;
       ZNEQ    =  58 ;
       ZLEQ    =  59 ;
       ZLES    =  60 ;
       ZGEQ    =  61 ;
       ZGRT    =  62 ;
       ZCMPRS  =  63 ;  (* UNUSED OPCODE, TRANSLATES TO ZCMPM *)
       ZMSTF8  =  64 ;
       ZMOV    =  65 ;
       ZMST    =  66 ;
       ZRET    =  67 ;
       ZSTO    =  68 ;
       ZSTOS   =  69 ;
       ZRETF8  =  70 ;
       ZORD    =  71 ;
       ZCHR    =  72 ;
       ZADI    =  73 ;
       ZSBI    =  74 ;
       ZDVI    =  75 ;
       ZMOD    =  76 ;
       ZMPI    =  77 ;
       ZNGI    =  78 ;
       ZRST    =  79 ;
    "  ZSAV    =  80 ; "
       ZDEC1   =  80 ;
       ZODD    =  81 ;
      "ZFLT    =  82 ;"
      "ZFLO    =  83 ;"
       ZABI    =  84 ;
       ZSGS    =  85 ;
       ZINN    =  86 ;
       ZUNI    =  87 ;
       ZINT    =  88 ;
       ZDIF    =  89 ;
       ZNEW    =  90 ;
       ZAND    =  91 ;
       ZIOR    =  92 ;
       ZNOT    =  93 ;
       ZMSTF   =  94 ;
       ZRETF   =  95 ;
       ZCUP1   =  96 ;
       ZCSP1   = 112 ;
       ZFJP    = 128 ;
       ZUJP    = 144 ;
       ZIND1   = 160 ;
       ZIXA1   = 176 ;
       ZLODG   = 192 ;

       ZABR    =   0 ;
       ZNGR    =   1 ;
       ZFLT    =   2 ;
       ZFLO    =   3 ;
       ZTRC    =   4 ;
       ZRND    =   5 ;
       ZADR    = 225 ;
       ZSBR    = 226 ;
       ZMPR    = 227 ;
       ZDVR    = 228 ;
       ZLODL   = 224 ;

       ZENT    = 254 ;             (* NON EXISTING OPCODE *)


       OPCNT = 64 ;                (* COUNT OF P_INSTRUCTIONS *)
       ZOPCNT=255 ;

       UNDEF = 0 ;  INT = 1 ;  REEL = 2 ;  BOOL = 3 ;
       SETT  = 4 ;  ADR = 5 ;  MARK = 6 ;  INDEX= 7 ;

(*----------------------------------------------------------------------------*)

TYPE
      BYTE         = 0..255 ;
      DATATYPE     = UNDEF..INDEX;
      LBLRNG       = MINLBL..MAXLBL ;
      ICRNG        = 0..ICMAX ;
      ADRRNG       = 0..MAXADR ;
      ALFA         = PACKED ARRAY [1..8] OF CHAR ;
      SHRTALFA     = PACKED ARRAY [1..3] OF CHAR ;
      BETA         = PACKED ARRAY[1..20] OF CHAR; (*ERROR MESSAGE*)
      COUNTER      = 0..MAXINT ;
      LABELST      = (ENTERED,DEFINED);  (* LABEL SITUATION *)
      PROCRNG      = 0..MAXPROC ;

      LABELREC     = RECORD
         VAL: 0..MAXADR   ;
         ST:  LABELST
         END ;

      TEXT         = FILE OF CHAR ;

(*----------------------------------------------------------------------------*)
VAR
     (* INSTRUCTION REGISTER *)
     OP            : -1..OPCNT ;
     IC, PC        : ICRNG  ;        (*PROGRAM ADDRESS REGISTER*)
     P,CURLVL      : 0..32;
     Q             : INTEGER;
     T             : DATATYPE ;

     GIC, GPC      : 0..MAXADR;
     PACKSTRNG     : BOOLEAN;         (*PACK THE STRING*)
     LEVEL         : 0..7 ;           (* LEVEL OF CURRENT PROC *)
     GENCODE,
     TRACE, DUMP   : BOOLEAN ;        (* TRACE OPTION FLAGS *)
     TIMER         : INTEGER ;        (* TIMER FOR LOADING/EXECUTION *)
     ERRCNT        : INTEGER ;        (* COUNT OF ASSEMBLY ERROR *)
     NEEDOPNDS     : SET OF 0..63 ;   (* OPCODES THAT HAVE OPERANDS *)
   " NAME          : SHRTALFA ; "     (* SYMBOLIC OPCODE OF CUR INSTR. *)
     LCALEN        : ADRRNG ;         (* TOTAL LEN OF 'LCA' INST *)
     OLDIC         : ICRNG   ;
     CODE          : ARRAY[ICRNG] OF 0..4096 ;
     ZCNV          : ARRAY [PABI..PNOP] OF BYTE ;  (* P TO Z CONVERSION *)
     INSTR         : ARRAY[0..OPCNT] OF SHRTALFA;  (* MNEMONIC INST. CODES *)
     SPTABLE       : ARRAY[0..SPCNT] OF SHRTALFA;  (* STANDARD FNS AND PROCS *)
     SPCODE        : ARRAY[0..SPCNT] OF 0..SPCNT ; (* INTERNAL CODE FOR SP'S *)
    "IVECTOR       : ARRAY['A'..'Z'] OF BYTE ;"
    "HEX           : ARRAY [0..15] OF CHAR ;"

    "ASCII         : ARRAY[CHAR] OF 32..95 ;"
     CMPOP         : ARRAY [PEQU..PNEQ] OF 0..5 ;
     PROC_CNT      : PROCRNG ;
     CALL_CNT      : ARRAY [PROCRNG] OF 0..1000 ;
     PROC_ID       : ARRAY [PROCRNG] OF ARRAY[1..7] OF CHAR ;
     PROC_INX      : ARRAY [PROCRNG] OF BYTE ;
     PROC_ADR      : ARRAY [PROCRNG] OF ADRRNG ;
     PROC_DATA     : ARRAY [PROCRNG] OF ADRRNG ;
     ZCNT          : ARRAY [BYTE] OF COUNTER ;
     ZLEN          : ARRAY [BYTE] OF 0..32 ;
"    PFILE         : TEXT ;                 (* P_CODE INPUT FILE *)

     PROCFILE      : TEXT ;

     ZFILE         : TEXT ;                 (* 'INTEL' FORMAT OBJECT FILE *)

     SYMFILE       : TEXT ;   "             (* SYMBOL TABLE FILE FOR SIM80 *)


(*----------------------------------------------------------------------------*)

PROCEDURE LOAD;
   VAR
        CH          :  CHAR ;
        I, J, K, L  :  INTEGER ;
      " NXTPROC," CURPROC  : MINPROC..MAXPROC ;
        LABELVALUE: ICRNG ;
        LABELTAB      : ARRAY [LBLRNG] OF LABELREC ;

   PROCEDURE INIT ;
      VAR I, J, K  : INTEGER;
   BEGIN INSTR[PABI]:='ABI'; INSTR[PABR]:='ABR';
         INSTR[PADI]:='ADI'; INSTR[PADR]:='ADR';
         INSTR[PAND]:='AND'; INSTR[PCHK]:='CHK';
         INSTR[PCHR]:='CHR'; INSTR[PCSP]:='CSP';
         INSTR[PCUP]:='CUP'; INSTR[PDEC]:='DEC';
         INSTR[PDEF]:='DEF'; INSTR[PDIF]:='DIF';
         INSTR[PDVI]:='DVI'; INSTR[PDVR]:='DVR';
         INSTR[PENT]:='ENT';"INSTR[PEOF]:='EOF';"
         INSTR[PEQU]:='EQU'; INSTR[PFJP]:='FJP';
         INSTR[PFLO]:='FLO'; INSTR[PFLT]:='FLT';
         INSTR[PGEQ]:='GEQ'; INSTR[PGRT]:='GRT';
         INSTR[PINC]:='INC'; INSTR[PIND]:='IND';
         INSTR[PINN]:='INN'; INSTR[PINT]:='INT';
         INSTR[PIOR]:='IOR'; INSTR[PIXA]:='IXA';
        "INSTR[PLAO]:='LAO';"INSTR[PLCA]:='LCA';
         INSTR[PLDA]:='LDA'; INSTR[PLDC]:='LDC';
        "INSTR[PLDO]:='LDO';"INSTR[PLEQ]:='LEQ';
         INSTR[PLES]:='LES'; INSTR[PLOC]:='LOC';
         INSTR[PLOD]:='LOD'; INSTR[PMOD]:='MOD';
         INSTR[PMOV]:='MOV'; INSTR[PMPI]:='MPI';
         INSTR[PMPR]:='MPR'; INSTR[PMST]:='MST';
         INSTR[PNEQ]:='NEQ'; INSTR[PNEW]:='NEW';
         INSTR[PNGI]:='NGI'; INSTR[PNGR]:='NGR';
         INSTR[PNOT]:='NOT'; INSTR[PODD]:='ODD';
         INSTR[PORD]:='ORD';"INSTR[PPRE]:='PRE';"
         INSTR[PRET]:='RET'; INSTR[PRST]:='RST';
         INSTR[PSAV]:='SAV'; INSTR[PSBI]:='SBI';
         INSTR[PSBR]:='SBR'; INSTR[PSGS]:='SGS';
         INSTR[PSQI]:='SQI'; INSTR[PSQR]:='SQR';
        "INSTR[PSRO]:='SRO';"INSTR[PSTO]:='STO';
         INSTR[PSTP]:='STP'; INSTR[PSTR]:='STR';
        "INSTR[PSUC]:='SUC';"INSTR[PTOF]:='TOF';
         INSTR[PTON]:='TON'; INSTR[PTRC]:='TRC';
         INSTR[PUJP]:='UJP'; INSTR[PUNI]:='UNI';
         INSTR[PXJP]:='XJP';"INSTR[PLCI]:='...';"
        "INSTR[PBGN]:='BGN';"INSTR[PLSA]:='LSA';

         SPTABLE[ 0]:='GET';  SPTABLE[ 1]:='PUT';
         SPTABLE[ 2]:='RLN';  SPTABLE[ 3]:='WLN';
         SPTABLE[ 4]:='RDC';  SPTABLE[ 5]:='WRC';
         SPTABLE[ 6]:='RDS';  SPTABLE[ 7]:='WRS';
         SPTABLE[ 8]:='RDI';  SPTABLE[ 9]:='WRI';
         SPTABLE[10]:='EOF';  SPTABLE[11]:='ELN';
         SPTABLE[12]:='EIO';  SPTABLE[13]:='XIT';
         SPTABLE[14]:='RES';  SPTABLE[15]:='REW';
         SPTABLE[16]:='SIN';  SPTABLE[17]:='COS';
         SPTABLE[18]:='EXP';  SPTABLE[19]:='LOG';
         SPTABLE[20]:='SQT';  SPTABLE[21]:='ATN';
        "SPTABLE[22]:='WRP';" SPTABLE[23]:='CLK';
         SPTABLE[24]:='NOP';

         SPCODE[QGET]:=  0 ;  SPCODE[QPUT]:=  1 ;
         SPCODE[QRLN]:=  2 ;  SPCODE[QWLN]:=  3 ;
         SPCODE[QRDC]:=  4 ;  SPCODE[QWRC]:=  5 ;
         SPCODE[QRDS]:=  6 ;  SPCODE[QWRS]:=  7 ;
         SPCODE[QRDI]:=  8 ;  SPCODE[QWRI]:=  9 ;
         SPCODE[QEOF]:= 10 ;  SPCODE[QELN]:= 11 ;
         SPCODE[QEIO]:= 12 ;  SPCODE[QXIT]:= 13 ;
         SPCODE[QRES]:= 14 ;  SPCODE[QREW]:= 15 ;
         SPCODE[QSIN]:= 16 ;  SPCODE[QCOS]:= 17 ;
         SPCODE[QEXP]:= 18 ;  SPCODE[QLOG]:= 19 ;
         SPCODE[QSQT]:= 20 ;  SPCODE[QATN]:= 21 ;
        "SPCODE[QWRP]:= 22 ;" SPCODE[QCLK]:= 23 ;
         SPCODE[QRDR]:= 24 ;  SPCODE[QWRR]:= 24 ;
         SPCODE[QRDB]:= 24 ;  SPCODE[QWRB]:= 24 ;
         SPCODE[QTRP]:= 24 ;  SPCODE[QPAK]:= 24 ;
         SPCODE[QWRO]:= 24 ;


       " FOR CH := 'A' TO 'Z' DO IVECTOR[CH] := 0 ;

         IVECTOR['A'] := PABI ;  IVECTOR['C'] := PCHK ;
         IVECTOR['D'] := PDEC ;  IVECTOR['E'] := PENT ;
         IVECTOR['F'] := PFJP ;  IVECTOR['G'] := PGEQ ;
         IVECTOR['I'] := PINC ;  IVECTOR['L'] := PLAO ;
         IVECTOR['M'] := PMOD ;  IVECTOR['N'] := PNEQ ;
         IVECTOR['O'] := PODD ;  IVECTOR['P'] := PPRE ;
         IVECTOR['R'] := PRET ;  IVECTOR['S'] 2= PSAV ;
         IVECTOR['T'] := PTON ;  IVECTOR['U'] :5 PUJP 3         AVECTOR['X'] :5 PXBP ;                         "
         (* P-CODE TG Z-CODE TRANSLATION TABLE *)

      "  ZCNV[PORD] := ZORD ;
         ZCNV[PCHR] := ZCHR ;  "
         ZCNV[PABI] := ZABI ;
         ZCNV[PADI] := ZADI ;
         ZCNV[PSBI] := ZSBI ;
         ZCNV[PMPI] := ZMPI ;
         ZCNV[PDVI] := ZDVI ;
         ZCNV[PMOD] := ZMOD ;
      "  ZCNV[PSQI] := ZSQI ;  "
         ZCNV[PNGI] := ZNGI ;
         ZCNV[PODD] := ZODD ;
         ZCNV[PRST] := ZRST ;
      "  ZCNV[PSAV] := ZSAV ;  "
         ZCNV[PAND] := ZAND ;
         ZCNV[PIOR] := ZIOR ;
         ZCNV[PNOT] := ZNOT ;
         ZCNV[PSGS] := ZSGS ;
         ZCNV[PINN] := ZINN ;
         ZCNV[PINT] := ZINT ;
         ZCNV[PUNI] := ZUNI ;
         ZCNV[PDIF] := ZDIF ;

         ZCNV[PADR] := ZADR ;
         ZCNV[PSBR] := ZSBR ;
         ZCNV[PMPR] := ZMPR ;
         ZCNV[PDVR] := ZDVR ;
         ZCNV[PABR] := ZABR ;
         ZCNV[PNGR] := ZNGR ;
        "ZCNV[PRND] := ZRND ;"
         ZCNV[PFLO] := ZFLO ;
         ZCNV[PFLT] := ZFLT ;
         ZCNV[PTRC] := ZTRC ;

         NEEDOPNDS := [PCHK,PCSP,PCUP,PDEC,PENT,PEQU,PFJP,PGEQ,PGRT,PINC,PIND,
                       PIXA,PLCA,PLDA,PLDC,PLEQ,PLES,PLOC,PLOD,PLSA,
                       PMOV,PMST,PNEQ,PNEW,PRET,PSTO,PSTR,PUJP,PXJP] ;
        "NAME := BLNK3 ;"  LCALEN := 0 ;

         PROC_CNT := MINPROC ;

     "   RESET(PRD) ;  "
         WHILE NOT EOF(PRD) DO
           BEGIN
           READLN(PRD,"PROC_ID[PROC_CNT]," CALL_CNT[PROC_CNT]) ;
           PROC_CNT := PROC_CNT+1 ;
           END ;

         (* NOTE THAT CALL_CNT[0] = 0 . I.E NO CALL TO $MAINBLOC *)

         PROC_INX[MINPROC] := PROC_CNT ;  CALL_CNT[PROC_CNT] := 0 ;
         FOR I := MINPROC TO PROC_CNT-1 DO
           BEGIN
           J := CALL_CNT[I] ;   K := MINPROC-1 ;

           REPEAT  K := K+1  UNTIL  CALL_CNT[PROC_INX[K]] <= J ;

           FOR J := I  DOWNTO K DO
             PROC_INX[J+1] := PROC_INX[J] ;

           PROC_INX[K] := I ;
           END (* FOR I := ... *) ;

         PROC_CNT := PROC_CNT-1 ;

       " FOR I := MINPROC TO PROC_CNT DO       (* PRINT PROC TABLE *)
           WRITELN(OUTPUT, I, PROC_INX[I], CALL_CNT[ PROC_INX[I] ]) ;

         WRITELN(OUTPUT) ;  WRITELN(OUTPUT) ;  "


(*       FOR CH := '0' TO '9' DO  ASCII[CH] := (ORD(CH)-ORD('0'))+48 ;

         FOR CH := 'A' TO 'Z' DO  ASCII[CH] := ORD(CH)-ORD('A')+64+1 ;


         ASCII[' ']  := 32 ;
         ASCII['!']  := 33 ;
         ASCII['"']  := 34 ;
         ASCII['#']  := 35 ;
         ASCII['$']  := 36 ;
         ASCII['%']  := 37 ;
         ASCII['&']  := 38 ;
         ASCII[''''] := 39 ;
         ASCII['(']  := 40 ;
         ASCII[')']  := 41 ;
         ASCII['*']  := 42 ;
         ASCII['+']  := 43 ;
         ASCII[',']  := 44 ;
         ASCII['-']  := 45 ;
         ASCII['.']  := 46 ;
         ASCII['/']  := 47 ;
         ASCII[':']  := 58 ;
         ASCII[';']  := 59 ;
         ASCII['<']  := 60 ;
         ASCII['=']  := 61 ;
         ASCII['>']  := 62 ;
         ASCII['?']  := 63 ;
         ASCII['@']  := 64 ;
         ASCII['[']  := 91 ;
         ASCII['|']  := 92 ;
         ASCII[']']  := 93 ;
         ASCII['~']  := 94 ;
         ASCII['_']  := 95 ;   *)


"        FOR I := 0 TO 9 DO  HEX[I] := CHR(I+ORD('0') ) ;     "

"        FOR I := 10 TO 15 DO  HEX[I] := CHR( I+ORD('A')-10 ) ;  "

         FOR I:= MINLBL TO MAXLBL DO
             WITH LABELTAB[I] DO BEGIN VAL:= 0; ST:= ENTERED END;

         FOR I := 0 TO ZOPCNT DO   ZCNT[I] := 0 ;

         CMPOP[PEQU] := 0 ;    CMPOP[PNEQ] := 1 ;  CMPOP[PLEQ] := 2 ;
         CMPOP[PLES] := 3 ;    CMPOP[PGEQ] := 4 ;  CMPOP[PGRT] := 5 ;
         IC := 0 ; " OLDIC := 0 ;"  GIC := 0 ;  LEVEL := 1 ;
         PC := 0 ;   GPC := 0 ;   PACKSTRNG := FALSE ;
         ERRCNT := 0 ;  TRACE:= FALSE;  DUMP := FALSE ;   GENCODE := TRUE ;
      (* IF GENCODE THEN  REWRITE(PRR) ;  *)

   END (*INIT*) ;
(*----------------------------------------------------------------------------*)
PROCEDURE ERROR(EC : BYTE) ;

   BEGIN   WRITELN( OUTPUT ) ;
   WRITELN(OUTPUT, ' ****  I_ERROR :' , EC:6,' NEAR:', PC:5,
                   PROC_ID[CURPROC]:9) ;
   ERRCNT := ERRCNT+1 ;
   END (*ERROR*) ;


"  PROCEDURE ERRORL(STRING: BETA); (*ERROR IN LOADING*)
   BEGIN WRITELN() ;
         WRITELN('****  ':12, STRING); EXIT(1001) (* TO END PROGRAM PCODE*)
   END; (*ERRORL*) "
(*----------------------------------------------------------------------------*)

   PROCEDURE UPDATELBL(X: LBLRNG); (*WHEN A LABEL DEFINITION LX IS FOUND*)
      VAR CURR,SUCC: ICRNG  ; (*RESP. CURRENT ELEMENT AND SUCCESSOR ELEMENT
                                      OF A LIST OF FUTURE REFERENCE*)
          ENDLIST: BOOLEAN;
   BEGIN
      IF X > MAXLBL THEN  ERROR(118 (* LABEL TO LARGE , IN UPDATELBL *) )
      ELSE
         IF LABELTAB[X].ST=DEFINED THEN
            BEGIN  WRITELN(OUTPUT,X) ; ERROR(119 (* DUPLICATE LABEL DEF *) ) END
         ELSE BEGIN
                IF LABELTAB[X].VAL <> 0 THEN (*FORWARD REFERENCE(S)*)
                BEGIN CURR:= LABELTAB[X].VAL; ENDLIST:= FALSE;
                   REPEAT
                           SUCC := CODE[CURR] ;
                           CODE[CURR] := LABELVALUE MOD 256 ;
                           CODE[CURR-1] := LABELVALUE DIV 256 + CODE[CURR-1] ;
                           IF SUCC = 0 THEN ENDLIST:= TRUE
                                       ELSE CURR:= SUCC
                   UNTIL ENDLIST ;
                END;
                LABELTAB[X].ST:= DEFINED;
                LABELTAB[X].VAL:= LABELVALUE;
             END  ;
   END;(*UPDATE*)
(*----------------------------------------------------------------------------*)


"  PROCEDURE DUMP ;
   VAR I: INTEGER ;
   BEGIN
      FOR I := 0 TO IC-1  DO
         WITH CODE [I] DO
         BEGIN
            WRITELN(OUTPUT,I:6,OP1 MOD 256 :5,INSTR[OP1 MOD 256]:5,
                     OP1 DIV (65536):6,(OP1 DIV 256) MOD 256:4,Q1:10) ;
         END
   END  (* DUMP *) ;   "
(*----------------------------------------------------------------------------*)

   PROCEDURE ASSEMBLE; FORWARD;
(*----------------------------------------------------------------------------*)

   PROCEDURE GENERATE;(*GENERATE SEGMENT OF CODE*)
      VAR X: INTEGER; (* LABEL NUMBER *)
(*----------------------------------------------------------------------------*)

 """  PROCEDURE OUTPUT_CODE ;
         (* TO GENERATE INTEL LOAD FORMAT OBJECT *)

         VAR I : ICRNG ;
             J, K, CSUM : INTEGER ;
             OBJLINE    : ARRAY[1..80] OF CHAR ;

         BEGIN
         WRITELN(OUTPUT) ;
         WRITELN(OUTPUT,' **** PROC:  ':14, PROC_ID[CURPROC],
                        '  DATA AREA:',PROC_DATA[CURPROC]:6, '  PCNT, T: ',
                        PC:6, GPC+PC-1:6, '  SIZE, T:', IC:5, GIC+IC:6) ;
       (* WRITELN(OUTPUT) ; *)

         IF DUMP THEN
            BEGIN
            FOR I := 0 TO IC-1 DO
               BEGIN
               IF (I MOD 16) = 0 THEN
                  BEGIN  WRITELN(OUTPUT) ;  WRITE(OUTPUT,I:6,':') ;  END ;
               WRITE(CODE[I]:4)
               END ;
            WRITELN(OUTPUT) ;
            WRITELN(OUTPUT, '1') ;
            END ;

            (* OUTPUT THE 'OBJECT' FOR THE CURRENT PROC *)
            IF GENCODE THEN
               BEGIN (*  WRITELN(PRR, '****  ', PROC_ID[CURPROC]) ; *)
               OBJLINE[1] := ':' ;
               OBJLINE[2] := HEX[2] ;  OBJLINE[3] := HEX[0] ; (* LENGTH = 32 *)
               OBJLINE[8] := HEX[0] ;  OBJLINE[9] := HEX[0] ;   (* TYPE *)
               (*  APPEND THE NAME OF THIS PROC TO THE OBJECT CODE LINE *)
               FOR I := 1 TO 5 DO  OBJLINE[I+75] :=  ' ' (*PROC_ID[CURPROC,I]*);
               J := 74 ;

               FOR I := 0 TO IC-1 DO
                  BEGIN
                  IF J >= 74 THEN     (* LINE FULL *)
                     BEGIN    K := CODE_ORG + FIX_AREA  + GIC + I ;
                     CSUM := (K DIV 256)+ (K MOD 256) ;
                     OBJLINE[4] := HEX[K DIV 4096] ;   K := K MOD 4096 ;
                     OBJLINE[5] := HEX[K DIV 256 ] ;   K := K MOD 256  ;
                     OBJLINE[6] := HEX[K DIV 16  ] ;
                     OBJLINE[7] := HEX[K MOD 16  ] ;
                     J := 10 ;
                     END ;

                  IF (CODE[I] < 0) OR (CODE[I] > 255) THEN
                     ERROR(128 (* BAD CODE BYTE DETECTED *) ) ;

                  OBJLINE[J] := HEX[CODE[I] DIV 16] ;
                  OBJLINE[J+1] := HEX[ CODE[I] MOD 16 ] ;
                  CSUM := CSUM+CODE[I] ;   J := J+2 ;

                  IF J >= 74 THEN     (* OUTPUT THE FULL LINE BUFFER *)
                     BEGIN
                     CSUM := 256-((CSUM+32) MOD 256) ; (* ADD LEN TO CHECKSUM *)
                     OBJLINE[74] := HEX[ (CSUM MOD 256) DIV 16 ] ;
                     OBJLINE[75] := HEX[CSUM MOD 16] ;
                     WRITELN(PRR, OBJLINE) ;
                     END ;

                  END (* FOR I := 0... *) ;

               IF J < 74 THEN  (* FLUSH THE PARTIAL LINE *)
                  BEGIN   K := (J-10) DIV 2 ;
                  OBJLINE[2] := HEX[K DIV 16] ;  OBJLINE[3] := HEX[K MOD 16] ;
                  CSUM := 256-((CSUM+K) MOD 256) ;
                  OBJLINE[J] := HEX[ (CSUM MOD 256) DIV 16 ] ;
                  OBJLINE[J+1] := HEX[CSUM MOD 16] ;
                  FOR J := J+2 TO 75 DO  OBJLINE[J] := ' ' ;

                  WRITELN(PRR, OBJLINE) ;

                  END ;

               GIC := GIC+IC ;         (* GLOBAL LOCATION COUNT *)

               (* IF $MAINBLK, OUTPUT SEGMENT TABLE *)
               IF LEVEL = 0 THEN
                  BEGIN  (*WRITELN(PRR, '****  $STBL') ; *)
                  (* RESET LENGTH TO 32 *)
                  OBJLINE[2] := HEX[2] ;  OBJLINE[3] := HEX[0] ;
              (*  OBJLINE[76] := '$' ;*) (* APPEND LINE IDENTIFICATION *)
                  OBJLINE[77] := 'S' ;
                  OBJLINE[78] := 'T' ;
                  OBJLINE[79] := 'B' ;
                  OBJLINE[80] := 'L' ;    *)

                  IF ODD(GIC) THEN GIC := GIC+1 ;
                  J := 74 ;

                  FOR I := MINPROC TO PROC_CNT DO
                     BEGIN
                     IF J >= 74 THEN     (* LINE FULL *)
                        BEGIN   K := (I+I) + GIC + CODE_ORG + FIX_AREA ;
                        CSUM := (K DIV 256)+ (K MOD 256) ;
                        OBJLINE[4] := HEX[K DIV 4096] ;   K := K MOD 4096 ;
                        OBJLINE[5] := HEX[K DIV 256 ] ;   K := K MOD 256  ;
                        OBJLINE[6] := HEX[K DIV 16  ] ;
                        OBJLINE[7] := HEX[K MOD 16  ] ;
                        J := 10 ;
                        END ;

                     L := PROC_ADR[ PROC_INX[I] ]  + FIX_AREA ;
                     K := L DIV 256 ;
                     OBJLINE[J+2] := HEX[K DIV 16] ;
                     OBJLINE[J+3] := HEX[ K MOD 16 ] ;
                     CSUM := CSUM+K ;

                     K := L MOD 256 ;
                     OBJLINE[J  ] := HEX[K DIV 16] ;
                     OBJLINE[J+1] := HEX[ K MOD 16 ] ;
                     CSUM := CSUM+K ;   J := J+4 ;

                     IF J >= 74 THEN     (* OUTPUT THE FULL LINE BUFFER *)
                        BEGIN
                        CSUM := 256-((CSUM+32) MOD 256) ; (* ADD LEN TO CSUM *)
                        OBJLINE[74] := HEX[ (CSUM MOD 256) DIV 16 ] ;
                        OBJLINE[75] := HEX[CSUM MOD 16] ;
                        WRITELN(PRR, OBJLINE) ;
                        END ;

                     END (* FOR I := MINPROC TO PROC_CNT *) ;

                  IF J < 74 THEN  (* FLUSH THE PARTIAL LINE *)
                     BEGIN   K := (J-10) DIV 2 ;
                     OBJLINE[2] := HEX[K DIV 16] ; OBJLINE[3] := HEX[K MOD 16] ;
                     CSUM := 256-((CSUM+K) MOD 256) ;
                     OBJLINE[J] := HEX[ (CSUM MOD 256) DIV 16 ] ;
                     OBJLINE[J+1] := HEX[ CSUM MOD 16 ] ;
                     FOR J := J+2 TO 75 DO  OBJLINE[J] := ' ' ;

                     WRITELN(PRR, OBJLINE) ;

                     END ;

                  (* OUTPUT ENTRY POINT ADDRESS *)
                  OBJLINE[2] := HEX[0] ;  OBJLINE[3] := HEX[8] ; (* LENGTH *)
                  K := CODE_ORG ;                   (* LOADING ADRESS *)
                  CSUM := (K DIV 256)+ (K MOD 256) ;
                  OBJLINE[4] := HEX[ K DIV 4096] ;   K := K MOD 4096 ;
                  OBJLINE[5] := HEX[ K DIV 256 ] ;   K := K MOD 256  ;
                  OBJLINE[6] := HEX[ K DIV 16  ] ;
                  OBJLINE[7] := HEX[ K MOD 16  ] ;

                  L := PROC_ADR[ PROC_INX[PROC_CNT] ] + FIX_AREA ;
                  K := L MOD 256 ;                  (* REL. ENTRY POINT ADR. *)
                  OBJLINE[10] := HEX[ K DIV 16 ] ;
                  OBJLINE[11] := HEX[ K MOD 16 ] ;
                  CSUM := CSUM+K ;
                  K := L DIV 256 ;
                  OBJLINE[12] := HEX[ K DIV 16 ] ;
                  OBJLINE[13] := HEX[ K MOD 16 ] ;
                  CSUM := CSUM+K ;

                  L := GIC + FIX_AREA ;             (* REL. PROC. TBL. ADR. *)
                  K := L MOD 256 ;
                  OBJLINE[14] := HEX[ K DIV 16 ] ;
                  OBJLINE[15] := HEX[ K MOD 16 ] ;
                  CSUM := CSUM+K ;
                  K := L DIV 256 ;
                  OBJLINE[16] := HEX[ K DIV 16 ] ;
                  OBJLINE[17] := HEX[ K MOD 16 ] ;
                  CSUM := CSUM+K ;

                  L := L + (PROC_CNT+1)*2 ;        (* REL. PROC. TBL. ADR. *)
                  K := L MOD 256 ;
                  OBJLINE[18] := HEX[ K DIV 16 ] ;
                  OBJLINE[19] := HEX[ K MOD 16 ] ;
                  CSUM := CSUM+K ;
                  K := L DIV 256 ;
                  OBJLINE[20] := HEX[ K DIV 16 ] ;
                  OBJLINE[21] := HEX[ K MOD 16 ] ;
                  CSUM := CSUM+K ;

                  L :=  HEAP_END ;    (* REL. HEAP ADR. *)
                  K := (*L MOD 256*) 0 ;
                  OBJLINE[22] := HEX[ K DIV 16 ] ;
                  OBJLINE[23] := HEX[ K MOD 16 ] ;
                  CSUM := CSUM+K ;
                  K := L DIV 256 ;
                  OBJLINE[24] := HEX[ K DIV 16 ] ;
                  OBJLINE[25] := HEX[ K MOD 16 ] ;
                  CSUM := CSUM+K ;

                  CSUM := 256-((CSUM+8) MOD 256) ; (* ADD LEN TO CSUM *)
                  OBJLINE[26] := HEX[ (CSUM MOD 256) DIV 16 ] ;
                  OBJLINE[27] := HEX[CSUM MOD 16] ;
                  FOR J := 28 TO 75 DO  OBJLINE[J] := ' ' ;
                  WRITELN(PRR, OBJLINE) ;
                  WRITELN(PRR, ':0000000000') ;
                  PROC_ID[PROC_INX[PROC_CNT]] [1] := ' ' ;    (* '$' <= ' ' *)

                  END (* IF LEVEL = 0 *) ;

               END (* IF GENCODE *) ;

         END (* OUTPUT_CODE *) ;    """
(*----------------------------------------------------------------------------*)

  PROCEDURE OUTPUT_CODE1 ;


  VAR   I, J : INTEGER ;   OBJLINE : ARRAY [1..80] OF CHAR ;

     BEGIN   WRITELN(OUTPUT) ;
"    WRITELN(OUTPUT,'**** PROC: ', PROC_ID[CURPROC],
                    '  DATA AREA:',PROC_DATA[CURPROC]:6, '  PCNT, T: ',
                    PC:6, GPC+PC-1:6, '  SIZE, T:', IC:5, GIC+IC:6) ;  "
"    I := GIC+CODE_ORG+FIX_AREA ;          (* LOADING ADDRESS FOR THIS PROC *)
     (* PRINT HEADER ==> LENGTH, LOAD ADR. *)
     WRITE(PRR, CHR(IC MOD 256 -ABS), CHR(IC DIV 256 -ABS),
                CHR(I MOD 256 -ABS), CHR(I DIV 256 -ABS) );  "
     J := 0 ;
     FOR I := 0 TO IC-1 DO
        BEGIN  J := J+1 ;
        OBJLINE[J] := CHR(CODE[I]-ABS) ;
        IF J >= 80 THEN
           BEGIN
           WRITE(PRR, OBJLINE) ;
           J := 0 ;
           END ;
        END (* FOR I := ... *)  ;
     IF J > 0 THEN  WRITE(PRR,OBJLINE:J)  ;

     (* SEE IF END OF MAINBLK *)

     GIC := GIC+IC ;
     IF LEVEL = 0 THEN
        BEGIN
        IF ODD(GIC) THEN  BEGIN GIC := GIC+1 ;  WRITE(PRR, CHR(256 -ABS))  END ;
"       I := PROC_CNT + PROC_CNT + 2 ;               (* PROC TABLE LENGTH   *)
        WRITE(PRR, CHR(I MOD 256 -ABS), CHR(I DIV 256 -ABS) ) ;
        (* PROC TABLE LOAD ADR *)
        I := GIC+CODE_ORG+FIX_AREA ;
        WRITE(PRR, CHR(I MOD 256 -ABS), CHR(I DIV 256 -ABS) ) ; "

        FOR I := MINPROC TO PROC_CNT DO
           BEGIN
           J := PROC_ADR[ PROC_INX[I] ] + FIX_AREA ;
           WRITE(PRR, CHR(J MOD 256 -ABS), CHR(J DIV 256 -ABS)) ;
           END ;

        (* WRITE THE LENGTH TABLES (I.E. FIX_AREA CONTENTS) *)
"       WRITE(PRR, CHR(FIX_AREA MOD 256 -ABS), CHR(FIX_AREA DIV 256 -ABS),
                   CHR(CODE_ORG MOD 256 -ABS), CHR(CODE_ORG DIV 256 -ABS) ) ;  "
        I := PROC_ADR[ PROC_INX[PROC_CNT] ] + FIX_AREA ;   (* ENTRY POINT ADR *)
        WRITE(PRR, CHR(I MOD 256 -ABS), CHR(I DIV 256 -ABS) ) ;
        I := GIC+ FIX_AREA ;         (* END OF PROGRAM / START OF PROC_TABLE *)
        WRITE(PRR, CHR(I MOD 256 -ABS), CHR(I DIV 256 -ABS) ) ;
        I := I+ PROC_CNT+PROC_CNT+2 ;(* END OF PROC_TABLE *)
        WRITE(PRR, CHR(I MOD 256 -ABS), CHR(I DIV 256 -ABS) ) ;
        I := 0 ;                     (* HEAP ADDRESS, TO BE SET BY INTERP. *)
        WRITE(PRR, CHR(I MOD 256 -ABS), CHR(I DIV 256 -ABS) ) ;
"       (* WRITE THE END RECORD FOR PTDOS LOADER *)
        WRITE(PRR, CHR(I MOD 256 -ABS), CHR(I DIV 256 -ABS) ) ;
        I := 256 ;    (* TO MAKE PTDOS HAPPY *)
        WRITE(PRR, CHR(I MOD 256 -ABS), CHR(I DIV 256 -ABS) ) ;   "
        END (* IF LEVEL = 0 *) ;

     END (* OUTPUT_CODE1 *) ;

(*----------------------------------------------------------------------------*)

""" PROCEDURE PRINTCOUNTS ;

  (* TO PRINT OUT P_CODE RELATED STATISTICS *)
  (* -------------------------------------- *)

  VAR  I, J, K, L, M, N, TZCNT : INTEGER ;
       ZINX             : ARRAY [0..ZOPCNT] OF 0..ZOPCNT ;
       ZINSTR           : ARRAY [0..ZOPCNT] OF  ARRAY [1..5] OF CHAR ;

      BEGIN

      (* INITIALZE INSTRUCTION NAME TABLE *)

      ZINSTR[ZLDC1 ] := 'LDC1 ' ;    ZLEN[ZLDC1 ] := 1 ;
      ZINSTR[ZLDC2 ] := 'LDC2 ' ;    ZLEN[ZLDC2 ] := 2 ;
      ZINSTR[ZLDC  ] := 'LDC  ' ;    ZLEN[ZLDC  ] := 3 ;
      ZINSTR[ZLDC8 ] := 'LDC8 ' ;    ZLEN[ZLDC8 ] := 9 ;
  (*  ZINSTR[ZLDCR ] := 'LDCR ' ;    ZLEN[ZLDCR ] := 9 ; *)
      ZINSTR[ZLODG2] := 'LODG2' ;    ZLEN[ZLODG2] := 2 ;
      ZINSTR[ZLOD  ] := 'LOD  ' ;    ZLEN[ZLOD  ] := 3 ;
      ZINSTR[ZLOD8 ] := 'LOD8 ' ;    ZLEN[ZLOD8 ] := 3 ;
   (* ZINSTR[ZLODR ] := 'LODR ' ;    ZLEN[ZLODR ] := 3 ; *)
      ZINSTR[ZCUP  ] := 'CUP  ' ;    ZLEN[ZCUP  ] := 2 ;
      ZINSTR[ZCSP  ] := 'CSP  ' ;    ZLEN[ZCSP  ] := 2 ;
      ZINSTR[ZIND  ] := 'IND  ' ;    ZLEN[ZIND  ] := 2 ;
      ZINSTR[ZINDS ] := 'INDS ' ;    ZLEN[ZINDS ] := 2 ;
      ZINSTR[ZIXA  ] := 'IXA  ' ;    ZLEN[ZIXA  ] := 3 ;
      ZINSTR[ZSPWRP] := 'SPWRP' ;    ZLEN[ZSPWRP] := 1 ;
      ZINSTR[ZSTRLG] := 'STRLG' ;    ZLEN[ZSTRLG] := 2 ;
      ZINSTR[ZSTR  ] := 'STR  ' ;    ZLEN[ZSTR  ] := 3 ;
      ZINSTR[ZMVP  ] := 'MVP  ' ;    ZLEN[ZMVP  ] := 2 ;
      ZINSTR[ZSTRS ] := 'STRS ' ;    ZLEN[ZSTRS ] := 3 ;
      ZINSTR[ZLDALG] := 'LDALG' ;    ZLEN[ZLDALG] := 2 ;
   (* ZINSTR[ZLDAL ] := 'LDAL ' ;    ZLEN[ZLDAL ] := 2 ;  *)
      ZINSTR[ZLDA  ] := 'LDA  ' ;    ZLEN[ZLDA  ] := 3 ;
      ZINSTR[ZLCA  ] := 'LCA  ' ;    ZLEN[ZLCA  ] := 10;
      ZINSTR[ZXJP  ] := 'XJP  ' ;    ZLEN[ZXJP  ] := 6 ;
      ZINSTR[ZCMPM ] := 'CMPM ' ;    ZLEN[ZCMPM ] := 3 ;
      ZINSTR[ZEQU  ] := 'EQU  ' ;    ZLEN[ZEQU  ] := 1 ;
      ZINSTR[ZNEQ  ] := 'NEQ  ' ;    ZLEN[ZNEQ  ] := 1 ;
      ZINSTR[ZLEQ  ] := 'LEQ  ' ;    ZLEN[ZLEQ  ] := 1 ;
      ZINSTR[ZLES  ] := 'LES  ' ;    ZLEN[ZLES  ] := 1 ;
      ZINSTR[ZGEQ  ] := 'GEQ  ' ;    ZLEN[ZGEQ  ] := 1 ;
      ZINSTR[ZGRT  ] := 'GRT  ' ;    ZLEN[ZGRT  ] := 1 ;
      ZINSTR[ZCMPRS] := 'CMPRS' ;    ZLEN[ZCMPRS] := 2 ;
      ZINSTR[ZMOV  ] := 'MOV  ' ;    ZLEN[ZMOV  ] := 2 ;
      ZINSTR[ZMST  ] := 'MST  ' ;    ZLEN[ZMST  ] := 1 ;
      ZINSTR[ZRET  ] := 'RET  ' ;    ZLEN[ZRET  ] := 1 ;
      ZINSTR[ZSTO  ] := 'STO  ' ;    ZLEN[ZSTO  ] := 1 ;
      ZINSTR[ZSTOS ] := 'STOS ' ;    ZLEN[ZSTOS ] := 1 ;
      ZINSTR[ZRETF8] := 'RETF8' ;    ZLEN[ZRETF8] := 1 ;

      ZINSTR[ZORD  ] := 'ORD  ' ;    ZLEN[ZORD  ] := 0 ;
      ZINSTR[ZCHR  ] := 'CHR  ' ;    ZLEN[ZCHR  ] := 0 ;
      ZINSTR[ZADI  ] := 'ADI  ' ;    ZLEN[ZADI  ] := 1 ;
      ZINSTR[ZADIC ] := 'ADIC ' ;    ZLEN[ZADIC ] := 2 ;
      ZINSTR[ZSBI  ] := 'SBI  ' ;    ZLEN[ZSBI  ] := 1 ;
      ZINSTR[ZDVI  ] := 'DVI  ' ;    ZLEN[ZDVI  ] := 1 ;
      ZINSTR[ZMOD  ] := 'MOD  ' ;    ZLEN[ZMOD  ] := 1 ;
      ZINSTR[ZMPI  ] := 'MPI  ' ;    ZLEN[ZMPI  ] := 1 ;
      ZINSTR[ZNGI  ] := 'NGI  ' ;    ZLEN[ZNGI  ] := 1 ;
      ZINSTR[ZRST  ] := 'RST  ' ;    ZLEN[ZRST  ] := 1 ;
      ZINSTR[ZDEC1 ] := 'DEC1 ' ;    ZLEN[ZDEC1 ] := 1 ;
      ZINSTR[ZODD  ] := 'ODD  ' ;    ZLEN[ZODD  ] := 1 ;
      ZINSTR[ZFLT  ] := 'FLT  ' ;    ZLEN[ZFLT  ] := 1 ;
      ZINSTR[ZFLO  ] := 'FLO  ' ;    ZLEN[ZFLO  ] := 1 ;
      ZINSTR[ZABI  ] := 'ABI  ' ;    ZLEN[ZABI  ] := 1 ;
      ZINSTR[ZSGS  ] := 'SGS  ' ;    ZLEN[ZSGS  ] := 1 ;
      ZINSTR[ZINN  ] := 'INN  ' ;    ZLEN[ZINN  ] := 1 ;
      ZINSTR[ZUNI  ] := 'UNI  ' ;    ZLEN[ZUNI  ] := 1 ;
      ZINSTR[ZINT  ] := 'INT  ' ;    ZLEN[ZINT  ] := 1 ;
      ZINSTR[ZDIF  ] := 'DIF  ' ;    ZLEN[ZDIF  ] := 1 ;
      ZINSTR[ZNEW  ] := 'NEW  ' ;    ZLEN[ZNEW  ] := 2 ;
      ZINSTR[ZAND  ] := 'AND  ' ;    ZLEN[ZAND  ] := 1 ;
      ZINSTR[ZIOR  ] := 'IOR  ' ;    ZLEN[ZIOR  ] := 1 ;
      ZINSTR[ZNOT  ] := 'NOT  ' ;    ZLEN[ZNOT  ] := 1 ;
      ZINSTR[ZMSTF ] := 'MSTF ' ;    ZLEN[ZMSTF ] := 1 ;
      ZINSTR[ZRETF ] := 'RETF ' ;    ZLEN[ZRETF ] := 1 ;
      ZINSTR[ZCUP1 ] := 'CUP1 ' ;    ZLEN[ZCUP1 ] := 1 ;
      ZINSTR[ZCSP1 ] := 'CSP1 ' ;    ZLEN[ZCSP1 ] := 1 ;
      ZINSTR[ZFJP  ] := 'FJP  ' ;    ZLEN[ZFJP  ] := 2 ;
      ZINSTR[ZUJP  ] := 'UJP  ' ;    ZLEN[ZUJP  ] := 2 ;
      ZINSTR[ZIND1 ] := 'IND1 ' ;    ZLEN[ZIND1 ] := 1 ;
      ZINSTR[ZIXA1 ] := 'IXA1 ' ;    ZLEN[ZIXA1 ] := 1 ;
      ZINSTR[ZLODG ] := 'LODG ' ;    ZLEN[ZLODG ] := 1 ;
      ZINSTR[ZLODL ] := 'LODL ' ;    ZLEN[ZLODL ] := 1 ;
      ZINSTR[ZENT  ] := 'ENT  ' ;    ZLEN[ZENT  ] := 11;

      (* OUTPUT PROCEDURE CALL TABLE *)

      WRITELN(OUTPUT,'1  PROCEDURE CALL TABLE    ',
                     'CALL_CNT, CUM_CNT, DATA_SIZE, ADDR. ') ;
      WRITELN(OUTPUT) ;   K := 0 ;
(*    REWRITE(SYMFILE) ;  (* WRITE SYMBOL FILE FOR THE SIMULATOR *)

      FOR I := MINPROC TO PROC_CNT DO
         BEGIN  J := PROC_INX[I] ;    K := K+CALL_CNT[J] ;
         WRITELN(OUTPUT, I, J:4,  PROC_ID[J]:12, CALL_CNT[J]:8, K:8,
                         PROC_DATA[J]:9, PROC_ADR[J]:8 ) ;
    (*  WRITELN(SYMFILE,I+1:6,PROC_ID[J]:12, PROC_ADR[J]+CODE_ORG+FIX_AREA:8);*)
         END ;

      (* SORT OPCODES BY FREQUENCY *)

      TZCNT := 0 ;   ZINX[0] := ZOPCNT ;  (* NOTE ZCNT[ZOPCNT] = 0 *)
##
##    FOR I := 0 TO ZOPCNT-1 DO
##       BEGIN    (* INSERT THE NEXT ENTRY IN ITS PROPER PLACE *)
##       J := ZCNT[I] ;   TZCNT := TZCNT+J ;
##       K := -1 ;   REPEAT K := K+1  UNTIL ZCNT[ ZINX[K] ] <= J ;
##
##       FOR J := I DOWNTO K DO  ZINX[J+1] := ZINX[J] ;
##
##       ZINX[K] := I ;
##       END (* SORT LOOP *) ;

      WRITELN(OUTPUT, '  I_INTERPRETIVE CODE FREQUENCIES, ',
                      'TOTAL (P_CODES, I_CODES, BYTES) :',
                      GPC-1:7, TZCNT:7, GIC:8) ;
      WRITELN(OUTPUT) ;  WRITELN(OUTPUT) ;
      WRITELN('(ABS)  (I.LEN) (T.LEN) (C.LEN)':55 );
      WRITELN(OUTPUT) ;

      L := 0 ;   N := 0 ;
      IF ZCNT[ZLCA] > 0 THEN
         ZLEN[ZLCA] := LCALEN DIV ZCNT[ZLCA]  ; (* CALC. AVERG 'LCA' LEN. *)
      FOR J := 0 TO ZOPCNT DO
         BEGIN   I := (* ZINX[J] *) J ;   K := ZCNT[I] ;  L := L+K ;
         IF K > 0 THEN
            BEGIN   M := ZLEN[I]*K ;   N := N+M ;
            WRITELN(OUTPUT, J, I:4, ZINSTR[I]:7, K:6,
                       (*   K*1000 DIV TZCNT:6,  L*1000 DIV TZCNT:6, *)
                            ZLEN[I]:10, M:7, (*M *1000 DIV GIC:7,*) N:9 ) ;
            END ;
         END ;
      WRITELN(OUTPUT) ;
      WRITELN(OUTPUT, '**** TOTAL ', '(P_CODES, BYTES, ACCOUNTED) :',
                      GPC-1:7, GIC:7, N:8) ;
      END (* PRINTCOUNTS*) ;   """


(*----------------------------------------------------------------------------*)

   BEGIN   (* GENERATE *)   (*  RESET(INPUT) ; *)
      REPEAT    (* READ UNTIL LAST INSTRUCTION, 'STP' *)
         READ(INPUT,CH) ;  (* FIRST CHARACTER OF LINE *)
         IF CH = ' ' THEN
         BEGIN   (* NO LABEL FIELD *)
            ASSEMBLE
         END   (* CH = ' ' *)
         ELSE
         BEGIN   (*PLABEL*)
            IF (CH = 'L') THEN
            BEGIN   (* LABEL DEFINITION *)
               READ(INPUT, X, CH) ;   (*READ NEXT NON BLANK CHAR*)
               IF INPUT@ = 'L' THEN   (* LAB *)
                  BEGIN  LABELVALUE := IC ;   UPDATELBL(X) ;  END
               ELSE
               BEGIN   (*PDEF*)
                  READ(INPUT, CH (*SKIP OVER OPCODE*), LABELVALUE)  ;
                  UPDATELBL(X) ;

               IF OP = PRET  (* THIS IS OLD OPCODE *) THEN
                  BEGIN   PROC_DATA[CURPROC] := LABELVALUE ;
              """  OUTPUT_CODE ;  """      (* OUTPUT CODE FOR THIS PROC. *)
                  OUTPUT_CODE1 ;           (* OUTPUT BINARY OBJECT FORM *)
                  GPC := GPC+PC ;
                  PC := 0 ;  IC := 0 ;
                  END ;

               END   (*PDEF*) ;
               READLN(INPUT) ;
            END   (* STANDARD LABEL *)
            ELSE
            BEGIN   (* PROCEDURE OR FUNCTION ENTRY POINT *)
               READ(INPUT, CURPROC) ;
               PROC_ADR[CURPROC] := GIC ;  (* RECORD ENTRY POINT ADR *)
               REPEAT  READ(INPUT,CH)  UNTIL INPUT@ <> ' ' ;
               (*ADVANCE TO OPCODE FIELD*)
               ASSEMBLE
            END   (* PROCEDURE OR FUNCTION *)
         END   (* LABEL *)  ;

      UNTIL OP = PSTP ;

  """ PRINTCOUNTS ;  """

   END   (* GENERATE *) ;
(*----------------------------------------------------------------------------*)

   PROCEDURE ASSEMBLE; (*TRANSLATE SYMBOLIC CODE INTO MACHINE CODE AND STORE*)
      VAR TCH :CHAR;  S1, DY, DX, I, J : INTEGER;  NEGATE: BOOLEAN ;
          STRING : ARRAY[1..MAXSLEN] OF CHAR ;
          "B :BOOLEAN;  R :REAL;  S :SET OF 0..63;"
(*----------------------------------------------------------------------------*)

    " PROCEDURE GET_OPCDE;
      BEGIN     READ(INPUT,NAME) ;
         OP := IVECTOR[NAME[1]]-1 ;
         INSTR[PNOP] := NAME ;
         REPEAT  OP := OP+1  UNTIL (INSTR[OP] = NAME) ;
         IF OP >= PNOP THEN
         BEGIN
            WRITELN(OUTPUT,' ****  ILLEGAL OPCODE: ' ,NAME) ;
            OP := PTOF  (* NOP *)
         END ;
         IF OP <= 63 THEN
            IF (OP IN NEEDOPNDS) THEN
               REPEAT
                  READ(INPUT,CH) ;
               UNTIL  INPUT@ <> ' ' ;
      END; (*GET_OPCDE*) "
(*----------------------------------------------------------------------------*)

(*++PROCEDURE ASSEM2 ; " FOR DEBUGGING HAVE TO DEVIDE ASSEMBLE INTO TWO "
       BEGIN
       CASE OP OF   +++*)

(*+++++   END " CASE OP " ;

       END " ASSEM2 " ;  +++*)


   BEGIN   (* ASSEMBLE *)
      P := 0;  Q := 0;  "OP := 0; T := UNDEF ; "
### #"GET_OPCDE;"
### # READ(INPUT, CH) ; OP := ORD(CH) ;
### #"WRITELN(OUTPUT,OP:3 , INSTR[OP]:5, IC:8);"
      IF (OP IN NEEDOPNDS) THEN   READ(INPUT, CH) ;
  """    REPEAT
            READ(INPUT,CH) ;
         UNTIL  INPUT@ <> ' ' ;  """
### # IF OP >= PNOP THEN  BEGIN  WRITELN(OUTPUT, OP); ERROR(160)  END ;

      CASE OP OF  (* GET PARAMETERS T,P,Q *)

          PLOC :
             BEGIN   WRITE(OUTPUT, '+') ;   PC := PC-1  END ;

          PLCA, PLSA :
             BEGIN   PACKSTRNG := OP = PLSA ;
                Q := IC ; CODE[IC] := ZLCA ; IC := IC+2 ;
                READ(INPUT, CH) ;
                   REPEAT
                   READ(INPUT, CH) ;  (* CH = FIRST CHAR IN STRING *)

                      REPEAT
                      IF OP = PLCA THEN
                         BEGIN  CODE[IC] := 0 ;  IC := IC+1 ; END ;
                      CODE[IC] := "ASCII[CH]-32" ORD(CH) ;
                      IC := IC+1 ;  READ(INPUT,CH)
                      UNTIL CH = '''' ;

                  UNTIL INPUT@ <> '''' ;

                CODE[Q+1] := IC-(Q+2) ;
                ZCNT[ZLCA] := ZCNT[ZLCA]+1 ;
                LCALEN := LCALEN+ IC-Q ;   (* ACCUMULATE LENGTH *)
             END;


          PLDC :  BEGIN  READ(INPUT, CH) ;
                    CASE CH OF  (*GET Q*)
                   'I', 'B' :BEGIN  P := 1;
                             READ(INPUT, CH, Q) ;
                             END;

                   'C' :BEGIN
                           P := 1 ;
                           READ(INPUT,CH, CH, CH  (* SKIP OVER ,'*) ) ;
                           Q := "ASCII[CH]-32" ORD(CH) ;
                        END   (* C *) ;

                   'R' :BEGIN
                        READ(INPUT, CH(*,*),CH) ;
                        J := 0 ;  DY := 0 ;
                        NEGATE := CH = '-' ;
                        IF (CH = '+') OR (CH = '-') THEN  READ(CH) ;
                        WHILE CH = '0' DO READ(CH) ; (* SKIP LAEDING ZEROS *)
                        IF CH ='.' THEN
                          BEGIN   READ(CH) ;
                          WHILE CH ='0' DO  BEGIN  J := J-1 ;  READ(CH)  END ;
                          DX := 0 ;   (*POWER INCREMENT *)
                          END
                        ELSE DX := +1 ;

                        WHILE CH IN ['0'..'9'] DO
                          BEGIN  DY := DY+1 ;  STRING[DY] := CH ;
                          J := J+DX ;
                          READ(CH) ;
                          IF CH = '.' THEN  BEGIN DX := 0 ;  READ(CH)  END ;
                          END ;

                        IF CH = 'E' THEN
                          BEGIN  READ(P) ;  J := J+P ;
                          IF (J < -63) OR (J > 63) THEN
                             BEGIN  ERROR(191);  J := 0;  END;
                          END;
                        J := J+64 ;
                        IF NEGATE THEN J := J+128 ;

                        FOR I := DY+1 TO 14 DO  STRING[I] := '0' ;
                        CODE[IC] := ZLDC8 ;  IC := IC+1 ;
                        ZCNT[ZLDC8] := ZCNT[ZLDC8]+1 ;
                        IF STRING[1] = '0' THEN  J := 0 ;

                        FOR I := 1 TO 7 DO
                          BEGIN
                          CODE[IC] := (ORD(STRING[I*2-1])-ORD('0') ) * 16 +
                                      (ORD(STRING[I*2]  )-ORD('0')) ;
                          IC := IC+1 ;
                          END ;

                        CODE[IC] := J ;   IC := IC+1 ;
                        P := 4 ;
                        "  REPEAT
                              READ(INPUT,CH) ;
                           UNTIL CH = ',' ;
                           READ(INPUT,R); "
                          "ERROR(140 (* LODC R *) ) ;"
                        END;

                   'N' :; (*P,Q = 0*)

                   'S' :BEGIN   P := 4;
                          "S := [ ];"
                           REPEAT
                              READ(INPUT,CH) ;
                           UNTIL CH = '(' ;
                           CODE[IC] := ZLDC8 ;  IC := IC+1 ;
                           ZCNT[ZLDC8] := ZCNT[ZLDC8]+1 ;

                           FOR I := 0 TO 7 DO
                              BEGIN  "J := I*16 ;"
                              READ(INPUT, S1, CH(*,*)) ;
                              CODE[IC] := S1 ;
                              IC := IC+1 ;
                              END (* FOR I :=..*) ;

                        END
                   END (*CASE*) ;

                   IF P <> 4 THEN
                       BEGIN
                         NEGATE :=  Q < 0 ;
                         IF NEGATE THEN  Q := -Q ;

                         IF Q < 32 THEN (*LOAD SHORT CONST *)
                           BEGIN  CODE[IC] := ZLDC1+Q ;
                           IC := IC+1 ;  ZCNT[ZLDC1] := ZCNT[ZLDC1]+1 ;
                           END
                         ELSE IF Q <= 255 THEN
                           BEGIN
                           CODE[IC] := ZLDC2 ;  CODE[IC+1] := Q ;
                           IC := IC+2 ;
                           ZCNT[ZLDC2] := ZCNT[ZLDC2]+1 ;
                           END
                         ELSE (* LOAD LARGE CONSTANT *)
                           BEGIN   CODE[IC] := ZLDC ;
                           CODE[IC+1] := Q DIV 256 ;
                           CODE[IC+2] := Q MOD 256 ;  IC := IC+3 ;
                           ZCNT[ZLDC] := ZCNT[ZLDC]+1 ;
                           END  (* LARGE CONST *)  ;

                        IF NEGATE THEN
                           BEGIN CODE[IC] := ZNGI ;
                           ZCNT[ZNGI] := ZCNT[ZNGI]+1 ;
                           IC := IC+1 ;
                           END ;

                        END (* LOAD CONST INT, CHAR, BOOL, NIL *)  ;

                END;

          PLOD :
             BEGIN  "READ(INPUT, CH) ;
                CASE CH OF
                   'I','C','B','A': T := INT ;
                   'R': T := REEL ;
                   'S': T := SETT ;
                END   (* CASE *) ; "
                READ(INPUT, TCH(*TYPE*), CH (*,*), P, CH (*,*), Q) ;
                IF TCH = 'R' THEN TCH := 'S' ;
                P := P-1 ;  IF P > 7 THEN  ERROR(162 (* LEVEL TOO HIGH *) );
              " IF T = REEL THEN ERROR(101 (* 'LOD' REAL OPERAND *) )
                ELSE "
                 IF (TCH = 'S') OR ((P > 0) AND (P < LEVEL)) OR (Q > 63) THEN
                    IF (TCH <> 'S') AND (P = GLOBAL) AND (Q <= 511) THEN
                       BEGIN
                       CODE[IC] := ZLODG2 ;  CODE[IC+1] := Q DIV 2 ;
                       ZCNT[ZLODG2]:= ZCNT[ZLODG2]+1 ;
                       IC := IC+2 ;
                       END
                    ELSE
                       BEGIN (* LOAD SET, NON LOCAL/NON GLOBAL OR LARGE ADR *)
                       IF TCH = 'S' THEN
                          BEGIN  CODE[IC] := ZLOD8; ZCNT[ZLOD8] := ZCNT[ZLOD8]+1
                          END
                       ELSE
                          BEGIN  CODE[IC] := ZLOD ;  ZCNT[ZLOD] := ZCNT[ZLOD]+1
                          END ;
                       IF Q > 16383 THEN ERROR(102 (*'LOD' OFFSET TOO LARGE*)) ;
                       CODE[IC+1] := P*32 + Q DIV 512 ;
                       CODE[IC+2] := (Q MOD 512) DIV 2 ;
                       IC := IC+3 ;
                       END
                  ELSE  (* LOAD LOCAL/GLOBAL SMALL OFFSET *)
                    BEGIN
                    IF P = LEVEL THEN  I := ZLODL  ELSE  I := ZLODG ;
                    ZCNT[I] := ZCNT[I]+1 ;
                    IF I = ZLODL THEN I := ZLODG+1 ;   (* DISTRIBUTE OPCODE *)
                    CODE[IC] := I + Q ;
                    IC := IC+1 ;
                    END ;
               IF ODD(Q) THEN  ERROR(125) ;
             END   (* LOD *) ;

          PSTR :
             BEGIN  "READ(INPUT, CH) ;
                CASE CH OF
                   'I','C','B','A': T := INT ;
                   'R': T := REEL ;
                   'S': T := SETT ;
                END   (* CASE *) ; "
                READ(INPUT, TCH(*TYPE*), CH(*,*), P, CH(*,*), Q) ;
                P := P-1 ;   IF P > 7 THEN ERROR(162 (* LEVEL TOO HIGH *) ) ;
                IF TCH = 'R' THEN TCH := 'S' ;
              " IF T = REEL THEN ERROR(108 (* 'STR' REAL OPERAND *) )
                ELSE "
                 IF (TCH = 'S') OR ((P > GLOBAL) AND (P < LEVEL))
                 OR "(Q > 127)" (Q > 255)  THEN
                    BEGIN (* LOAD SET, NON LOCAL/NON GLOBAL OR LARGE ADR *)
                    IF TCH = 'S' THEN
                       BEGIN  CODE[IC] := ZSTRS ;
                       ZCNT[ZSTRS] := ZCNT[ZSTRS]+1 ;
                       END
                    ELSE
                       BEGIN CODE[IC] := ZSTR ;
                       ZCNT[ZSTR] := ZCNT[ZSTR]+1 ;
                       END ;
                    CODE[IC+1] := P*32 + Q DIV 512 ;
                    CODE[IC+2] := (Q MOD 512) DIV 2 ;
                    IC := IC+3 ;  ZCNT[ZSTR] := ZCNT[ZSTR+1] ;
                    IF Q > 16383 THEN ERROR(104 (* 'STR' OFFSET TOO LARGE *) ) ;
                    END
                  ELSE  (* STORE LOCAL/GLOBAL SMALL OFFSET *)
                    BEGIN  CODE[IC] := ZSTRLG ;  I := Q DIV 2 ;
                    IF P = LEVEL THEN   CODE[IC+1] := I
                    ELSE  CODE [IC+1] := I+128 ;  (* STORE GLOBAL VAR *)
                    ZCNT[ZSTRLG] := ZCNT[ZSTRLG]+1 ;
                    IC := IC+2 ;
                    END ;
             END   (* LOD,STR *) ;

          PLDA :
             BEGIN
                READ(INPUT, P, CH(*,*), Q) ;
                P := P-1 ;  IF P > 7 THEN ERROR(162 (* LEVEL TOO HIGH *) );

                (* IF NEEDED, WE CAN ASSUME ALL OFFSETS ARE WORD
                   OFFSETS AND EXTEND THE OFFSET RANGE BY ONE BIT *)

                IF ((P = GLOBAL) OR (P = LEVEL)) AND ("Q < 128" Q < 256) THEN
                  BEGIN  CODE[IC] := ZLDALG ;   Q := Q DIV 2 ;
                  IF P <> LEVEL THEN  Q := Q+128 ;   (* LOAD GLOBAL ADDRESS *)
                  ZCNT[ZLDALG] := ZCNT[ZLDALG]+1 ;
                  CODE[IC+1] := Q ;  IC := IC+2 ;
                  END
                ELSE
                  BEGIN  CODE[IC] := ZLDA ;
                  CODE[IC+1] := P*32 + Q DIV 512 ;
                  CODE[IC+2] := (Q MOD 512) DIV 2 ;
                  IF  Q > 16383  THEN  ERROR(106 (* LDA OFFSET TOO LARGE*) ) ;
                  ZCNT[ZLDA] := ZCNT[ZLDA]+1 ;
                  IC := IC+3 ;
                  END ;

             END   (* LDA *) ;

          PCUP:
             BEGIN
                READ(INPUT, CH(*TYP*),CH(*,*), P (*PRM CNT*), CH, CH(*,$*), Q) ;

                I := -1 ;
                REPEAT  I := I+1 UNTIL  (PROC_INX[I] = Q) OR (I = PROC_CNT) ;
                (* I CONTAINS PROC INDEX *)
                IF I < 16 THEN
                  BEGIN  CODE[IC] := ZCUP1+I ;  IC := IC+1 ;
                  ZCNT[ZCUP1] := ZCNT[ZCUP1]+1 ;
                  END
                ELSE
                  BEGIN  IF I >= PROC_CNT THEN ERROR(112 (* UNDEF PROC *) ) ;
                  CODE[IC] := ZCUP ;  CODE[IC+1] := I ;
                  IC := IC+2 ;   ZCNT[ZCUP] := ZCNT[ZCUP]+1 ;
                  END ;
             END   (* CUP *) ;

          PRET, PMST :
             BEGIN  READ(INPUT, TCH) ;  IF TCH = 'R' THEN TCH := 'S' ;
                "CASE CH OF
                    'P': P:=0;
                    'I': P:=1;
                    'A': P:=2;
                    'B': P:=3;
                    'C': P:=4;
                    'R': P:= 5 ;
                    'S': P:= 6
                 END; "
             IF OP = PRET THEN
                BEGIN
                IF LEVEL > 0 THEN  CODE[IC] := ZRET
                ELSE
                   BEGIN  CODE[IC] := ZLDC1 ;
                   IC := IC+1 ;
                   CODE[IC] := ZCSP1+13 (*ZXIT*)  ;
                   END ;
                IF TCH = 'S'  THEN  CODE[IC] := ZRETF8
                ELSE  IF TCH <> 'P' THEN  CODE[IC] := ZRETF ;
                IF TCH = 'P' THEN  ZCNT[ZRET] := ZCNT[ZRET]+1
                ELSE ZCNT[ZRETF] := ZCNT[ZRETF]+1 ;
                END
             ELSE  (* OP = PMST *)
                BEGIN
                CODE[IC] := ZMST ;
                IF TCH <> 'P' THEN
                   BEGIN
                   IF TCH = 'S' THEN CODE[IC] := ZMSTF8
                   ELSE   CODE[IC] := ZMSTF8 ;   (* IN FACT 'ZMSTF' *)
                   ZCNT[ZMSTF] := ZCNT[ZMSTF]+1 ;
                   END
                ELSE  ZCNT[ZMST] := ZCNT[ZMST] + 1 ;
                END ;
             IC := IC+1 ;
             END ;

          PDEC,PINC :
             BEGIN
                READ(INPUT, TCH(*TYPE*), CH(*,*), Q) ;
                IF Q > 255 THEN ERROR(168 (* INC/DEC OPERAND TOO LARGE *)) ;

                IF (OP = PDEC) AND (Q = 1) THEN
                   BEGIN
                   CODE[IC] := ZDEC1 ;  ZCNT[ZDEC1] := ZCNT[ZDEC1]+1 ;
                   END

                 ELSE IF OP = PINC THEN

                   BEGIN
                   CODE[IC] := ZADIC ;  CODE[IC+1] := Q ;  IC := IC+1 ;
                   ZCNT[ZADIC] := ZCNT[ZADIC]+1 ;
                   END
                ELSE

                   BEGIN
                   IF Q < 32 THEN
                      BEGIN
      #               CODE[IC] := ZLDC1 + Q ;   ZCNT[ZLDC1] := ZCNT[ZLDC1]+1 ;
                      IC := IC+1 ;
                      END
                   ELSE
                      BEGIN   CODE[IC] := ZLDC2 ;
                      CODE[IC+1] := Q ;
                      IC := IC+2 ;   ZCNT[ZLDC2] := ZCNT[ZLDC2]+1 ;
                      END ;
                   IF OP = PDEC THEN
                      BEGIN  CODE[IC] := ZSBI ;  ZCNT[ZSBI] := ZCNT[ZSBI]+1  END
                   ELSE
                      BEGIN
                      CODE[IC] := ZADI ;  ZCNT[ZADI] := ZCNT[ZADI]+1
                      END ;
                   END  (* ~ (OP = PDEC) AND (Q = 1) *) ;

                IC := IC+1 ;

             END   (* INC,DEC *) ;

          PIND :
             BEGIN
                READ(INPUT, TCH(*TYPE*), CH (*,*), Q) ;

                IF TCH = 'R' THEN TCH := 'S' ;
               "IF TCH = 'R' THEN ERROR(107 (* 'IND R' ENCOUNTERED *) )
                ELSE"
                  IF (Q < 16) AND (TCH <> 'S') THEN
                     BEGIN  CODE[IC] := ZIND1 + Q ;
                     IC := IC+1 ;  ZCNT[ZIND1] := ZCNT[ZIND1]+1
                     END
                  ELSE (* LARGE DISPLACEMENT *)
                    BEGIN  CODE[IC] := ZIND ;
                    IF TCH = 'S' THEN
                       BEGIN
                       CODE[IC] := ZINDS ;   ZCNT[ZINDS] := ZCNT[ZINDS]+1
                       END
                    ELSE
                       BEGIN
                       CODE[IC] := ZIND ;  ZCNT[ZIND] := ZCNT[ZIND]+1
                       END ;

                    CODE[IC+1] := Q ;   IC := IC+2 ;
                    IF Q > 255 THEN ERROR(110 (* LARGE OFFSET FOR ' IND ' *) ) ;
                    END ;

             END   (* IND *) ;

          PSTO :
             BEGIN   READ(INPUT, TCH) ;
             IF (TCH ='R') OR (TCH ='S') THEN  I := ZSTOS  ELSE I := ZSTO ;
             CODE[IC] := I ;  IC := IC+1 ;
             ZCNT[I] := ZCNT[I]+1 ;
             END (* PSTO *) ;

          PIXA :
             BEGIN  READ(INPUT, Q) ;

             IF Q < 16 THEN  (* SHORT OPERAND *)
               BEGIN    CODE[IC] := ZIXA1+ Q ;  IC := IC+ 1 ;
               ZCNT[ZIXA1] := ZCNT[ZIXA1]+1 ;
               END
             ELSE
               BEGIN   CODE[IC] := ZIXA ;
               CODE[IC+1] := Q DIV 256 ;  CODE[IC+2] := Q MOD 256 ;
               ZCNT[ZIXA] := ZCNT[ZIXA]+1 ;
               IC := IC+3 ;
               END ;

             END   (* IXA *) ;

          PFJP,PUJP:
             BEGIN   READ(INPUT, CH (*L*), I(*INT LABEL*)) ;
             J := ZFJP ;  IF OP = PUJP THEN J := ZUJP ;
             IF LABELTAB[I].ST = DEFINED THEN   (* BACKWARD BRANCH *)
               BEGIN   CODE[IC] := J+LABELTAB[I].VAL DIV 256 ;
               CODE[IC+1] := LABELTAB[I].VAL MOD 256 ;
               END
             ELSE    (* FORWARD BRANCH *)
               BEGIN   CODE[IC] := J ;
               CODE[IC+1] := LABELTAB[I].VAL ;
               LABELTAB[I].VAL := IC+1 ;
               END ;

             IC := IC+2 ;  ZCNT[J] := ZCNT[J]+1 ;
             END ;
(*++++++  PABI, PADI, PSBI, PMPI, PNGI, PDVI,
          PMOD, PAND, PIOR, PNOT, PODD, PCHK,
          PINN, PINT, PUNI, PDIF, PSGS, PRST,
          PSQI, PABR, PADR, PSBR, PMPR, PDVR,
          PNGR, PFLT, PFLO, PSQR, PENT, PCSP,
          PEQU, PNEQ, PLEQ, PLES, PGEQ, PGRT,
          PNEW, PSAV, PXJP, PMOV            :    ASSEM2 ;   ++++*)
          (*+++  ASSEM2 COPIED TO HERE +++*)
          PENT :   (* THIS SHOULD BE FIXED TO READ PARM LENGTH *)
             BEGIN               (* RESET INSTR COUNTER *)
                FOR I := MINLBL TO MAXLBL DO

                  BEGIN  LABELTAB[I].VAL := 0 ;  LABELTAB[I].ST := ENTERED  END;


                READ(INPUT, TCH) ;
                IF      TCH = 'P' THEN   P := 0
                ELSE IF (TCH = 'S') OR (TCH = 'R') THEN  P := 8
              " ELSE IF TCH = 'R' THEN   ERROR(124 (* REAL PROC *) ) "
                ELSE                    P := 2 ;


              " WHILE TCH <> ',' DO READ(INPUT,TCH) ;" (* GET LEVEL *)
                READ(INPUT, CH (*,*), LEVEL) ;   LEVEL := LEVEL-1 ;

                IF LEVEL > 7 THEN ERROR(127 (* PROCEDURE NESTING TOO DEEP *) ) ;

                CODE[0 "IC"] := "P*8+"LEVEL*2 ;

                READ(INPUT,CH,CH(*,$*),I) ;    (*READ PROC_SIZE LABEL*)
                CODE[3"IC+2"] := LABELTAB[I].VAL ;  CODE[2"IC+1"] := 0 ;
                LABELTAB[I].VAL := 3"IC+2" ;

                (* SET CODE[1] TO -(PARM AREA LENGTH) *)
                READ(INPUT, CH, P) ;  CODE[1] := 256-(P+LNKAREA) ;
                IF P = 0 THEN CODE[1] := 0 ;

                WHILE INPUT@ = ' ' DO GET(INPUT) ;

                FOR J := 1 TO 6 DO
                  BEGIN  (* INCLUDE THE PROC NAME IN THE PROC HEADER *)
                  READ(INPUT,CH) ;  CODE[J+3"IC+3+J"] :="ASCII[CH]"ORD(CH)+ABS ;
                  PROC_ID[CURPROC,J] := CH ;
                  END ;
                READ(INPUT, PROC_ID[CURPROC,7] ) ;
                IC := 10 ;   OLDIC := 0 ;
                ZCNT[ZENT] := ZCNT[ZENT]+1 ;
              " WRITELN(OUTPUT) ; " WRITE(OUTPUT, PROC_ID[CURPROC]:8,' ') ;
             END ; (* PENT *)

          PCSP :
             BEGIN
### #           READ(INPUT,"NAME"CH) ;  Q := SPCODE[ ORD(CH) ] ;
             "  WHILE (NAME<>SPTABLE[Q]) AND (Q < SPCNT) DO  Q := Q+1 ;
                IF NAME <> SPTABLE[Q] THEN
                   BEGIN WRITE(NAME:5) ;ERROR(113 (* UNDEF CSP *) ) END
### #           ELSE

### #           WRITE('CSP', Q) ;
### #           WRITELN( SPTABLE[Q]:5, Q ) ;  "
### #           IF Q >= QNOP THEN ERROR(113)
### #           ELSE
                   IF Q < 16 THEN
                      BEGIN
                      IF (Q = 7 (*WRS*)) AND PACKSTRNG THEN
                         BEGIN
                         CODE[IC] := ZSPWRP ;  ZCNT[ZSPWRP] := ZCNT[ZSPWRP]+1 ;
                         PACKSTRNG := FALSE ;
                         END
                      ELSE
                         BEGIN  CODE[IC] := ZCSP1+Q ;
                         ZCNT[ZCSP1] := ZCNT[ZCSP1]+1 ;
                         END ;
                      IC := IC+1 ;
                      END
                   ELSE
                      BEGIN
                      CODE[IC] := ZCSP ;   CODE[IC+1] := Q ;   IC := IC+2 ;
                      ZCNT[ZCSP] := ZCNT[ZCSP]+1 ;
                      END ;

             END   (* CSP *) ;

          PEQU,PNEQ,PLEQ,PLES,PGEQ,PGRT :
                        BEGIN  READ(INPUT, TCH) ;
                            " CASE CH OF
                              'A': P := 0;
                              'I': P := 1;
                              'C': P := 2;
                              'B': P := 3;
                              'S': P := 4;
                              'R': P := 5;
                              'M' :BEGIN P := 6;
                                     READ(INPUT,CH,Q) ;
                                   END
                              END ; "

                        (* CMPOP[1..6] = 0, 1, 2, 3, 4, 5 *)
                        (* IF ENOUGH UNUSED OPCODES ARE LEFT ,
                        (* THIS MAY BE CHANGED TO A TWO BYTE INST *)
        (*M*)           IF TCH = 'M' THEN (* STRING COMARISON *)
                          BEGIN   READ(CH, Q) ;  CODE[IC] := ZCMPM ;
                          CODE[IC+1] := CMPOP[OP]  "+ P DIV 252" ;
                          CODE[IC+2] := Q DIV 2 ;
                          IF Q >= 512 THEN  ERROR(105 (*STRING TOO LONG*) ) ;
                          IC := IC+3 ;  ZCNT[ZCMPM] := ZCNT[ZCMPM]+1 ;
                          END
                        ELSE
         (*S*)          IF TCH = 'S' THEN
                           BEGIN  CODE[IC] := ZCMPM ;
                           IF OP = PGEQ THEN OP := PLES ;
                           CODE[IC+1] := CMPOP[OP] + 6  ;
                           IC := IC+2 ;   ZCNT[ZCMPRS] := ZCNT[ZCMPRS]+1 ;
                           END
                        ELSE
         (*R*)          IF TCH = 'R' THEN
                           BEGIN  "ERROR(130 (*REAL COMPARE*) )  ;"
                           CODE[IC] := ZCMPM ;
                           CODE[IC+1] := CMPOP[OP] + 10 ; IC := IC+2 ;
                           ZCNT[ZCMPRS] := ZCNT[ZCMPRS]+1 ;
                           END
                        ELSE
         (*A, I, C, B*)    BEGIN
                           I := ZCMPM+CMPOP[OP]+1 ;
                           CODE[IC] := I  ;  IC := IC+1 ;
                           ZCNT[I] := ZCNT[I]+1 ;
                           END ;

                        END; (* EQU, NEQ, GEQ .... *)

          PCHK :        BEGIN  READ(INPUT,DX,DY);  ERROR(141 (* CHK INSTR *) ) ;

                        "  CASE CH OF
                           'I','C': T := INT ;
                           'S':     T := SETT ;
                           'A':     T := ADR ;
                           'J':     T := INDEX
                           END ;    "

                        END;

          PNEW, PSAV :
             BEGIN   Q := 0 ;
                IF OP = PNEW THEN  READ(INPUT, Q) ;
                CODE[IC] := ZNEW ;  CODE[IC+1] := Q ;
                IC := IC+2 ;   ZCNT[ZNEW] := ZCNT[ZNEW]+1 ;
                IF Q > 255 THEN ERROR(146 (* LARGE OPERAND FOR 'NEW' *) ) ;
             END   (* NEW *) ;

          PXJP :
             BEGIN  READ(INPUT, CH, I);  (* LABEL OF THE LOWER BOUND *)
             CODE[IC] := ZLDC ;
             CODE[IC+2] := LABELTAB[I].VAL ;  LABELTAB[I].VAL := IC+2 ;
             CODE[IC+1] := 0 ;
             CODE[IC+3] := ZSBI ;   (* SUBTRACT LOWER BOUND *)
             CODE[IC+4] := ZXJP ;
             CODE[IC+5] := LABELTAB[I+1].VAL ;  LABELTAB[I+1].VAL := IC+5 ;
             CODE[IC+7] := LABELTAB[I+2].VAL ;  LABELTAB[I+2].VAL := IC+7 ;
             CODE[IC+6] := 0 ; (* CASE EXIT LABEL *) ;
             CODE[IC+9] := LABELTAB[I+3].VAL ;   LABELTAB[I+3].VAL := IC+9 ;
             CODE[IC+8] := 0 ;
             IC := IC+10 ;
             ZCNT[ZXJP] := ZCNT[ZXJP]+1 ;  ZCNT[ZSBI] := ZCNT[ZSBI]+1 ;
             ZCNT[ZLDC] := ZCNT[ZLDC]+1
             END (*PXJP*) ;

          PMOV :
             BEGIN  READ(INPUT, Q) ;
             IF PACKSTRNG THEN
                BEGIN
                CODE[IC] := ZMVP ;ZCNT[ZMVP] := ZCNT[ZMVP]+1 ;
                PACKSTRNG := FALSE
                END
             ELSE
                BEGIN  CODE[IC] := ZMOV ; ZCNT[ZMOV] := ZCNT[ZMOV]+1  END ;
             CODE[IC+1] := Q DIV 2 ;
             IC := IC+2 ;
             IF  Q >= 512 THEN  ERROR(114 (* MOVE OPERAND TOO LARGE *) ) ;

             END   (* MOV *) ;

          PABI, PADI, PSBI, PMPI, PNGI, PDVI, PMOD,
          PAND, PIOR, PNOT, PODD, PCHR, PORD,
          PINN, PINT, PUNI, PDIF, PSGS,
          PRST                        :

             BEGIN   Q := ZCNV[OP] ;
             CODE[IC] := Q ;
             IC := IC+1 ;   ZCNT[Q] := ZCNT[Q]+1 ;
             END   (*  NO OPERAND OPCODES *) ;

          PSQI, PSQR :

             ERROR(152 (* INSTRUCTIONS NOT YET IMPLEMENTED *) ) ;


          PABR, PADR, PSBR, PMPR, PDVR,
          PNGR, PFLT, PFLO, PTRC ",PRND" :

             BEGIN
             "ERROR(154 (* REAL ARITHMETIC INSTRUCTIONS *) ) ;"
             CODE[IC] := ZREAL ;   CODE[IC+1] := ZCNV[OP] ;
             IC := IC+2 ;
             ZCNT[ZREAL] := ZCNT[ZREAL+1] ;
             END   (* REAL ARITHMETIC *) ;


          (*+++  END ASSEM2  +++*)

          PTON: TRACE:= TRUE ;

          PTOF: TRACE:= FALSE ;


      END; (*CASE*)

      READLN(INPUT);
      (* STORE INSTRUCTION *)

   "
         IF OP <> PLOC THEN
            BEGIN
            IF TRACE THEN  (* LIST THE OBJECT CODE *)
               BEGIN
               WRITE(OUTPUT, PC:8, LEVEL:5, NAME:5, T:4, P:4, Q:8,
                             '   ### ', OLDIC:6, ' --', IC:5, ' ');
               FOR I := OLDIC TO IC-1 DO WRITE(CODE[I]:4) ;
               WRITELN(OUTPUT) ;
               END ;
            OLDIC := IC ;   PC := PC+1 ;
            END ;  "
      PC := PC+1 ;

   END; (* ASSEMBLE *)
(*------------------------------------------------------------------------*)

BEGIN (*LOAD*)   " TIMER := CLOCK(1) ; "
  WRITELN(OUTPUT, '  < STANFORD P_CODE ASSEMBLER/COMPRESSOR,',
                  ' VERSION OF MARCH 78 >') ;
  WRITELN(OUTPUT) ;
   INIT ;      (* INITIALIZE FOR LOADING THE P_PROGRAM *)

   GENERATE;   (* GENERATE THE P_PROGRAM SEGMENT *)

 " IF TRACE THEN DUMP ; "


 " Q := (CLOCK(1)-TIMER) DIV 100 ;  "
   WRITELN(OUTPUT) ;   WRITELN(OUTPUT, ' ') ;
   WRITELN(OUTPUT,'****', GPC-1:6, GIC:6, ' INSTR./BYTES LOADED.'
            ",    Q DIV 10: 4, '.', Q:1, ' SECONDS IN LOADING.'") ;
"  TIMER := CLOCK(1) ;  "
END; (*LOAD*)


(*------------------------------------------------------------------------*)

BEGIN   (*  MAIN  *)
   RESET(INPUT) ;  REWRITE(OUTPUT) ;  RESET(PRD) ; REWRITE(PRR) ;
   LOAD;  (* ASSEMBLES AND STORES CODE *)

   EXIT(ERRCNT) ;
END (*PCODE_ASSEMBLER*).
