1 /OS8 BASIC RUNTIME SYSTEM, V5A
13 /COPYRIGHT (C) 1972, 1973, 1974, 1975
14 /DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
18 /THIS SOFTWARE IS FURNISHED UNDER A LICENSE FOR USE ONLY ON A
19 /SINGLE COMPUTER SYSTEM AND MAY BE COPIED ONLY WITH THE INCLU-
20 /SION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE, OR ANT OTHER
21 /COPIES THEREOF, MAY NOT BR PROVIDED OR OTHERWISE MADE AVAILABLE
22 /TO ANY OTHER PERSON EXCEPT FOR USE ON SUCH SYSTEM AND TO ONE WHO
23 /AGREES TO THESE LICENSE TERMS. TITLE TO AND OWNERSHIP OF THE
24 /SOFTWARE SHALL AT ALL TIMES REMAIN IN DEC.
27 /THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT
28 /NOTICE AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL
29 /EQUIPMRNT COROPATION.
31 /DEC ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
32 /SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DEC.
44 /JR 21-APR-77 ADDED EXTENDED DATE CODE, CLEANED UP LISTING
45 /JR 26-APR-77 TIGHTENED UP STRING ROUTINES
46 /JR 28-APR-77 ADD SOURCE FIX FOR SEVERAL KNOWN BUGS
47 /JR 4-MAY-77 REWROTE FLOATING POINT OUTPUT ROUTINE TO INCREASE ACCURACY
50 VERSON= 5 /VERSION OF BRTS
51 /VERSION LOCATED AT TAG "VERLOC" AND VERLOC+1
53 /VERLOC+1 = 300+SUBVER (01 = A)
54 SUBVER= 01 /SUBVERSION OF BRTS
55 SUBVAF= 01 /SUBVERSION OF BASIC.AF OVERLAY
56 SUBVSF= 01 /SUBVERSION OF BASIC.SF OVERLAY
57 SUBVFF= 01 /SUBVERSION OF BASIC.FF OVERLAY
58 /FIRST WORD OF EACH OVERLAY CONTAINS
59 /60+VERSON IN LEFT HALF AND SUBVERSION OF OVERLAY
61 MDATE= 7666 /CONTAINS OS/8 DATE IN FIELD 1
62 BIPCCL= 7777 /CONTAINS YEAR EXTENSION BITS
63 SCOPWD= 7726 /WORD CONTAINING SCOPE FLAG IN 200 BIT
64 EDBLK= 7604 /CONTAINS BLOCK NUMBER OF EDITOR
65 WIDTH= 120 /WIDTH OF PRINTER
66 COLWID= 16 /WIDTH OF ONE PRINT COLUMN
67 SACLIM= 120 /DEFINE WIDTH OF STRING ACCUMULATOR
68 OVERLAY=3400 /ADDRESS OF START OF 5 PAGE OVERLAY BUFFER
72 /ASSEMBLY INSTRUCTIONS
76 / *BRTS$ (THEN SAVE AS SHOWN BELOW)
79 /WHEN ASSEMBLED AND LOADED VIA THE ABS. LOADER,THE
80 /CORE LAYOUT IS AS FOLLOWS:
83 /OVERLAY BASIC.AF IS AT 3400-4577
84 /OVERLAY BASIC.SF IA AT 12000-13177
85 /OVERLAY BASIC.FF IS AT 13400-14577
87 /TO CREATE SAVE IMAGE FILES PRIOR TO RUNNING BASIC,
88 /ASSEMBLE THIS SOURCE IN A 12K OR MORE MACHINE,THEN
89 /PERFORM THE FOLLOWING SEQUENCE OF OS/8 COMMANDS
93 /.SAVE SYS:BRTS 0-6777
95 /.SAVE SYS:BASIC.AF 3400-4577
97 /.SAVE SYS:BASIC.SF 12000-13177
99 /.SAVE SYS:BASIC.FF 13400-14577
101 /THE BASIC RUN-TIME SYSTEM IS CONDITIONALIZED TO TAKE ADVANTAGE
102 /OF THE PDP-8/E KE8/E EAE OPTION.
103 /NORMALLY,THE SYSTEM IS ASSEMBLED SUCH THAT IT WILL RUN ON ANY
104 /PDP-8 OR PDP-12. TO TAKE ADVANTAGE OF THE ADDITIONAL HARDWARE,SET
105 /THE SWITCH EAE=1 IF THE SYSTEM INCLUDES A KE8/E EAE.
106 /YOU MAY DO THIS BY CONCATENATING TTY: ONTO BRTS.PA AS FOLLOWS
107 /.PAL EABRTS<TTY:,SYS:BRTS.PA/W
111 /. BINARY IS CREATED...
112 /NOW EABRTS IS LOADED INSTEAD OF BRTS
113 /TO GET A LISTING, USE THE /J SWITCH TO INHIBIT THE FPP CODE YOU
114 /ARE NOT USING (EAE ON A NON EAE ASSEMBLY FOR EXAMPLE)
116 /EAE=0 /USE STANDARD FLOATING POINT PACKAGE
117 /EAE=1 /USE EAE FLOATING POINT PACKAGE
120 /.EAE ADD FOR NUMS <.00001 TO 0
121 /.FILE INPUT FROM TTY
122 /.OUTPUT OF NUMS > 80,000
123 /.STRING FETCH WHEN COUNT IS IN ONE FLD &
124 / TEXT IS IN THE NEXT
125 \f AC4000= CLA STL RAR
138 USECON, 0 /USE CONSTANT GENERATED BY "USE" STATEMENT
139 FSTOP1, FSTOPI /POINTER TO RTS EXIT ROUTINE USED
140 /BY ^C HOOKS IN SYSTEM HANDLER.
141 /IF THIS IS MOVED, BLOAD MUST BE ALTERED
144 SACXR, 15 /INDEX REGISTER FOR STRING ROUTINES
148 XR4, 4 /INDEX REGISTERS
150 DATAXR, 0 /POINTER FOR IN-CORE DATA LIST
151 SPINNR, 2713 /AT RUNTIME,THIS LOCATION IS SPUN FOR RND SEED
155 /COMPILER-INTERPRETER CONTROL BLOCK. LOCATIONS MARKED BY
156 /A /* ARE EXPECTED TO CONTAIN VALUES SUPPLIED BY THE COMPILER PRIOR
159 CDFIO, 6211 /* CDF FOR I/O TABLE AND SYMBOL TABLES
160 SCSTRT, 0 /* POINTER TO START OF SCALAR SYMBOL TABLE
161 ARSTRT, 0 /* POINTER TO START OF ARRAY SYMBOL TABLE-1
162 STSTRT, 0 /* POINTER TO START OF STRING SYMBOL TABLE-1
163 SASTRT, 0 /* POINTER TO START OF STRING ARRAY TABLE-1
164 CDFPS, 0 /* CDF FOR START OF PSEUDO-CODE
165 PSSTRT, 0 /* POINTER TO START OF PSEUDO CODE-1
166 DLSTOP, 0 /* POINTER TO TOP OF DATA LIST
167 DLSTRT, 0 /* POINTER TO BOTTOM OF INCORE DATA LIST-1
168 PSFLAG, 0 /* OS/8 SWAPPING FLAGS WORD
169 /BIT 0 SET IF OS/8 SAVED IN N7400 INSTEAD OF N7600 (TD8E)
170 /BIT 1 SET IF ROM TD8E HANDLER NOT NEEDING CDF CHANGES
171 /BIT 11 SET IF 17600 IS IN 17600. BIT 11 TOGGLED BY
176 SACLEN, 0 /LENGTH OF STRING IN SAC
177 S1, 0 /SUBSCRIPT 1 (MUST BE FOLLOWED BY S2!)
178 S2, 0 /SUBSCRIPT 2 (MUST BE PRECEEDED BY S1!)
179 DMAP, 0 /MAP OF DRIVER PAGES
180 BMAP, 0 /MAP OF FILE BUFFERS
183 /FLOATING POINT PACKAGE LOCATIONS. THE FOLLOWING 21 LOCATIONS ARE USED
184 /FOR VARIOUS PURPOSES BY THE FLOATING POINT PACKAGE. THOSE WITH DOUBLE
185 /LABELS ARE USED BY BRTS AS TEMPORARIES WHEN NOT CALLING THE PACKAGE.
186 /THE SECOND TAG IS THE ONE USED BY THE FLOATING POINT PACKAGE,THE FIRST
189 FF, 0 /SPECIAL MODE FLIP-FLOP
198 ACH, 0 /FAC-HIGH ORDER MANTISSA
199 ACL, 0 /FAC-MANTISSA LOW
206 DSWIT, 0 /SWITCH USED BY INPUT ROUTINE
207 CHAR, 215 /TERMINATOR OF LAST INPUT
208 TEMP10, 0 /LOC NEEDED BY FPP
212 /SYSTEM REGISTERS USED OFTEN BY INTERPRETER CODE
214 MODESW, 0 /0 FOR ARTHIMETIC MODE,1 FOR STRING MODE
215 INSAV, 0 /CURRENT PSEUDO-INSTRUCTION BEING EXECUTED
216 LINEHI, 0 /HI ORDER BITS OF LINE # CURRENTLY BEING EXECUTED
217 LINELO, 0 /LOW ORDER BITS OF CURRENT LINE NUMBER
218 STRMAX, 0 /MAXIMUM # OF CHARS ALLOWED IN CURRENT STRING
219 STRCNT, 0 /- # OF CHARACTERS IN CURRENT STRING
220 STRPTR, 0 /POINTER TO SIZE WORD OF CURRENT OPERAND STRING
223 \f/I/O TABLE POINTER AREA-THIS BLOCK HOLDS POINTERS TO THE I/O TABLE
224 /ENTRY FOR THE CURRENT FILE.THE POINTERS ARE CHANGED EVERY TIME AN
225 /SFN IS EXECUTED. A TAD I OFF ONE OF THE POINTERS WILL GET THE INFORMATION
226 /NOTED IN THE COMMENT FOR THE CURRENT I/O DEVICE
227 /THIS BLOCK IS INITIALIZED FOR TTY
229 IOTSIZ= 15 /CURRENT SIZE OF IO TABLE
231 /THE FORMAT OF THE HEADER WORD IS AS FOLLOWS
233 /0-3 OS/8 DEVICE NUMBER
234 /4-5 3 FOR 2 CHARACTER UNPACKING COUNT
235 /6 SET IF BUFFER HAS BEEN MODIFIED AND NEEDS TO BE WRITTEN
236 /7 SET IF NOT FILE STRUCTURED DEVICE
237 /8 SET IF HANDLER IS 2 PAGES LONG
238 /9 SET IF VARIABLE LENGTH (OUTPUT) FILE
240 /11 SET IF ASCII FILE, CLEAR IF NUMERIC IMAGE FILE
243 ENTNO, 0 /ENTRY NUMBER NOW IN AREA
244 IOTHDR, TTYF /HEADER WORD
245 IOTBUF, TTYF+1 /BUFFER ADDRESS
246 IOTBLK, TTYF+2 /CURRENT BLOCK IN BUFFER
247 IOTPTR, TTYF+3 /READ\WRITE POINTER
248 IOTHND, TTYF+4 /HANDLER ENTRY POINT
249 IOTLOC, TTYF+5 /FILE STARTING BLOCK #
250 IOTLEN, TTYF+6 /ACTUAL FILE LENGTH
251 IOTMAX, TTYF+7 / DEVICE / (FILE MAXIMUM LENGTH)
252 IOTPOS, TTYF+10 / NAME / (POSITION OF PRINT HEAD)
261 /FETCH NEXT PSEUDO WORD
263 PWFECH, JMP START1 /START ONCE ONLY CODE IN TTY BUFFER
264 ISZ INTPC /BUMP PSEUDO-CODE PROGRAM COUNTER
265 JMP CDFPSU /NO-SKIP;JUST GET NEXT PSEUDO-CODE WORD
266 TAD CDFPSU /SKIP MEANS WE HAVE TO INCREMENT PS-CODE FIELD
269 CDFPSU, VCHECK /SET DF TO FIELD OF PSEUDO-CODE
270 TAD I INTPC /GET NEXT WORD OF CODE
271 CDF 0 /SET DATA FIELD BACK TO INTERPRETER FIELD
275 SSMODE, IAC /SET INTERPRETER TO STRING MODE
276 AMODE, DCA MODESW /SET INTERPRETER TO ARITH MODE
277 /FALL BACK INTO I-LOOP
281 ILOOP, CLA CLL /FLUSH
282 DCA FF /PUT FPP IN SI MODE
283 JMS PWFECH /GET NEXT PSEUDO-INSTRUCTION
284 DCA INSAV /SAVE FOR LATER
285 JMS I [XPRINT /CALL TO TTY DRIVER
288 AND [7400 /STRIP TO OPCODE BITS
291 RAL /OPCODE NOW IN BITS 8-11
292 TAD O7770 /SUBTRACT 10
294 JMP SCASE /CALL TO INSTRUCTION COMMON TO SMODE AND AMODE
295 DCA TEMP1 /YES-SAVE THE OFFSET
296 TAD MODESW /WHICH MODE?
298 JMP SMODE /STRING MODE
299 TAD TEMP1 /ARITHMETIC MODE-GET OFFSET
300 TAD JMSI /MAKE JMS TO FP PACKAGE ROUTINE
302 JMS ARGPRE /SET UP ARGUMENT FROM SYMBOL TABLE
303 ILOOPF, . /JMS TO THE FLOATING POINT PACKAGE ROUTINE
304 NOP /FPP SOMETIMES RETURNS TO CALL+2
307 SCASE, TAD JMPI /JUST DISPATCH TO ROUTINE CALLED FOR
309 . /JUMP TO APPROPRIATE ROUTINE
311 JMSI, JMS I SEP1 /JMS USED FOR CALLS TO FPP BY AMODE INST
312 JMPI, JMP I SEP1 /JMP USED TO CALL ROUTINES COMMON TO AMODE AND SMODE
313 \f /JUMP TABLE FOR AMODE INSTRUCTIONS
315 FFADD /FAC_C(A)+FAC OPCODE 0
316 FFSUB /FAC_FAC-C(A) OPCODE 1
317 FFMPY /FAC_FAC*C(A) OPCODE 2
318 FFDIV /FAC_FAC/C(A) OPCODE 3
319 FFGET /FAC_C(A) OPCODE 4
320 FFPUT /C(A)_FAC OPCODE 5
321 FFSUB1 /FAC_C(A)-FAC OPCODE 6
322 FFDIV1 /FAC_C(A)/FAC OPCODE 7
323 /ALL INSTRUCTIONS BEYOND THIS POINT ARE COMMON TO AMODE AND SMODE
324 SEP1, LS1I /S1_C(A) OPCODE 10
325 LS2I /S2_C(A) OPCODE 11
326 FJOCI /IF TRUE,PC_C(PC,PC+1) OPCODE 12
327 JEOFI /IF EOF,PC_C(PC,PC+1) OPCODE 13
328 LINEI /LINE NUMBER OPCODE 14
329 ARRAYI /ARRAY INST OPCODE 15
331 OPERI /OPERATE INST OPCODE 17
334 SMODE, TAD TEMP1 /INST OFFSET
335 TAD JMSSI /BUILD JMP OFF STRING TABLE
336 DCA SDIS /PUT IN LINE
337 CLL /STRING SCALAR TABLE
338 JMS I STFINL /SET UP ARGUMENT ADDRESS
339 SDIS, . /CALL STRING ROUTINE REQUESTED
342 /JUMP TABLE FOR SMODE INSTRUCTIONS
343 / A "/*" IN THE COMMENT MEANS THAT THAT OPCODE IS NOT USED,SO WE
344 /USE THE SLOT FOR REGULAR STORAGE
347 SCOMP /IF SAC .NE. C(A$),PC_PC+2
349 INTPC, . /* INTERPRETER PC
352 STFINL, STFIND /* LINK TO STRING FINDING ROUTINE
353 JMSSI, JMP I .+1 /* DISPATCH JUMP FOR SMODE INSTRUCTIONS
354 \f/ARGPRE-ROUTINE TO TRANSLATE OPERAND FIELD INTO 12 BIT POINTER
355 /INTO SCALAR TABLE FOR USE IN FPP CALLS.
358 TAD INSAV /GET INSTRUCTION
359 AND [377 /STRIP TO OPERAND FIELD
364 TAD SCSTRT /MAKE 12 BIT ADDR
365 SCALDF, 1000 /DF TO SCALAR FIELD (CDF INITIALIZED BY LOADER)
372 DCA ACX /ZERO EXPONENT
373 DCA ACL /ZERO LOW MANTISSA
374 DCA ACH /ZERO HIGH MANTISSA
377 /STRING ACCUMULATOR USED BY STRING OPCODES AND FUNCTIONS
378 /CONTAINS ONE 6BIT CHAR PER WORD
383 NOP /A HLT PLACED HERE WILL ALLOW YOU TO STOP
384 /MACHINE BEFORE RUNTIME SYSTEM STARTS BY
385 /SETTING SWITCH REGISTER
387 ISZ SPINNR /SPIN RANDOM NUMBER SEED
388 NOP /WHILE WAITING FOR INITIALIZING TLS
392 DCA I PS1L /SET UP CDFS IN PSWAP
395 JMS I PFUDSC /SWAP 17600 IN IF NOT ALREADY IN AND SAVE SCOPE FLAG
397 TAD SCALDF /SET PROG NOT RESTARTABLE BIT
398 DCA I L7746 /TELL USR TO SAVE 1000-1777
399 TAD PINFO /POINTER TO INFO TABLE IN 17600
401 TAD POVTAB /POINTER TO BLOCK TABLE IN OVERLAY DRIVER
403 TAD FACCLR /WE HAVE TO GET 4 BLOCK NUMBERS
406 TAD I XR1 /GET BLOCK NUMBER FOR THIS OVERLAY FROM INFO AREA
408 DCA I XR2 /PUT IN TABLE IN OVERLAY DRIVER
411 JMS I [PSWAP /SWAP 17600 BACK TO HIGH CORE NOW
413 START3 /CONTINUE THE INITIALIZING CODE IN INTERMEDIATE BUFFER
424 TAD PSFLAG /TEST WHERE 17600 IS LOCATED
426 TAD [200 /IF NOT TD8E USE 7600
427 TAD [7400 /IF TD8E USE 7400
428 DCA I PHICORE /STORE FOR SWAPPER
431 SNA CLA /SKP IF PAGE 17600 IS ALREADY IN
432 JMS I [PSWAP /ELSE BRING IT IN
436 AND [200 /GET SCOPE BIT FROM RES MONITOR
439 DCA I PHCTR /NOW INITIALIZE THE SCREEN HEIGHT COUNTER
446 \f *SAC+SACLIM+1 /ORIGIN PAST SAC+ONE GUARD CHAR
450 FJOCI, TAD INSAV /GET JUMP INSTRUCTION
451 AND [17 /MASK OFF JUMP CONDITION
453 JMP I (GOSUB /YES-PUSH PC ON STACK THEN JUMP
454 TAD FSTOPI /BASE TAD FOR BUILD OF TAD INSTRUCTION
458 TAD ACH /GET HIGH ORDER FAC
460 JMP SUCJMP /CONDITION TRUE-JUMP
461 JFAIL, JMS I [PWFECH /CONDITION FALSE-DON'T JUMP,BUT BUMP PC
466 JEOFI, JMS I [IDLE /SEE IF FILE OPEN
467 TAD I IOTHDR /1ST WORD OF I/O TABLE ENTRY
468 CLL RTR /GET EOF BIT IN LINK
470 JMP JFAIL /NO-DON'T JUMP
471 /YES, FALL INTO JUMP ROUTINE
473 SUCJMP, JMS I [PWFECH /GET WORD FOLLOWING JUMP INS.
474 DCA I INTPCL /STORE AS NEW PC
475 TAD INSAV /GET JUMP INSTRUCTION
476 AND [340 /MASK OFF DESTINATION FIELD
478 TAD CDFINL /MAKE A CDF INSTRUCTION
479 DCA I [CDFPSU /AND SET NEW PC INSTRUCTION FIELD
480 JMP I [ILOOP /NEXT INSTUCTION
482 K7554, 7554 /MUST PRECEDE SKIP TABLE
484 /SKIP TABLE USED TO HOLD TESTS FOR VARIOUS CONDITIONS
486 K7600, 7600 /UNCONDITIONAL (CLA)
493 JMP I JFORL /FORLOOP JUMP ROUTINE
497 0000;0 /MARK BEGINNING OF GOSUB STACK
507 0 /MARK THE END OF THE GOSUB STACK
508 \f/CALL TO DEVICE DRIVER FOR FILE I/O. ASSUMES ARGS HAVE BEEN SET UP
511 DCA DRARG1 /FUNCTION WORD INTO DRIVER CALL
512 CDFINL, CDF /DF TO CURRENT FIELD
513 TAD I IOTBUF /GET BUFFER ADDRE FROM I/O TABLE ENTRY
514 DCA DRARG2 /PUT IN DRIVER CALL
515 TAD I IOTBLK /GET BLOCK NUMBER FROM I/O TABLE
516 DCA DRARG3 /PUT IN DRIVER CALL
517 TAD I IOTHND /GET DRIVER ENTRY
519 JMS I DRIVER /CALL DRIVER
520 DRARG1, 0 /FUNCTION CONTROL WORD
521 DRARG2, 0 /BUFFER ADDRESS
523 SMA CLA /DEVICE ERROR-IS IT FATAL?
524 JMP I DRCALL /ALLS WELL
525 DE, JMS I [ERROR /FATAL
528 /CALL TO INTERPRETER EXITING ROUTINE
530 FSTOPN, JMS I [XPRINT /ON NORMAL EXITS,WE MUST EMPTY RING BUFFER
533 DCA INSAV /FAKE A CALL TO BASIC.FF FUNCTION 6
534 JMP I .+1 /CALL OVERLAY
537 /USE FUNCTION-TAKES WORD FOLLOWING CALL AND STUFFS IT IN USECON FOR
538 /USE A BUFFER POINTER FOR USER SUBROUTINE
540 USE, JMS I [PWFECH /GET NEXT WORD FROM PSEUDO-CODE STREAM
541 DCA USECON /STORE IN PAGE 0 SLOT
545 \f/ARRAY INSTRUCTIONS
546 /ARRAY INSTRUCTIONS WORK BY FINDING THE ADDRESS OF THE ARGUMENT FROM THE ARRAY SYMBOL
547 /TABLE,THEN CALLING THE APPROPRIATE FLOATING POIN PACKAGE ROUTINE.
549 ARRAYI, TAD MODESW /WHICH MODE?
552 TAD INSAV /GET ARRAY INSTRUCTION
553 AND K0037 /MASK OFF ARRAY OPERAND
554 CLL RTL /MULTIPLY BY 4 (ENTRY LENGTH)
555 TAD ARSTRT /MAKE POINTER INTO ARRAY TABLE
556 DCA XR1 /POINTS TO ARRAY FOR THIS OPERATION
557 ATABDF, . /CHANGE DF TO ARRAY TABLE FIELD (SET BY START)
558 TAD I XR1 /GET POINTER TO FIRST ARRAY ELEMENT
559 DCA TEMP2 /SAVE FOR LATER
560 TAD I XR1 /GET DF FOR VARIABLE
561 DCA ADFC /PUT IN LINE AT END OF ROUTINE
562 TAD I XR1 /GET ARRAY DIMENSION 1
564 TAD S1 /GET SUBSCRIPT 1
565 CLL CMA /SET UP 12 BIT COMPARE
566 TAD TEMP3 /DIMENSION 1 +1
568 SU, JMS I [ERROR /YES-SUBSCRIPT OUT OF BOUNDS ERROR
569 DCA TEMP6 /CLEAR TEMPORARY
570 TAD I XR1 /GET DIMENSION 2
571 SNA /IS SECOND DIMENSION 0?(ARRAY UNIDIMENSIONAL)
572 JMP ADCALC /YES-DON'T CHECK S2 FOR OUT OF BOUNDS
573 DCA ARJMP /SAVE DIM2+1
574 TAD S2 /GET SUBSCRIPT 2
575 CLL CMA /SAVE 12 BIT COMPARE
577 SNL CLA /S2 BIGGER THAN DIM2?
579 TAD S2 /MULTIPLY DIM1+1 BY S2
580 JMS I [MPY /12 BY 12 MULTIPLY ROUTINE
582 TAD S1 /LORD OF S1+(DIM1+1)*S2
585 TAD TEMP6 /HORD OF S1+(DIM1+1)*S2
587 TAD TEMP5 /LORD OF S1+(DIM1+1)*S2
589 DCA TEMP7 /LORD OF [S1+(DIM1+1)*S2]*2
590 TAD TEMP6 /HORD OF S1+(DIM1+1)*S2
592 DCA TEMP3 /HORD OF [S1+(DIM1+1)*S2]*2
594 TAD TEMP5 /LORD OF S1+(DIM1+1)
595 TAD TEMP7 /LORD OF [S1+(DIM1+1)*S2]
596 DCA TEMP7 /LORD OF 3*[S1+(DIM1+1)*S2]
598 TAD TEMP6 /HORD OF [S1+(DIM1+1)*S2)*2
599 TAD TEMP3 /HORD OF S1+(DIM1+1)*S2
600 DCA TEMP6 /HORD OF 3*[S1+(DIM1+1)*S2]
602 TAD TEMP7 /INDEX TO ELEMENT
603 TAD TEMP2 /AC POINTS TO CORRECT ARRAY ELEMENT
604 DCA XR1 /SAVE POINTER
606 TAD TEMP6 /COMBINE TO MAKE TOTAL # OF FIELD OVERLAPS
608 RAL /SLIDE OVERLAPS TO FIELD BITS (6-8)
609 TAD ADFC /ADD ANY CHANGE IN DATA FIELD TO CDF
610 DCA ADFC /PUT ABSOLUTE CDF IN LINE
611 TAD INSAV /GET ARRAY INSTRUCTION AGAIN
612 AND [340 /MASK OFF ARRAY OPCODE
615 RAR /SLIDE TO BITS 9-11
616 TAD JMPI2 /AND USE AS INDEX INTO JUMP TABLE
617 DCA ARJMP /PUT JUMP IN LINE OF CODE
619 DCA FF /PUT FPP IN "SPECIAL MODE"
620 ADFC, . /CHANGE DF TO DF OF ARRAY ELEMNT
621 TAD XR1 /AC POINTS TO ARRAY ELEMENT
622 ARJMP, . /PERFORM THE REQUIRED OPERATION
623 NOP /FPP SOMETIMES RETURNS TO CALL+2
628 AJT, FFSUB1 /FAC=A(S1,S2)-FAC OPCODE 0
629 FFADD /FAC=FAC+A(S1,S2) OPCODE 1
630 FFSUB /FAC=FAC-A(S1,S2) OPCODE 2
631 FFMPY /FAC=FAC*A(S1,S2) OPCODE 3
632 FFDIV /FAC=FAC/A(S1,S2) OPCODE 4
633 FFGET /FAC=C(A(S1,S2) OPCODE 5
634 FPUTLL, FFPUT /C(A(S1,S2)=FAC OPCODE 6
635 FFDIV1 /FAC=A(S1,S2)/FAC OPCODE 7
636 \f /STRING ARRAY DISPATCH
638 SARRAY, TAD INSAV /GET INSTRUCTION
639 AND [340 /ISOLATE ARRAY OPCODE
641 RTR /AND SLIDE IT OVER FOR AN OFFSET
643 TAD JMPISA /BUILD A JUMP TO STRING INSTRCUTION
644 DCA SAD /AND PUT IN LINE
645 STL /TELL SFIND TO USE ARRAY TABLE
646 JMS I STFILK /SET UP ARGUMENT ADDRESS
647 SAD, . /EXECUTE INSTRCUTION
649 /STRING ARRAY JUMP TABLE
650 /USED WHEN ARRAYI CALLED IN SMODE
651 / A "/*" IN THE COMMENT MEANS THAT OPCODE IS UNDEFINED AND THE SLOT
652 /IN THE TABLES IS USED FOR NORMAL STORAGE
654 JMPISA, JMP I .+1 /DISPATCH JUMP FOR STRING ARRAY INSTRUCTIONS
656 SCON1 /SAC_SAC&C(A$(S1))
657 SCOMP /SKIP IF SAC=C(A$(S1))
660 STFILK, STFIND /* LINK TO STRING FINDING ROUTINE
662 SSTORE /C(A$(S1))_SAC
663 JMPI2, JMS I AJT /* DISPATCH JUMP FOR ARRAY INST
664 \f/ROUTINE TO PUT ONE WORD IN FILE BUFFER IN FIELD 1
668 JMS I [IDLE /CHECK IF FILE OPEN
669 TAD I IOTPTR /GET READ/WRITE POINTER
671 TAD ENTNO /GET FILE #
672 SZA CLA /IF TTY,BUFFER FIELD IS 0
674 TAD TEMP6 /GET WORD TO STORE AGAIN
675 DCA I TEMP7 /STORE IT IN BUFFER
677 TAD I IOTHDR /HEADER WORD
678 AND (7737 /TURN OFF BLOCK WRITTEN BIT
679 TAD (40 /TURN IT ON AGAIN
684 \f/TELETYPE DRIVING ROUTINE
685 /2 ENTRY POINTS-XPUTCH PUTS A CHARCTER IN THE RING BUFFER
686 / XPRINT TYPES A CHARACTER IF POSSIBLE
687 / AND RETURNS TO CALL+1 IF THERE
688 / ARE MORE CHARCTERS IN THE BUFFER,CALL+2
689 / IF THE BUFFER IS EMPTY
690 /THE IDEA IS THE PLACE CALLS TO XPRINT AT VARIOUS POINTS IN THE INTER-
691 /PRETER AND THUS KEEP THE TTY BUSY WITHOUT WASTING THE TIME WAITING FOR
692 /THE TTY FLAG. THE SUCCESS OF THIS SCHEME DEPENDS HEAVILY ON THE NUMBER
693 /AND PLACEMENT OF THE CALLS TO XPRINT.
696 DCA CHRSAV /SAVE THE CHARACTER
697 XPUT1, ISZ SPINNR /SPIN RANDOM # SEED
698 JMS XPRINT /START A CHAR IF POSSIBLE
700 TAD BCNT /GET THE NUMBER OF AVAILABLE SLOTS
701 SNA CLA /ARE THERE ANY?
702 JMP XPUT1 /NO-TRY TO RPINT 1 AND FREE UP A SPACE
703 PUTCHR, TAD CHRSAV /GET CHARACTER AGAIN
704 DCA I BUFIN /PUT CHARACTER IN RING BUFFER
705 ISZ BUFIN /BUMP BUFEER POINTER OF INPUT
706 CLA CLL CMA /-1 IN AC
707 TAD BCNT /DECREMENT AVAILABLE SLOT COUNT
709 TAD BUFIN /GET BUFFER INPUT POINTER
710 TAD MBEND /SUBTRACT ADDR OF END OF BUFFER
711 SPA SNA CLA /PAST EDN OF BUFFER?
712 JMP I XPUTCH /NO-RETURN
713 TAD BSTRTA /YES-RESET INPUT POINTER TO BEGINNING OF BUFFER
717 BUFIN, BSTRT /POINTER TO NEXT SLOT FOR BUFFER INPUT
718 BUFOUT, BSTRT /POINTER TO NEXT CHARACTER TO BE PRINTED
719 BSTRTA, BSTRT /ADDR OF START OF TTY BUFFER
720 BCNT, 30 /# OF AVAILABLE SLOTS IN BUFFER (40 INITIALLY)
722 MBEND, -BEND /-ADDR OF END OF RING BUFFER
731 KSF /IS KEYBOARD FLAG UP?
732 JMP NOCC /NO-NO CHANCE FOR A CTRL/C
733 KRB /YES-GET THE CHAR IN KEYBOARD BUFFER
734 AND [177 /GET RID OF PARAITY
735 TAD MCTRLC /IS IT CTRL/C
737 JMP I FSTOP1 /YES-ABORT TO EDITOR
751 TAD BCNT /# OF AVAILABLE SLOTS IN BUFFER
752 TAD M50 /IS BUFFER EMPTY?
754 JMP RECP2 /YES-RETURN TO CALL+2
755 TSF /NO-TTY FLAG UP YET?
756 JMP I XPRINT /NO-GO ABOUT YOUR BUSINESS
757 TAD I BUFOUT /GET NEXT CHARACTER
758 /*****************************************************************:
759 /N.B. BECAUSE OF THE ABOVE INSTRUCTION,THE DF MUST BE SET TO THE
760 /INTERPRETER FIELD WHENEVER XPRINT IS CALLED. WATCH YOUR HOOK PLACEMENT!
761 /****************************************************************:
762 JMS I (PCH /TYPE THE CHAR
763 ISZ BUFOUT /BUMP BUFFER OUTPUT POINTER
764 TAD BUFOUT /GET OUTPUT POINTER
765 TAD MBEND /SUBTRACT END OF BUFFER
766 SPA SNA CLA /IS OUTPUT POINTER PAST END?
767 JMP BOUTRS /NO-FREE UP A SPOT
768 TAD BSTRTA /YES-RESET POINTER TO BEGINNING
770 BOUTRS, ISZ BCNT /INCREMENT # OF FREE SLOTS (WE JUST PRINTED ONE)
773 RECP2, ISZ XPRINT /BUMP RETURN
774 JMP I XPRINT /RETURN TO CALL+2 FOR EMPTY BUFFER
777 /TELETYPE RING BUFFER
779 BSTRT, "B /START OF BUFFER
807 LINEI, TAD INSAV /GET INSTRUCTION
809 JMS I [PWFECH /GET WORD FOLLOWING LINE # INST
810 DCA LINELO /SAVE AS LOW ORDER LINE #
811 TRHOOK, JMP I [ILOOP /RETURN TO I-LOOP
812 TAD KC240 /IF TRACE IS ON,FAKE CALL
813 DCA INSAV /TO FUNC2,#12
815 FUNC2I /DISPATCH TO TRACE FUNCTION
817 /INTERMEDIATE TTY BUFFER
818 /USED TO BUFFER OUTPUT FROM FPP BEFORE WE PUT IT
819 /IN BASIC FORMAT FOR TRANSPORTATION TO THE TTY RING
822 KC240, 240 /STOPPER TO MARK BEGINNING OF BUFFER
824 START3, TAD CDFPS /CDF FOR PSEUDO-CODE
825 DCA I [CDFPSU /PUT IN-LINE TO ILOOP
826 TAD PSSTRT /START OF PSEUDO-CODE
827 DCA I INTPCK /PUT INTO PC
828 JMS I [FACCLR /ZERO FAC
829 TAD CDFIO /CDF FOR SYMBOL TABLE FIELD
830 DCA I STDFL /PUT IN LINE FOR STRING FUNCTIONS
831 FPPTM5, TAD CDFIO /CDF FOR SYMBOL TABLES
832 DCA I ATABDL /PUT IN LINE FOR ARRAY CALCULATIONS
833 TAD CDFIO /CDF FOR SCALAR TABLE
834 FPPTM4, DCA I SCALDL /PUT IN LINE FOR ARGPRE
836 DCA I DLCDFL /DATA FIELD FOR DATA LIST
838 DCA DATAXR /DO A RESTORE IN INCORE DATA LIST
839 JMP I .+1 /CONTINUE INITAILIZATION CODE IN TTY INPUT BUFFER
843 FPPTM1, /FLOATING POINT TEMPORARY
849 \f /VT52 DELAY PARAMETERS (MUST BE AT BEGINNING OF PAGE)
851 HEIGHT, 0 /NEGATIVE SCREEN HEIGHT
852 DELAY, 0 /NEGATIVE DELAY VALUE
853 IFNZRO HEIGHT-1200 <__FIX SET COMMAND__>
854 HCTR, 0 /HEIGHT COUNTER INITIALIZED BY SET
855 DCTR, 0 /DELAY COUNTER INITIALIZED BY SET
857 /LOW LEVEL ROUTINE TO TYPE A CHAR
860 TSF /WAIT FOR PREV CHAR
862 TLS /TYPE THE CURRENT ONE
863 AND [177 /MASK TO 7BIT
864 TAD (-15 /TEST IF LINE FEED WILL BE SENT NEXT
866 JMP I PCH /RETURN IF NOT
867 ISZ HCTR /TEST SCREEN HEIGHT IF LF
868 JMP I PCH /RETURN IF NOT AT BOTTOM OF SCREEN
870 DCA HCTR /RESET HEIGHT COUNTER NOW
872 SNA /TEST FOR ZERO DELAY
873 JMP I PCH /RETURN IF SO
874 DCA DCTR /ELSE SET DELAY COUNTER
875 DLOOP, ISZ PSWAP /NOW EXEC INNER LOOP 4096 TIMES (USUALLY)
877 KSF /TEST IF KEY STRUCK
879 JMP I PCH /RETURN AT ONCE IF YES
880 ISZ DCTR /TEST DELAY TIMER
882 JMP I PCH /NOW ALLOW PRINTING TO CONTINUE
884 /OPERATE CLASS INSTRUCTIONS
886 OPERI, TAD INSAV /GET OPERATE INSTRUCTION
887 AND [17 /MASK OFF OPERATE OPCODE
888 TAD JMPI3 /BUILD JUMP OFF OPERATE JUMPTABLE
889 DCA .+1 /STORE THE JUMP IN LINE
890 . /DISPATCH TO PROPER OPERATE ROUTINE
892 JMPI3, JMP I .+1 /JUMP TO OPERATE ROUTINE CALLED FOR
896 FUNC3I /CALL RESIDENT FUNCTION OPCODE 0
897 SPFUNC /SPECIAL FUNCTIONS OPCODE 1
898 SFN /SET FILE NUMBER OPCODE 2
899 FNEGI /NEGATE FAC OPCODE 3
900 RETRNI /GOSUB RETURN OPCODE 4
901 RESTOR /RESTORE DEVICE OPCODE 5
902 LSUB1I /LOAD S1 FROM FAC OPCODE 6
903 LSUB2I /LOAD S2 FROM FAC OPCODE 7
904 MSPACE, 20 /THIS OPCODE NOT DEFINED,SO WE PUT A CONST HERE
905 READI /READ DEVICE OPCODE 11
906 WRITEI /WRITE DEVICE OPCODE 12
907 SWRITE /STRING WRITE OPCODE 13
908 FUNC5I /CALL FILE FUNCTION OPCODE 14
909 FUNC4I /CALL USER FUNCTION OPCODE 15
910 FUNC1I /CALL FUNCTIONS 1 OPCODE 16
911 FUNC2I /CALL FUNCTIONS 2 OPCODE 17
912 \f/ROUTINE TO SWAP PG 17600 WITH N7400 OR N7600 (WHICHEVER THE CASE MAY BE)
913 /WHERE N IS THE HIGH CORE FIELD
916 TAD KK7600 /POINTER TO 17600 AND COUNTER
918 TAD PSFLAG /GET SWAPPING FLAGS
920 CML RAL /TOGGLE THE INPLACE BIT
921 DCA PSFLAG /STORE IT BACK
922 TAD HICORE /PICK UP ADDR OF HIGH CORE
923 DCA TEMP2 /POINTER TO HIGH CORE
924 P1CDF, HLT /DF TO HI CORE
925 TAD I TEMP2 /GET WORD FROM HI CORE
928 TAD I TEMP1 /GET WORD FROM 17600
929 P1CDF1, HLT /DF TO HI CORE AGAIN
930 DCA I TEMP2 /PUT 17600 WORD IN HI CORE
932 TAD TEMP4 /GET SAVED HI CORE WORD
933 DCA I TEMP1 /AND PUT IN 17600
934 ISZ TEMP2 /BUMP HI CORE POINTER
936 ISZ TEMP1 /BUMP 17600 POINTER AND CHECK FOR DONE
937 JMP P1CDF /NO DONE-MOVE NEXT WORD
939 JMP I PSWAP /DONE-RETURN
940 HICORE, 0 /POINTS TO LOCATION OF 17600 SAVE AREA
944 /TEMPORARY INCLUSION FOR FFOUT
952 DCA AC1 /ADD GUARD BITS
956 DCA ACL /ADD LOW ORDER BITS
960 DCA ACH /ADD HIGH ORDER BITS
963 /SHIFT FAC LEFT 1 BIT
978 \f /LOAD SUBSCRIPT 1 OR 2 FROM FAC OR MEMORY
983 LS1I, JMS I [FACSAV /PRESERVE FAC
984 JMS I ARGPRL /GET ARG POINTER INTO AC
985 JMS I [FFGET /LOAD ARG INTO FAC (SKIPS NEXT INST ON RETURN)
986 LSUB1I, JMS I [FACSAV /SAVE THE FAC
987 JMS I [UNSFIX /GET INT(FAC)
988 DCASUB, DCA S1 /SET RESULT AS SUBSCRIPT 1
989 JMS I [FACRES /RESTORE FAC
991 DCA DCASUB /FUDGE INSTR BACK
992 JMP I [ILOOP /NEXT INSTRCUTION
996 /JMP DISPATCH FOR FUNC1 CALLS
998 JMSI4, JMS I .+1 /CALL FOR CANNED FUNCTION SET 1
1000 /JUMP TABLE FOR FUNCTION CALL 1
1002 ATAN /FUNCTION BITS= 0
1013 /JUMP FOR FUNC2 DISPATCH
1015 JMSI5, JMP I .+1 /JMP OFF THE SET 2 TABLE
1017 /JUMP TABLE FOR FUNCTION SET 2
1019 ASC /FUNCTION BITS= 0
1028 /ERRORR MUST BE FUNCTION #10,ELSE "ERROPC" MUST CHANGE
1031 /TPRINT MUST BE #12 OR TRHOOK+1 MUST CHANGE
1033 /DISPATCH FOR FUNC5 CALLS
1035 JMPFIL, JMP I .+1 /CALL FORR FILE MANIPULATING FUNCTIONS
1037 /JUMP TABLE FOR FILE FUNCTIONS
1039 CHAIN /FUNCTION BITS= 0
1047 /ERROR CALL FOR USER FUNCTIONS-USER FUNCTION SHOULD "JMS I (IA"
1050 \f /FUNCTION OVERLAY DRIVER
1052 FUNC4I, JMS I [XPRINT /PURGE TTY RING BUFFER
1053 JMP .-1 /BEFORE CALLING USER FUNCTION
1054 IAC /LOOK FOR OVERLAY FLAG=3
1055 FUNC5I, IAC /LOOK FOR OVERLAY FLAG=2
1056 FUNC2I, IAC /LOOK FOR OVERLAY FLAG=1
1057 FUNC1I, DCA TEMP1 /LOOK FOR OVERLAY FLAG=0
1058 CDF /DF TO THIS FIELD
1059 TAD TEMP1 /GET OVERLAY # AGAIN
1061 TAD OVRLAY /COMPARE AGAINST OVERLAY FLAG
1062 SNA CLA /IS THE ONE WE WANT ALREADY RESIDENT?
1063 JMP OVDNE /YES-JUST JUMP TO FUNCTION
1064 TAD TEMP1 /NO-GET NUMBER OF OVERALY DESIRED
1065 TAD OATADI /USE AS OFFSET TO BUILD STARTING BLOCK TAD
1066 DCA TEMP2 /POINTS TO PROPER STARING BLOCK #
1067 TAD I TEMP2 /GET STARTING BLOCK FOR THIS OVERLAY
1068 DCA OVADD /PUT IN DRIVER CALL
1069 JMS I L7607 /CALL SYSTEM HANDLER
1070 0500 /OVERLAY 3400-4600
1072 OVADD, . /STARTING BLOCK # OF OVERLAY
1073 OE, JMS I [ERROR /I/O ERROR
1075 DCA OVRLAY /CHANGE RESIDENT FLAG
1076 OVDNE, TAD [SAC-1 /ENTER STRING FUNCTIONS WITH SACXR SET UP
1078 TAD TEMP1 /FUNCTION #
1079 TAD JMSTAD /BUILD A TAD OF THE PROPER DISPATCH JMS
1080 DCA .+2 /PUT IN LINE
1081 JMS I [FBITGT /GET # OF FUNCTION DESIRED
1082 . /BUILD JUMP OFF JUMP TABLE
1083 FUJUMP, DCA .+1 /PUT JUMP IN LINE
1084 . /GO TO DESIRED FUNCTION
1089 OVRLAY, 0 /# OF CURRENTLY RESIDENT OVERLAY
1090 /0=ARITHMETIC,1=STRING,2=FILE,3=USER
1092 /OVERLAY TABLE-CONTAINS STARTING BLOCK # OF SYSTEM OVERLAYS
1093 /INITIALIZED BY LOADER
1095 ARITHA, . /STARTING BLOCK OF ARITHMETIC OVERLAY
1096 STRNGA, . /STARTING BLOCK OF STRING OVERLAY
1097 FILEFA, . /STARTING BLOCK OF FILE OVERLAY
1098 USRA, . /STARTING BLOCK OF USER FUNCTIONS
1100 JMSTAD, TAD I TADTAB
1107 \f/CALL FOR RESIDENT FUNCTION
1109 FUNC3I, JMS I [FBITGT /ISOLATE FUNCTION #
1110 TAD JMSI7 /MAKE A JUMP OFF JUMP TABLE
1111 JMP FUJUMP /PUT THE JUMP IN LINE AND EXECUTE IT
1115 /JUMP TABLE FOR RESIDENT FUNCTIONS
1117 XABSVL /FUNCTION BITS= 0
1127 /THIS TABLE CANNOT BE MOVED!!!!
1129 /JUMP DISPATCH FOR USER ROUTINES
1132 /JUMP TABLE FOR USER FUNCTIONS
1133 ILOOPF /USER FUNCTION 1
1151 \f/SPECIAL FUNCTIONS
1153 SPFUNC, JMS I [FBITGT /ISOLATE FUNCTION BITS
1154 TAD JMPI6 /MAKE A JUMP OFF SPECIAL FUNCTION TABLE
1155 DCA .+1 /PUT IN LINE
1158 JMPI6, JMP I .+1 /JUMP TO SPECIAL FUNCTION ROUTINE
1160 /SPECIAL FUNCTION JUMP TABLE
1164 FSTOPN /LEAVE INTERPRETER 2
1165 SRLIST /STRING READ FROM DATA LIST 3
1166 CSFN /SET FILE # TO TTY 4
1167 RDLIST /READ DATA LIST 5
1168 AMODE /SWITCH TO A MODE 6
1169 SSMODE /SWITCH TO S MODE 7
1170 \f/SUBROUTINE UNSFIX-UNSIGNED INTEGER FIX ROUTINE. FIXS A POSITIVE 12 BIT
1171 /NUMBER OUT OF FAC MANTISSA AND LEAVES RESULT IN AC.RESULT IS AN UNSIGNED,
1176 TAD ACL /LOW MANTISSA
1177 CLL RAL /HI BIT OF LO MANTISSA TO LINK
1179 TAD ACH /HIGH MANTISSA
1180 SPA /IS NUMBER POSITIVE?
1181 FM, JMS I [ERROR /NO-BOO!!!
1182 RAL /SHIFT THE SIGN BIT OUT AND THE MANTISSA OVER,
1183 DCA ACH /MAKING 12 BITS OF MANTISSA AND BINARY POINT BEFORE BIT 0
1184 TAD ACX /GET EXPONENT
1185 SPA SNA CLA /IS X>1?
1186 JMP I UNSFIX /NO-FIX IT TO 0
1187 TAD ACX /YES-GET EXPONENT
1188 TAD [-14 /SET BINARY POINT AT 12
1191 SMA /NO-IS # TOO BIG?
1192 FO, JMS I [ERROR /YES
1193 DCA ACX /NO-STORE COUNT
1194 TAD ACH /HI MANTISSA
1195 UNSLP, CLL RAR /SCALE RIGHT
1198 JMP I UNSFIX /YES-RETURN
1200 UNSOUT, TAD ACH /ANSWER IN AC
1205 RESTOR, TAD ENTNO /GET CURRENT FILE #
1207 JMP RESDLS /YES-RESTORE DATA LIST
1208 JMS I (WRBLK /NO-WRITE CURRENT BUFFER
1210 TAD I IOTLOC /STARTING BLOCK-1
1211 DCA I IOTBLK /SET CURRENT BLOCK #
1212 TAD I IOTBUF /GET BUFFER ADDRESS
1213 DCA I IOTPTR /USE IT TO RESET READ\WRITE POINTER
1214 TAD I IOTHDR /GET HEADER WORD
1215 AND (7435 /CLEAR EOF BIT,BUFFER WRITTEN BIT,AND CHAR #
1217 JMS I [NEXREC /READ FIRST BLOCK INTO BUFFER
1219 RESDLS, TAD DLSTRT /ADDRESS OF START OF INCORE DATA LIST
1220 DCA DATAXR /USE IT TO RESET DATA LIST POINTER
1221 JMP I [ILOOP /THATS ALL!
1222 \f/SUBROUTINE STFIND-WHEN CALLED,IF LINK=1 STRING ARRAY TABLE IS
1223 /USED,IF LINK=0 STRING SYMBOL TABLE IS USED. RETURNS WITH AC SET
1224 /TO CDF OF OPERAND STRING,STRPTR POINTING TO THE FIRST WORD
1225 /IN THE STRING, AND THE MAX LENGTH OF THE STRING IS IN STRMAX. ALSO,
1226 /THE ACTUAL LENGTH OF THE STRING IS IN STRCNT
1229 SZL /IS THIS AN ARRAY INST?
1230 JMP SAFIND /YES-POINTER IS INTO ARRAY TABLE
1231 TAD INSAV /GET INST AGAIN
1232 AND [377 /ISOLATE OPERAND POINTER
1233 DCA TEMP1 /NO-SAVE OPERAND POINTER
1236 TAD TEMP1 /3N (3 WORDS/ENTRY)
1237 TAD STSTRT /ADD BASE ADR OF STRING TABLE
1238 STCOM, DCA XR2 /POINTER TO THIS ENTRY IN STRING TABLE
1239 STDF, . /DF TO THAT OF SYMBOL TABLES (SET BY START)
1240 TAD I XR2 /GET POINTER TO STRING
1242 TAD I XR2 /GET CDF FOR OPERAND STRING
1244 TAD I XR2 /GET -(MAX LENGTH OF STRING)
1247 JMP STRCDF /NO-SKIP THIS SUBSCRIPT CALCULATION
1248 TAD S1 /GET SUBSCRIPT
1249 CLL CMA /SET UP 12 BIT COMPARE
1250 TAD I XR2 /GET DIMENSION
1251 SNL CLA /IS S1>DIMENSION?
1253 TAD STRMAX /NO-GET ELEMENT LENGTH
1255 CLL IAC /ROUND OFF TO NEAREST MULTIPLE OF 2
1256 CLL RAR / DIVIDE BY TWO (COUNT/2=WORD COUNT)
1257 CLL IAC /ADD A WORD FOR HEADER
1258 DCA TEMP3 /# OF WORDS IN EACH ARRAY ELEMENT
1259 TAD S1 /GET SUBSCRIPT
1260 JMS I [MPY /S1*ELEMENT LENGTH (ASSUMES LINK UNCHANGED ON RETURN)
1261 TAD STRPTR /ARRAY OFFSET+POINTER TO A(0)
1262 DCA STRPTR /FINAL STRING POINTER
1263 RAL /CARRY TO BIT 11
1264 TAD TEMP6 /ADD TO ACCUMLATED OVERLAPS FROM MULTIPLY
1266 RAL /PUT OVERLAP # INTO BITS 6-8
1267 TAD STRCDF /ADD TO CDF IF NECESSARY
1268 DCA STRCDF /SAVE AGAIN
1269 STRCDF, 0 /DF TO STRING FIELD
1272 DCA STRCNT /STORE -(CURRENT LENGTH OF STRING)
1273 TAD STRCDF /CDF TO OPERAND IN AC
1274 DCA I (SSTEX /SETUP STRING STORE EXIT DF HERE
1275 JMS I (BYTSET /ENTER FUNCTIONS WITH BYTE POINTERS SETUP
1276 JMP I STFIND /RETURN
1278 SAFIND, TAD INSAV /GET INST
1279 AND (37 /ISOLATE OPERAND POINTER
1280 CLL RTL /4N (4 WORDS/ENTRY)
1281 TAD SASTRT /USE STRING ARRAY TABLE
1282 STL /SET LINK FOR ARRAY INST
1283 JMP STCOM /RETURN TO SUBROUTINE MAINLINE
1286 /SEND 7BIT CHAR TO THE CURRENT FILE
1288 PNT, JMS I [UNSFIX /FIX X
1289 AND [177 /STRIP TO 7 ASCII BITS
1290 TAD [200 /FORCE CHANNEL 8
1291 JMS I [PUTCH /PUT IN FILE BUFFER
1295 \f/ROUTINE SFN-ROUTINE TO RESET POINTERS IN PAGE ZERO FILE POINTER
1296 /AREA TO REFLECT A CHANGE IN THE CURRENT FILE NUMBER
1298 SFN, JMS I [UNSFIX /FIX FAC TO GET FILE #
1299 CSFN, DCA ENTNO /IF ENTRY IS HERE,FILE #=0 (TTY)
1302 TAD (-4 /IS RESULT A LEGAL FILE #?
1304 FN, JMS I [ERROR /NO-ERROR
1305 TAD ENTNO /PICK UP FILE NUMBER
1310 CIA /MULTIPLY BY SIZE OF IOTABLE
1311 IFNZRO IOTSIZ-15 <__ASSEMBLY ERROR__>
1312 TAD (TTYF /ADD TO BASE
1313 DCA XR1 /STORE IN TEMP
1314 TAD (IOTHDR-1 /NOW POINT AT PAGE 0 AREA
1316 TAD (-IOTSIZ+3 /SETUP ALL BUT LAST 3
1322 JMP .-4 /SET UP THE POINTERS NOW
1323 JMP I [ILOOP /--RETURN--
1328 GS, JMS I [ERROR /ERROR IF STACK OVERFLOW
1329 TAD I [CDFPSU /ELSE GET CDF INSTR
1333 DCA I GSP /STORE INT PC
1335 JMP I (SUCJMP /EXEC AS NORMAL GOTO NOW
1349 GR, JMS I [ERROR /FATAL ERROR IF NO RETURN
1351 JMP I (JFAIL /BUMP PC PAST ADDR WORD AND CONTINUE
1353 GSP, GSTCK /GOSUB STACK POINTER
1355 /FOR-LOOP JUMP ROUTINE
1356 /ENTER WITH AC = HORD
1358 JFOR, SNA /IS FAC=0?
1359 JMP I (JFAIL /YES-DO NOT JUMP
1360 TAD FSWITC /ADD FSWITCH
1361 SPA CLA /ARE SIGN BIT=FSWITCH?
1362 JMP I (JFAIL /NO-DO NOT JUMP
1363 JMP I (SUCJMP /YES-DO JUMP
1365 /ROUTINE TO INITIALIZE FSWITCH
1368 AND ACH /ISOLATE SIGN OF MANTISSA
1369 DCA FSWITC /STORE IN FSWITCH
1372 \f/ROUTINE TO RESET CHARACTER NUMBER TO 1
1376 AND [7477 /SET CHAR BITS TO 0
1378 JMP I CNOCLR /RETURN
1380 /ROUTINE TO ZERO THE CURRENT I/O BUFFER
1385 DCA XR1 /POINT INTO THE BUFFER
1387 DCA CNOBML /SET COUNT TO 400 WORDS
1388 TAD (232 /INSERT A ^Z IN THE BUFFER FIRST
1392 JMP .-2 /LOOP FOR THE REST
1394 JMP I BLZERO /--RETURN--
1396 /BUMP 3 FOR 2 CHAR NUMBER FOR CURRENT FILE
1399 TAD I IOTHDR /HEADER WORD
1400 TAD [100 /ADD 1 TO THE COUNT BITS
1404 /COMPARE SAC WITH MEMORY, BLANK EXTENDING THE
1405 /SHORTER STRING ON THE RIGHT
1407 SCOMP, DCA MODESW /SET INTERPRETER TO ARITH MODE NOW
1408 JMS I [FACCLR /TENTATIVELY ASSUME EQUAL (FAC = 0)
1409 SCOMLP, TAD STRCNT /IS THE MEMORY STRING EMPTY NOW?
1411 TAD L40 /PAD WITH SPACE IF YES
1413 JMS I (LDB /LOAD NEXT BYTE IF NOT
1415 TAD SACLEN /NOW IS THE SAC EMPTY
1417 TAD L40 /YES, PAD IT
1419 TAD I SACXR /NO GET IT
1420 CLL CIA /COMPARE TO MEMORY
1423 JMP SNEQ /JMP IF NOT EQUAL, L=SENSE OF COMPARE
1424 TAD STRCNT /IS MEMORY STRING DONE
1426 ISZ STRCNT /NO, BUMP COUNT
1427 L40, 40 /EFFECTIVE NOP
1428 TAD SACLEN /IS THE SAC EMPTY
1430 ISZ SACLEN /NO BUMP COUNT
1431 TAD SACLEN /GET SAC REMAINDER (SKP IF IS JUST ZERO)
1432 TAD STRCNT /ADD ARG REMAINDER
1434 JMP SCOMLP /LOOP IF BOTH NOT EMPTY
1435 JMP I [ILOOP /OTHERWISE EQUAL
1437 DCA ACH /STORE SIGN BIT
1438 JMP I [ILOOP /--RETURN--
1441 \f /STRING DATA LIST READ, STRING LOAD AND STRING CONCATENATE
1443 SRLIST, JMS I (DLREAD /FIRST READ NEG BYTE COUNT
1444 DCA STRCNT /STORE IT
1445 STL /SET LINK MEANS USE PHONY DATA LIST BYTE LOAD
1446 SKP /SKP INTO STRING LOAD ROUTINE
1447 SLOAD, CLL /CLEAR LINK TO USE NORMAL LOAD BYTE ROUTINE
1448 DCA SACLEN /CLEAR SAC LENGTH COUNTER
1450 TAD (DRGCH-LDB /USE PHONY LOAD BYTE
1451 SCON1, TAD (LDB /USE REAL LDB FOR CONCATENATE
1455 JMP I [ILOOP /NOTHING TO DO IF NULL STRING
1456 TAD SACLEN /COMPUTE OFFSET INTO SAC
1459 DCA SACXR /TO STORE AFTER END OF PREV STRING
1460 SEGCOM, JMS I SCLDB /GET A BYTE
1461 DCA I SACXR /STORE IT
1463 TAD SACLEN /NOW BUMP SIZE OF SAC
1465 TAD SACLEN /CHECK IF ROOM LEFT
1468 SC, JMS I [ERROR /FATAL ERROR IF SAC OVERFLOW
1470 JMP SEGCOM /ITERATE IF MORE
1471 JMP I [ILOOP /--RETURN--
1475 /ROUTINE TO GET A BYTE FROM THE DATA LIST
1478 TAD SACLEN /TEST FOR EVEN OR ODD
1481 JMP CHR2 /SECOND CHAR
1482 JMS I (DLREAD /FIRST CHAR, READ ANOTHER WORD
1489 CHR2, TAD DRCHR /GET SECOND CHAR
1490 AND [77 /MASK TO 6BIT
1495 /ROUTINE TO SET EOF BIT IN I/O ENTRY
1496 EOFSET, TAD I IOTHDR /HEADER
1497 CLL RTR /EOF BIT TO LINK
1499 /PUT LINK IN EOF BIT
1500 DCA I IOTHDR /STORE IN I/O TABLE ENTRY
1501 JMP I [ILOOP /EOF BIT SET-ABORT TO ILOOP
1503 /SUBROUTINE MPY- 12 BIT BY 12 BIT MULTIPLY. MULTIPLIES THE CONTENTS
1504 /OF TEMP3 BY THE CONTENTS OF THE AC,LEAVING THE HI RESULT IN TEMP6
1505 /AND THE LOW RESULT IN THE AC
1517 JMP .+3 /12 BIT MULTIPLY USED TO FIND (DIM1+1)*S2
1524 TAD TEMP3 /LORD OF (DIM1+1)*S2 IN AC
1525 RAR /HORD OF (DIM1+1)*S2 IN TEMP6
1528 /ROUTINE TO CHECK IF FILE IDLE
1531 TAD I IOTHND /GET HANDLER ENTRY
1532 SNA CLA /IS IT EMPTY?
1533 FI, JMS I [ERROR /YES-USER TRIED TO DO SOMETHING TO AN UNOPEN FILE
1534 JMP I IDLE /NO-RETURN
1535 \f/ROUTINE TO READ NEXT WORD IN DATALIST INTO AC
1538 TAD DATAXR /DATA LIST POINTER
1539 CLL CMA /SET UP 12 BIT COMPARE
1540 TAD DLSTOP /ADDR OF END OF DATA LIST
1541 SNL CLA /POINTER AT END OF LIST?
1542 DA, JMS I [ERROR /YES
1543 DLCDF, . /NO-DF TO DATA LIST
1544 TAD I DATAXR /FETCH WORD FROM DATA LIST
1548 /RANDOMIZE STATEMENT
1550 FRANDM, TAD SPINNR /USE SPINNR FOR NEW SEED FOR RND(X)
1551 STL RAL /MAKE SURE SEED IS ODD
1562 JMS I [PUTCH /PRINT A CR,AND LF
1563 DCA I IOTPOS /ZERO NUMBER OF CHARS PRINTED SO FAR
1567 /RETURNS TO CALL+1 IF FILE FIXED LENGTH,CALL+2 IF VARIABLE
1570 TAD I IOTHDR /GET HEADER
1571 AND (4 /ISOLATE TYPE BIT
1572 SZA CLA /IS IT FIXED LENGTH?
1573 ISZ FOTYPE /NO-BUMP RETURN
1574 JMP I FOTYPE /RETURN
1578 XABSVL, JMS ABSVAL /NEGATE FAC IF NEGATIVE
1579 JMP I [ILOOP /--RETURN--
1581 /SUBROUTINE TO TAKE ABS VALUE OF FAC
1586 JMS I [FFNEG /YES-NEGATE IT
1587 JMP I ABSVAL /RETURN
1589 /ROUTINE TO RESTORE THE FAC FROM FP TEMP
1592 JMS I [FFGET /GET FAC
1594 JMP I FACRES /RETURN
1601 JMP I (SSTEX /EXIT IF NULL STRING IN SAC
1602 DCA TEMP1 /SET COUNT
1603 TAD SACLEN /SEE IF WILL FIT
1606 SMA SZA CLA /SKP IF LEN.LE.MAX LEN
1607 SL, JMS I [ERROR /ERROR IF TARGET STRING TOO SMALL
1608 TAD I SACXR /PICK UP SAC BYTE
1609 JMS I (DPB /STORE IT
1612 JMP I (SSTEX /--RETURN--
1614 /STRING READ FROM FILE TO MEMORY
1616 SREAD, JMS I [GETCH /GET CHAR FROM FILE
1618 TAD [-215 /IS IS CR?
1620 JMP I (SSTEX /YES, EXIT
1623 JMP SREAD /YES, IGNORE IT
1624 TAD I (BYTCNT /SEE IF THIS CHAR WILL FIT
1627 JMP ST /NO, SOFT ERROR
1628 TAD CHAR /YES, STORE IT
1632 TAD [215 /FAKE OUT INPUT ROUTINE
1634 JMP I (SSTEX /SET STRING SIZE AND EXIT
1635 \f /STRING WRITE FROM SAC TO DEVICE
1638 TAD SACLEN /SEE IF NULL STRING
1640 JMP I [ILOOP /RETURN IF SO
1642 TAD I IOTPOS /ADD TO NUMBER OF CHARS PRINTED SO FAR
1644 SMA SZA CLA /SKP IF LE WIDTH OF LINE
1645 JMS I [CRLFR /ELSE RESET CARRAIGE
1647 DCA STRCNT /SET LOOP COUNTER
1649 DCA SACXR /POINT AT SAC
1653 TAD (240 /CONVERT TO 8BIT
1656 JMP SWRLP /ITERATE IF MORE
1657 JMP I [ILOOP /--RETURN--
1659 \f/COMMA FUNCTION (KNOWN ONLY TO COMPILER FOR FORMATTING PRINT
1662 COMMA, JMS I [FTYPE /SKP IF FILE IS ASCII
1663 JMP I [ILOOP /NO-COMMA FUNCTION IS A NOP
1664 TAD COMMAS /GET COMMA SWITCH
1665 SNA CLA /WAS LAST THING PRINTED A COMMA?
1666 JMP .+3 /NO-WE ARE OK
1667 TAD (" /YES-PRINT A SPACE BEFORE DOING COMMA CALCULATION
1670 DCA COMMAS /SET COMMA SWITCH
1673 TAD I IOTPOS /GET NUMBER OF CHARS PRINTED SO FAR
1674 COMLOP, TAD (-COLWID
1676 JMP SLOVER /YES-SLIDE PRINT HEAD TO START OF NEXT
1677 SNA /EXACTLY ON A COLUMN?
1678 JMP I [ILOOP /YES-DONE
1679 ISZ TEMP2 /ALL MARKERS CHECKED YET?
1680 JMP COMLOP /NO-DO NEXT
1681 CLA /FALL INTO CR ROUTINE TO RESET COL TO 0
1683 /CARRIAGE RETURN FUNCTION (KNOWN ONLY TO COMPILER FOR TERMINATING
1686 CRFUNC, TAD I IOTHDR
1688 SNL CLA /SKP IF EOF IS SET
1689 JMS I [FTYPE /SKP IF FILE IS ASCII
1690 JMP I [ILOOP /WE DON'T WANT TO OUTPUT CLFR
1691 JMS I [CRLFR /DO AS WE ARE TOLD
1692 JMP I [ILOOP /NEXT INST
1696 TAB, JMS I [UNSFIX /FIX X TO INTEGER
1698 TAD I IOTPOS /COMPARE DESIRED COLUMN TO REAL COLUMN
1699 IAC /BUMP BY 1 (WORD 7=COL #-1)
1700 SMA /IS X>=CURRENT COLUMN?
1701 JMP I [ILOOP /YES-THEN DO NOTHING
1702 /FALL INTO SPACE OUT ROUTINE
1704 SLOVER, DCA COLCNT /-# OF COLUMNS TO NEXT MARKER
1705 JMS I [FTYPE /IS FILE NUMERIC?
1706 JMP I [ILOOP /YES-THIS IS A NOP
1708 JMS I [PUTCH /PRINT IT
1709 ISZ COLCNT /THERE YET?
1710 JMP .-3 /NO-TYPE ANOTHER SPACE
1711 JMP I [ILOOP /YES-DONE
1713 COMMAS, 1 /SET TO 1 IF LAST PRINT WAS A COMMA MOVE
1716 /ROUTINE TO CALL ERROR ROUTINE BY FAKING A FUNC2 CALL TO FUNCTION #10
1719 CLA CLL IAC /ENTRY AC RANDOM
1720 AND PSFLAG /TEST IF OS/8 17600 RESIDENT
1722 JMS I [PSWAP /ELSE FORCE IT OUT (THESE ERRORS ARE FATAL)
1724 DCA INSAV /FAKE A FUNC CALL TO FUNC2 #10
1726 XERRRET,JMP I ERROR /RETURN TO CALLER IF NON FATAL ERROR
1730 FNEGI, JMS I [FFNEG /CALL NEGATE ROUTINE
1731 JMP I [ILOOP /RETURN TO ILOOP
1733 NUMBUF, ZBLOCK 6 /6 DIGIT BUFFER USED BY FFOUT
1736 \f /INCREMENT AND LOAD 6BIT BYTE FROM MEMORY
1739 JMS BUMP /INCREMENT POINTER AND SET DF
1740 TAD I BYTPTR /PICK UP BYTE
1742 ISZ BYTSWT /TEST HALFWORD SWITCH
1747 AND [77 /MASK TO 6BIT
1748 JMP I LDB /RETURN WITH CHAR IN AC
1750 /INCREMENT AND DEPOSIT BYTE IN MEMORY
1753 AND [77 /MASK TO 6BIT NOW
1755 JMS BUMP /INCREMENT POINTER AND SET DF
1757 ISZ BYTSWT /SKP IF PTR BUMPED
1758 CMA CML /ELSE PRESERVE LEFT HALF
1759 AND I BYTPTR /ZERO OUT TARGET BYTE
1763 JMP .+4 /JMP IF NO SHIFT
1768 DCA I BYTPTR /STORE BYTE
1770 ISZ BYTCNT /TALLY NUMBER OF BYTES STORED
1771 JMP I DPB /--RETURN--
1776 TAD BYTSWT /BUMP LOW ORDER BIT
1779 ISZ BYTSWT /SKP IF NO CARRY
1780 ISZ BYTPTR /ELSE BUMP WORD PTR
1781 JMP BYTCDF /JMP OUT IF FIELD NOT CROSSED
1784 DCA BYTCDF /PROPAGATE CARRY INTO CDF INSTR
1785 BYTCDF, 0 /GETS SET BY BYTSET TO TARGET FIELD
1786 JMP I BUMP /RETURN WITH A CLEAR LINK
1788 /BYTE LOAD/STORE INITIALIZE ROUTINE
1791 TAD SSTEX /GET FIELD OF STRING
1792 DCA BYTCDF /STORE INLINE
1793 TAD STRPTR /NOW GET ADDR OF COUNT WORD
1796 DCA BYTSWT /SET LOW ORDER BIT TO CARRY NEXT TIME
1797 DCA BYTCNT /CLEAR DEPOSITED BYTE COUNT
1799 DCA SACXR /ALWAYS RETURN WITH SAC POINTER SET UP
1800 JMP I BYTSET /--RETURN--
1802 /STRING STORE EXIT ROUTINE
1804 SSTEX, 0 /GETS SET BY STFIND TO DF OF STRING
1805 TAD BYTCNT /ENTER WITH POSITIVE LENGTH IN COUNT
1807 DCA I STRPTR /STORE IN STRING
1808 JMP I [ILOOP /--RETURN-- (ILOOP RESETS DF)
1814 \f/SUBROUTINE BUFCHK-CHECKS THE POSITION OF THE BUFFER POINTER FOR
1815 /THE DEVICE WHOSE I/O TABLE ENTRY IS IN WORKING AREA. RETURNS TO CALL+1
1816 /IF THE POINTER IS AT THE END AND CHAR NUMBER IS 1 (LAST
1817 /AVAILABLE CHAR 3 HAS BEEN USED),CALL+2 IF THE POINTER IS AT THE
1818 /END BUT THE CHAR # IS NOT 1 (THERE IS 1 CHAR 3 LEFT), CALL+3
1819 /IF THERE IS 1 WORD LEFT IN BUFFER,CALL+4 IF MORE THAN 1 LEFT.
1822 TAD ENTNO /GET DEVICE #
1824 TAD (62-400 /YES-CHECK FOR A BUFFER 60 WORDS LONG
1825 TAD [400 /NO-CHECK FOR A BUFFER 400 WORDS LONG
1826 TAD I IOTBUF /ADD LENGTH TO BUFFER ADDRESS
1827 CIA /-ADDR OF END OF BUFFER
1828 TAD I IOTPTR /CHECK AGAINST CURRENT POINTER
1829 SNA /IS POINTER AT END OF BUFFER?
1830 JMP EBC /AT END-CHECK THE CHAR #
1832 ISZ BUFCHK /NO-BUMP RETURN
1834 SNA CLA /WAS POINTER AT LAST WORD?
1835 JMP I BUFCHK /YES-RETURN TO CALL+3
1837 JMP I BUFCHK /RETURN TO CALL+4
1839 EBC, JMS I [CHARNO /GET CHAR #
1840 JMP I BUFCHK /IT WAS 1-RETURN TO CALL+1
1841 NOP /IT WAS 3-RETURN TO CALL+2
1842 ISZ BUFCHK /IT WAS 2-RETURN TO CALL+2
1845 /SUBROUTINE PACKCH-PACKS ASCII CHARS,3 FOR 2, INTO BUFFER FOR THE
1846 /DEVICE IN WORK AREA. CALL WITH THE CHARACTER IN THE AC
1850 JMS I [CHARNO /DETERMINE CHARACTER NUMBER
1853 TAD TEMP1 /1 OR 2-GET CHAR AGAIN
1854 JMS I [WRITFL /STORE IN BUFFER
1855 JMS I (CNOBML /BUMP CHARACTER NUMBER
1859 TAD I IOTPTR /BACK BUFFER POINTER UP TO POINT TO CHAR 1
1863 RTL /SLIDE LEFT HALF INTO BITS 0-3
1866 JMS COMBNE /ISOLATE LEFT HALF,COMBINE WITH CHAR1,AND PUT IN FILE
1867 TAD TEMP1 /CHAR AGAIN
1869 RTL /SLIDE RIGHT HALF INTO BITS 0-3
1870 JMS COMBNE /ISOLATE RIGHT HALF,COMBINE WITH CHAR 2,AND PUT IN FILE
1871 JMS I [CNOCLR /CLEAR THE CHARACTER NUMBER (RESET IT TO 1)
1875 AND [7400 /ISOLATE HALF IN QUESTION
1877 JMS I (BCGET /GET A WORD FROM FILE BUFFER IN FIELD 1
1878 AND [377 /FLUSH ANY SLUSH IN BITS 0-3
1880 JMS I [WRITFL /PUT IN BUFFER
1881 JMP I COMBNE /RETURN
1884 \f/ROUTINE TO READ WORD FROM FILE BUFFER AND BUMP POINTER
1887 JMS I (FOTYPE /IS FILE VARIABLE LENGTH
1889 VR, JMS I [ERROR /YES-IT IS AN ERROR TO TRY AND READ IT
1890 TAD I IOTHDR /CHECK IF MORE THERE
1891 CLL RTR /EOF BIT TO LINK
1893 JMP .+3 /NO-CONTINUE
1894 RE, JMS I [ERROR /YES-ATTEMPT TO READ BEYOND EOF
1895 JMP I [ILOOP /NOT FATAL-RETURN TO I LOOP
1896 JMS BCGET /GET WORD FROM FILE BUFFER
1897 ISZ I IOTPTR /BUMP POINTER
1900 /ROUTINE TO WRITE AC IN FILE BUFFER AND INCREMENT POINTER
1903 JMS I (BCPUT /STORE AC IN FILE BUFFER
1904 ISZ I IOTPTR /BUMP POINTER
1905 TAD I IOTHDR /GET FILE HEADER WORD
1906 CLL RTR /EOF BIT TO LINK
1907 SNL CLA /WAS FILE PAST END?
1908 JMP I WRITFL /NO-RETURN
1909 WE, JMS I [ERROR /YES-ATTEMPT TO WRITE PAST END OF FILE
1910 JMP I [ILOOP /NON-FATAL RETURN TO ILOOP
1912 /ROUTINE TO GET ONE WORD FROM FILE BUFFER IN FIELD 1
1915 JMS I [IDLE /CHECK IF FILE OPEN
1916 TAD I IOTPTR /GET READ WRITE POINTER
1918 TAD ENTNO /GET FILE #
1919 SZA CLA /IF TTY,BUFFER FIELD IS 0
1920 CDF 10 /DF TO BUFFER FIELD
1921 TAD I WRITFL /GET WORD FROM BUFFER
1924 \f/SUBROUTINE UNPACK-UNPACKS ASCII, 3 FOR 2 ,FROM THE FILE IN THE I/O
1925 /WORKING AREA. RETURNS WITH THE CHAR IN CHAR.
1928 JMS I [CHARNO /GET CHAR #
1931 JMS I (CNOBML /BUMP CHAR NUMBER
1932 JMS READFL /GET CHAR AGAIN
1933 U123C, AND [177 /STRIP OFF 7 BITS
1939 TAD (-232 /IS IT CTRL/Z?
1941 JMP I [EOFSET /YES-SET EOF BIT
1942 JMP I UNPACK /RETURN
1944 CHAR3U, JMS I [CNOCLR /RESET CHAR # TO 1
1947 DCA I IOTPTR /BACK BUFFER POINTER UP 2
1948 JMS READFL /GET LEFT HALF OF CHAR
1951 JMS READFL /GET NEXT WORD WITH RIGHT HALF
1952 AND [7400 /ISOLATE RIGHT HALF
1954 RTR /SLIDE RIGHT HALF OVER
1955 TAD XR5 /COMBINE WITH LEFT HALF
1957 RTR /MOVE TO BITS 4-11
1958 JMP U123C /REJOIN MAINLINE
1959 \f/READ FUNCTION-GETS NUMBERS INTO VARIABLES
1961 READI, JMS I [FTYPE /SKP IF FILE IS ASCII
1962 JMP RIMAGE /READ NUMERIC IMAGE
1963 JMS I (FFIN /READ ASCII INTO NUMBER
1964 JMP I [ILOOP /--RETURN--
1965 RIMAGE, JMS I [BUFCHK /YES-CHECK BUFFER POINTER
1966 NOP /PAST END-NEXT RECORD
1967 NOP /AT END-NEXT RECORD
1968 JMS I [NEXREC /ONLY 1 WORD LEFT-IT IS UNUSED IN NUMERIC FMT
1969 JMS READFL /GET WORD FROM FILE
1970 DCA ACX /STORE AS EXPONENT
1971 JMS READFL /GET WORD FROM FILE
1972 DCA ACH /STORE AS HIGH MANTISSA
1973 JMS READFL /GET WORD FROM FILE
1974 DCA ACL /STORE AS LOW MANTISSA
1977 /ROUTINE TO FETCH ASCII CHARACTERS FROM FILE BUFFER
1980 JMS I [FTYPE /IS FILE ASCII?
1981 SR, JMS I [ERROR /NO-ERROR
1989 NTTY, JMS I [BUFCHK /NO-CHECK STATUS OF BUFFER
1990 JMS I [NEXREC /LAST CHAR READ-NEXT RECORD
1991 NOP /CHAR 3 NOT USED YET
1992 TCHAR, 215 /NOP: CHAR 2 AND 3 LEFT
1993 JMS UNPACK /UNPACK CHAR FROM BUFFER
2001 /SUBROUTINE CHARNO-RETURNS TO CALL+1 IF CHAR #=1,CALL+2 IF 3,CALL+3
2005 TAD I IOTHDR /HEADER
2006 AND (300 /ISOLATE CHAR #
2008 RTL /CHAR # TO BITS 0,1
2010 ISZ CHARNO /YES-BUMP RETURN
2011 SZA CLA /IS IT 2 OR 3?
2012 ISZ CHARNO /YES-BUMP RETURN
2013 JMP I CHARNO /RETURN
2016 \f/WRITE FUNCTION-PUTS NUMBERS IN FILE BUFFERS
2018 WRITEI, JMS I [FTYPE /SKP IF FILE IS ASCII
2019 JMP WIMAGE /ELSE DO IMAGE WRITE
2020 JMS I (FFOUT /CONVERT INTERNAL TO ASCII
2023 TAD (INTERB-1 /CALCULATE NUMBER OF CHARS STORED IN BUFFER
2026 DCA SACXR /NOW POINT SACXR INTO BUFFER
2027 TAD TEMP10 /GET COUNT OF CHARS TO BE PRINTED
2029 TAD I IOTPOS /ADD TO PRINT HEAD POSITION
2030 TAD (-WIDTH /COMPARE AGAINST "72"
2031 SMA SZA CLA /WILL THE NUMBER FIT ON THIS LINE?
2032 JMS I [CRLFR /NO-ISSUE A CR,LF
2033 CPLOOP, TAD I SACXR /GET CHAR FROM INTERMEDIATE BUFFER
2034 JMS PUTCH /PUT ON DEVICE
2035 ISZ TEMP10 /BUMP COUNTER
2038 JMS PUTCH /SEND OUT A SPACE AFTER NUMBER
2039 JMP WDONE /TAKE COMMON EXIT
2040 WIMAGE, JMS I [BUFCHK /FILE IS NUMERIC-CHECK BUFFER STATUS
2041 O240, 240 /PAST END-NEW RECORD (AND INST SERVES AS NOP)
2042 O210, 0210 /AT END-NEW RECORD (AND SERVES AS NOP)
2043 JMS I [NEXREC /ONE WORD LEFT-DON'T USE IT
2045 JMS I [WRITFL /WRITE IN BUFFER
2046 TAD ACH /HIGH MANTISSA
2047 JMS I [WRITFL /WRITE IN BUFFER
2048 TAD ACL /LOW MANTISSA
2049 JMS I [WRITFL /WRITE IN BUFFER
2050 WDONE, DCA I (COMMAS /CLEAR COMMA SWITCH
2051 JMP I [ILOOP /WRITE IS DONE
2052 \f/ROUTINE TO PUT ASCII CHARS IN FILE BUFFER. IGNORES RUBOUTS.
2055 DCA TEMP1 /SAVE CHAR
2056 TAD TEMP1 /GET CHAR AGAIN
2058 SNA CLA /IS IT A RUBOUT?
2059 JMP I PUTCH /YES-RETURN
2060 JMS I [FTYPE /IS FILE NUMERIC?
2061 SW, JMS I [ERROR /YES-ERROR
2062 ISZ I IOTPOS /BUMP COULMN NUMBER
2063 TAD ENTNO /GET ENTRY #
2065 JMP TOUT /YES-JUST PUT CHARS IN RING BUFFER
2066 JMS I [BUFCHK /NO-IS BUFFER FULL?
2067 JMS I [NEXREC /YES-NEXT RECORD
2068 O40, 40 /THERE IS A CHAR 3 LEFT (AND IS A NOP)
2069 O20, 20 /THERE IS A CHAR 2 AND 3 LEFT (AND IS A NOP)
2070 TAD TEMP1 /GET CHAR AGAIN
2071 JMS I [PACKCH /PUT IN BUFFER
2074 TOUT, TAD TEMP1 /GET CHAR
2075 JMS I [XPUTCH /PUTCH CHAR IN OUTPUT BUFFER FOR TTY
2077 \f/SUBROUTINE NEXREC-WRITES THIS BUFFER IN FILE,THEN READS IN NEXT BUFFER
2078 /IF POSSIBLE,ELSE SETS EOF BIT. IF DEVICE IS READ OR WRITE ONLY
2079 /IT JUST READS OR WRITES A BLOCK,WHICHEVER IS APPROPRIATE
2082 TAD I IOTHDR /GET HEADER
2083 AND O20 /GET READ/WRITE ONLY BIT
2085 JMP FILSTR /NO-DEVICE IS FILE STRUCTURED
2086 JMS I (FOTYPE /YES-IS IT INPUT OR OUTPUT FILE?
2090 JMS BLINIT /INIT FILE TABLE ENTRIES
2096 FILSTR, JMS WRBLK /WRITE THE CURRENT BLOCK IF IT HAS BEEN CHANGED
2097 JMS BLINIT /INIT FILE TABLE ENTRIES
2098 ISZ I IOTBLK /BUMP BLOCK #
2099 TAD I IOTLOC /STARTING BLOCK
2101 TAD I IOTBLK /SUBTRACT FROM CURRENT BLOCK FOR FILE LENGTH
2102 CLL CMA /SET UP CURRENT FILE LENGTH FOR 12 BIT COMPARE
2103 TAD I IOTLEN /COMPARE TO ACTUAL LENGTH
2104 SNL CLA /IS IT > CURRENT LENGTH?
2105 JMP LASTB /YES-EXTEND THE FILE IF IT IS OUTPUT
2106 JMS BLREAD /READ IN THE NEXT RECORD
2107 JMP I NEXREC /RETURN
2110 LASTB, JMS I (FOTYPE /IS FILE FIXED LENGTH?
2111 JMP I [EOFSET /YES-SET EOF FLAG
2112 TAD I IOTLEN /NO-GET ACTUAL LENGTH
2114 TAD I IOTMAX /MAXIMUM LENGTH
2115 SNL CLA /IS ACTUAL LENGTH >= MAXIMUM LENGTH?
2116 JMP I [EOFSET /YES-SET EOF BITS
2117 ISZ I IOTLEN /NO-BUMP ACTUAL LENGTH
2118 JMP I NEXREC /RETURN WITHOUT READING NEXT RECORD
2119 \f/ROUTINE TO READ 2 PAGES FROM DEVICE
2123 TAD O210 /"READ 2 PAGES"
2124 JMS I [DRCALL /HANDLER CALL
2127 /ROUTINE TO WRITE 2 PAGES ONTO DEVICE
2130 TAD I IOTHDR /GET FILE HEADER
2131 AND O40 /GET FILE WRITTEN BIT
2132 SNA CLA /HAS THIS BLOCK BEEN CHANGED?
2133 JMP I WRBLK /NO-RETURN
2134 TAD (4210 /"WRITE 2 PAGES"
2135 JMS I [DRCALL /CALL TO DEVICE HANDLER
2139 /ROUTINE TO INITIALIZE I/O TABLE ENTRIES AFTER READ OR WRITE
2143 DCA I IOTPTR /INIT READ/WRITE POINTER
2145 AND (7437 /SET CHAR # TO 1 AND CLEAR BLOCK WRITTEN BIT
2149 /ROUTINE TO SAVE THE FAC IN FP TEMP
2152 JMS I [FFPUT /STORE FAC
2153 INTERB /USE INTERMEDIATE BUFFER FOR TEMP STORAGE
2154 JMP I FACSAV /RETURN
2163 /////////////////////////////////////////////////////////////
2164 /////////////////////////////////////////////////////////////
2165 //////////// OVERLAY BUFFER 3400-4600 ////////////////////
2166 //////////// CONTAINS FUNCTION OVERLAYS ////////////////////
2167 //////////// AT RUN TIME ////////////////////
2168 /////////////////////////////////////////////////////////////
2169 /////////////////////////////////////////////////////////////
2172 \f/////////////////////////////////////////////////////////////
2173 /////////////////////////////////////////////////////////////
2174 ////////////// OVERLAY 1-ARITHMETIC FUNCTIONS ///////////////
2175 /////////////////////////////////////////////////////////////
2176 /////////////////////////////////////////////////////////////
2185 INT, VERSON^100+SUBVAF+6000 /INITIALLY CONTAINS VERSION OF ARITH OVERLAY
2186 JMS I [FFPUT /SAVE X
2188 TAD ACX /GET EXPONENT
2189 SMA SZA CLA /IS EXP<0?
2194 JMS I [FACCLR /YES-RETURN A 0
2196 INSC, TAD ACH /GET HI MANTISSA
2198 JMP INTPOS /NO-USE FAC AS IS
2199 JMS I [FFNEG /YES-NEGATE FAC (MAKE IT POS)
2201 INTPOS, DCA TEMP3 /FLAG FOR NEGATIVE
2202 DCA TEMP5 /ZERO LORD MASK
2204 DCA TEMP4 /INITIALIZE HORD MASK TO 4000
2209 CLL CML RAR /ROTATE 1'S THROUGH 3 WORD MASK
2211 TAD TEMP5 /UNTIL THERE IS A COUNT OF ZERO
2216 TAD ACH /YES-MASK HORD
2223 SNA CLA /WAS ORIGINAL NUMER <0?
2225 JMS I [FFPUT /SAVE INT(X)
2227 JMS I (FFADD /-INT(X)+(X)
2231 JMS I [FACCLR /FLUSH FAC
2232 TAD TEMP3 /WAS INT(X)=X?
2234 JMP JUSNEG /YES-JUST NEGATE INT(X)
2235 JMS I (FFADD /NO-ADD 1
2237 JUSNEG, JMS I (FFADD /GET INT(X)
2239 JNEG, JMS I [FFNEG /AND NEGATE (INT(5.3)=-6)
2242 M1R, JMS I [FFGET /LOAD FAC WITH 1
2244 JMP JNEG /JUST NEGATE AND RETURN
2250 \f/EXPONENTIATION FUNCTION
2252 /IF A=0 AND B>0,A^B=0
2253 /IF A=0 AND B<0,DIVIDE BY ZERO ERROR MESSAGE RESULTS AND A^B=0
2254 /IF B=INTEGER > 0, A^B=A*A*A*.......*A
2255 /IF B=INTEGER < 0, A^B=1/A*A*A*.......*A
2256 /IF B=REAL AND A>0, A^B=EXP(B*LOG(A))
2257 /IF B=REAL AND A<0, A FATAL ERROR RESULTS
2260 JMS I [FFPUT /SAVE A
2262 JMS I [FFPUT /SET UP RUNNING PRODUCT IN CASE OF
2264 TAD ACH /HI ORDER OF A
2266 DCA INSAV /POINTER TO B IN SYMBOL TABLE
2267 JMS I ARGPLL /FIND B
2269 ARGPLL, ARGPRE /LOC SKIPPED BY FPP,SO WE USE IT FOR CONSTANT
2271 TAD ACH /HI ORDER OF B
2273 JMP I (RETRN1 /YES A^B=1
2276 TAD EXPON /YES-GET HI ORDER A
2278 JMP I (DV /YES-DIVIDE BY ZERO ERROR
2279 TAD EXPON /B>0. IS A=0?
2282 JMS I [FFPUT /SAVE B
2285 JMS I (MULLIM /TEST EXPONENT OF RESULT TO LIMIT LARGE MULTIPLY LOOPS
2286 JMS I (FFSUB /INT(B)-B
2288 TAD ACH /IS INT(B)-B=0?
2290 JMP I (USELOG /NO-USE LOGS
2291 JMS I [FFGET /NO-USE REPETITIVE MULTIPLY
2294 DCA EXPON /SAVE SIGN OF B
2296 JMS I [FFPUT /USE ABS(B) AS MULTIPLY COUNT
2298 EMLOOP, JMS I [FFGET /GET B
2302 JMS I [FFPUT /SAVE NEW COUNT
2305 SNA CLA /IS COUNT ZERO YET
2306 JMP I (EMDONE /YES-MULTIPLIES ARE DONE
2307 JMS I [FFGET /NO-GET RUNNING PRODUCT
2309 JMS I (FFMPY /MULTIPLY BY A
2311 JMS I [FFPUT /SAVE NEW RUNNING PRODUCT
2315 RET0, JMS I [FACCLR /RETURN WITH 0 IN FAC
2319 \fEMDONE, JMS I [FFGET /GET RUNNING PRODUCT
2321 TAD I EXPONK /GET SIGN OF B
2323 JMP I [ILOOP /NO-A^B=A*A*A*...*A
2324 JMS I FIDVP /YES-INVERT
2326 JMP I [ILOOP /A^B=1/A:A*A*...*A
2328 RETRN1, JMS I [FFGET
2332 USELOG, TAD I EXPONK /SIGN OF A
2334 EM, JMS I [ERROR /YES-PRINT A MESSAGE
2335 JMS I [FFGET /LOAD A
2337 JMS I FFLOGL /LOG(A)
2338 JMS I FMPYLV /B*LOG(A)
2340 JMS I FFEXPL /EXP(B*LOG(A))
2353 TAD ACH /GET HIGH MANTISSA
2355 JMP I [ILOOP /YES-THEN LEAVE IT ALONE
2361 DCA ACX /SET UP FLOAT
2362 JMS I [FFLOAT /FLOAT VALUE OF SGN FUNCTION
2365 /FLOATING SQUARE ROOT
2366 /USES A HARDWARE TYPE ALGORITHM FOR BINARY SQUARE ROOTS
2367 /REF: THE LOGIC OF COMPUTER ARITHMETIC-IVAN FLORES-P 409
2370 CLA CLL CML RTR /SET RESULT TO 2000;0000
2373 CDF /DF TO PACKAGE FIELD
2374 TAD KM22 /SET COUNTER FOR DEVELOPING 22 BITS OF RESULT
2375 DCA AC2 /ALREADY HAVE 1
2378 JMP I FROOT /ZERO FAC-NORMALIZED!-RETN. SAME
2380 JMS I [FFNEG /TAKE ROOT OF ABSOL VALUE
2381 TAD ACX /GET EXPONENT OF FAC
2382 SPA /IF NEGATIVE-MUST PROPAGATE SIGN
2384 RAR /DIVIDE EXP. BY 2
2385 DCA ACX /STORE IT BACK
2386 SZL /INCREMENT EXP. IF ORIGINAL EXP
2389 SNL /DO A PRE-SHIFT FOR EVEN EXPONENTS
2390 JMS I AL1K /SO FIRST BIT PAIR IS 10 NOT 01
2391 CLA CLL CMA RAL /SET COUNTER FOR DETECTING A
2392 DCA ZCNT /ZERO REMAINDER
2393 CLA CLL CML RTR /SET UP POSITION OF TRIAL BIT
2394 RTR /FOR FIRST PASS THRU LOOP
2397 TAD K6000 /GET A FAST FIRST BIT-WE KNOW
2398 TAD ACH /THIS WILL WORK SINCE # IS NORMALIZED
2399 DCA ACH /IF # IS A POWER OF TWO, AND A PERFECT
2400 TAD ACH /SQUARE-WE ARE DONE HERE!
2402 TAD ACL /COULD BE-CHECK LOW ORDER
2404 JMP DONE /WHOOPPEE-WE WIN BIG.
2405 JMP LOP01 /NOPE-LOOP DON'T SHIFT FIRST TIME
2406 SLOOP, TAD OPH /SHIFT TRIAL BIT 1 PLACE
2407 CLL RAR /TO THE RIGHT
2408 DCA OPH /AND STORE BACK
2412 JMS I AL1K /SHIFT FAC LEFT 1 PLACE
2413 LOP01, TAD OPL /ADD TRIAL BIT TO`ANSWER
2415 CLL CMA IAC /NEGATE IT
2416 TAD ACL /AND ADD TO FAC (REMAINDER SO FAR)
2417 SNA /IS RESULT ZERO?
2418 ISZ ZCNT /YES-INCREMENT COUNTER
2419 DCA TM /STORE RESULT IN TEMPORARY
2420 \f CML RAL /ADD CARRY TO HIGH ORDER FOR SUBTRACT
2421 TAD OPH /ADD TRIAL BIT
2422 TAD AN1 /ADD RESULT SO FAR (HI ORDER)
2423 CLL CMA IAC /AND SUBTRACT FROM HI ORDER FAC
2425 SNL /RESULT NEGATIVE?
2426 JMP GON /YES-NEXT RESULT BIT IS 0
2427 SZA /NO-IS HI ORDER RESULT=0?
2429 ISZ ZCNT /YES-WAS LOW ORDER =0?
2431 CMA /YES-REM.=0-SET COUNTER SO
2432 DCA AC2 /LOOKS LIKE WE'RE DONE
2433 LOP02, DCA ACH /STORE HIGH ORDER REM. IN FAC
2434 TAD TM /STORE LO ORDER REM. IN FAC
2436 TAD OPL /TRIAL BIT SHIFTED LEFT 1 IS
2437 CLL RAL /RESULT BIT-ADD IT TO ROOT DEVELOPED
2444 GON, CLA CLL CMA RAL /RESET COUNTER FOR ZERO REM.
2446 ISZ AC2 /DONE ALL 23 RESULT BITS?
2448 DONE, TAD AN1 /YES-STORE ANSWER IN FAC
2449 DCA ACH /ITS NORMALIZED ALREADY
2452 JMP I FROOT /AND RETURN
2465 /FLOATING SQUARE ROOT
2466 /USES MODIFIED HARDWARE ALGORITHM FOR BINARY SQUARE ROOTS
2467 /REF: THE LOGIC OF COMPUTER ARITHMETIC-IVAN FLORES; P-409
2470 CLA CLL CML RTR /SET RESLT TO 2000,0000
2473 SWAB /MODE B OF EAE-ALSO DOES MQL
2475 DCA RBCNT /CLR. SHIFT COUNTER
2477 DCA AC2 /SET COUNTER FOR 23 BITS OF RESULT
2478 TAD ACX /GET EXPONENT OF FAC
2481 DCA ACX /STORE IT BACK
2482 DPSZ /INCREMENT EXP. IF ORIG. EXP
2485 MQA /DETERMINE WHETHER TO DO A
2486 CLL RAL /PRE-SHIFT FOR EVEN EXPONENTS.
2488 DCA RKNT /STORE BIT-0 OR 1 SHIFT CNT
2489 CLL CML RTR /SET UP FIRST TRIAL BIT
2493 DCA ACNT /ZERO COUNTER
2496 SWP /GET IN RIGHT ORDER
2497 SNA /IS IT ZERO? (HI ORD=0)
2498 JMP I FROOT /YES-ROOT = 0
2500 DCM /YES-TAKE ABSOL. VALUE
2501 SHL /SHIFT # 1 BIT IF EXP WAS EVEN
2502 RKNT, 0 /SO FIRST BIT PAIR IS 10 NOT 01
2503 TAD K6000 /SUBTRACT 2000-KNOW FIRST BIT
2504 DPSZ /IS 1(NORMALIZED)-DONE??
2505 JMP LOP1 /NO-WE MUST LOOP
2506 JMP DONE /YES-AN EASY ONE!!!
2507 LOOP, DLD /GET THE FAC
2509 SHL /SHIFT FAC APPROPRIATELY
2511 LOP1, DST /MUST STOR BACK IN CASE RESLT
2516 ASR /SHIFT THE BIT APPROPRIATELY
2518 ISZ ACNT /SHIFT 1 MORE NEXT TIME
2519 DAD /ADD IN RESULT SO FAR
2522 ISZ RBCNT /BUMP COUNTER FOR RESLT BIT
2523 DAD /DO THE SUBTRACT
2525 SNL /RESULT NEGATIVE?
2526 JMP GON /YES-NEXT RESULT BIT = 0
2528 DPSZ /NO-DID WE GET A ZERO REMAINDER?
2530 ZREM, CMA /YES-SET SO LOOKS LIKE WE'RE DONE
2532 NOTZRO, DST /GOOD SUBTR.-MODIFY FAC
2533 ACH /ITS NOT CHANGED BY BAD SUBTRACT
2534 CAM /CLEAR EVERYTHING
2536 ASR /SHIFT RESLT BIT TO RIGHT PLACE
2538 DAD /ADD IT TO THE RESULT SO FAR
2539 OPH /WE APPEND IT TO RIGHT OF LAST
2542 GON, ISZ AC2 /DONE 23 BITS?
2544 DONE, DLD /YES-GET RESULT-ITS NORMALIZED
2546 DCA ACH /STORE HIGH ORDER BACK
2548 DCA ACL /STORE LOW ORDER BACK
2555 \f/23-BIT EXTENDED FUNCTIONS
2562 JMS NHNDLE /IF X<0,NEGATE X AND SET NFLAG
2563 JMS I (FFMPY /X*2/PI
2565 JMS FRACT /SAVE X IN TEMP1,THE INTEGER PART OF X IN NUM,AND GET FRACTIONAL PART IN FAC
2566 TAD NUM /GET INTEGER PART OF (2/PI)*X
2567 AND (3 /ISOLATE BITS 10,11
2569 DCA .+1 /MAKE JUMP TO ARGUMENT REDUCING ROUTINE
2570 JMP . /AND ADJUST ARG ACCORDING TO QUADRANT OF X
2572 POLYSN /X IN QUAD1,SIN(X)=SIN(X)
2573 QUAD2 /X IN QUAD2,SIN(X)=SIN(1-X)
2574 QUAD3 /X IN QUAD3,SIN(X)=SIN(-X)
2575 QUAD4 /X IN QUAD4,SIN(X)=SIN(X-1)
2577 QUAD2, JMS I (FFSUB1 /1-X
2579 JMP POLYSN /CALCULATE SIN(1-X)
2580 QUAD3, JMS I [FFNEG /-X
2581 JMP POLYSN /CALCULATE SIN(-X)
2582 QUAD4, JMS I (FFSUB /X-1
2584 POLYSN, JMS I [FFPUT /SAVE X
2587 JMS I [FFPUT /SAVE U
2591 JMS I (FFADD /A5+A7*U
2593 JMS I (FFMPY /A5*U+A7*U**2
2595 JMS I (FFADD /A3+A5(U)+A7(U**2)
2597 JMS I (FFMPY /A3(U)+A5(U**2)+A7(U**3)
2599 JMS I (FFADD /A1+A3(U)+A5(U**2)+A7(U**3)
2601 JMS I (FFMPY /A1(X)+A3(X**3)+A5(X**5)+A7(X**7)
2603 JMS NCHK /IF NFLAG IS SET,SET SIN(X)=-SIN(X)
2604 JMP I SIN /FAC=SIN(X)
2608 /USES SIN ROUTINE TO CALCULATE COS(X)
2611 JMS I (FFADD /COS(X)=SIN(PI/2+X)
2615 \f/ROUTINE TO SEPERATE THE INTEGER AND FRACTIONAL PARTS OF FAC
2616 /ORIGINAL FAC IS SAVED IN TEMP1,THE INTEGER PORTION OF FAC IS
2617 /SAVED AT NUM,AND THE FRACTIONAL FORTION OF THE FAC IS LEFT IN THE FAC
2620 JMS I [FFPUT /SAVE X
2622 JMS I (FFIX /INTEGER PORTION OF X
2624 DCA NUM /SAVE FIXED FORTION OF X
2625 JMS I [FFLOAT /FAC=FLOAT(FIX(X))
2626 JMS I (FFSUB1 /FAC=X-INT(X)=FRACTION (X)
2630 /ROUTINE TO CHECK IF FAC<0; IF IT IS,FAC IS NEGATED AND NFLAG IS
2634 TAD ACH /FETCH HIGH ORDER MANTISSA
2636 JMP NFLGST /NO-CLEAR NFLAG
2637 JMS I [FFNEG /YES-NEGATE FAC
2642 /ROUTINE TO NEGATE FAC IF NFLAG IS NOT =0
2644 NCHK, 0 /LOC ALSO USED FOR TEMP STORAGE
2646 SZA CLA /IS NFLAG=0?
2647 JMS I [FFNEG /NO-NEGATE FAC
2648 JMP I NCHK /YES-RETURN
2651 \f/******EXPONENTIAL******
2653 EXPON1, 0 /LOC USED FOR TEMP STORAGE BY SIN,ARCTAN
2654 JMS I (FFMPY /Y=XLOG2(E)
2656 JMS FRACT /GET FRACTIONAL PART OF Y
2657 JMS I (FFMPY /(FRACTION(Y))*(LN2/2)
2659 JMS I [FFPUT /SAVE Y
2662 JMS I (FFADD /B1+Y**2
2664 JMS I (FFDIV1 /A1/(B1+Y**2)
2666 JMS I (FFADD /A0+A1/(B1+Y**2)
2668 JMS I (FFSUB /A0-Y+A1/(B1+Y**2)
2674 ISZ ACX /MULT. BY 2=2Y
2676 JMS I (FFDIV /2Y/(A0-Y+A1/(B1+Y**2))
2678 JMS I (FFADD /1+2Y/(AO-Y+A1/(B1+Y**2))
2680 JMS I (FFSQ /[1+2Y/(A0-Y+A1/(B1+Y**2))]**2=EXP(Y)
2682 TAD ACX /EXP(X)=(2**N)(EXPY)
2684 JMP I EXPON1 /FAC=EXPON(X)
2688 /CONSTANT THAT WOULDN'T FIT ELSEWHERE
2694 TAD ACX /CHECK IF NUMBER OF MULTIPLIES IS TOO LARGE
2696 CLA /RETURN IF EXPONENT IS NEGATIVE (WE'LL USE LOGS)
2697 TAD (-4 /ONLY A ROUGH ROUGH LIMIT ON THE EXPONENT
2698 SPA SNA CLA /SKP IF NUMBER GT 15 APPROX
2699 JMP I MULLIM /NO, CONTINUE
2700 JMP I (USELOG /YES, USE LOG INSTEAD
2703 \f/******ARC TANGENT******
2706 JMS I NHNDLL /IF X<0,SET NFLAG AND NEGATE
2707 JMS I [FFPUT /SAVE X
2711 TAD ACH /GET HI MANTISSA
2713 JMP ARGPOL /NO-CLEAR GT1FLG
2714 JMS I [FFGET /YES-ATAN(X)=PI/2-ATAN(1/X)
2722 JMS I [FFGET /GET X OR 1/X
2727 JMS I FADDM /Y**2+B3
2729 JMS I FDIV1M /A3/(Y**2+B3)
2731 JMS I FADDM /B2+A3/(Y**2+B3)
2733 JMS I FADDM /Y**2+B2+A3/(Y**2+B3)
2735 JMS I FDIV1M /A2/(Y**2+B2+A3/(Y**2+B3))
2737 JMS I FADDM /B1+A2/(Y**2+B2+A3/(Y**2+B3))
2739 JMS I FADDM /Y**2+B1+A2/(Y**2+B2+A3/(Y**2+B3))
2741 JMS I FDIV1M /A1/(Y**2+B1+A2/(Y**2+B2+A3/(Y**2+B3)))
2743 JMS I FADDM /B0+A1/(Y**2+B1+A2/(Y**2+B2+A3/(Y**2+B3)))
2745 JMS I FMPYM /ATAN(Y)=X*(B0+A1/(Y**2+B1+A2/(Y**2+B2+A3/(Y**2+B3))))
2747 TAD GT1FLG /WAS X>1?
2749 JMP NGT /NO-TEST IF X<0?
2750 JMS I FSUB1M /ATAN(X)=PI/2-ATAN(1/X)
2752 NGT, JMS I NCHKL /IF NFLAG SET,NEGATE FAC
2753 JMP I ATAN /FAC=ATAN(X)
2756 \f/******NAPERIAN LOGARITHM******
2762 SPA SNA /X<0 OR X=0?
2763 JMP I ARTRAP /YES-TAKE ILLEGAL ARGUMENT TRAP
2770 TAD ACL /YES-LORD=0?
2772 JMP POLYNL /NO-ARG IS LEGAL AND NOT 1
2776 JMP I LOG /YES-LOG(1)=0
2778 DCA GTFLG /SAVE EXPONENT FOR LATER
2779 DCA ACX /ISOLATE MANTISSA IN FAC
2780 JMS I [FFPUT /SAVE F
2782 JMS I FADDM /F+SQR(.5)
2788 JMS I FSUBM /F-SQR(.5)
2790 JMS I FDIVM /Z=F+SQR(.5)/F-SQR(.5)
2797 JMS I FMPYM /C5(Z**2)
2799 JMS I FADDM /C3+C5(Z**2)
2801 JMS I FMPYM /C3(Z**2)+C5(Z**4)
2803 JMS I FADDM /C1+C3(Z**2)+C5(Z**4)
2805 JMS I FMPYM /C1(Z)+C3(Z**3)+C5(Z**5)
2807 JMS I FSUBM /C1(Z)+C3(Z**3)+C5(Z**5)-1/2=LOG2(F)
2809 JMS I [FFPUT /SAVE LOG2(F)
2812 DCA ACX /SET UP FLOAT
2814 JMS I FADDM /I+LOG2(F)
2816 JMS I FMPYM /[I+LOG2(F)]*LOGE(2)=LOGE(X)
2818 JMP I LOG /FAC=LN(X)
2829 /CONSTANTS USED BY VARIOUS FUNCTIONS
2834 SINA3, 0 /-.64592098
2837 SINA5, 7775 /.07948766
2840 SINA7, 7771 /-.004362476
2849 LN2OV2, 7777 /.34657359
2855 EXPA1, 12 /-601.80427
2861 ATANB0, 7776 /.17465544
2864 ATANA1, 2 /3.7092563
2873 ATANB2, 2 /3.3163354
2876 ATANA3, 7777 /-.26476862
2879 ATANB3, 1 /1.44863154
2903 /ROUTINE TO FIX ANY FLOATING NUMBER IN FAC BETWEEN -2047 AND +2047 TO
2904 /A TWELVE BIT INTEGER AND LEAVE RESULT IN EXP (LOC 44)
2908 TAD ACX /FETCH EXPONENT
2909 SZA SMA /IS NUMBER <1?
2910 JMP .+3 /NO-CONTINUE ON
2912 JMP FIXDNE+1 /YES-FIX IT TO ZERO
2913 TAD (-13 /SET BINARY POINT AT 11
2914 SNA /PLACES TO RIGHT OF CURRENT POINT?
2915 JMP FIXDNE /NO-NUMBER IS ALREADY FIXED THEN.
2916 SMA /YES-IS NUMBER TOO LARGE TO FIX?
2917 JMP I (FO /YES-TAKE OVERFLOW TRAP
2918 DCA ACX /NO-SET SCALE COUNT
2919 FIXLP, CLL /0 IN LINK
2920 TAD ACH /GET HIGH MANTISSA
2922 CML /YES-PUT A 1 IN LINK
2927 FIXDNE, TAD ACH /YES-ANSWER IN AC
2928 DCA ACX /RETURN WITH ANSWER IN 44
2932 /ROUTINE TO FLOAT ANY INTEGER IN EXP (LOC 44) INTO FAC
2936 DCA ACH /PUT NUMBER IN HI MANTISSA
2937 DCA ACL /CLEAR LOW MANTISSA
2938 TAD (13 /11(10) INTO EXPONENT
2940 JMS I [FFNOR /NORMALIZE
2941 JMP I FFLOAT /RETURN
2942 \f/RANDOM NUMBER GENERATOR
2945 TAD I (RSEED /GET SEED
2946 DCA TEMP3 /PUT IN MULTIPLY OPERAND
2948 JMS I [MPY /MULTIPLY SEED BY 73
2949 DCA I (RSEED /USE LOW ORDER 12 BITS AS NEW SEED
2950 TAD I (RSEED /LOW ORDER OF PRODUCT ALSO SERVES
2951 CLL RAR /AS RANDOM NUMBER
2952 DCA ACH /SET SIGN TO 0 AND STORE AS HORD
2955 DCA ACL /USE 12 BITS AS MANTISSA
2956 DCA AC1 /CLEAR FPP OVERFLOW
2957 JMS I [FFNOR /AND NORMALIZE
2961 \f /FLOATING POINT OUTPUT ROUTINE
2962 /CONVERT INTERNAL NUMBER TO ASCII
2963 /EXIT WITH CHAR STRING IN 'INTERB'
2964 /XR1 = POINTER TO LAST CHAR STORED
2968 DCA XR1 /SET POINTER TO ASCII BUFFER
2969 TAD ACH /SEE IF FAC NEGATIVE
2971 JMP OKPOS /JMP IF POSITIVE
2972 JMS I [FFNEG /TAKE ABS VALUE IF NEGATIVE
2973 TAD ("- /PRINT MINUS SIGN
2975 OKPOS, TAD (240 /PRINT SPACE IF POSITIVE
2977 TAD ACH /SEE IF NUMBER IS ZERO
2979 JMP ZERXIT /SPECIAL CASE IF SO
2980 JMS I (CVTNUM /CALL ROUTINE TO UNPACK TO BASE 10
2982 DCA XR2 /POINT XR2 AT DIGIT BUFFER
2983 TAD (5 /TEST FORMAT TO USE
2988 JMP SMLFMT /JMP IF .0NNNNNN TO .0000NNNNNN
2991 JMP REGFMT /JMP IF .NNNNNN TO NNNNNN
2992 /OTHERWISE USE E FORMAT N.NNNNNE+NNN OR N.NNNNNE-NNN
2993 TAD I XR2 /GET DIGIT TO LEFT OF POINT
2994 JMS PUTD /PUT IT OUT
2996 DCA I XR1 /NOW SEND OUT DECIMAL POINT
2998 DCA AC2 /DO 5 MORE DIGITS
2999 TAD I XR2 /PICK UP DIGIT
3000 JMS PUTD /CONVERT TO ASCII AND STORE
3002 JMP .-3 /LOOP FOR MORE
3006 TAD DECEXP /TAKE ABS(DECEXP)
3010 RTL /CONVERT "+" TO "-" IF NEGATIVE
3013 JMS IDIV /PRINT 3 DIGITS OF EXPONENT NOW
3019 JMP I FFOUT /ALL DONE --RETURN--
3020 \f /HANDLE .0NNNNNN TO .0000NNNNNN
3022 SMLFMT, DCA AC0 /STORE NUMBER OF LEADING ZEROES
3023 TAD (". /PUT OUT DECIMAL POINT
3027 JMP .-2 /LOOP FOR LEADING 0'S
3029 /GENERAL NON E FORMAT .NNNNNN TO NNNNNN
3032 DCA AC1 /INIT COUNT OF NONZERO DIGITS
3034 DCA AC2 /POINT AT END OF DIGIT BUFFER
3035 SHRINK, STA /DECREMENT DIGIT POINTER
3038 ISZ AC1 /REDUCE SIGNIFICANT DIGIT COUNT
3043 JMP PRTLP /JMP OUT IF NOT TO RIGHT OF DECIMAL POINT
3044 TAD I AC2 /ELSE LOOK AT DIGIT
3046 JMP SHRINK /DISCARD IT IF ZERO
3049 DCA DECEXP /SEE IF DIGIT TO BE PRINTED FOLLOWS DP
3054 TAD (". /YES, PRINT DP
3056 NODP, TAD I XR2 /PICK UP DECIMAL DIGIT
3059 JMP PRTLP /JMP IF MORE DIGITS TO PRINT
3060 JMP I FFOUT /--RETURN--
3063 JMP I FFOUT /--RETURN--
3065 /DIVIDE DECEXP BY -DIVISOR IN CALL+1
3068 DCA AC1 /CLEAR QUOTIENT
3072 JMP IDVOUT /JMP OUT IF LESS THAN DIVISOR
3073 DCA DECEXP /ELSE UPDATE IT
3074 ISZ AC1 /TALLY QUOTIENT
3077 TAD AC1 /GET QUOT AS NEXT DIGIT
3082 /CONVERT NUMBER IN AC TO ASCII DIGIT
3083 /MUST NOT TOUCH THE LINK
3087 DCA I XR1 /STORE IN BUFFER
3091 \f /CONVERT NUMBER IN FAC TO FORMAT N.NNNNNE NNN
3092 /DECIMAL EXPONENT RETURNED AS SIGNED NUMBER IN DECEXP
3093 /6 DIGITS STORED IN NUMBUF AS BINARY 0-9
3094 /FIRST REDUCES MANTISSA TO FORM 0DD DDF FFF FFF...
3095 /BY SUCCESSIVE MULTIPLIES OR DIVIDES BY 10. FOLLOWED BY
3096 /RENORMALIZATIONS UNTIL INTIGER BITS
3098 /DECIMAL DIGITS ARE ISOLATED BY REPEATED MULTIPLICATION BY 10.
3101 DCA AC1 /CLEAR OVERFLOW WORD
3102 SKP /SKP IN AND CLEAR DECIMAL EXPONENT
3104 DCA DECEXP /STORE UPDATED DECIMAL EXPONENT
3105 NORML, TAD ACH /SEE IF FRACTION IS NORMALIZED
3108 JMP NORMED /JMP IF YES
3109 JMS I (AL1 /SHIFT AC LEFT 1 BIT
3111 TAD ACX /COMPENSATE BINARY EXPONENT
3113 JMP NORML /TRY AGAIN
3114 NORMED, TAD ACX /RANGE CHECK BINARY EXPONENT NOW
3116 JMP DIVCHK /JMP IF NUMBER GE 1
3118 DCA ACX /INCREASE BINARY EXP TOWARDS ZERO
3119 JMS AR1 /SHIFT 4 BITS RIGHT
3120 JMS AR1 /MAX RELATIVE ERROR WILL BE LT 15*2^-34 PER MULTIPLY
3123 JMS MPY10 /NOW MULTIPLY BY 10.
3124 STA /DECREASE DECIMAL EXPONENT
3125 JMP ADJDEC /RENORMALIZE AND TRY AGAIN
3127 DIVCHK, TAD (-5 /SEE IF EXP GT 4
3129 JMP INRANG /JMP IF NOT, NUMBER MAY BE IN RANGE
3131 TAD (-40 /SET 32. STAGE SUBTRACT-SHIFT DIVIDE (SLOW BUT ACCURATE)
3132 DCA AC2 /(THE LEN ELEKMAN TECHNIQUE)
3133 /MAX RELATIVE ERROR WILL BE LT 9*2^-34. PER DIVIDE
3134 DVLOOP, TAD ACH /SEE IF GE 10.
3137 DCA ACH /UPDATE IF YES
3139 DCA AC0 /SAVE LOW ORDER BIT
3140 JMS I (AL1 /SHIFT MANTISSA NOW
3141 ISZ AC0 /STORE BIT NOW
3145 TAD ACH /NOW ZERO OUT REMAINDER
3148 IAC /NOW INCREASE DECIMAL EXPONENT
3151 INRANG, DCA AC2 /SET SHIFT COUNTER
3153 JMS AR1 /SHIFT FAC RIGHT
3155 JMP .-2 /LEAVE EFFECTIVE BINARY POINT RIGHT OF ACH BIT 4
3156 TAD ACH /ACH = 0DD DDF FFF FFF (D=DECIMAL DIGIT BITS)
3157 TAD (5400 /SEE IF DDDD GE 10
3159 JMP DIVGO /DIVIDE AGAIN (NORMALIZATION WILL WORK)
3161 TAD AC1 /NOW ROUND BY ADDING 0.000005
3164 IAC /ADD 24761 TO LOW BITS
3171 TAD (5400 /SEE IF CARRY INTO 9.XXX...
3173 JMP CVT10 /JMP IF NO
3174 TAD [200 /ELSE SET TO 1.00000
3178 ISZ DECEXP /AND BUMP DECIMAL EXPONENT
3179 O4, 4 /EFFECTIVE NOP
3181 /NOW CONVERT TO DECIMAL DIGITS
3183 CVT10, TAD (-6 /DO 6 DIGITS
3187 JMP CVTGO /FIRST DIGIT IS ALREADY IN
3188 CVTLP, TAD ACH /ZERO OUT PREV DIGIT
3191 JMS MPY10 /MULTIPLY BY 10.
3192 CVTGO, TAD ACH /GET DIGIT FROM 0DD DDF FFF FFF
3199 JMP CVTLP /LOOP IF MORE
3200 JMP I CVTNUM /--RETURN--
3202 /MULTIPLY ACH,,ACL,,AC1 BY 10.
3206 DCA OPH /COPY AC TO OP
3217 /SHIFT FAC RIGHT 1 BIT
3234 /FLOATING POINT INPUT ROUTINE
3238 DCA I FDVPT /INITIALIZE PERIOD SWITCH TO -1
3239 CMA /SET SIGN SWITCH TO -1
3241 CDF /DF TO PACKAGE FIELD
3242 DCA DSWIT /ZERO CONVERSION SWITCH
3243 DECONV, DCA ACX /ZERO OUT THE FAC!
3247 DECNV, DCA DNUMBR /ZERO # OF DIGITS SINCE DEC. PT.
3248 DECON, JMS GCHR /GET A CHAR.FROM TTY.
3249 JMP FFIN1 /TERMINATOR-
3250 ISZ DSWIT /DIGIT-BUMP CONVERSION SWITCH
3251 ISZ DNUMBR /BUMP # OF DIGITS-# IS STORED IN
3252 JMS I FMPYLL /"FMPY TEN"
3254 JMS I [FFPUT /"FPUT I TM3PT"
3256 JMS I [FFGET /"FGET TP"
3258 JMS I [FFNOR /"FNOR"
3259 JMS I FADDLL /"FADD I TM3PT"
3262 FFIN1, ISZ I FDVPT /HAVE WE HAD A PERIOD YET?
3263 JMP FIGO2 /YES-GO ON
3264 ISZ TP1 /NO-IS THIS A PERIOD?
3267 JMP DECNV /YES-ZERO DIG. COUNT AFTER DEC. PT.
3268 /AND GO CONVERT REST
3269 DCA DNUMBR /NO-TERMINATOR-ZERO COUNT OF
3270 /DIGITS AFTER DECIMAL POINT.
3271 FIGO2, ISZ SIGNF /IS # NEGATIVE?(DID WE GET - SIGN?)
3272 JMS I FFNEGP /YES-NEGATE IT
3273 CLA CMA /RESET SIGN SWITCH FOR EXP.
3275 TAD CHAR /NO-WAS THE TERMINATOR AN 'E'?
3278 GETE, JMS GCHR /YES-GET A CHAR. OF EXPONENT
3279 JMP EDON /END OF EXPONENT
3280 TAD TM /GOT DIG. OF EXP-STORED IN TP1
3281 CLL RTL /MULT. ACCUMULATED EXP BY 10
3286 \fEDON, TAD TM /GET EXPONENT
3287 ISZ SIGNF /WAS EXPONENT NEGATIVE?
3288 CMA IAC /YES-NEGATE IT
3289 CMA IAC /AND CALC. DNUMBR - EXPON.
3290 TAD DNUMBR /GET # TIMES TO DIV MANTISSA BY TEN
3292 SPA /RESULT POSITIVE?
3293 CLL CMA CML IAC /NO-MAKE POS. AND SET LINK
3294 CMA /NEGATE FOR COUNTER
3295 DCA DNUMBR /AND STORE
3296 RAL /LINK=1-DIV;=0-MUL. # BY TEN
3297 TAD MDV /FORM CORRECT INSTRUCTION
3298 DCA SIGNF /AND STORE FOR EXECUTION
3299 FCNT, ISZ DNUMBR /DONE ALL OPERATIONS?
3301 JMP I FFIN /YES-RETURN
3302 SIGNF, 0 /NO- MUL OR DIV. MANTISSA
3308 MDV, JMS I .+1 /THESE 3 WDS. MUST BE IN THIS ORDER
3310 FDVPT, FFDIV /!!!!!!!!!!!!!!!!!
3320 \f/ROUTINE TO GET A CHAR FROM THE TTY AND SEE IF IT IS DIGIT
3322 /RETURN TO CALL + 1 IF TERMINATOR, TO CALL + 2 IF DIGIT
3323 /THIS ROUTINE MUST NOT MODIFY THE MQ!!
3325 DCA TM /STORE ACCUMULATED EXPONENT (MAYBE)
3326 JMS INPUT /GET A CHAR FROM TTY.
3327 TAD CHAR /PICK IT UP
3328 TAD PLUS /WAS IT PLUS SIGN?
3330 JMP DECON1 /YES-GET ANOTHER CHAR.
3331 TAD MINUS /NO WAS IT MINUS SIGN?
3334 DCA SIGNF /YES-FLIP SWITCH
3335 DECON1, JMS INPUT /GET A CHAR.
3337 TAD K7506 /SEE IF ITS A DIGIT
3340 DCA TP1 /STORE FOR LATER
3342 ISZ GCHR /YES-RETN. TO CALL+2
3343 JMP I GCHR /NO-RETN. TO CALL+1
3346 /INPUT ROUTINE-IGNORES LEADING SPACES
3349 JMS I IGETCH /USE OUR ROUTINE TO GET CHAR
3350 TAD DSWIT /GET TERMINATOR
3351 SZA CLA /VALID INPUT YET?
3352 JMP IOUT /YES-CONTINUE
3353 TAD CHAR /NO-GET CHAR
3354 TAD M240 /COMPARE AGAINST SPACE
3356 TAD (240-212 /COMPARE TO LF
3357 SNA CLA /IS IT A SPACE OR LF?
3358 JMP INPUT+1 /YES-IGNORE IT
3359 IOUT, JMP I INPUT /RETURN
3360 IGETCH, GETCH /POINTER TO GET CHAR ROUTINE
3361 /ALTERED BY "VAL" FUNCTION TO PICK FROM SAC (BE CAREFULL)
3366 /ROUTINE TO DECIDE CALLING MODE IN LIEU OF "SPECIAL MODE" PROBLEMS
3370 JMP RTN2 /NO-THIS IS ALWAYS SI MODE WITH ADDR IN AC
3371 TAD FF /YES-GET SPECIAL MODE FLIP-FLOP
3372 SZA CLA /IF ON,THE ZERO AC MEANS ADDRESS OF 0
3373 RTN2, ISZ PATCHF /USE AC AS ADDRESS OF OPERAND
3374 JMP I PATCHF /RETURN
3377 /INVERSE FLOATING SUBTRACT-USES FLOATING ADD
3378 /!!FSW1!!-THIS IS OP-FAC
3381 JMS I [PATCHF /WHICH MODE?
3382 TAD I FFSUB1 /CALLED BY USER-GET ADDR. OF OP.
3383 JMS I ARGETL /GO PICK UP OPERAND
3385 JMS I FFNEGA /NEGATE FAC
3386 TAD FFSUB1 /AND GO ADD
3391 /INVERSE FLOATING DIVIDE
3396 JMS I [PATCHF /WHICH MODE OF CALL?
3397 TAD I FFDIV1 /CALLED BY USER-GET ADDR.
3398 JMS I ARGETL /PICK UP OPERAND
3399 TAD ACL /SWAP THE FAC AND OPERAND
3400 DCA OPL /THERE IS A POINTER TO OPL
3401 TAD I AC2 /IN AC2 LEFT FROM ARGET SUBR.
3403 TAD ACX /MIGHT AS WELL SUBTRACT THE
3404 CLL CMA IAC /EXPONENTS HERE (SAVES A WORD)
3405 TAD OPX /THEN ZERO OPX SO WILL NOT
3406 DCA ACX /MESS UP WHEN ITS DONE AGAIN
3407 DCA OPX /LATER (SEE DIV. ROUTINE)
3409 DCA AC2 /NOW SWAP HIGH ORDER MANTISSAS
3414 CDF /DF TO PACKAGE FIELD
3415 TAD FFDIV1 /NOW KLUDGE UP A SUBROUTINE LINKAGE
3419 JMP I MD1P /GO SET UP AND DIVIDE
3426 \f/MDSET-SETS UP SIGNS FOR MULTIPLY AND DIVIDE
3427 /ALSO SHIFTS OPERAND ONE BIT TO THE LEFT.
3428 /EXIT WITH EXPONENT OF OPERAND IN AC FOR EXPONENT
3429 /CALCULATION-CALLED WITH ADDRESS OF OPERAND IN AC AND
3430 /DATA FIELD SET PROPERLY FOR OPERAND.
3433 JMS I ARGETK /GET ARGUMENT
3434 MD1, CDF /DF TO PACKAGE FIELD
3435 CLA CLL CMA RAL /SET SIGN CHECK TO -2
3437 TAD OPH /IS OPERAND NEGATIVE?
3440 JMS I OPNEGP /YES-NEGATE IT
3441 ISZ TM /BUMP SIGN CHECK
3442 TAD OPL /AND SHIFT OPERAND LEFT ONE BIT
3448 DCA AC1 /CLR. OVERFLOW WORF OF FAC
3449 TAD ACH /IS FAC NEGATIVE
3452 JMS I FFNEGK /YES-NEGATE IT
3453 ISZ TM /BUMP SIGN CHECK
3455 LEV, TAD OPX /EXIT WITH OPERAND EXPONENT IN AC
3463 /CONTINUATION OF FLOATING DIVIDE ROUTINE
3465 FD1, TAD AC2 /NEGATE HI ORDER PRODUCT
3467 TAD ACH /COMPARE WITH REMAINDER OF FIRST DIV.
3469 JMP I DVOPSP /GREATER THAN REM.-ADJUST QUOT OF 1ST DIV.
3470 CLL /OK-DO (REM-(Q*OPL))/OPH
3471 DCA ACH /FIRST STORE ADJUSTED PRODUCT
3472 JMS I DV24P /DIVIDE BY OPH (HI ORDER OPERAND)
3473 DVL1, TAD AC1 /GET QUOT. OF FIRST DIV.
3474 SMA /IF HI ORDER BIT SET-MUST SHIFT 1 RIGHT
3475 JMP FD /NO-ITS NORMALIZED-DONE
3481 DCA ACH /STORE IN FAC
3482 TAD ACL /P@ LOW ORDER RIGHT
3485 ISZ ACX /BUMP EXPONENT
3489 FD, DCA ACH /STORE HIGH ORDER RESULT
3490 JMP I FDDONP /GO LEAVE DIVIDE
3492 FDDONP, FDDON /END OF FLTG. DIV. ROUTINE
3493 DV24P, DV24 /ROUTINE TO DO A 24X12BIT DIVIDE
3494 DVOPSP, DVOPS /ROUTINE TO ADJUST QUOT OF FIRST DIV.
3496 /CONTINUATION OF ROUTINE TO ADJUST QUOT. OF FIRST DIV.
3497 /DBAD1 IS ONLY EXECUTED ON DIVIDE OVERFLOW-OTHERWISE THE
3498 /ROUTINE STARTS AT DVOP2
3500 DBAD1, DCA ACX /DIVIDE OVERFLO-ZERO ALL
3501 DVOP2, SNA /IS IT ZERO?
3502 DCA ACL /YES-MAKE WHOLE THING ZERO
3504 JMS I DV24P /DIVIDE EXTENDED REM. BY HI DIVISOR
3505 TAD ACL /NEGATE THE RESULT
3508 SNL /IF QUOT. IS NON-ZERO, SUBTRACT
3509 CMA /ONE FROM HIGH ORDER QUOT.
3513 \f/FLOATING MULTIPLY-DOES 2 24X12 BIT MULTIPLIES
3515 JMS I [PATCHF /WHICH MODE OF CALL?
3516 TAD I FFMPY /CALLED BY USER-GET OPERAND ADDR.
3517 JMS I MDSETK /SET UP FOR MPY-OPX IN AC ON RETN.
3518 TAD ACX /DO EXPONENT ADDITION
3519 DCA ACX /STORE FINAL EXPONENT
3520 DCA DV24 /ZERO TEM STORAGE FOR MPY ROUTINE
3524 DCA ACX /YES-ZERO EXPONENT
3525 JMS MP24 /NO-MULTIPLY FAC BY LOW ORDER OPR.
3526 TAD OPH /NOW MULTIPLY FAC BY HI ORDER MULTIPLIER
3529 TAD AC2 /STORE RESULT BACK IN FAC
3530 RTZRO, DCA ACL /LOW ORDER
3531 TAD DV24 /HIGH ORDER
3533 TAD ACH /DO WE NEED TO NORMALIZE?
3536 JMP SHLFT /YES-DO IT FAST
3537 MDONE, DCA AC1 /NO-ZERO OVERFLOW WD(DO I NEED THIS???)
3538 ISZ FFMPY /BUMP RETURN POINTER
3539 ISZ TM /SHOULD RESULT BE NEGATIVE?
3540 JMP I FFMPY /NOPE-RETN.
3541 JMS I FFNEGR /YES-NEGATE IT
3543 SHLFT, CMA /SUBTRACT 1 FROM EXP.
3546 JMS I AL1PTR /SHIFT FAC LEFT 1 BIT
3550 /24 BIT BY 12 BIT MULTIPLY. MULTIPLIER IS IN OPL
3551 /MULTIPLICAND IS IN ACH AND ACL
3552 /RESULT LEFT IN DV24,AC2, AND AC1
3554 TAD KKM12 /SET UP 12 BIT COUNTER
3556 TAD OPL /IS MULTIPLIER=0?
3559 DCA AC1 /YES-INSURE RESULT=0
3561 MPLP, TAD OPL /SHIFT A BIT OUT OF LOW ORDER
3562 MPLP1, RAR /OF MULTIPLIER AND INTO LINK
3565 JMP MPLP2 /NO-0-JUST SHIFT PARTIAL PRODUCT
3566 \f CLL /YES-ADD MULTIPLICAND TO PARTIAL PRODUCT
3570 RAL /PROPAGATE CARRY
3573 RAR /NOW SHIFT PARTIAL PROD. RIGHT 1 BIT
3578 RAR /1 BIT OF OVERFLOW TO AC1
3580 ISZ OPX /DONE ALL 12 MULTIPLIER BITS?
3582 JMP I MP24 /YES-RETURN
3584 /PART OF DIVIDE ROUTINE-FFDIV MUST BE AT LOC. 6722
3585 MP12L, DCA OPL /STORE BACK MULTIPLIET
3586 TAD AC2 /GET PRODUCT SO FAR
3587 SNL /WAS MULTIPLIER BIT A 1?
3588 JMP .+3 /NO-JUST SHIFT THE PARTIAL PRODUCT
3589 CLL /YES-CLEAR LINK AND ADD MULTIPLICAND
3590 TAD ACL /TO PARTIAL PRODUCT
3591 RAR /SHIFT PARTIAL PRODUCT-THIS IS HI ORDER
3592 DCA AC2 /RESULT-STORE BACK
3593 DVLP1, TAD OPL /SHIFT A BIT OUT OF MULTIPLIER
3594 RAR /AND A BIT OR RESLT. INTO IT (LO ORD. PROD.)
3595 ISZ FFMPY /DONE ALL BITS?
3596 JMP MP12L /NO-LOOP BACK
3597 CLL CMA IAC /YES-LOW ORDER PROD. OF QUOT. X OPL IN AC
3598 DCA ACL /NEGATE AND STORE
3599 CML RAL /PROPAGATE CARRY
3601 FD1P, FD1 /POINTER TO REST OF DIVIDE ROUTINE
3603 /FLOATING DIVIDE ROUTINE
3604 /USES THE METHOD OF TRIAL DIVISION BY HI ORDER
3605 FFDIV, 0 /(USED AS A TEM. BY I/O ROUTINES)
3606 JMS I [PATCHF /WHICH MODE OF CALL?
3607 TAD I FFDIV /CALLED BY USER-GET ARG. ADDR.
3608 JMS I MDSETK /GO SET UP FOR DIVIDE-OPX IN AC ON RETN.
3609 FFD1, CMA IAC /NEGATE EXP. OF OPERAND
3610 TAD ACX /ADD EXP OF FAC
3611 DCA ACX /STORE AS FINAL EXPONENT
3612 TAD OPH /NEGATE HI ORDER OP. FOR USE
3613 CLL CMA IAC /AS DIVISOR
3615 JMS DV24 /CALL DIV.--(ACH+ACL)/OPH
3616 TAD ACL /SAVE QUOT. FOR LATER
3618 TAD KM13 /SET COUNTER FOR 12 BIT MULTIPLY
3619 DCA FFMPY /TO MULTIPLY QUOT. OF DIV. BY
3620 JMP DVLP1 /LOW ORDER OF OPERAND (OPL)
3622 /END OF FLOATING DIVIDE-FUDGE SOME
3623 /STUFF THEN JUMP INTO MULTIPLY
3625 FDDON, TAD FFDIV /STORE RETN. ADDR. IN MULT ROUTINE
3627 JMP MDONE /GO CLEAN UP
3629 /DIVIDE ROUTINE--24 BITS IN ACH,ACL ARE DIVIDED BY 12 BITS
3630 /IN OPH. OPH IS ASSUMED NEGATIVE AND .GT. ACH IN ABSOLUTE VALUE
3631 /ELSE-DIVIDE OVERFLOW--WE RETURN NORMALLY WITH QUOTIENT
3632 /IN ACL AND REM. IN ACH. (AC2=0 ON RETN.)
3635 TAD ACH /CHECK THAT DIVISOR IS .GT. DIVIDEND
3636 TAD OPH /DIVISOR IN OPH (NEGATIVE)
3638 JMP I DVOVR /NO-DIVIDE OVERFLOW
3639 TAD KM13 /YES-SET UP 12 BIT LOOP
3641 JMP DV1 /GO BEGIN DIVIDE
3642 DV2, TAD ACH /CONTINUE SHIFT OF FAC LEFT
3644 DCA ACH /RESTORE HI ORDER
3645 TAD ACH /NOW SUBTRACT DIVISOR FROM HI ORDER
3648 DCA ACH /YES-RESTORE HI DIVIDEND
3649 CLA /NO-DON'T RESTORE--OPH.GT.ACH
3650 DV1, TAD ACL /SHIFT FAC LEFT 1 BIT-ALSO SHIFT
3651 RAL /1 BIT OF QUOT. INTO LOW ORD OF ACL
3653 ISZ AC2 /DONE 12 BITS OF QUOT?
3655 JMP I DV24 /YES-RETN W/AC2=0
3667 JMS I [PATCHF /WHICH MODE FO CALL?
3668 TAD I FFADD /CALLED BY USER-GET ADDR. OF OPR.
3669 JMS I ARGETP /PICK UP OPERAND
3670 FAD1, CDF /DF TO PACKAGE FIELD
3671 TAD OPH /IS OPERAND = 0
3674 TAD ACH /NO-IS FAC=0?
3676 JMP DOADD /YES-DO ADD
3677 TAD ACX /NO-DO EXPONENT CALCULATION
3680 SMA SZA /WHICH EXP. GREATER?
3681 JMP FACR /OPERANDS-SHIFT FAC
3682 CMA IAC /FAC'S-SHIFT OPERAND=DIFFRNCE+1
3684 JMS ACSR /SHIFT FAC ONE PLACE RIGHT
3685 DOADD, TAD OPX /SET EXPONENT OF RESULT
3687 JMS OADD /DO THE ADDITION
3688 JMS I FNORP /NORMALIZE RESULT
3689 DONA, ISZ FFADD /BUMP RETURN
3691 FACR, JMS ACSR /SHIFT FAC = DIFF.+1
3692 JMS OPSR /SHIFT OPR. 1 PLACE
3693 JMP DOADD /DO ADDITION
3695 /OPERAND SHIFT RIGHT-ENTER WITH POSITIVE COUNT-1
3698 CMA /- (COUNT+1) TO SHIFT COUNTER
3700 LOP2, TAD OPH /GET SIGN BIT
3703 TAD OPH /GET HI MANTISSA
3704 RAR /SHIFT IT RIGHT, PROPAGATING SIGN
3708 DCA OPL /STORE LO ORDER BACK
3709 RAR /SAVE 1 BIT OF OVERFLOW
3711 ISZ OPX /INCREMENT EXPONENT
3713 ISZ AC0 /DONE ALL SHIFTS?
3715 JMP I OPSR /YES-RETN.
3717 /SHIFT FAC LEFT 1 BIT
3720 TAD AC1 /GET OVERFLOW BIT
3723 TAD ACL /GET LOW ORDER MANTISSA
3726 TAD ACH /GET HI ORDER
3731 /SHIFT FAC RIGHT-ENTER WITH COUNT-1 IN AC (POSITIVE)
3734 CMA /AC CONTAINS COUNT-1
3735 DCA AC0 /STORE COUNT
3736 LOP1, TAD ACH /GET SIGN BIT OF MANTISSA
3737 RAL /SET UP SIGN PROPAGATION
3739 TAD ACH /GET HIGH ORDER MANTISSA
3740 RAR /SHIFT RIGHT`1, PROPAGATING SIGN
3742 TAD ACL /GET LOW ORDER
3746 DCA AC1 /SAVE 1 BIT OF OVERFLOW
3747 ISZ ACX /INCREMENT EXPONENT
3751 JMP I ACSR /YES-RETN-AC=L=0
3753 /DIVIDE OVERFLOW-ZERO ACX,ACH,ACL
3755 DBAD, CLA CLL /NECESSARY SO WE DON'T GET OVRFLO AGAIN
3756 JMP I DBAD1P /GO ZERO ALL
3761 JMS I [PATCHF /WHICH MODE OF CALL?
3762 TAD I FFSUB /CALLED BY USER-GET ADDR. OF OP
3763 JMS I ARGETP /PICK UO THE OP.
3764 JMS OPNEG /NEGATE OPERAND
3765 TAD FFSUB /JMP INTO FLTG. ADD
3766 SUB0, DCA FFADD /AFTER SETTING UP RETURN
3773 FFNEG, 0 /(USED AS A TEM. BY OUTPUT ROUTINE)
3774 TAD ACL /GET LOW ORDER FAC
3775 CLL CMA IAC /NEGATE IT
3777 CML RAL /ADJUST OVERFLOW BIT AND
3778 TAD ACH /PROPAGATE CARRY-GET HI ORD
3779 CLL CMA IAC /NEGATE IT
3786 TAD OPL /GET LOW ORDER
3787 CLL CMA IAC /NEGATE AND STORE BACK
3789 CML RAL /PROPAGATE CARRY
3790 TAD OPH /GET HI ORDER
3791 CLL CMA IAC /NEGATE AND STORE BACK
3799 TAD AC2 /ADD OVERFLOW WORDS
3803 TAD OPL /ADD LOW ORDER MANTISSAS
3807 TAD OPH /ADD HI ORDER MANTISSAS
3815 /EAE FLOATING POINT PACKAGE
3816 /FOR PDP8/E WITH KE8-E EAE
3820 /DEFINITIONS OF EAE INSTRUCTIONS
3846 /FLOATING POINT INPUT ROUTINE
3851 DCA PRSW /INITIALIZE PERIOD SWITCH TO -1
3852 CMA /SET SIGN SWITCH TO -1
3854 CDF /CHANGE TO DF OF PACKAGE
3855 DCA DSWIT /ZERO CONVERSION SWITCH
3856 DECONV, DCA ACX /ZERO OUT THE FAC!
3859 DECNV, DCA DNUMBR /ZERO # OF DIGITS SINCE DEC. PT.
3860 DECON, JMS GCHR /GET A CHAR.FROM TTY.
3861 JMP FFIN1 /TERMINATOR-
3862 ISZ DSWIT /DIGIT-BUMP CONVERSION SWITCH
3863 ISZ DNUMBR /BUMP # OF DIGITS
3864 DCA TP1 /STORE IT IN FORM EASILY FLOATIBLE
3865 JMS I FMPYLL /MULTIPLY # BY 10
3867 JMS I [FFPUT /STORE IT AWAY
3869 JMS I [FFGET /GET NEW DIGIT
3871 JMS I [FFNOR /FLOAT IT
3872 JMS I FADDLL /ADD IT TO THE ACCUMULATED #
3875 FFIN1, ISZ PRSW /HAVE WE HAD A PERIOD YET?
3876 JMP FIGO2 /YES-GO ON
3877 TAD K2 /NO-IS THIS A PERIOD?
3879 JMP DECNV /YES-ZERO DIG. COUNT AFTER DEC. PT.
3880 /AND GO CONVERT REST
3881 DCA DNUMBR /NO-TERMINATOR-ZERO COUNT OF
3882 /DIGITS AFTER DECIMAL POINT.
3883 FIGO2, CLA MQL /0 TO MQ FOR LATER MULTIPLY
3884 ISZ SIGNF /IS # NEGATIVE?(DID WE GET - SIGN?)
3885 JMS I FFNEGP /YES-NEGATE IT
3887 CMA /RESET SIGN SWITCH FOR EXP.
3889 TAD CHAR /NO-WAS THE TERMINATOR AN 'E'?
3892 GETE, JMS GCHR /YES-GET A CHAR. OF EXPONENT
3893 JMP EDON /END OF EXPONENT
3894 MUY /GOT DIGIT OF EXP-MULT ACCUMULATED
3895 K12 /EXPONENT BY TEN AND ADD DIGIT
3897 \fEDON, ISZ SIGNF /WAS EXPONENT NEGATIVE?
3899 CLA CLL /CLEAR AC AND LINK
3900 TAD DNUMBR /GET # TIMES TO DIV MANTISSA BY TEN
3901 SAM /SUBTRACT FROM EXPONENT
3903 SPA /RESULT POSITIVE?
3904 CLL CMA CML IAC /NO-MAKE POS. AND SET LINK
3905 CMA /NEGATE FOR COUNTER
3906 DCA DNUMBR /AND STORE
3907 RAL /LINK=1-DIV;=0-MUL. # BY TEN
3908 TAD MDV /FORM CORRECT INSTRUCTION
3909 DCA FINST /AND STORE FOR EXECUTION
3910 FCNT, ISZ DNUMBR /DONE ALL OPERATIONS?
3912 JMP I FFIN /YES-RETURN
3913 FINST, 0 /NO- MUL OR DIV. MANTISSA
3922 MDV, JMS I .+1 /THESE 3 WDS. MUST BE IN THIS ORDER
3924 FFDIV /!!!!!!!!!!!!!!!!!
3934 \f/ROUTINE TO GET A CHAR FROM THE TTY AND SEE IF IT IS DIGIT
3936 /RETURN TO CALL + 1 IF TERMINATOR, TO CALL + 2 IF DIGIT
3937 /THIS ROUTINE MUST NOT MODIFY THE MQ!!
3939 JMS INPUT /GET A CHAR FROM TTY.
3940 TAD CHAR /PICK IT UP
3941 TAD PLUS /WAS IT PLUS SIGN?
3943 JMP DECON1 /YES-GET ANOTHER CHAR.
3944 TAD MINUS /NO WAS IT MINUS SIGN?
3947 DCA SIGNF /YES-FLIP SWITCH
3948 DECON1, JMS INPUT /GET A CHAR.
3950 TAD K7506 /SEE IF ITS A DIGIT
3954 ISZ GCHR /YES-RETN. TO CALL+2
3955 JMP I GCHR /NO-RETN. TO CALL+1
3961 /INPUT ROUTINE-IGNORES LEADING SPACES
3964 JMS I IGETCH /USE OUR ROUTINE TO GET CHAR
3965 TAD DSWIT /GET TERMINATOR
3966 SZA CLA /VALID INPUT YET?
3967 JMP IOUT /YES-CONTINUE
3968 TAD CHAR /NO-GET CHAR
3969 TAD M240 /COMPARE AGAINST SPACE
3971 TAD (240-212 /IS IT AN LF?
3972 SNA CLA /IS IT A SPACE OR LF?
3973 JMP INPUT+1 /YES-IGNORE IT
3974 IOUT, JMP I INPUT /RETURN
3976 IGETCH, GETCH /ALTERED BY VAL FUNCITON TO PICK FROM SAC
3978 /ROUTINE TO DECIDE CALLING MODE IN LIEU OF "SPECIAL MODE" PROBLEMS
3982 JMP RTN2 /NO-THIS IS ALWAYS SI MODE WITH ADDR IN AC
3983 TAD FF /YES-GET SPECIAL MODE FLIP-FLOP
3984 SZA CLA /IF ON,THE ZERO AC MEANS ADDRESS OF 0
3985 RTN2, ISZ PATCHF /USE AC AS ADDRESS OF OPERAND
3986 JMP I PATCHF /RETURN
3990 /FLOATING SUBTRACT-USES FLOATING ADD
3993 JMS I [PATCHF /WHICH MODE?
3994 TAD I FFSUB1 /CALLED BY USER-GET ADDR. OF OP
3995 JMS I ARGETL /PICK UP ARGUMENT
3997 JMS I FFNEGA /NEGATE FAC!
4010 JMS I [PATCHF /WHICH MODE OF CALL?
4011 TAD I FFDIV1 /CALLED BY USER-GET ADDR.
4012 JMS I ARGETL /(INTERP.)-GET OPRND.-ADDR. IN AC
4013 CDF /CDF TO FIELD OF PACKAGE
4014 TAD ACH /SWAP FAC AND OPRND-OPH IN MQ!
4015 DCA OPH /STORE ACH IN OPH
4016 TAD ACX /GET EXP OF FAC
4017 SWP /OPH TO AC, ACX TO MQ
4018 DCA ACH /STORE OPH IN ACH
4019 TAD OPX /STORE OPX IN ACX
4021 TAD OPL /OPL TO MQ, ACX TO AC
4023 DCA OPX /STORE ACX IN OPX
4025 DCA OPL /STORE ACL IN OPL
4026 TAD OPH /OPH TO MQ FOR LATER
4028 DCA ACL /STORE OPL IN ACL
4029 TAD FFDIV1 /SET UP SO WE RETN TO
4030 DCA I FFDP /NORMAL DIVIDE ROUTINE
4033 JMP I MD1P /GO ARRANGE OPERANDS
4042 /PATCH TO EAE ADD ROUTINE
4060 SNA CLA /OPERAND ZERO
4075 /FLOATING MULTIPLY--DOES 4 SINGLE MULTIPLIES WITH EAE
4076 /THIS USES THE FACT THAT IF AC IS NON-ZERO WHEN YOU DO
4077 /A MUY INSTR, THE AC IS ADDED TO RESULT OF THE MULTIPLY.
4078 /(IN THE LOW ORDER, NATCHERLY)
4081 JMS I [PATCHF /WHICH MODE?
4082 TAD I FFMPY /CALLED BY USER-GET ADDRESS
4083 JMS MDSET /SET UP FOR MULT
4084 CLA MUY /MULTIPLY-LOW ORDER FAC STILL IN MQ
4085 OPH /THIS IS PRODUCT OF LOW ORDERS
4086 MQL /ZAP LOW ORDER RESULT-INSIGNIFICANT
4087 TAD ACH /GET LOW ORDER(!) OF FAC
4088 SWP MUY /TO MQ-HIGH ORD. RESLT OF LAST MPY
4089 OPL /TO AC-WILL BE ADDED TO RESLT-THIS
4090 DST /IS PRODUCT-LOW ORD FAC,HI ORD OP
4092 DLD /HIGH ORDER FAC TO MQ, OPX TO AC
4094 TAD ACX /ADD FAC EXPONENT-GET SUM OF EXPS.
4095 DCA ACX /STORE RESULT
4096 MUY /MUL. HIGH ORDER FAC BY LOW ORD OP.
4097 OPH /HIGH ORDER FAC WAS IN MQ
4098 DAD /ADD IN RESULT OF SECOND MULTIPLY
4100 DCA ACH /STORE HIGH ORDER RESULT
4101 TAD ACL /GET HIGH ORDER FAC
4102 SWP /SEND IT TO MQ AND LOW ORD. RESULT
4103 DCA AC0 /OF ADD TO AC-STORE IT
4104 RAL /ROTATE CARRY TO AC
4106 MUY /NOW DO PRODUCT OF HIGH ORDERS
4107 OPL /FAC HIGH IN MQ, OP HIGH IN OPL
4108 DAD /ADD IN THE ACCUMULATED #
4111 JMP RTZRO /YES-GO ZERO EXPONENT
4112 NMI /NO-NORMALIZE (1 SHIFT AT MOST!)
4113 DCA ACH /STORE HIGH ORDER RESULT
4114 CLA SCA /GET STEP CNTR-DID WE NEED A SHIFT?
4116 JMP SNCK /NO-JUST CHECK SIGN
4117 CLA CMA /YES-MUST DECREASE EXP. BY 1
4119 RTZRO, DCA ACX /STORE BACK
4122 SPA CLA /IS HIGH ORDER OF OVERFLO WD. 1?
4123 DPIC /YES-ADD 1 TO LOW ORDER-STILL IN MQ
4124 SNCK, ISZ MSIGN /RESULT NEGATIVE?
4126 TAD ACH /YES-GET HIGH ORDER BACK
4127 DCM /LOW ORDER STILL IN MQ-NEGATE
4128 DCA ACH /STORE HIGH ORDER BACK
4129 MPOS, SWP /LOW ORDER TO AC
4131 ISZ FFMPY /BUMP RETURN
4138 /ROUTINE TO SET UP FOR MULTIPLY AND DIVIDE
4141 JMS I ARGETK /GET OPERAND (ADDR. IN AC)
4142 CDF /CHANGE TO DATA FIELD OF PACKAGE
4143 MD1, CLA CLL CMA RAL /MAKE A MINUS TWO
4144 DCA MSIGN /AND STORE IN MSIGN.
4145 TAD OPL /GET LOW ORDER MANTISSA OF OP.
4146 SWP /GET INTO RIGHT ORDER ( OPH IN MQ)
4150 ISZ MSIGN /BUMP SIGN COUNTER
4151 SHL /SHIFT OPRND LEFT 1 TO AVOID OVRFLO
4153 DST /STORE BACK-OPH CONTAINS LOW ORDER
4154 OPH / OPL CONTAINS HIGH ORDER
4155 DLD /GET THE MANTISSA OF THE FAC
4157 SWP /MAKE IT CORRECT ORDER
4161 ISZ MSIGN /BUMP SIGN COUNTER (MAY SKIP)
4163 FPOS, DST /STORE BACK-ACH CONTAINS LOW ORDER
4164 ACH / ACL CONTAINS HIGH ORDER
4174 JMS I [PATCHF /WHICH MODE?
4175 TAD I FFDIV /CALLED BY USER-GET ARG. ADDRESS
4176 JMS MDSET /GET ARG. AND SET UP SIGNS
4177 FFD1, DVI /DIVIDE-ACH AND ACL IN AC,MQ
4178 OPL /THIS IS HI (!) ORDER DIVISOR
4179 DST /QUOT TO AC0,REM TO AC1
4181 SZL CLA /DIVIDE ERROR?
4182 JMP I DVOFL /YES-HANDLE IT
4183 TAD OPX /DO EXPONENT CALCULATION
4184 CMA IAC /EXP. OF FAC - EXP. OF OP
4189 DCA ACX /YES-ZERO EXPONENT
4190 DVLP, MUY /NO-THIS IS Q*OPL*2**-12
4193 TAD AC1 /SEE IF GREATER THAN REMAINDER
4195 JMP I DVOPSP /YES-ADJUST FIRST DIVIDE
4196 DVI /NO-DO Q*OPL*2**-12/OPH
4200 DVLP1, TAD AC0 /NO-GET QUOT OF FIRST DIV.
4202 JMP .+5 /NO-REMEMBER-QUOT OF 2ND DIV. IN MQ
4203 LSR /YES-MUST SHIFT IT RIGHT 1
4205 ISZ ACX /ADJUST EXPONENT
4207 ISZ MSIGN /SHOULD SIGN BE MINUS?
4210 DBAD1, DCA ACH /STORE IT BACK
4214 JMP I FFDIV /BUMP RETN. AND RETN.
4218 DCA ACX /ZERO EXPONENT
4219 JMP DBAD1 /GO ZERO MANTISSA
4220 \f/FLOATING ADDITION-IN ORDER NOT TO LOSE BITS, WE DO NOT
4221 /SHIFT BOTH NUMBERS RIGHT 1 BIT BEFORE ADD-ONLY SHIFTS DONE
4222 /ARE TO ALIGN EXPONENTS.
4226 JMS I [PATCHF /WHICH MODE OF CALLING
4227 TAD I FFADD /CALLED DIRECTLY BY USER
4228 JMS I ARGETP /PICK UP ARGUMENTS
4229 JMP I PATCHK /CHECK FOR ADDITION BY ZERO
4230 FAD1, TAD OPX /PICK UP EXPONENT OF OPERAND
4231 MQL /SEND IT TO MQ FOR SUBTRACT
4232 TAD ACX /GET EXPONENT OF FAC
4233 SAM /SUBTRACT-RESULT IN AC
4234 SPA /NEGATIVE RESULT?
4235 CMA IAC /YES-MAKE IT POSITIVE
4236 DCA CNT /STORE IT AS A SHIFT COUNT
4237 TAD CNT /COUNT TOO BIG?(CAN'T BE ALIGNED)
4241 DCA AC0 /YES-MAKE IT A LOAD OF LARGEST #
4242 DLD /GET ADDRESSES TO SEE WHO'S SHIFTED
4244 SGT /WHICH EXP GREATER(GT FLG SET
4245 /BY SUBTR. OF EXPS.)
4246 SWP /OPERAND'S-SHIFT THE FAC
4247 DCA SHFBG /STORE ADDRESS OF WHO GETS SHIFTED
4248 SWP /GET ADDRESS OF OTHER (0 TO MQ)
4249 DCA DADR /THIS ONE JUST GETS ADDED
4250 SGT /WHICH EXPONENT WAS GREATER?
4251 JMP .+3 /FAC'S - DO NOTHING
4252 TAD OPX /OPERAND'S-PUT FINAL EXP. IN ACX
4254 DLD /GET THE LARGER # TO AC,MQ
4256 SWP /PUT IN THE RIGHT ORDER
4257 ISZ AC0 /COULD EXPONENTS BE ALIGNED?
4258 JMP LOD /NO-JUST LEAVE LARGER IN AC,MQ
4259 DST /YES-STORE THIS TEMPORARILY
4260 AC0 /(IF ONLY FAC STORAGE WAS REVERSED)
4261 DLD /GET THE SMALLER #
4263 SWP /PUT IT IN RIGHT ORDER
4264 ASR /DO THE ALIGNMENT SHIFT
4266 \f DAD /ADD THE LARGER #
4270 SZL /OVERFLOW?(L NOT = SIGN BIT)
4271 CMA /NOTE-WE DIDN'T SHIFT BOTH RIGHT 1
4274 CLA CLL CML RAR /MAYBE-SEE IF 2 #S HAD SAME SIGN
4277 SMA CLA /SIGNS ALIKE?
4278 JMP OVRFLO /YES-OVERFLOW
4279 NOOV, JMS I ADDPCL /JUMP TO PATCH FOR THIS ROUTINE
4280 LOD, NMI /NORMALIZE (LOW ORDER STILL IN MQ)
4281 DCA ACH /STORE FINAL RESULT
4282 SWP /GET AND STORE LOW ORDER
4284 SCA /GET SHIFT COUNTER(# OF NMI SHIFTS)
4286 TAD ACX /AND ADJUST FINAL EXPONENT
4288 ADON, ISZ FFADD /BUMP RETURN PAST ADDRESS
4290 OVRFLO, TAD AC1 /OVERFLOW-GET HIGH ORDER RESLT BACK
4291 ASR /SHIFT IT RIGHT 1
4293 TAD KK4000 /REVERSE SIGN BIT
4296 DCA ACL /STORE LOW ORDER
4297 ISZ ACX /BUMP EXPONENT
4305 /FLOATING SUBTRACT-USES FLOATING ADD
4308 JMS I [PATCHF /WHICH MODE?
4309 TAD I FFSUB /CALLED BY USER-GET ADDRESS OF OP.
4312 TAD OPL /OPH IS IN MQ!
4313 SWP /PUT IT IN RIGHT ORDER
4318 TAD FFSUB /GO TO ADD
4322 /FLOATING NEGATE--NEGATE FLOATING AC
4325 SWAB /MUST BE MODE B
4328 SWP /CORRECT ORDER PLEASE!
4337 /CONTINUATION OF DIVIDE ROUTINE
4338 /WE ARE ADJUSTING THE RESULT OF THE
4342 DCA AC1 /ADJUST REMAINDER
4343 TAD OPL /WATCH FOR OVERFLOW
4347 JMP DVOP1 /DON'T ADJUST QUOT.
4351 DCA AC0 /REDUCE QUOT BY 1
4353 TAD AC1 /GET REMAINDER
4355 CAM /YES-ZERO EVERYTHING
4358 SZL CLA /DIV. OVERFLOW?
4360 DCM /NO-ADJUST HI QUOT (MAYBE)
4361 JMP I DVLP1P /GO BACK
4368 /ARGUMENT PICK UP ROUTINE-ENTER WITH DATA FIELD SET TO EITHER
4369 /FLTG. DATA FIELD OR FLTG. INSTR. FIELD.
4370 /ADDRESS OF OPERAND IS IN THE AC ON ENTRY.
4371 /ON RETURN, THE`AC IS CLEAR
4374 DCA AC2 /STORE ADDRESS OF OPERAND
4375 TAD I AC2 /PICK UP EXPONENT
4377 JMS ISZAC2 /MOVE POINTER TO HORD,WATCH FOR FIELD OVERLAP
4378 TAD I AC2 /PICK IT UP
4385 SWAB /OPH INTO MQ BECAUSE EAE ROUTINES
4386 MQA /EXPECT TO FIND IT THERE
4389 JMS ISZAC2 /MOVE POINTER TO LORD,WATCHING FOR OVERLAP
4390 TAD I AC2 /PICK IT UP
4395 /ROUTINE TO NORMALIZE THE FAC
4398 TAD ACH /GET THE HI ORDER MANTISSA
4400 TAD ACL /YES-HOW ABOUT LOW?
4402 TAD AC1 /LOW=0, IS OVRFLO BIT ON?
4404 JMP ZEXP /#=0-ZERO EXPONENT
4405 NORMLP, AC2000 /NOT 0-MAKE A 2000 IN AC
4406 TAD ACH /ADD HI ORDER MANTISSA
4407 SZA /HI ORDER = 6000
4408 JMP .+3 /NO-CHECK LEFT MOST DIGIT
4409 TAD ACL /YES-6000 OK IF LOW=0
4411 SPA CLA /2,3,4,5,ARE LEGAL LEFT MOST DIGS.
4412 JMP FFNORR /FOR NORMALIZED #-(+2000=4,5,6,7)
4413 JMP FNLP /JUMP SO FFGET AND PUT ARE ORGED RIGHT
4415 FFNORR, DCA AC1 /DONE W/NORMALIZE-CLEAR AC1
4422 /ROUTINE TO NORMALIZE THE FAC
4426 CDF /CHANGE D.F. TO FIELD OF PACKAGE
4428 DLD /PICK UP MANTISSA
4430 SWP /PUT IT IN CORRECT ORDER
4433 DCA ACX /YES-INSURE ZERO EXPONENT
4434 DCA ACH /STORE HIGH ORDER BACK
4435 SWP /STORE LOW ORDER BACK
4437 CLA SCA /STEP COUNTER TO AC
4439 TAD ACX /AND ADJUST EXPONENT
4447 JMS I [PATCHF /WHICH MODE OF CALL
4448 TAD I FFGET /CALLED BY USER-GET ADDR. OF OP
4449 JMS ARGET /PICK UP OPERAND
4451 DCA ACX /LOAD THE OPERAND INTO FAC
4458 JMP I FFGET /RETN. TO CALL +2
4463 JMS I [PATCHF /WHICH MODE OF CALL?
4464 TAD I FFPUT /CALLED BY USER-GET OPR. ADDR
4465 DCA FFGET /STORE IN A TEMP
4466 TAD ACX /GET FAC AND STORE IT
4467 DCA I FFGET /AT SPECIFIED ADDRESS
4468 JMS ISZFGT /BUMP POINTER,WATCHING FOR FIELD OVERLAP
4474 ISZ FFPUT /BUMP RETN.
4476 JMP I FFPUT /RETN. TO CALL+2
4478 /ROUTINES TO BUMP ARGET AND FPUT POINTERS AND INCREMENT THE
4479 /DATA FIELD IF THE POINTER CROSSES A FIELD BOUNDARY
4482 ISZ FFGET /BUMP POINTER
4483 JMP I ISZFGT /NO SKIP MEANS JUST RETURN
4484 SKP /SKIP MEANS WE HAVE TO INCREMENT DATA FIELD
4485 NEWCDF, DCA ISZFGT /THIS INST EXECUTED ONLY BY ISZAC2
4486 RDF /GET THE DATA FIELD
4487 TAD CDF10 /BUMP BY 1 AND MAKE A CDF
4488 DCA .+1 /PUT IN LINE
4490 JMP I ISZFGT /RETURN
4495 ISZ AC2 /BUMP POINTER
4496 JMP I ISZAC2 /NOTHING HAPPENED
4497 TAD ISZAC2 /NEED NEW DF. GET RETURN ADDR
4498 JMP NEWCDF /AND BUMP DF
4501 /ROUTINE TO ADJUST QUOTINET OF FIRST DIVIDE (MAYBE) WHEN THE
4502 /REMAINDER OF THE FIRST`DIVIDE IS LESS THAN QUOT*OPL
4503 /USED BY FLTG. DIVIDE ROUTINE
4505 DVOPS, CMA IAC /NEGATE AND STORE REVISED REMAINDER
4509 TAD ACH /WATCH FOR OVERFLOW
4511 JMP DVOP1 /OVERFLOW-DON'T ADJUST QUOT. OF 1ST DIV.
4512 DCA ACH /NO OVERFLOW-STORE NEW REM.
4513 CMA /SUBTRACT 1 FROM QUOT OF
4514 TAD AC1 /FIRST DIVIDE
4517 TAD ACH /GET HI ORD OF REMAINDER
4521 FNLP, CLL CML CMA /-1
4522 TAD ACX /SUBTR. 1 FROM EXPONENT
4524 JMS I AL1P /SHIFT FAC LEFT 1
4525 JMP NORMLP /GO BACK AND SEE IF NORMALIZED
4530 /FSQUARE-SQUARE FAC-CALLS MULTIPLY TO MUL. FAC BY ITSELF
4535 JMS I TMPY /CALL MULTIPLY TO MULTIPLY
4541 O0, JMS I [ERROR /OVERFLOW
4542 DV, JMS I [ERROR /DIVISION ERROR
4543 JMS I [FACCLR /RETURN 0 IN FAC
4545 LM, JMS I [ERROR /ILLEGAL ARGUMENT
4552 /TELETYPE "DRIVER"-WHEN CALLED,GRABS CHARACTERS FROM THE
4553 /TELETYPE UNTIL A CR IS SENT OR THE BUFFER IS FULL. ASSUMES TTY ENTRY
4554 /IS IN I/O WORK AREA.
4559 LFLUSH, JMS I [CRLFR /PRINT A CR,LF
4560 TAD K277 /PRINT A ? SIGNIFYING WAIT FOR INPUT
4562 TAD I IOTBUF /BUFFER ADDRESS
4563 DCA I IOTPTR /INITIALIZE POINTER TO START OF BUFFER
4564 JMS I [CNOCLR /INITIALIZE CHAR # TO 1
4565 TTYIN, JMS I [XPRINT /EMPTY TTY BUFFER BEFORE AWAITING INPUT
4567 TAD I (HEIGHT /ALWAYS RESET SCREEN HIEGHT ON INPUT
4569 TAD K5252 /DESIGN INTO AC
4570 KSFA, KSF /CHAR READY?
4571 JMP SPIN /NO-DIDDLE WHILE WE WAIT
4572 CLA CLL /FLUSH SPINNER OUT OF AC
4573 TAD [200 /FORCE PARITY BIT
4577 JMS I [XPUTCH /ECHO IT
4578 KCC /CLEAR KEYBOARD FLAG AND SET READER RUN
4580 TAD MCTRLU /IS IT CTRL/U?
4582 JMP LFLUSH /YES-START AGAIN
4584 TAD CRUBOT /IS IT RUBOUT?
4586 JMP BACKUP /YES-BACK UP BUFFER POINTER
4587 TAD MCR /NO-IS IT CR?
4591 JMS I [PACKCH /PACK CHAR IN BUFFER
4592 JMS I [BUFCHK /BUFFER FULL?
4595 NOP /NO-2 AND 3 LEFT
4596 JMP TTYIN /NO-NEXT CHAR
4603 BACKUP, TAD I IOTPTR /BUFFER POINTER
4605 TAD I IOTBUF /COMPARE AGAINST START OF BUFFER
4606 SNA CLA /BUFFER EMPTY?
4607 JMP TTYIN /YES-THERE IS NOTHING TO RUBOUT
4608 TAD SCOPFG /TEST IF CONSOLE IS A SCOPE
4610 JMP NOSCOP /JMP IF NOT
4612 JMS I [XPUTCH /PRINT BS,SP,BS TO RUBOUT IF SCOPE
4618 JMS I [XPUTCH /ECHO "\"
4619 JMS I [CHARNO /GET CHAR # OF NEXT CHAR (LAST #+1)
4622 JMS I [CNOCLR /IT WAS 2-MAKE IT 1
4624 TAD I IOTPTR /BACK UP BUFFER POINTER
4626 JMP TTYIN /NEXT CHAR
4631 TAD [200 /IT WAS 1-MAKE IT 3
4633 JMP TTYIN /NO NEED TO BACK UP POINTER
4637 TAD [100 /IT WAS 3,MAKE IT 2
4639 JMP PBACK /BACK UP POINTER
4642 CR, JMS I [CRLFR /ECHO A CR,LF
4644 TAD TTYDRI /BUMP DRIVE RETURN TO NORMAL
4647 JMS I [PACKCH /PACK CHAR IN BUFFER
4649 DCA I IOTPTR /INITAILZE BUFFER POINTERS
4651 JMP I TTYDRI /RETURN
4655 SPIN, ISZ SPINNR /SPIN RANDOM # SEED
4657 CMA CML RAL /MARCH TO THE LEFT
4658 JMP KSFA /CHECK FOR CHAR YET
4659 SCOPFG, 0 /GETS SET TO SCOPE FLAG BY STARTUP CODE
4660 \f/SUBROUTINE FBITGT-ROUTINE TO PUT FUNCTION BITS FROM INSTRUCTION INTO AC
4665 RTR /PUT FUNCTION BITS IN BITS 8-11
4666 AND [17 /MASK THEM OFF
4667 JMP I FBITGT /RETURN
4669 /DATA LIST READ (NUMERIC)
4671 RDLIST, JMS I (DLREAD /FETCH WORD FROM LIST
4672 DCA ACX /STORE AS EXPONENT
4674 DCA ACH /HIGH MANTISSA
4676 DCA ACL /LOW MANTISSA
4679 /SUBROUTINE FTYPE-RETURNS TO CALL+1 IF FILE NUMERIC,CALL+2 IF ASCII
4682 TAD I IOTHDR /GET HEADER
4683 CLL RAR /TYPE TO LINK
4684 SZL CLA /IS IT NUMERIC?
4685 ISZ FTYPE /NO-BUMP RETURN
4689 \f/LAST PAGE OF BRTS-CONTAINS SAC,I/O TABLE, AND SOME MISCELLANEOUS CODE
4691 /TELETYPE INPUT BUFFER (74. CHARACTERS LONG)
4692 /THIS BUFFER CONTAINS ONCE ONLY START CODE WHEN LOADED
4695 START4, TAD CDFPS /DF FOR BOTTOM OF PSEUDO-CODE
4696 TAD MCDF1 /COMPARE TO A CDF 10
4697 SZA CLA /DO THEY MATCH?
4698 JMP I [ILOOP /NO-ALL BUFFERS ARE FREE-START INTERPRETER
4702 SNL CLA /IS START OF PSEUDO-CODE BELOW 400
4703 JMP CHKB2 /NO-CHECK FOR 1000
4704 TAD [17 /YES-SET ALL BUFFERS BUSY
4709 SNL CLA /IS START OF PSEUDO-CODE BELOW 1000
4710 JMP CHKB3 /NO-CHECK 1400
4711 TAD C16 /YES-ONLY BUFFER 1 IS AVAILABLE
4716 SNL CLA /IS START OF CODE BELOW 1400?
4717 JMP CHKB4 /YES-CHECK 2000
4718 TAD C14 /YES-ONLY BUFFER 1 AND 2 AVAILABLE
4723 SNL CLA /IS CODE START BELOW 2000?
4724 JMP I [ILOOP /NO-START INTERPRETER-ALL BUFFER FREE
4725 TAD [10 /YES-BUFFERS 1,2, AND 3 AVAILABLE
4727 JMP I [ILOOP /START INTERPRETER
4739 ////////////////////////////////////////////////////////////////
4740 /////// I/O TABLE 5 13-WORD ENTRIES ////////////////////////////
4741 ////////////////////////////////////////////////////////////////
4743 TTYF, 1 /TELETYPE ENTRY-FILE IS ASCII
4744 TTYBUF /BUFFER ADDRESS
4745 0 /CURRENT BLOCK IN BUFFER
4746 TTYBUF /READ WRITE POINTER
4747 TTYDRI /HANDLER ENTRY
4749 FILE1, ZBLOCK 15 /FILE #1
4750 FILE2, ZBLOCK 15 /FILE #2
4751 FILE3, ZBLOCK 15 /FILE #3
4752 FILE4, ZBLOCK 15 /FILE #4
4755 \f /CROSS FIELD LITERAL EQUATES
4783 \f/////////////////////////////////////////////////////////////
4784 /////////////////////////////////////////////////////////////
4785 ////////////// OVERLAY 2- STRING FUNCTIONS /////////////////
4786 /////////////////////////////////////////////////////////////
4787 /////////////////////////////////////////////////////////////
4793 /VERSION NUMBER WORD FOR STRING OVERLAY
4795 VERSON^100+SUBVSF+6000
4798 /RETURNS 1 6BIT CHAR STRING FOR THE VALUE OF X
4800 CHR, JMS I PUNSFIX /FIX X TO 12 BIT INTEGER
4801 AND O77 /MASK TO 6BIT
4802 DCA I (SAC /AND PUT INTO SAC
4804 DCA SACLEN /SET SAC LENGTH TO 1
4805 JMP I (SSMODE /SET TO SMODE AND RETURN
4808 /RETURNS DECIMAL ASCII FOR 1 CHAR STRING IN FAC
4810 ASC, TAD I (SAC /GET FIRST CHAR OF STRING
4811 JMP FLOATS /FLOAT RESULT INTO FAC AND RETURN
4814 /RETURNS LENGTH OF SAC IN FAC
4816 LEN, TAD SACLEN /LENGTH OF STRING IN SAC
4819 /ROUTINE TO FLOAT FAC AND RETURN
4821 FLOATS, DCA ACH /NUMBER TO BE FLOATED IN HORD
4823 DCA TEMP2 /CLEAR FPP OVERFLOW
4824 TAD (13 /SET EXP TO 11
4826 JMS I PFFNOR /NORMALIZE
4827 JMP I PILOOP /RETURN
4832 /RETURNS ASCII STRING FOR NUMBER IN FAC
4834 STR, JMS I (FFOUT /GET NUMBER INTO INTERMEDIATE BUFFER FIRST
4839 TAD SACLEN /NOW SAVE COUNTER
4842 DCA XR1 /POINT AT BUFFER
4843 STRLUP, TAD I XR1 /GET A CHAR
4844 AND O77 /MASK TO 6BIT
4845 TAD (-40 /CROCK TO DELETE BLANKS
4848 ISZ SACLEN /IGNORE THE BLANK
4851 DCA I SACXR /STORE IN SAC
4853 JMP STRLUP /LOOP FOR MORE
4854 JMP I (SSMODE /DONE-RETURN IN SMODE
4857 /RETURNS NUMBER IN FAC FOR STRING IN SAC
4860 DCA VALCNT /COUNT OF CHARS TO INPUT
4861 TAD (VALGET /ADDR OF PHONY INPUT ROUTINE
4862 DCA I (IGETCH /PUT IN INPUT ROUTINE IN PLACE OF KRB
4863 JMS I (FFIN /CALL FPP INPUT ROUTINE
4864 TAD PGETCH /NOW RESTORE REAL INPUT ADDR
4865 DCA I (IGETCH /RESTORE IN INPUT ROUTINE
4869 TAD VALCNT /TEST NUMBER OF CHARS LEFT
4872 ISZ VALCNT /ELSE BUMP
4874 TAD I SACXR /GET A BYTE
4877 TAD (240 /CONVERT TO 8BIT
4881 JMP I VALGET /RETURN WITH CHAR IN 'CHAR'
4887 / RETURNS STRING OF THE FORM "MM/DD/YY" IN SAC IF DATE IS PRESENT
4888 / RETURNS NULL STRING OTHERWISE
4891 DATE, TAD CDFIO /COPY CDF TO FIELD 17600 IN LINE
4894 TAD PSFLAG /GET TD8E BIT TO LINK
4897 TAD I (MDATE /IF ZERO LOOK AT MDATE IN N7600
4899 TAD I (MDATE-200 /ELSE LOOK AT N7400
4900 DCA DATEWD /STORE (DATE IS NOT A CLOSED SUBROUTINE)
4901 CDF /DATE IS IN THE FORM MMM MDD DDD YYY
4902 TAD DATEWD /PICK UP DATE
4904 TAD (-10 /RETURN 8. BYTES IF NOT NULL DATE
4905 DCA SACLEN /SET SAC LENGTH
4906 TAD I (BIPCCL /NOW GET YEAR EXTENSION
4907 AND (600 /IT'S IN THE 600 BITS
4909 RTR /SHIFT INTO PLACE
4910 DCA YEAREX /HOLD YEAR EXTENSION
4911 TAD DATEWD /NOW ISOLATE MONTH
4916 JMS PUTN /PUT "MM/" INTO THE SAC
4917 TAD DATEWD /NOW GET DAY OF MONTH
4921 JMS PUTN /PUT "DD/" IN SAC
4922 TAD DATEWD /FINALLY GET YEAR
4924 TAD YEAREX /ADD TO EXTENSION BITS
4925 TAD (106 /ADD 70. FOR BASE YEAR
4926 JMS PUTN /PUT OUT "YY/" (EXTRA SLASH WILL BE IGNORED)
4927 JMP I (SSMODE /RETURN IN STRING MODE
4930 ISZ NHIGH /BUMP HIGH ORDER DIGIT
4933 JMP .-3 /LOOP IF NOT REDUCED YET
4934 TAD (12+60 /CONVERT TO DECIMAL DIGIT
4935 DCA NLOW /HOLD MOMENTARILY
4936 TAD NHIGH /NOW GET HI ORDER DIGIT
4939 TAD NLOW /SEND OUT LOW DIGIT
4942 DCA I SACXR /SEND OUT "/"
4943 DCA NHIGH /CLEAR NHIGH FOR NEXT TIME (BE CAREFULL!!)
4948 \f/TRACE FUNCTION PRINTER. WHEN TRACE IS ENABLED,THIS ROUTINE
4949 /PRINTS THE LINE # EACH TIME IT IS STORED
4951 TPRINT, JMS I (LMAKE /MAKE LINE # INTO FIVE DIGITS
4953 JMS I PXPUTCH /PRINT "%"
4955 JMS I PXPUTCH /PRINT A SPACE
4956 TAD (DIG1-1 /ADDR OF FIRST DIGIT-1
4958 IGS, TAD I XR5 /GET DIGIT OF LINE NUMBER
4961 TAD TCHR /COMPARE IT TO 0
4963 JMP IGS /YES-IGNORE LEADING ZEROES
4964 PREST, TAD TCHR /NO-GET CHAR AGAIN
4966 SNA CLA /IS IT A CR?
4967 JMP TDONE /YES-LINE NUMBER IS PRINTED
4968 TAD TCHR /NO-GET CHAR A THIRD TIME
4969 JMS I PXPUTCH /TYPE IT
4970 TAD I XR5 /GET NEXT CHAR
4974 JMS I PXPUTCH /FOLLOW LINE # WITH A SPACE
4976 JMS I PXPUTCH /TYPE ANOTHER "%"
4978 JMS I PXPUTCH /TYPE,CR,LF
4981 JMS I PXPRINT /EMPTY RING BUFFER OF TRACE NUMBER
4987 \f/TRACE FUNCTION-ROUTINE TO TURN TRACE ON AND OFF
4989 TRACE, TAD ACH /GET HI MANTISSA OF ARG
4990 SNA CLA /SKP TO TURN TRACE ON
4991 TAD TRREST /ELSE RESTORE TRACE BYPASS INSTR IN LINE NUMBER ROUTINE
4992 DCA I HOOKL /BY NOP ING INSTRUCTION AT TRHOOK
4993 TRREST, JMP I PILOOP
4999 ERRORR, JMS I PXPRINT /PURGE TTY RING BUFFER
5000 JMP .-1 /BEFORE PRINTING ERROR
5001 TAD ETABA /ADDR OF ERROR TABLE
5002 DCA XR4 /POINTS INTO ERROR TABLE
5003 FERRLP, TAD I XR4 /GET 2 CHAR ERROR CODE
5009 AND O77 /STRIP TO 6 BIT
5010 TAD K0300 /MAKE 8 BIT (LETTERS ONLY ALLOWED)
5011 DCA ESTRNG /PUT IN MESSAGE
5012 TAD TEMP1 /2 CHAR CODE AGAIN
5013 AND O77 /SECOND CHAR
5014 TAD K0300 /MAKE LETTER
5015 DCA ESTRNG+1 /PUT IN MESSAGE
5016 TAD I XR4 /GET ERROR CODE +1
5017 TAD I PERROR /COMPARE AGAINST RETURN ADDR
5019 JMP FERRLP /NO-TRY NEXT ONE
5020 JMS LMAKE /MAKE THE LINE # INTO DECIMAL DIGITS
5021 TAD ESTRA /ADDR OF MESSAGE
5023 ETLOP, TAD I XR5 /GET MESSAGE CHAR
5024 SPA /DONE? (MESSAGE ENDNS WITH - NUMBER
5025 JMP FATCHK /YES-DETERMINE ERROR TYPE
5026 JMS I PXPUTCH /NO-PUT CHAR IN RING BUFFER
5030 TAD MFATAL /-ADDR OF FATAL ERRORS
5031 TAD XR4 /ADDR OF THIS ERROR
5032 SMA CLA /FATAL ERROR?
5033 JMP I ERRETN /NO-NEXT INST
5034 JMP I STOPI /YES-TERMINATE RUN
5040 AND O17 /ISOLATE BCD DIGIT
5041 TAD K260 /MAKE ASCII DIGIT
5046 \f/SUBROUTINE LMAKE-MAKES THE CURRENT LINE NUMBER INTO FIVE DIGITS
5050 TAD LINEHI /YES:GET HI LINE #
5051 JMS MAKED /GET DIGIT 2
5052 DCA DIG2 /PUT IN MESSAGE
5056 JMS MAKED /GET DIGIT 1
5057 DCA DIG1 /AND PUT IN MESSAGE
5058 TAD LINELO /DOGOTS 3,4, AND 5
5059 JMS MAKED /GET DIGIT 5
5064 JMS MAKED /GET DIGIT 4
5065 DCA DIG4 /AND PUT IN MESSAGE
5070 JMS MAKED /GET DIGIT 3
5071 DCA DIG3 /MESSAGE NOW COMPLETE
5095 ESTRA, EMESS-1 /MINUS NUMBER TO END ABOVE MESSAGE
5096 \f/ERROR TABLE
/ENTRY FORMAT- 2 CHAR 6-BIT ERROR CODE (LETTERS ONLY)
5102 -FB-1 /ATTEMPT TO OPEN AN ALREADY OPEN FILE
5104 -GR-1 /RETURN WITHOUT A GOSUB
5106 -VR-1 /ATTEMPT TO READ VARIABLE LENGTH FILE
5108 -SU-1 /SUBSCRIPT ERROR
5110 -DE-1 /DEVICE DRIVER ERROR
5112 -OE-1 /DRIVER ERROR WHILE OVERLAYING
5114 -FM-1 /ATTEMPT TO FIX MINUS NUMBER
5116 -FO-1 /ATTEMPT TO FIX NUMBER >4095
5118 -FN-1 /ILLEGAL FILE #
5120 -SC-1 /ATTEMPT TO OVERFLOW SAC ON CONCATENATE
5122 -FI-1 /ATTEMPT TO CLOSE OR USE UNOPENED FILE
5124 -DA-1 /ATTEMPT TO READ PAST END OF DATA LIST
5126 -GS-1 /TOO MANY NESTED GOSUBS
5128 -SR-1 /ATTEMPT TO READ STRING FROM NUMERIC FILE
5130 -SW-1 /ATTEMPT TO WRITE STRING INTO NUMERIC FILE
5132 -PA-1 /ILLEGAL ARG IN POS
5134 -FC-1 /OS/8 ERROR WHILE CLOSING TENTATIVE FILE
5136 -CI-1 /INQUIRE FAILURE IN CHAIN
5138 -CL-1 /LOOKUP FAILURE IN CHAIN
5140 -IN-1 /INQUIRE FAILURE IN OPEN
5142 -DO-1 /NO MORE ROOM FOR DRIVERS
5144 -FE-1 /FETCH ERROR IN OPEN
5146 -BO-1 /NO MORE FILE BUFFERS AVAILABLE
5148 -EN-1 /ENTER ERROR IN OPEN
5150 -IF-1 /ILLEGAL DEV:FILENAME SPECIFICATION
5152 -SL-1 /STRING TOO LONG OR UNDEFINED
5154 -O0-1 /NUMERIC OR INPUT OVERFLOW
5156 -LM-1 /ATTEMPT TO TAKE LOG OF NEG # OR 0
5158 -EM-1 /ATTEMPT TO EXPONENTIATE A NEG NUMBER TO A REAL ROWER
5160 -IA-1 /ILLEGAL ARGUMENT IN USER FUNCTION
5162 -CX-1 /ILLEGAL FILENAME EXTENSION IN A CHAIN STATEMENT
5163 /***********************************************************
5164 EFATAL, /ERRORS BEFORE THIS LABEL ARE FATAL
5165 /*******************************************************
5167 -RE-1 /ATTEMPT TO READ PAST EOF
5169 -WE-1 /ATTEMPT TO WRITE PAST EOF
5171 -DV-1 /ATTEMPT TO DIVIDE BY 0
5173 -ST-1 /STRING TRUNCATION ON INPUT
5175 -IO-1 /TTY INPUT BUFFER OVERFLOW
5180 /RETURNS SEGMENT OF X$ BETWEEN Y AND Z
5181 /IF Y<=0,THEN Y TAKEN AS 1
5182 /IF Y>LEN(X$),NULL STRING RETURNED
5183 /IF Z<=0,NULL STRING RETURNED
5184 /IF Z>LEN(X$),Z IS SET=LEN(X$)
5185 /IF Z<Y,NULL STRING IS RETURNED
5188 DCA MODESW /RETURN IN STRING MODE
5191 JMS I PUNSFIX /FIX IF POSITIVE
5193 IAC /SET Y TO 1 IF Y.LE.0
5195 TAD SACLEN /COMPARE YARG TO SACLEN
5199 SNL SZA CLA /SKP IF YARG.LOS.LEN(X$)
5200 JMP NULLST /NO-RETURN THE NULL STRING
5201 DCA INSAV /FAKE POINTER TO SCALAR #0
5202 JMS I ARGPLK /GET ADDR OF Z
5203 JMS I PFFGET /LOAD Z INTO FAC
5204 ARGPLK, ARGPRE /LOC SKIPPED BY FPP SO WE PUT CONST HERE
5205 TAD ACH /HI MANTISSA OF Z
5206 SPA SNA CLA /IS Z<0?
5207 JMP NULLST /YES-RETURN THE NULL STRING
5208 JMS I PUNSFIX /NO-FIX Z
5210 TAD SACLEN /CALC Z-LEN(SAC)
5211 SNL /SKP IF Z.LO.LEN(SAC)
5212 CLA /ELSE TAKE LEN(SAC)
5215 TAD YARG /NUMBER OF BYTES TO USE
5217 JMP NULLST /NONE, RETURN NULL STRING
5219 TAD YARG /INDEX INTO STRING FOR SOURCE BYTES
5221 DCA XR2 /SET SOURCE XR
5223 DCA SACLEN /SET NEW LENGTH OF SAC NOW
5224 TAD I XR2 /NOW MOVE THE BYTES
5228 JMP I PILOOP /--RETURN--
5230 DCA SACLEN /ZERO SAC
5231 JMP I PILOOP /--RETURN--
5236 /RETURNS THE POSITION IN X$ OF Y$ STARTING AFTER Z
5239 DCA INSAV /FAKE AS STRING CALL TO STRING 0
5240 JMS I (STFIND /FIND Y$
5241 TAD STRCNT /# OF CHARS IN Y$
5242 SNA CLA /IS Y$ THE NULL STRING?
5243 JMP ONERET /YES-RETURN 1 AS POSITION
5244 TAD SACLEN /NO-# OF CHARS IN X$
5245 SNA CLA /IS X$ THE NULL STRING?
5246 JMP ZRORET /YES-RETURN 0
5247 TAD ACH /NO-GET HORD OF Z
5248 SPA SNA CLA /IS Z GT 0?
5249 PA, JMS I PERROR /NO-ILLEGAL ARGUMENT
5250 JMS I PUNSFIX /FIX Z
5251 DCA POSITN /USE IT AS POSITION TO START SEARCH
5254 TAD SACLEN /COMPARE POSITION TO MAXIMUM LENGTH OF STRING
5256 JMP PA /Z IS PAST END OF STRING-ERROR
5259 TAD POSITN /GET POSITION NOW CHECKING+SIZE IF Y$
5260 TAD SACLEN /COMPARE AGAINST LENGTH OF STRING
5261 SMA SZA CLA /ANY MORE TO COME?
5262 JMP ZRORET /NO-SEARCH FAILS
5263 JMS I (BYTSET /SETUP BYTE LOAD ROUTINE
5264 TAD POSITN /SEARCH START POSITION IN X$
5265 TAD (SAC-2 /ADD TO BASE OF SAC
5267 TAD STRCNT /# OF CHARS IN Y$
5271 TAD I SACXR /COMPARE CHARS
5272 SNA CLA /DO THEY MATCH?
5273 JMP SCONTU /YES-CONTINUE MATCH TO NEXT CHAR IN X$ AND Y$
5274 ISZ POSITN /BUMP POSITION TO BE CHECKED
5277 SCONTU, ISZ TEMP3 /MORE CHARS IN Y$?
5278 JMP SRCLP /YES, ITERATE
5279 TAD POSITN /NO FOUND A MATCH
5281 ZRORET, JMS I PFACCLR /SEARCH FAILS-RETURN 0
5285 JMP I (FLOATS /RETURN 1
5291 //////////////////////////////////////////////////
5292 //////////////////////////////////////////////////
5293 ///////// OVERLAY 3-FILE MANIPULATING ////////////
5294 ///////// FUNCTIONS ////////////
5295 //////////////////////////////////////////////////
5296 //////////////////////////////////////////////////
5300 /FILE CLOSING ROUTINE
5302 VERSON^100+SUBVFF+6000 /VERSION WORD FOR FILES OVERLAY
5305 ANDLST, 7776 /MASKS FOR CLEARING BUFFER AND HANDLER STATUS BITS
5310 CLOSE, TAD ENTNO /GET FILE #
5312 JMP I PILOOP /YES-DON'T DO ANYTHING
5313 JMS I PIDLE /SEE IF FILE OPEN
5314 JMS I PFTYPE /IS FILE NUMERIC?
5315 JMP NOCZ /YES-DON'T OUTPUT ^Z
5316 JMS I (FOTYPE /NO-IS FILE VARIABLE LENGTH?
5317 JMP NOCZ /NO-DON'T OUTPUT ^Z
5319 JMS I PPUTCH /WRITE A ^Z IN FILE
5320 NOCZ, JMS I (WRBLK /WRITE LAST BLOCK IF IT HAS CHANGED
5321 JMS I PPSWAP /RESTORE 17600
5322 JMS I (FOTYPE /IS FILE FIXED LENGTH?
5323 JMP CLOSED /YES-NO NEED TO CLOSE THE FILE
5324 TAD I IOTLEN /NO-GET FILE LENGTH
5325 DCA CLENG /PUT IN CLOSE CALL
5327 DCA FNAP /POINTER TO FILE NAME
5331 RAL /GET DEVICE NUMBER INTO BITS 8-11
5334 JMS I O7700 /CALL USR
5336 FNAP, . /POINTER TO FILE NAME
5338 FC, JMS I PERROR /FILE CLOSING ERROR
5339 CLOSED, TAD I IOTBUF /GET BUFFER ADDRESS
5341 RTL /BUFFER NUMBER INTO AC
5344 TAD ANDPTR /USE AS INDEX INTO MASKS
5346 TAD BMAP /BUFFER STATUS MAP
5347 AND I TEMP1 /CLEAR THE BIT FOR THIS BUFFER
5349 \f TAD I IOTHDR /HEADER WORD
5350 AND O7400 /STRIP HEADER TO DEVICE # ONLY
5353 DCA TEMP3 /USE AS COUNTER
5354 CHECKL, TAD TEMP3 /GET 3 OF FILE TO CHECK
5355 TAD (W0PTR /MAKE POINTER TO PROPER W0 HEADER
5356 DCA TEMP1 /SAVE POINTER
5357 TAD TEMP3 /-# OF FILE WERE CHECKING
5358 TAD ENTNO /COMPARE TO CURRENT NUMBER
5359 SNA CLA /IS IT THIS ONE?
5360 JMP PSTCHK /YES-DON'T CHECK DRIVER
5361 TAD I TEMP1 /GET HEADER WORD FOR THE FILE OF INTEREST
5362 AND O7400 /ISOLATE DEVICE #
5364 TAD I IOTHDR /COMPARE TO CURRENT DEVICE #
5365 SNA CLA /SAME DEVICE?
5366 JMP CRETN /YES-LEAVE DRIVER IN CORE
5367 PSTCHK, ISZ TEMP3 /ALL 4 CHECKED?
5368 JMP CHECKL /NO-CHECK THE NEXT 1
5370 AND O10 /GET HANDLER LENGTH BIT
5372 JMP TPREL /YES-FREE BOTH PAGES
5373 TAD I IOTHND /THIS IS THE ONLY FILE USING HANDLER THEN
5375 RTL /SLIDE BITS 4,5 OF HANDLER PAGE TO AC BITS 10,11
5377 AND (3 /ISOLATE HANDLER BUFFER NUMBER
5378 TAD ANDPTR /MAKE POINTER TO PROPER AND MASK
5380 TAD DMAP /DRIVER PAGE MAP
5381 AND I TEMP1 /CLEAR HANDLER PAGE BIT
5383 CRETN, DCA I IOTHND /SET FILE AS IDLE
5384 JMS I PPSWAP /GET RID OF 17600 AGAIN
5387 TPREL, TAD I IOTHND /ONLY FILE USING HANDLER
5389 RTL /ISOLATE HANDLER BUFFER NUMBER
5392 TAD (ANDLS2 /USE AS INDEX TO AND MASK
5396 FILE2 /FILE TABLE ENTRIES
5404 /CODE TO READ IN COMPILER AND START IT
5405 /THIS CODE GETS MOVED TO FIELD 1 AND EXECUTED FROM
5406 /LOC 2001-2013 IN FIELD 1
5410 4613 /"JMS I L7607K"
5413 CBLK, 7617 /STARTING BLOCK OF COMPILER
5414 HLT /SYSTEM ERROR,AND SINCE WE ARE PROBABLY CLOBBERED,WE CAN'T REPORT IT
5416 5612 /"JMP I .+1"-START THE COMPILER
5417 7001 /STARTING ADDR OF COMPILER
5419 /LESS THAN THE DESIRED VALUE
5421 EXTCHK, 0 /SKIP RETURN IF CURRENT
5425 DCA EXTEMP /JUST A TEMP
5426 TAD I EXTEMP /GET EXTENSION
5429 ISZ EXTCHK /YES: SKIP
5435 /SETS UP COMMAND DECODER AREA,THEN CHAINS TO BCOMP.SV
5437 CHAIN, JMS I PXPRINT /EMPTY TTY RING BUFFER
5439 JMS I PPSWAP /RESTORE PG 17600
5440 JMS I DNA2 /GET FILE NAME IN NAME AREA FROM CURRENT FILE
5442 JMS I O7700 /CALL USR
5445 DCA DNA1 /FIRST TWO CHARS OF DEV NAME
5446 TAD I IOTDEV+1 /LAST TWO CHARS
5451 DNA1, 0 /DEVICE NAME
5454 CI, JMS I PERROR /ERROR
5455 TAD CDIN /GET ENTRY POINT OF DRIVER FOR CHAIN FILE
5456 SZA CLA /IS IT IN CORE?
5457 JMP DISIN /YES-NO NEED TO FETCH IT
5458 TAD DNA2 /NO-DEVICE # INTO AC
5462 7001 /INTO PAGE 7000
5463 JMP CI /MAKE IT LOOK LIKE INQUIRE ERROR
5465 DCA STB /POINTER TO FILE NAME
5466 TAD DNA2 /GET DEVICE #
5470 STB, 0 /POINTER TO FILE NAME
5472 CL, JMS I PERROR /LOOKUP ERROR
5473 TAD STB /GET STARTING BLOCK
5475 DCA I (7620 /STARTING BLOCK IN CD AREA
5476 TAD FLN /FILE LENGTH
5479 AND (7760 /PUT IN BITS 0-7
5480 TAD DNA2 /COMBINE WITH DEVICE #
5481 DCA I (7617 /PUT IN CD AREA
5482 TAD O100 /SET R SWITCH
5484 TAD I (7605 /STARTING BLOCK OF COMPILER
5485 SNA /(IS THIS A CORE IMAGE?
5486 JMP CICHAIN /YES: HANDLE SOMEWHAT DIFFERENTLY
5488 DCA I (CBLK /INTO COMPILER READ CODE
5490 JMS I (EXTCHK /SKP IF EXTENSION .SV
5492 JMP CX /ERROR IF IT IS
5493 JMS I (PSWAP2 /NOW EXEC DESTRUCTIVE EXIT CODE
5495 JMP I (CSMOVE /MOVE THE COMPILER READ TO FIELD 1 AND EXECUTE IT
5498 JMS I (EXTCHK /SKP IF EXTENSION IS .SV
5499 CX, JMS I PERROR /ERROR IF NOT
5500 JMS I (PSWAP2 /NOW EXEC ONCE ONLY CLEAN UP ROUTINE
5503 CIF 10 /NOW DO A RESET AND DELETE TENTATIVE FILES
5506 CIF 10 /FLAG TENTATIVE FILE CLEANUP
5513 JMS I (ENTLOK /LOOKUP
5514 DCA I IOTLEN /ACTUAL LENGTH
5516 DCA I IOTMAX /ALSO EQUALS MAXIMUM LENGTH
5517 CLEANP, DCA I IOTPOS /ZERO COLUMN POINTER
5519 TAD I IOTLOC /STARTING BLOCK-1
5520 DCA I IOTBLK /CURRENT BLOCK #=STARTING BLOCK-1
5522 DCA I IOTPTR /READ/WRITE POINTER AT BEGINNING OF BUFFER
5524 JMS I USR /CALL TO USR
5526 JMS I PPSWAP /GET RID OF 17600
5528 JMS I (NEXREC /DO A NEXREC TO READ IN FIRST FILE BLOCK
5531 /ROUTINE FOR INTERPRETER EXIT
5533 FSTOP, KSF /IS THE KEYBOARD FLAG SET?
5534 JMP NOCTC /NO-THERE IS NO CHANGE ^C SENT US HERE
5535 TAD O200 /YES-FORCE PARITY BIT
5537 TAD (-203 /COMPARE AGAINST ^C
5539 JMP NOCTC /NO-THIS IS A NORMAL EXIT
5542 TAD ("^ /YES -ECHO ^
5554 \f /FILE OPENING ROUTINE
5556 OPENAV, TAD (4 /ALPHANUMERIC,VARIABLE LENGTH
5557 OPENAF, IAC /ALPHANUMERIC,FIXED LENGTH
5559 OPENNV, TAD (4 /NUMERIC,VARIABLE LENGTH
5560 OPENNF, DCA I IOTHDR /SET UP HEADER WORD
5561 TAD ENTNO /IS FILE TTY?
5563 JMP I PILOOP /YES-DON'T DO ANYTHING
5564 TAD I IOTHND /GET HANDLER ENTRY
5565 SZA CLA /IS FILE IDLE?
5566 FB, JMS I PERROR /ATTEMPT TO OPEN FILE ALREADY OPEN
5567 JMS I PPSWAP /RESTORE 17600
5568 JMS I (NAMEG /GET FILE DEVICE NAME AND FILE NAME INTO WORDS 7-14 FROM SAC
5570 JMS I O7700 /CALL TO USR
5571 10 /LOCK USR IN CORE
5573 DCA DEVNA1 /DEVICE NAME INTO INQUIRE CALL
5577 JMS I USR /CALL TO USR
5579 DEVNA1, . /DEVICE NAME
5581 ENTRYN, 0 /ENTRY POINT
5582 IN, JMS I PERROR /INQUIRE ERROR
5583 TAD DEVNA2 /GET DEVICE #
5585 RTR /PUT INTO BITS 0-3
5588 DCA I IOTHDR /STORE IN HEADER WORD
5589 TAD ENTRYN /GET DRIVER ADDRESS
5591 JMP I (DRIVRN /YES-NO NEED TO FETCH IT
5592 TAD DMAP /NO-GET MAP OF DRIVER PAGES
5593 CLL RAR /PAGE 7000 BIT IN LINK
5594 SNL /IS PAGE 7000 FREE?
5596 CLL RAR /NO-7200 BIT TO LINK
5597 SNL /IS PAGE 7200 FREE?
5599 \f CLL RAR /NO-7400 BIT TO LINK
5600 SZL CLA /IS PAGE 7400 FREE?
5601 DO, JMS I PERROR /NO-NO MORE ROOM FOR DRIVERS
5602 TAD O7400 /YES-LOAD HANDLER INTO 7400
5603 DCA FETPAG /SET UP IN FETCH CALL
5604 TAD (4 /SET BIT 9 TO SHOW PAGE 7400 OCCUPIED
5605 JMP DFETCH /FETCH DRIVER
5607 FREE70, CLL RAR /PAGE 7200 BIT TO LINK
5608 SNL CLA /IS 7200 FREE?
5609 IAC /YES-THERE IS ROOM FOR A TWO PAGE HANDLER
5611 DCA FETPAG /SET UP FETCH TO USE PAGE 7000
5612 CLL CLA CML RTL /TURN ON BIT 10
5613 DCA TPH /SAVE IN TWO PAGE SET WORD
5614 IAC /SET BIT 11 TO SHOW PAGE 7000 OCCUPIED
5615 JMP DFETCH /FETCH HANDLER
5617 FREE72, CLL RAR /7400 BIT TO LINK
5618 SNL CLA /IS 7400 PAGE FREE?
5619 IAC /YES-THEN THERE IS ROOM FOR A 2 PAGE HANDLER
5621 DCA FETPAG /SET ADDRESS IN FETCH CALL
5623 DCA TPH /IF TWO PAGE LOADED,SET BIT 9 ALSO
5624 AC0002 /TURN ON BIT 10 TO SHOW PAGE 7200 OCCUPIED
5625 DFETCH, TAD DMAP /TURN ON PAGE BIT FOR WHERE BUFFER WILL BE LOADED
5627 TAD DEVNA2 /DEVICE # IN AC
5629 JMS I USR /CALL TO USR
5631 FETPAG, . /DRIVER ADDRESS
5632 FE, JMS I PERROR /FETCH ERROR
5635 TAD I (37 /GET ADDR OF HANDLER INFO TABLE
5636 TAD DEVNA2 /USE THE DEVICE # AS AN INDEX INTO THAT TABLE
5637 DCA TEMP1 /SAVE POINTER
5638 TAD I TEMP1 /GET THE INFO WORD FOR THE HANDLER JUST FETCHED
5640 SMA CLA /IS HANDLER 2 PAGES LONG?
5641 JMP DRAP /NO MAP IS COMPLETE
5642 TAD TPH /YES-UPDATE DRIVER MAP TO INCLUDE
5643 TAD DMAP /SECOND PAGE OF TWO PAGE HANDLERS
5646 TAD I IOTHDR /SET 2 PAGE BIT IN HEADER WORD
5648 DRAP, TAD FETPAG /HANDLER ENTRY ADDRESS
5649 JMP I (DRIVRN /PAGE ESCAPE
5652 \f/ROUTINE TO MOVE THE COMPILER READER INTO FIELD 1 AND START IT
5654 CSMOVE, TAD (CREAD-1
5655 DCA XR1 /POINTES TO COMPILER STARTING CODE
5659 DCA XR2 /MOVE TO LOC 2001 IN FIELD 1
5661 TAD I XR1 /GET WORD OF CODE
5666 CIF 10 /YES-START IT
5670 \fDRIVRN, DCA I IOTHND /DRIVER ENTRY INTO I/O TABLE
5671 TAD BMAP /GET BUFFER MAP
5672 CLL RAR /BUFF1 BIT TO LINK
5674 JMP B1 /YES-ASSIGN BUFF1
5675 RAR /BUFF2 BIT TO LINK
5677 JMP B2 /YES-ASSIGN BUFF2
5678 RAR /BUFF3 BIT TO LINK
5680 JMP B3 /YES-ASSIGN BUFF3
5681 RAR /NO-BUFF4 BIT TO LINK
5682 SZL CLA /IS IT FREE?
5683 BO, JMS I PERROR /NO-NO MORE BUFFERS AVAILABLE
5685 DCA I IOTBUF /SET BUFFER ADDRESS TO 1400
5686 TAD O10 /SET BUFF4 BIR IN MAP
5691 DCA I IOTBUF /SET BUFFER ADDRESS TO 1000
5693 JMP BUFASS /SET BUFF3 BIT IN MAP
5697 DCA I IOTBUF /SET BUFF ADDRESS TO 400
5698 CLL CML CLA RTL /SET BUFF2 BIT IN MAP
5702 DCA I IOTBUF /SET BUFF ADDRESS TO 0000
5703 CLA IAC /TURN ON BUFF1 BIT IN MAP
5705 DCA BMAP /UPDATE BUFFER ASSIGNMENT MAP
5706 TAD I IOTHDR /GET HEADER WORD
5708 RAR /FIXED,VARIABLE BIT TO LINK
5709 SNL CLA /IS IT FIXED?
5710 JMP I (FLOOK /YES-DO A LOOKUP
5711 TAD (3 /NO-DO AN ENTER
5713 DCA I IOTMAX /MAXIMUM LENGTH IN WORD 7
5714 DCA I IOTLEN /ZERO ACTUAL LENGTH
5715 JMP I (CLEANP /FINALIZE I/O TABLE ENTRY
5719 JMS I (PSWAP2 /RESTORE PG 27600
5721 TAD I (EDBLK /GET BLOCK # FOR EDITOR
5723 SNA /SHALL WE CALL THE EDITOR?
5724 JMP I (7600 /NOkJUST CALL OS/8
5725 DCA EBLK /YES-PUT THE BLOCK # IN DRIVER CALL
5726 JMS I (7607 /CALL SYS DRIVER
5729 EBLK, . /BLOCK # OF EDITOR
5730 HLT /SYS ERROR,AND SINCE WE ARE PROBABLY CLOBBERED,WE CAN'T REPORT IT
5731 JMP I .+1 /START THE EDITOR
5734 DCA FNOM /FUNCTION NUMBER IN PLACE
5735 TAD IOTFIL /POINTER TO FILE NAME
5736 DCA STARTB /INTO CALL
5737 TAD I (DEVNA2 /DEVICE NUMBER
5739 JMS I USR /CALL TO USR
5740 FNOM, . /ENTER OR LOOKUP
5743 EN, JMS I PERROR /ENTER ERROR
5744 TAD STARTB /FILE STARTING BLOCK #
5745 SZA CLA /IS IT NON-ZERO?
5746 JMP FILSTU /YES-DEVICE IS FILE STRUCTURED
5747 TAD FLEN /NO-GET FILE LENGTH
5748 SZA CLA /IS IT EMPTY?
5749 JMP FILSTU /NO-DEVICE IS FILE STRUCTURED
5750 TAD (20 /NO-FILE IS READ/WRITE ONLY
5752 DCA I IOTHDR /SET READ/WRITE ONLY BIT
5757 FILSTU, TAD STARTB /GET STARTING BLOCK # OF FILE
5758 DCA I IOTLOC /PUT IN I/O TABLE
5759 TAD FLEN /FILE LENGTH
5760 CIA /MAKE FILE LENGTH POSITIVE
5761 JMP I ENTLOK /RETURN
5762 \f/SUBROUTINE P2SWAP-RESTORE OS/8 RESIDENT MONITOR PRIOR TO EXIT FROM INTERPRETERTER
5763 /THIS IS DESTRUCTIVE CODE,AND ONCE THIS ROUTINE HAS BEEN EXECUTED
5764 /THERE IS NO PLACE TO GO BUT OUT.
5766 / 1) REMOVES CTRL/C HOOKS FROM SYS DRIVER
5767 / 2) RESTORES BATCH CONTROL WORDS TO 27774-27777
5768 / 3) IF SYS=TD/8E,RESTORES PAGE 27600 AND RETURNS CDFS TO PAGE 07600
5772 DCA I (7600 /REMOVE CTRL/C HOOKS
5776 DCA I (HICORE /FUDGE POINTER IN SWAP ROUTINE (IN CASE IT WAS TD8E)
5777 TAD PSFLAG /GET RESIDENT STATUS FLAG
5778 SPA CLA /IS THIS TD8/E SYS?
5779 JMS I (PSWP2P /YES-RESTORE PAGE 27600 AND PAGE 07600
5781 DCA .+3 /CDF TO HI CORE
5783 TAD I BOSPT1 /GET BATCH WORD
5785 DCA I BOSPT2 /BACK INTO LOFTY STATE
5790 JMP I PSWAP2 /YES-WE ARE FINISHED,SO RETURN
5795 \f /PARSE A FILENAME OF THE FORM "DEVN:FILENM.EX" IN THE SAC
5796 /DSK: AND A NULL EXTENSION ARE THE DEFAULTS
5797 /THE END OF THE SAC IS USED AS A WORK AREA
5798 /IF SYNTAX IS CORRECT, THE NAME IS PACKED INTO
5799 /THE FILENAME FIELD OF THE CURRENT FILE
5800 /OTHERWISE A FATAL ERROR IS RETURNED
5801 /ENTERED WITH OS/8 SWAPPED IN
5803 WKAREA= SAC+16 /DEFINE SCRATCH AREA
5807 TAD (16 /COMPARE STRING LENGTH TO 16
5809 IF, JMS I PERROR /TOO MANY CHARS IN "DEV:FILENM.EX"
5811 DCA TEMP2 /STRING LENGTH COUNTER
5814 TAD (DSK-1 /FIRST USE THE DEFAULT DEVICE
5816 NCG, TAD I SACXR /GET CHAR FROM SAC
5819 TAD (-72 /IS IT A COLON?
5821 JMP CAD /YES-CHARS SO FAR=DEVICE NAME
5822 TAD (14 /NO-IS IT A PERIOD?
5824 JMP SSAD /YES-NEXT TWO CHARS=EXTENSION
5825 TAD TEMP1 /NO-GET CHAR AGAIN
5826 DCA I XR2 /STORE IN WORK AREA
5827 ISZ TEMP4 /BUMP COUNT FOR CURRENT SECTION
5828 NCGS, ISZ TEMP2 /END OF STRING YET?
5829 JMP NCG /NO-NEXT CHAR
5830 \f TAD TEMP4 /YES-GET CHAR COUNT FOR THIS SECTION (NAME)
5832 SMA SZA CLA /IS IT >6?
5833 JMP IF /YES-TOO MANY CHARACTERS IN FILE NAME
5834 TAD (WKAREA-1 /NO-ADDRESS OF SCRATCH NAME BLOCK
5837 TAD IOTDEV /ADDRESS OF FINAL NAME BLOCK-1
5839 TAD (-6 /MOVE 6 WORDS
5846 DCA I XR2 /MOVE NAME WORD FROM SCRATCH AREA TO FINAL DEST
5849 JMP I NAMEG /YES-RETURN
5851 CAD, TAD TEMP4 /GET CHAR COUNT FOR THIS SECTION
5852 TAD (-4 /COMPARE AGAINST 4
5853 SMA SZA CLA /TOO MANY CHARS?
5854 JMP IF /YES-DEVICE NAME TOO LONG
5856 JMS DEVFUD /CLEAR BUF AND GET NAME FROM FILE FIELD THIS TIME
5859 SSAD, TAD TEMP4 /COUNT FOR THIS SECTION (FILE NAME)
5861 SMA SZA CLA /TOO MANY?
5862 JMP IF /YES-FILE NAME TOO LONG
5863 DCA TEMP4 /NO-CLEAR COUNT
5865 TAD TEMP2 /COMPARE AGAINST # OF CHARS LEFT
5867 JMP IF /TOO MANY CHARS IN EXTENSION
5873 DCA XR1 /POINT AT LOC OF DEV:
5875 DCA XR2 /POINT AT START OF WORK AREA
5880 TAD I XR1 /GET A DEVICE NAME BYTE
5881 DCA I XR2 /STORE IN WORK AREA DEVICE FIELD
5884 DCA I XR2 /NOW CLEAR REST OF FILE NAME
5887 TAD (WKAREA-1+4 /POINT XR2 AT FILENAME FIELD
5889 JMP I DEVFUD /RETURN WITH TEMP4 CLEAR
5891 DSK, 4;23;13;0 /6BIT DEFAULT DEVICE NAME "DSK"
5892 \f/SUBROUTINE TO RESTORE PAGE 27600 OF TD8/E DRIVER
5893 /AND READJUST THE CDFS IN FIELD 0
5898 SNL CLA /BIT 1 SET MEANS PHONEY TD8E
5902 DCA PSFLAG /CLEAR RESIDENT STATUS FLAG
5904 DCA I (P2CDF /PUT CDF 20 IN SWAP ROUTINE
5907 JMS I PPSWAP /MOVE DOWN PAGE 27600
5912 TAD (6222 /RESTORE CDFS IN PAGE 07600
5914 JMP I PSWP2P /RETURN
5935 /////////////////////////////////////////////////////////////////////
5936 /////////////////////////////////////////////////////////////////////
5937 /////////////// END OF OVERLAY AREA /////////////////////////////////
5938 /////////////////////////////////////////////////////////////////////
5939 /////////////////////////////////////////////////////////////////////
5942 \f<:STTYF, 1
\e+1"E0;'
5943 J<S
\13PRINT
\13\e;R-5DI[XPRINT
\e>
5944 J<S
\13SACPTR
\13\e;R-6DI[SAC-1
\e>
5945 J<S
\13PUTCHL
\13\e;R-6DI[PUTCH
\e>
5946 J<S
\13ILOOPL
\13\e;R-6DI[ILOOP
\e>
5947 J<S
\13INTL
\13\e;R-4DI[UNSFIX
\e>
5948 J<S
\13CDFPSL
\13\e;R-6DI[CDFPSU
\e>
5949 J<S
\13ERROR
\13\e;R-5DI[ERRDIS
\e>
5950 J<S
\13FBITS
\13\e;R-5DI[FBITGT
\e>
5951 J<S
\13PWFECL
\13\e;R-5DI[PWFECH
\e>
5952 J<S
\13MPYLNK
\13\e;R-6DI[MPY
\e>
5953 J<S
\13XPUT
\13\e;R-4DI[XPUTCH
\e>
5954 J<S
\13FIDLE
\13\e;R-5DI[IDLE
\e>
5955 J<S
\13DEVCAL
\13\e;R-6DI[DRCALL
\e>
5956 J<S
\13WRITFW
\13\e;R-6DI[WRITFL
\e>
5957 J<S
\13STHINL
\13\e;R-6DI[STHINI
\e>
5958 J<S
\13LDHINL
\13\e;R-6DI[LDHINI
\e>
5959 J<S
\13STH
\13\e;R-3DI[STHL
\e>
5960 J<S
\13LDH
\13\e;R-3DI[LDHL
\e>
5961 J<S
\13FACSAL
\13\e;R-6DI[FACSAV
\e>
5962 J<S
\13FACREL
\13\e;R-6DI[FACRES
\e>
5963 J<S
\13FGETL
\13\e;R-5DI[FFGET
\e>
5964 J<S
\13FPUTL
\13\e;R-5DI[FFPUT
\e>
5965 J<S
\13FNORL
\13\e;R-5DI[FFNOR
\e>
5966 J<S
\13FCLR
\13\e;R-4DI[FACCLR
\e>
5967 J<S
\13FNEGL
\13\e;R-5DI[FFNEG
\e>
5968 J<S
\13FLOATL
\13\e;R-6DI[FFLOAT
\e>
5969 J<S
\13GETCHL
\13\e;R-6DI[GETCH
\e>
5970 J<S
\13EOFSEL
\13\e;R-6DI[EOFSET
\e>
5971 J<S
\13BSWL
\13\e;R-4DI[BSWP
\e>
5972 J<S
\13PACKL
\13\e;R-5DI[PACKCH
\e>
5973 J<S
\13CNOCLL
\13\e;R-6DI[CNOCLR
\e>
5974 J<S
\13BUFCHL
\13\e;R-6DI[BUFCHK
\e>
5975 J<S
\13FTYPL
\13\e;R-5DI[FTYPE
\e>
5976 J<S
\13CHRNOL
\13\e;R-6DI[CHARNO
\e>
5977 J<S
\13NEXREL
\13\e;R-6DI[NEXREC
\e>
5978 J<S
\13CRLF
\13\e;R-4DI[CRLFR
\e>
5979 J<S
\13VALLK
\13\e;R-5DI[VALGET
\e>
5980 J<S
\13PATCHP
\13\e;R-6DI[PATCHF
\e>
5981 J<S
\13P1SWAP
\13\e;R-6DI[PSWAP
\e>
5982 J<S
\13LDHRST
\13\e;R-6DI[LRESET
\e>
5983 J<S
\13STHRST
\13\e;R-6DI[SRESET
\e>