Google
 

Trailing-Edge - PDP-10 Archives - bb-d549g-sb - boots.mac
There are 8 other files named boots.mac in the archive. Click here to see a list.
TITLE BOOTS - V023 - LEVEL D DISK BOOTSTRAP (LOCATION INDEPENDENT)
SUBTTL R. CLEMENTS /TH/JE/DAL/TW/JMF/DBD 11 JUL 79




;COPYRIGHT (C) 1977,1978,1979 BY
;DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
;
;
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY  IN  ACCORDANCE  WITH  THE  TERMS  OF  SUCH LICENSE AND WITH THE
;INCLUSION OF THE ABOVE COPYRIGHT NOTICE.  THIS SOFTWARE OR ANY  OTHER
;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
;OTHER PERSON.  NO TITLE TO AND OWNERSHIP OF THE  SOFTWARE  IS  HEREBY
;TRANSFERRED.
;
;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT  NOTICE
;AND  SHOULD  NOT  BE  CONSTRUED  AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.
;
;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY  OF  ITS
;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.

VBOOTS==23		;BOOTS VERSION NUMBER
EBOOTS==114		;EDIT NUMBER


;"THESE BOOTS WERE MADE FOR WALKIN'." - L.H.


;AC'S

F=0	;FLAGS
	;BITS 29-35=CONTROLER DEVICE CODES
A=1	;GENERAL AC'S
B=2	; ..
C=3	; ..
X=4	;MEMORY ADDRESS COUNTER
W=5	;WORD RETURNED BY RWORD OR SIXBRD
NAME=6	;NAME OF FILE OR UFD BEING SEARCHED FOR
EXT=7	;EXTENSION OF FILE OR UFD BEING SEARCHED FOR
Q=10	;COUNTER TO STEP THROUGH BUFFER OF 200 DATA WORDS
S=11	;COUNTER TO STEP THROUGH BUFFER OF 200 RIB WORDS
N=12	;NUMBER ASSEMBLER IN TYPEIN
M=13	;MEMORY AOBJN POINTER FOR READING THE DATA TO CORE
K=14	;INDEX OF KONTROLLER TYPE
R=15	;CONTAINS RELOCATION OF BOOTS TO MAKE IT LOCATION INDEPENDENT
	;R+1 MUST BE 17 OR LESS - SINCE JSR R USED TO SET R
LBN=16	;LOGICAL BLOCK NUMBER TO READ
P=17	;STACK POINTER
;DEFAULT ASSEMBLY PARAMETERS

;DEFAULT ASSEMBLY FOR PAPER TAPE BOOTS WILL PRODUCE A PAPER TAPE
; BOOTS WHICH WILL READ EITHER SAV OR EXE FILES FROM FIXED HEAD DISKS,
; RP02/RP03S, OR RP04S ON KI10 PROCESSORS

IF1,<			;PASS 1?
IFDEF FTKS10,<
IFN FTKS10,<
FTKI10==0
FTKL10==0
FTDPC==0
FTFHD==0
FTDHX==0
FTRH20==0
FTRH11==1
>;END IFN FTKS10
IFNDEF FTRH11,<FTRH11==0>
>;END IFDEF FTKS10
IFDEF FTKL10,<IFN FTKL10,<
FTKI10==0
>
IFNDEF FTRH20,<FTRH20==0>
>
IFNDEF FTKL10,<
FTKI10==1
FTKL10==0
FTRH20==0
>
IFNDEF FTKS10,<
FTKS10==0
FTRH11==0
>
WTBOOT==0		;ASSUME ABSOLUTE PAPER TAPE VERSION
FTRH2W==FTRH20		;SET FTRH2W NON-0 IF RH20 AND NOT LOC-DEPENDENT
IFNDEF CORE,<		;IS CORE UNDEFINED?
	WTBOOT==1	;YES, ASSUME LOCATION INDEPENDENT VERSION IS WANTED
>
IFE WTBOOT,<
FTRH2W==0
FT22BIT==0
IFE FTKS10,<
FTDPC==1
FTFHD==1
FTDHX==1
>;END IFE FTKS10
FTSAVE==1
FTEXE==1
FTWTBOOT==0
>;END IFE WTBOOT
>;END IF1

;DEFAULT ASSEMBLY FOR WTBOOT WILL PRODUCE A BOOTS WHICH WILL READ AND
; WRITE EXE FILES FROM OR TO RP02/RP03S

IFN WTBOOT,<
IFNDEF FT22BIT,<FT22BIT==0>
IFNDEF FTDPC,<FTDPC==1>
IFNDEF FTFHD,<FTFHD==0>
IFNDEF FTDHX,<FTDHX==0>
IFNDEF FTEXE,<FTEXE==1>
IFNDEF FTSAVE,<FTSAVE==0>
>;END IFN WTBOOT
;CORE ALLOCATION

IFNDEF FTWTBOOT,<FTWTBOOT==1>
IFN WTBOOT,<		;LOCATION INDEPENDENT?
	INTERN	MBOOTL
IFE FTWTBOOT,<
IFN FTDPC,<BTDPSA==:BOOTSA>
IFN FTDHX,<
IFE FTRH20,<BTDHSA==:BOOTSA>
IFN FTRH20,<BTD2SA==:BOOTSA>
>
>
IFN FTWTBOOT,<
IFE FTRH20,<INTERN BOOTSA>
IFN FTRH20,<INTERN BOOTS2>
IFN FTKS10,<BTRHSA==:BOOTSA>
>
	CORE=.+2000	;LAST LOC PLUS 1 FOR BOOTS
>
XSIZE==0
IFE WTBOOT,<
	XSIZE==1000
IFN FTRH20,<
	XSIZE==3000	;RESERVE PAGE FOR 1-FOR-1 MAP, PAGE TO MAP PAGE 0
>
>
ZZ=CORE-2000-XSIZE+140		;SET ABOVE JOB DATA AREA OF TOP K
BOOTDT==ZZ			;FIRST DATA LOC IN BOOTS

CLRTOP==ZZ-1			;WHEN CLEARING CORE, CLEAR TO HERE

DEFINE U(Z)<	UU(Z,1)>	;ONE WORD ALLOCATION
DEFINE UU(Z,N)<	Z==ZZ
ZZ==ZZ+N
>

DEFINE ERROR.(Z)<
	SALL
	JSR Z,ERROR(R)
	LIST
>

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

IFE WTBOOT,<		;ABSOLUTE ASSEMBLY?
LOC CORE-1000-XSIZE		;ABSOLUTE ASSEMBLY
BASE==0

IFN FTKI10,<
				 ;SINCE KL ABSOLUTE BOOTS IS A SAV FILE
RIM10B				;PAPER TAPE FORMAT
>
>
IFN WTBOOT,<		;LOCATION INDEPENDENT ASSEMBLY?
BASE==.
BLOCK	1000	;SKIP OVER LOWER CORE STUFF
>

BOOTSP=21			;ABSOLUTE ADDRESS OF THE CODE PAGE
BOOTWD=22			;DF-10 LOCS IN LOWER CORE
				; (LEVEL C RP-10 DF-10 LOCS)
LOWCMD=BOOTWD			;USE LOC 22 AND 23 FOR THE DF10
BOOTWD==BOOTWD+IOWEVA
FIRSTW==20			;FIRST LOCATION CONSIDERED ON WRITE
;I/O DEVICE PARAMETERS

DPC=250				;DEVICE KONTROLLER NUMBER FOR RP10
DPC2=254			;SECOND RP10
O.SEEK==4			;DISK OP FOR SEEK FOR RP10
O.READ==400000			;XOR MASK - SEEK TO READ
O.WRIT==500000			;XOR MASK - SEEK TO WRITE;

FHD=170				;DEVICE NUMBER FOR RC10 KONTROLLER
FHD2=174			;SECOND RC10
FH.WRT==1000			;BIT IN DATAO FOR WRITE ON RC10

IFNDEF DHX,<DHX=270>		;FIRST RH10/RP04 DEVICE CODE
IFNDEF DHX2,<DHX2=274>		;SECOND RH10/RP04
DH.RED==71			;READ
DH.WRT==61			;WRITE

DEFINE	RH20,<
	XX=="2"
	YY==540
	A(,YY)
	YY==YY+4
	A(\"XX,YY)
	XX==XX+1
	YY==YY+4
IFE	WTBOOT,<
	REPEAT	6,<
		A(\"XX,YY)
	XX==XX+1
	YY==YY+4
	>
>>

	DEFINE	A(Z,ZZ)<
	IFNDEF	RH2'Z<RH2'Z==ZZ>>

	RH20
IFN FTKS10,<
OPDEF	APRID	[700000,,0]	;READ MICROCODE VERSION AND CPU SERIAL NU
OPDEF	WRAPR	[700200,,0]	;WRITE APR
OPDEF	RDAPR	[700240,,0]	;READ APR
OPDEF	WRPI	[700600,,0]	;WRITE PI
	OPDEF	PIOFF	[700600,,400]
	OPDEF	PION	[700600,,200]
OPDEF	RDPI	[700640,,0]	;READ PI
OPDEF	WRUBR	[701140,,0]	;WRITE USER BASE REGISTER
OPDEF	CLRPT	[701100,,0]	;CLEAR PAGE TABLE
OPDEF	RDUBR	[701040,,0]	;READ USER BASE REGISTER
OPDEF	WREBR	[701200,,0]	;WRITE
OPDEF	RDEBR	[701240,,0]	;READ
OPDEF	TIOE	[710000,,0]	;TEST UNIBUS, SKIP EQUAL
OPDEF	TIOEB	[720000,,0]	;TEST UNIBUS, SKIP EQUAL
OPDEF	TION	[711000,,0]	;TEST UNIBUS, SKIP NOT EQUAL
OPDEF	TIONB	[721000,,0]	;TEST UNIBUS, SKIP NOT EQUAL
OPDEF	RDIO	[712000,,0]	;READ UNIBUS
OPDEF	RDIOB	[722000,,0]	;READ UNIBUS BYTE
OPDEF	WRIO	[713000,,0]	;WRITE UNIBUS
OPDEF	WRIOB	[723000,,0]	;WRITE UNIBUS BYTE
OPDEF	BSIO	[714000,,0]	;BIT SET TO UNIBUS
OPDEF	BSIOB	[724000,,0]	;BIT SET TO UNIBUS BYTE
OPDEF	BCIO	[715000,,0]	;BIT CLEAR TO UNIBUS
OPDEF	BCIOB	[725000,,0]	;BIT CLEAR TO UNIBUS BYTE
OPDEF	WRSPB	[702400,,0]	;WRITE SPT BASE REGISTER
OPDEF	RDSPB	[702000,,0]	;READ SPT BASE REGISTER
OPDEF	WRCSB	[702440,,0]	;WRITE CORE STATUS TABLE BASE REGISTER
OPDEF	RDCSB	[702040,,0]	;READ CORE STATUS TABLE BASE REGISTER
OPDEF	WRPUR	[702500,,0]	;WRITE PROCESS USE REGISTER
OPDEF	RDPUR	[702100,,0]	;READ PROCESS USE REGISTER
OPDEF	WRCSTM	[702540,,0]	;WRITE CST MASK REGISTER
OPDEF	RDCSTM	[702140,,0]	;READ CST MASK REGISTER
OPDEF	WRTIME	[702600,,0]	;WRITE TIME BASE
OPDEF	RDTIME	[702200,,0]	;READ TIME BASE
OPDEF	WRINT	[702640,,0]	;WRITE INTERVAL TIMER
OPDEF	RDINT	[702240,,0]	;READ THE INTERVAL REGISTER
OPDEF	UMOVE	[704000,,0]	;MOVE FROM PREVIOUS CONTEXT
OPDEF	UMOVEM	[705000,,0]	;MOVE TO PREVIOUS CONTEXT
OPDEF	RDHSB	[702300,,0]	;READ HALT STATUS BLOCK
OPDEF	WRHSB	[702700,,0]	;WRITE HALT STATUS BLOCK
;UNIBUS ADAPTER
	UBAMAP=763000	;MAPPING REGISTERS
	UBA.SR=763100	;STATUS REGISTER
	UBA.IR=763200	;VECTOR REGISTER
	UBA.MR=763300	;MAINTENANCE REGISTER

;PHYSICAL CORE DEFINITIONS FOR KS10 CTY AND KLINIK SERVICE
; AND PHYSICAL CORE LOCATIONS FOR OTHER FRONT-END FUNCTIONS

RLWORD==:31			;RELOAD WORD
	KSRLD==1B4		;RELOAD REQUEST
	KPACT==1B5		;KEEP ALIVE ACTIVE
	KLACT==1B6		;KLINIK ACTIVE
	PAREN==1B7		;PARITY ERROR DETECT ENABLED
	CRMPAR==1B8	;CRAM PAR ERR DETECT ENABLED
	DRMPAR==1B9	;DRAM PAR ERR DETECT ENABLED
	CASHEN==1B10	;CACHE ENABLED
	MILSEN==1B11	;1MSEC ENABLED
	KPALIV==377B28	;KEEP ALIVE WORD
	AUTOBT==1B32	;BOOT SWITCH OR POWER UP CONDITION
	PWRFAL==1B33	;POWER FAIL
	FORREL==1B34	;FORCED RELOAD
	KEPFAL==1B35	;KEEP ALIVE FAILURE


CTYIWD==:32			;CTY INPUT WORD
	CTYICH==377B35	;CTY INPUT CHARACTER
	CTYIVL==1B27	;INPUT VALID BIT

CTYOWD=33			;CTY OUTPUT WORD
	CTYOCH==377B35	;CTY OUTPUT CHARACTER
	CTYOVL==1B27	;OUTPUT VALID FLAG

KLIIWD==:34			;KLINIK INPUT WORD
	KLIICH==377B35	;KLINIK INPUT CHARACTER
	KLIIVL==1B27	;KLINIK INPUT VALID
KLICHR==:1B27			;KLINIK CHARACTER
KLIINI==:2B27			;KLINIK INITED
KLICAR==:3B27			;CARRIER LOST


KLIOWD==:35			;KLINIK OUTPUT WORD
	KLIOCH==377B35	;KLINIK OUTPUT CHARACTER
	KLIOVL==1B27	;KLINIK OUTPUT VALID
KLOCHR==:1B27			;KLINIK CHARACTER AVAILABLE
KLIHUP==:2B27			;KLINIK HANGUP REQUEST
;RH11 REGISTER DEFINITIONS
	RPCS1==776700
	RPWC==776702
	RPBA==776704
	RPDA==776706
	RPCS2==776710
	RPDS==776712
	RPER1==776714
	RPAS==776716
	RPLA==776720
	RPDB==776722
	RPMR==776724
	RPDT==776726
	RPSN==776730
	RPOF==776732
	RPDC==776734
	RPCC==776736
	RPER2==776740
	RPER3==776742
	RPEC1==776744
	RPEC2==776746

>;IFN FTKS10
;FLAGS, LEFT HALF OF F

L.DOT==1			;DOT SEEN IN FILE SPEC
L.LBK==2			;LEFT BRACKET SEEN IN FILE SPEC
L.CMA=4				;COMMA SEEN IN FILE SPEC
L.SLA==10			;SLASH SEEN IN FILE SPEC
L.ALL==17			;ABOVE FLAGS TOGETHER.

;FLAGS, RIGHT HALF OF F

R.KDEV=177			;BITS 29-35=KONTROLLER DEVICE CODE
R.TYPE==200			;TYPE OF UNIT ON KONTROLLER
R.DSKW==400			;WILD DISK NAME. TRY ALL.
R.SRIB==1000			;NEED TO SKIP A BLOCK (RIB AT START)
R.STRT==2000			;ON IF LOAD AND GO. OFF IF JUST LOAD
;R.KA10==4000			;ON IF A KA10 PROCESSOR (HISTORICAL)
R.KI10==10000			;ON IF A KI10 PROCESSOR
R.KL10==20000			;ON IF A KL10 PROCESSOR
R.KS10==40000			;ON IF A KS10 PROCESSOR

;MISCELLANEOUS EQUATES

PM.ACC==400000			;ALLOW ACCESS TO A PAGE
PM.WRT==100000			;ALLOW A PAGE TO BE WRITTEN
PG.LEB==400000			;LOAD THE EXEC BASE REGISTER
PG.EAT==20000			;TURN ON THE PAGING HARDWARE (ENABLE TRAPS)
PAGSIZ==^D512			;NUMBER OF WORDS IN A PAGE
BLKSIZ==^D128			;NUMBER OF WORDS IN A BLOCK
P2BLSH==2			;SHIFT AMOUNT TO CONVERT PAGES TO BLOCKS
B2PLSH==-2			;SHIFT AMOUNT TO CONVERT BLOCKS TO PAGES
P2WLSH==^D9			;SHIFT AMOUNT TO CONVERT PAGES TO WORDS
W2PLSH==-^D9			;SHIFT AMOUNT TO CONVERT WORDS TO PAGES
.JBSA==120			;RIGHT HALF IS PROGRAMS STARTING ADDRESS
SV.DIR==1776			;DIRECTORY BLOCK CODE
SV.END==1777			;END DIRECTORY BLOCK CODE
;SYSTEM PARAMETERS WHICH MUST AGREE WITH COMMOD

HOMBK1==1			;ADDRESSES OF HOME BLOCKS
HOMBK2==12			; ..
CODHOM=707070			;VERIFICATION CODE OF HOME BLOCK
CODRIB=777777			;VERIF CODE OF A RIB BLOCK
BLKCOD==176			;WORD ADDRESS OF VERIF CODE
BLKSLF==177			;WORD ADDRESS OF SELF POINTER
RIBFIR==0			;WORD ADDRESS OF RIB AOBJN PTR
RIBNAM==2			;W A OF NAME OF FILE IN THE RIB
RIBEXT==3			;W A OF EXT OF FILE IN THE RIB
RIBSIZ==5			;LENGTH OF FILE IN WORDS

HOMSNM==4			;STRUCTURE NAME IN SIXBIT
HOMLUN==10			;LOGICAL UNIT NUMBER (OCT) IN STR
HOMBSC==14			;BLOCKS PER SUPERCLUSTER IN HOME BLOCK
HOMSCU==15			;SUPERCLUSTERS PER UNIT
HOMCNP==16			;POINTER TO CLUSTER COUNT IN A RET PTR
HOMCKP==17			;POINTER TO CHECKSUM IN A RET PTR
HOMCLP==20			;POINTER TO CLUSTER ADDRESS IN A RET PTR
HOMBPC==21			;BLOCKS PER CLUSTER
HOMREF==23			;NEED TO REFRESH IF NON-ZERO
HOMCRS==41			;LBN IN STR OF CRASH.SAV RIB
HOMMFD==46			;LBN IN STR OF MFD RIB
OPDEF PJRST [JRST]		;EQUIVALENT TO TWO INSTR. PUSHJ/POPJ
OPDEF PJSP [JSP]		;EQUIVALENT TO TWO INSTR. MOVEI/PJRST
;DTE20 PARAMETERS FOR KLDCP

DTEFLG=444+BOOTVA		;SET BY KLDCP WHEN COMMAND IS COMPLETE
DTEF11=450+BOOTVA		;FROM 11 ARGUMENT
DTECMD=451+BOOTVA		;COMMAND LOCATION
DTEMTD=455+BOOTVA		;MONITOR OUTPUT COMPLETE FLAG (SET BY 11)
DTEMTI=456+BOOTVA		;MONITOR INPUT READY FLAG(SET BY 11)

DTE==200			;DTE DEVICE CODE

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


;HARDWARE BITS FOR DTE20

TO11DB==1B22			;DOORBELL TO 11
CL11PT==1B26			;CLEAR DOORBELL FOR 10
PILDEN==1B31			;ENABLE LOAD PI


;DTE EPT LOCATIONS

IFE FT22BIT,<
DTEEPW=144			;EXAMINE PROTECTION WORD
>
;ERROR CODES

ERNCB%==1			;NO COMMA INSIDE []
ERISS%==2			;ILLEGAL SWITCH OR NO START ADDRESS SPECIFIED BEFORE /G
ERRDE%==3			;INPUT ERROR
ERERD%==4			;INPUT ERROR READING THE EXE DIRECTORY
ERNDL%==5			;FIRST PAGE OF THE FILE ISN'T AN EXE DIRECTORY
				; OR IS AN EXE DIRECTORY WHICH IS TOO LONG
ERPNM%==6			;PAGES DESCRIBED IN THE EXE DIRECTORY AREN'T
				; MONOTONICALLY INCREASING
ERPEF%==7			;PREMATURE END OF FILE
ERWTE%==10			;OUTPUT ERROR
ERFNF%==11			;FILE NOT FOUND
ERBRB%==12			;BAD RIB
ERPRE%==13			;PREMATURE END OF FILE READING THE UFD
ERIBZ%==14			;ATTEMPT TO READ/WRITE BLOCK 0
ERBLB%==15			;LOGICAL BLOCK NUMBER EXCEEDS SIZE OF THE DISK
EREFO%==16			;END OF FILE ON OUTPUT
;START HERE
BOOTSA:
BOOTS2:
GO:	CONO	APR,200000	;I/O BUS RESET(MONITOR CHECKS FIRST INSTR. TO
				;TO SEE IF IT IS CONO APR,200000
				; ON 407 RESTART OR DEPOSIT IN 30
IFN FTKL10,<IFE WTBOOT,<
	CONO	APR,200000	;KLI STARTS BOOTS AT START ADDRESS+1
				; MAKE SURE DL10 IS ZAPPED SO 11'S AREN'T
				; DOING US IN
>;END IFE WTBOOT
>;END IFN FTKL10
	CONO	PI,10400	;CLEAR PI SYSTEM
IFN FTKL10,<
IFE FT22BIT,<IFE WTBOOT,<
IFE FTRH20,<
	CONO	PAG,0		;NO CACHE, NO PAGING, EPT IS PAGE 0
>;END IFE FTRH20
IFN FTRH20,<
	MOVSI	A,700000	;SET UP UBR TO MAP PART OF EXEC SPACE
	HRRI	A,<CORE/1000>-2!1B18	; (PAGES 340-377)
	DATAO	PAG,A
	CONO	PAG,PG.EAT+<CORE/1000>-2 ;PAGE PAST TOP CODE PAGE IS EPT
>;END IFN FTRH20
>;END IFE WTBOOT
>;END IFE FT22BIT
	CONO	DTE,PILDEN!0	;NO PI'S FROM DTE
>;END IFN FTKL10
IFN FTKS10,<
	MOVEI	A,424		;TOPS-10 HALT STATUS BLOCK ADDRESS
	WRHSB	A		;SET IT AND ENABLE WRITING OF IT
>;END IFN FTKS10
	MOVSI	R+1,(JRST (R))	;RETURN INSTR. FOR JSR
	JSR	R		;SETUP RELOCATION OF BOOTS IN R
				; RETURN HERE
	SUBI	R,.-BOOTSA+1000+BOOTDT-140	;ADJUST R TO BASE OF BOOTS DATA AREA
IFE FT22BIT,<IFN WTBOOT,<
	MAP	A,BOOTSA(R)	;PHYSICAL ADDRESS OR PAGE NUMBER
IFN FTKI10,<
	LSH	A,P2WLSH	;PAGE NUMBER PART OF THE ADDRESS
>;END IFN FTKI10
	MOVE	R,A		;RESULTS TO R
	TLNE	R,17		;ABOVE 256K?
	HALT	10		;YES, CANNOT HANDLE THAT WITH FT22BIT OFF
	SUBI	R,1000+BOOTDT-140	;RELOCATION AFTER PAGING IS TURNED OFF
IFN FTKI10,<
	MOVEI	0,PG.LEB	;LOAD THE EXEC BASE REGISTER (PAGING OFF)
	MOVSI	A,(DATAO PAG,)	;SET TO ZAP PAGING
>;END IFN FTKI10
IFN FTKL10!FTKS10,<
	MOVSI	A,(CONO PAG,)	;ZAP PAGING KL10 STYLE
>;END IFN FTKL10!FTKS10
	MOVSI	B,(JRST (R))	;TO GET BACK
	HRRI	B,BOOTGO	; TO BOOTGO
	JRST	A		;ZAP PAGING
BOOTGO:
>;END IFN WTBOOT
>;END IFE FT22BIT
IFN FT22BIT,<
	MAP	K,BOOTSA(R)	;PHYSICAL PAGE NUMBER OF CODE PAGE
IFN FTKL10!FTKS10,<
	LSH	K,W2PLSH	;ON THE KL10, MAP GETS THE PHYSICAL ADDRESS
				; SO CONVERT TO PHYSICAL PAGE
	MOVEI	N,PM.ACC+PM.WRT+0	;MAKE IOWD SPACE ADDRESSABLE
				; DO IT IN THE ACS SO CONO PAG, CLEARS PAGING MEMORY
	HRRZ	A,BPPRS(R)	;CCL BYTE POINTER ADDRESS
	LSHC	A,W2PLSH	;PAGE NUMBER + WORD NUMBER IN B
	MOVEI	A,PM.ACC+PM.WRT(A)	;ACCESS ALLOWED + WRITABLE
	HRLI	A,1(N)		;MAPPING FOR PAGE 1 AND THE CCL BYTE POINTER
	LSH	B,W2PLSH	;RIGHT JUSTIFY THE BYTE POINTER WORD ADDRESS
	TLO	B,BPPEVA	;BOOTS VIRTUAL ADDRESS OF CCL BYTE POINTER
	HLRM	B,BPPRS(R)	;STORE EVA IN BYTE POINTER

>;END IFN FTKL10!FTKS10
	ANDI	K,17777		;CLEAR ANY RANDOM BITS
	MOVEI	B,PM.ACC+PM.WRT-1(K)
	HRLI	B,1(B)		;PAGE MAP WORD TO MAP CODE PAGE,,DATA PAGE
IFN FTKI10,<
	TRO	K,PG.LEB+PG.EAT	;LOAD THE EXEC BASE REGISTER AND TURN ON PAGING
>;END IFN FTKI10
	MOVE	C,BOOTSA+200(R)	;SAVE A TEMPORARY WHILE MAKING DATA PAGE ADDRESSABLE
	MOVSM	B,BOOTSA+200(R)	;SETUP AN EXEC MAP IN THE CODE PAGE
	MOVSI	MAPACL+4-1,MAPACS(R)	;MAKE THE CODE PAGE THE EXEC MAP,
	HRRI	MAPACL+4-1,4	; THIS MUST BE DONE IN THE ACS, SINCE
	BLT	MAPACL+4-1,MAPACL+4-1	; NOTHING ELSE IS ADDRESSABLE WHILE IT
				; IS HAPPENING
	MOVNI	R,BOOTDT-BOOTVA-140	;NEW RELOCATION RELATIVE TO THE
				; MAP BEING SETUP
	JRST	4		;ZAP, WE'RE ADDRESSABLE
MAPPED:
IFN FTKI10,<
	MOVEM	K,BTEBR(R)	;BOOTS' EXEC BASE REGISTER
	TRZ	K,PG.LEB+PG.EAT	;GET CODE PAGE NUMBER
>;END IFN FTKI10
	MOVEM	K,HIPAGE(R)	;SAVE THAT AS THE HIGHEST PAGE TO SAVE OR DUMP
	LSH	K,P2WLSH	;CONVERT TO PHYSICAL ADDRESS OF DATA PAGE
	MOVEM	K,IOWEVA+BOOTSP	;STORE ABSOLUTE ADDRESS OF THE DATA PAGE
	MOVEM	C,BOOTSA+200(R)	;RESTORE LOCATION USED IN THE CODE SEGMENT
>;END IFN FT22BIT
IFN FTKS10,<
	SETZM	IOWEVA+CTYIWD	;CLEAR OUT ANY TYPE-AHEAD
	SETZM	IOWEVA+CTYOWD	;CLEAR OUT ANY OLD TYPE OUT
	SETZM	IOWEVA+KLIOWD	;CLEAR OUT ANY OLD KLINIK STUFF
IFN WTBOOT,<
	SETZM	IOWEVA+RLWORD	;CLEAR OUT RELOAD WORD
>;END IFN WTBOOT
>;END IFN FTKS10
IFE WTBOOT,<
	MOVEI	P,PDL-1(R)	;NEED A STACK POINTER TO INIT DTE AND TYPE VERSION
IFN FTKL10,<
IFE FT22BIT,<
	SETZM	DTEEPW		;TELL FRONT END THAT THIS IS SECONDARY PROTOCOL
>;END IFE FT22BIT
IFN FT22BIT,<
	SETZM	DTEEPW(R)	;EPT ISN'T PAGE 0 IF PAGING IS ON
>;END IFN FT22BIT
	SETZM	DTEMTI		;CLEAR INPUT READY FLAG
	MOVEI	A,DTEFLG
	MOVEI	C,.DTMMC	;TURN MONITOR MODE CONTROL ON
	PUSHJ	P,DODTE(R)
>;END IFN FTKL10
	MOVEI	B,VTXT(R)	;REPORT VERSION NUMBER
	PUSHJ	P,PASCIZ(R)	;PRINT IT
>;END IFE WTBOOT
REGO:	MOVEI	P,PDL-1(R)	;INITIAL STACK POINTER
	SETZB	F,BOOTDT(R)	;CLEAR FLAGS AND FILESPEC
	MOVSI	A,BOOTDT(R)	; ..
	HRRI	A,BOOTDT+1(R)	; ..
	BLT	A,DFBIT(R)	; ..
IFE FT22BIT,<IFN FTEXE,<
	MOVEI	K,BOOTSA-PAGSIZ(R)	;WHERE BOOTS STARTS
	MOVEM	K,BOOTSP	;STORE ABSOLUTE ADDRESS OF DATA PAGE
	LSH	K,W2PLSH	;CONVERT TO PAGE NUMBER
	MOVEM	K,HIPAGE(R)	;STORE THAT AS THE HIGHEST PAGE TO LOAD OR DUMP
>>;END IFE FT22BIT,IFN FTEXE
IFN WTBOOT,<
IFN FTKL10,<
IFE FT22BIT,<
	SETZM	DTEEPW		;TELL FRONT END THAT THIS IS SECONDARY PROTOCOL
>;END IFE FT22BIT
IFN FT22BIT,<
	SETZM	DTEEPW(R)	;EPT ISN'T PAGE 0 IF PAGING IS ON
>;END IFN FT22BIT
	SETZM	DTEMTI		;CLEAR INPUT READY FLAG
	MOVEI	A,DTEFLG
	MOVEI	C,.DTMMC	;TURN MONITOR MODE CONTROL ON
	PUSHJ	P,DODTE(R)
>;END IFN FTKL10
>;END OF IFN WTBOOT
IFE WTBOOT,<
	MOVEI	B,PTXT(R)	;PROMPT TEXT
	PUSHJ	P,PASCIZ(R)	;PRINT THAT
>;END IFE WTBOOT
IFN WTBOOT,<
	PUSHJ	P,CRLF(R)	;SAY HELLO
>;END IFN WTBOOT
IFN FTKS10,<
IFE WTBOOT,<
	MOVE	S,IOWEVA+RLWORD	;PICK UP RELOAD WORD
	SETZM	IOWEVA+RLWORD	;CLEAR OUT RELOAD WORD
	TRNN	S,AUTOBT	;DEFAULT BOOT REQUEST?
	JRST	GOL(R)		;NO--GO GET COMMAND STRING
	MOVEI	C,207		;YES--A BELL
	PUSHJ	P,TYO(R)	;SOUND IT FOR DEFAULT LOAD
	PUSHJ	P,CRLF(R)	;THE CRLF JUST LIKE HE TYPED IT
	JRST	RUN(R)		;GO TRY TO LOAD DEFAULT MONITOR
>;END IFE WTBOOT
>;END IFN FTKS10
GOL:	MOVE	S,SIXPTR(R)	;POINTER TO THE WORD.
	SETZB	N,W		;CLEAR ANSWERS.
SIXBRL:	ILDB	C,BPPRS(R)	;GET A CCL BYTE
	JUMPN	C,GOTCH(R)	;JUMP IF CCL EXISTS
	SETZM	BPPRS(R)	;INFINITE ZEROS
IFN FTKS10,<
	SKIPN	C,IOWEVA+CTYIWD	;GET INPUT WORD
	JRST	.-1(R)		;NONE SO WAIT
	SETZM	IOWEVA+CTYIWD	;FLAG WE GOT IT
>;IFN FTKS10
IFN FTKL10,<
	SKIPN	DTEMTI		;INPUT READY?
	JRST	.-1(R)		;NO
	SETZM	DTEMTI		;CLEAR
	MOVE	C,DTEF11	;GET CHARACTER
>;END IFN FTKL10
IFN FTKI10,<
	CONSO	TTY,40		;WAIT FOR A KEY TO BE STRUCK
	JRST	.-1(R)		; ..
	DATAI	TTY,C		;GET THE CHAR
>;END IFN FTKI10
GOTCH:	PUSHJ	P,TYO(R)	;ECHO IT
	ANDI	C,177		;ONLY 7 BITS
	CAIN	C,177		;RUBOUT?
	JRST	REGO(R)		;YES. QUIT.
	CAILE	C,140		;SKIP IF NOT L.C
	TRZ	C,40		;L.C., MAKE U.C.
	CAIG	C,"Z"		;LETTER?
	CAIGE	C,"A"		; ..
	SKIPA			;NOT A LETTER.
	JRST	SIXLTR(R)	;LETTER.
	CAIG	C,"9"		;NUMBER?
	CAIGE	C,"0"		; ..
	JRST	GO0(R)		;NO. RETURN WITH BREAK CHAR.
	LSH	N,3		;BUILD OCTAL NUMBER
	ADDI	N,-60(C)	;ADD IN THIS DIGIT
SIXLTR:	TRC	C,40		;MAKE SIXBIT
	TLNE	S,770000	;ONLY 6 CHARS
	IDPB	C,S		;STORE CHAR IN W
	JRST	SIXBRL(R)	;LOOP FOR MORE.
GO0:	CAIE	C,":"		;UNIT DELIMITER?
	JRST	GO1(R)		;NO.
	MOVEM	W,DEVICE(R)	;YES. SAVE NAME OF DEVICE
	JRST	GOL(R)		;GO READ MORE.
GO1:	CAIE	C,"]"		;END OF PPN?
	JRST	GO2(R)		;NO.
	HRRM	N,PPN(R)	;YES. SAVE PROGRAMMER NUMBER
	TLZN	F,L.CMA		;CLEAR PPN COMMA FLAG
	ERROR.	(ERNCB%)	;IT WASNT ON. BAD.
	JRST	GOL(R)		;OK. GO SEE IF ANY SWITCHES
GO2:	TLNE	F,L.ALL		;ANY SYNTAX REQUESTS?
	JRST	GO3(R)		;YES, SEE WHAT WAS TYPED
	JUMPE	W,GO4(R)	;NO PUNCTUATION, JUMP IF NO NAME TYPED
	MOVEM	W,FNAME(R)	;NAME TYPED, STORE IT
	JRST	GO4(R)		;GO CHECK PUNCTUATION
GO3:	TLZE	F,L.DOT		;WAS THERE A DOT?
	HLLOM	W,FEXT(R)	;YES. STORE EXT. RH IS FLAG IF BLANK.
	TLZE	F,L.LBK		;PPN REQUEST?
	HRLM	N,PPN(R)	;YES. STORE PROJ NO.
	TLZE	F,L.CMA		;PPN PART 2?
	HRRM	N,PPN(R)	;YES. STORE PROG NUMBER
	TLZE	F,L.SLA		;SLASH SWITCH?
	MOVEM	W,SWITCH(R)	;YES. SAVE SWITCH WORD
GO4:	CAIN	C,"."		;FILE EXTENSION REQUEST?
	TLO	F,L.DOT		;YES. REMEMBER THAT
	CAIN	C,"["		;PPN REQUEST?
	TLO	F,L.LBK		;YES. REMEMBER IT
	CAIN	C,"/"		;SLASH?
	TLO	F,L.SLA		;YES. MARK SWITCH COMING
	CAIN	C,","		;COMMA?
	TLO	F,L.CMA		;YES. ASSUME PART OF PPN
	CAILE	C,40		;PROCESS COMMAND IF SPACE OR A CONTROL CHARACTER
	JRST	GOL(R)		;LOOP FOR MORE.
;FALL INTO DO
;HERE WHEN COMMAND STRING SUCCESSFULLY READ. DO THE JOB.

DO:	SETZB	Q,W		;ZERO ACS USED BY DUMP AND LOAD
	PUSHJ	P,CRLF(R)	;SIGNAL STARTING I/O
	LDB	A,[POINT 6,SWITCH(R),5](R)	;GET FIRST CHARACTER
	JUMPE	A,RUN(R)	;NO SWITCH MEANS LOAD AND RUN
	CAIN	A,"L"-40	;LOAD COMMAND?
	JRST	LOAD(R)		;YES.
	CAIN	A,"D"-40	;DUMP COMMAND?
	JRST	DUMP(R)		;YES
	CAIL	A,"0"-40	;NUMERIC?
	CAILE	A,"7"-40	; OCTAL, THAT IS,
	TROA	F,R.STRT	;NO, ASSUME GO COMMAND
	JRST	STRTOK(R)	;STORE SUPPLIED STARTING ADDRESS
	CAIN	A,"G"-40	;GO COMMAND?
	SKIPN	N,PROGSA(R)	;YES, GET STARTING ADDRESS IF SUPPLIED
	ERROR.	(ERISS%)	;NO OTHERS IMPLEMENTED
STRTOK:	MOVE	W,N		;MOVE STARTING ADDRESS TO W
STARTQ:	HRLI	W,(JRST)
	MOVEM	W,PROGSA(R)	;SAVE THE STARTING ADDRESS
IFN FTKL10!FTKS10,<
	BLKI	APR,BOOTWD	;READ SERIAL NUMBER
>;END IFN FTKL10!FTKS10
IFN FTKI10,<
	CONI	PAG,BOOTWD	;READ PROCESSOR SERIAL NUMBER
>;END IFN FTKI10
	TRNN	F,R.STRT	;LOAD OR START?
	JRST	REGO(R)		;JUST LOAD. GO GET ANOTHER COMMAND
IFE FT22BIT,<
	JRST	(W)		;START
>;END IFE FT22BIT
IFN FT22BIT,<
IFN FTKI10,<
	MOVEI	K,PG.LEB	;LOAD EXEC BASE REGISTER, TURN PAGING OFF
	MOVE	W-1,MAPACS(R)	;DATAO PAG,K
>;END IFN FTKI10
IFN FTKL10!FTKS10,<
	MOVSI	W-1,(CONO PAG,)	;ZAP PAGING KL10 STYLE
>;END IFN FTKL10!FTKS10
	JRST	W-1		;ZAP PAGING, START PROGRAM
>;END IFN FT22BIT
;LOAD AND RUN COMMANDS

;LOAD:	TRZA	F,R.STRT	;LOAD BUT DON'T START PROGRAM
RUN:	TRO	F,R.STRT	;LOAD AND START PROGRAM
LOAD:	MOVE	A,SYSTEM(R)	;DEFAULT READ-FILE NAME
	PUSHJ	P,LOOK(R)	;TRY TO FIND FILE
				;SUCCESS. FALL INTO RFILE
IFE WTBOOT,<
	  JRST	REDEXE(R)
>
;HERE WHEN FILE FOUND. FIRST RIB FOR FILE IS IN CORE.

RFILE:
IFN FTSAVE,<
	SETZB	Q,40		;CLEAR CORE BEFORE READING FILE
				;AND INITIALLY NO WORDS IN DATA BUFFER
	MOVE	A,BLTXWD(R)	; ..
	BLT	A,CLRTOP(R)	;CLEAR UP TO BASE OF THIS PROGRAM
RFILL1:	PUSHJ	P,RWORD(R)	;READ A POINTER OR JRST WORD
	SKIPL	M,W		;WHICH IS IT?
	JRST	STARTQ(R)	;TRANSFER WORD
RFILL2:	PUSHJ	P,RWORD(R)	;READ A WORD OF DATA
	MOVEM	W,1(M)		;STORE IT IN CORE
	AOBJN	M,RFILL2(R)	;COUNT THE CORE POINTER.
	JRST	RFILL1(R)	;IT RAN OUT. GET ANOTHER.

;SUBROUTINE TO READ A DATA WORD FROM THE FILE.

RWNXTB:	PUSHJ	P,RDDATA(R)	;NO. READ NEXT DATA BLOCK, IF ANY
	  ERROR.	(ERRDE%)	;ERROR RETURN FROM RDDATA
RWORD1:	MOVSI	Q,-200		;PREPARE TO COUNT DATA WORDS
	HRRI	Q,DBUF(R)	;RELOCATE
RWORD:	JUMPGE	Q,RWNXTB(R)	;NEED ANOTHER BLOCK?
	MOVE	W,0(Q)		;NO. GET A WORD.
	AOBJN	Q,.+1(R)	;COUNT IT.
	POPJ	P,0		;RETURN FROM RWORD

>;END IFN FTSAVE
IFN FTEXE,<
;HERE TO READ AN EXE FILE

REDEXE:	PUSHJ	P,REDDIR(R)	;READ THE DIRECTORY PAGE
 	  ERROR.	(ERERD%)	;CAN'T READ IT
	HLRZ	A,DBUF(R)	;DIRECTORY DESCRIPTOR
	HRRZ	NAME,DBUF(R)	;LENGTH OF THE DIRECTORY
	CAIN	A,SV.DIR	;IS THIS A DIRECTORY?
	CAIL	NAME,^D128	; WHICH IS LESS THAN OR EQUAL TO 128 WORDS LONG?
	ERROR.	(ERNDL%)	;NOT A DIRECTORY OR ONE WE CAN'T HANDLE
	PUSHJ	P,ZCORE(R)	;CLEAR CORE FROM 40 UP
	MOVNI	NAME,-1(NAME)	;MAKE AN AOBJN POINTER TO THE DIRECTORY
	HRLI	NAME,DBUF+1(R)	; ..
	MOVSS	NAME		; ..
REDEX2:	MOVE	M,(NAME)	;BITS,,FILE PAGE NUMBER
	JUMPL	M,REDEX3(R)	;JUMP IF HI SEG PAGE, READ IT IMMEDIATELY
				; ABOVE THE LOW SEGMENT
	HRRZ	W,1(NAME)	;CORE PAGE NUMBER
	LSH	W,P2WLSH	;CORE ADDRESS
	SKIPN	W		;PAGE 0?
	HRROI	W,1000		;YES, READ IT INTO PAGE 1, AND REMEMBER ITS PAGE 0
REDEX3:	LDB	EXT,[POINT 9,1(NAME),8](R)
REDEX4:	TRCN	M,-1		;AN ALLOCATED BUT ZERO PAGE?
	JRST	REDEX8(R)	;YES, COUNT DOWN REPEAT COUNT AND UPDATE CORE ADDRESS
	TRC	M,-1		;NO, RESTORE FILE PAGE NUMBER
	HRRZ	X,M		;FILE PAGE NUMBER
	LSH	X,P2BLSH	;CONVERT TO BLOCK WITHIN THE FILE
	CAILE	Q,(X)		;FILE PAGE NUMBERS MUST BE MONOTONICALLY INCREASING
	ERROR.	(ERPNM%)	;CAN'T HANDLE THAT
REDEX5:	CAIN	X,(Q)		;AT THE RIGHT BLOCK WITHIN THE FILE?
	JRST	REDEX7(R)	;YES
REDEX6:	PUSHJ	P,SELBLK(R)	;NO, USETI BLOCK+1
	  ERROR.	(ERPEF%)	;END OF FILE
	AOJA	Q,REDEX5(R)	;SEE IF THERE YET
REDEX7:	MOVEI	K,-1(W)		;CORE ADDRESS WHERE THE PAGE IS TO BE READ INTO
IFN FT22BIT,<
	SUB	K,IOWEVA+BOOTSP	;SETCHN WILL ADD IN BOOTSP
>;END IFN FT22BIT
	PUSHJ	P,RDBLK(R)	;READ A BLOCK
	  ERROR.	(ERRDE%)	;I/O ERROR
	ADDI	W,BLKSIZ	;NEXT CORE ADDRESS
	TRNE	W,PAGSIZ-1	;HAS A WHOLE PAGE BEEN READ?
	AOJA	X,REDEX6(R)	;NO, READ THE NEXT BLOCK
	JUMPGE	W,REDEX9(R)	;PAGE 0 JUST READ?
IFN WTBOOT,<
	MOVE	W,[IOWEVA+1040,,IOWEVA+40](R)	;YES, MOVE IT TO PAGE 0
	BLT	W,IOWEVA+777	; CAREFULLY AVOIDING WIPING 0-37
>
IFE WTBOOT,<
	MOVE	W,[1040,,40](R)	
	BLT	W,777
>
	MOVEI	W,0		;READ NEXT PAGE INTO PAGE 1
REDEX8:	ADDI	W,PAGSIZ	;NEXT PAGE
REDEX9:	SOSL	EXT		;READ ALL THE PAGES DESCRIBED BY THIS ENTRY?
	AOJA	M,REDEX4(R)	;NO, READ THE NEXT PAGE
	AOBJN	NAME,.+1(R)	;BUMP PAST THIS DIRECTORY ENTRY, AND
	AOBJN	NAME,REDEX2(R)	; GO GET THE NEXT DIRECTORY ENTRY
	HRRZ	W,IOWEVA+.JBSA	;ALL DONE, GET THE STARTING ADDRESS
	JRST	STARTQ(R)	;AND GO START THE PROGRAM
>;END IFN FTEXE
;HERE TO WRITE OUT CORE ON AN EXISTING FILE

DUMP:	MOVE	A,CRASH(R)	;DEFAULT FILE NAME
	PUSHJ	P,LOOK(R)	;TRY TO FIND THE FILE.
IFE WTBOOT,<
	  JRST	WRTEXE(R)
>
IFN FTSAVE,<
	MOVEI	M,FIRSTW-1	;AND CORE ADDRESS COUNTER
DUMPL2:	HRRZS	X,M		;START OF A BLOCK
DUMPL1:	SKIPN	1(X)		;THIS WORD ZERO IN CORE?
	JRST	DUMP1(R)	;YES. SEE IF END OF A BLOCK.
	CAIGE	X,CLRTOP(R)	;LOOKED AT ALL OF CORE?
	AOJA	X,DUMPL1(R)	;NO. COUNT PART OF THIS BLOCK, LOOK ON.
DUMP1:	MOVEI	W,0(M)		;END OF BLOCK. IS BLOCK EMPTY?
	SUBI	W,0(X)		;START MINUS END OF BLK
	JUMPE	W,DUMP2(R)	;JUMP IF BLOCK EMPTY
	HRL	M,W		;MAKE -COUNT,,START-1 FOR COUNTER
	MOVE	W,M		;AND FOR DATA IN FILE
	PUSHJ	P,WWORD(R)	;WRITE IT OUT AS DATA
DUMPL3:	MOVE	W,1(M)		;GET THE WORD FROM CORE
	PUSHJ	P,WWORD(R)	;OUTPUT TO FILE
	AOBJN	M,DUMPL3(R)	;OUTPUT ALL OF BLOCK
DUMP2:	CAIGE	X,CLRTOP(R)	;CONSIDERED ALL OF CORE?
	AOJA	M,DUMPL2(R)	;NO. MOVE ON.
	MOVE	W,PROGSA(R)	;YES. APPEND STARTING ADDRESS
	HRLI	W,(JRST)	;SAVE FILES END WITH A JRST
	PUSHJ	P,WWORD(R)	;WRITE OUT THIS WORD
	JUMPL	Q,.-1(R)	;IF MORE TO GO IN BLOCK, WRITE AGAIN
	JRST	REGO(R)		;AND RESTART PROGRAM FOR NEXT COMMAND
>;END IFN FTSAVE
IFN FTEXE,<
;HERE TO WRITE AN EXE FILE

WRTEXE:	MOVE	X,HIPAGE(R)	;HIGHEST PAGE TO DUMP
	SUBI	X,1		;REPEAT COUNT
	ROT	X,-11		;NUMBER OF 256K CHUNKS + REPEAT COUNT LEFT JUSTIFIED
	MOVEI	W,(X)		;NUMBER OF 256K CHUNKS
	ADDI	W,3(W)		;MULTIPLY BY TWO AND ADD THREE (DIRECTORY LENGTH)
	HRLI	W,SV.DIR	;DIRECTORY DESCRIPTOR
	MOVSI	M,-^D512(W)	;NUMBER OF WORDS TO MAKE THE DIRECTORY A PAGE LONG
	PUSHJ	P,WWORD(R)	;WRITE DIRECTORY DESCRIPTOR,,DIRECTORY LENGTH
WRTEX1:	MOVEI	W,1(M)		;FILE PAGE NUMBER
	PUSHJ	P,WWORD(R)	;WRITE THAT
	MOVEI	W,(M)		;CORE PAGE NUMBER
	TLO	W,777000	;512 PAGES IN THIS CHUNK
	PUSHJ	P,WWORD(R)	;WRITE THAT
	ADDI	M,^D512		;NEXT CORE PAGE (ALSO NEXT FILE PAGE)
	TRNE	X,-1		;ALL DONE WITH THE DIRECTORY?
	SOJA	X,WRTEX1(R)	;NO, WRITE THE NEXT DIRECTORY PAIR
	HLLM	X,-1(Q)		;STORE NUMBER OF PAGES IN THE LAST CHUNK
	MOVE	W,[SV.END,,1](R)	;END OF DIRECTORY MARKER
WRTEX2:	PUSHJ	P,WWORD(R)	;WRITE THAT
	AOBJN	M,WRTEX2(R)	; ..
	MOVSI	W,IOWEVA	;FIRST BLOCK OF PAGE 0
	HRRI	W,DBUF(R)	;MOVE IT TO THE DATA BUFFER
	BLT	W,DBUF+177(R)	;MUST WRITE FROM BUFFER SINCE RH20 CAN'T WRITE LOC 0
	PUSHJ	P,WTDBUF(R)	;WRITE IT TO THE FILE
	MOVEI	W,200		;START AT 200, DUMP CORE
WRTEX3:	SOS	K,W		;COPY ADDRESS - 1 TO K
IFN FT22BIT,<
	SUB	K,IOWEVA+BOOTSP	;SUBTRACT OUT FOR SETCHN
>
	PUSHJ	P,WRTBLK(R)	;WRITE THE BLOCK
	  ERROR.	(ERWTE%);ERROR-OUTPUT ERROR
	ADDI	W,BLKSIZ+1	;STEP TO NEXT CORE ADDRESS
	CAMGE	W,IOWEVA+BOOTSP	;ARE WE DONE YET?
	JRST	WRTEX3(R)	;NO--GO DO SOME MORE
	JRST	REGO(R)		;YES--HEAD FOR NEXT COMMAND

>;END IFN FTEXE

;SUBROUTINE TO WRITE A WORD INTO THE FILE

WWORD:	JUMPL	Q,WWORD1(R)	;NEED A NEW POINTER?
	MOVSI	Q,-200		;YES
	HRRI	Q,DBUF(R)	;RELOCATE
WWORD1:	MOVEM	W,0(Q)		;PUT WORD INTO BUFFER
	AOBJN	Q,CPOPJ(R)	;COUNT POINTER. DONE?
WTDBUF:	PUSHJ	P,WRDATA(R)	;YES. OUTPUT BLOCK, IF POSSIBLE
	  ERROR.	(ERWTE%);NO GOOD.
	POPJ	P,0		;OK. RETURN.
;SUBROUTINE TO LOOK FOR FILE

LOOK:	SKIPN	FNAME(R)	;NAME SUPPLIED?
	MOVEM	A,FNAME(R)	;NO. PLUG IN DEFAULT.
	MOVSI	A,(SIXBIT /DSK/)	;ASSUME DSK WAS TYPED
	CAME	A,DEVICE(R)	;JUST DSK?
	SKIPN	DEVICE(R)	;OR BLANK?
	TROA	F,R.DSKW	;YES, FLAG WILD DISK NAME
	JRST	LOOK1(R)	;NO, USE SUPPLIED NAME
	TRO	A,(SIXBIT /@/)	;START AT DSKA
	MOVEM	A,DEVICE(R)	;STORE NAME AWAY

LOOK2:	MOVEI	A,010000	;INCREMENT WILD DSK NAME
	ADDB	A,DEVICE(R)	; ..
	TRNE	F,R.DSKW	;WILD DEVICE ARGUMENT?
	TRNE	A,200000	;TRIED UP TO DSKO?
	ERROR.	(ERFNF%)	;YES. GIVE UP, IT AINT THERE.

LOOK1:	SETZM	SLUNIT(R)	;CLEAR LOGICAL UNIT NUMBER
	PUSHJ	P,FNDUNI(R)	;TRY TO FIND SUCH A UNIT
	  JRST	LOOK2(R)	;NOT THERE.
LOOK3:	SKIPN	NAME,PPN(R)	;FIRST SEARCH FOR THE UFD
	MOVE	NAME,SYSPPN(R)	;IF NONE, ASSUME 1,4
	HRLOI	EXT,(SIXBIT /UFD/)	;EXTENSION IS UFD FOR FILE DIR
	MOVE	A,HBUF+HOMMFD(R)	;LBN IN STR OF MFD RIB
	PUSHJ	P,SRCHFD(R)	;SEARCH FOR THE REQUESTED UFD
	  JRST	LOOK2(R)	;NOT THERE.
	MOVE	NAME,FNAME(R)	;NAME OF FILE TO SEARCH FOR
	SKIPN	EXT,FEXT(R)	;IF EXTENSION NOT SEEN
IFN FTSAVE&WTBOOT,<
	HRLOI	EXT,(SIXBIT /SAV/)	;ASSUME SAV EXTENSION
>;END IFN FTSAVE
IFN FTEXE,<
	HRLOI	EXT,(SIXBIT /EXE/)	;ASSUME EXE EXTENSION
>;END IFN FTEXE
	HRRZ	A,1(A)		;SUPERCLUSTER ADDRESS OF THE UFD
	IMUL	A,HBUF+HOMBSC(R)	;MAKE IT A BLOCK NUMBER

;FALL INTO LOOK4
IFE WTBOOT,<
LOOK4:	PUSH	P,A		;SAVE UFD BLOCK NUMBER
>
	PUSHJ	P,SRCHFD(R)	;SEARCH FOR THE FILE IN THE UFD
IFN WTBOOT,<
	  JRST	LOOK2(R)	;NO SUCH FILE.
>
IFE WTBOOT,<
	  JRST	LOOK5(R)	;NO SUCH FILE.
	POP	P,(P)		;POP OFF JUNK
>
	HRRZ	LBN,1(A)	;SUPERCLUSTER OF START OF THE FILE
	IMUL	LBN,HBUF+HOMBSC(R)	;CONVERT TO LOGICAL BLOCK NUMBER
	PUSHJ	P,SETRIB(R)	;GET THE RIB, CHECK IT
	  JRST	LOOK2(R)	;NO LUCK. ASSUME FILE NOT THERE.
	HLLO	A,RBUF+RIBEXT(R)	;GET THE EXTENSION FROM RIB
	CAMN	A,EXT		;DESIRED EXTENSION?
	CAME	NAME,RBUF+RIBNAM(R)	;AND NAME?
	  ERROR.	(ERBRB%)	;NO. QUIT, RIB BAD.
IFE WTBOOT,<
	HLRZS	EXT		;FILE EXTENSION
	CAIE	EXT,(SIXBIT /EXE/)	;AN EXE FILE?
	JRST	CPOPJ1(R)	;NO, GIVE NOT EXE FORMAT RETURN
>
	POPJ	P,0		;RETURN
IFE WTBOOT,<
LOOK5:	POP	P,A		;RESTORE UFD BLOCK NUMBER
	HLRZS	EXT		;FILE EXTENSION
	SKIPN	FEXT(R)		;WAS ONE SPECIFIED?
	CAIN	EXT,(SIXBIT /SAV/)	;NO, WAS SAV LOOKED UP?
	JRST	LOOK2(R)	;YES, FILE NOT FOUND
	HRLOI	EXT,(SIXBIT /SAV/)	;TRY LOOKING UP SAV EXTENSION
	JRST	LOOK4(R)	;GO SEE IF THAT IS THERE
>;END IFE FTBOOT
;SUBROUTINE TO SET UP A RIB BLOCK AND CHECK IT.

SETRIB:	PUSHJ	P,LBNSEL(R)	;MAKE SURE ON RIGHT UNIT
	  POPJ	P,		;NOT THERE
IFE FT22BIT,<
	MOVEI	K,RBUF-1(R)	;ADDRESS OF THE RIB BUFFER
>;END IFE FT22BIT
IFN FT22BIT,<
	MOVEI	K,RBUFOS-1	;OFFSET INTO DATA PAGE OF THE RIB BUFFER
>;END IFN FT22BIT
	PUSHJ	P,REDBLK(R)	;READ THE FILE'S RIB
	  POPJ	P,0		;COULDN'T READ IT
	SETZM	CLUCNT(R)	;NO CLUSTERS LEFT
	SETZM	BLKCNT(R)	;NO BLOCKS LEFT IN CLUSTER
IFN FTSAVE,<
	MOVE	A,RBUF+RIBSIZ(R)	;LENGTH OF THE FILE
	MOVEM	A,LENGTH(R)	;SAVE FOR EOF TEST
>;END IFN FTSAVE
	TRO	F,R.SRIB	;WANT TO SKIP THE RIB WHEN READING
	MOVE	S,RBUF+RIBFIR(R)	;POINTER TO REAL RIB DATA
	ADDI	S,(R)		;RELOCATE
	JRST	CPOPJ1(R)	;SUCCESSFUL RETURN
;SUBR TO SEARCH A UFD OR MFD FOR FILE & EXT.
; RIB LBN IN STR OF THE FD IN A

SRCHFD:	SKIPG	LBN,A		;STORE BLOCK TO READ RIB FROM.
	ERROR.	(ERPRE%)	;SHOULDNT BE EOF
	PUSHJ	P,SETRIB(R)	;SET UP THE RIB
	  POPJ	P,0		;CAN'T READ IT
SCHL1:	PUSHJ	P,RDDATA(R)	;READ THE FILE DIR DATA FROM THIS FD
	  POPJ	P,0		;ERROR RETURN
	MOVSI	A,-200		;POINTER TO THE DATA BUFFER
	HRRI	A,DBUF(R)	;RELOCATE
SCHL2:	HLLO	B,1(A)		;EXTENSION
	CAMN	NAME,(A)	;DOES THE FILE NAME MATCH?
	CAME	B,EXT		;YES, EXTENSION MATCH ALSO?
	AOBJN	A,.+2(R)	;NO, MOVE ON TO THE NEXT FILE IN THE FD
	JRST	CPOPJ1(R)	;YES, GOOD RETURN, ANSWER AT (A)
	AOBJN	A,SCHL2(R)	;COUNT FILE, EXT. CHECK NEXT FILE IN FD
	JRST	SCHL1(R)	;READ ON.

;SUBR TO SELECT CORRECT UNIT FROM LBN

LBNSEL:	MOVE	A,LBN		;GET DESIRED BLOCK NUMBER
	MOVE	B,HBUF+HOMBSC(R)	;COMPUTE SIZE OF UNIT
	IMUL	B,HBUF+HOMSCU(R)	; ..
	IDIV	A,B		;SCALE LBN INTO A UNIT AND LOCAL LBN
	MOVE	LBN,B		;LBN WITHIN THE UNIT
	CAMN	A,HBUF+HOMLUN(R)	;ALREADY AT THIS UNIT?
	JRST	CPOPJ1(R)	;YES. NO NEED TO CHANGE UNITS
	MOVEM	A,SLUNIT(R)	;NO. NEED TO FIND IT.
	PUSH	P,LBN		;SAVE THE LBN WITHIN DESIRED UNIT
	PUSHJ	P,FNDUNI(R)	;FIND THE UNIT
	  SOS	-1(P)		;NOT THERE. SET FOR NON-SKIP RETURN.
	POP	P,LBN		;RESTORE UNIT LBN
	JRST	CPOPJ1(R)	;AND SKIP RETURN.

;SUBROUTINE TO SELECT NEXT BLOCK OF DATA
; THE DATA IS FOUND USING RIB'S STARTING AT 0(S), OR
; IF STUFF LEFT OVER FROM CURRENT RIB, VIA CLUCNT, BLKCNT, CLBN

SELBLK:
SEL5:	AOS	LBN,CLBN(R)	;ASSUME WILL USE NEXT BLOCK
	SOSL	BLKCNT(R)	;ANY BLOCKS LEFT IN CURRENT CLUSTER?
	JRST	SEL1(R)		;YES. GO PICK ONE.
	SOSL	CLUCNT(R)	;ANY CLUSTERS LEFT IN CURRENT RET PTR?
	JRST	SEL2(R)		;YES. PICK ONE.
SEL4L:	SKIPGE	S		;FAIL IF OUT OF POINTERS
	SKIPN	A,RBUF(S)	;NEED ANOTHER RET PTR. EOF YET?
	POPJ	P,0		;YES. FAIL RETURN.
	AOBJN	S,.+1(R)	;COUNT POINTER FOR NEXT RIB
	MOVE	C,HBUF+HOMCNP(R)	;GET THE COUNT POINTER
	PUSHJ	P,RIBBYT(R)	;GET COUNT OF CURRENT RET PTR
	JUMPN	B,SEL3(R)	;IF NON-ZERO, GO GET CLUSTER
	PUSHJ	P,RIBCLP(R)	;NEW UNIT. GET LOGICAL UNIT NUMBER
	CAMN	B,HBUF+HOMLUN(R)	;IS THIS UNIT RIGHT ALREADY?
	JRST	SEL4(R)		;YES. DON'T SEARCH
	MOVEM	B,SLUNIT(R)	;NO. SAVE LOG UNIT NUMBER FOR SEARCH
	PUSHJ	P,FNDUNI(R)	;FIND THE UNIT
	  POPJ	P,0		;NOT FOUND. ERROR.
SEL4:	JRST	SEL4L(R)	;READ NEXT RIB ON NEW UNIT

SEL3:	SUBI	B,1		;COUNT CLUSTER ABOUT TO BE USED.
	MOVEM	B,CLUCNT(R)	;AND SAVE REMAINDER.
	PUSHJ	P,RIBCLP(R)	;GET CLUSTER ADDRESS
	IMUL	B,HBUF+HOMBPC(R)	;CONVERT TO AN LBN
	MOVEM	B,LBN		;PUT IN CORRECT AC
SEL2:	MOVE	A,HBUF+HOMBPC(R)	;BLOCKS IN A CLUSTER
	SUBI	A,1		;MINUS THE ONE ABOUT TO BE READ
	MOVEM	A,BLKCNT(R)	;SAVE THIS COUNT
SEL1:	MOVEM	LBN,CLBN(R)	;SAVE CURRENT LBN
	TRZE	F,R.SRIB	;SKIP RIB?
	JRST	SEL5(R)		;YES. GO THROUGH THIS ROUTINE AGAIN
;CHECKSUM HERE?
	JRST	CPOPJ1(R)	;SUCCESSFUL RETURN FROM SELBLK
;ROUTINE TO FIND A PARTICULAR LOGICAL UNIT IN THE SYSTEM
;ARGUMENTS ARE: STRUCTURE NAME (SIXBIT) IN DEVICE, AND
;UNIT NUMBER WITHIN STRUCTURE IN SLUNIT.
;SKIP RETURN IF FOUND.

FNDUNI:	SETZM	TTYPE(R)	;CLEAR SEARCH TEMPS
FNDUL1:	SETZM	TUNIT(R)	; ..
FNDUL2:	MOVE	A,TTYPE(R)	;GET KONTROLLER TYPE
	MOVE	N,TUNIT(R)	;AND UNIT NUMBER
	PUSHJ	P,HOME(R)	;TRY TO READ ITS HOME BLOCK
	  JRST	FNDUNX(R)		;NO GOOD. ON TO NEXT.
	MOVE	A,HBUF+HOMSNM(R)	;FOUND THIS UNIT. IS IT DESIRED ONE?
	MOVE	B,HBUF+HOMLUN(R)	; ..
	CAMN	A,DEVICE(R)	;CHECK AGAINST SUPPLIED ARGS
	CAME	B,SLUNIT(R)	; ..
FNDUNX:	AOSA	A,TUNIT(R)	;NO GOOD. ON TO NEXT.
	JRST	CPOPJ1(R)	;CORRECT. SKIP RETURN.
	CAIG	A,UNIMAX	;TOO BIG?
	JRST	FNDUL2(R)	;NO. GO CHECK THIS ONE
	AOS	A,TTYPE(R)	;YES. COUNT TO NEXT TYPE OF KONTROLLER
	CAIG	A,TYPMAX	;ALL OF THOSE GONE BY?
	JRST	FNDUL1(R)	;NO. TRY THIS ONE.
				;ALL TRIED. GIVE FAIL RETURN.
				;BY FALLING INTO RIBCLP

RIBCLP:	MOVE	C,HBUF+HOMCLP(R)
RIBBYT:	HRRI	C,A		;WHERE THE WORD IS
	LDB	B,C		;GET THE DESIRED BYTE
	POPJ	P,0		;AND RETURN
;ROUTINE TO DETERMINE WHETHER A UNIT EXISTS, AND IF SO, TO READ
;ITS HOME BLOCK INTO THE HOME BUFFER

;CALLING SEQUENCE:
;A/	KONTROLLER TYPE INDEX
;N/	UNIT NUMBER, 0-7
;	PUSHJ P,HOME
;	  NOT THERE RETURN
;	OK RETURN

;AT THIS POINT, ANY NEEDED UNIT PARAMETERS ARE SAVED, SUCH AS R.TYPE
; AND THE HOME BLOCK IN HBUF
HOME:
IFN FTDPC!FTFHD!FTRH11,<
	TRZ	F,R.TYPE	;ASSUME UNIT TYPE IS RD10 OR RP02 OR RP04/6
>;END IFN FTDPC!FTFHD
	TRZ	F,R.KDEV	;CLEAR KONTROLLER FIELD
	MOVSI	B,A		;SET TO RELOCATE BY CONTROLLER TYPE
	HRRI	B,CHNTAB(R)	;INDEX INTO CHNTAB
IFE FTRH2W!FTKS10,<
	MOVE	C,@B		;GET DF10C CONI BIT
	HLLZM	C,DFBIT(R)	;STORE THE BIT IN CORE.
	TRO	F,(C)		;SET KONTROLLER FIELD
>;END FTRH2W!FTKS10
IFN FTRH2W!FTKS10,<
	TDO	F,@B		;SET KONTROLLER FIELD
>;END FTRH2W!FTKS10
	HRRI	B,UNIINI(R)	;ABS ADR OF INI TABLE (ARG FOR SETCHN)
	MOVEI	LBN,HOMBK1	;WANT TO READ FIRST HOME BLOCK
IFE FT22BIT,<
	MOVEI	K,DBUF-1(R)	;BUFFER FOR TEST I/O
>;END IFE FT22BIT
IFN FT22BIT,<
	MOVEI	K,DBUFOS-1	;OFFSET TO BUFFER FOR TEST I/O
>;END IFN FT22BIT
	PUSHJ	P,SETCHN(R)	;SET UP CHANNEL COMMAND LIST
				; AND CALL INITIALIZE KONT. ROUTINE
	  POPJ	P,0		;ERROR. NOT THERE.

;FALL INTO HOM1
;HERE TO READ THE FIRST HOME BLOCK ON A UNIT

HOM1:
IFE FT22BIT,<
	MOVEI	K,HBUF-1(R)	;READ HOME BLOCK INTO ITS BUFFER
>;END IFE FT22BIT
IFN FT22BIT,<
	MOVEI	K,HBUFOS-1	;OFFSET INTO DATA PAGE OF HOME BLOCK BUFFER
>;END IFN FT22BIT
	PUSHJ	P,REDBLK(R)	;TRY TO READ THE HOME BLOCK
	  JRST	HOM2(R)		;CAN'T READ THAT ONE
	MOVE	A,HBUF+BLKCOD(R)	;GET THE CODE WORD
	CAIN	A,CODHOM	;IS IT RIGHT?
	SKIPE	HBUF+HOMREF(R)	;AND NOT NEEDING REFRESHING?
	JRST	HOM2(R)		;NO GOOD.
	JRST	CPOPJ1(R)	;OK RETURN.

HOM2:	CAIN	LBN,HOMBK2	;TRIED BOTH BLOCKS?
	POPJ	P,0		;YES. GIVE FAIL RETURN
	MOVEI	LBN,HOMBK2	;NO TRY ANOTHER ONE.
	JRST	HOM1(R)		;READ SECOND HOME BLOCK
;INITIALIZE KONTROLLER ROUTINES (CONSO IRRELEVANT - USED TO GET DEVICE CODE

UNIINI:
IFN FTFHD,<
	CONSO	FHD,FHDINI(R)	;FIRST FHD
	CONSO	FHD2,FHDINI(R)	;SECOND FHD
>;END IFN FTFHD
IFN FTDHX,<
IFE FTRH20,<
	CONSO	DHX,DHXINI(R)	;FIRST RH10/RP04
	CONSO	DHX2,DHXINI(R)	;SECOND
>
IFN FTRH20,<
IFE WTBOOT,<
	CONSO	DHX,DHXINI(R)	;FIRST RH10/RP04
	CONSO	DHX2,DHXINI(R)	;SECOND
>
	DEFINE	A(Z)<
	CONSO	RH2'Z,DHXINI(R)	;RH20/RP04
>
	RH20
>
>;END IFN FTDHX
IFN FTRH11,<
	CONSO	RHIINI(R)	;FIRST RH11
>;IFN FTRH11
IFN FTDPC,<
	CONSO	DPC,DPCINI(R)	;FIRST DPC
	CONSO	DPC2,DPCINI(R)	;SECOND DPC
>;END IFN FTDPC
TYPMAX==.-UNIINI-1		;MAXIMUM KONTROLLER ROUTINE
UNIMAX==7			;MAX NUMBER OF UNITS ON A KONTROLLER

;DF10C CONI BITS READ FROM THE CONTROLLER

CHNTAB:
IFN FTFHD,<
	40000,,<FHD>_-2		;FIRST RC10
	40000,,<FHD2>_-2	;SECOND RC10
>;END IFN FTFHD
IFN FTDHX,<
IFE FTRH20,<			;RH20S ARE ALWAYS 22-BIT
	4000,,<DHX>_-2		;FIRST RH10/RP04
	4000,,<DHX2>_-2		;SECOND RH10/RP04
>
IFN FTRH20,<
IFE WTBOOT,<
	4000,,<DHX>_-2		;FIRST RH10/RP04
	4000,,<DHX2>_-2		;SECOND RH10/RP04
>
	DEFINE	A(Z)<
	400000,,<RH2'Z>_-2	;RH20/RP04
>
	RH20
>
>;END IFN FTDHX
IFN FTRH11,<
	0,,1			;FIRST RH11 ON UBA #1
>;IFN FTRH11
IFN FTDPC,<
	20,,<DPC>_-2		;FIRST RP10
	20,,<DPC2>_-2		;SECOND RP10
>;END FTDPC
IFN FTFHD,<
;INITIALIZATION FOR RC10 FIXED HEAD DISK/DRUM

FHDINI:	CAILE	N,3		;ONLY 3 UNITS ON FHD KONTROLLER
	POPJ	P,0		;ASKED FOR UNIT OVER 3. ERROR RETURN.
	ROT	N,-2		;INTO UNIT NUMBER FIELD
	TLO	N,160		;TRACK 0, SECTOR 70 BCD. ILLEGAL ON RM10B
	HRRI	N,LOWCMD	;CHANNEL COMMAND ADDRESS
	MOVE	C,[DATAO N](R)	;SET UP DATAO FROM N
	PUSHJ	P,IOXCT(R)	;PERFORM DATAO ON RIGHT DEVICE
	PUSHJ	P,IOWAIT(R)	;WAIT FOR DONE OR TIMEOUT
	JUMPLE	B,CPOPJ(R)	;QUIT IF TIMED OUT
	MOVEI	A,170220	;ERROR FLAGS?
	PUSHJ	P,IOCNSZ(R)	;DO A CONSZ
	POPJ	P,0		;ERRORS OR NOT DONE. FAIL RETURN
	MOVEI	A,200000	;SEARCH ERROR?
	PUSHJ	P,IOCNSZ(R)	; ..
	TRO	F,R.TYPE	;YES. PROBABLY A DRUM.
	JRST	CPOPJ1(R)	;GIVE GOOD RETURN
>;END IFN FTFHD

IFN FTDPC,<
;INITIALIZATION FOR PACKS

DPCINI:	MOVEI	A,LOWCMD_6(N)	;SET DRIVE NUMBER
	ROT	A,-6		;POSITION DRIVE, ICWA. OP=READ
	TLO	A,37		;ILLEGAL SURFACE
	MOVEM	A,DATAOW(R)	;STORE AS DATAO
	MOVE	C,[DATAO DATAOW(R)](R)	;SET UP A DATAO TO PACKS
	PUSHJ	P,IOXCT(R)	;DATAO ON RIGHT DEVICE
	PUSHJ	P,IOWAIT(R)	;TIMEOUT OR DONE FLAG
	JUMPLE	B,CPOPJ(R)	;TIMED OUT?
	MOVEI	A,2000		;DRIVE NOT THERE?
	PUSHJ	P,IOCNSZ(R)	; ..
	POPJ	P,0		;NOT THERE. ERROR RETURN.
	MOVE	C,[DATAI A](R)	;SET UP TO GET UNIT TYPE
	PUSHJ	P,IOXCT(R)	; ..
	TRNE	A,2000		;SKIP IF NOT RP03
	TRO	F,R.TYPE	;FLAG AS RP03
	JRST	CPOPJ1(R)	;SUCCESS RETURN
>;END IFN FTDPC
IFN FTRH11,<

;INITIALIZATION FOR RH11
; CALLING SEQUENCE
;N/	UNIT NUMBER, 0-7
;	PUSHJ P,RHIINI
;	  NOT THERE RETURN
;	OK RETURN

RHIINI:	MOVEI	A,40		;CLEAR RH11
	WRIO	A,RPCS2(C)	;DO IT
	MOVEI	A,740000	;UBA TEST MASK
	TIOE	A,UBA.SR(C)	;NON-EXISTANT RH11 OR ERROR?
	  JRST	RHIIN2(R)	;LOSE
	WRIO	N,RPCS2(C)	;SELECT UNIT
	RDIO	A,RPDT(C)	;GET DRIVE TYPE REGISTER
	TRNN	A,20000		;IS IT A DISK UNIT?
	  POPJ	P,		;NO, SO LOSE
	ANDI	A,777		;STRIP OUT TYPE NUMBER
	CAIN	A,24		;IS IT AN RM03?
	TRO	F,R.TYPE	;YES, SO SET FLAG
	MOVEI	A,21		;READ-IN-PRESET COMMAND
	WRIO	A,RPCS1(C)	;DO IT, SETTING VOLUME VALID
	RDIO	A,RPDS(C)	;GET DRIVE STATUS
	XORI	A,137777	;COMPLEMENT BITS (EXCEPT ERR)
	TRNE	A,050300	;CHECK FOR ERRORS (ERR, MOL, DRY, VV)
	  POPJ	P,		;LOSE
	JRST	CPOPJ1(R)	;WIN

RHIIN2:	WRIO	A,UBA.SR(C)	;CLEAR UBA PROBLEM
	  POPJ 	P,		;LOSE RETURN
>;IFN FTRH11
IFN FTDHX,<
;INITIALIZATION FOR RH10/RP04
DHXINI:
IFN FTRH20,<
	MOVEI	A,5400		;MASSBUS ENABLE, CLEAR RAE, CLEAR ERRORS
IFE WTBOOT,<
	TRNE	F,100		;IF AN RH20
>
	PUSHJ	P,IOCONO(R)
>
	MOVSI	A,4400(N)
;POSSIBLE BUM - REPLACE THE NEXT 2 INSTR'S WITH CONO APR,200000
	HRRI	A,11		;DRIVE CLEAR
	PUSHJ	P,IODTO(R)
	HRRI	A,21		;READIN PRESET
	PUSHJ	P,IODTO(R)
	MOVSI	A,010400(N)	;STATUS REGISTER
	PUSHJ	P,IODTI(R)	;READ IT
	ANDI	A,172777	;16 DATA BITS, IGNORE WRITE LOCK, PGM
	CAIE	A,10700		;OK? (VV=100 IS ONLY UP ON AN RP0X)
	POPJ	P,		;NOT THERE OR NOT RP0X
	JRST	CPOPJ1(R)

IODTI:	MOVE	C,[DATAO A](R)
	PUSHJ	P,IOXCT(R)
	TLZA	C,100		;TURN IT INTO A DATAI
IODTO:	MOVE	C,[DATAO A](R)
	PJRST	IOXCT(R)
>;END IFN FTDHX

IFE FTKS10,<
IOWAIT:	SETOB	A,B		;LOOK FOR ALL FLAG BITS
	PUSHJ	P,IOCNSO(R)	;ANYTHING THERE?
	  POPJ P,0		;NO SUCH DEVICE AT ALL
	MOVEI	B,^D50000	;TIMEOUT
	MOVEI	A,10		;DONE FLAG, ALL KONTROLLERS
	PUSHJ	P,IOCNSO(R)	;LOOK FOR DONE
	SOJG	B,.-2(R)	;NOT YET. COUNT DOWN AND LOOP
	POPJ	P,0		;DONE OR TIMED OUT.
>;END IFE FTKS10
;ROUTINE TO READ A BLOCK FROM THE DEVICE KONTROLLER AND UNIT IN
;CTYPE AND CUNIT INTO THE BUFFER AT (A)+1, FROM LOGICAL BLOCK NUMBER
;IN LBN. SKIP RETURN IF SUCCESSFUL, NON-SKIP IF ANY HARDWARE ERRORS

;SUBROUTINE TO READ NEXT BLOCK OF DATA INTO DBUF

RDDATA:
IFN FTSAVE,<
	SKIPGE	LENGTH(R)	;ANY DATA LEFT?
	POPJ	P,0		;NO.
	MOVNI	A,200		;SEE IF ANY LEFT
	ADDB	A,LENGTH(R)	;COUNT FILE SIZE DOWN
>;END IFN FTSAVE
REDDIR:	PUSHJ	P,SELBLK(R)	;SELECT NEXT DATA BLOCK OF FILE
	  POPJ	P,0		;NONE LEFT.
RDDBUF:
IFE FT22BIT,<
	MOVEI	K,DBUF-1(R)	;SELECT DATA BUFFER
				;FALL INTO RDBLK
>;END IFE FT22BIT
IFN FT22BIT,<
	MOVEI	K,DBUFOS-1	;OFFSET INTO DATA PAGE OF DATA BUFFER
>;END IFN FT22BIT
REDBLK:
;	PJRST	RDBLK(R)	;READ THE BLOCK AND RETURN
				; SKIP RETURN IF NO ERROR
RDBLK:	PJSP	B,SETCHN(R)	;SETUP CHANNEL CONTROL WORD AND CALL
				; PROPER READ ROUTINE BELOW DEP. ON TYPE

IFN FTFHD,<
	Z	FHDRED(R)	;RC10
	Z	FHDRED(R)	;SECOND FHD
>;END IFN FTFHD
IFN FTDHX,<
	Z	DHXRED(R)	;RH10/RP04 OR RH20/RP04
	Z	DHXRED(R)	;RH10/RP04 OR RH20/RP04
IFN FTRH20,<IFE WTBOOT,<
	DEFINE	A(Q)<
	Z	DHXRED(R)	;RH20/RP04
>
	RH20
>>
>;END IFN FTDHX
IFN FTRH11,<
	Z	RHIRED(R)	;RH11
>;IFN FTRH11
IFN FTDPC,<
	Z	DPCRED(R)	;RP10
	Z	DPCRED(R)	;SECOND RP10
>;IFN FTDPC
;ROUTINE TO WRITE A BLOCK AT LOGICAL BLOCK NUMBER IN LBN,
; ON DEVICE IN CTYPE AND CUNIT, WRITING FROM BUFFER AT (A)+1
; SKIP RETURN IF SUCCESSFUL.

WRDATA:
IFE FT22BIT,<
	MOVEI	K,DBUF-1(R)	;SET TO WRITE FROM DATA BUFFER
				;FALL INTO WRBLK
>;END IFE FT22BIT
IFN FT22BIT,<
	MOVEI	K,DBUFOS-1	;OFFSET INTO DATA PAGE OF THE DATA BUFFER
>;END IFN FT22BIT
WRTBLK:	PUSHJ	P,SELBLK(R)	;GET NEXT BLOCK OF FILE
	  ERROR.	(EREFO%)	;NOT POSSIBLE

	PJSP	B,SETCHN(R)	;SETUP CHANNEL CONTROL WORD AND CALL
				; PROPER WRITE ROUTINE BELOW DEP. ON TYPE

IFN FTFHD,<
	Z	FHDWRI(R)	;RC10
	Z	FHDWRI(R)	;SECOND RC10
>;END IFN FTFHD
IFN FTDHX,<
	Z	DHXWRT(R)	;RH10/RP04
	Z	DHXWRT(R)	;RH10/RP04
IFN FTRH20,<IFE WTBOOT,<
	DEFINE	A(Q)<
	Z	DHXWRT(R)	;RH20/RP04
>
	RH20
>>
>;END IFN FTDHX
IFN FTRH11,<
	Z	RHIWRI(R)	;RH11
>;IFN FTRH11
IFN FTDPC,<
	Z	DPCWRI(R)	;RP10
	Z	DPCWRI(R)	;SECOND RP10
>;IFN FTDPC
;SUBROUTINE TO SETUP CHANNEL, THEN DISPATCH TO DEVICE DEP ROUTINE
;CALL:	MOVEI K,ABS. ADR. OF FIRST DATA WORD-1
;	HRRI B,ABS. ADR. OF FIRST WORD IN DISPATCH TABLE
;	PUSHJ P,SETCHN
;	ERROR RETURN
;	OK RETURN

SETCHN:	ADD	B,TTYPE(R)	;GET ADDRESS OF CONTROLLER ROUTINE
IFE FTRH2W!FTKS10,<
	MOVE	C,[CONI C](R)	;READ THE CONI BITS
	PUSHJ	P,IOXCT(R)	; ..
IFN FT22BIT,<
	ADD	K,IOWEVA+BOOTSP	;PHYSICAL ADDRESS
	TDNN	C,DFBIT(R)	;A DF10C IN 22 BIT MODE?
	TLNN	K,-1		;NO, GREATER THAN AN 18 BIT ADDRESS REQUESTED?
	TLOA	K,774000	;NO, 200 WORDS 22 BIT STYLE
	POPJ	P,		;YES, FAIL
	TDNN	C,DFBIT(R)	;18 BIT MODE DF10C OR A DF10?
>;END IFN FT22BIT
IFE FT22BIT,<
IFN FTRH20,<
	SKIPGE	DFBIT(R)	;RH20?
	JRST	SETCH1(R)	;YES, DO IT DIFFERENTLY
>;END IFN FTRH20
	TDNE	C,DFBIT(R)	;A DF10C IN 22 BIT MODE?
	TLOA	K,774000	;YES, -200 22 BIT STYLE
>;END IFE FT22BIT
	TLO	K,777600	;YES, 200 WORDS 18 BIT STYLE
	MOVEM	K,BOOTWD	;STORE COMMAND
	SETZM	BOOTWD+1	;ALSO CLEAR FINAL CONTROL WORD ADDR
IFN FTRH20,<
	JRST	SETCH2(R)
>;END IFN FTRH20
>;END IFE FTRH2W!FTKS10
IFN FTRH20,<
SETCH1:
IFN WTBOOT,<
	ADD	K,IOWEVA+BOOTSP	;PHYSICAL ADDRESS
>;END IFN WTBOOT
	ADDI	K,1
	TLO	K,604000	;200 WODS, TRA + LAST
	MOVEM	K,LOWCMD+IOWEVA	;STORE IT
IFN WTBOOT,<
	MOVE	A,[200000,,LOWCMD](R)
	MOVEM	A,BOOTVA+RH2-540 ;SET UP A JUMP TO THE IOWD
	MOVEM	A,BOOTVA+RH22-540 ; DONT TEST, JUST STORE FOR EITHER RH20
>;END IFN WTBOOT
SETCH2:>;END IFN FTRH20
IFN FTKS10,<
	SETZ	C,		;CLEAR C
	DPB	F,[POINT 7,C,17](R) ;UBA # IN RIGHT SPOT
IFN WTBOOT&FT22BIT,<
	ADD	K,IOWEVA+BOOTSP	;PHYSICAL ADDRESS
>;END IFN WTBOOT&FT22BIT
	ADDI	K,1		;BUMP UP TO FIRST DATA WORD
	ROT	K,W2PLSH	;CONVERT TO PAGE ADDRESS
	TRO	K,140000	;SET FAST XFER AND VALID
	WRIO	K,UBAMAP(C)	;MAP FIRST PAGE
	LSH	K,-^D36+2-W2PLSH ;PDP11 (BYTE) ADR
	WRIO	K,RPBA(C)	; TO BUS ADDRESS REG
	MOVEI	A,-400		;WORD COUNT
	WRIO	A,RPWC(C)	; TO WORD COUNT REG
>;IFN FTKS10
	SKIPG	A,LBN		;GET AND CHECK BLOCK NUMBER
	ERROR.	(ERIBZ%)	;SHOULD BE .GT. 0
	PJRST	@(B)		;CALL DISPATCH ENTRY AS A SUBROUTINE RETURN
IFN FTFHD,<
;WRITE AND READ FROM RC10. LBN IS IN A, CHANNEL IS SET UP FOR ONE BLOCK (128 WDS)
;R.TYPE=0 IF RD10, 1 IF RM10B. UNIT NUMBER IS IN TUNIT, AND IS
;ASSUMED LEGAL.
;NOTE:	AN RD10 DISK HAS 200. TRKS OF 80. SECT OF 32. WDS =4000.*128. WDS
;	AN RM10B DRUM HAS 90. TRKS OF 60. SECT OF 64. WDS =2700.*128. WDS

FHDWRI:	PUSHJ	P,FHDCNV(R)	;SET UP DATAO WORD
	TROA	N,FH.WRT	;MAKE IT A WRITE COMMAND
FHDRED:	PUSHJ	P,FHDCNV(R)	;SET UP DATAO WORD WITH ITS BCD STUFF
	MOVE	C,[DATAO N](R)	;SET UP DATAO TO RC10
	PUSHJ	P,IOXCT(R)	;DO THE DATAO TO RIGHT DEVICE
	PJRST	DPCWAT(R)	;WAIT FOR IO AND CHECK ERRORS
				; SKIP RETURN IF NO ERRORS.

FHDCNV:	MOVEI	C,^D20		;ASSUME RD10
	TRNE	F,R.TYPE	;WHICH IS IT?
	MOVEI	C,^D30		;RM10B
	IDIVI	A,0(C)		;A_TRACK, B_#OF 128 WORD SECTOR ON TRK
	PUSH	P,B		;SAVE SECTOR*N
	IDIVI	A,12		;CONVERT TO BCD
	CAIL	A,12		;..
	ADDI	A,6		; ..
	LSH	A,4		;POSITION TRACK ADR
	IOR	A,B		;BOTH DIGITS
	ROT	A,-13		;TO PLACE FOR DATAO
	EXCH	A,0(P)		;SAVE ON STACK. GET SECTOR ADDR
	LSH	A,1		;TO 64. WD "SECTORS"
	TRNN	F,R.TYPE	;RD10?
	LSH	A,1		;YES. MAKE IT 32. WD SECTORS
	IDIVI	A,12		;NOW CONVERT TO BCD
	LSH	A,4		;SHIFT HIGH DIGIT LEFT
	IOR	A,B		;OR IN LOW DIGIT
	HRLZS	A		;POSITION FOR DATAO
	IORM	A,0(P)		;STORE SECTOR
	MOVE	A,TUNIT(R)	;GET UNIT NUMBER
	ROT	A,-2		;POSITION FOR RC10 DATAO
	IORM	A,0(P)		;COMPLETE WORD
	POP	P,N		;RESTORE TO AN AC
	TRO	N,LOWCMD	;PUT IN CHANNEL ADDRESS
	POPJ	P,0		;DONE AT LAST
>;END IFN FTFHD
IFN FTDHX,<
;READ AND WRITE ROUTINES FOR RH10/RP04

DHXRED:	TLOA	N,DH.RED
DHXWRT:	HRLI	N,DH.WRT
IFN FTRH20,<
	MOVEI	A,410		;CLEAR DONE, ELSE IT MIGHT STAY ON WITH BUSY
IFE WTBOOT,<
	TRNE	F,100
>
	PUSHJ	P,IOCONO(R)	; THUS FOOLING IOWAIT INTO RETURNING EARLY
	MOVE	A,LBN		;RESTORE BLOCK NUMBER
>;END IFN FTRH20
	IDIVI	A,^D380
	HRLI	A,124000(N)
	PUSHJ	P,IODTO(R)	;DESIRED CYLINDER
	IDIVI	B,^D20
	DPB	B,[POINT 5,C,27](R)
	TLC	A,170000
	HRR	A,C
	PUSHJ	P,IODTO(R)	;DESIRED SECTOR, SURFACE
	MOVS	A,N
IFE FTRH20,<
	TDO	A,[404000,,200000!LOWCMD_6](R)
>
IFN FTRH20,<
IFE WTBOOT,<
	TRNN	F,100		;RH20?
	TDOA	A,[404000,,200000!LOWCMD_6](R)
>;END IFE WTBOOT
	TDO	A,[716400,,377700](R)
>
	PUSHJ	P,IODTO(R)	;START THE IO
	PUSHJ	P,IOWAIT(R)
	JUMPLE	B,CPOPJ(R)
	MOVSI	A,10000(N)
	PUSHJ	P,IODTI(R)	;READ STATUS REGISTER
	TRNE	A,40000
	POPJ	P,
IFE FTRH20,<
	MOVEI	A,736320
>
IFN FTRH20,<
	MOVEI	A,515000
IFE WTBOOT,<
	TRNN	F,100		;IF AN RH10
	MOVEI	A,736320	; TEST THESE BITS INSTEAD
>;END IFE WTBOOT
>;END IFN FTRH20
	PJRST	IOCNSZ(R)
>;END IFN FTDHX
IFN FTRH11,<
;READ AND WRITE RH11 WITH RP04/6 OR RM03
; RP04'S HAVE 20 BLOCKS/TRACK; 19 TRACKS/CYLINDER; 411 CYLINDERS/DRIVE
; RM03'S HAVE 30 BLOCKS/TRACK; 5 TRACKS/CYLINDER; 823 CYLINDERS/DRIVE
; R.TYPE=0 IF RP04/6, =1 IF RM03
; A/ LOGICAL BLOCK NUMBER
; C/ UNIBUS ADAPTER NUMBER IN LEFT HALFWORD (#,,0)

RHIRED:	TLOA	N,DH.RED	;READ FUNCTION CODE
RHIWRI:	HRLI	N,DH.WRT	;WRITE FUNCTION CODE
	PUSH	P,N		;NEED A TEMP...SAVE N
	MOVEI	N,^D20*^D19	;ASSUME RP04/6
	TRNE	F,R.TYPE	;IS IT AN RM03?
	MOVEI	N,^D30*^D5	;YES--THEN SET PROPER DIVISOR
	IDIVI	A,(N)		;GET CYL NO. IN A, REMAINDER IN B
	WRIO	A,RPDC(C)	;SET CYLINDER TO USE
	MOVE	A,B		;COPY B TO A
	MOVEI	N,^D20		;ASSUME RP04/6
	TRNE	F,R.TYPE	;IS IT AN RM03?
	MOVEI	N,^D30		;YES--THEN SET PROPER DIVISOR
	IDIVI	A,(N)		;GET TRACK NO. IN A, SECTOR IN B
	LSH	A,^D8		;TRACK NO. TO LEFT BYTE
	IOR	B,A		;SECTOR NO. NOW IN RIGHT BYTE
	WRIO	B,RPDA(C)	;SEND TO RH11
	POP	P,N		;RESTORE N
	HLRZ	A,N		;FUNCTION TO RH(A)
	WRIO	A,RPCS1(C)	;START THE TRANSFER
	MOVSI	A,1		;SET COUNTER
	RDIO	B,RPCS1(C)	;GET CONTROL REGISTER
	TRNN	B,200		;READY BIT SET YET?
	  SOJGE	A,.-2(R)	;NO--GO BACK AND TRY AGAIN
	JUMPL	A,CPOPJ		;LOSE IF WE TIMED OUT
	TRNE	B,140000		;ANY FATAL ERRORS?
	  POPJ	P,		;LOSE IF YES
	JRST	CPOPJ1(R)	;WIN IF NO
>;IFN FTRH11
IFN FTDPC,<
;READ AND WRITE ROUTINES FOR THE DISK PACKS

DPCRED:	TLOA	N,O.READ	;FUNCTION = READ
DPCWRI:	HRLI	N,O.WRIT	;FUNCTION WRITE
	IDIVI	A,12		;GET SECTOR NUMBER
	HRLZ	C,B		;SECTOR_6
	IDIVI	A,24		;GET SURF AND CYL
	DPB	B,PSURF(R)	;STORE SURFACE
	DPB	A,PCYL(R)	;STORE CYLINDER
	TRNE	A,400		;CYLINDER ABOVE 256?
	TLO	C,20		;EXTENDED - SET RIGHT BIT
	TRO	C,O.SEEK_3+LOWCMD_6(N)	;OP=SEEK, PLUS DRIVE NUMBER
	ROT	C,-6		;PUT EVERYTHING IN RIGHT POSITION
	MOVEM	C,DATAOW(R)	;AND SAVE DATAO
	TRNN	F,R.TYPE	;SKIP IT RP03
	CAIG	A,^D202		;NOT RP03, SKIP IF CYLINDER NOT ON DISK
	CAILE	A,^D405		;RP03 - SKIP IF OK
	ERROR.	(ERBLB%)	;TOO BIG A LBN
	PUSHJ	P,DPCOPR(R)	;DO THE SEEK
	  POPJ	P,		;ERROR RETURN
	HLLZ	A,N		;GET XOR MASK FOR READ OR WRITE
	XORM	A,DATAOW(R)	;TURN SEEK INTO READ OR WRITE
DPCOPR:	MOVE	C,[DATAO CLRATN(R)](R)	;SET UP DATAO
	PUSHJ	P,IOXCT(R)	;DO DATAO WITH RIGHT DEVICE
	HRRI	C,DATAOW	;NEW ADDRESS(R IN INDEX FIELD ALREADY)
	XCT	C		;SEND THIS WORD TOO

;FALL INTO DPCWAT

>;END IFN FTDPC
IFN FTDPC!FTFHD,<
;SUBROUTINE TO WAIT FOR IO AND CHECK ERRORS

DPCWAT:	PUSHJ	P,IOWAIT(R)	;WAIT FOR DONE FLAG OR TIMEOUT
	JUMPLE	B,CPOPJ(R)	;IF TIMED OUT, GIVE UP.
	MOVEI	A,177720	;ANY ERRORS?
				;FALL INTO IOCNSZ(SKIP RETURN IF GOOD)
>;END IFN FTDPC!FTFHD

IFE FTKS10,<
IOCNSZ:	SKIPA	C,[CONSZ 0(A)](R)	;SET UP I/O INSTR.
IOCNSO:	MOVSI	C,(CONSO (A))	;SETUP IO INSTR.
IOXCT:	DPB	F,[POINT 7,C,9](R)	;PUT IN I/O DEVICE FIELD
	XCT	C		;DO THE IO
	POPJ	P,		;NO SKIP RETURN
>;END IFE FTKS10
CPOPJ1:	AOS	(P)		;SKIP RETURN
CPOPJ:	POPJ	P,		;NO SKIP RETURN

IFN FTRH20,<
IOCONO:	MOVSI	C,(CONO (A))
	JRST	IOXCT(R)
>
;SUBROUTINE TO ZERO MEMORY

ZCORE:
IFN FT22BIT,<
	MOVE	M,HIPAGE(R)		;FIRST PAGE TO ZERO PLUS ONE
ZCORE1:	MOVEI	C,PM.ACC+PM.WRT-1(M)	;PAGE + ACCESSABLE + WRITABLE
	HRLM	C,MCORE(R)		;STORE MAP ENTRY
IFN FTKI10,<
	DATAO	PAG,BTEBR(R)		;CLEAR THE AM FOR NEW MAPPING
>
IFN FTKL10!FTKS10,<
	BLKO	PAG,COREVA		;CLEAR PAGING CACHE FOR THIS PAGE
>
	MOVE	A,[XWD COREVA,COREVA+1](R) ;SET UP BLT POINTER
	SOSG	M			;DECR PAGE, SKIP IF NOT PAGE ZERO
IFN FTKI10,<
	ADD	A,[40,,40](R)		;IF PAGE 0, ONLY CLEAR FROM 40 UP
>
IFN FTKL10!FTKS10,<
	ADJSP	A,40			;IF PAGE 0, ONLY CLEAR FROM 40 UP
>
	SETZM	-1(A)			;ZERO THE FIRST WORD OF BLT RANGE
	BLT	A,COREVA+777		;ZERO THE PAGE
	JUMPG	M,ZCORE1(R)		;BACK FOR NEXT PAGE IF NON-ZERO
	POPJ	P,			;ALL DONE
>;END IFN FT22BIT
IFE FT22BIT,<
	MOVEI	M,40			;CLEAR CORE FROM 40 UP
ZCORE2:	CAIL	M,CLRTOP(R)		;AT TOP OF CORE?
	  POPJ	P,			;YES--ALL DONE
	SETZM	(M)			;NO--CLEAR THIS WORD
	AOJA	M,ZCORE2(R)		;DO NEXT WORD
>;END IFE FT22BIT
;TTY I/O SUBRS

ERROR:	0
	SOS	ERROR(R)	;BACK UP TO THE JSR
IFN FTKI10,<
	LDB	C,[POINT 4,@ERROR(R),12](R) ;GET THE ERROR CODE
	DATAO	PI,C		;DISPLAY ERROR CODE ON CALL TO ERROR IN LIGHTS
>;END IFN FTKI10
				; OPERATOR MAY CONSULT LISTING FOR ERROR COMMENT
	MOVEI	C,207		;MAKE A BELL, EVEN PARITY
	PUSHJ	P,TYO(R)	;TYPE IT OUT
	MOVEI	C,077		;MAKE A QUESTION MARK, EVEN
	PUSHJ	P,TYO(R)	;TYPE IT OUT SO USER WILL SEE
IFN FTKL10!FTKS10,<
	LDB	C,[POINT 4,@ERROR(R),12](R)	;GET ERROR CODE
	ADDI	C,"A"		;A FOR FIRST ERROR, B FOR SECOND, ETC.
	PUSHJ	P,TYO(R)	;TYPE ERROR CHARACTER
>;END IFN FTKL10!FTKS10
	SETZM	BPPRS(R)	;NO AUTOMATIC STUFF AFTER AN ERROR
	JRST	REGO(R)		;AND RESTART.

IFE WTBOOT,<
PASCIZ:	HRLI	B,(<POINT 7,,>)	;FORM BYTE POINTER TO TEXT
PASCI1:	ILDB	C,B		;GET CHARACTER
	JUMPE	C,CPOPJ(R)	;EXIT IF DONE
	PUSHJ	P,TYO(R)	;TYPE IT OUT
	JRST	PASCI1(R)	;LOOP OVER ENTIRE STRING
>;END IFE WTBOOT

CRLF:	MOVEI	C,215		;CR, EVEN
	PUSHJ	P,TYO(R)	;TYPE IT.
	MOVEI	C,12		;LF, EVEN
TYO:
IFN FTKS10,<
	SKIPE	IOWEVA+CTYOWD	;CAN WE SEND NEXT CHAR?
	JRST	.-1(R)		;NOT YET
	IORI	C,CTYOVL	;SIGNAL VALID
	MOVEM	C,IOWEVA+CTYOWD	;PUT IT UP FOR THE 8080 TO FIND IT
	WRAPR	1B23!1B25	;WAKE THE 8080
	POPJ	P,0		;DONE
>;END IFN FTKS10
IFN FTKL10,<
	MOVEI	C,.DTMTO(C)	;GET CHAR IN LOW ORDER 8 BITS, COMMAND IN NEXT FOUR
	MOVEI	A,DTEMTD
DODTE:	SETZM	(A)		;CLEAR DONE FLAG
	MOVEM	C,DTECMD	;PUT INTO COMMAND LOCATION
	CONO	DTE,TO11DB	;RING DOORBELL
	SKIPN	(A)		;WAIT TILL MONITOR OUTPUT DONE
	JRST	.-1(R)		;LOOP
	POPJ	P,0		;DONE.
>;END IFN FTKL10

IFN FTKI10,<
	DATAO	TTY,C		;SEND OUT CHAR
	CONSZ	TTY,20		;WAIT FOR IDLE
	JRST	.-1(R)		; ..
	POPJ	P,0		;DONE.
>;END IFN FTKI10

SYSPPN:	XWD	1,4		;DEFAULT PROJ-PROG
SYSTEM:	SIXBIT	/SYSTEM/	;DEFAULT FILENAME
CRASH:	SIXBIT	/CRASH/		;DEFAULT DUMP NAME
IFN FTSAVE,<
BLTXWD:	XWD	40,41		;FOR CORE-CLEARING
>;END IFN FTSAVE
SIXPTR:	XWD	440600,W	;POINTER FOR SIXBIT NAME
IFN FT22BIT,<
MAPACS:
IFN FTKI10,<
	DATAO	PAG,K		;NEW EXEC MAP
>;END IFN FTKI10
IFN FTKL10!FTKS10,<
	CONO	PAG,PG.EAT(K)	;NEW EXEC MAP, KL10  STYLE
>;END IFN FTKL10!FTKS10
	MOVSM	B,400000+MBOOTS-BOOTDT+140	;SETUP MAP IN CODE PAGE
IFN FTKI10,<
	SUBI	K,1		;POINT K AT CODE PAGE
	DATAO	PAG,K		;MAKE CODE PAGE THE EXCE MAP
	JRST	MAPPED(R)	;NOW ADDRESSABLE, DO SOMETHING USEFULL
>;END IFN FTKI10
IFN FTKL10!FTKS10,<
	HRRM	N,400000+MCORE-BOOTDT+140	;MAKE PAGE 0 ADDRESSABLE FOR IOWDS
	MOVEM	A,400000+MCORE1-BOOTDT+140
				;ALSO PAGE 1 AND WHAT BPPRS POINTS TO
				; DO IT HERE TO TAKE ADVANTAGE OF CONO PAG,
				; WHICH CLEARS PAGING MEMORY AND CAUSES NEW
				; MAPPING TO BE IN EFFECT
	CONO	PAG,PG.EAT-1(K)	;MAKE CODE PAGE THE EXEC MAP KL10 STYLE
	SOJA	K,MAPPED(R)	;POINT K AT DATA PAGE AND CONTINUE
>;END IFN FTKL10!FTKS10
MAPACL==.-MAPACS
>;END IFN FT22BIT

IFN FTDPC,<
PCYL:	POINT	8,C,13-6	;CYLINDER NUMBER FOR DATAO
PSURF:	POINT	5,C,18-6	;SURFACE NUMBER FOR DATAO
CLRATN:	XWD	500000,776	;CLEAR ATTENTION FLAGS.
>;END IFN FTDPC
IFE WTBOOT,<
PTXT:	BYTE	(7)	15,12,102,124,123,76,0
VTXT:	TMACR	(\VBOOTS,\EBOOTS,<ASCIZ "BOOTS V>,<
">)
>;END IFE WTBOOT
	LIT			;LIST THE LITERALS

IFN WTBOOT,<
	CROOM==CORE-1-.			;ROOM LEFT IN CODE PAGE
>
IFE WTBOOT,<
	CROOM==CORE-1-.-XSIZE+1000 	;ROOM LEFT IN CODE PAGE
>
IFN WTBOOT,<
	BLOCK	CROOM
>;END IFN WTBOOT
BPPRS:	POINT	0,0,0		;PRESET COMMAND POINTER (MUST BE 777XXX)
;MONITOR EXPECTS TO FIND DEVICE, FILE, EXT AND PPN HERE
U(DEVICE)
U(FNAME)
U(FEXT)
U(PPN)
IFN FTKL10&FT22BIT,<
U(DTEEPW)			;MUST BE 144 IN DATA PAGE
>;END IFN FTKL10&FT22BIT
U(SWITCH)
U(TTYPE)
U(TUNIT)
U(SLUNIT)
U(CLUCNT)
U(BLKCNT)
U(CLBN)
U(LENGTH)
U(DFBIT)
;CLEAR UP TO HERE ON A RESTART
U(PROGSA)
U(DATAOW)
U(HIPAGE)
IFN FTKI10&FT22BIT,<
U(BTEBR)
>;END IFN FTKI10&FT22BIT

;BUFFERS FOR HOME BLOCK, DATA, AND RIB
DBUFOS=ZZ-BOOTDT+140
UU(DBUF,200)
IOWEVA==0
BOOTVA==0
IFE WTBOOT,<
IFN FTRH20,<
IOWEVA==777000			;TOP PAGE TO MAP IOWDS
BOOTVA==776000			;PAGE 776 IS A 1-FOR-1 MAP
>;END IFN FTRH20
>;END IFE WTBOOT
IFN FT22BIT,<
U(MBOOTS,1)
IFL MBOOTS-CORE+2000-200,<PRINTX ?BOOTS PAGE MAP LOCATION OUT OF RANGE>
IFG MBOOTS-CORE+2000-377,<PRINTX ?BOOTS PAGE MAP LOCATION OUT OF RANGE>
BOOTVA==2000*<MBOOTS-CORE+2000>
U(MCORE,1)
IFN FTKL10!FTKS10,<
U(MCORE1,1)
>;END IFN FTKL10!FTKS10
COREVA==BOOTVA+2000
IFN FTKL10!FTKS10,<
IOWEVA==COREVA+1000
BPPEVA==IOWEVA+2000
>;END IFN FTKL10!FTKS10
IFE FTKL10!FTKS10,<
IOWEVA==0
>;END IFE FTKL10!FTKS10
>;END IFN FT22BIT
IFN FTKL10&FT22BIT,<
ZZ==BOOTDT+457-140		;RESERVE 444-456 FOR FRONT END
>;END IFN FTKL10&FT22BIT
HBUFOS=ZZ-BOOTDT+140
UU(HBUF,50)			;OVERLAP HOME BLOCK BUF WITH RIB
RBUFOS==ZZ-BOOTDT+140
UU(RBUF,200)

UU(PDL,13)
;THIS MUST COME AFTER THE LAST U OR UU AND BEFORE CRMMSG
UU(ZZMAX,0)
	DEFINE	CRMMSG(ROOM,PART),<
	PRINTX	[ROOM FREE LOCATIONS IN PART]
	>

IF1,< CRMMSG(\<777-ZZMAX-140+BOOTDT>,<DATA SEGMENT>)
	CRMMSG(\CROOM,<CODE AREA>)>

IFL CROOM,<PRINTX ?BOOTS CODE TOO LARGE>
IFG ZZMAX-BOOTDT-777+140,<PRINTX ?BOOTS DATA AREA TOO LARGE>
MBOOTL==BOOTSA-.	;MINUS LENGTH OF BOOTS CODE-WRITTEN BY WTBOOTS
IFE WTBOOT,<		;START ADR. IF ABSOLUTE PAPER TAPE
IFN FTRH20,<
	BLOCK	CROOM	 ;STEP TO NEXT PAGE
	DEFINE	A(Z)<
	200000,,LOWCMD
	BLOCK	3
	>
	RH20
	BLOCK	140	;STEP TO PAGE MAP
	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
REPEAT 177,<
	PT(ZZ)
	XLIST
	ZZ==ZZ+2
>
	LIST
	XWD	PM.ACC+PM.WRT+<CORE/1000>-2,PM.ACC+PM.WRT+0
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
>;END IFN FTRH20
	END	JRST GO
>
IFN WTBOOT,<		;NO START ADR. IF LOADED WITH WTBOOT
	END
>