SUBTTL	3-NOV-75
;
;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1976,1977,1986,1988.
;ALL RIGHTS RESERVED.
;
;
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED 
;ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE INCLUSION
;OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER COPIES THEREOF
;MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY OTHER PERSON. NO
;TITLE TO OR OWNERSHIP OF THE SOFTWARE IS HEREBY TRANSFERRED.
;
;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE 
;AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT 
;CORPORATION
;
;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.
;
;
;
VWHO==0
VFE==2
VMINOR==0
VEDIT==50
	IFNDEF .PSECT,<
	.DIRECT .XTABM>
	SALL
	SEARCH MACSYM
	SYN IFE,IF		;SO THAT "IF TOPS-10" WORKS
;
; PARAMETERS
;
IFNDEF FTDB,<FTDB==	0>	;1: ENABLE CODE TO SUPPORT RP04 (DB) REQUESTS
IFNDEF TOPS,<TOPS==	10>	;10: TOPS-10 SUPPORT;  20: TOPS-20 SUPPORT
IFNDEF FIDNUM,<FIDNUM==	^D4>	;ALLOW 4 OPEN FILE-ID'S
IFNDEF PDLEN,<PDLEN==	^D50>	;STACK LENGTH
IF TOPS-20,<
	TITLE FE -- FE DEVICE INTERFACE FOR TOPS-20
	SEARCH MONSYM
	.REQUIRE SYS:MACREL
FTDTE.==0			;NO DTE. UUO'S!!!
>; END IF TOPS-20
IF TOPS-10,<
	TITLE FE -- FE DEVICE INTERFACE FOR TOPS-10
	SEARCH UUOSYM


COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1976,1988. ALL RIGHTS RESERVED.
\;END OF COPYRIGHT MACRO


IFNDEF UICNUM,<UICNUM==	^D10>	;ALLOW 10. UIC TABLE ENTRIES
IFNDEF FTPATH,<FTPATH==	1>	;ALLOW PATH SPECS IN UIC TABLE
IFNDEF FTDTE.,<FTDTE.==	1>	;0: USE FE DEVICE JSYS'ES  1: USE DTE. UUO'S
IFN FTDB,<PRINTX DB REQUEST CODE NOT SUPPORTED ON TOPS-10>
IFE FTDTE.,<
	SEARCH MONSYM
	.REQUIRE SYS:MACREL
>; END IFE FTDTE.
>; END IF TOPS-10
;
; REGISTERS
;
F=	0			;FLAGS
T1=	1			;GENERAL USE, T1-T4 MUST BE 1-4
T2=	2			; . .
T3=	3			; . .
T4=	4			; . .
P1=	5			;NOT-SO-GENERAL USE
P2=	6			; . .
P3=	7			; . .
P4=	10			; . .
;
HDR=	11			;ADDRESS OF CURRENT HEADER AREA
FID=	12			;ADDRESS OF CURRENT FILE-ID BLOCK
C=	13			;RANDOM CHARACTERS
;
P=	17			;STACK POINTER
;
; FLAGS -- IN REGISTER F
;
F.PROC==1B0			;PROCCESSING A REQUEST-- DON'T ALLOW IPCF
F.WRIT==1B1			;WRITE REQUEST
;
; MACROS
;
IF TOPS-10,<
 DEFINE TMSG(MSG),<
	OUTSTR [ASCIZ\MSG\]
 >
>; END IF TOPS-10
DEFINE WARN(MSG,GOTO,IL),<
 IFB <IL>,<JRST [>
 TMSG <% MSG
>
 IFNB <GOTO>,<JRST GOTO>
 IFB <IL>,<
  IFB <GOTO>,<JRST .+1>
  ]>
>
;
DEFINE RETERR(ERR,IL),<
 IFB <IL>,<CALL [>
	MOVEI T1,<ERR>
 IFNB <IL>,<CALL RETXXX>
 IFB <IL>,<JRST RETXXX]>
>
;
OPDEF CALL [PUSHJ P,]
OPDEF CALLR [JRST]
OPDEF RETURN [POPJ P,]
DEFINE RETSKP,<JRST CRET1>
DEFINE CALLRX (WHERE),<IF2,<IFN <.-WHERE>,<PRINTX CALLRX WHERE NOT VALID>>>
;
; TOPS-20 HOM BLOCK DEFINITIONS
;
HOMNAM==0			;ALWAYS CONTAINS SIXBIT/HOM/
HOMSNM==3			;NAME OF STRUCTURE IN SIXBIT
HOMLUN==4			;LH: TOTAL # UNITS IN STR, RH: CURRENT UNIT #
HOMSIZ==13			;SIZE OF THIS UNIT IN BLOCKS
HOMFE0==61			;SECTOR ADDRESS OF F-E-F-S, BIT 2 SET IF EXISTS
HOMFE1==62			;SIZE OF F-E-F-S IN SECTORS
;
; -11 STYLE BITS
;
DEFINE ..BIT(IT),<BIT'IT==1B<35-IT>>
RADIX 10
$$$BIT==-1
REPEAT 16,<..BIT(\<$$$BIT==$$$BIT+1>)>
RADIX 8
	SUBTTL DATA DEFINITIONS
;
; MACROS TO DO DEFINITIONS OF -11 DATA STRUCTURES
;
DEFINE .BYT (NAME,LOC,OFF),<
 $$$BIT==^D17
 IFN <<OFF>&BIT1>,<$$$BIT==$$$BIT+^D18>
 IFN <<OFF>&BIT0>,<$$$BIT==$$$BIT-^D8>
 DEFSTR (NAME,<<<<<OFF>/4>>>+LOC>,$$$BIT,^D8)
>
DEFINE .WRD (NAME,LOC,OFF),<
 $$$BIT==^D17
 IFN <<OFF>&BIT1>,<$$$BIT==$$$BIT+^D18>
 IFN <<OFF>&BIT0>,<PRINTX ? WORD NAME HAS BAD OFFSET OFF>
 DEFSTR (NAME,<<<<<OFF>/4>>>+LOC>,$$$BIT,^D18)
>
DEFINE .DWRD (NAME,LOC,OFF),<
 IFN <<OFF>&<BIT1!BIT0>>,<PRINTX ? DOUBLE-WORD NAME HAS BAD OFFSET OFF>
 DEFSTR (NAME,<<<<<OFF>/4>>>+LOC>,^D35,^D36)
>
DEFINE PNTR (STR,Y),<..STR0 (..PNTR,AC,STR,Y)>
DEFINE ..PNTR (AC,LOC,MASK),<POINTR (<LOC>,<MASK>)>
;
DEFINE .RAD50 (X),<IRP X,<
 $$$R50==0
 IRPC X,<
  $$$CHR==0
  IFGE <"X"-"0">,<$$$CHR=="X"-"0"+36>
  IFGE <"X"-"A">,<$$$CHR=="X"-"A"+1>
  $$$R50==<$$$R50*50>+$$$CHR
  >
	XWD $$$R50_-^D16,$$$R50&177777
>>
;
; GENERAL BYTE AND WORD DEFINITIONS
;
.BYT (BYTE0,,0)
.BYT (BYTE1,,1)
.BYT (BYTE2,,2)
.BYT (BYTE3,,3)
.WRD (WORD0,,0)
.WRD (WORD1,,2)
;
; HEADER FROM -11
;
.WRD (HDRFN,0(HDR),0)		;FUNCTION CODE
.WRD (HDRDV,0(HDR),2)		;DEVICE NAME IN 8-BIT ASCII
.BYT (HDRUN,0(HDR),4)		;UNIT NUMBER OF DEVICE
.WRD (HDRP1,0(HDR),6)		;PARAMETER #1
.WRD (HDRP2,0(HDR),10)		;PARAMETER #2
.WRD (HDRSZ,0(HDR),12)		;SIZE OF FOLLOWING DATA BLOCK
HDRLEN==14			;SIZE OF HEADER IN BYTES
;
; FILE CONTROL PRIMITIVES DATA
;
.DWRD (FILID,SCRBUF,0)		;FILE-NAME BLOCK IS ALWAYS FIRST
.WRD (FILP1,SCRBUF,4)		;FILE PARAMETER #1 (ACCESS OR EXTEND)
.WRD (FILP2,SCRBUF,6)		;FILE PARAMETER #2 (EXTEND)
.WRD (FILAT0,SCRBUF,10-2)	;ATTRIBUTE CONTROL BLOCK (PRE-POINTER FOR ILDB)
.WRD (FILACB,SCRBUF,10)		;ATTRIBUTE CONTROL BLOCK
;
; READ/WRITE VIRTUAL BLOCK DATA
;
.WRD (RWVBH,SCRBUF,4)		;HIGH PART VBN
.WRD (RWVBL,SCRBUF,6)		;LOW PART VBN
.WRD (RWVSZ,SCRBUF,10)		;TRANSFER SIZE IN BYTES
.WRD (RWVDW0,SCRBUF,12-2)	;PRE-POINTER TO FIRST DATA WORD
.BYT (RWVDB,SCRBUF,12)		;FIRST BYTE OF DATA
;
; FILE-NAME BLOCK
;
.DWRD (N.FID,SCRBUF,0)		;FILE-ID
.WRD (N.FNM0,SCRBUF,6-2)	;FILE-NAME (POINTER FOR ILDB/IDPB)
.WRD (N.FNAM,SCRBUF,6)		;FILE NAME (3 WORDS)
.WRD (N.FTYP,SCRBUF,14)		;FILE TYPE
.WRD (N.FVER,SCRBUF,16)		;FILE VERSION #
.WRD (N.STAT,SCRBUF,20)		;STATUS BITS:
	NB.SVR==BIT3		;WILD VERSION
	NB.STP==BIT4		;WILD FILE TYPE
	NB.SNM==BIT5		;WILD FILE NAME
.WRD (N.NEXT,SCRBUF,22)		;CONTEXT SAVE FOR WILD OPERATIONS
.DWRD (N.DID,SCRBUF,24)		;DIRECTORY ID
.WRD (N.DOW,SCRBUF,30)		;DIRECTORY OWNER
S.DRFN==32			;SIZE FOR DIRECTORY FUNCTIONS
;
; FILE HEADER
;
.WRD (H.IDOF,FILHDR,0)		;ID/MAP AREA OFFSETS
.WRD (H.FNUM,FILHDR,2)		;FILE NUMBER
.WRD (H.FSEQ,FILHDR,4)		;FILE SEQUENCE #
.WRD (H.FLEV,FILHDR,6)		;FILE SYSTEM LEVEL
.WRD (H.FOWN,FILHDR,10)		;FILE OWNER (UIC)
.WRD (H.FPRO,FILHDR,12)		;FILE PROTECTION CODE
.WRD (H.CHAR,FILHDR,14)		;FILE CHARACTERISTICS
.WRD (H.UFAT,FILHDR,16)		;USER FILE ATTRIBUTES (16. WORDS)
 .BYT (H.RTYP,FILHDR,16+0)	;RECORD TYPE
 .BYT (H.RATT,FILHDR,16+1)	;RECORD ATTRIBUTES
 .WRD (H.RSIZ,FILHDR,16+2)	;RECORD SIZE
 .WRD (H.HHBK,FILHDR,16+4)	;HIGHEST VBN IN USE (HIGH PART)
 .WRD (H.LHBK,FILHDR,16+6)	; . . . (LOW PART)
 .WRD (H.HEFB,FILHDR,16+10)	;END-OF-FILE BLOCK # (HIGH PART)
 .WRD (H.LEFB,FILHDR,16+12)	; . . . (LOW PART)
 .WRD (H.FFBY,FILHDR,16+14)	;FIRST FREE BYTE IN END-OF-FILE BLOCK
.WRD (I.FNM0,FILHDR,56-2)	;FILENAME RAD50
.WRD (I.FNAM,FILHDR,56)		;FILENAME RAD50
.WRD (I.FTYP,FILHDR,64)		;FILE TYPE
.WRD (I.FVER,FILHDR,66)		;FILE VERSION #
.WRD (I.RVNO,FILHDR,70)		;REVISION #
.BYT (I.RVDT,FILHDR,72)		;REVISION DATE (7 BYTES)
.BYT (I.RVTI,FILHDR,101)	;REVISION TIME (6 BYTES)
.BYT (I.CRDT,FILHDR,107)	;CREATION DATE (7 BYTES)
.BYT (I.CRTI,FILHDR,116)	;CREATION TIME (6 BYTES)
.WRD (I.EDTW,FILHDR,124)	;EXPIRATION DATE
.BYT (I.EXDT,FILHDR,124)	;EXPIRATION DATE (7 BYTES)
	SUBTTL QUEUE I/O DEFINITIONS
;
; I/O FUNCTIONS
;
DEFINE IO(XXX,FUNC,SUB),< IO.'XXX== <FUNC+0>B<35-8>+<SUB+0>B<35-0> >
;
IO WLB,1			;WRITE LOGICAL BLOCK
IO RLB,2			;READ LOGICAL BLOCK
IO LOV,2,10			;LOAD OVERLAY
IO ATT,3			;ATTACH DEVICE
IO FCP,3,1			;FILE CONTROL PRIMITIVE
IO DET,4			;DETACH DEVICE
;
IO CLN,7			;CLOSE OUT LUN
;
IO FNA,11			;FIND NAME IN DIRECTORY
IO RNA,13			;REMOVE NAME FROM DIRECTORY
IO ENA,14			;ENTER NAME IN DIRECTORY
;
IO ACR,15			;ACCESS FOR READ
IO ACW,16			;ACCESS FOR READ, WRITE
IO ACE,17			;ACCESS FOR READ, WRITE, EXTEND
IO DAC,20			;DE-ACCESS FILE
IO RVB,21			;READ VIRTUAL BLOCK
IO WVB,22			;WRITE VIRTUAL BLOCK
IO EXT,23			;EXTEND FILE
IO CRE,24			;CREATE FILE
IO DEL,25			;MARK FILE FOR DELETE
IO RAT,26			;READ FILE ATTRIBUTES
IO WAT,27			;WRITE FILE ATTRIBUTES
IO APC,30			;ACP CONTROL
IO APV,30,10			;PRIVILEDGED ACP CONTROL
;
; STATUS RETURN CODES
;
	RADIX 10		;** NOTE RADIX 10 **
IS.SUC==+1			;SUCCESSFULL COMPLETION
;
IE.BAD==-1			;BAD PARAMETERS
IE.IFC==-2			;ILLEGAL FUNCTION CODE
IE.DNR==-3			;DEVICE NOT READY
IE.VER==-4			;PARITY OR DEVICE ERROR
IE.ONP==-5			;HARDWARE OPTION NOT PRESENT
IE.SPC==-6			;ILLEGAL USER BUFFER
IE.EOF==-10			;END OF FILE
IE.EOV==-11			;END OF VOLUME
IE.WLK==-12			;WRITE LOCKED DEVICE
IE.DAO==-13			;DATA OVERRUN
IE.SRE==-14			;SEND/RECEIVE FAILURE
IE.ABO==-15			;OPERATION ABORTED
IE.PRI==-16			;PRIVILEDGE VIOLATION
IE.RSU==-17			;SHARABLE RESOURCE IN USE
IE.OVR==-18			;ILLEGAL OVERLAY REQUEST
IE.BYT==-19			;BYTE-ALIGNED BUFFER
IE.BLK==-20			;LOGICAL BLOCK # TOO LARGE
;
IE.NOD==-23			;LACK OF NODE SPACE
IE.DFU==-24			;DEVICE FULL
IE.IFU==-25			;INDEX FILE FULL
IE.NSF==-26			;NO SUCH FILE
IE.LCK==-27			;LOCKED FROM WRITE ACCESS
IE.HFU==-28			;FILE HEADER FULL
IE.WAC==-29			;ACCESSED FOR WRITE
IE.CKS==-30			;FILE HEADER CHECKSUM ERROR
IE.WAT==-31			;ATTRIBUTE CONTROL LIST FORMAT ERROR
IE.RER==-32			;FCP DEVICE READ ERROR
IE.WER==-33			;FCP DEVICE WRITE ERROR
IE.ALN==-34			;FILE ALREADY ACCESSED ON LUN
IE.SNC==-35			;FILE ID, FILE NUMBER CHECK
IE.SQC==-36			;FILE ID, SEQUENCE NUMBER CHECK
IE.NLN==-37			;NO FILE ACCESSED ON LUN
IE.CLO==-38			;FILE NOT PROPERLY CLOSED
IE.DUP==-57			;ENTER - DUPLICATE NAME IN DIRECTORY
IE.BVR==-63			;BAD VERSION NUMBER
IE.BHD==-64			;BAD FILE HEADER
;
IE.IDU==-92			;INVALID DEVICE OR UNIT NUMBER
;
	RADIX 8			;** END OF RADIX 10 **
	SUBTTL	IMPURE DATA
;
; BUFFERS FOR HEADERS TO AND FROM THE -11
;
HEADER:	BLOCK <HDRLEN+3>/4	;MESSAGE HEADER FROM -11
FNCHDR:	BLOCK <HDRLEN+3>/4	;MESSAGE TO -11
;
; STACK
;
PDL:	BLOCK PDLEN		;STACK
;
; VARIABLES
;
INICLR==.			;START OF AREA TO CLEAR ON STARTUP
IFN FTDB,<
FSJFN:	BLOCK 1			;JFN OF FRONT-END-FILE-SYSTEM FILE
DSKOFS:	BLOCK 1			;OFFSET IN BLOCKS TO UNIT WITH F-E-F-S ON IT
FEADDR:	BLOCK 1			;SECTOR ADDRESS OF F-E-F-S
FESIZE:	BLOCK 1			;SIZE (IN SECTORS) OF F-E-F-S
CFSPAG:	BLOCK 1			;CURRENT F-E-F-S PAGE #
CFSSIZ:	BLOCK 1			;CURRENT F-E-F-S AREA SIZE MAPPED IN PAGES
> ;END IFN FTDB
;
IF TOPS-20,<
FEJFN:	BLOCK 1			;JFN OF FE DEVICE
CHN1PC:	BLOCK 1			;PC AT CHANNEL 1 PSI
FNMBLK:	BLOCK 10+10+10+3	;FILE NAME STRING BUFFER
FILFDB:	BLOCK .FBLEN		;WHOLE FDB
>; END IF TOPS-20
IF TOPS-10,<
CHNMSK:	BLOCK 1			;MASK OF ACTIVE CHANNELS
TMPFIL:	BLOCK 1			;CURRENT NUMBER FOR TEMP FILES
IFN FTDTE.,<
FEDNUM:	BLOCK 1			;FE DEVICE #
DTEFNC:	BLOCK 1			;CURRENT DTE. FUNCTION CODE
>; END IFN FTDTE.
IFE FTDTE.,<
FEJFN:	BLOCK 1			;JFN OF FE DEVICE
>; END IFE FTDTE.
>; END OF IF TOPS-10
;
BLKSIZ:	BLOCK 1			;SIZE OF CURRENT INPUT BLOCK IN BYTES FROM FE
USECNT:	BLOCK 1			;USE COUNT OF FILE-ID'S
DATBUF:	BLOCK 5			;SCRATCH FOR DATE TEXT
;
ATTRCB:	BLOCK	10		;SCRATCH ATTRIBUTE CONTROL BLOCK
FILHDR:	BLOCK 1000/4		;SIMULATED FILE HEADER FOR FCP
STSBLK:	BLOCK 3			; . . STATISTICS BLOCK
FILHDE:				;END OF FILE HEADER DATA
;
FIDTAB:				;FILE-ID CORRESPONDENCE BLOCK:
REPEAT FIDNUM,<
	PHASE 0
 FIDFID==.
	 BLOCK 1		;FILE-ID OF FILE (LH= INDEX INTO FIDTAB
				; RH= SEQUENCE #
 FIDJFN==.
	 BLOCK 1		;JFN OF FILE
	FJ.WLN==1B0		;WILD NAME
	FJ.WLT==1B1		;WILD TYPE
	FJ.WLG==1B2		;WILD GENERATION #
	FJ.WLD==FJ.WLN!FJ.WLT!FJ.WLG ;WILD ARGS TO GETNAM
	FJ.ALL==1B3		;STRUCTURE NAME IS ALL STRUCTURES
	FJ.DSK==1B4		;STRUCTURE NAME IS DISK SEARCH LIST
 FIDFLG==.
	 BLOCK 1		;FLAGS WORD
	FI.ACC==1B0		;FILE IS ACCESSED
	FI.WRT==1B1		;FILE IS ACCESSED FOR WRITE
	FI.TMP==1B2		;FILE IS TEMP FILE (I.E. NO NAME YET)
	FI.ASC==1B3		;FILE IS 7-BIT ASCII
 FIDNAM==.
	 BLOCK 1		;LH= FILENAME (1) RH= FILENAME (2)
 FIDTYP==.
	 BLOCK 1		;LH= FILENAME (3)  RH= FILE TYPE
 FIDVER==.
	 BLOCK 1		;LH= FILE VERSION #
 FIDUIC==.
	 BLOCK 1		;RH= UIC OF FILE OWNER
 FIDUCT==.
	 BLOCK 1		;USE COUNT
 FIDFBP==.
	 BLOCK 1		;CURRENT FILE BYTE POINTER
IF TOPS-10,<
 FIDSTR==.
	 BLOCK 1		;CURRENT STRUCTURE NAME FOR WILD LOOKUPS
 FIDDIX==.
	 BLOCK 1		;DIRECTORY INDEX FOR CURRENT WILD FILE
 FIDLEB==.
	 BLOCK .RBALC+1		;EXTENDED LOOKUP/ENTER BLOCK
>; END IF TOPS-10
 ;
 FIDSIZ==.			;SIZE OF EACH BLOCK
	DEPHASE
>; END REPEAT FIDNUM
FIDTBE:
;
CLREND==.-1
;
; UIC-DIRECTORY CORRESPONDENCE TABLE
;
UICSIZ==0			;SIZE OF ENTRY
UICUIC==1			;CORRESPONDING UIC
IF TOPS-20,<
UICNAM==2			;START OF NAME IN ASCIZ
>; END IF TOPS-20
IF TOPS-10,<
UICSTR==2			;STRUCTURE NAME IN SIXBIT, OR 0 (ALL) OR 1 (DSK)
UICPTH==2			;PATH BLOCK STARTS HERE: JUNK
UICSCS==3			;SCAN SWITCH= 0
UICPPN==4			;P,PN
UICSFD==5			;FIRST WORD OF SFD SPECS
>; END IF TOPS-10
IF TOPS-20,<
DEFINE .UIC(PJ,PG,NAME,%END),<
	EXP %END-.		;LENGTH OF ENTRY
	BYTE (36-16)0 (8)PJ (8)PG ;UIC= [PJ,PG]
	ASCIZ /NAME/		;DIRECTORY <NAME>
%END==.				;END OF THE ENTRY
>
>; END IF TOPS-20
IF TOPS-10,<
DEFINE .UIC(PJ,PG,STR,PROJ,PROG,%END),<
	EXP %END-.		;LENGTH OF ENTRY
	BYTE (36-16)0 (8)PJ (8)PG ;UIC= [PJ,PG]
	EXP STR
	EXP 0
	XWD PROJ,PROG
	EXP 0
%END==.				;END OF THE ENTRY
>
;
IFN 0,<
	.UIC 1,1,0,1,1
	.UIC 1,4,0,1,4
	.UIC 5,5,0,10,3606
	.UIC 5,6,0,10,757
	EXP 0
>; END IFN 0
UICTAB:
	BLOCK 10*UICNUM
	BLOCK 1
UICTBL==.-UICTAB
>; END IF TOPS-10
;
; MISC. DATA BUFFER
;
IF TOPS-20,<
	LOC	100K		;ALSO MORE RANDOM
>; END IF TOPS-20
SCRBUF:				;THIS IS BUFFER SPACE
IF TOPS-10,<
	BLOCK 2K
>; END IF TOPS-10
;
; BUFFER FOR DUMP I/O
;
IF TOPS-20,<
	LOC	200K		;ALSO MORE RANDOM
>; END IF TOPS-20
DMPBUF:
IF TOPS-10,<
	BLOCK 2K
>; END IF TOPS-10
;
IFN FTDB,<
;
; PAGE BUFFER FOR I/O TO AND FROM THE -11 FILE SYSTEM
;
	LOC	300K		;RANDOM PLACE
;
FEFBUF:				;HERE ON IS BUFFER SPACE
>; END IFN FTDB
IF TOPS-20,<
	RELOC
>; END IF TOPS-20
	SUBTTL PURE DATA
;
; ENTRY VECTORS
;
ENTVEC:	JRST START		;START
IF TOPS-20,<
	JRST FEWAIT		;REENTER
>; END IF TOPS-20
IF TOPS-10,<
	LOC 137
>; END IF TOPS-10
	BYTE (3)VWHO (9)VFE (6)VMINOR (18)VEDIT
IF TOPS-10,<
	RELOC
>; END IF TOPS-10
IF TOPS-20,<
;
; PSI TABLES
;
LEVTAB:	EXP CHN1PC,0,0
CHNTAB:	EXP 0,0,0,0,0,0,0,0,0	;00-08: UNUSED
	XWD 1,ILLTRP		;09: PDL OV
	EXP 0			;10: UNUSED
	XWD 1,IOERR		;11: FILE DATA ERROR
	EXP 0,0,0		;12-14: UNUSED
	XWD 1,ILLTRP		;15: ILLEGAL INSTRUCTION
	XWD 1,ILLTRP		;16: ILLEGAL MEMORY READ
	XWD 1,ILLTRP		;17: ILLEGAL MEMORY WRITE
	XWD 1,ILLTRP		;18: ILLEGAL MEMORY EXECUTE
	EXP 0			;19: UNUSED
	XWD 1,ILLTRP		;20: MACHINE SIZE EXCEEDED
	EXP 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0 ;21-35: UNUSED
;
; UIC-DIRECTORY TABLE
;
UICTAB:
	.UIC 1,1,SYSTEM
	.UIC 1,2,OPERATOR
	.UIC 1,4,SUBSYS
	.UIC 5,5,FRONT-END
	EXP 0			;END OF TABLE
>; END OF IF TOPS-20
IF TOPS-10,<
;
; DUMP I/O LIST
;
DMPLST:
	IOWD 200,DMPBUF
	EXP 0
>;END IF TOPS-10
	SUBTTL	INITIALIZATION
IF TOPS-20,<
;
; HERE ON PANIC CHANNEL PSUEDO-INTERRUPT
;
ILLTRP:	WARN <PANIC CHANNEL INTERRUPT -- RESTARTING>,,X
>; END IF TOPS-20
;
; INITIALIZE
;
START:	RESET			;RESET I/O STATE
	MOVE P,[IOWD PDLEN,PDL]	;INITIALIZE STACK POINTER
	SETZB F,INICLR		;CLEAR FLAGS, AND FIRST WORD OF STORAGE
	MOVE T1,[XWD INICLR,INICLR+1] ;SET TO CLEAR
	BLT T1,CLREND		; ALL OF VARIABLES
;
; INITIALIZE FE DEVICE
;
IFE FTDTE.,<
;
; ASSIGN A JFN TO DEVICE 'FE' AND OPEN IT
;
	MOVEI P1,0		;START WITH FE #0
;
GETFE:	HRROI T1,SCRBUF		;POINT TO NAME AREA
	HRROI T2,[ASCIZ/FE/]	;GET FIRST PART OF NAME
	SETZ T3,		;IN ASCIZZ
	SOUT			;PUT IT IN SCRBUF
	MOVE T2,P1		;GET THE # OF FE WE WANT THIS TIME
	MOVX T3,^D8		; IN OCTAL
	NOUT			;STORE IN GTJFN STRING
	 JSHLT			;OOPS
	MOVEI T2,":"		;FINISH IT OFF
	IDPB T2,T1		; . .
	MOVEI T2,0		; . .
	IDPB T2,T1		; . .
;
	MOVX T1,GJ%OLD!GJ%SHT	;1/ OLD FILE, SHORT GTJFN CALL
	HRROI T2,SCRBUF		;2/ ASCIZ FILE STRING
	GTJFN			;ASSIGN A JFN TO FE
	 JRST [CAIE 1,GJFX29		;IS DEVICE NOT AVAILABLE?
	        JSHLT			;YES-- GIVE UP
	       AOJA P1,GETFE]		;NO-- TRY AGAIN
	MOVEM T1,FEJFN		;SAVE THE JFN FOR FE0
;
	MOVX T2,<^D16>B5!OF%RD!OF%WR ;2/ OPEN FOR READ, WRITE, 16 BIT BYTES
	OPENF			;OPEN FE0
	 JRST [CAIE T1,OPNX7		;DEVICE NOT AVAILABLE?
	        JSHLT			;NO-- GIVE UP
	       HRRZ T1,FEJFN		;YES-- GET THE JFN
	       RLJFN			; AND RELEASE IT
		JFCL			;OOPS
	       AOJA P1,GETFE]		;AND TRY AGAIN
	MOVX T2,.MODTE		;2/ FUNCTION: GET A DTE
	MOVX T3,0		;3/ DTE #0
	MTOPR			;GET A DTE
	ERJMP JSHLT0		;OOOOOPS
;
	MOVE T1,FEJFN		;1/ JFN OF FE DEVICE
	MOVX T2,.MOEOF		;2/ PERFORM AN END-OF-FILE
	MOVX T3,0		;3/ REALLY SEND THE EOF
	MTOPR			;TELL -11 WE HAVE JUST RESTARTED
;
>; END IFE FTDTE.
IFN FTDTE.,<
GETFE:
	MOVEI T1,.DTEGF		;FUNCTION= GET FE DEVICE
	CALL DTESET		;SET UP REGISTERS
	DTE. T4,		;ATTEMPT TO GET AN FE
	 JRST [	CAIN T4,DTENF%		;NON-EX FE DEVICE?
		 WARN <FE DEVICE NOT AVAILABLE>,[EXIT]
		CAIE T4,DTEFB%		;BUSY WITH ANOTHER JOB?
		 CALL DTEERR		;NO-- OTHER FATAL ERROR
		AOS FEDNUM		;YES-- GET NEXT FED #
		JRST GETFE]		;AND TRY AGAIN
	MOVEI T1,.DTEFS		;SET FE DEVICE STATUS
	MOVX T3,DT.EOF		; TO END-OF-FILE
	CALL DTEUUO		; . . .
>; END IFN FTDTE.
;
; MORE INITIALIZATION . . .
;
IF TOPS-20,<
	MOVX T1,.FHSLF		;1/ OUR FORK
	MOVE T2,[XWD LEVTAB,CHNTAB] ;2/ TABLE ADDRESSES
	SIR			;SET INTERRUPT TABLE ADDRESSES
	MOVX T2,1B9+1B11+1B15+1B16+1B17+1B18+1B20 ;2/ PANIC CHANNELS
	AIC			;ENABLE PANIC CHANNELS
	EIR			;ENABLE THE PSUEDO-INTERRUPT SYSTEM
>; END IF TOPS-20
IF TOPS-10,<
	MOVX T1,-1B15&<^-<1B0>>	;GET BITS 1-15
	MOVEM T1,CHNMSK		;SET CHANNELS 1-15 AVAILABLE
;
	TIMER T1,		;GET A RANDOM NUMBER
	MOVEM T1,TMPFIL		;INIT TEMP FILE NUMBER
;
; READ FEUIC.TXT INTO UICTAB
;
; EACH LINE IN FEUIC.TXT IS FORMATTED AS FOLLOWS:
;
;	[GRP,USR]=STR:[P,PN,SFD,SFD,...]
;
; WHERE:
;	[GRP,USR] IS THE UIC TO BE DEFINED.
;	STR: IS A FILE STRUCTURE NAME,
;		IF "DSK:" THEN DSK SEARCH LIST IS USED,
;		IF BLANK THEN ALL SYSTEM STRUCTURES ARE SEARCHED.
;	[P,PN,SFD,SFD,...] IS THE DIRECTORY FOR THIS UIC.
;
; THE NUMBER OF UIC'S ALLOWED IS GOVERNED BY THE PARAMETER "UICNUM".
;
; SFD'S MAY BE SPECIFIED ONLY IF FTPATH IS ENABLED (NOT COMPLETELY CODED).
;
; COMMENTS MAY BE ENTERED IN THE FILE BY USING EITHER ";" OR "!".
;
REDUIC:
	PUSH P,.JBFF		;SAVE .JBFF FOR NOW
	MOVNI P4,2		;INIT LOOP FLAG
	MOVE P3,[IOWD UICTBL,UICTAB] ;POINT TO DIRECTORY TABLE
REDIRT:
	AOJG P4,[WARN (<SYS:FEUIC.TXT FILE NOT AVAILABLE>,REDIRX,X)]
	MOVSI T2,'SYS'		;GET FIRST DEVICE
	SKIPL P4		;FIRST TIME THROUGH?
	 MOVSI T2,'DSK'		;NO-- TRY DISK
	MOVX T1,.IOASL		;ASCII, LINE MODE
	MOVX T3,<XWD 0,SCRBUF>	;POINT TO INPUT BEFFER HEADER ADDRESS
	OPEN T1			;OPEN SYS OR DSK
	 JRST REDIRT		;TRY THE OTHER DEVICE
	DMOVE T1,[SIXBIT /FEUIC/
		  SIXBIT /TXT/]
	SETZB T3,T4		;SET TO LOOKUP FEUIC.TXT
	LOOKUP T1		;FIND FILE
	 JRST REDIRT		;TRY AGAIN
REDIR3:
	MOVE P2,P3		;SAVE THIS ADDRESS
	CALL REDCHR		;GET FIRST CHAR ON LINE
	JUMPL C,REDIRX		;EOF-- ALL DONE
	CAIN C,12		;END-OF-LINE?
	 JRST REDIR3		;YES-- IGNORE BLANK LINES
	CAIE C,"["		;LEGAL START DELIMITER?
	 JRST REDERR		;NO
	PUSH P3,[EXP 0]		;STORE A ZERO TO BE FIXED LATER
	CALL REDOCT		;GET OCTAL USER GROUP CODE
	SKIPG P1,T1		;SAVE THAT NUMBER
	 JRST REDERR		;ZERO OR -VE IS NO GOOD
	CAIG T1,377		;TOO BIG?
	CAIE C,","		;RIGHT SEPERATOR?
	 JRST REDERR		;NO
	CALL REDOCT		;GET USER NUMBER
	JUMPLE T1,REDERR	;0, -VE N.G.
	CAIG T1,377		;SMALL ENOUGH?
	CAIE C,"]"		;RIGHT SEPERATOR?
	 JRST REDERR		;NO
	LSH P1,^D8		;SHIFT GROUP TO HIGH BYTE
	IOR T1,P1		;MUSH IT ALL TOGETHER
	PUSH P3,T1		;STORE THE UIC
;
	CALL REDCHR		;GET NEXT CHAR
	CAIE C,"="		;PROPER SEP?
	 JRST REDERR		;NO
	CALL REDSIX		;GET SIXBIT STR NAME
	CAMN T1,[SIXBIT/DSK/]	;IS IT "DSK"?
	 MOVEI T1,1		;YES-- SPECIAL FLAG
	PUSH P3,T1		;SAVE THE STR NAME
	JUMPE T1,REDIR4		;IF NO STR NAME, THEN USE ALL:
	CAIE C,":"		;PROPER DEVICE TERMINATOR?
	 JRST REDERR		;NO
	CALL REDCHR		;GET NEXT CHAR
REDIR4:
	CAIE C,"["		;PROPER START?
	 JRST REDERR		;NO
	PUSH P3,[EXP 0]		;SCAN SWITCH= 0
	CALL REDOCT		;GET PROJECT #
	SKIPG P1,T1		;SAVE IT
	 JRST REDERR		; . . .
	CAIG P1,777777		;SIZE OK?
	CAIE C,","		;SEPARATOR OK?
	 JRST REDERR		;NO
	CALL REDOCT		;GET PROG #
	JUMPLE T1,REDERR	;OOPS
	CAILE P1,777777		;OK?
	 JRST REDERR		;NO
	HRL T1,P1		;MUSH IN PROJ #
	PUSH P3,T1		;SAVE P,PN
REDIR5:
IFE FTPATH,<
	CAIE C,"]"		;END-OF-LINE?
	 JRST REDERR		;NO DICE . . .
>; END IFE FTPATH
IFN FTPATH,<
	CAIN C,"]"		;END-OF-LINE?
	 JRST REDNXT		;YES-- GET NEXT LINE
	CAIE C,","		;GOOD SEPERATOR?
	 JRST REDERR		;NO
	CALL REDSIX		;GET SFD NAME
	JUMPE T1,REDERR		;NO NAME IS NO GOOD
	PUSH P3,T1		;SAVE THE NAME
	JRST REDIR5		;BACK FOR MORE
>; END IFN FTPATH
;
REDNXT:
	CALL REDCHR		;GET NEXT CHARACTER
	CAIE C,12		;MUST BE END-OF-LINE
	 JRST REDERR		;NO DICE
	PUSH P3,[EXP 0]		;TERMINATE THE LIST
	MOVE T1,P2		;GET INITIAL ADDRESS
	SUBM P3,T1		;FIND LENGTH OF THIS ENTRY
	HRRZM T1,1(P2)		;STORE LENGTH BACK AT START OF ENTRY
	JRST REDIR3		;GO BACK FOR ANOTHER LINE
;
REDERR:
	WARN <SYNTAX ERROR IN FE UIC-DIRECTORY CORRESPONDENCE FILE FEUIC.TXT>,,X
	MOVE P3,P2		;RESTORE ADDRESS POINTER
REDER1:
	CALL REDEAT		;EAT THIS LINE
	JRST REDIR3		;TRY FOR NEXT LINE
;
REDOCT:
	MOVX T1,0		;START OUT EMPTY
REDOC1:
	CALL REDCHR		;GET CHARACTER
	CAIL C,"0"		;OC-
	CAILE C,"7"		; TAL?
	 RETURN			;NO-- ALL DONE
	ASH T1,^D3		;MULTIPLY BY ^O10
	ADDI T1,-"0"(C)		;ADD IN CURRENT DIGIT
	JRST REDOC1		;BACK FOR MORE
;
REDSIX:
	SETZ T1,		;RESET THE VALUE
	MOVE T2,[POINT 6,T1]	;POINT TO INPUT
REDSX1:
	CALL REDCHR		;GET A CHARACTER
	CAIL C,"A"		;ALPHA-
	CAILE C,"Z"		; BETIC?
	 JRST [	CAIL C,"0"		;NO-- NUM-
		CAILE C,"9"		; ERIC?
		 RETURN			;NO-- GIVE UP
		JRST .+1]		;YES-- USE NUMBER
	SUBI C," "-' '		;CONVERT TO SIXBIT
	TRNN T1,77		;LAST CHARACTER IN ALREADY?
	 IDPB C,T2		;NO-- STORE THIS ONE
	JRST REDSX1		;BACK FOR SOME MORE SX
;
REDCHR:
	SOSGE SCRBUF+2		;DECREMENT BYTE COUNT
	 JRST [	IN			;EXHAUSTED-- GET ANOTHER BUFFER
		 JRST REDCHR		;OK-- TRY AGAIN
		MOVX C,-1		;EOF OR ERROR-- MARK EOF
		RETURN]			;AND BACK TO CALLER
	ILDB C,SCRBUF+1		;GET NEXT CHARACTER
	CAIE C,0		;NULL?
	CAIN C,15		;<CR>?
	 JRST REDCHR		;YES-- IGNORE
	CAIE C," "		;IGNORE SPACES
	CAIN C,"	"	; AND TABS
	 JRST REDCHR		; . . .
	CAIE C,"!"		;COMMENT?
	CAIN C,";"		; ??
	 CALLR REDEAT		;YES-- EAT IT
	CAIL C,"@"+40		;LOWER CASE?
	 SUBI C,40		;YES-- CONVERT TO UPPER
	RETURN			;AND DONE WITH REDCHR
;
REDEAT:
	CALL REDCHR		;GET ANOTHER CHARACTER
	CAIL C,0		;EOF??
	CAIN C,12		;<LF>?
	 RETURN			;YES-- RETURN NOW
	JRST REDEAT		;NO-- KEEP ON EATING
;
REDIRX:
	PUSH P3,[EXP 0]		;TERMINATE THE TABLE
	RELEASE			;FINISH OFF I/O CHANNEL 0
	POP P,.JBFF		;RESTORE .JBFF
>; END IF TOPS-10
;
IFN FTDB,<
;
; SEE IF THERE IS REALLY A FILES-11 AREA ON THIS SYSTEM, AND WHERE IT IS
;
REDHM1:	MOVEI T1,1		;START WITH BLOCK #1
REDHM2:	MOVEI T2,1K		;A BLOCK'S WORTH OF BYTES
	MOVE T4,T1		;SAVE THAT BLOCK
	CALL DSKIN		;READ THE HOM BLOCK
	 JRST REDHM5		;OOPS-- LET'S TRY AANOTHER ONE
	MOVE T1,SCRBUF+HOMNAM	;GET THE NAME OF THIS BLOCK
	CAME T1,[SIXBIT/HOM/]	;MATCH A HOM BLOCK'S NAME?
	 JRST REDHM5		;NO, SORRY
	MOVE T1,SCRBUF+HOMSNM	;GET THE STRUCTURE NAME
	CAME T1,[SIXBIT/PS/]	;IS THIS THE PUBLIC STRUCTURE?
	 JRST REDHM7		;NO-- CAN'T HAVE THE F-E-F-S
	HLRZ P1,SCRBUF+HOMFE0	;GET FIRST -11 WORD OF FE INFO (HIGH ADDR)
	TXZN P1,BIT15		;THIS THE RIGHT PLACE?
	 JRST REDHM6		;NO-- LOOK FOR ANOTHER PACK
	LSH P1,^D16		;YES-- SHIFT TO HIGH WORD
	HRRZ T1,SCRBUF+HOMFE0	;GET THE LOW ADDR
	IOR P1,T1		;MUSH TOGETHER AS WHOLE DISK ADDRESS
	HLRZ P2,SCRBUF+HOMFE1	;NOW GET THE SIZE, HIGH PART
	LSH P2,^D16		;SHIFT IT UP TO THE RIGHT AREA
	HRRZ T1,SCRBUF+HOMFE1	;LOW PART, TOO
	IOR P2,T1		;BOTH TOGETHER, SIZE OF AREA IN P2
	JRST FNFEFS		;NOW TO FIND THE FILE ITSELF
;
REDHM5:	WARN <BAD HOM BLOCK>,,X
	MOVEI T1,^D10		;TRY NEXT HOM BLOCK, IF THAT ONE BAD
	SOJE T4,REDHM2		; AND IF THAT WAS HOM BLOCK 1
	JRST FEWAIT		;ELSE WE HAVE NO F-E-F-S
;
REDHM6:	MOVE T1,SCRBUF+HOMLUN	;GET THE LUN WITHIN PS OF THIS UNIT
	HLRZ T2,T1		; AND THE TOTAL UNITS IN THIS STRUCTURE
	CAIG T2,(T1)		;THIS LAST (OR WORSE) UNIT IN PS?
	 WARN <NO FRONT END FILE SYSTEM>,FEWAIT
;
REDHM7:	MOVE T1,SCRBUF+HOMSIZ	;ON TO NEXT UNIT-- GET THE SIZE OF THIS UNIT
	ADDM T1,DSKOFS		; AND BUMP THE OVERALL DISK ADDRESS
	JUMPG T1,REDHM1		;OK-- BACK TO READ NEXT UNIT
	WARN <ZERO LENGTH UNIT FOUND WHILE LOOKING FOR FRONT END FILE SYSTEM>,FEWAIT,X
;
; ALSO GET A JFN FOR THE FRONT-END-FILE-SYSTEM
;
FNFEFS:	MOVX T1,GJ%OLD!GJ%SHT	;1/ OLD FILE, SHORT GTJFN
	HRROI T2,[ASCIZ/<ROOT-DIRECTORY>FRONT-END-FILE-SYSTEM.BIN/]
	GTJFN			;ASSIGN JFN TO THE FILE SYSTEM
	 JRST [JSERR
	       WARN (<<ROOT-DIRECTORY>FRONT-END-FILE-SYSTEM.BIN NOT AVAILABLE>,FEWAIT,X)]
	MOVEM T1,FSJFN		;SAVE THE JFN
;
	MOVX T2,OF%RD!OF%WR	;2/ READ, WRITE ACCESS
	OPENF			;OPEN THE FILE-SYSTEM
	 JRST [JSERR
	       WARN (<<ROOT-DIRECTORY>FRONT-END-FILE-SYSTEM.BIN NOT AVAILABLE>,FEWAIT,X)]
	MOVEM P1,FEADDR		;SAVE THE FOUND ADDRESS OF THE AREA
	MOVEM P2,FESIZE		;SAVE THE SIZE OF THE AREA
;
>; END IFN FTDB
	SUBTTL WAIT FOR SOMETHING FROM THE -11 TO DO
;
; HERE WHEN WE ARE DONE WITH A REQUEST
;
; WAIT FOR A REQUEST FROM THE -11, OR AN IPCF INTERRUPT FROM THE -20
;
FEWAIT:	MOVE P,[IOWD PDLEN,PDL]	;RESET STACK
	SETZ F,			;RESET ALL FLAGS
	MOVEI HDR,HEADER	;POINT TO THE INPUT BUFFER FOR THE NEXT HEADER
	MOVE T2,HDR		; ALSO FOR FEIN
	MOVEI T3,HDRLEN		;READ 12 BYTES OF HEADER
	CALL FEIN		;WAIT FOR IT
;
; WE HAVE AN -11 REQUEST-- PROCESS IT
;
	TXO F,F.PROC		;WE HAVE GOT SOMETHING-- NO IPCF NOW
	LOAD T1,HDRSZ;		;GET WORDS TO READ
	MOVNM T1,BLKSIZ		;SAVE THAT, IN CASE OF FAILURE OF FUNCTION
	LOAD T1,HDRFN;		;GET THE FUNCTION
	TXNE T1,BIT15		;-VE FUNCTION (RESPONSE)?
	 JRST FEPRSP		;YES-- PROCESS THAT
	MOVN T2,T1		;NO-- MAKE THIS FUNCTION
	STOR T2,HDRFN;		; INTO A RESPONSE
;
	LOAD T2,HDRDV;		;GET THE DEVICE CODE
IFN FTDB,<
	CAIN T2,<BYTE (36-16)0(8)"B","D"> ;IS THIS DB (RP04)?
	 JRST DBPROC		;YES-- PROCESS REQUEST
>; END IFN FTDB
	CAIN T2,<BYTE (36-16)0(8)"E","F"> ;IS THIS FE (TOPS-20 FILE REWUEST)?
	 JRST FEPROC		;YES-- CHECK IT OUT
	WARN <ILLEGAL DEVICE NAME FROM -11 -- RESTARTING>,START,X
;
IF TOPS-20,<
;
; HERE ON I/O ERROR PSI
;
IOERR:	TXZN F,F.PROC		;DOING A REQUEST?
	 JRST ILLTRP		;NO-- WE ARE SICK
	MOVEI T1,RETXXX		;YES-- SEND IT BACK
	MOVEM T1,CHN1PC		; . .
	MOVEI T1,IE.ABO		; WITH OUR LOVE, OF COURSE
	DEBRK			;RETURN THE ERROR
>; END IF TOPS-20
	SUBTTL PROCESS FUNCTION RESPONSE FROM -11
;
; HERE WITH RESPONSE FUNCTION CODE FOR A FUNCTION WE REQUESTED
;
FEPRSP:	WARN <RESPONSE CODE RECIEVED WITHOUT REQUEST -- RESTARTING>,START,X
	SUBTTL PROCESS REQUEST FOR "DB" -- RP04
;
IFN FTDB,<
;
; REQUESTS FOR PR04 ARE TAKEN HERE
;
; FUNCTIONS ACCEPTED:
;	IO.RLB
;	IO.WLB
;
DBPROC:	LSH T1,-^D8		;GET HIGH FUNCTION CODE
	CAIN T1,IO.RLB_-^D8	;THIS READ LOGICAL?
	 JRST DBPRLB		;YES-- DO READ
	CAIE T1,IO.WLB_-^D8	;WRITE LOGICAL?
	 RETERR IE.IFC
	TXO F,F.WRIT		;YES-- SAY TO WRITE
;
DBPRLB:	LOAD T1,HDRP1;		;GET PARAMETER 1
	LSH T1,^D16		;MOVE TO HIGH PART OF BLOCK #
	LOAD T2,HDRP2;		;GET LOW PART FROM SECOND PARAMETER
	IORB T1,T2		;GET BLOCK # TO BOTH T1 AND T2
	SUB T1,FEADDR		;COMPUTE RELATIVE BLOCK IN F-E-F-S FILE
	JUMPL T1,DBPRL1		;BELOW START-- SEE IF HOM BLOCKS
	LOAD T3,HDRSZ;		;GET SIZE OF REQUESTED READ/WRITE
	ADDI T3,1K-1		;ROUND UP
	ASH T3,-^D9		; TO NEXT BLOCK (OF BYTES)
	ADD T3,T1		;ADD CURRENT LENGTH IN BLOCKS
	CAML T1,FESIZE		;WITHIN RANGE?
	 RETERR IE.BLK
	IDIVI T1,4		;CONVERT RELATIVE BLOCK TO PAGE IN FILE
	MOVE T4,T2		;SAVE THE OFFSET WITHIN THE PAGE
	ADDI T3,4-1		;ROUND UP LAST BLOCK
	ASH T3,-2		; TO NEXT PAGE
	SUB T3,T1		;COMPUTE LENGTH OF AREA TO BE TRANSFERRED IN PAGES
	CAMN T1,CFSPAG		;IS THIS PAGE SAME AS LAST ONE?
	CAMLE T3,CFSSIZ		; AND WITHIN LAST RANGE?
	 SKIPA			;NO-- MUST DO ANOTHER PMAP
	JRST DBPRW1		;YES-- PMAP ALREADY DONE
	MOVEM T1,CFSPAG		;SAVE THIS PAGE
	MOVEM T3,CFSSIZ		; AND LENGTH IN PAGES
	HRL T1,FSJFN		;MAKE HANDLE TO THE F-E-F-S FILE
	MOVE T2,[XWD .FHSLF,FEFBUF/1K] ;MAKE DEST. HANDLE TO OUR BUFFER
	TXO T3,PM%RD!PM%WT!PM%CNT ;READ, WRITE, ITERATION COUNT OF PAGES IN B17-35
	PMAP			;MAP THE CURRENT SEGMENT OF THE F-E-F-S FILE TO BUFFER
;
; THE DESIRED SEGMENT OF THE FILE HAS BEEN MAPPED TO FEFBUF
;
DBPRW1:	MOVE T2,T4		;COPY THE OFFSET IN BLOCKS FROM THE BEGGINGING OF THE PAGE
	ASH T2,^D7		;CONVERT IN TO A WORD (-20) ADDRESS
	ADDI T2,FEFBUF		; WITHIN THE BUFFER
	LOAD T3,HDRSZ;		;GET # BYTES TO BE TRANSFERRED
	TXNN F,F.WRIT		;IS THIS A WRITE REQUEST?
	 JRST DBPRL2		;NO-- GO DO A READ
;
; WRITE REQUEST
;
	CALL FEIN		;INPUT ALL THE DATA TO BE WRITTEN
	MOVE T1,CFSPAG		;GET CURRENT PAGE #
	HRL T1,FSJFN		; IN F-E-F-S FILE
	MOVE T2,CFSSIZ		;AND SIZE OF MAPPED AREA
	UFPGS			;UPDATE FILE PAGES
	 RETERR IE.VER
	JRST DBPRL4		;FINISH WRITE REQUEST
;
; READ BLOCK NOT IN FILE SYSTEM-- MUST BE LESS THAN 10. (HOM BLOCKS)
;
DBPRL1:	SKIPN FESIZE		;IS THERE A FILE SYSTEM???
	 RETERR IE.BLK		;NO-- SORRY, CAN'T READ THAT BLOCK
	TXNE F,F.WRIT		;WRITING??
	 JRST DBPRL3		;YES-- ONLY BLOCK 0 (BOOT)
	MOVE T1,T2		;GET THE BLOCK #
	LOAD T2,HDRSZ;		; AND LENGTH TO TRANSFER
	CALL DSKIN		;READ THE BLOCK
	 RETERR IE.VER		;OOPS
	LOAD T3,HDRSZ;		;GET THE SIZE BACK TO TRANSFER
	MOVEI T2,SCRBUF		;WHERE THE BLOCK IS AT
;
; READ DATA BACK TO THE FE DEVICE
;
DBPRL2:	HRLZ T1,T3		;WITH PROPER # BYTES TRANSFERRED
	JRST DBPRL5		;FINISH REQUEST
;
; WRITE REQUEST OUT OF -11 AREA-- ONLY BOOT BLOCK 0 ALLOWED
;
DBPRL3:	LOAD T3,HDRSZ;		;GET THE SIZE OF REQUESTED TRANSFER
	CAIN T2,0		;THIS TO BLOCK 0?
	CAILE T3,1K		; AND LESS THAN ONE BLOCK?
	 RETERR IE.VER
	MOVEI T2,SCRBUF		;POINT TO DISK BUFFER
	CALL FEIN		;READ IT IN
	SETZ T1,		;SET TO BLOCK 0 ONLY
	LOAD T2,HDRSZ;		; AND THE TRANSFER SIZE
	CALL DSKOUT		;WRITE THAT BLOCK (0)
	 RETERR IE.VER
;
; FINISH WRITE REQUEST
;
DBPRL4:	LOAD T1,HDRSZ;		;GET REQUESTED SIZE, IN BYTES
	MOVS T1,T1		;SET AS PARAMETER #2
	SETZ T3,		;NO BYTES
;
; FINISH REQUEST
;
DBPRL5:	HRRI T1,IS.SUC		;SAY SUCCESS AS PARAMETER #1
	CALL FEHDR		;SEND THAT HEADER
	JRST FEWAIT		;BACK FOR ANOTHER
;
>; END IFN FTDB
	SUBTTL PROCESS REQUEST FOR FILE CONTROL
;
; DEVICE REQUESTED IS FE-- PERFORM SPECIFIED FUNCTION
;
FEPROC:	CAIN T1,IO.FCP		;IS THIS FILE CONTROL FUNCTION?
	 JRST T20FCP		;YES-- DO THE FILE-CONTROL PRIMITIVES
	RETERR IE.IFC,X		;NO-- ILLEGAL FUNCTION
	SUBTTL FE DEVICE I/O ROUTINES
;
; FEIN -- READ A BUFFER FROM THE FE DEVICE
;	T2 -- ADDRESS OF BUFFER TO STORE DATA
;	T3 -- LENGTH OF BUFFER IN 8 BIT BYTES
;
; T1,T2,T3,T4 USED
;
FEIN:	ADDM T3,BLKSIZ		;DECREMENT COUNT OF BYTES LEFT IN THIS PACKET
IFE FTDTE.,<
	MOVE T1,FEJFN		;1/ JFN OF FE DEVICE
	HRLI T2,(POINT 18,)	;2/ INPUT STRING POINTER
	ADDI T3,1		;3/ LENGTH OF STRING
	ASH T3,-1		; IN 18 BIT BYTES
	MOVN T3,T3		; -VE COUNT
	SIN			;READ THE BLOCK FROM THE FE DEVICE
	GTSTS			;CHECK OUT THE STATUS
	TXNN T2,GS%EOF		;END-OF-FILE?
>; END IFE FTDTE.
IFN FTDTE.,<
	ADDI T3,1		;ROUND UP
	ASH T3,^D<18-1>		; TO WORDS IN LH
	HRR T3,T2		;GET BUFFER ADDRESS
	MOVEI T1,.DTEIF		;INPUT FROM FE
	CALL DTEUUO		; . . .
	MOVEI T1,.DTEFG		;GET FE DEVICE STATUS
	CALL DTEUUO		; . . .
	TXNN T4,DT.EOF		;END-OF-FILE??
>; END IFN FTDTE.
	 RETURN			;RETURN OK
	WARN <EOF ON FE DEVICE -- RESTARTING>,START,X
;
; RETOK -- RETURN IS.SUC (SUCCESS) AND BACK TO WAITING
;
RETOK:	MOVEI T1,IS.SUC		;SUCCESS
;
; RETXXX -- RETURN ERROR CODE IN STATUS
;	T1 -- ERROR CODE
;
RETXXX:	MOVN T3,BLKSIZ		;GET BYTES LEFT IN PACKET
	JUMPLE T3,RETXX1	;OK IF ALL READ
	PUSH P,T1		;SAVE THE CODE
	MOVEI T2,SCRBUF		;POINT TO RANDOM BUFFER
	CALL FEIN		;READ THE TRASH
	POP P,T1		;RESTORE ERROR CODE
;
RETXX1:	SETZ T3,		;NO BUFFER
	CALL FEHDR		;OUTPUT THE HEADER
	JRST FEWAIT		;BACK TO WAITING
;
; FEHDR -- OUTPUT A BLOCK TO THE FE DEVICE, WHITH HEADER
;	T1 -- RH: PARAMETER #1, LH: PARAMETER #2
;	T2 -- ADDRESS OF BUFFER
;	T3 -- SIZE OF BUFFER IN 8 BIT BYTES
;	HDR -- ADDRESS OF CURRENT HEADER
;
; T1,T2,T3,T4 USED
;
FEHDR:	PUSH P,T2		;SAVE ADDR
	PUSH P,T3		; AND SIZE
	STOR T1,HDRP1;		;STORE THE STATUS
	MOVS T1,T1		;GET SECOND PARAM
	STOR T1,HDRP2;		; . . .
	STOR T3,HDRSZ;		;AND THE SIZE OF THE TRANSFER BLOCK
	MOVEI T2,HEADER		;POINT TO HEADER
	MOVEI T3,HDRLEN		;SET TO HEADER SIZE
	CALL FEOUT		;SEND IT
	POP P,T3		;RESTORE
	POP P,T2		; . . .
	JUMPE T3,CRET		;THAT'S IT IF NO DATA
	CALLRX FEOUT		;ELSE OUTPUT THE DATA BLOCK
;
; FEOUT -- OUTPUT A BLOCK TO THE FE DEVICE
;	T2 -- ADDRESS OF BLOCVK
;	T3 -- SIZE OF BLOCK IN 8 BIT BYTES
;
; USES T4,T2,T3,T1
;
FEOUT:
IFE FTDTE.,<
	MOVE T1,FEJFN		;1/ JFN OF FE DEVICE
	HRLI T2,(POINT 18,)	;2/ 18-BIT BYTE POINTER TO SOURCE STRING
	ADDI T3,1		;3/ SIZE OF STRING
	ASH T3,-1		; IN 16 BIT BYTES
	MOVN T3,T3		; -VE COUNT
	SOUT			;SEND TO FE DEVICE
	MOVX T2,.MOEOF		;PERFORM AN EOF FUNCTION
	MOVX T3,-1		; BUT DON'T SEND EOF
	MTOPR			;SO AS TO FORCE OUT THE BUFFER
	RETURN			;RETURN FROM FEOUT
>; END IFE FTDTE.
IFN FTDTE.,<
	ADDI T3,1		;ROUND UP
	ASH T3,^D<18-1>		; TO WORDS IN LH
	HRR T3,T2		;GET BUFFER ADDRESS
	MOVEI T1,.DTEOF		;OUTPUT TO FE DEVICE
	CALLRX DTEUUO		;OUTPUT TO FE DEVICE AND RETURN FROM FEOUT
;
; DTEUUO -- PERFORM DTE. UUO FUNCTION
;	T1 -- FUNCTION CODE
;	T3 -- ADDITIONAL DATA
; RETURNS +1:
;	T4 -- DATA FROM DTE. UUO
;
DTEUUO:
	CALL DTESET		;SET UP REGISTERS
	DTE. T4,		;DO A DTE UUO
	 CALLR DTEERR		;ERROR-- TYPE IT OUT
	RETURN			;OK-- RETURN FROM DTEUUO
;
; DTESET -- SET UP REGISTERS FOR DTE. UUO
;	T1 -- DTE FUNCTION CODE
; RETURNS +1:
;	T1 -- XWD 0,-1		;CPU 0, PRIV DTE-20
;	T2 -- FE DEVICE #
;	T4 -- XWD FUNC,T1
;
DTESET:
	MOVEM T1,DTEFNC		;SAVE THE FUNCTION CODE FOR ERROR TYPEOUT
	MOVS T4,T1		;COPY FUNCTION CODE TO LH
	HRRI T4,T1		;SET ADDRESS OF DTE FUNCTION BLOCK
	MOVX T1,<XWD 0,-1>	;CPU #, DTE #
	MOVE T2,FEDNUM		;GET FE DEVICE #
	RETURN			;FROM DTESET
;
; DTEERR -- REPORT DTE. UUO FAILURE
;
DTEERR:
	OUTSTR [ASCIZ/% DTE. UUO FAILURE /]
	MOVE T1,T4		;GET ERROR CODE
	CALL TYPOCT		;TYPE IT
	OUTSTR [ASCIZ/ FOR FUNCTION /]
	MOVE T1,DTEFNC		;GET SAVED CODE
	CALL TYPOCT		;TYPE IT
	EXIT 1,			;GIVE UP
	RETURN			;CONTINUE WILL GO ON . . .
>; END IFN FTDTE.
;
IFN FTDB,<
;
; DSKIN/DSKOUT -- READ/WRITE A PHYSICAL DISK BLOCK TO/FROM SCRBUF
;	T1 -- BLOCK #
;	T2 -- SIZE OF DATA IN 8 BIT BYTES
;
; USED T1,T3,T2
;
DSKOUT:	ADDI T2,3		;2/ SIZE OF BUFFER
	ASH T2,-2		;   IN WORDS
	TXO T2,DOP%WR		;DO A WRITE
	JRST DSKIO		;DO IT...
;
DSKIN:	ADDI T2,3		;2/ SIZE OF BUFFER
	ASH T2,-2		;   IN WORDS
;
DSKIO:	TXO T1,DOP%SA		;1/ SOFTWARE DISK ADDRESS
	ADD T1,DSKOFS		;ADD IN OFFSET FOR THIS UNIT
	ADDI T2,200-1		;2/ BUFFER SIZE IN WORDS
	TXZ T2,200-1		;   ROUNDED UP TO 200 WORDS
	MOVEI T3,SCRBUF		;3/ ADDRESS OF DATA BUFFER
	DSKOP			;PERFORM READ
	JUMPN T1,CRET		;ERROR-- RETURN +1
	CALLRX CRET1		;OK-- RETURN +2
;
>; END IFN FTDB
;
CRET1:	AOS (P)			;OK-- RETURN +2
CRET:	RETURN			;RETURN FROM DSKIN
	SUBTTL TOPS-20 FILE CONTROL REQUEST
;
; HERE WITH REQUEST FOR FE DEVICE, FUNCTION IO.FCT (FILE CONTROL)
;
T20FCP:	LOAD T3,HDRSZ;		;GET THE REQUESTED SIZE OF DATA TO COME HERE
	MOVEI T2,SCRBUF		;POINT TO SCRACTH BUFFER
	CALL FEIN		;READ THEM BYTES
	LOAD T1,HDRP1;		;GET THE I/O FUNCTION CODE OF THE PRIMITIVE
	LSH T1,-^D8		; BUT JUST THE MAJOR CODE
	CAIL T1,LOWFNC		;WITHIN RANGE?
	CAILE T1,HGHFNC		; FOR A FILE-CONTROL FUNCTION?
ILLFNC:	 RETERR IE.IFC
	CALL @FCPDSP-LOWFNC(T1)	;CALL THE REQUESTED FUNCTION CODE
;
; HERE ON COMPLETION OF A FUNCTION
;	T1 -- (LH) SECOND I/O STATUS WORD (RH) BYTE COUNT TO RETURN TO -11
;
FCPXIT:	HRRZ T3,T1		;COPY LENGTH OF RETURN BLOCK
	HRRI T1,IS.SUC		;SAY SUCCESS NOW
	MOVEI T2,SCRBUF		;RETURN DATA IN SCRBUF, ALSO
	CALL FEHDR		;SEND THE SUCCESS INFO TO THE -11
	JRST FEWAIT		;THAT'S ALL FOLKS
;
; DISPATCH TABLE FOR FILE PRIMITIVES
;
LOWFNC==11			;LOWEST FUNCTION ALLOWED
FCPDSP:
	EXP FCPFNA		;(11) FNA: FIND FILENAME IN DIRECTORY
	EXP ILLFNC		;(12) UNUSED
	EXP FCPRNA		;(13) RNA: REMOVE NAME FROM DIRECTORY
	EXP FCPENA		;(14) ENA: ENTER NAME IN DIRECTORY
	EXP FCPACR		;(15) ACR: ACCESS FOR READ
	EXP FCPACW		;(16) ACW: ACCESS FOR READ, WRITE
	EXP FCPACE		;(17) ACE: ACCESS FOR READ, WRITE, EXTEND
	EXP FCPDAC		;(20) DAC: DEACCESS FILE
	EXP FCPRVB		;(21) RVB: READ VIRTUAL BLOCK
	EXP FCPWVB		;(22) WVB: WRITE VIRTUAL BLOCK
	EXP FCPEXT		;(23) EXT: EXTEND FILE
	EXP FCPCRE		;(24) CRE: CREATE FILE
	EXP FCPDEL		;(25) DEL: DELETE FILE
	EXP FCPRAT		;(26) RAT: READ ATTRIBUTES
	EXP FCPWAT		;(27) WAT: WRITE ATTRIBUTES
	EXP FCPAPC		;(30) APC: ACP CONTROL
HGHFNC==30
;
; HERE TO RETURN NOTHING TO THE -11
;
FCPZX:	TDZA T1,T1		;SAY NOTHING
;
; HERE TO RETURN BYTE COUNT FROM P4
;
FCPP4X:	HRRZ T1,P4		;COPY BYTE COUNT
	RETURN			;RETURN SUCCESS
	SUBTTL FNA -- FIND FILE-NAME IN DIRECTORY
;
;
FCPFNA:	LOAD T2,N.DID;		;GET DIRECTORY ID
	CAME T2,[XWD 177777,177777] ;ID OF MFD?
	 JRST FCPFNF		;NO-- LOOK FOR A FILE
;
; FIND DIRECTORY NAME
;
	MOVEI P4,UICTAB		;POINT TO TABLE OF DIRECTORIES
;
	LOAD T2,N.DOW;		;GET DIRECTORY OWNER
	LOAD T1,N.STAT;		;GET FLAGS FOR THIS FILE
	TXNE T1,NB.SNM		;WILD NAME?
	 LOAD T2,N.NEXT;	;YES-- START LOOKING AT "NEXT" DIRECTORY
IF TOPS-20,<
	CAIGE T2,340B<35-8>	;THIS UIC GREATER THAN [340,0]?
	 JRST FCPFD1		;NO-- SCAN THE TABLE
	MOVE T4,T2		;COPY DIRECTORY UIC
	SUBI T2,340B<35-8>	;YES-- GET DIRECTORY NUMBER
	HRROI T1,FNMBLK		;SCRATCH AREA TO STORE NAME
	DIRST			;GET DIRECTORY NAME
	 RETERR IE.NSF		;NO SUCH DIRECTORY
	JRST FCPFD3		;STORE THE NAME
>; END IF TOPS-20
;
FCPFD1:	SKIPN T3,UICSIZ(P4)	;GET SIZE OF THIS BLOCK
	 RETERR IE.NSF		;END OF LIST-- NOT FOUND
	CAMG T2,UICUIC(P4)	;UIC MATCH?
	 JRST FCPFD2		;YES-- GOT IT
	ADD P4,T3		;NO-- BUMP TO NEXT ENTRY IN DIRECTORY TABLE
	JRST FCPFD1		;LOOP FOR ALL UIC'S IN TABLE
;
FCPFD2:	MOVE T4,UICUIC(P4)	;GET DIRECTORY WE FOUND
	TXNE T1,NB.SNM		;WILD?
	 JRST FCPFD3		;YES-- OK
	CAME T2,T4		;NO-- EXACT MATCH?
	 RETERR IE.NSF		;NO-- NOT FOUND
;
; CONVERT DIRECTORY NAME TO RAD50 AS FILE NAME
;
FCPFD3:
IF TOPS-20,<
	MOVE T1,[POINT 7,FNMBLK] ;POINT TO SCRATCH TEXT AREA
	MOVX T3,NO%LFL!NO%ZRO+3B17+^D8B35 ;OCTAL, 3 COLUMNS
	LDB T2,[POINT 8,T4,35-8] ;GET HIGH BYTE
	NOUT			;MAKE IT TEXT
	 RETERR IE.RER
	LDB T2,[POINT 8,T4,35-0] ;THEN LOW BYTE
	NOUT			;TEXT, ALSO
	 RETERR IE.RER
	HRROI T2,[ASCIZ/.DIR.0/] ;MAKE IT A DIRECTORY
	SETZ T3,		;ASCIZ
	SOUT			;PUT IN STRING
>; END IF TOPS-20
IF TOPS-10,<
	MOVEI FID,DMPBUF	;POINT TO SCRATCH AREA
	CALL CLRFNM		;RESET FILE-NAME BLOCK
	LDB T2,[POINT 8,T4,35-8] ;GET HIGH BYTE
	CALL OCTSIX		;CONVERT OCTAL TO SIXBIT
	HLLZM T3,FIDLEB+.RBNAM(FID) ;STORE AS FIRST THREE CHARS OF NAME
	LDB T2,[POINT 8,T4,35-0] ;THEN LOW BYTE
	CALL OCTSIX		;YOU TOO
	HLRM T3,FIDLEB+.RBNAM(FID) ; . .
	MOVX T1,<SIXBIT/DIR/>	;DIRECTORY FILE TYPE
	MOVEM T1,FIDLEB+.RBEXT(FID) ; . .
>; END IF TOPS-10
	CALL PUTNAM		;PUT THE FOUND NAME IN THE FNB
	 RETERR IE.RER
;
	MOVEI T1,1(T4)		;GET NEXT POSSIBLE DIRECTORY NUMBER
	STOR T1,N.NEXT;		;STORE THE DIRECTORY NUMBER FOR WILD
	HRLI T4,BIT15		;MAKE IT A DIRECTORY FID
	STOR T4,N.FID;		;STORE IT IN THE FNB
	JRST FCPDRX		;RETURN THE NEW FNB
;
; FIND FILENAME
;
FCPFNF:	LOAD T1,N.NEXT;		;GET CONTEXT FOR WILD LOOKUP, IF ANY
	JUMPN T1,FCPFNW		;N.NEXT SPECIFIED-- DO A WILD
	CALL ALCFID		;GET A FILE-ID
	CALL GETNAM		;CONVERT RAD50 NAME TO TEXT STRING
IF TOPS-20,<
	MOVX T1,GJ%OLD!GJ%SHT!GJ%IFG ;SET SHORT JFN, FILE MUST EXIST, INPUT FILE GROUP
	GTJFN			;GET THE JFN FOR THE FILE
>; END IF TOPS-20
IF TOPS-10,<
	CALL LOOK		;LOOKUP WILD(?) FILE
>; END IF TOPS-10
	 RETERR IE.NSF
	MOVEM T1,FIDJFN(FID)	;STORE JFN BACK IN FILE-ID BLOCK
	LOAD T1,N.DID;		;GET DIRECTORY ID
	MOVEM T1,FIDUIC(FID)	;STORE THE UIC FOR LATER
	JRST FCPFNN		;GET THE NAME
;
; WILD NAME FROM LAST TIME-- CHECK IT OUT
;
FCPFNW:	MOVE FID,T1		;COPY THE SPECIFIED N.NEXT AS FILE-ID
	IMULI FID,FIDSIZ	;MAKE IT AN OFFSET
	ADDI FID,FIDTAB-FIDSIZ	; INTO FIDTAB
	CAIL FID,FIDTBE		;BEYOND END?
	 RETERR IE.SNC		;YES-- BAD FILE-ID
;
FCPFWN:	MOVE T2,FIDFLG(FID)	;GET THE FLAGS
	TXNN T2,FI.ACC		;ACCESSED?????
	SKIPN T1,FIDJFN(FID)	;GET THE JFN
	 RETERR IE.RER
	SETZM FIDFLG(FID)	;RESET THE FLAGS FOR THE NEW FILE
	AOS FIDFID(FID)		;GET NEW SEQUENCE #
IF TOPS-20,<
	GNJFN			;GET NEXT FILE
>; END IF TOPS-20
IF TOPS-10,<
	CALL WLOOKN		;LOOKUP NEXT FILE
>; END IF TOPS-10
	 JRST [SETZM FIDJFN(FID)	;FAILED-- NO LONGER JFN'ED
	       RETERR (IE.NSF,X)]	;SAY NO SUCH FILE
	CALL SETUCT		;NOTE THAT THIS FILE-ID HAS BEEN USED
;
FCPFNN:
IF TOPS-20,<
	HRRZ T2,FIDJFN(FID)	;GET THE JFN, ONLY
	HRROI T1,FNMBLK		;STRING POINTER TO THE NAME
	MOVX T3,1B8+1B11+1B14+1B35 ;FILE.EXT.VER
	JFNS			;CONVERT WHAT JFN WE HAVE TO A STRING
>; END IF TOPS-20
	CALL PUTNAM		;STORE THE FILE-NAME
	 JRST FCPFWN		;TOO LONG-- LOOK AGAIN
;
	MOVE T1,FIDFID(FID)	;GET THE FILE-ID OF THIS FILE
	STOR T1,N.FID;		;STORE THE DOUBLE-WORD IN FNB
	HLRZ T1,T1		;GET THE FILE-ID NUMBER
	STOR T1,N.NEXT;		; AND SAVE FOR NEXT FNA
;
	MOVE T1,[PNTR (N.FNM0)]	;POINT TO THE FNB TO STORE
	MOVE T2,[POINT 18,FIDNAM(FID)] ;ALSO TO BEFORE NAME TO SAVE IT
	CALL MOVNAM		;MOVE THE FILE-NAME
;
	MOVX P1,FI.ASC		;GET ASCII FILE BIT
IF TOPS-20,<
	CALL GETFDB		;GET THE FDB FOR THIS FILE
	LDB T1,[POINT 6,FILFDB+.FBBYV,11] ;GET THE FILE'S BYTE SIZE
	CAIN T1,^D18		;BINARY FILE FOR SURE?
	 JRST FCPDRX		;YES-- ALL DONE
	CAIE T1,^D7		;ASCII FILE FOR SURE?
>; END IF TOPS-20
IF TOPS-10,<
	LDB T1,[POINT 4,FIDLEB+.RBPRV(FID),12] ;GET FILE MODE
	CAIN T1,.IOIMG		;IMAGE BINARY?
	 JRST FCPDRX		;YES-- FILE IS BINARY FOR SURE
	CAILE T1,.IOASL		;MODE= 0 OR 1 (ASCII)?
>; END IF TOPS-10
	CALL CHKTYP		;NO-- SEE IF BINARY FILE TYPE
	 IORM P1,FIDFLG(FID)	;NOT BINARY-- SET ASCII FLAG
	JRST FCPDRX		;RETURN FILE-NAME BLOCK TO -11
	SUBTTL	RNA, ENA -- REMOVE/ENTER NAME IN DIRECTORY
;
;
FCPRNA:	CALL FCPFNF		;FIND THE FILE TO REMOVE
IF TOPS-10,<
	HRRZ T1,FIDJFN(FID)	;GET CHANNEL #
	CALL XCTUUP		;LOOKUP CURRENT FILE
	LOOKUP FIDLEB(FID)	; . . .
	 RETERR IE.RER
	PUSH P,FID		;SAVE CURRENT FILE-ID
	MOVEI FID,DMPBUF	;POINT TO SCRATCH AREA
>; END IF TOPS-10
	CALL GETTMP		;GET A TEMP FILE TO RENAME THIS ONE TO
	JRST FCPERN		;DO THE RENAME
;
;
FCPENA:	CALL GETFID		;GET THE FILE-ID OF THE FILE BEING ENTERED
	MOVE T4,FIDFLG(FID)	;GET THE FLAGS FOR THIS FILE
	TXNE T4,FI.TMP		;THIS A TEMP FILE (MUST BE)?
	TXNE T4,FI.ACC		;FILE ACCESSED?
	 RETERR IE.ALN
IF TOPS-10,<
	HRRZ T1,FIDJFN(FID)	;GET CHANNEL #
	CALL XCTUUP		;LOOKUP TEMP FILE
	LOOKUP FIDLEB(FID)	; . . .
	 RETERR IE.RER
	PUSH P,FID		;SAVE CURRENT FILE-ID
	MOVEI FID,DMPBUF	;POINT TO SCRATCH AREA
>; END IF TOPS-10
	CALL GETNAM		;GET THE NAME HE WANTS TO ENTER IT AS
	TXNE T1,FJ.WLD		;WILD  *'S SEEN?
	 RETERR IE.BAD
IF TOPS-20,<
	MOVX T1,GJ%FOU!GJ%SHT!GJ%NEW ;NEXT VERSION, MUST BE NEW FILE, SHORT CALL
	GTJFN			;GET A JFN FOR IT IN T1
	 RETERR IE.DUP
>; END IF TOPS-20
;
; T1 = FILE-NAME TO BE, FID POINTS TO FILE-ID BLOCK OF EXISTING FILE
;
FCPERN:
IF TOPS-20,<
	HRRZ T2,T1		;COPY FINAL JFN
	HRRZ T1,FIDJFN(FID)	;GET THE EXISTING JFN
	RNAMF			;RENAME THE FILE
	 RETERR IE.RER
	HRRZM T2,FIDJFN(FID)	;STORE THE NEW JFN
>; END IF TOPS-20
IF TOPS-10,<
	POP P,T2		;GET FID FOR EXISTING FILE
	EXCH T2,FID		;T2= FID AREA FOR NEW FILE, FID= OLD FILE
	HRRZ T1,FIDJFN(FID)	;GET CHANNEL #
	CALL XCTUUP
	RENAME FIDLEB(T2)	;RENAME TO/FROM TEMP FILE
	 RETERR IE.DUP
	HRLZI T1,FIDLEB(T2)	;SUCCESS-- SET NEW FILE-NAME
	HRRI T1,FIDLEB(FID)	; INTO OLD FID BLOCK
	BLT T1,FIDLEB+.RBALC(FID) ; . . .
>; END IF TOPS-10
	MOVX T1,FI.TMP		;GET TEMP FILE BIT
	XORM T1,FIDFLG(FID)	;SET/CLEAR IT
	SETZRO N.NEXT;		;NO WILD CARDS ALLOWED
;	JRST FCPDRX		;RETURN THE NEW FILE-NAME BLOCK
;
; ALL DONE. RETURN FILE-NAME BLOCK
;
FCPDRX:	MOVEI T1,S.DRFN		;RETURN WHOLE BLOCK
	RETURN			;FROM DIRECTORY OPERATION
	SUBTTL ACR, ACW, ACE -- ACCESS FILE
;
;
FCPACE:
FCPACW:	TXO F,F.WRIT		;NOTE WRITE ACCESS
FCPACR:	CALL FCPRAT		;READ THE ATTRIBUTES, IF ANY
;
	HRRZ T1,FIDJFN(FID)	;GET CHANNEL #
	MOVE T4,FIDFLG(FID)	;GET THE FLAGS
	TXNE T4,FI.ACC		;ALREADY ACCESSED?
	 RETERR IE.ALN
	TXO T4,FI.ACC!FI.WRT	;ASSUME SUCCESS FLAGS
IF TOPS-20,<
	MOVX T2,OF%RD+^D7B5	;ASSUME READ, ASCII
	TXNN T4,FI.ASC		;ASCII FILE?
	 MOVX T2,OF%RD+^D18B5	;NO-- USE 18 BIT BYTES, -11 STYLE
	TXNE F,F.WRIT		;WRITE ACCESS?
	 TXOA T2,OF%WR		;YES-- SAY SO
	TXZ T4,FI.WRT		;NO-- MARK NOT WRITE ACCESS
	OPENF			;OPEN THE FILE
	 RETERR IE.RER		;OOPS
>; END IF TOPS-20
IF TOPS-10,<
	CALL XCTUUP		;LOOKUP FILE . .
	LOOKUP FIDLEB(FID)	; . . .
	 RETERR IE.RER
	TXNN F,F.WRIT		;WRITE ACCESS REQUESTED?
	 JRST FCPAC1		;NO-- DON'T ALLOW IT
	CALL XCTUUP		;IN UPDATE MODE,
	ENTER FIDLEB(FID)	;ATTEMPT TO ENTER THE FILE
	 RETERR IE.WER
	JRST FCPAC2
;
FCPAC1:
	TXZ T4,FI.WRT		;NO-- DON'T ALLOW IT
FCPAC2:
>; END IF TOPS-10
	SETZM FIDFBP(FID)	;RESET FILE BYTE POINTER
	MOVEM T4,FIDFLG(FID)	;SET THE NEW ACCESS BITS
	JRST FCPP4X		;RETURN THE ATTRIBUTE BLOCK FROM ACCESS
	SUBTTL DAC -- DEACCESS FILE
;
;
FCPDAC:	CALL FCPWAT		;WRITE THE FILE ATTRIBUTES
	MOVE P1,FIDFLG(FID)	;GET THE FLAGS FOR THIS FILE
	TXNN P1,FI.ACC		;FILE ACCESSED?
	 RETERR IE.NLN		;NO-- CAN'T DEACCESS IT
	MOVX T1,FI.WRT!FI.ACC	;CLEAR THE OPEN BITS
	ANDCAM T1,FIDFLG(FID)	; FOR THIS FILE
IF TOPS-20,<
	HRRZ T1,FIDJFN(FID)	;GET THE JFN FOR THE FILE
	TXO T1,1B0		;DON'T RELEASE THE JFN
	CLOSF			;CLOSE THE FILE
	 RETERR IE.WER		;OOPS
>; END IF TOPS-20
	TXNN P1,FI.WRT		;ACCESSED FOR WRITE?
	 JRST FCPDA9		;NO-- DON'T SET EOF
;
; ACCESSED FOR WRITE-- MUST UPDATE EOF IF SPECIFIED
;
	LOAD T1,H.HEFB;		;GET HIGH PART EOF BLOCK #
	LSH T1,^D16		;INTO HIGH WORD
	LOAD T2,H.LEFB;		;ALSO LOW PART
	IOR T2,T1		;GET EOF BLOCK # INTO T2
	SOJL T2,FCPZX		;START VBN'S AT 1-- SKIP IF NO EOF SPECIFIED
	ASH T2,^D9		;CONVERT VBN TO BYTES
	LOAD T3,H.FFBY;		;GET FIRST FREE BYTE IN THAT LAST BLOCK
	ADDB T3,T2		;EOF BYTE NOW IN T3 AND T2
	HRRZ T1,FIDJFN(FID)	;GET JFN OF THE FILE
IF TOPS-20,<
	TXNE P1,FI.ASC		;ASCII FILE?
	 JRST FCPDA3		;YES-- BYTE COUNT IS OK
	ADDI T3,1		;NO-- ROUND UP
	ASH T3,-1		; TO WORDS
;
FCPDA3:	HRLI T1,.FBSIZ		;SET TO CHANGE SIZE IN BYTES
	MOVX T2,-1		;WHOLE WORD TO CHANGE
	CHFDB			;CHANGE THE EOF BYTE POINTER
>; END IF TOPS-20
IF TOPS-10,<
	MOVEI T4,^D4		;ASSUME BINARY
	TXNE P1,FI.ASC		;ASCII FILE?
	 MOVEI T4,^D5		;YES-- FIVE BYTES/WORDS
	ADDI T2,-1(T4)		;ROUND UP
	IDIV T2,T4		; TO WORDS
	IDIVI T2,200		;FULL BLOCKS TO T2, EXTRA WORDS TO T3
	JUMPE T3,FCPDA3		;SKIP INPUT IF NO EXTRA WORDS
	MOVN T3,T3		;GET -VE WORDS EXTRA
	HRLZ T3,T3		;FORM
	HRRI T3,DMPBUF-1	; IOWD TO DMPBUF
	MOVX T4,0		;END I/O LIST
	CALL XCTUUO
	USETI 1(T2)		;SET TO INPUT LAST PARTIAL BLOCK
	CALL XCTUUO
	IN T3			;INPUT LAST BLOCK
	SKIPA			;OK-- GO ON
	 RETERR IE.RER
FCPDA3:
	ADDI T2,2		;COUNT THE RIBS
	MOVEM T2,FIDLEB+.RBALC(FID) ;STORE # FULL BLOCKS TO TRUNCATE TO
	SUBI T2,2		;BACK TO REAL SIZE
	CALL XCTUUP
	RENAME FIDLEB(FID)	;TRUNCATE AND CLOSE FILE
	 RETERR IE.WER
	JUMPLE T2,FCPDA4	;WRITING FROM BEGINNING OF FILE-- SUPERCEDE
	JUMPE T3,FCPZX		;ALL DONE IF NO EXTRA WORDS
	CALL XCTUUP
	LOOKUP FIDLEB(FID)	;RE-LOOKUP FILE
	 RETERR IE.RER
FCPDA4:
	CALL XCTUUP
	ENTER FIDLEB(FID)	;RE-ENABLE UPDATE MODE
	 RETERR IE.WER
	JUMPE T3,FCPDA9		;DONE IF NO WORDS TO WRITE
	CALL XCTUUO
	USETO 1(T2)		;SET OUTPUT TO LAST BLOCK (NOW NON-EX)
	CALL XCTUUO
	OUT T3			;OUTPUT EXTRA WORDS IN LAST BLOCK
	 SKIPA
	RETERR IE.WER
>; END IF TOPS-10
FCPDA9:
IF TOPS-10,<
	CALL CLOSEF		;CLOSE FILE
	 RETERR IE.WER		;OOPS
>; END IF TOPS-10
	JRST FCPZX		;DONE WITH DAC
	SUBTTL EXT, CRE, DEL -- EXTEND/CREATE/DELETE FILE
;
;
FCPEXT:	CALL GETFID		;CHECK OUT THE FILE-ID
	MOVSI T1,4		;SET EXTEND SIZE TO 4 BLOCKS (I/O STATUS WORD 2)
	RETURN			;FROM FCPEXT
;
;
FCPCRE:	CALL ALCFID		;ALLOCATE A FILE-ID FOR THE FILE
	CALL GETTMP		;GET A TEMPORARY JFN
IF TOPS-10,<
	CALL GETCHN		;GET A FREE CHANNEL
	 RETERR IE.NOD
	MOVX T2,.IODMP		;DUMP MODE
	MOVX T3,<SIXBIT/DSK/>	; FOR DEVICE DSK:
	MOVX T4,0		;NO BUFFERS
	CALL XCTUUO
	OPEN T2			;OPEN DEVICE NOW
	 JRST FCPCRF		;OOPS!!
>; END IF TOPS-10
	MOVEM T1,FIDJFN(FID)	;STORE THE TEMP JFN
	MOVE T1,FIDFID(FID)	;GET THE FILE-ID
	STOR T1,FILID;		;SAVE TO RETURN TO THE -11
	CALL FCPWAT		;WRITE ATTRIBUTES, IF ANY TO SET UP HEADER
	MOVE T1,[PNTR (I.FNM0)]	;POINT TO FILE-NAME FROM HEADER
	MOVE T2,[POINT 18,FIDNAM(FID)] ;POINT TO FILE-ID BLOCK TOO
	CALL MOVNAM		;MOVE THE NAME, 5 WORDS
	MOVX P1,FI.TMP		;GET TEMP FILE BIT FOR NOW
	LOAD T1,H.RTYP;		;GET RECORD TYPE BYTE
	TXNE T1,2		;VARIABLE RECORD LENGTH (I.E. FORMATTED FILE)?
	 JRST FCPCR1		;YES-- MUST BE BINARY FILE
	CALL CHKTYP		;SEE IF BINARY FILE TYPE
	 TXO P1,FI.ASC		;NO-- MUST BE AN ASCII FILE
FCPCR1:
	IORM P1,FIDFLG(FID)	;SET THE FLAGS
	HRRZ T1,FIDJFN(FID)	;GET THE JFN TO OPEN
IF TOPS-20,<
	MOVX T2,OF%RD!OF%WR	;OPEN FOR READ/WRITE
	OPENF			;OPEN THE FILE
	 JRST FCPCRF		;FAILED-- RELEASE AND COMPLAIN
	TXO T1,1B0		;DON'T RELEASE THE CLOSED JFN
	CLOSF			;CLOSE THE FILE TO CREATE IT
>; END IF TOPS-20
IF TOPS-10,<
	CALL XCTUUP
	ENTER FIDLEB(FID)	;ATTEMPT TO WRITE SUCH FILE
	 JRST FCPCRF
	CALL CLOSEF		;CLOSE FILE
>; END IF TOPS-10
	 JRST FCPCRF		;FAILED-- RELEASE JFN
	MOVEI T1,4		;OK-- SET TO RETURN THE FILE-ID
	RETURN			;RETURN THE FILE-ID FROM CREATE
;
FCPCRF:	HRRZ T1,FIDJFN(FID)	;GET THE JFN BACK
	SETZM FIDJFN(FID)	;NO LONGER A VALID FILE-ID
IF TOPS-20,<
	RLJFN			;RELEASE THE JFN
	 JFCL			;OOPS
>; END IF TOPS-20
IF TOPS-10,<
	CALL RELCHN		;RELEASE CHANNEL
>; END IF TOPS-10
	RETERR IE.IFU,X
;
;
FCPDEL:	CALL GETFID		;GET THE FILE-ID OF THE THING HE WANTS US TO DELETE
	LOAD T1,FILP1;		;GET EXTEND WORD
	TXNE T1,BIT15		;ENABLED (FOR TRUNCATE)?
	 JRST FCPZX		;YES-- DO NOTHING FOR TRUNCATE
	HRRZ T1,FIDJFN(FID)	;GET THE JFN OF THE FILE TO DELETE
IF TOPS-20,<
	DELF			;DELETE THE FILE
>; END IF TOPS-20
IF TOPS-10,<
	CALL XCTUUP
	LOOKUP FIDLEB(FID)	;LOOKUP THE FILE
	 RETERR IE.RER
	SETZB T2,T3		;RENAME TO ZERO= DELETE
	CALL XCTUUO
	RENAME T2		;ZAP!!
>; END IF TOPS-10
	 RETERR IE.WER		;OOPS!
	SETZM FIDJFN(FID)	;NO LONGER JFN'D
IF TOPS-10,<
	CALL RELCHN		;RELEASE CHANNEL
>; END IF TOPS-10
	JRST FCPZX		;RETURN HAPPY FROM DELETE
	SUBTTL RVB, WVB -- READ/WRITE VIRTUAL BLOCK
;
;
FCPWVB:	TXO F,F.WRIT		;NOTE WRITING
FCPRVB:	CALL GETFID		;GET THE SPECIFIED FILE-ID
	MOVE T4,FIDFLG(FID)	;GET THE FLAGS FOR THE FILE
	TXNN T4,FI.ACC		;FILE OPEN?
	 RETERR IE.NLN
	TXNN F,F.WRIT		;WRITING?
	 JRST FCPRW1		;NO-- GO ON
	TXNN T4,FI.WRT		;ACCESSED FOR WRITE?
	 RETERR IE.WAC
;
FCPRW1:	HRRZ T1,FIDJFN(FID)	;GET THE JFN
	LOAD P2,RWVBH;		;GET THE HIGH VBN
	LSH P2,^D16		;SHIFT TO HIGH WORD
	LOAD T3,RWVBL;		;GET LOW VBN
	IOR P2,T3		;MUSH IT TOGETHER
	SOJGE P2,FCPRW2		;VIRTUAL BLOCKS START AT 1
	RETERR IE.BLK,X
;
FCPRW2:
;
IF TOPS-20,<
	ASH P2,^D9		;CONVERT IT TO A BYTE OFFSET
	TXNN T4,FI.ASC		;THIS 7-BIT ASCII?
	 ASH P2,-1		;NO-- MAKE IT A WORD OFFSET
	CAMN P2,FIDFBP(FID)	;ARE WE SET TO THE RIGHT POINT IN THE FILE?
	 JRST FCPRW3		;YES-- GO ON
	SFPTR			;NO-- SET THE POINTER
	 RETERR IE.RER
;
FCPRW3:	LOAD P4,RWVSZ;		;GET THE BYTE SIZE REQUESTED
	MOVE T3,P4		;COPY THE COUNT
	TXNE T4,FI.ASC		;7-BIT ASCII?
	 JRST FCPRWA		;YES-- PROCESS THAT
;
	ADDI T3,1		;ROUND UP
	ASH T3,-1		; SIZE TO WORDS
	ADD P2,T3		;COMPUTE WHERE POINTER WILL BE
	MOVEM P2,FIDFBP(FID)	;SAVE THAT AS CURRENT POINTER
	MOVN T3,T3		;-VE BYTE COUNT: NOT ZERO TERMINATED STRING
	TXNE F,F.WRIT		;THIS WRITE?
	 JRST FCPRW5		;YES-- DO THAT
;
	MOVE T2,[POINT 18,SCRBUF] ;NO-- POINT TO READ DATA AREA
	CALL SINCLR		;INPUT THE DATA REQUESTED
	JRST FCPP4X		;RETURN, BYTE COUNT IN P4
;
FCPRW5:	MOVE T2,[PNTR (RWVDW0)]	;POINT TO DATA WORDS
	SOUT			;WRITE THEM WORDS
	JRST FCPZX		;RETURN NOTHING FROM FCPWVB
;
FCPRWA:	ADD P2,T3		;UPDATTE BYTE POINTER
	MOVEM P2,FIDFBP(FID)	; AS CURRENT FILE BYTE POINTER
	TXNE F,F.WRIT		;THIS WRITE?
	 JRST FCPWTA		;YES-- DO IT
;
	MOVN T3,P4		;GET -VE BYTE COUNT
	MOVE T2,[POINT 7,DMPBUF] ;POINT TO DISTANT SCRATCH AREA
	CALL SINCLR		;INPUT THE DATA REQUESTED
	MOVE T1,[POINT 7,DMPBUF] ;GET POINTER TO FRESH DATA
	MOVE T2,[PNTR (BYTE0,SCRBUF)] ;ALSO POINTER TO DATA TO STORE
	MOVE T3,P4		;GET BYTE COUNT TO CONVERT
	CALL ASCBYT		;CONVERT 7-BIT TO 8-BIT ASCII
	JRST FCPP4X		;RETURN, BYTE COUNT IN P4
;
FCPWTA:	MOVE T1,[POINT 7,DMPBUF] ;POINT TO REMOTE SCRATCH
	MOVE T2,[PNTR (RWVDB)]	;ALSO TO WHERE THE DATA IS
	CALL BYTASC		;CONVERT THE 8-BITS TO 7-BITS
	HRRZ T1,FIDJFN(FID)	;GET THE JFN BACK
	MOVE T2,[POINT 7,DMPBUF] ;POINT TO FRASH DATA
	MOVN T3,P4		;GET -VE BYTE COUNT
	SOUT			;WRITE THEM BYTES INTO THE FILE
	JRST FCPZX		;RETURN NOTHING FROM FCPWVB
>; END IF TOPS-20
;
IF TOPS-10,<
	MOVX P3,0		;ASSUME BYTE OFFSET IS ZERO (I.E. BINARY FILE)
	MOVX T2,^D4		; WITH 4 BYTES/WORD
	TXNN T4,FI.ASC		;ASCII FILE?
	 JRST FCPRW3		;NO-- GO ON WITH BIANRY FILE
	ASH P2,^D9		;YES-- GET BYTES UP TO THIS VBN
	IDIVI P2,200*^D5	;GET # 1000 BYTE BLOCKS TO THIS VBN IN P2, BYTE OFFSET TO P3
	MOVX T2,^D5		;ASCII IS 5 BYTES/WORD
FCPRW3:
	CAMN P2,FIDFBP(FID)	;ARE WE AT THE REQUESTED BLOCK?
	 JRST FCPRW4		;YES-- NO NEED TO USET
	CALL XCTUUO
	USETI 1(P2)		;NO-- SET TO CURRENT BLOCK
FCPRW4:
	LOAD P1,RWVSZ;		;GET TRANSFER SIZE IN BYTES
	PUSH P,P1		;SAVE THAT SIZE FOR LATER . . .
	ADD P1,P3		;ADD BYTE OFFSET TO DATA IN BLOCK
	ADDI P1,-1(T2)		;ROUND UP
	PUSH P,P2		;SAVE BLOCK #
	IDIV P1,T2		; TO WORDS TO READ
	POP P,P2		;RESTORE BLOCK #
	EXCH P1,P3		;BYTE OFFSET TO P1, LENGTH IN WORDS TO P3
	ADDI P3,200-1		;ROUND UP
	ASH P3,-^D7		; TO NEXT BLOCK
	MOVE T2,P2		;GET CURRENT BLOCK #
	ADD T2,P3		;COMPUTE END BLOCK
	MOVEM T2,FIDFBP(FID)	;STORE THE NEW BLOCK #
	ASH P3,^D<7+18>		;GET # WORDS TO TRANSFER IN LH
	MOVN P3,P3		;-VE # WORDS
	HRRI P3,DMPBUF-1	; AND DATA ADDRESS-1 FORM IOWD
	MOVX P4,0		;END I/O LIST
;
	TXNE T4,FI.ASC		;ASCII FILE?
	 JRST FCPRWA		;YES-- GO DO IT
	TXNN F,F.WRIT		;WRITING FILE?
	 JRST FCPRDB		;NO-- READ BINARY FILE
;
; WRITE BINARY
;
	POP P,T3		;RESTORE BYTE COUNT
	ADDI T3,1		;ROUND UP
	ASH T3,-1		;CONVERT BYTES TO WORDS
	MOVE T1,[PNTR (RWVDW0)]	;GET POINTER TO DATA TO BE WRITTEN
	MOVE T2,[POINT 18,DMPBUF] ;ALSO WHERE TO MOVE IT TO
	CALL MOVSTR		;MOVE IT
	HRRZ T1,FIDJFN(FID)	;GET CHANNEL #
	JRST FCPWTB		;FINISH WRITE
;
; READ BINARY
;
FCPRDB:
	HRRI P3,SCRBUF-1	;MAKE IOWD POINT TO SCRBUF
	CALL XCTUUO
	IN P3			;INPUT REQUESTED DATA
	 SKIPA			;OK-- GO ON
	RETERR IE.RER
	JRST FCPRDX		;RETURN DATA TO FE
;
; READ/WRITE ASCII
;
FCPRWA:
	TXNE F,F.WRIT		;WRITE FILE?
	 JRST FCPWTA		;YES-- DO IT
;
; READ ASCII
;
	CALL INEOF		;INPUT DATA, IGNORE EOF
	MOVE T3,(P)		;ALSO GET BYTE COUNT SAVED ON STACK
	MOVE T1,P1		;GET # BYTES IN BUFFER BEFORE ACTUAL DATA
	ADJBP T1,[POINT 7,DMPBUF] ;MAKE POINTER TO ACTUAL USER DATA
	MOVE T2,[PNTR (BYTE0,SCRBUF)] ;GET POINTER TO OUTPUT DATA BACK TO FE
	CALL ASCBYT		;CONVERT 7-BIT ASCII TO 8-BIT HALFWORD FORMAT
FCPRDX:
	POP P,P4		;RESTORE BYTE COUNT
	JRST FCPP4X		;RETURN DATA TO FE
;
; WRITE ASCII
;
FCPWTA:
	CALL INEOF		;INPUT DATA, IGNORE EOF
	POP P,T3		;RESTORE BYTE COUNT
	MOVE T1,P1		;GET # BYTES IN BUFFER BEFORE ACTUAL DATA
	ADJBP T1,[POINT 7,DMPBUF] ;MAKE POINTER TO ACTUAL USER DATA
	MOVE T2,[PNTR (RWVDB)]	;GET POINTER TO INPUT DATA IN 8-BIT FORMAT
	CALL BYTASC		;CONVERT 8-BIT TO 7-BIT ASCII
	HRRZ T1,FIDJFN(FID)	;GET CHANNEL #
	CALL XCTUUO
	USETO 1(P2)		;SET OUTPUT BLOCK #
FCPWTB:
	CALL XCTUUO
	OUT P3			;WRITE OLD AND NEW DATA BACK
	 SKIPA			;OK-- GO ON
	RETERR IE.WER
	JRST FCPZX		;RETURN COMPLETE TO -11 FROM FCPWVB
;
>; END IF TOPS-10
	SUBTTL RAT -- READ FILE ATTRIBUTES
;
; NOTE THIS IS ALSO CALLED FROM ACCESS, BYTE COUNT PRESERVED IN P4
;
FCPRAT:	CALL GETFID		;VERIFY THE USER'S FILE-ID
	CALL MAKHDR		;MAKE A FAKE HEADER BLOCK
	MOVE P1,[PNTR (FILAT0)]	;POINT TO ATTRIBUTE CONTROL BLOCK
	MOVE P2,[POINT 18,ATTRCB] ;ALSO POINT TO SCRATCH AREA
FCPRA0:	ILDB T1,P1		;GET A WORD
	IDPB T1,P2		;SAVE IT
	TXNE T1,BIT7		;DONE?
	 JRST FCPRA0		;NO-- SAVE SOME MORE
;
	MOVE P1,[POINT 18,ATTRCB] ;POINT TO START
	MOVE P2,[POINT 18,SCRBUF] ;ALSO POINT TO OUTPUT BUFFER
	SETZ P4,		;START BYTE COUNT AT ZERO
;
FCPRA1:	ILDB T1,P1		;GET A CONTROL WORD
	IDPB T1,P2		;STORE IN OUTPUT, ALSO
	ADDI P4,2		;BUMP BYTE COUNT
	SETZ T2,		;START WITH ZERO SIZE
	ROTC T1,^D<36-8>	;GET THE SIZE FROM HIGH BYTE INTO T2
	ASH T1,^D<8-36>		; AND SIGN-EXTEND FUNCTION INTO T1
	JUMPGE T1,FCPP4X	;ALL DONE IF ZERO (NO +VE FUNCTIONS FOR READ)
	MOVN T1,T1		;MAKE +VE FUNCTION
	CAILE T1,ATRMAX		;TOO BIG??
	 RETERR IE.RER
	MOVE T1,ATRPTR-1(T1)	;GET BYTE POINTER TO REQUESTED ATTRIBUTES
	SKIPN T2		;SIZE= 0?
	 MOVEI T2,1K		;YES-- IMPLIES WHOLE BLOCK
	ADDI T2,1		;ROUND
	ASH T2,-1		; UP TO WORDS
;
FCPRA4:	LDB C,T1		;GET A WORD
	IBP T1			;NOW BUMP THE POINTER
	IDPB C,P2		;SEND TO OUTPUT
	ADDI P4,2		;BUMP BYTE COUNT
	SOJG T2,FCPRA4		;LOOP FOR ALL SUCH ATTRIBUTES
	JRST FCPRA1		;BACK FOR ANOTHER ATTRIBUTE
	SUBTTL WAT -- WRITE ATTRIBUTES
;
;
FCPWAT:	CALL GETFID		;CHECK OUT THE FILE-ID
	CALL CLRHDR		;START WITH A CLEAR HEAD
	MOVE P1,[PNTR (FILAT0)]	;POINT TO ATTRIBUTE CONTROL LIST
;
FCPWA1:	ILDB T1,P1		;GET AN ATTRIBUTE WORD
	SETZ T2,		;CLEAR SIZE WORD
	ROTC T1,^D<36-8>	;SHIFT SIZE INTO T2
	ASH T1,^D<8-36>		;SIGN-EXTEND FUNCTION BYTE IN T1
	JUMPLE T1,FCPZX		;DONE IF ZERO (-VE FUNCTIONS ONLY FOR READ)
	CAILE T1,ATRMAX		;TO BIG?
	 RETERR IE.RER	
	MOVE T1,ATRPTR-1(T1)	;GET POINTER TO DATA IN HEADER
	SKIPN T2		;SIZE= 0?
	 MOVEI T2,1K		;YES-- IMPLIES WHOLE BLOCK
	ADDI T2,1		;ROUND
	ASH T2,-1		; UP TO WORDS
;
FCPWA4:	ILDB C,P1		;GET AN INPUT BYTE
	DPB C,T1		;STORE IN HEADER
	IBP T1			; THEN BUMP THE POINTER
	SOJG T2,FCPWA4		;LOOP FOR ALL THE WORDS
	JRST FCPWA1		;NOW BACK FOR ANOTHER ATTRIBUTE
;
; ATTRIBUTE CONTROL POINTERS
;
ATRPTR:	PNTR (H.FOWN)		;(1) FILE OWNER
	PNTR (H.FPRO)		;(2) FILE PROTECTION
	PNTR (H.CHAR)		;(3) FILE CHARACTERISTICS
	PNTR (H.UFAT)		;(4) USER'S FILE ATTRIBUTES
	PNTR (I.FNAM)		;(5) FILE NAME
	PNTR (I.FTYP)		;(6) FILE TYPE
	PNTR (I.FVER)		;(7) FILE VERSION NUMBER
	PNTR (I.EDTW)		;(8) EXPIRATION DATE
	POINT 18,STSBLK,17	;(9) STATISTICS BLOCK
	POINT 18,FILHDR,17	;(10) ENTIRE FILE HEADER
ATRMAX==^D10			;MAX
	SUBTTL	APC -- ACP CONTROL FUNCTIONS
;
; FUNCTIONS MOUNT, DISMOUNT: BOTH MERELY CLEAN UP FILE DATA BASE
;
FCPAPC:	MOVEI FID,FIDTAB	;POINT TO FID TABLE
;
FCPAP1:	SKIPN T1,FIDJFN(FID)	;THIS FILE GOT A JFN?
	 JRST FCPAP3		;NO-- JUST CLEAN UP
	HRRZ T1,T1		;JUST THE JFN
IF TOPS-20,<
	CLOSF			;CLOSE ANY OPEN FILE
	 JFCL
>; END IF TOPS-20
IF TOPS-10,<
	CALL RELCHN		;RELEASE CHANNEL
>; END IF TOPS-10
;
FCPAP3:	SETZM FIDUCT(FID)	;CLEAR
	SETZM FIDFLG(FID)	; IMPORTANT
	SETZM FIDJFN(FID)	;  WORDS
	ADDI FID,FIDSIZ		;BUMP TO NEXT FILE-ID
	CAIGE FID,FIDTBE	;BEYOND END?
	 JRST FCPAP1		;NO-- BACK FOR ANOTHER
;
	SETZB T1,USECNT		;RESET GLOBAL USE COUNT
	RETURN			;RETURN FROM APC, NO DATA
	SUBTTL FILE HEADER SUBROUTINES
;
; MAKHDR -- MAKE A FILE HEADER AND STATISTICS BLOCK
;
MAKHDR:	CALL CLRHDR		;START WITH A CLEAR HEAD
IF TOPS-20,<
	CALL GETFDB		;GET THE FDB FOR THIS FILE
>; END IF TOPS-20
	MOVEI T1,27027		;MAGIC
	STOR T1,H.IDOF;		; . .
	HLRZ T1,FIDFID(FID)	;GET FILE NUMBER
	STOR T1,H.FNUM;		; . .
	HRRZ T1,FIDFID(FID)	;AND SEQ #
	STOR T1,H.FSEQ;		; . .
	MOVE T1,FIDUIC(FID)	;ALSO GET UIC
	STOR T1,H.FOWN;		;
;
	SETZ T1,		;START WITH ALL ACCESS
IF TOPS-20,<
	MOVE T3,[POINT 6,FILFDB+.FBPRT,17] ;POINT TO PROTECTION FIELDS
>; END IF TOPS-20
IF TOPS-10,<
	MOVE T3,[POINT 3,FIDLEB+.RBPRV(FID)] ;POINT TO PROTECTION FIELDS
>; END IF TOPS-10
	MOVEI T4,3		;THREE OF THEM
MAKHD1:	ILDB T2,T3		;GET A CODE
IF TOPS-20,<
	LSH T2,-2		;ONLY FOUR HIGH BITS
>; END IF TOPS-20
	MOVE T2,PROTAB(T2)	;CONVERT THE PROTECTION
	ROTC T1,-4		;SHIFT THE BITS INTO HIGH PART OF T1
	SOJG T4,MAKHD1		;LOOP FOR ALL THE BITS
;
	LSH T1,^D<16-36>	;SHIFT DOWN INTO LOW BITS
	STOR T1,H.FPRO;		;STORE THE PROTECTION
;
	MOVE T1,[POINT 18,FIDNAM(FID)] ;POINT TO START OF FILE NAME
	MOVE T2,[PNTR (I.FNM0)]	;AND TO WHERE TO PUT IT
	CALL MOVNAM		;MOVE THE WHOLE FILE-NAME NOW
;
IF TOPS-20,<
	HLRZ T1,FILFDB+.FBCNT	;GET # WRITES
	STOR T1,I.RVNO;		;# REVISIONS
>; END IF TOPS-20
;
	MOVE T2,[PNTR (I.RVDT)]	;POINT TO REVISION DATE,TIME, CREATION DATE,TIME
IF TOPS-20,<
	MOVE T1,FILFDB+.FBWRT	;GET DATE/TIME OF LAST WRITE (REVISION)
>; END IF TOPS-20
IF TOPS-10,<
	LDB T1,[POINT 15,FIDLEB+.RBEXT(FID),35] ;GET LAST ACCESS DATE
>; END IF TOPS-10
	CALL BYTDTM		;STORE THE STRING IN THE HEADER
IF TOPS-20,<
	MOVE T1,FILFDB+.FBCRV	;GET DATE/TIME OF CREATION
>; END IF TOPS-20
IF TOPS-10,<
	LDB T1,[POINT 12,FIDLEB+.RBPRV(FID),35] ;GET LOW ORDER 12 BITS OF CREATION DATE
	LDB T3,[POINT 3,FIDLEB+.RBEXT(FID),20] ;GET HIGH ORDER THREE BITS . . .
	DPB T3,[POINT 3,T1,35-12] ;STORE THEM . . .
	LDB T3,[POINT 11,FIDLEB+.RBPRV(FID),23] ;GET CREATION TIME
	HRL T1,T3		;PUT TIME IN LH, DATE IN RH
>; END IF TOPS-10
	CALL BYTDTM		;CONVERT TO 8-BIT ASCII
;
	MOVE T3,FIDFLG(FID)	;GET THE FILE FLAGS
	MOVE T4,[PNTR (H.UFAT)]	;POINT TO USER ATTRIBUTES
	MOVEI T1,1002		;RECORD TYPE: VARIABLE
	TXNE T3,FI.ASC		;ASCII (IMAGE ASCII) FILE?
	 MOVEI T1,1		;YES-- RECORDS ARE FIXED LENGTH (UNFORMATTED)
	DPB T1,T4		; . .
	MOVEI T1,1000		;RECORD SIZE: 1000
	IDPB T1,T4		; . .
;
IF TOPS-20,<
	HRRZ T1,FILFDB+.FBBYV	;# PAGES
	ASH T1,2		;CONVERT TO BLOCKS
>; END IF TOPS-20
IF TOPS-10,<
	MOVE T1,FIDLEB+.RBALC(FID)
	SUBI T1,2		;MINUS THE PRIME AND SPARE
>; END IF TOPS-10
	MOVEI T2,4		;ASSUME BINARY (4 BYTES/WORD)
	TXNN T3,FI.ASC		;ASCII FILE?
	 JRST MAKHD5		;NO-- OK
	MOVEI T2,5		;YES-- 5 BYTES/WORD
	IMULI T1,5		;COMPUTE
	ASH T1,-2		;  BLOCKS IN ASCII
MAKHD5:	ROT T1,-^D16		;GET THE HIGH PART OF BLOCK SIZE FIRST
	IDPB T1,T4		;SAVE IN USER ATTRIBUTES
	HRLZM T1,STSBLK+1	;ALSO IN STATISTICS BLOCK
	ROT T1,^D16		;RESTORE THE LOW ORDER BITS
	IDPB T1,T4		;SAVE . .
	HRRM T1,STSBLK+1	; BOTH WAYS
;
IF TOPS-20,<
	MOVE T1,FILFDB+.FBSIZ	;GET FILE SIZE IN BYTES TO EOF
	IMUL T1,T2		;*BYTES/WORD = SIZE*(BYTES/WORD)
	LDB T3,[POINT 6,FILFDB+.FBBYV,11] ;BYTE SIZE
	MOVEI T2,^D36		;COMPUTE
	IDIV T2,T3		; BYTES/WORD
	ADDI T1,-1(T2)		;ROUND UP
	IDIV T1,T2		; TO 4/5 BYTES/WORD
>; END IF TOPS-20
IF TOPS-10,<
	MOVE T1,FIDLEB+.RBSIZ(FID) ;GET SIZE IN WORDS
	IMUL T1,T2		;CONVERT TO BYTES
>; END IF TOPS-10
	IDIVI T1,1000		;GET LAST BLOCK NUMBER
	ADDI T1,1		;VBN'S ALWAYS START WITH ONE
	ROT T1,-^D16		;GET HIGH PART FIRST
	IDPB T1,T4		;SAVE IN ATTRIBUTES
	ROT T1,^D16		;BACK TO LOW PART
	IDPB T1,T4		;STORE THAT TOO....
	IDPB T2,T4		;ALSO SAVE WHICH BYTE IN LAST BLOCK IS EOF
	RETURN			;FROM MAKHDR
;
; PROTAB -- PROTECTION CORRESPONDENCE TABLE
;	BITS ARE IN THE ORDER DELETE, EXTEND, WRITE, READ:
;		A "1" MEANS THAT SUCH ACCESS IS DENIED;
;		A "0" MEANS THAT SUCH ACCESS IS ALLOWED.
;	TABLE IS INDEXED BY TOPS-10/TOPS-20 PROTECTION CODE
;
PROTAB:
IF TOPS-20,<
	RADIX 2
	EXP 1111,1011,0111,0011,1101,1001,0101,0001
	EXP 1110,1010,0110,0010,1100,1000,0100,0000
	RADIX 8
>; END IF TOPS-20
IF TOPS-10,<
	RADIX 2
	EXP 0000,0000,1000,1000,1010,1110,1111,1111
	RADIX 8
>; END IF TOPS-10
;
; CLRHDR -- CLEAN THE FILE HEADER FOR NEW DATA
;
CLRHDR:	SETZM FILHDR+0		;CLEAR FIRST WORD
	MOVE T1,[XWD FILHDR+0,FILHDR+1] ;BLT POINTER TO CLEAR
	BLT T1,FILHDE-1		;DOWN TO THE END
	RETURN			;WASHED UP FROM CLRHDR
	SUBTTL FILE-ID SUBROUTINES
;
; ALCFID -- ALLOCATE A FILE-ID BLOCK
;	T1 -- JFN WORD OF FILE NEEDING AN ID
;
ALCFID:	MOVEI T3,FIDTAB		;POINT TO TABLE OF FILE-ID'S
	SETZ FID,		;FLAG NO FREE ONE FOUND
	HRLOI T4,377777		;START WITH USE COUNT OF INFINITY
;
ALCFI1:	SKIPE FIDJFN(T3)	;THIS FILE-ID IN USE?
	 JRST ALCFI2		;YES-- SEE IF ACCESSED
	MOVE FID,T3		;NO-- THIS IS THE ONE
	JRST ALCFI4		;SO USE IT
;
ALCFI2:	MOVE T2,FIDFLG(T3)	;GET FLAGS WORD
	TXNN T2,FI.ACC		;ACCESSED?
	CAMG T4,FIDUCT(T3)	; OR NOT LOWEST USE COUNT?
	 JRST ALCFI3		;YES-- SKIP IT
	MOVE T4,FIDUCT(T3)	;LOWEST USE COUNT SO FAR-- GET IT
	MOVE FID,T3		;SAVE THIS FILE-ID
;
ALCFI3:	ADDI T3,FIDSIZ		;BUMP TO NEXT FILE-ID
	CAIGE T3,FIDTBE		;PAST END YET?
	 JRST ALCFI1		;NO-- LOOK AT ANOTHER
;
	JUMPN FID,ALCFI4	;GOT FID-- GO ON
	RETERR IE.NOD,X
;
ALCFI4:	MOVX T1,0		;RESET JFN
	EXCH T1,FIDJFN(FID)	;STORE THE JFN, GET OLD ONE
	JUMPE T1,ALCFI5		;NO PREVIOUS JFN-- GO ON
	HRRZ T1,T1		;GET JUST THE JFN
IF TOPS-20,<
	RLJFN			;RELEASE IT
	 JFCL			;SO SORRY
>; END IF TOPS-20
IF TOPS-10,<
	CALL RELCHN		;RELEASE CHANNEL
>; END IF TOPS-10
;
ALCFI5:	MOVE T1,FID		;COPY FID BLOCK ADDR
	SUBI T1,FIDTAB-FIDSIZ	;MAKE IT
	IDIVI T1,FIDSIZ		; A NUMBER OF A FILE-ID
	AOS FIDFID(FID)		;BUMP THE SEQUENCE #
	HRLM T1,FIDFID(FID)	;STORE THE FILE-ID
	SETZM FIDFLG(FID)	;RESET THE FLAG WORD
	CALLR SETUCT		;SET USE COUNT AND RETURN FROM ALCFID
;
; GETFID -- GET AN EXISTING FILE-ID AND VERIFY IT
;
GETFID:	LOAD T1,FILID;		;GET THE USER-SPECIFIED FILE-ID
	HLRZ FID,T1		;GET THE FILE-ID NUMBER
	IMULI FID,FIDSIZ	;MAKE IT AN OFFSET
	ADDI FID,FIDTAB-FIDSIZ	; INTO FILE-ID TABLE
	CAIGE FID,FIDTBE	;BEYOND END?
	CAME T1,FIDFID(FID)	;NO-- NO MATCH?
	 RETERR IE.SQC		;THAT'S-A-NO-GOOD
	SKIPN FIDJFN(FID)	;GET THE JFN IF ANY
	 RETERR IE.RER		;BROKEN
	CALLRX SETUCT		;SET USE COUNT AND RETURN FROM GETFID
;
; SETUCT -- UPDATE USE COUNT FOR CURRENT FILE-ID
;
SETUCT:	AOS T1,USECNT		;UPDATE GLOBAL USE COUNT
	MOVEM T1,FIDUCT(FID)	;SET IT
	RETURN			;FROM SETUCT
	SUBTTL FILE-NAME SUBROUTINES
;
; GETNAM -- GET ASCIZ FILENAME IN FNMBLK FROM RAD50 FILENAME IN FNB
;
GETNAM:
IF TOPS-10,<
	CALL CLRFNM		;RESET FILE-NAME BLOCK
>; END IF TOPS-10
	MOVX P3,0		;START WITH NO WILDS
	LOAD T2,N.DID;		;GET THE DIRECTORY ID
	TLZN T2,BIT15		;IS THIS REALLY A DIRECTORY?
	 RETERR IE.SNC		;SORRY-- YOU CAN'T REMEMBER WHAT I TOLD YOU
	MOVEI P4,UICTAB		;POINT TO TABLE OF DIRECTORIES
IF TOPS-20,<
	MOVE T1,[POINT 7,FNMBLK] ;POINT TO FILE-NAME BLOCK
	MOVEI C,74		;START DIRECTORY OFF RIGHT
	IDPB C,T1		; . .
	CAIGE T2,340B<35-8>	;THIS UIC GREATER THAN [340,0]?
	 JRST GETNM2		;NO-- SCAN THE TABLE
	SUBI T2,340B<35-8>	;YES-- CONVERT IT TO A DIRECTORY NUMBER
	DIRST			;GET THE STRING
	 RETERR IE.RER		;ALREADY CHECKED OUT-- OOPS
	JRST GETN35		;OK-- STORE THE WIDGET
>; END IF TOPS-20
;
GETNM2:	SKIPN T3,UICSIZ(P4)	;GET A DIRECTORY TABLE ENTRY
	 RETERR IE.SQC		;SORRY NO SUCH DIRECTORY
	CAMN T2,UICUIC(P4)	;MATCH?
	 JRST GETNM3		;YES-- GOT IT
	ADD P4,T3		;BUMP TO NEXT ENTRY
	JRST GETNM2		;BACK FOR ANOTHER
;
GETNM3:
IF TOPS-20,<
	HRROI T2,UICNAM(P4)	;GET ADDRESS OF STRING
	SETZ T3,		;STRING IS ASCIZ
	SOUT			;PUT THE STRING AWAY
;
GETN35:	MOVEI C,76		;GET THE CLOSING WIDGET
	IDPB C,T1		;STORE IN FILE-NAME
>; END IF TOPS-20
IF TOPS-10,<
	MOVE T1,UICSTR(P4)	;GET STR NAME FOR THIS UIC
	CAIN T1,0		;ALL: ?
	 TXO P3,FJ.ALL		;YES-- NOTE THAT
	CAIN T1,1		;DSK: ?
	 TXO P3,FJ.DSK		;YES-- NOTE THAT
	MOVEM T1,FIDSTR(FID)	;SET STR NAME
	MOVE T1,UICPPN(P4)	;GET P,PN OF DIRECTORY
IFN FTPATH,<
	SKIPE UICSFD(P4)	;IS THERE ANY PATHS SPEC?
	 MOVEI T1,UICPTH(P4)	;YES-- GET PATH BLOCK ADDRESS INSTEAD
>; END IFN FTPATH
	MOVEM T1,FIDLEB+.RBPPN(FID) ;STORE DIRECTORY POINTER
	MOVE T1,[POINT 6,FIDLEB+.RBNAM(FID)] ;POINT TO FILE NAME IN SIXBIT
>; END IF TOPS-10
;
	MOVE P2,[PNTR (N.FNM0)]	;GET POINTER TO START OF RAD50 FILE-NAME
	MOVEI P1,3		;THREE WORDS
	LOAD P4,N.STAT;		;GET FILE FLAGS
	TXNE P4,NB.SNM		;WILD NAME?
	 JRST GETNM5		;YES-- GET IT
;
GETNM4:	ILDB T2,P2		;NO-- GET A RAD50 WORD
IF TOPS-10,<
	CAIE P1,1		;IGNORE LAST THREE CHARS
>; END IF TOPS-10
	CALL R50ASC		;CONVERT IT TO ASCII
	SOJG P1,GETNM4		;DO THREE WORDS
	JRST GETNM6		;ON TO FILE TYPE
;
GETNM5:
IF TOPS-20,<
	MOVEI C,"*"		;GET A STAR
	IDPB C,T1		;STORE IT
>; END IF TOPS-20
	TXO P3,FJ.WLN		;NOTE WILD NAME
GETN51:	IBP P2			;SKIP OVER
	SOJG P1,GETN51		; FILE-NAME
;
GETNM6:
IF TOPS-20,<
	MOVEI C,"."		;DO A
	IDPB C,T1		; . BETWEEN FILE AND TYPE
>; END IF TOPS-20
IF TOPS-10,<
	MOVE T1,[POINT 6,FIDLEB+.RBEXT(FID)]
>; END IF TOPS-10
	ILDB T2,P2		;GET THE TYPE
	TXNE P4,NB.STP		;WILD TYPE?
	 JRST GETNM7		;YES-- DO IT
	CALL R50ASC		; INTO ASCII
	JRST GETNM8		;ON TO VERSION
;
GETNM7:
IF TOPS-20,<
	MOVEI C,"*"		;GET A STAR
	IDPB C,T1		;STORE IT
>; END IF TOPS-20
	TXO P3,FJ.WLT		;NOTE WILD TYPE
;
GETNM8:
IF TOPS-20,<
	ILDB T2,P2		;GET THE VERSION
	TXNN P4,NB.SVR		;WILD VERSION?
	 JUMPE T2,GETNMX	;VERSION ZERO-- DON'T PUT ANYTHING IN STRING
	MOVEI C,"."		;PUNTUATE
	IDPB C,T1		; THE VERSION
	TXNE P4,NB.SVR		;WILD VERSION?
	 JRST GETNM9		;YES-- DO IT
	TXNN T2,BIT15!BIT14	;THIS A FUNNY (-VE) VERSION?
	TXZN T2,BIT13		;NO-- IS IT A TEMP VERSION (20000+N)?
	 JRST GETN82		;NO-- GO ON
	ADDI T2,^D100000	;YES-- MAKE IT A TEMP VERSION
	JRST GETN83		;AND DON'T SIGN-EXTEND IT
;
GETN82:	LSH T2,^D<36-16>	;SIGN
	ASH T2,^D<16-36>	; EXTEND THE NUMBER
;
GETN83:	MOVX T3,^D10		;VERSION IS IN DECIMAL
	NOUT			;MAKE A NUMBER
	 RETERR IE.BVR
	JRST GETNMX		;JUST ABOUT DONE
;
GETNM9:	MOVEI C,"*"		;GET A STAR
	IDPB C,T1		;STORE IT
	TXO P3,FJ.WLG		;NOTE  WILD GENERATION
;
GETNMX:	MOVEI C,0		;MAKE THE STRING
	IDPB C,T1		; ASCIZ
	HRROI T2,FNMBLK		;POINT TO THE NAME STRING
>; END IF TOPS-20
	MOVE T1,P3		;GET THE WILD FLAGS BACK
	RETURN			;FROM GETNAM
;
; PUTNAM -- PUT FILENAME FROM FNMBLK (IN ASCIZ) INTO FNB FOR RETURN
;	RETURNS +1 IF BAD (TOO LONG) NAME,
;		+2 IF OK
;
PUTNAM:	MOVE P2,[PNTR (N.FNM0)]	;POINT TO FILE-NAME
IF TOPS-20,<
	MOVE T1,[POINT 7,FNMBLK] ;ALSO TO WHERE TO GET IT FROM
>; END IF TOPS-20
IF TOPS-10,<
	MOVE T1,[POINT 6,FIDLEB+.RBNAM(FID)]
>; END IF TOPS-10
	MOVEI P1,3		;DO THREE WORDS OF FILE-NAME
;
PUTNM2:	CALL ASCR50		;CONVERT THREE CHARS TO RAD50
IF TOPS-10,<
	 RETURN			;BAD CHAR IN NAME
	CAIG P1,2		;END OF NAME?
>; END IF TOPS-10
	 JRST PUTNM3		;END OF NAME-- ON TO EXTENSION
	IDPB T2,P2		;STORE THE NAME WORD
	SOJG P1,PUTNM2		;LOOP FOR THREE CHARS
IF TOPS-20,<
	ILDB C,T1		;GET THE TERMINATING CHARACTER
>; END IF TOPS-20
	JRST PUTNM4		;ON TO GET EXT
;
PUTNM3:	IDPB T2,P2		;STORE LAST PARTIAL WORD
	SETZ T2,		;NOW CLEAR REMAINING WORDS
	SOJG P1,PUTNM3		;LOOP FOR ALL THEM EXTRA WORDS
;
PUTNM4:
IF TOPS-20,<
	CAIE C,"."		;IS THIS END OF FILE-NAME?
	 RETURN			;NO-- SORRY, IT SHOULD BE
>; END IF TOPS-20
	CALL ASCR50		;YES-- CONVERT THE FILE TYPE
	 SKIPA			;SHORT-- GOT TERMINATOR
IF TOPS-20,<
	ILDB C,T1		;GET TERMINATOR
	CAIE C,"."		;START OF VERSION?
	 RETURN			;NO-- ERROR
>; END IF TOPS-20
	IDPB T2,P2		;STORE THE FILE TYPE
IF TOPS-20,<
	MOVEI T3,^D10		;VERSION IS IN DECIMAL
	NIN			;GET THE VERSION #
	 RETURN			;BAD VERSION #
	CAIGE T2,BIT13		;TOO BIG FOR -11 TO HANDLE?
	 JRST PUTNM5		;NO-- STORE IT
	CAIGE T2,^D100000	;TEMP VERSION #?
	 RETURN			;NO-- VERSION TOO BIG
	SUBI T2,^D100000	;YES-- GET THE JOB #
	TXO T2,BIT13		;MARK AS A TEMP VERSION #
>; END IF TOPS-20
IF TOPS-10,<
	SETZ T2,		;ALWAYS ZERO
>; END IF TOPS-10
;
PUTNM5:	IDPB T2,P2		;STORE THE VERSION #
	RETSKP			;YES-- ALL OK
;
; GETTMP -- GET A TEMP FILE JFN
;	RETURNS JFN IN T1
;
GETTMP:
IF TOPS-20,<
	MOVX T1,GJ%SHT!GJ%NEW!GJ%FOU!GJ%TMP+.GJNHG
	HRROI T2,[ASCIZ/FRONT-END-TEMP-FILE.TMP/]
	GTJFN			;GET THE JFN OF THE TEMP FILE
	 RETERR IE.IFU
>; END IF TOPS-20
IF TOPS-10,<
	CALL CLRFNM		;CLEAR FILENAME BLOCK
	AOS T2,TMPFIL		;GET CURRENT TEMP FILE NUMBER
	CALL OCTSIX		;CONVERT TO SIXBIT
	HRRI T3,'FE '		;MAKE 000FE.TMP NAME
	MOVEM T3,FIDLEB+.RBNAM(FID) ;STORE NAME
	MOVSI T1,'TMP'		;MAKE TEMP FILE
	MOVEM T1,FIDLEB+.RBEXT(FID) ;AND TYPE
>; END IF TOPS-10
	RETURN			;FROM GETTMP
;
IF TOPS-10,<
;
; CLRFNM -- CLEAR LOOKUP/ENTER BLOCK AREA OF FID BLOCK
;
CLRFNM:
	MOVSI T1,FIDLEB(FID)	;GET START OF BLOCK
	HRRI T1,FIDLEB+1(FID)	; AND NEXT WORD . . .
	SETZM FIDLEB(FID)
	BLT T1,FIDLEB+.RBALC(FID)
	MOVEI T1,.RBALC		;ALL PARAMETERS UP TO .RBALC
	MOVEM T1,FIDLEB+.RBCNT(FID) ;SAVE THAT
	RETURN			;FROM CLRFNM
;
>; END IF TOPS-10
;
; CHKTYP -- SEE IF FILE TYPE (FROM FILE-ID BLOCK) IS BINARY FILE
;	RETURNS +1 IF NOT BINARY FILE TYPE
;		+2 IF BINARY FILE TYPE, I.E. ONE OF:
;			ABS, BIN, LDA, OBJ, OLB, SML, STB, SYS, TSK
;
CHKTYP:	HRRZ T1,FIDTYP(FID)	;GET FILE TYPE, IN RAD50
	MOVSI T2,-BINLEN	;AOBJN POINTER TO BINTAB
CHKTY1:
	CAMN T1,BINTAB(T2)	;THIS MATCH BINARY FILE TYPE?
	 RETSKP			;YES-- RETURN +2
	AOBJN T2,CHKTY1		;NO-- LOOK FOR ALL BINARY FILE TYPES
	RETURN			;NOT BINARY-- RETURN +1
;
; TABLE OF RAD50 BINARY FILE TYPES
;
BINTAB:
	.RAD50 <ABS,BIN,LDA,OBJ,OLB,SML,STB,SYS,TSK,EXB>
BINLEN==.-BINTAB
;
; MOVNAM -- MOVE FILENAME, TYPE AND VERSION
;	T1 -- SOURCE POINTER
;	T2 -- DESTINATION POIINTER
;
MOVNAM:	MOVEI T3,5		;FILENAME (3) TYPE (1) VER (1)
	CALLRX MOVSTR		;MOVE THE STRING
;
; MOVSTR -- MOVE A STRING
;	T1 -- SOURCE POINTER
;	T2 -- DESTINATION POINTER
;	T3 -- BYTE COUNT
;
MOVSTR:	ILDB C,T1		;GET A CHARACTER
	IDPB C,T2		;STORE IT
	SOJG T3,MOVSTR		;LOOP FOR ALL OF THEM
	RETURN			;FROM MOVSTR
	SUBTTL CONVERSION SUBROUTINES
;
; BYTDTM -- CONVERT A DATE/TIME WORD TO 8-BIT ASCII BYTE STRING (13 BYTES)
;	T1 -- DATE/TIME TO BE CONVERTED
;	T2 -- 8-BIT BYTE POINTER TO WHERE TO STORE THE DATA
; RETURNS T2 UPDATED
;
BYTDTM:	PUSH P,T2		;SAVE THE POINTER TO STORE
	MOVE T2,T1		;COPY THE DATE/TIME
	MOVE T1,[POINT 7,DATBUF] ;POINT TO SCRATCH AREA
IF TOPS-20,<
	MOVX T3,0		;COLUMNATTED FLAVOR
	ODTIM			;CONVERT TO STRING
	MOVE T1,[POINT 7,DATBUF] ;BACK TO BEGINNING
	MOVE T2,T1		;ALSO FOR OUTPUT, REMOVING THE TRASH
	MOVE T3,[POINT 3,[BYTE (3) 2,3,2,2,2,2,0]] ;POINTER TO FIELD SIZES
;
BYTDT1:	ILDB T4,T3		;GET SIZE OF NEXT FIELD
	JUMPE T4,BYTDT3		;DONE-- CONVERT TO 8-BIT
BYTDT2:	ILDB C,T1		;GET A CHARACTER FROM ORIGINAL STRING
	IDPB C,T2		;STORE IN OUTPUT STRING
	SOJG T4,BYTDT2		;LOOP FOR ENTIRE FIELD SIZE
	IBP T1			;END OF FIELD-- SKIP SEPERATOR
	JRST BYTDT1		;GET NEXT FIELD, IF ANY
>; END IF TOPS-20
IF TOPS-10,<
	CALL ASCDAT		;CONVERT DAT TO ASCII
>; END IF TOPS-10
;
BYTDT3:	MOVE T1,[POINT 7,DATBUF] ;BACK TO THE START OF THE STRING
	POP P,T2		;RESTORE THE POINTER TO THE 8-BIT STRING
	MOVEI T3,^D13		;13 BYTES OF DATE/TIME
	CALLRX ASCBYT		;CONVERT THE 7-BIT STRING TO 8-BIT
;
; ASCBYT -- CONVERT 7-BIT ASCII STRING TO 8-BIT BYTE -11 STYLE STRING
; BYTASC -- CONVERT STRING FROM -11 STYLE 8-BIT BYTES TO 7-BIT ASCII
;	T1 -- BYTE POINTER TO 7-BIT ASCII STRING
;	T2 -- BYTE POINTER TO 8-BIT DATA (POINTS TO FIRST DATA BYTE)
;	T3 -- BYTE COUNT
; UPDATES EVERYTHING, USES T1-T4, P1, C
;
ASCBYT:	TDZA P1,P1		;POINT TO ASCII-BYTE CONVERSIONS
BYTASC:	 MOVEI P1,2		;POINT TO BYTE-ASCII CONVERSIONS
	MOVE T4,T2		;COPY 8-BIT POINTER
	LSH T4,^D<3-36>		;DOWN TO HIGH THREE BITS
	TXC T4,1		;MAKE BYTES 3,2,1,0 IN WORD
;
ASCBY1:	SOJL T3,ASCBYX		;DONE IF BYTE COUNT DOWN
	XCT BYTINS+0(P1)	;EXECUTE THE LDB/ILDB
	XCT BYTINS+1(P1)	;EXECUTE THE IDPB/DPB
	SOJGE T4,ASCBY1		;BUMP POINTER INTO POINTERS
	MOVEI T4,3		;DOWN TO NEXT WORD-- RESET THE COUNT
	AOJA T2,ASCBY1		; AND INCREMENT THE ADDRESS
;
ASCBYX:	HLL T2,BYTPTR(T4)	;SET NEW BYTE POINTER BITS IN UPDATED POINTER
	TXZ T2,17B17		;ZERO THE INDEX FIELD
	RETURN			;THAT'S IT FOR BYTASC/ASCBYT
;
BYTINS:	ILDB C,T1		;(ASCBYT) GET 7-BIT BYTE
	DPB C,BYTPTR(T4)	;(ASCBYT) STORE 8-BIT BYTE
	LDB C,BYTPTR(T4)	;(BYTASC) GET 8-BIT BYTE
	IDPB C,T1		;(BYTASC) STORE 7-BIT BYTE
;
BYTPTR:	PNTR BYTE3,0(T2)
	PNTR BYTE2,0(T2)
	PNTR BYTE1,0(T2)
	PNTR BYTE0,0(T2)
;
; R50ASC -- CONVERT THREE CHARACTERS FROM RAD50 TO ASCII
;	T1 -- POINTER TO ASCIZ OUTPUT STRING
;	T2 -- RAD50 WORD (16 BITS) TO CONVERT
;	RETURNS +1, T1 UPDATED
;
R50ASC:	JUMPE T2,CRET		;IF NULL-- GIVE UP NOW!
	IDIVI T2,50		;TRIM OFF LOW CHARACTER
	HRLM T3,(P)		;SAVE IT ON STACK
	SKIPE T2		;END OF TEXT?
	 CALL R50ASC		;NO-- TRY AGAIN FOR ANOTHER CHAR
;
	HLRZ T2,(P)		;GET A CHARACTER BACK
	SETZ T3,		;START OUT TABLE PONTER
;
R50AS2:	CAMGE T2,R50TB1(T3)	;DOWN TO MATCH YET?
	 AOJA T3,R50AS2		;NO-- LOOK SOME MORE
	ADD T2,R50TB2(T3)	;YES-- CONVERT
IF TOPS-10,<
	SUBI T2," "-' '		;CONVERT TO SIXBIT
>; END IF TOPS-10
	 IDPB T2,T1		;NO-- STORE THE CHARACTER
	RETURN			;FROM R50ASC
;
R50TB1:	EXP 36,35,34,33,1,0
R50TB2:	EXP "0"-36,"%"-35,0-34,"-"-33,"A"-1," "-0
;
; ASCR50 -- CONVERT THREE CHARACTERS FROM ASCII TO RAD50
;	T1 -- POINTER TO ASCIZ STRING
;	RETURNS +1 IF UNRECOGNIZED CHARACTER (IN C) PARTIAL RESULT IN T2
;		+2 SUCCESS
;	T1 -- UPDATED POINTER TO NEXT CHARACTER
;	T2 -- RAD50 TEXT
;
ASCR50:	SETZ T2,		;CLEAR ANSWER
	MOVEI T3,3		;SET THE COUNT TO THREE AT MOST
;
ASCR51:	ILDB C,T1		;GET A CHARACTER FROM THE STRING
IF TOPS-10,<
	JUMPE C,ASCR56		;SPACES ARE SPACES . . .
	ADDI C," "-' '		;CONVERT SIXBIT TO ASCII
>; END IF TOPS-10
	CAIL C,"A"		;ALPHA
	CAILE C,"Z"		; BETIC?
	 JRST ASCR52		;NO-- TRY SOMETHING ELSE
	SUBI C,"A"-1		;YES-- CONVERT THE CHARACTER
	JRST ASCR56		;PUT IT AWAY
;
ASCR52:	CAIL C,"0"		;NUM
	CAILE C,"9"		; ERIC?
	 JRST ASCR53		;NO-- TRY HARDER
	SUBI C,"0"-36		;YES-- CONVERT IT
	JRST ASCR56		;PUT IT AWAY
;
ASCR53:	CAIE C,"-"		;HOW 'BOUT - (WILL BE A $)?
	 JRST ASCR54		;NO-- LOOK AGAIN
	MOVEI C,33		;YES-- MAKE IT A $
	JRST ASCR56		;GOT IT
;
ASCR54:	IMULI T2,50		;NO LUCK-- JUST FIX UP RESULT
	SOJG T3,ASCR54		;TILL 3 CHARS
	RETURN			;FAILURE TO PICK THREE CHARACTERS
;
ASCR56:	IMULI T2,50		;SHIFT THE RESULT A CHARACTER
	ADDI T2,(C)		;ADD IN CURRENT CHARATCER
	SOJG T3,ASCR51		;PUT AWAY NEXT CHARACTER
	RETSKP			;SUCCESS-- THREE CHARS FOR ASCR50
;
IF TOPS-10,<
;
; OCTSIX -- CONVERT BINARY TO OCTAL SIXBIT
;	T2 -- BINARY NUMBER 0-777
;	RETURNS +1:
;	T1 -- SIXBIT VALUE BITS 0-17
;
OCTSIX:
	MOVX T3,0		;START OUT EMPTY
OCTSX1:
	LSHC T2,-3		;SHIFT A DIGIT INTO T3
	LSH T3,-3		;ALLOCATE SIX BITS
	TXO T3,'0'B5		;MAKE SIXBIT
	TLNN T3,77		;A FULL 3 CHARS YET?
	 JRST OCTSX1		;NO-- WORK HARDER
	RETURN			;YES-- RETURN NOW
;
; ASCDAT -- CONVERT DATE TO ASCII
;	T1 -- POINTER TO 7-BIT OUTPUT STRING
;	T2 -- DATE/TIME TO BE CONVERTED (LH= MINUTES SINCE MIDNIGHT, RH= 15-BIT DATE)
;
ASCDAT:
	PUSH P,T2		;SAVE THE TIME
	HRRZ T2,T2		;GET JUST THE DATE
	IDIVI T2,^D31		;GET DAY OF MONTH TO T3
	ADDI T3,1		;START DAYS AT ONE
	CALL ASC2DC		;PUT IT
	IDIVI T2,^D12		;MONTH TO T3, YEAR TO T2
	ADD T3,[POINT 7,MONTAB] ;MAKE IT A POINTER TO MONTH TEXT
ASCDT2:
	ILDB C,T3		;GET A DATE CHARACTER
	JUMPE C,ASCDT3		;ASCIZ...
	IDPB C,T1		;STORE CHARACTER
	JRST ASCDT2		;BACK FOR MORE
;
ASCDT3:
	MOVEI T3,^D64(T2)	;GET YEAR
	CALL ASC2DC		;PUT IT AWAY
;
	POP P,T2		;RESTORE TIME
	HLRZ T2,T2		; TO RH
	IDIVI T2,^D60		;HOURS TO T2, MINS TO T3
	EXCH T3,T2		;COPY HRS
	CALL ASC2DC		;PUT OUT HRS
	MOVE T3,T2		;GET MINS
	CALL ASC2DC		;PUT THEM TOO
	MOVX T3,0		;SEC= 0 ALWAYS
	CALLRX ASC2DC		;PUT THEM IN AND RETURN FROM ASCDAT
;
; ASC2DC -- PUT TWO DECIMAL DIGITS FROM T3 IN ASCII IN STRING (T1)
;
ASC2DC:
	IDIVI T3,^D10		;HIGH DIGIT TO T3, LOW TO T4
	MOVEI C,"0"(T3)		;GET HIGH DIGIT IN ASCII
	IDPB C,T1		;STORE . . .
	MOVEI C,"0"(T4)		;ALSO LOW DIGIT
	IDPB C,T1		; . . .
	RETURN			;FROM ASC2DC
;
; MONTAB -- TABLE OF MONTHS
;
DEFINE MONTH(X),<IRP X,<ASCIZ\X\>>
MONTAB:
	MONTH <JAN,FEB,MAR,APR,MAY,JUN,JUL,AUG,SEP,OCT,NOV,DEC>
;
; TYPOCT -- TYPE OCTAL # FROM T1 ON TTY
;
TYPOCT:
	IDIVI T1,^D8		;GET A LOW DIGIT
	HRLM T2,(P)		;SAVE ON STACK
	SKIPE T1		;ALL DONE?
	 CALL TYPOCT		;NO-- FETCH SOME MORE DIGITS
	HLRZ C,(P)		;YES-- GET DIGIT BACK
	ADDI C,"0"		;MAKE IT ASCII
	OUTCHR C		;TYPE THE CHARACTER
	RETURN			;FROM TYPOCT
;
>; END IF TOPS-10
	SUBTTL FILE I/O SUBROUTINES
;
IF TOPS-20,<
;
; GETFDB -- GET THE FDB FOR THE FILE (FID) INTO FILFDB
;
GETFDB:
	HRRZ T1,FIDJFN(FID)	;GET THE JFN
	MOVSI T2,.FBLEN		;READ ENTIRE FDB
	MOVEI T3,FILFDB		; INTO FILFDB
	GTFDB			;GET IT
	RETURN			;FROM GETFDB
;
; SINCLR -- DO A SIN AND CLEAR REST OF BUFFER IF NOT ALL BYTES TRANSFERED
;
SINCLR:	SIN			;DO THE SIN
	JUMPGE T3,CRET		;OK-- JUST RETURN
	SETZ C,			;NOT FINISHED-- CLEAR A CHARACTER
SINCL1:	IDPB C,T2		;STORE A ZERO BYTE
	AOJL T3,SINCL1		;LOOP FOR ALL MISSING BYTES
	RETURN			;RETURN ALL DONE
;
>; END IF TOPS-20
;
IF TOPS-10,<
;
; LOOK -- DO (POSSIBLY) WILD LOOKUP ON FILE IN FIDLEB FOR FID
;	T1 -- WILD FLAGS (FROM GETNAM)
;	RETURNS +1:	FAILED TO FIND FILE
;		+2:	SUCCESS, T1= CHANNEL #
;
LOOK:
	MOVE P1,T1		;COPY FLAGS
	CALL GETCHN		;GET A FREE CHANNEL
	 RETERR IE.NOD
	HLL T1,P1		;RESTORE  FLAGS
	TXNN T1,FJ.ALL!FJ.DSK	;IS THIS A SEARCH-TYPE STRUCTURE?
	 JRST WLOOK1		;NO-- USE THE SUPPLIED NAME
	SETZM FIDSTR(FID)	;YES-- RESET TO START OF SEARCH LIST
	TXNN T1,FJ.ALL		;WAS THIS ALL?
	 SETOM FIDSTR(FID)	;NO-- DSK-- SET START TO -1
;
; WLOOK -- DO WILD CARD LOOKUP
; WLOOKN -- CONTINUE PREVIOUS WILD CARD LOOKUP
;
WLOOK:
	MOVX T3,0		;ASSUME RESET NON-SEARCH STR
	TXNN T1,FJ.ALL!FJ.DSK	;SEARCH LIST?
	 JRST WLOOKA		;NO-- DONE WITH STR-- GIVE UP
	MOVE T3,FIDSTR(FID)	;GET CURRENT STRUCTURE NAME
	TXNN T1,FJ.ALL		;ALL?
	 JRST WLOOKD		;NO-- USE DSK:
	SYSSTR T3,		;GET NEXT STRUCTURE NAME
	 WARN <SYSSTR UUO FAILURE>,[EXIT]
	JRST WLOOKA		;CONTINUE . . .
;
WLOOKD:
	MOVX T2,<XWD 1,T3>	;POINT TO JOBSTR ARG BLOCK
	JOBSTR T2,		;GET NEXT STR IN JOB SEARCH LIST
	 WARN <JOBSTR UUO FAILURE>,[EXIT]
WLOOKA:
	MOVEM T3,FIDSTR(FID)	;STORE THIS NEW STRUCTURE NAME
WLOOK1:
	SETZM FIDDIX(FID)	;RESET DIRECTORY INDEX
	CALLRX WLOOKN		;NOW DO DIRECTORY SCAN
;
WLOOKN:
	SKIPE T3,FIDSTR(FID)	;GET CURRENT STRUCTURE NAME
	CAMN T3,[EXP -1]	;LAST STR?
	 CALLR RELCHN		;NO MORE STRS-- GIVE UP
	MOVX T2,.IODMP		;DUMP MODE
	MOVX T4,0		;NO BUFFERS
	CALL XCTUUO
	OPEN T2
	 JRST WLOOK		;OOPS-- TRY NEXT STR
	MOVE T2,FIDLEB+.RBPPN(FID) ;GET PATH BLOCK POINTER
	MOVX T3,<SIXBIT/UFD/>	;ASSUME A UFD
IFN <P1-<T4+1>>,<PRINTX P1 MUST BE T4+1>
	MOVX P1,<XWD 1,1>	; IN THE MFD
IFN FTPATH,<
	TLNE T2,-1		;THIS A PATH BLOCK SPEC?
	 JRST WLOOK2		;NO-- JUST GO ON WITH UFD
	SKIPN 3(T2)		;JUST A P,PN?
	 JRST WLKPT2		;YES-- USE [1,1]P,PN.UFD
	MOVE T4,DMPLST		;POINT TO SCRATCH AREA
	PUSH T4,[EXP 0]		;SET JUNK WORD= 0
WLKPT1:
	PUSH T4,1(T2)		;SAVE LAST ENTRY IN PATH BLOCK TO SCRATCH AREA
	SKIPE 3(T2)		;END OF LIST COMING UP AFTER THIS ENTRY?
	 AOJA T2,WLKPT1		;NO-- LOOP FOR ALL BUT LAST ENTRY IN PATH BLOCK
	PUSH T4,[EXP 0]		;MARK END OF LIST
	MOVX T3,<SIXBIT/SFD/>	;SET TYPE= SUB-FILE-DIRECTORY
	MOVEI P1,DMPBUF		;POINT PATH BLOCK ADDRESS TO SCRATCH AREA
WLKPT2:
	MOVE T2,2(T2)		;GET LAST NAME FOUND IN LIST AS FILENAME OF DIRECTORY
WLOOK2:
>; END IFN FTPATH
	CALL XCTUUO
	LOOKUP T2		;FIND THE DIRECTORY
	 JRST WLOOK		;NO SUCH LUCK-- TRY FOR ANOTHER STR
	HLLZS FIDLEB+.RBEXT(FID) ;MAKE SURE EXT IS 3 CHARS
	MOVE T3,FIDDIX(FID)	;GET CURRENT DIRECTORY INDEX
	IDIVI T3,200		;FIND CURRENT BLOCK # IN DIRECTORY FILE
	CALL XCTUUO
	USETI 1(T3)		;SET TO CURRENT BLOCK #
WLOOK3:
	CALL XCTUUO
	IN DMPLST		;INPUT NEXT 200 WORDS
	 JRST WLOOK4		;OK-- LOOK AT THE BLOCK
	JRST WLOOK		;ERROR OR EOF-- TRY NEXT STRUCTURE NOW
;
WLOOK4:
	TRZE T4,200		;WHOLE BLOCK YET?
	 JRST WLOOK3		;YES-- READ NEXT ONE
	ADDI T4,2		;BUMP DIRECTORY INDEX
	MOVEI T2,2		;ALSO
	ADDM T2,FIDDIX(FID)	; DIRECTORY INDEX IN FILE-ID BLOCK
	MOVE T2,DMPBUF-2(T4)	;GET FILE-NAME FROM DIRECTORY BLOCK
	TXNN T1,FJ.WLN		;WILD NAME?
	CAMN T2,FIDLEB+.RBNAM(FID) ;NO-- NAME MATCH?
	 JRST WLOOK5		;YES-- TRY FILE TYPE
	JRST WLOOK4		;NO-- TRY NEXT ENTRY
;
WLOOK5:
	HLLZ T3,DMPBUF-1(T4)	;GET FILE TYPE
	TXNN T1,FJ.WLT		;WILD TYPE?
	CAMN T3,FIDLEB+.RBEXT(FID) ;NO-- TYPE MATCH?
	 JRST WLOOK7		;YES-- WE HAVE A MATCH
	JRST WLOOK4		;NO-- TRY NEXT ENTRY
;
WLOOK7:
	MOVEM T2,FIDLEB+.RBNAM(FID) ;STORE WILD NAME FOUND
	MOVEM T3,FIDLEB+.RBEXT(FID) ; ALSO WILD TYPE
	CALL XCTUUP
	LOOKUP FIDLEB(FID)	;LOOKUP SPECIFIED FILE
	 JRST WLOOKN		;FAILED-- TRY ALL OVER AGAIN
	CALL XCTUUO
	IN DMPLST		;READ FIRST BLOCK
	 SKIPA			;OK-- GO ON
	JRST WLOOK8		;OOPS-- GIVE UP
	MOVEI T2,.IODMP		;ASSUME UNKOWN MODE
	MOVE T3,DMPBUF+0	;GET FIRST WORD
	TXNN T3,-1B6		;BINARY FILE?
	 MOVEI T2,.IOIMG	;YES-- MAKE SURE OF IT
	DPB T2,[POINT 4,FIDLEB+.RBPRV(FID),12] ;SET FILE MODE
WLOOK8:
	CALLRX CLOSEF		;CLOSE FILE AND RETURN +2 FROM WLOOK
;
; CLOSEF -- CLOSE FILE
;	T1 -- CHANNEL #
;	RETURNS +2 ALWAYS
;
CLOSEF:
	CALL XCTUUO
	CLOSE
	RETSKP			;ALWAYS RETURN +2 FROM CLOSEF
;
; INEOF -- INPUT AND IGNORE EOF
;	T1 -- I/O CHANNEL
;	P3, P4 -- I/O LIST
;
INEOF:
	CALL XCTUUO
	IN P3			;ATTEMPT INPUT
	 RETURN			;OK-- RETURN FROM INEOF
	CALL XCTUUO
	STATZ IO.EOF		;END-OF-FILE?
	 RETURN			;YES-- RETURN FROM INEOF
	RETERR IE.RER,X
;
; GETCHN -- GET A FREE CHANNEL
;	RETURNS +1:	NO FREE CHANNELS
;		+2:	SUCCESS, T1= CHANNEL #
;
GETCHN:
	MOVE T1,CHNMSK		;GET FREE CHANNEL MASK
	JFFO T1,GETCH1		;FIND A FREE CHANNEL
	RETURN			;NONE FREE
;
GETCH1:
	MOVE T1,T2		;GET FIRST FREE BIT
	MOVN T2,T2		;GET -VE CHANNEL #
	MOVX T3,1B0		;START WITH BIT 0
	LSH T3,(T2)		;GET BIT FOR CHANNEL
	ANDCAM T3,CHNMSK	;MARK (CLEAR) CHANNEL IN USE
	RETSKP			;ALL DONE, CHANNEL # IN T1
;
; RELCHN -- RELEASE CHANNEL
;	T1 -- CHANNEL #
;
RELCHN:
	CALL XCTUUO		;FOR GOOD LUCK . . .
	RELEASE
	MOVN T2,T1		;GET -VE CHANNEL #
	MOVX T3,1B0		;START WITH CHANNEL 0
	LSH T3,(T2)		;GET BIT FOR CHANNEL
	IORM T3,CHNMSK		;MARK (SET) CHANNEL FREE
	RETURN
;
; XCTUUO -- XCT I/O UUO ON CHANNEL (T1)
;	T1 -- CHANNEL #
;	CALL XCTUUO
;	<UUO>
;	<RETURN +1 FROM UUO>
;	<RETURN +2 FROM UUO>
;
XCTUUO:
	PUSH P,@(P)		;STACK THE UUO
	AOS -1(P)		;SKIP THE UUO
	DPB T1,[POINT 4,(P),12]	;PUT CHANNEL # INTO AC FIELD
	XCT (P)			;EXECUTE THE UUO
	 SKIPA			;RETURN +1 FROM UUO
	AOS -1(P)		;RETURN +2 FROM UUO
	POP P,(P)		;REMOVE UUO FROM STACK
	RETURN			;RETURN AFTER UUO FROM XCTUUO
;
; XCTUUP -- SAME AS XCTUUO, EXCEPT PRESERVE FIDLEB+.RBPPN(FID)
;		THIS WORD IS DESTROYED ON LOOKUP/ENTER/RENAME
;
XCTUUP:
	PUSH P,FIDLEB+.RBPPN(FID) ;SAVE PPN/PATH BLOCK POINTER
	PUSH P,@-1(P)		;STACK THE UUO
	AOS -2(P)		;SKIP THE UUO
	DPB T1,[POINT 4,(P),12]	;PUT CHANNEL # INTO AC FIELD
	XCT (P)			;EXECUTE THE UUO
	 SKIPA			;RETURN +1 FROM UUO
	AOS -2(P)		;RETURN +2 FROM UUO
	POP P,(P)		;REMOVE UUO FROM STACK
	POP P,FIDLEB+.RBPPN(FID) ;RESTORE PPN/PATH BLOCK POINTER
	RETURN			;RETURN AFTER UUO FROM XCTUUP
;
>; END IF TOPS-10
	SUBTTL END STATEMENT
;
;
	END XWD 3,ENTVEC