File BRTS.PA (PAL assembler source file)

Directory of image this file is from
This file as a plain text file

/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.
/
/
/
/
/
/

/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
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
/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
/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
*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
/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
/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
*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
/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
/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
/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
/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
/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
/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
/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
/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
/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
/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
/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
/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
/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!
/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
/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--
/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
/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
/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
/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
/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
/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
/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
/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--
/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
/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
/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
/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
/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
/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
/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
/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
/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
/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
/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
///////////////////////////////////////////////////////////// ///////////////////////////////////////////////////////////// //////////// OVERLAY BUFFER 3400-4600 //////////////////// //////////// CONTAINS FUNCTION OVERLAYS //////////////////// //////////// AT RUN TIME //////////////////// ///////////////////////////////////////////////////////////// /////////////////////////////////////////////////////////////
///////////////////////////////////////////////////////////// ///////////////////////////////////////////////////////////// ////////////// 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
/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
EMDONE, 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
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
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 >
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 >
/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
/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
/******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
/******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
/******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
*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
/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
/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--
/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
/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
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
EDON, 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
/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
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
/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
/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
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)
/ /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
/ /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.
/ /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
*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 >
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
/ /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
EDON, 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
/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 /
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
/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
/ /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
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
/ /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
/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
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
/ /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 >
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
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 >
/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
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 >
/ /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
*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
/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
/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
*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
/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
///////////////////////////////////////////////////////////// ///////////////////////////////////////////////////////////// ////////////// 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
/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
/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
/ 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
/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
/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
/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
/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
/ERROR TABLE/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
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
/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
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
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
/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
/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
/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
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
/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
DRIVRN, 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
BUFASS, 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
ENTLOK, 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
/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
/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
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"
/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
FIELD 0 ///////////////////////////////////////////////////////////////////// ///////////////////////////////////////////////////////////////////// /////////////// END OF OVERLAY AREA ///////////////////////////////// ///////////////////////////////////////////////////////////////////// ///////////////////////////////////////////////////////////////////// $
<:STTYF, 1+1"E0;' J<SPRINT;R-5DI[XPRINT> J<SSACPTR;R-6DI[SAC-1> J<SPUTCHL;R-6DI[PUTCH> J<SILOOPL;R-6DI[ILOOP> J<SINTL;R-4DI[UNSFIX> J<SCDFPSL;R-6DI[CDFPSU> J<SERROR;R-5DI[ERRDIS> J<SFBITS;R-5DI[FBITGT> J<SPWFECL;R-5DI[PWFECH> J<SMPYLNK;R-6DI[MPY> J<SXPUT;R-4DI[XPUTCH> J<SFIDLE;R-5DI[IDLE> J<SDEVCAL;R-6DI[DRCALL> J<SWRITFW;R-6DI[WRITFL> J<SSTHINL;R-6DI[STHINI> J<SLDHINL;R-6DI[LDHINI> J<SSTH;R-3DI[STHL> J<SLDH;R-3DI[LDHL> J<SFACSAL;R-6DI[FACSAV> J<SFACREL;R-6DI[FACRES> J<SFGETL;R-5DI[FFGET> J<SFPUTL;R-5DI[FFPUT> J<SFNORL;R-5DI[FFNOR> J<SFCLR;R-4DI[FACCLR> J<SFNEGL;R-5DI[FFNEG> J<SFLOATL;R-6DI[FFLOAT> J<SGETCHL;R-6DI[GETCH> J<SEOFSEL;R-6DI[EOFSET> J<SBSWL;R-4DI[BSWP> J<SPACKL;R-5DI[PACKCH> J<SCNOCLL;R-6DI[CNOCLR> J<SBUFCHL;R-6DI[BUFCHK> J<SFTYPL;R-5DI[FTYPE> J<SCHRNOL;R-6DI[CHARNO> J<SNEXREL;R-6DI[NEXREC> J<SCRLF;R-4DI[CRLFR> J<SVALLK;R-5DI[VALGET> J<SPATCHP;R-6DI[PATCHF> J<SP1SWAP;R-6DI[PSWAP> J<SLDHRST;R-6DI[LRESET> J<SSTHRST;R-6DI[SRESET> P>



Feel free to contact me, David Gesswein djg@pdp8online.com with any questions, comments on the web site, or if you have related equipment, documentation, software etc. you are willing to part with.  I am interested in anything PDP-8 related, computers, peripherals used with them, DEC or third party, or documentation. 

PDP-8 Home Page   PDP-8 Site Map   PDP-8 Site Search