/ PS/8 MONITOR SYSTEM FOR 8K PDP-8, 8/I, 8/L, 8/E    PS8.002
/OCTOBER 31, 1970		R. LARY/E. FRIEDMAN

/COPYRIGHT 1970,  DIGITAL EQUIPMENT CORP., MAYNARD MASS.

/THIS VERSION OF PS/8 IS USR-COMPATIBLE WITH THE PRELIMINARY SYSTEM
/RELEASED IN JUNE, 1970
/HOWEVER, CHANGES AND ADDITIONS HAVE BEEN MADE
/TO THE KEYBOARD MONITOR, INITIAL BOOTSTRAP, DIRECTORY STRUCTURE
/AND ABSOLUTE LOADER.

/	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
	/KEYBOARD MONITOR FOR PS/8 SYSTEM - UNCOMMENTED AT PRESENT

	FIELD 0
	MTHREE=CLA CLL CMA RTL
	*200
GETNAM,	JMP I PRNAME
	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
PRNAME,	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
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 [-40
	SPA
	TAD [100
	TAD [240
	JMS I PCH
	JMP I PCHAR
PRINT,	0
	JMP .+3
	TSF
	JMP .-1
	TLS
	CLA
	TAD [7000
	DCA PRINT+1
	JMP I PRINT
KMER1,	JMS PRNAME
	JMS PRMESG
	TEXT	/ NOT AVAILABLE/
TMP,	0
	*400
KMNTRY,	JMP I .+1
	KMINIT
PCRLF,	JMS I [CRLF
KEYMON,	JMS I GLINE
	TAD [BEGLN-1
	DCA LXR
	JMS I GNAME
	JMP PRINTQ
	JMS I [SRCH
	-123;	ASSIGN
	-2301;	SAVE
	-2225;	RUN
	-705;	GET
	-2200;	R
	-2324;	START
	-1704;	ODT
	-0405;	DEAS
	-0401;	DATE
	0
	JMS I [PRNAME
PRINTQ,	JMS I [PRMESG
	TEXT	/?/
	0
ASSIGN,	TAD [12
	JMS GDEVNO
	TAD [UDNAME-1
	DCA TM1
	JMS I GNAME
	JMP STONAM
	TAD NM2
	SNA
	CML
	TAD NM1
	SNL SMA
	TAD [4000
STONAM,	CDF 10
	DCA I TM1
	CDF 0
	JMP KEYMON
R,	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,	0
	JMP I [KMER1
	TAD ASNM1+1
	JMP I GDEVNO
GET,	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
	0		/USELESS LENGTH WORD
	JMP I [KMER2
	JMP I .+1
	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
	TAD [1200
	DCA HNDLAD
	CLA IAC
	JMS GDEVNO
	JMS RSCOMN
	JMP I .+1
	SAVE2
HNDLAD,	7400		/REPLACED WITH 1200 BY "SAVE"

DATE,	JMS I [SHNDLR
	0201
	0600
	MSOVL2		/DATE PROCESSOR IS IN UPPER HALF-RECORD
	JMP KMONER
	JMP I [1000

	*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)
	*600
START,
NOESCP,	DCA TEMP1
	DCA TEMP2
	JMS I [STRTX
	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
MINCOR,	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
	7000
FILE,	0		/READ IN THE HEADER BLOCK
	JMP KMONER	/ERROR WHILE READING HEADER BLOCK
	TAD I [7000
	JMS I [CCBTST	/TEST VALIDITY OF CCB (PERFUNCTORALLY)
	TAD I [7001
	DCA I [MSTCDF
	TAD I [7002
	DCA I [MSTADR	/MOVE THE STARTING ADDRESS INTO UPPER CORE
	TAD I [7001
	DCA I [JFIELD
	TAD I [7002
	DCA I [JSTART
	TAD I [7003	/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
RUN2,	TAD I [PGNAME+1
	CMA
	TAD FILE
	DCA R7400		/GET THE RECORD NUMBER OF THE LAST RECORD IN THE FILE
	TAD I [7000
	CLL CMA RAL
	TAD [7004
	DCA TM1		/AND THE ADDRESS OF THE LAST PARAMETER PAIR
	TAD I TM1
	DCA I [MREAD+2
	ISZ TM1
	TAD DEVHND
	TAD [200		/LINK IS ZERO AT THIS POINT
	SNL CLA			/IS THIS DEVICE HANDLER IN PAGE 7600?
	TAD I TM1		/NO - MUST CHECK FOR DESTROYING PG 7400
	CLL RAL			/(AC=0 IF LOADING FROM SYSTEM HANDLER)
	TAD I [MREAD+2
	TAD [200
	SZA CLA			/DOES THIS PROGRAM LOAD OVER PG 7400?
	JMP RUN6		/NO - BREATHE EASY
	JMS I DEVHND
	0101
	6600
R7400,	0			/YES - READ THE CONTENTS OF PAGE 7400
	JMP I [RERR		/INTO PG 6600 AND WRITE THEM ON "SYS"
	JMS WRCTLB		/ALONG WITH THE CORE CONTROL BLOCK
	ISZ RUNSW		/FROM NOW ON WE LOOK LIKE AN "R" COMMAND
	DCA I [MSWITC		/SET SWITCH TO READ PG 7400 FROM "SYS"
	TAD I TM1
	TAD [7700		/BUMP DOWN COUNT OF LAST PARAMETER PAIR
	SZA			/DID WE EXHAUST IT?
	JMP RUN5		/NO - COOL
	ISZ I [7000		/WE DID - BUMP NUMBER OF PAIRS DOWN
	SKP
	JMP I [MSWITC	/ONLY ONE PAIR - GO RESTORE 7400 & START
RUN5,	DCA I TM1		/RESTORE BUMPED COUNT
	JMP RUN2	/GO BACK AND DO IT RIGHT(MUST FALL THROUGH)

RUN6,	TAD I TM1
	DCA I [MREAD+1
	TAD RUNSW
	SNA CLA			/IS THIS A "RUN" COMMAND?
	JMS WRCTLB		/YES - WRITE OUT THE CORE CONTROL BLOCK
	TAD FILE
	JMP I [RUN7		/GO DO THE ACTUAL LOADING

WRCTLB,	0
	JMS I [SHNDLR
	4200
	6600
	MTEMP+10		/THE CONTROL BLOCK GOES INTO THE UPPER HALF
	JMP KMONER		/OF RECORD "MTEMP+10"
	JMP I WRCTLB		/PAGE 7400 GOES INTO THE LOWER HALF IF NECESSARY


DEAS,	TAD [UDNAME-1	/ZERO OUT USER DEVICE NAME TABLE
	DCA X1
	TAD [-17
	DCA TM1
	CDF 10
	DCA I X1
	ISZ TM1
	JMP .-2
	CDF 0
	JMP I [KEYMON
	*1000
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 ADR1		/MOVE THE ACTUAL LOADER
	ISZ ADR2		/INTO PAGE 7200
	ISZ ADCNT
	JMP .-5
	JMP I .+1		/AND GO TO IT
	RUN8&177+7200

ADR1,	RUN8
ADR2,	RUN8&177+7200
ADCNT,	RUN8&177+7600

RUN8,	ISZ I R7000	/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
	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,	0
RADR,	0
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

ROTAT,	0
	CLL RTR
	RTR
	RTR
	AND (37
	IAC
	CLL RAR
	JMP I ROTAT
RERR,	CIF 10
	JMS I (7700
	7
	0	/TOTALLY MEANINGLESS
RUNADR,	7004
R7000,	7000
RMRD3,	MREAD+3
KMER2,	JMS I [PRNAME
	JMS I [PRMESG
	TEXT	/ NOT FOUND/
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
	RUNHND=CCBTST	/GRUNGE A LOCATION
	CMA
	AND [7740
	SNA CLA
	JMP I CCBTST	/IT WAS VALID
	TAD [7605
	DCA ERRET	/RELOAD MONITOR ON THIS ERROR
	JMS I [PRMESG	/IT WASN'T - TELL THE USER
	TEXT	/BAD CORE IMAGE/
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

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
	CDF 10
	TAD [MOFILE-1
	DCA X1
	TAD [-47
	DCA TEMP1
	DCA I X1	/ZERO OUT THE COMMAND DECODER AREA
	ISZ TEMP1
	JMP .-2
	CDF 0
	JMP I RESET

KMER3,	JMS I [PRMESG
	TEXT	/NO!!/
	*1200
	/TELETYPE INPUT ROUTINE
XGLINE,	KEYMON+1
	TAD [256
	JMS I PCH
	DCA RBFLAG
	TAD [BEGLN-1
	DCA LXR
CHLOOP,	KSF
	JMP CHLOOP
	TAD [200
	KRS
	DCA NM1
	KCC
	JMS SRCH
	-225;CTRLU
	-215;CARRET
	-377;RUBOUT
	-375;ALTMOD
	-376;ALTMOD
	-233;ALTMOD
	-212;LFEED
	-200;CHLOOP
	-217;CHLOOP	/IGNORE ^O
	-203;CTRLC	/MUST BE JUST BEFORE 0
ZROFUJ,	0
	JMS PRNT
CINSRT,	TAD NM1
	DCA I LXR
	TAD LXR
	TAD [-BEGLN-110
	SPA CLA
	JMP CHLOOP
CARRET,	JMS CRLF
	TAD LXR
	TAD [1-BEGLN
	SNA CLA
	JMP XGLINE+1
	DCA I LXR
	DCA I LXR
	JMP I XGLINE
PRNT,	0
	ISZ RBFLAG
	JMP .+3
	TAD [334
	JMS I PCH
	DCA RBFLAG
	TAD NM1
	JMS I PCH
	JMP I PRNT
CTRLC,
CTRLU,	TAD [336
	JMS I PCH
	TAD NM1
	TAD [100
CLRLIN,	JMS I PCH
	JMS CRLF
	ISZ SRCH
	TAD I SRCH
	SZA CLA
	JMP XGLINE+3
	JMP XGLINE+1
CRLF,	0
	TAD [215
	DCA NM1
	JMS PRNT
	TAD [212
	JMS I PCH
	JMP I CRLF
ALTMOD,	TAD [244
	DCA NM1
	JMS PRNT
	JMP CARRET+1
RUBOUT,	TAD LXR
	TAD [1-BEGLN
	SNA CLA
	JMP RBSPCL
	TAD [334
	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 CHLOOP-1
RBSPCL,	ISZ RBFLAG
	JMP CLRLIN+1
	TAD [334
	JMP CLRLIN
SRCH,	ZROFUJ-1		/PART OF THE "INITIAL ^C" FUDGE
	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 CRLF
	DCA I LXR
	TAD [BEGLN-1
	DCA XR
	TAD I XR
	SNA
	JMP LBCKUP
	JMS I PCH
	JMP .-4
	*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 => 7740
	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 .-6		/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
ELENGT,	0		/KNOWN LENGTH
	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
SAVE5,	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
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 ***

LOADF0,	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/
	*1600
BEGLN,	0	/LINE BUFFER
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 PMSWIT	/RESTORE THE "MSWITC" AREA IN PAGE 7600
	DCA X1
	TAD PMSRST	/SINCE IT CAN BE DESTROYED BY "SYSTEM ODT"
	DCA LXR
	TAD M7
	DCA TEMP2
	TAD I LXR
	DCA I X1
	ISZ TEMP2
	JMP .-3
	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
	KCC			/CLEAR KEYBOARD FLAG
	JMP I .+1	/YES
	CTRLC		/PRINT "^C"
M203,	-203
M7,	-7
PMSWIT,	MSWITC
PMSRST,	.		/THIS IS THE TABLE USED TO REFRESH 7765-7773
	SHNDLR&177+4200	/JMS SHNDLR
	0100
	7400
	MTEMP+10
	HLT
	CDF CIF 0
	TCF

	*1712	/LOCS 1600-1711 ARE FOR THE LINE BUFFER
STRTX,	0
	TAD I LXR
	SNA
	JMP I STRTX
	SKP
DIGTLP,	TAD I LXR
	TAD (-270
	CLL
	TAD [10
	SNL
	JMP EONUM
	DCA TMP1
	ISZ DIGFLG
	JMS ROT
	JMS ROT
	JMS ROT
	TAD TEMP2
	TAD TMP1
	DCA TEMP2
	JMP DIGTLP
EONUM,	CLA
	TAD TEMP1
	AND (7
	CLL RTL
	RAL
	TAD (6203
	DCA I [MSTCDF
	TAD TEMP2
	JMP I .+1
	STCOMN
ROT,	0
	TAD TEMP2
	CLL RAL
	DCA TEMP2
	TAD TEMP1
	RAL
	DCA TEMP1
	JMP I ROT
SAVE2,	TAD I LXR
	SNA CLA
	JMP I (SAVE2A
	JMS I [SHNDLR
	0201
	600
	MSOVLY
	JMP KMONER
	JMP I .-3
	/OVERLAY TO KEYBOARD MONITOR FOR "SAVE" WITH ARGUMENTS
	*2000		/GOES INTO 600
SAVE1A,	TAD (STRTX&177+2200	/"ISZ STRTX"
	DCA I (EONUM
	TAD (STRTX&177+5600	/"JMP I STRTX"
	DCA I (EONUM+1
	TAD (1603
	DCA X1
	DCA TM1
	CDF 10
	DCA I [OLDT9
S6203,	CIF CDF 0
	TAD (SROTAT-1200
	DCA PROTAT	/REPLACE THE POINTER TO "ROTAT" AS WE HAVE DESTROYED THE ORIGINAL
	TAD (SGETOUT-1200
	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 I (SGTNUM-1200
	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
	TAD OLD1
	SZA CLA	/ARE THE FIELDS THE SAME?
	JMP KMER5	/NO - ERROR
	TAD TEMP2
	AND [7600
	TAD [200
	DCA TEMP2
	TAD TEMP2
	CIA CLL
	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
SDLOOK,	CDF 0
	TAD I LXR
	SNA
	JMP I (SVEND-1200
	TAD (-",
	SNA
	JMP SNUMLP-1
	TAD (",-";
	SNA
	JMP SSTADR
	TAD (";-"=
	SNA CLA
	JMP I (SSBITS-1200
KMER5,	JMS I [PRMESG
	TEXT	/ILLEGAL ARG./
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 I (SGTNUM-1200
	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
	*2200	/LOADS INTO 1000
SGTNUM,	0
	DCA DIGFLG
	DCA TEMP1
	DCA TEMP2
	JMS I [STRTX
	JMP .+4
	TAD (20
	SNA CLA
	JMP .-4
	JMS I (LXRBAK-1200
	TAD DIGFLG
	SZA CLA
	ISZ SGTNUM
	JMP I SGTNUM
SSBITS,	JMS SGTNUM
	JMP I (KMER5-1200
	TAD TEMP2
	CDF 10
	DCA I (1603
	JMP I (SDLOOK-1200
SVEND,	JMS I [SHNDLR
	0101
	0600
	MSOVL2		/READ IN SECOND PART OF OVERLAY
	JMP KMONER
	TAD TM1
	SNA
	JMP I (MOVECB-1600
	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-1600	/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-1600	/SORT COMPLETE - CHECK FOR CONSISTENCY
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 
SROTAT,	0		/THIS ROTATE REPLACES THE ROTAT ROUTINE
	RTR		/WHICH WE HAVE UNFORTUNATELY READ OVER
	RTR
	RTR
	AND (37
	IAC
	CLL RAR
	JMP I SROTAT

SGETOUT,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
	JMP I SGETOUT
TIE,	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
	*2400		/LOADS INTO 600 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 LXR
	CIA CLL
	TAD I X1
	SNA CLA
	JMP BUTTNG	/UPPER LIMIT(2)=LOWER LIMIT(1) - ABUTTING SEGMENTS
	SNL 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
MERGED,	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
	JMP I (CBMOVE-1200
	*2600	/DATE PROCESSOR - LOADS INTO 600
DATEXX,	JMS DECIM
	-15	/GET THE MONTH
	CLL RTR
	RTR
	RAR		/PUT IN BITS 0-3
	DCA TEMP1
	JMS DECIM
	-40		/GET THE DAY
	CLL RTL
	RAL		/PUT IN BITS 4-8
	TAD TEMP1
	DCA TEMP1	/COMBINE WITH MONTH
	DCA DDELIM	/MAKE END-OF-LINE THE DELIMITER
	JMS DECIM
	-116	/GET THE YEAR
	TAD (-106	/SCALE DOWN TO RANGE 1970-1977
	SPA
	JMP BADNUM	/DIDN'T MAKE THE RANGE
	TAD TEMP1	/COMBINE WITH MONTH AND DAY
	CDF 10
	DCA I (MDATE	/STORE IN SYSTEM DATE CELL
	CDF 00
	TSF
	JMP .-1		/WAIT FOR TELETYPE TO DIE DOWN (RF08)
	JMP I (7605	/RETURN TO MONITOR

DECIM,	0		/DECIMAL INPUT FOR DATE
	DCA TEMP2
DECMLP,	TAD I LXR	/GET NEXT CHAR
	DCA TM1
	TAD TM1
	TAD (-240
	SNA CLA
	JMP DECMLP	/IGNORE BLANKS
	TAD TM1
	TAD DDELIM	/CHECK FOR SLASH OR EOL
	SNA CLA
	JMP DECOVR
	TAD TM1
	TAD  (-272
	CLL
	TAD (12
	SNL		/CHECK IF DIGIT
	JMP BADNUM	/NO - ERROR IN DATE
	DCA TM1
	TAD TEMP2
	CLL RTL
	TAD TEMP2
	RAL
	TAD TM1
	DCA TEMP2
	JMP DECMLP
DECOVR,	CLA CLL
	TAD TEMP2
	TAD I DECIM
	SZL CLA		/TEST IF NUMBER IS WITHIN LIMITS
	JMP BADNUM	/IT ISN'T
	ISZ DECIM
	TAD TEMP2
	JMP I DECIM	/RETURN WITH NUMBER IN AC

BADNUM,	CLA		/CRAP IN AC
	TAD (7605
	DCA ERRET
	JMS I [PRMESG
	TEXT	/BAD DATE/
DDELIM,	-257
	*3000	/MONITOR ERROR PROCESSOR - LOADS INTO 11400
	CLA CMA
	JMS I (FGET
	ISZ ZERO
	JMP .-3	/WAIT FOR TELETYPE PRINTER
	CLA
	TAD MERRNO
	CLL RAL
	SNA
	JMP USRERR
	CLL RAR
	TAD (60
	DCA I (MERTYP-1400
MERCMN,	TAD (MERRXR
	DCA XR
	TAD I XR
	SNA
	JMP MERNUM
	JMS MERPCH
	JMP .-4
MERNUM,	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
	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 (7600
USRERR,	CLA CLL
	JMS I (FGET
	TAD (60
	DCA I (UERTYP-1400
	TAD (UERRXR-MERRXR
	JMP MERCMN
MERPCH,	0
	6046
	6041
	JMP .-1
	CLA
	JMP I MERPCH
ZERO,	0
	*3200		/LOADS INTO 1600
	MERRXR=.-1401
	"M;"O;"N;"I;"T;"O;"R;" ;"E;"R;"R;"O;"R;" 
MERTYP,	0;" ;"A;"T;" 
	0
	UERRXR=.-1401
	"U;"S;"E;"R;" ;"E;"R;"R;"O;"R;" 
UERTYP,	0;" ;"A;"T;" 
	0
		/EXECUTION TIME LOADER FOR MONITOR "CHAIN" COMMAND
	*3400	/EXECUTES IN FIELD 0 IN PAGE 7400
MCHNX,	DCA MCHREC		/STORE STARTING RECORD #
	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 (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
MCHRD,	0
	JMS I (SHNDLR
MCHCTL,	0101		/1 RECORD INTO FIELD 0 STARTING FORWARDS
	MCHADR,	7200
MCHREC,	0
	HLT		/CANT COPE WITH ERRORS ON SYSTEM DEVICE
	TAD MCHCTL
MCHBMP,	CLL RTR
	RTR
	RTR
	AND (37
	IAC
	CLL RAR
	TAD MCHREC
	DCA MCHREC
	JMP I MCHRD
MCHT1,	0
MCHFJM,	MSTCDF&177+5200	/"JMP MSTCDF"
	*4000	/SYSTEM GENERATOR - WRITES STUFF OUT USING SHNDLR
	WRITE=JMS I 0
	JMS SYSSWP	/SWAP SYSTEM DEVICE HANDLER INTO 7600

	WRITE;	4200;	7400;	0;	JMP BERR	/BOOTSTRAP
	TAD RBFLAG
	SZA CLA
	JMP .+6
	WRITE;	4210;	1377;	01;	JMP BERR	/DIRECTORY
	WRITE;	5001;	0000;	07;	JMP BERR	/KEYBOARD MONITOR
	WRITE;	4610;	0000;	MONTOR;	JMP BERR	/INPUT-OUTPUT MONITOR
	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 TEMP1
	TAD W7600
	DCA TEMP2
SWAPLP,	TAD I TEMP1
	DCA TM1
	TAD I TEMP2
	DCA I TEMP1
	TAD TM1
	DCA I TEMP2
	ISZ TEMP1
	ISZ TEMP2
	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
	*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

MCALL1,	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
	HLT
	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
MARG1,	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
DCB,	ZBLOCK 17		/DEVICE CONTROL BLOCK - SET IN "CONFIG"









	/********************************************************
	/	MAP OF SYSTEM DEVICE AS OF 12/1/69
	/********************************************************
	/            *   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-67	RESERVED FOR EXPANSION
	/	70-END	FILE STORAGE
	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
	*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 OPTOMIZATION
		/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 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 7400 (HANDLER) MUST BE READ OVER
	JMS SHNDLR
	0100
	7400
	MTEMP+10	/GET THE PAGE OFF OF THE SYSTEM DEVICE
	HLT
MSTCDF,	CDF CIF 0
	TCF		/EXIT WITH A CLEAR CONSCIENCE(ALSO A CLEAR FLAG)
	JMP I .+1
MSTADR,	0
SBLOCK,	0
	*0
	SHNDLR	/USED BY SYSGEN (4000)
KMONER,	CLA
	TAD [7605
	DCA ERRET
	JMS I [PRMESG
	TEXT	/SYSTEM ERROR/
LXR,	0
X1,	0
	*20
RBFLAG,	0		/USED BY SYSGEN - MUST BE AT LOC 20
TEMP1,	0
TEMP2,	0
TM1,	0
TMP1,	0
SYSTEM,	7700
PCH,	PRINT
GLINE,	XGLINE
GNAME,	GETNAM
NM1,	203
NM2,	0
NM3,	0
NM4,	0
DEVHND,	7607
NMCT,	0
PN,	0
PRDSW,	0
RUNSW,	0
DIGFLG,	0
FUDJMP,	MSTCDF&177+5200	/"JMP MSTCDF"
SENTER,	0
P6203,	6203
PROTAT,	ROTAT
PGTOUT,	GETOUT
ERRET,	PCRLF		/SET TO 7605 BY CERTAIN ROUTINES
	FIELD 1
	/FIELD 1
	/BLEEP 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
	HLT	/BRANCH TO APPROPRIATE ROUTINE WITH LINK ON
MCTABL,	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
MCD,	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
	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
FGET,	0
	TAD MONITO
	JMS FGETW
	JMP I FGET
FGETW,	0
	DCA FPUT
FGETX,	HLT
	TAD I FPUT
	CDF CIF 10
	JMP I FGETW

CDSWAP,	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
	*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

GETREC,	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
	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"
	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
	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
	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
	JMP I [MERROR+2	/CANNOT REWRITE CATALOG
	JMP I MWRCAT

	IFNZRO .-766	<REASSEMBLE CONFIG>
SDVHND,	ZBLOCK 17	/DEVICE HANDLER INFORMATION TABLE - SET BY CONFIG
	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 [MLNOTF	/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"

MEMPTY,	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
	*1200
	/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
	SZA CLA		/IS IT THE SAME AS THE ONE WE JUST SQUISHED?
	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
	JMS I [MWRCAT
CRETRN,	ISZ I [MONITO
	JMP I [MRTRN+1

	/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
	JMP CONSOL+1	/REPEAT ENTIRE CONSOLIDATION - THIS DELETION MAY
			/HAVE BROUGHT TWO FREE ENTRIES TOGEHER
CONMTF,	TAD I XR	/IS THIS FREE ENTRY NULL?
	SNA
	JMP SQTRIV	/YES - SQUASHITLIKEABUG
	DCA T2		/NO - SAVE LENGTH
	TAD XR
	DCA T1		/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 T1	/STORE BACK IN FIRST LENGTH WORD AND SQUISH SECOND ENTRY
SQTRIV,	CLA CMA CLL RAL
	JMP SQCOMN	/SQUISH OUT 2 WORDS
CONLPT,	ISZ T7
	JMP CONLP	/MORE FILES - KEEP PLUGGING
	JMP I CONSOL	/RETURN FROM CONSOLIDATOR
MRESET,	TAD [-17
	DCA T3
MRSETL,	TAD T3
	JMS I [MCKDEV
	CLL
	TAD [200
	SNL CLA		/ZERO ALL DEVICE HANDLER SLOTS THAT AREN'T RESIDENT
	DCA I T1
	JMS I [FGET
	SNA CLA		/IF NEXT WD IS 0, DONT ZAP OPEN FILES
	JMP .+4
	TAD [7770
	AND I T8
	DCA I T8	/DELETE THE "FILE CURRENTLY OPEN" FLAG IF ASKED
	ISZ T3
	JMP MRSETL
	JMP I [MNEXT
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
	*1377		/MOVE UP IF THE LOCATION IS NEEDED
	NOPUNCH
	*1400
	ENPUNCH
	/INITIAL DIRECTORY FOR MONITOR
	/DEFINES BLEEP LOADER (LOADER.SV) AND DEC BINARY LOADER(BINLDR.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
	5370	/ENCODING FOR "OCTOBER 31, 1970"
	-5	/FIVE BLOCKS LONG( 1 BLOCK = 256 WORDS)
	0	/EMPTY SPACE
	-1	/OVERLAYED BY DEVICE DEPENDENT PART WITH LENGTH
	*3400	/"ENTER" OVERLAY TO USR - RUNS IN 11000
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
	TAD XR
	DCA METMP1
	TAD XR
	TAD MEFCNT
	DCA METMP2	/PREPARE TO PUSH ALL ENTRIES UP
MELP3,	TAD I METMP1
	DCA I METMP2	/DO THE PUSHING
	CLA CMA
	TAD METMP1
	DCA METMP1
	CLA CMA
	TAD METMP2
	DCA METMP2
	TAD METMP1
	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

MELAST,	TAD I [DCOUNT
	CLL CML RAR	/GIVE THE NEW SEGMENT HALF OF THE OLD ENTRIES
	DCA METMP1	/LENGTH OF NEW SEGMENT
	TAD METMP1
	CIA
	TAD I [DCOUNT
	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 [-7
	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
MEOCNT,	0
MEFCNT,	0
METMP1,	0
METMP2,	0
MNOFIL,	0
	MEOVLS=1200	/DESTROYS PART OF "CLOSE" OP FOR BUFFER
	/ABSOLUTE LOADER FOR BLEEP MONITOR - VERSION 1( AND ONLY)
	*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
	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
GETCH,	0		/GET-NEXT-INPUT-CHARACTER ROUTINE
	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
JMPGET,	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
	*2200
PUTWD,	0

	/	AND I B2
	/	DCA PUTMP
	/	TAD PUTMP
	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
	/	TAD PUTMP
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
FLD1,	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
	HLT
	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,	0
	TAD BUFREC
	SNA
	JMP I WRBUF
	CIF 0
	JMS I [SHNDLR
	4210
PTRBFR,	1400
BUFREC,	0
	JMP I (LIOERR
	/BAD I/O ON SYSTEM DEVICE
	JMP I WRBUF
PUTMP,	0


CORTAB,	ZBLOCK 30

NEXFIL,	0
	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

ORGX=NEXFIL
	*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
	JMP GETNXT
DATAWD,	JMS I (LOADWD
	ISZ ORIGIN
L40,	40
GETNXT,	TAD WD1
	TAD WD2
	TAD LCKSUM
	DCA LCKSUM
	TAD WD
	JMP NEWWD
ASSEMB,	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
	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

GETFLD,	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
	*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
	CLL RAR
	SZA CLA		/DON'T INCLUDE PAGES 07600 OR 17600
	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
FLDOVR,	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+2
	AND (3
	TAD I (CTLBLK+3
	DCA I (CTLBLK+3
	TAD LSTFLD
	AND (7
	CLL RTL
	RAL
	TAD [CDF CIF 0
	DCA I (CTLBLK+1
	TAD LSTADR
	DCA I (CTLBLK+2
	JMP I (LGTOUT	/WRITE CONTROL BLOCK AND EXIT
FIELDB,	0

SETADR,	0
	UPPERA=SETADR
	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

LINIT2,	0
	LOWERA=LINIT2
	DCA LSTFLD
	TAD [200
	DCA LSTADR	/INITIALIZE STARTING FIELD/ADDRESS
	DCA PG7400
	DCA I (OVLYFG	/INITIALIZE FLAGS FOR OVERLAYS
	JMP I LINIT2
LSTFLD,	0
LSTADR,	200
	*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 CRAP
	/********************************************
	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
LNOGO,	TAD CTL3
	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

LOADWD,	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
	*3200
ERPCH,	0
	AND (77	/GET LOW ORDER 6 BITS
	SZA
	JMP NZCHAR
	JMS ERR
FILMSG,	TEXT	/, FILE 0/
NZCHAR,	TAD (-40
	SPA
	TAD (100
	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

ERR,	0
	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
	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 I (CTINIT
	NOP
	JMS ERR
	TEXT	/NO INPUT/
LIOERR,	JMS ERR
	TEXT	/SYSTEM I-O ERROR/
OERR,	JMS ERR
	TEXT %NO /I!%

CTINIT,	0
	TAD (-30
	DCA C1
	TAD (CORTAB-1
	DCA LOADXR
	CLA CMA
	DCA I LOADXR
	ISZ C1
	JMP .-3
	JMS I (LINIT2
	ISZ CTINIT
	JMP I CTINIT

*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 (7740
	SZA CLA
	JMP I (BADINP	/NOT CORE IMAGE
	TAD I CCBPTR
	DCA SEGCNT
NEWSEG,	TAD I SGSTAD	/SEGMENT START ADDRESS
	DCA ORIGIN
	TAD I SGFDLT	/FIELD AND LENGTH
	AND (77
	DCA XFIELD
	TAD I SGFDLT
	AND [7700
	DCA SEGLTH
TWOPG,	TAD SEGLTH
	SPA SNA		/ALL PAGES DONE IN THIS SEGMENT?
	JMP GTSEG	/YES
	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
BUFPT,	1400	/INTO 11400
DATRC,	0
	JMP I (IOERR	/DATA FAILURE
	CLA CMA
	TAD ORIGIN
	AND [177
	TAD (1200	/SET UP INPUT POINTER
	CHARPT=10
	DCA CHARPT
	TAD I CHARPT
	JMS I (LOADWD	/MOST OF THE WORK
	ISZ ORIGIN
	ISZ WDCT	/FINISHED THIS BLOCK?
	JMP .-4
	JMS I (WRBUF	/YES.. WRITE THE STUFF OUT
	DCA I (BUFREC	/SO THAT WRBUF DOESN'T SCREW US UP
	JMP TWOPG	/NEXT!

GTSEG,	ISZ SEGCNT	/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+4	/SEGMENT START ADDRESS

RENEW,	CLA
	TAD (CTLBLK+4
	DCA SGSTAD
	TAD (CTLBLK+5
	DCA SGFDLT
	JMP I (NEWFIL
	/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
	*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
	$
