Google
 

Trailing-Edge - PDP-10 Archives - bb-d868c-bm_tops20_v4_2020_distr - language-sources/lnkfio.mac
There are 48 other files named lnkfio.mac in the archive. Click here to see a list.
TITLE	LNKFIO - SUBROUTINES TO DO ALL FILE I/O FOR LINK
SUBTTL	D.M.NIXON/DMN/JLd/JBC/JNG/PAH/DZN	24-Aug-79


;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
;  OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;
;COPYRIGHT (C) 1973, 1979 BY DIGITAL EQUIPMENT CORPORATION


SEARCH	LNKPAR,LNKLOW,MACTEN,UUOSYM,SCNMAC
SALL

ENTRY	LNKFIO
EXTERN	.TYOCH,LNKCOR,LNKLOG


CUSTVR==0		;CUSTOMER VERSION
DECVER==4		;DEC VERSION
DECMVR==1		;DEC MINOR VERSION
DECEVR==1220		;DEC EDIT VERSION


SEGMENT


LNKFIO:
SUBTTL	REVISION HISTORY


;START OF VERSION 1A
;65	TENEX SPEEDUPS

;START OF VERSION 2
;135	ADD OVERLAY FACILITY
;136	FIX I.ALC BUG ON DELETE
;170	CHANGE IODATA MACRO FOR PLOT SWITCH
;221	DELETE DVREN. USE DVRNF. INSTEAD
;222	(12773) DO UPDATE MODE ENTER RIGHT FOR DEFAULT PATH

;START OF VERSION 2B
;240	FIX I/O TO UNASSIGNED CHAN IF /SAVE AND HIGH FILE ALREADY EXISTS
;245	REWORK DVLKP. & LKPERR ROUTINES TO BE MORE GENERAL
;	ADD DVCEM. & DVSUP. (ROUTINE TO CHECK FOR SUPERSEDE)
;356	LABEL EDIT 240
;370	FIX LNKINS ERROR DETECT
;400	Support SFD's on output files.

;START OF VERSION 2C
;501	Support SFD's on symbol input and overlay files.
;537	Don't destroy I.PPN in DVRNF. for /SAVE
;557	Clean up listing for release.

;START OF VERSION 3A
;560	Release on both TOPS-10 and TOPS-20 as LINK version 3A(560)

;START OF VERSION 4
;604	Handle device NUL: correctly
;610	Handle output defaulting of ersatz devices correctly.
;610	Don't let libraries confuse DVSUP.
;731	SEARCH MACTEN,UUOSYM
;740	Add code to get F.VER SCAN block field into I/O blocks
;	and ( if input file ) to set version number of all output files.
;765	Release on both TOPS-10 and TOPS-20 as LINK version 4(765)

;START OF VERSION 4A
;1105	Fix edit 740 to not destroy the path to the file if it includes SFDs.
;1122	Remove edit 740.
;1123	Use HRLI instead of HRL to load ENTER error flag.
;1174	Label and clean up all error messages.
;1202	Make LNKNED message be potentially editable after 1174.
;1217	Clean up the listings for release.
;1220	Release on both TOPS-10 and TOPS-20 as version 4A(1220).
SUBTTL	HERE TO SETUP POINTER TO I/O DATA BLOCK


;CALLED BY
;	PUSHJ	P,DVCHN.
;RETURN
;	T1 = POINTER
;EXPECTS I/O CHAN# IN IO.CHN

DVCHN.::MOVE	T1,IO.CHN	;GET CHAN#
	SKIPE	T1,IO.PTR(T1)	;GET I/O BLOCK
	POPJ	P,
E$$INS::.ERR.	(MS,0,V%L,L%F,S%F,INS,<I/O data block not set up>) ;[1174]


;HERE TO DO DEVCHR FOR DEVICE
;CALLED BY
;	PUSHJ	P,DVCHK.##
;USES T1-T2
;EXPECTS I/O CHAN# IN IO.CHN
;SETS IO.CHR WITH DEVCHR OF I/O DEVICE

DVCHK.::PUSHJ	P,DVCHN.	;GET ADDRESS IN T1
	MOVE	T2,I.DEV(T1)	;GET DEVICE
	DEVCHR	T2,		;SEE WHAT IT IS
	MOVEM	T2,IO.CHR	;SAVE FOR POSTERITY
	JUMPE	T2,E01NED	;[1174] NO SUCH DEVICE
	MOVEI	T2,DV.M0	;MODE BIT
	SKIPGE	I.MOD(T1)	;TEST FOR SPECIAL CASE
	POPJ	P,		;WILL SET READ MODE LATER
	LSH	T2,@I.MOD(T1)	;MODE WE WANT
	AND	T2,IO.CHR	;SEE IF WE CAN USE IT
	JUMPN	T2,CPOPJ	;OK RETURN
E$$IDM::PUSH	P,IO.CHN	;[1174] SAVE CHAN
	.ERR.	(I,0,V%L,L%F,S%F,IDM,<Illegal data mode for device >)
SUBTTL	HERE TO DO OPEN FOR NEW DEVICE


;CALLED BY
;	PUSHJ	P,DVOPN.##
;USES T1-T2
;EXPECTS CHAN # IN IO.CHN
;OPENS DEVICE AND SETS UP BUFFERS IF REQUIRED
DVOPN.::PUSHJ	P,DVCHN.	;GET I/O BLOCK
	MOVEI	T2,I.MOD(T1)	;ADDRESS OF OPEN BLOCK
	HRLI	T2,(OPEN)	;FORM INST
	IOR	T2,I.CHN(T1)	;PUT IN CHAN
	XCT	T2		;DO OPEN
	  JRST	E01OFD		;[1174] FAILED
;HERE TO ALLOCATE SPACE FOR BUFFERS
	HRRZI	T2,I.MOD(T1)	;POINT TO DATA BLOCK FOR OPEN
	DEVSIZ	T2,		;GET BUFFER SIZE
IFE TOPS20,<HALT		;CAN NOT HAPPEN!!!>
IFN TOPS20,<MOVE T2,[2,,203]	;FAKE IT FOR TOPS20>
	JUMPE	T2,DVRET1	;DUMP MODE HAS NO BUFFERS
				;HERE TO FAKE IT IF NUMBER OF BUFFERS IS TOO SMALL
	MOVE	T3,IO.CHN	;GET CHAN NUMBER
IFE TOPS20,<
	CAIE	T3,DC		;INPUT ONLY
	JRST	DVNDC		;NO
	HLRZ	T3,T2		;GET NUMBER OF BUFFERS
	CAIGE	T3,.IBR		;ENOUGH ALREADY
	HRLI	T2,.IBR		;[1174] NO, USE TOPS-10 LINK DEFAULT
DVNDC:>;END IFE TOPS20
	CAMN	T2,I.DVZ(T1)	;SEE IF SAME
	JRST	DVBUF1		;SET UP BUFFERS
	EXCH	T2,I.DVZ(T1)	;SWAP NEW FOR OLD
	JUMPE	T2,DVVRG1	;NOTHING TO GIVE BACK
	PUSHJ	P,DVRET2	;RETURN OLD BUFFER SPACE
	JRST	DVVRG.		;AND GET NEW
;HERE TO RETURN ALL SPACE USED BY CHAN I/O DATA BLOCK
;CALLED BY
;	PUSHJ	P,DVZAP.
;USES T1, T2, T3
;EXPECTS CHAN# IN IO.CHN

DVZAP.::PUSHJ	P,DVRET.	;REMOVE BUFFERS
	MOVE	T3,IO.CHN	;GET CHAN#
	HRRZ	T1,IO.PTR(T3)	;GET PTR
	SETZM	IO.PTR(T3)	;CLEAR IT
	MOVEI	T2,LN.IO	;LENGTH
	PJRST	DY.RET##	;RETURN

;HERE TO RETURN OLD BUFFER SPACE
;CALLED BY
;	PUSHJ	P,DVRET.
;USES T1, T2, T3
;EXPECTS CHAN# IN IO.CHN

DVRET.::PUSHJ	P,DVCHN.	;GET POINTER TO I/O BLOCK
DVRET1:	MOVE	T2,I.DVZ(T1)	;GET BUFSIZ WORD
DVRET2:	JUMPLE	T2,CPOPJ	;DUMP OR UNKNOWN
	HLRZ	T3,T2
	HRRZ	T2,T2
	IMULI	T2,(T3)		;CALCULATE HOW MUCH
	MOVE	T1,I.RNG(T1)	;FROM WHERE
	PJRST	DY.RET##	;GIVE IT ALL BACK
;HERE TO GET VIRGIN SPACE
;CALLED BY
;	PUSHJ	P,DVVRG.
;USES T1, T2
;EXPECTS CHAN# IN I/O CHAN

DVVRG.::PUSHJ	P,DVCHN.	;GET I/O BLOCK
DVVRG1:	MOVE	T2,IO.CHR	;GET DEVCHR BITS
	TXC	T2,DV.TTA!DV.TTY;[1174] MUST BE CONTROLLING TTY: (NUL: ISN'T)
	TXCN	T2,DV.TTA!DV.TTY;[1174]   ..
	  JRST	DVTTY		;[1174] YES
	MOVE	T2,I.DVZ(T1)	;GET BACK DEVSIZ INFO
	HLRZ	T1,T2		;NUMBER OF BUFFERS
	HRRZ	T2,T2		;SIZE OF EACH
	IMULI	T2,(T1)		;TOTAL SIZE REQUIRED
	PUSHJ	P,DY.GET##	;FIND THE SPACE
	MOVE	T2,T1		;TEMP STORE
	MOVE	T1,IO.CHN	;GET CHAN
	MOVE	T1,IO.PTR(T1)	;GET DATA BLOCK
	MOVEM	T2,I.RNG(T1)	;STORE START OF BUFFER
	JRST	DVBUF1		;ALLOCATE THE BUFFERS

;HERE TO  SET UP  BUFFERS
;CALLED BY
;	PUSHJ	P,DVBUF.
;USES T1, T2
;EXPECTS CHAN# IN IO.CHN

DVBUF.::PUSHJ	P,DVCHN.	;GET I/O DATA BLOCK
DVBUF1:	MOVE	T2,I.RNG(T1)	;GET START OF AREA
	MOVEM	T2,.JBFF	;SET FREE SPACE POINTER TO POINT TO IT
	HLRZ	T2,I.DVZ(T1)	;GET NUMBER OF BUFFERS
	HLL	T2,I.BUF(T1)	;GET OUTPUT BUFFER HEADER
	TLZE	T2,-1		;OUTPUT DEVICE?
	TLOA	T2,(OUTBUF)	;YES, FORM OUTBUF UUO
	HRLI	T2,(INBUF)	;FORM INBUF UUO
	IOR	T2,I.CHN(T1)	;PUT IN CHAN#
	XCT	T2		;SETUP BUFFERS
	MOVE	T2,.JBREL	;INCASE /HELP
	MOVEM	T2,.JBFF
	POPJ	P,

DVTTY:	SETZM	I.RNG(T1)	;CLEAR BITS JUST INCASE
	SETZM	I.DVZ(T1)
	POPJ	P,		;WILL USE TTCALLS
;HERE TO READ FILE SPEC AND BUILD LOOKUP BLOCK
;CALLED BY
;	PUSHJ	P,DVINP.##
;USES T1-T3

DVINP.::MOVE	P1,F.INZR	;MAKE SURE P1 IS SETUP
	MOVEI	T2,LN.RIB-1	;LENGTH OF LOOKUP BLOCK DATA
	MOVEM	T2,RIBLEN	;INCASE NOT SET UP
	MOVE	T2,F.MOD(P1)	;PRESERVE SCAN MODE BITS
	MOVEM	T2,MDSCN
	MOVE	T2,F.NAME(P1)	;NAME
	MOVEM	T2,FNAM
	MOVE	T2,F.EXT(P1)	;EXTENSION
	HLLZM	T2,FEXT
	MOVE	T2,F.DIR(P1)	;DIRECTORY
	MOVEM	T2,UFDPPN
IFN LN.DRB,<			;IF ALLOWED FOR SFD'S
	SKIPN	F.DIR+2(P1)	;DO WE HAVE ANY?
	POPJ	P,		;NO
	MOVEM	T2,SFDDIR	;STORE PPN
	MOVEI	T1,SFDARG	;GET PNTR
	MOVEM	T1,UFDPPN	;AS PPN
	MOVE	T1,[-LN.DRB,,SFDDIR+1]
	MOVEI	T2,F.DIR+2(P1)	;ADDRESS OF DIRECTORY
DVSFD:	MOVE	T3,(T2)		;GET NEXT SFD
	MOVEM	T3,(T1)		;STORE EVEN IF ZERO
	JUMPE	T3,CPOPJ	;EXIT WHEN ZERO FOUND
	ADDI	T2,2		;SCAN COUNTS IN 2'S
	AOBJN	T1,DVSFD	;KEEP GOING
>
	POPJ	P,
;ROUTINE TO A LOOKUP
;CALLED BY
;	PUSHJ	P,DVLKP.
;	  ERROR	RETURN
;	NORMAL	RETURN
;
;EXPECTS
;	IO.CHN TO CONTAIN I/O CHANNEL (AND CHANNEL IS OPEN)
;	IO.CHR TO CONTAIN THE DEVCHR UUO WORD
;
;RETURNS WITH THE LOOKUP DONE ACCORDING TO DEVICE TYPE

DVLKP.::PUSHJ	P,DVCHN.	;SET POINTER TO I/O BLOCK
	MOVE	T2,I.CHN(T1)	;GCHAN # JUSTIFIED TO AC
	TLO	T2,(LOOKUP)	;MAKE AN I/O INSTRUCTION
	MOVE	T3,IO.CHR	;SEE WHAT IT WAS
	TXNN	T3,DV.DSK	;SEE IF A F/S
	JRST	NFSLKP		;NO
	HRRI	T2,I.RIB(T1)	;GET ADDR OF LOOKUP BLOCK
	XCT	T2		;EXTENDED LOOKUP
	  POPJ	P,		;FAILURE, ERROR RETURN
	MOVE	T2,IO.CHN	;NOW FIND WHERE FILE IS USING
	MOVEM	T2,I.ARG(T1)	;PATH. UUO, SINCE MONITOR LIES
	MOVEI	T2,I.PTH(T1)	;IF FILE IS IN AN SFD...
	MOVEM	T2,I.PPN(T1)	;ALWAYS MAKE I.PPN POINT TO PATH
	HRLI	T2,.PTMAX	;LENGTH OF PATH BLOCK
	PATH.	T2,		;FIND IT
	  SETZM	I.PPN(T1)	;CAN'T, ASSUME DEFAULT PATH
	PJRST	CPOPJ1		;SUCCESS, NORMAL RETURN

;HERE FOR NON-FILE STRUCTURE LOOKUP
NFSLKP:	HRRI	T2,I.NAM(T1)	;ADDR OF SHORT BLOCK
	XCT	T2		;SHORT LOOKUP
	  POPJ	P,		;ERROR RETURN
	PJRST	CPOPJ1		;NORMAL RETURN
;HERE TO HANDLE OUTPUT FILE SPECS
;CALLED BY 
;PUSHJ	P,DVOUT.##
;XWD	CHAN#, MODE

;DVOUT. CHECKS FOR DEVICE ALREADY OPEN ON THIS CHAN
;SETS UP DATA BLOCK AND RETURNS
;OPEN AND ENTER WILL BE DONE LATER

DVOUT.::HLRZ	T1,@(P)		;PICKUP CHAN NUMBER 
	MOVEM	T1,IO.CHN	;SAVE FOR DEFERED SWITCHES
	MOVEI	T2,LN.IO	;LENGTH REQUIRED
	SKIPN	T1,IO.PTR(T1)	;ALREADY SETUP?
	PUSHJ	P,DY.GET##	;NO, GET SPACE
	MOVE	T2,IO.CHN	;GET CHAN AGAIN
	HRROM	T1,IO.PTR(T2)	;POINT TO DATA AREA
				;-1 IN LEFT SIGNALS OPEN NOT YET DONE
	MOVE	T3,T1		;SAFER PLACE FOR POINTER
	HRRE	T1,@(P)		;GET MODE
	MOVEM	T1,I.MOD(T3)	;STORE MODE IN OPEN BLOCK
	AOS	(P)		;PASS OVER IT
	MOVE	T1,OBFTBL(T2)	;GET BUFFER HEADER
	HRLZM	T1,I.BUF(T3)	;INTO OPEN BLOCK
	HLLZM	T1,I.CHN(T3)	;CHAN# IN AC FIELD
	MOVE	T1,F.MOD(P1)	;PRESERVE SCAN MOD WORD
	MOVEM	T1,I.SCN(T3)
	MOVEI	T1,LN.RIB-1	;LENGTH OF EXTENDED ENTER
	MOVEM	T1,I.RIB(T3)
	SKIPN	T1,F.NAME(P1)	;FILE NAME
	MOVE	T1,O.NAM
	MOVEM	T1,I.NAM(T3)
	SKIPN	T1,F.EXT(P1)	;EXTENSION
	MOVE	T1,O.EXT	;DEFAULT MUST BE SETUP PRIOR TO THIS
	HLLZM	T1,I.EXT(T3)
	SKIPN	T1,F.PROT(P1)	;PROTECTION CODE
	MOVE	T1,O.PROT
	DPB	T1,[POINT 9,I.PRV(T3),8]	;STORE LOWER 9 BITS

;CONTINUED ON NEXT PAGE
;FALL IN FROM ABOVE TO DEFAULT OUTPUT PATH AND OUTPUT DEVICE.
;MUST REMEMBER THAT AN EXPLICIT ERSATZ DEVICE IS EXPLICITLY
;SPECIFYING BOTH A DEVICE AND A PATH, SO THE DEFAULT PATH
;(FROM [PATH]/DEFAULT:OUTPUT) SHOULD NOT BE APPLIED EVEN IF NO
;EXPLICIT PATH WAS GIVEN. SIMILARLY, A DEFAULT ERSATZ DEVICE
;(REL:/DEFAULT:OUTPUT) CAN ONLY BE APPLIED IF NEITHER DEVICE
;NOR PATH WERE EXPLICITLY GIVEN.

	MOVSI	T2,(FX.DIR)	;SET UP FOR TEST
	TDNN	T2,F.MOD(P1)	;WAS DIRECTORY SPECIFIED?
	JRST	DVOUT1		;MAYBE NOT. GO SEE.
	MOVE	T4,F.DIR(P1)	;ONE WAS. GET IT.
	TLNN	T4,-1		;PROJECT SPECIFIED?
	HLL	T4,MYPPN	;NO, ASSUME DEFAULT
	TRNN	T4,-1		;PROGRAMMER GIVEN?
	HRR	T4,MYPPN	;NO, DEFAULT
	MOVEI	T1,F.DIR(P1)	;POINT TO DIRECTORY WE'RE USING
	JRST	DVOUT4		;[610] AND GO CHECK SFD'S

;HERE WHEN FX.DIR IS OFF. EITHER NONE SPECIFIED OR IT'S [-].
DVOUT1:	TDNE	T2,F.MODM(P1)	;[610] WHICH IS IT?
	JRST	DVOUT3		;[610] IT'S [-]. DON'T USE DEFAULT.
	MOVE	T1,[3,,T2]	;[610] NO PATH GIVEN EXPLICITLY, SEE IF
	MOVE	T2,F.MOD(P1)	;[610]   ONE GIVEN VIA AN ERSATZ DEVICE
	TXNN	T2,FX.NDV	;[610] FIRST, SEE IF THERE WAS A DEVICE
	SKIPN	T2,F.DEV(P1)	;[610] SHOULD BE, MAKE SURE
	JRST	DVOUT2		;[610] NO DEVICE!
	PATH.	T1,		;[610] SEE IF EXPLICIT DEVICE IS ERSATZ
	  SETZ	T3,		;[610] PROBABLY NOT
	TXNN	T3,PT.IPP	;[610] DEVICE ERSATZ?
DVOUT2:	SKIPA	T1,[O.DIR]	;[610] NO, COPY PATH FROM DEFAULT
DVOUT3:	MOVEI	T1,F.DIR(P1)	;[610] YES, USE EXPLICIT PATH GIVEN
	MOVE	T4,(T1)		;GET UFD FOR OUTPUT
DVOUT4:	MOVE	T3,IO.CHN	;[610] RESTORE POINTER TO I.XXX
	HRRZ	T3,IO.PTR(T3)	;[610] POSSIBLY DESTROYED BY PATH UUO
	SKIPN	2(T1)		;[610] ANY SFD'S???
	JRST	[MOVEM T4,I.PPN(T3)	;NO, STORE PPN
		JRST DVOUT6]	;[610] AND GO DEFAULT DEVICE
	MOVEM	T4,I.UFD(T3)	;THERE ARE..UFD GOES IN I.UFD
	MOVEI	T2,I.PTH(T3)	;GET POINTER TO PATH BLOCK
	MOVEM	T2,I.PPN(T3)	;AND PUT IT IN ENTER BLOCK
DVOUT5:	ADDI	T1,2		;[610] POINT TO NEXT SFD FROM SCAN
	SKIPN	T2,(T1)		;IS THIS THE END?
	JRST	DVOUT6		;[610] YES, GO DEFAULT DEVICE
				;NOTE THAT THIS IS THE ONLY
				; EXIT FROM THIS LOOP, BECAUSE
				; THERE WILL ALWAYS BE A ZERO
				; AFTER THE LAST SFD.
	MOVEM	T2,I.SFD(T3)	;NOT LAST SFD. STORE IT.
	AOJA	T3,DVOUT5	;[610] CHECK FOR MORE
				;*** NOTE T3 MODIFIED HERE ***


;CONTINUED ON NEXT PAGE
;NOW TO DEFAULT THE DEVICE. IF THE DEFAULT DEVICE IS ERSATZ,
;WE CAN ONLY USE IT IF EXPLICIT SPEC CONTAINED NEITHER DEVICE
;NOR PATH. NOTE THAT DEVICE DEFAULTING MUST TAKE PLACE AFTER PATH
;DEFAULTING TO AVOID CONFUSING THE DEFAULT AND EXPLICIT DEVICES
;IN PATH DEFAULTING CODE.

DVOUT6:	MOVE	T2,F.MOD(P1)	;[610] SEE IF USER GAVE EXPLICIT DEVICE
	TXNN	T2,FX.NDV	;[610] ..
	SKIPN	T2,F.DEV(P1)	;[610] BITS SAY SO, MAKE SURE
	CAIA			;[610] NO DEVICE, DO DEFAULTING
	JRST	DVOUT9		;[610] EXPLICIT DEVICE--GO USE IT
	SKIPN	T2,O.DEV	;[610] IS THERE A DEFAULT DEVICE?
	JRST	DVOUT8		;[610] NO, JUST GO USE DSK:
	MOVE	T1,[3,,T2]	;[610] SEE IF THE DEFAULT DEVICE IS
	PATH.	T1,		;[610]   ERSATZ VIA A PATH UUO
	  SETZ	T3,		;[610] PROBABLY NOT
	TXNN	T3,PT.IPP	;[610] IS IT ERSATZ?
	JRST	DVOUT7		;[610] NO, OK TO USE IT
	MOVE	T2,F.MODM(P1)	;[610] DEFAULT DEVICE IS ERSATZ. WE CAN
	TXNN	T2,FX.DIR	;[610]   ONLY USE IT IF NO EXPLICIT PATH
DVOUT7:	SKIPN	T2,O.DEV	;[610] OK TO USE THE DEFAULT DEVICE
DVOUT8:	MOVSI	T2,'DSK'	;[610] CAN'T USE DEFAULT, JUST USE DSK:
DVOUT9:	MOVE	T3,IO.CHN	;[610] RESTORE POINTER TO I.XXX BLOCK
	HRRZ	T3,IO.PTR(T3)	;[610]   (LOST TO DVOUT5)
	MOVEM	T2,I.DEV(T3)	;[610] STORE FINAL DEVICE
	JRST	DVCHK.		;[610] AND GO CHECK DATA MODE
;HERE TO DO ENTER FOR OUTPUT SPEC
;CALLED BY
;	PUSHJ	P,DVENT.##
;EXPECTS CHAN# IN IO.CHN
;ALSO DOES SWITCHES BEFORE FILE NAME

DVENT.::PUSHJ	P,DVCHK.	;GET DEVCHR, POINT TO I/O DATA BLOCK
	HLRZ	T2,I.SWT(T1)	;ANY SWITCHES TO DO
	JUMPE	T2,DVENTR	;BEFORE WE DO ENTER
	HRRZS	I.SWT(T1)	;CLEAR SWITCHES
DVENT1:	MOVE	T3,1(T2)	;GET UUO
	TLZ	T3,(Z 17,)	;CLEAR CHAN#
	OR	T3,I.CHN(T1)	;USE CORRECT ONE
	MOVE	T1,T2		;PRESERVE ADDRESS OF BLOCK TO DELETE
	MOVE	T2,2(T1)	;GET REPEAT COUNT
	XCT	T3		;DO UUO
	SOJG	T2,.-1		;REPEAT?
	MOVEI	T2,3
	SKIPN	0(T1)		;MORE?
	JRST	DVENT2		;NO
	PUSH	P,0(T1)		;YES
	PUSHJ	P,DY.RET##
	PUSHJ	P,DVCHN.	;RESET T1
	POP	P,T2		;AND POINTER
	JRST	DVENT1		;AND LOOP

;HERE FOR LAST TIME
DVENT2:	PUSHJ	P,DY.RET##
	PUSHJ	P,DVCHN.	;GET DATA BLOCK

DVENTR:	SETZM	I.ALC(T1)	;MAKE SURE ALLOCATION IS CLEAR
	MOVEI	T2,I.RIB(T1)	;POINT TO LOOKUP/ENTER BLOCK
	HRLI	T2,(ENTER)
	IOR	T2,I.CHN(T1)	;BUILT INST
	MOVE	T3,IO.CHR	;GET DEVCHR WORD
	TXNN	T3,DV.DSK	;ONLY DSK CAN DO EXTENDED ENTERS
	ADDI	T2,2		;DO NORMAL 4 WORD ENTER
	PUSH	P,I.PPN(T1)	;SAVE PATH FROM DESTRUCTION
	XCT	T2		;DO ENTER
	  PUSHJ	P,ENTERR	;FAILED
	POP	P,I.PPN(T1)	;RESTORE PATH (MONITOR LIES)
	MOVE	T1,IO.CHN	;GET CHAN#
	HRRZS	IO.PTR(T1)	;SIGNAL DONE
	POPJ	P,
DEFINE	XXX (CH,NUM,MODE)<
 IFN CH-%%,<
  REPEAT CH-%%,<
   0
 >>
 IFGE MODE,<
  IFIDN <MODE><.IODPR>,<
   NUM,0
  >
  IFDIF <MODE><.IODPR>,<
   NUM,CH'BUF
 >>
 IFL MODE,<
  NUM,0
 >
 %%==CH+1
>
SYN	XXX,XXXX
%%==0
	XALL
OBFTBL:	IODATA
	SALL

PURGE	%%,XXX,XXXX
;HERE TO DO SWITCH ACTION JUST PRIOR TO RELEASE
;AND TO DO RELEASE
;EXPECTS CHAN # IN IO.CHN

DVRLS.::PUSHJ	P,DVCLS.	;CLOSE FILE IF OPEN, GET DATA BLOCK
	JUMPE	T1,CPOPJ	;GIVE UP IF NO ACTIVE I/O
	HRRZ	T2,I.SWT(T1)	;ANY SWITCHES TO DO
	JUMPE	T2,DVRLSZ	;NO, JUST RELEASE
	SETZM	I.SWT(T1)	;CLEAR SWITCHES
DVRLS1:	MOVSI	T3,(MTWAT.)	;INCASE TAPE STILL MOVING (DTA?)
	IOR	T3,I.CHN(T1)
	XCT	T3
	MOVE	T3,1(T2)	;GET UUO
	TLZ	T3,(Z 17,)	;CLEAR CHAN#
	OR	T3,I.CHN(T1)	;USE CORRECT ONE
	MOVE	T1,T2		;ADDRESS OF BLOCK TO DELETE
	MOVE	T2,2(T1)	;REPEAT COUNT
	XCT	T3		;DO UUO
	SOJG	T2,.-1		;REPEAT IT?
	MOVEI	T2,3
	SKIPN	0(T1)		;MORE?
	JRST	DVRLS2		;NO
	PUSH	P,0(T1)		;YES
	PUSHJ	P,DY.RET##
	PUSHJ	P,DVCHN.	;RESET T1
	POP	P,T2		;AND POINTER
	JRST	DVRLS1		;AND LOOP

DVRLS2:	PUSHJ	P,DY.RET##	;RETURN SWITCH BLOCK
	PUSHJ	P,DVCHN.	;SETUP T1 AGAIN
DVRLSZ:	MOVSI	T2,(RELEASE)
	IOR	T2,I.CHN(T1)	;BUILD INST
	XCT	T2
	POPJ	P,

;HERE TO DO CLOSE
;CALLED BY
;	PUSHJ	P,DVCLS.
;EXPECTS CHAN# IN IO.CHN

DVCLS.::PUSHJ	P,DVCHN.	;POINT TO I/O DATA BLOCK
	MOVSI	T2,(CLOSE)
	IOR	T2,I.CHN(T1)	;COMPLETE INST.
	XCT	T2
	POPJ	P,
;HERE TO SET DEFAULT FILE NAME IF ZERO
;CALLED BY
;	PUSHJ	P,DVNAM.
;EXPECTS CHAN# IN IO.CHN

DVNAM.::PUSHJ	P,DVCHN.	;POINT TO I/O DATA BLOCK
	SKIPE	T2,I.NAM(T1)	;GET USER SUPPLIED NAME
	POPJ	P,		;YES, JUST RET
	SKIPE	T2,LODNAM	;NOT SUPPLIED USE MAIN PROG NAME
	JRST	.+3		;HOWEVER IF STILL ZERO
	HLLZ	T2,JOBNUM	;GET SIXBIT JOBNUMBER
	HRRI	T2,'LNK'	;000LNK BY DEFAULT
	MOVEM	T2,I.NAM(T1)
	POPJ	P,
;HERE TO GET INTO UPDATE MODE FOR OVERFLOW FILES
;CALLED BY
;	MOVEI	T1,CHAN#
;	PUSHJ	P,DVUPD.
;RETURNS
;+1	FAILED (LOOKUP OR ENTER)
;+2	SUCCESS
;USES T1, T2, T3

DVUPD.::HRLZ	T2,T1		;CHAN # IN LEFT
	LSH	T2,5		;THENCE TO AC FIELD
	MOVE	T1,IO.PTR(T1)	;POINT TO DATA CHAN
	MOVEM	T2,I.CHN(T1)	;STORE INCASE NEEDED
	HRRI	T2,I.MOD(T1)	;ADDRESS OF OPEN BLOCK
	TLO	T2,(OPEN)
	XCT	T2
	  JRST	E01OFD		;[1174] SHOULD NEVER HAPPEN FOR DSK
	HRRI	T2,I.RIB(T1)	;POINT TO LOOKUP/ENTER BLOCK
	TLC	T2,027000	;OPEN .XOR. ENTER
	MOVE	T3,I.PPN(T1)	;SAVE PPN INCASE DEFAULT PATH
	XCT	T2		;ENTER FILE
	  POPJ	P,		;FAILED
	MOVEM	T3,I.PPN(T1)	;RESTORE DIRECTORY
	TLZ	T2,007000	;CONVERT TO CLOSE
	HRRI	T2,CL.DLL	;BUT DON'T DEALLOCATE
	XCT	T2
	HRRI	T2,I.RIB(T1)	;PUT LOOKUP ADDRESS BACK
	TLO	T2,006000	;LOOKUP
	XCT	T2
	  POPJ	P,		;FAILED
	MOVEM	T3,I.PPN(T1)	;RESTORE DIRECTORY
	TLO	T2,001000	;ENTER
	XCT	T2
	  POPJ	P,		;FAILED
CPOPJ1:	AOS	(P)
CPOPJ:	POPJ	P,
;HERE TO DELETE A FILE & RELEASE CHAN#
;CALLED BY
;	MOVEI	T1,CHAN#
;	PUSHJ	P,DVDEL.
;USES T1, T2
;RETURNS
;+1	FAILED
;+2	SUCCESS

DVDEL.::PUSHJ	P,DVDLF.	;DELETE FILE
	  POPJ	P,		;NON-SKIP RETURNS (FAILURE)?
	TLC	T2,024000	;RELEASE_RENAME
	HLLZ	T2,T2		;CLEAR RHS INCASE CLOSE BITS EVER WORK
	XCT	T2
	JRST	CPOPJ1		;OK RETURN
;HERE TO JUST DELETE A FILE
;CALLED BY
;	PUSHJ	P,DVDLF.
;ARGS AS ABOVE

DVDLF.::HRLZ	T2,T1		;CHAN# IN LEFT
	LSH	T2,5		;THENCE TO AC FIELD
	MOVE	T1,IO.PTR(T1)	;GET PTR TO DATA
DVDLFC:				;ENTER HERE WITH T2 =CHAN # IN AC FIELD
				;AND T1 POINTING TO DATA BLOCK
				;NOW COPY FILE SPEC TO SAFE PLACE
				;OTHERWISE STRANGE ERRORS OCCUR ON FUTURE RENAMES
	HRLZ	T3,T1		;FROM
	HRRZ	T1,IO.EMG	;A SAFE PLACE
	HRR	T3,T1		;TO
	BLT	T3,LN.IO-1(T1)	;T1 POINTS TO NEW BLOCK
	TLO	T2,(CLOSE)	;CLOSE FILE INCASE STILL OPEN
	XCT	T2
	HRRI	T2,I.RIB(T1)	;POINT TO LOOKUP BLOCK
	TLO	T2,006000	;CONVERT CLOSE TO LOOKUP
	PUSH	P,I.PPN(T1)	;SAVE PATH OVER LOOKUP
	XCT	T2
	  JRST	DVDLF1		;TOO BAD
	SETZM	I.NAM(T1)	;CLEAR NAME
	TLC	T2,023000	;RENAME _ LOOKUP
	XCT	T2		;DELETE FILE
	  JRST	DVDLF1		;TOO BAD
	AOS	-1(P)		;OK RETURN
DVDLF1:	POP	P,I.PPN(T1)	;RESTORE PATH FROM ENTRY
;	PJRST	DVCEM.		;CLEAR IO.EMG AND RETURN

;ROUTINE TO CLEAR IO.EMG, THE EMERGENCY FREE I/O DATA BLOCK
;CALLED BY
;	PUSHJ	P,DVCEM.
;
;USES T1,T3
;*** WARNING *** MUST LEAVE T2 UNCHANGED

DVCEM.::MOVE	T1,IO.EMG	;GET POINTER TO I/O BLOCK
	HRLZ	T3,T1		;BLT TO CLEAR IO.EMG
	HRRI	T3,1(T1)	;SO ITS FREE FOR NEXT TIME
	SETZM	(T1)
	BLT	T3,LN.IO-1(T1)
	POPJ	P,
;HERE TO RENAME A FILE
;CALLED BY
;	MOVE	T1,IO.CHN+CHAN# OF NEW FILE
;	MOVE	IO.CHN CHAN# OF OLD FILE
;	PUSHJ	P,DVRNF.
;USES T1, T2, T3, T4
;RETURNS
;+1	FAILED
;+2	SUCCESS

DVRNF.::PUSH	P,T1		;SAVE T1
	PUSHJ	P,DVCLS.	;CLOSE OUT OLD FILE
	POP	P,T2		;RECOVER NEW NAME
	MOVEI	T3,I.RIB(T1)	;ADDRESS
	TLO	T3,(LOOKUP)
	IOR	T3,I.CHN(T1)	;PLUS CHAN#
	PUSH	P,I.PPN(T1)	;SAVE PPN IN CASE DEFAULT PATH
	XCT	T3		;LOOKUP
	  JRST	[POP	P,0(P)	;ERROR - RESTORE STACK
		POPJ	P,]	;AND GIVE ERROR RETURN TO CALLER
	POP	P,I.PPN(T1)	;DON'T BELIEVE FALSE MONITOR VALUE
	TLC	T3,023000	;RENAME_LOOKUP
	HRRI	T3,I.RIB(T2)	;POINT TO NEW NAME
	LDB	T4,[POINT 9,I.PRV(T2),8]	;GET USER SPECIFIED PROTECTION
	SKIPE	T4		;UNLESS NOT SPECIFIED
	DPB	T4,[POINT 9,I.PRV(T1),8]	;STORE IN OLD SO WE COPY IT
	MOVE	T4,I.PRV(T1)	;GET DATE TIME ETC
	MOVEM	T4,I.PRV(T2)	;SINCE SAME FILE
	HRRZ	T4,I.EXT(T1)	;GET HIGH ORDER PART
	HRRM	T4,I.EXT(T2)	; ALSO
	PUSH	P,I.PPN(T2)	;SAVE PATH, SINCE MONITOR WIPES IT
	XCT	T3
	  JRST	DVRNFE		;TEST ERROR CONDITION
	POP	P,I.PPN(T2)	;RESTORE TO BEFORE (MONITOR LIES)
	JRST	CPOPJ1		;OK RETURN

DVRNFE:	POP	P,I.PPN(T2)	;RESTORE REAL PPN OF FILE
	HRRZ	T4,I.EXT(T2)	;GET RENAME ERROR CODE
	CAIE	T4,ERAEF%	;ALREADY EXISTS
	POPJ	P,		;NO, JUST IGNORE THIS ERROR?
	PUSH	P,I.NAM(T2)	;SAVE NAME
	PUSH	P,T2		;SAVE P2
	EXCH	T1,T2		;GET POINTER TO 2ND FILE
	MOVE	T2,I.CHN(T2)	;GET CHAN# TO 1ST FILE
	PUSHJ	P,DVDLFC
	  JRST	[SUB P,[2,,2]	;BACKUP STACK
		POPJ	P,]	;AND GIVE UP
	POP	P,T1		;RESTORE POINTER
	POP	P,I.NAM(T1)	;AND NAME
	JRST	DVRNF.		;TRY AGAIN
;ROUTINE TO OPEN DSK FILE, CHECK IF WILL EVENTUALLY SUPERSEDE
;	EXISTING FILE, AND IF SO SET THE DEV NAME TO STRUCTURE.
;CALLED BY
;	PUSHJ	P,DVSUP.
;	  ERROR	RETURN		;DEV IS NOT A DSK
;	NORMAL	RETURN
;
;EXPECTS
;	IO.CHN TO CONTIAN I/O CHANNEL NUMBER
;
;RETURNS WITH THE DEVICE NAME IN THE I/O DATA BLOCK INITIALIZED

DVSUP.::PUSHJ	P,DVCHK.	;GET THE DEVCHR WORD
	MOVE	T2,IO.CHR
	TLC	T2,-1-<(DV.TTA)>	;[604] NUL: ISN'T A DISK
	TLCE	T2,-1-<(DV.TTA)>	;[604]
	TXNN	T2,DV.DSK	;IS IT A DSK?
	POPJ	P,		;WE HAVE A PROBLEM
	AOS	(P)		;MAKE IT A SKIP RETURN
	MOVE	T2,IO.CHN	;GET THE CHAN #
	MOVE	T1,IO.PTR(T2)	;GET THE I/O BLOCK PNTR
	LSH	T2,^D23		;ALLIGN TO THE AC FIELD
	MOVEM	T2,I.CHN(T1)	;STORE FOR I/O BUILD
	PUSHJ	P,DVOPN.	;OPEN THE DEV
	PUSHJ	P,DVCHN.	;POINT TO THE I/O BLOCK
	SKIPN	T2,IO.EMG	;[604] ANY CORE LEFT? (IF FROM LNKCOR)
	PUSHJ	P,E$$MEF##	;[1174] NO, ERROR
	HRL	T2,T1		;[604] YES, FORM BLT PTR TO IO.EMG AREA
	MOVEI	T3,(T2)		; TO SAVE ORIG ENTER BLOCK
	BLT	T2,LN.IO-1(T3)	;IO.EMG POINTS TO TMP
	PUSHJ	P,DVENT.	;[656] SEE WHERE FILE WILL GO
	MOVE	T3,IO.CHN	;ENTRY IN IO.PTR TO SWAP
	RESDV.	T3,		;[656] DELETE FILE WE JUST ENTERED
	  MOVE	T3,IO.CHN	;[656] IGNORE ERROR
	HRRZ	T1,IO.PTR(T3)	;[604] TRADE I/O DATA BLOCKS
	MOVE	T2,T1		;  WITH IO.EMG
	EXCH	T1,IO.EMG	;  TMP AREA
	HRROM	T1,IO.PTR(T3)	;[656]   ...
	MOVE	T4,I.LDV(T2)	;GET STRUCTURE NAME
	MOVEM	T4,I.DEV(T1)	;REPLACE GENERIC NAME
	PJRST	DVCEM.		;CLEAR IO.EMG AND RETURN
SUBTTL	TOPS-20 JSYS ROUTINES


IFN TOPS20,<

;HERE TO CONVERT SCAN BLOCK INTO TEXT STRING
;CALLED BY
;	MOVE	IO.CHN	CHAN #
;	PUSHJ	P,DVTXT.

DVTXT.::MOVEI	T2,F.LEN	;GET SPACE TO STORE STRING
	PUSHJ	P,DY.GET##
	MOVE	T4,T1		;SAFER PLACE
	HRLI	T4,(POINT 7)	;MAKE INTO BYTE PTR
	PUSHJ	P,DVCHN.	;GET DATA BLOCK IN T1
	SKIPN	T3,I.DEV(T1)	;GET DEVICE
	JRST	DVTXT1		;NO DEVICE
	PUSHJ	P,DVDPB.	;STORE
	MOVEI	T2,":"
	IDPB	T2,T4
DVTXT1:	SKIPN	T3,I.PPN(T1)	;SEE IF DIRECTORY
	JRST	DVTXT2		;NO
	MOVEI	T2,"<"		;OPEN IT
	IDPB	T2,T4
	PUSHJ	P,DVDPB.	;STORE NAME
	MOVEI	T2,">"
	IDPB	T2,T4		;CLOSE IT
DVTXT2:	MOVE	T3,I.NAM(T4)
	PUSHJ	P,DVDPB.
	SKIPN	T3,I.EXT(T4)
	JRST	DVTXT3		;NO EXTENSION
	MOVEI	T2,"."
	IDPB	T2,T4
	PUSHJ	P,DVDPB.
DVTXT3:
	MOVE	T2,IO.CHN
	MOVEM	T4,IO.PTR(T2)	;STORE TEXT STRING PTR
	MOVEI	T2,F.LEN
	PJRST	DY.RET##	;GIVE BACK SCAN BLOCK
;HERE TO STORE BYTE IN STRING
;CALLED BY
;	T3 = SIXBIT WORD
;	T4 = BYTE PTR
;	PUSHJ	P,DVDPB.
;USES T2

DVDPB.:	SETZ	T2,
	LSHC	T2,6		;GET NEXT CHAR
	ADDI	T2," "		;TO ASCII
	IDPB	T2,T4
	JUMPN	T3,DVDPB.	;MORE TO DO
	POPJ	P,		;NO, RETURN

;DVGFO. - ROUTINE TO DO GTJFN FOR OUTPUT FILE
;EXPECTS TEXT STRING IN IO.PTR(IO.CHN)
;STORES JFN THERE ON COMPLETION

DVGFO.::MOVE	T4,IO.CHN	;GET CHAN#
	MOVSI	1,(1B0+1B17)	;OUTPUT SO VERSION# STUFF WORKS RIGHT
	HRRO	2,IO.PTR(T4)	;POINT TO TEXT STRING
	GTJFN
 	  HALT
	EXCH	T1,IO.PTR(T4)	;STORE JFN
	MOVEI	T2,F.LEN
	PJRST	DY.RET##	;REMOVE TEXT STRING

>;END OF IFN TOPS20
SUBTTL	ERROR MESSAGES


E01OFD::PUSH	P,IO.CHN	;[1174] PUT CHANNEL ON STACK
	.ERR.	(I,0,V%L,L%F,S%F,OFD) ;[1174]

E01NED::PUSH	P,IO.CHN	;[1174] PUT CHANNEL ON STACK FOR LNKLOG
	.ERR.	(I,0,V%L,L%F,S%E,NED)
	POPJ	P,		;[1174] RETURNS IF CHAN WAS DC; TRY NOW

ENTERR:	MOVE	T1,IO.CHN
	HRLI	T1,(%ENT)	;[1123] SIGNAL ENTER
	MOVE	T2,IO.CHR	;GET DEVCHR WORD
	TXNE	T2,DV.DTA	;DTA MIGHT BE SPECIAL
	JRST	[MOVE	T2,IO.PTR(T1)	;[1174] GET DATA BLOCK POINTER
		HRRZ	T3,I.EXT(T2)	;[1174] IF ERROR WAS ERPRT%
		CAXN	T3,ERPRT%	;[1174] AS IT MEANS DIRECTORY FULL
		HLLOS	I.EXT(T2)	;[1174] SIGNAL BY -1
		JRST	.+1]
E01FEE::PUSH	P,T1		;[1174] SAVE CHANNEL FOR LNKLOG
	.ERR.	(LRE,,V%L,S%D,L%D,FEE) ;[1174]
	POPJ	P,

E01FLE::PUSH	P,IO.CHN	;[1174] REMEMBER WHAT # FAILED
	.ERR.	(LRE,,V%L,S%D,L%D,FLE) ;[1174]
	POPJ	P,
SUBTTL	THE END


FIOLIT:	END