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