software: Added more and more

[pdp8.git] / sw / os8 / v3d / sources / system / dectapes / dectape4 / BUILD.PA

/33 OS/8 V3D BUILD
/
/
/
/
/
/
/
/
/
/COPYRIGHT  (C)  1971,1972,1973,1974,1975,1977 BY DIGITAL EQUIPMENT CORPORATION
/
/
/
/
/
/
/
/
/
/
/THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE
/AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
/CORPORATION.  DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY
/FOR ANY ERRORS THAT MAY APPEAR IN THIS DOCUMENT.
/
/THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER
/UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED
/(WITH INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH
/SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL.
/
/DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE
/OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY
/DIGITAL.
/
/
/
/
/
/
/
/
/
/
\f/ABSTRACT--
/BUILD IS THE SYSTEM CONFIGURATOR FOR THE OS/8 PROGRAMMING
/SYSTEM. WITH BUILD, THE DEVICES WITHIN A PARTICULAR
/SYSTEM CAN BE RAPIDLY AND EASILY CHANGED. BUILD ALSO
/PROVIDES THE FACILITY FOR CREATING AN INITIAL OS/8 SYSTEM
/FROM BINARY PAPER TAPES OR CASSETTES.

/V3 CHANGES

/0.     MADE BUILD SUPPORTABLE
/1.     ADDED VE COMMAND (CURRENT VERSION # IS 3X WHERE X IS PATCH LEVEL)
/2.     FIXED PROBLEM WITH Z'S AND 9'S IN FILENAMES
/3.     CHANGED LENGTH OF DF32
/4.     FIXED PROBLEM WITH RK8 BOOTSTRAP RECORD.
/5.     ON LOAD, NULL EXTENSION FIRST SEARCHES FOR .BN
/6.     CR TO $ DOESN'T GIVE ERROR
/7.     FIXED BUG WITH BUILDING ROM SYS
/8.     RUBOUTS TO BOL GIVE $
/9.     ^U RETYPES $
/10.    ASSUME DSK: IF NO DEV GIVEN WITH LOAD
/11.    NO DOT IS PRINTED IF NO EXTENSION
/12.    ^O STUFF NEW
/13.    ALLOW PARITY ^C
/14.    ADDED EXAMINE COMMAND
/15.    FIXED BUG RE ACCESSING USR TABLE VIA POINTER
/16.    CLEANED UP MOVE ROUTINE
/17.    CLEANED UP NUMBER TOO BIG CHECKER
/18.    OVERFLOW ERROR MESSAGE CHANGED TO 'BAD ORIGIN'
/19.    DON'T ALLOW NAMES OVER 6 CHARS TO SPILL INTO EXTENSION;
/       DON'T ALLOW MULTIPLE EXTENSIONS
/20.    INCREASED NUMBER OF ALLOWABLE ENTRY PTS/HANDLER TO 16 (DEC)
/21.    CLEANED UP SYMBOL PRINT ROUTINE
/22.    GOT NAMES IN TABLE TO LINE UP.
/23.    INSERT GRPNAME <CR> INSERTS FIRST HANDLER
/24.    INSERT GRP,DEV1,DEV2,DEV3,...
/25.    INSERT GRP,DEV1-5,...
/26.    SAME FOR DELETE AND REPLACE
/27.    COUNT DEVICES AND SLOTS ONLY ON BOOT
/28.    FIXED BUG RE SYS RF08=4023
/29.    GENERAL SUPPORT OF 2-PAGE SYS HANDLERS
/30.    ADDED QL COMMAND
/31.    SETS SA=00200, JSW=0
/32.    UNLOAD UNLOADS AND DELETES
/33.    ADDED DSK COMMAND
/34.    BUILD COMMAND
/35.    PRINT TELLS YOU ABOUT DSK
/36.    TOOK OUT LOC DEPENDENT CHECK FOR SYSTEM HANDLERS
/37.    INSERT ALLOWS SETTING # OF PLATTERS
/38.    HANDLER HEADER LOADS DIRECTLY INTO DESCRIPTOR TABLE
/39.    USES EXTRA CORE IF AVAILABLE (ALSO CHECKS SOFTWARE CORE SIZE)
/40.    STOPS ECHOING ON INPUT LINE OVERFLOW
/41.    *'S SYSTEM DEVICE
/42.    REMEMBERS SYS ACROSS A BOOT
/43.    'Y' INSTEAD OF 'YE'
/44.    BO CHECKS DCB IN CORE TO SEE IF NEED REWRITE MONITOR
/45.    ALLOW UNLOADING ENTRY POINT NAMES
/46.    CTL COMMAND
/47.    EACH COMMAND HAS ITS OWN MAXIMUM INPUT LINE SIZE
/48.    ADDED CORE COMMAND
/49.    FIXED ^U TO WRITE ZERO DIRECT MSG BUG
/50.    HIT CONTINUE AFTER 'SYS ERR' TO RETRY
/51.    PRESERVED DATE ACROSS BOOT
/52.    MULTIPLE LOADS AND UNLOADS
/53.    LOAD FROM SCRATCH USES INTERNAL ACTIVE HANDLERS
/54.    CASSETTE SUPPORT
/55.    SETS CORE CONTROL BLOCK

/CHANGES SINCE FIELD RELEASE

/A      'NO ROOM' DOESN'T PRINT 'BAD LOAD'
/B      NO. OF ENTRY POINTS NOW CORRECTLY CHECKED FOR
/C      FIXED BUG RE BUILDING TD8E FROM TD8E
/D      BOOT CMD DISABLES BUILD CMD
/E      JSW SET TO 1 BEFORE CHAINING TO ABSLDR
/F      P CMD BUG FIXED
/G      ALTER BUG FIXED
/H      LENGTH OF INPUT LINE SYMBOLIC
/I      SOFCOR STUFF OPTIMIZED
/J      QL DOESN'T PRINT SPACE BETWEEN SYS'S GRP:NAME
/K      FIXED BUG IN 32K
/L      PAPER TAPE PUTS HLT IN 7600

/THINGS TO DO:

/?      DIES IF DATA OCCURS BEFORE *0
/?      BOOT.ZE, .NZ  CMD?
/?      GET 2-PAGE BIT OF CURRENT SYSTEM

/CHANGES FOR MAINTENANCE RELEASE V3C:

/       7-AUG-75

/1.     CHANGED VERSION NUMBER TO V5
/2.     INCORPORATED PATCH SEQ #1 (DSN APRIL 1975)
/       ZERO LOCATION SOFSET WHILE BUILDING
/3.     INCORPORATED PATCH SEQ #2 (DSN NOV. 1974)
/       DISMISS USR AFTER ?NAME ERROR
/4.     INCORPORATED PATCH SEQ #3 (DSN  MARCH 1975)
/       DECREASE SYSTEM SIZE BY 5 (FOR ABSLDR) WHEN BUILDING FROM PAPER TAPE
/5.     INCORPORATED PATCH SEQ #4 (DSN APRIL 1975)
/       ADDED 'SIZE' COMMAND TO BUILD
/6.     FIXED BUG WHICH CAUSES SYSXY.RS NOT FOUND TO BE PRINTED
/       ON BOOTXY.RS COMMAND

/CHANGES FOR V3D:

/       1-MAY-77

/1.     FIXED PROBLEM WITH CASSETTE BUILD (JSW WAS SET WRONG)
/2.     ALLOWED SAVING OF HIGH-ORDER DATE BITS
\f/BUILD PAGE 0
        *1
        HLT             /SAFETY HALT AND PATCH SPACE
SAV1,   0
SAV2,   0               /SAVES GROUP NAME
        *10             /AUTO INDEX REGISTERS
XR1,    0               /GENERAL PURPOSE REGISTERS
XR2,    0
XR3,    0
XR4,    0               /USED TO BUILD IMAGE TABLES
XR5,    0
LXR,    0
GNMXR,  0
L600,   600

        *20
COUNT,  0               /GENERAL COUNTER LOCATION
CHAR,   0               /CHARACTER BUFFER
TEMP,   0               /TEMPORARIES
TMP1,   0


        BUFFER=5400
        BINARY=6000
        DEVBUF=0400     /FIRST HANDLER AT 10400
                        /FOR REASONS TOO LONG TO GO INTO HERE,
                        /BUT WHICH HAVE TO DO WITH CURIOUS
                        /PROPERTIES OF THE NUMBER 0,
                        /HANDLERS CAN'T START AT 0.
                        /THEY COULD HAVE STARTED AT 200.
        SOFSET=7747     /SYSTEM OFFSET. (CURRENTLY =0)
        PG7600=BUFFER   /RECORD 0 (IMAGES OF BOTH 7600'S)

        LDRCTL=4113     /CHECK OS/8 ASSEMBLY
NAME1,  0               /NAME1-4 HOLDS FILE AND DEVICE NAMES
NAME2,  0
NAME3,  0
NAME4,  0
TABLMT, DSCTAB          /HIGH CORE END OF DESCRIPTORS
                        /FIRST FREE LOCATION
SIZE,   0
HNDPTR, DEVBUF          /POINTS TO FIRST FREE LOCATION IN HANDLER TABLE

        BLDSAV=75       /**** WILL DESTROY PREVIOUS FILES
                        /START OF 40 BLOCK TO SAVE BUILD IN
        HDRSIZ=10       /NUMBER OF ITEMS IN A DESCRIPTOR
DSCPTR, DSCTAB          /ALWAYS POINTS TO BEGIN OF CURRENT DESCRIPTOR
\fSLOT,  0
DSKG1,  0               /NAME OF 'DSK'
DSKG2,  0
DSKP1,  0
DSKP2,  0
NEWPAG, 0
OLDPAG, 0
NEWCOR, 0               /NEW CORE MAX
SAVDAT, 0               /REMEMBERS DATE ACROSS A BOOT
        DATEWD=7666
FLAG2,  1               /0 IF PREVIOUS SYSTEM HAD A 2-PAGE HANDLER
/SAMSYS,        1               /0 IF DIDN'T SPECIFY NEW SYS
        BLOK66=0
SYSDCB, 0
        SA=7744
        JSW=7746
/BOOTDV,        0               /HANDLER ADDRESS OF DEVICE WE'RE BOOTSTRAPPING TO
SAVHID, 0               /HIGH-ORDER DATE (BITS 3-4)
\f/BEGLIN:       72 CHAR LINE BUFFER

/NEW BUILD CORE ALLOCATION:

/0000-5177      BUILD (ABSLD MUST BE ABOVE 4177)
/5400-5777      DEVICE HANDLER FOR LOAD
/5200-5377      PAPER TAPE/INIT/LINE BUFFER
/6000-6377      INPUT BUFFER FOR LOAD (TEMP LOC OF USR)
/6400-7577      DESCRIPTOR TABLE (DSCTAB)

/BINARY MUST FOLLOW BUFFER
/FIELD 1: HANDLERS (0400-7577)
/10000-10377    BLOK66  BUFFER
\f       *200

        SKP CLA         /ENTRY FROM 'R BUILD'
        HLT             /CHAIN ENTRY ADDRESS
        TAD I [7600     /SEE IF SYSTEM ALREADY EXISTS
        CIA
        TAD [4207
        SZA CLA         /IF NOT, BUILD SYSTEM FROM PAPER TAPE
        CLA IAC         /NOTE FACT THAT OS/8 AINT AROUND
        DCA I [RETSW
        JMS CORE
        DCA I (AMTCOR   /FIGURE OUT HOW MUCH CORE WE HAVE
        JMS I (GOOD     /DO SOME INITIALIZATION; IT'LL DO YA GOOD
CONFIG, CDF 0
        DCA I (ECHOFLG  /ALLOW TYPING
        JMS I [CRLF
DOLR,   TAD ["$         /OUTPUT A $ BECAUSE I'M JEWISH
        JMS I [TTYOUT
        DCA I [SWAPER   /USE CURRENT HANDLER, NO SWAP ON ^C.
        TAD [-LNLNGT
        JMS I [GTEXT    /READ TTY LINE
        JMP DOLR
        JMS I [GNAME    /INTERPRET THE COMMAND
        TAD NAME1
        SNA
        JMP CONFIG
        DCA CHAR        /ENABLE TEST TO WORK
\f       JMS I [TEST     /LOOK FOR THE COMMAND IN LIST
        -1417;LOAD      /LOAD DEVICE HANDLER BINARY
        -2205;REPLACE   /REPLACE IN SYSTEM
        -1601;NAME      /ALTER PERMANENT NAME
        -0114;ALTER     /CHANGE DEVICE HANDLER LOCATION
        -2022;PRINT     /SYSTEM STATUS
        -2331;SYSTEM    /SPECIFY SYSTEM DEVICE
        -0217;BOOT      /BOOTSTRAP THE NEW SYSTEM
        -2516;UNLOAD    /DELETE INACTIVE HANDLER
        -0405;DELETE    /DELETE ACTIVE HANDLER
        -1116;INSERT    /INSERT HANDLER IN SYSTEM
        -2605;VERS      /TYPE VERSION #
        -0530;EXAMINE   /EXAMINE LOCATION
        -2114;QLIST     /QUICK LIST
        -0423;DSK       /DSK
        -0317;KORE      /CORE
        -0403;DCBCM     /DCB
        -0324;CTLCM     /CTL
        -2311;SIZCM     /SIZE
BD,     -0225;BUILD     /BUILD
        0               /MUST TERMINATE LIST WITH 0
        JMP I [WHAT     /DIDN'T FIND COMMAND

/NEW HEADER BLOCK:

/       DEVICE GROUPNAME
/       DEVICE PERMANENT NAME
/       DCB     (R/W,TYPE,MAX # OF PLATTERS)
/       1/2 PAGE, SYSTEM BIT, CORES BIT, REL ENTRY PT
/       MUST BE 0
/       SIZE OF 1 PLATTER
\fCORSIZ,
GETCHA, 0
        TAD DSCPTR
        TAD I GETCHA
        ISZ GETCHA
        DCA GETEM
        TAD I GETEM
        JMP I GETCHA

GOTCHA, 0
        DCA GOTEM
        TAD I GOTCHA
        TAD DSCPTR
        ISZ GOTCHA
        DCA GETEM
        TAD GOTEM
        DCA I GETEM
        JMP I GOTCHA

        PUT=JMS I [GOTCHA
        GET=JMS I [GETCHA
\fGOTEM,
CORE,   0
        TAD I [7777
        AND [70
        CLL RTR
        RAR
        SNA
        JMS RELCOR
        JMP I CORE

GETEM,                  /POINTS INTO DSCTAB
RELCOR, 0
        CLA IAC
        DCA CORSIZ      /MAKE RE-USABLE
        TAD [7400
        DCA CORX        /MAKE ROUTINE REUSABLE ON 32K MACHINE
COR0,   CDF 0
        TAD CORSIZ
        RTL
        RAL
        AND COR70
        TAD COREX
        DCA .+1
COR1,   CDF /N
        TAD I CORLOC
COR2,   NOP
        DCA COR1
        TAD COR2
        DCA I CORLOC
COR70,  70
        TAD I CORLOC
CORX,   7400
        TAD CORX
        TAD CORV
        SZA CLA
        JMP COREX
        TAD COR1
        DCA I CORLOC
        ISZ CORSIZ
        JMP COR0
COREX,  CDF 0
        STA
        TAD CORSIZ
        JMP I RELCOR    /LEAVE WITH HIGHEST EXISTENT BANK

CORLOC, CORX
CORV,   1400
        PAGE
\f/GET   GETS DESCRIPTOR ITEM FROM CURRENT DESCRIPTOR
/OP

/PUT    PUTS DESCRIPTOR ITEM IN AC BACK IN SPECIFIED ITEM
/OP     IN CURRENT DESCRIPTOR

/ITEMS:

/ACTIVE BIT 0=1 MEANS ENTRY POINT HAS BEEN INSERTED (IS ACTIVE)
/PERM1  PERMANENT NAME (FIRST 2 CHARS)
/PERM2  2ND 2 CHARS
/TWOPAG BIT 0=1 MEANS 2-PAGE HANDLER, BIT 4 IGNORED, BITS 5-11 RELATIVE ENTRY POINT
/PAGRES BITS 7-11 GIVE PAGE OF START OF HANDLER WHEN ROTATED 6 RT
/GRPNM1 GROUP NAME (DEVICE NAME) FIRST 2 CHARS
/GRPNM2 2ND 2 CHARS
/DEVSIZ GIVES SIZE OF 1 PLATTER
/PLATNUM # OF PLATTERS IN BITS 2-4
/DSKBIT BIT 1 IS FLAG FOR 'DSK' (USED TEMPORARILY BY BUILD)
/MAXPLT MAXIMUM NUMBER OF PLATTERS ALLOWED (IN BITS 9-11)
/DCB    D.C.B. BIT 0: FILESTRUCTURED, BITS 3-8 DEVICE TYPE
/       BITS 9-11 MAX NO. OF PLATTERS
/CORES  BIT 2 MEANS ENTRY PT IS CORESIDENT WITH SYS HANDLER
/SYSBIT BIT 1 IS A 1 IF THE DEVICE HAS NAME 'SYS' AND IS A SYS DEVICE

/IF FIRST ENTRY OF A DESCRIPTOR IS GE 7600, THEN THIS
/ENTRY IS A BOOTSTRAP ENTRY.
/IT STARTS WITH THE NEGATIVE OF THE NUMBER OF WORDS IN THE
/BOOTSTRAP (FOR THE PRECEDING DEVICE), FOLLOWED BY THAT MANY WORDS
\f       GRPNM1=0
        GRPNM2=1
        PRMNM1=2
        PRMNM2=3
        DCB=4
        MAXPLT=4
        DVTYPE=4
        TWOPAG=5        /BIT 0
        SYSBIT=5        /BIT 1
        ACTIVE=6
        ENTPT=5
        PAGRES=6
        PLATNUM=6
        DEVSIZ=7
        DSKBIT=6        /BIT 1
        CORES=5         /BIT 2
\f/READ A LINE OF TEXT    RETURN 1 IS ^U RETURN
GTEXT,  0               /ROUTINE TO COLLECT TTY INPUT
        TAD (-BEGLIN    /AC IS NON-ZERO
        DCA ENDLIN
        DCA I (RUBFLG   /INITIALIZE RUBOUT TO \
        TAD (BEGLIN-1
RDTX,   DCA LXR         /BUFFER ADD. TO INDEX
RDTXT,  JMS I [TTYIN    /READ BLOODY TELETYPE
        TAD CHAR
        DCA NAME1       /SETUP FOR TEST AGAIN
        JMS I [TEST
        -377;RBOUT      /RUBOUT
        -212;LFEED      /LINE FEED..ECHO CURRENT COMMAND
        -215;CARRET     /LINE TERMINATOR
        -233;ALTMOD     /ALT MODE IN SEVERAL FLAVORS
        -375;ALTMOD
        -376;ALTMOD
        -200;RDTXT      /IGNORE BLANKS
        -217;RDTXT      /AS WELL AS ^O
        -203;CTRLC      /BACK TO CURRENT SYSTEM
        -225;CTRLU      /CTRLU
        0               /IF NOT ONE OF THESE, PUT IN BUFFER
        TAD LXR
        TAD ENDLIN
        SNA CLA
        JMP RDTXT       /LINE OVERFLOW, STOP ECHOING
        JMS I [PRNT     /PRINT THE CHARACTER
        TAD CHAR
        DCA I LXR       /AND PUT IN LINE BUFFER
        JMP RDTXT       /NO PROBLEMS YET
\fRBOUT, TAD LXR         /IS THERE TEXT TO RUB OUT?
        TAD [1-BEGLIN
        SNA CLA
        JMP RBCR        /NO..SO DON'T DO ANYTHING
        TAD ["\         /YES..ECHO BACKSLASH?
        ISZ I (RUBFLG   /IF = -1, NO
        JMS I [TTYOUT
        CLA CMA         /IGNORE CONSECUTIVE RUBOUTS
        DCA I (RUBFLG
        TAD LXR
        DCA TMP1
        TAD I TMP1
        JMS I [TTYOUT   /ECHO LAST CHAR
XRBACK, CLA CMA
        TAD LXR         /MOVE INDEX BACK ONE
        JMP RDTX
CARRET, JMS I [CRLF     /GENERATE 215,212
CAR1,   DCA I LXR
        DCA I LXR       /GUARD AGAINS CMD <CR>
        TAD [BEGLIN-1
        DCA GNMXR       /SETUP FOR GNAME ROUTINE
        ISZ GTEXT       /TAKE NORMAL RETURN
        JMP I GTEXT

LFEED,  DCA I LXR       /A 0 TO MARK END
        TAD [BEGLIN-1
        DCA LXR
        JMS I [CRLF
        TAD ["$
        JMS I [TTYOUT
ECHO,   TAD I LXR
        SNA             /DONE ECHOING?
        JMP XRBACK      /YES..REPOSITION LXR
        JMS I [TTYOUT
        JMP ECHO

ALTMOD, TAD ["$         /ALT MODE ECHOES AS $
        JMS I [TTYOUT
        JMP CAR1

CTRLU,  TAD ["^
        JMS I [TTYOUT   /GENERATE ^U
        TAD NAME1
        TAD [100
        JMS I [TTYOUT
RBCR,   JMS I [CRLF
        JMP I GTEXT     /TAKE ERROR RETURN
\f       GETCHR=JMS I [GETC
        BAKCHR=JMS I [BAKC

ENDLIN,
GETNUM, 0               /PICKS UP NUMBER FROM LINE BUFF
                        /DELIM CHAR PUT IN 'CHAR'
                        /PRINTS ERROR MESSAGE IF  GT 4095
                        /IF NO NUMBER, TAKES RETURN 1
                        /IF NUMBER, TAKES RET 2 WITH # IN 'SIZE'
        DCA SIZE
        DCA GOTSW       /HAVEN'T FOUND ANY DIGITS YET
        JMP NCHAR
ROT,    DCA TMP1
        ISZ GOTSW       /FOUND A DIGIT
        TAD SIZE
        AND [7000
        SZA CLA
        JMP I [BADARG   /NUMBER .GT. 4095
        TAD SIZE
        CLL RTL
        RAL             /BUILD UP THE DIGIT
        TAD TMP1
        DCA SIZE
NCHAR,  GETCHR
        SNA             /0 ENDS THE LINE
        JMP NUMOUT
        TAD [-240       /IGNORE SPACES
        SNA
        JMP NCHAR
        TAD (-30        /TEST LIMITS
        CLL
        TAD [10         /MUST BE BETWEEN 0 AND 7
        SZL
        JMP ROT
        TAD (260        /RESTORE CHAR
NUMOUT, DCA CHAR        /SAVE AWAY THIS DELIMETER
        TAD GOTSW       /DID WE GET ANY DIGITS?
        SZA CLA         /?
        ISZ GETNUM      /YES
        JMP I GETNUM    /NO, RETURN
\fGETC,  0               /GET THE NEXT CHARACTER, ADVANCE SCAN PAST IT
        TAD I GNMXR
        JMP I GETC

GOTSW,                  /1 MEANS GOT A DIGIT
BAKC,   0               /BACK UP SCAN TO THE CHARACTER JUST LOOKED AT
        STA
        TAD GNMXR
        DCA GNMXR
        JMP I BAKC
        PAGE
\f       INIT=JMS I [INI
        ADVDSC=JMS I [DSCADV
        ADVBOT=JMS I [BOTADV

/       JMS PRMNAM      /SEARCH TABLE FOR A PERMANENT NAME
                        /GIVEN IN NAME1-NAME2
                        /POINT TO DESCRIPTOR FOR THIS NAME
/       JMS ACTNAM      /SAME BUT PERMANENT NAME MUST BE ACTIVE
/       JMS BIGNAM      /SEARCHES FOR PERM & GRP NAME (GRP NAME IN SAV1,SAV2)
/       JMS GRPNAM      /SAME BUT SEARCH FOR GROUP NAME

CHKNAM, 0
        INIT
CHKLUP, ADVDSC          /ADVANCE TO NEXT DESCRIPTOR
        ADVBOT          /ADVANCE OVER ANY BOOTSTRAP
        JMP NFOUND      /NO MORE- ERROR
        GET
NM1,    GRPNM1          /GET GROUP OR PERMANENT NAME
        CIA
        TAD NAME1
        SZA CLA         /DO FIRST WORDS MATCH?
        JMP CHKLUP      /NO, TRY AGAIN
        GET
NM2,    GRPNM2          /GET 2ND WORD
        CIA
        TAD NAME2
        SZA CLA         /2ND WORD MATCH?
        JMP CHKLUP      /NO
        TAD BIGFLG
        SNA CLA         /WANT BOTH GROUP AND PERM NAME?
        JMP NOBIG       /NO
        GET             /YES
        GRPNM1
        CIA
        TAD SAV1
        SZA CLA
        JMP CHKLUP
        GET
        GRPNM2
        CIA
        TAD SAV2
        SZA CLA
        JMP CHKLUP
NOBIG,  TAD ACTSW       /FOUND MATCH
        SNA CLA         /MUST HANDLER BE ACTIVE?
        JMP I CHKNAM    /NO, RETURN
        GET             /YES
        ACTIVE
        SMA CLA         /IS IT ACTIVE?
        JMP CHKLUP      /NO, TRY AGAIN
        JMP I CHKNAM    /YES, RETURN
\fGRPNAM,        0
        TAD (GRPNM1     /WANT TO SEARCH FOR GROUP NAME
        DCA NM1
        TAD (GRPNM2
        DCA NM2
        DCA ACTSW       /NEED NOT BE ACTIVE
        DCA BIGFLG
        JMS CHKNAM      /GO SEARCH
        JMP I GRPNAM

ACTSW,  0               /1 MEANS HANDLER MUST BE ACTIVE

PRMNAM, 0
        DCA ACTSW       /AC MAY BE NON ZERO (TO MEAN ACTIVE ONLY)
        TAD (PRMNM1     /WANT TO SEARCH FOR PERMANENT NAME
        DCA NM1
        TAD (PRMNM2
        DCA NM2
        DCA BIGFLG
        JMS CHKNAM      /GO SEARCH
        JMP I PRMNAM

ACTNAM, 0
        CLA IAC         /THEY MUST BE ACTIVE
        JMS PRMNAM
        JMP I ACTNAM

BIGNAM, 0
        DCA ACTSW
        TAD (PRMNM1
        DCA NM1
        TAD (PRMNM2
        DCA NM2
        CLA IAC
        DCA BIGFLG
        JMS CHKNAM
        JMP I BIGNAM

/SOMETIMES CHKNAM CAME FROM DSKASK INSTEAD OF GETSYS ****

BIGFLG, 0               /SET TO 1 TO CHECK GROUP & PERMANENT NAME
\fNFOUND,        JMS I [PRNAME
        JMS I [PRWD
        TEXT / NOT FOUND/
        JMP I [CONFIG

NOROOM, JMS I [PRWD
        TEXT /?NO ROOM/
        DCA I TABLMT    /RESTORE SENTINEL 0
        JMP I [CONFIG

VERS,   JMS I [PRWD
        TEXT    /BUILD V6A/
        JMP I [CONFIG

/BUILD CORE CONTROL BLOCK

BLDCCB, -2              /2 SEGMENTS
        6203            /FIELD 0
        0200            /200 IS S.A.
        0000            /JSW
        0000            /0-7577
        3710
        0000            /10000-17577
        3700
/GOES INTO WORDS 200-377 OF BLOCK 37
\fOK,    STA             /NOW USE ORIGIN TO TELL US HOW BIG A
        TAD I (ORIGIN   /HANDLER WAS LOADED
        AND [7600
        TAD [200        /REMEMBER THAT ORIGIN IS ONE GREATER
        DCA HNDPTR      /THAN ACTUAL LAST LOCATION.
                        /BETTER TO USE 2-PAGE BIT
        TAD I (NEWLIM
        DCA TABLMT      /SET NEW TABLE TOP
        DCA I TABLMT    /NEED 0 AT END
        JMS I [COMMA
        JMP I (LOAD
        PAGE
\f/LOAD A 1- OR 2-PAGE HANDLER INTO BUFFER
/USE IT TO ABSLD

SETUP,  0
        TAD [NAME1
        DCA FILPTR      /POINT TO FILENAME AREA
        TAD (BUFFER+1   /LOAD 2 PAGE HANDLER INTO 'BUFFER'
        DCA DRIVER      /SET UP ASSIGN DEVICE HANDLER
        JMS I [GNAME    /GET DEVICE NAME
        TAD NAME1
        SNA CLA
        JMP I SETUP     /NO ARG
        ISZ SETUP
        TAD I (RETSW
        SZA CLA
        JMP I (BLDLOD   /WHEN LOADING STANDALONE, USE INTERNAL HANDLERS
        TAD CHAR
        TAD [-":
        SZA CLA
        JMP I (SETDSK   /USE 'DSK ' IF NO DEVICE GIVEN
        TAD NAME1
        DCA DVNM1
        TAD NAME2
        DCA DVNM1+1     /LOOKUP DEVICE NAME
GETU,   JMS I (GETUSR
        CIF 10
        JMS I [200      /FETCH HANDLER
        1
SUBLUP,
DVNM1,  0
LODTMP,
DVNUM,  0               /NAME GOES IN HERE
DRIVER, 0
        JMP I (KICKM    /NO DEVICE. RELEASE MONITOR
        TAD CHAR
        SZA CLA
        JMS I [GNAME    /PICK UP FILE NAME
        TAD DVNM1+1     /DEVICE NUMBER
        JMS I (DTYPE    /SEE IF FILE STRUCTURED
        TAD NAME1       /IF FILE STRUCTURED WITH NO NAME
        SNA CLA         /IT IS AN ERROR
        JMP NMER        /V3C
        TAD NAME4       /SAVE ORIGINAL EXTENSION
        DCA TEMP
        TAD NAME4
        SNA             /IF NULL
        TAD (0216       /TRY .BN FIRST
TRYAGN, DCA NAME4
        TAD DVNUM       /GET DEVICE NUMBER
        CIF 10
        JMS I [200      /DO LOOKUP OF FILENAME
        2
FILPTR, NAME1
        0
        JMP LDEXT       /DIDN'T FIND FILE. DO SOMETHING
        CIF 10
        JMS I [200      /KICK OUT MONITOR
        11
        TAD DRIVER
LOADIN, DCA I [DVICE    /ENTRY POINT OF HANDLER
        JMS I (IOPEN    /IF HERE, IT WILL FIT
        JMP I SETUP
\fLOAD,  JMS SETUP       /SET UP FOR INPUT
        JMP I [NODEV    /NO LOAD DEVICE
        STA CLL RAL     /-2 DO A HANDLER LOAD
        JMS I (LDABS
        JMP I [BADLOD   /BAD
        TAD I TABLMT    /SEE IF HEADER INFORMATION IS OK
        SMA
        JMP I [BADLOD
        TAD (20         /ALLOW 16 HANDLERS/BINARY
        SPA CLA
        JMP I [BADINP   /TOO MANY
        TAD I TABLMT
        DCA LODTMP      /# OF LOOPS TO EXECUTE
        TAD TABLMT
        TAD [PAGRES+1   /POINT TO FIRST 'PAGRES' WORD
        DCA HDPTR       /GO THERE FOR DESCRIPTORS
        TAD HNDPTR
        JMS I [ROTL
        DCA TEMP        /PAGE OF RESIDENCE
PGLUP,  TAD TEMP
        DCA I HDPTR     /INSERT PAGE OF RESIDENCE
        TAD HDPTR
        TAD [HDRSIZ
        DCA HDPTR
        ISZ LODTMP
        JMP PGLUP
        TAD [2-HDRSIZ
        TAD HDPTR
        DCA HDPTR       /POINT TO AFTER DESCRIPTORS
        TAD HDPTR
        CIA
        TAD I (NEWLIM
        SNA CLA         /AT END?
        JMP I (OK               /YES
        TAD I HDPTR     /NO, MAYBE A BOOTSTRAP RECORD
        CLL
        TAD [200
        SNL CLA
        JMP I [BADLOD   /NO
        TAD I HDPTR     /MAYBE
        CIA
        IAC             /OVER COUNT
        TAD HDPTR
        CIA
        TAD I (NEWLIM
        SZA CLA
        JMP I [BADLOD   /NO
        JMP I (OK
\fHDPTR, 0               /POINTS INTO NEW HEADER

/DESCRIPTOR TABLE DESCRIPTION:

/'TABLMT' ALWAYS POINTS TO FIRST FREE LOCATION
/'DSCPTR' ALWAYS POINTS TO BEGIN OF CURRENT HEADER BLOCK
/ITEMS ARE OF 3 FORMS:
/(A) GROUP COUNT: IN RANGE -1 TO -20  (IGNORED AND HAS NO MEANING)
/       IT IS THERE FOR COMPATIBILITY WITH OLD BUILD
/(B) HEADER BLOCK STARTS WITH NUMBER IN RANGE 0-7577
/       CONSISTS OF 'HDRSIZ' CONSECUTIVE WORDS
/       DESCRIBED ELSEWHERE
/(C) BOOTSTRAP BLOCK: STARTS WITH NUMBER IN RANGE 7600-7757
/       THIS IS THE NEGATIVE OF THE NUMBER OF WORDS TO FOLLOW
\f/NON-SYSTEM HEADER INFO:

/       - NUMBER OF ENTRY POINTS

/FOR EACH ENTRY POINT:

/0,1    GROUP NAME
/2,3    ENTRY POINT NAME        (PERMANENT NAME)
/4      R/W FILE-STR, DEVICE TYPE, MAX # OF PLATTERS
/5      1/2 PAGE, REL ENTRY PT, SYSBIT, CORES
/6*     PAGE OF HANDLER, ACTIVE BIT, # OF PLATS, DSKBIT
/7      SIZE OF DEVICE

/* SUPPLIED BY BUILD

LDEXT,  TAD TEMP        /DIDN'T FIND FILE
        SZA CLA
        JMP I (KICKM    /NO RESORT
        ISZ TEMP
        JMP TRYAGN      /TRY NULL EXTENSION

NMER,   CIF 10          /V3C
        JMS I [200      /DISMISS USR FROM CORE
        11
        JMP I [NAMERR
        PAGE
\fREPLACE,JMS I (DEL     /DELETE PERMANENT NAME SPECIFIED NEXT
        TAD CHAR
        TAD MEQ
        SZA CLA         /AFTER ALL DELETIONS, MUST FIND A "="
        JMP I [SYNTAX   /IF NOT, WARN THE GUY
        JMS INS         /IF FOUND IT, NOW PERFORM INSERTIONS
        JMP I [CONFIG   /THE GUY HAS BEEN HUMORED

INSERT, JMS INS
TSTEOL, TAD CHAR        /THERE SHOULDN'T BE ANYTHING AFTER EOC
        SNA CLA
        JMP I [CONFIG   /THERE WASN'T
        JMP I [SYNTAX   /WARN BLOKE ABOUT EXTRA STUFF

DELETE, JMS I (DEL      /DELETE PERMANENT NAMES SPECIFIED
        JMP TSTEOL

SYSTEM, JMS INS         /SYS IS SAME AS INSERT
        GET
        SYSBIT
        RTL
        SPA SZL CLA     /BUT SYSBIT OR CORES SHOULD BE ON
        JMP TSTEOL      /JUST TO HUMOR IT'S NAME
TWOSYS, JMS I [PRWD     /AND FOR COMPATIBILITY REASONS
        TEXT    /?SYS/
        JMP I [CONFIG
\fINS,   0
        TAD (STL RAR
        DCA I (ACTION   /SET 'ACTION' FOR INSERTIONS
        JMS I [TSTNAM   /LOOK FOR A NAME
        JMS I [GRPNAM   /GET GROUP NAME
        JMS SAVNAM
        JMS I [TEST
MEQ,    -"=;ACT
        -",;INSNAM
        -":;INSNAM
        4000;ACT
        0
INSNAM, JMS I [TSTNAM   /GRAB A NAME
INSGN,  JMS I [BIGNAM   /GET PERMANENT NAME WITH SPECIFIED GROUP NAME
        GET
        GRPNM1
        CIA
        TAD SAV1
        SZA CLA
        JMP I [NFOUND   /MAKE SURE PERMANENT NAME FOUND
        GET             /HAS GROUP NAME PREVIOUSLY SPECIFIED
        GRPNM2
        CIA
        TAD SAV2
        SZA CLA
        JMP I [NFOUND
ACT,    JMS I (SETACT   /SET ACTIVE BIT
COM,    JMS I [TEST
        -"-;HYPH
        -",;INSNAM
        -"=;INPLAT
        0
        JMP I INS
\fINPLAT,        JMS I [GETNUM   /AN "="
        JMP I [SYNTAX
        TAD SIZE
        SNA CLA
        JMP I [BADARG   /=0 ILLEGAL
        GET
        MAXPLT
        AND [7          /GET MAXIMUM # OF PLATTERS ALLOWED
        SNA
        IAC             /0 MEANT 1
        CMA CLL
        TAD SIZE        /COMPARE WITH USER'S REQUEST
        SZL CLA         /IS HIS REQUEST OKAY?
        JMP BADPLT      /REQUEST-SHMEST.  TOO MANY PLATTERS
        TAD SIZE
        JMS I [ROTR
        DCA SIZE
        GET
        PLATNUM
        AND (6177
        TAD SIZE        /STORE AWAY HIS STATED NUMBER OF PLATTERS
        PUT             /FOR FUTURE USE BY 'BOOT'
        PLATNUM
        JMP COM         /REJOIN PROCESSING

BADPLT, JMS I [PRWD
        TEXT    /?PLAT/
        JMP I [CONFIG
\fSAVNAM,        0
        TAD NAME1
        DCA SAV1        /SAVE GROUP NAME
        TAD NAME2
        DCA SAV2
        JMP I SAVNAM

HYPH,   TAD NAME2
        AND [77
        CIA
        DCA DETEM
        GETCHR
        AND [77
        TAD DETEM       /GET CHAR AFTER HYPEN
        SNA CLA         /REACHED IT YET?
        JMP IGET        /YES, WELL TRY FOR MORE STUFF
        BAKCHR          /NO, PUT IT BACK FOR FUTURE USE
        ISZ NAME2       /FORM NEXT SEQUENTIAL NAME
        JMP INSGN       /GO INSERT IT
/DO WE REALLY HAVE TO START SEARCH AT CURRENT DESCR?

DETEM,  0

IGET,   GETCHR
        DCA CHAR
        JMP COM

NODEV,  JMS I [PRWD
        TEXT    /?DEVICE/
        JMP I [CONFIG
        PAGE
\fINTEM,
SETACT, 0
        GET
        ACTIVE          /GET ACTIVATION BIT
        RAL
ACTION, STL RAR         /ACTIVATE IT (SET TO 'CLL RAR' TO DEACT)
        PUT
        ACTIVE          /RESTORE
        JMP I SETACT

DEL,    0
        TAD (CLL RAR
        DCA ACTION
DELNAM, JMS I [TSTNAM   /PARSE OFF A NAME
DELGN,  JMS I [ACTNAM   /FIND IT AS AN ACTIVE PERMANENT NAME
        JMS SETACT      /DEACTIVATE IT
        GET
        PLATNUM
        AND [6177       /SET # OF PLATTERS TO 0
        PUT
        PLATNUM
DCOM,   JMS I [TEST
        -"-;DHYPH
        -",;DELNAM
        0
        JMP I DEL

DHYPH,  TAD NAME2
        AND [77
        CIA
        DCA INTEM
        GETCHR
        AND [77
        TAD INTEM
        SNA CLA         /REACHED FINAL NAME?
        JMP DGET        /YES
        BAKCHR          /NO, PUT FINAL LETTER BACK
        ISZ NAME2       /YES, BUMP TO NEXT NAME
L0423,  423
        JMP DELGN       /DELETE NEXT ONE IN SUCCESSION
\fDGET,  GETCHR
        DCA CHAR
        JMP DCOM

TTYIN,  0               /TTY INPUT ROUTINE
        KSF
        JMP .-1
        KRB
        SNA             /LOW LEVEL BLANK IGNORE
        JMP TTYIN+1
        AND [177        /HANDLE PARITY
        TAD [200
        DCA CHAR
        JMP I TTYIN
\f/DSK=ACTIVE PERMANENT NAME
/DSK=GROUPNAME:PERMANENT NAME
/DSK=<CR>       MEANS NO DSK SPECIFIED, USE 'SYS'

/JUST REMEMBERS NAME (NOTHING ELSE)

DSK,    JMS I [GNAME    /GET A NAME
        TAD NAME1
        SNA CLA
        JMP NODSK
        TAD CHAR
        SNA
        JMP NOCOL
        TAD [-":
        SZA CLA         /IS IT FOLLOWED BY A ":"?
        JMP I [SYNTAX   /NO, ASSUME HE'S GIVING AN ACTIVE PERMANENT NAME
                        /THIS IS FOR COMPATIBILITY WITH OLD BUILD
/       JMS I [GRPNAM   /YES, ITS A GROUP NAME
        TAD NAME1       /SAVE IT
        DCA DSKG1
        TAD NAME2
        DCA DSKG2
        JMS I [TSTNAM   /GET PERMANENT NAME
PN,     TAD NAME1
        DCA DSKP1       /DON'T WORRY NOW IF IT'S AROUND
        TAD NAME2
        DCA DSKP2
        TAD CHAR
        SZA CLA
        JMP I [SYNTAX
        JMP I [CONFIG

NODSK,  DCA DSKG1       /FIRST WORD 0 MEANS NONE SPECIFIED
        JMP I [CONFIG

NOCOL,  JMS I [ACTNAM   /IT MUST BE AN ACTIVE HANDLER
        GET
        GRPNM1
        DCA DSKG1
        GET
        GRPNM2
        DCA DSKG2
        JMP PN
\fSETDSK,        TAD L0423       /DS
        DCA I (DVNM1
        TAD (1300       /K
        DCA I (DVNM1+1
        JMP I (GETU

KICKM,  CIF 10          /RELEASE MONITOR AND RELOAD
        JMS I [200      /OUR DEVICES
        11
        JMP I [NFOUND

GETUSR, 0
        CIF 10
        JMS I [7700     /LOCK IN MONITOR
        10
        CIF 10          /RESET RESIDENT HANDLER TABLE
        JMS I [200
        13
        JMP I GETUSR
\f/      CODE FOR USING INTERNAL HANDLERS ON STANDALONE LOAD:

BLDLOD, DCA I (FILPTR   /LOAD DEV
        JMS I [ACTNAM   /MUST BE ACTIVE
        JMS I [GETPG
        DCA HNDLOK      /LOCATION OF HANDLER
        TAD [-400
        JMS I [MOVE
        CDF 10
HNDLOK, HLT
        CDF 0
PBUFFER,BUFFER
        GET
        DCB
        DCA BLDCB
        GET
        ENTPT
        AND [177
        TAD PBUFFER     /GET ENTRY POINT OF HANDLER
        JMP I (LOADIN

BLDCB,  0               /CONTAINS DCB OF CURRENT LOAD HANDLER
        PAGE
\fGETPG, 0
        GET
        PAGRES
        JMS I [ROTR
        AND [7600
        JMP I GETPG

/FORMAT:        NAME OLDNAME=NEWNAME

NAME,   JMS TSTNAM      /SEE IF ARGUMENT SUPPLIED
                        /SEARCH PERMANENT TABLES
        JMS I [ACTNAM   /GET ACTIVE PERMANENT NAME DESCRIPTOR
        TAD CHAR
        TAD MEQL        /CHECK FOR =
        SZA CLA
        JMP I [BADARG
        JMS TSTNAM      /GET NEW DEVICE NAME
        TAD NAME1       /REPLACE THE NAME
        PUT
        PRMNM1
        TAD NAME2
        PUT
        PRMNM2
        JMP I [CONFIG
\fEXAMINE,CLA IAC
ALTER,  DCA XSWTCH
        JMS I [TSTNAM   /ALTER ALLOWS MODS TO A PARTICULAR
        JMS I [GRPNAM   /HANDLER'S ACTUAL CODE.
                        /LOOK AT DEVICE TYPE ENTRY
        JMS GETPG       /GET PAGE OF RESIDENCE
        DCA PAGAD       /SAVE IT.
        JMS I [GETNUM   /GET RELATIVE LOC TO ALTER
        JMP I [SYNTAX   /NO NUMBER
        GET
P2PAG,  TWOPAG          /IS THIS A 2-PAGE HANDLER?
        SPA CLA
        TAD [7600
        TAD [7600       /ALLOW 200 OR 400 MAXIMUM
        CLL
        TAD SIZE        /IS THE # TO ALTER TOO LARGE?
        SZL CLA
        JMP I [BADARG   /I GUESS IT IS
        TAD SIZE
        TAD PAGAD       /GET ABSOLUTE LOCATION
        DCA PAGAD
        TAD XSWTCH
        SZA CLA         /EXAMINE OR ALTER?
        JMP EXAM        /EXAMINE
        TAD CHAR        /ALTER
        SZA CLA         /CR?
        JMP GETVAL      /NO
        JMS EXAMSB      /YES, GIVE GUY  OLD VALUE FIRST
ODTL,   TAD ["/         /ODT LIKE
        JMS I [TTYOUT
        TAD [-100
        JMS I [GTEXT
        JMP ODTL
GETVAL, JMS I [GETNUM   /GET NEW CONTENTS
        JMP I (TSTEOL   /NO NUMBER
        TAD SIZE
        CDF 10
        DCA I PAGAD     /REPLACE THAT LOC.
        JMP I [CONFIG   /AND GET OUT
PAGAD,  0

/ALTER GROUPNAME,LOC=NEWVALUE
/ALTER GROUPNAME,LOC
/EXAMINE GROUPNAME,LOC
\f/SIZE ACTNAM
/SIZE ACTNAM=VALUE
/DCB ACTNAM
/DCB ACTNAM=VALUE
/CTL ACTNAM
/CTL ACTNAM=VALUE

SIZCM,  TAD (3          /SIZE COMMAND V3C
DCBCM,  TAD [-1         /EXAMINE DCB WORD
CTLCM,  TAD P2PAG       /EXAMINE CONTROL WORD
        DCA PUTAT
        TAD PUTAT
        DCA LOOKAT
        JMS I [TSTNAM   /GET A NAME
        JMS I [ACTNAM   /IT MUST BE ACTIVE
        JMS I [TEST
MEQL,   -"=;INPDCB
        4000;EXAMDCB
        0
        JMP I [SYNTAX
INPDCB, JMS I [GETNUM
        JMP I [CONFIG   /IGNORE = NOTHING
        TAD SIZE
        PUT
XSWTCH,                 /0 MEANS ALTER, 1 MEANS EXAMINE
PUTAT,  DCB
        JMP I [CONFIG   /THE USER LIVES DANGEROUSLY

EXAMDCB,GET
LOOKAT, DCB
        JMS PUTNUM
        TAD ["/
        JMS I [TTYOUT
        TAD [-100
        JMS I [GTEXT
        JMP EXAMDCB
        JMP INPDCB      /NOW PARSE OFF THE REPLY
\fEXAM,  JMS EXAMSB
        JMP I [CONFIG

EXAMSB, 0
        CDF 10
        TAD I PAGAD     /GET CURRENT CONTENTS
        CDF 0
        JMS PUTNUM      /PRINT IT
        JMP I EXAMSB

PUTNUM, 0               /PRINT AN OCTAL NUMBER
        DCA PTM
        TAD [-4         /4 DIGITS
        DCA PKNT
PLOOP,  TAD PTM
        RTL
        RTL
        AND [7
        TAD (60
        JMS I [TTYOUT
        TAD PTM
        RTL
        RAL
        DCA PTM
        ISZ PKNT
        JMP PLOOP
        JMP I PUTNUM
PTM,    0

PKNT,
TSTNAM, 0
        JMS I [GNAME    /COLLECT NAME
        TAD NAME1       /IF NO NAME FOUND, GIVE ERROR
        SZA CLA
        JMP I TSTNAM
NAMERR, JMS I [PRWD
        TEXT    /?NAME/
        JMP I [CONFIG
        PAGE
\f/PRINT FUNCTION TYPES OUT THE STATUS OF BUILD ON COMMAND
/AN * BESIDE A DEVICE INDICATES THAT IT IS CURRENTLY MARKED
/FOR INSERTION IN THE SYSTEM BEING BUILT.

TTY240,
PRINT,  STA
        DCA OLDPAG      /SET ILLEGAL OLD PAGE
        INIT
        ISZ I (LINEUP   /MAKE THINGS LINE UP
PRLUP,  ADVDSC          /ADVANCE TO NEXT DESCRIPTOR
        ADVBOT          /ADVANCE PAST A BOOTSTRAP (IF ANY)
        JMP DONE        /ALL DONE
        JMS I [GETPG    /GET PAGE OF NEW HANDLER
        DCA NEWPAG
        TAD NEWPAG
        CIA
        TAD OLDPAG      /COMPARE WITH LAST HANDLER'S PAGE
        SNA CLA         /SAME?
        JMP PRTPER      /YES
        JMS I [CRLF     /NO, GO TO NEXT LINE
        TAD NEWPAG
        DCA OLDPAG
        JMS PGNAME
        TAD TTY240
        JMS I [TTYOUT
PRTPER, GET             /GET ACTIVE BIT
        ACTIVE
        SPA CLA         /IS IT ACTIVE?
        TAD ("*-STA     /YES, PRINT *
        TAD TTY240      /NO, PRINT SPACE
        JMS I [TTYOUT
        JMS PNAME       /PRINT PERMANENT NAME
        JMP PRLUP

PGNAME, 0
        GET
        GRPNM1
        JMS I (PRINTE   /PRINT GROUP NAME
        GET
        GRPNM2
        JMS I (PRINTE
        TAD (":
        JMS I [TTYOUT
        JMP I PGNAME
\fDONE,  DCA I (LINEUP   /NO MORE LINE-UP
        TAD DSKG1
        SNA CLA
        JMP TELCOR
        JMS I [CRLF     /TELL GUY ABOUT 'DSK'
        JMS I [CRLF
        JMS I [PRWD
        TEXT    /DSK=/
        TAD DSKG1
        JMS I (PRINTE
        TAD DSKG2
        JMS I (PRINTE
        TAD (":
        JMS I [TTYOUT
        TAD DSKP1
        JMS I (PRINTE
        TAD DSKP2
        JMS I (PRINTE
TELCOR, TAD NEWCOR
        SNA
        JMP I [CONFIG   /NO SPECIFIED CORE LIMIT
        JMS I [ROTL
        TAD (6000
        DCA CORMSG+3
        JMS I [CRLF
        JMS I [PRWD
CORMSG, TEXT    /CORE= /
        JMP I [CONFIG
\f/QUICK PRINT

QLIST,  INIT
QLUP,   ADVDSC          /ADVANCE TO NEXT DESCRIPTOR
        ADVBOT          /ADVANCE OVER ANY BOOTSTRAP IF NECESSARY
        JMP DONE        /GO AWAY WHEN NO MORE
        GET
        ACTIVE          /GET ACTIVE BIT
        SMA CLA         /IS IT ACTIVE?
        JMP QLUP        /NO, IGNORE IT
        GET             /YES
        SYSBIT
        RAL
        SPA CLA         /IS IT 'SYS'?
        JMS PGNAME      /YES, PRINT GROUP NAME TOO
        JMS PNAME       /NO, PRINT PERMANENT NAME ONLY
        JMP QLUP

DT,
PNAME,  0
        GET
        PRMNM1
        JMS I (PRINTE
        GET
        PRMNM2
        JMS I (PRINTE
        TAD TTY240
        JMS I [TTYOUT
        JMP I PNAME
\f       DCBTBL=7760

WHAT,   JMS I [PRNAME
        JMS I [PRWD
        TEXT /?/        /FOR WHEN A COMMAND ERROR OCCURS
        JMP I [CONFIG


DTYPE,  0               /RETURNS TYPE OF OUTPUT
        TAD (DCBTBL-1
        DCA DT          /ENTRY AC HAD DEVICE #
        CDF 10
        TAD I DT        /IF FILE DEVICE, LINK=0
        CDF 0
        CMA RAL         /ALSO, IF FILE AC=0 ON EXIT
        CLA RAL
        JMP I DTYPE
\fWRITCC,        0
        TAD [-6         /PUT IN DATA BREAK FILLERS
        JMS I [MOVE
        CDF 0
        K7750
        CDF 0
        PG7600+200+150
        TAD (4200
        JMS I [SYS      /WRITE NEW CCB
        BLDCCB-200
        37
        JMP I WRITCC
        PAGE
\fTOOMANY,JMS I [PRWD
        TEXT    /?HANDLERS/
        JMP I [CONFIG

BADLOD, JMS I [CRLF
        JMS I [PRWD
        TEXT    /?BAD LOAD/
        DCA I TABLMT    /RESTORE SENTINEL 0
        JMP I [CONFIG
\fTEST,  0               /TEST CHAR AGAINST ARGUMENTS
        TAD I TEST      /PICK UP ARGUMENT FROM LIST
        SNA             /0 TERMINATES
        JMP I TEST
        TAD CHAR        /SEE IF THEY COMPARE =
        AND (3777       /COMPARE ONLY LOW ORDER, THUS ALLOWING '4000' TO MEAN '0'
        SNA CLA
        JMP TSTOVR      /THEY DO..DISPATCH TO TABLE
        ISZ TEST
        ISZ TEST
        JMP TEST+1      /THEY DON'T. KEEP GOING
TSTOVR, ISZ TEST
        TAD I TEST
        DCA TEMP
        JMP I TEMP

K7750,  7750            /DATA BREAK FILLERS
        7751
        7752
        7753
        7754
        7755

SYS,    0               /SAVES A FEW WORDS IN SYSTEM CALLS
        DCA SYCTL       /SAVE FUNCTION WORD
        TAD I SYS
        DCA SYBUF       /BUFFER BEING USED
        ISZ SYS
        TAD I SYS
        DCA SYREC       /RECORD #
        ISZ SYS         /THERE IS NO ERROR RETURN
/IF SWAPER SET AND BOOTDV SET, USE SPECIAL BOOT HANDLER HERE
GO,     JMS I SYSENT
SYCTL,  0
SYBUF,  0
SYREC,  0
        SKP CLA
        JMP I SYS
        JMS I [PRWD
        TEXT    /SYS ERR/
        HLT             /IF USER IS DARING, HIT CONTINUE TO RETRY
        JMP GO

SYSENT, 7607
\f/*****************
/
/       SYS HANDLER IS 2-PAGES LONG IF LOCATION 7612 IS A 3
/
/******************

CLRTBL, 0
        TAD [BEGLIN
        DCA XR1
        TAD [-200       /ZERO OUT 5200-5377
        DCA TMP1
        DCA I XR1
        ISZ TMP1
        JMP .-2
        JMP I CLRTBL

/FOR HANDLER ONLY
ORGLIM, 0               /THIS ROUTINE MAKES CERTAIN THAT
        DCA CLRTBL      /THE ORIGIN FOR LDABS IS WITHIN
        TAD CLRTBL      /THE BOUNDS SPECIFIED BY SIZE
        TAD [7600       /AND THE CONTENTS OF HNDPTR
        SPA
        JMP BADORG      /ORIGIN BELOW 200
        CIA
        TAD [400        /IS ORIGIN WITHIN UPPER BOUND?
        SPA CLA
        JMP BADORG
        TAD CLRTBL
        TAD [7600       /NOW GIVE BACK RELATIVE BUFFER
        TAD HNDPTR      /ADDRESS IN FIELD 1
        DCA CLRTBL
        TAD CLRTBL
        AND [7600
        TAD [200
        SNA CLA
        JMP I (NOROOM   /CAN'T 'ORIGIN' INTO PAGE 7600
        TAD CLRTBL
        JMP I ORGLIM

BADORG, JMS I [PRWD
        TEXT /?ORIGIN/
        JMP I (OVROUT

/SOMEWHERE TEST IF HE GAVE US A 2-PAGE BUT REQ A 1-PAGE
\f/      PG7600_0
/       BLOK66_66
/       IF OLD SYS WAS 1 PAGE, BLOK66/L_PG7600/L

RECZRO, 0               /READS FIELD 1 CODE, EVEN FOR 12K TD8E
        TAD [200
        JMS I [SYS      /READ RECORD 0
        PG7600
        0               /THAT NORMALLY CONTAINS FIELD 1
        TAD (210
        JMS I [SYS      /READ RECORD 66
        BLOK66
        66
        TAD FLAG2       /DID PREVIOUS SYSTEM HAVE A 2-PAGE HANDLER?
        SZA CLA
        TAD [-200       /NO
        JMS I [MOVE     /YES
        CDF 0
        PG7600
        CDF 10
        BLOK66
        JMP I RECZRO

NOTNUF, JMS I [PRWD
        TEXT    /?CORE/
        JMP I [CONFIG
        PAGE
\fUNLOAD,        JMS I [TSTNAM   /PULL OFF A NAME
        JMS I [GRPNAM   /IT HAD BETTER BE A GROUP NAME
        JMS I [TEST
        -":;UNLPRM
        4000;UNLGRP
        0
        JMP I [SYNTAX

UNLPRM, JMS I (SAVNAM   /UNLOAD PARTICULAR HANDLER
UNLNAM, JMS I [TSTNAM
        JMS I [BIGNAM
        TAD DSCPTR      /DELETE A SINGLE DESCRIPTOR
        DCA SAVPTR      /DON(T DELETE HANDLER
        TAD DSCPTR      /OR BOOTSTRAP
        TAD [HDRSIZ     /NO RELOCATION NECESSARY
        DCA LSTPTR
        TAD TABLMT
        JMP NOMOR
\fUNLGRP,        JMS I [GETPG    /GET PAGE OF RESIDENCE
        DCA TOMOV       /START OF HANDLER
        GET
        TWOPAG          /IS IT A 1- OR 2- PAGE HANDLER?
        SPA CLA
        TAD [200        /2 PAGE
        TAD [200        /1 PAGE
        DCA UNSIZE
        TAD TOMOV       /DELETE HANDLER AND MOVE ALL FOLLOWING DOWN
        TAD UNSIZE
        DCA FROMOV      /GET FIRST LOCATION AFTER HANDLER
        TAD HNDPTR      /GET NEXT FREE LOCATION FOR HANDLER
        CIA
        TAD FROMOV      /GET NUMBER OF LOCS TO MOVE
        JMS I [MOVE
        CDF 10
FROMOV, 0
        CDF 10
TOMOV,  0               /UPDATE POINTERS; SEARCH DESCRIPTORS
        TAD UNSIZE      /FOR REFS TO MOVED HANDLERS AND DECREASE
        CIA             /THOSE REFS BY -UNSIZE
        TAD HNDPTR
        DCA HNDPTR      /FREES SOME BUFFER SPACE
        TAD TABLMT
        DCA OLDTOP      /REMEMBER ORIGINAL TOP OF STACK
        STA             /BACK UP OVER GROUP COUNT
        TAD DSCPTR
        DCA SAVPTR      /REMEMBER THIS LOCATION
        TAD UNSIZE
        JMS I [ROTL
        CIA
        DCA UNSIZE
        TAD DSCPTR
        TAD [HDRSIZ
        DCA LSTPTR      /'LSTPTR' POINTS TO FIRST DESCRIPTOR BEING MOVED
\f/COMPRESS THE DESCRIPTORS ABOVE THIS ONE

ADV,    ADVDSC          /ADVANCE TO NEXT DESCRIPTOR
        JMP BADV        /ENCOUNTERED A BOOTSTRAP RECORD
        JMP NOMORE      /NO MORE, THROUGH
GT,     JMS I [GETPG    /GET PAGE OF THIS DESCRIPTOR
        CLL CIA
        TAD TOMOV       /COMPARE WITH PAGE OF DELETED HANDLER
        SNA CLA
        JMP SAMPAG      /THEY'RE THE SAME
        SZL             /THEY'RE NOT THE SAME.  WHICH IS HIGHER?
        JMP ADV         /IT WAS BELOW HANDLER.  NO SWEAT.
        GET             /IT WAS ABOVE HANDLER, HAVE TO ACCOUNT FOR THIS
        PAGRES          /POINT TO NEW HANDLER LOCATION
        TAD UNSIZE
        PUT
        PAGRES
        JMP ADV         /CONTINUE
SAMPAG, TAD [HDRSIZ
        TAD DSCPTR
        DCA LSTPTR      /NOTE LOCATION OF NEXT DESCRIPTOR
        JMP ADV
/ADVANCE PAST BOOTSTRAP OR DELETE IT AS NECESSARY
BADV,   TAD DSCPTR
        CIA
        TAD LSTPTR
        SZA CLA         /IS THIS BOOT PART OF GROUP BEING UNLOADED?
        JMP BDV         /NO
        TAD I DSCPTR    /YES
        CIA
        IAC
        TAD DSCPTR
        DCA LSTPTR      /SET 'LSTPTR' TO BEGIN OF NEXT DESCRIPTOR
BDV,    ADVBOT          /ADVANCE OVER BOOTSTRAP
        JMP NOMORE      /DONE
        JMP GT          /GO ON TO NEXT DESCRIPTOR
\f/ALL DESCRIPTORS FOR THE SAME HANDLER ARE CONSECUTIVE
/MOVE DOWN DESCRIPTORS

NOMORE, TAD OLDTOP
NOMOR,  CIA
        TAD LSTPTR      /MINUS # OF WORDS TO MOVE
        JMS I [MOVE
        CDF 0
LSTPTR, 0               /FIRST DESCRIPTOR NOT CONSIDERED
        CDF 0
SAVPTR, 0               /POINTS TO INITIAL DESCRIPTOR BEING DELETED
        TAD LSTPTR
        CIA
        TAD SAVPTR      /GET NUMBER OF WORDS DELETED
        TAD TABLMT
        DCA TABLMT      /UPDATE TABLMT
        DCA I TABLMT    /MUST HAVE 0 AT TABLE END SO DON'T THINK IT'S A BOOTSTRAP
        JMS I [COMMA
        JMP UNLNAM

OLDTOP,                 /ORIGINAL TOP OF DESCRIPTORS
INI,    0
        TAD (DSCTAB-HDRSIZ
        DCA DSCPTR
        JMP I INI

        INIT=JMS I [INI

/RETURN TO CONFIG IF EOL, OR BACK IN-LINE IF COMMA

UNSIZE,
COMMA,  0
        TAD CHAR
        SNA
        JMP I [CONFIG
        TAD (-",
        SNA CLA
        JMP I COMMA
        JMP I [SYNTAX
\fBOOTQ, SZA CLA         /MAY BE OVERLAID
        JMP SAMEE
        DCA I (DRECT    /DON'T TOUCH DIRECTORY IF DIDN'T COPY SYS
SAMF,   JMS I [SYSWP
        JMP I (BOOT4
SAMEE,  JMS I (SYSCPY   /OR IF OLD DEV=NEW DEV
        JMP SAMF
        PAGE
\fLOCSYS,        0
        TAD (2331       /"SY"
        DCA NAME1
        TAD (2300       /"S "
        DCA NAME2
        DCA NAME3       /V3C
        DCA NAME4
        JMS I [ACTNAM   /LOOK UP 'SYS'
        JMP I LOCSYS

NOSLOT, JMS I [PRWD
        TEXT    /?SLOTS/
        JMP I [CONFIG

GOOD,   0
        TAD [4207       /RESTORE 7600 TO NORMAL
        DCA I [7600
        TAD [5000
        DCA I [7601
        TAD (CDF CIF
        DCA I [SA       /SET SA=00200
        TAD [200
        DCA I (SA+1
        DCA I (JSW      /SET JOB STATUS WORD=0
        STA
        DCA I (DRECT
        CLL STA RTL     /-3
        TAD I [7612     /FUDGE FOR 12K TD8E
        DCA FLAG2       /SET FLAG2=0 IF PREV SYSTEM WAS 2 PAGE
        JMP I GOOD
\fPACK,  ISZ PROTECT     /OK TO PACK IT?
        JMP PACKOK      /YES
        STA
        DCA PROTECT     /INHIBIT OTHER PACKS ALSO
        JMP GNAME2
PACKOK, ISZ SWIT        /PACK LEFT OR RIGHT
        JMP RIGHT
        TAD CHAR
        AND [77
        JMS I [ROTL     /ROTATE 6 LEFT
        DCA I TEMP      /STORE THE CHARACTER
        JMP GNAME2
RIGHT,  CLA CMA         /RESET FLIP FLOP
        DCA SWIT
        TAD CHAR
        AND [77
        TAD I TEMP
        DCA I TEMP
        ISZ TEMP        /POINT TO NEXT WORD
        JMP GNAME2
PROTECT,0               /-1 MEANS DON'T ACCEPT CHAR, IGNORE IT
SWIT,   0
\fDOT,   CLA CMA
        DCA SWIT
        TAD (-3         /NOW ALLOW ONLY A 2-CHAR EXTENSION
        DCA PROTECT
        TAD (NAME4
        DCA TEMP
        ISZ DOTCNT      /HAD WE SEEN A DOT BEFORE?
        JMP SYNTAX      /YES
        JMP GNAME2      /NO

DOTCNT, -1              /-1 MEANS HAVEN'T SEEN A DOT

EOL,    DCA CHAR
        JMP I GNAME

GNAME,  0               /COLLECT A WORD IN NAME1-NAME4
                        /LEAVE DELIMITING CHAR IN 'CHAR'
        CDF 0
        TAD [-7         /MAX 6 CHARACTERS
        DCA PROTECT
        DCA NAME1       /FIRST CLEAR OUT COLLECTION AREA
        DCA NAME2
        DCA NAME3
        DCA NAME4
        CLA CMA
        DCA SWIT        /L-R PACKING SWITCH
        STA
        DCA DOTCNT      /ALLOW ONLY ONE DOT PER NAME
        TAD (NAME1
        DCA TEMP
GNAME2, GETCHR
        SNA             /A 0 ENDS THE SEARCH
        JMP EOL
        DCA CHAR
        TAD CHAR
        TAD (-"A        /GET ONLY A-Z OR 0-9
        CLL
        TAD ("A-"Z-1
        SNL CLA         /IS IT A-Z?
        JMP PACK        /YES..PACK IT AWAY
        TAD CHAR
        TAD (-"0
        CLL
        TAD ("0-"9-1
        SNL CLA
        JMP PACK        /FOUND 0-9
        JMS I [TEST     /TEST FOR DELIMITING CHARS
        -".;DOT         /ADVANCE POINTERS
        0
        JMP I GNAME
\fSYNTAX,        JMS I [PRWD
        TEXT /?SYNTAX/
        JMP I [CONFIG

DSKBAD, JMS I [PRWD
        TEXT    /?DSK/
        JMP I [CONFIG
\f       SRES=BEGLIN+60  /RESIDENCY TABLE
        SDCB=BEGLIN+100 /DCB
        SHND=BEGLIN+120 /SLOT ASSSIGNED?
        SNAME=BEGLIN+140/NAME
        SBUFF=BEGLIN+160/ADDRESS OF HANDLER


/       SYSTEM TABLES:

/THOSE IN USR:

/PDNT   PERMANENT DEVICE NAME TABLE     (SNAME)
/       POINTED TO BY LOCATION 10036 IN USR
/       CONTAIN HASH CODE OF DEVICE NAME
/       ADD TWO WORDS OF NAME TOGETHER AND TURN ON BIT 0
/       IF SECOND WORD WAS NON-ZERO
/       AN ENTRY OF 0 MEANS THERE IS NO DEVICE FOR THAT ENTRY

/DHIT   DEVICE HANDLER INFORMATION TABLE        (SHND)
/       POINTED TO BY LOCATION 10037 IN USR
/       BIT 0           =1 IF THIS IS A TWO-PAGE HANDLER
/       BITS 1-4        RELATIVE BLOCK LOCATION OF HANDLER ON SYSTEM DEVICE
/                       (BLOCK SLOT).  ADD 15 TO GET ACTUAL BLOCK #.
/       BITS 5-11       RELATIVE ENTRY POINT OF HANDLER


/DHRT   DEVICE HANDLER RESIDENCY TABLE  (SRES)
/       IN LOCATIONS 17647-17665
/       ACTUAL ENTRY POINT OF HANDLER
/       WE ONLY CARE ABOUT IT IF THE HANDLER IS RESIDENT.
/       OTHERWISE IT'S ZERO.
/       THE SYSTEM HANDLER AND ALL HANDLERS CORESIDENT WITH
/       IT ARE ALWAYS RESIDENT IN CORE AND HAVE THIS ENTRY NON-0.


/DCWT   DEVICE CONTROL WORD TABLE       (SDCB)
/       RESIDES IN LOCATIONS 17760-17776
/       BIT 0           1 IF DEVICE IS FILE STRUCTURED
/       BIT 1           1 IF THE DEVICE IS READ ONLY
/       BIT 2           1 IF THE DEVICE IS WRITE-ONLY
/       BITS 3-8        PHYSICAL DEVICE TYPE
/       BITS 9-11       DIRECTORY BLOCK # (WE SET TO 0)
\f/PRE-ASSIGNED DEVICE TYPES

/0      TELETYPE
/1      HIGH SPEED PAPER TAPE READER
/2      HIGH SPEED PAPER TAPE PUNCH
/3      CARD READER
/4      LINE PRINTER (ANY TYPE)
/5      RK8 DISK
/6      RF08 (1 PLATTER)
/7      RF08 (2 PLATTERS)
/10     RF08 (3 PLATTERS)
/11     RF08 (4 PLATTERS)
/12     DF32 (1 PLATTER)
/13     DF32 (2 PLATTERS)
/14     DF32 (3 PLATTERS)
/15     DF32 (4 PLATTERS)
/16     TC08 DECTAPE
/17     LINCTAPE
/20     TM8E MAGTAPE
/21     TD8E DECTAPE (12K OR ROM)
/22     BAT:
/23     RK8E DISK
/27     TU60 CASSETTES
/30     VR12 (PDP-12 SCOPE)
        PAGE
\fBOOT2A,        TAD (15
        DCA SLOT        /START ASSIGNING AT BLOCK SLOT 16 (16-25)
        TAD (-17        /ALLOW 16 ACTIVE HANDLERS NOT COUNTING DSK
        DCA COUNT
        JMS I (CLRTBL   /CLEAR OUT IN-CORE TABLES
        TAD (SHND+1     /ASSIGN SLOTS, COUNT ACTIVE HANDLERS
        DCA XR1         /XR1 POINTS TO SLOT TABLE (DHIT)
        TAD (SDCB+1
        DCA XR2         /XR2 POINTS TO DCB TABLE
        TAD (SNAME+1
        DCA XR3         /XR3 POINTS TO PERMANENT DEVICE NAME TABLE
        TAD (SBUFF+1
        DCA XR4         /XR4 POINTS TO HANDLER BUFFER ADDRESSES
        TAD (SRES+1
        DCA XR5         /XR5 POINTS TO RESIDENCY TABLE
        CLA IAC         /??
        DCA OLDPAG      /SET 'OLDPAG' TO A RIDICULOUS VALUE
        INIT
SLTLUP, ADVDSC          /GO TO NEXT DESCRIPTOR
        ADVBOT          /ADVANCING OVER ANY BOOTSTRAPS
        JMP BOOT2X      /ALL DONE CREATING INTERNAL COPIES OF TABLES
        GET
        ACTIVE
        SMA CLA         /IS IT ACTIVE?
        JMP INACT       /NO
        ISZ COUNT       /YES, UPDATE COUNT
        JMP ACTIV
        JMP I (TOOMANY  /TOO MANY ACTIVE HANDLERS

BOOT2X,/        TAD I (SNAME    /SEE IF SYS WAS SPECIFIED
/       DCA SAMSYS      /0 IF DIDN'T SPECIFY NEW SYS
/       TAD SAMSYS
/       SZA CLA
/       JMP CHKDSK
/       CDF 10
/       TAD I (7760     /DIDN'T SPECIFY SYS SO USE CURRENT SYS
/       CDF 0
/       DCA I (SDCB
/       TAD (7607
/       DCA I (SRES
/CHKDSK,        TAD DSKG1       /WAS DSK SPECIFIED?
/       SZA CLA
/       JMP I (BOOT3    /YES, ALREADY SET UP
/       TAD I (SDCB
/       DCA I (SDCB+1
/       TAD (7607
/       DCA I (SRES+1
/       DCA I (SBUFF+1
        JMP I (BOOT3
\fCHKRES,        0
        JMS I [GETPG    /GET PAGE OF RESIDENCE
        DCA NEWPAG
        TAD NEWPAG
        TAD OLDPAG
        SNA CLA         /SAME OR PREVIOUS PAGE?
        JMP I CHKRES    /YES, SAME PAGE
        ISZ CHKRES
        GET             /NO, A NEW PAGE, NEEDS NEW SLOT, ETC.
        CORES
        RTL             /GET CORES BIT
        SPA CLA         /IS THIS ALLOWED TO START A NEW GROUP?
        JMP I (TWOSYS   /NO, IT MAY ONLY BE CORESIDENT WITH SOMETHING EARLIER
        TAD NEWPAG      /YES
        CIA
        DCA OLDPAG      /GOT NEW 'OLDPAG'
        JMP I CHKRES
\fACTIV, JMS CHKRES
        JMP SAMPG
        GET
        SYSBIT
        RAL
        SPA CLA         /IS IT A 'SYS' HANDLER?
        JMP I (SETSY    /YES
        JMS I (GETSLOT  /NO
        JMS I (SETSLT   /SET BLOCK SLOT
        DCA I XR1
        TAD NEWPAG
HNDLOC, DCA I XR4       /STORE AWAY ADDRESS OF HANDLER (OR 0 IF PREVIOUSLY USED)
        JMS I (GETDCB
        DCA I XR2       /SET DCB
        GET             /HASH CODE NAME
        PRMNM2
        DCA TEMP        /SAVE 2ND WORD
        GET
        PRMNM1
        TAD TEMP        /ADD 2 WORDS
        DCA TMP1        /SAVE SUM
        TAD TEMP
        SNA CLA         /WAS 2ND WORD 0?
        JMP NO4C        /YES
        TAD TMP1        /NO, FORCE BIT 0 ON
        RAL
        STL RAR
        DCA TMP1
NO4C,   TAD TMP1        /TAKE CODED NAME
        DCA I XR3       /SET PERMANENT NAME TABLE
        GET
        CORES
        RTL             /GET CORESIDENT BIT
        SMA CLA         /IS IT RESIDENT?
        JMP NORE        /NO
        GET             /YES
        ENTPT           /GET RELATIVE ENTRY POINT
        AND [177
        TAD [7600       /CORESIDENT ENTRY POINTS TO SYS MUST BE ON PAGE 7600
NORE,   DCA I XR5       /SET RESIDENCY TABLE
INACT,  GET             /BUT MAYBE IT'S 'DSK'
        DSKBIT
        RTL
        SNL CLA         /IS IT DSK?
        JMP SLTLUP      /NO, IT'S TO BE IGNORED
        JMS I (SLOTDSK  /YES ASSIGN 'DSK''S LOCATION SLOT
        GET             /GET RID OF DSK BIT
        DSKBIT
        RTL
        CLL RTR
        PUT
        DSKBIT
        JMP SLTLUP      /REITERATE
\fSAMPG, TAD SLOT        /ALREADY HAVE SLOT
        JMS I (SETSLT
        DCA I XR1
        JMP HNDLOC

BADARG, JMS I [PRWD
        TEXT    /?ARG/
        JMP I [CONFIG
        PAGE
\f/      STEPS IN BOOTSTRAPPING:

/1.     ASSIGN DSK, IF SPECIFIED, MAKE SURE NFS         [BOOT2]
/2.     ASSIGN SLOTS                                    [BOOT2A]
/3.     GIVE ERROR IF TOO MANY ACTIVE OR TOO MANY SLOTS [BOOT2A]
/4.     BUILD INTERNAL COPIES OF DCB, SLOT, NAME, RES   [BOOT2A]
/5.     ALSO BUILD HANDLER ADDRESS TABLE, CONTAINS      [BOOT2A]
/       HANDLER ADDRESS IF NOT PREVIOUSLY WRITTEN OUT
/6.     COMPARE DCB'S OF NEW AND OLD SYSTEM, IF DIFF,   [BOOT3]
/       COPY SYSTEM OVER.  LEAVE NEW SYSTEM HANDLER
/       IN CORE
/7.     ASK GUY ABOUT NEW DIRECTORY                     [BOOT4]
/8.     READ IN USR, UPDATE ITS TABLES, WRITE OUT USR   [BOOTC]
/       NAME TABLE, DHIT (SLOT, 2-PAGE,ENTPT)
/9.     READ IN CURRENT PAGE 7600 IMAGES                [BOOT5]
/       SET UP AS FOLLOWS:
/       PG7600/L:       BOOT
/       PG7600/H:       07600 IMAGE
/       BLOK66/L:       17600 IMAGE
/       BLOK66/U:       27600 IMAGE
/       THIS IS ACCOMPLISHED VIA:
/       PG7600_0
/       BLOK66_66
/       IF OLD SYS WAS 1 PAGE, BLOK66/L_PG7600/L
/10.    MOVE DCB AND RESIDENCY TABLES INTO 17600 IMAGE  [BOOT6]
/11.    MOVE BOOTSTRAP INTO PAGE 7600 IMAGES (2 PLACES) [BOOT7]
/12.    WRITE OUT HANDLERS                              [BOOT8]
/13.    ZERO DIRECTORY IF REQUESTED                     [BOOTD]
/14.    PUT SYS, DATA BREAK, CORE LIM IN 07600 IMAGE    [BOOTE]
/15.    WRITE 7600 IMAGES BACK OUT ONTO TAPE            [BOOTF]
/       IF NEW SYS IS 1-PAGE, PG7600/L_BLOK66/L
/       0_PG7600
/       66_BLOK66
/16.    READ BACK PAGE 7600 IMAGES.  MOVE IN FIELD 1 STUFF
/       EXCEPT FOR CD AREA, RESTORE TODAY'S DATE,
/       BRANCH TO 7600
\fGETSLOT,0
        ISZ SLOT        /USE NEXT SLOT
        TAD SLOT
        TAD (-26
        SNA CLA
        JMP I (NOSLOT
        TAD SLOT
        JMP I GETSLOT

BOOT,   ISZ I (RETSW    /***?
        CLA IAC
        DCA I (BD       /DISABLE 'BUILD' CMD
/SEE IF ARGUMENT WAS GIVEN; TREAT IT AS BOOT DEVICE,
/SAVE HANDLER ADDRESS (MUST BE AN ACTIVE HANDLER)
        JMS I (LOCSYS   /IN CASE DSK=SYS
/       JMS I [GETNUM
/       NOP
/       TAD SIZE
/       DCA BOOTDV      /CHECK THAT # IS GT 7600
BOOT2,  TAD DSKG1       /FIND OUT ABOUT 'DSK'
        SNA
        JMP GOTD        /DSK=SYS
        DCA SAV1
        TAD DSKG2
        DCA SAV2
        TAD DSKP1
        DCA NAME1
        TAD DSKP2
        DCA NAME2
        JMS I [BIGNAM   /FIND IT IN TABLES
GOTD,   GET
        DCB
        SMA CLA         /IS IT FILE-STRUCTURED?
        JMP I (DSKBAD   /NO
        GET             /YES
        DSKBIT
        RTL
        STL RTR         /TURN ON BIT 1
        PUT
        DSKBIT
        JMP I (BOOT2A
\fGETDCB,        0
        GET
        PLATNUM
        JMS I [ROTL
        AND [7          /GET # OF PLATTERS
        SNA
        IAC             /0 MEANS 1
        TAD [-1         /SUBTRACT 1
        CLL RTL
        RAL             /TIMES 10
        DCA TMP1
        GET
        DCB
        AND [7770       /MASK OFF USEFUL INFO
        TAD TMP1
        JMP I GETDCB
\fSLOTDSK,0
        JMS I (CHKRES
        JMP SMPG
        TAD NEWPAG
        DCA I (SBUFF+1
        JMS GETSLOT
        JMS SETSLT
B,      DCA I (SHND+1
        JMS GETDCB
        DCA I (SDCB+1
        TAD (5723       /'DSK' HASHED
        DCA I (SNAME+1
        GET
        SYSBIT
        RTL             /SYSBIT TO L, CORES BIT TO AC0
        SNL SMA CLA     /IS IT EITHER SYS OR CORESIDENT WITH SYS?
        JMP NORE2       /NO, SO IT'S NOT CORE-RESIDENT
        GET             /YES, RESIDENT AT ALL TIMES IN 07600
        ENTPT
        AND [177
        TAD [7600
NORE2,  DCA I (SRES+1
        JMP I SLOTDSK

SETSY,  TAD NEWPAG
        DCA I (SBUFF
/       JMS SETSLT      /NO BLOCK SLOT
        DCA I (SHND
        JMS GETDCB
        DCA I (SDCB     /SET DCB
        TAD I (SNAME
        SZA CLA
        JMP I (TWOSYS
        TAD (4631       /HASH CODING FOR 'SYS'
        DCA I (SNAME
/CHECK THAT NAME IS 'SYS'
        TAD [7607
        DCA I (SRES
/CHECK REL ENTRY PT IS 7
        JMP I (INACT

SMPG,   TAD SLOT
        JMS SETSLT
        JMP B
\fSETSLT,        0
        SNA
        JMP .+3
        TAD [-15
        JMS I [ROTR
        DCA TMP1
        GET             /
        CORES           /
        RTL             /
        SPA SZL CLA     /
        JMP I SETSLT    /SYS &CORES HANDLERS GET 0 ENTRY (UNFORTUNATELY)
        GET
        ENTPT
        AND (4177
        TAD TMP1
        JMP I SETSLT
        PAGE
\f       USRBLK=13       /BLOCK OF USR ON SYSTEM DEVICE
        USRNPT=36       /POINTS TO USR PTR TO PERMANENT DEVICE NAME TABLE
        USRHPT=37       /POINTS TO USR PTR TO DEVICE HANDLER INFORMATION TABLE

BOOTC,  TAD [200        /READ FIRST BLOCK OF USR
        JMS I [SYS
        BUFFER          /INTO BUFFER
        USRBLK
        TAD I [BUFFER+USRNPT    /GET POINTER TO NAME TABLE
        TAD [BUFFER-400 /ADD IN OFFSET FOR RELOCATION
        DCA T1AD        /ASSUME BOTH TABLES OCCUR IN THE SECOND
        TAD I [BUFFER+USRHPT    /BLOCK OF THE USR
        TAD [BUFFER-400
        DCA T2AD        /GET POINTER TO DHIT
        TAD [400        /READ BLOCKS 2 AND 3 OF USR
        JMS I [SYS      /INTO BUFFER,BINARY
        BUFFER
        USRBLK+1
        TAD [-17
        JMS I [MOVE     /MOVE IN PERMANENT DEVICE NAME TABLE
        CDF 0
        SNAME
        CDF 0
T1AD,   HLT
/       TAD SAMSYS      /WAS SYS SPECIFIED?
/       SZA CLA
/       JMP CHKD2       /YES
/       TAD I T2AD      /NO, USE CURRENT SYS INFO
/       DCA I (SHND
/CHKD2, TAD DSKG1
/       SZA CLA         /WAS DSK SPECIFIED?
/       JMP MVSHND      /YES
/       TAD I T2AD      /MAKE SAME AS SYS
/       DCA I (SHND+1
MVSHND, TAD [-17        /NOW PUT IN SLOT WORDS (DHIT)
        JMS I [MOVE
        CDF 0
        SHND
        CDF 0
TMP2,
T2AD,   HLT
        TAD [4400       /RE-WRITE USR
        JMS I [SYS
L5400,  BUFFER
        USRBLK+1
        JMP I [BOOT5
        IFNZRO BUFFER-5400 <ERRRR,XX>
\fBOOTD, TAD DRECT       /WANT NEW DIRECTORY?
SNACLA, SNA CLA
        JMP BOOTE
        TAD L5400       /YEP. WRITE ONE
        JMS I [SYS
        DPROPR
        1
BOOTE,  TAD NEWCOR
        CLL RAL
        RTL
        TAD SAVHID      /V3D SET NEW H.O. DATE WORD
        DCA I [7777     /SET UP NEW CORE LIMIT
        TAD SYSLOC      /MOVE IN FRESH COPY OF SYS HANDLER
        TAD [7
        DCA SYSL2
        TAD [7607-7743-1
        JMS I [MOVE
        CDF 10
SYSL2,  HLT
        CDF 0
        7607
        TAD [-200       /PUT SYS HANDLER INTO REC 0 BUFF. ???
        JMS I [MOVE
        CDF 0
        7600
        CDF 0
        PG7600+200      /RESIDENT F0 CODE
        JMS I (WRITCC   /WRITE CCB AND DATA BREAK FILLERS
        TAD [200
        TAD SYSLOC      /MOVE IN COPY OF 27600 AGAIN
        DCA SYSL3
        TAD [-200
        JMS I [MOVE
        CDF 10
SYSL3,  HLT
        CDF 10
        BLOK66+200
        JMP I (BOOTF

DRECT,  -1              /1 MEANS WRITE A ZERO DIRECTORY
                        /0 MEANS DON'T TOUCH DIRECTORY
                        /-1 MEANS ASK GUY FOR OPTION
\f/SEE IF NEW SYSTEM HAS SAME DCB AS CURRENT SYSTEM
/THIS MAY WELL CAUSE EXTRA I/O WHEN GOING FROM RF08=K TO RF08=M

BOOT3,  CDF 10
        TAD I (DATEWD
        DCA SAVDAT      /SAVE TODAY'S DATE FOR FUTURE REFERENCE
        TAD I (DCBTBL   /GET DCB OF CURRENT SYSTEM
        CDF 0
        AND [7770
        DCA TMP2
        JMS I (PATCH    /V3D
        TAD SAVLOC      /DON'T COPY IF DID 'BUILD'
        SNA CLA         /WAS THE 'BU' COMMAND USED?
        TAD [-10        /NO, USE 'SZA CLA'
        TAD SNACLA      /YES, USE 'SNA CLA'
        DCA I (BOOTQ
        JMS SETUPSYS
        TAD SYSDCB
        CIA
        TAD TMP2
        JMP I (BOOTQ

/NOTE: THIS PROCEDURE DOESN'T COPY BOOTSTRAP IF NEW DEV=OLD DEV.
/       THEREFORE YOU CAN'T CHANGE BOOTSTRAPS
/       CHECK ON AFFECT FOR TD8E/ROM INTERACTION
\fSETUPSYS,0
        DCA SAVLOC
        TAD SAVLOC
        DCA I (SAVLC
        JMS I (LOCSYS
        JMS I [GETPG    /GET PAGE OF SYS HANDLER
        DCA SYSLOC      /PAGE OF START OF NEW SYSTEM HANDLER
        JMS I (GETDCB
        DCA SYSDCB
        JMS I (GETLEN
        GET
        TWOPAG
        DCA I (SYSSIZ
        TAD I (SYSSIZ
        SMA CLA         /IS IT 1- OR 2-PAGES?
        JMP ONEPG       /GUESS WHAT THIS MEANS [HINT LOOK AT LABEL]
        STA
        TAD I (AMTCOR
        SNA CLA
        JMP I (NOTNUF   /WE CAN'T RUN IN 8 K
ONEPG,  TAD [-400
        JMS I [MOVE
        CDF 10
SYSLOC, HLT             /MOVE SYSTEM HANDLER
        CDF 10
SAVLOC, 0               /TO 10000-10377
        JMP I SETUPSYS
        PAGE
\f/ASSUMES NEW PROPOSED SYSTEM HANDLER IS IN 10000-10377

/CAN'T DESTROY OS/8, IE. CAN'T USE PG 0 TEMPS

SYSWP,  0               /ROUTINE TO MOVE SYS HANDLER AROUND
        ISZ SWAPER      /DIDDLE SWAP INDICATOR
        CLA CMA         /-1 MEANS NEW HANDLER IS IN
        DCA SWAPER
        STA
        TAD AMTCOR
        SNA CLA         /DO WE HAVE 8K?
        JMP SWAPLW      /YES, DON'T SWAP WITH FIELD 2
        TAD L7600       /NO, CAN'T HURT TO SWAP FIELD 2
        DCA OUT
        TAD SAVLC
        TAD P200
        DCA IN
        TAD (4-200
        DCA STEMP       /SWAP ENTIRE PAGE (EXCEPT LAST 4 LOCATIONS)
SWAP3,  CDF 10          /SWAP 27600 & 2ND PAGE OF HANDLER
        TAD I IN
        DCA SYSQ
        CDF 20
        TAD I OUT
        CDF 10
        DCA I IN
        TAD SYSQ
        CDF 20
        DCA I OUT
        ISZ IN
L7400,  7400            /NOP
        ISZ OUT
L7600,  7600
        ISZ STEMP
        JMP SWAP3
SWAPLW, CDF 0
        TAD (7607
        DCA OUT         /7607 ALWAYS TARGET DESTINATION
        TAD SAVLC
        TAD (7
        DCA IN
        TAD (7607-7743-1/ONLY 7607-7743 GETS MOVED
        DCA STEMP
SWAP2,  CDF 10
        TAD I IN
        DCA SYSQ        /TEMP STORE
        CDF 0
        TAD I OUT
        CDF 10
        DCA I IN
        TAD SYSQ
        CDF 0
        DCA I OUT
        ISZ IN
        ISZ OUT
        ISZ STEMP
        JMP SWAP2
        DCA I (SOFSET   /V3C
        JMP I SYSWP

AMTCOR, 1               /HIGHEST CORE BANK
SAVLC,  0               /MUST BE ABOVE 3577
\fCHTMP,
IN,     0               /POINTS TO HANDLER AREA AT ONE NAMED SYS
OUT,    0               /POINTS TO 7607 HANDLER
SWAPER, 0               /-1 MEANS NEW HANDLER IN
\f/MUST BE ABOVE OS/8,  NO PAGE 0 LITERALS

STEMP,
ICHAR,  0
        JMS I (CTCTST
        ISZ JMPGET      /POINT TO CORRECT CHAR
        ISZ CHCNT       /NEED WE READ?
JMPX,   JMP JMPGET      /NOT YET
        TAD REOF        /YES. DID LAST YIELD EOF?
        SZA CLA
        JMP I (BADINP   /SOMETHING IS WRONG.
RDIN,   JMS I DVICE
P200,   0200            /READ INTO FIELD 0
BINBUF, BINARY
RECNO,  0
        JMP RERROR      /READ ERROR
RECNO2, ISZ RECNO       /POINT TO NEXT RECORD
        TAD (-601
        DCA CHCNT       /NEW CHARACTER COUNT
        TAD BINBUF
        DCA CHPTR
        TAD JMPX
        DCA JMPGET      /RESET JUMP SWITCH
        JMP ICHAR+1
SYSQ,
JMPGET, JMP .           /IF WE GET CAUGHT HERE, WE KNOW IT
        JMP CHAR1       /ASSEMBLE FIRST CHAR
        JMP CHAR2       /SECOND CHAR
        TAD JMPX        /THIRD CHAR HERE
        DCA JMPGET      /RESET SWITCH
        TAD I CHPTR
        AND L7400
        CLL RTR
        RTR
        TAD CHTMP       /ADD IN THE LAST TEMP STORE
        RTR
        RTR
        ISZ CHPTR       /TO NEXT CHAR
        JMP GCHCOM
\fCHAR2, TAD I CHPTR
        AND L7400
        DCA CHTMP       /SAVE FOR THIRD CHAR
        ISZ CHPTR
CHAR1,  TAD I CHPTR
GCHCOM, AND (377
        ISZ ICHAR       /PASS UP ERROR RET
        JMP I ICHAR
RERROR, SPA CLA         /FATAL, OR EOF?
        JMP IOERR       /FATAL
        ISZ REOF        /END OF FILE
        JMP RECNO2      /BACK TO MAINSTREAM
IOERR,  JMS I (PRWD
        TEXT    \?I/O\
        JMP I ICHAR
REOF,   0
CHCNT,  0
CHPTR,  0
DVICE,  0
        PAGE
\f/BLOCK 0 OF DEVICE CONTAINS INITIAL IMAGE
/OF 17600 FOLLOWED BY 07600

/17600-17646    CD AREA INITIALLY CONTAINS BOOTSTRAP
/17647-17665    RESIDENCY TABLE
/17666          DATE
/17667-17677    PART OF OS/8 KBM
/17700-17740    PART OF OS/8 USR
/17741-17757    USER DEVICE NAME TABLE/ODT
/17760-17776    CONTROL WORD TABLE (DCB)
/17777          UNUSED

/07600-07606    PART OF OS/8 CODE
/07607-07743    SYSTEM HANDLER
/07744-07745    STARTING ADDRESS
/07746          JOB STATUS WORD (JSW)
/07747          MUST BE 0 (SOFSET)
/07750-07755    DATA BREAK LOCATIONS RESERVED FOR HARDWARE
/07756-07775    KBM AND ODT
/07776          MUST BE 0 (SBLOCK)
/07777          SOFTWARE CORE SIZE, BATCH FLAGS

/IF SYSTEM HANDLER IS TWO PAGES LONG, THEN WE HAVE INSTEAD:

/BLOCK 66 (LOWER) CONTAINS 17600 IMAGE
/BLOCK 66 (UPPER) CONTAINS 27600 IMAGE (MUST END WITH 4 ZERO'S)
/BLOCK 0  (LOWER) CONTAINS BOOTSTRAP
/BLOCK 0  (UPPER) CONTAINS 07600 IMAGE
\fDSCADV,        0               /ADVANCE TO NEXT DESCRIPTOR
                        /RETURN 2 MEANS NO MORE
                        /RETURN 1 MEANS NOW AT BOOTSTRAP BLOCK
                        /RETURN 3 OTHERWISE
        TAD DSCPTR
        TAD [HDRSIZ
        DCA DSCPTR
        JMS I (SKPCRD   /SKIP A POSSIBLE GROUP COUNT
        TAD I DSCPTR
        CLL
        TAD [200
        SZL CLA
        JMP I DSCADV    /TAKE RETURN1 UPON REACHING BOOTSTRAP RECORD
        ISZ DSCADV
        TAD I DSCPTR
        SZA CLA
        ISZ DSCADV      /TAKE RETURN 2 IF ADVANCED TO END
        JMP I DSCADV

/RETURN 1 MEANS NO MORE DESCRIPTORS
BOTADV, 0
        TAD I DSCPTR
        CIA
        IAC             /COUNT IS ONE MORE
        TAD DSCPTR
        DCA DSCPTR      /POINT TO BEGIN OF NEXT DESCRIPTOR
        JMS I (SKPCRD
        TAD I DSCPTR
        CLL
        TAD [200
        SZL CLA
        JMP BOTADV+1    /WIERD CASE OF CONSECUTIVE BOOTSTRAPS
        TAD I DSCPTR
        SZA CLA
        ISZ BOTADV      /TAKE RETURN1 IF ADVANCED TO END
        JMP I BOTADV

/WIERD CASES CAN OCCUR IF GUY DELETES ALL ENTRY POINTS IN A GROUP SEPARATELY

/DESCRIPTOR ENTRIES:

/FIRST WORD:
/       0               MEANS END OF TABLE
/       -1 TO -20       MEANS GROUP COUNT (NOT NECESSARILY ACCURATE)
/       -21 TO -400 APPROX MEANS BOOTSTRAP RECORD COUNT
/       OTHER           MEANS DESCRIPTOR
\fSYSCPY,        0               /COPY OS/8 SYSTEM
        STA
        TAD I (AMTCOR
        SZA CLA
        TAD [10         /GT 8K
        DCA CORBIT
        TAD CORBIT
        SZA CLA
        JMP COP2
        JMS I [SYSWP    /SWAP IN NEW SYS HANDLER
        TAD (7410
        JMS I [SYS      /SAVE PART OF BUILD TO MAKE A BIG BUFFER
        400             /SAVE 400-
        27              /SAVE IN BLOCK 27
        JMS I [SYSWP    /GET BACK ORIGINAL HANDLER
COP2,   TAD [4210
        JMS COPY        /COPY BLOCK 0
        0
        TAD (5610
        JMS COPY        /COPY 7-15
        7
        TAD [4210
        JMS COPY        /COPY 26
        26
        TAD (7410
        JMS COPY        /COPY 51-66
        51
        TAD [4210
        JMS COPY        /COPY 67
        67
        TAD CORBIT
        SZA CLA
        JMP COP3
        JMS I [SYSWP    /GET BACK NEW HANDLER FOR A MOMENT
        TAD (3410       /RESTORE CORE WE SAVED
        JMS I [SYS
        400
        27
        JMS I [SYSWP    /RESTORE ORIGINAL SYS HANDLER
COP3,   JMP I SYSCPY
\fCOPY,  0
        TAD CORBIT
        DCA TMP1
        TAD I COPY
        DCA COPREC      /ARG 1 CONTAINS FIRST BLOCK TO COPY
        TAD COPREC
        DCA CPREC2      /MAKE TWO COPIES
        STL RAR         /CONVERT 'WRITE' TO READ
        TAD TMP1
        JMS I [SYS      /READ FROM ORIGINAL DEVICE
        400
COPREC, HLT
        JMS I [SYSWP
        TAD TMP1
        JMS I [SYS      /WRITE ON NEW DEVICE
        400
CPREC2, HLT
        JMS I [SYSWP    /LEAVE WITH ORIGINAL SYSTEM HANDLER STILL IN SYSTEM
        JMP I COPY      /FALL THROUGH RECORD NUMBER
\fCORBIT,
GETLEN, 0
        GET             /GET LENGTH OF DEVICE
        PLATNUM
        JMS I [ROTL     /GET NUMBER OF PLATTERS
        AND [7
        SNA
        IAC             /0 MEANS 1
        CIA
        DCA COUNT
        GET
        DEVSIZ
        DCA TMP1
SIZLUP, TAD TMP1
        SNA
        STA             /4096 BECOMES 4095
        ISZ COUNT
        JMP SIZLUP
        CIA
        TAD [70         /LEAVE ROOM FOR OS/8
        DCA DLENGTH
        JMP I GETLEN

DPROPR, -1              /INITIAL EMPTY DIRECTORY
        MFREE
        0
        0
        -1
        0               /1 EMPTY FILE
DLENGT, 0
        PAGE
\f/WANT TO COPY

/SYS    0
/KBM    7-12
/USR    13-15
/ENTER  26
/CD     51-53
/SAVE,DATE 54-55
/ERR    56
/CHAIN  57
/ODT    60-63
/CCL    64,65,67
/SYS    66

/EXTRA (DON'T WANT TO COPY):

/HANDLERS       16-25
/SCRATCH        27-50

/NEW ALGORITHM:

/SET FIELD 2 IF 12K OR MORE AND SKIP *'ED ITEMS

/1.     MOVE NEW SYS HANDLER TO 0,200
/2.*    SAVE 34 PAGES STARTING AT 10400 IN BLOCK 27 OF NEW DEVICE
/3.     COPY BLOCKS 7-15
/4.     COPY BLOCK 26
/5.     COPY BLOCKS 51-66
/6.     COPY BLOCK 67
/7.*    RESTORE 34 PAGES
\f/THE FOLLOWING ROUTINES AND VARIABLES MUST BE ABOVE THE LOCATIONS
/IN WHICH OS/8 AND CD LOAD INTO, BECAUSE THEY ARE CALLED BY LDABS.
/FURTHERMORE, NONE OF THESE ROUTINES MAY USE PAGE 0 LITERALS
/OR MAY USE ANY PAGE 0 TEMPORARIES, EXCEPT THAT SOME MAY USE
/PAGE ZERO TEMPORARIES IF THE STORE INTO THEM FIRST
/(EXCEPT THOSE COMMENTED OTHERWISE, WHICH MUST PRESERVE
/THE NEW PAGE 0 AT ALL COSTS, UNTIL IT IS WRITTEN OUT

/LDABS
/ICHAR
/BADINP
/OVER
/ASSEMB
/CTCTST
/PRWD
/CTRLC
/OVROUT
/ROTL
/PRINTE
/TTYOUT
/ROTR
/PWORD
/ECHOFL
/LINEUP
/CRLF
/PRNT
/RUBFLG
/MOVE
/SYSWP
/AMTCOR
\f       SYDCB=7760      /LOCATION OF SYS,DSK DCB WORDS

BOOT5,  JMS I (RECZRO
BOOT6,  TAD [-17
        JMS I [MOVE     /PUT RESIDENT FIELD 1 TABLES INTO
        CDF 0
        SDCB            /FIXED SPOTS
        CDF 10
        BLOK66+160
        TAD [-17
        JMS I [MOVE
        CDF 0
        SRES
        CDF 10
        BLOK66+47       /COULD SET USER DEVICE NAMES HERE IF DESIRED
BOOT7,  JMS I (LOCSYS
/       TAD SAMSYS
/       SZA CLA         /SAME SYSTEM?
/       JMP BOOT8       /YES
BLOOK,  ADVDSC          /SEARCH FOR BOOTSTRAP
        JMP FNDBOT      /FOUND BOOTSTRAP RECORD AMONGST DESCRIPTORS
        HLT             /IT WASN'T THERE!
        JMP BLOOK       /KEEP LOOKING

FNDBOT, TAD DSCPTR
        IAC             /POINT TO BOOTSTRAP
        DCA FROMBO
        TAD I DSCPTR    /LENGTH OF BOOTSTRAP
/CHECK THAT'S IT'S LE 47 LOCS IF 1-PAGE SYSTEM
        JMS I [MOVE
        CDF 0
FROMBO, HLT
        CDF 0
        PG7600
        TAD [-47        /MOVE FIRST 47 LOCS INTO CD AREA IN 17600 IMAGE
        JMS I [MOVE
        CDF 0
        PG7600
        CDF 10
        BLOK66
BOOT8,  TAD (-16
        DCA COUNT
        TAD (SBUFF
        DCA XR1
        TAD (SHND
        DCA XR2
DVLOOP, TAD I XR1
        SNA
        JMP NOHN
        DCA DVBUF       /LOCATION OF HANDLER
        TAD I XR2
        JMS I [ROTL
        AND [17
        SNA
        JMP CN          /NO BLOCK SLOT
        TAD L15         /CONVERT TO ACTUAL BLOCK #
        DCA DVREC
        TAD [4210
        JMS I [SYS
DVBUF,  HLT
DVREC,  HLT
CN,     ISZ COUNT
        JMP DVLOOP
        JMP I (BOOTD
NOHN,   ISZ XR2
        JMP CN

SYSSIZ, 0               /MINUS MEANS 2-PAGE SYS HANDLER
\fCTRLC, KCC             /CLEAR ^C FLAG
        TAD I (SWAPER   /DO WE HAVE TO SWITCH?
        SZA CLA
        JMS I (SYSWP    /YES. INSERT OLD HANDLER
        JMP I (7600

KORE,   JMS I [GETNUM
L15,    15              /NOTHING MEANS 0
        TAD SIZE
        AND [7770
        SZA CLA
        JMP I [BADARG   /MUST BE BETWEEN 0 AND 7
        JMS I (RELCOR   /FIND REAL AMOUNT OF CORE
        CMA
        TAD SIZE
        SMA CLA
        JMP I (NOTNUF   /MUST BE .LE. REAL AMT OF CORE
        TAD CHAR
        SZA CLA
        JMP I [SYNTAX
        TAD SIZE
        DCA NEWCOR
        JMP I [CONFIG
\f/      IF NEW SYS IS 1-PAGE,   PG7600/L_BLOK66/L
/       0_PG7600
/       66_BLOK66

BOOTF,  TAD SYSSIZ
        SMA CLA         /IS NEW SYS TWO PAGES?
        TAD [-200       /NO
        JMS I [MOVE     /YES, NULL MOVE
        CDF 10
        BLOK66
        CDF 0
        PG7600
        TAD [4200
        JMS I [SYS
        PG7600
        0
        TAD [4210
        JMS I [SYS
        BLOK66
        66
BOOTG,  NOP
/       JMS I (RECZRO   /SIMULATE BOOTSTRAP
        TAD [-131       /MOVE UP FIELD 1 CODE
        JMS I [MOVE
        CDF 10
        BLOK66+47
        CDF 10
        7600+47
        TAD SAVDAT
        CDF 10
        DCA I (DATEWD
        CDF 0
        JMS I [PRWD
        TEXT /SYS BUILT/
        JMP I [7600
        PAGE
\f/MOVE MOVES CORE AROUND        (CALLABLE FROM ANY FIELD)

/       TAD (-# OF LOCS TO MOVE
/       JMS MOVE
/       CDF FROM FIELD
/       FROM BUFFER LOCATION START
/       CDF 'TO' FILED
/       TO BUFFER

/MUSTN'T DESTROY OS/8 LOCS, NO PAGE 0 TEMPS!

MOVE,   0
        DCA MVCT
        RDF
        TAD (CIF CDF
        DCA MOVRET
        TAD I MOVE      /GET CDF FROM-FLD
        DCA MVCDF2
        ISZ MOVE        /POINT TO FROM-BUF
        TAD I MOVE      /GET LOC TO MOVE
        DCA MVTM1
        ISZ MOVE        /POINT TO TO-CDF
        TAD I MOVE
        DCA MVDF        /GET CDF TO FIELD OF DESTINATION
        ISZ MOVE        /POINT TO TARGET AREA
        TAD I MOVE
        DCA MVTM2
        ISZ MOVE        /POINT TO RETURN
        TAD MVCT
        SNA CLA
        JMP MOVRET      /NOTHING TO MOVE
MVCDF2, CDF 0           /GETS ALTERED TO PICK UP F1
        TAD I MVTM1
MVDF,   HLT
        DCA I MVTM2
        ISZ MVTM1       /BUMP POINTERS TO AREAS
        ISZ MVTM2
MV20,   20
        ISZ MVCT
        JMP MVCDF2
MOVRET, HLT             /RETURN TO CALLING FIELD
        JMP I MOVE

CTCTST, 0
        TAD MV7600      /ALLOW FOR PARITY
        KRS
        TAD (-7603
        SNA CLA
        KSF
        JMP I CTCTST
        JMP I (CTRLC
\fMVCT,
IOPEN,  0               /PREPARE TO READ INPUT
        CLA CMA
        DCA I (CHCNT
        TAD I (JMPX     /RESTORE SWITCH
        DCA I (JMPGET
        TAD I (FILPTR   /RESULTS OF LOOKUP
        DCA I (RECNO
        DCA I (REOF
        TAD (CDF 0
        DCA I (XFIELD   /SETUP LDABS FOR FIELD 0
        JMP I IOPEN
\fBOOT4, TAD I (DRECT
        SMA CLA
        JMP I (BOOTC    /HE'S SPECIFIED ABOUT DIRECTORY ZERO
        JMS I [PRWD     /YES, NO NEED TO COPY SYSTEM
        TEXT    /WRITE ZERO DIRECT?/
        TAD [-10        /DON'T WANT TO DESTROY PRECIOUS TABLES
        JMS I [GTEXT    /GET REPLY
        JMP BOOT4
        JMS I [GNAME
        TAD NAME1
        AND [7700
        TAD (-3100
        SNA CLA
        CLA IAC         /Y
        DCA I (DRECT    /NO; COULD HAVE SAVED LOCATION BUT I FEEL SAFER THIS WAY
        JMP I (BOOTC

MVTM1,
ROTL,   0
        CLL RTL
        RTL
        RTL
        JMP I ROTL

MVTM2,
ROTR,   0
        CLL RTR
        RTR
        RTR
        JMP I ROTR
\fTTYOUT,        0               /YOU GUESSED IT
        DCA TM
        TAD ECHOFL
        SZA CLA         /ARE WE ECHOING?
        JMP I TTYOUT    /NO
        TAD TM          /YES
        TLS
        TSF
        JMP .-1
MV7600, 7600            /CLA
        JMS I (CTCTST   /TEST FOR ^C.
        JMP I TTYOUT

TM,
SKPCRD, 0
        TAD I DSCPTR
        CLL
        TAD MV20                /A GROUP COUNT MUST BE IN THE RANGE -1 TO -20
        SNL CLA
        JMP I SKPCRD
        ISZ DSCPTR      /IT'S A DARN GROUP COUNT, GO PAST IT
        JMP SKPCRD+1    /WIERD CASE OF CONSECUTIVE GROUP COUNTS

ECHOFL, 0               /1 MEANS NOT ECHOING, SAW ^O
\fPATCH, 0
        TAD I [7777     /V3D
        AND L600
        DCA SAVHID      /SAVE HIGH ORDER DATE BITS
        JMP I PATCH
        PAGE
\fPRNAME,        0               /ROUTINE TO PRINT NAME1-NAME4
        TAD (NAME1
        DCA TEMP
        CLL STA RTL     /-3
        DCA COUNT
PRNM2,  TAD I TEMP
        JMS PRINTE      /TYPE OUT CHARS
        ISZ TEMP
        ISZ COUNT       /EXHAUSTED ALL?
        JMP PRNM2
        TAD I TEMP
        SNA CLA
        JMP I PRNAME    /NO . IF NO EXTENSION
        TAD (".         /PRINT '.'
        JMS I (TTYOUT
        TAD I TEMP
        JMS PRINTE
        JMP I PRNAME

PRINTE, 0
        DCA CHTMP2
        TAD CHTMP2      /EXTRACT LEFT HAND SIDE
        JMS I (ROTR
        JMS PWORD
        TAD CHTMP2
        JMS PWORD
        JMP I PRINTE
\fPWORD, 0
        AND (77
        SNA             /IF NULL, GET OUT
        JMP NULL
        DCA PRTM
        TAD (200
        KRS
        TAD (-217       /^O
        SNA CLA         /STOP ECHOING?
        KSF             /MAYBE
        SKP             /NO
        JMP CTO         /YES
        TAD PRTM
        TAD (240
        AND (77
PRSPAC, TAD (240
        JMS I (TTYOUT
        JMP I PWORD
NULL,   TAD LINEUP
        SNA CLA         /PRINT SPACE?
        JMP I PRINTE    /NO
        JMP PRSPAC      /YES

PRWD,   0
        CLA
PRWD2,  TAD I PRWD
        JMS PRINTE
        TAD I PRWD
        ISZ PRWD
        AND (77
        SZA CLA
        JMP PRWD2
        JMP I PRWD      /LEAVE IF LAST WORD ENDED WITH 00

CHTMP2, 0

CTO,    KCC
        TAD ("^
        JMS I (TTYOUT
        TAD ("O
        JMS I (TTYOUT
        JMS CRLF
        CLA IAC
        DCA I (ECHOFL
        JMP I PWORD

LINEUP, 0               /NON-ZERO MEANS PRINT NULLS AS SPACES
\fOVER,  JMS ASSEMB      /EXTENSION OF LDABS.
        CIA
        TAD I LCKSUM    /CHECKSUM OK?
        SZA CLA
        JMP BADINP      /SOORY ABOUT THAT
        CLA IAC
        JMP OVROUT      /SKIP ERROR EXIT
BADINP, JMS PRWD
        TEXT /?BAD INPUT/
        JMS CRLF
OVROUT, TAD I (LDABS
        DCA OTEMP
        JMP I OTEMP
OTEMP,
ASSEMB, 0               /ASSEMBLE TWO 6 BIT WORDS
        TAD I LWD1
        JMS I PROTL     /INTO A SINGLE 12 BIT WORD
        TAD I LWD2
        JMP I ASSEMB

LCKSUM, CKSUM
LWD1,   WD1
LWD2,   WD2
PROTL,  ROTL
PRTM,   0
\fCRLF,  0
        TAD (215
        DCA NAME1
        JMS PRNT
        TAD (212
        JMS I (TTYOUT
        JMP I CRLF

PRNT,   0               /CHARACTER PRINT ROUTINE
        TAD ("\         /IF NOT RUBOUT, AND IF RUBOUT WAS
        ISZ RUBFLG      /LAST, ECHO \.
        SKP CLA
        JMS I (TTYOUT
        TAD NAME1
        JMS I (TTYOUT
        JMP I PRNT
RUBFLG, 0               /RUBOUT FLAG
        PAGE
\f/LDABS DOES A REAL LIVE ABSLOAD IF AC=0
/IF AC=-2 THEN IT IS LOADING A HANDLER, THIS IS DONE AS FOLLOWS:
/SEARCH FOR *0
/THEN LOAD CONSEC WORDS INTO DESCRIPTOR TABLE
/AT NEXT ORIGIN, LOAD WORDS INTO HANDLER AREA (ALLOW ORIGINS)

/CAN'T USE PAGE 0 LITERALS IN CASE LOADING OS/8

LDABS,  0
        DCA LODTST      /-2 IF HANDLER, 0 IF OS8
LDABS2, TAD JMPNXT
        DCA TSTO0
        DCA CKSUM       /CLEAR CHECKSUM
        JMS I (ICHAR    /GET A BUFFER CHAR
        JMP I LDABS     /NO INPUT FOUND
        SNA
        JMP .-3         /IGNORE BLANKS
        TAD (-200
        SZA CLA         /IS IT LEADER?
        JMP I (BADINP   /WASN'T 200..PROBABLY NOT BINARY
LEADER, JMS I (ICHAR
        JMP I LDABS     /STRANGE....ALL LEADER!!!
        SNA
        JMP LDABS2      /START OVER.BLANKS AFTER LEADER
        TAD (-200       /IS IT STILL LEADER?
        SNA
        JMP LEADER      /YES
NEWWD,  SMA             /IS IT < 200?
        JMP FIELDW      /NO.TEST FOR FIELD SEETING
        TAD (200        /RESTORE CHARACTER
        DCA WD1
        JMS I (ICHAR
        JMP I (BADINP   /EOF BETWEEN WORDS. HOW NICE!
        DCA WD2
        JMS I (ICHAR
        JMP I (BADINP
        TAD (-200       /200 FINISHES US UP
        SNA
        JMP I (OVER
        DCA WD
        JMS I (ASSEMB   /ASSEMBLE LAST WORD READ
        SZL             /IS IT AN ORIGIN?
        JMP ORGTST      /YES
XFIELD, HLT             /GETS CDF N
        DCA I ORIGIN    /STORE THIS WORD
CDF0,   CDF 0
        ISZ ORIGIN      /SHOULD NEVER SKIP, BUT...
LD7,    7
        TAD ORIGIN
        TAD (200        /GIVE ERROR IF ORIGIN ADVANCES TO 7600
        SNA CLA
        JMP I (NOROOM
NEXT,   TAD WD1
        TAD WD2         /MAKE UP CHECKSUM
        TAD CKSUM
        DCA CKSUM
        TAD WD
        JMP NEWWD
\fORGTST,        DCA ORGX        /TEST FOR ORIGIN
        TAD LODTST      /GET POINTER TO PROPER ORIGIN
        SZA CLA
        JMP HND
        TAD ORGX        /OS/8 - USE REAL ORIGIN
ORI,    DCA ORIGIN      /BUFFER AREA
        TAD LODTST      /HANDLER LOAD?
        SNA CLA
        JMP NEXT        /NOPE
        TAD ORGX        /DON'T START LOAD UNTIL *0 IS FOUND
        SZA CLA
TSTO0,  JMP NEXT
        DCA .-1         /FOUND *0..DO THE LOAD
        ISZ LODTST      /YES. BUMP LODTST TO LOAD HANDLER NEXT
        JMP NEXT
        TAD XFIELD
        TAD (-CDF 0
        SNA CLA
        JMS FIRST       /FIRST TIME THROUGH
/DO THIS BETTER; ALSO MAKE SURE HANDLER DOESN(T HAVE A FILED PSEUDO
        TAD (CDF 10
        DCA XFIELD      /AT THIS POINT, WE START
        CLA CMA         /LOADING THE HANDLER INTO THE
        DCA LODTST      /AREA SPECIFIED BY HNDORG+1
/CHECK 'ORIGIN' TO SEE IF HEADER WAS RIGHT SIZE
/ALSO ELSEWHERE, CAN CHECK ORIGIN WHEN BUMPING TO SEE
/IF WE HIT ANY MAGIC LOCATIONS
        TAD ORGX        /SEE IF LEGAL RE ORIGIN
        JMS I (ORGLIM
        DCA ORIGIN      /ACTUAL FIELD 1 ORIGIN
/       TAD SNACLA      /LOADING FIELD 1..TEST ORIGINS
/       DCA JMPRE
JMPNXT, JMP NEXT
FIELDW, TAD (-100       /LESS THAN 300 FAILS
        SPA
        JMP I (BADINP
        DCA WD1
        TAD WD1
        AND LD7
        SZA CLA
        JMP I (BADINP   /DISECT WORD TO CATCH GARBAGE
        TAD LODTST      /IF LOADING HANDLER, IGNORE FIELD
        SZA CLA
        JMP FIELD2
        TAD WD1
        AND (70         /EXTRACT FIELD SETTING
        TAD CDF0
        DCA XFIELD
FIELD2, JMS I (ICHAR
        JMP I (BADINP
        TAD (7600
        SZA
        JMP NEWWD
        JMP I (OVER
\fORGX,  0
ORIGIN, 0
WD1,    0
WD2,    0
WD,     0
CKSUM,  0
LODTST, 0

/0:     LOADING OS/8
/-2:    LOADING HEADER OF HANDLER
/-1:    LOADING HANDLER

HND,    TAD ORIGIN
        DCA KLUD
        TAD TABLMT
        JMP ORI         /HANDLER - USE HANDLER SPACE

KLUD,   0

FIRST,  0
        TAD KLUD
        DCA NEWLIM
        JMP I FIRST

NEWLIM, 0               /NEW END OF DESCRIPTORS
RETSW,  0               /0 MEANS RAN FROM OS/8, 1 MEANS RAN STANDALONE
        PAGE
\f       LNLNGT=103
BEGLIN, ZBLOCK LNLNGT

        SBLOCK=7776     /??
/CTCFAK,        .+1             /^C MUST NOT RETURN TO ANY SYSTEM.
/       JMP I CTCFAK    /CTCFAK MARKS OUR PLACE DURING
/                       /SYSGEN, AND ^C WILL RETURN TO THAT PLACE.
/*** THIS STUFF GOES AWAY ON A BOOT

BUILD,  CDF 10
        TAD I [7200     /HAS SPECIAL CODE BEEN OVERLAID BY HANDLERS?
        CDF 0
        TAD [-1234
        SZA CLA
        JMP I (NOROOM   /YES, TOO BAD
/       TAD (5601
/       DCA I [7600
/       TAD (CTCFAK+1
/       DCA I (7601
        TAD [6600       /SAVE OLD SYSTEM HANDLER IN 16600
        JMS I (SETUPSYS
/       JMS CTCFAK
RDOS8,  JMS I [PRWD
        TEXT    \LOAD OS/8: \
        JMS RD
        JMP RDOS8
        CIF CDF 10
        JMS I (WROS8
        JMS I (SYSWP
/       JMS CTCFAK
RDCD,   JMS I [CRLF
        JMS I [PRWD
        TEXT    /LOAD CD: /
        DCA DVER
        JMS RD
        JMP RDCD
        CIF CDF 10
        JMS I (WRCD
        TAD I (RETSW
        SNA CLA         /NOT IF FROM SCRATCH
        JMS I (SYSWP    /GET OLD HANDLER IF ANY BACK IN
        JMP I [CONFIG
\fRD,    0
        TAD [-40
        JMS I [GTEXT
        JMP I RD
        JMS I (SETUP
DVER,   JMP I (NODEV
        JMS I (SYSWP    /PUT IN NEW HANDLER
        CIF CDF 10
        JMS I (SAVE
        JMS I (SYSWP
        JMS I (LDABS    /PAST HERE PAGE 0 IS GONE
        JMP I RD
        JMS I (SYSWP
        ISZ RD
        JMP I RD
        PAGE
\f       *6400

DSCTAB, ZBLOCK 1200
\f/RELIC:

        *7600
        0               /ONLY LOADED FROM PAPER TAPE.

        *7777
        0               /SET SOFTWARE CORE SIZE TO 'UNKNOWN'
        FIELD 1
        *0
        0               /FORCE ABSLDR TO LOAD THIS PAGE
        *400
/       ZBLOCK 5400
        0
\f       *6600

        RELOC BINARY

BINPUN, CDF 10
        CLA
        TAD (-400
        CIF 0
        JMS I (MOVE
        CDF 10
        6600
        CDF 0
        BINARY          /MOVE ONESELF DOWN
        CIF CDF 0
        JMP I (LDR      /EXECUTE IN FIELD 0
LDR,    JMS LEDER       /PUNCH 72 FRAMES OF 200
        DCA CHECK       /0 CHECKSUM
        TAD (102
        JMS CKSUMM
        JMS PNCH
STARTB, JMS I (CRLF
        TAD ("*
        JMS I (TTYOUT
        TAD (-100
        JMS I (GTEXT
        JMP STARTB
        JMS I (GETNUM
        JMP I (OVERB
        TAD SIZE
        AND (7770
        SZA CLA
        JMP STARTB
        TAD SIZE
        CLL RTL
        RAL
        DCA FLD
        JMS I (GETNUM   /GET LOWER LIMIT
        JMP STARTB
        TAD SIZE
        DCA LIM1
        JMS I (GETNUM   /GET UPPER LIMIT
        JMP STARTB
        TAD SIZE
        DCA LIM2
        TAD LIM2
        CMA
        TAD LIM1
        DCA COUNT2
        TAD FLD
        TAD (300
        JMS PNCH
        TAD FLD
        TAD (CDF 0
        DCA BUFLD
        TAD LIM1
        JMS I (ROTR
        AND (77
        TAD (100
        JMS CKSUMM
        TAD LIM1
        AND (77
        JMS CKSUMM
BUFLD,  HLT
        TAD I LIM1
        JMS I (ROTR
        AND (77
        JMS CKSUMM
        TAD I LIM1
        AND (77
        JMS CKSUMM
        ISZ LIM1
        ISZ COUNT2
        JMP BUFLD
        CIF CDF 0
        JMP STARTB
\fLEDER, 0               /PUNCH LEADER/TRAILER
        TAD (-200
        DCA COUNT2
        TAD (200
        JMS PNCH
        ISZ COUNT2
        JMP .-3
        JMP I LEDER

PNCH,   0
        PLS
        PSF
        JMP .-1
        CLA
        JMP I PNCH

FLD,    0
LIM1,   0
LIM2,   0
COUNT2, 0
CHECK,  0

CKSUMM, 0
        DCA CK1
        TAD CK1
        TAD CHECK
        DCA CHECK
        TAD CK1
        JMS PNCH
        JMP I CKSUMM

CK1,    0
        PAGE
\fOVERB, TAD (300
        JMS I (PNCH     /FIELD 0
        TAD (176
        JMS I (CKSUMM
        JMS I (CKSUMM   /*7600
        TAD (74
        JMS I (CKSUMM
        STL CLA RTL
        JMS I (CKSUMM   /HLT
        TAD (177
        JMS I (CKSUMM
        TAD (77
        JMS I (CKSUMM   /*7777
        JMS I (CKSUMM
        JMS I (CKSUMM   /0000
        TAD (102
        JMS I (CKSUMM
        JMS I (CKSUMM   /*200
        TAD I (CHECK
        JMS I (ROTR
        AND (77
        JMS I (PNCH
        TAD I (CHECK
        AND (77
        JMS I (PNCH
        JMS I (LEDER
        HLT
        JMP .-1         /ALL DONE
        PAGE
        RELOC
\f       *7200

        DIRLOC=1400     /FROM OS/8 ASSEMBLY

        READ=JMS I (7607
        WRITE=READ
        MFREE=70
        ERR=JMS I (WRERR

        1234            /MAGIC NUMBER WHICH IF NOT HERE, MEANS HANDLERS OVERLAID

WROS8,  0
        CIF 0
        TAD Z7600
        JMS I (MOVE     /SAVE CURRENT 7600
        CDF 0
        7600
        CDF 0
        7000            /IN 07000
        TAD (-7         /MOVE 6600 TO 7600
        CIF 0
        JMS I (MOVE
        CDF 0
        6600
        CDF 0
        7600
        TAD (-34        /FINISH MOVING FIELD 0
        CIF 0
        JMS I (MOVE
        CDF 0
        6744
        CDF 0
        7744
        CDF 0
        TAD (5          /V3C SUBTRACT OFF LENGTH OF ABSLDR
        TAD I (DLENGTH  /FILL IN INITIAL LENGTH
        CDF 10
        DCA I (DIRLOC+14        /OS8 HAS INITIAL DIRECTORY
\f       CIF 0;WRITE;4200;7400;0;ERR     /INITIAL REC.0
        CIF 0;WRITE;4200;7400;66;ERR    /ALSO WRITE RECORD 66
        CIF 0;WRITE;4210;DIRLOC;1;ERR   /INITIAL DIRECTORY
        CIF 0;WRITE;5000;0;7;ERR        /KBM
        CIF 0;WRITE;4610;0;13;ERR       /USR
        CIF 0;WRITE;4111;3400;26;ERR    /ENTER OVERLAY
        CIF 0;WRITE;4701;2000;54;ERR    /SAVE, DATE, MON ERROR, CHAIN OVERLAYS
        CIF 0;WRITE;4101;LDRCTL;70;ERR  /ABSLDR CORE CONTROL BLOCK
        CIF 0;WRITE;5010;2000;71;ERR    /ABSLDR
        CDF 0
        TAD I (RETSW
        CDF 10
        SNA CLA         /SCRATCH BUILD?
        JMP I (RES76    /NO
        TAD Z7600       /YES    /MOVE 17600 UP THERE
        CIF 0
        JMS I (MOVE
        CDF 0
        7400
        CDF 10
Z7600,  7600
        JMS I (RESTORE
        CIF CDF 0
        JMP I WROS8

/RELATIONSHIP BEWTWEEN OS/8 CORE IMAGE AND BLOCKS ON SYSTEM DEVICE:

/ITEM           CORE LOC        BLOCKS

/KBM            0000-1777       7-12
/OVERLAYS       2000-3577       54-57
/INIT DIR       DIRLOC-         1
/ABSLDR CCB     LDRCTL-         70
/INIT BLOCK 0   7400-7777       0
/USR            10000-11377     13-15
/ABSLDR         12000-13777     71-74
/ENTER          13400-13577     26
/SYS    06600-06606     PART OF 07600
/SYS    06744-06777     "
\fWRCD,  0
        CIF 0;WRITE;4600;0;51;ERR       /CD
        CIF 0;WRITE;5011;0;60;ERR       /ODT
        JMS I (RESTORE
        JMS I (CASIT
        CIF CDF 0
        JMP I WRCD
        PAGE
\f       READ=JMS I (7607
        ERR=JMS WRERR

/SPECIAL CODE TO CHAIN TO ABSLDR, TO READ IN MCPIP

        JMS I (7700
        10              /LOCK USR IN CORE
        TAD R7600       /ZERO CD AREA
        DCA CDPTR
        TAD (-47
        DCA CDKNT
        DCA I CDPTR
        ISZ CDPTR
        ISZ CDKNT
        JMP .-3
        STL CLA RAR     /ALTMODE
        DCA I (7642
        JMS I (200
        12              /INQUIRE
        4503    /ENCODE CSA0
CDN,    0
        0
        HLT
        TAD CDN         /TAKE DEVICE NUMBER
        DCA I (7617     /STORE DEVICE NUMBER OF CASSETTE
        ISZ I (7620     /V3C FORCE BLOCK 1
        CLA IAC
        CDF 0           /V3D
        DCA I (7746     /SET JSW SO CHAIN DOESN'T DO USROUT
        CDF 10
        JMS I (200      /CHAIN TO ABSLDR
        6
        70
\fRESTORE,0
        CIF 0;READ;3701;0;BLDSAV;ERR
        CIF 0;READ;3510;0;BLDSAV+20;ERR /RESTORE BUILD
        JMP I RESTORE
\f       WRITE=JMS I (7607
        ERR=JMS WRERR

SAVE,   0
        CDF 0
        DCA I (SOFSET
        DCA I (SBLOCK
        DCA I (DRECT    /HAVE TO KEEP DIRECTORY LATER
        CDF 10
        CIF 0;WRITE;7701;0;BLDSAV;ERR
        CIF 0;WRITE;7510;0;BLDSAV+20;ERR
        JMS CASIT
        CIF CDF 0
        JMP I SAVE

RES76,  TAD I (Z7600
        CIF 0
        JMS I (MOVE
        CDF 0
        7000            /RESTORE OLD PAGE 7600
        CDF 0
        7600
        JMP I (Z7600
\fWRERR, 0               /WRITE ERROR
        HLT CLA         /HIT CONTINUE TO RETRY
        TAD WRERR
        TAD (-6
        DCA WRERR       /POINT BACK TO CIF OF CALL
        JMP I WRERR     /RETRY

/RELATIONSHIP BETWEEN CD CORE IMAGE AND BLOCKS ON SYSTEM DEVICE:

/ITEM           CORE LOC        BLOCKS
/CD             00000-01377     51-63
/ODT            10000-11777     60-63

CSA,    0               /CASSETTE HANDLER ENTRY PT
CDPTR,  0

CDKNT,
CASIT,  0
        CDF 0
        TAD I (RECNO
        SNA
        CLA IAC         /IF BLOCK 0, CHANGE TO 1
        DCA I (RECNO
        TAD I PRETSW
        SNA CLA         /BUILDING FROM SCRATCH?
        JMP I CASIT     /NO
        TAD I (BLDCB    /YES, GET DCB OF LOAD HANDLER
        AND L770
        TAD M270        /CASSETTE DEVICE CODE=27
        SZA CLA
        JMP I CASIT     /NOT A CASSETTE
        TAD I (DVICE
        DCA CSA         /GET HANDLER ENTRY POINT
        CDF 10
        CIF 0
        JMS I CSA
        3               /SKIP TO NEXT FILE
L770,   770
M270,   -270
R7600,  7600            /IGNORE ERRORS
        CIF 0
        JMS I CSA
        100             /DUMMY READ A PAGE
        BINARY          /TO SKIP HEADER
PRETSW, RETSW
        SKP CLA         /WANT AN ERROR
        HLT             /A GOOD READ IS BAD!
        JMP I CASIT
\f       FIELD 0
        *200
        $
\f