ASMB,R,L,C     RTML4
*     NAME:   RTML4 RTE-M SEGMENTED GENERATOR-LOADER (SEGMENT 4)
*     SOURCE: 91740-18049 
*     RELOC:  91740-16049 
*     PGMR:   MIKE SCHOENDORF 
* 
*  ***************************************************************
*  * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977.  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-M SYSTEM GENERATOR-LOADER 
      NAM RTML4,5 91740-16049 REV 1740 771024 
* 
      ENT RTML4 
* 
*   EXTERNAL REFERENCE NAMES
      EXT ABRC1,ABREC,ABRT1,AFILE 
      EXT BAKUP,BLINE,BPAGA,BPLOC 
      EXT CLFL3 
      EXT CMER,CNT,CONSL,CONV 
      EXT DCB3
      EXT ECHOS,ER#OR 
      EXT FWABP,FWAC,FWAM,ICR,IDCB,IERR#,IFILE
      EXT IL,IN#CK,IOPTN,ISECU,JMPNO,KTABL
      EXT LBUF#,LBUFA,LDGEN 
      EXT LFILE,LISTO,LNKDR 
      EXT LST,LST1,LST3 
      EXT LST4,LST5,LSTA,LSTI 
      EXT LSTM,LSTP 
      EXT LWABP,LWAC,LWAM,MAPS,.MEM.,.MEM2
      EXT MESSI,MLOCC,MOVEX 
      EXT NBUF,NBUF6,NBUFT
      EXT NSCAN,NXTC,NXTC2,NXTCM
      EXT OFILE,ONTBL,OPEN1 
      EXT OPFLA,OPFLG,OPNLU 
      EXT OTFIL,OTMES,PACK#,PLK 
      EXT PLK1,PLK4,PLKS
      EXT PRCMD,PRINT,PUNCH,QBUFA,QGETC,QQCNT 
      EXT QQPTR 
      EXT SCAN,SCP,SEGFL
      EXT SNAPS,SSTBL 
      EXT TRANS,UEXFL,UNDEF,WERR1 
      EXT WRTBT,WRTFL,?XFER 
* 
      EXT CREAT,DCMC,OPEN,PARSE 
      EXT DU#MY 
* 
* 
B     EQU 1 
ERROR EQU ER#OR 
IERR  EQU IERR# 
INDCK EQU IN#CK 
LBUF  EQU LBUF# 
LOCC  EQU MLOCC 
PACK  EQU PACK# 
      SUP 
************************************************************************
* 
*  THIS SEGMENT OF THE RTE-M SEGEMNTED LOADER AND GENERATOR 
*  PROCESSES ALL LOADER COMMANDS (SET, REL, TR, ETC.).
*  HOWEVER THIS SEGMENT DOES NOT PERFORM RELOCATION.
*  CONTROL IS RETURNED TO EITHER THE LOADER OR GENERATOR
*  MAIN IF NO RELOCATION OCCURS. IF RELOCATION (REL OR
*  SEARCH COMMAND) IS NEEDED, THIS SEGMENT WILL CALL
*  FOR LOADER SEGMENT 3 (RTML3) TO BE LOADED IN TO
*  PERFORM THE RELOCATION.
* 
********************************************************************
      HED  RTM LOADER UTILITY SUBROUTINES 
      SPC 5 
      SKP 
RTML4 NOP 
      NOP 
      LDA LBUF4     REMOVE
      JSB INDCK         INDIRECT
      STA LBUF4             ADDRESSES 
      LDA LBUF0                 FOR 
      JSB INDCK                     DEFS
      STA LBUF0 
      LDA BPAGA 
      JSB INDCK 
      STA BPAGA 
      LDA B2
      STA SEGFL     LAST SEGMENT FLAG 
      LDA JMPNO 
      ADA M13 
      ADA PTABL 
      LDA 0,I 
      JMP 0,I 
* 
M13   DEC -13 
* 
      SKP 
***** 
* 
*  BRANCH TABLE FOR COMMAND PROCESSORS. 
*  ORDER OF THIS TABLE MUST CONFORM TO ORDER OF FIRST ENTRIES IN
*  COMMAND MNEMONIC TABLE.
* 
***** 
PTABL DEF * 
      DEF DSPST     DISPLAY STATEMENT 
      DEF SNPST     SNAPSHOT STATEMENT
      DEF EOL       END STATEMENT 
      DEF MCART     MOUNT CARTRIDGE STATEMENT 
      DEF DCART     DISMOUNT CARTRIDGE STATEMENT
      SKP 
***** 
* 
** MOVE. ** MOVE BLOCK OF CHARS FROM INPUT BUFFER (QIBUF) TO A
*           SPECIFIED LOCATION. STOP AT FIRST DELIMITER.
* CALLING SEQUENCE: 
* 
*     LDA ADDRESS OF DESTINATION
*     JSB MOVE. 
*     RETURN
* 
***** 
MOVE. NOP 
      STA MOVE3    SAVE DESTINATION ADDRESS 
      JSB NXTC    GET NEXT NON BLANK CHAR 
      JMP CMER   NONE FOUND 
MOV01 ALF,ALF     POSITION CHAR TO LEFT,
      STA MOVE3,I  AND STORE IN OUTPUT BUFFER 
      JSB QGETC   GET NEXT CHAR 
      JMP MOV03    END OF LINE
      CPA B40     BLANK?
      JMP MOV02 
      CPA B54     COMMA?
      JMP MOV02 
      CPA B51     RIGHT PAREN?
      JMP MOV02 
      CPA B50       LEFT PAREN? 
      JMP MOV02     YES 
      CPA B72       COLON?
      JMP MOV02     YES 
      IOR MOVE3,I   PUT LOWER HALF
      STA MOVE3,I   IN BUFFER 
      JSB QGETC     GET NEXT CHAR 
      JMP MOV03     END OF LINE 
      CPA B40       BLANK?
      JMP MOV02 
      CPA B54       COMMA?
      JMP MOV02 
      CPA B51       RIGHT PAREN?
      JMP MOV02 
      CPA B50       LEFT PAREN? 
      JMP MOV02     YES 
      CPA B72       COLON?
      JMP MOV02     YES 
      ISZ MOVE3    BUMP OUTPUT POINTER
      JMP MOV01    KEEP GOING 
MOV02 JSB BAKUP   BACK UP OVER LAST CHAR
MOV03 LDA MOVE3,I WAS LAST CHAR 
      AND UPCM
      CPA MOVE3,I  AN EVEN NUMBERED CHAR? 
      RSS 
      JMP MOVE.,I  YES, BUFFER IS OK
      IOR B40      NO, APPEND A BLANK 
      STA MOVE3,I  AND STORE IT AWAY
      JMP MOVE.,I 
* 
MOVE3 NOP           DESTINATION ADDRESS 
* 
B40   OCT 40
B50   OCT 50
B51   OCT 51
B54   OCT 54
B72   OCT 72
UPCM  OCT 77400 
      SPC 1 
      SKP 
* 
* 
*  SUBROUTINE TO DETERMINE IF INPUT IS OCTAL OR ASCII 
* 
* 
OCTAS NOP 
      STA 1 
      AND B377
      ADA M60 
      SSA 
      JMP OCTAS,I   ASCII 
      ADA M10 
      SSA,RSS 
      JMP OCTAS,I   MUST BE ASCII, EXIT 
      ISZ OCTAS     OCTAL 
      JMP OCTAS,I 
* 
B377  OCT 377 
M10   DEC -10 
M60   OCT -60 
* 
* 
* 
STORE NOP 
      LDB LU        ASCII LU
      STB OTFIL,I 
      ISZ OTFIL 
      LDB ..        ASCII ..
      STB OTFIL,I 
      ISZ OTFIL 
      STA OTFIL,I   LU
      JMP STORE,I 
* 
LU    ASC 1,LU
..    ASC 1,..
      SKP 
* 
* 
*  SUBROUTINES TO OPEN FILES
* 
* 
* 
* 
* 
OPFL7 NOP 
      LDA OPFLG 
      STA OPFLS 
      LDA SNAPS     OPEN SNAP/DISPLAY FILE
      LDB DCB3
      JSB OPNFL 
OPFLS OCT 210       ASCII OUTPUT
      JMP OPFL7,I 
* 
* 
* 
      SKP 
      SKP 
* 
* 
*  OPEN FILES 
* 
*    A REG = ADDRESS OF FILE NAME ARRAY 
*    B REG = ADDRESS OF DATA CONTROL BLOCK
* 
* 
OPNFL NOP 
      STA AFILE     SAVE ADDRESS OF FILE
      STB IDCB      SAVE ADDRESS OF DCB 
      LDA OPNFL,I 
      STA IOPTN     OPEN OPTION 
      ISZ OPNFL 
      JSB OPEN      OPEN FILE 
      DEF *+7       RETURN ADDRESS
      DEF IDCB,I    DCB 
      DEF IERR      ERROR CODE
      DEF AFILE,I   ADDRESS OF FILE 
      DEF IOPTN     OPEN OPTION 
      DEF ISECU     SECURITY CODE 
      DEF ICR       LABEL 
      SSA 
      JMP OPN1      OPEN ERROR
      LDA OPFLA 
      AND UDFE      CLEAR PAUSE BIT 
      JSB PAUSE 
      JMP OPNFL,I 
* 
OPN1  CPA M100
      JMP OPN7
      LDB OPEN1     COMMAND INPUT CALLING?
      CPB B1
      JMP ABRT0     YES, ABORT
      LDB OPFLA 
      SSB           BEEN HERE ALREADY?
      JMP OPN2      YES, FILE NOT FOUND 
      CPA MD6       OPEN ERROR (6)? 
      RSS 
      JMP ERROE     NO, OPEN ERROR
      LDA OPFLA           SET PAUSE BIT 
      IOR C1000 
      JSB PAUSE 
OPN4  CLA 
      STA QQCNT     RESET INPUT BUFFER
      LDA QBUFA 
      STA QQPTR 
      LDA QBUFA,I   GET FIRST CHARACTER 
      ALF,ALF 
      AND B177
      CPA B55       IS COMMAND ID SUPPLIED? 
      ISZ QQCNT     YES--BUMP CHAR. POINTER 
      JMP NXTC2 
* 
OPN2  LDA OPFLA     CLEAR PAUSE BIT 
      AND UDFE
      JSB PAUSE 
      JSB OPNLU     CHECK IF LU 
      JMP OPN8      NOT LU
      JMP OPNFL,I   LU, EXIT
OPN8  LDA AFILE 
      CPA OFILE     OPENING OUTPUT FILE?
      JMP OPN3      YES 
      LDB B4
      CPA SNAPS     OPENING SNAP FILE?
      JMP OPN6      YES 
      CPA LFILE     OPENING MAP FILE? 
      JMP OPN6
      CPA ECHOS     OPENING ECHO FILE?
      JMP OPN6      YES 
OPN5  LDA FN        FILE NOT FOUND
      LDB IERR      ERROR CODE
      JSB ERROR 
      JMP CONSL     TRY AGAIN 
* 
OPN3  LDA D300
      LDB LDGEN     LOADER CALLING? 
      SZB 
      LDA D30       YES 
      LDB B7
      RSS 
OPN6  LDA D15 
      JSB CRETE     GO TRY TO CREATE FILE 
      JMP OPN4
* 
OPN7  LDA DI
      LDB IERR      ERROR CODE
      JSB ERROR 
      JMP CONSL     DISK INITIALIZATION ERROR 
* 
ERROE LDA OE
      LDB IERR      ERROR CODE
      JMP WERR1 
* 
ABRT0 LDA OE        OPEN FILE ERROR 
      LDB IERR      ERROR CODE
      JSB ERROR 
      JMP ABRT1 
* 
MD6   DEC -6
B7    OCT 7 
B55   OCT 55
B177  OCT 177 
* 
D15   DEC 15
D30   DEC 30
C1000 OCT 100000
UDFE  OCT 77777 
* 
*  CREATE OUTPUT FILE IF IN FLOPPY ENVIRONMENT
* 
CRETE NOP 
      STA DSIZE     FILE SIZE 
      STB ITYPE     TYPE OF FILE 4=ASCII 7=ABS
      JSB CREAT     CREATE FILE 
      DEF *+8 
      DEF IDCB,I    DCB 
      DEF IERR
      DEF AFILE,I   ADDRESS OF FILE 
      DEF DSIZE     FILE SIZE 
      DEF ITYPE     TPE OF FILE 
      DEF ISECU     SECURITY CODE 
      DEF ICR       LABEL 
      CPA MD200 
      JMP OPN5      CAN'T CREATE FILE ON NON-FLOPPY 
      SSA,RSS 
      JMP CRETE,I 
* 
      LDA CR        CREATE ERROR
      LDB IERR      ERROR CODE
      JSB ERROR 
      JMP CONSL 
* 
CR    ASC 1,CR
DI    ASC 1,DI
* 
MD200 DEC -200
M100  DEC -100
D300  DEC 300 
* 
DSIZE NOP 
ITYPE NOP 
      SKP 
* 
OE    ASC 1,OE      OPEN FILE ERROR 
FN    ASC 1,FN      FILE NOT FOUND ERROR
* 
* 
*  SUBROUTINE TO ADD/DELETE PAUSE BIT FROM CONTROL WORDS
* 
PAUSE NOP 
      STA OPFLA 
      XOR B600
      STA OPFLG 
      JMP PAUSE,I 
* 
B600  OCT 600 
      SKP 
* 
* 
*  SUBROUTINE TO WRITE ON FILES 
* 
* 
* 
* 
* 
WRFL3 NOP 
      JSB WRTFL     DISPLAY/SNAP
      DEF DCB3
      JMP WRFL3,I 
      SKP 
* 
* 
*  SUBROUTINE TO PARSE COMMAND
* 
*    CALLING SEQUENCE 
* 
*    A REG = DEFAULT LU OR 0 IF DEFAULT NOT ALLOWED 
*    B REG = ADDRESS OF FILE NAME ARRAY 
* 
*    JSB FILE 
*    (P+1) = GTFIL IOPTN PARAMETER (WHICH FILE) 
*    RETURN 1 = COMMAND (LU) - GET FILE NAME
*    RETURN 2 = OPEN FILE 
* 
* 
FILE  NOP 
      STA OUTFL     SAVE DEFAULT LU 
      STB OTFIL     SAVE ADDRESS OF FILE NAME ARRAY 
      JSB NXTC      GET NEXT NON-BLANK CHARACTER
      JMP FILE4     NO MORE 
      LDB OTFIL 
      CPB TRANS     TRANSFER COMMAND? 
      JMP FILE2     YES 
      JSB BAKUP     BACKUP INPUT BUF TO PREV. CHAR. 
      LDB OTFIL 
      CPB IFILE     RELOCATE/SEARCH COMMAND?
      JMP FILE1     YES 
      CCA           OUTPUT, SNAP, MAP, OR DISPLAY COMMAND 
      CPB ECHOS     ECHO COMMAND? 
      LDA M2        YES 
      LDB ONTBL     SEARCH FOR ON OR OFF
      JSB SCAN
      JMP CMER      ERROR EXIT
      CPA B2        OFF?
      JMP FILE3     YES 
FILE1 JSB ASOCT     ASCII OR OCTAL? 
      JMP ASKEY     ASCII 
      LDA TCHAR     LU
      JSB STORE 
      JMP FILE,I
ASKEY JSB ASCII     MOVE FILE NAME TO 
      JMP FILE,I    FILE NAME ARRAY AND EXIT
FILE2 CPA B54       COMMA?
      JMP FILE1     YES 
FILE3 LDB FILE
      ADB B4        SET RETURN ADDRESS
      CLA           ECHO OFF
      JMP B,I       EXIT
FILE4 LDA OUTFL     USE DEFAULT LU
      JSB STORE 
      JMP FILE,I
* 
OUTFL NOP           LOGICAL UNIT NUMBER 
TCHAR NOP 
* 
M2    DEC -2
B4    OCT 4 
      SKP 
* 
* 
*  SUBROUTINE TO GET NEXT OCTAL OR ASCII CHARACTER
* 
* 
ASOCT NOP 
      JSB NXTC      GET NEXT CHARACTER
      JMP CMER      NO MORE, ERROR EXIT 
      JSB OCTAS 
      JMP ASOCT,I   ASCII INPUT 
      STB TCHAR     SAVE FIRST DIGIT
      JSB NXTC      GET NEXT CHARACTER
      JMP ASOC1     NO MORE, ONE DIGIT LU 
      JSB OCTAS 
      JMP CMER      ASCII, ERROR EXIT 
      LDA TCHAR     COMBINE WITH PREVIOUS DIGIT 
      ALF,ALF 
      IOR 1 
ODGIT STA TCHAR 
      ISZ ASOCT 
      JMP ASOCT,I 
* 
ASOC1 LDA TCHAR 
      IOR B30K
      JMP ODGIT 
* 
B30K  OCT 30000 
* 
* 
* 
* 
*  SUBROUTINE TO MOVE FILE NAME FROM INPUT BUFFER 
*  TO FILE NAME ARRAY 
* 
* 
ASCII NOP 
      JSB BAKUP     BACKUP INPUT BUFFER TO PREVIOUS CHARACTER 
      LDA OTFIL 
      LDB BLANK     SET FILE NAME TO BLANKS 
      INA 
      STB 0,I 
      INA 
      STB 0,I 
      LDA OTFIL     MOVE FILE NAME FROM INPUT BUFFER
      JSB MOVE.     TO FILE NAME ARRAY
      JMP ASCII,I   NO MORE CHARACTERS
* 
BLANK ASC 1,
      SKP 
* 
*  SUBROUTINES TO PARSE FILE NAMES FOR SECURITY CODE
*  AND LABEL. 
* 
PNMRC NOP 
      LDA B72 
      STA C:        SET FOR COLON 
      JSB PNMRX 
      JMP PNMRC,I 
* 
* 
PNMRX NOP 
      CLA 
      STA ISECU     INITIALIZE SECURITY CODE AND
      STA ICR       LABEL 
      JSB PNMRA     GET 1ST OPTIONAL NAME PARAMETER 
      JMP PNMRX,I   NONE, EXIT
      STA ISECU     SAVE SECUITY CODE 
      JSB PNMRA     GET 2ND OPTIONAL NAME PARAMETER 
      JMP PNMRX,I   NONE, EXIT
      STA ICR       SAVE LABEL
      JMP PNMRX,I 
* 
* 
* 
PNMRA NOP 
      JSB NXTC      GET NEXT CHARACTER
      JMP PNMRA,I   NO MORE 
      CPA C:
      JMP PNMR1     YES 
      JSB BAKUP     NO, BACKUP
      JMP PNMRA,I 
PNMR1 JSB NXTC      GET NEXT CHARACTER
      JMP PNMRA,I   NO MORE 
      CPA C:
      JMP PNMR2     YES, NO FIRST PARAMETER 
      JSB BAKUP     BACKUP
      LDA BLANK 
      STA BUFA1+1 
      STA BUFA1+2 
      LDA BUFAD 
      JSB MOVE.     PUT ASCII CHARS IN BUFFER 
      JSB PARSE     PARSE INPUT 
      DEF *+4 
      DEF BUFA1 
      DEF B6
      DEF RBUF
      LDA RBUF+1
      ISZ PNMRA 
      JMP PNMRA,I 
* 
PNMR2 JSB BAKUP     BACKUP
      CLA           SET FOR NO PARAMETER
      ISZ PNMRA     SET FOR NEXT PARAMETER
      JMP PNMRA,I 
BUFAD DEF *+1 
BUFA1 BSS 3 
RBUF  BSS 33
      SKP 
***** 
* 
**  MOUNT CARTRIDGE/DISMOUNT CARTRIGE 
* 
***** 
MCART CLA,RSS 
DCART CLA,INA 
      STA WHICH     SAVE TYPE 
      JSB PNMCM     GET LU/DRN AND LAST TRACK 
      JSB DCMC      GO MOUNT OR DISMOUNT CARTRIDGE
      DEF *+4       RETURN ADDRESS
      DEF WHICH     MOUNT/DISMOUNT
      DEF ISECU     LU/DRN
      DEF ICR       LAST TRACK
      SZA,RSS 
      JMP NXTCM     GET NEXT COMMAND
      LDB 0         ERROR CODE
      LDA MC
      JSB ERROR     OUTPUT ERROR
      JMP NXTCM     GET NEXT COMMAND
* 
* 
* 
PNMCM NOP 
      LDA B54       COMMA 
      STA C:
      JSB PNMRX     GET LU.DRN AND LAST TRACK 
      JMP PNMCM,I 
* 
* 
C:    NOP 
WHICH NOP 
* 
MC    ASC 1,MC
      SKP 
      SKP 
***** 
* 
** DISPLAY COMMAND PROCESSOR
* 
***** 
DSPST JSB BLINE     BLANK PRINT LINE
      LDA QQPTR  SAVE 
      STA STMP    BUFFER
      LDA QQCNT         POINTERS
      STA SVAL
      LDA LBUFA  MOVE NAME OF ENTITY TO BE DISPLAYED
      JSB MOVE.   INTO THE OUTPUT BUFFER
      LDA STMP
      STA QQPTR  RESTORE BUFFER POINTERS
      LDA SVAL
      STA QQCNT 
      LDA MD11
      LDB KTABL 
      JSB SCAN   IS THIS A KEYWORD? 
      JMP DSP10  NO, IT MUST BE AN IDENTIFIER 
      LDA CNT 
      STA CNT1
      JSB DISON     GET FILE OR LU
      LDA CNT1
      CPA D11   UNDEFS? 
      JMP OLSTU 
      CPA D10      TABLE? 
      JMP OLSTE 
      CPA B3
      LDB FWAM
      CPA B4
      LDB LWAM
      CPA B1
      LDB FWABP 
      CPA B2
      LDB LWABP 
      CPA B5
      LDB FWAC
      CPA B6
      LDB LWAC
      CPA D8
      LDB BPLOC 
      CPA D9
      LDB ?XFER 
      CPA B7
      LDB LOCC      GET CURRENT LOCATION COUNTER
      JMP DSP20     YES 
* 
STMP  NOP 
SVAL  NOP 
      SKP 
DSP10 LDA LBUFA 
      JSB MOVE. 
      JSB DISON     GET FILE OR LU
      LDB LBUFA 
      JSB SSTBL     SEARCH SYMBOL TABLE 
      JMP DSP30     SYMBOL IS UNDEFINED 
      LDB LST4,I    GET VALUE 
DSP20 LDA LBUF+2    SET EQUAL SIGN(=) IN 6TH CHAR 
      AND UPCM         OF PRINT LINE
      IOR B75 
      STA LBUF+2
      LDA LBUF4 
      JSB CONV   CONVERT THE VALUE TO ASCII 
      LDA D12 
DSP25 LDB MESAG     OUTPUT ON SYSTEM CONSOLE? 
      SZB 
      JMP DSP35     YES 
      LDB LBUFA 
      JSB WRFL3  WRITE THE LINE 
      CLB 
      LDA FILOP 
      SZA,RSS 
      CLB,INB 
      JSB CLFL3     CLOSE THE DISPLAY FILE
      JMP NXTCM    FINISHED, GET NEXT COMMAND 
DSP30 LDA MD5    MOVE "UNDEFINED" TO LBUF 
      LDB DSP40 
      JSB MOVEX 
LBUF4 DEF LBUF+3
      LDA D15 
      JMP DSP25 
DSP35 LDB LBUFA 
      JSB MESSI     OUTPUT TO SYSTEM CONSOLE
      OCT 2 
      JMP NXTCM     GET NEXT COMMAND
* 
DSP40 DEF *+1 
      ASC 5,UNDEFINED 
* 
MD11  DEC -11 
D9    DEC 9 
D10   DEC 10
D11   DEC 11
B5    OCT 5 
B75   OCT 75
* 
*  SUBROUTINE TO DETERMINE IF DISPLAY IS TO LU OR FILE
*  AND TO OPEN THE APPROPRIATE FILE 
* 
DISON NOP 
      CLA,INA 
      STA FILOP 
      JSB NXTC      GET NEXT CHARACTER
      JMP DISO1     NO MORE 
      JSB BAKUP     BACKUP
      CLA 
      STA MESAG     SET TO WRITE ON FILE
      STA FILOP 
      LDA ASC06     DUMMY, NOT USED 
      LDB SNAPS     DISPLAY FILE NAME ARRAY 
      JSB FILE      PARSE REQUEST 
      JSB PNMRC     GET OPTIONAL PARAMETERS 
      JSB OPFL7     OPEN DISPLAY FILE 
      JMP DISON,I 
* 
DISO1 CLA,INA       SET TO OUTPUT ON SYSTEM CONSOLE 
      STA MESAG 
      JMP DISON,I 
* 
ASC06 ASC 1,06
* 
CNT1  NOP 
FILOP NOP 
MESAG NOP 
* 
* 
OLSTE CLA,INA,RSS   ENTRY POINT LIST OPTION 
OLSTU CLA           LIST UNDEFINED SYMBOLS OPTION 
      CLB 
      JSB EPL 
      CLB 
      LDA FILOP 
      SZA,RSS 
      CLB,INB 
      JSB CLFL3     CLOSE DISPLAY FILE
      JMP NXTCM 
      SKP 
***** 
* 
** SNAP  **COMMAND PROCESSOR
* 
***** 
* 
* 
SNPST LDA ASC04     - DEFAULT LU FOR SNAP COMMAND 
      LDB SNAPS     SNAP FILE NAME ARRAY
      JSB FILE      PARSE REQUEST 
      JSB PNMRC     GET OPTIONAL PARAMETERS 
      JSB OPFL7     OPEN SNAP FILE
      LDA .MEM.      FIRST ADDRESS
      STA MEMAD     .MEM. ADDRESS 
      LDA MEMOT     ADDRESS OF LABELS 
      STA LBLAD 
      LDA MD6       NUMBER OF LABELS
      STA WDCNT 
      JSB GINIT     INITIALIZE BUFFER 
      CLA 
      STA MAXC      CLEAR WORD COUNT
      STA PROCT     CLEAR TOTAL COUNT 
SNAP1 LDA MD4        NO OF CHARS
      LDB BNDS      ADDRESS OF "-BOUNDS"
      JSB BUFUP    PUNCH ON TAPE
      JSB LBOUT     PUNCH LABELS
      LDB MEMAD,I  NEXT VALUE 
      LDA LDGEN     GENERATOR CALLING?
      SZA,RSS 
      JMP SNAP9     YES 
      LDA WDCNT     OUTPUT BPLOC INSTEAD OF FWABP 
      CPA MD6       FOR FIRST BOUNDS PARAMETER
      LDB BPLOC 
SNAP9 LDA NBUF6    BUFFER TEMP STORAGE
      JSB CONV  CONVERT TO OCTAL
      LDA M3
      LDB NBUF6 
      JSB BUFUP     PUNCH VALUE 
      CLA,INA      FINISH LINE WITH "CRLF"
      JSB BUFUP 
      ISZ MEMAD    BUMP TO NEXT VALUE 
      ISZ WDCNT    MORE?
      JMP SNAP1    YES
* 
      LDA LST,I     NUMBER OF SYMBOLS 
      SZA,RSS 
      JMP SNAP5     NO SYMBOLS
      CMA,INA 
      STA WDCNT 
      LDA LSTA      SYMBOL TABLE ADDRESS
      INA 
      STA MEMAD 
      STA ASYMB 
SNAP4 LDB MEMAD,I   GET 1ST TWO CHARACTERS OF LST ENTRY 
      SZB,RSS       BLANK ENTRY?
      JMP SNAP6     YES, DON'T OUTPUT SNAP
      LDA M3
      LDB ASET
      JSB BUFUP     PUNCH "-SET"
      JSB PSYMB     OUTPUT SYMBOL NAME
      LDA MEMAD 
      STA ASYMB 
      ISZ MEMAD 
      ISZ MEMAD     MOVE TO END OF NAME 
      LDA M2
      LDB ASTOA     PUNCH " TO "
      JSB BUFUP 
      ISZ MEMAD     BUMP TO LST4
      LDB MEMAD,I 
      CPB UDFE      UNDEFINED?
      JMP SNAP7     YES, OUTPUT UNDEF FOR LST4
      LDA NBUF6 
      JSB CONV       CONVERT LST4 TO OCTAL
      LDB NBUF6 
SNAP8 LDA M3
      JSB BUFUP     PUNCH LST4 OR UNDEF 
      CLA,INA 
      JSB BUFUP     FINISH WITH CRLF
      ISZ MEMAD 
      LDA MEMAD,I   GET LST5
      SZA,RSS       IS LST5 EQ. 0?
      JMP SNAP3     YES, SKIP LINKS 
      SSA           RPL OR AB ENTS
      JMP SNAP0     YES, GO OUTPUT THEM 
      LDB LDGEN     GENERATOR CALLING?
      SZB 
      JMP SNAP0     NO, OUTPUT LINK 
      CMA 
      ADA .MEM2 
      SSA,RSS 
      JMP SNAP3     DON'T OUTPUT LINK 
SNAP0 LDA MD8 
      LDB ASSTL 
      JSB BUFUP     PUNCH "-LINKS START AT" 
      LDB MEMAD,I 
      LDA NBUFT     BUFFER ADDRESS
      JSB CONV       CONVERT LST5 
      LDA M3
      LDB NBUFT 
      JSB BUFUP     PUNCH LST5
      LDA M1
      LDB COMBL     INSERT COMMA AND BLANK
      JSB BUFUP 
      JSB PSYMB     OUTPUT SYMBOL NAME
      CLA,INA 
      JSB BUFUP     FINISH WITH "CRLF"
SNAP3 ISZ MEMAD     UP TO NEXT SYMBOL 
      LDA MEMAD 
      STA ASYMB 
      ISZ WDCNT     DONE? 
      JMP SNAP4     NO, DO NEXT 
* 
SNAP5 LDA MD8 
      LDB ASET
      JSB BUFUP     PUNCH "-SET BPLOCC TO"
      CLB           ZERO
      LDA NBUF6 
      JSB CONV
      LDA M3
      LDB NBUF6 
      JSB BUFUP     PUNCH BPLOC 
      CLA,INA       DUMP BUFFER 
      JSB BUFUP 
      LDA M3        END LINE WITH CRLF
      LDB ASET      ADDRESS OF "SET"
      JSB BUFUP     PUNCH"-SET" 
      LDA M2
      LDB ASLOC     ADDRESS OF "LOCC" 
      JSB BUFUP     PUNCH "LOCC"
      LDA M2
      LDB ASTOA 
      JSB BUFUP     PUNCH " TO "
      LDB LOCC      FETCH FWAM
      LDA NBUF6 
      JSB CONV       CONVERT TO ASCII 
      LDA M3
      LDB NBUF6 
      JSB BUFUP     PUNCH VALUE OF FWAM 
      CLA,INA 
      JSB BUFUP    END LINE WITH CRLF 
      CLB,INB 
      JSB CLFL3     CLOSE SNAP FILE 
      JMP NXTCM     GET NEXT COMMAND
SNAP6 LDA MEMAD 
      ADA B4        ADVANCE TO NEXT ENTRY IN LST
      STA MEMAD 
      JMP SNAP3 
* 
SNAP7 LDB NODEF     GET ADDRESS OF UNDEF
      JMP SNAP8 
* 
BNDS  DEF *+1 
      ASC 4,-BOUNDS 
COMBL DEF *+1 
      OCT 26040 
NODEF DEF NDEF
NDEF  ASC 3,UNDEF 
* 
MD4   DEC -4
* 
ASC04 ASC 1,04
* 
ASYMB NOP 
* 
* 
*  SUBROUTINE TO OUTPUT SYMBOL NAME 
* 
* 
PSYMB NOP 
      LDA M2
      LDB ASYMB     OUTPUT 1ST 4 CHARACTERS OF
      JSB BUFUP     OF SYMBOL NAME
      ISZ ASYMB     MOVE TO END OF NAME 
      ISZ ASYMB 
      LDA ASYMB,I   GET LAST CHARACTER
      AND UPCM      MASK OUT LOWER
      IOR B40       INSERT SPACE AS LAST CHARACTER
      STA ASYMB,I   RESTORE 
      LDA M1        OUTPUT LAST CHARACTER 
      LDB ASYMB 
      JSB BUFUP 
      JMP PSYMB,I 
      HED  SNAPSHOT GENERATION SUBROUTINES
* 
* 
*                                OUTPUT LABEL ROUTINE 
* 
* 
*  CALLING SEQUENCE:
*    A AND B ARE IGNORED
*    JSB LBOUT
* 
*  RETURN: A AND B ARE DESTROYED
* 
LBOUT NOP 
      LDA M3
      LDB LBLAD     ADDRESS OF LABEL
      JSB BUFUP    PUNCH LABEL
      LDA LBLAD    UPDATE LABEL POINTER 
      ADA B3
      STA LBLAD 
      JMP LBOUT,I  RETURN 
* 
* 
*                                 LOAD AND DUMP THE PUNCH BUFFER
* 
* 
*  CALLING SEQUENCE:
*    A = NEG OF NO. OF WORDS TO LOAD
*    B = ADDRESS TO LOAD FROM 
*    JSB BUFUP
* 
*  RETURN:  A AND B ARE DESTROYED 
* 
BUFUP NOP 
      CPA B1        DUMP BUFFER REQUEST?
      JMP BUFDN     YES 
      STA MAXC      NO, SAVE NO OF WORDS TO GO
      ADA PROCT     ACCUMULATE THE TOTAL
      STA PROCT 
      LDA B,I       GET THE WORD
      STA CURAL,I   PUT IN BUFFER 
      INB           BUMP SOURCE POINTER 
      ISZ CURAL     UP BUFFER POINTER 
      ISZ MAXC      ALL DONE? 
      JMP *-5 
      JMP BUFUP,I   ALL DONE, RETURN
* 
BUFDN LDA PROCT     GET NEG OF WORD COUNT 
      CMA,INA       MAKE POSITIVE 
      RAL           MULT BY TWO 
      LDB LBUFA     START ADDRESS OF BUFFER 
      JSB WRFL3     GO WRITE THE FILE 
      JSB GINIT     INITIALIZE BUFFER POINTERS
      CLA 
      STA MAXC
      STA PROCT 
      JMP BUFUP,I    RETURN 
***** 
* 
*  THE GINIT SUBROUTINE SETS THE CURRENT ADDRESS AND UPPER/LOWER
*  FLAG FOR SCANNING LBUF.
* 
*  CALLING SEQUENCE:
*    A = IGNORED
*    B = IGNORED
*    JSB GINIT
* 
*  RETURN : CONTENTS OF A AND B ARE DESTROYED 
* 
GINIT NOP 
      LDA LBUFA     LBUFA = ADDR OF LBUF
      STA CURAL     SET CURRENT LBUF ADDRESS
      CCB 
      STB BUFUL     BUFUL = BUFFER U/L FLAG 
      JMP GINIT,I   RETURN
* 
* 
MEMOT DEF *+1 
      ASC 3,FWABP=
      ASC 3,LWABP=
      ASC 3,FWAM= 
      ASC 3,LWAM= 
      ASC 3,FWAC= 
      ASC 3,LWAC= 
BUFUL NOP 
CURAL NOP 
LBLAD NOP 
MAXC  NOP 
MEMAD NOP 
PROCT NOP 
WDCNT NOP 
ASET  DEF *+1 
      ASC 6,- SET BPLOCC
ASTO  ASC 2, TO 
ASTOA DEF ASTO
ASLOC DEF *+1 
      ASC 2,LOCC
ASSTL DEF *+1 
      ASC 8,-LINKS START AT 
      SKP 
                                                                                                                                                                                