ASMB,N,R,L,C
      HED RT2/3GN -- MAIN FOR ON-LINE GENERATOR 
      IFN            ASSEMBLY OPTION "N" FOR RTE-II 
      NAM RT2GN,3,90 92001-16031 REV.1926 790430
      XIF 
      IFZ            ASSEMBLY OPTION "Z" FOR RTE-III
      NAM RT3GN,3,90 92060-16037 REV.1926 790430
      XIF 
      SPC 1 
******************************************************************
*  * (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.       *
******************************************************************
      SPC 2 
      SPC 1 
************************************************************
* 
*   NAME              RT2GN/RT3GN   MAIN FOR ON-LINE GENERATOR
*   SOURCE PART #     92001-18031 / 92060-18037 
*   REL PART #        92001-16031 / 92060-16037 
*   WRITTEN BY:       KFH, JH, RB, GAA
* 
************************************************************* 
      SPC 3 
* 
* DEFINE ENTRY POINTS.
* 
*     OPERATOR INPUT SUBROUTINES: 
* 
      ENT PROMT     PRINT COMMAND AND ACCEPT INPUT. 
      ENT READ      READ INPUT. 
      ENT RNAME     SPECIAL ENTRY TO READ SUBR. 
      ENT YE/NO     ANALYZE YES/NO RESPONSE.
      ENT DOCON     ANALYZE INPUT FOR OCTAL VALUE.
      ENT GETAL     SUPPLY CHAR FOR GETNA & GETOC.
      ENT GETNA     MOVE LBUF TO TBUF.
      ENT GETOC     LBUF CHAR FROM ASCII TO OCTAL.
      ENT GINIT     INITIALIZE LBUF SCAN. 
* 
*     DIAGNOSTIC SUBROUTINES: 
* 
      ENT GN.ER     PRINT DIAGNOSTIC. 
      ENT INERR     CALL ERROR AND CONTINUE.
      ENT IRERR     CALL ERROR AND ABORT. 
      ENT ABORT     ABORT THE GENERATION. 
* 
*     DISC FILE I/O SUBROUTINES:
* 
      ENT CRETF     CREATE A FILE.
      ENT CLOSF     CLOSE A FILE. 
      ENT CLSAB     CLOSE RTGEN OUTPUT FILE.
      ENT CHFIL     CHECK FOR FILE ERRORS.
      ENT DRKEY     WRITE ON INTERACTIVE DEVICE.
      ENT SPACE     OUTPUT BLANK LINE.
      ENT LFOUT     WRITE ONTO LIST FILE. 
      ENT RDNAM     FIND A NAM RECORD IN A FILE.
      ENT RDBIN     READ RELOCATABLE FILE.
      ENT GTERM     PURGE ALL FILES ON ABORT. 
* 
*     CORE-IMAGE OUTPUT FILE SUBROUTINES. 
* 
      ENT DISKA     INCR. DISC ADDRESS. 
      ENT DISKI     INPUT CONTROL.
      ENT DISKO     OUTPUT CONTROL. 
      ENT DISKD     I/O SUBROUTINE. 
* 
*     DCB'S:
* 
      ENT IPDCB     COMMAND FILE DCB. 
      ENT LFDCB     LIST FILE DCB.
      ENT RRDCB     RELOCATABLE FILE DCB. 
      ENT NMDCB     NEW-NAM FILE DCB. 
      ENT ECDCB     ECHO DCB
* 
*     LST, IDENT, FIX-UP SUBS AND POINTERS. 
* 
      ENT INLST,LSTS,LSTX,LSTE
      ENT TLST,PLST 
      ENT .LST1,.LST2,.LST3,.LST4,.LST5 
* 
      ENT INIDX,IDXS,IDX
      ENT TIDNT,PIDNT 
      ENT ID1,ID2,ID3,ID4,ID5,ID6,ID7,ID8,ID9,ID10,ID11 
      ENT ID12,ID13,ID14,ID15,ID16
* 
      ENT FIXX,FIX,PFIX,TFIX
      ENT FIX1,FIX2,FIX3,FIX4 
* 
      ENT LNKX,LNK,LNKS 
      ENT LNK1,LNK2,LNK3
* 
*     LINKAGES FOR SEGMENT SUBR CALLS TO ANOTHER SEGMENT. 
* 
      ENT LLOAD     "LOAD"
      EXT NLOAD 
* 
      ENT LOADS     "LOADS" 
      EXT LODER 
* 
      ENT GENIO     "GENIO" 
      EXT GNIO
      ENT FWBPL 
      EXT FWENT 
* 
      ENT DSTBL     "DSTBL" 
      EXT DSTB
      EXT DSTB5 
* 
      ENT FSECT     "FSECT" 
      EXT FSEC
      EXT FSEC5 
* 
      IFZ 
******* BEGIN DMS CODE ******** 
      ENT PARTD     "PARTS" 
      EXT PARTS 
******* END DMS CODE   ******** 
      XIF 
* 
*     POINTERS FOR CURRENT PAGE LINKAGE IMAGE AREA. 
* 
      ENT TBLNK,CPLIM 
      ENT LRBP,URBP,IRBP
      ENT LBBP,UBBP,IBBP
      ENT CUBP,UCUBP,ICUBP,CUBPA
* 
*     MISCELLANEOUS SUBROUTINES:
* 
      ENT CONVD 
      ENT LABDO,USER,USERS,SEGS,SYS 
* 
*     MISCELLANEOUS VARIABLES:
* 
      ENT NAMRC,NAMBL,NAMOF 
      ENT ERRLU,ATRCM,IACOM,TRCHK 
      ENT SWRET 
      ENT FMRR
      ENT DPRS2 
      ENT .NM.
      ENT BPARS 
      ENT OCTNO 
      ENT BUFUL 
      ENT TCHAR 
      ENT DSKAD 
      ENT ADBUF 
      ENT MAPFG 
      ENT NUMPG 
      ENT PTYPE 
      ENT TYPMS 
      ENT DSKAB 
      ENT $RNT,$PRV 
      ENT TBCHN,PIOC,SWAPF
      ENT LBUF,TBUF,LWASM,PPREL 
      ENT SDS#,CURAL,CPL2 
      ENT CMFLG 
      ENT ABCOR 
      ENT MXABC 
      ENT SETDS 
      ENT OLDDA 
      ENT ADBP,NADBP
      ENT OUBUF 
      ENT TTIME,TIME1,MULR
      ENT LWSBP 
      ENT NLCOM 
      ENT EOBP
      ENT #IREG 
      ENT CPLSB,ASKEY,SISDA,SKEYA 
      ENT P3,P4,P5,P14
      ENT M7400 
* 
      SKP 
* 
*     DEFINE EXTERNALS
* 
      EXT INPUT,LURQ
      EXT WRITF,EXEC,CLOSE
      EXT LOCF,APOSN
      EXT CREAT,OPEN,READF,CNUMD
      EXT .ENTR 
      EXT PARSE 
      EXT COR.A,RMPAR,DSETU,PTBOT 
      EXT DSET5,PTBT5 
      EXT DLRM1,DLRM7 
* 
      SPC 2 
* 
*     DEFINE A AND B REG
* 
A     EQU 0 
B     EQU 1 
      SUP 
      SPC 3 
LST#T DEC 2        # LST TRACKS.
IDT#T DEC 3        # IDENT TRACKS.
FIX#T DEC 1        # FIX-UP TRACKS. 
SECWD DEC 128      # WORDS PER SECTOR.
      SKP 
*  IDENT FORMAT 
* 
*  WORD 1: ID1 - NAME 1,2 
*  WORD 2: ID2 - NAME 3,4 
*  WORD 3: ID3 - NAME 5, USAGE FLAG (SEE BELOW) 
*  WORD 4: ID4 - COMMON LENGTH
*  WORD 5: (15): ID5 - BASE/CURRENT PAGE LINKING FLAG 
*  WORD 5: (14): ID5 - NEW NAM RECORD FLAG
*  WORD 5: (13-4): ID5 - NOT USED 
*  WORD 5: (3-0): ID5 - MAP OPTIONS 
*  WORD 6 (15): ID6 - M/S 
*  WORD 6 (08-14): ID6 - NOT USED 
*  WORD 6 (04): ID6 - SSGA (RTE-III)
*  WORD 6 (03): ID6 - REVERSE COMMON (RTE-III)
*  WORD 6 (00-06): ID6 - TYPE 
*  WORD 7: ID7 - LOWEST DBL ADDRESS 
*  WORD 8: ID8  - DISK LENGTH FOR UTILITY RELOCATABLES
*                 OR.. MAIN IDENT INDEX FOR SEGMENTS
*                 OR.. (MEU SYSTEMS) PG REQMTS (8 BITS) 
*                      THEN KEYWD INDEX (LOW 8 BITS). 
*  WORD 9: ID9 - FILE NAME 1,2
*  WORD 10: ID10 - FILE NAME 3,4
*  WORD 11: ID11 - FILE NAME 5,6
*  WORD 12: ID12 - SECURITY CODE
*  WORD 13: ID13 - CARTRIDGE LABEL
*  WORD 14: ID14 - RECORD NUMBER
*  WORD 15: ID15 - RELATIVE BLOCK 
*  WORD 16: ID16 - BLOCK OFFSET 
* 
*   USAGE FLAG BITS ARE AS FOLLOWS: 
* 
*   BIT 0  IF SET MODULE WAS LOADED 
*   BIT 1  IF SET MUST LOAD THIS MODULE (EXT DEFINED BY IT) 
*   BIT 2  IF SET THIS MODULE WAS LOADED AS PART OF A SEGMENT 
* 
* 
*  LST FORMAT 
* 
*  WORD 1: .LST1 - NAME 1,2 
*  WORD 2: .LST2 - NAME 3,4 
*  WORD 3: .LST3 - NAME 5, ORDINAL
*  WORD 4: .LST4 - IDENT  INDEX  OR 2 IF COMMON, 3 IF ABS, 4 IF REPLACE 
*  WORD 5: .LST5 - SYMBOL VALUE 
* 
* 
*  FIXUP TABLE FORMAT 
* 
*  FIX1: CORE ADDRESS 
*  FIX2: INSTRUCTION CODE 
*  FIX3: OFFSET 
*  FIX4: INDEX OF LST ENTRY REFERENCED, OR ZERO IF NONE 
* 
      SKP 
* 
*  PROGRAM TYPES (NON-MEU)
* 
*  0: SYSTEM
*  1: RT RESIDENT 
*  2: RT DISK RESIDENT
*  3: BG DISK RESIDENT
*  4: BG RESIDENT 
*  5: BG SEGMENT
*  6: LIBRARY 
*  7: UTILITY 
*  8: LOAD ONLY TO SATISFY EXTERNAL REFERENCES. 
*  9: RT RESIDENT USING BACKGROUND COMMON.
* 10: RT DISC RESIDENT USING BACKGROUND COMMON. 
* 12: BG RESIDENT USING FORGROUND COMMON. 
* 11: BG DISC RESIDENT USING FORGROUND COMMON.
* 13: BG SEGMENT USING FORGROUND COMMON 
* 14: TYPE 6 THAT IS TO BE FOURCE LOADED TO THE LIBRARY.
* 30: (MEU SYSTEM SSGA MODULE) CONVERTED TO TYPE 7. 
* 16-29,31 (MEU MODULES USING SSGA) TYPE SET TO TYPE-16.
* 15,32-99:UNUSED (TYPE + 80 IS USED TO DESIGNATE AUTO
      SPC 1 
*  PROGRAM TYPES (MEU SYSTEMS)
* 
*  0: SYSTEM
*  1: MEMORY RESIDENT 
*  2: RT DISK RESIDENT
*  3: BG DISK RESIDENT
*  4: (CONVERTED TO 9)
*  5: BG SEGMENT
*  6: LIBRARY 
*  7: UTILITY 
*  8: LOAD ONLY TO SATISFY EXTERNAL REFERENCES. 
*  9: MEMORY RESIDENT USING BACKGROUND COMMON.
* 10: RT DISC RESIDENT USING BACKGROUND COMMON. 
* 11: BG DISC RESIDENT USING FORGROUND COMMON.
* 12: (CONVERTED TO TYPE 1) 
* 13: (CONVERTED TO 5, USES SAME COMMON AS MAIN)
* 14: TYPE 6 THAT IS TO BE FOURCE LOADED TO THE LIBRARY.
* 30: SUBSYSTEM GLOBAL MODULE 
* 17,18,19,25,26,27: TYPES 1,2,3,9,10,11 (RESP.)
*                    W/ACCESS TO SSGA.
* 15,16,20-24,28,29,31-99:UNUSED (TYPE + 80 IS USED TO
*              DESIGNATE AUTO SCHEDULE AT STARTUP, BUT MAY
*               ONLY BE ENTERED IN PARM PHASE. +80 IS JUST
*               A FLAG TO PARM PHASE, NOT STORED IN ID-SEG.)
* 
* 
      SKP 
* 
*  ERROR CODES
* 
*  0: GENERATOR ERROR (SEND IN BUG REPORT)
*  1: INVALID REPLY TO INITIALIZATION PARAMETERS
*  2: INSUFFICIENT AMOUNT OF AVAILABLE MEMORY FOR TABLES
*  3: RECORD OUT OF SEQUENCE
*  4: INVALID RECORD TYPE 
*  5: DUPLICATE ENTRY POINTS
*  6: COMMAND ERROR - PROGRAM INPUT PHASE 
*  7: LST,IDENT,FIXUP TABLE OVERFLOW
*  8: DUPLICATE PROGRAM NAMES 
*  9: PARAMETER NAME ERROR
*  10: PARAMETER TYPE ERROR 
*  11: PARAMETER PRIORITY ERROR 
*  12: PARAMETER EXECUTION INTERVAL ERROR 
*  13: BG SEGMENT PRECEDES BG DISC RESIDENT 
*  14: SYS AV MEM OR BG BOUNDARY ERRORS 
*  15: ILLEGAL CALL BY A TYPE 6 PROGRAM (MAY CALL TYPE 0 AND 6 ONLY)
*  16: BP LINKAGE AREA OVERFLOW 
*  17: TYPE 1 OUTPUT FILE OVERFLOW (ESTIMATE WAS NOT LARGE ENOUGH)
*  18: MEMORY OVERFLOW
*  19: TR STACK UNDERFLOW/OVERFLOW
*  20: INVALID COMMAND INPUT LU 
*  21: '$CIC' NOT FOUND IN LOADER SYMBOL TABLE
*  22: LIST FILE ERROR
*  23: INVALID FWA BP LINKAGE REPLY 
*  24: INVALID CHANNEL NO. IN EQT RECORD
*  25: INVALID DRIVER NAME IN EQT RECORD
*  26: INVALID D, B, U, OPERANDS IN EQT RECORD
*  27: INVALID DEVICE REFERENCE NO. 
*  28: INVALID INTERRUPT REC CHANNEL NO.
*  29: INVALID INTERRUPT REC CHANNEL NO. ORDER
*  30: INVALID INT RECORD MNEMONIC
*  31: INVALID EQT NO. IN INT RECORD
*  32: INVALID PROGRAM NAME IN INT RECORD 
*  33: INVALID ENTRY POINT IN INT RECORD
*  34: INVALID ABSOLUTE VALUE IN INT RECORD 
*  35: BP INTERRUPT LOCATION OVERFLOW 
*  36: INVALID TERMINATING OPERAND IN INT RECORD
*  37: INVALID COMMON LENGTH IN SYS, LIB, OR SSGA MODULE..... 
*  38: ID-SEGMENT OF SEGMENT 3 NOT FOUND
*  39: ILLEGAL SYSTEM CALL OF TYPE 6 PROGRAM
*  40: NOT USED 
*  41: NOT USED 
*  42: NOT USED 
*  43: NOT USED 
      SKP 
********************************************************************
*                                                                  *
*     M E U     E R R O R     C O D E S                            *
*                                                                  *
********************************************************************
      SPC 1 
*   DURING DEFINITION OF PARTITIONS:
*  44: INVALID PARTITION NUMBER 
*  45: INVALID PARTITION SIZE 
*  46: INVALID PARTITION TYPE 
*  47: INVALID PARTITION RESERVE
*     USER RESPONSE TO 44 THRU 47: REENTER DESCRIPTION
*     OF PARTITION IN QUESTION AND CONTINUE.
*  53: PARTITION SIZES DON'T TOTAL AVAILABLE AREA 
*     USER RESPONSE TO 53: REDEFINE ALL PARTITIONS
* 
*   DURING ASSIGNMENT OF PROGRAMS TO PARTITIONS:
*  48: INVALID OR UNKNOWN PROGRAM NAME
*  49: INVALID PARTITION NUMBER 
*  50: PROGRAM TOO LARGE FOR PARTITION SPECIFIED
*     USER RESPONSE TO 48 THRU 50: REENTER ASSIGNMENT 
*     OR GIVE UP AND CONTINUE 
* 
*   DURING OVERRIDE OF PROGRAM SIZE REQMTS: 
*  48: (SAME AS ABOVE)
*  51: INVALID SIZE (LARGER THAN ALLOWABLE OR 
*      SMALLER THAN PROGRAM REQUIREMENT 
*     USER RESPONSE TO 48 OR 51: REENTER SIZE OVERRIDE
*     OR GIVE UP AND CONTINUE 
* 
*   DURING PROGRAM LOADING AND RELOCATION:
*  52: MODULE WITHOUT SSGA BIT IN TYPE HAS
*      EXTERNAL REF TO AN SSGA ENTRY POINT
*  54: SUBROUTINE OR SEGMENT DECLARED MORE COMMON THAN MAIN 
*     USER RESPONSE: RECOMPILE MAIN SPECIFYING MAX COMMON NEEDED
      SKP 
DBP   EQU *        FWA DUMMY BASE PAGE. 
* 
************************************************
*                                              *
* THE NEXT 1K IS OVERLAID FOR DUMMY BASE PAGE  *
* WHEN RTGN3 BEGINS EXECUTION.                 *
*                                              *
************************************************
       SPC 5
START NOP 
      STB PARMA    SAVE THE COMMAND ADDRESS 
* 
*     SET UP COMMAND LU OR FILE, AND THE ERRLU
* 
STRT1 JSB RMPAR     RETRIEVE PARAMETERS 
      DEF *+2 
      DEF PARMA 
* 
* 
STRT2 LDA PARMA     GET FIRST WORD
      SZA,RSS       IF ZERO 
      ISZ PARMA     SET TO 1 (DEFAULT TO SYS CONSOLE) 
      CLB,INB       LU'S TYPE IS 1
      AND M7400     IS INPUT AN ASCII FILE NAME?
      SZA 
      INB           YES, FILE'S TYPE IS 2 
      STB PARS2     TYPE WORD FOR PRS21,+1,+2 
      DLD PARS3     GET POSSIBLE SEC. CODE & LU 
      STA PRS31     AND SAVE
      STB PRS41 
      LDA RWSUB     GET POTENTIAL R/W SUBFUNCTION 
      STA PARS5     SAVE FOR OPEN CALL
      LDB C4040     CONVERT 0 FILL'S IN NAME
      LDA PARS2+2   TO BLANKS 
      SZA,RSS 
      STB PARS2+2 
      LDA PARS2+3 
      SZA,RSS 
      STB PARS2+3 
* 
      JSB STATE     SET THE STATE FLAGS IACOM & CMDLU 
      JMP INVLU     INVALID INPUT LU SPECIFIED - GO RECOVER 
      LDA CMDLU     IF AN INTERACTIVE LU, SET THE 
      LDB IACOM      1 MEANS INTERACTIVE
      SZB,RSS 
      CLA,INA       DEFAULT TO LU 1 
      STA ERRLU     ERROR LU
* 
      JSB FOPEN     GO OPEN FILE
      DEF *+3 
      DEF IPDCB 
      DEF PARS5 
      LDA FMRR
      SSA,RSS       ANY ERRORS? 
      JMP STRT3     NO
      CMA,INA       SET POS. FOR CONVERT
      STA FMRR
      JSB CNUMD     GET DEC ERROR CODE
      DEF *+3 
      DEF FMRR
      DEF FERMA     ERROR MESSAGE ADDR
      LDA FERMA+2   GET LAST TWO CHARACTERS 
      STA FERMA 
* 
      JSB EXEC      SEND ERROR TO OPERATOR LU 
      DEF *+5 
      DEF P2
      DEF ERRLU 
      DEF FILEA+1 
      DEF B7
STRT4 CLA           SET BACK TO LU 1
      STA CMDLU 
      STA PARMA 
      STA IACOM 
      INA 
      STA ERRLU 
      JMP STRT2     START OVER
* 
INVLU JSB EXEC      INVALID INPUT LU SPECIFIED
      DEF *+5       ISSUE ERROR MESSAGE TO LU 1 (NOW
      DEF P2         DEFAULT ERRLU) 
      DEF P1
      DEF GNR20 
      DEF P5
      JMP STRT4     SET UP THE INPUT LU 
* 
STRT3 CCA 
      ADA STKAD     RESET STACK POINTER.
      STA P:TR
      CLA 
      JSB PUSH      GO PLACE ON STACK 
      JSB GTERM     ERROR RETURN - CAN'T HAPPEN!
* 
      LDA ERRLU      WE'RE GOING TO OVERLAY 3 WORDS 
      CMA,INA 
      LDB DSTRT      AT STRT3 - IN ORDER TO SETUP 
      JSB CONVD      THE ERROR COMMAND: 
      LDA STRT3+2     "TR,ERRLU"
      STA TRCOM+2    STORE THE ASCII LU 
* 
      LDA CPLIM     NEGATE HIGH END OF CURRENT
      CMA,INA       PAGE LINK LIMIT IMAGE 
      STA CPLIM     AREA
      SKP 
* ALLOCATE SPACE FOR FIX-UP,IDENT, AND LST TABLES:
* 
*  DETERMINE HOW MUCH CORE REMAINS BEYOND LONGEST 
*  SEGMENT, DIVIDE INTO 3 BLOCKS FOR IN-CORE CHUNKS 
*  OF TABLES, AND ALLOCATE DISC SPACE FOR TABLE STORAGE.
*  AVAILABLE CORE MUST BE AT LEAST 512 WORDS. 
*  THE LST IS ALLOCATED LAST TO USE WASTED CORE FROM
*  FIXUP & IDENT BLOCKS.
* 
      LDA 1657B     ADDR OF KEYWORD TABLE.
      STA TEMP1 
TRY   LDB TEMP1,I   GET NEXT ID SEG ADDRESS 
      SZB           END OF TABLE IF ZERO
      JMP TRYY
      LDA ERR38     SEGMENT 3'S ID SEGMENT IS MISSING 
      JMP NROOM+1   SEND ERROR & TERMINATE
* 
TRYY  ADB P12       GET TO NAME.
      LDA B,I       GET FIRST TWO CHAR. 
* 
*               DYNAMICALLY DETERMINE LONGEST SEGMENT 
* 
      CPA AS.RT     "RTGN3" = LONGEST SEGMENT.
      RSS           MATCH.
      JMP NEXT
      INB 
      LDA B,I       GET SECOND TWO CHAR.
      CPA AS.GN 
      RSS           MATCH.
      JMP NEXT
      INB 
      LDA B,I 
      AND M7400 
      CPA AS.3      "3".
      JMP MATCH 
NEXT  ISZ TEMP1 
      JMP TRY 
* 
MATCH LDA TEMP1,I   GET ADDR OF IDSEG.
      JSB COR.A     GET TO LWAM OF SEGMENT. 
      INA           GET FWAM. 
      STA FWAM      SAVE AS FIRST WORD AVAIL. MEM.
      CMA,INA       GET SIZE OF UNDECLARED CORE.
      ADA LWAM      LWAM SET BY RTE.
      STA NEXT
      LDA N512      MAKE SURE ENOUGH CORE.
      ADA NEXT      AT LEAST 512 WORDS WORTH
      SSA 
      JMP NROOM     NO ROOM. BAIL OUT.
      LDA NEXT
      CLB 
      DIV P4      ALLOCATE AVAILABLE MEMORY:
      STA TEMP1   1/4 TH FOR FIXUP TABLE, AND 
      CMA,INA     3/8 TH'S EACH FOR IDENT AND LST 
      ADA NEXT
      ARS           DIVIDE BY TWO 
      STA TEMP2 
* 
* SET UP FIX-UP TABLE.
      LDA TEMP1 
      JSB TTRUN     TRUNCATE TO TRACK SIZE
SETF0 CLB 
      DIV SECWD     SEE HOW MANY SECTORS FIT. 
      STA FX.#S     SAVE # SECT PER FIX-UP BLOCK. 
      MPY SECWD     CONVERT TO WORDS FOR LENGTH.
      STA LFIX      OF DISC READS AND WRITES. 
      CLB           BLOCK MULTIPLE MUST END ON A TRACK
      LDA P6144     BOUNDARY AS WELL
      DIV LFIX
      SZB,RSS 
      JMP SETF1     OK
      LDA LFIX
      ADA N128      DECREMENT SIZE BY ONE SECTOR
      JMP SETF0 
* 
TTRUN NOP 
      CLB           TRUNCATE BLOCK SIZE 
      DIV P6144     IF GREATER THAN 6144(#WORD/TRACK) 
      SZA 
      LDB P6144     TO ONE TRACK
      STB A 
      JMP TTRUN,I 
* 
SETF1 LDA LFIX
      CLB           GET # 4 WORD ENTRIES IN 
      DIV P4        THE BLOCK.
      STA EFIX      SAVE # ENTRIES IN BLOCK.
* 
      LDA FWAM      INITIALIZE FIX-UP POINTERS: 
      STA BFIX        FIRST ENTRY,
      CLA 
      STA PFIX        # ENTRIES USED, 
      STA TFIX        CURRENT ENTRY INDEX.
      STA B.F         1ST ENTRY NOW IN CORE.
* 
* SET UP IDENT TABLE. THIS ONE HAS AN OFFSET OF +10.
* 
      LDA BFIX      SET FWA IDENT AREA AT 
      ADA LFIX
      STA BIDNT     END OF FIX-UP AREA. 
      LDA TEMP2     GET BLOCK 
      JSB TTRUN     TRUNCATE BLOCK SIZE IF NECESSARY
SETI0 CLB 
      DIV SECWD     SEE HOW MANY SECTORS FIT
      STA ID.#S 
      MPY SECWD     CONVERT TO WORDS FOR LENGTH 
      STA LIDNT 
      CLB           BLOCK MULTIPLE MUST END ON
      LDA P6144     TRACK BOUNDARY AS WELL
      DIV LIDNT 
      SZB,RSS 
      JMP SETI1     OK
      LDA LIDNT     DECREMENT BLOCK 
      ADA N128      SIZE BY ONE SECTOR
      JMP SETI0 
SETI1 LDA LIDNT 
      CLB           GET # 16 WORD ENTRIES IN
      DIV P16        THE BLOCK. 
      STA EIDNT     SAVE # ENTRIES IN BLOCK.
* 
      LDA P10       INITIALIZE IDENT POINTERS:
      STA PIDNT       # ENTRIES USED +10, 
      STA TIDNT       CURRENT ENTRY INDEX,
      STA B.I         1ST ENTRY INDEX NOW IN CORE.
* 
* SET UP LOADER SYMBOL TABLE (LST). 
* 
      LDA BIDNT     SET FWA LST AREA AT END 
      ADA LIDNT 
      STA BLST      OF IDENT AREA.
      CMA,INA       USE ALL OF REMAINING
      ADA LWAM       AVAILABLE MEMORY.
      JSB TTRUN     TRUNCATE BLOCK SIZE IF NECESSARY
SETL0 CLB 
      DIV SECWD     SEE HOW MANY SECTORS FIT. 
      STA LS.#S     SAVE # SECT PER LST BLOCK.
      MPY SECWD     CONVERT TO WORDS FOR LENGTH 
      STA LLST      OF DISC READS AND WRITES. 
      CLB 
      LDA P6144     BLOCK MULTIPLE
      DIV LLST      MUST END ON TRACK 
      SZB,RSS       BOUNDARY AS WELL
      JMP SETL1 
      LDA LLST
      ADA N128      DECREMENT BY ONE SECTOR 
      JMP SETL0 
SETL1 LDA LLST
      CLB           GET # 5 WORD ENTRIES IN 
      DIV P5        THE BLOCK.
      STA ELST      SAVE # ENTRIES. 
* 
      CLA           INITIALIZE LST POINTERS:
      STA PLST       # ENTRIES USED,
      STA TLST       CURRENT ENTRY INDEX, 
      STA B.L        1ST ENTRY NOW IN CORE. 
      SKP 
* 
* ALLOCATE DISC SPACE FOR FIX-UP, IDENT, LST. 
* 
      LDA FIX#T     GET # FIX-UP TRACKS,
      ADA IDT#T     ADD # IDENT TRACKS, 
      ADA LST#T     ADD # LST TRACKS. 
      IOR MSIGN     SET NO SUSPEND BIT
      STA NEXT      TOTAL # TRACKS TO ALLOCATE. 
* 
GETTR JSB EXEC
      DEF *+6 
      DEF P4
      DEF NEXT      # TRACKS REQUESTED. 
      DEF FTRKA     RETURNED: FIRST TRACK.
      DEF DSKLU     RETURNED: WHICH DISC. 
      DEF SECTK     RETURNED: SECTORS/TRACK.
* 
      LDA FTRKA     GET FIRST TRACK # 
      SSA,RSS       REQUEST GRANTED?
      JMP ALLOC     YES 
      JSB SPACE 
      JSB EXEC      NO, TELL USER OF PROBLEM
      DEF *+5 
      DEF P2
      DEF ERRLU 
      DEF TRMSG 
      DEF P14       "GENERATOR WAITING FOR TRACKS"
* 
      LDA  NEXT      TAKE OUT NO-SUSPEND BIT
      XOR MSIGN 
      STA NEXT      SUSPEND UNTIL TRACKS ARE AVAILABLE
      JMP GETTR 
* 
* 
SETB  NOP 
      CLE,ELA       MPY BY 2 (64-WORD SECTORS)
      CLB 
      DIV SECTK     FIND MULT. FACTOR PER WRITE 
      SZB,RSS       IF A TRACK MULTIPLE 
      LDB P96       THEN SET IT SO
      JMP SETB,I    # 64-WORD SECTORS PER BLOCK 
* 
* 
ALLOC LDA FX.#S     GET # 128 WORD SECTORS. 
      JSB SETB
      STB FX.#S     SET # 64 WORD SECTORS PER BLOCK.
      LDA ID.#S 
      JSB SETB
      STB ID.#S 
      LDA LS.#S 
      JSB SETB
      STB LS.#S 
* 
      LDA FTRKA 
      STA FX.BT     FIX-UP START TRACK. 
      STA FX.LT     FIX-UP TRACK LAST READ. 
      ADA FIX#T 
      STA FX.ET     FIX-UP LAST TRACK +1. 
      STA ID.BT     IDENT START TRACK.
      STA ID.LT     IDENT TRACK LAST READ.
      ADA IDT#T 
      STA ID.ET     IDENT LAST TRACK +1.
      STA LS.BT     LST START TRACK.
      STA LS.LT     LST TRACK LAST READ.
      ADA LST#T 
      STA LS.ET     LST LAST TRACK +1.
      CLA 
      STA FX.LS 
      STA ID.LS 
      STA LS.LS 
      SKP 
* 
*     GET NAME, SECUR, LABEL OF LIST FILE.
* 
FNAME LDA P10       "LIST FILE?"
      LDB LSTFI 
      JSB RNAME     GET LIST FILE 
      JSB CRETF     GO CREATE THE FILE
      DEF *+5 
      DEF LFDCB 
      DEF P64 
      DEF P3
      DEF ZERO
      JSB CHFIL     CHECK FILE STATUS 
      JMP FNAME     ERROR 
      ISZ LFERR      1=> ACKNOWLEDGE LIST FILE ERRORS 
* 
      DLD PARS2     WAS NAME A FILE OR LU?
      CPA P1
      RSS 
      JMP FLNM0     FILE NAME, SO DEFAULT TO LSTLU=0
      STB LSTLU     SAVE THE LU - MAY NOT BE INTERACTIVE
      JSB EXEC      DETERMINE THE DEVICE TYPE 
      DEF *+5 
      DEF P13 
      DEF LSTLU 
      DEF EQT5
      DEF FNAME     SAVES A LINK TO EQT4!!
* 
      CLB 
      LDA FNAME     IF BIT BUCKET WAS SPECIFIED,
      AND M77       DON'T MISTAKE IT FOR A TYPE 
      SZA,RSS       00 DEVICE 
      JMP SETIA 
* 
      LDB LSTLU 
      LDA EQT5      INTERACTIVE DEVICES ARE TYPE 0, OR
      ALF,ALF        TYPE 5, SUBCHANNEL 0 
      AND M77 
      STA EQT5
      CPA P5
      JSB LUSUB      GET TYPE 5 SUBCHANNEL
      CLB 
      SZA,RSS 
      INB            SET INTERACTIVE
SETIA STB IALST      0=NOT INTERACTIVE, 1=IT IS 
* 
      SZB           IF ITS INTERACTIVE
      JMP EC?       THEN DON'T LOCK 
LULOC JSB LURQ
      DEF *+4 
      DEF IOPTN 
      DEF LSTLU 
      DEF P1
* 
      SZA,RSS       WAS IT SUCCESSFUL?
      JMP EC?       YES 
      JSB SPACE 
      JSB EXEC
      DEF *+5 
      DEF P2
      DEF ERRLU 
      DEF LUMSG 
      DEF P17       "GENERATOR WAITING ON LIST LU LOCK" 
* 
      LDA IOPTN     SET THE WAIT BIT FOR NEXT CALL
      XOR MSIGN 
      STA IOPTN 
      JMP LULOC 
* 
* RE-OPEN THE LIST FILE WITH A NON-EXCLUSIVE OPEN SO IT CAN 
* BE EXAMINED CONCURRENT WITH GENERATION
* 
FLNM0 JSB OPEN      A CALL TO OPEN AN ALREADY 
      DEF *+7       OPEN FILE WILL RESULT 
      DEF LFDCB     IN IT BEING CLOSED AND
      DEF FMRR      RE-OPENED WITH THE OPTIONS
      DEF PARS2+1 
      DEF P1
      DEF PARS3+1 
      DEF PARS4+1 
      JSB CHFIL 
      JMP FLNM0 
* 
* ASK WHETHER ECHO IS DESIRED 
* AND OPEN IT IF SO 
* 
EC?   LDA P5
      LDB ECHOI 
      JSB YE?NO 
      JMP EC?       INVALID REPLY 
      STA ECHON     1 FOR YES, 0 FOR NO 
* 
      CLA,INA       SET UP FOR CREATION 
      STA PARS2     OF DUMMY DCB IN TYP0
      LDA ERRLU 
      STA PARS2+1   LU ALREADY DETERMINED 
      JSB FOPEN 
      DEF *+3 
      DEF ECDCB 
      DEF RWSUB 
* 
      JSB CHFIL 
      JSB GTERM 
      RSS           SKIP
* 
* GET SIZE, NAME, SECUR, LABEL OF CORE-IMAGE RTE OUTPUT FILE. 
* 
      JSB INERR     INPUT ERROR 
EST#  JSB SPACE 
      LDA P30 
      LDB FISIZ     "EST. # TRACKS IN OUTPUT FILE?" 
      JSB READ
      LDA N3
      JSB DOCON     GET BINARY. 
      JMP EST#      ERROR. TRY AGAIN. 
      STA NEXT
      ADA MIN10     CHECK FOR 10 TRACKS MIN.
      SSA 
      JMP EST#-1
      LDA NEXT
      MPY P48       GET # BLOCKS. 
      SSA           IF NEGATIVE THEN RETRY
      JMP EST#-1
      STA NEXT
* 
FLNAM JSB SPACE 
      LDA P17 
      LDB OUTFI 
      JSB RNAME     "OUTPUT FILE NAME?" 
* 
      LDA PARS2     CHECK FOR NUMERIC OR NULL ANSWER
      CMA,INA,SZA   IF NULL(TYPE 0) 
      INA,SZA,RSS   OR NUMERIC(TYPE 1)
      RSS 
      JMP FLNMC     THEN ITS A LU 
      JSB INERR 
      JMP FLNAM 
* 
FLNMC JSB CRETF     GO CREATE THE OUTPUT FILE 
      DEF *+5 
      DEF ABDCB 
      DEF NEXT      # BLOCKS. 
      DEF P1        TYPE 1 FILE.
      DEF ZERO
      JSB CHFIL     CHECK FILE ERROR
      JMP FLNAM     RETRY...ERROR 
* 
* GET TARGET DISK TYPE
* 
      JSB SPACE 
      RSS 
      JSB INERR     INPUT ERROR TO "TARGET DISK?" 
STRT0 LDA P12       TO GET THE INITIAL SEGMENT
      LDB MES00     DEPENDS ON THE DISK TYPE
      JSB READ      MES00: "TARGET DISK?" 
      LDA N4
                                                                                                                                                                                                                                        