         SYSTEM   SIG7FDP
* READ PROC                                                             APR
* LF     R---     R-,+/-HW OFFSET,INDIRECT ADDR.                        APR  1
RMCF     CNAME    1                                                     APR01
         PROC                                                           APR04
LF       BAL,L1   RDMCF             READ MCF CLUSTER
         SLS,R2   -1                BA(CLOC) TO HA
         DO       NUM(AF(1))                                            APR30
         LW,AF(1) R2                LOAD HA(CLOC)+/- HW OFFSET          APR31
         DO       NUM(AF(2))                                            APR40
         AI,AF(1) AF(2)                                                 APR41
         ELSE                                                           APR42
         AI,AF(1) -1                SET HA(CLOC)-1
         FIN                                                            APR44
         FIN                                                            APR44
         PEND                                                           APR50
* WRITE PROC                                                            APW
* LF     W---     R-,BA(CLOC)+/-BA OFFSET,RETURN                        APW 1
WPOF     CNAME    0                                                     APW00
         PROC                                                           APW03
         DO       NUM(AF(2))                                            APW11
LF       LI,R4    AF(2)             LOAD BA(CLOC)                       APW12
         ELSE                                                           APW13
         DO       NUM(AF(1))                                            APW132
LF       LW,R4    AF(1)             LOAD,SET HA(CLOC) TO BA             APW14
         AW,R4    R4                                                    APW15
         FIN                                                            APW16
         FIN                                                            APW17
         DO       NUM(AF(4))                                            APW840
         B        WRPOF             WRITE POF CLUSTER                   APW841
         ELSE                                                           APW824
         DO       NUM(AF(3))                                            APW821
         LI,L1    AF(3)             LOAD LINK REGISTER                  APW822
         B        WRPOF             TO WRITE  POF  CLUSTER              APW823
         ELSE                                                           APW842
         BAL,L1   WRPOF             WRITE POF CLUSTER                   APW843
         FIN                                                            APW844
         FIN                                                            APW848
         PEND                                                           APW90
* DIAG PROC                                                             APD
DX       CNAME                                                          APD00
         PROC                                                           APD01
* AF     DX       DIAG CODE,LINK                                        APD02
LF       LI,R1    AF(1)             LOAD DIAG CODE                      APD10
         DO       NUM(AF(3))                                            APD241
         B        DIAG              WRITE DMF CLUSTER                   APD242
         ELSE                                                           APD24
         DO       NUM(AF(2))                                            APD20
         LI,L1    AF(2)             LOAD LINK REGISTER                  APD21
         B        DIAG              WRITE DMF CLUSTER                   APD22
         ELSE                                                           APD243
         BAL,L1   DIAG              WRITE DMF CLUSTER                   APD244
         FIN                                                            APD248
         FIN                                                            APD29
         PEND                                                           APD40
* LINK(OR LOAD) AND BRANCH PROC                                         APL
* LF     LAB,L/R  BRANCH ADDRESS,LINK ADDRESS(OR LOAD VALUE)            APL  1
LAB      CNAME                                                          APL01
         PROC                                                           APL04
LF       LI,CF(2) AF(2)             SET LINK REGISTER                   APL12
         B        AF(1)             BRANCH                              APL14
         PEND                                                           APL90
* LOAD,BRANCH AND LINK                                                  PRL
LBAL     CNAME    0                                                     PRL01
         PROC                                                           PRL02
* LF     LBAL,L-  BRANCH,LOAD VALUE,V-                                  PRL09
         DO       NUM(AF(3))                                            PRL20
         LI,AF(3) AF(2)             LOAD VALUE                          PRL22
         ELSE                                                           PRL23
         LI,V0    AF(2)             LOAD VALUE                          PRL24
         FIN                                                            PRL28
         DO       NUM(CF(2))                                            PRL40
         BAL,CF(2) AF(1)            BRANCH                              PRL42
         ELSE                                                           PRL43
         BAL,L1   AF(1)             BRANCH                              PRL44
         FIN                                                            PRL48
         PEND                                                           PRL99
* EXTERNAL REFERENCES
         REF      BAA02             RETURN
         REF      BAA40             SAVE DATA
         REF      PIA00,PIA02,PIA06,PIA08,PIA20,PIA22,PIA26,PIA28
         REF      PII00,PII02,PII20,PII22
         REF      PIL00,PIL02,PIL06,PIL20,PIL22,PIL26
         REF      PID10,PID11,PID12,PID14,PID16,PID18
         REF      PIP00,PIP02,PIP20,PIP22
         REF      PRA00,PRA01,PRA02,PRA04,PRA20,PRA21,PRA22,PRA24
         REF      PRB00,PRB02,PRB06,PRB20,PRB22,PRB26
         REF      PRC06
         REF      PRE00,PRE01,PRE02,PRE20,PRE21,PRE22
         REF      PRF00,PRF02,PRF06
         REF      PRG00,PRG02,PRG06,PRG20,PRG22,PRG26
         REF      PRT00,PRT02,PRT06,PRT20,PRT22,PRT26
         REF      PDB00,PDB02,PDB06
         REF      PDD00,PDD01,PDD02,PDD03,PDD04,PDD06,PDD08
         REF      PDL10,PDL12,PDL16
         REF      PPI10,PPI11,PPI12
         REF      PIY00,PIY01,PIY02,PIY03
         REF      PIY20,PIY21,PIY22,PIY23
         REF      PIY30,PIY31,PIY32,PIY33
         REF      PIZ30,PIZ32
         REF      LRA00,LRA01,LRA02
         REF      LRR00,LRR01,LRR02
         REF      LRD00,LRD01
         REF      LRD10,LRD11,LRD20,LRD21
         REF      LRD40,LRD41,LRD42
         REF      LRD60,LRD61,LRD62,LRD80,LRD81,LRD82
         REF      LRL00,LRL01
         REF      MRR10,MRR11,MRR12
         REF      MRR40,MRR41,MRR42
         REF      MRR60,MRR61,MRR62,MRR80,MRR81,MRR82
         REF      NRR40,NRR41,NRR42
         REF      NRR60,NRR61,NRR62,NRR80,NRR81,NRR82,NRR70
         REF      NRD00,NRD01,NRD02
         REF      ORR03,ORR04,ORR05,ORR06,ORR07,ORR08
         REF      ORD12,ORD22,ORD23,ORD24
         REF      MTL20
         REF      WRPOF
         REF      RDMCF
         REF      PDBS              NO. OF BYTES FOR BASE 4(HALF-WORD)
         REF      PDBX              LINE NO.                            AAC063
         REF      PDBZ              DDB ADCONS
*                                             +3 = WA(DBB BASE)
*                                             +4 = NO. OF DDB'S,
*                                                  WA(DBINDX)
         REF      GTMP              TEMP STG
         REF      GADNO             ADCON NO.
         REF      MCBUF,MDBUF
         REF      JDECP,JDSIZ       DECP,DSIZ
         REF      KBKON
* REGISTER EQUIVALENCES
R0       EQU      0
R1       EQU      1
R2       EQU      2
R3       EQU      3
R4       EQU      4
R5       EQU      5
R6       EQU      6                                                     117
R7       EQU      7                                                     116
V0       EQU      8
V1       EQU      9
V2       EQU      10
L0       EQU      V2                                                    1212
L1       EQU      11                LINK REGISTER
D0       EQU      12                DECA
D1       EQU      13
D2       EQU      14
D3       EQU      15
RE       EQU      4                 EVEN
RO       EQU      5                 ODD
RB       EQU      R6                BIN
RFL      EQU      V0                FLP
RF       EQU      V2                FILE CNTL
RS       EQU      V2                SIGN - EDIT
RC       EQU      L1                %
P1       EQU      V2                PREG 1
SR1      EQU      8                 SR1
SR3      EQU      X'A'              SR3
* BA(D-)
CBD0     EQU      X'30'
CBD1     EQU      X'34'                                                 CBD1
CBD2     EQU      X'38'                                                 CBD2
CBD3     EQU      X'36'                                                 CBD3
* INDEX REGISTERS                                                       CIR
CIR1     EQU      2                                                     CIR1
CIR2     EQU      4                                                     CIR2
CIR3     EQU      6                                                     CIR3
CIR4     EQU      8                                                     CIR4
CIR5     EQU      X'A'                                                  CIR5
CIR6     EQU      X'C'                                                  CIR6
CIR7     EQU      X'E'
* R REGISTERS
CRR1     EQU      X'10'                                                 CR01
CRR2     EQU      X'20'                                                 CR02
CRR3     EQU      X'30'                                                 CR03
CRR4     EQU      X'40'                                                 CR04
CRR5     EQU      X'50'                                                 CR05
CRR6     EQU      X'60'                                                 CR06
CRR7     EQU      X'70'                                                 CR07
CRV0     EQU      X'80'                                                 CR08
CRV1     EQU      X'90'                                                 CR09
CRV2     EQU      X'A0'                                                 CR10
CRL1     EQU      X'B0'                                                 CR11
CRD0     EQU      X'C0'                                                 CR12
CRD1     EQU      X'D0'                                                 CR13
CRD2     EQU      X'E0'                                                 CR14
CRD3     EQU      X'F0'                                                 CR15
CRE      EQU      X'40'             EVEN
CRO      EQU      X'50'             ODD
CRB      EQU      CRR6              BIN
CRFL     EQU      CRV0              FLP
CRF      EQU      CRV2              FILE CNTL
CRS      EQU      CRV2              SIGN - EDIT
CRC      EQU      CRL1              %
CP1      EQU      CRV2              PREG 1
CSR1     EQU      X'80'             SR1                                 CR3
CSR3     EQU      X'A0'             SR3                                 CR3
* OP CODES
CLCI     EQU      X'0220'
CCAL1    EQU      X'0400'           CAL1
CLD      EQU      X'1200'                                               C12
CSTD     EQU      X'1500'
CFAL     EQU      X'1D00'                                               C194
CAI      EQU      X'2000'                                               C20
CLI      EQU      X'2200'           LI                                  C22
CLI1     EQU      X'2210'           LI,1                                C221
CMI      EQU      X'2300'
CSF      EQU      X'2400'                                               C24
CS       EQU      X'2500'                                               C25
CAW      EQU      X'3000'
CSTW     EQU      X'3500'           STW                                 C35
CLW      EQU      X'3200'                                               C32
CSTS     EQU      X'4700'           STS                                 C47
CEOR     EQU      X'4800'           EOR                                 C48
CSAS     EQU      X'400'            RA SETING - SAS                     C484
CSDA     EQU      X'500'            RA SETTING - SAD                    C485
COR      EQU      X'4900'           OR                                  C49
CAND     EQU      X'4B00'
CLAH     EQU      X'5B00'
CMBS     EQU      X'6100'
CBDR     EQU      X'6400'                                               C64
CEXU     EQU      X'6700'                                               C67
CBR      EQU      X'6800'           B                                   C68
CBLE     EQU      X'6820'           BLE,BLEZ                            C682
CBEZ     EQU      X'6830'           BEZ                                 C683
CBAZ     EQU      X'6840'           BAZ                                 C684
CBL      EQU      X'6910'           BL                                  C691
CBNE     EQU      X'6930'           BNE,BNEZ
CBAL     EQU      X'6AB0'           BAL,L1
CLB      EQU      X'7200'                                               C72
CSTB     EQU      X'7500'                                               C75
CPACK    EQU      X'7600'                                               C76
CUNPK    EQU      X'7700'
CDSA     EQU      X'7C00'
CDL      EQU      X'7E00'                                               C795
CDST     EQU      X'7F00'
CIND     EQU      X'8000'           INDIRECT BIT                        C900
* POF CLUSTER CLNG,CNTL
* INSTRUCTION TYPE
DAIA     EQU      X'0401'           CONSTANT
DAID     EQU      X'0609'           DATA
DAII     EQU      X'0402'           INTERNAL LABEL
DAIL     EQU      X'0406'           LOC. CNTR
DAIP     EQU      X'0404'           PAR/SEC NAME
DAIX     EQU      X'0108'           XREF
* DATA REFERENCE
DARA     EQU      X'0410'           ADCONS
DARB     EQU      X'0417'           BRANCH TABLE
DARE     EQU      X'0415'           EXIT TABLE
DARF     EQU      X'41A'            FILE LABEL
DARG     EQU      X'0414'           GLOBAL LITERALS
DARL     EQU      X'0418'           LOCAL LITERALS
DART     EQU      X'0417'           TEMP STG
* DATA DEF
DADB     EQU      X'0621'           BINARY
DADD     EQU      X'0829'           DATA REF
DADL     EQU      X'0626'           LOC. CNTR
* DEFINITIONS/DECLARATIONS
DADX     EQU      X'0328'           EXTERNAL NAME
DAPI     EQU      X'0341'           INTERNAL LABEL
* GLOBAL LITERAL WA DISPL - BASE 4
DGDZ     EQU      4                 D'+0'
DGD1     EQU      3                 D'+1'
DGFZ     EQU      6                 FL'0.E8'
* GLOBAL LITERAL BA DISPL - BASE 4
DGZRO    EQU      0                 ZERO
DGSPC    EQU      1                 SPACE
DGQUO    EQU      2                 QUOTE
DGLV     EQU      3                 LOW-VALUE
DGHV     EQU      4                 HIGH-VALUE
DGAST    EQU      6                 ASTERISK
* REGISTER SAVE LEVELS
DSS      EQU      1                 SUBSCRIPT
DSL      EQU      2                 STORE
DSG      EQU      4                 GENERATOR
* TEMP REGISTER SAVE AREAS
DTB      EQU      9                 BIN
DTF      EQU      18                FLP
DTCSX    EQU      20                CORRESPONDING SXR1,SXR2
DTD1     EQU      10                DECA - SUBSCRIPT
DTD2     EQU      14                DECA - STORE
DTD4     EQU      22                DECA - GENERATORS
*
* ENTRY POINTS
         DEF      LIT00
         DEF      LIT05
         DEF      LIT340            WRITE POOL
         REF      MCLIT,MCLIT1,MLBUF
         PAGE
LIT05    RES      0                 BINARY IN D3,NO CLUSTER
         STW,R2   NOAC                 FLAG IT
LIT00    RES      0                 LITERAL POOLER FOR 4.2
         LCI      D3                ALL REGS SAVED EXCEPT R2 AND R5
         STM,R1   SREG                  (RESET TO FAKE DATA CLUSTER)
*
         BAL,L1   LIT200            ADD LITERAL TO POOL
         BAL,L1   LIT50             BUILD FAKE DATA CLUSTER
         LCI      D2
         LM,R1    SREG
         B        *L1
         PAGE
LIT50    RES      0                 BUILD FAKE DATA CLUSTER
         LW,D3    FDWRD             LOAD BASE,DISPL
         LCW,V0   NOAC              CF SPECIAL BINARY
         BEZ      LIT52             NO
* SPECIAL BINARY
         AWM,V0   NOAC              LOWER FLAG
         B        *L1
LIT52    RES      0
         LW,V0    TYPE
         CI,V0    2                 CF 'ALL 1 CHAR' AN LITERAL
         BNE      LIT60             NO.
* ALL '1 CHAR'
         LH,V0    1,R5                 OPTONS
         STW,V0   MLBUF
         LI,R2    HA(MLBUF)         SET HA REG
         LI,R5    HA(MLBUF)-1
         STW,R2   SREG+1
         STW,R5   SREG+4
         LI,V0    1                 TYPE = AN
*
LIT60    RES      0                 NUMERIC PACKED DECIMAL
         AI,V0    X'980'            SET CLNG,CNTL
         STH,V0   0,R2
         STH,D3   2,R2              SET DISPL
         B        *L1
         PAGE
LIT200   RES      0             ****ADD A LITERAL TO POOL
*                                   CALLING SEQUENCE
*                                       BAL,L1   LIT200
*                                   ANSWER
*                                       D3 = STARTING BYTE ADDRESS
*                                   REGS SAVED - R2, R5
*
         LCI      10
         STM,6    LINK1
         LI,R3    1                 INIT INDEX
         LH,V0    MCLIT+1           INIT BASE,DISPL
         SLS,V0   8
         STH,V0   FDWRD,R3
         LH,V0    0,R2              GET TYPE
         AND,V0   K30F              MASK 'F'
         STW,V0   TYPE              SAVE IT
         CW,R2    NOAC              CF BINARY ENTRY
         BE       LIT220            YES
* N LIT
         CI,V0    8
         BAZ      LIT203            AN LIT OR 1 CHAR LIT (1 OR 2)
         CI,V0    4
         BANZ     LIT275            BINARY OR INDEX (C OR D)
         CI,V0    2
         BAZ      LIT215            NUM LIT-PACKED DEC OR UNSIGNED (8/9)
         MTW,-2   TYPE              A/B TO 8/9
         B        LIT215            ONE OR +1 (A OR B)
* AN LIT
LIT203   CI,V0    2
         BL       LIT235            AN LIT
         BE       LIT210
*
* ALL '> 1 CHAR'
         MTW,-2   TYPE              TYPE = AN
         LI,V0    0
         LH,V1    3,R5
         CH,V1    3,R2              CF REPEATED ALL
         BLE      LIT235+1          NO.
* REPEATED ALL
         LH,V2    3,R2
*                                   COMPUTE RECLNG/LITLNG
         DW,V0    V2                   K(LITLENG) + R
         CI,V0    0
         BEZ      LIT204            EVEN MULTIPLE
* NOT EVEN MULTIPLE
         AI,V1    1
         SW,V2    V0                DSIZ = DSIZ+BSIZ-R
         AH,V2    3,R5
         STH,V2   3,R5
LIT204   RES      0
         STW,V1   KNT
         LH,R4    MCLIT+1,R3        BA DISPL
         AWM,R4   FDWRD
LIT205   RES      0
         LI,V0    0
         BAL,L1   LIT300            CF ENUF ROOM
         B        %+2
         BAL,L1   LIT250
         MTW,-1   TYPE              TYPE </= 0
         MTW,-1   KNT               K = K-1
         BNEZ     LIT205            REPEAT
         LI,V1    1                 TYPE = 1
         STW,V1   TYPE
         LH,V2    3,R5              BSIZ = DSIZ
         STH,V2   3,R2
         B        LIT260
* ALL '1 CHAR'
LIT210   RES      0                 INSERT 1 CHAR INTO POOL, SAVE
         LI,V0    0
         BAL,L1   LIT400            CF DUPLICATE
         BEZ      LIT260               YES
         LI,V0    0
         BAL,L1   LIT300            CF ENUF ROOM
         B        LIT260               NO, ALREADY ADDED
         LH,R4    MCLIT+1,R3        BA DISPL
         LH,V1    1,R2              BYTE
         SLS,V1   -8
         STB,V1   MCLIT+2,R4        STORE IT
         AWM,R4   FDWRD             SET DISPL
         MTW,1    MCLIT+1           INCR POOL SIZE
         B        LIT260
*
LIT215   RES      0                 PROCESS A TYPE 96
         LI,R3    X'F'
         EOR,R3   R6
         CI,R3    -4
         BANZ     LIT233            NO CONVERSION
* CONVERSION
         STW,R6   TYPE              CONVERT TYPE
         LW,R4    R2                DECIMAL LOAD
         AI,R4    8                    1)BYTE ADDRESS TO R4
         SLS,R4   1
         LH,V0    3,R2                 2) GET INSTRUCTION FORMAT
         SLS,V0   16                       FOR DL,X 0.R4
         EXU      V0
         LH,V0    3,R5
         SLS,V0   -1
         AI,V0    1
         STH,V0   3,R2              EQUALS BSIZ
         LH,V2    4,R5
         LI,V0    R2                RECEIVING REGISTERS R6 AND R7
         SLS,V0   16
         OR,V2    V0
         EXU      LIT230,R3
         CI,R3    0                 CF FLS
         BNEZ     LIT221            YES
* FLL
         LI,R3    1
         LI,V0    2
         BAL,L1   LIT400            CF DUPLICATE
         BEZ      LIT260               YES
         LI,V0    2
         BAL,L1   LIT300            CF ENUF ROOM
         B        LIT260               NO, ALREADY ADDED
         LH,R4    MCLIT+1,R3        DA OFFSET
         AI,R4    15
         SLS,R4   -3
         STD,R6   MCLIT,R4          STORE VALUE
         SLS,R4   3                 BA OFFSET
         STH,R4   MCLIT+1,R3        UPDATE NCHR
         AI,R4    -8                SET DISPL
         AWM,R4   FDWRD
         B        LIT260                 OUT
* BIN ENTRY
*                        D3 = BIN VALUE
LIT220   RES      0
         LW,R6    D3                LOAD BIN VALUE
*FLS/BIN/INDEX
LIT221   RES      0
         LI,R3    1
         LI,V0    1
         BAL,L1   LIT400            CF DUPLICATE
         BEZ      LIT260               YES
         LI,V0    1
         BAL,L1   LIT300            CF ENUF ROOM
         B        LIT260               NO, ALREADY ADDED
         LH,R4    MCLIT+1,R3        WA OFFSET
         AI,R4    7
         SLS,R4   -2
         STW,R6   MCLIT+1,R4        STORE VALUE
         SLS,R4   2                 BA OFFSET
         STH,R4   MCLIT+1,R3        UPDATE NCHR
         AI,R4    -4                SET DISPL
         AWM,R4   FDWRD
         B        LIT260
*
LIT230   RES      0                 CF BIN CONV. WANTED
         BAL,L1   C:CDF             FLL
         BAL,L1   C:CDE             FLS
         BAL,L1   C:CDB             BIN
         BAL,L1   C:CDB             INDEX
*
LIT233   LH,V0    3,R5              DSIZ
         SLS,V0   -1                   DIVIDED BY 2
         AI,V0    1                    PLUS
         STH,V0   3,R2                 EQUALS BSIZ
*
*  THE FOLLOWING 4 INSTRUCTIONS FORCE DECIMAL LITERALS TO WORD BOUNDARIE
         LW,V0    MCLIT+1           FORCE DECIMAL LITERAL
         AI,V0    3                   TO THE
         AND,V0   L(X'FFFFFFFC')      NEXT WORD BOUNDARY
         STW,V0   MCLIT+1             AND STORE THE NEW DISPLACEMENT
*
LIT235   RES      0
         LI,V0    0
         BAL,L1   LIT400            CF DUPLICATE
         BEZ      LIT260               YES
         LI,V0    0
         BAL,L1   LIT300            CF ENUF ROOM
         B        LIT260               NO, ALREADY ADDED
         LH,R4    MCLIT+1,R3        BA DISPL
         AWM,R4   FDWRD
         LI,L1    LIT260            SET LINK
*
LIT250   RES      0                 INSERT STRING OF CHARS INTO POOL,
         LW,D0    R2                UPDATE BYTE POINTER
         SLS,D0   1                     LINK THRU L1
         LH,D1    MCLIT+1,R3        SINK
         AI,D1    BA(MCLIT)+8
         LH,V0    3,R2              BSIZ
         STB,V0   D1
         MBS,D0   16                LIT TO POOL
         AWM,V0   MCLIT+1           INCR POOL SIZE
         B        *L1
LIT260   RES      0
         LCI      10
         LM,6     LINK1
         B        *L1
*
LIT275   RES      0
         LH,R6    5,R5
         LH,R4    4,R2
         STH,R4   R6
         B        LIT221
         PAGE
LIT300   RES      0                 CHECK FOR ROOM IN BUFFER
*   INPUT
*        BAL,L1   LIT300
*
*        WHERE    V0 = 0 CHAR
*                      = 1 WORD
*                      = 2 DOUBLE WORD
*
         LCI      10
         STM,6    LINK2
         LCH,D0   MCLIT+1,R3        LOAD -NCHR
         AI,D0    X'100'
         BNEZ     LIT302            NOT FULL
* FULL
         CI,V0    0                 CF TYPE
         BG       LIT315            WORD/DW
         LW,D3    TYPE
         BGZ      LIT315            NOT REPEATED ALL
* REPEATED ALL
         LAB,L0   LIT340,LIT320     WRITE POOL
LIT302   RES      0
         STW,D0   LEFT
         CI,V0    1                 CF TYPE OF CHECK WANTED
         BE       LIT310               WORD
         BG       LIT330               DOUBLE WORD
         LW,V0    TYPE
         CI,V0    2
         BE       LIT320            ALL '1 CHAR'
* AN
         SH,D0    3,R2              J-BSIZ
         BGEZ     LIT320
         LH,D3    MCLIT+1,R3
         CI,V0    0                 CF REPEATED ALL
         BLEZ     LIT304            YES
* NOT REPEATED ALL
         AWM,D3   FDWRD             SET DISPL
LIT304   RES      0
         AI,D3    BA(MCLIT)+8       BEGINNING OF POOL
         LW,D2    R2                SOURCE
         SLS,D2   1
         LW,D1    LEFT
         STB,D1   D3
         MBS,D2   16                MOVE STRING
         BAL,L0   LIT340            WRITE BUFFER
         LCW,D0   D0                REMAINING CHAR
         LI,D3    BA(MCLIT)+8       BA REMAINDER
         STB,D0   D3
         MBS,D2   16                MOVE REMAINDER
         STH,D0   MCLIT+1,R3        SET NCHR
         B        LIT325
LIT310   RES      0
         CI,D0    4                 WORD CHECK
         BGE      LIT320            FIT
LIT315   BAL,L0   LIT340            WRITE BUFFER
         STH,V0   FDWRD,R3          NEW DISPL
* FIT
LIT320   RES      0
         MTW,1    LINK2+5           +1 RETURN
LIT325   LCI      10                RETURN
         LM,6     LINK2
         B        *L1
*
LIT330   RES      0
         CI,D0    8                 DW CHECK
         BGE      LIT320            FIT
         B        LIT315
*
* WRITE FULL LIT BUFFER
*                        R3 = 1
*                        R4,V0,V1,L1 VOLATILE
*                        L0 = LINK REGISTER
*                        V0 = NEXT BUFFER DISPL ON EXIT
LIT340   RES      0
         LI,R4    255               SET MAX NCHR
         STH,R4   MCLIT+1,R3
         LB,V0    MCLIT+2,R4        LOAD,STORE LAST BYTE
         STB,V0   MCLIT1-62,R4
         LH,V0    MCLIT+1           SET DISPL
         STB,V0   MCLIT1+1
         LI,V1    X'84'             INITIALIZE LITERAL POOL CLNG
         STH,V1   MCLIT
         WPOF     ,BA(MCLIT)+1      WRITE MCLIT
         WPOF     ,BA(MCLIT1)
         LI,V0    X'FF01'           UPDATE DISPL
         AWM,V0   MCLIT+1
         LW,V0    MCLIT+1           LOAD DISPL
         SLS,V0   -8
         B        *L0
         PAGE
LIT400   RES      0                 CHECK POOL FOR LAREADY EXISTING
*                                     LITERAL
*                                         CALLING SEQUENCE--
*                                           BAL,L1    LIT400
*                                         WHERE-
*                                          V0 = 0  CHAR
*                                             = 1  WORD
*                                             = 2  DOUBLE WORD
*                                        RESPONSE-
*                                           ALL REGISTERS SAVED
*                                            EXCEPT V0
*
*                                         V0 = 0    LITERAL FOUND
*                                            = 45   LITERAL NOT FOUND
*
         LCI      10
         STM,6    LINK2
         LI,R3    1                 LOAD OFFSET
         LH,R4    MCLIT+1,R3
         CI,V0    1                 CF TYPE OF CHECK WANTED
         BE       LIT405               WORD
         BG       LIT425               DOUBLE WORD
         LW,V1    TYPE                 CHARACTER
         CI,V1    2                 CF ALL '1 CHAR'
         BE       LIT460
         LH,V0    3,R2              NO OF CAARS IN LITERAL
*                                      CF 2 CHARS
         CI,V0    2
         BE       LIT435                  YES
         CI,V0    4                    CF 4 CHARS
         BE       LIT445                  YES
         CI,V0    8
         BE       LIT450               CF 8 CHARS
         CI,V0    1                 CF 1 CHAR
         BE       LIT461            YES
         B        LIT430+1          NO
* WORD CHECK
*                        R6 = WORD
LIT405   RES      0
         SLS,R4   -2                WA OFFSET
LIT406   RES      0
         AI,R4    -1                CHECK FOR E-O-POOL
         BLZ      LIT417            E-O-POOL
         CW,R6    MCLIT+2,R4        CF DUPLICATE WORD
         BNE      LIT406            NO.
* FOUND WORD
LIT408   RES      0
         SLS,R4   2                 WA TO BA OFFSET
LIT415   RES      0                 FOUND IT, ANSWER WITH V0=0
         AWM,R4   FDWRD             SET DISPL
         LI,R6    0
         STW,R6   LINK2+2
         B        LIT420
*
LIT417   RES      0                 NOT FOUND, ANSWER WITH V0=X'45'
         LI,R6    X'45'
         STW,R6   LINK2+2
*
LIT420   RES      0                 RESTORE REGISTERS AND RETURN
         LCI      10
         LM,6     LINK2
         CI,V0    0                 SET CC
         B        *L1
* DOUBLE-WORD
*                        R6,R7 = DOUBLE-WORD
LIT425   RES      0
         SLS,R4   -3                DA OFFSET
LIT426   RES      0
         AI,R4    -1                CHECK FOR E-O-POOL
         BLZ      LIT417            E-O-POOL
         CD,R6    MCLIT+2,R4        CF DUPLICATE DOUBLE-WORD
         BNE      LIT426            NO.
* FOUND DOUBLE-WORD
LIT428   RES      0
         SLS,R4   3                 DA TO BA OFFSET
         B        LIT415
*
LIT430   RES      0                 BYTE CHECK
         LH,R4    MCLIT+1,R3        LOAD NCHR
*                        R4 = NCHR
*                        V0 = BSIZ
         SW,R4    V0                NCHR = NCHR-BSIZ
         LW,V1    R2                BA LITERAL STRING
         AW,V1    V1
         AI,V1    16
         STB,V0   V1                BSIZ
         LI,R6    0
LIT431   RES      0
         CW,R6    R4                CF E-O-POOL
         BG       LIT417            YES
         LW,R7    V1                LOAD ODD REGISTER
         CBS,R6   BA(MCLIT)+8       COMPARE STRING
         BE       LIT432            FOUND
* NOT FOUND
         CW,R7    V1                CF FIRST
         BNE      LIT431            NO.
         AI,R6    1
         B        LIT431
*FOUND
LIT432   LW,R4    R6                OBTAIN BA DISPL
         SW,R4    V0
         B        LIT415
*
LIT435   RES      0                 HALF WORD CHECK FO CHARS
         LH,R7    4,R2
         SLS,R4   -1                HA OFFSET
LIT436   RES      0
         AI,R4    -1                CHECK FOR E-O-POOL
         BLZ      LIT430            E-O-POOL
         CH,R7    MCLIT+2,R4        CF DUPLICATE HALF-WORD
         BNE      LIT436            NO.
* FOUND HALF-WORD
         SLS,R4   1                 HA TO BA OFFSET
         B        LIT415
*
LIT445   RES      0                 WORD CHECK OF CHARS
         LH,R7    4,R2              LOAD WORD (BY HALVES) INTO R6
         LH,R6    5,R5
         STH,R7   R6
         SLS,R4   -2                WA OFFSET
LIT446   RES      0
         AI,R4    -1                CHECK FOR E-O-POOL
         BLZ      LIT430            E-O-POOL
         CW,R6    MCLIT+2,R4        CF DUPLICATE WORD
         BNE      LIT446            NO.
* FOUND WORD
         B        LIT408
*
LIT450   RES      0                 DOUBLE WORD CHECK OF CHARS
         LH,R7    4,R2              LOAD DOUBLE (BY HALVES) INTO R6,R7
         LH,R6    5,R5
         STH,R7   R6
         LH,V1    5,R2
         LH,R7    6,R5
         STH,V1   R7
         SLS,R4   -3                DA OFFSET
LIT451   RES      0
         AI,R4    -1                CHECK FOR E-O-POOL
         BLZ      LIT430            E-O-POOL
         CD,R6    MCLIT+2,R4        CF DUPLICATE DOUBLE-WORD
         BNE      LIT451            NO.
* FOUND DOUBLE-WORD
         B        LIT428
*
LIT460   RES      0                 ALL '1 CAR' AN LITERAL
         LH,V0    1,R2
         B        LIT462
LIT461   RES      0
         LH,V0    4,R2              LOAD CHAR
LIT462   RES      0
         SLS,V0   -8
LIT463   RES      0
         AI,R4    -1
         BLZ      LIT417            E-O-POOL
         CB,V0    MCLIT+2,R4        CF DUPLICATE
         BE       LIT415            FOUND
         B        LIT463
         PAGE
*
*   CONSTANTS AND TEMP STORAGE
*
SREG     RES      16
LINK1    RES      10
LINK2    RES      10
FDWRD    GEN,8,24 X'08',0
TYPE     DATA     0                 TYPE OF LITERAL
KNT      DATA     0                 TEMP SAVE
LEFT     DATA     0                 ROOM LEFT IN POOL BEFORE LITERAL
*                                      INPUT
SOURCE   DATA     0                 TEMP SAVE
NOAC     DATA     0                 ZERO=LIT00,NON-ZERO=LIT05
* *** LITPAT(CH AREA) DELETED *****
         PAGE
B1       EQU      1
B2       EQU      2
B3       EQU      3
B4       EQU      4
B5       EQU      5
B6       EQU      6
B7       EQU      7
B8       EQU      8
B9       EQU      9
B10      EQU      10
K30F     EQU      KBKON+2
K3FF     EQU      KBKON+4
K2FFFF   EQU      KBKON+5
PSWD     RES      1                 CONDITION CODE
STREGS   RES      11                SAVE REGISTERS
SVDSA    RES      1                 COUNT FOR DSA
DECPS    RES      1                 DECP
RREG     RES      1                 RREG
ADJSTE   RES      1                 ADJUST E VALUE
         BOUND    8
POTSF    DATA     X'7F235FAD'       10**75
         DATA     X'D81C2813'
POTMU    DATA     X'59C9F2C9'       10**30
         DATA     X'CD046740'
         DATA     X'45186A00'       10**5
         DATA     X'00000000'
         DATA     X'41A00000'       10
         DATA     X'00000000'
POTSB    DATA     X'662CD76F'       10**45
         DATA     X'E086B935'
         DATA     X'7B172EBA'       10**70
         DATA     X'D6DDC733'
POTSN    DATA     X'7E389916'       10**74
         DATA     X'26937352'
         DATA     X'7E71322C'       2X10**74
         DATA     X'4D26E6A4'
         DATA     X'7EE26458'       4X10**74
         DATA     X'9A4DCD48'
         DATA     X'7F1C4C8B'       8X10**74
         DATA     X'1349B9A9'
MAXTST   DATA     X'7F199999'       FOR OVER FLOW TEST
         DATA     X'99999999'
BITWD    DATA     X'FF000000'
TENSEV   DATA     10000000          10**7
DECFIF   DATA     X'0065536C'       2**16
CVTBL    DATA     8000000           CONVERSION TABLE
         DATA     4000000
         DATA     2000000
         DATA     1000000
         DATA     800000
         DATA     400000
         DATA     200000
         DATA     100000
         DATA     80000
         DATA     40000
         DATA     20000
         DATA     10000
         DATA     8000
         DATA     4000
         DATA     2000
         DATA     1000
         DATA     800
         DATA     400
         DATA     200
         DATA     100
         DATA     80
         DATA     40
         DATA     20
TEN      DATA     10
         DATA     8
         DATA     4
         DATA     2
         DATA     1
         DATA     0
         DATA     0
         DATA     0
         DATA     0
SUBPOT   CD,B8    POTSB,B3
MULPOT   FML,B8   POTMU,B3
SUBEXP   AI,B10   1
         AI,B10   5
         AI,B10   30
GETDIGC  LI,B1    8
         LI,B1    8
         LI,B1    8
         LI,B1    7
*     ** SET PSWD FOR RESET CONDITION CODE
LDCF     LCF      PSWD              RESET CONDITION CODE
         B        *11
STCFP    LI,B3    X'20'             SET CONDITION CODE-POSITIVE
         STB,B3   PSWD
         B        *B7
STCFN    LI,B3    X'10'             NEGATIVE
         B        STCFP+1
STCFZ    LI,B3    0                 ZERO
         B        STCFP+1
SCFBO    LI,B3    X'40'             OVERFLOW
         B        STCFP+1
C:CBF2   LCI      11
         LM,1     STREGS
         B        LDCF
*     ** PACKED DECIMAL TO FLOATING
*        INPUT-PACKED DECIMAL IN DECA, DECP AND SREG IN R10
*        OUTPUT-FLS, FLL IN RREG
C:CDE    LCI      11                SHORT
         STM,1    STREGS
         STH,B10  DECPS
         AI,B10   X'40000'
         STW,B10  RREG
         LH,B10   DECPS
         BAL,11   TENHEX
         LH,B4    RREG
         STW,B8   STREGS-1,B4
         B        C:CBF2
C:CDF    LCI      11                LONG
         STM,1    STREGS
         STH,B10  DECPS
         AI,B10   X'40000'
         STW,B10  RREG
         LH,B10   DECPS
         BAL,11   TENHEX
         LH,B4    RREG
         LCI      2
         STM,B8   STREGS-1,B4
         B        C:CBF2
TENHEX   LI,B2    0                 DEC TO FLOATING
         LI,B3    0
         LFI      0
         EXU      GETDIGC,B2
         LI,B4    0
         LW,B5    12,B2
         SLD,B4   4
         CI,B4    0
         BCS,3    FNDFRC
         AI,B3    1                 SUPRESS LEADING ZERO
         BDR,B1   %-4
         CI,B3    31
         BCS,3    %+5
         LI,B8    0
         LI,B9    0
TENHEX1  BAL,B7   STCFZ
         B        *11
         AI,B2    1
         B        TENHEX+3
FNDFRC   LW,B8    B4                INITIALIZE FLOATING
         LI,B9    0
         SLD,B8   -4
         LI,B8    X'41'
         SLD,B8   24
FNDFRC1  AI,B3    1                 CHECK NUMBER OF DIGITS PROCESSED
         CI,B3    31
         BCR,3    EXPROC
         BDR,B1   FNDFRC2
         AI,B2    1
         EXU      GETDIGC,B2
         LW,B5    12,B2
FNDFRC2  FML,B8   POTMU+4           NEXT DIGIT
         LI,B4    0
         SLD,B4   4
         LW,B6    B4
         BCR,3    FNDFRC1
         LI,B7    0
         SLD,B6   -4
         LI,B6    X'41'
         SLD,B6   24
         FAL,B8   B6
         B        FNDFRC1
EXPROC   CI,B10   0
         BCR,3    EXPROC1
         BCS,2    EXPROC2
         FML,B8   POTMU+4           NEGATIVE DECP
         BIR,B10  %+2
         B        EXPROC1
         CD,B8    MAXTST
         BCS,1    EXPROC+3
         BAL,B7   SCFBO
         B        *11
EXPROC1  LI,B4    X'F'              CHECK SIGN
         AND,B4   15
         CI,B4    X'D'
         BCR,3    %+3
         BAL,B7   STCFP
         B        *11
         LCD,B8   B8
         BAL,B7   STCFN
         B        *11
EXPROC2  FDL,B8   POTMU+4           POSITIVE DECP
         BCR,3    TENHEX1
         BDR,B10  %-2
         B        EXPROC1
*     ** PACKED DECIMAL TO BINARY
*        INPUT-PACKED DECIMAL IN DECA, DECP IN R10
*        OUTPUT-BINARY IN RREG
C:CDB    LCI      11                DECIMAL TO BINARY
         STM,1    STREGS
         STH,B10  DECPS
         AI,B10   X'40000'          FIND ACTUAL REGISTER
         STW,B10  RREG
         LH,B10   DECPS
         LCW,B1   B10
         DSA      *B1
         BCR,4    %+3
DECBIN   BAL,B7   SCFBO             OVERFLOW
         B        C:CBF2
         LW,B2    12                CHECK R12
         BCS,3    DECBIN
         LW,B2    13                CHECK R13
         BCS,2    DECBIN
         LW,B5    14
         CI,B5    532
         BCS,2    DECBIN
         SLS,B5   4
         CVA,B4   CVTBL             CONVERT R14
         LW,B7    B4
         MW,B6    TENSEV
         CI,B6    0
         BCS,3    DECBIN
         LW,B5    15
         CVA,B4   CVTBL             CONVERT R15
         AW,B4    B7
         BCS,4    DECBIN
         BCS,3    %+3
         BAL,B7   STCFZ
         B        DECBIN1
         LI,B3    X'F'
         AND,B3   15
         CI,B3    X'D'
         BCR,3    %+3
         BAL,B7   STCFP
         B        %+3
         LCW,B4   B4
         BAL,B7   STCFN
DECBIN1  LH,B3    RREG              STORE RESULT
         STW,B4   STREGS-1,B3
         B        C:CBF2
         END
