--- /dev/null
+/OS8 BASIC RUNTIME SYSTEM, V5A
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/COPYRIGHT (C) 1972, 1973, 1974, 1975
+/DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
+/
+/
+/
+/THIS SOFTWARE IS FURNISHED UNDER A LICENSE FOR USE ONLY ON A
+/SINGLE COMPUTER SYSTEM AND MAY BE COPIED ONLY WITH THE INCLU-
+/SION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE, OR ANT OTHER
+/COPIES THEREOF, MAY NOT BR PROVIDED OR OTHERWISE MADE AVAILABLE
+/TO ANY OTHER PERSON EXCEPT FOR USE ON SUCH SYSTEM AND TO ONE WHO
+/AGREES TO THESE LICENSE TERMS. TITLE TO AND OWNERSHIP OF THE
+/SOFTWARE SHALL AT ALL TIMES REMAIN IN DEC.
+/
+/
+/THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT
+/NOTICE AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL
+/EQUIPMRNT COROPATION.
+/
+/DEC ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
+/SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DEC.
+/
+/
+/
+/
+/
+/
+\f/AUGUST 19, 1972
+/
+/R.G. BEAN, 1972
+/SHAWN SPILMAN, 1973
+/ J.K.,1975
+/JR 21-APR-77 ADDED EXTENDED DATE CODE, CLEANED UP LISTING
+/JR 26-APR-77 TIGHTENED UP STRING ROUTINES
+/JR 28-APR-77 ADD SOURCE FIX FOR SEVERAL KNOWN BUGS
+/JR 4-MAY-77 REWROTE FLOATING POINT OUTPUT ROUTINE TO INCREASE ACCURACY
+/
+/
+ VERSON= 5 /VERSION OF BRTS
+ /VERSION LOCATED AT TAG "VERLOC" AND VERLOC+1
+ /VERLOC = 260+VERSON
+ /VERLOC+1 = 300+SUBVER (01 = A)
+ SUBVER= 01 /SUBVERSION OF BRTS
+ SUBVAF= 01 /SUBVERSION OF BASIC.AF OVERLAY
+ SUBVSF= 01 /SUBVERSION OF BASIC.SF OVERLAY
+ SUBVFF= 01 /SUBVERSION OF BASIC.FF OVERLAY
+ /FIRST WORD OF EACH OVERLAY CONTAINS
+ /60+VERSON IN LEFT HALF AND SUBVERSION OF OVERLAY
+ /IN RIGHT HALF.
+ MDATE= 7666 /CONTAINS OS/8 DATE IN FIELD 1
+ BIPCCL= 7777 /CONTAINS YEAR EXTENSION BITS
+ SCOPWD= 7726 /WORD CONTAINING SCOPE FLAG IN 200 BIT
+ EDBLK= 7604 /CONTAINS BLOCK NUMBER OF EDITOR
+ WIDTH= 120 /WIDTH OF PRINTER
+ COLWID= 16 /WIDTH OF ONE PRINT COLUMN
+ SACLIM= 120 /DEFINE WIDTH OF STRING ACCUMULATOR
+ OVERLAY=3400 /ADDRESS OF START OF 5 PAGE OVERLAY BUFFER
+
+
+
+/ASSEMBLY INSTRUCTIONS
+/ .R PAL8
+/ *BRTS<BRTS.PA/W
+/ .R ABSLDR
+/ *BRTS$ (THEN SAVE AS SHOWN BELOW)
+/
+
+/WHEN ASSEMBLED AND LOADED VIA THE ABS. LOADER,THE
+/CORE LAYOUT IS AS FOLLOWS:
+/
+/BRTS IS AT 0-6777
+/OVERLAY BASIC.AF IS AT 3400-4577
+/OVERLAY BASIC.SF IA AT 12000-13177
+/OVERLAY BASIC.FF IS AT 13400-14577
+/
+/TO CREATE SAVE IMAGE FILES PRIOR TO RUNNING BASIC,
+/ASSEMBLE THIS SOURCE IN A 12K OR MORE MACHINE,THEN
+/PERFORM THE FOLLOWING SEQUENCE OF OS/8 COMMANDS
+/
+/.R ABSLDR
+/*BRTS$
+/.SAVE SYS:BRTS 0-6777
+/
+/.SAVE SYS:BASIC.AF 3400-4577
+/
+/.SAVE SYS:BASIC.SF 12000-13177
+/
+/.SAVE SYS:BASIC.FF 13400-14577
+/
+/THE BASIC RUN-TIME SYSTEM IS CONDITIONALIZED TO TAKE ADVANTAGE
+/OF THE PDP-8/E KE8/E EAE OPTION.
+/NORMALLY,THE SYSTEM IS ASSEMBLED SUCH THAT IT WILL RUN ON ANY
+/PDP-8 OR PDP-12. TO TAKE ADVANTAGE OF THE ADDITIONAL HARDWARE,SET
+/THE SWITCH EAE=1 IF THE SYSTEM INCLUDES A KE8/E EAE.
+/YOU MAY DO THIS BY CONCATENATING TTY: ONTO BRTS.PA AS FOLLOWS
+/.PAL EABRTS<TTY:,SYS:BRTS.PA/W
+/EAE=1
+/^Z
+/^Z
+/. BINARY IS CREATED...
+/NOW EABRTS IS LOADED INSTEAD OF BRTS
+/TO GET A LISTING, USE THE /J SWITCH TO INHIBIT THE FPP CODE YOU
+/ARE NOT USING (EAE ON A NON EAE ASSEMBLY FOR EXAMPLE)
+
+/EAE=0 /USE STANDARD FLOATING POINT PACKAGE
+/EAE=1 /USE EAE FLOATING POINT PACKAGE
+/
+/V4 FIXES
+/.EAE ADD FOR NUMS <.00001 TO 0
+/.FILE INPUT FROM TTY
+/.OUTPUT OF NUMS > 80,000
+/.STRING FETCH WHEN COUNT IS IN ONE FLD &
+/ TEXT IS IN THE NEXT
+\f AC4000= CLA STL RAR
+ AC2000= CLA STL RTR
+ AC0002= CLA STL RTL
+ AC7775= CLL STA RTL
+ AC7776= CLL STA RAL
+ AC3777= CLL STA RAR
+ AC5777= CLL STA RTR
+
+ IFNDEF EAE <EAE=0>
+
+ /PAGE 0 LOCATIONS
+
+ *6
+USECON, 0 /USE CONSTANT GENERATED BY "USE" STATEMENT
+FSTOP1, FSTOPI /POINTER TO RTS EXIT ROUTINE USED
+ /BY ^C HOOKS IN SYSTEM HANDLER.
+ /IF THIS IS MOVED, BLOAD MUST BE ALTERED
+
+ *10
+SACXR, 15 /INDEX REGISTER FOR STRING ROUTINES
+XR1, VCHECK
+XR2, 0
+XR3, 0
+XR4, 4 /INDEX REGISTERS
+XR5, 0
+DATAXR, 0 /POINTER FOR IN-CORE DATA LIST
+SPINNR, 2713 /AT RUNTIME,THIS LOCATION IS SPUN FOR RND SEED
+
+ *20
+
+/COMPILER-INTERPRETER CONTROL BLOCK. LOCATIONS MARKED BY
+/A /* ARE EXPECTED TO CONTAIN VALUES SUPPLIED BY THE COMPILER PRIOR
+/TO THE BRTS LOAD
+
+CDFIO, 6211 /* CDF FOR I/O TABLE AND SYMBOL TABLES
+SCSTRT, 0 /* POINTER TO START OF SCALAR SYMBOL TABLE
+ARSTRT, 0 /* POINTER TO START OF ARRAY SYMBOL TABLE-1
+STSTRT, 0 /* POINTER TO START OF STRING SYMBOL TABLE-1
+SASTRT, 0 /* POINTER TO START OF STRING ARRAY TABLE-1
+CDFPS, 0 /* CDF FOR START OF PSEUDO-CODE
+PSSTRT, 0 /* POINTER TO START OF PSEUDO CODE-1
+DLSTOP, 0 /* POINTER TO TOP OF DATA LIST
+DLSTRT, 0 /* POINTER TO BOTTOM OF INCORE DATA LIST-1
+PSFLAG, 0 /* OS/8 SWAPPING FLAGS WORD
+ /BIT 0 SET IF OS/8 SAVED IN N7400 INSTEAD OF N7600 (TD8E)
+ /BIT 1 SET IF ROM TD8E HANDLER NOT NEEDING CDF CHANGES
+ /BIT 11 SET IF 17600 IS IN 17600. BIT 11 TOGGLED BY
+ /PSWAP ROUTINE
+
+\f/SYSTEM REGISTERS
+
+SACLEN, 0 /LENGTH OF STRING IN SAC
+S1, 0 /SUBSCRIPT 1 (MUST BE FOLLOWED BY S2!)
+S2, 0 /SUBSCRIPT 2 (MUST BE PRECEEDED BY S1!)
+DMAP, 0 /MAP OF DRIVER PAGES
+BMAP, 0 /MAP OF FILE BUFFERS
+
+ *37
+/FLOATING POINT PACKAGE LOCATIONS. THE FOLLOWING 21 LOCATIONS ARE USED
+/FOR VARIOUS PURPOSES BY THE FLOATING POINT PACKAGE. THOSE WITH DOUBLE
+/LABELS ARE USED BY BRTS AS TEMPORARIES WHEN NOT CALLING THE PACKAGE.
+/THE SECOND TAG IS THE ONE USED BY THE FLOATING POINT PACKAGE,THE FIRST
+/IS USED BY BRTS.
+
+FF, 0 /SPECIAL MODE FLIP-FLOP
+TEMP1,
+AC0, 0
+AC1, 0
+TEMP3,
+AC2, 0
+TM,
+TEMP4, 6201
+ACX, 0 /FAC-EXPONENT
+ACH, 0 /FAC-HIGH ORDER MANTISSA
+ACL, 0 /FAC-MANTISSA LOW
+TEMP5,
+OPX, 0
+TEMP6,
+OPH, 0
+TEMP7,
+OPL, 0
+DSWIT, 0 /SWITCH USED BY INPUT ROUTINE
+CHAR, 215 /TERMINATOR OF LAST INPUT
+TEMP10, 0 /LOC NEEDED BY FPP
+
+ DECEXP= TEMP10
+
+ /SYSTEM REGISTERS USED OFTEN BY INTERPRETER CODE
+
+MODESW, 0 /0 FOR ARTHIMETIC MODE,1 FOR STRING MODE
+INSAV, 0 /CURRENT PSEUDO-INSTRUCTION BEING EXECUTED
+LINEHI, 0 /HI ORDER BITS OF LINE # CURRENTLY BEING EXECUTED
+LINELO, 0 /LOW ORDER BITS OF CURRENT LINE NUMBER
+STRMAX, 0 /MAXIMUM # OF CHARS ALLOWED IN CURRENT STRING
+STRCNT, 0 /- # OF CHARACTERS IN CURRENT STRING
+STRPTR, 0 /POINTER TO SIZE WORD OF CURRENT OPERAND STRING
+TEMP2, 0
+
+\f/I/O TABLE POINTER AREA-THIS BLOCK HOLDS POINTERS TO THE I/O TABLE
+/ENTRY FOR THE CURRENT FILE.THE POINTERS ARE CHANGED EVERY TIME AN
+/SFN IS EXECUTED. A TAD I OFF ONE OF THE POINTERS WILL GET THE INFORMATION
+/NOTED IN THE COMMENT FOR THE CURRENT I/O DEVICE
+/THIS BLOCK IS INITIALIZED FOR TTY
+
+ IOTSIZ= 15 /CURRENT SIZE OF IO TABLE
+
+ /THE FORMAT OF THE HEADER WORD IS AS FOLLOWS
+ /BITS USAGE
+ /0-3 OS/8 DEVICE NUMBER
+ /4-5 3 FOR 2 CHARACTER UNPACKING COUNT
+ /6 SET IF BUFFER HAS BEEN MODIFIED AND NEEDS TO BE WRITTEN
+ /7 SET IF NOT FILE STRUCTURED DEVICE
+ /8 SET IF HANDLER IS 2 PAGES LONG
+ /9 SET IF VARIABLE LENGTH (OUTPUT) FILE
+ /10 SET IF EOF
+ /11 SET IF ASCII FILE, CLEAR IF NUMERIC IMAGE FILE
+
+
+ENTNO, 0 /ENTRY NUMBER NOW IN AREA
+IOTHDR, TTYF /HEADER WORD
+IOTBUF, TTYF+1 /BUFFER ADDRESS
+IOTBLK, TTYF+2 /CURRENT BLOCK IN BUFFER
+IOTPTR, TTYF+3 /READ\WRITE POINTER
+IOTHND, TTYF+4 /HANDLER ENTRY POINT
+IOTLOC, TTYF+5 /FILE STARTING BLOCK #
+IOTLEN, TTYF+6 /ACTUAL FILE LENGTH
+IOTMAX, TTYF+7 / DEVICE / (FILE MAXIMUM LENGTH)
+IOTPOS, TTYF+10 / NAME / (POSITION OF PRINT HEAD)
+IOTFIL, TTYF+11 /
+/ TTYF+12 / FILE
+/ TTYF+13 / NAME
+/ TTYF+14 / .EX
+
+IOTDEV= IOTMAX
+\f *200
+
+ /FETCH NEXT PSEUDO WORD
+
+PWFECH, JMP START1 /START ONCE ONLY CODE IN TTY BUFFER
+ ISZ INTPC /BUMP PSEUDO-CODE PROGRAM COUNTER
+ JMP CDFPSU /NO-SKIP;JUST GET NEXT PSEUDO-CODE WORD
+ TAD CDFPSU /SKIP MEANS WE HAVE TO INCREMENT PS-CODE FIELD
+ TAD [10
+ DCA CDFPSU
+CDFPSU, VCHECK /SET DF TO FIELD OF PSEUDO-CODE
+ TAD I INTPC /GET NEXT WORD OF CODE
+ CDF 0 /SET DATA FIELD BACK TO INTERPRETER FIELD
+ JMP I PWFECH /RETURN
+O7770, 7770
+
+SSMODE, IAC /SET INTERPRETER TO STRING MODE
+AMODE, DCA MODESW /SET INTERPRETER TO ARITH MODE
+ /FALL BACK INTO I-LOOP
+
+ /BRTS I-LOOP
+
+ILOOP, CLA CLL /FLUSH
+ DCA FF /PUT FPP IN SI MODE
+ JMS PWFECH /GET NEXT PSEUDO-INSTRUCTION
+ DCA INSAV /SAVE FOR LATER
+ JMS I [XPRINT /CALL TO TTY DRIVER
+ NOP
+ TAD INSAV
+ AND [7400 /STRIP TO OPCODE BITS
+ CLL RTL
+ RTL
+ RAL /OPCODE NOW IN BITS 8-11
+ TAD O7770 /SUBTRACT 10
+ SMA /IS OPCODE <10?
+ JMP SCASE /CALL TO INSTRUCTION COMMON TO SMODE AND AMODE
+ DCA TEMP1 /YES-SAVE THE OFFSET
+ TAD MODESW /WHICH MODE?
+ SZA CLA
+ JMP SMODE /STRING MODE
+ TAD TEMP1 /ARITHMETIC MODE-GET OFFSET
+ TAD JMSI /MAKE JMS TO FP PACKAGE ROUTINE
+ DCA .+2 /PUT IN LINE
+ JMS ARGPRE /SET UP ARGUMENT FROM SYMBOL TABLE
+ILOOPF, . /JMS TO THE FLOATING POINT PACKAGE ROUTINE
+ NOP /FPP SOMETIMES RETURNS TO CALL+2
+ JMP ILOOP /DONE
+
+SCASE, TAD JMPI /JUST DISPATCH TO ROUTINE CALLED FOR
+ DCA .+1
+ . /JUMP TO APPROPRIATE ROUTINE
+
+JMSI, JMS I SEP1 /JMS USED FOR CALLS TO FPP BY AMODE INST
+JMPI, JMP I SEP1 /JMP USED TO CALL ROUTINES COMMON TO AMODE AND SMODE
+\f /JUMP TABLE FOR AMODE INSTRUCTIONS
+
+ FFADD /FAC_C(A)+FAC OPCODE 0
+ FFSUB /FAC_FAC-C(A) OPCODE 1
+ FFMPY /FAC_FAC*C(A) OPCODE 2
+ FFDIV /FAC_FAC/C(A) OPCODE 3
+ FFGET /FAC_C(A) OPCODE 4
+ FFPUT /C(A)_FAC OPCODE 5
+ FFSUB1 /FAC_C(A)-FAC OPCODE 6
+ FFDIV1 /FAC_C(A)/FAC OPCODE 7
+/ALL INSTRUCTIONS BEYOND THIS POINT ARE COMMON TO AMODE AND SMODE
+SEP1, LS1I /S1_C(A) OPCODE 10
+ LS2I /S2_C(A) OPCODE 11
+ FJOCI /IF TRUE,PC_C(PC,PC+1) OPCODE 12
+ JEOFI /IF EOF,PC_C(PC,PC+1) OPCODE 13
+ LINEI /LINE NUMBER OPCODE 14
+ ARRAYI /ARRAY INST OPCODE 15
+ ILOOP /NOP OPCODE 16
+ OPERI /OPERATE INST OPCODE 17
+
+
+SMODE, TAD TEMP1 /INST OFFSET
+ TAD JMSSI /BUILD JMP OFF STRING TABLE
+ DCA SDIS /PUT IN LINE
+ CLL /STRING SCALAR TABLE
+ JMS I STFINL /SET UP ARGUMENT ADDRESS
+SDIS, . /CALL STRING ROUTINE REQUESTED
+
+
+/JUMP TABLE FOR SMODE INSTRUCTIONS
+/ A "/*" IN THE COMMENT MEANS THAT THAT OPCODE IS NOT USED,SO WE
+/USE THE SLOT FOR REGULAR STORAGE
+
+ SCON1 /SAC_SAC&C(A$)
+ SCOMP /IF SAC .NE. C(A$),PC_PC+2
+ SREAD /C(A$)_DEVICE
+INTPC, . /* INTERPRETER PC
+ SLOAD /SAC_C(A$)
+ SSTORE /C(A$)_SAC
+STFINL, STFIND /* LINK TO STRING FINDING ROUTINE
+JMSSI, JMP I .+1 /* DISPATCH JUMP FOR SMODE INSTRUCTIONS
+\f/ARGPRE-ROUTINE TO TRANSLATE OPERAND FIELD INTO 12 BIT POINTER
+/INTO SCALAR TABLE FOR USE IN FPP CALLS.
+
+ARGPRE, 0
+ TAD INSAV /GET INSTRUCTION
+ AND [377 /STRIP TO OPERAND FIELD
+ DCA TEMP1 /SAVE
+ TAD TEMP1
+ CLL RAL /*2
+ TAD TEMP1 /PTR*3
+ TAD SCSTRT /MAKE 12 BIT ADDR
+SCALDF, 1000 /DF TO SCALAR FIELD (CDF INITIALIZED BY LOADER)
+ JMP I ARGPRE /RETURN
+
+/ROUTINE TO ZERO FAC
+
+FACCLR, -4
+L7600, 7600 /CLA
+ DCA ACX /ZERO EXPONENT
+ DCA ACL /ZERO LOW MANTISSA
+ DCA ACH /ZERO HIGH MANTISSA
+ JMP I FACCLR
+
+ /STRING ACCUMULATOR USED BY STRING OPCODES AND FUNCTIONS
+ /CONTAINS ONE 6BIT CHAR PER WORD
+
+START1,
+SAC, OSR
+ SZA CLA
+ NOP /A HLT PLACED HERE WILL ALLOW YOU TO STOP
+ /MACHINE BEFORE RUNTIME SYSTEM STARTS BY
+ /SETTING SWITCH REGISTER
+ TLS /SET TTY FLAG
+ ISZ SPINNR /SPIN RANDOM NUMBER SEED
+ NOP /WHILE WAITING FOR INITIALIZING TLS
+ TSF /FLAG UP YET?
+ JMP .-3 /NO
+ TAD CDFIO
+ DCA I PS1L /SET UP CDFS IN PSWAP
+ TAD CDFIO
+ DCA I PS2L
+ JMS I PFUDSC /SWAP 17600 IN IF NOT ALREADY IN AND SAVE SCOPE FLAG
+ JMS I CDFPSU
+ TAD SCALDF /SET PROG NOT RESTARTABLE BIT
+ DCA I L7746 /TELL USR TO SAVE 1000-1777
+ TAD PINFO /POINTER TO INFO TABLE IN 17600
+ DCA XR1
+ TAD POVTAB /POINTER TO BLOCK TABLE IN OVERLAY DRIVER
+ DCA XR2
+ TAD FACCLR /WE HAVE TO GET 4 BLOCK NUMBERS
+ DCA TEMP1
+OVML, CDF 10
+ TAD I XR1 /GET BLOCK NUMBER FOR THIS OVERLAY FROM INFO AREA
+ CDF
+ DCA I XR2 /PUT IN TABLE IN OVERLAY DRIVER
+ ISZ TEMP1 /DONE?
+ JMP OVML /NO
+ JMS I [PSWAP /SWAP 17600 BACK TO HIGH CORE NOW
+ JMP I .+1
+ START3 /CONTINUE THE INITIALIZING CODE IN INTERMEDIATE BUFFER
+L7746, 7746
+PINFO, 7607
+POVTAB, ARITHA-1
+PS1L, P1CDF
+PS2L, P1CDF1
+PFUDSC, FUDSC
+
+ PAGE
+
+FUDSC, 0
+ TAD PSFLAG /TEST WHERE 17600 IS LOCATED
+ SMA CLA
+ TAD [200 /IF NOT TD8E USE 7600
+ TAD [7400 /IF TD8E USE 7400
+ DCA I PHICORE /STORE FOR SWAPPER
+ CLA IAC
+ AND PSFLAG
+ SNA CLA /SKP IF PAGE 17600 IS ALREADY IN
+ JMS I [PSWAP /ELSE BRING IT IN
+ CDF 10
+ TAD I PSCOPW
+ CDF
+ AND [200 /GET SCOPE BIT FROM RES MONITOR
+ DCA I PSCOPF
+ TAD I PHEIGHT
+ DCA I PHCTR /NOW INITIALIZE THE SCREEN HEIGHT COUNTER
+ JMP I FUDSC /RETURN
+PHEIGHT,HEIGHT
+PHCTR, HCTR
+PSCOPW, SCOPWD
+PSCOPF, SCOPFG
+PHICOR, HICORE
+\f *SAC+SACLIM+1 /ORIGIN PAST SAC+ONE GUARD CHAR
+
+ /JUMP ON CONDITION
+
+FJOCI, TAD INSAV /GET JUMP INSTRUCTION
+ AND [17 /MASK OFF JUMP CONDITION
+ SNA /IS IT GOSUB?
+ JMP I (GOSUB /YES-PUSH PC ON STACK THEN JUMP
+ TAD FSTOPI /BASE TAD FOR BUILD OF TAD INSTRUCTION
+ DCA .+1 /PUT IN LINE
+ . /GET PROPER SKIP
+ DCA .+2 /PUT IN LINE
+ TAD ACH /GET HIGH ORDER FAC
+ . /SKIP INSTRUCTION
+ JMP SUCJMP /CONDITION TRUE-JUMP
+JFAIL, JMS I [PWFECH /CONDITION FALSE-DON'T JUMP,BUT BUMP PC
+ JMP I [ILOOP /DONE
+
+/JUMP ON END OF FILE
+
+JEOFI, JMS I [IDLE /SEE IF FILE OPEN
+ TAD I IOTHDR /1ST WORD OF I/O TABLE ENTRY
+ CLL RTR /GET EOF BIT IN LINK
+ SNL CLA /EOF?
+ JMP JFAIL /NO-DON'T JUMP
+ /YES, FALL INTO JUMP ROUTINE
+
+SUCJMP, JMS I [PWFECH /GET WORD FOLLOWING JUMP INS.
+ DCA I INTPCL /STORE AS NEW PC
+ TAD INSAV /GET JUMP INSTRUCTION
+ AND [340 /MASK OFF DESTINATION FIELD
+ CLL RTR /SLIDE OVER
+ TAD CDFINL /MAKE A CDF INSTRUCTION
+ DCA I [CDFPSU /AND SET NEW PC INSTRUCTION FIELD
+ JMP I [ILOOP /NEXT INSTUCTION
+
+K7554, 7554 /MUST PRECEDE SKIP TABLE
+
+/SKIP TABLE USED TO HOLD TESTS FOR VARIOUS CONDITIONS
+
+K7600, 7600 /UNCONDITIONAL (CLA)
+ SMA CLA /JPA
+ SZA CLA /JNA
+ SMA SZA CLA /JPA JNA
+ SPA CLA /JMA
+ SNA CLA /JZA
+ SPA SNA CLA /JMA JZA
+ JMP I JFORL /FORLOOP JUMP ROUTINE
+
+JFORL, JFOR
+INTPCL, INTPC
+ 0000;0 /MARK BEGINNING OF GOSUB STACK
+GSTCK, 6000;0
+ 6000;0
+ 6000;0
+ 6000;0
+ 6000;0
+ 6000;0
+ 6000;0
+ 6000;0
+ 6000;0
+ 0 /MARK THE END OF THE GOSUB STACK
+\f/CALL TO DEVICE DRIVER FOR FILE I/O. ASSUMES ARGS HAVE BEEN SET UP
+
+DRCALL, 0
+ DCA DRARG1 /FUNCTION WORD INTO DRIVER CALL
+CDFINL, CDF /DF TO CURRENT FIELD
+ TAD I IOTBUF /GET BUFFER ADDRE FROM I/O TABLE ENTRY
+ DCA DRARG2 /PUT IN DRIVER CALL
+ TAD I IOTBLK /GET BLOCK NUMBER FROM I/O TABLE
+ DCA DRARG3 /PUT IN DRIVER CALL
+ TAD I IOTHND /GET DRIVER ENTRY
+ DCA DRIVER /SAVE
+ JMS I DRIVER /CALL DRIVER
+DRARG1, 0 /FUNCTION CONTROL WORD
+DRARG2, 0 /BUFFER ADDRESS
+DRARG3, 0 /BLOCK #
+ SMA CLA /DEVICE ERROR-IS IT FATAL?
+ JMP I DRCALL /ALLS WELL
+DE, JMS I [ERROR /FATAL
+DRIVER, 0
+
+/CALL TO INTERPRETER EXITING ROUTINE
+
+FSTOPN, JMS I [XPRINT /ON NORMAL EXITS,WE MUST EMPTY RING BUFFER
+ JMP .-1 /FIRST
+FSTOPI, TAD K7554
+ DCA INSAV /FAKE A CALL TO BASIC.FF FUNCTION 6
+ JMP I .+1 /CALL OVERLAY
+ FUNC5I
+
+/USE FUNCTION-TAKES WORD FOLLOWING CALL AND STUFFS IT IN USECON FOR
+/USE A BUFFER POINTER FOR USER SUBROUTINE
+
+USE, JMS I [PWFECH /GET NEXT WORD FROM PSEUDO-CODE STREAM
+ DCA USECON /STORE IN PAGE 0 SLOT
+ JMP I [ILOOP /RETURN
+
+ PAGE
+\f/ARRAY INSTRUCTIONS
+/ARRAY INSTRUCTIONS WORK BY FINDING THE ADDRESS OF THE ARGUMENT FROM THE ARRAY SYMBOL
+/TABLE,THEN CALLING THE APPROPRIATE FLOATING POIN PACKAGE ROUTINE.
+
+ARRAYI, TAD MODESW /WHICH MODE?
+ SZA CLA
+ JMP SARRAY /SMODE
+ TAD INSAV /GET ARRAY INSTRUCTION
+ AND K0037 /MASK OFF ARRAY OPERAND
+ CLL RTL /MULTIPLY BY 4 (ENTRY LENGTH)
+ TAD ARSTRT /MAKE POINTER INTO ARRAY TABLE
+ DCA XR1 /POINTS TO ARRAY FOR THIS OPERATION
+ATABDF, . /CHANGE DF TO ARRAY TABLE FIELD (SET BY START)
+ TAD I XR1 /GET POINTER TO FIRST ARRAY ELEMENT
+ DCA TEMP2 /SAVE FOR LATER
+ TAD I XR1 /GET DF FOR VARIABLE
+ DCA ADFC /PUT IN LINE AT END OF ROUTINE
+ TAD I XR1 /GET ARRAY DIMENSION 1
+ DCA TEMP3 /SAVE
+ TAD S1 /GET SUBSCRIPT 1
+ CLL CMA /SET UP 12 BIT COMPARE
+ TAD TEMP3 /DIMENSION 1 +1
+ SNL CLA /S1 TOO BIG?
+SU, JMS I [ERROR /YES-SUBSCRIPT OUT OF BOUNDS ERROR
+ DCA TEMP6 /CLEAR TEMPORARY
+ TAD I XR1 /GET DIMENSION 2
+ SNA /IS SECOND DIMENSION 0?(ARRAY UNIDIMENSIONAL)
+ JMP ADCALC /YES-DON'T CHECK S2 FOR OUT OF BOUNDS
+ DCA ARJMP /SAVE DIM2+1
+ TAD S2 /GET SUBSCRIPT 2
+ CLL CMA /SAVE 12 BIT COMPARE
+ TAD ARJMP
+ SNL CLA /S2 BIGGER THAN DIM2?
+ JMP SU /YES
+ TAD S2 /MULTIPLY DIM1+1 BY S2
+ JMS I [MPY /12 BY 12 MULTIPLY ROUTINE
+ADCALC, CLL
+ TAD S1 /LORD OF S1+(DIM1+1)*S2
+ DCA TEMP5 /SAVE
+ RAL /CARRY TO BIT 11
+ TAD TEMP6 /HORD OF S1+(DIM1+1)*S2
+ DCA TEMP6 /SAVE
+ TAD TEMP5 /LORD OF S1+(DIM1+1)*S2
+ CLL RAL /*2
+ DCA TEMP7 /LORD OF [S1+(DIM1+1)*S2]*2
+ TAD TEMP6 /HORD OF S1+(DIM1+1)*S2
+ RAL /*2
+ DCA TEMP3 /HORD OF [S1+(DIM1+1)*S2]*2
+ CLL
+ TAD TEMP5 /LORD OF S1+(DIM1+1)
+ TAD TEMP7 /LORD OF [S1+(DIM1+1)*S2]
+ DCA TEMP7 /LORD OF 3*[S1+(DIM1+1)*S2]
+ RAL /CARRY TO BIT 11
+ TAD TEMP6 /HORD OF [S1+(DIM1+1)*S2)*2
+ TAD TEMP3 /HORD OF S1+(DIM1+1)*S2
+ DCA TEMP6 /HORD OF 3*[S1+(DIM1+1)*S2]
+ CLL
+ TAD TEMP7 /INDEX TO ELEMENT
+ TAD TEMP2 /AC POINTS TO CORRECT ARRAY ELEMENT
+ DCA XR1 /SAVE POINTER
+ RAL /CARRY TO BIT 11
+ TAD TEMP6 /COMBINE TO MAKE TOTAL # OF FIELD OVERLAPS
+ CLL RTL
+ RAL /SLIDE OVERLAPS TO FIELD BITS (6-8)
+ TAD ADFC /ADD ANY CHANGE IN DATA FIELD TO CDF
+ DCA ADFC /PUT ABSOLUTE CDF IN LINE
+ TAD INSAV /GET ARRAY INSTRUCTION AGAIN
+ AND [340 /MASK OFF ARRAY OPCODE
+ CLL RTR
+ RTR
+ RAR /SLIDE TO BITS 9-11
+ TAD JMPI2 /AND USE AS INDEX INTO JUMP TABLE
+ DCA ARJMP /PUT JUMP IN LINE OF CODE
+ IAC
+ DCA FF /PUT FPP IN "SPECIAL MODE"
+ADFC, . /CHANGE DF TO DF OF ARRAY ELEMNT
+ TAD XR1 /AC POINTS TO ARRAY ELEMENT
+ARJMP, . /PERFORM THE REQUIRED OPERATION
+ NOP /FPP SOMETIMES RETURNS TO CALL+2
+ JMP I [ILOOP /DONE
+
+/ARRAY JUMP TABLE
+
+AJT, FFSUB1 /FAC=A(S1,S2)-FAC OPCODE 0
+ FFADD /FAC=FAC+A(S1,S2) OPCODE 1
+ FFSUB /FAC=FAC-A(S1,S2) OPCODE 2
+ FFMPY /FAC=FAC*A(S1,S2) OPCODE 3
+ FFDIV /FAC=FAC/A(S1,S2) OPCODE 4
+ FFGET /FAC=C(A(S1,S2) OPCODE 5
+FPUTLL, FFPUT /C(A(S1,S2)=FAC OPCODE 6
+ FFDIV1 /FAC=A(S1,S2)/FAC OPCODE 7
+\f /STRING ARRAY DISPATCH
+
+SARRAY, TAD INSAV /GET INSTRUCTION
+ AND [340 /ISOLATE ARRAY OPCODE
+ CLL RTR
+ RTR /AND SLIDE IT OVER FOR AN OFFSET
+ RAR
+ TAD JMPISA /BUILD A JUMP TO STRING INSTRCUTION
+ DCA SAD /AND PUT IN LINE
+ STL /TELL SFIND TO USE ARRAY TABLE
+ JMS I STFILK /SET UP ARGUMENT ADDRESS
+SAD, . /EXECUTE INSTRCUTION
+
+/STRING ARRAY JUMP TABLE
+/USED WHEN ARRAYI CALLED IN SMODE
+/ A "/*" IN THE COMMENT MEANS THAT OPCODE IS UNDEFINED AND THE SLOT
+/IN THE TABLES IS USED FOR NORMAL STORAGE
+
+JMPISA, JMP I .+1 /DISPATCH JUMP FOR STRING ARRAY INSTRUCTIONS
+
+ SCON1 /SAC_SAC&C(A$(S1))
+ SCOMP /SKIP IF SAC=C(A$(S1))
+ SREAD /A$(S1)_DEVICE
+K0037, 37 /*
+STFILK, STFIND /* LINK TO STRING FINDING ROUTINE
+ SLOAD /SAC_C(A$(S1))
+ SSTORE /C(A$(S1))_SAC
+JMPI2, JMS I AJT /* DISPATCH JUMP FOR ARRAY INST
+\f/ROUTINE TO PUT ONE WORD IN FILE BUFFER IN FIELD 1
+
+BCPUT, 0
+ DCA TEMP6 /SAVE AC
+ JMS I [IDLE /CHECK IF FILE OPEN
+ TAD I IOTPTR /GET READ/WRITE POINTER
+ DCA TEMP7 /SAVE
+ TAD ENTNO /GET FILE #
+ SZA CLA /IF TTY,BUFFER FIELD IS 0
+ CDF 10
+ TAD TEMP6 /GET WORD TO STORE AGAIN
+ DCA I TEMP7 /STORE IT IN BUFFER
+CDF0, CDF
+ TAD I IOTHDR /HEADER WORD
+ AND (7737 /TURN OFF BLOCK WRITTEN BIT
+ TAD (40 /TURN IT ON AGAIN
+ DCA I IOTHDR
+ JMP I BCPUT /RETURN
+
+ PAGE
+\f/TELETYPE DRIVING ROUTINE
+/2 ENTRY POINTS-XPUTCH PUTS A CHARCTER IN THE RING BUFFER
+/ XPRINT TYPES A CHARACTER IF POSSIBLE
+/ AND RETURNS TO CALL+1 IF THERE
+/ ARE MORE CHARCTERS IN THE BUFFER,CALL+2
+/ IF THE BUFFER IS EMPTY
+/THE IDEA IS THE PLACE CALLS TO XPRINT AT VARIOUS POINTS IN THE INTER-
+/PRETER AND THUS KEEP THE TTY BUSY WITHOUT WASTING THE TIME WAITING FOR
+/THE TTY FLAG. THE SUCCESS OF THIS SCHEME DEPENDS HEAVILY ON THE NUMBER
+/AND PLACEMENT OF THE CALLS TO XPRINT.
+
+XPUTCH, 0
+ DCA CHRSAV /SAVE THE CHARACTER
+XPUT1, ISZ SPINNR /SPIN RANDOM # SEED
+ JMS XPRINT /START A CHAR IF POSSIBLE
+ NOP
+ TAD BCNT /GET THE NUMBER OF AVAILABLE SLOTS
+ SNA CLA /ARE THERE ANY?
+ JMP XPUT1 /NO-TRY TO RPINT 1 AND FREE UP A SPACE
+PUTCHR, TAD CHRSAV /GET CHARACTER AGAIN
+ DCA I BUFIN /PUT CHARACTER IN RING BUFFER
+ ISZ BUFIN /BUMP BUFEER POINTER OF INPUT
+ CLA CLL CMA /-1 IN AC
+ TAD BCNT /DECREMENT AVAILABLE SLOT COUNT
+ DCA BCNT
+ TAD BUFIN /GET BUFFER INPUT POINTER
+ TAD MBEND /SUBTRACT ADDR OF END OF BUFFER
+ SPA SNA CLA /PAST EDN OF BUFFER?
+ JMP I XPUTCH /NO-RETURN
+ TAD BSTRTA /YES-RESET INPUT POINTER TO BEGINNING OF BUFFER
+ DCA BUFIN
+ JMP I XPUTCH /RETURN
+
+BUFIN, BSTRT /POINTER TO NEXT SLOT FOR BUFFER INPUT
+BUFOUT, BSTRT /POINTER TO NEXT CHARACTER TO BE PRINTED
+BSTRTA, BSTRT /ADDR OF START OF TTY BUFFER
+BCNT, 30 /# OF AVAILABLE SLOTS IN BUFFER (40 INITIALLY)
+CHRSAV=TEMP1
+MBEND, -BEND /-ADDR OF END OF RING BUFFER
+MCTRLC, -3
+M50, -30
+MXON, -21+3
+MXOFF, -23+21
+XFLAG, 0
+
+
+XPRINT, 0
+ KSF /IS KEYBOARD FLAG UP?
+ JMP NOCC /NO-NO CHANCE FOR A CTRL/C
+ KRB /YES-GET THE CHAR IN KEYBOARD BUFFER
+ AND [177 /GET RID OF PARAITY
+ TAD MCTRLC /IS IT CTRL/C
+ SNA
+ JMP I FSTOP1 /YES-ABORT TO EDITOR
+ TAD MXON
+ SZA
+ JMP .+3
+ DCA XFLAG
+ JMP NOCC+3
+ TAD MXOFF
+ SZA CLA
+ JMP NOCC
+ ISZ XFLAG
+ JMP XPRINT+1
+NOCC, TAD XFLAG
+ SZA CLA
+ JMP XPRINT+1
+ TAD BCNT /# OF AVAILABLE SLOTS IN BUFFER
+ TAD M50 /IS BUFFER EMPTY?
+ SNA CLA
+ JMP RECP2 /YES-RETURN TO CALL+2
+ TSF /NO-TTY FLAG UP YET?
+ JMP I XPRINT /NO-GO ABOUT YOUR BUSINESS
+ TAD I BUFOUT /GET NEXT CHARACTER
+/*****************************************************************:
+/N.B. BECAUSE OF THE ABOVE INSTRUCTION,THE DF MUST BE SET TO THE
+/INTERPRETER FIELD WHENEVER XPRINT IS CALLED. WATCH YOUR HOOK PLACEMENT!
+/****************************************************************:
+ JMS I (PCH /TYPE THE CHAR
+ ISZ BUFOUT /BUMP BUFFER OUTPUT POINTER
+ TAD BUFOUT /GET OUTPUT POINTER
+ TAD MBEND /SUBTRACT END OF BUFFER
+ SPA SNA CLA /IS OUTPUT POINTER PAST END?
+ JMP BOUTRS /NO-FREE UP A SPOT
+ TAD BSTRTA /YES-RESET POINTER TO BEGINNING
+ DCA BUFOUT
+BOUTRS, ISZ BCNT /INCREMENT # OF FREE SLOTS (WE JUST PRINTED ONE)
+ JMP I XPRINT /RETURN
+
+RECP2, ISZ XPRINT /BUMP RETURN
+ JMP I XPRINT /RETURN TO CALL+2 FOR EMPTY BUFFER
+
+
+/TELETYPE RING BUFFER
+
+BSTRT, "B /START OF BUFFER
+ "R
+ "T
+ "S
+ "
+ "V
+VERLOC, 260+VERSON
+ 300+SUBVER
+ 0215
+ 0212
+VEREND, 0212
+VCHECK, 0
+ CDF 10
+ TAD I N7644
+ CDF 0
+ AND XR4
+ SNA CLA
+ JMP I VCHECK
+ TAD XR1
+ DCA BUFIN
+ TAD SACXR
+ DCA BCNT
+ JMP I VCHECK
+BEND,
+N7644, 7644
+
+\f /LINE NUMBERS
+
+LINEI, TAD INSAV /GET INSTRUCTION
+ DCA LINEHI /SAVE
+ JMS I [PWFECH /GET WORD FOLLOWING LINE # INST
+ DCA LINELO /SAVE AS LOW ORDER LINE #
+TRHOOK, JMP I [ILOOP /RETURN TO I-LOOP
+ TAD KC240 /IF TRACE IS ON,FAKE CALL
+ DCA INSAV /TO FUNC2,#12
+ JMP I .+1
+ FUNC2I /DISPATCH TO TRACE FUNCTION
+
+/INTERMEDIATE TTY BUFFER
+/USED TO BUFFER OUTPUT FROM FPP BEFORE WE PUT IT
+/IN BASIC FORMAT FOR TRANSPORTATION TO THE TTY RING
+/BUFFER
+
+KC240, 240 /STOPPER TO MARK BEGINNING OF BUFFER
+INTERB,
+START3, TAD CDFPS /CDF FOR PSEUDO-CODE
+ DCA I [CDFPSU /PUT IN-LINE TO ILOOP
+ TAD PSSTRT /START OF PSEUDO-CODE
+ DCA I INTPCK /PUT INTO PC
+ JMS I [FACCLR /ZERO FAC
+ TAD CDFIO /CDF FOR SYMBOL TABLE FIELD
+ DCA I STDFL /PUT IN LINE FOR STRING FUNCTIONS
+FPPTM5, TAD CDFIO /CDF FOR SYMBOL TABLES
+ DCA I ATABDL /PUT IN LINE FOR ARRAY CALCULATIONS
+ TAD CDFIO /CDF FOR SCALAR TABLE
+FPPTM4, DCA I SCALDL /PUT IN LINE FOR ARGPRE
+ TAD CDFIO
+ DCA I DLCDFL /DATA FIELD FOR DATA LIST
+FPPTM3, TAD DLSTRT
+ DCA DATAXR /DO A RESTORE IN INCORE DATA LIST
+ JMP I .+1 /CONTINUE INITAILIZATION CODE IN TTY INPUT BUFFER
+FPPTM2, START4
+ATABDL, ATABDF
+STDFL, STDF
+FPPTM1, /FLOATING POINT TEMPORARY
+INTPCK, INTPC
+DLCDFL, DLCDF
+SCALDL, SCALDF
+
+ PAGE
+\f /VT52 DELAY PARAMETERS (MUST BE AT BEGINNING OF PAGE)
+
+HEIGHT, 0 /NEGATIVE SCREEN HEIGHT
+DELAY, 0 /NEGATIVE DELAY VALUE
+ IFNZRO HEIGHT-1200 <__FIX SET COMMAND__>
+HCTR, 0 /HEIGHT COUNTER INITIALIZED BY SET
+DCTR, 0 /DELAY COUNTER INITIALIZED BY SET
+
+ /LOW LEVEL ROUTINE TO TYPE A CHAR
+
+PCH, 0
+ TSF /WAIT FOR PREV CHAR
+ JMP .-1
+ TLS /TYPE THE CURRENT ONE
+ AND [177 /MASK TO 7BIT
+ TAD (-15 /TEST IF LINE FEED WILL BE SENT NEXT
+ SZA CLA
+ JMP I PCH /RETURN IF NOT
+ ISZ HCTR /TEST SCREEN HEIGHT IF LF
+ JMP I PCH /RETURN IF NOT AT BOTTOM OF SCREEN
+ TAD HEIGHT
+ DCA HCTR /RESET HEIGHT COUNTER NOW
+ TAD DELAY
+ SNA /TEST FOR ZERO DELAY
+ JMP I PCH /RETURN IF SO
+ DCA DCTR /ELSE SET DELAY COUNTER
+DLOOP, ISZ PSWAP /NOW EXEC INNER LOOP 4096 TIMES (USUALLY)
+ JMP .-1
+ KSF /TEST IF KEY STRUCK
+ SKP
+ JMP I PCH /RETURN AT ONCE IF YES
+ ISZ DCTR /TEST DELAY TIMER
+ JMP DLOOP /REITERATE
+ JMP I PCH /NOW ALLOW PRINTING TO CONTINUE
+
+ /OPERATE CLASS INSTRUCTIONS
+
+OPERI, TAD INSAV /GET OPERATE INSTRUCTION
+ AND [17 /MASK OFF OPERATE OPCODE
+ TAD JMPI3 /BUILD JUMP OFF OPERATE JUMPTABLE
+ DCA .+1 /STORE THE JUMP IN LINE
+ . /DISPATCH TO PROPER OPERATE ROUTINE
+
+JMPI3, JMP I .+1 /JUMP TO OPERATE ROUTINE CALLED FOR
+
+ /OPERATE JUMP TABLE
+
+ FUNC3I /CALL RESIDENT FUNCTION OPCODE 0
+ SPFUNC /SPECIAL FUNCTIONS OPCODE 1
+ SFN /SET FILE NUMBER OPCODE 2
+ FNEGI /NEGATE FAC OPCODE 3
+ RETRNI /GOSUB RETURN OPCODE 4
+ RESTOR /RESTORE DEVICE OPCODE 5
+ LSUB1I /LOAD S1 FROM FAC OPCODE 6
+ LSUB2I /LOAD S2 FROM FAC OPCODE 7
+MSPACE, 20 /THIS OPCODE NOT DEFINED,SO WE PUT A CONST HERE
+ READI /READ DEVICE OPCODE 11
+ WRITEI /WRITE DEVICE OPCODE 12
+ SWRITE /STRING WRITE OPCODE 13
+ FUNC5I /CALL FILE FUNCTION OPCODE 14
+ FUNC4I /CALL USER FUNCTION OPCODE 15
+ FUNC1I /CALL FUNCTIONS 1 OPCODE 16
+ FUNC2I /CALL FUNCTIONS 2 OPCODE 17
+\f/ROUTINE TO SWAP PG 17600 WITH N7400 OR N7600 (WHICHEVER THE CASE MAY BE)
+/WHERE N IS THE HIGH CORE FIELD
+
+PSWAP, 0
+ TAD KK7600 /POINTER TO 17600 AND COUNTER
+ DCA TEMP1
+ TAD PSFLAG /GET SWAPPING FLAGS
+ RAR
+ CML RAL /TOGGLE THE INPLACE BIT
+ DCA PSFLAG /STORE IT BACK
+ TAD HICORE /PICK UP ADDR OF HIGH CORE
+ DCA TEMP2 /POINTER TO HIGH CORE
+P1CDF, HLT /DF TO HI CORE
+ TAD I TEMP2 /GET WORD FROM HI CORE
+ DCA TEMP4 /SAVE IT
+P2CDF, CDF 10
+ TAD I TEMP1 /GET WORD FROM 17600
+P1CDF1, HLT /DF TO HI CORE AGAIN
+ DCA I TEMP2 /PUT 17600 WORD IN HI CORE
+P2CDF1, CDF 10
+ TAD TEMP4 /GET SAVED HI CORE WORD
+ DCA I TEMP1 /AND PUT IN 17600
+ ISZ TEMP2 /BUMP HI CORE POINTER
+KK7600, 7600 /CLA
+ ISZ TEMP1 /BUMP 17600 POINTER AND CHECK FOR DONE
+ JMP P1CDF /NO DONE-MOVE NEXT WORD
+ CDF
+ JMP I PSWAP /DONE-RETURN
+HICORE, 0 /POINTS TO LOCATION OF 17600 SAVE AREA
+
+ IFNZRO EAE <
+
+ /TEMPORARY INCLUSION FOR FFOUT
+
+ /ADD OP TO FAC
+
+OADD, 0
+ CLL
+ TAD AC2
+ TAD AC1
+ DCA AC1 /ADD GUARD BITS
+ RAL
+ TAD OPL
+ TAD ACL
+ DCA ACL /ADD LOW ORDER BITS
+ RAL
+ TAD OPH
+ TAD ACH
+ DCA ACH /ADD HIGH ORDER BITS
+ JMP I OADD
+
+ /SHIFT FAC LEFT 1 BIT
+
+AL1, 0
+ TAD AC1
+ CLL RAL
+ DCA AC1
+ TAD ACL
+ RAL
+ DCA ACL
+ TAD ACH
+ RAL
+ DCA ACH
+ JMP I AL1
+ >
+ PAGE
+\f /LOAD SUBSCRIPT 1 OR 2 FROM FAC OR MEMORY
+
+LSUB2I, ISZ DCASUB
+ JMP LSUB1I
+LS2I, ISZ DCASUB
+LS1I, JMS I [FACSAV /PRESERVE FAC
+ JMS I ARGPRL /GET ARG POINTER INTO AC
+ JMS I [FFGET /LOAD ARG INTO FAC (SKIPS NEXT INST ON RETURN)
+LSUB1I, JMS I [FACSAV /SAVE THE FAC
+ JMS I [UNSFIX /GET INT(FAC)
+DCASUB, DCA S1 /SET RESULT AS SUBSCRIPT 1
+ JMS I [FACRES /RESTORE FAC
+ TAD DCAS1
+ DCA DCASUB /FUDGE INSTR BACK
+ JMP I [ILOOP /NEXT INSTRCUTION
+DCAS1, DCA S1
+ARGPRL, ARGPRE
+
+/JMP DISPATCH FOR FUNC1 CALLS
+
+JMSI4, JMS I .+1 /CALL FOR CANNED FUNCTION SET 1
+
+/JUMP TABLE FOR FUNCTION CALL 1
+
+ ATAN /FUNCTION BITS= 0
+ COS / 1
+ EXPON1 / 2
+ EXPON / 3
+ INT / 4
+ LOG / 5
+ SGN / 6
+ SIN / 7
+ RND / 10
+ FROOT / 11
+
+/JUMP FOR FUNC2 DISPATCH
+
+JMSI5, JMP I .+1 /JMP OFF THE SET 2 TABLE
+
+/JUMP TABLE FOR FUNCTION SET 2
+
+ ASC /FUNCTION BITS= 0
+ CHR / 1
+ DATE / 2
+ LEN / 3
+ POS / 4
+ SEG / 5
+ STR / 6
+ VAL / 7
+ ERRORR / 10
+/ERRORR MUST BE FUNCTION #10,ELSE "ERROPC" MUST CHANGE
+ TRACE / 11
+ TPRINT / 12
+/TPRINT MUST BE #12 OR TRHOOK+1 MUST CHANGE
+
+/DISPATCH FOR FUNC5 CALLS
+
+JMPFIL, JMP I .+1 /CALL FORR FILE MANIPULATING FUNCTIONS
+
+/JUMP TABLE FOR FILE FUNCTIONS
+
+ CHAIN /FUNCTION BITS= 0
+ CLOSE / 1
+ OPENAF / 2
+ OPENAV / 3
+ OPENNF / 4
+ OPENNV / 5
+ FSTOP /INT. EXIT 6
+
+/ERROR CALL FOR USER FUNCTIONS-USER FUNCTION SHOULD "JMS I (IA"
+
+IA, JMS I [ERROR
+\f /FUNCTION OVERLAY DRIVER
+
+FUNC4I, JMS I [XPRINT /PURGE TTY RING BUFFER
+ JMP .-1 /BEFORE CALLING USER FUNCTION
+ IAC /LOOK FOR OVERLAY FLAG=3
+FUNC5I, IAC /LOOK FOR OVERLAY FLAG=2
+FUNC2I, IAC /LOOK FOR OVERLAY FLAG=1
+FUNC1I, DCA TEMP1 /LOOK FOR OVERLAY FLAG=0
+ CDF /DF TO THIS FIELD
+ TAD TEMP1 /GET OVERLAY # AGAIN
+ CIA /NEGATE
+ TAD OVRLAY /COMPARE AGAINST OVERLAY FLAG
+ SNA CLA /IS THE ONE WE WANT ALREADY RESIDENT?
+ JMP OVDNE /YES-JUST JUMP TO FUNCTION
+ TAD TEMP1 /NO-GET NUMBER OF OVERALY DESIRED
+ TAD OATADI /USE AS OFFSET TO BUILD STARTING BLOCK TAD
+ DCA TEMP2 /POINTS TO PROPER STARING BLOCK #
+ TAD I TEMP2 /GET STARTING BLOCK FOR THIS OVERLAY
+ DCA OVADD /PUT IN DRIVER CALL
+ JMS I L7607 /CALL SYSTEM HANDLER
+ 0500 /OVERLAY 3400-4600
+ 3400
+OVADD, . /STARTING BLOCK # OF OVERLAY
+OE, JMS I [ERROR /I/O ERROR
+ TAD TEMP1
+ DCA OVRLAY /CHANGE RESIDENT FLAG
+OVDNE, TAD [SAC-1 /ENTER STRING FUNCTIONS WITH SACXR SET UP
+ DCA SACXR
+ TAD TEMP1 /FUNCTION #
+ TAD JMSTAD /BUILD A TAD OF THE PROPER DISPATCH JMS
+ DCA .+2 /PUT IN LINE
+ JMS I [FBITGT /GET # OF FUNCTION DESIRED
+ . /BUILD JUMP OFF JUMP TABLE
+FUJUMP, DCA .+1 /PUT JUMP IN LINE
+ . /GO TO DESIRED FUNCTION
+ JMP I [ILOOP /DONE
+
+OATADI, ARITHA
+L7607, 7607
+OVRLAY, 0 /# OF CURRENTLY RESIDENT OVERLAY
+ /0=ARITHMETIC,1=STRING,2=FILE,3=USER
+
+/OVERLAY TABLE-CONTAINS STARTING BLOCK # OF SYSTEM OVERLAYS
+/INITIALIZED BY LOADER
+
+ARITHA, . /STARTING BLOCK OF ARITHMETIC OVERLAY
+STRNGA, . /STARTING BLOCK OF STRING OVERLAY
+FILEFA, . /STARTING BLOCK OF FILE OVERLAY
+USRA, . /STARTING BLOCK OF USER FUNCTIONS
+
+JMSTAD, TAD I TADTAB
+
+TADTAB, JMSI4
+ JMSI5
+ JMPFIL
+ JMSUSR
+
+\f/CALL FOR RESIDENT FUNCTION
+
+FUNC3I, JMS I [FBITGT /ISOLATE FUNCTION #
+ TAD JMSI7 /MAKE A JUMP OFF JUMP TABLE
+ JMP FUJUMP /PUT THE JUMP IN LINE AND EXECUTE IT
+
+JMSI7, JMP I .+1
+
+/JUMP TABLE FOR RESIDENT FUNCTIONS
+
+ XABSVL /FUNCTION BITS= 0
+ COMMA / 1
+ CRFUNC / 2
+ ILOOPF / 3
+ TAB / 4
+ PNT / 5
+ USE / 6
+
+
+ *1557 /****N.B.****
+ /THIS TABLE CANNOT BE MOVED!!!!
+
+/JUMP DISPATCH FOR USER ROUTINES
+JMSUSR, JMS I .+1
+
+/JUMP TABLE FOR USER FUNCTIONS
+ ILOOPF /USER FUNCTION 1
+ ILOOPF / 2
+ ILOOPF / 3
+ ILOOPF / 4
+ ILOOPF / 5
+ ILOOPF / 6
+ ILOOPF / 7
+ ILOOPF / 8
+ ILOOPF / 9
+ ILOOPF / 10
+ ILOOPF / 11
+ ILOOPF / 12
+ ILOOPF / 13
+ ILOOPF / 14
+ ILOOPF / 15
+ ILOOPF / 16
+
+ PAGE
+\f/SPECIAL FUNCTIONS
+
+SPFUNC, JMS I [FBITGT /ISOLATE FUNCTION BITS
+ TAD JMPI6 /MAKE A JUMP OFF SPECIAL FUNCTION TABLE
+ DCA .+1 /PUT IN LINE
+ .
+
+JMPI6, JMP I .+1 /JUMP TO SPECIAL FUNCTION ROUTINE
+
+/SPECIAL FUNCTION JUMP TABLE
+
+ SETF /SET FSWITCH 0
+ FRANDM /RANDOMIZE 1
+ FSTOPN /LEAVE INTERPRETER 2
+ SRLIST /STRING READ FROM DATA LIST 3
+ CSFN /SET FILE # TO TTY 4
+ RDLIST /READ DATA LIST 5
+ AMODE /SWITCH TO A MODE 6
+ SSMODE /SWITCH TO S MODE 7
+\f/SUBROUTINE UNSFIX-UNSIGNED INTEGER FIX ROUTINE. FIXS A POSITIVE 12 BIT
+/NUMBER OUT OF FAC MANTISSA AND LEAVES RESULT IN AC.RESULT IS AN UNSIGNED,
+/12 BIT INTEGER
+
+UNSFIX, 0
+ CDF 0
+ TAD ACL /LOW MANTISSA
+ CLL RAL /HI BIT OF LO MANTISSA TO LINK
+ CLA
+ TAD ACH /HIGH MANTISSA
+ SPA /IS NUMBER POSITIVE?
+FM, JMS I [ERROR /NO-BOO!!!
+ RAL /SHIFT THE SIGN BIT OUT AND THE MANTISSA OVER,
+ DCA ACH /MAKING 12 BITS OF MANTISSA AND BINARY POINT BEFORE BIT 0
+ TAD ACX /GET EXPONENT
+ SPA SNA CLA /IS X>1?
+ JMP I UNSFIX /NO-FIX IT TO 0
+ TAD ACX /YES-GET EXPONENT
+ TAD [-14 /SET BINARY POINT AT 12
+ SNA /DONE ALREADY?
+ JMP UNSOUT /YES
+ SMA /NO-IS # TOO BIG?
+FO, JMS I [ERROR /YES
+ DCA ACX /NO-STORE COUNT
+ TAD ACH /HI MANTISSA
+UNSLP, CLL RAR /SCALE RIGHT
+ ISZ ACX /DONE?
+ JMP UNSLP /NO
+ JMP I UNSFIX /YES-RETURN
+
+UNSOUT, TAD ACH /ANSWER IN AC
+ JMP I UNSFIX
+
+/RESTORE ROUTINE
+
+RESTOR, TAD ENTNO /GET CURRENT FILE #
+ SNA CLA /IS IT 0?
+ JMP RESDLS /YES-RESTORE DATA LIST
+ JMS I (WRBLK /NO-WRITE CURRENT BUFFER
+ STA /-1
+ TAD I IOTLOC /STARTING BLOCK-1
+ DCA I IOTBLK /SET CURRENT BLOCK #
+ TAD I IOTBUF /GET BUFFER ADDRESS
+ DCA I IOTPTR /USE IT TO RESET READ\WRITE POINTER
+ TAD I IOTHDR /GET HEADER WORD
+ AND (7435 /CLEAR EOF BIT,BUFFER WRITTEN BIT,AND CHAR #
+ DCA I IOTHDR
+ JMS I [NEXREC /READ FIRST BLOCK INTO BUFFER
+ JMP I [ILOOP /DONE
+RESDLS, TAD DLSTRT /ADDRESS OF START OF INCORE DATA LIST
+ DCA DATAXR /USE IT TO RESET DATA LIST POINTER
+ JMP I [ILOOP /THATS ALL!
+\f/SUBROUTINE STFIND-WHEN CALLED,IF LINK=1 STRING ARRAY TABLE IS
+/USED,IF LINK=0 STRING SYMBOL TABLE IS USED. RETURNS WITH AC SET
+/TO CDF OF OPERAND STRING,STRPTR POINTING TO THE FIRST WORD
+/IN THE STRING, AND THE MAX LENGTH OF THE STRING IS IN STRMAX. ALSO,
+/THE ACTUAL LENGTH OF THE STRING IS IN STRCNT
+
+STFIND, 0
+ SZL /IS THIS AN ARRAY INST?
+ JMP SAFIND /YES-POINTER IS INTO ARRAY TABLE
+ TAD INSAV /GET INST AGAIN
+ AND [377 /ISOLATE OPERAND POINTER
+ DCA TEMP1 /NO-SAVE OPERAND POINTER
+ TAD TEMP1 /N
+ CLL RAL /2N
+ TAD TEMP1 /3N (3 WORDS/ENTRY)
+ TAD STSTRT /ADD BASE ADR OF STRING TABLE
+STCOM, DCA XR2 /POINTER TO THIS ENTRY IN STRING TABLE
+STDF, . /DF TO THAT OF SYMBOL TABLES (SET BY START)
+ TAD I XR2 /GET POINTER TO STRING
+ DCA STRPTR
+ TAD I XR2 /GET CDF FOR OPERAND STRING
+ DCA STRCDF /SAVE
+ TAD I XR2 /GET -(MAX LENGTH OF STRING)
+ DCA STRMAX /SAVE
+ SNL /ARRAY ELEMENT?
+ JMP STRCDF /NO-SKIP THIS SUBSCRIPT CALCULATION
+ TAD S1 /GET SUBSCRIPT
+ CLL CMA /SET UP 12 BIT COMPARE
+ TAD I XR2 /GET DIMENSION
+ SNL CLA /IS S1>DIMENSION?
+ JMP I (SU /YES
+ TAD STRMAX /NO-GET ELEMENT LENGTH
+ CIA /MAKE POSITIVE
+ CLL IAC /ROUND OFF TO NEAREST MULTIPLE OF 2
+ CLL RAR / DIVIDE BY TWO (COUNT/2=WORD COUNT)
+ CLL IAC /ADD A WORD FOR HEADER
+ DCA TEMP3 /# OF WORDS IN EACH ARRAY ELEMENT
+ TAD S1 /GET SUBSCRIPT
+ JMS I [MPY /S1*ELEMENT LENGTH (ASSUMES LINK UNCHANGED ON RETURN)
+ TAD STRPTR /ARRAY OFFSET+POINTER TO A(0)
+ DCA STRPTR /FINAL STRING POINTER
+ RAL /CARRY TO BIT 11
+ TAD TEMP6 /ADD TO ACCUMLATED OVERLAPS FROM MULTIPLY
+ CLL RTL
+ RAL /PUT OVERLAP # INTO BITS 6-8
+ TAD STRCDF /ADD TO CDF IF NECESSARY
+ DCA STRCDF /SAVE AGAIN
+STRCDF, 0 /DF TO STRING FIELD
+ TAD I STRPTR
+ CDF
+ DCA STRCNT /STORE -(CURRENT LENGTH OF STRING)
+ TAD STRCDF /CDF TO OPERAND IN AC
+ DCA I (SSTEX /SETUP STRING STORE EXIT DF HERE
+ JMS I (BYTSET /ENTER FUNCTIONS WITH BYTE POINTERS SETUP
+ JMP I STFIND /RETURN
+
+SAFIND, TAD INSAV /GET INST
+ AND (37 /ISOLATE OPERAND POINTER
+ CLL RTL /4N (4 WORDS/ENTRY)
+ TAD SASTRT /USE STRING ARRAY TABLE
+ STL /SET LINK FOR ARRAY INST
+ JMP STCOM /RETURN TO SUBROUTINE MAINLINE
+
+ /PNT(X)
+ /SEND 7BIT CHAR TO THE CURRENT FILE
+
+PNT, JMS I [UNSFIX /FIX X
+ AND [177 /STRIP TO 7 ASCII BITS
+ TAD [200 /FORCE CHANNEL 8
+ JMS I [PUTCH /PUT IN FILE BUFFER
+ JMP I [ILOOP /DONE
+
+ PAGE
+\f/ROUTINE SFN-ROUTINE TO RESET POINTERS IN PAGE ZERO FILE POINTER
+/AREA TO REFLECT A CHANGE IN THE CURRENT FILE NUMBER
+
+SFN, JMS I [UNSFIX /FIX FAC TO GET FILE #
+CSFN, DCA ENTNO /IF ENTRY IS HERE,FILE #=0 (TTY)
+ TAD ENTNO
+ STL
+ TAD (-4 /IS RESULT A LEGAL FILE #?
+ SNL SZA CLA
+FN, JMS I [ERROR /NO-ERROR
+ TAD ENTNO /PICK UP FILE NUMBER
+ CLL RTL
+ RTL
+ CIA
+ TAD ENTNO
+ CIA /MULTIPLY BY SIZE OF IOTABLE
+ IFNZRO IOTSIZ-15 <__ASSEMBLY ERROR__>
+ TAD (TTYF /ADD TO BASE
+ DCA XR1 /STORE IN TEMP
+ TAD (IOTHDR-1 /NOW POINT AT PAGE 0 AREA
+ DCA XR2
+ TAD (-IOTSIZ+3 /SETUP ALL BUT LAST 3
+ DCA TEMP2
+ TAD XR1
+ DCA I XR2
+ ISZ XR1
+ ISZ TEMP2
+ JMP .-4 /SET UP THE POINTERS NOW
+ JMP I [ILOOP /--RETURN--
+\f /GOSUB
+
+GOSUB, TAD I GSP
+ SMA CLA
+GS, JMS I [ERROR /ERROR IF STACK OVERFLOW
+ TAD I [CDFPSU /ELSE GET CDF INSTR
+ DCA I GSP
+ ISZ GSP
+ TAD I (INTPC
+ DCA I GSP /STORE INT PC
+ ISZ GSP
+ JMP I (SUCJMP /EXEC AS NORMAL GOTO NOW
+
+ /GOSUB RETURN
+
+RETRNI, STA
+ TAD GSP
+ DCA GSP /POP STACK
+ TAD I GSP /GET PC
+ DCA I (INTPC
+ STA
+ TAD GSP /POP STACK
+ DCA GSP
+ TAD I GSP
+ SMA
+GR, JMS I [ERROR /FATAL ERROR IF NO RETURN
+ DCA I [CDFPSU
+ JMP I (JFAIL /BUMP PC PAST ADDR WORD AND CONTINUE
+
+GSP, GSTCK /GOSUB STACK POINTER
+
+ /FOR-LOOP JUMP ROUTINE
+ /ENTER WITH AC = HORD
+
+JFOR, SNA /IS FAC=0?
+ JMP I (JFAIL /YES-DO NOT JUMP
+ TAD FSWITC /ADD FSWITCH
+ SPA CLA /ARE SIGN BIT=FSWITCH?
+ JMP I (JFAIL /NO-DO NOT JUMP
+ JMP I (SUCJMP /YES-DO JUMP
+
+/ROUTINE TO INITIALIZE FSWITCH
+
+SETF, AC4000
+ AND ACH /ISOLATE SIGN OF MANTISSA
+ DCA FSWITC /STORE IN FSWITCH
+ JMP I [ILOOP /DONE
+FSWITC, 0
+\f/ROUTINE TO RESET CHARACTER NUMBER TO 1
+
+CNOCLR, 0
+ TAD I IOTHDR
+ AND [7477 /SET CHAR BITS TO 0
+ DCA I IOTHDR
+ JMP I CNOCLR /RETURN
+
+ /ROUTINE TO ZERO THE CURRENT I/O BUFFER
+
+BLZERO, 0
+ STA
+ TAD I IOTBUF
+ DCA XR1 /POINT INTO THE BUFFER
+ TAD [7400
+ DCA CNOBML /SET COUNT TO 400 WORDS
+ TAD (232 /INSERT A ^Z IN THE BUFFER FIRST
+ CDF 10
+ DCA I XR1
+ ISZ CNOBML
+ JMP .-2 /LOOP FOR THE REST
+ CDF
+ JMP I BLZERO /--RETURN--
+
+ /BUMP 3 FOR 2 CHAR NUMBER FOR CURRENT FILE
+
+CNOBML, 0
+ TAD I IOTHDR /HEADER WORD
+ TAD [100 /ADD 1 TO THE COUNT BITS
+ DCA I IOTHDR
+ JMP I CNOBML /DONE
+\f /STRING COMPARE
+ /COMPARE SAC WITH MEMORY, BLANK EXTENDING THE
+ /SHORTER STRING ON THE RIGHT
+
+SCOMP, DCA MODESW /SET INTERPRETER TO ARITH MODE NOW
+ JMS I [FACCLR /TENTATIVELY ASSUME EQUAL (FAC = 0)
+SCOMLP, TAD STRCNT /IS THE MEMORY STRING EMPTY NOW?
+ SNA CLA
+ TAD L40 /PAD WITH SPACE IF YES
+ SNA
+ JMS I (LDB /LOAD NEXT BYTE IF NOT
+ DCA TEMP2
+ TAD SACLEN /NOW IS THE SAC EMPTY
+ SNA CLA
+ TAD L40 /YES, PAD IT
+ SNA
+ TAD I SACXR /NO GET IT
+ CLL CIA /COMPARE TO MEMORY
+ TAD TEMP2
+ SZA CLA
+ JMP SNEQ /JMP IF NOT EQUAL, L=SENSE OF COMPARE
+ TAD STRCNT /IS MEMORY STRING DONE
+ SZA CLA
+ ISZ STRCNT /NO, BUMP COUNT
+L40, 40 /EFFECTIVE NOP
+ TAD SACLEN /IS THE SAC EMPTY
+ SZA CLA
+ ISZ SACLEN /NO BUMP COUNT
+ TAD SACLEN /GET SAC REMAINDER (SKP IF IS JUST ZERO)
+ TAD STRCNT /ADD ARG REMAINDER
+ SZA CLA
+ JMP SCOMLP /LOOP IF BOTH NOT EMPTY
+ JMP I [ILOOP /OTHERWISE EQUAL
+SNEQ, STA RAR
+ DCA ACH /STORE SIGN BIT
+ JMP I [ILOOP /--RETURN--
+
+ PAGE
+\f /STRING DATA LIST READ, STRING LOAD AND STRING CONCATENATE
+
+SRLIST, JMS I (DLREAD /FIRST READ NEG BYTE COUNT
+ DCA STRCNT /STORE IT
+ STL /SET LINK MEANS USE PHONY DATA LIST BYTE LOAD
+ SKP /SKP INTO STRING LOAD ROUTINE
+SLOAD, CLL /CLEAR LINK TO USE NORMAL LOAD BYTE ROUTINE
+ DCA SACLEN /CLEAR SAC LENGTH COUNTER
+ SZL
+ TAD (DRGCH-LDB /USE PHONY LOAD BYTE
+SCON1, TAD (LDB /USE REAL LDB FOR CONCATENATE
+ DCA SCLDB
+ TAD STRCNT
+ SNA CLA
+ JMP I [ILOOP /NOTHING TO DO IF NULL STRING
+ TAD SACLEN /COMPUTE OFFSET INTO SAC
+ CIA
+ TAD [SAC-1
+ DCA SACXR /TO STORE AFTER END OF PREV STRING
+SEGCOM, JMS I SCLDB /GET A BYTE
+ DCA I SACXR /STORE IT
+ STA
+ TAD SACLEN /NOW BUMP SIZE OF SAC
+ DCA SACLEN
+ TAD SACLEN /CHECK IF ROOM LEFT
+ TAD (SACLIM
+ SPA CLA
+SC, JMS I [ERROR /FATAL ERROR IF SAC OVERFLOW
+ ISZ STRCNT
+ JMP SEGCOM /ITERATE IF MORE
+ JMP I [ILOOP /--RETURN--
+
+SCLDB, 0
+
+ /ROUTINE TO GET A BYTE FROM THE DATA LIST
+
+DRGCH, 0
+ TAD SACLEN /TEST FOR EVEN OR ODD
+ CLL RAR
+ SZL CLA
+ JMP CHR2 /SECOND CHAR
+ JMS I (DLREAD /FIRST CHAR, READ ANOTHER WORD
+ DCA DRCHR
+ TAD DRCHR
+ CLL RTR
+ RTR
+ RTR /SHIFT RIGHT
+ SKP
+CHR2, TAD DRCHR /GET SECOND CHAR
+ AND [77 /MASK TO 6BIT
+ JMP I DRGCH /RETURN
+
+DRCHR, 0
+\f
+/ROUTINE TO SET EOF BIT IN I/O ENTRY
+EOFSET, TAD I IOTHDR /HEADER
+ CLL RTR /EOF BIT TO LINK
+ STL RTL /SET LINK
+ /PUT LINK IN EOF BIT
+ DCA I IOTHDR /STORE IN I/O TABLE ENTRY
+ JMP I [ILOOP /EOF BIT SET-ABORT TO ILOOP
+
+/SUBROUTINE MPY- 12 BIT BY 12 BIT MULTIPLY. MULTIPLIES THE CONTENTS
+/OF TEMP3 BY THE CONTENTS OF THE AC,LEAVING THE HI RESULT IN TEMP6
+/AND THE LOW RESULT IN THE AC
+
+MPY, 0
+ DCA TEMP10
+ DCA TEMP6
+ TAD [-14
+ DCA TEMP5
+MP12LP, TAD TEMP3
+ RAR
+ DCA TEMP3
+ TAD TEMP6
+ SNL
+ JMP .+3 /12 BIT MULTIPLY USED TO FIND (DIM1+1)*S2
+ CLL
+ TAD TEMP10
+ RAR
+ DCA TEMP6
+ ISZ TEMP5
+ JMP MP12LP
+ TAD TEMP3 /LORD OF (DIM1+1)*S2 IN AC
+ RAR /HORD OF (DIM1+1)*S2 IN TEMP6
+ JMP I MPY /RETURN
+
+ /ROUTINE TO CHECK IF FILE IDLE
+
+IDLE, 0
+ TAD I IOTHND /GET HANDLER ENTRY
+ SNA CLA /IS IT EMPTY?
+FI, JMS I [ERROR /YES-USER TRIED TO DO SOMETHING TO AN UNOPEN FILE
+ JMP I IDLE /NO-RETURN
+\f/ROUTINE TO READ NEXT WORD IN DATALIST INTO AC
+
+DLREAD, 0
+ TAD DATAXR /DATA LIST POINTER
+ CLL CMA /SET UP 12 BIT COMPARE
+ TAD DLSTOP /ADDR OF END OF DATA LIST
+ SNL CLA /POINTER AT END OF LIST?
+DA, JMS I [ERROR /YES
+DLCDF, . /NO-DF TO DATA LIST
+ TAD I DATAXR /FETCH WORD FROM DATA LIST
+ CDF
+ JMP I DLREAD /DONE
+
+ /RANDOMIZE STATEMENT
+
+FRANDM, TAD SPINNR /USE SPINNR FOR NEW SEED FOR RND(X)
+ STL RAL /MAKE SURE SEED IS ODD
+ DCA RSEED
+ JMP I [ILOOP /DONE
+RSEED, 2713
+
+/SUBROUTINE CR,LF
+
+CRLFR, 0
+ TAD [215
+ JMS I [PUTCH
+ TAD (212
+ JMS I [PUTCH /PRINT A CR,AND LF
+ DCA I IOTPOS /ZERO NUMBER OF CHARS PRINTED SO FAR
+ JMP I CRLFR
+
+/SUBROUTINE FOTYPE
+/RETURNS TO CALL+1 IF FILE FIXED LENGTH,CALL+2 IF VARIABLE
+
+FOTYPE, 0
+ TAD I IOTHDR /GET HEADER
+ AND (4 /ISOLATE TYPE BIT
+ SZA CLA /IS IT FIXED LENGTH?
+ ISZ FOTYPE /NO-BUMP RETURN
+ JMP I FOTYPE /RETURN
+
+ /ABS(X) FUNCTION
+
+XABSVL, JMS ABSVAL /NEGATE FAC IF NEGATIVE
+ JMP I [ILOOP /--RETURN--
+
+ /SUBROUTINE TO TAKE ABS VALUE OF FAC
+
+ABSVAL, 0
+ TAD ACH
+ SPA CLA /IS FAC<0?
+ JMS I [FFNEG /YES-NEGATE IT
+ JMP I ABSVAL /RETURN
+
+/ROUTINE TO RESTORE THE FAC FROM FP TEMP
+
+FACRES, 0
+ JMS I [FFGET /GET FAC
+ INTERB
+ JMP I FACRES /RETURN
+
+ PAGE
+\f /STRING STORE
+
+SSTORE, TAD SACLEN
+ SNA
+ JMP I (SSTEX /EXIT IF NULL STRING IN SAC
+ DCA TEMP1 /SET COUNT
+ TAD SACLEN /SEE IF WILL FIT
+ CIA
+ TAD STRMAX
+ SMA SZA CLA /SKP IF LEN.LE.MAX LEN
+SL, JMS I [ERROR /ERROR IF TARGET STRING TOO SMALL
+ TAD I SACXR /PICK UP SAC BYTE
+ JMS I (DPB /STORE IT
+ ISZ TEMP1
+ JMP .-3
+ JMP I (SSTEX /--RETURN--
+
+ /STRING READ FROM FILE TO MEMORY
+
+SREAD, JMS I [GETCH /GET CHAR FROM FILE
+ TAD CHAR
+ TAD [-215 /IS IS CR?
+ SNA
+ JMP I (SSTEX /YES, EXIT
+ TAD (3 /IS IT LF?
+ SNA CLA
+ JMP SREAD /YES, IGNORE IT
+ TAD I (BYTCNT /SEE IF THIS CHAR WILL FIT
+ TAD STRMAX
+ SMA CLA
+ JMP ST /NO, SOFT ERROR
+ TAD CHAR /YES, STORE IT
+ JMS I (DPB
+ JMP SREAD
+ST, JMS I [ERROR
+ TAD [215 /FAKE OUT INPUT ROUTINE
+ DCA CHAR
+ JMP I (SSTEX /SET STRING SIZE AND EXIT
+\f /STRING WRITE FROM SAC TO DEVICE
+
+SWRITE, DCA COMMAS
+ TAD SACLEN /SEE IF NULL STRING
+ SNA
+ JMP I [ILOOP /RETURN IF SO
+ CIA
+ TAD I IOTPOS /ADD TO NUMBER OF CHARS PRINTED SO FAR
+ TAD (-WIDTH
+ SMA SZA CLA /SKP IF LE WIDTH OF LINE
+ JMS I [CRLFR /ELSE RESET CARRAIGE
+ TAD SACLEN
+ DCA STRCNT /SET LOOP COUNTER
+ TAD [SAC-1
+ DCA SACXR /POINT AT SAC
+SWRLP, TAD I SACXR
+ TAD (240
+ AND [77
+ TAD (240 /CONVERT TO 8BIT
+ JMS I (PUTCH
+ ISZ STRCNT
+ JMP SWRLP /ITERATE IF MORE
+ JMP I [ILOOP /--RETURN--
+
+\f/COMMA FUNCTION (KNOWN ONLY TO COMPILER FOR FORMATTING PRINT
+/STATEMENTS)
+
+COMMA, JMS I [FTYPE /SKP IF FILE IS ASCII
+ JMP I [ILOOP /NO-COMMA FUNCTION IS A NOP
+ TAD COMMAS /GET COMMA SWITCH
+ SNA CLA /WAS LAST THING PRINTED A COMMA?
+ JMP .+3 /NO-WE ARE OK
+ TAD (" /YES-PRINT A SPACE BEFORE DOING COMMA CALCULATION
+ JMS I [PUTCH
+ IAC
+ DCA COMMAS /SET COMMA SWITCH
+ TAD (-4
+ DCA TEMP2
+ TAD I IOTPOS /GET NUMBER OF CHARS PRINTED SO FAR
+COMLOP, TAD (-COLWID
+ SPA /PAST THIS ONE?
+ JMP SLOVER /YES-SLIDE PRINT HEAD TO START OF NEXT
+ SNA /EXACTLY ON A COLUMN?
+ JMP I [ILOOP /YES-DONE
+ ISZ TEMP2 /ALL MARKERS CHECKED YET?
+ JMP COMLOP /NO-DO NEXT
+ CLA /FALL INTO CR ROUTINE TO RESET COL TO 0
+
+/CARRIAGE RETURN FUNCTION (KNOWN ONLY TO COMPILER FOR TERMINATING
+/PRINT STATEMENTS)
+
+CRFUNC, TAD I IOTHDR
+ CLL RTR
+ SNL CLA /SKP IF EOF IS SET
+ JMS I [FTYPE /SKP IF FILE IS ASCII
+ JMP I [ILOOP /WE DON'T WANT TO OUTPUT CLFR
+ JMS I [CRLFR /DO AS WE ARE TOLD
+ JMP I [ILOOP /NEXT INST
+
+ /TAB FUNCTION
+
+TAB, JMS I [UNSFIX /FIX X TO INTEGER
+ CIA /NEGATE
+ TAD I IOTPOS /COMPARE DESIRED COLUMN TO REAL COLUMN
+ IAC /BUMP BY 1 (WORD 7=COL #-1)
+ SMA /IS X>=CURRENT COLUMN?
+ JMP I [ILOOP /YES-THEN DO NOTHING
+ /FALL INTO SPACE OUT ROUTINE
+
+SLOVER, DCA COLCNT /-# OF COLUMNS TO NEXT MARKER
+ JMS I [FTYPE /IS FILE NUMERIC?
+ JMP I [ILOOP /YES-THIS IS A NOP
+ TAD (" /GET SPACE
+ JMS I [PUTCH /PRINT IT
+ ISZ COLCNT /THERE YET?
+ JMP .-3 /NO-TYPE ANOTHER SPACE
+ JMP I [ILOOP /YES-DONE
+
+COMMAS, 1 /SET TO 1 IF LAST PRINT WAS A COMMA MOVE
+COLCNT, 0
+
+/ROUTINE TO CALL ERROR ROUTINE BY FAKING A FUNC2 CALL TO FUNCTION #10
+
+ERROR, 0
+ CLA CLL IAC /ENTRY AC RANDOM
+ AND PSFLAG /TEST IF OS/8 17600 RESIDENT
+ SZA CLA /SKP IF NOT
+ JMS I [PSWAP /ELSE FORCE IT OUT (THESE ERRORS ARE FATAL)
+ TAD (7607
+ DCA INSAV /FAKE A FUNC CALL TO FUNC2 #10
+ JMP I (FUNC2I
+XERRRET,JMP I ERROR /RETURN TO CALLER IF NON FATAL ERROR
+
+ /FLOATING NEGATE
+
+FNEGI, JMS I [FFNEG /CALL NEGATE ROUTINE
+ JMP I [ILOOP /RETURN TO ILOOP
+
+NUMBUF, ZBLOCK 6 /6 DIGIT BUFFER USED BY FFOUT
+
+ PAGE
+\f /INCREMENT AND LOAD 6BIT BYTE FROM MEMORY
+
+LDB, 0
+ JMS BUMP /INCREMENT POINTER AND SET DF
+ TAD I BYTPTR /PICK UP BYTE
+ CDF
+ ISZ BYTSWT /TEST HALFWORD SWITCH
+ JMP .+4
+ CLL RTR
+ RTR
+ RTR
+ AND [77 /MASK TO 6BIT
+ JMP I LDB /RETURN WITH CHAR IN AC
+
+ /INCREMENT AND DEPOSIT BYTE IN MEMORY
+
+DPB, 0
+ AND [77 /MASK TO 6BIT NOW
+ DCA BYTE
+ JMS BUMP /INCREMENT POINTER AND SET DF
+ TAD [77 /GET MASK
+ ISZ BYTSWT /SKP IF PTR BUMPED
+ CMA CML /ELSE PRESERVE LEFT HALF
+ AND I BYTPTR /ZERO OUT TARGET BYTE
+ DCA I BYTPTR
+ TAD BYTE /GET BYTE
+ SZL
+ JMP .+4 /JMP IF NO SHIFT
+ CLL RTL
+ RTL
+ RTL
+ TAD I BYTPTR
+ DCA I BYTPTR /STORE BYTE
+ CDF
+ ISZ BYTCNT /TALLY NUMBER OF BYTES STORED
+ JMP I DPB /--RETURN--
+
+ /BUMP BYTE POINTER
+
+BUMP, 0
+ TAD BYTSWT /BUMP LOW ORDER BIT
+ CLL CMA
+ DCA BYTSWT
+ ISZ BYTSWT /SKP IF NO CARRY
+ ISZ BYTPTR /ELSE BUMP WORD PTR
+ JMP BYTCDF /JMP OUT IF FIELD NOT CROSSED
+ TAD [10
+ TAD BYTCDF
+ DCA BYTCDF /PROPAGATE CARRY INTO CDF INSTR
+BYTCDF, 0 /GETS SET BY BYTSET TO TARGET FIELD
+ JMP I BUMP /RETURN WITH A CLEAR LINK
+
+ /BYTE LOAD/STORE INITIALIZE ROUTINE
+
+BYTSET, 0
+ TAD SSTEX /GET FIELD OF STRING
+ DCA BYTCDF /STORE INLINE
+ TAD STRPTR /NOW GET ADDR OF COUNT WORD
+ DCA BYTPTR /STORE
+ IAC
+ DCA BYTSWT /SET LOW ORDER BIT TO CARRY NEXT TIME
+ DCA BYTCNT /CLEAR DEPOSITED BYTE COUNT
+ TAD [SAC-1
+ DCA SACXR /ALWAYS RETURN WITH SAC POINTER SET UP
+ JMP I BYTSET /--RETURN--
+
+ /STRING STORE EXIT ROUTINE
+
+SSTEX, 0 /GETS SET BY STFIND TO DF OF STRING
+ TAD BYTCNT /ENTER WITH POSITIVE LENGTH IN COUNT
+ CIA
+ DCA I STRPTR /STORE IN STRING
+ JMP I [ILOOP /--RETURN-- (ILOOP RESETS DF)
+
+BYTCNT, 0
+BYTPTR, 0
+BYTSWT, 0
+BYTE, 0
+\f/SUBROUTINE BUFCHK-CHECKS THE POSITION OF THE BUFFER POINTER FOR
+/THE DEVICE WHOSE I/O TABLE ENTRY IS IN WORKING AREA. RETURNS TO CALL+1
+/IF THE POINTER IS AT THE END AND CHAR NUMBER IS 1 (LAST
+/AVAILABLE CHAR 3 HAS BEEN USED),CALL+2 IF THE POINTER IS AT THE
+/END BUT THE CHAR # IS NOT 1 (THERE IS 1 CHAR 3 LEFT), CALL+3
+/IF THERE IS 1 WORD LEFT IN BUFFER,CALL+4 IF MORE THAN 1 LEFT.
+
+BUFCHK, 0
+ TAD ENTNO /GET DEVICE #
+ SNA CLA /IS IT TTY?
+ TAD (62-400 /YES-CHECK FOR A BUFFER 60 WORDS LONG
+ TAD [400 /NO-CHECK FOR A BUFFER 400 WORDS LONG
+ TAD I IOTBUF /ADD LENGTH TO BUFFER ADDRESS
+ CIA /-ADDR OF END OF BUFFER
+ TAD I IOTPTR /CHECK AGAINST CURRENT POINTER
+ SNA /IS POINTER AT END OF BUFFER?
+ JMP EBC /AT END-CHECK THE CHAR #
+ ISZ BUFCHK
+ ISZ BUFCHK /NO-BUMP RETURN
+ IAC
+ SNA CLA /WAS POINTER AT LAST WORD?
+ JMP I BUFCHK /YES-RETURN TO CALL+3
+ ISZ BUFCHK /NO
+ JMP I BUFCHK /RETURN TO CALL+4
+
+EBC, JMS I [CHARNO /GET CHAR #
+ JMP I BUFCHK /IT WAS 1-RETURN TO CALL+1
+ NOP /IT WAS 3-RETURN TO CALL+2
+ ISZ BUFCHK /IT WAS 2-RETURN TO CALL+2
+ JMP I BUFCHK
+\f
+/SUBROUTINE PACKCH-PACKS ASCII CHARS,3 FOR 2, INTO BUFFER FOR THE
+/DEVICE IN WORK AREA. CALL WITH THE CHARACTER IN THE AC
+
+PACKCH, 0
+ DCA TEMP1 /SAVE
+ JMS I [CHARNO /DETERMINE CHARACTER NUMBER
+ SKP /1
+ JMP CHAR3P /3
+ TAD TEMP1 /1 OR 2-GET CHAR AGAIN
+ JMS I [WRITFL /STORE IN BUFFER
+ JMS I (CNOBML /BUMP CHARACTER NUMBER
+ JMP I PACKCH /DONE
+
+CHAR3P, AC7776
+ TAD I IOTPTR /BACK BUFFER POINTER UP TO POINT TO CHAR 1
+ DCA I IOTPTR
+ TAD TEMP1 /CHAR
+ CLL RTL
+ RTL /SLIDE LEFT HALF INTO BITS 0-3
+ DCA TEMP1 /SAVE
+ TAD TEMP1
+ JMS COMBNE /ISOLATE LEFT HALF,COMBINE WITH CHAR1,AND PUT IN FILE
+ TAD TEMP1 /CHAR AGAIN
+ CLL RTL
+ RTL /SLIDE RIGHT HALF INTO BITS 0-3
+ JMS COMBNE /ISOLATE RIGHT HALF,COMBINE WITH CHAR 2,AND PUT IN FILE
+ JMS I [CNOCLR /CLEAR THE CHARACTER NUMBER (RESET IT TO 1)
+ JMP I PACKCH /DONE
+
+COMBNE, 0
+ AND [7400 /ISOLATE HALF IN QUESTION
+ DCA TEMP2 /SAVE
+ JMS I (BCGET /GET A WORD FROM FILE BUFFER IN FIELD 1
+ AND [377 /FLUSH ANY SLUSH IN BITS 0-3
+ TAD TEMP2 /COMBINE
+ JMS I [WRITFL /PUT IN BUFFER
+ JMP I COMBNE /RETURN
+
+ PAGE
+\f/ROUTINE TO READ WORD FROM FILE BUFFER AND BUMP POINTER
+
+READFL, 0
+ JMS I (FOTYPE /IS FILE VARIABLE LENGTH
+ SKP
+VR, JMS I [ERROR /YES-IT IS AN ERROR TO TRY AND READ IT
+ TAD I IOTHDR /CHECK IF MORE THERE
+ CLL RTR /EOF BIT TO LINK
+ SNL CLA /EOF?
+ JMP .+3 /NO-CONTINUE
+RE, JMS I [ERROR /YES-ATTEMPT TO READ BEYOND EOF
+ JMP I [ILOOP /NOT FATAL-RETURN TO I LOOP
+ JMS BCGET /GET WORD FROM FILE BUFFER
+ ISZ I IOTPTR /BUMP POINTER
+ JMP I READFL /DONE
+
+/ROUTINE TO WRITE AC IN FILE BUFFER AND INCREMENT POINTER
+
+WRITFL, 0
+ JMS I (BCPUT /STORE AC IN FILE BUFFER
+ ISZ I IOTPTR /BUMP POINTER
+ TAD I IOTHDR /GET FILE HEADER WORD
+ CLL RTR /EOF BIT TO LINK
+ SNL CLA /WAS FILE PAST END?
+ JMP I WRITFL /NO-RETURN
+WE, JMS I [ERROR /YES-ATTEMPT TO WRITE PAST END OF FILE
+ JMP I [ILOOP /NON-FATAL RETURN TO ILOOP
+
+/ROUTINE TO GET ONE WORD FROM FILE BUFFER IN FIELD 1
+
+BCGET, 0
+ JMS I [IDLE /CHECK IF FILE OPEN
+ TAD I IOTPTR /GET READ WRITE POINTER
+ DCA WRITFL /SAVE
+ TAD ENTNO /GET FILE #
+ SZA CLA /IF TTY,BUFFER FIELD IS 0
+ CDF 10 /DF TO BUFFER FIELD
+ TAD I WRITFL /GET WORD FROM BUFFER
+ CDF
+ JMP I BCGET /RETURN
+\f/SUBROUTINE UNPACK-UNPACKS ASCII, 3 FOR 2 ,FROM THE FILE IN THE I/O
+/WORKING AREA. RETURNS WITH THE CHAR IN CHAR.
+
+UNPACK, 0
+ JMS I [CHARNO /GET CHAR #
+ SKP /1
+ JMP CHAR3U /3
+ JMS I (CNOBML /BUMP CHAR NUMBER
+ JMS READFL /GET CHAR AGAIN
+U123C, AND [177 /STRIP OFF 7 BITS
+ SNA
+ JMP UNPACK+1 /ZERO
+ TAD [200
+ DCA CHAR /SAVE
+ TAD CHAR
+ TAD (-232 /IS IT CTRL/Z?
+ SNA CLA
+ JMP I [EOFSET /YES-SET EOF BIT
+ JMP I UNPACK /RETURN
+
+CHAR3U, JMS I [CNOCLR /RESET CHAR # TO 1
+ AC7776
+ TAD I IOTPTR
+ DCA I IOTPTR /BACK BUFFER POINTER UP 2
+ JMS READFL /GET LEFT HALF OF CHAR
+ AND [7400
+ DCA XR5 /SAVE
+ JMS READFL /GET NEXT WORD WITH RIGHT HALF
+ AND [7400 /ISOLATE RIGHT HALF
+ CLL RTR
+ RTR /SLIDE RIGHT HALF OVER
+ TAD XR5 /COMBINE WITH LEFT HALF
+ CLL RTR
+ RTR /MOVE TO BITS 4-11
+ JMP U123C /REJOIN MAINLINE
+\f/READ FUNCTION-GETS NUMBERS INTO VARIABLES
+
+READI, JMS I [FTYPE /SKP IF FILE IS ASCII
+ JMP RIMAGE /READ NUMERIC IMAGE
+ JMS I (FFIN /READ ASCII INTO NUMBER
+ JMP I [ILOOP /--RETURN--
+RIMAGE, JMS I [BUFCHK /YES-CHECK BUFFER POINTER
+ NOP /PAST END-NEXT RECORD
+ NOP /AT END-NEXT RECORD
+ JMS I [NEXREC /ONLY 1 WORD LEFT-IT IS UNUSED IN NUMERIC FMT
+ JMS READFL /GET WORD FROM FILE
+ DCA ACX /STORE AS EXPONENT
+ JMS READFL /GET WORD FROM FILE
+ DCA ACH /STORE AS HIGH MANTISSA
+ JMS READFL /GET WORD FROM FILE
+ DCA ACL /STORE AS LOW MANTISSA
+ JMP I [ILOOP /DONE
+
+/ROUTINE TO FETCH ASCII CHARACTERS FROM FILE BUFFER
+
+GETCH, 0
+ JMS I [FTYPE /IS FILE ASCII?
+SR, JMS I [ERROR /NO-ERROR
+ TAD ENTNO
+ SZA CLA
+ JMP NTTY
+ TAD TCHAR
+ TAD [-215
+ SNA CLA
+ JMS I [DRCALL
+NTTY, JMS I [BUFCHK /NO-CHECK STATUS OF BUFFER
+ JMS I [NEXREC /LAST CHAR READ-NEXT RECORD
+ NOP /CHAR 3 NOT USED YET
+TCHAR, 215 /NOP: CHAR 2 AND 3 LEFT
+ JMS UNPACK /UNPACK CHAR FROM BUFFER
+ TAD ENTNO
+ SZA CLA
+ JMP I GETCH /RETURN
+ TAD CHAR
+ DCA TCHAR
+ JMP I GETCH
+
+/SUBROUTINE CHARNO-RETURNS TO CALL+1 IF CHAR #=1,CALL+2 IF 3,CALL+3
+/IF 2
+
+CHARNO, 0
+ TAD I IOTHDR /HEADER
+ AND (300 /ISOLATE CHAR #
+ CLL RTL
+ RTL /CHAR # TO BITS 0,1
+ SMA SZA /IS IT 2?
+ ISZ CHARNO /YES-BUMP RETURN
+ SZA CLA /IS IT 2 OR 3?
+ ISZ CHARNO /YES-BUMP RETURN
+ JMP I CHARNO /RETURN
+
+ PAGE
+\f/WRITE FUNCTION-PUTS NUMBERS IN FILE BUFFERS
+
+WRITEI, JMS I [FTYPE /SKP IF FILE IS ASCII
+ JMP WIMAGE /ELSE DO IMAGE WRITE
+ JMS I (FFOUT /CONVERT INTERNAL TO ASCII
+ TAD XR1
+ CIA
+ TAD (INTERB-1 /CALCULATE NUMBER OF CHARS STORED IN BUFFER
+ DCA TEMP10 /SAVE
+ TAD (INTERB-1
+ DCA SACXR /NOW POINT SACXR INTO BUFFER
+ TAD TEMP10 /GET COUNT OF CHARS TO BE PRINTED
+ CIA
+ TAD I IOTPOS /ADD TO PRINT HEAD POSITION
+ TAD (-WIDTH /COMPARE AGAINST "72"
+ SMA SZA CLA /WILL THE NUMBER FIT ON THIS LINE?
+ JMS I [CRLFR /NO-ISSUE A CR,LF
+CPLOOP, TAD I SACXR /GET CHAR FROM INTERMEDIATE BUFFER
+ JMS PUTCH /PUT ON DEVICE
+ ISZ TEMP10 /BUMP COUNTER
+ JMP CPLOOP /NEXT
+ TAD O240
+ JMS PUTCH /SEND OUT A SPACE AFTER NUMBER
+ JMP WDONE /TAKE COMMON EXIT
+WIMAGE, JMS I [BUFCHK /FILE IS NUMERIC-CHECK BUFFER STATUS
+O240, 240 /PAST END-NEW RECORD (AND INST SERVES AS NOP)
+O210, 0210 /AT END-NEW RECORD (AND SERVES AS NOP)
+ JMS I [NEXREC /ONE WORD LEFT-DON'T USE IT
+ TAD ACX /EXPONENT
+ JMS I [WRITFL /WRITE IN BUFFER
+ TAD ACH /HIGH MANTISSA
+ JMS I [WRITFL /WRITE IN BUFFER
+ TAD ACL /LOW MANTISSA
+ JMS I [WRITFL /WRITE IN BUFFER
+WDONE, DCA I (COMMAS /CLEAR COMMA SWITCH
+ JMP I [ILOOP /WRITE IS DONE
+\f/ROUTINE TO PUT ASCII CHARS IN FILE BUFFER. IGNORES RUBOUTS.
+
+PUTCH, 0
+ DCA TEMP1 /SAVE CHAR
+ TAD TEMP1 /GET CHAR AGAIN
+ TAD (-377
+ SNA CLA /IS IT A RUBOUT?
+ JMP I PUTCH /YES-RETURN
+ JMS I [FTYPE /IS FILE NUMERIC?
+SW, JMS I [ERROR /YES-ERROR
+ ISZ I IOTPOS /BUMP COULMN NUMBER
+ TAD ENTNO /GET ENTRY #
+ SNA CLA /IS IT TTY?
+ JMP TOUT /YES-JUST PUT CHARS IN RING BUFFER
+ JMS I [BUFCHK /NO-IS BUFFER FULL?
+ JMS I [NEXREC /YES-NEXT RECORD
+O40, 40 /THERE IS A CHAR 3 LEFT (AND IS A NOP)
+O20, 20 /THERE IS A CHAR 2 AND 3 LEFT (AND IS A NOP)
+ TAD TEMP1 /GET CHAR AGAIN
+ JMS I [PACKCH /PUT IN BUFFER
+ JMP I PUTCH /RETURN
+
+TOUT, TAD TEMP1 /GET CHAR
+ JMS I [XPUTCH /PUTCH CHAR IN OUTPUT BUFFER FOR TTY
+ JMP I PUTCH /RETURN
+\f/SUBROUTINE NEXREC-WRITES THIS BUFFER IN FILE,THEN READS IN NEXT BUFFER
+/IF POSSIBLE,ELSE SETS EOF BIT. IF DEVICE IS READ OR WRITE ONLY
+/IT JUST READS OR WRITES A BLOCK,WHICHEVER IS APPROPRIATE
+
+NEXREC, 0
+ TAD I IOTHDR /GET HEADER
+ AND O20 /GET READ/WRITE ONLY BIT
+ SNA CLA /IS IT ON?
+ JMP FILSTR /NO-DEVICE IS FILE STRUCTURED
+ JMS I (FOTYPE /YES-IS IT INPUT OR OUTPUT FILE?
+ JMP RONLY
+ JMS WRBLK
+RWONC, ISZ I IOTBLK
+ JMS BLINIT /INIT FILE TABLE ENTRIES
+ JMP I NEXREC /DONE
+
+RONLY, JMS BLREAD
+ JMP RWONC
+
+FILSTR, JMS WRBLK /WRITE THE CURRENT BLOCK IF IT HAS BEEN CHANGED
+ JMS BLINIT /INIT FILE TABLE ENTRIES
+ ISZ I IOTBLK /BUMP BLOCK #
+ TAD I IOTLOC /STARTING BLOCK
+ CIA /NEGATE
+ TAD I IOTBLK /SUBTRACT FROM CURRENT BLOCK FOR FILE LENGTH
+ CLL CMA /SET UP CURRENT FILE LENGTH FOR 12 BIT COMPARE
+ TAD I IOTLEN /COMPARE TO ACTUAL LENGTH
+ SNL CLA /IS IT > CURRENT LENGTH?
+ JMP LASTB /YES-EXTEND THE FILE IF IT IS OUTPUT
+ JMS BLREAD /READ IN THE NEXT RECORD
+ JMP I NEXREC /RETURN
+
+
+LASTB, JMS I (FOTYPE /IS FILE FIXED LENGTH?
+ JMP I [EOFSET /YES-SET EOF FLAG
+ TAD I IOTLEN /NO-GET ACTUAL LENGTH
+ CLL CMA
+ TAD I IOTMAX /MAXIMUM LENGTH
+ SNL CLA /IS ACTUAL LENGTH >= MAXIMUM LENGTH?
+ JMP I [EOFSET /YES-SET EOF BITS
+ ISZ I IOTLEN /NO-BUMP ACTUAL LENGTH
+ JMP I NEXREC /RETURN WITHOUT READING NEXT RECORD
+\f/ROUTINE TO READ 2 PAGES FROM DEVICE
+
+BLREAD, 0
+ JMS I (BLZERO
+ TAD O210 /"READ 2 PAGES"
+ JMS I [DRCALL /HANDLER CALL
+ JMP I BLREAD
+
+/ROUTINE TO WRITE 2 PAGES ONTO DEVICE
+
+WRBLK, 0
+ TAD I IOTHDR /GET FILE HEADER
+ AND O40 /GET FILE WRITTEN BIT
+ SNA CLA /HAS THIS BLOCK BEEN CHANGED?
+ JMP I WRBLK /NO-RETURN
+ TAD (4210 /"WRITE 2 PAGES"
+ JMS I [DRCALL /CALL TO DEVICE HANDLER
+ JMS I (BLZERO
+ JMP I WRBLK
+
+/ROUTINE TO INITIALIZE I/O TABLE ENTRIES AFTER READ OR WRITE
+
+BLINIT, 0
+ TAD I IOTBUF
+ DCA I IOTPTR /INIT READ/WRITE POINTER
+ TAD I IOTHDR
+ AND (7437 /SET CHAR # TO 1 AND CLEAR BLOCK WRITTEN BIT
+ DCA I IOTHDR
+ JMP I BLINIT
+
+/ROUTINE TO SAVE THE FAC IN FP TEMP
+
+FACSAV, 0
+ JMS I [FFPUT /STORE FAC
+ INTERB /USE INTERMEDIATE BUFFER FOR TEMP STORAGE
+ JMP I FACSAV /RETURN
+
+ PAGE
+\f
+
+
+
+
+
+/////////////////////////////////////////////////////////////
+/////////////////////////////////////////////////////////////
+//////////// OVERLAY BUFFER 3400-4600 ////////////////////
+//////////// CONTAINS FUNCTION OVERLAYS ////////////////////
+//////////// AT RUN TIME ////////////////////
+/////////////////////////////////////////////////////////////
+/////////////////////////////////////////////////////////////
+
+
+\f/////////////////////////////////////////////////////////////
+/////////////////////////////////////////////////////////////
+////////////// OVERLAY 1-ARITHMETIC FUNCTIONS ///////////////
+/////////////////////////////////////////////////////////////
+/////////////////////////////////////////////////////////////
+
+ *OVERLAY
+
+
+
+/INTEGER FUNCTION
+/RANGE=ALL X
+
+INT, VERSON^100+SUBVAF+6000 /INITIALLY CONTAINS VERSION OF ARITH OVERLAY
+ JMS I [FFPUT /SAVE X
+ FPPTM1
+ TAD ACX /GET EXPONENT
+ SMA SZA CLA /IS EXP<0?
+ JMP INSC /NO-GO ON
+ TAD ACH /YES
+ SPA CLA /IS X<0?
+ JMP M1R /YES-INT=-1
+ JMS I [FACCLR /YES-RETURN A 0
+ JMP I INT
+INSC, TAD ACH /GET HI MANTISSA
+ SMA CLA /IS IT <0?
+ JMP INTPOS /NO-USE FAC AS IS
+ JMS I [FFNEG /YES-NEGATE FAC (MAKE IT POS)
+ IAC /AND SET FLAG
+INTPOS, DCA TEMP3 /FLAG FOR NEGATIVE
+ DCA TEMP5 /ZERO LORD MASK
+ CLL CML RAR
+ DCA TEMP4 /INITIALIZE HORD MASK TO 4000
+ TAD ACX
+ CIA /- COUNT
+ DCA TEMP2
+MASKL, TAD TEMP4
+ CLL CML RAR /ROTATE 1'S THROUGH 3 WORD MASK
+ DCA TEMP4 /
+ TAD TEMP5 /UNTIL THERE IS A COUNT OF ZERO
+ RAR
+ DCA TEMP5
+ ISZ TEMP2 /DONE?
+ JMP MASKL /NO
+ TAD ACH /YES-MASK HORD
+ AND TEMP4
+ DCA ACH
+ TAD ACL /MASK LORD
+ AND TEMP5
+ DCA ACL
+ TAD TEMP3 /NEG FLAG
+ SNA CLA /WAS ORIGINAL NUMER <0?
+ JMP I INT /NO-DONE
+ JMS I [FFPUT /SAVE INT(X)
+ FPPTM2
+ JMS I (FFADD /-INT(X)+(X)
+ FPPTM1
+ TAD ACH /SAVE HORD
+ DCA TEMP3
+ JMS I [FACCLR /FLUSH FAC
+ TAD TEMP3 /WAS INT(X)=X?
+ SNA CLA
+ JMP JUSNEG /YES-JUST NEGATE INT(X)
+ JMS I (FFADD /NO-ADD 1
+ ONE
+JUSNEG, JMS I (FFADD /GET INT(X)
+ FPPTM2
+JNEG, JMS I [FFNEG /AND NEGATE (INT(5.3)=-6)
+ JMP I INT /DONE
+
+M1R, JMS I [FFGET /LOAD FAC WITH 1
+ ONE
+ JMP JNEG /JUST NEGATE AND RETURN
+
+ONE, 1
+ 2000
+ 0
+
+\f/EXPONENTIATION FUNCTION
+/IF B=0,A^B=1
+/IF A=0 AND B>0,A^B=0
+/IF A=0 AND B<0,DIVIDE BY ZERO ERROR MESSAGE RESULTS AND A^B=0
+/IF B=INTEGER > 0, A^B=A*A*A*.......*A
+/IF B=INTEGER < 0, A^B=1/A*A*A*.......*A
+/IF B=REAL AND A>0, A^B=EXP(B*LOG(A))
+/IF B=REAL AND A<0, A FATAL ERROR RESULTS
+
+EXPON, 0
+ JMS I [FFPUT /SAVE A
+ FPPTM5
+ JMS I [FFPUT /SET UP RUNNING PRODUCT IN CASE OF
+ FPPTM4 /MULTIPLIES
+ TAD ACH /HI ORDER OF A
+ DCA EXPON /SAVE IT
+ DCA INSAV /POINTER TO B IN SYMBOL TABLE
+ JMS I ARGPLL /FIND B
+ JMS I [FFGET /GET B
+ARGPLL, ARGPRE /LOC SKIPPED BY FPP,SO WE USE IT FOR CONSTANT
+ CDF
+ TAD ACH /HI ORDER OF B
+ SNA /IS B=0?
+ JMP I (RETRN1 /YES A^B=1
+ SMA CLA /IS B<0?
+ JMP .+4 /NO
+ TAD EXPON /YES-GET HI ORDER A
+ SNA CLA /IS A=0?
+ JMP I (DV /YES-DIVIDE BY ZERO ERROR
+ TAD EXPON /B>0. IS A=0?
+ SNA CLA
+ JMP RET0 /YES A^B=0
+ JMS I [FFPUT /SAVE B
+ FPPTM3
+ JMS INT /GET INT(B)
+ JMS I (MULLIM /TEST EXPONENT OF RESULT TO LIMIT LARGE MULTIPLY LOOPS
+ JMS I (FFSUB /INT(B)-B
+ FPPTM3
+ TAD ACH /IS INT(B)-B=0?
+ SZA CLA
+ JMP I (USELOG /NO-USE LOGS
+ JMS I [FFGET /NO-USE REPETITIVE MULTIPLY
+ FPPTM3 /GET B AGAIN
+ TAD ACH
+ DCA EXPON /SAVE SIGN OF B
+ JMS I (ABSVAL /!B!
+ JMS I [FFPUT /USE ABS(B) AS MULTIPLY COUNT
+ FPPTM3
+EMLOOP, JMS I [FFGET /GET B
+ FPPTM3
+ JMS I (FFSUB /B-1
+ ONE
+ JMS I [FFPUT /SAVE NEW COUNT
+ FPPTM3
+ TAD ACH
+ SNA CLA /IS COUNT ZERO YET
+ JMP I (EMDONE /YES-MULTIPLIES ARE DONE
+ JMS I [FFGET /NO-GET RUNNING PRODUCT
+ FPPTM4
+ JMS I (FFMPY /MULTIPLY BY A
+ FPPTM5
+ JMS I [FFPUT /SAVE NEW RUNNING PRODUCT
+ FPPTM4
+ JMP EMLOOP
+
+RET0, JMS I [FACCLR /RETURN WITH 0 IN FAC
+ JMP I [ILOOP
+
+ PAGE
+\fEMDONE, JMS I [FFGET /GET RUNNING PRODUCT
+ FPPTM4
+ TAD I EXPONK /GET SIGN OF B
+ SMA CLA /WAS IT -?
+ JMP I [ILOOP /NO-A^B=A*A*A*...*A
+ JMS I FIDVP /YES-INVERT
+ ONE
+ JMP I [ILOOP /A^B=1/A:A*A*...*A
+
+RETRN1, JMS I [FFGET
+ ONE /SET FAC TO 1
+ JMP I [ILOOP
+
+USELOG, TAD I EXPONK /SIGN OF A
+ SPA CLA /A<0?
+EM, JMS I [ERROR /YES-PRINT A MESSAGE
+ JMS I [FFGET /LOAD A
+ FPPTM5
+ JMS I FFLOGL /LOG(A)
+ JMS I FMPYLV /B*LOG(A)
+ FPPTM3
+ JMS I FFEXPL /EXP(B*LOG(A))
+ JMP I [ILOOP /DONE
+
+
+FFEXPL, EXPON1
+FFLOGL, LOG
+FMPYLV, FFMPY
+EXPONK, EXPON
+FIDVP, FFDIV1
+
+/SGN FUNCTION
+
+SGN, 0
+ TAD ACH /GET HIGH MANTISSA
+ SNA /IS X=ZERO?
+ JMP I [ILOOP /YES-THEN LEAVE IT ALONE
+ SPA CLA /IS X>0?
+ JMP .+3 /NO
+ IAC /YES-SET FAC=1
+ SKP
+ CMA /NO-SET FAC=-1
+ DCA ACX /SET UP FLOAT
+ JMS I [FFLOAT /FLOAT VALUE OF SGN FUNCTION
+ JMP I [ILOOP /DONE
+\f IFZERO EAE <
+/FLOATING SQUARE ROOT
+/USES A HARDWARE TYPE ALGORITHM FOR BINARY SQUARE ROOTS
+/REF: THE LOGIC OF COMPUTER ARITHMETIC-IVAN FLORES-P 409
+/
+FROOT, 0
+ CLA CLL CML RTR /SET RESULT TO 2000;0000
+ DCA AN1
+ DCA AN2
+ CDF /DF TO PACKAGE FIELD
+ TAD KM22 /SET COUNTER FOR DEVELOPING 22 BITS OF RESULT
+ DCA AC2 /ALREADY HAVE 1
+ TAD ACH
+ SNA
+ JMP I FROOT /ZERO FAC-NORMALIZED!-RETN. SAME
+ SPA CLA
+ JMS I [FFNEG /TAKE ROOT OF ABSOL VALUE
+ TAD ACX /GET EXPONENT OF FAC
+ SPA /IF NEGATIVE-MUST PROPAGATE SIGN
+ CML
+ RAR /DIVIDE EXP. BY 2
+ DCA ACX /STORE IT BACK
+ SZL /INCREMENT EXP. IF ORIGINAL EXP
+ ISZ ACX /WAS ODD
+ NOP
+ SNL /DO A PRE-SHIFT FOR EVEN EXPONENTS
+ JMS I AL1K /SO FIRST BIT PAIR IS 10 NOT 01
+ CLA CLL CMA RAL /SET COUNTER FOR DETECTING A
+ DCA ZCNT /ZERO REMAINDER
+ CLA CLL CML RTR /SET UP POSITION OF TRIAL BIT
+ RTR /FOR FIRST PASS THRU LOOP
+ DCA OPH
+ DCA OPL
+ TAD K6000 /GET A FAST FIRST BIT-WE KNOW
+ TAD ACH /THIS WILL WORK SINCE # IS NORMALIZED
+ DCA ACH /IF # IS A POWER OF TWO, AND A PERFECT
+ TAD ACH /SQUARE-WE ARE DONE HERE!
+ SNA /WELL IS IT?
+ TAD ACL /COULD BE-CHECK LOW ORDER
+ SNA CLA
+ JMP DONE /WHOOPPEE-WE WIN BIG.
+ JMP LOP01 /NOPE-LOOP DON'T SHIFT FIRST TIME
+SLOOP, TAD OPH /SHIFT TRIAL BIT 1 PLACE
+ CLL RAR /TO THE RIGHT
+ DCA OPH /AND STORE BACK
+ TAD OPL
+ RAR
+ DCA OPL
+ JMS I AL1K /SHIFT FAC LEFT 1 PLACE
+LOP01, TAD OPL /ADD TRIAL BIT TO`ANSWER
+ TAD AN2 /SO FAR
+ CLL CMA IAC /NEGATE IT
+ TAD ACL /AND ADD TO FAC (REMAINDER SO FAR)
+ SNA /IS RESULT ZERO?
+ ISZ ZCNT /YES-INCREMENT COUNTER
+ DCA TM /STORE RESULT IN TEMPORARY
+\f CML RAL /ADD CARRY TO HIGH ORDER FOR SUBTRACT
+ TAD OPH /ADD TRIAL BIT
+ TAD AN1 /ADD RESULT SO FAR (HI ORDER)
+ CLL CMA IAC /AND SUBTRACT FROM HI ORDER FAC
+ TAD ACH
+ SNL /RESULT NEGATIVE?
+ JMP GON /YES-NEXT RESULT BIT IS 0
+ SZA /NO-IS HI ORDER RESULT=0?
+ JMP LOP02 /NO-GO ON
+ ISZ ZCNT /YES-WAS LOW ORDER =0?
+ JMP .+3 /NO-GO ON
+ CMA /YES-REM.=0-SET COUNTER SO
+ DCA AC2 /LOOKS LIKE WE'RE DONE
+LOP02, DCA ACH /STORE HIGH ORDER REM. IN FAC
+ TAD TM /STORE LO ORDER REM. IN FAC
+ DCA ACL
+ TAD OPL /TRIAL BIT SHIFTED LEFT 1 IS
+ CLL RAL /RESULT BIT-ADD IT TO ROOT DEVELOPED
+ TAD AN2 /SO FAR
+ DCA AN2
+ TAD OPH
+ RAL
+ TAD AN1
+ DCA AN1
+GON, CLA CLL CMA RAL /RESET COUNTER FOR ZERO REM.
+ DCA ZCNT
+ ISZ AC2 /DONE ALL 23 RESULT BITS?
+ JMP SLOOP /NO-GO ON
+DONE, TAD AN1 /YES-STORE ANSWER IN FAC
+ DCA ACH /ITS NORMALIZED ALREADY
+ TAD AN2
+ DCA ACL
+ JMP I FROOT /AND RETURN
+
+K6000, 6000
+ZCNT, 0
+AL1K, AL1
+AN1, 0
+AN2, 0
+KM22, -26
+
+ PAGE
+ >
+\f IFNZRO EAE <
+/
+/FLOATING SQUARE ROOT
+/USES MODIFIED HARDWARE ALGORITHM FOR BINARY SQUARE ROOTS
+/REF: THE LOGIC OF COMPUTER ARITHMETIC-IVAN FLORES; P-409
+ *SGN+14
+FROOT, 0
+ CLA CLL CML RTR /SET RESLT TO 2000,0000
+ DCA OPL
+ DCA OPH
+ SWAB /MODE B OF EAE-ALSO DOES MQL
+ CDF
+ DCA RBCNT /CLR. SHIFT COUNTER
+ TAD KM22
+ DCA AC2 /SET COUNTER FOR 23 BITS OF RESULT
+ TAD ACX /GET EXPONENT OF FAC
+ ASR /DIVIDE BY 2
+ 1
+ DCA ACX /STORE IT BACK
+ DPSZ /INCREMENT EXP. IF ORIG. EXP
+ ISZ ACX /WAS ODD
+ NOP
+ MQA /DETERMINE WHETHER TO DO A
+ CLL RAL /PRE-SHIFT FOR EVEN EXPONENTS.
+ CML RAL
+ DCA RKNT /STORE BIT-0 OR 1 SHIFT CNT
+ CLL CML RTR /SET UP FIRST TRIAL BIT
+ RTR
+ DCA AC1
+ DCA AC0 /STORE AWAY
+ DCA ACNT /ZERO COUNTER
+ DLD /GET THE FAC
+ ACH
+ SWP /GET IN RIGHT ORDER
+ SNA /IS IT ZERO? (HI ORD=0)
+ JMP I FROOT /YES-ROOT = 0
+ SPA /NEGATIVE?
+ DCM /YES-TAKE ABSOL. VALUE
+ SHL /SHIFT # 1 BIT IF EXP WAS EVEN
+RKNT, 0 /SO FIRST BIT PAIR IS 10 NOT 01
+ TAD K6000 /SUBTRACT 2000-KNOW FIRST BIT
+ DPSZ /IS 1(NORMALIZED)-DONE??
+ JMP LOP1 /NO-WE MUST LOOP
+ JMP DONE /YES-AN EASY ONE!!!
+LOOP, DLD /GET THE FAC
+ ACH
+ SHL /SHIFT FAC APPROPRIATELY
+ 1
+LOP1, DST /MUST STOR BACK IN CASE RESLT
+ ACH /BIT IS 0
+ DLD /GET TRIAL BIT
+ AC0
+
+ ASR /SHIFT THE BIT APPROPRIATELY
+ACNT, 0
+ ISZ ACNT /SHIFT 1 MORE NEXT TIME
+ DAD /ADD IN RESULT SO FAR
+ OPH
+ DCM /NEGATE IT
+ ISZ RBCNT /BUMP COUNTER FOR RESLT BIT
+ DAD /DO THE SUBTRACT
+ ACH
+ SNL /RESULT NEGATIVE?
+ JMP GON /YES-NEXT RESULT BIT = 0
+
+ DPSZ /NO-DID WE GET A ZERO REMAINDER?
+ JMP NOTZRO /NOPE
+ZREM, CMA /YES-SET SO LOOKS LIKE WE'RE DONE
+ DCA AC2
+NOTZRO, DST /GOOD SUBTR.-MODIFY FAC
+ ACH /ITS NOT CHANGED BY BAD SUBTRACT
+ CAM /CLEAR EVERYTHING
+ RTR
+ ASR /SHIFT RESLT BIT TO RIGHT PLACE
+RBCNT, 0
+ DAD /ADD IT TO THE RESULT SO FAR
+ OPH /WE APPEND IT TO RIGHT OF LAST
+ DST /BIT
+ OPH /STORE IT BACK
+GON, ISZ AC2 /DONE 23 BITS?
+ JMP LOOP /NO-GO ON
+DONE, DLD /YES-GET RESULT-ITS NORMALIZED
+ OPH
+ DCA ACH /STORE HIGH ORDER BACK
+ SWP
+ DCA ACL /STORE LOW ORDER BACK
+ JMP I FROOT /RETURN
+KM22, -26
+K6000, 6000
+
+ PAGE
+ >
+\f/23-BIT EXTENDED FUNCTIONS
+
+/1-31-72 R BEAN
+
+/******SINE******
+
+SIN, 0
+ JMS NHNDLE /IF X<0,NEGATE X AND SET NFLAG
+ JMS I (FFMPY /X*2/PI
+ TOVPI
+ JMS FRACT /SAVE X IN TEMP1,THE INTEGER PART OF X IN NUM,AND GET FRACTIONAL PART IN FAC
+ TAD NUM /GET INTEGER PART OF (2/PI)*X
+ AND (3 /ISOLATE BITS 10,11
+ TAD JMPISN
+ DCA .+1 /MAKE JUMP TO ARGUMENT REDUCING ROUTINE
+ JMP . /AND ADJUST ARG ACCORDING TO QUADRANT OF X
+JMPISN, JMP I .+1
+ POLYSN /X IN QUAD1,SIN(X)=SIN(X)
+ QUAD2 /X IN QUAD2,SIN(X)=SIN(1-X)
+ QUAD3 /X IN QUAD3,SIN(X)=SIN(-X)
+ QUAD4 /X IN QUAD4,SIN(X)=SIN(X-1)
+
+QUAD2, JMS I (FFSUB1 /1-X
+ ONE
+ JMP POLYSN /CALCULATE SIN(1-X)
+QUAD3, JMS I [FFNEG /-X
+ JMP POLYSN /CALCULATE SIN(-X)
+QUAD4, JMS I (FFSUB /X-1
+ ONE
+POLYSN, JMS I [FFPUT /SAVE X
+ FPPTM1
+ JMS I (FFSQ /U=X**2
+ JMS I [FFPUT /SAVE U
+ FPPTM2
+ JMS I (FFMPY /A7*U
+ SINA7
+ JMS I (FFADD /A5+A7*U
+ SINA5
+ JMS I (FFMPY /A5*U+A7*U**2
+ FPPTM2
+ JMS I (FFADD /A3+A5(U)+A7(U**2)
+ SINA3
+ JMS I (FFMPY /A3(U)+A5(U**2)+A7(U**3)
+ FPPTM2
+ JMS I (FFADD /A1+A3(U)+A5(U**2)+A7(U**3)
+ SINA1
+ JMS I (FFMPY /A1(X)+A3(X**3)+A5(X**5)+A7(X**7)
+ FPPTM1
+ JMS NCHK /IF NFLAG IS SET,SET SIN(X)=-SIN(X)
+ JMP I SIN /FAC=SIN(X)
+
+
+/******COSINE******
+/USES SIN ROUTINE TO CALCULATE COS(X)
+
+COS, 0
+ JMS I (FFADD /COS(X)=SIN(PI/2+X)
+ PIOV2
+ JMS SIN
+ JMP I COS /RETURN
+\f/ROUTINE TO SEPERATE THE INTEGER AND FRACTIONAL PARTS OF FAC
+/ORIGINAL FAC IS SAVED IN TEMP1,THE INTEGER PORTION OF FAC IS
+/SAVED AT NUM,AND THE FRACTIONAL FORTION OF THE FAC IS LEFT IN THE FAC
+
+FRACT, 0
+ JMS I [FFPUT /SAVE X
+ FPPTM1
+ JMS I (FFIX /INTEGER PORTION OF X
+ TAD ACX
+ DCA NUM /SAVE FIXED FORTION OF X
+ JMS I [FFLOAT /FAC=FLOAT(FIX(X))
+ JMS I (FFSUB1 /FAC=X-INT(X)=FRACTION (X)
+ FPPTM1
+ JMP I FRACT /RETURN
+
+/ROUTINE TO CHECK IF FAC<0; IF IT IS,FAC IS NEGATED AND NFLAG IS
+/SET TO 1
+
+NHNDLE, 0
+ TAD ACH /FETCH HIGH ORDER MANTISSA
+ SMA CLA /IS IT <0?
+ JMP NFLGST /NO-CLEAR NFLAG
+ JMS I [FFNEG /YES-NEGATE FAC
+ IAC /AND SET NFLAG
+NFLGST, DCA NFLAG
+ JMP I NHNDLE
+
+/ROUTINE TO NEGATE FAC IF NFLAG IS NOT =0
+
+NCHK, 0 /LOC ALSO USED FOR TEMP STORAGE
+ TAD NFLAG
+ SZA CLA /IS NFLAG=0?
+ JMS I [FFNEG /NO-NEGATE FAC
+ JMP I NCHK /YES-RETURN
+
+ NUM=NCHK
+\f/******EXPONENTIAL******
+
+EXPON1, 0 /LOC USED FOR TEMP STORAGE BY SIN,ARCTAN
+ JMS I (FFMPY /Y=XLOG2(E)
+ LOG2E
+ JMS FRACT /GET FRACTIONAL PART OF Y
+ JMS I (FFMPY /(FRACTION(Y))*(LN2/2)
+ LN2OV2
+ JMS I [FFPUT /SAVE Y
+ FPPTM1
+ JMS I (FFSQ /Y**2
+ JMS I (FFADD /B1+Y**2
+ EXPB1
+ JMS I (FFDIV1 /A1/(B1+Y**2)
+ EXPA1
+ JMS I (FFADD /A0+A1/(B1+Y**2)
+ EXPA0
+ JMS I (FFSUB /A0-Y+A1/(B1+Y**2)
+ FPPTM1
+ JMS I [FFPUT /SAVE
+ FPPTM2
+ JMS I [FFGET /GET Y
+ FPPTM1
+ ISZ ACX /MULT. BY 2=2Y
+ NOP
+ JMS I (FFDIV /2Y/(A0-Y+A1/(B1+Y**2))
+ FPPTM2
+ JMS I (FFADD /1+2Y/(AO-Y+A1/(B1+Y**2))
+ ONE
+ JMS I (FFSQ /[1+2Y/(A0-Y+A1/(B1+Y**2))]**2=EXP(Y)
+ TAD NUM
+ TAD ACX /EXP(X)=(2**N)(EXPY)
+ DCA ACX
+ JMP I EXPON1 /FAC=EXPON(X)
+
+ NFLAG=EXPON1
+
+/CONSTANT THAT WOULDN'T FIT ELSEWHERE
+TOVPI, 0 /.6366198
+ 2427
+ 6302
+
+MULLIM, 0
+ TAD ACX /CHECK IF NUMBER OF MULTIPLIES IS TOO LARGE
+ SPA
+ CLA /RETURN IF EXPONENT IS NEGATIVE (WE'LL USE LOGS)
+ TAD (-4 /ONLY A ROUGH ROUGH LIMIT ON THE EXPONENT
+ SPA SNA CLA /SKP IF NUMBER GT 15 APPROX
+ JMP I MULLIM /NO, CONTINUE
+ JMP I (USELOG /YES, USE LOG INSTEAD
+
+ PAGE
+\f/******ARC TANGENT******
+
+ATAN, 0
+ JMS I NHNDLL /IF X<0,SET NFLAG AND NEGATE
+ JMS I [FFPUT /SAVE X
+ FPPTM1
+ JMS I FSUBM /X-1
+ ONE
+ TAD ACH /GET HI MANTISSA
+ SPA CLA /WAS X>1?
+ JMP ARGPOL /NO-CLEAR GT1FLG
+ JMS I [FFGET /YES-ATAN(X)=PI/2-ATAN(1/X)
+ ONE
+ JMS I FDIVM /1/X
+ FPPTM1
+ JMS I [FFPUT
+ FPPTM1
+ IAC /SET GT1FLG
+ARGPOL, DCA GT1FLG
+ JMS I [FFGET /GET X OR 1/X
+ FPPTM1
+ JMS I FSQRM /Y**2
+ JMS I [FFPUT /SAVE
+ FPPTM2
+ JMS I FADDM /Y**2+B3
+ ATANB3
+ JMS I FDIV1M /A3/(Y**2+B3)
+ ATANA3
+ JMS I FADDM /B2+A3/(Y**2+B3)
+ ATANB2
+ JMS I FADDM /Y**2+B2+A3/(Y**2+B3)
+ FPPTM2
+ JMS I FDIV1M /A2/(Y**2+B2+A3/(Y**2+B3))
+ ATANA2
+ JMS I FADDM /B1+A2/(Y**2+B2+A3/(Y**2+B3))
+ ATANB1
+ JMS I FADDM /Y**2+B1+A2/(Y**2+B2+A3/(Y**2+B3))
+ FPPTM2
+ JMS I FDIV1M /A1/(Y**2+B1+A2/(Y**2+B2+A3/(Y**2+B3)))
+ ATANA1
+ JMS I FADDM /B0+A1/(Y**2+B1+A2/(Y**2+B2+A3/(Y**2+B3)))
+ ATANB0
+ JMS I FMPYM /ATAN(Y)=X*(B0+A1/(Y**2+B1+A2/(Y**2+B2+A3/(Y**2+B3))))
+ FPPTM1
+ TAD GT1FLG /WAS X>1?
+ SNA CLA
+ JMP NGT /NO-TEST IF X<0?
+ JMS I FSUB1M /ATAN(X)=PI/2-ATAN(1/X)
+ PIOV2
+NGT, JMS I NCHKL /IF NFLAG SET,NEGATE FAC
+ JMP I ATAN /FAC=ATAN(X)
+NHNDLL, NHNDLE
+NCHKL, NCHK
+\f/******NAPERIAN LOGARITHM******
+
+ GTFLG=ATAN
+
+LOG, 0
+ TAD ACH
+ SPA SNA /X<0 OR X=0?
+ JMP I ARTRAP /YES-TAKE ILLEGAL ARGUMENT TRAP
+ CLL RTL
+ SNA /NO-HORD=2000?
+ TAD ACX /YES-EXP=1?
+ CMA IAC
+ IAC
+ SNA
+ TAD ACL /YES-LORD=0?
+ SZA CLA
+ JMP POLYNL /NO-ARG IS LEGAL AND NOT 1
+ DCA ACX
+ DCA ACL
+LTRPRT, DCA ACH
+ JMP I LOG /YES-LOG(1)=0
+POLYNL, TAD ACX
+ DCA GTFLG /SAVE EXPONENT FOR LATER
+ DCA ACX /ISOLATE MANTISSA IN FAC
+ JMS I [FFPUT /SAVE F
+ FPPTM1
+ JMS I FADDM /F+SQR(.5)
+ SQRP5
+ JMS I [FFPUT /SAVE
+ FPPTM2
+ JMS I [FFGET
+ FPPTM1
+ JMS I FSUBM /F-SQR(.5)
+ SQRP5
+ JMS I FDIVM /Z=F+SQR(.5)/F-SQR(.5)
+ FPPTM2
+ JMS I [FFPUT
+ FPPTM1
+ JMS I FSQRM /Z**2
+ JMS I [FFPUT
+ FPPTM2
+ JMS I FMPYM /C5(Z**2)
+ LOGC5
+ JMS I FADDM /C3+C5(Z**2)
+ LOGC3
+ JMS I FMPYM /C3(Z**2)+C5(Z**4)
+ FPPTM2
+ JMS I FADDM /C1+C3(Z**2)+C5(Z**4)
+ LOGC1
+ JMS I FMPYM /C1(Z)+C3(Z**3)+C5(Z**5)
+ FPPTM1
+ JMS I FSUBM /C1(Z)+C3(Z**3)+C5(Z**5)-1/2=LOG2(F)
+ ONEHAF
+ JMS I [FFPUT /SAVE LOG2(F)
+ FPPTM2
+ TAD GTFLG /I
+ DCA ACX /SET UP FLOAT
+ JMS I [FFLOAT
+ JMS I FADDM /I+LOG2(F)
+ FPPTM2
+ JMS I FMPYM /[I+LOG2(F)]*LOGE(2)=LOGE(X)
+ LN2
+ JMP I LOG /FAC=LN(X)
+
+ GT1FLG=LOG
+FMPYM, FFMPY
+FADDM, FFADD
+FDIVM, FFDIV
+FDIV1M, FFDIV1
+FSUBM, FFSUB
+FSUB1M, FFSUB1
+FSQRM, FFSQ
+ARTRAP, LM
+/CONSTANTS USED BY VARIOUS FUNCTIONS
+
+SINA1, 1 /1.5707949
+ 3110
+ 3747
+SINA3, 0 /-.64592098
+ 5325
+ 1167
+SINA5, 7775 /.07948766
+ 2426
+ 2466
+SINA7, 7771 /-.004362476
+ 5610
+ 3164
+PIOV2, 1 /1.5707963
+ 3110
+ 3756
+LOG2E, 1 /1.442695
+ 2705
+ 2434
+LN2OV2, 7777 /.34657359
+ 2613
+ 4415
+EXPB1, 6 /60.090191
+ 3602
+ 7054
+EXPA1, 12 /-601.80427
+ 5514
+ 3104
+EXPA0, 4 /12.015017
+ 3001
+ 7301
+ATANB0, 7776 /.17465544
+ 2626
+ 6157
+ATANA1, 2 /3.7092563
+ 3553
+ 1071
+ATANB1, 3 /6.762139
+ 3303
+ 670
+ATANA2, 3 /-7.10676
+ 4344
+ 5267
+ATANB2, 2 /3.3163354
+ 3241
+ 7554
+ATANA3, 7777 /-.26476862
+ 5703
+ 4040
+ATANB3, 1 /1.44863154
+ 2713
+ 3140
+SQRP5, 0 /.7071068
+ 2650
+ 1170
+LOGC1, 2 /2.8853913
+ 2705
+ 2440
+LOGC3, 0 /.9614706
+ 3661
+ 566
+LOGC5, 0 /.59897865
+ 2312
+ 5525
+ONEHAF, 0 /.5
+ 2000
+ 0
+LN2, 0 /.6931472
+ 2613
+ 4415
+\f *4500
+
+ /******FIX******
+/ROUTINE TO FIX ANY FLOATING NUMBER IN FAC BETWEEN -2047 AND +2047 TO
+/A TWELVE BIT INTEGER AND LEAVE RESULT IN EXP (LOC 44)
+
+FFIX, 0
+ CLA
+ TAD ACX /FETCH EXPONENT
+ SZA SMA /IS NUMBER <1?
+ JMP .+3 /NO-CONTINUE ON
+FTRPRT, CLA
+ JMP FIXDNE+1 /YES-FIX IT TO ZERO
+ TAD (-13 /SET BINARY POINT AT 11
+ SNA /PLACES TO RIGHT OF CURRENT POINT?
+ JMP FIXDNE /NO-NUMBER IS ALREADY FIXED THEN.
+ SMA /YES-IS NUMBER TOO LARGE TO FIX?
+ JMP I (FO /YES-TAKE OVERFLOW TRAP
+ DCA ACX /NO-SET SCALE COUNT
+FIXLP, CLL /0 IN LINK
+ TAD ACH /GET HIGH MANTISSA
+ SPA /IS IT <0?
+ CML /YES-PUT A 1 IN LINK
+ RAR /SCALE RIGHT
+ DCA ACH /SAVE
+ ISZ ACX /DONE YET?
+ JMP FIXLP /NO
+FIXDNE, TAD ACH /YES-ANSWER IN AC
+ DCA ACX /RETURN WITH ANSWER IN 44
+ JMP I FFIX /RETURN
+
+/******FLOAT******
+/ROUTINE TO FLOAT ANY INTEGER IN EXP (LOC 44) INTO FAC
+
+FFLOAT, 0
+ TAD ACX
+ DCA ACH /PUT NUMBER IN HI MANTISSA
+ DCA ACL /CLEAR LOW MANTISSA
+ TAD (13 /11(10) INTO EXPONENT
+ DCA ACX
+ JMS I [FFNOR /NORMALIZE
+ JMP I FFLOAT /RETURN
+\f/RANDOM NUMBER GENERATOR
+
+RND, 0
+ TAD I (RSEED /GET SEED
+ DCA TEMP3 /PUT IN MULTIPLY OPERAND
+ TAD (73
+ JMS I [MPY /MULTIPLY SEED BY 73
+ DCA I (RSEED /USE LOW ORDER 12 BITS AS NEW SEED
+ TAD I (RSEED /LOW ORDER OF PRODUCT ALSO SERVES
+ CLL RAR /AS RANDOM NUMBER
+ DCA ACH /SET SIGN TO 0 AND STORE AS HORD
+ DCA ACX
+ RAR
+ DCA ACL /USE 12 BITS AS MANTISSA
+ DCA AC1 /CLEAR FPP OVERFLOW
+ JMS I [FFNOR /AND NORMALIZE
+ JMP I [ILOOP /DONE
+
+ PAGE
+\f /FLOATING POINT OUTPUT ROUTINE
+ /CONVERT INTERNAL NUMBER TO ASCII
+ /EXIT WITH CHAR STRING IN 'INTERB'
+ /XR1 = POINTER TO LAST CHAR STORED
+
+FFOUT, 0
+ TAD (INTERB-1
+ DCA XR1 /SET POINTER TO ASCII BUFFER
+ TAD ACH /SEE IF FAC NEGATIVE
+ SMA CLA
+ JMP OKPOS /JMP IF POSITIVE
+ JMS I [FFNEG /TAKE ABS VALUE IF NEGATIVE
+ TAD ("- /PRINT MINUS SIGN
+ SKP
+OKPOS, TAD (240 /PRINT SPACE IF POSITIVE
+ DCA I XR1
+ TAD ACH /SEE IF NUMBER IS ZERO
+ SNA CLA
+ JMP ZERXIT /SPECIAL CASE IF SO
+ JMS I (CVTNUM /CALL ROUTINE TO UNPACK TO BASE 10
+ TAD (NUMBUF-1
+ DCA XR2 /POINT XR2 AT DIGIT BUFFER
+ TAD (5 /TEST FORMAT TO USE
+ TAD DECEXP
+ CLL
+ TAD (-4
+ SNL
+ JMP SMLFMT /JMP IF .0NNNNNN TO .0000NNNNNN
+ TAD (-7
+ SZL CLA
+ JMP REGFMT /JMP IF .NNNNNN TO NNNNNN
+ /OTHERWISE USE E FORMAT N.NNNNNE+NNN OR N.NNNNNE-NNN
+ TAD I XR2 /GET DIGIT TO LEFT OF POINT
+ JMS PUTD /PUT IT OUT
+ TAD (".
+ DCA I XR1 /NOW SEND OUT DECIMAL POINT
+ TAD (-5
+ DCA AC2 /DO 5 MORE DIGITS
+ TAD I XR2 /PICK UP DIGIT
+ JMS PUTD /CONVERT TO ASCII AND STORE
+ ISZ AC2
+ JMP .-3 /LOOP FOR MORE
+ TAD ("E /PRINT E
+ DCA I XR1
+/ CLL
+ TAD DECEXP /TAKE ABS(DECEXP)
+ SPA
+ CML CIA
+ DCA DECEXP
+ RTL /CONVERT "+" TO "-" IF NEGATIVE
+ TAD ("+
+ DCA I XR1
+ JMS IDIV /PRINT 3 DIGITS OF EXPONENT NOW
+ -144
+ JMS IDIV
+ -12
+ TAD DECEXP
+ JMS PUTD
+ JMP I FFOUT /ALL DONE --RETURN--
+\f /HANDLE .0NNNNNN TO .0000NNNNNN
+
+SMLFMT, DCA AC0 /STORE NUMBER OF LEADING ZEROES
+ TAD (". /PUT OUT DECIMAL POINT
+ DCA I XR1
+ JMS PUTD /SEND A 0
+ ISZ AC0
+ JMP .-2 /LOOP FOR LEADING 0'S
+
+ /GENERAL NON E FORMAT .NNNNNN TO NNNNNN
+
+REGFMT, TAD (-7
+ DCA AC1 /INIT COUNT OF NONZERO DIGITS
+ TAD (NUMBUF+6
+ DCA AC2 /POINT AT END OF DIGIT BUFFER
+SHRINK, STA /DECREMENT DIGIT POINTER
+ TAD AC2
+ DCA AC2
+ ISZ AC1 /REDUCE SIGNIFICANT DIGIT COUNT
+ TAD DECEXP
+ IAC
+ TAD AC1
+ SMA CLA
+ JMP PRTLP /JMP OUT IF NOT TO RIGHT OF DECIMAL POINT
+ TAD I AC2 /ELSE LOOK AT DIGIT
+ SNA CLA
+ JMP SHRINK /DISCARD IT IF ZERO
+PRTLP, STA
+ TAD DECEXP
+ DCA DECEXP /SEE IF DIGIT TO BE PRINTED FOLLOWS DP
+ AC0002
+ TAD DECEXP
+ SZA CLA
+ JMP NODP /NO
+ TAD (". /YES, PRINT DP
+ DCA I XR1
+NODP, TAD I XR2 /PICK UP DECIMAL DIGIT
+ JMS PUTD /PUT OUT
+ ISZ AC1
+ JMP PRTLP /JMP IF MORE DIGITS TO PRINT
+ JMP I FFOUT /--RETURN--
+
+ZERXIT, JMS PUTD
+ JMP I FFOUT /--RETURN--
+
+ /DIVIDE DECEXP BY -DIVISOR IN CALL+1
+
+IDIV, 0
+ DCA AC1 /CLEAR QUOTIENT
+IDIVLP, TAD DECEXP
+ TAD I IDIV
+ SPA
+ JMP IDVOUT /JMP OUT IF LESS THAN DIVISOR
+ DCA DECEXP /ELSE UPDATE IT
+ ISZ AC1 /TALLY QUOTIENT
+ JMP IDIVLP /ITERATE
+IDVOUT, CLA
+ TAD AC1 /GET QUOT AS NEXT DIGIT
+ JMS PUTD /PUT OUT
+ ISZ IDIV
+ JMP I IDIV
+
+ /CONVERT NUMBER IN AC TO ASCII DIGIT
+ /MUST NOT TOUCH THE LINK
+
+PUTD, 0
+ TAD ("0 /ADD IN 0
+ DCA I XR1 /STORE IN BUFFER
+ JMP I PUTD
+
+ PAGE
+\f /CONVERT NUMBER IN FAC TO FORMAT N.NNNNNE NNN
+ /DECIMAL EXPONENT RETURNED AS SIGNED NUMBER IN DECEXP
+ /6 DIGITS STORED IN NUMBUF AS BINARY 0-9
+ /FIRST REDUCES MANTISSA TO FORM 0DD DDF FFF FFF...
+ /BY SUCCESSIVE MULTIPLIES OR DIVIDES BY 10. FOLLOWED BY
+ /RENORMALIZATIONS UNTIL INTIGER BITS
+ /DDDD ARE LT 10.
+ /DECIMAL DIGITS ARE ISOLATED BY REPEATED MULTIPLICATION BY 10.
+
+CVTNUM, 0
+ DCA AC1 /CLEAR OVERFLOW WORD
+ SKP /SKP IN AND CLEAR DECIMAL EXPONENT
+ADJDEC, TAD DECEXP
+ DCA DECEXP /STORE UPDATED DECIMAL EXPONENT
+NORML, TAD ACH /SEE IF FRACTION IS NORMALIZED
+ RAL
+ SPA CLA
+ JMP NORMED /JMP IF YES
+ JMS I (AL1 /SHIFT AC LEFT 1 BIT
+ STA
+ TAD ACX /COMPENSATE BINARY EXPONENT
+ DCA ACX
+ JMP NORML /TRY AGAIN
+NORMED, TAD ACX /RANGE CHECK BINARY EXPONENT NOW
+ SMA SZA
+ JMP DIVCHK /JMP IF NUMBER GE 1
+ TAD O4
+ DCA ACX /INCREASE BINARY EXP TOWARDS ZERO
+ JMS AR1 /SHIFT 4 BITS RIGHT
+ JMS AR1 /MAX RELATIVE ERROR WILL BE LT 15*2^-34 PER MULTIPLY
+ JMS AR1
+ JMS AR1
+ JMS MPY10 /NOW MULTIPLY BY 10.
+ STA /DECREASE DECIMAL EXPONENT
+ JMP ADJDEC /RENORMALIZE AND TRY AGAIN
+
+DIVCHK, TAD (-5 /SEE IF EXP GT 4
+ SPA
+ JMP INRANG /JMP IF NOT, NUMBER MAY BE IN RANGE
+DIVGO, CLA CLL
+ TAD (-40 /SET 32. STAGE SUBTRACT-SHIFT DIVIDE (SLOW BUT ACCURATE)
+ DCA AC2 /(THE LEN ELEKMAN TECHNIQUE)
+ /MAX RELATIVE ERROR WILL BE LT 9*2^-34. PER DIVIDE
+DVLOOP, TAD ACH /SEE IF GE 10.
+ TAD (5400
+ SMA
+ DCA ACH /UPDATE IF YES
+ CML STA RAL
+ DCA AC0 /SAVE LOW ORDER BIT
+ JMS I (AL1 /SHIFT MANTISSA NOW
+ ISZ AC0 /STORE BIT NOW
+ ISZ AC1
+ ISZ AC2 /BUMP COUNT
+ JMP DVLOOP /ITERATE
+ TAD ACH /NOW ZERO OUT REMAINDER
+ AND [377
+ DCA ACH
+ IAC /NOW INCREASE DECIMAL EXPONENT
+ JMP ADJDEC
+
+INRANG, DCA AC2 /SET SHIFT COUNTER
+ SKP
+ JMS AR1 /SHIFT FAC RIGHT
+ ISZ AC2
+ JMP .-2 /LEAVE EFFECTIVE BINARY POINT RIGHT OF ACH BIT 4
+ TAD ACH /ACH = 0DD DDF FFF FFF (D=DECIMAL DIGIT BITS)
+ TAD (5400 /SEE IF DDDD GE 10
+ SMA CLA
+ JMP DIVGO /DIVIDE AGAIN (NORMALIZATION WILL WORK)
+ CLL
+ TAD AC1 /NOW ROUND BY ADDING 0.000005
+ TAD (4761
+ DCA AC1
+ IAC /ADD 24761 TO LOW BITS
+ RAL
+ TAD ACL
+ DCA ACL
+ SZL
+ ISZ ACH
+ TAD ACH
+ TAD (5400 /SEE IF CARRY INTO 9.XXX...
+ SZA CLA
+ JMP CVT10 /JMP IF NO
+ TAD [200 /ELSE SET TO 1.00000
+ DCA ACH
+ DCA ACL
+ DCA AC1
+ ISZ DECEXP /AND BUMP DECIMAL EXPONENT
+O4, 4 /EFFECTIVE NOP
+
+ /NOW CONVERT TO DECIMAL DIGITS
+
+CVT10, TAD (-6 /DO 6 DIGITS
+ DCA AC0
+ TAD (NUMBUF-1
+ DCA XR3
+ JMP CVTGO /FIRST DIGIT IS ALREADY IN
+CVTLP, TAD ACH /ZERO OUT PREV DIGIT
+ AND [177
+ DCA ACH
+ JMS MPY10 /MULTIPLY BY 10.
+CVTGO, TAD ACH /GET DIGIT FROM 0DD DDF FFF FFF
+ RTL
+ RTL
+ RTL
+ AND [17
+ DCA I XR3 /STORE IT
+ ISZ AC0
+ JMP CVTLP /LOOP IF MORE
+ JMP I CVTNUM /--RETURN--
+
+ /MULTIPLY ACH,,ACL,,AC1 BY 10.
+
+MPY10, 0
+ TAD ACH
+ DCA OPH /COPY AC TO OP
+ TAD ACL
+ DCA OPL
+ TAD AC1
+ DCA AC2
+ JMS I (AL1 /N*2
+ JMS I (AL1 /N*4
+ JMS I (OADD /N*5
+ JMS I (AL1 /N*10.
+ JMP I MPY10
+
+ /SHIFT FAC RIGHT 1 BIT
+
+AR1, 0
+ TAD ACH
+ CLL RAR
+ DCA ACH
+ TAD ACL
+ RAR
+ DCA ACL
+ TAD AC1
+ RAR
+ DCA AC1
+ JMP I AR1 /DONE
+
+ PAGE
+\f IFZERO EAE <
+
+/FLOATING POINT INPUT ROUTINE
+
+FFIN, 0
+ CLA CMA
+ DCA I FDVPT /INITIALIZE PERIOD SWITCH TO -1
+ CMA /SET SIGN SWITCH TO -1
+ DCA SIGNF
+ CDF /DF TO PACKAGE FIELD
+ DCA DSWIT /ZERO CONVERSION SWITCH
+DECONV, DCA ACX /ZERO OUT THE FAC!
+ DCA ACL
+P200, 200
+ DCA ACH
+DECNV, DCA DNUMBR /ZERO # OF DIGITS SINCE DEC. PT.
+DECON, JMS GCHR /GET A CHAR.FROM TTY.
+ JMP FFIN1 /TERMINATOR-
+ ISZ DSWIT /DIGIT-BUMP CONVERSION SWITCH
+ ISZ DNUMBR /BUMP # OF DIGITS-# IS STORED IN
+ JMS I FMPYLL /"FMPY TEN"
+ TEN
+ JMS I [FFPUT /"FPUT I TM3PT"
+ FPPTM1
+ JMS I [FFGET /"FGET TP"
+ TP
+ JMS I [FFNOR /"FNOR"
+ JMS I FADDLL /"FADD I TM3PT"
+ FPPTM1
+ JMP DECON /GO ON
+FFIN1, ISZ I FDVPT /HAVE WE HAD A PERIOD YET?
+ JMP FIGO2 /YES-GO ON
+ ISZ TP1 /NO-IS THIS A PERIOD?
+ ISZ TP1
+ SKP CLA
+ JMP DECNV /YES-ZERO DIG. COUNT AFTER DEC. PT.
+ /AND GO CONVERT REST
+ DCA DNUMBR /NO-TERMINATOR-ZERO COUNT OF
+ /DIGITS AFTER DECIMAL POINT.
+FIGO2, ISZ SIGNF /IS # NEGATIVE?(DID WE GET - SIGN?)
+ JMS I FFNEGP /YES-NEGATE IT
+ CLA CMA /RESET SIGN SWITCH FOR EXP.
+ DCA SIGNF
+ TAD CHAR /NO-WAS THE TERMINATOR AN 'E'?
+ TAD KME
+ SNA CLA
+GETE, JMS GCHR /YES-GET A CHAR. OF EXPONENT
+ JMP EDON /END OF EXPONENT
+ TAD TM /GOT DIG. OF EXP-STORED IN TP1
+ CLL RTL /MULT. ACCUMULATED EXP BY 10
+ TAD TM
+ CLL RAL
+ TAD TP1 /ADD DIGIT
+ JMP GETE /CONTINUE
+\fEDON, TAD TM /GET EXPONENT
+ ISZ SIGNF /WAS EXPONENT NEGATIVE?
+ CMA IAC /YES-NEGATE IT
+ CMA IAC /AND CALC. DNUMBR - EXPON.
+ TAD DNUMBR /GET # TIMES TO DIV MANTISSA BY TEN
+ CLL CMA IAC
+ SPA /RESULT POSITIVE?
+ CLL CMA CML IAC /NO-MAKE POS. AND SET LINK
+ CMA /NEGATE FOR COUNTER
+ DCA DNUMBR /AND STORE
+ RAL /LINK=1-DIV;=0-MUL. # BY TEN
+ TAD MDV /FORM CORRECT INSTRUCTION
+ DCA SIGNF /AND STORE FOR EXECUTION
+FCNT, ISZ DNUMBR /DONE ALL OPERATIONS?
+ JMP SIGNF /NO
+ JMP I FFIN /YES-RETURN
+SIGNF, 0 /NO- MUL OR DIV. MANTISSA
+ TEN /BY TEN
+ JMP FCNT /GO ON
+FFNEGP, FFNEG
+DNUMBR, 0
+KME, -305
+MDV, JMS I .+1 /THESE 3 WDS. MUST BE IN THIS ORDER
+FMPYLL, FFMPY
+FDVPT, FFDIV /!!!!!!!!!!!!!!!!!
+FADDLL, FFADD
+
+KK12, 12
+TP, 13
+TP1, 0
+ 0
+TEN, 4
+ 2400
+ 0
+\f/ROUTINE TO GET A CHAR FROM THE TTY AND SEE IF IT IS DIGIT
+/OR A TERMINATOR.
+/RETURN TO CALL + 1 IF TERMINATOR, TO CALL + 2 IF DIGIT
+/THIS ROUTINE MUST NOT MODIFY THE MQ!!
+GCHR, 0
+ DCA TM /STORE ACCUMULATED EXPONENT (MAYBE)
+ JMS INPUT /GET A CHAR FROM TTY.
+ TAD CHAR /PICK IT UP
+ TAD PLUS /WAS IT PLUS SIGN?
+ SNA
+ JMP DECON1 /YES-GET ANOTHER CHAR.
+ TAD MINUS /NO WAS IT MINUS SIGN?
+ SZA CLA
+ JMP .+3
+ DCA SIGNF /YES-FLIP SWITCH
+DECON1, JMS INPUT /GET A CHAR.
+ TAD CHAR
+ TAD K7506 /SEE IF ITS A DIGIT
+ CLL
+ TAD KK12
+ DCA TP1 /STORE FOR LATER
+ SZL /DIGIT?
+ ISZ GCHR /YES-RETN. TO CALL+2
+ JMP I GCHR /NO-RETN. TO CALL+1
+K7506, 7506
+/
+/INPUT ROUTINE-IGNORES LEADING SPACES
+/
+INPUT, 0
+ JMS I IGETCH /USE OUR ROUTINE TO GET CHAR
+ TAD DSWIT /GET TERMINATOR
+ SZA CLA /VALID INPUT YET?
+ JMP IOUT /YES-CONTINUE
+ TAD CHAR /NO-GET CHAR
+ TAD M240 /COMPARE AGAINST SPACE
+ SZA /SKP IF SPACE
+ TAD (240-212 /COMPARE TO LF
+ SNA CLA /IS IT A SPACE OR LF?
+ JMP INPUT+1 /YES-IGNORE IT
+IOUT, JMP I INPUT /RETURN
+IGETCH, GETCH /POINTER TO GET CHAR ROUTINE
+ /ALTERED BY "VAL" FUNCTION TO PICK FROM SAC (BE CAREFULL)
+M240, -240
+PLUS, -253
+MINUS, 253-255
+/
+/ROUTINE TO DECIDE CALLING MODE IN LIEU OF "SPECIAL MODE" PROBLEMS
+/
+PATCHF, 0
+ SZA /IS AC EMPTY
+ JMP RTN2 /NO-THIS IS ALWAYS SI MODE WITH ADDR IN AC
+ TAD FF /YES-GET SPECIAL MODE FLIP-FLOP
+ SZA CLA /IF ON,THE ZERO AC MEANS ADDRESS OF 0
+RTN2, ISZ PATCHF /USE AC AS ADDRESS OF OPERAND
+ JMP I PATCHF /RETURN
+\f PAGE
+/
+/INVERSE FLOATING SUBTRACT-USES FLOATING ADD
+/!!FSW1!!-THIS IS OP-FAC
+/
+FFSUB1, 0
+ JMS I [PATCHF /WHICH MODE?
+ TAD I FFSUB1 /CALLED BY USER-GET ADDR. OF OP.
+ JMS I ARGETL /GO PICK UP OPERAND
+ CDF
+ JMS I FFNEGA /NEGATE FAC
+ TAD FFSUB1 /AND GO ADD
+ JMP I SUB0P
+FFNEGA, FFNEG
+SUB0P, SUB0
+/
+/INVERSE FLOATING DIVIDE
+/FSWITCH=1
+/THIS IS OP/FAC
+/
+FFDIV1, 0
+ JMS I [PATCHF /WHICH MODE OF CALL?
+ TAD I FFDIV1 /CALLED BY USER-GET ADDR.
+ JMS I ARGETL /PICK UP OPERAND
+ TAD ACL /SWAP THE FAC AND OPERAND
+ DCA OPL /THERE IS A POINTER TO OPL
+ TAD I AC2 /IN AC2 LEFT FROM ARGET SUBR.
+ DCA ACL
+ TAD ACX /MIGHT AS WELL SUBTRACT THE
+ CLL CMA IAC /EXPONENTS HERE (SAVES A WORD)
+ TAD OPX /THEN ZERO OPX SO WILL NOT
+ DCA ACX /MESS UP WHEN ITS DONE AGAIN
+ DCA OPX /LATER (SEE DIV. ROUTINE)
+ TAD ACH
+ DCA AC2 /NOW SWAP HIGH ORDER MANTISSAS
+ TAD OPH
+ DCA ACH
+ TAD AC2
+ DCA OPH
+ CDF /DF TO PACKAGE FIELD
+ TAD FFDIV1 /NOW KLUDGE UP A SUBROUTINE LINKAGE
+ DCA I FFDP
+ TAD KFD1
+ DCA I MDSETP
+ JMP I MD1P /GO SET UP AND DIVIDE
+
+MD1P, MD1
+ARGETL, ARGET
+MDSETP, MDSET
+FFDP, FFDIV
+KFD1, FFD1
+\f/MDSET-SETS UP SIGNS FOR MULTIPLY AND DIVIDE
+/ALSO SHIFTS OPERAND ONE BIT TO THE LEFT.
+/EXIT WITH EXPONENT OF OPERAND IN AC FOR EXPONENT
+/CALCULATION-CALLED WITH ADDRESS OF OPERAND IN AC AND
+/DATA FIELD SET PROPERLY FOR OPERAND.
+/
+MDSET, 0
+ JMS I ARGETK /GET ARGUMENT
+MD1, CDF /DF TO PACKAGE FIELD
+ CLA CLL CMA RAL /SET SIGN CHECK TO -2
+ DCA TM
+ TAD OPH /IS OPERAND NEGATIVE?
+ SMA CLA
+ JMP .+3 /NO
+ JMS I OPNEGP /YES-NEGATE IT
+ ISZ TM /BUMP SIGN CHECK
+ TAD OPL /AND SHIFT OPERAND LEFT ONE BIT
+ CLL RAL
+ DCA OPL
+ TAD OPH
+ RAL
+ DCA OPH
+ DCA AC1 /CLR. OVERFLOW WORF OF FAC
+ TAD ACH /IS FAC NEGATIVE
+ SMA CLA
+ JMP LEV /NO-GO ON
+ JMS I FFNEGK /YES-NEGATE IT
+ ISZ TM /BUMP SIGN CHECK
+ NOP /MAY SKIP
+LEV, TAD OPX /EXIT WITH OPERAND EXPONENT IN AC
+ JMP I MDSET
+
+FFNEGK, FFNEG
+OPNEGP, OPNEG
+ARGETK, ARGET
+
+/
+/CONTINUATION OF FLOATING DIVIDE ROUTINE
+/
+FD1, TAD AC2 /NEGATE HI ORDER PRODUCT
+ CLL CMA IAC
+ TAD ACH /COMPARE WITH REMAINDER OF FIRST DIV.
+ SNL /WELL?
+ JMP I DVOPSP /GREATER THAN REM.-ADJUST QUOT OF 1ST DIV.
+ CLL /OK-DO (REM-(Q*OPL))/OPH
+ DCA ACH /FIRST STORE ADJUSTED PRODUCT
+ JMS I DV24P /DIVIDE BY OPH (HI ORDER OPERAND)
+DVL1, TAD AC1 /GET QUOT. OF FIRST DIV.
+ SMA /IF HI ORDER BIT SET-MUST SHIFT 1 RIGHT
+ JMP FD /NO-ITS NORMALIZED-DONE
+ CLL
+ ISZ ACL
+ SKP
+ IAC
+ RAR
+ DCA ACH /STORE IN FAC
+ TAD ACL /P@ LOW ORDER RIGHT
+ RAR
+ DCA ACL /STORE BACK
+ ISZ ACX /BUMP EXPONENT
+ NOP
+ TAD ACH
+ JMP DVL1+1
+FD, DCA ACH /STORE HIGH ORDER RESULT
+ JMP I FDDONP /GO LEAVE DIVIDE
+
+FDDONP, FDDON /END OF FLTG. DIV. ROUTINE
+DV24P, DV24 /ROUTINE TO DO A 24X12BIT DIVIDE
+DVOPSP, DVOPS /ROUTINE TO ADJUST QUOT OF FIRST DIV.
+/
+/CONTINUATION OF ROUTINE TO ADJUST QUOT. OF FIRST DIV.
+/DBAD1 IS ONLY EXECUTED ON DIVIDE OVERFLOW-OTHERWISE THE
+/ROUTINE STARTS AT DVOP2
+/
+DBAD1, DCA ACX /DIVIDE OVERFLO-ZERO ALL
+DVOP2, SNA /IS IT ZERO?
+ DCA ACL /YES-MAKE WHOLE THING ZERO
+ DCA ACH
+ JMS I DV24P /DIVIDE EXTENDED REM. BY HI DIVISOR
+ TAD ACL /NEGATE THE RESULT
+ CLL CMA IAC
+ DCA ACL
+ SNL /IF QUOT. IS NON-ZERO, SUBTRACT
+ CMA /ONE FROM HIGH ORDER QUOT.
+ JMP DVL1 /GO TO IT
+
+ PAGE
+\f/FLOATING MULTIPLY-DOES 2 24X12 BIT MULTIPLIES
+FFMPY, 0
+ JMS I [PATCHF /WHICH MODE OF CALL?
+ TAD I FFMPY /CALLED BY USER-GET OPERAND ADDR.
+ JMS I MDSETK /SET UP FOR MPY-OPX IN AC ON RETN.
+ TAD ACX /DO EXPONENT ADDITION
+ DCA ACX /STORE FINAL EXPONENT
+ DCA DV24 /ZERO TEM STORAGE FOR MPY ROUTINE
+ DCA AC2
+ TAD ACH /IS FAC=0?
+ SNA CLA
+ DCA ACX /YES-ZERO EXPONENT
+ JMS MP24 /NO-MULTIPLY FAC BY LOW ORDER OPR.
+ TAD OPH /NOW MULTIPLY FAC BY HI ORDER MULTIPLIER
+ DCA OPL
+ JMS MP24
+ TAD AC2 /STORE RESULT BACK IN FAC
+RTZRO, DCA ACL /LOW ORDER
+ TAD DV24 /HIGH ORDER
+ DCA ACH
+ TAD ACH /DO WE NEED TO NORMALIZE?
+ RAL
+ SMA CLA
+ JMP SHLFT /YES-DO IT FAST
+MDONE, DCA AC1 /NO-ZERO OVERFLOW WD(DO I NEED THIS???)
+ ISZ FFMPY /BUMP RETURN POINTER
+ ISZ TM /SHOULD RESULT BE NEGATIVE?
+ JMP I FFMPY /NOPE-RETN.
+ JMS I FFNEGR /YES-NEGATE IT
+ JMP I FFMPY /RETURN
+SHLFT, CMA /SUBTRACT 1 FROM EXP.
+ TAD ACX
+ DCA ACX
+ JMS I AL1PTR /SHIFT FAC LEFT 1 BIT
+ JMP MDONE+1 /DONE.
+AL1PTR, AL1
+/
+/24 BIT BY 12 BIT MULTIPLY. MULTIPLIER IS IN OPL
+/MULTIPLICAND IS IN ACH AND ACL
+/RESULT LEFT IN DV24,AC2, AND AC1
+MP24, 0
+ TAD KKM12 /SET UP 12 BIT COUNTER
+ DCA OPX
+ TAD OPL /IS MULTIPLIER=0?
+ SZA
+ JMP MPLP1 /NO-GO ON
+ DCA AC1 /YES-INSURE RESULT=0
+ JMP I MP24 /RETURN
+MPLP, TAD OPL /SHIFT A BIT OUT OF LOW ORDER
+MPLP1, RAR /OF MULTIPLIER AND INTO LINK
+ DCA OPL
+ SNL /WAS IT A 1?
+ JMP MPLP2 /NO-0-JUST SHIFT PARTIAL PRODUCT
+\f CLL /YES-ADD MULTIPLICAND TO PARTIAL PRODUCT
+ TAD AC2
+ TAD ACL /LOW ORDER
+ DCA AC2
+ RAL /PROPAGATE CARRY
+ TAD ACH /HI ORDER
+MPLP2, TAD DV24
+ RAR /NOW SHIFT PARTIAL PROD. RIGHT 1 BIT
+ DCA DV24
+ TAD AC2
+ RAR
+ DCA AC2
+ RAR /1 BIT OF OVERFLOW TO AC1
+ DCA AC1
+ ISZ OPX /DONE ALL 12 MULTIPLIER BITS?
+ JMP MPLP /NO-GO ON
+ JMP I MP24 /YES-RETURN
+/
+/PART OF DIVIDE ROUTINE-FFDIV MUST BE AT LOC. 6722
+MP12L, DCA OPL /STORE BACK MULTIPLIET
+ TAD AC2 /GET PRODUCT SO FAR
+ SNL /WAS MULTIPLIER BIT A 1?
+ JMP .+3 /NO-JUST SHIFT THE PARTIAL PRODUCT
+ CLL /YES-CLEAR LINK AND ADD MULTIPLICAND
+ TAD ACL /TO PARTIAL PRODUCT
+ RAR /SHIFT PARTIAL PRODUCT-THIS IS HI ORDER
+ DCA AC2 /RESULT-STORE BACK
+DVLP1, TAD OPL /SHIFT A BIT OUT OF MULTIPLIER
+ RAR /AND A BIT OR RESLT. INTO IT (LO ORD. PROD.)
+ ISZ FFMPY /DONE ALL BITS?
+ JMP MP12L /NO-LOOP BACK
+ CLL CMA IAC /YES-LOW ORDER PROD. OF QUOT. X OPL IN AC
+ DCA ACL /NEGATE AND STORE
+ CML RAL /PROPAGATE CARRY
+ JMP I FD1P /GO ON
+FD1P, FD1 /POINTER TO REST OF DIVIDE ROUTINE
+/
+/FLOATING DIVIDE ROUTINE
+/USES THE METHOD OF TRIAL DIVISION BY HI ORDER
+FFDIV, 0 /(USED AS A TEM. BY I/O ROUTINES)
+ JMS I [PATCHF /WHICH MODE OF CALL?
+ TAD I FFDIV /CALLED BY USER-GET ARG. ADDR.
+ JMS I MDSETK /GO SET UP FOR DIVIDE-OPX IN AC ON RETN.
+FFD1, CMA IAC /NEGATE EXP. OF OPERAND
+ TAD ACX /ADD EXP OF FAC
+ DCA ACX /STORE AS FINAL EXPONENT
+ TAD OPH /NEGATE HI ORDER OP. FOR USE
+ CLL CMA IAC /AS DIVISOR
+ DCA OPH
+ JMS DV24 /CALL DIV.--(ACH+ACL)/OPH
+ TAD ACL /SAVE QUOT. FOR LATER
+ DCA AC1
+ TAD KM13 /SET COUNTER FOR 12 BIT MULTIPLY
+ DCA FFMPY /TO MULTIPLY QUOT. OF DIV. BY
+ JMP DVLP1 /LOW ORDER OF OPERAND (OPL)
+\f/
+/END OF FLOATING DIVIDE-FUDGE SOME
+/STUFF THEN JUMP INTO MULTIPLY
+/
+FDDON, TAD FFDIV /STORE RETN. ADDR. IN MULT ROUTINE
+ DCA FFMPY
+ JMP MDONE /GO CLEAN UP
+/
+/DIVIDE ROUTINE--24 BITS IN ACH,ACL ARE DIVIDED BY 12 BITS
+/IN OPH. OPH IS ASSUMED NEGATIVE AND .GT. ACH IN ABSOLUTE VALUE
+/ELSE-DIVIDE OVERFLOW--WE RETURN NORMALLY WITH QUOTIENT
+/IN ACL AND REM. IN ACH. (AC2=0 ON RETN.)
+/
+DV24, 0
+ TAD ACH /CHECK THAT DIVISOR IS .GT. DIVIDEND
+ TAD OPH /DIVISOR IN OPH (NEGATIVE)
+ SZL CLA /IS IT?
+ JMP I DVOVR /NO-DIVIDE OVERFLOW
+ TAD KM13 /YES-SET UP 12 BIT LOOP
+ DCA AC2
+ JMP DV1 /GO BEGIN DIVIDE
+DV2, TAD ACH /CONTINUE SHIFT OF FAC LEFT
+ RAL
+ DCA ACH /RESTORE HI ORDER
+ TAD ACH /NOW SUBTRACT DIVISOR FROM HI ORDER
+ TAD OPH /DIVIDEND
+ SZL /GOOD SUBTRACT?
+ DCA ACH /YES-RESTORE HI DIVIDEND
+ CLA /NO-DON'T RESTORE--OPH.GT.ACH
+DV1, TAD ACL /SHIFT FAC LEFT 1 BIT-ALSO SHIFT
+ RAL /1 BIT OF QUOT. INTO LOW ORD OF ACL
+ DCA ACL
+ ISZ AC2 /DONE 12 BITS OF QUOT?
+ JMP DV2 /NO-GO ON
+ JMP I DV24 /YES-RETN W/AC2=0
+FFNEGR, FFNEG
+MDSETK, MDSET
+KKM12, -14
+KM13, -15
+DVOVR, DV
+
+ PAGE
+\f/
+/FLOATING ADD
+/
+FFADD, 0
+ JMS I [PATCHF /WHICH MODE FO CALL?
+ TAD I FFADD /CALLED BY USER-GET ADDR. OF OPR.
+ JMS I ARGETP /PICK UP OPERAND
+FAD1, CDF /DF TO PACKAGE FIELD
+ TAD OPH /IS OPERAND = 0
+ SNA CLA
+ JMP DONA /YES-DONE
+ TAD ACH /NO-IS FAC=0?
+ SNA CLA
+ JMP DOADD /YES-DO ADD
+ TAD ACX /NO-DO EXPONENT CALCULATION
+ CLL CMA IAC
+ TAD OPX
+ SMA SZA /WHICH EXP. GREATER?
+ JMP FACR /OPERANDS-SHIFT FAC
+ CMA IAC /FAC'S-SHIFT OPERAND=DIFFRNCE+1
+ JMS OPSR
+ JMS ACSR /SHIFT FAC ONE PLACE RIGHT
+DOADD, TAD OPX /SET EXPONENT OF RESULT
+ DCA ACX
+ JMS OADD /DO THE ADDITION
+ JMS I FNORP /NORMALIZE RESULT
+DONA, ISZ FFADD /BUMP RETURN
+ JMP I FFADD /RETURN
+FACR, JMS ACSR /SHIFT FAC = DIFF.+1
+ JMS OPSR /SHIFT OPR. 1 PLACE
+ JMP DOADD /DO ADDITION
+/
+/OPERAND SHIFT RIGHT-ENTER WITH POSITIVE COUNT-1
+/IN AC
+OPSR, 0
+ CMA /- (COUNT+1) TO SHIFT COUNTER
+ DCA AC0
+LOP2, TAD OPH /GET SIGN BIT
+ RAL /TO LINK
+ CLA
+ TAD OPH /GET HI MANTISSA
+ RAR /SHIFT IT RIGHT, PROPAGATING SIGN
+ DCA OPH /STORE BACK
+ TAD OPL
+ RAR
+ DCA OPL /STORE LO ORDER BACK
+ RAR /SAVE 1 BIT OF OVERFLOW
+ DCA AC2 /IN AC2
+ ISZ OPX /INCREMENT EXPONENT
+NOP2, NOP
+ ISZ AC0 /DONE ALL SHIFTS?
+ JMP LOP2 /NO-LOOP
+ JMP I OPSR /YES-RETN.
+\f/
+/SHIFT FAC LEFT 1 BIT
+/
+AL1, 0
+ TAD AC1 /GET OVERFLOW BIT
+ CLL RAL /SHIFT LEFT
+ DCA AC1 /STORE BACK
+ TAD ACL /GET LOW ORDER MANTISSA
+ RAL /SHIFT LEFT
+ DCA ACL /STORE BACK
+ TAD ACH /GET HI ORDER
+ RAL
+ DCA ACH /STORE BACK
+ JMP I AL1 /RETN.
+/
+/SHIFT FAC RIGHT-ENTER WITH COUNT-1 IN AC (POSITIVE)
+/
+ACSR, 0
+ CMA /AC CONTAINS COUNT-1
+ DCA AC0 /STORE COUNT
+LOP1, TAD ACH /GET SIGN BIT OF MANTISSA
+ RAL /SET UP SIGN PROPAGATION
+ CLA
+ TAD ACH /GET HIGH ORDER MANTISSA
+ RAR /SHIFT RIGHT`1, PROPAGATING SIGN
+ DCA ACH /STORE BACK
+ TAD ACL /GET LOW ORDER
+ RAR /SHIFT IT
+ DCA ACL /STORE BACK
+ RAR
+ DCA AC1 /SAVE 1 BIT OF OVERFLOW
+ ISZ ACX /INCREMENT EXPONENT
+NOP1, NOP
+ ISZ AC0 /DONE?
+ JMP LOP1 /NO-LOOP
+ JMP I ACSR /YES-RETN-AC=L=0
+/
+/DIVIDE OVERFLOW-ZERO ACX,ACH,ACL
+/
+DBAD, CLA CLL /NECESSARY SO WE DON'T GET OVRFLO AGAIN
+ JMP I DBAD1P /GO ZERO ALL
+/
+/FLOATING SUBTRACT
+/
+FFSUB, 0
+ JMS I [PATCHF /WHICH MODE OF CALL?
+ TAD I FFSUB /CALLED BY USER-GET ADDR. OF OP
+ JMS I ARGETP /PICK UO THE OP.
+ JMS OPNEG /NEGATE OPERAND
+ TAD FFSUB /JMP INTO FLTG. ADD
+SUB0, DCA FFADD /AFTER SETTING UP RETURN
+ JMP FAD1
+ARGETP, ARGET
+\f *6135
+/
+/FLOATING NEGATE
+/
+FFNEG, 0 /(USED AS A TEM. BY OUTPUT ROUTINE)
+ TAD ACL /GET LOW ORDER FAC
+ CLL CMA IAC /NEGATE IT
+ DCA ACL /STORE BACK
+ CML RAL /ADJUST OVERFLOW BIT AND
+ TAD ACH /PROPAGATE CARRY-GET HI ORD
+ CLL CMA IAC /NEGATE IT
+ DCA ACH /STORE BACK
+ JMP I FFNEG
+/
+/NEGATE OPERAND
+/
+OPNEG, 0
+ TAD OPL /GET LOW ORDER
+ CLL CMA IAC /NEGATE AND STORE BACK
+ DCA OPL
+ CML RAL /PROPAGATE CARRY
+ TAD OPH /GET HI ORDER
+ CLL CMA IAC /NEGATE AND STORE BACK
+ DCA OPH
+ JMP I OPNEG
+/
+/ADD OPERAND TO FAC
+/
+OADD, 0
+ CLL
+ TAD AC2 /ADD OVERFLOW WORDS
+ TAD AC1
+ DCA AC1
+ RAL /ROTATE CARRY
+ TAD OPL /ADD LOW ORDER MANTISSAS
+ TAD ACL
+ DCA ACL
+ RAL
+ TAD OPH /ADD HI ORDER MANTISSAS
+ TAD ACH
+ DCA ACH
+ JMP I OADD /RETN.
+DBAD1P, DBAD1
+FNORP, FFNOR
+ >
+\f IFNZRO EAE <
+/EAE FLOATING POINT PACKAGE
+/FOR PDP8/E WITH KE8-E EAE
+/
+/W.J. CLOGHER
+/
+/DEFINITIONS OF EAE INSTRUCTIONS
+ SWP= 7521
+ CAM= 7621
+ MQA= 7501
+ MQL= 7421
+ SGT= 6006
+ SWAB= 7431
+ SWBA= 7447
+ SCA= 7441
+ MUY= 7405
+ DVI= 7407
+ NMI= 7411
+ SHL= 7413
+ ASR= 7415
+ LSR= 7417
+ ACS= 7403
+ SAM= 7457
+ DAD= 7443
+ DLD= 7663
+ DST= 7445
+ DPIC= 7573
+ DCM= 7575
+ DPSZ= 7451
+ /
+ TM= TEMP4
+ \f/
+/FLOATING POINT INPUT ROUTINE
+/
+ PAGE
+FFIN, 0
+ CLA CMA
+ DCA PRSW /INITIALIZE PERIOD SWITCH TO -1
+ CMA /SET SIGN SWITCH TO -1
+ DCA SIGNF
+ CDF /CHANGE TO DF OF PACKAGE
+ DCA DSWIT /ZERO CONVERSION SWITCH
+DECONV, DCA ACX /ZERO OUT THE FAC!
+ DCA ACL
+ DCA ACH
+DECNV, DCA DNUMBR /ZERO # OF DIGITS SINCE DEC. PT.
+DECON, JMS GCHR /GET A CHAR.FROM TTY.
+ JMP FFIN1 /TERMINATOR-
+ ISZ DSWIT /DIGIT-BUMP CONVERSION SWITCH
+ ISZ DNUMBR /BUMP # OF DIGITS
+ DCA TP1 /STORE IT IN FORM EASILY FLOATIBLE
+ JMS I FMPYLL /MULTIPLY # BY 10
+ TEN
+ JMS I [FFPUT /STORE IT AWAY
+ FPPTM1
+ JMS I [FFGET /GET NEW DIGIT
+ TP
+ JMS I [FFNOR /FLOAT IT
+ JMS I FADDLL /ADD IT TO THE ACCUMULATED #
+ FPPTM1
+ JMP DECON /GO ON
+FFIN1, ISZ PRSW /HAVE WE HAD A PERIOD YET?
+ JMP FIGO2 /YES-GO ON
+ TAD K2 /NO-IS THIS A PERIOD?
+ SNA CLA
+ JMP DECNV /YES-ZERO DIG. COUNT AFTER DEC. PT.
+ /AND GO CONVERT REST
+ DCA DNUMBR /NO-TERMINATOR-ZERO COUNT OF
+ /DIGITS AFTER DECIMAL POINT.
+FIGO2, CLA MQL /0 TO MQ FOR LATER MULTIPLY
+ ISZ SIGNF /IS # NEGATIVE?(DID WE GET - SIGN?)
+ JMS I FFNEGP /YES-NEGATE IT
+ SWAB
+ CMA /RESET SIGN SWITCH FOR EXP.
+ DCA SIGNF
+ TAD CHAR /NO-WAS THE TERMINATOR AN 'E'?
+ TAD KME
+ SNA CLA
+GETE, JMS GCHR /YES-GET A CHAR. OF EXPONENT
+ JMP EDON /END OF EXPONENT
+ MUY /GOT DIGIT OF EXP-MULT ACCUMULATED
+ K12 /EXPONENT BY TEN AND ADD DIGIT
+ JMP GETE /CONTINUE
+\fEDON, ISZ SIGNF /WAS EXPONENT NEGATIVE?
+ DCM /YES-NEGATE IT
+ CLA CLL /CLEAR AC AND LINK
+ TAD DNUMBR /GET # TIMES TO DIV MANTISSA BY TEN
+ SAM /SUBTRACT FROM EXPONENT
+ CLL
+ SPA /RESULT POSITIVE?
+ CLL CMA CML IAC /NO-MAKE POS. AND SET LINK
+ CMA /NEGATE FOR COUNTER
+ DCA DNUMBR /AND STORE
+ RAL /LINK=1-DIV;=0-MUL. # BY TEN
+ TAD MDV /FORM CORRECT INSTRUCTION
+ DCA FINST /AND STORE FOR EXECUTION
+FCNT, ISZ DNUMBR /DONE ALL OPERATIONS?
+ JMP FINST /NO
+ JMP I FFIN /YES-RETURN
+FINST, 0 /NO- MUL OR DIV. MANTISSA
+ TEN /BY TEN
+ JMP FCNT /GO ON
+FFNEGP, FFNEG
+PRSW, 0
+DNUMBR, 0
+SIGNF, 0
+K2, 2
+KME, -305
+MDV, JMS I .+1 /THESE 3 WDS. MUST BE IN THIS ORDER
+FMPYLL, FFMPY
+ FFDIV /!!!!!!!!!!!!!!!!!
+FADDLL, FFADD
+
+K12, 12
+TP, 13
+TP1, 0
+ 0
+TEN, 4
+ 2400
+ 0
+\f/ROUTINE TO GET A CHAR FROM THE TTY AND SEE IF IT IS DIGIT
+/OR A TERMINATOR.
+/RETURN TO CALL + 1 IF TERMINATOR, TO CALL + 2 IF DIGIT
+/THIS ROUTINE MUST NOT MODIFY THE MQ!!
+GCHR, 0
+ JMS INPUT /GET A CHAR FROM TTY.
+ TAD CHAR /PICK IT UP
+ TAD PLUS /WAS IT PLUS SIGN?
+ SNA
+ JMP DECON1 /YES-GET ANOTHER CHAR.
+ TAD MINUS /NO WAS IT MINUS SIGN?
+ SZA CLA
+ JMP .+3
+ DCA SIGNF /YES-FLIP SWITCH
+DECON1, JMS INPUT /GET A CHAR.
+ TAD CHAR
+ TAD K7506 /SEE IF ITS A DIGIT
+ CLL
+ TAD K12
+ SZL /DIGIT?
+ ISZ GCHR /YES-RETN. TO CALL+2
+ JMP I GCHR /NO-RETN. TO CALL+1
+K7506, 7506
+PLUS, -253
+MINUS, 253-255
+/
+/
+/INPUT ROUTINE-IGNORES LEADING SPACES
+/
+INPUT, 0
+ JMS I IGETCH /USE OUR ROUTINE TO GET CHAR
+ TAD DSWIT /GET TERMINATOR
+ SZA CLA /VALID INPUT YET?
+ JMP IOUT /YES-CONTINUE
+ TAD CHAR /NO-GET CHAR
+ TAD M240 /COMPARE AGAINST SPACE
+ SZA
+ TAD (240-212 /IS IT AN LF?
+ SNA CLA /IS IT A SPACE OR LF?
+ JMP INPUT+1 /YES-IGNORE IT
+IOUT, JMP I INPUT /RETURN
+M240, -240
+IGETCH, GETCH /ALTERED BY VAL FUNCITON TO PICK FROM SAC
+/
+/ROUTINE TO DECIDE CALLING MODE IN LIEU OF "SPECIAL MODE" PROBLEMS
+/
+PATCHF, 0
+ SZA /IS AC EMPTY
+ JMP RTN2 /NO-THIS IS ALWAYS SI MODE WITH ADDR IN AC
+ TAD FF /YES-GET SPECIAL MODE FLIP-FLOP
+ SZA CLA /IF ON,THE ZERO AC MEANS ADDRESS OF 0
+RTN2, ISZ PATCHF /USE AC AS ADDRESS OF OPERAND
+ JMP I PATCHF /RETURN
+/
+\f PAGE
+/
+/FLOATING SUBTRACT-USES FLOATING ADD
+/FSW1!!
+FFSUB1, 0
+ JMS I [PATCHF /WHICH MODE?
+ TAD I FFSUB1 /CALLED BY USER-GET ADDR. OF OP
+ JMS I ARGETL /PICK UP ARGUMENT
+ CDF
+ JMS I FFNEGA /NEGATE FAC!
+ TAD FFSUB1
+ JMP I SUB0P
+FFNEGA, FFNEG
+SUB0P, SUB0
+
+
+/
+/FLOATING DIVIDE
+/FSWITCH=1
+/THIS IS OP/FAC
+/
+FFDIV1, 0
+ JMS I [PATCHF /WHICH MODE OF CALL?
+ TAD I FFDIV1 /CALLED BY USER-GET ADDR.
+ JMS I ARGETL /(INTERP.)-GET OPRND.-ADDR. IN AC
+ CDF /CDF TO FIELD OF PACKAGE
+ TAD ACH /SWAP FAC AND OPRND-OPH IN MQ!
+ DCA OPH /STORE ACH IN OPH
+ TAD ACX /GET EXP OF FAC
+ SWP /OPH TO AC, ACX TO MQ
+ DCA ACH /STORE OPH IN ACH
+ TAD OPX /STORE OPX IN ACX
+ DCA ACX
+ TAD OPL /OPL TO MQ, ACX TO AC
+ SWP
+ DCA OPX /STORE ACX IN OPX
+ TAD ACL
+ DCA OPL /STORE ACL IN OPL
+ TAD OPH /OPH TO MQ FOR LATER
+ SWP
+ DCA ACL /STORE OPL IN ACL
+ TAD FFDIV1 /SET UP SO WE RETN TO
+ DCA I FFDP /NORMAL DIVIDE ROUTINE
+ TAD FD1
+ DCA I MDSETP
+ JMP I MD1P /GO ARRANGE OPERANDS
+
+MD1P, MD1
+ARGETL, ARGET
+MDSETP, MDSET
+FFDP, FFDIV
+FD1, FFD1
+
+\f
+/PATCH TO EAE ADD ROUTINE
+
+ADDPCH, 0
+ TAD AC1
+ TAD RB4000
+ DPSZ
+ JMP ADDP1
+ CLL CML RTR
+ ISZ ACX
+ NOP
+ADDP1, TAD RB4000
+ JMP I ADDPCH
+RB4000, 4000
+
+
+/
+PTCHAD, CDF
+ TAD OPH
+ SNA CLA /OPERAND ZERO
+ JMP I JADON /YES
+ TAD ACH /FAC ZERO
+ SZA CLA
+ JMP I JFAD1 /NO
+ TAD OPX
+ DCA ACX
+ TAD OPH
+ DCA ACH
+ TAD OPL
+ DCA ACL
+ JMP I JADON
+JADON, ADON
+JFAD1, FAD1
+\f/
+/FLOATING MULTIPLY--DOES 4 SINGLE MULTIPLIES WITH EAE
+/THIS USES THE FACT THAT IF AC IS NON-ZERO WHEN YOU DO
+/A MUY INSTR, THE AC IS ADDED TO RESULT OF THE MULTIPLY.
+/(IN THE LOW ORDER, NATCHERLY)
+ PAGE
+FFMPY, 0
+ JMS I [PATCHF /WHICH MODE?
+ TAD I FFMPY /CALLED BY USER-GET ADDRESS
+ JMS MDSET /SET UP FOR MULT
+ CLA MUY /MULTIPLY-LOW ORDER FAC STILL IN MQ
+ OPH /THIS IS PRODUCT OF LOW ORDERS
+ MQL /ZAP LOW ORDER RESULT-INSIGNIFICANT
+ TAD ACH /GET LOW ORDER(!) OF FAC
+ SWP MUY /TO MQ-HIGH ORD. RESLT OF LAST MPY
+ OPL /TO AC-WILL BE ADDED TO RESLT-THIS
+ DST /IS PRODUCT-LOW ORD FAC,HI ORD OP
+ AC0 /STORE RESULT
+ DLD /HIGH ORDER FAC TO MQ, OPX TO AC
+ ACL
+ TAD ACX /ADD FAC EXPONENT-GET SUM OF EXPS.
+ DCA ACX /STORE RESULT
+ MUY /MUL. HIGH ORDER FAC BY LOW ORD OP.
+ OPH /HIGH ORDER FAC WAS IN MQ
+ DAD /ADD IN RESULT OF SECOND MULTIPLY
+ AC0
+ DCA ACH /STORE HIGH ORDER RESULT
+ TAD ACL /GET HIGH ORDER FAC
+ SWP /SEND IT TO MQ AND LOW ORD. RESULT
+ DCA AC0 /OF ADD TO AC-STORE IT
+ RAL /ROTATE CARRY TO AC
+ DCA ACL /STORE AWAY
+ MUY /NOW DO PRODUCT OF HIGH ORDERS
+ OPL /FAC HIGH IN MQ, OP HIGH IN OPL
+ DAD /ADD IN THE ACCUMULATED #
+ ACH
+ SNA /ZERO?
+ JMP RTZRO /YES-GO ZERO EXPONENT
+ NMI /NO-NORMALIZE (1 SHIFT AT MOST!)
+ DCA ACH /STORE HIGH ORDER RESULT
+ CLA SCA /GET STEP CNTR-DID WE NEED A SHIFT?
+ SNA CLA
+ JMP SNCK /NO-JUST CHECK SIGN
+ CLA CMA /YES-MUST DECREASE EXP. BY 1
+ TAD ACX
+RTZRO, DCA ACX /STORE BACK
+\f
+ TAD AC0
+ SPA CLA /IS HIGH ORDER OF OVERFLO WD. 1?
+ DPIC /YES-ADD 1 TO LOW ORDER-STILL IN MQ
+SNCK, ISZ MSIGN /RESULT NEGATIVE?
+ JMP MPOS /NO-GO ON
+ TAD ACH /YES-GET HIGH ORDER BACK
+ DCM /LOW ORDER STILL IN MQ-NEGATE
+ DCA ACH /STORE HIGH ORDER BACK
+MPOS, SWP /LOW ORDER TO AC
+ DCA ACL /STORE AWAY
+ ISZ FFMPY /BUMP RETURN
+ JMP I FFMPY /RETIRN
+MSIGN, 0
+ARGETK, ARGET
+DVOFL, DV
+
+/
+/ROUTINE TO SET UP FOR MULTIPLY AND DIVIDE
+/
+MDSET, 0
+ JMS I ARGETK /GET OPERAND (ADDR. IN AC)
+ CDF /CHANGE TO DATA FIELD OF PACKAGE
+MD1, CLA CLL CMA RAL /MAKE A MINUS TWO
+ DCA MSIGN /AND STORE IN MSIGN.
+ TAD OPL /GET LOW ORDER MANTISSA OF OP.
+ SWP /GET INTO RIGHT ORDER ( OPH IN MQ)
+ SMA /NEGATIVE?
+ JMP .+3 /NO
+ DCM /YES-NEGATE IT
+ ISZ MSIGN /BUMP SIGN COUNTER
+ SHL /SHIFT OPRND LEFT 1 TO AVOID OVRFLO
+ 1
+ DST /STORE BACK-OPH CONTAINS LOW ORDER
+ OPH / OPL CONTAINS HIGH ORDER
+ DLD /GET THE MANTISSA OF THE FAC
+ ACH
+ SWP /MAKE IT CORRECT ORDER
+ SMA /NEGATIVE?
+ JMP FPOS /NO
+ DCM /YES-NEGATE IT
+ ISZ MSIGN /BUMP SIGN COUNTER (MAY SKIP)
+ NOP
+FPOS, DST /STORE BACK-ACH CONTAINS LOW ORDER
+ ACH / ACL CONTAINS HIGH ORDER
+ JMP I MDSET /RETURN
+\f
+
+
+/
+/FLOATING DIVIDE
+/
+ *5722
+FFDIV, 0
+ JMS I [PATCHF /WHICH MODE?
+ TAD I FFDIV /CALLED BY USER-GET ARG. ADDRESS
+ JMS MDSET /GET ARG. AND SET UP SIGNS
+FFD1, DVI /DIVIDE-ACH AND ACL IN AC,MQ
+ OPL /THIS IS HI (!) ORDER DIVISOR
+ DST /QUOT TO AC0,REM TO AC1
+ AC0
+ SZL CLA /DIVIDE ERROR?
+ JMP I DVOFL /YES-HANDLE IT
+ TAD OPX /DO EXPONENT CALCULATION
+ CMA IAC /EXP. OF FAC - EXP. OF OP
+ TAD ACX
+ DCA ACX
+ DPSZ /IS QUOT = 0?
+ SKP /NO-GO ON
+ DCA ACX /YES-ZERO EXPONENT
+DVLP, MUY /NO-THIS IS Q*OPL*2**-12
+ OPH
+ DCM /NEGATE IT
+ TAD AC1 /SEE IF GREATER THAN REMAINDER
+ SNL
+ JMP I DVOPSP /YES-ADJUST FIRST DIVIDE
+ DVI /NO-DO Q*OPL*2**-12/OPH
+ OPL
+ SZL CLA /DIV ERROR?
+ JMP I DVOFL /YES
+DVLP1, TAD AC0 /NO-GET QUOT OF FIRST DIV.
+ SMA /NEGATIVE?
+ JMP .+5 /NO-REMEMBER-QUOT OF 2ND DIV. IN MQ
+ LSR /YES-MUST SHIFT IT RIGHT 1
+ 1
+ ISZ ACX /ADJUST EXPONENT
+ NOP
+ ISZ MSIGN /SHOULD SIGN BE MINUS?
+ SKP /NO
+ DCM /YES-DO IT
+DBAD1, DCA ACH /STORE IT BACK
+ SWP
+ DCA ACL
+ ISZ FFDIV
+ JMP I FFDIV /BUMP RETN. AND RETN.
+
+DVOPSP, DVOPS
+DBAD, CAM
+ DCA ACX /ZERO EXPONENT
+ JMP DBAD1 /GO ZERO MANTISSA
+\f/FLOATING ADDITION-IN ORDER NOT TO LOSE BITS, WE DO NOT
+/SHIFT BOTH NUMBERS RIGHT 1 BIT BEFORE ADD-ONLY SHIFTS DONE
+/ARE TO ALIGN EXPONENTS.
+/
+ PAGE
+FFADD, 0
+ JMS I [PATCHF /WHICH MODE OF CALLING
+ TAD I FFADD /CALLED DIRECTLY BY USER
+ JMS I ARGETP /PICK UP ARGUMENTS
+ JMP I PATCHK /CHECK FOR ADDITION BY ZERO
+FAD1, TAD OPX /PICK UP EXPONENT OF OPERAND
+ MQL /SEND IT TO MQ FOR SUBTRACT
+ TAD ACX /GET EXPONENT OF FAC
+ SAM /SUBTRACT-RESULT IN AC
+ SPA /NEGATIVE RESULT?
+ CMA IAC /YES-MAKE IT POSITIVE
+ DCA CNT /STORE IT AS A SHIFT COUNT
+ TAD CNT /COUNT TOO BIG?(CAN'T BE ALIGNED)
+ TAD M27
+ SPA SNA CLA
+ CMA /NO-OK
+ DCA AC0 /YES-MAKE IT A LOAD OF LARGEST #
+ DLD /GET ADDRESSES TO SEE WHO'S SHIFTED
+ ADDRS
+ SGT /WHICH EXP GREATER(GT FLG SET
+ /BY SUBTR. OF EXPS.)
+ SWP /OPERAND'S-SHIFT THE FAC
+ DCA SHFBG /STORE ADDRESS OF WHO GETS SHIFTED
+ SWP /GET ADDRESS OF OTHER (0 TO MQ)
+ DCA DADR /THIS ONE JUST GETS ADDED
+ SGT /WHICH EXPONENT WAS GREATER?
+ JMP .+3 /FAC'S - DO NOTHING
+ TAD OPX /OPERAND'S-PUT FINAL EXP. IN ACX
+ DCA ACX
+ DLD /GET THE LARGER # TO AC,MQ
+DADR, 0
+ SWP /PUT IN THE RIGHT ORDER
+ ISZ AC0 /COULD EXPONENTS BE ALIGNED?
+ JMP LOD /NO-JUST LEAVE LARGER IN AC,MQ
+ DST /YES-STORE THIS TEMPORARILY
+ AC0 /(IF ONLY FAC STORAGE WAS REVERSED)
+ DLD /GET THE SMALLER #
+SHFBG, 0
+ SWP /PUT IT IN RIGHT ORDER
+ ASR /DO THE ALIGNMENT SHIFT
+CNT, 0
+\f DAD /ADD THE LARGER #
+ AC0
+ DST /STORE RESULT
+ AC0
+ SZL /OVERFLOW?(L NOT = SIGN BIT)
+ CMA /NOTE-WE DIDN'T SHIFT BOTH RIGHT 1
+ SMA CLA
+ JMP NOOV /NOPE
+ CLA CLL CML RAR /MAYBE-SEE IF 2 #S HAD SAME SIGN
+ AND ACH
+ TAD OPH
+ SMA CLA /SIGNS ALIKE?
+ JMP OVRFLO /YES-OVERFLOW
+NOOV, JMS I ADDPCL /JUMP TO PATCH FOR THIS ROUTINE
+LOD, NMI /NORMALIZE (LOW ORDER STILL IN MQ)
+ DCA ACH /STORE FINAL RESULT
+ SWP /GET AND STORE LOW ORDER
+ DCA ACL
+ SCA /GET SHIFT COUNTER(# OF NMI SHIFTS)
+ CMA IAC /NEGATE IT
+ TAD ACX /AND ADJUST FINAL EXPONENT
+ DCA ACX
+ADON, ISZ FFADD /BUMP RETURN PAST ADDRESS
+ JMP I FFADD /RETURN
+OVRFLO, TAD AC1 /OVERFLOW-GET HIGH ORDER RESLT BACK
+ ASR /SHIFT IT RIGHT 1
+ 1
+ TAD KK4000 /REVERSE SIGN BIT
+ DCA ACH /AND STORE
+ SWP
+ DCA ACL /STORE LOW ORDER
+ ISZ ACX /BUMP EXPONENT
+ NOP
+ JMP ADON /DONE
+KK4000, 4000
+M27, -27
+ADDRS, OPH
+ ACH
+ARGETP, ARGET
+/FLOATING SUBTRACT-USES FLOATING ADD
+/FSW0!!
+FFSUB, 0
+ JMS I [PATCHF /WHICH MODE?
+ TAD I FFSUB /CALLED BY USER-GET ADDRESS OF OP.
+ JMS I ARGETP
+ CDF
+ TAD OPL /OPH IS IN MQ!
+ SWP /PUT IT IN RIGHT ORDER
+ DCM /NEGATE IT
+ DCA OPH /STORE BACK
+ MQA
+ DCA OPL
+ TAD FFSUB /GO TO ADD
+SUB0, DCA FFADD
+ JMP FAD1-1
+\f/
+/FLOATING NEGATE--NEGATE FLOATING AC
+/
+FFNEG, 0
+ SWAB /MUST BE MODE B
+ DLD /GET MANTISSA
+ ACH
+ SWP /CORRECT ORDER PLEASE!
+ DCM /NEGATE IT
+ DCA ACH /RESTORE
+ SWP /SEND 0 TO MQ
+ DCA ACL
+ JMP I FFNEG
+
+
+/
+/CONTINUATION OF DIVIDE ROUTINE
+/WE ARE ADJUSTING THE RESULT OF THE
+/FIRST DIVIDE.
+/
+DVOPS, CMA IAC
+ DCA AC1 /ADJUST REMAINDER
+ TAD OPL /WATCH FOR OVERFLOW
+ CLL CMA IAC
+ TAD AC1
+ SNL
+ JMP DVOP1 /DON'T ADJUST QUOT.
+ DCA AC1
+ CMA
+ TAD AC0
+ DCA AC0 /REDUCE QUOT BY 1
+DVOP1, CLA CLL
+ TAD AC1 /GET REMAINDER
+ SNA /ZERO?
+ CAM /YES-ZERO EVERYTHING
+ DVI /NO
+ OPL
+ SZL CLA /DIV. OVERFLOW?
+ JMP I DVOVR /YES
+ DCM /NO-ADJUST HI QUOT (MAYBE)
+ JMP I DVLP1P /GO BACK
+DVLP1P, DVLP1
+DVOVR, DV
+ADDPCL, ADDPCH
+PATCHK, PTCHAD
+ >
+\f PAGE
+/ARGUMENT PICK UP ROUTINE-ENTER WITH DATA FIELD SET TO EITHER
+/FLTG. DATA FIELD OR FLTG. INSTR. FIELD.
+/ADDRESS OF OPERAND IS IN THE AC ON ENTRY.
+/ON RETURN, THE`AC IS CLEAR
+/
+ARGET, 0
+ DCA AC2 /STORE ADDRESS OF OPERAND
+ TAD I AC2 /PICK UP EXPONENT
+ DCA OPX
+ JMS ISZAC2 /MOVE POINTER TO HORD,WATCH FOR FIELD OVERLAP
+ TAD I AC2 /PICK IT UP
+ IFZERO EAE <
+ NOP
+ NOP
+ >
+
+ IFNZRO EAE <
+ SWAB /OPH INTO MQ BECAUSE EAE ROUTINES
+ MQA /EXPECT TO FIND IT THERE
+ >
+ DCA OPH /STORE
+ JMS ISZAC2 /MOVE POINTER TO LORD,WATCHING FOR OVERLAP
+ TAD I AC2 /PICK IT UP
+ DCA OPL /STORE IT
+ JMP I ARGET /RETURN
+\f IFZERO EAE <
+/
+/ROUTINE TO NORMALIZE THE FAC
+/
+FFNOR, 0
+ TAD ACH /GET THE HI ORDER MANTISSA
+ SNA /ZERO?
+ TAD ACL /YES-HOW ABOUT LOW?
+ SNA
+ TAD AC1 /LOW=0, IS OVRFLO BIT ON?
+ SNA CLA
+ JMP ZEXP /#=0-ZERO EXPONENT
+NORMLP, AC2000 /NOT 0-MAKE A 2000 IN AC
+ TAD ACH /ADD HI ORDER MANTISSA
+ SZA /HI ORDER = 6000
+ JMP .+3 /NO-CHECK LEFT MOST DIGIT
+ TAD ACL /YES-6000 OK IF LOW=0
+ SZA CLA
+ SPA CLA /2,3,4,5,ARE LEGAL LEFT MOST DIGS.
+ JMP FFNORR /FOR NORMALIZED #-(+2000=4,5,6,7)
+ JMP FNLP /JUMP SO FFGET AND PUT ARE ORGED RIGHT
+
+FFNORR, DCA AC1 /DONE W/NORMALIZE-CLEAR AC1
+ JMP I FFNOR /RETURN
+AL1P, AL1
+ >
+ IFNZRO EAE <
+
+/
+/ROUTINE TO NORMALIZE THE FAC
+/
+ *6215
+FFNOR, 0
+ CDF /CHANGE D.F. TO FIELD OF PACKAGE
+ SWAB /FORCE MODE B
+ DLD /PICK UP MANTISSA
+ ACH
+ SWP /PUT IT IN CORRECT ORDER
+ NMI /NORMALIZE IT
+ SNA /IS THE # ZERO?
+ DCA ACX /YES-INSURE ZERO EXPONENT
+ DCA ACH /STORE HIGH ORDER BACK
+ SWP /STORE LOW ORDER BACK
+ DCA ACL
+ CLA SCA /STEP COUNTER TO AC
+ CMA IAC /NEGATE IT
+ TAD ACX /AND ADJUST EXPONENT
+ DCA ACX
+ JMP I FFNOR /RETURN
+ >
+\f/FLOATING GET
+
+ *6241
+FFGET, 0
+ JMS I [PATCHF /WHICH MODE OF CALL
+ TAD I FFGET /CALLED BY USER-GET ADDR. OF OP
+ JMS ARGET /PICK UP OPERAND
+ TAD OPX
+ DCA ACX /LOAD THE OPERAND INTO FAC
+ TAD OPL
+ DCA ACL
+ TAD OPH
+ DCA ACH
+ ISZ FFGET
+ CDF
+ JMP I FFGET /RETN. TO CALL +2
+/
+/FLOATING PUT
+/
+FFPUT, 0
+ JMS I [PATCHF /WHICH MODE OF CALL?
+ TAD I FFPUT /CALLED BY USER-GET OPR. ADDR
+ DCA FFGET /STORE IN A TEMP
+ TAD ACX /GET FAC AND STORE IT
+ DCA I FFGET /AT SPECIFIED ADDRESS
+ JMS ISZFGT /BUMP POINTER,WATCHING FOR FIELD OVERLAP
+ TAD ACH
+ DCA I FFGET
+ JMS ISZFGT
+ TAD ACL
+ DCA I FFGET
+ ISZ FFPUT /BUMP RETN.
+ CDF
+ JMP I FFPUT /RETN. TO CALL+2
+
+/ROUTINES TO BUMP ARGET AND FPUT POINTERS AND INCREMENT THE
+/DATA FIELD IF THE POINTER CROSSES A FIELD BOUNDARY
+
+ISZFGT, 0
+ ISZ FFGET /BUMP POINTER
+ JMP I ISZFGT /NO SKIP MEANS JUST RETURN
+ SKP /SKIP MEANS WE HAVE TO INCREMENT DATA FIELD
+NEWCDF, DCA ISZFGT /THIS INST EXECUTED ONLY BY ISZAC2
+ RDF /GET THE DATA FIELD
+ TAD CDF10 /BUMP BY 1 AND MAKE A CDF
+ DCA .+1 /PUT IN LINE
+ .
+ JMP I ISZFGT /RETURN
+
+CDF10, CDF 10
+
+ISZAC2, 0
+ ISZ AC2 /BUMP POINTER
+ JMP I ISZAC2 /NOTHING HAPPENED
+ TAD ISZAC2 /NEED NEW DF. GET RETURN ADDR
+ JMP NEWCDF /AND BUMP DF
+\f IFZERO EAE <
+/
+/ROUTINE TO ADJUST QUOTINET OF FIRST DIVIDE (MAYBE) WHEN THE
+/REMAINDER OF THE FIRST`DIVIDE IS LESS THAN QUOT*OPL
+/USED BY FLTG. DIVIDE ROUTINE
+/
+DVOPS, CMA IAC /NEGATE AND STORE REVISED REMAINDER
+ DCA ACH
+ CLL
+ TAD OPH
+ TAD ACH /WATCH FOR OVERFLOW
+ SNL
+ JMP DVOP1 /OVERFLOW-DON'T ADJUST QUOT. OF 1ST DIV.
+ DCA ACH /NO OVERFLOW-STORE NEW REM.
+ CMA /SUBTRACT 1 FROM QUOT OF
+ TAD AC1 /FIRST DIVIDE
+ DCA AC1
+DVOP1, CLA CLL
+ TAD ACH /GET HI ORD OF REMAINDER
+ JMP I DVOP2P /GO ON
+DVOP2P, DVOP2
+
+FNLP, CLL CML CMA /-1
+ TAD ACX /SUBTR. 1 FROM EXPONENT
+ DCA ACX
+ JMS I AL1P /SHIFT FAC LEFT 1
+ JMP NORMLP /GO BACK AND SEE IF NORMALIZED
+ZEXP, DCA ACX
+ JMP FFNORR
+ >
+\f/
+/FSQUARE-SQUARE FAC-CALLS MULTIPLY TO MUL. FAC BY ITSELF
+/
+ *6347
+A,
+FFSQ, 0
+ JMS I TMPY /CALL MULTIPLY TO MULTIPLY
+ ACX /FAC BY ITSELF
+ JMP I FFSQ /DONE
+TMPY, FFMPY
+/
+/ ERROR TRAPS
+O0, JMS I [ERROR /OVERFLOW
+DV, JMS I [ERROR /DIVISION ERROR
+ JMS I [FACCLR /RETURN 0 IN FAC
+ JMP I [ILOOP
+LM, JMS I [ERROR /ILLEGAL ARGUMENT
+
+ PAGE
+
+\f *OVERLAY+3000
+
+
+/TELETYPE "DRIVER"-WHEN CALLED,GRABS CHARACTERS FROM THE
+/TELETYPE UNTIL A CR IS SENT OR THE BUFFER IS FULL. ASSUMES TTY ENTRY
+/IS IN I/O WORK AREA.
+
+TTYDRI, 0
+ JMP LFLUSH+1
+IO, JMS I [ERROR
+LFLUSH, JMS I [CRLFR /PRINT A CR,LF
+ TAD K277 /PRINT A ? SIGNIFYING WAIT FOR INPUT
+ JMS I [XPUTCH
+ TAD I IOTBUF /BUFFER ADDRESS
+ DCA I IOTPTR /INITIALIZE POINTER TO START OF BUFFER
+ JMS I [CNOCLR /INITIALIZE CHAR # TO 1
+TTYIN, JMS I [XPRINT /EMPTY TTY BUFFER BEFORE AWAITING INPUT
+ JMP .-1
+ TAD I (HEIGHT /ALWAYS RESET SCREEN HIEGHT ON INPUT
+ DCA I (HCTR
+ TAD K5252 /DESIGN INTO AC
+KSFA, KSF /CHAR READY?
+ JMP SPIN /NO-DIDDLE WHILE WE WAIT
+ CLA CLL /FLUSH SPINNER OUT OF AC
+ TAD [200 /FORCE PARITY BIT
+ KRS /GET CHAR
+ DCA CHAR /SAVE
+ TAD CHAR
+ JMS I [XPUTCH /ECHO IT
+ KCC /CLEAR KEYBOARD FLAG AND SET READER RUN
+ TAD CHAR
+ TAD MCTRLU /IS IT CTRL/U?
+ SNA CLA
+ JMP LFLUSH /YES-START AGAIN
+ TAD CHAR /NO
+ TAD CRUBOT /IS IT RUBOUT?
+ SNA
+ JMP BACKUP /YES-BACK UP BUFFER POINTER
+ TAD MCR /NO-IS IT CR?
+ SNA CLA
+ JMP CR /YES-DONE
+ TAD CHAR
+ JMS I [PACKCH /PACK CHAR IN BUFFER
+ JMS I [BUFCHK /BUFFER FULL?
+ JMP IO /YES-ERROR
+ NOP /NO-CHAR 3 LEFT
+ NOP /NO-2 AND 3 LEFT
+ JMP TTYIN /NO-NEXT CHAR
+MCTRLU, -225
+MCR, 377-215
+CRUBOT, -377
+K5252, 5252
+K277, 277
+
+BACKUP, TAD I IOTPTR /BUFFER POINTER
+ CIA /NEGATE
+ TAD I IOTBUF /COMPARE AGAINST START OF BUFFER
+ SNA CLA /BUFFER EMPTY?
+ JMP TTYIN /YES-THERE IS NOTHING TO RUBOUT
+ TAD SCOPFG /TEST IF CONSOLE IS A SCOPE
+ SNA CLA
+ JMP NOSCOP /JMP IF NOT
+ TAD (10
+ JMS I [XPUTCH /PRINT BS,SP,BS TO RUBOUT IF SCOPE
+ TAD (40
+ JMS I [XPUTCH
+ TAD (10
+ SKP
+NOSCOP, TAD K334
+ JMS I [XPUTCH /ECHO "\"
+ JMS I [CHARNO /GET CHAR # OF NEXT CHAR (LAST #+1)
+ JMP C1B /1
+ JMP C3B /3
+ JMS I [CNOCLR /IT WAS 2-MAKE IT 1
+PBACK, CLA CMA /-1
+ TAD I IOTPTR /BACK UP BUFFER POINTER
+ DCA I IOTPTR
+ JMP TTYIN /NEXT CHAR
+K334, 334
+
+C1B, TAD I IOTHDR
+ AND [7477
+ TAD [200 /IT WAS 1-MAKE IT 3
+ DCA I IOTHDR
+ JMP TTYIN /NO NEED TO BACK UP POINTER
+
+C3B, TAD I IOTHDR
+ AND [7477
+ TAD [100 /IT WAS 3,MAKE IT 2
+ DCA I IOTHDR
+ JMP PBACK /BACK UP POINTER
+
+
+CR, JMS I [CRLFR /ECHO A CR,LF
+ TAD K4
+ TAD TTYDRI /BUMP DRIVE RETURN TO NORMAL
+ DCA TTYDRI
+ TAD CHAR
+ JMS I [PACKCH /PACK CHAR IN BUFFER
+ TAD I IOTBUF
+ DCA I IOTPTR /INITAILZE BUFFER POINTERS
+ JMS I [CNOCLR
+ JMP I TTYDRI /RETURN
+K4, 4
+
+
+SPIN, ISZ SPINNR /SPIN RANDOM # SEED
+ SKP
+ CMA CML RAL /MARCH TO THE LEFT
+ JMP KSFA /CHECK FOR CHAR YET
+SCOPFG, 0 /GETS SET TO SCOPE FLAG BY STARTUP CODE
+\f/SUBROUTINE FBITGT-ROUTINE TO PUT FUNCTION BITS FROM INSTRUCTION INTO AC
+
+FBITGT, 0
+ TAD INSAV
+ CLL RTR
+ RTR /PUT FUNCTION BITS IN BITS 8-11
+ AND [17 /MASK THEM OFF
+ JMP I FBITGT /RETURN
+
+/DATA LIST READ (NUMERIC)
+
+RDLIST, JMS I (DLREAD /FETCH WORD FROM LIST
+ DCA ACX /STORE AS EXPONENT
+ JMS I (DLREAD
+ DCA ACH /HIGH MANTISSA
+ JMS I (DLREAD
+ DCA ACL /LOW MANTISSA
+ JMP I [ILOOP
+
+/SUBROUTINE FTYPE-RETURNS TO CALL+1 IF FILE NUMERIC,CALL+2 IF ASCII
+
+FTYPE, 0
+ TAD I IOTHDR /GET HEADER
+ CLL RAR /TYPE TO LINK
+ SZL CLA /IS IT NUMERIC?
+ ISZ FTYPE /NO-BUMP RETURN
+ JMP I FTYPE /RETURN
+
+ PAGE
+\f/LAST PAGE OF BRTS-CONTAINS SAC,I/O TABLE, AND SOME MISCELLANEOUS CODE
+
+/TELETYPE INPUT BUFFER (74. CHARACTERS LONG)
+/THIS BUFFER CONTAINS ONCE ONLY START CODE WHEN LOADED
+
+TTYBUF,
+START4, TAD CDFPS /DF FOR BOTTOM OF PSEUDO-CODE
+ TAD MCDF1 /COMPARE TO A CDF 10
+ SZA CLA /DO THEY MATCH?
+ JMP I [ILOOP /NO-ALL BUFFERS ARE FREE-START INTERPRETER
+ TAD PSSTRT
+ CLL CMA
+ TAD [400
+ SNL CLA /IS START OF PSEUDO-CODE BELOW 400
+ JMP CHKB2 /NO-CHECK FOR 1000
+ TAD [17 /YES-SET ALL BUFFERS BUSY
+ JMP BAS
+CHKB2, TAD PSSTRT
+ CLL CMA
+ TAD C1000
+ SNL CLA /IS START OF PSEUDO-CODE BELOW 1000
+ JMP CHKB3 /NO-CHECK 1400
+ TAD C16 /YES-ONLY BUFFER 1 IS AVAILABLE
+ JMP BAS
+CHKB3, TAD PSSTRT
+ CLL CMA
+ TAD C1400
+ SNL CLA /IS START OF CODE BELOW 1400?
+ JMP CHKB4 /YES-CHECK 2000
+ TAD C14 /YES-ONLY BUFFER 1 AND 2 AVAILABLE
+ JMP BAS
+CHKB4, TAD PSSTRT
+ CLL CMA
+ TAD K2000
+ SNL CLA /IS CODE START BELOW 2000?
+ JMP I [ILOOP /NO-START INTERPRETER-ALL BUFFER FREE
+ TAD [10 /YES-BUFFERS 1,2, AND 3 AVAILABLE
+BAS, DCA BMAP
+ JMP I [ILOOP /START INTERPRETER
+ 0
+MCDF1, -6211
+K2000, 2000
+C14, 14
+C16, 16
+C1000, 1000
+C1400, 1400
+ ZBLOCK 10
+TTYEND, 0
+\f *OVERLAY+3277
+
+////////////////////////////////////////////////////////////////
+/////// I/O TABLE 5 13-WORD ENTRIES ////////////////////////////
+////////////////////////////////////////////////////////////////
+
+TTYF, 1 /TELETYPE ENTRY-FILE IS ASCII
+ TTYBUF /BUFFER ADDRESS
+ 0 /CURRENT BLOCK IN BUFFER
+ TTYBUF /READ WRITE POINTER
+ TTYDRI /HANDLER ENTRY
+ ZBLOCK 10
+FILE1, ZBLOCK 15 /FILE #1
+FILE2, ZBLOCK 15 /FILE #2
+FILE3, ZBLOCK 15 /FILE #3
+FILE4, ZBLOCK 15 /FILE #4
+
+ PAGE
+\f /CROSS FIELD LITERAL EQUATES
+
+ PGETCH= [GETCH
+ PILOOP= [ILOOP
+ PPUTCH= [PUTCH
+ PSACM1= [SAC-1
+ PXPUTCH= [XPUTCH
+ PXPRINT= [XPRINT
+ PFFNOR= [FFNOR
+ PFFGET= [FFGET
+ PFFPUT= [FFPUT
+ PUNSFIX= [UNSFIX
+ PERROR= [ERROR
+ PFACCLR= [FACCLR
+ PIDLE= [IDLE
+ PPSWAP= [PSWAP
+ PFTYPE= [FTYPE
+ USR= [200
+ O200= [200
+ O400= [400
+ O100= [100
+ O10= [10
+ O17= [17
+ O7400= [7400
+ O77= [77
+ O215= [215
+ O7700= [7700
+ M215= [-215
+\f/////////////////////////////////////////////////////////////
+/////////////////////////////////////////////////////////////
+////////////// OVERLAY 2- STRING FUNCTIONS /////////////////
+/////////////////////////////////////////////////////////////
+/////////////////////////////////////////////////////////////
+
+ FIELD 1
+ *2000
+ RELOC OVERLAY
+
+ /VERSION NUMBER WORD FOR STRING OVERLAY
+
+ VERSON^100+SUBVSF+6000
+
+/CHR$ FUNCTION
+/RETURNS 1 6BIT CHAR STRING FOR THE VALUE OF X
+
+CHR, JMS I PUNSFIX /FIX X TO 12 BIT INTEGER
+ AND O77 /MASK TO 6BIT
+ DCA I (SAC /AND PUT INTO SAC
+ CMA
+ DCA SACLEN /SET SAC LENGTH TO 1
+ JMP I (SSMODE /SET TO SMODE AND RETURN
+
+/ASC FUNCTION
+/RETURNS DECIMAL ASCII FOR 1 CHAR STRING IN FAC
+
+ASC, TAD I (SAC /GET FIRST CHAR OF STRING
+ JMP FLOATS /FLOAT RESULT INTO FAC AND RETURN
+
+/LEN FUNCTION
+/RETURNS LENGTH OF SAC IN FAC
+
+LEN, TAD SACLEN /LENGTH OF STRING IN SAC
+ CIA /MAKE POSITIVE
+
+/ROUTINE TO FLOAT FAC AND RETURN
+
+FLOATS, DCA ACH /NUMBER TO BE FLOATED IN HORD
+ DCA ACL /CLEAR LORD
+ DCA TEMP2 /CLEAR FPP OVERFLOW
+ TAD (13 /SET EXP TO 11
+ DCA ACX
+ JMS I PFFNOR /NORMALIZE
+ JMP I PILOOP /RETURN
+\f
+
+
+/STR$ FUNCTION
+/RETURNS ASCII STRING FOR NUMBER IN FAC
+
+STR, JMS I (FFOUT /GET NUMBER INTO INTERMEDIATE BUFFER FIRST
+ TAD XR1
+ CIA
+ TAD (INTERB-1
+ DCA SACLEN
+ TAD SACLEN /NOW SAVE COUNTER
+ DCA TEMP2
+ TAD (INTERB-1
+ DCA XR1 /POINT AT BUFFER
+STRLUP, TAD I XR1 /GET A CHAR
+ AND O77 /MASK TO 6BIT
+ TAD (-40 /CROCK TO DELETE BLANKS
+ SZA
+ JMP .+3
+ ISZ SACLEN /IGNORE THE BLANK
+ JMP .+3
+ TAD (40
+ DCA I SACXR /STORE IN SAC
+ ISZ TEMP2
+ JMP STRLUP /LOOP FOR MORE
+ JMP I (SSMODE /DONE-RETURN IN SMODE
+\f
+/VAL FUNCTION
+/RETURNS NUMBER IN FAC FOR STRING IN SAC
+
+VAL, TAD SACLEN
+ DCA VALCNT /COUNT OF CHARS TO INPUT
+ TAD (VALGET /ADDR OF PHONY INPUT ROUTINE
+ DCA I (IGETCH /PUT IN INPUT ROUTINE IN PLACE OF KRB
+ JMS I (FFIN /CALL FPP INPUT ROUTINE
+ TAD PGETCH /NOW RESTORE REAL INPUT ADDR
+ DCA I (IGETCH /RESTORE IN INPUT ROUTINE
+ JMP I PILOOP /DONE
+
+VALGET, 0
+ TAD VALCNT /TEST NUMBER OF CHARS LEFT
+ SNA CLA
+ JMP EOVAL /NONE
+ ISZ VALCNT /ELSE BUMP
+ NOP
+ TAD I SACXR /GET A BYTE
+ TAD (240
+ AND O77
+ TAD (240 /CONVERT TO 8BIT
+ SKP
+EOVAL, TAD O215
+ DCA CHAR
+ JMP I VALGET /RETURN WITH CHAR IN 'CHAR'
+
+VALCNT, 0
+
+ PAGE
+\f/ DATE FUNCTION
+/ RETURNS STRING OF THE FORM "MM/DD/YY" IN SAC IF DATE IS PRESENT
+/ RETURNS NULL STRING OTHERWISE
+
+
+DATE, TAD CDFIO /COPY CDF TO FIELD 17600 IN LINE
+ DCA .+1
+YEAREX, 0
+ TAD PSFLAG /GET TD8E BIT TO LINK
+ CLL RAL
+ SNL CLA
+ TAD I (MDATE /IF ZERO LOOK AT MDATE IN N7600
+ SZL
+ TAD I (MDATE-200 /ELSE LOOK AT N7400
+ DCA DATEWD /STORE (DATE IS NOT A CLOSED SUBROUTINE)
+ CDF /DATE IS IN THE FORM MMM MDD DDD YYY
+ TAD DATEWD /PICK UP DATE
+ SZA CLA
+ TAD (-10 /RETURN 8. BYTES IF NOT NULL DATE
+ DCA SACLEN /SET SAC LENGTH
+ TAD I (BIPCCL /NOW GET YEAR EXTENSION
+ AND (600 /IT'S IN THE 600 BITS
+ CLL RTR
+ RTR /SHIFT INTO PLACE
+ DCA YEAREX /HOLD YEAR EXTENSION
+ TAD DATEWD /NOW ISOLATE MONTH
+ AND O7400
+ CLL RTL
+ RTL
+ RAL
+ JMS PUTN /PUT "MM/" INTO THE SAC
+ TAD DATEWD /NOW GET DAY OF MONTH
+ AND (370
+ CLL RTR
+ RAR
+ JMS PUTN /PUT "DD/" IN SAC
+ TAD DATEWD /FINALLY GET YEAR
+ AND (7
+ TAD YEAREX /ADD TO EXTENSION BITS
+ TAD (106 /ADD 70. FOR BASE YEAR
+ JMS PUTN /PUT OUT "YY/" (EXTRA SLASH WILL BE IGNORED)
+ JMP I (SSMODE /RETURN IN STRING MODE
+
+PUTN, 0
+ ISZ NHIGH /BUMP HIGH ORDER DIGIT
+ TAD (-12 /-10.
+ SMA
+ JMP .-3 /LOOP IF NOT REDUCED YET
+ TAD (12+60 /CONVERT TO DECIMAL DIGIT
+ DCA NLOW /HOLD MOMENTARILY
+ TAD NHIGH /NOW GET HI ORDER DIGIT
+ TAD (57 /MAKE 6BIT
+ DCA I SACXR
+ TAD NLOW /SEND OUT LOW DIGIT
+ DCA I SACXR
+ TAD (57
+ DCA I SACXR /SEND OUT "/"
+ DCA NHIGH /CLEAR NHIGH FOR NEXT TIME (BE CAREFULL!!)
+ JMP I PUTN
+NHIGH, 0
+NLOW, 0
+DATEWD, 0
+\f/TRACE FUNCTION PRINTER. WHEN TRACE IS ENABLED,THIS ROUTINE
+/PRINTS THE LINE # EACH TIME IT IS STORED
+
+TPRINT, JMS I (LMAKE /MAKE LINE # INTO FIVE DIGITS
+ TAD ("%
+ JMS I PXPUTCH /PRINT "%"
+ TAD ("
+ JMS I PXPUTCH /PRINT A SPACE
+ TAD (DIG1-1 /ADDR OF FIRST DIGIT-1
+ DCA XR5 /IN XR5
+IGS, TAD I XR5 /GET DIGIT OF LINE NUMBER
+ DCA TCHR /SAVE IT
+ TAD (-"0
+ TAD TCHR /COMPARE IT TO 0
+ SNA CLA /IS IT A 0?
+ JMP IGS /YES-IGNORE LEADING ZEROES
+PREST, TAD TCHR /NO-GET CHAR AGAIN
+ TAD M215
+ SNA CLA /IS IT A CR?
+ JMP TDONE /YES-LINE NUMBER IS PRINTED
+ TAD TCHR /NO-GET CHAR A THIRD TIME
+ JMS I PXPUTCH /TYPE IT
+ TAD I XR5 /GET NEXT CHAR
+ DCA TCHR
+ JMP PREST /AND LOOP
+TDONE, TAD ("
+ JMS I PXPUTCH /FOLLOW LINE # WITH A SPACE
+ TAD ("%
+ JMS I PXPUTCH /TYPE ANOTHER "%"
+ TAD (215
+ JMS I PXPUTCH /TYPE,CR,LF
+ TAD (212
+ JMS I PXPUTCH
+ JMS I PXPRINT /EMPTY RING BUFFER OF TRACE NUMBER
+ JMP .-1
+ JMP I PILOOP /DONE
+TCHR, 0
+
+ PAGE
+\f/TRACE FUNCTION-ROUTINE TO TURN TRACE ON AND OFF
+
+TRACE, TAD ACH /GET HI MANTISSA OF ARG
+ SNA CLA /SKP TO TURN TRACE ON
+ TAD TRREST /ELSE RESTORE TRACE BYPASS INSTR IN LINE NUMBER ROUTINE
+ DCA I HOOKL /BY NOP ING INSTRUCTION AT TRHOOK
+TRREST, JMP I PILOOP
+
+HOOKL, TRHOOK
+
+/ERROR ROUTINE
+
+ERRORR, JMS I PXPRINT /PURGE TTY RING BUFFER
+ JMP .-1 /BEFORE PRINTING ERROR
+ TAD ETABA /ADDR OF ERROR TABLE
+ DCA XR4 /POINTS INTO ERROR TABLE
+FERRLP, TAD I XR4 /GET 2 CHAR ERROR CODE
+ DCA TEMP1 /SAVE
+ TAD TEMP1
+ CLL RTR
+ RTR
+ RTR
+ AND O77 /STRIP TO 6 BIT
+ TAD K0300 /MAKE 8 BIT (LETTERS ONLY ALLOWED)
+ DCA ESTRNG /PUT IN MESSAGE
+ TAD TEMP1 /2 CHAR CODE AGAIN
+ AND O77 /SECOND CHAR
+ TAD K0300 /MAKE LETTER
+ DCA ESTRNG+1 /PUT IN MESSAGE
+ TAD I XR4 /GET ERROR CODE +1
+ TAD I PERROR /COMPARE AGAINST RETURN ADDR
+ SZA CLA /MATCH?
+ JMP FERRLP /NO-TRY NEXT ONE
+ JMS LMAKE /MAKE THE LINE # INTO DECIMAL DIGITS
+ TAD ESTRA /ADDR OF MESSAGE
+ DCA XR5
+ETLOP, TAD I XR5 /GET MESSAGE CHAR
+ SPA /DONE? (MESSAGE ENDNS WITH - NUMBER
+ JMP FATCHK /YES-DETERMINE ERROR TYPE
+ JMS I PXPUTCH /NO-PUT CHAR IN RING BUFFER
+ JMP ETLOP
+
+FATCHK, CLA
+ TAD MFATAL /-ADDR OF FATAL ERRORS
+ TAD XR4 /ADDR OF THIS ERROR
+ SMA CLA /FATAL ERROR?
+ JMP I ERRETN /NO-NEXT INST
+ JMP I STOPI /YES-TERMINATE RUN
+
+ERRETN, XERRRET
+STOPI, FSTOPN
+
+MAKED, 0
+ AND O17 /ISOLATE BCD DIGIT
+ TAD K260 /MAKE ASCII DIGIT
+ JMP I MAKED
+
+K260, 260
+K0300, 300
+\f/SUBROUTINE LMAKE-MAKES THE CURRENT LINE NUMBER INTO FIVE DIGITS
+/STARTING AT DIG1
+
+LMAKE, 0
+ TAD LINEHI /YES:GET HI LINE #
+ JMS MAKED /GET DIGIT 2
+ DCA DIG2 /PUT IN MESSAGE
+ TAD LINEHI
+ CLL RTR
+ RTR
+ JMS MAKED /GET DIGIT 1
+ DCA DIG1 /AND PUT IN MESSAGE
+ TAD LINELO /DOGOTS 3,4, AND 5
+ JMS MAKED /GET DIGIT 5
+ DCA DIG5
+ TAD LINELO
+ CLL RTR
+ RTR
+ JMS MAKED /GET DIGIT 4
+ DCA DIG4 /AND PUT IN MESSAGE
+ TAD LINELO
+ CLL RAL
+ RTL
+ RTL
+ JMS MAKED /GET DIGIT 3
+ DCA DIG3 /MESSAGE NOW COMPLETE
+ JMP I LMAKE
+\f/ERROR MESSAGE
+
+EMESS, 215
+ 212
+ESTRNG, 0000
+ 0000
+ "
+ "A
+ "T
+ "
+ "L
+ "I
+ "N
+ "E
+ "
+DIG1, 0
+DIG2, 0
+DIG3, 0
+DIG4, 0
+DIG5, 0
+ 215
+ 212
+ESTRA, EMESS-1 /MINUS NUMBER TO END ABOVE MESSAGE
+\f/ERROR TABLE\r/ENTRY FORMAT- 2 CHAR 6-BIT ERROR CODE (LETTERS ONLY)
+/ -(ADDR OF CALL)-1
+
+ETABA, ETAB-1
+MFATAL, -EFATAL
+ETAB, 0602 /FB
+ -FB-1 /ATTEMPT TO OPEN AN ALREADY OPEN FILE
+ 0722 /GR
+ -GR-1 /RETURN WITHOUT A GOSUB
+ 2622 /VR
+ -VR-1 /ATTEMPT TO READ VARIABLE LENGTH FILE
+ 2325 /SU
+ -SU-1 /SUBSCRIPT ERROR
+ 0405 /DE
+ -DE-1 /DEVICE DRIVER ERROR
+ 1705 /OE
+ -OE-1 /DRIVER ERROR WHILE OVERLAYING
+ 0615 /FM
+ -FM-1 /ATTEMPT TO FIX MINUS NUMBER
+ 0617 /FO
+ -FO-1 /ATTEMPT TO FIX NUMBER >4095
+ 0616 /FN
+ -FN-1 /ILLEGAL FILE #
+ 2303 /SC
+ -SC-1 /ATTEMPT TO OVERFLOW SAC ON CONCATENATE
+ 0611 /FI
+ -FI-1 /ATTEMPT TO CLOSE OR USE UNOPENED FILE
+ 0401 /DA
+ -DA-1 /ATTEMPT TO READ PAST END OF DATA LIST
+ 0723 /GS
+ -GS-1 /TOO MANY NESTED GOSUBS
+ 2322 /SR
+ -SR-1 /ATTEMPT TO READ STRING FROM NUMERIC FILE
+ 2327 /SW
+ -SW-1 /ATTEMPT TO WRITE STRING INTO NUMERIC FILE
+ 2001 /PA
+ -PA-1 /ILLEGAL ARG IN POS
+ 0603 /FC
+ -FC-1 /OS/8 ERROR WHILE CLOSING TENTATIVE FILE
+ 0311 /CI
+ -CI-1 /INQUIRE FAILURE IN CHAIN
+ 0314 /CL
+ -CL-1 /LOOKUP FAILURE IN CHAIN
+ 1116 /IN
+ -IN-1 /INQUIRE FAILURE IN OPEN
+ 0417 /DO
+ -DO-1 /NO MORE ROOM FOR DRIVERS
+ 0605 /FE
+ -FE-1 /FETCH ERROR IN OPEN
+ 0217 /BO
+ -BO-1 /NO MORE FILE BUFFERS AVAILABLE
+ 0516 /EN
+ -EN-1 /ENTER ERROR IN OPEN
+ 1106 /IF
+ -IF-1 /ILLEGAL DEV:FILENAME SPECIFICATION
+ 2314 /SL
+ -SL-1 /STRING TOO LONG OR UNDEFINED
+ 1726 /OV
+ -O0-1 /NUMERIC OR INPUT OVERFLOW
+ 1415 /LM
+ -LM-1 /ATTEMPT TO TAKE LOG OF NEG # OR 0
+ 0515 /EM
+ -EM-1 /ATTEMPT TO EXPONENTIATE A NEG NUMBER TO A REAL ROWER
+ 1101 /IA
+ -IA-1 /ILLEGAL ARGUMENT IN USER FUNCTION
+ 0330 /CX
+ -CX-1 /ILLEGAL FILENAME EXTENSION IN A CHAIN STATEMENT
+/***********************************************************
+EFATAL, /ERRORS BEFORE THIS LABEL ARE FATAL
+/*******************************************************
+ 2205 /RE
+ -RE-1 /ATTEMPT TO READ PAST EOF
+ 2705 /WE
+ -WE-1 /ATTEMPT TO WRITE PAST EOF
+ 0426 /DV
+ -DV-1 /ATTEMPT TO DIVIDE BY 0
+ 2324 /ST
+ -ST-1 /STRING TRUNCATION ON INPUT
+ 1117 /IO
+ -IO-1 /TTY INPUT BUFFER OVERFLOW
+\f T= .
+ *ETAB
+ *T
+/SEG$ FUNCTION
+/RETURNS SEGMENT OF X$ BETWEEN Y AND Z
+/IF Y<=0,THEN Y TAKEN AS 1
+/IF Y>LEN(X$),NULL STRING RETURNED
+/IF Z<=0,NULL STRING RETURNED
+/IF Z>LEN(X$),Z IS SET=LEN(X$)
+/IF Z<Y,NULL STRING IS RETURNED
+
+SEG, CLA IAC
+ DCA MODESW /RETURN IN STRING MODE
+ TAD ACH /IS Y>0?
+ SMA SZA CLA
+ JMS I PUNSFIX /FIX IF POSITIVE
+ SNA
+ IAC /SET Y TO 1 IF Y.LE.0
+ DCA YARG
+ TAD SACLEN /COMPARE YARG TO SACLEN
+ CIA
+ STL CIA
+ TAD YARG
+ SNL SZA CLA /SKP IF YARG.LOS.LEN(X$)
+ JMP NULLST /NO-RETURN THE NULL STRING
+ DCA INSAV /FAKE POINTER TO SCALAR #0
+ JMS I ARGPLK /GET ADDR OF Z
+ JMS I PFFGET /LOAD Z INTO FAC
+ARGPLK, ARGPRE /LOC SKIPPED BY FPP SO WE PUT CONST HERE
+ TAD ACH /HI MANTISSA OF Z
+ SPA SNA CLA /IS Z<0?
+ JMP NULLST /YES-RETURN THE NULL STRING
+ JMS I PUNSFIX /NO-FIX Z
+ STL
+ TAD SACLEN /CALC Z-LEN(SAC)
+ SNL /SKP IF Z.LO.LEN(SAC)
+ CLA /ELSE TAKE LEN(SAC)
+ CMA
+ TAD SACLEN
+ TAD YARG /NUMBER OF BYTES TO USE
+ SMA
+ JMP NULLST /NONE, RETURN NULL STRING
+ DCA STRCNT
+ TAD YARG /INDEX INTO STRING FOR SOURCE BYTES
+ TAD (SAC-2
+ DCA XR2 /SET SOURCE XR
+ TAD STRCNT
+ DCA SACLEN /SET NEW LENGTH OF SAC NOW
+ TAD I XR2 /NOW MOVE THE BYTES
+ DCA I SACXR
+ ISZ STRCNT
+ JMP .-3
+ JMP I PILOOP /--RETURN--
+NULLST, CLA CLL
+ DCA SACLEN /ZERO SAC
+ JMP I PILOOP /--RETURN--
+YARG, 0
+
+ PAGE
+\f /POS FUNCTION
+ /RETURNS THE POSITION IN X$ OF Y$ STARTING AFTER Z
+
+POS, CLA CLL
+ DCA INSAV /FAKE AS STRING CALL TO STRING 0
+ JMS I (STFIND /FIND Y$
+ TAD STRCNT /# OF CHARS IN Y$
+ SNA CLA /IS Y$ THE NULL STRING?
+ JMP ONERET /YES-RETURN 1 AS POSITION
+ TAD SACLEN /NO-# OF CHARS IN X$
+ SNA CLA /IS X$ THE NULL STRING?
+ JMP ZRORET /YES-RETURN 0
+ TAD ACH /NO-GET HORD OF Z
+ SPA SNA CLA /IS Z GT 0?
+PA, JMS I PERROR /NO-ILLEGAL ARGUMENT
+ JMS I PUNSFIX /FIX Z
+ DCA POSITN /USE IT AS POSITION TO START SEARCH
+ TAD POSITN
+ STL
+ TAD SACLEN /COMPARE POSITION TO MAXIMUM LENGTH OF STRING
+ SNL SZA CLA
+ JMP PA /Z IS PAST END OF STRING-ERROR
+POSSET, TAD STRCNT
+ CMA
+ TAD POSITN /GET POSITION NOW CHECKING+SIZE IF Y$
+ TAD SACLEN /COMPARE AGAINST LENGTH OF STRING
+ SMA SZA CLA /ANY MORE TO COME?
+ JMP ZRORET /NO-SEARCH FAILS
+ JMS I (BYTSET /SETUP BYTE LOAD ROUTINE
+ TAD POSITN /SEARCH START POSITION IN X$
+ TAD (SAC-2 /ADD TO BASE OF SAC
+ DCA SACXR
+ TAD STRCNT /# OF CHARS IN Y$
+ DCA TEMP3 /COUNTER
+SRCLP, JMS I (LDB
+ CIA
+ TAD I SACXR /COMPARE CHARS
+ SNA CLA /DO THEY MATCH?
+ JMP SCONTU /YES-CONTINUE MATCH TO NEXT CHAR IN X$ AND Y$
+ ISZ POSITN /BUMP POSITION TO BE CHECKED
+ JMP POSSET /ITERATE
+
+SCONTU, ISZ TEMP3 /MORE CHARS IN Y$?
+ JMP SRCLP /YES, ITERATE
+ TAD POSITN /NO FOUND A MATCH
+ JMP I (FLOATS
+ZRORET, JMS I PFACCLR /SEARCH FAILS-RETURN 0
+ JMP I PILOOP
+
+ONERET, CLA IAC
+ JMP I (FLOATS /RETURN 1
+POSITN, 0
+
+ PAGE
+\f RELOC
+
+//////////////////////////////////////////////////
+//////////////////////////////////////////////////
+///////// OVERLAY 3-FILE MANIPULATING ////////////
+///////// FUNCTIONS ////////////
+//////////////////////////////////////////////////
+//////////////////////////////////////////////////
+
+ *3400
+
+ /FILE CLOSING ROUTINE
+
+ VERSON^100+SUBVFF+6000 /VERSION WORD FOR FILES OVERLAY
+
+ANDPTR, ANDLST
+ANDLST, 7776 /MASKS FOR CLEARING BUFFER AND HANDLER STATUS BITS
+ 7775
+ 7773
+ 7767
+
+CLOSE, TAD ENTNO /GET FILE #
+ SNA CLA /IS IT TTY?
+ JMP I PILOOP /YES-DON'T DO ANYTHING
+ JMS I PIDLE /SEE IF FILE OPEN
+ JMS I PFTYPE /IS FILE NUMERIC?
+ JMP NOCZ /YES-DON'T OUTPUT ^Z
+ JMS I (FOTYPE /NO-IS FILE VARIABLE LENGTH?
+ JMP NOCZ /NO-DON'T OUTPUT ^Z
+ TAD (232 /YES
+ JMS I PPUTCH /WRITE A ^Z IN FILE
+NOCZ, JMS I (WRBLK /WRITE LAST BLOCK IF IT HAS CHANGED
+ JMS I PPSWAP /RESTORE 17600
+ JMS I (FOTYPE /IS FILE FIXED LENGTH?
+ JMP CLOSED /YES-NO NEED TO CLOSE THE FILE
+ TAD I IOTLEN /NO-GET FILE LENGTH
+ DCA CLENG /PUT IN CLOSE CALL
+ TAD IOTFIL
+ DCA FNAP /POINTER TO FILE NAME
+ TAD I IOTHDR
+ CLL RTL
+ RTL
+ RAL /GET DEVICE NUMBER INTO BITS 8-11
+ AND O17 /ISOLATE IT
+ CIF 10
+ JMS I O7700 /CALL USR
+ 4 /CLOSE
+FNAP, . /POINTER TO FILE NAME
+CLENG, .
+FC, JMS I PERROR /FILE CLOSING ERROR
+CLOSED, TAD I IOTBUF /GET BUFFER ADDRESS
+ CLL RTL
+ RTL /BUFFER NUMBER INTO AC
+ RAL /BITS 10,11
+ AND (3 /STRIP
+ TAD ANDPTR /USE AS INDEX INTO MASKS
+ DCA TEMP1
+ TAD BMAP /BUFFER STATUS MAP
+ AND I TEMP1 /CLEAR THE BIT FOR THIS BUFFER
+ DCA BMAP
+\f TAD I IOTHDR /HEADER WORD
+ AND O7400 /STRIP HEADER TO DEVICE # ONLY
+ DCA I IOTHDR
+ TAD MM4 /-4
+ DCA TEMP3 /USE AS COUNTER
+CHECKL, TAD TEMP3 /GET 3 OF FILE TO CHECK
+ TAD (W0PTR /MAKE POINTER TO PROPER W0 HEADER
+ DCA TEMP1 /SAVE POINTER
+ TAD TEMP3 /-# OF FILE WERE CHECKING
+ TAD ENTNO /COMPARE TO CURRENT NUMBER
+ SNA CLA /IS IT THIS ONE?
+ JMP PSTCHK /YES-DON'T CHECK DRIVER
+ TAD I TEMP1 /GET HEADER WORD FOR THE FILE OF INTEREST
+ AND O7400 /ISOLATE DEVICE #
+ CIA /NEGATE
+ TAD I IOTHDR /COMPARE TO CURRENT DEVICE #
+ SNA CLA /SAME DEVICE?
+ JMP CRETN /YES-LEAVE DRIVER IN CORE
+PSTCHK, ISZ TEMP3 /ALL 4 CHECKED?
+ JMP CHECKL /NO-CHECK THE NEXT 1
+ TAD I IOTHDR
+ AND O10 /GET HANDLER LENGTH BIT
+ SZA CLA /TWO PAGES?
+ JMP TPREL /YES-FREE BOTH PAGES
+ TAD I IOTHND /THIS IS THE ONLY FILE USING HANDLER THEN
+ CLL RTL
+ RTL /SLIDE BITS 4,5 OF HANDLER PAGE TO AC BITS 10,11
+ RAL
+ AND (3 /ISOLATE HANDLER BUFFER NUMBER
+ TAD ANDPTR /MAKE POINTER TO PROPER AND MASK
+RELCOM, DCA TEMP1
+ TAD DMAP /DRIVER PAGE MAP
+ AND I TEMP1 /CLEAR HANDLER PAGE BIT
+ DCA DMAP
+CRETN, DCA I IOTHND /SET FILE AS IDLE
+ JMS I PPSWAP /GET RID OF 17600 AGAIN
+ JMP I PILOOP /DONE
+
+TPREL, TAD I IOTHND /ONLY FILE USING HANDLER
+ CLL RTL
+ RTL /ISOLATE HANDLER BUFFER NUMBER
+ RAL
+ AND (3
+ TAD (ANDLS2 /USE AS INDEX TO AND MASK
+ JMP RELCOM
+
+W0PTR, FILE1
+ FILE2 /FILE TABLE ENTRIES
+ FILE3
+ FILE4
+
+MM4,
+ANDLS2, 7774
+ 7701
+
+/CODE TO READ IN COMPILER AND START IT
+/THIS CODE GETS MOVED TO FIELD 1 AND EXECUTED FROM
+/LOC 2001-2013 IN FIELD 1
+
+CREAD, CDF 10
+ CIF 0
+ 4613 /"JMS I L7607K"
+ 3700 /31 PAGES
+ 0 /0-7577
+CBLK, 7617 /STARTING BLOCK OF COMPILER
+ HLT /SYSTEM ERROR,AND SINCE WE ARE PROBABLY CLOBBERED,WE CAN'T REPORT IT
+ CIF 0
+ 5612 /"JMP I .+1"-START THE COMPILER
+ 7001 /STARTING ADDR OF COMPILER
+K7607K, 7607
+ /LESS THAN THE DESIRED VALUE
+
+EXTCHK, 0 /SKIP RETURN IF CURRENT
+ AC0002
+ IAC
+ TAD IOTFIL /IS .SV
+ DCA EXTEMP /JUST A TEMP
+ TAD I EXTEMP /GET EXTENSION
+ TAD (-2326
+ SNA CLA /IS IT .SV?
+ ISZ EXTCHK /YES: SKIP
+ JMP I EXTCHK
+EXTEMP, 0
+
+ PAGE
+\f/CHAIN FUNCTION
+/SETS UP COMMAND DECODER AREA,THEN CHAINS TO BCOMP.SV
+
+CHAIN, JMS I PXPRINT /EMPTY TTY RING BUFFER
+ JMP .-1
+ JMS I PPSWAP /RESTORE PG 17600
+ JMS I DNA2 /GET FILE NAME IN NAME AREA FROM CURRENT FILE
+ CIF 10
+ JMS I O7700 /CALL USR
+ 10 /LOCK IN CORE
+ TAD I IOTDEV
+ DCA DNA1 /FIRST TWO CHARS OF DEV NAME
+ TAD I IOTDEV+1 /LAST TWO CHARS
+ DCA DNA2
+ CIF 10
+ JMS I USR
+ 12 /INQUIRE
+DNA1, 0 /DEVICE NAME
+DNA2, NAMEG
+CDIN, 0
+CI, JMS I PERROR /ERROR
+ TAD CDIN /GET ENTRY POINT OF DRIVER FOR CHAIN FILE
+ SZA CLA /IS IT IN CORE?
+ JMP DISIN /YES-NO NEED TO FETCH IT
+ TAD DNA2 /NO-DEVICE # INTO AC
+ CIF 10
+ JMS I USR
+ 1 /FETCH HANDLER
+ 7001 /INTO PAGE 7000
+ JMP CI /MAKE IT LOOK LIKE INQUIRE ERROR
+DISIN, TAD IOTFIL
+ DCA STB /POINTER TO FILE NAME
+ TAD DNA2 /GET DEVICE #
+ CIF 10
+ JMS I USR
+ 2 /LOOKUP
+STB, 0 /POINTER TO FILE NAME
+FLN, 0
+CL, JMS I PERROR /LOOKUP ERROR
+ TAD STB /GET STARTING BLOCK
+ CDF 10
+ DCA I (7620 /STARTING BLOCK IN CD AREA
+ TAD FLN /FILE LENGTH
+ CLL RTL
+ RTL
+ AND (7760 /PUT IN BITS 0-7
+ TAD DNA2 /COMBINE WITH DEVICE #
+ DCA I (7617 /PUT IN CD AREA
+ TAD O100 /SET R SWITCH
+ DCA I (7644
+ TAD I (7605 /STARTING BLOCK OF COMPILER
+ SNA /(IS THIS A CORE IMAGE?
+ JMP CICHAIN /YES: HANDLE SOMEWHAT DIFFERENTLY
+ CDF
+ DCA I (CBLK /INTO COMPILER READ CODE
+ CDF
+ JMS I (EXTCHK /SKP IF EXTENSION .SV
+ SKP
+ JMP CX /ERROR IF IT IS
+ JMS I (PSWAP2 /NOW EXEC DESTRUCTIVE EXIT CODE
+ CDF 10
+ JMP I (CSMOVE /MOVE THE COMPILER READ TO FIELD 1 AND EXECUTE IT
+
+CICHAIN,CDF
+ JMS I (EXTCHK /SKP IF EXTENSION IS .SV
+CX, JMS I PERROR /ERROR IF NOT
+ JMS I (PSWAP2 /NOW EXEC ONCE ONLY CLEAN UP ROUTINE
+ TAD STB
+ DCA CHNSTB
+ CIF 10 /NOW DO A RESET AND DELETE TENTATIVE FILES
+ JMS I USR
+ 13 /RESET
+ CIF 10 /FLAG TENTATIVE FILE CLEANUP
+ JMS I USR
+ 6
+CHNSTB, HLT
+\f /FILE LOOKUP
+
+FLOOK, AC0002
+ JMS I (ENTLOK /LOOKUP
+ DCA I IOTLEN /ACTUAL LENGTH
+ TAD I IOTLEN
+ DCA I IOTMAX /ALSO EQUALS MAXIMUM LENGTH
+CLEANP, DCA I IOTPOS /ZERO COLUMN POINTER
+ CMA /-1
+ TAD I IOTLOC /STARTING BLOCK-1
+ DCA I IOTBLK /CURRENT BLOCK #=STARTING BLOCK-1
+ TAD I IOTBUF
+ DCA I IOTPTR /READ/WRITE POINTER AT BEGINNING OF BUFFER
+ CIF 10
+ JMS I USR /CALL TO USR
+ 11 /USROUT
+ JMS I PPSWAP /GET RID OF 17600
+ JMS I (BLZERO
+ JMS I (NEXREC /DO A NEXREC TO READ IN FIRST FILE BLOCK
+ JMP I PILOOP /DONE
+
+ /ROUTINE FOR INTERPRETER EXIT
+
+FSTOP, KSF /IS THE KEYBOARD FLAG SET?
+ JMP NOCTC /NO-THERE IS NO CHANGE ^C SENT US HERE
+ TAD O200 /YES-FORCE PARITY BIT
+ KRB /GET CHARACTER
+ TAD (-203 /COMPARE AGAINST ^C
+ SZA CLA /WAS IT ^C?
+ JMP NOCTC /NO-THIS IS A NORMAL EXIT
+ TSF
+ JMP .-1
+ TAD ("^ /YES -ECHO ^
+ TLS
+ CLA
+ TSF
+ JMP .-1
+ TAD ("C /ECHO "C"
+ TLS
+NOCTC, TSF
+ JMP .-1
+ JMP I (MEXIT
+
+ PAGE
+\f /FILE OPENING ROUTINE
+
+OPENAV, TAD (4 /ALPHANUMERIC,VARIABLE LENGTH
+OPENAF, IAC /ALPHANUMERIC,FIXED LENGTH
+ JMP OPENNF
+OPENNV, TAD (4 /NUMERIC,VARIABLE LENGTH
+OPENNF, DCA I IOTHDR /SET UP HEADER WORD
+ TAD ENTNO /IS FILE TTY?
+ SNA CLA
+ JMP I PILOOP /YES-DON'T DO ANYTHING
+ TAD I IOTHND /GET HANDLER ENTRY
+ SZA CLA /IS FILE IDLE?
+FB, JMS I PERROR /ATTEMPT TO OPEN FILE ALREADY OPEN
+ JMS I PPSWAP /RESTORE 17600
+ JMS I (NAMEG /GET FILE DEVICE NAME AND FILE NAME INTO WORDS 7-14 FROM SAC
+ CIF 10
+ JMS I O7700 /CALL TO USR
+ 10 /LOCK USR IN CORE
+ TAD I IOTDEV
+ DCA DEVNA1 /DEVICE NAME INTO INQUIRE CALL
+ TAD I IOTDEV+1
+ DCA DEVNA2
+ CIF 10
+ JMS I USR /CALL TO USR
+ 12 /INQUIRE
+DEVNA1, . /DEVICE NAME
+DEVNA2, .
+ENTRYN, 0 /ENTRY POINT
+IN, JMS I PERROR /INQUIRE ERROR
+ TAD DEVNA2 /GET DEVICE #
+ CLL RAR
+ RTR /PUT INTO BITS 0-3
+ RTR
+ TAD I IOTHDR
+ DCA I IOTHDR /STORE IN HEADER WORD
+ TAD ENTRYN /GET DRIVER ADDRESS
+ SZA /IS IT IN CORE?
+ JMP I (DRIVRN /YES-NO NEED TO FETCH IT
+ TAD DMAP /NO-GET MAP OF DRIVER PAGES
+ CLL RAR /PAGE 7000 BIT IN LINK
+ SNL /IS PAGE 7000 FREE?
+ JMP FREE70 /YES
+ CLL RAR /NO-7200 BIT TO LINK
+ SNL /IS PAGE 7200 FREE?
+ JMP FREE72 /YES
+\f CLL RAR /NO-7400 BIT TO LINK
+ SZL CLA /IS PAGE 7400 FREE?
+DO, JMS I PERROR /NO-NO MORE ROOM FOR DRIVERS
+ TAD O7400 /YES-LOAD HANDLER INTO 7400
+ DCA FETPAG /SET UP IN FETCH CALL
+ TAD (4 /SET BIT 9 TO SHOW PAGE 7400 OCCUPIED
+ JMP DFETCH /FETCH DRIVER
+
+FREE70, CLL RAR /PAGE 7200 BIT TO LINK
+ SNL CLA /IS 7200 FREE?
+ IAC /YES-THERE IS ROOM FOR A TWO PAGE HANDLER
+ TAD (7000
+ DCA FETPAG /SET UP FETCH TO USE PAGE 7000
+ CLL CLA CML RTL /TURN ON BIT 10
+ DCA TPH /SAVE IN TWO PAGE SET WORD
+ IAC /SET BIT 11 TO SHOW PAGE 7000 OCCUPIED
+ JMP DFETCH /FETCH HANDLER
+
+FREE72, CLL RAR /7400 BIT TO LINK
+ SNL CLA /IS 7400 PAGE FREE?
+ IAC /YES-THEN THERE IS ROOM FOR A 2 PAGE HANDLER
+ TAD (7200
+ DCA FETPAG /SET ADDRESS IN FETCH CALL
+ TAD (4
+ DCA TPH /IF TWO PAGE LOADED,SET BIT 9 ALSO
+ AC0002 /TURN ON BIT 10 TO SHOW PAGE 7200 OCCUPIED
+DFETCH, TAD DMAP /TURN ON PAGE BIT FOR WHERE BUFFER WILL BE LOADED
+ DCA DMAP
+ TAD DEVNA2 /DEVICE # IN AC
+ CIF 10
+ JMS I USR /CALL TO USR
+ 1 /FETCH
+FETPAG, . /DRIVER ADDRESS
+FE, JMS I PERROR /FETCH ERROR
+ CDF 10
+ CLA CMA
+ TAD I (37 /GET ADDR OF HANDLER INFO TABLE
+ TAD DEVNA2 /USE THE DEVICE # AS AN INDEX INTO THAT TABLE
+ DCA TEMP1 /SAVE POINTER
+ TAD I TEMP1 /GET THE INFO WORD FOR THE HANDLER JUST FETCHED
+ CDF
+ SMA CLA /IS HANDLER 2 PAGES LONG?
+ JMP DRAP /NO MAP IS COMPLETE
+ TAD TPH /YES-UPDATE DRIVER MAP TO INCLUDE
+ TAD DMAP /SECOND PAGE OF TWO PAGE HANDLERS
+ DCA DMAP
+ TAD O10
+ TAD I IOTHDR /SET 2 PAGE BIT IN HEADER WORD
+ DCA I IOTHDR
+DRAP, TAD FETPAG /HANDLER ENTRY ADDRESS
+ JMP I (DRIVRN /PAGE ESCAPE
+
+TPH, 0
+\f/ROUTINE TO MOVE THE COMPILER READER INTO FIELD 1 AND START IT
+
+CSMOVE, TAD (CREAD-1
+ DCA XR1 /POINTES TO COMPILER STARTING CODE
+ TAD (-13
+ DCA TEMP1 /COUNTER
+ TAD (2000
+ DCA XR2 /MOVE TO LOC 2001 IN FIELD 1
+ CDF
+ TAD I XR1 /GET WORD OF CODE
+ CDF 10
+ DCA I XR2 /MOVE IT
+ ISZ TEMP1 /DONE?
+ JMP .-5 /NO
+ CIF 10 /YES-START IT
+ JMS I (2000
+
+ PAGE
+\fDRIVRN, DCA I IOTHND /DRIVER ENTRY INTO I/O TABLE
+ TAD BMAP /GET BUFFER MAP
+ CLL RAR /BUFF1 BIT TO LINK
+ SNL /IS IT FREE?
+ JMP B1 /YES-ASSIGN BUFF1
+ RAR /BUFF2 BIT TO LINK
+ SNL /IS IT FREE?
+ JMP B2 /YES-ASSIGN BUFF2
+ RAR /BUFF3 BIT TO LINK
+ SNL /IS IT FREE
+ JMP B3 /YES-ASSIGN BUFF3
+ RAR /NO-BUFF4 BIT TO LINK
+ SZL CLA /IS IT FREE?
+BO, JMS I PERROR /NO-NO MORE BUFFERS AVAILABLE
+ TAD (1400
+ DCA I IOTBUF /SET BUFFER ADDRESS TO 1400
+ TAD O10 /SET BUFF4 BIR IN MAP
+ JMP BUFASS
+
+B3, CLA
+ TAD (1000
+ DCA I IOTBUF /SET BUFFER ADDRESS TO 1000
+ TAD (4
+ JMP BUFASS /SET BUFF3 BIT IN MAP
+
+B2, CLA
+ TAD O400
+ DCA I IOTBUF /SET BUFF ADDRESS TO 400
+ CLL CML CLA RTL /SET BUFF2 BIT IN MAP
+ JMP BUFASS
+
+B1, CLA
+ DCA I IOTBUF /SET BUFF ADDRESS TO 0000
+ CLA IAC /TURN ON BUFF1 BIT IN MAP
+\fBUFASS, TAD BMAP
+ DCA BMAP /UPDATE BUFFER ASSIGNMENT MAP
+ TAD I IOTHDR /GET HEADER WORD
+ CLL RTR
+ RAR /FIXED,VARIABLE BIT TO LINK
+ SNL CLA /IS IT FIXED?
+ JMP I (FLOOK /YES-DO A LOOKUP
+ TAD (3 /NO-DO AN ENTER
+ JMS ENTLOK /ENTER
+ DCA I IOTMAX /MAXIMUM LENGTH IN WORD 7
+ DCA I IOTLEN /ZERO ACTUAL LENGTH
+ JMP I (CLEANP /FINALIZE I/O TABLE ENTRY
+
+MEXIT, CLA
+ JMS I PPSWAP
+ JMS I (PSWAP2 /RESTORE PG 27600
+ CDF 10
+ TAD I (EDBLK /GET BLOCK # FOR EDITOR
+ CDF
+ SNA /SHALL WE CALL THE EDITOR?
+ JMP I (7600 /NOkJUST CALL OS/8
+ DCA EBLK /YES-PUT THE BLOCK # IN DRIVER CALL
+ JMS I (7607 /CALL SYS DRIVER
+ 2100 /READ 8 BLOCKS
+ 0 /INTO 0-3377
+EBLK, . /BLOCK # OF EDITOR
+ HLT /SYS ERROR,AND SINCE WE ARE PROBABLY CLOBBERED,WE CAN'T REPORT IT
+ JMP I .+1 /START THE EDITOR
+ 3212
+\fENTLOK, 0
+ DCA FNOM /FUNCTION NUMBER IN PLACE
+ TAD IOTFIL /POINTER TO FILE NAME
+ DCA STARTB /INTO CALL
+ TAD I (DEVNA2 /DEVICE NUMBER
+ CIF 10
+ JMS I USR /CALL TO USR
+FNOM, . /ENTER OR LOOKUP
+STARTB, .
+FLEN, .
+EN, JMS I PERROR /ENTER ERROR
+ TAD STARTB /FILE STARTING BLOCK #
+ SZA CLA /IS IT NON-ZERO?
+ JMP FILSTU /YES-DEVICE IS FILE STRUCTURED
+ TAD FLEN /NO-GET FILE LENGTH
+ SZA CLA /IS IT EMPTY?
+ JMP FILSTU /NO-DEVICE IS FILE STRUCTURED
+ TAD (20 /NO-FILE IS READ/WRITE ONLY
+ TAD I IOTHDR
+ DCA I IOTHDR /SET READ/WRITE ONLY BIT
+ TAD FNOM
+ CLL RAR
+ SNL CLA
+ IAC
+FILSTU, TAD STARTB /GET STARTING BLOCK # OF FILE
+ DCA I IOTLOC /PUT IN I/O TABLE
+ TAD FLEN /FILE LENGTH
+ CIA /MAKE FILE LENGTH POSITIVE
+ JMP I ENTLOK /RETURN
+\f/SUBROUTINE P2SWAP-RESTORE OS/8 RESIDENT MONITOR PRIOR TO EXIT FROM INTERPRETERTER
+/THIS IS DESTRUCTIVE CODE,AND ONCE THIS ROUTINE HAS BEEN EXECUTED
+/THERE IS NO PLACE TO GO BUT OUT.
+/HAS 3 FUNCTIONS:
+/ 1) REMOVES CTRL/C HOOKS FROM SYS DRIVER
+/ 2) RESTORES BATCH CONTROL WORDS TO 27774-27777
+/ 3) IF SYS=TD/8E,RESTORES PAGE 27600 AND RETURNS CDFS TO PAGE 07600
+
+PSWAP2, 0
+ TAD (4207
+ DCA I (7600 /REMOVE CTRL/C HOOKS
+ TAD (6213
+ DCA I (7605
+ TAD (7600
+ DCA I (HICORE /FUDGE POINTER IN SWAP ROUTINE (IN CASE IT WAS TD8E)
+ TAD PSFLAG /GET RESIDENT STATUS FLAG
+ SPA CLA /IS THIS TD8/E SYS?
+ JMS I (PSWP2P /YES-RESTORE PAGE 27600 AND PAGE 07600
+ TAD CDFIO
+ DCA .+3 /CDF TO HI CORE
+ CDF 10
+ TAD I BOSPT1 /GET BATCH WORD
+ CDF 10
+ DCA I BOSPT2 /BACK INTO LOFTY STATE
+ ISZ BOSPT1
+ ISZ BOSPT2
+ JMP .-6
+ CDF
+ JMP I PSWAP2 /YES-WE ARE FINISHED,SO RETURN
+BOSPT1, 7600
+BOSPT2, 7774
+
+ PAGE
+\f /PARSE A FILENAME OF THE FORM "DEVN:FILENM.EX" IN THE SAC
+ /DSK: AND A NULL EXTENSION ARE THE DEFAULTS
+ /THE END OF THE SAC IS USED AS A WORK AREA
+ /IF SYNTAX IS CORRECT, THE NAME IS PACKED INTO
+ /THE FILENAME FIELD OF THE CURRENT FILE
+ /OTHERWISE A FATAL ERROR IS RETURNED
+ /ENTERED WITH OS/8 SWAPPED IN
+
+ WKAREA= SAC+16 /DEFINE SCRATCH AREA
+
+NAMEG, 0
+ TAD SACLEN
+ TAD (16 /COMPARE STRING LENGTH TO 16
+ SPA CLA
+IF, JMS I PERROR /TOO MANY CHARS IN "DEV:FILENM.EX"
+ TAD SACLEN
+ DCA TEMP2 /STRING LENGTH COUNTER
+ TAD PSACM1
+ DCA SACXR
+ TAD (DSK-1 /FIRST USE THE DEFAULT DEVICE
+ JMS DEVFUD
+NCG, TAD I SACXR /GET CHAR FROM SAC
+ DCA TEMP1 /SAVE
+ TAD TEMP1
+ TAD (-72 /IS IT A COLON?
+ SNA
+ JMP CAD /YES-CHARS SO FAR=DEVICE NAME
+ TAD (14 /NO-IS IT A PERIOD?
+ SNA CLA
+ JMP SSAD /YES-NEXT TWO CHARS=EXTENSION
+ TAD TEMP1 /NO-GET CHAR AGAIN
+ DCA I XR2 /STORE IN WORK AREA
+ ISZ TEMP4 /BUMP COUNT FOR CURRENT SECTION
+NCGS, ISZ TEMP2 /END OF STRING YET?
+ JMP NCG /NO-NEXT CHAR
+\f TAD TEMP4 /YES-GET CHAR COUNT FOR THIS SECTION (NAME)
+ TAD (-6
+ SMA SZA CLA /IS IT >6?
+ JMP IF /YES-TOO MANY CHARACTERS IN FILE NAME
+ TAD (WKAREA-1 /NO-ADDRESS OF SCRATCH NAME BLOCK
+ DCA XR1
+ STA /-1
+ TAD IOTDEV /ADDRESS OF FINAL NAME BLOCK-1
+ DCA XR2
+ TAD (-6 /MOVE 6 WORDS
+ DCA TEMP2
+MML, TAD I XR1
+ CLL RTL
+ RTL
+ RTL
+ TAD I XR1
+ DCA I XR2 /MOVE NAME WORD FROM SCRATCH AREA TO FINAL DEST
+ ISZ TEMP2 /DONE?
+ JMP MML /NO
+ JMP I NAMEG /YES-RETURN
+
+CAD, TAD TEMP4 /GET CHAR COUNT FOR THIS SECTION
+ TAD (-4 /COMPARE AGAINST 4
+ SMA SZA CLA /TOO MANY CHARS?
+ JMP IF /YES-DEVICE NAME TOO LONG
+ TAD (WKAREA-1+4
+ JMS DEVFUD /CLEAR BUF AND GET NAME FROM FILE FIELD THIS TIME
+ JMP NCGS
+
+SSAD, TAD TEMP4 /COUNT FOR THIS SECTION (FILE NAME)
+ TAD (-6
+ SMA SZA CLA /TOO MANY?
+ JMP IF /YES-FILE NAME TOO LONG
+ DCA TEMP4 /NO-CLEAR COUNT
+ TAD DSK
+ TAD TEMP2 /COMPARE AGAINST # OF CHARS LEFT
+ SPA SNA CLA
+ JMP IF /TOO MANY CHARS IN EXTENSION
+ TAD (WKAREA-1+12
+ DCA XR2
+ JMP NCGS
+
+DEVFUD, 0
+ DCA XR1 /POINT AT LOC OF DEV:
+ TAD (WKAREA-1
+ DCA XR2 /POINT AT START OF WORK AREA
+ TAD (-10
+ DCA TEMP4
+ TAD (-4
+ DCA TEMP3
+ TAD I XR1 /GET A DEVICE NAME BYTE
+ DCA I XR2 /STORE IN WORK AREA DEVICE FIELD
+ ISZ TEMP3
+ JMP .-3 /ITERATE
+ DCA I XR2 /NOW CLEAR REST OF FILE NAME
+ ISZ TEMP4
+ JMP .-2 /ITERATE
+ TAD (WKAREA-1+4 /POINT XR2 AT FILENAME FIELD
+ DCA XR2
+ JMP I DEVFUD /RETURN WITH TEMP4 CLEAR
+
+DSK, 4;23;13;0 /6BIT DEFAULT DEVICE NAME "DSK"
+\f/SUBROUTINE TO RESTORE PAGE 27600 OF TD8/E DRIVER
+/AND READJUST THE CDFS IN FIELD 0
+
+PSWP2P, 0
+ TAD PSFLAG
+ RTL
+ SNL CLA /BIT 1 SET MEANS PHONEY TD8E
+ JMP .+3
+ DCA PSFLAG
+ JMP I PSWP2P
+ DCA PSFLAG /CLEAR RESIDENT STATUS FLAG
+ TAD (CDF 20
+ DCA I (P2CDF /PUT CDF 20 IN SWAP ROUTINE
+ TAD (CDF 20
+ DCA I (P2CDF1
+ JMS I PPSWAP /MOVE DOWN PAGE 27600
+ TAD (6223
+ DCA I (7642
+ TAD (6222
+ DCA I (7721
+ TAD (6222 /RESTORE CDFS IN PAGE 07600
+ DCA I (7727
+ JMP I PSWP2P /RETURN
+
+ PAGE
+\f
+
+
+ FIELD 0
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+/////////////////////////////////////////////////////////////////////
+/////////////////////////////////////////////////////////////////////
+/////////////// END OF OVERLAY AREA /////////////////////////////////
+/////////////////////////////////////////////////////////////////////
+/////////////////////////////////////////////////////////////////////
+
+ $
+\f<:STTYF, 1\e+1"E0;'
+J<S\13PRINT\13\e;R-5DI[XPRINT\e>
+J<S\13SACPTR\13\e;R-6DI[SAC-1\e>
+J<S\13PUTCHL\13\e;R-6DI[PUTCH\e>
+J<S\13ILOOPL\13\e;R-6DI[ILOOP\e>
+J<S\13INTL\13\e;R-4DI[UNSFIX\e>
+J<S\13CDFPSL\13\e;R-6DI[CDFPSU\e>
+J<S\13ERROR\13\e;R-5DI[ERRDIS\e>
+J<S\13FBITS\13\e;R-5DI[FBITGT\e>
+J<S\13PWFECL\13\e;R-5DI[PWFECH\e>
+J<S\13MPYLNK\13\e;R-6DI[MPY\e>
+J<S\13XPUT\13\e;R-4DI[XPUTCH\e>
+J<S\13FIDLE\13\e;R-5DI[IDLE\e>
+J<S\13DEVCAL\13\e;R-6DI[DRCALL\e>
+J<S\13WRITFW\13\e;R-6DI[WRITFL\e>
+J<S\13STHINL\13\e;R-6DI[STHINI\e>
+J<S\13LDHINL\13\e;R-6DI[LDHINI\e>
+J<S\13STH\13\e;R-3DI[STHL\e>
+J<S\13LDH\13\e;R-3DI[LDHL\e>
+J<S\13FACSAL\13\e;R-6DI[FACSAV\e>
+J<S\13FACREL\13\e;R-6DI[FACRES\e>
+J<S\13FGETL\13\e;R-5DI[FFGET\e>
+J<S\13FPUTL\13\e;R-5DI[FFPUT\e>
+J<S\13FNORL\13\e;R-5DI[FFNOR\e>
+J<S\13FCLR\13\e;R-4DI[FACCLR\e>
+J<S\13FNEGL\13\e;R-5DI[FFNEG\e>
+J<S\13FLOATL\13\e;R-6DI[FFLOAT\e>
+J<S\13GETCHL\13\e;R-6DI[GETCH\e>
+J<S\13EOFSEL\13\e;R-6DI[EOFSET\e>
+J<S\13BSWL\13\e;R-4DI[BSWP\e>
+J<S\13PACKL\13\e;R-5DI[PACKCH\e>
+J<S\13CNOCLL\13\e;R-6DI[CNOCLR\e>
+J<S\13BUFCHL\13\e;R-6DI[BUFCHK\e>
+J<S\13FTYPL\13\e;R-5DI[FTYPE\e>
+J<S\13CHRNOL\13\e;R-6DI[CHARNO\e>
+J<S\13NEXREL\13\e;R-6DI[NEXREC\e>
+J<S\13CRLF\13\e;R-4DI[CRLFR\e>
+J<S\13VALLK\13\e;R-5DI[VALGET\e>
+J<S\13PATCHP\13\e;R-6DI[PATCHF\e>
+J<S\13P1SWAP\13\e;R-6DI[PSWAP\e>
+J<S\13LDHRST\13\e;R-6DI[LRESET\e>
+J<S\13STHRST\13\e;R-6DI[SRESET\e>
+P>
+\f
projects / pdp8.git / blobdiff