         SYSTEM   SIG7FDP
         TITLE    'VPROC - VALUE PROCESSER'
R1       EQU      1
R2       EQU      2
R3       EQU      3
R4       EQU      4
R5       EQU      5
R6       EQU      6
R7       EQU      7
R8       EQU      8
R9       EQU      9
R10      EQU      10
R11      EQU      11
R12      EQU      12
R13      EQU      13
R14      EQU      14
R15      EQU      15
DLORG    EQU      PDBZ
         DEF      VPROC
         REF      BASE4DSP
         REF      CARDNO
         REF      DIAG
         REF      DLPNTR
         REF      M:LO
         REF      PDBZ
         REF      RDIVF
         REF      WRPOF
VPROC    STW,R11  VPEXIT            VALUE PROCESSOR
         LCI      10
         STM,R1   VPTEMP
         LW,R3    DLORG             INITIALIZE DICT POINTER
         STW,R3   VDPNTR
VP10     LW,R4    L(X'FFFFFF')
         AND,R4   *VDPNTR           IS DICT. SYN. LNK. EMPTY?
         BNEZ     VP30               NO
VP20     LW,R3    DLPNTR             YES - VALUE NOT ON DATA ENTRY
         CW,R3    VDPNTR            HAVE ALL ENTRIES BEEN EXAMINED
         BE       VP500              YES - EXIT
         LB,R3    *VDPNTR            NO - ADVANCE TO NEXT ENTRY
         STW,R3   PREVDEL           SAVE DATA ENTRY LENGTH
         AWM,R3   VDPNTR
         LI,R1    0
         STW,R1   PL88
         B        VP10
VP30     BAL,R11  RDIVF             GET NEXT IVF ENTRY
         AI,R2    1                 IS IVF VALUE SEQ. NO. EQUAL TO
         LW,R3    L(X'2000012')      VALUE SEQ. NO. IN SYN. LNK. FIELD
         LW,R4    *VDPNTR            OF CURRENT DICT. ENTRY?
         CBS,R2   0
         BE       VP50               YES
         BG       VP40               NO - SERIOUS ERROR
         BAL,R11  RDIVF             IVF LESS THAN SYN. LNK.  GET NXT IVF
         BLZ      VP510              END OF IVF - FORGET IT
         B        VP30+1             TRY AGAIN
VP40     LW,R3    DLPNTR            IVF GREATER THAN SYN. LNK.
         CW,R3    VDPNTR
         BE       VP520             NO MORE DICT. ENTRIES
         LB,R3    *VDPNTR
         AWM,R3   VDPNTR            GET NEXT DICT ENTRY
         LB,R4    R3                GET CHAR COUNT FROM CBS
         CI,R4    2
         BE       VP30+2            UNEQUAL 1ST CHARS. - R2 NOT CHANGED
         AI,R2    -1                2ND CHAR. MISMATCH - RESET R2
         B        VP30+2
VP50     LI,R7    1                 SAVE SOURCE LINE NO. AND SUB
         LW,R3    *VDPNTR,R7         FOR POSSIBLE DIAGNOSTIC MESSAGES
         XW,R3    CARDNO                                                VPROC
         STW,R3   LINENOS                                               VPROC
         LI,R7    8
         LB,R3    *VDPNTR,R7        IS CURRENT DICT. ENTRY
         CI,R3    88                A LEVEL 88 ITEM?
         BE       VP55               YES
         LI,R5    0
         STW,R5   CONTCODE           NO - RESET CONTINUATION CODE
         STW,R5   PL88               AND COND. NAME DICT. POINTER
         B        VP150
VP55     LW,R3    VP88FLG           IS THIS 1ST VALUE IN 88 ENTRY
         BEZ      VP60               YES
         MTW,4    VPLIP              NO - INCREMENT LITERAL INFO. PNTR.
         LW,R5    VPLIP
         B        VP70
VP60     LW,R5    PL88              IS COND. NAME DICT. POINTER SET?
         BNEZ     VP65               YES
         LW,R6    VDPNTR             NO - COMPUTE ADDRESS OF COND. NAME
         SW,R6    PREVDEL            DICT. ENTRY AND SAVE FOR POSSIBLE
         STW,R6   PL88               LATER USE IN ALIGN SUBROUTINE
VP65     LW,R5    VDPNTR            SET LITERAL INFO. PNTR. TO 1ST LIT.
         AI,R5    6                  INFO. ENTRY IN 88 DICT. ENTRY
         SLS,R5   2
         LI,R7    3                 1ST LIT. INFO. ENTRY ADDRESS =
         LI,R6    X'F'               BEGINNING ENTRY ADDRESS + 6 +
         AND,R6   *VDPNTR,R7         SPACE OCCUPIED BY FACTORS
         SLS,R6   1
         AW,R5    R6
         STW,R5   VPLIP
         STW,R2   VP88FLG           SET COND. NAME FLAG
VP70     AI,R2    1
         LB,R3    0,R2              GET CONTINUATION CODE
         STW,R3   CONTCODE
         CI,R3    1
         BL       VP80              LAST OR ONLY LITERAL
         BG       VP100             MORE LITERALS FOLLOW
         LI,R4    X'40'             1ST OF LITERAL PAIR IN RANGE TEST
         B        VP90              SET UB BIT IN CURRENT LIT INFO ENTRY
VP80     LI,R4    X'80'             SET UA BIT
VP90     STB,R4   0,R5
VP100    AI,R2    -1
         LB,R3    0,R2              GET VALUE TYPE IN IVF
         AND,R3   L(X'F0')
         CI,R3    X'B0'
         BE       VP110             STRING
         BG       VP130             NUMBER
         LB,R3    0,R5              FIGURATIVE CONSTANT, BY DEFAULT
         OR,R3    L(X'8')           SET BIAS OF 8 IN UD TO INDICATE
         STB,R3   0,R5               FIG. CONS. COMPARISON
         LB,R3    0,R2              GET FIGURATIVE CONSTANT TYPE IN IVF
         AND,R3   L(X'F')
         AI,R5    1
         STB,R3   0,R5              STORE TYPE IN UE
         AI,R2    3
         B        VP140
VP110    LB,R3    0,R2              GET STRING TYPE IN IVF
         AND,R3   L(X'F')
         BEZ      VP120             SIMPLE STRING
         LB,R3    0,R5              ALL STRING
         OR,R3    L(X'1')           SET UD TO 1
         STB,R3   0,R5
VP120    AI,R2    2
         AI,R5    1
         LB,R3    0,R2              GET ALL STRING LENGTH IN IVF
         STB,R3   0,R5              STORE IN UE
         AI,R2    1
         B        VP145
VP130    AI,R2    3
         AI,R5    1                 GET LENGTH (IN BYTES) FROM IVF OF
         LB,R3    0,R2               PACKED DECIMAL NUMERIC LITERAL
         STB,R3   0,R5              STORE IN UE
VP140    AI,R5    -1
         LI,R7    14
         LB,R3    *VDPNTR,R7
         AND,R3   L(X'F')           GET CLASS FROM CURRENT DICT. ENTRY
         EXU      UDSET,R3          SET COMPARISON TYPE IN UD
         LB,R3    0,R5
         OR,R3    R4
         STB,R3   0,R5
*    THE FOLLOWING CODE ALIGNS THE BASE4DSP COUNTER TO A WORD           VPROC
*     OR DOUBLE WORD BOUNDRY DEPENDING ON THE TYPE OF LITERAL           VPROC
         LW,R5    BASE4DSP                                              VPROC
         CI,R4    4                                                     VPROC
         BL       VP145                                                 VPROC
         CI,R4    6                                                     VPROC
         BNE      VP145AA                                               VPROC
         AI,R5    7                                                     VPROC
         AND,R5   L(X'FFFFFFF8')                                        VPROC
         B        VP145BB                                               VPROC
VP145AA  AI,R5    3                                                     VPROC
         AND,R5   L(X'FFFFFFFC')                                        VPROC
VP145BB  STW,R5   BASE4DSP                                              VPROC
*    END OF ALIGNMENT PROCEDURE                                         VPROC
VP145    LW,R5    BASE4DSP          STORE CURRENT BASE 4 DISP.
         LW,R6    VPLIP              IN UG OF CURRENT LIT INFO ENTRY
         SLS,R6   -1
         AI,R6    1
         STH,R5   0,R6
         AI,R2    -3
VP150    LB,R3    0,R2              GET VALUE TYPE IN IVF
         AND,R3   L(X'F0')
         LI,R7    14                GET CLASS FROM CURRENT DICT. ENTRY
         LB,R4    *VDPNTR,R7
         AND,R4   L(X'F')
         CI,R3    X'C0'
         BL       VP170             VALUE TYPE FIG. CONST. OR STRING
         CI,R4    6                 VALUE TYPE NUMBER
         BGE      VP410
VP160    LI,R1    105               VALUE TYPE CONFICTS WITH CLASS
         BAL,R11  DIAG               OF DICT. ENTRY
         B        VP400             PROCESSING BYPASSED
VP170    CI,R3    X'B0'             IS VALUE TYPE A STRING?
         BE       VP175              YES
         CI,R4    6                  NO - THEREFORE FIGURATIVE CONSTANT
         BL       VP200             STRING FIGCON
         LB,R3    0,R2              CLASS OF DICT. NUMERIC
         AND,R3   L(X'F')           IS THIS FIGCON ZERO?
         BNEZ     VP160              NO - ERROR
         LI,R2    BA(FIGZERO)-2      YES - SET IVF INPUT POINTER TO
         B        VP410              DUMMY LITERAL ZERO ENTRY
VP175    CI,R4    6
         BGE      VP160
         LB,R3    0,R2
         AND,R3   L(X'F')           IF AND RESULT 0, VALUE IS
         BEZ      VP240              SIMPLE STRING -- ELSE ALL STRING
         AI,R2    2                 GET LENGTH OF ONE REPETITION
         LB,R3    0,R2               OF ALL STRING
         LI,R7    11
         LH,R9    *VDPNTR,R7        GET SIZE OF DICT. ENTRY
         AND,R9   L(X'0000FFFF')    CLEAR EXTENSION SIGN              VPROC
         AI,R2    -6                BUILD POF ENTRY IN IVF BUFFER
         LW,R7    R2                LOC. OF CLUSTER ORIGIN
         CW,R3    R9                IS ONE REPETITION OF ALL STRING
         BLE      %+4                GREATER THAN DICT. SIZE?
         LI,R1    106                YES - VALUE RIGHT TRUNCATED
         BAL,R11  DIAG               TO DICT. SIZE
         LW,R3    R9
         CI,R3    1                 ONE CHAR ?
         BNE      VP176
         AI,R2    7
         LB,R6    0,R2              SINGE CHAR
         STW,R6   SINGCHAR
         LW,R6    VDPNTR            GET CURRENT DICT. ADDRESS
         AI,R6    4                 POSITION TO BASE AND DISP. FIELDS
         SLS,R6   2                 CHANGE TO BA
         LW,R10   R9
         CI,R10   16
         BGE      DATA16
         CI,R10   R4
         BGE      DATA4
         LW,R7    R10               < 4 CHARS
         B        DATA16+1
VP176    RES      0
         LW,R8    R3                COMPUTE POF CLUSTER LENGTH =
         AI,R8    9                  STRING REP. LNGTH + 7 BYTES FIXED
         SLS,R8   -1                 INFO + 2 BYTE ROUND FOR HALFWORD
         STB,R8   0,R7              STORE IN POF CLUSTER LENGTH FIELD
         AI,R7    1
         LI,R5    X'2D'             SET POF CONTROL BYTE TO
         STB,R5   0,R7               ALPHA DISPLAY
         LW,R5    VP88FLG           IS DICT. ENTRY A COND. NAME?
         BEZ      VP180              NO
         AI,R7    1                  YES
         LI,R5    4                 STORE CONDITION NAME BASE NO. (4)
         STB,R5   0,R7               IN POF
         LI,R6    BA(BASE4DSP)+1
         LI,R5    3
         STB,R5   R7                MOVE CURRENT BASE 4 DISPLACEMENT
         AI,R7    1                  TO POF
         MBS,R6   0
         B        VP190
VP180    LW,R6    VDPNTR            GET CURRENT DICT. ADDRESS
         AI,R6    4                 POSITION TO BASE AND DISP. FIELDS
         SLS,R6   2
         LI,R5    4
         STB,R5   R7
         AI,R7    1                 MOVE DICT. BASE AND DISP.
         MBS,R6   0                  TO POF
VP190    LW,R4    R2
         BAL,R11  WRPOF             OUTPUT INIT. VALUE POF ITEM
         LW,R8    VP88FLG
         BEZ      %+2
         AWM,R3   BASE4DSP
         SW,R9    R3                SUBT ALL REP LNGTH FROM DICT LNGTH
         BEZ      VP400             IF 0, NO FURTHER ACTION REQUIRED
         AI,R7    -3                RESET PNTR TO START OF DISP. FIELD
         LW,R6    R7
         LI,R7    21                BA(R5)+1
         LI,R4    3
         STB,R4   R7                MOVE CURRENT DISP. FROM POF ENTRY
         LI,R5    0                  JUST WRITTEN TO R5
         MBS,R6   0
         AW,R5    R3                BUMP BY ALL REPETITION LENGTH
         AI,R6    -3
         LW,R7    R6
         LI,R6    21
         STB,R4   R7                STORE UPDATED DISP. BACK IN
         MBS,R6   0                  POF ENTRY
         CW,R3    R9                COMP ALL REP LNGTH TO REM DICT LNGTH
         BLE      VP190             ANOTHER FULL POF ITERATION REQUIRED.
         STB,R9   0,R7              LAST ITERATION. REM TO J OF POF
         LW,R10   R9
         AI,R7    -6
         AI,R9    9                 COMPUTE LENGTH OF REMAINDER CLUSTER
         SLS,R9   -1
         STB,R9   0,R7
         LW,R4    R2
         BAL,R11  WRPOF             OUTPUT IT
         LW,R8    VP88FLG
         BEZ      VP400
         AWM,R10  BASE4DSP
         B        VP400
VP200    LI,R7    11                GENERATE FIG. CONST. POF ENTRIES
         LH,R9    *VDPNTR,R7        SET COUNTER WITH DATA ENTRY SIZE
         AND,R9   L(X'0000FFFF')    CLEAR EXTENSION SIGN              VPROC
         LW,R10   R9
         LW,R5    VP88FLG           IS DATA ENTRY A COND. NAME?
         BEZ      VP210              NO
         LI,R5    X'400'             YES - SET BASE NO. IN FIG. CONST.
         LI,R6    1                  BUFFER TO 4
         STH,R5   FCBUF,R6
         LI,R6    BA(BASE4DSP)+1
         LI,R7    BA(FCBUF)+3
         LI,R5    3
         STB,R5   R7                MOVE CURRENT BASE 4 DISP.
         MBS,R6   0                  TO FIG. CONST. BUFFER
         B        VP220
VP210    LW,R6    VDPNTR            MOVE CURRENT DATA ENTRY BASE
         AI,R6    4                  AND DISP. TO FIG. CONST. BUFFER
         SLS,R6   2
         CI,R10   16                16 CHAR OR MORE ?
         BGE      DATA16            YES
         CI,R10   4                 4 CHAR OR MORE ?
         BGE      DATA4             YES
         LI,R7    BA(FCBUF)+2
         LI,R5    4
         STB,R5   R7
         MBS,R6   0
VP220    LB,R5    0,R2              GET FIG. CONST. TYPE
         AND,R5   L(X'F')
         LB,R6    FCCHAR,R5         GET CORRESPONDING EBCDIC CHAR.
         LI,R7    BA(FCBUF)+7
         STB,R6   0,R7              STORE IN FIG. CONST. BUFFER
         LI,R4    BA(FCBUF)
         LI,R5    X'10000'
VP230    BAL,R11  WRPOF             OUTPUT FIG. CONST. POF ITEM
         AWM,R5   FCBUF+1           BUMP DISP. IN FIG. CONST. BUFFER
         BDR,R9   VP230             REPEAT AS NECESSARY
         LW,R8    VP88FLG
         BEZ      VP400
         AWM,R10  BASE4DSP
         B        VP400
DATA16   LI,R7    16
         STW,R7   CHARCNT           SET CHAR COUNTFOR DATA
         STW,R7   PRNTCHAR          CHARS TO BE PRINTED
         LI,R7    BA(FCBUF2)+2      DEST OF DICT INFOR
         LI,R5    4
         STB,R5   R7                BYTE COUNT
         MBS,R6   0                 MOVE DICT INFOR
         LW,R6    SINGCHAR          ALL ' ' SINGLE CHAR
         BGZ      %+4               YES
         LB,R5    0,R2
         AND,R5   L(X'F')           CHAR TYPE
         LB,R6    FCCHAR,R5         CHAR OF ALL STRING
         LI,R1    BA(FCBUF2)+7      BEGIN ADDR OF ALL STRIN
DATANXT  LW,R7    PRNTCHAR
         LI,R5    2
         STB,R7   FCBUF2+1,R5       STORE BYTE COUNT
         AI,R7    1
         SLS,R7   -1
         AI,R7    4                 FORM HALF WORD COUNT
         STB,R7   FCBUF2
         LI,R5    HA(FCBUF2)        FORM LAST HALF WORD ADD
         AW,R5    R7
         SLS,R5   1                 TO BA
         AI,R5    -1
         STB,R7   0,R5              SET LAST HALF WORD COUN
         LW,R5    PRNTCHAR
         STB,R5   R1
         MBS,0    27                LAST BYTE OF R6
         LI,R1    BA(FCBUF2)+7      RESET DEST ADDR
         LI,R4    BA(FCBUF2)
         BAL,R11  WRPOF             OUTPUT POF
         LW,R5    PRNTCHAR
         SLS,R5   16
         AWM,R5   FCBUF2+1          UPDATE DICT INFOR
         SW,R9    PRNTCHAR
         CI,R9    0                 END OF OUTPUT
         BG       %+3               NOT YET FINISHED
         STW,R9   SINGCHAR
         B        VP230+3
         CW,R9    CHARCNT           LAST PIECE
         BG       %+2               NO
         STW,R9   PRNTCHAR          SET NEW PRINT CHAR
         B        DATANXT
DATA4    LI,R7    4
         B        DATA16+1
VP240    AI,R2    2                 GENERATE SIMPLE STRING POF ENTRY
         CI,R4    2                 SET JUSTIFICATION FLAG IF CLASS
         BE       %+3                OF DATA ENTRY ANR OR AER
         CI,R4    4
         BNE      %+2
         STW,R4   JFLAG
         LB,R3    0,R2              GET LENGTH OF SIMPLE STRING
         LI,R7    11
         LH,R9    *VDPNTR,R7        GET LENGTH OF DATA ENTRY
*  CHECK LENGTH OF DATA ITEM IF IT IS ZERO FORGET IT                    VPROC
         BEZ      VP400                                                 VPROC
         AND,R9   L(X'0000FFFF')    CLEAR EXTENSION SIGN              VPROC
         CI,R9    255
         BG       VP340             EXTRA BLANK PADDING POFS NEEDED
VP245    CW,R3    R9                COMPARE STRING TO DATA ENTRY SIZE
         BE       VP300             EQUAL
         BG       VP270             GREATER - ERROR - TRUNCATE EXCESS
         LI,R1    BA(POFBUF)+7      LESS
         LI,R5    255               SET POF BUFFER INITIALLY
         STB,R5   R1                 TO ALL BLANKS
         MBS,0    BA(FCCHAR)+1
         LW,R4    JFLAG             IS DATA ENTRY JUSTIFIED RIGHT?
         BEZ      VP260              (CLASS ANR OR AER)
         LW,R8    R9                 YES - CHAR. OF BLANK FILL ON LEFT =
         SW,R8    R3                 DATA ENTRY SIZE MINUS STRING SIZE
         LI,R7    BA(POFBUF)+7      COMPUTE RECEIVING ADDRESS OF
         AW,R7    R8                 NON-BLANK PORTION OF POF STRING
VP250    LW,R6    R2                COMPUTE TRANSMITTING ADDRESS
         AI,R6    1                  OF SIMPLE STRING
         STB,R3   R7                SET NO. OF SIMPLE STRING CHAR.
         MBS,R6   0                 MOVE IT
         B        VP310
VP260    LI,R7    BA(POFBUF)+7
         B        VP250
VP270    LW,R4    JFLAG             STRING EXEEDS SIZE OF DATA ENTRY
         BEZ      VP290
         LI,R1    107               JUSTIFIED RIGHT, THEREFORE STRING
         BAL,R11  DIAG               LEFT TRUNCATED
         LW,R8    R3                AMOUNT TRUNCATED = STRING SIZE
         SW,R8    R9                 MINUS DATA ENTRY SIZE
         LW,R6    R2                COMPUTE STARTING ADDRESS OF NON-
         AW,R6    R8                 TRUNCATED PORTION
VP280    AI,R6    1
         LI,R7    BA(POFBUF)+7      SET DESTINATION ADDRESS
         STB,R9   R7                TRUNCATED LENGTH = DATA ENTRY SIZE
         MBS,R6   0
         B        VP310
VP290    LI,R1    106               STRING RIGHT TRUNCATED
         BAL,R11  DIAG
VP300    LW,R6    R2                STRING SIZE EQUALS DATA ENTRY SIZE
         B        VP280
VP310    CI,R9    255
         BLE      VP315
         LI,R8    255
         B        %+2
VP315    LW,R8    R9                COMPUTE POF CLUSTER LENGTH
         AI,R8    9                  AND STORE IN POF BUFFER
         SLS,R8   -1
         LI,R7    BA(POFBUF)
         STB,R8   0,R7
         LI,R7    BA(POFBUF)+1      SET POF CONTROL BYTE TO
         LI,R5    X'2D'              ALPHA DISPLAY
         STB,R5   0,R7
         LW,R5    VP88FLG           STORE APPROPRIATE BASE NO. AND
         BEZ      VP320              DISPLACEMENT IN POF BUFFER
         LI,R5    X'400'
         LI,R6    1
         STH,R5   POFBUF,R6
         LI,R6    BA(BASE4DSP)+1
         LI,R7    BA(POFBUF)+3
         LI,R5    3
         STB,R5   R7
         MBS,R6   0
         B        VP330
VP320    LW,R6    VDPNTR
         AI,R6    4
         SLS,R6   2
         LI,R7    BA(POFBUF)+2
         LI,R5    4
         STB,R5   R7
         MBS,R6   0
VP330    CI,R9    255
         BLE      VP335
         LI,R9    255
         B        %+2
VP335    STB,R9   0,R7              STORE DATA ENTRY SIZE IN POFBUF
         LI,R4    BA(POFBUF)
         BAL,R11  WRPOF             OUTPUT SIMPLE STRING POP ITEM
         LW,R2    VP88FLG
         BEZ      %+2
         AWM,R9   BASE4DSP
         LW,R4    JFLAG             IF NO JUSTIFICATION, CHECK SIZE OF
         BEZ      VP390              DATA ENTRY FOR MORE THAN 255 CHAR.
         LI,R4    0
         STW,R4   JFLAG              ELSE RESET VFLAG.
         B        VP400
VP340    LW,R4    JFLAG             IS JUSTIFICATION FLAG SET?
         BNEZ     %+3                YES - BLANK PADDING OUTPUT FIRST
         STW,R2   PFLAG              NO - SET FLAG FOR OUTPUT OF
         B        VP245              PADDING LATER
VP350    LI,R1    BA(POFBUF)+7      SET POFBUF STRING AREA TO BLANKS
         LI,R5    255
         STB,R5   R1
         MBS,0    BA(FCCHAR)+1
         LI,R7    HA(POFBUF)+2
         LW,R5    PFLAG             IF PFLAG SET, BUMP POFBUF DISP.
         BEZ      VP360              FIELD BY 255 BEFORE PROCEEDING
         LH,R6    0,R7
         AI,R6    255
         STH,R6   0,R7
VP360    LW,R5    R9                COMPUTE NO. OF CHARACTERS OF
         AI,R5    -255               BLANK FILL REQUIRED
         CI,R5    255
         BLE      VP380             LESS THAN 1 BUFFER-FULL REMAINING
         LI,R4    BA(POFBUF)+6      STORE NO. OF STRING CHARACTERS
         LI,R6    255                IN POFBUF
         STB,R6   0,R4
         LI,R4    BA(POFBUF)        STORE CLUSTER LENGTH IN POFBUF
         LI,R6    131
         STB,R6   0,R4
VP370    BAL,R11  WRPOF             OUTPUT 255 CHAR BLANK POF ITEM
         LI,R8    255               BUMP DISP. BY 255
         LW,R10   VP88FLG
         BEZ      %+2
         AWM,R8   BASE4DSP
         AH,R8    0,R7
         STH,R8   0,R7
         AI,R5    -255
         CI,R5    255
         BG       VP370
VP380    LI,R4    BA(POFBUF)+6
         STB,R5   0,R4
         LW,R10   R5
         LI,R4    BA(POFBUF)
         AI,R5    8
         SLS,R5   -1
         STB,R5   0,R4
         BAL,R11  WRPOF             OUTPUT LAST BLANK POF ITEM
         LW,R8    VP88FLG
         BEZ      %+2
         AWM,R10  BASE4DSP
         LW,R5    PFLAG
         BNEZ     %+4               IF PFLAG SET, RESET IT
         AH,R10   0,R7               ELSE BUMP DISP.
         STH,R10  0,R7
         B        VP400
         LI,R8    0
         STW,R8   PFLAG
         B        VP400
VP390    CI,R9    255
         BG       VP350
VP400    RES      0                                                     VPROC
         LW,R5    LINENOS        RESTORE CARD NUMBER                    VPROC
         STW,R5   CARDNO                                                VPROC
         LW,R5    CONTCODE   IS THIS LAST LITERAL IN VALUE CLAUSE       VPROC
         BNEZ     VP30               NO
         LI,R5    0                  YES - RESET COND. NAME FLAG
         STW,R5   VP88FLG
         LW,R5    *VDPNTR           REMOVE SEQ. NO. FROM
         AND,R5   L(X'FF000000')     DICT. SYN. LNK. FIELD
         STW,R5   *VDPNTR
         LW,R5    DLPNTR
         CW,R5    VDPNTR
         BE       VP500
         LB,R5    *VDPNTR
         STW,R5   PREVDEL           SAVE DATA ENTRY LENGTH
         AWM,R5   VDPNTR
         B        VP10
         B        VP20
VP410    LI,R7    11                NUMERIC DATA ENTRY
         LH,R6    *VDPNTR,R7        GET DATA ENTRY SIZE FROM DICT.
         AND,R6   L(X'0000FFFF')    CLEAR EXTENSION SIGN              VPROC
         STW,R6   DESIZ              AND SAVE
         AI,R2    2
         LB,R6    0,R2              GET NO. OF DIGITS TO RIGHT OF
         STW,R6   DRDIVF             DECIMAL POINT FROM IVF AND SAVE
         AI,R2    1
         LB,R6    0,R2              GET LENGTH OF PACKED DECIMAL LITERAL
         STW,R6   LLIVF              FROM IVF AND SAVE
         AI,R2    1
         B        %-5,R4            BRANCH ON CLASS OF DATA ENTRY
         B        VP460             6  ND
         B        VP460             7  NDU
         B        VP450             8  NP
         B        VP450             9  NPU
         B        BADCLASS          A UNDEFINED
         B        BADCLASS          B UNDEFINED
         B        VP430             C  IX
         B        VP430             D  NB
         B        VP420             E  NFS
         B        VP420             F  NFD
BADCLASS LI,R1    503
         BAL,R11  DIAG              COMPILER ERROR 03
         B        VP460             IF CONTINUE ASSUME ND
VP420    BAL,R11  PDL               FLOATING POINT - LOAD DECA
         LW,R1    DRDIVF            LOAD POINT LOCATION
         BAL,R11  TENHEX            CONVERT PACKED DECIMAL TO FLOATING
         LI,R2    24                BA(R6)
         LI,R3    BA(POFBUF)+6
         CI,R4    X'E'              IS NUMBER SINGLE PRECISION
         BE       VP421              YES
         LI,R5    8                  NO - LOAD DOUBLE PREC. NO. LENGTH
         B        VP422
VP421    BAL,R1   CDS               CONVERT DOUBLE TO SINGLE PRECISION
         LI,R5    4                 LOAD SINGLE PREC. NO. LENGTH
VP422    STB,R5   R3
         MBS,R2   0                 MOVE FLOATING POINT NO. TO POFBUF
         LI,R7    BA(POFBUF)
         LI,R1    BA(POFBUF)+1
         CI,R4    X'E'              IS NUMBER SINGLE PRECISION
         BE       VP423              YES
         LI,R6    X'2B'              LOAD DOUBLE PREC. CONTROL BYTE
         LI,R8    8                  LOAD DOUBLE PREC. POF CLUSTER LNGTH
         B        VP426
VP423    LI,R6    X'2A'             LOAD SINGLE PREC. CONTROL BYTE
         LI,R8    6                 LOAD SINGLE PREC. POF CLUSTER LENGTH
VP426    STB,R8   0,R7              STORE INFO IN POFBUF
         STB,R6   0,R1
         B        VP470
VP430    BAL,R11  PDL               BINARY OR INDEX - LOAD DECA
         LCW,R1   DRDIVF            ARE ANY FRACTIONAL DIGITS PRESENT?
         BEZ      VP440              NO
         DSA      *R1                YES - REMOVE THEM
         LI,R1    106               VALUE RIGHT TRUNCATED
         BAL,R11  DIAG
VP440    BAL,R11  TENBIN            CONVERT PACKED DECIMAL TO BINARY
         BNOV     %+3               TEST FOR OVERFLOW
         LI,R1    107               OVERFLOW PRESENT
         BAL,R11  DIAG               VALUE LEFT TRUNCATED
         LI,R2    24                BA(R6) - MOVE BINARY RESULT TO
         LI,R3    BA(POFBUF)+6       POF BUFFER
         LI,R5    4
         STB,R5   R3
         LI,R1    BA(POFBUF)
         LI,R5    6                 CLUSTER LENGTH TO POFBUF
         STB,R5   0,R1               (6 HALFWORDS)
         LI,R1    BA(POFBUF)+1      SET POF CONTROL BYTE TO
         LI,R5    X'21'              BINARY
         STB,R5   0,R1
         MBS,R2   0                 MOVE BINARY NO. TO POFBUF
         B        VP470
VP450    BAL,R11  PDL               PACKED DECIMAL - LOAD DECA
         BAL,R11  ALIGNPKD          ALIGN POINT LOCATIONS
         LI,R5    X'2C'             SET POF CONTROL BYTE TO
         LI,R1    BA(POFBUF)+1       PACKED DECIMAL
         STB,R5   0,R1
         LW,R5    DESIZ
         LI,R1    BA(POFBUF)+6      DATA ENTRY LENGTH (IN BYTES) TO
         STB,R5   0,R1               POFBUF CHAR CNT
         LI,R1    BA(POFBUF)        CLUSTER LENGTH (IN HALFWORDS) TO
         AI,R5    9                  POFBUF
         SLS,R5   -1
         STB,R5   0,R1
         LI,R7    BA(POFBUF)+7      CONSTRUCT AND EXECUTE
         LW,R5    DESIZ              DECIMAL STORE FROM
         SLS,R5   4                  DECA TO POFBUF
         AND,R5   L(X'F0')
         AI,R5    X'7F0E'
         STH,R5   DECSTORE
         EXU      DECSTORE
         CI,R4    9                 IS CLASS PACKED DECIMAL UNSIGNED?
         BNE      VP470              NO
         AI,R15   2                  YES - MAKE DECA SIGN PLUS
         B        VP470
VP460    BAL,R11  PDL               NUMERIC DISPLAY - LOAD DECA
         BAL,R11  ALIGN             ALIGN POINT LOCATIONS
         CI,R4    7                 IS CLASS NUMERIC DISPLAY UNSIGNED?
         BNE      %+2                NO
         AI,R15   2                  YES - MAKE DECA SIGN PLUS
         LW,R3    VP88FLG           IS DATA ENTRY A COND. NAME
         BNEZ     VP450+2            YES - DO SPECIAL PROCESSING
         LI,R3    1                 UNPACK DECA INTO POFBUF
         AND,R3   DESIZ
         AI,R3    BA(POFBUF)+6      COMPUTE RECEIVING ADDRESS
         LW,R5    DESIZ              AND NO. OF BYTES TO BE UNPACKED
         AI,R5    2
         SLS,R5   3
         AND,R5   L(X'F0')
         AI,R5    X'7706'
         STH,R5   UNPACK            BUILD AND EXECUTE UNPACK INSTURCTION
         EXU      UNPACK
         LI,R1    BA(POFBUF)+6
         LW,R5    DESIZ             DATA ENTRY LENGTH TO POFBUF
         STB,R5   0,R1
         CI,R4    7
         BNE      %+5
         AW,R1    R5                CLASS IS NDU
         LB,R7    0,R1              CHANGE POSITIVE SIGN IN LOW ORDER
         OR,R7    L(X'F0')           BYTE OF NUMBER FROM C TO F
         STB,R7   0,R1
         LI,R1    BA(POFBUF)        CLUSTER LENGTH TO POFBUF
         AI,R5    9
         SLS,R5   -1
         STB,R5   0,R1
         LI,R1    BA(POFBUF)+1      SET POF CONTROL BYTE TO
         LI,R5    X'2D'              ALPHA DISPLAY
         STB,R5   0,R1
VP470    LI,R7    BA(POFBUF)+2      SET POINTER TO POFBUF BASE NO. FIELD
         LW,R5    VP88FLG           IS DATA ENTRY A COND. NAME?
         BEZ      VP480              NO
         LI,R5    4                  YES - BASE NO. 4 TO POFBUF
         STB,R5   0,R7
         LW,R5    BASE4DSP
         LI,R7    HA(POFBUF)+2      BASE 4 DISP. TO POFBUF
         STH,R5   0,R7
         B        VP490
VP480    LW,R6    VDPNTR            DATA ENTRY BASE AND DISP.
         AI,R6    4                  TO POFBUF
         SLS,R6   2
         LI,R5    4
         STB,R5   R7
         MBS,R6   0
VP490    LI,R4    BA(POFBUF)
         BAL,R11  WRPOF             OUTPUT POF ITEM
         LW,R6    VP88FLG           IF COND. NAME  BUMP BASE 4 DISP.
         BEZ      VP400              BY DATA ENTRY SIZE
         LW,R6    DESIZ
         AWM,R6   BASE4DSP
         B        VP400
UNPACK   DATA     0
DECSTORE DATA     0
VP500    LCI      10
         LM,R1    VPTEMP
         B        *VPEXIT
VPTEMP   RES      10
VPEXIT   RES      1
VP510    LI,R1    501
         B        %+2
VP520    LI,R1    502
         BAL,R11  DIAG
*                 PERFORM DECIMAL LOAD
PDL      LW,R5    LLIVF             GET BYTE LENGTH OF IVF PKD DEC LIT
         SLS,R5   4                 POSITION TO L FIELD OF INSTRUCTION
         AND,R5   L(X'F0')          REMOVE ANY STRAY BITS
         AI,R5    X'7E04'           ADD OP CODE AND INDEX R2
         STH,R5   DECLOAD           STORE COMPOSITE INSTRUCTION
         EXU      DECLOAD           EXECUTE DECIMAL LOAD
         B        *R11              RETURN
DECLOAD  DATA     0
*                 ALIGN POINT LOCATIONS
ALIGNPKD LW,R8    DESIZ             COMPUTE BYTE SIZE OF PACKED DECIMAL
         SLS,R8   1                  NUMBER
         AI,R8    -1
         LI,R7    15                IF ZERO FILL BIT SET IN DICT.
         LB,R5    *VDPNTR,R7         (J FIELD) SUBT. 1 FROM COMPUTED
         AND,R5   L(X'F0')           SIZE
         BEZ      ALIGN+1
         AI,R8    -1
         B        ALIGN+1
ALIGN    LW,R8    DESIZ
         STW,R11  AEXIT             SAVE RETURN
         LW,R5    PL88              IS COND. NAME DICT. POINTER SET?
         BNEZ     %+2                YES - USE COND. NAME DICT. ADDRESS
         LW,R5    VDPNTR            GET POINT LOCATION FROM DICT.
         AI,R5    6                 FOUND AT DICT. ADDRESS + 6 + SPACE
         SLS,R5   2                  OCCUPIED BY FACTORS
         LI,R7    3
         LI,R6    X'F'
         AND,R6   *VDPNTR,R7
         SLS,R6   1
         AW,R5    R6
         SLS,R5   -1
         LH,R5    0,R5
         BGEZ     ALIGN10
         DST,0    DECASAVE          SCALING PRESENT - SAVE DECA
         LI,R1    33                SHIFT SCALED VALUE
         SW,R1    R8                 OFF LEFT END OF DECA
         DSA      *R1               LEFT SHIFT AGAIN N DIGITS WHERE N
         LCW,R1   R5                 IS THE REQUIRED SCALE FACTOR
         DSA      *R1               WERE ANY SIGNIFICANT DIGITS SHIFTED?
         BNOV     %+3                NO
         LI,R1    106                YES - ERROR
         BAL,R11  DIAG
         DL,0     DECASAVE          RESTORE DECA
         SW,R5    DRDIVF
         B        ALIGN20
ALIGN10  SW,R5    DRDIVF            SUBTRACT POINT LOCATION FOUND IN IVF
         BGEZ     %+3
         LI,R1    106               TOO MANY FRACTIONAL DIGITS IN LIT.
         BAL,R11  DIAG              VALUE RIGHT TRUCATED
ALIGN20  SW,R5    R8
         AI,R5    31
         DSA      *R5
         BNOV     %+3
         LI,R1    107               TOO MANY INTEGER DIGITS IN LIT.
         BAL,R11  DIAG               VALUE LEFT TRUNCATED
         LW,R5    R8
         AI,R5    -31
         DSA      *R5
         B        *AEXIT            RETURN
AEXIT    DATA     0
DESIZ    DATA     0                 DATA ENTRY SIZE
DRDIVF   DATA     0                 DIGITS RIGHT OF DECIMAL PT. IN IVF
LLIVF    DATA     0                 IVF LITERAL LENGTH
UDSET    LI,R4    0                 0 - GR
         LI,R4    0                 1 - AN
         LI,R4    0                 2 - ANR
         LI,R4    0                 3 - AE
         LI,R4    0                 4 - AER
         LI,R4    0                 5 - NE
         LI,R4    2                 6 - ND
         LI,R4    2                 7 - NDU
         LI,R4    3                 8 - NP
         LI,R4    3                 9 - NPU
         LI,R4    0                 A
         LI,R4    0                 B
         LI,R4    0                 C - IX
         LI,R4    4                 D - NB
         LI,R4    5                 E - NFS
         LI,R4    6                 F - NFD
SINGCHAR DATA     0
CHARCNT  DATA     0
PRNTCHAR DATA     0
FCBUF2   DATA     X'002D0000'
         RES      5
FCBUF    DATA     X'052D0000'       FIGURATIVE CONSTANT BUFFER
         DATA     X'00000100'
         DATA     X'00050000'
         REF      FCCHAR                                                VPROC
         DATA     X'FF000000'        CHARACTER TABLE
FIGZERO  DATA     X'00010C00'       DUMMY FIGCON ZERO IVF ENTRY
POFBUF   DATA     0                 POF BUFFER FOR CONSTRUCTION OF
         DATA     0                  SIMPLE STRING AND NUMERIC
         RES      64                 POF ENTRIES
CONTCODE DATA     0                 CONTINUATION CODE
DECASAVE RES      4                 DECA SAVE AREA
JFLAG    DATA     0                 JUSTIFICATION FLAG
PFLAG    DATA     0                 PADDING FLAG
PL88     DATA     0                 COND. NAME DICT. ENTRY ADDRESS
PREVDEL  DATA     0                 PREVIOUS DATA ENTRY LENGTH
VDPNTR   DATA     0                 CURRENT DATA ENTRY ADDRESS
VP88FLG  DATA     0                 CONDITION NAME FLAG
VPLIP    DATA     0                 CURRENT LITERAL INFO ENTRY ADDRESS
         BOUND    8
POTEN    DATA     X'41A00000'       10
         DATA     X'00000000'
MAXTST   DATA     X'7F199999'       FOR OVERFLOW TEST
         DATA     X'99999999'
STREGS   RES      11                SAVE REGISTERS
PSWD     RES      1                 SAVE CONDITION CODE
TENSEV   DATA     10000000          10**7
CVTBL    DATA     8000000
         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
         DATA     10
         DATA     8
         DATA     4
         DATA     2
         DATA     1
         DATA     0
         DATA     0
         DATA     0
         DATA     0
DIGTC    LI,10    8                 DIGIT COUNT
         LI,10    8
         LI,10    8
         LI,10    7
TENHEX   LCI      11                DECIMAL TO FLOATING
         STM,1    STREGS
         BAL,11   DECFLO
         LCI      2
         STM,6    STREGS+5
EXIT     LCI      11
         LM,1     STREGS
         LCF      PSWD
         B        *11
STCFP    LI,3     X'20'             CONDITION CODE-POSITIVE
         STB,3    PSWD
         B        *9
STCFN    LI,3     X'10'             NEGATIVE
         B        STCFP+1
STCFZ    LI,3     0                 ZERO
         B        STCFP+1
SCFBO    LI,3     X'40'             OVERFLOW
         B        STCFP+1
DECFLO   LFI      0
         LI,2     0
         LI,3     0
         EXU      DIGTC,2
         LI,4     0
         LW,5     12,2
         SLD,4    4
         CI,4     0
         BCS,3    FNDFRC            SUPPRESS LEADING ZERO
         AI,3     1
         BDR,10   %-4
         CI,3     31
         BCS,3    %+5
         LI,6     0
         LI,7     0
DECFLO1  BAL,9    STCFZ
         B        *11
         AI,2     1
         B        DECFLO+3
FNDFRC   LW,6     4                 INITIALIZATION
         LI,7     0
         SLD,6    -4
         LI,6     X'41'
         SLD,6    24
FNDFRC1  AI,3     1                 CHECK PROCESSED DIGIT NUMBER
         CI,3     31
         BCR,3    EXPROC
         BDR,10   FNDFRC2
         AI,2     1
         EXU      DIGTC,2
         LW,5     12,2
FNDFRC2  FML,6    POTEN             NEXT DIGIT
         LI,4     0
         SLD,4    4
         LW,8     4
         BCR,3    FNDFRC1
         LI,9     0
         SLD,8    -4
         LI,8     X'41'
         SLD,8    24
         FAL,6    8
         B        FNDFRC1
EXPROC   CI,1     0
         BCR,3    EXPROC1
         BCS,2    EXPROC2
         FML,6    POTEN             NEGATIVE DECP
         BIR,1    %+2
         B        EXPROC1
         CD,6     MAXTST
         BCS,1    EXPROC+3
         BAL,9    SCFBO
         B        *11
EXPROC1  LI,4     X'F'
         AND,4    15
         CI,4     X'D'
         BCR,3    %+3
         BAL,9    STCFP
         B        *11
         LCD,6    6
         BAL,9    STCFN
         B        *11
EXPROC2  FDL,6    POTEN
         BCR,3    DECFLO1
         BDR,1    %-2
         B        EXPROC1
TENBIN   LCI      11                PACKED DECIMAL TO BINARY
         STM,1    STREGS
         LW,2     12                CHECK R12
         BCR,3    %+3
TENBIN0  BAL,9    SCFBO
         B        EXIT
         LW,2     13                CHECK R13
         BCS,3    TENBIN0
         LW,7     14
         CI,7     532
         BCS,2    TENBIN0
         SLS,7    4
         CVA,6    CVTBL             CONVERT R14
         LW,5     6
         MW,4     TENSEV
         CI,4     0
         BCS,3    TENBIN0
         LW,7     15
         CVA,6    CVTBL             CONVERT R15
         AW,6     5
         BCS,4    TENBIN0
         BCS,3    %+3
         BAL,9    STCFZ
         B        TENBIN1
         LI,3     X'F'
         AND,3    15
         CI,3     X'D'
         BCR,3    %+3
         BAL,9    STCFP
         B        %+3
         LCW,6    6
         BAL,9    STCFN
TENBIN1  STW,6    STREGS+5
         B        EXIT
CDS      AI,R6    0                 TEST OPERAND SIGN
         BGZ      CDS1              POSITIVE
         BEZ      0,R1              ZERO - EXIT
*              OPERAND NEGATIVE
         AD,R6    NEGROUND          ROUND IN 2ND WORD  (CAN'T OVFL)
         CW,R6    =X'00FFFFFF'      IF STILL NORMALIZED, NO EXP CHANGE
         BANZ     0,R1               NEEDED -- EXIT
*              NEGATIVE, EXPONENT CHANGE
         SW,R6    =X'00100000'      DECREMENT EXP, MANTISSA = X'F00000'
         BNOV     0,R1              TYPICAL CASE = NO OVERFLOW - EXIT
*              NEGATIVE, OVERFLOW
         LCW,R6   MAXPOS            MINUS INFINITY
         B        CDS2
*              OPERAND POSITIVE
CDS1     AD,R6    POSROUND          ROUND IN 2ND WORD
         BNOV     CDS3
*              POSITIVE, OVERFLOW
         LW,R6    MAXPOS            PLUS INFINITY
*              POS + NEG OVERFLOW
CDS2     FAS,R6   R6                PROVOKE OVERFLOW
         B        0,R1              EXIT
*              POSITIVE, NO OVERFLOW
CDS3     CW,R6    =X'00FFFFFF'      IF STILL NORMALIZED, NO EXP CHANGE
         BANZ     0,R1               NEEDED -- EXIT
*              POSITIVE, EXPONENT CHANGE
         AW,R6    =X'00100000'      INCREMENT EXP, MANTISSA = X'100000'
         B        0,R1              EXIT  (PREV. ADD CAN'T OVERFLOW)
         BOUND    8
POSROUND DATA     X'00000000',X'80000000'
NEGROUND DATA     X'00000000',X'7FFFFFFF'
MAXPOS   EQU      NEGROUND+1        =X'7FFFFFFF'
LINENOS  RES      1                                                     VPROC
         END
