A large commit.
[pdp8.git] / sw / os8 / v3d / sources / fortran / all / rtl.pa
... / ...
CommitLineData
1/FORTRN 4 RTS LOADER
2/
3/ VERSION 5A PT 16-MAY-77
4/
5/
6/
7/
8/
9//
10/
11/
12/
13/
14/COPYRIGHT (C) 1974, 1975
15/DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
16/
17/
18/
19/THIS SOFTWARE IS FURNISHED UNDER A LICENSE FOR USE ONLY ON A
20/SINGLE COMPUTER SYSTEM AND MAY BE COPIED ONLY WITH THE INCLU-
21/SION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE, OR ANT OTHER
22/COPIES THEREOF, MAY NOT BR PROVIDED OR OTHERWISE MADE AVAILABLE
23/TO ANY OTHER PERSON EXCEPT FOR USE ON SUCH SYSTEM AND TO ONE WHO
24/AGREES TO THESE LICENSE TERMS. TITLE TO AND OWNERSHIP OF THE
25/SOFTWARE SHALL AT ALL TIMES REMAIN IN DEC.
26/
27/
28/THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT
29/NOTICE AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL
30/EQUIPMRNT COROPATION.
31/
32/DEC ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
33/SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DEC.
34/
35/
36/
37/
38/
39/
40\f/FORTRAN 4 RTS LOADER - RL
41/WITH DOUBLE PRECSION - MKH
42/AND RTS-8 SUPPORT - R. LARY
43
44/LAST EDITED 5/21/74
45/
46/ CHANGES FOR OS/78 AND OS/8 V3D BY P.T. 5/1/77
47/ .FIXED THE D AND B FORMAT (FPP) BUG
48/ .FIXED FIELD OVERFLOW BUG(NO. OF ASTERISKS PRINTED)
49/
50
51/PAGE 0 LOCATIONS FOR RTS LOADER
52
53X0= 10
54X1= 11
55X2= 12
56X3= 13
57
58HADR= 20
59UNIT= 21
60HCWORD= 22
61MXFLD= 23
62HLDADR= 24
63HGHFLD= 25
64HGHADR= 26
65RLTMP= 27
66HDIFF= 30
67CFLAG= 31
68
69/DURING MOST OF THE LOAD OPERATION A SECTION OF FIELD 0 RTS
70/IS MOVED UP INTO FIELD 1 AND THE VACATED AREA OF FIELD 0 IS USED
71/TO RUN THE COMMAND DECODER AND TO ACCUMULATE DEVICE HANDLERS.
72
73/*K* THEREFORE, IF THE RTS LOADER IS TO MODIFY ANY CODE BETWEEN
74/"F0HBEG" AND "F0HEND" IT MUST MODIFY IT IN FIELD 1 IN THE "F0TO" AREA.
75
76F0HBEG= 0
77F0HEND= 3000
78F0HSAV= 7000 /400 WORDS WHERE DEVICE HANDLERS ARE TEMPORARILY SAVED
79 /SO THAT THEY WON'T INITIALIZE THEMSELVES WRONG
80\f/RTS LOADER TABLES
81
82 *2000
83
84IONTBL, ZBLOCK 100 /INTERRUPT ENABLE TABLE - LOW BIT ONLY
85HCWTBL, ZBLOCK 14 /HANDLER CONTROL WORD - ONE PER PAGE (LOTSA WASTE)
86TFTABL, ZBLOCK 45 /TENTATIVE FILE SAVE TABLE
87DVTEMP, ZBLOCK 17 /HANDLER ENTRY TABLE SAVE AREA
88
89 *IONTBL+5 /RK8 / RK8E
90 1
91 *IONTBL+16 /DTA
92 1
93 *IONTBL+6 /RF08 IN 4 FLAVORS
94 1;1;1;1
95 *IONTBL+0 /TTY
96 2 /FORMS CONTROL ON TTY
97 *IONTBL+4 /LPT
98 2 /FORMS CONTROL ON LPT
99 *IONTBL+23
100 1
101 *IONTBL+25
102 1
103 PAGE
104\f/RTS LOADER
105
106RTSLDR, JMS I (RTINIT
107 JMS I (RTINIT /INITIALIZE WHETHER CHAINED TO OR NOT
108 JMP NOCD
109LICD, JMS I (200
110 5
111 1404 /.LD DEFAULT EXTENSION
112NOCD, JMS I (TSTSWS /TEST /E,/P,/V AND /H SWITCHES
113 TAD I (7617
114 SNA
115 JMP LICD
116 AND (17
117 JMS I (GETHAN /GET HANDLER TO LOAD WITH
118 0 /DON'T PUT IT ANYWHERE
119 TAD I (7620
120 DCA LIBLK
121 JMS I (SVHND /COPY HANDLER TO AVOID BAD INITIALIZATION
122 CIF 0
123 JMS I HLDADR
124 0100
125LHDR, QLHDR
126LIBLK, 0
127 JMP LDIOER
128 JMS I (RSTHND /RESTORE VIRGIN COPY OF HANDLER
129 CDF 0
130 TAD HADR
131 DCA I (OVHND
132 TAD HCWORD
133 DCA I (OVHCDW
134 TAD (QUSRLV-1
135 DCA X0
136 AC7776
137 TAD I LHDR
138 SZA CLA /VERIFY LOADER IMAGE INPUT
139 JMP NOTLI /GOOD THING WE CHECKED!
140 TAD DPFPP
141 TAD I (QDPFLG /CHECK IF TRYING TO USE D.P. WITHOUT OPTION
142 SMA CLA
143 JMP .+3
144 JMS I (RLERR /YES - PRINT WARNING MESSAGE
145 NODPMS /BUT LET THE FOOL GO ON
146\f/SET UP RTS TABLES FROM LOADER IMAGE
147
148 CDF 0
149 TAD (OVLYTB-1
150 DCA X1
151 TAD (-10
152 DCA RLTMP
153OVRELP, TAD I X0
154 DCA I X1 /MOVE USER OVERLAY INFO INTO SWAP TABLE,
155 TAD I X0
156 DCA I X1
157 TAD I X0
158 TAD LIBLK /RELOCATING THE BLOCK NUMBERS
159 DCA I X1
160 TAD I X0
161 DCA I X1
162 ISZ RLTMP
163 JMP OVRELP
164 TAD I (QRTSWP
165 AND (7770 /TURN THE LOADER INITIAL SWAP WORD
166 DCA I (STSWAP+2
167 TAD I (QRTSWP /INTO A DUMMY SWAP WORD AND A JUMP WORD
168 AND (7 /SO THAT WE CAN HALT BETWEEN
169 TAD (JA /LOADING AND STARTING USERS PROGRAM.
170 DCA I (STJUMP
171 TAD I (QRTSWP+1
172 DCA I (STJUMP+1
173 TAD I (QHGHAD
174 DCA HGHFLD
175 CLA IAC
176 TAD HGHFLD
177 CMA
178 DCA I (FCNT
179 TAD I (QHGHAD+1
180 DCA HGHADR
181 JMS I (GETFIL /GET USER I/O FILES IF ANY
182 TAD I (OS8DAT /SALT AWAY OS/8 DATE WORD
183 DCA I (VDATE-F0HBEG+F0TO
184 STL CLA
185 6141 /TEST IF WE ARE ON A PDP-12
186 0261 /ROL I 1 - PUTS LINK IN AC11
187 0002 /PDP
188 DCA I (V8OR12+1-F0HBEG+F0TO
189 JMS I (MOVE
190 CDF 10
191 SPSTRT-1 /MOVE SPECIAL /P START CODE TO LOC 200
192 CDF 10
193 200-F0HBEG+F0TO-1 /(RELOCATED 200, THAT IS)
194 -3
195 JMP I (MOVCOR
196
197DPFPP, 3777 /0 IF D.P. FPP AVAILABLE
198\fNOTLI, JMS I (RLERR
199 NOLI
200 JMP LICD
201
202LDIOER, JMS I (RLERR
203 LIOEMS
204 CDF CIF 0
205 JMP I (7605
206 PAGE
207\f/FIGURE OUT CORE LIMITS AND WRITE OUT PG 17600
208
209MOVCOR, TAD I (HTOP
210 TAD HDIFF /GET BOTTOM OF HANDLER AREA
211 CIA
212 CLL /LENGTH OF HANDLER AREA IN AC
213 TAD HGHADR
214 SZL /TRICKY CODE - IF (L,AC)=0, AC GETS -1
215 STA /IF (L,AC) =0XXXX, AC GETS 0
216 SNA CLA /IF (L,AC) =1XXXX, AC GETS 1
217 STL STA /THERE OUGHTA BE A SHORTER WAY -
218 RAL /I'D APPRECIATE HEARING ONE.
219 TAD HGHFLD /USE MAGIC NUMBER TO ADJUST HGHFLD
220 CIA /BEFORE WE COMPARE IT TO TOP-OF-CORE
221 TAD MXFLD
222 SPA CLA
223 JMP TOOBIG /ALL THAT WORK FOR NOTHING!
224 TAD MXFLD
225 CLL RTL
226 RAL
227 TAD (CDF
228 DCA HCDF /PREPARE TO TRANSFER THE HANDLERS
229 JMS I (MOVE /BEFORE WE MOVE THE HANDLERS WE SHOULD WRITE
230 CDF 10 /OUT PAGE 17600 AND THE RTS CLEANUP CODE
231 TFTABL-1 /SINCE THE HANDLERS MAY OVERLAY THEM.
232 CDF 10 /SO FIRST MOVE THE TENTATIVE FILE TABLE
233 7600-1 /INTO PAGE 17600 WHERE IT'S SAFE.
234 -45
235 CIF 0
236 JMS I (7607
237 4210
238 7400
239 37 /SUITABLE SCRATCH BLOCK
240 JMP SYSERR
241 TAD HDIFF
242 TAD (F0HEND /CHANGE HDIFF FROM AN OFFSET
243 DCA HDIFF /TO THE FIRST LOC ABOVE THE HANDLERS.
244\f/SHUFFLE CORE AROUND AND START UP RTS
245
246HLOOP, STA
247 TAD HDIFF /WE HAVE TO MOVE THE HANDLERS IN A COCKEYED
248 DCA HDIFF /WAY SINCE WE MIGHT BE PARTIALLY SWAPPING
249 CDF 0 /CORE BETWEEN FIELD 0 (THE HANDLERS) AND
250 STA /FIELD 1 (WHERE WE SAVED FIELD 0) IN 8K SYSTEMS.
251 TAD HPTR1
252 DCA HPTR1
253 STA
254 TAD HPTR2
255 DCA HPTR2
256 TAD I HPTR1
257HCDF, HLT /MOVE A HANDLER WORD FROM FIELD 0
258 DCA I HDIFF /TO FIELD N
259 CDF 10
260 TAD I HPTR2 /MEANWHILE RESTORE FIELD 0
261 CDF 0
262 DCA I HPTR1 /FROM FIELD 1
263 ISZ HMCT
264 JMP HLOOP /DO MORE THAN WE HAVE TO - IT CAN'T HURT
265 CDF CIF 0
266 TAD (5606
267 DCA I (7605 /SET UP OS/8 RETURN SEQUENCE TO TRAP TO RTS
268 TAD (PDPXIT
269 DCA I (7606 /AS RANDOM RESTARTS COULD BE FATAL.
270 FPICL /RE-INITIALIZE FPP (IF ANY)
271 FPCOM /CLEAR APT POINTER FIELD BITS (IF FPP)
272 CLA IAC
273 6654 /LOAD PRINTER BUFFER ON ANALEX PRINTER
274 SZA CLA /IS ANALEX PRESENT?
275 JMP I (FPSTRT /NO - START UP
276 DCA I (LPTEST /IF ANALEX TAKE OUT LPT INTERNAL HANDLER
277LP6652, 6652 /ALSO CLEAR ALL ANALEX FLAGS
278 DCA I (LPTSNA
279 6662 /CLEAR BUFFER ON ANALEX
280 TAD (6651
281 DCA I (LPTERR /REPLACE LP08 ERROR CODE BY ANALEX
282 TAD LP6652 /TO AVOID HANGING ON ANALEX POWER OFF.
283 DCA I (LPTERR+2
284 JMP I (FPSTRT
285
286TOOBIG, JMS I (RLERR
287 TOOMCH
288OS8RTN, CDF CIF 0
289 JMP I (7605
290
291SYSERR, JMS I (RLERR
292 SYSMSG
293 JMP OS8RTN
294
295HPTR1, F0HEND
296HPTR2, F0TO+F0HEND-F0HBEG
297HMCT, F0HBEG-F0HEND
298\f/MOVE ROUTINE
299
300MOVE, 0 /GENERAL MOVE SUBROUTINE
301 CDF 10
302 CLA
303 TAD MOVE
304 DCA X2
305 TAD I MOVE
306 DCA FRMFLD
307 TAD I X2
308 DCA X3
309 TAD I X2
310 DCA TOFLD
311 TAD I X2
312 DCA X1
313 TAD I X2
314 DCA MVC
315FRMFLD, HLT
316 TAD I X3
317TOFLD, HLT
318 DCA I X1
319 ISZ MVC
320 JMP FRMFLD
321 CDF 10
322 JMP I X2
323MVC, 0
324
325HNDERR, JMS I (RLERR
326 TOMNYH
327 JMP OS8RTN
328 PAGE
329\f/INITIALIZATION
330
331RTINIT, 0
332 ISZ RTINIT /SKIP RETURN
333 JMS I (BAKTST /SEE IF WE'RE RUNNING IN BACKGROUND UNDER RTS-8
334 CIF 0
335 JMS I (CORE
336 DCA MXFLD
337 CLA IAC
338 JMS I (GETION /GET ION BIT FOR SYS HANDLER
339 DCA I (HCWTBL+13 /SAVE IT
340 SWAB /SET EAE MODE TO B (IF 8/E)
341 CLA IAC
342EAEKIL, SHL /ZERO THIS LOCATION TO INHIBIT EAE
343 CLA IAC /LOW ORDER BITS 01
344 TAD (-2
345 SNA CLA /TEST FOR 8/E EAE
346 JMS I (MOVEAE /YES - SUBSTITUTE PACKAGES
347 TAD (APT
348 FPST /START FPP ON "STARTE;FEXIT"
349 JMP NOFPP /DIDN'T START
350 JMS I (MOVE
351 CDF 10
352 FPPINT-1 /THE FPP HANDLER AND D.P. I/O PKG IS IN THE
353 CDF 0 /SAME LOCATIONS IN FIELD 1 AS THE
354 FPPINT-1 /FPP INTERPRETER IN FIELD 0.
355 -1000 /COUNT FOR DBL PREC SPACE
356 FPRST /FPP HAD BETTER BE DONE BY NOW!!
357 AND (4 /GET D.P. STATUS BIT
358 SNA CLA
359 JMP NOFPP /NO DOUBLE PRECISION
360 DCA I (DPFPP /SET FLAG TO INDICATE D.P. AVAILABLE
361 CDF 0
362 TAD (DFMT
363 DCA I (DF /ENABLE D FORMAT
364 TAD (BFMT
365 DCA I (BF /AND B FORMAT
366 CDF 10
367\fNOFPP, JMS I (MOVE
368RICDF0, CDF 0
369 F0HBEG-1
370 CDF 10
371 F0TO-1 /MOVE LOWER F0 INTO F1 FOR SAFEKEEPING
372 F0HBEG-F0HEND
373 CDF 0
374 TAD I (OSJSWD /GET OS/8 STATUS WORD
375 AND (6374 /FORCE BITS ON INDICATING NON-RESTARTABLE JOB
376 TAD (1003 /AND DESTRUCTIVE CALLS TO CD AND USR
377 DCA I (OSJSWD /MEANWHILE FORCING "BATCH SAVED" BIT OFF
378 TAD I (7612
379 TAD (-3 /CHECK FOR IN-CORE TD8E'S
380 SZA CLA
381 JMP NOTDSY
382 TAD MXFLD
383 CLL RTL
384 RAL
385 TAD RICDF0
386 DCA TD8EFG /SET TD8E FLAG WHICH IS ALSO CDF
387 TAD I (7642
388 AND (70
389 TAD RICDF0 /GET THE FIELD WE'RE COMING FROM
390 DCA TD8EFL
391 TAD TD8EFG
392 IAC
393 JMS I (TDSET /REDO THE CDF'S IN F0
394 JMS I (MOVE
395TD8EFL, CDF 20
396 7577
397TD8EFG, 0
398 7577
399 -174 /SPARE BATCH PARAMETERS IN TOP FIELD
400 TAD MXFLD /SET FLAG IN CLEANUP ROUTINE
401 DCA I (TDEXFG /TO RESTORE TD8E HANDLER TO FIELD 2
402NOTDSY, CDF 10
403 TAD MXFLD
404 TAD (-7
405 SNA /32K?
406 JMP TAKCAR /YES - UNIQUE PROBLEMS
407 TAD (6
408 SNA CLA /8K?
409 JMP ONLY8K /YES - IGNORE BATCH & TD8E CRAP
410 JMS I (GBFLG /GET BATCH FLAG
411 TAD TD8EFG
412 SNA CLA /IF NO BATCH OR TD8E'S,
413ONLY8K, TAD (200 /USE ALL OF THE LAST FIELD.
414STOHDF, TAD (-F0HEND-200
415 DCA HDIFF /OTHERWISE USE ONLY UP TO 7600
416 JMP I RTINIT
417\fTAKCAR, JMS I (GBFLG /GET BATCH FLAG
418 SNA CLA
419 JMP NO32KB /NO BATCH - USE UP TO 77400 (TD8E ROM)
420 TAD (6 /BATCH - USE UP TO 67600
421 DCA MXFLD
422 JMP STOHDF
423NO32KB, TAD TD8EFG
424 SNA CLA /IF IN-CORE TD8E'S
425 TAD (7600 /LIMIT IS 77600 ELSE 77400
426 JMP STOHDF
427 PAGE
428\fGETHAN, 0 /GET HANDLER SUBROUTINE
429 AND (17
430 DCA UNIT
431 DCA H1
432 TAD UNIT
433 JMS I (200
434 12 /INQUIRE
435H1, 0
436 NOP /ERROR RETURN ALWAYS SKIPPED
437 TAD H1
438 SNA
439 JMP NOTLDD /NOT IN CORE - MUST LOAD
440 JMS HCWTBA /IN CORE
441GHEXIT, TAD I HCWPTR /GET CONTROL WORD FOR HANDLER PAGE
442 DCA HCWORD
443 TAD HLDADR
444 DCA HADR /ASSUME HANDLER PERMENANTLY RESIDENT
445 TAD (-4
446 AND HCWORD
447 SNA CLA /WERE WE RASH?
448 JMP RESHAN /NO
449 TAD HADR
450 AND (177
451 TAD (HPLACE /YES - I APOLOGIZE
452 DCA HADR
453RESHAN, TAD I GETHAN /GET DSRN NUMBER
454 SNA
455 JMP I GETHAN /NO DSRN NUMBER
456 CLL RTL
457 RAL
458 TAD I GETHAN
459 TAD (DSRN-12
460 DCA X0 /XR POINTS TO DSRN ENTRY
461 CDF 0
462 TAD HADR
463 DCA I X0 /SEE PG 0, FLD 0 FOR DSRN FORMAT
464 TAD HCWORD
465 TAD CFLAG /THE C BIT REVERSES THE FORMS CTL BIT ON THIS FILE
466 AND (7773 /KILL ANY OVERFLOW
467 DCA I X0
468 TAD HGHFLD
469 CLL RTL
470 RAL
471 TAD HGHADR
472 DCA I X0 /SAVE BUFFER ADDRESS, FIELD
473 TAD HGHADR
474 DCA I X0 /INITIALIZE WORD POINTER
475 TAD HGHADR
476 TAD (400
477 SNA
478 ISZ HGHFLD /BUMP DOUBLEWORD BUFFER ADDRESS
479 DCA HGHADR
480 AC7775
481 DCA I X0 /INITIALIZE CHAR CTR
482 CDF 10
483 JMP I GETHAN /RETURN
484\f/LOAD A NON-RESIDENT HANDLER
485
486NOTLDD, JMS GH
487 CLA IAC
488 JMS GH /TRY 1-PAGE AND THEN 2-PAGE ASSIGN
489 HLT /ARRRGHHHH!!!
490
491GH, 0
492 DCA TPFLG
493 TAD HTOP
494 TAD (7600 /BUMP HANDLER CEILING DOWN
495 SNA
496 JMP I (HNDERR /CAN'T PUT HANDLER IN PAGE 0
497 DCA HTOP
498 TAD TPFLG
499 TAD HTOP
500 DCA GHADR
501 TAD UNIT
502 JMS I (200
503 1 /FETCH HANDLER
504GHADR, 0
505 JMP I GH /FAILED!
506 TAD GHADR /SAVE ACTUAL LOAD ADDRESS
507 JMS HCWTBA /INDEX INTO HCW TABLE
508 TAD GHADR
509 AND (7600
510 TAD HDIFF
511 DCA GHADR /SAVE RELOCATED HANDLER PAGE ADDRESS
512 TAD MXFLD /PUT ADDR IN BITS 0-3 AND FIELD IN BITS 6-8
513 CLL RTL
514 RAL
515 TAD GHADR
516 DCA GHADR
517 TAD UNIT
518 JMS I (GETION /ION BIT INTO BIT 11, FORMS CTL BIT INTO BIT 10
519 TAD GHADR
520 DCA I HCWPTR /STORE POINTER FOR THIS PAGE
521 JMP GHEXIT
522\fHCWTBA, 0
523 DCA HLDADR
524 TAD HLDADR
525 AND (7600
526 CLL RTL
527 RTL
528 RTL /GET PAGE NUMBER
529 TAD (HCWTBL-24
530 DCA HCWPTR /SAVE POINTER INTO TABLE
531 JMP I HCWTBA
532
533HTOP, F0HEND
534HCWPTR, 0
535TPFLG, 0
536
537SPSTRT, RELOC 200 / /P STARTUP CODE
538 SWAB /MAKE SURE EAE IS IN MODE B
539 JMP I .+1 /EXECUTES AT 200
540 FPSTRT /START UP IN FLAG CLEARING CODE
541 RELOC
542 PAGE
543\f/ROUTINE TO ACCEPT FILE SPECIFICATIONS
544
545GETFIL, 0
546 CDF 10
547 TAD I (OS8SWS-1
548 SPA CLA /ALTMODE MEANS NO MORE SPECS
549 JMP I GETFIL
550GETFCD, JMS I (SPMDCD /CALL CD IN SPECIAL MODE
551 TAD I (7600
552 STL CIA
553 SNA /OUTPUT FILE?
554 TAD I (7605
555 SNA /IN OR OUT FILE?
556 TAD I (OS8SWS+3 /NEITHER - HOW ABOUT INTERNAL HANDLER?
557 SNA CLA
558 JMP GETFIL+1 /NONE OF THE ABOVE
559 RAR /LINK MAGICALLY TELLS DIRECTION
560 DCA DIR
561 DCA DSRNUM
562 TAD I (OS8SWS+2
563 AND (777 /SWITCHES 1-9
564 SNA
565 JMP NONUM
566 CLL RTL
567DNUMLP, ISZ DSRNUM
568 RAL
569 SMA
570 JMP DNUMLP /TRANSLATE SWITCH INTO NUMBER
571 TAD DIR /** AC IS NEGATIVE **
572 SPA CLA
573 TAD (5
574 TAD (7600
575 DCA FPTR /POINT TO FILE UNIT
576 TAD I FPTR
577 SNA
578 JMP INTHND /NO FILE - GET HANDLER FROM INTERNAL LIST
579 JMS I (GETHAN /GET HANDLER - XR10 POINTS INTO DSRN
580DSRNUM, 0 /DSRN ENTRY NUMBER
581 TAD DIR
582 STL RTL /GENERATE 2 OR 3 (LOOKUP OR ENTER)
583 DCA LKPNTR
584 TAD I FPTR /GET UNIT AND REQUESTED BLOCK COUNT (IF ENTER)
585 ISZ FPTR /BUMP POINTER SO IT POINTS TO THE FILE NAME
586 DCA FUNIT /SAVE UNIT NUMBER A SEC
587 TAD I FPTR /WATCH OUT FOR NULL FILE NAMES
588 SNA CLA /AS THEY WILL FAIL ON LOOKUPS
589 JMP NONAME /ON OUTPUT-ONLY NON-DIRECTORY DEVICES
590 JMS I (SVHND /SAVE HANDLER
591 TAD FUNIT
592 JMS I (200
593LKPNTR, 0 /LOOKUP OR ENTER
594FPTR, 0 /FILE NAME
595FUNIT, 0 /GETS LENGTH
596 JMP FILERR /SOMETHING NOT KOSHER
597 JMS I (RSTHND /RESTORE VIRGIN COPY OF HANDLER
598\fSTDSRN, TAD FPTR
599 CDF 0
600 DCA I X0 /SAVE STARTING BLOCK
601 DCA I X0 /RELATIVE BLOCK
602 TAD FUNIT
603 SNA
604 IAC /FUDGE NON-DIRECTORY DEVICES VERY LARGE
605 CIA /TURN NEGATIVE COUNT TO POSITIVE
606 DCA I X0 /LENGTH
607 TAD X0
608 DCA FPTR /SAVE PTR TO LENGTH WORD
609 CDF 10
610 TAD DIR
611 SMA CLA /TENTATIVE FILE?
612 JMP GETFIL+1
613 TAD FPTR /YES - STORE POINTER TO LENGTH WORD OF DSRN
614 DCA I TFPTR /IN TENTATIVE FILE TABLE ENTRY
615 JMS I (MOVE
616 CDF 10
617 7600-1
618 CDF 10
619TFPTR, TFTABL /SAVE FILE NAME AND UNIT IN
620 -5 /TENTATIVE FILE TABLE
621 TAD TFPTR
622 TAD (6
623 DCA TFPTR /BUMP PTR TO NEXT 6-WORD ENTRY
624 JMP GETFIL+1
625\fNONUM, JMS I (RLERR
626 NONMSG
627 JMP GETFCD
628FILERR, JMS I (RLERR
629 FILMSG
630 JMP GETFCD
631
632DIR, 0
633
634NONAME, DCA FPTR
635 DCA FUNIT /ZERO BLOCK # AND LENGTH
636 JMP STDSRN /USE ENTIRE DEVICE AS FILE
637
638INTHND, STA
639 TAD I (OS8SWS+3
640 AND (3 /ONLY USE LOW ORDER 2 BITS OF NUMBER
641 TAD (IHTBL
642 DCA HADR /SAVE PTR INTO TABLE OF INTL HANDLERS
643 TAD DSRNUM
644 CLL RTL
645 RAL
646 TAD DSRNUM /MULTIPLY DSRN NUMBER BY 9
647 TAD (DSRN-11 /ADD TABLE BASE
648 DCA DSRNUM
649 TAD I HADR
650 CDF 0
651 DCA I DSRNUM
652 ISZ DSRNUM
653 AC7776
654 TAD CFLAG /DEPENDING ON THE C FLAG,
655 CIA
656 DCA I DSRNUM /DISABLE OR ENABLE FORMS CONTROL
657 JMP GETFIL+1
658 PAGE
659\fTSTSWS, 0 /ROUTINE TO TEST CD SWITCHES E AND H
660 TAD I (OS8SWS
661 AND (20
662 CDF 0
663 SNA CLA /TEST FOR /H SWITCH
664 JMP .+3
665 TAD (HLT
666 DCA I (HLTNOP /SET TO HALT BEFORE STARTING PROGRAM
667 CDF 10
668 TAD I (OS8SWS+1
669 AND (4
670 SNA CLA /TEST FOR /V SWITCH
671 JMP .+3 /NO
672 JMS I (RLERR /YES - PRINT VERSION NUMBER MESSAGE
673 XVERMS
674 TAD I (OS8SWS
675 AND (200
676 CDF 0
677 SZA CLA /TEST FOR /E SWITCH
678 ISZ I (ERRFLG /MAKE USER ERRORS NON-FATAL
679 CDF 10 /(USER ERROR = MISSING SUBROUTINE, ETC)
680 TAD I (OS8SWS+1
681 AND (400
682 CDF 0
683 SNA CLA /TEST FOR /P SWITCH
684 JMP .+3 /NO, PRAISE BE!
685 TAD (SKP /GIVE THE DUMMY WHAT HE WANTS
686 DCA I (HLTNOP
687 CDF 10
688 TAD I (OS8SWS
689 RTL
690 SMA CLA
691 AC0002
692 DCA CFLAG /SAVE C FLAG IN PAGE0
693 JMP I TSTSWS
694
695MOVEAE, 0
696 TAD (EFFNOR /SUBSTITUTE A POINTER TO THE EAE NORMALIZE
697 CDF 0 /ROUTINE FOR THE POINTER TO THE NON-EAE
698 DCA I (NORMX /NORMALIZE ROUTINE
699 JMS I (MOVE
700 CDF 10
701 FPPKG-1 /THE EAE PKG IS IN THE SAME PAGE IN FIELD 1
702 CDF 0
703 FPPKG-1 /AS THE NON-EAE PKG IN FIELD 0
704 -600
705 JMS I (MOVE
706 CDF 0 /SUBSTITUTE FAST FIX AND FLOAT
707 EFXFLT-1
708 CDF 0
709 EAEFIX-1
710 -FXFLTC
711 JMP I MOVEAE
712\fSPMDCD, 0 /SUBR TO DO A SPECIAL MODE COMMAND DECODE
713 JMS I (MOVE
714 CDF 10
715 OS8DVT-1
716 CDF 10
717 DVTEMP-1 /MOVE OS/8 DEVICE HANDLER TABLE
718 -17 /SINCE C.D. CLEARS IT AND WE ARE USING IT
719 TAD I (HTOP /GET LOWEST HANDLER LOADED
720 RAL
721 SZL SPA CLA /DID WE LOAD ANY BELOW 02000?
722 JMP .+4 /NO
723 CDF 0
724 ISZ I (OSJSWD /YES - MAKE CD CALLS DESTRUCTIVE
725 ISZ I (OSJSWD
726 CDF 10
727 JMS I (200
728 5 /COMMAND DECODE
729 5200 /SPECIAL MODE - WROUGHT WITH PERIL
730 0 /DON'T CLEAR TENTATIVE FILES
731 JMS I (MOVE
732 CDF 10
733 DVTEMP-1
734 CDF 10
735 OS8DVT-1
736 -17 /MOVE DEVICE HANDLER TABLE BACK
737 JMS TSTSWS /CHECK FOR /E, /H, /P
738 JMP I SPMDCD
739
740IHTBL, PTR;PTP;LPT;TTY /INTERNAL HANDLER TABLE
741 PAGE
742\fGETION, 0
743 TAD (OS8DCB-1
744 DCA GMADR
745 TAD I GMADR /GET DCB WORD
746 CLL RTR
747 RAR
748 AND (77 /INDEX INTO TABLE
749 TAD (IONTBL /WHICH INDICATES IF HANDLER CAN EXECUTE
750 DCA GMADR /WITH INTERRUPTS ON
751 TAD I GMADR /ION BIT INTO BIT 11, FORMS CONTROL INTO BIT 10
752 JMP I GETION
753
754GBFLG, 0
755 CDF 0
756 TAD I (7777 /SPECIAL FLAGS LOC
757 CDF 10
758 RTL
759 CLA RAL
760 JMP I GBFLG
761
762SVHND, 0 /ROUTINE TO SAVE HANDLER IN F1
763 JMS GMADR /GET MOVE FROM ADDRESS
764 JMP I SVHND /NO HANDLER TO MOVE
765 DCA SVMOVE
766 JMS I (MOVE
767 CDF 0
768SVMOVE, 0
769 CDF 10
770 F0HSAV-1
771 -400
772 JMP I SVHND
773
774RSTHND, 0 /ROUTINE TO RESTORE HANDLER FROM F1
775 JMS GMADR
776 JMP I RSTHND /HANDLER IS SYS:
777 DCA RSTMOV
778 JMS I (MOVE
779 CDF 10
780 F0HSAV-1
781 CDF 0
782RSTMOV, 0
783 -400
784 JMP I RSTHND
785
786GMADR, 0
787 TAD HLDADR
788 SPA /CHECK THAT WE'RE NOT TRYING
789 JMP RESHND /TO SAVE A RESIDENT HANDLER -
790 AND RESHND /THAT COULD BE TRICKY
791 TAD (-1 /ECCH
792 ISZ GMADR
793 JMP I GMADR
794RESHND, 7600
795 JMP I GMADR
796\f/RTS LOADER ERROR MESSAGE ROUTINE & MESSAGES
797
798RLERR, 0 /ERROR MESSAGES ARE IN FIELD 0
799 CLA
800 CDF 10
801 TAD I RLERR
802 CDF 0
803 DCA RLTMP
804RELP, TAD I RLTMP
805 RTR
806 RTR
807 RTR
808 AND (77
809 JMS LTTY
810 TAD I RLTMP
811 AND (77
812 JMS LTTY
813 ISZ RLTMP
814 JMP RELP
815EOMSG, TAD (7515
816 JMS LTTY
817 TAD (7512
818 JMS LTTY
819 ISZ RLERR
820 CDF 10
821 JMP I RLERR /SOME MESSAGES ARE NOT FATAL
822
823LTTY, 0
824 SNA
825 JMP EOMSG
826 TAD (240
827 SMA
828 AND (77 /CONVERT SIXBIT TO EIGHTBIT
829 TAD (240
830 TLS
831 CLA
832 TSF
833 JMP .-1
834 JMP I LTTY
835\f/ROUTINE TO DETERMINE WHETHER WE ARE RUNNING IN THE
836/BACKGROUND UNDER RTS-8, AND MODIFY THE RUN-TIME SYSTEM IF WE ARE.
837/RUNS AT INITIALIZATION TIME, BEFORE LOWER FIELD 0 IS MOVED
838
839BAKTST, 0
840 FPICL /FIRST INITIALIZE FPP (IF ANY)
841 FPCOM /INCLUDING CLEARING EXTENDED APT POINTER
842 TCF /TEST FOR RTS-8 BACKGROUND BY CLEARING THE
843 TSF /TTY FLAG AND THEN TESTING IT - IF IT IS
844 JMP I BAKTST /STILL SET, WE ARE RUNNING UNDER SRT-8.
845 CDF 0 /MODIFY LIST AND MODIFICATIONS ARE IN FIELD 0
846BAKLP, TAD I BKRPTR /GET POINTER TO BLOCK TO BE MODIFIED
847 SNA
848 JMP BAKRTN /ZERO - WE'RE DONE
849 DCA X0 /STORE IN AUTO-XR
850 ISZ BKRPTR
851BAKWLP, TAD I BKRPTR /GET NEXT WORD TO STORE
852 ISZ BKRPTR
853 SNA
854 JMP BAKLP /ZERO MEANS END OF GROUP
855 DCA I X0
856 JMP BAKWLP
857BAKRTN, CDF 10 /RESET DATA FIELD TO 10
858 DCA I (EAEKIL /EAE USES SGT WHICH IS NOT EMULATED, SO KILL IT
859 JMP I BAKTST /AND RETURN
860
861BKRPTR, BKRLST
862 PAGE
863
864F0TO= .
865\f/FLOATING POINT PROCESSOR HANDLER
866 *FPPINT
867
868RETURN, JMP FPPRTN /MUST BE AT 0 IN PAGE
869
870FPGO, 0 /FPP STARTUP ROUTINE - MUST BE AT 1 IN PAGE
871 CDF 0
872 DCA STEFLG
873 TAD PC
874 DCA FSAVPC /SAVE OLD PC FOR ONE LEVEL
875 TAD APT
876 DCA SAVAPT /OF RE-ENTRANTNESS
877 TAD I FPGO
878 DCA PC
879 TAD APT
880 AND (7770
881 DCA APT /SET UP ADDRESS IN APT
882FPREST, TAD (400 /ENABLE FPP INTERRUPTS
883 FPCOM /LOAD AND STORE ENTIRE APT
884 CLA /NECESSARY?
885 TAD STEFLG /0 OR 4000?(STARTF OR STARTE)
886 SZA
887 6567 /A MNEMONIC?
888 CLA
889 TAD (APT
890 IOF
891 FPST /START UP FPP
892 JMP .-1 /I HAVE NO IDEA WHY IT DIDN'T START
893 CLA /NECESSARY?
894 JMS I (HANG /EXECUTE BACKGROUND
895 FPUHNG
896 FPRST /READ FPP STATUS
897 FPICL /RESET FPP
898 ION
899 RTL
900 SZL /TEST TRAP BIT
901 JMP TRAP /YUP - GO EXECUTE IT
902 AND (7400
903 SZA /ANY ERRORS?
904 JMP FPPER
905 TAD FSAVPC
906 DCA PC /RESTORE OLD PC
907 TAD SAVAPT
908 DCA APT
909 ISZ FPGO
910 JMP I FPGO
911\f/FLOATING POINT TRAP PROCESSOR
912
913TRAP, AC7775
914 TAD PC
915 DCA PC /BACK UP PC TO BEFORE THE TRAP
916 SZL
917 STA
918 TAD APT /INCLUDING THE FIELD BITS
919 DCA APT
920 TAD APT /SET UP "FETPC" TO FETCH POSSIBLE TRAP ARGS
921 JMS I MCDF
922 DCA I (PCCDF
923 JMS I (FETPC
924 DCA T
925 TAD T /GET TRAP WORD
926 JMS I MCDF
927 IAC /MAKE A "CDF CIF N"
928 IAC
929 DCA TRPCIF
930 JMS I (FETPC
931 DCA ADR /STORE PDP8-CODE ROUTINE ADDRESS
932 TAD T
933TRPCIF, HLT /SET DATA AND INSTRUCTION FIELDS
934 SMA CLA /TRAP3 OR TRAP4?
935 JMP I ADR /TRAP3 - GO TO ADR
936 JMS I ADR /TRAP4 - CALL ADR
937FPPRTN, DCA STEFLG
938 ISZ PC /RESTORE PC FROM BEFORE TRAP
939 SKP
940 ISZ APT /INCLUDING FIELD
941 CDF 0
942 JMP FPREST /RESTART FPP
943
944FPPER, SPA
945 JMP I (FPPERR /FPHALT - FATAL ERROR
946 RTL
947 ISZ FATAL /DIVIDE BY 0 AND OVERFLOW ARE NON-FATAL
948 SZL
949 JMP FPDVER
950FPOVER, JMS I ERR
951 SKP
952FPDVER, JMS I ERR
953 TAD . /I ALWAYS WANTED TO INCLUDE ONE OF THESE!
954 DCA ACX
955 AC2000
956 DCA ACH
957 JMP FPREST
958
959FSAVPC, 0
960SAVAPT, 0
961STEFLG, 0
962\f/RANDOM FPP CODE FOR D.P. I/O
963DFSTM2, FSTA+LONG
964 DFTMP2
965 FEXIT
966
967 PAGE
968\f/THIS IS DOUBLE PRECISION FORMATTED OUTPUT.
969/ITS A LOT LIKE SINGLE PRECISION,WITHOUT ALL THE G + I STUFF
970/AND, OH JOY!, NO PAGE 0 LITERALS.
971DNXT, TAD RWFLAG /READ OR WRITE?
972 SMA CLA
973 AC4000 /ITS INPUT SO LEAVE IN STARTE MODE
974 JMS I (GETLMN
975 JMP .+3
976DFMT, STA
977BFMT, DCA EFLG
978 TAD D
979 DCA OD /SAVE COUNT OF DIGITS AFTER DEC PT
980 TAD PFACT
981 DCA PFACTX
982 DCA SCALE
983 JMS I (SKPOUT /DONE?
984 JMP I (DPIN /ITS INPUT
985 STA /ITS OUTPUT
986 DCA I (FFNEG /USE THIS LOCN AS SIGN FLAG
987 TAD EFLG
988 CLL RAL
989 CLL RAL
990 TAD W /GIVE ROOM FOR EXP FIELD (IF ANY)
991 CLL /NECESSARY?
992 DCA I (OW
993 TAD ACH
994 SNA
995 JMP SKPZRO /IF AC 0,SKIP ALOT OF THIS
996 SMA CLA
997 JMP DSCLUP
998 JMS I (DFNEG /AC<0-NEGATE IT
999 DCA I (FFNEG / 0 <> 7777
1000DSCLUP, DCA SCALE
1001 TAD ACX
1002 SMA SZA CLA /AC<1.0?
1003 JMP DGT1 /NO
1004 AC4000 /STARTE
1005 JMS I (FPGO /Y-MULT BY 10.
1006 FMUL10
1007 STA
1008 TAD SCALE /BUMP POWER OF TEN
1009 JMP DSCLUP
1010DGT1, JMS I (DSCLDN /NUMBER IS >=1.;NOW DECREASE IT TO (0,1)
1011 AC4000
1012 JMS I (FPGO /SAVE IT
1013 FSTTMP
1014 TAD (22
1015 JMS I (OSCALE
1016 AC4000
1017 JMS I (FPGO
1018 FADTMP
1019 JMS I (DSCLDN
1020\fSKPZRO, JMS I (DIGCNT /NO NEED FOR ALL THE G STUFF TO BE
1021 /INCLUDED IN THE SINGLE PREC ROUTINE
1022 /MAKE NOTG ROUTINE A SUBROUTINE
1023 SMA /EQUIV TO OUTNUM IN SINGLE PREC
1024 JMP DASTRS
1025 JMS I (OBLNKS
1026 AC7775
1027 ISZ I (FFNEG /IF SIGN IS NEG,
1028 JMS I (DIGIT /PRINT A MINUS
1029 CLA
1030 TAD ACX
1031 SNA /ALIGN FAC MANTISSA INTO A
1032 JMS I (DAL1 /FRACTION (.1,1)
1033 IAC
1034 SPA
1035 JMS I (DACSR
1036 CLA
1037 TAD EAC3
1038 DCA AC1 /MOVE FAC DOWN SO OVERFLOW FROM
1039 TAD EAC2 /MULT BY 10 IN HIGH ORDER WORD
1040 DCA EAC3
1041 TAD EAC1
1042 DCA EAC2
1043 TAD ACL
1044 DCA EAC1
1045 TAD ACH
1046 DCA ACL
1047 TAD SCALE
1048 SPA SNA /ANY DIGITS TO LEFT OF DEC PT?
1049 JMP I (DPRZRO /N-PRINT A 0
1050/JUST AS CHEAP TO DUPLICATE CODE
1051 JMS I (DBLDIG /Y- PRINT THEM
1052\fDRDCPT, AC7776
1053 JMS I (DIGIT /PRINT A DEC PT
1054 TAD SCALE
1055 SMA CLA /NEED LEADING ZEROS?
1056 JMP DNOLZR /NO
1057 TAD SCALE
1058 DCA T
1059DLZERO, STA CLL
1060 TAD OD /DECREASE D VALUE
1061 SNL
1062 JMP DNOMAC /NO MORE FIELD WIDTH AVAILABLE
1063 DCA OD
1064 JMS I (DIGIT /PRINT A 0
1065 ISZ T /CONT UNTIL COUNT OR WIDTH RUNS OUT
1066 JMP DLZERO
1067DNOLZR, TAD OD
1068 SZA
1069 JMS I (DBLDIG /PRINT REMAINING DIGITS
1070DNOMAC, CLA
1071 TAD EFLG
1072 SZA /IF EFLG IS NOT ZERO IT IS -1,
1073 JMS I (EXPFLD /SO WE WILL PRINT A D INSTEAD OF AN E
1074 JMP I (DNXT
1075
1076DASTRS, CLA
1077 TAD W
1078 JMS I (ASTRSK
1079 JMP I (DNXT
1080 PAGE
1081\fDBLDIG, 0 /OUTPUT DIGITS
1082 CIA
1083 DCA T
1084DBDLOP, DCA ACH /0 THE HI WORD FOR OVERFLO
1085 TAD AC1
1086 DCA AC2 /START TO COPY THE FAC.THIS IS
1087 TAD ACL /EAC3 SHIFTED DOWN 1 WORD
1088 DCA OPL
1089 TAD EAC1
1090 DCA L1 /ACL
1091 TAD EAC2
1092 DCA DACSR /EAC1
1093 TAD EAC3
1094 DCA DSCLDN /EAC2
1095 JMS DAL1
1096 JMS DAL1
1097 CLL
1098 TAD AC2
1099 TAD AC1
1100 DCA AC1 /THIS IS FAC*5 COMING UP
1101 RAL
1102 TAD DSCLDN
1103 TAD EAC3
1104 DCA EAC3
1105 RAL
1106 TAD DACSR
1107 TAD EAC2
1108 DCA EAC2
1109 RAL
1110 TAD L1
1111 TAD EAC1
1112 DCA EAC1
1113 RAL
1114 TAD OPL
1115 TAD ACL
1116 DCA ACL
1117 RAL
1118 TAD ACH
1119 DCA ACH
1120 JMS DAL1
1121 TAD ACH
1122 JMS I (DIGIT
1123 ISZ T
1124 JMP DBDLOP
1125 JMP I DBLDIG
1126\fDSCLDN, 0 /USED AS A TEMP TOO
1127 TAD ACX
1128 SPA SNA CLA
1129 JMP I DSCLDN /DONE IF FAC<1.
1130 AC4000
1131 JMS I (FPGO
1132 FDIV10
1133 ISZ SCALE
1134 0 /A FREE LOCN!
1135 JMP DSCLDN+1
1136
1137DPRZRO, CLA
1138 JMS I (DIGIT
1139 JMP I (DRDCPT
1140/6 WORD FAC LEFT SHIFT
1141DAL1, 0
1142 TAD AC1 /GET OVERFLO BIT
1143 CLL RAL /SHIFT LEFT
1144 DCA AC1
1145 TAD EAC3 /CONTINUE WORKING WAY UP THRU MANTISSA
1146 RAL
1147 DCA EAC3
1148 TAD EAC2
1149 RAL
1150 DCA EAC2
1151 TAD EAC1
1152 RAL
1153 DCA EAC1
1154 TAD ACL
1155 RAL
1156 DCA ACL
1157 TAD ACH
1158 RAL
1159 DCA ACH
1160 JMP I DAL1
1161
1162DFLTM2, FLDA+LONG
1163 DFTMP2
1164 FEXIT
1165DFTMP2, 0;0;0;0;0;0
1166\f/6 WORD FAC RIGHT SHIFT. ENTER WITH COUNT-1 IN AC
1167/
1168DACSR, 0 /USED AS A TEMP BY DBDLOP
1169 DCA AC0 /STORE COUNT
1170DLOP1, TAD ACH
1171 CLL
1172 SPA /PROPOGATE SIGN
1173 CML
1174 RAR
1175 DCA ACH /SHIFT RIGHT 1,PROPOGATE SIGN
1176 TAD ACL /DO SHIFTING FOR EACH WORD OF MANTISSA
1177 RAR
1178 DCA ACL
1179 TAD EAC1
1180 RAR
1181 DCA EAC1
1182 TAD EAC2
1183 RAR
1184 DCA EAC2
1185 TAD EAC3
1186 RAR
1187 DCA EAC3
1188 ISZ ACX /INCREMENT EXPONENT
1189 NOP
1190 ISZ AC0 /DONE?
1191 JMP DLOP1 /NOPE
1192 RAR /YUP
1193 DCA AC1 /SAVE 1 BIT OF OVERFLOW
1194 JMP I DACSR
1195L1, 0
1196 PAGE
1197\f/THIS IS DOUBLE PRECISION INPUT (WITH FPP ONLY)
1198/IT IS A LOT LIKE SINGLE PRECISION INPUT, BUT USES
1199/ITS OWN FPP ROUTINES.
1200DPIN, STA
1201 DCA DDPSW /INITIALIZE DEC. PT. SWITCH
1202 STA
1203 DCA DINESW /AND EXPONENT SWITCH
1204 TAD W
1205 CMA
1206 DCA FMTNUM /CHAR COUNT
1207DINESM, DCA ACX /CLEAR FLOATING AC
1208 DCA ACH
1209 DCA ACL
1210 DCA EAC1
1211 DCA EAC2
1212 DCA EAC3
1213 STA
1214DINMIN, DCA DFNEG
1215DINLOP, ISZ FMTNUM
1216 JMP DINGCH /LOOP UNTIL WIDTH EXHAUSTED
1217DINENM, ISZ I (DFNEG /IS SIGN NEGATIVE?
1218 JMS I (DFNEG /YES-NEGATE
1219 ISZ DINESW /SEEN A D YET?
1220 JMP DFIXUP /YES-THIS IS EXP,NOT NUMBER
1221 TAD PFACTX /NO D- SCALE WITH P FACTOR
1222DSCLIN, TAD OD /GET SCALING FACTOR
1223 STL
1224 SNA
1225 JMP I (DNXT /NO SCALING NEEDED
1226 SMA
1227 CIA CLL /AC CONTAINS MAGNITUDE,LINK CONTAINS SIGN
1228 DCA OD
1229 RTL
1230 RAL
1231 TAD (FDIV10
1232 DCA DIGFOP
1233 AC4000
1234 JMS I (FPGO /MULT OR DIVIDE BY 10
1235DIGFOP, 0
1236 ISZ OD
1237 JMP DIGFOP-2 /MULT OR DIV CORRECT NUMBER OF TIMES
1238 JMP I (DNXT /GET MORE
1239DIND, ISZ DINESW /IS THERE A 2ND D?
1240 JMP DINER /Y-A NO-NO
1241 ISZ DDPSW /FORCE DEC. PT. SWITCH ON
1242 TAD OD /USE SCALE FACTOR IF SEEN DEC. PT
1243 DCA SCALE /SAVE SCALE FACTOR
1244 ISZ DFNEG
1245 JMS DFNEG /GET SIGN OF NUMBER
1246 AC4000
1247 JMS I (FPGO /SAVE IT TEMPORARILY
1248 DFSTM2
1249 JMP DINESM /GO COLLECT EXP
1250\fDFIXUP, JMS I (FFIX /IS THIS OK FOR DBL PREC???
1251 TAD ACI
1252 CIA
1253 TAD SCALE /ADD EXP TO DEC PT SCALE FACTOR
1254 DCA OD
1255 AC4000
1256 JMS I (FPGO
1257 DFLTM2 /GET NUMBER BACK IN FAC
1258 JMP DSCLIN
1259DINGCH, JMS I (FMTIN /GET A CHAR
1260 JMS I (CHTYPE /CLASSIFY IT
1261 1234; DDIGIT
1262 -56; DIDCPT /.
1263 -53; DINLOP /+
1264 -55; DINMIN /-
1265 -4; DIND /D
1266 -5; DIND /E - BE FORGIVING
1267 -40; DINLOP /BLANK
1268 -54; DINENM /,
1269 0
1270DINER, JMP I (INER
1271
1272DIDCPT, DCA OD /ZERO COUNT OF DIGITS AFTER DEC PT
1273 ISZ DDPSW /TEST + SET DEC PT SWITCH
1274 JMP DINER /2 DEC. PT. IS NO GOOD
1275 JMP DINLOP
1276DDIGIT, TAD CHCH
1277 DCA I (DGT+1 /SAVE DIGIT
1278 AC4000
1279 JMS I (FPGO
1280 ACMDGT
1281 TAD DDPSW
1282 SNA CLA
1283 ISZ OD /BUMP DIGIT IF DEC PT SEEN
1284 JMP DINLOP
1285DDPSW, 0
1286\f/6 WORD FLOATING NEGATE
1287
1288DFNEG, 0
1289 TAD EAC3
1290 CLL CMA IAC /NEGATE LOW ORDER WORD OF MANTISSA
1291 DCA EAC3 /STORE IT BACK
1292 CML RAL /ADJUST OVERFLOW+CARRY
1293 TAD EAC2 /CONTINUE WITH REST OF MANTISSA
1294 CMA IAC
1295 DCA EAC2
1296 CML RAL
1297 TAD EAC1
1298 CMA IAC
1299 DCA EAC1
1300 CML RAL
1301 TAD ACL
1302 CMA IAC
1303 DCA ACL
1304 CML RAL
1305 TAD ACH
1306 CLL CMA IAC
1307 DCA ACH
1308 JMP I DFNEG
1309DINESW, 0
1310 PAGE
1311\f *FPPKG /EAE PKG LOADS OVER REGULAR PKG
1312
1313LPBUF2, ZBLOCK 16
1314 LPBUF5
1315
1316AL1BMP, 0 /*K* MUST BE AT SAME LOC AS NON-EAE VERSION
1317 STA
1318 TAD ACX
1319 DCA ACX
1320 JMS I (AL1
1321 JMP I AL1BMP
1322
1323/EAE FLOATING POINT INTERPRETER
1324/FOR PDP8/E WITH KE8-E EAE
1325
1326/W.J. CLOGHER, MODIFIED BY R.LARY FOR FORTRAN
1327
1328/FLOATING MULTIPLY--DOES 4 SINGLE MULTIPLIES WITH EAE
1329/THIS USES THE FACT THAT IF AC IS NON-ZERO WHEN YOU DO
1330/A MUY INSTR, THE AC IS ADDED TO RESULT OF THE MULTIPLY.
1331/(IN THE LOW ORDER, NATCHERLY)
1332
1333DDMPY, JMS I (DARGET
1334 SKP
1335FFMPY, JMS I (ARGET
1336 JMS EMDSET /SET UP FOR MULT
1337 CLA MUY /MULTIPLY-LOW ORDER FAC STILL IN MQ
1338 OPH /THIS IS PRODUCT OF LOW ORDERS
1339 MQL /ZAP LOW ORDER RESULT-INSIGNIFICANT
1340 TAD ACH /GET LOW ORDER(!) OF FAC
1341 SWP MUY /TO MQ-HIGH ORD. RESLT OF LAST MPY
1342 OPL /TO AC-WILL BE ADDED TO RESLT-THIS
1343 DST /IS PRODUCT-LOW ORD FAC,HI ORD OP
1344 AC0 /STORE RESULT
1345 CLA
1346 TAD ACL /HIGH ORDER FAC TO MQ
1347 MQL
1348 TAD OPX /GET OPERAND EXPONENT
1349 TAD ACX /ADD FAC EXPONENT-GET SUM OF EXPS.
1350 DCA ACX /STORE RESULT
1351 MUY /MUL. HIGH ORDER FAC BY LOW ORD OP.
1352 OPH /HIGH ORDER FAC WAS IN MQ
1353 DAD /ADD IN RESULT OF SECOND MULTIPLY
1354 AC0
1355 DCA ACH /STORE HIGH ORDER RESULT
1356 TAD ACL /GET HIGH ORDER FAC
1357 SWP /SEND IT TO MQ AND LOW ORD. RESULT
1358 DCA AC0 /OF ADD TO AC-STORE IT
1359 RAL /ROTATE CARRY TO AC
1360 DCA ACL /STORE AWAY
1361 MUY /NOW DO PRODUCT OF HIGH ORDERS
1362 OPL /FAC HIGH IN MQ, OP HIGH IN OPL
1363 DAD /ADD IN THE ACCUMULATED #
1364 ACH
1365\f/MULTIPLIES DONE - MASSAGE RESULT
1366
1367 SNA /ZERO?
1368 JMP RTZRO /YES-GO ZERO EXPONENT
1369 NMI /NO-NORMALIZE (1 SHIFT AT MOST!)
1370 DCA ACH /STORE HIGH ORDER RESULT
1371 CLA SCA /GET STEP CNTR-DID WE NEED A SHIFT?
1372 SNA CLA
1373 JMP SNCK /NO-JUST CHECK SIGN
1374 TAD AC0 /YES - WATCH OUT FOR LOST ACCURACY!
1375 RAL
1376 DCA AC0
1377 SZL /IF HIGH ORDER BIT OF OVERFLOW WORD WAS ON,
1378 DPIC /TURN MQ11 ON (IT WAS 0 FROM THE NMI)
1379 CLA CMA /MUST DECREASE EXP. BY 1
1380 TAD ACX
1381RTZRO, DCA ACX /STORE BACK
1382SNCK, TAD AC0
1383 SPA CLA /IS HIGH ORDER OF OVERFLO WD. 1?
1384 DPIC /YES-ADD 1 TO LOW ORDER-STILL IN MQ
1385 TAD ACH
1386 SMA
1387 JMP EMDONE /WE DIDN'T OVERROUND - GOODY
1388 LSR
1389 1 /BUT OVERROUNDING IS EASILY CORRECTED!
1390 ISZ ACX / (OVERCORRECTED??)
1391 NOP
1392
1393/COMMON CLEANUP ROUTINE FOR MULTIPLY AND DIVIDE
1394
1395EMDONE, ISZ EMSIGN /SHOULD SIGN BE MINUS?
1396 SKP /NO
1397 DCM /YES-DO IT
1398 SNA
1399 DCA ACX /FORCE EXPONENT 0 IF MANTISSA = 0
1400 DCA ACH /STORE IT BACK
1401 SWP
1402 DCA ACL
1403 TAD DFLG
1404 SMA SZA CLA
1405 TAD ACX /IF D.P. INTEGER MODE AND ACX LESS THAN 0,
1406 SNA /GO TO UNNORMALIZE RESULT
1407 JMP I FPNXT /OTHERWISE BUMP RETN. AND RETN.
1408 CMA
1409 JMS I (ACSR
1410 JMP I FPNXT
1411EMSIGN, 0
1412\f/ROUTINE TO SET UP FOR MULTIPLY AND DIVIDE
1413
1414EMDSET, 0
1415 CLA CLL CMA RAL /MAKE A MINUS TWO
1416 DCA EMSIGN /AND STORE IN EMSIGN.
1417 DLD /GET HIGH ORDER MANTISSA OF OP.
1418 OPH
1419 SWP
1420 SMA /NEGATIVE?
1421 JMP .+3 /NO
1422 DCM /YES-NEGATE IT
1423 ISZ EMSIGN /BUMP SIGN COUNTER
1424 SHL /SHIFT OPRND LEFT 1 TO AVOID OVRFLO
1425 1
1426 DST /STORE BACK-OPH CONTAINS LOW ORDER
1427 OPH / OPL CONTAINS HIGH ORDER
1428 DLD
1429 ACH
1430 SWP
1431 SMA /FAC LESS THAN 0?
1432 JMP .+4 /NO
1433 DCM
1434 ISZ EMSIGN
1435 NOP /EMSIGN MAY BUMP TO 0
1436 DST /STORE BACK - ACH CONTAINS LOW ORDER
1437 ACH / ACL CONTAINS HIGH ORDER
1438 JMP I EMDSET
1439 PAGE
1440\f/FLOATING DIVIDE-BY-0 ROUTINE - MUST BE AT 0 IN PAGE
1441
1442DBAD, ISZ FATAL /DIVIDE BY 0 NON-FATAL
1443 JMS I ERR
1444 TAD DBAD
1445 DCA ACX /SET AC TO A LARGE POSITIVE NUMBER
1446 AC2000
1447 JMP I (EMDONE
1448
1449/FLOATING DIVIDE
1450
1451DDDIV, JMS I (DARGET
1452 SKP
1453FFDIV, JMS I (ARGET
1454 JMS I (EMDSET /GET ARG. AND SET UP SIGNS
1455 DVI /DIVIDE-ACH AND ACL IN AC,MQ
1456 OPL /THIS IS HI (!) ORDER DIVISOR
1457 DST /QUOT TO AC0,REM TO AC1
1458 AC0
1459 SZL CLA /DIVIDE ERROR?
1460 JMP DBAD /YES - HANDLE IT
1461 TAD OPX /DO EXPONENT CALCULATION
1462 CMA IAC /EXP. OF FAC - EXP. OF OP
1463 TAD ACX
1464 DCA ACX
1465 DPSZ /IS QUOT = 0?
1466 SKP /NO-GO ON
1467 DCA ACX /YES-ZERO EXPONENT
1468DVLP, MUY /NO-THIS IS Q*OPL*2**-12
1469 OPH
1470 DCM /NEGATE IT
1471 TAD AC1 /SEE IF GREATER THAN REMAINDER
1472 SNL
1473 JMP EDVOPS /YES-ADJUST FIRST DIVIDE
1474 DVI /NO-DO Q*OPL*2**-12/OPH
1475 OPL
1476 SZL CLA /DIV ERROR?
1477 JMP DBAD /YES
1478EDVLP1, TAD AC0 /NO-GET QUOT OF FIRST DIV.
1479 SMA /NEGATIVE?
1480 JMP I (EMDONE /NO-REMEMBER-QUOT OF 2ND DIV. IN MQ
1481 LSR /YES-MUST SHIFT IT RIGHT 1
1482 1
1483 ISZ ACX /ADJUST EXPONENT
1484 NOP
1485 SGT /TEST SHIFTED OUT BIT
1486 JMP I (EMDONE /ZERO - NO ROUND
1487 DPIC /BUMP AC FRACTION
1488 JMP EDVLP1+1 /MAYBE SHIFT AGAIN
1489\f/CONTINUATION OF DIVIDE ROUTINE
1490/WE ARE ADJUSTING THE RESULT OF THE
1491/FIRST DIVIDE.
1492
1493EDVOPS, CMA IAC
1494 DCA AC1 /ADJUST REMAINDER
1495 TAD OPL /WATCH FOR OVERFLOW
1496 CLL CMA IAC
1497 TAD AC1
1498 SNL
1499 JMP EDVOP1 /DON'T ADJUST QUOT.
1500 DCA AC1
1501 CMA
1502 TAD AC0
1503 DCA AC0 /REDUCE QUOT BY 1
1504EDVOP1, CLA CLL
1505 TAD AC1 /GET REMAINDER
1506 SNA /ZERO?
1507 CAM /YES-ZERO EVERYTHING
1508 DVI /NO
1509 OPL
1510 SZL CLA /DIV. OVERFLOW?
1511 JMP DBAD /YES
1512 DCM /NO-ADJUST HI QUOT (MAYBE)
1513 JMP EDVLP1 /GO BACK
1514
1515/ROUTINE TO NORMALIZE THE FAC
1516
1517EFFNOR, 0
1518 CDF 0
1519 DLD /PICK UP MANTISSA
1520 ACH
1521 SWP /PUT IT IN CORRECT ORDER
1522 NMI /NORMALIZE IT
1523 SNA /IS THE # ZERO?
1524 DCA ACX /YES-INSURE ZERO EXPONENT
1525 DCA ACH /STORE HIGH ORDER BACK
1526 SWP /STORE LOW ORDER BACK
1527 DCA ACL
1528 CLA SCA /STEP COUNTER TO AC
1529 CMA IAC /NEGATE IT
1530 TAD ACX /AND ADJUST EXPONENT
1531 DCA ACX
1532 JMP I EFFNOR /RETURN
1533
1534ADDRS, OPH
1535 ACH
1536
1537LPBUF5, ZBLOCK 50
1538 LPBUF7
1539 PAGE
1540\f/"OPNEG" MUST BE AT 0 IN PAGE
1541
1542OPNEG, 0 /ROUTINE TO NEGATE OPERAND
1543 DLD
1544 OPH
1545 SWP
1546 DCM
1547 DCA OPH
1548 MQA
1549 DCA OPL
1550 JMP I OPNEG
1551
1552/FLOATING ADD AND SUBTRACT-IN ORDER NOT TO LOSE BITS,
1553/WE DO NOT SHIFT BOTH NUMBERS RIGHT 1 BIT BEFORE ADD-
1554/ONLY SHIFTS DONE ARE TO ALIGN EXPONENTS.
1555
1556FFSUB, JMS I (ARGET
1557 JMS OPNEG /NEGATE OPERAND
1558 SKP
1559FFADD, JMS I (ARGET /PICK UP ARGUMENTS
1560 TAD OPH
1561 SNA CLA /IF OPERAND IS 0,
1562 JMP I FPNXT /RESULT IS ALREADY IN AC.
1563 TAD ACH
1564 SZA CLA /CHECK FOR AC=0
1565 JMP BOTHN0 /NO
1566 DLD
1567 OPH /YES - ANSWER IS OPERAND
1568 SWP
1569 DCA ACH
1570 JMP FADND /JUMP INTO CLEANUP CODE
1571BOTHN0, TAD OPX /PICK UP EXPONENT OF OPERAND
1572 MQL /SEND IT TO MQ FOR SUBTRACT
1573 TAD ACX /GET EXPONENT OF FAC
1574 SAM /SUBTRACT-RESULT IN AC
1575 SPA /NEGATIVE RESULT?
1576 CMA IAC /YES-MAKE IT POSITIVE
1577 DCA CNT /STORE IT AS A SHIFT COUNT
1578 TAD CNT /COUNT TOO BIG?(CAN'T BE ALIGNED)
1579 TAD (-27
1580 SPA SNA CLA
1581 CMA /NO-OK
1582 DCA AC0 /YES-MAKE IT A LOAD OF LARGEST #
1583 DLD /GET ADDRESSES TO SEE WHO'S SHIFTED
1584 ADDRS
1585 SGT /WHICH EXP GREATER(GT FLG SET
1586 /BY SUBTR. OF EXPS.)
1587 SWP /OPERAND'S-SHIFT THE FAC
1588 DCA SHFBG /STORE ADDRESS OF WHO GETS SHIFTED
1589 SWP /GET ADDRESS OF OTHER (0 TO MQ)
1590 DCA DADR /THIS ONE JUST GETS ADDED
1591 TAD ACX /GET FAC EXP.INTO AC
1592 SGT /WHICH EXPONENT WAS GREATER?
1593 DCA OPX /FAC'S-STORE FINAL EXP. IN OPX
1594\f DLD /GET THE LARGER # TO AC,MQ
1595DADR, 0
1596 SWP /PUT IN THE RIGHT ORDER
1597 ISZ AC0 /COULD EXPONENTS BE ALIGNED?
1598 JMP LOD /NO-JUST LEAVE LARGER IN AC,MQ
1599 DST /YES-STORE THIS TEMPORARILY
1600 AC0 /(IF ONLY FAC STORAGE WAS REVERSED)
1601 DLD /GET THE SMALLER #
1602SHFBG, 0
1603 SWP /PUT IT IN RIGHT ORDER
1604 ASR /DO THE ALIGNMENT SHIFT
1605CNT, 0
1606 DAD /ADD THE LARGER #
1607 AC0
1608 DST /STORE RESULT
1609 AC0
1610 SZL /OVERFLOW?(L NOT = SIGN BIT)
1611 CMA /NOTE-WE DIDN'T SHIFT BOTH RIGHT 1
1612 SMA CLA
1613 JMP NOOV /NOPE
1614 CLA CLL CML RAR /MAYBE-SEE IF 2 #S HAD SAME SIGN
1615 AND ACH
1616 TAD OPH
1617 SMA CLA /SIGNS ALIKE?
1618 JMP OVRFLO /YES-OVERFLOW
1619NOOV, AC4000 /NO-GET HIGH ORDER RESULT BACK
1620 TAD AC1 /CHECK FOR 4000 0000 MANTISSA
1621 DPSZ /IT WILL BE SET TO 0 BY NMI
1622 JMP .+3 /OK-RESTORE NUMBER
1623 AC2000 /GOT A 4000 0000-SET TO 6000 0000
1624 JMP DOIT /AND INCREMENT EXPONENT
1625 TAD (4000 /RESTORE NUMBER
1626LOD, NMI /NORMALIZE (LOW ORDER STILL IN MQ)
1627 DCA ACH /STORE FINAL RESULT
1628 SCA /GET SHIFT COUNTER(# OF NMI SHIFTS)
1629 CMA /NEGATE IT
1630ADON, IAC
1631FADND, TAD OPX /AND ADJUST FINAL EXPONENT
1632 DCA ACX
1633 SWP /GET AND STORE LOW ORDER
1634 DCA ACL
1635 JMP I FPNXT /RETURN
1636OVRFLO, TAD AC1 /OVERFLOW-GET HIGH ORDER RESLT BACK
1637 ASR /SHIFT IT RIGHT 1
1638 1
1639DOIT, TAD (4000 /REVERSE SIGN BIT
1640 DCA ACH /AND STORE
1641 JMP ADON /DONE
1642
1643LPBUF7, ZBLOCK 34
1644 LPBUFE
1645 PAGE
1646\f *7400 /RTS CLEANUP ROUTINE - SAVED WITH PG 17600
1647
1648CLNUP, DCA I CFPTR /ENTER HERE ON ^C OR ERROR
1649TDEXFG, JMP CTMP /ENTER HERE ON "STOP" OR "CALL EXIT"
1650 TAD TDEXFG /TDEXFG CONTAINS TOP MEM FIELD
1651 CLL RTL /IF WE ARE ON AN IN-CORE TD8E CONFIGURATION
1652 RAL
1653 TAD (CDF
1654 DCA TDGTDF
1655TDGTDF, HLT
1656 TAD I TDPTR /MOVE THE TD8E ROUTINE
1657 CDF 20
1658 DCA I TDPTR /DOWN TO FIELD 2
1659 ISZ TDPTR
1660 JMP TDGTDF
1661 CDF 0
1662 TAD (CIF 20
1663 JMS TDSET /RESET THE F0 CDF'S TO POINT TO FIELD 2
1664CTMP, CDF 0
1665 TAD (6213
1666 DCA I (7605
1667 TAD (5267
1668 DCA I (7606 /RESTORE PAGE 7600
1669 AC7776
1670 AND I (OSJSWD
1671 IAC
1672 DCA I (OSJSWD /MARK 10000-11777 AS USELESS
1673 AND I 0
1674 AND I 0 /DELAY A WHILE IN CASE ITS AN LA30
1675 AND I 0
1676 AND I 0
1677 AND I 0
1678 TSF
1679 SKP
1680 JMP WTOVR
1681 ISZ ZERO
1682 TAD I (TOCHR /IF TTY IS NOT IDLE,
1683 SZA CLA /DELAY LONG ENOUGH TO AVOID GARBLE.
1684 JMP CTMP
1685WTOVR, TAD I (7777
1686 CLL RAL
1687 SMA CLA /IS BATCH EXECUTING?
1688 JMP NOBTCH /NO - RELAX
1689 TAD (212 /TO PREVENT OVERPRINTING, POP UP A LINE
1690 TLS /ON THE TELETYPE
1691 LLS /AND ON THE LINE PRINTER
1692 TSF
1693 JMP .-1 /WAIT FOR THE SLOWER ONE (I HOPE)
1694 CLA
1695\fNOBTCH, CDF 10
1696CLOSLP, TAD I CFPTR
1697 SNA /ANY MORE ENTRIES IN THE TENTATIVE
1698 JMP GOAWAY /FILE TABLE?
1699 DCA CTMP /YES - SAVE FILE LENGTH PTR
1700 CDF 0
1701 TAD I CTMP
1702 CDF 10
1703 SNA
1704 JMP IGNORC /UNWRITTEN FILES AREN'T CLOSED
1705 DCA FLEN
1706 JMS I USR
1707 10 /BRING USR IN
1708 TAD (200
1709 DCA USR /KEEP IT IN
1710 TAD (HPLACE+1
1711 DCA CHAND
1712 JMS I USR
1713 13 /RESET DEVICE HANDLER TABLE
1714 0 /BUT NOT TENTATIVE FILES!
1715 ISZ CFPTR
1716 TAD I CFPTR /GET UNIT NUMBER
1717 JMS I USR
1718 1
1719CHAND, 0 /FETCH HANDLER
1720 JMP CLSERR
1721 TAD I CFPTR /GET UNIT AGAIN
1722 ISZ CFPTR /BUMP PTR TO NAME
1723 JMS I USR
1724C4, 4
1725CFPTR, 7600 /CLOSE THE FILE
1726FLEN, 0
1727 JMP CLSERR
1728 SKP
1729IGNORC, AC0002
1730 TAD CFPTR
1731 TAD C4
1732 DCA CFPTR
1733 JMP CLOSLP /LOOK FOR MORE
1734
1735TDSET, 0
1736 DCA I (7721
1737 TAD I (7721
1738 DCA I (7727
1739 TAD I (7721
1740 IAC
1741 DCA I (7642
1742 JMP I TDSET
1743\fGOAWAY, CDF CIF 0
1744 JMP I (7605 /RETURN TO OS/8 AQAP
1745CLSERR, JMS I USR /"IMPOSSIBLE" ERROR - GIVE "USER ERROR 2"
1746 7
1747 2 /IT'S BETTER THAN HALTING
1748
1749TDPTR, 7600
1750ZERO, 0
1751USR, 7700
1752 $$$-$$$-$$$
1753\f