/  PS/8 DELETE ROUTINE (DMK)
/0

ZZZ=0
FROM=16
TO=17
CDP=20
IOROUT=21
DCB=7760
USR=200


	FIELD 1
	*2000

DELETE, JMS 7700	/LOCK USR IN CORE
	 10
DELET1,	JMS USR		/CALL CD
	 5
	 0		/NO ASSUMED EXTENSION
	TAD (7617
	DCA CDP		/START OF CD INPUT LIST
	JMS CRLF
DELET2,	TAD I CDP
	ISZ CDP
	SNA		/DONE?
	JMP DELET4	/YES.  TRY AGAIN
	AND (17		/GET DEVICE #
	DCA TEMP
	TAD TEMP
	TAD (DCB-1
	DCA TEMP1	/POINT TO DCB ENTRY
	TAD I TEMP1
	SMA!CLA		/FILE STRUCTURED?
	JMP UNFSER	/NO.  ERROR
	TAD I CDP
	SNA!CLA		/WHOLE DEVICE TYPE FILE
	JMP NOFNER	/YES.  ERROR - NO FILE NAME
	TAD (IOHNDL	/YES
	DCA TEMP1	/ADDRESS FOR HANDLER
	TAD TEMP	/GET DEVICE NUMBER
	JMS USR
	 1
TEMP1,	 ZZZ
	HLT		/FATAL ERROR
	TAD TEMP1
	DCA IOROUT	/SAVE HANDLER ENTRY
	IAC		/DIRECTORY IN BLOCK 1
DELET3,	DCA INBLK
	TAD INBLK
	DCA OUTBLK	/FOR LATER
	CIF 0
	JMS I IOROUT
	 210		/READ 2 PAGE DIRECTORY, FIELD 1
	 BUF
INBLK,	 ZZZ
	JMP IOERR	/READ ERROR
	TAD (BUF-1
	DCA FROM
	TAD I FROM
	DCA NTRCNT	/WORD 0 IS ENTRY COUNT
	TAD I FROM
	CIA
	DCA BLKNUM	/WORD 1 IS FIRST BLOCK REFERENCED
			/BY THIS DIRECTORY
	ISZ FROM
	ISZ FROM
	TAD I FROM	/WORD 4 IS 'EXTRA LENGTH'
	TAD (-4
	DCA LEN		/ENTRY LENGTH -1
	DCA FREEP
	DCA FOUND
	TAD FROM
	DCA TO
	JMP DNSR1	/START SEARCH

IOERR,	CLA!IAC		/HANDLER LEAVES STUFF IN AC
UNFSER, IAC
NOFNER, TAD (ERRTBL
	DCA TEMP1
	TAD I TEMP1
	DCA .+2
	JMS MESAGE
	 ZZZ
	TAD CDP
	TAD (-7617+2-1	/CORRECT FOR AUTO-XR,
			/FIRST ENTRY AT 7617
	CLL!RAR
	TAD (4360	/#DIGIT
	DCA ERR5+6
	TAD CDP
	RAR
	STL!RAL	/POINT TO NEXT ENTRY (ODD LOC.)
	DCA CDP
	JMS MESAGE
	 ERR5
	JMS CRLF
	JMP DELET2

ERRTBL, ERR4;ERR3;ERR1

DELET4, TAD 7642	/CD TERMINATOR IND.
	SMA!CLA		/ALT MODE?
	JMP DELET1	/NO
	CDF!CIF 0	/YES
	JMP 7600

/0
/1

	PAGE

DNSR1,	TAD I FROM	/FIRST WORD
	SZA		/EMPTY ENTRY?
	JMP DNSR4	/NO
DNSR2,	TAD I FROM
	DCA TEMP	/SAVE FREE BLOCK COUNT
	TAD FREEP
	SZA!CLA		/CONSOLIDATING FREE BLOCKS?
	JMP .+6		/YES
	DCA I TO	/NOT YET
	DCA I TO	/MAKE EMPTY ENTRY
	TAD TO
	DCA FREEP	/POINT TO CONSOLIDATION COUNT
	SKP
	ISZ BUF		/ONE LESS FILE
	TAD TEMP
	TAD BLKNUM
	DCA BLKNUM	/UPDATE BLOCK NUMBER
	TAD TEMP
	TAD I FREEP
	DCA I FREEP	/UPDATE FREE BLOCK COUNT
DNSR3,	ISZ NTRCNT	/DONE THIS SEGMENT?
	JMP DNSR1	/NO.  ONWARD...
	CIF 0
	JMS I IOROUT	/YES.  REWRITE BUFFER
	 4210		/WRITE, 2 PAGE, FIELD 1 BUFFER
	 BUF
OUTBLK,  ZZZ
	JMP IOERR	/WRITE ERROR
	TAD FOUND
	SZA!CLA		/FIND FILE YET?
	JMP DELET2	/YES.  NEXT FILE
	TAD BUF+2	/NO.  END OF CHAIN?
	SZA
	JMP DELET3	/NO.  TRY NEXT BLOCK
	HLT		/YES.  HMMM...
	JMP .-1

DNSR4,	DCA TEMP	/SAVE FIRST WORD
	TAD LEN
	CIA
	TAD FROM
	DCA COUNTP	/POINT TO COUNT IN FILE ENTRY
	TAD I CDP
	TAD BLKNUM
	SZA!CLA		/FIND FILE TO DELETE?
	JMP DNSR5	/NO
	ISZ FOUND	/YES.  MARK FOUND
	ISZ CDP		/POINT TO NEXT FILE
	CMA		/-1 FOR AUTO-XR
	TAD COUNTP
	DCA FROM
	JMP DNSR2

DNSR5,	TAD I COUNTP
	SZA!CLA		/ZERO COUNT?
	JMP .+5
	TAD COUNTP	/YES.  TENTATIVE FILE
	DCA FROM
	ISZ BUF		/BEST NOT SKIP (ALWAYS 1 MT ENTRY)
	JMP DNSR3

	TAD LEN
	DCA COUNT
	TAD TEMP	/SAVE FIRST WORD FIRST
	DCA I TO
	TAD I FROM
	DCA I TO
	ISZ COUNT
	JMP .-3
	DCA FREEP	/CLEAR FREE POINTER
	TAD I COUNTP
	TAD BLKNUM
	DCA BLKNUM	/UPDATE BLOCK NUMBER
	JMP DNSR3

COUNT, 0
COUNTP, 0
LEN, 0
BLKNUM, 0
TEMP, 0
NTRCNT, 0
FREEP, 0
FOUND, 0


MESAGE, .-.
	TAD I MESAGE
	ISZ MESAGE
	DCA MESP
MES1,	TAD I MESP
	CLL!RTR
	RTR
	RTR
	JMS MESSUB
	TAD I MESP
	JMS MESSUB
	ISZ MESP
	JMP MES1

MESP, 0

MESSUB, .-.
	AND (77
	SNA
	JMP I MESAGE
	TAD (240
	AND (77
	TAD (240
	JMS TYO
	JMP I MESSUB


/1
	
/2

	PAGE

TYO,	.-.
	TLS
	TSF
	JMP .-1
	CLA
	JMP I TYO

CRLF,	.-.
	TAD (215
	JMS TYO
	TAD (212
	JMS TYO
	JMP I CRLF

ERR1,	TEXT 'I/O ERROR '
ERR3,	TEXT 'NON FILE-STRUCTURED DEVICE '
ERR4,	TEXT 'NO FILE NAME SPECIFIED '
ERR5,	TEXT 'FOR REQUEST # .  CONTINUING'

	PAGE
IOHNDL, ZBLOCK 200
BUF,	ZBLOCK 400

$