 TITLE 'TELEFILE ASSEMBLY PROGRAM - APDGCOM'
         PCC      0
         SPACE    6
*   %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
*   %%%%%     MODULE NAME:     APDGCOM                 %%%%%
*   %%%%%     LAST UPDATED:    MAR 07, 1984            %%%%%
*   %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
         SPACE    2
         SPACE    12
*        T E L E F I L E    P R O P R I E T A R Y    P R O D U C T
         SPACE    2
*        THIS DOCUMENT INCLUDES DATA AND INFORMATION WHICH IS CONSIDERED
*        PROPRIETARY TO TELEFILE COMPUTER PRODUCTS, INC. REPRODUCTION,
*        DUPLICATION, DISCLOSURE OR DISSEMINATION, IN WHOLE OR IN PART,
*        TO OTHERS THAN REPRESENTATIVES OF THE UNITED STATES GOVERNMENT
*        SHALL NOT BE MADE WITHOUT PRIOR WRITTEN AUTHORIZATION OF TELEFILE
*        COMPUTER PRODUCTS, INC. NOTWITHSTANDING THE FOREGOING, USE OF
*        THE DATA OR INFORMATION IN WHOLE OR IN PART FOR DESIGN,
*        PROCUREMENT OR MANUFACTURE IS STRICTLY FORBIDDEN.
         PAGE
         SPACE    12
*        T E L E F I L E    P R O P R I E T A R Y    P R O D U C T
         SPACE    2
*        THIS DOCUMENT INCLUDES DATA AND INFORMATION WHICH IS CONSIDERED
*        PROPRIETARY TO TELEFILE COMPUTER PRODUCTS, INC. REPRODUCTION,
*        DUPLICATION, DISCLOSURE OR DISSEMINATION, IN WHOLE OR IN PART,
*        TO OTHERS THAN REPRESENTATIVES OF THE UNITED STATES GOVERNMENT
*        SHALL NOT BE MADE WITHOUT PRIOR WRITTEN AUTHORIZATION OF TELEFILE
*        COMPUTER PRODUCTS, INC. NOTWITHSTANDING THE FOREGOING, USE OF
*        THE DATA OR INFORMATION IN WHOLE OR IN PART FOR DESIGN,
*        PROCUREMENT OR MANUFACTURE IS STRICTLY FORBIDDEN.
         PAGE
DGCOMP   CSECT    1
*
         DEF      AEDIT
         DEF      BEDIT
         DEF      BEDIT4
         DEF      CERR
         DEF      CTCHRS
         DEF      DERR
         DEF      DGCOMP
         DEF      EDIT
         DEF      EDITDDLR
         DEF      EDITDLR
         DEF      EDITV
         DEF      EDITV1
         DEF      EERR
         DEF      EXPEND
         DEF      GENERATE
         DEF      GENERATE1
         DEF      GENERATE2
         DEF      GENERATE3
         DEF      GETCSADD
         DEF      HILIMIT
         DEF      HILIMIT4
         DEF      IERR
         DEF      KERR
         DEF      LERR
         DEF      LOADABS
         DEF      ORIGIN
         DEF      PRINT
         DEF      PRINTC
         DEF      PRINTC1
         DEF      PRINTC2
         DEF      SERR
         DEF      TERR
         DEF      TYPE
         DEF      UERR
         DEF      XEDIT
*
         REF      ABORT
         REF      BLANC
         REF      BO%FLAG
         REF      BYX3SIZE
         REF      CLRLSTBF
         REF      DEDIT
         REF      DGWRITELO
         REF      GO%FLAG
         REF      LO%FLAG
         REF      LSTBF
         REF      MAJLINE
         REF      RD%STD
         REF      READX3
         REF      SUBLINE
         REF      SYSLEVEL
         REF      WDX3SIZE
         REF      WRITEBO
         REF      WRITEDO
         REF      WRITEGO
         REF      X3BUF
*
         SYSTEM   AP%IL
         SYSTEM   AP%DG
*
         USECT    DGCOMP
         PAGE
*   A C O N
*        THIS SUBROUTINE OUTPUTS AN ADD CONSTANT LOAD ITEM TO THE
*          OBJECT MODULE IF THE VALUE OF THE CONSTANT IS NON-ZERO.
*
*        INPUT:   THE CONSTANT TO BE OUTPUT IS IN REGISTER XT.
*
*        CALL:    BAL,RL  ACON
*
*        USES REGISTERS
*                 XT
*                 XT1
*                 NBYTES
*                 RL
*
ACON     RES      0
         CI,XT    0
         EXIT,EQ  RL                RETURN IF CONSTANT IS ZERO
         STW,XT   ACONVAL
         LI,XT    ADDCON            LOADER CODE FOR ADD CONSTANT
         STW,XT   ACONVAL-1
         LI,XT1   BA(ACONVAL)-1     BYTE ADDRESS OF 1ST ITEM TO OUTPUT
         LI,NBYTES  5               NUMBER OF BYTES TO OUTPUT
         B        BEDIT%SE          ERROR IF SOCW CONTROL IN EFFECT
*
ADDCON   EQU      1                 LOADER CONTROL CODE FOR ADD CONSTANT
         PAGE
*
*  A E D I T
*        THIS ROUTINE STORES A TEXT STRING IN THE LISTING IMAGE
*
*          INPUT: NUMBER OF BYTES TO STORE IN REG. NBYTES
*                 BYTE ADDRESS OF THE TEXT STRING IN REG. XT1
*                 INDEX TO FIRST (LEFT-MOST) BYTE IS IN REG. LBX
*
*         OUTPUT: REG NBYTES CONTAINS ZERO
*                 REGS. ARGA AND LBX ARE BUMPED BY NBYTES
*
AEDIT    RES      0
         LB,XT    0,XT1
         STB,XT   LSTBF,LBX
         AI,XT1   1                 ADDRESS OF NEXT BYTE
         AI,LBX   1                 INDEX TO LISTING IMAGE
         BDR,NBYTES  AEDIT
*
         EXIT     RL
         PAGE
*   A S V
*        THIS SUBROUTINE OUTPUTS AN ADD/SUBTRACT VALUE LOAD ITEM TO THE
*          OBJECT MODULE.
*
*        INPUT:   DDASV. IF ZERO AN ADD VALUE IS OUTPUT; IF ONE A
*                   SUBTRACT VALUE IS OUTPUT.
*                 DDTYPE. IF LOCAL FORWARD, A 3 BYTE ADD/SUBTRACT VALUE
*                   OF THE LOCAL FORWARD REFERENCE NUMBER IS OUTPUT;
*                   IF NOT LOCAL FORWARD, DDNUM IS INSPECTED.
*                 DDNUM. IF ZERO, A ONE BYTE ADD/SUBTRACT ABSOLUTE
*                   SECTION CONTROL BYTE IS OUTPUT; IF NON-ZERO, A TWO
*                   OR THREE BYTE ADD VALUE OF DECLARATION IS OUTPUT.
*                 NAMENUM. IF ZERO, LESS THAN 256 DECLARATIONS HAVE BEEN
*                   ASSIGNED; IF ONE, MORE THAN 255 HAVE BEEN ASSIGNED.
*
*        CALL:    BAL,RL  ASV
*
*        USES REGISTERS
*                 XT
*                 XT1
*                 NBYTES
*
         LOCAL    %10,%20,%30,%40,%50,%60
*
ASV      RES      0
         LW,XT    DDASV             0 IF ADD VALUE, 1 IF SUBTRACT VALUE
         SLS,XT   3
         AW,XT    DDRS              RESOLUTION
         AI,XT    X'20'
         LW,XT1   DD%TYPE
         CV,XT1   LCLFWDET
         BE       %10               ITEM IS A LOCAL FORWARD
*
         CV,XT1   LFWDHET
         BNE      %50               ITEM IS NOT A LOCAL FORWARD & HOLD
*
*   HERE TO OUTPUT ADD/SUBTRACT VALUE OF FORWARD REFERENCE NUMBER
*
%10      RES      0
         AI,XT    4
%20      RES      0
         SLS,XT   16
         LI,XT1   BA(ACONVAL)+1     BYTE ADDRESS OF DATA TO BE OUTPUT
         LI,NBYTES 3                NUMBER OF BYTES TO OUTPUT
%30      RES      0
         AW,XT    DDNUM
%40      RES      0
         STW,XT   ACONVAL
         B        BEDIT%SE          ERROR IF SOCW CONTROL IN EFFECT
*
%50      RES      0
         MTW,0    DDNUM
         BEZ      %60               ABSOLUTE SECTION
*
*   HERE TO OUTPUT ADD/SUBTRACT VALUE OF DECLARATION NUMBER
*
         MTW,0    NAMENUM
         BGZ      %20               MORE THAN 255 NAME NUMBERS ASSIGNED
*                                     DDNUM CONTAINS TWO BYTE NAME #
*   HERE FOR 1 BYTE NAME NUMBERS
*
         SLS,XT   8
         LI,NBYTES 2                NUMBER OF BYTES TO OUTPUT
         LI,XT1   BA(ACONVAL)+2     BYTE ADDRESS OF DATA TO BE OUTPUT
         B        %30
*
*   HERE TO OUTPUT ADD/SUBTRACT ABSOLUTE SECTION
*
%60      RES      0
         MTW,0    DDASV
         IF,EQ                      DOIF ADD ABS SECTION
         AI,XT    4
         FI
         AI,XT    X'10'
         LI,NBYTES 1                NUMBER OF BYTES TO OUTPUT
         LI,XT1   BA(ACONVAL)+3     BYTE ADDRESS OF DATA TO BE OUTPUT
         B        %40
         PAGE
*
*   B E D I T
*        THIS ROUTINE BLOCKS BYTES IN THE BINARY OUTPUT BUFFER. WHEN THE
*          BUFFER IS FULL, IT IS OUTPUT TO THE BO FILE, AND A NEW
*          RECORD IS BEGUN.
*
*        INPUT:   THE NUMBER OF BYTES TO BLOCK IS IN REGISTER NBYTES.
*                 THE BYTE ADDRESS OF THE BYTES TO BE BLOCKED IS IN
*                   REGISTER XT1
*                 THE NUMBER OF BYTES IN THE OUTPUT BUFFER IS IN BOCT.
*
*        OUTPUT:  NBYTES IS ZERO
*                 BOCT CONTAINS THE CURRENT BYTE COUNT FOR THE BUFFER.
*
*        CALL:    BAL,RL  BEDIT
*
*        USES REGISTERS
*                 XT XT1 RL NBYTES IOSIZE IORL IOADD
*
*        ALTERNATE CALLS:
*
*                 BEDIT%SE   EDITS NOTHING IF SOCW%FLG NZ -- GIVES T ERR
*
*                 BEDIT%SC   EDITS ONLY FINAL 'NOBYTES' # BYTES IF SOCW
*
*                 BEDIT%SCE   SAME AS BEDIT%SC, BUT GIVES T ERR ALSO
*
         LOCAL    %10
*
BEDIT%SE RES      0
         MTW,0    SOCW%FLG
         BEZ      BEDIT
*
         BAL,ER   TERR
         B        BEDIT
*
BEDIT%SCE   RES   0
         MTW,0    SOCW%FLG
         BEZ      BEDIT
*
         BAL,ER   TERR
*        (FALL THROUGH)
*
BEDIT%SC RES      0
         MTW,0    SOCW%FLG
         BEZ      BEDIT
*
         SW,NBYTES   NOBYTES        GET DIFFERENCE
         AW,XT1   NBYTES            BYPASS CONTROL INFO
         LW,NBYTES   NOBYTES        JUST EDIT DATA
*        (FALL THROUGH)
*
BEDIT    RES      0
         LW,XT    BO%FLAG
         AW,XT    GO%FLAG           EXIT IF NO OUTPUT IS SPECIFIED
         EXIT,EQ  RL                  FOR BOTH 'BO' AND 'GO'
BEDIT3   RES      0
         LW,XT    BOCT              LOAD THE BO COUNT
         CW,XT    BOMAX
         BL       BEDIT8            STILL ROOM IN BUFFER
*   HERE TO OUTPUT CURRENT RECORD IN BO BUFFER
BEDIT4   RES      0
         STW,NBYTES  BOCT           SAVE # OF BYTES REMAINING
         STW,XT   IOSIZE            BO COUNT IS RECORD SIZE
         MTW,0    SOCW%FLG
         IF,EZ                      DO ONLY IF NO SOCW CONTROL IN EFFECT
         LI,XT    1                 STORE RECORD SIZE AND ZERO CHECKSUM
         STH,IOSIZE BOBUF,XT          BYTE
         MTB,1    BOBUF,XT          INCREASE SEQ. NO. MODULO 255
         LW,XT    IOSIZE
         AI,XT    -1
         LB,IORL  BOBUF             BEGIN CHECKSUM WITH RECORD TYPE BYTE
BEDIT6   RES      0
         LB,IOADD BOBUF,XT          FORM A BYTE CHECKSUM OF ALL BYTES
         AW,IORL  IOADD               IN THE RECORD
         BDR,XT   BEDIT6
         LI,XT    2
         STB,IORL BOBUF,XT          STORE CHECKSUM
         FI
         MTW,0    BO%FLAG
         BEZ      BEDIT7            NO 'BO' OUTPUT SPECIFIED
         BAL,IORL WRITEBO           OUTPUT A RECORD ON 'BO'
         MTW,0    GO%FLAG
         BEZ      BEDIT5            NO 'GO' OUTPUT SPECIFIED
BEDIT7   RES      0
         BAL,IORL WRITEGO           OUTPUT A RECORD ON 'GO'
BEDIT5   RES      0
         LI,XT    4
         MTW,0    SOCW%FLG
         IF,NZ
         LI,XT    0                 USE ENTIRE RECORD UNDER SOCW CONTROL
         FI
         LW,NBYTES  BOCT            RESTORE # OF BYTES REMAINING
         STW,XT   BOCT              INITIALIZE BO COUNT FOR NEXT RECORD
*   HERE TO STORE NEXT BYTE TO BO BUFFER
BEDIT8   RES      0
         LB,IORL  0,XT1             LOAD NEXT BYTE AND STORE IT TO NEXT
         STB,IORL BOBUF,XT            BYTE POSITION IN BO BUFFER
         AI,XT1   1                 INCREMENT ARGUMENT ADDRESS
         MTW,1    BOCT              INCREMENT BO COUNT
         BDR,NBYTES  BEDIT3         DECREMENT # OF BYTES TO BLOCK
         EXIT     RL
*
*   TABLE OF LOADER CONTROL CODES
EXPENDCD DATA,1   2                 CONTROL BYTE FOR EXPRESSION END
ORIGINCD DATA,1   4                 CONTROL BYTE FOR LOAD ORIGIN
         BOUND    4
         PAGE
*
*  C T C H R S
*        COUNT THE NUMBER OF DECIMAL DIGITS IN A NUMBER
*
*          INPUT: XT1 CONTAINS THE NUMBER (IT MUST BE POSITIVE)
*
*         OUTPUT: XT CONTAINS THE NUMBER OF DIGITS.
*
CTCHRS   RES      0
         LI,XT    0
CTCHRS1  RES      0
         AI,XT    1
         CW,XT1   TENS-1,XT
         BGE      CTCHRS1
         EXIT     RL
TENS     DATA     10,100,1000,10000,100000
         PAGE
*
*   D F N F L D
*        THIS SUBROUTINE OUTPUTS A THREE BYTE 'DEFINE FIELD' ITEM TO
*          THE OBJECT FILE.
*
*        INPUT:   FLENGTH CONTAINS THE NUMBER OF BITS IN THE CURRENT
*                   FIELD.
*                 HVLENGTH CONTAINS THE STARTING BIT POSITION OF THE
*                   NEXT FIELD WITHIN HEXVAL.
*
*        CALL:    BAL,RL  DFNFLD
*
*        USES REGISTERS
*                 XT
*                 XT1
*                 NBYTES
*
DFNFLD   RES      0
         LI,XT    255               LOW ORDER BIT LOCATION OF
         SW,XT    HVLENGTH            FIELD TO BE DEFINED
         SLS,XT   8                 POSITION IT
         AI,XT    X'070000'         CONTROL BYTE FOR 'DEFINEFIELD '
         AW,XT    FLENGTH           FIELD LENGTH
         STW,XT   ACONVAL
         LI,XT1   'N'
         STW,XT1  CODE              DEFINE FIELD CODE FOR EDIT
         LI,XT1   BA(ACONVAL)+1     BYTE ADDRESS OF 1ST ITEM TO OUTPUT
         LI,NBYTES 3                NUMBER OF BYTES TO OUTPUT
         B        BEDIT%SE          ERROR IF SOCW CONTROL IN EFFECT
         PAGE
*
*  E D I T
*        EDIT THE LOCATION COUNTER AND A VALUE INTO THE LISTING IMAGE.
*
*          INPUT: THE VALUE IS LEFT-ADJUSTED IN HEXVAL (UP TO 4 WORDS)
*                 THE RELOCATION CODE IS IN CODE
*                 THE NUMBER OF BYTES TO OUTPUT IS IN NOBYTES
*
*         OUTPUT: THE LOCATION COUNTER AND VALUE ARE PRINTED, AND
*                 BOTH LOCATION COUNTERS ARE BUMPED BY THE NUMBER
*                 OF BYTES OUTPUT.
*
EDIT     RES      0
         LW,XT    PASS
         EXIT,EQ  RL               DON'T EDIT DURING DEFINITION PASS
         STW,RL   EDITXIT
         CALL     EDITDLR           EDIT LOCATION COUNTER
         LI,LBX   33
         LW,XT    CODE              ADDRESS CLASSIFICATION CODE
         CI,XT    ' '
         BE       EDIT1
         STB,XT   LSTBF,LBX
         B        EDIT2
* HEX EDIT THE CONTROL SECTION NUMBER UNLESS IT'S CURRENT ONE
EDIT1    RES      0
         LW,XT1   DDCS              CONTROL SECTION OF DATA ITEM
         CW,XT1   DLRCS
         BE       EDIT2             SAME AS LOCATION COUNTER
         STB,XT1  XT1               LEFT-ADJUST FOR XEDIT
         LI,NBYTES  2               TWO DIGITS
         CALL     XEDIT             EDIT THE CONTROL SECTION NUMBER
EDIT2    RES      0
         LI,XT    HEXVAL            ADDRESS OF 1ST ARGUMENT
         STW,XT   TX1
         LW,XT1   NOBYTES           COMPUTE NUMBER OF HEX. DIGITS
         SLS,XT1  1                   TO OUTPUT
         STW,XT1  TX2
         LI,XT    X'FFFEA'          ALLOW GENERATED CODE TO BE
         AND,XT   NOLIST              PRINTED WITHIN A PRE-ENCODED
         XW,XT    NOLIST              SYSTEM OR A SYSTEM NOT OTHERWISE
         STW,XT   LASTVAL             LISTED (E.G,  PSYS=0).
EDIT3    RES      0
         LI,NBYTES 8                OUTPUT EITHER 8 HEX DIGITS
         CW,NBYTES  TX2               OR TX2 HEX DIGITS,
         BLE      %+2                 WHICHEVER IS SMALLER
         LW,NBYTES  TX2
         LI,LBX   24                BEGIN IN COLUMN 24
         LW,XT1   *TX1              ARGUMENT
         CALL     XEDIT
         CALL     PRINT             PRINT THE LINE
         MTW,1    TX1               BUMP ADDRESS OF NEXT ARGUMENT
         MTW,-8   TX2               DECREASE NO. OF DIGITS REMAINING
         BGZ      EDIT3               AND RETURN IF NOT FINISHED
*
         LW,XT    LASTVAL           RESTORE
         STW,XT   NOLIST              NOLIST.
*
* NOW UPDATE BOTH LOCATION COUNTERS BY THE NUMBER OF BYTES OUTPUT
         LW,XT    NOBYTES
         AWM,XT   DLRVAL
         AW,XT    DDLRVAL
         STW,XT   DDLRVAL
         STW,XT   LASTVAL
         B        *EDITXIT
         PAGE
*
*   E D I T D D L R
*        EDIT THE LOAD LOCATION COUNTER INTO THE LISTING
*
EDITDDLR RES      0
         MTB,1    RL
*
*   E D I T D L R
*        EDIT THE LOCATION COUNTER INTO THE LISTING IMAGE
*
EDITDLR  RES      0
         MTW,0    PASS             DON'T EDIT THE LOCATION COUNTER
         EXIT,EQ  RL                 DURING THE DEFINITION PASS
         STW,RL   EDITDXIT
         LB,XT1   EDITDXIT          INDEX TO % OR %%
         LW,XT1   DLRCS,XT1         CONTROL SECTION # OF % OR %%
         STB,XT1  XT1
         LI,NBYTES  2
         LI,LBX   12                STARTING COLUMN NUMBER
         CALL     XEDIT
         LB,XT1   EDITDXIT          INDEX TO % OR %%
         LW,XT1   DLRVAL,XT1        VALUE OF % OR %%
         SLS,XT1  10                LEFT-ADJUST VALUE
         AI,LBX   1                 SKIP 1 COLUMN
         LI,NBYTES  5               SET NUMBER OF DIGITS TO PRINT
         CALL     XEDIT
         SCS,XT1  2                 RIGHT-ADJUST THE 2 LOW ORDER BITS
         AI,LBX   1                 SKIP A COLUMN
         CALL     DEDIT
         B        *EDITDXIT
         PAGE
*
*  E D I T V A L
*        EDIT A VALUE ITEM INTO THE LISTING IMAGE.  THIS ROUTINE
*          OPERATES ONLY ON THE SOURCE LEVEL IN THE GEN PASS.
*
*          INPUT: ARG POINTS TO THE VALUE ITEM
*
*         OUTPUT: THE VALUE EDITED INTO THE LISTING IN COL. 18 AS:
*                 A) AN 8 DIGIT VALUE ITEM IF AN SP BINARY INTEGER
*                 B) AN ADDRESS IF IT'S A NON-EXTERNAL
*                 C) FX,FS,FL,EXT,D,DPI,OR LFR AS APPROPRIATE
*
EDITV    RES      0
*   ENTRY FOR EDITING VALUE IN EXPRESSION TABLE
         LW,XT    0,XS
         AW,XT    KLINE
         STW,XT   ARG               STORE POINTER TO VALUE IN EVT
EDITVAL  RES      0
         LW,XT    PROCREF           EXIT IF NOT ON SOURCE LEVEL
         EXIT,NE  RL
EDITV1   RES      0                 ENTRY FOR DISP DIRECTIVE
         LW,XT    PASS              EXIT IF IN THE DEFINITION PASS
         EXIT,EQ  RL
         STW,RL   EDITDXIT          SAVE EXIT ADDRESS
         LW,XT1   *ARG              CONTROL WORD OF ITEM
         CALL     TYPE              DETERMINE TYPE OF ITEM
         SHIFT,XT2 ETLOB,31         RIGHT ADJUST TYPE
         LB,XT    EDITVTBL,XT2
         LI,LBX   18                START STORING IN BYTE 18
         LW,XT3   ARG               ADDRESS OF ARGUMENT
         B        EDITVJMP,XT       BRANCH ON ITEM'S TYPE
*
EJ       COM,8    AF-EDITVJMP
EDITVTBL RES      0
         EJ       EDITV10           UNDEFINED
         EJ       EDITV2            SPECIAL ADDRESS
         EJ       EDITV10           SPECIAL EXTERNAL
         EJ       EDITV3            SIMPLE ADDRESS
         EJ       EDITV5            SUM
         EJ       EDITV10           EXTERNAL
         EJ       EDITV10           LOCAL FORWARD
         EJ       EDITV10           LOCAL FORWARD AND HOLD
         EJ       EDITV10           ONE WORD ADDRESS
         EJ       EDITV8            SPECIAL INTEGER
         EJ       EDITV9            BLANK
         EJ       EDITV6            INTEGER
         EJ       EDITV10           PACKED DECIMAL
         EJ       EDITV10           TEXT
         EJ       EDITV10           FX
         EJ       EDITV10           FS
         EJ       EDITV10           FL
         EJ       EDITV10           DPI
         EJ       EDITV10           LIST
         EJ       EDITV10           FUNCTION
         BOUND    4
*
EDITVJMP RES      0
*   HERE FOR SPECIAL ADDRESS
EDITV2   RES      0
         LV,XT    ADDFLD            MASK FOR ADD FIELD
         AND,XT   XT1               ADD FIELD AT INTRINSIC RESOLUTION
         LV,RL    CSFLD             MASK FOR CS FIELD
         AND,RL   XT1
         SHIFT,RL CSLOB,7           LEFT ADJUST CONTROL SECTION #
         B        EDITV4
*   HER FOR SIMPLE ADDRESS
EDITV3   RES      0
         LW,XT    1,XT3             GET OFFSET AND CONTROL SECTION
         LV,RL    FCSFLD            MASK FOR FCS FIELD
         AND,RL   XT
         SHIFT,RL FCSLOB,7          LEFT ADJUST CONTROL SECTION #
EDITV4   RES      0
         SHIFT,XT1 ARLOB,31         RIGHT ADJUST AR FIELD
         AND,XT1  =3
         SCS,XT   0,XT1             SHIFT OFFSET TO BYTE RESOLUTION
         STW,XT   TX1                 AND SAVE IN TEMP
         LW,XT1   RL                LOAD LEFT ADJUSTED CONTROL SECTION #
         LI,NBYTES 2
         CALL     XEDIT             OUTPUT CONTROL SECTION AS 2 DIGITS
         AI,LBX   1                 LEAVE A BLANK COLUMN IN LSTBF
         LW,XT1   TX1
         SLS,XT1  10                LEFT ADJUST WORD OFFSET FOR XEDIT
         LI,NBYTES 5
         CALL     XEDIT             OUTPUT WORD OFFSET AS 5 DIGITS
         AI,LBX   1                 LEAVE A BLANK COLUMN IN LSTBF
         LW,XT1   TX1
         AND,XT1  =3
         CALL     DEDIT             OUTPUT BYTE OFFSET IF NON-ZERO
         B        *EDITDXIT         EXIT
*   HERE FOR SUM
EDITV5   RES      0
         AI,LBX   9                 SKIP OVER 9 BYTES
         LI,XT1   'S'
         STB,XT1  LSTBF,LBX         OUTPUT A SUM INDICATOR
         AI,LBX   -9                BACK UP 9 BYTES
*   HERE FOR INTEGER
EDITV6   RES      0
         LW,XT1   1,XT3             LOAD WORD FOLLOWING CONTROL WORD
EDITV7   RES      0
         LI,NBYTES 8
         CALL     XEDIT             OUTPUT 8 HEX DIGITS
         B        *EDITDXIT         EXIT
*   HERE FOR SPECIAL INTEGER
EDITV8   RES      0
         BFNZ,XT1,1  CCFLD,EDITV10  BRANCH IF SPECIAL INTEGER TEXT
         LV,XT    VALFLD            MASK FOR VAL FIELD
         AND,XT1  XT
         B        EDITV7
*   HERE FOR BLANK ITEM
EDITV9   RES      0
         LI,XT1   0                 OUTPUT A ZERO
         B        EDITV7
*   HERE FOR UNDEFINED, SPECIAL EXTERNAL, EXTERNAL, LOCAL FORWARD,
*     LOCAL FORWARD & HOLD, ONE WORD ADDRESS, PACKED DECIMAL,
*     TEXT, FX, FS, FL, DPI, LIST, AND FUNCTION
EDITV10  RES      0
         LW,XT    DD%TYPE
         SHIFT,XT ETLOB,31          RIGHT ADJUST ITEM'S TYPE
         LB,XT1   EDITVMSGTBL,XT
         AI,XT1   BA(EDITVMSG)      BYTE ADDRESS OF TEXT MESSAGE
         LI,NBYTES 4
         CALL     AEDIT             OUTPUT A 4 CHARACTER MESSAGE
         B        *EDITDXIT         EXIT
*
EM       COM,8    BA(AF)-BA(EDITVMSG)
EDITVMSGTBL  RES  0
         EM       UNDMSG            UNDEFINED
         EM       UNDMSG            SPECIAL ADDRESS
         EM       EXTMSG            SPECIAL EXTERNAL
         EM       UNDMSG            SIMPLE ADDRESS
         EM       UNDMSG            SUM
         EM       EXTMSG            EXTERNAL
         EM       LFRMSG            LOCAL FORWARD
         EM       LFRMSG            LOCAL FORWARD AND HOLD
         EM       UNDMSG            ONE WORD ADDRESS
         EM       TEXTMSG           SPECIAL INTEGER (TEXT)
         EM       UNDMSG            BLANK
         EM       UNDMSG            INTEGER
         EM       DMSG              PACKED DECIMAL
         EM       TEXTMSG           TEXT
         EM       FXMSG             FX
         EM       FSMSG             FS
         EM       FLMSG             FL
         EM       DPIMSG            DPI
         EM       LISTMSG           LIST
         EM       UNDMSG            FUNCTION
         BOUND    4
*
EDITVMSG RES      0
UNDMSG   TEXT     'UND '
EXTMSG   TEXT     'EXT '
LFRMSG   TEXT     'LFR '
DMSG     TEXT     'D   '
TEXTMSG  TEXT     'TEXT'
FXMSG    TEXT     'FX  '
FSMSG    TEXT     'FS  '
FLMSG    TEXT     'FL  '
DPIMSG   TEXT     'DPI '
LISTMSG  TEXT     'LIST'
         PAGE
*
*   E R R
*        THIS ROUTINE RECORDS ERRORS REPORTED BY XAP.  IT HAS MULTIPLE
*          ENTRY POINTS; EACH ONE LOADS AN ERROR CODE AND A SEVERITY
*          FOR THAT ERROR AND BRANCHES TO A COMMON PROCESSING POINT.
*          THIS ROUTINE MAINTAINS THE NUMBER OF ERRORS ENCOUNTERED
*          WITHIN A LINE AND THE MAXIMUM SEVERITY FOR AN ENTIRE
*          ASSEMBLY. THE FIRST THREE ERROR CODES REPORTED FOR A LINE
*          WILL BE LISTED WITH THAT LINE. ANY ADDITIONAL ERRORS PER LINE
*          WILL BE INCLUDED IN THE ERROR COUNT BUT WILL NOT BE LISTED.
*          MAXIMUM SEVERITY IS DETERMINED FROM ALL ERRORS REPORTED,
*          WHETHER LISTED OR NOT.
*
*        INPUT:   REGISTER EC CONTAINS AN EBCDIC ERROR CODE AND A
*                   SEVERITY LEVEL
*
*        OUTPUT:  ERRTRIG CONTAINS THE NUMBER OF ERRORS REPORTED FOR
*                   THE CURRENT LINE.
*                 ERRSEV CONTAINS THE MAXIMUM SEVERITY ERROR REPORTED
*
*        CALL:    BAL,ER  CERR
*                 BAL,ER  DERR
*                 BAL,ER  EERR
*                 BAL,ER  IERR
*                 BAL,ER  KERR
*                 BAL,ER  LERR
*                 BAL,ER  SERR
*                 BAL,ER  TERR
*                 BAL,ER  UERR
*
*        USES REGISTERS
*                 EC
*                 ER
*
*
ERRCODE  COM,8,4,12,8  X'22',EC,AF(1),AF(2)
*
CERR     RES      0
         ERRCODE  'C',3
         B        ERR3
DERR     RES      0
         ERRCODE  'D',3
         B        ERR3
EERR     RES      0
         ERRCODE  'E',3
         B        ERR3
IERR     RES      0
         ERRCODE  'I',3
         B        ERR3
KERR     RES      0
         ERRCODE  'K',3
         B        ERR3
LERR     RES      0
         ERRCODE  'L',3
         B        ERR3
SERR     RES      0
         ERRCODE  'S',3
         B        ERR3
TERR     RES      0
         ERRCODE  'T',3
         B        ERR3
UERR     RES      0
         MTW,0    TCORFLG           DON'T REPORT UNDEFINED ERRORS
         EXIT,NE  ER                  WHILE PROCESSING TCOR OR DISP
         ERRCODE  'U',3
ERR3     RES      0
         MTW,0    PASS
         EXIT,EQ  ER                DON'T REPORT ERRORS IN DEFINITION
         CB,EC    MAXSEV
         BLE      ERR4              SEVERITY FOR THIS ERROR NOT MAXIMUM
         STB,EC   MAXSEV            UPDATE MAXIMUM SEVERITY LEVEL
ERR4     RES      0
         SLS,EC   -8                SHIFT OFF SEVERITY
         XW,XT    ERRTRIG           SAVE XT AND LOAD ERROR COUNT
         BEZ      ERR6              FIRST ERROR FOR THIS LINE
*                                                              /25342/*D-DGCOM
         LH,XT    XT                RIGHT-JUSTIFY              /25342/*D-DGCOM
         CI,XT    3                 BRANCH IF 3 ERROR CODES HAVE ALREADY
         BE       ERR7                BEEN STORED FOR THIS LINE
         STB,XT   EC                SAVE ERROR COUNT
ERR5     RES      0
         CB,EC    LSTBF,XT          DON'T STORE CURRENT ERROR CODE IF IT
         BE       ERR8                IS ALREADY IN THE LIST BUFFER
         BDR,XT   ERR5
         LB,XT    EC                RESTORE ERROR COUNT
ERR6     RES      0
         AI,XT    1                 INCREMENT ERROR COUNT
         STB,EC   LSTBF,XT          STORE ERROR CODE IN LIST BUFFER
ERR7     RES      0
         SLS,XT   16                RESTORE TO LEFT HW         /25342/*D-DGCOM
         XW,XT    ERRTRIG           UPDATE ERROR COUNT AND RESTORE XT
         EXIT     ER
ERR8     RES      0
         LB,XT    EC                RESTORE ERROR COUNT
         B        ERR7
         PAGE
*
*   E X P E N D
*        THIS SUBROUTINE OUTPUTS AN EXPRESSION END LOADER CODE TO THE
*         'BO' FILE.
*
*        CALL:    BAL,RL  EXPEND
*
*        USES REGISTERS
*                 NBYTES
*                 XT1
*
EXPEND   RES      0
         LI,XT1   BA(EXPENDCD)      LOADER CODE FOR EXPRESSION END
         LI,NBYTES 1                OUTPUTS ONE BYTE
         B        BEDIT%SE          ERROR IF SOCW CONTROL IN EFFECT
         PAGE
*
*   G E N E R A T E
*        THIS SUBROUTINE GENERATES BINARY OBJECT CODE TO THE BO BUFFER
*          AND EQUIVALENT HEX CODE TO THE LO BUFFER. IT ALSO EDITS
*          THE ADDRESS TYPE TO THE LO BUFFER (N,X, ,A,F,CS#). DURING
*          THE GENERATION PASS OBJECT CODE IS PRODUCED; DURING THE
*          DEFINITION PASS, THE LOCATION COUNTERS ARE INCREASED BY THE
*          NUMBER OF BYTES TO BE GENERATED.
*
*        INPUT:   INPUT TO GENERATE CONSISTS OF TWO LISTS; THE FIRST
*                   LIST IS A SERIES OF POINTERS TO FIELD LENGTH
*                   DEFINITIONS, THE SECOND LIST IS A SERIES OF POINTERS
*                   TO FIELD VALUES.
*                 XT CONTAINS THE NUMBER OF BYTES TO BE GENERATED.
*                 FLDCNT CONTAINS THE NUMBER OF ENTRIES IN THE FIELD
*                   LENGTH LIST
*                 FLDPTR CONTAINS A POINTER TO THE FIRST ENTRY IN THE
*                   FIELD LENGTH LIST
*                 VALCNT CONTAINS THE NUMBER OF ENTRIES IN THE FIELD
*                   VALUE LIST
*                 VALPTR CONTAINS A POINTER TO THE FIRST ENTRY IN THE
*                   FIELD VALUE LIST
*
*        OUTPUT:  THE LOCATION COUNTERS HAVE BEEN ADVANCED BY THE
*                   NUMBER OF BYTES GENERATED.
*
*        CALL:    BAL,RL  GENERATE  BOTH LISTS ARE IN EXPRESSION TABLE
*                 BAL,RL  GENERATE1 VALUE LIST IS IN EXPRESSION TABLE,
*                                     BUT FIELD LENGTH LIST IS ELSEWHERE
*        USES REGISTERS
*                 XT
*                 XT1
*                 XT2
*                 XT3
*                 RL
*                 TR0
*                 TR1
*
         LOCAL    %1,%2,%3,%10,%20,%30,%40,%50,%60,%70,%71,%72
         LOCAL    %80,%90,%91,%92,%93,%94,%100,%110,%120,%121,%122
         LOCAL    %130,%131,%132,%140,%150,%160,%170,%180,%190
         LOCAL    %200,%210,%290,%291,%300,%301,%302,%303,%304
         LOCAL    %305,%306,%307,%310,%311,%320,%321,%330,%331
         LOCAL    %340,%341,%342,%350,%351,%352,%360,%361,%362
         LOCAL    %370,%371,%380,%381,%382,%383,%384,%390,%391
         LOCAL    %392,%400,%401,%410,%420,%421,%430,%431,%432
GENERATE RES      0
         LW,XT1   KLINE             FIELD LENGTH POINTERS ARE OFFSETS
         B        %1                  FROM KLINE
GENERATE1  RES    0
         LI,XT1   0                 FIELD LENGTH POINTERS ARE ADDRESSES
%1       RES      0
         STW,XT1  FLDPTRBSE         BASE ADDRESS FOR FLDPTR
         LW,XT1   DLRCS
         AWM,XT1  DATAGEN           INDICATE DATA HAS BEEN GENERATED
         MTW,0    PASS
         BNEZ     %2                GENERATION PASS
*   HERE FOR DEFINITION PASS.
         AWM,XT   DLRVAL            ADVANCE BOTH LOCATION COUNTERS BY
         AWM,XT   DDLRVAL             NUMBER OF BYTES TO BE GENERATED
         EXIT     RL
%2       RES      0
*   HERE FOR GENERATION PASS
         STW,RL   GENEXIT
         CALL     ORIGIN            OUTPUT A LOAD ORIGIN IF NEEDED
         LI,XT    0
         STW,XT   ASVCNT            INITIALIZE ADD/SUBTRACT VALUE COUNT
         STW,XT   HVLENGTH            AND ACCUMULATED LENGTH
         STW,XT   HEXVAL              AND FOUR WORD ACCUMULATED VALUE
         STW,XT   HEXVAL+1
         STW,XT   HEXVAL+2
         STW,XT   HEXVAL+3
         LW,XT    FLDCNT
         CW,XT    VALCNT
         BGE      %10               MORE FIELDS THAN VALUES WILL PAD 0'S
         STW,XT   VALCNT            MORE VALUES THAN FIELDS, USE FIELD
         BAL,ER   EERR                COUNT FOR BOTH AND REPORT ERROR
         B        %10
%3       RES      0
*   MAJOR LOOP FOR FIRST PASS BEGINS HERE
         MTW,-1   FLDPTR            DECREMENT POINTERS TO NEXT FIELD
         MTW,-1   VALPTR              SIZE AND VALUE
         MTW,-1   VALCNT            DECREMENT VALUE COUNT
%10      RES      0
         LI,XT    1
         STW,XT   NOWORDS           INITIALIZE NUMBER OF WORDS
         LW,XT    *FLDPTR           GET POINTER TO FIELD SIZE
         LW,XT    *FLDPTRBSE,XT     LOAD FIELD SIZE
         AND,XT   =VALFLD           GET VALUE FROM SPECIAL INTEGER
         STW,XT   FLENGTH           SAVE FIELD LENGTH
         BEZ      %170              DO NOTHING FOR ZERO LENGTH FIELD
         LW,XT    VALCNT
         BLEZ     GEN35             NO MORE VALUES                /10778/B-08773
         LW,XT    *VALPTR           GET VALUE CONTROL WORD
         AW,XT    KLINE
         STW,XT   ARG               SAVE POINTER TO VALUE
         AND,XT   =ETFLD
         STW,XT   DD%TYPE           SAVE ITEM TYPE
         SHIFT,XT ETLOB,31          RIGHT JUSTIFY TYPE
         LB,XT    TYPETBL,XT        GET OFFSET TO ITEM TYPE PROCESSOR
         B        TYPEBASE,XT       BRANCH TO ITEM TYPE PROCESSOR
*
TYPEBASE RES      0
*
%20      RES      0
*   HERE FOR EXTERNAL, SPECIAL EXTERNAL, LOCAL FORWARD, LOCAL FORWARD
*     AND HOLD, OR ONE WORD ADDRESS
         LI,XT    0                 USE ZERO VALUE
         B        %60
%30      RES      0
*   HERE FOR SPECIAL ADDRESS
         LW,RL    *ARG              LOAD ADDRESS WORD
         LV,XT    ADDFLD            MASK FOR ADDRESS FIELD
         AND,XT   RL                GET ADDRESS
         BFZ,RL   CSFLD,%70         ABSOLUTE CONTROL SECTION
         B        %60               RELOCATABLE CONTROL SECTION
GEN35    RES      0                                               /10778/B-08773
         LW,XT    VALPTR            IS THERE ROOM FOR             /10778/B-08773
         CW,XT    NXTSYMT             A BLANK ECT ENTRY           /10778/B-08773
         BL       HILIMIT4            NO.  ABORT                  /10778/B-08773
%40      RES      0
*   HERE FOR BLANK FIELD
         LW,XT    *FLDPTR           GET FIELD SIZE ECT ENTRY
         BFZ,XT   ASTFLD,GEN41      NO VALUE REQUIRED FOR THIS FIELD
         BAL,ER   EERR              ERROR, THIS FIELD REQUIRES A VALUE
GEN41    RES      0
         LI,XT    0                 USE ZERO VALUE
         B        %70
%140     RES      0
*   HERE FOR UNDEFINED GLOBAL, LIST, AND FUNCTION
         BAL,ER   UERR              UNDEFINED ITEM
         B        GEN41
%50      RES      0
*   HERE FOR SMALL INTEGER
         LW,XT    *ARG              LOAD SMALL INTEGER WORD
         AND,XT   =VALFLD           GET INTEGER VALUE
         B        %70
%80      RES      0
*   HERE FOR COMPLEX SUM
         MTW,1    ARG               POINT TO WORD FOLLOWING CONTROL WORD
         LW,XT    *ARG              LOAD VALUE
         B        %60
%90      RES      0
*   HERE FOR PACKED DECIMAL, FL, AND DPI
         LW,XT    *ARG              LOAD CONTROL WORD
         AND,XT   =LENGTHFLD        GET LENGTH
         AI,XT    -1                  AND DECREASE BY ONE
         CI,XT    4
         BLE      %91               4 WORDS OR LESS IS OK
         BAL,ER   TERR              TRUNCATION ERROR
         LI,XT    4                 SET LENGTH TO 4
%91      RES      0
         STW,XT   NOWORDS           NUMBER OF VALUE WORDS
%92      RES      0
         LW,RL    *ARG,XT           MOVE CONSTANTS FROM EXPRESSION
         STW,RL   FLDVAL-1,XT         TABLE TO FLDVAL; MOVING FROM LAST
         BDR,XT   %92                 TO FIRST
         LW,RL    FLDVAL
         BGEZ     %71               VALUE IS POSITIVE
         LW,XT1   ARG               LOAD CONTROL WORD
%93      RES      0
         BFZ,XT1,1 EXPFLD,%71       VALUE IS NOT SIGNED
         LW,XT    FLENGTH
         AI,XT    31                COMPUT THE NUMBER OF WORDS THAT
         SLS,XT   -5                  VALUE IS TO BE PACKED INTO
         CW,XT    NOWORDS           IF IT'S NOT MORE THAN THE CONSTANT
         BLE      %71                 NO SIGN EXTENSION IS NEEDED
         LW,XT1   NOWORDS
         STW,XT   NOWORDS
%94      RES      0
         LW,RL    FLDVAL-1,XT1      RIGHT ADJUST CONSTANT WITHIN THE
         STW,RL   FLDVAL-1,XT         NUMBER OF WORDS TO BE USED
         AI,XT    -1
         BDR,XT1  %94
         LI,RL    -1
         STW,RL   FLDVAL-1,XT       THEN EXTEND THE MINUS SIGN THRU-OUT
         BDR,XT   %-1                 THE REST OF THE HIGH ORDER WORDS
         B        %71
%100     RES      0
*   HERE FOR INTEGER AND FS
         LW,XT1   ARG               LOAD CONTROL WORD
         LW,XT    1,XT1             LOAD VALUE
         BGEZ     %70               VALUE IS POSITIVE
         STW,XT   FLDVAL
         B        %93
%110     RES      0
*   HERE FOR SIMPLE ADDRESS
         MTW,1    ARG               POINT TO WORD FOLLOWING CONTROL WORD
         LW,RL    *ARG              LOAD WORD CONTAINING ADDRESS
         LV,XT    OFFSETFLD         MASK FOR OFFSET FIELD
         AND,XT   RL                GET OFFSET
         BFZ,RL   FCSFLD,%70        ABSOLUTE CONTROL SECTION
         B        %60               RELOCATABLE CONTROL SECTION
%120     RES      0
*   HERE FOR FX
         MTW,1    ARG               POINT TO WORD FOLLOWING CONTROL WORD
         LW,XT    *ARG              LOAD VALUE
         LI,XT1   0
         LW,XT2   FLENGTH           FIELD LENGTH
         AND,XT2  =X'1F'            SHIFT COUNT
         BEZ      %121              SHIFT ZERO PLACES
         SLD,XT   -32,XT2           RIGHT DOUBLE
%121     RES      0
         STW,XT   FLDVAL            ADJUSTED VALUE
         LW,RL    FLENGTH
         AI,RL    -32               DECREASE FIELD LENGTH BY 1 WORD
         BLEZ     %71               FIELD LENGTH IS 1 WORD OR LESS
%122     RES      0
         LW,XT    NOWORDS
         STW,XT1  FLDVAL,XT         STORE RIGHT HALF VALUE, OR ZERO
         LI,XT1   0                   AND PAD ZEROS UNTIL NUMBER OF
         MTW,1    NOWORDS             WORDS CORRESPONDING TO FIELD SIZE
         AI,RL    -32                 HAVE BEEN STORED
         BG       %122
         B        %71
%130     RES      0
*   HERE FOR TEXT
         MTW,1    ARG               POINT TO WORD FOLLOWING CONTROL WORD
         LI,XT    0
         STW,XT   FLDVAL
         LB,XT    *ARG              LOAD BYTE COUNT
         BEZ      %71               NO CHARS TO STORE
         CI,XT    16
         BLE      %131
         BAL,ER   TERR              TRUNCATION ERROR, TOO MANY CHARS
         LI,XT    16                USE MAX BYTE COUNT
%131     RES      0
         LW,XT1   XT
         AI,XT1   3
         SLS,XT1  -2                (BYTE COUNT+3)/4 IS
         STW,XT1  NOWORDS             NUMBER OF WORDS
         SLS,XT1  2
         AI,XT1   -1                (NOWORDS*4)-1 IS LAST CHAR POSITION
%132     RES      0
         LB,RL    *ARG,XT
         STB,RL   FLDVAL,XT1
         AI,XT1   -1
         BDR,XT   %132
         B        %71
%60      RES      0
         STW,XT   FLDVAL
         MTW,1    ASVCNT            INCREMENT ADD/SUBTRACT VALUE COUNT
         LV,XT    RELOFLD           FLAG TO USE ENTRY
         B        %72
%70      RES      0
         STW,XT   FLDVAL
%71      RES      0
         LI,XT    0                 FLAG TO SKIP ENTRY
%72      RES      0
         LV,XT1   RELOFLD           MASK FOR RELO FIELD
         STS,XT   *VALPTR           SET USE/SKIP FLAG IN VALUE POINTER
*
*   HERE THE VALUE IN FLDVAL IS MERGED INTO THE APPROPRIATE FIELD OF
*        HEXVAL. NOWORDS IS THE NUMBER OF SIGNIFICANT WORDS IN FLDVAL.
*        FLENGTH IS THE NUMBER OF BITS IN THE CURRENT FIELD WITHIN
*        FLDVAL. HVLENGTH IS THE BIT POSITION IN HEXVAL (0-127) TO
*        START MERGING. TRUNCATION IS DIAGNOSED.
*
         LW,XT1   NOWORDS           NUMBER OF WORDS IN FLDVAL
         LW,XT    FLENGTH           FIELD LENGTH PLUS OLD TOTAL LENGTH
         AW,XT    HVLENGTH            IS CURRENT TOTAL LENGTH
         CI,XT    32                IF ACCUMULATED LENGTH EXCEEDS ONE
         BG       %180                WORD, GO PROCESS MULTI-WORD MERGE
         CI,XT1   1                 IF VALUE TO MERGE EXCEEDS ONE WORD,
         BNE      %180                GO PROCESS MULTI-WORD MERGE
*   HERE IF VALUE TO BE MERGED IS ONLY ONE WORD AND FINAL RESULT WILL
*        FIT IN ONE WORD.
         LI,TR0   0                 SET SIGN PLUS IN HIGH ORDER WORD
         LW,TR1   FLDVAL            VALUE TO MERGE IN LOW ORDER WORD
         BGE      %150              VALUE IS POSITIVE
         LI,TR0   -1                VALUE IS NEGATIVE, SET SIGN WORD -
%150     RES      0
         LI,XT    32
         SW,XT    FLENGTH
         SLD,TR0  0,XT              LEFT ADJUST VALUE
         CALL     CHCKTRUN          CHECK FOR TRUNCATION
         LCW,XT   HVLENGTH
         SLS,TR1  0,XT              POSITION VALUE
         AWM,TR1  HEXVAL            MERGE VALUE INTO ACCUMULATED WORD
%160     RES      0
*   HERE TO COMPLETE PROCESSING OF CURRENT FIELD
         LW,XT    FLENGTH
         AWM,XT   HVLENGTH          ADD FIELD SIZE TO TOTAL
%170     RES      0
         MTW,-1   FLDCNT            DECRSMENT FIELD COUNT
         BGZ      %3                BACK TO PROCESS NEXT FIELD
         B        %300              BEGIN SECOND PASS PROCESSING
%180     RES      0
*   HERE TO PERFORM A MULTI-WORD MERGE.
*   THIS SECTION INITIALIZES.
         LI,XT2   128
         SW,XT2   XT                NUMBER OF BITS TO SHIFT LEFT TO
         AND,XT2  =X'1F'              POSITION VALUE
         AI,XT    -1
         SLS,XT   -5                INDEX TO LOW ORDER WORD OF HEXVAL
         LCW,XT3  FLENGTH
*   STARTING HERE, WORDS ARE MOVED FROM FLDVAL TO HEXVAL. A VALUE IS
*        MOVED FROM LOW ORDER TO HIGH ORDER WORDS.
%190     RES      0
         CI,XT3   -32
         BG       %200              PROCESS WORD CONTAINING FINAL UNIT.
         LI,TR0   0
         LW,TR1   FLDVAL-1,XT1      LOAD FIELD VALUE WORD
         STW,TR1  ER                SAVE IT FOR TRUNCATION TEST LATER
         SLD,TR0  0,XT2             POSITION VALUE FOR MERGING
         AWM,TR1  HEXVAL,XT         MERGE LOW ORDER VALUE WORD
         AWM,TR0  HEXVAL-1,XT         AND HIGHER ORDER WORD
         AI,XT3   32                INCREASE FIELD LENGTH
         AI,XT    -1                INDEX TO HIGHER ORDER WORD OF HEXVAL
         BDR,XT1  %190              DECREMENT NUMBER OF WORDS OF FLDVAL
*                                     AND CONTINUE IF MORE
*   HERE IF NUMBER OF WORDS OF FLDVAL IS EXHAUSTED. TRUNCATION IS NOT
*        POSSIBLE.
         B        %160              DONE PROCESSING THIS VALUE
%200     RES      0
*   HERE TO PROCESS THE WORD CONTAINING THE FINAL UNIT.
         LW,TR0   FLDVAL-1,XT1      LOAD VALUE WORD
         CI,XT3   0
         BE       %220              REMAINING FIELD LENGTH IS ZERO
         LI,TR1   0
         SAD,TR0  0,XT3             SHIFT RIGHT TO SPLIT THE WORD
         SW,XT2   XT3
         AI,XT2   -32
         CALL     CHCKTRUN          CHECK FOR TRUNCATION
         LI,TR0   0
         SLD,TR0  0,XT2             POSITION VALUE WORD FOR MERGING
         AWM,TR1  HEXVAL,XT         MERGE LOW ORDER VALUE WORD
         AWM,TR0  HEXVAL-1,XT         AND HIGHER ORDER WORD
%210     RES      0
*   HERE TO DISCARD REMAINING WORDS. EACH WORD MUST BE EQUAL TO THE
*        SIGN OF VALUE ,I.E. ALL ZEROS OR ALL ONES, OR TRUNCATION ERROR
*        IS REPORTED.
         AI,XT1   -1                DECREMENT NUMBER OF FLDVAL WORDS
         BE       %160              ALL WORDS PROCESSED
         CW,ER    FLDVAL-1,XT1      IF WORD IS SAME AS SIGN WORD
         BE       %210                IT CAN BE DISCARDED
*   HERE WHEN VALUE WORD TO BE DISCARDED IS NOT THE SAME AS SIGN WORD.
         CALL     CKTRUN1           REPORT TRUNCATION ERROR
         B        %160
%220     RES      0
*   HERE TO CHECK FOR TRUNCATION WHEN REMAINING FIELD LENGTH IS ZERO.
         LW,TR1   ER
         CALL     CHCKTRUN          CHECK FOR TRUNCATION
         B        %210
*
*   C H C K T R U N
*        THIS SUBROUTINE IS USED BY GENERATE TO CHECK FOR POSSIBLE
*          TRUNCATION.
*
*        OUTPUT:  ER CONTAINS SIGN WORD (ZERO OR -1) OR IS GREATER THAN
*                   ZERO IF TRUNCATION OCCURS.
*
*        CALL:    BAL,RL  CHCKTRUN
*
CHCKTRUN RES      0
         LW,ER    TR0               IF HIGH ORDER WORD IS ZERO, THERE
         EXIT,EQ  RL                  IS NO TRUNCATION
         CI,ER    -1                IF HIGH ORDER WORD IS NOT -1, THERE
         BNE      CKTRUN1             IS A TRUNCATION ERROR
         CI,TR1   0                 IF HIGH ORDER WORD IS -1 AND LOW
         EXIT,L   RL                  ORDER WORD IS NEGATIVE, THERE IS
*                                     NO TRUNCATION
CKTRUN1  RES      0
         LV,ER    SUMET             DON'T REPORT TRUNCATION ERROR IF
         CW,ER    DD%TYPE             THE ITEM IS A COMPLEX SUM
         EXIT,EQ  RL
         BAL,ER   TERR              REPORT TRUNCATION ERROR
         EXIT     RL
*
*   TABLE OF OFFSETS TO ITEM TYPE PROCESSOR
*
TYP      COM,8    AF-TYPEBASE
TYPETBL  RES      0
         TYP      %140              UNDEFINED
         TYP      %30               SPECIAL ADDRESS
         TYP      %20               SPECIAL EXTERNAL
         TYP      %110              SIMPLE ADDRESS
         TYP      %80               SUM
         TYP      %20               EXTERNAL
         TYP      %20               LOCAL FORWARD
         TYP      %20               LOCAL FORWARD AND HOLD
         TYP      %20               ONE WORD ADDRESS (WITHIN SUM)
         TYP      %50               SPECIAL INTEGER
         TYP      %40               BLANK FIELD
         TYP      %100              INTEGER
         TYP      %90               PACKED DECIMAL
         TYP      %130              TEXT
         TYP      %120              FX
         TYP      %100              FS
         TYP      %90               FL
         TYP      %90               DPI
         TYP      %140              LIST
         TYP      %140              FUNCTION
         BOUND    4
GENERATE2  RES    0
*   HERE TO GENERATE A FORWARD REFERENCE DEFINITION
         MTW,0    PASS
         EXIT,EQ  RL                DEFINITION PASS
         STW,RL   GENEXIT
         LI,RL    8                 LOADER CODE FOR FORWARD REFERENCE
         AND,XT   =LENGTHFLD+STYPEFLD
         STW,XT   ACONVAL           STORE FORWARD REFERENCE NUMBER
         CV,XT    LCLFWDHD
         BL       %290              ITEM IS NOT A FORWARD AND HOLD
         LI,RL    16                LOADER CODE FOR FORWARD AND HOLD
%290     RES      0
         STH,RL   ACONVAL           STORE LOADER CONTROL CODE
         LI,NBYTES  3               NUMBER OF BYTES TO OUTPUT
         LI,XT1   BA(ACONVAL)+1     BYTE ADDRESS OF 1ST BYTE TO OUTPUT
         CALL     BEDIT%SE          ERROR IF SOCW CONTROL IN EFFECT
         B        %291
GENERATE3 RES     0
*   HERE TO GENERATE A LOAD DEFINITION
         STW,RL   GENEXIT
%291     RES      0
         MTB,1    GENEXIT           FLAG FOR LOAD DEFINITIONS
         LI,XT    0
         STW,XT   ACONVAL           INITIALIZE OFFSET TO ZERO
         STW,XT   LARG
         B        %307
*   HERE FOR SECOND PASS INITIALIZATION.
%300     RES      0
         LW,XT    HVLENGTH
         SLS,XT   -3
         STW,XT   NOBYTES           NUMBER OF BYTES TO LOAD
         LI,XT    0
         STW,XT   HVLENGTH          INITIALIZE BACKWARD FIELD SIZE TOTAL
         B        %306
*   MAJOR LOOP FOR SECOND PASS BEGINS HERE
%301     RES      0
         MTW,1    FLDPTR            ADVANCE POINTERS TOWARD BOTTOM
         MTW,1    VALPTR
%306     RES      0
         MTW,0    ASVCNT
         BEZ      %304              ONLY CONSTANTS REMAINING
         LW,XT    *FLDPTR           GET POINTER TO FIELD SIZE
         LW,XT1   *FLDPTRBSE,XT     GET FIELD SIZE
         AND,XT1  =VALFLD
         STW,XT1  FLENGTH           SAVE FIELD SIZE
         BEZ      %301              SKIP ZERO LENGTH FIELDS
         LW,XT    *VALPTR           GET VALUE CONTROL WORD
         BFNZ,XT  RELOFLD,%303      PROCESS ADD/SUBTRACT VALUE ITEM
*   HERE IF FIELD IS ABSOLUTE
         LW,XT    HVLENGTH
         BNEZ     %302              NOT FIRST FIELD
         CALL     LOADABS           OUTPUT A LOAD ABSOLUTE CODE
%302     RES      0
         LW,XT    FLENGTH
         AWM,XT   HVLENGTH          ACCUMULATE BACKWARD FIELD TOTAL
         B        %301
%303     RES      0
*   HERE FOR RELOCATABLE ITEMS WHICH OUTPUT ADD/SUBTRACT VALUE ITEMS.
         MTW,-1   ASVCNT            DECREMENT ADD/SUBTRACT VALUE COUNT
         AW,XT    KLINE
         STW,XT   ARG               SAVE POINTER TO VALUE
%307     RES      0
         LW,XT1   *ARG
         CALL     TYPE              GET ITEM'S TYPE
         LW,XT    DD%TYPE
         SHIFT,XT ETLOB,31
         LB,XT    TYPETBL2,XT
         B        TYPEBSE2,XT
%304     RES      0
*   HERE IF ONLY CONSTANTS REMAIN IN HEXVAL
         MTW,0    HVLENGTH
         BNEZ     %305              LOAD CONTROL ALREADY OUTPUT
*   HERE IF HEXVAL CONSISTS OF ENTIRELY CONSTANTS
         CALL     LOADABS           OUTPUT LOAD ABSOLUTE CONTROL
         LI,XT    'A'
         STW,XT   CODE              SET CODE TO ABSOLUTE
%305     RES      0
         CALL     EDIT              EDIT HEXVAL INTO OBJECT LISTING
         B        *GENEXIT
*
TYPEBSE2 RES      0
*
%310     RES      0
*   HERE FOR SPECIAL ADDRESS
         LW,XT    *ARG              GET WORD CONTAINING ADDRESS
         LV,RL    CSFLD
         AND,RL   XT                GET CONTROL SECTION NUMBER
         SHIFT,RL CSLOB,31          RIGHT JUSTIFY IT
         STW,RL   DDCS              SAVE CONTROL SECTION NUMBER
         BEZ      %311              ABSOLUTE CONTROL SECTION
         AW,RL    CSBASE            DECLARATION NUMBER FOR 1ST CS
%311     RES      0
         STW,RL   DDNUM             CONTROL SECTION DECLARATION NUMBER
         LV,RL    ADDFLD
         AND,RL   XT
         STW,RL   ACONVAL           OFFSET
         STW,RL   LARG
         B        %331
%320     RES      0
*   HERE FOR ADDRESS
         LW,XT    *ARG              GET CONTROL WORD
         MTW,1    ARG               POINT TO WORD FOLLOWING CONTROL WORD
         LW,RL    *ARG              GET WORD CONTAINING ADDRESS
         LV,XT1   FCSFLD
         AND,XT1  RL                GET CONTRO SECTION NUMBER
         SHIFT,XT1 FCSLOB,31        RIGHT JUSTIFY IT
         STW,XT1  DDCS              SAVE CONTROL SECTION NUMBER
         BEZ      %321              ABSOLUTE CONTROL SECTION
         AW,XT1   CSBASE            DECLARATION NUMBER FOR 1ST CS
%321     RES      0
         STW,XT1  DDNUM             CONTROL SECTION DECLARATION NUMBER
         STW,RL   LARG
         AND,RL   =OFFSETFLD
         STW,RL   ACONVAL           OFFSET
         B        %341
%330     RES      0
*   HERE FOR SPECIAL EXTERNAL
         LW,XT    *ARG
         LV,RL    ADDFLD
         AND,RL   XT
         STW,RL   DDNUM             EXTERNAL DECLARATION NUMBER
%331     RES      0
         LI,RL    0
         STW,RL   DDASV             SET FLAG TO 'ADD'
         B        %360
%340     RES      0
*   HERE FOR LOCAL FORWARD, EXTERNAL, LOCAL FORWARD AND HOLD, OR
*     ONE WORD ADDRESS
         LW,XT    *ARG
         LV,RL    LENGTHFLD
         AND,RL   XT
         STW,RL   DDNUM             DECLARATION NUMBER
         LW,RL    DD%TYPE
         CV,RL    1WDADDET
         BNE      %341              ITEM IS NOT A ONE WORD ADDRESS
         LW,RL    DDNUM
         BEZ      %341              ABSOLUTE CONTROL SECTION
         AW,RL    CSBASE            DECLARATION NUMBER FOR 1ST C S
         STW,RL   DDNUM             DECLARATION NUMBER
%341     RES      0
         LI,RL    0                 SET FLAG FOR AN 'ADD'
         BFZ,XT   ADFLD,%342        ADDEND FLAG INDICATES ADD
         LI,RL    1                 SET FLAG FOR A 'SUBTRACT'
%342     RES      0
         STW,RL   DDASV             STORE ADD/SUBTRACT FLAG
%360     RES      0
         AND,XT   =ARFLD            GET ADDRESS RESOLUTION
         SHIFT,XT ARLOB,31            AND RIGHT JUSTIFY IT
         STW,XT   DDRS
         MTB,0    GENEXIT
         BNEZ     %382              PROCESSING LOAD DEFINITIONS
         LW,XT    HVLENGTH
         BNEZ     %361              LOAD HAS ALREADY BEEN OUTPUT
         CALL     LOAD              OUTPUT LOAD CONTROL
         MTW,0    DDREL
         BNEZ     %302              RELOCATABLE LOAD WAS OUTPUT
%361     RES      0
         CALL     DFNFLD            OUTPUT DEFINE FIELD
         CALL     ASV               OUTPUT ADD/SUBTRACT VALUE
%362     RES      0
         CALL     EXPEND            OUTPUT EXPRESSION END
         B        %302
%350     RES      0
*   HERE FOR SUM
         LV,XT1   LENGTHFLD
         LS,XT1   *ARG              GET LENGTH FROM CONTROL WORD
         MTW,1    ARG
         LW,XT    *ARG              GET WORD FOLLOWING CONTROL WORD
         STW,XT   ACONVAL           OFFSET
         CV,XT1   LNGTH3
         BNE      %351              NOT A SIMPLE SUM
*   HERE FOR SIMPLE SUM
         MTW,1    ARG
         LW,XT1   *ARG              GET WORD FOLLOWING SVAL
         CALL     TYPE              GET IT'S TYPE
         B        %340
%351     RES      0
*   HERE FOR COMPLEX SUMS
         AI,XT1   -2                DECREASE LENGTH BY TWO
         STW,XT1  LARG              SAVE NUMBER OF ENTRIES IN SUM
         MTB,0    GENEXIT
         BNEZ     %381              PROCESSING LOADER DEFINITIONS
         MTW,0    HVLENGTH
         BNEZ     %352
         CALL     LOADABS
%352     RES      0
         CALL     DFNFLD
%370     RES      0
         MTW,1    ARG               POINT TO NEXT WORD OF SUM ENTRY
         LW,XT1   *ARG              LOAD CONTROL WORD
         LI,RL    0                 SET FLAG FOR AN 'ADD'
         BFZ,XT1  ADFLD,%371        ADDEND FLAG INDICATES ADD
         LI,RL    1                 SET FLAG FOR A 'SUBTRACT'
%371     RES      0
         STW,RL   DDASV             STORE ADD/SUBTRACT FLAG
         LV,RL    LENGTHFLD
         AND,RL   XT1
         STW,RL   DDNUM             DECLARATION/FORWARD REFERENCE NUMBER
         LV,RL    ARFLD
         AND,RL   XT1
         SHIFT,RL ARLOB,31
         STW,RL   DDRS              ADDRESS RESOLUTION
         CALL     TYPE              GET ITEM'S TYPE
         LW,XT    DD%TYPE
         CV,XT    1WDADDET
         BNE      %380              ITEM IS NOT A ONE WORD ADDRESS
         LW,XT    DDNUM
         BEZ      %380              CONTROL SECTION ZERO
         AW,XT    CSBASE            DECLARATION NUMBER FOR 1ST CONTROL
         STW,XT   DDNUM               SECTION
%380     RES      0
         CALL     ASV
         MTW,-1   LARG              DECREMENT NUMBER OF ENTRIES
         BGZ      %370              CONTINUE UNTIL ALL ARE PROCESSED
         MTB,0    GENEXIT
         BNEZ     %392              PROCESSING LOADER DEFINITIONS
         B        %362
%381     RES      0
         CALL     ACON              OUTPUT AN 'ADD CONSTANT'
         B        %370
%382     RES      0
         LW,RL    LARG              BRANCH IF THERE IS NO ADDRESS TO
         BEZ      %383                CONVERT TO BYTE RESOLUTION
         AND,RL   =LOBFLD+OFFSETFLD
         SCS,RL   0,XT              CONVERT ADDRESS FROM INTRINSIC
         STW,RL   ACONVAL             RESOLUTION TO BYTE RESOLUTION
         LI,RL    0
         STW,RL   DDRS              SET RESOLUTION TO BYTE
%383     RES      0
         LW,XT    ACONVAL
         CALL     ACON              OUTPUT 'ADD CONSTANT'
         CALL     ASV               OUTPUT 'ADD/SUBTRACT VALUE'
         B        %392
%390     RES      0
*   HERE FOR UNDEFINED ITEMS        (LOAD DEFINITIONS ONLY)
         BAL,ER   UERR              UNDEFINED ERROR
         LW,XT    ACONVAL
%391     RES      0
         CALL     ACON              OUTPUT AN 'ADD CONSTANT'
%392     RES      0
         CALL     EXPEND            OUTPUT 'EXPRESSION END'
         B        *GENEXIT
%400     RES      0
*   HERE FOR SPECIAL INTEGER        (LOAD DEFINITIONS ONLY)
         LW,XT    *ARG
         AND,XT   =VALFLD           GET INTEGER VALUE
         B        %391
%410     RES      0
*   HERE FOR INTEGER, DECIMAL, FX, FS, AND DPI TYPE CONSTANTS
*                                   (LOAD DEFINITIONS ONLY)
         LW,XT    *ARG
         AND,XT   =LENGTHFLD
         CV,XT    LNGTH2
         BE       %421              CONSTANT IS 32 BITS OR LESS
%420     RES      0
         BAL,ER   TERR              TRUNCATION ERROR
%421     RES      0
         MTW,1    ARG               POINT TO WORD FOLLOWING CONTROL WORD
         LW,XT    *ARG              LOAD VALUE OF CONSTANT
         B        %391
%430     RES      0
*   HERE FOR TEXT CONSTANTS         (LOAD DEFINITIONS ONLY)
         MTW,1    ARG               POINT TO WORD FOLLOWING CONTROL WORD
         LB,XT    *ARG              GET CHARACTER COUNT
         BEZ      %392              NO CHARACTERS
         CI,XT    4
         BLE      %431              FOUR OR LESS CHARACTERS
         BAL,ER   TERR              TRUNCATION ERROR
         LI,XT    4                 USE ONLY FIRST FOUR CHARACTERS
%431     RES      0
         LI,XT1   3
%432     RES      0
         LB,RL    *ARG,XT           MOVE TEXT CHARACTERS (UP TO 4)
         STB,RL   ACONVAL,XT1         TO ACONVAL
         AI,XT1   -1
         BDR,XT   %432
         B        %391-1
*
*   TABLE OF OFFSETS TO ITEM TYPE PROCESSOR FOR SECOND PASS
*
TYP2     COM,8    AF-TYPEBSE2
TYPETBL2 RES      0
         TYP2     %390              UNDEFINED
         TYP2     %310              SPECIAL ADDRESS
         TYP2     %330              SPECIAL EXTERNAL
         TYP2     %320              ADDRESS
         TYP2     %350              SUM
         TYP2     %340              EXTERNAL
         TYP2     %340              LOCAL FORWARD
         TYP2     %340              LOCAL FORWARD AND HOLD
         TYP2     %340              ONE WORD ADDRESS
         TYP2     %400              SPECIAL INTEGER
         TYP2     %392              BLANK
         TYP2     %410              INTEGER
         TYP2     %410              DECIMAL
         TYP2     %430              TEXT
         TYP2     %410              FX
         TYP2     %410              FS
         TYP2     %420              FL
         TYP2     %410              DPI
         TYP2     %390              LIST
         TYP2     %390              FUNCTION
         BOUND    4
         PAGE
*
*   G E T C S A D D
*        OBTAINS THE TABLE ADDRESS OF THE SPECIFIED CONTROL SECTION
*          NUMBER.
*
*        INPUT:   XT2 CONTAINS THE CONTROL SECTION NUMBER.
*
*        OUTPUT:  XT2 CONTAINS THE ADDRESS OF THE CONTROL SECTION TABLE
*                   FOR THIS ENTRY.
*
*        CALL:    BAL,RL  GETCSADD
*
*        USES REGISTERS
*                 RL
*                 XT2
*                 XT1
*
GETCSADD RES      0
         LW,XT1   XT2
         MI,XT1   CSTBLSIZE         OFFSET TO CONTROL SECTION TABLE ENTRY
         STW,XT1  XT2
         CI,XT2   16*CSTBLSIZE
         IF,GE                      DOIF CS # > 15
         AI,XT2   -16*CSTBLSIZE
         AW,XT2   CS16LOC           ADD BASE ADDRESS OF CS # 16
         ELS                        CS # IN RANGE 0-15
         AW,XT2   CS0LOC            ADD BASE ADDRESS OF CS # 0
         FI
         EXIT
         PAGE
*
*   H I L I M I T
*        THIS ROUTINE CHECKS FOR TABLE OVERLAP AT THE HIGH END OF CORE.
*          IF THE END OF THE LOCAL SYMBOL TABLE OVERLAPS THE END OF THE
*          EXPRESSION VALUE TABLE, KLINE IS MOVED TO A LOWER CORE
*          ADDRESS.  IF THIS CAUSES THE END OF THE EXPRESSION CONTROL
*          TABLE TO OVERLAP THE END OF THE NON-LOCAL TABLES, XAP WILL
*          ABORT.  OTHERWISE, KLINE WILL BE ADJUSTED SUCH THAT AN EQUAL
*          AMOUNT OF SPACE IS AVAILABLE TO TABLES CONVERGING AT BOTH
*          ENDS OF KLINE.
*
*        INPUT:   NXTSYMT CONTAINS THE ADDRESS OF THE NEXT AVAILABLE
*                   GLOBAL SYMBOL TABLE WORD
*                 NXTLOCAL CONTAINS THE ADDRESS OF THE NEXT AVAILABLE
*                   LOCAL SYMBOL TABLE WORD
*                 ECT CONTAINS AN OFFSET FROM KLINE TO THE NEXT
*                   EXPRESSION CONTROL TABLE WORD
*                 EVT CONTAINS AN OFFSET FROM KLINE TO THE NEXT
*                   EXPRESSION VALUE TABLE WORD
*
*        OUTPUT:  THE AMOUNT OF ADJUSTMENT TO KLINE IS IN REGISTER XT1
*
*        CALL:    BAL,RL  HILIMIT
*
*        USES REGISTERS
*                 XT
*                 XT1
*                 RL
*                 ER
         PAGE
*       *         ORIGIN OF LOCAL SYMBOL TABLE AREA        HIGH CORE
*       *
*     * * *
*      * *
*       *         END OF LOCAL SYMBOL TABLE AREA
*
*
*       *         END OF EXPRESSION VALUE TABLE
*      * *
*     * * *
*       *
*       *         KLINE
*       *
*     * * *
*      * *
*       *         END OF EXPRESSION CONTROL TABLE
*
*
*       *         END OF NON-LOCAL TABLE AREA
*      * *
*     * * *
*       *
*       *         ORIGIN OF NON-LOCAL TABLE AREA           LOW CORE
HILIMIT  RES      0
         LW,XT    KLINE             IF THE LOCAL SYMBOL TABLE DOES NOT
         AW,XT    EVT,LVL             OVERLAP THE EXPRESSION VALUE
         SW,XT    NXTLOCAL            TABLE, KLINE DOES NOT NEED TO BE
         EXIT,LE  RL                  ADJUSTED TO A LOWER CORE ADDRESS
HILIMIT4 RES      0
         ABORT    ABORT1            MEMORY HAS BEEN DEPLETED
         PAGE
*
*   L O A D
*        THIS SUBROUTINE OUTPUTS A 'LOAD' CONTROL BYTE TO THE OBJECT
*          FILE. THE 'LOAD' BYTE IS FOLLOWED BY THE CONSTANT TO BE
*          LOADED. IF THE CONSTANT IS OTHER THAN 4 BYTES, IT IS
*          GENERATED WITH A 'LOAD ABSOLUTE' CONTROL. IF THE CONSTANT
*          IS 4 BYTES IN LENGTH, IT WILL BE LOADED WITH ONE OF THE
*          'LOAD RELOCATABLE' CONTROLS IF THE FOLLOWING CONDITIONS
*          ARE MET:
*                1 THE LOAD LOCATION COUNTER (%%) IS ON A WORD BOUNDARY,
*                2 THE VALUE HAS A POSITIVE RELOCATION, AND
*                3 THE VALUE IS AN ADDRESS OR SPECIAL ADDRESS, AND ITS
*                    RESOLUTION IS BYTE       AND FIELD LENGTH IS GE 19
*                      OR RESO  IS HALFWORD   AND FIELD LENGTH IS GE 18
*                      OR RESO  IS WORD       AND FIELD LENGTH IS GE 17
*                      OR RESO  IS DOUBLEWORD AND FIELD LENGTH IS GE 16
*                4 OR THE VALUE IS A LOCAL FORWARD, EXTERNAL, OR SPECIAL
*                    EXTERNAL, AND ITS
*                    RESOLUTION IS BYTE       AND FIELD LENGTH IS = 19
*                      OR RESO  IS HALFWORD   AND FIELD LENGTH IS = 18
*                      OR RESO  IS WORD       AND FIELD LENGTH IS = 17
*                      OR RESO  IS DOUBLEWORD AND FIELD LENGTH IS = 16
*          IF, IN ADDITION, THE FOLLOWING CONDITIONS ARE MET, THE
*          CONSTANT WILL BE GENERATED VIA 'LOAD RELOCATABLE SHORT'
*          RATHER THAN 'LOAD RELOCATABLE LONG':
*                1 INTRINSIC RESOLUTION OF VALUE IS 'WORD', AND
*                2 THE DECLARATION OR FORWARD REFERENCE NUMBER IS
*                    LE X'3F' .
*          OTHERWISE, THE CONSTANT WILL BE LOADED VIA 'LOAD ABSOLUTE'
*          CONTROL.
*
*        INPUT:   NOBYTES CONTAINS THE NUMBER OF BYTES OF VALUE
*                 DDASV INDICATES RELOCATION (0=POSITIVE, 1=NEGATIVE)
*                 DDRS CONTAINS THE INTRINSIC RESOLUTION
*                 DD%TYPE CONTAINS THE ITEM TYPE
*                 FLENGTH CONTAINS THE FIELD SIZE
*                 DDOFF CONTAINS THE ADDRESS OFFSET
*                 DDNUM CONTAINS THE DECLARATION OR FORWARD REFERENCE
*                   NUMBER
*                 DDLRVAL CONTAINS THE LOAD LOCATION COUNTER VALUE
*
*        OUTPUT:  DDREL INDICATES THE TYPE OF LOAD CONTROL OUTPUT
*                   0=ABSOLUTE , 1=RELOCATABLE
*                 CODE CONTAINS THE RELOCATION CODE
*                   'X'  EXTERNAL
*                   'F'  FORWARD REFERENCE
*                   ' '  RELOCATABLE ADDRESS
*                   'A'  ABSOLUTE
*
*        CALL:    BAL,RL  LOAD
*
*        USES REGISTERS
*                 XT
*                 XT1
*                 RL
*                 NBYTES
*
LOAD     RES      0
         LW,XT    NOBYTES
         CI,XT    4
         BNE      LOAD2             NOT A FOUR BYTE VALUE, LOAD ABS
         LI,XT    3
         AND,XT   DDLRVAL
         BNEZ     LOAD2             %% NOT AT A WORD BOUNDRY, LOAD ABS
         MTW,0    DDASV
         BNEZ     LOAD2             NOT POSITIVE RELOCATION, LOAD ABS
         LW,XT    FLENGTH
         AW,XT    DDRS
         CI,XT    19
         BE       LOAD3             LOAD RELOCATABLE
         BL       LOAD2             LOAD ABSOLUTE
         LW,XT    DD%TYPE
         CV,XT    SPADDRET
         BE       LOAD1             TYPE IS SPECIAL ADDRESS, LOAD RELO
         CV,XT    ADDRET
         BNE      LOAD2             TYPE IS NOT ADDRESS, LOAD ABSOLUTE
LOAD1    RES      0
         LI,XT    X'F0000'
         AND,XT   ACONVAL
         BEZ      LOAD3             LOAD RELOCATABLE
LOAD2    RES      0
         LI,XT    0
         STW,XT   DDREL             FLAG ABSOLUTE LOAD
         B        LOADABS           LOAD ABSOLUTE AND RETURN
LOAD3    RES      0
         LI,XT    1
         STW,XT   DDREL             FLAG RELOCATABLE LOAD
         LW,XT    DD%TYPE
         SHIFT,XT ETLOB,31          SET CODE TO  'X'   EXTERNAL
         LB,XT    CODEWD,XT                      'F'   LOCAL FORWARD
         STW,XT   CODE                OR         ' '   ADDRESS
         LW,XT    DDRS
         CI,XT    WDRS
         BNE      LOAD5             LOAD RELOCATABLE LONG
         LW,XT    DDNUM
         CI,XT    X'3F'
         BG       LOAD5             LOAD RELOCATABLE LONG
*   HERE TO LOAD  RELOCATABLE SHORT
         LI,NBYTES  5               NUMBER OF ITEMS TO OUTPUT
         AI,XT    X'80'             CODE FOR 'LOAD RELOCATABLE SHORT'
         LW,XT1   DD%TYPE
         CV,XT1   LCLFWDET
         BL       LOAD8             NOT A LOCAL FWD
         CV,XT1   LFWDHET
         BG       LOAD8               OR LOCAL FWD & HOLD
         AI,XT    X'40'             SPECIFY FORWARD REFERENCE
LOAD8    RES      0
         LI,XT1   BA(ACONVAL)+3     BA OF 1ST ITEM TO OUTPUT
LOAD4    RES      0
         STW,XT   ACONVAL
         B        BEDIT%SCE         OUTPUT 4 BYTES & ERROR, IF SOCW
*
LOAD5    RES      0
*   HERE TO LOAD RELOCATABLE LONG
         LW,XT    DDRS              LOAD RESOLUTION
         AI,XT    X'50'             CODE FOR 'LOAD RELOCATABLE LONG'
         LW,XT1   DD%TYPE
         CV,XT1   LCLFWDET
         BL       LOAD6             ITEM IS NOT A LOCAL FORWARD
         CV,XT1   LFWDHET
         BG       LOAD6               OR A LOCAL FORWARD AND HOLD
         AI,XT    4                 SPECIFY FORWARD REFERENCE
LOAD6    RES      0
         LW,XT1   DDNUM
         CI,XT1   X'FF'
         BG       LOAD7             DECLARATION NUMBER IS TWO BYTES
*   HERE TO OUTPUT TWO BYTE 'LOAD RELOCATABLE LONG' CODE
         AI,XT    8                 SPECIFY A 1 BYTE DECLARATION NUMBER
         SLS,XT   8                 MAKE ROOM FOR 1 BYTE DECLARATION #
         AW,XT    DDNUM
         LI,XT1   BA(ACONVAL)+2     BYTE ADDRESS OF ITEMS TO OUTPUT
         LI,NBYTES  6               NUMBER OF BYTES TO OUTPUT
         B        LOAD4
LOAD7    RES      0
*   HERE TO OUTPUT THREE BYTE 'LOAD RELOCATABLE LONG' CODE
         SLS,XT   16                MAKE ROOM FOR 2 BYTE DECLARATION #
         AW,XT    DDNUM
         LI,XT1   BA(ACONVAL)+1     BYTE ADDRESS OF 1ST ITEM TO OUTPUT
         LI,NBYTES  7               NUMBER OF BYTES TO OUTPUT
         B        LOAD4
CODEWD   RES      0
         DATA,1   'Z',' ','X',' '   TABLE OF RELOCATION CODES FOR EDIT
         DATA,1   'Z','X','F','F'
         DATA,1   'S','Z','Z','Z'
         PAGE
*
*   L O A D A B S
*        THIS SUBROUTINE OUTPUTS A LOAD ABSOLUTE ITEM TO THE OBJECT
*          MODULE.
*
*        INPUT:   THE NUMBER OF BYTES IN THE ITEM IS CONTAINED IN
*                   NOBYTES.
*                 THE VALUE IS CONTAINED IN UP TO FOUR WORDS STARTING
*                   AT HEXVAL.
*
*        CALL:    BAL,RL  LOADABS
*
*        USES REGISTERS
*                 XT
*                 XT1
*                 NBYTES
*                 RL
*
LOADABS  RES      0
         LI,XT    X'F'              MASK
         AND,XT   NOBYTES           NUMBER OF BYTES OF ABSOLUTE DATA
         AI,XT    X'40'             LOADER CONTROL FOR LOAD ABS
         STW,XT   HEXVAL-1
         LW,NBYTES NOBYTES
         AI,NBYTES  1               NUMBER OF BYTES TO OUTPUT
         LI,XT1   BA(HEXVAL)-1      BYTE ADDRESS OF 1ST BYTE TO OUTPUT
         B        BEDIT%SC          IF SOCW, OMIT CONTROL BYTE
         PAGE
*   O R I G I N
*        THIS SUBROUTINE OUTPUTS AN 'ORIGIN' CONTROL FOLLOWED BY A LOAD
*          ADDRESS TO THE OBJECT FILE IF:
*            1. THE LOAD LOCATION COUNTER HAS AN OFFSET WHICH DIFFERS
*                 FROM THE LAST LOAD OFFSET,  OR
*            2. THE LOAD LOCATION COUNTER IS IN A DIFFERENT CONTROL
*                 SECTION THAN THE LAST 'LOAD'.
*
*        INPUT:   DDLRVAL CONTAINS THE CURRENT LOAD LOCATION COUNTER
*                 LASTVAL CONTAINS THE PREVIOUS LOAD LOCATION COUNTER
*                 DDLRCS CONTAINS THE CURRENT LOAD LOCATION CONTER
*                   CONTROL SECTION.
*                 LASTCS CONTAINS THE PREVIOUS LOAD LOCATION COUNTER
*                   CONTROL SECTION.
*
*        CALL:    BAL,RL  ORIGIN
*
*        USES REGISTERS
*                 XT
*                 XT1
*                 RL
*                 NBYTES
*
ORIGIN   RES      0
         LW,XT    DDLRVAL
         CW,XT    LASTVAL           IF LOCATION COUNTER IS NOT IN SYNC
         IF,EQ                      IN SYNC -- CHECK CONTROL SECTION
         LW,XT    DDLRCS
         CW,XT    LASTCS
         EXIT,EQ  RL                IF CONTROL SECTION HAS NOT CHANGED
*
         FI
         MTW,0    SOCW%FLG
         EXIT,NZ                    FORGET ORIGIN UNDER SOCW CONTROL
*
         STW,RL   ORIGXIT
         LI,XT1   BA(ORIGINCD)      BYTE ADDRESS OF LOADER CODE
         LI,NBYTES 1                NUMBER OF BYTES TO OUTPUT
         CALL     BEDIT             OUTPUT LOADER CODE FOR ORIGIN
         LW,XT    DDLRVAL
         STW,XT   LASTVAL           UPDATE LASTVAL
         CALL     ACON              ADD OFFSET TO EXPRESSION
         LW,XT    DDLRCS
         STW,XT   LASTCS            UPDATE LASTCS
         BEZ      ORIGIN3           ABSOLUTE CONTROL SECTION
         AW,XT    CSBASE
ORIGIN3  RES      0
         STW,XT   DDNUM             DECLARATION NUMBER
         LI,XT    0
         STW,XT   DDRS              SET TO BYTE RESOLUTION
         STW,XT   DDASV             SET TO ADD
         LV,XT    ADDRET
         STW,XT   DD%TYPE           SET ITEM TYPE TO ADDRESS
         CALL     ASV               ADD DECLARATION NUMBER TO EXPRESSION
         CALL     EXPEND            OUTPUT EXPRESSION END
         B        *ORIGXIT
         PAGE
*
*  P R I N T
*        OUTPUT A LINE ON THE LO FILE. IF THERE'S AN ERROR ON THE
*          LINE, IT'S OUTPUT ON 'DO' UNCONDITIONALLY. IT IS ALSO
*          OUTPUT ON 'LO' IF 'LO' IS NOT THE SAME AS 'DO'.
*          IF THERE'S NO ERROR, THE LINE IS OUTPUT ON 'LO' ONLY
*          IF VARIABLE NOLIST IS NON-ZERO.
*
*    THIS ROUTINE TAKES CARE OF PRINTING THE TITLE LINE WHEN
*          APPROPRIATE, INSERTING LINE NUMBER INTO THE LINE, ERROR
*          LINE NUMBER WHEN REQUIRED, AND THE SOURCE LINE IF THERE
*          IS ONE.
*
PRINTC1  RES      0
         MTW,0    PROCREF
         BEZ      PRINTC            PROCESSING AT THE SOURCE LEVEL
         EXIT     RL                DON'T PRINT WITHIN A PROC
PRINTC2  RES      0
* THIS ENTRY PRINTS IF EITHER AN ERROR IS SET OR THERE IS A SOURCE LINE
         MTH,0    ERRTRIG                                      /25342/*D-DGCOM
         BNEZ     PRINT             PRINT IF ERRTRIG IS SET
PRINTC   RES      0
*   THIS ENTRY PRINTS IF THERE IS A SOURCE LINE
         LW,XT    LSTBF+4
         AW,XT    SOURCE
         CW,XT    BLANC             DON'T PRINT THIS LINE IF IT
         EXIT,EQ  RL                  HAS ALREADY BEEN PRINTED
PRINT    RES      0
*   THIS ENTRY UNCONDITIONALLY PRINTS DURING THE GENERATION PASS
         LW,XT    PASS              EXIT IN THE DEFINITION PASS
         EXIT,EQ  RL
         STW,RL   PRINTXIT          SAVE EXIT
         LW,XT    SKIPTRIG
         BEZ      PRINT3
         LW,XT    =' *S*'
         STW,XT   LSTBF+8
* IF SOURCE IS NON-ZERO, A SOURCE LINE IS TO BE OUTPUT
PRINT3   RES      0
         LW,XT    SOURCE
         BEZ      PRINT15
         LW,XT    SOURCEX           INDEX TO SOURCE BUFFER
         LI,LBX   37                INDEX TO LSTBF
         B        PRINT6
PRINT4   RES      0
         STB,XT1  LSTBF,LBX         SOURCE CHAR TO LIST BUFFER
         AI,LBX   1                 BUMP LIST BUFFER INDEX
PRINT6   RES      0
         BIR,XT   PRINT8            BUMP INDEX, TEST, & BRANCH
*
         LI,IOADD X3BUF
         BAL,IORL READX3            READ NEXT SOURCE RECORD
         LI,XT    -BYX3SIZE         INITIALIZE SOURCE INDEX
PRINT8   RES      0
         LB,XT1   X3BUF+WDX3SIZE,XT      GET NEXT SOURCE CHARACTER
         CI,XT1   X'3F'
         BG       PRINT4            NOT A CONTROL BYTE
         CI,XT1   X'20'
         BL       PRINT4            NOT A CONTROL BYTE
         BE       PRINT10           END OF LINE
         AI,XT1   -X'20'            REPEAT COUNT
         BIR,XT   PRINT9            BUMP INDEX, TEST, AND BRANCH
*
         LI,IOADD X3BUF
         BAL,IORL READX3            READ NEXT SOURCE RECORD
         LI,XT    -BYX3SIZE         INITIALIZE SOURCE INDEX
PRINT9   RES      0
         LB,T1    X3BUF+WDX3SIZE,XT      GET NEXT SOURCE CHARACTER
         CI,T1    X'40'
         BE       PRINT7
PRINT5   RES      0
         STB,T1   LSTBF,LBX         STORE SOURCE
         AI,LBX   1                   CHARACTER,
         BDR,XT1  PRINT5              'REPEAT COUNT' TIMES
         B        PRINT6
PRINT7   RES      0
         AW,LBX   XT1               ADVANCE LSTBF INDEX
         B        PRINT6
PRINT10  RES      0
         STW,XT   SOURCEX           RESTORE INDEX TO SOURCE BUFFER
* EDIT THE LINE NUMBER INTO THE LISTING
         LI,LBX   8
         LI,XT    ' *'
         LW,XT1   SUBLINE           IF SUBLINE NE 0, EDIT IT
         BNEZ     PRINT11             FOLLOWED BY AN '*'
         LW,XT1   MAJLINE           EDIT MAJOR LINE NUMBER,
         LH,XT    RD%STD              FOLLOWED BY A BLANK IF AT
         AW,XT    SYSLEVEL            SOURCE LEVEL, OR AN
         BEZ      PRINT12             'A' THROUGH 'H' FOR
         AI,XT    ' A'-1              THE SYSTEM LEVEL
PRINT11  RES      0
         STH,XT   LSTBF+2
PRINT12  RES      0
         CALL     DEDIT             EDIT LINE NUMBER INTO LISTING
PRINT15  RES      0
         LH,XT    ERRTRIG           ARE THERE ERRORS ON LINE   /25342/*D-DGCOM
         IF,EZ                        NO                       /25342/*D-DGCOM
         MTW,0    ERRTRIG           WAS CALL FROM 'ERROR' DIR  /25342/*D-DGCOM
         IF,NZ                                                 /25342/*D-DGCOM
         MTW,0    PROCREF           DON'T PRINT SOURCE 'ERROR' /25342/*D-DGCOM
         BNEZ     PRINT14                                      /25342/*D-DGCOM
*                                                              /25342/*D-DGCOM
         FI                                                    /25342/*D-DGCOM
         B        WRILINE                                      /25342/*D-DGCOM
*                                                              /25342/*D-DGCOM
         FI                                                    /25342/*D-DGCOM
         BLZ      PRINT13           FORCE COMMENTARY OUT ON 'LO' ONLY
         LW,XT1   MAJERRLN
         IF,LZ                      IS FIRST                          *D-DGCOM
         LI,NBYTES  6               'FIRST' ERROR MESSAGE
         LI,XT1   BA(FIRSTMSG)
         LI,LBX   120
         CALL     AEDIT
         ELS                                                          *D-DGCOM
         AND,XT1  L(MAJERRFLD)      GET LINE #, ONLY                  *D-DGCOM
         LI,LBX   125
         CALL     DEDIT             STORE MAJOR ERROR LINE NUMBER
         LI,XT    '<'
         STB,XT   LSTBF,LBX
         LI,LBX   126
         LW,XT1   SUBERRLN          IS SUB-LINE OF LAST ERROR LINE = 0
         IF,NZ                      DOIF NOT                          *D-DGCOM
         LI,XT    '.'               DECIMAL POINT TO SEPARATE LINE NOS.
         STB,XT   LSTBF,LBX
         CALL     CTCHRS            COUNT CHARACTERS IN SUB-LINE
         AW,LBX   XT
         STW,LBX  SUBERRLN          SAVE IN TEMP                      *D-DGCOM
         CALL     DEDIT             STORE ERROR SUB-LINE NUMBER
         LW,LBX   SUBERRLN                                            *D-DGCOM
         AI,LBX   1
         FI                                                           *D-DGCOM
         LB,XT    MAJERRLN          SEE IF LAST ERROR WAS             *D-DGCOM
         IF,NZ                        WITHIN SYSTEM.                  *D-DGCOM
         AI,XT    'A'-1             'TWAS                             *D-DGCOM
         STB,XT   LSTBF,LBX         STORE LEVEL LETTER                *D-DGCOM
         AI,LBX   +1                                                  *D-DGCOM
         FI                                                           *D-DGCOM
         FI                                                           *D-DGCOM
         LI,XT    '>'
         STB,XT   LSTBF,LBX
* BUMP ERROR LINE STATISTICS
         MTW,1    NERRS             NUMBER OF LINES WITH ERRORS
         LW,XT    MAJLINE           SAVE THE LAST LINE NO. THAT
         STW,XT   MAJERRLN            CONTAINS AN ERROR
         LH,XT    RD%STD                                              *D-DGCOM
         AW,XT    SYSLEVEL          SAVE SYSTEM LEVEL                 *D-DGCOM
         STB,XT   MAJERRLN                                            *D-DGCOM
         LW,XT    SUBLINE
         STW,XT   SUBERRLN
* WRITE THE LINE ON THE 'DO' DEVICE
*                                                              /25342/*D-DGCOM
PRINT14  RES      0                                            /25342/*D-DGCOM
         LI,IOADD LSTBF
         LI,IOSIZE 132
         BAL,IORL WRITEDO
PRINT13  RES      0
         MTW,0    LO%FLAG           OUTPUT ON 'LO' DEVICE
         BNEZ     PRINT21             IF LO WAS REQUESTED
WRILINE  RES      0
         LW,XT    NOLIST
         BNEZ     PRINTEND
         MTW,0    PSRTRIG
         BEZ      PRINT22           PRINT SKIPPED RECORDS
*
         MTW,0    SKIPTRIG
         BNEZ     PRINTEND          DONT PRINT SKIPPED RECORDS
*
PRINT22  RES      0
         LW,XT    SOURCE            BRANCH IF THERE IS
         BNEZ     PRINT21             SOURCE FOR THIS LINE.
*
         LW,XT    SOURCEONLY        DON'T PRINT LINES WITH NO
         BNEZ     PRINTEND            SOURCE IF FLAG IS SET.
*
PRINT21  LI,IOADD  LSTBF
         LI,IOSIZE 132
         BAL,IORL DGWRITELO
PRINTEND RES      0
         LI,XT    0
         STW,XT   SOURCE            RESET SOURCE
         STW,XT   ERRTRIG           RESET ERROR TRIGGER
         STW,XT   SKIPTRIG          RESET SKIP TRIGGER
         CALL     CLRLSTBF          BLANKS TO LISTING BUFFER
         B        *PRINTXIT
FIRSTMSG TEXT     '<FIRST'
         PAGE
*
*    T Y P E
*        THIS ROUTINE RETURNS THE TYPE OF A SYMBOL TABLE ENTRY
*          IN DD%TYPE.  TYPE INFORMATION IS IN THE ET FIELD OF
*          DD%TYPE.
*
TYPE     RES      0
         MTW,0    XT1               IS ENTRY SPECIAL ADDR OR SAALL INT
         BGEZ     TYPE5             NO
         LV,XT2   UGLBLET           VALUE FOR UNDEFINED ITEM
         BFZ,XT1,1  DEFFLD,TYPEEND  BRANCH IF ITEM IS UNDEFINED
         LV,XT2   SPINTET
         CV,XT1   SPINTFLD          YSE, IS IT A SMALL INTEGER
         BANZ     TYPEEND           BRANCH IF YES
         LV,XT2   SPADDRET
         CV,XT1   REFORSREF         NO, IS ENTRY A SPECIAL EXTERNAL
         BAZ      TYPEEND           NO
         LV,XT2   SPEXTET
         B        TYPEEND
TYPE5    STW,XT1  XT2               GET TYPE FIELD
         AND,XT2  L(TYPEFLD)
         SHIFT,XT2 TYPELOB,31
         LB,XT2   TYPE%JUMP,XT2
         B        TYPE%BASE,XT2     BRANCH TO APPROPRIATE TYPE
TYPE%JUMP  RES    0
         BYTE,TYPE%BASE  TYPEILL    T=0
         BYTE     TYPELST           LIST
         BYTE     TYPECON           CONSTANT
         BYTE     TYPESYM           SYMBOL
         BYTE     TYPEBLNK          BLANK
         BYTE     TYPEILL           COMMAND
         BYTE     TYPEFUN           FUNCTION
         BYTE     TYPEILL           T=7
         BOUND    4
TYPE%BASE  RES    0
TYPEFUN  RES      0
         LV,XT2   FUNCET
         B        TYPEEND
TYPEBLNK LV,XT2   BLANKET
         B        TYPEEND
TYPELST  LV,XT2   LISTET
         B        TYPEEND
TYPECON  STW,XT1  XT2
         AND,XT2  L(CTYPEFLD)       GET CONSTANT TYPE
         AW,XT2   L(11**(31-CTYPELOB))  CONVERT TO ET VALUE
         B        TYPESYM1
TYPESYM  STW,XT1  XT2
         AND,XT2  L(STYPEFLD)       GET SYMBOL TYPE
         AW,XT2   L(3**(31-STYPELOB))  CONVERT TO ET VALUE
TYPESYM1 RES      0
         SLS,XT2  STYPELOB-ETLOB    MOVE TO ET FIELD
TYPEEND  RES      0
         STW,XT2  DD%TYPE           STORE ITEM TYPE
         B        *RL               RETURN
TYPEILL  RES      0
         ABORT    ABORT2            BAD ENCODED TEXT
         PAGE
*
*  X E D I T
*        CONVERT A NUMBER TO HEXADECIMAL AND STORE IT IN THE
*          LISTING IMAGE.
*
*          INPUT: NUMBER OF DIGITS TO STORE IS IN REG. NBYTES
*                 INDEX TO LEFT-MOST DIGIT TO STORE IS IN REG. LBX
*                 NUMBER IS LEFT-ADJUSTED IN REG XT1
*
*         OUTPUT: XT1 SHIFTED LEFT 4*NBYTES PLACES
*                 LBX IS BUMPED BY NBYTES
*
XEDIT    RES      0
         LI,XT    0                 SHIFT HIGH ORDER HEX DIGIT
         SLD,XT   4                   TO LOW ORDER OF REG XT
         LB,XT    HEXTBL,XT         CONVERT IT TO A HEX CHARACTER
         STB,XT   LSTBF,LBX           AND STORE
         AI,LBX   1                 BUMP INDEX TO LISTING IMAGE
         BDR,NBYTES  XEDIT          COUNT AND RETURN
         EXIT     RL
HEXTBL   RES      0
         TEXT     '0123456789ABCDEF'  TABLE OF HEX CHARACTERS
         END

