Google
 

Trailing-Edge - PDP-10 Archives - cuspbinsrc_2of2_bb-fp63b-sb - 10,7/smfile/smfile.mac
There is 1 other file named smfile.mac in the archive. Click here to see a list.
;MAINDEC-10-SMFILE

MCNVER=2
DECVER=7

	XLIST
DEFINE	NAME	(MCNVER,DECVER),<

TITLE	SMFILE	DECSYSTEM 2020 DIAGNOSTICS FE-FILE PROGRAM, VER MCNVER,DECVER>
	LIST
	LALL

NAME	\MCNVER,\DECVER

	LOC	137
BYTE (3)0(9)MCNVER(6)0(18)DECVER
	RELOC

;*COPYRIGHT 1978,1979,1986
;*DIGITAL EQUIPMENT CORPORATION
;*MARLBORO, MASS. 01752

;*JOHN R. KIRCHOFF/TL

	NOSYM
	SEARCH	MONSYM,MACSYM
	.REQUI	REL:MACREL
	.REQUI	REL:MONSYM	;FOR DDT

INTERN	$CCLIN
EXTERN	K%INIT,S%INIT,S%CMND,S%ERR

EXTERN	SMPREB	;START ADDRESS OF DIAGNOSTIC PRE-BOOT
EXTERN	SMPEND	;END ADDRESS OF DIAGNOSTIC PRE-BOOT

IF2,<PRINTX	[STARTING PASS 2]>
SUBTTL	PARAMETERS

DEFINE	S,<;*********************************************************************>

S
;*DATA SWITCHES
S

NOPNT==	040000		;INHIBIT ALL PRINT/TYPE OUT (EXCEPT FORCED)
PNTLPT==020000		;PRINT ALL DATA ON LPT (DSK IN USER MODE)

;*AC USE

T1=1			;TEMPS
T2=2
T3=3
T4=4
T5=5
T6=6
T7=7
AC10=10
AC11=11
AC12=12
AC13=13
STPNTR=14		;STBUF STORE POINTER
FP=15			;STACK FRAME POINTER
CX=16			;CALL/RETURN TEMP
T16=16
P=17

A=	1
B=	2
C=	3
D=	4

AC0=	0
AC1=	1
AC2=	2
AC3=	3
AC4=	4
AC=	5
CHR=	6
CHR1=	7
LP=	10	;LINE CHAR POINTER
CNT=	15
INDX=	16
BYTE=	1
P1=	13
P2=	14
;*FE-FILE DIRECTORY DEFINTIONS

FEDIR=400000		;FE-DIR PAGE

FSP=	0		;FREE SPACE POINTER
FSL=	1		;FREE SPACE PAGE #,,LENGTH

MCP=	2		;MICROCODE POINTER
MCL=	3		;MICROCODE PAGE #,,LENGTH

MPBP=	4		;MONITOR PRE-BOOT POINTER
MPBL=	5		;MONITOR PRE-BOOT PAGE #,,LENGTH

DPBP=	6		;DIAGNOSTIC PRE-BOOT POINTER
DPBL=	7		;DIAGNOSTIC PRE-BOOT PAGE #,,LENGTH

BC1P=	10		;BOOTCHECK 1 POINTER
BC1L=	11		;BOOTCHECK 1 PAGE #,,LENGTH

BCKP=	12		;BOOTCHECK 2 PRE-BOOT POINTER
BCKL=	13		;BOOTCHECK 2 PRE-BOOT PAGE #,,LENGTH

MBOOTP=	14		;MONITOR BOOT POINTER
MBOOTL=	15		;MONITOR BOOT PAGE #,,LENGTH

DBP=	16		;DIAGNOSTIC BOOT POINTER
DBOOTL=	17		;DIAGNOSTIC BOOT PAGE #,,LENGTH

BCHKP=	20		;BOOTCHECK 2 POINTER
BCHKL=	21		;BOOTCHECK 2 PAGE #,,LENGTH

IFP0=	22		;INDIRECT FILE 0 POINTER
IFL0=	23		;INDIRECT FILE 0 PAGE #,,LENGTH

CRAM=	401000		;CRAM STORAGE, 12 PAGES WORTH

MPREBP=	415000		;MONITOR PRE-BOOT PAGE
DPREBP=	416000		;DIAGNOSTIC PRE-BOOT PAGE

CRMBC1=	417000		;BOOTCHECK 1 STORAGE, 12 PAGES WORTH

BCPREBP=433000		;BOOTCHECK 2 PRE-BOOT PAGE

WINDOW=	434000		;WINDOW PAGE

GENPAG=	435000		;

HOMPAG=	436000		;HOME BLOCKS READ INTO HERE
S
;*OPERATOR DEFINITIONS (NON-UUO'S)
S

OPDEF	GO	[PUSHJ	P,]	;SUBROUTINE CALL
OPDEF	RTN	[POPJ	P,]	;SUBROUTINE RETURN 
OPDEF	PUT	[PUSH	P,]	;PUT DATA ON PUSH LIST
OPDEF	GETIT	[POP	P,]	;GET DATA FROM PUSH LIST 
OPDEF	PJRST	[JRST	]	;JRST TO ROUTINE THAT RTN'S

S
;*SUBROUTINE INITIALIZATION CALL
S

OPDEF	PGMINT	[JSP	0,SBINIT]	;SUBROUTINE INITIALIZATION

S
;*HALTING UUO'S (A MORE GRACEFUL HALT THAN SIMPLY USING THE HALT INSTRUCTION).
S

OPDEF	FATAL	[37B8!15B12!4]	;FATAL PROGRAMMING HALT
OPDEF	ERRHLT	[37B8!14B12!4]	;PROGRAM ERROR HALT

S
;*TERMINAL INPUT UUO'S
S

OPDEF	TTICHR 	[37B8!0B12!3]	;TTY, INPUT ANY CHARACTER
OPDEF	TTIYES	[37B8!1B12!3]	;TTY, NORMAL RETURN Y
OPDEF	TTINO	[37B8!2B12!3]	;TTY, NORMAL RETURN N
OPDEF	TTIOCT	[37B8!3B12!3]	;TTY, INPUT OCTAL WORD
OPDEF	TTIDEC	[37B8!4B12!3]	;TTY, INPUT DECIMAL WORD
OPDEF	TTICNV	[37B8!5B12!3]	;TTY, INPUT CONVERTABLE WORD
OPDEF	TTLOOK	[37B8!6B12!3]	;TTY, KEYBOARD CHECK
OPDEF	TTALTM	[37B8!7B12!3]	;TTY, ALT-MODE CHECK
OPDEF	TTSIXB	[37B8!10B12!3]	;TTY, INPUT SIXBIT WORD
OPDEF	TTYINP	[37B8!11B12!3]	;TTY, IMAGE MODE INPUT
OPDEF	TTICLR	[37B8!12B12!3]	;TTY, CLEAR INPUT
S
;*TERMINAL OUTPUT UUO'S.
S

OPDEF	PNTA	[37B8!0B12!0]	;PRINT ASCII WORD
OPDEF	PNTAF	[37B8!0B12!1]	;PRINT ASCII WORD FORCED
OPDEF	PNTAL	[37B8!17B12!0]	;PRINT ASCIZ LINE
OPDEF	PNTALF	[37B8!17B12!1]	;PRINT ASCIZ LINE FORCED
OPDEF	PSIXL	[37B8!14B12!3]	;PRINT SIXBIT'Z LINE
OPDEF	PSIXLF	[37B8!15B12!3]	;PRINT SIXBIT'Z LINE FORCED
OPDEF	PNTMSG	[37B8!0B12!0]	;PRINT MESSAGE IMMEDIATE
OPDEF	PNTMSF	[37B8!1B12!0]	;PRINT MESSAGE IMMEDIATE FORCED
OPDEF	PSIXM	[37B8!2B12!0]	;PRINT SIXBIT'Z MSG IMMEDIATE
OPDEF	PSIXMF	[37B8!4B12!0]	;PRINT SIXBIT'Z MSG IMM FORCED
OPDEF	PNTCI	[37B8!0B12!0]	;PRINT CHARACTER IMMEDIATE
OPDEF	PNTCIF	[37B8!1B12!0]	;PRINT CHARACTER IMMEDIATE FORCED
OPDEF	PNTCHR	[37B8!12B12!0]	;PRINT CHARACTER
OPDEF	PNTCHF	[37B8!12B12!1]	;PRINT CHARACTER FORCED
OPDEF	PNT1	[37B8!1B12!0]	;PRINT ONE OCTAL DIGIT
OPDEF	PNT1F	[37B8!1B12!1]	;PRINT 1 OCTAL DIGIT FORCED	
OPDEF	PNT2	[37B8!2B12!0]	;PRINT TWO OCTAL DIGITS
OPDEF	PNT2F	[37B8!2B12!1]	;PRINT 2 OCTAL DIGITS FORCED	
OPDEF	PNT3	[37B8!3B12!0]	;PRINT THREE OCTAL DIGITS
OPDEF	PNT3F	[37B8!3B12!1]	;PRINT THREE OCTAL DIGITS FORCED	
OPDEF	PNT4	[37B8!4B12!0]	;PRINT FOUR OCTAL DIGITS
OPDEF	PNT4F	[37B8!4B12!1]	;PRINT FOUR OCTAL DIGITS FORCED
OPDEF	PNT5	[37B8!5B12!0]	;PRINT FIVE OCTAL DIGITS
OPDEF	PNT5F	[37B8!5B12!1]	;PRINT FIVE OCTAL DIGITS FORCED
OPDEF	PNT6	[37B8!6B12!0]	;PRINT SIX OCTAL DIGITS
OPDEF	PNT6F	[37B8!6B12!1]	;PRINT SIX OCTAL DIGITS FORCED
OPDEF	PNT7	[37B8!7B12!0]	;PRINT 7 OCTAL DIGITS
OPDEF	PNT7F	[37B8!7B12!1]	;PRINT 7 OCTAL DIGITS FORCED
OPDEF	PNT8	[37B8!10B12!0]	;PRINT 8 OCTAL DIGITS
OPDEF	PNT8F	[37B8!10B12!1]	;PRINT 8 OCTAL DIGITS FORCED
OPDEF	PNT11	[37B8!11B12!0]	;PRINT 11 OCTAL DIGITS
OPDEF	PNT11F	[37B8!11B12!1]	;PRINT 11 OCTAL DIGITS FORCED.
OPDEF	PNTADR	[37B8!10B12!0]	;PRINT PHYSICAL ADDRESS
OPDEF	PNTADF	[37B8!10B12!1]	;PRINT PHYSICAL ADDRESS FORCED
OPDEF	PNTOCT  [37B8!14B12!0]	;PRINT FULL WORD OCTAL
OPDEF	PNTOTF	[37B8!14B12!1]	;PRINT FULL WORD OCTAL FORCED
OPDEF	PNTHW	[37B8!13B12!0]	;PRINT OCTAL HALF WORDS, 6 SP 6
OPDEF	PNTHWF	[37B8!13B12!1]	;PRINT OCTAL HALF WORDS, 6 SP 6 FORCED
OPDEF	PNTOCS	[37B8!16B12!3]	;PRINT OCTAL, SUPPRESS LEADING 0'S
OPDEF	PNTOCF	[37B8!17B12!3]	;PRINT OCTAL, SUPPRESS LEADING 0'S FORCED
OPDEF	PNTDEC	[37B8!15B12!0]	;PRINT DECIMAL, SUPRESS LEADING 0'S
OPDEF	PNTDCF	[37B8!15B12!1]	;PRINT DECIMAL, SUPRESS LEADING 0'S FORCED
OPDEF	PNTDS	[37B8!16B12!0]	;PRINT DECIMAL, SPACES FOR LD 0'S
OPDEF	PNTDSF	[37B8!16B12!1]	;PRINT DECIMAL, SPACES FOR LD 0'S FORCED
OPDEF	PNTNM	[37B8!4B12!2]	;PRINT PROGRAM NAME
OPDEF	PNTSIX	[37B8!0B12!2]	;PRINT SIXBIT WORD
OPDEF	PNTSXF	[37B8!1B12!2]	;PRINT SIXBIT WORD FORCED
OPDEF	DROPDV	[37B8!5B12!2]	;CLOSE LOGICAL FILE, USER MODE
OPDEF	PCRL	[37B8!0B12!CRLF] ;PRINT CARRIAGE RETURN/LINE FEED
OPDEF	PCRLF	[37B8!1B12!CRLF] ;PRINT CARRIAGE RETURN/LINE FEED FORCED
OPDEF	PSP	[37B8!0B12!40]	;PRINT SPACE
OPDEF	PSPF	[37B8!1B12!40]	;PRINT SPACE FORCED
OPDEF	PSPACE	[37B8!1B12!40]	;PRINT SPACE FORCED
OPDEF	PTAB	[37B8!1B12!11]	;PRINT TAB FORCED
OPDEF	PCRL2	[37B8!0B12!CRLF2] ;PRINT CARRIAGE RETURN/LINE FEED (TWICE)
OPDEF	PCRL2F	[37B8!1B12!CRLF2] ;PRINT CARRIAGE RETURN/LINE FEED (TWICE) FORCED
OPDEF	PBELL	[37B8!1B12!7]	;PRINT TTY BELL

OPDEF	PFORCE	[37B8!1B12!26]	;PRINT FORCE, CONTROL O OVERRIDE

DEFINE	PMSG	(ARG),<
	PSIXM	[SIXBIT\ARG'_\]>

DEFINE	PMSGF	(ARG),<
	PSIXMF	[SIXBIT\ARG'_\]>

;*SIXBTZ -- MACRO TO GENERATE SIXBIT DATA FOR PRINTING
;*	CONSERVES CORE OVER ASCIZ

DEFINE	SIXBTZ	(ARG),<	[SIXBIT\ARG'_\]>

S
;*END OF PASS/PROGRAM UUOS
S

OPDEF	ENDUUO	[37B8!12B12!4]	;UUO TO DISPLAY LIGHTS
OPDEF	EOPUUO	[37B8!16B12!4]	;END OF PROGRAM UUO
SUBTTL	STANDARD PROGRAM ASSIGNMENTS

S
;*PDP-10 STANDARD PC CONTROL FLAGS (SAVED ON PUSHJ, JSR, ETC..)
S

AROV==	400000			;ARITHMETIC OVERFLOW
CRY0==	200000			;CARRY 0
CRY1==	100000			;CARRY 1
FOV==	40000			;FLOATING POINT OVERFLOW
BIS==	20000			;BYTE INTERRUPT
USERF==	10000			;USER MODE
EXIOT==	4000			;USER PRIV I/O
FXU==	100			;FLOATING POINT UNDERFLOW
DCK==	40			;DIVIDE CHECK

S
;*PDP-10 STANDARD ADDRESS ASSIGNMENTS
S

LUUO==	40			;UUO STORAGE, UUO 1-37
LUUOI==	41			;UUO SERVICE INSTRUCTION

S
;*JOB DATA AREA EXTERNALS (OLD DEFINITIONS)
S

JOBUUO==40
JOB41==	41
JOBREL==44
JOBDDT==74
JOBSYM==116
JOBUSY==117
JOBSA==	120
JOBFF==	121
JOBREN==124
JOBAPR==125
JOBCNI==126
JOBTPC==127
JOBOPC==130
JOBVER==137
S
;*JOB DATA AREA EXTERNALS (NEW DEFINITIONS)
S

.JBUUO==40
.JB41==	41
.JBREL==44
.JBDDT==74
.JBSYM==116
.JBUSY==117
.JBSA==	120
.JBFF==	121
.JBREN==124
.JBAPR==125
.JBCNI==126
.JBTPC==127
.JBOPC==130
.JBVER==137

S
;*USER MODE APR ASSIGNMENTS (FOR "APRENB" CALL)
S

PDLOVU==200000			;PUSHDOWN LIST OVERFLOW
MPVU==	20000			;MEMORY PROTECTION VIOLATION
NXMU==	10000			;NON-X-MEMORY
PARU==	4000			;PARITY ERROR
CLKU==	1000			;CLOCK
FOVU==	100			;FLOATING OVERFLOW
AROVU==	10			;ARITHMETIC OVERFLOW

S
;*USER MODE PRINT OUTPUT CHANNEL ASSIGNMENTS (FOR SUBROUTINE PACKAGE)
;*THE USER SHOULD BE CAUTIONED NOT TO USE THESE CHANNELS WHEN
;*USING THE SUBROUTINE PACKAGE AND CODING USER MODE PROGRAMS.
S

$DEVCH==17			;LOGICAL DEVICE CHANNEL

SUBTTL	MACROS

DEFINE	SCMTAB(NAME),<
NAME:	XWD	L.'NAME,L.'NAME

DEFINE	ECMTAB,<
	L.'NAME==.-NAME-1
>
>

DEFINE	CMTAB(CMD,ADR),<
	[ASCIZ "CMD"],,ADR
>

DEFINE	CMABR(ABBR,REST,ADDR),<
	[ASCIZ "ABBR"],,[ TLNN T1,(CM%ESC)
			  JRST ADDR
			  HRROI	T1,[ASCIZ "REST "]
			  SKIPN MONTYP
				JRST [HRRZ 1,1
				OUTSTR @1
				JRST ADDR]
			  PSOUT
			  JRST ADDR]
>

DEFINE	CMD(FUNC,ERR,%A),<
%A:!	XLIST
IFNB <ERR>,<
	MOVEI	T1,[ASCIZ "ERR"]
	MOVEM	T1,CMDMSG
>
IFB <ERR>,<
	SETZM	CMDMSG
>
	MOVEI	T1,CSB
	MOVEI	T2,FUNC
	SKIPN	MONTYP
	JRST	[GO 	S%CMND
		 JRST	.+3]
	COMND
	ERJMP	[PUSH P,[%A]
		 JRST CMJERR]
	TLNE	T1,(CM%NOP)
	GO	CMDERR
	LIST
>
DEFINE	NOISE(TEXT),<
	CMD	[FLDDB.(.CMNOI,,<-1,,[ASCIZ "TEXT"]>)],<EXPECTING TEXT>
>
DEFINE	CMDNOP(FUNC,ERR,%A),<
%A:!	XLIST
IFNB <ERR>,<
	MOVEI	T1,[ASCIZ "ERR"]
	MOVEM	T1,CMDMSG
>
IFB <ERR>,<
	SETZM	CMDMSG
>
	MOVEI	T1,CSB
	MOVEI	T2,FUNC
	SKIPN	MONTYP
	JRST	[GO 	S%CMND
		 JRST	.+3]
	COMND
	ERJMP	[PUSH P,[%A]
		 JRST CMJERR]
	TLNE	T1,(CM%NOP)
	LIST
>

DEFINE	ERR(TEXT),<
	GO	[HRROI	T1,[ASCIZ "TEXT"]
		 JRST	ERR%]
>

DEFINE	WARN(TEXT),<
	MOVEI	[ASCIZ "
% TEXT
"]
	PNTALF
>
DEFINE	MOVSLJ(AC,E),<
	EXTEND	AC,[EXP <016B8+<Z E>>]
>

DEFINE	MOVST(AC,E),<
	EXTEND	AC,[EXP <015B8+<Z E>>]
>

OPDEF	CONFIRM	[GO	CFMCMD]

DEFINE	OP$$AC(OP,ACLST),<
	XLIST
IRP ACLST,<
	OP	P,ACLST
>
	LIST
>

DEFINE	SAVEAC,<
	OP$$AC	PUSH,<T1,T2,T3,T4,T5,T6,FP,CX>
>

DEFINE	RESTAC,<
	OP$$AC	POP,<CX,FP,T6,T5,T4,T3,T2,T1>
>
SUBTTL	PROGRAM PARAMETERS

S
;*PROGRAM VARIABLE PARAMETER AREA
S

USER:	0		; 0 = EXEC, -1 = USER MODE FLAG
KAIFLG:	0		;PROCESSOR TYPE, 0 = KA10, -1 = KI10
KLFLG:	0		;PROCESSOR TYPE, 0 = KA/KI, -1 = KL10
MONFLG:	-1		;DIAG MONITOR SPECIAL USER FLAG
MONCTL:	0		;DIAG MON/SYS EXR FLAG
MONTEN:	0		;-1= LOADED BY 10
CONSW:	0		;CONSOLE SWITCH SETTINGS
PASCNT:	0		;PROGRAM PASS COUNT
ITRCNT:	0		;PROGRAM ITERATION COUNT
RUNFLG:	0		;PROGRAM RUN FLAG
TESTPC:	0		;SUBTEST PC
ERRPC:	0		;ERROR PC
ERRTLS:	0		;ERROR TOTALS
$ONETM:	0		;SUBROUTINE INITIALIZATION FLAG

S
;*SPECIAL PROGRAM DISPATCH ADDRESSES
S

CPOPJ1:			;SKIP RETURN
UUOSKP:	AOS	(P)	;SKIP RETURN FROM UUO
CPOPJ:			;NON-SKIP REGULAR RETURN
UUOEXT:	RTN		;UUO RETURN
$UUOER:	JFCL		;INITED AS (JRST $UOERX)

S
;*PROCESSOR CONTROL STORAGE
S

$ACC0:	0		;INTERRUPT SAVED AC0

$SVUUO:	0		;CURRENT USERS UUO
$SVUPC:	0		;PC OF CURRENT USERS UUO
S
;*UUO DISPATCH TABLE
S
	XLIST
IFNDEF	LUUO1,<LUUO1=$UUOER>
IFNDEF	LUUO2,<LUUO2=$UUOER>
IFNDEF	LUUO3,<LUUO3=$UUOER>
IFNDEF	LUUO4,<LUUO4=$UUOER>
IFNDEF	LUUO5,<LUUO5=$UUOER>
IFNDEF	LUUO6,<LUUO6=$UUOER>
IFNDEF	LUUO7,<LUUO7=$UUOER>
IFNDEF	LUUO10,<LUUO10=$UUOER>
IFNDEF	LUUO11,<LUUO11=$UUOER>
IFNDEF	LUUO12,<LUUO12=$UUOER>
IFNDEF	LUUO13,<LUUO13=$UUOER>
IFNDEF	LUUO14,<LUUO14=$UUOER>
IFNDEF	LUUO15,<LUUO15=$UUOER>
IFNDEF	LUUO16,<LUUO16=$UUOER>
IFNDEF	LUUO17,<LUUO17=$UUOER>
IFNDEF	LUUO20,<LUUO20=$UUOER>
IFNDEF	LUUO21,<LUUO21=$UUOER>
IFNDEF	LUUO22,<LUUO22=$UUOER>
IFNDEF	LUUO23,<LUUO23=$UUOER>
IFNDEF	LUUO24,<LUUO24=$UUOER>
IFNDEF	LUUO25,<LUUO25=$UUOER>
IFNDEF	LUUO26,<LUUO26=$UUOER>
IFNDEF	LUUO27,<LUUO27=$UUOER>
IFNDEF	LUUO30,<LUUO30=$UUOER>
IFNDEF	LUUO31,<LUUO31=$UUOER>
IFNDEF	LUUO32,<LUUO32=$UUOER>
IFNDEF	LUUO33,<LUUO33=$UUOER>
	LIST
UUODIS:	LUUO1,,$UUOER
	LUUO3,,LUUO2
	LUUO5,,LUUO4
	LUUO7,,LUUO6
	LUUO11,,LUUO10
	LUUO13,,LUUO12
	LUUO15,,LUUO14
	LUUO17,,LUUO16
	LUUO21,,LUUO20
	LUUO23,,LUUO22
	LUUO25,,LUUO24
	LUUO27,,LUUO26
	LUUO31,,LUUO30
	LUUO33,,LUUO32

S
;*PRINT CONTROL STORAGE
S

PNTFLG:	0		;PRINT FLAG, -1 WHILE IN PRINT ROUTINE
PNTENB:	0		;PRINT ENABLE
PDISF:	0		;PRINT DISABLED FLAG
PNTINH:	0		;INHIBIT PRINT INPUT CHECKS
PNTSPC:	0		;PRINT SPACE CONTROL
OPTIME:	0		;TYPE-IN WAIT TIME
$TWCNT:	0		;TIME WAITED
$DVOFF:	0		;LOGICAL DEVICE INITED FLAG
$TTCHR:	0		;ACTUAL TYPED IN CHAR
$CHRIN:	0		;UPPER CASED & PARITY STRIPPED CHAR
$TYPNB:	0		;TYPED IN NUMBER
$CRLF:	0		;FREE CR/LF FLAG
$TABF:	0		;TAB CONVERSION FLAG
$FFF:	0		;FORM FEED CONVERSION FLAG
$VTF:	0		;VERTICAL TAB CONVERSION FLAG
USRLFF:	0		;USER LF FILLERS
USRCRF:	0		;USER CR FILLERS
CRLF:	ASCII/
/
CRLF2:	ASCII/

/
RADIX:	^D10			;DECIMAL PRINT RADIX
RADLSP:	40			;DECIMAL PRINT LEADING CHAR
RADLSC:	^D10			;DECIMAL PRINT LEADING CHAR COUNT

S
;*USER MODE OUTPUT FILE INFORMATION
S

$OBUF:	BLOCK	3		;LOGICAL FILE OUTPUT BUFFER HEADER
$OUTNM:	SIXBIT	/PRINT/		;FILE NAME
$OUTEX:	SIXBIT	/PNT/		;FILE NAME EXTENSION
	BLOCK	2

S
;*PUSHDOWN LIST CONTROL INFORMATION
S

PLIST:	PLIST-PLISTE,,PLIST
PLISTS:	BLOCK	200
PLISTE:	0		;END OF PUSHDOWN LIST

S
;*NUMBER INPUT DIGIT FLAG
S

TTNBRF:	0	;-1 IF ANY DIGIT TYPED

S
;*USER MODE MONITOR TYPE FLAG
S

MONTYP:	0	;0 = TOPS10, -1 = TOPS20

S
;*SPECIAL USERS USER MODE OUTPUT ERROR INTERCEPT INSTUCTION
S

$$OUTER:0	;IF NON-ZERO, XCT'D AT END OF USER MODE ERROR

S
;*"SWITCH" CALL USAGE CONTROL
S

$$TOGGLE:0	;IF NON-ZERO, USE C(CONSW) FOR SWITCHES

S
;*SM10 (KS-10) PROCESSOR TYPE FLAG
S

SM10:	0	;IF -1 THIS IS A KS-10

SALL
SUBTTL	FIXED DATABASE

EV:	JRST START
	JRST REEN
	BYTE (3)0(9)MCNVER(6)0(18)DECVER

PROMPT:	ASCIZ	"SMFILE>"

CMDFNC:
REPEAT 0,<
	FLDBK.	(.CMKEY,,MAINCM,,,[BRMSK.(KEYB0.,KEYB1.,KEYB2.,KEYB3.,\"32)])
>
REPEAT 1,<
	FLDDB.	(.CMKEY,,MAINCM)
>
	SCMTAB	MAINCM

REPEAT 0,<
	CMTAB	\"32,.EXIT1
>
	CMABR	D,EPOSIT,DEP
	CMABR	DE,POSIT,DEP
	CMTAB	DEBUG,SETDEB
	CMTAB	DEPOSIT,DEP

	CMABR	E,XAMINE,EXAM
	CMTAB	ECHO,ECHO
	CMABR	EX,IT,.EXIT
	CMTAB	EXAMINE,EXAM
	CMTAB	EXIT,.EXIT

	CMTAB	HELP,HELP

	CMTAB	INFORMATION,INFORM

	CMTAB	OUTPUT,OUTX

	CMTAB	PUSH,PUSHCM

	CMTAB	RDBC1,RDBC1
	CMTAB	READ,READ

	CMTAB	SERIAL,SERIAL

	CMTAB	TAKE,TAKE
	CMTAB	TYPE,.TYPE

	CMTAB	WRITE,WRITE

	ECMTAB

INIT:	FLDDB.	.CMINI
CFM:	FLDDB.	.CMCFM
SUBTTL	INIT PROGRAM

START:	PGMINT

	SETZM	PNTSPC		;NO SPACES AFTER NUMBERS
	MOVEI	16,1		;CLEAR AC'S
	SETZB	0,FIRZER	;AND LOW CORE
	BLT	16,16
	MOVE	T1,[FIRZER,,FIRZER+1]
	BLT	T1,ENDZER	;ZAP!

	MOVE	T1,[.PRIIN,,.PRIOU]
	MOVEM	T1,CSB+.CMIOJ

	SKIPE	MONTYP
	JRST	START1

	OUTSTR	[ASCIZ/[FOR HELP TYPE "HELP"]
/]
	GO	CONCIN		;INIT ^C INTERRUPT
	GO	S%INIT		;INIT SCANNING MODULE
	GO	K%INIT		;INIT KEYBOARD MODULE
	GO	T$INT		;INIT SPECIAL SUBRTN INPUT
	GO	INTCOR		;INIT CORE FOR CRAM STORE
	JRST	NEXT
START1:	TMSG	<[FOR HELP TYPE "HELP"]
>
	MOVEI	T1,.FHSLF
	RPCAP			;GET CURRENT CAPABILITIES
	ERMSG	<RPCAP FAILED>
	TLO	T3,(SC%CTC+SC%GTB)
	EPCAP
	ERMSG	<EPCAP FAILED>

	MOVEI	T1,.FHSLF	;THIS FORK
	MOVE	T2,[LEVTAB,,CHNTAB]
	SIR
	ERMSG	<CAN NOT SET ADDRESS OF LEVTAB AND CHNTAB>

	MOVE	T1,[.TICCX,,^D30]
	ATI
	ERMSG	<CAN NOT ENABLE CONTROL-X>

	MOVE	T1,[.TICCC,,^D31]
	ATI
	ERMSG	<CAN NOT ENABLE CONTROL-C>

	MOVE	T1,[.TICCZ,,^D32]
	ATI
	ERMSG	<CAN NOT ENABLE CONTROL-Z>

	MOVE	T1,[.TICCT,,^D33]
	ATI
	ERMSG	<CAN NOT ENABLE CONTROL-T>

	MOVE	T1,[.TICCo,,^D34]
	ATI
	ERMSG	<CAN NOT ENABLE CONTROL-o>

	MOVEI	T1,.FHSLF
	MOVEI	T2,1B19+1B30+1B31+1B32+1B33+1b34
	AIC
	ERMSG	<AIC FAILED>

	EIR
	ERMSG	<EIR FAILED>

	JRST	NEXT		;JOIN MAIN LOOP
SUBTTL	MAIN LOOP

CMDERR:	SKIPN	MONTYP
	JRST	CMDE10
	PUSH	P,T2
	MOVEI	T1,.FHSLF
	GETER
	ERMSG	<CMDERR: GETER FAILED>
	TLZ	T2,-1
	CAIN	T2,IFIXX3
	JRST   [POP P,T2
		RET]

	SKIPN	CMDMSG
	JRST	.+6

	HRROI	T1,[ASCIZ "
?COMMAND ERROR: "]
	PSOUT
	HRRO	T1,CMDMSG
	PSOUT
	JRST	REEN

	HRROI	T1,[ASCIZ "
?JSYS ERROR: "]
	PSOUT
	MOVEI	T1,.PRIOU
	HRLOI	T2,.FHSLF
	MOVEI	T3,0
	ERSTR
	  ERJMP	.
	  ERJMP	.
	JRST	REEN
CMDE10:	SKIPN	CMDMSG
	JRST	.+5
	OUTSTR	[ASCIZ/?COMMAND ERROR: /]
	OUTSTR	@CMDMSG
	OUTSTR	[ASCIZ/
/]
	JRST	REEN
	GO	S%ERR		;REPORT SCANNER ERROR
	JRST	REEN

ERR%:	SKIPN	MONTYP
	JRST	ERR%10
	ESOUT
	TMSG	< - ERROR AT PC >
	HRRZ	(P)
	SOS
	PNTOCF
	TMSG	<
>
	JRST	REEN
ERR%10:	TTCALL	13,0
	JFCL
	HRRZ	1,1
	OUTSTR	[ASCIZ/?/]
	OUTSTR	@1
	OUTSTR	[ASCIZ/ - ERROR AT PC /]
	HRRZ	(P)
	SOS
	PNTOCF
	OUTSTR	[ASCIZ/
/]
	CLRBFI
	SETZM	CCBLK+2
	JRST	REEN

T$INT:	MOVE	[GO	$$TT0]
	MOVEM	$$$TT0
	MOVE	[GO	$$TT1]
	MOVEM	$$$TT1
	RTN

$$TT0:	INCHRW	$TTCHR
	MOVE	$TTCHR
	CAIE	"Z"-100
	PNTCHR
	RTN

$$TT1:	INCHRW
	PNTCHR
	RTN
REEN:	MOVE	T1,[.PRIIN,,.PRIOU]
	MOVEM	T1,CSB+.CMIOJ

NEXT:	SETZM	CTADR
	HRROI	T1,CMDBUF
	MOVEM	T1,CSB+.CMBFP
	MOVEM	T1,CSB+.CMPTR
	MOVEI	T1,^D250
	MOVEM	T1,CSB+.CMCNT
	MOVEM	T1,CSB+.CMABC
	HRROI	T1,ATOM
	MOVEM	T1,CSB+.CMABP

	CMD	INIT

PARSE:	MOVE	P,PLIST
	MOVEI	T1,PARSET
	MOVEM	T1,CTADR

	CMD	CMDFNC,<NOT A VALID COMMAND>

	SETZM	CTADR
	HRRZ	T4,(T2)		;GET DISPATCH ADDRESS
	GO	(T4)		;PROCESS COMMAND

	JRST	NEXT
;*HERE ON AN ERROR FROM COMMAND JSYS

CMJERR:	MOVEI	T1,.FHSLF
	GETER
	ERMSG	<GETER FAILED>
	TLZ	T2,-1
	CAIE	T2,IOX4
	CALL	JSHLT0

EOCF:	MOVEI	[ASCIZ "
	[END OF COMMAND FILE]
SMFILE>"]
	PNTALF
	HLRZ	T1,CSB+.CMIOJ
	CLOSF
	ERR	<CAN NOT CLOSE COMMAND FILE>
	MOVE	T1,[.PRIIN,,.PRIOU]
	MOVEM	T1,CSB+.CMIOJ
	SETZM	INTAKE
	RTN

;*COMMAND PARSER SUBROUTINES

CFMCMD:	CMD	CFM,<MUST END LINE WITH RETURN>
	HLRZ	T1,CSB+.CMIOJ
	CAIN	T1,.PRIIN
	JRST	CFMCM1
	MOVEI	CMDBUF
	SKIPGE	ECOFLG
	PNTALF
	RET
CFMCM1:	MOVEI	CMDBUF
	SKIPE	$DVOFF		;LOGGING ?
	PNTAL
	RTN

SIXOUT:	MOVE	AC12,[POINT 6,AC11]
	MOVEI	AC13,6
	ILDB	AC12
	ADDI	40
	PNTCHF
	SOJG	AC13,.-3
	RTN
SUBTTL	COMMANDS -- INFORMATION

	SCMTAB	INFO
	CMTAB	DISK,IDISK
	CMTAB	FEFILE,IFEFILE
	CMTAB	FREE,IFREE
	CMTAB	INDIRECT,FETELL
	ECMTAB

INFORM:	CMD	[FLDDB.(.CMKEY,,INFO)],<NO INFORMATION ABOUT THAT>
	HRRZ	T1,(T2)
	PUT	T1
	CONFIRM
	GETIT T1
	JRST	(T1)

IFREE:	SKIPN	MONTYP
	JRST	IFREE10
	SKIPN	FESETF
	ERR	<FE-FILE SYSTEM NOT SETUP>

	PMSG	<^FRONT-END FREE PAGES = >

	HRRZ	FEDIR+FSL
	PNTDCF

	PCRLF
	PCRLF
	RTN

IFREE10:PMSGF	<N/A - TOPS-10^>
	RTN
IFEFILE:SKIPN	FESETF
	ERR	<FE-FILE SYSTEM NOT SETUP>

	SKIPN	MONTYP
	JRST	IFEF10

	PMSGF	<^DISK ADDRESS IN HOME BLOCK = >
	MOVE 	HOMPAG+200+101
	PNTHWF

	PMSGF	<^LENGTH IN HOME BLOCK =       >
	MOVE	HOMPAG+200+102
	PNTHWF

	PMSGF	<^8080 POINTER IN HOME BLOCK = >
	MOVE	HOMPAG+200+103
	PNTHWF

	PCRLF
	PCRLF
	RTN

IFEF10:	PMSGF	<^DISK ADDRESS IN HOME BLOCK = >
	MOVE 	HOMBUF+101
	PNTHWF

	PMSGF	<^LENGTH IN HOME BLOCK =        >
	MOVE	HOMBUF+102
	PNTHWF

	PMSGF	<^8080 POINTER IN HOME BLOCK = >
	MOVE	HOMBUF+103
	PNTHWF

	PCRLF
	PCRLF
	RTN
IDISK:	SKIPN	FESETF
	ERR	<FE-FILE SYSTEM NOT SETUP>

	SKIPN	MONTYP
	JRST	IDSK10		;TOPS-10

	HRROI	T1,STBUF
	HRRZ	T2,FEJFN
	MOVSI	T3,(1B2)
	JFNS
	ERMSG	<CAN NOT GET STRUCTURE NAME>

	PMSGF	<^USING >
	MOVEI	STBUF
	PNTALF			;PRINT STRUCTURE

	PTAB

	MOVE	T1,DSKTYP
	CAIN	T1,.MSRP4
	PMSGF	<RP04>
	CAIN	T1,.MSRP5
	PMSGF	<RP05>
	CAIN	T1,.MSRP6
	PMSGF	<RP06>
	CAIN	T1,11
	PMSGF	<RM03>

	PCRLF
	PCRLF
	RTN

IDSK10:	PMSGF	<^USING >
	MOVE	DIRDEV
	PNTSXF			;PRINT STRUCTURE

	PTAB

	MOVE	T1,DSKTYP
	CAIN	T1,.DCUR4
	PMSGF	<RP04>
	CAIN	T1,.DCUR6
	PMSGF	<RP06>
	CAIN	T1,.DCUR3
	PMSGF	<RM03>

	PCRLF
	PCRLF
	RTN
SUBTTL	COMMANDS -- PUSH

PUSHCM:	NOISE	<COMMAND LEVEL>
	CONFIRM
	SKIPN	MONTYP
	JRST	PUSH10

	MOVSI	T1,(GJ%SHT)
	HRROI	T2,[ASCIZ "PS:<SYSTEM>EXEC.EXE.0"]
	GTJFN
	ERMSG	<CAN NOT GET JFN ON EXEC>

	HRRZM	T1,EXJFN#
	MOVSI	T2,(CR%CAP)
	CFORK
	ERMSG	<CAN NOT CREATE AN EXEC FORK>

	HRRZM	T1,EXFORK#
	HRLZ	T1,T1
	HRR	T1,EXJFN
	GET
	ERMSG	<CAN NOT GET EXEC>

	HRRZ	T1,EXFORK
	MOVEI	T2,0
	SFRKV
	ERMSG	<CAN NOT START EXEC>

	WFORK
pushpc:	ERMSG	<PUSH: WFORK ERROR>

	KFORK
	ERMSG	<CAN NOT KILL EXEC FORK>

	RTN

PUSH10:	SETZB	T1,T2		;NO RUN, NO TMPCOR
	PUSHJ	P,CTX		;DO IT
	 JFCL			;DON'T CARE, MESSAGE TYPED
	RTN
	SUBTTL	CTX. UUO DEFINITIONS

	OPDEF	CTX.	[CALLI 215]	;UUO TO MANIPULATE JOB CONTEXTS

.CTFNC==0			;FUNCTION CODE WORD
   CT.PHY==1B0			   ;PHYSICAL ONLY RUN UUO
   CT.LEN==777B17		   ;LENGTH OF BLOCK INCLUDING THIS WORD
   CT.FNC==777777B35		   ;FUNCTION CODE
      .CTSVH==0			      ;SAVE CURRENT CONTEXT, HALT JOB
      .CTSVR==1			      ;SAVE CURRENT CONTEXT, RUN PROGRAM
      .CTSVT==2			      ;SAVE CURRENT CONTEXT, CREATE A TOP LEVEL
      .CTSVS==3			      ;SAVE CURRENT CONTEXT, SWITCH TO ANOTHER
      .CTSVD==4			      ;SAVE CURRENT CONTEXT, RUN PROGRAM
      .CTRDB==5			      ;READ DATA BUFFER
      .CTWDB==6			      ;WRITE DATA BUFFER
      .CTRQT==7			      ;READ QUOTAS INTO DATA BUFFER
      .CTSQT==10		      ;SET QUOTAS IN DATA BUFFER
      .CTDIR==11		      ;RETURN A DIRECTORY MAP OF ALL CONTEXTS
      .CTINF==12		      ;RETURN INFORMATION ABOUT A CONTEXT
.CTDBL==1			;DATA BUFFER LENGTH
.CTDBA==2			;DATA BUFFER ADDRESS
.CTNAM==3			;SIXBIT CONTEXT NAME
.CTRNO==4			;RUN UUO OFFSET (LH RESERVED)
.CTRNB==5			;RUN UUO BLOCK ADDRESS
.CTTMN==6			;TMPCOR LENGTH,,SIXBIT NAME
.CTTMB==7			;TMPCOR BUFFER ADDRESS
.CTMAX==10			;LENGTH OF ARGUMENT BLOCK

; DATA BUFFER OFFSETS FOR FUNCTIONS .CTRQT AND .CTSQT
.CTJOB==0			;JOB NUMBER
.CTCTQ==1			;CONTEXT QUOTA
.CTPGQ==2			;SAVED PAGES QUOTA

; DATA BUFFER OFFSETS FOR FUNCTION .CTDIR
;.CTJOB==0			;JOB NUMBER
.CTWCT==1			;RETURNED WORD COUNT OF BYTE-STREAM DATA
.CTFDW==2			;FIRST DATA WORD OF DIRECTORY BYTE-STREAM

; DATA BUFFER OFFSETS FOR FUNCTION .CTINF
;.CTJOB==0			;JOB NUMBER
.CTCNO==1			;THIS CONTEXT'S NUMBER
.CTCNM==2			;THIS CONTEXT'S NAME
.CTSNO==3			;SUPERIOR'S CONTEXT NUMBER
.CTSNM==4			;SUPERIOR'S CONTEXT NAME
.CTPGM==5			;PROGRAM NAME
.CTITM==6			;IDLE TIME IN TICKS

; ON ANY RETURN, THE AC WILL CONTAIN THE FOLLOWING
   CT.DAT==1B0			;DATA WORDS RETURNED
   CT.DBT==1B1			;DATA BUFFER TRUNCATED
   CT.ETX==1B2			;UUO ERROR TEXT IN DATA BUFFER
   CT.RUN==1B3			;RUN UUO ERROR
   CT.RDL==777B27		;WORDS IN DATA BUFFER
   CT.ERR==777B35		;ERROR CODE
; CTX. UUO ERROR CODES

CXIFC%==00			;ILLEGAL FUNCTION CODE
CXACR%==01			;ADDRESS CHECK READING ARGUMENTS
CXACS%==02			;ADDRESS CHECK STORING ANSWERS
CXNEA%==03			;NOT ENOUGH ARGUMENTS
CXNLI%==04			;NOT LOGGED IN
CXLOK%==05			;LOCKED IN CORE
CXDET%==06			;DETACHED
CXSCE%==07			;SYSTEM CONTEXT QUOTA EXCEEDED
CXSPE%==10			;SYSTEM PAGE QUOTA EXCEEDED
CXJCE%==11			;JOB CONTEXT QUOTA EXCEEDED
CXJPE%==12			;JOB PAGE QUOTA EXCEEDED
CXNCS%==13			;NOT ENOUGH CORE TO SAVE CONTEXT
CXNCD%==14			;NOT ENOUGH CORE TO RETURN DATA BLOCK
CXICN%==15			;ILLEGAL CONTEXT NUMBER
CXNSC%==16			;NO SUPERIOR CONTEXT
CXNPV%==17			;NO PRIVILEGES TO SET QUOTAS
CXIJN%==20			;ILLEGAL JOB NUMBER
CXCSI%==21			;CANNOT SWITCH TO AN INTERMEDIATE CONTEXT
CXCDI%==22			;CANNOT DELETE AN INTERMEDIATE CONTEXT
CXCDC%==23			;CANNOT DELETE THE CURRENT CONTEXT
CXCNP%==24			;CONTEXT NOT PRIVILEGED
CXNDA%==25			;NO DATA BLOCK AVAILABLE
; ROUTINE TO SAVE AND OPTIONALLY RUN A PROGRAM IN
; AN ALTERNATE CONTEXT.
; CALL:	MOVE	T1, ZERO OR OPTIONAL RUN UUO BLOCK POINTER
;	MOVE 	T2, ZERO OR OPTIONAL BUFLEN,,BUFFER OF EDT TMPCOR TO WRITE
;	PUSHJ	P,CTX
;	  <NON-SKIP>		;CTX. UUO FAILED, ERROR MESSAGE TYPED
;	<SKIP>			;CONTEXT SAVED AND RESTORED
CTX:	ADJSP	P,.CTMAX+20	;ALLOCATE DATA AREA
	PUSH	P,[[CAIA
		     AOS -<.CTMAX+20>(P)
		    ADJSP P,-<.CTMAX+20>
		    RTN]]
	DEFINE CTXARG,<-<.CTMAX+20>(P)>
	DEFINE CTXDAT,<-<20>(P)>
	MOVEI	T3,CTXARG	;POINT TO ARG BLOCK
	MOVEM	T1,.CTRNB(T3)	;SAVE POSSIBLE RUN UUO BLOCK
	HLLZM	T2,.CTTMN(T3)	;SAVE TMPCOR BUFFER LENGTH
	HRRZM	T2,.CTTMB(T3)	;SAVE TMPCOR BUFFER ADDRESS
	SKIPN	T1		;RUNNING A PROGRAM?
	SKIPA	T1,[.CTSVH]	;FUNCTION CODE TO SAVE AND HALT
	MOVEI	T1,.CTSVR	;FUNCTION CODE TO SAVE AND RUN
	HRLI	T1,.CTMAX	;INCLUDE ARGUMENT BLOCK LENGTH
	MOVEM	T1,.CTFNC(T3)	;SAVE
	MOVEI	T4,(SIXBIT/EDT/);EDT IS THE TMPCOR FILE NAME
	SKIPE	T2		;WRITING TMPCOR?
	HRRM	T4,.CTTMN(T3)	;YES--SAVE TMPCOR FILE NAME
	SETZM	.CTNAM(T3)	;NO CONTEXT NAME
	MOVEI	T1,20		;LENGTH OF DATA BLOCK
	MOVEM	T1,.CTDBL(T3)	;SAVE
	MOVEI	T1,CTXDAT	;ADDR OF DATA BLOCK
	MOVEM	T1,.CTDBA(T3)	;SAVE
	MOVE	T1,T3		;POINT TO ARG BLOCK
	CTX.	T1,		;FIRE UP AN ALTERNATE CONTEXT
	  SKIPA			;FAILED
	JRST	RSKP		;RETURN
	PMSGF	<? Cannot save context; >
	MOVEI	T4,CTXER1	;DEFAULT TO GENERIC ERROR MESSAGE
	CAMN	T1,T3		;UUO LEAVE AC UNCHANGED?
	MOVEI	T4,CTXER0	;YES--NOT IMPLEMENTED
	TXNE	T1,CT.RUN	;RUN UUO ERROR?
	MOVEI	T4,CTXER2	;YES
	TXNE	T1,CT.ETX	;CTX. UUO ERROR TEXT IN DATA BUFFER?
	MOVEI	T4,CTXER3	;YES
	JRST	(T4)		;DETAIL

CTXER0:	PMSGF	<CTX. UUO not implemented>
	JRST	CTXERE
CTXER1:	PMSGF	<CTX. UUO error >
CTXERO:	LDB	0,[POINTR(T1,CT.ERR)]
	PNTOCS
CTXERE:	PCRL
	RET
CTXER2:	PMSGF	<RUN UUO error >
	JRST	CTXERO
CTXER3:	MOVEI	CTXDAT
	PNTAL
	JRST	CTXERE
SUBTTL	COMMANDS -- DEBUG

	SCMTAB	SETCLR
	CMTAB	CLEAR,[0]
	CMTAB	SET,[-1]
	ECMTAB

	SCMTAB	DBFLGS
	CMTAB	DEBUG,DEBUGF
	ECMTAB


SETDEB:	CMD	[FLDDB.(.CMKEY,,SETCLR)],<MUST BE 'SET' OR 'CLEAR'>
	HRRZ	T1,(T2)		;GET POINTER
	MOVE	T6,(T1)		;GET FLAG
	CMD	[FLDDB.(.CMKEY,,DBFLGS)],<NOT A DEBUG FLAG>
	HRRZ	T5,(T2)		;PLACE TO STORE ANSWER
	NOISE	<FLAG>
	CONFIRM
	MOVEM	T6,(T5)		;SET/CLEAR FLAG
	RTN

SUBTTL	COMMANDS -- ECHO

	SCMTAB	YESNO
	CMTAB	NO,0
	CMTAB	YES,777777
	ECMTAB

ECHO:	NOISE	<COMMAND FILES>
	CMD	[FLDDB.(.CMKEY,,YESNO,<YES OR NO>,<YES>)]
	HRRE	T1,(T2)
	PUT	T1
	CONFIRM
	GETIT	ECOFLG
	RTN
SUBTTL	COMMANDS -- DEPOSIT

	SCMTAB	DEPCMD
	CMTAB	BC1,DPBC1
	CMTAB	CRAM,DPCRAM
	ECMTAB

DEP:	CMD	[FLDDB.(.CMKEY,,DEPCMD)],<CAN NOT DEPOSIT THAT>
	HRRZ	T1,(T2)
	JRST	(T1)

;*HERE TO STORE INTO CRAM

DPBC1:	SETOM	BC1FLG#
	JRST	DPCRAM+1
DPCRAM:	SETZM	BC1FLG
	NOISE	<LOCATION>
	CMD	[FLDDB.(.CMNUM,,^D8)],<NOT A VALID CRAM ADDRESS>
	SKIPL	T2
	CAIL	T2,4000
	ERR	<ADDRESS MUST BE 0 TO 3777>
	MOVEM	T2,EXMADR
	CONFIRM
	MOVE	T6,EXMADR
	SETOM	DEPFLG
	GO	DPYFLD
	RTN
SUBTTL	COMMANDS -- SERIAL

SERIAL:	NOISE	<CPU SERIAL NUMBER (4097 TO 32767) INTO MICROCODE>
	CMD	[FLDDB.(.CMNUM,,^D10)],<NOT A VALID SERIAL NUMBER>
	MOVEM	T2,SNBR#
	CONFIRM

	MOVE	T2,SNBR
	SKIPL	T2
	CAIGE	T2,^D4097
	ERR	<NOT A VALID SERIAL NUMBER>
	CAILE	T2,^D32767
	ERR	<NOT A VALID SERIAL NUMBER>

	SKIPN	RDFLAG
	ERR	<MUST FIRST READ MICROCODE WITH READ COMMAND>

	MOVEI	T6,1700		;SERIAL # AT APRID: (1700) OF MICROCODE
	IMULI	T6,3
	ADDI	T6,CRAM

	DPB	T2,[POINT 12,1(T6),23]
	LSH	T2,-^D12
	DPB	T2,[POINT 6,1(T6),35]

	JRST	ENDDPY+2	;RECOMPUTE CRAM PARITY
SUBTTL	COMMANDS -- EXAMINE

	SCMTAB	EXCMDS
	CMTAB	BC1,EXBC1
	CMTAB	CRAM,EXCRAM
	ECMTAB

EMDFNC:	FLDDB.	(.CMKEY,,EXCMDS)

EXAM:	CMD	EMDFNC,<CAN NOT EXAMINE THAT>
	HRRZ	T1,(T2)
	JRST	(T1)

;*EXAMINE CRAM

EXBC1:	SETOM	BC1FLG
	JRST	EXCRAM+1
EXCRAM:	SETZM	BC1FLG
	NOISE	<LOCATION>
	CMD	[FLDDB.(.CMNUM,,^D8)],<NOT A VALID CRAM LOCATION>
	PUSH	P,T2
	CONFIRM
	POP	P,T2
	SKIPL	T2
	CAIL	T2,4000
	ERR	ADDRESS MUST BE 0 TO 3777
	MOVEM	T2,EXMADR
EXCRM:	PNTMSF	[ASCIZ/SHOULD BE:	/]
	MOVE	EXMADR
	PNT6F
	PNTCIF	"/"
	MOVE	T6,EXMADR
	IMULI	T6,3
	SKIPN	BC1FLG
	ADDI	T6,CRAM
	SKIPE	BC1FLG
	ADDI	T6,CRMBC1
	MOVE	2(T6)
	PNT8F
	MOVE	1(T6)
	PNTOTF
	MOVE	(T6)
	PNTOTF

	GO	CRMFLD
	PCRLF
	RET
SUBTTL	COMMANDS -- EXIT

.EXIT:	NOISE	<TO MONITOR>
	CONFIRM
.EXIT1:	SKIPN	MONTYP
	EXIT
	HALTF
	JRST	START

SUBTTL	COMMANDS -- HELP

HELP:	CONFIRM
	SKIPN	MONTYP
	JRST	HELP10
	MOVSI	T1,(GJ%OLD!GJ%PHY!GJ%SHT)
	HRROI	T2,HLPFIL
	GTJFN
	JRST	NOHELP
	MOVE	T2,[7B5!OF%RD!OF%NWT]
	OPENF
	JRST	NOHELP
	MOVEI	T6,.PRIOU
HELPLP:	BIN
	ERJMP	HELPEX
	EXCH	T1,T6
	BOUT
	EXCH	T1,T6
	JRST	HELPLP

HELPEX:	CLOSF
	ERR	<HELP: CAN NOT CLOSE HELP FILE>
	RTN

NOHELP:	PMSGF	<?CAN NOT READ >
	MOVEI	HLPFIL
	PNTALF
	PCRLF
	RTN

HLPFIL:	ASCIZ	"SMFILE.HLP"
;*TOPS-10 HELP

HELP10:	MOVE	[SIXBIT/DSK/]
	MOVEM	GTJDEV
	SETZM	GTJDIR
	MOVE	[SIXBIT/SMFILE/]
	MOVEM	GTJFIL
	MOVE	[SIXBIT/HLP/]
	MOVEM	GTJEXT

	GO	OPNTEN		;FIND FILE
	ERR	<SMFILE.HLP NOT FOUND>

HLP10A:	GO	GET10
	SKIPGE	EOFSW
	JRST	R10EOF

	MOVEM	T3,HLP10X#
	MOVEI	HLP10X
	PNTA
	JRST	HLP10A
SUBTTL	COMMANDS -- WRITE

	SCMTAB	WRTCMD
	CMTAB	BC1,WRTBC1
	CMTAB	BC2,WRTBC2
	CMTAB	BOOT,WRTBOOT
	CMTAB	CRAM,WRTCRM
	CMTAB	DIAGBT,WRTDB
	CMTAB	DONE,WRTDONE
	CMTAB	INDIRECT,WRTFEF
	CMTAB	RESET,WRTRSET
	CMTAB	SETUP,WRTSET
	ECMTAB

WRITE:	CMD	[FLDDB.(.CMKEY,,WRTCMD)],<CAN NOT WRITE THAT>
	HRRZ	T1,(T2)
	JRST	(T1)
;*WRTSET - READ FE-FILE DIRECTORY BLOCK INTO MEMORY

WRTSET:	HRROI	T1,[ASCIZ "BOOTSTRAP"]
	SKIPE	DEBUGF
	HRROI	T1,[ASCIZ "BOOTST"]
	SKIPN	MONTYP
	HRROI	T1,[ASCIZ "KS10FE"]
	MOVEM	T1,GTJFIL

	HRROI	T1,[ASCIZ "BIN"]
	MOVEM	T1,GTJEXT

	HRROI	T1,[ASCIZ "ROOT-DIRECTORY"]
	SKIPE	DEBUGF
	HRROI	T1,[ASCIZ "KIRCHOFF"]
	SKIPN	MONTYP
	HRROI	T1,[ASCIZ "[6,2020]"]
	MOVEM	T1,GTJDIR

	HRROI	T1,[ASCIZ "XXX:"]
	MOVEM	T1,GTJDEV

	MOVSI	T1,(GJ%OLD)
	MOVEM	T1,GTJFLG

	CMD	[FLDDB.(.CMFIL)]
	HRRZM	T2,FEJFN

	CONFIRM

	SKIPN	MONTYP
	JRST	DEVSTR		;TOPS-10

	HRROI	T1,STBUF
	HRRZ	T2,FEJFN
	MOVSI	T3,(1B2)
	JFNS
	ERMSG	<CAN NOT GET STRUCTURE NAME>

	SKIPN	DEBUGF
	GO	FIND		;FIND PHYSICAL DISK
	HRROI	T1,STBUF
	STDEV
	ERR	<STDEV FAILED FOR STRUCTURE>
	MOVEM	T2,STRDES#

	HRRZ	T1,FEJFN
	MOVE	T2,[1,,.FBCTL]
	MOVEI	T3,T3
	GTFDB
	ERMSG	<WRTSETUP: GTFDB FAILED>
	TLNE	T3,(FB%NXF)	;DOES FILE EXIST
	ERR	<FRONT-END FILE DOES NOT EXIST>

	MOVE	T2,[1,,.FBBYV]
	MOVEI	T3,T3
	GTFDB
	ERMSG	<WRITE: GTFBD FOR SIZE FAILED>
	TLZ	T3,FB%PGC	;JUST PAGE COUNT
	CAIGE	T3,^D48
	 ERR	<BOOTSTRAP.BIN FILE TOO SMALL>

	MOVE	T1,FEJFN
	MOVEI	T2,OF%RD!OF%WR
	OPENF			;OPEN THE FILE
	JRST	[JSERR		;CAN'T OPEN THE FRONT-END FILE SYSTEM?
		JRST START]

	HRLZ	T1,FEJFN
	MOVE	T2,[.FHSLF,,<FEDIR_-^D9>]
	MOVE	T3,[PM%RD+PM%WR+PM%PLD]
	PMAP			;READ FE DIRECTORY BLOCK
	 ERJMP	[JSERR
		 JRST	START]

	SKIPE	DEBUGF
	JRST	WRTSEX

	MOVEI	T1,0
	GO	REDHOM		;READ HOME BLOCK
	 RTN

	SKIPN	HOMPAG+200+101
	 ERR	<NO DISK ADDRESS IN HOME BLOCK>

	SKIPN	HOMPAG+200+102
	 ERR	<NO LENGTH IN HOME BLOCK>

WRTSEX:	SETOM	FESETF#
	SETZM	FERSETF#
	RTN
;*WRTRSET - RESET FE-DIRECTORY

WRTRSET:CONFIRM
	SKIPN	FESETF		;FE-DIR  IN CODE ?
	 ERR	<FE-FILE SYSTEM NOT SETUP>

	SETZM	FEDIR		;CLEAR FE-DIR PAGE
	MOVE	[FEDIR,,FEDIR+1]
	BLT	FEDIR+777

	SKIPE	MONTYP
	MOVE	T1,HOMPAG+200+102	;GET LENGTH IN SECTORS
	SKIPN	MONTYP
	MOVE	T1,HOMBUF+102
	SKIPE	DEBUGF
	MOVEI	T1,^D64*4

	IDIVI	T1,^D4		;CONVERT TO PAGES
	SUBI	T1,^D28		;SUB FIXED FILES
	HRLI	T1,^D28		;FIRST FREE PAGE STARTS AT PAGE 28
	MOVEM	T1,FEDIR+FSL	;SET RESET PAGE #,,LENGTH

	MOVE	T1,[^D1,,^D12]
	MOVEM	T1,FEDIR+MCL	;SETUP MCODE PAGE #,,LENGTH

	MOVE	T1,[^D13,,^D1]
	MOVEM	T1,FEDIR+MPBL	;SETUP M-PRE-BOOT PAGE #,,LENGTH

	MOVE	T1,[^D14,,^D1]
	MOVEM	T1,FEDIR+DPBL	;SETUP D-PRE-BOOT PAGE #,,LENGTH

	MOVE	T1,[^D15,,^D12]
	MOVEM	T1,FEDIR+BC1L	;SETUP BOOTCHECK 1 PAGE #,,LENGTH

	MOVE	T1,[^D27,,^D1]
	MOVEM	T1,FEDIR+BCKL	;SETUP BC2-PRE-BOOT PAGE #,,LENGTH

	SETOM	FERSETF		;INDICATE RESET

	RTN
;*FIND - FIND THE PHYSICAL DISK WITH THE GIVEN NAME

FIND:	MOVEI	T6,ARGBLK	;SET ARG BLOCK INDEX
	SETOM	.MSRCH(T6)	;-1 TO CHAN ENTRY OF BLOCK
	SETOM	.MSRCT(T6)	;-1 TO CONTROLLER ENTRY OF BLOCK
	SETOM	.MSRUN(T6)	;-1 TO UNIT ENTRY OF BLOCK

FINDN:	SETZM	.MSRST(T6)	;CLEAR STATUS ENTRY OF BLOCK
	MOVE	T1,[ARGBLK+.MSRST,,ARGBLK+.MSRST+1]
	BLT	T1,ARGBLK+ARGLN-1	;CLEAR REST OF BLOCK

	HRROI	T1,BUFFER
	MOVEM	T1,.MSRSN(T6)	;USE BUFFER TO SAVE PACK NAME

	MOVE	T1,[.MSRLN,,.MSRNU]
	MOVEI	T2,ARGBLK
MS:	MSTR			;GET STATUS OF NEXT DISK UNIT
	 ERCAL	FINDER		;  ERROR

	CAIN	T2,MSTX27	;ERROR, IS THE UNIT A DISK ?
	JRST	FINDN		;NO, NOT A DISK, TRY FOR ANOTHER

	MOVE	T1,.MSRST(T6)	;GET UNIT STATUS
	TLNN	T1,(MS%MNT)	;MOUNTED ?
	JRST	FINDN		;NO, TRY ANOTHER
	TLNE	T1,(MS%OFL)	;IS THE UNIT OFF-LINE ?
	JRST FINDN		;YES, TRY ANOTHER

	MOVE	T2,[POINT 7,STBUF]
	MOVE	T3,[POINT 7,BUFFER]
	GO	STRCMP		;COMPARE REQUESTED/DISK NAME
	JRST	FINDN		;NO MATCH

	MOVE	T1,.MSRST(T6)	;GET MONITORS DRIVE TYPE
	LDB	T1,[POINT 9,T1,17]
	MOVEM	T1,DSKTYP#	;SAVE

	SETZM	RM03F#
	CAIN	T1,.MSRP4	;RP04 ?
	JRST	FINDX		;YES
	CAIN	T1,.MSRP5	;RP05 ?
	JRST	FINDX		;YES
	CAIN	T1,.MSRP6	;RP06 ?
	JRST	FINDX		;YES
	CAIE	T1,11		;.MSRM3 RM03 ?
	ERR	<DISK IS NOT A VALID TYPE>
	SETOM	RM03F		;YES

FINDX:	RTN

	ARGLN=.MSRLN
ARGBLK:	BLOCK	ARGLN

;ERROR HANDLER FOR THE GET NEXT UNIT JSYS

FINDER:	MOVEI	T1,400000	;SET PROCESS HANDLE
	GETER			;GET ERROR CODE
	HRRZ	T2,T2		;ERROR CODE ONLY
	CAIN	T2,MSTX27	;IS THE UNIT A DISK ?
	RTN			;NO, GO BACK AND LOOK FURTHER
	CAIE	T2,MSTX18	;NO MORE UNITS FOUND ?
	JRST	[JSERR
		 JRST	START]
	GETIT	T6
	JRST	FALIAS		;CAN'T FIND PHYSICAL, TRY ALIAS

;*STRCMP - STRING COMPARE ROUTINE

STRCMP:	ILDB	0,T2
	ILDB	T1,T3
	CAME	0,T1		;EQUAL ?
	RTN			;NO, LOSE

	JUMPN	0,STRCMP	;YES, END OF STRING ?
	JRST	CPOPJ1		;YES, SKIP RETURN
;*FALIAS - FIND THE PHYSICAL DISK WITH THE GIVEN ALIAS

FALIAS:	MOVEI	T6,ARGBLK	;SET ARG BLOCK INDEX
	SETOM	.MSRCH(T6)	;-1 TO CHAN ENTRY OF BLOCK
	SETOM	.MSRCT(T6)	;-1 TO CONTROLLER ENTRY OF BLOCK
	SETOM	.MSRUN(T6)	;-1 TO UNIT ENTRY OF BLOCK

FADN:	SETZM	.MSRST(T6)	;CLEAR STATUS ENTRY OF BLOCK
	MOVE	T1,[ARGBLK+.MSRST,,ARGBLK+.MSRST+1]
	BLT	T1,ARGBLK+ARGLN-1	;CLEAR REST OF BLOCK

	HRROI	T1,BUFFER
	MOVEM	T1,.MSRSA(T6)	;USE BUFFER TO SAVE PACK ALIAS

	MOVE	T1,[.MSRLN,,.MSRNU]
	MOVEI	T2,ARGBLK
FAMS:	MSTR			;GET STATUS OF NEXT DISK UNIT
	 ERCAL	FADER		;  ERROR

	CAIN	T2,MSTX27	;ERROR, IS THE UNIT A DISK ?
	JRST	FADN		;NO, NOT A DISK, TRY FOR ANOTHER

	MOVE	T1,.MSRST(T6)	;GET UNIT STATUS
	TLNN	T1,(MS%MNT)	;MOUNTED ?
	JRST	FADN		;NO, TRY ANOTHER
	TLNE	T1,(MS%OFL)	;IS THE UNIT OFF-LINE ?
	JRST	FADN		;YES, TRY ANOTHER

	MOVE	T2,[POINT 7,STBUF]
	MOVE	T3,[POINT 7,BUFFER]
	GO	STRCMP		;COMPARE REQUESTED/DISK NAME
	JRST	FADN		;NO MATCH
	MOVE	T1,.MSRST(T6)	;GET MONITORS DRIVE TYPE
	LDB	T1,[POINT 9,T1,17]
	MOVEM	T1,DSKTYP#	;SAVE

	SETZM	RM03F#
	CAIN	T1,.MSRP4	;RP04 ?
	JRST	FINDAX		;YES
	CAIN	T1,.MSRP5	;RP05 ?
	JRST	FINDAX		;YES
	CAIN	T1,.MSRP6	;RP06 ?
	JRST	FINDAX		;YES
	CAIE	T1,11		;.MSRM3 RM03 ?
	ERR	<DISK IS NOT A VALID TYPE>
	SETOM	RM03F		;YES

FINDAX:	RTN

;ERROR HANDLER FOR THE GET NEXT UNIT JSYS

FADER:	MOVEI	T1,400000	;SET PROCESS HANDLE
	GETER			;GET ERROR CODE
	HRRZ	T2,T2		;ERROR CODE ONLY
	CAIN	T2,MSTX27	;IS THE UNIT A DISK ?
	RTN			;NO, GO BACK AND LOOK FURTHER
	CAIN	T2,MSTX18	;NO MORE UNITS FOUND ?
	 ERR	<CAN'T FIND DISK>
	JRST	[JSERR
		 JRST	START]

;*COMPUTE DIAGNOSTIC PRE-BOOT PAGE POINTER

CPBPNTR:MOVEI	SMPREB		;GET START ADR OF PRE-BOOT
	ADDI	5		;ADD OFFSET TO POINTER
	MOVE	0,@0		;GET POINTER TO POINTER BLOCK
	HLRZ	1,0		;GET LH CODE WORD
	CAIE	1,123456	;IS IT CORRECT ?
	ERR	<DIAGNOSTIC PRE-BOOT CODE WORD INCORRECT>
	SUBI	0,1000		;REMOVE OFFSET
	ADDI	0,SMPREB	;ADD ACTUAL LOCATION
	HRRZM	0,SMPBPG#	;SAVE
	HRL	0,0		;FORM BLT POINTER
	ADDI	0,1
	MOVEM	0,SMPBBLT#	;SAVE
	RTN
;DEFINITIONS FOR SM10

BOORG=1000	;START OF HARDWARE BOOT
FEADR=101	;ADDRESS OF BOOTSTRAP
FEMAX=102	;ADDRESS OF LENGTH POINTER

OPDEF	WRUBR	[701B8+3B12]	;WRITE USER BASE REGISTER
OPDEF	RDIO	[712B8]		;READ I/O
OPDEF	TION	[711B8]		;TEST I/O
OPDEF	WRIO	[713B8]		;WRITE I/O

UBAP0=	763000	;ADDRESS OF UNIBUS MAP
UBSTAT=	763100	;ADDRESS OF UNIBUS STATUS

BOOTPA=20	;ADDRESS OF BOOTSTRAP (TOPS-10 NEEDS ACROSS RELOADS)
KPALIVE=31	;KEEP-ALIVE & STATUS WORD
MSRH=	36	;RH-11 BASE ADDRESS
MSDRIVE=37	;DRIVE NUMBER
MSSLAVE=40	;SLAVE & FORMAT

RIPST=21	;READ IN PRESET
RDATA=71	;READ DATA
RDY=200		;READY
MCPE=20000	;MASS I/O CONTROL BUS PARITY ERROR
TRE=40000	;TRANSFER ERROR
SC=100000	;SPECIAL CONDITION
FMT22=10000	;FORMAT 22 (FORMAT BIT)

RHCLR=	40	;CONTROLLER CLEAR

MT.RF=	71	;READ FORWARD
MT.SF=	31	;SPACE FILE FORWARD
MT.SR=	33	;SPACE REVERSE
MTTM=	4	;TAPE MARK
MTPIP=	20000	;POSITIONING IN PROGRESS
MTDRY=	200	;DRIVE READY
MTFCE=	1000	;FRAME COUNT ERROR

;REGISTER DEFINITIONS

RPCS1=	00	;CONTROL AND STATUS 1
RPWC=	02	;WORD COUNT REGISTER
RPBA=	04	;UNIBUS ADDRESS REGISTER
RPDA=	06	;DESIRED SECTOR/TRACK ADDRESS REGISTER
RPCS2=	10	;CONTROL AND STATUS 2
RPDS=	12	;DRIVE STATUS
RPER1=	14	;ERROR 1
RPER2=	40	;ERROR 2
RPER3=	42	;ERROR 3
RPOF=	32	;OFFSET REGISTER
RPDC=	34	;DESIRED CYLINDER REGISTER
RPFC=	6	;MAGTAPE FRAME COUNTER
RPTC=	32	;MAGTAPE TAPE CONTROL

UNV36X=100000	;UNIBUS 36 BIT TRANSFER BIT
UBVBIT==40000	;UNIBUS VALID BIT

BUFFER:	BLOCK	<BUFSIZ==400>
BTJFN:	BLOCK	1		;BOOT JFN
FEJFN:	BLOCK	1		;JFN FOR THE FRONT-END FILE SYSTEM
BOOTEV:	BLOCK	1		;ENTRY VECTOR FOR BOOT
FORKN:	BLOCK	1
;*WRTBOOT - WRITE MONITOR PRE-BOOT AND BOOT ON DISK

WRTBOOT:HRROI	T1,[ASCIZ "SMBOOT"]
	MOVEM	T1,GTJFIL

	HRROI	T1,[ASCIZ "EXE"]
	MOVEM	T1,GTJEXT

	SETZM	GTJDEV
	SETZM	GTJDIR

	MOVSI	T1,(GJ%OLD)
	MOVEM	T1,GTJFLG

	CMD	[FLDDB.(.CMFIL)]
	MOVEM	T2,BTJFN	;SAVE THE JFN OF THE BOOT FILE

	CONFIRM

	SKIPN	FESETF		;FE-DIR  IN CORE ?
	 ERR	<FE-FILE SYSTEM NOT SETUP>
	SKIPN	FERSETF	
	ERR	<FE-FILE SYSTEM NOT RESET>

	SETZM	RPPAGD
	MOVE	[RPPAGD,,RPPAGD+1]
	BLT	RPPAGX		;CLEAR PRE-BOOT POINTER STORAGE

	SKIPN	MONTYP
	JRST	WB10		;TOPS-10

	SETZB	T1,T2		;CREATE A BLANK FORK
	CFORK
	ERJMP	[JSERR		;ERROR ON CFORK
		HALTF]
	MOVEM	T1,FORKN	;SAVE FORK

	HRRZ	T1,BTJFN	;GET THE JFN OF THE BOOT
	HRL	T1,FORKN	;GET PROCESS HANDLE
	SETZ	T2,0
	GET
	ERJMP	[JSERR		;ERROR ON GET
		JRST START]
	MOVE	T1,FORKN
	GEVEC			;GET THE VECTOR OF BOOT
	MOVEM	T2,BOOTEV	;SAVE BOOT ENTRY VECTOR ADDRESS

	SETZ	T3,		;CLEAR PAGE COUNTER
	MOVE	T4,[-1000,,0]	;ALLOW FOR 1000 PAGES
	HRLZ	T1,FORKN	;GET PROCESS HANDLE
	HRR	T1,T4		;GET PAGE NUMBER

	RPACS			;READ PAGE ACCESS
	TDNE	T2,[PA%RD!PA%PEX]
	AOS	T3		;IT'S THERE, COUNT IT
	AOBJN	T4,.-5

	HRRZ	T1,FEDIR+FSL	;GET PRESENT FREE SPACE LENGTH
	CAMGE	T1,T3		;ENOUGH ROOM ?
	ERR	<NOT ENOUGH FREE SPACE>

	SETZM	WINDOW
	MOVE	[WINDOW,,WINDOW+1]
	BLT	WINDOW+777	;CLEAR MONITOR PRE-BOOT PAGE

	MOVE	T4,[-1000,,0]	;ALLOW FOR 1000 PAGES
	HRLZ	P1,FEJFN	;GET JFN OF FRONT-END-FILE SYSTEM
	HLR	P1,FEDIR+FSL	;GET FREE SPACE PAGE #
	HRLZM	P1,FEDIR+MBOOTL	;SET MBOOT START PAGE

	MOVEI	P2,RPPAGD
	SETZM	PBCNT#
	HLRZ	T7,FEDIR+MBOOTL
PAGELP:	HRLZ	T1,FORKN	;GET PROCESS HANDLE
	HRR	T1,T4		;GET PAGE NUMBER
	RPACS			;READ PAGE ACCESS
	TDNE	T2,[PA%RD!PA%PEX]
	GO	COPPAG		;COPY PAGE

	AOBJN	T4,PAGELP	;TRY ANOTHER PAGE

	ANDI	P1,-1
	HRLM	P1,FEDIR+FSL	;RESET FREE SPACE START PAGE
	HRRZ	0,FEDIR+FSL	;FREE SPACE NOW SMALLER BY BOOT
	SUB	0,PBCNT
	HRRM	0,FEDIR+FSL

	MOVE	P1,PBCNT
	HRRM	P1,FEDIR+MBOOTL	;SET MBOOT LENGTH

	SETOM	(P2)		;INDICATE END OF SPACE

	MOVE	T1,BOOTEV	;FIND ENTRY VECTOR
	HRRZM	T1,1(P2)	;SET ENTRY VECTOR

	HRLZ	T1,FEJFN
	HRRI	T1,^D13
	MOVE	T2,[.FHSLF,,<WINDOW_-^D9>]
	MOVE	T3,[PM%WR!PM%RD]
	PMAP			;GET MONITOR PRE-BOOT IN FE-FILE
	 ERJMP	[JSERR
		 JRST	START]

	MOVE	[BTSTR1,,WINDOW]
	BLT	WINDOW+<RPPAGX-BTSTR1>

	SETO	T1,
	SETZ	T3,
	PMAP			;PUT MONITOR PRE-BOOT IN FE-FILE
	 ERJMP	[JSERR
		 JRST	START]

	MOVE	T1,FORKN
	KFORK			;KILL "GET" FORK
	 ERJMP	[JSERR
		 JRST	START]

	RTN
;*WRTDB - WRITE DIAGNOSTIC PRE-BOOT AND "SMMON" ON DISK

WRTDB:	HRROI	T1,[ASCIZ "SMMON"]
	MOVEM	T1,GTJFIL

	HRROI	T1,[ASCIZ "EXE"]
	MOVEM	T1,GTJEXT

	SETZM	GTJDEV
	SETZM	GTJDIR

	MOVSI	T1,(GJ%OLD)
	MOVEM	T1,GTJFLG

	CMD	[FLDDB.(.CMFIL)]
	MOVEM	T2,BTJFN	;SAVE THE JFN OF THE BOOT FILE

	CONFIRM

	SKIPN	FESETF		;FE-DIR  IN CODE ?
	 ERR	<FE-FILE SYSTEM NOT SETUP>
	SKIPN	FERSETF	
	ERR	<FE-FILE SYSTEM NOT RESET>

	GO	CPBPNTR		;COMPUTE DIAGNOSTIC PRE-BOOT POINTER

	SETZM	@SMPBPG
	MOVE	SMPBBLT
	BLT	SMPEND		;CLEAR PRE-BOOT POINTER STORAGE

	SKIPN	MONTYP
	JRST	WDB10		;TOPS-10

	SETZB	T1,T2		;CREATE A BLANK FORK
	CFORK
	ERJMP	[JSERR		;ERROR ON CFORK
		HALTF]
	MOVEM	T1,FORKN	;SAVE FORK

	HRRZ	T1,BTJFN	;GET THE JFN OF THE BOOT
	HRL	T1,FORKN	;GET PROCESS HANDLE
	SETZ	T2,0
	GET
	ERJMP	[JSERR		;ERROR ON GET
		JRST START]
	MOVE	T1,FORKN
	GEVEC			;GET THE VECTOR OF BOOT
	MOVEM	T2,BOOTEV	;SAVE BOOT ENTRY VECTOR ADDRESS

	SETZ	T3,		;CLEAR PAGE COUNTER
	MOVE	T4,[-1000,,0]	;ALLOW FOR 1000 PAGES
	HRLZ	T1,FORKN	;GET PROCESS HANDLE
	HRR	T1,T4		;GET PAGE NUMBER

	RPACS			;READ PAGE ACCESS
	TDNE	T2,[PA%RD!PA%PEX]
	AOS	T3		;IT'S THERE, COUNT IT
	AOBJN	T4,.-5

	HRRZ	T1,FEDIR+FSL	;GET PRESENT FREE SPACE LENGTH
	CAMGE	T1,T3		;ENOUGH ROOM ?
	ERR	<NOT ENOUGH FREE SPACE>

	SETZM	WINDOW
	MOVE	[WINDOW,,WINDOW+1]
	BLT	WINDOW+777	;CLEAR DIAG PRE-BOOT PAGE

	MOVE	T4,[-1000,,0]	;ALLOW FOR 1000 PAGES
	HRLZ	P1,FEJFN	;GET JFN OF FRONT-END-FILE SYSTEM
	HLR	P1,FEDIR+FSL	;GET FREE SPACE PAGE #
	HRLZM	P1,FEDIR+DBOOTL	;SET DBOOT START PAGE

	MOVE	P2,SMPBPG
	SETZM	PBCNT
	HLRZ	T7,FEDIR+DBOOTL
WRTDBLP:HRLZ	T1,FORKN	;GET PROCESS HANDLE
	HRR	T1,T4		;GET PAGE NUMBER
	RPACS			;READ PAGE ACCESS
	TDNE	T2,[PA%RD!PA%PEX]
	GO	COPPAG		;COPY PAGE

	AOBJN	T4,WRTDBLP	;TRY ANOTHER PAGE

	ANDI	P1,-1
	HRLM	P1,FEDIR+FSL	;RESET FREE SPACE START PAGE
	HRRZ	0,FEDIR+FSL	;FREE SPACE NOW SMALLER BY BOOT
	SUB	0,PBCNT
	HRRM	0,FEDIR+FSL

	MOVE	P1,PBCNT
	HRRM	P1,FEDIR+DBOOTL	;SET DBOOT LENGTH

	SETOM	(P2)		;INDICATE END OF SPACE

	MOVE	T1,BOOTEV	;FIND ENTRY VECTOR
	HRRZM	T1,1(P2)	;SET ENTRY VECTOR

	HRLZ	T1,FEJFN
	HRRI	T1,^D14
	MOVE	T2,[.FHSLF,,<WINDOW_-^D9>]
	MOVE	T3,[PM%WR!PM%RD]
	PMAP			;GET DIAG PRE-BOOT IN FE-FILE
	 ERJMP	[JSERR
		 JRST	START]

	MOVE	[SMPREB,,WINDOW]
	BLT	WINDOW+777

	SETO	T1,
	SETZ	T3,
	PMAP			;PUT DIAG PRE-BOOT IN FE-FILE
	 ERJMP	[JSERR
		 JRST	START]

	MOVE	T1,FORKN
	KFORK			;KILL "GET" FORK
	 ERJMP	[JSERR
		 JRST	START]

	RTN
;*WRTBC2 - WRITE BOOTCHECK 2 PRE-BOOT AND "SMBC2" ON DISK

WRTBC2:HRROI	T1,[ASCIZ "SMBC2"]
	MOVEM	T1,GTJFIL

	HRROI	T1,[ASCIZ "EXE"]
	MOVEM	T1,GTJEXT

	SETZM	GTJDEV
	SETZM	GTJDIR

	MOVSI	T1,(GJ%OLD)
	MOVEM	T1,GTJFLG

	CMD	[FLDDB.(.CMFIL)]
	MOVEM	T2,BTJFN	;SAVE THE JFN OF THE BC2 FILE

	CONFIRM

	SKIPN	FESETF		;FE-DIR  IN CODE ?
	 ERR	<FE-FILE SYSTEM NOT SETUP>
	SKIPN	FERSETF	
	ERR	<FE-FILE SYSTEM NOT RESET>

	GO	CPBPNTR		;COMPUTE DIAGNOSTIC PRE-BOOT POINTER

	SETZM	@SMPBPG
	MOVE	SMPBBLT
	BLT	SMPEND		;CLEAR PRE-BOOT POINTER STORAGE

	SKIPN	MONTYP
	JRST	BC210		;TOPS-10

	SETZB	T1,T2		;CREATE A BLANK FORK
	CFORK
	ERJMP	[JSERR		;ERROR ON CFORK
		HALTF]
	MOVEM	T1,FORKN	;SAVE FORK

	HRRZ	T1,BTJFN	;GET THE JFN OF THE BOOT
	HRL	T1,FORKN	;GET PROCESS HANDLE
	SETZ	T2,0
	GET
	ERJMP	[JSERR		;ERROR ON GET
		JRST START]
	MOVE	T1,FORKN
	GEVEC			;GET THE VECTOR OF BOOT
	MOVEM	T2,BOOTEV	;SAVE BOOT ENTRY VECTOR ADDRESS

	SETZ	T3,		;CLEAR PAGE COUNTER
	MOVE	T4,[-1000,,0]	;ALLOW FOR 1000 PAGES
	HRLZ	T1,FORKN	;GET PROCESS HANDLE
	HRR	T1,T4		;GET PAGE NUMBER

	RPACS			;READ PAGE ACCESS
	TDNE	T2,[PA%RD!PA%PEX]
	AOS	T3		;IT'S THERE, COUNT IT
	AOBJN	T4,.-5

	HRRZ	T1,FEDIR+FSL	;GET PRESENT FREE SPACE LENGTH
	CAMGE	T1,T3		;ENOUGH ROOM ?
	ERR	<NOT ENOUGH FREE SPACE>

	SETZM	WINDOW
	MOVE	[WINDOW,,WINDOW+1]
	BLT	WINDOW+777	;CLEAR BC2 PRE-BOOT PAGE

	MOVE	T4,[-1000,,0]	;ALLOW FOR 1000 PAGES
	HRLZ	P1,FEJFN	;GET JFN OF FRONT-END-FILE SYSTEM
	HLR	P1,FEDIR+FSL	;GET FREE SPACE PAGE #
	HRLZM	P1,FEDIR+BCHKL	;SET BC2 START PAGE

	MOVE	P2,SMPBPG
	SETZM	PBCNT
	HLRZ	T7,FEDIR+BCHKL
BC2LP:	HRLZ	T1,FORKN	;GET PROCESS HANDLE
	HRR	T1,T4		;GET PAGE NUMBER
	RPACS			;READ PAGE ACCESS
	TDNE	T2,[PA%RD!PA%PEX]
	GO	COPPAG		;COPY PAGE

	AOBJN	T4,BC2LP	;TRY ANOTHER PAGE

	ANDI	P1,-1
	HRLM	P1,FEDIR+FSL	;RESET FREE SPACE START PAGE
	HRRZ	0,FEDIR+FSL	;FREE SPACE NOW SMALLER BY BC2
	SUB	0,PBCNT
	HRRM	0,FEDIR+FSL

	MOVE	P1,PBCNT
	HRRM	P1,FEDIR+BCHKL	;SET BC2 LENGTH

	SETOM	(P2)		;INDICATE END OF SPACE

	MOVE	T1,BOOTEV	;FIND ENTRY VECTOR
	HRRZM	T1,1(P2)	;SET ENTRY VECTOR

	HRLZ	T1,FEJFN
	HRRI	T1,^D27
	MOVE	T2,[.FHSLF,,<WINDOW_-^D9>]
	MOVE	T3,[PM%WR!PM%RD]
	PMAP			;GET BC2 PRE-BOOT IN FE-FILE
	 ERJMP	[JSERR
		 JRST	START]

	MOVE	[SMPREB,,WINDOW]
	BLT	WINDOW+777

	SETO	T1,
	SETZ	T3,
	PMAP			;PUT BC2 PRE-BOOT IN FE-FILE
	 ERJMP	[JSERR
		 JRST	START]

	MOVE	T1,FORKN
	KFORK			;KILL "GET" FORK
	 ERJMP	[JSERR
		 JRST	START]

	RTN
COPPAG:	PUT	T1
	PUT	T3

	SETZM	PAG0FLG#
	HRRZ	T3,T1
	CAIN	T3,1		;IS THIS PAGE 1 ?
	ERR	<CAN'T OVERLOAD PRE-BOOT PAGE>

	CAIN	T3,0		;IS THIS PAGE 0 ?
	SETOM	PAG0FLG		;IF PAGE 0 OF FILE, SET FLAG
	GETIT	T3
	GETIT	T1

	SKIPE	PAG0FLG		;IF PAGE 0, IGNORE IT
	RTN

	PUT	T1
	MOVE	T6,P2
	GO	SBOOTP		;SET 8080 POINTER
	AOS	P2

	GETIT	T1
	HRRZM	T1,0(P2)	;SET A POINTER TO PAGE NUMBER
	AOS	P2		;POINT TO NEXT

	PUT	T1
	HRRZ	T3,T1		;FIND THE PAGE
	HRL	T1,FORKN	;GET FORK NUMBER
	HRR	T1,T3		;GET PAGE NUMBER
	MOVE	T2,[.FHSLF,,<GENPAG_-^D9>]
	MOVE	T3,[PM%RD]
	PMAP			;GET PAGE IN SELF
	ERJMP	[JSERR
		JRST START]

	MOVE	T1,P1		;SET UP PMAP ARGUMENTS
	MOVE	T2,[.FHSLF,,<IPAG_-^D9>]
	MOVSI	T3,(PM%WR!PM%RD)
	PMAP
	ERJMP	[JSERR
		JRST START]	;JSYS ERROR

	MOVE	T3,[GENPAG,,IPAG]
	BLT	T3,IPAG+777

	SETO	T1,
	SETZ	T3,
	PMAP
	ERJMP	[JSERR
		JRST START]	;JSYS ERROR

	GETIT	T3		;REMOVE PAGE NUMBER
	AOS	P1		;UPDATE P1 ARGUMENTS
	AOS	PBCNT		;COUNT PAGES
	ADDI	T7,1		;UPDATE DISK ADDRESS
	RTN			;RETURN
;HERE TO READ MONITOR BOOT EXE FILE

WB10:	GO	OPNTEN		;OPEN INPUT FILE
	ERR	<FILE NOT FOUND>

	MOVE	T1,LOOK10+.RBNAM
	MOVEM	T1,O.NAM1	;SAME NAME AS INPUT
;A01 TO CLEAR WHEN THE TIME COMES
	MOVEM	T1,FILE		;Used by CLRNDL and SETNDL
	MOVEM	T1,BOONAM#	;Will be used when setting after write
	MOVE	T1,[SIXBIT/RIM/];Not the address
	MOVEM	T1,EXT		;Used by CLRNDL and SETNDL
	GO	CLRNDL		;Will error if file doesn't exist
	  JFCL		;ERR NEW FILE WILL BE CREATED IN PLACE ANYWAY
;A01END
	MOVSI	T1,(SIXBIT/RIM/)
	MOVEM	T1,O.EXT	;OUTPUT EXT IS ".RIM"

	MOVE	T1,LOOK10+.RBVER
	MOVEM	T1,O.VER	;USE INPUT VERSION AS OUTPUT VERSION

	LDB	T1,[POINT 11,LOOK10+.RBPRV,23]
	MOVEM	T1,O.TIME	;USE INPUT TIME AND DATE AS OUTPUT

	LDB	T1,[POINT 3,LOOK10+.RBEXT,20]
	DPB	T1,[POINT 3,O.DATE,23]
	LDB	T1,[POINT 12,LOOK10+.RBPRV,35]
	DPB	T1,[POINT 12,O.DATE,35]

	MOVE	T1,DIRDIR	;USE WRTSET'S PPN
	MOVEM	T1,O.PPN

	MOVE	T1,DIRDEV	;USE WRTSET'S DEVICE
	MOVEM	T1,O.DEV

	MOVEI	T1,577		;SET PROTECTION TO 577
	MOVEM	T1,O.PRT

	MOVE	T1,LOOK10+.RBSIZ ;GET FILE SIZE IN WORDS
	TRNE	T1,777
	ERR	<FILE NOT EVEN MULTIPLE OF PAGES>
	SOS	T1		;MINUS EXE DIR PAGE
	IDIVI	T1,^D512	;CONVERT TO PAGES
	MOVEM	T1,FEDIR+MBOOTL	;SET MONITOR BOOT LENGTH
	IMULI	T1,4		;CONVERT TO BLOCKS
	MOVEM	T1,S.ALO	;SET FOR ALLOCATION

	GO	ETER10		;ENTER OUTPUT FILE
	ERR	<FILE ENTER FAILURE>

;*NOW READ EXE FILE

	SETZM	SELPAG#
	GO	REDDIR		;READ THE DIRECTORY PAGE

	HLRZ	A,DBUF		;DIRECTORY DESCRIPTOR
	HRRZ	T6,DBUF		;LENGTH OF THE DIRECTORY
	CAIN	A,SV.DIR	;IS THIS A DIRECTORY?
	CAIL	T6,^D128	; WHICH IS LESS THAN OR EQUAL TO 128 WORDS LONG?
	ERR	<NOT A DIRECTORY OR ONE WE CAN'T HANDLE>

	MOVNI	T6,-1(T6)	;MAKE AN AOBJN POINTER TO THE DIRECTORY
	HRLI	T6,DBUF+1	; ..
	MOVSS	T6		; ..

	MOVEI	P2,RPPAGD
	ADDI	P2,1

WB10A:	MOVE	M,(T6)		;BITS,,FILE PAGE NUMBER
	HRRZ	T5,1(T6)	;CORE PAGE NUMBER
	LSH	T5,P2WLSH	;CORE ADDRESS
	SKIPN	T5		;PAGE 0?
	HRROI	T5,0		;YES, READ IT AND REMEMBER ITS PAGE 0

WB10C:	LDB	T7,[POINT 9,1(T6),8]

WB10D:	TRNN	M,-1		;AN ALLOCATED BUT ZERO PAGE?
	SOJA	M,WB10H		;YES, COUNT DOWN REPEAT COUNT AND UPDATE CORE ADDRESS
	HRRZ	T4,M		;FILE PAGE NUMBER
	LSH	T4,P2BLSH	;CONVERT TO BLOCK WITHIN THE FILE
	CAMGE	T4,SELPAG	;FILE PAGE NUMBERS MUST BE MONOTONICALLY INCREASING
	ERR	<PAGES IN EXE DIR AREN'T MONOTONICALLY INCREASING>

WB10E:	CAMN	T4,SELPAG	;AT THE RIGHT BLOCK WITHIN THE FILE?
	JRST	WB10G		;YES

WB10F:	GO	SELBLK		;BYPASS FILE PAGE
	JRST	WB10E		;SEE IF THERE YET
WB10G:	CAIN	T5,1000
	ERR	<CAN'T OVERLOAD PRE-BOOT PAGE>

	GO	REDPAG		;READ EXE DATA PAGE

	JUMPL	T5,WB10X	;PAGE 0 ?

	PUT	T5
	ANDI	T5,-1
	LSH	T5,W2PLSH
	HRRZM	T5,(P2)		;SET A POINTER TO PAGE NUMBER
	GETIT	T5
	ADDI	P2,2		;POINT TO NEXT

	OUT	WC,[IOWD ^D512,IPAG
		    0]
	SKIPA
	ERR	<WRITE ERROR>

	JUMPGE	T5,WB10H	;PAGE 0 JUST READ?

WB10X:	MOVE	IPAG+.JBSA
	MOVEM	BOOTEV		;SAVE STARTING ADDRESS

	MOVEI	T5,0		;READ NEXT PAGE INTO PAGE 1

WB10H:	ADDI	T5,PAGSIZ	;NEXT PAGE
WB10I:	SOSL	T7		;READ ALL THE PAGES DESCRIBED BY THIS ENTRY?
	AOJA	M,WB10D		;NO, READ THE NEXT PAGE

	AOBJN	T6,.+1		;BUMP PAST THIS DIRECTORY ENTRY, AND
	AOBJN	T6,WB10A	; GO GET THE NEXT DIRECTORY ENTRY

	SETOM	-1(P2)		;INDICATE END OF SPACE

	MOVE	T1,BOOTEV
	HRRZM	T1,(P2)		;SET ENTRY VECTOR
;*FIND 1ST PAGE OF FILE & PUT IN PRE-BOOT

	CLOSE	WC,CL.DLL	;CLOSE FILE
	RELEAS	WC,

	GO	GETBK2		;GET DISK ADDRESS
	MOVEM	T1,FEDIR+MBOOTP
	MOVEM	T1,T5

;*COMPUTE 8080 ADDRESSES - PUT IN PRE-BOOT

	MOVEI	T6,RPPAGD

WB10J:	MOVE	(T6)		;GET ADDRESS POINTER
	CAMN	[-1]		;TERMINATOR ?
	JRST	WB10K		;YES

	MOVE	T1,T5
	GO	TBOOTP		;SET DISK ADDRESS
	ADDI	T5,4
	ADDI	T6,2
	JRST	WB10J

WB10K:	SETZM	MPREBP
	MOVE	[MPREBP,,MPREBP+1]
	BLT	MPREBP+777

	MOVE	[BTSTR1,,MPREBP]	;PUT MONITOR PRE-BOOT IN PLACE
	BLT	MPREBP+<RPPAGX-BTSTR1>

	RTN			;DONE
;HERE TO READ DIAGNOSTIC BOOT EXE FILE

WDB10:	GO	OPNTEN		;OPEN INPUT FILE
	ERR	<FILE NOT FOUND>

	MOVE	T1,LOOK10+.RBNAM
	MOVEM	T1,O.NAM1	;SAME NAME AS INPUT

	MOVSI	T1,(SIXBIT/RIM/)
	MOVEM	T1,O.EXT	;OUTPUT EXT IS ".RIM"

	MOVE	T1,LOOK10+.RBVER
	MOVEM	T1,O.VER	;USE INPUT VERSION AS OUTPUT VERSION

	LDB	T1,[POINT 11,LOOK10+.RBPRV,23]
	MOVEM	T1,O.TIME	;USE INPUT TIME AND DATE AS OUTPUT

	LDB	T1,[POINT 3,LOOK10+.RBEXT,20]
	DPB	T1,[POINT 3,O.DATE,23]
	LDB	T1,[POINT 12,LOOK10+.RBPRV,35]
	DPB	T1,[POINT 12,O.DATE,35]

	MOVE	T1,DIRDIR	;USE WRTSET'S PPN
	MOVEM	T1,O.PPN

	MOVE	T1,DIRDEV	;USE WRTSET'S DEVICE
	MOVEM	T1,O.DEV

	MOVEI	T1,577		;SET PROTECTION TO 577
	MOVEM	T1,O.PRT

	MOVE	T1,LOOK10+.RBSIZ ;GET FILE SIZE IN WORDS
	TRNE	T1,777
	ERR	<FILE NOT EVEN MULTIPLE OF PAGES>
	SOS	T1		;MINUS EXE DIR PAGE
	IDIVI	T1,^D512	;CONVERT TO PAGES
	MOVEM	T1,FEDIR+DBOOTL	;SET MONITOR BOOT LENGTH
	IMULI	T1,4		;CONVERT TO BLOCKS
	MOVEM	T1,S.ALO	;SET FOR ALLOCATION

	GO	ETER10		;ENTER OUTPUT FILE
	ERR	<FILE ENTER FAILURE>

;*NOW READ EXE FILE

	SETZM	SELPAG#
	GO	REDDIR		;READ THE DIRECTORY PAGE

	HLRZ	A,DBUF		;DIRECTORY DESCRIPTOR
	HRRZ	T6,DBUF		;LENGTH OF THE DIRECTORY
	CAIN	A,SV.DIR	;IS THIS A DIRECTORY?
	CAIL	T6,^D128	; WHICH IS LESS THAN OR EQUAL TO 128 WORDS LONG?
	ERR	<NOT A DIRECTORY OR ONE WE CAN'T HANDLE>

	MOVNI	T6,-1(T6)	;MAKE AN AOBJN POINTER TO THE DIRECTORY
	HRLI	T6,DBUF+1	; ..
	MOVSS	T6		; ..

	MOVE	P2,SMPBPG
	ADDI	P2,1

WDB10A:	MOVE	M,(T6)		;BITS,,FILE PAGE NUMBER
	HRRZ	T5,1(T6)	;CORE PAGE NUMBER
	LSH	T5,P2WLSH	;CORE ADDRESS
	SKIPN	T5		;PAGE 0?
	HRROI	T5,0		;YES, READ IT AND REMEMBER ITS PAGE 0

WDB10C:	LDB	T7,[POINT 9,1(T6),8]

WDB10D:	TRNN	M,-1		;AN ALLOCATED BUT ZERO PAGE?
	SOJA	M,WDB10H	;YES, COUNT DOWN REPEAT COUNT AND UPDATE CORE ADDRESS
	HRRZ	T4,M		;FILE PAGE NUMBER
	LSH	T4,P2BLSH	;CONVERT TO BLOCK WITHIN THE FILE
	CAMGE	T4,SELPAG	;FILE PAGE NUMBERS MUST BE MONOTONICALLY INCREASING
	ERR	<PAGES IN EXE DIR AREN'T MONOTONICALLY INCREASING>

WDB10E:	CAMN	T4,SELPAG	;AT THE RIGHT BLOCK WITHIN THE FILE?
	JRST	WDB10G		;YES

WDB10F:	GO	SELBLK		;BYPASS FILE PAGE
	JRST	WDB10E		;SEE IF THERE YET
WDB10G:	CAIN	T5,1000
	ERR	<CAN'T OVERLOAD PRE-BOOT PAGE>

	GO	REDPAG		;READ EXE DATA PAGE

	JUMPL	T5,WDB10X	;PAGE 0 ?

	PUT	T5
	ANDI	T5,-1
	LSH	T5,W2PLSH
	HRRZM	T5,(P2)		;SET A POINTER TO PAGE NUMBER
	GETIT	T5
	ADDI	P2,2		;POINT TO NEXT

	OUT	WC,[IOWD ^D512,IPAG
		    0]
	SKIPA
	ERR	<WRITE ERROR>

	JUMPGE	T5,WDB10H	;PAGE 0 JUST READ?

WDB10X:	MOVE	IPAG+.JBSA
	MOVEM	BOOTEV		;SAVE STARTING ADDRESS

	MOVEI	T5,0		;READ NEXT PAGE INTO PAGE 1

WDB10H:	ADDI	T5,PAGSIZ	;NEXT PAGE
WDB10I:	SOSL	T7		;READ ALL THE PAGES DESCRIBED BY THIS ENTRY?
	AOJA	M,WDB10D	;NO, READ THE NEXT PAGE

	AOBJN	T6,.+1		;BUMP PAST THIS DIRECTORY ENTRY, AND
	AOBJN	T6,WDB10A	; GO GET THE NEXT DIRECTORY ENTRY

	SETOM	-1(P2)		;INDICATE END OF SPACE

	MOVE	T1,BOOTEV
	HRRZM	T1,(P2)	;SET ENTRY VECTOR
;*FIND 1ST PAGE OF FILE & PUT IN PRE-BOOT

	CLOSE	WC,CL.DLL	;CLOSE FILE
	RELEAS	WC,

	GO	GETBK2		;GET DISK ADDRESS
	MOVEM	T1,FEDIR+DBP
	MOVEM	T1,T5

;*COMPUTE 8080 ADDRESSES - PUT IN PRE-BOOT

	MOVE	T6,SMPBPG

WDB10J:	MOVE	(T6)		;GET ADDRESS POINTER
	CAMN	[-1]		;TERMINATOR ?
	JRST	WDB10K		;YES

	MOVE	T1,T5
	GO	TBOOTP		;SET DISK ADDRESS
	ADDI	T5,4
	ADDI	T6,2
	JRST	WDB10J

WDB10K:	SETZM	DPREBP
	MOVE	[DPREBP,,DPREBP+1]
	BLT	DPREBP+777

	MOVE	[SMPREB,,DPREBP]	;PUT DIAGNOSTIC PRE-BOOT IN PLACE
	BLT	DPREBP+777

	RTN			;DONE
;HERE TO READ DIAGNOSTIC BC2 EXE FILE

BC210:	GO	OPNTEN		;OPEN INPUT FILE
	ERR	<FILE NOT FOUND>

	MOVE	T1,LOOK10+.RBNAM
	MOVEM	T1,O.NAM1	;SAME NAME AS INPUT

	MOVSI	T1,(SIXBIT/RIM/)
	MOVEM	T1,O.EXT	;OUTPUT EXT IS ".RIM"

	MOVE	T1,LOOK10+.RBVER
	MOVEM	T1,O.VER	;USE INPUT VERSION AS OUTPUT VERSION

	LDB	T1,[POINT 11,LOOK10+.RBPRV,23]
	MOVEM	T1,O.TIME	;USE INPUT TIME AND DATE AS OUTPUT

	LDB	T1,[POINT 3,LOOK10+.RBEXT,20]
	DPB	T1,[POINT 3,O.DATE,23]
	LDB	T1,[POINT 12,LOOK10+.RBPRV,35]
	DPB	T1,[POINT 12,O.DATE,35]

	MOVE	T1,DIRDIR	;USE WRTSET'S PPN
	MOVEM	T1,O.PPN

	MOVE	T1,DIRDEV	;USE WRTSET'S DEVICE
	MOVEM	T1,O.DEV

	MOVEI	T1,577		;SET PROTECTION TO 577
	MOVEM	T1,O.PRT

	MOVE	T1,LOOK10+.RBSIZ ;GET FILE SIZE IN WORDS
	TRNE	T1,777
	ERR	<FILE NOT EVEN MULTIPLE OF PAGES>
	SOS	T1		;MINUS EXE DIR PAGE
	IDIVI	T1,^D512	;CONVERT TO PAGES
	MOVEM	T1,FEDIR+BCHKL	;SET BC2 LENGTH
	IMULI	T1,4		;CONVERT TO BLOCKS
	MOVEM	T1,S.ALO	;SET FOR ALLOCATION

	GO	ETER10		;ENTER OUTPUT FILE
	ERR	<FILE ENTER FAILURE>
;*NOW READ EXE FILE

	SETZM	SELPAG#
	GO	REDDIR		;READ THE DIRECTORY PAGE

	HLRZ	A,DBUF		;DIRECTORY DESCRIPTOR
	HRRZ	T6,DBUF		;LENGTH OF THE DIRECTORY
	CAIN	A,SV.DIR	;IS THIS A DIRECTORY?
	CAIL	T6,^D128	; WHICH IS LESS THAN OR EQUAL TO 128 WORDS LONG?
	ERR	<NOT A DIRECTORY OR ONE WE CAN'T HANDLE>

	MOVNI	T6,-1(T6)	;MAKE AN AOBJN POINTER TO THE DIRECTORY
	HRLI	T6,DBUF+1	; ..
	MOVSS	T6		; ..

	MOVE	P2,SMPBPG
	ADDI	P2,1

BC210A:	MOVE	M,(T6)		;BITS,,FILE PAGE NUMBER
	HRRZ	T5,1(T6)	;CORE PAGE NUMBER
	LSH	T5,P2WLSH	;CORE ADDRESS
	SKIPN	T5		;PAGE 0?
	HRROI	T5,0		;YES, READ IT AND REMEMBER ITS PAGE 0

BC210C:	LDB	T7,[POINT 9,1(T6),8]

BC210D:	TRNN	M,-1		;AN ALLOCATED BUT ZERO PAGE?
	SOJA	M,BC210H	;YES, COUNT DOWN REPEAT COUNT AND UPDATE CORE ADDRESS
	HRRZ	T4,M		;FILE PAGE NUMBER
	LSH	T4,P2BLSH	;CONVERT TO BLOCK WITHIN THE FILE
	CAMGE	T4,SELPAG	;FILE PAGE NUMBERS MUST BE MONOTONICALLY INCREASING
	ERR	<PAGES IN EXE DIR AREN'T MONOTONICALLY INCREASING>

BC210E:	CAMN	T4,SELPAG	;AT THE RIGHT BLOCK WITHIN THE FILE?
	JRST	BC210G		;YES

BC210F:	GO	SELBLK		;BYPASS FILE PAGE
	JRST	BC210E		;SEE IF THERE YET
BC210G:	CAIN	T5,1000
	ERR	<CAN'T OVERLOAD PRE-BOOT PAGE>

	GO	REDPAG		;READ EXE DATA PAGE

	JUMPGE	T5,.+6		;PAGE 0 ?

	PUT	T1
	SETZM	IPAG+KPALIVE	;YES, ZERO 8080 COMM AREA
	MOVE	T1,[IPAG+KPALIVE,,IPAG+KPALIVE+1]
	BLT	T1,IPAG+MSSLAVE
	GETIT	T1

	PUT	T5
	ANDI	T5,-1
	LSH	T5,W2PLSH
	HRRZM	T5,(P2)		;SET A POINTER TO PAGE NUMBER
	GETIT	T5
	ADDI	P2,2		;POINT TO NEXT

	OUT	WC,[IOWD ^D512,IPAG
		    0]
	SKIPA
	ERR	<WRITE ERROR>

	JUMPGE	T5,BC210H	;PAGE 0 JUST READ?

	MOVE	IPAG+.JBSA
	MOVEM	BOOTEV		;SAVE STARTING ADDRESS

	MOVEI	T5,0		;READ NEXT PAGE INTO PAGE 1

BC210H:	ADDI	T5,PAGSIZ	;NEXT PAGE
BC210I:	SOSL	T7		;READ ALL THE PAGES DESCRIBED BY THIS ENTRY?
	AOJA	M,BC210D	;NO, READ THE NEXT PAGE

	AOBJN	T6,.+1		;BUMP PAST THIS DIRECTORY ENTRY, AND
	AOBJN	T6,BC210A	; GO GET THE NEXT DIRECTORY ENTRY

	SETOM	-1(P2)		;INDICATE END OF SPACE

	MOVE	T1,BOOTEV
	HRRZM	T1,(P2)	;SET ENTRY VECTOR
;*FIND 1ST PAGE OF FILE & PUT IN PRE-BOOT

	CLOSE	WC,CL.DLL	;CLOSE FILE
	RELEAS	WC,

	GO	GETBK2		;GET DISK ADDRESS
	MOVEM	T1,FEDIR+BCHKP
	MOVEM	T1,T5

;*COMPUTE 8080 ADDRESSES - PUT IN PRE-BOOT

	MOVE	T6,SMPBPG

BC210J:	MOVE	(T6)		;GET ADDRESS POINTER
	CAMN	[-1]		;TERMINATOR ?
	JRST	BC210K		;YES

	MOVE	T1,T5
	GO	TBOOTP		;SET DISK ADDRESS
	ADDI	T5,4
	ADDI	T6,2
	JRST	BC210J

BC210K:	SETZM	BCPREBP
	MOVE	[BCPREBP,,BCPREBP+1]
	BLT	BCPREBP+777

	MOVE	[SMPREB,,BCPREBP]	;PUT DIAGNOSTIC PRE-BOOT IN PLACE
	BLT	BCPREBP+777

	RTN			;DONE
;*MONITOR BOOT STRAP PROGRAM TO BE WRITTEN ON THE DISK

BTSTR1:
	PHASE	BOORG

BTSTRT:!JRST	BTSTAR

BTHLT0:!HALT	.		;TRIED TO OVERLOAD PRE-BOOT
BTHLT1:!HALT	.		;DISK RETRY FAILURE
BTHLT2:!HALT	.		;NO RH-11 BASE ADDRESS
BTHLT3:!HALT	.		;RESERVED

BTSTAR:!MOVSI	17,-17
	SETZM	(17)		;ZERO AC'S
	AOBJN	17,.-1
	SETZM	17

	MOVE	P1,MSRH		;GET DISK ADDRESS
	MOVEM	P1,MSRHSV
	SKIPN	P1
	JRST	BTHLT2		;NO RH-11 BASE ADDRESS ?
	HLLM	P1,BTUBP0	;SETUP UBA MAP POINTER
	HLLM	P1,BTUBST	;SETUP UBA STATUS POINTER

	MOVE	T1,BOOTPA	;SAVE BOOT DATA VECTOR ADDRESS
	MOVEM	T1,BTSV20

	MOVE	T1,KPALIVE
	MOVEM	T1,MSKPAL	;SAVE KEEP-ALIVE WORD

	MOVEI	T1,RHCLR
	WRIO	T1,RPCS2(P1)	;CLEAR CONTROLLER

	MOVE	T1,MSDRIVE
	MOVEM	T1,MSDRSV
	WRIO	T1,RPCS2(P1)	;SELECT DRIVE

	MOVEI	T1,RIPST	;DO READIN PRESET
	WRIO	T1,RPCS1(P1)	;WRITE REGISTER
	MOVEI	T2,RDY		;WAIT FOR READY
	TION	T2,RPDS(P1)	;CHECK READY?
	JRST	.-1		;NO -- CONTINUE WAIT

	MOVEI	T3,RPPAG	;FIND THE OFFSET STUFF
	MOVEI	T5,^D10		;SET RETRY COUNT
RDABLK:!MOVE	T4,0(T3)	;FIND THE DISK ADDRESS
	JUMPL	T4,RDADON	;QUIT IF ALL DONE WITH PAGES

	AOS	T3		;POINT TO BLOCK ENTRIES
	WRIO	T4,RPDA(P1)	;SET DISK ADDRESS
	MOVSS	T4		;FIND CYL ADDRESS
	WRIO	T4,RPDC(P1)	;SET CYL ADDRESS

	MOVNI	T4,2000		;READ A PAGE (WORD COUNT)
	WRIO	T4,RPWC(P1)	;SET WORD COUNT

	SETZ	T4,		;CLEAR CURRENT ADDRESS REGISTER
	WRIO	T4,RPBA(P1)	;SET UNIBUS ADDRESS TO 0

	MOVE	T4,0(T3)	;FIND THE CORE ADDRESS
	AOS	T3		;POINT TO NEXT ENTRY
	CAIN	T4,1		;CAN'T OVERLOAD PRE-BOOT
	JRST	RDBADR		;PAGE 1 REQUESTED TO BE LOADED ?

	IORI	T4,UBVBIT!UNV36X
	WRIO	T4,@BTUBP0	;SET UP UNIBUS ADAPTOR PAGE 0

	MOVEI	T4,RDATA	;SET GO
	WRIO	T4,RPCS1(P1)	;WAIT FOR GO
	RDIO	T4,RPCS1(P1)
	TRNN	T4,RDY
	JRST	.-2		;HO HUM WAIT

	TRNN	T4,TRE!MCPE	;CHECK ERROR CONDITION SUMMARY
	JRST	RDABLK		;DO NEXT PAGE

	SUBI	T3,2		;BACKUP TO SAME ENTRY
	SOJLE	T5,RDFAIL	;TRY AGAIN TILL RETRY RUNS OUT

RDRTRY:!MOVEI	T1,RHCLR	;ERROR, CLEAR & TRY AGAIN
	WRIO	T1,RPCS2(P1)	;CLEAR CONTROLLER

	MOVE	T1,MSDRIVE
	WRIO	T1,RPCS2(P1)	;SELECT DRIVE

	JRST	RDABLK		;TRY AGAIN
RDBADR:!MOVEI	17,BTHLT0	;SET HALT ADDRESS
	SUBI	T3,2		;POINT TO FAILING ENTRY
	JRST	.+2

RDFAIL:!MOVEI	17,BTHLT1	;SET HALT ADDRESS
	MOVE	(T3)
	MOVEM	100		;SAVE 8080 DISK ADDRESS
	MOVE	1(T3)
	MOVEM	101		;SAVE MEMORY PAGE ADDRESS

	MOVEM	T3,102		;SAVE SELECTION PICKUP POINTER

	RDIO	RPCS1(P1)
	MOVEM	103		;SAVE CONTROL AND STATUS 1
	RDIO	RPCS2(P1)
	MOVEM	104		;SAVE CONTROL AND STATUS 2
	RDIO	RPDS(P1)
	MOVEM	105		;SAVE DRIVE STATUS
	RDIO	RPER1(P1)
	MOVEM	106		;SAVE ERROR 1
	RDIO	RPER2(P1)
	MOVEM	107		;SAVE ERROR 2
	RDIO	RPER3(P1)
	MOVEM	110		;SAVE ERROR 3

	RDIO	@BTUBP0
	MOVEM	111		;SAVE UBA PAGING RAM LOC 0
	RDIO	@BTUBST
	MOVEM	112		;SAVE UBA STATUS REG

	MOVE	BTVER
	MOVEM	113		;SAVE PRE-BOOT VERSION

	MOVE	MSRHSV
	MOVEM	MSRH		;REINSTALL RH-11 BASE ADDRESS
	MOVE	MSDRSV
	MOVEM	MSDRIVE		;REINSTALL DRIVE NUMBER
	MOVE	MSKPAL
	MOVEM	KPALIVE		;REINSTALL KEEP-ALIVE
	MOVE	BTSV20		;RESTORE BOOT DATA VECTOR
	MOVEM	BOOTPA

	JRST	@17		;HALT AT APPROPRIATE HALT
RDADON:!MOVE	1(T3)		;GET START ADDRESS
	EXCH	BTSV20		;STORE START ADDRESS, GET BOOT DATA VECTOR
	MOVEM	BOOTPA		;RESTORE BDV

	WRUBR	ACBLK7
	MOVSI	17,-17
	SETZM	(17)		;ZERO AC'S
	AOBJN	17,.-1
	SETZM	17

	WRUBR	ACBLK6
	MOVSI	17,-17
	SETZM	(17)		;ZERO AC'S
	AOBJN	17,.-1
	SETZM	17

	WRUBR	ACBLK5
	MOVSI	17,-17
	SETZM	(17)		;ZERO AC'S
	AOBJN	17,.-1
	SETZM	17

	WRUBR	ACBLK4
	MOVSI	17,-17
	SETZM	(17)		;ZERO AC'S
	AOBJN	17,.-1
	SETZM	17

	WRUBR	ACBLK3
	MOVSI	17,-17
	SETZM	(17)		;ZERO AC'S
	AOBJN	17,.-1
	SETZM	17

	WRUBR	ACBLK2
	MOVSI	17,-17
	SETZM	(17)		;ZERO AC'S
	AOBJN	17,.-1
	SETZM	17

	WRUBR	ACBLK1
	MOVSI	17,-17
	SETZM	(17)		;ZERO AC'S
	AOBJN	17,.-1
	SETZM	17

	WRUBR	ACBLK0
	MOVSI	17,-17
	SETZM	(17)		;ZERO AC'S
	AOBJN	17,.-1
	SETZM	17
	MOVE	MSRHSV
	MOVEM	MSRH		;REINSTALL RH-11 BASE ADDRESS
	MOVE	MSDRSV
	MOVEM	MSDRIVE		;REINSTALL DRIVE NUMBER
	MOVE	MSKPAL
	MOVEM	KPALIVE		;REINSTALL KEEP-ALIVE

	SETZ
	JRST	@BTSV20		;NOW START BOOT

ACBLK7:!	1B0!7B8		;WRUBR ARGUMENTS
ACBLK6:!	1B0!6B8
ACBLK5:!	1B0!5B8
ACBLK4:!	1B0!4B8
ACBLK3:!	1B0!3B8
ACBLK2:!	1B0!2B8
ACBLK1:!	1B0!1B8
ACBLK0:!	1B0!0B8

MSKPAL:!	0		;KEEP-ALIVE & STATUS WORD
MSRHSV:!	0		;RH-11 BASE ADDRESS
MSDRSV:!	0		;DRIVE NUMBER

BTSV20:!	0		;SAVED BDV ADDRESS
BTVER:!	BYTE (3)0(9)MCNVER(6)0(18)DECVER	;PRE-BOOT VERSION

BTUBP0:!	1,,763000	;ADDRESS OF FIRST WINDOW
BTUBST:!	1,,763100	;ADDRESS OF UBA STATUS

RPPAG:!				;NEXT TWO INSTRUCTIONS MUST FOLLOW!!DO NOT MOVE
	DEPHASE

RPPAGD:	BLOCK	100		;CORE PAGE #S FOR EACH DISK PAGE
RPPAGX:	0
IFG <.-BTSTR1>-1000,<PRINTX ?DISK BOOTSTRAP BIGGER THAN 1 PAGE>
;*WRITE MICRO-CODE ONTO DISK

WRTBC1:	SETOM	BC1FLG
	JRST	WRTCRM+1
WRTCRM:	SETZM	BC1FLG
	NOISE	<MICROCODE ONTO DISK>
	CONFIRM

	SKIPN	FESETF		;FE-DIR  IN CODE ?
	 ERR	<FE-FILE SYSTEM NOT SETUP>
	SKIPN	RDFLAG
	ERR	<MUST FIRST READ MICROCODE WITH READ COMMAND>

	SKIPN	MONTYP
	JRST	WRTC10		;TOPS-10

	HLRZ	T3,FEDIR+MCL	;GET MICROCODE START PAGE
	SKIPE	BC1FLG
	HLRZ	T3,FEDIR+BC1L
	LSH	T3,^D9		;MAKE WORD POINTER INTO FILE
	MOVEM	T3,WTPTR#	;SAVE

	MOVE	T1,FEJFN
	MOVE	T2,WTPTR
	SFPTR
	ERMSG	<CAN NOT SET FILE POINTER>

	MOVEI	T6,CRAM
	SKIPE	BC1FLG
	MOVEI	T6,CRMBC1
	MOVEI	T5,4000
WTLOOP:	MOVE	T2,(T6)
	BOUT
	MOVE	T2,1(T6)
	BOUT
	MOVE	T2,2(T6)
	BOUT
	ADDI	T6,3
	SOJG	T5,WTLOOP

	MOVE	T1,FEJFN
	MOVEI	T2,0		;SET FILE POINTER TO 0
	SFPTR
	ERMSG	<CAN NOT SET FILE POINTER>

WRTC10:	MOVEI	T6,FEDIR+MCP
	HLRZ	T7,FEDIR+MCL
	SKIPN	BC1FLG
	JRST	.+3
	MOVEI	T6,FEDIR+BC1P
	HLRZ	T7,FEDIR+BC1L
	GO	S8080P		;SETUP 8080 POINTER

	RTN
;*WRTFEF, WRITE FRONT-END INDIRECT FILES
;*	COMMAND - [INDIRECT "0-366(8)" "FILE.EXT"
;*	CREATES - "FEF000.FI" TO "FEF366.FI" (TOPS-10)

WRTFEF:	CMD	[FLDDB.(.CMNUM,,^D8)],<NOT A VALID FILE NUMBER>

	SKIPL	T2
	CAILE	T2,366
	ERR	<NOT A VALID FILE NUMBER>
	MOVEM	T2,FEFNBR#

	SETZM	GTJFIL		;NO DEFAULTS ALLOWED
	SETZM	GTJEXT
	SETZM	GTJDEV
	SETZM	GTJDIR

	MOVSI	T1,(GJ%OLD)
	MOVEM	T1,GTJFLG

	CMD	[FLDDB.(.CMFIL)]
	HRLZM	T2,FEFJFN#	;SAVE THE JFN OF THE FILE

	CONFIRM

	SKIPN	FESETF
	ERR	<FE-FILE SYSTEM NOT SETUP>

	SKIPN	MONTYP
	JRST	FEF10		;TOPS-10

	HRRZ	T1,FEDIR+FSL	;GET FREE SPACE LENGTH
	CAIGE	T1,1		;THIS NEEDS ONE PAGE
	ERR	<NOT ENOUGH FREE SPACE>
	HLRZ	T1,FEFJFN
	MOVEI	T2,OF%RD
	OPENF			;OPEN FILE
	ERR	<INDIRECT OPEN ERROR>

	HLRZ	T1,FEFJFN
	MOVE	T2,[1,,.FBBYV]
	MOVEI	T3,T4
	GTFDB			;GET FILE PAGE COUNT
	ANDI	T4,-1
	CAIE	T4,^D1		;CAN ONLY BE ONE PAGE
	 JRST	FEFERR		;WRONG LENGTH

	MOVE	T1,FEFJFN
	MOVE	T2,[.FHSLF,,<GENPAG_-^D9>]
	MOVE	T3,[PM%RD+PM%PLD+PM%CPY]
	PMAP			;GET FILE
	ERJMP	[JSERR
		 JRST	START]

	SETMM	GENPAG		;MAKE PRIVATE

	HLRZ	T1,FEFJFN
	CLOSF			;CLOSE FILE
	ERR	<INDIRECT CLOSE ERROR>

	GO	FEIFMT		;FORMAT INDIRECT FILE

	MOVE	T1,[.FHSLF,,<IPAG_-^D9>]
	HRLZ	T2,FEJFN
	HLR	T2,FEDIR+FSL	;GET FREE-SPACE PAGE
	MOVE	T3,[PM%WR]
	PMAP			;PUT INDIRECT INTO FE-FILE
	 ERJMP	[JSERR
		 JRST	START]
	MOVE	T1,FEDIR+FSL	;GET FREE-SPACE PAGE #,,LENGTH
	MOVE	T2,T1
	SUBI	T1,1		;MINUS ONE IN LENGTH
	ADD	T1,[1,,0]	;PLUS ONE TO PAGE #
	MOVEM	T1,FEDIR+FSL	;RESAVE

	MOVE	T1,FEFNBR	;GET INDIRECT NUMBER
	IMULI	T1,2		;DOUBLE IT
	ADDI	T1,FEDIR+IFL0	;ADD FEDIR START POSITION

	HRRI	T2,^D1		;MAKE POINTER PAGE #,,1
	MOVEM	T2,(T1)		;SETUP FE-DIR POINTER

	RTN

FEFERR:	HLRZ	T1,FEFJFN
	CLOSF			;CLOSE OUT BAD INDIRECT
	ERR	<INDIRECT CLOSE ERROR>
	ERR	<INDIRECT WRONG LENGTH>
;*FEF10, TOPS-10 WRITE FRONT-END INDIRECT FILES

FEF10:	GO	OPNTEN		;OPEN INPUT FILE
	ERR	<FILE NOT FOUND>

	MOVE	T1,LOOK10+.RBSIZ ;GET FILE SIZE IN WORDS
	CAILE	T1,^D512	;MUST BE ONE PAGE OR LESS
	ERR	<INDIRECT WRONG LENGTH>

	SETZM	GENPAG
	MOVE	T1,[GENPAG,,GENPAG+1]
	BLT	T1,GENPAG+777

	MOVEI	T7,GENPAG		;READ IN INDIRECT
	GO	GET10
	SKIPGE	EOFSW
	JRST	.+3
	MOVEM	T3,(T7)
	AOJA	T7,.-4

	GO	R10EOF		;CLOSE INPUT FILE

	GO	FEIFMT		;FORMAT INDIRECT FILE

	SETZ	T1,		;COOK UP OUTPUT FILE NAME
	LDB	[POINT 3,FEFNBR,29]
	DPB	[POINT 3,T1,23]
	LDB	[POINT 3,FEFNBR,32]
	DPB	[POINT 3,T1,29]
	LDB	[POINT 3,FEFNBR,35]
	DPB	[POINT 3,T1,35]
	ADD	T1,[SIXBIT/FEF000/]
	MOVEM	T1,O.NAM1

	MOVSI	T1,(SIXBIT/FI/)
	MOVEM	T1,O.EXT

	MOVE	T1,DIRDIR	;USE WRTSET'S PPN
	MOVEM	T1,O.PPN

	MOVE	T1,DIRDEV	;USE WRTSET'S DEVICE
	MOVEM	T1,O.DEV

	MOVEI	T1,577		;SET PROTECTION 577
	MOVEM	T1,O.PRT
	SETZM	O.VER
	SETZM	O.TIME
	SETZM	O.DATE

	MOVEI	T1,4		;MAKE FILE ONE PAGE
	MOVEM	T1,S.ALO

	GO	ETER10		;CREATE FILE
	ERR	<FILE ENTER ERROR>

	OUT	WC,[IOWD ^D512,IPAG
		    0]
	SKIPA
	ERR	<WRITE ERROR>

	CLOSE	WC,CL.DLL	;CLOSE FILE
	RELEAS	WC,

	GO	GETBK2		;GET DISK ADDRESS
	MOVEM	T1,T7
	MOVE	T6,FEFNBR	;POINT TO FEDIR POSITION
	IMULI	T6,2
	ADDI	T6,FEDIR+IFP0

	MOVEI	T2,1
	MOVEM	T2,1(T6)	;MARK IN USE

	GO	T8080P		;COMPUTE 8080 POINTER

	RTN
;*FEIFMT, FORMAT FRONT-END INDIRECT FILES

FEIFMT:	SETZM	IPAG		;CLEAR STORAGE
	MOVE	T1,[IPAG,,IPAG+1]
	BLT	T1,IPAG+777

	MOVE	T6,[POINT 7,GENPAG]
	MOVEI	T5,IPAG
	MOVEI	T4,<^D512*^D4>-1

FEILP:	SETZ	T2,
	GO	FEICHR		;FIRST CHAR
	JRST	FEILP2		;EOF
	DPB	T3,[POINT 8,T2,35]

	GO	FEICHR		;SECOND CHAR
	JRST	FEILP1		;EOF
	DPB	T3,[POINT 8,T2,27]

	GO	FEICHR		;FIRST CHAR
	JRST	FEILP1		;EOF
	DPB	T3,[POINT 8,T2,19]

	GO	FEICHR		;FIRST CHAR
	JRST	FEILP1		;EOF
	DPB	T3,[POINT 8,T2,11]

	MOVEM	T2,(T5)		;STORE WORD
	AOJA	T5,FEILP	;LOOP TILL EOF

FEILP1:	MOVEM	T2,(T5)		;SAVE FINAL WORD
FEILP2:	RTN			;DONE

FEICHR:	CAMN	T6,[POINT 7,GENPAG+777,34]
	JRST	FEIBIG		;INPUT FILE TOO BIG

	ILDB	T3,T6		;GET INPUT CHAR
	JUMPN	T3,.+2
	RTN			;NULL, END-OF-FILE
	SOJLE	T4,FEIBIG	;COUNT CHAR, JUMP IF TOO MANY
	JRST	CPOPJ1		;SKIP RETURN WITH CHAR

FEIBIG:	ERR	<INDIRECT FILE TOO BIG>
;*TYPE, TYPE CONTENTS OF INDIRECT FILE

	SCMTAB	..TYPE
	CMTAB	INDIRECT,TYPEFI
	ECMTAB

.TYPE:	CMD	[FLDDB.(.CMKEY,,..TYPE)],<CAN NOT TYPE THAT>
	HRRZ	T1,(T2)
	JRST	(T1)

TYPEFI:	CMD	[FLDDB.(.CMNUM,,^D8)],<NOT A VALID FILE NUMBER>
	SKIPL	T2
	CAILE	T2,366
	ERR	<NOT A VALID FILE NUMBER>
	MOVEM	T2,FEFNBR

	CONFIRM

	SKIPN	FESETF
	ERR	<FE-FILE SYSTEM NOT SETUP>

	MOVE	T1,FEFNBR	;GET INDIRECT FILE NUMBER
	IMULI	T1,2		;DOUBLE IT
	ADDI	T1,FEDIR+IFL0	;ADD FEDIR START POSITION

	SKIPN	MONTYP
	JRST	TYPF10		;TOPS-10

	HLRZ	T1,(T1)		;GET FE-DIR POINTER

	SKIPN	T1
	ERR	<INDIRECT FILE DOES NOT EXIST>

	HRL	T1,FEJFN
	MOVE	T2,[.FHSLF,,<IPAG_-^D9>]
	MOVE	T3,[PM%RD]
	PMAP			;GET INDIRECT FILE
	ERJMP	[JSERR
		 JRST	START]

	PCRLF
	MOVEI	T6,IPAG
	MOVE	T3,(T6)
	GO	FEITYP		;PRINT IT
	AOJA	T6,.-2
	PCRLF

	RTN
FEITYP:	LDB	0,[POINT 8,T3,35]
	JUMPE	0,CPOPJ1
	GO	FEIPNT

	LDB	0,[POINT 8,T3,27]
	JUMPE	0,CPOPJ1
	GO	FEIPNT

	LDB	0,[POINT 8,T3,19]
	JUMPE	0,CPOPJ1
	GO	FEIPNT

	LDB	0,[POINT 8,T3,11]
	JUMPE	0,CPOPJ1
	GO	FEIPNT

	RTN

FEIPNT:	CAIE	0,15		;CR ?
	JRST	.+3		;NO
	PNTCHF			;YES, PRINT CR/LF
	MOVEI	0,12
	PNTCHF
	RTN
;*TYPF10, TOPS-10 TYPE CONTENTS OF INDIRECT FILE

TYPF10:	SKIPN	(T1)
	ERR	<INDIRECT FILE DOES NOT EXIST>

	SETZ	T1,		;COOK UP INPUT FILE NAME
	LDB	[POINT 3,FEFNBR,29]
	DPB	[POINT 3,T1,23]
	LDB	[POINT 3,FEFNBR,32]
	DPB	[POINT 3,T1,29]
	LDB	[POINT 3,FEFNBR,35]
	DPB	[POINT 3,T1,35]
	ADD	T1,[SIXBIT/FEF000/]
	MOVEM	T1,GTJFIL

	MOVSI	T1,(SIXBIT/FI/)
	MOVEM	T1,GTJEXT

	MOVE	T1,DIRDIR
	MOVEM	T1,GTJDIR

	MOVE	T1,DIRDEV
	MOVEM	T1,GTJDEV

	GO	OPNTEN		;FIND INPUT FILE
	ERR	<INDIRECT FILE DOES NOT EXIST>

	PCRLF
TF10LP:	GO	GET10		;GET INPUT WORD
	SKIPGE	EOFSW
	JRST	.+3		;END-OF-FILE

	GO	FEITYP		;PRINT IT
	JRST	TF10LP

	PCRLF
	JRST	R10EOF
;*FETELL, REPORT INDIRECT FILES IN USE & FREE SPACE

FETELL:	PMSGF	<^THE FOLLOWING FRONT-END INDIRECT FILES EXIST:^>

	MOVEI	T6,FEDIR+IFL0	;GET START ADDRESS
	SETZ	T7,		;ZERO FORMAT COUNTER

FETEL0:	MOVE	(T6)		;GET ENTRY
	JUMPE	FETEL1		;NOT USED

	MOVE T6
	SUBI	FEDIR+IFL0
	IDIVI	2
	PNTOCF			;PRINT IT

	AOS	T7
	TRNE	T7,3
	JRST	.+3
	PCRLF
	JRST	.+2
	PTAB

FETEL1:	ADDI	T6,2		;STEP TO NEXT ENTRY
	CAIE	T6,FEDIR+1001	;DONE ?
	JRST	FETEL0		;NOT YET

	SKIPN	MONTYP
	JRST	FETEL2

	PMSGF	<^FRONT-END FREE PAGES = >
	HRRZ	FEDIR+FSL
	PNTDCF

FETEL2:	PCRLF
	PCRLF
	RTN
;ADDR DIVIDED BY SECTOR/CYL = CYL
;REM DIVIDED BY SECTOR/TRACK = TRACK
;REM = SECTOR

S8080P:	MOVE	T1,T7
	IMULI	T1,4		;CHANGE PAGES TO SECTORS
	SKIPE	MONTYP
	ADD	T1,HOMPAG+200+101
	SKIPN	MONTYP
	ADD	T1,HOMBUF+101
T8080P:	AND	T1,[37,,-1]	;MASK ADDRESS BITS ONLY
	SKIPE	RM03F
	GO	TRM03P		;RM03 DISK
	IDIVI	T1,<^D20*^D19>	;FIND CYL

	PUT	T1
	MOVE	T1,T2
	SKIPN	RM03F
	IDIVI	T1,^D20		;FIND SECTOR
	SKIPE	RM03F
	IDIVI	T1,^D30
	LSH	T1,8
	IOR	T1,T2
	GETIT	T2

	LSH	T2,6
	HRL	T1,T2
	MOVEM	T1,(T6)		;STORE 8080 POINTER
	RTN

SBOOTP:	MOVE	T1,T7
	IMULI	T1,4		;CHANGE PAGES TO SECTORS
	ADD	T1,HOMPAG+200+101
TBOOTP:	AND	T1,[37,,-1]	;MASK ADDRESS BITS ONLY
	SKIPE	RM03F
	GO	TRM03P		;RM03 DISK
	IDIVI	T1,<^D20*^D19>	;FIND CYL

	PUT	T1
	MOVE	T1,T2
	SKIPN	RM03F
	IDIVI	T1,^D20		;FIND SECTOR
	SKIPE	RM03F
	IDIVI	T1,^D30
	LSH	T1,8
	IOR	T1,T2
	GETIT	T2

	HRL	T1,T2
	MOVEM	T1,(T6)		;STORE 8080 POINTER
	RTN
;*WRTDONE - WRITE FE-DIR FILE BLOCK

WRTDONE:CONFIRM
	SKIPN	FESETF		;FE-DIR  IN CODE ?
	 ERR	<FE-FILE SYSTEM NOT SETUP>

	MOVEI	T5,^D512/2
	SKIPN	MONTYP
	MOVEI	T5,^D18/2
	MOVEI	T4,FEDIR

	MOVE	T6,T4		;POSITION TO T6
	HLRZ	T7,1(T4)	;PAGE # TO T7
	JUMPE	T7,.+2		;POSITION NOT USED
	GO	S8080P		;SET 8080 DISK POINTER
	ADDI	T4,2
	SOJG	T5,.-5

	SKIPN	MONTYP
	JRST	WRTD10		;TOPS-10

	SETO	T1,
	MOVE	T2,[.FHSLF,,<FEDIR_-^D9>]
	SETZ	T3,
	PMAP			;UNMAP FE-DIR PAGE
	 ERJMP	[JSERR
		 JRST	START]

	MOVE	T1,FEJFN
	CLOSF
	 ERR	<CAN NOT CLOSE BOOTSTRAP.BIN>

	MOVEI	T1,0		;UPDATE HOME BLOCKS
	GO	REDHOM
	  RET

	GO	SHOMEP		;COMPUTE 8080 POINTER

	MOVE	T1,BTADDR#	;SAME AS ON DISK ?
	CAMN	T1,HOMPAG+200+103
	RTN			;YES, LEAVE HOME BLOCKS ALONE THEN
	MOVE	T1,BTADDR
	MOVEM	T1,HOMPAG+200+103
	MOVEI	T1,0
	GO	WRTHOM		;NO, UPDATE HOME BLOCKS
	  RET

	MOVEI	T1,10
	GO	REDHOM
	  RET

	MOVE	T1,BTADDR
	MOVEM	T1,HOMPAG+400+103
	MOVEI	T1,10
	GO	WRTHOM
	  RET
HOMSET:	PNTMSF	[ASCIZ/
[HOME BLOCKS SET]
/]
	RET

SHOMEP:	MOVEI	T6,BTADDR
	SETZ	T7,
	GO	S8080P
	RTN

WRTD10:	ENTER	DAT,ODAT10	;SET FOR OUTPUT
	ERR	<KS10FE.BIN ENTER ERROR>

	USETO	DAT,1
	MOVEI	T2,^D28
	MOVE	T3,[FEDIR,,IPAG]
WRTD11:	MOVE	T1,T3
	BLT	T1,IPAG+777
	MOVSI	T1,^D512
	ADD	T3,T1
	OUT	DAT,[IOWD ^D512,IPAG
		     0]
	SKIPA
	ERR	<KS10FE.BIN OUTPUT ERROR>
	SOJG	T2,WRTD11
	CLOSE	DAT,
	RELEAS	DAT,
;A01 Only here to set "Not to be DeLeted bits after both files have been
;created
	MOVE	T1,FEEXT	;Get ext used when KS10FE was found
	MOVEM	T1,EXT		;Put it where SETNDL will use it
	MOVE	T1,FENAM	;Retrieve whatever name its called these days
	MOVEM	T1,FILE		;For use by NDL INIT routine
	GO	SETNDL		;Make it 1 whatever it was
	  ERR	<ERROR SETTING NDL FOR KS10FE>
	MOVE	T1,[SIXBIT/RIM/];If this changes we're in trouble
	MOVEM	T1,EXT		;Put it where it's needed
	MOVE	T1,BOONAM	;Same name as used when cleared
	MOVEM	T1,FILE		;For use by NDL INIT routine
	GO	SETNDL		;Turn on "not to be DeLeted" bit
	  ERR	<ERROR SETTING NDL FOR KSBOOT>
;A01END
	RTN
;*SUBROUTINE TO READ AND WRITE HOME BLOCKS
;*CALL WITH:
;*	T1/ DISK ADDRESS
;*	STRDES/ DEVICE DESIGNATOR OF STRUCTURE
;*	GO	REDHOM/WRTHOM
;*	  ERROR
;*	OK

WRTHOM:	SKIPA	T2,[DOP%WR+1000]
REDHOM:	MOVEI	T2,1000

	SKIPE	DEBUGF
	JRST	CPOPJ1		;DON'T DO HOME IF DEBUG

	MOVEI	T3,HOMPAG
	MOVE	T4,STRDES
;*	TXO	T1,<.DOPSR>B1!DOP%SN ;MONSYM IS BAD
	TLO	T1,577600
	DSKOP
	ERJMP	BADHOM
	JUMPE	T1,RSKP
	ERR	ERROR UPDATING HOME BLOCKS

BADHOM:	MOVEI	T1,.FHSLF
	GETER
	ERMSG	<BADHOM: GETER FAILED>
	TLZ	T2,-1
	CAIE	T2,WHELX1
	ERR	ERROR UPDATING HOME BLOCKS
	PNTMSF	[ASCIZ/
%HOME BLOCKS NOT UPDATED -- MUST BE WHEEL OR OPERATOR
/]
	RET

TRM03P:	SKIPE	MONTYP		;TOPS-20
	IDIVI	T1,<^D30*^D5>-2
	SKIPN	MONTYP		;TOPS-10
	IDIVI	T1,<^D30*^D5>
	JRST	CPOPJ1
SUBTTL	COMMANDS -- READ

RDBC1:	SETOM	BC1FLG
	JRST	READ+1
READ:	SETZM	BC1FLG
	NOISE	<MICROCODE FROM FILE>
	HRROI	T1,[ASCIZ "KS10"]
	SKIPE	BC1FLG
	HRROI	T1,[ASCIZ "KSBC1"]
	MOVEM	T1,GTJFIL
	HRROI	T1,[ASCIZ "ULD"]	;MAKE THIS "RAM" FOR PRODUCTION
	MOVEM	T1,GTJEXT
	SETZM	GTJDEV
	SETZM	GTJDIR
	MOVSI	T1,(GJ%OLD)
	MOVEM	T1,GTJFLG
	CMD	[FLDDB.(.CMFIL)]
	HRLZM	T2,UCFILE
	CONFIRM
	SKIPN	MONTYP
	JRST	READ10

	HLRZ	T1,UCFILE
	MOVEI	T2,OF%RD
	OPENF
	ERR	<CAN NOT OPEN MICROCODE FILE>

	SETZM	STBUF
	HRROI	T1,STBUF
	HLRZ	T2,UCFILE
	MOVSI	T3,200
	JFNS			;GET FILE ".EXT" STRING
	MOVE	STBUF
	CAME	[ASCIZ/RAM/]
	JRST	RDULD		;OLD STYLE ".ULD" MICROCODE

	HLRZ	T1,UCFILE
	MOVE	T2,[1,,.FBBYV]
	MOVEI	T3,T4

	GTFDB			;GET FILE PAGE COUNT

	ANDI	T4,-1
	CAIE	T4,^D12
	 JRST	READF		;WRONG LENGTH
	MOVE	T1,UCFILE
	SKIPN	BC1FLG
	MOVE	T2,[.FHSLF,,<CRAM_-^D9>]
	SKIPE	BC1FLG
	MOVE	T2,[.FHSLF,,<CRMBC1_-^D9>]
	MOVE	T3,[PM%CNT+PM%RD+PM%WR+PM%PLD+PM%CPY+^D12]

	PMAP			;READ CRAM INTO MEMORY
	ERJMP	[JSERR
		 JRST	START]

	SKIPN	BC1FLG
	MOVEI	T1,CRAM
	SKIPE	BC1FLG
	MOVEI	T1,CRMBC1
	MOVEI	T2,^D12
	SETMM	(T1)		;TOUCH EACH CRAM PAGE
	ADDI	T1,1000		; TO MAKE IT PRIVATE
	SOJG	T2,.-2

	HLRZ	T1,UCFILE
	CLOSF			;CLOSE OUT CRAM FILE
	 ERR	<CAN NOT CLOSE MICROCODE FILE>

	SETOM	RDFLAG
	RTN

READF:	HLRZ	T1,UCFILE
	CLOSF			;CLOSE OUT BAD FILE
	 ERR	<CAN NOT CLOSE MICROCODE FILE>
	 ERR	<MICROCODE FILE WRONG LENGTH>
	RTN
;*TOPS-10 MICROCODE READ PROCESS

READ10:	GO	OPNTEN		;OPEN INPUT FILE
	ERR	<FILE NOT FOUND>

	MOVE	T1,LOOK10+.RBVER ;USE INPUT VERSION AS OUTPUT VERSION
	MOVEM	T1,MC.VER

	LDB	T1,[POINT 11,LOOK10+.RBPRV,23]
	MOVEM	T1,MC.TIME	;USE INPUT TIME AND DATE AS OUTPUT

	LDB	T1,[POINT 3,LOOK10+.RBEXT,20]
	DPB	T1,[POINT 3,MC.DATE,23]
	LDB	T1,[POINT 12,LOOK10+.RBPRV,35]
	DPB	T1,[POINT 12,MC.DATE,35]

	MOVE	T1,LOOK10+.RBSIZ ;GET FILE SIZE IN WORDS

	MOVE	0,GTJEXT
	CAME	0,[SIXBIT/RAM/]
	JRST	RDULD

	CAIE	T1,^D12*^D512
	ERR	<FILE WRONG LENGTH>

	SKIPN	BC1FLG
	MOVEI	T7,CRAM		;SETUP CRAM STORAGE POINTER
	SKIPE	BC1FLG
	MOVEI	T7,CRMBC1

LOOP1:	GO	GET10		;GET WORD FROM FILE
	SKIPGE	EOFSW
	JRST	LOOP2
	MOVEM	T3,(T7)		;STORE IT
	AOJA	T7,LOOP1

LOOP2:	SETOM	RDFLAG
	JRST	R10EOF		;DONE
SUBTTL	TOPS-10 DISK ROUTINE DEFINITIONS

;*I/O CHANNELS

DAT=1	;GENERAL DATA CHANNEL
RC=2	;READ CHANNEL
WC=3	;WRITE CHANNEL
DIR=4	;DIRECTORY CHANNEL
HOM=5	;HOME BLOCK CHANNEL
$CHN=6	;COMMAND FILE CHANNEL
NDL=7	;A01 Channel for super I/O update

;*SYMBOL DEFINITIONS

BLKSIZ==20			;SIZE OF LOOKUP/ENTER BLOCKS

RADIX	10
HMBK01==1+20*0+380*0		;HOME BLOCK #1
				;1=SECTOR NUMBER
				;0=TRACK NUMBER
				;0=CYLINDER NUMBER
HMBK10==10+20*0+380*0		;HOME BLOCK #10

RADIX	8
.BFPTR=1
.BFCTR=2
.DCUPN=15
TO10IC==HEAD10+.BFCTR		;-10 INPUT RING BUF BYTE COUNT
TO10IP==HEAD10+.BFPTR		;-10 INPUT RING BUF BYTE PTR
TO10OC==HEDBLK+.BFCTR		;-10 OUTPUT RING BUF BYTE COUNT
TO10OP==HEDBLK+.BFPTR		;-10 OUTPUT RING BUF BYTE PTR
PHYDEV==DATDEV+.DCUPN		;PHY UNIT FOR DATA FILE(0-399)
DSKUPN==DIRDEV+.DCUPN		;PHY UNIT FOR FILE IN 406-409
E10ALC==ENTBLK+.RBALC		;# OF BLOCKS TO ALLOCATE
E10STS==ENTBLK+.RBSTS		;FILE STATUS WORD
E20ALC==LOOK10+.RBALC		;# OF BLOCKS TO ALLOCATE
E20STS==LOOK10+.RBSTS		;FILE STATUS WORD

SU.SOT=200000			;SUSET. OUTPUT BIT
CTYPF=10000			;SET IF ANY CHARS TYPED FOR A COMMAND
.IOBIN=14
.IODMP=17
RP.NFS=1B21
RP.ABC=1B22
CL.DLL=4
.DCUR4=0	;RP04
.DCUR6=1	;RP06
.DCUR3=2	;RM03
;EXTENDED ENTER BLOCK

.RBCNT=0	;0,,COUNT OF ENTRIES
.RBPPN=1	;PROJ,PROG #
.RBNAM=2	;SIXBIT FILE NAME
.RBEXT=3	;SIXBIT EXT,,18-20 HI DATE,21-35 ACCESS DATE
.RBPRV=4	;0-8 PROT,9-12 DATA MODE,13-23 CREATE TIME,24-35 CREATE DATE
.RBSIZ=5
.RBVER=6
.RBSPL=7
.RBEST=10	;0 - EST BLOCKS
.RBALC=11	;# OF CONTIGUOUS BLOCKS
.RBPOS=12
.RBTF1=13
.RBNCA=14
.RBMTA=15
.RBDEV=16
.RBSTS=17	;FILE STATUS, UFD,,FILE - BIT 22 RP.ABC

HOLD==^D64		;DEFAULT PAGE COUNT FOR KS-10 AREA
PRIME==0		;RELATIVE BLOCK OF PRIME RIB FOR USETI
HOMCLP== HOMBUF+20	;ADDRESS POINTER FOR RETRIEVAL PTRS
HOMBPC== HOMBUF+21	;BLOCKS PER CLUSTER

HOMLST:	IOWD ^D128,HOMBUF	;COMMAND LIST FOR HOME BLOCK
	0
DIRLST:	IOWD ^D128,DIRBUF	;COMMAND LIST FOR DIRECTORY BLOCK
	0
DATLST:	IOWD ^D128,DATBUF	;COMMAND LIST FOR DATA BLOCK
	0
H10LST:	IOWD ^D128,HOMB10	;COMMAND LIST FOR HOME BLK #10
	0
;A01 Definitions and blocks for super I/O patch

Z.NDLB:!			;BEGINING OF DATA FOR SET/CLEAR NDL
IOLIST:	BLOCK	2		;I/O COMMAND LIST
OPN:	BLOCK	3		;OPEN BLOCK
RIB:	BLOCK	200		;LOOKUP/ENTER AND RIB BLOCK
Z.NDLE==.-1			;END OF DATA FOR SET/CLEAR NDL

	0
.RBSLF==177			;Approx end of input buf
RP.NDL=1B19			;A01 SPECIFY 'NOT TO BE DELETED'
;A01END of definitions for super I/O patch

;*ERROR INTERCEPT CONTROL BLOCK

CCBLK:	4,,CCINT
	0,,2
	BLOCK	2

DIRDEV:	BLOCK	16	;DEVICE INFORMATION FOR DIR FILE

DATDEV:	BLOCK	16	;DEVICE INFORMATION FOR DATA FILE

HOMBUF:	BLOCK	200	;BUFFER CONTAINS HOME BLOCK # 1

HOMB10:	BLOCK	200	;BUFFER CONTAINS HOME BLOCK # 10

CMDCNT:	BLOCK	1	;COMMAND LINE COUNT
O.STR:			;START OF OUTPUT SPEC STORAGE
O.DEV:	BLOCK	1	;DEVICE
O.NAM1:	BLOCK	1	;NAME
O.EXT:	BLOCK	1	;EXT
O.PRT:	BLOCK	1	;PROTECTION
O.PPN:	BLOCK	1	;PROJ,PROG #
O.DATE:	BLOCK	1	;CREATION DATE
O.TIME:	BLOCK	1	;CREATION TIME
O.VER:	BLOCK	1	;VERSION NUMBER

I.STR:			;START OF INPUT SPEC STORAGE
I.DEV:	BLOCK	1	;DEVICE
I.NAM1:	BLOCK	1	;NAME
I.EXT:	BLOCK	1	;EXT
I.PPN:	BLOCK	1	;PROJ,PROG #

GETBUF:	BLOCK	^D128	;A DEDICATED BUFFER

DATBUF:	BLOCK	^D128	;BUFFER CONTAINING REGULAR DATA BLOCK
DATEND=.-1

DIRBUF:	BLOCK	^D128	;BUFFER CONTAINING DIRECTORY BLOCK
ENDBLK=.-1

OPEN10:	BLOCK	3	;-10 OPEN BLOCK
LOOK10:	BLOCK	BLKSIZ	;-10 LOOKUP BLOCK
HEAD10:	BLOCK	3	;-10 BUFFER HEADER
OPNBLK:	BLOCK	3	;-10 OUTPUT OPEN BLOCK
ENTBLK:	BLOCK	BLKSIZ	;-10 ENTER BLOCK
HEDBLK:	BLOCK	3	;-10 OUTPUT BUFFER HEADER
OPND10:	BLOCK	3	;-10 DAT OPEN BLOCK
ODAT10:	BLOCK	BLKSIZ	;-10 DAT LOOKUP BLOCK

MC.VER:	BLOCK	1	;MICROCODE VERSION
MC.TIME:BLOCK	1	;MICROCODE TIME
MC.DATE:BLOCK	1	;MICROCODE DATE
MT.VER:	BLOCK	1	;MAGTAPE VERSION
MT.TIME:BLOCK	1	;MAGTAPE TIME
MT.DATE:BLOCK	1	;MAGTAPE DATE
MT.SADR:BLOCK	1	;MAGTAPE START ADDRESS
SUBTTL	TOPS-10 DISK FILE PROCESS

;*GET A CHARACTER FROM -10 FILE

GET10:	SKIPE	EOFSW		;HAVE WE HIT EOF YET ?
	JRST	GET10Z		;YES, CLEAR CHARACTER

CHKCNT:	SOSGE	TO10IC		;BYTE COUNT=0?
	JRST	IN10		;YES

	ILDB	T3,TO10IP	;GET BUFFER PTR
	RTN			;RETURN, BUFFER FULL

GET10Z:	SETZ	T3,
	RTN

IN10:	IN	RC,
	JRST	GET10

;*END OF INPUT FILE

COMEND:	GETSTS	RC,C		;GET ERROR STATUS
	TRNE	C,74B23		;SEE IF ANY ERRORS
	ERR	<READ ERROR>

	TRNN	C,1B22		;SEE IF END OF FILE
	ERR	<SHOULD NEVER HAPPEN>

	SETOM	EOFSW		;INDICATE EOF IS DETECTED
	SETZM	T3		;ZERO THE CHARACTER
	RTN			;RETURN
;*PUT A CHARACTER TO -10 FILE

PUT10:	SOSG	TO10OC		;DECREMENT BYTE COUNT
	JRST	PUTBUF

PUTNXT:	IDPB	T3,TO10OP	;PUT WORD IN BUFFER
	RTN

PUTBUF:	OUT	WC,		;EMPTY BUFFER
	JRST	PUTNXT
	ERR	<WRITE ERROR>

;*COMPLETE OUTPUT FILE

R10EOF:	CLOSE	RC,		;CLOSE READ CHANNEL
	RELEAS	RC,
	MOVE	T1,JBFFRC
	MOVEM	T1,.JBFF	;RECLAIM BUF SPACE

	RTN

W10EOF:	CLOSE	WC,		;CLOSE WRITE CHANNEL
	RELEAS	WC,

	RTN
;*OPEN DEVICE/LOOKUP ON FILE

	SETOM	OPNTDMP
	SKIPA
OPNTEN:	SETZM	OPNTDMP#
	SETZM	HEAD10
	SETZM	HEAD10+1
	SETZM	HEAD10+2
	MOVEI	T1,HEAD10	;SETUP BUFFER HEADER
	MOVEM	T1,OPEN10+2
	SETZM	EOFSW#

	MOVE	T1,GTJDEV	;SETUP DEVICE
	MOVEM	T1,OPEN10+1

	MOVEI	T1,.IOBIN	;SET BINARY MODE
	SKIPE	OPNTDMP
	MOVEI	T1,.IODMP	;SET DUMP MODE
	MOVEM	T1,OPEN10

	OPEN	RC,OPEN10	;OPEN READ CHANNEL
	ERR	<TOPS-10 OPEN ERROR>

	MOVE	T1,.JBFF	;SAVE RING BUFFER ADDRESS
	MOVEM	T1,JBFFRC#

	SKIPN	OPNTDMP
	INBUF	RC,2		;TWO BUFFERS

	MOVE	T1,GTJFIL	;SETUP FILE NAME
	MOVEM	T1,LOOK10+.RBNAM

	MOVE	T1,GTJEXT	;SETUP FILE EXT
	MOVEM	T1,LOOK10+.RBEXT

	MOVE	T1,GTJDIR	;SETUP PPN
	MOVEM	T1,LOOK10+.RBPPN

	MOVEI	T1,17
	MOVEM	T1,LOOK10

	LOOKUP	RC,LOOK10	;FIND FILE
	RTN			;NOT FOUND

	JRST	CPOPJ1		;FOUND
;*OPEN DEVICE/LOOKUP ON DATA FILE

OPNDAT:	SETZM	OPND10
	SETZM	OPND10+1
	SETZM	OPND10+2
	MOVEI	T1,OPND10	;SETUP BUFFER HEADER
	MOVEM	T1,OPND10+2

	MOVE	T1,GTJDEV	;SETUP DEVICE
	MOVEM	T1,OPND10+1
	MOVEI	T1,.IODMP	;SET DUMP MODE
	MOVEM	T1,OPND10

	OPEN	DAT,OPND10	;OPEN READ CHANNEL
	ERR	<TOPS-10 OPEN ERROR>

	MOVE	T1,GTJFIL	;SETUP FILE NAME
	MOVEM	T1,ODAT10+.RBNAM
;A01 Two instructions for SPR 10-32756
	MOVEM	T1,FILE#	;A01 For use by NDLINI via CLRNDL
	MOVEM	T1,FENAM#	;And save for setting after WRITE DONE

	MOVE	T1,GTJEXT	;SETUP FILE EXT
	MOVEM	T1,ODAT10+.RBEXT
;A01 Two instructions for SPR 10-32756
	MOVEM	T1,EXT#		;Used by NDLINI via CLRNDL
	MOVEM	T1,FEEXT#	;And save for final set

	MOVE	T1,GTJDIR	;SETUP PPN
	MOVEM	T1,ODAT10+.RBPPN

	MOVEI	T1,17
	MOVEM	T1,ODAT10

;A01 The following patch is to clear potential NDL bit when
;KS10FE already exists.
;Two instructions for SPR 10-32756
	GO	CLRNDL		;Make it 0 what ever it was
	  SKIPA		;ERR WILL MAKE A NEW FILE AND TRY AGAIN
;A01END
	LOOKUP	DAT,ODAT10	;FIND FILE
	RTN			;NOT FOUND

	JRST	CPOPJ1		;FOUND
;*OPEN DEVICE/ENTER ON FILE

OPNWRT:	SETZM	HEDBLK
	SETZM	HEDBLK+1
	SETZM	HEDBLK+2
	MOVSI	T1,HEDBLK	;SETUP BUFFER HEADER
	MOVEM	T1,OPNBLK+2

	MOVE	T1,O.DEV	;SETUP DEVICE
	SKIPN	T1
	MOVSI	T1,(SIXBIT/DSK/)
	MOVEM	T1,OPNBLK+1
	MOVEI	T1,.IODMP	;SET DUMP MODE
	MOVEM	T1,OPNBLK
	OPEN	WC,OPNBLK	;OPEN WRITE CHANNEL
	ERR	<TOPS-10 OPEN ERROR>

	SETZM	ENTBLK
	MOVE	T1,[ENTBLK,,ENTBLK+1]
	BLT	T1,ENTBLK+17

	MOVE	T1,O.NAM1	;SETUP FILE NAME
	MOVEM	T1,ENTBLK+.RBNAM

	MOVE	T1,O.EXT	;SETUP FILE EXT
	MOVEM	T1,ENTBLK+.RBEXT

	MOVE	T1,O.PPN	;SETUP PPN
	MOVEM	T1,ENTBLK+.RBPPN

	MOVE	T1,O.PRT	;SETUP PROTECTION
	DPB	T1,[POINT 9,ENTBLK+.RBPRV,8]

	LDB	T1,[POINT 3,O.DATE,23] ;SETUP TIME AND DATE
	DPB	T1,[POINT 3,ENTBLK+.RBEXT,20]
	LDB	T1,[POINT 12,O.DATE,35]
	DPB	T1,[POINT 12,ENTBLK+.RBPRV,35]
	MOVE	T1,O.TIME
	DPB	T1,[POINT 11,ENTBLK+.RBPRV,23]

	MOVE	T1,O.VER	;SETUP VERSION
	MOVEM	T1,ENTBLK+.RBVER

	MOVEI	T1,17
	MOVEM	T1,ENTBLK
	ENTER	WC,ENTBLK	;ENTER FILE
	RTN
	JRST	CPOPJ1
;*ENTER FILE ON CHANNEL WC

ETER10:	SETZM	HEDBLK
	SETZM	HEDBLK+1
	SETZM	HEDBLK+2
	MOVSI	T1,HEDBLK	;SETUP BUFFER HEADER
	MOVEM	T1,OPNBLK+2
	MOVE	T1,O.DEV	;SETUP DEVICE
	SKIPN	T1
	MOVSI	T1,(SIXBIT/DSK/)
	MOVEM	T1,OPNBLK+1
	MOVEI	T1,.IODMP	;DUMP MODE
	MOVEM	T1,OPNBLK

	OPEN	WC,OPNBLK	;OPEN WRITE CHANNEL
	ERR	<TOPS-10 OPEN ERROR>

	SETZM	ENTBLK
	MOVE	T1,[ENTBLK,,ENTBLK+1]
	BLT	T1,ENTBLK+17

	MOVE	T1,O.NAM1	;SETUP FILE NAME
	MOVEM	T1,ENTBLK+.RBNAM
	MOVE	T1,O.EXT	;SETUP FILE EXT
	MOVEM	T1,ENTBLK+.RBEXT
	MOVE	T1,O.PPN	;SETUP PROJ,PROG #
	SKIPN	T1
	MOVE	T1,[6,,2020]	;DEFAULT PPN IS 6,20
	MOVEM	T1,ENTBLK+.RBPPN
	MOVE	T1,O.PRT	;SETUP PROTECTION
	DPB	T1,[POINT 9,ENTBLK+.RBPRV,8]
	LDB	T1,[POINT 3,O.DATE,23]	;SETUP TIME AND DATE
	DPB	T1,[POINT 3,ENTBLK+.RBEXT,20]
	LDB	T1,[POINT 12,O.DATE,35]
	DPB	T1,[POINT 12,ENTBLK+.RBPRV,35]
	MOVE	T1,O.TIME
	DPB	T1,[POINT 11,ENTBLK+.RBPRV,23]
	MOVE	T1,O.VER	;SETUP VERSION
	MOVEM	T1,ENTBLK+.RBVER

	MOVEI	T1,17		;SET # OF WORDS IN EXTENDED ENTER
	MOVEM	T1,ENTBLK
	MOVEI	T1,RP.NFS!RP.ABC ;BIT 22 FOR BAD CHECKSUM
	MOVEM	T1,E10STS	;TELL MON NOT TO CHECK IT
	MOVE	T1,S.ALO	;SET BLOCKS ALLOCATED
	MOVEM	T1,E10ALC
	ENTER	WC,ENTBLK	;WE DID IT
	  RTN			;Error return
	JRST	CPOPJ1		;Give skip (good) return

;A01 The following subroutine, SETNDL & CLRNDL,
;was inserted to control the NDL bit for files
;KS10FE.BIN and KSBOOT.RIM. The intent is to make it more
;difficult for these files to be deleted and moved because they
;are pointed to in the home block.
;calling SETBIT works the same as calling CLRBIT except that NDL
;bit is turned on instead of off
	SEARCH	UUOSYM

CLRNDL:	TDZA	T1,T1		;CLEAR NO DELETE BIT
SETNDL:	MOVEI	T1,RP.NDL	;SET NO DELETE BIT
	PUSH	P,T1		;SAVE THE BIT
	PUSHJ	P,NDLINI	;INIT STORAGE
	OPEN	NDL,OPN		;OPEN A CHANNEL
	  JRST	OPNERR		;FAILED
	LOOKUP	NDL,RIB		;LOOK FOR THE FILE
	  JRST	LKPERR		;FAILED
	USETI	NDL,0		;THE PRIME RIB (BLOCK ZERO)
	IN	NDL,IOLIST	;READ IN THE RIB
	SKIPA			;ALL IS WELL
	  JRST	IOERR		;FAILED
	CLOSE	NDL,CL.DAT	;CLOSE OFF THE CHANNEL
	MOVEI	T1,RP.NDL	;BIT IN QUESTION
	ANDCAM	T1,RIB+.RBSTS	;FIRST CLEAR IT
	MOVE	T1,(P)		;GET SET/CLEAR FLAG
	IORM	T1,RIB+.RBSTS	;POSSIBLY SET THE BIT
	MOVE	T1,RIB+177	;GET SELF BLOCK NUMBER
	TLO	T1,(<NDL>B12)	;INCLUDE THE CHANNEL NUMBER
	SUSET.	T1,		;POSITION FOR OUTPUT
	  JRST	IOERR		;CALL IT AN I/O ERROR
	OUT	NDL,IOLIST	;REWRITE THE RIB
	AOSA	-1(P)		;ALL IS WELL
	JRST	IOERR		;I/O ERROR
	JRST	DONE		;AND FINISH UP

OPNERR:	SETO	T1,		;OPEN FAILURE

LKPERR:	TLOA	T1,-1		;LOOKUP ERROR

IOERR:	GETSTS	NDL,T1		;I/O ERROR

DONE:	RELEAS	NDL,		;RELEASE CHANNEL
	POP	P,(P)		;PHASE STACK
	POPJ	P,		;RETURN

NDLINI:	MOVE	T1,[Z.NDLB,,Z.NDLB+1] ;SET UP BLT
	SETZM	Z.NDLB		;CLEAR FIRST WORD
	BLT	T1,Z.NDLE	;ZERO STORAGE

;I/O COMMAND LIST
	MOVE	T1,[IOWD 200,RIB] ;POINTER TO BUFFER FOR I/O
	MOVEM	T1,IOLIST

;OPEN BLOCK
	MOVEI	T1,.IODMP	;DUMP MODE
	MOVEM	T1,OPN+.OPMOD
	MOVE	T1,DEVICE	;DEVICE NAME ORIGINALLY FOUND
	MOVEM	T1,OPN+.OPDEV
	SETZM	OPN+.OPBUF	;NO BUFFER RING HEADERS

;LOOKUP/ENTER BLOCK
	MOVEI	T1,.RBMAX+1	;LENGTH OF BLOCK
	MOVEM	T1,RIB+.RBCNT
	MOVE	T1,PPN	;ORIGINAL PPN FOUND WITH MAGIC CMD IN WRTSET:
	MOVEM	T1,RIB+.RBPPN	;WILL NOT CHANGE THROUGH OUT PROG
	MOVE	T1,FILE		;FILE NAME
	MOVEM	T1,RIB+.RBNAM
	MOVE	T1,EXT		;EXTENSION
	MOVEM	T1,RIB+.RBEXT
	POPJ	P,		;RETURN

;A01END OF SUPERI/O PATCH THAT STARTED AT CLRBIT:
SUBTTL	TOPS-10 INDIRECT COMMAND FILE PROCESS

$CCL:	SKIPE	$CCLF		;ALREADY DOING INDIRECT ?
	ERR	<CCL COMMAND ERROR>

	SETOM	$CCLF		;SET COMMAND FILE PROCESS FLAG

	MOVE	T1,GTJDEV
	SKIPN	T1		;ANY DEVICE SPECIFIED ?
	MOVSI	T1,'DSK'	;NO, ASSUME "DSK"
	MOVEM	T1,CCLBLK+1

	MOVE	T1,GTJFIL
	MOVEM	T1,CCLDIR	;SETUP FILE NAME

	MOVE	T1,GTJEXT
	SKIPN	T1		;ANY EXTENSION SPECIFIED ?
	MOVSI	T1,'CMD'	;NO, ASSUME "CMD"
	MOVEM	T1,CCLDIR+1

	MOVE	T1,GTJDIR
	MOVEM	T1,CCLDIR+3	;SETUP PPN

	MOVEI	$IBF
	MOVEM	CCLBLK+2

	OPEN	$CHN,CCLBLK	;OPEN COMMAND CHANNEL
	ERR	<CCL OPEN ERROR>

	INBUF	$CHN,1		;ONE BUFFER

	LOOKUP	$CHN,CCLDIR	;FIND COMMAND FILE
	ERR	<CCL FILE NOT FOUND>

	MOVE	.JBFF		;SAVE FIRST FREE FOR RECLAIM
	MOVEM	$SJBFF#

	MOVE	T1,[.NULIO,,.PRIOU]
	MOVEM	T1,CSB+.CMIOJ
	SKIPL	ECOFLG
	SETOM	INTAKE
	RTN
$CCLIN:	SOSLE	$IBF+2		;ANY CHARS AVAILABLE ?
	JRST	$CCLI1		;YES

	IN	$CHN,		;NO, INPUT A BUFFER
	 JRST	$CCLI1		;OK

	STATZ	$CHN,740000	;NO, CHECK STATUS
	ERR	<CCL FILE READ ERROR>

	MOVEI	[ASCIZ/
	[END OF COMMAND FILE]
/]
	PNTALF
	JRST	REEN

$CCLI1:	ILDB	T2,$IBF+1	;GET CHAR

;	CAIN	T2,12		;LF, CLEAR COMMENT FLAG
;	SETZM	$CMNTF
;	CAIN	T2,14		;F/F, CLEAR COMMENT FLAG
;	SETZM	$CMNTF
;
;	CAIN	T2,";"		;SEMICOLON, SET COMMENT FLAG
;	SETOM	$CMNTF
;
;	SKIPE	$CMNTF		;PROCESSING COMMENT ?
;	JRST	$CCLIN		;YES

	RTN			;RETURN TO CHAR PROCESS

CCLBLK:	BLOCK	3
$IBF:	BLOCK	3
CCLDIR:	BLOCK	4
SUBTTL	SPECIFY DEVICE FILE STRUCTURE FOR  DIRECTORY
;	===============================================

DEVSTR:	MOVE	T2,GTJDIR
	MOVEM	T2,DIRDIR#	;SAVE STRUCTURE PPN
;A01 The following inst is for SPR 10-32756
	MOVEM	T2,PPN#		;For NDL super I/O
	MOVE	T2,GTJDEV	;GET STRUCTURE NAME
	MOVEM	T2,DIRDEV
	MOVEM	T2,DATDEV	;SAVE IT
;A01 The following inst is for SPR 10-32756
	MOVEM	T2,DEVICE#	;Used by NDLINI for SET & CLR of NDL
	MOVE	T1,[0,,DIRDEV]	;STATUS AT LOC+0

	DSKCHR	T1,
	ERR	<DEVICE SELECTION ERROR>

	LDB	T2,[POINT 6,T1,26];GET BITS 21-26
	SUBI	T2,5		;5=RH10/RH20 CTR
	JUMPE	T2,.+2		;IT'S RH10/RH20 CTR
	ERR	<NOT AN RH10/RH20 CONTROLLER>

	SETZM	RM03F
	LDB	T2,[POINT 3,T1,32]
	MOVEM	T2,DSKTYP
	CAIN	T2,.DCUR4
	JRST	CTLROK
	CAIN	T2,.DCUR6
	JRST	CTLROK
	CAIN	T2,.DCUR3
	JRST	[SETOM	RM03F
		 JRST CTLROK]
	ERR	<NOT AN RP04/RP06/RM03 DISK>

CTLROK:	MOVE	T1,[16,,DIRDEV]	;PHYNAME AT LOC+15

	DSKCHR	T1,		;GET PHY DEVICE NAME
	ERR	<DEVICE SELECTION ERROR>

	MOVE	T1,[16,,DATDEV]

	DSKCHR	T1,
	ERR	<DEVICE SELECTION ERROR>

USRHPQ:	MOVEI	1
	HPQ			;SET HI-PRI RUN Q
	 JFCL

USRHDQ:	MOVEI	HDQ		;SET HI-PRI DISK Q
	DISK.
	 JFCL
	JRST	.+2
HDQ:	3,,-1
	GO	OPNHOM		;OPEN WITH HOM CHANNEL
	ERR	<HOM CHN OPEN ERROR>

	MOVEI	T3,HMBK01	;GET HOME BLK #1
	GO	RADHOM
	ERR	<HOME BLOCK #1 READ ERROR>

	MOVE	T1,HOMBUF+103
	MOVEM	T1,BTADDR	;SAVE ORIGINAL 8080 POINTER

	MOVE	B,HOMBUF+101	;GET DISK ADDRESS
	MOVEM	B,BTLADR#

	MOVE	C,HOMBUF+102	;GET LENGTH IN SECTORS
	MOVEM	C,BTLPAG#

	JUMPE	B,CRESTR	;NO CURRENT KS10FE.BIN

CREST1:	GO	OPNDAT
	JRST	CRESTR		;REALLY NOT THERE

	MOVE	T1,ODAT10+.RBALC
	CAIGE	T1,<^D28*^D4>+1
	ERR	<KS10FE.BIN WRONG SIZE>

	USETI	DAT,PRIME	;GET LOGICAL BLK # OF 1ST BLK

	IN	DAT,[IOWD 200,GETBUF
		     0]
	SKIPA
	ERR	<PRIME RIB READ ERROR>
	GO	GOARND+4

	CAME	T1,BTLADR	;HOME BLOCK & FILE AGREE ?
	ERR	<KS10FE.BIN HOME BLOCK & FILE ADDRESSES DIFFER>
	USETI	DAT,1		;SELECT 1ST PAGE

	MOVEI	T5,^D28
	MOVE	T4,[IPAG,,FEDIR]
	MOVEI	T3,FEDIR+777

CREST2:	IN	DAT,[IOWD ^D512,IPAG
		    0]
	JRST	CREST3

	GETSTS	DAT,T1
	TRNE	T1,74B23	;ANY ERRORS
	ERR	<KS10FE.BIN READ ERROR>
	TRNN	T1,1B22		;END OF FILE ?
	ERR	<SHOULD NEVER HAPPEN>
	JRST	WRTSEX

CREST3:	MOVE	T1,T4
	MOVE	T2,T3
	BLT	T1,(T2)		;TRANSFER TO HI-CORE

	ADDI	T4,^D512
	ADDI	T3,^D512
	SOJG	T5,CREST2

	JRST	WRTSEX
;*OPNHOM - ROUTINE TO OPEN THE DISK ON CHANNEL 'HOM'

OPNHOM:	MOVEI	T5,.IODMP	;OPEN IN DUMP MODE
	MOVE	T6,DSKUPN	;GET DEVICE NAME
	MOVEI	T7,0

	OPEN	HOM,T5
	  RTN			;ERROR RETURN

	JRST	CPOPJ1		;GOOD RETURN

;*RADHOM - ROUTINE TO READ A BLOCK ON CHANNEL 'HOM'

RADHOM:	SETZ	T1,
	MOVEI	T2,HOM
	DPB	T2,[POINT 4,T1,12]	;PUT CHANNEL IN ARG REG.
	DPB	T3,[POINT 23,T1,35]	;PUT BLK NO IN ARG REG

	SUSET.	T1,		;INSERT BLOCK NUMBER
	ERR	<SUSET. UUO FAILURE>

	IN	HOM,HOMLST	;BRING IN THE DIRECTORY BLOCK
	  JRST	CPOPJ1		;GOOD RETURN

	RTN			;BAD RETURN

;*WHOM10 - ROUTINE TO WRITE A BLOCK ON CHANNEL 'HOM'

WHOM10:	MOVSI	T1,SU.SOT	;OUTPUT BIT
	MOVEI	T2,HOM
	DPB	T2,[POINT 4,T1,12]	;PUT CHANNEL IN ARG REG.
	DPB	T3,[POINT 23,T1,35]	;PUT BLK NO IN ARG REG

	SUSET.	T1,
	ERR	<SUSET. UUO FAILURE>

	OUT	HOM,HOMLST	;OUTPUT HOME BLOCK
	  JRST	CPOPJ1		;GOOD RETURN

	RTN			;ERROR RETURN
;*OPWCDP - ROUTINE TO OPEN IN DUMP MODE TO WRITE

OPWCDP:	MOVEI	T1,.IODMP	;DUMP MODE
	MOVE	T2,DSKUPN	;DEVICE NAME
	SETZM	T3

	OPEN	WC,T1		;OPEN FOR  OUTPUT
	  RTN			;ERROR RETURN

	JRST	CPOPJ1		;GOOD RETURN

;*OPRCDP - ROUTINE TO OPEN IN DUMP MODE TO READ

OPRCDP:	MOVEI	T1,.IODMP	;USE DUMP MODE INPUT
	MOVE	T2,DSKUPN	;GET DEVICE NAME
	SETZM	T3		;NO BUFFER

	OPEN	RC,T1
	  RTN			;ERROR RETURN

	JRST	CPOPJ1		;GOOD RETURN
;*GETBLK - ROUTINE TO GET THE LOGICAL BLOCK NUMBER OF THE
;*	   FIRST BLOCK OF A FILE IN THE TOPS-10 FILE SYSTEM.
;*
;*CALL:		GO	GETBK1
;*		OR
;*		GO	GETBK2
;*		RETURN WITH BLOCK # IN T1

GETBK1:	GO	OPRCDP		;USE DUMP MODE INPUT
	ERR	<DUMP MODE OPEN ERROR>

	MOVEI	T1,17		;GET # OF ARGUMENTS
	MOVEM	T1,LOOK10	;SAVE # OF ARGS IN LOOKUP BLK

	LOOKUP	RC,LOOK10	;LOOKUP THE FILE
	ERR	<CAN'T FIND FILE>

	JRST	GOARND		;GO AROUND

GETBK2:	GO	OPRCDP		;USE DUMP MODE INPUT
	ERR	<DUMP MODE OPEN ERROR>

	MOVEI	T1,17		;GET # OF ARGUMENTS
	MOVEM	T1,ENTBLK	;SAVE IT

	LOOKUP	RC,ENTBLK	;LOOKUP THE OUTPUT FILE
	ERR	<CAN'T FIND FILE>

GOARND:	USETI	RC,PRIME	;SET UP TO READ PRIME RIB

	IN	RC,[IOWD 200,GETBUF
		    0 ]		;READ THE PRIME RIB
	SKIPA
	ERR	<PRIME RIB READ ERROR>

	HRRZ	T1,GETBUF	;GET ADDRESS OF 1ST POINTER
	MOVEI	T1,GETBUF+1(T1)	;GET SECOND POINTER
	HLL	T1,HOMCLP	;FORM BYTE POINTER
	LDB	T1,T1		;GET ADDRESS POINTER
	IMUL	T1,HOMBPC	;COMPUTE RIB LOGICAL BLOCK #
	ADDI	T1,1		;COMPUTE # OF DATA BLOCK 1
	RTN			;RETURN
SUBTTL	ROUTINE TO CREATE KS10FE.BIN FILE
;	===========================================

CRESTR:	MOVE	T1,GTJDEV
	MOVEM	T1,O.DEV

	MOVE	T1,GTJFIL
	MOVEM	T1,O.NAM1

	MOVE	T1,GTJEXT
	MOVEM	T1,O.EXT

	MOVE	T1,GTJDIR
	MOVEM	T1,O.PPN

	MOVEI	T1,577		;SET PROTECTION 577
	MOVEM	T1,O.PRT

	SETZM	O.DATE
	SETZM	O.TIME
	SETZM	O.VER

	MOVEI	T1,<^D28*^D4>+1	;28 PAGES, AND A BLOCK FOR ENTROPY
	MOVEM	T1,S.ALO#

	GO	ETER10		;ENTER FILE
	ERR	<ERROR CREATING KS10FE.BIN>

	CLOSE	WC,CL.DLL	;CLOSE WRITE CHANNEL
	RELEAS	WC,

;*GET DISK DIRECTORY ADDRESS, PUT IN HOME BLOCK

	GO	GETBK2		;GET 1ST BLOCK FROM -10
	MOVEM	T1,BTLADR

	MOVE	T7,BTLADR
	MOVEI	T6,BTADDR
	GO	T8080P		;COMPUTE 8080 POINTER

	MOVE	BTLADR		;SET LOGICAL ADDRESS
	MOVEM	HOMBUF+101
	MOVEI	^D28*^D4	;SET LENGTH IN SECTORS
	MOVEM	BTLPAG
	MOVEM	HOMBUF+102
	MOVE	BTADDR		;SET 8080 ADDRESS
	MOVEM	HOMBUF+103
;*WRITE OUT HOME BLOCK #1

	MOVEI	T3,HMBK01		;HOME BLOCK # 1
	GO	WHOM10			;WRITE IT
	ERR	<HOME BLOCK #1 WRITE ERROR>

;*HERE TO UPDATE AND WRITE OUT HOME BLOCK # 10

	MOVEI	T3,HMBK10		;GET BLOCK # FOR HOBK10
	SETZ	T1,
	MOVEI	T2,HOM
	DPB	T2,[POINT 4,T1,12]	;PUT CHANNEL IN ARG REG.
	DPB	T3,[POINT 23,T1,35]	;PUT BLK NO IN ARG REG

	SUSET.	T1,
	ERR	<SUSET. UUO FAILURE>

	IN	HOM,H10LST		;BRING IN HOME BLK #10
	JRST	.+2			;READ OK

	ERR	<HOME BLOCK #10 READ ERROR>

	MOVE	BTLADR		;SET LOGICAL ADDRESS
	MOVEM	HOMB10+101
	MOVE	BTLPAG		;SET LENGTH IN PAGES
	MOVEM	HOMB10+102
	MOVE	BTADDR		;SET 8080 ADDRESS
	MOVEM	HOMB10+103

	MOVSI	T1,SU.SOT		;SET OUTPUT BIT
	MOVEI	T2,HOM
	DPB	T2,[POINT 4,T1,12]	;PUT CHANNEL IN ARG REG.
	DPB	T3,[POINT 23,T1,35]	;PUT BLK NO IN ARG REG

	SUSET.	T1,
	ERR	<SUSET. UUO FAILURE>

	OUT	HOM,H10LST		;OUTPUT HMBK10
	SKIPA

	ERR	<HOME BLOCK #10 WRITE ERROR>

	CLOSE	DIR,			;CLOSE DIR CHANNEL
	CLOSE	HOM,			;CLOSE HOM CHANNEL
	JRST	CREST1
SUBTTL	PROCESS ".ULD" MICROCODE

RDULD:	MOVEI	T1,RDULDT
	MOVEM	T1,CTADR
	SKIPE	BC1FLG
	JRST	.+5
	SETZM	CRAM
	MOVE	[CRAM,,CRAM+1]
	BLT	CRAM+13777	;CLEAR MICROCODE STORE
	JRST	.+4
	SETZM	CRMBC1
	MOVE	[CRMBC1,,CRMBC1+1]
	BLT	CRMBC1+13777

	SETZM	IBF+1
	SKIPN	MONTYP
	JRST	READ.1

	HLRZ	T1,UCFILE
	MOVE	T2,[1,,.FBBYV]
	MOVEI	T3,INCNT#
	GTFDB			;GET FILE PAGE COUNT
	HRRZS	INCNT

READ.1:	GO	RDEOL
	GO	RDBYTE
	CAIN	T1,"E"
	JRST	READ.5
	CAIE	T1,"["
	JRST	READ.1
	MOVEI	T6,0

READ.2:	GO	RDBYTE
	CAIN	T1,"]"
	JRST	READ.3
	SUBI	T1,"0"
	LSH	T6,3
	ADD	T6,T1
	JRST	READ.2
READ.3:	GO	RDBYTE
	CAIE	T1,"="
	ERR	<MICROCODE IS NOT IN CORRECT FORMAT>
	MOVEM	T6,RDULT6#
	IMULI	T6,3
	SKIPN	BC1FLG
	ADDI	T6,CRAM
	SKIPE	BC1FLG
	ADDI	T6,CRMBC1
	MOVEM	T6,CRAMT6#

RDULIN:	MOVE	T4,[POINT 3,ULDSTR]
	MOVEI	T5,^D36

	GO	RDBYTE
	IDPB	T1,T4

	SOJG	T5,RDULIN+2

KSSHF3:	SETZ	AC10,
	SETZB	AC11,AC12

	MOVE	T7,[-^D108,,KSCRMP]

	MOVE	STPNTR,[POINT 1,ULDSTR]
	MOVE	0,[ILDB	T6,STPNTR]
	MOVE	T1,[DPB	T6,(T7)]
	MOVE	T2,[AOBJN T7,0]
	MOVE	T3,[JRST KSSHF4]
	JRST	0

KSSHF4:	GO	KSXX		;COMPUTE PARITY
	
	JRST	READ.1
;*KSXX, CRAM PARITY COMPUTE SUBROUTINE

KSXX:	MOVE	STPNTR,[POINT 1,AC10]
	MOVEI	0,^D36
	SETZ	T1,
	MOVE	T2,[ILDB T6,STPNTR]
	MOVE	T3,[ADD T1,T6]
	MOVE	T4,[SOJG 0,T2]
	MOVE	T5,[JRST KSXX1]
	JRST	T2		;COMPUTE CRAM PARITY "CRA"

KSXX1:	TDC	T1,PARFLG
	DPB	T1,PB.CRA

	MOVEI	0,^D60
	SETZ	T1,
	MOVE	T5,[JRST KSXX2]
	JRST	T2		;COMPUTE CRAM PARITY "CRM"

KSXX2:	TDC	T1,PARFLG
	DPB	T1,PB.CRM

	MOVE	T6,CRAMT6
	MOVE	T1,AC11
	MOVE	T2,AC12
	LSHC	T1,-^D12
	MOVEM	T2,(T6)		;STORE BITS 60-95

	MOVE	T1,AC10
	MOVE	T2,AC11
	LSHC	T1,-^D12
	MOVEM	T2,1(T6)	;STORE BITS 24-59

	MOVE	T2,AC10
	LSH	T2,-^D12
	MOVEM	T2,2(T6)	;STORE BITS 0-23

	RTN
 
READ.5:	GO	RDBYTE
	CAIE	T1,"N"
	JRST	READ.1
	GO	RDBYTE
	CAIE	T1,"D"
	JRST	READ.1

	SETOM	RDFLAG

	SKIPN	MONTYP
	JRST	R10EOF

	SETO	T1,
	MOVE	T2,[.FHSLF,,<IPAG_-^D9>]
	SETZ	T3,

	PMAP			;RELEASE LAST INPUT PAGE
	ERJMP	[JSERR
		 JRST	START]

	HLRZ	T1,UCFILE
	CLOSF
	ERR	<CAN NOT CLOSE MICROCODE FILE>

	RTN
DEFINE	CRMBIT(BIT),<
  IFL BIT-^D36,<
	POINT	1,AC10,BIT
  >
  IFGE BIT-^D36,<
    IFL BIT-^D72,<
	POINT	1,AC11,BIT-^D36
    >
    IFGE BIT-^D72,<
	POINT	1,AC12,BIT-^D72
    >
  >
>

DEFINE	CRMRNG(FROM,TO),<
	ZZ..==FROM
  REPEAT TO-FROM+1,<
	CRMBIT	\ZZ..
	ZZ..==ZZ..+1
  >
>

	RADIX	10
KSCRMP:	CRMRNG	0,11	;J
	CRMRNG	60,68	;ALU LSRC RSRC
	CRMRNG	87,89	;DEST
	CRMBIT	107
	CRMBIT	107
	CRMRNG	74,77	;A
	CRMBIT	107
	CRMBIT	107
	CRMRNG	80,83	;B
	CRMRNG	84,86	;RAMADR
	CRMBIT	107
	CRMRNG	72,73	;DBUS
	CRMRNG	69,71	;DBM
	CRMBIT	78	;DP CLOCK L
	CRMBIT	50	;PAR EN L
	CRMBIT	92	;PAR CK L
	CRMBIT	79	;DP CLOCK R
	CRMBIT	51	;PAR EN R
	CRMBIT	93	;PAR CK R
	CRMRNG	18,20	;SPEC
	CRMRNG	30,32
	CRMRNG	21,23	;DISP
	CRMRNG	27,29
	CRMRNG	15,17	;SKIP
	CRMRNG	33,35
	CRMBIT	107
	CRMRNG	12,13	;T
	CRMBIT	25	;CRY 38
	CRMRNG	90,91	;SC & FE
	CRMBIT	48	;FM WRITE
	CRMBIT	26	;MEM
	CRMRNG	52,53	;DIVIDE AND MULTI PREC
	CRMBIT	49	;MULTI SHIFT
	CRMBIT	14	;CALL
	CRMBIT	107
	CRMBIT	107
	CRMBIT	107
	CRMBIT	107
	CRMBIT	107
	CRMBIT	107
	CRMBIT	107
	CRMBIT	107
	CRMBIT	107
	CRMRNG	54,59	; #
	CRMRNG	36,47

PB.CRA:	CRMBIT	24
PB.CRM:	CRMBIT	94
	RADIX	8
;*SUBROUTINE TO FILE END OF LINE
;*CALL WITH:
;*	GO	RDEOL
;*	RETURN HERE

RDEOL:	GO	RDBYTE
	CAIN	T1,12
	RTN
	JRST	RDEOL

RDBYTE:	SOSLE	IBF+1
	JRST	.+3
	GO	RDUINP		;GET NEXT FILE PAGE
	ERR	<MICROCODE ERROR EOF>

	ILDB	T1,IBF		;GET FILE BYTE
	JUMPE	T1,RDBYTE	;IGNORE NULLS

	RTN

RDUINP:	SKIPN	MONTYP
	JRST	RDUI10
	SOSGE	INCNT		;COUNT DOWN PAGE COUNT
	RTN			;NONE LEFT, EOF

	MOVE	T1,UCFILE
	MOVE	T2,[.FHSLF,,<IPAG_-^D9>]
	SETZ	T3,

	PMAP			;GET NEXT FILE PAGE
	ERJMP	[JSERR
		 JRST	START]

	MOVEI	1000*5
	MOVEM	IBF+1		;SET BYTE COUNT

	MOVE	[POINT 7,IPAG]
	MOVEM	IBF		;SET BYTE POINTER

	AOS	UCFILE		;INCREMENT FILE PAGE NUMBER
	AOS	(P)
	RTN

RDUI10:	GO	GET10
	MOVEM	T3,RDUIBF#
	SKIPGE	EOFSW
	RTN
	MOVEI	5
	MOVEM	IBF+1
	MOVE	[POINT 7,RDUIBF]
	MOVEM	IBF
	AOS	(P)
	RTN
SUBTTL	COMMANDS -- OUTPUT

	SCMTAB	OUTCMD
	CMTAB	BC1,OUTBC1
	CMTAB	CRAM,OUTRAM
	CMTAB	MTBOOT,OUTMT
	CMTAB	RAM,OUTRAM
	ECMTAB

OUTX:	CMD	[FLDDB.(.CMKEY,,OUTCMD)],<CAN NOT OUTPUT THAT>
	HRRZ	T1,(T2)
	JRST	(T1)
;*OUTRAM, OUTPUT MICROCODE ".RAM" FILE

OUTBC1:	SETOM	BC1FLG
	JRST	OUTRAM+1
OUTRAM:	SETZM	BC1FLG
	NOISE	<MICROCODE INTO .RAM FILE>
	HRROI	T1,[ASCIZ "KS10"]
	MOVEM	T1,GTJFIL
	HRROI	T1,[ASCIZ "RAM"]
	MOVEM	T1,GTJEXT
	SETZM	GTJDEV
	SETZM	GTJDIR
	MOVSI	T1,(GJ%FOU)
	MOVEM	T1,GTJFLG

	CMD	[FLDDB.(.CMFIL)]
	MOVEM	T2,OUTJFN#

	CONFIRM

	SKIPN	MONTYP
	JRST	ORAM10		;TOPS-10

	MOVE	T1,OUTJFN
	MOVEI	T2,OF%WR
	OPENF
	 ERR	<CAN NOT OPEN MICROCODE OUTPUT FILE>

	SKIPN	BC1FLG
	MOVEI	T6,CRAM
	SKIPE	BC1FLG
	MOVEI	T6,CRMBC1
	MOVEI	T5,4000
OUTLP:	MOVE	T2,(T6)
	BOUT
	MOVE	T2,1(T6)
	BOUT
	MOVE	T2,2(T6)
	BOUT

	ADDI	T6,3
	SOJG	T5,OUTLP

	MOVE	T1,OUTJFN
	CLOSF
	 ERR	<CAN NOT CLOSE MICROCODE OUTPUT FILE>

	RTN
;*TOPS-10 OUTPUT MICRO-CODE ".RAM" FILE

ORAM10:	MOVE	T1,MC.VER
	MOVEM	T1,O.VER
	MOVE	T1,MC.TIME
	MOVEM	T1,O.TIME
	MOVE	T1,MC.DATE
	MOVEM	T1,O.DATE
	SETZM	O.PRT

	MOVE	T1,GTJDEV
	MOVEM	T1,O.DEV
	MOVE	T1,GTJFIL
	MOVEM	T1,O.NAM1
	MOVE	T1,GTJEXT
	MOVEM	T1,O.EXT
	MOVE	T1,GTJDIR
	MOVEM	T1,O.PPN

	GO	OPNWRT		;OPEN OUTPUT
	ERR	<OUTPUT OPEN FAILURE>

	MOVEI	T2,^D12
	SKIPN	BC1FLG
	MOVE	T3,[CRAM,,IPAG]
	SKIPE	BC1FLG
	MOVE	T3,[CRMBC1,,IPAG]

ORAM11:	MOVE	T1,T3
	BLT	T1,IPAG+777
	MOVSI	T1,^D512
	ADD	T3,T1

	OUT	WC,[IOWD ^D512,IPAG
		    0]
	SKIPA
	ERR	<MICROCODE OUTPUT ERROR>

	SOJG	T2,ORAM11

	GO	W10EOF

	RTN
;*OUTMT, OUTPUT MAGTAPE ".RDI" FILE

OUTMT:HRROI	T1,[ASCIZ "MTBOOT"]
	MOVEM	T1,GTJFIL

	HRROI	T1,[ASCIZ "EXE"]
	MOVEM	T1,GTJEXT

	SETZM	GTJDEV
	SETZM	GTJDIR

	MOVSI	T1,(GJ%OLD)
	MOVEM	T1,GTJFLG

	CMD	[FLDDB.(.CMFIL)]
	MOVEM	T2,BTJFN	;SAVE THE JFN OF THE BOOT FILE

	SKIPN	MONTYP
	GO	OMT10		;TOPS-10

	NOISE	<AS>
	HRROI	T1,[ASCIZ "MTBOOT"]
	MOVEM	T1,GTJFIL
	HRROI	T1,[ASCIZ "RDI"]
	MOVEM	T1,GTJEXT
	SETZM	GTJDEV
	SETZM	GTJDIR
	MOVSI	T1,(GJ%FOU)
	MOVEM	T1,GTJFLG

	CMD	[FLDDB.(.CMFIL)]
	MOVEM	T2,MTJFN#

	CONFIRM

	SKIPN	MONTYP
	JRST	OMT10A		;TOPS-10

	MOVE	T1,MTJFN
	MOVEI	T2,OF%WR
	OPENF
	 ERR	<CAN NOT OPEN MAGTAPE RDI OUTPUT FILE>
	SETZB	T1,T2		;CREATE A BLANK FORK
	CFORK
	ERJMP	[JSERR		;ERROR ON CFORK
		HALTF]
	MOVEM	T1,FORKN	;SAVE FORK

	HRRZ	T1,BTJFN	;GET THE JFN OF THE BOOT
	HRL	T1,FORKN	;GET PROCESS HANDLE
	SETZ	T2,0
	GET
	ERJMP	[JSERR		;ERROR ON GET
		JRST START]

	MOVE	T1,FORKN
	GEVEC			;GET THE VECTOR OF BOOT
	MOVEM	T2,BOOTEV	;SAVE BOOT ENTRY VECTOR ADDRESS

	SETZM	WINDOW
	MOVE	[WINDOW,,WINDOW+1]
	BLT	WINDOW+777	;CLEAR DIAG PRE-BOOT PAGE

	SETZM	MTPAGD
	MOVE	[MTPAGD,,MTPAGD+1]
	BLT	MTPAGX		;CLEAR PRE-BOOT POINTER STORAGE

	MOVE	T4,[-1000,,0]	;ALLOW FOR 1000 PAGES

	HRLZ	P1,MTJFN	;GET JFN OF .RDI FILE
	HRRI	P1,1		;GET MTBOOT START PAGE

	MOVEI	P2,MTPAGD+1
MTPGLP:	HRLZ	T1,FORKN	;GET PROCESS HANDLE
	HRR	T1,T4		;GET PAGE NUMBER
	RPACS			;READ PAGE ACCESS
	TDNE	T2,[PA%RD!PA%PEX]
	GO	MTCOPPG		;COPY PAGE

	AOBJN	T4,MTPGLP	;TRY ANOTHER PAGE

	SETOM	(P2)		;INDICATE END OF SPACE

	MOVE	T1,BOOTEV	;FIND ENTRY VECTOR
	HRRZM	T1,1(P2)	;SET ENTRY VECTOR

	MOVE	[MTSTR1,,WINDOW]
	BLT	WINDOW+<MTPAGX-MTSTR1>

	MOVE	T1,[.FHSLF,,<WINDOW_-^D9>]
	HRLZ	T2,MTJFN
	HRRI	T2,0
	MOVE	T3,[PM%WR]
	PMAP			;PUT MAGTAPE PRE-BOOT IN .RDI FILE
	 ERJMP	[JSERR
		 JRST	START]

	MOVE	T1,FORKN
	KFORK			;KILL "GET" FORK
	 ERJMP	[JSERR
		 JRST	START]

	MOVE	T1,MTJFN
	TLO	T1,(CO%NRJ)
	CLOSF			;CLOSE FILE, KEEP JFN
	 ERR	<CAN NOT CLOSE MAGTAPE RDI FILE>
	MOVE	T1,MTJFN
	TLO	T1,(CF%NUD!<.FBBYV>B17)
	MOVE	T2,[FB%BSZ]
	MOVSI	T3,(^D36B11)
	CHFDB			;UPDATE BYTE SIZE IN FDB

	MOVE	T1,MTJFN
	TLO	T1,(<.FBSIZ>B17)
	MOVE	T2,[-1]
	HRRZ	T3,P1
	IMULI	T3,^D512
	CHFDB			;UPDATE EOF POINTER IN FDB

	MOVE	T1,MTJFN
	RLJFN
	 ERR	<CAN NOT RELEASE MAGTAPE RDI JFN>

	RTN
MTCOPPG:HRRZM	T1,0(P2)	;SET A POINTER TO PAGE NUMBER
	AOS	P2		;POINT TO NEXT
	PUT	T1
	HRRZ	T3,T1		;FIND THE PAGE

	SETZM	PAG0FLG#
	CAIN	T3,1		;IS THIS PAGE 1 ?
	ERR	<CAN'T OVERLOAD PRE-BOOT PAGE>
	CAIN	T3,0		;IS THIS PAGE 0 ?
	SETOM	PAG0FLG		;IF PAGE 0 OF FILE, SET FLAG

	HRL	T1,FORKN	;GET FORK NUMBER
	HRR	T1,T3		;GET PAGE NUMBER
	MOVE	T2,[.FHSLF,,<GENPAG_-^D9>]
	MOVE	T3,[PM%RD]
	PMAP			;GET PAGE IN SELF
	ERJMP	[JSERR
		JRST START]

	MOVE	T3,[GENPAG,,IPAG]
	BLT	T3,IPAG+777

	SKIPN	PAG0FLG		;IS THIS PAGE 0 ?
	JRST	.+4		;NO
	SETZM	IPAG+KPALIVE	;YES, ZERO 8080 COMM AREA
	MOVE	T1,[IPAG+KPALIVE,,IPAG+KPALIVE+1]
	BLT	T1,IPAG+MSSLAVE

	MOVE	T1,[.FHSLF,,<IPAG_-^D9>]
	MOVE	T2,P1		;SET UP PMAP ARGUMENTS
	MOVSI	T3,(PM%WR)
	PMAP
	ERJMP	[JSERR
		JRST START]	;JSYS ERROR

	GETIT	T3		;REMOVE PAGE NUMBER
	AOS	P1		;UPDATE P1 ARGUMENTS
	RTN			;RETURN
;*TOPS-10 OUTPUT MAGTAPE ".RDI" FILE

OMT10:	GO	OPNTEN		;OPEN INPUT FILE
	ERR	<FILE NOT FOUND>

	MOVE	T1,LOOK10+.RBVER ;USE INPUT VERSION AS OUTPUT VERSION
	MOVEM	T1,MT.VER

	LDB	T1,[POINT 11,LOOK10+.RBPRV,23]
	MOVEM	T1,MT.TIME	;USE INPUT TIME AND DATE AS OUTPUT

	LDB	T1,[POINT 3,LOOK10+.RBEXT,20]
	DPB	T1,[POINT 3,MT.DATE,23]
	LDB	T1,[POINT 12,LOOK10+.RBPRV,35]
	DPB	T1,[POINT 12,MT.DATE,35]

	RTN

OMT10A:	MOVE	T1,MT.VER
	MOVEM	T1,O.VER
	MOVE	T1,MT.TIME
	MOVEM	T1,O.TIME
	MOVE	T1,MT.DATE
	MOVEM	T1,O.DATE
	SETZM	O.PRT

	MOVE	T1,GTJDEV
	MOVEM	T1,O.DEV
	MOVE	T1,GTJFIL
	MOVEM	T1,O.NAM1
	MOVE	T1,GTJEXT
	MOVEM	T1,O.EXT
	MOVE	T1,GTJDIR
	MOVEM	T1,O.PPN

	GO	OPNWRT		;OPEN OUTPUT
	ERR	<OUTPUT OPEN FAILURE>

	JRST	REDEXE
SUBTTL	PROCESS TOPS-10 MAGTAPE BOOT EXE FILE

;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
SV.DIR==1776		;DIRECTORY BLOCK CODE
SV.END==1777		;END DIRECTORY BLOCK CODE

DBUF=WINDOW		;EXE DIRECTORY PAGE

Q=10
N=12
M=13
K=14
;HERE TO READ AN EXE FILE

REDEXE:	SETZM	SELPAG#
	GO	REDDIR		;READ THE DIRECTORY PAGE

	HLRZ	A,DBUF		;DIRECTORY DESCRIPTOR
	HRRZ	T6,DBUF		;LENGTH OF THE DIRECTORY
	CAIN	A,SV.DIR	;IS THIS A DIRECTORY?
	CAIL	T6,^D128	; WHICH IS LESS THAN OR EQUAL TO 128 WORDS LONG?
	ERR	<NOT A DIRECTORY OR ONE WE CAN'T HANDLE>

	MOVNI	T6,-1(T6)	;MAKE AN AOBJN POINTER TO THE DIRECTORY
	HRLI	T6,DBUF+1	; ..
	MOVSS	T6		; ..

	OUT	WC,[IOWD ^D512,IPAG
		    0]		;MAKE DUMMY FIRST PAGE FOR NOW
	SKIPA
	ERR	<WRITE ERROR>

	MOVEI	P2,MTPAGD+1

REDEX2:	MOVE	M,(T6)		;BITS,,FILE PAGE NUMBER
	HRRZ	T5,1(T6)	;CORE PAGE NUMBER
	LSH	T5,P2WLSH	;CORE ADDRESS
	SKIPN	T5		;PAGE 0?
	HRROI	T5,0		;YES, READ IT AND REMEMBER ITS PAGE 0

REDEX3:	LDB	T7,[POINT 9,1(T6),8]

REDEX4:	TRNN	M,-1		;AN ALLOCATED BUT ZERO PAGE?
	SOJA	M,REDEX8	;YES, COUNT DOWN REPEAT COUNT AND UPDATE CORE ADDRESS
	HRRZ	T4,M		;FILE PAGE NUMBER
	LSH	T4,P2BLSH	;CONVERT TO BLOCK WITHIN THE FILE
	CAMGE	T4,SELPAG	;FILE PAGE NUMBERS MUST BE MONOTONICALLY INCREASING
	ERR	<PAGES IN EXE DIR AREN'T MONOTONICALLY INCREASING>

REDEX5:	CAMN	T4,SELPAG	;AT THE RIGHT BLOCK WITHIN THE FILE?
	JRST	REDEX7		;YES

REDEX6:	GO	SELBLK		;BYPASS FILE PAGE
	JRST	REDEX5		;SEE IF THERE YET
REDEX7:	CAIN	T5,1000
	ERR	<CAN'T OVERLOAD PRE-BOOT PAGE>

	GO	REDPAG		;READ EXE DATA PAGE

	JUMPGE	T5,.+6		;JUMP IF NOT PAGE 0
	PUT	T1
	SETZM	IPAG+KPALIVE	;YES, ZERO 8080 COMM AREA
	MOVE	T1,[IPAG+KPALIVE,,IPAG+KPALIVE+1]
	BLT	T1,IPAG+MSSLAVE
	GETIT	T1

	PUT	T5
	ANDI	T5,-1
	LSH	T5,W2PLSH
	HRRZM	T5,(P2)		;SET A POINTER TO PAGE NUMBER
	GETIT	T5
	AOS	P2		;POINT TO NEXT

	OUT	WC,[IOWD ^D512,IPAG
		    0]
	SKIPA
	ERR	<WRITE ERROR>

	JUMPGE	T5,REDEX8	;PAGE 0 JUST READ?

	MOVE	IPAG+.JBSA
	MOVEM	MT.SADR		;SAVE STARTING ADDRESS

	MOVEI	T5,0		;READ NEXT PAGE INTO PAGE 1
REDEX8:	ADDI	T5,PAGSIZ	;NEXT PAGE
REDEX9:	SOSL	T7		;READ ALL THE PAGES DESCRIBED BY THIS ENTRY?
	AOJA	M,REDEX4	;NO, READ THE NEXT PAGE

	AOBJN	T6,.+1		;BUMP PAST THIS DIRECTORY ENTRY, AND
	AOBJN	T6,REDEX2	; GO GET THE NEXT DIRECTORY ENTRY

	SETOM	(P2)		;INDICATE END OF SPACE

	MOVE	T1,MT.SADR
	HRRZM	T1,1(P2)	;SET ENTRY VECTOR

	SETZM	IPAG
	MOVE	[IPAG,,IPAG+1]
	BLT	IPAG+777

	MOVE	[MTSTR1,,IPAG]
	BLT	IPAG+<MTPAGX-MTSTR1>

	GO	RDEX10		;PUT MAGTAPE PRE-BOOT IN ".RDI" FILE

	GO	W10EOF		;CLOSE OUTPUT
	GO	R10EOF		;CLOSE INPUT

	RTN			;DONE
;*SELECT NEXT EXE DATA PAGE

SELBLK:

;*READ EXE DATA PAGE

REDPAG:	SKIPA	AC10,[-^D512,,IPAG]

;*READ EXE DIRECTORY PAGE

REDDIR:	MOVE	AC10,[-^D512,,WINDOW]

	GO	GET10
	MOVEM	T3,(AC10)
	AOBJN	AC10,.-2

	MOVEI	4
	ADDM	SELPAG		;INDICATE NEXT SELECTED PAGE

	RTN

RDEX10:	USETO	WC,1		;SELECT 1ST PAGE

	OUT	WC,[IOWD ^D512,IPAG
		    0]
	SKIPA
	ERR	<WRITE ERROR>
	RTN
;*MONITOR BOOT STRAP PROGRAM TO BE WRITTEN ON THE MAGTAPE

MTSTR1:
	PHASE	BOORG

MTSTRT:!JRST	MTSTAR
MTHLT0:!HALT	.		;TRIED TO OVERLOAD PRE-BOOT PAGE
MTHLT1:!HALT	.		;MAGTAPE READ ERROR
MTHLT2:!HALT	.		;NO RH-11 BASE ADDRESS
MTHLT3:!HALT	.		;MAGTAPE SKIP EOF ERROR

MTSTAR:!MOVSI	17,-17
	SETZM	(17)		;ZERO AC'S
	AOBJN	17,.-1
	SETZM	17

	MOVE	MSRH		;GET MAGTAPE ADDRESS
	MOVEM	MTRHSV
	SKIPN
	JRST	MTHLT2		;NO RH-11 BASE ADDRESS ?

	MOVE	MSDRIVE
	MOVEM	MTDRSV		;SAVE DRIVE
	MOVE	MSSLAVE
	MOVEM	MTSLSV		;SAVE SLAVE & FORMAT
	MOVE	KPALIVE
	MOVEM	MTKPAL		;SAVE KEEP-ALIVE WORD
	MOVE	BOOTPA		;SAVE TOPS-20 BDV
	MOVEM	MTSV20

	MOVE	MTRHSV		;SETUP RH-11 TABLE
	MOVE	T1,MTPNTR
	MOVEM	(T1)
	ADDI	2
	AOBJN	T1,.-2
	MOVEI	UBAP0		;SETUP UBA MAP POINTER
	HRRM	MTUBP0
	MOVEI	UBSTAT		;SETUP UBA STATUS POINTER
	HRRM	MTUBST
	MOVEI	P1,^D100	;RETRY 100 TIMES
	MOVEI	T3,MTPAG+1	;FIND THE OFFSET STUFF

RDMT:!	JSP	P,MTSRH		;SETUP RH-11

	MOVE	T4,(T3)		;FIND THE CORE ADDRESS
	CAIN	T4,1		;CAN'T OVERLOAD PRE-BOOT
	JRST	MTBADR		;PAGE 1 REQUESTED TO BE LOADED ?

	JUMPL	T4,RDMTDN	;QUIT IF ALL DONE WITH PAGES

	IORI	T4,UBVBIT
	WRIO	T4,@MTUBP0	;SET UP UNIBUS ADAPTOR PAGE 0

	SETZ	T1,		;CLEAR CURRENT ADDRESS REGISTER
	WRIO	T1,@MTBA	;SET UNIBUS ADDRESS TO 0

	MOVNI	T1,2000		;READ A PAGE (WORD COUNT)
	WRIO	T1,@MTWC	;SET WORD COUNT

	MOVEI	T1,MT.RF
	WRIO	T1,@MTCS1	;READ FORWARD

	JSP	P,MTRDY		;WAIT FOR READY
	TRNE	T1,MTTM
	JRST	MTFAIL		;READ ERROR, EOF DETECTED

	RDIO	T1,@MTER
	TRNE	T1,177777-MTFCE
	JRST	MTRTRX		;ERROR OTHER THAN LENGTH ERROR

	AOS	T3		;POINT TO NEXT ENTRY
	JRST	RDMT		;DO NEXT PAGE

MTRDY:	RDIO	T1,@MTDS	;READ DRIVE STATUS
	TRNN	T1,MTPIP	;IS DRIVE STOPPED ?
	TRNN	T1,MTDRY	;DRIVE READY ?
	JRST	MTRDY		;NO, WAIT
	JRST	@P		;YES, RETURN
MTSRH:!	MOVEI	T1,RHCLR
	WRIO	T1,@MTCS2	;CLEAR MAGTAPE

	MOVE	T1,MTDRSV
	WRIO	T1,@MTCS2	;SELECT DRIVE

	MOVE	T1,MTSLSV
	WRIO	T1,@MTTC	;LOAD TAPE CONTROL REGISTER

	SETZ	T1,
	WRIO	T1,@MTFC	;CLEAR FRAME COUNTER

	JRST	@P		;RETURN

MTRTRX:! SOJL	P1,MTFAIL	;DONE ALL RETRIES ?

	JSP	P,MTSRH		;NO, SETUP RH-11

	MOVNI	T1,1
	WRIO	T1,@MTFC	;SET FRAME COUNT TO -1

	MOVEI	T1,MT.SR
	WRIO	T1,@MTCS1	;BACKSPACE THE TAPE

	JSP	P,MTRDY		;WAIT FOR TAPE TO STOP

	JRST	RDMT		;NOW TRY AGAIN
MTSERR:!MOVEI	17,MTHLT3	;SET HALT ADDRESS
	JRST	.+5

MTBADR:!MOVEI	17,MTHLT0	;SET HALT ADDRESS
	JRST	.+2

MTFAIL:!MOVEI	17,MTHLT1	;SET HALT ADDRESS
	SOS	T3		;POINT TO FAILING ENTRY

	SETZM	100
	MOVE	(T3)
	MOVEM	101		;SAVE MEMORY PAGE ADDRESS

	MOVEM	T3,102		;SAVE SELECTION PICKUP POINTER

	RDIO	@MTCS1
	MOVEM	103		;SAVE CONTROL AND STATUS 1
	RDIO	@MTCS2
	MOVEM	104		;SAVE CONTROL AND STATUS 2
	RDIO	@MTDS
	MOVEM	105		;SAVE DRIVE STATUS
	RDIO	@MTER
	MOVEM	106		;SAVE ERROR 1
	SETZ
	MOVEM	107		;NO ERROR 2
	SETZ
	MOVEM	110		;NO ERROR 3

	RDIO	@MTUBP0
	MOVEM	111		;SAVE UBA PAGING RAM LOC 0
	RDIO	@MTUBST
	MOVEM	112		;SAVE UBA STATUS REG

	MOVE	MTVER
	MOVEM	113		;SAVE PRE-BOOT VERSION

	MOVE	MTRHSV
	MOVEM	MSRH		;REINSTALL RH-11 BASE ADDRESS
	MOVE	MTDRSV
	MOVEM	MSDRIVE		;REINSTALL DRIVE NUMBER
	MOVE	MTSLSV
	MOVEM	MSSLAVE		;REINSTALL SLAVE NUMBER
	MOVE	MTKPAL
	MOVEM	KPALIVE		;REINSTALL KEEP-ALIVE
	MOVE	MTSV20		;RESTORE BDV
	MOVEM	BOOTPA

	JRST	@17		;HALT AT APPROPRIATE HALT
RDMTDN:! AOS	T3
	MOVE	(T3)		;SETUP START ADDRESS
	EXCH	MTSV20		;GET BDV ADDRESS, SAVE START ADDRESS
	MOVEM	BOOTPA		;RESTORE PREVIOUS BDV ADDRESS

	JSP	P,MTSRH		;SETUP RH-11

	MOVEI	T1,MT.SF	;SPACE FORWARD OVER EOF MARKER
	WRIO	T1,@MTCS1

	JSP	P,MTRDY		;WAIT FOR TAPE TO STOP
	TRNN	T1,MTTM		;TAPE MARK DETECTED ?
	JRST	MTSERR		;NO, SPACE FORWARD ERROR

	MOVE	MTRHSV
	MOVEM	MSRH		;REINSTALL RH-11 ADDRESS
	MOVE	MTDRSV
	MOVEM	MSDRIVE		;REINSTALL DRIVE NUMBER
	MOVE	MTSLSV
	MOVEM	MSSLAVE		;REINSTALL SLAVE NUMBER
	MOVE	MTKPAL
	MOVEM	KPALIVE		;REINSTALL KEEP-ALIVE
	WRUBR	MTBLK7
	MOVSI	17,-17
	SETZM	(17)		;ZERO AC'S
	AOBJN	17,.-1
	SETZM	17

	WRUBR	MTBLK6
	MOVSI	17,-17
	SETZM	(17)		;ZERO AC'S
	AOBJN	17,.-1
	SETZM	17

	WRUBR	MTBLK5
	MOVSI	17,-17
	SETZM	(17)		;ZERO AC'S
	AOBJN	17,.-1
	SETZM	17

	WRUBR	MTBLK4
	MOVSI	17,-17
	SETZM	(17)		;ZERO AC'S
	AOBJN	17,.-1
	SETZM	17

	WRUBR	MTBLK3
	MOVSI	17,-17
	SETZM	(17)		;ZERO AC'S
	AOBJN	17,.-1
	SETZM	17

	WRUBR	MTBLK2
	MOVSI	17,-17
	SETZM	(17)		;ZERO AC'S
	AOBJN	17,.-1
	SETZM	17

	WRUBR	MTBLK1
	MOVSI	17,-17
	SETZM	(17)		;ZERO AC'S
	AOBJN	17,.-1
	SETZM	17

	WRUBR	MTBLK0
	MOVSI	17,-17
	SETZM	(17)		;ZERO AC'S
	AOBJN	17,.-1
	SETZM	17

	JRST	@MTSV20		;START BOOT

MTBLK7:!	1B0!7B8		;WRUBR ARGUMENTS
MTBLK6:!	1B0!6B8
MTBLK5:!	1B0!5B8
MTBLK4:!	1B0!4B8
MTBLK3:!	1B0!3B8
MTBLK2:!	1B0!2B8
MTBLK1:!	1B0!1B8
MTBLK0:!	1B0!0B8

MTKPAL:!	0		;KEEP-ALIVE & STATUS WORD
MTRHSV:!	0		;RH-11 BASE ADDRESS
MTDRSV:!	0		;DRIVE NUMBER
MTSLSV:!	0		;SLAVE NUMBER
MTSV20:!	0		;BDV ADDRESS

MTVER:!	BYTE (3)0(9)MCNVER(6)0(18)DECVER	;PRE-BOOT VERSION

MTPNTR:!	-^D16,,MTCS1
MTCS1:!	0
MTWC:!	0
MTBA:!	0
MTFC:!	0
MTCS2:!	0
MTDS:!	0
MTER:!	0
MTAS:!	0
MTCC:!	0
MTDB:!	0
MTMR:!	0
MTDT:!	0
MTSN:!	0
MTTC:!	0
MTUBP0:! 0	;ADDRESS OF FIRST WINDOW
MTUBST:! 0	;ADDRESS OF UBA STATUS REGISTER

MTPAG:!			;NEXT TWO INSTRUCTIONS MUST FOLLOW!!DO NOT MOVE
	DEPHASE

MTPAGD:	BLOCK	100	;CORE PAGE #S FOR EACH MTA RECORD
MTPAGX:	0
IFG <.-MTSTR1>-1000,<PRINTX ?TAPE BOOTSTRAP BIGGER THAN 1 PAGE>
SUBTTL	COMMANDS -- TAKE

TAKE:	NOISE	<COMMANDS FROM FILE>
	HRROI	T1,[ASCIZ "SMFILE"]
	MOVEM	T1,GTJFIL
	HRROI	T1,[ASCIZ "CMD"]
	MOVEM	T1,GTJEXT
	SETZM	GTJDEV
	SETZM	GTJDIR
	MOVSI	T1,(GJ%OLD)
	MOVEM	T1,GTJFLG
	CMD	[FLDDB.(.CMFIL)]
	HRRZM	T2,CMFILE
	CONFIRM

	SKIPN	MONTYP
	JRST	$CCL		;TOPS-10

	HLRZ	T1,CSB+.CMIOJ
	CAIn	T1,.PRIIN
	jrst	.+3
	CLOSF
	ERR	<CAN NOT CLOSE OLD COMMAND FILE>
	HRRZ	T1,CMFILE
	MOVE	T2,[7B5+OF%RD]
	OPENF
	ERR	<CAN NOT OPEN FILE>
	HRLZ	T1,T1
	HRRI	T1,.NULIO
	MOVEM	T1,CSB+.CMIOJ
	SKIPL	ECOFLG
	SETOM	INTAKE
	RTN
SUBTTL	COMMAND SUBROUTINES -- DPYFLD

OPDEF	DPYNOF	[GO	$DPYNOF]

$DPYNOF:PNTMSF	[ASCIZ/%VALUE DID NOT FIT IN FIELD
/]
	RET

DPYFLD:	MOVEI	T1,ENDDPY
	MOVEM	T1,CZADR
	MOVEM	P,CZSP
	PCRL2F

	MOVE	T6,EXMADR
	IMULI	T6,3
	SKIPN	BC1FLG
	ADDI	T6,CRAM
	SKIPE	BC1FLG
	ADDI	T6,CRMBC1
DPYCALL:PMSGF	< CALL/>
	LDB	T2,[POINT 1,2(T6),26]
	GO	UPDFLD
	 JRST	DPYCALL
	DPB	T2,[POINT 1,2(T6),26]
	LSH	T2,-1
	JUMPE	T2,.+2
	DPYNOF

DPYJ:	PMSGF	< J/>
	LDB	T2,[POINT 12,2(T6),23]
	GO	UPDFLD
	 JRST	DPYCALL
	DPB	T2,[POINT 12,2(T6),23]
	LSH	T2,-^D12
	JUMPE	T2,.+2
	DPYNOF

DPYNBR:	PMSGF	< #/>
	LDB	T2,[POINT 6,1(T6),35]
	LSH	T2,^D12
	LDB	T1,[POINT 12,1(T6),23]
	OR	T2,T1
	GO	UPDFLD
	 JRST	DPYJ
	DPB	T2,[POINT 12,1(T6),23]
	LSH	T2,-^D12
	DPB	T2,[POINT 6,1(T6),35]
	LSH	T2,-6
	JUMPE	T2,.+2
	DPYNOF

DPYALU:	PMSGF	< ALU/>
	LDB	T2,[POINT 3,(T6),2]
	GO	UPDFLD
	 JRST	DPYNBR
	DPB	T2,[POINT 3,(T6),2]
	LSH	T2,-3
	JUMPE	T2,.+2
	DPYNOF

	PMSGF	<S/D^>
DPYLSRC:PMSGF	<  LSRC/>
	LDB	T2,[POINT 3,(T6),5]
	GO	UPDFLD
	 JRST	DPYALU
	DPB	T2,[POINT 3,(T6),5]
	LSH	T2,-3
	JUMPE	T2,.+2
	DPYNOF

DPYRSRC:PMSGF	<  RSRC/>
	LDB	T2,[POINT 3,(T6),8]
	GO	UPDFLD
	 JRST	DPYLSRC
	DPB	T2,[POINT 3,(T6),8]
	LSH	T2,-3
	JUMPE	T2,.+2
	DPYNOF

DPYDEST:PMSGF	<  DEST/>
	LDB	T2,[POINT 3,(T6),29]
	GO	UPDFLD
	 JRST	DPYRSRC
	DPB	T2,[POINT 3,(T6),29]
	LSH	T2,-3
	JUMPE	T2,.+2
	DPYNOF
	PMSGF	<A/B^>
DPYA:	PMSGF	<  A/>
	LDB	T2,[POINT 4,(T6),17]
	GO	UPDFLD
	 JRST	DPYDEST
	DPB	T2,[POINT 4,(T6),17]
	LSH	T2,-4
	JUMPE	T2,.+2
	DPYNOF

DPYB:	PMSGF	<  B/>
	LDB	T2,[POINT 4,(T6),23]
	GO	UPDFLD
	 JRST	DPYA
	DPB	T2,[POINT 4,(T6),23]
	LSH	T2,-4
	JUMPE	T2,.+2
	DPYNOF

	PMSGF	<RBM^>
DPYRAM:	PMSGF	<  RAMADR/>
	LDB	T2,[POINT 3,(T6),26]
	GO	UPDFLD
	 JRST	DPYB
	DPB	T2,[POINT 3,(T6),26]
	LSH	T2,-3
	JUMPE	T2,.+2
	DPYNOF

DPYDBUS:PMSGF	<  DBUS/>
	LDB	T2,[POINT 2,(T6),13]
	GO	UPDFLD
	 JRST	DPYRAM
	DPB	T2,[POINT 2,(T6),13]
	LSH	T2,-2
	JUMPE	T2,.+2
	DPYNOF
DPYDBM:	PMSGF	<  DBM/>
	LDB	T2,[POINT 3,(T6),11]
	GO	UPDFLD
	 JRST	DPYDBUS
	DPB	T2,[POINT 3,(T6),11]
	LSH	T2,-3
	JUMPE	T2,.+2
	DPYNOF

DPYSPEC:PMSGF	< SPEC/>
	LDB	T2,[POINT 3,2(T6),32]
	LSH	T2,3
	LDB	T1,[POINT 3,1(T6),8]
	OR	T2,T1
	GO	UPDFLD
	 JRST	DPYDBM
	DPB	T2,[POINT 3,1(T6),8]
	LSH	T2,-3
	DPB	T2,[POINT 3,2(T6),32]
	LSH	T2,-3
	JUMPE	T2,.+2
	DPYNOF

DPYDISP:PMSGF	< DISP/>
	LDB	T2,[POINT 3,2(T6),35]
	LSH	T2,3
	LDB	T1,[POINT 3,1(T6),5]
	OR	T2,T1
	GO	UPDFLD
	 JRST	DPYSPEC
	DPB	T2,[POINT 3,1(T6),5]
	LSH	T2,-3
	DPB	T2,[POINT 3,2(T6),35]
	LSH	T2,-3
	JUMPE	T2,.+2
	DPYNOF

DPYSKIP:PMSGF	< SKIP/>
	LDB	T2,[POINT 4,2(T6),29]
	LSH	T2,3
	LDB	T1,[POINT 3,1(T6),11]
	OR	T2,T1
	GO	UPDFLD
	 JRST	DPYDISP
	DPB	T2,[POINT 3,1(T6),11]
	LSH	T2,-3
	DPB	T2,[POINT 4,2(T6),29]
	LSH	T2,-4
	JUMPE	T2,.+2
	DPYNOF
DPYT:	PMSGF	< T/>
	LDB	T2,[POINT 2,2(T6),25]
	GO	UPDFLD
	 JRST	DPYSKIP
	DPB	T2,[POINT 2,2(T6),25]
	LSH	T2,-2
	JUMPE	T2,.+2
	DPYNOF

DPYCRY:	PMSGF	< CARRY IN/>
	LDB	T2,[POINT 1,1(T6),1]
	GO	UPDFLD
	 JRST	DPYT
	DPB	T2,[POINT 1,1(T6),1]
	LSH	T2,-1
	JUMPE	T2,.+2
	DPYNOF

DPYLSC:	PMSGF	< LOAD SC/>
	LDB	T2,[POINT 1,(T6),30]
	GO	UPDFLD
	 JRST	DPYCRY
	DPB	T2,[POINT 1,(T6),30]
	LSH	T2,-1
	JUMPE	T2,.+2
	DPYNOF

DPYLFE:	PMSGF	< LOAD FE/>
	LDB	T2,[POINT 1,(T6),31]
	GO	UPDFLD
	 JRST	DPYLSC
	DPB	T2,[POINT 1,(T6),31]
	LSH	T2,-1
	JUMPE	T2,.+2
	DPYNOF
DPYFMW:	PMSGF	< FM WRITE/>
	LDB	T2,[POINT 1,1(T6),24]
	GO	UPDFLD
	 JRST	DPYLFE
	DPB	T2,[POINT 1,1(T6),24]
	LSH	T2,-1
	JUMPE	T2,.+2
	DPYNOF

DPYMEM:	PMSGF	< MEM CYCLE/>
	LDB	T2,[POINT 1,1(T6),2]
	GO	UPDFLD
	 JRST	DPYFMW
	DPB	T2,[POINT 1,1(T6),2]
	LSH	T2,-1
	JUMPE	T2,.+2
	DPYNOF

DPYDIV:	PMSGF	< DIVIDE/>
	LDB	T2,[POINT 1,1(T6),28]
	GO	UPDFLD
	 JRST	DPYMEM
	DPB	T2,[POINT 1,1(T6),28]
	LSH	T2,-1
	JUMPE	T2,.+2
	DPYNOF

DPYMP:	PMSGF	< MULTI PREC/>
	LDB	T2,[POINT 1,1(T6),29]
	GO	UPDFLD
	 JRST	DPYDIV
	DPB	T2,[POINT 1,1(T6),29]
	LSH	T2,-1
	JUMPE	T2,.+2
	DPYNOF

DPYMS:	PMSGF	< MULTI SHIFT/>
	LDB	T2,[POINT 1,1(T6),25]
	GO	UPDFLD
	 JRST	DPYMP
	DPB	T2,[POINT 1,1(T6),25]
	LSH	T2,-1
	JUMPE	T2,.+2
	DPYNOF
	PMSGF	<C/LR^>
DPYCLL:	PMSGF	<  DP CLOCK L/>
	LDB	T2,[POINT 1,(T6),18]
	GO	UPDFLD
	 JRST	DPYMP
	DPB	T2,[POINT 1,(T6),18]
	LSH	T2,-1
	JUMPE	T2,.+2
	DPYNOF

DPYGEL:	PMSGF	<  PAR EN L/>
	LDB	T2,[POINT 1,1(T6),26]
	GO	UPDFLD
	 JRST	DPYCLL
	DPB	T2,[POINT 1,1(T6),26]
	LSH	T2,-1
	JUMPE	T2,.+2
	DPYNOF

DPYCHL:	PMSGF	<  CHKL/>
	LDB	T2,[POINT 1,(T6),32]
	GO	UPDFLD
	 JRST	DPYGEL
	DPB	T2,[POINT 1,(T6),32]
	LSH	T2,-1
	JUMPE	T2,.+2
	DPYNOF

DPYCLR:	PMSGF	<  DP CLOCK R/>
	LDB	T2,[POINT 1,(T6),19]
	GO	UPDFLD
	 JRST	DPYCHL
	DPB	T2,[POINT 1,(T6),19]
	LSH	T2,-1
	JUMPE	T2,.+2
	DPYNOF
DPYGER:	PMSGF	<  PAR EN R/>
	LDB	T2,[POINT 1,1(T6),27]
	GO	UPDFLD
	 JRST	DPYCLR
	DPB	T2,[POINT 1,1(T6),27]
	LSH	T2,-1
	JUMPE	T2,.+2
	DPYNOF

DPYCHR:	PMSGF	<  CHKR/>
	LDB	T2,[POINT 1,(T6),33]
	GO	UPDFLD
	 JRST	DPYGER
	DPB	T2,[POINT 1,(T6),33]
	LSH	T2,-1
	JUMPE	T2,.+2
	DPYNOF

DPYMK:	PMSGF	< MARK/>
	LDB	T2,[POINT 1,(T6),35]
	GO	UPDFLD
	 JRST	DPYCHR
	DPB	T2,[POINT 1,(T6),35]
	LSH	T2,-1
	JUMPE	T2,.+2
	DPYNOF
ENDDPY:	SETZM	CZADR
	MOVE	P,CZSP
	MOVEM	T6,CRAMT6

	MOVE	T1,2(T6)		;RECREATE SHUFFLE FORMAT
	MOVE	T2,1(T6)		;MICROCODE WORD
	ROTC	T1,^D12
	MOVEM	T1,AC10

	MOVE	T1,(T6)
	MOVE	T2,1(T6)
	ROTC	T1,^D12
	MOVEM	T2,AC11

	MOVE	AC12,(T6)
	LSH	AC12,^D12

	SETZ	T1,
	DPB	T1,PB.CRA		;CLEAR PRESENT PARITY BITS
	DPB	T1,PB.CRM

	GO	KSXX			;COMPUTE PARITY & RESTORE

	RTN
SUBTTL	COMMAND SUBROUTINES -- UPDFLD

;*SUBROUTINE TO GET NEW VALUE FOR FIELD
;*CALL WITH:
;*	T2/	OLD VALUE
;*	GO	UPDFLD
;*	HERE IF "^" (UPARROW), BACKUP ONE FIELD
;*	HERE WITH NEW VALUE IN T2

UPDFLD:	MOVE	T2
	PNTOCf
	SKIPN	DEPFLG
	RETSKP
	MOVEM	T2,VALUE#
	PTAB
	SKIPN	MONTYP
	JRST	UPDFL1
	HLRZ	T1,CSB+.CMIOJ
	BIN
	CAIN	T2,15
	JRST	GTFLD1
	CAIN	T2,"^"
	JRST	CRPOPJ		;UPARROW
	BKJFN			;BACKUP INPUT POINTER 1 BYTE
	ERR	<UPDFLD: BKJFN FAILED>
UPFLD2:	HLRZ	T1,CSB+.CMIOJ
	MOVEI	T3,10
	NIN
	JRST   [PNTMSF [ASCIZ/
TRY AGAIN: /]
		JRST UPFLD2]
	AOS	(P)
	RTN

GTFLD1:	BIN
	CAIE	T2,12
	ERR	<CARRIAGE RETURN NOT FOLLOWED BY LINE FEED>
	MOVE	T2,VALUE
	AOS	(P)
	RTN

CRPOPJ:	PCRLF
	RTN
UPDFL1:	TTIOCT
	JRST	UPDFL3
	SKIPN	TTNBRF
	JRST	UPDFL2
	MOVE	T2,0
	MOVE	0,$CHRIN
	CAIE	0,15
	JRST	[PNTMSF	[ASCIZ/
TRY AGAIN: /]
		JRST	UPDFL1]
	AOS	(P)
	RTN

UPDFL2:	MOVE	0,$CHRIN
	CAIE	0,15
	JRST	UPDFL4
	MOVE	T2,VALUE
	AOS	(P)
	RTN

UPDFL3:	CAIN	0,"^"
	JRST	CRPOPJ
	CAIN	0,"Z"-100
	JRST	UPDFL5

UPDFL4:	PNTMSF	[ASCIZ/
TRY AGAIN: /]
	JRST	UPDFL1

UPDFL5:	PCRLF
	JRST	ENDDPY
SUBTTL	DISPLAY CRAM BY FIELD BREAKDOWN -- CRMFLD

CRMFLD:	PNTMSF	[ASCIZ	%

C    J   #  ALU S/D  A/B RBM SPEC DISP SKIP T C SC FE FM MC DV MP C/LR M
%]
	LDB	[POINT 1,2(T6),26]
	MOVEM	CFCALL
	PNT1F			;PRINT "CALL"
	PSPACE

	LDB	[POINT 12,2(T6),23]
	MOVEM	CFJ
	PNT4F			;PRINT "J"
	PSPACE

	LDB	[POINT 6,1(T6),35]
	LSH	^D12
	LDB	T1,[POINT 12,1(T6),23]
	OR	T1
	MOVEM	CFNBR
	PNT6F			;PRINT "#"
	PSPACE

	LDB	[POINT 3,(T6),2]
	MOVEM	CFALU
	PNT1F			;PRINT "ALU"
	PSPACE

	LDB	[POINT 3,(T6),5]
	LSH	3		;"LSRC"
	LDB	T1,[POINT 3,(T6),8]
	OR	T1
	LSH	3		;"RSRC"
	LDB	T1,[POINT 3,(T6),29]
	OR	T1		;"DEST"
	MOVEM	CFSD
	PNT3F			;PRINT "S/D"
	PSPACE
	LDB	[POINT 4,(T6),17]
	LSH	6		;"A"
	LDB	T1,[POINT 4,(T6),23]
	OR	T1		;"B"
	MOVEM	CFAB
	PNT4F			;PRINT "A/B"
	PSPACE

	LDB	[POINT 3,(T6),26]
	LSH	3		;PRINT "R"
	LDB	T1,[POINT 2,(T6),13]
	OR	T1		;PRINT "B"
	LSH	3
	LDB	T1,[POINT 3,(T6),11]
	OR	T1		;PRINT "M"
	MOVEM	CFRBM
	PNT3F			;PRINT "RBM"
	PSPACE
	PSPACE
	PSPACE

	LDB	[POINT 3,2(T6),32]
	LSH	3
	LDB	T1,[POINT 3,1(T6),8]
	OR	T1
	MOVEM	CFSPEC
	PNT2F			;PRINT "SPEC"
	PSPACE
	PSPACE
	PSPACE

	LDB	[POINT 3,2(T6),35]
	LSH	3
	LDB	T1,[POINT 3,1(T6),5]
	OR	T1
	MOVEM	CFDISP
	PNT2F			;PRINT "DISP"
	PSPACE
	PSPACE
	PSPACE
	LDB	[POINT 3,2(T6),29]
	LSH	3
	LDB	T1,[POINT 3,1(T6),11]
	OR	T1
	MOVEM	CFSKIP
	PNT2F			;PRINT "SKIP"
	PSPACE

	LDB	[POINT 2,2(T6),25]
	MOVEM	CFT
	PNT1F			;PRINT "T"
	PSPACE

	LDB	[POINT 1,1(T6),1]
	MOVEM	CFC
	PNT1F			;PRINT "C"
	PSPACE
	PSPACE

	LDB	[POINT 1,(T6),30]
	MOVEM	CFSC
	PNT1F			;PRINT "SC"
	PSPACE
	PSPACE
	LDB	[POINT 1,(T6),31]
	MOVEM	CFFE
	PNT1F			;PRINT "FE"
	PSPACE
	PSPACE

	LDB	[POINT 1,1(T6),24]
	MOVEM	CFFM
	PNT1F			;PRINT "FM"
	PSPACE
	PSPACE

	LDB	[POINT 1,1(T6),2]
	MOVEM	CFMC
	PNT1F			;PRINT "MC"
	PSPACE
	PSPACE

	LDB	[POINT 1,1(T6),28]
	MOVEM	CFDV
	PNT1F			;PRINT "DV"
	PSPACE
	PSPACE

	LDB	[POINT 1,1(T6),29]
	LSH	1
	LDB	T1,[POINT 1,1(T6),25]
	OR	T1
	MOVEM	CFMP
	PNT1F			;PRINT "MP"
	PSPACE
	PSPACE
	LDB	[POINT 1,(T6),18]
	LSH	1		;"CLKL"
	LDB	T1,[POINT 1,1(T6),26]
	OR	T1		;"GENL"
	LSH	1
	LDB	T1,[POINT 1,(T6),32]
	OR	T1		;"CHKL"
	MOVEM	CFCL
	PNT1F			;PRINT "CL"
	PSPACE

	LDB	[POINT 1,(T6),19]
	LSH	1		;"CLKR"
	LDB	T1,[POINT 1,1(T6),27]
	OR	T1		;"GENR"
	LSH	1
	LDB	T1,[POINT 1,(T6),33]
	OR	T1		;"CHKR"
	MOVEM	CFCR
	PNT1F			;PRINT "CR"
	PSPACE

	LDB	[POINT 1,(T6),35]
	MOVEM	CFMARK
	PNT1F			;PRINT "M"

	PCRLF
	RET
SUBTTL	MISCELLANEOUS ROUTINES

INTCOR:	SKIPE	IC1TIM#
	JRST	INTCR1

	MOVSI	T1,400000+<^D31*^D512>-1
	CORE	T1,
	ERR	<CAN'T GET HI-CORE>

	SETZM			;MAKE IT WRITABLE
	SETUWP
	ERR	<CAN'T MAKE HI-CORE WRITABLE>

	SETZM	400000
	MOVE	T1,[400000,,400001]
	BLT	T1,400000+<^D31*^D512>-1
	SETOM	IC1TIM
	RTN

INTCR1:	SETZM			;MAKE IT WRITABLE
	SETUWP
	ERR	<CAN'T MAKE HI-CORE WRITABLE>
	RTN

CONCIN:	MOVEI	CCBLK		;SETUP ^C INTERRUPT BLOCK
	MOVEM	134
	SETZM	CCBLK+2
	RTN

CCINT:	SETSTS	16,0		;RESET TTY
	HLRZ	CCBLK+3		;GET INTERRUPT REASON
	CAIE	2		;^C ?
	HALT .
	EXIT

RTTY=	SETSTS	16,0		;RESET TTY
STTY=	SETSTS	16,700		;SET TTY, IO.LEM+IO.SUP+IO.TEC,+.IOASC
SUBTTL	PSI LOGIC -- LEVTAB & CHNTAB

LEVTAB:	LEV1PC
	LEV2PC
	LEV3PC

LFLVTB:	LF1PC
	LF2PC
	LF3PC

CHNTAB:	0			;00 UNUSED
	0			;01 UNUSED
	0			;02 UNUSED
	0			;03 UNUSED
	0			;04 UNUSED
	0			;05 UNUSED
	0			;06 ARITHMETIC OVERFLOW
	0			;07 FLOATING POINT OVERFLOW
	0			;08 RESERVED
	0			;09 PDL OV
	0			;10 END OF FILE
	0			;11 DATA ERROR
	0			;12 RESERVED
	0			;13 RESERVED
	0			;14 RESERVED
	0			;15 ILLEGAL INSTRUCTION
	0			;16 ILLEGAL MEMORY READ
	0			;17 ILLEGAL MEMORY WRITE
	0			;18 RESERVED
	2,,FRKERR		;19 INFERIOR PROCESS TERMINATION
	0			;20 SYSTEM RESOURCES EXHAUSTED
	0			;21 RESERVED
	0			;22 NON-X-PAGE
	0			;23 UNUSED
	0			;24 UNUSED
	0			;25 UNUSED
	0			;26 UNUSED
	0			;27 UNUSED
	0			;28 UNUSED
	0			;29 UNUSED
	1,,CTLX			;30 CONTROL-X
	1,,CTLC			;31 CONTROL-C
	1,,CTLZ			;32 CONTROL-Z
	1,,CTLT			;33 CONTROL-T
	1,,ctlo			;34 control-o
	0			;35 UNUSED
SUBTTL PSI LOGIC -- CONTROL-C AND CONTROL-X

;*HERE ON A CONTROL-C INTERRUPT

CTLC:	MOVE	[1B5+.+3]
	MOVEM	LEV1PC
	DEBRK
	HALTF			;EXIT TO MONITOR
	JRST	START

;*HERE ON CONTROL-X INTERRUPT

CTLX:	TMSG	<
ABORTED
>
	MOVE	T1,[1B5+REEN]	;WHERE TO GO
	MOVEM	T1,LEV1PC	;STORE IT
	DEBRK			;GO REENTER
	JRST	REEN		;INTERNAL CONFUSION

;*HERE ON CONTROL-Z INTERRUPT

CTLZ:	SKIPN	CZADR
	DEBRK
	PUSH	P,T1
	MOVE	T1,CZADR
	TLO	T1,(1B5)
	MOVEM	T1,LEV1PC
	POP	P,T1
	DEBRK

;*HERE ON A CONTROL-T INTERRUPT

CTLT:	SKIPN	CTADR
	DEBRK
	SAVEAC
	GO	@CTADR
	RESTAC
	DEBRK
;*here on control-o interrupt

ctlo:	SETCMM	NOTYPE#
	debrk

;**PSI LOGIC -- FORK TERMINATION

;*HERE WHEN A FORK TERMINATES
FRKERR:	put	t1
	hrrz	t1,lev2pc
	cain	t1,pushpc
	jrst	[getit	t1
		 debrk]
	MOVEI	T1,.PRIOU
	DOBE
	CFIBF
	TMSG	<
?UNEXPECTED INFERIOR PROCESS TERMINATION
PROGRAM RESTARTING...
>
	JRST	START

SUBTTL	PSI LOGIC -- CONTROL T

RDULDT:	TMSG	<
READING CRAM ADDRESS - >
	MOVE	T2,RDULT6
	MOVEI	T1,.PRIOU
	MOVEI	T3,^D8
	NOUT
	ERR	<CONTROL-T NOUT FAILED>
	TMSG	<
>
	RTN


PARSET:	HRROI	T1,[ASCIZ "
WAITING FOR A COMMAND
SMFILE>"]
	PSOUT
	RTN
SUBTTL	STORAGE -- PRESERVED

	XLIST			;LITERAL POOL
L:	LIT
ENDLIT:
	LIST			;LITERAL POOL

;*COMMAND STATUS BLOCK FOR COMND JSYS
CSB:	PARSE
	.PRIIN,,.PRIOU
	-1,,PROMPT
	-1,,CMDBUF
	-1,,CMDBUF
	^D250
	0
	-1,,ATOM
	^D250
	GTJFNB

GTJFNB:
GTJFLG:	EXP	GJ%OLD
	.PRIIN,,.PRIOU
GTJDEV:	0
GTJDIR:	-1,,[ASCIZ "SMFILE"]
GTJFIL:	-1,,[ASCIZ "DECSYSTEM-2020"]
GTJEXT:	-1,,[ASCIZ "RAM"]
	0
	0
	0
	0
	0
	0
	0
	0
	0

CMDBUF:	BLOCK	^D50
ATOM:	BLOCK	^D50
DEBUGF:	0			;0 = PRODUCTION, -1 = DEBUG
PARFLG:	0			;EVEN/ODD CRAM PARITY SWITCH
LOGFLG:	0			;-1 = LOG, 0 = NO LOG
RDFLAG:	BLOCK	1		;INDICATES MICROCODE READ IN
ECOFLG:	-1			;-1=ECHO, 0=DON'T ECHO TAKE FILES

LOGNAM:	SIXBIT/SMFILE/		;LOG FILE NAME & EXT
LOGEXT:	SIXBIT/LOG/
SUBTTL	 COMMAND PROCESSOR

	LALL

$PNAME:	PGMNAM
$PVER:	MCNVER,,DECVER

PGMNAM:	ASCIZ	%
DECSYSTEM 2020 DIAGNOSTICS FE-FILE PROGRAM
%

REENTR:	DROPDV			;CLOSE LOG FILE
	SKIPE	MONTYP
	JRST	REEN20
	CALLI	0
	CALLI	12

REEN20:	RESET
	HALTF
	JRST	START
SUBTTL	MAIN SUBROUTINE PACKAGE CONTROL

S
;*INITIALIZE THE SUBROUTINE PACKAGE
S

SUBRTN:	SIXBIT/SUBRTN/		;"SUBRTN" IDENTIFICATION WORD
SUBVER:	MCNVER,,DECVER		;"SUBRTN" VERSION INFORMATION
PNTNAM:	SIXBIT/SMFILE/
PNTEXT:	SIXBIT/LOG/

S
;*CONTRL* SUBROUTINE PACKAGE INITIALIZATION
S

SBINIT:
$PGMIN:	MOVEM	0,$$PAC0
	SETOM	USER
	JSP	0,.+1		;LOAD FLAGS INTO AC0
	TLNN	0,USERF		;USER MODE ?
	HALT	.		;EXEC MODE
	SETZM	MONTYP
	MOVE	[112,,11]
	GETTAB			;GET MONITOR TYPE ID
	CAM
	CAIN	40000		;TOPS20 ?
	SETOM	MONTYP		;YES
S
;*INITIALIZE PROCESSOR FLAGS AND PUSH LIST
S

$PGMN1:	HLRZ	JOBSA		;RESET JOB FIRST FREE TO
	MOVEM	JOBFF		;END OF LOW SEGMENT
	SKIPN	MONTYP
	CALLI	0		;TOPS10 RESET
	SKIPE	MONTYP
	RESET			;CLEAR USER I/O
	JRST	2,@.+1		;CLEAR PC FLAGS
		0,,.+1
	MOVE	CONSW
	MOVEM	$SVCSW#		;SAVE PREVIOUS SWITCHES
	SETZM	CONSW#		;CLEAR SWITCH REGISTER
	SETZM	$SWFLG#		;DISALLOW SWITCHES TILL INITED
	MOVE	P,PLIST		;INIT PUSH POINTER

S
;*INITIALIZE SUBROUTINES
S

PGINGO:	GO	$CPUTP		;DETERMINE CPU TYPE (KL/KI/KA)
	GO	$UUOIN		;INIT UUO TRAP TRANSFER LOCATION
	GO	$PNTIN		;INIT PRINT SUBROUTINE
	GO	$TYPIN		;INIT TTY INPUT SUBROUTINE
	SETOM	$ONETM		;SET ONE TIME FLAG
	JRST	@$$PAC0#
SUBTTL	UUO HANDLING SUBROUTINE

S
;*UUO INITIALIZATION
S

$UUOIN:	MOVE	[GO  $UORTN]	;BRING IN UUORTN ENTRY INSTR.
	MOVEM	JOB41		;SETUP UUO TRAP AT JOB41
	MOVE	[JRST $UOERX]
	MOVEM	$UUOER		;SET UUO ERROR IN "FIXED"
	SETZM	$UPLER#
	RTN			;EXIT

;*$UORTN - UUO PROCESSING

$UORTN:	PUT	AC0		;SAVE AC0 ON PUSH LIST
	MOVE	AC0,JOBUUO	;GET THE UUO
	LSH	AC0,-^D27	;ISOLATE INSTRUCTION FIELD FOR UUO (RT 27 PLACES)
	CAILE	AC0,36		;IS IT 36 OR LESS? (LOW)
	JRST	$SUBUO		;DECODE 37 @ $SUBUO
$USRUO:	MOVE	AC0,-1(P)	;GET USRPC + 1 (AC0 IS ALSO ON THE STACK)
	SUBI	1		; - 1
	MOVEM	$SVUPC		;SAVE FOR USER UUO ROUTINE (IF NEEDED)
	MOVE	AC0,JOBUUO	;GET UUO FROM LOCATION 40 IN JDA
	MOVEM	$SVUUO		;SAVE FOR USER UUO ROUTINE
	MOVE	AC0,$SVUUO
	LSH	AC0,-^D27	;RIGHT SHIFT FOR INDEX INTO UUO TABLE
	PUT	1
	LSHC	0,-1
	ADDI	UUODIS		;ADD USER UUO TABLE START TO THE UUO
$XUUO:	TLNN	1,400000
	HRRZ	@0		;EVEN UUO
	TLNE	1,400000
	HLRZ	@0		;ODD UUO
	GETIT	1
	EXCH	AC0,(P)		;PUT ADR ON STACK, AC0 BACK IN AC0
	RTN			;SPECIAL XFER TO ROUTINE USING ADR ON STACK

$SUBUO:	SUBI	AC0,37		;NORMALIZE TO MAKE LOWEST UUO = 0
	ADDI	AC0,TABLE0	;ADDR OF TABLE + NORM. UUO (0-3)
	JRST	@0		;SELECT THE CORRECT ERROR UUO VIA TABLE

TABLE0:	JRST	$UUO37		;UUO = 37 .......DECODE SUBROUTINE UUO

S
;*UUO ERROR EXIT ROUTINE
S
	SALL

	GETIT	AC0		;POP OFF AC0 (KA MUUO'S)
$UOERX:	PUT	JOBUUO		;SAVE BAD UUO WHILE PRINTING VIA AC0 (P + 1)
	PMSG	<^ILLEGAL UUO^UUO]]FLAGS]  PC^>
	GETIT	AC0		;GET BAD UUO FROM THE STACK (P - 1)
	PNTHW			;PRINT IT
	PSP			;PRINT SPACE
	GETIT	AC0		;GET FLAGS & UUO PC + 1 FROM STACK (P - 1)
	SUBI	AC0,1		;SUBTRACT 1
	PNTHW			;PRINT FLAGS & UUO PC
	PCRL			;PRINT C/R & L/F
	FATAL

	LALL
S
;*DECODE ROUTINE FOR SUBROUTINE UUO'S (037)
S

$UUO37:	HRRZ	JOBUUO		;GET CALLING UUO
	JUMPE	$PNTIT		;PRINT UUO
	CAIN	0,1
	JRST	$PNTIF		;PRINT FORCED UUO
	TRNE	777600
	JRST	$EG177		;PRINT MESSAGE UUO
	CAIL	5
	JRST	$EG4		;PRINT CHAR IMMEDIATE UUO
	PUT	1
	MOVE	1,JOBUUO
	LSH	1,-^D23		;EXTRACT UUO AC FIELD
	ANDI	1,17
	LSH	0,4		;POSITION E FIELD
	IOR	0,1		;COMBINE E & AC FIELD
	LSHC	0,-1		;SET ODD/EVEN
	ADDI	$UOTAB-20	;COMPUTE TABLE ENTRY OFFSET
	JRST	$XUUO

$UOTAB:				;E FIELD = 2
	$PTSXF,,$PNTSX
	$UOERX,,$UOERX
	$DRPDV,,$PNTNM
	$UOERX,,$UOERX
	$UOERX,,$UOERX
	$UOERX,,$UOERX
	$UOERX,,$UOERX
	$UOERX,,$UOERX
				;E FIELD = 3
	$YESNO,,$OPTLK
	$TPOCT,,$NOYES
	$TPCNV,,$TPDEC
	$TALTM,,$TTLK
	$TTYIN,,$TISIX
	$UOERX,,$TPCLR
	$PSIXF,,$PSIX
	$POCSF,,$POCS
				;E FIELD = 4
	$UOERX,,$UOERX
	$UOERX,,$UOERX
	$UOERX,,$UOERX
	$UOERX,,$UOERX
	$UOERX,,$UOERX
	$UOERX,,$END
	$FATAL,,$ERHLT
	$UOERX,,$EOP

$EG4:	MOVE	JOBUUO		;IMMEDIATE CHARACTER PRINT
	TLNE	(1B12)
	JRST	[PNTCHF
		JRST	$EGX]
	PNTCHR
	JRST	$EGX

$EG177:	MOVE	JOBUUO		;IMMEDIATE MESSAGE PRINT
	TLNE	(4B12)
	JRST	[PSIXLF
		JRST	$EGX]
	TLNE	(2B12)
	JRST	[PSIXL
		JRST	$EGX]
	TLNE	(1B12)
	JRST	[PNTALF
		JRST	$EGX]
	PNTAL
$EGX:	GETIT	0
	RTN

SUBTTL	PROCESSOR TYPE DETERMINATION
S

$CPUTP:	SETZM	CYCL60#
	SETZM	SM10
	SETZM	KLFLG
	SETZM	KAIFLG
$CPKL:	MOVE	1,[1,,1]	;IF KL10, AC1 AFTER BLT WILL CHANGE
	BLT	1,1
	CAMN	1,[1,,1]
	JRST	$CPKAI
	SETOM	KLFLG		;KL10 - SET FLAG

$CPINI:	SKIPN	MONTYP
	JRST	.+5		;TOPS-10
	MOVE	1,[SIXBIT/APRID/]
	SYSGT			;GET SERIAL NUMBER
	MOVE	0,1
	JRST	.+4
	MOVE	0,[20,,11]
	GETTAB
	SETZ	0,
	MOVEM	0,$$SNX#	;SAVE IT
	SKIPN	KLFLG
	RTN
	CAILE	0,^D4096	;IS THIS A KS10 ?
	SETOM	SM10		;YES, SERIAL # GT 4096.
	RTN

$CPKAI:	SETOM	KAIFLG
	MOVNI	0,1
	AOBJN	0,.+1
	SKIPE
	SETZM	KAIFLG		;KA10

	JRST	$CPINI
SUBTTL	PROGRAM HALTS

;*SUBROUTINE ERROR HALT
S
	SALL

$ERHLT:	PNTNM			;PRINT PROGRAM NAME
	PMSGF	<ERROR HALT AT >
	GETIT	$ERH0
	PUT	0
	MOVE	AC0,$ERH0#	;LOAD HALT LOC WITH USRPC + 1 FOR RESTART
	SOS			;SUBTRACT ONE FOR USRPC OF ERROR
	PNT6F			;PRINT USRPC FORCED
	PCRLF

$ERHL4:	GETIT	AC0
	SKIPE	MONTYP
	JRST	.+3
	CALLI	1,12
	JRST	@$ERH0
	HALTF			;RETURN TO MONITOR
	JRST	@$ERH0		;IF CONTINUED
	LALL

;*FATAL PROGRAM ERROR HALT
S
	SALL

$FATAL:	PNTNM
	PMSGF	<FATAL PROGRAM ERROR AT >
	MOVE	AC0,(P)		;RETRIEVE USRPC + 1 FROM THE STACK
	SOS			;- 1
	PNT6F			;PRINT IT
	PCRLF
	JRST	$EOP		;END PROGRAM
	LALL
SUBTTL	PROGRAM NAME PRINTER

;*PRINT PROGRAM NAME IF NOT STAND-ALONE OR USER MODE
S
	SALL
$PNTNM:	SKIPL	MONCTL		;DIAG MON / SYS EXR ?
	JRST	$PNM2		;NO
	PNTMSG	@$PNAME		;PRINT PROGRAM NAME
	PMSG	<VERSION >
	HLRZ	JOBVER
	ROT	-6		;JUSTIFY CONVENTIONALLY
	PNTOCS			;PRINT MCN LEVEL
	PNTCI	"."
	HRRZ	JOBVER
	PNTOCS			;PRINT DEC VERSION
	SKIPN	MONTYP
	PMSG	<, TOPS-10>
	SKIPE	MONTYP
	PMSG	<, TOPS-20>
	
	SKIPE	KLFLG
	JRST	[SKIPE	SM10
		 JRST	[PMSG	<, KS10>
			 JRST	$PNM3]
		 PMSG	<, KL10>
		 JRST	$PNM3]
	SKIPN	KAIFLG
	JRST	[PMSG	<, KA10>
		 JRST	$PNM3]
	PMSG	<, KI10>

$PNM3:	SKIPN	$$SNX
	JRST	$PNM2
	PMSG	<, CPU#=>
	MOVE	$$SNX
	PNTDEC

$PNM2:	PCRL
	RTN			;EXIT

	LALL
SUBTTL	*SUBRTN* END OF PASS/END OF PROGRAM ROUTINES
	LALL
;*END OF PASS ROUTINE
S
	SALL
$END:	AOS	PASCNT		;INCREMENT PASS COUNTER
	SOS	ITRCNT
$END2:	PMSGF	<END PASS >
	MOVE	PASCNT		;PRINT END OF PASS COUNT
	PNTDCF
	PNTCIF	"."
	PCRLF
$END3:	AOS	(P)
	RTN
	LALL

;*END OF PROGRAM ROUTINE
S

$EOP:	SKIPN	MONTYP
	CALLI	12
	HALTF			;YES, EXIT
	JRST	START
	LALL
SUBTTL	*SUBRTN* TELETYPE INPUT ROUTINES

S
;*CARRIAGE RETURN OR COMMA TERMINATES OCTAL, DECIMAL, OR CONVERT TYPE-IN.
;*CHARACTER OR NUMBER RETURNED IN AC0.
;*CALL SEQUENCE IS AS FOLLOWS:
;*	NAME
;*	NO/ERROR RESPONSE RETURN (+ 1)
;*	NORMAL RESPONSE RETURN (+ 2)
;*$OPTLK =	INPUT ANY CHARACTER
;*$YESNO =	ASK QUESTION, CORRECT RESPONSE Y
;*$NOYES =	ASK QUESTION, CORRECT RESPONSE N
;*$TPOCT =	INPUT UP TO 12 OCTALS
;*$TPDEC =	INPUT UP TO 11 DECIMALS
;*$TPCNV =	INPUT UP TO 9 CONVERT'S
;*$TTLK  =	KEYBOARD CHECK, INPUT ANY CHARACTER (NO WAIT)
;*$TALTM =	KEYBOARD, ALT-MODE CHECK
;*$TISIX =	INPUT UP TO 6 SIXBIT CHARACTERS
S

;*TELETYPE INPUT INITIALIZATION
S
$TYPIN:	SETZM	INUPTR		;CLEAR INPUT POINTER
	RTN			;NO TYPE-IN AVAILABLE

S
;*CHECKS FOR ANY KEY STRUCK, RETURNS IMMEDIATELY
;*RETURNS +1 IF NO TYPEIN, RETURNS +2 IF CHAR TYPED
S

$TTLK:	SETZ	AC0,
	SKIPGE	MONCTL		;NO CHECK IF "MONITOR"
	RTN
	SKIPE	MONTYP
	JRST	.+4
	INCHRS	$TTCHR		;TOPS10 INPUT CHAR AND SKIP
	RTN			;NONE AVAILABLE
	JRST	$HEAR4		;GO PROCESS
	PUT	1
	PUT	2
	MOVEI	1,.PRIIN
	SIBE			;ANY INPUT AVAILABLE ?
	 JRST	.+4		;YES
	GETIT	2
	GETIT	1
	RTN
	PBIN			;GET INPUT CHAR
	MOVEM	1,$TTCHR
	GETIT	2
	GETIT	1
	JRST	$HEAR4		;CHAR TYPED, GO PROCESS
S
;*TELETYPE IMAGE MODE INPUT
;*PROVIDES UNBUFFERED MODE INPUT
;*WAITS FOREVER, RETURN WITH CHAR UPPER CASED & ECHOED
S

$TTYIN:	SKIPE	MONTYP
	JRST	.+3
	INCHRW			;TOPS10 INPUT CHAR AND WAIT
	JRST	.+5
	PUT	1
	PBIN
	MOVEM	1,$TTCHR
	GETIT	1
	GO	$HEAR4		;PROCESS IT
	JRST	.-1
	RTN

$OPTLK:	MOVEM	4,$TACB4#
	GO	$HEAR
	JRST	.-1
	AOS	(P)
	MOVEI	4,1
	MOVEM	4,$TWCNT	;INDICATE NO TIMEOUT
	MOVE	4,$TACB4
	RTN

S
;*TELETYPE ALT-MODE CHECK ROUTINE
S

$TALTM:	GO	$TTLK
	RTN			;NO TYPE-IN  ...EXIT

$TALT2:	CAIE	175
	CAIN	176
	JRST	$TALT1		;ALT-MODE WAS TYPED
	CAIE	33
	JRST	.+2		;NO ALT-MODE

$TALT1:	JRST	CPOPJ1		;ALT-MODE, RETURN +2

	RTN
S
;*TELETYPE INPUT CHARACTER 
S

$HEAR:	SKIPE	MONTYP
	JRST	.+3
$$$TT0:	INCHWL	$TTCHR		;TOPS10 INPUT CHAR LINE MODE
	JRST	$HEAR4
	SKIPN	INUPTR		;ANY INPUT POINTER ?
	JRST	.+5		;NO, INPUT CLEARED
	ILDB	0,INUPTR	;GET CHAR FROM STORE
	JUMPE	0,.+3		;USED IT ALL, GET NEW INPUT
	MOVEM	0,$TTCHR	;SAVE IT
	JRST	$HEAR4		;GO PROCESS

	PUT	1
	PUT	2
	PUT	3
	MOVE	1,[POINT 7,D$ISTR]
	MOVEM	1,INUPTR#	;SETUP INPUT POINTER
	MOVE	2,[RD%BRK!RD%TOP!^D132]
	SETZ	3,

	RDTTY			;GET TTY INPUT FROM MONITOR
	 JRST	T20ERR

	GETIT	3
	GETIT	2
	GETIT	1
	JRST	$HEAR		;NOW GO PROCESS

$TPCLR:	PUT	1
	SETZM	INUPTR		;CLEAR INPUT POINTER
	MOVEI	1,.PRIIN
	SKIPN	MONTYP
	CLRBFI			;TOPS10 CLEAR BUFFER
	SKIPE	MONTYP
	CFIBF			;ERROR, CLEAR TYPE-IN BUFFER
	GETIT	1
	RTN
S
;*CHARACTER PROCESSING ROUTINE FOR INPUT
;*CHARACTER RETURNED IN AC0 IS UPPER CASE
;*ACTUAL CHARACTER IS IN $TTCHR
S

$HEAR4:	MOVE	0,$TTCHR	;GET ACTUAL CHARACTER
	ANDI	0,177		;CLEAR PARITY BIT
	CAIL	0,"A"+40	;CONVERT TO UPPER CASE
	CAILE	0,"Z"+40
	JRST	.+2
	SUBI	0,40
	MOVEM	0,$CHRIN#	;SAVE CHARACTER
	CAIE	0,15		;IS IT CR ?
	JRST	$HEAR3		;NO
	SETZM	$CARCT		;CLEAR CHARACTER COUNTER
	SKIPN	MONTYP
$$$TT1:	INCHRW			;TOPS10 FLUSH LF
	SKIPE	MONTYP
	IBP	INUPTR		;GET RID OF LF
	MOVE	0,CONSW
	TLNN	0,PNTLPT	;LPT/LOGICAL DEVICE OUTPUT ?
	JRST	$HEAR2		;NO
	PCRL			;YES-ADD CRLF
$HEAR2:	MOVE	0,$CHRIN	;PUT INPUT CHAR IN AC0
	AOS	(P)		;SKIP RETURN +2 
	RTN			;NORMAL RETURN +1 

$HEAR3:	MOVE	0,CONSW		;GET DATA SWITCHES
	TLNN	0,PNTLPT	;PRINT ON LPT?
	JRST	$HEAR2		;NO-EXIT 
	MOVE	0,$CHRIN	;YES
	PNTCHR			;SEND CHAR TO LPT/LOGICAL DEV
	JRST	$HEAR2		;EXIT 
SUBTTL	*SUBRTN* TELETYPE  YES/NO TYPE-IN ROUTINE

S
;*ACCEPTS Y OR N
;*FOR YESNO, Y IS SKIP RETURN, N OR NO RESPONSE IS DIRECT RETURN
;*FOR NOYES, N IS SKIP RETURN, Y OR NO RESPONSE IS DIRECT RETURN
;*'Y OR N <CR> - ' ASKED UPON ENTRY
S

$NOYES:	MOVEI	0,1		;INIT FOR N ANSWER
	JRST	.+2
$YESNO:	MOVEI	0,0		;INIT FOR Y ANSWER
	MOVEM	1,$TACC1#	;SAVE AC'S
	MOVEM	2,$TACC2#
	MOVE	2,0

$YN1:	PMSGF	< Y OR N <CR> - >
	GO	$OPTLK
	JRST	$YN2		;NO RESPONSE
	CAIE	0,"Y"		;IS IT A 'Y' ?
	CAIN	0,"N"		;OR AN 'N' ?
	JRST	.+2		;YES
	JRST	$YN3		;NEITHER, ERROR
	MOVE	1,0
	LSH	1,7		;POSITION 1ST CHAR
	GO	$OPTLK
	JRST	$YN2		;NO RESPONSE
	OR	1,0		;MERGE 2ND CHAR
	CAMN	1,$YN4(2)	;COMPARE FOR REQUESTED
	JRST	.+4		;YES, RETURN +2
	CAMN	1,$YN4+1(2)	;COMPARE FOR OPPOSITE
	JRST	.+3		;YES, RETURN +1
	JRST	$YN3		;ERROR, REPEAT
	AOS	(P)		;YES, RETURN +2
$YN2:	MOVE	2,$TACC2	;RESTORE AC2
	MOVE	0,1
	MOVE	1,$TACC1	;RESTORE AC1
	RTN			;RETURN +1

$YN3:	PCRLF
	GO	$TPCLR		;CLEAR INPUT
	JRST	$YN1

$YN4:	EXP	26215		;'Y' (CR)
	EXP	23415		;'N' (CR)
	EXP	26215		;'Y' (CR)
SUBTTL	*SUBRTN* TELETYPE OCTAL-DECIMAL-CONVERT TYPE-IN ROUTINE

S
;*ACCEPTS 0 TO 12 OCTALS, 0 TO 11 DECIMALS, 0 TO 9 CONVERT CHARACTERS
;*NUMBER RETURNED IN AC0.
S

$TPCNV:	MOVEI	AC0,2		;SET INDEX TO CONVERT
	JRST	$TPCV1
$TPDEC:	MOVEI	AC0,1		;SET INDEX TO DECIMAL
	JRST	$TPCV1
$TPOCT:	MOVEI	AC0,0		;SET INDEX TO OCTAL

$TPCV1:	MOVEM	1,$TACD1#	;SAVE AC'S 1-3
	MOVEM	2,$TACD2#
	MOVEM	3,$TACD3#
	MOVE	3,0		;LOAD AC3 WITH THE INDEX
	SETZB	1,2		;CLEAR DATA REG, CHAR COUNTER
	SETZM	$TYPNB#		;CLEAR ERR NUMBER
	SETZM	$NEGF#		;CLEAR NEGATE FLAG
	SETZM	$CNVD#		;CLEAR DECIMAL CONVERT FLAG
	SETZM	TTNBRF		;CLEAR DIGIT TYPED FLAG


;*INPUT AND COMPUTE NUMBER
S

$TYPLP:	GO	$OPTLK
	JRST	$TPERR		;NO RESPONSE, GO TO ERROR EXIT
	CAIN	0,"-"		;IS IT MINUS ?
	JRST	$NEGX		;YES
	CAIN	0,"."		;IS IT PERIOD ?
	JRST	$CNVX		;YES
	CAIN	0,15		;IS IT CR ?
	JRST	$TPEXT		;YES
	CAIN	0,","		;IS IT COMMA ?
	JRST	$TPEXT		;YES
	CAIL	0,"0"		;A VALID DIGIT ?
	XCT	$TPCK(3)	;YES
	JRST	$TPERR		;NO ...ERROR EXIT

$TYPL1:	SETOM	TTNBRF		;SET DIGIT TYPED FLAG
	AOS	2		;INCREMENT CHARACTER COUNTER
	XCT	$TPMUL(3)	;MULT BY OCTAL/DECIMAL BASE, SHIFT CONVERT
	SUBI	60		;ADD IN NEW CHAR
	ADD	1,0
	JRST	$TYPLP		;REPEAT TILL CR OR COMMA
;*CHECK FOR PROPER AMOUNT OF CHARACTERS
S

$TPEXT:	XCT	$TPNBR(3)	;PROPER NUMBER OF CHARACTERS
	JRST	$TPERR		;NO ...ERROR EXIT 
	CAIN	3,2		;CONVERT ? (INDEX = 2)
	JRST	$CNVX1		;YES
				;NO, EXIT

$TPEX1:	MOVE	3,$TACD3	;RESTORE AC'S 3 & 2
	MOVE	2,$TACD2
	MOVE	0,1		;PUT NUMBER IN AC0
	SKIPE	$NEGF		;NEGATE ?
	MOVN	0,1		;YES
	MOVE	1,$TACD1	;RESTORE AC1
	AOS	(P)		;RETURN +2 
	RTN			;RETURN +1 

$TPERR:	MOVEM	1,$TYPNB	;SAVE NUMBER - ERROR EXIT
	MOVE	3,$TACD3	;RESTORE AC'S
	MOVE	2,$TACD2
	MOVE	1,$TACD1
	RTN			;ERROR EXIT )


;*NUMBER COMPUTING CONSTANTS
S

$TPCK:	CAILE	0,"7"		;OCTAL NUMBER CHECK
	CAILE	0,"9"		;DECIMAL NUMBER CHECK
	CAILE	0,"9"		;CONVERT NUMBER CHECK
$TPMUL:	LSH	1,3		;OCTAL BASE SHIFT
	IMULI	1,^D10		;DECIMAL BASE MULTIPLIER
	LSH	1,4		;CONVERT SHIFT
$TPNBR:	CAILE	2,^D12		;ACCEPT UP TO 12 OCTALS
	CAILE	2,^D11		;ACCEPT UP TO 11 DECIMALS
	CAILE	2,^D9		;ACCEPT UP TO 9 CONVERT
$NEGX:	SKIPE	2		;1ST CHAR ?
	JRST	$TPERR		;NO, ERROR EXIT )
	SETOM	$NEGF		;YES, SET NEGATE FLAG
	JRST	$TYPLP		;GET NEXT CHAR

$CNVX:	CAIE	3,2		;PERIOD, IN CONVERT ?
	JRST	$TPERR		;NO, ERROR EXIT )
	SETOM	$CNVD		;YES, SET DECIMAL FLAG
	JRST	$TYPLP		;GET NEXT CHAR


;*CONVERT CONVERSION ROUTINE
S

$CNVX1:	MOVEI	2,^D9		;NINE DIGITS
	SETZM	0
	SKIPE	$CNVD		;OCTAL OR DECIMAL ?
	JRST	$CNVX2		;DECIMAL
	TDNE	1,[421042104210]	;OCTAL
	JRST	$TPERR		;OCTAL ERROR, 8 OR 9 INPUT
	LSH	1,1		;SQUEEZE OUT 4TH BIT
	LSHC	0,3		;COMPACT INTO OCTAL
	SOJN	2,.-2		;COMPLETED ?
	MOVE	1,0		;YES
	JRST	$TPEX1		;RETURN 

$CNVX2:	SETZM	3		;DECIMAL
	SETZM	0
	IMULI	3,^D10		;MULTIPLY BY DECIMAL BASE
	LSHC	0,4		;UNPACK NEXT DIGIT
	ADD	3,0		;ADD IN
	SOJN	2,.-4		;COMPLETED ?
	MOVE	1,3		;YES
	JRST	$TPEX1		;RETURN )

SUBTTL	*SUBRTN*  TELETYPE SIXBIT INPUT ROUTINE

S
;*INPUTS UP TO SIX CHARACTERS, TERMINATES WITH A CR OR COMMA.
;*SIXBIT WORD RETURNED IN AC0
S

$TISIX:	MOVEM	1,$TSX1#	;SAVE AC'S
	MOVEM	2,$TSX2#
	MOVE	2,[POINT 6,1]
	MOVEI	1,0

$TSXB1:	GO	$OPTLK
	JRST	$TSXB3		;NO RESPONSE, RTN + 1
	CAIN	0,15
	JRST	$TSXB2		;CR, TERMINATE, RTN + 2 
	CAIN	0,","
	JRST	$TSXB2		;COMMA, TERMINATE, RTN + 2
	CAIL	0,"0"
	CAILE	0,"Z"
	JRST	$TSXB3		;ERROR, RTN + 1 
	CAILE	0,"9"
	CAIL	0,"A"
	JRST	$TSXB4		;ALPHA-NUMERIC
	JRST	$TSXB3		;ERROR, RTN + 1 

$TSXB4:	TRC	0,40		;CONVERT TO SIX-BIT
	TRNE	1,77
	JRST	$TSXB3		;TOO MANY CHAR'S, RTN + 1
	IDPB	0,2		;PUT INTO WORD
	JRST	$TSXB1		;GET NEXT CHARACTER

$TSXB2:	AOS	(P)		;INCR USRPC FOR RTN + 2 (NORMAL)

$TSXB3:	MOVE	0,1		;SIXBIT WORD IN AC0
	MOVE	1,$TSX1		;RESTORE AC'S
	MOVE	2,$TSX2
	RTN			;EXIT + 1/+2
SUBTTL	*SUBRTN* PRINT SUBROUTINES

S
;*	$PNTSX		PRINT SIXBIT NORMAL
;*	$PTSXF		PRINT SIXBIT FORCED
;*	$PNTCW		PRINT DF10 CONTROL WORD
;*	$PNTI1		PRINT OCTAL NUMBER
;*	$CHRPN		PRINT CHARACTER
;*	$ASCPN		PRINT ASCII CHARACTER/LINE
;*	$DECPN		PRINT DECIMAL NUMBER
S

S
;*PRINT SUBROUTINE INITIALIZATION
;*INITIALIZES CONTROL WORDS, AND TTY IF IN USER MODE
S

$PNTIN:	SETZM	$INTDF#		;CLEAR DEVICE DEFAULT FLAG
	SETZM	$DVOFF#		;CLEAR DEVICE INITED FLAG
	SETZM	PDISF#		;CLEAR PRINT DISABLED FLAG
	SETZM	$PTINH#		;CLEAR PRINT 'TYPE-IN INHIBIT' FLAG
	SETZM	PNTINH#		;ALLOW EXEC PRINT TYPE IN INHIBIT
	SETZM	XOFFLAG#	;CLEAR XOFF FLAG
	SETZM	PNTFLG#		;CLEAR IN PRINT FLAG
	SETOM	PNTSPC#		;SET PRINT SPACE FLAG
	MOVNI	0,^D5000	;SET PRINT ENABLE TO 5000 LINES
	MOVEM	0,PNTENB
	SETZM	TTYFIL#		;ALLOW EXEC FILLERS
	SETZM	$CRLF#		;ALLOW FREE CR/LF
	SETZM	$TABF		;ALLOW TAB CONVERSION
	SETZM	$FFF		;ALLOW FORM FEED CONVERSION
	SETZM	$VTF		;ALLOW VERTICAL TAB CONVERSION

	SKIPN	MONTYP
	JRST	$PNTIX

	movei	1,.priou
	rfmod			;don't translate print output
	trz	2,tt%dam
	tro	2,3b29
	sfmod

$PNTIX:	MOVEI	REENTR		;SETUP REENTER ADDRESS
	MOVEM	JOBREN
	SKIPGE	MONCTL		;MONITOR CONTROL ?
	RTN			;YES, DON'T PRINT TITLE
	SKIPE	$ONETM		;FIRST TIME?
	RTN			;NO .....EXIT
	JRST	$PNTNM+2	;YES ...PRINT PROGRAM NAME
				;AND EXIT
S
;*PRINT SUBROUTINE ENTRY POINT
;*EXIT VIA $PNTI4 BELOW
S

$PNTIF:	SETOM	PNTFLG		;SET IN PRINT FLAG
	SETOM	$PNTTY#		;FORCE TO TTY
	SETZM	$PTINH
	SKIPE	MONTYP
	JRST	.+4
	TTCALL	13,0		;TOPS10 CLEAR CONTROL O
	JFCL
	JRST	$PNTIA
	PUT	1
	PUT	2
	MOVEI	1,.PRIOU
	RFMOD
	TLZ	2,(TT%OSP)	;CLEAR CONTROL O
	SFMOD
	GETIT	2
	GETIT	1
	SETZM	INUPTR		;CLEAR TTY INPUT BUFFER
	JRST	$PNTIA

$PNTIT:	SETOM	PNTFLG		;SET IN PRINT FLAG
	SETZM	$PNTTY		;NOT FORCED TO TTY
	SKIPL	PNTENB#		;PRINT LIMIT REACHED YET?
	JRST	$PNTIB		;YES ..DON'T PRINT
	MOVE	CONSW		;READ DATA SWITCHES INTO AC0
	TLNN	0,NOPNT		;NO PRINT SWITCH SET?
	JRST	$PNTIA
	GETIT	AC0		;YES ...RESTORE AC0 FROM STACK (P - 1)
	JRST	$PRNTX		;EXIT, DON'T PRINT
;*PRINT ROUTINE EXIT
S

$PNTI4:	SETZM	$PNTTY		;CLEAR FORCE TO TTY FLAG

	MOVE	1,$PACA1	;RESTORE AC'S
	MOVE	2,$PACA2
	MOVE	3,$PACA3
	MOVE	4,$PACA4
	MOVE	5,$PACA5
$PRNTX:	SETZM	PNTFLG		;CLEAR IN PRINT FLAG
	RTN			;RETURN 

;*PRINT LIMIT WARNING & ALTERNATE EXIT PATH
S

$PNTIB:	GETIT	AC0		;RESTORE THE STACK (P - 1)
	SKIPE	PDISF#		;FIRST TIME PRINT DISABLED?
	JRST	$PRNTX		;YES	...EXIT )

$PNTB1:	SETOM	PDISF		;NO ........SET IT
	MOVEM	1,$PACA1	;SAVE AC'S 1 - 5
	MOVEM	2,$PACA2
	MOVEM	3,$PACA3
	MOVEM	4,$PACA4
	MOVEM	5,$PACA5
	SETOM	$PNTTY		;SET FORCE TO TTY FLAG
	MOVEI	[ASCIZ/
******
EXCEEDED ALLOWED PRINTOUTS
/]
	JRST	$ASCPN-1	;PRINT THE WARNING & EXIT
S
;*PRINT ROUTINE SELECTOR
;*BASED ON "AC FIELD" = 12 - 17
S

$PNTIA:	MOVEM	1,$PACA1#	;SAVE AC1.
	MOVEM	2,$PACA2#	;SAVE AC2.
	MOVEM	3,$PACA3#	;SAVE AC3.
	MOVEM	4,$PACA4#	;SAVE AC4.
	MOVEM	5,$PACA5#	;SAVE AC5.
	GETIT	AC0		;RESTORE AC0 FROM STACK (P - 1)
	SETZM	$PNT#		;CLEAR PRINT HALF WORDS FLAG
	MOVE	2,LUUO
	ROT	2,15		;GET X (AC FIELD)
	ANDI	2,17		;OUT OF THE UUO

$PNTIC:	CAIN	2,17		;X=17?
	JRST	$PNTLN		;YES. PRINT ASCII LINE
	JUMPE	2,$ASCPN	;X=0? YES. GO PRINT 1 WORD ASCII
	CAIN	2,15		;X=15?
	JRST	$DECPN		;YES, PRINT DECIMALS )
	CAIN	2,16		;X=16?
	JRST	$DECSP		;YES, PRINT DECIMALS, LEADING SPACES 
	CAIN	2,13		;X=13?
	JRST	$PNTI3		;YES, PRINT OCTALS, 6 SP 6
	CAIN	2,12		;X=12?
	JRST	$CHRPN		;YES, PRINT CHARACTER )

	JRST	$PNTI1		;NONE OF THE ABOVE, PRINT OCTAL
				;(AC FIELD <12 OR = TO 14)
S
;*SIXBIT PRINT SUBROUTINE
;*PRINTS SIXBIT WORD IN AC0
S

;*NORMAL PRINTOUT
S

$PNTSX:	PUT	1		;SAVE AC1 ON STACK (P + 1)
	MOVE	1,0		;PUT SIXBIT WORD IN AC1
	MOVEI	0,0
	LSHC	0,6		;GET NEXT CHAR INTO AC0
	ADDI	0,40		;CONVERT TO ASCII
	PNTCHR			;PRINT IT
	JUMPN	1,.-4		;LOOP TILL ALL PRINTED
	GETIT	1		;RESTORE AC1 FROM THE STACK (P - 1)
	RTN			;EXIT

;*FORCED PRINTOUT
S

$PTSXF:	PUT	1		;SAVE AC1 ON THE STACK (P + 1)
	MOVE	1,0		;PUT SIXBIT WORD IN AC1
	MOVEI	0,0
	LSHC	0,6		;GET NEXT CHAR INTO AC0
	ADDI	0,40		;CONVERT TO ASCII
	PNTCHF			;PRINT
	JUMPN	1,.-4		;LOOP TILL ALL PRINTED
	GETIT	1		;FROM THE STACK (P - 1)
	RTN			;EXIT 
S
;*SIXBIT MESSAGE PRINT ROUTINE
;*PRINTS THE SIXBIT MESSAGE THOSE ADDRESS IS IN AC0
;*"BACKARROW" (77) SIGNIFIES END OF TEXT
;*"UPARROW" (76) SIGNIFIES CR/LF
;*"RIGHT SQUARE BRACKET" (75) SIGNIFIES TAB
S

$PSIXF:	PUT	5
	SETO	5,		;SET FORCED PRINTING FLAG
	JRST	.+3

$PSIX:	PUT	5
	SETZ	5,		;NORMAL PRINTING
	PUT	1
	PUT	2
	PUT	3
	PUT	4

	HRRZ	4,0		;MESSAGE ADDRESS TO AC4

$PSIX1:	MOVEI	3,6		;6 = NUM OF 6BIT CHAR PER WORD
	MOVE	1,(4)		;GET FIRST/NEXT WORD OF MESSAGE

$PSIX2:	SETZ	2,
	ROTC	1,6		;C(AC1) = CHAR TO BE PRINTED
	CAIN	2,77
	JRST	$PSIX5		;"BACKARROW", DONE
	CAIN	2,76
	JRST	$PSIX4		;"UPARROW", CR/LF
	CAIN	2,75
	MOVEI	2,151		;"BRACKET", CHANGE TO TAB (151+40=11)
	MOVEI	0,40(2)		;CHANGE TO ASCII
	JUMPN	5,[PNTCHF
		JRST	.+2]	;FORCED PRINT
	PNTCHR
$PSIX3:	SOJN	3,$PSIX2	;PRINTED ALL CHARS FROM THIS WORD ?
	AOJA	4,$PSIX1	;YES, DO NEXT WORD

$PSIX4:	JUMPN	5,[PCRLF
		JRST	.+2]
	PCRL			;PRINT CR/LF
	JRST	$PSIX3

$PSIX5:	GETIT	4
	GETIT	3
	GETIT	2
	GETIT	1
	GETIT	5
	RTN
S
;*OCTAL SUPPRESS LEADING ZEROS PRINT ROUTINE
;*PRINTS NUMBER IN AC0, SUPPRESSING LEADING ZEROS
;*PRINTS MINUS SIGN IF NUMBER IS NEGATIVE
S

$POCSF:	PUT	5
	SETO	5,		;FORCED PRINTOUT
	JRST	.+3

$POCS:	PUT	5
	SETZ	5,		;NORMAL PRINTOUT
	PUT	1
	PUT	2
	PUT	3
	PUT	4

	MOVE	2,0
	JUMPGE	2,$POCS1	;IS NUMBER NEGATIVE ?
	MOVEI	"-"
	JUMPN	5,[PNTCHF
		JRST	.+2]
	PNTCHR			;YES, PRINT MINUS SIGN
	MOVN	2,2		;MAKE NUMBER POSITIVE

$POCS1:	SETZ	4,
	SETZB	3,1
	JUMPE	2,$POCS3	;IF NUMBER 0, PRINT 1 ZERO

	MOVEI	3,^D12		;PRINT UP TO 12 DIGITS
$POCS2:	SETZ	1,
	LSHC	1,3
	JUMPE	1,$POCS5	;IS THIS DIGIT ZERO ?
	SETO	4,		;NO, SET NON-ZERO DIGIT FLAG
$POCS3:	MOVEI	"0"(1)		;MAKE ASCII NUMBER
	JUMPN	5,[PNTCHF
		JRST	.+2]
	PNTCHR			;PRINT DIGIT

$POCS4:	SOJG	3,$POCS2	;ALL DONE ?
	GETIT	4
	GETIT	3
	GETIT	2
	GETIT	1
	GETIT	5
	RTN

$POCS5:	JUMPE	4,$POCS4	;PRINTED NON-ZERO DIGIT ?
	JRST	$POCS3		;YES, PRINT ZEROS
S
;*OCTAL PRINTOUT ROUTINE
;*PRINTS NUMBER IN AC0
S

$PNTI1:	MOVE	3,2		;MOVE X INTO AC3.
	ROT	0,-3		;ROT OCTAL NUM 3 PLACES
	SOJN	3,.-1		;X AMOUNT OF TIMES.

$PNTI2:	MOVEI	1,6		;PUT 6 INTO AC1 SO THAT
	ROTC	0,3		;C(AC1) AFTER THE ROTC WILL BE 60
	JSP	3,$TOUT		;PLUS NUMBER TO BE PRINTED
	SOJN	2,$PNTI2	;SUB 1 FROM X...PRINT UNTIL X=0.
	MOVEM	1,$PNTSV#	;SAVE NUMBER
	SKIPN	PNTSPC
	JRST	.+3
	MOVEI	1,40		;AT THIS POINT WE HAVE PRINTED
	JSP	3,$TOUT		;X AMOUNT OF NUMBER(S) AND NOW A SPACE
	SKIPN	$PNT#		;PRINT 6 SP 6 FLAG SET?
	JRST	$PNTI4		;NO, EXIT )
	MOVE	1,$PNTSV	;RESTORE NUMBER
	MOVEI	2,6		;SETUP FOR 2ND HALF
	SETZM	$PNT		;CLEAR PRINT SPACE FLAG
	JRST	$PNTI2		;PRINT REST OF NUMBER

$PNTI3:	MOVEI	3,14		;SETUP FOR LH WORD
	MOVEI	2,6		;SETUP FOR FIRST HALF
	SETOM	$PNT		;SET PRINT 6 SP 6 FLAG
	SETOM	PNTSPC		;SET THE PRINT SPACE FLAG
	JRST	$PNTI1+1	;PRINT FIRST HALF NUMBER
	JRST	$PNTI4		;EXIT

S
;*ASCII/CHARACTER PRINTOUT ROUTINE
;*PRINTS CHAR IN LOWER 7 BITS OF AC0
S

$CHRPN:	ANDI	0,177		;STRIP CHAR TO 7 BITS
	MOVE	1,0
	JSP	3,$TOUT		;PRINT A CHARACTER
	JRST	$PNTI4		;LEAVE 

S
;*PRINTS ASCII WHOSE ADDRESS IS IN AC0
S

$PNTLN:	SETOM	$PNT#		;SET PRINT MORE THAN 1 WORD FLAG.

$ASCPN:	MOVEM	0,$POINT#	;SAVE ADDRESS OF ASCII MESSAGE.
$ASCP1:	MOVEI	2,5		;5 = NUM OF ASCII CHAR. IN A WORD.
	MOVE	0,@$POINT	;C(AC0) = FIRST/NEXT WORD OF ASCII MESS

$ASCP2:	SETZ	1,		;CLEAR AC1.
	ROTC	0,7		;C(AC1) = CHAR TO BE PRINTED.
	JUMPE	1,$PNTI4	;CHAR = NULL?..NO MORE CHAR..EXIT
	JSP	3,$TOUT		;PRINT A CHAR
	SOJN	2,$ASCP2	;PNT ALL CHAR FROM THIS WORD?
	AOS	$POINT		;YES. INC TO GET NEXT WORD.
	SKIPN	$PNT		;PNT MORE THAN ONE WORD FLAG SET?
	JRST	$PNTI4		;NO..LEAVE
	JRST	$ASCP1		;YES...RETURN TO PNT NEXT WORD.
S
;*DECIMAL PRINTOUT ROUTINE
;*PRINTS NUMBER IN AC0
S

$DECSP:	SETOM	$PNT		;SET LEADING SPACES PRINT CONTROL

$DECPN:	JUMPGE	0,.+4		;IS NUMBER NEGATIVE ?
	MOVEI	1,"-"		;YES, PRINT MINUS SIGN
	JSP	3,$TOUT
	MOVN	0,0		;MAKE NUMBER POSITIVE
	GO	$RADIX		;DECIMAL-ASCII CONVERSION & PRINT CHARS
	JRST	$PNTI4		;EXIT

$RADIX:	MOVE	2,RADLSC	;SETUP DIGIT COUNTER
	LSHC	0,-^D35		;SHIFT RIGHT 35 BITS INTO AC1
	LSH	1,-1		;VACATE AC1 SIGN BIT

$DCCMP:	DIV	0,RADIX		;DIVIDE DOUBLE LENGTH INTERGER BY 10
	HRLM	1,(17)		;SAVE DIGIT
	SOS	2		;COUNT DIGIT
	JUMPE	0,$LDSPS	;ALL DIGITS FORMED?
	GO	$RADIX+1	;NO, COMPUTE NEXT ONE

$DECP1:	HLRZ	1,(17)		;YES, RETRIEVE DIGIT
	ADDI	1,60		;CONVERT TO ASCII
	JSP	3,$TOUT		;TYPE-OUT A DIGIT
	RTN			;GET NEXT/EXIT

$LDSPS:	SKIPN	$PNT		;LEADING SPACES PRINT SET?
	JRST	$DECP1		;NO ...GO PRINT
				;YES ...DO IT
$DCSPS:	SOJL	2,$DECP1	;SPACES COMPLETE ?  YES
	MOVE	1,RADLSP	;NO, PRINT LEADING SPACE
	JSP	3,$TOUT		;TYPE OUT THE SPACE
	JRST	.-3		;CHECK FOR NEXT
SUBTTL	*SUBRTN*  CHARACTER OUTPUT ROUTINES

S
;*OUTPUT TERMINATION CONTROL ROUTINE
S

$TOUT:	MOVEM	0,$PACB0#	;SAVE AC0.
	MOVEM	1,$PNTYC#	;SAVE CHARACTER TO BE PRINTED

S
;*OVERALL CHARACTER OUTPUT CONTROL ROUTINE
S

$TOUTB:	MOVE	AC0,CONSW	;DATA SWITCHES INTO AC0
	AOS	$CARCT#		;INC CHAR CNTR.
	CAIN	1,7		;CHAR A BELL ?
	SETZM	$PTINH		;YES, CLEAR PRINT INHIBIT
	CAIE	1,15		;CHAR A CR?
	JRST	$TOUB1		;NO-CHK FOR LF
	SKIPN	$PTINH		;DON'T COUNT ^O'ED LINES
	AOS	PNTENB		;COUNT LINES, TILL NO MORE
	SETZM	$CARCT		;CLR CHAR CNTR.

$TOUB1:	CAIN	1,12		;IS CHAR A LF?
	SETZM	$CARCT		;YES-CLR CHAR CNTR.
	SKIPE	$PNTTY		;NO-IS PRINT FORCED ON?
	JRST	$TOUB2		;YES-DON'T CHECK NON-PNT SW
	TLNE	0,NOPNT		;IS NON PNT SWITCH ON?
	JRST	(3)		;YES, RETURN

$TOUB2:	JSP	4,$TOUT2	;SEND CHARACTER USER MODE 

$TOUB3:	SKIPE	USRLFF#		;NEED USER LF FILLERS ?
	JRST	$USRFL		;YES
	SKIPE	USRCRF#		;NEED USER CR FILLERS ?
	JRST	$USRFC		;YES
	JRST	$TOUTA		;NO-BACK TO PRINT ROUTINE
;*USER MODE LF & CR FILLERS
S

$USRFC:	CAIE	1,15		;CR ?
	JRST	$TOUTA		;NO-RETURN TO PRINT ROUTINE 
	MOVE	5,USRCRF	;SEND FILLERS FOR CR
	JRST	$USRF1		;DEPENDING ON 'USRCRF'

$USRFL:	CAIE	1,12		;LF ?
	JRST	$TOUTA		;NO-RETURN TO PRINT 
	MOVE	5,USRLFF	;SEND FILLERS FOR LF
$USRF1:	SOJL	5,$TOUTA	;DEPENDING ON 'USRLFF'
	MOVEI	1,001		;^A
	JSP	4,$TOUT2	;SEND CHARACTER 
	JRST	$USRF1

;*RETURN BACK TO PRINTING ROUTINE FROM CHAR OUTPUT
S
$TOUTA:	MOVE	AC0,$PACB0	;RESTORE AC0
	JRST	(3)		;RETURN TO PRINT ROUTINE
S
;*USER MODE CHARACTER OUTPUT
S

$TOUT2:	MOVEM	4,$PACC4#
	CAIN	1,26		;DON'T PRINT NULLS
	JRST	@$PACC4
	MOVE	0,CONSW
	TLNE	0,PNTLPT	;IS LPT PRINT SWITCH UP ?
	JRST	$TOUT3		;YES, GO PRINT ON LOGICAL DEVICE
	DROPDV			;CLOSE DEV IF SWITCH CHANGED
$TOUT6:	MOVE	0,$CARCT	;CHARACTER NUMBER
	CAIN	0,1		;FIRST CHAR IN LINE ?
	JRST	$TOUT4		;YES
$TOUT5:	SKIPE	NOTYPE		;TYPEOUT INHIBITED ?
	JRST	@$PACC4		;YES
	SKIPN	MONTYP
	OUTCHR	1
	SKIPE	MONTYP
	PBOUT			;OUTPUT VIA MONITOR TTCALL
	JRST	@$PACC4		;GO RESTORE AC0 AND RETURN

$TOUT4:	SKIPL	MONCTL		;SYSTEM EXERCISER
	JRST	$TOUT5		;NO
	PUT	1
	MOVEI	1,"?"		;PRECEDE LINE WITH ?
	SKIPN	MONTYP
	OUTCHR	1
	SKIPE	MONTYP
	PBOUT
	GETIT	1
	JRST	$TOUT5

;*USER MODE LOGICAL DEVICE OUTPUT
S

$TOUT3:	SKIPN	$DVOFF		;DEVICE BEEN INITED YET ?
	GO	$INTDV		;NO, GO DO IT
	GO	$PUTCR		;GO OUTPUT CHAR
	SKIPN	$PNTTY		;SKIP IF MESSAGE ALSO FORCED TO TTY
	JRST	@$PACC4
	JRST	$TOUT6		;OUTPUT 
;* LOGICAL DEVICE OUTPUT ROUTINES
S

$PUTCR:	SKIPN	MONTYP
	JRST	$PUT10
	PUT	1
	PUT	2
	MOVE	2,1
	MOVE	1,DEVJFN
	BOUT
	ERJMP	$PUTER
	GETIT	2
	GETIT	1
	RTN

$PUTER:	TMSG	<
LOG OUTPUT ERROR - LOGGING STOPPED
>
	SETZM	LOGFLG
	SETZM	CONSW
	GO	$DRPDV
	GETIT	2
	GETIT	1
	RTN
S
;*LOGICAL DEVICE INITIALIZATION
;*PHY DEV ASSIGNED AT RUN TIME
S

$INTDV:	MOVE	0,PNTEXT
	MOVEM	0,$OUTEX
	MOVE	0,PNTNAM	;SETUP LOGICAL OUTPUT FILE NAME
	MOVEM	0,$OUTNM
	MOVEM	1,$PACF1#
	MOVEM	2,$PACF2#
	SETZM	$INTD3#
	SKIPN	MONTYP
	JRST	$INT10		;TOPS10
	MOVE	[POINT 7,FILASC,27]
	MOVE	1,[ASCII/DEV:/]
	MOVEM	1,FILASC
$INT21:	MOVEI	1,$OUTNM
	GO	SIXASC		;CONVERT SIXBIT TO ASCII
	HRLZI	1,(GJ%SHT)	;IF FILE EXISTS, APPEND TO IT
	HRROI	2,FILASC
	GTJFN
	 ERJMP	$INT22		;DEVICE NOT AVAILABLE, DEFAULT TO DSK
	MOVEM	1,DEVJFN#
	MOVE	2,[7B5!OF%APP]
	OPENF
	 JRST	T20ERR
$INT12:	SETOM	$DVOFF
	MOVE	2,$PACF2
	MOVE	1,$PACF1
	RTN

$INT22:	SKIPE	$INTD3
	 JRST	T20ERR
	HRROI	1,[ASCIZ/
****
USING 'DSK' PRINT FILE
****
/]
	PSOUT
	MOVE	[POINT 7,FILASC,27]
	MOVE	1,[ASCII/DSK:/]
	MOVEM	1,FILASC
	SETOM	$INTD3
	JRST	$INT21
;*USER MODE CLOSE FILE
S

$DRPDV:	SKIPN	$DVOFF		;DEVICE INITED?
	RTN			;NO, DON'T BOTHER 
	SKIPN	MONTYP
	JRST	$DRP10		;TOPS10
	PUT	1
	MOVE	1,DEVJFN
	CLOSF
	 JRST	T20ERR
	GETIT	1
	SETZM	$DVOFF
	RTN			;EXIT 

T20ERR:	MOVEI	1,.PRIOU
	HRLOI	2,.FHSLF
	SETZ	3,
	ERSTR
	 HALTF
	 HALTF
	HALTF

SIXASC:	PUT	2
	PUT	3
	PUT	4
	MOVE	3,0
	MOVE	4,1
	MOVE	1,(4)
	GO	SIXSTR
	MOVEI	"."
	IDPB	0,3
	HLLZ	1,1(4)
	SKIPE	1
	GO	SIXSTR
	IDPB	1,3
	GETIT	4
	GETIT	3
	GETIT	2
	RTN

SIXSTR:	SETZB	0,2
	LSHC	0,6
	ADDI	0,40
	IDPB	0,3
	JUMPN	1,.-4
	RTN
;*TOPS10, LOGICAL DEVICE OUTPUT

$PUT10:	SKIPE	$DVTTY#		;IF DEVICE IS TTY
	JRST	.+5		;EMPTY BUFFER AFTER EACH CHAR
	SOSG	$OBUF+2		;INCREMENT BYTE COUNT
	JRST	.+3
	IDPB	1,$OBUF+1	;STORE CHAR
	RTN
	OUT	$DEVCH,		;EMPTY BUFFER
	JRST	.-3

;*$INT10, TOPS10 INITIALIZE LOGICAL OUTPUT

$INT10:	MOVEM	0,$OUTNM
	INIT	$DEVCH,0	;ASCII MODE, DEV CHANNEL
	SIXBIT	/DEV/		;LOGICAL DEVICE, LPT,DSK,DTAX
	XWD	$OBUF,		;OUTPUT ONLY
	JRST	$INT13		;DEV NOT AVAIL, DEFAULT TO DISK
$INT11:	OUTBUF	$DEVCH,1	;SETUP OUTPUT BUFFER
	ENTER	$DEVCH,$OUTNM	;INIT OUTPUT FILE
	JRST	$OERR2		;NO DIR ROOM, ERROR
	SETOM	$DVOFF		;SET DEVICE INITED FLAG
	MOVEI	0,$DEVCH
	DEVCHR			;GET DEVICE CHARACTERISTICS
	TLNE	0,10
	SETOM	$DVTTY		;DEVICE IS TTY
	JRST	$INT12		;EXIT
$INT13:	SKIPN	$INTDF		;FIRST DEFAULT INIT ?
	OUTSTR	[ASCIZ/
****
USING 'DSK' PRINT FILE
****
/]
	SETOM	$INTDF
	INIT	$DEVCH,0
	SIXBIT	/DSK/
	XWD	$OBUF,
	JRST	$OERR1
	JRST	$INT11

;*USER MODE CLOSE FILE

$DRP10:	CLOSE	$DEVCH,		;CLOSE FILE
	STATZ	$DEVCH,740000	;RECHECK FINAL ERROR BITS
	OUTSTR	[ASCIZ/
%PRINT CLOSE ERROR
/]
	RELEAS	$DEVCH,		;RELINQUISH DEVICE, WRITE DIRECTORY
	SETZM	$DVOFF
	RTN			;EXIT 

$OUTER:	OUTSTR	[ASCIZ/
%PRINT OUTPUT ERROR
/]
	SKIPE	$$OUTER
	XCT	$$OUTER		;EXECUTE USERS ERROR RTN, IF PROV.
	EXIT	1,		;ERROR, QUIT
	JRST	START		;RESTART USER SEGMENT 

$OERR1:	OUTSTR	[ASCIZ/
DSK INIT ERROR/]
	JRST	$OUTER		;DISK PRINT OUTPUT ERROR

$OERR2:	OUTSTR	[ASCIZ/
NO DIR ROOM/]
	JRST	$OUTER		;DISK PRINT OUTPUT ERROR
SUBTTL	*STOR* RESERVED STORAGE

;PROGRAM LITERALS
	LIT
ENDSLD:	0

;END OF PROGRAM VARIABLES

FILASC:	BLOCK	3

D$ISTR:	BLOCK	^D30		;INPUT STORAGE

PATCH:	BLOCK	100		;DEBUGGING AREA

;PROGRAM VARIABLE WORDS

	VAR

END:	0
SUBTTL	STORAGE -- ZEROED ON STARTUP
FIRZER:!

LEV1PC:	BLOCK	1		;RETURN PC FOR PSI'S
LEV2PC:	BLOCK	1		; ..
LEV3PC:	BLOCK	1		; ..
LF1PC:	BLOCK	1		;RETURN PC FOR PSI'S
LF2PC:	BLOCK	1		; ..
LF3PC:	BLOCK	1		; ..
EXMADR:	BLOCK	1		;ADDRESS OF LAST EXAMINE COMMAND
BITPTR:	BLOCK	1		;BYTE POINTER TO INPUT BIT
BITBYT:	BLOCK	1		;INPUT BYTE
CMDMSG:	BLOCK	1		;POINTER TO ERROR MESSAGE
CZADR:	BLOCK	1		;WHERE TO GO ON CONTROL-Z
CZSP:	BLOCK	1		;CONTROL-Z STACK POINTER
CTADR:	BLOCK	1		;WHERE TO GO ON CONTROL-T
CMFILE:	BLOCK	1		;COMMAND JFN
UCFILE:	BLOCK	1		;INPUT JFN
DEPFLG:	BLOCK	1		;0=EXAMINE, -1=DEPOSIT
LASTCA:	BLOCK	1		;LAST CRAM ADDRESS
INTAKE:	BLOCK	1		;-1 DON'T TYPE DATA BECAUSE OF TAKE CMD
ULDSTR:	BLOCK	4		;".ULD" LINE STORAGE
IBF:	BLOCK	2		;INPUT FILE POINTERS
DSKBF:	BLOCK	3
GSBF:	BLOCK	3
DSKLIN:	BLOCK	^D30
DSKNAM:	BLOCK	1
DSKEXT:	BLOCK	3
$CCLF:	BLOCK	1
$CMNTF:	BLOCK	1
$LISTF:	BLOCK	1
CFCALL:	BLOCK	1
CFJ:	BLOCK	1
CFNBR:	BLOCK	1
CFALU:	BLOCK	1
CFSD:	BLOCK	1
CFAB:	BLOCK	1
CFRBM:	BLOCK	1
CFSPEC:	BLOCK	1
CFDISP:	BLOCK	1
CFSKIP:	BLOCK	1
CFT:	BLOCK	1
CFC:	BLOCK	1
CFSC:	BLOCK	1
CFFE:	BLOCK	1
CFFM:	BLOCK	1
CFMC:	BLOCK	1
CFDV:	BLOCK	1
CFMP:	BLOCK	1
CFCL:	BLOCK	1
CFCR:	BLOCK	1
CFMARK:	BLOCK	1
STBUF:	BLOCK	40		;STRING BUFFER
LFPDL:	BLOCK	100
ENDZER==.-1

	RELOC	<<.+1140>&777000>-140
IPAG:	BLOCK	^D512

	END	<3,,EV>