File: BRTS.03 of Tape: OS8/OS8-V3/dec-s8-uextb-a-ua2
(Source file text)
/OS8 BASIC RUNTIME SYSTEM, V3 / / / / / / / / / /COPYRIGHT (C) 1974 BY DIGITAL EQUIPMENT CORPORATION / / / / / / / / / / /THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE /AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT /CORPORATION. DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY /FOR ANY ERRORS THAT MAY APPEAR IN THIS MANUAL. / /THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER /UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED /(WITH INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH /SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL. / /DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE /OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY /DIGITAL. / / / / / / / / / / /AUGUST 19, 1972 / /R.G. BEAN, 1972 /SHAWN SPILMAN, 1973 / / / VERSON=300 /ADDRESS OF START OF 5 PAGE OVERLAY BUFFER: OVERLAY=3400 /ASSEMBLY INSTRUCTIONS: / .R PAL8 / *BRTS,BRTS<BRTS.03/K (REQUIRES 12K CORE) / .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$ (*BRTS,EAEOVR$ IF YOU WISH TO USE ON EAE MACHINE) /.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. /THE RESULTING BINARY IS THEN LOADED OVER THE NORMAL SYSTEM /BINARY AS AN OVERLAY USING THE ABS LOADER,AND THE MODIFIED SYSTEM /IS SAVED. IN OTHER WORDS,TO CREATE A NON-EAE SYSTEM,ASSEMBLE THIS /SOURCE ONCE,WITH EAE=0, AND PERFORM THE SAVE OPERATIONS ABOVE ON THE /BINARY THAT RESULTS. TO CREATE AN EAE SYSTEM,ASSEMBLE THIS SOURCE /TWICE,ONCE WITH EAE=0 AND ONCE WITH EAE=1. USE THE ABSOLUTE LOADER /TO LOAD BOTH RESULTING BINARIES (THE EAE BINARY MUST BE LOADED /AFTER THE NORMAL BINARY), THEN PERFORM THE SAVE /OPERATIONS ON THE RESULT. /EAE=0 /USE STANDARD FLOATING POINT PACKAGE /EAE=1 /ASSEMBLE EAE OVERLAY IFNDEF EAE <EAE=0> XLIST EAE IFNZRO EAE < NOPUNCH > / /PAGE 0 LOCATIONS *0 HLT HLT HLT TEMP14, 0 TEMP15, 0 /TEMPS USED BY CHARACTER UNPACKING ROUTINES BLZERP, BLZERO USECON, 0 /USE CONSTANT GENERATED BY "USE" STATEMENT TEMP2, 0 *10 XR0, 0 XR1, 0 XR2, 0 XR3, 0 XR4, 0 /INDEX REGISTERS XR5, TEMP18, 0 DLPTR, 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 /SYSTEM REGISTERS PSFLAG, 0 /IF BIT 0 ON,TD8/E PG2 MOVED /IF BIT 11 ON,PG 17600 HAS BEEN MOVED STRLEN, 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 EXP, ACX, 0 /FAC-EXPONENT HORD, ACH, 0 /FAC-HIGH ORDER MANTISSA LORD, ACLO, 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 K215, SWIT1, 215 /=0 FOR NO LF AFTER CR ON INPUT M215, SWIT2, -215 /=0 FOR NO CR/LF AFTER OUTPUT EFLG, 7777 /O=E FORMAT FLDW, 24 /FIELD WIDTH OF OUTPUT DADP, 12 /#OF PLACES AFTER DEC. PT TEMP10, 0 /LOC NEEDED BY FPP TEMP11, 0 /LOC NEEDED BY FPP /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 GSP, GSTCK-1 /POINTER INTO GOSUB STACK STRMAX, 0 /MAXIMUM # OF CHARS ALLOWED IN CURRENT STRING STRCNT, 0 /- # OF CHARACTERS IN CURRENT STRING STRPTR, 0 /POINTER TO CURRENT OPERAND STRING /OFT USED CONSTANTS K0010, 0010 K0017, 0017 K0077, 0077 K0100, 100 USR, K0200, 0200 K200=K0200 K0340, 0340 K0377, 0377 K0400, 0400 K7400, 7400 K7700, 7700 K7477, 7477 KM40, -40 M14, -14 /OFT USED LINKS PRINT, XPRINT /LINK FOR TTY DRIVER HOOKS SACPTR, SAC-1 /POINTER TO STRING ACCUMULATOR PUTCHL, PUTCH /LINK TO FILE BUFFER STUFFING ROUTINE ILOOPL, ILOOP /POINTER TO START OF ILOOP INTL, UNSFIX /LINK TO UNSIGNED 12-BIT INTEGER FIX CDFPSL, CDFPSU /POINTER TO PSEUDO-CODE CDF ERROR, ERRDIS /ERROR ROUTINE DISPATCH FBITS, FBITGT /ROUTINE TO ISOLATE FUNCTION BITS FROM INST PWFECL, PWFECH /ROUTINE TO GET NEXT WORD FROM PSEUDO-CODE STREAM MPYLNK, MPY /LINK TO 12 BY 12 BIT MULTIPLY XPUT, XPUTCH /ROUTINE TO PUT CHAR IN TTY RING BUFFER FIDLE, IDLE /LINK TO FILE IDLE CHECK ROUTINE DEVCAL, DRCALL /LINK TO DEVICE DRIVER CALLING ROUTINE WRITFW, WRITFL /ROUTINE TO WRITE 1 WORD IN FILE BUFFER STHINL, STHINI /LINK TO STH INITIALIZER LDHINL, LDHINI /LINK TO LDH INITIALIZE STH, STHL /STORE HALF ROUTINE LDH, LDHL /LOAD HALF ROUTINE FACSAL, FACSAV /ROUTINE TO SAVE FAC IN TEMPOARARY FACREL, FACRES /ROUTINE TO RESTORE FAC FROM TEMPORARY FGETL, FFGET /LINK TO FPP GET ROUTINE FPUTL, FFPUT /LINK TO FPP PUT ROUTINE FNORL, FFNOR /LINK TO FPP NORMALIZE ROUTINE FCLR, FACCLR /ROUTINE TO ZERO FAC FNEGL, FFNEG /LINK TO FPP NEGATE ROUTINE FLOATL, FFLOAT /LINK TO FPP FLOAT ROUTINE GETCHL, GETCH /LINK FOR ASCII CHAR GET ROUTINE EOFSEL, EOFSET /ROUTINE TO SET EOF BIT BSWL, BSWP /LINK FOR BYTE SWAP ROUTINE PACKL, PACKCH /ROUTINE TO PACK ASCII,3 FOR 2 CNOCLL, CNOCLR /ROUTINE TO INITAILIZE CHAR # TO 1 BUFCHL, BUFCHK /CHECK STATUS OF BUFFER POINTER FTYPL, FTYPE /ROUTINE TO DETERMINE FILE TYPE CHRNOL, CHARNO /ROUTINE TO DETERMINE CHARATER NUMBER NEXREL, NEXREC /ROUTINE TO FILL BUFFER WITH NEXT RECORD CRLF, CRLFR /ROUTINE TO PRINT CR,LF VALLK, VALGET /ROUTINE USED BY FINPUT TO FETCH CHARS DURING VAL$ FUNCTION PATCHP, PATCHF /LINK TO FPP SPECIAL MODE PATCH P1SWAP, PSWAP /ROUTINE TO SWAP HI CORE AND PAGE 17600 LDHRST, LRESET /ROUTINE TO RESET LDH TO FIELD 0 STHRST, SRESET /ROUTINE TO RESET STH TO FIELD 0 FSTOP1, FSTOPI /LINK FOR ^C HOOKS IN DRIVERS /******* THE ABOVE LINK MUST BE AT 161 ******* /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 ENTNO, 0 /ENTRY NUMBER NOW IN AREA WORD0, TTYF /HEADER WORD WORD1, TTYF+1 /BUFFER ADDRESS WORD2, TTYF+2 /CURRENT BLOCK IN BUFFER WORD3, TTYF+3 /READ\WRITE POINTER WORD4, TTYF+4 /HANDLER ENTRY POINT WORD5, TTYF+5 /FILE STARTING BLOCK # WORD6, TTYF+6 /ACTUAL FILE LENGTH WORD7, TTYF+7 / DEVICE / (FILE MAXIMUM LENGTH) WORD10, TTYF+10 / NAME / (POSITION OF PRINT HEAD) WORD11, TTYF+11 / WORD12, TTYF+12 / FILE WORD13, TTYF+13 / NAME WORD14, TTYF+14 / /BRTS MAINLINE-THIS IS THE INTERPRETER INSTRUCTION LOOP. IT IS IN THIS /LOOP THAT THE NEXT INSTRUCTION IS FETCHED,DECODED,AND USED AS A DISPATCH /TO THE PROPER EXECUTION ROUTINES FOR THAT INSTRUCTION. *200 /SUBROUTINE PWFECH-RETURNS WITH NEXT WORD FROM PSEUDO-CODE STREAM IN AC PWFECH, JMP I CDFPSU /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 K0010 DCA CDFPSU CDFPSU, START1 /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 /************************************************************ /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 PRINT /CALL TO TTY DRIVER NOP TAD INSAV AND K7400 /STRIP TO OPCODE BITS CLL RTL RTL RAL /OPCODE NOW IN BITS 8-11 TAD KM10 /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 KM10, -10 /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 ILOOPL /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 /*********************************************************** /END OF I-LOOP /*********************************************************** /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 K0377 /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 ///////////////////////////////////////////////////////////// /////////////// STRING ACCUMULATOR ///////////////////////// ///////////////////////////////////////////////////////////// /36 LOCATIONS USED TO HOLD STRING OPERANDS AND RESULTS FOR STRING /OPERATIONS. AT LOAD TIME,IT IS FULL OF ONCE-ONLY STARTUP CODE 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 P1SWAP /RESTORE PAGE 17600 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 MINUS4 /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 P1SWAP /YES-FLUSH PAGE 17600 JMP I .+1 START3 /CONTINUE THE INITIALIZING CODE IN INTERMEDIATE BUFFER L7746, 7746 MINUS4, -4 PINFO, 7607 POVTAB, ARITHA-1 PS1L, P1CDF PS2L, P1CDF1 //////////////////////////////////////////////////////////// //////////////////////////////////////////////////////////// /ROUTINE TO ZERO FAC FACCLR, 0 L7600, 7600 /CLA DCA EXP /ZERO EXPONENT DCA LORD /ZERO LOW MANTISSA DCA HORD /ZERO HIGH MANTISSA JMP I FACCLR /ROUTINE TO RESET CHARACTER NUMBER TO 1 CNOCLR, 0 TAD I WORD0 AND K7477 /SET CHAR BITS TO 0 DCA I WORD0 JMP I CNOCLR /RETURN PAGE /JUMP ON CONDITION FJOCI, TAD INSAV /GET JUMP INSTRUCTION AND K0017 /MASK OFF JUMP CONDITION SNA /IS IT GOSUB? JMP 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 HORD /GET HIGH ORDER FAC . /SKIP INSTRUCTION JMP SUCJMP /CONDITION TRUE-JUMP JFAIL, JMS I PWFECL /CONDITION FALSE-DON'T JUMP,BUT BUMP PC JMP I ILOOPL /DONE GOSUB, TAD I CDFPSL /GET CURRENT PC DATA FIELD JMS I PUSHGL /PUSH ON GOSUB STACK TAD I INTPCL /GET CURRENT PC JMS I PUSHGL /PUSH ON GOSUB STACK /FALLS INTO UNCONDITIONAL JUMP BECAUSE A /GOSUB IS MERELY A PUSH FOLLOWED BY A JUMP SUCJMP, JMS I PWFECL /GET WORD FOLLOWING JUMP INS. DCA I INTPCL /STORE AS NEW PC TAD INSAV /GET JUMP INSTRUCTION AND K0340 /MASK OFF DESTINATION FIELD CLL RTR /SLIDE OVER TAD CDFINL /MAKE A CDF INSTRUCTION DCA I CDFPSL /AND SET NEW PC INSTRUCTION FIELD JMP I ILOOPL /NEXT INSTUCTION K7554, 7554 /*****THIS CONST CAN NOT BE MOVED. THERE /MUST BE A CONSTANT BEFORE THE SKIP TABLE,AND /THER MUST BE A TAD OF THAT CONSTANT ON THIS PAGE /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 PUSHGL, PUSHG JFORL, JFOR INTPCL, INTPC /JUMP ON END OF FILE JEOFI, JMS I FIDLE /SEE IF FILE OPEN TAD I WORD0 /1ST WORD OF I/O TABLE ENTRY CLL RTR /GET EOF BIT IN LINK SNL CLA /EOF? JMP JFAIL /NO-DON'T JUMP JMP SUCJMP /JUMP ////////////////// GOSUB STACK//////////////////////////// GSTCK, 0 /START OF GOSUB STACK 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 GSSTOP, 0 /TOP OF GOSUB STACK /STRING ACCUMULATOR STORE SSTORE, DCA I STHCDF /STORE CDF FOR OPERAND IN STH TAD I STHCDF DCA TEMP24 /AND SSTEX TAD SACPTR CLL IAC /SET AC TO ADDR OF SAC JMS I LDHINL /INITIALIZE LDH TO PULL CHARS FROM SAC JMS I LDHRST /SAC IS IN FIELD 0 TAD STRPTR /POINTER INTO OPERAND CLL IAC /AC POINTS TO OPERAND JMS I STHINL /INITIALIZE STH TO STORE IN OPERAND DCA STRCNT /ZERO COUNT TAD STRLEN /STRING LENGTH SNA /IS IT NULL STRING? JMP SSTEX /YES-WE DON'T HAVE TO STORE ANYTHING-JUST ZERO COUNT DCA TEMP1 /SERVES AS CHARACTER COUNTER SSLOOP, JMS I LDH /GET CHAR FROM SAC JMS I STH /STORE IN OPERAND STRING ISZ STRCNT /BUMP OPERAND COUNT ISZ TEMP1 /SAC ALL MOVED YET? SKP /NO-CHECK IF THERE'S ROOM FOR THE REST JMP SSTEX /YES-DONE TAD STRCNT /# OF CHARS IN STRING SO FAR TAD STRMAX /COMPARE TO MAXIMUM SIZE SMA SZA CLA /MAXIMUM SIZE REACHED YET? SL, JMS I ERROR /YES-STRING TOO LONG OR UNDEFINED JMP SSLOOP /NO-MOVE NEXT CHAR SSTEX, TEMP24, . /DF TO STRING FIELD INIT ABOVE TAD STRCNT /DONE-GET # OF CHARS MOVED CIA /NEGATE (ALL COUNTS ARE NEGATIVE DCA I STRPTR /AND STORE AS COUNT WORD FOR OPERAND STRING JMP I ILOOPL /THAT'S ALL, FOLKS! STHCDF, STHDF /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 WORD1 /GET BUFFER ADDRE FROM I/O TABLE ENTRY DCA DRARG2 /PUT IN DRIVER CALL TAD I WORD2 /GET BLOCK NUMBER FROM I/O TABLE DCA DRARG3 /PUT IN DRIVER CALL TAD I WORD4 /GET DRIVER ENTRY DCA TEMP24 /SAVE JMS I TEMP24 /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 /CALL TO INTERPRETER EXITING ROUTINE FSTOPN, JMS I PRINT /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 /ROUTINE TO RESET LDH FIELD TO 0 LRESET, 0 TAD CDFINL DCA I LDHDCK /CHANGE TO CDF 0 JMP I LRESET LDHDCK, LDHDF /USE FUNCTION-TAKES WORD FOLLOWING CALL AND STUFFS IT IN USECON FOR /USE A BUFFER POINTER FOR USER SUBROUTINE USE, 0 JMS I PWFECL /GET NEXT WORD FROM PSEUDO-CODE STREAM DCA USECON /STORE IN PAGE 0 SLOT JMP I USE /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 TEMP30 /SAVE DIM2+1 TAD S2 /GET SUBSCRIPT 2 CLL CMA /SAVE 12 BIT COMPARE TAD TEMP30 SNL CLA /S2 BIGGER THAN DIM2? JMP SU /YES TAD S2 /MULTIPLY DIM1+1 BY S2 JMS I MPYLNK /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 K0340 /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 ILOOPL /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 K0340 /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 FIDLE /CHECK IF FILE OPEN TAD I WORD3 /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 WORD0 /HEADER WORD AND K7737 /TURN OFF BLOCK WRITTEN BIT TAD K40 /TURN IT ON AGAIN DCA I WORD0 JMP I BCPUT /RETURN K40, 40 K7737, 7737 /ROUTINE TO SET STH DF TO 0 TEMP30, SRESET, 0 TAD CDF0 DCA I STHDKK JMP I SRESET STHDKK, STHDF 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, 50 /# OF AVAILABLE SLOTS IN BUFFER (40 INITIALLY) CHRSAV=TEMP1 MBEND, -BEND /-ADDR OF END OF RING BUFFER MCTRLC, -203 M50, -50 XPRINT, 0 KSF /IS KEYBOARD FLAG UP? JMP NOCC /NO-NO CHANCE FOR A CTRL/C TAD K0200 /FORCE PARAITY BIT KRS /YES-GET THE CHAR IN KEYBOARD BUFFER TAD MCTRLC /IS IT CTRL/C SNA CLA JMP I FSTOP1 /YES-ABORT TO EDITOR NOCC, 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! /****************************************************************: TLS /TYPE IT CLA CLL 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, 0 /START OF BUFFER 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 /40 CHARACTERS LONG 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 BEND, 0 /END OF TTY BUFFER /LINE NUMBERS LINEI, TAD INSAV /GET INSTRUCTION DCA LINEHI /SAVE JMS I PWFECL /GET WORD FOLLOWING LINE # INST DCA LINELO /SAVE AS LOW ORDER LINE # TRHOOK, JMP I ILOOPL /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 TELETYPE BUFFER /////////////////// /////////////////////////////////////////////////////////// /USED TO BUFFER OUTPUT FROM FPP BEFORE WE PUT IT /IN BASIC FORMAT FOR TRANSPORTATION TO THE TTY RING /BUFFER.FILLED WITH INITIALIZATION CODE WHEN ENTERED KC240, 240 /STOPPER TO MARK BEGINNING OF BUFFER INTERB, START3, TAD CDFPS /CDF FOR PSEUDO-CODE DCA I CDFPSL /PUT IN-LINE TO ILOOP TAD PSSTRT /START OF PSEUDO-CODE DCA I INTPCK /PUT INTO PC JMS I FCLR /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 DLPTR /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 /OPERATE CLASS INSTRUCTIONS OPERI, TAD INSAV /GET OPERATE INSTRUCTION AND K0017 /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 / /FLOATING NEGATE FNEGI, JMS I FNEGL /CALL NEGATE ROUTINE JMP I ILOOPL /RETURN TO ILOOP /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 RESIDENT STATUS FLAG SMA CLA /WHICH HI-CORE PAGE IS IT IN? TAD K200 /7600 TAD K7400 /7400 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 /SUBROUTINE ASCOUT /ROUTINE CALLED BY WRITE WITH THE NUMBER TO BE WRITTEN IN FAC. /CALLS THE FPP TO OUTPUT THE DIGITS TO AN INTERMEDIATE BUFFER,THEN /MASSAGES THAT BUFFER TO PUT OUTPUT IN BASIC FORMAT. ASCOUT, 0 JMS I FACSAL /SAVE THE FAC TAD HORD /GET HI MANTISSA SNA CLA /IS NUMBER 0? JMP FFORMT /YES-USE F FORMAT JMS I ABSVLL /ABS(X) JMS I FSUBLK /ABS(X)-999999 A999 TAD HORD /GET HI MANTISSA OF RESULT SMA SZA CLA /IS ABS(X)>999999? JMP E20P10 /YES-USE E FORMAT FOR OUTPUT JMS I FACREL /GET X AGAIN JMS I ABSVLL /ABS(X) JMS I FSUBLK /ABS(X)-.000001 AP0001 TAD HORD SPA CLA /IS ABS(X)>.000001? JMP E20P10 /NO-USE E FORMAT FFORMT, TAD K0010 DCA DADP /8 PLACES AFTER DEC PT TAD MSPACE DCA FLDW /16 COLUMNS IN FIELD WIDTH IAC /SET FLAG FOR F FORMAT E20P10, DCA EFLG /SET FORMAT FLAG JMS I FACREL /GET X BACK IN FAC TAD INTRB /ADDR OF INTERMEDIATE BUFFER-1 DCA XR3 /XR3 POINTS TO INTERMEDIATE BUFFER JMS I FFOUTL /USE FPP TO PUT ASCII NUMBER IN INTERMEDIATE BUFFER CLA CMA /-1 IN AC TAD XR3 /ADDR OF LF IN INTER BUFFER-1 DCA TEMP10 /TEMP10 POINTS TO CR IN BUFFER DCA TEMP2 /CLEAR CHARACTER COUNT DCA TEMP3 /CLEAR ZERO REPLACE FLAG DCA TEMP4 /CLEAR DECIMAL POINT SEEN FLAG CFETCH, CLA CMA /-1 IN AC TAD TEMP10 DCA TEMP10 /BACK UP POINTER TO NEXT CHAR TAD I TEMP10 /GET CHAR FROM BUFFER TAD M260 /-"0" SNA /IS IT "0"? JMP ZR /YES-REPLACE WITH CR IF ZERO FLAG NOT SET /OR ALTMODE IF IN E FORMAT AND DECPT HAS BEEN SEEN. TAD MSPACE /IS IT " "? SNA JMP I ASCOUT /YES-DONE-PREPARE THE NUMBER FOR TYPING ZROFF, ISZ TEMP2 /NO-BUMP CHAR COUNT TAD MDECPT /IS IT "."? SNA CLA JMP COUNCK /YES-IF COUNT=0,REPLACE WITH CR ISZ TEMP3 /NO-TURN OF ZERO REPLACE JMP CFETCH /NEXT ZR, TAD EFLG /YES-GET FORMAT FLAG SZA CLA /ARE WE IN E FORMAT? JMP ZRCONT /NO-PROCEED TO CHECK ZERO REPLACE FLAG TAD TEMP4 SNA CLA /HAS DECIMAL POINT BEEN SEEN YET? JMP ZROFF /NO-THIS ZERO STAYS,SO COUNT IT TAD K0377 /YES-THIS IS THE ZERO BEFORE THE POINT JMP CRREP+1 /SO REPLACE IT WITH AN ALTMODE ZRCONT, TAD TEMP4 /HAS A PERIOD BEEN SEEN YET? SZA CLA JMP ZROFF /YES-THIS ZERO STAYS TAD TEMP3 /GET ZERO REPLACE FLAG SZA CLA /IS IT ON? JMP ZROFF /YES-DON'T REPLACE ZEROES CRREP, TAD K215 /NO-REPLACE THIS ZERO WITH A CR DCA I TEMP10 /YES-REPLACE 0 WITH CR JMP CFETCH /NEXT CHAR COUNCK, ISZ TEMP4 /SET DECIMAL POINT SEEN FLAG CLA CMA /-1 IN AC TAD TEMP2 /GET CHAR COUNT SZA CLA /IS IT 1 (. WAS FIRST COUNTED CHAR)? JMP CFETCH /NO-DON'T REPLACE . WITH CR JMP CRREP /YES-REPLACE . WITH CR FSUBLK, FFSUB INTRB, INTERB-1 FFOUTL, FFOUT M260, -260 MDECPT, -16 ABSVLL, ABSVAL PAGE /LOAD SUBSCRIPT 1 LS1I, JMS I FACSAL /PRESERVE FAC JMS I ARGPRL /GET ARG POINTER INTO AC JMS I FGETL /LOAD ARG INTO FAC (SKIPS NEXT INST ON RETURN) LSUB1I, JMS I FACSAL /SAVE THE FAC JMS I INTL /GET INT(FAC) DCA S1 /SET RESULT AS SUBSCRIPT 1 JMS I FACREL /RESTORE FAC JMP I ILOOPL /NEXT INSTRCUTION /LOAD SUBSCRIPT 2 LS2I, JMS I FACSAL /PRESERVE FAC JMS I ARGPRL /GET ARG POINTER INTO AC JMS I FGETL /LOAD ARG INTO FAC (SKIPS NEXT INST ON RETURN) LSUB2I, JMS I FACSAL /SAVE THE FAC JMS I INTL /GET INT(FAC) DCA S2 /SET RESULT AS SUBSCRIPT 2 JMS I FACREL /RESTORE THE FAC JMP I ILOOPL /BACK TO ILOOP ARGPRL, ARGPRE /JMP DISPATCH FOR FUNC1 CALLS JMSI4, JMS I .+1 /CALL FOR CANNED FUNCTION SET 1 /JUMP TABLE FOR FUNCTION CALL 1 FFATN /FUNCTION BITS= 0 FFCOS / 1 FFEXP / 2 EXPON / 3 INT / 4 FFLOG / 5 SGN / 6 FFSIN / 7 RND / 10 FROOT / /11 /JUMP FOR FUNC2 DISPATCH JMSI5, JMS I .+1 /JMS 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 /ROUTINE TO CALL ERROR ROUTINE BY FAKING A FUNC2 CALL TO FUNCTION #10 ERRDIS, 0 CLA CLL /FLUSH TAD L7607 DCA INSAV /FAKE A FUNC CALL TO FUNC2 #10 JMP FUNC2I /ERROR CALL FOR USER FUNCTIONS-USER FUNCTION SHOULD "JMS I IAL" IA, JMS ERRDIS /FUNCTION OVERLAY DRIVER FUNC4I, JMS I PRINT /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 TEMP1 /FUNCTION # TAD JMSTAD /BUILD A TAD OF THE PROPER DISPATCH JMS DCA .+2 /PUT IN LINE JMS I FBITS /GET # OF FUNCTION DESIRED . /BUILD JUMP OFF JUMP TABLE FUJUMP, DCA .+1 /PUT JUMP IN LINE . /GO TO DESIRED FUNCTION JMP I ILOOPL /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 FBITS /ISOLATE FUNCTION # TAD JMSI7 /MAKE A JUMP OFF JUMP TABLE JMP FUJUMP /PUT THE JUMP IN LINE AND EXECUTE IT JMSI7, JMS I .+1 /JUMP TABLE FOR RESIDENT FUNCTIONS ABSVAL /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 FBITS /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 LORD /LOW MANTISSA CLL RAL /HI BIT OF LO MANTISSA TO LINK CLA TAD HORD /HIGH MANTISSA SPA /IS NUMBER POSITIVE? FM, JMS I ERROR /NO-BOO!!! RAL /SHIFT THE SIGN BIT OUT AND THE MANTISSA OVER, DCA HORD /MAKING 12 BITS OF MANTISSA AND BINARY POINT BEFORE BIT 0 TAD EXP /GET EXPONENT SPA SNA CLA /IS X>1? JMP I UNSFIX /NO-FIX IT TO 0 TAD EXP /YES-GET EXPONENT TAD M14 /SET BINARY POINT AT 12 SNA /DONE ALREADY? JMP UNSOUT /YES SMA /NO-IS # TOO BIG? FO, JMS I ERROR /YES DCA EXP /NO-STORE COUNT TAD HORD /HI MANTISSA UNSLP, CLL RAR /SCALE RIGHT ISZ EXP /DONE? JMP UNSLP /NO JMP I UNSFIX /YES-RETURN UNSOUT, TAD HORD /ANSWER IN AC JMP I UNSFIX /RESTORE RESTI, 0 JMS I WRBLKL /NO-WRITE CURRENT BUFFER CLA CMA /-1 TAD I WORD5 /STARTING BLOCK-1 DCA I WORD2 /SET CURRENT BLOCK # TAD I WORD1 /GET BUFFER ADDRESS DCA I WORD3 /USE IT TO RESET READ\WRITE POINTER TAD I WORD0 /GET HEADER WORD AND K7435 /CLEAR EOF BIT,BUFFER WRITTEN BIT,AND CHAR # DCA I WORD0 JMS I NEXREL /READ FIRST BLOCK INTO BUFFER JMP I RESTI /DONE WRBLKL, WRBLK K7435, 7435 /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 K0377 /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 TEMP11 /SAVE TAD I XR2 /GET MAX LENGTH OF STRING DCA STRMAX /SAVE SNL /ARRAY ELEMENT? JMP SCDF /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 SUBERL /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 MPYLNK /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 TEMP11 /ADD TO CDF IF NECESSARY DCA TEMP11 /SAVE AGAIN SCDF, TAD TEMP11 /GET DF OF STRING DCA .+1 /PUT IN LINE . /DF TO STRING FIELD TAD I STRPTR /GET STRING LENGTH DCA STRCNT /ACTUAL LENGTH OF STRING OPERAND TAD TEMP11 /CDF TO OPERAND IN AC CDF JMP I STFIND /RETURN SAFIND, TAD INSAV /GET INST AND K0037L /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 K0037L, 0037 SUBERL, SU /TAB FUNCTION TAB, 0 JMS I INTL /FIX X TO INTEGER CIA /NEGATE TAD I WORD10 /COMPARE DESIRED COLUMN TO REAL COLUMN IAC /BUMP BY 1 (WORD 7=COL #-1) SMA /IS X>=CURRENT COLUMN? JMP I ILOOPL /YES-THEN DO NOTHING JMP I SLOVEL /NO-AC CONTAINS # OF SPACES NEEDED TO REACH DESIRED COLUMN SLOVEL, SLOVER /PNT FUNCTION /VALUE OF X SENT TO TTY PNT, 0 JMS I INTL /FIX X AND K0177 /STRIP TO 7 ASCII BITS TAD K0200 /FORCE CHANNEL 8 JMS I PUTCHL /PUT IN FILE BUFFER JMP I ILOOPL /DONE K0177, 177 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 INTL /FIX FAC TO GET FILE # CSFN, DCA EXP /IF ENTRY IS HERE,FILE #=0 (TTY) TAD EXP /GET NUMBER AGAIN TAD KM4 /IS RESULT A LEGAL FILE #? SMA SZA CLA FN, JMS I ERROR /NO-ERROR TAD EXP /YES-GET FILE # DCA ENTNO /SAVE AS CURRENT FILE # TAD EXP TAD IOTPTR /USE AS INDEX INTO TABLE OF MASTER POINTERS DCA TEMP2 /POINTS TO FIRST WORD OF EACH I/O TABLE ENTRY TAD I TEMP2 /GET POINTER TO FIRST WORD OF I/O TABLE ENTRY WE WANT DCA WORD0 /PUT IN WORK AREA TAD M14 /WE HAVE TO CHANGE 12 POINTERS DCA TEMP2 TAD WORD0A /POINTER TO LAST ENTRY MADE DCA XR1 TAD WORD1A /POINTER TO NEXT ENTRY TO BE BUILT DCA XR2 SFNLP, TAD I XR1 /EACH ENTRY IS BUILT IAC /BY ADDING 1 TO THE PREVIOUS ENTRY DCA I XR2 ISZ TEMP2 /DONE? JMP SFNLP /NO JMP I ILOOPL /YES-NEW TABLE IS NOW BUILT KM4, -4 WORD0A, WORD0-1 WORD1A, WORD1-1 IOTPTR, IOTAB IOTAB, TTYF /POINTERS TO THE FIRST WORD IN EACH OF THE FIVE FILE1 /I/O TABLE ENTRIES FILE2 FILE3 FILE4 /FOR-LOOP JUMP ROUTINE JFOR, CLA CLL TAD HORD /GET HIGH MANTISSA SNA /IS FAC=0? JMP I JFAILL /YES-DO NOT JUMP TAD FSWITC /ADD FSWITCH SPA CLA /ARE SIGN BIT=FSWITCH? JMP I JFAILL /NO-DO NOT JUMP JMP I SUCJML /YES-DO JUMP SUCJML, SUCJMP JFAILL, JFAIL /ROUTINE TO INITIALIZE FSWITCH SETF, CLL CML RAR /4000 IN AC AND HORD /ISOLATE SIGN OF MANTISSA DCA FSWITC /STORE IN FSWITCH JMP I ILOOPL /DONE FSWITC, 0 /STRING COMPARE SCOMP, DCA OCDF /DF TO OPERNAD IN LINE DCA MODESW /RETURN IN AMODE JMS I FCLR /INITIALIZE FAC TO 0 TAD STRLEN /LENGTH OF STRING IN SAC TAD STRCNT /LENGTH OF OPERAND SNA CLA /ARE THEY BOTH ZERO? JMP I ILOOPL /YES-THEY ARE EQUAL,SO RETURN WITH FAC=0 CLL TAD STRLEN /NO-LENGTH OF SAC SNA CLA /IS IT ZERO? JMP SNEQ-1 /YES-THEN THEY ARE NOT EQUAL TAD STRCNT /LENGTH OF OPERAND SNA CLA /IS IT EMPTY JMP SNEQ /YES-THEY ARE NOT EQUAL TAD SACPTR /POINTER INTO SAC CLL IAC JMS I LDHINL /INIT LDH JMS I LDHRST /TO LOAD FROM SAC JMS PTRBMP /ISZ STRPTR OVER COUNT WORD DCA SWITCC /INIT LDHPST LDHC, JMS LDHPST /HALF LOAD DCA TEMP2 /AND SAVE JMS I LDH /GET CHAR FROM SAC CIA CLL /NEGATE IT TAD TEMP2 /AND COMPARE TO OPERAND CHARACTER SZA CLA /ARE THEY EQUAL? JMP SNEQ /NO-RETURN WITH FAC SIGN SET APPROPRIATELY ISZ STRCNT /MORE OPERAND CHARS? JMP SACCHK /YES-SEE IF SAC EMPTY SAC40C, ISZ STRLEN /MORE CHARS IN SAC? SKP /YES JMP I ILOOPL /STRINGS ARE EQUAL-RETURN WITH 0 FAC JMS I LDH /GET CHAR FROM SAC CLL TAD KM40 /COMPARE TO SPACE SNA CLA /IS IT A SPACE? JMP SAC40C /YES-CHECK NEXT CHAR SNEQ1, CML SNEQ, CLA CMA RAR DCA HORD /SET SIGN BIT OF MANTISSA TO REFLECT RESULTS OF COMPARE JMP I ILOOPL SACCHK, ISZ STRLEN /SAC EMPTY? JMP LDHC /NO-COMPARE NEXT TWO CHARS STC40C, JMS LDHPST /YES-GET CHAR FROM OPERAND TAD KM40 /COMPARE TO SPACE SZA CLA /IS IT A SPACE? JMP SNEQ1 /NO-STRINGS AREN'T EQUAL ISZ STRCNT /YES-MORE CHARS? JMP STC40C /YES-CHECK THEM JMP I ILOOPL /NO-STRINGS ARE EQUAL-RETURN WITH FAC=0 /ROUTINE TO GRAB 1 CHAR AT A TIME FROM OPERAND STRING LDHPST, 0 TAD SWITCC /GET HALF SWITCH CLL RAR /PUT IN LINK OCDF, . /DF TO OPERAND TAD I STRPTR /GET TWO CHARS FROM STRING CDF SNL /RIGHT HALF? JMS I BSWL /NO-SWAP BYTES AND K0077 /ISOLATE RIGHT CHAR DCA TEMP2 /SAVE TAD SWITCC CLL RAR /HALFWORD SITCH TO LINK SZL /RIGHT HALF? JMS PTRBMP /BUMP STRING POINTER SNL CLA /FLIP HALFWORD SWITCH CLL CML IAC /(LEAVE LINK=1) DCA SWITCC TAD TEMP2 /GET CHAR AGAIN JMP I LDHPST SWITCC=TEMP3 /SUBROUTINE TO BUMP STRPTR AND WATCH FOR FIELD OVERLAP PTRBMP, 0 ISZ STRPTR JMP I PTRBMP /NO-SKIP;RETURN TAD OCDF /SKIP MEANS WE MUST INCREMENT FIELD TAD K0010 DCA OCDF JMP I PTRBMP /FLOATING POINT CONSTANT USED BY ASCOUT AP0001, 7755 /.000001 2061 5734 PAGE /STRING CONCATENATE SCON1, DCA I LDHCDF /DF FOR LDH TAD STRCNT /OPERAND=0? SNA CLA JMP I ILOOPL /YES-THEN THERE IS NOTHING TO DO TAD STRPTR /ADDR OF OPERAND CLL IAC /ADDR OF OPERAND 1ST CHARACTER JMS I LDHINL /INITIALIZE LDH TO PULL FROM OPERAND TAD STRLEN /# OF CHARS IN AC SNA /SAC EMPTY? JMP SACEM /YES-CONCATE ESSENTIALLY IS A LOAD CLL CML RAR /DIVIDE BY TWO SZA CIA /POSITIVE WORD COUNT SNL SACEM, IAC TAD SACPTR /USE AS DISPLACEMENT OFF START OF SAC JMS I STHINL /INITIALZE STH TO SAC+STRLEN/2 JMS I STHRST /SAC IS IN FLD 0 SEGCOM, JMS I LDH /GET CHAR FROM OPERAND JMS I STH /PUT CHAR IN SAC CLA CMA /-1 TAD STRLEN /"BUMP" STRING COUNT FOR SAC DCA STRLEN TAD STRLEN TAD K110 /IS SAC FULL YET? SPA CLA SC, JMS I ERROR /YES-TRUNCATION ERROR ISZ STRCNT /NO-MORE CHARS LEFT IN OPERAND? JMP SEGCOM /YES-GO GETTEM JMP I ILOOPL /NO-DONE K110, 110 LDHCDF, LDHDF /ROUTINE TO SIMULATE HARDWARE BYTE SWAP BSWP, 0 CLL RTR RTR RTR /LEFT HALF NOW IN RIGHT HALF DCA TEMP12 /SAVE TAD TEMP12 AND K0077 /ISOLATE LEFT HALF TAD TEMP12 /DO A PARTIAL SHIFT OF BITS 6-11 LEFT ONE RAR /MOVE INTO POSITION JMP I BSWP /ROUTINE TO SET EOF BIT IN I/O ENTRY EOFSET, TAD I WORD0 /HEADER CLL RTR /EOF BIT TO LINK CLL CML /SET LINK RTL /PUT LINK IN EOF BIT DCA I WORD0 /STORE IN I/O TABLE ENTRY JMP I ILOOPL /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 M14 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 /--------------------------------------------------------------- TEMP13=MPY /ROUTINE TO CHECK IF FILE IDLE IDLE, 0 TAD I WORD4 /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 TEMP12, DLREAD, 0 TAD DLPTR /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 DLPTR /FETCH WORD FROM DATA LIST CDF JMP I DLREAD /DONE /ROUTINES TO SWITCH INTERPRETER MODE SSMODE, IAC /SET SWITCH TO SMODE AMODE, DCA MODESW /SET SWITCH TO A MODE JMP I ILOOPL /DONE /SUBROUTINE PUSHG /ROUTINE TO PUSH AC ON TOP OF GOSUB STACK PUSHG, 0 DCA TEMP1 /SAVE ELEMENT TO BE PUSHED ISZ GSP /BUMP GOSUB STACK POINTER TAD GSP /GET STACK POINTER CIA /NEGATE TAD GSTCKT /ADD ADR OF TOP OF STACK SPA CLA /STACK OVERFLOW? GS, JMS I ERROR /YES-TOO MANY NESTED GOSUBS TAD TEMP1 /NO-GET ELEMENT TO BE STACKED DCA I GSP /STACK IT JMP I PUSHG /RETURN GSTCKT, GSSTOP /ADDR OF TOP OF STACK /ROUTINE TO RANDOMIZE RND(X) FRANDM, TAD SPINNR /USE SPINNR FOR NEW SEED FOR RND(X) CLL CML RAL /MAKE SURE SEED IS ODD DCA RSEED JMP I ILOOPL /DONE RSEED, 2713 /SUBROUTINE CR,LF CRLFR, 0 TAD K215 JMS I PUTCHL TAD K212L JMS I PUTCHL /PRINT A CR,AND LF DCA I WORD10 /ZERO COLUMN POINTER JMP I CRLFR K212L, 212 /SUBROUTINE FOTYPE /RETURNS TO CALL+1 IF FILE FIXED LENGTH,CALL+2 IF VARIABLE FOTYPE, 0 TAD I WORD0 /GET HEADER AND K0004 /ISOLATE TYPE BIT SZA CLA /IS IT FIXED LENGTH? ISZ FOTYPE /NO-BUMP RETURN JMP I FOTYPE /RETURN K0004, 4 /SUBROUTINE TO REPLACE FAC WITH ABS(FAC) ABSVAL, 0 TAD HORD SPA CLA /IS FAC<0? JMS I FNEGL /YES-NEGATE IT JMP I ABSVAL /RETURN /ROUTINE TO RESTORE THE FAC FROM FP TEMP FACRES, 0 JMS I FGETL /GET FAC INTERB JMP I FACRES /RETURN PAGE /STRING DATA LIST READ SRLIST, JMS I DLREAL /READ COUNT FROM DATA LIST DCA STRLEN /SAVE AS NEW COUNT FOR FAC TAD STRLEN /COUNT FOR SAC STRING SNA /NULL STRING? JMP I ILOOPL /YES-NO OPERATION TO PERFORM CLL CML RAR /AND DIVIDE BY TWO FOR WORD COUNT DCA STRCNT /SAVE AS MOVE COUNTER TAD SACPTR DCA XR2 /POINTS INTO SAC SRLOOP, JMS I DLREAL /READ 2 CHARS FROM DATA LIST DCA I XR2 /AND PUT THEM IN SAC ISZ STRCNT /BUMP STRING COUNT JMP SRLOOP /NEXT 2 JMP I ILOOPL /DONE DLREAL, DLREAD /STRING READ ROUTINE SREAD, DCA I STHCDL /DF FOR STH DCA STRCNT /0 STRING COUNT CLL IAC /LEAVE FIELD AS IS TAD STRPTR /ADDR OF OPERAND JMS I STHINL /INIT STORE HALF TO STORE IN OPERAND FTCOM, JMS I GETCHL /GET CHAR FROM FILE OR TTY TAD CHAR TAD M215 /IS IT CR? SNA JMP SRFIN /YES-STRING IS FINISHED TAD MLF /IS IT LF? SNA CLA JMP FTCOM /YES-IGNORE IT TAD STRCNT /NO-GET LENGTH OF STRING SO FAR TAD STRMAX /COMPARE AGAINST UPPER LIMIT OF DESTINATION SMA CLA /ANY MORE ROOM? JMP ST /NO-TRUNATION ERROR TAD CHAR /YES JMS I STH /STORE CHAR IN STRING ISZ STRCNT /BUMP COUNT JMP FTCOM /GET NEXT CHAR ST, JMS I ERROR /YES-TRUNCATION ERROR TAD K215 /SET CHAR TO 215 DCA CHAR /SO TTY BUFFER CLEARED BEFORE NEXT INPUT SRFIN, TAD I STHCDL /GET DF OF STRING DCA .+1 /PUT IN LINE TEMP19, . /DF TO THAT OF STRING TAD STRCNT /STRING DONE-GET LENGTH CIA /NEGATE DCA I STRPTR /STORE AS COUNT FOR STRING JMP I ILOOPL /DONE MLF, 3 STHCDL, STHDF /STRING WRITE ROUTINE SWRITE, DCA COMMAS /CLEAR COMMA SWITCH TAD STRLEN /# OF CHARS IN STRING SNA /NULL STRING? JMP I ILOOPL /YES-NOTHING TO WRITE CIA /MAKE A POSITIVE NUMBER TAD I WORD10 /ADD TO COLUMN NUMBER TAD MM110 /COMPARE AGAINST END OF LINE SMA SZA CLA /WILL STRING FIT ON LINE? JMS I CRLF /NO-ISSUE A CRLF FIRST TAD SACPTR CLL IAC /AC POINTS TO LEFT SAC CHAR 1 JMS I LDHINL /INITIALIZE LOAD HALF ROUTINE JMS I LDHRST /LOAD FROM SAC IN FLD 0 TAD STRLEN /# OF CHARS DCA STRCNT /USE AS COUNTER SWCLP, JMS I LDH /LOAD HALF CHAR FROM STRING DCA TEMP1 /SAVE TAD TEMP1 TAD KM40 /SUBTRACT 40 SPA CLA /IS CHAR <40? TAD K0100 /NO-MAKE IT 300 SERIES TAD K0200 /MAKE IT 200 SERIES TAD TEMP1 JMS I PUTCHL /PUT CHAR IN FILE OR ON TTY ISZ STRCNT /DONE? JMP SWCLP /NO-NEXT CHAR JMP I ILOOPL /YES MM110, -110 /FLOATING POINT CONSTANT USED BY ASCOUT FOR FORMAT CONVERSION A999, 24 /999999 3641 0770 /COMMA FUNCTION (KNOWN ONLY TO COMPILER FOR FORMATTING PRINT /STATEMENTS) COMMA, 0 JMS I FTYPL /IS FILE NUMERIC? JMP I ILOOPL /YES-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 C240 /YES-PRINT A SPACE BEFORE DOING COMMA CALCULATION JMS I PUTCHL IAC DCA COMMAS /SET COMMA SWITCH TAD M4 DCA TEMP2 /ONLY 4 COLUMNS TO CHECK TAD POSPTA DCA XR4 /POINTS TO POSITION #'S OF COLUMNS COMLOP, TAD I WORD10 /GET CURRENT PRINT HEAD POSITION TAD I XR4 /COMPARE AGAINST COLUMN MARKER SPA /PAST THIS ONE? JMP SLOVER /YES-SLIDE PRINT HEAD TO START OF NEXT SNA CLA /EXACTLY ON A COLUMN? JMP I ILOOPL /YES-DONE ISZ TEMP2 /ALL MARKERS CHECKED YET? JMP COMLOP /NO-DO NEXT JMS I CRLF /YES-NEXT COLUMN IS 0 JMP I ILOOPL /DONE SLOVER, DCA TEMP19 /-# OF COLUMNS TO NEXT MARKER JMS I FTYPL /IS FILE NUMERIC? JMP I ILOOPL /YES-THIS IS A NOP TAD C240 /GET SPACE JMS I PUTCHL /PRINT IT ISZ TEMP19 /THERE YET? JMP SLOVER+1 /NO-TYPE ANOTHER SPACE JMP I ILOOPL /YES-DONE COMMAS, 1 /SET TO 1 IF LAST PRINT WAS A COMMA MOVE POSPTA, POSTP-1 POSTP, -16 /COLUMN MARKERS -34 /MINUS TTY COLUMN NUMBER THAT MARKS BEGINNING -52 /OF ONE OF THE BASIC COLUMNS -70 C240, 240 M4, -4 /RESTORE FOR IN-CORE DATA LIST RESDLS, TAD DLSTRT /ADDRESS OF START OF INCORE DATA LIST DCA DLPTR /USE IT TO RESET DATA LIST POINTER JMP I ILOOPL /THATS ALL! /RESTORE ROUTINE RESTOR, TAD ENTNO /GET CURRENT FILE # SNA CLA /IS IT 0? JMP RESDLS /YES-RESTORE DATA LIST JMS I RESTIL /NO-RESTORE A FILE JMP I ILOOPL /DONE RESTIL, RESTI PAGE /SUBROUTINE STH-SIMULATES AN AUTO-INDEXING STORE HALF INSTRUCTION. /STORES THE RIGHT HALF OF THE AC IN THE HALFWORD FOLLOWING THE /LAST HALFWORD STORED. TO CHANGE THE STORAGE ADDRESS,CALL STHINI STHL, 0 AND K0077 /STRIP TO 6 BITS DCA TEMP11 /SAVE STHDF, . /DF TO STORE FIELD TAD STHSWT /GET SWITCH FOR HALF TO STORE IN SZA CLA /WHICH HALF? JMP RIGHTS /STORE IN RIGHT HALF TAD TEMP11 /STORE IN LEFT HALF JMS I BSWL /SWAP BYTES DCA TEMP11 /SAVE AGAIN TAD I STHR /GET CURRENT VALUES AND K0077 /PRESERVE RIGHT HALF SLRCOM, TAD TEMP11 /COMBINE WITH NEW LEFT HALF DCA I STHR /AND STORE IT TAD STHSWT /GET HALF SWITCH SNA CLA /WAS THIS RIGHT HALF? JMP JSL /NO-JUST FLIP SWITCH ISZ STHR /BUMP POINTER JMP JSL+1 /POINTER IS BUMPED-SET HALFSWITCH TO LEFT TAD STHDF /SKIP MEANS WE HAVE TO BUMP STH CDF TAD K0010 DCA STHDF SKP /SET HALF SWITCH TO 0 JSL, CMA /FLIP HALF SWITCH DCA STHSWT CDF JMP I STHL /DONE RIGHTS, TAD I STHR /GET LEFT HALF AND K7700 /CLEAR ANY GARBAGE THAT MIGHT BE IN RIGHT HALF JMP SLRCOM /FLIP SWITCH AND RETURN /SUNROUTINE STHINI-USED TO SET THE HALFWORD ADDRESS STORED INTO BY STH. /ON CALL,WORD ADDR IS IN AC,LINK SET TO 0 FOR LEFT HALF,1 FOR RIGHT HALF. STHINI, 0 DCA STHR /STORE ADDRESS SZL CLA /WHICH HALF TO START CMA /RIGHT-SET STHSWT DCA STHSWT /LEFT-CLEAR STHSWT JMP I STHINI /DONE STHSWT, 0 /STORE HALFWORD SWITCH STHR, 0 /HALFWORD POINTER FOR STH /SUBROUTINE LDH-SIMULATES AN AUTO-INDEXING LOAD HALF INSTRUCTION. WHEN /CALLED,IT LOADS THE NEXT HALFWORD INTO AC. TO CHANGE ADDRESS FROM /WHICH IT LOADS,CALL LDHINI. DF MUST BE SET TO DF OF SOURCE ON CALL. LDHL, 0 LDHDF, . /DF FROM WHICH TO GET WORDS TAD LDHSWT /WHICH HALF TO LOAD? SZA CLA JMP RIGHTL /RIGHT HALF TAD I LDHR /LEFT HALF-GET BOTH JMS I BSWL /SWAP BYTES LRSCOM, AND K0077 /ISOLATE CHAR DCA TEMP11 /SAVE TAD LDHSWT CMA /FLIP LDHSWT DCA LDHSWT TAD TEMP11 CDF JMP I LDHL /RETURN RIGHTL, TAD I LDHR /GET WORD ISZ LDHR /BUMP POINTER TO NEXT WORD JMP LRSCOM /NO SKIP SO JUST CONTINUE DCA TEMP21 /SKIP MEANS WE HAVE TO BUMP LDH DF TAD LDHDF TAD K0010 DCA LDHDF TAD TEMP21 /GET WORD AGAIN JMP LRSCOM /FLIP SWITCH AND RETURN /SUBROUTINE LDHINI-USED TO SET HALFWORD ADDRESS LDH DRAWS FROM. ON CALL, /AC=FULL WORD ADDRESS,AND LINK=0 FOR LEFT HALF,1 FOR RIGHT. LDHINI, 0 DCA LDHR /SAVE LDH POINTER SZL CLA /WHICH HALF? CMA /RIGHT-LDHSWT=7777 DCA LDHSWT /LEFT-LDHSWT=0 JMP I LDHINI LDHSWT, 0 /LOAD HALFWORD SWITCH LDHR, 0 /HALFWORD POINTER FOR LDH TEMP21=STHINI /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 MK61 /YES-CHECK FOR A BUFFER 60 WORDS LONG TAD K0400 /NO-CHECK FOR A BUFFER 400 WORDS LONG TAD I WORD1 /ADD LENGTH TO BUFFER ADDRESS CIA /-ADDR OF END OF BUFFER TAD I WORD3 /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 MK61, 7461 EBC, JMS I CHRNOL /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 CHRNOL /DETERMINE CHARACTER NUMBER SKP /1 JMP CHAR3P /3 TAD TEMP1 /1 OR 2-GET CHAR AGAIN JMS I WRITFW /STORE IN BUFFER JMS I CNOBMK /BUMP CHARACTER NUMBER JMP I PACKCH /DONE CHAR3P, CLA CLL CMA RAL /-2 IN AC TAD I WORD3 /BACK BUFFER POINTER UP TO POINT TO CHAR 1 DCA I WORD3 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 CNOCLL /CLEAR THE CHARACTER NUMBER (RESET IT TO 1) JMP I PACKCH /DONE CNOBMK, CNOBML COMBNE, 0 AND K7400 /ISOLATE HALF IN QUESTION DCA TEMP2 /SAVE JMS I BCGETL /GET A WORD FROM FILE BUFFER IN FIELD 1 AND K0377 /FLUSH ANY SLUSH IN BITS 0-3 TAD TEMP2 /COMBINE JMS I WRITFW /PUT IN BUFFER JMP I COMBNE /RETURN BCGETL, BCGET PAGE /ROUTINE TO READ WORD FROM FILE BUFFER AND BUMP POINTER READFL, 0 JMS I FTYL /IS FILE VARIABLE LENGTH SKP VR, JMS I ERROR /YES-IT IS AN ERROR TO TRY AND READ IT TAD I WORD0 /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 ILOOPL /NOT FATAL-RETURN TO I LOOP JMS BCGET /GET WORD FROM FILE BUFFER ISZ I WORD3 /BUMP POINTER JMP I READFL /DONE FTYL, FOTYPE /ROUTINE TO WRITE AC IN FILE BUFFER AND INCREMENT POINTER WRITFL, 0 JMS I BCPUTL /STORE AC IN FILE BUFFER ISZ I WORD3 /BUMP POINTER TAD I WORD0 /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 ILOOPL /NON-FATAL RETURN TO ILOOP BCPUTL, BCPUT /ROUTINE TO GET ONE WORD FROM FILE BUFFER IN FIELD 1 BCGET, 0 JMS I FIDLE /CHECK IF FILE OPEN TAD I WORD3 /GET READ WRITE POINTER DCA TEMP17 /SAVE TAD ENTNO /GET FILE # SZA CLA /IF TTY,BUFFER FIELD IS 0 CDF 10 /DF TO BUFFER FIELD TAD I TEMP17 /GET WORD FROM BUFFER CDF JMP I BCGET /RETURN TEMP17=WRITFL /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 CHRNOL /GET CHAR # SKP /1 JMP CHAR3U /3 JMS I CNOBMP /BUMP CHAR NUMBER JMS READFL /GET CHAR AGAIN AND K0377 /STRIP TO EIGHT BITS U123C, DCA CHAR /SAVE TAD CHAR /GET CHAR AGIAN SNA JMP UNPACK+1 TAD MCTRLZ /IS IT CTRL/Z? SNA CLA JMP I EOFSEL /YES-SET EOF BIT JMP I UNPACK /RETURN CHAR3U, JMS I CNOCLL /RESET CHAR # TO 1 CLA CLL CMA RAL /-2 IN AC TAD I WORD3 DCA I WORD3 /BACK BUFFER POINTER UP 2 JMS READFL /GET LEFT HALF OF CHAR AND K7400 DCA TEMP18 /SAVE JMS READFL /GET NEXT WORD WITH RIGHT HALF AND K7400 /ISOLATE RIGHT HALF CLL RTR RTR /SLIDE RIGHT HALF OVER TAD TEMP18 /COMBINE WITH LEFT HALF CLL RTR RTR /MOVE TO BITS 4-11 JMP U123C /REJOIN MAINLINE MCTRLZ, -232 CNOBMP, CNOBML /READ FUNCTION-GETS NUMBERS INTO VARIABLES READI, JMS I FTYPL /IS FILE NUMERIC? SKP /YES-WRITE DATA JMP ASCHR /NO-WRITE ASCII JMS I BUFCHL /YES-CHECK BUFFER POINTER NOP /PAST END-NEXT RECORD NOP /AT END-NEXT RECORD JMS I NEXREL /ONLY 1 WORD LEFT-IT IS UNUSED IN NUMERIC FMT JMS READFL /GET WORD FROM FILE DCA EXP /STORE AS EXPONENT JMS READFL /GET WORD FROM FILE DCA HORD /STORE AS HIGH MANTISSA JMS READFL /GET WORD FROM FILE DCA LORD /STORE AS LOW MANTISSA JMP I ILOOPL /DONE ASCHR, JMS I FFINL /USE FPP INPUT TO GET NUMBER JMP I ILOOPL /DONE FFINL, FFIN /ROUTINE TO FETCH ASCII CHARACTERS FROM FILE BUFFER GETCH, 0 JMS I FTYPL /IS FILE ASCII? SR, JMS I ERROR /NO-ERROR TAD ENTNO SZA CLA JMP NTTY TAD TCHAR TAD M215 SNA CLA JMS I DEVCAL NTTY, JMS I BUFCHL /NO-CHECK STATUS OF BUFFER JMS I NEXREL /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 /STRING ACCUMULATOR LOAD SLOAD, DCA LOADDF /PUT DF FOR OPERAND FIELD IN LINE TAD SACPTR /POINTER TO START OF SAC DCA XR2 /POINTS INTO SAC TAD STRCNT /GET LENGTH OF THIS STRING DCA STRLEN /SET THAT LENGTH AS LENGTH OF STRING IN SAC TAD STRLEN /GET LENGTH OF NEW STRING SNA CLA /IS IT A NULL STRING? JMP I ILOOPL /YES-WE DON'T HAVE TO MOVE ANYTHING SSLP, ISZ STRPTR /POINT TO FIRST PAIR OF CHARACTERS JMP LOADDF TAD LOADDF /SKIP MEANS WE HAVE TO BUMP DF TAD K0010 DCA LOADDF LOADDF, . /DF TO OPERAND FIELD TAD I STRPTR /GET 2 CHARS FROM STRING CDF /DF TO SAC FIELD DCA I XR2 /PUT IN SAC ISZ STRCNT /DONE? SKP /NO-TWO CHARS/WORD JMP I ILOOPL /YES-NEXT INST ISZ STRCNT /DOES SECOND CHAR MAKE COUNT 0? JMP SSLP /NO-LOOP JMP I ILOOPL /YES-NEXT INST PAGE /WRITE FUNCTION-PUTS NUMBERS IN FILE BUFFERS WRITEI, JMS I FTYPL /GET FILE TYPE SKP /NUMERIC-WRITE DATA JMP PDNE /ASCII JMS I BUFCHL /FILE IS NUMERIC-CHECK BUFFER STATUS K240, 240 /PAST END-NEW RECORD (AND INST SERVES AS NOP) K0210, 0210 /AT END-NEW RECORD (AND SERVES AS NOP) JMS I NEXREL /ONE WORD LEFT-DON'T USE IT TAD EXP /EXPONENT JMS I WRITFW /WRITE IN BUFFER TAD HORD /HIGH MANTISSA JMS I WRITFW /WRITE IN BUFFER TAD LORD /LOW MANTISSA JMS I WRITFW /WRITE IN BUFFER JMP WDONE /DONE ASCOUL, ASCOUT /LINK TO FPP CALLER AND FORMATTER /PDNE-CALLS ASCOUT TO GET NUMBER INTO INTERMEDIATE /BUFFER,THEN TYPES IT ON DEVICE PDNE, JMS I ASCOUL /GET # INTO INTER BUFFER ISZ TEMP10 /MOVE POINTER PAST SPACE THAT SENT US HERE TAD I TEMP10 /GET SIGN TAD MPLUS SZA CLA /IS IT PLUS? JMP MDNE /NO-ITS MINUS TAD K240 /SPACE DCA I TEMP10 /REPLACE "+" WITH SPACE MDNE, TAD TEMP2 /GET COUNT OF CHARS TO BE PRINTED TAD I WORD10 /ADD TO PRINT HEAD POSITION TAD M110 /COMPARE AGAINST "72" SMA SZA CLA /WILL THE NUMBER FIT ON THIS LINE? JMS I CRLF /NO-ISSUE A CR,LF CPLOOP, TAD I TEMP10 /GET CHAR FROM INTERMEDIATE BUFFER TAD M215 /IS IT CR? SNA CLA JMP ASCNDE /YES-NUMBER ALL OUTPUTTED TAD I TEMP10 /NO-GET CHAR AGAIN JMS PUTCH /PUT ON DEVICE ISZ TEMP10 /BUMP POINTER JMP CPLOOP /NEXT ASCNDE, TAD K240 JMS PUTCH /FOLLOW THE NUMBER WITH A SPACE WDONE, DCA I COMMAP /CLEAR COMMA SWITCH JMP I ILOOPL /WRITE IS DONE COMMAP, COMMAS MPLUS, -253 M110, -110 /ROUTINE TO PUT ASCII CHARS IN FILE BUFFER. IGNORES RUBOUTS. PUTCH, 0 DCA TEMP1 /SAVE CHAR TAD TEMP1 /GET CHAR AGAIN TAD MRUBOT SNA CLA /IS IT A RUBOUT? JMP I PUTCH /YES-RETURN JMS I FTYPL /IS FILE NUMERIC? SW, JMS I ERROR /YES-ERROR ISZ I WORD10 /BUMP COULMN NUMBER TAD ENTNO /GET ENTRY # SNA CLA /IS IT TTY? JMP TOUT /YES-JUST PUT CHARS IN RING BUFFER JMS I BUFCHL /NO-IS BUFFER FULL? JMS I NEXREL /YES-NEXT RECORD KK40, 40 /THERE IS A CHAR 3 LEFT (AND IS A NOP) K20, 20 /THERE IS A CHAR 2 AND 3 LEFT (AND IS A NOP) TAD TEMP1 /GET CHAR AGAIN JMS I PACKL /PUT IN BUFFER JMP I PUTCH /RETURN TOUT, TAD TEMP1 /GET CHAR JMS I XPUT /PUTCH CHAR IN OUTPUT BUFFER FOR TTY JMP I PUTCH /RETURN MRUBOT, -377 /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 WORD0 /GET HEADER AND K20 /GET READ/WRITE ONLY BIT SNA CLA /IS IT ON? JMP FILSTR /NO-DEVICE IS FILE STRUCTURED JMS I FOTYPL /YES-IS IT INPUT OR OUTPUT FILE? JMP RONLY JMS WRBLK RWONC, ISZ I WORD2 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 WORD2 /BUMP BLOCK # TAD I WORD5 /STARTING BLOCK CIA /NEGATE TAD I WORD2 /SUBTRACT FROM CURRENT BLOCK FOR FILE LENGTH CLL CMA /SET UP CURRENT FILE LENGTH FOR 12 BIT COMPARE TAD I WORD6 /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 FOTYPL /IS FILE FIXED LENGTH? JMP I EOFSEL /YES-SET EOF FLAG TAD I WORD6 /NO-GET ACTUAL LENGTH CLL CMA TAD I WORD7 /MAXIMUM LENGTH SNL CLA /IS ACTUAL LENGTH >= MAXIMUM LENGTH? JMP I EOFSEL /YES-SET EOF BITS ISZ I WORD6 /NO-BUMP ACTUAL LENGTH JMP I NEXREC /RETURN WITHOUT READING NEXT RECORD FOTYPL, FOTYPE /ROUTINE TO READ 2 PAGES FROM DEVICE BLREAD, 0 JMS I BLZERP TAD K0210 /"READ 2 PAGES" JMS I DEVCAL /HANDLER CALL JMP I BLREAD /ROUTINE TO WRITE 2 PAGES ONTO DEVICE WRBLK, 0 TAD I WORD0 /GET FILE HEADER AND KK40 /GET FILE WRITTEN BIT SNA CLA /HAS THIS BLOCK BEEN CHANGED? JMP I WRBLK /NO-RETURN TAD K4210 /"WRITE 2 PAGES" JMS I DEVCAL /CALL TO DEVICE HANDLER JMS I BLZERP JMP I WRBLK K4210, 4210 /ROUTINE TO INITIALIZE I/O TABLE ENTRIES AFTER READ OR WRITE BLINIT, 0 TAD I WORD1 DCA I WORD3 /INIT READ/WRITE POINTER TAD I WORD0 AND K7437 /SET CHAR # TO 1 AND CLEAR BLOCK WRITTEN BIT DCA I WORD0 JMP I BLINIT K7437, 7437 /ROUTINE TO SAVE THE FAC IN FP TEMP FACSAV, 0 JMS I FPUTL /STORE FAC INTERB /USE INTERMEDIATE BUFFER FOR TEMP STORAGE JMP I FACSAV /RETURN ///////////////////////////////////////////////////////////// ///////////////////////////////////////////////////////////// //////////// OVERLAY BUFFER 3400-4600 //////////////////// //////////// CONTAINS FUNCTION OVERLAYS //////////////////// //////////// AT RUN TIME //////////////////// ///////////////////////////////////////////////////////////// ///////////////////////////////////////////////////////////// ///////////////////////////////////////////////////////////// ///////////////////////////////////////////////////////////// ////////////// OVERLAY 1-ARITHMETIC FUNCTIONS /////////////// ///////////////////////////////////////////////////////////// ///////////////////////////////////////////////////////////// *OVERLAY /INTEGER FUNCTION /RANGE=ALL X INT, 0 JMS I FPUTL /SAVE X FPPTM1 TAD EXP /GET EXPONENT SMA SZA CLA /IS EXP<0? JMP INSC /NO-GO ON TAD HORD /YES SPA CLA /IS X<0? JMP M1R /YES-INT=-1 JMS I FCLR /YES-RETURN A 0 JMP I INT INSC, TAD HORD /GET HI MANTISSA SMA CLA /IS IT <0? JMP INTPOS /NO-USE FAC AS IS JMS I FNEGL /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 EXP 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 HORD /YES-MASK HORD AND TEMP4 DCA HORD TAD LORD /MASK LORD AND TEMP5 DCA LORD TAD TEMP3 /NEG FLAG SNA CLA /WAS ORIGINAL NUMER <0? JMP I INT /NO-DONE JMS I FPUTL /SAVE INT(X) FPPTM2 JMS I FADDLK /-INT(X)+(X) FPPTM1 TAD HORD /SAVE HORD DCA TEMP3 JMS I FCLR /FLUSH FAC TAD TEMP3 /WAS INT(X)=X? SNA CLA JMP JUSNEG /YES-JUST NEGATE INT(X) JMS I FADDLK /NO-ADD 1 ONE JUSNEG, JMS I FADDLK /GET INT(X) FPPTM2 JNEG, JMS I FNEGL /AND NEGATE (INT(5.3)=-6) JMP I INT /DONE M1R, JMS I FGETL /LOAD FAC WITH 1 ONE JMP JNEG /JUST NEGATE AND RETURN FADDLK, FFADD 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 FPUTL /SAVE A FPPTM5 JMS I FPUTL /SET UP RUNNING PRODUCT IN CASE OF FPPTM4 /MULTIPLIES TAD HORD /HI ORDER OF A DCA EXPON /SAVE IT DCA INSAV /POINTER TO B IN SYMBOL TABLE JMS I ARGPLL /FIND B JMS I FGETL /GET B ARGPLL, ARGPRE /LOC SKIPPED BY FPP,SO WE USE IT FOR CONSTANT CDF TAD HORD /HI ORDER OF B SNA /IS B=0? JMP I RETRNO /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 DVTRAP /YES-DIVIDE BY ZERO ERROR TAD EXPON /B>0. IS A=0? SNA CLA JMP RET0 /YES A^B=0 JMS I FPUTL /SAVE B FPPTM3 JMS INT /GET INT(B) JMS I FSUBLL /INT(B)-B FPPTM3 TAD HORD /IS INT(B)-B=0? SZA CLA JMP I USELOL /NO-USE LOGS JMS I FGETL /YES-USE REPETITIVE MULTIPLY FPPTM3 /GET B AGAIN TAD HORD DCA EXPON /SAVE SIGN OF B JMS I ABSV /!B! JMS I FPUTL /USE ABS(B) AS MULTIPLY COUNT FPPTM3 EMLOOP, JMS I FGETL /GET B FPPTM3 JMS I FSUBLL /B-1 ONE JMS I FPUTL /SAVE NEW COUNT FPPTM3 TAD HORD SNA CLA /IS COUNT ZERO YET JMP I EMDONL /YES-MULTIPLIES ARE DONE JMS I FGETL /NO-GET RUNNING PRODUCT FPPTM4 JMS I FMPYL /MULTIPLY BY A FPPTM5 JMS I FPUTL /SAVE NEW RUNNING PRODUCT FPPTM4 JMP EMLOOP RET0, JMS I FCLR /RETURN WITH 0 IN FAC JMP I ILOOPL USELOL, USELOG EMDONL, EMDONE RETRNO, RETRN1 FMPYL, FFMPY FSUBLL, FFSUB DVTRAP, DV ABSV, ABSVAL PAGE EMDONE, JMS I FGETL /GET RUNNING PRODUCT FPPTM4 TAD I EXPONK /GET SIGN OF B SMA CLA /WAS IT -? JMP I ILOOPL /NO-A^B=A*A*A*...*A JMS I FIDVP /YES-INVERT ONE JMP I ILOOPL /A^B=1/A:A*A*...*A RETRN1, JMS I FGETL ONE /SET FAC TO 1 JMP I ILOOPL USELOG, TAD I EXPONK /SIGN OF A SPA CLA /A<0? EM, JMS I ERROR /YES-PRINT A MESSAGE JMS I FGETL /LOAD A FPPTM5 JMS I FFLOGL /LOG(A) JMS I FMPYLV /B*LOG(A) FPPTM3 JMS I FFEXPL /EXP(B*LOG(A)) JMP I ILOOPL /DONE FFEXPL, FFEXP FFLOGL, FFLOG FMPYLV, FFMPY EXPONK, EXPON FIDVP, FFDIV1 /SGN FUNCTION SGN, 0 TAD HORD /GET HIGH MANTISSA SNA /IS X=ZERO? JMP I ILOOPL /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 EXP /SET UP FLOAT JMS I FLOATL /FLOAT VALUE OF SGN FUNCTION JMP I ILOOPL /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 FNEGL /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 ACLO /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 ACLO /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 ACLO 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 ACLO JMP I FROOT /AND RETURN K6000, 6000 ZCNT, 0 AL1K, AL1 AN1, 0 AN2, 0 KM22, -26 > XLIST IFNZRO EAE < ENPUNCH / /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 ACLO /STORE LOW ORDER BACK JMP I FROOT /RETURN KM22, -26 K6000, 6000 NOPUNCH > XLIST /23-BIT EXTENDED FUNCTIONS /1-31-72 R BEAN *4000 /******SINE****** SIN, 0 JMS NHNDLE /IF X<0,NEGATE X AND SET NFLAG JMS I FMPYLK /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 C3 /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 FSUB1L /1-X ONE JMP POLYSN /CALCULATE SIN(1-X) QUAD3, JMS I FNEGL /-X JMP POLYSN /CALCULATE SIN(-X) QUAD4, JMS I FSUBL /X-1 ONE POLYSN, JMS I FPUTL /SAVE X FPPTM1 JMS I FSQRL /U=X**2 JMS I FPUTL /SAVE U FPPTM2 JMS I FMPYLK /A7*U SINA7 JMS I FADDL /A5+A7*U SINA5 JMS I FMPYLK /A5*U+A7*U**2 FPPTM2 JMS I FADDL /A3+A5(U)+A7(U**2) SINA3 JMS I FMPYLK /A3(U)+A5(U**2)+A7(U**3) FPPTM2 JMS I FADDL /A1+A3(U)+A5(U**2)+A7(U**3) SINA1 JMS I FMPYLK /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 FADDL /COS(X)=SIN(PI/2+X) PIOV2 JMS SIN JMP I COS /RETURN FADDL, FFADD FMPYLK, FFMPY FDIVL, FFDIV FSUB1L, FFSUB1 FSUBL, FFSUB FSQRL, FFSQ FIXL, FFIX FDIV1L, FFDIV1 C3, 3 /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 FPUTL /SAVE X FPPTM1 JMS I FIXL /INTEGER PORTION OF X TAD EXP DCA NUM /SAVE FIXED FORTION OF X JMS I FLOATL /FAC=FLOAT(FIX(X)) JMS I FSUB1L /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 HORD /FETCH HIGH ORDER MANTISSA SMA CLA /IS IT <0? JMP NFLGST /NO-CLEAR NFLAG JMS I FNEGL /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 FNEGL /NO-NEGATE FAC JMP I NCHK /YES-RETURN NUM=NCHK /******EXPONENTIAL****** EXPON1, 0 /LOC USED FOR TEMP STORAGE BY SIN,ARCTAN JMS I FMPYLK /Y=XLOG2(E) LOG2E JMS FRACT /GET FRACTIONAL PART OF Y JMS I FMPYLK /(FRACTION(Y))*(LN2/2) LN2OV2 JMS I FPUTL /SAVE Y FPPTM1 JMS I FSQRL /Y**2 JMS I FADDL /B1+Y**2 EXPB1 JMS I FDIV1L /A1/(B1+Y**2) EXPA1 JMS I FADDL /A0+A1/(B1+Y**2) EXPA0 JMS I FSUBL /A0-Y+A1/(B1+Y**2) FPPTM1 JMS I FPUTL /SAVE FPPTM2 JMS I FGETL /GET Y FPPTM1 ISZ EXP /MULT. BY 2=2Y NOP JMS I FDIVL /2Y/(A0-Y+A1/(B1+Y**2)) FPPTM2 JMS I FADDL /1+2Y/(AO-Y+A1/(B1+Y**2)) ONE JMS I FSQRL /[1+2Y/(A0-Y+A1/(B1+Y**2))]**2=EXP(Y) TAD NUM TAD EXP /EXP(X)=(2**N)(EXPY) DCA EXP JMP I EXPON1 /FAC=EXPON(X) NFLAG=EXPON1 /CONSTANT THAT WOULDN'T FIT ELSEWHERE TOVPI, 0 /.6366198 2427 6302 *4200 /******ARC TANGENT****** ATAN, 0 JMS I NHNDLL /IF X<0,SET NFLAG AND NEGATE JMS I FPUTM /SAVE X FPPTM1 JMS I FSUBM /X-1 ONE TAD HORD /GET HI MANTISSA SPA CLA /WAS X>1? JMP ARGPOL /NO-CLEAR GT1FLG JMS I FGETM /YES-ATAN(X)=PI/2-ATAN(1/X) ONE JMS I FDIVM /1/X FPPTM1 JMS I FPUTM FPPTM1 IAC /SET GT1FLG ARGPOL, DCA GT1FLG JMS I FGETM /GET X OR 1/X FPPTM1 JMS I FSQRM /Y**2 JMS I FPUTM /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 HORD SPA SNA /X<0 OR X=0? JMP I ARTRAP /YES-TAKE ILLEGAL ARGUMENT TRAP CLL RTL SNA /NO-HORD=2000? TAD EXP /YES-EXP=1? CMA IAC IAC SNA TAD LORD /YES-LORD=0? SZA CLA JMP POLYNL /NO-ARG IS LEGAL AND NOT 1 DCA EXP DCA LORD LTRPRT, DCA HORD JMP I LOG /YES-LOG(1)=0 POLYNL, TAD EXP DCA GTFLG /SAVE EXPONENT FOR LATER DCA EXP /ISOLATE MANTISSA IN FAC JMS I FPUTM /SAVE F FPPTM1 JMS I FADDM /F+SQR(.5) SQRP5 JMS I FPUTM /SAVE FPPTM2 JMS I FGETM FPPTM1 JMS I FSUBM /F-SQR(.5) SQRP5 JMS I FDIVM /Z=F+SQR(.5)/F-SQR(.5) FPPTM2 JMS I FPUTM FPPTM1 JMS I FSQRM /Z**2 JMS I FPUTM 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 FPUTM /SAVE LOG2(F) FPPTM2 TAD GTFLG /I DCA EXP /SET UP FLOAT JMS I FLOATM 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 FGETM=FGETL FLOATM=FLOATL FPUTM=FPUTL /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 FFSIN=SIN FFCOS=COS FFATN=ATAN FFLOG=LOG FFEXP=EXPON1 *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 EXP /FETCH EXPONENT SZA SMA /IS NUMBER <1? JMP .+3 /NO-CONTINUE ON FTRPRT, CLA JMP FIXDNE+1 /YES-FIX IT TO ZERO TAD M13 /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 OTRAPA /YES-TAKE OVERFLOW TRAP DCA EXP /NO-SET SCALE COUNT FIXLP, CLL /0 IN LINK TAD HORD /GET HIGH MANTISSA SPA /IS IT <0? CML /YES-PUT A 1 IN LINK RAR /SCALE RIGHT DCA HORD /SAVE ISZ EXP /DONE YET? JMP FIXLP /NO FIXDNE, TAD HORD /YES-ANSWER IN AC DCA EXP /RETURN WITH ANSWER IN 44 JMP I FFIX /RETURN M13, -13 /-11 DECIMAL C13, 13 /11 DECIMAL OTRAPA, FO /ADDRESS OF VECTOR FOR OVERFLOW TRAP /******FLOAT****** /ROUTINE TO FLOAT ANY INTEGER IN EXP (LOC 44) INTO FAC FFLOAT, 0 TAD EXP DCA HORD /PUT NUMBER IN HI MANTISSA DCA LORD /CLEAR LOW MANTISSA TAD C13 /11(10) INTO EXPONENT DCA EXP JMS I FNORL /NORMALIZE JMP I FFLOAT /RETURN /RANDOM NUMBER GENERATOR RND, 0 TAD I RSEEDL /GET SEED DCA TEMP3 /PUT IN MULTIPLY OPERAND TAD K73 JMS I MPYLNK /MULTIPLY SEED BY 73 DCA I RSEEDL /USE LOW ORDER 12 BITS AS NEW SEED TAD I RSEEDL /LOW ORDER OF PRODUCT ALSO SERVES CLL RAR /AS RANDOM NUMBER DCA HORD /SET SIGN TO 0 AND STORE AS HORD DCA EXP RAR DCA LORD /USE 12 BITS AS MANTISSA DCA AC1 /CLEAR FPP OVERFLOW JMS I FNORL /AND NORMALIZE JMP I ILOOPL /DONE RSEEDL, RSEED K73, 73 ///////////////////////////////////////////////////////////// ///////////////////////////////////////////////////////////// ////////////// OVERLAY 2- STRING FUNCTIONS ///////////////// ///////////////////////////////////////////////////////////// ///////////////////////////////////////////////////////////// FIELD 1 *2000 NOPUNCH *OVERLAY ENPUNCH IFNZRO EAE < NOPUNCH > /CHR$ FUNCTION /RETURNS 1 CHAR STRING FOR THE VALUE OF X CHR, 0 JMS I INTL /FIX X TO 12 BIT INTEGER JMS I BSWL /TREAT THE RIGHTMOST 6 BITS AS CHAR DCA I SACL /AND PUT INTO SAC CMA DCA STRLEN /SET SAC LENGTH TO 1 JMP RETMOD /SET TO SMODE AND RETURN /ASC FUNCTION /RETURNS DECIMAL ASCII FOR 1 CHAR STRING IN FAC ASC, 0 TAD I SACL /GET FIRST TWO CHARS OF STRING JMS I BSWL /WE WANT LEFT CHAR AND K0077 /SO ISOLATE IT JMP I FLOATB /FLOAT RESULT INTO FAC AND RETURN /LEN FUNCTION /RETURNS LENGTH OF SAC IN FAC LEN, 0 TAD STRLEN /LENGTH OF STRING IN SAC CIA /MAKE POSITIVE JMP I FLOATB /FLOAT RESULT AND RETURN FLOATB, FLOATS SACL, SAC /STR$ FUNCTION /RETURNS ASCII STRING FOR NUMBER IN FAC STR, 0 JMS I ASCOLK /GET ASCII FOR FAC INTO INTERMEDIATE BUFFER DCA STRLEN /ZERO FAC CLL IAC TAD SACPTR JMS I STHINL /INITIALIZE STH TO SAC JMS I STHRST /SET DF TO STH TO 0 ISZ TEMP10 /MOVE PAST LEADING SPACE TAD I TEMP10 /GET SIGN OF NUMBER TAD MINUSP /IS IT "+" SZA CLA JMP STSLP /NO-IT IS "-" SO LEAVE IT ALONE TAD CCC240 /YES-REPLACE IT WITH A SPACE DCA I TEMP10 STSLP, ISZ TEMP10 /BUMP POINTER TAD I TEMP10 /GET CHAR FROM INTERMEDIATE BUFFER TAD M215 /IS IT CR? SNA JMP RETMOD /YES-RETURN IN SMODE TAD MCRMAL /IS IT ALTMODE? SNA CLA JMP STSLP /YES-IGNORE IT TAD I TEMP10 /NO-GET CHAR AGAIN JMS I STH /PUT IN SAC CLA CMA TAD STRLEN /"BUMP" SAC COUNTER" DCA STRLEN JMP STSLP MCRMAL, 7616 ASCOLK, ASCOUT CCC240, 240 MINUSP, -253 /VAL FUNCTION /RETURNS NUMBER IN FAC FOR STRING IN SAC VAL, 0 CLL IAC TAD SACPTR JMS I LDHINL /INITIALIZE LDH TO SAC JMS I LDHRST TAD STRLEN DCA VALCNT /COUNT OF CHARS TO INPUT TAD STCGTJ /JMS TO VALGET DCA I INPTCL /PUT IN INPUT ROUTINE IN PLACE OF KRB JMS I FFINLK /CALL FPP INPUT ROUTINE TAD GETCHG /JMS TO GETCH DCA I INPTCL /RESTORE IN INPUT ROUTINE JMP I ILOOPL /DONE FFINLK, FFIN INPTCL, INPUT+1 STCGTJ, JMS I VALLK GETCHG, JMS I GETCHL VALGET, 0 TAD VALCNT /GET # OF CHARS LEFT SNA CLA /ANY MORE? JMP ENVAL /NO-SEND A CR TO FPP INPUT ROUTINE JMS I LDH /YES-HET CHAR DCA CHAR /SAVE TAD CHAR TAD KM40 /SUBTRACT 40 SPA CLA /IS CHAR <40? TAD K0100 /YES-IT IS IN 300 SERIES TAD K200 /TURN ON PARITY BIT TAD CHAR /BUILD 8 BIT CHAR DCA CHAR ISZ VALCNT /DECREASE COUNT NOP JMP I VALGET /RETURN WITH CHAR IN AC ENVAL, TAD K215 DCA CHAR JMP I VALGET VALCNT=STR RETMOD, IAC DCA MODESW /SET TO STRING MODE JMP I ILOOPL /RETURN *2200 NOPUNCH *OVERLAY+200 ENPUNCH IFNZRO EAE < NOPUNCH > /DATE FUNCTION DATE, 0 TAD CDFIO DCA .+1 /CDF TO FIELD THAT 17600 SITS IN . /DF TO 17600 FIELD TAD PSFLAG /GET RESIDENT STATUS FLAG CLL RAL /TD8/E BIT TO LINK SNL CLA /IS PG 17600 AT N7400? JMP N7666 /NO-GET DATE FROM N7666 TAD I L7466 /YES-GET DATE DCA TEMP1 /SAVE JMP DATCOM N7666, TAD I L7666 DCA TEMP1 /SAVE DATCOM, TAD TEMP1 /GET DATE AGAIN SZA CLA /IS IT EMPTY? TAD KKM10 /NO-SET STRING COUNT TO 8 DCA STRLEN /YES-RETURN NULL STRING CDF TAD SACPTR DCA XR5 /POINTS TO SAC TAD TEMP1 CLL RTL RTL RAL /MONTH TO BITS 8-11 AND K0017 /ISOLATE JMS ASCON /CONVERT TO ASCII DCA I XR5 /PUT IN SAC TAD TEMP1 /DATE CLL RTR RAR /DAY TO BITS7-11 AND K0037C /ISOLATE JMS ASCON /CONVERT TO ASCII JMS I BSWL /SWAP DIGITS DCA TEMP2 TAD TEMP2 AND K0077 /DAY DIGIT 1 TAD K5700 /"/N" DCA I XR5 /PUT IN STRING TAD TEMP2 /DAY DIGITS AGAIN AND K7700 /DAY DIGIT 2 TAD K0057 /"N/" DCA I XR5 /ADD TO STRING TAD TEMP1 /DATE AND K0007C /YEAR JMS ASCON TAD K0700 /"7N" DCA I XR5 /FINISH OFF STRING JMP I RETMDL /RETURN IN SMODE ASCON, 0 TAD DATABA /ADDR OF DATE TABLE DCA TEMP3 /POINTER TO RIGHT SET OF DIGITS TAD I TEMP3 /GET TWO ASII DIGITS FROM TABLE JMP I ASCON RETMDL, RETMOD DATABA, DATTAB-1 L7466, 7466 L7666, 7666 K0037C, 37 K0700, 700 K0057, 57 K5700, 5700 K0007C, 7 KKM10, -10 /TRACE FUNCTION PRINTER. WHEN TRACE IS ENABLED,THIS ROUTINE /PRINTS THE LINE # EACH TIME IT IS STORED TPRINT, 0 JMS I LMAKEL /MAKE LINE # INTO FIVE DIGITS TAD KEX JMS I XPUT /PRINT "%" TAD CC240 JMS I XPUT /PRINT A SPACE TAD DIG1A /ADDR OF FIRST DIGIT-1 DCA XR5 /IN XR5 IGS, TAD I XR5 /GET DIGIT OF LINE NUMBER DCA TPRINT /SAVE IT TAD MM260 TAD TPRINT /COMPARE IT TO 0 SNA CLA /IS IT A 0? JMP IGS /YES-IGNORE LEADING ZEROES PREST, TAD TPRINT /NO-GET CHAR AGAIN TAD M215 SNA CLA /IS IT A CR? JMP TDONE /YES-LINE NUMBER IS PRINTED TAD TPRINT /NO-GET CHAR A THIRD TIME JMS I XPUT /TYPE IT TAD I XR5 /GET NEXT CHAR DCA TPRINT JMP PREST /AND LOOP TDONE, TAD CC240 JMS I XPUT /FOLLOW LINE # WITH A SPACE TAD KEX JMS I XPUT /TYPE ANOTHER "%" TAD CCR JMS I XPUT /TYPE,CR,LF TAD CLF JMS I XPUT JMS I PRINT /EMPTY RING BUFFER OF TRACE NUMBER JMP .-1 JMP I ILOOPL /DONE LMAKEL, LMAKE KEX, 245 CCR, 215 CLF, 212 DIG1A, DIG1-1 MM260, -260 CC240, 240 *2400 NOPUNCH *OVERLAY+400 ENPUNCH IFNZRO EAE < NOPUNCH > /TRACE FUNCTION-ROUTINE TO TURN TRACE ON AND OFF TRACE, 0 TAD HORD /GET HI MANTISSA OF ARG SNA CLA /WHICH? JMP TOFF /FOR 0,TURN TRACE OFF TAD KNOP /TURN TRAC ON DCA I HOOKL /BY NOP ING INSTRUCTION AT TRHOOK TRREST, JMP I ILOOPL HOOKL, TRHOOK TOFF, TAD TRREST /TURN OFF TRACE JMP TRREST-1 /BY RESTOREING JMP TO TRHOOK KNOP, 7000 /ERROR ROUTINE ERRORR, 0 JMS I PRINT /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 JMS I BSWL /FIRST CHAR TO RIGHT AND K0077 /STRIP TO 6 BIT TAD K0300 /MAKE 8 BIT (LETTERS ONLY ALLOWED) DCA ESTRNG /PUT IN MESSAGE TAD TEMP1 /2 CHAR CODE AGAIN AND K0077 /SECOND CHAR TAD K0300 /MAKE LETTER DCA ESTRNG+1 /PUT IN MESSAGE TAD I XR4 /GET ERROR CODE +1 TAD I ERRET /COMPARE AGAINST RETURN ADDRESS 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 XPUT /NO-PUT CHAR IN RING BUFFER JMP ETLOP FATCHK, CLA TAD I ERRET /GET RETURN ADDRESS DCA ERRORR /AND STORE IT TAD MFATAL /-ADDR OF FATAL ERRORS TAD XR4 /ADDR OF THIS ERROR SMA CLA /FATAL ERROR? JMP I ERRORR /NO-NEXT INST JMP I STOPI /YES-TERMINATE RUN ERRET, ERRDIS STOPI, FSTOPN MAKED, 0 AND K0017 /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 240 301 /A 324 /T 240 314 /L 311 /I 316 /N 305 /E 240 DIG1, 0 DIG2, 0 DIG3, 0 DIG4, 0 DIG5, 0 215 212 ESTRA, EMESS-1 /MINUS NUMBER TO END ABOVE MESSAGE /ROUTINE TO FLOAT FAC AND RETURN FLOATS, DCA HORD /NUMBER TO BE FLOATED IN HORD DCA LORD /CLEAR LORD DCA TEMP2 /CLEAR FPP OVERFLOW TAD CC13 /SET EXP TO 11 DCA EXP JMS I FNORL /NORMALIZE JMP I ILOOPL /RETURN CC13, 13 /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 /*********************************************************** 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 /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, 0 IAC DCA MODESW /RETURN IN STRING MODE TAD HORD /IS Y>0? SMA SZA CLA JMP .+3 /YES JMS I FGETL /NO-SET Y TO 1 ONE1 JMS I FPUTL /SAVE Y FPPTM1 JMS I INTL /FIX Y TAD STRLEN /COMPARE TO STRLEN SMA SZA CLA /Y>LEN(X$)? JMP NULLST /YES-RETURN THE NULL STRING DCA INSAV /FAKE POINTER TO SCALAR #0 JMS I ARGPLK /GET ADDR OF Z JMS I FGETL /LOAD Z INTO FAC ARGPLK, ARGPRE /LOC SKIPPED BY FPP SO WE PUT CONST HERE TAD HORD /HI MANTISSA OF Z SPA SNA CLA /IS Z<0? JMP NULLST /YES-RETURN THE NULL STRING JMS I INTL /NO-FIX Z TAD STRLEN /COMPARE TO STRING LENGTH SPA CLA JMP ZMINY /Z<=LEN(X$) DCA LORD /Z>LEN(X$) SO SET Z=LEN(X$) TAD KK13 DCA EXP TAD STRLEN CIA /MAKE LENGTH POSITIVE DCA HORD JMS I FNORL /FLOAT LENGTH JMS I ARGPLK JMS I FPUTL /SAVE NEW Z KK13, 13 ZMINY, CDF JMS I FGETL /LOAD Y FPPTM1 JMS I ARGPLK /GET ADDR OF Z JMS I FISUBL /Z-Y CDF000, CDF TAD HORD /GET HI ORDER Z-Y SPA CLA /IS Y<Z? JMP NULLST /NO-RETURN NULL STRING JMS I INTL /FIX Z-Y CMA /ADD ONE AND NEGATE DCA STRCNT /STORE AS SEG LENGTH JMS I FGETL FPPTM1 /RETRIEVE Y AGAIN JMS I INTL /FIX Y CLL RAR /DIVIDE BY TWO SZL IAC CML TAD SACPTR /USE Y/2 AS DISPLACEMENT FROM START OF SAC JMS I LDHINL /INITIALIZE LDH JMS I LDHRST TAD SACPTR CLL IAC JMS I STHINL /INITIALIZE STH TO SAC JMS I STHRST DCA STRLEN /ZERO SAC JMP I SEGCML /USE CODE IN CONCATENATE TO DO THE REST NULLST, DCA STRLEN /ZERO SAC JMP I ILOOPL /RETURN FISUBL, FFSUB1 SEGCML, SEGCOM *3000 NOPUNCH *OVERLAY+1000 ENPUNCH IFNZRO EAE < NOPUNCH > /POS FUNCTION /RETURNS THE POSITION IN X$ OF Y$ STARTING AFTER Z POS, 0 CLL DCA INSAV /FAKE AS STRING CALL TO STRING 0 JMS I STFINK /FIND Y$ DCA I LDHCDL /GET Y$ CHARS FROM DF N TAD STRCNT /# OF CHARS IN Y$ SNA CLA /IS Y$ THE NULL STRING? JMP ONERET /YES-RETURN 1 AS POSITION TAD STRLEN /NO-# OF CHARS IN X$ SNA CLA /IS X$ THE NULL STRING? JMP ZRORET /YES-RETURN 0 TAD HORD /NO-GET HORD OF Z SPA CLA /IS Z>=0? PA, JMS I ERROR /NO-ILLEGAL ARGUMENT JMS I INTL /FIX Z DCA POSITN /USE IT AS POSITION TO START SEARCH TAD POSITN TAD STRLEN /COMPARE POSITION TO MAXIMUM LENGTH OF STRING SMA SZA CLA JMP PA /Z IS PAST END OF STRING-ERROR POSSET, TAD POSITN /SEARCH START POSITION IN X$ CLL RAR /DIVIDE BY 2 SZL IAC CML TAD SACPTR /USE AS DISPLACEMENT OFF START OF SAC DCA LDHPR /POINTS TO NEXT CHAR FROM X$ SNL CLA /IF LINK=0,GET RIGHT HALF CMA /ELSE GET LEFT HALF DCA LDHPSW TAD STRPTR CLL IAC /BUMP PAST CHAR COUNT JMS I LDHINL /INITIALIZE LDH TO Y$ TAD STRLEN /# OF CHARS IN X$ DCA TEMP4 /COUNTER TAD STRCNT /# OF CHARS IN Y$ DCA TEMP3 /COUNTER SRCLP, JMS XDGET /GET CHAR FROM X$ JMS I LDH /GET CHAR FROM Y$ CDF CIA /NEGATE CHAR FRON Y$ TAD TEMP1 /COMPARE WITH CHAR FROM X$ SNA CLA /DO THEY MATCH? JMP SCONTU /YES-CONTINUE MATCH TO NEXT CHAR IN X$ AND Y$ ISZ POSITN /BUMP POSITION TO BE CHECKED TAD POSITN /GET POSITION NOW CHECKING TAD STRLEN /COMPARE AGAINST LENGTH OF STRING SMA SZA CLA /ANY MORE TO COME? JMP ZRORET /NO-SEARCH FAILS JMP POSSET /YES-START COMPARING NEXT POSITION SCONTU, ISZ TEMP3 /MORE CHARS IN Y$? SKP /YES JMP RETPOS /NO-MATCH SUCCEEDS-RETURN POSITN ISZ TEMP4 /MORE IN X$? JMP SRCLP /YES-CONTINUE MATCH ZRORET, JMS I FCLR /NO-SEARCH FAILS-RETURN 0 JMP I ILOOPL RETPOS, TAD POSITN /GET POSITION OF MATCH JMP I FLOABL /FLOAT RESULT AND RETURN ONERET, JMS I FGETL /1 INTO FAC ONE1 JMP I ILOOPL ONE1, 1 2000 0 POSITN, 0 LDHPR, 0 LDHPSW, 0 STFINK, STFIND FLOABL, FLOATS LDHCDL, LDHDF /ROUTINE TO GET SUCCESSIVE HALFWORDS FROM X$ XDGET, 0 TAD LDHPSW /HALFWORD SWITCH SNA CLA /LEFT OR RIGHT? JMP XDRITE /RIGHT TAD I LDHPR /LEFT-GET CHARS JMS I BSWL /SWAP BYTES XLCOM, AND K0077 /ISOLATE CHAR DCA TEMP1 /SAVE TAD LDHPSW /HALFWORD SWITCH CMA /FLIP IT DCA LDHPSW JMP I XDGET /RETURN XDRITE, TAD I LDHPR /GET 2 CHARS ISZ LDHPR /BUMP POINTER TO NEXT WORD JMP XLCOM /DATE TABLE-USED TO CONVERT BINARY NUMBERS<31 INTO ASCII CHARACTERS DATTAB, 6061 /01 6062 /02 6063 /03 6064 /04 6065 /05 6066 /06 6067 /07 6070 /08 6071 /09 6160 /10 6161 /11 6162 /12 6163 /13 6164 /14 6165 /15 6166 /16 6167 /17 6170 /18 6171 /19 6260 /20 6261 /21 6262 /22 6263 /23 6264 /24 6265 /25 6266 /26 6267 /27 6270 /28 6271 /29 6360 /30 6361 /31 ////////////////////////////////////////////////// ////////////////////////////////////////////////// ///////// OVERLAY 3-FILE MANIPULATING //////////// ///////// FUNCTIONS //////////// ////////////////////////////////////////////////// ////////////////////////////////////////////////// *3400 /FILE CLOSING ROUTINE 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 ILOOPL /YES-DON'T DO ANYTHING JMS I FIDLE /SEE IF FILE OPEN JMS I FTYPL /IS FILE NUMERIC? JMP NOCZ /YES-DON'T OUTPUT ^Z JMS I FTYPSE /NO-IS FILE VARIABLE LENGTH? JMP NOCZ /NO-DON'T OUTPUT ^Z TAD K232 /YES JMS I PUTCHL /WRITE A ^Z IN FILE NOCZ, JMS I WRBLKK /WRITE LAST BLOCK IF IT HAS CHANGED JMS I P1SWAP /RESTORE 17600 JMS I FTYPSE /IS FILE FIXED LENGTH? JMP CLOSED /YES-NO NEED TO CLOSE THE FILE TAD I WORD6 /NO-GET FILE LENGTH DCA CLENG /PUT IN CLOSE CALL TAD WORD11 DCA FNAP /POINTER TO FILE NAME TAD I WORD0 CLL RTL RTL RAL /GET DEVICE NUMBER INTO BITS 8-11 AND K0017 /ISOLATE IT CIF 10 JMS I K7700 /CALL USR 4 /CLOSE FNAP, . /POINTER TO FILE NAME CLENG, . FC, JMS I ERROR /FILE CLOSING ERROR CLOSED, TAD I WORD1 /GET BUFFER ADDRESS CLL RTL RTL /BUFFER NUMBER INTO AC RAL /BITS 10,11 AND K0003 /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 WORD0 /HEADER WORD AND K7400 /STRIP HEADER TO DEVICE # ONLY DCA I WORD0 TAD MM4 /-4 DCA TEMP3 /USE AS COUNTER CHECKL, TAD TEMP3 /GET 3 OF FILE TO CHECK TAD W0PTRA /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 K7400 /ISOLATE DEVICE # CIA /NEGATE TAD I WORD0 /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 WORD0 AND K0010 /GET HANDLER LENGTH BIT SZA CLA /TWO PAGES? JMP TPREL /YES-FREE BOTH PAGES TAD I WORD4 /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 K0003 /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 WORD4 /SET FILE AS IDLE JMS I P1SWAP /GET RID OF 17600 AGAIN JMP I ILOOPL /DONE TPREL, TAD I WORD4 /ONLY FILE USING HANDLER CLL RTL RTL /ISOLATE HANDLER BUFFER NUMBER RAL AND K0003 TAD AN2PTR /USE AS INDEX TO AND MASK JMP RELCOM K232, 232 FTYPSE, FOTYPE WRBLKK, WRBLK K0003, 3 W0PTRA, W0PTR W0PTR, FILE1 /STARING ADDRESSES OF FILE2 /FILE TABLE ENTRIES FILE3 FILE4 AN2PTR, ANDLS2 MM4, ANDLS2, 7774 7701 *3600 /CHAIN FUNCTION /SETS UP COMMAND DECODER AREA,THEN CHAINS TO BCOMP.SV CHAIN, JMS I PRINT /EMPTY TTY RING BUFFER JMP .-1 JMS I P1SWAP /RESTORE PG 17600 JMS I DNA1 /RESTORE SYS RESIDENT JMS I DNA2 /GET FILE NAME IN NAME AREA FROM CURRENT FILE CIF 10 JMS I K7700 /CALL USR 10 /LOCK IN CORE TAD I WORD7 DCA DNA1 /FIRST TWO CHARS OF DEV NAME TAD I WORD10 /LAST TWO CHARS DCA DNA2 CIF 10 JMS I USR 12 /INQUIRE DNA1, PSWAP2 /DEVICE NAME DNA2, NAMEG CDIN, 0 CI, JMS I ERROR /ERROR TAD CDIN /GET ENTRY POINT OF DRIVER FOR CAHIN 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 WORD11 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 ERROR TAD STB /GET STARTING BLOCK CDF 10 DCA I L7620 /STARTING BLOCK IN CD AREA TAD FLN /FILE LENGTH CLL RTL RTL AND K7760 /PUT IN BITS 0-7 TAD DNA2 /COMBINE WITH DEVICE # DCA I CBLK /PUT IN CD AREA TAD K0100 /SET R SWITCH DCA I L7644 TAD I L7605K /STARTING BLOCK OF COMPILER SNA /(IS THIS A CORE IMAGE? JMP CICHAIN /YES: HANDLE SOMEWHAT DIFFERENTLY DCA CBLK /INTO COMPILER READ CODE CDF JMS I EXCHKP /VERIFY EXTENSION NOT .SV SKP JMP CL /ERROR IF IT IS CDF10 JMP I.+1 CSMOVE /MOVE THE COMPILER READ TO FIELD 1 AND EXECUTE IT L7644, 7644 L7620, 7620 K7760, 7760 L7621, 7621 L7605K, 7605 /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 /ROUTINE FOR INTERPRETER EXIT FSTOP, KSF /IS THE KEYBOARD FLAG SET? JMP NOCTC /NO-THERE IS NO CHANGE ^C SENT US HERE TAD K200 /YES-FORCE PARITY BIT KRB /GET CHARACTER TAD MCC /COMPARE AGAINST ^C SZA CLA /WAS IT ^C? JMP NOCTC /NO-THIS IS A NORMAL EXIT TSF JMP .-1 TAD KUPARO /YES -ECHO ^ TLS CLA TSF JMP .-1 TAD KC /ECHO "C" TLS NOCTC, TSF JMP .-1 CLA JMS I P1SWAP /RESTORE PG 17600 JMS I P2SWAL /RESTORE PG 27600 CDF 10 TAD I EDBLK /GET BLOCK # FOR EDITOR CDF SNA /SHALL WE CALL THE EDITOR? JMP I KL7600 /NOkJUST CALL OS/8 DCA EBLK /YES-PUT THE BLOCK # IN DRIVER CALL JMS I LK7607 /CALL SYS DRIVER 1700 /READ 7 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 3012 P2SWAL, PSWAP2 KL7600, 7600 LK7607, 7607 EDBLK, 7604 MCC, -203 KUPARO, 336 KC, 303 CICHAIN,CDF JMS I EXCHKP /VERIFY EXTENSION IS .SV JMP CL /ERROR IF NOT TAD STB DCA .+4 CIF 10 JMS I USR 6 HLT EXCHKP, EXTCHK *4000 /FILE OPENING ROUTINE /SITS IN THIS OVERLAY BECUASE THERE IS ROOM HERE,AND THE USR IS /GOING TO SPIN SYS ANYWAY OPENAV, TAD C4 /ALPHANUMERIC,VARIABLE LENGTH OPENAF, IAC /ALPHANUMERIC,FIXED LENGTH JMP OPENNF OPENNV, TAD C4 /NUMERIC,VARIABLE LENGTH OPENNF, DCA I WORD0 /SET UP HEADER WORD TAD ENTNO /IS FILE TTY? SNA CLA JMP I ILOOPL /YES-DON'T DO ANYTHING TAD I WORD4 /GET HANDLER ENTRY SZA CLA /IS FILE IDLE? FB, JMS I ERROR /ATTEMPT TO OPEN FILE ALREADY OPEN JMS I P1SWAP /RESTORE 17600 JMS I NAMEGL /GET FILE DEVICE NAME AND FILE NAME INTO WORDS 7-14 FROM SAC CIF 10 JMS I K7700 /CALL TO USR 10 /LOCK USR IN CORE TAD I WORD7 DCA DEVNA1 /DEVICE NAME INTO INQUIRE CALL TAD I WORD10 DCA DEVNA2 CIF 10 JMS I USR /CALL TO USR 12 /INQUIRE DEVNA1, . /DEVICE NAME DEVNA2, . ENTRYN, 0 /ENTRY POINT IN, JMS I ERROR TAD DEVNA2 /GET DEVICE # CLL RAR RTR /PUT INTO BITS 0-3 RTR TAD I WORD0 DCA I WORD0 /STORE IN HEADER WORD TAD ENTRYN /GET DRIVER ADDRESS SZA /IS IT IN CORE? JMP I DRIVRL /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 ERROR /NO-NO MORE ROOM FOR DRIVERS TAD K7400 /YES-LOAD HANDLER INTO 7400 DCA FETPAG /SET UP IN FETCH CALL TAD C4 /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 K7000 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 K7200 DCA FETPAG /SET ADDRESS IN FETCH CALL TAD C4 DCA TPH /IF TWO PAGE LOADED,SET BIT 9 ALSO CLL CLA CML RTL /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 ERROR CDF 10 CLA CMA TAD I L0037 /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 K0010 TAD I WORD0 /SET 2 PAGE BIT IN HEADER WORD DCA I WORD0 DRAP, TAD FETPAG /HANDLER ENTRY ADDRESS JMP I DRIVRL /PAGE ESCAPE DRIVRL, DRIVRN K7000, 7000 TPH, 0 L0037, 37 C4, 4 NAMEGL, NAMEG K7200, 7200 /ROUTINE TO MOVE THE COMPILER READER INTO FIELD 1 AND START IT CSMOVE, TAD CSTA DCA XR1 /POINTES TO COMPILER STARTING CODE TAD CSTAC DCA TEMP1 /COUNTER TAD KK2000 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 .+1 KK2000, 2000 CSTA, CREAD-1 CSTAC, -13 EXTCHK, 0 /SKIP RETURN IF CURRENT CLA CLL CML IAC /FILE EXTENSION RAL TAD WORD11 /IS .SV DCA DEVNA2 /JUST A TEMP TAD I DEVNA2 /GET EXTENSION TAD M2326 SNA CLA /IS IT .SV? ISZ EXTCHK /YES: SKIP JMP I EXTCHK M2326, -2326 *4200 DRIVRN, DCA I WORD4 /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 ERROR /NO-NO MORE BUFFERS AVAILABLE TAD K1400 DCA I WORD1 /SET BUFFER ADDRESS TO 1400 TAD K0010 /SET BUFF4 BIR IN MAP JMP BUFASS B3, CLA TAD K1000 DCA I WORD1 /SET BUFFER ADDRESS TO 1000 TAD CC4 JMP BUFASS /SET BUFF3 BIT IN MAP B2, CLA TAD K0400 DCA I WORD1 /SET BUFF ADDRESS TO 400 CLL CML CLA RTL /SET BUFF2 BIT IN MAP JMP BUFASS B1, CLA DCA I WORD1 /SET BUFF ADDRESS TO 0000 CLA IAC /TURN ON BUFF1 BIT IN MAP BUFASS, TAD BMAP DCA BMAP /UPDATE BUFFER ASSIGNMENT MAP TAD I WORD0 /GET HEADER WORD CLL RTR RAR /FIXED,VARIABLE BIT TO LINK SNL CLA /IS IT FIXED? JMP FLOOK /YES-DO A LOOKUP TAD CC3 /NO-DO AN ENTER JMS ENTLOK /ENTER DCA I WORD7 /MAXIMUM LEMGTH IN WORD 7 DCA I WORD6 /ZERO ACTUAL LENGTH JMP CLEANP /FINALIZE I/O TABLE ENTRY FLOOK, CLL CML CLA RTL /2 JMS ENTLOK /LOOKUP DCA I WORD6 /ACTUAL LENGTH TAD I WORD6 DCA I WORD7 /ALSO EQUALS MAXIMUM LENGTH CLEANP, DCA I WORD10 /ZERO COLUMN POINTER CMA /-1 TAD I WORD5 /STARTING BLOCK-1 DCA I WORD2 /CURRENT BLOCK #=STARTING BLOCK-1 TAD I WORD1 DCA I WORD3 /READ/WRITE POINTER AT BEGINNING OF BUFFER CIF 10 JMS I USR /CALL TO USR 11 /USROUT JMS I P1SWAP /GET RID OF 17600 JMS I BLZERP JMS I NEXRCK /DO A NEXREC TO READ IN FIRST FILE BLOCK JMP I ILOOPL /DONE NEXRCK, NEXREC ENTLOK, 0 DCA FNOM /FUNCTION NUMBER IN PLACE TAD WORD11 /POINTER TO FILE NAME DCA STARTB /INTO CALL TAD I DEVNAL /DEVICE NUMBER CIF 10 JMS I USR /CALL TO USR FNOM, . /ENTER OR LOOKUP STARTB, . FLEN, . EN, JMS I 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 C20 /NO-FILE IS READ/WRITE ONLY TAD I WORD0 DCA I WORD0 /SET READ/WRITE ONLY BIT TAD FNOM CLL RAR SNL CLA IAC FILSTU, TAD STARTB /GET STARTING BLOCK # OF FILE DCA I WORD5 /PUT IN I/O TABLE TAD FLEN /FILE LENGTH CIA /MAKE FILE LENGTH POSITIVE JMP I ENTLOK /RETURN K1400, 1400 K1000, 1000 CC4, 4 CC3, 3 DEVNAL, DEVNA2 C20, 20 /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 K4207K DCA I L7600K /REMOVE CTRL/C HOOKS TAD K6213K DCA I L7605P TAD PSFLAG /GET RESIDENT STATUS FLAG SPA CLA /IS THIS TD8/E SYS? JMS I TDFIXL /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 TDFIXL, PSWP2P K4207K, 4207 K6213K, 6213 BOSPT1, 7600 BOSPT2, 7774 MIN4, -4 L7600K, 7600 L7605P, 7605 *4400 /NAMEG-ROUTINE TO TRANSLATE SAC INTO A 6 WORD FILE NAME BLOCK,THEN /PUT THAT NAME BLOCK INTO THE BLOCK SPECIFIED BY THE AC ON ENTRY MCOLON, -72 MCSPE, 14 N3A, N3 N1, 0 /SCRATCH NAME BLOCK N2, 0 /DEVICE NAME N3, 0 N4, 0 /FILE NAME N5, 0 N6, 0 /.EXT DS, 0423 K0, 1300 M6, -6 CC16, 16 MMM4, -4 NAMEG, 0 TAD WORD7 /PUT THE NAME IN FILENAME AREA DCA TEMP3 /SAVE DESTINATION BLOCK ADDRESS TAD STRLEN TAD CC16 /COMPARE STRING LENGTH TO 16 SPA CLA IF, JMS I ERROR /TOO MANY CHARS IN DEV:FILENAME TAD STRLEN DCA TEMP2 /STRING LENGTH COUNTER TAD SACPTR CLL IAC JMS I LDHINL /INIT LDH TO PULL CHARS FROM SAC JMS I LDHRST TAD N3A CLL JMS I STHINL /INIT STH TO PUT CHARS IN SCRATCH BLOCK JMS I STHRST TAD DS DCA N1 TAD K0 DCA N2 /INITIALIZE DEV TO DSK: DCA N3 DCA N4 DCA N5 DCA N6 /ZERO FILE NAME DCA TEMP4 /ZERO INTERMEDIATE COUNTER NCG, JMS I LDH /GET CHAR FROM SAC DCA TEMP1 /SAVE TAD TEMP1 TAD MCOLON /IS IT A COLON? SNA JMP CAD /YES-CHARS SO FAR=DEVICE NAME TAD MCSPE /NO-IS IT A PERIOD? SNA CLA JMP SSAD /YES-NEXT TWO CHARS=EXTENSION TAD TEMP1 /NO-GET CHAR AGAIN JMS I STH /STORE IN NAME BLOCK 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 M6 SMA SZA CLA /IS IT >6? JMP IF /YES-TOO MANY CHARACTERS IN FILE NAME TAD N1A /NO-ADDRESS OF SCRATCH NAME BLOCK DCA XR1 CMA /-1 TAD TEMP3 /ADDRESS OF FINAL NAME BLOCK-1 DCA XR2 TAD M6 /MOVE 6 WORDS DCA TEMP2 MML, 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 MMM4 /COMPARE AGAINST 4 SMA SZA CLA /TOO MANY CHARS? JMP IF /YES-DEVICE NAME TOO LONG TAD N3 DCA N1 TAD N4 DCA N2 /NO-MOVE NEW DEVICE NAME FROM FILE NAME WORDS TO PROPER PLACE DCA N3 DCA N4 /CLEAR FILE NAME TAD N3A CLL JMS I STHINL /AND RE-INIT STH FOR NAME AREA DCA TEMP4 /ZERO COUNT JMP NCGS SSAD, TAD TEMP4 /COUNT FOR THIS SECTION (FILE NAME) TAD M6 SMA SZA CLA /TOO MANY? JMP IF /YES-FILE NAME TOO LONG DCA TEMP4 /NO-CLEAR COUNT CLA CLL CML RTR /2 IN AC TAD TEMP2 /COMPARE AGAINST # OF CHARS LEFT SPA CLA JMP IF /TOO MANY CHARS IN EXTENSION TAD N6A CLL JMS I STHINL /INIT STH TO PUT INTO EXTENSION JMP NCGS N1A, N1-1 N6A, N6 /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 CDF20 DCA I P2CDFL /PUT CDF 20 IN SWAP ROUTINE TAD CDF20 DCA I P2CDL1 JMS I P1SWAP /MOVE DOWN PAGE 27600 TAD K6223 DCA I L7642 TAD K6222 DCA I L7721 TAD K6222 /RESTORE CDFS IN PAGE 07600 DCA I L7727 JMP I PSWP2P /RETURN CDF20, CDF 20 P2CDFL, P2CDF P2CDL1, P2CDF1 K6223, 6223 L7642, 7642 K6222, 6222 L7721, 7721 L7727, 7727 FIELD 0 ///////////////////////////////////////////////////////////////////// ///////////////////////////////////////////////////////////////////// /////////////// END OF OVERLAY AREA ///////////////////////////////// ///////////////////////////////////////////////////////////////////// /////////////////////////////////////////////////////////////////// IFNZRO EAE < NOPUNCH > IFZERO EAE < *4600 / /FLOATING OUTPUT ROUTINE / FFOUT, 0 CLA CLL CMA RAL /MAKE A MINUS TWO DCA I FFNGP /AND STORE IN SIGN WORD DCA KNT /CLEAR COUNT WORD TAD EFLG /IS THIS E FORMAT? SZA CLA JMP FFMT /NO-F FORMAT TAD K6 /YES-GET A 6 DCA DADP /STORE AS # OF DIGITS AFT DEC PT TAD K16 /SET FIELD WIDTH TO 14 ( DECIMAL) DCA FLDW FFMT, CDF /DF TO PACKAGE FIELD TAD KM7 /SET # OF SIGNF. DIGITS DCA I DCNTP /TO 6 (DON'T PRINT 7TH) TAD ACH /DETERMINE IF #=0 SNA JMP FOUT3 /YES-SKIP DOWN SMA CLA /NO-IS IT NEGATIVE? JMP .+3 /POSITIVE JMS I FFNGP /NEGATE # DCA I FFNGP /NEGATIVE-SET FLAG FOUT1, TAD ACX /GET # INTO RANGE .1<=N<1 SMA SZA CLA /IS EXP. NEG.? JMP FOUT2 /NO-GO ON JMS I FFMPP /YES-MAKE # GREATER THAN 1 TEN /BY MULTIPLYING BY TEN (DEC.) ISZ KNT /COUNT THE MULTIPLIES JMP FOUT1 /SEE IF >1 YET FOUT2, JMS SE /# IS >1-MAKE IT LESS THAN 1 JMS I FFPUTP /STORE IN A TEMPORARY TM3 DCA ACX /SET FAC TO .5 CLL CML RTR DCA ACH DCA ACLO TAD EFLG /IS THIS E FORMAT? SZA CLA TAD KNT /NO-GET COUNT OF MULTIPLIES CMA IAC /NEGATE IT TAD DADP /AND ADD # OF DIGITS AFT. DC. PT. SMA /MUST BE NEGATIVE CMA TAD KK7 /LIMIT # OF DIVS TO 7 SPA CLA TAD KM7 /RESTORE DCA SE /STORE AS COUNTER JMP .+3 JMS I FFDVP /DIVIDE .5 BY TEN THAT # OF TIMES TEN ISZ SE /DONE? JMP .-3 /NO-GO ON JMS I FFADP /YES-ADD IN ORIG.#-THIS IS ROUNDING TM3 JMS SE /INSURE THAT IT IS IN RANGE FOUT4, TAD ACX /SHIFT MANTISSA ACCORDING TO EXP CMA IAC /0=1 LEFT; 1=NO SHIFT;2=1 RIGHT,... JMS I ACSRPT /SHIFT RIGHT (ACX+1) PLACES JMS I AL1PT /SHIFT LEFT 2 TO CORRECT JMS I AL1PT /(WE ARE LOSING BITS!!) FOUT3, TAD KNT /DONE-GET COUNT OF MULS. DCA OPX /PRESERVE IT TAD EFLG /IS THIS E FORMAT OUT? SZA CLA JMP NOTE /NO DCA KNT /YES-ZERO COUNT TAD KM7 /GET MINUS 7-FOR 2 SIGNS,PT,+EXP JMP ADFW /GO ADD FIELD WIDTH ACSRPT, ACSR AL1PT, AL1 / /ROUTINE TO GET FAC<1 / SE, 0 SE1, TAD ACX SPA SNA CLA /#>1? JMP I SE /NO-RETN. JMS I FFDVP /YES-DIV. BY TEN TEN CMA TAD KNT /REDUCE KNT BY 1 DCA KNT JMP SE1 /CONSTANTS AND POINTERS OUTDGP, OUTDG K16, 16 FLINK, JMP I FFOUT PRNTXP, PRNTX PRZROP, PRZRO DGTYPP, DGTYP DCNTP, DCNT M1, 7777 KK7, 7 KM20, -20 KM7, -7 FFADP, FFADD FFDVP, FFDIV FFPUTP=FPUTL FFMPP, FFMPY FFNGP, FFNEG KNT, 0 K6, 6 /CONTINUATION OF OUTPUT MAINLINE *4743 NOTE, TAD KNT /GET COUNT OF MULTIPLIES SMA /IF NOT NEG-MAKE = -2 CLA CMA TAD M1 /MINUS 1 FOR DEC.PT ADFW, TAD FLDW /GET THE FIELD WIDTH CMA IAC /NEGATE IT DCA I FFDVP /STORE WHILE WE CHECK DADP TAD DADP /GET DIGITS AFTER DEC. PT SNA /DID HE SAY NO DEC. PLACES? CMA /YES-TAKE AWAY 1 SINCE NO DEC. PT. TAD I FFDVP /ADD IN REST SMA /NEG? JMP I PRNTXP /NO-PRINT XS-NOT ENUFF ROOM DCA SE /STORE AS CNT OF SPACES JMP .+3 TAD KM20 JMS I OUTDGP /PRINT A SPACE ISZ SE /DONE? JMP .-3 /NO-GO ON CLA CLL CMA RTL /MAKE A MINUS 3 TAD I FFNGP /YES-GET SIGN(=-2 OR 0) JMS I OUTDGP /FOR PLUS OR MINUS-PRINT SIGN TAD KNT /GET MUL COUNT SMA JMP I PRZROP /PRINT LEADING ZERO CMA IAC JMS I DGTYPP /OUTPUT 'KNT' DIGITS PRDCP, TAD DADP /CHECK DADP FOR 0 SNA CLA /DON'T PRINT '.' IF DADP=0 /************************************* /FALL THROUGH PAGE BOUNDARY!!! /'SNA CLA' MUST BE LAST LOC. ON PAGE!!! /(CURSE YOU B.C.) /************************************* PAGE /*******FALL THROUGH PAGE BOUNDARY TO HERE******* JMP GKNT /MUST BE FIRST LOC. OF PAGE!!******* PDP, CLA CLL CMA RAL JMS OUTDG /PRINT DEC. PT. GKNT, TAD I KNTP /GET COUNT AGAIN SPA SNA CLA JMP GD TAD I KNTP /GET COUNT CMA /NEGATE DCA DGTYP /STORE AS COUNTER TAD DADP CMA /SAME FOR DADP DCA SEP JMP PR /GO ON PZR, JMS OUTDG /PRINT A ZERO PR, ISZ DGTYP SKP JMP PS ISZ SEP JMP PZR PS, TAD I KNTP CMA IAC GD, TAD DADP SMA SZA JMS DGTYP CLA TAD EFLG SZA CLA JMP DONEF /DONE JMS OUT 305 /PRINT 'E' TAD OPX /GET PRESERVED COUNT OF MULS SMA SZA CLA /DETERMINE SIGN CLA CLL CML RTL /MAKE A 2 JMS OUT 253 /PRINT MINUS OR PLUS SIGN TAD KM144 /SET TO DIV BY 100 DCA OPH CLA CLL CMA RAL /SET LOOP COUNTER DCA DGTYP TAD OPX /GET THE COUNT SPA CMA IAC /NEGATE IF NEGATIVE LOOP, DCA ACLO /STORE FOR DIV. ROUTINE DCA ACH /HI ORD. MUST BE ZERO CLL /PREVENT DIVIDE OVERFLOW!! JMS I DV24PT /DIVIDE BY 100 TAD ACLO /GET THE QUOTIENT JMS OUTDG /OUTPUT HUNDREDS PLACE TAD KM12 /NOW DIV. BY 10 DCA OPH TAD ACH /DIV. REM. BY 10 ISZ DGTYP /DONE? JMP LOOP /NO-GO DO CALCULATE , PRINT TENS PLACE JMS OUTDG /YES-REM(ONES PLACE)IS IN AC-PRINTIT DONEF, TAD SWIT2 /SHOULD WE PRINT CR/LF? SNA CLA JMP I FLING /NO JMS OUT 215 JMS OUT 212 JMP I FLING / /OUTPUT DIGITS OF FAC BY MULTIPLYING BY TEN /THE HIGH ORDER OVERFLOW IS THE DIGIT DGTYP, 0 CMA IAC DCA SEP /STORE COUNT PASSED DT1, TAD ACH /GET FAC AND STORE FOR LATER DCA OPH TAD ACLO DCA OPL JMS I AL1PP /SHIFT FAC LEFT 1 = FAC*2 RAL /OVERFLOW TO TM3 DCA TM3 JMS I AL1PP /SHIFT LEFT AGAIN = FAC*4 TAD TM3 /SHIFT OUT OVERFLOW RAL DCA TM3 DCA AC2 /MUST BE 0 FOR OADD JMS I OADDP /ADD ORIG FAC = FAC*5 RAL /ADD OVERFLOW TO TM3 TAD TM3 DCA TM3 JMS I AL1PP /SHIFT FAC 1 LEFT = FAC*10!! TAD TM3 /OVERFLOW IN TM3 IS FIRST DIGIT RAL ISZ DCNT /DONE ALL SIGNIF. DIGS.? JMP .+3 /NO-GO ON CLA CMA /YES-PRINT ZEROS DCA DCNT /FROM NOW ON JMS OUTDG /PRINT DIGIT (HI ORD. OVRFLOW) ISZ SEP /DONE REQUIRED? JMP DT1 /NOPE JMP I DGTYP /YUP KM144, -144 KM12, -12 DV24PT, DV24 DCNT, 0 /COUNT OF SIGNF. DIGITS AL1PP, AL1 OADDP, OADD FLING, FLINK PRDCPP, PRDCP / /OUTPUT ROUTINE / OUT, 0 TAD I OUT /GET THE CHAR DCA I XR3 /STORE CHAR IN INTERMEDIATE BUFFER JMP I OUT / /OUTPUT DIGIT / OUTDG, 0 JMS OUT 260 JMP I OUTDG /RETN KNTP, KNT TM3, 0 0 SEP, 0 PRNTX, CLA TAD FLDW /GET FIELD WIDTH CMA /MUST BE NEGATIVE DCA SEP /USE AS COUNTER PRNTX1, ISZ SEP /DONE ALL? SKP /NO-GO ON JMP DONEF /YES-RETN. JMS OUT /PRINT ASTERISK 252 /ASTERISK JMP PRNTX1 / /PRINT A LEADING ZERO / PRZRO, CLA JMS OUTDG JMP I PRDCPP / /FLOATING POINT INPUT ROUTINE / PAGE 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 ACLO 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 FPUTL /"FPUT I TM3PT" FPPTM1 JMS I FGETL /"FGET TP" TP JMS I FNORL /"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 TM3PT, TM3 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 GETCHL /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 SNA CLA /IS IT A SPACE? JMP INPUT+1 /YES-IGNORE IT IOUT, JMP I INPUT /RETURN 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 PATCHP /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 PATCHP /WHICH MODE OF CALL? TAD I FFDIV1 /CALLED BY USER-GET ADDR. JMS I ARGETL /PICK UP OPERAND TAD ACLO /SWAP THE FAC AND OPERAND DCA OPL /THERE IS A POINTER TO OPL TAD I AC2 /IN AC2 LEFT FROM ARGET SUBR. DCA ACLO 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 D ASUBROUTINE 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 RAR /MUST SHIFT RIGHT 1 DCA ACH /STORE IN FAC TAD ACLO /P@ LOW ORDER RIGHT RAR DCA ACLO /STORE BACK ISZ ACX /BUMP EXPONENT NOP TAD ACH 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 ACLO /YES-MAKE WHOLE THING ZERO DCA ACH JMS I DV24P /DIVIDE EXTENDED REM. BY HI DIVISOR TAD ACLO /NEGATE THE RESULT CLL CMA IAC DCA ACLO SNL /IF QUOT. IS NON-ZERO, SUBTRACT CMA /ONE FROM HIGH ORDER QUOT. JMP DVL1 /GO TO IT *5555 BLZERO, 0 CLA CMA TAD I WORD1 DCA XR1 TAD K7400 DCA CNOBML TAD CTRLZK CDF 10 DCA I XR1 ISZ CNOBML JMP .-2 CDF JMP I BLZERO CTRLZK, 232 CNOBML, 0 TAD I WORD0 /HEADER WORD TAD K0100 /ADD 1 TO THE COUNT BITS DCA I WORD0 JMP I CNOBML /DONE PAGE /FLOATING MULTIPLY-DOES 2 24X12 BIT MULTIPLIES FFMPY, 0 JMS I PATCHP /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 ACLO /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 ACLO /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 ACLO /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 ACLO /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 ACLO /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 PATCHP /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+ACLO)/OPH TAD ACLO /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,ACLO 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 ACLO 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 ACLO /SHIFT FAC LEFT 1 BIT-ALSO SHIFT RAL /1 BIT OF QUOT. INTO LOW ORD OF ACLO DCA ACLO 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 PATCHP /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 ACLO /GET LOW ORDER MANTISSA RAL /SHIFT LEFT DCA ACLO /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 ACLO /GET LOW ORDER RAR /SHIFT IT DCA ACLO /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,ACLO / DBAD, CLA CLL /NECESSARY SO WE DON'T GET OVRFLO AGAIN JMP I DBAD1P /GO ZERO ALL / /FLOATING SUBTRACT / FFSUB, 0 JMS I PATCHP /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 ACLO /GET LOW ORDER FAC CLL CMA IAC /NEGATE IT DCA ACLO /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 ACLO DCA ACLO RAL TAD OPH /ADD HI ORDER MANTISSAS TAD ACH DCA ACH JMP I OADD /RETN. DBAD1P, DBAD1 FNORP, FFNOR > XLIST 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 / ACLO=LORD TM=TEMP4 ENPUNCH *4600 / /FLOATING OUTPUT ROUTINE / FFOUT, 0 SWAB /ALSO DOES MQL TO CLR. AC DCA SIGN /CLEAR SIGN AND COUNT WORDS DCA KNT TAD EFLG /IS THIS E FORMAT? SZA CLA JMP FFMT /NO-F FORMAT CLL CML IAC RTL /YES-MAKE A 6 DCA DADP /STORE AS # OF DIGITS AFT DEC PT TAD K16 /SET FIELD WIDTH TO 14 ( DECIMAL) DCA FLDW FFMT, CDF /CHANGE TO FIELD OF PACKAGE TAD KM7 /SET # OF SIGNF. DIGITS DCA I DCNTP /TO 6 (DON'T PRINT 7TH) TAD ACH /DETERMINE IF #=0 SNA JMP FOUT3 /YES-SKIP DOWN SMA CLA /NO-IS IT NEGATIVE? JMP .+3 /POSITIVE ISZ SIGN /NEGATIVE-SET FLAG JMS I FFNGP /AND NEGATE # FOUT1, TAD ACX /GET # INTO RANGE .1<=N<1 SMA SZA CLA /IS EXP. NEG.? JMP FOUT2 /NO-GO ON JMS I FFMPP /YES-MAKE # GREATER THAN 1 TEN /BY MULTIPLYING BY TEN (DEC.) ISZ KNT /COUNT THE MULTIPLIES JMP FOUT1 /SEE IF >1 YET FOUT2, JMS I SEP /# IS >1-MAKE IT LESS THAN 1 JMS I FFPUTP /STORE IN A TEMPORARY TM3 DCA ACX /SET FAC TO .5 CLL CML RTR DCA ACH DCA ACLO TAD EFLG /IS THIS E FORMAT? SZA CLA TAD KNT /NO-GET COUNT OF MULTIPLIES CMA IAC /NEGATE IT TAD DADP /AND ADD # OF DIGITS AFT. DC. PT. SMA /MUST BE NEGATIVE CMA TAD KK7 /LIMIT # OF DIVS TO 7 SPA CLA TAD KM7 /RESTORE DCA I SEP /STORE AS COUNTER JMP .+3 JMS I FFDVP /DIVIDE .5 BY TEN THAT # OF TIMES TEN ISZ I SEP /DONE? JMP .-3 /NO-GO ON JMS I FFADP /YES-ADD IN ORIG.#-THIS IS ROUNDING TM3 JMS I SEP /INSURE THAT IT IS IN RANGE FOUT4, TAD ACX /GET EXPONENT CMA IAC /USE AS COUNT FOR SHIFTING MANT. DCA FOUT5 DLD /PICK UP MANTISSA ACH SWP SHL /PUT IN CORRECT ORDER 1 /SHIFT LEFT 1(FOR 0 EXP.) LSR /NOW SHIFT RIGHT ACCORD TO EXP. FOUT5, 0 DCA ACH /STORE BACK SWP DCA ACLO FOUT3, TAD KNT /DONE-GET COUNT OF MULS. DCA OPX /PRESERVE IT TAD EFLG /IS THIS E FORMAT OUT? SZA CLA JMP NOTE /NO DCA KNT /YES-ZERO COUNT TAD KM7 /GET MINUS 7-FOR 2 SIGNS,PT,+EXP JMP ADFW /GO ADD FIELD WIDTH NOTE, TAD KNT /GET COUNT OF MULTIPLIES SMA /IF NOT NEG-MAKE = -2 CLA CMA TAD M1 /MINUS 1 FOR DEC.PT ADFW, TAD FLDW /GET THE FIELD WIDTH CMA IAC /NEGATE IT TAD DADP /ADD DIGITS AFTER DEC. PT SMA /NEG? JMP I PRNTXP /NO-PRINT XS-NOT ENUFF ROOM DCA I SEP /STORE AS CNT OF SPACES JMP .+3 TAD KK240 JMS I OUTP /PRINT A SPACE ISZ I SEP /DONE? JMP .-3 /NO-GO ON TAD SIGN /YES-GET SIGN CLL RAL /MAKE A ZERO OR 2 TAD K253 /FOR PLUS OR MINUS JMS I OUTP /PRINT SIGN TAD KNT /GET MUL COUNT SMA JMP I PRZROP /PRINT LEADING ZERO CMA IAC JMS I DGTYPP /OUTPUT 'KNT' DIGITS PRDCP, TAD DADP /DON'T PRINT DEC. PT SNA CLA /IF DADP IS 0 JMP I GKNTP JMP I PDPP PRZROP, PRZRO PDPP, PDP K16, 16 GKNTP, GKNT FLINK, JMP I FFOUT PRNTXP, PRNTX K253, 253 PRP, PR DCNTP, DCNT M1, 7777 KK7, 7 DGTYPP, DGTYP OUTP, OUT KK240, 240 KM7, -7 FFADP, FFADD FFDVP, FFDIV FFPUTP, FFPUT SEP, SE FFMPP, FFMPY FFNGP, FFNEG KNT, 0 SIGN, 0 PAGE PDP, CLA CLL CMA RAL JMS OUTDG /PRINT DEC. PT. GKNT, TAD I KNTP /GET COUNT AGAIN SPA SNA CLA JMP GD TAD I KNTP /GET COUNT CMA /NEGATE DCA DGTYP /STORE AS COUNTER TAD DADP CMA /SAME FOR DADP DCA SE JMP PR /GO ON PZR, JMS OUTDG /PRINT A ZERO PR, ISZ DGTYP SKP JMP PS ISZ SE JMP PZR PS, TAD I KNTP CMA IAC GD, TAD DADP SMA SZA JMS DGTYP TAD EFLG SZA CLA JMP DONEF /DONE TAD K305 /PRINT 'E' JMS OUT TAD OPX /GET PRESERVED COUNT OF MULS SMA SZA CLA /DETERMINE SIGN CLA IAC RAL /MAKE A 2 TAD P253 /PRINT MINUS OR PLUS SIGN JMS OUT TAD OPX /GET THE COUNT SPA CMA IAC /NEGATE IF NEGATIVE MQL DVI /DIVIDE BY ONE HUNDRED K144 SWP /QUOT TO AC, REM TO MQ JMS OUTDG /THIS IS FIRST DIG-PRINT IT DVI /DIVIDE REM BY TEN K12 SWP /GET SECOND DIGIT JMS OUTDG /PRINT IT SWP JMS OUTDG /PRINT LAST DONEF, TAD SWIT2 /SHOULD WE PRINT CR/LF? SNA CLA JMP I FLING /NO TAD KK215 JMS OUT TAD K212 JMS OUT JMP I FLING / /ROUTINE TO GET FAC<1 / SE, 0 SE1, TAD ACX SPA SNA CLA /#>1? JMP I SE /NO-RETN. JMS I FFDV /YES-DIV. BY TEN TEN CMA TAD I KNTP /REDUCE KNT BY 1 DCA I KNTP JMP SE1 / /OUTPUT DIGITS OF FAC BY MULTIPLYING BY TEN /THE HIGH ORDER OVERFLOW IS THE DIGIT DGTYP, 0 CMA IAC DCA SE /STORE COUNT PASSED SWAB /MODE B OF EAE DT1, TAD ACLO /GET LOW ORDER FAC MQL MUY /MUL BY TEN K12 SWP /NEW ACLO TO AC DCA ACLO /STORE IT BACK TAD ACH /GET ACH-SEND TO MQ, AND SWP MUY /HI ORD. OVERFLO OF MUY TO AC K12 /MULT BY TEN, OVRFLO IS ADDED ISZ DCNT /DONE ALL SIGNIF. DIGS.? JMP .+3 /NO-GO ON CLA CMA /YES-PRINT ZEROS DCA DCNT /FROM NOW ON JMS OUTDG /PRINT DIGIT (HI ORD. OVRFLOW) SWP /NEW ACH IS IN MQ DCA ACH /STORE IT ISZ SE /DONE REQUIRED? JMP DT1 /NOPE JMP I DGTYP /YUP PRNTX, CLA TAD FLDW /GET FIELD WIDTH CMA /MUST BE NEGATIVE DCA SE /USE AS COUNTER PRNTX1, ISZ SE /DONE ALL? SKP /NO-GO ON JMP DONEF /YES-RETN. TAD K252 JMS OUT /PRINT ASTERISK JMP PRNTX1 K252, 252 /ASTERISK PRZRO, CLA /CLR. GARBAGE JMS OUTDG /PRINT ZERO JMP I PRDCPP /PRINT DEC. PT. (MAYBE) PRDCPP, PRDCP / /OUTPUT ROUTINE / OUT, 0 DCA I XR3 /STORE IN INTERMEDIATE BUFFER JMP I OUT / /OUTPUT DIGIT / OUTDG, 0 TAD P260 JMS OUT JMP I OUTDG /RETN KNTP, KNT KK215, 215 K212, 212 TM3, 0 0 0 DCNT, 0 /COUNT OF SIGNF. DIGITS K305, 305 P260, 260 FFDV, FFDIV P253, 253 FLING, FLINK K144, 144 / /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 ACLO 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 FPUTL /STORE IT AWAY FPPTM1 JMS I FGETL /GET NEW DIGIT TP JMS I FNORL /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 GETCHL /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 SNA CLA /IS IT A SPACE? JMP INPUT+1 /YES-IGNORE IT IOUT, JMP I INPUT /RETURN M240, -240 / /ROUTINE TO DECIDE CALLING MODE IN LIEU OF "SPECIAL MODE" PROBLEMS / *5364 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 PATCHP /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 PATCHP /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 ACLO DCA OPL /STORE ACLO IN OPL TAD OPH /OPH TO MQ FOR LATER SWP DCA ACLO /STORE OPL IN ACLO 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 *5555 BLZERO, 0 CLA CMA TAD I WORD1 DCA XR1 TAD K7400 DCA CNOBML TAD CTRLZK CDF 10 DCA I XR1 ISZ CNOBML JMP .-2 CDF JMP I BLZERO CTRLZK, 232 CNOBML, 0 TAD I WORD0 /HEADER WORD TAD K0100 /ADD 1 TO THE COUNT BITS DCA I WORD0 JMP I CNOBML /DONE / /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 PATCHP /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 ACLO 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 ACLO /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 ACLO /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 ACLO /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 / ACLO CONTAINS HIGH ORDER JMP I MDSET /RETURN / /FLOATING DIVIDE / *5722 FFDIV, 0 JMS I PATCHP /WHICH MODE? TAD I FFDIV /CALLED BY USER-GET ARG. ADDRESS JMS MDSET /GET ARG. AND SET UP SIGNS FFD1, DVI /DIVIDE-ACH AND ACLO 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 ACLO 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 PATCHP /WHICH MODE OF CALLING TAD I FFADD /CALLED DIRECTLY BY USER JMS I ARGETP /PICK UP ARGUMENTS CDF /CHANGE TO CURRENT DATA FIELD 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 ACLO 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 ACLO /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 PATCHP /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 / /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 ACLO 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 NOPUNCH > PAGE XLIST /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 > XLIST IFNZRO EAE < ENPUNCH *. SWAB /OPH INTO MQ BECAUSE EAE ROUTINES MQA /EXPECT TO FIND IT THERE NOPUNCH > XLIST 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 ACLO /YES-HOW ABOUT LOW? SNA TAD AC1 /LOW=0, IS OVRFLO BIT ON? SNA CLA JMP ZEXP /#=0-ZERO EXPONENT NORMLP, CLA CLL CML RTR /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 ACLO /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 > XLIST IFNZRO EAE < ENPUNCH / /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 ACLO CLA SCA /STEP COUNTER TO AC CMA IAC /NEGATE IT TAD ACX /AND ADJUST EXPONENT DCA ACX JMP I FFNOR /RETURN NOPUNCH > XLIST / /FLOATING GET / *6241 FFGET, 0 JMS I PATCHP /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 ACLO TAD OPH DCA ACH ISZ FFGET CDF JMP I FFGET /RETN. TO CALL +2 / /FLOATING PUT / FFPUT, 0 JMS I PATCHP /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 ACLO 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 FCLR /RETURN 0 IN FAC JMP I ILOOPL LM, JMS I ERROR /ILLEGAL ARGUMENT /CARRIAGE RETURN FUNCTION (KNOWN ONLY TO COMPILER FOR TERMINATING /PRINT STATEMENTS) CRFUNC, 0 TAD I WORD0 CLL RTR SNL CLA JMS I FTYPL /IS FILE NUMERIC? JMP I ILOOPL /YES-WE DON'T WANT TO OUTPUT CRLF JMS I CRLF /DO AS WE ARE TOLD JMP I ILOOPL /NEXT INST *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 SKP /CRLF ONLY NECESSARY ON FLUSH LFLUSH, JMS I CRLF /PRINT A CR,LF TAD K277 /PRINT A ? SIGNIFYING WAIT FOR INPUT JMS I XPUT TAD I WORD1 /BUFFER ADDRESS DCA I WORD3 /INITIALIZE POINTER TO START OF BUFFER JMS I CNOCLL /INITIALIZE CHAR # TO 1 TTYIN, JMS I PRINT /EMPTY TTY BUFFER BEFORE AWAITING INPUT JMP .-1 TAD K5252 /DESIGN INTO AC KSFA, KSF /CHAR READY? JMP SPIN /NO-DIDDLE WHILE WE WAIT CLA CLL /FLUSH SPINNER OUT OF AC TAD K0200 /FORCE PARITY BIT KRS /GET CHAR DCA CHAR /SAVE TAD CHAR JMS I XPUT /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 PACKL /PACK CHAR IN BUFFER JMS I BUFCHL /BUFFER FULL? JMP I IOLK /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 IOLK, IO K5252, 5252 K277, 277 BACKUP, TAD I WORD3 /BUFFER POINTER CIA /NEGATE TAD I WORD1 /COMPARE AGAINST START OF BUFFER SNA CLA /BUFFER EMPTY? JMP TTYIN /YES-THERE IS NOTHING TO RUBOUT TAD K334 JMS I XPUT /ECHO "\" JMS I CHRNOL /GET CHAR # OF NEXT CHAR (LAST #+1) JMP C1B /1 JMP C3B /3 JMS I CNOCLL /IT WAS 2-MAKE IT 1 PBACK, CLA CMA /-1 TAD I WORD3 /BACK UP BUFFER POINTER DCA I WORD3 JMP TTYIN /NEXT CHAR K334, 334 C1B, TAD I WORD0 AND K7477 TAD K0200 /IT WAS 1-MAKE IT 3 DCA I WORD0 JMP TTYIN /NO NEED TO BACK UP POINTER C3B, TAD I WORD0 AND K7477 TAD K0100 /IT WAS 3,MAKE IT 2 DCA I WORD0 JMP PBACK /BACK UP POINTER CR, JMS I CRLF /ECHO A CR,LF TAD K4 TAD TTYDRI /BUMP DRIVE RETURN TO NORMAL DCA TTYDRI TAD CHAR JMS I PACKL /PACK CHAR IN BUFFER TAD I WORD1 DCA I WORD3 /INITAILZE BUFFER POINTERS JMS I CNOCLL 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 /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 K0017 /MASK THEM OFF JMP I FBITGT /RETURN /GOSUB POP ROUTINE-ROUTINE TO POP ELEMENT OFF GOSUB STACK POPG, 0 TAD GSP /GET GOSUB STACK POINTER TAD MSTTOP /COMPARE AGAINST TOP OF STACK SPA CLA /ATTEMPT TO POP OF EMPTY STACK? GR, JMS I ERROR /YES-RETURN WITHOUT A GOSUB TAD I GSP /GET TOP STACK ELEMENT DCA TEMP1 /SAVE CLA CMA /-1 IN AC TAD GSP /BACK UP GOSUB STACK POINTER DCA GSP TAD TEMP1 /GET POPPED ELEMENT IN AC JMP I POPG /RETURN MSTTOP, -GSTCK /GOSUB RETURN RETRNI, JMS POPG /POP PC OFF GOSUB STACK IAC /BUMP OVER SECOND WORD OF GOSUB INST DCA I INTPLK /USE AS NEW PSEUDO-PC JMS POPG /POP CDF OFF STACK DCA I CDFPSL /PUT IN LINE IN PWFECH JMP I ILOOPL /RETURN TO ILOOP /DATA LIST READ (NUMERIC) RDLIST, JMS I DLRELK /FETCH WORD FROM LIST DCA EXP /STORE AS EXPONENT JMS I DLRELK DCA HORD /HIGH MANTISSA JMS I DLRELK DCA LORD /LOW MANTISSA JMP I ILOOPL DLRELK, DLREAD /SUBROUTINE FTYPE-RETURNS TO CALL+1 IF FILE NUMERIC,CALL+2 IF ASCII FTYPE, 0 TAD I WORD0 /GET HEADER CLL RAR /TYPE TO LINK SZL CLA /IS IT NUMERIC? ISZ FTYPE /NO-BUMP RETURN JMP I FTYPE /RETURN INTPLK, INTPC 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 ILOOPL /NO-ALL BUFFERS ARE FREE-START INTERPRETER TAD PSSTRT CLL CMA TAD K0400 SNL CLA /IS START OF PSEUDO-CODE BELOW 400 JMP CHKB2 /NO-CHECK FOR 1000 TAD K0017 /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 ILOOPL /NO-START INTERPRETER-ALL BUFFER FREE TAD K0010 /YES-BUFFERS 1,2, AND 3 AVAILABLE BAS, DCA BMAP JMP I ILOOPL /START INTERPRETER 0 MCDF1, -6211 K2000, 2000 C14, 14 C16, 16 C1000, 1000 C1400, 1400 0 0 0 0 0 0 0 0 TTYEND, 0 KM400=K7400 /*************************************************************** /SUBROUTINE CHARNO-RETURNS TO CALL+1 IF CHAR #=1,CALL+2 IF 3,CALL+3 /IF 2 CHARNO, 0 TAD I WORD0 /HEADER AND K300 /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 K300, 300 /ERROR MESSAGE FOR TTY INPUT OVERFLOW IO, JMS I ERROR /LINE FULL JMP I .+1 /FLUSH BUFFER AND TRY AGAIN LFLUSH *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 0 0 0 0 0 0 0 0 FILE1, 0 /FILE #1 0 0 0 0 0 0 0 0 0 0 0 0 FILE2, 0 /FILE #2 0 0 0 0 0 0 0 0 0 0 0 0 FILE3, 0 /FILE #3 0 0 0 0 0 0 0 0 0 0 0 0 FILE4, 0 /FILE #4 0 0 0 0 0 0 0 0 0 0 0 0 $