3 / VERSION 5A PT 16-MAY-77
14 /COPYRIGHT (C) 1974, 1975
15 /DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
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.
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.
32 /DEC ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
33 /SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DEC.
40 \f/FORTRAN 4 RTS LOADER - RL
41 /WITH DOUBLE PRECSION - MKH
42 /AND RTS-8 SUPPORT - R. LARY
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)
51 /PAGE 0 LOCATIONS FOR RTS LOADER
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.
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.
78 F0HSAV= 7000 /400 WORDS WHERE DEVICE HANDLERS ARE TEMPORARILY SAVED
79 /SO THAT THEY WON'T INITIALIZE THEMSELVES WRONG
84 IONTBL, ZBLOCK 100 /INTERRUPT ENABLE TABLE - LOW BIT ONLY
85 HCWTBL, ZBLOCK 14 /HANDLER CONTROL WORD - ONE PER PAGE (LOTSA WASTE)
86 TFTABL, ZBLOCK 45 /TENTATIVE FILE SAVE TABLE
87 DVTEMP, ZBLOCK 17 /HANDLER ENTRY TABLE SAVE AREA
93 *IONTBL+6 /RF08 IN 4 FLAVORS
96 2 /FORMS CONTROL ON TTY
98 2 /FORMS CONTROL ON LPT
106 RTSLDR, JMS I (RTINIT
107 JMS I (RTINIT /INITIALIZE WHETHER CHAINED TO OR NOT
111 1404 /.LD DEFAULT EXTENSION
112 NOCD, JMS I (TSTSWS /TEST /E,/P,/V AND /H SWITCHES
117 JMS I (GETHAN /GET HANDLER TO LOAD WITH
118 0 /DON'T PUT IT ANYWHERE
121 JMS I (SVHND /COPY HANDLER TO AVOID BAD INITIALIZATION
128 JMS I (RSTHND /RESTORE VIRGIN COPY OF HANDLER
138 SZA CLA /VERIFY LOADER IMAGE INPUT
139 JMP NOTLI /GOOD THING WE CHECKED!
141 TAD I (QDPFLG /CHECK IF TRYING TO USE D.P. WITHOUT OPTION
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
154 DCA I X1 /MOVE USER OVERLAY INFO INTO SWAP TABLE,
158 TAD LIBLK /RELOCATING THE BLOCK NUMBERS
165 AND (7770 /TURN THE LOADER INITIAL SWAP WORD
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.
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
185 6141 /TEST IF WE ARE ON A PDP-12
186 0261 /ROL I 1 - PUTS LINK IN AC11
188 DCA I (V8OR12+1-F0HBEG+F0TO
191 SPSTRT-1 /MOVE SPECIAL /P START CODE TO LOC 200
193 200-F0HBEG+F0TO-1 /(RELOCATED 200, THAT IS)
197 DPFPP, 3777 /0 IF D.P. FPP AVAILABLE
198 \fNOTLI, JMS I (RLERR
207 \f/FIGURE OUT CORE LIMITS AND WRITE OUT PG 17600
210 TAD HDIFF /GET BOTTOM OF HANDLER AREA
212 CLL /LENGTH OF HANDLER AREA IN AC
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
223 JMP TOOBIG /ALL THAT WORK FOR NOTHING!
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.
239 37 /SUITABLE SCRATCH BLOCK
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
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.
257 HCDF, HLT /MOVE A HANDLER WORD FROM FIELD 0
258 DCA I HDIFF /TO FIELD N
260 TAD I HPTR2 /MEANWHILE RESTORE FIELD 0
262 DCA I HPTR1 /FROM FIELD 1
264 JMP HLOOP /DO MORE THAN WE HAVE TO - IT CAN'T HURT
267 DCA I (7605 /SET UP OS/8 RETURN SEQUENCE TO TRAP TO RTS
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)
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
277 LP6652, 6652 /ALSO CLEAR ALL ANALEX FLAGS
279 6662 /CLEAR BUFFER ON ANALEX
281 DCA I (LPTERR /REPLACE LP08 ERROR CODE BY ANALEX
282 TAD LP6652 /TO AVOID HANGING ON ANALEX POWER OFF.
296 HPTR2, F0TO+F0HEND-F0HBEG
300 MOVE, 0 /GENERAL MOVE SUBROUTINE
332 ISZ RTINIT /SKIP RETURN
333 JMS I (BAKTST /SEE IF WE'RE RUNNING IN BACKGROUND UNDER RTS-8
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)
342 EAEKIL, SHL /ZERO THIS LOCATION TO INHIBIT EAE
343 CLA IAC /LOW ORDER BITS 01
345 SNA CLA /TEST FOR 8/E EAE
346 JMS I (MOVEAE /YES - SUBSTITUTE PACKAGES
348 FPST /START FPP ON "STARTE;FEXIT"
349 JMP NOFPP /DIDN'T START
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
359 JMP NOFPP /NO DOUBLE PRECISION
360 DCA I (DPFPP /SET FLAG TO INDICATE D.P. AVAILABLE
363 DCA I (DF /ENABLE D FORMAT
365 DCA I (BF /AND B FORMAT
371 F0TO-1 /MOVE LOWER F0 INTO F1 FOR SAFEKEEPING
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
379 TAD (-3 /CHECK FOR IN-CORE TD8E'S
386 DCA TD8EFG /SET TD8E FLAG WHICH IS ALSO CDF
389 TAD RICDF0 /GET THE FIELD WE'RE COMING FROM
393 JMS I (TDSET /REDO THE CDF'S IN F0
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
406 JMP TAKCAR /YES - UNIQUE PROBLEMS
409 JMP ONLY8K /YES - IGNORE BATCH & TD8E CRAP
410 JMS I (GBFLG /GET BATCH FLAG
412 SNA CLA /IF NO BATCH OR TD8E'S,
413 ONLY8K, TAD (200 /USE ALL OF THE LAST FIELD.
414 STOHDF, TAD (-F0HEND-200
415 DCA HDIFF /OTHERWISE USE ONLY UP TO 7600
417 \fTAKCAR, JMS I (GBFLG /GET BATCH FLAG
419 JMP NO32KB /NO BATCH - USE UP TO 77400 (TD8E ROM)
420 TAD (6 /BATCH - USE UP TO 67600
424 SNA CLA /IF IN-CORE TD8E'S
425 TAD (7600 /LIMIT IS 77600 ELSE 77400
428 \fGETHAN, 0 /GET HANDLER SUBROUTINE
436 NOP /ERROR RETURN ALWAYS SKIPPED
439 JMP NOTLDD /NOT IN CORE - MUST LOAD
441 GHEXIT, TAD I HCWPTR /GET CONTROL WORD FOR HANDLER PAGE
444 DCA HADR /ASSUME HANDLER PERMENANTLY RESIDENT
447 SNA CLA /WERE WE RASH?
451 TAD (HPLACE /YES - I APOLOGIZE
453 RESHAN, TAD I GETHAN /GET DSRN NUMBER
455 JMP I GETHAN /NO DSRN NUMBER
460 DCA X0 /XR POINTS TO DSRN ENTRY
463 DCA I X0 /SEE PG 0, FLD 0 FOR DSRN FORMAT
465 TAD CFLAG /THE C BIT REVERSES THE FORMS CTL BIT ON THIS FILE
466 AND (7773 /KILL ANY OVERFLOW
472 DCA I X0 /SAVE BUFFER ADDRESS, FIELD
474 DCA I X0 /INITIALIZE WORD POINTER
478 ISZ HGHFLD /BUMP DOUBLEWORD BUFFER ADDRESS
481 DCA I X0 /INITIALIZE CHAR CTR
484 \f/LOAD A NON-RESIDENT HANDLER
488 JMS GH /TRY 1-PAGE AND THEN 2-PAGE ASSIGN
494 TAD (7600 /BUMP HANDLER CEILING DOWN
496 JMP I (HNDERR /CAN'T PUT HANDLER IN PAGE 0
506 TAD GHADR /SAVE ACTUAL LOAD ADDRESS
507 JMS HCWTBA /INDEX INTO HCW TABLE
511 DCA GHADR /SAVE RELOCATED HANDLER PAGE ADDRESS
512 TAD MXFLD /PUT ADDR IN BITS 0-3 AND FIELD IN BITS 6-8
518 JMS I (GETION /ION BIT INTO BIT 11, FORMS CTL BIT INTO BIT 10
520 DCA I HCWPTR /STORE POINTER FOR THIS PAGE
530 DCA HCWPTR /SAVE POINTER INTO TABLE
537 SPSTRT, 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
543 \f/ROUTINE TO ACCEPT FILE SPECIFICATIONS
548 SPA CLA /ALTMODE MEANS NO MORE SPECS
550 GETFCD, JMS I (SPMDCD /CALL CD IN SPECIAL MODE
556 TAD I (OS8SWS+3 /NEITHER - HOW ABOUT INTERNAL HANDLER?
558 JMP GETFIL+1 /NONE OF THE ABOVE
559 RAR /LINK MAGICALLY TELLS DIRECTION
563 AND (777 /SWITCHES 1-9
570 JMP DNUMLP /TRANSLATE SWITCH INTO NUMBER
571 TAD DIR /** AC IS NEGATIVE **
575 DCA FPTR /POINT TO FILE UNIT
578 JMP INTHND /NO FILE - GET HANDLER FROM INTERNAL LIST
579 JMS I (GETHAN /GET HANDLER - XR10 POINTS INTO DSRN
580 DSRNUM, 0 /DSRN ENTRY NUMBER
582 STL RTL /GENERATE 2 OR 3 (LOOKUP OR ENTER)
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
593 LKPNTR, 0 /LOOKUP OR ENTER
595 FUNIT, 0 /GETS LENGTH
596 JMP FILERR /SOMETHING NOT KOSHER
597 JMS I (RSTHND /RESTORE VIRGIN COPY OF HANDLER
600 DCA I X0 /SAVE STARTING BLOCK
601 DCA I X0 /RELATIVE BLOCK
604 IAC /FUDGE NON-DIRECTORY DEVICES VERY LARGE
605 CIA /TURN NEGATIVE COUNT TO POSITIVE
608 DCA FPTR /SAVE PTR TO LENGTH WORD
611 SMA CLA /TENTATIVE FILE?
613 TAD FPTR /YES - STORE POINTER TO LENGTH WORD OF DSRN
614 DCA I TFPTR /IN TENTATIVE FILE TABLE ENTRY
619 TFPTR, TFTABL /SAVE FILE NAME AND UNIT IN
620 -5 /TENTATIVE FILE TABLE
623 DCA TFPTR /BUMP PTR TO NEXT 6-WORD ENTRY
625 \fNONUM, JMS I (RLERR
635 DCA FUNIT /ZERO BLOCK # AND LENGTH
636 JMP STDSRN /USE ENTIRE DEVICE AS FILE
640 AND (3 /ONLY USE LOW ORDER 2 BITS OF NUMBER
642 DCA HADR /SAVE PTR INTO TABLE OF INTL HANDLERS
646 TAD DSRNUM /MULTIPLY DSRN NUMBER BY 9
647 TAD (DSRN-11 /ADD TABLE BASE
654 TAD CFLAG /DEPENDING ON THE C FLAG,
656 DCA I DSRNUM /DISABLE OR ENABLE FORMS CONTROL
659 \fTSTSWS, 0 /ROUTINE TO TEST CD SWITCHES E AND H
663 SNA CLA /TEST FOR /H SWITCH
666 DCA I (HLTNOP /SET TO HALT BEFORE STARTING PROGRAM
670 SNA CLA /TEST FOR /V SWITCH
672 JMS I (RLERR /YES - PRINT VERSION NUMBER MESSAGE
677 SZA CLA /TEST FOR /E SWITCH
678 ISZ I (ERRFLG /MAKE USER ERRORS NON-FATAL
679 CDF 10 /(USER ERROR = MISSING SUBROUTINE, ETC)
683 SNA CLA /TEST FOR /P SWITCH
684 JMP .+3 /NO, PRAISE BE!
685 TAD (SKP /GIVE THE DUMMY WHAT HE WANTS
692 DCA CFLAG /SAVE C FLAG IN PAGE0
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
701 FPPKG-1 /THE EAE PKG IS IN THE SAME PAGE IN FIELD 1
703 FPPKG-1 /AS THE NON-EAE PKG IN FIELD 0
706 CDF 0 /SUBSTITUTE FAST FIX AND FLOAT
712 \fSPMDCD, 0 /SUBR TO DO A SPECIAL MODE COMMAND DECODE
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
721 SZL SPA CLA /DID WE LOAD ANY BELOW 02000?
724 ISZ I (OSJSWD /YES - MAKE CD CALLS DESTRUCTIVE
729 5200 /SPECIAL MODE - WROUGHT WITH PERIL
730 0 /DON'T CLEAR TENTATIVE FILES
736 -17 /MOVE DEVICE HANDLER TABLE BACK
737 JMS TSTSWS /CHECK FOR /E, /H, /P
740 IHTBL, PTR;PTP;LPT;TTY /INTERNAL HANDLER TABLE
745 TAD I GMADR /GET DCB WORD
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
756 TAD I (7777 /SPECIAL FLAGS LOC
762 SVHND, 0 /ROUTINE TO SAVE HANDLER IN F1
763 JMS GMADR /GET MOVE FROM ADDRESS
764 JMP I SVHND /NO HANDLER TO MOVE
774 RSTHND, 0 /ROUTINE TO RESTORE HANDLER FROM F1
776 JMP I RSTHND /HANDLER IS SYS:
788 SPA /CHECK THAT WE'RE NOT TRYING
789 JMP RESHND /TO SAVE A RESIDENT HANDLER -
790 AND RESHND /THAT COULD BE TRICKY
796 \f/RTS LOADER ERROR MESSAGE ROUTINE & MESSAGES
798 RLERR, 0 /ERROR MESSAGES ARE IN FIELD 0
821 JMP I RLERR /SOME MESSAGES ARE NOT FATAL
828 AND (77 /CONVERT SIXBIT TO EIGHTBIT
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
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
846 BAKLP, TAD I BKRPTR /GET POINTER TO BLOCK TO BE MODIFIED
848 JMP BAKRTN /ZERO - WE'RE DONE
849 DCA X0 /STORE IN AUTO-XR
851 BAKWLP, TAD I BKRPTR /GET NEXT WORD TO STORE
854 JMP BAKLP /ZERO MEANS END OF GROUP
857 BAKRTN, 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
865 \f/FLOATING POINT PROCESSOR HANDLER
868 RETURN, JMP FPPRTN /MUST BE AT 0 IN PAGE
870 FPGO, 0 /FPP STARTUP ROUTINE - MUST BE AT 1 IN PAGE
874 DCA FSAVPC /SAVE OLD PC FOR ONE LEVEL
876 DCA SAVAPT /OF RE-ENTRANTNESS
881 DCA APT /SET UP ADDRESS IN APT
882 FPREST, TAD (400 /ENABLE FPP INTERRUPTS
883 FPCOM /LOAD AND STORE ENTIRE APT
885 TAD STEFLG /0 OR 4000?(STARTF OR STARTE)
892 JMP .-1 /I HAVE NO IDEA WHY IT DIDN'T START
894 JMS I (HANG /EXECUTE BACKGROUND
896 FPRST /READ FPP STATUS
901 JMP TRAP /YUP - GO EXECUTE IT
906 DCA PC /RESTORE OLD PC
911 \f/FLOATING POINT TRAP PROCESSOR
915 DCA PC /BACK UP PC TO BEFORE THE TRAP
918 TAD APT /INCLUDING THE FIELD BITS
920 TAD APT /SET UP "FETPC" TO FETCH POSSIBLE TRAP ARGS
927 IAC /MAKE A "CDF CIF N"
931 DCA ADR /STORE PDP8-CODE ROUTINE ADDRESS
933 TRPCIF, 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
938 ISZ PC /RESTORE PC FROM BEFORE TRAP
940 ISZ APT /INCLUDING FIELD
942 JMP FPREST /RESTART FPP
945 JMP I (FPPERR /FPHALT - FATAL ERROR
947 ISZ FATAL /DIVIDE BY 0 AND OVERFLOW ARE NON-FATAL
953 TAD . /I ALWAYS WANTED TO INCLUDE ONE OF THESE!
962 \f/RANDOM FPP CODE FOR D.P. I/O
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.
971 DNXT, TAD RWFLAG /READ OR WRITE?
973 AC4000 /ITS INPUT SO LEAVE IN STARTE MODE
979 DCA OD /SAVE COUNT OF DIGITS AFTER DEC PT
984 JMP I (DPIN /ITS INPUT
986 DCA I (FFNEG /USE THIS LOCN AS SIGN FLAG
990 TAD W /GIVE ROOM FOR EXP FIELD (IF ANY)
995 JMP SKPZRO /IF AC 0,SKIP ALOT OF THIS
998 JMS I (DFNEG /AC<0-NEGATE IT
999 DCA I (FFNEG / 0 <> 7777
1002 SMA SZA CLA /AC<1.0?
1005 JMS I (FPGO /Y-MULT BY 10.
1008 TAD SCALE /BUMP POWER OF TEN
1010 DGT1, JMS I (DSCLDN /NUMBER IS >=1.;NOW DECREASE IT TO (0,1)
1012 JMS I (FPGO /SAVE IT
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
1027 ISZ I (FFNEG /IF SIGN IS NEG,
1028 JMS I (DIGIT /PRINT A MINUS
1031 SNA /ALIGN FAC MANTISSA INTO A
1032 JMS I (DAL1 /FRACTION (.1,1)
1038 DCA AC1 /MOVE FAC DOWN SO OVERFLOW FROM
1039 TAD EAC2 /MULT BY 10 IN HIGH ORDER WORD
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
1053 JMS I (DIGIT /PRINT A DEC PT
1055 SMA CLA /NEED LEADING ZEROS?
1060 TAD OD /DECREASE D VALUE
1062 JMP DNOMAC /NO MORE FIELD WIDTH AVAILABLE
1064 JMS I (DIGIT /PRINT A 0
1065 ISZ T /CONT UNTIL COUNT OR WIDTH RUNS OUT
1069 JMS I (DBLDIG /PRINT REMAINING DIGITS
1072 SZA /IF EFLG IS NOT ZERO IT IS -1,
1073 JMS I (EXPFLD /SO WE WILL PRINT A D INSTEAD OF AN E
1081 \fDBLDIG, 0 /OUTPUT DIGITS
1084 DBDLOP, DCA ACH /0 THE HI WORD FOR OVERFLO
1086 DCA AC2 /START TO COPY THE FAC.THIS IS
1087 TAD ACL /EAC3 SHIFTED DOWN 1 WORD
1100 DCA AC1 /THIS IS FAC*5 COMING UP
1126 \fDSCLDN, 0 /USED AS A TEMP TOO
1129 JMP I DSCLDN /DONE IF FAC<1.
1140 /6 WORD FAC LEFT SHIFT
1142 TAD AC1 /GET OVERFLO BIT
1145 TAD EAC3 /CONTINUE WORKING WAY UP THRU MANTISSA
1166 \f/6 WORD FAC RIGHT SHIFT. ENTER WITH COUNT-1 IN AC
1168 DACSR, 0 /USED AS A TEMP BY DBDLOP
1169 DCA AC0 /STORE COUNT
1175 DCA ACH /SHIFT RIGHT 1,PROPOGATE SIGN
1176 TAD ACL /DO SHIFTING FOR EACH WORD OF MANTISSA
1188 ISZ ACX /INCREMENT EXPONENT
1193 DCA AC1 /SAVE 1 BIT OF OVERFLOW
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.
1201 DCA DDPSW /INITIALIZE DEC. PT. SWITCH
1203 DCA DINESW /AND EXPONENT SWITCH
1206 DCA FMTNUM /CHAR COUNT
1207 DINESM, DCA ACX /CLEAR FLOATING AC
1216 JMP DINGCH /LOOP UNTIL WIDTH EXHAUSTED
1217 DINENM, 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
1222 DSCLIN, TAD OD /GET SCALING FACTOR
1225 JMP I (DNXT /NO SCALING NEEDED
1227 CIA CLL /AC CONTAINS MAGNITUDE,LINK CONTAINS SIGN
1234 JMS I (FPGO /MULT OR DIVIDE BY 10
1237 JMP DIGFOP-2 /MULT OR DIV CORRECT NUMBER OF TIMES
1238 JMP I (DNXT /GET MORE
1239 DIND, 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
1245 JMS DFNEG /GET SIGN OF NUMBER
1247 JMS I (FPGO /SAVE IT TEMPORARILY
1249 JMP DINESM /GO COLLECT EXP
1250 \fDFIXUP, JMS I (FFIX /IS THIS OK FOR DBL PREC???
1253 TAD SCALE /ADD EXP TO DEC PT SCALE FACTOR
1257 DFLTM2 /GET NUMBER BACK IN FAC
1259 DINGCH, JMS I (FMTIN /GET A CHAR
1260 JMS I (CHTYPE /CLASSIFY IT
1266 -5; DIND /E - BE FORGIVING
1272 DIDCPT, 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
1277 DCA I (DGT+1 /SAVE DIGIT
1283 ISZ OD /BUMP DIGIT IF DEC PT SEEN
1286 \f/6 WORD FLOATING NEGATE
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
1311 \f *FPPKG /EAE PKG LOADS OVER REGULAR PKG
1316 AL1BMP, 0 /*K* MUST BE AT SAME LOC AS NON-EAE VERSION
1323 /EAE FLOATING POINT INTERPRETER
1324 /FOR PDP8/E WITH KE8-E EAE
1326 /W.J. CLOGHER, MODIFIED BY R.LARY FOR FORTRAN
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)
1333 DDMPY, JMS I (DARGET
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
1346 TAD ACL /HIGH ORDER FAC TO MQ
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
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
1361 MUY /NOW DO PRODUCT OF HIGH ORDERS
1362 OPL /FAC HIGH IN MQ, OP HIGH IN OPL
1363 DAD /ADD IN THE ACCUMULATED #
1365 \f/MULTIPLIES DONE - MASSAGE RESULT
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?
1373 JMP SNCK /NO-JUST CHECK SIGN
1374 TAD AC0 /YES - WATCH OUT FOR LOST ACCURACY!
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
1381 RTZRO, DCA ACX /STORE BACK
1383 SPA CLA /IS HIGH ORDER OF OVERFLO WD. 1?
1384 DPIC /YES-ADD 1 TO LOW ORDER-STILL IN MQ
1387 JMP EMDONE /WE DIDN'T OVERROUND - GOODY
1389 1 /BUT OVERROUNDING IS EASILY CORRECTED!
1390 ISZ ACX / (OVERCORRECTED??)
1393 /COMMON CLEANUP ROUTINE FOR MULTIPLY AND DIVIDE
1395 EMDONE, ISZ EMSIGN /SHOULD SIGN BE MINUS?
1399 DCA ACX /FORCE EXPONENT 0 IF MANTISSA = 0
1400 DCA ACH /STORE IT BACK
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.
1412 \f/ROUTINE TO SET UP FOR MULTIPLY AND DIVIDE
1415 CLA CLL CMA RAL /MAKE A MINUS TWO
1416 DCA EMSIGN /AND STORE IN EMSIGN.
1417 DLD /GET HIGH ORDER MANTISSA OF OP.
1423 ISZ EMSIGN /BUMP SIGN COUNTER
1424 SHL /SHIFT OPRND LEFT 1 TO AVOID OVRFLO
1426 DST /STORE BACK-OPH CONTAINS LOW ORDER
1427 OPH / OPL CONTAINS HIGH ORDER
1431 SMA /FAC LESS THAN 0?
1435 NOP /EMSIGN MAY BUMP TO 0
1436 DST /STORE BACK - ACH CONTAINS LOW ORDER
1437 ACH / ACL CONTAINS HIGH ORDER
1440 \f/FLOATING DIVIDE-BY-0 ROUTINE - MUST BE AT 0 IN PAGE
1442 DBAD, ISZ FATAL /DIVIDE BY 0 NON-FATAL
1445 DCA ACX /SET AC TO A LARGE POSITIVE NUMBER
1451 DDDIV, JMS I (DARGET
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
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
1467 DCA ACX /YES-ZERO EXPONENT
1468 DVLP, MUY /NO-THIS IS Q*OPL*2**-12
1471 TAD AC1 /SEE IF GREATER THAN REMAINDER
1473 JMP EDVOPS /YES-ADJUST FIRST DIVIDE
1474 DVI /NO-DO Q*OPL*2**-12/OPH
1478 EDVLP1, TAD AC0 /NO-GET QUOT OF FIRST DIV.
1480 JMP I (EMDONE /NO-REMEMBER-QUOT OF 2ND DIV. IN MQ
1481 LSR /YES-MUST SHIFT IT RIGHT 1
1483 ISZ ACX /ADJUST EXPONENT
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
1494 DCA AC1 /ADJUST REMAINDER
1495 TAD OPL /WATCH FOR OVERFLOW
1499 JMP EDVOP1 /DON'T ADJUST QUOT.
1503 DCA AC0 /REDUCE QUOT BY 1
1505 TAD AC1 /GET REMAINDER
1507 CAM /YES-ZERO EVERYTHING
1510 SZL CLA /DIV. OVERFLOW?
1512 DCM /NO-ADJUST HI QUOT (MAYBE)
1515 /ROUTINE TO NORMALIZE THE FAC
1519 DLD /PICK UP MANTISSA
1521 SWP /PUT IT IN CORRECT ORDER
1524 DCA ACX /YES-INSURE ZERO EXPONENT
1525 DCA ACH /STORE HIGH ORDER BACK
1526 SWP /STORE LOW ORDER BACK
1528 CLA SCA /STEP COUNTER TO AC
1530 TAD ACX /AND ADJUST EXPONENT
1532 JMP I EFFNOR /RETURN
1540 \f/"OPNEG" MUST BE AT 0 IN PAGE
1542 OPNEG, 0 /ROUTINE TO NEGATE OPERAND
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.
1557 JMS OPNEG /NEGATE OPERAND
1559 FFADD, JMS I (ARGET /PICK UP ARGUMENTS
1561 SNA CLA /IF OPERAND IS 0,
1562 JMP I FPNXT /RESULT IS ALREADY IN AC.
1564 SZA CLA /CHECK FOR AC=0
1567 OPH /YES - ANSWER IS OPERAND
1570 JMP FADND /JUMP INTO CLEANUP CODE
1571 BOTHN0, 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)
1582 DCA AC0 /YES-MAKE IT A LOAD OF LARGEST #
1583 DLD /GET ADDRESSES TO SEE WHO'S SHIFTED
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
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 #
1603 SWP /PUT IT IN RIGHT ORDER
1604 ASR /DO THE ALIGNMENT SHIFT
1606 DAD /ADD THE LARGER #
1610 SZL /OVERFLOW?(L NOT = SIGN BIT)
1611 CMA /NOTE-WE DIDN'T SHIFT BOTH RIGHT 1
1614 CLA CLL CML RAR /MAYBE-SEE IF 2 #S HAD SAME SIGN
1617 SMA CLA /SIGNS ALIKE?
1618 JMP OVRFLO /YES-OVERFLOW
1619 NOOV, 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
1626 LOD, NMI /NORMALIZE (LOW ORDER STILL IN MQ)
1627 DCA ACH /STORE FINAL RESULT
1628 SCA /GET SHIFT COUNTER(# OF NMI SHIFTS)
1631 FADND, TAD OPX /AND ADJUST FINAL EXPONENT
1633 SWP /GET AND STORE LOW ORDER
1636 OVRFLO, TAD AC1 /OVERFLOW-GET HIGH ORDER RESLT BACK
1637 ASR /SHIFT IT RIGHT 1
1639 DOIT, TAD (4000 /REVERSE SIGN BIT
1646 \f *7400 /RTS CLEANUP ROUTINE - SAVED WITH PG 17600
1648 CLNUP, DCA I CFPTR /ENTER HERE ON ^C OR ERROR
1649 TDEXFG, 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
1656 TAD I TDPTR /MOVE THE TD8E ROUTINE
1658 DCA I TDPTR /DOWN TO FIELD 2
1663 JMS TDSET /RESET THE F0 CDF'S TO POINT TO FIELD 2
1668 DCA I (7606 /RESTORE PAGE 7600
1672 DCA I (OSJSWD /MARK 10000-11777 AS USELESS
1674 AND I 0 /DELAY A WHILE IN CASE ITS AN LA30
1682 TAD I (TOCHR /IF TTY IS NOT IDLE,
1683 SZA CLA /DELAY LONG ENOUGH TO AVOID GARBLE.
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
1693 JMP .-1 /WAIT FOR THE SLOWER ONE (I HOPE)
1697 SNA /ANY MORE ENTRIES IN THE TENTATIVE
1698 JMP GOAWAY /FILE TABLE?
1699 DCA CTMP /YES - SAVE FILE LENGTH PTR
1704 JMP IGNORC /UNWRITTEN FILES AREN'T CLOSED
1713 13 /RESET DEVICE HANDLER TABLE
1714 0 /BUT NOT TENTATIVE FILES!
1716 TAD I CFPTR /GET UNIT NUMBER
1719 CHAND, 0 /FETCH HANDLER
1721 TAD I CFPTR /GET UNIT AGAIN
1722 ISZ CFPTR /BUMP PTR TO NAME
1725 CFPTR, 7600 /CLOSE THE FILE
1733 JMP CLOSLP /LOOK FOR MORE
1744 JMP I (7605 /RETURN TO OS/8 AQAP
1745 CLSERR, JMS I USR /"IMPOSSIBLE" ERROR - GIVE "USER ERROR 2"
1747 2 /IT'S BETTER THAN HALTING