1 /FORTRAN IV RUNTIME SYSTEM, V5A
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 RUNTIME SYSTEM - R.LARY
41 /AND NOW WITH DOUBLE PRECISION! - MKH
42 /RTS-8 SUPPORT ADDED 5/20/74 - RL
45 XVERSN=5 /UPDATE WITH EVERY RELEASE!
46 XPATCH="A /PATCH LEVEL A
48 /NOTES TO MAINTAINERS:
50 /THIS PROGRAM IS DESIGNED TO SUPPORT MANY DIFFERENT HARDWARE
51 /CONFIGURATIONS IN A MINIMAL AMOUNT OF SPACE. IT ACHIEVES THIS GOAL
52 /BY "TAILORING" ITSELF AT INITIALIZATION TIME
53 /BASED ON A SURVEY OF ITS HARDWARE/SOFTWARE ENVIRONMENT. THIS MAKES
54 /THIS PROGRAM DIFFICULT TO MODIFY UNLESS THE MODIFYING PROGRAMMER
55 /KNOWS WHAT IS GOING ON. IT IS THEREFORE SUGGESTED THAT YOU READ THIS
56 /LISTING THOROUGHLY AND UNDERSTAND THE MAJOR ROUTINES BEFORE
57 /MAKING EVEN "TRIVIAL" CHANGES.
59 /ALL SYMBOLS BEGINNING WITH THE LETTER "Q" ARE ENTRIES IN THE
60 /HEADER BLOCK OF THE LOADER-IMAGE (.LD) FILE.
62 /ALL SYMBOLS BEGINNING WITH THE LETTER "Y" DENOTE THE BEGINNING OF
63 /A BLOCK OF CODE WHICH WILL BE REPLACED BY DIFFERENT CODE IF FRTS
64 /IS RUNNING IN THE BACKGROUND UNDER RTS-8. THE REPLACEMENT CODE
65 /CAN BE FOUND IN THE TABLE "BKRLST".
67 /ALL SYMBOLS BEGINNING WITH THE LETTER "V" ARE DEFINED IN THE LOADER
68 /SYMBOL TABLE AND CANNOT BE MOVED WITHOUT CHANGING THE LOADER. ONLY
69 /A VERY FEW OF THESE SYMBOLS OCCUR IN PLACES OTHER THAN
70 /PAGE 200 OR THE FIRST LOCATION OF OTHER PAGES.
72 /CODE WHICH CONTAINS THE CHARACTER SEQUENCE "*K*" IN THE COMMENT FIELD
73 /IS PARTICULARLY SUBTLE/OBSCURE (THE "K" IS FOR "KLUDGE"). THE REST OF THE
74 /COMMENT SHOULD INDICATE WHAT IS GOING ON.
77 / FIXES FOR V4 J.K. 1975
79 / .SCALE FACTOR PRINTED BY P FORMAT OPERATOR
81 / .RK8E HANDLER TO RUN WITH INTERRUPTS ON
82 / .SLASH AT END OF FORMAT STATEMENT
85 / CHANGES FOR OS/78 AND OS/8 V3D BY P.T.
86 / .CHANGED THE VERSION NUMBER TO 5A
87 / .FIXED THE FIELD OVERFLOW PROBLEM
88 / .FIXED THE "K=K+1" PROBLEM
98 /DEFINITIONS OF KE-8/E INSTRUCTIONS
122 /DEFINITIONS OF FPP IOT'S
140 LONG= 400 /TWO-WORD ADDRESSING
141 BASE= 200 /BASEPAGE ADDRESSING
142 IND= 600 /INDIRECT ADDRESSING
165 /VARIOUS OTHER IOT'S:
173 \f/PAGE ZERO FOR FORTRAN IV RTS
179 LPGET, LPBUFR /LINE PRINTER RING BUFFER FETCH POINTER
180 TOCHR, 0 /TELETYPE STATUS WORD
181 KBDCHR, 0 /KEYBOARD INPUT CHARACTER
182 POCHR, 0 /P.T. PUNCH COMPLETION FLAG
183 RDRCHR, 0 /P.T. READER STATUS
184 FMTPXR, 0 /XR USED TO INDEX FORMAT PARENTHESIS ARRAY
185 INXR, INBUFR-1 /XR USED TO GET CHARS FROM INPUT LINE
190 VEOFSW, 0 /USED BY "EOFCHK" TO STORE VARIABLE ADDRESS
191 0 /*K* MUST BE IN AUTO - XR
193 DFLG, 0 /0 = F.P., 1 = D.P.
194 INST, 0 /CURRENT INSTRUCTION WORD
196 /IOH PAGE ZERO LOCATIONS
198 RWFLAG, 0 /READ/WRITE FLAG
199 FMTTYP, 0 /TYPE OF CONVERSION BEING DONE
200 EOLSW, 0 /EOL SW ON INPUT - CHAR POS ON OUTPUT
203 D, 0 /NUMBER OF PLACES AFTER DECIMAL POINT
205 DATCDF, 0 /SUBROUTINE TO CHANGE DATA FIELD
206 DATAF, 0 /CONTAINS VARIOUS CDF'S
209 ERR, ERROR /POINTER TO ERROR ROUTINE
210 FATAL, 0 /FATAL ERROR FLAG - 0=FATAL
213 /FPP PARAMETER TABLE LOCATIONS:
215 APT, 0 /VARIOUS FIELD BITS FOR FPP
216 PC, DPTEST /FPP PROGRAM COUNTER
217 XRBASE, 0 /FPP INDEX REGISTER ARRAY ADDRESS
218 BASADR, 0 /FPP BASE PAGE ADDRESS
219 ADR, 0 /ADDRESS TEMPORARY
221 ACH, 0 /*** FLOATING ACCUMULATOR ***
224 EAC2, 0 /** FOR EXTENDED PRECISION OPTION **
226 \f/FLOATING POINT PACKAGE LOCATIONS
229 AC1, 0 /FLOATING AC OVERFLOW WORD
230 AC2, 0 /OPERAND OVFLOW WORD
232 OPH, 0 /*** FLOATING OPERAND REGISTER ***
235 /RTS I/O CONVERSION SYSTEM LOCATIONS
237 FMTBYT, 0 /FORMAT BYTE POINTER
238 IFLG, 0 /I FOEMAT FLAG
239 GFLG, 0 /G FORMAT FLAG
240 EFLG, 0 /E FORMAT FLAG - SOMETIMES ON FOR G FMT
243 PFACT, 0 /P-SCALE FACTOR
244 PFACTX, 0 /TEMP FOR PFACT
245 ACI, 0 /INTEGERIZED FAC FROM "FFIX" SUBR
247 FMTNUM, 0 /CONTAINS ACCUMULATED NUMERIC VALUE
248 CTCINH, 0 /^C INHIBIT FLAG
249 LOGUNT, 0 /DSRN POINTER - ONLY USED FROM ONE PAGE!
250 PTTY, TTY /POINTER TO TTY HANDLER - USED BY LDDSRN
251 0 / SO FORMS CONTROL WILL WORK ON UNIT 0
252 FPNXT, ICYCLE /USED AS INTERPRETER ADDRESS IF NO FPP
256 HAND, 0 /HANDLER ENTRY POINT
257 HCODEW, 0 /HANDLER LOAD ADDR & FIELD + IOFFLG + FORMS CTL FLG
258 BADFLD, 0 /BUFFER ADDRESS AND FIELD
259 CHRPTR, 0 /ACTUALLY A WORD POINTER
260 CHRCTR, 0 /COUNTER - RANGES FROM -3 TO -1
261 STBLK, 0 /STARTING BLOCK OF FILE
262 RELBLK, 0 /CURRENT RELATIVE BLOCK NUMBER
263 TOTBLK, 0 /LENGTH OF FILE
264 FFLAGS, 0 /FILE FLAGS:
265 /BIT 0 - "HAS BEEN WRITTEN" FLAG
266 /BITS 1-2 - FORMATTED/UNFORMATTED FLAGS
267 /BIT 11 - "END-FILED" FLAG
269 BUFFLD, 0 /ROUTINE TO SET DF TO BUFFER FIELD
273 FADD1, FADD+LONG /FPP CODE TO ADD 1.0 TO FAC
274 ONE /AND FALL INTO STORE CODE
275 FGPBF, 0 /THESE THREE WORDS ARE USED
276 BIOPTR, 0 /TO FETCH AND STORE FLOATING POINT NUMBERS
277 FEXIT /FROM RANDOM MEMORY
281 FTEMP2, ISZ .+3 /ALSO USED AS I/O F.P. TEMPORARY
284 VDATE, RTSLDR /USED TO STORE OS/8 DATE
286 /RTS ENTRY POINTS - "VERSION INDEPENDENT"
288 VUERR, JMP I (USRERR /USER ERROR
289 /** LOADER MUST DEFINE #ARGER AS VARGER-1 **
290 VARGER, JMS I ERR /LIBRARY ARGUMENT ERROR
291 VRENDO, ISZ RWFLAG /END OF I/O LIST
292 VRFSV, JMP I GETLMN /I/O LIST ARG ENTRY - COROUTINE WITH GETLMN
293 VBAK, JMP I (BKSPC /"BACKSPACE" ROUTINE
294 VENDF, JMP I (ENDFL /"END FILE" ROUTINE
295 VREW, JMP I (RWIND /"REWIND" ROUTINE
296 VDEF, JMP I (DFINE /"DEFINE FILE" ROUTINE
297 VWUO, AC4000 /UNFORMATTED WRITE
298 VRUO, JMP I (RWUNF /UNFORMATTED READ
299 VWDAO, AC4000 /DIRECT ACCESS WRITE
300 VRDAO, JMP I (RWDACC /DIRECT ACCESS READ
301 VWRITO, AC4000 /FORMATTED (ASCII) WRITE
302 VREADO, JMP I (RWASCI /FORMATTED (ASCII) READ
303 VSWAP, JMP I (SWAP /OVERLAY PROCESSOR
304 VEXIT, TRAP3; CALXIT /"STOP" ROUTINE - ENTERED IN FPP MODE
305 V8OR12, 0;0 /0;1 IF CPU IS A PDP-12
306 VBACKG, JMP I (NULLJB /BACKGROUND JOB DISPATCHER
308 CDF CIF 0 /USED BY ROUTINE "ONQB" IN LIBRARY
312 /IOH GET VARIABLE ROUTINE.
313 /THIS ROUTINE MAKES THE FORMATTED I/O PROCESSOR AND THE USER'S
314 /PROGRAM CO-ROUTINES (DEF(COROUTINE)= 2 ROUTINES EACH THINKING THE OTHER
315 / IS A SUBROUTINE). ON ENTRY FAC=INPUT NUMBER
316 /IF I/O IS A READ, ON RETURN FAC=OUTPUT NUMBER IF I/O IS A WRITE.
319 VRETRN, JMP I [RETURN /SHORT ROUTINE FOR ALL THOSE COMMENTS, NO?
320 \f/INTERRUPT DRIVEN I/O HANDLERS
322 LPT, 0 /RING-BUFFERED - LP08 OR LS8E
323 AND [377 /JUST IN CASE
325 JMP I (IOERR /CANNOT BE USED FOR INPUT
331 SZA CLA /IS LPT QUIET?
334 LLS /YES - START 'ER UP
336 LIE /ENABLE LPT INTERRUPTS
337 TAD LPPUT /1 IN AC, REMEMBER?
341 JMP .-3 /NEGATIVE NUMBERS ARE BUFFER LINKS
342 SZA CLA /ANY ROOM LEFT IN BUFFER?
344 LPUHNG /WAIT FOR LINE PRINTER
345 ION /TURN INTERRUPTS BACK ON
350 PTP, 0 /PAPER TAPE PUNCH HANDLER
352 JMP I (IOERR /INPUT IS ERROR
355 TAD POCHR /IF PUNCH IS NOT IDLE,
356 SZA CLA /WE DISMISS JOB
358 PPUHNG /WAIT FOR PUNCH INTERRUPT
361 DCA POCHR /SET FLAG NON-ZERO
365 /*K* THE FOLLOWING ADDRESSES GET FALLEN INTO & MUST BE SMALL
367 IFNZRO PPUHNG&7000 <__ERROR__>
368 IFNZRO TTUHNG&7000 <__ERROR__>
369 IFNZRO KBUHNG&7000 <__ERROR__>
370 IFNZRO RDUHNG&7000 <__ERROR__>
371 IFNZRO LPUHNG&7000 <__ERROR__>
372 \f/INTERRUPT-DRIVEN PTR AND TELETYPE HANDLER
374 PTR, 0 /CRUDE READER HANDLER
376 JMP I (IOERR /OUTPUT ILLEGAL TO PTR
380 RDUHNG /HANG UNTIL COMPLETE
381 TAD RDRCHR /GET CHARACTER
385 TTY, 0 /BUFFERS 2 CHARS ON OUTPUT, 1 ON INPUT
386 YTTY, IOF /DELICATE CODE AHEAD
387 SNA /INPUT OR OUTPUT?
389 DCA LPT /OUTPUT - SAVE CHAR
390 TAD TOCHR /GET TTY STATUS
391 SMA SZA CLA /G.T. 0 MEANS A CHAR IS BACKED UP
393 TTUHNG /WAIT FOR LOG JAM TO CLEAR
394 TAD TOCHR /NO CHAR BACKED UP - SEE IF TTY BUSY
395 CLL RAL /"BUSY" FLAG IN LINK - INTERRUPTS ARE OFF!
396 CLA CML RAR /COMPLEMENT OF BUSY IN SIGN
398 SPA /IF TTY NOT BUSY,
400 DCA TOCHR /STORE POS OR NEG, BACKED UP OR BUSY
401 TTYRET, ION /TURN INTERRUPTS BACK ON
403 \fKBD, TAD KBDCHR /HAS A CHARACTER BEEN INPUT?
406 KBUHNG /NO - RUN BACKGROUND UNTIL ONE IS
407 TAD KBDCHR /GET CHARACTER
409 DCA KBDCHR /CHEAR CHARACTER BUFFER
411 JMP TTYRET /RETURN WITH INTERRUPTS ON
413 KILFPP, FPHLT /BRING FPP TO A SCREECHING HALT
415 JMP .-1 /WAIT FOR IT TO STOP
416 FPICL /CLEAN UP MESS HALT HAS MADE IN FPP
417 BEEORC, SZL /^C OR ^B?
418 JMP I (7600 /^C - HIYO SILVER, AWAY!
419 KCC /CLEAR KBD FLAG ON ^B
420 CTLBER, JMS I ERR /*** THIS MAY BE DANGEROUS! **
422 \f/INTERRUPT SERVICE ROUTINES
427 VINT, JMP .+4 /** MUST BE AT 403 **
428 IFNZRO VINT-403 <___ CHANGE LOADER!!!>
430 CDF CIF 0 /USER INTERRUPT ROUTINE GOES HERE
433 FPINT /CHECK FOR FPP DONE
435 FPUHNG, JMP DISMIS /ALWAYS GOES TO RESTRT
437 VDISMS, JMP DISMIS /FOR USE BY USERS
443 LPTLCF, LCF /CLEAR FLAG
445 SNA CLA /CHECK FOR SPURIOUS INTERRUPT
446 JMPDIS, JMP DISMIS /GO AWAY IF SO
447 DCA I LPGET /ZERO CHAR JUST OUTPUT
451 DCA LPGET /TAKE CARE OF BUFFER LINKS
453 TAD I LPGET /MAKE SURE CHAR IS IN AC
454 SZA /IS THERE A CHARACTER?
457 LSF /CHECK FOR IMMEDIATE FLAG
458 LPUHNG, JMP DISMIS /NO - MAYBE RESTART PROGRAM
459 JMP LPTLCF /YES - LOOP
461 NOTLPT, TSF /CHECK TTY
464 TAD TOCHR /GET TTY STATUS
465 SMA SZA /IF THERE IS A CHARACTER WAITING,
467 SMA SZA CLA /CHANGE "WAITING" TO "BUSY",
468 STL RAR /"BUSY" TO "IDLE".
471 \f/KBD AND PTP INTERRUPTS
476 KRS /USE KRS TO FORCE PARITY BIT
477 DCA KBDCHR /AND ALSO SO THAT ^C WILL STILL BE IN BUFFER IN OS/8
479 TAD (-202 /CHECK FOR ^C OR ^B
482 JMP CTCCTB /YUP - TAKE SOME DRASTIC ACTION
483 KCC /DATA CHARACTER - CLEAR FLAG
487 SNA CLA /ARE WE IN A HANDLER?
490 CLL RAL /YES - RETURN WITH INTERRUPTS OFF
491 TAD INTAC /TRUST IN GOD AND RTS
497 PCF /P.T. PUNCH INTERRUPT - CLEAR FLAG
498 DCA POCHR /CLEAR SOFTWARE FLAG
508 LPTERR, LSE /TEST FOR LP08 ERROR FLAG
510 LIF /DISABLE LP08 INTERRUPTS IF ERROR FLAG ON
513 TAD INTAC /RESTORE AC AND LINK
516 JMP I 0 /RETURN FROM THE INTERRUPT
520 \f/BACKGROUND INITIATE/TERMINATE ROUTINE
522 HANG, 0 /ALWAYS CALLED WITH INTERRUPTS OFF!
523 TAD I HANG /GET POINTER TO UNHANGING LOCATION
525 RDF /GET FIELD CALLED FROM
527 DCA HNGCDF /SAVE FOR RETURN
529 TAD (JMP RESTRT /CHANGE THE "JMP DISMIS" AT THAT LOC
530 DCA I UNHANG /TO A "JMP RESTRT"
533 TAD BACKAC /SET UP BACKGROUND AC AND LINK
537 JMP I BACKPC /INITIATE BACKGROUND
539 / COME HERE WHEN THE HANG CONDITION HAS GONE AWAY
541 RESTRT, TAD JMPDIS /RESTORE THE UNHANG LOCATION
543 TAD INTAC /SUSPEND THE BACKGROUND
554 JMS I MCDF /*K* OK SINCE BACKGROUND DOESN'T USE MAKCDF
558 JMP I HANG /INTERRUPTS ARE OFF - RETURN
560 NOTINH, TAD JMPDIS /IN CASE WE WERE HUNG, WE DON'T WANT
561 DCA I UNHANG /TO GET "UNHUNG" OUT OF THE ERROR ROUTINE!
562 JMP I (KILFPP /KILL FPP AND GO TO EXIT OR ERROR
569 IFNZRO VHANG-0524 <__ CHANGE LOADER!>
571 \f/I-O CONVERSION ROUTINES - STARTUP CODE
573 RWASCI, JMS I [RWINIT /"READ(N,FMT)" OR "WRITE(N,FMT)"
574 2000 /"FORMATTED" BIT
575 JMS I [FETPC /GET ADDRESS OF FORMAT STMT
580 DCA PFACT /CLEAR SCALE FACTOR
581 JMS I [GETLMN /EXIT TO MAIN PROGRAM TO GET 1ST VARIABLE
584 FMTSET, DCA FMTPXR /STORE NEW FORMAT PUSHDOWN POINTER
586 DCA FMTBYT /GET NEW BYTE POINTER (NOTE-FMTPDL CONTAINS A 0)
587 \f/MAIN FORMAT DECODING LOOP
590 DCA FMPBYT /SAVE CURRENT BYTE PTR FOR PARENTHESES HACK
591 FMTDLP, DCA FMTNUM /ZERO ACCUMULATED NUMBER
592 FMTCLP, JMS FMTGCH /GET A CHARACTER
593 ISZ FMTBYT /BUMP BYTE POINTER
594 JMS I [CHTYPE /CLASSIFY CHAR
609 SZA CLA /CHECK THAT WE DO NOT HAVE A FIELD OUTSTANDING
610 JMP I (FMTERR /IF WE DO - ERROR
611 TAD CHCH /GET FIELD CHARACTER
614 SNA /IF REPEAT COUNT WAS MISSING OR ZERO
617 DCA N /STORE -(REPEAT COUNT +1)
618 DCA W /CLEAR WIDTH INITIALLY
619 ISZ FMTNUM /PRECLUDE "FORMAT ERROR" ON X,P, OR H FORMATS
621 AND [7 /IS THE CHARACTER P, X, OR H?
622 SNA CLA /IF SO, DON'T WAIT
623 COMMA, JMS I (DOFMT /EXECUTE THE STORED FIELD SPECIFICATION
624 JMP FMTFLP /BACK FOR MORE
626 FMTADR, 0 /ADDRESS OF FORMAT
627 \fFMTGCH, 0 /GET CHARACTER FROM FORMAT
628 JMS FMTGAD /GET WORD CONTAINING CHAR AND L/R SWITCH
630 JMS I (FMTGLR /EXTRACT CHARACTER
633 FMTGAD, 0 /SUBR TO GET A WORD FROM A CHARACTER OFFSET
634 TAD FMTBYT /GET OFFSET
637 TAD FMTADR /COMPUTE BASE ADDR + [OFFSET/2]
641 JMS I MCDF /SET UP PROPER DATA FIELD
646 CLA /LEAVE L/R SWITCH IN LINK
648 JMP I FMTGAD /RETURN WITH WORD IN AC
650 FMTDF, 0 /FIELD OF 1ST CHAR OF FORMAT IN BITS 9-11
652 FMTDIG, TAD FMTNUM /DIGIT PROCESSOR
655 CLL RAL /MULTIPLY FMTNUM BY 10
656 TAD CHCH /ADD IN THE DIGIT
657 JMP FMTDLP /STORE IT BACK AND CONTINUE
658 \f/PARENTHESIS AND DIGIT ROUTINES
662 SZA /ARE WE AT PARENTHESIS LEVEL 1?
664 TAD FMPBYT /YES - STORE A POINTER TO THE FIRST DIGIT OF THE
665 DCA I (FMTPDL-2 /GROUP COUNT PRECEDING THIS PAREN
666 /AS THE LOOP POINTER FOR LEVEL 1
668 SPA CLA /PUSHDOWN OVERFLOW?
669 FPOERR, JMS I ERR /YES
672 DCA FMTPXR /BUMP PARENTHESIS PUSHDOWN POINTER
674 DCA I FMTPXR /SAVE BYTE POINTER
677 IAC /NO GROUP COUNT MEANS COUNT = 1
679 DCA I FMTPXR /SAVE LOOP COUNT
680 DCA I (FMTPDL-1 /INITIAL GROUP COUNT IS INFINITE!
681 RPLOOP, AC7776 /COME HERE ON RIGHT PAREN ALSO
682 TAD FMTPXR /BACK UP FORMAT PDL POINTER
683 JMP FMTSET /RESTORE FMTBYT FROM TOP OF LIST
687 RPAREN, JMS I (DOFMT /EXECUTE PREVIOUS SPEC IF ANY
689 TAD (2-FMTPDL /IS THIS THE FINAL RIGHT PAREN?
691 JMS I [ENDREC /YES - CHECK FOR END OF FORMAT
692 ISZ I FMTPXR /BUMP COUNT
693 JMP RPLOOP /DIDN'T OVERFLOW - LOOP TO BYTE AFTER (
694 ISZ FMTPXR /POP UP PARENTHESES STACK
695 JMP FMTFLP /CONTINUE PAST RIGHT PAREN
697 \f/QUOTE AND HOLLERITH FORMAT PROCESSORS
699 KWOTE, TAD MINUS5 /APOSTROPHE PROCESSOR
700 DBLQOT, TAD (-42 /QUOTE PROCESSOR
701 DCA KWODEL /SAVE TERMINATOR
702 JMS DOFMT /PROCESS PRECEDING FIELD , IF ANY
704 KWOTLP, JMS FMTHCV /PROCESS ONE CHARACTER
705 JMS I [FMTGCH /GET THE NEXT FORMAT CHAR
707 SZA CLA /IS IT THE TERMINATOR?
708 JMP KWOTLP /NO - PROCESS IT AND CONTINUE
709 ISZ FMTBYT /BUMP OVER TERMINATOR
712 SNA CLA /IS THIS ANOTHER TERMINATOR?
713 JMP KWOTLP /TWO TERMINATORS PRINT AS ONE
714 JMP I (FMTFLP /OTHERWISE GO BACK TO FORMAT LOOP
716 HFMT, JMS MORE /MORE CHARACTERS?
717 JMS FMTHCV /YES - PROCESS ONE
720 FMTHCV, 0 /ROUTINE COMMON TO H AND QUOTED FORMATS
721 TAD RWFLAG /PROCESSES ONE CHAR IN OR OUT OF THE FORMAT
722 H7700, SMA CLA /IN OR OUT?
724 JMS I [FMTGCH /OUT - GET THE CHAR
725 JMS I [FMTOUT /PRINT IT
727 FMTHIN, JMS I [FMTIN /INPUT - GET THE CHAR FROM THE INPUT LINE
731 JMP FHRGHT /RIGHT SIDE
732 AND [77 /LEFT - KEEP RIGHT CHAR
738 TAD MORE /ADD NEW CHAR IN ON THE LEFT
740 FHRGHT, AND H7700 /KEEP THE CHAR ON THE LEFT
741 TAD W /ADD NEW CHAR IN ON THE RIGHT
742 DCA I D /RESTORE ALTERED WORD
744 FMTHCR, ISZ FMTBYT /BUMP BYTE POINTER
747 KWODEL, 0 /MUST BE UNIQUE!
748 \fMORE, 0 /SUBR TO BUMP REPEAT COUNT AND EXIT ON OVFLO
751 DOFRTN, DCA FMTTYP /INDICATE NO SPECIFICATION COLLECTED
752 JMP I DOFMT /RETURN FROM "DOFMT"
754 DOFMT, 0 /ROUTINE TO PROCESS A FORMAT SPECIFICATION
755 TAD FMTNUM /GET THE CURRENT NUMBER
756 DCA D /STORE IT AS DECIMAL POINT SPEC
759 DCA GFLG /ZERO CONVERSION FLAGS
761 SNA CLA /ANY SPECIFICATION WAITING?
762 JMP I DOFMT /NO - JUST RETURN
764 TAD D /IF THERE WAS NO W OR D SPECIFICATION,
766 JMP FMTERR /ITS AN ERROR
768 JMS I [CHTYPE /YES - WHICH ONE?
778 -4;DF, EFMT /D - EQUIVALENT TO E IF NO D.P. FPP
779 -2;BF, FFMT /B - EQUIVALENT TO F IF NO D.P. FPP
781 0 /NONE OF THE ABOVE - ERROR
783 \fENDREC, 0 /ROUTINE TO END A LINE AND MAYBE THE I/O
786 AND RWFLAG /LO BIT OF RWFLAG IS "I/O LIST EXHAUSTED" FLAG
787 SNA CLA /SKIP IF NO MORE ELEMENTS IN I/O LIST
789 JMP I [ENDIO /NOW FINISH UP AND LEAVE
791 SLASH, JMS DOFMT /EXECUTE THE FIELD SPEC IF ANY
792 JMS I [EOLINE /TERMINATE CURRENT LINE
797 ISZ MINFLG /P FORMAT - CHECK FOR NEGATIVE SCALE
800 STA /FALL INTO CODE TO CLEAR MINFLG
801 DCA MINFLG /SET FLAG ON MINUS
804 FMINUS, JMS DOFMT /EXECUTE PRECEDING SPEC
805 DCA MINFLG /CLEAR MINUS FLAG
810 FMTPER, TAD FMTNUM /PERIOD PROCESSOR
814 ABORTO, JMS DOFMT /$ - SPECIAL HACK TO ALLOW PROMPTS
815 DCA EOLSW /FAKE BEGINNING OF LINE
816 DCA I (TTYLF /INHIBIT LF BEFORE NEXT TTY INPUT
817 JMP I [ENDIO /GO AWAY
819 \fCHTYPE, 0 /ROUTINE TO CLASSIFY CHARACTERS
822 CDIGIT, TAD CHCH /CHECK FOR DIGIT
826 SZL /IS CHAR A DIGIT?
828 CHLOOP, ISZ CHTYPE /SKIP OVER ADDRESS
833 JMP JMPOTX /MAYBE - JUMP WITH CODE IN AC
835 SZA CLA /DOES CHAR MATCH CHAR ON LIST?
836 JMP CHLOOP /NO - KEEP LOOKING
837 JMPOUT, DCA CHCH /ZERO CHAR
839 DCA CHTYPE /SET UP TO RETURN INDIRECTLY
840 JMPOTX, SZA CLA /IS THIS THE END?
841 JMP CDIGIT /NO - GO CHECK FOR DIGIT
842 JMP I CHTYPE /GO TO SPECIFIED ADDRESS
845 SKPOUT, 0 /ROUTINE USED BY DATA-HANDLING SPECIFICATIONS
846 JMS I [MORE /CHECK FOR REPEAT COUNT EXHAUSTED
850 ISZ SKPOUT /SKIP RETURN
851 SZL CLA /IF END OF I/O LIST,
852 JMS I [ENDREC /DON'T RETURN AT ALL - GO AWAY
854 \f/A FORMAT PROCESSOR
859 DCA ACL /INITIALIZE LOW-ORDER WORDS TO BLANKS
864 STL RTL /INPUT CHAR GOES IN HIGH-ORDER
865 RTL /WITH BLANK IN LOW-ORDER
869 TAD I FMTGLR /COMBINE INPUT CHAR AND OLD LEFT HALF
870 TAD [-40 /DELETE PREVIOUS RIGHT-HALF SPACE
871 AINPTC, DCA I FMTGLR /STORE WORD
873 JMP AINPTL /LOOP AROUND WIDTH
874 ANXT, JMS I [GETLMN /GET NEXT ELEMENT
877 DCA W /SAVE FIELD WODTH AS A COUNT
878 JMS I [SKPOUT /CHECK FOR REPEAT COUNT OVFLO AND I/O DIR
880 AOTPUT, JMS GADR /OUTPUT - GET ADDRESS OF BYTE
883 JMS I [FMTOUT /PRINT IT
885 JMP AOTPUT /LOOP ON WIDTH
888 FMTGLR, 0 /SUBR TO EXTRACT A CHAR FROM A WORD
893 RTR /LEFT HALF - ROTATE INTO RIGHT HALF
897 GADR, 0 /BYTE ADDRESS ROUTINE FOR A FORMAT PROCESSOR
899 TAD W /FORM BYTE OFFSET IN THE RANGE 0 THRU D-1
903 JMP I GADR /LEAVE WITH L/R FLAG IN LINK
904 \f/"STOP" ROUTINE - TERMINATES JOB
908 DCA ACI /GO THROUGH THE FORTRAN UNIT NUMBERS.
909 DCA I (ENDFLS /*K* TURN "ENDFL" INTO A SUBROUTINE
910 JMS I (LDDSRN /IF WE FIND A UNIT WHICH IS BEING USED
911 SNA CLA /AND HAS NOT BEEN ENDFILED,
912 JMP XITISZ /WE WILL DUMP THE CURRENT BUFFER (IF IT
913 CLA IAC /IS A FORMATTED OUTPUT FILE) AND
914 AND FFLAGS /END-FILE IT
919 LPTTWT, TAD I LPGET /WAIT FOR LINE PRINTER AND TELETYPE TO
923 ISZ CLNADR /SET UP TO CLOSE OUTPUT FILES
924 PDPXIT, IOF /ENTER HERE FROM 7605
925 CDF 0 /TO PROTECT CLODS WITH PDP 8/E'S
928 7400 /READ IN CLEANUP ROUTINE
929 37 /AND OS/8 PAGE 17600
930 JMP .-5 /AYEEEE!! SYSTEM DEVICE GONZO!
932 JMP I CLNADR /CLOSE TENTATIVE FILES AND EXIT
936 ARGLD, 0 /ROUTINE TO GET VALUE OF AN ARG
938 AND [7 /THROW AWAY OPCODE (JA)
941 JMS I [FETPC /CONSTRUCT AN FPP INSTRUCTION
951 \f/SUBROUTINE TO OPEN A UNIT FOR I/O
954 DCA RWFLAG /DIRECTION IN AC ON ENTRY
956 AND I RWINIT /IF CALLED FROM BACKSPACE, REWIND OR ENDFILE
957 SZA CLA /UNIT NUMBER IS IN FAC
958 JMS I [ARGLD /OTHERWISE, GET UNIT NUMBER
963 SZL CLA /CHECK DEVICE NUMBER IN RANGE 0-9
964 JMS LDDSRN /LOAD DSRN ENTRY INTO PAGE 0
965 SNA CLA /IS UNIT INITIALIZED?
966 UNTERR, JMS I ERR /NO - ERROR
968 SPA /IF WE ARE WRITEING FOR THE FIRST TIME
969 TAD FFLAGS /ON A UNIT WHICH WAS BEING READ,
970 CMA RAL /WE MUST BUMP THE RELATIVE BLOCK NUMBER DOWN
971 SNL SMA CLA /ONE BECAUSE OF A PHILOSOPHICAL DIFFERENCE
972 JMS I (RD2WR /BETWEEN READ AND WRITE
974 TAD RWFLAG /OR THE I/O TYPE AND
976 AND FFLAGS /DIRECTION BITS INTO THE FLAG WORD
982 SNL SMA CLA /IT IS ILLEGAL TO ACCESS A FILE IN
983 JMP UNTERR /FORMATTED AND UNFORMATTED MODES
989 DCA XR /STORE POINTER INTO DIRECT-ACCESS TABLE
991 \f/REWIND AND END FILE
993 RWIND, JMS RWINIT /GET THE DSRN ENTRY
994 0 /DON'T PLAY WITH MODES
997 SNA CLA /IF FORMATTED OUTPUT FILE AND NOT EOF'D
998 JMS DMPBUF /DUMP LAST BUFFER AS A FAVOR
1000 AND FFLAGS /KILL ALL FLAG BITS
1001 DCA FFLAGS /EXCEPT "END-FILED" BIT
1006 DCA CHRCTR /INITIALIZE BUFFER POINTERS
1007 DCA RELBLK /AND RELATIVE BLOCK #
1008 JMP I [ENDIO /RESTORE DSRN AND EXIT
1010 ENDFL, JMS RWINIT /*K* USED AS A SUBROUTINE BY CALXIT
1011 1 /GET DSRN, SET "END FILE" FLAG
1012 TAD FFLAGS /IF THE FILE IS UNFORMATTED,
1013 CMA RAL /OR WAS NOT OUTPUT ONTO,
1014 SNL SMA CLA /THEN ENDFILE DOES NOTHING.
1015 JMS DMPBUF /ELSE DUMP THE FINAL BUFFER
1017 AND FFLAGS /CLEAR WRITE BIT SO WE WILL NOT TRY
1018 SETTOT, DCA FFLAGS /ANYTHING ON A SUBSEQUENT ENDFILE
1019 TAD RELBLK /SET NEW LENGTH OF FILE IN CASE ITS TENTATIVE,
1020 DCA TOTBLK /AND SO WE WON'T READ PAST EOF.
1021 ENDIO, JMS INITMV /SET UP DSRN POINTERS
1023 DCA I XR /STORE BACK THE DSRN ENTRY
1024 ISZ T /FOR THIS LOGICAL UNIT
1026 DCA VEOFSW /CLEAR EOFSW AT END OF EVERY READ
1027 ENDFLS, JMP I [RETURN /RETURN TO THE CALLING PROGRAM
1028 JMP I ENDFL /*K* OR RETURN TO CALXIT
1030 INITMV, 0 /ROUTINE TO SET UP STUFF
1039 \f/ROUTINE TO DUMP CURRENT OUTPUT BUFFER WITH ^Z AT THE END
1042 ISZ EOLSW /FORCE COLUMN 1 SWITCH OFF
1043 TAD (7712 /OUTPUT A LINE FEED
1045 TAD HAND /IF THE FILE IS BEING OUTPUT VIA
1046 SMA CLA /AN OS/8 HANDLER,
1047 JMP CLREOL /WE MUST TERMINATE THE BUFFER PROPERLY.
1049 CTZLP, TAD Z7700 /OUTPUT A ^Z AND FILL BUFFER WITH ZEROES.
1050 JMS I [FMTOUT /NEGATIVE NUMBERS TURN INTO CONTROL CHARS
1053 TAD CHRCTR /FILL THE BUFFER UNTIL CHRPTR POINTS TO
1054 IAC /A BLOCK BOUNDARY AND CHRCTR = -3
1055 Z7700, SMA CLA /WE ARE THEN AT BUFFER-END
1057 CLREOL, DCA EOLSW /RESET TO BEGINNING OF LINE
1058 JMP I DMPBUF /RETURN
1060 /ROUTINE TO MOVE THE PROPER DSRN ENTRY INTO PAGE 0
1063 TAD ACI / READ/WRITE INIT SINGS THIS SONG,
1064 CLL RTL / (DOO DAH, DOO DAH,)
1065 RAL / DSRN ENTRIES 9 WORDS LONG
1066 TAD ACI / (OH, DEE DOO DAH DAY).
1068 SNA /DEVICE NUMBER 0 IS SPECIAL -
1069 TAD (PTTY+11-DSRN /IT'S ALWAYS THE TELETYPE
1072 JMS INITMV /SET UP FOR MOVE
1074 DCA I XR1 /PUT DSRN ENTRY IN PAGE 0
1080 DCA BUFCDF /SAVE BUFFER FIELD AS A CDF
1084 \f/BACKSPACE ROUTINE - WORKS ON BINARY OR ASCII FILES
1086 BKSPC, JMS I [RWINIT
1087 0 /GET THE DSRN ENTRY WITHOUT ALTERING MODE
1090 JMP I [UNTERR /UNIT MUST BE BLOCK ORIENTED
1093 SZA CLA /IS FILE FORMATTED?
1094 JMP BKASCI /YES - PAIN IN NECK
1095 JMS BMPBLK /UNFORMATTED FILE - REREAD LAST BLOCK
1099 JMS BUFFLD /SET DATA FIELD TO FIELD OF BUFFER
1100 TAD I T /LOOK AT LAST WORD IN BUFFER
1101 CIA /REGARD IT AS THE NUMBER OF BLOCKS/RECORD
1103 DCA RELBLK /RELBLK POINTS TO FIRST BLOCK OF PREV. REC
1106 BMPBLK, 0 /SUBR TO BUMP BLOCK # BACK AND READ
1107 CMA CLL /AC MAY NOT BE 0 ON ENTRY
1109 DCA RELBLK /BUMP BLOCK BACK
1111 JMP I (ATLDMK /BACKSPACED TOO FAR - CALL IT QUITS
1112 DCA CHRPTR /ZERO CHRPTR TO FORCE A READ FROM MASSIO
1113 JMS I [MASSIO /READ A BLOCK
1116 /**** NULL JOB GOES HERE FOR LACK OF A BETTER PLACE ****
1119 NULLLP, ISZ N2525 /PUT THE FAMOUS "POLY BASIC PATTERN"
1120 JMP NULLLP /IN THE AC LIGHTS
1127 JMP I (VBACKG /GOT SOMETHING MORE USEFUL TO DO?
1130 \f/BACKSPACE FOR FORMATTED FILES
1132 BKLORD, TAD I CHRPTR
1135 AND [177 /GET 7 BITS
1136 TAD (-15 /COMPARE WITH C.R. - SINCE WE SKIPPED
1137 SNA CLA /THE FIRST ONE THIS WILL BELONG TO THE PREVIOUS
1138 JMP I [ENDIO /LINE AND WE WILL BE DONE (HAH!)
1139 BKASCI, JMS I (MASBMP /A COMPLICATED MESS - FIRST BUMP THE
1140 SKP /CHARACTER POINTER BACK TWO PLACES
1141 JMP BKGTCH /AND THEN FETCH A CHARACTER. THIS WILL IGNORE
1142 TAD BADFLD /THE LAST CHAR READ/WRITTEN (WHICH SHOULD
1143 AND [7400 /BE A CARRIAGE RETURN).
1147 SZA CLA /TEST WHETHER WE HAVE TO READ AN OLD BUFFER
1149 TAD CHRCTR /SAVE POSITION IN CURRENT DOUBLEWORD
1152 AC4000 /IF WE ARE BACKSPACING AN OUTPUT FILE,
1153 TAD FFLAGS /WE MUST SAVE THE INFORMATION IN THE
1154 SPA /CURRENT BUFFER BY WRITING IT OUT.
1156 DCA FFLAGS /ALSO CHANGE THE UNIT TO AN INPUT FILE
1157 AC4000 /(RWINIT TAKES CARE OF SWITCHING BACK TO OUTPUT)
1159 CLA IAC /WE DON'T WANT THE LAST BLOCK READ/WRITTEN,
1160 JMS BMPBLK /THAT'S IN CORE - WE WANT THE ONE
1161 TAD GETCH3 /BEFORE THAT.
1165 SKP /COMPUTE WORD POINTER FROM CHAR POINTER
1168 DCA CHRPTR /BUMP WD PTR BACK 1
1169 BKGTCH, JMS I (MASBMP /NOW GET A CHARACTER - THIS LOOKS A LOT
1170 JMP BKLORD /LIKE THE INPUT ROUTINE
1173 \fGETCH3, 0 /COMMON CODE BETWEEN BACKSPACE AND INPUT
1176 DCA BMPBLK /HANDY TEMPORARY
1181 RTR /COMBINE TWO 4-BIT QUANTITIES
1182 TAD BMPBLK /INTO A CHARACTER
1187 DATABL, ZBLOCK 33 /DIRECT ACCESS TABLE
1189 \f/I,E,F,AND G FORMAT CONVERSIONS
1192 DCA W /SET WIDTH PROPERLY
1193 DCA D /FOR SCALING PURPOSES
1199 DCA GFLG /SET G AND E FLAGS
1202 DCA EFLG /SET E FLAG
1205 IGEF, JMS I [GETLMN /MAIN LOOP FOR CONVERSIONS - SKIPPED 1ST TIME
1207 DCA OD /SAVE COUNT OF POST-D.P. DIGITS
1209 SNA CLA /APPLY THE P-SCALE FACTOR
1210 TAD PFACT /ONLY IF THE FORMAT IS NOT I
1212 DCA SCALE /DON'T LOOK FOR TROUBLE
1213 JMS I [SKPOUT /CHECK IF MORE AND TEST DIRECTION
1214 JMP I (IGEFIN /INPUT
1216 DCA I [FFNEG /USE NEGATE ROUTINE HEADER AS SIGN FLAG
1219 CLL RAL /0 IF NOT E, -4 IF E
1220 TAD W /THIS PROVIDES FOR THE EXP. FIELD (IF E FMT)
1221 DCA OW /OR THE 4 TRAILING SPACES (IF G FMT)
1224 JMP SKPSHT /AC IS ZERO - SKP A LOT OF SHT
1226 JMS I [FFNEG /AC<0 - NEGATE IT AND SET FLAG (CLEVER)
1229 SMA SZA CLA /AC<1.0?
1231 JMS I [FPGO /YES - MULTIPLY BY 10.0
1234 TAD SCALE /BUMP POWER OF TEN
1236 \f/I,G,E,F, OUTPUT CONVERSIONS - NUMBER IS NOW =>1.0
1238 GT1, JMS I (SCALDN /NOW DECREASE IT TO THE INTERVAL [0,1)
1239 JMS I [FPGO /SAVE IT AWAY
1243 JMS I [FPGO /USE IT TO ROUND THE NUMBER TO BE OUTPUT
1245 JMS I (SCALDN /WE COULD HAVE ROUNDED FROM .999... TO 1.000...
1246 SKPSHT, TAD GFLG /ENTER HERE IF NUM WAS 0 - SCALE=0
1248 JMP NOTG /NOT G FORMAT
1249 TAD SCALE /G FORMAT - TEST FOR OUT OF F FORMAT RANGE
1251 CIA CLL /F FORMAT RANGE IS [.1,10**(D VALUE))
1254 JMP USEE /IF OUT OF BOUNDS USE E FORMAT (FLAG IS SET)
1255 DCA OD /REDUCE D VALUE BY SCALE FACTOR
1256 DCA EFLG /TO RETAIN CORRECT # OF SIG. DIGITS
1260 /SET UP TO PRINT DIGITS
1264 TAD PFACTX /COMPUTE EXPONENT JUST IN CASE E FORMAT
1269 SNA CLA /NOW COMPUTE THE NUMBER OF DIGITS BEFORE THE D.P.
1270 TAD SCALE /TAKE SCALE FACTOR INTO ACCOUNT IF NOT E FORMAT
1271 TAD PFACTX /TAKE P FACTOR INTO ACCOUNT IF NOT I OR F/G
1272 DCA SCALE /STORE THE NUMBER OF DIGITS BEFORE THE D.P.
1273 TAD I [FFNEG /INCREASE NUMBER OF LEADING BLANKS BY 1
1274 SPA CLA /IF THE NUMBER IS POSITIVE. THIS DEPENDS ON
1275 ISZ OW /THIS LOCATION BEING BELOW 4000.
1276 TAD SCALE /GET THE NUMBER OF PRE-D.P. DIGITS (AS NEGATIVE #)
1278 CLA IAC /IF NONE, PRINT A 0 SO COUNT AS 1
1279 TAD OD /REDUCE THE WIDTH BY THIS NUMBER
1281 TAD OW /REDUCE IT AGAIN BY THE POST-D.P. DIGIT COUNT
1283 TAD IFLG /AND AGAIN BY 1 FOR THE D.P. (IF NOT I FORMAT)
1286 \f/I,G,E,F FORMAT - ROUTINE TO SCALE ROUNDING FACTOR
1288 OSCALE, 0 /SUBR TO SCALE .5 THE CORRECT # OF TIMES
1289 DCA NPLCS /MAX IN AC ON ENTRY
1291 AC2000 /FORM A FLOATING 0.5 IN ORDER
1292 DCA ACH /TO ROUND THE NUMBER BEFORE PRINTING.
1294 TAD EFLG /FIGURE OUT HOW TO SCALE IT -
1295 SNA CLA /THE THEORY IS THAT IT SHOULD BE SCALED
1296 TAD SCALE /DOWN BY THE NUMBER OF SIGNIFICANT
1297 DCA T /PRINTING DIGITS. THIS CAN BE
1298 TAD SCALE /EXPRESSED AS:
1299 CIA CLL /(P FACTOR) * (NOT (G FMT PRINTING AS F))
1300 TAD OD / + (SCALE FACTOR) * (NOT E FMT) + (D VALUE).
1301 SZL CLA /THE SCALE FACTOR IS < 0 FOR
1302 TAD GFLG /NUMBERS < .1, WHICH REDUCES
1303 SNA CLA /THE # OF SIG. DIGITS VIA LEADING ZEROS.
1304 TAD PFACTX /IF THERE ARE < 0 SIG. DIGITS
1305 TAD T /IT DOESN'T MATTER WHAT WE DO
1306 TAD OD /SINCE THE NUMBER WILL PRINT AS
1307 SMA /0.00000 ANYWAY.
1308 CMA /IF THERE ARE >NPLCS SIG. PRINTING DIGITS
1309 TAD NPLCS /THE ROUNDING GETS MEANINGLESS SO MAKE
1310 SPA /THE EXCESS DIVISIONS DIVIDES BY 2 INSTEAD
1311 DCA ACX / OF BY 10. THIS FUDGE WORKS QUITE WELL
1312 CIA /FOR NUMBERS OF UP TO NPLCS+2
1313 TAD NPLCS /SIGNIFICANT DIGITS.
1317 FDIVLP, JMS I [FPGO /SCALE THE .5 DOWN THE CORRECT NUMBER OF TIMES
1325 \f/I,G,E,F OUTPUT CONVERSION - ACTUAL OUTPUT SECTION
1327 OUTNUM, SMA /CHECK FOR FIELD OVERFLOW
1328 JMP ASTSK1 /YES - PRINT *******
1329 JMS OBLNKS /PRINT LEADING BLANKS - AC IS NOT 0!
1330 /***IMPORTANT - OBLNKS CLEARS AC1 ***
1332 ISZ I [FFNEG /IF SIGN IS NEGATIVE,
1333 JMS DIGIT /OUTPUT A MINUS SIGN
1334 CLA /OTHERWISE OUTPUT NOTHING
1336 SNA /ALIGN THE FAC MANTISSA INTO A DOUBLEWORD
1337 JMS I [AL1 /FRACTION IN THE RANGE [.1,1)
1338 IAC /THIS INVOLVES SHIFTING THE MANTISSA
1339 CMA /RIGHT BY (-ACX-1) PLACES
1340 SMA /WHERE A NEGATIVE NUMBER MEANS A LEFT SHIFT.
1343 TAD ACL /NOW MOVE THE FAC DOWN A WORD SO THAT
1344 DCA AC1 /WHEN WE MULTIPLY BY 10 THE OVERFLOW APPEARS
1345 TAD ACH /IN THE HIGH-ORDER WORD
1348 SPA SNA /DO WE HAVE DIGITS TO THE LEFT OF THE D.P.?
1349 JMP PRZERO /NO - PRINT A ZERO THERE
1350 JMS DIGITS /YES - PRINT THEM
1353 JMP I (IGEF /IF I FORMAT, WE'RE DONE NOW
1355 JMS DIGIT /OTHERWISE PRINT DECIMAL POINT
1357 SMA CLA /CHECK WHETHER WE NEED TO PRINT LEADING ZEROS
1362 TAD OD /BUMP D VALUE DOWN BY ONE
1363 SNL /IF IT GOES NEGATIVE,
1364 JMP NOMOAC /WE'VE RUN OUT OF FIELD WIDTH
1366 JMS DIGIT /PRINT A ZERO
1367 ISZ T /UNTIL THE COUNT (OR THE WIDTH) RUNS OUT
1370 SZA /IF THERE ARE ANY DIGITS YET TO BE PRINTED,
1371 JMS DIGITS /PRINT THEM
1372 \f/I,G,E,F OUTPUT CONVERSION - FINISH UP
1377 JMP CHKG /NO - CHECK FOR G FORMAT OUTPUT AS F
1382 JMS I [FMTOUT /OUTPUT "E"
1383 TAD FMTNUM /GET EXPONENT
1386 CML CIA /SEPARATE INTO MAGNITUDE AND SIGN
1387 DCA FMTNUM /SAVE MAGNITUDE
1389 TAD (-5 /PRINT + OR -
1391 DCA T /INITIALIZE QUOTIENT OF DIVISION
1392 DVELP, TAD FMTNUM /SUBTRACT 10 FROM EXPONENT
1394 SPA /DID IT GO NEGATIVE?
1395 JMP PRNTXP /YES - DONE
1396 DCA FMTNUM /NO - STORE IT BACK
1397 ISZ T /BUMP QUOTIENT
1407 JMS DIGIT /PRINT TWO DIGITS OF EXPONENT
1411 SNA /WAS IT G FORMAT?
1412 JMP I (IGEF /NO - F OR I - DONE
1413 DCA EFLG /RE-SET EFLG SINCE WE ZEROED IT BEFORE
1415 JMS OBLNKS /OUTPUT 4 BLANKS
1416 JMP I (IGEF /DONE WITH G FORMAT OUTPUT
1418 PRZERO, CLA /COME HERE IF NO SIG. DIGITS LEFT OF D.P.
1419 JMS DIGIT /PRINT A ZERO
1420 JMP PRDCPT /CONTINUE
1424 ASTSK1, CLA /CLEAR THE AC
1425 TAD W /GET THE FIELD WIDTH
1428 \f/I,G,E,F OUTPUT CONVERSION - OUTPUT SUBROUTINES
1430 OBLNKS, 0 /SUBROUTINE TO PRINT A STRING OF BLANKS
1431 DCA AC1 /MUST LEAVE AC1 ZERO ON EXIT SO THAT
1432 JMP .+3 /FAC LEFT SHIFT WON'T SHIFT IN GARBAGE LATER ON
1434 JMS I [FMTOUT /OUTPUT A BLANK
1437 JMP I OBLNKS /RETURN
1439 DIGITS, 0 /ROUTINE TO OUTPUT A STRING OF DECIMAL DIGITS
1443 DCA AC2 /COPY AC INTO OPERAND FOR ADDITION LATER ON
1446 DCA ACH /CLEAR "OVERFLOW WORD"
1448 JMS I [AL1 /FAC=FAC*4
1451 JMS I [AL1 /FAC=ORIGINAL FAC*10
1452 TAD ACH /GET OVERFLOW
1454 ISZ T /LOOP FOR SPECIFIED NUMBER
1456 JMP I DIGITS /RETURN
1458 DIGIT, 0 /ROUTINE TO OUTPUT A DIGIT
1460 JMS I [FMTOUT /TRIVIAL, ISN'T IT?
1463 \f/I,G,E,F INPUT CONVERSION
1465 IGEFIN, STA /OD CONTAINS SCALING IF NO D.P. IN INPUT
1466 DCA DPSW /INITIALIZE D.P. SW
1468 DCA INESW /DITTO EXPONENT SWITCH
1471 DCA FMTNUM /GET CHAR COUNT
1472 INERSM, DCA ACX /RE-ENTER HERE AFTER SEEING "E"
1473 DCA ACH /CLEAR FLOATING AC
1476 JMP INMINS /SET SIGN PLUS
1478 INGCH, JMS I [FMTIN /GET A CHAR
1479 JMS I [CHTYPE /CLASSIFY IT
1485 -40; IBLDIG /BLANK - TREAT LIKE 0 IN FORTRAN STANDARD
1490 INDCPT, DCA OD /ZERO COUNT OF DIGITS AFTER D.P.
1491 ISZ DPSW /TEST AND SET D.P. SWITCH
1492 JMP INER /WHOOPS - TWO D.P.S IN A NUMBER
1493 JMP INLOOP /KEEP GOING
1495 IBLDIG, TAD EOLSW /SINCE THE BLEEPING STANDARD DOESN'T COVER
1496 SZA CLA /TELETYPE I/O, WE KEEP SOME COOL BY IGNORING
1497 JMP INLOOP /BLANKS CREATED BY EARLY LINE TERMINATION.
1500 DCA DGT+1 /SAVE THE DIGIT
1501 JMS I [FPGO /FORM 10*FAC + DIGIT IN FAC
1505 ISZ OD /BUMP DIGIT COUNT IF D.P. SEEN
1507 \fINMINS, DCA I [FFNEG /SET SIGN NEGATIVE
1510 JMP INGCH /LOOP UNTIL WIDTH EXHAUSTED
1511 INEONM, ISZ I [FFNEG /CHECK IF SIGN NEGATIVE
1512 JMS I [FFNEG /YES - NEGATE
1513 ISZ INESW /SEE IF "E" SEEN
1514 JMP FIXUPE /YES - WE HAVE EXPONENT, NOT NUMBER
1515 TAD PFACTX /NO "E" SEEN - SCALE USING P FACTOR
1517 SCALIN, TAD OD /GET SCALING FACTOR
1520 JMP I (IGEF /NO SCALING NECESSARY
1522 CIA CLL /AC CONTAINS MAGNITUDE, LINK CONTAINS SIGN
1525 RAL /AC CONTAINS 0 IF DIVIDE, 4 IF MULTIPLY
1528 JMS I [FPGO /MULTIPLY OR DIVIDE BY 10.0
1531 JMP IGEFOP-1/MULT OR DIV APPROPRIATE NUMBER OF TIMES
1532 JMP I (IGEF /RETURN FOR MORE
1534 INE, ISZ INESW /SEE IF THIS IS THE SECOND "E"
1535 JMP INER /YES - ERROR
1536 ISZ DPSW /FORCE DP SW ON (TO INHIBIT D.P. AFTER E)
1537 TAD OD /USE SCALE FACTOR ONLY IF D.P. SEEN
1538 DCA SCALE /SAVE SCALE FACTOR
1540 JMS I [FFNEG /GET SIGN OF NUMBER CORRECT
1541 JMS I [FPGO /SAVE IT TEMPORARILY
1543 JMP INERSM /GO COLLECT EXPONENT
1546 TAD ACI /GET EXPONENT
1548 TAD SCALE /ADD IN EXPONENT TO D.P. SCALE FACTOR
1550 JMS I [FPGO /GET NUMBER BACK IN FAC
1566 \fSCALDN, 0 /SUBROUTINE TO SCALE THE FAC LESS THAN 1.0
1568 SPA SNA CLA /IS THE FAC => 1.0?
1569 JMP I SCALDN /NO - WE'RE DONE
1570 JMS I [FPGO /DIVIDE BY TEN
1572 ISZ SCALE /BUMP POWER OF TEN
1583 JMP I ASTRSK /GET NEXT ELEMENT
1585 INESW, 0 /"E SEEN" SWITCH ON INPUT
1587 \f/L AND X FORMATS , T FORMAT INPUT
1589 TFMTIN, JMS I [FMTIN /FORCE INPUT BUFFER NON-EMPTY
1590 CLA /BY FETCHING AND WASTING A CHARACTER
1593 DCA EOLSW /SET TO BEGINNING OF LINE
1595 XFMTIN, JMS I [FMTIN
1596 H7600, 7600 /WASTE AN INPUT CHAR
1597 XFMT, JMS I [MORE /ANY MORE CHARS?
1598 TAD RWFLAG /YES - IN OR OUT?
1601 TPPLBL, TAD [40 /HERE WITH AC=13 TO OVERPRINT ON T OUTPUT
1605 LINGCH, JMS I [FMTIN
1606 JMS I [CHTYPE /GET AND CLASSIFY CHARACTER
1614 LINFLS, CLL RAR /PUT EITHER 0.0 OR 1.0 IN THE FAC
1620 JMP LINGCH /LOOP ON FIELD WIDTH
1622 LNXT, JMS I [GETLMN /GET NEXT ELEMENT FOR I/O
1625 DCA W /SAVE WIDTH AS A COUNT
1626 JMS I [SKPOUT /IN OR OUT?
1630 JMS I (OBLNKS /OUTPUT W-1 BLANKS
1634 TAD (6 /NON-ZERO IS TRUE, ZERO FALSE
1635 JMS I [FMTOUT /OUTPUT T OR F
1636 JMP LNXT /NEXT VICTIM
1637 \f/T FORMAT OUTPUT AND RANDOM SUBROUTINES
1641 DCA N /USE N TO FAKE OUT "X" FMT ROUTINE
1646 TAD EOLSW /COMPARE DESIRED POSITION WITH CURRENT ONE
1648 JMP TPBLNK /AFTER - SPACE TO IT
1649 JMS EOLINE /OUTPUT CR AND ZERO EOLSW
1650 JMS I [MORE /KLUDGE FOR "T1" FORMAT
1651 TAD (13 /FAKE X FORMAT INTO PRINTING
1652 JMP TPPLBL /A + AND (N-1) SPACES
1653 TPBLNK, DCA N /SAVE DIFFERENCE BETWEEN POSITIONS
1654 JMP XFMT /GO SPACE OUT
1656 EOLINE, 0 /SUBROUTINE TO TERMINATE I/O LINE
1657 TAD RWFLAG /CAUTION - AC LO-ORDER BITS MAY NOT BE 0
1658 SPA CLA /INPUT OR OUTPUT?
1660 JMS I [FMTIN /FORCE INPUT BUFFER NON-EMPTY
1663 DCA INXR /SET XR TO NEGATIVE WORD AT THE
1664 JMP .+3 /BEGINNING OF THE INPUT BUFFER
1666 JMS I [FMTOUT /OUTPUT A CARRIAGE RETURN
1667 DCA EOLSW /CLEAR EOLSW FOR INPUT AND OUTPUT
1669 \f/ROUTINE TO MOVE A HANDLER INTO FIELD 0
1671 GETHND, 0 /HANDLER CODE WORD IN AC ON ENTRY
1672 DCA HCW /SAVE HANDLER CODE WORD
1674 AND HCW /KNOCK OUT ION AND FORMS CTL BITS
1676 SZA /IF HANDLER IS NOT RESIDENT,
1677 TAD HKEY /SEE IF THE HANDLER IS ALREADY
1678 SNA CLA /IN THE HANDLER AREA IN FIELD 0
1680 TAD HCW /NO - PUT IT THERE
1683 DCA HNDCDF /GET CDF TO FIELD IN WHICH HANDLER RESIDES
1686 TAD (-1 /GET POINTER TO HANDLER ADDRESS
1687 DCA XR1 /IN THAT FIELD
1689 DCA XR /ALSO TO HANDLER AREA IN FIELD 0
1690 TAD [7400 /SET UP COUNT OF 7400
1691 DCA HKEY /INDEPENDENT OF HANDLER SIZE
1695 DCA I XR /MOVE HANDLER INTO HANDLER AREA
1700 DCA HKEY /SET NEW KEY CODE WORD
1703 SNA CLA /INTERRUPTS ALLOWED?
1704 YHIOF, IOF /NO - TOO BAD
1705 ISZ CTCINH /INHIBIT ^C DURING HANDLER CALL
1710 \f/CHARACTER INPUT ROUTINE - LINE AT A TIME
1714 SNA /END OF LINE ALREADY FOUND?
1715 TAD I INXR /NO - GET CHAR FROM LINE BUFFER
1716 SPA /TIME TO READ A NEW LINE?
1719 JMP INEOL /YES - SET INDICATOR
1720 AND [77 /CONVERT TO SIXBIT
1721 JMP I FMTIN /RETURN WITH IT
1723 UNPKLN, DCA EOLSW /SET EOL INDICATOR TO A BLANK
1724 JMP FMTIN+1 /AND RETURN BLANKS FROM HERE ON IN
1725 READLN, DCA EOLSW /USE EOLSW AS A COUNT SO IT WINDS UP 0
1728 SNA CLA /IS IT TELETYPE INPUT?
1729 STA /YES - SET TTY FLAG
1732 TTYLF, 12 /ECHO LF IF TTY INPUT
1733 TAD [12 /TTYLF IS ZEROED BY ABORTO
1738 SPA CLA /CHARACTER ORIENTED DEVICE?
1739 JMP MASSIN /NO - UNPACK CHAR FROM BUFFER
1740 JMS I HAND /GET A CHARACTER
1741 GOTCHR, AND [177 /STRIP OFF PARITY
1742 JMS I [CHTYPE /CLASSIFY IT
1743 -15; INCRET /CARRIAGE RETURN
1744 -177; RUBOUT /RUBOUT
1751 SMA /IF CHARACTER IS >37,
1752 JMS INPUTC /STORE IT AND ECHO IT IF TTY
1754 \f/CHARACTER INPUT ROUTINE - SPECIAL CHARACTER HANDLERS
1756 INTAB, JMS INPUTC /TAB - INSERT (AND ECHO) BLANKS
1759 SZA CLA /UNTIL A COLUMN MULTIPLE OF 8 IS REACHED
1765 TAD I (INBUFR /IGNORE RUBOUTS IF LINE EMPTY
1768 JMP READLP /OR IF NON-TTY INPUT
1770 134 /ECHO A BACKSLASH
1773 DCA INXR /BACK UP LINE POINTER
1776 DCA EOLSW /AND CHAR COUNTER
1779 INEOF, TAD VEOFSW /CHECK SWITCH SET BY "CHKEOF" LIBRARY ROUTINE
1780 SNA /WAS HE EXPECTING AN EOF?
1781 EOFERR, JMS I ERR /NO
1784 HLT /CDF TO FIELD OF INDICATOR VARIABLE
1786 DCA I VEOFSW+1 /SET VARIABLE TO .5
1787 CDF 0 /FALL INTO CARRIAGE RETURN CODE
1789 INCRET, DCA I INXR /CARRIAGE RETURN - ZERO OUT REST OF LINE
1791 CTRLU, STA /SNEAKY, SNEAKY!
1793 DCA INXR /RESET XR TO FETCH LINE CHARS
1796 JMP UNPKLN /BACK TO FETCH FIRST CHAR
1798 INPUTC, 0 /ROUTINE TO STORE AND ECHO A CHAR
1802 INTMP, 0 /ECHO CHAR IF TTY INPUT
1804 DCA I INXR /STORE CHAR IN LINE BUFFER
1806 JMP I INPUTC /RETURN IF NO OVERFLOW
1807 JMP IBAKUP /IGNORE CHAR IF OVERFLOW
1808 \fECHO, 0 /ROUTINE TO ECHO CHAR IF TTY INPUT
1809 TAD I ECHO /GET CHAR
1811 SZA /SHOULD WE ECHO?
1813 JMP I ECHO /RETURN TO CHARACTER - ITS SMALL
1816 /CHARACTER INPUT ROUTINE - MASS STORAGE SECTION
1818 MASSIN, JMS MASBMP /GET BUFFER FIELD AND CHAR NUMBER
1819 JMP INLORD /CHAR 1 OR 2 - STRAIGHTFORWARD
1820 JMS I (GETCH3 /USE COMMON SUBROUTINE
1821 JMP MASICM /GO TO COMMON CODE
1823 INLORD, JMS I [MASSIO /CHECK IF WE SHOULD READ IN A BUFFERLOAD
1824 JMS BUFFLD /SET FIELD OF BUFFER
1826 MASICM, ISZ CHRPTR /GET THE CHAR (IN LOW 8 BITS) AND BUMP PTR
1827 NOP /WATCH END OF FIELD FUNNYBUSINESS!
1828 CDF 0 /RESET DATA FIELD
1829 JMP GOTCHR /GO EXTRACT SEVEN BIT CHARACTER
1832 JMS BUFFLD /SET TO BUFFER'S DATA FIELD
1833 ISZ CHRCTR /BUMP CHAR COUNTER
1834 JMP I MASBMP /CHAR 1 OR 2 - NO SWEAT
1836 DCA CHRCTR /CHAR 3 - RESET CHAR CTR
1838 TAD CHRPTR /BUMP BACK CHAR PTR
1841 JMP I MASBMP /SKIP RETURN
1843 \f/CHARACTER OUTPUT ROUTINE
1846 TAD [40 /FIRST CONVERT SIXBIT TO ASCII
1847 SMA /CTL CHARS COME IN NEGATIVE
1850 DCA OCHAR /SAVE ASCII CHAR (WITHOUT PARITY BIT)
1853 JMP NOT1ST /FIRST CHAR IS DECODED FOR FORMS CONTROL
1854 AC0002 /CHECK TO SEE IF THIS UNIT
1855 AND HCODEW /SHOULD RECEIVE FORMS CONTROL
1857 JMP LFPLCH /NO - JUST PRINT A LINE FEED AND THE CHAR
1859 JMS I [CHTYPE /CLASSIFY CONTROL CHAR
1860 -261; OUTFFX /1 - TOP OF FORM
1861 -260; OUT2LF /0 - DOUBLE SPACE
1862 -253; NOLF /+ - OVERPRINT
1863 0 /ANYTHING ELSE - SINGLE SPACE
1867 TAD (-TTY /IF HANDLER IS TTY OUTPUT TWO LINE FEEDS
1868 SZA CLA /INSTEAD OF A FORM FEED
1871 DCA OCHAR /SET 2ND CHAR TO LINE FEED
1873 DCA EOLSW /SET SWITCH FOR 2ND CHAR
1875 DCA CHCH /SAVE CHARACTER AWAY
1877 OUTFF, TAD F214 /SUBSTITUTE THE APPROPRIATE FORM CONTROL
1878 DCA OCHAR /FOR THE CHARACTER
1880 SPA CLA /CHARACTER ORIENTED DEVICE?
1881 JMP MASOUT /NO - PACK CHAR INTO BUFFER
1883 JMS I HAND /OUTPUT CHAR
1884 NOLF, ISZ EOLSW /BUMP CHAR CTR
1885 JMP I FMTOUT /NO - RETURN
1886 TAD CHCH /AHA - ANOTHER CHARACTER SHOULD BE OUTPUT
1887 JMP OUTFF+1 /GO TO IT
1888 \f/CHARACTER OUTPUT - MASS STORAGE OUTPUT
1890 MASOUT, JMS I (MASBMP /GET BUFFER FIELD AND CHAR NUMBER
1891 JMP OULORD /CHAR 1 OR 2 - STRAIGHTFORWARD
1892 JMS OSUBR /CHAR 3 - PACK FIRST HALFBYTE
1893 JMS OSUBR /PACK SECOND HALFBYTE
1895 JMS MASSIO /CHECK IF WE SHOULD DUMP THE BUFFER
1897 JMP NOLF /GO RETURN OR REENTER
1900 DCA I CHRPTR /STORE CHAR, ZAPPING HIGH-ORDER BITS
1901 ISZ CHRPTR /BUMP CHAR PTR
1902 F214, 214 /GUARD AGAINST OVFLO
1905 OSUBR, 0 /ROUTINE TO PACK A HALFBYTE
1908 RTL /SHIFT CHAR 4 LEFT
1910 TAD I CHRPTR /CLEAR OUT ANY RESIDUE
1911 AND [377 /FROM HIGH-ORDER OF BUFFER WORD
1912 DCA I CHRPTR /IN CASE WE ARE WRITING AFTER A BACKSPACE.
1914 AND [7400 /GET 4 BITS
1916 DCA I CHRPTR /ADD INTO HIGH-ORDER OF BUFFER WORD
1917 ISZ CHRPTR /BUMP POINTER
1921 MASSIO, 0 /SUBROUTINE TO READ/WRITE BUFFER IF NECESSARY
1923 TAD BUFCDF /ADD BUFFER CDF TO R/W BIT IN AC
1924 TAD (-6001 /TAKE AWAY CDF, LEAVE BIT 4 ON
1925 DCA IOCTL /STORE I/O CONTROL WORD
1928 SZA CLA /SEE IF POINTER IS AT BUFFER BOUNDARY
1929 JMP I MASSIO /YES - RETURN DOING NOTHING
1931 TAD STBLK /STORE BLOCK # IN HANDLER CALL
1935 DCA BUFFER /STORE BUFFER ADDRESS IN HANDLER CALL
1936 \f/CHARACTER OUTPUT - BUFFER I/O ROUTINE CONTINUED
1941 SZL CLA /CHECK FOR FILE OVERFLOW
1942 IOVFLO, JMS I ERR /YES - ERROR
1944 JMS I (GETHND /GET HANDLER INTO FIELD 0
1945 JMS I HAND /CALL HANDLER
1949 SMA CLA /HANDLER ERROR - ABORT
1952 JMS I (RECOVR /CLEAR ANY FLAGS SET BY OS8 HANDLER
1953 ISZ RELBLK /BUMP RELATIVE BLOCK NUMBER
1955 DCA CHRPTR /RESET CHAR PTR
1956 JMP I MASSIO /RETURN
1957 /FPP CODE FOR I/O CONVERSION
1962 OCHAR, 0 /*** NEEDED FOR PADDING ***
1963 FMUL10, FMUL+LONG /FMUL10 MUST BE AT FDIV10+4
1973 \f/UNFORMATTED (BINARY) INPUT-OUTPUT
1975 RWUNF, JMS I [RWINIT /"READ(N)" OR "WRITE(N)"
1976 1000 /"UNFORMATTED" BIT
1977 TAD SZLCLA /ENABLE SEQUENCE CHECKING
1978 UNFIO, DCA SEQCHK /*** SET SEQCHK TO "SZL CLA" OR "CLA"
1979 DCA RECCTR /ENTER HERE FROM DIRECT ACCESS
1981 SMA CLA /CHECK FOR MASS-STORAGE HANDLER
1982 JMP I [UNTERR /NO - ERROR
1983 JMS I [GETLMN /GET FIRST VARIABLE
1986 RSETBP, TAD (125 /INITIALIZE COUNT TO -86 FOR WRITE,
1991 DCA BIOPTR /INITIALIZE BUFFER POINTER
1995 CLL RTR /AC BIT 0 NOW ON
1996 TAD RWFLAG /AC BIT 0 CONTAINS COMP. OF R/W FLAG
1997 CLL RAR /AC=(.NOT.RW)*2000+BUFFER FIELD
1998 TAD (FSTA+LONG /AC=(FSTA OR FLDA) + BUFFLD
2000 JMP UIOVLP /SKIP FIRST VARIABLE FETCH/STORE
2002 FGPBF /LOAD OR STORE A BUFFER ENTRY
2004 ISZ BIOPTR /INCREASE BUFFER POINTER
2006 JMS I [GETLMN /GET A VARIABLE FROM THE CALLING PROGRAM
2008 CLL RAR /LOWORDER BIT OF RWFLAG = END LIST FLAG
2010 JMP ENDUIO /NO MORE VARIABLES - TERMINATE
2011 ISZ CHRCTR /BUMP COUNTER
2012 JMP BFINCR /ROOM IN BUFFER - MOVE VARIABLE
2013 JMS UDOIO /GET A NEW BUFFER
2014 JMP RSETBP /RESET BUFFER POINTERS AND COUNTERS
2016 ENDUIO, TAD RWFLAG /COME HERE WHEN I/O LIST EXHAUSTED
2018 JMS UDOIO /YES - WRITE OUT THE LAST BUFFER
2019 JMP I [ENDIO /RESTORE DSRN ENTRY AND QUIT
2022 \f/DIRECT-ACCESS I/O
2024 RWDACC, JMS I [RWINIT /"READ(N'R)" OR "WRITE(N'R)"
2025 1000 /DIRECT ACCESS IS UNFORMATTED I/O
2027 DCA T /GET BLOCKS/RECORD FACTOR FROM D.A. TABLE
2028 JMS I [ARGLD /GET RECORD NUMBER
2029 JMS I [FFIX /CONVERT TO INTEGER
2032 ISZ T /MULTIPLY RECORD NUMBER BY BLOCKS/RECORD
2033 JMP .-2 /TO GET RELATIVE BLOCK NUMBER
2036 SNA /THIS LOC SHOULD NOT BE ZERO!
2038 DCA FGPBF /IT SHOULD BE AN FSTA + THE FIELD
2039 TAD I XR /IN WHICH THE CONTROL VARIABLE IS
2040 DCA BIOPTR /STORED. THE NEXT WORD IS THE ADDRESS
2041 JMS I [FPGO /OF THE CONTROL VARIABLE IN THAT FIELD
2042 FADD1 /ADD 1 TO RECORD # AND STORE IN CONTROL VAR
2043 TAD DUMPIT /*K* "DCA T" SAME AS "CLA" HERE
2044 JMP UNFIO /NOW GO DO A REGULAR BINARY READ/WRITE
2047 ISZ RECCTR /BUMP NUMBER OF RECORDS TRANSFERRED
2050 TAD [377 /FORM POINTER TO LAST WORD IN BUFFER
2054 DCA I BIOPTR /FOR WRITE, PUT RECORD NUMBER IN 256TH WORD
2058 JMS I [MASSIO /DO I/O (CHRPTR=0 TO FORCE I/O)
2061 CMA STL /FOR READ, CHECK THE INPUT
2062 TAD I BIOPTR /SEQUENCE NUMBER TO MAKE SURE IT IS
2063 CDF 0 /NO LARGER THAN THE ONE WE EXPECT.
2064 SEQCHK, SZL CLA /*K* IF IT IS LARGER THIS IMPLIES THAT WE
2065 JMP I UDOIO /ARE STILL IN THE MIDDLE OF THE LAST
2066 JMP UDOIOL /RECORD AND SO WE READ AGAIN.
2067 \f/DEFINE FILE PROCESSOR
2069 DFINE, JMS I [RWINIT /SET UP A POINTER INTO THE D.A. TABLE
2070 1000 /DIRECT ACCESS I/O IS UNFORMATTED
2071 JMS I [ARGLD /GET NUMBER OF RECORDS
2075 DUMPIT, DCA T /SAVE IT FOR MULTIPLY
2076 JMS I [ARGLD /GET THE NUMBER OF WORDS/RECORD
2077 JMS I [FPGO /CONVERT WORDS TO BLOCKS
2079 JMS I [FFIX /CONVERT TO INTEGER
2081 TAD ACI /MULTIPLY THE NUMBER OF BLOCKS/RECORD
2082 ISZ T /BY THE NUMBER OF RECORDS
2084 DCA RELBLK /TO GET THE FILE LENGTH IN BLOCKS
2087 DCA I XR /STORE NUMBER OF BLOCKS/RECORD
2088 JMS I [ARGLD /GET POINTER TO CONTROL VARIABLE
2090 TAD (FSTA-FLDA /CHANGE A LOAD TO A STORE
2091 DCA I XR /SAVE "FSTA CONTROL-VARIABLE"
2096 TAD RELBLK /MAKE SURE WE HAVE ROOM FOR THE FILE
2098 DFERR, JMS I ERR /WE DON'T
2101 IAC /FORCE "END-FILED" BIT FOR CLOSE
2102 JMP I (SETTOT /SET LENGTH AND EXIT
2104 \f/SWAPPER AND ERROR ROUTINE
2106 SWAP, JMS I [FETPC /SWAPPER CALLING SEQUENCE:
2108 TAD T / ADDR OVLY*4000000+LVL*100000+ENTRYADR
2111 DCA STRTUP /STORE JA TO ENTRY POINT
2117 TAD (OVLYTB /INDEX INTO LEVEL TABLE
2121 DCA T /T CONTAINS OVERLAY NUMBER IN BITS 0-3
2124 TAD T /SEE IF THIS OVERLAY IS IN CORE
2126 JMP ITSIN /YES - DON'T LOAD
2129 DCA I ADR /MARK THIS OVERLAY IN CORE (OPTIMIST)
2133 DCA OVADR /SAVE INITIAL OVERLAY LOAD ADDRESS
2136 DCA OVIOW /AND FIELD
2138 TAD I ADR /GET STARTING BLOCK OF THIS LEVEL
2142 DCA OVLEN /STORE LENGTH OF OVERLAY IN BLOCKS
2143 OVADLP, TAD T /LEVEL STARTING BLOCK +
2144 SNA /(OVERLAY #) * (OVERLAY LENGTH)
2145 JMP LOADOV /= OVERLAY STARTING BLOCK
2152 \f/SWAPPER - CONTINUED
2154 LOADLP, DCA OVLEN /STORE UPDATED OVERLAY LENGTH
2155 TAD OVIOW /GET LAST READ CONTROL WORD
2157 AND [7400 /CONVERT BLOCK COUNT TO WORD COUNT
2158 TAD OVADR /INCREMENT OVERLAY LOAD ADDRESS (LINK = 0)
2162 TAD OVIOW /TO INCREMENT THE LOAD FIELD IF NECESSARY
2164 DCA OVIOW /OVIOW CONTAINS ONLY THE LOAD FIELD NOW
2167 CIA /LOTSA CALCULATIONS HERE - OS/8 HANDLERS
2168 SNA /CAN'T READ MORE THAN 15 BLOCKS AT A TIME
2169 TAD [7400 /AND CANNOT READ OVER FIELD BOUNDARIES
2171 RTL /SO WE MUST BREAK UP THE OVERLAY READ
2172 CMA CML RAL /INTO SEVERAL SMALL READS OF MAXIMAL LENGTH.
2173 TAD OVLEN /THE NUMBER OF BLOCKS TO READ IS GIVEN BY:
2174 CMA /MINIMUM(B,L,15)
2175 SMA /WHERE B IS THE # OF BLOCKS LEFT IN THIS FIELD
2176 CLA /AND L IS THE # OF BLOCKS LEFT IN THE OVERLAY
2177 TAD OVLEN /AND 15 IS THE # OF BLOCKS A HANDLER CAN READ
2182 RTR /TURN NUMBER OF BLOCKS INTO 0S/8 BLOCK COUNT
2184 DCA OVIOW /ADD FIELD BITS AND STORE AS I/O CONTROL WD
2185 TAD OVHCDW /GET OVERLAY HANDLER CODE WORD
2186 JMS I (GETHND /LOAD HANDLER INTO FIELD 0
2191 OVERR, JMS I ERR /WHOOPS - OVERLAY READ ERROR
2192 JMS RECOVR /CLEAR ANY NASTY FLAGS LEFT BY HANDLER
2195 DCA OVBLK /UPDATE BLOCK NUMBER
2198 TAD OVLEN /BUMP DOWN RECORD COUNT
2199 SZA /SEE IF WE ARE DONE
2200 JMP LOADLP /NO - PREPARE FOR NEXT READ
2201 \f/OVERLAY IN CORE - EXECUTE IT
2203 ITSIN, JMS I [FPGO /START UP FPP
2204 STRTUP /AND JA TO ENTRY POINT
2210 FPPERR, JMS I ERR /SHOULD NEVER GET HERE
2212 STRTUP, 0;0 /JA ENTRY
2214 OVHND, 0 /SET BY LOADER
2215 OVHCDW, 0 /SET BY LOADER
2217 RECOVR, 0 /ROUTINE TO CLEAN UP ANY FLAGS
2218 DCA CTCINH /LEFT ON BY SLOPPY OS/8 HANDLERS.
2222 NOP /RIGHT NOW I DON'T KNOW OF ANY.
2234 TEN, 4;2400;0;0;0;0 /10.0D0
2235 FLTG85, 7;2520;0 /85.0
2237 \f/INPUT BUFFER - CONTAINS STARTUP CODE
2239 INBUFR, -206 /LENGTH
2240 0 /INPUT LINE BUFFER - FIRST A LITTLE PADDING,
2242 /RTS EXECUTION INITIALIZATION - IN INPUT BUFFER
2244 FPSTRT, 6601 /CLEAR DF32 FLAG
2247 PP7600, 7600 /CLEAR READER CHAR
2248 6135 /CLEAR KW12 OR DK8-EP EVENT FLAGS
2250 6132 /STOP KW12 CLOCKS
2251 6134 /DISABLE KW12 INTERRUPTS
2252 6530 /CLEAR AD8-EA FLAGS
2253 6050 /CLEAR VC8/E FLAG
2254 6500 /DISABLE XY8/E INTERRUPTS
2256 6130 /DISABLE DK8-EP INTERRUPTS
2257 CLA /LEAVE SPACE FOR ADDITIONAL CLEARS
2270 LDPROG, JMS I [FPGO /START UP FPP OR PSEUDO-FPP
2272 HLTNOP, NOP /SET TO HLT IF /H SPECIFIED,
2273 JMP PRTCR /SKP IF /P SPECIFIED
2275 DCA LDPROG /BYPASS LOADING ON STARTUP
2278 \f/ROUTINE TO PUNCH RTS+PROGRAM ON FORTRAN UNIT 9 (UNCOMMENTED)
2293 JFMOUT, JMS I [FMTOUT /*K* ONLY WORKS FOR FIELD 0-3
2320 DCA I (ENDFLS /*K* SAME KLUDGE AS CALXIT
2322 DCA I (PDPXIT+1 /WIPE HALT SO WE CAN RETURN TO OS/8
2349 PCTR, 200 /DON'T PUNCH 07600!
2352 JMS I PTTY /PRINT CARRIAGE RETURN
2354 DCA I (ERRENB /ENABLE ERROR TRACEBACK
2356 STJUMP /NOW JUMP TO THE NEWLY-LOADED CODE
2357 STSWAP, TRAP3 /TRAP3
2366 ZBLOCK INBUFR+210-. /PAD OUT TO END OF BUFFER
2367 \f/OVERLAY AND DSRN TABLES
2369 *.-4 /FIRST ENTRY IN OVLYTB ONLY NEEDED TO LOAD MAIN PGM
2371 OVLYTB, ZBLOCK 40 /OVERLAY TABLE
2373 DSRN, PTR; ZBLOCK 10
2377 1234 /*K* PREVENT PROBLEM IN
2378 ZBLOCK 5 /RWINIT INVOLVING WRITE
2379 /AFTER READ ON TELETYPE
2382 ZBLOCK 12 /FORMAT PARENTHESIS PUSHDOWN LIST
2383 FMTPDL, 0 /GUARD WORD
2385 \f/SOFTWARE FLOATING POINT ROUTINES WHICH ARE USED
2386 /EVEN IF FLOATING HARDWARE IS PRESENT
2388 /** MUST NOT DESTROY FAC! **
2390 FFIX, 0 /ROUTINE TO FIX FAC
2391 STA /ANSWER IS RETURNED IN ACI
2392 TADACX, TAD ACX /ABS(FAC) MUST BE LESS THAN 2048
2393 CLL /DETERMINE IF FAC EXPONENT IS
2394 TAD (-13 /BETWEEN 1 AND 14
2396 JMP FIXBIG /14 IS A SPECIAL CASE
2399 JMP FIXDNE /EXP GT 14 OR LT 1 - RETURN 0
2402 FIXLP, CLL /0 IN LINK
2403 SPA /IS IT LESS THAN 0?
2404 CML /YES-PUT A 1 IN LINK
2406 FIXISZ, ISZ ACI /DONE YET?
2408 FIXDNE, DCA ACI /RETURN WITH ANSWER IN ACI
2411 FIXBIG, TAD ACL /IF EXP IS 14 WE MUST SHIFT AC FRACTION
2412 RAL /LEFT ONE PLACE TO INTEGERIZE IT.
2416 JMP FIXDNE /STORE ANSWER AND RETURN
2419 DCA I (BASCDF /SET BASE PAGE LOCATION
2424 /SHIFT FAC LEFT 1 BIT
2427 TAD AC1 /GET OVERFLOW BIT
2430 TAD ACL /GET LOW ORDER MANTISSA
2433 TAD ACH /GET HI ORDER
2438 /SHIFT FAC RIGHT-ENTER WITH COUNT-1 IN AC (POSITIVE)
2441 CMA /AC CONTAINS COUNT-1
2442 DCA AC0 /STORE COUNT
2443 LOP1, TAD ACH /GET HIGH ORDER MANTISSA
2447 RAR /SHIFT RIGHT 1, PROPAGATING SIGN
2449 TAD ACL /GET LOW ORDER
2452 ISZ ACX /INCREMENT EXPONENT
2457 DCA AC1 /SAVE 1 BIT OF OVERFLOW
2458 JMP I ACSR /YES-RETN-AC=L=0
2462 FFNEG, 0 /(USED AS A TEM. BY OUTPUT ROUTINE)
2463 TAD ACL /GET LOW ORDER FAC
2464 CLL CMA IAC /NEGATE IT
2466 CML RAL /ADJUST OVERFLOW BIT AND
2467 TAD ACH /PROPAGATE CARRY-GET HI ORD
2468 CLL CMA IAC /NEGATE IT
2471 \fOADD, 0 /ADD OPERAND TO FAC
2473 TAD AC2 /ADD OVERFLOW WORDS
2477 TAD OPL /ADD LOW ORDER MANTISSAS
2481 TAD OPH /ADD HI ORDER MANTISSAS
2488 JMP PCCDF /NO FIELD BUMP
2489 ISZ APT /BUMP FIELD FOR FPP RESTART (IN CASE FPP EXISTS)
2490 FPC10, 10 /PROTECTION FOR ISZ
2498 EEPUT, STL /EXTENDED PRECISION STORE
2499 EEGET, DCA ADR /EXTENDED PRCISION FETCH
2503 AC2000 /SET UP "TAD ACX" OR "DCA ACX"
2506 EELOOP, SNL /LINK=1 MEANS STORE
2526 \f/RUN-TIME SYSTEM ERROR LIST
2528 ERRLST, VARGER; ARGMSG
2543 -1; DV0MSG /BY ELIMINATION
2544 \f/RTS ERROR MESSAGES
2546 ARGMSG, TEXT /BAD ARG/
2547 UMSG, TEXT /USER ERROR/
2548 FPOMSG, TEXT /PARENS TOO DEEP/
2549 FMTMSG, TEXT /FORMAT ERROR/
2550 UNTMSG, TEXT /UNIT ERROR/
2551 INMSG, TEXT /INPUT ERROR/
2552 OVMSG, TEXT /OVERLAY /
2554 IOMSG, TEXT %I/O ERROR%
2555 DAMSG, TEXT /NO DEFINE FILE/
2556 FPPMSG, TEXT /FPP ERROR/
2557 INEMSG, TEXT /EOF ERROR/
2558 DV0MSG, TEXT /DIVIDE BY 0/
2559 DFMSG, TEXT /D.F. TOO BIG/
2560 IOVMSG, TEXT /FILE /
2562 OFLMSG, TEXT /OVERFLOW/
2565 USRERR, TAD ERRFLG /USER ERROR - OPTIONALLY NON-FATAL
2567 UERR, JMS I ERR /PRINT MESSAGE
2568 JMP I [RETURN /IF NON-FATAL, CONTINUE PROCESSING
2569 ERRFLG, 0 /SET TO NON-ZERO IF /E SWITCH SPECIFIED
2571 TRPPRT, TRAP3 /CODE WHICH IS LOADED INTO PROGRAM PROLOGUES
2572 PRTNAM /BY THE ERROR TRACEBACK ROUTINE
2574 \fMAKCDF, 0 /ROUTINE TO MAKE A CDF FROM AC9-11
2578 TAD ERCDF /STRAIGHTFORWARD ENOUGH, ISN'T IT?
2581 RD2WR, 0 /ROUTINE CALLED WHEN SWITCHING
2582 STA /FROM READ TO WRITE. (CALLED ONLY ONCE!)
2583 TAD RELBLK /BUMP BLOCK # BACK FROM "NEXT BUFFER'S BLOCK #"
2584 DCA RELBLK /TO "THIS BUFFER'S BLOCK #".
2585 TAD CHRCTR /HOWEVER, IF WE ARE AT THE VERY END OF A
2586 IAC /BUFFER, WRITE ROUTINE EXPECTS US TO
2587 SZA CLA /BE AT THE BEGINNING OF THE NEXT BUFFER,
2588 JMS I [MASSIO /SO RE-READ THIS BUFFER AND SET POINTERS
2591 /RUN-TIME-SYSTEM ERROR ROUTINE
2598 ERRLP, ISZ XR /SEARCH ERROR LIST FOR CALLING ADDRESS
2599 TAD I XR /ERROR LIST CONTAINS
2601 SZA /CALLING ADDRESSES AND
2602 TAD ERROR /CORRESPONDING MESSAGES
2609 DCA HAND /QUICK FUDGE FOR TTY OUTPUT
2610 DCA HCODEW /TO SET CARRIAGE CONTROL
2613 JMS I [EOLINE /TYPE CARRET AND SET EOLSW
2614 DCA FMTBYT /INITIALIZE MESSAGE PTR
2615 ERPTLP, JMS I [FMTOUT /OUTPUTS LF FIRST TIME
2616 JMS I [FMTGCH /GET CHAR USING FORMAT ROUTINES
2619 JMP ERPTLP /LOOP UNTIL 0 CHAR
2620 \f/PRINT ROUTINE NAME AND LINE NUMBER
2623 ERRENB, JMP I E7605 /*K* IN CASE INITIALIZATION OR /P GET ERRORS
2624 / PREVIOUS LINE REPLACED WITH:
2625 / JMS I [FMTOUT /OUTPUT A BLANK(LF ON EXTRA LINES)
2626 JMS I [FPGO /START UP FPP
2627 GTNMPT /GET POINTER TO NAME IN FAC
2629 DCA I (FMTDF /SET UP FORMAT GET CHARACTER ROUTINE
2630 TAD ACL /TO GET CHARACTERS OF ROUTINE NAME
2634 DCA ISN /6 CHARACTER NAME
2635 PRTNML, JMS I [FMTGCH
2637 TAD [40 /AVOID PRINTING RANDOM @S
2638 JMS I [FMTOUT /GET AND PRINT A CHARACTER
2643 JMS I [FMTOUT /SEPARATE THE NAME BY A SPACE
2644 TAD [-4 /FROM THE LINE NUMBER.
2649 DCA ISN+1 /PRINT LINE NUMBER IN OCTAL
2650 TAD ISN+1 /BECAUSE THAT IS THE WAY IT APPEARS
2651 RAL /IN THE FORTRAN PROGRAM LISTING
2657 JMS I [EOLINE /OUTPUT FINAL CR
2659 SNA CLA /FATAL ERROR?
2660 JMP TRCBAK /YES - GIVE FULL TRACEBACK
2661 DCA FATAL /"NON-FATAL" FLAG MUST BE SET EACH TIME
2663 TRCBAK, JMS I [FPGO /START UP FPP
2664 UP1LEV /MOVE UP TO CALLING ROUTINE
2665 /FPP CODE DOES A "TRAP3 PRTNAM"
2667 \f/FPP CODE FOR ERROR ROUTINE
2670 XTA 0 /LOAD LINE NUMBER FROM XR 0
2673 FLDA+BASE 10 /LOAD POINTER TO PROLOGUE
2675 THREE /NAME IS 3 LOCATIONS BEFORE PROLOGUE
2676 STARTF /FOR NON-FPP VERSION
2677 THREE, FEXIT;3 /*K* DEPENDS ON FACT THAT FEXIT=0
2680 FLDA+BASE 11 /GET THE UPWARD POINTER
2682 NOTMN /ZERO MEANS MAIN PROGRAM
2684 E7605, 7605 /GO AWAY IF MAIN PROGRAM
2687 2 /WE WILL STORE A "TRAP3 PRTNAM"
2688 FLDA+LONG /IN THE FIFTH LOCATION OF THE PROLOGUE,
2690 FSTA+IND 0+10 /WHERE THE FIRST 4 LOCS WERE A SETX AND SETB.
2691 FLDA+BASE 0 /GET THE PROLOGUE ADDRESS AGAIN
2699 DGT /GET UNNORMALIZED DIGIT INTO AC
2707 \fHPLACE, /ZBLOCK 400 /HANDLER SWAP AREA
2709 /VARIOUS INITIALIZATION STUFF OVERLAYING THE RTS HANDLER AREA
2711 QLHDR, 0 /SHOULD BE A 2 FOR A LOADER IMAGE
2712 QRTSWP, ZBLOCK 2 /INITIAL SWAP ARGS TO LOAD USER MAIN
2713 QHGHAD, ZBLOCK 2 /HIGHEST ADDRESS USED
2714 QVERNO, 0 /LOADER VERSION #
2715 QDPFLG, 0 /"PROGRAM USES D.P." FLAG
2716 QUSRLV, ZBLOCK 40 /USER OVERLAY INFO
2718 /EAE OVERLAY TO FIX AND FLOAT
2720 EFXFLT, RELOC EAEFIX
2723 DCA FIXSH /SHIFT COUNT BETWEEN 0 AND 12
2725 JMP FIX0 /NOT INTEGERIZABLE
2734 \f/SUBR TO DETERMINE MACHINE SIZE - RETURNS NUMBER OF
2736 /MUST RUN IN FIELD 0.
2742 CORELP, CDF 0 /NEEDED FOR PDP-8L
2744 AND COR70 /IF BITS 6-8 OF LOCATION 7777 ARE NOT ZERO,
2745 CLL RTR /THEY SPECIFY THE LAST FIELD OF CORE
2746 RAR /WHICH WE SHOULD USE.
2748 JMP CORRET /SO RETURN THAT AMOUNT
2749 TAD TRYFLD /GET FLD TO TST
2752 AND COR70 /MASK USEFUL BITS
2754 DCA COR706 /SET UP CDF TO FLD
2756 TAD I CORLOC /SAV CURRENT CONTENTS
2759 TAD .-2 /7000 IS A GOOD PATTERN
2761 COR70, 70 /HACK FOR PDP-8.,NO-OP
2762 TAD I CORLOC /TRY TO READ BK 7000
2763 CO7400, 7400 /HACK FOR PDP-8,.NO-OP
2764 TAD CO7400 /GUARD AGAINST WRAP AROUND
2765 TAD CORLOC+1 /TAD 1400
2767 JMP .+5 /NON EXISTENT FLD EXIT
2768 TAD COR706 /RESTORE CONTENS DESTROYED
2770 ISZ TRYFLD /TRY NXT HIGHER FLD
2776 CORLOC, CO7400 /ADR TO TST IN EACH FLD
2777 1400 /7000+7400+1400=0
2778 TRYFLD, 1 /CURRENT FLD TO TST
2782 DPTEST, STARTE /EXECUTED BY FPP DURING INITIALIZATION
2783 FEXIT /CHECK WHETHER DOUBLE PRECISION ENABLED
2784 \f/TABLE OF MODIFICATIONS TO MAKE TO FRTS FOR BACKGROUND OPERATION
2785 /UNDER RTS-8. FORMAT OF TABLE IS: POINTER TO FIRST WORD OF BLOCK - 1
2786 / (0 TERMINATES) FOLLOWED BY LIST OF REPLACEMENT WORDS (0 TERMINATES).
2788 BKRLST, YLPT-1 /LINE PRINTER OUTPUT ROUTINE
2791 CLA /DON'T DO RING-BUFFERING - JUST "OUTPUT" CHAR.
2792 JMS CTCBCK /CHECK FOR ^C OR ^B
2794 FJCTCT, JMS CTCBCK /COME HERE FROM INTERPRETED FPP JUMPS
2795 JMP I FPNXT /CHECK FOR ^C,^B AND RETURN TO INTERPRETER
2799 YPTP-1 /PAPER-TAPE PUNCH ROUTINE
2800 CLA /ALL PAPER-TAPE I/O ILLEGAL
2802 YPTR-1 /PAPER TAPE READER ROUTINE
2803 CLA /ALL PAPER-TAPE I/O ILLEGAL
2806 YTTY-1 /TELETYPE INPUT/OUTPUT ROUTINE
2809 JMP KBDRTS /AC=0 MEANS INPUT
2811 JMP .-1 /HANG UNTIL OUTPUT BUFFER NOT FULL
2814 JMS CTCBCK /CHECK FOR ^C OR ^B TYPED
2817 JMP .-1 /HANG UNTIL CHAR RECEIVED
2818 JMS CTCBCK /CHECK FOR ^C OR ^B
2820 AND KB177 /STRIP PARITY
2822 IAC /NOW FORCE PARITY BIT ON (177+1=200)
2825 CTCBCK, . /*K* CAN'T BE 0!
2826 KRS /PEEK AT NEXT CHAR IN BUFFER
2830 SNA CLA /IS IT ^C OR ^B?
2831 KSF /AND IS IT REALLY PENDING?
2832 JMP I CTCBCK /NO - JUST RETURN WITH AC=0
2833 JMP BEEORC /TERMINATE JOB - LINK HAS ^C/^B FLAG
2838 \f/CONTINUATION OF TABLE OF RTS-8 OVERLAYS TO FRTS
2840 YHIOF-1 /"GET OS/8 HANDLER" ROUTINE
2841 NOP /ELIMINATE "IOF" INSTRUCTION
2844 YRCOVR-1 /"RECOVER FROM OS/8 HANDLER" ROUTINE
2846 JMP I RECOVR /SHORT-CIRCUIT PORTION OF ROUTINE WHICH DOES
2850 YFJMP-1 /FPP INTERPRETER - SUCCESSFUL JUMP SECTION
2851 FJCTCT /TEST FOR ^C OR ^B TYPED BEFORE
2852 0 /RETURNING TO THE INTERPRETER
2854 0 /** LIST TERMINATOR **
2855 \f/ERROR MESSAGES FOR RUN-TIME LOADER - IN HANDLER BUFFER
2856 /*K* CANNOT LOAD BELOW HPLACE+200 AS HPLACE-HPLACE+177 ARE DESTROYED BY HEADER!
2858 IFNZRO .-HPLACE-200&4000 <__ERROR__>
2860 NOLI, TEXT /NOT A LOADER IMAGE/
2861 NONMSG, TEXT /NO NUMERIC SWITCH/
2862 FILMSG, TEXT /FILE ERROR/
2863 SYSMSG, TEXT /SYSTEM DEVICE ERROR/
2864 TOOMCH, TEXT /MORE CORE REQUIRED/
2865 TOMNYH, TEXT /TOO MANY HANDLERS/
2866 LIOEMS, TEXT /CAN'T READ IT!/
2867 NODPMS, TEXT /CAUTION - NO DP/
2868 XVERMS, TEXT /FRTS V/
2870 XVERSN&70^7+XVERSN+4060 /VERSION NUMBER IN SIXBIT
2871 XPATCH&77^100+40 /PATCH LEVEL
2874 \f/FPP INTERPRETER STARTUP ROUTINE
2876 FPPINT= . /FOR FPP OVERLAY
2877 RETURN, JMP I FPNXT /RETURN DOES SOMETHING DIFFERENT IF FPP PRESENT
2880 FPGCDF, CDF 0 /NECESSARY?
2883 DCA SAVPC /ALLOW ONE LEVEL OF RECURSIVENESS
2890 TAD FPGCDF /FPGO STARTS UP THE FPP FROM FIELD 0 ONLY
2897 DCA I (PCCDF /RESTORE OLD PC
2898 JMP I FPGO /RETURN TO PDP-8 CODE
2902 FPXTA, TAD [27 /XR TO AC - NORMALIZE IF FLOATING MODE
2908 SPA CLA /SIGN-EXTEND 12-BIT WORD
2909 STA /INTO FAC FRACTION
2911 NRMFAC, DCA AC1 /CLEAR OVERFLOW WORD
2913 SPA SNA CLA /UNLESS WE ARE IN D.P.I. MODE,
2914 JMS I NORMX /NORMALIZE THE FAC
2916 \f/MISCELLANEOUS JUMP CLASS INSTRUCTIONS
2921 DCA JSCDF /SET UP LOC TO SAVE PC IN
2924 DCA ADR /BUMP ADDRESS BY 2
2928 DCA DATAF /INCLUDING DATA FIELD
2929 JSAR, TAD I (PCCDF /JSA/JSR COMMON CODE
2932 ISZ PC /BUMP PC BEFORE STORING
2934 IAC /INCLUDING FIELD BITS
2935 TAD (JA-2620 /FORM "JA" INSTRUCTION
2940 JMS I (DFBUMP /BUMP TARGET ADDRESS
2943 JMP I (DOJMP /NOW JUMP TO DESTINATION
2950 TAD I (BASCDF /SET JSCDF&PUTM TO BASE PAGE LOC +1
2965 DCA I ADR /SET XR TO NEXT INST WD
2967 \f/MORE INDEX REGISTER & AC-TO-MEMORY INSTRUCTIONS
2971 TAD I ADR /ADD NEXT INST WD TO XR
2974 ATX, TAD DFLG /ATX WORKS DIFFERENTLY IN D.P.I. MODE
2977 JMS I NORMX /FAC MAY NOT BE NORMALIZED
2982 OPMEM, DCA AD1 /GENERAL AC-TO-MEMORY INTERPRETER
2988 TAD KLUDGM /FORM FSTA X INSTRUCTION
2991 AND INST /TURN OP 5 TO OP 1,
2993 TAD [3000 / OP 7 TO OP 4.
2995 TAD PUTM /STICK IN FIELD BITS
3006 AD2, 0 /STORE RESULT
3011 NORMX, FFNOR /*K* CHANGED TO EFFNOR IF EAE
3013 \f/MAIN INTERPRETER LOOP
3015 NEGFAC, JMS I [FFNEG
3018 JMS I [FETPC /GET INST
3023 SMA /SKIP IF BASEPAGE ADDRESSING
3027 DCA OPJMP /SAVE OPCODE CALL ADDRESS
3028 TAD INST /DATA FIELD IS STILL SET UP
3029 SZL /SO IS LINK (WITH INSTRUCTION BIT 3)
3030 JMP BPAGEI /INDIRECT ADDRESSING
3032 TAD INST /MULTIPLY BASE OFFSET BY 3
3033 TAD [200 /ELIMINATE ANY
3034 AND (777 /HIGH ORDER BITS
3035 IMFUDJ, CLL /CLL IAC IF D.P. INTEGER MODE
3036 TAD BASADR /ADD IN BASE PAGE ORIGIN
3037 BASCDF, HLT /CDF TO BASE PAGE FIELD
3039 JMS DFBUMP /BUMP DF IF ADDITION OVERFLOWED
3041 OPJMP, HLT /JMP I EXECUTIONROUTINE
3047 TAD ADR /FORM 3*OFFSET+1
3052 TAD BASCDF /FORM PROPER CDF
3054 ADDRLO, HLT /EXECUTE IT
3055 TAD I ADR /GET FIELD BITS OF REAL ADDRESS
3056 DCA ADDRHI /FROM 2D WORD OF BASE PAGE LOC
3059 JMS DFBUMP /WATCH FOR FIELD OVERFLOW
3060 TAD I ADR /GET LOW-ORDER ADDRESS FROM 3D WORD
3061 JMP INDEX /NOW GO DO INDEXING (IF ANY)
3062 \f/COME HERE IF BIT 4 OF INSTRUCTION IS OFF
3065 SNL /TEST BIT 3 OF INSTRUCTION
3066 JMP I (SPECAL /SPECIAL INSTRUCTION
3070 DCA ADDRHI /HIGH-ORDER ADDRESS BITS IN INST WD
3071 JMS I [FETPC /NEXT INST WORD CONTAINS LOW-ORDER ADDRESS
3075 SNA /IS XR NUMBER 0?
3076 JMP NOINDX /YES - NO INDEXING
3077 JMS DCDIDX /GET XR VALUE (MAYBE INCREMENTED)
3079 TAD DFLG /GET -3 IF F, -2 IF D, -6 IF E MODE
3086 ISZ DCDIDX /ADD THE XR IN THE PROPER NUMBER OF TIMES
3091 DCA ADDRHI /TURN HIGH-ORDER ADDRESS INTO A CDF
3092 ADDRHI, HLT /AND EXECUTE IT
3094 JMP OPJCLL /GO EXECUTE THE INSTRUCTION
3096 DFBUMP, 0 /BUMP DATA FIELD
3102 TAD DFTMP /RESTORE AC
3108 TAD XRBASE /ADD IN BASE ADDRESS OF XR ARRAY
3109 XRCDF, HLT /CDF TO XR ARRAY FIELD
3111 JMS DFBUMP /OR MAYBE NEXT FIELD
3112 DCA T /SAVE POINTER TO XR
3115 SZA CLA /INCREMENT BIT ON?
3116 ISZ I T /YES - BUMP XR
3117 DCD100, 100 /** PROTECTION
3120 BASJMP, JMP I JMPTB1 /JMP I JMPTB2 FOR D.P. MODE
3122 JMPTB1, FFGET / F MODE (FLOATING POINT)
3131 DDGET / D MODE ( DOUBLE PRECISION INTEGER)
3140 EEGET / E MODE ( 6 WD FLOATING POINT)
3152 JMP XRINST /OPCODE 0 HAS MANY MANSIONS
3154 DCA SPCJMP /GET OPCODE JUMP ADDRESS
3157 TAD INST /ALL OF THESE ARE TWO-WORD INSTRUCTIONS
3158 JMS I MCDF /SO FORM THE ADDRESS NOW
3167 SNA CLA /IF SUB-OPCODE IS ZERO,
3168 JMP OPERAT /DECODE SUB-SUB-OPCODE
3173 DCA ADR /COMPUTE INDEX REGISTER ADDRESS
3181 AND [77 /GET OPCODE - HIGH ORDER 2 BITS ARE 0
3182 OXCOMN, TAD (JMP I SP2
3183 DCA .+1 /EXECUTE APPROPRIATE JUMP
3190 SETX, TAD DATAF /SET XR0 LOC
3197 JUMPS, AND (100 /INSTRUCTION IN AC
3198 CLL RTR /20 IN AC IF NOT COND. JUMP
3199 SZA /IF NOT COND. JUMP, DECODE FURTHER
3206 DCA T /INDEX INTO CONDITIONAL SKIP TABLE
3213 SZA CLA /IF HIGH ORDER ZERO, AC MIGHT BE UNNORMALIZED.
3214 IAC /USE LOW ORDER ON 0/NOT 0 BASIS
3215 CNDSKP, HLT /TEST AC
3216 JMP I FPNXT /FAILED - DON'T JUMP
3225 DCA I (PCCDF /ADDRESS-1 TO PC
3227 YFJMP, ICYCLE /** CHANGED IF RUNNING UNDER RTS-8
3229 JXN, AND [70 /GET XR FIELD
3230 JMS I (DCDIDX /GET XR VALUE WITH INCREMENTING
3234 JMP DOJMP /JUMP ON INDEX NON-ZERO, RIGHT?
3236 CNDSKT, SZA CLA /JEQ
3253 SPECOP, JMP I SPECOP /SPECIAL OPCODE TABLE
3284 \f/MISCELLANEOUS OPCODE ROUTINES
3289 DCA .+1 /FORM CDF CIF N
3292 SMA CLA /TRAP4 JMS'S TO ITS TARGET ADDRESS,
3293 JMP I ADR /TRAP3 JMP'S TO IT
3297 ALN, TAD ACX /ALIGN SIMULATOR
3298 DCA OPX /SAVE EXPONENT IN CASE WE'RE IN D.I. MODE
3301 DCA ACX /ZERO EXP IF D.I. MODE
3302 JMS DATCDF /SET TO XR FIELD
3305 TAD DFLG /IF WE'RE IN FLOATING POINT MODE,
3306 SNA CLA /AND DOING AN "ALN 0",
3307 TAD [27 /ALIGN UNTIL EXPONENT = 23
3309 TAD I ADR /OTHERWISE ALIGN UNTIL EXPONENT = XR VALUE
3313 CMA /FORM DIFFERENCE - 1
3314 SPA /IF EXPONENT IS LARGER THEN DESIRED EXPONENT,
3315 JMP ALNSHL /SHIFT LEFT
3316 JMS I [ACSR /OTHERWISE SHIFT RIGHT
3318 SPA SNA CLA /IF DOUBLE INTEGER MODE,
3320 TAD OPX /ALIGNMENT LEAVES THE EXPONENT UNCHANGED
3323 ALNSHL, DCA T /STORE SHIFT COUNT
3324 SKP /SHIFT LEFT ONE LESS THAN COUNT
3328 JMP ALNXIT /GO TO COMMON CODE
3329 \f/ARG FETCH SUBROUTINES AND MODE CHANGE OPERATORS
3336 JMP ARGET2 /FAKE OUT FLOATING POINT ROUTINE
3338 ARGET, 0 /SUBROUTINE TO FETCH ARG FOR ADD, SUBT, ETC.
3339 DCA ADR /STORE ADDRESS OF OPERAND
3340 TAD I ADR /PICK UP EXPONENT
3341 ISZ ADR /MOVE POINTER TO HI MANTISSA WD
3345 TAD I ADR /PICK IT UP
3347 ISZ ADR /MOVE PTR. TO LO MANTISSA WD.
3349 JMS I (DFBUMP /WATCH THOSE FIELD TRANSITIONS!
3350 TAD I ADR /PICK IT UP
3355 STRTE, TAD DFLG /START EXTENDED PRECISION MODE
3357 JMP .+4 /CLEAR EXTENDED FAC
3358 DCA EAC1 /IF NOT ALREADY IN E MODE
3365 STRTD, CLA IAC /START DOUBLE PRECISION INTEGER MODE
3366 STRTF, DCA DFLG /START FLOATING POINT MODE
3369 DCA I (IMFUDJ /SET D.P.I FUDGE TO "CLL" OR "CLL IAC"
3372 CMA /CHANGE -3 FOR E MODE TO +2
3375 TAD (JMPTB1&177+5600
3378 \f/DOUBLE PRECISION INTEGER OPERATORS
3384 DCA AC1 /CLEAR OVERFLOW JUSTINCASE
3388 FFGET, DCA ADR /GET A FLOATING POINT NUMBER
3390 DCA ACX /SAVE EXPONENT
3392 JMP .+3 /NO FIELD OVERFLOW
3393 JMS I (DFBUMP /BUMP DATA FIELD
3394 DDGET, DCA ADR /SUAVE - ENTRY POINT FOR D.P. INTEGER GET
3404 FFPUT, DCA ADR /STORE A FLOATING POINT NUMBER
3405 TAD ACX /GET FAC AND STORE IT
3406 DCA I ADR /AT SPECIFIED ADDRESS
3410 DDPUT, DCA ADR /ENTRY FOR D.P. INTEGER PUT
3420 \fFPPKG= . /FOR EAE OVERLAY
3422 /23-BIT FLOATING PT INTERPRETER
3423 /W.J. CLOGHER, MODIFIED BY R.LARY FOR FORTRAN
3428 AL1BMP, 0 /*K* UTILITY SUBROUTINE - USED BY INTERPRETER
3435 /FLOATING MULTIPLY-DOES 2 24X12 BIT MULTIPLIES
3436 DDMPY, JMS I (DARGET
3438 FFMPY, JMS I (ARGET /GET OPERAND
3439 JMS MDSET /SET UP FOR MPY-OPX IN AC ON RETN.
3440 TAD ACX /DO EXPONENT ADDITION
3441 DCA ACX /STORE FINAL EXPONENT
3442 DCA MDSET /ZERO TEM STORAGE FOR MPY ROUTINE
3446 DCA ACX /YES-ZERO EXPONENT
3447 JMS MP24 /NO-MULTIPLY FAC BY LOW ORDER OPR.
3448 TAD OPH /NOW MULTIPLY FAC BY HI ORDER MULTIPLIER
3451 TAD AC2 /STORE RESULT BACK IN FAC
3453 TAD MDSET /HIGH ORDER
3455 TAD ACH /DO WE NEED TO NORMALIZE?
3458 JMS AL1BMP /YES-DO IT FAST
3460 SPA CLA /CHECK OVERFLOW WORD
3461 ISZ ACL /HIGH BIT ON - ROUND RESULT
3463 ISZ ACH /LOW ORDER OVERFLOWED - INCREMENT HIGH ORDER
3465 SPA /CHECK FOR OVERFLOW TO 4000 0000
3466 JMP I (SHR1 /WE HANDLE A SIMILIAR CASE IN FLOATING DIVIDE
3468 \fMDONE, DCA AC1 /ZERO OVERFLOW WD(DO I NEED THIS???)
3469 ISZ MSIGN /SHOULD RESULT BE NEGATIVE?
3471 JMS I [FFNEG /YES-NEGATE IT
3473 SNA CLA /A ZERO AC MEANS A ZERO EXPONENT
3476 SMA SZA CLA /D.P. INTEGER MODE?
3477 TAD ACX /WITH ACX LESS THAN 0?
3479 JMP I FPNXT /NO - RETURN
3481 JMS I [ACSR /UN-NORMALIZE RESULT
3483 \f/MDSET-SETS UP SIGNS FOR MULTIPLY AND DIVIDE
3484 /ALSO SHIFTS OPERAND ONE BIT TO THE LEFT.
3485 /EXIT WITH EXPONENT OF OPERAND IN AC FOR EXPONENT
3486 /CALCULATION-CALLED WITH ADDRESS OF OPERAND IN AC AND
3487 /DATA FIELD SET PROPERLY FOR OPERAND.
3490 CLA CLL CMA RAL /SET SIGN CHECK TO -2
3492 TAD OPH /IS OPERAND NEGATIVE?
3495 JMS I (OPNEG /YES-NEGATE IT
3496 ISZ MSIGN /BUMP SIGN CHECK
3497 TAD OPL /AND SHIFT OPERAND LEFT ONE BIT
3503 DCA AC1 /CLR. OVERFLOW WORF OF FAC
3504 TAD ACH /IS FAC NEGATIVE
3507 JMS I [FFNEG /YES-NEGATE IT
3508 ISZ MSIGN /BUMP SIGN CHECK
3510 LEV, TAD OPX /EXIT WITH OPERAND EXPONENT IN AC
3513 \f/24 BIT BY 12 BIT MULTIPLY. MULTIPLIER IS IN OPL
3514 /MULTIPLICAND IS IN ACH AND ACL
3515 /RESULT LEFT IN MDSET,AC2, AND AC1
3518 TAD (-14 /SET UP 12 BIT COUNTER
3520 TAD OPL /IS MULTIPLIER=0?
3523 DCA AC1 /YES-INSURE RESULT=0
3525 MPLP, TAD OPL /SHIFT A BIT OUT OF LOW ORDER
3526 MPLP1, RAR /OF MULTIPLIER AND INTO LINK
3529 JMP MPLP2 /NO - 0 - JUST SHIFT PARTIAL PRODUCT
3530 TAD AC2 /YES-ADD MULTIPLICAND TO PARTIAL PRODUCT
3533 CML RAL /*K* NOTE THE "SNL" 5 WORDS BACK!
3536 RAR /NOW SHIFT PARTIAL PROD. RIGHT 1 BIT
3542 RAR /OVERFLOW TO AC1
3544 ISZ OPX /DONE ALL 12 MULTIPLIER BITS?
3546 JMP I MP24 /YES-RETURN
3548 \f/DIVIDE-BY-ZERO ROUTINE - MUST BE AT BEGINNING OF PAGE
3550 DBAD, ISZ FATAL /DIVIDE BY 0 NON-FATAL
3551 JMS I ERR /GIVE ERROR MSG
3553 DCA ACX /RETURN A VERY LARGE POSITIVE NUMBER
3557 /FLOATING DIVIDE - USES DIVIDE-AND-CORRECT METHOD
3559 DDDIV, JMS I (DARGET
3561 FFDIV, JMS I (ARGET /GET OPERAND
3562 JMS I (MDSET /GO SET UP FOR DIVIDE-OPX IN AC ON RETN.
3563 CMA IAC /NEGATE EXP. OF OPERAND
3564 TAD ACX /ADD EXP OF FAC
3565 DCA ACX /STORE AS FINAL EXPONENT
3566 TAD OPH /NEGATE HI ORDER OP. FOR USE
3567 CLL CMA IAC /AS DIVISOR
3569 JMS DV24 /CALL DIV.--(ACH+ACL)/OPH
3570 TAD ACL /SAVE QUOT. FOR LATER
3574 JMP DVL2 /AVOID MULTIPLYING BY 0
3575 TAD (-15 /SET COUNTER FOR 12 BIT MULTIPLY
3576 DCA DV24 /TO MULTIPLY QUOT. OF DIV. BY
3577 JMP DVLP1 /LOW ORDER OF OPERAND (OPL)
3579 /DIVIDE ROUTINE - (ACH,ACL)/OPH = ACL REMAINDER REM (AC2=0)
3582 TAD ACH /CHECK THAT DIVISOR IS .GT. DIVIDEND
3583 TAD OPH /DIVISOR IN OPH (NEGATIVE)
3585 JMP DBAD /NO-DIVIDE OVERFLOW
3586 TAD (-15 /YES-SET UP 12 BIT LOOP
3588 JMP DV1 /GO BEGIN DIVIDE
3589 DV2, TAD ACH /CONTINUE SHIFT OF FAC LEFT
3591 DCA ACH /RESTORE HI ORDER
3592 TAD ACH /NOW SUBTRACT DIVISOR FROM HI ORDER
3595 DCA ACH /YES-RESTORE HI DIVIDEND
3596 CLA /NO-DON'T RESTORE--OPH.GT.ACH
3597 DV1, TAD ACL /SHIFT FAC LEFT 1 BIT-ALSO SHIFT
3598 RAL /1 BIT OF QUOT. INTO LOW ORD OF ACL
3600 ISZ AC2 /DONE 12 BITS OF QUOT?
3602 JMP I DV24 /YES-RETN W/AC2=0
3603 \f/DIVIDE ROUTINE CONTINUED
3605 MP12L, DCA OPL /STORE BACK MULTIPLIET
3606 TAD AC2 /GET PRODUCT SO FAR
3607 SNL /WAS MULTIPLIER BIT A 1?
3608 JMP .+3 /NO-JUST SHIFT THE PARTIAL PRODUCT
3609 CLL /YES-CLEAR LINK AND ADD MULTIPLICAND
3610 TAD ACL /TO PARTIAL PRODUCT
3611 RAR /SHIFT PARTIAL PRODUCT-THIS IS HI ORDER
3612 DCA AC2 /RESULT-STORE BACK
3613 DVLP1, TAD OPL /SHIFT A BIT OUT OF MULTIPLIER
3614 RAR /AND A BIT OR RESLT. INTO IT (LO ORD. PROD.)
3615 ISZ DV24 /DONE ALL BITS?
3616 JMP MP12L /NO-LOOP BACK
3617 CLL CIA /YES-LOW ORDER PROD. OF QUOT. X OPL IN AC
3618 DCA ACL /NEGATE AND STORE
3619 CML RAL /PROPAGATE CARRY
3620 TAD AC2 /NEGATE HI ORDER PRODUCT
3622 TAD ACH /COMPARE WITH REMAINDER OF FIRST DIV.
3624 JMP DVOPS /GREATER THAN REM.-ADJUST QUOT OF 1ST DIV.
3625 DCA ACH /OK - DO (REM - (Q*OPL)) / OPH
3626 DVL3, JMS DV24 /DIVIDE BY OPH (HI ORDER OPERAND)
3627 DVL1, TAD AC1 /GET QUOT. OF FIRST DIV.
3628 SMA /IF HI ORDER BIT SET-MUST SHIFT 1 RIGHT
3629 JMP FD /NO-ITS NORMALIZED-DONE
3631 ISZ ACL /ROUND AND SHIFT RIGHT ONE
3633 IAC /DOUBLE PRECISION INCREMENT
3635 DCA ACH /STORE IN FAC
3636 TAD ACL /SHIFT LOW ORDER RIGHT
3639 ISZ ACX /BUMP EXPONENT
3642 JMP DVL1+1 /IF FRACT WAS 77777777 WE MUST SHIFT AGAIN
3643 FD, DCA ACH /STORE HIGH ORDER RESULT
3644 JMP I (MDONE /GO LEAVE DIVIDE
3646 DVL2, DCA ACL /COME HERE IF LOW-ORDER QUO=0
3647 JMP DVL3 /SAVE SOME TIME
3648 \f/ROUTINE TO ADJUST QUOTINET OF FIRST DIVIDE (MAYBE) WHEN THE
3649 /REMAINDER OF THE FIRST DIVIDE IS LESS THAN QUOT*OPL
3651 DVOPS, CMA IAC /NEGATE AND STORE REVISED REMAINDER
3655 TAD ACH /WATCH FOR OVERFLOW
3657 JMP DVOP1 /OVERFLOW-DON'T ADJUST QUOT. OF 1ST DIV.
3658 DCA ACH /NO OVERFLOW-STORE NEW REM.
3659 CMA /SUBTRACT 1 FROM QUOT OF
3660 TAD AC1 /FIRST DIVIDE
3663 TAD ACH /GET HI ORD OF REMAINDER
3665 DVOP2, DCA ACL /YES-MAKE WHOLE THING ZERO
3667 JMS DV24 /DIVIDE EXTENDED REM. BY HI DIVISOR
3668 TAD ACL /NEGATE THE RESULT
3671 SNL /IF QUOT. IS NON-ZERO, SUBTRACT
3672 CMA /ONE FROM HIGH ORDER QUOT.
3678 \f/"OPNEG" MUST BE AT 0 ON PAGE
3680 OPNEG, 0 /ROUTINE TO NEGATE OPERAND
3681 TAD OPL /GET LOW ORDER
3682 CLL CIA /NEGATE AND STORE BACK
3684 CML RAL /PROPAGATE CARRY
3685 TAD OPH /GET HI ORDER
3686 CLL CIA /NEGATE AND STORE BACK
3690 /FLOATING SUBTRACT AND ADD
3692 FFSUB, JMS I (ARGET /PICK UO THE OP.
3693 JMS OPNEG /NEGATE OPERAND
3695 FFADD, JMS I (ARGET /PICK UP OPERAND
3696 TAD OPH /IS OPERAND = 0
3698 JMP I FPNXT /YES-DONE
3699 TAD ACH /NO-IS FAC=0?
3701 JMP CLROFL /CLEAR OUT THE OVERFLOW BITS
3702 TAD ACX /NO-DO EXPONENT CALCULATION
3705 SMA SZA /WHICH EXP. GREATER?
3706 JMP FACR /OPERANDS-SHIFT FAC
3707 CIA /FAC'S-SHIFT OPERAND=DIFFRNCE+1
3709 SMA /TEST FOR INSIGNIFICANCE
3710 JMP OPINSG /YES - ANSWER IS FAC
3713 JMS I [ACSR /SHIFT FAC ONE PLACE RIGHT
3714 DOADD, TAD OPX /SET EXPONENT OF RESULT
3716 JMS I [OADD /DO THE ADDITION
3717 JMS FFNOR /NORMALIZE RESULT
3720 SMA /TEST FOR INSIGNIFICANCE
3721 JMP ACINSG /YES - ANSWER IS OPR
3723 JMS I [ACSR /SHIFT FAC = DIFF.+1
3724 JMS OPSR /SHIFT OPR. 1 PLACE
3725 JMP DOADD /DO ADDITION
3729 \f/OPERAND SHIFT RIGHT-ENTER WITH POSITIVE COUNT-1 IN AC
3732 CMA /- (COUNT+1) TO SHIFT COUNTER
3734 LOP2, TAD OPH /GET SIGN BIT
3737 CML /WITH HI MANTISSA IN AC
3738 RAR /SHIFT IT RIGHT, PROPAGATING SIGN
3742 DCA OPL /STORE LO ORDER BACK
3743 ISZ OPX /INCREMENT EXPONENT
3745 ISZ AC0 /DONE ALL SHIFTS?
3747 RAR /SAVE 1 BIT OF OVERFLOW
3749 JMP I OPSR /YES-RETN.
3751 FFNOR, 0 /ROUTINE TO NORMALIZE THE FAC
3752 TAD ACH /GET THE HI ORDER MANTISSA
3754 TAD ACL /YES-HOW ABOUT LOW?
3756 TAD AC1 /LOW=0, IS OVRFLO BIT ON?
3758 JMP ZEXP /#=0-ZERO EXPONENT
3759 NORMLP, CLA CLL CML RTR /NOT 0-MAKE A 2000 IN AC
3760 TAD ACH /ADD HI ORDER MANTISSA
3761 SZA /HI ORDER = 6000
3762 JMP .+3 /NO-CHECK LEFT MOST DIGIT
3763 TAD ACL /YES-6000 OK IF LOW=0
3765 SPA CLA /2,3,4,5,ARE LEGAL LEFT MOST DIGS.
3766 JMP FFNORR /FOR NORMALIZED #-(+2000=4,5,6,7)
3767 JMS I [AL1BMP /SHIFT AC LEFT AND BUMP ACX DOWN
3768 JMP NORMLP /GO BACK AND SEE IF NORMALIZED
3770 FFNORR, DCA AC1 /DONE W/NORMALIZE - CLEAR AC1
3773 ACINSG, CLA /COME HERE IF AC IS INSIGNIFICANT ON ADDITION
3776 JMP DOADD-1 /FAKE AN ADD WITH OPR=0
3780 CLROFL, DCA AC1 /CLEAR THE FLOATING AC OVERFLOW WORD
3781 DCA AC2 /CLEAR THE OPERAND OVERFLOW WORD
3782 JMP DOADD /FAC=0; DO THE ADD
3784 \f/PAGE 7400 UNUSED RIGHT NOW