ASMB,R,L,C
* 
*     NAME:   ASMB0 
*     SOURCE: 92067-18070 
*     RELOC:  92067-16070 
*     PGMR:   C.C.H.,S.P.K. 
* 
*     MODIFIED BY VERN MCGEORGE 13JUL79 TO COUNT CS & FMP ERRORS
*  ***************************************************************
*  * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978.  ALL RIGHTS     *
*  * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED,       *
*  * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT*
*  * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY.       *
*  ***************************************************************
* 
      HED * RTE ASMB0 92067-16070 * (C) HEWLETT-PACKARD COMPANY 1978. 
      NAM ASMB0,5,99 92067-16070 REV.1940 790713
      ENT ASMB0 
      SPC 1 
      EXT OPN.C,PRM.C,C.BIN,C.BIA,C.LST,C.SOR 
      EXT WRT.C,C.TTY,RUN.C 
      EXT ?BPKU,?PKUP,?RSTA,?SETM,?SEGM,?ASM1 
      EXT ?MESX,?FLGS,?AFLG 
      EXT ?X,?LWA,?RFLG,?ICSA,?LSTL,?LINC,?PLIN,?ENFL 
      EXT ?NEAU,?HA38,?ASME 
      EXT ?FP,?FPT,?NDSY,?MOVE
      EXT ERRCN 
      EXT ?PASS,?PLCN,?PLEN,?PNTR,?IOBF,?BUFF,?PBUF 
      EXT ?TEMP,?BINF,?FMPE 
* 
*             ****************************
*             * TEMPORARY AND FLAG REGION*
*             ****************************
* 
A     EQU 0 
B     EQU 1 
      SUP           SUPPRESS EXTENDED LISTING 
.1    DEC 1 
.2    DEC 2 
.3    DEC 3 
.4    DEC 4 
.5    DEC 5 
.6    DEC 6 
.14   DEC 14
.54B  OCT 54        , 
BLNK  OCT 40        LOWER BLANK,UPPER 0 (=40B)
TW10  OCT 176000    ADDRESS MASK
.B    OCT 102 
.M201 DEC -201
.M202 DEC -202
NPRG  ASC 2,NPRG
ASMBN OCT 5757
      SPC 2 
LINC  EQU ?LINC 
PLINE EQU ?PLIN 
PASS  EQU ?PASS 
PLCN  EQU ?PLCN     PROGRAM LOCATION COUNTER
PLEN  EQU ?PLEN     LIT LENGTH PASS 1/LIT ORG PASS 2
PNTR  EQU ?PNTR     POINTS AT LAST OR CURRENT CHAR. 
*             * I/O STATEMENT BUFFER *
*             *(INPUXFFER(BUFF) STARTS IN 11TH WORD)* 
IOBF  EQU ?IOBF     50 WRDS+EOS BUFF. 
BUFF  EQU ?BUFF 
PBUF  EQU ?PBUF          START OF PUNCH BUFR(NAM FMT) 
* 
.BUFF DEF BUFF      ADDRESS OF BUFFER 
PRMST ASC 1,]_      PROMPT CHARACTER
      SPC 1 
ASMB0 LDA ?ENFL     FLAG SET? 
      SZA,RSS 
      JMP OPNFL     NO, THEN OPEN FILES 
      JMP XRFSC     YES,SCHEDULE XREF 
OPNFL LDA PRMST     PROMPT CHARACTER
      JSB OPN.C     NO, OPEN SOURCE FILE
      DEF C.SOR     WITH REWIND OPTION
      JMP SRCER     ERROR SEND OUT THE ERROR MESSAGE
      JSB OPN.C     OPEN LIST FILE
      DEF C.LST     LIST FILE FCB 
      JMP LSTER     SEND OUT ERROR MESSAGE
      JMP ASMD6 
* 
SRCER CCB           INDICATE SOURCE FILE
      CPA .M202     SOURCE NAMR NOT FOUND?
      RSS           YES 
      JMP ?FMPE     NO, THEN DISPLAY FMP ERROR
      DLD NPRG      YES, DISPLAY: 
      JSB ?MESX     /ASMB: NPRG 
      JMP ?ASME     EXIT
* 
LSTER CLB 
      JMP ?FMPE     DISPLAY FMP ERROR 
* 
ASMD6 LDA ?ICSA 
      CMA,INA 
      STA ?LSTL 
      CLA 
      STA PASS      SET PASS FLAG=0 (PASS 1)
      JSB ?RSTA     READ AND PRINT CONTROL STATEMENT
* 
*             * TEST FOR 'ASMB' IN FIRST 4 POSITIONS *
* 
      LDA BUFF
      CMA,INA 
      ADA BUFF+1
      CPA ASMBN     =5757B (I.E. =ASMB?)
      JMP COPS      YES 
* 
*             * CONTROL STATEMENT ERROR ROUTINE * 
* 
CSER  ISZ ERRCN     COUNT THE ERROR 
      LDA .CS       'CONTROL' STATEMENT'ERROR 
      LDB .CS+1 
      JSB ?MESX     PRINT MESSAGE 
      JMP ?ASME     ASSEMBLER EXIT
* 
*             * TEST FOR CONTROL OPTIONS (A,B,C,F,L,N,R,T,X,Z) *
* 
COPS  CLA           INITIALIZE
      STA XFOPT       X OR F OPTION 
      JSB PRM.C     GET 
      DEF .5          PARAMETER # 5 
      SZA,RSS       OVER RIDE OPTIONS SPECIFIED?
      JMP COPST     NO PROCESS STANDARD ASMB STMT 
* 
      CLE,ERB        DIVIDE BYTE ADDR BY 2 TO GET WORD ADDR 
      SEZ           WAS IT AN ODD BYTE ADDRESS? 
      CMB,INB       INDICATE STRING STARTS ON RIGHT BYTE
      STB MVSTR     SOURCE ADDRESS OF WORDS 
      LDA .5        CHECK FOR A OR R OPTION IN CS STRING
      STA PNTR      IN THE SOURCE STATEMENT 
CLOOP JSB ?PKUP     PICKUP A CHAR 
      CPA BLNK      DONE? 
      JMP GETOP     YES, GET OVER RIDE OPTIONS
      SZA,RSS       0?
      JMP GETOP     YES, GET OVERRIDE OPTIONS 
      CPA .54B      COMMA?
      RSS           YES 
      JMP CSER      NO, ERROR 
      JSB ?BPKU     SKIP BLANKS 
      ISZ PNTR      SET POINTER TO CHECK NEXT CONTROL OPTION
      CPA .R        R OPTION? 
      JMP RLOC      YES 
      CPA .A        A OPTION? 
      RSS           YES 
      JMP CLOOP     NO, CHECK NEXT CONTROL OPTION 
      STA ?AFLG 
      RSS 
RLOC  STA ?RFLG     SET RELOCATABLE ASSEMBLY FLAG 
GETOP LDA .6        # OF CHARS IN STRING TO MOVE
      LDB .BUFF     DESTINATION ADDRESS 
      RSS 
      LDB B,I       REMOVE INDIRECTS
      RBL,CLE,SLB,ERB 
      JMP *-2 
      JSB ?MOVE 
MVSTR NOP 
      CLA,INA       SET UP CHAR POINTER TO STRING 
      STA PNTR      RELATIVE CHAR POSITION W.R.T. BUFF
OPLP  JSB ?PKUP     PICKUP NEXT CHAR
      CPA BLNK      BLANK?
      JMP G         YES, THEN TERMINATE CHECK 
      JSB CHKOP     NO, THEN CHECK OPTION 
      LDB PNTR
      CMB,INB 
      ADB .6        GREATER THAN 6? 
      SSB 
      JMP G         YES, TERMINATE CHECK
      JMP OPLP      NO, TEST FOR MORE 
      SPC 2 
COPST LDA .5        (5) 
      STA PNTR      SET PNTR = 5
COPUP JSB ?PKUP     GET NEXT CHARACTER
      CPA BLNK      DONE ?
      JMP G          YES
      SZA,RSS       CHAR=0? 
      JMP G          YES, 0K
      CPA .54B      COMMA?
      RSS           -YES- 
      JMP CSER      -NO- ERROR
      JSB ?BPKU     SKIP BLANKS 
      JSB CHKOP     CHECK FOR OPTION
      ISZ PNTR
      JMP COPUP     TEST FOR MORE CONTROL OPTIONS 
      SPC 1 
*  TEST FOR VALIDITY OF CONTROL OPTION
CHKOP NOP 
      LDB ?FLGS     LOC'N OF CONTROL CHAR SET 
      CPA .B        =B? (PUNCH) 
      JMP CHKOP,I    YES,IGNORE 
      CPA .L        =L? (LIST)
      JMP BCON       YES
      CPA .R        =R? (RELOC.-NOT NECESSARY)
      ADB .1         YES
      CPA .T        =T? (SYMBOL TABLE PRINT)
      ADB .2         YES
      CPA .N        IS IT FOR IFN?
      ADB .3         YES
      CPA .Z        IS  IT FOR  IFZ?
      ADB .3         YES
      CPA .A        =A? (ABSOLUTE ASSEMBLY?)
      ADB .4         YES
      CPA .C        =C? (CROSS REF. TABLE?) 
      ADB .5         YES
      CPA .Q        =Q? 
      JMP BCON      YES,PRINT ONLY ADDRESS NOT INSTRUCTION CODE 
      CPA .P        =P (OVERRIDE OPTION?) 
      JMP CHKOP,I   YES, IGNORE IT
      CPB ?FLGS     SKIP IF ANY OPTION FOUND
      JMP XTST      NO NICE MATCH SO FAR
BCON  STA 1,I       SET OPTION FLAG 
      JMP CHKOP,I   RETURN
.L    OCT 114       ASCII 'L' 
.N    OCT 116             'N' 
.R    OCT 122             'R' 
.T    OCT 124             'T' 
.Z    OCT 132             'Z' 
.A    OCT 101             'A' 
.C    OCT 103             'C' 
.X    OCT 130             'X' 
.Q    OCT 121             'Q' 
.P    OCT 120             'P' 
.F    OCT 106             'F' 
XFOPT DEC 0         'X' OR 'F' OPTION COUNT 
CNTX  DEC -12       LENGTH OF FLOATING POINT OPCODE ENTRIES 
DESTN DEF ?FP       LOC'N OF HDWE. 'FIX/FLT' OPCODES
AS.FI OCT 43111     ASCII 'FI' TO ENABLE 'FIX/FLT' OPCODES
DESLO DEF ?FPT      LOC'N OF FLOATING POINT OPCODE ENTRIES
* 
MVLC  DEF *+1 FLOATING POINT OPCODE TBL. VALUES 
* 
*                         ****** FAD ******* ****** FDV ******* 
      OCT 43101,42026,105000,43104,53026,105060 
* 
*                         ****** FMP ******* ****** FSB ******* 
      OCT 43115,50026,105040,43123,41026,105020 
* 
*                           * END OF FLOATING POINT ENTRIES * 
* 
      SKP 
CS.CK NOP 
      LDA XFOPT     LOAD A WITH OPTION FLAG 
      SZA           SKIP IF FLAG 0
      JMP CSER      IF 1 PRINT CS ERROR 
      INA           INCREMENT VALUE OF FLAG 
      STA XFOPT     SAVE IN FLAG POSITION 
      JMP CS.CK,I   RETURN
* 
FMOVE JSB CS.CK     GO CHECK LEGAL OPTION 
      LDB DESTN     LOAD B WITH TABLE POINTER 
      RBL,CLE,SLB,ERB  CLEAR INDIRECT BIT, IF ANY.
      LDB B,I       PUT POINTER ADDR. IN B
      LDA AS.FI     LOAD A WITH ASCII "FI"
      STA B,I       STORE IN FIX PART OF TABLE
      LDB DESLO     LOAD B WITH SECOND TABLE POINTER
      RBL,CLE,SLB,ERB  CLEAR INDIRECT BIT, IF ANY.
      LDB B,I       PUT POINTER ADDR. IN B
TMOV2 LDA MVLC,I    LOAD FIRST WORD 
      STA B,I       STORE IN TABLE
      ISZ MVLC      INCREMENT TO NEXT WORD
      INB           INCREMENT POINTER 
      ISZ CNTX      INCREMENT COUNT, SKIP IF 0
      JMP TMOV2     RETURN FOR NEXT WORD
      JMP BCON+1    RETURN
* 
XTST  CPA .F        IS OPTION =F
      JMP FMOVE     YES, GO CHANGE TABLE
      CPA .X        IS OPTION =X
      JMP TMOVE     YES, GO CHANGE TABLE
      JMP CSER      NO, PRINT CONTROL STATEMENT ERROR!
TMOVE JSB CS.CK     CHECK IF F BEFORE 
      LDB DESLC     MOVE N-EAU OPCODE VALUES
      RBL,CLE,SLB,ERB  CLEAR INDIRECT BIT, IF ANY.
      LDB B,I       PUT POINTER ADDRESS IN B
TMOV1 LDA MOVLC,I   OPCODE TABLE IN ASMB..
      RAL,CLE,SLA,ERA  CLEAR INDIRECT BIT, IF ANY.
      LDA A,I          GET DIRECT ADDRESS.
      STA B,I       STORE NEW VALUE INTO OPCODE TBL.
      ISZ MOVLC 
      INB           BUMP TABLE POINTER
      ISZ COUNX     IS TABLE ALL MOVED? 
      JMP TMOV1      NO,  GO MOVE ANOTHER WORD. 
      JMP BCON+1
COUNX DEC -13       LENGTH OF NEW TABLE 
DESLC DEF ?NEAU     LOCATION OF OPCODE VALUE DESTIN.
* 
MOVLC DEF *+1       NON-EAU OPCODE VALUES FOR TABLE.
      OCT 42111,53006    DIV
      DEF ?HA38 
      OCT 42114,42006    DLD
      DEF ?HA38 
      OCT 42123,52006    DST
      DEF ?HA38 
      OCT 46520,54406    MPY
      DEF ?HA38 
      OCT 0         END OF NEW TABLE
*             * TEST FOR COMPATABILITY AMONG THE OPTIONS *
* 
G     LDB ?AFLG 
      LDA ?RFLG 
      SZB,RSS    IS 'A' SET?
      JMP *+3 
      SZA           YES - IS 'R' SET? 
      JMP CSER      YES - CONTROL CONFLICT
      LDA ?X        GET FWA OF AVAILABLE CORE 
      CMA,INA 
      ADA ?LWA      LWA-FWA AVAIL MEM. IN A 
      INA           A NOW = SYMBOL TBL LENGTH 
* 
*             * CLEAR SYMBOL TABLE *
* 
      LDB ?X        FWA OF SYM TBL TO 'B' 
      STB ?NDSY     SET ADDRESS OF END OF SYMBOL TABLE
      JSB ?SETM 
      NOP           SET SYMBOL TABLE TO ZERO
*             ********************* 
*             * START PASS 1 HERE * 
*             ********************* 
      LDB ?AFLG     GET ABSOLUTE ASSEMBLU FLAG
      SZB,RSS       ABSOLUTE ASSEMBLY?
      JMP RELOC     NO
      JSB OPN.C     YES 
      DEF C.BIA     ABSOLUTE BINASY FILE FCB
OUTER CLB,INB,RSS   ERROR 
      JMP ASMD5 
      CPA .M201     IS THE ERROR BINARY FILE NOT SPECIFIED? 
      JMP ASMD7     YES, THEN DO, NOT OUTPUT BINARY 
      JMP ?FMPE     NO, THEN PRINT ERROR MESSAGE
RELOC JSB OPN.C     RELOC. ASSEMBLY 
      DEF C.BIN     BINARY RELOCATABLE FCB
      JMP OUTER     ERROR 
ASMD5 CLA,INA       SET FLAG TO INDICATE
      STA ?BINF     BINARY OUTPUT IS PRESENT
ASMD7 LDA TW10
      STA ?ASM1     SET FLAG FOR 'INIT' PROCESSING
      CLA 
      STA PASS      SET PASS FLAG FOR PASS 1
      STA PLCN      INITIALIZE PROG LOC'N COUNTER 
      STA PLEN      CLEAR LITERAL LENGTH FLAG 
      LDA EXTLN     GET LENGTH OF NAM EXTENSION AREA. 
      LDB EXTAD     GET FWA OF NAM EXTENSION. 
      JSB ?SETM     GO SET BLANKS INTO THE AREA.
      ASC 1,        DUAL ASCII BLANKS.
      LDA .3        SEG. CALL FOR ABSOLUTE
      LDB ?AFLG     GET ABSOLUTE-ASSEMBLY FLAG. 
      SZB,RSS       ABS. ASSY? - SKIP IF TRUE.
      CLA,INA       PICK UP CODE FOR ASMB1
      JMP ?SEGM     GO TO LOAD THE NEXT SEGMENT 
.CS   ASC 2,CS      ASCII 'CS' FOR CONTROL STMT. ERROR MSG. 
EXTAD DEF PBUF+17   FWA OF NAM EXTENSION AREA.
EXTLN EQU .54B      (54B) LENGTH OF NAM EXTENSION AREA. 
* 
*  THIS SECTION IS ENTERED TO SCHEDULE XREF ANDEOR
*      TERMINATE THE ASSEMBLER
* 
* 
XRFSC LDA LINC+1    GET CURRENT PAGE #
      CMA,INA       NEGATE FOR SIGNAL TO XREF 
      STA PRMLS+3   SAVE IN PARAMETER LIST
      LDA PLINE     GET THE NEGATED # LINES/PAGE
      CMA,INA       MAKE THE VALUE POSITIVE 
      STA PRMLS+4   SET IT IN PARAMETER LIST
* 
      JSB WRT.C     INFORM THE OPERATOR 
      DEF C.TTY     THAT THE CROSS-REFERENCE GENERATOR
      DEF TELOP     HAS BEEN SCHEDULED
      DEF .12 
      NOP 
* 
      JSB RUN.C     SCHEDULE THE XREF PROGRAM 
      DEF C.SOR     SOURCE FILE FCB 
      DEF C.LST 
      DEF XREF      NAME OF PROGRAM 
      DEF PRMLS     PARAMETER LIST
      JMP ?ASME     TERMINATE ASSEMBLER 
* 
PRMLS NOP 
      BSS 4 
TELOP ASC 4, /ASMB: 
XREF  ASC 3,XREF
      ASC 5,SCHEDULED 
.12   DEC 12
* 
      END ASMB0 
                                                                              