Add README.md

[pdp8.git] / sw / os8 / v3d / sources / system / dectapes / dectape7 / OS8.PA

/12 OS8 MONITOR SYSTEM		OS8 VERS. 3D
/
/
/
/
/
/
/
/
/
/COPYRIGHT  (C)  1970,1971,1972,1973,1974,1975,1977 BY DIGITAL EQUIPMENT CORPORATION
/
/
/
/
/
/
/
/
/
/
/THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE
/AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
/CORPORATION.  DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY
/FOR ANY ERRORS THAT MAY APPEAR IN THIS DOCUMENT.
/
/THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER
/UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED
/(WITH INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH
/SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL.
/
/DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE
/OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY
/DIGITAL.
/
/
/
/
/
/
/
/
/
/
\f/13-APRIL-1977		RL/EF/HJ/SR


	/THIS VERSION OF OS/8 IS THE BATCH OPERATING SYSTEM
	/AS WELL AS THE STANDARD KEYBOARD SYSTEM. THIS SYSTEM
	/IS EXTERNALLY COMPATIBLE WITH ALL PREVIOUS OS/8-PS/8
	/USER PROGRAMS. HOWEVER, INTERNALLY THE SYSTEMS ARE
	/QUITE DIFFERENT. THE MARCH 1972 OS/8 WILL NOT RUN BATCH.
	/THIS VERSION IS COMPATIBLE WITH CCL.

/	SYMBOLIC REFERENCES TO VARIOUS OVERLAYS:

	MEOVLY=26		/DIRECTORY OVERFLOW OVERLAY FOR "ENTER"
	MCDREC=51		/COMMAND DECODER
	MSOVLY=54		/"SAVE W. ARGS" OVERLAY
	MSOVL2=55		/SECOND PART OF SAVE W. ARGS
	MERRTN=56		/MONITOR ERROR ROUTINE
	MRUNRC=57		/"CHAIN" OVERLAY
	ODTREC=60		/SYSTEM ODT
	MFREE=70		/BEGINNING OF FILE STORAGE
	CCB=7400
	CSOVLY=400
	RSOVL1=1400
	RSOVL2=2000

	VERSNO=3
	PATCHLEV="Q

/V3 CHANGES:

/1.	CCL SUPPORT
/2.	FIXED KILLER CLOSE BUG
/3.	ADDED VERSION NUMBER
/4.	^U, RO TO BOL, AND LF ALL PRINT '.' AGAIN
/5.	CALL TO USR WITH CODE OF 0 GIVES ERROR
/6.	MONITOR ERROR MESSAGES NOW GIVE EXPLANATION
/7.	ENTER NOW MOVES 7 FILES TO MAKE ROOM INSTEAD OF HALF SEGMENT
/8.	DIRECTORY VERIFICATION HAS IMPROVED

/V3 FIXES TO ABSLDR:

/1.	ALLOWED PARITY ^C
/2.	PUT IN SELF-STARTING STUFF
/3.	FIXED CCB BUG FOR 17600

/FIXES TO FIELD RELEASE

/1.	ABSLDR CHECKS PAGE 0 LITERALS
/2.	FIXED BUG RE MONITOR ERROR MESSAGES
/3.	ADDITIONAL INFO FIX
/4.	BATCH FIX

/FIXES FOR MAINTENANCE RELEASE:

/1.	CHANGED VERSION NUMBER OF MONITOR TO V3M
/2.	INCORPORATED PATCH RE LOC 13121 AFTER MONITOR ERROR
/	[SEQ #1, DSN APRIL 1975]
/3.	ALLOW CHAIN TO WORK ON FULL FIELD SAVES
/	[SEQ #2, DSN  JUNE 1975]
/4.	ALLOW ABSLDR/I TO WORK ON FULL FIELD CORE IMAGES
/	[SEQ #1, DSN OCTOBER 1975]
/5.	ADDED INTERNAL VERSION NUMBER TO ABSLDR AT LOCATION 2200
/	MAINT. RELEASE VERSION # IS V4
/6.	SET INITIAL ABSLDR DATE TO 1-NOVEMBER-1975

/V3D AND OS/78 CHANGES:

/1.	ACCEPT DEC STANDARD DATE FORMAT FOR INPUT (DD-MMM-YY)
/2.	CHANGED VERSION NUMBER TO V3Q
/3.	ADDED DATE/78 CHANGES
/4.	FIXED BUG ABOUT WAITING FOR TTY FLAG & BATCH
/5.	ADDED STUFF FOR LINKER [USES SOFSET]
/6.	CHANGED ABSLDR DATE TO 1-JUNE-77
/7.	DISALLOW RUN OF PROGRAM WITH BIT 4 OF JSW ON [OS/78 ONLY]
/8.	ASSIGNED RESIDENT BITS FOR SCOPE AND OS/78
/9.	ALLOW @ IN KBM COMMAND
/10.	COULD RUN INIT.CM ON SYSTEM START-UP
/11.	CHANGED BAD CORE IMAGE MSG TO CORE IMAGE ERR
/12.	CHANGED ABSLDR/I SO THAT IT SETS UP JSW AND SA
\f	/KEYBOARD MONITOR FOR OS/8 SYSTEM - UNCOMMENTED AT PRESENT

	FIELD 0
	MTHREE=CLA CLL CMA RTL
	*200
PRINT,	JMP I PRNAME	/MUST BE AT 200 FOR BATCH
	JMP .+3		/****GETS CIF CDF N FOR BATCH*****
	TSF		/****GETS JMP I .+1******
	JMP .-1		/*GETS BOSPRT*****
	TLS
	CLA
	TAD [7000
	DCA PRINT+1
	JMP I PRINT
GETNAM,	0
	DCA NM1
	DCA NM2
	DCA NM3
	DCA NM4
	TAD [NM1
	DCA PN
	CLA CMA
	DCA PRDSW
GTNMX,	DCA NMCT
	TAD I LXR
	TAD [-240
	SNA
	JMP .-3
	TAD [240
	SKP
GTNMLP,	TAD I LXR
	DCA TMP
	TAD TMP
	TAD [-256
	SNA
	JMP PERIOD
	TAD [-2
	CLL
	TAD [-12
	SNL CLA
	JMP NINSRT
	TAD [-301
	TAD TMP
	CLL CML
	TAD [-32
	SNL CLA
	JMP EONAME
NINSRT,	TAD NMCT
	TAD [-6
	SMA CLA
	JMP GTNMLP
	TAD NMCT
	CLL RAR
	TAD PN
	DCA TEMP1
	TAD TMP
	AND [77
	SZL
	JMP .+4
	RTL
	RTL
	RTL
	TAD I TEMP1
	DCA I TEMP1
	ISZ NMCT
	JMP GTNMLP
PERIOD,	ISZ PRDSW
	JMP EONAME
	ISZ PN
	TAD [4
	JMP GTNMX
EONAME,	TAD NMCT
	SZA CLA
	ISZ GETNAM
	JMP I GETNAM
\fPRNAME,	4000
	TAD NM1
	JMS PRWD
	TAD NM2
	JMS PRWD
	TAD NM3
	JMS PRWD
	TAD NM4
	SNA CLA
	JMP I PRNAME
	TAD [256
	JMS PCHAR
	TAD NM4
	JMS PRWD
	JMP I PRNAME
PRINLP,	JMS PRWD
	ISZ PRMESG
	SKP
	IFNZRO .-330 <CCLTRB,ERRR>
PRMESG,	0
	CLA
	TAD I PRMESG
	SZA
	JMP PRINLP
	TSF
	JMP .-1
	JMP I ERRET
PRWD,	0
	DCA TMP
	TAD TMP
	RTR
	RTR
	RTR
	JMS PCHAR
	TAD TMP
	JMS PCHAR
	JMP I PRWD
PCHAR,	0
	AND [77
	SNA
	JMP I PCHAR
	TAD [240
	AND [77
	TAD [240
	JMS I PCH
	JMP I PCHAR
\fPRINTQ,	JMS PRMESG
	TEXT /?/
	0

	*367
KSV2A,	SAVE2A
SAVE2,	TAD I LXR
	SNA		/ARE THERE ARGUMENTS?
	JMP I KSV2A	/NO..USE CCB
	JMS I [SHNDLR	/READ IN ARGUMENT OVERLAY
	0201
	CSOVLY
	MSOVLY
	JMP KMONER	/NORMAL RETURN IS TO 400
\f	*400
KMNTRY,	JMP I HANDAD	/V3
	0		/FREE LOCATION !
PCRLF,	JMS I [CRLF
	IFNZRO .-403 <BTCHER,XXXX>

KEYMON,	JMS I GLINE
	TAD [BEGLN-1	/ADDRESS REFERENCED BY INIT
	DCA LXR
	JMS I GNAME
/V3D	JMP I [PRINTQ
	XXX=[PRINTQ	/NEED LITERAL IN SAME PLACE
	NOP		/V3D ALLOW @ IN NAME
	JMS I [SRCH
	-123;	ASSIGN
	-2301;	SAVE
	-2225;	RUN
	-705;	GET
	-2200;	R
	-2324;	START
	-1704;	ODT
	-0405;	DEAS
	IFNZRO .-431 <SEECCL,ZZZ>
	-0401;	DATE
	0
	JMP I .+1
CCLSW,	PRQMRK		/MODIFIED FOR CCL TO 'GETCCL'
	IFNZRO CCLSW-435 <SEECCL,ZZ>

ASSIGN,	TAD [12
	JMS GDEVNO
	TAD [UDNAME-1
	DCA TM1
	JMS I GNAME
	JMP ASGN2+1	/NO USER DEV. DO A DEASSIGN 
	TAD NM2		/SEE IF WE HASH IT
	SNA
	JMP ASGN2	/DON'T HASH..ONLY 1 OR 2 CHARS
	TAD NM1
	RAL		/LINK BECOMES 4000 IF NECESSARY
	CLA CML RAR
	TAD NM2
ASGN2,	TAD NM1
	JMP I [ASDONE
\fR,	DCA I [GETSW
	TAD P6203
	JMS I [RESET
	ISZ RUNSW
	TAD [SHNDLR
	DCA HANDAD
	CLA IAC
	JMP RGETPG
GDEVNO,	0
	DCA ASNM1-1
	JMS I [MINCOR
	JMS I GNAME
	JMP I [KMER4
	TAD NM1
	DCA ASNM1
	TAD NM2
	DCA ASNM1+1
	TAD HNDLAD
	DCA HANDAD
	CIF 10
	JMS I SYSTEM
	1
ASNM1,	0;0
HANDAD,	KMINIT		/V3
	JMP I [KMER1
	TAD ASNM1+1
	JMP I GDEVNO
\fGET,	TAD [SKP
RUN,	DCA I [GETSW
	TAD P6203
	JMS I [RESET
	DCA RUNSW
	CLA IAC
	JMS GDEVNO
RGETPG,	JMS RSCOMN
	JMS I [MINCOR
	TAD SENTER
	CIF 10
	JMS I SYSTEM
	2
PGNAME,	NM1
	MOVBUF		/USED AS POINTER TO FIELD 1 SR
	JMP I [KMER2
	JMP I [RLOADR
RSCOMN,	0
	DCA SENTER
	TAD HANDAD
	DCA DEVHND
	JMS I GNAME
	JMP I [KMER4
	TAD NM4
	SNA
	TAD [2326
	DCA NM4
	JMP I RSCOMN
SAVE,	TAD [SAVE12	/CHANGE ERROR RETURN ADDRESS AS WE WILL DESTROY CORE
	DCA ERRET
	TAD I [JSBITS
	JMS I [RESET
	CIF 10		/MOVE THE LINE BUFFER TO 1600 DURING
	JMS I PGNAME+1	/A SAVE, AS HANDLER WIPES IT OUT
	TAD LXR		/LET'S MOVE THE REGISTER AROUND
	TAD [SVLNBF-BEGLN
	DCA LXR
	TAD [1001
	DCA HNDLAD
	CLA IAC
	JMS GDEVNO
	JMS RSCOMN
	JMP I [SAVE2
HNDLAD,			/REPLACED WITH 1001 BY SAVE

WRCTLB,	7001		/WRITE OVERLAY AND CCB
	JMS I [SHNDLR
	4600
	6200
	MTEMP+6
	JMP KMONER
	JMP I WRCTLB
\f	*573		/LOADS SYSTEM ODT OVER THE MONITOR
ODT,	JMS I PGTOUT
	JMS I [SHNDLR
	1001
	0
	ODTREC
	/LOCATION 600 IN ODT IS A HLT (ERROR RETURN)
\f	*600
START,	DCA TEMP1
	DCA TEMP2
	TAD I LXR	/V3
	SZA		/V3
	JMP I [STRTX	/V3
	TAD I [JFIELD
	DCA I [MSTCDF
	TAD I [JSBITS
	AND [1000
	SZA CLA
	JMP I [KMER3
	TAD I [JSBITS
	JMS I [RESET	/RESET ONLY IF NO START ADR SPECIFIED
	TAD I [JSTART
STCOMN,	DCA I [MSTADR
	TSF
	JMP .-1		/WAIT FOR PRINTER TO FINISH
	JMS I PGTOUT
	TAD I [JSBITS
	SPA CLA
	JMP I [MSTCDF
	TAD [SHNDLR
	DCA I [MREAD-1
	TAD [1000
	DCA I [MREAD+1
	DCA I [MREAD+2
	TAD [MTEMP+4
	DCA I [MREAD+3
	TAD FUDJMP
	DCA I [MSWITC
	JMP I [MREAD
\fMINCOR,	0
	CIF 10
	JMS I SYSTEM
	10
	CDF 10
	DCA I [OLDT9	/ZERO OUT "DIRECTORY IN CORE" KEY
	CDF 0
	TAD [200
	DCA SYSTEM
	JMP I MINCOR
RLOADR,
RUN1,	TAD I [PGNAME
	DCA FILE
	JMS I DEVHND
	0101
	CCB
FILE,	0		/READ IN THE HEADER BLOCK
	JMP KMONER	/ERROR WHILE READING HEADER BLOCK
	TAD I [CCB
	JMS I [CCBTST	/TEST FOR VALID CORE CONTROL
	TAD I [CCB+3	/V3D
	RAL		/V3D
	JMS I KRCHK	/V3D CAN'T RUN SYSTEM CUSP UNDER OS78
	TAD I [CCB+1
	DCA I [MSTCDF
	TAD I [CCB+2
	DCA I [MSTADR	/MOVE THE STARTING ADDRESS INTO UPPER CORE
	TAD I [CCB+1
	DCA I [JFIELD
	TAD I [CCB+2
	DCA I [JSTART
	TAD I [CCB+3	/SET UP THE JOB INFORMATION AREA
	JMS I [RESET	/AND CLEAR INFORMATION ABOUT "RUN" HANDLER
	TAD FUDJMP
	DCA I [MSWITC		/SET MSWITC TO INHIBIT LOADING 7400
GETSW,	SKP			/SKP FOR GET, NOP FOR RUN
	JMP RUN2
	TAD P6203
	DCA I [MSTCDF
	TAD [7600
	DCA I [MSTADR		/IF A GET, SET STARTING ADDRESS TO RETURN
				/TO MONITOR
\fRUN2,	TAD I [CCB
	CLL CMA RAL	/POINT TO LAST DOUBLEWORD IN CCB
	TAD [CCB+4
	DCA TM1		/TM1 POINTS TO SEG. ADDRESS
	TAD I TM1	/STORE ADDRES TO READ POSSIBLE OVERLAY
	DCA I [MREAD+2
	ISZ TM1		/POINT TO SEGMENT CONTROL WORD
	TAD DEVHND	/IF THE HANDLER IS IN 7600, OR
	TAD [200	/IF THE SEGMENT DOES NOT LOAD OVER
	CLA RAL		/7000, NO OVERLAY IS NEEDED. ALSO IF
	TAD I TM1	/THE SEGMENT IS IN FIELDS 1-7.
	AND [77
RUN5A,	SZA CLA
	JMP I [RUN6	/NO PROBLEMS.. READ STUFF IN
	TAD I [MREAD+2	/SEE IF WE OVERLAY 7000
	CLL CML RAR
	TAD I TM1	/ADD IN CONTROL WORD
	TAD [300
	SPA		/IF NEGATIVE, 7000 IS NOT OVERLAYED
	JMP RUN5A
	TAD [7600	/GETS 0, 100, 200, OR 300
	SMA		/IF  POSITIVE READ 3 PAGE OVERLAY
	ISZ I [PGNAME+1	/POINT TO NEXT TO LAST RECORD
	TAD [300
	DCA RDCNT
	TAD I [PGNAME+1
	CMA		/GET RECORD TO READ OVERLAY FROM
	TAD FILE
	DCA R7000
	JMS I DEVHND	/READ OVERLAY FROM THE FILE INTO PAGES
RDCNT,	0	/BEFORE CCB
	6200		/THEN WRITE THE WHOLE MESS OUT
R7000,	0
	JMP I [RERR
	JMS I [WRCTLB	/WRITE OUT THE OVERLAY+CCB
	DCA .-1		/BUT ONLY ONCE!!
	ISZ RUNSW
	DCA I [MSWITC	/ENABLE READ OF OVERLAY
	TAD RDCNT	/SEE IF THIS SEG IS EXHAUSTED
	CIA
	TAD I TM1
	SPA SNA
	ISZ I [CCB	/ARE WE DONE ALL SEGMENTS?
	SKP		/NOT YET. LOOP UNTIL DONE
	JMP I [MSWITC
RUN5,	DCA I TM1	/SAVE ALTERED CONTROL WORD
	JMP RUN2
\f/ASDONE,	CDF 10
/	DCA I TM1	/THIS COULD BE OPTIMIZED
/	CDF 0
/	JMP I [KEYMON

KMER1,	JMS I [PRNAME	/DEVICE NOT AVAILABLE
	JMS I [PRMESG
	TEXT	/ NOT AVAILABLE/
\f	*1000
/MUST BE AT 1000 FOR BATCH
BEGLN,	0	/LINE BUFFER	COULD BECOME "@
	"I
	"N
	"I
	"T
KMINIT,	CDF 10		/INITIALIZATION - DESTROYED BY LINE BUFFER
	ISZ I [7700	/LOC 17700=7777 IF I/O MONITOR IS KNOWN
	JMP .+3		/TO BE IN CORE, SO SET UP
	TAD [200	/THE INITIAL POINTER FOR CALLS TO THE MONITOR
	DCA SYSTEM	/ACCORDINGLY
	CDF 0
	TAD I LXR
	DCA I X1
	ISZ TEMP2
	JMP .-3
	CDF 10
	TAD MVFROM
	DCA I PDBUF
	ISZ .-2
	ISZ PDBUF
	ISZ MVCNT
	JMP .-5
	CDF 0
	TAD I PDBUF+1	/SEE IF BATCH IS SET
	RAL		/IF YES, GO TO PAGE 0 TO CONTINUE
	SMA CLA		/IF IT ISN'T, CONTINUE NORMALLY
	JMP INTGO	/NORMAL KEYBOARD SYSTEM
	DCA I RTWTPT	/DON'T WAIT ON TTY FLAG IF BATCH IS RUNNING
	TAD I [JSBITS	/IS BOS IN PLACE?
	AND DCBF
	SNA CLA
	JMP BATCH	/NO. GO READ IT IN.
	JMP BCHGO	/YES. START IT UP.
INTGO,	TAD [200
	KRS
	TAD M203
	SNA CLA		/IS THERE A ^C IN THE READER BUFFER
	KSF		/WITH THE FLAG ON?
	JMP I ERRET	/NO - PRINT CRLF AND PERIOD
	JMP CLR		/V3D
/CCLADR,	GETCCL	/V3D DIDN'T SEEM TO BE USED
RTWTPT,	RUNTWT
DCBF,	400
/START
PMSRST,	SHNDLR&177+4200	/JMS SHNDLR
	0300
	7000
	MTEMP+6
	HLT		/CONTAINS SECOND COPY OF OS/78 BIT
	CDF CIF 0
	TCF
/END
MVCNT,	MOVBUF-MVT3-1
PDBUF,	MOVBUF
\fMVFROM,	NOPUNCH
	*7626
	ENPUNCH
MOVBUF,	7777	/USED IN BATCH SETUP
	TAD I MVT1	/MOVE THE LINE BUFFER FROM 1000
	DCA I MVT2	/TO 1655
	ISZ MVT1
	ISZ MVT2
	ISZ MVT3
	JMP .-5
	CIF CDF 0
	JMP I MOVBUF

MVT1,	BEGLN
MVT2,	SVLNBF
MVT3,	-112


	*1077		/V3D
INIT,	CDF 10		/V3D (INITIALIZATION)
	TAD DCBF
	DCA I ROT	/RESTORE LOC 7677 TO '400'
	CDF 0
	DCA KMINIT	/END LINE WITH 0
	TLS
	JMP I CRLF	/FAKE OUT KBM AS IF USER TYPED @INIT


CLR,	KCC
	JMP I .+1
	CTRLC
\f	*1112
	ENPUNCH

DIGTLP,	TAD I LXR
STRTX,	TAD (-270
	CLL
	TAD [10
	DCA TMP1	/V3
	SNL
	JMP EONUM
/V3	ISZ DIGFLG
	JMS ROT
	JMS ROT
	JMS ROT
	TAD TEMP2
	TAD TMP1
	DCA TEMP2
	JMP DIGTLP
EONUM,	TAD TEMP1
	AND [7
	CLL RTL
	RAL
	TAD KM6203
	DCA I [MSTCDF
	TAD TEMP2
	JMP I .+1
	STCOMN

ROT,	7677		/V3D NEEDED FOR INIT
	TAD TEMP2
	CLL RAL
	DCA TEMP2
	TAD TEMP1
	RAL
	DCA TEMP1
	JMP I ROT
\fDEAS,	TAD [UDNAME-1
	DCA X1
	TAD [-17
	DCA TM1
	CDF 10
	DCA I X1
	ISZ TM1
	JMP .-2
KM6203,	CDF CIF 0
	JMP I [KEYMON

ASDONE,	CDF 10		/V3
	DCA I TM1	/V3
	JMP KM6203	/V3


CRLF,	KEYMON+1	/V3D NEEDED FOR INIT
	TAD [215
	DCA NM1
	JMS I (PRNT
	TAD [212
	JMS I PCH
	JMP I CRLF

M203,	-203
	PAGE
\f/NOTE: XR=AMFLAG !

	*1200
	/TELETYPE INPUT ROUTINE
XGLINE,	KEYMON+1		/MUST BE AT 1200 FOR BATCH & CCL
	TAD [".
	JMS I PCH
	DCA RBFLAG
	TAD [BEGLN-1
CHLM1,	DCA LXR
	DCA AMFLAG	/ZERO ALTMODE FLAG
CHLOOP,	KSF
	JMP CHLOOP
	TAD [200
	KRS
	DCA NM1
	KCC
	JMS SRCH
	-225;CTRLU
	-215;CARRET
	-377;RUBOUT
	-375;ALTMOD	/THIS AREA GETS MODIFIED BY SET
	-376;ALTMOD
	-233;ALTMOD
	-212;LFEED
	-200;CHLOOP
	-217;CHLOOP	/IGNORE ^O
	-203;CTRLC	/MUST BE JUST BEFORE 0
			/MUST BE HERE FOR CCL
	0
	JMS PRNT
CINSRT,	TAD NM1
	DCA I LXR
	TAD LXR
	TAD [-BEGLN-110
	SPA CLA
	JMP CHLOOP
CARRET,	JMS I [CRLF
	TAD LXR
	TAD [1-BEGLN
	SNA CLA
	JMP XGLINE+1
	DCA I LXR
	DCA I LXR
	JMP I XGLINE
\f/THIS PAGE GETS MODIFIED BY SET COMMANDS (FOR REAL SCOPE RUBOUTS)
/**** BEWARE! ***

PRNT,	0
	ISZ RBFLAG
	JMP .+3
	TAD ["\
	JMS I PCH
	DCA RBFLAG
	TAD NM1
	JMS I PCH
	JMP I PRNT
CTRLC,
CTRLU,	TAD ["^
	JMS I PCH
	TAD NM1
	TAD [100
CLRLIN,	JMS I PCH
RBSPCL,	JMS I [CRLF
	JMP XGLINE+1

ALTMOD,	TAD ["$
	DCA NM1
	JMS PRNT
	ISZ AMFLAG	/NOTE ALTMODE
	JMP CARRET+1
RUBOUT,	TAD LXR
	TAD [1-BEGLN
	SNA CLA
	JMP RBSPCL
	TAD ["\		/MUST BE HERE
	ISZ RBFLAG
	JMS I PCH
	CLA CMA
	DCA RBFLAG
	TAD LXR
	DCA TEMP1
	TAD I TEMP1
	JMS I PCH
LBCKUP,	CLA CMA
	TAD LXR
	JMP CHLM1
\fSRCH,	0
	TAD I SRCH
	ISZ SRCH
	SNA
	JMP I SRCH
	TAD NM1
	SNA CLA
	JMP SFND
	ISZ SRCH
	JMP SRCH+1
SFND,	TAD I SRCH
	DCA TEMP1
	JMP I TEMP1
LFEED,	JMS I [CRLF
	DCA I LXR
	TAD [".
	JMS I PCH
	TAD [BEGLN-1
	DCA XR
	TAD I XR
	SNA
	JMP LBCKUP
	JMS I PCH
	JMP .-4

PRQMRK,	JMS I [PRNAME
	JMP I [PRINTQ
	IFNZRO PRQMRK-1357 <SEECCL,ZZXX>
	ZBLOCK 1	/A FREE LOCATION!

	IFNZRO .-1362 <FIXCCL,ERRRR>

GETCCL,	TAD [6003
	JMS I [RESET
	TAD [67		/CCL OVERLAY BLOCK IS BLOCK 67 ***
	DCA OV
	JMP DATE2
DATE,	TAD TMP
	SNA CLA
	JMP I [CCLSW-1	/USED TO BE JMP GETCCL
DATE2,	JMS I [SHNDLR	/READ IN DATE OVERLAY
	0201
	0400
OV,	MSOVL2
	JMP KMONER
	JMP I [600
	PAGE
\f	*1400
SAVE2A,	JMS I [SHNDLR
	0201
	400
	MTEMP+10
	JMP KMONER
SAVE3,	TAD [603
	DCA XR
	TAD I [600
	DCA TM1
	TAD TM1
	JMS I [CCBTST	/CHECK TM1 FOR VALID CCB
SAVE3A,	ISZ XR
	TAD I XR	/GET THE I/O CONTROL WORD OF THIS SEGMENT
	JMS I PROTAT	/EXTRACT THE LENGTH FROM IT
	TAD CLENGT
	DCA CLENGT	/UPDATE THE LENGTH OF THE FILE
	ISZ TM1
	JMP SAVE3A		/LOOP FOR ALL SEGMENTS OF THE FILE
	TAD CLENGT	/USE THIS LENGTH WHEN ENTERING THE FILE
	CLL RTL
	RTL
	TAD SENTER
	CIF 10
	JMS I SYSTEM
	3		/ENTER
SFILE,	NM1
	0		/LENGHT UNIMPORTANT
	JMP SAVERR
	TAD SENTER
	CIF 10
	JMS I SYSTEM
	4		/CLOSE
	NM1		/NAME FOR "CLOSE"
CLENGT,	1		/CLOSING LENGTH
	JMP SAVERR
	TAD [603
	DCA XR
	JMS I PGTOUT	/KICK THE I/O MONITOR OUT IF NECESSARY
	TAD I [JSBITS
	RAL
	CMA		/IF JOB LOADS INTO LOCS 0-1777,
	SNL SMA CLA	/BUT NOT INTO LOCS 10000-11777,
	JMS LOADF0	/LOAD 0-1777 INTO 10000-11777 NOW
	TAD SFILE
	DCA SWFILE
	JMS SWRITE	/WRITE OUT CONTROL BLOCK
SAVE4,	TAD I XR
	DCA SADR
	CLA CLL CML RAR
	TAD I XR
	DCA SCTL
\fSAVE5,  TAD SADR
        RAL
        SZL SPA CLA     /DOES THIS SEGMENT START BELOW 2000?
        JMP SAVE8       /NO - NOTHING TO WORRY ABOUT
        TAD SCTL
        AND [70
        SZA CLA         /FIELD 0?
        JMP SAVE8       /NO - SAVE AS IS
SAVE6,  JMS LOADF0      /LOAD THE FIELD 0 SAVE AREA OVER THE I/O MONITOR
SAVE7,  CLA CMA
        TAD SCTL
        CLL RAL
        TAD SADR
        RAL
        SZL SPA CLA     /CHECK WHETHER UPPER LIMIT IS ABOVE 2000
        JMP SAVE7A      /IT IS - MUST MAKE 2 WRITES
        TAD SCTL        /TOTALLY CONTAINED IN 0-1777
        TAD [10		/CHANGE FIELD 0 TO FIELD 1 AND CONTINUE
        JMP SAVE8A
SAVE7A, TAD SCTL        /WRITE IN 2 PARTS -
        DCA TM1
        TAD SADR
        CIA	     /FIRST PART FROM FIELD 1, EVERYTHING BELOW 2000
        TAD [2020
        CLL CML RAR
        DCA SCTL
        JMS SWRITE
        CLA CLL CML RTR
        DCA SADR
        TAD SCTL        /SECOND PART FROM FIELD 0, EVERYTHING ABOVE 2000
        AND [3700
        CIA
        TAD TM1
	SMA		/FULL FIELD SAVE IN F0 MAKES THIS +
	TAD [4000	/COMPENSATE FOR THAT CASE
SAVE8A, DCA SCTL
SAVE8,  JMS SWRITE
        ISZ I [600
        JMP SAVE4
SAVE12, JMS I [SHNDLR
        0610
        0
        MONTOR          /FORCE THE I/O MONITOR BACK INTO CORE
        JMP KMONER      /(OY VEH!)
        CLA CMA
        CDF 10
        DCA I [7700     /TELL THE KEYBOARD MONITOR THAT ITS IN CORE
        JMP I [7605     /*** DEPENDS ON 7605 BEING A CDF CIF 10 ***

\fLOADF0,	0
	ISZ F0OVLY	/HAS THE FIELD 0 OVERLAY BEEN LOADED BEFORE?
	JMP I LOADF0	/EVIDENTLY
	JMS I [SHNDLR
	1010
F0OVLY,	-1		/WILL BE 0 IF WE EXECUTE THIS CODE, OF COURSE
	MTEMP+4
	JMP KMONER
	JMP I LOADF0

SWRITE,	0
	JMS I DEVHND
SCTL,	4101
SADR,	600
SWFILE,	0
	JMP SAVERR
	TAD SCTL
	JMS I PROTAT
	TAD SWFILE
	DCA SWFILE	/BUMP RECORD NUMBER
	JMP I SWRITE
SAVERR,	JMS I [PRMESG
	TEXT	/SAVE ERROR/
PROTAT,	ROTAT
\f	*1600
KMER4,	JMS I [PRMESG
	TEXT	/TOO FEW ARGS/
CCBTST,	0	/EXAMINE COUNT WORD OF CCB FOR VALIDITY
			/ASCII AND BINARY FILES USUALLY FAIL THIS TEST
	CMA
	AND [7740
	SNA CLA
	JMP I CCBTST	/IT WAS VALID
CIERR,	TAD [7605
	DCA ERRET	/RELOAD MONITOR ON THIS ERROR
	JMS I [PRMESG	/IT WASN'T - TELL THE USER
	TEXT	/CORE IMAGE ERR/
GETOUT,	0		/SUBROUTINE TO KICK MONITOR OUT IF NECESSARY
	TAD I [JSBITS
	RAR
	CLA
	TAD SYSTEM
	SZL SPA CLA	/IS THE SYSTEM IN CORE AND SHOULD IT BE?
	JMP I GETOUT
	CIF 10		/YES AND NO - KICK IT OUT
	JMS I SYSTEM
	11		/BYE BYE
	TAD [7700
	DCA SYSTEM
	JMP I GETOUT
\fSVLNBF,
KMER2,	JMS I [PRNAME
	JMS I [PRMESG
	TEXT	/ NOT FOUND/
/
/NEXT 112 LOCATIONS DESTROYED BY THE LINE BUFFER DURING A SAVE
/

RESET,	0
	DCA I [JSBITS	/MARK AREAS FOR I/O OPTOMIZATION
	JMS I [MINCOR
	CIF 10
	JMS I SYSTEM
	13		/RESET DEVICE HANDLERS AND OUTPUT FILES
/V3D	CDF 0		/THIS INSTRUCTION SEEMS UNNECESSARY
	JMP I RESET

RCHK,	0
	AND I RADR	/V3D
	AND [200	/CAN'T ALLOW BOTH OS78 BIT AND SYSTEM CUSP BIT
	SNA CLA
	JMP I RCHK
	JMP CIERR	/V3D CAN'T FALL INTO KMER3
			/BECAUSE HAVE TO RELOAD KBM TO RESET 'PGNAME'
KMER3,	JMS I [PRMESG
	TEXT	/NO!!/

RUN6,	TAD I TM1	/STORE CONTROL WORD FOR LAST SEG.
	DCA I [MREAD+1
	TAD RUNSW	/IS THIS R OR RUN?
	SNA CLA
	JMS I [WRCTLB	/RUN
	TAD I RFILE	/V3D FOR LINKER
	DCA I RCTL	/V3D SAVE BLOCK NUMBER IN 'SOFSET'
	TAD I RFILE
RUN7,	IAC
	DCA RUNFIL		/STORE STARTING BLOCK NUMBER
	TAD DEVHND
	DCA I [MREAD-1
	TAD DEVHND
	DCA RUNHND		/STORE DEVICE HANDLER ENTRY IN THIS PAGE
	TAD I ADR1
	DCA I ADR2
	ISZ ADCNT
	JMP .-3
	JMP I .+1		/AND GO TO IT
	RUN8&177+7400

RFILE,	FILE
ADCNT,	RUN8&177+7600
\fRUN8,	ISZ I R7400	/IS THIS THE LAST PARAMETER PAIR?
	JMP RUN9	/NO - KEEP LOADING
	TAD RUNFIL
	DCA I RMRD3	/MOVE THE RECORD NUMBER INTO THE FINAL READ
	TSF
RUNTWT,	JMP .-1		/WAIT FOR THE TELETYPE TO DIE DOWN (RF08 IS FAST!)
	JMP I .+1
	MREAD		/READ THE LAST SEGMENT AND START UP
RUN9,	TAD I RUNADR
	DCA RADR	/SET UP THE LOADING ADDRESS OF THE CURRENT SEGMENT
	ISZ RUNADR
	TAD I RUNADR
	DCA RCTL	/AND THE READ CONTROL WORD
	JMS I RUNHND
RCTL,	SOFSET		/V3D THESE ARE STORED INTO ONLY AFTER MOVING
RADR,	OS78		/V3D
RUNFIL,	0
	JMP RERR		/INPUT ERROR READING THE PROGRAM
	TAD RCTL
	JMS ROTAT		/GET THE BLOCK LENGTH OF THIS SEGMENT
	TAD RUNFIL
	DCA RUNFIL		/UPDATE THE BLOCK NUMBER FROM IT
	ISZ RUNADR
	JMP RUN8		/BACK FOR ANOTHER ONE

RERR,	CIF 10
	JMS I RU7700
	7
	0	/TOTALLY MEANINGLESS
RUNADR,	CCB+4
R7400,	7400
RMRD3,	MREAD+3
RU7700,	7700
RUNHND,	0
	IFNZRO ROTAT-SVLNBF-112&4000 <ERROR>
	*1765	/MUST BE AT TOP OF PAGE
ROTAT,	0
	CLL RTR
	RTR
	RTR
	AND RU37
	SNA
	TAD RU37
	IAC
	CLL RAR
	JMP I ROTAT
RU37,	37
\f	/OVERLAY TO KEYBOARD MONITOR FOR "SAVE" WITH ARGUMENTS
	*2000		/GOES INTO 400
SAVE1A,	TAD (1603
	DCA X1
	DCA TM1
	CDF 10
	DCA I [OLDT9
S6203,	CIF CDF 0
	TAD (SGETOUT-RSOVL2	/POINTER TO NEW GETOUT

	DCA PGTOUT		/LIKEWISE "GETOUT"
	JMS I [SHNDLR
	0210
	1400
	MTEMP+10		/READ IN CONTROL BLOCK
	JMP KMONER
	JMS LXRBAK		/RESET LXR TO LOOK AT FIRST CHAR
	JMS LXRBAK
	DCA DASHFG
SNUMLP,	JMS SGTNUM
	JMP SDLOOK	/NO NUMBER - GET DELIMETER
	TAD I LXR
	TAD (-"-
	SNA CLA
	JMP SVDASH
	JMS LXRBAK
	TAD DASHFG
	SNA CLA		/WAS THERE A LOWER LIMIT?
	JMS DASHSB	/NO - SET LOWER LIMIT TO UPPER LIMIT
	TAD TEMP1
	CIA CLL CML
	TAD OLD1
	SZA CLA	/ARE THE FIELDS THE SAME?
	JMP KMER5	/NO - ERROR
	TAD TEMP2
	AND [7600
	TAD [200
	DCA TEMP2
	TAD TEMP2
	CIA
	TAD OLD2
	SZL CLA		/IS UPPER LIMIT > LOWER LIMIT?
	JMP KMER5	/NO - ERROR
	CDF 10
	TAD OLD1
	DCA I X1
	TAD OLD2
	DCA I X1
	TAD TEMP2
	DCA I X1	/CREATE A TRIPLET(FIELD, LOW LIMIT, HIGH LIMIT)
			/IN THE TABLE IN FIELD 1
	ISZ TM1		/BUMP ENTRY COUNT
\fSDLOOK,	CDF 0
	TAD I LXR
	SNA
	JMP I (SVEND-RSOVL1
	TAD (-",
	SNA
	JMP SNUMLP-1
	TAD (",-";
	SNA
	JMP SSTADR
	TAD (";-"=
	SNA CLA
	JMP I (SSBITS-RSOVL1
KMER5,	JMS I [PRMESG
	TEXT	/BAD ARGS/
LXRBAK,	0
	CLA CMA
	TAD LXR
	DCA LXR
	JMP I LXRBAK
SVDASH,	TAD DASHFG
	SZA CLA
	JMP KMER5
	ISZ DASHFG
	JMS DASHSB
	JMP SNUMLP
SSTADR,	JMS SGTNUM
	JMP KMER5	/NULL STARTING ADR - ERROR
	TAD TEMP1
	AND [7
	CLL RTL
	RAL
	TAD S6203
	CDF 10
	DCA I (1601	/STORE AWAY STARTING FIELD
	TAD TEMP2
	DCA I (1602	/AND STARTING ADDRESS
	JMP SDLOOK
DASHSB,	0
	TAD TEMP1
	AND [7
	DCA OLD1
	TAD TEMP2
	AND [7600
	DCA OLD2
	JMP I DASHSB
DASHFG,	0
OLD1,	0
OLD2,	0

\fSGTNUM,	0	/GET A NUMBER ROUTINE
	DCA DIGFLG	/CLEAR DIGIT COLLECTED FLAG
	DCA TEMP1
	DCA TEMP2
	JMS I (STARTX-RSOVL1
	JMP .+4
	TAD (20
	SNA CLA
	JMP .-4
	JMS LXRBAK	/SHOVE INDEX BACK
	TAD DIGFLG	/IS DIGIT PRESENT?
	SZA CLA
	ISZ SGTNUM
	JMP I SGTNUM
	PAGE
\f	*2200	/LOADS INTO 600
SSBITS,	JMS I (SGTNUM-RSOVL1
	JMP I (KMER5-RSOVL1
	TAD TEMP2
	CDF 10
	DCA I (1603
	JMP I (SDLOOK-RSOVL1
SVEND,	JMS I [SHNDLR
	0101
	0400
	MSOVL2		/READ IN SECOND PART OF OVERLAY
	JMP KMONER
	TAD TM1
	SNA
	JMP I (MOVECB-RSOVL2
	CIA
	CDF 10
	DCA I (1600
		/NOW SORT THE ENTRIES IN THE SEGMENT TABLE ON 
		/DECREASING FIELD AND INCREASING ADDRESS
		/WITHIN THE FIELD.
	TAD (1603
	DCA P1
	CLA IAC
	TAD I (1600
	SNA
	JMP I (SORTED-RSOVL2	/RIDICULOUS TO SORT ONE ITEM
	DCA TEMP1
OUTRLP,	TAD (3
	TAD P1
	DCA P2
	TAD TEMP1
	DCA TEMP2
INERLP,	TAD P1
	DCA LXR
	TAD P2
	DCA X1
	TAD I LXR
	CIA CLL
	TAD I X1
	SNA CLA
	JMP TIE		/FIELDS ARE EQUAL - SORT ON ADDRESS IN FIELD
	SZL
	JMP SWITCH	/WRONG ORDER - SWITCH 'EM
TIENTY,	TAD P2
	TAD (3
	DCA P2		/INDEX TO NEXT ENTRY
SWNTRY,	ISZ TEMP2
	JMP INERLP
	TAD P1
	TAD (3
	DCA P1		/ELEMENT IS IN PLACE - GO TO NEXT POSITION
	ISZ TEMP1
	JMP OUTRLP
	JMP I (SORTED-RSOVL2	/SORT COMPLETE - CHECK FOR CONSISTENCY
\fTIE,	TAD I LXR
	CIA CLL
	TAD I X1
	SZL CLA		/TEST FOR ADRESSES IN ASCENDING ORDER
	JMP TIENTY	/YES - DONT HAVE TO SWAP
SWITCH,	JMS SWSUBR
	JMS SWSUBR
	JMS SWSUBR
	CLA CLL CMA RTL
	TAD P1
	DCA P1		/RESET FIRST POINTER
	JMP SWNTRY	/AND DONT BUMP 2D POINTER, AS WE HAVE JUST BUMPED IT
SWSUBR,	0
	ISZ P1
	ISZ P2
	TAD I P1
	DCA TM1
	TAD I P2
	DCA I P1
	TAD TM1
	DCA I P2
	JMP I SWSUBR
P1,	0
P2,	0

\fSTARTX,	0
	TAD I LXR	/ANYTHING LEFT?
	SNA
	JMP I STARTX	/NO.. TAKE EMPTY RETURN
	SKP
ADGTLP,	TAD I LXR
	TAD (-270
	CLL		/SEE IF THIS IS A DIGIT
	TAD [10
	SNL
	JMP AONUM	/NO.. GET OUT
	DCA TMP1
	ISZ DIGFLG
	JMS ROT2
	JMS ROT2
	JMS ROT2
	TAD TEMP2
	TAD TMP1
	DCA TEMP2
	JMP ADGTLP	/KEEP LOOKING
AONUM,	ISZ STARTX
	JMP I STARTX

ROT2,	0
	TAD TEMP2
	CLL RAL		/WE NEED THIS BECAUSE THE HANDLER
	DCA TEMP2	/WIPED THE FIRST COPY (MAYBE!!!)
	TAD TEMP1
	RAL
	DCA TEMP1
	JMP I ROT2
	PAGE
\f	*2400		/LOADS INTO 400 ON TOP OF SAVE1A
SORTED,	TAD I (1600
	IAC
	SNA		/IS THERE ONLY ONE ITEM IN THE LIST?
	JMP MERGED	/YES - DON'T COMPRESS FURTHER
	DCA TEMP1
	TAD (1603
	DCA X1
	TAD (1606
	DCA LXR
		/NOW CHECK THE SORTED FILE FOR CONSISTENCY
		/OVERLAPPING SEGMENTS ARE ERRORS,
		/ABUTTING SEGMENTS ARE TO BE CONDENSED IN
		/THE INTERESTS OF SPEED
MRGLP,	TAD I LXR
	CIA
	TAD I X1
	SZA CLA
	JMP NOCMPR	/DIFFERENT FIELDS - INCOMPARABLE
	ISZ X1
	TAD I X1
	CIA
	CLL
	TAD I LXR
	SNA CLA
	JMP BUTTNG	/UPPER LIMIT(2)=LOWER LIMIT(1) - ABUTTING SEGMENTS
	SZL CLA
	JMP NXTONE	/UPPER LIM(2)<LOWER LIM(1) - NORMAL CASE
	CDF 0		/UPPER LIM(2) > LOWER LIM(1) - ERROR
	JMS I [PRMESG
	TEXT	/BAD ARGS/
BUTTNG,	CLA CMA
	TAD X1
	DCA X1
	TAD I LXR
	DCA I X1	/SET UPPER LIM(2) = UPPER LIM(1)
	TAD X1
	TAD (-1777
	SZA CLA
	JMP .-5		/AND COMPRESS OUT THE LOWER ENTRY
	ISZ I (1600	/DECREMENT THE ENTRY COUNT (CAN'T OVERFLOW)
	JMP SORTED	/START OVER FROM BEGINNING

NOCMPR,	ISZ X1
	ISZ X1
	ISZ LXR
NXTONE,	ISZ LXR
	ISZ TEMP1
	JMP MRGLP	/NOW ALL THAT REMAINS IS TO TRANSFORM OUR TRIPLETS
			/INTO THE FORMAT WHICH THE RUN LOADER EXPECTS; I.E.
		/DEVICE-HANDLER ARGUMENTS
\fMERGED,	TAD (1603
	DCA LXR
	TAD (1603
	DCA X1
	TAD I (1603
	AND (1777
	TAD (6000
	DCA I (1603	/INITIALIZE STATUS BITS TO NO OVERLOADS
	TAD I (1600
	DCA TEMP1
MERGLP,	TAD I LXR
	DCA TEMP2
	TAD I LXR
	AND (7400
	DCA TMP1
	TAD TMP1
	DCA I X1	/STORE ADDRESS
	TAD TMP1
	CIA
	TAD I LXR	/FORM UPPER LIM - LOWER LIM
	CLL RTR
	RTR
	TAD TEMP2	/ADD IN FIELD
	RAL
	RTL		/ROTATE WHOLE MESS INTO PLACE
	DCA I X1
	TAD TMP1
	CLL RAL
	SZL SPA CLA	/IS THE LOWER LIMIT < 2000?
	JMP NXTSEG	/NO
	TAD TEMP2
	RAR
	SZA CLA		/YES- IS THE FIELD 0 OR 1?
	JMP NXTSEG	/NO
	SNL
	IAC
	CMA CML RTR
	AND I (1603	/AND OUT THE PROPER OVERLOAD BIT
	DCA I (1603
NXTSEG,	ISZ TEMP1
	JMP MERGLP
MOVECB,	TAD (1577
	DCA LXR
	TAD (577
	DCA X1
	TAD [7600
	DCA TEMP1
CBMOVE,	CDF 10		/FINAL CODE TO MOVE NEW CONTROL BLOCK
	TAD I LXR	/INTO PAGE 600 OF FIELD 0
	CDF 0
	DCA I X1
	ISZ TEMP1
	JMP CBMOVE
	JMP I (SAVE3		/EXIT TO SAVE PROCESSOR 

\fSGETOUT,0		/REPLACES "GETOUT" WHICH WE'VE STORED OVER
	TAD I [JSBITS
	RAL		/ONLY PERFORMS THOSE FUNCTIONS THAT "SAVE" NEEDS
	SPA CLA
	JMP I SGETOUT
	CIF 10
	JMS I SYSTEM
	11
DECIMB,	JMP I SGETOUT	/DECIMB ONLY CALLED BY NEXT PAGE
			/PART OF NEXT PAGE'S ROUTINE:
	TAD NM2		/ALL NEW FOR V3D
	TAD NM4		/ONLY ALLOW 2 CHARS FOR MM
	SNA CLA
	ISZ DECIMB
	TAD NM1
	RTR
	RTR
	JMP I DECIMB
	PAGE
\f	*2600		/DATE PROCESSOR - LOADS IN 400, RUNS IN 600
DATEXX,	JMS DECIM
NUM2,	DCA NUM2
	TAD NUM2
	TAD M40
	SMA CLA
	JMP BADNUM	/DAY > 31
	JMS I GNAME
L30,	30		/NOTHING FOUND WILL GIVE ERROR LATER
/	DCA NUM1	/NUM1 IS INITIALLY 0
NEWLUP,	ISZ MONPTR
	ISZ NUM1
	TAD I MONPTR
	ISZ MONPTR
	SMA
	JMP BADNUM	/SYMBOLIC MONTH NOT FOUND
	TAD NM1
	SNA CLA		/SKIP IF FIRST 2 LETTERS DON'T MATCH
	TAD NM2
	TAD I MONPTR
	SZA CLA
	JMP NEWLUP	/SECOND 2 LETTERS DON'T MATCH
/*** TEST DELIMETER HERE
	TAD NUM1
	CLL RTL
	RTL
	RAL
	TAD NUM2
	RTL
	RAL
	DCA NUM2
	DCA DDELIM	/MAKE END-OF-LINE THE DELIMITER
	JMS DECIM
	TAD (-106	/SCALE DOWN TO RANGE 1970-1999
	SPA
	JMP BADNUM	/DIDN'T MAKE THE RANGE
	DCA NUM1
	TAD NUM1
	AND L30		/ISOLATE EXTENSION DATE BITS
	CLL RTL
	RTL
	DCA TM1
	TAD I (BIPCCL
	AND L7177	/STORE THEM INTO BITS RESERVED FOR THIS PURPOSE
	TAD TM1
TSLUP,	DCA I (BIPCCL
	TAD NUM1
	AND [7
	TAD NUM2	/COMBINE WITH MONTH AND DAY
	CDF 10
	DCA I (MDATE	/STORE IN SYSTEM DATE CELL
	TSF		/7605 SETS THE DF
	JMS L7177	/TIME OUT A BIT
	JMP I [7605	/IN CASE RUNNING UNDER BATCH
L7177,	7177		/JMS IS LONGER THAN JMP
	ISZ DDELIM	/DDELIM IS 0 AT END
	JMS TSLUP	/WAIT FOR TELETYPE TO DIE DOWN (RF08)
	JMP I [7605	/RETURN TO MONITOR
\fDDELIM,	-"-

/WOULD LIKE TO BRANCH TO CCLSW-1 IF DATE ENDED WITH ALTMODE

CNV,	0
	AND [77
	SNA
	JMP NUL
	TAD (-60
	SPA
	JMP BADNUM
	JMP I CNV
NUL,	TAD TM1
	JMP GODE

DECIM,	0
	JMS I GNAME
M40,	-40		/NOTHING THERE (LOGIC WILL CAUSE ERROR LATER)
	TAD TMP
	TAD DDELIM	/COMPARE AGAINST DESIRED DELIMETER
	SNA CLA		/DASH OR NULL
	JMS I (DECIMB-2400+400
	JMP BADNUM	/DELIMETER BAD
	RTR
	JMS CNV
	DCA TM1
	TAD TM1
	CLL RTL
	TAD TM1
	RAL
	DCA TEMP2
	TAD NM1
	JMS CNV
	TAD TEMP2
GODE,	SZA
	JMP I DECIM
BADNUM,	CLA		/CRAP IN AC
	TAD [7605
	DCA ERRET
	JMS I [PRMESG
	TEXT	/BAD DATE/
NUM1,	0		/MONTH NUMBER (MUST BE 0 INITIALLY)
\fMONS,	-1201	/JAN
	-1600
	-0605	/FEB
	-0200
	-1501	/MAR
	-2200
	-0120	/APR
	-2200
	-1501	/MAY
	-3100
	-1225	/JUN
	-1600
	-1225	/JUL
	-1400
	-0125	/AUG
	-0700
	-2305	/SEP
	-2000
	-1703	/OCT
	-2400
	-1617	/NOV
	-2600
	-0405	/DEC
	-0300
MONPTR,	MONS-2600+600-1	/RELOCATES TO PAGE 600
			/MUST BE POSITIVE

	PAGE
\f	*3000	/MONITOR ERROR PROCESSOR - LOADS INTO 11400
DLYLPX,	AND I 0
D7600,	7600
	TAD MERRNO
	CLL RAL
	ISZ I (ZERO-1400
	ISZ I (ZERO-1400	/V3C
	ISZ I (ZERO-1400
	JMP DLYLPX	/WAIT FOR TELEPRINTER (WITHOUT CDF'S)
	SNA
	JMP USRERR
	CLL RAL
	RTL
	RTL
	TAD (6040
	DCA I (MERTYP-1400
MERCMN,	TAD (MERRXR-1400
	JMS EPRINT
	TAD I (FPUTX
	RTR
	RAR
	AND (7
	TAD (60
	JMS MERPCH
	CLA CLL CMA RAL
	TAD I (MONITO
	RAL
	DCA T1
	TAD (-4
	DCA T2
MEROLP,	TAD T1
	RTL
	RAL
	DCA T1
	TAD T1
	AND (7
	TAD (60
	JMS MERPCH
	ISZ T2
	JMP MEROLP
	TAD MERRNO
	CLL RAL
	SNA
	JMP NOEXPL	/NO EXPLANATION FOR USER ERRORS
	CLL RAR
	TAD (EXPLTBL-1401	/PRINT EXPLANATION
	DCA T1		/GET ADDRESS INTO MESSAGE TABLE
	TAD (240
	JMS MERPCH
	TAD ("(
	JMS MERPCH
	TAD I T1	/GET ADDRESS OF MESSAGE
	JMS EPRINT
	TAD (")
	JMS MERPCH
	TAD MERRNO
NOEXPL,	TAD (3773
	SPA CLA
	CLA CMA
	DCA I (7700
	DCA OLDT9
	CLA CLL CML RAR
	DCA MERRNO
	CDF 0
	TAD I (JSBITS
	AND (6777
	TAD (1000
	DCA I (JSBITS	/SET THE CURRENT JOB UNSTARTABLE
	CDF CIF 0
	JMP I D7600
USRERR,	CLA CLL
	JMS I (FGET
	TAD (4060
	DCA I (UERTYP-1400
	TAD (UERRXR-MERRXR
	JMP MERCMN
MERPCH,	0
	TLS
	TSF
	JMP .-1
	CLA
	JMP I MERPCH
ZERO,	0
\fEPRINT,	0
	DCA T2
EPRLUP,	TAD I T2
	RTR
	RTR
	RTR
	JMS EPR
	TAD I T2
	JMS EPR
	ISZ T2
	JMP EPRLUP

EPR,	0
	AND (77
	SNA
	JMP I EPRINT
	TAD (240
	AND (77
	TAD (240
	JMS MERPCH
	JMP I EPR
	PAGE
\f	*3200		/LOADS INTO 1600

MERRXR,	TEXT	\MONITOR ERROR 0 AT \
	MERTYP=MERRXR+7

UERRXR,	TEXT	\USER ERROR 0 AT \
	UERTYP=UERRXR+5

EXPLTBL,MON1-1400
	MON2-1400
	MON3-1400
	MON4-1400
	MON5-1400
	MON6-1400
	MON7-1400

MON1,	TEXT	\CLOSE ERROR\
MON2,	TEXT	\DIRECTORY I/O ERROR\
\fMON3,	TEXT	\DEVICE HANDLER NOT IN CORE\
MON4,	TEXT	\ILLEGAL USR CALL\
MON5,	TEXT	\I/O ERROR ON SYS:\
MON6,	TEXT	\DIRECTORY OVERFLOW\
MON7,	TEXT	\RESERVED\
\f		/EXECUTION TIME LOADER FOR MONITOR "CHAIN" COMMAND
	*3400	/EXECUTES IN FIELD 0 IN PAGE 7400
MCHNX,	DCA MCHREC		/STORE STARTING RECORD #
	TAD MCHREC
	DCA I (SOFSET	/V3D SAVE STARTING ADDRESS
	CIF 10
	JMS I (200
	13		/RESET ALL DEVICE ASSIGNMENTS
	0		/BUT DON'T CLEAR OUTPUT FILES
	CIF 10
	JMS I (200
	11		/KICK MONITOR OUT AND RESTORE CORE IF NECESSARY
	JMS MCHRD	/PARAMETERS PRESET TO READ CONTROL BLOCK INT0 7200
	TAD I (7200	/TEST FOR SAVE FILE!
	CMA		/TEST FOR VALID CCB
	AND (7740
	SZA CLA
	JMP CHERR
	TAD I (7201
	DCA I (MSTCDF	/TRANSFER INFORMATION FROM CONTROL BLOCK
	CLA IAC
	TAD I (7202
	DCA I (MSTADR	/TO PAGE 7600
	TAD I (7203
	TAD (1000
	DCA I (JSBITS
	TAD (7204
	DCA MCHT1
	TAD MCHFJM
	DCA I (MSWITC
	TAD (TCF
	DCA I (MSTCDF+1
MCHN1,	ISZ I (7200
	JMP MCHN2
	TAD I MCHT1
	DCA I (MREAD+2
	ISZ MCHT1
	TAD I MCHT1
	DCA I (MREAD+1
	TAD MCHREC
	DCA I (MREAD+3
	TAD (SHNDLR
	DCA I (MREAD-1
	JMP I (MREAD
MCHN2,	TAD I MCHT1
	DCA MCHADR	/SET UP COMMAND TO READ NEXT SEGMENT
	ISZ MCHT1
	TAD I MCHT1
	DCA MCHCTL
	JMS MCHRD	/READ IT
	ISZ MCHT1
	JMP MCHN1	/LOOP ON NUMBER OF SEGMENTS
\fMCHRD,	0
	JMS I (SHNDLR
MCHCTL,	0101		/1 RECORD INTO FIELD 0 STARTING FORWARDS
MCHADR,	7200
MCHREC,	0
	JMP CHERR	/CHAIN ERROR
	TAD MCHCTL
MCHBMP,	CLL RTR
	RTR
	RTR
	AND (37
	SNA		/V3C
	TAD (40		/0 MEANS FULL 4K READ
	IAC
	CLL RAR
	TAD MCHREC
	DCA MCHREC
	JMP I MCHRD
MCHT1,	0
MCHFJM,	MSTCDF&177+5200	/"JMP MSTCDF"

CHERR,	ISZ CHERR1
	JMP CHERR	/LET TTY DIE DOWN
	ISZ CHERR2
	JMP CHERR
CHTADC,	TAD CHARS
	SNA
	JMP I (7600	/DONE..BACK TO MONITOR
	TLS
	TSF
	JMP .-1
	CLA
	ISZ CHTADC	/NEXT LETTER
	JMP CHTADC
\fCHERR1,	0
CHERR2,	-6
CHARS,	"C;"H;"A;"I;"N;" ;"E;"R;"R;215;212;0
	PAGE
\f	*4000	/SYSTEM GENERATOR - WRITES STUFF OUT USING SHNDLR
	WRITE=JMS I SYSHND
	JMS SYSSWP	/SWAP SYSTEM DEVICE HANDLER INTO 7600

	WRITE;	4200;	7400;	0;	JMP BERR	/BOOTSTRAP
	TAD RBFLAG
	SZA CLA
	JMP .+6
	WRITE;	4210;	DCOUNT;	01;	JMP BERR	/DIRECTORY
	WRITE;	5001;	0000;	07;	JMP BERR	/KEYBOARD MONITOR
	WRITE;	4610;	0000;	MONTOR;	JMP BERR	/USR
	WRITE;	4111;	3400;	MEOVLY;	JMP BERR	/"ENTER" OVERLAY
	WRITE;	4701;	2000;	MSOVLY;	JMP BERR	/SAVE OVERLAY,
					/ERROR ROUTINE AND "CHAIN"
	TAD RBFLAG
	SZA CLA
	JMP .+13
	WRITE;	4101;	LDRCTL;	MFREE;	JMP BERR	/ABSLDR CONTROL BLOCK
	WRITE;	5010;	2000;MFREE+1;	JMP BERR	/ABSLDR
	JMS I (4200	/OUTPUT THE DEVICE HANDLERS
	JMP BERR
	JMS SYSSWP	/SWAP BACK PAGE 7600
	CLA CMA
	HLT
	CLA
	JMP I .+1
BERR,	7600
	JMS SYSSWP
	HLT
	JMP .-1
W6600,	6600
W7600,	7600
SYSSWP,	0
	TAD W6600
	DCA SYTM1
	TAD W7600
	DCA SYTM2
SWAPLP,	TAD I SYTM1
	DCA TMSY
	TAD I SYTM2
	DCA I SYTM1
	TAD TMSY
	DCA I SYTM2
	ISZ SYTM1
	ISZ SYTM2
	JMP SWAPLP
	JMP I SYSSWP

	/CONTROL BLOCK FOR ABSOLUTE LOADER
LDRCTL,	7777	/ONE CONTIGUOUS LOAD
	6213	/STARTING ADDRESS IN FIELD 1
	2000	/STARTING LOCATION=12000
	6003	/DOES NOT LOAD OVER EITHER MONITOR AREA
		/ALSO DOES NOT USE THESE AREAS AT COMMAND TIME - TRUE
		/ONLY FOR FIRST CALL TO COMMAND DECODER
	2000	/FIRST(AND ONLY) SEGMENT STARTS AT 2000
	1010	/IN FIELD 1 AND IS 10 PAGES LONG

	IFNZRO LDRCTL-4113 <BLDER,XQX>

SYTM1,	0
SYTM2,	0
TMSY,	0
SYSHND,	7607
	PAGE
\f	*7400
	NOPUNCH
	*7600
	ENPUNCH
	/UPPER PAGE OF FIELD 1 - CHOCK FULL OF GOODIES
	/LIKE THOUSANDS OF TABLES AND THE MONITOR CALL LOCATION

MOFILE,	ZBLOCK 17	/OUTPUT FILE TABLE - 7600-7616 (3 ENTRIES MAX)
			/5 WORDS PER ENTRY - DEVICE # AND FILE NAME
MIFILE,	ZBLOCK 24	/INPUT FILE TABLE - 7617-7642 (10 ENTRIES MAX)
			/2 WORDS PER ENTRY - DEVICE # AND RECORD #

			/LAST WORD IN TABLE CONTAINS TERMINATION INDICATOR
			/(0 FOR CR, 1 FOR ALTMODE) AND HIGH ORDER
			/PART OF NUMERICAL ARGUMENT

MPARAM,	ZBLOCK 4	/PARAMETER TABLE - 7643-7646
			/FIRST 3 WORDS - MASK OF SWITCHES(A-Z,0-9).
			/FOURTH WORD - CONTAINS THE LOW ORDER BITS OF
			/THE NUMERICAL ARGUMENT



			/TABLE OF DEVICE HANDLERS PRESENTLY IN CORE
DVHNDL,	7607;7607;0;0;0;0;0
	0;0;0;0;0;0;0;0
MDATE,	0		/HOLDS THE CURRENT DATE- 4 BIT MONTH,
			/5 BIT DAY, 3 BIT YEAR FROM 1970
MGET,	CIF 0
	JMS SHNDLR	/INST FIELD IS 0
	1000		/READ 4 RECORDS INTO FIELD 0
	0		/LOCATIONS 0-1777
	7		/KEYBOARD MONITOR FOLLOWS DIRECTORY
PJSBTS,	JSBITS		/SERVES AS A HALT (WATCH IT!)
SCDCIF,	CDF CIF 0
	JMP I .+1
	KMNTRY		/V3D GETS CHANGED TO INIT
\fMCALL1,	0
	DCA MARG1	/SAVE AC AS IT MAY CONTAIN AN ARGUMENT
	RDF	/GET CALLING FIELD
	TAD SCDCIF
	DCA SMCIF
	CDF 0
	TAD I PJSBTS
	RAR
	CDF 10
	SZL CLA		/DOES JOB USE LOCS 10000-11777?
	JMP MONRD	/NO - DONT SAVE THEM
	CIF 0
	JMS SHNDLR
	5010
	0
	MTEMP
	HLT
MONRD,	CIF 0
	JMS SHNDLR
	610
	0
	MONTOR
SCOPE,	HLT		/BIT 4 IS A 1 IF CONSOLE IS A SCOPE
	JMP MSTART	/START THE MONITOR UP IN PAGE 0
MRETRN,	CIF 0
	JMS SHNDLR
	1010	/READ 10 RECS INTO FIELD 1
	0
	MTEMP	/TEMP REGION ON SYS
	HLT	/SYS HAS PROBLEMS
SMCIF,	0
	JMP I MCALL1
\fMARG1,	0
			/TABLE OF USER DEVICE NAMES
			/ALSO USED BY SYSTEM ODT

UDNAME,	0;0;0;0;0;0;0;0;0;0;0;0;0;0;0
\fDCB,	ZBLOCK 17		/DEVICE CONTROL BLOCK - SET IN "CONFIG"









	/********************************************************
	/	MAP OF SYSTEM DEVICE AS OF 2/21/73
	/********************************************************
	/            *   256 WORD RECORDS   *
	/********************************************************

	/	RECORDS    CONTENTS
	/	-------    --------

	/	 0	MONITOR BOOTSTRAP
	/	 1- 6	SYSTEM DIRECTORIES
	/	 7-12	KEYBOARD MONITOR
	/	13-15	I/O MONITOR(CALLABLE MONITOR)
	/	16-25	DEVICE HANDLER RECORDS
	/	26	MONITOR "ENTER" OVERLAY
	/	27-50	MONITOR SCRATCH AREA FOR SAVING CORE
	/	51-53	COMMAND DECODER
	/	54-55	"SAVE WITH ARGUMENTS" AND "DATE" OVERLAYS
	/	56	MONITOR ERROR ROUTINE
	/	57	"CHAIN" PROCESSOR
	/	60-63	SYSTEM ODT
	/	64	RESERVED FOR EXPANSION
	/65	CCL REMINISCENSES
	/	66	USED BY TWO-PAGE SYS HANDLER
	/	67	USED BY CCL (CCL OVERLAY)
	/	70-END	FILE STORAGE
\f	SHNDLR=7607	/ENTRY POINT TO SYSTEMS HANDLER

	*6600
	NOPUNCH
	*7600
	ENPUNCH

	/SYSTEM HANDLER AND FIELD 0 UPPER PAGE
	/INCLUDES BOOTSTRAP AND PART OF MONITOR CALL ROUTINE
	DVHORG=16	/DEVICE HANDLER RECORDS
	MTEMP=27
	MONTOR=13
	JMS SHNDLR
	5000		/SAVE MONITOR CORE - WRITE 5 RECORDS FROM FIELD 0
	0		/(LOCATIONS 0-1777)
	MTEMP+4
	7602		/TROUBLE WITH SYSTEM DEVICE
	CDF CIF 10
	JMP MGET	/NOW GO READ IN THE KEYBOARD MONITOR
\f	*6744	/INFORMATION ABOUT CURRENT JOB
	NOPUNCH
	*7744
	ENPUNCH
JFIELD,	6203	/A CDF CIF N INSTRUCTION TO START THE JOB
JSTART,	7600	/THE STARTING ADDRESS
JSBITS,	1000	/VARIOUS STATUS BITS - USED FOR OPTIMIZATION
		/BIT 4000 - JOB DID NOT LOAD INTO 00000-01777
		/BIT 2000 - JOB DID NOT LOAD INTO 10000-11777
		/BIT 1000	- JOB IS NOT RESTARTABLE
		/BIT 400 - DOESN'T DESTROY BATCH MONITOR
		/BIT 2    - JOB DOES NOT USE LOCS 00000-01777
		/BIT 1    - JOB DOES NOT USE LOCS 10000-11777
SOFSET,	0	/FOR FUTURE(AND MAYBE PRESENT) USE

	/DATA BREAK FILLERS FOR SYSTEM BOOTSTRAP
	7750
	7751
	7752
	7753
	7754
	7755
		/MONITOR PATCH TO HELP BLEEP LOADER
	0	/ADDRESS OF HANDLER FOR DEVICE USED
MREAD,	JMS I .-1
	0
	0
	0
	HLT
MSWITC,	JMP .+6	/ZEROED IF PG 7000 (HANDLER) MUST BE READ OVER
	JMS SHNDLR
	0300
	7000		/THIS AREA MODIFIED BY ODT
	MTEMP+6
OS78,	HLT		/BIT 4 IS A 1 IF OS/78 IS RUNNING
MSTCDF,	CDF CIF 0
	TCF		/EXIT WITH A CLEAR CONSCIENCE(ALSO A CLEAR FLAG)
	JMP I .+1
MSTADR,	0
SBLOCK,	0
BIPCCL,	0	/MORE STATUS BITS.
		/BIT 1: 1=> BATCH IS IN PROGRESS
		/BITS 6-8: FIELD OF BATCH MONITOR
		/HIGHEST CORE FIELD USED BY OS/8
		/OR 0 TO MEAN OS/8 MAY USE ALL OF CORE
\f	*0
	VERSNO		/OS/8 VERSION 3
KMONER,	CLA
	TAD [7605
	DCA ERRET
	JMS I [PRMESG
	TEXT	/SYSTEM ERR/

/THE FOLLOWING REGISTERS ARE SET TO VITAL INITIAL VALUES. TO ALTER
/THESE VALUES IS TO BRING DISASTER DOWN UPON YOUR HEAD!

LXR,	PMSRST-1
X1,	MSWITC	/THESE TWO ARE USED AT INITIALIZATION.
ADR1,	RUN8-1
ADR2,	RUN8&177+7377	/USED DURING R, AND RUN COMMANDS
XR,
AMFLAG,	0		/1 MEANS SAW ALTMODE
			/MUST NOT MOVE FOR CCL AND BATCH

	*20
RBFLAG,	0		/MUST BE AT LOCATION 20
TEMP2,	-7
SYSTEM,	7700
PCH,	PRINT
GLINE,	XGLINE
GNAME,	GETNAM
DEVHND,	7607
FUDJMP,	MSTCDF&177+5200
P6203,	6203
TMP,	PATCHLEV	/MONITOR PATCH LEVEL MUST BE AT LOC 31 FOR CCL
PGTOUT,	GETOUT
ERRET,	PCRLF		/MUST BE AT 33 FOR CCL

/THE FOLLOWING LOCS. ARE TEMPORARIES. HOWEVER, THERE IS NOW
/VITAL ONCE ONLY CODE TO HELP THE BATCH PROCESSOR. THIS CODE IS
/READ IN EVERY TIME THE KEYBOARD MONITOR IS RE-READ.

NM1,	203		/THIS MUST BE  A 203!
BATCH,			/ENTRY TO READ NEW BATCH MONITOR
NM2,	JMS I [7607	/THE BATCH INITIALIZER ALTERS  SOME VALUES
NM3,	610		/IN THIS LIST...THIS ONE**********
NM4,	0		/THIS ONE*****GETS ADDRESS OF BOS.
TEMP1,	13		/******GETS RECORD OF BOS*****
TM1,	SKP CLA		/ERROR. DON'T RUN BATCH
TMP1,	JMP BCHGO
NMCT,	DCA I KM1	/CLEAR BATCH FLAG.
PN,	JMP KMONER
PRDSW,
KM1,	7777
BCHGO,
RUNSW,	CIF CDF 0
DIGFLG,	JMP I .+1
SENTER,	KMINIT	/GETS ENTRY POINT (BOS)
KRCHK,	RCHK
\f	FIELD 1
\f	/FIELD 1
	/OS/8 MONITOR - MONITOR ROUTINES
	/THIS MONITOR IS CALLED INTO CORE BY A JMS 7700 IN FIELD 1
	/IT REPLACES CORE FROM 200-1777
	/AND INTERPRETS THE WORDS AFTER THE JMS AS A MONITOR FUNCTION
	/MONITOR FUNCTIONS ARE ASSIGN,LOOKUP,ENTER,ETC.
	MAXCMD=13
	*200
MONITO,	0	/MONITOR SUBROUTINE
	DCA MACARG	/STORE AC ARG
	DCA USERFG	/SET FLAG TO INDICATE WE WERE CALLED DIRECTLY
	RDF	/GET CALLING FIELD
	TAD [CDF CIF 0
	DCA FGETX
MRENTR,	TAD FGETX
	DCA FPUTX	/FOR LOADING AND STORING CALLING SEQUENCE
	JMS FGET	/GET FIRST ARGUMENT[AND SET DATA FIELD 1)
	ISZ MONITO
	CLL
	TAD [-MAXCMD-1
	SZL
	JMP MERROR
	TAD JMPMAX
	DCA .+1		/BRANCH TO APPROPRIATE ROUTINE WITH LINK ON
FGET,	0		/MUST PRESERVE LINK
	TAD MONITO
	JMS FGETW
	JMP I FGET
/MONITOR COMMAND DISPATCH TABLE MUST BE JAMMED BEFORE 'FPUT'
	MERROR
	MASSIGN
	MLOOKUP
	MENTER
	MCLOSE
	MCD
	MCHAIN
	MERR
	MESCAP
	MESCPR
	MASGN
MRSETP,	MRESET
FPUT,	0		/MUST FOLLOW LAST ADDRESS IN JUMP TABLE
FPUTX,	0
	DCA I MONITO
	CDF CIF 10
JMPMAX,	JMP I FPUT
MEOERR,	ISZ MERRNO
MIOERR,	ISZ MERRNO
MERROR,	ISZ MERRNO
	ISZ MERRNO
	ISZ MERRNO
	ISZ MERRNO
MERR,	CLA
	CIF 0
	JMS I [SHNDLR
	0210
	1400
	MERRTN
	HLT
	JMP I .-3
\fMCD,	CLA CLL CML RAR
	JMS CDSWAP	/SWAP OUT CORE IF NECESSARY
	JMS FGET
	DCA T1
	CIF 0
	JMS I [SHNDLR
	0601
	0
	MCDREC
	JMP  MIOERR
	TAD FPUTX
	CDF CIF 0
	JMS I [200
	DCA FPUTX
	TAD FPUTX
	DCA FGETX
	JMS CDSWAP	/RESTORE THE SWAPPED CORE IF NECESSARY
	STL		/LINK MUST BE ON AT MRESET
	JMP I MRSETP	/AFTER CD, RESET DEVICE AREA
MCHAIN,	JMS FGET
	DCA T1		/BUFFER THE ARGUMENT
	CIF 0
	JMS I [SHNDLR
	0101
	7400
	MRUNRC
	JMP MIOERR
	TAD T1		/LOAD THE BUFFERED ARGUMENT
	CDF CIF 0
	JMP I .-5
MLNOTF,	CLA
	ISZ MONITO
MNEXT,	TAD USERFG
MESCAP,	CLL RAR
	TAD MONITO
	DCA I [7700
	TAD FPUTX
	DCA I [SMCIF
	CLA IAC CML
	CDF 0
	AND I [JSBITS
	CDF 10
	RAR
	SZL SPA CLA	/RESTORE CORE IF USERFG=1 AND JSW[11]=0
	JMP I [SMCIF
	JMP I [MRETRN
MESCPR,	CLL CML
	JMP MESCAP+1
FGETW,	0
	DCA FPUT
FGETX,	HLT
	TAD I FPUT
	CDF CIF 10
	JMP I FGETW
\fCDSWAP,	0
	TAD ME1000	/FORM READ OR WRITE OPERATION
	DCA MCDCTL
	CDF 0
	TAD I [JSBITS
	CDF 10
	RTR
	SZL CLA	/IS IT NECESSARY TO SAVE CORE?
	JMP I CDSWAP	/NO
	CIF 0
	JMS I [SHNDLR
MCDCTL,	0
	0
	MTEMP+4
	JMP MIOERR
	JMP I CDSWAP

EOVFLO,	CIF 0
	JMS I [SHNDLR
	0111
ME1000,	1000		/ENTER OVERLAY LOADS OVER ENTER (NATCH)
	MEOVLY
	JMP MIOERR
	JMP I ME1000
\f	*400
	/ASSIGN PROCESSOR - TRANSLATE DEVICE NAME INTO DEVICE NUMBER
	/(IF NECESSARY),GET DEVICE HANDLER INTO CORE(IF NECESSARY)
	/AND ADJUST TABLES(IF NECESSARY).  IS THIS REALLY NECESSARY?
MASGN,	CLA IAC
MASSIGN,	DCA ASFLAG
	TAD MACARG
	SZA		/IS DEVICE NUMERIC OR SYMBOLIC?
	JMP DFOUND	/NUMERIC
	JMS I [FGET	/GET HIGH ORDER 2 CHARS OF NAME
	ISZ I [MONITO
	SNA
	JMP I [MRTRN+1		/FIRST WORD OF NAME MUST BE NON-ZERO
	DCA NAME
	JMS I [FGET
	SNA		/IS NAME >2 CHARACTERS LONG?
	JMP NOHASH	/NO - DON'T HASH
	TAD NAME
	RAL
	CLL CML RAR	/FORCE SIGN BIT OF HASH NAME ON
	DCA NAME
NOHASH,	TAD [UDNAME-1	/SEARCH USER NAME TABLE FIRST
DSRCH,	DCA XR
	TAD [-17
	DCA T2
DSRCLP,	TAD I XR
	CIA
	TAD NAME
	SNA CLA
	JMP DSFND
	ISZ T2
	JMP DSRCLP
	TAD XR
	SMA CLA		/WHICH TABLE DID WE JUST SEARCH?
	JMP I [MRTRN+1	/SYSTEM TABLE - ERROR
	TAD [SDNAME-1
	JMP DSRCH	/GO SEARCH SYSTEM TABLE
DSFND,	TAD T2
	TAD [20
	JMS I [FPUT	/PUT NUMBER INTO CALLING SEQUENCE
	JMS I [FGET	/GET IT BACK IN AC, BUMPING POINTER
	ISZ I [MONITO
DFOUND,	JMS I [MCKDEV	/DETERMINE ITS VALIDITY (NON-ZERONESS)
			/AND FORM POINTERS
	SNA		/IS THE DEVICE HANDLER IN CORE?
	TAD I T2
	SNA		/DOES A HANDLER EXIST FOR THE DEVICE?
	JMP I [MLNOTF	/NO - SAME AS THE DEVICE NOT EXISTING
	CMA RAL		/GET THE COMPLEMENT OF THE HIGH ORDER BIT INTO THE LINK
	SNL CLA		/TWO PAGE HANDLER?(IF HANDLER IS IN CORE,
			/THIS TEST IS RANDOM BUT WE DON'T CARE)
	TAD [100	/YES - FORCE A TWO-PAGE READ
	TAD [100
	DCA DVHCTL
	TAD T1
	DCA T7		/SAVE T1 AS WE WILL DESTROY IT LATER
	TAD I T1
	TAD ASFLAG
	SZA CLA		/DOES HE ACTUALLY WANT US TO LOAD THE SILLY THING?
	JMP AFINIS	/NO - HE MUST HAVE TASTE.
	JMS I [FGET		/FETCH PAGE IN WHICH HANDLER IS TO BE LOADED
	RAR		/GET THE LINK, WHICH HAS BEEN UNTOUCHED SINCE WE
			/PUT THE "TWO PAGE HANDLER" FLAG INTO IT
	SNL SMA		/IF THIS HANDLER IS TWO-PAGE, IS HE ALLOWING IT TO BE?
	JMP I [MLNOTF	/NO - GIVE AN ERROR RETURN
	RAL		/YES - ROTATE BACK
	AND [7600		/MAKE IT LEGAL
	DCA DVHLOC
	JMS GETREC
	DCA DVHREC
	CIF 0
	JMS I [SHNDLR
DVHCTL,	0		/READ ONE OR TWO PAGES INTO FIELD 0
DVHLOC,	0
DVHREC,	0
	JMP I [MIOERR	/SYSTEM DEVICE ERROR
		/NOW GO THROUGH THE TABLE OF AVAILABE HANDLERS
	TAD [-17	/AND MARK OFF THOSE WHICH ARE NOW IN CORE
	DCA T4
DVHCLP,	TAD T4
	JMS I [MCKDEV	/LOW ORDER BITS OF T4 GO THROUGH 1-17
	CMA
	TAD DVHLOC
	CLL CML RAR
	TAD DVHCTL	/IF A HANDLER ENTRY POINT IS WITHIN 200 WORDS OF THE
	SMA CLA		/LOADING ADDRESS (400 FOR A TWO-PAGE HANDLER)
	DCA I T1	/MARK IT AS WIPED
	JMS GETREC
	CIA
	TAD DVHREC
	SZA CLA
	JMP NOTINC
	TAD I T2
	AND [177
	TAD DVHLOC
	DCA I T1
NOTINC,	ISZ T4
	JMP DVHCLP
AFINIS,	TAD I T7
	JMP I [MRTRN	/STORE HANDLER ADDRESS AND EXIT
\fGETREC,	0
	TAD I T2	/GET RECORD OF DEVICE HANDLER
	CLL RTL
	RTL
	RTL		/EXTRACT THE RECORD NUMBER
	AND [17
	TAD [DVHORG-1	/ADD THE BASE OF DEVICE HANDLER STORAGE
	JMP I GETREC

MCKDEV,	0		/MUST PRESERVE LINK
	AND [17
	SNA
	JMP I [MERROR	/DEVICE 0 IS ILLEGAL
	DCA NAME
	TAD NAME
	TAD [SDVHND-1	/FORM POINTER INTO HANDLER IMAGE TABLE
	DCA T2
	TAD NAME
	TAD [DVHNDL-1
	DCA T1
	TAD NAME
	TAD [DCB-1
	DCA T8		/FORM POINTER TO DCB ENTRY FOR DEVICE
	TAD I T1
	JMP I MCKDEV

	IFNZRO .-564	<REASSEMBLE CONFIG>
SDNAME,	ZBLOCK 17		/SYSTEM DNAME TABLE - SET UP BY "CONFIG"
\f	IFZERO .+200&1000	<*600>
	/LOOKUP PROCESSOR - GETS THE STARTING BLOCK OF AN INPUT FILE
	/ON A SPECIFIED DEVICE.SKIPS IF FILE WAS FOUND OR DEVICE
	/IS NOT FILE ORIENTED
MLOOKUP,CLL		/SET RDCAT MODE TO INPUT
	JMS MRDCAT
	JMP ERETRN	/NON-FILE STRUCTURED DEVICE
	JMS MDSRCH	/SEARCH THE DIRECTORY FOR THE FILE
	JMP MRTRN+1	/NOT FOUND - TAKE ERROR RETURN
LRETRN,	TAD T5
	CIA
	TAD I [DORG	/CONVERT T5 TO A RECORD NUMBER
ERETRN,	JMS I [FPUT
	ISZ I [MONITO
	TAD T6
	CIA		/STORE FILE LENGTH AS A NEGATIVE NUMBER
MRTRN,	JMS I [FPUT	/THIS CODE IS JUMPED TO BY SEVERAL ROUTINES
MRTRN2,	ISZ I [MONITO
	JMP I [MLNOTF

MRDCAT,	0
	SZA
	JMP MRDREN	/NOT THE FIRST SEGMENT - DON'T SET UP POINTERS
	DCA T5		/ZERO STARTING BLOCK NUMBER
	DCA T6		/ZERO FILE LENGTH
	TAD MACARG	/GET DEVICE NUMBER FROM AC
	JMS I [MCKDEV	/CHECK LEGALITY AND FORM POINTERS
	SNA
	JMP I [MERROR+1	/DEVICE HANDLER IS NOT IN CORE - ERROR
	DCA T9		/ADDRESS OF DEVICE HANDLER
	JMS I [FGET
	DCA T4		/STORE THE POINTER TO THE FILE NAME IN T4
	SNL
	CML RAR
	RTR		/FORM A MASK OF 2000 OR 1000 DEPENDING ON LINK
	AND I T8
	SZA CLA		/TEST FOR READ-ONLY(L=1) OR WRITE-ONLY(L=0)
	JMP MRTRN+1	/FAILED THE TEST - ERROR RETURN
	TAD I T8
	SMA CLA
	JMP I MRDCAT	/DEVICE IS NOT FILE-ORIENTED
	ISZ MRDCAT
	CLA IAC
MRDREN,	DCA MCATRC	/STORE SEGMENT NUMBER
	TAD T9		/USE LOW ORDER BITS
	AND [177	/OF DEVICE HANDLER ENTRY POINT
	CLL RTL		/AND THE REQUESTED SEGMENT NUMBER
	RAL		/TO FORM A "UNIQUE" KEY
	TAD MCATRC	/FOR THIS SEGMENT OF THIS DIRECTORY
		/(THE UNIQUENESS DEPENDS ON EACH HANDLER HAVING A DIFFERENT
		/STARTING OFFSET IN ITS PAGE)
	CIA
	TAD OLDT9	/COMPARE KEY AGAINST KEY OF CURRENT SEGMENT
	SNA		/ARE THEY THE SAME?
	JMP INLRDY	/YES - DON'T READ SEGMENT, ITS IN CORE
	CIA
	TAD OLDT9
	DCA OLDT9	/STORE THE KEY OF THE NEW IN-CORE SEGMENT
	CLA CLL CML RAR	/CHANGE WRITE TO READ
	JMS MWRCAT
INLRDY,	TAD I [DCOUNT
	CML CMA RAL
	SZL SPA
	JMP JMPME2
	CMA CML RAR	/NEW V3 DIRECTORY VERIFYER
	DCA NFILES	/FIRST WORD IN CATALOG = -# OF FILES IN CATALOG
	TAD [DPROPR-1
	DCA XR		/SET XR TO POINT TO FIRST FILE ENTRY
	JMP I MRDCAT	/RETURN TO BUMPED ADDRESS
MDSRCH,	0
FSRCLP,	TAD I XR
	SNA CLA	/EMPTY SPACES HAVE A ONE WORD ZERO DIRECTORY ENTRY
	JMP SKPMTF	/SO SKIP THE 4 WORD COMPARE ON THEM
	CLA CMA
	TAD XR
	DCA XR
	TAD [-4
	DCA T6
	TAD T4
	DCA T7
SRCWDL,	TAD T7
	JMS I [FGETW
	CIA
	TAD I XR
	SZA CLA	/COMPARE ENTRY AGAINST ARGUMENT(8 CHARACTERS)
	JMP NXTFIL
	ISZ T7
	ISZ T6
	JMP SRCWDL
	JMS BUMPXR	/SKIP GARBAGE WORDS
	TAD I XR
	SNA
	JMP SKPMTF+1	/UNCLOSED OUTPUT FILES DONT COUNT
	CIA
	DCA T6	/STORE FILE LENGTH
	ISZ MDSRCH
	JMP I MDSRCH
NXTFIL,	TAD T6
	IAC
	JMS BUMPXR	/SKIP REST OF NAME AND GARBAGE WORDS
SKPMTF,	TAD I XR	/GET LENGTH OF THIS ENTRY
	TAD T5
	DCA T5	/ADD TO BLOCK STARTING ADDRESS
	ISZ NFILES
	JMP FSRCLP
	DCA T5		/RE-INITIALIZE BLOCK NUMBER FOR NEXT SEGMENT
	TAD I [DLINK	/DIRECTORY EXHAUSTED - ANY MORE?
	SZA
	JMP MRDREN
	JMP I MDSRCH

BUMPXR,	0		/ROUTINE TO SKIP (DWASTE+AC) WORDS

	TAD I [DWASTE
	CIA		/DWASTE IS NEGATIVE AND SO IS AC
	TAD XR
	DCA XR
	JMP I BUMPXR

MWRCAT,	0
	TAD [4210
	DCA CATCTL
	CIF 0
	JMS I T9
CATCTL,	4210	/WRITE 2 RECORDS FROM FIELD 1
	1400
MCATRC,	1
JMPME2,	JMP I [MERROR+2	/CANNOT REWRITE CATALOG
	JMP I MWRCAT

	IFNZRO .-772	<REASSEMBLE CONFIG>	/USED TO BE 766
SDVHND,	ZBLOCK 17	/DEVICE HANDLER INFORMATION TABLE - SET BY CONFIG
\f	IFZERO 1000&. <*1000>
	/ENTER PROCESSOR FOR MONITOR
	/FIND A HOLE IN THE DIRECTORY LARGE ENOUGH TO ACCOMODATE THE FILE
	/AND STICK IT IN. MAKE A NOTE THAT WE DID SO FOR THE
	/"CLOSE" PROCESSOR.
MENTER,	DCA EPASS	/SET UP FOR PASS 1
	JMS I [MRDCAT	/READ CATALOG AND SET UP NFILES AND XR
	JMP I [ERETRN	/NON-FILE-STRUCTURED DEVICE
	JMS I [CONSOL
	DCA T2		/INTIIALIZE STARTING BLOCK NUMBER COUNTER
	TAD [DPROPR-1
	DCA XR		/RESTORE XR (CONSOLIDATOR DESTROYED IT)
	TAD MACARG
	CLL RTR
	RTR
	AND [377	/GET REQUESTED LENGTH FROM AC BITS 0-7
	CIA
	DCA T3	/T3=REQUESTED LENGTH.  IF T3=0, MEANS RETURN
		/LARGEST EMPTY SPACE ON TAPE. IF T3<>0, MEANS RETURN
		/SMALLEST BLOCK OF LENGTH =>T3.
	TAD I T8	/GET FCB ENTRY
	AND [7
	SZA CLA		/ANY ACTIVE TENTATIVE FILES ON THIS DEVICE?
	JMP I [MRTRN+1	/YES - TAKE ERROR RETURN
MELOOP,	TAD I XR
	SNA CLA
	JMP MEMPTY	/EMPTY SPACE - LOOK AT LENGTH
	MTHREE		/OCCUPIED - IGNORE
	JMS I [BUMPXR
	TAD I XR
MELEND,	TAD T2
	DCA T2	/UPDATE T2 TO STARTING BLOCK # OF NEXT ENTRY
	ISZ NFILES
	JMP MELOOP	/GO TO NEXT ENTRY

	/DIRECTORY BLOCK EXHAUSTED
	TAD EPASS
	SZA CLA		/WHAT PASS ARE WE IN?
	JMP EFINUP	/SECOND PASS - THIS IS FOR KEEPS
	TAD I [DLINK	/FIRST PASS
	SZA		/ANY MORE SEGMENTS?
	JMP I [MRDREN	/YES - CONTINUE


		/DONE - SEE IF OUR BEST IS GOOD ENOUGH.
	TAD T4
	JMS I [FGETW
	SZA CLA		/CHECK THAT FIRST WORD OF NAME IS NON-ZERO
	TAD T6
	SNA CLA		/AND THAT WE FOUND WHAT WE WANTED
	JMP I [MRTRN2	/OTHERWISE GIVE ERROR RETURN
	TAD ASFLAG	/GET NUMBER OF BEST SEGMENT
	ISZ EPASS	/AND RESTART THE ALGORITHM IN PASS 2
	JMP I [MRDREN	/(TAKES LESS SPACE THAN SAVING XR AND NAME)

	/EVERYTHING IS SET UP - PERFORM THE ACTUAL ENTRY OPERATION

EFINUP,	TAD XR
	DCA T1
	TAD [-4
	JMS I [BUMPXR
	TAD I [DWASTE
	CIA
	TAD XR		/CATALOG MUST HAVE ROOM FOR ONE MORE FILE
	TAD [-1772	/AFTER THIS FILE IS ENTERED
	SMA CLA		/WILL NEW ADDITION OVERFLOW CATALOG?
	JMP I [EOVFLO	/YUP - CALL OVERLAY TO EXTEND DIRECTORY
MELP2,	TAD I T1	/MOVE REST OF CATALOG UP
	DCA I XR	/TO CREATE SPACE FOR NEW ENTRY
	CLA CMA
	TAD T1
	DCA T1
	CLA CMA CLL RAL
	TAD XR
	DCA XR
	TAD T1
	CIA CLL CML
	TAD NAME
	SZA CLA		/HAVE WE PUSHED UP EVERYTHING?
	JMP MELP2	/NO, KEEP PUSHING
	TAD [-4
	DCA T1		/NOW MOVE THE USERS FILE NAME
	TAD NAME
	DCA XR
	TAD T4
	JMS I [FGETW	/[IN THE USERS FIELD, OF COURSE)
	DCA I XR
	ISZ T4
	ISZ T1	/INTO THE EMPTY SPACE JUST CREATED
	JMP .-5
	TAD I [MDATE	/PUT DATE OF CREATION INTO FILE NAME
	DCA I XR	/THIS WILL BE DESTROYED IF DWASTE=0
	IAC		/ADJUST XR BUMP BECAUSE OF DATE STORE
	JMS I [BUMPXR
	DCA I XR	/GIVE THE NEWLY ENTERED FILE A LENGTH OF 0
	TAD XR	/PUT A POINTER TO THE LENGTH WORD OF THE
	DCA I [DFLAG	/NEW ENTRY INTO THE DIRECTORY HEADER
	CLA CMA
	TAD I [DCOUNT
	DCA I [DCOUNT	/INCREASE THE FILE COUNT BY 1
	TAD I T8
	TAD ASFLAG
	DCA I T8	/SIGNAL AN OPEN OUTPUT FILE ON THIS DEVICE
	JMS I [MWRCAT	/WRITE THE ALTERED CATALOG BACK OUT
	JMP I [LRETRN	/STORE ARGS BACK JUST LIKE "LOOKUP"
\fMEMPTY,	TAD I XR
	CIA CLL
	DCA T1	/SAVE LENGTH OF CURRENT ENTRY
	TAD T3
	TAD T6
	CLA		/LINK NOW EQUALS BEST LENGTH>=DESIRED LENGTH
	TAD T3
	SNA
	CML		/IF DESIRED LENGTH=0 WE ALWAYS WANT MAXIMUM
	TAD T1
	CLA CML		/LINK IS NOW ON IF DESIRED LENGTH IS NOT IN BETWEEN
			/BEST LENGTH AND CURRENT LENGTH
	TAD T1
	CIA
	TAD T6
	SZL SNA CLA	/TAKE EITHER MIN OR MAX OF BEST AND CURRENT LENGTHS,
			/DEPENDING ON WHETHER LINK IS ON OR OFF
	JMP MNOCHG	/MIN(MAX)=BEST - NOTHING TO DO
	TAD T1
	DCA T6		/MAKE CURRENT ENTRY NEW "BEST"
	CLA CLL CMA RAL
	TAD XR
	DCA NAME	/REMEMBER CATALOG LOCATION
	TAD I [MCATRC
	DCA ASFLAG	/ALSO DIRECTORY SEGMENT NUMBER
	TAD T2
	DCA T5		/AND STARTING BLOCK NUMBER
MNOCHG,	TAD T1
	CIA
	JMP MELEND	/GO UPDATE THE BLOCK NUMBER
\f	/CLOSE PROCESSOR - CLOSES  AN OUTPUT FILE WHICH WAS OPENED
	/BY THE "ENTER" CALL -- ARGUMENTS ARE THE DEVICE NUMBER AND THE
	/CLOSING LENGTH OF THE FILE.  PERFORMS A DIRECTORY CLEANUP AFTER
	/CLOSING THE FILE.  IF AN ENTRY ALREADY EXISTS WITH THE NEW FILE'S
	/NAME IT IS DELETED. (CLOSE MAY BE USED AS A "DELETE" COMMAND
	/ONLY IF NO OUTPUT FILE WAS ENTERED).  AN ERROR RETURN IS 
	/GIVEN IF THE CLOSING LENGTH IS TOO BIG OR IF THERE WAS NEITHER
	/AN ACTIVE TENTATIVE FILE OR AN OLD FILE TO DELETE.

MCLOSE,	JMS I [MRDCAT	/GET THE CATALOG
	JMP CRETRN	/NON-FILE STRUCTURED DEVICE - RETURN NORMALLY
	CLA IAC		/GET THE NEXT WORD IN THE CALLING SEQUENCE
	JMS I [FGET
	DCA T1		/GET CLOSING LENGTH AND STORE IT AWAY
	JMS I [MDSRCH	/SEARCH FOR THE OLD COPY
	JMP NODLET		/NO OLD COPY
	MTHREE
	TAD I [DWASTE
	JMS SQUISH	/SQUISH OUT 3+#WASTE WORDS OF THE OLD COPY
	DCA I XR2	/AND MAKE THE OTHER TWO INTO AN EMPTY
	TAD T6		/FILE ENTRY WITH THE SAME LENGTH
	CIA
	DCA I XR2	/AS THE OLD COPY
	TAD I T8
	AND [7
	SNA		/IS THERE AN OPEN OUTPUT FILE ON THIS DEVICE
	JMP EOCLOS	/NO - FINISH UP AND GET OUT
	CIA		/GET THE SEGMENT NUMBER WE WANT
	TAD I [MCATRC
	SNA CLA
	JMP .+3
	JMS CONSOL
	JMS I [MWRCAT	/NO - WRITE OUT THE ONE WE SQUISHED
	TAD I [DFLAG	/GET LOCATION OF TENTATIVE FILE
	CIA CLL
	TAD XR2
	SZL CLA		/IS THE ENTRY TO BE CLOSED ABOVE THE ONE 
	JMP .+3		/WE JUST DELETED?
	MTHREE		/YES - MOVE THE POINTER DOWN
	TAD I [DWASTE	/TO COMPENSATE FOR THE SQUISHING
	TAD I [DFLAG	/THE POINTER WILL NOW POINT
	DCA I [DFLAG	/TO THE LENGTH WORD.
		/(THIS WAS WASTED WORK UNLESS THE CORRECT SEGMENT IS IN CORE)

NODLET,	TAD I T8
	AND [7
	SNA		/IS THERE AN OPEN OUTPUT FILE ON THIS DEVICE?
	JMP I [MRTRN+1	/WHAT DID HE CALL US FOR? - ERROR
	JMS I [MRDCAT	/YES - READ IN THE CORRECT SEGMENT
	TAD I [DFLAG
	DCA T4		/T4 POINTS TO THE LENGTH OF THE TENTATIVE ENTRY
	TAD T1
	CIA		/IF T1=0, NEW ENTRY WILL BE DELETED AUTOMATICALLY
	DCA I T4	/DURING CONSOLIDATION
	ISZ T4
	ISZ T4
	CLL CML
	TAD T1
	TAD I T4	/SUBTRACT CLOSING LENGTH FROM FREE BLOCK ADJACENT TO ENTRY
	SNL SZA
	JMP I [MERROR+3	/THIS CREEP HAS GONE AND DESTROYED HIS TAPE
	DCA I T4
EOCLOS,	JMS CONSOL	/CONSOLIDATE THE DIRECTORY
	TAD [7770
	AND I T8
	DCA I T8
	SKP
CRETRN,	TAD [7600	/DO A WRITE OF 0 PAGES. (MAGTAPE)
	JMS I [MWRCAT
	ISZ I [MONITO
	JMP I [MRTRN2
\f	/CONSOLIDATOR - CHECKS FOR ENTRIES OF LENGTH 0 AND DELETES THEM.
	/ALSO CHECKS FOR ADJACENT FREE AREAS AND COMBINES THEM.
CONSOL,	0
	TAD [DPROPR-1
	DCA XR
	TAD I [DCOUNT
	DCA T7		/T7 = FILE COUNT
CONLP,	TAD I XR
	SNA CLA		/EMPTY FILE?
	JMP CONMTF	/YES - GO CHECK FOR NULL AND 2 IN A ROW
	MTHREE
	JMS I [BUMPXR	/GET PAST THE GARBAGE WORDS
	TAD I XR	/GET COUNT
	SZA CLA		/WOULD THIS HAPPEN TO BE A NULL FILE?
	JMP CONLPT	/NAH, GO TO NEXT ONE
	TAD [-5		/YEAH, REMOVE IT ENTIRELY
	TAD I [DWASTE	/INCLUDING THE WASTE WORDS
SQCOMN,	JMS SQUISH
	ISZ I [DCOUNT	/BUMP DOWN FILE COUNT IN DIRECTORY
	ISZ NFILES	/AS WELL AS THE TEMPORARY ONE IN PAGE 0
	NOP		/V3 RL INSISTS
	JMP CONSOL+1	/REPEAT ENTIRE CONSOLIDATION - THIS DELETION MAY
			/HAVE BROUGHT TWO FREE ENTRIES TOGEHER
/	THE ABOVE NOP FIXES THE KILLER CLOSE BUG
CONLPT,	ISZ T7
	JMP CONLP	/MORE FILES - KEEP PLUGGING
	JMP I CONSOL	/RETURN FROM CONSOLIDATOR
CONMTF,	TAD I XR	/IS THIS FREE ENTRY NULL?
	SNA
	JMP SQTRIV	/YES - SQUASHITLIKEABUG
	DCA T2		/NO - SAVE LENGTH
	TAD XR
	DCA SQUISH		/SAVE POSITION OF LENGTH WORD
	ISZ T7		/WAS IT THE LAST FILE?
	SKP		/NO, THEN THERE IS ONE AFTER IT(GOOD THINKING!)
	JMP I CONSOL	/YES - RETURN FROM CONSOLIDATOR
	TAD I XR
	SZA CLA		/TWO EMPTIES IN A ROW?
	JMP CONLP+3	/NO - SLIP BACK INTO LOOP
	TAD I XR
	TAD T2		/YES - COMBINE LENGTHS
	DCA I SQUISH	/STORE BACK IN FIRST LENGTH WORD AND SQUISH SECOND ENTRY
SQTRIV,	CLA CMA CLL RAL
	JMP SQCOMN	/SQUISH OUT 2 WORDS
\fMRESET,	TAD [-17
	DCA T3
MRSETL,	TAD T3
	JMS I [MCKDEV
/LINK MUST BE ON AT THIS POINT
	TAD [200
	SZL CLA		/ZERO ALL DEVICE HANDLER SLOTS THAT AREN'T RESIDENT
	DCA I T1
	JMS I [FGET
	SZA CLA
	TAD [7
	CMA STL
	AND I T8
	DCA I T8	/DELETE THE "FILE CURRENTLY OPEN" FLAG IF ASKED
	ISZ T3
	JMP MRSETL
	JMP I [MNEXT

/SUBR TO COLLAPSE DIRECTORY AFTER A  POINT
SQUISH,	0
	TAD XR
	DCA XR1
	CLA CLL CMA RAL
	TAD XR1
	DCA XR2		/SET UP XR2 FOR CHANGING SQUISHED ENTRY
SQLOOP,	TAD I XR
	DCA I XR1	/MOVE DOWN ONE WORD
	TAD XR
	TAD [-1777
	SZA CLA	/AT END YET?
	JMP SQLOOP	/NO, KEEP GOING
	JMP I SQUISH
\f	*1400
	/INITIAL DIRECTORY FOR MONITOR
	/DEFINES OS/8 ABSOLUTE LOADER (ABSLDR.SV)

DCOUNT,	-2	/TWO ENTRIES
DORG,	MFREE	/FILE STORAGE STARTS AT BLOCK "MFREE"
DLINK,	0	/THIS IS THE ONLY DIRECTORY RECORD
DFLAG,	0	/THERE ARE NO OPEN OUTPUT FILES ON THIS DEVICE
DWASTE,	-1	/# OF WASTED WORDS PER ENTRY
DPROPR,	0102	/AB
	2314	/SL
	0422	/DR
	2326	/.SV
	3017	/V3D ENCODING FOR 1-JUN-77
	-5	/FIVE BLOCKS LONG( 1 BLOCK = 256 WORDS)
	0	/EMPTY SPACE
	-1	/OVERLAYED BY DEVICE DEPENDENT PART WITH LENGTH

	IFNZRO .-1415 <CNFER,QQQ>
\f	*3400	/"ENTER" OVERLAY TO USR - RUNS IN 11000
	JMP .+3
MSEGLM,	-7	/# DIRECT. SEGS
NEWLEN,	-10
MEOVLP,	TAD I [DLINK
	SNA CLA
	JMP MELAST	/LAST SEGMENT - MUST CREATE A NEW ONE
	ISZ I [DCOUNT	/BUMP ENTRY COUNT DOWN
	JMS I [MWRCAT	/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	/THROUGH A BUFFER AT LOC 11200
	TAD XR
	CIA
	TAD T1		/T1 WAS SET UP BY "ENTER"
	SZA CLA
	JMP .-7
	TAD I T1	/GET LENGTH OF MOVED ENTRY
	DCA MEOCNT
	TAD I [DLINK
	JMS I [MRDCAT	/READ NEXT SEGMENT
	JMS I [CONSOL	/MAKE SURE IT IS AT ITS SMALLEST
	TAD I [DORG
	TAD MEOCNT
	DCA I [DORG	/BUMP FILE ORIGIN DOWN
	JMS MSKIPF	/FIND LAST LOC IN NEW SEGMENT
MELP3,	TAD XR
	DCA METMP1
	TAD XR
	TAD MEFCNT
	DCA METMP2	/PREPARE TO PUSH ALL ENTRIES UP
	TAD I METMP1
	DCA I METMP2	/DO THE PUSHING
	STA
	TAD XR
	DCA XR
	TAD XR
	TAD (-DWASTE
	SZA CLA		/ARE WE THROUGH?
	JMP MELP3	/NO
	TAD (MEOVLS-1
	DCA XR		/PREPARE TO MOVE THE SAVED ENTRY INTO THE
	CLA CMA		/NEW SEGMENT
	TAD I [DCOUNT
	DCA I [DCOUNT	/INCREASE ENTRY COUNT OF NEW SEGMENT
	TAD MEFCNT
	CIA
MECOMN,	DCA MEFCNT	/STORE NUMBER OF WORDS TO MOVE
	TAD [DWASTE
	DCA XR1
	TAD I XR
	DCA I XR1
	ISZ MEFCNT
	JMP .-3		/MOVE THE ENTRY IN
	JMS MSKIPF
	TAD XR
	DCA T1		/T1=LAST LOC IN SEGMENT
	TAD I [DWASTE
	CIA
	TAD XR
	TAD [-1772
	SMA CLA		/HAVE WE MADE THIS SEGMENT TOO BIG?
	JMP MEOVLP	/YES - LOOP UNTIL WE GET IT RIGHT
	JMS I [MWRCAT	/WRITE OUT NEW SEGMENT
	JMP MEOXIT	/READ IN ENTER AND CONTINUE
\fMWRONG,	IAC
MELAST,	TAD NEWLEN
	DCA METMP1	/LENGTH OF NEW SEGMENT
	TAD METMP1
	CIA
	TAD I [DCOUNT
	SMA		/WERE THERE "NEWLEN+1"
	JMP MWRONG	/NO - SET OUR SIGHTS LOWER
	DCA I [DCOUNT	/ADJUST LENGTH OF OLD SEGMENT
	JMS MSKIPF	/FIND BOUNDARY LOC BETWEEN SEGMENTS
	TAD I [MCATRC
	IAC
	DCA I [DLINK	/LINK THE OLD LAST SEGMENT TO 
	TAD I [DLINK	/THE NEWLY CREATED ONE
	TAD MSEGLM
	SMA CLA
	JMP I (MEOERR	/PROVIDED THAT THERE IS ROOM FOR ANOTHER
	JMS I [MWRCAT	/WRITE OUT THE NEXT-TO-LAST SEGMENT
	ISZ I [MCATRC	/BUMP RECORD NUMBER FOR NEXT WRITE
	ISZ OLDT9	/LIKEWISE BUMP DIRECTORY KEY
	TAD METMP1
	DCA I [DCOUNT
	TAD MEOCNT
	CIA
	TAD I [DORG
	DCA I [DORG	/SET UP PARAMETERS OF THE NEW SEGMENT
	DCA I [DLINK	/MARK IT AS THE NEW LAST SEGMENT
	TAD XR
	TAD [-1777	/SET UP COUNT OF WORDS TO SLIDE DOWN
	JMP MECOMN	/USE COMMON CODE TO SLIDE WORDS AND EXIT

MSKIPF,	0		/SUBR TO FIND LAST LOC USED IN A SEGMENT
			/ALSO FINDS NUMBER OF BLOCKS USED BY SEGMENT
	TAD I [DCOUNT
	DCA MNOFIL
	TAD [DWASTE
	DCA XR
	DCA MEOCNT	/INITIALIZE POINTER(XR) AND COUNT(MEOCNT)
MSKPLP,	TAD I XR
	SNA CLA
	JMP MEOMTY
	MTHREE
	TAD I [DWASTE	/BUMP POINTER TO LENGTH WORD OF FILE ENTRY
	CIA
	TAD XR
	DCA XR
MEOMTY,	TAD I XR
	TAD MEOCNT
	DCA MEOCNT
	ISZ MNOFIL
	JMP MSKPLP
	JMP I MSKIPF
\fMEOCNT,	0
MEFCNT,	0
METMP1,	0
METMP2,	0
MNOFIL,	0
	MEOVLS=1200	/DESTROYS PART OF "CLOSE" OP FOR BUFFER
	PAGE
\f	EJECT ABSLDR
	/ABSOLUTE LOADER FOR OS/8 - VERSION 4A
	*2000
	CTLBLK=3400
	BUFFER=CTLBLK
	XFIELD=20
	ORIGIN=21
	B1=22
	B2=23
	B3=24
	C1=25
	C2=26
	C3=27
	WD=30
	WD1=31
	WD2=32
	FILPTR=33
	PG7400=34
	LSTFLD=35
	LOADXR=11
ABSLDR,	JMS I (CTINIT
	JMS I (CTINIT
	JMP CALLCD
	JMP NOCD
NEXTCD,	JMS I (NEXFIL
CALLCD,	JMS I [200
	5	/COMMAND DECODE
	0216	/ASSUMED EXTENSION IS .BN
NOCD,	TAD [6001
	CDF 0
	DCA I [JSBITS	/SET JSBITS TO SAVE CD AREA NEXT TIME
	CDF 10
	TAD I [MPARAM+1
	AND [100
	SZA CLA		/IS /R SWITCH ON?
	JMS I (CTINIT	/YES - RE-INITIALIZE LOADER TABLES
LD7400,	7400
	TAD (MIFILE
	DCA FILPTR
	JMS I (SETADR	/GET THE STARTING ADDRESS IF IT APPEARS ON THE LINE
NEWFIL,	TAD (7001
	DCA HANDLR
	TAD I FILPTR
	AND [7760
	SZA		/LENGTH OF 256 BLOCKS IMPLIES AT LEAST 256
	TAD [17
	CLL CML RTR
	RTR
	DCA RCDCNT
	TAD I FILPTR
	ISZ FILPTR
	SNA
	JMP NEXTCD	/FILE POINTER = 0 MEANS NO MORE INPUT FILES
	JMS I [200
	1		/ASSIGN
HANDLR,	7001		/LOAD INTO 7000 IF NOT ALREADY LOADED
	JMP I (IOERR
	TAD I FILPTR
	DCA RECNO
	ISZ FILPTR
	CLA CMA
	DCA CHCNT
	DCA REOF
	TAD I [MPARAM	/TEST FOR /I
	AND (10
	SNA CLA
	JMP I (LOADER	/I IS NOT ON
	ISZ OFLG	/IS /I ALLOWED?
	JMP I (OERR	/NO!
	JMP I (SLASHO
\fGETCH,	0		/GET-NEXT-INPUT-CHARACTER ROUTINE
	TAD [200
	KRS
	TAD (-203
	SNA CLA
	KSF
	SKP
	JMP I (MGET
	ISZ JMPGET
	ISZ CHCNT
JMPX,	JMP JMPGET
	TAD REOF
	SZA CLA
	JMP I GETCH	/EOF REACHED BEFORE LOGICAL END - ERROR
	CIF 0
	JMS I HANDLR
	0210		/READ 2 RECORDS INTO FIELD 1
PBUFFR,	BUFFER
RECNO,	0
	JMP RERROR
	ISZ RECNO
	ISZ RCDCNT
	SKP
	ISZ REOF
	TAD (-601
	DCA CHCNT
	TAD PBUFFR
	DCA CHPTR
	TAD JMPX
	DCA JMPGET
	JMP GETCH+1
\fJMPGET,	JMP .
	JMP CHAR1
	JMP CHAR2
CHAR3,	TAD JMPX
	DCA JMPGET
	TAD I CHPTR
	AND LD7400
	CLL RTR
	RTR
	TAD CHTMP
	RTR
	RTR
	ISZ CHPTR
	JMP GCHCOM
CHAR2,	TAD I CHPTR
	AND LD7400
	DCA CHTMP
	ISZ CHPTR
CHAR1,	TAD I CHPTR
GCHCOM,	AND (377
	ISZ GETCH
	JMP I GETCH
RERROR,	SPA CLA
	JMP I (IOERR	/AN ACTUAL READ ERROR - AMAZING!
	ISZ REOF
	JMP RECNO+2
REOF,	0
CHCNT,	0
CHPTR,	0
CHTMP,	0
RCDCNT,	0
OFLG,	-1		/SWITCH FOR /O OPTION
	PAGE
\f	*2200
PUTWD,	6402		/ABSLDR VERSION NUMBER
	CMA
	AND I B2	/AND OUT THE PAGE SLOT IN THE PAGE TABLE
	DCA I B2
	TAD ORIGIN
	DCA ORGX
	TAD XFIELD
	CLL RTR
	RTR
	SZA CLA		/TEST FOR FIELDS 0 OR 1
	JMP PUTIT	/NEITHER - STORE AS IS
	SNL
	JMP FLD0
	TAD ORIGIN
	SPA CLA
	JMP FLD1
	CLA CLL CML RTR
	TAD ORIGIN
	SMA CLA
	JMP .+3
	ISZ I (OVLYFG	/SET FLAG THAT LOADER IS BEING OVERLAYED
	TAD (2400	/LOADER OVERLAYS GO IN MTEMP+11 - MTEMP+14
LCOMPR,	TAD ORIGIN
	RTL
	RTL
	RAL
	AND [17
	TAD (MTEMP
RLCOMN,	DCA PGTMP
	TAD BUFREC
	CIA
	TAD PGTMP
	SNA CLA
	JMP DONTWR
	JMS WRBUF
WRIBUF,	 CLA		/MODIFIED..IF NOT /O GETS SZA CLA
	JMP DONTWR
	CIF 0
	JMS I [SHNDLR
	0210
	1400	/USE CATALOG SPACE
PGTMP,	0
	JMP I (LIOERR
DONTWR,	DCA OLDT9	/MARK THE CATALOG DESTROYED
	TAD PGTMP
	DCA BUFREC
	TAD ORIGIN
	AND [377
	TAD PTRBFR
	DCA ORGX
	JMP PUTIT2
\fFLD1,	CLL
	TAD ORIGIN	/IGNORE LOCATIONS ABOVE 17600
	TAD [200
	SZL CLA
	JMP I PUTWD
PUTIT,	TAD XFIELD
	TAD [7770	/CONSTRUCT CDF N FOR PROPER FIELD
PUTIT2,	TAD CDF10
	DCA .+1
M7,	-7
	TAD C3
	DCA I ORGX
CDF10,	CDF 10
	JMP I PUTWD
FLD0,	TAD ORIGIN	/CHECK FOR STUFF IN PAGE 7000
	TAD (1000
	SNL CLA		/IF NON ZERO,OVERLAY
	JMP PUTIT
	TAD [7400	/FORM RECORD NO. FOR OVERLAY
	ISZ PG7400	/SET OVERLAY FLAG
	JMP LCOMPR	/FORM RECORD NO.
WRBUF,	CALONC
	TAD BUFREC
	SNA
	JMP I WRBUF
	CIF 0
	JMS I [SHNDLR
	4210
PTRBFR,	1400
BUFREC,	0
	JMP I (LIOERR
	DCA BUFREC
	/BAD I/O ON SYSTEM DEVICE
	JMP I WRBUF
\fORGX,
NEXFIL,	ERTRN
	JMS WRBUF	/WRITE WHATEVER
	TAD I [MPARAM-1
	SPA CLA
	JMP I (BUILD
	TAD I (MPARAM
	AND (40
	SZA CLA
	JMP I (BUILD
	JMP I NEXFIL

CORTAB,	ZBLOCK 30	/ONCE-ONLY CODE INSERTED HERE KATER
	ZBLOCK 2	/EXTRA NEEDED BY ONCE-ONLY CODE
			/NOT USED BY CORE TABLE
	PAGE
\f	*2400
ITSOVR,	JMS ASSEMB
	CIA
	TAD LCKSUM
SZAIN,	SZA CLA
	JMP I (BADCKS
	TAD I [MPARAM+1
	AND L40
	SNA CLA
	JMP I (NEWFIL
LOADER,	DCA LCKSUM
	DCA I (OFLG	/CANCEL FURTHER /I'S
	TAD SZAIN
	DCA I (WRIBUF
	JMS GETFLD
	DCA XFIELD
	TAD [200
	DCA ORIGIN
	JMS I (GETCH
	JMP I (NEWFIL
	SNA
	JMP .-3
	TAD [-200
	SZA CLA
	JMP LOADER+1
LEADER,	JMS I (GETCH
	JMP I (NEWFIL
	SNA
	JMP LOADER+1
	TAD [-200
	SNA
	JMP LEADER
NEWWD,	SMA
	JMP FIELDW
	TAD [200
	DCA WD1
	JMS I (GETCH
	JMP I (BADINP
	DCA WD2
	JMS I (GETCH
	JMP I (BADINP
	TAD [-200
	SNA
	JMP ITSOVR
	DCA WD
	JMS ASSEMB
	SNL
	JMP DATAWD
	DCA ORIGIN
	DCA I (LOADWD	/ZERO 'DATA LOADED' FLAG V3
	JMP GETNXT
\fDATAWD,	JMS I (LOADWD
	ISZ ORIGIN
L40,	40
GETNXT,	TAD WD1
	TAD WD2
	TAD LCKSUM
	DCA LCKSUM
	TAD WD
	JMP NEWWD
\fASSEMB,	0
	TAD WD1
	CLL RTL
	RTL
	RTL
	TAD WD2
	JMP I ASSEMB
FIELDW,	TAD (-32
	SNA
	JMP CTLZ
	TAD (-46
	SPA
	JMP NOTXP
	DCA WD1
	TAD WD1
	AND [7		/V3C
	SZA CLA
	JMP NOTXP
	TAD WD1
	AND (70
	DCA XFIELD
	JMS I (GETCH
	JMP I (BADINP
	TAD [-200
	SZA
	JMP NEWWD
NOTXP,	CLA
	TAD LCKSUM
	SNA CLA
	JMP LOADER
	JMP I (BADINP
LCKSUM,	0
CTLZ,	TAD LCKSUM
	SZA CLA
	JMP I (BADINP
	JMP I (NEWFIL
\fGETFLD,	0
	DCA C1
	TAD I (MPARAM+2
	AND (1774
	SNA
	JMP I GETFLD
	RTL
	RAL
	ISZ C1
	SNL
	JMP .-3
	CLA CMA
	TAD C1
	CLL RTL
	RAL
	JMP I GETFLD
	PAGE
\f	*2600
BUILD,	TAD (CORTAB+25
	DCA B1
	TAD I (CORTAB+3
	CLL CMA
	AND [7760
	SNA CLA
	CML
	TAD I (CORTAB
	CMA
	AND [7760
	SNA CLA
	IAC
	RTR
	DCA I (CTLBLK+3
	TAD (CTLBLK+3
	DCA LOADXR
	TAD [-10
	DCA C1
	TAD [70
	DCA FIELDB
	DCA I (CTLBLK
FLDLP,	TAD FIELDB
	TAD [-20
	SMA CLA		/IGNORE 07600 AND 17600 IN CCB	/V3
	CMA		/IN THE CORE MAP
	TAD [-37
	DCA C2
	DCA LOWERA
MTLOOP,	JMS I (SHFT
	SNL CLA
	JMP INUSE
	TAD LOWERA
MTRSME,	TAD [200
	DCA LOWERA
	ISZ C2
	JMP MTLOOP
	JMP FLDOVR
INUSE,	TAD LOWERA
	TAD [200
	DCA UPPERA
	ISZ C2
	SKP
	JMP ENDRGN-2
	JMS I (SHFT
	SZL CLA
	JMP ENDRGN
	TAD UPPERA
	JMP INUSE+1
	CLA CMA
	DCA C2
ENDRGN,	TAD LOWERA
	AND [7400
	DCA I LOADXR
	ISZ I (CTLBLK
	TAD LOWERA
	AND [7400
	CIA
	TAD UPPERA
	CLL RAR
	TAD FIELDB
	DCA I LOADXR
	TAD UPPERA
	JMP MTRSME
\fFLDOVR,	TAD FIELDB
	TAD [-10
	DCA FIELDB
	CLA CLL CMA RTL
	TAD B1
	DCA B1
	ISZ C1
	JMP FLDLP
	TAD I (CTLBLK
	SNA
	JMP I (NULERR
	CIA
	DCA I (CTLBLK
	TAD I [MPARAM+1	/CLOBBER BATCH?
	AND [400
	TAD I (MPARAM+2	/AH ED, BUG IF YOU SPEC /P/1 TO LOADER
	AND (403
	TAD I (CTLBLK+3
	DCA I (CTLBLK+3
	TAD LSTFLD
	AND [7
	CLL RTL
	RAL
	TAD [CDF CIF 0
	DCA I (CTLBLK+1
	SKP
ORG200,	TAD [200
	TAD LSTADR
	SZA		/V3
	JMP NOORG	/V3 ALLOW EXPLICIT START ADDR TO OVERRIDE DEFAULT
	TAD I (LOADWD	/V3 NO EXPLICIT START ADDR
	CLA		/REPLACE BY 'SZA CLA' TO ALLOW SELF-STARTING STUFF
/*	SZA CLA		/V3 IS IT SELF STARTING BIN FORMAT?
	JMP ORG200	/V3 NO
	TAD XFIELD	/V3 YES
	TAD [CIF CDF 0	/V3
	DCA I (CTLBLK+1	/V3
	TAD I (ORIGIN	/V3
NOORG,	DCA I (CTLBLK+2
	JMP I (LGTOUT	/WRITE CONTROL BLOCK AND EXIT
FIELDB,	0
\fUPPERA,
SETADR,	0
	TAD I (MPARAM+3
	SNA		/IS THERE A STARTING ADDRESS SPECIFIED?
	JMP I SETADR	/NO
	DCA LSTADR
	TAD I [MPARAM-1
	DCA LSTFLD
	JMP I SETADR

LOWERA,	0
LSTADR,	0
	PAGE
\f	*3000
ZOFILE,	MOFILE
ZOUCNT,	-47
LGTOUT,	TAD PG7400
	SNA CLA
	JMP .+7
	CIF 0
	JMS I [SHNDLR
	0300
	7000
	MTEMP+15
	JMP I (LIOERR
	CIF 0
	JMS I [SHNDLR
	4210
	CTLBLK-200
	MTEMP+10
	JMP I (LIOERR
	TAD I (CTLBLK+2
	DCA CTL2		/MOVE THINGS INTO THIS PAGE 
	TAD I (CTLBLK+3
	DCA CTL3	/SO WE CAN REFERENCE THEM WITH DF=0
	TAD I [MPARAM
	AND (40
	SNA CLA
	JMP LNOGO
	TAD CTL3
	RAL
	SPA CLA		/ARE WE OVERLAYING THE I/O MONITOR?
	JMP LKICKM		/NO
	CDF 0
	DCA I [JSBITS	/YES - SET JSBITS TO FORCE A READ
	CDF 10
	JMS I [200
	13		/RESET I/O DEVICES AND FILES
LKICKM,	JMS I [200
	11		/KICK MONITOR OUT
	/********************************************
	/NO PAGE ZERO REFERENCES AFTER THIS POINT 
	/PAGE ZERO MAY CONTAIN USER CODE
	/********************************************
	DCA I ZOFILE		/ZERO OUT COMMAND DECODER AREA
	ISZ ZOFILE
	ISZ ZOUCNT
	JMP .-3
	TAD I (CTLBLK+1
	CDF 0
	DCA I (MSTCDF
	TAD CTL2
	DCA I (MSTADR	/SET UP STARTING ADDRESS IN FIELD 0
	JMP LMOVRD
\fLNOGO,	TAD CTL3	/ABOVE COMMENT DOESN'T APPLY TO NEXT 9 LINES
	SPA CLA		/ARE WE OVERLAYING THE KEYBOARD MONITOR?
	TAD (5		/NO - RETURN TO NON-SAVING ENTRY
	TAD [7600
	CDF 0
	DCA I (MSTADR
	TAD ZCDIF0
	DCA I (MSTCDF
	CLA CMA
LMOVRD,	CDF 10
	DCA I (7700	/SET 7700 TO -1 IF NO GO
	TAD I (CTLBLK+1
	CDF 0
	DCA I (JFIELD	/SET UP PARAMETERS IN FIELD 0
	TAD CTL2
	DCA I (JSTART
	TAD CTL3
	DCA I (JSBITS
LMOVLP,	TAD COMBO
	DCA I COMBPT
	ISZ LMOVLP
	ISZ COMBPT
	ISZ COMBCT
	JMP LMOVLP	/MOVE THE READ OF THE LOADER OVERLAY INTO FIELD 0
ZCDIF0,	CDF CIF 0
	TAD OVLYFG
	SZA CLA
	JMP I (MREAD	/LOADER OVERLAYED - GO READ OVERLAY
	JMP I (MSTCDF	/LOADER NOT OVERLAYED - WHY READ?
COMBPT,	MREAD-1
COMBCT,	-7
COMBO,	7607
	MREAD-1&177+4600	/JMS I .-1
	1010
	2000
	MTEMP+11	/LOCATION OF SCRATCH BLOCKS FOR LOADER OVERLAY
	HLT
	MSTCDF&177+5200	/JMP MSTCDF
CTL2,	0
CTL3,	0
OVLYFG,	0
\fLOADWD,	0
	DCA C3
	TAD XFIELD
	CLL RAR
	TAD XFIELD
	RTR
	TAD (CORTAB-1
	DCA B2
	TAD ORIGIN
	AND [7600
	CLL RTL
	RTL
	RTL
	ISZ B2
	TAD (-14
	SMA
	JMP .-3
	DCA CTL2
	CLL CML
	RAL
	ISZ CTL2
	JMP .-2
	JMS I (PUTWD
	JMP I LOADWD
	PAGE
\f	*3200
ERPCH,	0
	AND (77	/GET LOW ORDER 6 BITS
	SZA
	JMP NZCHAR
	JMS ERR
FILMSG,	TEXT	/, FILE 0/
NZCHAR,	TAD (240
	AND (77
	TAD (240	/CONVERT TO ASCII
	JMS LDRPCH	/PRINT
	JMP I ERPCH	/AND RETURN
LDRPCH,	0
	TLS
	TSF
	JMP .-1
	CLA
	JMP I LDRPCH
SHFT,	0
	CLA CLL CMA RTL
	DCA C3
	CLA CLL CML RTL
	TAD B1
SHFTLP,	DCA B3
	TAD I B3
	RAL
	DCA I B3
	CLA CMA CML
	TAD B3
	ISZ C3
	JMP SHFTLP
	JMP I SHFT		/NOTE: SHFT LEAVES AC NON-ZERO
\fERR,	ONCE		/CAN'T USE PAGE 0 LITERALS
	CLA
	CDF 10
	TAD I (FILPTR	/ZERO CHAR GETS REPLACED BY "FILE #"
	TAD (322	/MAGIC NUMBER
	CLL CML RAR	/AC NOW CONTAINS " #"
	DCA FILMSG+3
ERRLUP,	TAD I ERR
	SNA
	JMP EOMESG	/MESSAGE MUST BE EVEN NUMBER OF CHARS LONG
	RTR
	RTR
	RTR
	JMS ERPCH
	TAD I ERR
	JMS ERPCH
	ISZ ERR
	JMP ERRLUP
EOMESG,	TAD (215	/TERMINATE MESSAGE WITH CR-LF
	JMS LDRPCH
	TAD (212
	JMS LDRPCH
ERTRN,	JMP I (ABSLDR	/RETURN TO LOADER STARTING ADDRESS
IOERR,	JMS ERR
	TEXT	%I/O ERROR%
BADINP,	JMS ERR
	TEXT	/BAD INPUT/
BADCKS,	JMS ERR
	TEXT	/ BAD CHECKSUM/
NULERR,	JMS CTINIT
	NOP
	JMS ERR
	TEXT	/NO INPUT/
\fLIOERR,	JMS ERR
	TEXT	/SYSTEM I-O ERROR/
OERR,	JMS ERR
	TEXT %NO /I!%

CTINIT,	0
CALONC,	JMS I ERR	/CALL ONCE-ONLY CODE
	TAD (-30
	DCA C1
	TAD (CORTAB-1
	DCA LOADXR
	CLA CMA
	DCA I LOADXR
	ISZ C1
	JMP .-3
	DCA LSTFLD
	DCA I (LSTADR	/V3 SET INITIAL STARTING ADDRESS TO 0
	DCA I (OVLYFG
	DCA PG7400
	ISZ CTINIT
	JMP I CTINIT
	PAGE
\f
*CTLBLK+200

/CODE FOR OVERLAY OPTION IS HERE.IF /I IS NOT
/USED IMMEDIATELY, THIS CODE WILL PROBABLY BE DESTROYED,
/AS IT IS USED FOR A BUFFER

SLASHO,	CLA CMA
	DCA I (OFLG	/RE ENABLE /I
	TAD I (HANDLR
	DCA GLONK	/ENTRY POINT TO HANDLER
	TAD I (RECNO
	DCA CCBLOK
	CIF 0
	JMS I GLONK	/READ IN CORE CONTROL BLOCK
	0110
CCBPTR,	CTLBLK
CCBLOK,	0
	JMP I (OERR	/DATA FAILURE
	TAD I CCBPTR	/NO. SEGMENTS
	CMA		/TEST FOR BAD CORE IMAGE
	AND L7740
	SZA CLA
	JMP I (BADINP	/NOT CORE IMAGE
	TAD I CCBPTR
	DCA SEGCNT
	TAD I SGSTAD	/THIS CODE IS NEW FOR V3D
/	AND [70		/GET FIELD
	CLL RTR
	RAR
	DCA I (LSTFLD
	ISZ SGSTAD
	TAD I SGSTAD
	DCA I (LSTADR
	ISZ SGSTAD
	TAD I SGSTAD	/GET JSW FROM SAVE FILE
	AND [400
	DCA TEMP	/PRESERVE /P
	TAD I [MPARAM+1
	AND (7377
	TAD TEMP
	DCA I [MPARAM+1
	TAD I SGSTAD
	AND (3		/PRESERVE LAST 2 BITS
	DCA TEMP
	TAD I (MPARAM+2
	AND [7774
	TAD TEMP
	DCA I (MPARAM+2
	ISZ SGSTAD
NEWSEG,	TAD I SGSTAD	/SEGMENT START ADDRESS
	DCA ORIGIN
	TAD I SGFDLT	/FIELD AND LENGTH
	AND L77
	DCA XFIELD
	TAD I SGFDLT
	AND [7700
	SNA		/V3C
	STL CLA RAR	/AC4000
	DCA SEGLTH
	TAD SEGLTH
TWOPG,	TAD [7600
	SMA CLA		/NO.. IS TWO PAGE SEGMENT LEFT?
	TAD [7600	/YES..-400 TO WORD COUNT
	TAD [7600	/NO.. -200 TO WORD COUNT
	DCA WDCT
	TAD SEGLTH
	TAD [7600	/BUMP DOWN LENGTH LEFT
	DCA SEGLTH

	ISZ CCBLOK	/POINT TO NEXT DATA RECORD
	TAD CCBLOK
	DCA DATRC
	DCA OLDT9	/MARK DIRECTORY DESTROYED
	CIF 0
	JMS I GLONK	/READ THE DATA RECORD IN
	0210
	1400	/INTO 11400
TEMP,
DATRC,	0
	JMP I (IOERR	/DATA FAILURE
	CLA CMA
	TAD ORIGIN
	AND [177
	TAD (1200	/SET UP INPUT POINTER
	CHARPT=10
	DCA CHARPT
LOOPI,	TAD I CHARPT
	JMS I (LOADWD	/MOST OF THE WORK
	ISZ ORIGIN
L7400,	7400		/NOP
	ISZ WDCT	/FINISHED THIS BLOCK?
	JMP LOOPI
	JMS I (WRBUF	/YES.. WRITE THE STUFF OUT
	DCA I (BUFREC	/SO THAT WRBUF DOESN'T SCREW US UP
	TAD SEGLTH	/V3C (REARRANGED)
	SMA SZA		/ALL PAGES DONE?
	JMP TWOPG	/NO, NEXT! (IF DONE, FALL INTO 'GTSEG')
	ISZ SEGCNT	/YES, ANY MORE SEGMENTS
	SKP
	JMP RENEW	/RESET CCB POINTER FOR NEXT /I
	CLA CLL CML RTL
	TAD SGSTAD
	DCA SGSTAD
	CLA CLL CML RTL
	TAD SGFDLT
	DCA SGFDLT	/POINT TO NEXT CCB ENTRIES
	JMP NEWSEG

GLONK,	0		/HANDLER ENTRY POINT HERE
WDCT,	0
SEGCNT,	0
SEGLTH,	0
CTLBLK=3400

SGFDLT,	CTLBLK+5	/FIELD AND LENGTH WORD
SGSTAD,	CTLBLK+1	/SEGMENT START ADDRESS

L7740,
RENEW,	7740		/USED TO CLEAR AC
L77,	77		/MIGHT OR MIGHT NOT SKIP
	TAD (CTLBLK+1
	DCA SGSTAD
	TAD (CTLBLK+5
	DCA SGFDLT
	JMP I (NEWFIL
	PAGE
\f	*CORTAB		/ONCE-ONLY CODE

ONCE,	0		/ONCE-ONLY CODE TO CHECK FOR CORRECT MONITOR
	DCA I WRBUF	/DON'T CALL AGAIN
	TAD [400
	TAD K7400
	SZA CLA
	JMP OLDMON
	TAD [7
	TAD M7
	SNA CLA
	JMP I ONCE	/THEY AGREE
OLDMON,	TAD KERR
	DCA I NEXFIL
	JMS I PERR	/THEY DON'T
	TEXT	/INCOMPATIBLE/	/MUST BE AN EVEN # OF CHARS LONG
	CIF CDF 0
	JMP I K7605
K7400,	7400
PERR,	ERR
K7605,	7605
KERR,	ERR&177+5600
\f	/PAGE 0 - TEMPORARIES AND LITERALS.
		/LOCATIONS 0-3 ARE RESERVED FOR POINTERS TO KEY LOCATIONS
		/IN THE MONITOR (SO THE CUSPS CAN GET AT THESE LOCATIONS)

		/LOCATIONS 4-6 ARE RESERVED FOR SYSTEM ODT FIELD 1 BREAKPOINTS

	*7
OLDT9,	0		/POINTER TO DEVICE HANDLER OF DIRECTORY IN CORE

	*15
XR1,	0
XR2,	0
XR,	0
	*20		/ENTRY TO MONITOR FROM A CALL TO 17700 -
			/CAN BE DESTROYED AFTER IT IS EXECUTED
MSTART,	TAD I T1
	DCA MACARG
	TAD I [7700
	DCA I [MONITO
	TAD I [SMCIF
	DCA I T2	/FAKE A CALL TO "MONITO"
	TAD I [MONITO
	RAL
	SNL SMA CLA
	TAD I [SMCIF
	TAD T3
	SNA CLA		/CHECK FOR A CALL FROM 10000-11777
	JMP I [MERROR	/YES - GIVE ERROR IMMEDIATELY
	JMP I T4	/NO - SLIDE INTO MONITOR CODE

	*36		/POINTERS TO INTERNAL MONITOR LOCATIONS FOR "BUILD"
	SDNAME		/SYSTEM DEVICE NAME TABLE
	SDVHND		/DEVICE HANDLER ENTRY TABLE
\f	*40		/LOCATIONS 20-37 RESERVED FOR CUSP SCRATCH SPACE
USERFG,	1	/MUST BE IN 40 - SEE CD LISTING
T1,	MARG1	/MUST BE AT 41
T2,	FGETX
T3,	-6213
T4,	MRENTR
T5,	0
T6,	0
T7,	0
T8,	0
T9,	0
NAME,	0
NFILES,	0
ASFLAG,	0
MACARG,	0
EPASS,	0
MERRNO,	4000
MEOXIT,	CIF 0		/RETURN FROM ENTER OVERLAY
	JMS I [SHNDLR
	0210
	1000
	MONTOR+2	/RESTORE LOCS 1000-1377 OF USR
	HLT		/HELP!
	JMP I .+1
	MENTER		/RESTART ENTER OPERATION COMPLETELY
\f	$
\f