/COS 300 MONITOR			EDITED 11/2/73
/COPYRIGHT 1971, 1972, 1973
/DIGITAL EQUIPMENT CORPORATION
/MAYNARD, MASS.  01754
/
/LIBRARY NUMBERS:
/LINCTAPE:	DEC-12-OCOSA-B-UA
/TC08:		DEC-08-OCOSA-B-UC
/TD8E:		DEC-8E-OCOSA-B-UC
/RK05:		DEC-8E-OCOSA-B-HB
/
/
/SGW WITH GRATEFUL ASSISTANCE FROM RL
/
/THIS SOFTWARE IS FURNISHED TO PURCHASER UNDER A LICENSE FOR USE
/ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED (WITH INCLUSION
/OF DEC'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH SYSTEM, EXCEPT
/AS MAY OTHERWISE BE PROVIDED IN WRITING BY DEC.
/
/THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT
/NOTICE AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL
/EQUIPMENT CORPORATION.
/
/DEC ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY
/OF ITS SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DEC.
/
	DECIMAL
	YEARX=	3
	MONTH=	7
	DAYX=	25
	OCTAL
	SYSDAT=	MONTH^40+DAYX^10+YEARX-2	/DATE TO APPEAR IN SYSTEM TAPE LABELS
/
/THE 2 ERROR REPORTING OPTIONS, RK8E&TD8E OR RK8E
/SHOULD BE ASSEMBLED ONLY FOR THE OCTAL LISTING
/TO PATCH THE MONITOR 
/DO NOT SET BOTH EPOT2 AND EPOT.
IFNDEF EPOT2 <EPOT2=0>	/SET TO 1 TO ASSEMBLE RK8E AND TD8E
			/REGISTER EXAMINE RESIDES IN CARD READER HANDLER
IFNDEF EPOT <EPOT=0>	/SET TO 1 TO ASSEMBLE RK8E DISK ERROR PRINTOUT
			/RESIDES IN DECTAPE HANDLER
IFNDEF TAPE <TAPE=0>		/TC01=0, TD8E=1, LINCTAPE=2
IFNDEF RKDISK <RKDISK=1>	/RK8=0, RK8E=1
IFNDEF SYSNUM <SYSNUM=0>	/SET TO 0 FOR DECTAPE SYSTEM DEVICE, 1=RK8
IFNDEF LP645	<LP645=0>	/LP08 = 0, ANELEX = 1

/ONLY PRINT LOCATIONS TO BE PATCHED IF ASSEMBLING
/THE TD8E AND RK8E ERROR REPORTING PATCHES
IFNZRO EPOT+EPOT2 <XLIST>
	BASFLD=	0	/THE FIELD OFFSET FOR THIS WHOLE MESS
	FIELD BASFLD%10
	MQL=	7421
	LSF=	6661
	LCF=	6662
	LSE=	6663
	LIE=	6665
	LLS=	6666
	LIF=	6667
	RCSF=	6631
	RCRA=	6632
	RCSD=	6671
	RCSE=	6672
	RCRD=	6674
/TD8E IOT'S
	SDSS=	6771
	SDST=	6772
	SDSQ=	6773
	SDLC=	6774
	SDLD=	6775
	SDRC=	6776
	SDRD=	6777
	MAGTAP=	0
	/TC08-P IOT'S
	DTRA=	6761
	DTCA=	6762
	DTXA=	6764
	DTLA=	6766
	DTSF=	6771
	DTRB=	6772
	DTXB=	6774
	/RK8E MAINTENANCE IOT
	DMAN=	6747

	*0
	RECOVR		/SEE NOTE AT DEFINITION OF SYSINT
	JMP I	.+1
P7400,	INTRPT
	IFNZRO INTRPT-7400 <???>/ERROR
*10
GETPNT,	CTCFIX		/THIS IS A TEMPORARY POINTER, PRESENT ATLOAD TIME ONLY
PUTPNT,	IODIE		/SO IS THIS
	*20
P77,	77
	IFNZRO P77-20 <???>/ERROR - P77 MUST BE AT LOCATION 20
CTCFG,	1
BSWPTR,	BSWX			/USED IF NON-8/E
KMOVE,	MOVE			/ROUTINE TO MOVE CORE LOCATIONS AROUND
KGETC,	MGETC			/ROUTINE TO GET A CHAR FROM EDP-8 RECORD
KPUTC,	PUTC			/ROUTINE TO PUT A CHAR...
KRDOIO,	RDOIO			/ROUTINE TO R/W ENTIRE EDP-8 RECORDS TO/FROM DTA, ETC
KCDOIO,	CDOIO
	DEVTBL=.	/HANDLER ADDRESS TABLE MUST START ON 10-WORD BOUNDARY
	IFNZRO DEVTBL&7 <???>/ERROR
/N.B. DO NOT CHANGE THE ORDER OF THESE AROUND!
TTYIN,	TTICHR		/KBD IN
TTYOUT,	TTOCHR		/TTYOUT
CDIN,	CDICHR		/CDR
PPOUT,	PPOCHR		/PTP
PRIN,	PRICHR		/PTR
LPOUT,	LPOCHR		/LPT
XIN,	NULLIO		/NULL INPUT DEVICE
YOUT,	NULLIO		/NULL OUTPUT DEVICE
P7,	7
	IFNZRO P7-40 <???>/ERROR - P7 MUST BE AT LOC'N 40 (SEE TAG "ANDP40")
KGPBUF,	GPBUF
IFN,	PICHR		/TEMP STORAGE OF INTERNAL FILE #
KPTRST,	PTRSET		/SET UP W0-W5, U0-U2 FOR GIVEN IFN
	DECIMAL
LENGTH,	-60		/MAX. LENGTH OF A LINE FROM KBD, CDR, OR PTR
	OCTAL
M1,	-1
	/W0-W5 AND U0-U2 ARE POINTERS SET UP BY THE ROUTINE "PTRSET".
	/THEY POINT TO THE ENTRIES IN THE TEMPORARY AND PERMANENT
	/FILE TABLES, RESPECTIVELY, FOR A GIVEN INTERNAL FILE # 0-7.
W0,	0	/BIT 0 = R/W, WRITE = 1
		/BITS 1-4 = NUMBER OF BLOCKS TO READ AT A TIME (0 => 20)
		/BIT 5 IS FREE
		/BITS 6-8 ARE THE FIELD OF THE BLOCK BUFFER.
		/BITS 9-11 GET SET BY THE ROUTINE "PTRSET" TO BE THE
		/PHYSICAL UNIT NUMBER OF THE DEVICE (E.G., DECTAPE #3).
W1,	0	/BITS 0-4 ARE THE BLOCK BUFFER ADDRESS, MOD 200
		/BITS 5-6 ARE FREE
		/BITS 7-11 ARE THE LOGICAL UNIT # FOR THIS OPEN FILE.
W2,	0	/THIS WORD IS THE INTERNAL BUFFER POINTER
W3,	0	/THIS IS THE NUMBER OF WORDS LEFT IN THE BUFFER
W4,	0	/THIS IS THE HI-ORDER RELATIVE BLOCK BITS
W5,	0	/BITS 0-3 ARE THE LOW-ORDER RELATIVE BLOCK BITS
		/BIT 4 IS FREE
		/BIT 5 IS FREE
		/BITS 6-11 IS THE TAPE SEQUENCE #
/ROUTINE "PTRSET" NEEDS U TABLE TO FOLLOW W TABLE
U0,	BADINT-1	/ADDRESS & UNIT OF PHYSICAL DEV. HANDLER
U1,	LPDNFG	/STARTING 4K SEGMENT
U2,	TICHR	/(-) LENGTH IN 4K SEGMENTS
GET,	SBT		/TEMPORARIES, PRESENT AT PROGRAM LOAD TIME ONLY!!!
PUT,	MOUNT		/THEY WILL GO AWAY AFTER ANY CALL TO THE MONITOR
TEMP,	SRTFLG		/SYSTEM PROGRAMS MUST USE THEM IMMEDIATELY
COUNT,	TF0		/IN THEIR INITIALIZATION CODE, IF THEY NEED THEM
NMBR,	IZERO
		/SOME CONSTANTS APPROPRIATE UNTO THE DAY
P17,	17
P70,	70
M4,	-4
HANDLR,	0		/"PTRSET" SETS THIS UP TO POINT TO THE CORRECT
			/LOW-LEVEL HANDLER.
P7600,	7600
PCDF,	CDF 0
KINIT,	INIT
KCTRLO,	CTRLO
KOTOPD,	OTOPD
KCLOSE,	CLOSE
KSPLIT,	SPLIT
SYSHND,	SYSDEV		/THE SYSTEM HANDLER

	DECIMAL
	TTYSIZ=-72-1
	OCTAL
	OVR1=14		/BLOCK NUMBER, FIRST OVERLAY
	COMPWA=100	/BLOCK NUMBER, COMPILER SCRATCH AREA
	RESMON=10	/BLOCK #, RESIDENT MONITOR
	RSYSBL=34	/BLOCK #, RSYS
	EDITBL=20	/BLOCK #, EDITOR/COMMAND DECODER (THIS THING)
	EDITWA=40	/BLOCK NUMBER, EDITOR SCRATCH AREA
	OVRADR=4000	/PLACE TO READ OVERLAYS INTO
	AC0001=	CLA IAC
	AC0002=	CLA CLL CML RTL
	AC2000=	CLA CLL CML RTR
	AC4000=	CLA CLL CML RAR
	AC7775=	CLA CLL CMA RTL
	AC7776=	CLA CLL CMA RAL
	AC7777=	CLA CMA
	PDATE=M1		/SYSTEM DATE IS AT 7777
	BSW=	7002

		*100
NCHARS,	0		/# OF CHARS IN INPUT LINE
LINENO,	0		/THE LINE # OF THE INPUT LINE
WCPTR,	0		/POINTER TO THE WORD COUNT WORD OF A LINE JUST FOUND IN FIELD 1
NAM1,	0		/"NAME" PLACED HERE BY "GETNAM", ETC.
NAM2,	0
NAM3,	0
NAM4,	0
FILORG,	0
FILSZ,	0		/LENGTH, IN BLOCKS, OF FILE LOOKED UP
CHANGF,	0		/GETS SET TO 1 IF ANY EDITING DONE ON SCRATCH FILE
PRTNE,	TTOCHR		/POINTER TO OUTPUT RTNE
TABSET,	-10		/- TAB SETTING
TABCNT,	0
SIZE,	0
MOVSIZ,	0
CHAR,	0
NCPL,	0		/# OF CHARS PER LINE, FOR I/O "WRAP-AROUND" ON PRINTING
WRTPTR,	0
RDPTR,	0
INPNUM,	144
INPINC,	12		/PARAMETERS FOR INPUT
INSWIT,	0		/+1 IF IN "LN" MODE
DBLOCK,	0		/FLAG TO TELL WHAT IS CURRENTLY IN THE DIRECTORY BLOCK BUFFER
DAVICE,	0		/POINTER TO CURENT DEVICE HANDLER
UNIT,	0		/THE CURRENT UNIT OF INTEREST
LSTLIN,	0		/SOME OPTOMIZATION STUFF FOR INPUT MODE
LSTXR,	0
LNPRPG,	0		/LINES PER PAGE
PDCNT,	DIRECT		/POINTERS TO DIRECTORY GOODIES
PDORG,	DIRECT+1
PDLINK,	DIRECT+2
PDWSTE,	DIRECT+4
EPTR,	0
ETMP,	0
/
	PAGE

INPUT1,	JMP I	INPUT2		/START UP HERE TO WRITE OUT SYSTEM
	TAD	INSWIT		/IN SEQUENCE MODE?
	SNA	CLA
	JMP I	INPUT1		/NO
	TAD	INPNUM		/GET CURRENT LINE #
	JMS I	(DECNUM		/& PRINT IT
	DCA I	16		/SUPPLY CHAR TO BE IGNORED
	JMS I	(BUMPNC		/BUMP COUNT
	JMP I	INPUT1
INPUT2,	SYSWRI
	TAD	INSWIT		/IN SEQ MODE?
	SNA	CLA
	JMP I	INPUT2		/NO, RETURN IMMEDIATE
	TAD	INPNUM		/YES RETURN LINE NUMBER
	DCA	LINENO
	CLL
	TAD	INPNUM		/INCREMENT NUMBER
	TAD	INPINC
	SZL
	JMP	LNTB		/LINE # TOO BIG
	DCA	INPNUM
IN2EX,	ISZ	INPUT2		/INCREMENT RETURN
	JMP I	INPUT2
INPUT,	AC0001			/COME HERE FOR "LN X,Y/D"
	DCA	INSWIT
	JMS I	[SCANER
	TAD I	[STRTLN
	SZA			/IF NO RESPONSE, KEEP OLD
	DCA	INPNUM
	TAD I	[FINLIN
	SMA SZA
	DCA	INPINC
KCLA,	CLA
	TAD I	[SWITCH
	SNA
	JMP I	[NXTLIN
	TAD	(-2400
	SNA
	JMP	TTY
	TAD	(2400-0300
	SNA
	JMP	CARDS
	TAD	(0300-2200
	SZA CLA
	JMP I	[NXTLIN
HSR,	AC0002			/SET UP POINTER TO PTR ROUTINE...
CARDS,	TAD	(2		/OR CARD READER...
TTY,	TAD	(JMS I	TTYIN	/OR JUST TTY
	DCA I	(CHRLUP
	ISZ I	KCTRLO		/TURN ON ^O
	JMP I	[NXTLIN

LNTB,	JMS I	[ERRMSG
	LNO-1			/--------------------"LINE # TOO BIG"
	JMP	IN2EX
K240A,	240
BADCOM,	-10			/"ERROR IN COMMAND"
	4663
	6360
	6301
	5257
	0144
	6056
	5642
	5745
DO,	JMS I	[SAVWA
	TAD	(OVR1+2
	JMS I	KSPLIT
	JMS I	SYSHND
	0200
	4400
	0
	JMP I	.+1
	DOVERL&177+4600		/CALL IN "DO" OVERLAY
REPL,	-4			/"REPLACE?"
	6346
	6155
	4244
	4640

/SOMETHING PECULIAR HAPPENS IN THIS ROUTINE.  NORMALLY, RDOIO
/IS INITIALLY SET UP BY "INIT" OR WHATEVER TO INITALLY SEE AN EMPTY
/BUFFER SO THAT WHEN RDOIO IS FIRST CALLED IT GOES AND GETS THE NEXT
/(WHICH HAPPENS TO BE THE FIRST) BLOCK OF THE DATA FILE.  HOWEVER,
/SINCE WE READ THE BLOCK IN FOR RDOIO, THE "DO"
/OVERLAY SETS UP THE FILE TABLE TO SHOW RDOIO IT HAS A FULL BUFFER, AND
/ALL THE POINTERS ARE FOR THE  N E X T  BLOCK TO READ IN.  SO THAT'S
/WHY ALL THE DIDDLING WITH W4 AND W5 HERE...IT SUBTRACTS 1 FROM THE
/BLOCK NUMBER IN THE TEMPORARY FILE TABLE FOR FILE 0, TO GIVE THE BLOCK
/NUMBER ACTUALLY BEING USED, BECAUSE THE FILE TABLE IS ALWAYS ONE
/BUFFER AHEAD.
REREAD,	0			/REGET THE CORRECT BLOCK FOR "DO" FILE
	JMS I	KPTRST		/AFTER IT GOES AWAY (I.E., AFTER IT GETS
	AC7777 CLL		/OVERLAID BY A DIRECTORY OR SOMETHING)
	TAD I	W4
	DCA	DOHI
	TAD I	W5
	AND	P7400
	TAD	P7400
	SNL
	ISZ	DOHI
	JMS I	SYSHND
	0200
	DIRECT
DOHI,	0
	AC7777
	DCA	DBLOCK		/7777 MEANS "DO" BLOCK IS IN AND ALIVE
	JMP I	REREAD
GETC,	0
	TAD I	14		/GET CHAR
	ISZ	NCHARS		/INCR COUNT
	SKP
	SKP CLA			/LOOKS BAD DOESN'T IT?
	ISZ	GETC
	JMP I	GETC
/
	PAGE

GETLIN,	0
	TAD	(NONUMB&377+5000	/JMP NONUMB IN DISGUISE
	DCA I	(SPACOK		/MAKE SPACE LEGAL TERMINATOR FOR NUMBER
	TAD I	[TF0		/CHECK FOR "DO" MODE
	SZA CLA
	JMP I	(TAPLIN		/GET COMMAND FROM FILE
	TAD	(256		/PRINT "."
	JMS I	TTYOUT
	AC0001			/COUNT "DOT" IN TAB CALCULATIONS
TAPRET,	TAD	[-15		/"TAPLIN" RETURNS HERE
	DCA	TABCNT		/SET TAB COUNTER
	TAD	[LINE-1
	DCA	16
	AC0001			/BUMP ONE FOR DOT WE'VE ALREADY PRINTED
	TAD	(TTYSIZ		/-72 IN DISGUISE
	DCA	NCPL
	DCA	NCHARS		/CHAR COUNTER
	JMS I	(INPUT1		/IN INPUT MODE?
CHRLUP,	JMS I	TTYIN		/GET CHAR FROM TTY (THIS LOC'N CHANGES)
TGETCR,	DCA	CHAR
	TAD I	KCTRLO
	RAR
	SNL CLA			/SKIP IF ^O ON
	TAD	(RUBOUT-CHRLUP
	TAD	(JMP	CHRLUP
	DCA	QUEEP
	TAD	CHAR
	TAD	(-215
	SNA			/TEST FOR CAR. RET.
	JMP	ENDLIN
	TAD	(215-377
	SNA			/TEST FOR RUBOUT
QUEEP,	JMP	RUBOUT		/IF ^O ON, THIS IS "JMP CHRLUP"
	TAD	(377-226	/TEST FOR CONTROL V
	SNA
	JMP I	(CTRLV		/GO PRINT MONITOR VERSION #
	IAC
	SNA			/NOW TEST FOR CTRL/U
	JMP	CNTRLU		/START OVER
	TAD	(225-203
	SNA
	JMP	CNTRLU		/TREAT ^C LIKE ^U
	TAD	(203-211	/TEST FOR TAB
	SNA
	JMP	TAB		/DO TAB
	TAD	(211-232	/TEST FOR CONTROL Z
	SNA
	JMP I	(FORM		/LEAVE INPUT MODE
	TAD	(232-334	/TEST FOR BACKSLASH
	SNA
	JMP	CHRLUP		/IGNORE IT
	TAD	(334-240	/IS CHAR BETWEEN 240 AND 336?
	SPA
	AC4000			/SMA WILL NOT SKIP NOW
	TAD	(240-337
	SMA CLA			/SAME AS -100
	JMP	CHRLUP		/CHAR IS >336, IGNORE IT ALSO
	TAD	CHAR
NOECHO,	JMS I	[PRNTC		/ECHO CHAR
	TAD	CHAR
	DCA I	16		/SAVE CHAR
	JMS I	[BUMPNC		/BUMP COUNT
	TAD	NCHARS
	TAD	K170
CLR,	SMA SZA CLA
	JMP	CHRLUP		/NOT TOO BIG
	JMS I	[TCRLF
	JMS I	[ERRMSG
	L2LONG-1		/--------------------"LINE TOO LONG"
	JMP	GETLIN+1
RUBOUT,	TAD	INSWIT		/BACKUP
	IAC
	TAD	NCHARS
	SMA SZA CLA		/BUT NOT PAST START OF LINE
	JMP	CLR+1
	ISZ	NCHARS
K170,	170			/THE ISZ MAY SKIP
	TAD	16
	DCA	CHAR		/POINTER TO LAST CHAR
	AC7777
	TAD	16
	DCA	16
	TAD I	CHAR
	JMS I	[PRNTC
	JMP	CHRLUP
CNTRLU,	JMS I	[TCRLF
	JMP	GETLIN+1	/START OVER
TAB,	TAD	(334
	DCA	CHAR
	JMP	NOECHO-1

ENDLIN,	JMS I	[TCRLF
	DCA I	16		/PUT IN 0 AT END
	TAD	NCHARS
	SNA
	JMP	GETLIN+1	/IF ONLY CAR. RET. TYPED
	TAD	M1
	DCA	NCHARS		/GIVES -NCHARS-1
	TAD	[LINE-1		/SET UP PTR TO LINE
	DCA	14
	JMS I	[INPUT2		/TEST FOR INPUT MODE
	SKP
	JMP	GTLRET		/YUP - IN INPUT MODE, SO RETURN .+2
	JMS I	[NUMBR		/NO - DECODE WHAT WAS TYPED AS A LINE #
	JMP I	GETLIN		/NO #, SO HE MUST HAVE TYPED A COMMAND
	DCA	LINENO
GTLRET,	ISZ	GETLIN
	JMP I	GETLIN
KTGETC,	TGETC
/
	PAGE

NXTLIN,	CLA
	TAD	INSWIT
	AND I	KCTRLO
	DCA I	KCTRLO		/IF IN INPUT MODE, DON'T TURN OFF ^O
	TAD	(NONAME&377+5000	/"JMP NONAME" IN DISGUISE
	DCA I	(SPSW		/MAKE SPACES LEGAL TRMINATOR
DMSM,	JMS I	[GETLIN		/GET LINE
	JMP I	(COMAND		/IT MUST BE A COMMAND
	TAD I	PDATE		/BEFORE WE GO TOO FAR, MAKE SURE
	SNA CLA			/GUY HAS ENTERED A DATE.
	JMP I	(CKDATE		/NOPE, GO PRINT MESSAGE AGAIN.
	AC0002			/THIS IS A TOTAL CROCK
	TAD	NCHARS
	SNA CLA			/TO TAKE CARE OF THE WEIRD CASE OF A
	JMP	DMSM		/GUY TYPING A NUMBER, SPACE, AND RETURN
	TAD	LINENO
	JMS I	[FIND		/LOOK UP THIS LINE NUMBER
	JMP	NEWLIN		/ITS A COMPLETELY NEW LINE
	CDF 10
	TAD I	WCPTR		/GET SIZE OF THIS LINE
	CIA
	TAD	WCPTR		/THIS IS READ POINTER
	DCA	16
	AC7777
	TAD	WCPTR
	DCA	15		/THIS IS THE WRITE POINTER
GETWC,	TAD I	16		/GET LINE SIZE
	SNA
	JMP	ENDREM
	DCA	SIZE
	TAD	SIZE
	DCA I	15		/PUT LINE SIZE INTO NEW PLACE
	TAD I	16
	DCA I	15		/MOVE LINE DOWN
	ISZ	SIZE
	JMP	.-3
	JMP	GETWC		/CONTINUE WITH NEXT LINE
ENDREM,	DCA I	15		/STORE EOF
GETROM,	CDF 0			/WE'VE REMOVED OLD COPY SO IT
				/LOOKS LIKE A NEW LINE
	AC0001			/SET CHANGED FILE SWITCH
	DCA	CHANGF
	JMS I	[GETC		/SKIP A BLANK
	JMP	NXTLIN		/LINE IS FINISHED, SO ARE WE
	TAD	(-334
	SNA CLA			/DON'T SKIP TABS
	JMS I	[BACK1
	TAD	15		/ADDR OF EOF
	CMA
	TAD	WCPTR		/GET NUMBER OF WORDS TO MOVE UP
	DCA	MOVSIZ
	TAD	NCHARS
	CIA			/NCHARS+1
	CLL	RAR		/OVER 2
	IAC			/+1=SIZE OF NEW LINE (= SPACE NEEDED)
	DCA	SIZE
	TAD	SIZE
	CLL IAC			/=SPACE NEEDED
	TAD	15		/WRITE POINTER
	DCA	WRTPTR
	TAD	WRTPTR
	TAD	P17		/TEST FOR FILE TOO BIG
	SZL CLA			/SIZE+1+CURRENT POSITION+17 <=4095
	JMP	FL2BIG
	TAD	15
	DCA	RDPTR		/READ POINTER
	CDF 10
ROMLUP,	TAD I	RDPTR		/MAKE ROOM FOR NEW LINE
	DCA I	WRTPTR
	AC7777			/DECREMENT POINTERS
	TAD	RDPTR
	DCA	RDPTR
	AC7777
	TAD	WRTPTR
	DCA	WRTPTR
	ISZ	MOVSIZ		/BUMP COUN
	JMP	ROMLUP
INSERT,	TAD	SIZE
	CIA
	DCA I	WCPTR		/PUT IN NEW LINE SIZE
	TAD	WCPTR
	DCA	LSTXR
	ISZ	WCPTR
	TAD	LINENO		/ALSO PUT IN LINE NUMBER
	DCA	LSTLIN
	TAD	LSTLIN
INSLUP,	DCA I	WCPTR
	ISZ	WCPTR
	CDF 0
	TAD I	14		/GET CHAR
	SNA
	JMP	NXTLIN
	CDF 10
	TAD	KM237		/CONVERT TO EDP-8 6-BIT
BSW001,	BSW			/CHANGES IF NON-8E
	DCA I	WCPTR		/PUT INTO UPPER CHAR
	CDF 0
	TAD I	14		/GET ANOTHER CHAR
	SNA
	JMP	NXTLIN
	CDF 10
	TAD	KM237
	TAD I	WCPTR		/UNITED WE STAND
	JMP	INSLUP

FL2BIG,	JMS I	[ERRMSG
	FILTOB-1		/--------------------"TEXT AREA FULL"
	JMP I	[NXTLIN
KM237,	-237
NEWLIN,	CDF 10			/FIND END OF FILE
	AC7777
	TAD	WCPTR		/ST. ADDR. OF LAST LINE
NEWLN3,	DCA	15
	TAD I	15
	CIA
	SNA
	JMP	GETROM
	TAD	15
	JMP	NEWLN3
/THE "PLEASE" COMMAND
/WHAT THIS DOES IS:
/TYPE A BELL
/WAIT FOR ANY KEY ON TTY
/GO BACK TO GET NEXT LINE
PLEASE,	TAD	P7		/THIS IS GOOD ENOUGH FOR US
	JMS I	TTYOUT
	JMS I	TTYIN
	JMP I	[NXTLIN
/
	PAGE

/ROUTINE TO FIND THE STARTING LOCATION OF A LINE IN THE TEXT BUFFER.
/IT IS OPTOMIZED SUCH THAT IN "LN" MODE, IF THE LINE # TO FIND
/IS GREATER THATN THE LAST ONE PROCESSED, IT STARTS THERE TO LOOK
/FOR THE PLACE TO PUT THE NEW LINE (KEEPS US FROM CHEWING HIGH-SPEED
/READERS INTO LITTLE PIECES WITH START-STOP READING)
FIND,	0			/FIND A LINE IN THE TEXT BUFFER
	DCA	FLINE		/SAVE THE LINE NUMBER
	TAD	FLINE
	CMA CLL
	TAD	LSTLIN
	SNL CLA
	TAD	LSTXR
	TAD	M1
	CDF 10
FLOOP,	DCA	16		/SET UP PTR
	TAD I	16		/GET LINE SIZE
	SNA
	JMP	FNDEND		/END OF FILE
	CMA CLL
	DCA	FSIZE
	TAD	FLINE
	CIA CLL
	TAD I	16
	SNA	CLA
	JMP	FOUND		/THIS IS THE LINE
	SZL
	JMP	ITSNEW		/IF LINE FOUND IS > LINE WANTED
				/THIS MUST BE A NEW LINE
	TAD	FSIZE
	TAD	16		/SKIP REST OF LINE
	JMP	FLOOP
FOUND,	ISZ	FIND		/BUMP RETURN
ITSNEW,	AC7777
FNDEND,	TAD	16
	DCA	WCPTR		/THIS IS ADDR OF WORD COUNT
	DCA	LSTLIN
	DCA	LSTXR
	CDF 0
	JMP I	FIND
FSIZE,	0
FLINE,	0

COMAND,	JMS I	[GETNAM		/GET COMMAND NAME (2 CHARS)
	JMP	COMERR
	TAD	(GTNMCH&377+5000	/"JMP GTNMCH" IN DISGUISE
	DCA I	(SPSW		/IGNORE ALL SPACES FROM NOW ON 
	TAD	(COMLST-1	/SEARCH COMMAND LIST
COMLUP,	DCA	16
	TAD I	16
	SNA
	JMP	COMERR
	TAD	NAM1
	SZA	CLA
	JMP	CBUMP1
	TAD	NAM1
	TAD	(-0401		/CHECK FOR "DATE" COMMAND
	SNA CLA			/IF IT IS, SKIP NEXT CHECK FOR PRESENCE OF DATE
	JMP	DATOK
	TAD I	PDATE
	SZA CLA
	JMP	DATOK
	JMS I	[ERRMSG
	NODATE-1
	JMP I	[NXTLIN
DATOK,	TAD I	16		/GET ADDR OF COMMAND PROCESSOR
	DCA	LINENO
	JMP I	LINENO		/GO TO IT
CBUMP1,	AC0001
	TAD	16
	JMP	COMLUP
COMLST,	-0605;READ		/"FETCH"
	-2722;WRITE
	-2301;SAVE
	-1411;LIST
	-2200;RUN		/"R" INSTEAD OF "RU"...(A FRILL ONLY)
	-2225;RUN
	-2205;RESEQ
	-0522;DELETE		/"ERASE"
	-0411;CATALG		/"DIRECTORY"
	-0405;PURCAT		/"DELETE"
	-0401;ENDATE
	-1416;INPUT		/"LN" (LINE NUMBERS)
	-0201;DO		/"BATCH"
	-2014;PLEASE		/"PLEASE"
K0,	0			/END OF COMMANDS
COMERR,	JMS I	[ERRMSG
	BADCOM-1		/--------------------"ERROR IN COMMAND"
	JMP I	[NXTLIN
BUMPNC,	0
	AC7777
	TAD	NCHARS
	DCA	NCHARS
	JMP I	BUMPNC
ERRMSG,	0
	CLA
	CDF 0
	DCA I	KCTRLO
	DCA	INSWIT
	DCA I	[TF0
	TAD I	ERRMSG
	ISZ	ERRMSG
	DCA	.+3
	AC0001
	JMS I	KCDOIO
	0
K240,	240
	TAD	(JMS I	TTYIN
	DCA I	(CHRLUP
	JMP I	ERRMSG
/
BACK1,	0		/BACK UP THE COMMAND LINE CHARACTER POINTER 1 CHARACTER
	AC7777
	TAD	14
	DCA	14
	JMS	BUMPNC
	JMP I	BACK1
/
	PAGE

/ROUTINE TO HANDLE "LIST M,N/S"
/
LIST,	JMS I	[SCANER
	DCA	LNPRPG		/LINES PER PAGE
	TAD I	[SWITCH
	TAD	(-1400
	SNA			/L?
	JMP	PRINT
	TAD	P7400		/1400-2000 IN DISGUISE
	SZA CLA			/P?
	JMP	TTYLST
	TAD	PPOUT
	DCA	PRTNE
	TAD	KSKP
	DCA	IFPTP		/IF PTP OUPUT, DON'T PUNCH LINE #S
	TAD	(KMAGIC&177+1200	/TAD KMAGIC IN DISGUISE
	DCA I	(IFPTP2		/& PUNCH TABS AS REAL 211'S
KSKP,	SKP
TTYLST,	TAD	(TTYSIZ		/ FOR LINE #
SVLNSZ,	DCA	LNCNT
LISTEX,	TAD I	[STRTLN
	JMS I	[FIND		/FIND STARTING PLACE
	CLA
	CMA
	TAD	WCPTR
	DCA	16
TTYLUP,	TAD	LNCNT
	DCA	NCPL
	TAD	[-15		/SET TAB COUNTER INITIALLY TO -15
	DCA	TABCNT
	TAD I	KCTRLO
	RAR
	SZL CLA
	JMP	FINLST		/IF ^O ON
	CDF 10
	TAD I	16
	SNA
	JMP	FINLST
	DCA	LSIZE
	TAD I	16		/LINE NUMBER
	CDF 0
	DCA	LINENO
	TAD I	[FINLIN
	CLL CMA
	TAD	LINENO
	SZL CLA
	JMP	FINLST
IFPTP,	TAD	LINENO
	JMS I	(DECNUM		/DECIMAL CONVERSION
	ISZ	LSIZE
LUPTTY,	CDF 10			/NOW PRINT CONTENTS
	TAD I	16
	CDF 0
	DCA	LCHARS
	TAD	LCHARS
BSW002,	BSW			/CHANGES IF NON-8E
	AND	P77
	SNA
	JMP	TTYEND
	TAD	[237
	JMS I	[PRNTC		/PRINT LEFT HALF...
	TAD	LCHARS
	AND	P77
	SNA
	JMP	TTYEND
	TAD	[237
	JMS I	[PRNTC		/& THEN THE RIGHT HALF
	ISZ	LSIZE
	JMP	LUPTTY
TTYEND,	JMS	LCRLF
	ISZ	LNPRPG
	SKP
	JMS	FORMFD		/EJECT AFTER 70 LINES
	JMP	TTYLUP
FINLST,	CDF 0
	DCA I	KCTRLO		/TURN OFF ^O, IF ON
	JMS	FORMFD
	TAD	(PRTABX&377+5000
	DCA I	(IFPTP2
	JMS	LCRLF
	TAD	TTYOUT
	DCA	PRTNE		/RESET TO TTY (AFTER PTP, FOR EX.)
	TAD	(TAD	LINENO
	DCA	IFPTP
	JMP I	[NXTLIN
LNCNT,	0			/MAXIMUM # OF CHARS PER LINE
LSIZE,	0			/THE SIZE OF THE CURRENT LINE
LCHARS,	0
PRINT,	TAD	LPOUT		/SET POINTER TO LPT FOR PRNTC ROUTINE
	DCA	PRTNE
	JMS	FORMFD
	TAD I	(LPTSIZ		/"LPSIZE" IS A LOCATION, NOT A CONSTANT LIKE TTYSIZ"!
	JMP	SVLNSZ
LCRLF,	0			/DO CRLF ON GIVEN DEVICE
	TAD	(215
	JMS I	PRTNE
	TAD	(212
	JMS I	PRTNE
	JMP I	LCRLF
FORMFD,	0
	TAD	PRTNE
	CIA
	TAD	LPOUT
	SNA CLA			/NO FORMFEED EXCEPT TO LPT
	TAD	(214
	JMS I	PRTNE
	TAD	(-70
	DCA	LNPRPG
	JMP I	FORMFD
/
	PAGE

/ROUTINE TO ERASE A LINE OR GROUP OF LINES
/COMMAND IS OF THE FORM "ERASE M,N"
/
DELETE,	JMS I	[SCANER
	TAD I	[FINLIN
	CLL CMA
	TAD I	[STRTLN
	SZL
	JMP I	[COMERR		/FOR "LIST 3,2" CASES
	SNA CLA
	JMP	DELALL
	TAD I	[STRTLN
	JMS I	[FIND
	JMP	NEXDEL+1	/LINE NOT THERE
	AC7777
	TAD	WCPTR
	DCA	12		/POINTER-1 TO LINE
	CDF 10
	TAD I	WCPTR		/GET LINE'S WORD COUNT
	CIA			/MAKE +
	TAD	WCPTR
	DCA	15		/THIS IS NOW POINTER-1 TO LINE AFTER
DELOOP,	TAD I	15
	SNA			/LENGTH=0?
	JMP	NEXDEL		/YES, SEE IF MORE TO DO
	DCA	DELSIZ
	TAD	DELSIZ
	DCA I	12
	TAD I	15
	DCA I	12		/MOVE WORD COUNT DOWN
	ISZ	DELSIZ
	JMP	.-3
	JMP	DELOOP

NEXDEL,	DCA I	12		/PUT IN EOF
	CDF 0
	ISZ I	[STRTLN		/BUMP TO NEXT
	SKP
	JMP	SETCFS
	TAD I	[STRTLN
	CLL CIA
	TAD I	[FINLIN
	CDF 10
	SZL CLA			/DONE ALL ASKED FOR?
	TAD I	WCPTR
SETCF2,	CDF 0
	SZA CLA
	JMP	DELETE+1	/NOT YET
SETCFS,	CLA	IAC
	DCA	CHANGF		/SET CHANGED FILE SWITCH
	DCA	LSTLIN
	DCA	LSTXR		/YOU ONLY NEED TO DO THIS ON "DELALL"
	JMP I	[NXTLIN
DELALL,	CDF 10
	DCA	LINENO
	DCA I	LINENO
	JMP	SETCF2		/RESET CDF TOO!!!
DELSIZ,	0
RESSIZ,	0
INCR,	0

/ROUTINE TO SESEQUENCE THE TEXT AREA.  DEFAULTS ARE 100,10.  IF
/EITHER IS OMITTED, E.G., "RESEQ ,2" THE DEFAULT VALUE IS
/USED FOR THE ONE THAT IS MISSING.
/
RESEQ,	JMS I	[SCANER
	DCA	LSTLIN
	DCA	LSTXR
	TAD I	[STRTLN
	SNA
	TAD	(144		/SET DEFAULTS
	DCA	LINENO
	TAD I	[FINLIN
	IAC
	SNA
	TAD	(13
	TAD	M1
	DCA	INCR
DEFALT,	AC7777
	DCA	16
	CDF 10
RESLUP,	TAD I	16
	SNA
	JMP	SETCF2
	CLL CIA			/MAKE +
	DCA	RESSIZ
	TAD	LINENO
	DCA I	16		/STORE NEW LINE NUMBER
	TAD	LINENO
	TAD	INCR
	DCA	LINENO		/BUMP LINE NUMBER
	SZL			/ADD OVERFLOW?
	JMP	RESOVR
	AC7777
	TAD	RESSIZ
	TAD	16		/SKIP OVER REST OF LINE
	DCA	16
	JMP	RESLUP
RESOVR,	JMS I	[ERRMSG
	LNO-1
	JMP I	[NXTLIN

DECNUM,	0			/DECIMAL OUT CONVERSION
	DCA	DNUM		/SAVE THE NUMBER
	TAD	(TENTBL		/PTR TO POWER OF TEN TABLE
	DCA	FPTR
	TAD	M4		/NUMBER OF DIGITS
	DCA	DCTR
DCLOOP,	TAD	(260		/ASCII ZERO
	DCA	NTMP		/START DIGIT AT ZERO
DCLUP,	TAD	DNUM
	CLL
	TAD I	FPTR		/SUBTRACT THIS POWER OF TEN
	SNL
	JMP	NXTPWR		/NUMBER TOO SMALL, LOWER POWER
	DCA	DNUM		/SAVE RESULT OF SUB
	ISZ	NTMP		/INCREMENT DIGIT
	JMP	DCLUP		/KEEP GOING WITH THIS POWER
NXTPWR,	CLA
	TAD	NTMP		/PRINT THIS DIGIT
	JMS I	[PRNTC		/THEN TRY NEXT LOWER POWER OF 10
	ISZ	FPTR
	ISZ	DCTR
	JMP	DCLOOP
	TAD	(240
	JMS I	[PRNTC		/PRINT BLANK AFTER NUMBER
	JMP I	DECNUM
FPTR,	0
NTMP,	0
DNUM,	0
DCTR,	0
/
	PAGE

/SCANS THE COMMAND LINE FOR UP TO A SIX-CHARACTER NAME.  NAME
/TERMINATORS ARE: SLASH, COMMA, OR END-OF-LINE.  A SPACE CAN ALSO
/BE A TERMINATOR FOR THE FIRST NAME ON A LINE (I.E., THE COMMAND).
/
GETNAM,	0			/GET A FILE NAME
	DCA	NAM1
	DCA	NAM2
	DCA	NAM3
	DCA	NAMSW
	TAD	FILTOB		/-7 IN DISGUISE
	DCA	COUNT
GTNMCH,	JMS	ONECHR		/GET CHAR, CHECK IT FOR SPECIAL CASES
	TAD	(13		/TEST FOR BLANK
	SNA
SPSW,	JMP	NONAME		/"JMP NONAME" OR "JMP GTNMCH"
	TAD	(240
	AND	P77
	DCA	NAMCHR
	TAD	NAMSW		/BEEN HERE BEFOR
	SNA
	ISZ	GETNAM		/NO, BUMP RETURN
	CLL	RAR		/LOW BIT INTO LINK
	TAD	(NAM1
	DCA	NAMPTR
	TAD	NAMCHR
	TAD I	NAMPTR
	SZL
	JMP	LOWNAM		/IF CHAR COUNT IS ODD, LOWER
BSW003,	BSW			/CHANGES IF NON-8E
	ISZ	COUNT
	SKP
	JMP	SCNCLA
LOWNAM,	DCA I	NAMPTR		/STORE IT
	ISZ	NAMSW		/BUMP COUNT
	JMP	GTNMCH
SCANSP,	JMS	ONECHR		/GOTTEN 6, SCAN TO DELIM
SCNCLA,	CLA
	JMP	SCANSP
/
ONECHR,	0		/GET A CHAR FOR NAME, CHECK FOR +,-./ DELIMITERS
	JMS I	[GETC
	JMP	NONAME
	TAD	(-260
	CLL
	TAD	(5
	SNL
	JMP I	ONECHR
NONAME,	JMS I	[BACK1
	JMP I	GETNAM
NAMPRE,	0
NAMCHR,	0
NAMSW,	0

/DIRECTORY COMMAND "DIR DEV" OR "DIR/N"
/
CATALG,	JMS I	[SAVWA
	JMS I	[GETDEV
	TAD I	[SWITCH
	TAD	(-2400
	SNA CLA
	JMP	SYSOVR
	TAD	LPOUT
	DCA	PRTNE
	JMS I	(FORMFD
SYSOVR,	JMS I	(LCRLF
	TAD	(OVR1
	JMS I	KSPLIT
	JMS I	SYSHND
	0400
STRTOV,	OVRADR
NAMPTR,	0
	JMP I	STRTOV

/ROUTINE TO PROCESS THINGS LIKE "M,N/D" AND PERMUTATIONS THEREOF
/
SCANER,	0
	DCA	STRTLN
	AC7777
	DCA	FINLIN
	JMS	SCAN
	DCA	STRTLN		/GOT "M" VALUE
	TAD	STRTLN
	JMP	MUSTBE		/ONLY SPECIAL CHARS ALLOWED NEXT
COMMA,	AC7777			/SEEN A COMMA, SO WE'RE ABOUT TO DO "N"
	DCA	FINLIN		/INITIALIZE TO SOMETHING RIDICULOUS
	JMS	SCAN
MUSTBE,	DCA	FINLIN		/STORE "N"
	JMS	SCAN		/THIS SHOULD NEVER RETURN
SCNERR,	CLA
	JMP I	[COMERR		/...BUT IT DID?
/
SCAN,	0			/CHECKS FOR SLASH, COMMA, SPACE, GETS A #
	JMS I	[GETC
	JMP	DSWITC		/NONE LEFT
	TAD	(-257
	SNA
	JMP	SLASH
	TAD	(257-254
	SNA
	JMP	COMMA
	TAD	(14
	SNA CLA
	JMP	SCAN+1
	JMS I	[BACK1		/NO SPECIAL CHAR, MUST BE START OF A NUMBER
	JMS I	[NUMBR
	JMP	SCNERR		/...IT WASN'T
	JMP I	SCAN
SLASH,	JMS I	[GETNAM
	SKP CLA
	TAD	NAM1		/GET THE SWITCH CHARS
DSWITC,	DCA I	[SWITCH
	JMP I	SCANER
STRTLN,	0
FINLIN,	0
FILTOB,	-7			/"TEXT AREA FULL"
	6546
	7165
	0142
	6346
	4201
	4766
	5555
TENTBL,	-1750;-144;-12;-1
	/
	PAGE

/ROUTINE TO DO LOOKUPS ON PS/8 DIRECTORIES
/CALL:
/JMS LOOKUP
/POINTER-1 TO NAME
/NOT FOUND RETURN
/FOURND RETURN, ST. BLK. # IN AC, LENGHT IN "FILSZ"
/
/PROGRAM MUST HAVE PREVIOUSLY SET UP:
/UINT=PHYSICAL UNIT #
/DAVICE=DEVICE HANDLER ADDRESS
/DBLOCK=0
/DIRECT=ADDRESS OF WHERE TO PUT THE DIRECTORY BLOCK READ IN (FIELD 0)
/
	XR=10
	XR1=12
	XR2=11
LOOKUP,	0
	TAD I	LOOKUP
	DCA	PTNAME
	ISZ	LOOKUP
	JMS	MRDCAT
	JMS	MDSRCH
	JMP I	LOOKUP
	TAD	SBLOCK
	CIA
	TAD I	PDORG
	ISZ	LOOKUP
	JMP I	LOOKUP
/
MRDCAT,	0
	SZA
	JMP	MRDREN
	DCA	SBLOCK
	DCA	FILSZ
	AC0001
MRDREN,	TAD	DAVICE		/FORM A UNIQUE VALUE FOR EACH DEVICE'S DIRECTORY BLOCKS
	CIA
	TAD	DBLOCK
	SNA
	JMP	INLRDY
	CIA
	TAD	DBLOCK
	DCA	DBLOCK
	JMS	MREADC
INLRDY,	TAD I	PDCNT
	DCA	NFILES
	TAD	PDWSTE
	DCA	XR
	JMP I	MRDCAT

MDSRCH,	0
FSRCLP,	TAD	PTNAME
	DCA	XR2
	TAD	M4
	DCA	CT
	TAD I	XR
	SNA
	JMP	SKPMTF
	SKP
SRCWDL,	TAD I	XR
	CIA
	TAD I	XR2
	SZA CLA
	JMP	NXTFIL
	ISZ	CT
	JMP	SRCWDL
	JMS	BUMPXR
	TAD I	XR
	SNA
	JMP	SKPMTF+1
	DCA	FILSZ
	ISZ	MDSRCH
	JMP I	MDSRCH
NXTFIL,	TAD	CT
	IAC
	JMS	BUMPXR
SKPMTF,	TAD I	XR
	TAD	SBLOCK
	DCA	SBLOCK
	ISZ	NFILES
	JMP	FSRCLP
	DCA	SBLOCK
	TAD I	PDLINK
	SZA
	JMP	MRDREN
	JMP I	MDSRCH
/
BUMPXR,	0
	TAD I	PDWSTE
	CIA
	TAD	XR
	DCA	XR
	JMP I	BUMPXR

MREADC,	0
	TAD	(200
	TAD	UNIT
	DCA	DIOCTL
	TAD	DBLOCK
	AND	P7
	JMS I	KSPLIT
	JMS I	DAVICE
DIOCTL,	0
	DIRECT
	0
	TAD I	PDCNT		/QUICK CHECK FOR LEGAL DIRECTORY
	TAD	(100
	SPA CLA
	JMP I	(BADDIR
	TAD I	PDLINK
	AND	TABSET		/7770 IN DISGUISE
	SZA CLA
	JMP I	(BADDIR
	JMP I	MREADC
SBLOCK,	0
CT,	0
NFILES,	0
PTNAME,	0
FORM,	DCA	INSWIT
	DCA I	KCTRLO
	TAD	(JMS I	TTYIN
	DCA I	(CHRLUP
	DCA	LSTLIN		/KILL THE "FIND" OPTOMIZATION STUFF
	DCA	LSTXR
	JMP I	(CNTRLU
L2LONG,	-7			/"LINE TOO LONG"
	5552
	5746
	0165
	6060
	0155
	6057
	5000
MEOVLS,	ZBLOCK 7		/SCRATCH SPACE USED BY DIRECTORY EXPANSION ROUTINE
/
	PAGE

/ROUTINE TO GET A SOURCE FILE AND READ IT INTO THE SOURCE
/EDITING AREA (IN CORE ONLY--DOESN'T AFFECT SOURCE SCRATCH AREA)
/
READ,	JMS I	[GETNAM
	JMP I	[COMERR		/NO NAME
	JMS I	[GETDEV		/GET DEVICE & UNIT OF FILE
	DCA	DBLOCK
	TAD	(0123		/AS
	DCA	NAM4
	JMS I	[LOOKUP
	NAM1-1
	JMP	NOFILE
	DCA	FILORG
	TAD	FILSZ
	CIA
	AND	P17		/MAKE 20 INTO 0
	CLL RTL
	RAL
	CLL CML RTL		/SET LINK TO EVENTUALLY BECOME THE FIELD BIT
	RTL
	TAD	UNIT
	DCA	RECTL
	TAD	FILORG
	JMS I	KSPLIT
	JMS I	DAVICE
RECTL,	10
	0
RDORG,	0
	AC0001
	DCA	CHANGF		/ SWITCH FOR CHANGED FILE
	DCA	LSTLIN		/ATTEMPT TO FIX OBSCURE EDIT BUG
	DCA	LSTXR		/BY TRYING THIS AS A RANDOM GUESS
	JMP I	[NXTLIN
NOFILE,	JMS I	[ERRMSG
	NOTFND-1		/--------------------"NOT FOUND"
	JMP I	[NXTLIN
DIGIT,	0

/ROUTINE TO SCAN COMMAND LINE & PICK OFF A DECIMAL #, < 4096.
/TERMINATORS ARE: SLASH, COMMA, OR NON-NUMERIC.  A SPACE CAN
/TERMINATE THE FIRST NUMBER ON A LINE I.E., THE LINE #.
/
NUMBR,  0			/CALL WITH AC = 0
        DCA     NUMSW           /ZERO SWITCH
NUMLUP,	DCA	NUMBER
        JMS I	[GETC
NONUMB, SKP     CLA             /END LINE, NO NUMBER
        JMP     TSTNUM          /TEST CHAR FOR DIGIT
	JMS I	[BACK1
        TAD     NUMBER          /GET RESULT INTO AC
        JMP I   NUMBR
TSTNUM,	TAD	(-240
	SNA
SPACOK,	JMP	NONUMB-1	/EITHER "JMP NONUMB" OR "JMP NONUMB-1", TO EITHER TAKE SPACES AS A
				/TERMINATOR OR NOT
	TAD     (240-272
	CLL
        TAD     (12
	SNL
        JMP     NONUMB          /IF < 260 NOT A DIGIT
        DCA     DIGIT
        TAD     NUMSW           /HAVE WE BEEN THRU BEFORE
        SNA     CLA
        ISZ     NUMBR           /NO, SO BUMP RETURN ADD
        ISZ     NUMSW           /SET SWITC
        TAD     NUMBER          /MULT BY 10
        CLL RTL
	TAD	NUMBER
        RAL
        TAD     DIGIT           /ADD NEW DIGIT
	SNL
        JMP	NUMLUP
	JMS I	[ERRMSG		/ERRMSG DOES CLA
	LNO-1			/--------------------"LINE # TOO LARGE"
	DCA	NUMBER
	JMP I	[NXTLIN
NUMBER, 0
NUMSW,  0

PRNTC,	0			/PRINT ROUTINE WITH TABS
	DCA	RDORG
	ISZ	NCPL
	JMP	NOCR		/STILL GOT SPACE ON LINE
EOFLIN,	JMS I	(LCRLF
	TAD	(TTYSIZ
	DCA	NCPL
NOCR,	TAD	RDORG
	TAD	(-334		/334 (\) IS TAB
	SNA
IFPTP2,	JMP	PRTABX		/DO THE TAB (THIS INSTRUCTION CHANGES)
	TAD	(334
	JMS I	PRTNE		/PRINT THE CHAR
	ISZ	TABCNT		/BUMP TAB COUNTER
	JMP I	PRNTC		/RETURN
RSTAB,	TAD	TABSET		/RESET TAB COUNT
	DCA	TABCNT
	JMP I	PRNTC
PRTAB,	ISZ	NCPL
	SKP
	JMP	EOFLIN
PRTABX,	TAD	(240		/PRINT BLANKS FOR TAB
	JMS I	PRTNE
	ISZ	TABCNT
	JMP	PRTAB
	JMP	RSTAB		/NOW GO RESET COUNT
KMAGIC,	211-334
BADDIR,	JMS I	[ERRMSG
	ZAPDIR-1		/--------------------"BAD DIRECTORY"
	JMP I	P7600		/MUST RETURN TO MONITOR THIS WAY, BECAUSE WE CAN COME
				/HERE WHEN CALLED FROM AN OVERLAY

CTRLV,	TAD I	(FLAGS
	RAR
	CML RAL
	DCA I	(FLAGS		/FLIP MESSAGE BIT
	JMP I	[NXTLIN
NOMEM,	-11			/"NOT ENOUGH MEMORY"
	5760
	6501
	4657
	6066
	5051
	0156
	4656
	6063
	7200
/
	PAGE

/THE "RUN" COMMAND PROCESSOR.
/RUN WITH NO ARGS: RUNS THE LAST COMPILED DIBOL BINARY.
/RUN WITH ARGS: TAKES THE FIRST AS "SV" FILE TO RUN, OTHERS AS ASCII
/FILES. (CASE 1)
/CASE 2, RUN WITH ARGS, "SV" FILE OF NAME NOT FOUND:
/LOOKS UP DIBOL BINARY FILE OF THAT NAME & RUNS THAT.
/IMPLICATION: YOU CAN'T HAVE A DIBOL BINARY OF THE SAME NAME AS A SYSTEM
/PROGRAM, BECAUSE "RUN" WILL ALWAYS RUN THE "SV" FILE IN PREFERENCE
/TO THE "DB" FILE.  (WHO CARES)
/
NOTHER,	ISZ	FILCNT
	SKP
	JMP I	(NOFILE
	TAD	(0402
	JMP	RLOOP
/
RUNBIN,	TAD	RUNORG
	SKP
RUNSCR,	TAD	(COMPWA		/STARTING BLOCK OF COMPILER SCRATCH AREA
	DCA I	(SBT
	TAD	(34		/STARTING BLOCK OF RSYS ON TAPE
	DCA	RUNORG
	AC0001
	JMP	NWRITF
RUN,	JMS	SAVWA
RGETL,	AC7776
	DCA	FILCNT
	TAD	(EDITWA		/ASSUME EDITOR SCRATCH AREA TO START
	DCA I	(SBT
	TAD	SYSHND
	DCA	DAVICE
	DCA	RUNORG
	DCA	UNIT
	DCA	DBLOCK
	JMS I	[GETNAM
	JMP	RUNSCR		/IF NO ARGS...
	TAD	(2326		/FIRST TRY TO FIND SV FILE OF NAME
RLOOP,	DCA	NAM4
	JMS I	[LOOKUP
	NAM1-1
	JMP	NOTHER
	DCA	RUNORG		/SAVE STARTING BLK. #
	TAD	NAM4		/SEE IF SV OR DB TYPE
	CIA
	TAD	(0402		/"DB"
	SNA CLA
	JMP	RUNBIN
	/IF WE FALL THRU, IT'S A SYSTEM PROGRAM ("SV")
NWRITF,	TAD	(SBT-1		/FORM FILE LIST
	DCA 	13
	TAD	TABSET
	DCA	FILCNT		/MAX NUMBER OF FILES (8)
GFILES,	JMS I	[GETC
	JMP	GOBACK		/END OF FILE LIST
	TAD	(-257
ESNA,	SNA
GOBACK,	JMS I	[BACK1
	TAD	(4
	SNA CLA			/IS IT "+"?
	JMP	KEEPOL		/YES - KEEP OLD EXTENSION
	TAD	(0123		/NO - PUT IN .AS
	DCA	NAM4
KEEPOL,	JMS I	[GETNAM		/GET NAME OF FILE
	JMP	DOSPL
	ISZ	FILCNT
	JMP	LUKN
	JMS I	[ERRMSG
	BADCOM-1		/TOO MANY FILES
	JMP I	[NXTLIN
LUKN,	JMS I	[LOOKUP
	NAM1-1
	JMP I	(NOFILE		/NOT FOUND
	DCA I	13
	JMP	GFILES
RUNORG,	0
/
DOSPL,	JMS I	[SCANER		/GET SWITCH (IF ANY)
	TAD	RUNORG
	JMS I	KSPLIT
	JMS I	SYSHND		/READ IN HEADER BLOCK OF SYSTEM PROGRAM TO RUN
	200
K4000,	4000			/INTO 4000-4377
	0
	TAD I	(4001
	DCA I	(MSTCDF
	TAD I	(4002
	DCA I	(MSTADR
	TAD	P7600
	JMS I	KMOVE
	CDF 0
	MSTART-1
	MSTART&177+4200-1
	JMP I	.+1
	4200			/**** CAREFUL!!!
SAVWA,	0
	TAD	CHANGF
	SNA CLA
	JMP	ENBCTC		/DON'T NEED TO REWRITE
	TAD	(EDITWA
	JMS I	KSPLIT
	JMS I	SYSHND
	4010
	0
	0
ENBCTC,	TAD	ESNA
	DCA I	(CTCFIX		/RE-ENABLE ^C BOOT
	JMP I	SAVWA
FILCNT,	0

/"DATE" COMMAND
ENDATE,	JMS I	[SAVWA
	TAD	(NONUMB&377+5000-1
	DCA I	(SPACOK
	TAD	(OVR1+2		/STARTING BLOCK, OVERLAYS
	JMS I	KSPLIT
	JMS I	SYSHND		/GO GET OVERLAY
	0200
	OVRADR+400
	0
	JMP I	.+1		/GO TO CORRECT PLACE
	DACOM&177+OVRADR+600
/
	PAGE

/THIS CODE MOVES TO 4200-4377 FOR "RUN" COMMAND
MSTART,	TAD I	(RUNORG
	IAC
	DCA	RUNFIL
	TAD	(4004
	DCA	RUNGET
RUN8,	ISZ I	R7000		/LAST PAIR?
	JMP	RUN9
	TAD I	RUNGET
	ISZ	RUNGET
	DCA I	(MREAD+3
	TAD I	RUNGET
	ISZ	RUNGET
	DCA I	(MREAD+2
	TAD	RUNFIL
	JMP I	(MREAD
RUN9,	TAD I	RUNGET
	ISZ	RUNGET
	DCA	RADR
	TAD I	RUNGET
	ISZ	RUNGET
	DCA	RCTL
	TAD	RCTL
	AND	P70
	TAD	PCDF
	CIA CLL
	TAD I	(BIGCDF
	SPA CLA			/CHECK FOR ENOUGH CORE
	JMP	NOCORE		/NOT ENOUGH MEMORY
	TAD	RUNFIL
	JMS I	KSPLIT
	JMS I	SYSHND
RCTL,	0
RADR,	0
	0
	TAD	RCTL
	JMS	ROTAT
	TAD	RUNFIL
	DCA	RUNFIL
	JMP	RUN8
RUNFIL,	0
ROTAT,	0
BSW004,	BSW			/CHANGES IF NON-8E
	AND	(37
	SNA			/TEST FOR FULL FIELD LOAD
	TAD	(37		/IF SO, WE WANT AC = 40
	IAC
	CLL RAR
	JMP I	ROTAT
R7000,	4000
/
NOCORE,	JMS I	[ERRMSG
	NOMEM-1			/NOT ENOUGH MEMORY!
	JMP I	P7600

/ROUTINE TO SAVE A DIBOL BINARY
/
SAVE,	JMS I	[SAVWA		/WRITE OUT FIELD 1
	TAD	(OVR1+2		/GET "SAVE" OVERLAY
	JMS I	KSPLIT
	JMS I	SYSHND
	0200
	OVRADR+400		/SAVE USES GETDEV & ENTER, SO IT CAN'T GO AT
RUNGET,	0
				/4000 LIKE THE OTHER OVERLAYS
	JMP I	.+1
	SAVOVR&377+OVRADR+400
ZAPDIR,	-7
	4342	/BA
	4501	/D
	4552	/DI
	6346	/RE
	4465	/CT
	6063	/OR
	7201	/Y
/

/ROTUINE TO DO THE BATCH THING.
/FIRST CALL TAPLIN TO GET A LINE (I.E., ONE RECORD)
/THEN CALL TGETC AS NEEDED TO GET CHARS FROM RECORD.
/NOTE THAT IT CUNNINGLY UNPACKS THE RECORD INTO WHERE
/IT IS, CHEERFUL IN THE KNOWLEGE THAT IT'LL KEEP AHEAD OF ITSELF.
TAPLIN,	TAD	(KTGETC&177+5600	/JMP I KTGETC IN DISGUISE
	DCA I	(CHRLUP		/CHANGE THE PLACE GETLIN GETS ITS CHARS FROM.
	TAD	DBLOCK
	CMA
	SZA CLA
	JMS I	(REREAD		/"DO" BLOCK NOT IN, SO REGET IT
	JMS I	KRDOIO		/GET A RECORD FROM "DO" FILE
	LINE+103-1		/PUT IT HERE
	JMP	EOFRE		/END OF FILE
	AC0002
	DCA	DORELC		/+2 TO SKIP LINE #
	TAD I	(LINE+103
	DCA	TCNT
	JMP I	(TAPRET		/RETURN TO GETLIN TO GET THE CHARS OUT NOW
DORELC,	0
TCNT,	0
TGETC,	TAD	DORELC
	CLL RAR
	DCA	TEMP
	TAD	TEMP
	TAD	TCNT
	SMA CLA
	JMP	EOTL
	TAD	TEMP
	TAD	(LINE+103
	IAC
	DCA	GET
	TAD I	GET
	SNL
BSW005,	BSW			/CHANGES IF NON-8E
RETAND,	AND	P77
	JMP	MASC

EOTL,	TAD	(215-237	/RETURN CR ON END OF RECORD
MASC,	TAD	(237-334	/MAKE ASCII, CHECK FOR "\"
	SNA
	TAD	(211-334	/CHANGE SUCH THINGS TO TABS
	TAD	(334
	ISZ	DORELC
	JMP I	(TGETCR
EOFRE,	DCA I	[TF0		/TURN OFF "DO"
	JMS I	[SAVWA		/IN CASE BATCH JOB INCLUDED A "FETCH"
	JMP I	P7600
/
	PAGE

/BUFFER FOR THE INPUT COMMAND LINE
/THIS CODE GOES AWAY
/
LINE,	0
	*.-1
START,	TAD I	M4
	IFNZRO START-3000 <???> /ERROR - MONITOR
	DCA	SYSHND
	TAD	SYSHND
	DCA I	(DEVLST
	TAD	SYSHND
	DCA I	(6200		/FIX UP LOGICAL UNITS TABLE
BSWFIX,	TAD	BSWVAL
BSWVAL,	7002			/BSW, IF IT EXISTS
	TAD	(-0270
	SNA CLA
	JMP	BSWLUP
	TAD	(JMS I	BSWPTR
	DCA	BSWVAL
BSWLUP,	TAD	BSWADR
	SNA
	JMP	TRNION
	DCA	BSWT
	TAD	BSWVAL
	DCA I	BSWT
	ISZ	BSWLUP
	JMP	BSWLUP
BSWADR,	BSW001
	BSW002
	BSW003
	BSW004
	BSW005
	BSW006
	BSW007
	BSW008
	BSW009
	0
BSWT,	0
TRNION,	ION			/NOTE THAT THIS CODE IS ONCE-ONLY, AND GOES AWAY
	TAD	KSZACL
	DCA I	(SRTFLG		/RESTORE SORT KLUDGE
	DCA I	(IZERO		/RESET
	TAD	(SKP
	DCA I	(CTCFIX		/MAKE ^C DISABLED, SO GUY WON'T LOSE EDITING CHANGES BY BEING A CLOD
	TAD	KCLAIA
	DCA I	(PIPFX1		/FIX UP AFTER POSSIBLE PIP ABORTION
	TAD	KCDO
	DCA I	(PIPFX2
	DCA I	(SWITCH		/CLEAR PREVIOUS OPTIONS
	TAD	KEWA
	JMS I	KSPLIT
	JMS I	SYSHND		/READ IN EDITOR WORKING AREA
	10
	0
	0
	TAD	(-107
	DCA	COUNT
	TAD	(FTBASE+11-1	/!!!!!!!-------- C A U T I O N --------!!!!!!!!
	DCA	PUTPNT
	DCA I	PUTPNT
	ISZ	COUNT
	JMP	.-2
	DCA I	(DEVNUM		/MAKE SURE TCRLF ECHOES!
	JMS I	[TCRLF
NOMESG,	AC7777
SCANLP,	DCA	15
	CDF 10
	TAD I	15		/CHECK WORKING AREA FOR LEGALITY
	SNA
	JMP	MKTSHT
	CLL
	TAD	K120
	SNL
	JMP	BADFIL
	TAD	(-120
	CLL CIA
	TAD	15
	SNL			/WRAP AROUND?
	JMP	SCANLP
BADFIL,	AC7777
	CDF 10
	DCA	15
	DCA I	15
MKTSHT,	CDF 0
	TAD I	[TF0		/SEE IF BATCH IS RUNNING
	SNA CLA
	TAD I	(FLAGS
	CLL RAR
	SNL CLA			/CHECK FOR ^V SWITCH
	JMP I	(CKFGBG		/THANK HEAVENS
KCLAIA,	AC0001
KCDO,	JMS I	KCDOIO		/PRINT VERSION MESSAGE
	VERMES-1
KEWA,	EDITWA
	JMP I	(CKFGBG
K120,	120
NODATE,	-3			/"DATE?"
	4542
	6546
	4001
KSZACL,	SZA CLA
/
	PAGE

	DIRECT=.
REBUFR,	0
/
/NOTE THAT PAGE 7600 GETS ASSEMBLED INTO HERE
/AND THEN THE INITIALIZATION CODE MOVES IT UP
/WHEN IT GOES TO WRITE OUT THE SYSTEM
/
	PAGE

/FAKE DIRECTORY
	-2
140
/
/1-7 = DIRECTORY
/10-13 = RESIDENT MONITOR
/14-17 = EDITOR OVERLAYS (DIR, DATE, SAVE)
/20-33 = EDITOR
/34-37 = RSYS LOADER
/40-57 = EDITOR WORK AREA
/60-67 = RSYS INTERPRETER
/70-74 = COMP OVERLAYS
/75-77 = DDT
/100-177=COMP SCRATCH AREA (FOR NOW)
/
0
0
7777
/
0317	/CO
1520	/MP
0
2326	/SV
SYSDAT	/DATE
7762
/
0
	6616
SYSWRI,	TAD	P7600		/SAVE OS/8 PAGE 7600
	JMS I	KMOVE
	CDF 10
	7600-1
	6000-1
	TAD	P7600		/MOVE PAGE 7600 INTO ITS PROPER SPOT
	JMS I	KMOVE
	CDF 0
	REBUFR-1
	7600-1
	AC0001
	JMS I	KSPLIT
	JMS I	SYSHND		/WRITE OUT BLANK DIRECTORY
	4200
	.&7400
	0 
	JMS I	SYSHND	/WRITE OUT APPROPRIATE BOOTSTRAP
	4210
	IFZERO SYSDEV-DTA <
	IFZERO TAPE <TC01BT>
	IFNZRO TAPE&1 <TD8EBT>
	IFNZRO TAPE&2 <TC12BT>>
	IFZERO SYSDEV-RK8 <
	IFZERO RKDISK <RK8BT>
	IFNZRO RKDISK <RKEBT>>
	0 
	TAD	(RESMON		/WRITE OUT RESIDENT
	JMS I	KSPLIT
	JMS I	SYSHND
	5000
	6000
	0
	TAD	(OVR1		/WRITE OUT OVERLAYS
	JMS I	KSPLIT
	JMS I	SYSHND
	5010
	OVRADR
	0
	TAD	(EDITBL		/WRITE OUT EDITOR
	JMS I	KSPLIT
	JMS I	SYSHND
	7000
	0
	0 
	TAD	P7600
	CDF 10			/NOW RESTORE OS/8 PAGE 7600
	JMS I	KMOVE
	CDF 0
	6000-1
	7600-1
	IOF
	JMP I	.+1
	7605
	*.&7600+100		/THIS IS TO KEEP TAG "VERMES" FROM BEING MULTIPLY DEFINED
				/BECAUSE OF CONDITIONAL CODE ABOVE
VERMES,	-11			/"COS MONITOR YR.MO.DA"
	4460
	6401
	5660
	5752
	6560
	6301
	YEARX^100+2117	/YR+.
	ZZZ1=MONTH%12
	ZZZ2=ZZZ1^12
	ZZZ3=MONTH-ZZZ2
	ZZZ1^100+ZZZ3+2121	/MO
/	ZZZ4=DAYX%12
/	ZZZ5=ZZZ4^12
/	ZZZ6=DAYX-ZZZ5
/	ZZZ4^100+ZZZ6+2121	/DA
	4300			/FOR PATCH LEVEL

CKFGBG,	TAD I	KFLAGS
	SPA CLA
	JMP I	(CKDATE		/IF FOREGROUND/BACKGROUND, DON'T UPSET FIELD ALLOCATIONS!
CHKMEM,	CLA CLL IAC		/NOW SEE HOW MUCH CORE WE GOT
	DCA	CORSIZ
COR0,	CDF 0
	TAD	CORSIZ
	RTL
	RAL
	AND	P70
	TAD	COREX
	DCA	.+1
COR1,	CDF
	TAD I	CORLOC
COR2,	NOP
	DCA	COR1
	TAD	COR2
	DCA I	CORLOC
	NOP
	TAD I	CORLOC
CORX,	7400
	TAD	CORX
	TAD	CORV
	SZA CLA
	JMP	COREX
	TAD	COR1
	DCA I	CORLOC
	ISZ	CORSIZ
	JMP	COR0
COREX,	CDF 0
	AC7777
	TAD	CORSIZ
	CLL RTL
	RAL
	TAD	COREX
SAVCDF,	DCA I	(BIGCDF
CKDATE,	AC0002
	DCA I	P7600
	TAD I	PDATE
	SZA CLA
	JMP I	[NXTLIN
	AC0001
	JMS I	KCDOIO
	NODATE-1
KFLAGS,	FLAGS
	JMP I	[NXTLIN
CORSIZ,	0
CORLOC,	CORX
CORV,	1400
/
	PAGE

PURCAT,	JMS I	[GETNAM
	JMP I	[COMERR
	JMS I	[GETDEV		/GET DEV, UNIT TO USE
	TAD	(DELLST-2
	DCA	GETPNT
DELLUP,	ISZ	GETPNT
	TAD I	GETPNT
	SMA
	JMP I	[COMERR
	TAD I	[SWITCH
	SZA CLA
	JMP	DELLUP
	TAD I	GETPNT
	DCA	NAM4
	DCA	DBLOCK
	TAD	K3100		/FAKE A /Y
	DCA I	[SWITCH
	JMS	PURGE
	JMP I	(NOFILE		/IT WERN'T THERE
	JMP I	[NXTLIN
/
PURGE,	0
	JMS I	[LOOKUP
	NAM1-1
	JMP I	PURGE
P7700,	SMA CLA
K600,	600
	TAD I	[SWITCH
	TAD	M3100
	SNA CLA			/DID GUY GIVE A /Y?
	JMP	DOPUR		/YUP
	AC0001			/WE DON'T WANT TO KILL BATCH MODE FOR THIS MESSAGE
	JMS I	KCDOIO		/DON'T CALL ERROR MESSAGE ROUTINE HERE
	REPL-1			/--------------------"REPLACE?"
K3100,	3100
	JMS I	KCDOIO
	LINE-1
M3100,	-3100
	TAD I	(LINE+1
	AND	P7700
	TAD	K600
	SZA CLA
	JMP I	[NXTLIN
DOPUR,	ISZ	PURGE
	AC7776
	TAD	XR
	DCA	XR
	TAD	XR
	DCA	XR2
	DCA I	XR2
	AC7775
	TAD I	PDWSTE
	JMS	SQUISH
	JMS	CONSOL
	CLA CLL CML RAR
	JMS I	(MREADC
	JMP I	PURGE
CONSOL,	0
	TAD	PDWSTE
	DCA	XR
	TAD I	PDCNT
	DCA	XR2
CONLP,	TAD I	XR
	SNA CLA
	JMP	PEMPTY
PSKIPF,	TAD	M4
	JMS I	(BUMPXR
	ISZ	XR2
	JMP	CONLP
	JMP I	CONSOL

DELLST,	-2326;	2326		/-SV;	SV
	-2300;	0123		/-S;	AS
	-0200;	0402		/-B;	DB
	-0600;	0406		/-F;	DF
	-1500;	0415		/-M;	DM
PEMPTY,	ISZ	XR		/DELLST MUST TERMINATE WITH A (+) NUMBER !!!
	TAD	XR
	DCA	SQUISH
	ISZ	XR2
	SKP
	JMP I	CONSOL
	TAD I	XR
	SZA CLA
	JMP	PSKIPF
	TAD I	XR
	TAD I	SQUISH
	DCA I	SQUISH
	AC7776
	JMS	SQUISH
	ISZ I	PDCNT
	JMP	CONSOL+1
SQUISH,	0
	TAD	XR
	DCA	XR1
SQLOOP,	TAD I	XR
	DCA I	XR1
	TAD	XR
	TAD	(-DIRECT-377
	SZA CLA
	JMP	SQLOOP
	JMP I	SQUISH

LNO,	-10		/"LINE # TOO LARGE"
	5552
	5746
	0104
	0165
	6060
	0155
	4263
	5046
NOTFND,	-7		/"FILE NOT FOUND"
	4752
	5546
	0157
	6065
	0147
	6066
	5745
/
PAGE

/C A U T I O N :  NOTE THAT AN EDITOR OVERLAY READS INTO THIS BLOCK,
/SO BE CAREFUL WHAT YOU PUT HERE (MAKE SURE THE OVERLAY DOESN'T
/NEED TO USE IT.)
/
/TAD	(LENGTH OF FILE
/JMS	ENTER
/DONE, BLK # IN AC
/
ENTER,	0
	DCA	ELENGT
	JMS I	(PURGE
ELENGT,	0			/ERROR RETURN FOR PURGE, SO ELENGT MUST BE <=777 !!!
RENTER,	JMS I	(MRDCAT
	TAD	(ZERO
	DCA	EPTR
	DCA	EBLOCK
ELOOP,	TAD I	XR
	SNA CLA
	JMP	EMPTY
	AC7775
	JMS I	(BUMPXR
	TAD I	XR
ELEND,	TAD	EBLOCK
	DCA	EBLOCK
	ISZ I	(NFILES
	JMP	ELOOP
	TAD	XR
	DCA	ETMP
	TAD I	EPTR
	SZA
	JMP	EINSRT
	TAD I	PDLINK
	SZA
	JMP I	(MRDREN
	JMP	NOSPAC
/
EMPTY,	TAD I	XR
	DCA	ETMP
	AC7777 CLL
	TAD	ETMP
	TAD	ELENGT
	SZL CLA
	TAD	ETMP
	CIA CLL
	TAD I	EPTR
	SZL CLA
	JMP	ENOGD
	TAD	XR
	DCA	EPTR
	TAD	EBLOCK
	DCA	EBLK
ENOGD,	TAD	ETMP
	JMP	ELEND

EINSRT,	TAD	ELENGT
	SNA CLA			/IF IT JUST FITS, DELETE HOLE
	AC0002
	TAD	M4
	JMS I	(BUMPXR
	TAD I	PDWSTE
	CIA
	TAD	XR
	TAD	(-DIRECT-372
	SMA CLA
	JMP	NOROOM		/EVENTUALLY, AN OVERLAY TO EXPAND DIRECTORY
	JMS	MOVEUP
EMDONE,	TAD I	EPTR
	TAD	ELENGT
	SNA			/NECESSARY IF TWO FREE ENTRIES IN A ROW
	ISZ I	PDCNT
	NOP
	SZA
	DCA I	XR
	AC7777
	TAD	ETMP
	DCA	XR
	TAD	NAM1
	DCA I	XR
	TAD	NAM2
	DCA I	XR
	TAD	NAM3
	DCA I	XR
	TAD	NAM4
	DCA I	XR
	TAD I	PDATE
	DCA I	XR
	AC0001
	JMS I	(BUMPXR
	TAD	ELENGT
	CIA
	DCA I	XR
	AC7777
	TAD I	PDCNT
	DCA I	PDCNT
	AC4000
	JMS I	(MREADC
	TAD	EBLK
	CIA
	TAD I	PDORG
	JMP I	ENTER
EBLOCK,	0
EBLK,	0

NOROOM,	TAD	P7400
	JMS I	SYSHND
	0100
	3000
	0
	JMP I	.-2		/GO TO DIRECTORY EXPANDER OVERLAY
MOVEUP,	0
EMLOOP,	TAD I	ETMP
	DCA I	XR
	TAD	ETMP
	CMA
	TAD	EPTR
	SNA CLA
	JMP I	MOVEUP
	AC7777
	TAD	ETMP
	DCA	ETMP
	AC7776
	TAD	XR
	DCA	XR
	JMP	EMLOOP
NOSPAC,	JMS I	[ERRMSG
	NORM-1
	JMP I	[NXTLIN
/
	PAGE

/ROUTINE TO SAVE A SOURCE FILE ON A SPECIFIED DEVICE. 
/COMMAND:
/WRITE FILENM,DEV
/
WRITE,	JMS I	[GETNAM
	JMP I	[COMERR
	JMS I	[GETDEV
	TAD	(0123
	DCA	NAM4
	DCA	DBLOCK
	CDF 10
	CMA
WRGTLN,	DCA	GETPNT
	TAD I	GETPNT	/GET LENGTH
	CIA CLL		/MAKE +
	SNA
	JMP	ENDFLD
	TAD	GETPNT
	JMP	WRGTLN
ENDFLD,	CDF 0
	TAD	GETPNT
	SNA			/CHECK FOR COMPLETELY EMPTY WORK AREA
	JMP	NONE		/IF SIZE 0, TELL USER HE IS NOT TOO BRIGHT
	TAD	(401		/401 TO TAKE CARE OF EOF WORD NOT INCLUDED IN COUNT
				/(400 DOES NOT WORK, FRIEND! YOU CAN GUESS HOW WE KNOW)
	AND	P7400
	CLL CML RAR
	TAD	UNIT
	TAD	(10
	DCA	WRCTL
	TAD	WRCTL
	RTL
	AND	P7400
	RTL
	RTL
	SNA
	TAD	(20
	JMS I	(ENTER
	JMS I	KSPLIT
	JMS I	DAVICE
WRCTL,	0
0		/THIS WORD MUST BE ZERO, I.E., 0000, ALWAYS!!!
0
	TNAM1=WRCTL
TNAM2=17	/********MOMENTUS AND COLOSSAL KLUDGE**********
	TNAM3=WRCTL+2
	JMP I	[NXTLIN
/

/ROUTINE TO DECODE THE MNEMONICS "DTN," "RKN," INTO SOMETHING
/MEANINGFUL.
/
GSWITC,	JMS I	[BACK1	/GOT SWITCH, BACK UP 1 CHAR
	JMP	CHKDEV
GETDEV,	0
	TAD	NAM1		/PRESERVE CURENT NAME
	DCA	TNAM1
	TAD	NAM2
	DCA	TNAM2
	TAD	NAM3
	DCA	TNAM3
	DCA	NAM2
	DCA I	[SWITCH
	JMS I	[GETC		/SKIP COMMA
	JMP	GSWITC		/IF NONE
	TAD	(-257
	SNA CLA
	JMP	GSWITCH
	JMS I	[GETNAM
	JMP	GSWITC+1
	TAD	NAM1
	TAD	(-0413		/-DK
	SNA
	JMP	RK
	TAD	(0413-0424	/-DT
	SZA CLA
	JMP	BADDEV		/ILLEGAL DEVICE
DT,	IAC
RK,	IAC
CHKDEV,	TAD	(DEVLST-1
	DCA	GETPNT
	TAD	NAM2
	SNA
	TAD	(6000		/IF NO, ASSUME UNIT 0
BSW006,	BSW			/CHANGES IF NON-8E
	TAD	(-67
	SMA SZA
	JMP	BADDEV
	TAD	P7
	DCA	UNIT
	JMS I	[SCANER		/GET SWITCH
	TAD I	GETPNT		/GET HANDLER ADDR
	DCA	DAVICE
	TAD	TNAM1		/RESTORE OLD NAME
	DCA	NAM1
	TAD	TNAM2
	DCA	NAM2
	TAD	TNAM3
	DCA	NAM3
	JMP I	GETDEV

DEVLST,	0		/GETS SET TO SYSTEM DEVICE POINTER
	RK8
	DTA
NONE,	JMS I	[ERRMSG
	NOFL-1		/"NO FILE TO SAVE"
	JMP I	[NXTLIN
NOFL,	-10		/--------------------"NO FILE TO SAVE"
	4057
	6001
	4752
	5546
	0165
	6001
	6442
	6746
BADDEV,	JMS I	[ERRMSG
	ILUNT-1		/MESSAGE IN  MONITOR -------"ILLEGAL UNIT"
	JMP I	[NXTLIN
/
NORM,	-4		/"NO ROOM"
	5760
	0163
	6060
	5600
/
PAGE

/C A U T I O N : EDITOR OVERLAYS THIS OCCASIONALLY
/
	*4400
/ROUTINE TO TAKE CARE OF SEQUENCE NUMBERS, LABEL CHECKING, AND
/SIMILAR TRIVIA.  CALL:
/JMS	MOUNT
/RETURN
/
P7760,	7760		/*!* MUST BE FIRST LOCATION ON PAGE *!*
	IFNZRO P7760&177 <???> /ERROR
MOUNT,	0
	DCA	NMBR		/MAYBE SAVE LOGICAL UNIT # TO USE
	DCA I	KCTRLO		/THEN TURN OFF ^O
	TAD	W5
	DCA	FMAD
	AC7775
	JMS I	KMOVE		/MOVE IN LABEL TO PRINT
	CDF	BASFLD
FMAD,	0
	LBL1-1
	ISZ I	W5		/BUMP SEQUENCE #.
	TAD I	W5		/IF >63...
	AND	P77		/THIS MAKES AC0
	SNA			/AND IF >63
	JMP	BADSEQ		/GENERATE AN ERROR.
	JMS I	KOTOPD		/CONVERT AC TO DECIMAL ASCII
	DCA I	(SEQ		/AND SAVE HERE.
	TAD	LENGTH
	DCA	FMAD		/REMEMBER CURRENT VALUE OF THIS
	TAD I	W0
	SMA CLA			/INPUT OR OUTPUT?
	AC0002			/INPUT
	TAD	(OUTIN-1
	DCA	INOUT
	AC7776
	JMS I	KMOVE		/BRING IN PROPER LETTERS FOR MESSAGE
	CDF 0
INOUT,	0
	IORO-1			/PUT THEM HERE
	TAD	NMBR		/CHECK TO SEE IF GUY IS TRYING TO PRE-ASSIGN LOGICAL UNITS
	SZA CLA
	JMP	MEOS		/YES, SO TAKE IT AND SEE IF IT'S OK
DOMES,	AC0001
	JMS I	KCDOIO
	TMOUNT-1		/"MOUNT XXXXXX #XX FOR XXXPUT"
KM10,	-10			/NOP
	TAD	P7		/"7" IS JUST AS GOOD AS "207" FOR US
	JMS I	TTYOUT		/THIS IS ANOTHER MARKETING GROOVINESS
	AC7775			/RESET BUFFER LENGTH TO THIS
	DCA	LENGTH		/SINCE OUR BUFFER IS ONLY 4 WORDS LONG
	JMS I	KCDOIO		/NOW GET THE RESPONSE &
EBUFR,	BUFR-1			/PUT IT HERE.
	JMP	DOMES		/GUY OVERFLOWED BUFFER
	DCA	CNUM		/REL. CHAR. 0
	DCA	NMBR
NXTDIG,	TAD	EBUFR		/BUFFER POINTER IN AC
	IAC
	JMS I	KGETC
CNUM,	0
	SNA
	JMP	MEOS		/END OF LINE
	ISZ	CNUM		/BUMP FOR NEXT TIME
	TAD	M33		/MAKE SURE CHAR IS A #
	CLL IAC
	TAD	(11
	SNL
	JMP I	(BADUNT
	DCA	TEMP
	TAD	NMBR		/GET CURRENT VALUE
	CLL RTL			/& MULTIPLY IT BY 10
	TAD	NMBR
	RAL
	TAD	TEMP		/ADD IN NEW #
	JMP	NXTDIG-1
MEOS,	TAD	NMBR		/SEE IF IN RANGE 1-15
	SZA
	TAD	P7760		/-16 IN DISGUISE
	SMA CLA
	JMP I	(BADUNT		/>15!
	TAD I	W1
MP200,	AND	P7760		/CEAR THE LOGICAL UNIT #
	DCA I	W1		/THAT WAS PREVIOUSLY ASSIGNED
	TAD	KM10
	DCA	COUNT
	TAD	(FTBASE+1
	DCA	GET
CHKLP,	CIF 0			/TO TURN OFF INTERRUPTS DURING CHECK PROCESS
				/(NECESSARY ONLY FOR EVENTUAL FOREGROUND/BACKGROUND)
	TAD I	GET
	AND	P17
	CIA
	TAD	NMBR
	SNA CLA
	JMP I	(INUSE
	TAD	GET
	TAD	(TF1-TF0
	DCA	GET
	ISZ	COUNT
	JMP	CHKLP
	TAD I	W1		/OK TO PUT IN LOGICAL UNIT NO.
	TAD	NMBR		/BITS 8-11 ALREADY CLEARED
	DCA I	W1
	TAD	IFN		/WE NOW HAVE TO SET UP "HANDLR"
	JMS I	KPTRST		/NOW THAT W1 IS CORRECT AND THEREFORE U0 WILL BE CORRECT
	TAD I	W1		/GET BUFFER ADDRESS
	AND	P7600
	TAD	M1
	DCA I	W2		/SET UP INTERNAL BUFFER POINTER-1
	TAD I	W0
	RAL
	AND	P7400
	SNL			/READ OR WRITE?
	CLA			/SET BUFFER EMPTY FOR READS
	CIA
	JMP I	.+1
	NEXTP1
MOUNTR,	TAD	FMAD		/RESTORE
	DCA	LENGTH		/VALUE THE USER MAY HAVE HAD
	JMP I	MOUNT
OUTIN,	6066;6561		/OUTP
	0152;5761		/INP
BADSEQ,	AC0001
	JMS I	KCDOIO
	BADS-1
M33,	-33
	JMP I	P7600
INU,	-3			/"IN USE"
	5257
	0166
	6446
/
	PAGE

KK377,	377		/MUST BE FIRST LOCATION ON PAGE!
NEXTP1,	DCA I	W3
	DCA I	W4		/0 HI REL. BLK. BITS
	TAD I	W5		/SET INITIAL BLOCK AS 1
K200,	AND	KK377
	TAD	(400
	DCA I	W5		/TO LEAVE LABEL & BOOSTRAP INTACT IN BLOCK 0
	TAD	M4
	DCA	COUNT
	TAD	W4		/POINTER-1 TO CURRENT LABEL
	DCA	GETPNT
	JMS	RDBLK0
	TAD	RD0CDF
	DCA	BFRFLD
	TAD	RD0CDF
	DCA	LBLCHK
	TAD	RD0CDF
	DCA	BDLCDF
	TAD	ARG2
	DCA	PUTPNT		/POINTER-1 TO BUFFER
	TAD	ARG2		/GET SA -1 OF BUFFER
	IAC
	DCA	FRMADR		/THE "FROM" PLACE
LBLCHK,	HLT
	TAD I	PUTPNT
	CDF	BASFLD
	CIA
	TAD I	GETPNT
	SZA CLA
	JMP	BADLBL
	ISZ	COUNT
	JMP	LBLCHK
	JMP	OOSIK		/LABELS AGREE
BADLBL,	TAD I	W0		/LABELS DISAGREE
	SPA CLA
	JMP	BDLCDF		/ASK REPLACE IF OUTPUT
	TAD	P77		/PRINT "?"
	JMS I	TTYOUT		/TO LET GUY KNOW LABEL NOT FOUND
	JMP I	(DOMES		/NOW RE-ASK MOUNT MESSAGE

BDLCDF,	HLT			/THE "FROM" CDF
	TAD I	FRMADR
	AND	P77
	JMS I	KOTOPD
	DCA	SEQLBL
	AC7775
	JMS I	KMOVE		/MOVE LABEL TO MESSAGE PLACE
	CDF	BASFLD		/CDF "TO" FIELD
FRMADR,	0
TOADR,	LABEL1-1
	TAD	LABEL1
	SMA CLA
	JMP	OOSIK		/FIRST CHAR LABEL + MEANS WORK UNIT, OK TO GRUNCH IT
RM,	DCA I	KCTRLO		/BE SURE ^O IS OFF FOR MESSAGE
	AC0001
	JMS I	KCDOIO
	REPLBL-1		/"REPLACE XXXXXX #XX?
KK5,	5
	JMS I	KCDOIO		/FIND OUT YES OR NO
	BUFR-1
KM7200,	-7200			/NOP
	TAD	BUFR+1
	AND	K7700
	TAD	KM7200		/-Y
	SZA CLA
	JMP I	(DOMES		/REPEAT IF NOT Y
OOSIK,	TAD I	W0		/EITHER LABEL AGREES, OR WE DON'T CARE
K7700,	SMA CLA			/READ OR WRITE
	JMP	MEXIT		/IF READ, NO MORE TO DO
	TAD	W4
	DCA	BFRM
	TAD	ARG2
	DCA	BTOADR
	TAD	M4
	JMS I	KMOVE		/MOVE IN NEW LABEL & DATE
BFRFLD,	0			/"TO" FIELD
BFRM,	0			/"FROM" PLACE
BTOADR,	0			/"TO" PLACE
	AC4000
	JMS	RDBLK0
MEXIT,	JMP I	.+1		/FINALLY!
	MOUNTR

BUFR,	0;0;0		/PLUS ENTRY TO RDBLK0
RDBLK0,	0
	TAD	P77
	AND I	W0
	TAD	K200
	DCA	ARG1
	TAD I	W1
	AND	P7600
	DCA	ARG2
	TAD	ARG1
	AND	P70
	TAD	PCDF
	DCA	RD0CDF
	TAD	ARG2
	TAD	KK5
	DCA	HIBLK
	TAD I	W4
	DCA	BTOADR
	TAD I	M1		/GET CURRENT DATE
RD0CDF,	HLT
	DCA I	HIBLK
	ISZ	HIBLK
	TAD	BTOADR
	DCA I	HIBLK
	CDF	BASFLD
	TAD I	U1
	DCA	HIBLK
	JMS I	HANDLR
ARG1,	0
ARG2,	0
HIBLK,	0
	JMP I	RDBLK0
REPLBL,	-12
	6346	/RE
	6155	/PL
	4244	/AC
SEQOUT,	4601	/E
LABEL1,	0
LABEL2,	0
LABEL3,	0
	0104	/ #
SEQLBL,	0	/XX
	4000	/?
/
	PAGE

CTRLO,	0		/MUST BE FIRST LOCATION ON PAGE!!
TSTTTI,	KSF			/KBD?
	JMP	TSTTTO		/NOPE, TRY TTY
	TAD	TTI200
	KRS
	DCA	TICHR
	KCC
	TAD	TICHR
	TAD	(-203		/TEST FOR ^C
CTCFIX,	SNA
	JMP	TICTLC
	TAD	(-13		/& ^N
	CLL RAR
	SZA CLA
	JMP I	(DISMIS
	SNL
	ISZ I	(CTRLN
	SZL
FOFF,	ISZ	CTRLO
PTR232,	232
	DCA	TICHR
	JMP I	(DISMIS
TSTTTO,	TSF			/BETTER BE TTY INTERRUPT
	JMP	BADINT		/IGNORE, ON PENALTY OF DEATH
	TCF
	DCA	TOCHR		/SET NOT BUSY
	JMP I	(DISMIS
IFZERO LP645 <
BADINT,	LSE	/MAKE AN EFFORT (MEAGER AT BEST) TO FIND BAD INTERRUPT
	SKP
	LIF		/LPT ERROR FLAG, DISABLE LPT FROM INTERRUPT>
IFNZRO LP645 <
BADINT,	6651
	SKP
	6652>
	JMP I	(TTYCLR

TTOCHR,	0			/TTY OUTPUT ROUTINE
	DCA	TTICHR
DLYLUP,	AC0001
TTI200,	AND	CTRLO		/INHIBIT OUTPUT IF ^O
	SZA CLA
	JMP I	TTOCHR
	TAD	TOCHR
	SZA CLA
	JMP	.-2
	ISZ	DELAY		/GIVE TIME FOR "FAST" (>300 BAUD) VT05'S TO DO THE THING
	JMP	DLYLUP
	TAD	TTICHR
DLYFAC,	ISZ	TOCHR		/SET "BUSY"
	TLS
	TAD	KM212F
	SNA CLA
	TAD	DLYFAC		/DELAY FOR LINEFEED + DELAY LOOP MUST GIVE TOTAL DELAY OF 1/60 SEC
	CMA			/IF NOT LINEFEED, MAKE ISZ SKIP FIRST TIME
	DCA	DELAY
	JMP I	TTOCHR
DELAY,	0
KM212F,	-212
/RE: THIS DELAY STUFF...FIND UNCLE CHARLIE'S KITE IN TEWSKBURY...IT'S A LONG, SAD STORY
TTICHR,	0
	TAD	TICHR		/WAIT FOR CHAR
	SNA
	JMP	.-2
	DCA	TTOCHR
	DCA	TICHR
	TAD	TTOCHR
	JMS I	KWHYME		/WHY ME, WITH THIS NUMERIC KEYPAD THING?
TTEXIT,	JMP I	TTICHR
KWHYME,	WHYME
TICHR,	0
	IFNZRO TICHR-5077 <???> /ERROR RSYS
TOCHR,	0
TICTLC,	DCA I	(TF0		/TURN OFF "DO" MODE
	TAD	CTCFG		/^C DETECTED - IS IT INHIBITED?
	SMA SZA CLA
	JMP I	P7600		/NO
	AC7777			/YES - SET FLAG
	DCA	CTCFG
	JMP I	(DISMIS		/& RETURN
/
TSTRDR,	RSF			/WAS IT PTR?
	JMP	TSTPTP		/NOPE, TRY PUNCH
	TAD	TTI200
	RRB			/READ CHR, FORCE PARITY
	DCA	PICHR
TSTPTP,	PSF			/PUNCH?
	JMP	TSTTTI		/NO, TRY KBD
	PCF
	DCA	POCHR		/CLEAR FLAG TO SHOW DONE
	JMP I	(DISMIS
PPOCHR,	0
	DCA	TTICHR
	TAD	POCHR
	SZA CLA
	JMP	.-2
	ISZ	POCHR		/SET BUSY
	TAD	TTICHR
	PLS
	CLA
	JMP I	PPOCHR
POCHR,	0
PRICHR,	0
	DCA	TTICHR		/SET COUNTER = 0
	AC7775
	DCA	PPOCHR		/SET OUTER COUNTER TO -3
PTRWT,	TAD	PICHR		/GET CHAR BUFFER WORD
	SMA SZA
	JMP	PTRCHI		/POS MEANS CHAR
	SZA CLA
	JMP	PTRST		/NEG MEANS READER STOPPED
				/ZERO MEANS WAITING
	ISZ	TTICHR		/WAIT FOR CHAR
	JMP	PTRWT		/WITH TIMEOUT
	ISZ	PPOCHR		/TRY OUTER LOOP
	JMP	PTRWT		/KEEP WAITING
	AC4000			/OPPS - TIME 'S UP
	DCA	PICHR		/SET BUFFER NEG
	TAD	PTR232
	JMP I	PRICHR		/RETURN ^Z
PTRCHI,	DCA	TTOCHR
	DCA	PICHR
	RFC			/RESTART RDR
	TAD	TTOCHR
	JMP I	PRICHR		/RETURN CHAR
PTRST,	DCA	PICHR		/START RDR
	RFC
	JMP	PRICHR+1
PICHR,	4000			/SET INITIAL READER STATE AS "QUIET"
/
	PAGE

/CALLING SEQUENCE: SAME AS RDOIO, EXCEPT AC CONTAINS FIELD + DEVICE
/NUMBER, AND "ERROR" RETURN IS TAKEN FOR ^Z ON INPUT.
/DEVICE #S ARE:
/TTYIN = 0
/TTYOUT = 1
/CDR = 2
/PTP = 3
/PTR = 4
/LPT = 5
/NULLIN = 6
/NULOUT = 7
CDOIO,	0
	DCA	DEVNUM
	TAD	DEVNUM
	AND	P70
	TAD	PCDF
	DCA	LINFLD
	TAD I	CDOIO		/GET BUFFER ADDR-1
	ISZ	CDOIO
	IAC
	DCA	RECADR
	TAD	DEVNUM		/GET DEVICE #
	AND	P7	
	TAD	(TAD	DEVTBL
	DCA	DEVADR
DEVADR,	0			/PICK UP HANDLER ADDRESS
	DCA	DEVADR		/SAVE HANDLER ADDRESS HERE
	DCA	WRELC		/0
	TAD	DEVNUM		/HANDLER NUMBER
	RAR
	SNL CLA			/ODD OR EVEN?
	JMP	READC		/EVEN=READ DEVICES (KBD,PTR,CDR)
DOWR,	JMS	SETLDF		/GET CHAR FROM BUFFER
	TAD	RECADR
	JMS I	KGETC
WRELC,	0
	SNA
	JMP	WEOL		/0 RETURNED FOR END-OF-RECORD
	TAD	(237		/MAKE IT GENUINE ASCII
	JMS I	DEVADR		/OUTPUT IT TO TTY,LPT, OR PTP
	ISZ	WRELC		/BUMP REL. CHAR.
	JMP	DOWR
GOTCTU,	JMS	TCRLF
READC,	DCA	RRELC		/0
RAC,	CLA
	JMS I	DEVADR		/GET CHAR FROM KBD,PTR, OR CDR
	TAD	(-334
	SZA
	TAD	(-3
	SMA
	JMP	RAC
	TAD	(337-225
	SNA			/CTRL/U?
	JMP	GOTCTU
	TAD	(225-232
	SNA			/CTRL/Z?
	JMP	GOTCTZ
	TAD	(232-211
	SNA			/TAB?
	TAD	(123
	TAD	M4
	SNA
	JMP	GOTCR
	TAD	(-22
	SPA SNA			/LESS THAN 237 IS IGNORED
	JMP	RAC
	JMS	ECHO
	TAD	RRELC		/NOW SEE IF WE HAVE ROOM TO PUT IN NEXT CHAR
	CLL RAR
	CLL
	TAD	LENGTH
	SZL CLA
	JMP	TOOLNG		/BUFFER FULL!
	TAD	TEMP
	JMS	CDOPUT
	JMP	RAC		/READ NEXT CHAR
CRLF,	0
	TAD	(215
	JMS I	DEVADR
	TAD	(212
	JMS I	DEVADR
	JMP I	CRLF
WEOL,	JMS	CRLF		/AT END OF OUTPUT LINE
	ISZ	CDOIO
	JMP I	CDOIO
GOTCR,	ISZ	CDOIO		/BUMP EXIT RETURN HERE
	TAD	RRELC
	SNA CLA			/WATCH OUT FOR NULL LINES!
	JMS	CDOPUT		/(BUT NOT IF CTRL/Z)
TOOLNG,	TAD	RRELC		/GET BUMPED COUNT
	CIA			/NEGATE
	CLL CML RAR		/DIVIDE BY 2 TO GET WORD COUNT
GOTCTZ,	JMS	SETLDF		/--CDF BUFFER FIELD
	DCA I	RECADR		/PUT IN WORD COUNT
	CDF BASFLD
	JMS	TCRLF
	JMP I	CDOIO

ECHO,	0
	DCA	TEMP
	TAD	DEVNUM
	AND	(6
	IFNZRO TTYIN&7 <???> /ERROR - THIS TEST FOR ECHO WON'T WORK
	SZA CLA
	JMP I	ECHO
	TAD	TEMP
	TAD	(237		/CONVERT TO ASCII
	JMS I	TTYOUT
	JMP I	ECHO
SETLDF,	0
LINFLD,	0
	JMP I	SETLDF
CDOPUT,	0
	JMS	SETLDF		/--CDF RECORD FIELD
	JMS I	KPUTC
RECADR,	0			/RECORD ADDR.
RRELC,	0			/REL. CHAR.
	ISZ	RRELC
	JMP I	CDOPUT
DEVNUM,	0
TCRLF,	0
	TAD	(-22
	JMS	ECHO
	TAD	(-25
	JMS	ECHO
	JMP I	TCRLF
/
	PAGE

UNDEF,	0		/UNDEFINED LOGICAL UNIT JMS
	IFNZRO UNDEF-5400 <???> /ERROR
BADUNT,	CLA
	TAD	(ILUNT-1-INU+1
INUSE,	TAD	(INU-1
	DCA	ERP
	AC0001			/+1 FOR TTY
	JMS I	KCDOIO
ERP,	ILUNT-1			/"?ILLEGAL UNIT
KM12,	-12
	JMP I	(DOMES

/ROUTINE TO CONVERT OCTAL TO PACKED ASCII DECIMAL
/CALL WITH OCTAL # 0-143 IN AC AND "COUNT" =0
/EXIT WITH TWO 6-BIT ASCII DIGITS IN AC, 00-99.
/
OTOPD,	0
	DCA	TEMP
	DCA	COUNT
	TAD	TEMP
	ISZ	COUNT
	TAD	KM12		/-10 IN DISGUISE
	SMA
	JMP	.-3
	DCA	TEMP
	TAD	COUNT		/GET TENS
BSW007,	BSW			/CHANGES IF NON-8E
	TAD	TEMP		/AND ONES IN LOW HALF
	TAD	(2033		/MAKE ASCII
	JMP I	OTOPD
/
CLOSE,	0
	JMS I	KPTRST
	TAD I	W0
	SMA CLA
	JMP	CLOSRD
	TAD I	W3		/(-) # OF WORDS LEFT IN BUFFER
	AND	P7400
	CLL CML RAR		/DIV BY 2
	TAD	(200
	TAD I	W0		/MAKE W0 SHOW AMOUNT ACTUALLY USED
	DCA I	W0
	AC7776			/FUDGE W3
	DCA I	W3		/SO WE NEVER DO OUTPUT
	TAD	IFN
	JMS I	KRDOIO		/INSERT LENGTH OF 0 FOR EOF
	ZERO-1
	/NOTE - RDOIO WILL ALWAYS TAKE ITS ERROR RETURN HERE, SO TWO RETURN
	/POINTS ARE NOT NEEDED
	JMS	GPBUF		/OUTPUT LAST BUFFER.
	JMS I	(RDBLK0
	TAD I	W5		/SEE IF WE HAVE A PARTIAL SEGMENT
	AND	P7400
	SZA CLA
	ISZ I	W4		/IF SO, BUMP W4 TO SHOW IT
	AC4000
	JMS I	(RDBLK0
CLOSRD,	DCA I	W0
	DCA I	W1		/CLEAR UNIT WORD TO PREVENT "IN USE" MESSAGES
	JMP I	CLOSE

GPBUF,	0
	TAD I	W5		/SAVE REL. BLK BITS
	DCA	GTEMP
NOTLST,	TAD I	U1
	TAD I	W4
	DCA	HIBLKA
	TAD I	W0
	AND	(3600
	CLL RAL
	TAD I	W5		/UPDATE LOW REL. BLK BITS
	DCA I	W5
	SZL
	ISZ I	W4
	TAD I	W4
	TAD I	U2
	SZA CLA			/END OF UNIT?
	JMP	FULLOK		/NOT YET
	TAD I	W5		/GET LOW REL BLK BITS
	AND	P7400
	CLL RAR
	CIA
FULLOK,	TAD I	W0
	DCA	ARG1A
	TAD I	W1
	AND	P7600
	DCA	ARG2A
	TAD	GTEMP
	AND	P7400
	JMS I	HANDLR		/CALL THE CORRECT LOW-LEVEL HANDLER
ARG1A,	0
ARG2A,	0
HIBLKA,	0
	TAD I	W0		/BUMP W3 TO NEXT RELATIVE BLOCKS
	RAL
	AND	P7400
	CIA
	DCA I	W3
	TAD I	W1		/RESET W2
	AND	P7600		/TO THE BEGINNING OF THE BUFFER
	TAD	M1
	DCA I	W2
	JMP I	GPBUF

/ROUTINE TO MOVE CORE LOCATIONS AROUND.
/CALL:
/CDF	(FROM FIELD
/TAD	(-COUNT
/JMS	MOVE
/CDF	(TO FIELD
/"FROM" ADDR-1
/"TO" ADDR-1
/RETURN
/
GTEMP,
MOVE,	0
	DCA	COUNT
	JMS	CDFSET
	DCA	FRFLD
	TAD I	MOVE		/GET "TO" CDF
	ISZ	MOVE
	DCA	TOFLD
	TAD I	MOVE		/GET "FROM" ADDR-1
	ISZ	MOVE
	DCA	GETPNT
	TAD I	MOVE		/GET "TO" ADDR-1
	ISZ	MOVE
	DCA	PUTPNT
FRFLD,	HLT			/CDF FROM
	TAD I	GETPNT
TOFLD,	HLT			/CDF TO
	DCA I	PUTPNT
	ISZ	COUNT
	JMP	FRFLD
	CDF	BASFLD
	JMP I	MOVE		/DONE THE THING
CDFSET,	0
	RDF
	TAD	PCDF
	CDF 0
	JMP I	CDFSET
/
	PAGE

/ROUTINE TO GET AND PUT THINGS THAT LOOK LIKE DIBOL DATA RECORDS.
/THAT IS, WITH WORD COUNT FOLLOWED BY PACKED ASCII.  CALL:
/TAD	(FIELD+IFN
/JMS	RDOIO
/RECORD BUFFER ADDR-1
/EOF,EOS,EOU RETURN (EOF=0, EOS=+1, EOU=+2)
/OK RETURN
/END-OF-STRING AND END-OF-UNIT ARE IGNORED EXCEPT BY SORT.
/THE ONLY WAY YOU CAN GET AN EOU RETURN IS BY PATCHING "SRTFLG".
/
RDOIO,	0
/	CIA		/THIS OPTOMIZATION DOESN'T WORK WITH COMP!
/	TAD	TIFN
/	SNA			/DO WE NEED TO CALL PTRSET?
/	JMP	RDOREN		/IF NOT, DON'T
/	CIA
/	TAD	TIFN
	DCA	TIFN
	TAD	TIFN
	JMS I	KPTRST
RDOREN,	TAD I	W0
	SNA
	JMP	NOINIT
BS7700,	SMA CLA
	AC0002
	TAD	(DCA I	DOLIST
	DCA	DOSTOR
	TAD	TIFN
	AND	P70
	TAD	PCDF
	JMS	STORE		/CDF LINE BUFR
	TAD I	RDOIO
	JMS	STORE		/LOC OF LINE BUFR
	TAD I	W0
	AND	P70
	TAD	PCDF
	JMS	STORE		/CDF I/O BUFR
	TAD	DOSTOR
	DCA	RESTOR
	TAD I	W3
	SNA CLA			/BUFR EMPTY?
	JMS I	KGPBUF		/
	TAD I	W2
	JMS	STORE		/CURR. LOC'N CTR IN BUFR
	TAD	GETCDF
	DCA	.+1
	0
	TAD I	GETPNT		/GET WORD CNT
	DCA	COUNT
	CDF	BASFLD
	TAD I	W0
	SMA CLA			/READ OR WRITE?
	JMP	ITSOK		/IF READ, DON'T NEED TO CHECK FOR OVERFLOW
	TAD I	W1		/GET STARTING ADDR OF BUFFER
	AND	P7600
	TAD	COUNT		/SUBTRACT LENGTH OF NEXT RECORD
	TAD	M4		/4 FOR A SAFETY MARGIN
	CIA
	TAD I	W2		/GET INTERNAL BUFFER POINTER
	AND	P7400	/THIS GIVES NUMBER OF TOTALLY FILLED RECORDS WE'LL HAVE IF WE ADD NEXT LINE
		/*** NOTE - THIS IS ONLY APPLICABLE FOR OUTPUT
	CLL
	TAD I	W5
	CLA RAL
	TAD I	W4
	TAD I	U2
	SZA CLA			/WILL THE UNIT BE TOTALLY FILLED BY THIS LAST RECORD?
	JMP	ITSOK		/NO - ALL THOSE GROOVY CHECKS GONE TO WASTE
	AC7777
	DCA I	W3
	AC0002
	JMS	PUTBMP
	JMP	MTTRGN
ITSOK,	TAD	COUNT
	JMS	PUTBMP
	TAD	COUNT		/COUNT = +1 MEANS END-OF-STRING
	SMA
	JMP	GRUNKL		/IF >=0, A SPECIAL THINGIE
	CLL CML CIA
	TAD	LENGTH		/CHECK FOR OVERFLOW OF BUFFER
	SZL SNA CLA
	JMP	GETCDF
GRUNKL,	AC7776			/COUNT = +2 MEANS END-OF-UNIT
	TAD	COUNT
SRTFLG,	SZA CLA			/SET TO "CLA" BY PRESORT - SUPERKLUDGE!
	JMP	RDOIOE
MTTRGN,	JMS I	(MOUNT
	JMP	RDOREN		/RETRY
GETCDF,	HLT
	TAD I	GETPNT
	JMS	PUTBMP
ISZCNT,	ISZ	COUNT
	JMP	GETCDF
	ISZ	RDOIO
RDOIOE,	ISZ	RDOIO
	JMP I	RDOIO
STORE,	0
DOSTOR,	HLT			/DCA I DOLIST+N
	ISZ	DOSTOR
	JMP I	STORE

PUTBMP,	0
PUTCDF,	HLT
	DCA I	PUTPNT
	CDF	BASFLD
	ISZ I	W2		/MAY SKIP!!!!!!! (GUESS HOW WE KNOW)
	NOP
	ISZ I	W3
	JMP I	PUTBMP
	JMS I	KGPBUF
	TAD I	W2
RESTOR,	HLT			/DCA GETPNT OR DCA PUTPNT
	JMP I	PUTBMP
DOLIST,	GETCDF
	GETPNT
	PUTCDF
	PUTPNT
	GETCDF
	GETPNT
NOINIT,	AC0001			/+1 FOR TTY
	JMS I	KCDOIO
	NOIN-1
K377,	377
	JMP I	P7600
TIFN,
BSWX,	0			/IT WORKS AND PRESERVES THE LINK.
	DCA	PUTBMP
	RTR
	RTR
	RTR
	TAD	PUTBMP
	AND	BS7700
	TAD	PUTBMP
	RTL
	RTL
	RTL
	JMP I	BSWX
TTYCLR,	6302			/IOT CLEARS FOR EXTRA TERMINALS
	6322
	6342
	6362
	6402
	6422
	JMP I	(DISMIS
/
	PAGE

/TAD (BUFFER POINTER
/CDF (BUFFER FIELD
/JMS MGETC
/<RELATIVE CHARACTER#>
/<RETURN, CHAR IN AC OR 0 IF END OF RECORD OR LINE>
/MUST BE CALLED FROM FIELD 0, AND THE
/BUFFER CANNOT CROSS A FIELD BOUNDARY
MGETC,	0
	DCA	PUTC		/SAVE BUFFER POINTER
	JMS I	(CDFSET
	DCA	MGCDF
	TAD I	MGETC		/GET RELATIVE CHAR
	ISZ	MGETC
	CLL RAR			/FORM WORD NO.
	DCA	TEMP
	TAD	TEMP
	TAD	PUTC		/FORM POINTER TO WORD
	IAC			/SKIP OVER WORD COUNT
	DCA	GET
	TAD	TEMP		/RELATIVE WORD WE WANT
MGCDF,	HLT
	TAD I	PUTC		/GET WORD COUNT
	SPA CLA			/CHECK FOR GOING OFF END OF RECORD...SKP IF WE DO
	TAD I	GET		/GET THE CHAR
	SNL			/IF LINK=1, WANT RIGHT HALF
BSW008,	BSW			/CHANGES IF NON-8E
RGRR,	AND	P77
	CDF BASFLD
	JMP I	MGETC

/TAD (CHAR
/CDF (BUFFER FIELD
/JMS PUTC
/<BUFFER ADDRESS>
/<CHAR, #>
/<RETURN, AC=IF=DF=0>
/MUST BE CALLED FROM FIELD 0
/AND BUFFER CANNOT CROSS A FIELD BOUNDARY
PUTC,	0
	AND	P77
	DCA	TEMP		/SAVE CHAR
	JMS I	(CDFSET
	DCA	MPCDF
	TAD I	PUTC		/GET BUFFER ADDRESS
	ISZ	PUTC
	CLL RAL
	TAD I	PUTC		/GET CHAR #
	ISZ	PUTC
	RAR			/MAKE CHAR # INTO WORD#
	IAC			/BUMP PAST RECORD WORD COUNT
	DCA	PUT
MPCDF,	HLT
	SZL
	TAD I	PUT
	AND	(7700
	TAD	TEMP
	SNL
BSW009,	BSW			/SOME OF THESE MODS HAVE EGREGIOUS RESULTS
	DCA I	PUT
	CDF 0
	JMP I	PUTC
NOIN,	-6
	5760	/NO
	0152	/ I
	5752	/NI
	6501	/T
	4560	/DO
	5746	/NE
ILUNT,	-6			/"ILLEGAL UNIT"
	5255
	5546
	5042
	5501
	6657
	5265

/ENTER WITH IFN IN AC
/SETS W0-W5,U0-U2 TO POINT TO
/THE CORRECT TFT AND UT ENTRIES
/235 CYCLES EXCLUDING CALL
/
PTRSET,	0
	AND	P7
	DCA	IFN
	TAD	NOIN		/-6 IS WHAT COUNTS
	DCA	COUNT
	TAD	(W0-1
	DCA	PUTPNT
	TAD	(U0-4
	DCA	GETPNT
	CDF BASFLD		/"PROTECTION AGAINST R.L."  -RL
PTSETL,	TAD	IFN
	CLL RTL
	RAL
	TAD	IFN
	TAD	(FTBASE+6
	TAD	COUNT
	DCA I	PUTPNT
	TAD I	W1
	CLL RAL
	TAD I	W1
	AND	P77
	TAD	(UTBASE+3
	TAD	COUNT
	DCA I	GETPNT
	ISZ	COUNT
	JMP	PTSETL
	TAD I	U0		/NOW SET UP "HANDLR" FOR CORRECT LOW-LEVEL I/O
	AND	K7770
	DCA	HANDLR		/WITH PHYSICAL DEV. # REMOVED.
	TAD I	U0
	AND	P7		/GET PHYS. DEV.
	DCA	PUTC
	TAD I	W0
	AND	K7770		/PREPARE TO PUT IT HERE...
	TAD	PUTC
	DCA I	W0
	JMP I	PTRSET

/TAD	(IFN
/	JMS	INIT
/R/W,LENGTH,FIELD
/BUFFER
/LABEL POINTER-1
/<OK>
INIT,	0
	JMS	PTRSET		/U0-U2 AT THIS POINT WILL BE JUNK
	TAD I	INIT		/R/W,LEN,FIELD
	ISZ	INIT
	DCA I	W0
	TAD I	INIT
	ISZ	INIT
	DCA I	W1
	TAD I	INIT
	ISZ	INIT
	DCA	MVARG1
	TAD	W5
	DCA	MVARG2
	AC7775
	JMS I	KMOVE
	CDF	BASFLD
MVARG1,	0
MVARG2,	0
	DCA I	W5		/CLEAR SEQUENCE #
	TAD	IZERO		/SYSTEM PROGRAMS SET IZERO TO WHATEVER, IF
				/THEY ARE PRE-ASSIGNING LOGICAL UNITS
	JMS I	(MOUNT
	DCA	IZERO		/PROTECTION
	JMP I	INIT
IZERO,	0			/USUALLY 0, MAY BE SET TO A LOGICAL UNIT #
/
K7770,	7770			/SKP ... CLA
	/
	PAGE

/PERMANENT FILE TABLE
UTBASE=.
PF0,	SYSDEV+0;0;-56		/THREE WORDS FOR EACH
PF1,	DTA+1;0;-56
PF2,	DTA+2;0;-56
PF3,	DTA+3;0;-56
PF4,	DTA+4;0;-56
PF5,	DTA+5;0;-56
PF6,	DTA+6;0;-56
PF7,	DTA+7;0;-56
PF8,	UNDEF;0;0
PF9,	UNDEF;0;0
PF10,	UNDEF;0;0
PF11,	UNDEF;0;0
PF12,	UNDEF;0;0
PF13,	UNDEF;0;0
PF14,	UNDEF;0;0
PF15,	UNDEF;0;0

FTBASE=.
	IFNZRO FTBASE-6260 <???> /ERROR - EDIT
/TEMPORARY FILE TABLE
TF0,	0;0;0;0;0;0;0;0;0	/NINE WORDS FOR EACH
TF1,	0;0;0;0;0;0;0;0;0
TF2,	0;0;0;0;0;0;0;0;0
TF3,	0;0;0;0;0;0;0;0;0
TF4,	0;0;0;0;0;0;0;0;0

TF5,	0;0;0;0;0;0;0;0;0
TF6,	0;0;0;0;0;0;0;0;0
TF7,	0;0;0;0;0;0;0;0;0
SBT,	0;0;0;0;0;0;0;0	/RUNTIME FILE TABLE
/STARTING BLOCKS OF FILES SPECIFIED IN "RUN" COMMAND
/
/	- CAUTION...MONITOR (EDITOR) NEEDS TF TABLE NEXT TO SB TABLE

	IFZERO RKDISK <
	DLDC=6732
	DLWC=6753
	DLDR=6733
	DLCA=6755
	DSKD=6745
	DSKE=6747
	DKRE=7325
	DCLS=6742
	DRDS=6741
	DCLA=6751
	DRCA=6757
	DRDA=6734
	DRWC=6752
	0		/PROTECTION FOR SBT
RK4,	4
RKOVER,	ISZ	CTCFG		/RE-ENABLE CTRL/C
	JMP I	RK8
	JMP I	R87600		/CTRL/C TYPED WHILE INHIBITED - BOOTSTRAP
RKDLDR,	DLDR
RKCNT,	0
	4554			/"DK"
RK8,	BOOTRE
	IFNZRO RK8&7 <???> /ERROR - MUST START ON 10-WORD BOUNDARY
	DCA	RKLOW		/SAVE LO-ORDER ADDR
	DCA	CTCFG		/INHIBIT CTRL/C
	AC7775
	DCA	RKCNT		/# OF TRIES ON ERROR
RKRETR,	TAD I	RK8
	AND	RK4
	SZA CLA			/DON'T ALLOW UNIT #S .GT. 3
	JMP	RKBAD
	TAD I	RK8
	AND	R87
	TAD I	RK8
	AND	R877		/UNIT #*2+FIELD
	DLDC
	TAD I	RK8
	RAL
	AND	R87600
	SZA
	CIA
	DLWC			/LOAD WORD COUNT
	RTL
	TAD	RKDLDR
	DCA	RKINST		/READ (6733) OR WRITE (6735)
	ISZ	RK8
	AC7777
	TAD I	RK8
	DLCA			/LOAD CURRENT ADDRESS
	SZA CLA			/CHECK FOR NO DISK AT ALL
	JMP	RKBAD
	ISZ	RK8
	DCLS
	CLL
	DSKE			/CHECK FOR NON-EXISTENT DISK ERROR
	SKP
	JMP	RKBAD		/IT SURE IS
	TAD I	RK8
	TAD	RKLOW		/GET BLOCK ADDRESS
	TAD	RKLOW
	RTL
	RTL
	ISZ	RK8
RKINST,	6733			/GO!
RKINTL,	DSKD
	JMP	.-1		/& WAIT...
	DSKE
	JMP	RKOVER		/NO ERROR
	DRDS
	AND	RK4		/CHECK FOR TRACK OVERFLOW
	SZA CLA
	JMP	RKTKOV
	ISZ	RKCNT		/SOME OTHER ERROR - BADNESS
	JMP	RKOK
RKBAD,	TAD	RK8-1
	JMS I	RKIODI		/TRIED 3 TIMES - GO AWAY
	AC7775
	DCA	RKCNT
RKOK,	DRDS
	AND	RKP40		/TRACK SEEK ERROR?
	DCLS
	SNA CLA
	JMP	RKBACK
	DCLA			/YES - RECALIBRATE
	DSKD
	JMP	.-1
RKBACK,	AC7775
	TAD	RK8
	DCA	RK8
	JMP	RKRETR		/GO TRY AGAIN
RKTKOV,	DCLS
	DRDA
	AND	RK7760		/??
	TAD	RKP20		/BUMP TRACK NUMBER
	JMP	RKINST		/GO BACK & DO REST OF TRANSFER
RKLOW,	0
R87,	7
RKP20,	20
RKP40,	40
R877,	77
R87600,	7600
RK7760,	7760
RKIODI,	IODIE>

	IFNZRO RKDISK <
	DCLR=6742
	DLAG=6743
	DLDC=6746
	DRST=6745
	DSKP=6741
	DLCA=6744
CHKHED,	0
R3700,	3700			/"R3700" MUST BE AT RELATIVE LOCATION 201
KIODIE,	IODIE
GARG,	0
TRYRK,	0
R4077,	4077
PAGCNT,	0
RKCODE,	4554			/"DK"
RK8,	0			/MUST BE AT *6410
	DCA	GARG		/ENTER WITH LOW BLOCK BITS IN AC
	TAD I	RK8
	AND	RE7		/GET UNIT BITS
	TAD I	RK8		/MULTIPLY THEM BY 2
	AND	R4077		/AND GET R/W AND FIELD BITS
	DCA	RKECMD
	TAD I	RK8
	ISZ	RK8
R201,	AND	R3700		/GET # OF PAGES TO DO
	SNA			/0 IMPLIES 40...
	AC4000
	DCA	PAGCNT
	TAD I	RK8		/GET CURRENT ADDRESS
	ISZ	RK8
	DCA	RCA		/RCA IS A REGISTERED TRADEMARK OF RADIO CORPORATION OF AMERICA?
	DCA	CTCFG		/TURN OFF ^C
	TAD	GARG
	CLL RAL			/COMBINE HIGH + LOW BLOCK #
	TAD I	RK8
	ISZ	RK8
	RTL
	RTL
	DCA	GARG
	SZL			/CHECK FOR POSSIBLE "SUPER CYLINDER" BIT
R2,	ISZ	RKECMD		/IF IT IS THERE
R1,	DCA	CHKHED
RKRETR,	AC7775
	DCA	TRYRK
RELPX,	DCLR			/CLEAR STATUS
	TAD	RCA
	DLCA			/LOAD CURRENT ADDRESS
	TAD	PAGCNT
	AND	RE7600
	SNA CLA
	TAD	R201
	TAD	CHKHED
	CLL RAR
	TAD	RKECMD
	DLDC			/LOAD COMMAND REGISTER
	TAD	GARG		/NOW GET DISK ADDRESS
	DLAG			/AND START IT GOING
RKINTL,	DSKP
	JMP	.-1
	DRST			/GET STATUS
	CLL RAL
	SZA CLA
IFZERO EPOT+EPOT2 < JMP RKEBAD >		/OH WELL
IFNZRO EPOT+EPOT2 <XLIST	/PRINT THIS
JMP I KZEPO	/PRINT OUT REGISTERS
	XLIST>
	TAD	PAGCNT
	TAD	RE7600
	SPA SNA
	JMP	RKDONE
	DCA	PAGCNT
	TAD	RCA
	TAD	R400		/BUMP CURRENT ADDRESS
	DCA	RCA
	TAD	GARG
	CMA
	AND	RK37
	SZA CLA			/CHECK FOR NEW TRACK
	AC2000			/IF NOT, SET "DON'T CHECK HEADER"
	ISZ	GARG		/BUMP BLOCK #
	JMP	R1
	JMP	R2		/BUMP "SUPER CYLINDER" BIT IF BLOCK # OVERFLOWED 7777
RKEBAD,	DCLR			/RECALIBRATE
	AC0002
	DCLR
	DSKP
	JMP	.-1
	DCLR
	DRST
	SZA CLA
	JMP	.-2
KZZRT,	DCA	CHKHED		/RETURN FROM ERROR PRINTOUT
	IFZERO EPOT+EPOT2 <
	ISZ	TRYRK		/HAVE WE ALREADY TRIED THIS FOOLISHNESS ENOUGH?
	JMP	RELPX >		/'FRAID NOT
	IFNZRO EPOT+EPOT2 < XLIST	/PRINT THIS
	JMP	.+2 >
	IFNZRO EPOT <
KZEPO,	EPO 			/ADDRESS OF ERROR PRINTOUT
	XLIST >
	IFNZRO EPOT2 <
KZEPO,	EPO2 			/ADDRESS OF REGISTER EXAMINE
	XLIST >
	TAD	RKCODE
	JMS I	KIODIE		/TELL USER THE BAD NEWS
	JMP	RKRETR
RE7600,
RKDONE,	7600
	ISZ	CTCFG		/RE-ENABLE ^C
	JMP I	RK8
	JMP I	RE7600
RKECMD,	0
R400,	400
RK37,	37
RE7,	7
RCA,	0>

	*6540
/CARD READER TRANSLATION TABLE
/CHARACTERS ARE IN -240 CODE
/
CDTBL,	0021	/0001	/ 1
	2223	/0203	/23
	2425	/0405	/45
	2627	/0607	/67
	3031	/1011	/89
	3203	/1213	/:#
	4007	/1415	/@'
	3502	/1617	/="
	2017	/2021	/0/
	6364	/2223	/ST
	6566	/2425	/UV
	6770	/2627	/WX
	7172	/3031	/YZ
	7514	/3233	/],
	0577	/3435	/%_
	3637	/3637	/>?
	1552	/4041	/-J
	5354	/4243	/KL
	5556	/4445	/MN
	5760	/4647	/OP
	6162	/5051	/QR
	0104	/5253	/!$
	1211	/5455	/*)
	3374	/5657	/;\  (334=TAB)
	0641	/6061	/&A
	4243	/6263	/BC
	4445	/6465	/DE
	4647	/6667	/FG
	5051	/7071	/HI
	7316	/7273	/[.
	3410	/7475	/<(
	1376	/7677	/+^
/
	PAGE

	IFZERO TAPE <
DTAWC,	7754
	/NOTE! SYSGEN CHECKS WHAT SYSTEM TAPE IS BY LOOKING AT LOC. 6600...
	/SO DON'T CHANGE WITHOUT CONSULTING SYSGEN.
DTACA,	7755
DTBLOC,	0
DTANO,	0
DLOC,	6577
DERRCT,	-3
DFUN,	BOOTRE
	4565		/"DT"
DTA,	0
	IFNZRO DTA&7 <???> /ERROR - MUST BEGIN ON 10-WORD BOUNDARY
	DCA	GET
	TAD I	DTA
	DCA	DFUN		/SAVE ARGS
	ISZ	DTA
	AC7777
	TAD I	DTA
	DCA	DLOC
	ISZ	DTA
	TAD	GET
	CLL RAL
	TAD I	DTA
	RTL
	RTL			/COMPUTE BLOCK NO.
	CLL RAL			/& DOUBLE IT
	DCA	DTBLOC
	ISZ	DTA
DTATRX,	DCA	CTCFG		/INHIBIT ^C
	AC7775
	DCA	DERRCT
DTATRY,	TAD	DTAWC
	DCA I	DTACA		/PUT SEARCH BLOCK # IN WC
	TAD	DFUN
	AND	DT7		/GET UNIT #
	CLL RTR
	RTR
	TAD	(410		/SEARCH REVERSE, "GO" BIT OFF
	DTCA DTXA
	DTLB			/DECTAPE DF=0
DTGO,	TAD	(200		/"GO" BIT
DC,	SZL
	TAD	(400		/CHANGE SEARCH DIRECTION
	DTXA
	JMS	DTWAIT
	TAD	CTCFG
	SPA CLA
	JMP	DSTOP
	DTRA
	RTL
	CMA RTL			/DIRECTION IN LINK
	SNL CLA
	CML RTL			/SEARCH FOR BLOCK-2 IN REVERSE
	TAD I	DTAWC
	CIA
	TAD	DTBLOC
	SNA CLA
	SZL CLA
	JMP	DC
	TAD	DLOC
	DCA I	DTACA		/SET CA TO BUFR-1
	TAD	DFUN
	DTLB			/LOAD BUFFER DF
	TAD	DFUN
	CLL RAL
	AND	DT7600
	DCA	DBLKCT
	RAL
	IAC
	CLL CML RTL
	RTL			/30 FOR READ, 50 FOR WRITE
DL,	DTXA
	TAD	DT7600
	DCA I	DTAWC		/WC = -200
	JMS	DTWAIT
DTOK,	TAD	DBLKCT		/BUMP BLOCK COUNT
	TAD	DT7600
	SNA
	JMP	DSTOP
	DCA	DBLKCT
	JMP	DL
DERR2,	ISZ	DERRCT
	JMP	DTATRY
	TAD	(200		/STOP TAPE
	DTXA
	TAD	DTA-1
	JMS I	(IODIE		/FATAL ERROR
	JMP	DTATRX
DSTOP,	CDF	BASFLD
	TAD	(200
	DTXA			/STOP TAPE
	ISZ	CTCFG		/RE-ENABLE ^C
	JMP I	DTA
	JMP I	DT7600
DTWAIT,	0
DTINTL,	DTSF DTRB
	JMP	.-1
	SMA CLA
	JMP I	DTWAIT
	DTRB
	RTL
	RAL			/END ZONE IN LINK, SELECT IN 0
	SNL SMA CLA
	JMP	DERR2		/NEITHER - A BADDIE
	SZL CLA
	JMP	DTGO
	TAD	DFUN
	AND	DT7
	TAD	D0121
	DCA	DBLKCT
	CDF	BASFLD
	ISZ	CTCFG
	SKP
	JMP I	DT7600
	DCA I	KCTRLO		/MAKE SURE TTY IS ON
	AC0001
	JMS I	KCDOIO
	DTMSG-1
D0121,	0121
	JMS I	TTYIN
DT7600,	7600
	JMP	DTATRX
DT7,	7
DTMSG,	-3
	4565
DBLKCT,	0
	4000
/
	PAGE>

	IFNZRO TAPE&1 <
/TD8E SUBROUTINE FOR EDP-8
/SUPPORTS UP TO 8 UNITS; RUNS WITH INTERRUPTS  O F F !!!
/
	TD7=	P7
	TD7600=	P7600
	TD70=	P70
	TD77=	P77
	*6600
C100,	100		/MUST BE FIRST LOCATION ON PAGE ! ! !
	/NOTE! SYSGEN CHECKS WHAT SYSTEM TAPE IS BY LOOKING AT LOC. 6600...
	/SO DON'T CHANGE WITHOUT CONSULTING SYSGEN.
M20,	-20
PGCT,	0
TRYCNT,	0
BLOCK,	0
C1000,	1000
C3,	3
C4565,	4565
DTA,	0
	IFNZRO DTA&7 <???> /ERROR
	DCA	BLOCK		/SAVE LOW BLOCK BITS
	IOF			/NOTE WELL, YE FOOLS WHO WOULD TRY TO KEEP INTERRUPTS ON!
	TAD I	DTA		/GET FUNCTION WORD
C6775,	SDLD			/LOAD DATA REGISTER (AS TEMP. STORAGE)
	AND	TD7		/EXTRACT UNIT #
	CLL RAR
	DCA	TDCTRL
	RAR			/GET ODD-EVEN UNIT BIT
	DCA	UBIT
	TAD	TDCTRL		/REGET SHIFTED FUNCTION WORD
	CLL CMA RTL
	RAL			/PERFORM MAGIC
	TAD	C6775		/SUBTRACT UNIT BITS, BUT THIS REALLY SETS UP A MAGIC #
	DCA	TDCTRL
	TAD	TDPTR		/POINTER TO LIST OF THINGS TO CHANGE
	DCA	TDIOTT
	TAD	TDNMBR		/GET # OF IOT'S TO CHANGE
	DCA	TDIOTC
TDIOTL,	TAD I	TDIOTT		/GET ADDR
	DCA	TDIOTP
	TAD I	TDIOTP		/GET IOT
	AND	TD7		/JUST THE UNIQUE PART
	TAD	TDCTRL		/MAKE PROPER IOT FOR GIVEN PAIR OF UNITS
	DCA I	TDIOTP		/RESAVE
	ISZ	TDIOTT
	ISZ	TDIOTC		/DONE?
	JMP	TDIOTL		/NO
	ISZ	DTA
	TAD I	DTA		/GET CORE ADDR
	DCA	BUFF
	ISZ	DTA
	TAD	BLOCK		/GET LOW BLOCK BITS
	CLL RAL
	TAD I	DTA		/GET HIGH BLOCK BITS
	RTL
	RTL
	RAL
	DCA	BLOCK
	ISZ	DTA		/POINT TO GOOD EXIT
	SDRD			/READ DATA REG. (= FUNCTION WORD, RIGHT NOW)
	CLL RAL
	AND	TD7600
	DCA	PGCT		/SAVE # OF BLOCKS TO READ
	SDRD
	AND	TD70		/GET BUFFER FIELD
	TAD	PCDF
	DCA	XFIELD
	SDRD
	DCA I	KTDTEM		/SAVE FUNCTION WORD
TDRETR,	AC7775
	DCA	TRYCNT		/3 TIMES ON ERROR
	JMS	SDLCX		/LOAD COM. REG. WITH ODD-EVEN UNIT BIT
CHG1,	SDRC			/READ COM. REG.
C200,	AND	C100		/CHECK FOR SELECT ERROR
	SZA CLA
	JMP I	TDHANG		/YUP
TDGOBA,	CLA CLL CML RTR		/2000 - TURN ON REVERSE MOTION
	JMP	GO		/WHEN WE GO TO GO
NXTREC,	TAD	PGCT
	TAD	TD7600
	SNA
	JMP	TDEXIT
	DCA	PGCT
	ISZ	BLOCK
	TAD	C200
	TAD	BUFF
	DCA	BUFF
GO,	TAD	C1000		/LOAD GO BIT
	JMS	SDLCX		/AND UNIT BIT (ODD-EVEN) INTO COM. REG.
	JMS I	CRDQUD		/SKIP QUAD LINE FLAG
	JMS I	CRDQUD
SRCH,	JMS I	CGTLIN		/SKIP LINE, READ COM. REG., ROTATE AC
	TAD	M110		/CHECK FOR END ZONE
	SNA
	JMP	TDENDZ		/WE GOT IT
	TAD	M20		/MAYBE A BLOCK MARK?
	SZA CLA
	JMP	SRCH		/NEITHER...KEEP GOING
CHG2,	SDRD			/READ DATA REGISTER
	SZL			/RIGHT DIRECTION?
	TAD	C3		/LINK = MOTION BIT (1 = REVERSE)
	CMA
	TAD	BLOCK		/LOOK FOR BLOCK-3 WHEN GOING IN REVERSE
	CMA
	SNA
	JMP	TDFOUND
M110,	SZL SNA CLA		/GOING IN THE RIGHT DIRECTION TO EVER FIND IT?
	JMP	SRCH		/YES, KEEP GOING
TDENDZ,	SDRC
	RTL			/DIRECTION BIT IN LINK
	CLA CML RTR		/
	JMP	GO		/TURN AROUND
IFZERO EPOT2<
TRY3,	ISZ	TRYCNT>		/NO, GOING FORWARD, SO IT'S A BADDIE
IFNZRO EPOT2< XLIST
TRY3,	JMP I	CIODIE		/GO HLT TO EXAMINE COMMAND REGISTER
	XLIST >
	JMP	TDGOBA		/REV. AND TRY AGAIN
	JMS	SDLCX		/FATAL ERROR, STOP TAPE
	ION
	TAD	C4565		/"DT"
	JMS I	CIODIE
	JMP	TDRETR
TDEXIT,	JMS	SDLCX		/GOOD EXIT, STOP TAPE
	ION
	JMP I	DTA
SDLCX,	0
	TAD	UBIT
CHG3,	SDLC
	JMP I	SDLCX
TDPTR,	TDIOTS
TDNMBR,	TDIOTS-TDIOTE
CRDQUD,	RDQUAD
CGTLIN,	GTLIN
IFZERO EPOT2<
TDHANG,	TDMESG>
IFNZRO EPOT2< XLIST
TDHANG,KZTAP3
	XLIST >
BUFF,	0
KTDTEM,	TDTEMP
UBIT,	0
IFZERO EPOT2<
CIODIE,	IODIE>
IFNZRO EPOT2< XLIST
CIODIE,	KZTAP2
	XLIST >
*6774
TDFOUN,	SZL CLA			/MUST BE GOING FORWARD
	JMP	SRCH		/KEEP GOING IN REVERSE
	TAD	BUFF
XFIELD,	HLT			/CDF BUFFER FIELD
TDIOTT=TRYCNT
TDIOTP=XFIELD
TDIOTC=PGCT
TDCTRL=BUFF

*7000
	DCA	XBUFF
	TAD	TD7600
	DCA	WORDS
REVGRD,	JMS	GTLIN		/GET A MARK WORD
	TAD	CM150		/REV GUARD = 32
	SZA CLA
	JMP	REVGRD		/YUP
	TAD	TDTEMP		/GET FUNCTION WORD
TD7700,	SMA CLA
	JMP	TDREAD		/DO A READ
TDWRIT,	SDRC			/TEST FOR WRITE LOCK OR SELECT ERROR
	AND	C300
	SZA CLA
	JMP I	CTDMESG
	JMS	RDQUAD		/WAIT 4 LINES
	CLA
	TAD	C1400		/TURN ON WRITE
	JMS I	CSDLCX
	AC7777			/WRITE 7777 IN REV. CHECKSUM
	JMS	WRQUAD
	AC7777
	DCA	CHKSUM		/ALSO IN SOFTWARE CHECKSUM
WRLP,	TAD I	XBUFF		/GET DATA FROM BUFFER
	JMS	WRQUAD
	ISZ	XBUFF
C374,	374
	ISZ	WORDS		/DONE?
	JMP	WRLP		/NOPE
	JMS	WRQUAD		/FILL 129TH WORD
	JMS	GETCHK		/DIDDLE CHECKSUM
	JMS	WRQUAD		/& WRITE
	JMS	WRQUAD		/... TWICE FOR GOOD MEASURE
	JMP	RWCOM		/CHECK FOR MORE BLOCKS TO DO
TDREAD,	JMS	RDQUAD
	JMS	RDQUAD
	JMS	RDQUAD
	AND	TD77
	TAD	TD7700
	DCA	CHKSUM		/STORE REVERSE CHECKSUM
RDLP,	JMS	RDQUAD		/GET DATA WORDS
	JMS	EQUFUN		/EQUIVALENCE CHECKSUM THEM (?)
	DCA I	XBUFF		/& SAVE
	ISZ	XBUFF
C300,	300
	ISZ	WORDS
	JMP	RDLP
	JMS	RDQUAD		/129TH WORD TO SKIP
	JMS	EQUFUN
	JMS	RDQUAD		/GET TAPE CHECKSUM
	AND	TD7700
	JMS	EQUFUN
	JMS	GETCHK		/GET TOTAL CHECKSUM
RWCOM,	CDF	BASFLD
CHG10,	SDST
	SZA CLA
	JMP I	CTRY3
	JMP I	CNEXTR
WRQUAD,	0
	JMS	EQUFUN
CHG4,	SDSQ
	JMP	.-1
CHG5,	SDLD
	CLA
	JMP I	WRQUAD
RDQUAD,	0
CHG6,	SDSQ
DTINTL,	JMP	.-1
CHG7,	SDRD
	JMP I	RDQUAD
EQUFUN,	0			/TAKE THIS ONE ON FAITH
	CMA
	DCA	EQUTMP
	TAD	EQUTMP
	AND	CHKSUM
	CIA
	CLL RAL
	TAD	EQUTMP
	TAD	CHKSUM
	DCA	CHKSUM
	TAD	EQUTMP
	CMA
	JMP I	EQUFUN
GETCHK,	0			/COMPUTE CHECKSUM
	CLA
	TAD	CHKSUM
	CLL CMA RTL
	RTL
	RTL
	JMS	EQUFUN
	CLA
	TAD	CHKSUM
	AND	TD7700
	JMP I	GETCHK		/AC =0, WE HOPE!
GTLIN,	0
CHG8,	SDSS
	JMP	.-1
CHG9,	SDRC
	CLL RTL
	AND	C374
	JMP I	GTLIN
IFZERO EPOT2 <
CTDMES,	TDMESG
CTRY3,	TRY3>
IFNZRO EPOT2 < XLIST
CTDMES,	KZTAP3
CTRY3,	KZTAP1
	XLIST  >
CNEXTR,	NXTREC
CSDLCX,	SDLCX
CM150,	-150
C1400,	1400
CHKSUM,	0
WORDS,	0
XBUFF,	0
TDTEMP,	0
EQUTMP,	0
TDIOTS,	CHG1
	CHG10
	CHG2
	TDENDZ
	CHG3
	TDWRIT
	CHG4
	CHG5
	CHG6
	CHG7
	CHG8
	CHG9
TDIOTE=.
PAGE>

	IFNZRO TAPE&2 <
LTP14,	14		/MUST BE FIRST LOCATION ON PAGE!!!
	/NOTE! SYSGEN CHECKS WHAT SYSTEM TAPE IS BY LOOKING AT LOC. 6600...
	/SO DON'T CHANGE WITHOUT CONSULTING SYSGEN.
	IFNZRO LTP14&177 <???> /ERROR
P30,	30
LTAXO,	30
LT129,	0
LTLOC,	6600
LTFUN2,	-3
LTNMBL,	-5
	4565			/"DT"
DTA,	BOOTRE			/LINCTAPE HANDLER
	IFNZRO DTA&7 <???> /ERROR - MUST BE ON 10-WORD BOUNDARY
	CLL RAL			/ENTER WITH LOW BLOCK BITS IN AC
	DCA	LTBLK
	DCA	CTCFG		/TURN OFF ^C
	TAD I	DTA		/GET R/W,LEN,FIELD,UNIT
	ISZ	DTA
	DCA	LTFUN
	TAD	LTFUN
	AND	LT70
	TAD	PCDF
	DCA	LTBUFR		/IN PREPARATION FOR SAVING 129TH WORD
	TAD I	DTA		/GET BUFR ADDR
	ISZ	DTA
	DCA	LTLOC
	TAD I	DTA		/GET HI BLOCK BITS
	ISZ	DTA
	TAD	LTBLK		/ADD IN LOW
	RTL			/GRUNGLE
	RTL
K4,	RAL			/MULT 256-WORD BLK NO. BY 2
	DCA	LTBLK		/=START 129-WORD BLK
	TAD	LTFUN
	AND	LT7
	CLL RAR
	TAD	P30		/XA, NP
	DCA	LTAXO
	TAD	LTFUN
	RTL
	RTL
LTP200,	AND	LTP14
	TAD	(702
	DCA	LTOP		/RDE OR WRI
	TAD	LTFUN		/GET # OF BLKS TO DO
	CLL RTL			/INTO BITS 8-11
	RTL
	RTL
	DCA	LTFUN2		/WE NEED THIS SETUP LATER
	TAD	LTFUN2
	AND	LT17		/JUST GET THE COUNT OF 256-WORD BLOCKS
	RAL			/MULT BY 2 FOR 128-WORD BLOCKS (AND GET LINK, MAYBE, FOR EXTRA 128 WORDS)
	SNA			/0 IMPLIES 40
	TAD	LT40
	CIA
	DCA	LTNMBL		/=BLOCK COUNT
	TAD	LTFUN2		/WE SAVED THIS FOR A REASON, REMEMBER?
	AND	(7000		/TO GET THE FIELD BITS
	TAD	LTAXO
	DCA	LTFUN		/THIS IS THE WORD FOR THE AXO NOW
LTBUFR,	HLT			/BECOMES CDF BUFFER
LTLOOP,	TAD	LTLOC
	TAD	LTP200
	DCA	LTFUN2		/A TEMPORARY TEMPORARY
	TAD I	LTFUN2		/GET BUFFER 129TH WORD
	DCA	LT129		/& SAVE IT
LTREDO,	AC7775
	DCA	LTFUN2		/3 TRIES ON ERROR
LTTRY,	TAD	LTLOC
	CIF 0			/INHIBIT INTERRUPTS WITHOUT TURNING THEM OFF
	6141	/LINC		/FOR THIS MODE
	0023	/TMA
	1020	/LDA I
LTFUN,	30
	0001	/AXO
LTOP,	702			/"RDE" OR "WRI"
LTBLK,	53			/BLOCK #
LTWAIT,	0002	/PDP
DTINTL,	CLA
	TAD	(100
	6151			/STD (WAIT FOR TAPE)
	JMP	.-3
	CIF 0			/RE-DISENABLE INTERRUPTS AGAIN
	6141	/LINC

LTCKSM,	0003	/TAC		/GET CHECKSUM (7777=OK)
	0002	/PDP
	DCA	LTAXO
	TAD	LTOP
	AND	K4		/SEE IF RDE OR WRI
	SZA CLA
	JMP	LTOK		/IGNORE FALSE CHECKSUMS ON WRITES
				/(WHAT "TAC" GIVES YOU IS JUST JUNK)
	ISZ	LTAXO
	JMP	LTBAD		/ERROR!
LTOK,	TAD	LTP200
	TAD	LTLOC		/BUMP CORE LOC
	DCA	LTLOC
	ISZ	LTBLK		/BUMP BLOCK #
	TAD	CTCFG
	SPA CLA
	JMP	LTID0		/^C TYPED
	ISZ	LTNMBL		/DONE ALL?
	JMP	LTBUFR		/NOPE
LTEXIT,	TAD	LT129		/GET 129TH WORD WE SAVED
	DCA I	LTLOC		/RESTORE IT
LTCDEX,	CDF	BASFLD
	ISZ	CTCFG
	JMP I	DTA
LTID0,	CDF	BASFLD
	JMP I	LT7600
LTBAD,	ISZ	LTFUN2		/TRIED 3 TIMES?
	JMP	LTTRY
	CDF	BASFLD
	TAD	DTA-1
	JMS I	(IODIE
	JMP	LTREDO
LT17,	17
LT7600,	7600
LT7,	7
LT40,	40
LT70,	70
/
	PAGE>

/ * * * * * L I N E  P R I N T E R  B U F F E R * * * * *
/
/IS 7020-7377, OR THIS MAY BE PART OF TD8E HANDLER AREA
/
/IF TD8E, TD8E ROUTINE OCCUPIES 6600-7177, 7340-7377
/
/LINE PRINTER BUFFER IS THEN 7220-7337
/IF ANELEX (TYPE 645) PRINTER IS IMPLEMENTED,
/
/THERE IS NO RING BUFFER.
/
TMOUNT,	-17
	5660
	6657
	6501
LBL1,	0
LBL2,	0
LBL3,	0
	0104
SEQ,	0
	0101
	4760
	6301
IORO,	0
	0
	6665
	3301
	LPBUFR=.

	IFNZRO TAPE&1 <
	*7340
LPBFND,	LPBUFR		/LPT RING BUFFER POINTER
TDMESG,	RDF
	TAD	.+1
	CDF 0
	DCA	TDCDEX
	TAD I	RNDIOT		/TO GET UNIT # FROM
	CLL CMA RTR
	RTR
	TAD I	TDUBIT
	RTL
	AND	P7
	TAD	TD121
	DCA	TDUNIT
	IFZERO EPOT <
	JMS I (SDLCX >		/STOP TAPE
	IFNZRO EPOT <
	JMS I (KDTA >	/NO TAPE HANDLER IF EPOT=1
	ION
	DCA I	KCTRLO		/MAKE SURE TTY IS ON
	CLA IAC
	JMS I	KCDOIO
	TDM-1
TD121,	121
	JMS I	TTYIN
	IOF
TDCDEX,	0
	IFZERO EPOT <
	JMP I	(TDRETR		/TDRETR CLEARS AC
RNDIOT,	CHG1			/AS GOOD AS INY
TDUBIT,	UBIT >
	IFNZRO EPOT <
	JMP I	(KDTA		/HALT NO TAPE HANDLER
RNDIOT,	0
TDUBIT,	0 >
TDM,	-3
	4565
TDUNIT,	0
	4000>
	IFZERO TAPE&1 <
	*7377
LPBFND,	LPBUFR>
	*LPBUFR
	ZBLOCK LPBFND-.
	LPSIZE=LPBFND-LPBUFR-1

	*7400
/WATCH LITERALS IN THIS PAGE ! ! !
/SEE TAG "CD1377"
/
/
/
 
INTRPT,	DCA	INTAC		/SAVE AC
GETLNK,	CLA RAR			/NOW GET LINK TO SAVE
	DCA	INTLNK		/& LINK
TSTCDR,	RCSF			/SKIP COLUMN READY
	JMP	TSTCD2
	RCRA			/READ COLUMN, APLHA MODE
	DCA	CDCODE		/SAVE
	ISZ	CDCOLF		/SET SOFTWARE FLAG
	JMP	DISMIS
TSTCD2,	RCSD			/SKIP CARD DONE
	JMP	TSTLPT		/TRY LPT
	RCRD			/CLEAR FLAG
	AC4000
	DCA	CDONFG		/SET CARD JUST DONE
DISMIS,	TAD	INTLNK
	CLL RAL
	TAD	INTAC
	RMF
	ION
	JMP I	0
CDONFG,	0
LPDNFG,	0			/LPT DONE
	IFNZRO LPDNFG-7425 <???> /ERROR RSYS
TSTLPT,	CLA			/NECESSARY
	LSF			/LPT?
	JMP I	KTSTRD		/NO, TRY PTR
	IFZERO LP645 <
	TAD	LPCHCT
	SMA CLA			/IGNORE PRINTER FIDDLING BY OPERATOR
	JMP	LPTLCF
	ISZ	LPCHCT
	JMP	LPMORE
	AC7777
	DCA	LPDNFG		/SET LPT DONE FLAG FOR SPECIAL RSYS GROOVINESS
LPTLCF,	LCF
	JMP	DISMIS
LPMORE,	ISZ	LPGETP
	TAD I	LPGETP
	SPA
	DCA	LPGETP
	CLA
	TAD I	LPGETP		/GET NEXT CHAR FROM BUFR...
	LLS			/& PRINT IT
LPSIZ,	LPSIZE
	JMP	TSTCD2
LPOCHR,	0			/OUTPUT CHAR ON LP08
	CDF 0			/PROTECTION AGAINST THE WORLD
IFNZRO EPOT2 <XLIST>
	AND	CD1377
IFNZRO EPOT2 <XLIST>	/PRINT THIS OUT 
	DCA I	LPPUTP
LPFULP,	CLA IAC			/FOR BENEFIT OF CENTRONICS HACK
	LIE			/ENABLE LP08 INTERRUPT
	TAD	LPCHCT
	TAD	LPSIZ
	SNA CLA			/IS LPT BUFFER FULL?
	JMP	LPFULP		/YES - WAIT
	CIF 0			/NO INTERRUPT FOR DELICATE STUFF
	DCA	LPDNFG		/FIX ELUSIVE BUG
	AC7777 CLL
	TAD	LPCHCT
	DCA	LPCHCT		/BUMP CHAR  COUNT
	TAD I	LPPUTP
	SNL			/LINK OFF MEANS PRINTER QUIET
	LLS
	SZL CLA
	ISZ	LPPUTP
	TAD I	LPPUTP
	SPA
	DCA	LPPUTP
	CLA
	JMP I	LPOCHR
LPPUTP,	LPBUFR+1
LPGETP,	LPBUFR
LPCHCT,	0>

	IFNZRO LP645 <
	6652
	DCA	LPFLAG
	JMP	DISMIS		/SET "LINE IS PRINTED" PLAG
LPM3,	-3			/THE ENTRY POINT "LPOCHR" MUST BE IN THE SAME SPOT
LPM212,	-212			/FOR BOTH THE LP08 AND ANALEX HANDLERS - SO WATCH IT, STUPID!
LPM204,	-204
CHRCNT,	-204
FINLPB,	TAD	FORMC
FORMCT,	IOF
	ISZ	LPFLAG
	TAD	P17
	6652
	6664			/DUMP HARDWARE LINE BUFFER
	ION
	TAD	LPM204
	DCA	CHRCNT
	JMP I	LPOCHR
FORMC,	-7
LPOCHR,	0
	DCA	CDICHR		/MAKE SURE THIS IS AT SAME PLACE AS IN LP08 HANDLER!!!!!
	TAD	LPFLAG
	SZA CLA			/ARE WE IN THE PROCESS OF PRINTING A LINE?
	JMP	.-2		/CHUG, CHUG, WE ARE
	TAD	CDICHR
	TAD	LPM212
	SNA
	JMP	FINLPB
	TAD	LPM3
	SNA
	JMP I	LPOCHR		/IGNORE CARRIAGE RETURNS
	IAC
	SNA CLA
	JMP	FORMCT		/GOT A FORMFEED
	TAD	CHRCNT
	SNA CLA
	JMP I	LPOCHR
	TAD	CDICHR		/RESTORE ORIGINAL CHAR
	6654			/PUT IT IN HARDWARE LINE BUFFER (10 USEC)
	ISZ	CHRCNT
	JMP I	LPOCHR
LPFLAG,	0
	JMP I	LPOCHR
	0;0;0;0		/FILL>

/CDCOLF=0 - COLUMN NOT READY
/CDCOLF=1 - COLUMN IS IN
/CDONFG=0 - START A CARD IN MOTION
/CDONFG=1 - A CARD IS IN MOTION
/CDONFG=- - CARD IS JUST FINISHED (CARD DONE)
/THIS RETURNS ONE CHARACTER (I.E., ONE COLUMN) AT A TIME,
/SO YOU HAVE TO FETCH CHARACTERS FAST ENOUGH TO KEEP UP WITH IT.
/
IFZERO EPOT2<
CDICHR,	0
	TAD	CDTIME		/THIS CAN BE "TAD M4" ON ANYTHING BUT AN 8/E...
	DCA	CDTEMP 		/FOR TIMEOUT LOOP LATER (CHEAP CDR!)
		/SEE END OF LISTING FOR CODE ASSEMBLED FOR ERROR CHECK
CDRETR,	TAD	CDONFG
	SZA
	JMP	CDGO		/CARD IS MOVING
	DCA	CDCOLF		/SET "COLUMN NOT IN YET"
	ISZ	CDONFG		/SET "CARD IN MOTION"
	RCSE			/START CARD MOVING, SKIP IF OK
	JMP	CDCTZ		/NOT OK (OUT OF CARDS, OR TURNED OFF)
CDGO,	SMA CLA		/
	JMP	CDMVNG		/CARD IS IN MOTION
	DCA	CDONFG		/SET "CARD STOPPED"
CD1377,	TAD	(215		/RETURN CR FOR END-OF-CARD CONDITION
				/! * ! * WATCH IT! LITERAL 215 MUST BE AT REL. LCO. 377 ! * !
	JMP I	CDICHR
CDMVNG,	TAD	CDCOLF
	SNA CLA			/WAIT FOR COLUMN TO COME IN
	JMP	CDPOOR		/WAIT FOR CARD DONE, COLUMN DONE, OR ELSE WAIT
			/AROUND LONG ENOUGH TO DECIDE SOMETHING IS WRONG 
			/AND WE MIGHT AS WELL QUIT
	DCA	CDCOLF		/SET COLUMN NOT READY AGAIN
	TAD	CDCODE		/GET 6-BIT COLUMN CODE
	CLL RAR
	TAD	KCDTBL		/ADD BASE OF TRANSLATION TABLE
	DCA	LPOCHR		/CONVENIENT TEMPORARY TEMPORARY
	TAD I	LPOCHR		/GET THE ASCII TRANSLATION
	SNL			/LINK TELLS WHICH HALF
	JMS I	BSWPTR		/CANNOT BE IN TABLE 'CAUSE FGBG OVERLAYS THIS
CDAND,	AND	P77		/& GET 6 BITS
	TAD	CD240		/TABLE IS IN -240 ASCII
	JMP I	CDICHR		/EXIT WITH CHAR
CDPOOR,	ISZ	LPOCHR		/"CDPOOR" FOR POOR DESIGN OF CDR...
	JMP	CDRETR
	ISZ	CDTEMP
	JMP	CDRETR
CDCTZ,	DCA	CDONFG		/SET CARD DONE
	TAD	P7		/RING BELL ON END OF CARD DECK
	6046			/WE CAN DO THIS OK, SINCE WE'VE WAITED
CDTIME,	SPA SNA SZL CLA >		/WILL IT SKIP? WHO KNOWS! BUT IT'LL CLEAR AC
IFNZRO EPOT2 <*7554>
CD232,	232
	JMS I	TTYIN
	TAD	CDM232		/LOOK FOR ^Z TO END DECK
	SZA CLA
	JMP	CDICHR+1	/ANYTHING ELSE TRIES TO READ MORE
	TAD	CD232		/RETURN ^Z FOR END-OF-DECK
	JMP I	CDICHR
/
INTAC,	0
INTLNK,	0
KTSTRD,	TSTRDR
KCDTBL,	CDTBL
CDM232,	-232
CDCODE,	0
CDCOLF,	0
CD240,	240 
/
CDTEMP,
NULLIO,	0
	SNA CLA
	TAD	CD232
	JMP I	NULLIO 
	PAGE
/
IFNZRO EPOT2 < XLIST
/REPORT ERRORS IN RK8E,CAUSE CPU HALT WITH
/DISK REGISTERS IN AC
/ALSO CHANGE LOCATION 7455 SINCE CD1377 CHANGED ADDRESS
/THIS IS A HAND PATCH ONLY, ASSEMBLE ONLY FOR READING OCTAL
*7507			/OR SAME LOCATION AS CDICHR
			/IS FOR CARD READER HANDLER
CDICHR,	0
	TAD	KZ232
	JMP I	CDICHR		/RETURN ^Z FOR END-OF-DECK
EPO2,	DRST
	HLT	/STATUS REG IN AC
	CLA
	TAD I	KPAG	/COMPUTE COMMAND REG,SAME
	AND	KZ7600	/WAY AS IN DISK ROUTINE
	SNA CLA
	TAD I	KR201
	TAD I	KCHK
	CLL RAR
	TAD I	KRKEC
	HLT
	CLA
	TAD I	KGARG	/GET DISK ADDRESS
	HLT
	CLA
	JMP I	KKZZR
KZ232,	232
KZ7600,	7600
KPAG,	PAGCNT
KGARG,	GARG
KR201,	201
KCHK,	CHKHED
KRKEC,	RKECMD
CD1377,	1377
KKZZR,	KZZRT 
	XLIST
/
	PAGE > 

	*3200
	NOPUNC
	*7600
	ENPUNCH
BOOTST,	0002		/FOR BENEFIT OF PDP-12'S
	CLA CLL
	CDF 0		/FOR BENEFIT OF 8/E CUSTOMERS
	JMS I	PSHND
STRTAD,	3000
ZERO,	0
	1
BOOTRE,	JMP I	STRTAD
BADS,	-7
	6446	/SEQ. # TOO BIG
	6217
	0104
	0165
	6060
	0143
	5250
IOERMS,	-14
	5220	/I/
	6001	/O
	4663	/ER
	6360	/RO
	6301	/R
	6057	/ON
	0101	/
IODEV,	0
	3401	/;
	6346	/RE
	6563	/TR
	7240	/Y?
PTCRLF,	TCRLF
CTRLN,	0
	IFNZRO CTRLN-7636 <???> /ERROR, FGBG!
WHYME,	0
	IFNZRO WHYME-7637 <???> /ERROR, FGBG!
	DCA	TTCHR
	TAD	CTRLN
	CLL RAR
	SNL CLA
	JMP	NOCONV
	TAD	K257
	DCA	IODIE
	TAD	CNVTBL
	DCA	IODEV
DLOOP,	ISZ	IODIE
	TAD I	IODEV
	ISZ	IODEV
	SNA
	JMP	NOCONV
	TAD	TTCHR
	SZA CLA
	JMP	DLOOP
	TAD	IODIE
	JMP I	WHYME
NOCONV,	TAD	TTCHR
	JMP I	WHYME
CNVTBL,	CVTABL
K257,	257
TTCHR,	0
CVTABL,	-315	/M=0
	-312	/J=1
	-313	/K=2
	-314	/L=3
	-325	/U=4
	-311	/I=5
	-317	/O=6
	0
S377,	377
KMY,	-331
IODIE,	0
	IFNZRO IODIE-7702 <???>	/ERRORS ALL OVER THE PLACE
	DCA	IODEV
	CDF 0 
	JMS I	PTCRLF
PIPFX1,	AC0001
PIPFX2,	JMS I	KCDOIO
	IOERMS-1
S3,	3
	JMS I	TTYIN
	TAD	KMY
	SNA CLA
	JMP I	IODIE
	JMP	BOOTST
				/LEAVE LOCATIONS 7720-7730 FREE
	ZBLOCK 7731-.		/FOR BENEFIT OF DP8E COMMUNICATIONS HACK
/
/ROUTINE TO TAKE A BLOCK # & RETURN THE HIGH-ORDER BITS IN .+4 
/AND THE LOW BITS IN THE AC.  FOR EXAMPLES, REFER TO CALLS TO THE
/LOW-LEVEL DISK & TAPE ROUTINES.
/
SPLIT,	0
	CLL RTR
	RTR
	DCA	TEMP
	TAD	SPLIT
	TAD	S3
	DCA	IODEV
	TAD	TEMP
	AND	S377
	DCA I	IODEV
	TAD	TEMP
	RAR
	AND	P7400
	JMP I	SPLIT
/
	IFNZRO 7750-.&4000 <???> /ERROR	/DON'T CLOBBER DATA BREAK LOCATIONS!
	ZBLOCK 7750-.
	.
	.
	.
	.
	.
	.
MREAD,	JMS	SPLIT		/THE FINAL LOADER USED BY "RUN"
	JMS I	PSHND
	0
	0
	0
MSTCDF,	CIF CDF 0
	JMP I	.+1
MSTADR,	0
RECOVR,	JMP I	.+1
	IFNZRO RECOVR-7766 <???> /ERROR, SYSGEN!
	SYSINT
DDTBRK,	0		/DDT FLAG DIGNUS
	IFNZRO DDTBRK-7770 <???> /ERROR RSYS AND DDT
	ZBLOCK 7772-.
FLAGS,	1		/VARIOUS FLAGS
			/BIT 0 = FOREGROUND FLAG
			/BIT 11 = MARKETING FLAG (THEY KNOW WHAT THE CUSTOMER  WANTS)
	DECIMAL
IFZERO LP645 <
LPTSIZ,	-80		/COLUMS LPT HAS>
IFNZRO LP645 <
LPTSIZ,	-130>
	OCTAL
PSHND,	SYSDEV
BIGCDF,	CDF 10		/HIGHEST CDF OF MACHINE
SWITCH,	0		/"/S" OF COMMAND
DATE,	0
/
	BOOT=7600

/PAGE 0 LITERALS
/
	FIELD BASFLD%10+1

	*200
	TC01BT=.
	NOPUNC
	*7600
	ENPUNC
	JMP	FAKEIT
	0401
	7464
	7264
	7601
	SYSDAT
	0
CHGCA,	DCA	7755
	DTSF
	JMP	.-1
	DCA	7755
	JMP	1
	0
	0
	0
DWAIT,	JMP	CHGCA
	NOPUNC
	*201	/THIS SHOULD REALLY BE "*1" BUT PAL10 BLOWS UP IF IT IS
	/THIS CODE READS INTO FIELD 0, PAGE 0, WHEN BOOTSTRAPPED
	ENPUNC
	TAD	D30
SRCHLP,	DTXA
	DTSF
	JMP	.-1
	AND I	0		/MAGIC...TO MAKE THIS WORK ON 8/I'S
	TAD	0
	TAD	DM20
	SZA CLA
	JMP	SRCHLP
	TAD	D5777
	DCA I	D7755
	DCA I	D7754
	TAD	D30
BRDLP,	DTXA
	DTSF
	JMP	.-1
	AC7777
	TAD I	D7755
	DCA I	D7755
	ISZ	M10
	JMP	BRDLP
	JMP I	D7600
DM20,	-20
D5777,	5777
D30,	30
M10,	-10
D7600,	7600
D7755,	7755
D7754,	7754
	ZBLOCK 2
	7
	NOPUNCH
	*.+7417
	ENPUNCH
FAKEIT,	TAD	D600
	DTCA DTXA
	DTSF
	JMP	.-1
	TAD	D7577
	DCA	7754
	TAD	D7577
	DCA	7755
	TAD	D220
	DTCA DTXA
	TAD	D5217
	DCA	DWAIT
D5217,	JMP	DWAIT
D600,	600
D220,	220
D7577,	7577
	ZBLOCK 7		/PRAY
	7600
	ZBLOCK 6
	6610

	*400
	/THIS READS INTO *4000, FIELD 0
	TC12BT=.
/LINCTAPE BOOTSTRAP
	HLT
	401
	7464
	7264
	7601
	SYSDAT
	0
K7600,	7600
K70,	70
	K7,	7
K17,	17
LK200,	200
KCDF,	CDF 0
	*.&7600+17
C,	7767	/-10
	1020	/LDA I
	20
	1	/AXO
J,	1020	/LDA I
L,	6000
	23	/TMA
	702
K,	20
	1020	/LDA I
	1
	2027	/ADD K
	4027	/STC K
	2024	/ADD L
	2013	/ADD LK200
	4024	/STC L
	237	/XSK I C
	6023	/JMP J
	2	/PDP
	TAD	K70
	DCA	65
	TAD	K7
	DCA	P7
	TAD	K17
	DCA	P17
	TAD	K7600
	DCA	P7600
	TAD	KCDF
	DCA	PCDF
	JMP I	K7600

	*600
	RK8BT=.
	NOPUNC
	*601	/THIS SHOULD ALSO BE "*1" BUT PAL10 GIVES "Z" ERRORS IF IT IS...
	ENPUNC
	HLT
	0401
	7464
	7264
	7601
	5623
	0
	ZBLOCK 617-.
X3777,	3777+1
P6000,	6000	
RKBLP,	TAD I	X3777
	DCA I	P6000
	ISZ	P6000
	JMP	RKBLP
	JMP I	.+1
	7600
	ZBLOCK 630-.
	DSKD=6745
	DSKD
	JMP	.-1
	JMP	RKBLP
	ZBLOCK 640-.
	7
	ZBLOCK 670-.
	7600
	PAGE

	*1000			/SHOULD BE *0...
	RF08BT=.		/RF08 BOOTSTRAP
	HLT
	0401
	7464
	7264
	7601
	SYSDAT
	0
	*1016
	NOPUNCH
	*6622
	ENPUNCH
	TAD	RB70
	DCA	65		/THIS CODE READS INTO 6622
	TAD	RB7600
	DCA	70
	TAD	RBSIZ
	DCA	COUNT
	TAD	RBDOT1
	DCA	GETPNT
	TAD	RBDOT2
	DCA	PUTPNT
	TAD I	GETPNT		/MOVE DOWN TO 5000
	DCA I	PUTPNT
	ISZ	COUNT
	JMP	.-3
	JMP I	.+1
	RDOT&177+5000
RDOT,	TAD	R5777
	DCA I	R7750
	TAD	R5777
	DCA I	R7751
	AC4000
	6603
	6622
	JMP	.-1
	JMP I	RB7600
R7750,	7750
R7751,	7751
R5777,	5777
RB70,	70
RB7600,	7600
RBSIZ,	-25
RBDOT1,	RDOT-1
RBDOT2,	RDOT&177+5000-1

/EDP-8 TD8E BOOTSTRAP FOR RECORD 0
	*1200
	TD8EBT=.
	HLT
	0401
	7464
	7264
	7601
	SYSDAT
	0
	ZBLOCK 1220-.
	NOPUNCH
	*7400
	ENPUNCH
QMOVE,	TAD I	P1
	DCA I	P2		/RELOCATE
	ISZ	P1
	ISZ	P2
	ISZ	TDK		/DONE?
	JMP	QMOVE
	JMP	0
P1,	TDK+1
P2,	0
TDK,	TDBOOT-END-1
	NOPUNCH
	*1200			/THIS IS REALLY *0
	ENPUNCH
TDBOOT,	TAD	QK7600
	DCA	TDWCT
	7400			/MUST BE AT LOC'N 2
	SDSS			/WAIT FOR BLOCK MARK
	JMP	.-1
	SDRC
	AND	TDB77
	TAD	KM26
	SZA CLA			/IS IT A BLOCK MARK?
	JMP	TDBOOT+2	/NOPE
	SDRD			/YUP, GET BLOCK #
	TAD	TDBKNO		/RIGHT ONE?
	SZA CLA
	JMP	TDBOOT+2	/NOT YET
TDRGRD,	SDSS
	JMP	.-1
	77			/MUST BE AT LOC'N 20
	SDRC
	AND	TDB77
	TAD	KM32		/IS IT REV. GUARD?
	SZA CLA
	JMP	TDRGRD
	JMS	TDRQD
	JMS	TDRQD
	JMS	TDRQD
QTDREA,	JMS	TDRQD		/GET A DATA WORD
	ISZ	QTDPTR
	DCA I	QTDPTR
	ISZ	TDWCT		/DONE?
	JMP	QTDREAD
QK7600,	7600
TDB77,	77
	7			/MUST BE AT LOC'N 40
	AC7777
	TAD	TDBKNO
	DCA	TDBKNO
	ISZ	QM10
	JMP	TDBOOT
	SDLC			/STOP TAPE
	JMP I	QK7600		/BOOT REST OF SYSTEM
TDWCT,	7600
TDRQD,	0
	SDSQ
	JMP	.-1
	SDRD
	JMP I	TDRQD
KM26,	-26
KM32,	-32
TDBKNO,	-20			/READ BLKS 20-27
QTDPTR,	5777			/INTO 6000-7777
QM10,	-10
	0
	0
	70			/MUST BE AT 65
	0
	0
	7600			/MUST BE AT 70
	CDF 0			/MUST BE AT 71
END,
/
	PAGE

	*1400
	RKEBT=.
	HLT
	0401
	7464
	7264
	7601
	SYSDAT
	0
	ZBLOCK 1430-.
	DSKP=6741
	DSKP
	JMP	.-1
	AC0001
	DCLR=6742
	DCLR
	TAD	RE6000
	DLCA
RLP,	TAD	REBLK
	DLAG=6743
	DLAG
REP7,	7
	DSKP
	JMP	.-1
	ISZ	REBLK
	TAD	RE1000
	DLDC
	ISZ	RCNT
	JMP	RLP
	JMP I	R57600
RCNT,	-4
RE1000,	1000
RE6000,	6000
REBLK,	10
	ZBLOCK 1470-.
R57600,	7600

	*OVRADR		/THIS IS REALLY AN OVERLAY THAT GETS CALLED IN
	/TO RESIDE IN FIELD 0 AT APPROPRIATE TIMES
DIRPRT,	TAD I	(SWITCH
	SPA CLA
	JMP I	(TAPLBL
	DCA	DBLOCK
	TAD I	PDATE		/GET SYSTEM DATE
	JMS I	(DACODE		/& MAKE SENSE OUT OF IT
	TAD	(DIRHDR-1
	DCA	GETPNT
	AC7776
	DCA	COUNT
	TAD	(-15
	DCA	NCPL
PRTHDR,	TAD I	GETPNT
	JMS I	(LP8P2C
	ISZ	NCPL
	JMP	PRTHDR
PRTHR2,	JMS I	(LCRLF
	JMS I	(LCRLF
	TAD	(-13
	DCA	NCPL
	ISZ	COUNT
	JMP	PRTHDR
SEGLP,	JMS I	(MRDCAT
	TAD	PDWSTE
	DCA	GETPNT
NAMLUP,	TAD	(-15
	DCA	NCPL
	TAD I	GETPNT
	SNA
	JMP	BLNKNM		/GOT A BLANK ENTRY (FROM DELETION)
	DCA	NAM2PR
	TAD I	GETPNT
	DCA	NAM2PR+1
	TAD I	GETPNT
	DCA	NAM2PR+2
	TAD	K4040
	DCA	NAM2PR+3
	TAD I	GETPNT
	AND	P77
	DCA	FILTYP		/EXTENSION
	TAD I	PDWSTE		/GET # OF ADDITIONAL INFO WORDS
	SNA CLA
	JMP	PRTNAM		/IF NONE
	TAD I	GETPNT		/PICK UP DATE
	JMS I	(DACODE
	TAD I	PDWSTE
	CMA
	TAD	GETPNT		/BUMP PAST REST OF ADD'L INFO WORDS
	DCA	GETPNT
PRTNAM,	TAD I	GETPNT		/GET LENGTH WORD
	CIA
	JMS I	KOTOPD
	TAD	(3737
	DCA	LENWRD
	TAD	(NAM2PR-1
PREMPT,	DCA	PUTPNT
PRTLUP,	TAD I	PUTPNT
	JMS I	(LP8P2C
	ISZ	NCPL
	JMP	PRTLUP
NAMDUN,	JMS I	(LCRLF
	ISZ I	PDCNT		/BUMP COUNT OF FILES
	JMP	NAMLUP
	TAD I	PDLINK
	SZA
	JMP	SEGLP
	JMS I	(FORMFD		/DONE ALL
	JMP I	P7600
BLNKNM,	TAD I	GETPNT
	JMS I	(DIV100
	TAD I	(DFLEN
	DCA	DEMPTY
	TAD I	(DFLEN+1
	DCA	DEMPTY+1
	TAD	(-12
	DCA	NCPL
	TAD	(EMPMES-1
	JMP	PREMPT
EMPMES,	4074			/" <XXXX FREE BLOCKS>  "
DEMPTY,	0
	0
	4006
	2205
	0540
	0214
	1703
	1323
	7640
DIRHDR,	0411	/DI
	NAM2PR=DIRHDR
	2205	/RE
	0324	/CT
	1722	/OR
FILTYP,	3140	/Y
	4040
LENWRD,	4040			/GETS FILLED WITH LENGTH
K4040,	4040
DAY,	0
MONTH1,	0
MONTH2,	0
	5567	/-7
YEAR,	0
	1601	/NA
	1505	/ME
	4040
	4024	/ T
	3120	/YP
	0540	/E
	1416	/LN
	4040
	4040
	0401	/DA
	2405	/TE
/
	PAGE

LP8P2C,	0
	DCA	DTEM1
	TAD	DTEM1
	RTR
	RTR
	RTR
	JMS	TOASC
	TAD	DTEM1
	JMS	TOASC
	JMP I	LP8P2C
TOASC,	0
	AND	P77
	SNA
	TAD	(40
	DCA	DTEM2
	TAD	DTEM2
	AND	(40
	SNA CLA
	TAD	(100
	TAD	DTEM2
	JMS I	PRTNE
	JMP I	TOASC
DTEM1,	0
DTEM2,	0
	5555
	5555
MONLST,	5512	/-JAN, -FEB, -MAR, ETC.
	0116
	5506
	0502
	5515
	0122
	5501
	2022
	5515
	0131
	5512
	2516
	5512
	2514
	5501
	2507
	5523
	0520
	5517
	0324
	5516
	1726
	5504
	0503
DACODE,	0		/DECODE INTO MONTH-DAY-YEAR
	DCA	TEMP
	TAD	TEMP
	CLL RTL
	RTL
	RAL
	AND	P17
	CLL RAL
	TAD	(MONLST-3
	XR12=12		/***** DEFINITION *****
	DCA	XR12
	TAD I	XR12
	DCA I	(MONTH1
	TAD I	XR12
	DCA I	(MONTH2
	TAD	TEMP
	AND	P7
	CLL RTL
	RTL
	RTL
	TAD	(6200
	DCA I	(YEAR
	TAD	TEMP
	CLL RTR
	RAR
	AND	(37
	JMS I	KOTOPD
	TAD	(3737
	DCA I	(DAY
	JMP I	DACODE
TXT26,	5252
	5252
	5252
	5252
	5252
	5252
	5252
	5252
	5252
	5252
	5252
	5252
	5252
	5252
TXT2,	5240
	4040
	4040
	4040
	4040
	4040
	4040
	4040
	4040
	4040
	4040
	4040
	4040
	4052
/
	PAGE

	/SECOND BLOCK OF OVERLAY - TO IMMEDIATELY FOLLOW THE FIRST ON TAPE
PDRET,	DCA	LBLSEQ
	TAD	PDORG
	DCA	GETPNT
	TAD I	GETPNT
	JMS	FRM237
	DCA	CHR1
	TAD I	GETPNT
	JMS	FRM237
	DCA	CHR2
	TAD I	GETPNT
	JMS	FRM237
	DCA	CHR3
	TAD I	GETPNT
	JMS I	(DACODE
	TAD I	(MONTH1
	DCA	LBLM1
	TAD I	(MONTH2
	DCA	LBLM2
	TAD I	(DAY
	DCA	LBLDAY
	TAD I	(YEAR
	DCA	LBLYR
	TAD I	GETPNT
	CIA			/MAKE NEG SO DIV100 CAN MAKE IT +
	SNA
	TAD I	NMBR		/GET LENGTH OF FULL UNIT IF ZERO
	JMS	DIV100
	TAD	(LINLST-1
	DCA	XR12
GTMSPR,	TAD I	XR12
	SNA
	JMP	LBLDUN
	DCA	GETPNT
	TAD	(-16
	DCA	NCPL
GETEXT,	TAD I	GETPNT
	JMS I	(LP8P2C
	ISZ	NCPL
	JMP	GETEXT
	JMS I	(LCRLF
	JMP	GTMSPR
LBLDUN,	JMS I	(FORMFD
	JMP I	P7600

FRM237,	0
	DCA	TEMP
	TAD	TEMP
	TAD	(37
	AND	P77
	SNA
	TAD	(40
	DCA	QUOT		/TEMPORARY TEMPORARY
	TAD	TEMP
	TAD	(3700
	SNA
	CLL CML RAR
	AND	(7700
	TAD	QUOT
	JMP I	FRM237
BADSW,	JMS I	(ERRMSG
	BADCOM-1
	JMP I	P7600
LBLPRT,	5240
	4040
CHR1,	0
CHR2,	0
CHR3,	0
	4043
LBLSEQ,	0
	4040
	LBLDAY,	0
	LBLM1,	0
	LBLM2,	0
	5567
	LBLYR,	0
	4052

DIV100,	0
	CIA		/MAKE +
	DCA	REM
	DCA	QUOT
	TAD	REM
DIVLUP,	CLL
	TAD	(-144
	ISZ	QUOT
	SZL			/DIVIDE BY 100
	JMP	DIVLUP
	TAD	(144
	DCA	REM
	AC7777
	TAD	QUOT
	JMS I	KOTOPD
	TAD	(3737
	DCA I	(DFLEN
	TAD	REM
	JMS I	KOTOPD
	TAD	(3737
	DCA I	(DFLEN+1
	JMP I	DIV100
BDLBL,	JMS I	(ERRMSG
	LBLZAP-1
	JMP I	P7600
QUOT,	0
REM,	0
LBLZAP,	-5
4342
4501
5542
4346
5501
/
	PAGE

LINLST,	TXT26-1
	TXT2-1
	LBLHDR-1
	TXT2-1
	LBLPRT-1
	TXT2-1
	TXTL-1
	TXT2-1
	TXT26-1
	0
TXTL,	5240
	4040
	1405
	1607
	2410
	7240
DFLEN,	0
	0
	4040
	2516
	1124
	7240
LOGUNT,	0
	4052
LBLHDR,	5240
	4040
	1601
	1505
	4040
	4023
	0521
	5640
	4040
	0401
	2405
	4040
	4040
	4052
TAPLBL,	TAD I	(SWITCH
	TAD	(-6000
	SPA			/CHECK FOR LEGAL, MORE OR LESS
	AC4000
	TAD	(-1200
	SMA SZA CLA
	JMP I	(BADSW
	TAD I	(SWITCH		/DECODE "/XX" INTO A REAL #
	AND	P77
	SZA CLA
	JMP	TWONMS
	TAD I	(SWITCH
	CLL RTR
	RTR
	RTR
NMAND,	AND	P17
	DCA	NMBR
	TAD	NMBR
	TAD	NMBR
	TAD	NMBR
	TAD	(UTBASE
	DCA	NMBR
	TAD I	NMBR
	AND	TABSET		/GET HANDLER ADDR
	TAD	(-UNDEF		/CHECK FOR UNDEFINED LOGICAL UNIT
	SNA
	JMP	NONO
	TAD	(UNDEF
	DCA	DAVICE
	TAD I	NMBR
	AND	P7		/GET PHYSICAL UNIT
	DCA	UNIT
	TAD I	(SWITCH
	DCA	LOGUNT
	CLL
	7234
	SPA CLA
	DCA I	P7400
	TAD	UNIT
	TAD	(200
	DCA	TPLBLC
	ISZ	NMBR
	TAD I	NMBR		/GET OFFSET OF LOGICAL UNIT
	ISZ	NMBR		/POINT TO UNIT LENGTH
	DCA	KDIR+1
	JMS I	DAVICE
TPLBLC,	0
KDIR,	DIRECT
	0
	TAD I	PDORG
	AND	(7700
	TAD	P7400
	SZA CLA
	JMP I	(BDLBL
	TAD I	PDORG
	AND	P77		/GET SEQ. #
	JMS I	KOTOPD
	TAD	(3737
	JMP I	(PDRET

TWONMS,	TAD I	(SWITCH
	AND	(100
	SZA CLA
	TAD	(12
	TAD I	(SWITCH
	JMP	NMAND
NONO,	JMS I	(ERRMSG
	ILUNT-1
	JMP I	P7600
/
	PAGE

	/THIS READS INTO *4400, FIELD 0
/THE PROLOGUE RECORD OF THE BINARY SCRATCH AREA LOOKS MORE OR LESS
/LIKE THIS (FOR DIBOL BINARIES - FOR OTHERS, IT MAY BE A BIT
/DIFFERENT):
/WORD	CONTENTS
/0	WORD COUNT
/1	TYPE OF LINE
/2	(-) IF ERRORS, OR # OF BUFFERS REQUIRED
/3	STARTING CDF
/4	STARTING PC
/5	# OF BLOCKS TO SAVE (0 IF ERRORS)
/6	MAXIMUM CORE
/7	VERSION # OF COMPILER
/10	EXTENSION TO USE FOR SAVE (DB, DF, DM)
SAVOVR,	TAD	(COMPWA
	JMS I	(SPLIT
	JMS I	SYSHND		/GET HEADER OF COMP W.A.
	0200
	DIRECT
	0
	TAD I	(DIRECT+5	/GET # OF BLOCKS TO SAVE
	SNA			/ERRORS?
	JMP	BADSAV		/YUP
	DCA	GET		/TEMPORARY
	JMS I	(GETNAM
	JMP	ERCOM
	JMS I	(GETDEV
	TAD	(COMPWA		/STARTING BLCOK BIN WORK AREA
	DCA	SAVBLK
	TAD I	(DIRECT+10
	TAD	(-0402
	SZA
	TAD	(0402-0406
	SZA
	TAD	(0406-0415
	SZA CLA
	JMP	BADSAV
	TAD I	(DIRECT+10	/GET THE EXTENSION
	DCA	NAM4
	TAD	GET		/# OF BLOCKS TO SAVE
	CLL RTR
	RTR			/DIV. BY 20(8)
K20,	AND	P77
	CMA
	DCA	COUNT		/- # OF 20-BLOCK TRANSFERS-1
	TAD 	GET
	AND	P17
	CLL RTR
	RTR
	RTR
	DCA	NCPL		/SAVE REMAINDER
	TAD	(10
	DCA	RDCTL		/SET FIELD BIT
	DCA	DBLOCK
	TAD	KKSKP
	DCA I	(CTCFIX		/NO ^C FROM HERE ON
	TAD 	GET
	JMS I	(ENTER
	DCA	LNPRPG		/TEMPORARY
	TAD	(JMP	SLOOP
	DCA	SVEXIT
SLOOP,	ISZ	COUNT
KKSKP,	SKP
	JMP	LSTWRI
	TAD	SAVBLK
	JMS I	(SPLIT
	JMS I	SYSHND		/GET COMPILER PROG
RDCTL,	0
	0
	0
	TAD	K20
	TAD	SAVBLK		/BUMP BLK #
	DCA	SAVBLK
	AC4000
	TAD	RDCTL
	TAD	UNIT
	DCA	WRICTL
	TAD	LNPRPG
	JMS I	(SPLIT
	JMS I	DAVICE
WRICTL,	0
	0
	0
	TAD	K20
	TAD	LNPRPG
	DCA	LNPRPG
SVEXIT,	JMP	SLOOP		/MAY BE "JMP I P7600"

LSTWRI,	TAD	JMPSTR
	DCA	SVEXIT
	TAD	NCPL
	SNA
JMPSTR,	JMP I	P7600
	TAD	RDCTL
	DCA	RDCTL
	JMP	SLOOP
ERCOM,	JMS I	(ERRMSG
	BADCOM-1
	JMP I	P7600
BADSAV,	JMS I	(ERRMSG
	CMPERR&177+4400-1	/"--------------------"BAD COMPILATION"
	JMP I	P7600
SAVBLK,	0
CMPERR,	-10		/"BAD COMPILATION"
	4342
	4501
	4460
	5661
	5255
	4265
	5260
	5700
/
	PAGE

/ROUTINE TO GET AND STORE THE DATE FROM THE "DATE" COMMAND
DACOM,	JMS I	(NUMBR
	JMP	DATERR
	SNA
	AC4000
	TAD	(-14
	SMA SZA
	JMP	DATERR
	TAD	(14
	CLL RTR
	RTR
	RAR
	DCA	DTEM
	JMS	GDNM
	SNA
	AC4000
	TAD	(-37
	SMA SZA
	JMP	DATERR
	TAD	(37
	CLL RTL
	RAL
	TAD	DTEM
	DCA	DTEM
	JMS	GDNM
	TAD	(-120
	CLL
	TAD	(10
	SNL
	JMP	DATERR
	TAD	DTEM
	DCA I	PDATE
	CLL CML
	TAD	(0123
	7014
	SMA CLA
	JMP I	P7600
	CLL CML RAR	/KILL!
	DCA I	(7604
	DCA I	(7606	/KILL!
	JMP I	P7600	/CRASH!
DTEM,	0

GDNM,	0
	JMS I	(GETC
	JMP	DATERR
	CLA
	JMS I	(NUMBR
	SKP CLA
	JMP I	GDNM
DATERR,	CLA
	JMS I	(ERRMSG
	DATFRM&177+4600-1
	JMP I	P7600
DATFRM,	-13
	4657	/EN
	6546	/TE
	6301	/R
	0345	/"D
	4265	/AT
	4601	/E
	5656	/MM
	2045	//D
	4520	/D/
	7272	/YY
	0300	/"

/"DO" OVERLAY THING
DOVERL,	JMS I	(GETNAM
	JMP	BADDO		/GOT TO HAVE A NAME
	TAD	SYSHND
	DCA	DAVICE
	DCA	UNIT
	TAD	(0123		/"AS"
	DCA	NAM4
	DCA	DBLOCK		/FOR EUPHONIOUS AND SALUDICATIOUS REASONS
	JMS I	(LOOKUP		/(DON'T ASK ME WHAT IT MEANS)
	NAM1-1
	JMP	NODOFI		/FILE NOT FOUND
	DCA	PUT		/SAVE IN PREPARATION FOR SYSINI THING
	JMS I	KPTRST
	TAD	(200
	DCA I	W0
	TAD	PDCNT
	DCA I	W1
	AC7777
	TAD I	W1
	DCA I	W2		/FIX UP BUFFER POINTER-1
	TAD	PUT
	IAC		/RDOIO WANTS TO BE SET UP TO THE BUFFER ONE MORE
		/THAN THE ONE IT'S ON (SEE LONG-WINDED NOTE AT ROUTINE
		/"REREAD" AND EXAMINE CODE "GPBUF" IF YOU'RE REALLY INTERESTED)
	CLL RAR
	RTR
	RTR
	DCA	TEMP
	TAD	TEMP
	AND	P7400
	DCA I	W5
	TAD	TEMP
	RAL
	AND	(377
	DCA I	W4
	TAD	P7400		/SHOW 400 WORDS LEFT IN BUFFER
	DCA I	W3
	DCA	DBLOCK
	JMP I	P7600
BADDO,	JMS I	(ERRMSG
	BADCOM-1
	JMP I	P7600
NODOFI,	JMS I	(ERRMSG
	NOTFND-1
	JMP I	P7600
/
	PAGE

/DIRECTORY EXPANSION OVERLAY
/CALLED IN MOMENTS OF EXTREME DURESS
/ADDS ANOTHER BLOCK TO THE LINKED DIRECTORY (IN THEORY, AT LEAST)
/IT RUNS AT *3000
/
MEOVLP,	TAD I	PDLINK
	SNA CLA			/ANY SEGMENTS AFTER THIS ONE?
	JMP	MELAST		/LAST ONE, MUST CREATE ANOTHER (PAIN AND AGONY)
	ISZ I	PDCNT		/BUMP ENTRY COUNT DOWN
	AC4000
	JMS I	(MREADC		/WRITE OUT THIS SEGMENT
	JMS	MSKIPF		/FIND END OF SHORTENED DIRECTORY
	DCA	MEFCNT		/PREPARE TO TRANSFER LAST ENTRY
	TAD	(MEOVLS-1
	DCA	XR1		/INTO NEXT DIRECTORY SEGMENT
	TAD I	XR
	DCA I	XR1
	ISZ	MEFCNT
	TAD	XR
	CIA
	TAD	ETMP		/ETMP WAS SET UP BY ENTER
	SZA CLA			/(IT SAYS HERE IN FINE PRINT...)
	JMP	.-7
	TAD I	ETMP		/GET LENGTH OF MOVED ENTRY
	DCA	MEOCNT
	TAD I	PDLINK
	JMS I	(MRDCAT		/READ NEXT SEGMENT
	JMS I	(CONSOL		/MAKE SURE IT IS AT ITS SMALLEST
	TAD I	PDORG
	TAD	MEOCNT
	DCA I	PDORG		/BUMP FILE ORIGIN DOWN
	JMS	MSKIPF		/FIND LAST LOC IN NEW SEGMENT
	TAD	XR
	DCA	ETMP
	AC7777
	TAD	XR
	TAD	MEFCNT
	DCA	XR		/PREPARE TO PUSH ALL ENTRIES UP
	TAD	(DIRECT+6
	DCA	EPTR
	JMS I	(MOVEUP
	TAD	(MEOVLS-1
	DCA	XR		/PREPARE TO MOVE THE SAVED ENTRY
	AC7777			/INTO THE NEW SEGMENT
	TAD I	PDCNT
	DCA I	PDCNT		/INCREASE ENTRY COUNT OF NEW SEGMENT
	TAD	MEFCNT
	CIA
MECOMN,	DCA	MEFCNT		/STORE NUMBER OF WORDS TO MOVE
	TAD	PDWSTE
	DCA	XR1
	TAD I	XR
	DCA I	XR1
	ISZ	MEFCNT
	JMP	.-3		/MOVE THE ENTRY IN
	JMS	MSKIPF
	TAD	XR
	DCA	ETMP		/ETMP= LAST LOC IN SEGMENT
	JMS I	(BUMPXR
	TAD	XR
	TAD	(-DIRECT-372
	SMA CLA			/HAVE WE MADE THE SEGMENT TOO BIG?
	JMP	MEOVLP		/YES - LOOP UNTIL WE GET IT RIGHT
	AC4000
	JMS I	(MREADC		/WRITE OUT SEGMENT
	JMP I	(RENTER		/AND CONTINUE WITH ENTER
MELAST,	TAD I	PDCNT
	CLL CML RAR		/GIVE THE NEW SEGMENT HALF THE OLD ENTRIES
	DCA	EPTR		/LENGTH OF NEW SEGMENT
	TAD	EPTR
	CIA
	TAD I	PDCNT
	DCA I	PDCNT		/ADJUST LENGTH OF OLD SEGMENT
	JMS	MSKIPF		/FIND BOUNDARY LOC BETWEEN SEGS
	TAD	DBLOCK
	AND	P7
	IAC
	DCA I	PDLINK		/LINK THE OLD SEGMENT TO THE NEW
	TAD I	PDLINK
	TAD	(-7
	SMA CLA
	JMP I	(NOSPAC		/PROVIDED THERE IS ROOM FOR ANOTHER
	AC4000
	JMS I	(MREADC		/WRITE OUT NEXT-TO-LAST SEG
	ISZ	DBLOCK
	TAD	EPTR
	DCA I	PDCNT
	TAD	MEOCNT
	CIA
	TAD I	PDORG
	DCA I	PDORG		/SET UP PARAMS FOR NEW SEG
	DCA I	PDLINK		/MARK IT AS THE NEW LAST SEGMENT
	TAD	XR
	TAD	(-DIRECT-377	/SET UP COUNT OF WORDS TO SLIDE DOWN
	JMP	MECOMN		/USE COMMON SLIDING CODE, & EXIT

MSKIPF,	0			/SUB. TO FIND LAST LOC USED IN A SEG
				/ALSO FINDS # OF BLOCKS USED BY SEG
	TAD I	PDCNT
	DCA	MNOFIL
	TAD	PDWSTE
	DCA	XR
	DCA	MEOCNT
MSKPLP,	TAD I	XR
	SNA CLA			/EMPTY ENTRY?
	JMP	MEOMTY		/YUP
	AC7775
	JMS I	(BUMPXR		/POINT TO LENGTH WORD OF FILE ENTRY
MEOMTY,	TAD I	XR
	TAD	MEOCNT		/GET LENGTH
	DCA	MEOCNT		/& ADD IT UP
	ISZ	MNOFIL
	JMP	MSKPLP
	JMP I	MSKIPF
MEOCNT,	0
MEFCNT,	0
MNOFIL,	0
/
	PAGE

	IFNZRO	EPOT < XLIST
	/ROUTINE TO PRINT OUT REGISTERS.OF RK8E DISK HANDLER
	/ON ERROR
	/NO TAPES CAN BE ACCESSED IF THIS ROUTINE RESIDES IN 
	/THE MONITER, A HALT AND JMP .-1 WILL OCCUR IF THE
	/TAPE HANDLER IS CALLED.  THIS ROUTINE IS CALLED FROM 
	/IODEV, THE ERROR HANDLER FOR DISK AND TAPE
	FIELD 0
*6600
KPAG,	PAGCNT
KGARG,	GARG
KTMP,	0
KMSK,	0007
KR201,	201
KCHK,	CHKHED
FOUR,	0
K7774,	7774
*6610
KSDLCX,		/STOP TAPE FUNCTION
KDTA,	0
	HLT		/HANG IF TAPE IS ACCESSED
	JMP	.-1
EPO,	DRST		/READ STATUS REG
	DCA	KTMP	/STORE STATUS REGISTER
	JMS	DMAN1	/PRINT IT OUT
	TAD I	KPAG	/COMPUTE COMMAND REG. SAME
	AND	(7600	/WAY AS IN DISK ROUTINE
	SNA CLA
	TAD I	KR201
	TAD I	KCHK
	CLL RAR
	TAD I	KRKEC
	DCA	KTMP
	JMS	DMAN1	/PRINT IT OUT
	TAD I	KGARG	/GET DISK ADDRESS
	DCA	KTMP
	JMS	DMAN1
	TAD	(215
	JMS I	TTYOUT
	TAD	(212	/PRINT CRLF
	JMS I	TTYOUT
	JMP I	(KZZRT
DMAN1,	0
	TAD	K7774
	DCA	FOUR
KAG2,	TAD	KTMP
	RTL CLL
	RAL
	DCA	KTMP	/STORE
	TAD	KTMP
	RAL
	AND	KMSK	/GET ONE CHAR
	TAD	(260
	JMS I	TTYOUT	/PRINT OUT THE CHARACTER
	ISZ	FOUR	/DO FOUR TIMES PER REG.
	JMP	KAG2
	TAD	(240
	JMS I	TTYOUT
	CLA
	JMP I	DMAN1
KRKEC,	RKECMD
	XLIST
	PAGE >

/DECTAPE ERROR HALT PATCH,TO BE ENTERED BY
/SWITCH REGISTERS ONLY
IFNZRO EPOT2 < XLIST
*6540
KZTAP1,	SDRC	/READ COMMAND REGISTER ON COMPUTED CHECKSUM ERROR
	HLT	/DISPLAYED IN AC
	JMP I	KZTE1	/RETRY
KZTAP2,	SDRC
	HLT
	JMP I	KZTE1	/RETRY
KZTAP3,	SDRC
	HLT		/SELECT ERROR
	JMP I	KZTE2	/PRINT MESSAGE
KZTE1,	TRY3+1
KZTE2,	TDMESG
	XLIST
	PAGE >

/		C A U T I O N !
/	INITIAL MONITOR WRITE-OUT ROUTINE
/	TEMPORARILY MOVES OS/8 PAGE 7600 FIELD 0
/	TO PAGE 6000 FIELD 1 WHILE IT DOES ITS THING TO
/	WRITE OUT THE SYSTEM...SO DON'T PUT ANYTHING AT 16000

IFZERO SYSNUM <SYSDEV=DTA;	SYSINT=DTINTL>
IFNZRO SYSNUM&1 <SYSDEV=RK8;	SYSINT=RKINTL>
IFNZRO SYSNUM&2 <SYSDEV=RF08;	SYSINT=RFINTL>
	/NON-OBVIOUS THINGIE;
	/PARTICULAR TIMES IN THE LIFE OF THE MONITOR; "RUN" TIME AND
	/"BOOTSTRAP" TIME.  AT EITHER OF THESE TIMES, PAGE 0 IS READ
	/OVER WITH INTERRUPTS ON, AND IF LOCATION 0 IS READ OVER THE
	/INSTANT AFTER GETTING AN INTERRUPT, THE WORLD WILL COME TO
	/AN END UNLESS SOMETHING IS DONE.  WHAT IS DONE IS,
	/SINCE ONLY THE SYSTEM DEVICE IS USED FORRUN & CTRL/C,
	/THE MONITOR CAN ONLY BE IN THE SYSTEM DEVICE WAIT LOOP WHEN
	/THE INTERRUPT OCCURS.  THEREFORE, LOCATION 0 IS INITIALIZED TO
	/POINT TO THE SYSTEM DEVICE WAIT LOOP, WHICH WILL BE THE PLACE
	/IT MUST HAVE COME FORM IN THIS SPECIAL CASE.  OK?
	$$$
$