File: USR.LS of Disk: V50/Source/Source-Listing-FORTRAN-2
(Source file text)
RALF V50A 24-JUL-20 PAGE 1
/ 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
RALF V50A 24-JUL-20 PAGE 1-1
/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
00000 1030 JA #ST
00001 0141
/NOTE: MUCH OF THIS CODE WAS LIFTED FROM A FORTRAN
/ GENERATED ASSEMBLY LISTING. ACCEPT THIS AS
RALF V50A 24-JUL-20 PAGE 1-2
/ AN APOLOGY FOR THE LACK OF COMMENTS IN SOME SECTIONS.
/
#XR, ORG .+10
00012 2523 TEXT +USR +
00013 2240
00014 4000
00015 1100 #RET, SETX #XR
00016 0002
00017 1110 SETB #BASE
00020 0023
00021 1030 JA .+3
00022 0024
#BASE, ORG .+6 /BASE 0 AND 1
UNIT, ORG .+3 /BASE 2
FUNCT, ORG .+3 /BASE 3
ERROR, ORG .+3 /BASE 4
00042 0423 #DSK, TEXT +DSK@@@+ /DEFAULT DEVICE NAME
00043 1300
00044 0000
00045 0000 I, F 0.0 /BASE 6
00046 0000
00047 0000
00050 0000 N, F 0.0 /BASE 7
00051 0000
00052 0000
ORG #BASE+30
00053 0040 FNOP
00054 1030 JA #RET
00055 0015
00056 0040 FNOP
00057 0000 #GOBAK, 0;0
00060 0000
00061 0000 PERFLG, F 0.0 /PERIOD FLAG
00062 0000
00063 0000
X,
#TMP, ORG .+3
00067 0001 ONE, F 1.0
00070 2000
00071 0000
00072 0002 TWO, F 2.0
00073 2000
00074 0000
00075 0002 THREE, F 3.0
00076 3000
00077 0000
00100 0003 FOUR, F 4.0
00101 2000
00102 0000
00103 0003 SEVEN, F 7.0
00104 3400
00105 0000
00106 0027 MUNIT, 0027;0;0 /Low unit: Set according to CORE avail.
00107 0000
RALF V50A 24-JUL-20 PAGE 1-3
00110 0000
00111 0004 NINE, F 9.0
00112 2200
00113 0000
00114 0004 TEN, F 10.0
00115 2400
00116 0000
00117 0005 ATEEN, F 18.0
00120 2200
00121 0000
00122 0006 COLON, F 58.0
00123 3500
00124 0000
00125 0006 PERIOD, F 46.0
00126 2700
00127 0000
00130 0006 SPACE, F 32.0
00131 2000
00132 0000
00133 0007 MAXCOR, 7; 0 /RHM: Don't require the FRTS patch.
00134 0000
00135 0007 HGHLOC, 7; 3400 /RHM: Hope memory used doesn't get larger.
00136 3400
/ 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
00137 1030 JA #GOBAK
00140 0057
00141 0006 #ST, STARTD
00142 0210 0210
00143 6400 FSTA #GOBAK,0
00144 0057
00145 0200 0200
00146 1100 SETX #XR
00147 0002
00150 1110 SETB #BASE
00151 0023
00152 0101 LDX 0,1
00153 0000
00154 6200 FSTA #BASE
00155 0710 FLDA% #BASE,1+
00156 6202 FSTA UNIT
00157 0710 FLDA% #BASE,1+
00160 6400 FSTA NAME
00161 0355
00162 0710 FLDA% #BASE,1+
00163 6203 FSTA FUNCT
00164 0710 FLDA% #BASE,1+
00165 6204 FSTA ERROR
/ INITIALIZE PROGRAM
SKIP, /JA SKIP2 AFTER FIRST ENTRY
/ FIND OUT HOW MANY UNITS TO ALLOW
RALF V50A 24-JUL-20 PAGE 1-4
/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.
00166 0230 FLDA MAXCOR /Load Max field #
00167 1400 FADD D7400 /Offset to highest useable address
00170 0530
00171 2230 FSUB HGHLOC /Compute locations available
00172 0101 LDX 11,1 /Load shift argument
00173 0011
00174 0011 ALN 1 /Divide by 1000
00175 6400 FSTA MUNIT+1,0 /Store number of units
00176 0107
00177 0005 STARTF
00200 0223 FLDA TEN /Load MAX units+1
00201 2221 FSUB MUNIT /Subtract number of units
00202 6221 FSTA MUNIT /Store new minimum unit
00203 2216 FSUB THREE /Limit min. to three
00204 1010 JGE SKCONT /Ok if greater than 2
00205 0210
00206 0216 FLDA THREE /Just in case we need to avoid
00207 6221 FSTA MUNIT /field boundary problems
RALF V50A 24-JUL-20 PAGE 1-5
00210 0006 SKCONT, STARTD
00211 1100 SETX MAXCOR
00212 0133
00213 0030 XTA 0 /GET HIGHEST FIELD
00214 3400 FDIV D10X /PUT IT INTO BITS 6-8 OF LO ORDER WORD
00215 0514
00216 1100 SETX LHIFLD
00217 0161
00220 0020 ATX 0 /LOAD HIGHEST FIELD INTO LHIFLD
00221 1400 FADD DCDF /MAKE IT CDF HIFLD
00222 0510
00223 1100 SETX FD1
00224 0031
00225 0020 ATX 0 /SET LOCATIONS USING IT
00226 1100 SETX FD2
00227 0102
00230 0020 ATX 0
00231 1400 FADD ONED /MAKE IT CIF HIFLD
00232 0512
00233 1100 SETX FI1
00234 0043
00235 0020 ATX 0
00236 1100 SETX #XR
00237 0002
/ CHECK TO MAKE SURE USER DID NOT DECLARE
/ DEVICE WITH HANDLER EXTERNAL TO THESE ROUTINES.
00240 0400 FLDA SKIPJA /SET INSTRUCTION SO THIS CODE
00241 0506
00242 6400 FSTA SKIP,0 / EXECUTES ONLY ONCE.
00243 0166
/
00244 0400 FLDA SXDSRN /INITIALIZE SETX INSTRUCTION
00245 0520
00246 6400 FSTA SKCON2
00247 0252
00250 0106 LDX -11,6 /SET COUNTER (MAX # DSRN ENTRIES)
00251 7767
00252 1100' SKCON2, SETX DSRN /STUFFED AND MODIFIED
00253 4244
00254 0030 XTA 0 /GET NEXT HANDLER ENTRY POINT
00255 1100 SETX #XR
00256 0002
00257 2400 FSUB D5200
00260 0524
00261 1050 JLT SKCON3 /INTERNAL HANDLER, IT'S OK
00262 0273
00263 2400 FSUB D2400
00264 0526
00265 1060 JGT SKCON3 /RESIDENT HANDLER (E.G. SYS:), IT'S OK TOO
00266 0273
00267 0100 LDX 2,0 /***SOME OTHER HANDLER***USER ERROR 2
00270 0002
EXTERN #UE
RALF V50A 24-JUL-20 PAGE 1-6
00271 3000 TRAP3 #UE /USER ILLEGALLY DECLARED A FILE!
00272 0000
/
00273 0400 SKCON3, FLDA NINED /INCREMENT TO NEXT DSRN ENTRY
00274 0522
00275 5400 FADDM SKCON2
00276 0252
00277 2160 JXN SKCON2,6+
00300 0252
/
00301 0005 SKIP2, STARTF /***END OF INITILIZATIN CODE***
00302 0107 LDX 1,7
00303 0001
00304 0002 FCLA /INITIALIZE SOME VARIABLES...
00305 6212 FSTA PERFLG /NO PERIODS YET
00306 6470 FSTA FILE-0003,7
00307 0341
00310 6570 FSTA FILE-0003,7+
00311 0341
00312 0205 FLDA #DSK /SETUP DEFAULT DEVICE
00313 6400 FSTA DEV
00314 0254
00315 0214 FLDA ONE /FIRST CHARACTER IS # 1
00316 6207 FSTA N
00317 0602 FLDA% UNIT /CHECK FOR LEGAL UNIT #
00320 2221 FSUB MUNIT
00321 1120 JSA #LT / IF (UNIT.LT.MUNIT.OR.UNIT.GT.9) GO TO 900
00322 0000
00323 6213 FSTA #TMP+00
00324 0602 FLDA% UNIT
00325 2222 FSUB NINE
00326 1120 JSA #GT
00327 0000
00330 1213 FADD #TMP+00
00331 1040 JNE #900
00332 0476
00333 0603 FLDA% FUNCT /CHECK FOR LEGAL FUNCTION CODE
00334 2215 FSUB TWO
EXTERN #LT
00335 1120 JSA #LT / IF (FUNCT.LT.2.OR.FUNCT.GT.4) GO TO 901
00336 0000
00337 6213 FSTA #TMP+00
00340 0603 FLDA% FUNCT
00341 2217 FSUB FOUR
EXTERN #GT
00342 1120 JSA #GT
00343 0000
00344 1213 FADD #TMP+00
00345 1040 JNE #901
00346 0502
/
/ PUT DEV:FILE.EXT INTO CORRECT FORMAT FOR USR CALL
/
00347 0214 FLDA ONE
00350 6206 FSTA I / DO 100 I=1,18
RALF V50A 24-JUL-20 PAGE 1-7
00351 1130 #G0002, JSR CGET / CALL CGET (NAME, I, X)
00352 0000
00353 1030 JA .+10
00354 0363
00355 1030 NAME, JA .
00356 0355
00357 1030 JA I
00360 0045
00361 1030 JA X
00362 0064
00363 0213 FLDA X / IF (X.NE.COLON) GO TO 40
00364 2225 FSUB COLON
00365 1040 JNE #40
00366 0406
00367 0206 FLDA I /COLON MUST BE COLUMN 6 OR BEFORE
00370 2220 FSUB SEVEN /7
00371 1010 JGE #DONE
00372 0453
00373 0400 FLDA FILE /COLON DEFINES DEVICE NAME
00374 0344
00375 6400 FSTA DEV
00376 0254
00377 0002 FCLA
00400 6400 FSTA FILE
00401 0344
00402 0214 FLDA ONE
00403 6207 FSTA N
00404 1030 JA #100
00405 0445
00406 0213 #40, FLDA X / IF (X.NE.PERIOD) GO TO 60
00407 2226 FSUB PERIOD
00410 1040 JNE #60
00411 0422
00412 0212 FLDA PERFLG /ONLY ONE PERIOD ALLOWED
00413 1040 JNE #DONE
00414 0453
00415 0220 FLDA SEVEN /SET TO DECODE EXTENSION
00416 6212 FSTA PERFLG
00417 6207 FSTA N
00420 1030 JA #100
00421 0445
00422 0213 #60, FLDA X
00423 1000 JEQ #100 /SKIP OVER NULL'S
00424 0445
00425 2227 FSUB SPACE
00426 1000 JEQ #100 /SKIP OVER SPACES
00427 0445
00430 1130 JSR CPUT / CALL CPUT (FILE, N, X)
00431 0000
00432 1030 JA .+10
00433 0442
00434 1030 JA FILE
00435 0344
00436 1030 JA N
RALF V50A 24-JUL-20 PAGE 1-8
00437 0050
00440 1030 JA X
00441 0064
00442 0207 FLDA N / N=N+1
00443 1214 FADD ONE
00444 6207 FSTA N
00445 0206 #100, FLDA I / 100 CONTINUE
00446 1214 FADD ONE
00447 6206 FSTA I
00450 2224 FSUB ATEEN
00451 1020 JLE #G0002
00452 0351
00453 0603 #DONE, FLDA% FUNCT
00454 2217 FSUB FOUR
00455 1040 JNE #101 /FUNCTION = CLOSE ?
00456 0462
EXTERN #ENDF
00457 0602 FLDA% UNIT /YES - END FILE
00460 3000 TRAP3 #ENDF
00461 0000
00462 1100 #101, SETX FUNCTX /USR XR TO PASS PARAMETERS
00463 0166
00464 0603 FLDA% FUNCT
00465 0020 ATX 0
00466 0602 FLDA% UNIT
00467 0021 ATX 1
00470 4000 TRAP4 #USRSE /TRAP TO THE USR CALLING ROUTINE
00471 0000
00472 0032 XTA 2 /GET ERRNO AND RETURN IT
00473 6604 FSTA% ERROR
00474 1030 JA #RTN
00475 0137
00476 0216 #900, FLDA THREE /ILLEGAL UNIT NUMBER!!!
00477 6604 FSTA% ERROR
00500 1030 JA #RTN
00501 0137
00502 0217 #901, FLDA FOUR /ILLEGAL FUNCTION CODE!!!
00503 6604 FSTA% ERROR
00504 1030 JA #RTN
00505 0137
/
00506 1030 SKIPJA, JA SKIP2
00507 0301
00510 0000 DCDF, 0;CDF
00511 6201
00512 0000 ONED, 0;1
00513 0001
00514 0400 D10X, 400;0 /0.1
00515 0000
00516 0000 D10, 0;10
RALF V50A 24-JUL-20 PAGE 1-9
00517 0010
00520 1100' SXDSRN, SETX DSRN
00521 4244
00522 0000 NINED, 0;11
00523 0011
00524 0000 D5200, 0;5200
00525 5200
00526 0000 D2400, 0;2400
00527 2400
00530 0000 D7400, 0;7400
00531 7400
SECT8 #USRSE; 0
00000 0000
/
/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
/
00001 1367 TAD UNITX
00002 7106 CLL RTL /MULTIPLY BY 9
00003 7004 RAL
00004 1367 TAD UNITX
00005 1352 TAD K6 /OFFSET TO CURRENT BLOCK
00006 1360 TAD LDSRN /START OF DSRN TABLE - 11
00007 3362 DCA TEMQ
00010 6201 CDF 0
00011 1762 TAD% TEMQ
00012 3246 DCA SB
/
/MOVE USR CALLING ROUTINE TO DEFINED LOCATION
/ I.E. PROTECT LOCS 10000-11777
/
00013 1353 TAD K7400 /Target address
00014 3362 DCA TEMQ /Store for indirect reference
00015 1372 TAD #LUSR+1 /Origin address
00016 3363 DCA TEMQ2 /Store for indirect reference
00017 1354 TAD M200 /Number of words to move
00020 3364 DCA TEMQ3 /Store in a counter
00021 1371 TAD #LUSR /Load field word
00022 0356 AND K7 /Strip it
00023 7106 CLL RTL /Into right bits
00024 7004 RAL
00025 1260 TAD #CDF
RALF V50A 24-JUL-20 PAGE 1-10
00026 3227 DCA .+1 /Store the CDF
00027 7402 FUSR, HLT /Set field where USR loads
00030 1763 TAD% TEMQ2 /Load routine location
00031 6201 FD1, CDF 00 /Set HIGH field
00032 3762 DCA% TEMQ /Store location in high field
00033 2362 ISZ TEMQ /Bump the pointers
00034 2363 ISZ TEMQ2
00035 2364 ISZ TEMQ3 /And the counters
00036 5227 JMP FUSR /Loop on it
/SET FIELDS AND CALL IT
00037 6224 RIF /GET CURRENT FIELD
00040 1260 TAD #CDF
00041 3242 DCA .+1
00042 7402 HLT /Set this field
00043 6202 FI1, CIF 00 /Set high field
00044 1366 TAD FUNCTX /Load function number
00045 4753 JMS% K7400 /Call routine
00046 0000 SB, 0 /START BLOCK OF FILE OR LENGTH IF CLOSE
00047 0000 NOBLKS, 0 /LENGTH OF FILE
00050 0000 ENTPT, 0 /HANDLER ENTRY POINT
00051 3370 DCA ERRUSR /SAVE ERROR RETURN VALUE
/SETUP TO MOVE DSRN TABLE APPROPRIATELY
00052 1367 TAD UNITX
00053 7106 CLL RTL /MULTIPLY BY 9
00054 7004 RAL
00055 1367 TAD UNITX
00056 1360 TAD LDSRN
00057 3362 DCA TEMQ
00060 6201 #CDF, CDF 0
00061 3762 DCA% TEMQ /DISABLE FILE IN CASE CLOSE FUNCTION
00062 7346 CLA CLL CMA RTL /-3 => AC
00063 1366 TAD FUNCTX
00064 7740 SMA SZA CLA /CLOSE?
00065 5350 JMP USRSL5 /YES
/MOVE HANDLER TO APROPRIATE BUFFER
00066 7344 CLA CMA CLL RAL /-2 => AC
00067 1367 TAD UNITX
00070 7112 CLL RTR
00071 7012 RTR /UNIT 9 => AC=7000; UNIT 8 => AC=6000
00072 1355 TAD M400
00073 3365 DCA LHNDR /LOCATION FOR THIS UNIT'S HANDLER
00074 1357 TAD K5200
00075 3363 DCA TEMQ2
00076 1355 TAD M400
00077 3364 DCA TEMQ3
00100 6201 USRL4, CDF 0
00101 1763 TAD% TEMQ2
00102 6201 FD2, CDF 00
00103 3765 DCA% LHNDR
00104 2363 ISZ TEMQ2
RALF V50A 24-JUL-20 PAGE 1-11
00105 2365 ISZ LHNDR
00106 2364 ISZ TEMQ3
00107 5300 JMP USRL4
/BUILD UP NEW DSRN TABLE FOR THIS UNIT
00110 6201 CDF 0
00111 1250 TAD ENTPT
00112 3762 DCA% TEMQ /ENTRY POINT
00113 2362 ISZ TEMQ
00114 7126 CLL CML RTL /2 => AC (FORMS CONTROL BIT)
00115 1365 TAD LHNDR
00116 1355 TAD M400
00117 1361 TAD LHIFLD
00120 3762 DCA% TEMQ /HANDLER CODE WORD
00121 1374 TAD K7774 /*K* KLUDGE TO LET FRTS KNOW WHICH
00122 0762 AND% TEMQ / HANDLER IS IN CORE
00123 3773 DCA% #HKEY
00124 2362 ISZ TEMQ
00125 1365 TAD LHNDR
00126 1361 TAD LHIFLD
00127 3762 DCA% TEMQ /BUFFER ADDRESS & FIELD
00130 2362 ISZ TEMQ
00131 1365 TAD LHNDR
00132 3762 DCA% TEMQ /CHARACTER POINTER
00133 2362 ISZ TEMQ
00134 7146 CMA CLL RTL /-3 => AC
00135 3762 DCA% TEMQ /CHARACTER COUNTER
00136 2362 ISZ TEMQ
00137 1246 TAD SB
00140 3762 DCA% TEMQ /START BLOCK
00141 2362 ISZ TEMQ
00142 3762 DCA% TEMQ /RELATIVE BLOCK
00143 2362 ISZ TEMQ
00144 1247 TAD NOBLKS
00145 3762 DCA% TEMQ /LENGTH OF FILE
00146 2362 ISZ TEMQ
00147 3762 DCA% TEMQ /STATUS WORD
00150 6203 USRSL5, CDF CIF 0
00151 5600 JMP% #USRSE
00152 0006 K6, 6
00153 7400 K7400, 7400
00154 7600 M200, -200
00155 7400 M400, -400
00156 0007 K7, 7
00157 5200 K5200, 5200
00160 4233 LDSRN, DSRN-11 /START LOCATION OF DSRN TABLE
00161 0000 LHIFLD, 0
00162 0000 TEMQ, 0
00163 0000 TEMQ2, 0
00164 0000 TEMQ3, 0
RALF V50A 24-JUL-20 PAGE 1-12
00165 0000 LHNDR, 0
00166 0000 FUNCTX, 0 /STUFFED BY RALF CODE
00167 0000 UNITX, 0 /STUFFED BY RALF CODE
00170 0000 ERRUSR, 0 /READ BY RALF CODE
00171 0000 #LUSR, ADDR #USR
00172 0200
00173 2761 #HKEY, HKEY /LOCATION OF HKEY IN FRTS
/ MUST AGREE WITH VERSION!!
00174 7774 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.
/
/
00200 0000 #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
/
00201 3266 DCA FUNCTY /SAVE FUNCTION CODE
00202 1600 TAD% #USR /GET # BLOCKS IN CASE CLOSE FUNCTION
00203 3270 DCA #BLKS
00204 6214 RDF /SET INSTRUCTION FIELD FOR RETURN
00205 1221 TAD #CIF
00206 3330 DCA EXIT4
00207 7040 CMA /MAKE IT CDF
00210 1330 TAD EXIT4
00211 3307 DCA EXIT
00212 3341 DCA ERRNO /INITIALIZE ERROR RETURN VARIABLE
RALF V50A 24-JUL-20 PAGE 1-13
00213 7040 CMA
00214 1221 TAD #CIF /-1 IN AC MAKES IT CDF
00215 6224 RIF
00216 3217 DCA .+1
00217 7402 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.
00220 6002 IOF
00221 6202 #CIF, CIF 0
00222 4732 JMS% K7607 /CALL SYSTEM HANDLER
00223 5210 5210 / WRITE 17400-17777,10000-11777
00224 7400 7400
00225 0027 27
00226 7402 HLT /DEVICE ERROR
00227 6202 CIF 0
00230 4732 JMS% K7607 /READ IN USR
00231 0610 610
00232 0000 0
00233 0013 13 /From block 13
00234 7402 HLT
00235 6202 CIF 0
00236 4732 JMS% K7607 /READ IN FIELD ONE TABLES
00237 0210 210
00240 7400 7400
00241 0037 37 /From block 37 (where FRTS put it)
00242 7402 HLT
/ ********PERFORM USR FUNCTIONS
00243 6212 CIF 10
00244 4733 JMS% K200 /RESET tables, so it looks like no handlers
00245 0013 13
00246 0000 0
00247 1334 TAD K5201 /SET PAGE FOR HANDLER (allow 2 page handler)
00250 3256 DCA ENTRY
00251 6212 CIF 10
00252 4733 JMS% K200 /FETCH
00253 0001 1
00254 0000 DEV, 0 /(STUFFED BY RALF ROUTINE)
00255 0000 DEVNO, 0
00256 5201 ENTRY, 5201
00257 5336 JMP ERR /ILLEGAL DEVICE
00260 1342 TAD #LFILE /SET POINTER TO FILE
00261 1343 TAD KOFSET
00262 3267 DCA LFILE
00263 1255 TAD DEVNO /GET DEVICE NUMBER
00264 6212 CIF 10
RALF V50A 24-JUL-20 PAGE 1-14
00265 4733 JMS% K200 /PERFORM FUNCTION
00266 0000 FUNCTY, 0
SB2,
00267 0000 LFILE, 0
00270 0000 #BLKS, 0
00271 5335 JMP ERR2 /FILE ERROR
/ ********RESTORE CORE
00272 6202 EXIT2, CIF 0
00273 4732 JMS% K7607 /SAVE FIELD ONE TABLES
00274 4210 4210 /? Is this really necessary?
00275 7400 7400 /Since they've already been saved?
00276 0037 37 /by FRTS
00277 7402 HLT
00300 6202 CIF 0 /USROUT function would do this
00301 4732 JMS% K7607 /Read in the Stuff we saved
00302 1210 1210
00303 7400 7400
00304 0027 27
00305 7402 HLT
00306 6001 ION /Is this necessary?
00307 7402 EXIT, HLT
00310 1267 TAD SB2 /RETURN SB & #BLKS
00311 3600 DCA% #USR
00312 2200 ISZ #USR
00313 1267 TAD SB2
00314 7640 SZA CLA /NON-FILE STRUCTURED DEVICE?
00315 5320 JMP .+3
00316 7040 CMA /YES - SET MAX NUMBER OF BLOCKS
00317 5322 JMP .+3
00320 1270 TAD #BLKS
00321 7041 CIA
00322 3600 DCA% #USR
00323 2200 ISZ #USR
00324 1256 TAD ENTRY
00325 3600 DCA% #USR
00326 2200 ISZ #USR
00327 1341 TAD ERRNO
00330 7402 EXIT4, HLT
00331 5600 JMP% #USR
00332 7607 K7607, 7607 /SYSTEM HANDLER ENTRY POINT
00333 0200 K200, 200 /USR ENTRY POINT
00334 5201 K5201, 5201 /PAGE FOR HANDLER (& TWO PAGES AVAILABLE)
00335 7201 ERR2, CLA IAC /ILLEGAL FILE NAME
00336 7001 ERR, IAC /ILLEGAL DEVICE NAME
00337 3341 DCA ERRNO
00340 5272 JMP EXIT2
00341 0000 ERRNO, 0
00342 0344 #LFILE, AND FILE /LOCATION OF FILE ON PAGE 7400
RALF V50A 24-JUL-20 PAGE 1-15
/'AND' NEEDED TO TRICK ABSOLUTE REFERENCE
/CHECK IN RALF.
00343 7200 KOFSET, 7200 /OFFSET TO REAL EXECUTION ADDRESS
00344 0000 FILE, 0;0;0;0;0;0;0;0;0
00345 0000
00346 0000
00347 0000
00350 0000
00351 0000
00352 0000
00353 0000
00354 0000
RALF V50A 24-JUL-20 PAGE 1-16
NO ERRORS
112 SYMBOLS, 2 ABS REFS
# C 00000 #BASE 00023 #BLKS 00270 #CDF 00060
#CIF 00221 #DONE 00453 #DSK 00042 #ENDF X 00000
#GOBAK 00057 #GT X 00000 #G0002 00351 #HKEY 00173
#LFILE 00342 #LT X 00000 #LUSR 00171 #MAIN S 00000
#RET 00015 #RTN 00137 #ST 00141 #TMP 00064
#UE X 00000 #USR 00200 #USRSE 8 00355 #XR 00002
#100 00445 #101 00462 #40 00406 #60 00422
#900 00476 #901 00502 ATEEN 00117 CGET X 00000
COLON 00122 CPUT X 00000 DCDF 00510 DEV 00254
DEVNO 00255 DSRN 04244 D10 00516 D10X 00514
D2400 00526 D5200 00524 D7400 00530 ENTPT 00050
ENTRY 00256 ERR 00336 ERRNO 00341 ERROR 00037
ERRUSR 00170 ERR2 00335 EXIT 00307 EXIT2 00272
EXIT4 00330 FD1 00031 FD2 00102 FILE 00344
FI1 00043 FOUR 00100 FUNCT 00034 FUNCTX 00166
FUNCTY 00266 FUSR 00027 HGHLOC 00135 HKEY 02761
I 00045 KOFSET 00343 K200 00333 K5200 00157
K5201 00334 K6 00152 K7 00156 K7400 00153
K7607 00332 K7774 00174 LDSRN 00160 LFILE 00267
LHIFLD 00161 LHNDR 00165 MAXCOR 00133 MUNIT 00106
M200 00154 M400 00155 N 00050 NAME 00355
NINE 00111 NINED 00522 NOBLKS 00047 ONE 00067
ONED 00512 PERFLG 00061 PERIOD 00125 SB 00046
SB2 00267 SEVEN 00103 SKCONT 00210 SKCON2 00252
SKCON3 00273 SKIP 00166 SKIPJA 00506 SKIP2 00301
SPACE 00130 SXDSRN 00520 TEMQ 00162 TEMQ2 00163
TEMQ3 00164 TEN 00114 THREE 00075 TWO 00072
UNIT 00031 UNITX 00167 USR S 00532 USRL4 00100
USRSL5 00150 X 00064