sw/adventure/USR.RA

   1 /       SUBROUTINE USR (UNIT, NAME, FUNCT, ERROR)
   2 /       VERSION 01.18
   3
   4 /       WRITTEN BY:
   5 /         ROBERT PHELPS
   6 /         BEHAVIOR LAB
   7 /         DEPT. RAD. BIOL. & BIOPHYSICS
   8 /         UNIVERSITY OF ROCHESTER
   9 /         ROCHESTER, NY  14642
  10 /
  11 /               THIS ROUTINE ALLOWS RUN-TIME DECLARATION OF FILES
  12 /               IN D.E.C. FORTRAN IV FOR THE PDP-8.
  13 /
  14 /       DESCRIPTION OF PARAMETERS:
  15 /
  16 /               UNIT  - LOGICAL UNIT NUMBER
  17 /                       ONLY NUMBERS 5 THRU 9 ARE ALLOWED.
  18 /                       FEWER LOGICAL UNITS MAY BE ALLOWED DEPENDING
  19 /                       ON CORE AVAILABILITY -- SEE PROGRAMMING NOTE
  20 /                       BELOW.
  21 /               NAME  - DEV:FILE.EX
  22 /                       STORED IN FORMAT 3A6 OR EQUIVALENT.
  23 /                       DEVICE ASSUMED TO BE DSK: IF NOT
  24 /                       EXPLICITLY STATED.  THIS PARAMETER MAY
  25 /                       ALSO BE A HOLLERITH LITERAL.
  26 /                       NULL CHARACTERS ('@') AND SPACES
  27 /                       ARE IGNORED IN THIS FIELD.
  28 /               FUNCT - FUNCTION: 2 - OPEN FILE FOR INPUT
  29 /                                 3 - OPEN FILE FOR OUTPUT
  30 /                                 4 - CLOSE OUTPUT FILE
  31 /                       THE OUTPUT FILE NAME GIVEN FOR A <CLOSE>
  32 /                       MUST AGREE WITH THE CORRESPONDING <OPEN>
  33 /                       FILE NAME FOR THAT UNIT.  CLOSING A FILE
  34 /                       WITH 0 BLOCKS OR AN INPUT (FUNCT=2) FILE WILL
  35 /                       DELETE THAT FILENAME FROM THE DIRECTORY.
  36 /               ERROR - RETURN ERROR CONDITION
  37 /                       0 - NO ERRORS.
  38 /                       1 - ILLEGAL DEVICE
  39 /                       2 - ILLEGAL FILE NAME
  40 /                       3 - ILLEGAL UNIT NUMBER (CORE EXCEEDED!?)
  41 /                       4 - ILLEGAL FUNCTION CODE
  42 /
  43 /       USER ERRORS MAY TERMINATE EXECUTION UNLESS THE /E
  44 /       OPTION WAS SPECIFIED TO FRTS.  THE FOLLOWING USER
  45 /       ERRORS FROM <USR> ARE DEFINED:
  46 /               0002 - THE USER HAS DEFINED A NON-RESIDENT
  47 /                       DEVICE HANDLER EXTERNAL TO <USR>.
  48 /
  49 /       PROGRAMMING NOTE:  EACH UNIT IS ASSIGNED 1000(8) LOCATIONS
  50 /IN THE HIGHEST FIELD FOR BUFFER AND HANDLER (400 FOR ITS BUFFER
  51 /AND 400 FOR ITS HANDLER).  THESE LOCATIONS ARE
  52 /NOT DYNAMICALLY ALLOCATED BUT ARE USED FOR DEVICE BUFFER AND
  53 /HANDLERS ONLY IF THEY ARE NOT USED BY THE
  54 /PROGRAM.  TO USE CORE MOST EFFICIENTLY FOR LARGE
  55 /PROGRAMS, USE THE HIGHEST ORDER UNIT NUMBERS POSSIBLE.  THAT IS,
  56 /USING UNIT 5 ALLOWS 1000(8) FEWER WORDS FOR SOURCE CODE THAN IF
  57 /UNIT 6 WERE THE LOWEST UNIT NUMBER USED.
  58 /
  59 /       RESTRICTIONS:  BECAUSE <FRTS> LOADS NON-RESIDENT HANDLERS FROM
  60 /THE TOP OF CORE DOWN, AND <USR> ALSO USES THAT AREA, THE USER IS NOT
  61 /ALLOWED TO MAKE LOAD TIME
  62 /I/O UNIT DECLARATIONS TO DEVICES WITH NON-RESIDENT
  63 /HANDLERS EXTERNAL TO <USR>.  TO DO SO WLL CAUSE A FATAL
  64 /USER ERROR 2.  IT IS RECOMMENDED, AND GENERALLY
  65 /MORE CONVIENENT TO USE INTERNAL HANDLERS AND
  66 /DECLARE ALL OTHER FILES AT EXECUTION TIME
  67 /WITH CALLS TO THIS SUBROUTINE.
  68 /THE USE OF <FRTS> INTERNAL HANDLERS,
  69 /SYS:, AND DEVICES CO-RESIDENT WITH SYS: ARE LEGAL,
  70 /EVEN IF DEFINED EXTERNAL TO THIS SUBROUTINE.
  71 /
  72 /NOTE:  THIS PROGRAM REQUIRES ONE PATCH BE MADE TO
  73 /       <FRTS> BEFORE IT WILL RUN.  IT IS DESCRIBED
  74 /       BELOW:
  75 /
  76 /MAXCOR=121     /THESE ARE LOCATIONS IN THE RESIDENT PART OF
  77 /HGHLOC=123     /<FRTS> AND REQUIRE THE FOLLOWING PATCH BE PLACED
  78                 /IN FRTS SO THEY WILL BE SET PROPERLY.  THE PATCH
  79                 /DELETES CODE WHICH INITIALIZES SYSTEMS WITH AN
  80                 /ANALEX PRINTER, SO IF YOU HAVE AN ANALEX ... WATCH OUT.
  81
  82 /Note that MAXCOR and HGHLOC are 2 word variables which have been
  83 /created for this routine on page 0 of FRTS. If FRTS
  84 /is changed to use more page 0 locations, the patch
  85 /will have to be changed as well.
  86
  87 /       FIELD 1; *2475
  88 /12475  7300    CLA CLL                 /Note, CDF CIF 0 is pending
  89 /12476  1311    TAD     12511           /Load address of VAR
  90 /12477  3010    DCA     10010           /Store in auto index
  91 /       1023    TAD     10023           /Load value of MAX field
  92 /       3410    DCA I   10010           /As high order part of MAXCOR
  93 /       3410    DCA I   10010           /Zero low order part
  94 /       1025    TAD     10025           /Load highest avail. field
  95 /       3410    DCA I   10010           /Store high order word
  96 /       1026    TAD     10026           /load high address
  97 /       3410    DCA I   10010           /Store low order word of HGHLOC
  98 /       7000    NOP                     /?
  99 /       5766    JMP I   12566           /Start up FPP
 100
 101 /12511   120                    /ADDRESS-1 of MAXCOR
 102
 103         EXTERN  CGET
 104         EXTERN  CPUT
 105         DSRN=4244               /Address of DSRN table in FRTS
 106
 107         SECT    USR
 108         JA      #ST
 109
 110 /NOTE:  MUCH OF THIS CODE WAS LIFTED FROM A FORTRAN
 111 /       GENERATED ASSEMBLY LISTING.  ACCEPT THIS AS
 112 /       AN APOLOGY FOR THE LACK OF COMMENTS IN SOME SECTIONS.
 113 /
 114 #XR,    ORG     .+10
 115         TEXT    +USR  +
 116
 117 #RET,   SETX #XR
 118         SETB #BASE
 119         JA .+3
 120 #BASE,  ORG     .+6     /BASE 0 AND 1
 121 UNIT,   ORG     .+3     /BASE 2
 122 FUNCT,  ORG     .+3     /BASE 3
 123 ERROR,  ORG     .+3     /BASE 4
 124 #DSK,   TEXT +DSK@@@+   /DEFAULT DEVICE NAME
 125 I,      F 0.0           /BASE 6
 126 N,      F 0.0           /BASE 7
 127         ORG     #BASE+30
 128         FNOP
 129         JA #RET
 130         FNOP
 131 #GOBAK, 0;0
 132
 133 PERFLG, F 0.0           /PERIOD FLAG
 134 X,
 135 #TMP,   ORG     .+3
 136 ONE,    F 1.0
 137 TWO,    F 2.0
 138 THREE,  F 3.0
 139 FOUR,   F 4.0
 140 SEVEN,  F 7.0
 141 MUNIT,  0027;0;0        /Low unit: Set according to CORE avail.
 142 NINE,   F 9.0
 143 TEN,    F 10.0
 144 ATEEN,  F 18.0
 145 COLON,  F 58.0
 146 PERIOD, F 46.0
 147 SPACE,  F 32.0
 148 MAXCOR, 0; 7; 0         /RHM: Don't require the FRTS patch.
 149 HGHLOC, 0; 7; 2000      /RHM: Hope memory used doesn't get larger.
 150 / ADVENT in the current implementation uses up thru 71000 at worst.
 151 / This hopefully allows room for extra 2-page handlers and the TD8E ROM.
 152 #RTN,   BASE    #BASE
 153         JA      #GOBAK
 154 #ST,    STARTD
 155         0210
 156         FSTA    #GOBAK,0
 157         0200
 158         SETX    #XR
 159         SETB    #BASE
 160         LDX     0,1
 161         FSTA    #BASE
 162         FLDA%   #BASE,1+
 163         FSTA    UNIT
 164         FLDA%   #BASE,1+
 165         FSTA    NAME
 166         FLDA%   #BASE,1+
 167         FSTA    FUNCT
 168         FLDA%   #BASE,1+
 169         FSTA    ERROR
 170
 171 /       INITIALIZE PROGRAM
 172
 173 SKIP,                   /JA SKIP2 AFTER FIRST ENTRY
 174
 175 /               FIND OUT HOW MANY UNITS TO ALLOW
 176
 177 /Note that the original scheme was rather bizzare, and for
 178 /humerous purposes, I have left it here, commented out.
 179 /This worked OK with the old FPP interpreter, since it zeroed
 180 /the exponent with a STARTF. The FPP does not, and the
 181 /EXPONENT is left indeterminate. This meant that sometimes
 182 /you could use past 72400, and sometimes you couldn't.
 183 /(Note, that S.B.'s version of FRTS has been changed
 184 /so that the FPP interpreter works the same as the FPP.)
 185
 186 /       FLDA MAXCOR     /Load highest field number
 187 /       FSUB HGHLOC     /Subtract high location
 188 /       FADD D2400      /1 FIELD LESS 5400 LOCS FOR 5 DEVICES
 189                         /  NOTE:  PG. 7600 RESERVED FOR OS/8
 190                         /         PG. 7400 USED FOR OS/8 USR CALL
 191 /       JGE SKCONT      /ROOM FOR 5 DEVICES?
 192 /       FADD D15000     /Note, FAC= how many locations short
 193 /       FMUL D1000      /HOW MANY 1000 WORD BLOCKS ARE THERE?
 194 /       STARTF
 195 /       FNORM
 196 /       FMUL E30        /ALTHOUGH WE WERE WORKING WITH AN
 197 /                       /INTEGER ABOVE, THE FPP THOUGHT IT
 198 /                       /HAD A BINARY POINT TO THE RT. OF THE
 199 /                       /SIGN BIT.  THIS INSTRUCTION EFFECTIVELY
 200 /                       /CHANGES THE NUMBER TO A REAL FPP INTEGER.
 201 /       FSTA MUNIT      /MINIMUM UNIT # ALLOWED
 202 /D15000,        1;5000
 203 /D1000, 4;0     /0.001
 204 /E30,   30;2000;0       /1.E30(2)
 205
 206 /The routine should really be modified to check which handlers
 207 /are already loaded. This wouldn't be all that difficult,
 208 /since the field 1 tables of handler residency are saved on
 209 /SYS block 37, and restored each time USR is called. As long
 210 /as a reset isn't performed, it should be easy to determine
 211 /if a handler is already loaded. Then HGHLOC could be changed
 212 /dynamically, as handlers were loaded. The core usage would then
 213 /also be independent of the unit number used.
 214
 215         FLDA    MAXCOR  /Load Max field #
 216         FADD    D7400   /Offset to highest useable address
 217         FSUB    HGHLOC  /Compute locations available
 218         LDX     11,1    /Load shift argument
 219         ALN     1       /Divide by 1000
 220         FSTA    MUNIT+1,0 /Store number of units
 221         STARTF
 222         FLDA    TEN     /Load MAX units+1
 223         FSUB    MUNIT   /Subtract number of units
 224         FSTA    MUNIT   /Store new minimum unit
 225         FSUB    THREE   /Limit min. to three
 226         JGE     SKCONT  /Ok if greater than 2
 227         FLDA    THREE   /Just in case we need to avoid
 228         FSTA    MUNIT   /field boundary problems
 229
 230 SKCONT, STARTD
 231         SETX MAXCOR+1
 232         XTA 0           /GET HIGHEST FIELD
 233         FDIV D10X       /PUT IT INTO BITS 6-8 OF LO ORDER WORD
 234         SETX LHIFLD
 235         ATX 0           /LOAD HIGHEST FIELD INTO LHIFLD
 236         FADD DCDF       /MAKE IT CDF HIFLD
 237         SETX FD1
 238         ATX 0           /SET LOCATIONS USING IT
 239         SETX FD2
 240         ATX 0
 241         FADD ONED       /MAKE IT CIF HIFLD
 242         SETX FI1
 243         ATX 0
 244         SETX #XR
 245
 246 /       CHECK TO MAKE SURE USER DID NOT DECLARE
 247 /       DEVICE WITH HANDLER EXTERNAL TO THESE ROUTINES.
 248
 249         FLDA SKIPJA     /SET INSTRUCTION SO THIS CODE
 250         FSTA SKIP,0     /  EXECUTES ONLY ONCE.
 251 /
 252         FLDA SXDSRN     /INITIALIZE SETX INSTRUCTION
 253         FSTA SKCON2
 254         LDX -11,6       /SET COUNTER (MAX # DSRN ENTRIES)
 255 SKCON2, SETX DSRN       /STUFFED AND MODIFIED
 256         XTA 0           /GET NEXT HANDLER ENTRY POINT
 257         SETX #XR
 258         FSUB D5200
 259         JLT SKCON3      /INTERNAL HANDLER, IT'S OK
 260         FSUB D2400
 261         JGT SKCON3      /RESIDENT HANDLER (E.G. SYS:), IT'S OK TOO
 262         LDX 2,0         /***SOME OTHER HANDLER***USER ERROR 2
 263 EXTERN #UE
 264         TRAP3 #UE       /USER ILLEGALLY DECLARED A FILE!
 265 /
 266 SKCON3, FLDA  NINED     /INCREMENT TO NEXT DSRN ENTRY
 267         FADDM SKCON2
 268         JXN SKCON2,6+
 269 /
 270 SKIP2,  STARTF          /***END OF INITILIZATIN CODE***
 271         LDX 1,7
 272         FCLA            /INITIALIZE SOME VARIABLES...
 273         FSTA PERFLG     /NO PERIODS YET
 274         FSTA    FILE-0003,7
 275         FSTA    FILE-0003,7+
 276         FLDA #DSK       /SETUP DEFAULT DEVICE
 277         FSTA DEV
 278         FLDA    ONE     /FIRST CHARACTER IS # 1
 279         FSTA    N
 280         FLDA%   UNIT    /CHECK FOR LEGAL UNIT #
 281         FSUB    MUNIT
 282         JSA     #LT     /  IF (UNIT.LT.MUNIT.OR.UNIT.GT.9) GO TO 900
 283         FSTA    #TMP+00
 284         FLDA%   UNIT
 285         FSUB    NINE
 286         JSA     #GT
 287         FADD    #TMP+00
 288         JNE     #900
 289         FLDA%   FUNCT   /CHECK FOR LEGAL FUNCTION CODE
 290         FSUB    TWO
 291         EXTERN  #LT
 292         JSA     #LT     /  IF (FUNCT.LT.2.OR.FUNCT.GT.4) GO TO 901
 293         FSTA    #TMP+00
 294         FLDA%   FUNCT
 295         FSUB    FOUR
 296         EXTERN  #GT
 297         JSA     #GT
 298         FADD    #TMP+00
 299         JNE     #901
 300 /
 301 /       PUT DEV:FILE.EXT INTO CORRECT FORMAT FOR USR CALL
 302 /
 303         FLDA    ONE
 304         FSTA    I       /  DO 100 I=1,18
 305
 306 #G0002, JSR     CGET    /  CALL CGET (NAME, I, X)
 307         JA      .+10
 308 NAME,   JA      .
 309         JA      I
 310         JA      X
 311         FLDA    X       /  IF (X.NE.COLON) GO TO 40
 312         FSUB    COLON
 313         JNE     #40
 314         FLDA I          /COLON MUST BE COLUMN 6 OR BEFORE
 315         FSUB SEVEN      /7
 316         JGE #DONE
 317         FLDA FILE       /COLON DEFINES DEVICE NAME
 318         FSTA    DEV
 319         FCLA
 320         FSTA    FILE
 321         FLDA    ONE
 322         FSTA    N
 323         JA      #100
 324
 325 #40,    FLDA    X       /  IF (X.NE.PERIOD) GO TO 60
 326         FSUB    PERIOD
 327         JNE     #60
 328         FLDA PERFLG     /ONLY ONE PERIOD ALLOWED
 329         JNE #DONE
 330         FLDA    SEVEN   /SET TO DECODE EXTENSION
 331         FSTA PERFLG
 332         FSTA    N
 333         JA      #100
 334
 335 #60,    FLDA X
 336         JEQ #100        /SKIP OVER NULL'S
 337         FSUB SPACE
 338         JEQ #100        /SKIP OVER SPACES
 339         JSR     CPUT    /  CALL CPUT (FILE, N, X)
 340         JA      .+10
 341         JA      FILE
 342         JA      N
 343         JA      X
 344         FLDA    N       /  N=N+1
 345         FADD    ONE
 346         FSTA    N
 347
 348 #100,   FLDA    I       /  100 CONTINUE
 349         FADD    ONE
 350         FSTA    I
 351         FSUB    ATEEN
 352         JLE     #G0002
 353
 354 #DONE,  FLDA% FUNCT
 355         FSUB FOUR
 356         JNE #101        /FUNCTION = CLOSE ?
 357         EXTERN #ENDF
 358         FLDA% UNIT      /YES - END FILE
 359         TRAP3 #ENDF
 360
 361 #101,   SETX FUNCTX     /USR XR TO PASS PARAMETERS
 362         FLDA% FUNCT
 363         ATX 0
 364         FLDA% UNIT
 365         ATX 1
 366
 367         TRAP4   #USRSE  /TRAP TO THE USR CALLING ROUTINE
 368
 369         XTA 2           /GET ERRNO AND RETURN IT
 370         FSTA% ERROR
 371         JA      #RTN
 372 #900,   FLDA    THREE   /ILLEGAL UNIT NUMBER!!!
 373         FSTA%   ERROR
 374         JA #RTN
 375
 376 #901,   FLDA FOUR       /ILLEGAL FUNCTION CODE!!!
 377         FSTA%   ERROR
 378         JA      #RTN
 379 /
 380 SKIPJA, JA SKIP2
 381 DCDF,   0;CDF
 382 ONED,   0;1
 383 D10X,   400;0   /0.1
 384 D10,    0;10
 385 SXDSRN, SETX DSRN
 386 NINED,  0;11
 387 D5200,  0;5200
 388 D2400,  0;2400
 389 D7400,  0;7400
 390
 391 SECT8 #USRSE; 0
 392 /
 393 /THIS ROUTINE SETS UP, ON PAGE 7400 OF THE HIGHEST FIELD, A
 394 /ROUTINE WHICH CALLS THE OS/8 USR (USER SERVICE ROUTINE).
 395 /IT IS NECESSARY TO DO THIS BECAUSE THE FORTRAN IV LOADER
 396 /MAY LOAD ANY ROUTINE IN THE RESERVED AREA FOR
 397 /THE OS/8 USR (10000 - 11777).
 398 /
 399 /       THIS PROGRAM ALSO REQUIRES
 400 /       THAT 'HKEY' BE THE LOCATION IN <FRTS> AS DEFINED
 401 /       BELOW:
 402
 403 HKEY=2761
 404 DSRN=4244               /Address of DSRN table in FRTS
 405
 406 /
 407 /IN CASE CLOSE FUNCTION, GET # BLOCKS WRITTEN
 408 /
 409         TAD UNITX
 410         CLL RTL         /MULTIPLY BY 9
 411         RAL
 412         TAD UNITX
 413         TAD K6          /OFFSET TO CURRENT BLOCK
 414         TAD LDSRN       /START OF DSRN TABLE - 11
 415         DCA TEMQ
 416         CDF 0
 417         TAD% TEMQ
 418         DCA SB
 419 /
 420 /MOVE USR CALLING ROUTINE TO DEFINED LOCATION
 421 /       I.E. PROTECT LOCS 10000-11777
 422 /
 423         TAD K7400       /Target address
 424         DCA TEMQ        /Store for indirect reference
 425         TAD #LUSR+1     /Origin address
 426         DCA TEMQ2       /Store for indirect reference
 427         TAD M200        /Number of words to move
 428         DCA TEMQ3       /Store in a counter
 429         TAD #LUSR       /Load field word
 430         AND K7          /Strip it
 431         CLL RTL         /Into right bits
 432         RAL
 433         TAD #CDF
 434         DCA .+1         /Store the CDF
 435 FUSR,   HLT             /Set field where USR loads
 436         TAD% TEMQ2      /Load routine location
 437 FD1,    CDF 00          /Set HIGH field
 438         DCA% TEMQ       /Store location in high field
 439         ISZ TEMQ        /Bump the pointers
 440         ISZ TEMQ2
 441         ISZ TEMQ3       /And the counters
 442         JMP FUSR        /Loop on it
 443
 444 /SET FIELDS AND CALL IT
 445
 446         RIF             /GET CURRENT FIELD
 447         TAD #CDF
 448         DCA .+1
 449         HLT             /Set this field
 450 FI1,    CIF 00          /Set high field
 451         TAD FUNCTX      /Load function number
 452         JMS% K7400      /Call routine
 453 SB,       0             /START BLOCK OF FILE OR LENGTH IF CLOSE
 454 NOBLKS,   0             /LENGTH OF FILE
 455 ENTPT,    0             /HANDLER ENTRY POINT
 456         DCA ERRUSR      /SAVE ERROR RETURN VALUE
 457
 458 /SETUP TO MOVE DSRN TABLE APPROPRIATELY
 459
 460         TAD UNITX
 461         CLL RTL         /MULTIPLY BY 9
 462         RAL
 463         TAD UNITX
 464         TAD LDSRN
 465         DCA TEMQ
 466 #CDF,   CDF 0
 467         DCA% TEMQ       /DISABLE FILE IN CASE CLOSE FUNCTION
 468         CLA CLL CMA RTL /-3 => AC
 469         TAD FUNCTX
 470         SMA SZA CLA     /CLOSE?
 471         JMP USRSL5      /YES
 472
 473 /MOVE HANDLER TO APROPRIATE BUFFER
 474
 475         CLA CMA CLL RAL /-2 => AC
 476         TAD UNITX
 477         CLL RTR
 478         RTR             /UNIT 9 => AC=7000; UNIT 8 => AC=6000
 479         TAD M400
 480         DCA LHNDR       /LOCATION FOR THIS UNIT'S HANDLER
 481         TAD K5200
 482         DCA TEMQ2
 483         TAD M400
 484         DCA TEMQ3
 485 USRL4,  CDF 0
 486         TAD% TEMQ2
 487 FD2,    CDF 00
 488         DCA% LHNDR
 489         ISZ TEMQ2
 490         ISZ LHNDR
 491         ISZ TEMQ3
 492         JMP USRL4
 493
 494 /BUILD UP NEW DSRN TABLE FOR THIS UNIT
 495
 496         CDF 0
 497         TAD ENTPT
 498         DCA% TEMQ       /ENTRY POINT
 499         ISZ TEMQ
 500         CLL CML RTL     /2 => AC (FORMS CONTROL BIT)
 501         TAD LHNDR
 502         TAD M400
 503         TAD LHIFLD
 504         DCA% TEMQ       /HANDLER CODE WORD
 505         TAD K7774       /*K* KLUDGE TO LET FRTS KNOW WHICH
 506         AND% TEMQ       /    HANDLER IS IN CORE
 507         DCA% #HKEY
 508         ISZ TEMQ
 509         TAD LHNDR
 510         TAD LHIFLD
 511         DCA% TEMQ       /BUFFER ADDRESS & FIELD
 512         ISZ TEMQ
 513         TAD LHNDR
 514         DCA% TEMQ       /CHARACTER POINTER
 515         ISZ TEMQ
 516         CMA CLL RTL     /-3 => AC
 517         DCA% TEMQ       /CHARACTER COUNTER
 518         ISZ TEMQ
 519         TAD SB
 520         DCA% TEMQ       /START BLOCK
 521         ISZ TEMQ
 522         DCA% TEMQ       /RELATIVE BLOCK
 523         ISZ TEMQ
 524         TAD NOBLKS
 525         DCA% TEMQ       /LENGTH OF FILE
 526         ISZ TEMQ
 527         DCA% TEMQ       /STATUS WORD
 528
 529 USRSL5, CDF CIF 0
 530         JMP% #USRSE
 531
 532
 533 K6,     6
 534 K7400,  7400
 535 M200,   -200
 536 M400,   -400
 537 K7,     7
 538 K5200,  5200
 539
 540 LDSRN,  DSRN-11         /START LOCATION OF DSRN TABLE
 541
 542 LHIFLD, 0
 543 TEMQ,   0
 544 TEMQ2,  0
 545 TEMQ3,  0
 546 LHNDR,  0
 547 FUNCTX, 0               /STUFFED BY RALF CODE
 548 UNITX,  0               /STUFFED BY RALF CODE
 549 ERRUSR, 0               /READ BY RALF CODE
 550
 551 #LUSR,  ADDR #USR
 552 #HKEY,  HKEY            /LOCATION OF HKEY IN FRTS
 553                         /  MUST AGREE WITH VERSION!!
 554 K7774,  7774
 555 /
 556         ORG .+177&7600
 557 /USR CALLING SUBROUTINE FOR FORTRAN
 558 /
 559 /       THIS ROUTINE IS MOVED TO PAGE 7400 OF THE HIGHEST
 560 /       FIELD BEFORE EXECUTING TO AVOID BEING OVERWRITTEN BY THE USR
 561 /       ROUTINE.  NO FILE SPECIFICATIONS OTHER THAN INTERNAL
 562 /       HANDLERS AND SYSTEM DEVICES MAY BE MADE EXTERNAL TO THESE
 563 /       ROUTINES BECAUSE THE USE OF THIS ROUTINE WILL OVERWRITE
 564 /       THE HANDLERS WHICH ARE STORED IN HIGH CORE.
 565 /
 566 /
 567 #USR, 0
 568 /
 569 /       ENTER WITH FUNCTION CODE IN THE AC
 570 /               2 - LOOKUP (OPEN FOR INPUT)
 571 /               3 - ENTER  (OPEN FOR OUTPUT)
 572 /               4 - CLOSE  (CLOSE OUTPUT FILE)
 573 /
 574 /       DEVICE AND FILE NAMES ARE STUFFED BY THE CALLING
 575 /       PROGRAM BEFORE THIS SUBROUTINE IS CALLED.
 576 /
 577 /       CALLING SEQUENCE:
 578 /               JMS #USR
 579 /                 START BLOCK OF FILE (RETURNED FOR CODE 2 & 3)
 580 /                       # BLOCKS SUPPLIED IF CODE 4
 581 /                 NUMBER OF BLOCKS IN FILE (RETURNED FOR CODE 2 & 3)
 582 /                 ENTRY POINT OF HANDLER AS READ INTO PAGE 5200
 583 /               <RETURN>
 584 /
 585 /       AC ON EXIT CONTAINS ERROR CONDITION:
 586 /               0 - NO ERROR
 587 /               1 - ILLEGAL DEVICE
 588 /               2 - ILLEGAL FILE NAME
 589 /
 590         DCA FUNCTY      /SAVE FUNCTION CODE
 591         TAD% #USR       /GET # BLOCKS IN CASE CLOSE FUNCTION
 592         DCA #BLKS
 593
 594         RDF             /SET INSTRUCTION FIELD FOR RETURN
 595         TAD #CIF
 596         DCA EXIT4
 597         CMA             /MAKE IT CDF
 598         TAD EXIT4
 599         DCA EXIT
 600         DCA ERRNO       /INITIALIZE ERROR RETURN VARIABLE
 601         CMA
 602         TAD #CIF        /-1 IN AC MAKES IT CDF
 603         RIF
 604         DCA .+1
 605         HLT             /SET DATA FIELD TO CURRENT FIELD
 606
 607 /       ********SWAP CORE FOR USR CALL
 608
 609 /Note, that it would be much simpler to read in the field
 610 /one tables, and call USR at 17700. Let USR do the swapping.
 611 /We must only set the correct bits in the JSW.
 612
 613         IOF
 614 #CIF,   CIF 0
 615         JMS% K7607      /CALL SYSTEM HANDLER
 616           5210          /  WRITE 17400-17777,10000-11777
 617           7400
 618             27
 619         HLT             /DEVICE ERROR
 620
 621         CIF 0
 622         JMS% K7607      /READ IN USR
 623            610
 624              0
 625             13          /From block 13
 626         HLT
 627
 628         CIF 0
 629         JMS% K7607      /READ IN FIELD ONE TABLES
 630            210
 631           7400
 632             37          /From block 37 (where FRTS put it)
 633         HLT
 634
 635 /       ********PERFORM USR FUNCTIONS
 636
 637         CIF 10
 638         JMS% K200       /RESET tables, so it looks like no handlers
 639             13
 640              0
 641
 642         TAD K5201       /SET PAGE FOR HANDLER (allow 2 page handler)
 643         DCA ENTRY
 644         CIF 10
 645         JMS% K200       /FETCH
 646              1
 647 DEV,         0          /(STUFFED BY RALF ROUTINE)
 648 DEVNO,       0
 649 ENTRY,    5201
 650         JMP ERR         /ILLEGAL DEVICE
 651
 652         TAD #LFILE      /SET POINTER TO FILE
 653         TAD KOFSET
 654         DCA LFILE
 655         TAD DEVNO       /GET DEVICE NUMBER
 656         CIF 10
 657         JMS% K200       /PERFORM FUNCTION
 658 FUNCTY,      0
 659 SB2,
 660 LFILE,       0
 661 #BLKS,       0
 662         JMP ERR2        /FILE ERROR
 663
 664 /       ********RESTORE CORE
 665
 666 EXIT2,  CIF 0
 667         JMS% K7607      /SAVE FIELD ONE TABLES
 668           4210          /? Is this really necessary?
 669           7400          /Since they've already been saved?
 670             37          /by FRTS
 671         HLT
 672
 673         CIF 0           /USROUT function would do this
 674         JMS% K7607      /Read in the Stuff we saved
 675           1210
 676           7400
 677             27
 678         HLT
 679
 680         ION             /Is this necessary?
 681 EXIT,   HLT
 682         TAD SB2         /RETURN SB & #BLKS
 683         DCA% #USR
 684         ISZ #USR
 685         TAD SB2
 686         SZA CLA         /NON-FILE STRUCTURED DEVICE?
 687         JMP .+3
 688         CMA             /YES - SET MAX NUMBER OF BLOCKS
 689         JMP .+3
 690         TAD #BLKS
 691         CIA
 692         DCA% #USR
 693         ISZ #USR
 694         TAD ENTRY
 695         DCA% #USR
 696         ISZ #USR
 697         TAD ERRNO
 698 EXIT4,  HLT
 699         JMP% #USR
 700
 701
 702 K7607,  7607            /SYSTEM HANDLER ENTRY POINT
 703 K200,   200             /USR ENTRY POINT
 704 K5201,  5201            /PAGE FOR HANDLER (& TWO PAGES AVAILABLE)
 705
 706 ERR2,   CLA IAC         /ILLEGAL FILE NAME
 707 ERR,    IAC             /ILLEGAL DEVICE NAME
 708         DCA ERRNO
 709         JMP EXIT2
 710 ERRNO,  0
 711
 712 #LFILE, AND FILE        /LOCATION OF FILE ON PAGE 7400
 713                         /'AND' NEEDED TO TRICK ABSOLUTE REFERENCE
 714                         /CHECK IN RALF.
 715 KOFSET, 7200            /OFFSET TO REAL EXECUTION ADDRESS
 716 FILE,   0;0;0;0;0;0;0;0;0
 717