ASMB,L,Z,C
*RTLGN  USE 'ASMB,Z '  ALWAYS !!
* 
*  ***************************************************************
*  * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980.  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 XL  GENERATOR SEGMENT 1 
      NAM L20G1,5 92071-1X078 REV.2041 800715 
* 
* 
*     NAME:    RTE XL  GENERATOR SEGMENT 1
*     SOURCE:  92071-18078
*     PGMR:    B.C. 
* 
      ENT L20G1 
* 
* 
      EXT EXEC,LOGLU,NAMR,.ENTR,PURGE 
      EXT OPEN,CLOSE,READF,WRITF,CREAT,RWNDF
* 
      EXT DSTRG,IPBUF,STRNG,SLONG,DONE?,ISTRC,DIPBF 
      EXT DFTLU,FATAL,OP?,MSIZE,IPTN2,ABOR
      EXT CPL.L,EXIT,LIMEM
* 
      EXT FWFM,LWFM,BPFWA,LODPT,COMAD,COMLG,LWAPG 
      EXT TDBP,LDBP,CSDBP,CUDBP 
* 
      EXT READ,FLERR,NAMRR,DRKEY,SPACE,FCLOS,MOVE 
      EXT ERRCT,ASTRX 
* 
      EXT F1,FILE1,TYPE1,F1SC,F1DSC,IERR1 
      EXT F2,FILE2,TYPE2,F2SC,F2DSC,IERR2 
      EXT F3,FILE3,TYPE3,F3SC,F3DSC,IERR3 
      EXT F4,FILE4,TYPE4,F4SC,F4DSC,IERR4 
      EXT CDCB1,ODCB2,SDCB3,LDCB4 
      EXT EFBUF,CONSL,FTIME,ADCB3,.MVW
      EXT CLOS2,CLOS3,CLOS4,OPSNP,CNV99,STCR1 
* 
      SUP PRESS EXTRANIOUS LISTING
* 
      SKP 
      SKP 
* 
*     PARSE THE RU STRING 
* 
L20G1 JSB NAMRR     PARSE TWICE TO GET RID OF THE RU AND
      JSB NAMRR     THE RTLGN. WE NOW HAVE PARAMETERS.
* 
* 
      JSB NAMRR     NOW GET THE COMMAND FILE NAME 
      SSA,RSS       END OF STRING ? 
      JMP GTCMD     NO
* 
NOCMD JSB EXEC      NO
      DEF *+5 
      DEF P2           COMMAND
      DEF DFTLU+0 
      DEF EFBUF+0              FILE 
      DEF COUNT 
* 
EXIT3 JSB EXEC                      EXIT
      DEF *+2 
      DEF P6
* 
* 
GTCMD LDA N6        GET THE NEG COUNT AGAIN 
      JSB MOVE      AND MOVE THE NAME TO THE CMND NAME BUFFER 
      DEF IPBUF+0   SOURCE OF MOVE
      DEF FILE1+0   COMMAND FILE NAME ADDRESS 
      LDA TYPE1     GET THE PARSE TYPE WORD 
      AND P3        KEEP ONLY THE LEAST TWO BITS
      STA TYPE1     AND SAVE FOR LATER
      CPA P3        COMMAND IS A FILE?
      RSS           YES 
      JMP NOCMD     NO , EXIT NO COMMAND FILE 
* 
*     LIST FILE NAMR
* 
      JSB NAMRR     GET THE LIST FILE 
      SSA 
      JMP OPNF4     END OF STRING , USE DEFAULT 
      LDA IPBUF+3   NULL INPUT? 
      SZA,RSS       NO
      JMP OPNF4     YES , USE DEFAULT 
      LDA N6        GET THE NEG COUNT AGAIN 
      JSB MOVE      AND MOVE THE NAME TO THE LIST BUFFER
      DEF IPBUF+0   SOURCE OF MOVE
      DEF FILE4+0   LIST FILE NAME ADDRESS
      LDA TYPE4     GET THE PARSE TYPE WORD 
      AND P3        KEEP ONLY THE LEAST TWO BITS
      STA TYPE4     AND SAVE FOR LATER
      ERA,SLA       IS IT A FILE OR AN LU ? 
      JMP OPNF4     FILE, LET'S START 
* 
LIERR JSB EXEC      NO , ILLEGAL NAME 
      DEF *+5 
      DEF P2
      DEF DFTLU+0 
      DEF LSTER 
      DEF P13 
      JMP EXIT3 
* 
*     PROCESS AND OPEN LIST FILE
* 
OPNF4 LDA FILE4 
      AND HIMSK     KEEP ONLY UPPER BYTE
      CPA ACENT     IS IT A ' 
      JMP OPEN4     YES , GO OPEN THE FILE
* 
CRAT4 JSB CREAT     NO , SO CRATE THE FILE
      DEF *+8 
      DEF LDCB4+0 
      DEF IERR4+0 
      DEF FILE4+0 
      DEF P150
      DEF P3
      DEF F4SC+0
      DEF F4DSC+0 
      SSA,RSS       ANY ERROR?
      JMP OPEN4     NO DO AN EXPLICT OPEN 
F4ERR SSA,RSS       ANY ERROR ? 
      JMP F4TST     NO ,
F4ER2 JSB CLOS4     YES , SO CLOSE THE OUTPUT FILE
      LDA N6        MOVE FILE NAME
      JSB MOVE
      DEF FILE4+0   SOURCE
      DEF LSTNM     DESTINATION 
      LDA IERR4     ERROR CODE IN A 
      CMA,INA       MAKE POSITIVE 
      JSB CNV99 
      STA LSTER+4 
      JMP LIERR 
* 
* 
OPEN4 JSB OPEN      OPEN THE LIST FILE
      DEF *+7 
      DEF LDCB4+0 
      DEF IERR4+0 
      DEF FILE4+0 
      DEF IPTN2+0   OPEN OPTION 
      DEF F4SC+0
      DEF F4DSC+0 
* 
      CPA N6        DID WE FIND THE FILE
      JMP CRAT4     NO , GO CRATE IT
      JMP F4ERR     SEE IF ANY ERROR
* 
F4TST JSB WRITF     TEST WRITE THE LIST FILE FOR SEC CODE 
      DEF *+5 
      DEF LDCB4+0 
      DEF IERR4+0 
      DEF SDCB3+0 
      DEF P1
* 
      SSA           ANY ERROR?
      JMP F4ER2     YES , ERROR 
* 
*     OUTPUT FILE NAMR
* 
      JSB NAMRR     NO , NOW GET THE OUTPUT FILE NAME 
      SSA           END OF STRING 
      JMP GTSNP     YES 
      LDA IPBUF+3   NULL INPUT? 
      SZA,RSS       NO
      JMP GTSNP     YES , USE DEFAULT 
      LDA N6        GET THE NEG COUNT FOR MOVE WORDS
      JSB MOVE      TO THE OUTPUT FILE BUFFER 
      DEF IPBUF+0   SOURCE OF MOVE
      DEF FILE2+0   OUTPUT FILE NAME ADDRESS
      LDA TYPE2     GET THE PARSE TYPE WORD 
      AND P3        KEEP ONLY THE LEAST TWO BIT 
      STA TYPE2     AND SAVE IT FOR LATER 
* 
*     SNAP FILE NAMR
* 
GTSNP JSB NAMRR     GET THE SNAP FILE NAME
      SSA           END OF STRING   ? 
      JMP F1OPN     YES, USE DEFAULT
      LDA IPBUF+3   NULL INPUT? 
      SZA,RSS       NO
      JMP F1OPN     YES , USE DEFAULT 
      LDA N6        GET THE NEG COUNT AGAIN 
      JSB MOVE      AND MOVE THE NAME TO THE SNAP FILE BUFER
      DEF IPBUF+0   SOURCE OF MOVE
      DEF FILE3+0    SNAP FILE NAME ADDRESS 
      LDA TYPE3     GET THE PARSE TYPE WORD 
      AND P3        KEEP ONLY THE LEAST TWO BIT 
      STA TYPE3     AND SAVE FOR LATER
* 
*     PROCESS AND OPEN COMMAND FILE 
* 
F1OPN JSB OPEN      OPEN THE COMMAND FILE 
      DEF *+7 
      DEF CDCB1+0   DATA CONTROL BLOCK
      DEF IERR1+0   ERROR FLAG
      DEF FILE1+0   FILE NAMR 
      DEF IPTN2+0   OPEN OPTION 
      DEF F1SC+0    SECURITY CODE 
      DEF F1DSC+0   CARTRIDGE REF # 
* 
      SSA,RSS       ANY ERRORS ?
      JMP F2OPN     NO
      LDB P1
      STB FATAL     SET THE FATAL FLAG
      LDB F1        GET THE FILE NAME ADDRESS 
      JSB FLERR     YES 
      JMP ABOR      AFTER ERROR ON COMMAND FILE , HANG IT UP
* 
*     PROCESS AND OPEN THE SYSTEM OUTPUT FILE 
* 
F2OPN LDA TYPE2     CHECK OUTPUT FILE NAME
      ERA,SLA       IT IS A FILE OR AN LU ? 
      JMP OPNF2     A FILE, OPEN IT 
      LDA N15       AN LU , IT SHOULD BE A FILE 
      STA IERR2     ECHO ILLEGAL FILE 
      JMP F2ER
* 
OPNF2 LDA FILE2 
      AND HIMSK     KEEP ONLY UPPER BYTE
      CPA ACENT     IS IT A ' 
      JMP PURG2     YES , GO PURGE THE FILE 
* 
CRAT2 JSB CREAT     NO , SO CRATE THE FILE
      DEF *+8 
      DEF ODCB2+0 
      DEF IERR2+0 
      DEF FILE2+0 
      DEF P512
      DEF P1
      DEF F2SC+0
      DEF F2DSC+0 
F2ERR SSA,RSS       ANY ERROR ? 
      JMP F3OPN     NO
F2ER  JSB CLOS2     YES , SO CLOSE THE OUTPUT FILE
      LDB F2        GET THE FILE NAME ADDRESS TO B
      LDA IERR2     ERROR CODE IN A 
      JSB FLERR     DO FILE ERROR THING 
      CLA,INA 
      STA FATAL 
      JMP F3OPN 
* 
PURG2 JSB PURGE     PURGE THE OUTPUT FILE 
      DEF *+6 
      DEF ODCB2+0 
      DEF IERR2+0 
      DEF FILE2+0 
      DEF F2SC+0
      DEF F2DSC+0 
* 
      SSA,RSS       ANY ERROR?
      JMP CRAT2     NO
      CPA N6        YES , DID WE FIND THE FILE? 
      JMP CRAT2     NO , GO CRATE IT
      JMP F2ERR     OTHER ERRORS
* 
*     PROCESS AND OPEN SNAP FILE
* 
F3OPN LDA TYPE3     CHECK SNAP FILE NAME
      ERA,SLA       IT IS A FILE OR AN LU ? 
      JMP OPNF3     A FILE, OPEN IT 
      LDA P1
      STA FATAL     SET THE FATAL FLAG
      LDA N15       AN LU , IT SHOULD BE A FILE 
      STA IERR3     ECHO ILLEGAL FILE 
      JMP F3ER
* 
OPNF3 LDA FILE3 
      AND HIMSK     KEEP ONLY UPPER BYTE
      CPA ACENT     IS IT A ' 
      JMP OPEN3     YES , GO OPEN THE FILE
* 
CRAT3 JSB CREAT     NO , SO CRATE THE FILE
      DEF *+8 
      DEF SDCB3+0 
      DEF IERR3+0 
      DEF FILE3+0 
      DEF P35 
      DEF P3
      DEF F3SC+0
      DEF F3DSC+0 
F3ERR SSA,RSS       ANY ERROR ? 
      JMP F3TST     NO ,
F3ER  JSB CLOS3     YES , SO CLOSE THE OUTPUT FILE
      LDB F3        GET THE FILE NAME ADDRESS TO B
      LDA IERR3     ERROR CODE IN A 
      JSB FLERR     DO FILE ERROR THING 
      CLA,INA 
      STA FATAL 
      JMP EREAD 
* 
OPEN3 JSB OPSNP     OPEN THE SNAP FILE
      CPA N6        DID WE FIND THE FILE
      JMP CRAT3     NO , GO CRATE IT
      JMP F3ERR     SEE IF ANY ERROR
* 
F3TST JSB WRITF     TEST WRITE TO SNAP FILE 
      DEF *+5 
      DEF SDCB3+0 
      DEF IERR3+0 
      DEF FILE3+0 
      DEF P12 
* 
      SSA,RSS       ANY ERROR?
      JMP INIT0     NO
      JMP F3ER
* 
INIT0 JSB CLOS3     CLOSE SNAP FILE FOR NOW 
      CLA 
      STA ADCB3,I 
      LDA ADCB3 
      STA B 
      INB 
      JSB .MVW
      DEF P128
      NOP 
* 
      LDB N512
      STB CNT1      INITIALIZE THE OUTPUT FILE TO ZERO
INIT5 JSB WRITF 
      DEF *+5 
      DEF ODCB2+0 
      DEF IERR2+0 
      DEF SDCB3+0 
      DEF P128
* 
      SSA,RSS       ANY ERROR?
      JMP INIT8     NO
      JMP F2ER      YES , ECHO ERROR
* 
INIT8 ISZ CNT1
      JMP INIT5 
* 
EREAD LDA FATAL     ANY FATAL ERROR ? 
      SLA 
      JMP ABOR      YES , GO ABORT
* 
      SKP 
* 
*     ALL FILES OK
* 
      JSB RWNDF     REWIND LIST FILE AFTER TEST WRITE 
      DEF *+2 
      DEF LDCB4+0 
* 
      JSB FTIME     GET SYSTEM TIME 
      DEF *+2 
      DEF BUFF
* 
      LDA SLONG     ECHO THE RUN STRING 
      LDB DSTRG 
      JSB DRKEY 
* 
      JSB SPACE 
* 
      LDA P34       ECHO THE DATE AND TIME
      LDB TIMAD 
      JSB DRKEY 
* 
      JSB SPACE 
* 
      LDA P14 
      STA CONSL     ECHO TO CONSOL
      LDB DMES0 
      JSB DRKEY     OUTPUT " RTLGN - XL " 
* 
* 
      SKP 
* 
*     GET LINKING SPECIFICATION 
* 
      CLA,INA 
      STA CPL.L     DEFAULT TO CURRENT PAGE LINKING 
      JSB SPACE 
      LDA P14 
      LDB MES1      LINKING OPTION? 
      JSB DRKEY 
      JSB READ
      JMP EXIT      END OF FILE 
      LDA OP? 
      CPA LI        IS IT LINK? 
      RSS           YES 
      JMP LNKER     NO , LINK SPECIFICATION ERROR 
      JSB NAMRR     GET THE OPTIONS 
      SSA 
      JMP LNKER     END OF STRING, NO SPECIFICATION 
      CLA 
      LDB IPBUF     GET THE INPUT 
      CPB BP        IS IT BASE PAGE LINKAGE ? 
      JMP LNK30     YES 
      CPB CP        IS IT CP? 
      JMP GFMEM     YES 
      JMP LNKER     NO , USE CP AND ISSUE WARNING 
* 
LNK30 STA CPL.L     0/1 DON'T USE/ USE CURRENT PAGE LINK
      JMP GFMEM 
* 
LNKER LDA P1        DEFAULT TO CURRENT PAGE LINK
      JSB LDRER 
      JMP GFMEM 
* 
MES1  DEF *+1 
      ASC 7,* CP/BP LINK? 
* 
      SKP 
* 
*     GET FREE MEMORY 
* 
GFMEM JSB LIMEM 
      DEF *+4 
      DEF ANOP
      DEF FWFM+0    ADDRESS OF PROG'S HIGHEST WD+1
      DEF LWFM+0    # OF WORDS AFTER PROG END 
* 
      LDA LWFM      # OF WDS AFTER FREE MEMORY
      ADA N1
      ADA FWFM      FIRST WORD OF FREE MEMORY 
      STA TDBP      TOP OF DUMMY BASE PAGE
      STA CSDBP     SET CURRENT SYSTEM DUMMY BP 
      ADA N1023     ALLOW 1024 LOCATION FOR DUMMY BP
      STA LDBP      SET LOWER BOUND OF DUMMY BP 
      ADA BPFWA 
      STA CUDBP     SET CURRENT USER DUMMY BP 
      LDA LWFM      CHECK FOR OVERFLOW
      ADA N1024 
      SSA           IS IT POSITIVE? 
      JMP GTF10     NO , OVERFLOW 
      ADA FWFM      YES , ADD FIRST WD FREE MEMORY
      STA LWFM      SET LAST WORD OF FREE MEMORY
* 
      LDA N1024     ZERO OUT DUMMY BASE PAGE
      STA CNT1
      CLA 
      LDB LDBP      LOWER BOUNDS OF DUMMY BP
LP    STA B,I 
      INB 
      ISZ CNT1      ANY MORE? 
      JMP LP        YES 
* 
      JMP LSEG2     GO LOAD SEGMENT 2 
GTF10 CLA 
      JSB LDRER     PARTITION OVERFLOWED
      JMP EXIT
* 
LSEG2 LDA B101      PUT DATE AND TIME IN 101B TO 121B 
      LDB B121
      JSB SETCR 
* 
      JSB EXEC
      DEF *+3       LOAD SEGMENT 2
      DEF P8
      DEF SEG2      L20G2 
* 
      SKP 
      SKP 
* 
* 
*     LDRER OUTPUTS ERRORS TO THE LIST DEVICE 
* 
*     CALLING SEQUENCE: 
*                       A-REG = +VE ERROR CODE
*                       JSB LDRER 
*                       RETURN
* 
* 
LDRER NOP 
      MPY P3        CALCULATE OFFSET INTO LIST OF ERROR CODE
      ADA EMESS     ADD STARTING ADDRESS OF LIST
      STA B         AND SAVE IN B-REG FOR OUTPUT
      LDA P6        LENGTH OF MESSAGE IN CHARACTERS 
      JSB DRKEY     PRINT IT
      ISZ ERRCT     BUMP UP ERROR COUNT 
      JSB ASTRX     PRINT ******
      JSB SPACE 
      JMP LDRER,I   AND RETURN
* 
* 
EMESS DEF *+1 
      ASC 3,OV FIX  PARTITION OVERFLOWED
      ASC 3,LNK ER  LINK ERROR , DEFAULT TO CP LINKING
* 
      SKP 
* 
* 
*     OUTPUT CONSECUTIVE CORE LOCATIONS 
* 
*     LDA START     STARTING ADDRESS
*     LDB END       ENDING ADDRESS
*     JSB SETCR     DATA WILL BE AT BUFF0 
* 
SETCR NOP 
      STA ZTEM5    STARTING ADDRESS 
      CMA,INA       NEGATE STARTING ADDRESS 
      ADA B         ADD ENDING ADDRESS
      INA           ADD 1 FOR TOTAL # TO OUTPUT 
      CMA,INA       NEGATE FOR COUNT
      STA CNT10 
      LDA TIMAD     ADDRESS OF DATA 
      STA CNT20 
SET10 LDA CNT20,I   GET DATA
      LDB ZTEM5     GET ADDRESS 
      JSB STCR1     OUTPUT
      ISZ CNT20     NEXT DATA WORD
      ISZ ZTEM5     NEXT ADDRESS
      ISZ CNT10     ANY MORE OUTPUT ? 
      JMP SET10     YES 
      JMP SETCR,I   NO
* 
      SKP 
* 
*     CONTANTS
* 
P1    DEC 1 
P2    DEC 2 
P3    DEC 3 
P6    DEC 6 
P8    DEC 8 
P12   DEC 12
P13   DEC 13
P14   DEC 14
P34   DEC 34
P35   DEC 35
P128  DEC 128 
P150  DEC 150 
P512  DEC 512 
* 
N1    DEC -1
N6    DEC -6
N15   DEC -15 
N512  DEC -512
N1023 DEC -1023 
N1024 DEC -1024 
* 
B101  OCT 101 
B121  OCT 121 
* 
BP    ASC 1,BP
CP    ASC 1,CP
LI    ASC 1,LI
SEG2  ASC 3,L20G2 
* 
ANOP  NOP 
CNT1  NOP 
CNT10 NOP 
CNT20 NOP 
ZTEM5 NOP 
COUNT DEC 13
* 
ACENT OCT 23400 
HIMSK OCT 177400
* 
LSTER ASC 9,  FMGR -15 ON FILE
      OCT 20040 
LSTNM OCT 20040 
      OCT 20040 
      OCT 20040 
* 
DMES0 DEF *+1 
      ASC 7,* RTLGN - XL
TIMAD DEF BUFF0 
BUFF0 OCT 20040 
      OCT 20040 
BUFF  BSS 30
* 
      SKP 
* 
*      BASE PAGE COMMUNICATION VALUES 
* 
A     EQU 0 
B     EQU 1 
* 
      SPC 3 
      END L20G1