File: USR.RA of Disk: V50/Source/Source-Listing-FORTRAN-2
(Source file text)
/ 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, 7; 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