ASMB,R,L,C,F
* 
******************************************************* 
* 
*         RELOC. TAPE:  29100-16005 
*         ERS:          29100-16005-1 
*         LISTING:      29100-16005-2 
*         SOURCE TAPE:  29100-18005  REV A
* 
******************************************************* 
* 
      NAM ERROR,7       29100-16005 REV.A 
* 
      ENT ERROR,ERRCD,INERR,SERR
      EXT EXEC,.DIV,.ENTR 
* 
NUM   NOP 
MNEM  NOP 
LUN   NOP 
ADDR  NOP 
* 
ERROR NOP 
      JSB .ENTR 
      DEF NUM 
* 
      LDA LUN,I     SAVE LUN OF DESTINATION DEVICE
      STA DEVIC 
* 
      LDA MPSA      SET MP START
      STA MP
* 
      LDB MNEM,I     GET MNEM LENGTH IN CHARS 
      INB            ADD CHAR FOR ROUNDING
      BRS            MAKE IT WORDS
      CMB,INB        MAKE NEGATIVE
COPY  ISZ MNEM        MOVE POINTER TO TEXT
      LDA MNEM,I     LOAD ASCII WORD
      JSB MPSTR      STORE INTO OUTPUT BUFFER 
      INB,SZB        DONE ? 
      JMP COPY       NO.
* 
      LDB PLUS       SET SIGN OF ERROR
      STB MP,I
      LDB MINUS      GET POSSIBLE - SIGN
      LDA NUM,I      GET ERROR NUMBER 
      STA ERRCD      AND SAVE IT
      SSA 
      STB MP,I       STORE - SIGN 
      SSA 
      CMA,INA      MAKE ERROR NUMBER POSITIVE 
      STA NUM         SAVE ERROR NUMBER 
* 
      ISZ MP         MOVE POINTER 
* 
      LDA BLANK       LOAD 2 BLANKS 
      REP 3 
      JSB MPSTR       STORE BLANKS
      CCA 
      ADA MP          SAVE DECREMENTED POINTER
      STA FAKE
* 
      LDA NUM         LOAD ERROR NUMBER 
LOOP  CLB        SET UP FOR DIVIDE
      JSB .DIV
      DEF D10 
      STA NUM        SAVE RESULT
      SWP            PUT B INTO A 
      IOR BLDIG      MAKE ASCII 
      STA MP,I       SAVE 
* 
      CLB 
      LDA NUM 
      JSB .DIV
      DEF D10 
      STA NUM        SAVE RESULT
      SWP            PUT B INTO A 
      ALF,ALF 
      IOR DIGIT 
      IOR MP,I
      STA FAKE,I        STORE 2 ASCII NUMBERS 
      CCA 
      ADA FAKE          DECREMENT POINTER 
      STA FAKE
* 
      LDA NUM        GET RESULT 
      SZA            DONE ? 
      JMP LOOP       NO.
* 
      LDA IN         GET INSERT 
      JSB MPSTR    STORE IN OUTPUT BUFFER 
      LDA IN+1
      JSB MPSTR 
* 
      LDB XEQT       GET CURRENT ID SEGMENT ADDRESS 
      ADB D12        MOVE TO NAME AREA
      LDA B,I        GET START OF NAME
      JSB MPSTR 
      INB 
      LDA B,I        GET MIDDLE 
      JSB MPSTR      STORE
      INB 
      LDA B,I        GET END OF NAME
      AND H377       MASK OFF LOW CHARACTER 
      IOR B40        ADD A BLANK
      JSB MPSTR      STORE
* 
      LDA AT          LOAD "AT" 
      JSB MPSTR       STORE INTO OUTPUT BUFFER
* 
      LDA ADDR,I      GET CALL ADDRESS
      JSB INDCK       REMOVE INDIRECTS
      STA ADDR        SAVE
* 
      ALF             POSITION
      AND B7          MASK
      IOR BLDIG       MAKE IT A BLANK AND A DIGIT 
      JSB MPSTR       STORE 
* 
      LDB ADDR        GET NUMBER
      BLF             POSITION
      JSB FAKE
* 
      LDB ADDR        GET NUMBER AGAIN
      BLF,BLF 
      RBL,RBL          POSITION 
      JSB FAKE
* 
      LDA MPA          LOAD START OF BUFFER 
      CMA,INA          NEGATE 
      ADA MP           GET BUFFER LENGTH
      STA FAKE         SAVE FOR WRITE 
* 
      JSB EXEC         WRITE BUFFER 
      DEF *+5 
      DEF WCODE 
      DEF DEVIC 
MPA   DEF ERR 
      DEF FAKE
      JMP ERROR,I   RETURN
* 
MPSTR NOP         ROUTINE TO STORE A REG INTO BUFFER
      STA MP,I
      ISZ MP
      JMP MPSTR,I   RETURN
* 
FAKE  NOP        ROUTINE TO CONVERT 6 HIGH BITS IN B REG
*                                            TO DIGITS
      CLA 
      RRL 3      LONG SHIFT 3 (EAU) 
      ALF,RAL 
      RRL 3 
      IOR DIGIT 
      JSB MPSTR   STORE INTO BUFFER 
      JMP FAKE,I   RETURN 
* 
* ENTRY POINT TO SET ERRCD TO DESIRED VALUE 
* 
PTR   NOP 
* 
SERR  NOP           SET ERRCD TO PASSED VALUE 
      JSB .ENTR 
      DEF PTR 
      LDA PTR,I 
      STA ERRCD 
      JMP SERR,I
* 
*ENTRY POINT TO FETCH ERRCD 
* 
VALU  NOP 
* 
INERR NOP 
      JSB .ENTR 
      DEF VALU
      LDA ERRCD 
      STA VALU,I
      JMP INERR,I   RETURN IN THE A REGISTER
* 
* 
INDCK NOP 
      RSS 
      LDA A,I 
      RAL,CLE,SLA,ERA 
      JMP *-2 
      JMP INDCK,I 
* 
WCODE DEC 2 
ERRCD NOP 
DEVIC BSS 1 
IN    ASC 2, IN 
LNGTH NOP 
XEQT  EQU 1717B 
D10   DEC 10
D12   DEC 12
DIGIT OCT 30060 
BLDIG OCT 20060 
PLUS  ASC 1, +
MINUS ASC 1, -
ERR   ASC 3,ERROR 
      BSS 33
MPSA  DEF ERR+3 
MP    NOP 
AT    ASC 1,AT
* 
B7     OCT 7
H377   OCT 177400 
B     EQU 1 
A     EQU 0 
B40   OCT 40       BLANK
BLANK ASC 1,
* 
      END 
                                        