+++ /dev/null
-/ SUBROUTINE USR (UNIT, NAME, FUNCT, ERROR)\r
-/ VERSION 01.18\r
-\r
-/ WRITTEN BY:\r
-/ ROBERT PHELPS\r
-/ BEHAVIOR LAB\r
-/ DEPT. RAD. BIOL. & BIOPHYSICS\r
-/ UNIVERSITY OF ROCHESTER\r
-/ ROCHESTER, NY 14642\r
-/\r
-/ THIS ROUTINE ALLOWS RUN-TIME DECLARATION OF FILES\r
-/ IN D.E.C. FORTRAN IV FOR THE PDP-8.\r
-/\r
-/ DESCRIPTION OF PARAMETERS:\r
-/\r
-/ UNIT - LOGICAL UNIT NUMBER\r
-/ ONLY NUMBERS 5 THRU 9 ARE ALLOWED.\r
-/ FEWER LOGICAL UNITS MAY BE ALLOWED DEPENDING\r
-/ ON CORE AVAILABILITY -- SEE PROGRAMMING NOTE\r
-/ BELOW.\r
-/ NAME - DEV:FILE.EX\r
-/ STORED IN FORMAT 3A6 OR EQUIVALENT.\r
-/ DEVICE ASSUMED TO BE DSK: IF NOT\r
-/ EXPLICITLY STATED. THIS PARAMETER MAY\r
-/ ALSO BE A HOLLERITH LITERAL.\r
-/ NULL CHARACTERS ('@') AND SPACES\r
-/ ARE IGNORED IN THIS FIELD.\r
-/ FUNCT - FUNCTION: 2 - OPEN FILE FOR INPUT\r
-/ 3 - OPEN FILE FOR OUTPUT\r
-/ 4 - CLOSE OUTPUT FILE\r
-/ THE OUTPUT FILE NAME GIVEN FOR A <CLOSE>\r
-/ MUST AGREE WITH THE CORRESPONDING <OPEN>\r
-/ FILE NAME FOR THAT UNIT. CLOSING A FILE\r
-/ WITH 0 BLOCKS OR AN INPUT (FUNCT=2) FILE WILL\r
-/ DELETE THAT FILENAME FROM THE DIRECTORY.\r
-/ ERROR - RETURN ERROR CONDITION\r
-/ 0 - NO ERRORS.\r
-/ 1 - ILLEGAL DEVICE\r
-/ 2 - ILLEGAL FILE NAME\r
-/ 3 - ILLEGAL UNIT NUMBER (CORE EXCEEDED!?)\r
-/ 4 - ILLEGAL FUNCTION CODE\r
-/\r
-/ USER ERRORS MAY TERMINATE EXECUTION UNLESS THE /E\r
-/ OPTION WAS SPECIFIED TO FRTS. THE FOLLOWING USER\r
-/ ERRORS FROM <USR> ARE DEFINED:\r
-/ 0002 - THE USER HAS DEFINED A NON-RESIDENT\r
-/ DEVICE HANDLER EXTERNAL TO <USR>.\r
-/\r
-/ PROGRAMMING NOTE: EACH UNIT IS ASSIGNED 1000(8) LOCATIONS\r
-/IN THE HIGHEST FIELD FOR BUFFER AND HANDLER (400 FOR ITS BUFFER\r
-/AND 400 FOR ITS HANDLER). THESE LOCATIONS ARE\r
-/NOT DYNAMICALLY ALLOCATED BUT ARE USED FOR DEVICE BUFFER AND\r
-/HANDLERS ONLY IF THEY ARE NOT USED BY THE\r
-/PROGRAM. TO USE CORE MOST EFFICIENTLY FOR LARGE\r
-/PROGRAMS, USE THE HIGHEST ORDER UNIT NUMBERS POSSIBLE. THAT IS,\r
-/USING UNIT 5 ALLOWS 1000(8) FEWER WORDS FOR SOURCE CODE THAN IF\r
-/UNIT 6 WERE THE LOWEST UNIT NUMBER USED.\r
-/\r
-/ RESTRICTIONS: BECAUSE <FRTS> LOADS NON-RESIDENT HANDLERS FROM\r
-/THE TOP OF CORE DOWN, AND <USR> ALSO USES THAT AREA, THE USER IS NOT\r
-/ALLOWED TO MAKE LOAD TIME\r
-/I/O UNIT DECLARATIONS TO DEVICES WITH NON-RESIDENT\r
-/HANDLERS EXTERNAL TO <USR>. TO DO SO WLL CAUSE A FATAL\r
-/USER ERROR 2. IT IS RECOMMENDED, AND GENERALLY\r
-/MORE CONVIENENT TO USE INTERNAL HANDLERS AND\r
-/DECLARE ALL OTHER FILES AT EXECUTION TIME\r
-/WITH CALLS TO THIS SUBROUTINE.\r
-/THE USE OF <FRTS> INTERNAL HANDLERS,\r
-/SYS:, AND DEVICES CO-RESIDENT WITH SYS: ARE LEGAL,\r
-/EVEN IF DEFINED EXTERNAL TO THIS SUBROUTINE.\r
-/\r
-/NOTE: THIS PROGRAM REQUIRES ONE PATCH BE MADE TO\r
-/ <FRTS> BEFORE IT WILL RUN. IT IS DESCRIBED\r
-/ BELOW:\r
-/\r
-/MAXCOR=121 /THESE ARE LOCATIONS IN THE RESIDENT PART OF\r
-/HGHLOC=123 /<FRTS> AND REQUIRE THE FOLLOWING PATCH BE PLACED\r
- /IN FRTS SO THEY WILL BE SET PROPERLY. THE PATCH\r
- /DELETES CODE WHICH INITIALIZES SYSTEMS WITH AN\r
- /ANALEX PRINTER, SO IF YOU HAVE AN ANALEX ... WATCH OUT.\r
-\r
-/Note that MAXCOR and HGHLOC are 2 word variables which have been\r
-/created for this routine on page 0 of FRTS. If FRTS\r
-/is changed to use more page 0 locations, the patch\r
-/will have to be changed as well. \r
-\r
-/ FIELD 1; *2475\r
-/12475 7300 CLA CLL /Note, CDF CIF 0 is pending\r
-/12476 1311 TAD 12511 /Load address of VAR\r
-/12477 3010 DCA 10010 /Store in auto index\r
-/ 1023 TAD 10023 /Load value of MAX field\r
-/ 3410 DCA I 10010 /As high order part of MAXCOR\r
-/ 3410 DCA I 10010 /Zero low order part\r
-/ 1025 TAD 10025 /Load highest avail. field\r
-/ 3410 DCA I 10010 /Store high order word\r
-/ 1026 TAD 10026 /load high address\r
-/ 3410 DCA I 10010 /Store low order word of HGHLOC\r
-/ 7000 NOP /?\r
-/ 5766 JMP I 12566 /Start up FPP\r
-\r
-/12511 120 /ADDRESS-1 of MAXCOR\r
-\r
- EXTERN CGET\r
- EXTERN CPUT\r
- DSRN=4244 /Address of DSRN table in FRTS\r
-\r
- SECT USR\r
- JA #ST\r
-\r
-/NOTE: MUCH OF THIS CODE WAS LIFTED FROM A FORTRAN\r
-/ GENERATED ASSEMBLY LISTING. ACCEPT THIS AS\r
-/ AN APOLOGY FOR THE LACK OF COMMENTS IN SOME SECTIONS.\r
-/\r
-#XR, ORG .+10\r
- TEXT +USR +\r
-\r
-#RET, SETX #XR\r
- SETB #BASE\r
- JA .+3\r
-#BASE, ORG .+6 /BASE 0 AND 1\r
-UNIT, ORG .+3 /BASE 2\r
-FUNCT, ORG .+3 /BASE 3\r
-ERROR, ORG .+3 /BASE 4\r
-#DSK, TEXT +DSK@@@+ /DEFAULT DEVICE NAME\r
-I, F 0.0 /BASE 6\r
-N, F 0.0 /BASE 7\r
- ORG #BASE+30\r
- FNOP\r
- JA #RET\r
- FNOP\r
-#GOBAK, 0;0\r
-\r
-PERFLG, F 0.0 /PERIOD FLAG\r
-X,\r
-#TMP, ORG .+3\r
-ONE, F 1.0\r
-TWO, F 2.0\r
-THREE, F 3.0\r
-FOUR, F 4.0\r
-SEVEN, F 7.0\r
-MUNIT, 0027;0;0 /Low unit: Set according to CORE avail.\r
-NINE, F 9.0\r
-TEN, F 10.0\r
-ATEEN, F 18.0\r
-COLON, F 58.0\r
-PERIOD, F 46.0\r
-SPACE, F 32.0\r
-MAXCOR, 0; 7; 0 /RHM: Don't require the FRTS patch.\r
-HGHLOC, 0; 7; 2000 /RHM: Hope memory used doesn't get larger.\r
-/ ADVENT in the current implementation uses up thru 71000 at worst.\r
-/ This hopefully allows room for extra 2-page handlers and the TD8E ROM.\r
-#RTN, BASE #BASE\r
- JA #GOBAK\r
-#ST, STARTD\r
- 0210\r
- FSTA #GOBAK,0\r
- 0200\r
- SETX #XR\r
- SETB #BASE\r
- LDX 0,1\r
- FSTA #BASE\r
- FLDA% #BASE,1+\r
- FSTA UNIT\r
- FLDA% #BASE,1+\r
- FSTA NAME\r
- FLDA% #BASE,1+\r
- FSTA FUNCT\r
- FLDA% #BASE,1+\r
- FSTA ERROR\r
-\r
-/ INITIALIZE PROGRAM\r
-\r
-SKIP, /JA SKIP2 AFTER FIRST ENTRY\r
-\r
-/ FIND OUT HOW MANY UNITS TO ALLOW\r
-\r
-/Note that the original scheme was rather bizzare, and for\r
-/humerous purposes, I have left it here, commented out.\r
-/This worked OK with the old FPP interpreter, since it zeroed\r
-/the exponent with a STARTF. The FPP does not, and the\r
-/EXPONENT is left indeterminate. This meant that sometimes\r
-/you could use past 72400, and sometimes you couldn't.\r
-/(Note, that S.B.'s version of FRTS has been changed\r
-/so that the FPP interpreter works the same as the FPP.)\r
-\r
-/ FLDA MAXCOR /Load highest field number\r
-/ FSUB HGHLOC /Subtract high location\r
-/ FADD D2400 /1 FIELD LESS 5400 LOCS FOR 5 DEVICES\r
- / NOTE: PG. 7600 RESERVED FOR OS/8\r
- / PG. 7400 USED FOR OS/8 USR CALL\r
-/ JGE SKCONT /ROOM FOR 5 DEVICES?\r
-/ FADD D15000 /Note, FAC= how many locations short\r
-/ FMUL D1000 /HOW MANY 1000 WORD BLOCKS ARE THERE?\r
-/ STARTF\r
-/ FNORM\r
-/ FMUL E30 /ALTHOUGH WE WERE WORKING WITH AN\r
-/ /INTEGER ABOVE, THE FPP THOUGHT IT\r
-/ /HAD A BINARY POINT TO THE RT. OF THE\r
-/ /SIGN BIT. THIS INSTRUCTION EFFECTIVELY\r
-/ /CHANGES THE NUMBER TO A REAL FPP INTEGER.\r
-/ FSTA MUNIT /MINIMUM UNIT # ALLOWED\r
-/D15000, 1;5000\r
-/D1000, 4;0 /0.001\r
-/E30, 30;2000;0 /1.E30(2)\r
-\r
-/The routine should really be modified to check which handlers\r
-/are already loaded. This wouldn't be all that difficult,\r
-/since the field 1 tables of handler residency are saved on\r
-/SYS block 37, and restored each time USR is called. As long\r
-/as a reset isn't performed, it should be easy to determine\r
-/if a handler is already loaded. Then HGHLOC could be changed\r
-/dynamically, as handlers were loaded. The core usage would then\r
-/also be independent of the unit number used.\r
-\r
- FLDA MAXCOR /Load Max field #\r
- FADD D7400 /Offset to highest useable address\r
- FSUB HGHLOC /Compute locations available\r
- LDX 11,1 /Load shift argument\r
- ALN 1 /Divide by 1000\r
- FSTA MUNIT+1,0 /Store number of units\r
- STARTF\r
- FLDA TEN /Load MAX units+1\r
- FSUB MUNIT /Subtract number of units\r
- FSTA MUNIT /Store new minimum unit\r
- FSUB THREE /Limit min. to three\r
- JGE SKCONT /Ok if greater than 2\r
- FLDA THREE /Just in case we need to avoid\r
- FSTA MUNIT /field boundary problems\r
-\r
-SKCONT, STARTD\r
- SETX MAXCOR+1\r
- XTA 0 /GET HIGHEST FIELD\r
- FDIV D10X /PUT IT INTO BITS 6-8 OF LO ORDER WORD\r
- SETX LHIFLD\r
- ATX 0 /LOAD HIGHEST FIELD INTO LHIFLD\r
- FADD DCDF /MAKE IT CDF HIFLD\r
- SETX FD1\r
- ATX 0 /SET LOCATIONS USING IT\r
- SETX FD2\r
- ATX 0\r
- FADD ONED /MAKE IT CIF HIFLD\r
- SETX FI1\r
- ATX 0\r
- SETX #XR\r
-\r
-/ CHECK TO MAKE SURE USER DID NOT DECLARE\r
-/ DEVICE WITH HANDLER EXTERNAL TO THESE ROUTINES.\r
-\r
- FLDA SKIPJA /SET INSTRUCTION SO THIS CODE\r
- FSTA SKIP,0 / EXECUTES ONLY ONCE.\r
-/\r
- FLDA SXDSRN /INITIALIZE SETX INSTRUCTION\r
- FSTA SKCON2\r
- LDX -11,6 /SET COUNTER (MAX # DSRN ENTRIES)\r
-SKCON2, SETX DSRN /STUFFED AND MODIFIED\r
- XTA 0 /GET NEXT HANDLER ENTRY POINT\r
- SETX #XR\r
- FSUB D5200\r
- JLT SKCON3 /INTERNAL HANDLER, IT'S OK\r
- FSUB D2400\r
- JGT SKCON3 /RESIDENT HANDLER (E.G. SYS:), IT'S OK TOO\r
- LDX 2,0 /***SOME OTHER HANDLER***USER ERROR 2\r
-EXTERN #UE\r
- TRAP3 #UE /USER ILLEGALLY DECLARED A FILE!\r
-/\r
-SKCON3, FLDA NINED /INCREMENT TO NEXT DSRN ENTRY\r
- FADDM SKCON2\r
- JXN SKCON2,6+\r
-/\r
-SKIP2, STARTF /***END OF INITILIZATIN CODE***\r
- LDX 1,7\r
- FCLA /INITIALIZE SOME VARIABLES...\r
- FSTA PERFLG /NO PERIODS YET\r
- FSTA FILE-0003,7\r
- FSTA FILE-0003,7+\r
- FLDA #DSK /SETUP DEFAULT DEVICE\r
- FSTA DEV\r
- FLDA ONE /FIRST CHARACTER IS # 1\r
- FSTA N\r
- FLDA% UNIT /CHECK FOR LEGAL UNIT #\r
- FSUB MUNIT\r
- JSA #LT / IF (UNIT.LT.MUNIT.OR.UNIT.GT.9) GO TO 900\r
- FSTA #TMP+00\r
- FLDA% UNIT\r
- FSUB NINE\r
- JSA #GT\r
- FADD #TMP+00\r
- JNE #900\r
- FLDA% FUNCT /CHECK FOR LEGAL FUNCTION CODE\r
- FSUB TWO\r
- EXTERN #LT\r
- JSA #LT / IF (FUNCT.LT.2.OR.FUNCT.GT.4) GO TO 901\r
- FSTA #TMP+00\r
- FLDA% FUNCT\r
- FSUB FOUR\r
- EXTERN #GT\r
- JSA #GT\r
- FADD #TMP+00\r
- JNE #901\r
-/\r
-/ PUT DEV:FILE.EXT INTO CORRECT FORMAT FOR USR CALL\r
-/\r
- FLDA ONE \r
- FSTA I / DO 100 I=1,18\r
-\r
-#G0002, JSR CGET / CALL CGET (NAME, I, X)\r
- JA .+10\r
-NAME, JA .\r
- JA I\r
- JA X\r
- FLDA X / IF (X.NE.COLON) GO TO 40\r
- FSUB COLON\r
- JNE #40\r
- FLDA I /COLON MUST BE COLUMN 6 OR BEFORE\r
- FSUB SEVEN /7\r
- JGE #DONE\r
- FLDA FILE /COLON DEFINES DEVICE NAME\r
- FSTA DEV\r
- FCLA\r
- FSTA FILE\r
- FLDA ONE\r
- FSTA N\r
- JA #100\r
-\r
-#40, FLDA X / IF (X.NE.PERIOD) GO TO 60\r
- FSUB PERIOD\r
- JNE #60\r
- FLDA PERFLG /ONLY ONE PERIOD ALLOWED\r
- JNE #DONE\r
- FLDA SEVEN /SET TO DECODE EXTENSION\r
- FSTA PERFLG\r
- FSTA N\r
- JA #100\r
-\r
-#60, FLDA X\r
- JEQ #100 /SKIP OVER NULL'S\r
- FSUB SPACE\r
- JEQ #100 /SKIP OVER SPACES\r
- JSR CPUT / CALL CPUT (FILE, N, X)\r
- JA .+10\r
- JA FILE\r
- JA N\r
- JA X\r
- FLDA N / N=N+1\r
- FADD ONE\r
- FSTA N\r
-\r
-#100, FLDA I / 100 CONTINUE\r
- FADD ONE\r
- FSTA I\r
- FSUB ATEEN\r
- JLE #G0002\r
-\r
-#DONE, FLDA% FUNCT\r
- FSUB FOUR\r
- JNE #101 /FUNCTION = CLOSE ?\r
- EXTERN #ENDF\r
- FLDA% UNIT /YES - END FILE\r
- TRAP3 #ENDF\r
-\r
-#101, SETX FUNCTX /USR XR TO PASS PARAMETERS\r
- FLDA% FUNCT\r
- ATX 0\r
- FLDA% UNIT\r
- ATX 1\r
-\r
- TRAP4 #USRSE /TRAP TO THE USR CALLING ROUTINE\r
-\r
- XTA 2 /GET ERRNO AND RETURN IT\r
- FSTA% ERROR\r
- JA #RTN\r
-#900, FLDA THREE /ILLEGAL UNIT NUMBER!!!\r
- FSTA% ERROR\r
- JA #RTN\r
-\r
-#901, FLDA FOUR /ILLEGAL FUNCTION CODE!!!\r
- FSTA% ERROR\r
- JA #RTN\r
-/\r
-SKIPJA, JA SKIP2\r
-DCDF, 0;CDF\r
-ONED, 0;1\r
-D10X, 400;0 /0.1\r
-D10, 0;10\r
-SXDSRN, SETX DSRN\r
-NINED, 0;11\r
-D5200, 0;5200\r
-D2400, 0;2400\r
-D7400, 0;7400\r
-\r
-SECT8 #USRSE; 0\r
-/\r
-/THIS ROUTINE SETS UP, ON PAGE 7400 OF THE HIGHEST FIELD, A\r
-/ROUTINE WHICH CALLS THE OS/8 USR (USER SERVICE ROUTINE).\r
-/IT IS NECESSARY TO DO THIS BECAUSE THE FORTRAN IV LOADER\r
-/MAY LOAD ANY ROUTINE IN THE RESERVED AREA FOR\r
-/THE OS/8 USR (10000 - 11777). \r
-/\r
-/ THIS PROGRAM ALSO REQUIRES\r
-/ THAT 'HKEY' BE THE LOCATION IN <FRTS> AS DEFINED\r
-/ BELOW:\r
-\r
-HKEY=2761\r
-DSRN=4244 /Address of DSRN table in FRTS\r
-\r
-/\r
-/IN CASE CLOSE FUNCTION, GET # BLOCKS WRITTEN\r
-/\r
- TAD UNITX\r
- CLL RTL /MULTIPLY BY 9\r
- RAL\r
- TAD UNITX\r
- TAD K6 /OFFSET TO CURRENT BLOCK\r
- TAD LDSRN /START OF DSRN TABLE - 11\r
- DCA TEMQ\r
- CDF 0\r
- TAD% TEMQ\r
- DCA SB\r
-/\r
-/MOVE USR CALLING ROUTINE TO DEFINED LOCATION\r
-/ I.E. PROTECT LOCS 10000-11777\r
-/\r
- TAD K7400 /Target address\r
- DCA TEMQ /Store for indirect reference\r
- TAD #LUSR+1 /Origin address\r
- DCA TEMQ2 /Store for indirect reference\r
- TAD M200 /Number of words to move\r
- DCA TEMQ3 /Store in a counter\r
- TAD #LUSR /Load field word\r
- AND K7 /Strip it\r
- CLL RTL /Into right bits\r
- RAL\r
- TAD #CDF\r
- DCA .+1 /Store the CDF\r
-FUSR, HLT /Set field where USR loads\r
- TAD% TEMQ2 /Load routine location\r
-FD1, CDF 00 /Set HIGH field\r
- DCA% TEMQ /Store location in high field\r
- ISZ TEMQ /Bump the pointers\r
- ISZ TEMQ2\r
- ISZ TEMQ3 /And the counters\r
- JMP FUSR /Loop on it\r
-\r
-/SET FIELDS AND CALL IT\r
-\r
- RIF /GET CURRENT FIELD\r
- TAD #CDF\r
- DCA .+1\r
- HLT /Set this field\r
-FI1, CIF 00 /Set high field\r
- TAD FUNCTX /Load function number\r
- JMS% K7400 /Call routine\r
-SB, 0 /START BLOCK OF FILE OR LENGTH IF CLOSE\r
-NOBLKS, 0 /LENGTH OF FILE\r
-ENTPT, 0 /HANDLER ENTRY POINT\r
- DCA ERRUSR /SAVE ERROR RETURN VALUE\r
-\r
-/SETUP TO MOVE DSRN TABLE APPROPRIATELY\r
-\r
- TAD UNITX\r
- CLL RTL /MULTIPLY BY 9\r
- RAL\r
- TAD UNITX\r
- TAD LDSRN\r
- DCA TEMQ\r
-#CDF, CDF 0\r
- DCA% TEMQ /DISABLE FILE IN CASE CLOSE FUNCTION\r
- CLA CLL CMA RTL /-3 => AC\r
- TAD FUNCTX\r
- SMA SZA CLA /CLOSE?\r
- JMP USRSL5 /YES\r
-\r
-/MOVE HANDLER TO APROPRIATE BUFFER\r
-\r
- CLA CMA CLL RAL /-2 => AC\r
- TAD UNITX\r
- CLL RTR\r
- RTR /UNIT 9 => AC=7000; UNIT 8 => AC=6000\r
- TAD M400\r
- DCA LHNDR /LOCATION FOR THIS UNIT'S HANDLER\r
- TAD K5200\r
- DCA TEMQ2\r
- TAD M400\r
- DCA TEMQ3\r
-USRL4, CDF 0\r
- TAD% TEMQ2\r
-FD2, CDF 00\r
- DCA% LHNDR\r
- ISZ TEMQ2\r
- ISZ LHNDR\r
- ISZ TEMQ3\r
- JMP USRL4\r
-\r
-/BUILD UP NEW DSRN TABLE FOR THIS UNIT\r
-\r
- CDF 0\r
- TAD ENTPT\r
- DCA% TEMQ /ENTRY POINT\r
- ISZ TEMQ\r
- CLL CML RTL /2 => AC (FORMS CONTROL BIT)\r
- TAD LHNDR\r
- TAD M400\r
- TAD LHIFLD\r
- DCA% TEMQ /HANDLER CODE WORD\r
- TAD K7774 /*K* KLUDGE TO LET FRTS KNOW WHICH\r
- AND% TEMQ / HANDLER IS IN CORE\r
- DCA% #HKEY\r
- ISZ TEMQ\r
- TAD LHNDR\r
- TAD LHIFLD\r
- DCA% TEMQ /BUFFER ADDRESS & FIELD\r
- ISZ TEMQ\r
- TAD LHNDR\r
- DCA% TEMQ /CHARACTER POINTER\r
- ISZ TEMQ\r
- CMA CLL RTL /-3 => AC\r
- DCA% TEMQ /CHARACTER COUNTER\r
- ISZ TEMQ\r
- TAD SB\r
- DCA% TEMQ /START BLOCK\r
- ISZ TEMQ\r
- DCA% TEMQ /RELATIVE BLOCK\r
- ISZ TEMQ\r
- TAD NOBLKS\r
- DCA% TEMQ /LENGTH OF FILE\r
- ISZ TEMQ\r
- DCA% TEMQ /STATUS WORD\r
-\r
-USRSL5, CDF CIF 0\r
- JMP% #USRSE\r
-\r
-\r
-K6, 6\r
-K7400, 7400\r
-M200, -200\r
-M400, -400\r
-K7, 7\r
-K5200, 5200\r
-\r
-LDSRN, DSRN-11 /START LOCATION OF DSRN TABLE\r
-\r
-LHIFLD, 0\r
-TEMQ, 0\r
-TEMQ2, 0\r
-TEMQ3, 0\r
-LHNDR, 0\r
-FUNCTX, 0 /STUFFED BY RALF CODE\r
-UNITX, 0 /STUFFED BY RALF CODE\r
-ERRUSR, 0 /READ BY RALF CODE\r
-\r
-#LUSR, ADDR #USR\r
-#HKEY, HKEY /LOCATION OF HKEY IN FRTS\r
- / MUST AGREE WITH VERSION!!\r
-K7774, 7774\r
-/\r
- ORG .+177&7600\r
-/USR CALLING SUBROUTINE FOR FORTRAN \r
-/\r
-/ THIS ROUTINE IS MOVED TO PAGE 7400 OF THE HIGHEST\r
-/ FIELD BEFORE EXECUTING TO AVOID BEING OVERWRITTEN BY THE USR\r
-/ ROUTINE. NO FILE SPECIFICATIONS OTHER THAN INTERNAL\r
-/ HANDLERS AND SYSTEM DEVICES MAY BE MADE EXTERNAL TO THESE\r
-/ ROUTINES BECAUSE THE USE OF THIS ROUTINE WILL OVERWRITE\r
-/ THE HANDLERS WHICH ARE STORED IN HIGH CORE.\r
-/\r
-/\r
-#USR, 0\r
-/\r
-/ ENTER WITH FUNCTION CODE IN THE AC\r
-/ 2 - LOOKUP (OPEN FOR INPUT)\r
-/ 3 - ENTER (OPEN FOR OUTPUT)\r
-/ 4 - CLOSE (CLOSE OUTPUT FILE)\r
-/\r
-/ DEVICE AND FILE NAMES ARE STUFFED BY THE CALLING\r
-/ PROGRAM BEFORE THIS SUBROUTINE IS CALLED.\r
-/\r
-/ CALLING SEQUENCE:\r
-/ JMS #USR\r
-/ START BLOCK OF FILE (RETURNED FOR CODE 2 & 3)\r
-/ # BLOCKS SUPPLIED IF CODE 4\r
-/ NUMBER OF BLOCKS IN FILE (RETURNED FOR CODE 2 & 3)\r
-/ ENTRY POINT OF HANDLER AS READ INTO PAGE 5200\r
-/ <RETURN>\r
-/\r
-/ AC ON EXIT CONTAINS ERROR CONDITION:\r
-/ 0 - NO ERROR\r
-/ 1 - ILLEGAL DEVICE\r
-/ 2 - ILLEGAL FILE NAME\r
-/\r
- DCA FUNCTY /SAVE FUNCTION CODE\r
- TAD% #USR /GET # BLOCKS IN CASE CLOSE FUNCTION\r
- DCA #BLKS\r
-\r
- RDF /SET INSTRUCTION FIELD FOR RETURN\r
- TAD #CIF\r
- DCA EXIT4\r
- CMA /MAKE IT CDF\r
- TAD EXIT4\r
- DCA EXIT\r
- DCA ERRNO /INITIALIZE ERROR RETURN VARIABLE\r
- CMA\r
- TAD #CIF /-1 IN AC MAKES IT CDF\r
- RIF\r
- DCA .+1\r
- HLT /SET DATA FIELD TO CURRENT FIELD\r
-\r
-/ ********SWAP CORE FOR USR CALL\r
-\r
-/Note, that it would be much simpler to read in the field\r
-/one tables, and call USR at 17700. Let USR do the swapping.\r
-/We must only set the correct bits in the JSW.\r
-\r
- IOF\r
-#CIF, CIF 0\r
- JMS% K7607 /CALL SYSTEM HANDLER\r
- 5210 / WRITE 17400-17777,10000-11777\r
- 7400\r
- 27\r
- HLT /DEVICE ERROR\r
-\r
- CIF 0\r
- JMS% K7607 /READ IN USR\r
- 610\r
- 0\r
- 13 /From block 13\r
- HLT\r
-\r
- CIF 0\r
- JMS% K7607 /READ IN FIELD ONE TABLES\r
- 210\r
- 7400\r
- 37 /From block 37 (where FRTS put it)\r
- HLT\r
-\r
-/ ********PERFORM USR FUNCTIONS\r
-\r
- CIF 10\r
- JMS% K200 /RESET tables, so it looks like no handlers\r
- 13\r
- 0\r
-\r
- TAD K5201 /SET PAGE FOR HANDLER (allow 2 page handler)\r
- DCA ENTRY\r
- CIF 10\r
- JMS% K200 /FETCH\r
- 1\r
-DEV, 0 /(STUFFED BY RALF ROUTINE)\r
-DEVNO, 0\r
-ENTRY, 5201\r
- JMP ERR /ILLEGAL DEVICE\r
-\r
- TAD #LFILE /SET POINTER TO FILE\r
- TAD KOFSET\r
- DCA LFILE\r
- TAD DEVNO /GET DEVICE NUMBER\r
- CIF 10\r
- JMS% K200 /PERFORM FUNCTION\r
-FUNCTY, 0\r
-SB2,\r
-LFILE, 0\r
-#BLKS, 0\r
- JMP ERR2 /FILE ERROR\r
-\r
-/ ********RESTORE CORE\r
-\r
-EXIT2, CIF 0\r
- JMS% K7607 /SAVE FIELD ONE TABLES\r
- 4210 /? Is this really necessary?\r
- 7400 /Since they've already been saved?\r
- 37 /by FRTS\r
- HLT\r
-\r
- CIF 0 /USROUT function would do this\r
- JMS% K7607 /Read in the Stuff we saved\r
- 1210\r
- 7400\r
- 27\r
- HLT\r
-\r
- ION /Is this necessary?\r
-EXIT, HLT\r
- TAD SB2 /RETURN SB & #BLKS\r
- DCA% #USR\r
- ISZ #USR\r
- TAD SB2\r
- SZA CLA /NON-FILE STRUCTURED DEVICE?\r
- JMP .+3\r
- CMA /YES - SET MAX NUMBER OF BLOCKS\r
- JMP .+3\r
- TAD #BLKS\r
- CIA\r
- DCA% #USR\r
- ISZ #USR\r
- TAD ENTRY\r
- DCA% #USR\r
- ISZ #USR\r
- TAD ERRNO\r
-EXIT4, HLT\r
- JMP% #USR\r
-\r
-\r
-K7607, 7607 /SYSTEM HANDLER ENTRY POINT\r
-K200, 200 /USR ENTRY POINT\r
-K5201, 5201 /PAGE FOR HANDLER (& TWO PAGES AVAILABLE)\r
-\r
-ERR2, CLA IAC /ILLEGAL FILE NAME\r
-ERR, IAC /ILLEGAL DEVICE NAME\r
- DCA ERRNO\r
- JMP EXIT2\r
-ERRNO, 0\r
-\r
-#LFILE, AND FILE /LOCATION OF FILE ON PAGE 7400\r
- /'AND' NEEDED TO TRICK ABSOLUTE REFERENCE\r
- /CHECK IN RALF.\r
-KOFSET, 7200 /OFFSET TO REAL EXECUTION ADDRESS\r
-FILE, 0;0;0;0;0;0;0;0;0\r
-\r
projects / pdp8.git / blobdiff