/LIBRARY AND FILE COMMAND PROCESSOR:

	/****** STORAGE ALLOCATION MAP ******
	/*****				*****
	/*	1200	2ND INPUT BUFFER
	/*	1600	THE OUTPUT BUFFER
	/*	2200	STACK LIVES HERE
	/*	3000	PUSHDOWN ROUTINES
	/*	3200	MAIN INPUT BUFFER
	/*	3600	MAIN INPUT HANDLER
	/*	4200	THE LIBRARY HANDLER
	/*	4600	THE OUTPUT HANDLER
	/*	5200	2ND INPUT HANDLER
	/*
	/*	5600	FILE OUTPUT, CLOSE & ABORT
	/*	6000	OPEN, RESTORE & FILE INPUT
	/*	6200	TABULATE, HANDLER & SETDHT
	/*	6400	DECODER, DATER, SAVER, GOSUB
	/*	6600	RUN,CALL,BRANCH,RETURN,LJUMP
	/*	7000	LIBRARIAN, IOWAIT
	/*	7200	OPEN, DISMISS & COMPARE
	/*	7400	GTNAME
	/*****				*****
	/************************************

/	INITIAL TEXT FOR U/W-FOCAL

	FIELD 2
	PAGE  1
	0		/PROGRAM LENGTH
	5051		/'()' FOR TDUMP
LINE0,	0		/POINTER TO NEXT
	0		/LINE NO. ZERO
	TEXT "C U/W-FOCAL:"
TITLE,	TEXT "VER-4E"	/'?M'=CODED CR
DATE,	TEXT "15.10.78?M"
LINE1=	DATE+5		/NULLS BECOME SPACES

	*100
	ZBLOCK 2	/PC0 FOR COMMAND MODE
/PAGE ZERO STORAGE HAS BEEN CAREFULLY ARRANGED !

	FIELD 0
	PAGE  0

	INITLZ		/INTERRUPT SERVICE ROUTINE
	CIF P
	JMP I [INTRPT	/PATCH 177 FOR POWER FAIL

PRNTC,	RMF		/RETURN FROM THE INTERRUPT
	I0N
CL0SE,	5600		/'JMP I 0'

USR,	7700	//POINTER TO MONITOR (200 IF IN CORE)
K77,	77	//LOCATION 7 FOR PLOTTER ROUTINES

AUTO,	ZBLOCK 4	/AUTO-INDEX REGISTERS

ICHARX,	ICHAR0		/USE THE REMAINING ONES
OFFSET,	ICHAR-XI33	/FOR THE EXTRA FEATURES
SCHARX,	SCHAR0-ICHAR0

	*20
NONAME,	LPUSHF		/INSERT VERSION NO. AFTER 'ERASE'
H0RD,	    VERSION
	LPOPF
XCHAR,	    NAMLOC-1	/STRATEGICALLY LOCATED!
IOWAIT,	SP1		/POINTER TOO!
	DCA GOSW	/SET RETURN POINTER
	JMS TEMP	/THEN UPDATE HEADER
	DCA LIBFLG	/ZAP 'PROGRAM SAVED' FLAG
	TAD GOSW	/RETURN FOR LOAD CALLS
EXIT,	TAD GOJUMP	/NORMAL RETURNS='JMP I (PROC'
	DCA GOSW
	DISMISS		/REMOVE THE USR
	CDI P
	I0N

GOSW,	[DERR		/LOWER FIELD ERROR ROUTINE
	DISMISS		/CLEARS AC (JMP 135)
	TAD GOSW	/(RELOCATE FOR LINC INTERRUPTS)
	CDI P
	DCA I [ERROR	/SIMULATE A 'JMS'
	JMP I [ERROR+1
GOJUMP,	JMP I K177-1	/PLUS (GOSW)

	*HORD
VERSION,TEXT "16K-V4"
	LGOSUB		/-1
	CONT		/ 0
K177,	START		/+1
	GOTO+1		/+2

NEWDEV,	ZBLOCK 4	/'NEWDEV-1'='TELSW'
FLNGTH=	.-2
STBLK=	.-1		/'LIBBLK-1'='BUFR'

LIBBLK,	ZBLOCK 2	/FOR DEVICE NAME
	4201		/LOAD POINT
DEVNO,	0		/FOR DEVICE #
LIBHND,	ERTRAP		/HANDLER ENTRY

CHAR,	[7200		/LOWER FIELD COPY
NAMLOC,	ZBLOCK 4	/(MUST BE 'CHAR+1')
EXTENSION=.-1
DSK,	5723		/HASH CODE FOR DEFAULT DEVICE

LIBDEV,	ZBLOCK 4
LIBFLG=	.-1		/REFERENCE VIA P77

	*100
PC0,	0		/ENTRY AND RESTART POINT
	JMP I 0		/INITIALIZE (ONCE ONLY)
SWAP,	CLA CLL IAC	/POINTER TO SWAP ROUTINE
	JMP EXIT
	*.+2		/FOR COMPATIBILITY
TEMP,	[7400		/UPDATE THE HEADER
	CIF T
	JMP NUHEAD+1

SINBLK,	ZBLOCK 2
	5201		/4201 PATCHED BY PLOT
	0
SINHND,	0
SPOINT,	0
D,	DATE-1
XNAME,	NAMLOC

INBLK,	ZBLOCK 2
	3601
	0
INHND,	GOSW		/REREAD TRAP

OUTBLK,	ZBLOCK 2
	4601
FILDEV,	0
OUTHND,	0
OUTFLG,	0

	*PRINTC&177
ERROR0=	JMS I .		/='PRINTC'
	TRAP
ERROR1=	JMS GOSW
/SECONDARY INPUT ROUTINES: THE 'O S' AND 'O R S' COMMANDS

/IN THE ABSENCE OF THE PLOTTER ROUTINES THERE ARE NO RE-
/STRICTIONS ON THE SECOND INPUT FILE, BUT THE ADDITION OF
/THESE ROUTINES LIMITS THE 'L' COMMANDS TO THE USE OF THE
/<SAME> DEVICE - OR ANY HANDLER CO-RESIDENT WITH THE SYS-
/TEM DEVICE, SUCH AS 'RKB0', OR 'DTA1' IN A 'TD8E' SYSTEM.

	*200
SINPUT,	CLL CMA		/USE THE REGULAR LOOKUP ROUTINE
	JMS I [OPEN
	    SINBLK-1
	ERROR0		/FILE MISSING
	JMP I CRT	/PATCHED BY SCOPE OVERLAY
	TAD STBLK
	DCA SBLK
	SM1
	DCA SINFLG

SRST,	TAD SINFLG
	SNA CLA
	ERROR0		/NOTHING LEFT
	TAD SCHARX
	*CR
	TAD ICHARX	/ENTRY POINT FOR 'O I', 'O R I'
	CDF P
	DCA I INP	/CHANGE THE FILE INPUT POINTER
	JMP I TTY

INP,	FILIN
TTY,	TTYIN-1
CRT,	TTYIN		/OR 'OSCOPE'
END,	ENDCHK

SEND,	0		/POINTS TO NEXT STEP
	JMS I END	/CHECK FOR THE EOF
SINFLG,	0		/'FILE OPEN' FLAG

SCHAR0,	ISZ SINFLG	/BUFFER EMPTY?
	JMP I SEND	/NO, GET THE NEXT CHARACTER
	I0F
	JMS I SINHND	/READ ANOTHER BLOCK
	0200
	1200		/2200 PATCHED BY PLOT
SBLK,	0
	SMA CLA		/FATAL ERROR?
	SKP CLA
	JMP I [DERR
	TAD [-600
	DCA SINFLG	/RESET THE WORD COUNTER
	ISZ SBLK	/ADVANCE THE BLOCK NO.
	TAD SBLK-1
	DCA SPOINT	/AND RESTART FROM THE TOP
	I0N
SCHAR1,	TAD I SPOINT	/UNPACK THE BUFFER
	JMS SEND

	TAD I SPOINT	/SAVE UPPER 4 BITS
	AND [7400
	DCA I SBLK-1
	ISZ SPOINT	/POINT TO THE NEXT
	TAD I SPOINT
	JMS SEND

	TAD I SPOINT	/NOW TO PUT THE PIECES
	ISZ SPOINT	/ALL TOGETHER AGAIN
	AND [7400
	CLL RTR
	RTR
	TAD I SBLK-1
	RTR
	RTR
	JMS SEND
	JMP SCHAR1	/ROUND & ROUND & ROUND WE GO
/////

LPTDEV,	XOUTL; ZBLOCK 2	/CHANGE THESE 3 LOCATIONS TO THE
/DEVICE	LPT		/ENTRY POINT AND THE DEVICE NAME

LPTCHK,	[PDLXR		/CHECK FOR CALLS TO 'LPT:'
	SM2
	COMPAR		/NOW CHECK IT
	    LPTDEV
	    NEWDEV-1
	JMP I LPTCHK	/NOT WHAT WE'RE LOOKING FOR
	ISZ LPTCHK	/RETURN WITH THE ENTRY POINT
	TAD LPTDEV	/(INSERT OTHER CODE HERE - FOR EX:
	JMP I LPTCHK	/A CHECK FOR THE ',E' OPTION,ETC.)
/THE STACK, TTY BUFFER & ERROR TRAP ALL LIVE HERE

	*3024		/BEGINNING OF THE STACK

PCHK,	["0		/STACK OVERFLOW CHECK
	CDF P
	TAD I [PDLXR	/ADJUST FIELD 1 X-REGISTER
	DCA PDLXR	/BACKUP & COPY
	TAD PDLXR
	DCA I [PDLXR
	TAD PDLXR	/CHECK FOR OVERFLOW
	STL CIA
	TAD (2200	/2600 PATCHED BY PLOT
	CDI L
	SPA SNA SZL CLA	/-10 = L-P
	JMP I PCHK
PDERR,	TAD .-3		/TOO BAD!
	JMP EXIT+1	/USE 'CDI L' AS THE ERROR CODE

MPUSHF,	0		/PUSH 4 WORDS ON THE STACK
	TAD PDERR-2	/LOWER FIELD ENTRY
	TAD PCHK+1	/UPPER FIELD ENTRY
	DCA FCDF
	CLL CMA
	TAD I MPUSHF	/BACKUP POINTER
	ISZ MPUSHF
	DCA AUTO
	TAD [-4
	JMS PCHK
	TAD [-4
	DCA PCHK
FCDF,	CDF L P		/CHANGE TO CALLING FIELD
	TAD I AUTO
	CDF S
	DCA I PDLXR	/LOAD STACK
	ISZ PCHK
	JMP FCDF	/WITH FOUR WORDS
	SP2
	TAD FCDF	/CHANGE 'CDF' TO 'CDI'
	DCA .+1
	CDI L P
	JMP I MPUSHF

APUSHX,	DCA MPOPF	/PUSH THE AC ON THE STACK
	SM1
	JMS PCHK
	TAD MPOPF
	DCA I PDLXR
	CDI P
	JMP I (XPUSHA+3	/ONLY USED BY FIELD 1
	*.&7757
TBUF,	ZBLOCK 20	/TELETYPE OUTPUT BUFFER

MPOPF,	0		/POP 4 WORDS
	TAD I MPOPF
	DCA AUTO
	JMS PCHK	/COPY THE PDLXR
	TAD [-4
	DCA PCHK
	TAD I PDLXR
	DCA I AUTO
	CDF P
	ISZ I [PDLXR	/FAKE A FIELD 1 USE
	CDF L
	ISZ PCHK
	JMP .-6
	ISZ MPOPF
	JMP I MPOPF

TRAP,	0		/RECOVER FROM SELETED ERRORS
	DISMISS
	TAD TRAP
	DCA GOSW	/ASSUME NORMAL ERROR EXIT
	SP2
	CDF P
	ISZ I (NAGSW	/WAS A LINE NUMBER GIVEN?
	JMP EXIT	/YES, FALL INTO THE TRAP
	JMP GOSW+1	/NO,  DO THE USUAL STUFF

REKOVR,	0		/CONTINUATION OF ERROR ROUTINE
	KCC
	TAD (-17
	DCA TBUF
	TAD (TBUF
	DCA PDLXR
	DCA I PDLXR	/CLEAR OUT THE TTY BUFFER
	ISZ TBUF
	JMP .-2
	TAD I SWAP	/CHECK CORE-SWAP FLAG
	SNA CLA
	JMS I SWAP	/RESTORE THE SCRATCH AREA
	TAD [CR		/PRINT A CR AHEAD OF ERROR MESSAGE
	CLA		/OR 'JMS I PRNTC'
	TAD REKOVR	/LET 'EOF' RESTORE THE TTY
	CDI P
	DCA I [EOF
	JMP I (EOF+1	/THEN GO PRINT THE ERROR MESSAGE

	PAGE 26
/INITIALIZE THE VARIABLES AND THE DATE

INITLZ,	ZBLOCK 20	/CLEAR ANNOYING FLAGS

	SM8		/PATCH FOR MULTI-8
	JMP .+4
	6770		/GET THE TIME-OF-DAY
	JMS I MV1	/REVERSE HRS, MINUTES
	DCA MV1-4	/INITIALIZE RANDOM NO.

	TAD .+3
	JMS MOVE	/LOAD COMMAND DECODER AREA
	.+1-MV1
RELOC	RANDOM-16

PUTV,	.-1		/SUBROUTINE TO LOCATE VARIABLES
	DCA THISOP	/SAVE THE NAME
	DCA LORD	/CLEAR SUBSCRIPT
	PUSHJ
	    GS1		/DO THE LOOKUP
	POPF
	    FLAC	/GET THE VALUE
	FENT
	FPUTIPT1	/STORE IT
	FEXT
	TAD LASTV	/ADVANCE THE POINTER
	DCA FIRSTV
	CIF L
	JMP I PUTV	/RETURN

RANDOM,	0;4421;3040;1;0	/RANDOM ENOUGH?
RELOC

MV1,	SM1		/SET THE ADDRESS POINTERS
	TAD I (FIRSTV	/USING THE VALUE HERE
	DCA I (SECRTV
	TAD I (FIRSTV
	DCA I (LASTV
	JMS SETV	/CALL OUR FIELD 1 ROUTINE
	PI;2011
	SP2
	TAD I (LASTV
	DCA I (DIMEN	/FOR DOUBLE SUBSCRIPTING
	JMS SETV
	FPZ;4100	/!
	JMS SETV
	FPZ;4200	/"
	SP2
	TAD I (LASTV
	DCA I (FSFP	/FOR FSF'S
	JMS SETV
	FPZ;4300	/#
	JMS SETV
	FPZ;4400	/$
	JMS SETV
	FPZ;4500	/%
	JMP FINALZ	/'NOP' FOR MORE
	JMS SETV
	FPZ;4600	/&
	JMS SETV
	FPZ;7200	/:
	JMS SETV
	FPZ;3400	/\
	JMP .+3		/SINGLE QUOTE IS OUT
	FPZ;4700	/'

FINALZ,	CIF T
	JMS I (DATA	/SET THE DATE WORDS
	JMS I (ENVIR	/CHECK THE ENVIRONMENT
	KSF		/KEYBOARD INPUT?
	JMP NONAME	/NO
	JMP SWAP	/YES: LEAVE VERSION ID

FPZ=	TBUF		/FLOATING POINT ZERO
PI,	2;3110;3755;2421
SETV,	0		/CROSS-FIELD CALL
	CDF L
	TAD I SETV	/GET THE DATA VALUE
	ISZ SETV
	DCA .+2
	LPUSHF		/SAVE IT ON THE STACK
	0
	TAD I SETV	/NOW GET THE NAME
	ISZ SETV
	CDI P
	JMS I (PUTV	/AND INSERT IT
	JMP I SETV	/DF=P

MOVE,	0		/CLEVER LITTLE ROUTINE
	DCA AUTO
	TAD I MOVE
	DCA PC0+1
	ISZ MOVE
	CDF L
	TAD I MOVE	/WHERE ITS AT
	CDF P
	DCA I AUTO	/WHERE ITS GOING
	ISZ PC0+1	/COVER OUR TRACKS
	JMP MOVE+4
	ISZ MOVE
	JMP I MOVE	/DF=P

	PAGE 15

/CHECK THE RUN-TIME ENVIRONMENT:

	7777		/BIPCCL POINTER
	XI33+1		/RELOCATION POINTER
ENVIR,	0
	TAD I ENVIR-2	/ARE WE RUNNING UNDER SOMETHING?
	RTL		/2000=BATCH, 1000=RTS8
	SNL SMA CLA	/EITHER BATCH OR RTS8?
	JMP VIDEO	/NO, CHECK SCOPE MODE
	TAD ENVIR-1	/GET RELOCATION POINTER
	JMS I .+12	/CHANGE TO NON-INTERRUPT I/O
	.+1-MV2
RELOC	XI33+2
/XI33,	0
/	KSF		/ANY INPUT?
	JMP .-1		/WAIT UNTIL THERE IS
	JMS KCHK
	TAD INBUF	/HERE IT IS
	DCA XOUTL
	KCC
	DCA INBUF	/CLEAR INPUT FLAG
	TAD XOUTL
	JMP I XI33

XOUTL,	MOVE
	TLS		/THIS IS ALL WE NEED!
	7600		/'CLA' = MONITOR EXIT
	JMS KCHK	/CHECK FOR INPUT
	TSF		/BUFFER FULL?
	JMP .-1
	JMP I XOUTL

BYEBYE,	CDI		/RETURN TO OS/8
	JMP I XOUTL+2	/OR TO BATCH...
	"P-"C

POPX,	JMS KCHK	/CHECK INPUT AFTER A 'POPJ'
	JMP I .+1
	XPOPJ
	"C&277

KCHK,	POPX		/KEYBOARD CHECK
	KSF
	JMP I KCHK	/NOTHING WAITING
	KRS
	AND P177
	SNA
	JMP I KCHK	/IGNORE NULLS
	TAD M20
	SNA		/CTRL P?
	JMP M20+2
	TAD POPX-1
	SNA		/CTRL C?
	JMP BYEBYE
	TAD KCHK-1	/SET PARITY
	DCA INBUF	/SAVE THE INPUT
	JMP I KCHK
RELOC

MV2,	TAD .-20	/PATCH 'POPJ'
	DCA I (POPJ&177
	TAD .-21	/MOVE 'KSF'
	DCA I ENVIR-1	/INTO PLACE
/	DISABLE ALL THE 'IONS'

	DCA I [ERROR+1
	DCA I (4333	/FRA
	CDF L
	DCA GOSW-1
	DCA I (247	/SINPUT
	DCA I (OECHO-1
	DCA I (ICHAR1-1
	TAD MV3-5	/NOP
	DCA I (TAB+10
	DCA I (IOWATE+2

/	CHECK FOR BATCH

	TAD I ENVIR-2	/IS BATCH RUNNING?
	RAL
	SMA CLA
	JMP VIDEO	/NO, CHECK SCOPE MODE
	TAD I ENVIR-2
	AND .+16	/GET THE BATCH FIELD
	TAD .+16	/ADD 'CIF'
	DCA .+15	/SET UP THE INSTRUCTION
	TAD ENVIR-1	/CHANGE TTY TO BATCH I/O
	JMS I ENVIR+20	/=MOVE
	.+1-MV3

RELOC	XI33+2

/XI33,	0
/	CIF BF		/CHANGE TO THE BATCH FIELD
	JMS I BATIN	/READ FROM THE BATCH STREAM
	ERROR2		/NOTHING LEFT!
	TAD XOUTL-1	/CAST OUT LINEFEEDS
	SNA
	JMP XI33+1
	TAD CLF
	JMP I XI33
	-LF

XOUTL,	70		/OUTPUT TO THE BATCH LOG
	CIF		/'PATCHED FOR BATCH'
	7000		/'NOP' = BATCH EXIT
	JMS I BATOUT
	JMP I XOUTL
BATIN,	5400
BATOUT,	7400
RELOC
MEMSIZ=	CDI T V		/SELECT THE HIGHEST FIELD

MV3,	TAD .-6		/MOVE THE 'CDI' INSTR
	DCA I ENVIR-1	/TO 'XI33+1'
	TAD .-10	/AND THEN TO 'BYEBYE'
	DCA I (BYEBYE	/TO CATCH CTRL/C'S
	TAD MV2-4
	DCA I (BATXIT	/FIX UP THE ERROR ROUTINE
	TAD .-14
	TAD (-MEMSIZ	/CHECK MEMORY SIZE
	SPA SNA CLA
	ERROR1		/NOT ENOUGH MEMORY!

VIDEO,	CDF 10
	TAD I (17726	/DO WE HAVE A VIDEO TERMINAL?
	AND [200
	SNA CLA
	JMP .+6		/NO, LEAVE RUBOUT ALONE
	TAD (TAD START
	DCA I (RUB1+3
	TAD (ECHOC	/YES, USE 'BS', 'SP', 'BS'
	DCA I (RUB1+4
	SKP
	DCA I (MODLN	/REMOVE LINENO PRINTOUT
	CDF L
	JMP I ENVIR

	PAGE
/ FILE CLOSING AND OUTPUT ROUTINES

	PAGE 27		/'JMP I 0'

CLOSER,	0		/CLOSE OR REMOVE THE FILE
	DCA TEMP	/SET THE 'CALL' FLAG
	TAD OUTFLG	/IS THERE AN OPEN FILE?
	SNA CLA
	JMP I CLOSER	/NO, IGNORE THE COMMAND
	TAD O2		/WHICH COMMAND?
	SNA CLA
	JMP REMOVE	/'ABORT'
	TAD [232	/'CLOSE'
	JMS NOCHAR	/INSERT A 'CTRL/Z'
GETSIZ,	SNL SMA		/POINTS TO 'MGETA'
	JMP .-2		/AND PAD WITH ZEROS
	ISZ TEMP	/CHECK CALLING FLAG
	JMP NOSIZE

REMOVE,	JMS I GETSIZ	/GET THE CLOSING LENGTH, IF ANY
	STL		/ONLY 'O A' & 'O C' HAVE SIZES
	TAD OLNGTH	/COMPARE WITH THAT AVAILABLE
	SNL SZA CLA
	ERROR1		/BETTER LUCK NEXT TIME
	TAD I [LORD	/GET THE SIZE BACK
	SZA		/ZERO MEANS 'AS IS'
	DCA BLKCNT	/ENTRY POINT FOR OVERFLOW ERROR

NOSIZE,	CDF P		/RESTORE OUTPUT TO THE ECHO DEVICE
	TAD I [ECODEV
	DCA I [OUTDEV	/THE USR MUST NOT BE IN CORE!
	JMS I IOWAIT	/WAIT FOR TELETYPE (RESETS DF)
	JMS I [SETDHT	/SET THE ENTRY POINT FOR 'CLOSE'
	    FILDEV-1	/ POINTER TO DEVICE # AND ENTRY
	CIF 10
	TAD FILDEV	/SAVED DEVICE NO.
	JMS I USR
	4
	ONMTMP		/FILE NAME POINTER
BLKCNT,	0		/CURRENT FILE LENGTH
OLNGTH,	0		/MAXIMUM   "     "
	TAD OUTFLG
	SNA CLA
	ERROR1		/FILE WAS TOO LONG
	DCA OUTFLG	/CLEAR THE 'FILE OPEN' FLAG
	JMP I CLOSER	/ALSO CALLED BY 'SAVE' & 'DELETE'

ABORT,	DCA O2		/'OUTPUT ABORT' COMMAND
	DCA BLKCNT

CLOSE,	SM1		/'OUTPUT CLOSE' COMMAND
	JMS CLOSER	/L=1
	JMP EXIT	/SIMPLE - ONCE YOU KNOW HOW!
NOCHAR,	0		/OS/8 3/2 BUFFERED CHARACTER OUTPUT
	AND (377	/MASK OUT GARBAGE
	ISZ O2		/WHICH CHAR OF THREE?
	JMP O1		/STRAIGHT PACKING
	JMS O2		/HALF WORD PACKING - PACK 1ST HALF
	TAD O3		/GET SAVED ARG
	JMS O2		/PACK SECOND HALF
	SM3		/RESET 3-WAY SWITCH
	DCA O2		/BUFFER CAN ONLY BE FILLED WITH
	ISZ OUTFLG	/THE 3RD CHARACTER OF 3
	JMP O1+2	/NOT FULL YET
	TAD OLNGTH	/CHECK THE FILE SIZE
	TAD BLKCNT	/AMOUNT USED SO FAR
	SNL CLA		/HAVE WE GONE TOO FAR?
	JMP NOSIZE-1	/YES, DELETE THE FILE
	I0F
	JMS I OUTHND	/WRITE ONE BLOCK BUFFER
	4200
	1600		/5200 PATCHED BY PLOT
OBLK,	0
	JMP I [DERR	/DEVICE ERROR
	ISZ OBLK	/BUMP OUTPUT BLOCK
	ISZ BLKCNT	/AND COUNT OF BLOCKS SO FAR
	JMS O3		/RESET POINTERS FOR NEXT BUFFER
	JMP I NOCHAR	/L=1

O1,	DCA I OPTR1	/NORMAL PACKING IS EASY!
	ISZ OPTR1	/BUMP POINTER
	CLL
	JMP I NOCHAR	/L=0

O2,	0		/HALF-WORD PACK ROUTINE
	CLL RTL
	RTL
	DCA O3		/SAVE FOR SECOND HALF
	TAD O3
	AND [7400
	TAD I OPTR2	/ADD IN CHARACTER IN RIGHT HALF
	DCA I OPTR2	/PACK IT
	ISZ OPTR2	/BUMP POINTER AGAIN
	JMP I O2

O3,	0		/RESET THE OUTPUT POINTERS
	SM3
	DCA O2
	TAD OBLK-1
	DCA OPTR1
	TAD OPTR1
	DCA OPTR2
	TAD [-200	/X3 = 384 CHARACTERS/BUFFER
	DCA OUTFLG
	JMP I O3	/'SM3' SETS THE LINK

OPTR1,	0		/PACKING POINTERS
OPTR2,	0
	JMS NOCHAR	/'OUTPUT BUFFER' COMMAND
DUMPER,	TAD OUTFLG	/DUMPS THE OUTPUT BUFFER
	SNL SZA CLA	/L=0 INITIALLY
	JMP DUMPER-1
	JMP EXIT	/PAD WITH ZEROS AND EXIT

	ILNGTH
XLEN,	TAD OLNGTH	/FUNCTION TO CHECK FILE LENGTH
	TAD BLKCNT	/(MINUS THE AMOUNT USED SO FAR)
	CIA
	SKP
	TAD I XLEN-1	/FUNCTION TO CHECK INPUT SIZE
	CDI P
	JMP I .+1
	FL0AT

/THIS IS THE 'OPEN OUTPUT' COMMAND:

	TTYOUT
OUTPUT,	STL CMA		/SET ECHO FLAG AND CALL=3
	JMS I [OPEN	/CALL USR, HANDLER; ENTER FILE
	    OUTBLK-1	/OUTPUT HANDLER BLOCK
	ERROR0		/ENTER ERROR: CLOSE FILE & RETRY?
	JMP I OUTPUT-1	/'OPEN OUTPUT TTY:' (OR JUST 'O O')
	TAD FLNGTH	/MAXIMUM ALLOWABLE LENGTH
	CIA
	DCA OLNGTH
	TAD STBLK	/STARTING BLOCK
	DCA OBLK
	JMS O3		/SET UP PACKING POINTERS
	DCA BLKCNT
	LPUSHF		/SAVE THE FILE NAME FOR CLOSING
	    NAMLOC
	LPOPF
	    ONMTMP-1	/CODE SPILLS ACROSS THE PAGE
	*FLOUTP-1	/FUDGE TO SAVE A WORD OR TWO
	JMP ORST
BLKNO,	0
ILNGTH,	0

ORST,	TAD OUTFLG	/'OPEN RESTORE OUTPUT' COMMAND
	SNA CLA		/FLAG IS CHARACTER COUNT
	ERROR0		/NO OUTPUT FILE TO RESTORE
	TAD OFFSET	/POINTER TO FILE OUTPUT ROUTINE
TTYOUT,	TAD [XOUTL	/SWITCH OUTPUT TO THE TELETYPE
	CDF P		/ENTRY POINT FOR INTERNAL HANDLERS
	DCA I [OUTDEV
	ISZ GOSW	/SKIP IF NO ECHO
	TAD OCHAR0+2	/'TAD ENDCHK'
	DCA OECHO	/SET OUTPUT ROUTINE
	JMP EXIT	/FINISH THE LINE

TTYP,	XI33		/TTY INPUT
	INDEV
/THE 'OPEN' AND 'RESTORE' COMMANDS AND FILE INPUT/OUTPUT

	SCANER
OCMND,	JMS I .-1	/'O' COMMAND ENTRY - SKIP TO NEXT
	TAD DOTDA
	DCA EXTENSION	/SET '.DA'
	CMA
	DCA GOSW	/INITIALIZE THE ECHO SWITCH
	LJUMP		/GO DO COMMAND
	    FILIST-1
	    FILEGO-FILIST
	ERROR1		/OOPS - BAD 'O' COMMAND

RESTOR,	CDF P		/'O R' COMMANDS - GET NEXT LETTER
	TAD I XCHAR
	DCA TEMP	/SAVE COMMAND LETTER
	GTNAME		/CHECK FOR ECHO AND LINE NUMBER
	TAD TEMP
	DCA CHAR
	LJUMP		/SORT OUT "I", "O", OR "R"
	    ORLIST-1
	    ORGO-ORLIST
	ERROR1		/BAD 'RESTORE' COMMAND
DOTDA,	401		/WAS 604 FOR '.FD'

/THE 'OPEN INPUT' COMMAND:

INPUT,	CLL CMA		/INITIALIZE ECHO AND SET 'CALL'=2
	JMS I [OPEN	/CALL THAT AMAZING
	    INBLK-1	/GENERAL-PURPOSE SUBROUTINE
	ERROR0		/WHOOPS - FILE NOT FOUND
	JMP TTYIN	/'OPEN INPUT TTY:' (OR JUST 'O I')
	TAD FLNGTH
	DCA ILNGTH	/FOR 'FLEN' AND 'FRA'
	TAD STBLK
	DCA BLKNO

RERD,	TAD BLKNO	/'OPEN RE READ' COMMAND
	DCA IBLK	/FIRST BLOCK NO.
	SM1		/RESET FILE POINTERS
	DCA INFLG	/CHARACTER COUNTER

IRST,	TAD INFLG	/'OPEN RESTORE INPUT' COMMAND
	SNA CLA		/CHECK CHARACTER COUNT
	ERROR0		/NO INPUT FILE TO RESTORE
	JMP I [CR	/SET POINTER TO 'ICHAR0' (12K)
	TAD OFFSET	/=ICHAR-XI33
TTYIN,	TAD TTYP	/'OPEN INPUT TTY:'
	CDF P
	DCA I TTYP+1	/= 'INDEV'
	ISZ GOSW	/CHECK ECHO MODE
	TAD IRST+2	/= 'PRINTC'
	DCA I ECHOP
	JMP EXIT	/RETURN
/OFFSET,OCHAR-XOUTL	/8K CONSTANT
OCHAR0,	0		/FILE OUTPUT VIA 'PRINTC'
	DCA ENDCHK	/SAVE CHARACTER FOR ECHO
	TAD ENDCHK
	JMS I FILOUT	/WRITE IT
	I0N
OECHO,	TAD ENDCHK	/=0000 IF NO ECHO
	SNA
	ISZ OCHAR0	/SET NO ECHO RETURN
	CDI P
	JMP I OCHAR0
FILOUT,	NOCHAR

RDPTR,	0		/THIS IS A COROUTINE !
	JMS ENDCHK	/ISN'T THAT AMAZING ?
INFLG,	0

ICHAR0,	ISZ INFLG	/DO WE NEED ANOTHER BUFFER?
	JMP I RDPTR	/NO, UNPACK THE CHARACTER

	I0F
	JMS I INHND	/YES, GO GET IT
	0200
	3200
IBLK,	0
	SMA CLA		/ONLY BOTHER WITH FATAL ERRORS
	SKP CLA
	JMP I [DERR	/WE'VE GOT ONE
	TAD [-600	/=384 CHARACTERS/BUFFER
	DCA INFLG
	ISZ IBLK	/BUMP TO NEXT BLOCK
	TAD IBLK-1	/AND RESTORE POINTERS
	DCA IPNTR
	I0N

ICHAR1,	TAD I IPNTR	/STRAIGHT-FORWARD UNPACK ROUTINE
	JMS RDPTR	/DO COMMON STUFF

	TAD I IPNTR	/SAVE LEFT HALF FOR LATER
	AND [7400
	DCA I IBLK-1
	ISZ IPNTR	/INCREMENT TO NEXT WORD
	TAD I IPNTR	/ANOTHER EASY ONE
	JMS RDPTR

	TAD I IPNTR	/THIS IS THE TRICKY ONE!
	ISZ IPNTR	/GET LOW-ORDER HALF
	AND [7400
	CLL RTR		/SHIFT RIGHT
	RTR
	TAD I IBLK-1	/GET HIGH-ORDER HALF (REMEMBER?)
	RTR		/SHIFT SOME MORE
	RTR
	JMS RDPTR	/GOT IT!
	JMP ICHAR1	/1-2-3-1-2-3-1-2-3 ...
IPNTR,	0
ECHOP,	IECHO

/PROCESS THE CHARACTERS FROM EITHER INPUT FILE:

ENDCHK,	0		/CALLED BY 'RDPTR' AND 'SEND'
	AND K177	/IGNORE PARITY
	SZA		/NULL?
	JMP .+4		/NO
	ISZ ENDCHK	/YES, TAKE THE 2ND EXIT AND
	JMP I ENDCHK	/RETURN TO THE INPUT ROUTINE
	-32
	TAD .-1		/END OF FILE? (^Z)
	SZA
	JMP .+5		/NO
	DCA I ENDCHK	/YES, CLEAR 'FILE OPEN' FLAG
	CDF P		/AND SET UP A CLEVER RETURN
	TAD [EOF	/TO RESTORE THE KEYBOARD FOR
	DCA I TTYP+1	/INPUT AND FLAG THE ERROR AT
	TAD [232	/THE SAME TIME!  THIS -ALSO-
	CDI P		/REMOVES THE ^Z SO YOU DON'T
	JMP ICHAR+3	/GET A SECOND ERROR MESSAGE!

	*CDF L
PLTDEV,	XOUTL; ZBLOCK 2	/COULD BE USEFUL!
/TABULATE ROUTINES:  CALLED FROM THE UPPER FIELD

	CR-SP
TAB,	CDI P		/'PRINTC' TAB COUNTER
	SNA		/TEST FOR CR
	DCA I [ERROR	/RESET COUNTER
	SNA
	JMP CROUT
	TAD TAB-1	/CR-SP
	SMA		/NON-PRINTING CHARACTERS
	ISZ I [ERROR	/ADD 1 TO TAB COUNT (FIELD 1)
	I0N		/TURN ON AFTER AN ERROR
	TAD [SP
	JMP CROUT+3

ZER,	TASK
	SMA CLA		/INITIAL ENTRY POINT
	JMP POS
	TAD I XCHAR	/SAVE THE CURRENT CHARACTER
	DCA CHAR
NEG,	CDI P
	JMP SKPX	/SKIP OVER ONE (OR MORE)
	ISZ I [LORD
	JMP NEG
	TAD CHAR
	DCA I XCHAR	/RESTORE THE ORIGINAL ONE

POS,	CDI P
	TAD I [LORD	/FIND OUT WHERE WE'RE GOING
	STL CIA
	TAD I [ERROR	/SUBTRACT FROM WHERE WE ARE
	SNL CLA
	JMP I ZER	/FORGET IT...
	TAD [SP
	JMS CPRNT	/PRINT SPACES
	JMP POS

	*RMF
	0		/'PRINTC' FOR LISTING AND DATE
	CDI P
	JMS CPRNT
	JMP I RMF
/LOAD A HANDLER INTO THE PROPER SLOT: (ENTRY AT 'HANDLR')

NOTEQ,	ISZ SLOT	/BUMP POINTER TO SAVE NAME
	TAD NEWDEV	/MOVE NEW DEVICE NAME TO TABLE
	DCA I SLOT
	ISZ SLOT
	TAD NEWDEV+1
	DCA I SLOT
	ISZ SLOT
	GETMON		/NEED USR, MIGHT AS WELL LOCK IT IN

RETRY,	TAD NEWDEV	/MOVE DEVICE NAME FOR MONITOR CALL
	DCA DEVC
	TAD NEWDEV+1
	DCA DEVC+1
	TAD I SLOT	/MOVE LOAD POINT
	DCA DLOAD
	CIF 10
	JMS I USR	/CALL MONITOR (ALREADY IN CORE)
	1
DEVC,	0
	0		/DEVICE NO.
DLOAD,	0		/ENTRY POINT
	ERROR0		/DEVICE NOT AVAILABLE

	TAD DLOAD	/CHECK IF THE HANDLER HAS BEEN
	AND [7600	/LOADED INTO THE PROPER PAGE
	CMA		/'CIA' FOR 1-PAGE HANDLERS
	TAD I SLOT	/DESIRED PAGE
	SZA CLA
	TAD DLOAD	/WRONG PAGE!
	TAD [200	/IS IT THE SYSTEM HANDLER?
	SPA CLA		/IF .GT. 7600 WE'RE OK
	JMP NOGOOD	/SORRY, TRY IT AGAIN

	ISZ SLOT	/BUMP POINTER TO DEVICE #
	TAD DEVC+1	/SAVE IT
	DCA I SLOT
	ISZ SLOT	/MOVE TO ENTRY POINT
	TAD DLOAD
	DCA I SLOT	/SAVE ENTRY
	TAD DEVC+1
HANDX,	DCA TEMP	/DEVICE NO.
	JMP I HANDLR

NOGOOD,	DCA DLOAD	/CLEAR ENTRY POINT
	JMS SETDHT	/TELL USR THE HANDLER
	    DLOAD-2	/IS NOT IN CORE ANYMORE
	JMP RETRY	/LOAD IT THIS TIME
	*ECODEV
HANDLR,	0		/AC = BLOCK POINTER
	DCA SLOT
	SM2		/IF THE HANDLER HAS THE SAME NAME,
	COMPARE		/DON'T LOAD IT AGAIN
SLOT,	    0
	    NEWDEV-1
	JMP NOTEQ	/DIFFERENT NAMES, LOAD NEW HANDLER
	ISZ AUTO 2	/BUMP PAST LOAD POINT
	TAD AUTO 2	/(SET BY 'COMPARE')
	DCA .+2
	JMS SETDHT	/IN CASE USR RESET THE TABLE
	0
	TAD I AUTO 2
	JMP HANDX	/SAVE THE DEVICE NO.

TTYDEV,	DEVICE TTY	/FOR COMPARISON PURPOSES

	*EOF
SETDHT,	0		/SET THE DEVICE HANDLER TABLE
	TAD I SETDHT	/  (TO FAKE OUT THE USR)
	DCA PDLXR	/POINTER TO DEVICE # AND ENTRY
	TAD (17646	/TABLE LOCATION
	TAD I PDLXR	/PLUS DEVICE NUMBER
	DCA DEVC	/POINTS TO 'HANDLER-IN-CORE' FLAG
	TAD I PDLXR
	CDF 10
	DCA I DEVC	/FLAG IS SIMPLY HANDLER ENTRY
	CDF L
	ISZ SETDHT
	JMP I SETDHT	/ALSO CALLED BY 'CLOSER'

/CHARACTER TABLE FOR LOWER-FIELD COMMANDS:

KOMLST,	CR-200		/RETURN
	";-200		/DITTO
	"Z		/ZERO
	"N		/NAME
	"G		/GOSUB
	"P		/P???
FILIST,	"L		/LIST
	"A		/ALL OR ABORT
	"C		/CALL OR CLOSE
	"D		/DATE OR DELETE
	"B		/BR. OR BUFFER
	"E		/EXIT OR EVERY
ORLIST,	"S		/SAVE OR SECOND
	"R		/RUN OR RESTORE
	"I		/INPUT OR INITIAL
	"O		/OUTPUT OR ONLY

	PAGE 32
/LIBRARY COMMANDS: SAVER, DELETR, CALLER, RUNNER, GOSUB

	*FPNT		/ENTER VIA 'JMP I 7'

LCMND,	JMS SCANER	/SAVE CHAR AND MOVE TO THE NEXT
	TAD (603	/SET '.FC'
	DCA EXTENSION
	DCA GOSW	/POINT TO 'PROC'
	LJUMP		/BRANCH TO THE APPROPRIATE ROUTINE
	    KOMLST-1
	    KOMGO-KOMLST
	ERROR1		/SORRY, TRY AGAIN

SCANER,	(CALL		/COMMAND WORD SCANNER
	CDI P
	TAD I XCHAR	/SAVE CURRENT CHARACTER
	DCA CHAR
	JMS LSORT	/SCAN TO THE END
	JMP I SCANER

SAVER,	GTNAME		/'LIBRARY SAVE' COMMAND
	JMS TEMP	/FILL IN THE HEADER
	JMS SAVE	/DO IT
	JMP EXIT	/DONE

DELETR,	JMS I CL0SE	/'LIBRARY DELETE' COMMAND
	GTNAME
	TAD LBUFR	/'LIBBLK-1'
	GETHND
	JMS LCLOSE
	JMP EXIT-2

LCLOSE,	(OPENUP		/SAVE OR DELETE A FILE
	DCA SAVBLK
	TAD DEVNO
	CIF 10
	JMS I USR
	4
	NAMLOC
SAVBLK,	(20
	ERROR0		/NOT THERE
	JMP I LCLOSE

FOCLTM,	FILENAME FOCAL.TM
GOSUB,	LPUSHF		/'LIBRARY GOSUB' COMMAND
	    FOCLTM
	LPOPF		/MOVE 'FOCAL.TM' TO NAME AREA
	    NAMLOC-1
	TAD DSK		/IN CASE WE NEED TO SAVE IT
	DCA NEWDEV
	DCA NEWDEV+1
	TAD LIBFLG	/ARE WE ALREADY SAVED?
	SNA CLA
	JMS SAVE	/NO
	TAD (603
	DCA EXTENSION	/RESET EXTENSION TO 'FC'

/LOOKUP AND LOAD ROUTINES:

SUBBER,	SM3		/THESE ALL DO THE SAME THING AND
RUNNER,	CLL IAC		/THEN BRANCH TO DIFFERENT PLACES
CALLER,	CLL IAC		/LOAD HAS 5 POSSIBLE EXITS !
	JMS I [OPEN	/CALL THE HANDLER AND LOCATE FILE
LBUFR,	    LIBBLK-1	/= 'BUFR' TOO
LIB3,	3		/NOT THERE, NO NAME, OR
	ERROR1		/SOMETHING JUST AS STUPID

	JMS I (DEVCHK	/FILE STRUCTURED?
	TAD GOSW	/CHECK FOR GOSUB
	SPA CLA
	LPUSHF		/SAVE CURRENT PROGRAM INFO.
	    LIBDEV
	JMP LOADGO	/'JMP I (LCHECK+2' FOR 8K

GOBACK,	LPOPF		/RESTORE CALLING PROGRAM POINTERS
	    NEWDEV-1
	TAD LBUFR
	GETHND		/GET THE HANDLER BACK

LOADGO,	JMS LOADER	/READ THE PROGRAM
	CDF T		/'CDI T' FOR INITIAL DIALOG
	TAD I D		/CHECK PROGRAM I.D.
	SZA CLA
/	JMP I D		/ENTER SPECIAL PROGRAM
INITIAL,ERROR1		/(NONE RIGHT NOW)
	TAD I [200	/MOVE PROGRAM LENGTH
	CDF P
	DCA I LBUFR
	CDI L		/RETURN TO:
	JMP EXIT-1	/PROC, START, GOTO, OR DO
SAVE,	0		/CALLED BY 'SAVER' AND 'GOSUB'
	JMS I CL0SE	/AVOID TROUBLE
	CDF P
	TAD I LBUFR	/GET PROGRAM LENGTH
	CDF T
	DCA I [200	/SAVE IT WITH THE PROGRAM
LSHFT,	SM1
	TAD I [200	/COMPUTE FILE SIZE
	CDF L
	AND [7600	/MASK PAGE COUNT
	JMS I LSHFT	/SHIFT IT
	IAC		/ROUND UP TO BLOCKS
	CLL RAR
	DCA FLNGTH	/SAVE
	GETMON		/CALL THE MONITOR
	TAD LBUFR
	GETHND		/GET THE HANDLER
	JMS I (DEVCHK	/CHECK FOR STUPIDITY
	TAD LIB3
	DCA I (CALL	/SET UP OUR SUBROUTINE
	JMS I (OPENUP
	ERROR1		/NO ROOM OR WRITE-LOCKED
	TAD FLNGTH
	JMS LCLOSE	/UPDATE DIRECTORY IN ADVANCE!
	TAD (20		/SET THE 'WRITE' BIT
	JMS LOADER	/SAVE THE PROGRAM
	JMP I SAVE
/////
LOADER,	0		/READ (OR WRITE) A PROGRAM
	TAD FLNGTH	/COMPUTE FUNCTION WORD
	JMS I LSHFT	/'SHFTL6'
	STL RAL		/SET TO SEARCH FORWARD
IFNZRO	T  < TAD (T >	/ADD FIELD BITS (12K)
	DCA .+4
	TAD STBLK
	DCA .+4
	JMS I LIBHND	/GET THE PROGRAM
	0
	200		/LOADS FROM 200 UP
	0		/STARTING BLOCK NO.
	JMP I [DERR
	DISMISS		/SO WE CAN USE THE STACK
	LPUSHF
	    NEWDEV	/SAVE NEW POINTERS
	LPOPF
	    LIBDEV-1	/IN CASE WE 'GOSUB'
	JMP I LOADER

	PAGE
/THE 'OUTPUT DATE' COMMAND

DATER,	TAD [NODATE-1
	DCA AUTO
	TAD [-4
	DCA GOSW
	CDF T
	TAD I AUTO	/GET DATE
	JMS I ZEROER-1	/OUTPUT IT
	ISZ GOSW
	JMP .-4
	JMP EXIT	/RETURN
/////

DEVCHK,	0		/CHECK THE DEVICE TYPE
	TAD DEVNO
	TAD P17757
	DCA JUMPER
	CDF 10
	TAD I JUMPER
	CDF L
	SMA CLA
	ERROR1		/DEVICE IS NOT FILE STRUCTURED
	JMP I DEVCHK
P17757,	17757		/DEVICE CONTROL WORD TABLE
/////

JUMPER,	0		/SORT AND BRANCH SUBROUTINE
	JMS I IOWAIT	/CLEAR AC, RESET DF, TURN IOF
	TAD I JUMPER	/GET LIST ADDRESS
	ISZ JUMPER
	DCA AUTO
	TAD I AUTO
	SPA		/END OF LIST ?
	JMP ERR
	STL CIA
	TAD CHAR
	SZA CLA		/FOUND IT ?
	JMP .-6		/NO
	TAD AUTO
	TAD I JUMPER	/ADD OFFSET
	DCA JUMPER
	TAD I JUMPER	/POINT TO ENTRY
	DCA JUMPER
ERR,	CLA CLL		/FALL THROUGH OFFSET
	JMP I JUMPER	/L=0
/////
/LIBRARY COMMAND LIST:

KOMGO,	GOBACK		/CR
	GOBACK		/;
	ZEROER		/Z
	NAMER		/N
	GOSUB		/G
	SCANER-1	/P
	LLIST		/L
	LISTAL		/A
	CALLER		/C
	DELETR		/D
	BRANCH		/B
	7600		/E
	SAVER		/S
	RUNNER		/R
	INITIAL		/I

/FILE COMMAND LIST

FILEGO,	LIST1		/O,L
	ABORT		/A
	CLOSE		/C
	DATER		/D
	DUMPER		/B
	ECOSET		/E
	SINPUT		/S
	RESTOR		/R
	INPUT		/I
	OUTPUT		/O

/RESTORE COMMAND LIST

ORGO,	SRST		/S
	RERD		/R
	IRST		/I
	ORST		/O

/THE 'LOGICAL BRANCH' COMMAND ALLOWS PROGRAMS TO TEST THE
/TELETYPE WITHOUT READING A CHARACTER.  THE BRANCH OCCURS
/IF THERE IS -NO- INPUT:  1.1 T PI;L B .1;C A KEY WAS HIT
/'FIN()' MAY THEN BE USED TO READ AND TEST THE CHARACTER.

/THIS HAS NOW BEEN REPLACED BY THE 'JUMP' COMMAND  (V4D).

BRANCH,	CDI P		/'LOGICAL BRANCH' COMMAND
	I0N
	JMP I .+1	/USES THE 'JUMP' COMMAND!
	PACLST+3
/////
ONMTMP,	ZBLOCK 4	/SAVED FILE NAME
/THE 'OUTPUT EVERYTHING' COMMAND SWITCHES TO A DIFFERENT
/INTERNAL HANDLER FOR ALL OUTPUT, INCLUDING THE ECHO AND
/ERRORS; THIS DEVICE IS RESTORED FOLLOWING AN 'O C' OR
/'O A' COMMAND.  THE HANDLER MAY ALSO BE CALLED BY 'O O'

ECOSET,	GTNAME		/THE 'O E' COMMAND
	JMS I INTCHK	/WAS IT 'O E LPT:'?
	TAD [XOUTL	/NO, EVERYTHING ELSE = 'TTY:'
	JMP OSCOPE+1	/SAVE ENTRY POINT

	ZBLOCK 1	/PATCHED BY LAB OVERLAY
OSCOPE,	TAD .-1		/THE 'O S' COMMAND
	CDF P
	DCA I [ECODEV	/AFFECTS BOTH 'OCHAR' AND 'EOF'
	TAD I [ECODEV
	JMP I .+1	/INSERT ENTRY PT. INTO 'OUTDEV'
	TTYOUT+1
/////

INTCHK,	LPTCHK		/CHECK FOR INTERNAL HANDLERS
	INTRNL+1	/RETURN POINT
	JMS I INTCHK	/CHECK FOR 'LPT:'
	SKP		/TRY AGAIN
	JMP I INTCHK-1	/PUT ENTRY POINT INTO 'OUTDEV'
	SM2
	COMPARE		/CHECK FOR 'PLTR'
	    PLTDEV
	    NEWDEV-1
	JMP I INTCHK+1	/NEITHER OF THESE
	TAD I .-3
	JMP I INTCHK-1	/MOVE THE ENTRY POINT
//////

LZERO,	HANDLR-3	/THE 'LIBRARY ZERO' COMMAND
	SM1		/DANGEROUS - BUT USEFUL!
	DCA I FILCNT	/RESET THE FILE COUNT
	DCA I [HANDLR-2	/CLEAR THE LINK WORD
	DCA I AUTO	/CREATE AN 'EMPTY' WITH
	TAD FLNGTH	/  THE SPECIFIED LENGTH
	SNA		/IF NO LENGTH, PROBABLY
	ERROR1		/DIDN'T WANT TO DO THIS!
LZXIT,	CIA
	TAD I LZERO	/SUBTRACT SYSTEM BLOCKS
	DCA I AUTO
	JMS I LIBHND	/PUT IT BACK
	4200
FILCNT,	HANDLR-4
	1
	JMP I [DERR	/OH DEAR!
	JMP I LZXIT	/RESTORE THINGS AND EXIT
/////
/THE 'LIBRARY LIST' COMMAND SHOWS ONLY FILES WITH ONE EX-
/TENSION. 'LIST ALL' SHOWS EVERYTHING, 'LIST ONLY' JUST 1.
	LIBBLK-1
LLIST,	CMA CLL RTR	/'LIBRARY LIST' COMMAND
LIST1,	CMA STL RAL	/'LIST ONLY' / 'ONLY LIST'
LISTAL,	DCA I [OPEN	/'LIST ALL' COMMAND
	SM3		/CLEAR THE 'L Z' SWITCH
ZEROER,	DCA 0		/'LIBRARY ZERO' COMMAND
	DCA GOSW	/= NO EMPTIES
	GTNAME		/GET DEVICE TO LIST
	TAD LLIST-1
	GETHND		/GET THE HANDLER
	JMS DEVCHK	/CHECK DEVICE TYPE
	DISMISS		/REMOVE THE USR
	JMS I [7607	/SWAP OUT CORE TO MAKE ROOM
	4200		/FOR DIRECTORY
	HANDLR-4
	40		/SYSTEM SCRATCH AREA
	JMP I [DERR	/WHOOPS!
	DCA I SWAP	/SET THE FLAG TO SWAP BACK IN
	IAC		/DIRECTORY BEGINS WITH BLOCK 1
BLOKLP,	DCA LBLOCK
	JMS I LIBHND
	0200
	HANDLR-4	/POSITIONED FOR OUR CONVENIENCE!
LBLOCK,	1
	JMP I [DERR
	TAD [HANDLR	/FIRST 5 WORDS ARE INFORMATION
	DCA AUTO
	TAD 0		/CHECK FOR 'L Z'
	SNA CLA
	JMP I (LZERO+1	/OR 'EMPTY-2' TO DISABLE 'L Z'
LOOP2,	TAD AUTO	/SAVE NAME POINTER FOR PRINTING
	DCA LIBX
	TAD I AUTO
	SNA CLA
	JMP EMPTY	/CHECK IF WE SHOULD LIST EMPTIES
	ISZ AUTO
	ISZ AUTO
	TAD I AUTO	/PICK UP EXTENSION
	DCA LBLOCK
	TAD I [HANDLR	/WASTE WORDS (NEGATIVE)
	CIA
	TAD AUTO	/SKIP TO LENGTH
	DCA AUTO
	TAD I AUTO	/ZERO LENGTH MEANS TEMPORARY FILE
	*CIA
	SNA		/LZERO RETURN
	JMP LOOP3	/IGNORE SUCH THINGS
	DCA FLNGTH
	TAD NAMLOC	/WAS A NAME GIVEN ?
	SNA CLA
	JMP CKEXTN	/NO
	TAD EXTENSION	/CHECK THIS TOO?
	SNA CLA
	IAC		/NO, ONLY CHECK THE NAME
	TAD [-4
	COMPARE		/COMPARE THIS NAME WITH ARG
LIBX,	    AUTO-1
	    NAMLOC-1
	JMP LOOP3	/NON-MATCHING
	ISZ I [OPEN	/TEST FOR ONLY ONE
	TAD EXTENSION	/OR A NULL EXTENSION
	SZA CLA
	DCA NAMLOC	/DON'T CHECK ANY MORE
	JMP DIRLST

CKEXTN,	TAD EXTENSION	/DO WE WANT THIS ONE?
	CIA
	TAD LBLOCK
	SZA CLA
	TAD I [OPEN	/TEST FOR 'ALL'
	SPA CLA
	JMP LOOP3	/GUESS NOT
DIRLST,	SM3		/PRINT 3 WORDS
	DCA TEMP
	ISZ LIBX
	TAD I LIBX
	JMS I DIRLST	/PRINT 2 CHARS
	ISZ TEMP
	JMP .-4
	TAD DOT
	JMS I PRNTC
	TAD LBLOCK	/PRINT EXTENSION
	JMS I DIRLST
	TAD NPRNT+2	/SET UP FOR DECIMAL LENGTH PRINT
	DCA NEWDEV
NLOOP,	DCA NEWDEV+1	/INITIALIZE LEADING-ZERO FLAG
	DCA SHFTL6	/CLEAR QUOTIENT

	TAD I NEWDEV	/FINISHED ALL POWERS OF 10?
	SNA
	JMP LOOP3-2	/YES, ALL DONE
	TAD FLNGTH	/NO, ADD THIS POWER
	SMA SZA		/OVERFLOW?
	JMP DIDJET	/YES, PRINT THIS DIGIT
	DCA FLNGTH	/NO, GO THROUGH THE LOOP AGAIN
	ISZ SHFTL6	/ADD ONE TO THIS DIGIT
	JMP NLOOP+2	/ANOTHER DIVIDE CYCLE

	TAD [CR		/DONE WITH THIS LINE (WHEW!)
	JMS I PRNTC
LOOP3,	ISZ I LBLOCK-1	/DONE WITH THIS BLOCK?
	JMP LOOP2	/NO, KEEP GOING
	JMS I IOWAIT	/WAIT FOR I/O
	TAD I [HANDLR-2	/LINK TO NEXT BLOCK
	SZA		/LAST BLOCK?
	JMP BLOKLP	/NO, GET THE NEXT
	JMS I SWAP	/YES, RESTORE SWAPPED CORE
	JMP EXIT	/(JMS RESETS THE FLAG)
/MANY THANKS TO STEVE L. GILLETT FOR FIGURING OUT
/HOW TO MAKE ROOM FOR THE 'LIST EMPTIES' OPTION!!

EMPTY,	TAD I AUTO	/LIST THE EMPTIES!
	DCA FLNGTH	/GET THE LENGTH
	TAD GOSW	/ARE WE SUPPOSED TO?
	SMA SZA CLA	/',E' TESTED BY 'GTNAME'
	JMP NLOOP-3	/YES, INDENT SLIGHTLY
	JMP LOOP3	/FORGET IT

DIDJET,	CLA CLL		/CLEAN UP THE AC
	ISZ NEWDEV	/NEXT POWER OF TEN
	TAD SHFTL6	/IF THIS DIGIT IS ZERO, AND NO
	ISZ NEWDEV+1	/OTHER DIGITS HAVE BEEN NON-ZERO,
	SZA		/PRINT A SPACE INSTEAD
	JMP NPRNT
	TAD [SP
	JMS I PRNTC
	JMP NLOOP

NPRNT,	TAD ["0		/CHANGE TO ASCII
	JMS I PRNTC
	CMA STL		/SET ZERO SWITCH
	JMP NLOOP

DECIMAL;*CMA STL	/TRICKY, HUH?
	1000
	 100
	  10
	   1
OCTAL;	*SM1		/MORE TRICKS!

SHFTL6,	0		/CLEVER USE TERMINATES TABLE
	CLL RTL
	RTL
	RTL
	JMP I SHFTL6	/CONSIDER 'BSW' FOR THE 8/E

NAMLST,	"<		/BLOCK
	":		/DEVICE
	"(		/VARIABLE DATA
DOT,	".		/EXTENSION
	"[		/SIZE
	",		/ECHO

	PAGE 35
/ROUTINE TO ENTER OR FIND A FILE FOR 'O O', 'O I' & 'LIB'

OPEN,	0		/LOOKUP AND ENTER ROUTINE
	DCA GOSW	/SET ECHO/LOAD SWITCH
	IAC
	RAL		/SET CALL CODE (2 OR 3)
	DCA CALL
	GTNAME		/GET DEVICE AND FILENAME

	TAD MDSK	/CALLING SEQUENCE:
	TAD NEWDEV	/	AC=GOSW, L=1 FOR ENTER
	SNA		/	JMS I [OPEN
	TAD NAMLOC	/	    HANDLER BLOCK (-1)
	SNA CLA		/	ERROR RETURN
	JMP SHUT+1	/	'TTY' RETURN
	SM2		/	REGULAR RETURN
	COMPAR		/CHECK FOR CALLS TO 'TTY:'
	    TTYDEV-1	/'TTY:' IS ALSO THE DEFAULT
TLSW,	    NEWDEV-1	/WHEN NO OTHER NAME IS FOUND
	JMP I INTRNL	/CHECK FOR OTHER INTERNAL DEV.
	JMP SHUT+1	/'TTY:'
INTRNL,	INTCHK+2	/'.+1' FOR 8K

	TAD I OPEN	/GET HANDLER BLOCK TO USE
	GETHND		/LOAD THE HANDLER
	TAD NAMLOC	/CHECK FOR A DIRECT ACCESS CALL
SHFT,	CMA STL RAL	/POINTS TO 'SHFTL6'
	TAD CALL	/'NAMLOC'=1, 'CALL'=2 (ONLY)
	SNA
	ERROR1		/CANNOT USE '<>' WITH 'OPEN OUTPUT'
	IAC
	SNA CLA
	JMP SHUT-1	/OK: 'STBLK' & 'FLNGTH' ARE SET

	JMS OPENUP	/DO WHAT WE CAME FOR
	JMP SHUT+2	/ERROR RETURN
	TAD CALL+2
	CIA
	DCA FLNGTH	/SAVE POSITIVE LENGTH
	ISZ OPEN
SHUT,	DISMISS		/REMOVE THE USR
	ISZ OPEN
	ISZ OPEN
	JMP I OPEN	/NORMAL RETURN
/////

USRIN,	0		/LOCK THE USR IN CORE - 'GETMON'
	I0F
	CIF 10
	JMS I USR
	10
	TAD [200
	DCA USR
	JMP I USRIN
OPENUP,	0		/CALLED BY 'SAVE' AND 'OPEN'
	TAD XNAME
	DCA CALL+1	/INITIALIZE USR CALL
	TAD FLNGTH	/REQUESTED SIZE FROM 'GTNAME'
	CLL RTL
	RTL
	AND O7760	/SIZE
	TAD TEMP	/DEVICE NO.
	CIF 10
	JMS I USR	/'ENTER' OR 'FETCH'
CALL,	0
	NAMLOC		/BECOMES THE BLOCK NO.
	0		/ AND THE FILE LENGTH
O7760,	SNL SMA SZA CLA	/ERROR RETURN
	ISZ OPENUP
	TAD CALL+1	/SAVE STARTING BLOCK
	DCA STBLK
	JMP I OPENUP

	*CLA CLL IAC
SWAPIN,	NOP		/RESTORE CORE AFTER DIRECTORY LIST
	JMS I [7607	/SYSTEM HANDLER
	200
	HANDLR-4
	40
DERR,	ERROR1		/DEVICE ERROR = 'CLA CLL RTL'
	JMP I SWAPIN

USROUT,	0		/REMOVE THE USR - 'DISMISS'
	SM0
	TAD USR		/CHECK POINTER TO FIND OUT
	SMA CLA
	JMP I USROUT	/ALREADY GONE
	TAD .-2		/RESET THE POINTER
	DCA USR
	I0F
	CIF 10
	JMS I [200
	11
	JMP I USROUT

	*SP1
IOWATE,	0		/WAIT FOR TELETYPE TO FINISH
	CDF P
	I0N
	TAD I TLSW
	SZA CLA
	JMP .-3
	I0F
	CDF L
	JMP I IOWATE	/THEN TURN THE INTERRUPT OFF

MDSK,	-5723
XFORM,	0
	AND K77
	SMA SZA
	TAD [240
	AND K77
	TAD [240
	JMS I PRNTC
	JMP I XFORM

	*SM3
NPACK,	0		/STANDARD 6-BIT UNPACK ROUTINE
	DCA CMPR
	TAD CMPR
	JMS I SHFT	/'BSW'
	RAL
	JMS XFORM
	TAD CMPR
	JMS XFORM
	JMP I NPACK	/CALLED BY 'DIRLST' & 'DATER'

CMPR,	0		/COMPARE TWO BLOCKS OF ANY LENGTH
	DCA XFORM	/CALLING SEQUENCE:
	TAD I CMPR	/    AC= -# OF WORDS
	ISZ CMPR	/    COMPARE
	DCA AUTO 2	/	FIRST-1
	TAD I CMPR	/	SECOND-1
	ISZ CMPR	/    RETURN IF NO MATCH
	DCA AUTO 3	/    RETURN IF MATCH
	TAD I AUTO 2	/COMPARE TWO WORDS
	CIA
	TAD I AUTO 3
	SZA CLA
	JMP I CMPR	/NO MATCH
	ISZ XFORM	/DONE ?
	JMP .-6		/NO, CHECK TWO MORE
	ISZ CMPR	/YES, BUMP RETURN POINTER
	JMP I CMPR
/////
	PAGE 36
/READ A DEV:FILENAME.EX STRING INTO 'NAMLOC' & 'NEWDEV'

NAME,	0
	SM1		/POINTER TO 'SHFTL6'
	DCA AUTO 1	/PERIOD COUNTER
	DCA MGETA	/DIGIT COUNTER
	TAD DSK
	DCA NEWDEV
DEVNAM,	DCA NEWDEV+1
	DCA NAMLOC	/CLEAR NAME AREA
	DCA NAMLOC+1
	DCA NAMLOC+2	/BUT NOT THE EXTENSION!
	TAD XNAME
	DCA STBLK
	DCA AUTO 2	/CHAR. COUNTER
	DCA FLNGTH
NAMLUP,	JMS MGETC	/'SM1' SETS L=1
	LJUMP		/'LJUMP' CLEARS IT
	    NAMLST-1	/TRAP '< : ( . [ ,'
	    NAMGO-NAMLST
PLUS10,	"9-"0+1		/'NOP'

	TAD CHAR	/CHECK FOR A-Z, 0-9
	TAD MINUS9
	CLL
	TAD PLUS10
	SZL
	JMP .+4		/OK
	TAD K7760	/"0-"@ = -20
	STL
	TAD ("@-"Z-1
	SNL CLA
	JMP NAMEND	/ILLEGAL CHARACTER

	TAD AUTO 2
	TAD (-5
K7760,	SNL SMA SZA CLA	/TOO MANY?
	JMP IGNORE
	TAD AUTO 2
	CLL RAR
	TAD STBLK
	DCA MGETC	/NAME POINTER
	ISZ AUTO 2
	TAD CHAR
	AND K77
	SNL
	JMS I NAME+1	/'SHFTL6'
	CDF L
	TAD I MGETC
	DCA I MGETC
NXTNUM,	CDF P
	TAD I PDLXR	/MAY BE GARBAGE
	TAD ["0
	DCA CHAR
IGNORE,	ISZ MGETA
	TAD MGETA
	SPA SNA CLA	/END OF THE STRING?
	JMP NAMLUP+1
	TAD I XCHAR	/YES, IS THERE MORE?
	TAD MCOMMA
	CLL
	SZA CLA		/CHECK FOR A COMMA
	JMP NAMLUP

	*-"E
VARBL,	JMS MGETA	/PROCESS A VARIABLE FILE NAME
	CLL CIA
	DCA CHAR	/ASSUME ITS A LETTER
	TAD I H0RD	/NOW CHECK THE SIGN
	SPA
	JMP VLETR	/IT WAS, USE -1 AS THE COUNT
	CDI P
	JMP VFN		/CONVERT POS. NUM. TO ASCII

BLKNUM,	JMS MGETA	/READ THE BLOCK NUMBER
	ISZ NAMLOC	/SET THE BLOCK FLAG
	JMP NAMLUP-3

	*-"9-1
COLON,	TAD NAMLOC	/MOVE NAME TO 'NEWDEV'
	DCA NEWDEV
	TAD NAMLOC+1
	JMP DEVNAM

MGETC,	0		/CROSS-FIELD CALL
	CDI P
	JMP LGETC	/L=1 TO SKIP 'GETC'
	DCA CHAR
	JMP I MGETC

	*SNL SMA-1
	JMP I .+1	/TRY TO FIGURE THIS OUT!
MGETA,	0		/EVALUATE AN EXPRESSION
	JMS MGETC	/SKIP THE DELIMITER
	CDI P
	JMP GETA	/CALL 'EVAL'

	*-",
PERIOD,	ISZ AUTO 1	/DOUBLE PERIODS?
	JMP NAMEND	/APPARENTLY
	DCA EXTENSION	/CLEAR OUT THE ASSUMED ONE
	ISZ STBLK	/ADVANCE STORAGE POINTER
	TAD (4		/ALLOW FOR TWO MORE CHARACTERS
	JMP NAMLUP-2
NAMGO,	BLKNUM		/BLOCK
MINUS9,	COLON		/DEVICE
MINUSE,	VARBL		/LETTERS & NUMBERS
MCOMMA,	PERIOD		/EXTENSION
	SQBRKT		/SIZE
	ECHCHK		/ECHO

	*SMA SZA
SQBRKT,	JMS MGETA	/READ REQUESTED FILE SIZE
	JMP NAMLUP-1

VFR,	DCA PDLXR	/SAVE STARTING ADDRESS
	TAD I (T3
	SPA SNA		/CHECK DECIMAL EXPONENT
	CLA IAC		/FORCE 1 IF .LE. ZERO
	STL CIA
VLETR,	DCA MGETA	/EXPONENT=NUMBER OF DIGITS
	SNL
	JMP IGNORE	/LETTERS
	JMP NXTNUM	/NUMBERS

ECHCHK,	TAD [SP		/REPLACE THE COMMA WITH A SPACE
	SKP
	ISZ GOSW	/CLEAR THE SWITCH & REMOVE THE 'E'
	CDF P
	DCA I XCHAR
	JMS I (SCANER	/SKIP TO THE 'ECHO' OR LINE NO.
	TAD I XCHAR
	TAD MINUSE	/DOES IT BEGIN WITH AN 'E'?
	SNA CLA
	JMP ECHCHK+2	/YES, MARK IT AND CONTINUE

NAMEND,	CDI P		/EVALUATE THE LINE NUMBER
	JMP GETL
	JMS I IOWAIT	/AND WAIT FOR THE TERMINAL
	JMP I NAME	/***RETURN***

NAMER,	GTNAME		/'LIBRARY NAME' COMMAND
	JMP IOWAIT+1	/JUST UPDATES THE HEADER

	PAGE 37
/PAGE ZERO (FIELD 0) LITERALS:

LPUSHF=	JMS I [MPUSHF
LPOPF=	JMS I [MPOPF
LJUMP=	JMS I [JUMPER
COMPAR=	JMS I [CMPR
GTNAME=	JMS I [NAME
GETHND=	JMS I [HANDLR
GETMON=	JMS I [USRIN
DISMIS=	JMS I [USROUT

	FIELD 0
/READ AND STORE THE OS/8 DATE WORD:

	FIELD 2

	*14
NODATE,	TEXT "NO/DA/TE"	/BECOMES THE CURRENT DATE

	*20
NUHEAD,	0		/MOVE THE NAME UP FROM FIELD L
	TAD I .+2
	DCA NUHEAD
	TEMP
	TAD .+2
	DCA PDLXR
	NAMLOC-1
	TAD .+2
	DCA AUTO
	TITLE-1
	SM3
	DCA DATUM

	CDF L
	TAD I PDLXR
	CDF T
	DCA I AUTO
	ISZ DATUM
	JMP .-5

	DCA I AUTO	/CLEAR THE I.D.

	TAD NODATE+0	/MOVE THE DATE INTO PLACE
	DCA I AUTO
	TAD NODATE+1
	DCA I AUTO
	TAD NODATE+2
	DCA I AUTO
	TAD NODATE+3
	DCA I AUTO
	CDI L
	JMP I NUHEAD

DAY,	SZA		/ZERO = READ CURRENT DATE
	JMP NIGHT	/NON-ZERO = SET NEW DATE
	TAD I (17666
	JMP NIGHT+2

NIGHT,	DCA I (17666
	JMS DATUM
	CDI P
	JMP I .+1	/'FL0ATR'
	FL0AT
PACK1,	0		/HALF-WORD PACK ROUTINE
	TAD (60		/ADD OFFSET
	AND (77
	ISZ (-1		/TEST THE SWITCH
	JMP PACK0
	CLL RTL
	RTL
	RTL
	DCA PDLXR	/SAVE LEFT HALF
	JMP I PACK1

	*0
PACK0,	TAD PDLXR	/MERGE THE PIECES
	CDF T
	DCA I AUTO
	CDF 10
	SM1
	DCA (-1		/RESET THE SWITCH
	JMP I PACK1

	*7
	600		/EXTENDED DATE MASK
	ZBLOCK 4	/INDICATE USAGE

	*104		/LEAVE ROOM FOR 'PC0'
PACK2,	0
	DCA AUTO 2	/SAVE DIGITS
	DCA AUTO 1	/CLEAR QUOT.
	JMP .+3
	ISZ AUTO 1	/DIVIDE BY TEN
	DCA AUTO 2
	TAD AUTO 2
	TAD (-12
	SMA
	JMP .-5

	CLA		/CLEAR OVERDRAW
	TAD AUTO 1	/FIRST DIGIT
	JMS PACK1
	TAD AUTO 2	/SECOND DIGIT
	JMS PACK1
	SM2		/"0"-2="."
	JMS PACK1
	JMP I PACK2
/ROUTINE TO UNPACK THE DATE - USED BY 'FDAY'

DATA,	0		/CALLED FROM 'INITLZ'
	JMS DATUM
	CDI L
	JMP I DATA

DATUM,	0		/UNPACK THE DATE WORD
	SM1
	DCA (-1		/INITIALIZE
	TAD (NODATE-1
	DCA AUTO
	CDF 10
	TAD I (17666
	SNA
	JMP I DATUM	/SKIP NULL DATE
	RTR
	AND (77
	CLL RAR
	JMS PACK2	/DAY
	TAD I (17666
	RTL
	RTL
	AND K7
	RAL
	JMS PACK2	/MONTH
	TAD I (17666
	AND K7
	DCA PDLXR
	CDF 0
	TAD I (7777	/WILL BE -1!
K7,	AND 7
	CLL RTR
	RTR
	TAD (106	/1970
	TAD PDLXR
	JMS PACK2	/YEAR
	JMP I DATUM

	FIELD 2
	$
