Google
 

Trailing-Edge - PDP-10 Archives - dec-10-omona-u-mc9 - bootm.mac
There are 6 other files named bootm.mac in the archive. Click here to see a list.
	SUBTTL	T.HESS/TAH/TW 20 JAN 77

;***COPYRIGHT 1975,1976,1977, DIGITAL EQUIPMENT CORP., MAYNARD, MASS.***

VBOOTM==4	;VERSION NUMBER
EBOOTM==16	;EDIT NUMBER

;REVISION HISTORY

;14	(19728)	RECORD COULD BE INCORRECTLY DETERMINED AS A TRAILER
;		RECORD. ADD ADDITIONAL CHECK FOR SECOND WORD.
;		AREA AFFECTED: FNDFIL
;REGISTER DEFINITIONS

F=0		;LH := FLAGS , RH := UNIT TYPE
T1=1		;TEMPS
T2=2
T3=3
T4=4
W=5		;WORD COUNT / PNTR
N=6		;COUNTER
X=7		;FOR USE BY IO DRIVERS
P1=10		;POINTER ACS FOR EXE FILES
P2=11
B=12		;USED IF BACKUP FORMAT
M=13		;MEMORY ADDRS
Q=14		;
D=15		;DATA PNTR FOR MTA ROUTINES
R=16		;RELOCATION
P=17		;PDL PNTR

;DEFAULT FT SETTINGS

IFNDEF FTEXE,<FTEXE==1>		;EXE FILE SUPPORT (DEFAULT)
IFNDEF FTFRS,<FTFRS==1>		;SUPPORT FRS/BACKUP SYSTEM
IFNDEF DEBUG,<DEBUG==0>		;ASSEMBLE DEBUG FEATURES
IFNDEF FTTU70,<FTTU70==1>	;ASSEMBLE TU70 CODE
IFNDEF FTTC10,<FTTC10==1>	;ASSEMBLE TC10C CODE
IFNDEF FTTM02,<FTTM02==1>	;ASSEMBLE TM02/TU16 CODE
IFNDEF MAGRIM,<MAGRIM==1>	;MAGRIM FORMAT
IFN MAGRIM,<PTPSW==1>		;ABS ASSEMBLEY IF MAGRIM ON
IFNDEF PTPSW,<PTPSW==0>
IFN MAGRIM!PTPSW,<FTRH20==0>	;NO READIN ON A KL10
IFNDEF FTRH20,<FTRH20==1>	;ASSEMBLE TU16/RH20 CODE
IFNDEF CORE,<CORE==5000>

;ERROR MACRO

	SALL
DEFINE ERROR (GREEK,MSG) <
	PUSHJ	P,UERROR(R)
	CAIA	''GREEK''
	Z	[ASCIZ "MSG"]
>
IFE MAGRIM,<
IFN PTPSW,<
	LOC	CORE
	RIM10B
>
IFE PTPSW,<
IFN DEBUG,<
	LOC	74	;FAKE OUT LINK
	EXP	360000	;DDT START ADDRS
	LOC	370000		;PLACE NEAR 128K
>
IFE DEBUG,<LOC CORE>
>
>
IFN MAGRIM,<
	LOC	CORE-1
	RIM10
	IOWD EBTM-BOOTM,.+1
>

BTMSIZ==<EBTM-BOOTM+777>&777000	;SIZE TO NEAREST PAGE
.JBSA==120		;JOB START ADDRS
;BITS IN FLAG REGISTER

REWF==(1B0)		;UNIT REWINDING
LOADF==(1B1)		;/LOAD SWITCH SEEN
DOREWF==(1B2)		;/REW COMMAND
RUBF==(1B3)		;RUBOUT FLAG
STRTF==(1B4)		;START MONITOR
			;BITS 5-7 ARE SPECIAL SWITCH DISPATCH BYTE
  S.UNI==(1B7)		;UNIT NUMBER DISPATCH OFFSET
  S.ADR==(2B7)		;ADDRS DISPATCH OFFSET
  S.DEN==(3B7)		;DENSITY DISPATCH OFFSET
DOSKPF==(1B8)		;/SKIP COMMAND
REPOSF==(1B9)		;DONT REPOSITION TAPE AFTER LOAD

;PARSE FLAGS

L.DOT==(1B14)		;PERIOD SEEN
L.LBK==(1B15)		;LEFT BRACKET SEEN
L.SLA==(1B16)		;SLASH SEEN
L.CMA==(1B17)		;COMMA SEEN (IN PPN)

L.ALL=L.SLA+L.CMA+L.LBK+L.DOT    ;ALL FLAGS

ERRTRY==^D40		;RETRY COUNTER

;GENERAL TEXT MACRO FOR VERSION #

DEFINE TMACR (VER,EDIT,TEXT,ET<>)) <
TEXT'VER(EDIT)'ET>

TMACR (\VBOOTM,\EBOOTM,<TITLE BOOTM - MAG-TAPE BOOTSTRAP FOR FAILSA TAPES %>)
SUBTTL	TM10 HARDWARE DEFINITIONS

TM.RWS==1B19		;REWIND STATUS
TM.EOF==1B23		;END OF FILE
TM.JBD==1B29		;JOB DONE
TM.TUR==1B30		;TAPE UNIT READY
TM.DTR==1B35		;DATA REQUEST (TM10A ONLY)
TM.ERR==460600		;HUNG+ILLOP+PAR+OVERRUN+BDTAPE

TM.PAR==1B21		;ODD PARITY
TM.CD==1B22		;CORE DUMP MODE (DEFAULT)
TM.D2==0B29		;200 BPI DENSITY
TM.D5==1B29		;556 BPI DENSITY
TM.D8==2B29		;800 BPI DENSITY
TM.RD==2B26		;READ FCN
TM.FSR==6B26		;SKIP FORWARD RECORD
TM.BSR==7B26		;SKIP BACKWARD RECORD
TM.REW==1B26		;REWIND
TM.NOP==0B26		;NO OP

TM.DFC==(1B9)		;DF10C FLAG IN TMS
TM.UNP==^D20		;UNIT CODE RIGHT MOST BIT
SUBTTL	TC10 HARDWARE DEFINITIONS
IFN FTTC10,<

TC.RWS==(1B6)		;TAPE REWINDING
TC.EOF==(1B0)		;TAPE MAREK SEEN
TC.JBD==1B32		;JOB DONE
TC.RDY==(1B17)		;UNIT READY
TC.ERR==030534		;ERROR BITS(LH)

TC.REW==1B25		;REWIND OP
TC.BSR==7B25		;BACKSPACE RECORD
TC.FSR==6B25		;FOWARD SKIP RECORD
TC.RD==2B25		;READ
TC.NOP==0B25		;NO-OP
TC.CDM==1B26		;CORE DUMP MODE
TC.LCR==1B31		;LOAD COMMAND REG
TC.GO==1B30		;START OP

TC.UNP==^D20		;UNIT NUMBER POSITION
TCX==724		;DEVICE CODE

>
SUBTTL TM02 HARDWARE DEFINITIONS
IFN FTTM02,<

;REGISTERS
T2.DSR==10000			;STATUS REGISTER
T2.DER==20000			;ERROR
T2.DFC==50000			;FRAME COUNTER
T2.DDT==60000			;DRIVE TYPE
T2.DTC==110000			;TAPE CNTRL
T2.DRH==400000			;RH10 CNTRL REG

T2.DLR==4000			;LOAD REGISTER

;CONI BITS
T2.22B==4000			;22-BIT DF
T2.DON==10			;DONE

;TAPE CNTRL REGISTER BITS
T2.M7T==20			;7-TRACK CORE DUMP

;FUNCTIONS
T2.RWF==7			;REWIND
T2.DCF==11			;DRIVE CLEAR
T2.SFF==31			;SKIP-FORWARD
T2.SBF==33			;SKIP BACKWARD
T2.RDF==71			;READ

;STATUS BITS
T2.SER==40000			;ERROR
T2.SPP==20000			;POSITION IN PROGRESS
T2.SRY==200			;READY
T2.SPE==40			;PHASE ENCODED
T2.SEF==4			;EOF
T2.SBT==2			;BOT

;ERROR REG
T2.NER==102200			;NOT ERRORS IF PE MODE
T2.ERR==176377			;ERROR IF ON

;RH20
T2.MBE==400			;MASSBUS ENABLE
T2.RAE==4000			;CLEAR REGISTER ACCESS ERROR
>
SUBTTL TX01/DX10 HARDWARE DEFINITIONS

IFN FTTU70,<
;DEVICE DATAO BITS

DO.RES==1B16		;DO LOCAL RESET
DO.LRS==1B17		;LOAD REG SELECT
DO.UC0==4		;MP CTL 0
DO.UC1==5		;MP CTL 1
DU0HLT==1B19		;HALT
DU0CON==1B20		;CONTINUE
DU0EXM==1B22		;EXAMINE

UP.SA==200		;MP START ADDRESS
PDC==220		;DEVICE CODE
ICPC==20		;PLACE FOR INITIAL CHL PC

;CHL BITS

CH.COP==1B1+1B3		;DEVICE COMMAND, AUTO ERROR RETRY
CH.GO==1B2		;GO BIT
CH.JMP==1B3		;CHL JMP
CH.STS==1B4		;STORE STATUS
CH.FRC==1B5		;FORCE SENSE BYTES

;DEVICE COMMANDS

TX.NOP==3		;NOOP
TX.FRD==2		;READ FORWARD
TX.FSR==67		;FORWARD SPACE RECORD
TX.BSR==47		;BACK SPACE RECORD
TX.REW==7		;REWIND

;CONI BITS
 
TX.RUN==1B17	;RUN BIT  
TX.ILI==1B25	;INHIBIT LOAD ICPC
TX.UPE==1B26	;MP ERROR
TX.MPE==1B27	;MEM PARITY ERROR
TX.NXM==1B28	;NXM
TX.STA==1B29	;STATUS AVAILABLE
TX.CLR==1B31	;CLEAR
TX.CON==1B32	;CONTINUE

;SENSE BYTE DEFINITIONS

LSNS==^D24	;NUMBER OF SENSE BYTES
SB1==4		;OFFSET INTO CHSNS FOR BYTE 1
SB17TK==1B11	;DRIVE IS 7-TK
;STATUS BITS IN DSR/CSR

DS.UCH==1B6		;UNIT CHECK
DS.UEX==1B7		;UNIT EXCEPTION

CS.SLE==1B11		;SELECTION ERROR
CS.SQE==1B12		;SEQUENCE ERROR
CS.DPE==1B13		;DEVICE PARITY ERROR
CS.LNE==1B14		;LENGTH ERROR
CS.DSF==1B17		;DSR FLAG

CS.NFG==1B18		;SENSE AND/OR STATUS NO GOOD
CS.INC==1B19		;OP INCOMPLETE

CS.STE==1		;ENDING STATUS
CS.STC==2		;CU INITIATED STATUS

;DATA MODES

TX.7TK==3		;7 TRACK CORE DUMP
TX.9TK==0		;9 TRACK CORE DUMP

TX.D72==063		;200 BPI + ODD PARITY
TX.D75==163		;556 BPI + ODD PARITY
TX.D78==263		;800 BPI + ODD PARITY

>
SUBTTL MISC DEFINITIONS

APR==0		;PROCESSOR DEVICE CODE
PI==4		;PI SYSTEM DEVICE CODE
PAG==10		;PAGER
TTY==120	;CTY
NXMKA==1B23	;NXMF ON KA
NXMKI==1B29	;NXMF ON KI
NXMKL==1B25	;NXMF ON KL

;OFFSETS IN DBUF FOR RIB ENTRIES

.RBNAM==4		;FILE NAME
.RBEXT==5		;FILE EXTENSION
.RBPPN==3		;PROJ/PROG

CCW=22			;CHANNEL COMMAND LIST
BOOTWD=22		;PLACE FOR SERIAL NUMBER

LNPDL==20		;LENGTH OF PDL
LNMTBF==1040		;LENGTH OF TAPE BUFFER (DBUF)
WAITM==(1B12)		;TIME TO WAIT FOR CTL STATUS
W2PLSH==-^D9		;CONVERT WORDS TO PAGES
P2WLSH==^D9		;CONVERT PAGES TO WORDS
P2BLSH==2		;CONVERT PAGES TO BLOCK IN FILE
PAGSIZ==1000		;WORDS IN A PAGE
SV.DIR==1776		;DIRECTORY BLOCK CODE

PM.ACC==400000		;PAGE ACCESSABLE
PM.WRT==100000		;WRITABLE
PG.EAT==20000		;TURN ON PAGING HARDWARE
.LMPFN==502		;ADDRESS OF PAGE FAIL NEW PC

	DTE==200		;DEVICE CODE

IFE FTRH20,<EPT==0>		;NO PAGING IF NO RH20
IFN FTRH20,<EPT==777000>	;TOP PAGE IS EPT
DTEFLG==444+EPT		;SET BY KLDCP WHEN CMD COMPLETE
DTEF11==450+EPT		;FROM 11 ARG
DTECMD==451+EPT		;COMMAND LOC
DTEMTD==455+EPT		;MONITOR OUTPUT DONE FLG (SET BY 11)
DTEMTI==456+EPT		;MONITOR INPUT READY FLG (SET BY 11)

.DTMTO==10B27		;MONITOR OUTPUT
.DTMMC==11B27		;TURN ON MONITOR MODE CONSOLE
.DTMNM==12B27		;TURN OFF MONITOR MODE CONSOLE

;HARDWARE BITS FOR THE DTE20
TO11DB==1B22		;DOORBELL TO 11
CL11PT==1B26		;CLEAR DOORBELL FOR 10
PILDEN==1B31		;ENABLE LOAD PIA

;DTE EPT LOCS

DTEII=142		;INTERUPT ADDRESS
DTEEPW=144		;EXAMINE PROTECTION WORD
SUBTTL INITIALIZATION

BOOTM::	CONO	APR,1B19	;I/O RESET
	CONO	PI,10400	;CLR PI SYSTEM
IFN DEBUG,<
DDPAT:	JFCL	NODDT		;PATCHED
	MOVE	0,116
	MOVEM	0,36		;FIXUP SYMBOL TABLE PNTR
	MOVSI	0,(<JRST>)
	HLLM	0,DDPAT
	HRRZ	0,74		;DDT START ADDRS
	JRST	@0		;START IT
NODDT:	MOVEI	R,0		;NO RELOC IF DEBUG
>
RPAT:	JFCL			;PATCHED LATER
	MOVEI	1,0		;SET UP FOR PROCESSOR TEST
	BLT	1,0		;...
	JUMPN	1,[SETOM KLFLG	;IT IS A KL
		   SETZM KIFLG	;AND NOT A KI OR KA
		   JRST MOVB]
	HRLOI	1,-2		;SET UP FOR KI/KA TEST
	AOBJN	1,[SETZM KLFLG	;IT IS NOT A KL
		   SETOM KIFLG	;BUT IT IS A KI
		   JRST MOVB]
	SETZM	KLFLG		;IT MUST BE A KA
	SETZM	KIFLG		;...
				;FALL INTO MOVB
;WE NOW NEED TO RELOCATE OURSELVES TO THE TOP OF CORE
;OR TO 256K WHICH EVER COMES FIRST
;ALSO R(ELOCATION REG) IS SET UP

MOVB:
IFE DEBUG,<
	MOVEI	0,NXMKI		;ASSUME KI NXM FLAG
	SKIPN	KIFLG		;IS IT?
	MOVEI	0,NXMKA		;NO - TRY KA STYLE
>
	SKIPN	KLFLG		;DO ONLY IF ON KL
	JRST	NKL1
	CONO	PAG,0		;NO CACHE, NO PAGING, EPT IS PAGE 0
	MOVEI	1,TRPLOC	;WHERE PAGE FAIL CAUSED BY NXM REFERENCE SHOULD TRAP
	MOVEM	1,.LMPFN	;SAVE THAT AS PAGE FAIL TRAP NEW PC
	CONO	DTE,PILDEN+0	;NO PIA FOR DTE
IFE DEBUG,<MOVEI 0,NXMKL	;NXM FLAG ON KL>
NKL1:	MOVE	1,[JRST GO(R)]
	MOVEM	1,RPAT		;PATCH FOR RESTART
IFE DEBUG,<
	HRRM	0,NXMI		;ALTER NXM TEST INSTR.
	MOVEI	1,^D16*2000	;START AT 16K
MOVBL:	MOVES	(1)		;REFERENCE MEMORY
TRPLOC:	TRNE	1,-1		;256K COMES FIRST
NXMI:	CONSZ	APR,.-.		;INSTR MODIFIED
	SKIPA	2,1		;FOUND END OF CORE
	AOJA	1,MOVBL		;LOOP AND TRY NEXT
	CONO	APR,@NXMI	;TURN OFF FLAG
	SUBI	1,BTMSIZ	;LOWER BOUND
	HRLI	1,BOOTM		;START ADDRS NOW
	MOVEI	R,-CORE(1)	;SET RELOC
	BLT	1,-1(2)		;MOVE TO TOP OF CORE
>
IFN DEBUG,<
	MOVEI	2,<PAGTAB+1000>&777000
>
IFN FTRH20,<
	SKIPN	KLFLG(R)
	JRST	BOOTM(R)	;IF A KL WHICH MIGHT HAVE RH20'S
	SUBI	2,1000		;TOP PAGE
	MOVE	1,2
	LSH	2,-11		;MAKE TOP PAGE=EPT
	TRO	2,PM.ACC+PM.WRT	; AND EPT= 1-FOR-1 MAP OF CORE
	HRRM	2,377(1)
	TRZ	2,760000	;CLEAR  EXTRA BITS
	HRLI	2,700000	;SET UP 1-FOR-1 MAP
	DATAO	PAG,2		;TOP CORE PAGE IS BOTH UPT AND EPT
	CONO	PAG,PG.EAT(2)
>
	JRST	BOOTM(R)	;HACK
GO:	SETOM	ONCEFF(R)	;ONCE ONLY FLAG
	MOVEI	F,0		;CLEAR FLAGS
	SKIPN	T1,UNIT(R)	;SEE IF INFO FROM DXLD
	JRST	REGO(R)		;NO PROCEED
	HLRZ	F,T1		;GET CTL TYPE
	HRRZM	T1,UNIT(R)	;AND UNIT #
				;FALL INTO REGO
REGO:	MOVSI	P,-LNPDL	;SET UP PDL PNTR
	HRRI	P,PDL-1(R)	;...
	PUSH	P,UNIT(R)	;SAVE UNIT # LAST SPECIFIED
	TLZ	F,-1		;CLEAR FLAGS (PRESERVE CTL TYPE)
	SETZM	CLRB(R)		;CLEAR WORLD
	MOVSI	T1,CLRB(R)	;MAKE BLT PNTR
	HRRI	T1,CLRB+1(R)	;...
	BLT	T1,CLRE(R)	;ZAP
	POP	P,UNIT(R)	;RESTORE UNIT #
	SKIPN	KLFLG(R)	;SKIP IF ON KL
	JRST	NKL2(R)		;XFER AROUND CODE IF NOT KL
	SETZM	DTEEPW		;SECONDARY PROTOCALL
	SETZM	DTEMTI		;CLEAR INPUT FLAG
	SETZM	DTEFLG		; & COMMAND COMPLETE
	MOVEI	T1,.DTMMC	;TURN ON CONSOLE
	MOVEM	T1,DTECMD	;SEND CMD
	CONO	DTE,TO11DB	;RING DOORBELL
	SKIPN	DTEFLG		;WAIT FOR COMPLETION
	JRST	.-1(R)
NKL2:	AOSE	ONCEFF(R)	;ONCE ONLY FLAG
	JRST	REGO1(R)
	PUSHJ	P,PCRLF(R)	;CRLF
	MOVEI	T1,ITXT(R)	;HELLO MESSAGE
	PUSHJ	P,OUTTXT(R)	;PRINT GREETINGS
	PUSHJ	P,PCRLF(R)	;CRLF AGAIN
REGO1:	PUSHJ	P,PROMPT(R)	;GIVE PROMPT
	PUSHJ	P,REDLIN(R)	;GOBBLE LINE

			;FALL INTO PARSER
SUBTTL	PARSER


PARSE:	PUSHJ	P,REDSIX(R)	;SNARF ATOM
	TLNE	F,L.SLA		;IF SLASH ALREADY SEEN SKIP TEST
	JRST	PARSE3(R)	;  OF COLON
	CAIE	T1,":"		;DEVICE DELIM
	JRST	PARSE1(R)	;NO
	MOVEM	W,DEVICE(R)	;YES - STASH NAME
	JRST	PARSE(R)	;AND PROCEED

PARSE1:	CAIE	T1,"]"		;RIGHT BRACKET?
	JRST	PARSE2(R)	;NO.
	HRRM	N,PPN(R)	;YES - MUST BE PROG #
	TLZN	F,L.CMA		;WAS A COMMA SEEN
	ERROR	(IPP,<INVALID PROJ,PROG NUMBER>)
	JRST	PARSE(R)	;CONTINUE

PARSE2:	TLNE	F,L.ALL		;ANYTHING
	JRST	PARSE3(R)	;YES - SEE WHAT IT IS
	JUMPE	W,PARSE4(R)	;JUMP IF NO ATOM IN W
	MOVEM	W,FNAME(R)	;ELSE IT IS A FILE NAME
	JRST	PARSE4(R)	;CHECK PUNCTUATION

PARSE3:	TLZE	F,L.DOT		;PERIOD SEEN
	HLLOM	W,FEXT(R)	;YES - STASH EXTENSION
	TLZE	F,L.LBK		;LEFT BRACKET SEEN
	HRLM	N,PPN(R)	;YES - STASH PROJ #
	TLZE	F,L.CMA		;COMMA SEEN
	HRRM	N,PPN(R)	;YES - STASH PROG #
	TLZE	F,L.SLA		;SLASH SEEN
	PUSHJ	P,DOSWIT(R)	;YES - PROCESS SWITCH
PARSE4:	CAIN	T1,"."		;PERIOD
	TLO	F,L.DOT		;YES - FILE EXTENSION REQUEST
	CAIN	T1,"["		;BRACKET
	TLO	F,L.LBK		;YES - PPN COMING
	CAIN	T1,"/"		;SLASH
	TLO	F,L.SLA		;YES - SWITCH COMING
	CAIN	T1,","		;COMMA
	TLO	F,L.CMA		;PPN FOLLOWS
	CAIN	T1,15		;IS THIS A CR
	JRST	DOIT(R)		;YES - TRY TO EXECUTE CMD
	CAILE	T1,40		;MINIMAL CHECK
	JRST	PARSE(R)	;OK - PROCEED
	ERROR	(CME,<COMMAND ERROR>)
;SWITCH PROCESSOR - ATOM IN W

DOSWIT:	PUSH	P,T1		;SAVE BRK CHAR
	HLLZS	T1,W		;COPY OF ATOM (3CHAR)
	MOVNI	T2,1		;MASK TO ALL ONES
	LSH	T2,-6		;SHIFT ONE CHAR
	LSH	T1,6		;  FROM MASK AND ARG
	JUMPN	T1,.-2(R)	;LOOP TILL ALL GONE
	MOVNI	T3,1		;INIT FLAG
	MOVE	Q,[-SWLEN,,SWTAB](R) ;TABLE PNTR
	ADDI	Q,0(R)		;RELOCATE
SWITL:	HRLZ	T4,0(Q)		;FETCH TABLE ENTRY
	TDZ	T4,T2		;MASK CHARS NOT TYPED
	CAMN	W,0(Q)		;CHECK EXACT MATCH
	JRST	SWITM(R)	;YES - EXIT
	CAME	W,T4		;ALMOST MATCH?
	JRST	SWITN(R)	;NO - PROCEED
	AOJG	T3,SWITN(R)	;YES - FIRST ONE?
	MOVE	D,Q		;YES - REMEMBER IT
SWITN:	AOBJN	Q,SWITL(R)	;LOOP TILL FINISHED
	SKIPN	T3		;CHECK SAVED VALUE
	MOVE	Q,D		;RESTORE IF ONE FOUND
SWITM:	POP	P,T1		;RESTORE BREAK CHAR
	HLLZ	T2,0(Q)		;GET TABLE ENTRY
	JUMPL	T2,SWERR(R)	;ERROR IF NEG
	LDB	T3,[POINT 3,T2,7](R) ;GET SW TYPE
	JUMPE	T3,SWITS(R)	;JUST SET BITS IF ZERO
	ADDI	T3,(R)		;ELSE ADD IN RELOC
	JRST	SWDSP(T3)	;AND DISPATCH

SWITS:	CAIN	T1,":"		;BETTER NOT BE COLON
SWERR:	ERROR	(ISW,<ILLEGAL SWITCH OR ARGUMENT>)
	TDO	F,T2		;SET ONES LEFT IN FLG REG
	POPJ	P,		;AND EXIT

;HERE TO HANDLE UNIT NUMBER

SWUNI:	LDB	T3,[POINT 3,T2,17](R) ;GET CTL TYPE
	HRR	F,T3		;SET IN F
	CAIE	T1,":"		;CHECK FOR VALUE
	JRST	[MOVEI N,0	;DEFAULT TO ZERO
		 JRST SWUNI1(R)](R)
	PUSHJ	P,REDSIX(R)	;SNARF ATOM
SWUNI1:	MOVEM	N,UNIT(R)	;STASH VALUE
	POPJ	P,		;AND EXIT
;HERE TO SPECIFY START ADDRS

SWADR:	TLO	F,STRTF		;SET START SWITCH SEEN
	CAIE	T1,":"		;COLON SEEN
	SKIPA	N,.JBSA		;USE START ADDRS OF CORE IMAGE
	PUSHJ	P,REDSIX(R)	;GET ATOM
	HRRZM	N,PROGSA(R)	;SET START ADDRS
	POPJ	P,		;AND EXIT

;HERE TO PICK UP DENSITY ARG

SWDEN:	CAIE	T1,":"		;CORRECT DELIM?
	JRST	SWERR(R)	;NO - LOSE
	PUSHJ	P,REDSIX(R)	;SNARF AN ATOM
	JUMPE	D,SWERR(R)	;LOSE IF NOT A GOOD NUMBER
	MOVE	W,[-DLEN,,DENTAB](R) ;TABLE PNTR
	ADDI	W,(R)		;RELOCATE
SWDN1:	MOVE	T2,0(W)		;GET TABLE ENTRY
	CAIE	D,(T2)		;MATCH?
	AOBJN	W,SWDN1(R)	;NO - TRY NEXT
	JUMPGE	W,SWERR(R)	;LOSAGE IF NOT FOUND
	HLRZM	T2,TDEN(R)	;SAVE DENSITY INDEX
	POPJ	P,		;RETURN
;SWITCH TABLE

SWTAB:	DOREWF,,'REW'		;/REWIND
	DOSKPF,,'SKI'		;/SKIP
	LOADF,,'LOA'		;/LOAD
	REPOSF,,'NOR'		;/NOREWIND
	S.ADR,,'STA'		;/START
	S.DEN,,'DEN'		;/DENSITY
	S.UNI+0,,'TM1'		;/TM10
	S.UNI+2,,'TC1'		;/TC10
	S.UNI+3,,'TX0'		;/TX01
	S.UNI+4,,'TM0'		;/TM02

SWLEN==.-SWTAB
	-1			;END OF TABLE

;SPECIAL SWITCH DISPATCH TABLE

SWDSP:	JRST	SWERR(R)	;0 - ERROR
	JRST	SWUNI(R)	;1 - UNIT SPEC
	JRST	SWADR(R)	;2 - START ADDRS
	JRST	SWDEN(R)	;3 - DENSITY SPEC

;DENSITY TABLE

DENTAB:	1,,^D200		;200 BPI
	2,,^D556
	3,,^D800
	4,,^D1600

DLEN==.-DENTAB		;# OF ENTRIES
SUBTTL DISPATCH AND MISC

;HERE TO PERFORM COMMAND

DOIT:	HRRZ	T2,F		;GET CTL TYPE
	ADDI	T2,RS(R)	;ADDRS OF RESET TABLE
	PUSHJ	P,@(T2)		;DISPATCH
	TLZE	F,DOSKPF	;SKIP FILE?
	JRST	[PUSHJ P,SKPEOF(R)
		 JRST REGO(R)](R)
	TLZN	F,DOREWF	;REWIND?
	JRST	FIND(R)		;NO - READ FILE
	PUSHJ	P,REWND(R)	;YES - START REWIND
	PUSHJ	P,CKREW(R)	;WAIT TILL DONE
	JRST	REGO(R)		;BACK TO TOP

;ROUTINE TO CLEAR CORE

LINIT:	MOVE	T1,[40,,41](R)	;START AT 40
	SETZM	40		;CLEAR FIRST LOC
IFE DEBUG,<BLT T1,BOOTM-1(R)>	;CLEAR TO BOTTOM OF PROGRAM
IFN DEBUG,<BLT T1,357777>	;DDT IS AT 360000
	POPJ	P,		;RETURN

NOTFSF:	ERROR	(NSF,<NOT FAILSAFE FORMAT>)

;DISPATCH TABLE FOR RESET FUNCTIONS

RS:	TMA.RS(R)		;TM10A
	TMB.RS(R)		;TM10B
	TCX.RS(R)		;TC10C
	TX1.RS(R)		;TX01/DX10
	TM2.RS(R)		;TM02

;RESET ROUTINE FOR TM10

TMA.RS:	CONSZ	TMC,7		;MAKE SURE NOT TM10B
	HRRI	F,1		;WHOOPS IT IS
TMB.RS:	POPJ	P,		;RETURN

IFN FTTC10,<
;ROUTINE TO DO RESET ON TC10

TCX.RS:	POPJ	P,		;DUMMY
>
SUBTTL SCAN TAPE FOR DESIRED FILE SPEC.

FIND:	SKIPN	T1,DEVICE(R)	;CHECK IF DEVICE GIVEN
	MOVE	T1,[SIXBIT "DSKB"](R)
	MOVEM	T1,DEVICE(R)	;STORE CORRECT VALUE
	SKIPN	T1,FNAME(R)	;CHECK ON FILE NAME
	MOVE	T1,[SIXBIT "SYSTEM"](R) ;DEFAULT NAME
	MOVEM	T1,FNAME(R)	;STORE
	SKIPN	T1,PPN(R)	;CHECK FOR PPN
	MOVE	T1,[1,,4](R)	;DEFAULT IS SYSTEM PPN
	MOVEM	T1,PPN(R)	;STORE IT
	SKIPN	M,FEXT(R)	;CHECK FOR EXPLICIT EXTENSION
IFN FTEXE,<HRLOI M,'EXE'>	;SELECT PROPER DEFAULT
IFE FTEXE,<HRLOI M,'SAV'>	;...
	HLLZM	M,FILEXT(R)	;SAVE PLAIN EXTENSION

FIND0:	SETOM	B		;WE DONT KNOW YET IF BACKUP OR FAILSA
	PUSHJ	P,READBL(R)	;GO READ 1ST RECORD
	  JRST	.-1(R)		;SEARCH FOR FAILSAFE SAVE/SET
IFN FTFRS,<
	MOVE	T1,DBUF(R)	;IF WORD 0 IS A SMALL POSITIVE NUMBER,
	CAIGE	T1,7
	JUMPG	T1,FNDFIB(R)	;THEN ITS PROBABLY BACKUP
>
FIND1:	PUSHJ	P,SKPEOF(R)	;OK - SKIP TO EOF
	HRRZ	T1,DBUF(R)	;GET WORD COUNT
	MOVE	T2,DBUF+1(R)	;VERIFY HEADER
	CAIN	T1,4		;CHECK FOR HEADER LABEL
	CAME	T2,['*FAILS'](R)
	JRST	FIND0(R)
	SETZ	B,		;B=0 IF FAILSAFE FORMAT

FNDFIL:	PUSHJ	P,READBL(R)	;GET A BLOCK
	  JRST	FNDFIL(R)	;EOF - IGNORE
	MOVE	T1,DBUF(R)	;GET FIRST WORD
	JUMPL	T1,CHKFIL(R)	;CHECK IF HEADER
	HRRZ	T1,T1		;GET RHS
	MOVE	T2,DBUF+1(R)	;[14] GET SECOND WORD
	CAIN	T1,4		;[14] TRAILER?
	CAME	T2,['*FAILS'](R);[14] ...
	JRST	FNDFIL(R)	;NO - KEEP TRYING
FINDX:	PUSHJ	P,REWND(R)	;YES - REWIND TAPE
	HLRZS	M		;FILE EXTENSION
	SKIPN	FEXT(R)		;WAS ONE SPECIFIED
	CAIN	M,'SAV'		;NO - WAS SAV FOUND?
	ERROR	(FNF,<FILE NOT FOUND>)
	HRLOI	M,'SAV'		;TRY LOOKING FOR SAV EXTENSION
IFN FTFRS,<
	HLLZM	M,FILEXT(R)	;TELL BACKUP-CODE THE EXT WE WANT
>
	JRST	FIND0(R)	;TAPE SHOULD BE REWOUND
;HERE IF (PROBABLY) BACKUP FORMAT
IFN FTFRS,<
FNDFIB:	MOVE	T1,DBUF(R)	;FIRST WORD
	CAIGE	T1,7		;IS IT A BLOCK TYPE?
	SKIPGE	T1
	JRST	FIND1(R)	;OOPS, REALLY ISNT BACKUP
	CAIN	T1,4		;YES, A FILE?
	JRST	CHKFIB(R)	;YES, CHECK IT
	CAIN	T1,3		;NO, END-OF-VOLUME?
	JRST	FINDX(R)	;YES, COULDNT FIND IT
FNDFI1:	PUSHJ	P,READBL(R)	;TRY NEXT BLOCK
	  JRST	FIND1(R)	;EOF - IT ISNT THERE
	JRST	FNDFIB(R)	;TEST THIS BLOCK

CHKFIB:	MOVE	T1,DBUF+3(R)	;FLAGS WORD
	TLNN	T1,40000	;START OF A FILE?
	JRST	FNDFI1(R)	;NO, KEEP TRYING
	MOVEI	W,DBUF+41(R)	;YES, POINT AT 1ST ID WORD
	MOVEI	B,1		;NO EXTENSION SEEN YET
CHKFI1:	PUSHJ	P,FDCODE(R)	;GLOM NEXT IDENTIFIER
	  JRST	CHKFI2(R)	;DONE, SEE IF WE WON
	ADDI	T1,DEVICE-1(R)	;POINT TO RIGHT WORD IN "LOOKUP BLOCK"
	CAME	T2,(T1)		;MATCH?
	JRST	FNDFI1(R)	;NO, KEEP ON TRYING
	JRST	CHKFI1(R)	;YES, TEST NEXT WORD
CHKFI2:	TRZN	B,2		;DID WE SEE AN EXT?
	SKIPN	FILEXT(R)	;NO, WAS ONE SPECIFIED?
	JRST	FOUND(R)	;WE WON!
	JRST	FNDFI1(R)	;CLOSE BUT NO CIGAR
;SUBROUTINE TO GET THE NEXT FILE ID WORD FROM THE BUFFER
;EXIT T1=CODE, T2= SIXBIT (OR PPN)
FDCODE:	HLRZ	T1,(W)		;TYPE-CODE
	JUMPE	T1,CPOPJ(R)	;DONE IF 0
	CAIG	T1,3		;1-3 ARE OK
	JRST	FDCOD1(R)
	CAIE	T1,40		;NOT 1-3, BETTER BE PPN
	POPJ	P,		;NOT PPN, DIDNT WIN
	MOVEI	T1,4		;PPN, SET CODE=4
FDCOD1:	CAIN	T1,3		;EXT?
	TRO	B,2		;SEEN EXTENSION
	HRRZ	N,(W)		;GET WORDCOUNT
	SUBI	N,1		;WHICH INCLUDES WDCNT WORD
	MOVEI	W,1(W)		;POINT AT DATA
	HRLI	W,440700	;MAKE A BYTE POINTER
	SETZB	T2,T3		;T2 GETS THE ANSWER
	CAIE	T1,4		;PPN?
	MOVE	T3,[POINT 6,T2](R) ;NO, SET BYTE PNTR FOR STORING
FDCOD2:	TLNN	W,760000	;DONE WITH THIS WORD?
	SOJLE	N,FDCOD5(R)	;YES, GO IF WDCNT EXHAUSTED
	ILDB	T4,W		;GET NEXT CHAR
	JUMPE	T4,FDCOD5(R)	;DONE IF 0
	CAIN	T1,4		;PPN?
	JRST	FDCOD3(R)	;YES
	SUBI	T4,40		;NO, MAKE SIXBIT
	TLNE	T3,770000
	IDPB	T4,T3		;AND SAVE IT
	JRST	FDCOD2(R)	;TEST NEXT CHAR
FDCOD3:	CAIN	T4,"_"		;DONE WITH PROJECT?
	JRST	FDCOD4(R)	;YES
	ROT	T4,-3		;NO, ACCUMULATE ANSWER
	LSHC	T3,3
	JRST	FDCOD2(R)	;AND TRY NEXT
FDCOD4:	HRL	T2,T3		;PROJECT IN LH
	SETZ	T3,		;START FRESH WITH PROG. NUMBER
	JRST	FDCOD2(R)
FDCOD5:	CAIN	T1,4		;PPN?
	HRR	T2,T3		;YES, GET PROG NUMBER
	AOJA	W,CPOPJ1(R)	;POINT AT NEXT WORD AND EXIT
>	;END FTFRS
CHKFIL:	MOVE	T1,DEVICE(R)	;GET STR NAME
	CAME	T1,DBUF+1(R)	;MATCH?
	JRST	FNDFIL(R)	;NO - KEEP LOOKING
	MOVE	T1,FNAME(R)	;GET FILE NAME
	CAME	T1,DBUF+.RBNAM(R) ;MATCH
	JRST	FNDFIL(R)	;NO - TRY NEXT
	HLLO	T2,DBUF+.RBEXT(R) ;NOW TRY EXTENSION
	CAME	T2,M		;MATCH?
	JRST	FNDFIL(R)	;NOPE - TRY SOME OTHERS
	MOVE	T1,PPN(R)	;TRY PPN
	CAME	T1,DBUF+.RBPPN(R)
	JRST	FNDFIL(R)	;ALMOST MADE IT

FOUND:	PUSHJ	P,LINIT(R)	;INIT CORE
IFN FTFRS,<
	JUMPLE	B,FOUND1(R)	;GO IF FAILSAFE
	MOVE	W,DBUF+6(R)	;BACKUP - GET POSITION
	ADDI	W,DBUF+40(R)	;RELOCATE
	MOVN	T1,DBUF+5(R)	;GET COUNT
	HRL	W,T1		;MAKE AOBJN WORD
	JRST	FOUND2(R)	;AND CONTINUE
FOUND1:>
	MOVE	W,DBUF+2(R)	;GET HEADER OVERHEAD
	MOVNI	T1,2(W)		;NEGATE + 2
	ADD	T1,DBUF(R)	;ADD IN ACTUAL LENGTH
	MOVNI	T1,0(T1)	;NEGATE COUNT
	HRL	W,T1		;TO LHS OF W
	ADDI	W,DBUF+3(R)	;ADDRS OF DATA TO RHS
FOUND2:
IFN FTEXE,<
	HLRZS	M		;FILE EXTENSION
	CAIN	M,'EXE'		;WAS IT AN EXE FILE?
	JRST	RDEXE(R)	;YES - TRY .EXE FILE
>
	JRST	RFILE(R)	;NO - READ IT
SUBTTL LOAD A SAVE FILE

RFILE:	PUSHJ	P,RWORD(R)	;FETCH A WORD
	SKIPL	M,T3		;CHECK FOR IOWD
	JRST	STARTQ(R)	;MUST BE XFER WORD
RFIL1:	PUSHJ	P,RWORD(R)	;GOBBLE NEXT
	MOVEM	T3,1(M)		;STASH IN MEMORY
	AOBJN	M,RFIL1(R)	;LOOP TILL IOWD EXHAUSTED
	JRST	RFILE(R)	;LOOK FOR MORE TO DO

;ROUTINE TO READ NEXT TAPE BLOCK AND SET UP W

RWNXTB:	PUSHJ	P,READBL(R)	;SNARF A RECORD
	  ERROR	(TSF,<TAPE MARK IN SAVE FILE>)
IFN FTFRS,<
	JUMPLE	B,RWNXT2(R)	;GO IF FAILSAFE
	MOVE	T1,DBUF(R)	;BACKUP, GET TYPE
	MOVE	T2,DBUF+3(R)	;AND FLAGS
	CAIN	T1,4		;STILL A FILE?
	TLNN	T2,40000	;YES, START OF NEXT FILE?
	JRST	RWNXT1(R)	;NO, ALL IS WELL
	ERROR	(BFI,<BACKUP FILE INCONSISTANT>)
RWNXT1:	TLNE	T2,100000	;REPEAT RECORD?
	JRST	RWNXTB(R)	;REPEAT RECORD, WE WON ON THE ORIGINAL
	MOVE	W,DBUF+6(R)	;NO, GET POSITION (SHOULD BE 0)
	ADDI	W,DBUF+40(R)	;RELOCATE
	MOVN	T1,DBUF+5(R)	;GET COUNT
	HRL	W,T1		;AOBJN-IZE IT
	JRST	RWORD(R)	;AND CONTINUE
RWNXT2:>
	MOVE	T1,DBUF(R)	;LOOK AT FIRST WORD
	TLNE	T1,-1		;CHECK NEW FILE
	ERROR	(SFI,<SAVE FILE INCONSISTANT>)
	MOVNS	T1		;NEGATE COUNT
	HRLZ	W,T1		;MOVE TO W
	HRRI	W,DBUF+1(R)	;SET ADDRS
RWORD:	JUMPGE	W,RWNXTB(R)	;GET MORE IF LIST EMPTY
	MOVE	T3,0(W)		;RETURN WORD IN T3
	AOBJN	W,.+1(R)	;BUMP ONE
	POPJ	P,
;RETURN HERE TO START UP WORLD

STARTQ:	TLNE	F,STRTF		;START SPECIFIED?
	SKIPN	T1,PROGSA(R)	;SEE IF HE GAVE START ADRS
	MOVE	T1,T3		;NO - TRY ONE IN FILE
	HRRZM	T1,PROGSA(R)	;SAVE IT
	SKIPE	KLFLG(R)	;SKIP IF NOT KL
	BLKI	APR,BOOTWD	;READ SERIAL NUMBER
	SKIPE	KIFLG(R)	;SKIP IF NOT KI
	CONI	PAG,BOOTWD	;READ SERIAL NUMBER
	TLNE	F,LOADF		;LOAD OR START?
	JRST	REGO(R)		;LOAD - GET NEXT COMMAND
	TLNE	F,REPOSF	;WANT TO REPOS
	JRST	STARTN(R)	;NO - JUST START
	PUSH	P,BOOTWD	;SAVE SERIAL NUMBER
	PUSHJ	P,REWND(R)	;YES - REWIND DRIVE
	PUSHJ	P,SKPEOF(R)	;  AND SKIP ONE FILE
	POP	P,BOOTWD	;NEEDED FOR DUAL CPU
STARTN:	SKIPN	T3,PROGSA(R)	;START - GET ADDRS
	ERROR	(NSA,<NO START ADDRESS>)
	JRST	0(T3)		;OK - BLIND LEAP
SUBTTL LOAD AN EXE FILE

IFN FTEXE,<
RDEXE:	PUSHJ	P,RWORD(R)	;FETCH FIRST WORD OF FILE
	HLRZ	T1,T3		;DIRECTORY DESCRIPTOR
	HRRZ	T2,T3		;LENGTH OF DIRECTORY
	CAIN	T1,SV.DIR	;IS THIS A DIRECTORY
	CAIL	T2,^D128	;  AND LESS THAN 128 WORDS IN LENGTH
	ERROR	(NDL,<NOT AN EXE FILE OR DIRECTORY TOO LONG>)
	MOVEI	Q,DIRB(R)	;MAKE PNTR TO DIRECTORY BLOCK
	HRLI	Q,-^D128	;...
	SKIPA			;ALREADY HAVE FIRST WORD
RDEXE1:	PUSHJ	P,RWORD(R)	;FETCH WORD 
	MOVEM	T3,0(Q)		;STORE IN DIRECTORY
	AOBJN	Q,RDEXE1(R)	;LOOP TILL DONE
	MOVEI	T4,3		;SKIP REMAINDER OF PAGE
	PUSHJ	P,SKPBLK(R)	;SKIPS OVER 1 BLOCK OF FILE
	SOJG	T4,.-1(R)	;LOOP
	HRRZ	P1,DIRB(R)	;NOW MAKE AN AOBJN PNTR
	MOVNI	P1,-1(P1)	;  TO THE DIRECTORY
	HRLI	P1,DIRB+1(R)	;...
	MOVSS	P1

	MOVEI	Q,4		;Q HAS BLK # ABOUT TO BE READ
RDEXE2:	MOVE	P2,0(P1)	;P2 := BITS,,PAGE#
	JUMPL	P2,RDEXE3(R)	;JUMP IF HIGHSEG - READ IMMEDIATELY
				;  ABOVE THE LOW SEG
	HRRZ	M,1(P1)		;CORE PAGE NUMBER
	LSH	M,P2WLSH	;CONVERT TO ADDRESS
	SKIPN	M		;IS THIS PAGE 0?
	MOVNI	M,1		;YES - SET SPECIAL FLG
RDEXE3:	LDB	T4,[POINT 9,1(P1),8](R)
	MOVEM	T4,PAGCNT(R)
RDEXE4:	TRNN	P2,-1		;ALLOCATED BUT ZERO PAGE?
	SOJA	P2,RDEXE8(R)	;YES - ADJUST EVERYTHING
	HRRZ	T4,P2		;FILE PAGE #
	LSH	T4,P2BLSH	;CONVERT TO BLK WITHIN FILE
	CAILE	Q,(T4)		;CHECK FOR MONTONICALLY INCREASING PAGE #'S
	ERROR	(PNM,<PAGE NOT MONOTONICALLY INCREASING>)
			;FALL INTO NEXT PAGE (RDEXE5)
RDEXE5:	CAIN	T4,(Q)		;ARE WE IN THE RIGHT PLACE?
	JRST	RDEXE7(R)	;YES
RDEXE6:	PUSHJ	P,SKPBLK(R)	;NO - SKIP A BLOCK
	AOJA	Q,RDEXE5(R)	;INCREMENT CNTR AND TRY AGAIN
RDEXE7:	JUMPGE	M,[HRLI M,-PAGSIZ ;BUILD AOBJN PNTR
		   JRST RDEX7A(R)](R)
	MOVEI	M,40		;PAGE 0 - SKIP FIRST 40 WORDS
	PUSHJ	P,RWORD(R)	; TO AVOID WIPING
	SOJG	M,.-1(R)	;  OUT LOCS 0-37
	MOVE	M,[-<PAGSIZ-40>,,40](R)
RDEX7A:	PUSHJ	P,RWORD(R)	;GET A WORD
	MOVEM	T3,0(M)		;STORE IN CORE
	AOBJN	M,RDEX7A(R)	;LOOP TILL DONE
	ADDI	Q,4		;SAY WE READ 4 BLKS
	JRST	RDEXE9(R)	;TRY NEXT PAGE
RDEXE8:	ADDI	M,PAGSIZ	;ADVANCE TO NEXT PAGE
RDEXE9:	SOSL	PAGCNT(R)	;READ ALL PAGES OF THIS ENTRY
	AOJA	P2,RDEXE4(R)	;NO - READ THE NEXT PAGE
	AOBJN	P1,.+1(R)	;YES - INCR PAST DIR ENTRY
	AOBJN	P1,RDEXE2(R)	;GO GET NEXT ENTRY IF ANY
	HRRZ	T3,.JBSA	;ELSE GET START ADDRS
	JRST	STARTQ(R)	;AND SEE WHAT TO DO NEXT

;ROUTINE TO SKIP OVER ONE 128 WORD MAG TAPE BLOCK

SKPBLK:	PUSH	P,T4		;SAVE T4
	PUSH	P,Q		;  AND Q
	MOVEI	Q,^D128		;NUMBER TO SKIP
	PUSHJ	P,RWORD(R)	;EAT A WORD
	SOJG	Q,.-1(R)	;LOOP TILL DONE
	POP	P,Q		;RESTORE ACS
	POP	P,T4
	POPJ	P,		;AND EXTI
>
SUBTTL READ ROUTINES

;DISPATCH TABLE FOR READ FUNCTION
RD:	TMA.RD(R)		;TM10A
	TMB.RD(R)		;TM10B
	TCX.RD(R)		;TC10C
	TX1.RD(R)		;TX01/DX10
	TM2.RD(R)		;TM02

;ROUTINE TO READ NEXT BLOCK FROM TAPE
READBL:	SETZM	EOF(R)		;CLEAR EOF FLAG
	PUSHJ	P,CKREW(R)	;GRNTEE NOT REWINDING
	MOVEI	N,ERRTRY	;RETRY COUNTER
READ1:	PUSHJ	P,READX(R)	;READ THE NEXT RECORD
	  JRST	READE(R)	;READ ERROR RETURN
READ2:	SKIPN	EOF(R)		;OK RETURN - CK EOF
	AOS	0(P)		;DATA READ OK
	POPJ	P,		;RETURN

READX:	MOVE	D,[IOWD LNMTBF,DBUF](R) ;IOWD TO BUFFER
	ADDI	D,(R)		;RELOCATE
	HRRZ	T2,F		;GET UNIT TYPE
	ADDI	T2,RD(R)	;ADD TABLE OFFSET
	PUSHJ	P,@(T2)		;EXECUTE DEVICE DEP ROUTINE
	  SOS	(P)		;ERROR RETURN
	JRST	CPOPJ1(R)	;SKIP OR NON-SKIP

;HERE ON READ ERROR - FATAL
READE:
IFN FTFRS,<
	CAIN	N,ERRTRY	;FIRST RETRY?
	JUMPG	B,READE3(R)	;YES, SPECIAL IF BACKUP
READE1:>
IFN FTTU70,<
	HRRZ	T2,F		;IF A TU70
	CAIN	T2,3		; THE DX10 HAS RETRIED THE OPERATION
	JRST	READE2		;SO GIVE UP
>
	PUSHJ	P,BACKSP(R)	;REPOSITION
	SOJG	N,READ1(R)	;TRY AGAIN
	PUSHJ	P,SKIPR(R)	;SKIP BAD RECORD
READE2:	ERROR	(TRE,<TAPE READ ERROR>)
IFN FTFRS,<
READE3:	MOVEI	N,1		;COUNT OF RECORDS READ
	PUSHJ	P,READX(R)	;READ NEXT RECORD
	  AOJA	N,.-1(R)	;THAT ONE'S BAD TOO, TRY NEXT
	MOVE	T1,DBUF+3(R)	;GET FLAGS-WORD
	TLNE	T1,100000	;REPEAT OF A BAD RECORD?
	JRST	READ2(R)	;YES, WE WON
	PUSHJ	P,BACKSP(R)	;NO, REPOSITION
	SOJG	N,.-1(R)
	MOVEI	N,ERRTRY
	JRST	READE1(R)	;AND RETRY IT
>

;TM10A READ ROUTINE

TMA.RD:	MOVE	T1,UNIT(R)	;GET UNIT #
	LSH	T1,^D35-TM.UNP	;UNIT POSTION
	IORI	T1,TM.PAR+TM.CD+TM.RD ;READ DATA
	PUSHJ	P,TMSDN(R)	;SET CORRECT DENSITY
	CONO	TMC,(T1)	;START CTL
TMA.RL:	PUSHJ	P,TWAIT(R)	;WAIT FOR STATUS
	  CONSO	TMS,TM.DTR!TM.JBD ;WAIT FOR DONE
	CONSO	TMS,TM.DTR	;DATA REQUEST?
	JRST	TM.CHK(R)	;CHECK FOR ERRORS
	BLKI	TMC,D		;READ A WORD
	  JRST	TM.CHK(R)	;DONE - CHECK ERRORS
	JRST	TMA.RL(R)	;GET SOME MORE

;HERED AFTER READ TO CHECK FOR ERRORS

TM.CHK:	CONO	TMS,1		;STOP XFER
	PUSHJ	P,TWAIT(R)	;WAIT FOR STATUS
	  CONSO	TMS,TM.JBD	;INSTR TO XCT
	CONI	TMS,T2		;READ STATUS
	TRNE	T2,TM.EOF	;CHEKCK FOR TM
	SETOM	EOF(R)		;SET EOF FLAG
	TRNN	T2,TM.ERR	;ERRORS?
CPOPJ1:	AOS	0(P)		;ALL OK
CPOPJ:	POPJ	P,		;RETURN

;TM10B READ ROUTINE

TMB.RD:	CONI	TMS,T1		;GET STATUS
	TLNN	T1,TM.DFC	;CHECK FOR 22-BIT CHL
	JRST	TMB.R1(R)	;NO - SKIP OVER CODE
	HLRZ	T1,D		;GET LENGTH
	LSH	T1,4		;SHIFT 4 BITS
	HRL	D,T1		;PLACE BACK IN PNTR
TMB.R1:	MOVEM	D,CCW		;SAVE IOWD IN CHL PGM
	SETZM	CCW+1		;TERMINATE LIST
	MOVEI	T1,CCW
	DATAO	TMS,T1		;CCW ADDRS TO CTL
	MOVE	T1,UNIT(R)	;GET UNIT #
	LSH	T1,^D35-TM.UNP	;POSITION
	IORI	T1,TM.PAR+TM.CD+TM.RD ;FCN READ
	PUSHJ	P,TMSDN(R)	;SET CORRECT DENSITY
	CONO	TMC,(T1)	;START OPERATION
	PUSHJ	P,TWAIT(R)	;WAIT TILL DONE
	  CONSO	TMS,TM.JBD
	JRST	TM.CHK(R)	;CHECK ERRORS
;TC10C READ ROUTINE
IFN FTTC10,<

TCX.RD:	MOVEM	D,CCW		;STORE CTL WORD
	SETZM	CCW+1		;CLEAR TERMINATION WD
	MOVEI	T1,CCW		;SET INAD INTO
	DATAO	TCX,T1		;  DF10
	MOVE	T1,UNIT(R)	;GET UNIT #
	LSH	T1,^D35-TC.UNP	;POSITION
	IORI	T1,TC.GO+TC.LCR+TC.CDM+TC.RD
	CONO	TCX,(T1)	;START CHL
	PUSHJ	P,TWAIT(R)	;WAIT FOR STATUS
	  CONSO	TCX,TC.JBD
	MOVEI	T1,1B21		;STOP CHL
	DATAO	TCX,T1
	PUSHJ	P,TWAIT(R)	;GRNTEE JOB DONE UP
	  CONSO	TCX,TC.JBD
	CONI	TCX,T2		;READ STATUS
	TLNE	T2,TC.EOF	;END OF FILE?
	SETOM	EOF(R)		;YES - SET FLAG
	TLNN	T2,TC.ERR	;CHECK ERRORS
	AOS	(P)		;OK - SKIP RETURN
	POPJ	P,		;...

;ROUTINE TO SELECT UNIT ON TC10 CTL

TCSEL:	MOVE	T1,UNIT(R)	;GET UNIT #
	LSH	T1,^D35-TC.UNP
	IORI	T1,TC.NOP+TC.LCR+TC.GO
	CONO	TCX,(T1)	;DO NOOP TO DRIVE
	PUSHJ	P,TWAIT(R)	;WAIT FOR UNIT READY
	  PUSHJ	P,[CONI TCX,T2	;GET STATUS
		   TLNE T2,TC.RDY!TC.RWS ;READY OR REWN'D
		   AOS (P)	;GIVE SKIP
		   POPJ P,](R)	;RETURN
	POPJ	P,		;RETURN
>
IFN FTTM02,<
;TM02 (TU16/TU45) READ ROUTINES
TM2.RS:	MOVEI	T1,270/4	;SEARCH FOR RIGHT DEVICE CODE
	SETZ	X,		;ASSUME RH10
TM2.R1:	DPB	T1,[POINT 7,TM2DTO(R),9](R) ;TRY THIS CONTROLLER
	DPB	T1,[POINT 7,TM2DTI(R),9](R)
IFN FTRH20,<
	JUMPE	X,TM2.R2(R)	;IF AN RH20,
	DPB	T1,[POINT 7,TM2CNO(R),9](R)
	MOVEI	T2,T2.MBE	;MASSBUS ENABLE
	XCT	TM2CNO(R)
TM2.R2:>
	MOVE	T2,UNIT(R)	;UNIT WE'RE TALKING TO
	HRLI	T2,T2.DTC!T2.DLR ;SET TO TALK TO IT
	XCT	TM2DTO(R)	;TELL TAPE CONTROL REG
	MOVSI	T2,T2.DDT	;READ DRIVE TYPE REGISTER
	PUSHJ	P,TM2DTO(R)
	MOVE	T3,T2		;PRESERVE DT REG
	ANDI	T2,770		;MASK FOR TM02/TU16
	CAIN	T2,10		;IS IT?
	JRST	TM2.R3(R)	;YES, WE'RE THERE
	ADDI	T1,1		;NO, TRY NEXT CONTROL
	CAIN	T1,300/4	;AFTER 274 IS 360
	MOVEI	T1,360/4
	CAIG	T1,374/4	;TRIED LAST RH10 DEV CODE?
	JRST	TM2.R1(R)	;NO, TRY THIS ONE
IFN FTRH20,<
	MOVEI	X,1		;TRY THE RH20'S
	CAIG	T1,574/4
	JRST	TM2.R1(R)	;UNLESS WE TRIED ALL OF THEM
>
	ERROR	(NT2,<NO RH FOR TM02>)
TM2.R3:	DPB	T1,[POINT 7,TM2CNI(R),9](R) ;SET DEV CODE IN OTHER INSTRUCTIONS
	DPB	T1,[POINT 7,TM2CSO(R),9](R)
	TRNE	T3,10000	;IS IT 9-TRACK?
	HRROS	X		;NO, 7-TRACK
IFN FTRH20,<
	LSH	T1,2		;COMPUTE INITIAL CNTRL WRD ADDRESS
	ADDI	T1,EPT-540	; IF THIS IS AN RH20
	HRRM	T1,TM2.IC(R)
>
	POPJ	P,		;AND RETURN

TM2DTO:	DATAO	,T2		;SELECT REGISTER
	IMULI	T2,1		;WAIT A WHILE
	IMULI	T2,1
TM2DTI:	DATAI	,T2		;READ IT
	ANDI	T2,177777	;ONLY 16 BITS ARE OF INTEREST
	POPJ	P,
;READ ROUTINE
TM2.RD:	PUSHJ	P,T2.STC(R)	;SET UP TAPE CONTROL REG
IFN FTRH20,<
	MOVEI	T2,515410	;CLEAR ERRORS, MASSBUS ENABLE
TM2CNO:	CONO	,(T2)		;CLEAR THE RH20
>
	HLRE	T2,D		;WORDCOUNT
	MOVEI	N,5		;COMPUTE FRAME COUNT
	SKIPGE	X		;9-TRACK?
	ADDI	N,1		;NO
	IMULI	T2,(N)
	ANDI	T2,177777	;TELL FRAME-COUNT REG
	HRLI	T2,T2.DFC!T2.DLR
	XCT	TM2DTO(R)
IFN FTRH20,<
	TRNN	X,1		;RH20?
	JRST	TM2CNI(R)	;NO
	HLRE	T1,D		;YES, GET POSITIVE WRDCNT
	MOVNS	T1
	TRO	T1,600000_-4	;TRA+LAST (READY TO BE SHIFTED TO RIGHT PLACE)
	MOVE	T2,[200000,,CCW](R) ;JUMP TO IOWD
TM2.IC:	MOVEM	T2,.		;STORE INITIAL JUMP (ADDR PATCHED)
	AOJA	D,TM2.RH(R)	;SET LH OF IOWD, CONTINUE
>
TM2CNI:	CONI	,T1
	TLNN	T1,T2.22B	;22-BIT DF?
	JRST	TM2.RA(R)	;NO, GO READ
	HLRZ	T1,D		;YES, ADJUST WORD COUNT
TM2.RH:	LSH	T1,4
	HRLM	T1,D
TM2.RA:	MOVEM	D,CCW		;SAVE IOWD
	SETZM	CCW+1		;TERMINATE IO LIST
IFN FTRH20,<
	TRNE	X,1		;IF AN RH20
	SKIPA	T2,[716200,,377000!T2.RDF](R) ;READ RH20-STYLE
>
	MOVE	T2,[T2.DRH!T2.DLR,,CCW_6!T2.RDF](R) ;READ RH10-STYLE
	XCT	TM2DTO(R)	;START THE OPERATION
	PUSHJ	P,TWAIT(R)	;WAIT TILL JOB DONE COMES UP
TM2CSO:	  CONSO	,T2.DON
TM2.RB:	MOVSI	T2,T2.DSR	;READ STATUS REG
	PUSHJ	P,TM2DTO(R)
	TRNE	T2,T2.SEF	;EOF?
	SETOM	EOF(R)		;YES
	TRNN	T2,T2.SER	;ERROR?
	JRST	TM2.RC(R)	;NO, WE WON
	MOVE	T1,T2		;PRESERVE STATUS REG
	MOVSI	T2,T2.DER	;READ THE ERROR REG
	PUSHJ	P,TM2DTO(R)
	TRNE	T1,T2.SPE	;PE MODE?
	TRZ	T2,T2.NER	;YES, THESE AREN'T ERRORS
	TRNN	T2,T2.ERR	;ERROR?
TM2.RC:	AOS	(P)		;NO ERROR, SKIP-RETURN
	MOVE	T2,[T2.DLR,,T2.DCF](R) ;CLEAR OUT THE DRIVE
	XCT	TM2DTO(R)	; IN CASE OF ANY ERRORS LEFT
	POPJ	P,		;AND RETURN
;ROUTINE TO SET UP THE TAPE-CONTROL REGISTER
T2.STC:	SKIPL	T2,X		;9-TRACK?
	TDZA	T2,T2		;9-TRACK CORE DUMP
	MOVEI	T2,T2.M7T	;NO, 7-TRACK CORE DUMP
	MOVEI	N,4		;4 OR 5 FRAMES PER WORD
	SKIPGE	X
	SUBI	N,1
	SKIPE	T1,TDEN(R)	;GET DENSITY
	CAILE	T1,(N)
	MOVEI	T1,(N)		;1=200BPI,...4=1600
	ADDI	T1,T2.DTB(R)	;POINT TO RIGHT DENSITY ENTRY
	ADD	T2,(T1)		;SET DENSITY IN DATAO
	ADD	T2,UNIT(R)	;PLUS UNIT NUMBER
	HRLI	T2,T2.DTC!T2.DLR ;TELL TAPE CNTRL REG
	XCT	TM2DTO(R)	;NOW WE'RE TALKING TO DRIVE
	POPJ	P,		;AND RETURN

T2.DTB:	-1
	0B27		;200 BPI
	1B27		;556
	2B27		;800
	4B27		;1600
>	;END FTTM02
;TX01/DX10 READ ROUTINE

IFN FTTU70,<

TX1.RD:	HLRZ	T1,D		;ADJUST WORD COUNT
	HRRZ	T2,TX.MOD(R)	;  TO BE BYTE COUNT
	IMUL	T1,T2		;...
	LSH	T1,4		;PUT IN PROPER POSITION
	HRL	D,T1		;PUT BACK INTO XFER WORD
	ADDI	D,1		;ADJUST FOR DX10
	MOVEI	X,CHPRG(R)	;SET UP CHL PGM PNTR
	SKIPGE	TX.MOD(R)	;7-TK DRIVE?
	PUSHJ	P,TX.7MD(R)	;SET 7 TRACK MODE
	MOVEI	T1,TX.FRD	;FWD READ CODE
	PUSHJ	P,TX.CMD(R)	;BUILD COMMAND
	MOVEI	T1,TX.9TK	;ASSUME 9 TRACK MODE
	SKIPG	TX.MOD(R)	;IS IT?
	MOVEI	T1,TX.7TK	;NO - USE DIFFERENT MODE
	DPB	T1,[POINT 2,0(X),6](R) ;SET INTO COMMAND
	MOVEM	D,1(X)		;SAVE XFER LIST
	MOVSI	T1,(CH.STS!CH.FRC)
	MOVEM	T1,2(X)		;STORE STATUS & SENSE BYTES

TX.XFR:	PUSHJ	P,TX.SXS(R)	;SET UP XS AREA & START XFR
	PUSHJ	P,TWAIT(R)	;NOW WAIT TILL DONE
	  CONSO	PDC,TX.STA
	PUSHJ	P,TX.CHK(R)	;CHECK FOR CHL ERRORS
	PUSHJ	P,CLRSTA(R)	;CLEAR STATUS AVAIL NOW
	TLNN	T3,(CS.DSF)	;DSR FLAG?
	JRST	CPOPJ1(R)	;NO - EVERTHING OK
	TLNN	T3,(DS.UEX)	;UNIT EXCEPTION?
	POPJ	P,		;NO - JUST ERROR
	SETOM	EOF(R)		;YES - MUST BE EOF
	TLNN	T3,(DS.UCH!CS.DPE) ;UNIT CHECK ALSO
	AOS	0(P)		;NO - OK RETURN
	POPJ	P,		;ERROR ALSO

;SET UP XS AREA AND START XFER

TX.SXS:	HRLZI	T1,-LSNS_4	;CONSTRUCT XFER FOR SENSE BYTES
	HRRI	T1,CHSNS(R)	;ADDRS OF XS AREA
	MOVEM	T1,ICPC+3	;STORE IN ICPC AREA
	JRST	TX.GO(R)	;START CHL
>
SUBTTL TX01/DX10 ROUTINES

IFN FTTU70,<
;DX10 RESET ROUTINE

TX1.RS:	CONI	PDC,T1		;GET CTL STATUS
	TLNE	T1,(TX.RUN)	;'8 RUNNING?
	JRST	TX.IN1(R)	;YES - PROCEDE
	PUSHJ	P,UPRES(R)	;NO - RESET
	PUSHJ	P,UPHALT(R)	;MAKE SURE HALTED
	MOVSI	T4,-UPMTBL 	;CHECK MAGIC LOCS
	ADDI	T4,0(R)		;ADD IN RELOCATION
TX.IN0:	HLRZ	T3,UPMTAB(T4)	;GET ADDRESS
	PUSHJ	P,UPMRD(R)	;READ CONTENTS
	HRRZ	T3,UPMTAB(T4)	;GET EXPECTED VALUE
	CAME	T2,T3		;MATCH?
TX.NRN:	ERROR	(CSD,<CANNOT START DX10>)
	AOBJN	T4,TX.IN0(R)	;YES - TRY MORE
TX.IST:	MOVEI	T3,UP.SA	;SET START ADDRS
	PUSHJ	P,UPSTRT(R)	;START IT
TX.IN1:	PUSHJ	P,CLRICP(R)	;CLEAR ICP(R)C AREA
	PUSHJ	P,CLRCHN(R)	;CLEAR CHL & SET ICPC
	CONI	PDC,T1		;GET STATUS
	TLNN	T1,(TX.RUN)	;STILL RUNNING
	JRST	TX.NRN(R)	;NO - INFORM USER
	MOVEI	X,CHPRG(R)	;SET UP PNTR TO PROGRAM
	MOVEI	T1,TX.NOP	;DEVICE COMMAND NOOP
	PUSHJ	P,TX.CMD(R)	;BUILD A DEVICE COMMAND
	MOVSI	T1,(CH.STS!CH.FRC);FORCE SENSE BYTES
	MOVEM	T1,CHPRG+1(R)	;STORE IN CHL PROG
	PUSHJ	P,TX.SXS(R)	;START CHL ETC.
	PUSHJ	P,TWAIT(R)	;WAIT FOR DONE
	  CONSO	PDC,TX.STA	;STATUS AVAILABLE
	PUSHJ	P,CLRSTA(R)	;CLR STATUS AVAIL NOW
	MOVE	T1,CHSNS+SB1(R)	;GET SENSE BYTE 1
	MOVEI	T2,5		;ASSUME 9-TK
	TLNE	T1,(SB17TK)	;TEST FOR 7-TK
	HRROI	T2,6		;IT IS , SET 6 BYTE/WD
	MOVEM	T2,TX.MOD(R)	;SAVE IN MODE WORD
	POPJ	P,		;RETURN

UPMTAB:	XWD	17,4756
	XWD	200,5210
	XWD	210,6007
	XWD	211,3777
	XWD	212,3774
	XWD	215,6502

UPMTBL==.-UPMTAB
;DX10 UTILITIES FOR THE PDP8

UPHALT:	MOVEI	T2,DO.UC0	;SELECT CTL 0
	PUSHJ	P,UPRSEL(R)	;...
	MOVEI	T2,DU0HLT	;SET HALT
	DATAO	PDC,T2		;...
	POPJ	P,

UPRES:	MOVSI	T2,(DO.RES)	;ISSUE RESET CMD
	DATAO	PDC,T2
	POPJ	P,		;RETURN

UPSTRT:	MOVEI	T2,DO.UC1	;SELECT CTL 1
	PUSHJ	P,UPRSEL(R)	;...
	ANDI	T3,7777		;VALIDATE ADDRS
	DATAO	PDC,T3		;SEND ADDRS
	MOVEI	T2,DO.UC0	;SELECT CTL 0
	PUSHJ	P,UPRSEL(R)	;...
	MOVEI	T2,DU0CON	;SET CONTINUE
	DATAO	PDC,T2		;...
	POPJ	P,		;RETURN

UPRSEL:	TLO	T2,(DO.LRS)	;LOAD REG SELECT BIT
	DATAO	PDC,T2		;SELECT REGISTER
	POPJ	P,		;RETURN

;READ MEMORY LOC IN DX10
;C(T3) := ADDRS , RESULT INTO T2

UPMRD:	MOVEI	T2,DO.UC1	;SELECT CTL 1
	PUSHJ	P,UPRSEL(R)	;...
	ANDI	T3,7777		;GRNTEE VALID ADDRS
	DATAO	PDC,T3		;SEND IT OUT
	MOVEI	T2,DO.UC0	;SELECT CTL 0
	PUSHJ	P,UPRSEL(R)	;...
	MOVEI	T2,DU0EXM	;EXAMINE ENABLE
	DATAO	PDC,T2		;SEND IT OUT
	DATAI	PDC,T2		;READ REG
	ANDI	T2,7777		;ONLY BITS OF INTEREST
	POPJ	P,		;RETURN
;ROUTINE TO CLEAR ICPC AREA

CLRICP:	SETZM	ICPC		;CLEAR 1ST WORD
	SETZM	ICPC+1
	SETZM	ICPC+2
	SETZM	ICPC+3		;THROUGH 4TH WORD
	POPJ	P,		;RETURN

;ROUTINE TO SET UP CHL STUFF

CLRCHN:	MOVEI	T1,ICPC		;ADDRS OF CHL AREA
	LSH	T1,^D9		;PROPER POSITION
	IORI	T1,TX.UPE!TX.MPE!TX.NXM!TX.STA
	CONO	PDC,(T1)	;CLEAR ERROR FLGS & SET ICPC
	POPJ	P,		;RETURN

;ROUTINE TO SETUP CHL COMMAND C(T1) := CMD

TX.CMD:	SETZM	0(X)		;CLEAR CMD WORD
	DPB	T1,[POINT 8,0(X),23](R) ;SET CMD IN PLACE
	MOVSI	T1,(CH.COP)	;SAY ITS A CHL OPR
	IORM	T1,0(X)		;PUT INTO CMD
	MOVE	T1,UNIT(R)	;GET UNIT #
	DPB	T1,[POINT 8,0(X),35](R)
	POPJ	P,		;RETURN

;ROUTINE TO START CHL

TX.GO:	MOVE	T1,[CH.JMP!CH.GO+CHPRG](R) ;JUMP TO PROG AREA
	ADDI	T1,(R)		;RELOCATE
	MOVEM	T1,ICPC		;PUT IN ICPC
	CONSZ	PDC,TX.STA	;THIS BETTER NOT BE ON
	ERROR	(CSE,<CHANNEL SYNCHRONIZATION ERROR>)
	CONO	PDC,TX.ILI!TX.CON!TX.CLR
	POPJ	P,		;START AND RETURN

;ROUTINE TO SETUP 7 TRACK MODE SET CMD

TX.7MD:	SKIPE	T1,TDEN(R)	;SEE IF DENSITY SPECIFIED
	CAILE	T1,3		;CHECK MAX ALLOWED
	MOVEI	T1,3		;ELSE USE DEFAULT
	ADDI	T1,(R)		;RELOCATE
	MOVE	T1,TX.DTB(T1)	;GET DENSITY CMD
	PUSHJ	P,TX.CMD(R)	;FINISH COMMAND
	ADDI	X,1		;ADVANE PNTR TO NEXT
	POPJ	P,		;RETURN

;TX01/DX10 DENSITY TABLE
TX.DTB:	TX.D78		;800 BPI DEFAULT
	TX.D72		;200
	TX.D75		;556
	TX.D78		;800
>
SUBTTL TAPE POSITIONING ROUTINES

;ROUTINE TO SKIP FORWARD/BACKWARD ONE RECORD

SKIPR:	TDZA	T4,T4		;FORWARD SKIP RECORD
BACKSP:	MOVEI	T4,1		;BACK SKIP RECORD
	ADDI	T4,(R)		;ADD RELOCATION NOW
	PUSHJ	P,CKREW(R)	;GRNTEE NOT REWINDING
	HRRZ	T2,F		;GET TYPE
	ADDI	T2,SR(R)	;TABLE OFFSET
	JRST	@(T2)		;EXECUTE ROUTINE

;SPACE TABLE (0 := SKIP FWD , 1:= SKIP BKWD)

SR:	TMA.SR(R)
	TMB.SR(R)
	TCX.SR(R)
	TX1.SR(R)
	TM2.SR(R)

;ROUTINES FOR TM10A/B

TMB.SR:	SETZM	CCW		;CLR THESE FOR TM10B
	SETZM	CCW+1
TMA.SR:	PUSHJ	P,TMSEL(R)	;SELECT UNIT
	MOVE	T1,UNIT(R)	;GET UNIT #
	LSH	T1,^D35-TM.UNP
	IORI	T1,TM.CD+TM.PAR	;SET DEFAULT BITS
	PUSHJ	P,TMSDN(R)	;SET DENSITY
	IOR	T1,[TM.FSR
		    TM.BSR](T4)	;SET CORRECT COMMAND
	CONO	TMC,(T1)	;START OP
	PUSHJ	P,TWAIT(R)	;TILL DONE
	  CONSO	TMS,TM.JBD
	CONSZ	TMS,TM.EOF	;CHECK EOF
	SETOM	EOF(R)		;YEP - SET FLAG
	POPJ	P,		;RETURN

;TM10 DENSITY TABLE

TM.DTB:	TM.D8		;DEFAULT
	TM.D2		;200 BPI
	TM.D5		;556 BPI
	TM.D8		;800 BPI
;ROUTINE TO SKIP TO EOF

SKPEOF:	SETZM	EOF(R)		;GRNTEE WE SEE A LATER ONE
	PUSHJ	P,SKIPR(R)	;SKIP A RECORD
	SKIPN	EOF(R)		;EOF YET?
	JRST	SKPEOF(R)	;NO - LOOP
	POPJ	P,		;YES - EXIT

;ROUTINE TO WAIT FOR UNIT TO SHOW DESIRED STATUS
;CALL:	PUSHJ	P,TWAIT
;	<INSTR TO EXECUTE>   ;SKIP WHEN SUCCESSFUL

TWAIT:	MOVSI	T1,WAITM	;TIME TO WAIT FOR STATUS
	XCT	@(P)		;EXECUTE INSTR
	SOJG	T1,.-1(R)	;'ROUND
	JUMPN	T1,CPOPJ1(R)	;SUCCESS
	ERROR	(NMS,<NO MAG-TAPE STATUS>)

;ROUTINE TO SELECT TM10 DRIVE

TMSEL:	MOVE	T1,UNIT(R)	;UNIT #
	LSH	T1,^D35-TM.UNP	;POSITION
	IORI	T1,TM.NOP	;SELECT NOOP
	CONO	TMC,(T1)	;GRONK
	PUSHJ	P,TWAIT(R)	;WAIT
	  CONSO	TMS,TM.TUR!TM.RWS ;TILL READY
	POPJ	P,		;RETURN - DRIVE SELECTED

;ROUTINE TO SET DENSITY INTO T1

TMSDN:	SKIPE	T2,TDEN(R)	;SEE IF DENSITY SPEC
	CAILE	T2,3		;CHECK MAX ALLOWED
	MOVEI	T2,3		;NO - USE 800BPI
	ADDI	T2,(R)		;RELOC
	IOR	T1,TM.DTB(T2)	;SET DENSTIY
	POPJ	P,
;ROUTINES FOR SPACING OPS ON TX01/DX10

IFN FTTU70,<

TX1.SR:	MOVEI	X,CHPRG(R)	;ADDRS OF CHL PROG
	SKIPG	TX.MOD(R)	;CHECK FOR 7TK
	PUSHJ	P,TX.7MD(R)	;YES - SET UP MODE SET STUFF
	MOVE	T1,[TX.FSR
		    TX.BSR](T4)	;SET CORRECT CMD
	PUSHJ	P,TX.CMD(R)	;...
	MOVSI	T1,(CH.STS!CH.FRC)
	MOVEM	T1,1(X)		;FORCE SENSE
	PUSHJ	P,TX.XFR(R)	;SET XS AND START CHL
	  JFCL			;IGNORE ERRORS
	POPJ	P,		;EXIT

;ROUTINE TO CHECK ON CHL ERRORS
;RETURNS C(T3) := CSR/DSR

TX.CHK:	MOVE	T3,ICPC+1	;GET ST1
	CONI	PDC,T2		;GET CONI STATUS
	TRNN	T2,TX.UPE!TX.MPE!TX.NXM
	TLNE	T3,(CS.SLE!CS.SQE)
TX.LOS:	ERROR	(FDE,<FATAL DX10 ERROR OR DRIVE OFF-LINE>)
	LDB	T1,[POINT 2,ICPC+1,10](R)
	CAIE	T1,CS.STE	;GRNTEE ENDING STATUS
	ERROR	(NES,<NOT ENDING STATUS>)
	TRNE	T3,CS.NFG!CS.INC
	JRST	TX.LOS(R)	;SOMETHING WORSE COULDN'T HAPPEN
	POPJ	P,		;RETURN
>
;ROUTINE FOR SPACING OP ON TC10
IFN FTTC10,<

TCX.SR:	SETZM	CCW		;CLEAR INAD AREA
	SETZM	CCW+1
	PUSHJ	P,TCSEL(R)	;SELECT A UNIT
	MOVE	T1,UNIT(R)	;UNIT #
	LSH	T1,^D35-TC.UNP	;CORRECT POSITION
	IORI	T1,TC.CDM!TC.GO!TC.LCR
	IOR	T1,[TC.FSR
		    TC.BSR](T4)	;GET FCN DESIRED
	CONO	TCX,(T1)	;START DRIVE
	PUSHJ	P,TWAIT(R)	;WAIT TILL DONE
	  CONSO	TCX,TC.JBD
	CONI	TCX,T1		;GET STATS
	TLNE	T1,TC.EOF	;CHECK EOF
	SETOM	EOF(R)		;SET FLAG IF SO
	POPJ	P,		;AND RETURN

>

IFN FTTM02,<
TM2.SR:	PUSHJ	P,T2.STC(R)	;SET TO TALK TO RIGHT DRIVE
	MOVE	T2,[T2.DFC!T2.DLR,,177777](R)
	XCT	TM2DTO(R)	;SET FRAME-COUNT = 1
	MOVE	T2,[T2.DLR,,T2.SFF ;GET RIGHT FUNCTION
		   T2.DLR,,T2.SBF](T4)
	XCT	TM2DTO(R)	;START THE OPERATION
	PUSHJ	P,TM2.C1(R)	;WAIT FOR DRIVE-READY
	PUSHJ	P,TM2.RB(R)	;CHECK FOR ERRS
	  JFCL
	POPJ	P,		;AND RETURN
>
SUBTTL REWIND ROUTINES

REWND:	PUSHJ	P,CKREW(R)	;GRNTEE NO REW
	HRRZ	T2,F		;GET CTL TYPE
	ADDI	T2,RW(R)	;DISPATCH TBL
	TLO	F,REWF		;WE ARE REWINDING
	JRST	@(T2)		;GO EXECUTE

;REWIND TABLE

RW:	TMA.RW(R)		;TM10A
	TMB.RW(R)		;TM10B
	TCX.RW(R)		;TC10C
	TX1.RW(R)		;TX01
	TM2.RW(R)		;TM02

;ROUTINE TO CHECK ON REWINDING DRIVE

CKREW:	TLZN	F,REWF		;ARE WE?
	POPJ	P,		;NO - JUST RETURN
	HRRZ	T2,F		;GET TYPE
	ADDI	T2,CK(R)	;RELOCATE TABLE
	JRST	@(T2)		;RETURN WHEN NOT REWINDING

;CHECK REWIND DONE DISPATCH

CK:	TMA.CK(R)		;TM10A
	TMB.CK(R)		;TM10B
	TCX.CK(R)		;TC10C
	TX1.CK(R)		;TX01
	TM2.CK(R)		;TM02

;TM10A/B ROUTINES

TMA.RW:
TMB.RW:	PUSHJ	P,TMSEL(R)	;SELECT UNIT
	MOVE	T1,UNIT(R)	;UNIT #
	LSH	T1,^D35-TM.UNP	;POSITION
	IORI	T1,TM.REW	;REWIND COMMAND
	CONO	TMC,(T1)	;START
	PUSHJ	P,TWAIT(R)	;WAIT FOR JOB DONE
	  CONSO	TMS,TM.JBD
	POPJ	P,		;RETURN

TMA.CK:
TMB.CK:	PUSHJ	P,TMSEL(R)	;SELECT UNIT
	CONSZ	TMS,TM.RWS	;WAIT FOR STATUS TO DROP
	JRST	.-1(R)
	POPJ	P,
;TX01/DX10 ROUTINES

IFN FTTU70,<

TX1.CK:	CONSO	PDC,TX.STA	;WAIT FOR STATUS AVAIL
	JRST	.-1(R)
	LDB	T1,[POINT 2,ICPC+1,10](R)
	CAIE	T1,CS.STC	;CHECK CU STATUS
	ERROR	(NCS,<NOT CU STATUS>)
CLRSTA:	CONO	PDC,TX.ILI!TX.STA ;CLEAR STATUS AVAIL
	POPJ	P,		;RETURN

;REWIND ROUTINE

TX1.RW:	MOVEI	X,CHPRG(R)	;ADDRS OF CHL PROG
	MOVEI	T1,TX.REW	;REWIND CMD
	PUSHJ	P,TX.CMD(R)	;BUILD IT
	MOVSI	T1,(CH.STS)	;CHL TERMINATION WORD
	MOVEM	T1,1(X)		;STASH IN PRG
	SETZM	ICPC+3		;NO SENSE BYTES
	PUSHJ	P,TX.GO(R)	;START CHL
	PUSHJ	P,TWAIT(R)	;NOW WAIT TILL STARTED
	  CONSO	PDC,TX.STA
	PUSHJ	P,TX.CHK(R)	;CHECK CORRECT STATUS
	JRST	CLRSTA(R)	;AND CLEAR STATUS AVAIL.
>
;TC10 ROUTINES
IFN FTTC10,<

TCX.CK:	PUSHJ	P,TCSEL(R)	;SELECT UNIT
	CONI	TCX,T1		;READ STATUS
	TLNE	T1,TC.RWS	;REWINDING?
	JRST	.-2(R)		;YES - KEEP LOOKING
	PUSHJ	P,TWAIT(R)	;WAIT FOR READY STATUS
	  PUSHJ	P,[CONI TCX,T2
		   TLNE T2,TC.RDY
		   AOS (P)
		   POPJ P,](R)
	POPJ	P,		;EXIT

;REWIND ROUTINE

TCX.RW:	PUSHJ	P,TCSEL(R)	;SELECT UNIT
	MOVE	T1,UNIT(R)	;UNI #
	LSH	T1,^D35-TC.UNP	;POSITION
	IORI	T1,TC.REW!TC.GO!TC.LCR
	CONO	TCX,(T1)	;START OPERATION
	PUSHJ	P,TWAIT(R)	;WAIT FOR JOB DONE
	  CONSO	TCX,TC.JBD
	POPJ	P,		;EXIT
>
IFN FTTM02,<
TM2.RW:	PUSHJ	P,T2.STC(R)	;TALK TO RIGHT DRIVE
	MOVE	T2,[T2.DLR,,T2.RWF](R) ;FUNCTIN=REWIND
	XCT	TM2DTO(R)	;DO IT
	PUSHJ	P,TWAIT(R)	;WAIT TILL STARTED
	  PUSHJ	P,T2.RWC(R)
	POPJ	P,		;AND RETURN

TM2.CK:	PUSHJ	P,T2.STC(R)	;TALK TO RIGHT DRIVE
TM2.C1:	PUSHJ	P,TWAIT(R)	;WAIT
	  PUSHJ	P,T2.RDC(R)	; TILL DRIVE READY IS UP
	POPJ	P,		;AND RETURN

;ROUTINES TO WAIT
T2.RWC:	MOVEI	T4,T2.SPP!T2.SBT ;WAIT FOR BOT OR POSITION IN PROGRESS
	CAIA
T2.RDC:	MOVEI	T4,T2.SRY	;WAIT FOR DRIVE READY
	MOVSI	T2,T2.DSR	;READ STATUS REG
	PUSHJ	P,TM2DTO(R)
	TRNE	T2,(T4)		;RIGHT BIT UP?
	AOS	(P)		;YES, SKIP
	POPJ	P,		;AND RETURN
>
SUBTTL DUMMY ROUTINES TO SATISFY FT SWITCHES

IFE FTTU70,<
TX1.RW:
TX1.RD:
TX1.CK:
TX1.RS:
TX1.SR:	ERROR	(NT7,<NO TU70 CODE - FTTU70 OFF>)
>
IFE FTTC10,<
TCX.RW:
TCX.RD:
TCX.CK:
TCS.CK:
TCX.RS:
TCX.SR:	ERROR	(NTC,<NO TC10 CODE - FTTC10 OFF>)
>
IFE FTTM02,<
TM2.RW:
TM2.RD:
TM2.CK:
TM2.RS:
TM2.SR:	ERROR	(NT2,<NO TM02 CODE - FTTM02 OFF>)
>
SUBTTL UTILITIES

UERROR:	MOVEI	T1,ETXT(R)	;?<BELL>BTM
	PUSHJ	P,OUTTXT(R)	;PRINT MSG
	HRLZ	T1,@(P)		;GET 3 CHAR MSG
	PUSHJ	P,SIXOUT(R)	;PRINT IT
	MOVEI	T1,[ASCIZ " - "](R)
	PUSHJ	P,OUTTXT(R)	;MORE TO COME
	AOS	(P)		;ADVANCE TO NEXT ARG
	HRRZ	T1,@(P)		;PNTR TO TEXT STRING
	ADDI	T1,(R)		;ADD IN RELOC
	PUSHJ	P,OUTTXT(R)	;PRINT IT
	JRST	REGO(R)		;RESTART BOOTM

;ROUTINE TO OUTPUT 1 CHARACTER

OCHR:	SKIPE	KLFLG(R)	;USE THIS CODE IF NOT KL
	JRST	NKL3(R)		;ITS A KL
	DATAO	TTY,T1		;DUMP CHAR
	CONSZ	TTY,20		;WAIT FOR IDLE
	JRST	.-1(R)		;...
	POPJ	P,		;RETURN

NKL3:	SETZM	DTEMTD		;CLEAR DONE FLAG
	MOVEI	T1,.DTMTO(T1)	;GET CHAR IN LOW ORDER 8 BITS, COMMAND IN NEXT 4
	MOVEM	T1,DTECMD	;PUT IN CMD LOC
	CONO	DTE,TO11DB	;RING DOORBELL
	SKIPN	DTEMTD		;WAIT TILL DONE
	JRST	.-1(R)
	POPJ	P,		;RETURN
;ROUTINE TO PRINT MSG POINTED TO BY T1

OUTTXT:	HRLI	T1,(<POINT 7,,>) ;FORM BP
	PUSH	P,T1		;SAVE ON STACK
OUTXT1:	ILDB	T1,0(P)		;GET CHAR
	JUMPE	T1,OUTXT2(R)	;EXIT ON NULL
	PUSHJ	P,OCHR(R)	;PRINT
	JRST	OUTXT1(R)	;LOOP
OUTXT2:	POP	P,0(P)		;PRUNE PDL
	POPJ	P,		;AND EXIT

;ROUTINE TO FETCH A CHAR FROM CTY

TYI:	SKIPN	KLFLG(R)	;TEST IF KL
	JRST	NKL4(R)		;IT IS NOT
	SKIPN	DTEMTI		;INPUT READY
	JRST	.-1(R)		;NO - WIAT
	MOVE	T1,DTEF11	;GET CHARACTER
	SETZM	DTEMTI		;AND CLEAR FLAG
	JRST	TYIX(R)		;EXIT

NKL4:	CONSO	TTY,40		;WAIT FOR KEY TO BE STRUCK
	JRST	.-1(R)		;...
	DATAI	TTY,T1		;GET THE CHAR
TYIX:	ANDI	T1,177		;7-BITS ONLY
	POPJ	P,		;RETURN
;ROUTINE TO READ A LINE INTO LINBUF (DO LOCAL EDITING)

REDLIN:	MOVE	Q,[POINT 7,LINBUF(R)](R)
	MOVEM	Q,P.TXT(R)	;INIT LINE PNTR
	SETZM	LINBUF(R)	;SET TO CLEAR BUFFER
	MOVEI	T1,LINBUF(R)
	HRLS	T1		;INTO LH
	ADDI	T1,1		;LINBUF,,LINBUF+1
	BLT	T1,LINBUF+17(R)	;ZAPPP
	TLZ	F,RUBF		;CLR RUBOUT FLAG
	MOVEI	N,20*5		;MAX CHARS
REDCHR:	PUSHJ	P,TYI(R)	;SNARF A CHAR
	CAIN	T1,177		;CHECK RUBOUTS
	JRST	REDRUB(R)	;GO PROCESS
	CAIN	T1,"U"-100	;CHECK ^U
	JRST	REDCU(R)	;PROCESS ^U
	CAIE	T1,175		;CONVERT ESC , ALTMODES ETC
	CAIN	T1,176		;...
	MOVEI	T1,15		;INTO CR
	CAIE	T1,12		;LF
	CAIN	T1,33		;ESC
	MOVEI	T1,15		;INTO CR ALSO
	IDPB	T1,Q		;STASH CHAR
	TLZE	F,RUBF		;POST PROCESS RO
	PUSHJ	P,PRUB(R)
	LDB	T1,Q		;GET CHAR BACK
	PUSHJ	P,TYO(R)	;AND ECHO IT
	CAIN	T1,15		;TERMINATION
	POPJ	P,		;YES , EXIT
	SOJG	N,REDCHR(R)	;LOOP TILL DONE
	ERROR	(LTL,<LINE TOO LONG>)

;HERE TO PROCESS A CTRL-U

REDCU:	MOVEI	T1,"^"		;PRINT UPARROW
	PUSHJ	P,OCHR(R)	;...
	MOVEI	T1,"U"
	PUSHJ	P,OCHR(R)
	JRST	NOCHR1(R)	;CONTINUE PROCESSING
;ROUTINE TO PROCESS RUBOUTS

REDRUB:	CAIN	N,20*5		;CHECK FRONT OF LINE
	JRST	NOCHR(R)	;YES - SPECIAL HACK
	TLON	F,RUBF		;CHECK HERE BEFORE?
	PUSHJ	P,PRUB(R)	;NO -PRINT BSLSH
	LDB	T1,Q		;GET CHAR
	PUSHJ	P,TYO(R)	;PRINT IT
	ADD	Q,[POINT 0,0,28](R) ;BACK UP BYTE PNTR
	TLNE	Q,(<1B0>)
	SUB	Q,[POINT 0,1,0](R)
	AOJA	N,REDCHR(R)	;GET NEXT CHAR

;REACHED BEGINNING OF LINE

NOCHR:	TLZE	F,RUBF
	PUSHJ	P,PRUB(R)	;PRINT \ IF NECESSARY
NOCHR1:	PUSHJ	P,PROMPT(R)	;RE-PRINT PROMPT
	JRST	REDLIN(R)	;LOOP FOR NEXT LINE

;OUTPUT ROUTINE TO DO ECHOING AND SPECIAL CHAR HANDLING

TYO:	CAIE	T1,11		;CHECK SPECIAL
	CAIL	T1,40
	JRST	OCHR(R)		;JUST PRINT
	PUSH	P,T1		;SAVE CHAR
	CAIN	T1,15		;CHECK FOR CR
	JRST	TYOL(R)		;DO CRLF
	MOVEI	T1,"^"		;PRINT CTRL CHAR
	PUSHJ	P,OCHR(R)	;...
	MOVE	T1,0(P)		;PRINT CHAR
	ADDI	T1,100		;AS ^CHAR
TYO1:	PUSHJ	P,OCHR(R)	;DUMP CHAR
	POP	P,T1		;RESTORE CHAR
	POPJ	P,		;AND EXIT

;HANDLE PRINTING OF CRLF

TYOL:	PUSHJ	P,OCHR(R)		;OUTPUT CR
	MOVEI	T1,12		;AND LF
	JRST	TYO1(R)

;HANDLE BACK SLASH PRINTING

PRUB:	MOVEI	T1,"\"
	JRST	OCHR(R)		;DUMP IT

;PROMPT MESSAGE PRINTER

PROMPT:	MOVEI	T1,PTXT(R)
	JRST	OUTTXT(R)	;PRINT TEXT STRING
;ROUTINE TO GOBBLE NEXT ATOM
;RETURNS C(W) - SIXBIT ATOM
;	C(N) - OCTAL CONSTANT
;	C(T) - BREAK CHARACTER
;	C(D) - DECIMAL CONSTANT

REDSIX:	MOVE	Q,[POINT 6,W](R) ;PNTR TO SIXBIT ATOM
	SETZB	N,W		;CLEAR THINGS
	MOVEI	D,0		;...
REDSXL:	ILDB	T1,P.TXT(R)	;GET CHAR FROM BUFFER
	CAILE	T1,140		;CHECK FOR L.C.
	TRZ	T1,40		;CONVERT TO U.C.
	CAIG	T1,"Z"		;CHECK FOR LETTER
	CAIGE	T1,"A"		;...
	  SKIPA			;NOT A LETTER
	JRST	REDLTR(R)	;LETTER - PUT IN ATOM
	CAIG	T1,"9"		;CHECK FOR DIGIT
	CAIGE	T1,"0"		;...
	POPJ	P,		;NOPE - RETURN BREAK CHAR IN T1
	LSH	N,3		;ELSE ACCUM OCTAL
	ADDI	N,-60(T1)	;CONVERT TO DIGIT ETC.
	IMULI	D,^D10		;MULTIPLY
	ADDI	D,-60(T1)	;AND ADD IT IN
REDLTR:	TRC	T1,40		;MAKE SIXBITCH
	TLNE	Q,770000	;SIX YET?
	IDPB	T1,Q		;NO - STORE CHAR
	JRST	REDSXL(R)	;AND GET NEXT CHAR
;ROUTINE TO PRINT SIXBIT ATOMS IN T1

SIXOUT:	MOVE	T2,T1		;GET COPY OF ATOM
SIXOU1:	MOVEI	T1,0
	LSHC	T1,6		;GET NEXT CHAR
	ADDI	T1,40		;MAKE INTO ASCII
	PUSHJ	P,OCHR(R)	;PRINT IT
	JUMPN	T2,SIXOU1(R)	;DONE?
	POPJ	P,		;NO - CONTINUE

;ROUTINE TO PRINT CRLF

PCRLF:	MOVEI	T1,15		;SET UP CR
	JRST	TYO(R)		;WILL HANDLE THIS JUST FINE
SUBTTL DATA REGION

ONCEFF:	-1			;ONCE ONLY FLAG
KLFLG:	0			;-1 IF KL PROCESSOR
KIFLG:	0			;-1 IF KI PROCESSOR

ITXT:	TMACR (\VBOOTM,\EBOOTM,<ASCIZ "BOOTM V>,<">)

ETXT:	BYTE (7) "?",7(21)"BTM"(7)0

PTXT:	ASCIZ	"
BTM>"

CLRB:				;BEGINNING OF AREA TO CLEAR
DBUF:	BLOCK	LNMTBF		;BUFFER SIZE

PAGCNT:	EXP	0		;PAGE COUNT FOR EXE FILES
EOF:	EXP	0		;EOF FLAG
; THE FOLLOWING 4 WORDS MUST REMAIN IN THS ORDER
DEVICE:	EXP	0		;STR NAME
FNAME:	EXP	0		;FILE NAME
FILEXT:	EXP	0		;EXTENSION WE'RE CURRENTLY LOOKING FOR
PPN:	EXP	0		;PPN
FEXT:	EXP	0		;EXTENSION USER TYPED
UNIT::	EXP	0		;UNIT NUMBER ON CTL
TDEN:	EXP	0		;DENSITY VALUE
PROGSA:	EXP	0		;START ADDRS OF PROGRAM
P.TXT:	EXP	0		;TEXT POINTER
LINBUF:	BLOCK	20		;LINE BUFFER
IFN FTEXE,<
DIRB:	BLOCK	200		;DIRECTORY FOR EXE FILES
>

IFN FTTU70,<
;TX01/DX10 VARIABLES

CHPRG:	BLOCK	4		;PLACE FOR CHL PROGRAM
CHSNS:	BLOCK	12		;PLACE FOR EXTENDED STATUS
TX.MOD:	BLOCK	1		;MODE WORD
>
CLRE==.-1			;LAST LOC TO CLEAR

PDL:	BLOCK	LNPDL		;PUSH-DOWN LIST

BTMLIT:	LIT
IFN FTRH20,<
CROOM==<.-BOOTM>&777	;AMOUNT OF SPACE OVER PAGE-BOUNDARY
ROOM==1200-CROOM	;SPACE TO GET TO START OF MAP

	BLOCK	ROOM	 ;STEP TO NEXT PAGE
	DEFINE PT(X),<
	XWD	PM.ACC+PM.WRT+X,PM.ACC+PM.WRT+X+1
>
ZZ==400			;SET UP 1-FOR-1 MAP FOR ALL OF CORE
PAGTAB:
REPEAT 200,<
	PT(ZZ)
	XLIST
	ZZ==ZZ+2
>
	LIST
ZZ==340
REPEAT 20,<	;PER-PROCESS PART OF MAP (UBR)
	XLIST
	PT(ZZ)
	ZZ==ZZ+2
>
	LIST
	BLOCK	160		;STEP TO WORD 600
ZZ==0
REPEAT 160,<	;PAGES 0-337
	XLIST
	PT(ZZ)
	ZZ==ZZ+2
>
	LIST
>
IFN MAGRIM,<JRST BOOTM		;XFER WORD>
EBTM::
IFN <PTPSW!DEBUG>,<END	BOOTM>
IFE <PTPSW!DEBUG>,<
	IF2,<RELOC EBTM>
	END	BOOTM
>