         SYSTEM   SIG7FDP
         SYSTEM   BPM
         DEF      C:STM,C:MTS
         REF      C:CFD,C:CDB,C:CBD,C:VPL,C:ABA
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
         BOUND    8
SENDA    RES      1                 BA OF SENDING
SENDSZ   RES      1                 BYTE SIZE OF SENDING
INTOA    RES      1                 BA OF INTO
INTOSZ   RES      1                 BYTE SIZE OF INTO
DELRA    RES      1                 BA OF DELIMITER
DELRSZ   RES      1                 BYTE SIZE OF DELIMITER
PONTA    RES      1                 BA OF POINTER
PONTSZ   RES      1                 BYTE SIZE OF POINTER
TALYA    RES      1                 BA OF TALLYING
TALYSZ   RES      1                 BYTE SIZE OF TALLYING
CONTA    RES      1                 BA OF COUNTER
CONTSZ   RES      1                 BYTE SIZE OF COUNTER
DELIA    RES      30                BA AND SIZE OF DELIMITED
MVB1     DATA     BA(CVDATA)
DCMPR    DATA     X'0C5C40F0'       VARIOUS DATA
CVDATA   RES      5                 DATA BUFFER
OVERF    DATA     0                 OVERFLOW FLAG
FSZ      RES      0                 FLOATING SHORT ZERO
FLZ      DATA     X'48000000'       FLOATING LONG ZERO
         DATA     0
SENDCL   DATA     0                 CLASSES OF DATA
INTOCL   DATA     0
DELRCL   DATA     0
PONTCL   DATA     0
TALYCL   DATA     0
CONTCL   DATA     0
DELICL   RES      15
EDITP    DATA     0                 EDITING OPTION AND MASK ADDR
MASKD    RES      3                 EDITING INFORMATION
MSKTJ    RES      1                 TJ
MSKTK    RES      1                 TK
MSKTL    RES      1                 TL
MSKTM    RES      1                 TM
MSKTD    RES      1                 CURRENCY SIGN
MSKTN    RES      1                 DIGIT SIZE
*** NO INSERTION AND/OR ADDITION ABOVE THIS LINE ***
EXUFL    MBS,0    BA(CVDATA)-1      ZERO FILL
         MBS,0    BA(CVDATA)-2      BLANK FILL
DLDMY    GEN,12,20   X'7E0',CVDATA    DL,0  CVDATA
PKDMY    GEN,12,3,17 X'760',5,CVDATA  PACK,0  CVDATA,R5
MSKDR    GEN,8,24 0,BA(EDITP)
DELICT   DATA     0                 DELIMITED COUNT
POINTR   DATA     0                 POINTER OF FIELD
POINTF   DATA     0                 POINTER FLAG
TALYCT   DATA     0                 TALLYING COUNT
TODRCT   DATA     0                 SIZE GO TO DELIMITER
TOINA    DATA     0                 BA OF SENDING GO TO INTO
TODRA    DATA     0                 BA OF SENDING GO TO DELIMITER
ACTSZ    DATA     0                 SIZE OF CURRENT SENDING
ANEJR    DATA     0                 NO. OF LEADING BLANK
INSRT    DATA     0                 INSERTION FLAG
FIELD1   DATA     0                 FIRST FIELD FLAG
ENDF     DATA     0                 END OF STATEMENT FLAG
VADRF    DATA     0
SAVR     RES      15                REGISTERS SAVE AREA
BIMTS    DATA,2   MTS20-MTS17,MTS20-MTS17
         DATA,2   MTS17-MTS17,MTS23-MTS17
         DATA,2   MTS22-MTS17,MTS30-MTS17
         DATA,2   MTS17-MTS17,MTS17-MTS17
BTOBI    DATA,2   NDSU-FLTL,NDSU-FLTL
         DATA,2   PDSU-FLTL,PDSU-FLTL
         DATA,2   ERROR-FLTL,ERROR-FLTL
         DATA,2   BINY-FLTL,BINY-FLTL
         DATA,2   FLTS-FLTL,FLTL-FLTL
BBINT    DATA,2   BDDSP-BFLTL,BDDSP-BFLTL
         DATA,2   BPDEC-BFLTL,BPDEC-BFLTL
         DATA,2   ERROR-BFLTL,ERROR-BFLTL
         DATA,2   BBIN-BFLTL,BBIN-BFLTL
         DATA,2   BFLTS-BFLTL,BFLTL-BFLTL
         TITLE    'C:STM - RUNTIME ROUTINE FOR STRING STATEMENT'
C:STM    LCI      15                SAVE REGISTERS
         STM,R1   SAVR
         LI,R6    1
         BAL,R9   VLAS              RESOLVE VAR RECORD
         LI,R4    0
         STW,R4   POINTR            SET POINTER FLAG
         INT,R2   0,R7
         BCR,8    STM1              NO POINTER
         LI,R6    3
         BAL,R9   VLAS1             RESOLVE VAR REC
         BAL,R9   TOBIN             CONVERT TO BINARY
         BLEZ     STM18             BAD POINTER
         CW,R4    INTOSZ
         BG       STM18             BAD POINTER
         MTW,1    POINTF            SET POINTER FLAG
         AI,R4    -1
         STW,R4   POINTR            SET POINTER FLAG
STM2     INT,R2   0,R7
         BCS,1    STM3              SENDING
STM1     LI,R6    6
         BAL,R9   VLAS1             RESOLVE VAR REC
         INT,R2   0,R7
STM3     STW,R2   ENDF              END OF STATEMENT FLAG
         LI,R6    0
         BAL,R9   VLAS1             RESOLVE VAR REC
         STW,R7   SAVR+6
         LW,R3    DELIA+1           DELIMITED SIZE
         CW,R3    SENDSZ
         BG       STM7              DELIMITED NOT USEFUL
         MTW,0    DELICL            SIZE OPTION
         BEZ      STM12             NO
STM7     LW,R5    INTOSZ            INTO SIZE
         SW,R5    POINTR            POINTER
         SW,R5    SENDSZ            SENDING SIZE
         BGEZ     STM8
         MTW,1    OVERF             OVERFLOW
         AW,R5    SENDSZ
         B        STM9
STM8     LW,R5    SENDSZ            SENDING SIZE
STM9     LW,R3    INTOA             INTO ADDR
         AW,R3    POINTR
         AWM,R5   POINTR            FOR NEXT FIELD
         BAL,R9   SUMVC             GO TO MOVE TO INTO
         B        STM16
STM12    LW,R1    INTOA             BA OF INTO
         AW,R1    POINTR
         LW,R2    SENDA             BA OF SENDING
         LW,R3    DELIA                   DELIMITED
         LW,R5    DELIA+1           DELIMITED SIZE
         CW,R5    SENDSZ            SENDING SIZE
         BG       STM7              NO MORE DELIMITED
         BAL,R9   SUCMP0            GO TO COMPARE
         BE       STM16             DELIMITED MATCHED
STM15    LW,R2    SENDA
         LW,R6    POINTR
         CW,R6    INTOSZ
         BL       %+3
         MTW,1    OVERF             OVERFLOW
         B        STM16
         LB,R6    0,R2              ONE BYTE FROM SENDING
         STB,R6   0,R1                TO INTO FIELD
         MTW,1    POINTR            BUMP TO NEXT BYTE
         MTW,-1   SENDSZ
         BLEZ     STM16             END OF STRING
         MTW,1    SENDA
         B        STM12
STM16    LW,R7    SAVR+6
         MTW,0    ENDF
         BEZ      STM2              MORE SENDING FIELD
MSTME    MTW,0    POINTF            POINTER OPTION?
         BEZ      STM17             NO
         LI,R7    3
         LW,R4    POINTR            POINTER
         AI,R4    1
         BAL,R9   BINTO             UPDATE POINTER FIELD
STM17    LCI      15                RECOVER REGISTERS
         LM,R1    SAVR
         LI,R7    0
         STW,R7   POINTF            RESET POINTER FLAG
         XW,R7    OVERF             SET OVERFLOW
         B        *R11
STM18    MTW,1    OVERF             OVERFLOW
         B        STM17
         TITLE    'C:MTS - RUNTIME ROUTINE FOR UNSTRING STATEMENT'
C:MTS    LCI      15                SAVE REGISTERS
         STM,R1   SAVR
         LI,R6    0
         BAL,R9   VLAS              RESOLVE VAR RECORD
         LI,R4    0
         STW,R4   DELICT            DELIMITED COUNT
         STW,R4   FIELD1
         STW,R4   POINTR            INITIALIZE POINTER
MTS1     INT,R2   0,R7              NEXT FIELD
         BCS,8    MTS5              INTO GROUP
         BCS,1    MTS3              DELIMITED
         BCS,2    MTS2              TALLYING
         MTW,1    POINTF            POINTER FLAG
         LI,R6    3
         BAL,R9   VLAS1             RESOLVE VAR REC
         BAL,R9   TOBIN             CONVERT TO BINARY
         BLEZ     STM18             BAD POINTER
         CW,R4    SENDSZ
         BG       STM18             BAD POINTER
         AI,R4    -1
         STW,R4   POINTR            POINTER COUNT
         B        MTS1
MTS2     MTW,1    TALYCT            TALLYING COUNT
         LI,R6    4
         BAL,R9   VLAS1             RESOLVE VAR REC
         B        MTS1
MTS3     LI,R6    6
MTS4     MTW,1    DELICT
         BAL,R9   VLAS1             RESOLVE VAR REC
         AI,R6    1
         INT,R2   0,R7              NEXT FIELD
         BCS,8    MTS5              NOT SENDING GROUP                   SUS
         BCS,1    MTS4              DELIMITED AGAIN
MTS5     STCF     ENDF              INTO GROUP
         LI,R6    1
         BAL,R9   VLAS1             RESOLVE VAR REC
         LI,R6    0                 INITIALIZE
         STW,R6   DELRA                DELIMITER
         STW,R6   CONTA                COUNT
         LW,R5    INTOCL            INTO CLASS
         CI,R5    3
         BL       MTS6              NO EDITING
         CI,R5    5
         BG       MTS6              NO EDITING
         LW,R4    R7
         SLS,R4   2
         LB,R2    0,R4
         STB,R2   MSKDR             LENGTH OF EDITING INFORMATION
         LW,R5    MSKDR
         MBS,R4   0                 SAVE EDITING INFORMATION
         AI,R2    3
         SLS,R2   -2                TO WORD COUNT
         AW,R7    R2
MTS6     LCF      ENDF
         BCS,1    MTS10             END OF PARAM
         INT,R2   0,R7              NEXT PARAM
         BCR,6    MTS10             NOT COUNT OR DELIMITER
         STCF     ENDF
         BCS,2    MTS7              COUNT FIELD
         LI,R6    2
         BAL,R9   VLAS1             RESOLVE VAR REC
         B        MTS6
MTS7     LI,R6    5
         BAL,R9   VLAS1             RESOLVE VAR REC
MTS10    STW,R7   SAVR+6            SAVE R7 FOR NEXT INTO GROUP
         LI,R7    0                 INITIALIZE
         STW,R7   TODRCT             SIZE TO DELIMITER
         LW,R3    SENDA             BA OF SENDING
         STW,R3   TODRA
         STW,R3   TOINA
         MTW,0    FIELD1
         BNEZ     MTS11             NOT FIRST INTO
         LCW,R4   POINTR
         AWM,R4   SENDSZ            UPDATE SENDING SIZE
         LW,R3    POINTR
         AWM,R3   SENDA             ADJUST BY POINTER
         AWM,R3   TOINA
         AWM,R3   TODRA
MTS11    LW,R1    DELICT
MTS12    LD,R4    DELIA,R7
         BAL,R9   SUCMP
         BE       MTS13             MATCHED
         AI,R7    1
         BDR,R1   MTS12
         LI,R7    0
         MTW,1    POINTR            UPDATE POINTER
         MTW,1    SENDA
         MTW,1    TODRA
         MTW,-1   SENDSZ
         BGZ      MTS11
         B        MTS14
MTS13    LD,R4    DELIA,R7
         AWM,R5   TODRCT            UPDATE DELIMITER COUNT
         AWM,R5   SENDA
         AWM,R5   POINTR            UPDATE POINTER
         LCW,R6   R5
         AWM,R6   SENDSZ
         BLEZ     MTS14             NO MORE SENDING
         MTW,0    DELICL,R7
         BEZ      MTS14             NO ALL OPTION
         BAL,R9   SUCMP             GO TO COMPARE
         BE       MTS13
MTS14    MTW,0    DELRA
         BEZ      MTS15             NO DELIMITER
         LW,R2    TODRA
         LW,R3    DELRA
         LW,R5    TODRCT
         CW,R5    DELRSZ
         BLE      %+2               DELIMITER SIZE ENOUGH
         XW,R5    DELRSZ
         BAL,R9   SUMVC             MOVE TO DELIMITER
MTS15    MTW,0    CONTA
         BEZ      MTS16             NO COUNT
         LW,R4    TODRA
         SW,R4    TOINA             COUNT SIZE
         LI,R7    5
         BAL,R9   BINTO             SET COUNT FIELD
MTS16    LW,R8    TODRA
         SW,R8    TOINA
         STW,R8   ACTSZ             CURRENT SENDING SIZE
         MTW,1    FIELD1
         LW,R1    INTOCL            CLASS OF INTO
         LH,R2    BIMTS,R1                                              SUS
         B        MTS17,R2                                              SUS
MTS17    LW,R5    INTOSZ            NDU
         SW,R5    ACTSZ
         BEZ      MTS21             SAME SIZE
         BGZ      MTS18             LEADING BYTES FILLING
         AWM,R5   ACTSZ             LEFT TRUNCATION
         LCW,R5   R5
         AWM,R5   TOINA             ADJUST SENDING ADDR
         B        MTS21
MTS18    CI,R1    2
         BNE      MTS19             NDS, NDU
         BAL,R9   BLKFL             LEADING BLANK FILL
         B        MTS21
MTS19    BAL,R9   ZROFL             LEADING ZERO FILL
         B        MTS21
MTS20    LW,R5    INTOSZ            GROUP, AN
         SW,R5    ACTSZ
         BGEZ     MTS21
         AWM,R5   ACTSZ             RIGHT TRUNCATION
MTS21    LW,R5    ACTSZ             MOVE SENDING TO INTO
         LW,R2    TOINA
         LW,R3    INTOA
         BAL,R9   SUMVC
         LW,R5    INTOSZ
         SW,R5    ACTSZ
         BLEZ     MTS40             NO TRAILING BLANK FILL
         LW,R1    R3
         LI,R2    1
         BAL,R9   BLKFL1            TRAILING BLANK FILL
         B        MTS40
MTS22    LW,R2    ACTSZ             ANE JR
         BEZ      MTS23             NULL SENDING
         SH,R2    MASKD             SENDING - INTO
         BEZ      MTS23             SAME SIZE
         BGZ      %+3
         STW,R2   ANEJR             LEADING BLANK FILL
         B        MTS23
         AWM,R2   TOINA             LEFT TRUNCATION
MTS23    LW,R3    INTOA             MOVE EDITING MASK
         LW,R2    INTOSZ
         STB,R2   R3
         LW,R2    EDITP                   TO INTO
         MBS,R2   0
         MTW,0    ACTSZ
         BNEZ     %+3
         STW,R3   ANEJR             NULL SENDING
         B        MTS40
         LI,R7    2
         LB,R6    MASKD,R7          DESCRIPTOR BYTE COUNT
         AI,R7    1
         MTB,0    MASKD,R7
         BNEZ     MTS24
         MTW,1    INSRT             LEADING INSERTIONS
         AI,R7    1
         AI,R6    -1
MTS24    LW,R2    TOINA             FROM SENDING
         LW,R3    INTOA                   TO INTO
MTS25    LB,R4    MASKD,R7          NEXT DESCRIPTOR
         AI,R7    1
         MTW,0    INSRT
         BEZ      MTS26             GO TO MOVE
         AW,R3    R4                SKIP INSERTION
         MTW,-1   INSRT
         BDR,R6   MTS25             NEXT IS MOVE
         B        MTS40
MTS26    LW,R5    ANEJR
         BGEZ     MTS28             NO BLANK FILL
         AW,R5    R4
         BGZ      MTS27
         STW,R5   ANEJR
         AW,R3    R4
         B        MTS29
MTS27    SW,R3    ANEJR             SKIP BLANK FILL
         LW,R4    R5
         STW,R5   ANEJR             NO MORE BLANK FILL
MTS28    LW,R5    ACTSZ
         SW,R5    R4
         STW,R5   ACTSZ             SAVE FOR NEXT MOVE
         BGEZ     %+2
         AW,R4    R5                LAST MOVE
         STB,R4   R3
         MBS,R2   0                 MOVE TO INTO
         MTW,0    ACTSZ
         BLEZ     MTS40             END OF MOVE
MTS29    AI,R6    -1
         BLEZ     MTS40             END OF DESCRIPTOR
         MTW,1    INSRT             NEXT IS INSERTION
         B        MTS25
MTS30    LI,R4    BA(MASKD)+7       NUMERIC EDITING
         LI,R2    6
         LB,R5    0,R4
         STW,R5   MASKD+2,R2        STORE TJ-TN
         AI,R4    -1
         BDR,R2   %-3
         LW,R4    ACTSZ             NUMERIC EDITING - SENDING SIZE
         STB,R4   MVB1
         LW,R5    MVB1
         LW,R4    TOINA             SOURCE ADDR
         MBS,R4   0
         BAL,R11  NDPK              PACK ND INTO DECA
         DST,0    CVDATA            SAVE DECA
         LW,R2    INTOSZ
         LH,R6    MASKD             TE-TI
         CI,R6    X'800'            CHECK BWZ/*WZ
         BAZ      MTS31
         DC,1     DCMPR
         BNE      MTS31             DECA NOT ZERO
         LW,R1    INTOA
         STB,R2   R1
         CI,R6    X'400'            CHECK * FLAG
         BANZ     %+3
         MBS,0    BA(DCMPR)+2       BLANK FILL
         B        MTS40
         MBS,0    BA(DCMPR)+1       * FILL
         LW,R5    MSKTL             TL
         BEZ      MTS40             NO DECP
         AI,R5    -1
         AW,R5    INTOA             BA OF DECP
         MTB,0    INTOA
         BEZ      %+3
         LI,R4    ','               USE ',' AS '.'
         B        %+2
         LI,R4    '.'               USE '.'
         STB,R4   0,R5
         B        MTS40
MTS31    LW,R5    INTOA             MOVE EDITING MASK TO INTO
         STB,R2   R5
         LW,R4    EDITP
         MBS,R4   0
         CI,R6    X'C000'
         BAZ      %+2               NO LEADING SIGN
         AI,R6    X'C000'           CHANGE LEADING SIGN FLAG
         CI,R6    X'1000'
         BAZ      MTS32             NO TRAILING +/-
         CI,R6    X'2000'
         BANZ     MTS32             NO TRAILING +
         AI,R6    X'1F000'          CHANGE TRAILING + FLAG
MTS32    CI,R6    X'C0'
         BAZ      MTS33             NO FLOATING SIGN
         AI,R6    -X'40'            CHANGE FLOATING SIGN FLAG
         CI,R6    X'80'
         BANZ     MTS33             FLOATING %
         AI,R6    X'20'
         LI,R9    '-'               LOAD '-' SIGN
         DC,1     DCMPR
         BL       MTS33
         LI,R9    '+'               LOAD '+' SIGN
         CI,R6    X'2040'
         BAZ      MTS33
         LI,R9    ' '               LOAD BLANK
MTS33    LCW,R8   INTOSZ
         AW,R8    MSKTJ             -INTOSZ+TJ
         CI,R6    X'14000'          CHECK FOR LEADING +/-
         BAZ      MTS34             NO
         SW,R5    INTOSZ
         DC,1     DCMPR
         BGEZ     MTS34             NOT NEGATIVE
         LI,R9    '-'
         STB,R9   0,R5              STORE LEADING SIGN
MTS34    LI,R7    X'10'             CC4=1 FORCE SIGNIFICANCE
         LW,R2    MSKTN             DIGIT SIZE
         CI,R2    1
         BANZ     %+2               EVEN SIZE
         AI,R7    X'40'             CC1=1
         SLS,R2   -1
         LI,R3    63                LAST BYTE OF DECA
         SW,R3    R2
         LW,R4    L(X'40000000')    FILL CHAR = SPACE
         CI,R6    X'500'            CHECK SUPRESSION
         BAZ      MTS35             NO Z/* REPLACEMENT
         AI,R7    -X'10'
         CI,R6    X'100'            CHECK FOR Z REPLACEMENT
         BANZ     MTS35
         LW,R4    L(X'5C000000')    FILL CHAR = *
MTS35    OR,R4    R3                SENDING REGISTER
         LW,R2    MSKTK             TK
         BEZ      %+4
         CI,R6    X'23000'          CHECK TRAILING SIGN
         BAZ      %+2
         AI,R6    4                 RAISE TRAILING SIGN FLAG
         CI,R6    X'5E0'
         BAZ      MTS36             NO FLOATING/SUPPRESSION
         LW,R1    MSKTM             TM
         BEZ      %+5
         SW,R1    MSKTJ             TM-TJ(=EBS2)
         AW,R2    R1
         LW,R3    R1                SAVE EBS2
         AI,R6    8
         CI,R6    X'80'             CHECK FOR FLOATING %
         BAZ      MTS36
         LW,R11   MSKTD             CURRENCY SIGN
MTS36    AW,R2    R8                -EBS1=-EBS1+(-BSIZ+TJ)
         CI,R6    8                 CHECK EBS2 FLAG
         BANZ     %+2               UP - EBS2 SET
         LCW,R3   R2
         CI,R6    X'14000'          CHECK LEADINF +/- FLAG
         BAZ      %+2
         LW,R8    MSKTJ             TJ
         AW,R5    R8                INTO ADDR
         STB,R3   R5                   AND SIZE
         CI,R6    8
         BAZ      %+2
         AW,R1    R5                R1 = BA(9/V/'.')
         OR,R7    L(X'02200000')    FORM LCI
         EXU      R7
         EBS,R4   0                 EDITING
         STCF     MASKD+2           SAVE CONDITION CODE
         CI,R6    X'E0'
         BAZ      MTS37             NO FLOATING
         BDR,R1   %+1               SS+1 = SS
         CI,R6    X'80'             CHECK FLOATING % FLAG
         BAZ      %+3
         STB,R11  0,R1              FLOATING % SIGN
         B        MTS37
         STB,R9   0,R1              FLOATING +/-
MTS37    CI,R6    8
         BAZ      MTS38             EBS COMPLETE
         LCW,R1   R2                LOAD EBS2
         STB,R1   R5
         LW,R1    L(X'10000000')
         OR,R1    MASKD+2
         LCF      R1                SET CC4
         EBS,R4   0                 EDITING
         STCF     MASKD+2           SAVE CONDITION CODE
MTS38    CI,R6    X'20004'          TRAILING SIGN
         BAZ      MTS40
         LCF      MASKD+2           RECOVER CC OF EBS
         BLZ      MTS40             FINISHED
         LW,R3    MSKTM             TM
         CI,R6    4
         BAZ      MTS39             TRAILING + ONLY
         LW,R3    MSKTK             TK
         CI,R6    X'1000'           CHECK CR/DB FLAG
         BAZ      %+2
         AI,R3    -1
MTS39    AI,R3    -1
         AW,R5    R3                ADJUST R5
         LI,R1    ' '
         CI,R6    X'20000'          CHECK TRAILING + FLAG
         BAZ      %+2
         LI,R1    '+'               LOAD +
         STB,R1   0,R5              STORE ' '/'+'
         CI,R6    X'1000'           CHECK CR/DB FLAG
         BAZ      MTS40
         AI,R5    1
         STB,R1   0,R5              STORE SECOND CHAR
MTS40    LCF      ENDF
         BCS,1    MTS42             END OF UNSTRING
         MTW,0    SENDSZ            CHECK END
         BLEZ     MTS43             FINISHED
         MTW,0    TALYCT
         BEZ      MTS41
         MTW,1    TALYCT            UPDATE TALLYING
MTS41    LW,R7    SAVR+6
         INT,R2   0,R7              NEXT INTO
         B        MTS5
MTS42    MTW,0    SENDSZ
         BLEZ     %+2               NO SENDING LEFT
         MTW,1    OVERF
MTS43    LI,R4    0                             RESET TALLYING
         XW,R4    TALYCT
         BEZ      MSTME             NO TALLYING FIELD
         LI,R7    4
         BAL,R9   BINTO             MOVE TO TALLYING
         B        MSTME
         TITLE    'COMMON ROUTINES FOR C:STM AND C:MTS'
*  CONVERT POINTER TO BINARY
TOBIN    LD,R2    PONTA             CONVERT POINTER TO BINARY
         STB,R3   MVB1
         LW,R3    MVB1
         MBS,R2   0                 INPUT DATA TO CVDATA
         LW,R2    PONTCL            CLASS
         LH,R2    BTOBI,R2
         B        FLTL,R2
FLTL     LD,R4    CVDATA            FLOATING
         B        FLTS1
FLTS     LW,R4    CVDATA
         LI,R5    0
FLTS1    LI,R10   0
         BAL,R11  C:CFD             CONVERT FLOATING TO PACKED DECIMAL
         BCS,4    ERROR             NEGATIVE OR OVERFLOW
         B        PDSU3
NDSU     BAL,R11  NDPK              NUMERIC DISPLAY
         B        PDSU2
PDSU     LB,R4    MVB1              PACKED DECIMAL
         SLS,R4   20
         OR,R4    DLDMY
         EXU      R4
PDSU2    LW,R10   PONTA             DECIMAL POINT
         SAS,R10  -24
PDSU3    LCW,R10  R10               FOR DECA SHIFT
         BEZ      PDSU4
         DSA      *R10
         LI,R10   0
PDSU4    BAL,R11  C:CDB             PACKED DECIMAL TO BINARY
         BCS,4    ERROR
         B        *R9
BINY     LW,R4    CVDATA            BINARY
         B        *R9
NDPK     LB,R4    MVB1              PACK CVDATA TO DECA
         AI,R4    2
         SLS,R4   -1                L COUNT
         SLS,R4   20
         OR,R4    PKDMY
         LB,R5    MVB1
         AND,R5   L(X'1')           CHECK ODD OR EVEN
         AI,R5    -1
         EXU      R4
         B        *R11
*  CONVERT BINARY TO OUTPUT FORMAT
BINTO    LW,R3    SENDCL,R7         CLASS
         LH,R2    BBINT,R3
         B        BFLTL,R2
BFLTL    RES      0                 FLOATING LONG
BFLTS    LI,R5    0                 FLOATING SHORT
         SAD,R4   -8
         EOR,R4   FSZ               SET CHARACTERISTIC
         FAL,R4   FLZ               NORMALIZE
BBIN     STD,R4   CVDATA            BINARY OR INDEX
         LI,R2    BA(CVDATA)
         B        BINTO1
BDDSP    RES      0                 BIN TO DECIMAL DISPLAY
BPDEC    LI,R10   0                 BIN TO PACK DECIMAL
         BAL,R11  C:CBD
         LD,R4    SENDA,R7
         SAS,R4   -24               DECIMAL POINT ALLIGNMENT
         DSA      *R4
         CI,R3    1
         BG       BPDEC1            TO PACK DECIMAL
         UNPK,10  CVDATA            TO DECIMAL DISPLAY
         LI,R2    19
         B        BPDEC2
BPDEC1   DST,0    CVDATA            TO PACK DECIMAL
         LI,R2    16
BPDEC2   LD,R4    SENDA,R7          BA AND SIZE
         SW,R2    R5
         AI,R2    BA(CVDATA)
BINTO1   LD,R4    SENDA,R7          UPDATE DATA
         LW,R3    R4                DESTINATION
         STB,R5   R3                SIZE
         MBS,R2   0
         B        *R9
ERROR    LI,R2    X'9A'             BAD INPUT DATA
         STB,R2   R10
         B        C:ABA
*  COMPARE SENDING WITH DELIMITED
SUCMP    LW,R2    R4                DELIMITED BA
         LW,R3    SENDA
SUCMP0   BAL,R11  CKBSL
         STB,R4   R3
SUCMP1   CBS,R2   0
         BNE      *R9               NOT MATCHED
         AI,R5    -1
         BEZ      *R9               MATCHED
         STB,R8   R3
         B        SUCMP1
*  MOVE TO RECEIVING FIELD
SUMVC    BAL,R11  CKBSL
         STB,R4   R3
SUMVC1   MBS,R2   0
         AI,R5    -1
         BEZ      *R9               END OF MOVE
         STB,R8   R3
         B        SUMVC1
*  BLANK OR ZERO FILL INTO FIELD
ZROFL    LI,R2    0
         B        BLKFL0
BLKFL    LI,R2    1
BLKFL0   LCW,R7   R5
         AWM,R7   INTOSZ            SIZE OF INTO LEFT
         LW,R1    INTOA             BA OF INTO
BLKFL1   BAL,R11  CKBSL
         STB,R4   R1
BLKFL2   EXU      EXUFL,R2
         STW,R1   INTOA
         AI,R5    -1
         BEZ      *R9               END OF PAD
         STB,R8   R1
         B        BLKFL2
CKBSL    LI,R4    0
         CI,R5    255
         BG       CKBSL1            GREATER THAN 255
         XW,R4    R5
         B        CKBSL2
CKBSL1   LI,R8    255
         DW,R4    R8
CKBSL2   AI,R5    1
         B        *R11
*  RESOLVE VARIABLE ADDRESS AND LENGTH
VLAS     INT,R2   0,R7              GET NEXT PARAM
VLAS1    LW,R4    R2
         SLS,R2   -4
         STW,R2   SENDCL,R6         CLASS OF DATA
         LI,R2    3
         AND,R2   R4
         AW,R7    R2                ADJUST PARAM ADDR
         LW,R2    1,R7              DECP, BYTE ADDR
         STD,R2   SENDA,R6             AND SIZE
         AI,R7    2
         CI,R4    8
         BAZ      *R9               NO VAR REC
         LI,R1    0                                                     SUS
         STW,R1   VADRF             CLEAR VAR REC ADDR FLAG             SUS
         LW,R1    0,R7              NEXT PARAM                          SUS
         AI,R7    1                 BUMP BY ONE                         SUS
         CW,R1    R7                                                    SUS
         BE       %+3               VAR REC PARAM FOLLOWS
         STW,R7   VADRF
         LW,R7    R1                                                    SUS
         BAL,R11  C:VPL             RESOLVE VAR REC
         SW,R3    0,R7              ADJUST LENGTH
         LB,R11   R2                SAVE DECP
         AND,R2   L(X'FFFFFF')
         SW,R2    1,R7              ADJUST ADDRESS
         STB,R11  R2                RECOVER DECP
         STD,R2   SENDA,R6
         LW,R7    2,R7              NEXT PARAM ADDR
         MTW,0    VADRF
         BEZ      *R9
         LW,R7    VADRF
         B        *R9
         END
