[pdp8.git] / sw / f4 / extra / USR.RA

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

/       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, 3; 0            /RHM: Don't require the FRTS patch.
HGHLOC, 7; 3400         /RHM: Hope memory used doesn't get larger.
/ ADVENT in the current implementation uses up thru 73000 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
        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