/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.
/
/
/
/
/
/
/
/
/
/
/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

/BUILD PAGE 0
	*1
	HLT		/SAFETY HALT AND PATCH SPACE
SAV1,	0
SAV2,	0		/SAVES GROUP NAME
			/POINTER TO BATCH ROUTINE (GROSS BUT NEEDED THE ROOM)
BATT,	BATTST		/AGAIN GROSS BUT WHAT CAN I SAY?
	*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=76	/**** 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
SLOT,	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)
/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
	*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 I (CORE
	DCA I (AMTCOR	/FIGURE OUT HOW MUCH CORE WE HAVE
	JMS I (GOOD	/DO SOME INITIALIZATION; IT'LL DO YA GOOD
	TAD (BATLS-1	/SET POINTER FOR BATCH OVERLAY
	JMS I (BATTST	/GO CHECK FOR CALL FROM BATCH
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
	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
	-0516;END	/END COMMAND FOR BATCH
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
CORSIZ,
GETCHA,	0
	TAD DSCPTR
	TAD I GETCHA
	ISZ GETCHA
	DCA GETEM
	TAD I GETEM
	JMP I GETCHA

/GOTCHA SUBROUTINE MOVED FOR ROOM

	PUT=JMS I [GOTCHA
	GET=JMS I [GETCHA


BATTST,	0		/SUBROUTINE TO SEE IF CALLED FROM BATCH
	DCA XR1	/POINTER TO OVERLAY CODE IN FIELD 2
	TAD I [7777	/GET THE BATCH SWITCH (JMP BATBK IF IN BATCH)
	RAL		/BIT 1
	SMA CLA	/IF NO BATCH MAY NOT HAVE FIELD 2
	JMP I BATTST	/NOT CALLED FROM BATCH
BATBK,	CIF 20		/NOW TO FIELD 2
	JMS I (BATSET	/GO DO SOME OVERLAYS
	JMP I BATTST	/RETURN TO CALLER
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
/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
	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
/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
LFMOD,	-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
RBOUT,	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
	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
GETC,	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
	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
GRPNAM,	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

BADLOD,	JMS I [CRLF
	JMS I [PRWD
	TEXT	/?BAD LOAD/
	DCA I TABLMT	/RESTORE SENTINEL 0
	JMP I [CONFIG

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
NFOUND,	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 V7A/
	JMP I [CONFIG

/BUILD CORE CONTROL BLOCK
/	***** CAUTION IF BUILD GROWS FROM FIELD 2

BLDCCB,	-3		/3 SEGMENTS
	6203		/FIELD 0
	0200		/200 IS S.A.
	0000		/JSW
	0000
	1020		/20000-21777
	0000		/10000-17577
	3710
	0000		/00000-07577
	3700
/GOES INTO WORDS 200-377 OF BLOCK 37
	PAGE
/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 I (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
LOAD,	JMS SETUP	/SET UP FOR INPUT
	JMP I [NODEV	/NO LOAD DEVICE
	STA CLL RAL	/-2 DO A HANDLER LOAD
	CIF CDF 20	/OFF TO FIELD 2
	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
HDPTR,	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
/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

	PAGE
REPLACE,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
INS,	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
INPLAT,	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
SAVNAM,	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
INTEM,
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
DGET,	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
/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
SETDSK,	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
/	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
GETPG,	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
EXAMINE,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
/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
EXAM,	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
/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
DONE,	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
/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
	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
WRITCC,	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
TOOMANY,JMS I [PRWD
	TEXT	/?HANDLERS/
	JMP I [CONFIG

GOTCHA,	0
	DCA I (GOTEM
	TAD I GOTCHA
	TAD DSCPTR
	ISZ GOTCHA
	DCA GETEMP
	TAD I (GOTEM
	DCA I GETEMP
	JMP I GOTCHA

GETEMP,	0		/TEMP FOR GOTCHA
TEST,	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
/*****************
/
/	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
	CIF CDF 20	/CALLED FROM FIELD 2
	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
/	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
UNLOAD,	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
UNLGRP,	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
/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
/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
BOOTQ,	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
LOCSYS,	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
PACK,	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


ACTNAM,	0		/THEY MUST BE ACTIVE
	CLA IAC
	JMS I (PRMNAM
	JMP I ACTNAM
DOT,	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
SYNTAX,	JMS I [PRWD
	TEXT /?SYNTAX/
	JMP I [CONFIG

DSKBAD,	JMS I [PRWD
	TEXT	/?DSK/
	JMP I [CONFIG
	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)
/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
BOOT2A,	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
CHKRES,	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
ACTIV,	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
SAMPG,	TAD SLOT	/ALREADY HAVE SLOT
	JMS I (SETSLT
	DCA I XR1
	JMP HNDLOC

GOTEM,
CORE,	0
	TAD I [7777
	AND [70
	CLL RTR
	RAR
	SNA
	JMS I (RELCOR
	JMP I CORE
	PAGE
/	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
GETSLOT,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
GETDCB,	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
SLOTDSK,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
SETSLT,	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
	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>
BOOTD,	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
/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
SETUPSYS,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
FIRST,	0		/SUBROUTINE FOR LDABS IN FIELD 2
	TAD KLUD
	DCA NEWLIM
	CIF CDF 20
	JMP I FIRST

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

HND,	CDF 20		/DATA FIELD 2
	TAD I (ORIGIN
	DCA KLUD
	TAD TABLMT
	CIF CDF 20		/BACK TO FIELD 2
	JMP I (ORI

KLUD,	0
NEWLIM,	0		/NEW END OF DESCRIPTORS


OK,	STA		/NOW USE ORIGIN TO TELL US HOW BIG A
	CDF 20
	TAD I (ORIGIN	/HANDLER WAS LOADED
	CDF 00		/BACK TO OUR FIELD
	AND [7600
	TAD [200	/REMEMBER THAT ORIGIN IS ONE GREATER
	DCA HNDPTR	/THAN ACTUAL LAST LOCATION.
			/BETTER TO USE 2-PAGE BIT
	TAD NEWLIM
	DCA TABLMT	/SET NEW TABLE TOP
	DCA I TABLMT	/NEED 0 AT END
	JMS I [COMMA
	JMP I (LOAD



NMER,	CIF 10		/V3C
	JMS I [200	/DISMISS USR FROM CORE
	11
	JMP I (NAMERR

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
	CDF 20		/OFF TO FIELD 2
	DCA I (XFIELD	/SETUP LDABS FOR FIELD 0
	CDF 00		/BACK TO FIELD 0
	JMP I IOPEN
	PAGE

/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
	*4000
DSCADV,	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
SYSCPY,	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
COPY,	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
CORBIT,
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


BADARG,	JMS I [PRWD
	TEXT	/?ARG/
	JMP I [CONFIG
	PAGE
/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
/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
	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
CTRLC,	KCC		/CLEAR ^C FLAG
	TAD I (SWAPER	/DO WE HAVE TO SWITCH?
	SZA CLA
	JMS I (SYSWP	/YES. INSERT OLD HANDLER
	JMP END	/GO CHECK BATCH BEFORE RETURNING

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
/	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/



/MUST DO SOME CLEAN UP IF BATCH IS RUNNING
/ALL OVERLAYED CODE MUST BE RESET IN CASE USER WANTS
/TO REUSE THIS COPY OF BUILD.

END,	JMS I BATT	/JUMP TO BATCH TEST ROUTINE FOR CLEAN UP
	JMP I [7600	/OTHERWISE GO HOME WITH NEW SYSTEM
			/THIS IS FROM BATCH
	PAGE


/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
MVCT,	0


ASSEMB,	0		/ASSEMBLE TWO 6 BIT WORDS
	CDF 20
	TAD I LWD1
	JMS I PROTL
	TAD I LWD2
	CDF 00
	JMP I ASSEMB

LWD1,	WD1
LWD2,	WD2
PROTL,	ROTL

BOOT4,	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
TTYOUT,	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
PATCH,	0
	TAD I [7777	/V3D
	AND L600
	DCA SAVHID	/SAVE HIGH ORDER DATE BITS
	JMP I PATCH
	PAGE
PRNAME,	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
PWORD,	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
OVER,	JMS I (ASSEMB	/EXTENSION OF LDABS.
	CIA
	CDF 20		/OFF TO FIELD 2
	TAD I LCKSUM	/CHECKSUM OK?
	CDF 00		/BACK TO OUR FIELD
	SZA CLA
	JMP BADINP	/SOORY ABOUT THAT
	CLA IAC
	JMP OVROUT	/SKIP ERROR EXIT
BADINP,	JMS PRWD
	TEXT /?BAD INPUT/
	JMS CRLF
OVROUT,	CDF 20
	TAD I (LDABS
	CDF 00
	DCA OTEMP
	JMP I OTEMP
OTEMP,	0


LCKSUM,	CKSUM
PRTM,	0
CRLF,	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
/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
CHTMP,
IN,	0		/POINTS TO HANDLER AREA AT ONE NAMED SYS
OUT,	0		/POINTS TO 7607 HANDLER
SWAPER,	0		/-1 MEANS NEW HANDLER IN

/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
CHAR2,	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 TO20		/RETURN
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\
TO20,	CIF CDF 20		/BACK TO FIELD 2
	JMP I ICHAR


REOF,	0
CHCNT,	0
CHPTR,	0
DVICE,	0
RETSW,	0		/0 MEANS RAN FROM 0S/8, 1 MEANS RNA STANDALONE
	PAGE
	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
RD,	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
	CIF CDF 20	/OFF TO PAGE 2
	JMS I [LDABS	/PAST HERE PAGE 0 IS GONE
	JMP I RD
	JMS I (SYSWP
	ISZ RD
	JMP I RD
	PAGE
	*6400

DSCTAB,	ZBLOCK 1200
/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
	*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
LEDER,	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
OVERB,	TAD Q300
	JMS I QPNCH	/FIELD 0
	TAD Q176
	JMS I QCKSUM
	JMS I QCKSUM	/*7600
	TAD Q74
	JMS I QCKSUM
	STL CLA RTL
	JMS I QCKSUM	/HALT
	TAD Q177
	TAD Q77
	JMS I QCKSUM	/*7777
	JMS I QCKSUM
	JMS I QCKSUM	/*0000
	TAD Q102
	JMS I QCKSUM
	JMS I QCKSUM
	TAD I QCHECK
	JMS I QROTR
	AND Q77
	JMS I QPNCH
	TAD I QCHECK
	AND Q77
	JMS I QPNCH
	JMS I QLEDER
	HLT
	JMP .-1	/ALL DONE
Q300,	300
QPNCH,	PNCH
Q176,	176
QCKSUM,	CKSUMM
Q74,	74
Q177,	177
Q77,	77
Q102,	102
QCHECK,	CHECK
QROTR,	ROTR
QLEDER,	LEDER
	PAGE

	RELOC
	DIRLOC=1400	/FROM OS/8 ASSEMBLY

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

	*7200


	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 (6		/V3D DEV EXT LENGTH OF ABSLDR
	TAD I (DLENGTH	/FILL IN INITIAL LENGTH
	CDF 10
	DCA I (DIRLOC+14	/OS8 HAS INITIAL DIRECTORY
	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 CDF 20	/OFF IN FIELD 2
	JMP I (BAK
WHER,	CDF 0	/RETURN FROM RELOCATED ROUTINES.
	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-14377	71-75
/ENTER		13400-13577	26
/EXT MEM SAVE & ODT				64
/SYS	06600-06606	PART OF 07600
/SYS	06744-06777	"
WRCD,	0
	CIF 0;WRITE;4600;0;51;ERR	/CD
	CIF 0;WRITE;5011;0;60;ERR	/ODT

/THE NEXT ROUTINE IS TO FINISH LOADING BLOCK 64 OF THE
/SYSTEM DEVICE THAT HAD BEEN RESERVED.  THE FIRST PART
/WAS WRITTEN WITH OS8 AND NOW THE OTHER PART MUST BE
/WRITTEN ON THAT SAME BLOCK FROM CD.

	CIF 0;READ;210;0;64;ERR		/GET PART OF ODT WRITTEN
	/MOVE LOCATIONS 11600-11663 TO 10000-10063
	CIF 0
	TAD (-64
	JMS I (MOVE
	CDF 10
	1600
	CDF 10
	0000
	CIF 0;WRITE;4210;0;64;ERR

/END OF ROUTINE TO LOAD BLOCK 64

	JMS I (RESTORE
	JMS I (CASIT
	CIF CDF 0
	JMP I WRCD
	PAGE
	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
RESTORE,0
	CIF 0;READ;3701;0;BLDSAV;ERR
	CIF 0;READ;3510;0;BLDSAV+20;ERR	/RESTORE BUILD
	JMP I RESTORE
	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
WRERR,	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

/INITIALIZATION CODE FOR BATCH OPERATION



	FIELD 2

*10
BATXR1,	0		/INDEX REG. 1 FOR BATCH
BATXR2,	0		/INDEX REG. 2 FOR BATCH


*200

BATSET,	0
	TAD I (XR1	/GET THE OVERLAY POINTER
	SZA		/IF ZERO USE OLD VALUE
			/THIS SAVES ME SOME FIELD 0 SPACE
	DCA BATXR1	/SAVE THE POINTER
	TAD I [7777	/NOW GET THE BATCH FIELD
	CDF 20		/TO FIELD 2
	AND (0070	/NOW GET THE FIELD BITS
	TAD (CIF	/MAKE A CIF FOR OVERLAY
	DCA CBATI	/SAVE IN INPUT ROUTINE
	TAD CBATI	/ALSO OUTPUT
	DCA CBATO	/OVERLAY

BATMOV,	TAD I BATXR1	/GET NEXT STORAGE ADDRESS
	SNA		/IF ZERO ALL DONE (SECOND TIME THRU)
	JMP BATDON	/RETURN TO CALLER
	DCA BATXR2	/OTHERWISE SAVE POINTER TO TARGET CODE
BATLUP,	TAD I BATXR1	/GET A PATCH WORD
	SNA		/ZERO MEANS END OF THIS PATCH
	JMP BATMOV	/GO GET ANOTHER POINTER OR MAYBE ALL DONE
	CDF 0		/BACK TO FIELD ZERO
	DCA I BATXR2	/NOW CODE IS BATCHABLE
	CDF 20		/BACK TO FIELD 2
	JMP BATLUP	/DO IT ALL AGAIN

BATDON,	CIF CDF 0	/RETURN TO CALLER
	JMP I BATSET	/BYE

BATLS,	TTYIN		/POINTER TO MOVE DATA
	CBATI=.	/SET CIF BATCH
	RELOC TTYIN+1	/RELOCATABLE CODE
	CIF
	JMS I BATINI	/JUMP TO GET INPUT FROM BATCH
	HLT		/BAD ERROR
	SKP		/SKIP OVER POINTER
BATINI,	5400		/POINTER TO BATCH INPUT ROUTINE
	0		/TERMINATOR

	TTYOUT+5	/NOW FOR OUTPUT
	RELOC
	CBATO=.	/SET FOR CIF BATCH
	RELOC TTYOUT+6	/POINTER TO MOVE DATA
	CIF		/CIF BATCH
	JMS I .+1	/GO SEND DATA TO BATCH
	7400		/POINTER TO BATCH OUTPUT PROCESSOR
	0		/TERMINATOR


	LFMOD		/POINTER TO LINE FEED MOD
	RELOC LFMOD+1	/RLOCATE THE CODE
	RDTXT		/IGNORE LINE FEEDS
	0		/TERMINATOR

	BATTST+1	/POINTER TO MODIFY BATCH TEST
	RELOC BATTST+2	/RELOCATE THE CODE
	JMP BATBK	/JUMP AROUND THE BATCH SWITCH TEST
			/WITH A NEW SYSTEM THE TEST IS ILLOGICAL
			/WHICH IS THE CASE IF A BOOT IS REQUESTED
	0		/TERMINATOR
	RELOC

	0		/FINAL OVERLAY TERMINATOR



/NOW COMES THE RESET CODE TO PUT THINGS BACK
/ THE WAY THEY WERE TO BEGIN WITH.

	TTYIN		/POINTER TO MOVE DATA
	RELOC TTYIN+1	/RELOCATABLE CODE
	KSF		/SKIP ON FLAG
	JMP .-1
	KRB		/READ A CHAR
	SNA		/LOW LEVEL BLANK IGNORE
	JMP TTYIN+1	/GO GET ANOTHER
	0		/OVERLAY TERMINATOR

	TTYOUT+5	/NOW FOR OUTPUT
	RELOC TTYOUT+6	/RELOCATE AGAIN
	TLS		/PRINT THE CHAR
	TSF		/DONE?
	JMP .-1	/NO.
	0		/OVERLAY TERMINATOR

	LFMOD		/POINTER TO LINE FEED MOD
	RELOC LFMOD+1	/RELOCATE ONE MORE TIME
	LFEED		/LINE FEED..ECHO CURRENT COMMAND
	0		/TERMINATOR

	BATTST+1	/POINTER TO BATCH TEST
	RELOC BATTST+2	/RELOCATE THE CODE
	TAD I [7777	/RESET THE CODE TO ORIGINAL STATE
	0		/OVERLAY TERMINATOR

	RELOC
	0		/FINAL OVERLAY TERMINATOR
	PAGE


/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 (ICHA	/GET A BUFFER CHAR
	JMP LDAB	/NO INPUT FOUND
	SNA
	JMP .-3		/IGNORE BLANKS
	TAD (-200
	SZA CLA		/IS IT LEADER?
	JMP BADIN	/WASN'T 200..PROBABLY NOT BINARY
LEADER,	JMS I (ICHA
	JMP LDAB	/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 (ICHA
	JMP BADIN	/EOF BETWEEN WORDS. HOW NICE!
	DCA WD2
	JMS I (ICHA
	JMP BADIN
	TAD (-200	/200 FINISHES US UP
	SNA
	JMP OVE
	DCA WD
	JMS I (ASSEM	/ASSEMBLE LAST WORD READ
	SZL		/IS IT AN ORIGIN?
	JMP ORGTST	/YES
XFIELD,	HLT		/GETS CDF N
	DCA I ORIGIN	/STORE THIS WORD
CDF20,	CDF 20
	ISZ ORIGIN	/SHOULD NEVER SKIP, BUT...
LD7,	7
	TAD ORIGIN
	TAD (200	/GIVE ERROR IF ORIGIN ADVANCES TO 7600
	SZA CLA
	JMP .+3		/SKIP AROUND ERROR
	CIF CDF 0	/ERROR IN FIELD 0
	JMP I (NOROOM
NEXT,	TAD WD1
	TAD WD2		/MAKE UP CHECKSUM
	TAD CKSUM
	DCA CKSUM
	TAD WD
	JMP NEWWD

ORGTST,	DCA ORGX	/TEST FOR ORIGIN
	TAD LODTST	/GET POINTER TO PROPER ORIGIN
	SNA CLA
	JMP .+3
	CIF CDF 0	/JUMP TO HANDLER TEST
	JMP I (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
	SZA CLA
	JMP .+3		/JUMP AROUND IF NOT FIRST TIME
	CIF CDF 0	/SUBROUTINE IN FIELD 0
	JMS I [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
	CIF CDF 0	/OFF ON FIELD 0
	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 BADIN
	DCA WD1
	TAD WD1
	AND LD7
	SZA CLA
	JMP BADIN	/DISECT WORD TO CATCH GARBAGE
	TAD LODTST	/IF LOADING HANDLER, IGNORE FIELD
	SZA CLA
	JMP FIELD2
	TAD WD1
	AND (70		/EXTRACT FIELD SETTING
	TAD [CDF 0
	DCA XFIELD
FIELD2,	JMS I (ICHA
	JMP BADIN
	TAD (7600
	SZA
	JMP NEWWD
OVE,	CIF CDF 0	/ROUTINE IN FIELD 0
	JMP I [OVER
LDAB,	CIF CDF 0	/BACK TO FIELD 0
	JMP I LDABS	/RETURN FROM SUBROUTINE

BADIN,	CIF CDF 0	/BACK TO FIELD 0
	JMP I [BADINP	/BAD INPUT


ORGX,	0
ORIGIN,	0
WD1,	0
WD2,	0
WD,	0
CKSUM,	0
LODTST,	0
	PAGE
ICHA,	0		/ICHAR CALL ROUTINE FOR FIELD 0
	CIF CDF 0	/OFF TO FIELD 0
	JMS I (ICHAR	/JUMP TO ICHAR
	JMP I ICHA	/ERROR RETURN
	ISZ ICHA	/GOOD RETURN
	JMP I ICHA	/RETURN TO CALLER



ASSEM,	0		/ASSEMBLE A WORD
			/THIS CODE APPEARS IN FIELD 0 ALSO
	TAD I (WD1	/GET WORD 1
	CLL RTL		/NOW DO THE ROTATE
	RTL;RTL
	TAD I (WD2	/NOW FOR THE SECOND PART
	JMP I ASSEM	/BACK TO CALLER
	PAGE
	WRITEX=JMS I (7607	/OFF TO WRITE TO DEV.
	ERROR=JMS ERRX		/ERROR SUBROUTINE
BAK,
	CIF 0;WRITEX;4111;3400;26;ERROR	/ENTER OVERLAY
	CIF 0;WRITEX;4701;2000;54;ERROR	/SAVE, DATE, MON ERROR, CHAIN OVERLAYS
	TAD Q200
	CDF 0
	TAD I QLD
	DCA I QLD
	CDF 20
	CIF 0;WRITEX;4101;LDRCTL;70;ERROR /ABSLDR CORE CONTROL BLOCK
	TAD (-114
	CIF 0
	JMS I (MOVE
	CDF 0
	4264
	CDF 0
	3464
	CIF 0;WRITEX;4200;3400;64;ERROR
	CIF 0;WRITEX;5210;2000;71;ERROR	/ABSLDR
	CIF CDF 10	/BACK TO FIELD 1
	JMP I (WHER
QLD,	LDRCTL+5
Q200,	200


ERRX,	0		/WRITE ERROR
	HLT CLA		/HIT CONTINUE TO RETRY
	TAD ERRX
	TAD (-6		/BACK TO TRY AGAIN
	DCA ERRX	/AGAIN
	JMP I ERRX	/RETRY



	FIELD 0
	*200
	$

