/PFOC0C -- PS/8 FOCAL LIBRARY ROUTINES



/ASSEMBLY INSTRUCTIONS:

/.R PAL8
/*PFOCLC,PFOCLC<PFOC0C,PFOC1C,PFLOTC,PFOCNC,DOLLAR
/.R ABSLDR
/*PFOCLC,INITAL=10200$
/.SAVE SYS PFOCLC
/.R PFOCLC

/(DOLLAR CONTAINS DOLLAR SIGNS TO TERMINATE THE ASSEMBLY)




	FIELD 0

	*1		/INTERRUPT SERVICE ROUTINE

	CIF CDF 10
	JMP I .+1
	INTRPT

	*10
AUTO1,	0		/AUTO-INDEX REGISTERS...ACTUALLY USE SOME
AUTO2,	0
AUTO3,	0
AUTO4,	0
AUTO5,	0
AUTO6,	0
AUTO7,	0
AUTO8,	0
XCNTR,	0		/GENERAL COUNTER--SUCH AS FOR MPD2,MPD3
USR,	7700		/POINTER TO MONITOR (200 IF IN CORE)
PEXIT,	JMS I [DISMIS	/NORMAL RETURN FOR PS/8 COMMANDS
	ION
	CDF CIF 10
	JMP I .+1
	GOSWITCH-3

NAMLOC,	ZBLOCK 3
EXTENSION,	0		/"FC" OR "FD"
LISTFLG,	0
NEWDEV,	ZBLOCK 2
TEM7,	0
ATEM,	0
XCHAR,	CHAR
SHNDLR,	7607
	/DEFINE LOWER FIELD INSTRUCTIONS . . .

	TGETC=JMS I .
	XGETC
	TPOPA=JMS I .
	MPOPA
	TPUSHA=JMS I .
	MPUSHA
	TPUSHF=JMS I .
	MPD2
	TPOPF=JMS I .
	MPD3
	TSORTJ=JMS I .
	MSORTJ

ECHFLG,	0
OPNFLG,	0
IPNFLG,	0
FLNGTH,	0
STBLK,	0
DEVNO,	0
LIBBLK,	0		/FOR DEVICE NAME
	0
	7400		/LOAD POINT
	0		/FOR DEVICE #
LIBHND,	0		/HANDLER ENTRY
	TESTRM=JMS I .
	MSORTC
	ERROR1=JMS I .
	ERROR
	*66
CHAR,	0		/FOR OBSCURE FAKING REASONS

INBLK,	0
	0
	5000
	0
INHND,	0

OUTBLK,	0
	0
	5200
	0
OUTHND,	0

	TPRINTC=JMS I .
	MPRINTC
	TGETLN=JMS I .
	MGETLN
	TSPNOR=JMS I .
	XTSPNOR
LIBFIL,	0
DEVHLD,	0

INRTRN,	RMF		/RETURN FROM INTERRUPT
	ION
	JMP I 0

	PAGE
	/INITIAL TEXT FOR PS/8 FOCAL

	*200
PC0,	0
	0
	0
	0
	0
	5051
	BUFR
	LINE1
LINE0,	0
	0
	TEXT "C-PS/8 FOCAL, 1971"
	*.-1
	7715		/DUMMY CR
	LINE1=.
	PAGE
/PS/8 FOCAL FILE ROUTINES

	*3614

RESTORE,TSPNOR		/'OPEN RESTORE' COMMAND
	TAD CHAR	/SAVE COMMAND CHAR (3 WORD COMMAND!)
	TPUSHA
	TGETC
	TESTRM		/GO TO END OF COMMAND WORD
	SKP CLA
	JMP .-3
	CLA CLL CMA	/INITIALIZE ECHO SWITCH
	DCA ECHFLG
	JMS I [NAME	/JUST TO SET ECHO MODE
	TPOPA
	TAD [-"I	/OPEN RESTORE INPUT?
	SNA
	JMP I [IRST	/YES
	TAD ["I-"O	/NO, MUST BE OUTPUT
	SZA CLA
	ERROR1		/NEITHER ONE!
	JMP I [ORST

OCLOSE,	0		/CLOSE THE OPEN OUTPUT FILE
	TAD OPNFLG
	SNA CLA		/DON'T BOTHER IF IT ISN'T OPEN
	JMP I OCLOSE
	TAD [232	/WRITE '^Z'
	JMS NOCHAR
	TAD OPTR1	/PAD BUFFER WITH ZEROS
	TAD (-4400	/(AND WRITE IT OUT)
	SZA CLA
	JMP .-4
	TAD DEVHLD	/SAVED DEVICE #
	IOF
	CIF 10
	JMS I USR
	4
	ONMTMP		/POINTER TO SAVED NAME
BLKCNT,	0		/FILE LENGTH (BLOCKS)
	ERROR1		/HUH?
	DCA OPNFLG	/CLEAR 'FILE OPEN' FLAG
	ION
	CDF 10
	TAD [XOUTL	/RESTORE TELETYPE OUTPUT ROUTINE
	DCA I [OUTDEV
	CDF
	JMP I OCLOSE	/DO WHATEVER ELSE NEEDS TO BE DONE

NOCHAR,	0		/PS/8 3/2 BUFFERED CHARACTER OUTPUT
	JMS I [FLDSET	/CALLED FROM EITHER FIELD
	DCA CCIF	/SAVE CALLING FIELD
	CDF
	TAD ATEM	/CHARACTER TO BE OUTPUT
	AND (377	/MASK OUT GARBAGE
	ISZ O3		/WHICH CHAR OF THREE?
	JMP O2		/STRAIGHT PACKING
	JMS RT		/HALF WORD PACKING - PACK FIRST HALF
	TAD ATEM	/GET SAVED ARG
	JMS RT		/PACK SECOND HALF
	CLA CLL CMA RTL	/RESET 3-WAY SWITCH
	DCA O3
	ISZ OCHCT	/BUFFER CAN ONLY BE FILLED WITH 3RD CHAR OF 3
	JMP CCIF	/NOT FULL YET, RETURN TO CALLING ROUTINE
	JMS I [PUTDEV	/TELL THE MONITOR THIS HANDLER'S IN CORE
		OUTHND-1	/POINTER TO DEVICE # AND ENTRY
	CLA CLL
	TAD OLNGTH	/-MAXIMUM ALLOWABLE LENGTH
	TAD BLKCNT	/LENGTH SO FAR
	SZL CLA		/HAS HE GONE TOO FAR?
	JMP OOVER	/YES, KILL HIM
	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
	ION
	JMP CCIF
O2,	DCA I OPTR1	/NORMAL PACKING IS EASY!
	ISZ OPTR1	/BUMP POINTER
CCIF,	HLT		/FILLED WITH CIF CDF
	JMP I NOCHAR

	O3=.		/WHY NOT?
RT,	0		/HALF-WORD PACK ROUTINE
	CLL RTL
	RTL
	DCA ATEM	/SAVE FOR SECOND HALF
	TAD ATEM
	AND [7400
	TAD I OPTR2	/ADD IN CHARACTER IN RIGHT HALF
	DCA I OPTR2	/PACK IT
	ISZ OPTR2	/BUMP POINTER AGAIN
	JMP I RT

OOVER,	DCA OPNFLG	/HE BLEW IT - KILL THE FILE!!
	TAD DEVHLD
	IOF
	CIF 10
	JMS I USR
	4
	ONMTMP
	0		/LENGTH OF ZERO TO DELETE
O7600,	7600		/IGNORE ERRORS
	ERROR1		/BECAUSE WE ALREADY KNOW ABOUT THEM

OSETUP,	0		/RESET ALL THE POINTERS (WHAT FUN!)
	TAD OBLK-1
	DCA OPTR1
	TAD OBLK-1
	DCA OPTR2
	CLA CLL CMA RTL
	DCA O3
	TAD O7600
	DCA OCHCT
	JMP I OSETUP

OPTR1,	0
OPTR2,	0
OLNGTH,	0
OCHCT,	0

	PAGE
	*5400

OOPEN,	JMS I [IOWAIT	/WAIT FOR TELETYPE TO FINISH (DECTAPES ARE SLOW!)
	JMS I [OPEN	/CALL USR, HANDLER; ENTER OUTPUT FILE
YINT,		OUTBLK-1	/OUTPUT HANDLER BLOCK
		3	/MONITOR 'ENTER' CODE
YBLK,	JMP TTYOUT	/'OPEN OUTPUT TTY:'
	JMP OCLCHK	/ERROR ON ENTER - SEE IF FILE ALREADY OPEN
	JMS I [DISMISS	/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
	CLA CLL CMA	/THERE'S A FILE OPEN!
	DCA OPNFLG
	TAD DEVNO	/SAVE FOR CLOSE
	DCA DEVHLD
	DCA I (BLKCNT	/DITTO
ORST,	TAD OPNFLG	/ENTRY FOR 'OPEN RESTORE OUTPUT'
	SNA CLA		/IF 'OPEN OUTPUT', FLAG IS ALREADY SET
	ERROR1		/NO OUTPUT FILE TO RESTORE
	CDF 10
	ISZ ECHFLG	/SKIP IF NO ECHO
	TAD IBLK+2
	DCA I (OUTECH	/SET OUTPUT ROUTINE
	TAD (OCHAR	/POINTER TO FILE OUTPUT ROUTINE
	CIF CDF 10
	DCA I [OUTDEV
	ION
	JMP I [PROC	/FINISH THE LINE
TTYOUT,	TAD [XOUTL	/SWITCH OUTPUT TO TELETYPE (INTERRUPT)
	JMP .-5

FILEST,	TAD I XCHAR	/HERE'S WHERE FILES START!!
	DCA CHAR	/GET NEXT CHAR
	CDF
	TAD (604	/SET '.FD' ASSUMED EXTENSION
	DCA EXTENSION
	TSPNOR		/SKIP SPACES
	TAD CHAR	/SAVE COMMAND CHAR
	TPUSHA
	TGETC
	TESTRM		/GO TO END OF COMMAND WORD
	SKP CLA
	JMP .-3
	TPOPA
	TSORTJ		/GO DO COMMAND
		FILIST-1
		FILGO-FILIST
	ERROR1		/OOPS - BAD 'O' COMMAND

ICHAR,	0		/GET A CHARACTER FROM A FILE
	CLA CLL		/MAKE SURE
	ISZ INCHT	/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
	ION
	ISZ IBLK	/BUMP TO NEXT BLOCK
	TAD IBLK-1	/AND RESTORE POINTERS
	DCA IPNTR
	TAD [7200
	DCA INCHT
ICHAR1,	TAD I IPNTR	/STRAIGHTFORWARD UNPACK ROUTINE
	JMS RDPTR	/DO COMMON CRAP
ICHAR2,	TAD I IPNTR	/SAVE LEFT HALF FOR LATER
	AND [7400
	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 [7400
	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		/IF YOU DIDN'T KNOW, THIS IS A COROUTINE!
	AND [177	/ISN'T THAT AMAZING?
	SNA		/IGNORE NULLS AND PARITY
	JMP ICHAR+1
	TAD (-32	/END OF FILE? (^Z)
	SZA
	JMP .+5		/NO
	DCA IPNFLG	/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 (MIGHT COME IN HANDY)
	CIF CDF 10
	JMP I ICHAR

ITEMP,	0
IPNTR,	0
INCHT,	0
ONMTMP,	ZBLOCK 4

	PAGE
IOPEN,	JMS I [IOWAIT	/WAIT FOR TELETYPE (DECTAPES ARE STILL SLOW!)
	JMS I [OPEN	/CALL THAT AMAZING GENERAL-PURPOSE SUBROUTINE
		INBLK-1
		2	/MONITOR 'LOOKUP'
	JMP TTYIN	/'OPEN INPUT TTY:'
	ERROR1		/WHOOPS - FILE NOT FOUND
	JMS I [DISMISS	/BOOT THE USR OUT
	TAD STBLK	/SET POINTERS AND OTHER CRAP
	DCA I (IBLK
	CLA CLL CMA
	DCA IPNFLG
	CLA CLL CMA
	DCA I (INCHT
IRST,	TAD IPNFLG	/'OPEN RESTORE INPUT' COMES HERE
	SNA CLA		/FLAG IS SET ALREADY IF 'OPEN INPUT'
	ERROR1		/NO INPUT FILE TO RESTORE
	TAD (ICHARF	/SET I/O POINTERS
	CIF CDF 10
	DCA I [INDEV
	ISZ ECHFLG	/AND ECHO MODE
	TAD [PRINTC
	DCA I [PPRNT
	ION
	JMP I [PROC
TTYIN,	TAD [XI33	/'OPEN INPUT TTY:'
	JMP TTYIN-7

MPUSHA,	0		/PUSH THE AC ON THE STACK
	JMS FLDSET	/CALLED FROM EITHER FIELD
	DCA ACDF
	CDF 10		/DO SOME CRAZY, MIXED-UP POINTER SCRAMBLING
	TAD I (PDLXR
	DCA TEM7
	CMA
	TAD TEM7
	DCA I (PDLXR
	TAD TEM7
	CIA CLL
	TAD I [BUFR
	SZL CLA
PDERR,	ERROR1		/PUSHDOWN OVERFLOW
	TAD I (PDLXR
	CDF
	DCA AUTO2
	TAD ATEM
	DCA I TEM7
ACDF,	CIF CDF
	JMP I MPUSHA

MPD2,	0		/PUSH 4 WORDS ON THE STACK
	TAD I MPD2	/GET POINTER TO FIRST WORD
	TAD [3		/PUSH IN REVERSE ORDER
	DCA MPD3
	ISZ MPD2
	JMS FLDSET
	DCA FCDF
	CDF
	TAD [-4
	DCA XCNTR
FCDF,	HLT		/CHANGE FIELD TO CALLING FIELD
	TAD I MPD3	/GET THE NEXT WORD
	CIF CDF
	JMS MPUSHA	/PUSH IT
	CLA CLL CMA	/BACK UP POINTER
	TAD MPD3
	DCA MPD3
	ISZ XCNTR
	JMP FCDF	/GET THE NEXT ONE
	TAD FCDF
	DCA .+1
	0		/RESTORE CALLING FIELD
	JMP I MPD2

MPD3,	0		/POP 4 WORDS
	CLA CLL CMA	/GET POINTER-1
	TAD I MPD3
	DCA AUTO3
	ISZ MPD3
	TAD (CDF
	RDF
	DCA FCIF
	TAD [-4		/FOUR WORDS
	DCA XCNTR
	CDF
	JMS MPOPA	/GET ONE
FCIF,	CDF
	DCA I AUTO3	/PUT IT AWAY
	ISZ XCNTR	/ALL DONE?
	JMP FCIF-2	/NO, GET ANOTHER
	CLL CLA CML RTL	/YES, CHANGE CDF TO CIF CDF
	TAD FCIF
	DCA .+1
	0		/CHANGE FIELD AND EXIT
	JMP I MPD3

MPOPA,	0		/POP A WORD
	JMS FLDSET	/(THIS ONE'S EASY)
	DCA ACIF
	CDF 10
	ISZ I (PDLXR
	CDF
	TAD I AUTO2
ACIF,	CIF CDF
	JMP I MPOPA

FLDSET,	0
	DCA ATEM
	TAD FCDF+2
	RDF
	JMP I FLDSET

XRESTOR,TAD LISTFLG	/PART OF ERROR ROUTINE TO RESET I/O TO TELETYPE
	SZA CLA
	JMS I [SWAPIN	/RESTORE CORE SWAPPED BY DIRECTORY LIST
	CIF CDF 10
	TAD [PRINTC	/'OPEN INPUT TTY:,ECHO;OPEN OUTPUT TTY:'
	DCA I [PPRNT
	TAD [XI33
	DCA I [INDEV
	TAD [XOUTL
	DCA I [OUTDEV
	JMP I .+1
	RECOVY

MSORTC,	0		/CHECK FOR TERMINATOR
	CIF CDF 10
	JMS I [TERMER
	ISZ MSORTC
	JMP I MSORTC

	PAGE
/LIBRARY COMMAND PROCESSOR

	/****** STORAGE ALLOCATION MAP ******
	/*****				*****
	/*	3600	FILES (OUTPUT AND RESTORE)
	/*	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 AND OPEN)
	/*
	/*	5600	PUSHDOWN LIST CONTROLS
	/*	6000	NAME, GTMON, DISMISS, IOWAIT
	/*	6200	HANDAD, COMPARE
	/*	6400	LOWLIB, SAVER, RETURN
	/*	6600	CHAINER, FETCHER, GOSUB
	/*	7000	LIBRARIAN
	/*	7200	MISCELLANEOUS
	/*	7400	LIBRARY HANDLER
	/*****				*****
	/************************************




NAME,	0		/READ A DEV:FILENAME.EX STRING INTO 'NAMLOC' & 'NEWDEV'
	JMS DISMIS	/'GETC' WON'T WITH THE USR IN CORE
	TAD (5723	/CODE FOR 'DSK:'
	DCA NEWDEV	/(DEFAULT DEVICE)
	DCA NEWDEV+1
	JMS GNAME	/GET FIRST PART (MIGHT BE DEVICE)
	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+4	/GET FILENAME

GNAME,	0		/READ A NAME INTO 'NAMLOC'
	DCA NAMLOC	/CLEAR NAME AREA
	DCA NAMLOC+1	/(DON'T CLEAR ASSUMED EXTENSION)
	DCA NAMLOC+2
	TAD [NAMLOC	/INITIALIZE POINTERS
	DCA NMBASE
	CLA CMA
	DCA PERDSW
	DCA NAMECT
	TSPNOR
	SKP
NAMEC,	TGETC		/MAIN LOOP
	TAD CHAR	/LOWER FIELD COPY, OF COURSE
	TAD [-".	/EXTENSION?
	SNA
	JMP PERD	/YES, CLEAR DEFAULT EXTENSION
	TAD [".-",	/COMMA?
	SNA CLA
	JMP ECHCHK	/YES, CHECK FOR ECHO
ECHGO,	JMS DECODE	/MUST BE A-Z, 0-9
	JMP I GNAME	/IT WASN'T, MUST BE END OF NAME
	SZL		/RESTORE CHARACTER
	TAD [57
	IAC
	DCA DECODE	/TEMPORARY STORAGE
	TAD NAMECT	/NO MORE THAN 6 CHARACTERS/NAME
	TAD [-6
	SMA CLA
	JMP NAMEC
	TAD NAMECT	/BUILD POINTER TO CHARACTER POSITION
	CLL RAR
	TAD NMBASE
	DCA TT
	TAD DECODE	/LEFT OR RIGHT HALF?
	SZL
	JMP .+4
	CLL RTL		/LEFT, SHIFT OVER
	RTL
	RTL
	TAD I TT	/ADD IN OTHER HALF
	DCA I TT
	ISZ NAMECT	/BUMP COUNT
	JMP NAMEC	/CONTINUE LOOP

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 [4
	JMP NAMEC-3

ECHCHK,	TGETC		/MOVE PAST COMMA
	TSPNOR
	TAD CHAR	/MUST BE FOLLOWED BY 'ECHO'
	TAD [-"E
	SZA CLA
	JMP I GNAME
	DCA ECHFLG	/SET ECHO FLAG
	TGETC		/MOVE TO END OF WORD
	JMS DECODE
	JMP I GNAME
	CLA CLL
	JMP .-4

DECODE,	0		/CHECK FOR A-Z, 0-9
	TAD CHAR
	TAD [-"9-1
	CLL
	TAD ["9+1-"0
	SZL
	JMP DCDYES
	TAD ["0-"Z-1
	CLL CML
	TAD ["Z-"A+1
	SNL
DCDYES,	ISZ DECODE	/IT WAS!
	JMP I DECODE

NMBASE,	0
PERDSW,	0
NAMECT,	0
TT,	0

IOWAIT,	0		/WAIT FOR TELETYPE TO FINISH
	ION
	CDF 10
	TAD I (TELSW	/BUSY FLAG IS ZERO WHEN THROUGH
	SZA CLA
	JMP .-2
	CDF
	IOF
	JMP I IOWAIT

GTMON,	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 GTMON

DISMIS,	0		/IF THE USR IS IN, KICK IT OUT
	CLA CLL
	TAD USR		/CHECK POINTER TO FIND OUT
	SPA CLA
	JMP I DISMIS
	IOF
	CIF 10
	JMS I USR
	11
	TAD ECHGO+10	/RESET POINTER
	DCA USR
	JMP I DISMIS

	PAGE
HANDAD,	0		/LOADS HANDLER INTO PROPER SLOT
	TAD I HANDAD	/WHICH SLOT?
	ISZ HANDAD
	DCA SLOT
	JMS 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 AUTO5
	TAD I AUTO5	/(SET BY 'COMPARE')
	DCA DEVNO	/MOVE DEVICE # (FOR SAVE AND CLOSE)
	TAD AUTO5	/POINTS TO DEVICE #
	DCA .+2
	JMS I [PUTDEV	/SO USR KNOWS IT'S IN CORE
		0
	JMP I HANDAD

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
	JMS I [GTMON	/WE MUST CALL THE 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
DLOAD,	0
	ERROR1		/DEVICE NOT AVAILABLE OR TWO PAGE HANDLER
	CLL
	TAD DLOAD	/ENTRY POINT FOR HANDLER
	TAD [200	/IF THIS HANDLER IS IN PAGE 7600,
	SZL CLA		/DON'T BOTHER TO CHECK FOR LEGALITY
	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 I [PUTDEV	/TELL USR THE HANDLER IS NOT
		DEVC+1	/IN CORE ANYMORE
	JMP RETRY	/LOAD IT THIS TIME

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 HANDAD

COMPARE,0		/COMPARE TWO BLOCKS OF INDEFINITE LENGTH
	TAD I COMPARE	/CALLING SEQUENCE:
	ISZ COMPARE	/JMS COMPARE
	DCA XCNTR	/	-# OF WORDS TO CHECK
	TAD I COMPARE	/	FIRST-1
	ISZ COMPARE	/	SECOND-1
	DCA AUTO5	/RETURN IF MATCH
	TAD I COMPARE	/RETURN IF NO MATCH
	ISZ COMPARE
	DCA AUTO6
AGAIN,	TAD I AUTO5	/COMPARE TWO WORDS
	CIA
	TAD I AUTO6
	SZA CLA
	JMP I COMPARE	/NO MATCH
	ISZ XCNTR	/FINISHED?
	JMP AGAIN	/NO, CHECK NEXT TWO
	ISZ COMPARE	/YES, BUMP RETURN POINTER
	JMP I COMPARE

MPRINTC,0		/CROSS-FIELD 'PRINTC'
	CIF CDF 10
	JMS I (CPRNT
	JMP I MPRINTC

TABCNT,	0		/TAB COUNTER (ONLY PRINTING CHARACTERS)
	TAD (-15	/7-BIT CR MEANS RETURN ONLY
	SNA
	JMP CRONLY
	TAD [-200	/CHECK FOR CR
	SNA
	JMP NEWLIN	/TYPE CR,LF
	ISZ TABCNT
	TAD (215-240
	SMA
	ISZ I TABCPT	/IT PRINTS, INCREMENT COUNT
	NOP		/IT JUST MIGHT SKIP
	TAD [240
	CIF 10
	JMP I TABCNT

CRONLY,	TAD [215
	CIF 10
	JMS I [PRINTX
	DCA I TABCPT
	TAD [200	/NULL FOR DELAY
	JMP TABCNT+1

NEWLIN,	DCA I TABCPT
	JMP CRONLY-2

TABCPT,	TABC

COMLIST,"S		/SAVE
	"C		/CALL
	"R		/RUN
	"L		/LIST
	"D		/DELETE
	"G		/GOSUB
	" 		/FAKE A 'LIBRARY RETURN' WITH A SPACE
	"E		/EXIT

FILGO,	IOPEN
	OOPEN
	OCLOSR
	RESTOR

	PAGE
	/ACTUAL LIBRARY PROCESSOR
	/STARTING WITH COMMAND DECODE:

LOWLIB,	CDF 10		/CLEAR SWITCH FOR NORMAL RETURN
	DCA I [GOSWITCH	/I.E. TO 'PROC' FOR REST OF LINE
	TAD I XCHAR	/MOVE CURRENT CHARACTER DOWN
	CDF
	DCA CHAR
	TAD CHAR	/SAVE FOR COMMAND SORT
	TPUSHA
	TAD [603	/'.FC' ASSUMED EXTENSION
	DCA EXTENSION
	SKP CLA		/MIGHT BE A TERMINATOR ALREADY
	TGETC		/MOVE TO END OF COMMAND WORD
	TESTRM
	SKP
	JMP .-3
	TPOPA		/RESTORE COMMAND CHAR
	TSORTJ		/AND BRANCH TO APPROIATE ROUTINE
		COMLIST-1
		PCOMGO-COMLIST
	ERROR1		/SORRY, CHARLIE!

PCOMGO,	SAVER
	FETCHER
	CHAINER
	LIBRARIAN
	PDELET
	GOSUB
	PRETRN
C7600,	7600

SAVER,	JMS I [NAME	/GET NAME FOR SAVE
	JMS PSAVE	/DO IT
	JMP PEXIT	/EASY, WASN'T IT?

PSAVE,	0		/CALLED BY 'SAVE' AND 'GOSUB'
	JMS OCHK	/CLOSE OUTPUT FILE TO AVOID TROUBLE
	TAD [NAMLOC	/POINTER TO NAME
	DCA SAVEPT
	CDF 10
	TAD I [BUFR	/GET PROGRAM LENGTH
	CDF
	DCA I [207	/SAVE IT WITH THE PROGRAM
	JMS I [GTMON	/CALL THE MONITOR
	JMS I [HANDAD	/AND THE HANDLER
		LIBBLK-1
	TAD I [207	/SAVED LENGTH, REMEMBER?
	AND C7600	/MASK OFF
	CLL RAR		/CONVERT TO PAGES
	DCA BLOCK	/FOR HANDLER
	TAD BLOCK	/ROUND UP TO BLOCKS
	TAD [100
	AND C7600
	CLL RTR
	RAR
	DCA RECORD	/FOR MONITOR 'ENTER'
	TAD RECORD	/GET DESIRED LENGTH
	TAD DEVNO	/(SET BY 'HANDAD')
	CIF 10
	JMS I USR	/ENTER OUTPUT FILE
	3
SAVEPT,	NAMLOC
	0
	ERROR1		/NO ROOM ON DEVICE
	TAD RECORD	/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
	CLL CML RAR	/COMPUTE FUNCTION WORD
	IAC		/SET TO SEARCH FORWARD
	TAD BLOCK	/HOW MUCH TO WRITE
	DCA BLLL
	JMS I LIBHND
BLLL,	0		/WRITE (BLOCK) BLOCKS FROM FIELD 0
	200		/FROM 200 UP
POINT4,	0
	JMP I [DERR	/GO COMPLAIN ABOUT DEVICE
	JMP I PSAVE

LIBLEN,	0
LIBDEV,	ZBLOCK 2
RECORD,	0
BLOCK,	0

PRETRN,	TPOPA		/GET BACK ALL THE JUNK WE SAVED
	CDF 10		/FOR THE LAST GOSUB
	DCA I XCHAR	/IN-LINE CHARACTER
	CDF
	TPOPF		/DEVICE NAME
		NEWDEV
	TPOPA		/FILE LENGTH
	DCA FLNGTH
	TPOPA		/STARTING BLOCK
	DCA STBLK
	JMS I [HANDAD	/GET THE HANDLER BACK
		LIBBLK-1
	JMP LOADGO	/LOAD THE PROGRAM

OCLOSR,	JMS I [OCLOSE	/CLOSE OUTPUT FILE
	CIF CDF 10
	JMP I [PROC	/ANOTHER EASY ONE!

PUTDEV,	0		/TELL THE MONITOR A HANDLER IS IN OR OUT
	TAD I PUTDEV	/GET POINTER TO DEV # AND ENTRY
	DCA RECORD
	TAD I RECORD	/DEVICE #
	ISZ RECORD	/BUMP POINTER TO ENTRY
	TAD (7646	/MONITOR TABLE
	DCA BLOCK	/POINTER TO 'HANDLER-IN-CORE' FLAG
	TAD I RECORD	/FLAG IS HANDLER ENTRY
	CDF 10		/TABLE IS IN FIELD 1
	DCA I BLOCK
	CDF
	ISZ PUTDEV
	JMP I PUTDEV

	PAGE
	/LOOKUP AND LOAD ROUTINES

CHAINER,IAC		/THESE ALL DO THE SAME THING
GOSUB1,	IAC		/AND THEN GO TO DIFFERENT PLACES
FETCHER,IAC
	CDF 10
	DCA I [GOSWITCH
	CDF
LOAD,	JMS I [OPEN	/CALL THE HANDLER AND LOOKUP THE FILE
		LIBBLK-1
		2
	JMP .+5		/TTY: NOT A DIRECTORY DEVICE
	ERROR1
	JMS I [DISMISS
	JMS I (GETDEV	/GET DEVICE TYPE
	SMA CLA
	ERROR1		/NOT A DIRECTORY DEVICE
	TGETLN		/SOME COMMANDS HAVE LINE NUMBERS
LOADGO,	JMS I [DISMISS	/ONLY USED BY 'RETURN'
	TAD STBLK	/BLOCK TO READ FROM
	DCA POINT6
	TAD AUTO2	/GET PUSHDOWN POINTER
	TAD [-200	/DIDDLE IT
	AND [7600
	CLL RAL
	RTL
	RTL
	TAD FLNGTH	/NOW COMPARE WITH LENGTH OF FILE
	SPA CLA
	JMP PDERR	/PROGRAM TOO LONG
	CDF 10
	CLA CLL CMA RAL	/(=-2)
	TAD I [GOSWITCH	/IS THIS A GOSUB?
	SZA CLA
	JMP .+7		/NO, SKIP THIS GARBAGE
	TAD I XCHAR	/YES, SAVE PROGRAM NAME, ETC.
	CDF
	TPUSHA
	TAD [215
	CDF 10
	DCA I XCHAR
	CDF
	TAD FLNGTH	/COMPUTE FUNCTION WORD
	CIA
	CLL RTL
	RTL
	RTL
	CLL CML RAL	/SET TO SEARCH FORWARD
	DCA LENF1
	JMS I LIBHND	/GET THE PROGRAM
LENF1,	3600
	0200
POINT6,	0
	JMP I [DERR
	TAD NEWDEV	/SAVE THIS STUFF SO WE
	DCA LIBDEV	/KNOW WHERE WE ARE
	TAD NEWDEV+1
	DCA LIBDEV+1
	TAD STBLK
	DCA LIBFIL
	TAD FLNGTH
	DCA LIBLEN
	TAD I [207	/MOVE PROGRAM LENGTH
	CDF 10
	DCA I [BUFR
	CDF
	JMP PEXIT	/GO TO APPROPRIATE ROUTINE

GOSUB,	TAD LIBFIL	/CHECK FOR CURRENT PROGRAM
	SZA
	JMP NOSAVE	/NO NEED TO SAVE CORE
	TPUSHF		/MOVE 'FOCAL.TM' TO NAME AREA
		FOCTXT
	TPOPF
		NAMLOC
	TAD (5723	/DEVICE 'DSK' FOR SAVE
	DCA NEWDEV
	DCA NEWDEV+1
	JMS PSAVE	/SAVE FILE (THIS WILL LEAVE USR IN CORE)
	TAD [603	/RESET EXTENSION TO 'FC'
	DCA EXTENSION
	JMS I [DISMISS	/KICK MONITOR OUT TO SAVE STARTING BLOCK
	TAD LIBFIL
NOSAVE,	TPUSHA		/'LIBFIL' STILL IN AC
	TAD LIBLEN
	TPUSHA
	TPUSHF
		LIBDEV
	JMP GOSUB1

XTSPNOR,0		/DUPLICATE UPPER FIELD ROUTINE
	TAD CHAR
	TAD [-240
	SZA CLA
	JMP I XTSPNOR
	TGETC
	JMP XTSPNOR+1

TTYTXT,	DEVICE TTY	/HANDY THING TO HAVE

MSORTJ,	0		/ANOTHER DUPLICATE
	CIA
	DCA ATEM
	TAD I MSORTJ
	ISZ MSORTJ
	DCA AUTO4
	TAD I AUTO4
	SPA
	JMP MSEX
	TAD ATEM
	SZA CLA
	JMP .-5
	TAD AUTO4
	TAD I MSORTJ
	DCA ATEM
	TAD I ATEM
	DCA ATEM
	JMP I ATEM

MSEX,	ISZ MSORTJ
	CLA CLL
	JMP I MSORTJ

FILIST,	"I		/INPUT
	"O		/OUTPUT
	"C		/CLOSE
	"R		/RESTORE

	PAGE
	/THIS SECTION DOES THE DIRTY WORK OF LISTING
	/ALL "FC"'S AND "FD"'S ON THE DEVICE REFERENCED
	/IT WAS FUN...

LIBRARIAN,	JMS I [NAME	/GET DEVICE TO LIST
	JMS I [HANDAD	/GET THE HANDLER
		LIBBLK-1
	JMS I [DISMISS	/KICK OUT USR (IN CASE HANDAD CALLED IT)
	JMS GETDEV	/FIND DEVICE TYPE
	SMA CLA
	ERROR1		/CAN'T LIST A NON-DIRECTORY DEVICE
	JMS I SHNDLR	/SWAP OUT CORE TO MAKE ROOM FOR DIRECTORY
	4200
	1000
	40		/SYSTEM SCRATCH AREA
	JMP I [DERR	/WHOOPS!
	CLA IAC		/SET FLAG TO SWAP BACK IN
	DCA LISTFLG
	CLL CLA IAC	/DIRECTORY BEGINS WITH BLOCK 1
BLOKLP,	DCA LBLOCK
	IOF
	JMS I LIBHND
	0200
	1000
LBLOCK,	1
	JMP I [DERR
	TAD (1004	/FIRST 5 WORDS ARE INFORMATION
	DCA AUTO4
LOOP2,	TAD AUTO4	/SAVE FOR LATER
	DCA AUTO8
	TAD AUTO4
	DCA LIBX
	TAD I AUTO4	/LOOKING FOR .FC & .FD FILES
	SNA CLA
	JMP PATCH	/ZERO FILE
	ISZ AUTO4
	ISZ AUTO4
	TAD I AUTO4	/PICK UP EXTENSION
	DCA LBLOCK
	TAD I (1004	/WASTE WORDS (NEGATIVE)
	CIA		/THANKS FOR TELLING US, RITCHIE
	TAD AUTO4	/SKIP TO LENGTH
	DCA AUTO4
	TAD I AUTO4	/ZERO LENGTH MEANS TEMPORARY FILE
	SNA
	JMP LOOP3	/IGNORE SUCH THINGS
	CLL CIA
	DCA FLNGTH	/SAVE POSITIVE LENGTH
	TAD NAMLOC	/IF A NAME WAS GIVEN, SEE IF WE
	SNA CLA		/HAVE REACHED IT YET
	JMP TESTGO	/NO NAME
	JMS I [COMPARE	/COMPARE THIS NAME WITH ARG
		-4
LIBX,		0
		NAMLOC-1
	JMP LOOP3	/NON-MATCHING
	DCA NAMLOC	/WE FOUND IT, DON'T CHECK ANY MORE
TESTGO,	TAD LBLOCK	/COMPARE EXTENSION
	TAD (-604	/DO WE WANT THIS ONE?
	SZA
	IAC
	SZA CLA
	JMP LOOP3	/GUESS NOT
DIRLIST,CLA CLL CMA RTL	/PRINT 3 WORDS
	DCA COUNT
	TAD I AUTO8/SET BEFORE THIS
	JMS NPACK	/PRINT 2 CHARS
	ISZ COUNT
	JMP .-3
	TAD (".
	TPRINTC
	TAD I AUTO8	/PRINT EXTENSION
	JMS NPACK
	TAD (PTABLE	/SET UP FOR DECIMAL LENGTH PRINT
	DCA POINT
ZLOOP,	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 PDIGIT	/YES, PRINT THIS DIGIT
	DCA FLNGTH	/NO, GO THROUGH THE LOOP AGAIN
	ISZ COUNT	/ADD ONE TO THIS DIGIT
	JMP NLOOP	/ANOTHER DIVIDE CYCLE

PDIGIT,	CLA CLL		/CRAP IN AC
	ISZ POINT	/NEXT POWER OF TEN
	TAD COUNT	/IF THIS DIGIT IS ZERO,
	ISZ ZERSW	/AND NO OTHER DIGITS HAVE BEEN NON-ZERO,
	SZA		/PRINT A SPACE INSTEAD
	JMP NPRNT
	TAD [240
	TPRINTC
	JMP ZLOOP
NPRNT,	TAD [260	/CHANGE TO ASCII
	TPRINTC
	CLA CLL CMA	/SET ZERO SWITCH
	JMP ZLOOP
NEND,	TAD [215	/DONE WITH THIS LINE (WHEW!)
	TPRINTC
	JMP LOOP3

PATCH,	ISZ AUTO4	/BUMP PAST EMPTY LENGTH
LOOP3,	ISZ I LBLOCK-1	/DONE WITH THIS BLOCK?
	JMP LOOP2	/NO, KEEP GOING
LEXIT,	JMS I [IOWAIT	/WAIT FOR I/O
	TAD I [1002	/LINK TO NEXT BLOCK
	SZA		/LAST BLOCK?
	JMP BLOKLP	/NO, GET THE NEXT
	JMS SWAPIN	/YES, RESTORE SWAPPED CORE AND EXIT
	JMP PEXIT

GETDEV,	0		/GET DEVICE TYPE FROM MONITOR TABLE
	TAD [7757	/DCB-1
	TAD DEVNO
	DCA COUNT
	CDF 10
	TAD I COUNT
	CDF
	JMP I GETDEV

	DECIMAL
PTABLE,	-1000
	-100
	-10
	-1
	0
	OCTAL

	POINT=NEWDEV
	ZERSW=NEWDEV+1
POINT7,	0
COUNT,	0

	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
	CLA CLL CMA	/INITIALIZE ECHO FLAG TO OFF
	DCA ECHFLG
	JMS I [NAME	/GET DEVICE AND FILENAME
	JMS I [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 [NAMLOC	/POINTER TO NAME
	DCA NAMPT
	JMS I [GTMON
	JMS I [HANDAD	/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 THROUGH ON ERROR)
	TAD DEVNO	/DO THE CALL
	CIF 10
	JMS I USR
CALL,	0
NAMPT,	NAMLOC
LNGTH,	0
	JMP OTHER-2	/LET THE CALLING ROUTINE DECIDE ERROR PROCEDURE
	TAD LNGTH	/MOVE PARAMETERS TO PAGE ZERO
	DCA FLNGTH
	TAD NAMPT
	DCA STBLK
	JMP OTHER-3	/AND TAKE NORMAL RETURN

ERROR,	0		/LOWER FIELD ERROR ROUTINE
	JMS I [DISMIS	/MAKE SURE
	TAD ERROR	/FAKE OUT ERROR ROUTINE
	CIF CDF 10	/AND GO TO IT
	DCA I (ERR2
	JMP I (ERR2+1

PDELET,	JMS I [NAME	/DELETE IS AN EASY ONE (THANK GOD!)
	JMS I [GTMON
	JMS I [HANDAD
		LIBBLK-1
	JMS OCHK	/CLOSE ANY OPEN OUTPUT FILE
	CIF 10		/DELETE THE FILE
	TAD DEVNO
	JMS I USR
	4
	NAMLOC
	0
	ERROR1
	DCA LIBFIL	/IN CASE HE JUST DELETED THIS PROGRAM
	JMP PEXIT

OCHK,	0		/IF ANY FILE EXISTS, CLOSE IT
	TAD DEVHLD
	SZA CLA
	JMS OCLOSE
	JMP I OCHK

SWAPIN,	0		/RESTORE CORE AFTER DIRECTORY LIST
	DCA LISTFLG
	IOF
	JMS I SHNDLR
	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
	SZA		/PRINT SPACES FOR NULLS
	TAD (-40
	SPA
	TAD [100
	TAD [240
	TPRINTC
	JMP I XFORM

OCLCHK,	TAD OPNFLG	/MAKE 'OPEN OUTPUT' WITH AN ALREADY OPEN FILE
	SNA CLA		/THE SAME AS 'OUTPUT CLOSE;OPEN OUTPUT'
	ERROR1
	JMS OCLOSE
	TAD (YINT	/FAKE OUT 'OPEN'
	DCA OPEN
	JMP OTHER

MGETLN,	0		/CROSS-FIELD FAKE
	CIF CDF 10
	JMS I (PGETLN
	JMP I MGETLN

FOCTXT,	FILENAME FOCAL.TM	/USED BY 'GOSUB'

XGETC,	0		/ANOTHER FAKE
	CIF CDF 10
	JMS I (MGETC
	TAD I XCHAR
	CDF
	DCA CHAR
	JMP I XGETC

	PAGE

	FIELD 1