/	SUBROUTINE USR (UNIT, NAME, FUNCT, ERROR)
/	VERSION 01.18

/	WRITTEN BY:
/	  ROBERT PHELPS
/	  BEHAVIOR LAB
/	  DEPT. RAD. BIOL. & BIOPHYSICS
/	  UNIVERSITY OF ROCHESTER
/	  ROCHESTER, NY  14642
/
/		THIS ROUTINE ALLOWS RUN-TIME DECLARATION OF FILES
/		IN D.E.C. FORTRAN IV FOR THE PDP-8.
/
/	DESCRIPTION OF PARAMETERS:
/
/		UNIT  - LOGICAL UNIT NUMBER
/			ONLY NUMBERS 5 THRU 9 ARE ALLOWED.
/			FEWER LOGICAL UNITS MAY BE ALLOWED DEPENDING
/			ON CORE AVAILABILITY -- SEE PROGRAMMING NOTE
/			BELOW.
/		NAME  - DEV:FILE.EX
/			STORED IN FORMAT 3A6 OR EQUIVALENT.
/			DEVICE ASSUMED TO BE DSK: IF NOT
/			EXPLICITLY STATED.  THIS PARAMETER MAY
/			ALSO BE A HOLLERITH LITERAL.
/			NULL CHARACTERS ('@') AND SPACES
/			ARE IGNORED IN THIS FIELD.
/		FUNCT - FUNCTION: 2 - OPEN FILE FOR INPUT
/				  3 - OPEN FILE FOR OUTPUT
/				  4 - CLOSE OUTPUT FILE
/			THE OUTPUT FILE NAME GIVEN FOR A <CLOSE>
/			MUST AGREE WITH THE CORRESPONDING <OPEN>
/			FILE NAME FOR THAT UNIT.  CLOSING A FILE
/			WITH 0 BLOCKS OR AN INPUT (FUNCT=2) FILE WILL
/			DELETE THAT FILENAME FROM THE DIRECTORY.
/		ERROR - RETURN ERROR CONDITION
/			0 - NO ERRORS.
/			1 - ILLEGAL DEVICE
/			2 - ILLEGAL FILE NAME
/			3 - ILLEGAL UNIT NUMBER (CORE EXCEEDED!?)
/			4 - ILLEGAL FUNCTION CODE
/
/	USER ERRORS MAY TERMINATE EXECUTION UNLESS THE /E
/	OPTION WAS SPECIFIED TO FRTS.  THE FOLLOWING USER
/	ERRORS FROM <USR> ARE DEFINED:
/		0002 - THE USER HAS DEFINED A NON-RESIDENT
/			DEVICE HANDLER EXTERNAL TO <USR>.
/
/	PROGRAMMING NOTE:  EACH UNIT IS ASSIGNED 1000(8) LOCATIONS
/IN THE HIGHEST FIELD FOR BUFFER AND HANDLER (400 FOR ITS BUFFER
/AND 400 FOR ITS HANDLER).  THESE LOCATIONS ARE
/NOT DYNAMICALLY ALLOCATED BUT ARE USED FOR DEVICE BUFFER AND
/HANDLERS ONLY IF THEY ARE NOT USED BY THE
/PROGRAM.  TO USE CORE MOST EFFICIENTLY FOR LARGE
/PROGRAMS, USE THE HIGHEST ORDER UNIT NUMBERS POSSIBLE.  THAT IS,
/USING UNIT 5 ALLOWS 1000(8) FEWER WORDS FOR SOURCE CODE THAN IF
/UNIT 6 WERE THE LOWEST UNIT NUMBER USED.
/
/	RESTRICTIONS:  BECAUSE <FRTS> LOADS NON-RESIDENT HANDLERS FROM
/THE TOP OF CORE DOWN, AND <USR> ALSO USES THAT AREA, THE USER IS NOT
/ALLOWED TO MAKE LOAD TIME
/I/O UNIT DECLARATIONS TO DEVICES WITH NON-RESIDENT
/HANDLERS EXTERNAL TO <USR>.  TO DO SO WLL CAUSE A FATAL
/USER ERROR 2.  IT IS RECOMMENDED, AND GENERALLY
/MORE CONVIENENT TO USE INTERNAL HANDLERS AND
/DECLARE ALL OTHER FILES AT EXECUTION TIME
/WITH CALLS TO THIS SUBROUTINE.
/THE USE OF <FRTS> INTERNAL HANDLERS,
/SYS:, AND DEVICES CO-RESIDENT WITH SYS: ARE LEGAL,
/EVEN IF DEFINED EXTERNAL TO THIS SUBROUTINE.
/
/NOTE:	THIS PROGRAM REQUIRES ONE PATCH BE MADE TO
/	<FRTS> BEFORE IT WILL RUN.  IT IS DESCRIBED
/	BELOW:
/
/MAXCOR=121	/THESE ARE LOCATIONS IN THE RESIDENT PART OF
/HGHLOC=123	/<FRTS> AND REQUIRE THE FOLLOWING PATCH BE PLACED
		/IN FRTS SO THEY WILL BE SET PROPERLY.  THE PATCH
		/DELETES CODE WHICH INITIALIZES SYSTEMS WITH AN
		/ANALEX PRINTER, SO IF YOU HAVE AN ANALEX ... WATCH OUT.

/Note that MAXCOR and HGHLOC are 2 word variables which have been
/created for this routine on page 0 of FRTS. If FRTS
/is changed to use more page 0 locations, the patch
/will have to be changed as well. 

/	FIELD 1; *2475
/12475	7300	CLA CLL			/Note, CDF CIF 0 is pending
/12476	1311	TAD	12511		/Load address of VAR
/12477	3010	DCA	10010		/Store in auto index
/	1023	TAD	10023		/Load value of MAX field
/	3410	DCA I	10010		/As high order part of MAXCOR
/	3410	DCA I	10010		/Zero low order part
/	1025	TAD	10025		/Load highest avail. field
/	3410	DCA I	10010		/Store high order word
/	1026	TAD	10026		/load high address
/	3410	DCA I	10010		/Store low order word of HGHLOC
/	7000	NOP			/?
/	5766	JMP I	12566		/Start up FPP

/12511	 120			/ADDRESS-1 of MAXCOR

	EXTERN	CGET
	EXTERN	CPUT
	DSRN=4244		/Address of DSRN table in FRTS

	SECT	USR
	JA	#ST

/NOTE:  MUCH OF THIS CODE WAS LIFTED FROM A FORTRAN
/	GENERATED ASSEMBLY LISTING.  ACCEPT THIS AS
/	AN APOLOGY FOR THE LACK OF COMMENTS IN SOME SECTIONS.
/
#XR,	ORG	.+10
	TEXT	+USR  +

#RET,	SETX #XR
	SETB #BASE
	JA .+3
#BASE,	ORG	.+6	/BASE 0 AND 1
UNIT,	ORG	.+3	/BASE 2
FUNCT,	ORG	.+3	/BASE 3
ERROR,	ORG	.+3	/BASE 4
#DSK,	TEXT +DSK@@@+	/DEFAULT DEVICE NAME
I,	F 0.0		/BASE 6
N,	F 0.0		/BASE 7
	ORG	#BASE+30
	FNOP
	JA #RET
	FNOP
#GOBAK,	0;0

PERFLG,	F 0.0		/PERIOD FLAG
X,
#TMP,	ORG	.+3
ONE,	F 1.0
TWO,	F 2.0
THREE,	F 3.0
FOUR,	F 4.0
SEVEN,	F 7.0
MUNIT,	0027;0;0	/Low unit: Set according to CORE avail.
NINE,	F 9.0
TEN,	F 10.0
ATEEN,	F 18.0
COLON,	F 58.0
PERIOD,	F 46.0
SPACE,	F 32.0
MAXCOR,	0; 7; 0		/RHM: Don't require the FRTS patch.
HGHLOC,	0; 7; 2000	/RHM: Hope memory used doesn't get larger.
/ ADVENT in the current implementation uses up thru 71000 at worst.
/ This hopefully allows room for extra 2-page handlers and the TD8E ROM.
#RTN,	BASE	#BASE
	JA	#GOBAK
#ST,	STARTD
	0210
	FSTA	#GOBAK,0
	0200
	SETX	#XR
	SETB	#BASE
	LDX	0,1
	FSTA	#BASE
	FLDA%	#BASE,1+
	FSTA	UNIT
	FLDA%	#BASE,1+
	FSTA	NAME
	FLDA%	#BASE,1+
	FSTA	FUNCT
	FLDA%	#BASE,1+
	FSTA	ERROR

/	INITIALIZE PROGRAM

SKIP,			/JA SKIP2 AFTER FIRST ENTRY

/		FIND OUT HOW MANY UNITS TO ALLOW

/Note that the original scheme was rather bizzare, and for
/humerous purposes, I have left it here, commented out.
/This worked OK with the old FPP interpreter, since it zeroed
/the exponent with a STARTF. The FPP does not, and the
/EXPONENT is left indeterminate. This meant that sometimes
/you could use past 72400, and sometimes you couldn't.
/(Note, that S.B.'s version of FRTS has been changed
/so that the FPP interpreter works the same as the FPP.)

/	FLDA MAXCOR	/Load highest field number
/	FSUB HGHLOC	/Subtract high location
/	FADD D2400	/1 FIELD LESS 5400 LOCS FOR 5 DEVICES
			/  NOTE:  PG. 7600 RESERVED FOR OS/8
			/	  PG. 7400 USED FOR OS/8 USR CALL
/	JGE SKCONT	/ROOM FOR 5 DEVICES?
/	FADD D15000	/Note, FAC= how many locations short
/	FMUL D1000	/HOW MANY 1000 WORD BLOCKS ARE THERE?
/	STARTF
/	FNORM
/	FMUL E30	/ALTHOUGH WE WERE WORKING WITH AN
/			/INTEGER ABOVE, THE FPP THOUGHT IT
/			/HAD A BINARY POINT TO THE RT. OF THE
/			/SIGN BIT.  THIS INSTRUCTION EFFECTIVELY
/			/CHANGES THE NUMBER TO A REAL FPP INTEGER.
/	FSTA MUNIT	/MINIMUM UNIT # ALLOWED
/D15000,	1;5000
/D1000,	4;0	/0.001
/E30,	30;2000;0	/1.E30(2)

/The routine should really be modified to check which handlers
/are already loaded. This wouldn't be all that difficult,
/since the field 1 tables of handler residency are saved on
/SYS block 37, and restored each time USR is called. As long
/as a reset isn't performed, it should be easy to determine
/if a handler is already loaded. Then HGHLOC could be changed
/dynamically, as handlers were loaded. The core usage would then
/also be independent of the unit number used.

	FLDA	MAXCOR	/Load Max field #
	FADD	D7400	/Offset to highest useable address
	FSUB	HGHLOC	/Compute locations available
	LDX	11,1	/Load shift argument
	ALN	1	/Divide by 1000
	FSTA	MUNIT+1,0 /Store number of units
	STARTF
	FLDA	TEN	/Load MAX units+1
	FSUB	MUNIT	/Subtract number of units
	FSTA	MUNIT	/Store new minimum unit
	FSUB	THREE	/Limit min. to three
	JGE	SKCONT	/Ok if greater than 2
	FLDA	THREE	/Just in case we need to avoid
	FSTA	MUNIT	/field boundary problems

SKCONT,	STARTD
	SETX MAXCOR+1
	XTA 0		/GET HIGHEST FIELD
	FDIV D10X	/PUT IT INTO BITS 6-8 OF LO ORDER WORD
	SETX LHIFLD
	ATX 0		/LOAD HIGHEST FIELD INTO LHIFLD
	FADD DCDF	/MAKE IT CDF HIFLD
	SETX FD1
	ATX 0		/SET LOCATIONS USING IT
	SETX FD2
	ATX 0
	FADD ONED	/MAKE IT CIF HIFLD
	SETX FI1
	ATX 0
	SETX #XR

/	CHECK TO MAKE SURE USER DID NOT DECLARE
/	DEVICE WITH HANDLER EXTERNAL TO THESE ROUTINES.

	FLDA SKIPJA	/SET INSTRUCTION SO THIS CODE
	FSTA SKIP,0	/  EXECUTES ONLY ONCE.
/
	FLDA SXDSRN	/INITIALIZE SETX INSTRUCTION
	FSTA SKCON2
	LDX -11,6	/SET COUNTER (MAX # DSRN ENTRIES)
SKCON2,	SETX DSRN	/STUFFED AND MODIFIED
	XTA 0		/GET NEXT HANDLER ENTRY POINT
	SETX #XR
	FSUB D5200
	JLT SKCON3	/INTERNAL HANDLER, IT'S OK
	FSUB D2400
	JGT SKCON3	/RESIDENT HANDLER (E.G. SYS:), IT'S OK TOO
	LDX 2,0		/***SOME OTHER HANDLER***USER ERROR 2
EXTERN #UE
	TRAP3 #UE	/USER ILLEGALLY DECLARED A FILE!
/
SKCON3,	FLDA  NINED	/INCREMENT TO NEXT DSRN ENTRY
	FADDM SKCON2
	JXN SKCON2,6+
/
SKIP2,	STARTF		/***END OF INITILIZATIN CODE***
	LDX 1,7
	FCLA		/INITIALIZE SOME VARIABLES...
	FSTA PERFLG	/NO PERIODS YET
	FSTA	FILE-0003,7
	FSTA	FILE-0003,7+
	FLDA #DSK	/SETUP DEFAULT DEVICE
	FSTA DEV
	FLDA	ONE	/FIRST CHARACTER IS # 1
	FSTA	N
	FLDA%	UNIT	/CHECK FOR LEGAL UNIT #
	FSUB	MUNIT
	JSA	#LT	/  IF (UNIT.LT.MUNIT.OR.UNIT.GT.9) GO TO 900
	FSTA	#TMP+00
	FLDA%	UNIT
	FSUB	NINE
	JSA	#GT
	FADD	#TMP+00
	JNE	#900
	FLDA%	FUNCT	/CHECK FOR LEGAL FUNCTION CODE
	FSUB	TWO
	EXTERN	#LT
	JSA	#LT	/  IF (FUNCT.LT.2.OR.FUNCT.GT.4) GO TO 901
	FSTA	#TMP+00
	FLDA%	FUNCT
	FSUB	FOUR
	EXTERN	#GT
	JSA	#GT
	FADD	#TMP+00
	JNE	#901
/
/	PUT DEV:FILE.EXT INTO CORRECT FORMAT FOR USR CALL
/
	FLDA	ONE	
	FSTA	I	/  DO 100 I=1,18

#G0002,	JSR	CGET	/  CALL CGET (NAME, I, X)
	JA	.+10
NAME,	JA	.
	JA	I
	JA	X
	FLDA	X	/  IF (X.NE.COLON) GO TO 40
	FSUB	COLON
	JNE	#40
	FLDA I		/COLON MUST BE COLUMN 6 OR BEFORE
	FSUB SEVEN	/7
	JGE #DONE
	FLDA FILE	/COLON DEFINES DEVICE NAME
	FSTA	DEV
	FCLA
	FSTA	FILE
	FLDA	ONE
	FSTA	N
	JA	#100

#40,	FLDA	X	/  IF (X.NE.PERIOD) GO TO 60
	FSUB	PERIOD
	JNE	#60
	FLDA PERFLG	/ONLY ONE PERIOD ALLOWED
	JNE #DONE
	FLDA	SEVEN	/SET TO DECODE EXTENSION
	FSTA PERFLG
	FSTA	N
	JA	#100

#60,	FLDA X
	JEQ #100	/SKIP OVER NULL'S
	FSUB SPACE
	JEQ #100	/SKIP OVER SPACES
	JSR	CPUT	/  CALL CPUT (FILE, N, X)
	JA	.+10
	JA	FILE
	JA	N
	JA	X
	FLDA	N	/  N=N+1
	FADD	ONE
	FSTA	N

#100,	FLDA	I	/  100 CONTINUE
	FADD	ONE
	FSTA	I
	FSUB	ATEEN
	JLE	#G0002

#DONE,	FLDA% FUNCT
	FSUB FOUR
	JNE #101	/FUNCTION = CLOSE ?
	EXTERN #ENDF
	FLDA% UNIT	/YES - END FILE
	TRAP3 #ENDF

#101,	SETX FUNCTX	/USR XR TO PASS PARAMETERS
	FLDA% FUNCT
	ATX 0
	FLDA% UNIT
	ATX 1

	TRAP4	#USRSE	/TRAP TO THE USR CALLING ROUTINE

	XTA 2		/GET ERRNO AND RETURN IT
	FSTA% ERROR
	JA	#RTN
#900,	FLDA	THREE	/ILLEGAL UNIT NUMBER!!!
	FSTA%	ERROR
	JA #RTN

#901,	FLDA FOUR	/ILLEGAL FUNCTION CODE!!!
	FSTA%	ERROR
	JA	#RTN
/
SKIPJA,	JA SKIP2
DCDF,	0;CDF
ONED,	0;1
D10X,	400;0	/0.1
D10,	0;10
SXDSRN,	SETX DSRN
NINED,	0;11
D5200,	0;5200
D2400,	0;2400
D7400,	0;7400

SECT8 #USRSE; 0
/
/THIS ROUTINE SETS UP, ON PAGE 7400 OF THE HIGHEST FIELD, A
/ROUTINE WHICH CALLS THE OS/8 USR (USER SERVICE ROUTINE).
/IT IS NECESSARY TO DO THIS BECAUSE THE FORTRAN IV LOADER
/MAY LOAD ANY ROUTINE IN THE RESERVED AREA FOR
/THE OS/8 USR (10000 - 11777).  
/
/	THIS PROGRAM ALSO REQUIRES
/	THAT 'HKEY' BE THE LOCATION IN <FRTS> AS DEFINED
/	BELOW:

HKEY=2761
DSRN=4244		/Address of DSRN table in FRTS

/
/IN CASE CLOSE FUNCTION, GET # BLOCKS WRITTEN
/
	TAD UNITX
	CLL RTL		/MULTIPLY BY 9
	RAL
	TAD UNITX
	TAD K6		/OFFSET TO CURRENT BLOCK
	TAD LDSRN	/START OF DSRN TABLE - 11
	DCA TEMQ
	CDF 0
	TAD% TEMQ
	DCA SB
/
/MOVE USR CALLING ROUTINE TO DEFINED LOCATION
/	I.E. PROTECT LOCS 10000-11777
/
	TAD K7400	/Target address
	DCA TEMQ	/Store for indirect reference
	TAD #LUSR+1	/Origin address
	DCA TEMQ2	/Store for indirect reference
	TAD M200	/Number of words to move
	DCA TEMQ3	/Store in a counter
	TAD #LUSR	/Load field word
	AND K7		/Strip it
	CLL RTL		/Into right bits
	RAL
	TAD #CDF
	DCA .+1		/Store the CDF
FUSR,	HLT		/Set field where USR loads
	TAD% TEMQ2	/Load routine location
FD1,	CDF 00		/Set HIGH field
	DCA% TEMQ	/Store location in high field
	ISZ TEMQ	/Bump the pointers
	ISZ TEMQ2
	ISZ TEMQ3	/And the counters
	JMP FUSR	/Loop on it

/SET FIELDS AND CALL IT

	RIF		/GET CURRENT FIELD
	TAD #CDF
	DCA .+1
	HLT		/Set this field
FI1,	CIF 00		/Set high field
	TAD FUNCTX	/Load function number
	JMS% K7400	/Call routine
SB,	  0		/START BLOCK OF FILE OR LENGTH IF CLOSE
NOBLKS,	  0		/LENGTH OF FILE
ENTPT,	  0		/HANDLER ENTRY POINT
	DCA ERRUSR	/SAVE ERROR RETURN VALUE

/SETUP TO MOVE DSRN TABLE APPROPRIATELY

	TAD UNITX
	CLL RTL		/MULTIPLY BY 9
	RAL
	TAD UNITX
	TAD LDSRN
	DCA TEMQ
#CDF,	CDF 0
	DCA% TEMQ	/DISABLE FILE IN CASE CLOSE FUNCTION
	CLA CLL CMA RTL	/-3 => AC
	TAD FUNCTX
	SMA SZA CLA	/CLOSE?
	JMP USRSL5	/YES

/MOVE HANDLER TO APROPRIATE BUFFER

	CLA CMA CLL RAL	/-2 => AC
	TAD UNITX
	CLL RTR
	RTR		/UNIT 9 => AC=7000; UNIT 8 => AC=6000
	TAD M400
	DCA LHNDR	/LOCATION FOR THIS UNIT'S HANDLER
	TAD K5200
	DCA TEMQ2
	TAD M400
	DCA TEMQ3
USRL4,	CDF 0
	TAD% TEMQ2
FD2,	CDF 00
	DCA% LHNDR
	ISZ TEMQ2
	ISZ LHNDR
	ISZ TEMQ3
	JMP USRL4

/BUILD UP NEW DSRN TABLE FOR THIS UNIT

	CDF 0
	TAD ENTPT
	DCA% TEMQ	/ENTRY POINT
	ISZ TEMQ
	CLL CML RTL	/2 => AC (FORMS CONTROL BIT)
	TAD LHNDR
	TAD M400
	TAD LHIFLD
	DCA% TEMQ	/HANDLER CODE WORD
	TAD K7774	/*K* KLUDGE TO LET FRTS KNOW WHICH
	AND% TEMQ	/    HANDLER IS IN CORE
	DCA% #HKEY
	ISZ TEMQ
	TAD LHNDR
	TAD LHIFLD
	DCA% TEMQ	/BUFFER ADDRESS & FIELD
	ISZ TEMQ
	TAD LHNDR
	DCA% TEMQ	/CHARACTER POINTER
	ISZ TEMQ
	CMA CLL RTL	/-3 => AC
	DCA% TEMQ	/CHARACTER COUNTER
	ISZ TEMQ
	TAD SB
	DCA% TEMQ	/START BLOCK
	ISZ TEMQ
	DCA% TEMQ	/RELATIVE BLOCK
	ISZ TEMQ
	TAD NOBLKS
	DCA% TEMQ	/LENGTH OF FILE
	ISZ TEMQ
	DCA% TEMQ	/STATUS WORD

USRSL5,	CDF CIF 0
	JMP% #USRSE


K6,	6
K7400,	7400
M200,	-200
M400,	-400
K7,	7
K5200,	5200

LDSRN,	DSRN-11		/START LOCATION OF DSRN TABLE

LHIFLD,	0
TEMQ,	0
TEMQ2,	0
TEMQ3,	0
LHNDR,	0
FUNCTX,	0		/STUFFED BY RALF CODE
UNITX,	0		/STUFFED BY RALF CODE
ERRUSR,	0		/READ BY RALF CODE

#LUSR,	ADDR #USR
#HKEY,	HKEY		/LOCATION OF HKEY IN FRTS
			/  MUST AGREE WITH VERSION!!
K7774,	7774
/
	ORG .+177&7600
/USR CALLING SUBROUTINE FOR FORTRAN 
/
/	THIS ROUTINE IS MOVED TO PAGE 7400 OF THE HIGHEST
/	FIELD BEFORE EXECUTING TO AVOID BEING OVERWRITTEN BY THE USR
/	ROUTINE.  NO FILE SPECIFICATIONS OTHER THAN INTERNAL
/	HANDLERS AND SYSTEM DEVICES MAY BE MADE EXTERNAL TO THESE
/	ROUTINES BECAUSE THE USE OF THIS ROUTINE WILL OVERWRITE
/	THE HANDLERS WHICH ARE STORED IN HIGH CORE.
/
/
#USR, 0
/
/	ENTER WITH FUNCTION CODE IN THE AC
/		2 - LOOKUP (OPEN FOR INPUT)
/		3 - ENTER  (OPEN FOR OUTPUT)
/		4 - CLOSE  (CLOSE OUTPUT FILE)
/
/	DEVICE AND FILE NAMES ARE STUFFED BY THE CALLING
/	PROGRAM BEFORE THIS SUBROUTINE IS CALLED.
/
/	CALLING SEQUENCE:
/		JMS #USR
/		  START BLOCK OF FILE (RETURNED FOR CODE 2 & 3)
/			# BLOCKS SUPPLIED IF CODE 4
/		  NUMBER OF BLOCKS IN FILE (RETURNED FOR CODE 2 & 3)
/		  ENTRY POINT OF HANDLER AS READ INTO PAGE 5200
/		<RETURN>
/
/	AC ON EXIT CONTAINS ERROR CONDITION:
/		0 - NO ERROR
/		1 - ILLEGAL DEVICE
/		2 - ILLEGAL FILE NAME
/
	DCA FUNCTY	/SAVE FUNCTION CODE
	TAD% #USR	/GET # BLOCKS IN CASE CLOSE FUNCTION
	DCA #BLKS

	RDF		/SET INSTRUCTION FIELD FOR RETURN
	TAD #CIF
	DCA EXIT4
	CMA		/MAKE IT CDF
	TAD EXIT4
	DCA EXIT
	DCA ERRNO	/INITIALIZE ERROR RETURN VARIABLE
	CMA
	TAD #CIF	/-1 IN AC MAKES IT CDF
	RIF
	DCA .+1
	HLT		/SET DATA FIELD TO CURRENT FIELD

/	********SWAP CORE FOR USR CALL

/Note, that it would be much simpler to read in the field
/one tables, and call USR at 17700. Let USR do the swapping.
/We must only set the correct bits in the JSW.

	IOF
#CIF,	CIF 0
	JMS% K7607	/CALL SYSTEM HANDLER
	  5210		/  WRITE 17400-17777,10000-11777
	  7400
	    27
	HLT		/DEVICE ERROR

	CIF 0
	JMS% K7607	/READ IN USR
	   610
	     0
	    13		/From block 13
	HLT

	CIF 0
	JMS% K7607	/READ IN FIELD ONE TABLES
	   210
	  7400
	    37		/From block 37 (where FRTS put it)
	HLT

/	********PERFORM USR FUNCTIONS

	CIF 10
	JMS% K200	/RESET tables, so it looks like no handlers
	    13
	     0

	TAD K5201	/SET PAGE FOR HANDLER (allow 2 page handler)
	DCA ENTRY
	CIF 10
	JMS% K200	/FETCH
	     1
DEV,	     0		/(STUFFED BY RALF ROUTINE)
DEVNO,	     0
ENTRY,	  5201
	JMP ERR		/ILLEGAL DEVICE

	TAD #LFILE	/SET POINTER TO FILE
	TAD KOFSET
	DCA LFILE
	TAD DEVNO	/GET DEVICE NUMBER
	CIF 10
	JMS% K200	/PERFORM FUNCTION
FUNCTY,	     0
SB2,
LFILE,	     0
#BLKS,	     0
	JMP ERR2	/FILE ERROR

/	********RESTORE CORE

EXIT2,	CIF 0
	JMS% K7607	/SAVE FIELD ONE TABLES
	  4210		/? Is this really necessary?
	  7400		/Since they've already been saved?
	    37		/by FRTS
	HLT

	CIF 0		/USROUT function would do this
	JMS% K7607	/Read in the Stuff we saved
	  1210
	  7400
	    27
	HLT

	ION		/Is this necessary?
EXIT,	HLT
	TAD SB2		/RETURN SB & #BLKS
	DCA% #USR
	ISZ #USR
	TAD SB2
	SZA CLA		/NON-FILE STRUCTURED DEVICE?
	JMP .+3
	CMA		/YES - SET MAX NUMBER OF BLOCKS
	JMP .+3
	TAD #BLKS
	CIA
	DCA% #USR
	ISZ #USR
	TAD ENTRY
	DCA% #USR
	ISZ #USR
	TAD ERRNO
EXIT4,	HLT
	JMP% #USR


K7607,	7607		/SYSTEM HANDLER ENTRY POINT
K200,	200		/USR ENTRY POINT
K5201,	5201		/PAGE FOR HANDLER (& TWO PAGES AVAILABLE)

ERR2,	CLA IAC		/ILLEGAL FILE NAME
ERR,	IAC		/ILLEGAL DEVICE NAME
	DCA ERRNO
	JMP EXIT2
ERRNO,	0

#LFILE,	AND FILE	/LOCATION OF FILE ON PAGE 7400
			/'AND' NEEDED TO TRICK ABSOLUTE REFERENCE
			/CHECK IN RALF.
KOFSET,	7200		/OFFSET TO REAL EXECUTION ADDRESS
FILE,	0;0;0;0;0;0;0;0;0