<div id='wikitext'>
<pre><b> File: OS8F.PA of Tape: Sources/RTS/s3</b></pre>
<pre><b>(Source file text) </b></pre>
<hr />
<pre>
/OS/8 FILE SUPPORT TASK

/PROVIDES RTS-8 TASKS WITH THE FACILITY TO LOOKUP, ENTER
/AND DELETE FILES IN OS/8 DIRECTORIES.

TASK=	OS8F
CUR=	0
INIWT=	0
PARTNO=	0
CPABLE=	0
WRITE=	1

/THE FORMAT OF A MESSAGE TO THIS TASK IS:
/WORD 1		MESSAGE EVENT FLAG
/WORDS 2&amp;3	RESERVED FOR RTS-8
/WORD 4		FUNCTION WORD:
/    BITS 0-1	00=LOOKUP,10=DELETE,01=11=ENTER
/    BITS 3-8	TASK NUMBER OF DEVICE HANDLER
/    BITS 9-11	UNIT NUMBER
/WORD 5		POINTER TO FILE NAME
/WORD 6		GETS A 0 IF SUCCESSFUL, ERROR CODE IF NOT
/WORD 7		GETS BLOCK NUMBER AFTER SUCCESSFUL LOOKUP OR ENTER
/WORD 8		GETS FILE LENGTH AFTER LOOKUP
/		SPECIFIES DESIRED FILE LENGTH ON ENTER

/PAGE 0 LOCATIONS: IN FILE PG0F0.PA
/OS8 FILE SUPPORT INTERLOCK TEST ROUTINE
/ON ENTRY, XR POINTS TO HNDTAB AND LENGTH=-17(8)

	FIELD 0
	*6000

CKINTL,	0
	TAD	(HNDTAB
	DCA	XR	/PREPARE TO CHECK OS/8 INTERLOCK
	TAD	(-17
	DCA	LENGTH
WTINTL,	CAL		/WAIT FOR OS/8 TO REACH A STATE IN WHICH
	WAITE+FREE	/THERE IS NO POSSIBILITY OF AN ACTIVE
PINTLK,	INTLOK		/DIRECTORY BUFFER IN THE USR.
HNDLP,	TAD I	(FN
	AND	(1777	/SEE IF OUR DEVICE IS IN THE OS/8 SYSTEM
	CIA
	TAD I	XR	/BY SEARCHING THE OS8 SUPPORT TASK&#039;S
	SNA CLA		/TABLES FOR IT
	JMP	FNDOSD	/FOUND IT
	ISZ	LENGTH
	JMP	HNDLP	/KEEP LOOKING
	JMP I	CKINTL	/NOT THERE - NO INTERLOCK
FNDOSD,	TAD	XR
	TAD	(OS8DCB-1-HNDTAB
	DCA	LENGTH	/GET POINTER INTO THE DCB ENTRY FOR THE
	CDF OS8F1	/DEVICE INVOLVED
	TAD I	LENGTH
	AND	(7	/CHECK FOR OPEN OUTPUT FILE ON THE DEVICE
	CDF CUR
	SNA CLA
	JMP I	CKINTL	/NONE - NO INTERLOCK
	ISZ	INTLOK	/OOPS - WE CAN&#039;T TOUCH DIRECTORY NOW
	JMP	WTINTL	/WAIT UNTIL THE NEXT QUIET MOMENT

	PAGE

START,	CAL
	RECEIVE+FREE	/WAIT FOR A MESSAGE AND PULL IT IN
MADDR,	0
	DCA	MSGCDF
	JMS	MCDF	/SET DF TO MESSAGE FIELD
	TAD I	MADDR
	DCA	FN	/SAVE FUNCTION
	ISZ	MADDR
	TAD I	MADDR
	DCA	PTNAME	/SAVE PTR TO FILE NAME
	ISZ	MADDR
	CDF CUR
	TAD	FN
	AND	(7
	DCA	UNIT	/UNIT NUMBER IN BITS 9-11 OF FUNCTION WORD
	TAD	FN
	CLL RTR
	RAR
	AND	(77	/HANDLER&#039;S TASK NUMBER IN BITS 3-8
	DCA	IOTASK
	TAD	FN
	CLL RAL
	SPA CLA		/FUNCTIONS ARE:
	JMP	ENTER	/0000=LOOKUP, 2000=DELETE, 4000&amp;6000=ENTER
	SNL CLA
	JMP	LOOKUP
	JMS I	(PURGE	/DELETE - PURGE FILE NAME FROM OS/8 DIRECTORY
NOFILE,	IAC		/ERROR RETURN - SET STATUS CODE
FINI,	JMS	MCDF
	DCA I	MADDR	/STORE STATUS CODE
	ISZ	MADDR
	TAD	BLOCK
	DCA I	MADDR
	ISZ	MADDR
	TAD	LENGTH	/STORE BLOCK NUMBER AND LENGTH IN MESSAGE
	DCA I	MADDR
	IFDEF	OS8	&lt;
	TAD	(OS8
	CAL		/RESUME OS/8 EXECUTION
	RUN
	&gt;
	TAD	MSGCDF
	DCA	MEFCDF
	TAD	MADDR
	TAD	(-7
	CAL
	POST
FN,
MEFCDF,	0		/POST MESSAGE EVENT FLAG
	JMP	START	/GET NEXT MESSAGE

MCDF,	0
MSGCDF,	HLT
	JMP I	MCDF
LOOKUP,	JMS I	(MDSRCH	/FIND FILE NAME IN DIRECTORY
	JMP	NOFILE	/NOT FOUND
	JMP	FINI	/FOUND.

ENTER,	JMS I	(PURGE	/DELETE PREVIOUS COPY OF FILE
	NOP		/FILE NOT FOUND - WHO CARES?
	AC0002
	TAD	MADDR
	DCA	LENGTH
	JMS	MCDF
	TAD I	LENGTH	/GET DESIRED LENGTH
	CDF CUR
	JMP I	(ENTERX

MRDCAT,	0		/DIRECTORY READ ROUTINE
	DCA	DBLOCK	/ENTER WITH BLOCK NUMBER IN AC
	JMS	MREADC	/READ DIR BLK
	TAD I	(DSTBLK
	DCA	BLOCK	/INITIALIZE BLOCK NUMBER FROM DIRECTORY HEADER
	TAD I	PDCNT
	DCA	NFILES	/INITIALIZE FILE COUNT
	TAD	(DBODY-1
	DCA	XR	/INITIALIZE DIRECTORY FILE PTR
	JMP I	MRDCAT

MREADC,	0		/LOW-LEVEL DIRECTORY READ/WRITE ROUTINE
	TAD	(200+CUR
	DCA	IOCTLW	/STORE READ OR WRITE CONTROL WORD
	CAL
	SENDW+FREE
IOTASK,	0
	IOMSG
	TAD	IOSTAT
	SZA
	JMP	FINI	/I/O ERROR - RETURN I/O STATUS AS ERROR
	TAD I	PDCNT
	CMA CLL
	TAD I	(DLINK
	AND	(7700
	SNL		/VALIDATE THE DIRECTORY BUFFER
	SZA CLA
	SKP		/BAD
	JMP I	MREADC
	AC4000
	JMP	FINI	/ERROR 4000 - BAD OS/8 DIRECTORY BLOCK

MEOVLS,	ZBLOCK	10	/TEMPORARY STORAGE FOR DIRECTORY EXPANDER
	PAGE
ENTERX,	DCA	LENGTH	/STORE DESIRED LENGTH
RENTER,	DCA	EPTR	/SET FOUND POINTER TO 0
	CLA IAC
ENSEGL,	JMS I	(MRDCAT	/GET NEXT DIRECTORY SEGMENT
ENSRCL,	TAD I	XR	/GET NEXT ENTRY
	SNA CLA
	JMP	EMPTY	/IT&#039;S EMPTY
	AC7775		/IT&#039;S A FILE - SKIP IT
	JMS I	(BUMPXR
	TAD I	XR
ELEND,	CIA
	TAD	BLOCK	/UPDATE BLOCK NUMBER
	DCA	BLOCK
	ISZ	NFILES
	JMP	ENSRCL
	TAD	EPTR
	SZA CLA		/DID WE FIND A SUITABLE EMPTY IN THIS SEGMENT?
	JMP	EINRTS	/YES
	TAD I	(DLINK	/NO - GO TO NEXT SEGMENT
	SZA
	JMP	ENSEGL
ENTERR,	AC0002		/NO MORE SEGMENTS - ENTER ERROR
	JMP I	(FINI

EMPTY,	TAD I	XR
	DCA	ETMP	/SAVE LENGTH OF EMPTY
	TAD	EPTR
	SZA CLA		/DO WE ALREADY HAVE A GOOD EMPTY?
	JMP	ENOGD	/YES - DISREGARD THIS&#039;N
	CLL STA
	TAD	ETMP
	TAD	LENGTH
	SNL CLA		/IS IT LARGE ENOUGH?
	JMP	ENOGD	/NO
	TAD	XR
	DCA	EPTR
	TAD	BLOCK
	DCA	EBLOCK
ENOGD,	TAD	ETMP
	JMP	ELEND	/UPDATE BLOCK NUMBER
EINRTS,	TAD	XR
	DCA	ETMP	/SAVE POINTER TO END OF SEGMENT
	TAD I	EPTR	/GET LENGTH OF GOOD EMPTY
	TAD	LENGTH
	SNA CLA		/CHECK FOR EXACT FIT
	AC0002		/YES - EMPTY WILL DISAPPEAR
	TAD	(-4
	JMS I	(BUMPXR
	JMS	CKOVFL	/CHECK SEGMENT OVERFLOW
	JMS	MOVEUP
	TAD I	EPTR
	TAD	LENGTH
	SNA
	ISZ I	PDCNT	/REDUCE FILE COUNT BY 1 FOR KILLED EMPTY
	NOP
	SZA
	DCA I	XR	/OTHERWISE STORE UPDATED LENGTH
	STA
	TAD	ETMP
	DCA	XR	/RESTORE END-OF-SEGMENT POINTER TO XR
	TAD	(-4
	DCA	ETMP
NMOVLP,	JMS I	(MCDF
	TAD I	PTNAME
	ISZ	PTNAME
	CDF CUR
	DCA I	XR	/MOVE FILE NAME INTO DIRECTORY SEGMENT
	ISZ	ETMP
	JMP	NMOVLP
	CDF 0
	TAD I	(DATE
	CDF CUR
	DCA I	XR	/STORE SYSTEM DATE IN ADDITIONAL INFO WORD #1
	CLA IAC
	JMS I	(BUMPXR
	TAD	LENGTH
	CIA
	DCA I	XR	/STORE LENGTH OF NEW FILE
	STA
	TAD I	PDCNT	/INCREMENT FILE COUNT
	DCA I	PDCNT
	AC4000		/WRITE THIS SEGMENT BACK OUT
	JMS I	(MREADC
	TAD	EBLOCK
	DCA	BLOCK	/RESTORE BLOCK FOR STORING INTO MESSAGE
	JMP I	(FINI
EBLOCK,	0

MOVEUP,	0		/ROUTINE USED BY ENTER AND &quot;NOROOM&quot;
	TAD I	ETMP
	DCA I	XR	/TRANSFER A WORD
	TAD	ETMP
	CMA
	TAD	EPTR
	SNA CLA
	JMP I	MOVEUP	/ENOUGH WORDS - DONE
	STA
	TAD	ETMP
	DCA	ETMP
	AC7776
	TAD	XR
	DCA	XR
	JMP	MOVEUP+1

CKOVFL,	0		/CHECK DIRECTORY SEGMENT OVERFLOW
	TAD I	(DEXTRA
	CIA
	TAD	XR	/MUST BE ROOM FOR 1 DUMMY ENTRY
	TAD	(-DBUF-372
	SMA CLA
	JMP I	(NOROOM	/THERE ISN&#039;T - MUST ADJUST SEGMENTS
	JMP I	CKOVFL
	PAGE
MDSRCH,	0		/DIRECTORY SEARCH ROUTINE
	CLA IAC
SRSEGL,	JMS I	(MRDCAT
MDSRCL,	TAD	PTNAME
	DCA	PTN	/GET POINTER TO FILE NAME WORD 1
	TAD	(-4
	DCA	CT
	TAD I	XR
	SNA		/CHECK TYPE OF ENTRY
	JMP	SKPMTF	/EMPTY
	SKP		/SKIP INTO SEARCH LOOP
SRCWDL,	TAD I	XR
	CIA
	JMS I	(MCDF
	TAD I	PTN
	ISZ	PTN
	CDF CUR
	SZA CLA		/COMPARE FILE NAME AGAINST DIRECTORY ENTRY
	JMP	NXTFIL
	ISZ	CT
	JMP	SRCWDL
	JMS	BUMPXR	/SUCCESSFUL MATCH
	TAD I	XR	/GET LENGTH WORD
	SNA
	JMP	SKPMTF+1	/LENGTH 0 FILES ARE TENTATIVES
	DCA	LENGTH
	ISZ	MDSRCH
	JMP I	MDSRCH	/TAKE SKIP RETURN IF SUCCESS

NXTFIL,	TAD	CT
	IAC
	JMS	BUMPXR	/SKIP TO END OF FILE NAME IN SEGMENT
SKPMTF,	TAD I	XR
	CIA
	TAD	BLOCK	/UPDATE BLOCK NUMBER
	DCA	BLOCK
	ISZ	NFILES
	JMP	MDSRCL
	TAD I	(DLINK	/SEGMENT EXHAUSTED - ON TO NEXT SEGMENT
	SNA
	JMP I	MDSRCH	/NO NEXT SEGMENT - TAKE ERROR EXIT
	JMP	SRSEGL

BUMPXR,	0
	TAD I	(DEXTRA	/GET NUMBER OF ADDITIONAL INFO WORDS
	CIA
	TAD	XR	/BUMP POINTER BY AC+A.I.WORDS
	DCA	XR
	JMP I	BUMPXR

CT,	0
PTN,	0
PURGE,	0		/ROUTINE TO PURGE A FILE FROM THE DIRECTORY
	IFDEF	OS8	&lt;	/MUST INTERLOCK WITH BACKGROUND
	JMS I	(CKINTL	/CHECK IT
	TAD	(OS8	/MADE IT! - SUSPEND OS/8
	CAL		/SO WE WON&#039;T HAVE ANY TROUBLE
	SUSPND
	&gt;
	JMS	MDSRCH	/SEARCH DIRECTORY FOR FILE NAME
	JMP I	PURGE	/NO SUCH FILE - ERROR EXIT
	ISZ	PURGE
	AC7776
	TAD	XR
	DCA	XR	/POINT XR AT LENGTH WORD - 1
	TAD	XR
	DCA	SQP
	ISZ	SQP
	DCA I	SQP	/ZERO LENGTH WORD -1
	AC7775
	TAD I	(DEXTRA
	JMS	SQUISH	/SQUISH OUT FILE NAME, LEAVING EMPTY
	JMS	CONSLD	/ELIMINATE PAIRS OF EMPTIES
	AC4000
	JMS I	(MREADC	/WRITE OUT THIS SEGMENT
	JMP I	PURGE	/AND RETURN

CONSLD,	0		/ROUTINE TO CONSOLIDATE A DIRECTORY
	TAD	(DBODY-1
	DCA	XR
	TAD I	PDCNT
	DCA	CT
CONLP,	TAD I	XR
	SNA CLA
	JMP	PEMPTY	/GOT AN EMPTY - CHECK FOR 2
PSKIPF,	TAD	(-4
	JMS	BUMPXR	/SKIP PAST FILE NAMES
	ISZ	CT
	JMP	CONLP
	JMP I	CONSLD	/DONE - RETURN

PEMPTY,	ISZ	XR
	TAD	XR
	DCA	SQUISH	/SAVE POINTER TO FIRST LENGTH WORD
	ISZ	CT
	SKP
	JMP I	CONSLD	/LAST ENTRY WAS EMPTY - WE&#039;RE DONE
	TAD I	XR
	SZA CLA
	JMP	PSKIPF	/NON-EMPTY - NO SQUISH
	TAD I	XR
	TAD I	SQUISH
	DCA I	SQUISH
	AC7776
	JMS	SQUISH	/SQUISH OUT REDUNDANT EMPTY
	ISZ I	PDCNT
	JMP	CONSLD+1	/START ALL OVER AGAIN
SQUISH,	0		/LOW LEVEL COMPRESS ROUTINE
	TAD	XR
	DCA	SQP
SQLOOP,	TAD I	XR
	ISZ	SQP
	DCA I	SQP
	TAD	XR
	TAD	(-DBUF-377
	SZA CLA
	JMP	SQLOOP
	JMP I	SQUISH

SQP,	0
	PAGE
NOROOM,	TAD I	(DLINK
	SNA CLA		/LAST SEGMENT?
	JMP	MELAST	/YES - SPECIAL PROCEDURE
	ISZ I	PDCNT	/DECREASE ENTRY COUNT BY 1
	AC4000
	JMS I	(MREADC	/WRITE OUT THIS SEGMENT
	JMS	MSKIPF	/FIND END OF SHORT SEGMENT
	DCA	MEFCNT	/INITIALIZE LENGTH COUNTER
	TAD	(MEOVLS-1
	DCA	EPTR
MVLP1,	TAD I	XR
	ISZ	EPTR
	DCA I	EPTR
	ISZ	MEFCNT
	TAD	XR
	CIA
	TAD	ETMP	/MOVE LAST FILE NAME TO SAFE PLACE
	SZA CLA
	JMP	MVLP1
	TAD I	ETMP
	DCA	MEOCNT	/SAVE LENGTH OF LAST ENTRY
	TAD I	(DLINK
	JMS I	(MRDCAT
	JMS I	(CONSLD	/PRE-SQUISH NEW SEGMENT
	TAD I	(DSTBLK
	TAD	MEOCNT	/BUMP DOWN FILE ORIGIN
	DCA I	(DSTBLK
	JMS	MSKIPF	/FIND END OF SEGMENT
	TAD	XR
	DCA	ETMP
	STA
	TAD	MEFCNT
	TAD	XR
	DCA	XR	/BUMP XR BACK BY NEW FILE ENTRY LENGTH
	TAD	(DBODY+1
	DCA	EPTR
	JMS I	(MOVEUP
	TAD	(MEOVLS-1
	DCA	XR
	STA
	TAD I	PDCNT
	DCA I	PDCNT	/INCREASE ENTRY COUNT
	TAD	MEFCNT
	CIA
	JMP	MECOMN
MELAST,	TAD	(7	/MOVE 7 FILES INTO BRAND NEW SEGMENT
	TAD I	PDCNT
	DCA I	PDCNT	/DECREASE ENTRY COUNT BY 7
	JMS	MSKIPF	/FIND NEW END OF SEGMENT
	TAD	DBLOCK
	AND	(7
	IAC
	DCA I	(DLINK	/LINK THIS SEGMENT TO NEW ONE
	TAD I	(DLINK
	TAD	(-7
	SMA CLA		/HAVE WE RUN OUT OF SEGMENTS?
	JMP I	(ENTERR	/YES
	AC4000
	JMS I	(MREADC	/WRITE OUT TRUNCATED BLOCK
	ISZ	DBLOCK	/SET UP TO WRITE NEW BLOCK
	TAD	(-7
	DCA I	PDCNT
	TAD	MEOCNT
	CIA
	TAD I	(DSTBLK	/NEW START BLOCK = OLD START BLOCK
	DCA I	(DSTBLK	/PLUS LENGTH OF OLD SEGMENT
	DCA I	(DLINK	/MARK AS NEW LAST SEGMENT
	TAD	XR
	TAD	(-DBUF-377	/MOVE TOP OF DIRECTORY DOWN
MECOMN,	DCA	MEFCNT
	TAD	(DBODY-1
	DCA	EPTR
MVLP2,	TAD I	XR
	ISZ	EPTR
	DCA I	EPTR	/COPY NEW FILE INTO NEW SEGMENT
	ISZ	MEFCNT
	JMP	MVLP2
	JMS	MSKIPF	/SKIP TO END OF SEGMENT
	TAD	XR
	DCA	ETMP	/SAVE FOR POSSIBLE ITERATION
	JMS I	(CKOVFL	/CHECK FOR NEW SEGMENT OVERFLOW
	AC4000
	JMS I	(MREADC	/WRITE OUT SEGMENT
	JMP I	(RENTER	/START ENTER OVER AGAIN
MSKIPF,	0		/ROUTINE TO SKIP TO END OF SEGMENT
	TAD I	PDCNT
	DCA	MNOFIL
	TAD	(DBODY-1
	DCA	XR
	DCA	MEOCNT	/KEEP RUNNING LENGTH ON THE WAY
MSKPLP,	TAD I	XR
	SNA CLA
	JMP	MEOMTY
	AC7775
	JMS I	(BUMPXR	/BUMP PAST FILE NAME
MEOMTY,	TAD I	XR
	TAD	MEOCNT
	DCA	MEOCNT	/UPDATE LENGTH
	ISZ	MNOFIL
	JMP	MSKPLP
	JMP I	MSKIPF

MNOFIL,	0
MEFCNT,	0
MEOCNT,	0
	PAGE
/-----CAREFUL  --INIT-- OF RTS8 MONITOR GETS ALSO LOADED HERE--------
DBUF=	.		/DIRECTORY BUFFER - FIRST WD IF FILE CT
DSTBLK=	.+1		/STARTING BLOCK FOR FILES IN THIS SEGMENT
DLINK=	.+2		/LINK TO NEXT SEGMENT
DOPTR=	.+3
DEXTRA=	.+4		/NUMBER OF EXTRA WORDS PER FILE ENTRY
DBODY=	.+5		/BODY OF DIRECTORY
</pre>
<hr/>
</div>