/FOCAL OS/8 LIBRARY ROUTINES

	FIELD 0
TPUSHF=	JMS I [MPD2	/DEFINE SOME NEW INSTRUCTIONS
TPOPF=	JMS I [MPD3
TGETC=	JMS I [MGETC
TSPNOR=	JMS I [MSPNOR
TJUMP=	JMS I [JUMPER
GETHND=	JMS I [HANDLR
GTNAME=	JMS I [NAME
GETMON=	JMS I [USRIN
DISMIS=	JMS I [USROUT
WAITUP=	JMS I [IOWAIT
COMPAR=	JMS I [CMPR
OPENUP=	JMS I [OPEN

	*1		/INTERRUPT SERVICE ROUTINE
	CIF 10
	JMP I .+1
	INTRPT
	RMF		/RETURN FROM INTERRUPT
	ION
	JMP I 0

USR,	7700	//POINTER TO MONITOR (200 IF IN CORE)

AUTO,	ZBLOCK 4	/AUTO-INDEX REGISTERS

NUDATE,	ZBLOCK 4	/BECOMES THE CURRENT DATE

NONAME,	TPOPF		/CLEAR PROGRAM NAME
XNAME,	    NAMLOC
	IAC
	DCA GOSW	/SET RETURN
	JMS HEADER	/UPDATE HEADER - THEN CLEAR
	DCA LIBFIL	/'CURRENT PROGRAM SAVED' FLAG
	TAD GOSW	/RETURN FOR LOAD CALLS
EXIT,	TAD GOJUMP	/NORMAL RETURNS='JMP I (PROC'
	DCA ATEM
	CDI 10
	ION

ATEM=.
HEADER,	0
	TPUSHF
XCHAR,	    NAMLOC	/STRATEGICALLY LOCATED !
	TPOPF		/MOVE PROGRAM NAME
	    TITLE
	DCA I D		/CLEAR I.D.
	TPUSHF
	    NUDATE
	TPOPF		/MOVE CURRENT DATE
DIALOG,	    DATE
	JMP I HEADER
D,	DATE-1
GOJUMP,	JMP I .+2	/PLUS (GOSW)
	LGOSUB
	PROC
K177,	UPDATE		/BECOMES 'START'
K604,	GOTO+1

NEWDEV,	ZBLOCK 4
FLNGTH=	.-2
STBLK=	.-1		/LIBBLK-1 = INBUF

LIBBLK,	ZBLOCK 2	/FOR DEVICE NAME
K7400,	7400		/LOAD POINT
	0		/FOR DEVICE #
LIBHND,	0		/HANDLER ENTRY

CHR,	0		/LOWER FIELD COPY

	*CHAR		/SAVE A WORD OR TWO!
NAMLOC,	ZBLOCK 4
EXTENSION=.-1
DEVNO,	0
DEVHLD,	0

LIBDEV,	ZBLOCK 4
LIBLEN=	.-2
LIBFIL=	.-1		/REFERENCE VIA P77

	*100
PC0,	ZBLOCK 2	/FOR COMMAND MODE VIA C100
	DISMISS		/CONVENIENT FOR RESTARTING
	IAC
	JMP EXIT

ERROR1=	JMS .
GOSW,	0		/LOWER FIELD ERROR ROUTINE
	DISMISS		/CLEARS AC
	TAD GOSW
	CDI 10
	DCA I [ERR2
	JMP I .+1	/SIMULATE A 'JMS'
	ERR2+1

INBLK,	ZBLOCK 2
	5000
	0
INHND,	0
INFLG,	0

OUTBLK,	ZBLOCK 2
	5200
	0
OUTHND,	0
OUTFLG,	0
/LIBRARY AND FILE COMMAND PROCESSOR:


	/****** STORAGE ALLOCATION MAP ******
	/*****				*****
	/*	3600	(OUTPUT,RESTORE,CLOSE,ABORT)
	/*	4000	INPUT BUFFER (PAGE 1)
	/*	4200	INPUT BUFFER (PAGE 2)
	/*	4400	OUTPUT BUFFER (PAGE 1)
	/*	4600	OUTPUT BUFFER (PAGE 2)
	/*	5000	INPUT HANDLER
	/*	5200	OUTPUT HANDLER
	/*	5400	FILES (INPUT,OPEN,AND LIST)
	/*
	/*	5600	PUSHDOWN LIST CONTROLS
	/*	6000	NAME, GTMON, DISMISS, IOWAIT
	/*	6200	HANDLR, PUTDEV, & TABULATE
	/*	6400	DECODER, NAMER, DATER, SAVER
	/*	6600	RUN,CALL,GOSUB,BRANCH,RETURN
	/*	7000	LIBRARIAN
	/*	7200	MISCELLANEOUS
	/*	7400	LIBRARY HANDLER
	/*****				*****
	/************************************


	/TEXT STORAGE AND THE PUSH-DOWN LIST USE THE
	/REMAINING SPACE.  IF THE FILE COMMANDS ARE
	/DELETED STORAGE EXTENDS TO 5600; OTHERWISE
	/IT ENDS AT APPROXIMATELY 3600.




	/INITIAL TEXT FOR U/W-FOCAL

	*200
	0		/PROGRAM LENGTH
	5051		/"()" FOR TDUMP
LINE0,	0		/POINTER TO NEXT
	0		/LINE NO. ZERO
	TEXT "C U/W-FOCAL:"
TITLE,	ZBLOCK 4	/NULLS NOW PRINT AS SPACES
DATE,	ZBLOCK 4	/LINK TO INITIAL DIALOG
	7715		/DUMMY CR
LINE1=.
/OS/8 FOCAL FILE ROUTINES

	*3622

RESTOR,	TSPNOR		/'OPEN RESTORE' COMMAND
	TAD CHR		/SAVE COMMAND CHAR
	DCA NOCHAR
	CMA		/INITIALIZE ECHO SWITCH
	DCA GOSW
	GTNAME		/TO SET ECHO MODE
	TAD NOCHAR
	TJUMP		/SORT OUT "I" OR "O"
	    ORLIST-1
	    ORGO-ORLIST
	ERROR1		/NEITHER ONE!

CLOSE,	JMS CLOSER	/'OUTPUT CLOSE' COMMAND
	JMP EXIT

CLOSER,	0		/CLOSE THE OPEN OUTPUT FILE
	TAD OUTFLG
	SNA CLA		/DON'T BOTHER IF IT ISN'T OPEN
	JMP I CLOSER
	STL CMA
K377,	AND (232	/WRITE '^Z'
	JMS NOCHAR
	SZL		/PAD BUFFER WITH ZEROS
	JMP .-2		/ (AND WRITE IT OUT)

KILLIT,	IOF
	TAD DEVHLD	/SAVED DEVICE #
	CIF 10
	JMS I USR
	4
	ONMTMP		/POINTER TO SAVED NAME
BLKCNT,	0		/FILE LENGTH (BLOCKS)
	ERROR1		/HUH?

	TAD (XOUTL	/RESTORE TELETYPE OUTPUT ROUTINE
	CDF 10
	DCA I [OUTDEV
	CDF
	TAD OUTFLG
	SNA CLA
	JMP FILERR	/FILE WAS TOO LONG
	DCA OUTFLG	/CLEAR 'FILE OPEN' FLAG
	TAD BLKCNT	/CHECK FOR ALTERNATE EXIT
	SZA CLA
	JMP I CLOSER	/CALLED BY 'CLOSE' 'OCHK' 'OCLCHK'

ABORT,	TAD OUTFLG	/'OUTPUT ABORT' COMMAND
	SNA CLA
	JMP EXIT	/EXIT BEFORE OR AFTER !
	DCA BLKCNT
	JMP KILLIT
NOCHAR,	0		/PS/8 3/2 BUFFERED CHARACTER OUTPUT
	AND K377	/MASK OUT GARBAGE
	ISZ O3		/WHICH CHAR OF THREE?
	JMP O2		/STRAIGHT PACKING
	JMS O3		/HALF WORD PACKING - PACK 1ST HALF
	TAD OSETUP	/GET SAVED ARG
	JMS O3		/PACK SECOND HALF
	CMA CLL RTL	/RESET 3-WAY SWITCH
	DCA O3		/BUFFER CAN ONLY BE FILLED WITH
	ISZ OUTFLG	/THE 3RD CHARACTER OF 3
	JMP I NOCHAR	/NOT FULL YET
	TAD OLNGTH	/-MAXIMUM ALLOWABLE LENGTH
	TAD BLKCNT	/LENGTH SO FAR
	SNL CLA		/HAS HE GONE TOO FAR?
	JMP ABORT+3	/YES, KILL HIM
	JMS I (PUTDEV	/TELL MONITOR THE HANDLER'S IN CORE
    	    OUTHND-2	//POINTER TO DEVICE # AND ENTRY
	IOF
	JMS I OUTHND	/WRITE ONE BLOCK BUFFER
	4200
	4400
OBLK,	0
	JMP I [DERR	/DEVICE ERROR
	ISZ OBLK	/BUMP OUTPUT BLOCK
	ISZ BLKCNT	/AND COUNT OF BLOCKS SO FAR
	JMS OSETUP	/RESET POINTERS FOR NEXT BUFFER
	CLL		/INFORM CLOSER THAT
	JMP I NOCHAR	/THE END IS AT HAND

O2,	DCA I OPTR1	/NORMAL PACKING IS EASY!
	ISZ OPTR1	/BUMP POINTER
	JMP I NOCHAR

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

OPTR1,	0		/PACKING POINTERS
OPTR2,	0

ONMTMP,	ZBLOCK 4	/SAVED FILE NAME

FILERR,	ERROR1		/FILE TOO LONG

OLNGTH,	0		/MAX. FILE LENGTH

ORGO,	IRST
	ORST
OSETUP,	0		/RESET ALL THE POINTERS (WHAT FUN!)
	TAD OBLK-1
	DCA OPTR1
	TAD OBLK-1
	DCA OPTR2
	TAD [-200	/X3 = 384 CHARACTERS/BUFFER
	DCA OUTFLG
	CMA CLL RTL
	DCA O3
	JMP I OSETUP

	PAGE 26
IMPUT=(	WAITUP		/JUST PLAIN SNEAKY!
	OCLCHK
OUTPUT,	WAITUP		/WAIT FOR TELETYPE TO FINISH
	CMA
	OPENUP		/CALL USR, HANDLER; ENTER FILE
YINT,	    OUTBLK-1	/OUTPUT HANDLER BLOCK
	    3		/MONITOR 'ENTER' CODE
	JMP TTYOUT	/'OPEN OUTPUT TTY:'
	JMP I .-7	/ENTER ERROR: SEE IF FILE ALREADLY
	DISMISS		/OPEN.   IF NO ERROR: KICK USR OUT
	TPUSHF		/SAVE NAME AND OTHER CRAP
		NAMLOC
	TPOPF
		ONMTMP
	TAD STBLK	/STARTING BLOCK
	DCA I (OBLK
	TAD FLNGTH	/-MAXIMUM ALLOWABLE LENGTH
	DCA I (OLNGTH
	JMS I (OSETUP	/SET UP PACKING POINTERS
	DCA I (BLKCNT
	TAD DEVNO	/SAVE FOR CLOSE
	DCA DEVHLD
ORST,	TAD OUTFLG	/'OPEN RESTORE OUTPUT' COMMAND
	SNA CLA		/FLAG IS CHARACTER COUNT
	ERROR1		/NO OUTPUT FILE TO RESTORE
	TAD TTYOUT-1	/POINTER TO FILE OUTPUT ROUTINE
	CDF 10
	DCA I [OUTDEV
	ISZ GOSW	/SKIP IF NO ECHO
	TAD OCHAR0+2	/'TAD ICHAR0'
	DCA OECHO	/SET OUTPUT ROUTINE
	JMP EXIT	/FINISH THE LINE
	OCHAR
TTYOUT,	TAD .+2		/SWITCH OUTPUT TO THE TELETYPE
	JMP ORST+4
	XOUTL

OCHAR0,	0		/FILE OUTPUT VIA 'PRINTC'
	DCA ICHAR0	/SAVE CHARACTER FOR ECHO
	TAD ICHAR0
	JMS I (NOCHAR	/WRITE IT
	ION
OECHO,	TAD ICHAR0	/=0000 IF NO ECHO
	SNA
	ISZ OCHAR0	/SET NO ECHO RETURN
	CDI 10
	JMP I OCHAR0

OCMND,	TAD K604	/'O' COMMAND ENTRY FROM FIELD 1
	DCA EXTENSION	/SET '.FD'
	TAD I XCHAR
	TJUMP		/GO DO COMMAND
	    FILIST-1
	    FILEGO-FILIST
	ERROR1		/OOPS - BAD 'O' COMMAND
ICHAR0,	0		/FILE INPUT VIA 'READC'
	ISZ INFLG	/DO WE NEED ANOTHER BUFFER?
	JMP I RDPTR	/NO, UNPACK THE CHARACTER

	IOF
	JMS I INHND	/YES, GO GET IT
	0200
	4000
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
	ION

ICHAR1,	TAD I IPNTR	/STRAIGHTFORWARD UNPACK ROUTINE
	JMS RDPTR	/DO COMMON CRAP
ICHAR2,	TAD I IPNTR	/SAVE LEFT HALF FOR LATER
	AND K7400
	DCA ITEMP
	ISZ IPNTR	/INCREMENT TO NEXT WORD
	TAD I IPNTR	/ANOTHER EASY ONE
	JMS RDPTR
ICHAR3,	TAD I IPNTR	/THIS IS THE TRICKY ONE!
	ISZ IPNTR	/GET LOW-ORDER HALF
	AND K7400
	CLL RTR		/SHIFT RIGHT
	RTR
	TAD ITEMP	/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 ...

RDPTR,	0		/THIS IS A COROUTINE !
	AND K177	/ISN'T THAT AMAZING ?
	SNA		/IGNORE NULLS AND PARITY
	JMP ICHAR0+1
	TAD (-32	/END OF FILE? (^Z)
	SZA
	JMP .+5		/NO
	DCA INFLG	/YES, CLEAR OPEN FILE FLAG
	CDF 10		/AND SET UP CLEVER KLUDGE
	TAD (EOF	/TO CHECK FOR A STUPID
	DCA I [INDEV	/'ATTEMPT-TO-READ-PAST-EOF'!
	TAD (232	/PASS ^Z TO PROGRAM
	CDI 10		/(MIGHT COME IN HANDY)
	JMP I ICHAR0

ITEMP,	0
IPNTR,	0
XLEN,	TAD I (OLNGTH	/FUNCTION TO CHECK FILE LENGTH
	TAD I (BLKCNT	/(AMOUNT USED THUS FAR)
	CIA
	CDI 10
	JMP I .+1	/RETURN MAX. AVAILABLE LENGTH
	FIN+2

	ZBLOCK 3

FILEGO,	OLIST
	ABORT
	CLOSE
	RESTOR
	DATER
	IMPUT
	OUTPUT

	PAGE
/IMPUT,	WAITUP		/WAIT FOR THE TELETYPE AGAIN
	CMA
	OPENUP		/CALL THAT AMAZING
	    INBLK-1	/GENERAL-PURPOSE SUBROUTINE
	    2		/MONITOR 'LOOKUP'
	JMP TTYIN	/'OPEN INPUT TTY:'
	ERROR1		/WHOOPS - FILE NOT FOUND
	DISMISS		/BOOT THE USR OUT
	CLA CMA
	DCA INFLG	/CHARACTER COUNTER
	TAD STBLK	/FIRST BLOCK NO.
	DCA I .+2
	JMP IRST+3
	IBLK
IRST,	TAD INFLG	/'OPEN RESTORE INPUT' COMMAND
	SNA CLA		/CHECK CHARACTER COUNT
	ERROR1		/NO INPUT FILE TO RESTORE
	TAD TTYIN-1	/SET I/O POINTERS
	CDF 10
	DCA I [INDEV
	TAD ATEM-1	/'ION'
	ISZ GOSW	/AND ECHO MODE
	TAD (PRINTC-ION
	DCA I .+2	/READC ECHO INSTRUCTION
	JMP EXIT	/RETURN
	IECHO
	ICHAR
TTYIN,	TAD (XI33	/'OPEN INPUT TTY:'
	JMP IRST+4

/THE STACK CAN BEGIN HERE IF THE FILE COMMANDS ARE DELETED.

/NOTE: STACK ROUTINES HAVE BEEN REVISED FOR IMPROVED SPEED!

PCHK,	0		/STACK OVERFLOW CHECK
	CDF 10
	TAD I [PDLXR	/ADJUST FIELD 1 X-REGISTER
	DCA PDLXR	/BACKUP & COPY
	TAD PDLXR
	DCA I [PDLXR
	TAD PDLXR	/CHECK FOR OVERFLOW
	CLL CIA
	TAD I [BUFR	/LAST TEXT WORD
	CDF
	SZL CLA
PDERR,	ERROR1		/TOO BAD !
	JMP I PCHK

MPUSHA,	0		/PUSH THE AC ON THE STACK
	DCA MPOPA
	CMA
	JMS PCHK
	TAD MPOPA
	DCA I PDLXR
	JMP I MPUSHA
	*5660
IOBUF,	ZBLOCK 20	/TELETYPE OUTPUT BUFFER

/LOWER FIELD STACK ROUTINES:

MPOPA,	0		/POP A WORD INTO THE AC
	CDF 10
	ISZ I [PDLXR	/FAKE A FIELD 1 USE
	TAD I [PDLXR
	CDF
	DCA MPUSHA
	TAD I MPUSHA
	JMP I MPOPA

MPD2,	0		/PUSH 4 WORDS ON THE STACK
	CLA CMA
	TAD I MPD2	/BACKUP POINTER
	DCA AUTO
	ISZ MPD2
	TAD FCDF+2
	RDF		/CALLED FROM EITHER FIELD
	DCA FCDF
	TAD [-4
	JMS PCHK
	TAD [-4
	DCA PCHK
FCDF,	HLT		/CHANGE TO CALLING FIELD
	TAD I AUTO
	CDI
	DCA I PDLXR	/LOAD STACK
	ISZ PCHK
	JMP FCDF	/WITH FOUR WORDS
	TAD FCDF
	DCA .+1
	CDI
	JMP I MPD2

MPD3,	0		/POP 4 WORDS
	CLA CMA
	TAD I MPD3
	DCA PDLXR
	ISZ MPD3
	TAD [-4
	DCA PCHK
	JMS MPOPA
	DCA I PDLXR
	ISZ PCHK
	JMP .-3
	JMP I MPD3


APUSHX,	JMS MPUSHA	/FIELD 1 'PUSHA' CALL
	CDI 10
	JMP I .+1
	XPUSHA+3
REKOVR,	ZBLOCK 3	/'SWBA' & OTHER RESETS GO HERE
	DCA I PDLXR	/CLEAR OUT THE TTY BUFFER
	ISZ IOBUF	/('-20' SET BY 'RECOVR')
	JMP .-2		/ALSO CLEARS 'MPUSHA'
	TAD I [SWAPIN	/CHECK CORE-SWAP FLAG
	SNA CLA
	JMS I [SWAPIN	/RESTORE FOCAL!
	CDI 10
	TAD (RECOVX	/LET 'EOF' RESTORE THE TTY
	DCA I (EOF
	JMP I (EOF+1

	PAGE
/READ A DEV:FILENAME.EX STRING INTO 'NAMLOC' & 'NEWDEV'

GNAME,	TAD ("A-":	/WAS IT A DEVICE ?
	SZA CLA
	JMP I NAME	/NO, ALL SET UP
	TGETC		/YES, MOVE PAST ':'
	TAD NAMLOC	/MOVE TO DEVICE AREA
	DCA NEWDEV
	TAD NAMLOC+1
	JMP NAME+3	/GET FILENAME

NAME,	0
	TAD [5723	/CODE FOR 'DSK:'
	DCA NEWDEV	/(DEFAULT DEVICE)
	DCA NEWDEV+1
	DCA NAMLOC	/CLEAR NAME AREA
	DCA NAMLOC+1	/(DON'T CLEAR ASSUMED EXTENSION)
	DCA NAMLOC+2
	TAD XNAME	/INITIALIZE POINTERS
	DCA NMBASE
GETN,	STA STL
	DCA PERDSW
	DCA NAMECT
	TSPNOR
	DCA I [NPACK
	JMP I .+1	/EXAMINE THE FIRST CHARACTER
	FIRSTC

NAMEC,	JMP I GETN	/GET NEXT CHARACTER OR NUMBER
	TAD ("(-".	/EXTENSION?
	SNA
	JMP PERD	/YES, CLEAR DEFAULT EXTENSION
	TAD (".-",	/COMMA?
	SNA CLA
	JMP ECHCHK	/YES, CHECK FOR ECHO
	JMS DECODE	/MUST BE A-Z, 0-9
	JMP GNAME	/IT WASN'T, MUST BE END OF NAME
	SZL		/RESTORE CHARACTER
	TAD K57
	IAC
	DCA DECODE	/TEMPORARY STORAGE
	TAD NAMECT	/NO MORE THAN 6 CHARACTERS/NAME
	TAD (-6
K7700,	SMA CLA
	JMP I PASSN	/GO TO THE END OF THE NUMBER
	TAD NAMECT	/BUILD POINTER TO CHAR. POSITION
	CLL RAR
	TAD NMBASE
	DCA ATEM
	TAD DECODE	/LEFT OR RIGHT HALF?
	SZL
	JMP .+4
	RTL		/LEFT, SHIFT OVER
	RTL
	RTL
	TAD I ATEM	/ADD IN OTHER HALF
	DCA I ATEM
	ISZ NAMECT	/BUMP COUNT
	JMP NAMEC	/CONTINUE LOOP

K57,	57
P4,	4

PERD,	TAD NAMLOC	/FOUND A PERIOD IN STRING
	SZA CLA
	ISZ PERDSW
	ERROR1		/DOUBLE PERIODS OR NO FILE NAME
	DCA EXTENSION	/CLEAR EXTENSION
	TGETC		/MOVE PAST PERIOD
	ISZ NMBASE	/FAKE OUT POINTERS
	TAD P4
	JMP GETN+2

ECHCHK,	TGETC		/MOVE PAST COMMA
	TSPNOR
	TAD CHR		/MUST BE FOLLOWED BY 'ECHO'
	TAD (-"E
	SZA CLA
	JMP GNAME
	DCA GOSW	/CLEAR ECHO FLAG
	TGETC		/MOVE TO END OF WORD
	JMS DECODE
	JMP GNAME
	CLA CLL
	JMP .-4

DECODE,	0		/CHECK FOR A-Z, 0-9
	TAD CHR	
	TAD (-"9-1
	CLL IAC
	TAD K11		/"9(+1)-"0
	SZL
	JMP DCDYES
	TAD ("0-"Z-1
	STL
	TAD ("Z-"A+1
	SNL
DCDYES,	ISZ DECODE	/IT WAS!
	JMP I DECODE

NMBASE=.
IOWAIT,	0		/WAIT FOR TELETYPE TO FINISH
	ION
	CDF 10
	TAD I (TELSW
	SZA CLA
	JMP .-2
	CDF
	IOF		/THEN TURN OFF THE INTERRUPT
	JMP I IOWAIT
PERDSW=.
USRIN,	0		/LOCK THE USR IN CORE
	IOF		/(NOP IF ALREADY IN CORE)
	CIF 10
	JMS I USR
	10
	TAD [200	/SET POINTER FOR LATER CALLS
	DCA USR
	JMP I USRIN

NAMECT=.
USROUT,	0		/IF THE USR IS IN, KICK IT OUT
PASSN,	STA CLL
	AND USR		/CHECK POINTER TO FIND OUT
	SPA CLA
	JMP I USROUT
	TAD K7700	/RESET POINTER = 7700
	DCA USR
	IOF
	CIF 10
	JMS I [200
K11,	11
	JMP I USROUT

	PAGE
TTYTXT,	DEVICE TTY	/FOR COMPARISON PURPOSES
	*CIF		/'PRINTC' TAB COUNTER
	0
	SZA		/TEST FOR CR
	JMP .+4
	ISZ CIF		/ADVANCE RETURN POINT
	ISZ CIF
	DCA I [ERR2	/RESET COUNTER
	TAD (215-240
	SMA		/NON-PRINTING CHARACTERS
	ISZ I [ERR2	/ADD 1 TO TAB COUNT (FIELD 1)
	NOP		/MIGHT SKIP AFTER 4095 TIMES
	TAD [240	/WITHOUT INTERVENING CR'S
	CIF 10
	JMP I CIF

TSP,	TASK
DHT,	7646

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
	ERROR1		/DEVICE NOT AVAILABLE OR
	TAD [200	/       TWO-PAGE HANDLER
	TAD DLOAD	/ENTRY POINT FOR HANDLER
	SMA CLA		/IF >7600 DON'T CHECK FURTHER
	JMP HANDOK	/SYSTEM HANDLER
	TAD DLOAD	/IF THE HANDLER WAS NOT LOADED
	AND [7600	/INTO THE PROPER PAGE, RELOAD IT!
	CLL CIA
	TAD I SLOT	/PROPER LOADING ADDRESS
	SNA CLA
	JMP HANDOK	/EVERYTHING'S ALL RIGHT
	DCA DLOAD	/CLEAR ENTRY POINT
	JMS PUTDEV	/TELL USR THE HANDLER
	    DLOAD-2	/IS NOT IN CORE ANYMORE
	JMP RETRY	/LOAD IT THIS TIME
PUTDEV,	0		/TELL THE MONITOR WHETHER
	TAD I PUTDEV	/  A HANDLER IS IN OR OUT
	DCA PDLXR	/POINTER TO DEVICE # AND ENTRY
	TAD DHT		/DEVICE HANDLER TABLE
	TAD I PDLXR	/PLUS DEVICE NUMBER
	DCA ATEM	/POINTS TO 'HANDLER-IN-CORE' FLAG
	TAD I PDLXR
	CDF 10
	DCA I ATEM	/FLAG IS SIMPLY HANDLER ENTRY
	CDF
	ISZ PUTDEV
	JMP I PUTDEV	/ALSO CALLED BY 'NOCHAR'


/LOAD A HANDLER INTO THE PROPER SLOT:

HANDLR,	0
	TAD I HANDLR	/WHICH SLOT?
	ISZ HANDLR
	DCA SLOT
	COMPARE		/IF THE HANDLER HAS THE SAME NAME,
	   -2		/DON'T LOAD IT AGAIN
SLOT,	    0
	    NEWDEV-1
	JMP NOTEQ	/DIFFERENT NAMES, LOAD NEW HANDLER
	ISZ AUTO 2	/(SET BY 'COMPARE')
	TAD AUTO 2	/POINTS TO DEVICE #
	DCA .+4
	TAD I AUTO 2
	DCA DEVNO	/MOVE DEVICE # (FOR SAVE AND CLOSE)
	JMS PUTDEV	/SO USR KNOWS IT'S IN CORE
	0
	JMP I HANDLR


HANDOK,	ISZ SLOT	/BUMP POINTER TO DEVICE #
	TAD DEVC+1	/SAVE IT
	DCA I SLOT
	ISZ SLOT	/MOVE TO ENTRY POINT
	TAD DLOAD	/SAVE ENTRY
	DCA I SLOT
	TAD DEVC+1	/GET DEVICE #
	DCA DEVNO	/SAVE IT AND EXIT
	JMP I HANDLR
	EJECT

/TABULATE ROUTINES:  CALLED FROM THE UPPER FIELD

TAB,	SPA		/TAB COMMAND
	JMP NEG
	CIA
	TAD I [ERR2	/FIND OUT WHERE WE ARE
	SMA		/HAVEN'T GOT THERE YET
ZER,	CLA CMA		/WE'RE PAST: FORCE -1
	DCA GOSW
	CDI 10
	ISZ GOSW	/TEST IN ADVANCE
	SKP		/NO JUMPS ALLOWED!
	JMP I TSP	/RETURN TO A/T LOOP

	TAD [240	/PRINT SPACES
	JMS I [CPRNT
	JMP ZER+2

NEG,	DCA GOSW
	TAD I XCHAR	/SAVE THE CURRENT CHARACTER
	DCA CHR
	CIF 10
	JMP SKIP1	/SKIP OVER ONE (OR MORE)
POS,	ISZ GOSW
	JMP .-3
	TAD CHR
	DCA I XCHAR	/RESTORE THE ORIGINAL ONE
	JMP ZER


/SORT AND BRANCH TABLE FOR LOWER-FIELD COMMANDS:

KOMLST,	"B		/BRANCH
	"G		/GOSUB
	LF		/RETURN
	"N		/NAME
	"S		/SAVE
	"E		/EXIT
FILIST,	"L		/LIST
	"A		/ALL OR ABORT
	"C		/CALL OR CLOSE
	"R		/RUN OR RESTORE
	"D		/DATE OR DELETE
ORLIST,	"I		/INPUT OR INITIAL
	"O		/OUTPUT OR ONLY

	PAGE
/LIBRARY PROCESSOR: COMMAND DECODE, NAMER, DATER, & SAVER.

	*FPNT		/ENTER VIA 'JMP I 7'

LCMND,	TAD I XCHAR	/SAVE CURRENT CHARACTER
	DCA CHR
	TAD [603	/SET '.FC'
	DCA EXTENSION
	DCA GOSW	/POINT TO 'PROC'
	TSPNOR
	WAITUP		/TURN OFF THE INTERRUPT
	TAD CHR
	JMP LGO		/RETAIN OLD ERROR CODE

NAMER,	GTNAME		/'LIBRARY NAME' COMMAND
	JMP EXIT-3

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

LGO,	TJUMP		/BRANCH TO THE APPROPRIATE ROUTINE
	    KOMLST-1
	    KOMGO-KOMLST
	ERROR1		/SORRY, CHARLIE!

DATER,	TAD [NUDATE-1	/'OUTPUT DATE' COMMAND
	DCA AUTO
	TAD [-4
	DCA GOSW
	TAD I AUTO	/GET DATE AND
	JMS I [NPACK	/OUTPUT IT
	ISZ GOSW
	JMP .-3
	JMP EXIT	/RETURN

	CGET
	OCHK

SAVE,	0		/CALLED BY 'SAVER' AND 'GOSUB'
	JMS I .-2	/CLOSE OUTPUT FILE TO AVOID TROUBLE
	TAD XNAME	/POINTER TO NAME
	DCA SAVEPT
	CDF 10
	TAD I [BUFR	/GET PROGRAM LENGTH
	CDF
	DCA I [200	/SAVE IT WITH THE PROGRAM
	GETMON		/CALL THE MONITOR
	GETHND		/AND THE HANDLER
	    LIBBLK-1
	TAD I [200	/SAVED LENGTH, REMEMBER?
	AND [7600	/MASK OFF
	CLL RAR		/CONVERT TO PAGES
	DCA BLOCK	/FOR HANDLER
	TAD BLOCK	/ROUND UP TO BLOCKS
	TAD [100
	AND [7600
	CLL RAR
	RTR
	DCA SAVBLK	/FOR MONITOR 'ENTER'
	TAD SAVBLK	/GET DESIRED LENGTH
	TAD DEVNO	/(SET BY 'HANDLR')
	CIF 10
	JMS I USR	/ENTER OUTPUT FILE
	3
SAVEPT,	NAMLOC
	0
	ERROR1		/NO ROOM ON DEVICE
	TAD SAVBLK	/SHIFT FOR CLOSING LENGTH
	CLL RTR
	RTR
	DCA SAVBLK
	TAD DEVNO	/CLOSE THE FILE BEFORE WE WRITE IT!
	CIF 10		/(SURE, IT'S CHEATING, BUT
	JMS I USR	/IT SAVES TIME!)
	4
	NAMLOC
SAVBLK,	0
	ERROR1		/IMPOSSIBLE ERROR !
	TAD SAVBLK	/SAVE THIS CRAP TO REMEMBER
	CIA		/WHERE THIS PROGRAM IS
	DCA LIBLEN	/IN CASE WE WANT TO GOSUB
	TAD SAVEPT
	DCA LIBFIL
	TAD NEWDEV
	DCA LIBDEV
	TAD NEWDEV+1
	DCA LIBDEV+1
	TAD SAVEPT	/MOVE STARTING BLOCK FOR WRITE
	DCA POINT4
	STL RAR		/COMPUTE FUNCTION WORD
	IAC		/SET TO SEARCH FORWARD
	TAD BLOCK	/HOW MUCH TO WRITE
	DCA BLOCK
	JMS I LIBHND
BLOCK,	0		/WRITE (BLOCK) BLOCKS
	200		/FROM FIELD 0, 200 UP
POINT4,	0
	JMP I [DERR	/GO COMPLAIN ABOUT DEVICE
	DISMISS
	JMP I SAVE



MGETC,	0		/CROSS-FIELD CALL
	CDI 10
	JMS I SAVE-2
	DCA CHR
	JMP I MGETC
CMPR,	0		/COMPARE TWO BLOCKS OF ANY LENGTH
	TAD I CMPR	/CALLING SEQUENCE:
	ISZ CMPR	/    COMPARE
	DCA MGETC	/	-# OF WORDS
	TAD I CMPR	/	FIRST-1
	ISZ CMPR	/	SECOND-1
	DCA AUTO 2	/    RETURN IF NO MATCH
	TAD I CMPR	/    RETURN IF MATCH
	ISZ CMPR
	DCA AUTO 3
CONT,	TAD I AUTO 2	/COMPARE TWO WORDS
	CIA
	TAD I AUTO 3
	SZA CLA
	JMP I CMPR	/NO MATCH
	ISZ MGETC	/DONE ?
	JMP CONT	/NO, CHECK TWO MORE
	ISZ CMPR	/YES, BUMP RETURN POINTER
	JMP I CMPR


/LIBRARY COMMAND LIST:

KOMGO,	BRANCH		/B
	GOSUB		/G
	GOBACK		/LF
	NAMER		/N
	SAVER		/S
	MONITOR		/E
	LIST2		/L
	LISTAL		/A
	CALLER		/C
	RUNNER		/R
	DELEET		/D
	INITIAL		/I
	LIST1		/O
	/LOOKUP AND LOAD ROUTINES

PDR,	PDERR
SVR,	SAVE

INITIAL=.+2
SUBBER,	CMA CLL RTL	/THESE ALL DO THE SAME THING AND
RUNNER,	IAC		/THEN BRANCH TO DIFFERENT PLACES
CALLER,	IAC		/LOAD HAS 5 POSSIBLE EXITS !
	OPENUP		/CALL THE HANDLER AND
	    LIBBLK-1	/LOOKUP THE FILE
	    2
	JMP .+5		/TTY: NOT A DIRECTORY DEVICE
	ERROR1
	DISMISS
	JMS I GDT	/GET DEVICE TYPE
	SMA CLA
	ERROR1		/NOT A DIRECTORY DEVICE
	CDI 10
	JMS I GLN	/SOME COMMANDS HAVE LINE NUMBERS

LOAD,	TAD I [PDLXR	/GET PUSHDOWN POINTER
	CDF
	TAD [-200	/DIDDLE IT
	AND [7600
	CLL RAL
	RTL
	RTL
	TAD FLNGTH	/NOW COMPARE WITH LENGTH OF FILE
	SPA CLA
	JMP I PDR	/PROGRAM TOO LONG
	TAD FLNGTH	/COMPUTE FUNCTION WORD
	CLL CIA
	RTL
	RTL
	RTL
	STL RAL		/SET TO SEARCH FORWARD
	DCA .+4
	TAD STBLK
	DCA .+4
	JMS I LIBHND	/GET THE PROGRAM
TEMP,	0
	200		/LOADS FROM 200 UP
	0		/STARTING BLOCK NO.
	JMP I [DERR
	TAD I [200	/MOVE PROGRAM LENGTH
	CDF 10
	DCA I [BUFR

	TAD GOSW	/CHECK FOR GOSUB
	SMA CLA
	JMP LOADGO

TPUSHA=	JMS I TPA
TPOPA=	JMS I [MPOPA
	TAD I XCHAR	/GOSUB MUST SAVE TERMINATOR
	TPUSHA
	TAD [215	/AND SUBSTITUTE A CR TO FORCE
	CDF 10
	DCA I XCHAR	/A RETURN FROM 'TERMER'
	CDF
	TPUSHF		/ALSO SAVE CURRENT PROGRAM INFO
		LIBDEV
LOADGO,	CDF
	TPUSHF		/SAVE NEW PROGRAM POINTERS
		NEWDEV
	TPOPF		/SO WE KNOW WHERE WE ARE
		LIBDEV
	TAD I D		/CHECK PROGRAM I.D.
	SZA CLA
	JMP I DIALOG	/INITIAL DIALOGUE - OR
	JMP EXIT-1	/PROC, START, GOTO, OR DO

GOSUB,	TAD LIBFIL	/CHECK FOR CURRENT PROGRAM
	SZA CLA
	JMP SUBBER	/NO NEED TO SAVE IT
	TPUSHF		/MOVE 'FOCAL.TM' TO NAME AREA
		FOCTXT
	TPOPF
		NAMLOC
	TAD [5723	/DEVICE 'DSK' FOR SAVE
	DCA NEWDEV
	DCA NEWDEV+1
	JMS I SVR	/SAVE FILE & REMOVE USR
	TAD [603	/RESET EXTENSION TO 'FC'
	DCA EXTENSION
	JMP SUBBER

GOBACK,	TPOPF		/RESTORE CALLING PROGRAM POINTERS
		NEWDEV
	GETHND		/GET THE HANDLER BACK
INB,	    LIBBLK-1	/POINTS TO 'INBUF'
	DISMISS		/AND REMOVE THE USR
	TPOPA		/FINALLY, RESTORE THE PROPER CHAR.
	CDF 10
	DCA I XCHAR
	JMP LOAD	/AND RELOAD THE PROGRAM


/THE 'LIBRARY 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.1;C A KEY WAS HIT
/'FIN()' MAY THEN BE USED TO READ AND TEST THE CHARACTER.

BRANCH,	CDI 10		/'LIBRARY BRANCH' COMMAND
	JMS I GLN
	TAD I INB	/CHECK FOR INPUT
	SNA CLA
	STL RTL		/NONE: SET EXIT TO 'GOTO'
	JMP EXIT	/OTHERWISE CONTINUE LINE
JUMPER,	0		/SORT AND BRANCH SUBROUTINE
	CIA
	DCA TEMP
	SKP		/CURRENT ONE MIGHT BY A TERMINATOR
	TGETC
	CDI 10
	JMS I TRM	/IS 'CHAR' A SP, COMMA, ; OR CR?
	JMP .-3		/NO
	TAD I JUMPER	/GET LIST ADDRESS
	ISZ JUMPER
	DCA AUTO
	TAD I AUTO
GLN,	SPA SNA		/END OF LIST ?
	JMP ERRX
	TAD TEMP
	SZA CLA		/FOUND IT ?
	JMP GLN-1	/NO
	TAD AUTO
	TAD I JUMPER	/ADD OFFSET
	DCA TEMP
	TAD I TEMP	/POINT TO ENTRY
	DCA TEMP
	JMP I TEMP

ERRX,	ISZ JUMPER	/ERROR EXIT FOR 'JUMPER'
	JMP I JUMPER	/ERROR ROUTINE CLEARS AC

FOCTXT,	FILENAME FOCAL.TM
TPA,	MPUSHA
TRM,	TERMER
GDT=.+1

OLIST,	WAITUP		/'ONLY LIST' COMMAND
LIST1,	CMA STL RAL	/'LIST ONLY' COMMAND
LIST2,	ISZ GOSW	/'LIBRARY LIST' COMMAND
LISTAL,	DCA STBLK	/'LIST ALL' COMMAND
/THIS SECTION DOES THE WORK OF LISTING THE DIRECTORY:

/THE 'LIBRARY LIST' COMMAND SHOWS ONLY "FC" AND "FD" FILES
/'LIST ALL' SHOWS EVERYTHING & 'LIST ONLY' SHOWS ONLY ONE.

	GTNAME		/GET DEVICE TO LIST
	GETHND		/GET THE HANDLER
	    LIBBLK-1
	DISMISS		/KICK OUT USR IF HANDLR CALLED IT
	JMS GETDEV	/FIND DEVICE TYPE
	SMA CLA
	ERROR1		/CAN'T LIST A NON-DIRECTORY DEVICE
	JMS I [7607	/SWAP OUT CORE TO MAKE ROOM
	4200		/FOR DIRECTORY
	1000
	40		/SYSTEM SCRATCH AREA
	JMP I [DERR	/WHOOPS!
	DCA I [SWAPIN	/SET THE FLAG TO SWAP BACK IN
	IAC		/DIRECTORY BEGINS WITH BLOCK 1

BLOKLP,	DCA LBLOCK
	IOF
	JMS I LIBHND
	0200
	1000
LBLOCK,	1
	JMP I [DERR
	TAD K1004	/FIRST 5 WORDS ARE INFORMATION
	DCA AUTO

LOOP2,	TAD AUTO	/SAVE FOR LATER
	DCA AUTO 1
	TAD AUTO
	DCA LIBX
	TAD I AUTO	/LOOKING FOR .FC & .FD FILES
	SNA CLA
	JMP PATCH	/ZERO FILE
	ISZ AUTO
	ISZ AUTO
	TAD I AUTO	/PICK UP EXTENSION
	DCA LBLOCK
	TAD I K1004	/WASTE WORDS (NEGATIVE)
	CIA		/THANKS FOR TELLING US, RITCHIE
	TAD AUTO	/SKIP TO LENGTH
	DCA AUTO
	TAD I AUTO	/ZERO LENGTH MEANS TEMPORARY FILE
	SNA
	JMP LOOP3	/IGNORE SUCH THINGS
	CIA
	DCA FLNGTH	/SAVE POSITIVE LENGTH
	TAD NAMLOC	/WAS A NAME GIVEN ?
	SZA CLA
	JMP CKNAME	/YES


CKFCFD,	TAD LBLOCK	/COMPARE EXTENSION
	TAD (-604	/DO WE WANT THIS ONE?
	SZA
	IAC
	SZA CLA
	TAD GOSW	/TEST FOR 'ALL'
	SZA CLA
	JMP LOOP3	/GUESS NOT
	JMP DIRLIST

CKNAME,	COMPARE		/COMPARE THIS NAME WITH ARG
	  -4
LIBX,	   0
	   NAMLOC-1
	JMP LOOP3	/NON-MATCHING
	ISZ STBLK	/TEST FOR ONLY ONE
	DCA NAMLOC	/DON'T CHECK ANY MORE

DIRLIST,CMA CLL RTL	/PRINT 3 WORDS
	DCA COUNT
	TAD I AUTO 1	/SET BEFORE THIS
	JMS I [NPACK	/PRINT 2 CHARS
	ISZ COUNT
	JMP .-3
	TAD (".
	JMS I (PRINT
	TAD I AUTO 1	/PRINT EXTENSION
	JMS I [NPACK
	TAD TABLE	/SET UP FOR DECIMAL LENGTH PRINT
	DCA POINT
ZLUP,	DCA ZERSW
	DCA COUNT

NLOOP,	TAD I POINT	/FINISHED ALL POWERS OF 10?
	SNA
	JMP NEND	/YES, ALL DONE
	TAD FLNGTH	/NO, SUBTRACT THIS POWER
	SPA		/UNDERFLOW?
	JMP DIGIT	/YES, PRINT THIS DIGIT
	DCA FLNGTH	/NO, GO THROUGH THE LOOP AGAIN
	ISZ COUNT	/ADD ONE TO THIS DIGIT
	JMP NLOOP	/ANOTHER DIVIDE CYCLE

PATCH,	ISZ AUTO	/BUMP PAST EMPTY LENGTH
LOOP3,	ISZ I LBLOCK-1	/DONE WITH THIS BLOCK?
	JMP LOOP2	/NO, KEEP GOING
	WAITUP		/WAIT FOR I/O
	TAD I K1002	/LINK TO NEXT BLOCK
	SZA		/LAST BLOCK?
	JMP BLOKLP	/NO, GET THE NEXT
	JMS I [SWAPIN	/YES, RESTORE SWAPPED CORE
	JMP EXIT	/(JMS RESETS THE FLAG)

K1002,	1002
K1004,	1004
DIGIT,	CLA CLL		/CRAP IN AC
	ISZ POINT	/NEXT POWER OF TEN
	TAD COUNT	/IF THIS DIGIT IS ZERO, AND NO
	ISZ ZERSW	/OTHER DIGITS HAVE BEEN NON-ZERO,
	SZA		/PRINT A SPACE INSTEAD
	JMP NPRNT
	TAD [240
	JMS I (PRINT
	JMP ZLUP

NPRNT,	TAD [260	/CHANGE TO ASCII
	JMS I (PRINT
TABLE,	CMA STL		/SET ZERO SWITCH
	JMP ZLUP

NEND,	TAD [215	/DONE WITH THIS LINE (WHEW!)
	JMS I (PRINT
	JMP LOOP3

	*CMA STL	/TRICKY, HUH?
	DECIMAL
	-1000
	-100
	-10
	-1
COUNT=.;OCTAL		/CLEVER ASSIGNMENT TERMINATES TABLE

	*CMA STL RAL	/MORE TRICKS!
GETDEV,	0		/GET DEVICE TYPE FROM MONITOR TABLE
	TAD (7757	/DCB-1
	TAD DEVNO
	DCA LIBX
	CDF 10
	TAD I LIBX
	CDF
	JMP I GETDEV

POINT=	NEWDEV
ZERSW=	NEWDEV+1

	PAGE
	/MISCELLANEOUS GENERAL-PURPOSE ROUTINES

	/THIS IS THE GENERAL OPEN SUBROUTINE
	/CALLNG SEQUENCE:
	/JMS I [OPEN
	/HANDLER BLOCK
	/MONITOR CALL CODE
	/RETURN IF TTY: IS DEVICE
	/ERROR RETURN
	/NORMAL RETURN
	/SETS STBLK, FLNGTH ON PAGE ZERO

OPEN,	0
	DCA GOSW	/SET ECHO/LOAD SWITCH
	GTNAME		/GET DEVICE AND FILENAME
	COMPARE		/DEVICE 'TTY:' IS SPECIAL
	   -2
	   NEWDEV-1
	   TTYTXT-1
	JMP OTHER	/DEVICE OTHER THAN TTY
	ISZ OPEN	/INCREMENT TO PROPER RETURN
	ISZ OPEN
	JMP I OPEN
OTHER,	TAD I OPEN	/GET HANDLER BLOCK TO USE
	DCA HND
	ISZ OPEN
	TAD XNAME	/POINTER TO NAME
	DCA NAMPT
	GETMON
	GETHND		/GET THE HANDLER
HND,	0		/SET TO HANDLER BLOCK
	TAD I OPEN	/GET MONITOR CALL CODE (2 OR 3)
	ISZ OPEN
	DCA CALL
	DCA LNGTH	/FOR MONITOR KLUDGE - IT FALLS
	TAD DEVNO	/    THROUGH IN CASE OF ERROR
	CIF 10
	JMS I USR	/DO THE CALL
CALL,	0
NAMPT,	NAMLOC
LNGTH,	0		/LET THE CALLING ROUTINE
	JMP OTHER-2	/DECIDE ERROR PROCEDURE
	TAD LNGTH	/MOVE PARAMETERS TO PAGE ZERO
	DCA FLNGTH
	TAD NAMPT
	DCA STBLK
	JMP OTHER-3	/AND TAKE NORMAL RETURN

MSPNOR,	0		/COPY UPPER FIELD ROUTINE
	TAD CHR
	TAD MSPACE
	SZA CLA
	JMP I MSPNOR
	TGETC
	JMP MSPNOR+1
DELEET,	JMS OCHK	/DELETE IS AN EASY ONE
	GTNAME
	GETMON
	GETHND
	    LIBBLK-1
	CIF 10
	TAD DEVNO
	JMS I USR	/DELETE THE FILE
	4
	NAMLOC
	0
	ERROR1
	DISMISS
	JMP EXIT-2

OCHK,	0		/IF ANY FILE EXISTS, CLOSE IT
	TAD DEVHLD
	SZA CLA
	JMS I .+2
	JMP I OCHK
	CLOSER

SWAPIN,	HLT		/RESTORE CORE AFTER DIRECTORY LIST
	IOF
	JMS I [7607	/SYSTEM HANDLER
	200
	1000
	40
DERR,	ERROR1		/DEVICE ERROR
	JMP I SWAPIN

NPACK,	0		/STANDARD 6-BIT UNPACK ROUTINE
	DCA OCHK
	TAD OCHK
	RTR
	RTR
	RTR
	JMS XFORM
	TAD OCHK
	JMS XFORM
	JMP I NPACK

XFORM,	0
	AND (77
MSPACE,	SMA SZA		/PRINT SPACES FOR NULLS
	TAD MFORTY
	SPA
	TAD [100
	TAD [240
	JMS PRINT
	JMP I XFORM
	EJECT
OCLCHK,	TAD OUTFLG	/MAKE 'OPEN OUTPUT' WITH AN
	SNA CLA		/ALREADY OPEN FILE THE SAME AS
	ERROR1		/'OUTPUT CLOSE;OPEN OUTPUT'
	JMS I OCHK+5
	TAD (YINT	/FAKE OUT 'OPEN'
	DCA OPEN
	JMP OTHER

	*STA CLL	/VARIABLE FILE NAME PATCH
	ISZ NPACK	/COUNT THE DIGITS
	TAD NPACK	/NOW MANY?
MFORTY,	SMA SZA CLA
	TGETC		/RETURN TO ALPHA MODE
FIRSTC,	TAD CHR
	TAD (-"(	/CHECK FOR A LEFT "("
	SZA
	JMP I (NAMEC+1	/CONTINUE CHECKING

	CDI 10		/FOUND ONE, GO GET #
	JMS I (VFN
	DCA AUTO	/SAVE STRING ADDRESS
	TAD I (T3
	SPA SNA		/CHECK DECIMAL EXPONENT
	CLA IAC		/FOR "0"
	CIA
	DCA NPACK	/SET DIGIT COUNTER

	*STA STL
	CDF 10		/GET A DIGIT - 'GETN'
	TAD I AUTO
	CDF
	TAD [260	/CONVERT TO ASCII
	DCA CHR
	JMP STA CLL	/!

PRINT,	0		/'PRINTC' FOR LISTING AND DATE
	CDI 10
	JMS I [CPRNT
	JMP I PRINT

	PAGE
	EJECT PAGE-ZERO (FIELD 0) LITERALS:
	$