         TITLE    'SYSGEN WRITEMON FOR DEF'
*M*      UTMBPMBT WRITE UNLABELLED PORTION OF PO/BO TAPE
*P*      NAME: UTMBPMBT
*P*      PURPOSE: WRITE UNLABELLED PORTION OF BO/PO TAPE
*P*      DESCRIPTION: UTMBPMBT WRITES A TAPE BOOTSTRAP AND INITIALIZATION
*P*       PROCESSORS PLUS MONITOR TO PO/BO TAPE. THE PROCESSORS (M:MON,
*P*       XDELTA,ALLOCAT,FIX,GHOST1,RECOVER) ARE OBTAINED FROM THE :SYS
*P*       (BO) OR RUNNING (PO) ACCOUNT. NONE MAY CONTAIN MISSING PAGES
*P*       IF LOADED IN EXTENDED MEMORY MODE (NO RES > 511 WORDS).
         SYSTEM   BPM
         SYSTEM   SIG7FDP
********
*  EXTERNAL DEFS
********
         DEF      UTMBPMWRITEMON
********
*  EXTERNAL REFS
********
         REF      M:TM
         PAGE
********
*  REGISTERS
********
R0       EQU      0
R1       EQU      1
R2       EQU      2
R3       EQU      3
R4       EQU      4
R5       EQU      5
R6       EQU      6
R7       EQU      7
SR1      EQU      8
SR2      EQU      9
SR3      EQU      10
SR4      EQU      11
D1       EQU      12
D2       EQU      13
D3       EQU      14
D4       EQU      15
********
         PAGE
************************************************************************
*  THIS ROUTINE IS ENTERED FROM PASS1 & DEF WHEN AN OUTPUT TAPE IS TO BE
*    GENERATED. PASS1 GENERATES BO, & DEF GENERATES PO. WRITEMON WILL
*    OBTAIN THE M:MON LOAD MODULE FROM THE CURRENT ACCOUNT(FOR A DEF) OR
*    THE SYSTEM (:SYS) ACCOUNT(FOR A PASS1 SYSWRT) & THEN WRITE A
*    BOOTSTRAP & THE MONITOR (IN ABS) TO THE OUTPUT TAPE.
*
*        ENTRY:
*           (R6) = OPEN TM PLIST PARAM LIST CONTROL WORD
*           (R7) = ADDRESS OF M:BO/M:PO DCB FOR WRITING TAPE
*          (SR1) = VERSION # IN EBCDIC
************************************************************************
UTMBPMWRITEMON  EQU  %
         STW,R7   D1                SAVE FOR FUTURE USE(OUTPUT DCB ADDR.
         STW,SR1  VERSION           SET VERSION # IN RECORD
         PSW,SR4  *R0
         M:GP     255      ***      GET SOME WORK AREA
         STW,9    BUFFER            SAVE BUFFER ADDRESS
         LI,9     X'FF'
         STS,8    FP                SAVE # TO RELEASE
         SLS,8    11                SIZE IN BYTES
         LI,7     X'10000'          SET ACCOUNT IN OPEN FPT
         STS,6    FCTL
         CAL1,1   OPTAP             OPEN OUTPUT DEVICE
         M:DEVICE *D1,(BIN),(PACK)
         M:DEVICE *D1,DRC
         LD,6     MONTXT            SET FILE NAME
         STD,6    FNAME
         LI,9     MONTXT            AND ERROR NAME ADDRESS
         CAL1,1   OPNTM             OPEN M:MON
EJECT    M:DEVICE M:LL,(PAGE)
         EXU      UPSPACE
*
* READ M:MON HEAD
*
,SETTM   M:SETDCB M:TM,(ABN,RER),(ERR,RER)
         M:READ   M:TM,(ERR,RER),(ABN,RER),(BUF,*BUFFER),;
                  (SIZE,2048),(KEY,HEAD),WAIT
         LW,2     BUFFER
         LI,7     X'1FFFF'          GET MONITOR ENTRY ADDRESS
         LW,6     1,2
         STS,6    STMONMTB          AND PUT IN BOOTSTRAP
         CAL1,1   RTREE             READ TREE TO GET SIZE OF TOOR
         LCI      3
         LM,3     1,2               SAVE ROOT NAME FOR SYMGEN
         STM,3    RKEY
         LW,1     6,2
         MTH,-1   1                 DEC SIZE BY ONE DW
         MTB,1    1                 INC SIZE BY ONE PG
         LB,6     1
         STS,6    MTBOOT            #RECORDS FOR BOOT TO READ
*        WRITE    BOOTSTRAP
         LI,15    MTBOOT            SET BUFFER ADDRESS
         CAL1,1   WRTD1
         LW,15    BUFFER            SET BUFFER ADDR FOR M:MON COPY
*
* READ M:MON ROOT (MON::ORG)
*
         AI,15    90                START FIRST WRITE AT X'5A'
RMON     M:READ   M:TM,(ERR,RER),(ABN,RER),(BUF,*BUFFER),(SIZE,2048),;
                  (KEY,MONKEY),WAIT
*
* WRITE M:MON ROOT TO BO/PO
*
WMON     CAL1,1   WRTD1
         MTW,1    MONKEY
         LW,15    BUFFER
         BDR,6    RMON
         STS,6    MONKEY            ZAP KEY
         STW,6    SYMBSZ
         STW,6    SEGCNT
         STW,6    #PATCHES
         STW,6    OLDSEG
         STW,6    SEGN
*
* GET TIME & DATE
*
         M:TIME   TIMEDATE
         BAL,11   SYMGEN            BUILD M:MON SYMTAB
         CAL1,1   WRTSMB            WRITE IT
         LI,11    SYMN-SYMP         TURN OFF LDEFS
         AWM,11   SYMLCK
*        NOW READ THE TREE AND GENERATE NAMES OF OVERLAYS TABLE
,RTREE   M:READ   M:TM,(ERR,RER),(ABN,RER),(BUF,0),(SIZE,*8),;
                  (KEY,TREE),WAIT
BUFFER   EQU      RTREE+4
,CLOSETM M:CLOSE  M:TM,SAVE
         LI,1     12                START WITH THE FIRST ENTRY
         LI,4     #SPROCS           PUT SHARED PROCESSORS FIRST
         LD,6     NONOVS,4
         STD,6    *BUFFER,4
         BDR,4    %-2
         LW,2     BUFFER
         AI,2     #SPROCS*2+2
VMASK    EQU      %                 5 HEX DIGITS AND POSITIVE
         LI,4     -1                SET FLAG ST CURRENT END OF TABLE
         STW,4    0,2
GTAB1    LCI      2                 GET THE NEXT NAME
         LM,6     *BUFFER,1
         AI,1     5                 AND SIZE FOR LATER COPY
         LI,11    ' '               ZAP GARBAGE
         LB,4     6
         AI,4     -7
         BGEZ     %+2
         STB,11   8,4
         BIR,4    %-1
         LW,4     *BUFFER,1         CALCULATE SIZE OF SEGMENT
         MTH,-1   4
         MTB,1    4
         SLS,4    -24
         LW,11    1                 SAVE SEG# FOR COPY KEYS
         DW,11    ELEVEN
         STB,4    11                SAVE SIZE TOO SO WE NEEDNT READ TREE
         PSW,11   *0                SAVE FOR LATER COPY
         LW,4     2                 CHECKK FOR ALFANUMERIC POSITION
         SLS,4    2
         LW,5     GTABCBS
         CBS,4    1
         BL       TREER             OUT OF ORDER
         LW,3     2                 MOVER THE REST DOWN
GTAB4    AI,3     2
         XW,7     -1,3
         XW,6     -2,3              UNTIL THE NEGATIVE ONE
         BGZ      GTAB4
         STW,6    -0,3              RESTORE FLAG
         AI,1     11-5              TO NEXT ENTRY
         CW,1     *BUFFER           ARE WE DONE
         BL       GTAB1             NO.
         LD,4     XRECVR            PUT RECOVER AT END OF LIST
         STD,4    *3
         AI,3     2+3               3 EXTRA FOR PREVIOUS ENTRY
*                                   SO SEGNO STARTS AT ZERO
         STW,3    BUF               SAVE ADDR FOR WRITE
         STW,3    FRSTSEG           SAVE ADDRESS FOR PATCH ORDERING
         MTW,3    FRSTSEG
         STW,3    LASTSEG           INITIALIZE CURRETN SEGN
         SW,3     BUFFER            CALCULATE # OV ENTRIES
         SLS,3    -1                # OF NAMES+2 (0TH AND DUMMY SYMBOL)
         AI,3     #SPROCS*2-1-2     EACH GHOST HAS 2 MORE EXCEPT ALLOCAT
         MI,3     3                 EACH ENTRY IS THREE WORDS
         AW,3     BUF               ADDRESS OF END OF SEGNAME SYMBOLS
         LW,4     3
         AI,4     M7-M1+1           POINT TO END OF FIXED PART
         LI,R1    M1-M7-1           SIZE OF FIXED PART
         LW,R2    M7,R1
         STW,R2   *R4,R1
         BIR,R1   %-2
         LW,7     BUF               ADDRESS OF SEGNAME TABLE
         STW,1    -2,7              INITIALIZE SEGNO
         STW,1    -3,7              BOTH OF THEM
         LCI      6
         PSM,8    *0
         LCI      6
         LM,9     -6,4              GET CANNED MSG IN REGS
         LI,5     0                 START WITH DATA INDEX
LOOP     AI,1     1                 TO NEXT LM NAME
         LD,10    *BUFFER,1         GET TEXT
         BEZ      ENDNAMES          DONE
         LW,8     5                 SET CSECT#
         LW,13    KEYS+1,5          GET PROPER TEXT
         LI,2     #SPROCS           SPECIAL NAMES FOR SHARED PROCESSOR
         CD,10    NONOVS,2          RECORDS
         BE       %+2,2
         BDR,2    %-2
         B        NOTGHOST
         B        PT01
         B        PT021
         B        PT021
PT01     BDR,5    LOOP+1            SKIP DCBS IF ALLOCAT
         AI,5     1                 RESTORE 5 IF NOT
PT021    LB,5     RECVEC,5          GET NEXT
         BEZ      %+3               NO MORE
         AI,1     -1                NO, REPEAT SAME NAME
         AI,5     -2                CONVERT TO NEW INDEX
         SLS,5    -1
         AI,8     '0'               SET TEXT IN 8
         STW,7    MIDSEG            SAVE ADDRESS OF LAST GHOST NAME
         MTW,3    MIDSEG
NOTGHOST LB,2     10
         AI,2     -8                SET TO PAD WITH ZEROES
         SLD,10   8                 SCRUB BYTE COUNT
         STB,8    12,2
         OR,10    M1                PUT IN BLANK FOR THERECORD
         OR,11    M1
         LCI      6
         STM,9    0,4               PUT IT AWAY
         MTW,1    *3                COUNT MESSAGES
         AI,4     6                 TO NEXT
         STB,8    12,2              NOW ZERO PAD FOR DELTA
         LI,8     0                 SET VALUE OFR OVERLAY NAMES
         BIR,2    %-2
         LW,8     -3,7              GET PREVIOUS VALUE
         AI,8     1                 MAKE NEW
         STW,8    0,7
         STM,10   1,7               CC=2 FROM AI,8 1
         AI,7     3
         B        LOOP
ENDNAMES EQU      %
         SW,7     BUF               SIZE OF STMBOL TABLE PIECE
         AWM,7    SYMBSZ            ACCUMULATE SIZE
         SLS,7    2
,WRTSMB  M:WRITE  M:TEMP,(BUF,0),(SIZE,*7),WAIT
BUF      EQU      WRTSMB+2
M:TEMP   DSECT    2
M:TEMP   M:DCB    (FILE,'X'),OUTIN,REL,CONSEC
         USECT    UTMBPMWRITEMON
         LCI      6
         PLM,8    *0
         LI,R1    M7-ENDINFO        PUT TAIL OF RECORD
         AI,R4    ENDINFO-M7
         LW,R2    ENDINFO,R1
         STW,R2   *R4,R1
         BIR,R1   %-2
         SW,R4    R3                RECORD SIZE
         SLS,R4   2                 BYTES
*
* WRITE CREATION DATA RECORD
*
         LW,D4    R3                SET BUFFER ADDRESS
,WRTD1   M:WRITE  *D1,(BUF,*D4),(SIZE,2048),(WAIT)
         AI,R4    -8                TWO UNPRINTABLE WORDS
         LW,R2    MSGTXTC
         STW,R2   0,R3
         M:PRINT  (MESS,*R3)        PRINT
         AI,R3    MSZ
         AI,R4    1-4*MSZ
         BDR,R4   %-4
         EXU      EJECT
         LW,9     BUFFER            RESTORE BUFFER ADDRESS
         SLS,SR1  -2
         AW,SR1   SR2
         SW,SR1   D4                ADJUST BUF SIZE
         SLS,SR1  2
*
*   NOW WRITE THE MODULES TO PO
*
         LD,2     XDLTT             STICK XDELTA IN TOO
         STD,2    *9
         AI,8     -32               BUILD SYMBOLS WITH HEAD IN CORE
NXTULBL  LD,2     *9
         STD,2    FNAME
         BEZ      *11               ALL DONE
         LI,4     0                 SET SEGN FOR NON OVERLAY
         LI,5     #NONOVS
         CD,2     NONOVS,5
         BE       %+5
         BDR,5    %-2
         LD,4     MONTXT            OVER LAY..OPEN M:MON
         STD,4    FNAME
         PLW,4    *0                GET SEG# AND SIZE
         LI,7     X'85'             AND BUILD A HEAD
         STB,7    *15
         STH,4    SEGN
         LI,7     3
         LI,6     X'4000'
         STH,6    3,7               SET BIAS ALSO
         STW,4    *15,7
         LI,6     X'8000'           SET START ADDRESS
         LI,7     1
         STW,6    *15,7
         CAL1,1   OPNTM             OPEN THE FILE
         CAL1,1   SETTM             SET TO READ ABN/ERR
         STD,2    RKEY              SET KEY FOR SYMTABS
         SLD,2    8
         STW,2    PSYMF             PUT NAME IN MEESSAGE
         STW,3    PSYMF+1
*
*   READ HEAD
*
         BIR,5    %+2               NO HEAD IF OVER LAY
         M:READ   M:TM,(ERR,RER),(ABN,RER),(BUF,*D4),(SIZE,*SR1);
                  ,(KEY,HEAD),(WAIT)
         AI,15    8                 BUILD SYMBOLS FOR THIS LM
         BAL,11   SYMGEN
         AI,15    -8
         CI,9     X'1FF'            IF NOT XDLT, PRINT SYMS
         BAZ      %+4
         M:PRINT  (MESS,PSYM)
         BAL,5    SORTNUM           NUMERICALLY
         BAL,5    PRNTSYMS
         LB,2     *15
         LI,14    X'7FFFF'          LARGE POS
         CI,2     X'85'             SET NEG IF 85 TYPE
         BNE      %+2
         LI,14    X'80000'
         LW,2     15                HEAD ADDRESS
         STW,7    7,2               SAVE SYMTAB SIZE
         LD,4     *9                IF PROCESSOR, USE HEAD AS IS
         LI,1     #SPROCS
         CD,4     NONOVS,1
         BE       NOZAP
         BDR,1    %-2
         XW,1     3,2               ZAP/GET DATA
         STW,1    4,2               BECOMES PP
ZAPDCBS  LI,1     0
         STW,1    6,2
NOZAP    LW,1     4,2               PRCD IS DATA EXISTENCE FLAG
         LW,3     6,2               DCBS
         LW,2     3,2               DATA IS PRCD EXISTENCE FLAG
         BEZ      %+2
         XW,2     1
         LCI      3
         STM,1    HEADDAT           SAVE FOR WRITE
         LW,13    15                SAVE BUFFER ADDRESS
         CI,9     X'1FF'            IF THIS IS XDELTA, ADD SYMTABSZ TO HEAD
         BANZ     WHEAD             IT ISNT
         CAL1,1   WRTSMB            SAVE XDELTA SYMTAB
         M:PFIL   M:TEMP,BOF        START READING AT BEGINNING
         AI,15    8                 DONT CLOBBER HEAD READING DATA
         B        GPROT             GET DATA TO FIGURE HOW BIG IT WILL  BE
WHEAD    LW,7     HEADDAT           IF THIS IS AN OVERLAY, MUST BE <6 PG
         CI,7     X'BFFF'           CHECK BIAS=4000
         BANZ     HOK               MUST BE SUMMIT ELSE
         MTB,-7   7                 CHECK SIZE..MIGHT BE UMOV
         BNC      HOK               <6 PGS..IS REGULAR OVERLAY
         AI,7     X'700'            ADJUST BIAS FOR UMOV
         STW,7    HEADDAT
         LI,6     4                 AND IN OUTPUT HEAD RECORD
         STW,7    *15,6             FOR BOOTSUBR
         LD,6     *9                CHECK NAME IN CASE OF BAD OVERLAY
         MTB,-4   6                 FOUR BYTE NAME
         BNE      BADOV
         SLD,6    8                 PUTEM ALL IN ONE WORD
         CW,6     UMOVT
         BNE      BADOV             BADDIE
HOK      RES
         CAL1,1   WRTD1
GPROT    EQU      %
         LB,2     RKEY              GET SIZE
         LI,3     3                 START WITH DATA
WPROT    STB,3    RKEY,2            SET CODE IN KEY
         SLS,3    1                 IS THERE ANYTHING TO WRITE
         AI,3     -6
         LB,6     HEADDAT,3         # PAGES TO WRITE
         BEZ      NXTREC            NO
*
*  READ RECORD
*
         BDR,14   RPROT             READ IF NOT 85 TYPE
         LW,5     3                 GEN 85 KEY
         AI,5     2
         LB,5     HEADDAT,5
         MTB,3    5
         OR,5     SEGN              SET SEG# FOR OVERLAYS
         STW,5    RKEY
RPROT    M:READ   M:TM,(ERR,RER),(ABN,RER),(BUF,*15),(SIZE,*8),;
                  (KEY,RKEY),WAIT
WPAGE    CI,9     X'1FF'            IF WRITING XDELTA, DO SYMTAB
         BANZ     WPAGE2            NOT, SO JUST WRITE
         LW,4     15                GET BUFFER ADDR IN INDEX REG
         CB,6     HEADDAT,3         IS THIS FIRST PAGE
         BE       WPAGE1            YES, UPDATE AND WRITE HEAD
         CI,6     1                 IS THIS THE LAST PAGE
         BNE      WPAGE2            NO, JUST WRITE IT
         AND,7    M9                GET DISP INTO PAGE OF SYMBOLS
         AW,7     4                 ADD BUFFER ADDRESS
         LW,6     SYMBSZ            GET TOTAL SIZE TO READ
         SLS,6    2
         STW,7    BUF               SAVE STRART FOR OUTPUT
         M:READ   M:TEMP,(BUF,*7),(SIZE,*6),WAIT
         SLS,7    2
         AW,7     M:TEMP+13
         SLS,7    -2
         SW,6     M:TEMP+13         DECREMENT SIZE
         BGZ      %-5               STILL MORE TO READ
         STW,7    ESYMS             SAVE END
         M:PRINT  (MESS,SYMM)
         BAL,5    SORTALF
         BAL,5    PRNTSYMS
         M:PRINT  (MESS,BYVALUE)
         BAL,5    SORTNUM
         BAL,5    PRNTSYMS
         AW,7     MINSYMS           INSURE ENOUGH EXTRA SYMBOLS
         CAL1,1   WRTD1             NOW START WRITING IT
         AI,15    512               A PAGE AT A TIME
         CW,15    7                 UNTIL THERE IS NO MORE
         BL       %-3
         B        WPAGE2+1          DONT WRITE ANOTHER
WPAGE1   LW,7     2,4               ADDRESS OF NEXT SYMBOL SLOT
         AW,7     SYMBSZ            ADD SIZE OF OUR STUFF
         XW,7     2,4               AND SET NEW NEXTSYM
         LW,5     2,4               GET NEW NEXT
         AW,5     MINSYMS
         CI,5     X'10000'          ARE WE STILL IN 64K
         BG       BADXD             NO, MUST GIVE UP
M9       AI,5     X'1FF'            SET UPPER LIMIT OF SYMBOLS
         AND,5    M8X9              ROUND UP TO NEXT PAGE
         STW,5    3,4               PUT IN CODE
         MTW,-3   3,4               POINT TO LAST GOOD ONE
         SW,5     2,4               CALCULATE REMAINING SPACE
         STW,5    #SYMS             SAVE FOR MESSAGE
         AW,5     2,4               RESTORE END ADDRESS
         INT,11   -8+4,4            GET DATA BIAS
         SLS,5    -1
         SW,5     11                DWD SIZE OF DATA NOW
         STH,5    11
         STW,11   -8+4,4            PUT BACKIN HEAD
         AI,15    -8                AND WRITE THE HEAD
         CAL1,1   WRTD1
         AI,15    8
WPAGE2   CAL1,1   WRTD1             WRITE A PAGE
         BDR,14   NOT85             NO MORE READING IF NOT 85
         MTW,1    RKEY              INCREMENT 85-TYPE KEY
         BDR,6    RPROT
NOT85    AI,15    512               WRITE IT OUT IN PAGE RECORDS
         BDR,6    WPAGE
         LW,15    13                RESTORE BUFFER ADDRESS
         MTW,-3   SEGCNT            CHECK SKIP FLAG
         BGZ      NXTREC            STILL SKIPPING
         PSW,8    *0                SAVE BUFFER SIZE
RPATCH   LW,1     ZAPBUF            INITIALIZE BUFFER
         MBS,0    BA(PBUF)+1
         LB,11    ASTBANG           PUT * OR BANG IN IT
         STB,11   PBUF+1            IN CASE THERE IS NO INPIUT
         M:READ   M:PATCH,(ABN,PABN),(ERR,PABN),WAIT
         LH,8     PBUF+1
         CI,8     '<<'
         BE       RPATCH
PABN     M:WRITE  *12,(BUF,PBUF+1),(SIZE,80),WAIT
         MTW,1    #PATCHES          COUNT EM
         LB,7     PBUF+1            GET FIRST CHARACTER
         LB,1     PSTART            CHECK START CHARS (NON-SEGNO-TYPES)
         CB,7     PSTART,1
         BE       RPATCH            GOT ONE, GO TO NEXT PATCH
         BDR,1    %-2
         CB,7     ASTBANG           IS IT TERMINATOR TYPE
         BE       PEXT0             YES, GET OUT
         CI,11    '*'               IS THIS GENMD PORTION
         BNE      RPATCH            YES, JUST COPY UNTIL BANG
         SD,4     4                 NO, GET SEGNO TEXT IN 4-5
         LI,1     -8                MAX 8 CHARS
         LB,7     PBUF+3,1
         CI,7     '/'               ARE WE DONE BUILDING IT
         BE       %+3               YES
         STB,7    6,1
         BIR,1    %-4
         LW,1     FRSTSEG           ADDRESS OF FIRST SEGNAME
         CW,4     -2,1              IS THIS IT
         BNE      %+3
         CW,5     -1,1              MEBBE
         BE       %+4               YES, IS IT AT LEAST AS BIG AS THE LAST
         AI,1     3                 TO NEXT KNOWN ONE
         CW,1     15                ARE WE DONE
         BLE      %-6               NO
         CW,1     15                SET BIG SEGNAME IF RECOVER
         BNE      %+2
         SAD,4    -63               ALL ONES
         CW,1     MIDSEG            SET SMALL SEGNAME IF ALLOCAT/GHOST1
         BG       %+2
         STD,1    4
         LW,7     CHKSEG            COMPARE NEW WITH OLD
         CBS,7    BA(OLDSEG)-4*4
         STD,4    OLDSEG            SET NEW OLDSEG
         BG       BADPATCH          OLD IS BIGGER
         CW,1     15                IS THIS KNOWN NAME
         BG       RPATCH            NO, KEEP COPYING
         B        PEXT
PEXT0    MTB,-2   ASTBANG           SET NEXT
         CI,7     '*'               IF NOT *, MUST BE ALL DONE
         BNE      PEXT1
         LW,1     15                SET LAST SEGNAME
PEXT     SW,1     LASTSEG           CHECK ORDER OF PATCHES
         BE       RPATCH            SAME, KEEP COPYING
         AWM,1    LASTSEG           SET NEW LAST ONE
         STW,1    SEGCNT            AND SET SKIP COUNT
PEXT1    PLW,8    *0
         B        NXTREC
M:PATCH  DSECT    2
M:PATCH  M:DCB    FILE,(ERR,PABN),(ABN,PABN),IN,PASS,(SN,3),;
                  (BUF,PBUF+1),(RECL,80)
         ORG      M:PATCH+22
         DATA,1   1,0,2,8
         TEXTC    'PATCH'
         USECT    UTMBPMWRITEMON
SEGCNT   DATA     0                 INITIAL SKIP COUNT
ASTBANG  DATA,1   '*',,,
#PATCHES DATA     0                 # OF PATCHES READ
#SYMS    RES      1
MINSYMS  DATA     20*3              INSURE AT LEAST 20 SLOTS
PSTART   TEXTC    '/<:#'
LASTSEG  DATA     0
FRSTSEG  DATA     3                 ADDRESS OF (END OF) FIRST NAME
MIDSEG   DATA     15                ADDRESS OF GHOST11'S NAME
CHKSEG   DATA,1   8,,,4*4           CBS POINTER TO CHECK SEGN ORDER
         BOUND    8
OLDSEG   DATA     0,0               MOST RECENT SEGNAME
NXTREC   SLS,3    -2
         LB,3     RECVEC,3          GET NEXT KEY #
         BNEZ     WPROT             NOT DONE YET
NOGHOST  CAL1,1   CLOSETM
         AI,9     2
         BAL,11   NXTULBL           RETURN IF DONE
         LW,5     #PATCHES          PRINT # PATCH PUT OUT
         LI,10    PMESS
         BAL,11   PRTDEC
         LW,5     #SYMS             PRINT AMOUNT OF SYMBOL SAPCE
         DW,5     THREE             IN SYMBOLS
         LI,10    SMESS
         LI,11    UBTX
PRTDEC   EQU      %
         LI,3     '0'
         LI,2     10                INDEX INTO MESSAGE
PDIV     LI,4     0                 CONVER T TO EBCDIC
         DW,4     TEN
         STS,3    4                 SET EBCDIC CODE
PDOT     STB,4    *10,2
         BEZ      %+2               LEAVE PADDING
         BDR,2    PDIV
         LI,4     '.'               FILL UP WITH .S
         LCI      0
         BDR,2    PDOT
         M:PRINT  (MESS,*10)
         B        *11
UBTX     EQU      %
,FP      M:FP     0                 RELEASE WORK AREA
         MTB,4    ASTBANG           RESTORE DATA
         LI,11    SYMP-SYMN
         AWM,11   SYMLCK
         M:CLOSE  M:TEMP
         M:CLOSE  *D1,(SAVE)
         PLW,SR4  *R0
         B        *SR4    <<->>     RETURN
************************************************************************
         PAGE
**********************************************************
*        SUBROUTINE FOR SYMBOL TABLE GENERATION
**********************************************************
SYMGEN   EQU      %
*        M:TM IS OPEN TO FILE WITH SYMBOLS TO GEN
*        BAL,11   SYMGEN
*        BUFFER ADDR IN 15, SIZE IN BYTES IN 8
         MTB,1    RKEY              GEN RFDF KEY
         LB,3     RKEY
         LI,2     0
         STB,2    RKEY,3            SET RDFD CODE
         EXU      RPROT             SAME A READ OF CODE RECORD
         LW,10    M:TM+13           GET SIZE OF REFDEF STACK
         SLS,10   -2                IN WORDS
         AW,10    15
         STD,15   6                 INITIALIZE IN/OUT POINTERS
SYML     INT,2    0,6               GET NEXT FLAG WORD
         SCD,2    -4
         LC       3                 GET ENTRY TYPE
         BCR,7    SYMCK             0,8 DEF OR DDEF, GOOD POSSIBILITY
         BCS,4    SYMN              >3 NOT DSECT
         BCR,1    SYMN              2   NOT DSECT    SKIP IT
         BCR,2    SYMN              1   NOT DSECT    SKIP IT
SYMP     EQU      %                 PUT THIS ONE IN THE TABLE
         LW,2     1,6               GET VALUE
         LW,3     2,6               IF NO RES, USE VALUS AS IS
         BEZ      %+5
         SLS,2    2
         SLS,2    -1
         DH,3     PSYMB             DIVIDE BY 256
         BNEZ     %-2               MAKE WORD RES
         LB,5     *6                SAVE SIZE IN CASE WE CLOBBER IT
         STW,2    0,7               PUT VALUE IN TABLE
         LCI      3                 NOW GET SYMBOL
SYMLOC   LM,2     3,6
         LB,14    4                 ADD EIGHTH BYTE IN CASE ITS THERE
         LB,4     2                 SIZE OF SYMBOL
         SLD,2    8                 REMOVE COUNT BYTE
         OR,3     14
         LI,14    0
         AI,4     -8                ZERO PAD
         BGEZ     %+3
         STB,14   4,4
         BIR,4    %-1
         AI,7     3                 INCR TO NEXT POSITION
         STM,2    -2,7              SETTING CC=2 FOR STORE
         LW,5     5                 TEST SIZE
         B        %+2
SYMN     LB,5     *6                SIZE OF THIS ENTRY
         BEZ      %+4               GOT CRAP FOR A STACK
         AW,6     5                 TO NEXT ONE
         CW,6     10                ARE WE DONE
         BL       SYML              NO, LOOP
         STW,7    ESYMS             SAVE END FOR SORT
         SW,7     15                SIZE OF GENERATED TABLE
         AWM,7    SYMBSZ            ACCUMULATE SIZE
         SLS,7    2                 IN BYTES
         STW,15   BUF
         B        *11
PRNTSYMS LCI      5
         PSM,1    *0                SAVE CLOBBERED REGS
         EXU      UPSPACE
         LW,5     BUF               INPUT POINTER
NXTLINE  LW,1     ZAPBUF
         MBS,0    BA(PBUF)+1
         LI,1     PBUF+2
NXTVALUE LW,2     0,5               PRINT THE VALUE
         AND,2    VMASK             (MAKE DIVIDE WORK PROPERLY)
         LI,3     5                 IN HEX, MAX 5 CHARS
         LI,4     15
         AND,4    2
         LB,4     HEXS,4
         STB,4    *1,3
         DH,2     H10               SHIFT RIGHT 4, CHECK VALUE
         BEZ      %+2
         BDR,3    %-6
         LW,3     1,5               NOW PUT SYMBOL
         STS,3    2,1
         LW,3     2,5
         STS,3    3,1
         AI,1     4
         AI,5     3
         CW,5     ESYMS
         BGE      %+5
         CI,1     PBUF+1+#SYM*4     ARE WE AT END OF BUFFER
         BLE      NXTVALUE
,PSYMB   M:PRINT  (MESS,PBUF)
         B        NXTLINE
         CAL1,2   PSYMB             PRINT LAST BUFFER
         EXU      UPSPACE
         LCI      5
         PLM,1    *0
         B        0,5               RETURN
BYVALUE  TEXTC    '      BY VALUE..'
SYMCK    LC       2                 IS THIS LDEF OR UDEF
SYMLCK   BCS,1    SYMP              LDEF, CHANGED TO SYMN AFTER M:MON
         ANLZ,3   SYMLOC            GET WA(TEXTC)
         LB,5     *3                SIZE
         LB,5     *3,5              LAST CHAR
         CI,5     ':'               ALL ENDING IN : GET PUT IN
         BNE      SYMN
         MTB,-1   *3                SCRUB :
         B        SYMP
HEXS     TEXT     '0123456789ABCDEF'
#SYM     EQU      6                 6 SYMBOLS PER LINE
PBUF     DATA,1   #SYM*17+1,64,64,64
         DO1      #SYM*4+1
         TEXT     ' '
ZAPBUF   GEN,8,24 #SYM*16+4,BA(PBUF+1)
         PAGE
************************************************************************
*  SUBROUTINE TO SORT SYMBOL TABLES
*************************************************************************
SORTNUM  MTB,1    5                 SET VALUE SORT FLAG
SORTALF  RES
         LCI      15
         STM,1    PBUF+1
         LW,2     BUF               SET LOW END OF AREA
         LW,3     ESYMS             AND END OF IT
         LB,4     5
         LI,5     1                 SET WHERE TO START SORT
         LI,1     4
         STS,4    SORTMOVE,1
         BDR,1    %-1
         SW,2     4
         SW,3     4                 ADJUST ADRESSING
         LI,9     -1                SET MASK
         LI,7     -1                (S)
         STW,9    1,3               SET TERMINATOR
         SW,3     2
         PSW,2    *0                SET END
         PSW,9    *0
SSST     AW,3     2                 MAKE BOTH POINTERS
         LD,4     2                 SAVE
         LW,6     1,2               FIRST COMP
         LW,8     2,2               SECOND
         LI,1     %+1
         AI,2     3                 SEACRH FOR
         CS,6     1,2               LOW SIDE ENTRY
         BG       %-2               THAT'S TOO BIG
         BL       %+3
         CS,8     2,2
         BG       %-5
         AI,3     -3                AND HIGH SIDE ONE THAT'S TOO SMALL
         CS,6     1,3
         BL       %-2
         BG       %+3
         CS,8     2,3
         BL       %-5
         CW,2     3
         BL       SORTMOVE
         LW,2     4                 DONE, SWITCH THE COMPARATOR TOO
         BAL,1    SORTMOVE
         LW,4     3                 RESTORE UPPER AND LOWER RANGES
         AI,4     3
         SW,3     2
         SW,5     4                 CHECK SIZES, DO SMALLER
         CW,3     5
         BLE      %+3               SAVE LARGER FOR LATER
         XW,2     4
         XW,3     5
         CI,5     3                 IF THERES ANYTHING TO DO
         BLE      %+3
         PSW,4    *0
         PSW,5    *0
SCHK     CI,3     4                 EITHER PLACE
         BG       SSST
         BAZ      %+4
         LCI      15
         LM,1     PBUF+1
         B        0,5
         PLW,3    *0
         PLW,2    *0
         B        SCHK
*
SORTMOVE LCI      3
         LM,10    0,2
         LM,13    0,3
         STM,10   0,3
         STM,13   0,2
         B        0,1
*
*        SORT DATA
ESYMS    RES      1
         PAGE
************************************************************************
*  ERR/ABN ROUTINES
************************************************************************
********
OPE      LW,1     OPT
         B        %+2
RER      LW,1     RET
         STW,1    OPM
         LB,2     *9                GET FILE NAME
         LB,3     *9,2
         STB,3    NAMEM,2           PUT IN MSG
         BDR,2    %-2
         CW,1     RET               PUUT KEY IF READ
         BNE      RER1
         LW,3     PAGEM
         LB,1     *M:TM+18          GET KEY SIZE
         CI,1     3                 IF 3 IS PAGE OF LM
         BE       RER0
         LB,1     *M:TM+18,1        GET LAST CHAR OF KEY
         LW,3     HEADM
         CI,1     'D'               IF D MUST BE HEAD
         BE       RER0
         LW,3     TREEM
         CI,1     'E'               IF E MUST BE TREE
         BE       RER0
         SLS,1    -1
         LW,3     KEYS,1            GET RECORD TYPE
RER0     STW,3    KEYM              PUT IN MSG
         REF      M:XX
RER1     M:OPEN   M:XX,(FILE,'ERRMSG',':SYS'),(ABN,RER2),(ERR,RER2)
         SLD,10   -24               GEN KEY
         SLS,11   -1
         AI,10    X'30000'
         SLD,10   8
         STW,10   KEYS
         M:READ   M:XX,(KEY,KEYS),(BUF,IOMSG+1),(SIZE,80),(ERR,RER2)
         LW,1     M:XX+13
         AI,1     3
         STB,1    IOMSG
RER2     EQU      %
UPSPACE  M:PRINT  (MESS,BLNKLINE)
         M:PRINT  (MESS,IOMSG)
         M:PRINT  (MESS,MESM)
ABORT    M:PRINT  (MESS,ABORTM)
         M:XXX
********
MESM     TEXTC    '   XXXXING                 '
KEYM     EQU      %-1
OPM      EQU      MESM+1
NAMEM    EQU      MESM+3
TREEM    TEXT     'TREE'
HEADM    TEXT     'HEAD'
PAGEM    TEXT     'PAGE'
KEYS     TEXT     'RFDFDATAPROCDCBS'
ABORTM   TEXTC    '*****  DEF PROCESSOR ABORTED  *****'
IOMSG    TEXTC    '    UNKNOWN ABNORMAL CODE'
OPT      TEXT     'OPEN'
RET      TEXT     'READ'
         PAGE
*********************************************************
*        LOGICAL SYSGEN ERRORS DETECTED BY DEF
****************************************************************
BADOV    EXU      UPSPACE
         M:PRINT  (MESS,BADOVM)
         B        ABORT
BADOVM   TEXTC    '****  OVERLAY EXCEEDS 6 PAGES'
BADXD    EXU      UPSPACE
         M:PRINT  (MESS,BADXDM)
         B        ABORT
BADXDM   TEXTC    '****  XDELTA TOO BIG - REDUCE ITS BIAS'
BADPATCH EXU      UPSPACE
         CAL1,2   PSYMB             PRINT OFFENDING PATCH
         M:PRINT  (MESS,BADPM)
         B        ABORT
BADPM    TEXTC    '****  OUT OF ORDER PATCH'
TREER    EXU      UPSPACE
         M:PRINT  (MESS,TREERM)
         B        ABORT
TREERM   TEXTC    '****  M:MON TREE OUT OF ORDER'
         PAGE
************************************************************************
*  OTHER DATA & PLISTS
************************************************************************
********
HEAD     TEXTC    'HEAD'
TREE     TEXTC    'TREE'
         BOUND    8
OPNTM    GEN,8,24 X'14',M:TM
         DATA     X'C1000001',OPE,OPE,1
FCTL     DATA,1   1,0,3,3
FNAME    RES      0
RKEY     TEXTC    'M:MON'
         RES      1
         DATA,1   2,1,2,2
         TEXT     ':SYS    '
OPTAP    DATA     X'9400000C'
THREE    EQU      %
         DATA     3,X'10000'
MONKEY   DATA     X'3000000'
SEGN     DATA     0
GTABCBS  DATA,1   7,,,4*6+1
RECVEC   DATA,1   7,0,5,0
HEADDAT  RES      3
         BOUND    8
NONOVS   EQU      %-2
ALYT     TEXTC    'ALLOCAT'
         TEXTC    'FIX'
         TEXT     ' '
         TEXTC    'GHOST1'
#SPROCS  EQU      DA(%)-DA(NONOVS)-1
XRECVR   TEXTC    'RECOVER'
XDLTT    TEXTC    'XDELTA'
#NONOVS  EQU      DA(%)-DA(NONOVS)-1
MONTXT   TEXTC    'M:MON'
UMOVT    TEXT     'UMOV'
SYMBSZ   DATA     0                 SIZE OF GENERATED XDELTA SYMBOL TABLE
**********
BLNKLINE TEXTC    '   '
         BOUND    4
RWS      EQU      13
M8X9     DATA     X'1FE00'
ELEVEN   DATA     11
H10      DATA,2   16,0
TEN      DATA     10
PMESS    TEXTC    '.......... PATCHES INCLUDED'
SMESS    TEXTC    '.......... SYMBOLS MAY BE DEFINED'
SYMM     TEXTC    '      ROOT SYMBOL TABLE:'
PSYM     TEXTC    '      SYMBOLS FOR PATCHING XXXXXXX'
PSYMF    EQU      %-2
MSGTXTC  GEN,8,24 4*MSZ+3,'   '
**********
         PAGE
************************************
GENINFO  EQU      %
         GEN,8,24 VERSION-%,(ENDINFO-M1)/MSZ    # MESSAGES IN GENINFO
M1       TEXT     '                        '
M2       TEXT     ' ***********************'
M2:1     TEXT     '         C P - V        '
         TEXT     '                        '
         TEXT     ' HONEYWELL  RESTRICTED  '
         TEXT     ' PROPRIETARY  PROGRAM.  '
         TEXT     ' USE  AUTHORIZED  ONLY  '
         TEXT     ' PURSUANT  TO  LICENSE  '
         TEXT     ' AGREEMENTS.            '
         TEXT     '                        '
M3       TEXT     ' SYSTEM GENERATED ON:   '
M4       TEXT     '    '
TIMEDATE DATA     0,0,0,0
         TEXT     '    '
M5       TEXT     ' VERSION NO. IS:    '
VERSION  TEXT     'XXXX'
M6       TEXT     ' ***********************'
         TEXT     '  PATCH SEGMENT NAMES:  '
         TEXT     '               (ROOT)   '
M7       TEXT     ' ***********************'
MSZ      EQU      %-M7              MESSAGE SIZE (WORDS)
M7:2     TEXT     '                        '
HGPINFO  DATA     0                 B0-15=HGPSIZE ; B16-31=HGP ADDR.
ENDINFO  EQU      %
************************************************************************
         PAGE
************************************************************************
*  THE FOLLOWING IS THE BI/PO TAPE BOOTSTRAP
************************************************************************
         DEF      MTBOOT,TBOOT
         BOUND    8
MTBOOT   EQU      %
A        ASECT
         ORG      MTBOOT            KEEP ORIGINAL ORIGIN
         LOC      A+X'2A'           SET ADDR.= '2A'
TBOOT    EQU      %
         LI,1     0                 #RECORDS SET BY WMON
         LI,2     (512-90)*4        FIRST RECORD OVERLAPS SECOND
BLOOP    LI,4     10                NR. OF RETRIES
         LI,0     DA(MTCDW)         CDW ADDRESS
SIO      SIO,0    *37
         TIO,3    *37
         BCS,X'C' %-1
         CW,3     ERRMSK
         BANZ     RETRY
         AWM,2    MTCDW
         LI,2     X'800'
         BDR,1    BLOOP
STRTADRT B        0   ***(SET BY WRITEMON) EXIT TO MONITOR AT INITIAL
RETRY    LI,0     DA(MTCDW)+1
         BDR,4    SIO
         B        %                 HANG IF UNRECOVERABLE ERR
         BOUND    8
MTCDW    EQU      %
         GEN,8,24 2,90*4            READ
         DATA     2048              RECORD BYTE COUNT
         GEN,8,24 X'4B',0
         DATA,1   X'20',0,0,0
         GEN,8,24 X'8',DA(MTCDW)    READ AGAIN
ERRMSK   DATA     X'6EFE0000'
MTCMNDW  EQU      MTCDW-TBOOT+MTBOOT+2
STMONMTB EQU      STRTADRT-TBOOT+MTBOOT
************************************************************************
         END

