         SYSTEM   SIG7FDP
*                                                                          00680
*  EXTERNAL REFERENCES                                                     00690
*                                                                          00700
         REF      DIAG,PDBP1,PDBP2                                   BWZ
*                                                                          00710
* ENTRY POINTS                                                             00720
*                                                                          00730
         DEF      PICTURE,PICCUR,PICDEC,PICINFO
         DEF      STRING2,PIC,BWZ                                    BWZ
*                                                                          08050
* PICTURE EQUIVALENTS                                                      08060
* REGISTER EQUATES
*                                                                          08070
R1       EQU      1                                                        08080
R2       EQU      2                                                        08090
R3       EQU      3                                                        08100
R4       EQU      4                                                        08110
R5       EQU      5                                                        08120
R6       EQU      6                                                        08130
R7       EQU      7                                                        08140
R8       EQU      8                                                        08150
R9       EQU      9                                                        08160
R10      EQU      10                                                       08170
R11      EQU      11                                                       08180
R12      EQU      12                                                       08190
R13      EQU      13                                                       08200
R14      EQU      14                                                       08210
R15      EQU      15                                                       08220
STRING   EQU      STRING2                                            BWZ
         PAGE
*
* DIAGNOSTIC EQUATES
*
PICDIAG1 EQU      -44               MAX REPEAT COUNT EXCEEDED
PICDIAG2 EQU      -45               NON-NUMERIC WITHIN PARENTHESIS
PICDIAG3 EQU      -46               ILLEGAL CHARACTER IN PICTURE
PICDIAG4 EQU      -47               ILLEGAL SYNTAX
PICDIAG5 EQU      -48               MAX EDITING FIELD EXCEEDED
PICDIAG6 EQU      -208              EXCESSIVE CHARACTERS IN PIC STRING
PICDIAG7 EQU       -223             CLASS NOT SPECIFIED NDU ASSUMED     PICTURE
*
* CLASS EQUATES
*
PICALPH  EQU      1                 CLASS- ALPHANUMERIC
PICALPE  EQU      3                       ALPHANUMERIC EDITED
PICNUMS  EQU      6                        NUMERIC SIGNED
PICNUME  EQU      5                        NUMERIC EDITED
PICNUMU  EQU      7                        NUMERIC UNSIGNED
         PAGE
*                                                                          00740
* THE PICTURE CURRENCY ROUTINE                                             00750
*    EXPECTS THE NEW CURRENCY SYMBOL IN STRING TABLE                       00760
*    EXCHANGES APPROPRIATE ENTRIES IN PRECEDENCE TABLE                     00770
*                                     COMPARISON WORD
*                                     EDIT MASK
*                                     TTBS TABLE                           00780
*                                                                          00790
PICCUR   LB,R2    STRING            PICK UP NEW CURRENCY SIGN              00800
         STB,R2   PDBP2             SET NEW CURRENCY SIGN
         STW,R4   PICTMP            SAVE R4
         LI,R4    11
         STB,R2   PICMMT,R4         SET NEW % MASK CHAR
         STW,R2   DSIGN             SET NEW % COMPARISON WORD
         LI,R4    C'%'              PICK UP %
         BCR,0    PICCDS            GOTO EXCHANGE ENTRIES                  00820
*                                                                          00830
* THE PICTURE PERIOD-COMMA ROUTINE                                         00840
*    EXCHANGES (.) AND (,) ENTRIES IN PRECEDENCE TABLE                     00850
*                                      TTBS TABLE                          00860
*                                     EDIT MASK
*                                     COMPARISON WORD
*                                                                          00870
PICDEC   LI,R2    X'0004B'          PICK UP .                              00880
         STW,R4   PICTMP            SAVE R4
         LI,R4    X'200'
         OR,R4    PDBP1
         STW,R4   PDBP1             SET DECIMAL IS COMMA INDICATOR
         LI,R4    X'0006B'          PICK UP ,                              00890
         LI,R3    8
         LI,R5    7
         STB,R2   PICMMT,R5         CHANGE MASK CHAR FOR , TO .
         STB,R4   PICMMT,R3         CHANGE MASK CHAR FOR . TO ,
         STW,R2   COMMA             CHANGE COMPARISON WORD FOR . TO ,
         STW,R4   PERIOD            CHANGE COMPARISON WORD FOR , TO .
*                                                                          00900
* EXCHANGE ENTRIES                                                         00910
*                                                                          00920
PICCDS   LB,R3    PICTTBS,R2                                               00930
         LB,R5    PICTTBS,R4                                               00940
         STB,R3   PICTTBS,R4                                               00950
         STB,R5   PICTTBS,R2                                               00960
         LI,R3    X'0003F'
         AND,R4   R3                CONVERT % AND ,
         CI,R2    X'00040'
         BCR,4    PICCDS3
         AND,R2   R3
         BCR,0    PICCDS4
PICCDS3  AND,R2   R3
         LI,R3    X'00040'
         OR,R2    R3
PICCDS4  LW,R3    PRECTAB,R2
         LW,R3    PRECTAB,R2                                               01080
         LW,R5    PRECTAB,R4                                               01090
         STW,R3   PRECTAB,R4                                               01100
         STW,R5   PRECTAB,R2                                               01110
         LW,R4    PICTMP            RESTORE R4
         BCR,0    0,R1              RETURN                                 01120
         PAGE                                                              01130
*                                                                          01140
* PICTURE ROUTINE                                                          01150
*    EXPECTS PICTURE CHARACTORS IN STRING                                  01160
*    SAVES REGISTERS                                                       01170
*    EXITS WHEN PICTURE IS PROCESSED OR AN ERROR IS FOUND                  01180
*                                                                          01190
PICTURE  LCI      X'0000F'          SAVE REGISTERS                         01200
         STM,R1   PICTMP                                                   01210
         LI,R15   0                                                        01220
         STW,R15  PICTURH                                                  01230
*                                                                          01240
* PRESCN ROUTINE                                                           01250
*   CHECKS FOR ILLEGAL PICTURE CHARACTORS                                  01260
*    CHANGES ILLEGAL CHARACTORS TO B AND SETS FLAG
*                                                                          01280
PRESCN   LI,R3    BA(STRING)        ADDRESS OF PICTURE CHARACTORS          01290
         LW,R2    PICMK40
         STW,R2   PICTTBM           SET MASK
         OR,R3    PICT31L           LENGTH OF STRING                       01300
         LI,R2    BA(PICTTBS)                                              01310
PRESCN1  AND,R2   PICMKCL           CLEAR MASK
         OR,R2    PICTTBM           MASK
         TTBS,R2  0                 TRANSLATE AND TEST BYTE STRING         01330
         BCR,1    PRESCN2           END OF STRING GOTO CHANGE TO BLANK     01340
         LB,R4    0,R3
         CI,R4    ' '               IS ILLEGAL CHAR A BLANK
         BCR,3    PRESCN3           YES-GOTO COMPUTE NO. CHAR
         CI,R4    C'('              IS ILLEGAL CHAR A (
         BCS,3    PRESCN4           NO -GO TEST FOR )
         LW,R4    PICMK08           YES-SET MASK TO ALLOW NUMERICS
         STW,R4   PICTTBM
         BCR,0    PRESCN6
PRESCN4  CI,R4    C')'              IS ILLEGAL CHAR A )
         BCS,3    PRESCN5           NO -GOTO CHANGE CHAR
         LW,R4    PICMK40           YES-SET MASK TO DISALLOW NUMERICS
         STW,R4   PICTTBM
         BCR,0    PRESCN6
PRESCN5  LI,R4    C'B'
         STB,R4   0,R3              CHANGE ILLEGAL CHAR TO B
         LI,R4    X'400'
         OR,R4    PICTURH           SET ILLEGAL CHAR FLAG IN HISTORY
         STW,R4   PICTURH
PRESCN6  AI,R3    1                 INCREMENT STRING BYTE ADDRESS
         SW,R3    PICTTBC           DECREMENT TTBS COUNT
         BCR,0    PRESCN1           GOTO FINISH SCAN
PRESCN2  LI,R4    C' '
         STB,R4   0,R3              CHANGE LAST CHAR TO BLANK              01480
         LI,R1    PICDIAG6
         BAL,R11  DIAG
PRESCN3  SCS,R3   8                 COMPUTE NO. OF CHAR IN PICTURE         01510
         AND,R3   PICBYTM                                                  01520
         STW,R3   PICSIZE                                                  01530
         LI,R3    X'1F'                                                    01540
         SW,R3    PICSIZE                                                  01550
         STW,R3   PICSIZE                                                  01560
         PAGE                                                              01570
*                                                                          01580
* PICTURE CLASS ROUTINE                                                    01590
*    DETERMINES THE CLASS OF PICTURE                                       01600
*    COMPUTE NUMBER OF CHARACTERS IN PICTURE                               01610
*    TRANSFERS CONTROL TO APPROPRIATE ROUTINE %N,NE,AN<                    01620
*                                                                          01630
PICLASS  LI,R3    BA(STRING)                                               01640
         LW,R1    PICSIZE                                                  01650
         SCS,1    -8                                                       01660
         OR,R3    R1                PICTURE LENGTH                         01670
         LI,R2    BA(PICTTBS)                                              01680
         LW,R1    PICMK20
         STW,R1   PICTTBM
PICLAS1  AND,R2   PICMKCL           CLEAR MASK
         OR,R2    PICTTBM
         TTBS,R2  0                 IS CLASS NUMERIC
         BCR,1    PICNUM            YES-GOTO NUMERIC ROUTINE
         LB,R4    0,R3
         CI,R4    C'('
         BCS,3    PICLAS2
         LW,R5     R3               CURRENT STRING ADDRESS              PICTURE
         AND,R5    PICMKCL          REMOVE PICTURE LENGTH               PICTURE
         CI,R5     BA(STRING)       IS '(' THE FIRST CHARACTER          PICTURE
         BNE       PICLAS15         NO                                  PICTURE
         LI,R1     PICDIAG7         ISSUE DIAG                          PICTURE
         BAL,R11   DIAG                                                 PICTURE
PICLAS15 RES       0                                                    PICTURE
         LW,R1    PICMK08           SET MASK TO ALLOW   NUMERICS
         STW,R1   PICTTBM
         BCR,0    PICLAS3
PICLAS2  CI,R4    C')'
         BCS,3    PICLAS4
         LW,R1    PICMK20           SET MASK TO DISALLOW NUMERICS
         STW,R1   PICTTBM
PICLAS3  AI,R3    1                 INCREMENT STRING ADDRESS
         SW,R3    PICTTBC
         BCR,0    PICLAS1           GO CONTINUE SCAN
PICLAS4  LI,R3    BA(STRING)
         LW,R1    PICSIZE                                                  01730
         SCS,R1   -8                                                       01740
         OR,R3    R1                PICTURE LENGTH                         01750
         LI,R2    BA(PICTTBS)                                              01760
         OR,R2    PICMK10           NUMERIC EDIT MASK                      01770
         TTBS,R2  0                 IS CLASS NUMERIC EDIT                  01780
         BCS,1    PICNE             YES-GOTO NUMERIC EDIT ROUTINE          01790
         LI,R3    BA(STRING)
         LW,R1    PICSIZE
         SCS,R1   -8
         OR,R3    R1
         LW,R1    PICMK80
         STW,R1   PICTTBM
PICLAS5  AND,R2   PICMKCL
         OR,R2    PICTTBM
         TTBS,R2  0
         BCR,1    PICAN             GOTO CLASS IS ALPHANUMERIC
         LB,R4    0,R3
         CI,R4    C'('
         BCS,3    PICLAS6
         LW,R1    PICMK08           SET MASK TO ALLOW NUMERICS
         STW,R1   PICTTBM
         BCR,0    PICLAS7
PICLAS6  CI,R4    C')'
         BCS,3    PICAE             GOTO CLASS IS ALPHANUMERIC EDITED
         LW,R1    PICMK80           SET MASK TO DISALLOW NUMERICS
         STW,R1   PICTTBM
PICLAS7  AI,R3    1
         SW,R3    PICTTBC
         BCR,0    PICLAS5           GO CONTINUE SCAN
PICEXIT  LI,R1    0                                                  BWZ
         STW,R1   BWZ               RESET BWZ FLAG                   BWZ
         LCI      X'F'              LOAD INDEXES                     BWZ
         LM,R1    PICTMP                                                   01820
         BCR,0    0,R1                                                     01830
PICDROP  STW,R15  PICINFO                                                  01840
         BCR,0    PICEXIT                                                  01850
         PAGE                                                              01860
*                                                                          01870
* ALPHANUMERIC ROUTINE                                                     01880
*    BUILDS MURAL AND MURAL DESCRIPTOR                                     01890
*    COMPUTES PICTURE SIZE                                                 01900
*    SETS CLASS TO ALPHANUMERIC OR ALPHANUMERIC EDIT                       01910
*                                                                          01920
PICAN    LI,R1    PICALPH
         STW,R1   PICINFO           SET CLASS TO ALPHANUMERIC
         BCR,0    PICAN3
PICAE    LI,R1    PICALPE
         STW,R1   PICINFO
         STW,R15  PICANDC
         STW,R15  PICICNT
         LI,R1    X'FFFFF'
         STW,R1   PICANKY           RESET KEY                              01970
         LI,R1    1
         STW,R1   R4
PICAN3   STW,R15  R5
         BAL,R1   IGETBYT           INITILIZE GETBYT                       01980
PICAN1   BAL,R1   GETBYT                                                   01990
         BCR,0    PICAN7                                                   02000
         BCR,0    PICANSI           EXIT-END OF PICTURE                    02010
PICAN7   LW,R1    PICINFO
         CI,R1    PICALPH           IS CLASS AN
         BCR,3    PICAN8            YES-GOTO INC CHAR COUNT
         CI,R5    256               EXCESS MASK
         BCS,2    PICAN6            YES-GO GIVE DIAG
         LW,R1    GETBCCH
         CI,R1    X'000F0'          IS CURRENT CHAR A 0                    02030
         BCR,3    PICAN2            YES-GOTO TEST KEY OFF                  02040
         LI,R2    X'00040'          NO -                                   02050
         STW,R2   GETBCCH           CHANGE CHAR TO A BLANK                 02060
         CI,R1    X'000C2'          IS CURRENT CHAR A B                    02070
         BCR,3    PICAN2            YES-GOTO TEST KEY OFF                  02080
         LW,R1    PICICNT
         AI,R1    1
         STW,R1   PICICNT
         LW,R1    PICANKY           NO -IS KEY ON                          02090
         BCS,1    PICAN4            YES-GOTO INCREMENT                     02100
PICAN5   LCW,R1   PICANKY           NO -                                   02110
         STW,R1   PICANKY           SWITCH KEY                             02120
         LW,R1    PICANDC                                                  02130
         STB,R1   PICINFO+3,R4      STORE DESCRIPTOR CNT IN MURAL DESC.    02140
         STW,R15  PICANDC           RESET DESCRIPTOR CNT                   02150
         AI,R4    X'00001'          INCREMENT DESCRIPTOR LENGTH            02160
PICAN4   LW,R1    PICANDC                                                  02170
         AI,R1    X'00001'                                                 02180
         STW,R1   PICANDC           INCREMENT DESCRIPTOR CNT               02190
         LW,R1    GETBCCH                                                  02200
         STB,R1   PICINFO+11,R5     STORE CURRENT CHAR IN MURAL            02210
PICAN8   AI,R5    1                 INCREMENT CHAR COUNT
         BCR,0    PICAN1            GO PROCESS REST OF CHAR                02230
PICAN2   LW,R1    PICANKY           IS KEY OFF                             02240
         BCS,2    PICAN4            YES-GOTO INCREMENT                     02250
         BCR,0    PICAN5            NO -GOTO SWITCH KEY                    02260
PICANSI  STW,R5   PICINFO+1         STORE SIZE
         LW,R1    PICANDC
         STB,R1   PICINFO+3,R4
         LW,R1    PICANKY
         BCS,1    %+2
         AI,R4    -1
         STB,R4   PICINFO+3         STORE DESCRIPTOR IN MURAL
         LW,R1    PICICNT
         STW,R1   PICINFO+2         STORE INTERNAL SIZE
         LI,R1    X'00400'
         AND,R1   PICTURH
         BCR,3    PICEXIT
         LI,R1    PICDIAG3
         BAL,R11  DIAG
         BCR,0    PICEXIT
PICAN6   LI,R1    PICDIAG5
         BAL,R11   DIAG
         BCR,0    PICANSI
         PAGE                                                              02430
*                                                                          02440
* NUMERIC ROUTINE                                                          02450
*    USES NUMERIC SCAN                                                     02460
*    STORES CLASS                                                          02470
*                                                                          02480
PICNUM   LW,R1    BWZ                                                BWZ
         BNEZ     PICNE                                              BWZ
         LW,R1  PICSIZE  SIDR 2234 3/1/71 TEST FOR B                    PICTURE
         LB,R2  STRING,R1 ***                                           PICTURE
         CI,R2  'B'       ***                                           PICTURE
         BE     PICNE     ***                                           PICTURE
         AI,R1  -1        ***                                           PICTURE
         BGE    %-4       ***                                           PICTURE
         BAL,R1   IGETBYT           INITIALIZE GETBYT                BWZ
         LI,R1    PICNUMU
         STW,R1   PICINFO           SET CLASS TO NUMERIC                   02510
         BAL,R1   PICNSCN                                                  02520
         LW,R1    PICTURH                                                  02530
         AND,R1   PICTUSB                                                  02540
         BCR,3    PICNEXT           NO-GO EXIT                             02550
         LI,R1    PICNUMS
         STW,R1   PICINFO                                                  02570
PICNEXT  BCR,0    PICEXIT           EXIT                                   02580
         PAGE                                                              02590
*                                                                          02600
* NUMERIC EDIT ROUTINE                                                     02610
*    USES NUMERIC SCAN                                                     02620
*    STORES CLASS                                                          02630
*    COMPUTES AND STORES ......                                            02640
*                                                                          02650
PICNE    BAL,R1   IGETBYT                                                  02660
         LI,R1    PICNUME
         STW,R1   PICINFO           SET CLASS TO NUMERIC EDIT              02680
         STW,R15  PICINFO+3         INIT LEFT-RIGHT SIGN                   02690
         STW,R15  PICINFO+4              TYPE OF REPLACEMENT               02700
         STW,R15  PICINFO+5              RESET LEADING COUNT
         STW,R15  PICINFO+7              LEADING INSERITION COUNT
         STW,R15  PICINFO+8              TRAILING INSERTIONS               02710
         STW,R15  PICINFO+9              FLOATING SIGN                     02720
         STW,R15  PICINFO+10             . POSITION                        02730
         STW,R15  PICTUFH                FLOAT HISTORY                     02740
*                                                                          02750
* DETERMINE FLOAT CHARACTER IF ANY                                         02760
*                                                                          02770
PICNEF   LI,R3    BA(STRING)        STRING TABLE                           02780
         LW,R4    PICSIZE                                                  02790
         SCS,R4   -8                                                       02800
         OR,R3    R4                                                       02810
         LI,R2    BA(PICTTBS)       TTBS TABLE                             02820
PICNEF1  OR,R2    PICMK07
         TTBS,R2  0                                                        02840
         BCR,1    PICNEFE                                                  02850
         SCS,R2   8                                                        02860
         LI,R1    X'000FF'                                                 02870
         AND,R1   R2                                                       02880
         LW,R4    PICTUFH                                                  02890
         AND,R4   R1                                                       02900
         BCR,3    PICNEF2           NO                                     02910
         STW,R4   PICTUFH                                                  02920
         BCR,0    PICNEFX                                                  02930
PICNEF2  LW,R4    PICTUFH
         OR,R4    R1
         STW,R4   PICTUFH
         SCS,R2   -8                                                       02960
         AI,R3    1                 INCREMENT STRING BYTE ADDRESS          02970
         SW,R3    PICTTBC           DECREMENT TTBS COUNT                   02980
         LB,R4    0,R3
         CI,R4    C'('              IS NEXT CHAR (                         03000
         BCS,3    PICNEF1           NO -GOTO LOOP                          03010
         STW,R1   PICTUFH           SET FLOAT FLAG                         03020
         BCR,0    PICNEFX                                                  03030
PICNEFE  STW,R15  PICTUFH                                                  03040
PICNEFX  BAL,R1   PICNSCN                                                  03050
*                                                                          03060
* COMPUTE AND STORE NUMERIC EDIT INFORMATION                               03070
*                                                                          03080
         LW,R1    PICTU9B                                                  03090
         AND,R1   PICTURH           ANY 9                                  03100
         BCS,3    PICNESI           YES-                                   03110
         LI,R1    X'00008'          NO -                                   03120
         OR,R1    PICINFO+4                                                03130
         STW,R1   PICINFO+4         SET BWZ IN TR                          03140
PICNESI  LW,R1    PICICNT                                                  03150
         STW,R1   PICINFO+6         SET NUMBER OF DIGIT POSITIONS          03160
         BCR,0    PICEXIT           EXIT                                   03170
         PAGE                                                              03180
*                                                                          03190
* NUMERI SCAN ROUTINE                                                      03200
*    USES GETBYT                                                           03210
*    SCANS PICTURE AND GIVES ERROR DIAG.                                   03220
*    COMPUTES AND STORES POINT LOCATION AND SIZE                           03230
*    WHEN CLASS IS SET TO %NE< A MURAL IS PRODUCED                         03240
*                                                                          03250
PICNSCN  STW,R1   PICNTMP           SAVE LINK REGISTER                     03260
         STW,R15  PICDCNT                                                  03270
         STW,R15  PICECNT                                                  03280
         STW,R15  PICICNT                                                  03290
         STW,R15  PICTRLF                                                  03300
PICNSC2  BAL,R1   GETBYT                                                   03310
         BCR,0    PICNSC1           NORMAL EXIT                            03320
         BCR,0    PICNEOP           END OF PICTURE EXIT                    03330
PICNSC1  LW,R1    GETBCCH                                                  03340
         CI,R1    X'000D7'          IS CURRENT CHAR A P                    03350
         BCS,3    PICNTC            NO -GOTO TEST CLASS                    03360
         LW,R1    PICTURH           YES-                                   03370
         AND,R1   PICTVPS           ANY EXCEPT VPS                         03380
         BCR,3    PICNTC                                                   03390
         LI,R1    X'0008B'          NO -                                   03400
         STW,R1   GETBCCH           CHANGE CURRENT CHAR TO P%T<            03410
PICNTC   LW,R1    GETBCCH
         LW,R2    PICINFO
         CI,R2    PICNUMU
         BCR,3    PICNVT            Y
         LW,R3    PICECNT
         CI,R3    255               EXCESS EDIT MASK
         BCS,2    PICNEO5           YES-GO GIVE DIAG
         PAGE                                                              03460
*                                                                          03470
* ALL OTHER NECESSARY CHANGES TO CCH ARE MADE HERE                         03480
*                                                                          03490
         CI,R1    C'+'                                                     03510
         BCR,3    PICNSP            GOTO PROCESS +                         03520
         CI,R1    C'-'                                                     03530
         BCR,3    PICNSM            GOTO PROCESS -                         03540
         CW,R1    DSIGN
         BCR,3    PICNSD            GOTO PROCESS %                         03560
         CI,R1    C'Z'                                                     03570
         BCR,3    PICNZA            GOTO PROCESS Z*                        03580
         CI,R1    C'*'                                                     03590
         BCR,3    PICNZA            GOTO PROCESS Z*                        03600
         CI,R1    C'9'                                                     03610
         BCR,3    PICNS9            GOTO PROCESS 9                         03620
         CW,R1    PERIOD
         BCR,3    PICNPR            GOTO PROCESS .                         03640
         CI,R1    C'0'                                                     03670
         BCR,3    PICNC0            GOTO PROCESS ,0                        03680
         CW,R1    COMMA
         BCR,3    PICNC0            GOTO PROCESS ,0                        03700
         CI,R1    C'B'                                                     03710
         BCR,3    PICNB             GOTO PROCESS B                         03720
         CI,R1    C'D'                                                     03730
         BCR,3    PICNDC            GOTO PROCESS D OR C                    03740
         CI,R1    C'C'                                                     03750
         BCR,3    PICNDC            GOTO PROCESS D OR C                    03760
PICNVT   CI,R1    C'V'
         BCR,3    PICNSV            GOTO PROCESS V                         03660
         BCR,0    PICNCV                                                   03770
         PAGE                                                              03780
*                                                                          03790
* PROCESS +                                                                03800
*                                                                          03810
PICNSP   LI,R1    X'00002'                                                 03820
         AND,R1   PICTUFH           FLOATING                               03830
         BCS,3    PICNSP1           YES-GOTO 1ST                           03840
         LW,R1    PICTURH           NO -                                   03850
         AND,R1   PIC9ZAD           LEADING                                03860
         BCR,3    PICNSP4           YES-                                   03870
         LI,R1    1                                                        03880
         LI,R2    7                                                        03890
         STH,R1   PICINFO,R2        SET RS TO P                            03900
         LI,R1    X'0009D'          NO -                                   03910
         STW,R1   GETBCCH                                                  03920
         BAL,R1   PICTRLS                                                  03930
         B        PICNSPM           GO CHECK FOR EMBEDDED SIGN
PICNSP1  LW,R1    PICTURH                                                  03950
         STW,R15  PICINFO+8         RESET TRAIL                            03960
         STW,R15  PICTRLF                                                  03970
         AND,R1   PICTPFB           FIRST +                                03980
         BCS,3    PICNSP2           NO -GOTO 9/./V (IF)
         LI,R1    X'0009A'          YES                                    04000
         STW,R1   GETBCCH                                                  04010
         LI,R1    2                                                        04020
         OR,R1    PICINFO+4                                                04030
         STW,R1   PICINFO+4         SET TR TO +                            04040
         LI,R1    1                                                        04050
         STW,R1   PICINFO+9         SET FS TO +                            04060
         BCR,0    PICNCV            GOTO CONVERT +(FS)                     04070
PICNSP2  LW,R1    GETNCCH           IMMEDIATELY FOLLOWING CHAR             04080
         CI,R1    C'9'                                                     04090
         BCR,3    PICNSP3           GOTO SET +(SS)                         04100
         CW,R1    PERIOD
         BCR,3    PICNSP3           GOTO SET +(SS)                         04120
         CI,R1    C'V'                                                     04130
         BCR,3    PICNSP3           GOTO SET +(SS)                         04140
         LI,R1    X'0009C'                                                 04150
         STW,R1   GETBCCH                                                  04160
         BCR,0    PICNCV            GOTO CONVERT +(DS)                     04170
PICNSP3  LI,R1    X'0009B'                                                 04180
         STW,R1   GETBCCH                                                  04190
         BCR,0    PICNCV            GOTO CONVERT +(SS)                     04200
PICNSP4  LI,R1    1                                                        04210
         STH,R1   PICINFO+3                                                04220
         BCR,0    PICNCV            SET LS TO +                            04230
         PAGE                                                              04240
*                                                                          04250
* PROCESS -                                                                04260
*                                                                          04270
PICNSM   LI,R1    X'00001'                                                 04280
         AND,R1   PICTUFH           FLOATING                               04290
         BCS,3    PICNSM1           YES-GOTO 1ST                           04300
         LW,R1    PICTURH           NO -                                   04310
         AND,R1   PIC9ZAD           LEADING                                04320
         BCS,3    PICNSM4           NO -                                   04330
         LI,R1    2                                                        04340
         STH,R1   PICINFO+3                                                04350
         LI,R1    X'000A1'          YES-                                   04360
         STW,R1   GETBCCH                                                  04370
         BAL,R1   PICTRLS                                                  04380
         BCR,0    PICNCV            GOTO CONVERT -(BLANK)                  04390
PICNSM1  LW,R1    PICTURH                                                  04400
         STW,R15  PICINFO+8         RESET TRAIL                            04410
         STW,R15  PICTRLF                                                  04420
         AND,R1   PICTMFB           FIRST -                                04430
         BCS,3    PICNSM2           NO -GOTO 9/./V (IF)                    04440
         LI,R1    X'0009E'          YES                                    04450
         STW,R1   GETBCCH                                                  04460
         LI,R1    2                                                        04470
         OR,R1    PICINFO+4                                                04480
         STW,R1   PICINFO+4         SET TR TO -                            04490
         LI,R1    2                                                        04500
         STW,R1   PICINFO+9         SET FS TO -                            04510
         BCR,0    PICNCV            GOTO CONVERT -(FS)                     04520
PICNSM2  LW,R1    GETNCCH           IMMEDIATELY FOLLOWING CHAR             04530
         CI,R1    C'9'                                                     04540
         BCR,3    PICNSM3           GOTO SET -(SS)                         04550
         CW,R1    PERIOD
         BCR,3    PICNSM3           GOTO SET -(SS)                         04570
         CI,R1    C'V'                                                     04580
         BCR,3    PICNSM3           GOTO SET -(SS)                         04590
         LI,R1    X'000A0'                                                 04600
         STW,R1   GETBCCH                                                  04610
         BCR,0    PICNCV            GOTO CONVERT -(DS)                     04620
PICNSM3  LI,R1    X'0009F'                                                 04630
         STW,R1   GETBCCH                                                  04640
         BCR,0    PICNCV            GOTO CONVERT -(SS)                     04650
PICNSM4  LI,R1    2                                                        04660
         LI,R2    7                                                        04670
         STH,R1   PICINFO,R2                                               04680
PICNSPM  LW,R1    GETNCCH
         CI,R1    C' '
         BE       PICNCV            GOTO CONVERT
         LI,R1    X'800'            EMBEDDED SIGN SET ILL SYN
         OR,R1    PICTURH
         STW,R1   PICTURH
         BCR,0    PICNCV                                                   04690
         PAGE                                                              04700
*                                                                          04710
* PROCESS %                                                                04720
*                                                                          04730
PICNSD   LI,R1    X'00004'                                                 04740
         STW,R15  PICINFO+8         RESET TRAIL                            04750
         STW,R15  PICTRLF                                                  04760
         AND,R1   PICTUFH           FLOATING                               04770
         BCS,3    PICNSD1           YES-GOTO 1ST                           04780
         LW,R1    PICTURH           NO -                                   04790
         AND,R1   PICTPMB           LEADING                                04800
         BCR,3    PICNSD4           YES-                                   04810
         LI,R1    2                                                        04820
         OR,R1    PICINFO+4         SET TR TO %                            04830
         STW,R1   PICINFO+4                                                04840
         BCR,0    PICNCV            GOTO CONVERT                           04850
PICNSD1  LW,R1    PICTURH                                                  04860
         AND,R1   PICTDFB           FIRST %                                04870
         BCS,3    PICNSD2           NO -GOTO 9/./V (IF)                    04880
         LI,R1    X'0008E'          YES-                                   04890
         STW,R1   GETBCCH                                                  04900
         LI,R1    2                                                        04910
         OR,R1    PICINFO+4                                                04920
         STW,R1   PICINFO+4         SET TR TO %                            04930
         LI,R1    3                                                        04940
         STW,R1   PICINFO+9         SET FS TO %                            04950
         BCR,0    PICNCV            GOTO CONVERT %(FS)                     04960
PICNSD2  LW,R1    GETNCCH           IMMEDIATELY FOLLOWING CHAR             04970
         CI,R1    C'9'                                                     04980
         BCR,3    PICNSD3           GOTO SET %(SS)                         04990
         CW,R1    PERIOD
         BCR,3    PICNSD3           GOTO SET %(SS)                         05010
         CI,R1    C'V'                                                     05020
         BCR,3    PICNSD3           GOTO SET %(SS)                         05030
         LI,R1    X'00090'                                                 05040
         STW,R1   GETBCCH                                                  05050
         BCR,0    PICNCV            GOTO CONVERT %(DS)                     05060
PICNSD3  LI,R1    X'0008F'                                                 05070
         STW,R1   GETBCCH                                                  05080
         BCR,0    PICNCV            GOTO CONVERT %(SS)                     05090
PICNSD4  LI,R1    3                                                        05100
         STH,R1   PICINFO+3         SET LS TO %                            05110
         BCR,0    PICNCV                                                   05120
         PAGE                                                              05130
*                                                                          05140
* PROCESS Z OR *                                                           05150
*                                                                          05160
PICNZA   LW,R1    PICTURH                                                  05170
         STW,R15  PICINFO+8         RESET TRAIL                            05180
         STW,R15  PICTRLF                                                  05190
         AND,R1   PICTZAB                                                  05200
         BCS,3    PICNZA1                                                  05210
         LW,R1    PICECNT                                                  05220
         STW,R1   PICINFO+7         SET LEADING CHAR                       05230
         LI,R2    4
         LW,R1    GETBCCH
         CI,R1    C'*'
         BE       %+2
         LI,R2    1
         OR,R2    PICINFO+4
         STW,R2   PICINFO+4         SET TR TO Z
PICNZA1  LW,R1    GETNCCH           IMMEDIATELY FOLLOWING CHAR             05240
         CI,R1    C'9'                                                     05250
         BCR,3    PICNZA2           GOTO SET Z*(SS)                        05260
         CW,R1    PERIOD
         BCR,3    PICNZA2           GOTO SET Z*(SS)                        05280
         CI,R1    C'V'                                                     05290
         BCS,3    PICNZA3           S1877 V DOES NOT FOLLOW Z OR *
PICNZA2  LW,R1    GETBCCH                                                  05310
         CI,R1    C'Z'              IS CHAR Z                              05320
         BCR,3    PICNSZ            YES-                                   05330
         LI,R1    X'0008D'          NO - *                                 05340
         STW,R1   GETBCCH           SET TO *(SS)                           05350
         BCR,0    PICNCV                                                   05390
PICNSZ   LI,R1    X'0008C'                                                 05400
         STW,R1   GETBCCH           SET TO Z(SS)                           05410
         BCR,0    PICNCV                                                   05450
*        SIDR 1877 - INCORRECT HANDLING OF .ZZZZZ- PICTURE
PICNZA3  LW,R2    GETPRCH
        CW,R2  PERIOD   SIDR 3803 ALLOW FOR DEC-PT IS COMMA             PICTURE
         BNE      PICNCV            NO - GO TO CONVERT
         LW,R1  GETBCCH                                                 PICTURE
         LI,R2    X'0008A'          SET TO *(SI)
         CI,R1    C'Z'
         BNE      %+2
         LI,R2    'Z'+1              SET TO Z(SI)
         STW,R2   GETBCCH
         B        PICNCV
         PAGE                                                              05460
*                                                                          05470
* PROCESS 9                                                                05480
*                                                                          05490
PICNS9   STW,R15  PICINFO+8
         STW,R15  PICTRLF           RESET TRAIL
         LW,R1    PICTURH
         AND,R1   PIC9PRB           FIRST 9OR.
         BCS,3    PICNCV            NO -GOTO CONVERT 9(DS)
         LW,R1    PICTUFH           YES-FLOAT
         BCR,3    PICNS92           NO -GO CHECK FOR SUPPRESS
         LW,R1    GETPRCH           YES-GET IMMEDIATELY PRECEDING CHAR
         CI,R1    C'0'
         BE       PICNS91
         CI,R1    C'B'
         BE       PICNS91
         CW,R1    COMMA
         BE       PICNS91
         BCR,0    PICNCV            GOTO CONVERT 9(DS)
PICNS91  LW,R1    PICECNT
         STW,R1   PICINFO+5
         BCR,0    PICNCV            GOTO CONVERT 9(DS)
PICNS92  LW,R1    PICTURH
         AND,R1   PICTZAB           SUPPRESSION
         BCR,3    PICNCV            NO -GOTO CONVERT 9(DS)
         LI,R1    X'00080'          YES-
         STW,R1   GETBCCH
         BCR,0    PICNCV            GOTO CONVERT 9(SI)
         PAGE                                                              05720
*                                                                          05730
* PROCESS .                                                                05740
*                                                                          05750
PICNPR   LW,R1    PICECNT                                                  05760
         AI,R1    1                                                        05770
         STW,R1   PICINFO+10        SET DEC POSITION                       05780
         LW,R1    PICINFO+8                                                05790
         AI,R1    1                 INCREMENT TRAIL CNT                    05800
         STW,R1   PICTRLF           SET 0,. FLAG                           05810
         STW,R1   PICINFO+8                                                05820
         STW,R15  PICDCNT           0 TO DEC CNT
PICNPR2  LW,R1    PICTU9B                                                  05840
         AND,R1   PICTURH                                                  05850
         BCS,3    PICNCV                                                   05860
         LW,R1    PICZFB
         AND,R1   PICTURH           SUPPRESS OR FLOAT
         BCR,3    PICNCV            NO-GOTO CONVERT .
         LW,R1    GETPRCH           YES-GET IMMEDIATELY PRECEDING CHAR
         CI,R1    C'0'
         BE       PICNPR1
         CI,R1    C' '
         BE       PICNPR1
         CI,R1    C','
         BE       PICNPR1
         BCR,0    PICNCV            GOTO CONVERT .
PICNPR1  LW,R1    PICECNT
         STW,R1   PICINFO+5         SET LEADING COUNT                      05880
         BCR,0    PICNCV                                                   05890
*                                                                          05900
* PROCESS 0 AND ,                                                          05910
*                                                                          05920
PICNC0   LW,R1    PICINFO+8                                                05930
         AI,R1    1                 INCREMENT TRAL COUNT                   05940
         STW,R1   PICTRLF           SET 0/,/. FLAG                         05950
         STW,R1   PICINFO+8                                                05960
         BCR,0    PICNCV                                                   05970
*                                                                          05980
* PROCESS B                                                                05990
*                                                                          06000
PICNB    LW,R1    GETPRCH                                                  06010
         CI,R1    X'000C4'                                                 06020
         BCR,3    PICNCV                                                   06030
         LI,R1    X'00040'                                                 06040
         STW,R1   GETBCCH           SET TO (BLANK)                         06050
         LW,R1    PICINFO+8                                                06060
         AI,R1    1                 INCREMENT TRAIL CNT                    06070
         STW,R1   PICINFO+8                                                06080
         BCR,0    PICNCV                                                   06090
*                                                                          06100
* PROCESS D OR C                                                           06110
*                                                                          06120
PICNDC   LI,R1    3                                                        06130
         LI,R2    7                                                        06140
         STH,R1   PICINFO,R2                                               06150
         LW,R1    PICINFO+8                                                06160
         AI,R1    1                 INCREMENT TRAIL CNT                    06170
         STW,R1   PICINFO+8                                                06180
         BAL,R1   PICTRLS                                                  06190
         BCR,0    PICNCV                                                   06200
*                                                                          06210
* PROCESS V                                                                06220
*                                                                          06230
PICNSV   LW,R1    PICTPTB                                                  06240
         AND,R1   PICTURH                                                  06250
         BCS,3    PICNCV
         STW,R15  PICDCNT
         LI,R1    PICTU9B
         AND,R1   PICTURH           ANY NINES
         BCS,3    PICNCV            YES-
         LW,R1    GETPRCH           NO -GET IMMEDIATELY PRECEDING CHAR
         CI,R1    C'0'
         BE       PICNSV2
         CI,R1    C' '
         BE       PICNSV2
         CI,R1    C','
         BE       PICNSV2
         BCR,0    PICNCV
PICNSV2  LW,R2    PICTUFH           FLOAT
         BCS,3    PICNSV1           YES
         LW,R1    PICTZAB           NO-
         AND,R1   PICTURH           SUPPRESS
         BCR,3    PICNCV            NO
         LW,R1    GETNCCH           YES-GET IMMEDIATELY FOLLOWING CHAR
         CI,R1    C'0'
         BE       PICNSV1
         CI,R1    C' '
         BE       PICNSV1
         CI,R1    C','
         BE       PICNSV1
         BCR,0    PICNCV
PICNSV1  LW,R1    PICECNT           SET LEADING CNT
         STW,R1   PICINFO+5
         PAGE                                                              06280
PICNCV   LW,R1    GETBCCH                                                  06290
         CI,R1    X'00040'                                                 06300
         BCR,4    PICNCV1                                                  06310
         LI,R2    X'0003F'                                                 06320
         AND,R1   R2                                                       06330
         BCR,0    PICNCV2                                                  06340
PICNCV1  LI,R2    X'0003F'                                                 06350
         AND,R1   R2                                                       06360
         LI,R2    X'00040'                                                 06370
         OR,R1    R2                                                       06380
PICNCV2  STW,R1   PICPCCH           STORE PRECEDENCE CCH                   06390
PICNLPE  LW,R1    PICPCCH                                                  06400
         LW,R2    PRECTAB,R1        PRECEDENCE ENTRY IN %R2<               06410
         LW,R3    PICTUHM           HISTORY MASK                           06420
         AND,R3   PICTURH           HISTORY                                06430
         AND,R3   R2                LEGAL SYNTAX                           06440
         BCR,3    PICNINC           YES-GOTO INCREMENT                     06450
         LI,R3    X'00800'          NO -                                   06460
         OR,R3    PICTURH                                                  06470
         STW,R3   PICTURH           SET ILLEGAL SYNTAX BIT                 06480
*                                                                          06490
* INCREMENT ALL PICTURE COUNTS HERE                                        06500
*                                                                          06510
PICNINC  LI,R3    X'00800'                                                 06520
         AND,R3   R2                DEC BIT SET                            06530
         BCR,3    PICNIN1           NO -GOTO EXT CNT                       06540
         LW,R3    PICDCNT           YES-                                   06550
         AI,R3    X'00001'          INCREMENT DEC CNT                      06560
         STW,R3   PICDCNT                                                  06570
PICNIN1  LI,R3    X'00400'          EXT BIT SET                            06580
         AND,R3   R2                                                       06590
         BCR,3    PICNIN2           NO -GOTO INT CNT                       06600
         LW,R3    PICECNT           YES-                                   06610
         AI,R3    X'00001'          INCREMENT EXT CNT                      06620
         STW,R3   PICECNT                                                  06630
PICNIN2  LI,R3    X'00200'          INT BIT SET                            06640
         AND,R3   R2                                                       06650
         BCR,3    PICTUOR           NO -GOTO OR BIT TO HISTORY             06660
         LW,R3    PICICNT           YES-                                   06670
         AI,R3    X'00001'          INCREMENT INT CNT                      06680
         STW,R3   PICICNT                                                  06690
*                                                                          06700
* OR CHAR TO HISTORY                                                       06710
*                                                                          06720
PICTUOR  LI,R1    X'0001F'                                                 06730
         AND,R1   R2                                                       06740
         LI,R3    X'00400'                                                 06750
         SLS,R3   0,R1                                                     06760
         OR,R3    PICTURH                                                  06770
         STW,R3   PICTURH                                                  06780
         LW,R1    PICINFO                                                  06790
         CI,R1    PICNUMU
         BCR,3    PICNSC2           YES-GOTO GET NEXT BYTE                 06810
*                                                                          06820
* PACK NUMERIC MURAL                                                       06830
*                                                                          06840
         LW,R3    GETBCCH                                                  06850
         CI,R3    C'S'                                                     06860
         BCR,3    PICNSC2           S GOTO GET NEXT CHAR                   06870
         CI,R3    C'V'                                                     06880
         BCR,3    PICNSC2           V-GOTO GET NEXT BYTE                   06890
         CI,R3    C'P'                                                     06900
         BCR,3    PICNSC2           P(L)-GOTO GET NEXT BYTE                06910
         CI,R3    X'0008B'                                                 06920
         BCR,3    PICNSC2           P(T)-GOTO GET NEXT BYTE                06930
         LW,R3    PICECNT                                                  06940
         AI,R3    -1                                                       06950
         LI,R1    X'001E0'                                                 06960
         AND,R1   R2                                                       06970
         SLS,R1   -5                                                       06980
         LB,R1    PICMMT,R1         MURAL MASK CODE                        06990
         STB,R1   PICINFO+11,R3                                            07000
         BCR,0    PICNSC2           GOTO GET NEXT CHAR                     07010
         PAGE                                                              07020
*                                                                          07030
* NUMERIC END OF PICTURE                                                   07040
*                                                                          07050
PICNEOP  LI,R1    X'00400'                                                 07060
         AND,R1   PICTURH                                                  07070
         BCR,3    PICNEO1                                                  07080
         LI,R1    PICDIAG3
         BAL,R11   DIAG
PICNEO1  LI,R1    X'00800'                                                 07110
         AND,R1   PICTURH                                                  07120
         BCR,3    PICNEO2                                                  07130
         LI,R1    PICDIAG4
         BAL,R11   DIAG
         BCR,0    PICDROP           GOTO DROP PICTURE                      07160
PICNEO2  LW,R1    PICECNT                                                  07170
         STW,R1   PICINFO+1         SIZE                                   07180
         LW,R1    PICDCNT                                                  07200
         STW,R1   PICINFO+2         POINT LOCATION                         07210
         LW,R1    PICTPTB                                                  07220
         AND,R1   PICTURH                                                  07230
         BCR,3    PICNEO3                                                  07240
         LW,R1    PICICNT                                                  07250
         SW,R1    PICDCNT                                                  07260
         STW,R1   PICINFO+2         POINT LOCATION                         07270
         BCR,0    PICNEO4                                                  07280
PICNEO3  LW,R1    PICPLCB                                                  07290
         AND,R1   PICTURH                                                  07300
         BCS,3    PICNEO4                                                  07310
         STW,R15  PICINFO+2                                                07320
PICNEO4  LW,R1    PICNTMP                                                  07330
         BCR,0    0,R1              RETURN                                 07340
PICNEO5  LI,R1    PICDIAG5
         BAL,R11  DIAG              EXCESS EDIT MASK
         BCR,0    PICNEOP
*                                                                          07350
* TRAILING SIGN                                                            07360
*                                                                          07370
PICTRLS  LW,R2    PICTRLF           TRAILING 0/,/.                         07380
         BCR,3    PICTRL1           NO -                                   07390
         LW,R2    PICINFO+8         YES-                                   07400
         AI,R2    1                 INCREMENT TRAILING INSERT CNT          07410
         STW,R2   PICINFO+8                                                07420
         BCR,0    0,R1                                                     07430
PICTRL1  STW,R15  PICINFO+8         ZERO TO TRAILING INSERT CNT            07440
         BCR,0    0,R1                                                     07450
         PAGE                                                              07460
*                                                                          07470
* PICTURE CONSTANTS                                                        07480
*                                                                          07490
         BOUND    4                                                        07500
PICT31L  DATA     X'1F000000'       MAXIMUM LENGTH OF PICTURE CHARACTORS   07510
PICILCM  DATA     X'C0000000'       ILLEGAL CHARACTOR MASK                 07520
PICMK07  DATA     X'07000000'
PICMK08  DATA     X'08000000'
PICMK10  DATA     X'10000000'       NUMERIC EDIT MASK                      07660
PICMK20  DATA     X'20000000'       NUMERIC MASK                           07650
PICMK40  DATA     X'40000000'
PICMK80  DATA     X'80000000'
PIC9ZAD  DATA     X'8C804000'       9Z*%.-BIT                              07550
PICTPFB  DATA     X'00001000'       +(F)-BIT                               07560
PICTMFB  DATA     X'00002000'       -(F)-BIT                               07570
PICTDFB  DATA     X'00004000'       %(F)-BIT                               07580
PICTPMB  DATA     X'00180000'       +AND--BIT                              07590
PICTZAB  DATA     X'0C000000'       Z AND *-BIT                            07600
PICTU9B  DATA     X'80000000'       9-BIT                                  07610
PIC9ZAB  DATA     X'8C000000'       9Z*-BITS                               07620
PICTTBC  DATA     X'01000000'       TTBS COUNT DECREMENT                   07630
PICBYTM  DATA     X'000000FF'       BYTE MASK                              07640
PICTUSB  DATA     X'40000000'       S-BIT                                  07670
PICTUBB  DATA     X'00008000'       B%T<-BIT                               07680
PICTUHM  DATA     X'FFFFF000'       HISTORY MASK                           07690
PICTU15  DATA     X'0000000F'                                              07700
PICPLCB  DATA     X'30808000'       POINT LOC BITS                         07710
PICTVPS  DATA     X'8FFFF000'       VPS-BITS                               07720
PICTPTB  DATA     X'00008000'       P%T<-BITS                              07730
PIC9PVB  DATA     X'A0800000'       9.V-BIT                                07740
PICTRLF  DATA     X'10000000'       TRAIL 0,. FLAG                         07750
PICMKCL  DATA     X'00FFFFFF'       MASK CLEAR
PIC9PRB  DATA     X'80800000'       9.-BIT
PICZFB   DATA     X'0C007000'       SUPRESS FLOAT-BIT
         PAGE                                                              07760
*                                                                          07770
* PICTURE VARIBLES                                                         07780
*                                                                          07790
PICTURH  DATA     0                 PICTURE HISTORY                        07800
PICTUFH  DATA     0                 FLOAT HISTORY                          07810
PICSIZE  DATA     0                 PICTURE SIZE                           07820
PICNTMP  DATA     0                                                        07830
PICTMP   DATA     0                 INDEX STORAGE                          07840
         DATA     0                                                        07850
         DATA     0                                                        07860
         DATA     0                                                        07870
         DATA     0                                                        07880
         DATA     0                                                        07890
         DATA     0                                                        07900
         DATA     0                                                        07910
         DATA     0                                                        07920
         DATA     0                                                        07930
         DATA     0                                                        07940
         DATA     0                                                        07950
         DATA     0                                                        07960
         DATA     0                                                        07970
         DATA     0                                                        07980
PICPCCH  DATA     0                 CONVERTED PRECEDENCE CHAR              07990
PICDCNT  DATA     0                                                        08000
PICECNT  DATA     0                                                        08010
PICICNT  DATA     0                                                        08020
PICANDC  DATA     0                 DESCRIPTOR CNT                         08030
PICANKY  DATA     0                 KEY                                    08040
PICTTBM  DATA     0                 TTBS MASK TEMP
*
* COMPARISON WORDS
*
PERIOD   DATA     X'0000004B'
COMMA    DATA     X'0000006B'
DSIGN    DATA     X'0000005B'
         PAGE                                                              08230
*                                                                          08240
* PICTURE INFORMATION TABLE                                                08250
*                                                                          08260
PIC      DATA     0                 PICTURE PRESENT FLAG             BWZ
BWZ      DATA     0                 BWZ     PRESENT FLAG             BWZ
STRING2  DATA     0,0,0,0           PICTURE STRING BUFFER            BWZ
         DATA     0,0,0,0                                            BWZ
PICINFO  DATA     0                 CLASS                                  08270
         DATA     0                 SIZE                                   08280
         DATA     0                 POINT LOCATION                         08290
         DATA     0                 LEFT SIGN / RIGHT SIGN                 08300
         DATA     0                 TYPE OF REPLACEMENT                    08310
         DATA     0                 NO. OF INSERT CHAR PRECEDING 9/./V     08320
         DATA     0                 NO. OF DIGIT POSITIONS                 08330
         DATA     0                 NO. OF LEADING INSERTIONS              08340
         DATA     0                 NO. OF TRAILING INSERTIONS             08350
         DATA     0                 FLOATING SIGN                          08360
         DATA     0                 CHAR POSITION OF '.' WITHIN MASK       08370
         DATA     0                 LENGTH OF EDITING MASK                 08380
         DO       64                                                       08390
         DATA     0                    EDITING MASK                        08400
         FIN                                                               08410
*                                                                          08420
* MURAL MASK TABLE                                                         08430
*                                                                          08440
PICMMT   DATA     X'00202122'         /DS/SS/FS                            08450
         DATA     X'23F0406B'       SI/ 0/ L/,                             08460
         DATA     X'4B4E605B'        ./ +/ -/%                             08470
         DATA     X'C2C3D9C4'        B/ C/ R/D                             08480
         PAGE                                                              08490
*                                                                          08500
* TTBS SOURCE TABLE                                                        08510
*                                                                          08520
         BOUND    4                                                        08530
PICTTBS  DATA     X'48484848'       XXXX
         DATA     X'48484848'       XXXX
         DATA     X'48484848'       XXXX
         DATA     X'48484848'       XXXX
         DATA     X'48484848'       XXXX
         DATA     X'48484848'       XXXX
         DATA     X'48484848'       XXXX
         DATA     X'48484848'       XXXX
         DATA     X'48484848'       XXXX
         DATA     X'48484848'       XXXX
         DATA     X'48484848'       XXXX
         DATA     X'48484848'       XXXX
         DATA     X'48484848'       XXXX
         DATA     X'48484848'       XXXX
         DATA     X'48484848'       XXXX
         DATA     X'48484848'       XXXX
         DATA     X'48484848'       XXXX
         DATA     X'48484848'       XXXX
         DATA     X'48484830'       XXX.
         DATA     X'48E83248'       X(+X
         DATA     X'48484848'       XXXX
         DATA     X'48484848'       XXXX
         DATA     X'48484834'       XXX%
         DATA     X'30E84848'       *)XX
         DATA     X'31484848'       -XXX
         DATA     X'48484848'       XXXX
         DATA     X'48484830'       XXX,
         DATA     X'48484848'       XXXX
         DATA     X'48484848'       XXXX
         DATA     X'48484848'       XXXX
         DATA     X'48484848'       XXXX
         DATA     X'48484848'       XXXX
         DATA     X'48484848'       XXXX
         DATA     X'48484848'       XXXX
         DATA     X'48484848'       XXXX
         DATA     X'48484848'       XXXX
         DATA     X'48484848'       XXXX
         DATA     X'48484848'       XXXX
         DATA     X'48484848'       XXXX
         DATA     X'48484848'       XXXX
         DATA     X'48484848'       XXXX
         DATA     X'48484848'       XXXX
         DATA     X'48484848'       XXXX
         DATA     X'48484848'       XXXX
         DATA     X'48484848'       XXXX
         DATA     X'48484848'       XXXX
         DATA     X'48484848'       XXXX
         DATA     X'48484848'       XXXX
         DATA   X'48208030'  XABC  SIDR 2234  4/16/71                   PICTURE
         DATA     X'30484848'       DXXX
         DATA     X'48484848'       XXXX
         DATA     X'48484848'       XXXX
         DATA     X'48484848'       XXXX
         DATA     X'48484810'       XXXP
         DATA     X'48304848'       XRXX
         DATA     X'48484848'       XXXX
         DATA     X'48481048'       XXSX
         DATA     X'48104820'       XVXX(REAL)
         DATA     X'48304848'       XZXX
         DATA     X'48484848'       XXXX
         DATA     X'A0606060'       0123
         DATA     X'60606060'       4567
         DATA     X'60004848'       89XX
         DATA     X'48484848'       XXXX
         PAGE                                                              09180
*                                                                          09190
* PRECEDENCE TABLE                                                         09200
*                                                                          09210
PRECTAB  RES      0
         DATA     X'400784CC'       ENTRY  B(BLANK)
         DATA     X'000004C0'              A                               09230
         DATA     X'401D858C'              B(AFTER D)                      09240
         DATA     X'401FB5A8'              C                               09250
         DATA     X'401FB5E7'              D                               09260
         DATA     X'000004C0'              E                               09270
         DATA     X'000004C0'              F                               09280
         DATA     X'000004C0'              G                               09290
         DATA     X'000004C0'              H                               09300
         DATA     X'000004C0'              I                               09310
         DATA     X'000004C0'              `                               09320
         DATA     X'7087850D'              .                               09330
         DATA     X'000004C0'              <                               09340
         DATA     X'000004C0'              (                               09350
         DATA     X'CFFFF529'              +(LEAD)                         09360
         DATA     X'000004C0'              |                               09370
         DATA     X'000004C0'              &                               09380
         DATA     X'000004C0'              J                               09390
         DATA     X'000004C0'              K                               09400
         DATA     X'000004C0'              L                               09410
         DATA     X'000004C0'              M                               09420
         DATA     X'000004C0'              N                               09430
         DATA     X'000784AB'              O                               09440
         DATA     X'8F7FF812'              P(LEAD)                         09450
         DATA     X'000004C0'              Q                               09460
         DATA     X'401BB5C6'              R                               09470
         DATA     X'000004C0'              !                               09480
         DATA     X'CFE7F56F'              %(LEAD)                         09490
         DATA     X'C807FE30'              *(DS)
         DATA     X'000004C0'              )                               09510
         DATA     X'000004C0'              ;                               09520
         DATA     X'000004C0'              ~                               09530
         DATA     X'401F954A'       -(TRAIL)
         DATA     X'000004C0'              /                               09550
         DATA     X'FFFFF014'              S                               09560
         DATA     X'000004C0'              T                               09570
         DATA     X'000004C0'              U                               09580
         DATA     X'30800013'              V
         DATA     X'000004C0'              W                               09600
         DATA     X'000004C0'              X                               09610
         DATA     X'000004C0'              Y                               09620
         DATA     X'C407FE31'              Z(DS)
         DATA     X'C407FE91'        Z(SI)  (SIDR 1877)
         DATA     X'400784EE'              ,                               09650
         DATA     X'000004C0'              %                               09660
         DATA     X'000004C0'                                             09670
         DATA     X'000004C0'              >                               09680
         DATA     X'000004C0'              ?                               09690
         DATA     X'000784AB'              0                               09700
         DATA     X'000004C0'              1                               09710
         DATA     X'000004C0'              2                               09720
         DATA     X'000004C0'              3                               09730
         DATA     X'000004C0'              4                               09740
         DATA     X'000004C0'              5                               09750
         DATA     X'000004C0'              6                               09760
         DATA     X'000004C0'              7                               09770
         DATA     X'000004C0'              8                               09780
         DATA     X'00078E35'              9(DS)                           09790
         DATA     X'000004C0'              :                               09800
         DATA     X'000004C0'              #                               09810
         DATA     X'000004C0'              @                               09820
         DATA     X'000004C0'              '                               09830
         DATA     X'000004C0'              =                               09840
         DATA     X'000004C0'              "                               09850
         DATA     X'00078E95'              9(SI)                           09860
         DATA     X'000004C0'              A (LOWER CASE)                  09870
         DATA     X'000004C0'              B                               09880
         DATA     X'000004C0'              C                               09890
         DATA     X'000004C0'              D                               09900
         DATA     X'000004C0'              E                               09910
         DATA     X'000004C0'              F                               09920
         DATA     X'000004C0'              G                               09930
         DATA     X'000004C0'              H                               09940
         DATA     X'000004C0'              I                               09950
         DATA     X'C807FE90'        *(SI)  (SIDR 1877)
         DATA     X'30800805'              P(TRAIL)                        09970
         DATA     X'C407FE51'              Z(SS)
         DATA     X'C807FE50'              *(SS)
         DATA     X'CE07B464'              %(FS)                           10000
         DATA     X'CE07BE44'              %(SS)                           10010
         DATA     X'CE07BE24'              %(DS)                           10020
         DATA     X'000004C0'              J                               10030
         DATA     X'000004C0'              K                               10040
         DATA     X'000004C0'              L                               10050
         DATA     X'000004C0'              M                               10060
         DATA     X'000004C0'              N                               10070
         DATA     X'000004C0'              O                               10080
         DATA     X'000004C0'              P                               10090
         DATA     X'000004C0'              Q                               10100
         DATA     X'000004C0'              R                               10110
         DATA     X'CC1FE462'              +(FS)                           10120
         DATA     X'CC1FEE42'              +(SS)                           10130
         DATA     X'CC1FEE22'              +(DS)                           10140
         DATA     X'401FB549'              +(-)                            10150
         DATA     X'CC1FD463'              -(FS)                           10160
         DATA     X'CC1FDE43'              -(SS)                           10170
         DATA     X'CC1FDE23'              -(DS)                           10180
         DATA     X'CFFFF4CA'              -(BLANK)                        10190
         DATA     X'000004C0'              S                               10200
         DATA     X'000004C0'              T                               10210
         DATA     X'000004C0'              U                               10220
         DATA     X'000004C0'              V                               10230
         DATA     X'000004C0'              W                               10240
         DATA     X'000004C0'              X                               10250
         DATA     X'000004C0'              Y                               10260
         DATA     X'000004C0'              Z                               10270
         PAGE                                                              10280
*                                                                          10290
* INITILIZE GETBYT ROUTINE                                                 10300
*                                                                          10310
IGETBYT  STW,R15  GETBRPG           RESET-REPEAT GATE                      10320
         STW,R15  GETBRPC                  REPEAT COUNT                    10330
         STW,R15  GETBCHC                  CHAR COUNT                      10340
         STW,R15  GETBCCH           INIT CURRENT CHAR                      10350
         STW,R15  GETPRCH                PREVIOUS CHAR                     10360
         STW,R15  GETNCCH                NEXT CHAR                         10370
         STW,R15  GETBPCH                PREVIOUS-CURRENT CHAR             10380
         BCR,0    0,R1              RETURN                                 10390
*                                                                          10400
* GETBYT ROUTINE                                                           10410
*    EXPECTS PICTURE CHARACTORS IN STRING                                  10420
*    PICKS UP NEXT SEQUENCAL CHARACTOR                                     10430
*    PROCESSES REPEATED CHAR INDICATION                                    10440
*    RETURN +1 NORMAL                                                      10450
*           +2 END OF-PICTURE                                              10460
*                                                                          10470
GETBYT   LCI      4                                                        10480
         STM,R1   GETBTMP           SAVE RETURN REGISTER                   10490
GETBRGO  LW,R1    GETBRPG                                                  10500
         CI,R1    0                 IS REPEAT GATE ON                      10510
         BCR,3    GETBGNC           NO GOTO GET CHAR                       10520
         LW,R1    GETBRPC           YES                                    10530
         AI,R1    -1                                                       10540
         STW,R1   GETBRPC                                                  10550
         CI,R1    0                 IS REPEAT COUNT GREATER THAN 0         10560
         BCS,2    GETBGSC           YES                                    10570
         STW,R15  GETBRPG           NO- TURN OFF REPEAT GATE               10580
         BCR,0    GETBRGO           GOTO IS REPEAT GATE ON                 10590
GETBGSC  CI,R1    1
         BCS,2    GETBGS1
         LW,R2    GETBCHC
         LB,R2    STRING,R2
         STW,R2   GETNCCH           SET NEXT CHAR
GETBGS1  STW,R1   GETBCCH
         LW,R1    GETBPCH
         STW,R1   GETBCCH
GETEXT1  LCI      4                                                        10620
         LM,R1    GETBTMP           RETURN +1  NORMAL                      10630
         BCR,0    0,R1                                                     10640
GETBGNC  LW,R2    GETBCHC                                                  10650
         LB,R1    STRING,R2                                                10660
         STW,R1   GETBCCH                                                  10670
         AI,R2    1                 INCREMENT CHAR COUNT                   10680
         STW,R2   GETBCHC                                                  10690
         LB,R4    STRING,R2                                                10700
         STW,R4   GETNCCH                                                  10710
         CI,R1    X'00040'          IS CURRENT CHAR BLANK                  10720
         BCR,3    GETEXT2           YES-END OF PICTURE                     10730
         CI,R1    C'('              NO-IS CURRENT CHAR OPEN BRACKET        10740
         BCR,3    GETBPRP           YES-GO PROCESS BRACKETED QUANTITY      10750
         LW,R2    GETBPCH                                                  10760
         STW,R2   GETPRCH                                                  10770
         STW,R1   GETBPCH           NO-SAVE CURRENT CHAR                   10780
         BCR,0    GETEXT1           GOTO EXIT NORMAL                       10790
GETEXT2  LCI      4                                                        10800
         LM,R1    GETBTMP           LOAD RETURN REGISTER                   10810
         BCR,0    1,R1              RETURN +2 END OF PICTURE               10820
*                                                                          10830
* PROCESS BRACKETED QUANTITY                                               10840
*                                                                          10850
GETBPRP  STW,R15  GETBRPC                                                  10860
GETBPRL  LB,R1    STRING,R2                                                10870
         AI,R2    1                 INCREMENT CHAR CNT                     10880
         STW,R2   GETBCHC                                                  10890
         CI,R1    C')'              IS CURRENT CHAR A CLOSE BRACKET        10900
         BCR,3    GETBMAX           YES GO CHECK FOR MAX                   10910
         CI,R1    C'0'              NO-IS CHAR LESS THAN 0                 10920
         BCS,1    GETBER1           YES-GOTO ERROR 1                       10930
         CI,R1    C'9'              NO-IS CHAR GREATER THAN 9              10940
         BCS,2    GETBER1           YES-GOTO ERROR 1                       10950
         LW,R3    GETBRPC           NO                                     10960
         AND,R1   PICTU15           CONVERT TO HEX                         10970
         MI,R3    10                                                       10980
         AW,R3    R1                REPEAT COUNT X 10 + NUM CHAR           10990
         STW,R3   GETBRPC                                                  11000
         BCR,0    GETBPRL           GO GET NEXT CHAR                       11010
GETBMAX  RES      0
         LI,R1    C'('              IS ) FOLLOWED BY (                  PICTURE
         CB,R1    STRING,R2         CHECK IT                            PICTURE
         BNE      GETMAX0           IF NOT OK                           PICTURE
         LI,R1    -PICDIAG4         ISSUE DIAGNOSTIC                    PICTURE
         BAL,R11  DIAG                                                  PICTURE
GETMAX0  RES      0                                                     PICTURE
         LW,R1    GETBPCH
         STW,R1   GETNCCH           SET NCCH TO REPEAT CHAR
         LI,R1    1
         STW,R1   GETBRPG           SET REPEAT GATE                        11030
         LI,R3    255               SET MAX ALLOWABLE TO 255
         LW,R4    PICINFO
         CI,R4    PICALPH
         BCR,3    GETMAX1
         CI,R4    PICNUMU
         BCR,3    GETMAX1
         BCR,0    GETMAX2           IS CLASS EDITED
GETMAX1  LI,R3    65535             SET TO MAX
GETMAX2  CW,R3    GETBRPC           IS REPEAT COUNT GREATR THA ALLOWED
         BGE      GETBRGO           NO
         STW,R3   GETBRPC           SET REPEAT COUNT TO MAX                11080
         LI,R1    PICDIAG1
         BAL,R11   DIAG
         BCR,0    GETBRGO           GOTO IS REPEAT GATE ON                 11110
GETBER1  LI,R1    PICDIAG2
         BAL,R11   DIAG
         BCR,0    PICDROP           GOTO DROP PICTURE                      11140
         PAGE                                                              11150
*                                                                          11160
* GET BYTE VARIBLES                                                        11170
*                                                                          11180
        BOUND     4                                                        11190
GETBRPG  DATA     0                 REPEAT GATE                            11200
GETBRPC  DATA     0                 REPEAT COUNT                           11210
GETBCHC  DATA     0                 CURRENT CHAR COUNT                     11220
GETBCCH  DATA     0                 CURRENT CHAR                           11230
GETBPCH  DATA     0                 PREVIOUS-CURRENT CHAR                  11240
GETPRCH  DATA     0                 PREVIOUS CHAR                          11250
GETNCCH  DATA     0                 NEXTED CHAR                            11260
GETBTMP  DATA     0                 REGISTER TEMP                          11270
         DATA     0                                                        11280
         DATA     0                                                        11290
         DATA     0                                                        11300
         END      PICTURE
