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