projects / pdp8.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | blame (incremental) | history | HEAD
maindec: Added the usual collection, with intact symlinks
[pdp8.git] / sw / adventure / USR.RA
CommitLineData
84b5715c
PH		 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
121UNIT, ORG .+3 /BASE 2\r
122FUNCT, ORG .+3 /BASE 3\r
123ERROR, ORG .+3 /BASE 4\r
124#DSK, TEXT +DSK@@@+ /DEFAULT DEVICE NAME\r
125I, F 0.0 /BASE 6\r
126N, 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
133PERFLG, F 0.0 /PERIOD FLAG\r
134X,\r
135#TMP, ORG .+3\r
136ONE, F 1.0\r
137TWO, F 2.0\r
138THREE, F 3.0\r
139FOUR, F 4.0\r
140SEVEN, F 7.0\r
141MUNIT, 0027;0;0 /Low unit: Set according to CORE avail.\r
142NINE, F 9.0\r
143TEN, F 10.0\r
144ATEEN, F 18.0\r
145COLON, F 58.0\r
146PERIOD, F 46.0\r
147SPACE, F 32.0\r
148MAXCOR, 0; 7; 0 /RHM: Don't require the FRTS patch.\r
149HGHLOC, 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
173SKIP, /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
230SKCONT, 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
255SKCON2, 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
263EXTERN #UE\r
264 TRAP3 #UE /USER ILLEGALLY DECLARED A FILE!\r
265/\r
266SKCON3, FLDA NINED /INCREMENT TO NEXT DSRN ENTRY\r
267 FADDM SKCON2\r
268 JXN SKCON2,6+\r
269/\r
270SKIP2, 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
308NAME, 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
380SKIPJA, JA SKIP2\r
381DCDF, 0;CDF\r
382ONED, 0;1\r
383D10X, 400;0 /0.1\r
384D10, 0;10\r
385SXDSRN, SETX DSRN\r
386NINED, 0;11\r
387D5200, 0;5200\r
388D2400, 0;2400\r
389D7400, 0;7400\r
390\r
391SECT8 #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
403HKEY=2761\r
404DSRN=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
435FUSR, HLT /Set field where USR loads\r
436 TAD% TEMQ2 /Load routine location\r
437FD1, 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
450FI1, CIF 00 /Set high field\r
451 TAD FUNCTX /Load function number\r
452 JMS% K7400 /Call routine\r
453SB, 0 /START BLOCK OF FILE OR LENGTH IF CLOSE\r
454NOBLKS, 0 /LENGTH OF FILE\r
455ENTPT, 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
485USRL4, CDF 0\r
486 TAD% TEMQ2\r
487FD2, 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
529USRSL5, CDF CIF 0\r
530 JMP% #USRSE\r
531\r
532\r
533K6, 6\r
534K7400, 7400\r
535M200, -200\r
536M400, -400\r
537K7, 7\r
538K5200, 5200\r
539\r
540LDSRN, DSRN-11 /START LOCATION OF DSRN TABLE\r
541\r
542LHIFLD, 0\r
543TEMQ, 0\r
544TEMQ2, 0\r
545TEMQ3, 0\r
546LHNDR, 0\r
547FUNCTX, 0 /STUFFED BY RALF CODE\r
548UNITX, 0 /STUFFED BY RALF CODE\r
549ERRUSR, 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
554K7774, 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
647DEV, 0 /(STUFFED BY RALF ROUTINE)\r
648DEVNO, 0\r
649ENTRY, 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
658FUNCTY, 0\r
659SB2,\r
660LFILE, 0\r
661#BLKS, 0\r
662 JMP ERR2 /FILE ERROR\r
663\r
664/ ********RESTORE CORE\r
665\r
666EXIT2, 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
681EXIT, 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
698EXIT4, HLT\r
699 JMP% #USR\r
700\r
701\r
702K7607, 7607 /SYSTEM HANDLER ENTRY POINT\r
703K200, 200 /USR ENTRY POINT\r
704K5201, 5201 /PAGE FOR HANDLER (& TWO PAGES AVAILABLE)\r
705\r
706ERR2, CLA IAC /ILLEGAL FILE NAME\r
707ERR, IAC /ILLEGAL DEVICE NAME\r
708 DCA ERRNO\r
709 JMP EXIT2\r
710ERRNO, 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
715KOFSET, 7200 /OFFSET TO REAL EXECUTION ADDRESS\r
716FILE, 0;0;0;0;0;0;0;0;0\r
717\r
My complete PDP-8 universe