.TITLE INTERPRETER PROGRAM FOR PSEUDO-OPERATION OPCODES / / 19 JUN 75 (JAF) CORRECTLY LOAD IMAGINARY PART OF DOUBLE COMPLEX / INTO ACCUMULATOR B. / 18 SEP 73 (JAF) CORRECT 'GETCNT' FOR PDP-15 / 12 SEP 73 (PDH) REMOVE .SNAFU; TIDY UP COMMENTS / 28 MAY 73 (PDH) MOVE CONSTANT TABLES TO EXTERNAL FILE / 13 APR 73 (PDH) CHANGE ERROR HANDLING / / MACROS FOR CONDITIONAL PDP-15 ASSEMBLY / .DEFIN .LACI,A .IFDEF PDP15 LAC* A .ENDC .ENDM / / .DEFIN .AND,A .IFDEF PDP15 AND A .ENDC .ENDM / / EXTERNAL GLOBALS .GLOBL .OPST,FET.X,.ERROR,.NERR,.RTRN2,.RTRN4 / EXTERNAL CONSTANT TABLES .GLOBL .CE25,.MSQ2O2,.DC8,.RT216,.LOG2,.LN2 .GLOBL .MPT16,.MPT63,.T,.S,.A,.B,.C,.C1,.C2,.C3,.C4 / / / INTERNAL GLOBALS / ARITHMETIC ACCUMULATORS .GLOBL .MODEA,.SIGNA,.EXPA,.MOSTA,.LESTA,.A3,.A4 .GLOBL .SGNIA,.EXPIA,.MSTIA,.LSTIA,.AI3,.AI4 .GLOBL .MODEB,.SIGNB,.EXPB,.MOSTB,.LESTB,.B3,.B4 .GLOBL .SGNIB,.EXPIB,.MSTIB,.LSTIB,.BI3,.BI4 .GLOBL .INT1,.INT2,.LOGAC / SUBROUTINES (ARITHMETIC) .GLOBL .SPRML,.SPRDV,.SPADD,.SPRST,.SPRLD .GLOBL .DPRML,.DPRDV,.DPADD,.DPRST,.DPRLD .GLOBL .DPSER,.DBNRM,.FLOTA,.FLOTB,.FIX .GLOBL .LDREL,.LDDBL,.LODBD,.LODBS,.CMPLA,.CMPLB .GLOBL .LOAD1,.RVRSG,.ZRVAL,.ZROIA,.PICK1,.PICK2 / SUBROUTINES (OTHER) .GLOBL .STORE,.CHRGT,.CMPIT,.LDPT5,.PSHBA .GLOBL .SWPIT,.SWPUS,.SWPBI,.SWPIB,.SPBIA,.MVIMA / FUNCTIONS (WITH ENTRANCES FOR MACRO) .GLOBL .IABS,.FLOAT,.IFIX,.SNGL,.ALG10 .GLOBL .SPXP2,.DPXP2,.SPLG2,.DPLG2 / REFERENCED LOCATIONS .GLOBL L.BOX,.TABLE,.BOX,.ADDR1,.ADDR2,.CNTR / ENTRY POINTS .GLOBL .NEXT,.NEXT2,.STORP,.STORN,.LOADS,.NEXT1,.NEXT3,.ILMDE .EJECT / DEFINITION OF FLOATING ACCUMULATORS / ACC A MODEA;SIGNA;EXPA;MOSTA;LEASTA;A3;A4;SIGNIA;EXPIA;MOSTIA;LESTIA;AI3;AI4 / ACC B MODEB;SIGNB;EXPB;MOSTB;LEASTB;B3;B4;SIGNIB;EXPIB;MOSTIB;LESTIB;BI3;BI4 / DEFINITION OF INTEGER ACCUMULATOR INT1;INT2 / LOGICAL ACC LOGACC / / EQUIVALENCES FOR GLOBALING .MODEA=MODEA;.SIGNA=SIGNA;.EXPA=EXPA;.MOSTA=MOSTA;.LESTA=LEASTA .A3=A3;.A4=A4;.SGNIA=SIGNIA;.EXPIA=EXPIA;.MSTIA=MOSTIA;.LSTIA=LESTIA .AI3=AI3;.AI4=AI4 .MODEB=MODEB;.SIGNB=SIGNB;.EXPB=EXPB;.MOSTB=MOSTB;.LESTB=LEASTB .B3=B3;.B4=B4;.SGNIB=SIGNIB;.EXPIB=EXPIB;.MSTIB=MOSTIB;.LSTIB=LESTIB .BI3=BI3;.BI4=BI4 .INT1=INT1;.INT2=INT2;.LOGAC=LOGACC / / LOCATIONS FOR DIVIDE ROUTINES / DPDSTA .BLOCK 5 / / STORAGE FOR COMPLEX MULTIPLY AND DIVIDE / SIGNS .BLOCK 5 SIGNH .BLOCK 5 SIGND .BLOCK 5 SIGNE .BLOCK 5 / ERROR LAW 25 JMP* .NERR / / TABLE ADDRESS - MUST BE INSERTED AT EXECUTION TIME TABLE 0 .TABLE=TABLE / / STORAGE LOCATIONS / INTMA;INTMB;INTM3;INTM4 BOX;CNTRL;MOVCNT SIZE;BOXX .BOX=BOX / / THIS SUBROUTINE MOVES DATA FROM B PSEUDO-ACCUMULATOR TO / A PSEUDO-ACCUMULATOR, GIVEN THE MODE BITS RIGHT JUSTIFIED / IN THE AC. IT RETURNS WITH THE MODE IN THE AC. .PSHBA XX TAD (XCT .LOADS DAC .+1 XX / PERFORM ENTRY TO LOAD ROUTINE LAC MODEA / GET MODE JMP* .PSHBA .EJECT / / OPERATION CODE INTERPRETER DISPATCH ROUTINE / / THIS SECTION DECODES NON-ARITHMETIC OPERATIONS / NOARIT CLLS 6 / GET OPCODE ADD .OPST / LOCATION OF ADDRESS TABLE DAC TIE+1 JMP* TIE+1 / GO TO EXECUTION ROUTINE / THIS SECTION DECODES ALL ARITHMETIC OPCODES AND LOADS ACCUMULATOR / B WITH THE ARGUMENT. / TIE DAC .+1 /GET ENTRY XX /EXECUTE IT /PICK UP NEXT INSTRUCTION ,GET DATA AND ENTER SUBROUTINE / ALSO ENTRY POINT FOR INTERPRETER / / .NEXT LAC* AUTO1 /GET NEXT INSTRUCTION GSLMQ /BIT 0 TO LINK,SAVE INST. IN MQ .NEXT3 AND (7777 /ADDRESS ADJUSTMENT REMAINS TAD TABLE /ADD BASE ADDRESS OF ADDRESS TABLE .NEXT1 DAC BOX /LOCATION IN ADDRESS TABLE L.BOX LAC* BOX / GET TRUE ADDRESS FROM TABLE .AND (077777 / REMOVE UPPER MOST BITS FOR PDP-15 DAC* (AUTO2 SZL / LINK IS ZERO IF ARITHMETIC INSTRUCTION JMP NOARIT / GO TO SORT OUT NON-ARITHMETIC ROUTINE .LACI BOX / REGAIN MODE BITS FOR PDP-15 /TEST MODE BITS TO FIND CORRECT LOADING ROUTINE .NEXT2 SPA!RAL /MODE BITS ARE STILL IN AC JMP TEMPOR /COMPLEX LOGICAL OR CHARACTER SMA!RAL /NOTE IF EXIT TO INTGR L=0 JMP INTGR /INTEGER,SINGLE OR DOUBLE SPA!CLL!CML JMP DOUBLE /DOUBLE PRECISION FLOATING POINT /ARGUMENT IS REAL-BREAK INTO FORM FOR ARITHMETIC LAC* AUTO2 /GET FIRST WORD(LINK IS SET) RAR /SIGN TO LINK, 1 TO ACO DAC MOSTB /MOST SIGNIFICANT PORTION OF FRACTION CLA!RAR /GET SIGN BIT DAC SIGNB /SET FRACTION SIGN LAC* AUTO2 /GET NEXT WORD DAC EXPB /SAVE IT AND (777000 /SET TRAILING NINE BITS TO ZERO DAC LEASTB /LEAST SIGNIFICANT PART OF FRACTION XOR EXPB /GET EXP. SIGN AND MAG. CLL!RAR /EXPONENT SIGN TO LINK SAD (377 /IS IT ZERO OR INFINITY (8 BITS) JMS ZERINF /GENERATE ZERO OR INFINITY SZL /IS EXPONENT NEGATIVE CMA /YES-FROM ONE'S COMPLIMENT DAC EXPB /EXPONENT REALTY CLLS 6 /GET OP CODE FROM MQ CLL!RAL /LEAVE SPACE FOR MODE TYPE RTL ADD (XCT SUBR+2 /LOCATE ENTRY IN SUBROUTINE TABLE JMP TIE /GO TO EXECUTE IT /GENERATE ZERO OR INFINITY IN REAL OR DOUBLE PRECISION ZERINF XX /RETURN ADDRESS SZL!CLA!CMA /TEST SIGN AND SET AC TO 1'S CLA /NEGATIVE - SET AC TO ZEROS DAC MOSTB /SET FRACTION TO ALL 0'S 0R 1'S DAC LEASTB DAC B3 DAC B4 LAC (377777 JMP* ZERINF /MAXIMUM EXPONENT /ARGUMENT IS DOUBLE PRECISION-BREAK INTO FORM FOR ARITHMETIC DOUBLE LAC* AUTO2 RAR DAC MOSTB CLA!RAR DAC SIGNB LAC* AUTO2 DAC LEASTB LAC* AUTO2 DAC B3 LAC* AUTO2 DAC EXPB AND (777000 DAC B4 XOR EXPB CLL!RAR SAD (377 JMS ZERINF SZL CMA DAC EXPB DBLTY CLLS 6 CLL!RAL RTL ADD (XCT SUBR+3 JMP TIE /ARGUMENT IS INTEGER-SET PRECISION INDICATOR / LINK IS ZERO ON ENTRY TO INTGR FOR INTEGERS / COMPLEX ROUTINES ENTER WITH L=1 INTGR SPA!CLA /TEST FOR SINGLE OR DOUBLE, CLEAR AC INTGRD LAC (2000 /DOUBLE , SET AC TO 2000 LLS 6 /SHIFT IN OP CODE RAL /ROTATE MODE BITS IN (L=0 FOR INTEGER RTL /1 FOR COMPLEX ADD (XCT SUBR /LOCATE ENTRY IN OP. TABLE JMP TIE /ARGUMENT IS COMPLEX, LOGICAL OR TEMPORARY ACCUMULATOR COMPLX DAC CNTRL /SAVE DATA (BIT 0=1 FOR DOUBLE) CLL!CML /SET LINK LAC* AUTO2 /GET MOST SIGNIFICANT PART & SIGN RAR DAC MOSTB CLA!RAR DAC SIGNB LAC CNTRL /RETRIEVE DATA SMA!RAL /SINGLE OR DOUBLE JMP CMPTIE /SINGLE-GO ON DOWN LAC* AUTO2 /DOUBLE-STORE NEXT TWO WORDS DAC LEASTB LAC* AUTO2 DAC B3 CMPTIE LAC* AUTO2 /GET LAST WORD OF REAL PART DAC EXPB AND (777000 SNL /SINGLE OR DOUBLE PRECISION DAC LEASTB /SINGLE (ONLY) DAC B4 /DOUBLE(ALWAYS, INFINITE) XOR EXPB CLL!RAR SAD (377 JMS ZERINF SZL!CLL!CML /SET LINK WHILE TESTING EXPONENT SIGN CMA DAC EXPB LAC* AUTO2 /NOW DO IMAGINARY PART RAR /SIGN TO LINK, 1 TO ACO FROM LINK DAC MOSTIB CLA!RAR DAC SIGNIB LAC CNTRL SMA!RAL JMP CMP5 LAC* AUTO2 DAC LESTIB LAC* AUTO2 DAC BI3 CMP5 LAC* AUTO2 DAC EXPIB AND (777000 SNL DAC LESTIB DAC BI4 XOR EXPIB CLL!RAR SAD (377 JMP CMP8 CMP9 SZL!CLL!CML /L=1 FOR ENTRY TO INTGR CMA DAC EXPIB LAC CNTRL JMP INTGR CMP8 SZL!CLA!CMA CLA DAC MOSTIB DAC LESTIB DAC BI3 DAC BI4 LAC (377777 JMP CMP9 /LOGICAL,CHARACTER OR TEMPORARY ACCUMULATOR LOGT CLLS 6 /SET UP FOR LOGICAL OR CHARACTER DATA CLL!RAL RTL ADD (XCT SUBR+6 /LOCATE ENTRY IN OP.TABLE JMP TIE /GO TO EXECUTE IT /RECOVER TEMPORARY ACCUMULATOR TEMPOR SMA!RAL JMP COMPLX SMA JMP LOGT /START RECOVERING LAC* AUTO2 /MODE SPA!RTL JMP TEMP3 /COMPLEX OR CHARACTER SNA!RAL /PRECISION BIT TO LINK JMP INTGRD /DOUBLE INTEGER LAC* AUTO2 DAC SIGNB /SIGN LAC* AUTO2 DAC EXPB /EXPONENT LAC* AUTO2 DAC MOSTB LAC* AUTO2 DAC LEASTB SNL JMP REALTY LAC* AUTO2 DAC B3 LAC* AUTO2 DAC B4 JMP DBLTY TEMP3 SZL!RAL /PRECISION BIT TO LINK JMP CHARAC LAC* AUTO2 DAC SIGNB LAC* AUTO2 DAC EXPB LAC* AUTO2 DAC MOSTB LAC* AUTO2 DAC LEASTB SNL /CHECK PRECISION BIT JMP TEMP2 /SINGLE LAC* AUTO2 /DOUBLE DAC B3 LAC* AUTO2 DAC B4 TEMP2 LAC* AUTO2 DAC SIGNIB LAC* AUTO2 DAC EXPIB LAC* AUTO2 DAC MOSTIB LAC* AUTO2 DAC LESTIB SNL!CLL!CML!CLA /SET LINK TO 1,AC=0 JMP INTGRD+1 /CALCULATE XCT SUBR+5+OP CODE*8 LAC* AUTO2 DAC BI3 LAC AUTO2 DAC BI4 JMP INTGRD /CALC XCT SUBR+4 + OP. CODE*8 / / PROCESS CHARACTER CONSTANT. IT IS EITHER / 7XXXXX, DATA POINTER / 6XXXXX, DATA / CHARAC JMS GETCNT CLLS 6 CLL!RAL RTL ADD (XCT SUBR+7 JMP TIE / / THIS SUBROUTINE GETS THE # OF CHARS/ELEMENT FOR CHARACTER / CONSTANTS AND VARIABLES. GETCNT XX SNL!CLL!RAR JMP CHAR2 CLL!RAR CLL!RAR DAC SIGNB /CHARACTER COUNT LAC* AUTO2 .AND (077777 DAC* (AUTO2 JMP* GETCNT CHAR2 CLL!RAR CLL!RAR DAC SIGNB JMP* GETCNT .EJECT / / THIS TABLE IS USED TO ACCESS THE ARITHMETIC ROUTINES. A JMS IMPLIES / THAT ROUTINE IS OF NECESSITY A SUBROUTINE. /SUBROUTINE ENTRY TABLE SUBR JMS INTADD /INTEGER ADD OPCODE 00 JMS DINTAD /DOUBLE INTEGER JMS ADDRL /REAL JMS ADDBL /DOUBLE PRECISION JMS ADDCPX /COMPLEX JMS ADDDCP /DOUBLE INTEGER JMP LOGOR /LOGICAL OR JMP ERROR /TEMPORARY AC JMS INTSUB /SUBTRACT OPCODE 01 JMS DINTSB JMS SUBRL JMS SUBDBL JMP SUBCPX JMP SUBDPX JMP LOGORN / OR NEGATIVE JMP ERROR JMP INTRSB /REVERSE SUBTRACT OPCODE 02 JMP DINTRS JMP RSBRL JMP RSBDBL JMP RSBCPX JMP RSBDPX JMP LORORN / REVERSE OR NEGATIVE JMP ERROR JMP INTMUL /MULTIPLY OPCODE 03 JMP DINTML JMP MULRL JMP MULBL JMS MULCPX JMS MULDCP JMP LOGAND /LOGICAL AND JMP ERROR DENTRY JMP INTDIV /DIVIDE OPCODE 04 JMP DINTDV JMP DIVRL JMP DIVBL JMS DIVCPX JMS DIVDCP JMP ERROR JMP ERROR JMP RINTDI /REVERSE DIVIDE OPCODE 05 JMP RDINTD JMP RDIVRL JMP RDIVDB JMP RDIVCX JMP RDIVDC JMP ERROR JMP ERROR JMP INTEXP /EXP OPCODE 06 JMP DNTEXP JMP RELEXP JMP DBLEXP JMP ERROR JMP ERROR JMP ERROR JMP ERROR JMP RINTXP /REXP OPCODE 07 JMP RDNTXP JMP RRELXP JMP RDBLXP JMP ERROR JMP ERROR JMP ERROR JMP ERROR JMP INTXPN /EXPN OPCODE 10 JMP DNTXPN JMP RELXPN JMP DBLXPN JMP ERROR JMP ERROR JMP ERROR JMP ERROR JMP RINTXN /REXPN OPCODE 11 JMP RDNTXN JMP RRELXN JMP RDBLXN JMP ERROR JMP ERROR JMP ERROR JMP ERROR JMP NINTXP /NEXP OPCODE 12 JMP NDNTXP JMP NRELXP JMP NDBLXP JMP ERROR JMP ERROR JMP ERROR JMP ERROR JMP RNINTX /RNEXP OPCODE 13 JMP RNDNTX JMP RNRELX JMP RNDBLX JMP ERROR JMP ERROR JMP ERROR JMP ERROR JMP NINTXN /NEXPN OPCODE 14 JMP NDNTXN JMP NRELXN JMP NDBLXN JMP ERROR JMP ERROR JMP ERROR JMP ERROR JMP RNINXN /RNEXPN OPCODE 15 JMP RNDNXN JMP RNREXN JMP RNDBXN JMP ERROR JMP ERROR JMP ERROR JMP ERROR GTN JMP GREAT /GTN ROUTINES OPCODE 16 JMP GREAT JMP GREAT JMP GREAT JMP ERROR JMP ERROR JMP ERROR JMP ERROR JMP GREAT /GT ROUTINES OPCODE 17 JMP GREAT JMP GREAT JMP GREAT JMP ERROR JMP ERROR JMP ERROR JMP GREAT / CHARACTER LTN JMP LESS /LTN ROUTINES OPCODE 20 JMP LESS JMP LESS JMP LESS JMP ERROR JMP ERROR JMP ERROR JMP ERROR JMP LESS /LT ROUTINES OPCODE 21 JMP LESS JMP LESS JMP LESS JMP ERROR JMP ERROR JMP ERROR JMP LESS / - CHARACTER EQN JMP EQUAL /EQN ROUTINES OPCODE 22 JMP EQUAL JMP EQUAL JMP EQUAL JMP ERROR JMP ERROR JMP ERROR JMP ERROR JMP EQUAL /EQ ROUTINES OPCODE 23 JMP EQUAL JMP EQUAL JMP EQUAL JMP ERROR JMP ERROR JMP ERROR JMP EQUAL / - CHARACTER .LOADS JMS LDINT /LOAD OPCODE 24 JMS LDBINT JMS LDREAL JMS LDDBL JMS LDCPLS JMS LDCPLD JMP LDLOGC JMP LDCHAR / JMS LNINT /LOAD NEGATIVE. MUST BE IMMEDIATELY AFTER .LOADS JMS LNBINT / (SEE YANKIT IN DO) OPCODE 25 JMP LNREAL JMP LNDBL JMP LNCPLS JMP LNCPLD JMP LNLOGC JMP ERROR JMP* .RTRN2 / 'RETURN N' OPCODE 26 JMP* .RTRN4 / (N IS A VARIABLE) JMP ERROR JMP ERROR JMP ERROR JMP ERROR JMP ERROR JMP ERROR LOADIT JMP LOAD2 / DUMMY OPCODE 27 USED BY '.FETCH' JMP LOAD2 JMP LOAD2 JMP LOAD2 JMP LOAD2 JMP LOAD2 JMP LOAD2 JMP LOAD2 / LOAD2 CMA ADD (XCT LOADIT / GET MODE BITS IN AC CMA XCT* FET.X / AND RETURN TO .FETCH IN .INTRP .EJECT / / THE ARITHMETIC ROUTINES START HERE / / LOGICAL 'AND' LOGAND LAC* AUTO2 /PICK UP ARGUMENT SNA DAC LOGACC JMP .NEXT /LOGICAL INCLUSIVE OR LOGORN LAC* AUTO2 CMA!SKP LOGOR LAC* AUTO2 /PICK UP ARGUMENT SZA DAC LOGACC JMP .NEXT LORORN LAC LOGACC CMA DAC LOGACC JMP LOGOR .EJECT / / THE LOAD ROUTINES START HERE******************************* /SINGLE INTEGER / / SINGLE INTEGER LDINT XX LAC* AUTO2 /PICK UP INTEGER DAC INT2 SPA!CLA /EXTEND TO DOUBLE WORD CMA DAC INT1 DZM MODEA /MARK AS INTEGER JMP* LDINT /DOUBLE INTEGER LDBINT XX LAC* AUTO2 DAC INT1 LAC* AUTO2 DAC INT2 DZM MODEA JMP* LDBINT /REAL VARIABLE LDREAL XX LAC (200000 / MARK AS REAL DAC MODEA LDTIE LAC SIGNB DAC SIGNA LAC EXPB DAC EXPA LAC MOSTB DAC MOSTA LAC LEASTB DAC LEASTA JMP* LDREAL /DOUBLE PRECISION VARIABLE LDDBL XX LAC (300000 / MARK AS DOUBLE REAL DAC MODEA LAC LDDBL DLDTIE DAC LDREAL LAC B3 DAC A3 LAC B4 DAC A4 JMP LDTIE / COMPLEX VARIABLE LDCPLS XX LAC (400000 DAC MODEA JMS MVIMA LAC LDCPLS JMP DLDTIE .EJECT /COMPLEX(DOUBLE PRECISION) LDCPLD XX LAC (500000 DAC MODEA JMS MVIMA LAC LDCPLD JMP DLDTIE /LOGICAL / LOAD LOGICAL NEGATIVE LNLOGC LAC* AUTO2 CMA!SKP / LOAD LOGICAL LDLOGC LAC* AUTO2 DAC LOGACC LAC (600000 DAC MODEA JMP .NEXT /LOAD NEGATIVE ROUTINES /LOAD INTEGER NEGATIVE LNINT XX LAC* AUTO2 CMA TAD (1 DAC INT2 SPA!CLA CMA DAC INT1 DZM MODEA JMP* LNINT /LOAD DOUBLE INTEGER NEGATIVE LNBINT XX LAC* AUTO2 CMA DAC INT1 LAC* AUTO2 CMA!CLL TAD (1 DAC INT2 SZL ISZ INT1 DZM MODEA JMP* LNBINT /LOAD REAL NEGATIVE LNREAL JMS LDREAL NSIGN LAC SIGNA XOR (400000 DAC SIGNA JMP .NEXT /LOAD DOUBLE NEGATIVE LNDBL JMS LDDBL JMP NSIGN .EJECT /LOAD SINGLE COMPLEX NEGATIVE LNCPLS JMS LDCPLS NSIGNI LAC SIGNIA XOR (400000 DAC SIGNIA JMP NSIGN /LOAD DOUBLE COMPLEX NEGATIVE LNCPLD JMS LDCPLD JMP NSIGNI / LOAD CHARACTER VARIABLE LDCHAR LAC SIGNB DAC SIGNA /CHARACTER COUNT LAC* (AUTO2 DAC* (AUTO3 LAC (700000 DAC MODEA JMP .NEXT / .EJECT / / THE ADDITION ROUTINES FOLLOW******************************* /ADD REAL NUMBER TO ACCUMULATOR / ADDRL XX LAC MODEA /GET MODE OF ACCUMULATOR SPA!RTL JMP X1 /COMPLEX OR ILLEGAL SNL JMP INTG1 /INTEGER X1 SPA JMP DOUBL1 /DOUBLE PRECISION JMS SPRADD JMP* ADDRL /RETURN INTG1 JMS .FLOTA /CONVERT TO REAL OR DOUBLE JMP ADDRL+2 /REPEAT WITH CONVERTED ACCUM. DOUBL1 DZM B3 /EXTEND FRACTION LENGTH IN ACC B DZM B4 JMS DPRADD /DOUBLE PRECISION ADD ROUTINE JMP* ADDRL /RETURN /ADD DOUBLE PRECISION NUMBER TO ACCUMULATOR ADDBL XX LAC MODEA SPA!RTL JMP X2 SNL JMP INTG2 X2 SMA JMP REAL1 ADDB2 JMS DPRADD JMP* ADDBL INTG2 JMS .FLOTA /CONVERT TO REAL OR DOUBLE JMP ADDBL+2 /REPEAT WITH CONVERTED ACCUM. REAL1 DZM A3 /EXTEND FRACTION OF REAL PART DZM A4 DZM AI3 /EXTEND FRACTION OF IMAG. PART DZM AI4 JMP ADDB2 /DO DOUBLE PRECISION ADD /ADD COMPLEX NUMBER TO ACCUMULATOR ADDCPX XX JMS ADDRL /ADD REAL PARTS LAC MODEA SPA JMP CMPLX3 /ACCUM. IS CMPLEX- PERFORM IMAG. ADD XOR (600000 DAC MODEA JMS MVIMA DZM AI3 DZM AI4 JMP* ADDCPX CMPLX3 JMS SWAPA /SAVE REAL PART, IMAG TO REAL JMS ADDRL /REAL ADD JMS SWAPUS /REAL TO IMAG, RESTORE REAL PART JMS .SPBIA JMP* ADDCPX /RETURN /ADD DOUBLE COMPLEX NUMBER TO ACCUMULATOR ADDDCP XX JMS ADDBL LAC MODEA SPA JMP CMPLX4 XOR (600000 DAC MODEA JMS MVIMA / ACCUMULATOR IS REAL, MOVE IN IMAG PART LAC BI3 DAC AI3 LAC BI4 DAC AI4 JMP* ADDDCP CMPLX4 JMS SWAPA JMS ADDBL JMS SWAPUS JMS .SPBIA JMP* ADDDCP /MOVE IMAG PART OF B TO IMAG PART OF A MVIMA XX LAC EXPIB DAC EXPIA LAC SIGNIB DAC SIGNIA LAC MOSTIB DAC MOSTIA LAC LESTIB DAC LESTIA LAC MODEA RTL SMA JMP* MVIMA LAC BI3 DAC AI3 LAC BI4 DAC AI4 JMP* MVIMA .EJECT /BI TO B, A TO BI, AI TO A SWAPA XX JMS SWAPIB JMS SWAPBI JMS SWAPIT JMP* SWAPA / / BI TO B / SWAPIB XX LAC EXPIB DAC EXPB LAC SIGNIB DAC SIGNB LAC MOSTIB DAC MOSTB LAC LESTIB DAC LEASTB LAC BI3 DAC B3 LAC BI4 DAC B4 JMP* SWAPIB / / A TO BI / SWAPBI XX LAC EXPA DAC EXPIB LAC SIGNA DAC SIGNIB LAC MOSTA DAC MOSTIB LAC LEASTA DAC LESTIB LAC A3 DAC BI3 LAC A4 DAC BI4 JMP* SWAPBI .EJECT / BI TO A / .SPBIA XX LAC EXPIB DAC EXPA LAC SIGNIB DAC SIGNA LAC MOSTIB DAC MOSTA LAC LESTIB DAC LEASTA LAC BI3 DAC A3 LAC BI4 DAC A4 JMP* .SPBIA / / A TO AI SWAPUS XX LAC EXPA DAC EXPIA LAC SIGNA DAC SIGNIA LAC MOSTA DAC MOSTIA LAC LEASTA DAC LESTIA LAC A3 DAC AI3 LAC A4 DAC AI4 JMP* SWAPUS .EJECT / /THIS SUBROUTINE ASSUMES SINGLE PRECISION REAL, DOUBLE PREC- / ISION REAL, OR DOUBLE PRECISION COMPLEX BASED ON THE INCLUS- / IVE OR OF THE MODE BITS WHEN SWITCHING ACC'S A & B FOR / REVERSE OPERATIONS. / REVRSG XX LAC (MODEA-1 / ACC A POINTERS DAC* (AUTO5 DAC* (AUTO6 LAC (MODEB-1 / ACC B POINTERS DAC* (AUTO3 DAC* (AUTO4 LAC MODEA LMQ LAC MODEB OMQ / OR OF MODE IN AC SMA!RCL / AC -5 FOR REAL,-7 FOR DOUBLE,-15 FOR COMPLEX SKP!RAL LAW -3 SPA!RCL TAD (-2 TAD (-5 DAC MOVCNT / SAVE WORD COUNT REVR2 LAC* AUTO5 / START SWITCHING LMQ / SAVE IN MQ LAC* AUTO3 DAC* AUTO6 LACQ DAC* AUTO4 ISZ MOVCNT JMP REVR2 / L=1 IF COMPLEX JMP* REVRSG / / /ADD SINGLE INTEGER TO ACCUMULATOR INTADD XX LAC MODEA /IS AC AN INTEGER SZA JMP MIXEA /MIXED MODE LAC* AUTO2 /GET INTEGER SMA!CLL /TEST SIGN JMP TIEPNT /POSITIVE NUMBER NEG TAD INT2 /NEG NUMBER ONLY DAC INT2 /ADD LEAST SIGNIFIGANT PART SZL!CLA!CMA /SET AC TO 777777,TEST FOR CARRY JMP* INTADD /RETURN IF CARRY OCCURS TAD INT1 /ADD MOST SIGNIFIGANT PART DAC INT1 JMP* INTADD /RETURN / / MIXERS LAC SIGNA /CHANGE SIGN OF FLOATING ACC XOR (400000 DAC SIGNA MIXEA JMS PICK1 /GET INTEGER JMS .FLOTB /CONVERT TO REAL NUMBER SINGAD JMS ADDRL /DO REAL ADDITION JMP* INTADD /RETURN .EJECT / / THE SUBTRACTION ROUTINES FOLLOW / /SUBTRACT SINGLE INTEGER FROM ACCUMULATOR INTSUB XX LAC INTSUB /SET UP RETURN ADDRESS DAC INTADD LAC MODEA SZA!CLL!CML!CMA /SKIP IF ACC IS INT.GET READY FOR 2'S COMP JMP MIXES /MIXED MODE TAD* AUTO2 /PICK UP &2'S COMP INTEGER SMA!CMA!CLL /TEST SIGN TO SPLIT INTO +AND- SAD (400000 JMP TIEPNT /POSITIVE JMP NEG /NEGATIVE MIXES JMS PICK1 /GET INTEGER JMP MIXAB /REVERSE SUBTRACT SINGLE INTEGER INTRSB LAC (.NEXT /SET UP RETURN ADDRESS DAC INTADD LAC MODEA SZA!CLL!CML /SKIP IF INTEGER SET LINK JMP MIXERS /MIXED MODE RAL /AC IS 1 TAD INT1 /COMPLEMENT OF INT1+777777 CMA!CML DAC INT1 LAC* AUTO2 /GET INTEGER SMA!CMA!CLL ISZ INT1 /777777 WAS A MISTAKE-RESCIND NOP TAD INT2 /FORM DIFFERENCE CMA!CML JMP TIEPN2 /ADD DOUBLEINTEGER TO ACC DINTAD XX LAC DINTAD /SET UP RETURN ADDR DAC INTADD LAC MODEA /TEST AC MODE SZA JMP MIXDAD /MIXED LAC* AUTO2 TAD INT1 DAC INT1 /MOST SIGNIF PART CLL LAC* AUTO2 TIEPNT TAD INT2 TIEPN2 DAC INT2 /LEAST SIG PART SZL ISZ INT1 /PROPAGATE CARRY JMP* INTADD JMP* INTADD .EJECT MIXDRS LAC SIGNA XOR (400000 /REVERSE SIGN OF FLOATING NUMBER DAC SIGNA MIXDAD JMS PICK2 /GET INTEGER JMS .FLOTB /CGNVERT TO FLOATING MIXAB2 SAD (200000 JMP SINGAD /RETURN HERE IF SINGLE JMS ADDBL /AND HERE IF DOUBLE JMP* INTADD /RETURN /SUBTRACT DOUBLE INTEGER FROM ACCUMULATOR DINTSB XX LAC DINTSB /SET RETURN ADDRESS DAC INTADD LAC MODEA SZA JMP MIXDSB /MIXED LAC* AUTO2 CMA /COMPLEMENT FIRST WORD TAD INT1 /ADD TO MOST SIGN WORD DAC INT1 CLL!CLA!CMA /GENERATE 2'S COMPLEMENT OF 2ND WORD TAD* AUTO2 CML!CMA JMP TIEPNT /GO TO COMPLETE OPERATION MIXDSB JMS PICK2 /GET INTEGER MIXAB JMS .FLOTB /CONVERT TO FLOAT JMS COMPLB LAC MODEB JMP MIXAB2 /REVERSE SUBTRACT DOUBLE INTEGER FROM ACCUMULATOR DINTRS LAC (.NEXT /SET RETURN ADDRESS DAC INTADD LAC MODEA SZA JMP MIXDRS /MIXED MODE LAC INT1 CMA TAD* AUTO2 DAC INT1 /MOST SIG. WORD CLL!CLA!CMA /GENERATE 2'S CMP OF INT2 TAD INT2 CML!CMA TAD* AUTO2 JMP TIEPN2 / SUBTRACT REAL SUBRL XX JMS COMPLB JMS ADDRL JMP* SUBRL .EJECT /REVERSE SUBTRACT REAL RSBRL JMS COMPLA JMS ADDRL JMP .NEXT / SUBTRACT DOUBLE SUBDBL XX JMS COMPLB JMS ADDBL JMP* SUBDBL /REVERSE SUBTRACT DOUBLE RSBDBL JMS COMPLA JMS ADDBL JMP .NEXT / SUBTRACT SINGLE COMPLEX SUBCPX JMS COMPLB LAC (400000 XOR SIGNIB DAC SIGNIB SKP /REVERSE SUBTRACT SINGLE COMPLEX RSBCPX JMS COMPLA JMS ADDCPX JMP .NEXT /SUBTRACT DOUBLE COMPLEX SUBDPX JMS COMPLB LAC (400000 XOR SIGNIB DAC SIGNIB SKP /REVERSE SUBTRACT DOUBLE COMPLEX RSBDPX JMS COMPLA JMS ADDDCP JMP .NEXT /COMPLEMENT ROUTINE FOR REVERSE SUBTRACT-IF AC IS INTEGER , /CONVERTS TO FLOAT COMPLA XX LAC MODEA SNA!RAL JMP INTS /INTEGER AC. CPTIE SZL!CLL!CML!CLA /SKIP IF REAL,AC=0,L=1 JMP CPLXS /COMPLEX INTIE RAR /AC=400000,L=0 XOR SIGNA DAC SIGNA /REVERSE SIGN JMP* COMPLA CPLXS RAR /AC=400000,L=0 XOR SIGNIA DAC SIGNIA /REVERSE SIGN JMP CPTIE /L=0 STILL INTS JMS .FLOTA /CONVERT TO FLOAT CLL!CML /L=1 JMP INTIE .EJECT /COMPLEMENT ROUTINE FOR SUBTRACT COMPLB XX LAC (400000 XOR SIGNB DAC SIGNB JMP* COMPLB / / SINGLE AND DOUBLE INTEGER LOAD FOR .FLOTB / PICK1 XX LAC* AUTO2 /PICK UP INTEGER DAC INT2 SPA!CLA /EXTEND TO DOUBLE WORD CMA DAC INT1 JMP* PICK1 / / PICK2 XX LAC* AUTO2 DAC INT1 LAC* AUTO2 DAC INT2 JMP* PICK2 / / /CONVERT INTEGER ACCUMULATOR TO FLOATING POINT IN ACC A .FLOTA XX LAC (MODEA JMS FLOATX DAC MODEA JMP* .FLOTA / / FLOAT INTEGER ACCUMULATOR INTO ACCUMULATOR B .FLOTB XX LAC (MODEB JMS FLOATX DAC MODEB JMP* .FLOTB .EJECT / / CONVERT INTEGER ACCUMULATOR INTO FLOATING POINT / GENERALIZED FLOAT ROUTINE FLOATX XX DAC* (AUTO6 LAC INT1 GSM DAC INT1 CLA!RAR DAC* AUTO6 / SET SIGN SMA!CLL!CLA!CMA JMP FLTA TAD INT2 SKP!CML!CMA FLTA LAC INT2 LMQ GLK TAD INT1 SZA!CLL JMP FNORMA LACQ SNA!CLA JMP FZEROA FNORMA NORM DAC INT1 LAW 17700 OSC CMA DAC* AUTO6 / STORE EXPONENT DAC INT2 LAC INT1 LLS 1 DAC* AUTO6 / STORE MOST SIGNIFICANT BITS LACQ DAC* AUTO6 / STORE LEAST SIGNIFICANT BITS LAW -33 TAD INT2 SPA!CLL JMP FSNGLA DZM* AUTO6 DZM* AUTO6 LAC (300000 /SET MODE TO DOUBLE JMP* FLOATX /RETURN FZEROA LAC (400000 DAC* AUTO6 DZM* AUTO6 DZM* AUTO6 FSNGLA LAC (200000 /SET MODE TO REAL JMP* FLOATX .EJECT /SINGLE PRECISION REAL ADD SPRADD XX LAC EXPB /DIFFERENCE OF EXPONENTS CMA!CLL ADD EXPA /DIFFERENCE OF EXPONENTS SZA!SMA!SNL!CMA /TEST AND COMPLIMENT JMP ALARGE /EXPA LARGER SZA!SMA!SNL /TEST AGAIN JMP BLARGE /EXPB LARGE SZL JMP HUGE /DIFFERENCE GREATER THAN 2**17-1 LAC SIGNA /WE NOW HAVE EQUAL EXPONENTS XOR SIGNB SPA!CLL JMP DIFF /DIFFERENT SIGNS LAC LEASTA JOIN TAD LEASTB JOIN2 DAC LEASTA GLK /CARRY FROM FIRST ADD TAD MOSTA TAD MOSTB DAC MOSTA /ASSUME NORM NOT NEEDED SNL!RAR /TEST FOR OVERFLOW AND ROTATE RIGHT JMP* SPRADD /NO OVERFLOW- EXIT DAC MOSTA /STORE NORMALIZED FIRST WORD LAC LEASTA /GET SECOND WORD RAR /ROTATE TO CONCATENATE WITH BIT IN LINK DAC LEASTA /STORE IT JOINSD ISZ EXPA /INCREMENT EXPONENT SKP!CLA!STL JMP .-2 /WE DID -0 TO +0, TRY AGAIN RAR / SET AC _ 400000 SAD EXPA /TEST IF OVERFLOW, 377777 TO 400000 SKP!CLA / WE HAVE INFINITY BY ADDITION JMP* SPRADD /EXIT JMS* .ERROR /ERROR 0 EXPONENT OVERFLOW JMS INFIN / SET TO INFINITY JMP* SPRADD ALARGE CMA /COMP. OF SHIFT IS IN AC XOR (LRS /CONSTRUCT SHIFT INSTRUCTION DAC SHIFTA XOR (LRS /RECOVER COUNT ADD (-44 SMA!SZA!CLL /IS DIFFERENCE MORE THAN 2**36 JMP* SPRADD /YES- EXIT LEAVING A UNCHANGED LAC LEASTB /NORMALIZE BY SHIFTING AC.MQ LMQ LAC MOSTB SHIFTA XX DAC MOSTB /PUT MOST SIGN. WORD BACK LAC SIGNA /TEST SIGNS XOR SIGNB GS!LACQ /GET LEAST SIGN. WORD INTO AC SZL!CLL /AND TEST SIGN CONDITION JMP BSMALL /DIFFERENT SIGNS FORM A-B TAD LEASTA /SAME SIGNS FORMA+B JMP JOIN2 .EJECT BLARGE XOR (LRS DAC SHIFTB XOR (LRS ADD (-44 SMA!SZA!CLL JMP SWOP /B>>A SWAP THEM LAC EXPB DAC EXPA LAC LEASTA LMQ LAC MOSTA SHIFTB XX DAC MOSTA LAC SIGNA XOR SIGNB GS!LACQ SNL!CLL JMP JOIN /SAME SIGN ADD THEM CMA!CLL TAD LEASTB /FORM B-A ON LEAST SIGN. PARTS TAD (1 DAC LEASTA LAC SIGNB DAC SIGNA LAC MOSTA SZL!CMA!CLL TAD (1 TAD MOSTB JMP NORMLZ HUGE LAC EXPA /WHICH IS THE LARGER EXPONENT SMA JMP* SPRADD /A IS BIGGER-EXIT SWOP LAC SPRADD DAC LDREAL JMP LDTIE .EJECT /SUBTRACTING EQUAL EXPONENT NUMBERS. TRY A-B FIRST AND IF IT GIVES /A NEGATIVE RESULT,COMPLEMENT IT .SUBTRACTION WITH B SHIFTED ENTERS /BSMALL . IF THE SUBTRACTION DEVELOPES MORE THAN ONE /LEADING ZERO,RESULT IS ROUNDED TO 27 BITS BEFORE NORMALIZING. DIFF LAC LEASTB BSMALL CMA!CLL /-B+A TAD (1 TAD LEASTA DAC LEASTA LAC MOSTB SZL!CMA!CLL /TEST FOR CARRY TAD (1 /CARRY TAD MOSTA SZL JMP NORMLZ /TRUE RESULT DAC MOSTA LAC SIGNB /NO COMPLEMENT IT DAC SIGNA LAC LEASTA CMA!CLL TAD (1 DAC LEASTA LAC MOSTA SZL!CMA TAD (1 NORMLZ DAC MOSTA SPA!CLL!RAL /WAS LEADING ZERO FORMED JMP* SPRADD /NO EXIT /IF ONLY 1 LEADING ZERO, ROTATE WILL HAVE REMOVED IT SMA /IS THERE STILL AZERO JMP GRIND /YES-GO NORMALIZE IT DAC MOSTA /STORE WORD ONE, BIT 17 = 0 LAC LEASTA /GET NEXT WORD RAL /GET BIT ZERO INTO LINK DAC LEASTA /STORE IT BACK LAW -2 /EXPONENT ADJUSTMENT INITIALIZATION EXPADJ SZL!CLL /WAS MBIT ZERO OF 2ND WORD A 1 ISZ MOSTA /YES-ADD 1 TO 1ST WORD ADD EXPA /ADJUST EXPONENT SAD (777777 / CHECK FOR -0 CMA DAC EXPA SZL ZEROS JMS ZERVAL / FORM REAL ZERO. NO UNDERFLOW ERROR INDICATED JMP* SPRADD / SINCE CORRECT VALUE MAY BE ZERO; EXIT .EJECT /ROUTINE TO NORMALIZE NUMBERS WITH MORE THAN ONE LEADING ZERO. /ROUNDS TO 27 BITS. GRIND LAC LEASTA TAD (400 /ROUND TO 27 BITS AND (777000 /CHOP OFF TRASH LMQ GLK / CARRY FROM ROUNDING TAD MOSTA NORM /GET RID OF ALL BUT ONE LEADING ZERO RAL /GET RID OF LEADING ZERO DAC MOSTA /LAST BIT = ZERO LACQ /GET 2ND WORD RAL /FIRST BIT INTO LINK DAC LEASTA /FIRST BIT REMAINS IN LINK LACS /GET STOP COUNTER AND TAD (777745 /FORM ONE'S COMPLIMENT SMA!CMA!CML /COMPLIMENTARY LINK REPAIRS DAMAGE OF TAD JMP EXPADJ /FIX UP EXPONENT JMP ZEROS /SHIFT OF 36, ALL ZEROS .EJECT / THE DOUBLE PRECISION ROUTINES FOLLOW / /DOUBLE PRECISION REAL ADD DPRADD XX LAC EXPB /DETERMINE WHETHER EXPONENTS ARE CMA!CLL /EQUAL, OR WHICH ONE IS LARGER ADD EXPA SZA!SMA!SNL!CMA JMP ALGE /A IS LARGER SZA!SMA!SNL JMP BLGE /B IS LARGER SZL JMP IMMENS /DIFFERENCE OF EXPONENTS IS VERY BIG DBLEQL LAC SIGNA /EQUAL EXPONENTS NOW XOR SIGNB /TEST SIGNS SMA!CLL JMP DBLSAM /SAME SIGNS LAC B4 /ASSUME A IS LARGER CMA!CLL TAD (1 TAD A4 DAC A4 LAC B3 SZL!CMA!CLL TAD (1 TAD A3 DAC A3 LAC LEASTB SZL!CMA!CLL TAD (1 TAD LEASTA DAC LEASTA LAC MOSTB SZL!CMA!CLL TAD (1 TAD MOSTA DAC MOSTA SNL /WAS A LARGER JMS DBLCMP /NO-COMPLEMENT RESULT SMA /DOES IT NEED NORMALIZING JMS .DBNRM /YES-NORMALIZE JMP* DPRADD .EJECT DBLSAM LAC A4 /SIGNS ARE SAME-ADD A AND B TAD B4 DAC A4 GLK TAD A3 TAD B3 DAC A3 GLK TAD LEASTA TAD LEASTB DAC LEASTA GLK TAD MOSTA TAD MOSTB DAC MOSTA SNL!RAR JMP* DPRADD DAC MOSTA LAC LEASTA RAR DAC LEASTA LAC A3 RAR DAC A3 LAC A4 RAR DAC A4 LAC DPRADD /SET UP RETURN ADDRESS DAC SPRADD JMP JOINSD DBLCMP XX /COMPLIMENT RESULT OF A-B LAC SIGNA XOR (400000 DAC SIGNA LAC A4 CMA!CLL TAD (1 DAC A4 LAC A3 SZL!CMA!CLL TAD (1 DAC A3 LAC LEASTA SZL!CMA!CLL TAD (1 DAC LEASTA LAC MOSTA SZL!CMA!CLL TAD (1 DAC MOSTA JMP* DBLCMP .EJECT / DOUBLE PRECISION NORMALIZE ROUTINE .DBNRM XX LAW -4 DAC BOXX DGRNM LAC MOSTA SZA!CLL JMP DNRM LAW -23 ADD EXPA DAC EXPA SZL / CHECK FOR UNDERFLOW JMP UNDER ISZ BOXX / CHECK FOR ALL ZEROS SKP JMP DZERO / SET ACC TO ZERO LAC LEASTA DAC MOSTA LAC A3 DAC LEASTA LAC A4 DAC A3 DZM A4 JMP DGRNM / NORMALIZE NUMBER, ONLY IF LEADING BIT ZERO DNRM SPA!STL / NOTE: LINK IS SET JMP* .DBNRM / NO SHIFT NESCESSARY NORM LAW 17700 OSC TAD (LLS 45 /NOTE: THIS CLEARS LINK DAC DSHL1 XOR (LLS\777777 / REMOVE LLS AND GET 1'S COMP OF # OF SHIFTS ADD EXPA DAC EXPA SNL!CLL /TEST FOR EXPONENT UNDERFLOW JMP DSHIFT UNDER LAW 1 JMS* .ERROR / ERROR UNDERFLOW, ISSUE ERROR AND RETURN / UNDERFLOW AND ZERO CASES COME HERE DZERO JMS ZERVAL /GENERATE DOUBLE PRECISION ZERO, NO ERROR JMP* DPRADD /EXIT .EJECT / PERFORM THE REQUIRED SHIFTING DSHIFT LAC LEASTA /NORMALIZE BY LONG LEFT SHIFTS LMQ LAC MOSTA DSHL1 XX /MOSTA.LEASTA DAC MOSTA LAC A3 LMQ LAC LEASTA XCT DSHL1 /LEASTA.A3 DAC LEASTA LAC A4 LMQ LAC A3 XCT DSHL1 /A3.A4 DAC A3 LACQ DAC A4 JMP* .DBNRM / / / EXPONENT OF A IS LARGER ALGE CMA /ENTER WITH COMPLEMENT OF SHIFT IN AC DAC BOXX ADD (-110 SMA!SZA!CLL JMP* DPRADD /A MUCH GREATER THAN B ALGE1 LAC BOXX /SHIFT RIGHT BY WORDS IF POSSIBLE TAD (-22 SPA!CLL JMP DRSHFT DAC BOXX LAC B3 DAC B4 LAC LEASTB DAC B3 LAC MOSTB DAC LEASTB DZM MOSTB JMP ALGE1 DRSHFT LAC BOXX /NOW SHIFT RIGHT IN PAIRS BY LRS XOR (LRS DAC DRSH1 LAC B4 LMQ LAC B3 DRSH1 XX LACQ DAC B4 LAC B3 LMQ LAC LEASTB XCT DRSH1 LACQ DAC B3 LAC LEASTB LMQ LAC MOSTB XCT DRSH1 DAC MOSTB LACQ DAC LEASTB JMP DBLEQL /EXPONENTS ARE EQUAL NOW / / / B EXPONENT IS LARGER BLGE DAC BOXX ADD (-110 SMA!SZA!CLL JMP DBLSWP /B MUCH GREATER THAN A LAC EXPB /SWAP EXPB INTO EXPA DAC EXPA BLGE1 LAC BOXX /SHIFT RIGHT BY WORDS IF POSSIBLE TAD (-22 SPA!CLL JMP DRSHF2 DAC BOXX LAC A3 DAC A4 LAC LEASTA DAC A3 LAC MOSTA DAC LEASTA DZM MOSTA JMP BLGE1 DRSHF2 LAC BOXX /SHIFT RIGHT IN PAIRS BY LRS XOR (LRS DAC DRSH4 LAC A4 LMQ LAC A3 DRSH4 XX LACQ DAC A4 LAC A3 LMQ LAC LEASTA XCT DRSH4 LACQ DAC A3 LAC LEASTA LMQ LAC MOSTA XCT DRSH4 DAC MOSTA LACQ DAC LEASTA JMP DBLEQL /EXPONENTS ARE EQUAL NOW / / IMMENS LAC EXPA /TEST DIFFERENCE OF EXPONENTS SMA JMP* DPRADD /A MUCH LARGER THAN B-EXIT DBLSWP LAC DPRADD JMP DLDTIE .EJECT / / THE MULTIPLY ROUTINES START HERE / /SINGLE PRECISION INTEGER MULTIPLY INTMUL LAC MODEA SZA JMP MIXEMI /MIXED MODE LAC* AUTO2 /GET INTEGER SNA /TEST FOR ZERO JMP INTMZ2 /ZERO-GO TO ZERO ROUTINE GSM /FORM 2'S COMP. IF NEGATIVE SZL TAD (1 DZM INTMA /EXPAND LEFT WITH ZEROS JMS INTMPY /PERFORM MULT. JMP .NEXT MIXEMI JMS PICK1 /GET INTEGER JMS .FLOTB /FLOAT IT JMP MULRL /PERFORM REAL MULTIPLY INTMZ2 DZM INT1 / SET INTEGER TO ZERO DZM INT2 JMP .NEXT / /DOUBLE PRECISION INTEGER MULTIPLY DINTML LAC MODEA SZA JMP MIXEM2 /MIXED MODE LAC* AUTO2 /GET FIRST WORD GSM /GET SIGN AND MAGNITUDE DAC INTMA /STORE IT LAC* AUTO2 /GET SECOND WORD SNL /IS IT NEGATIVE JMP DMLT /NO-BYPASS COMPLEMENTING CMA!CLL /YES-COMPLEMENT TAD (1 SZL!CLL!CML /TEST FOR CARRY AND SET LINK ISZ INTMA /PROPAGATE CARRY DMLT JMS INTMPY /PERFORM MULTIPLICATION JMP .NEXT MIXEM2 JMS PICK2 /MIXED MODE - PICK UP INTEGER JMS .FLOTB /FLOAT IT SAD (200000 JMP MULRL /SINGLE PRECISION MULTIPLY JMS MULBL /DOUBLE PRECISION MULTIPLY /MULTIPLY ROUTINE FOR INTEGERS INTMPY XX DAC INTMB /STORE SECOND HALF OF INTEGER CLA!RAR /STORE SIGN OF MULTIPLIER DAC BOXX LAC INT1 /GET FIRST WORD OF MULTIPLICAND SMA /TEST SIGN AND SET LINK=0 FOR POS. JMP MIPOS /POSITIVE - BYPASS COMPLIMENTING JMS INTACP /COMPLEMENT INTEGER LAC (400000 /GET SIGN XOR BOXX /DEVELOP RESULT SIGN DAC BOXX LAC INT1 /TEST FOR PRECISION AND FOR ZERO MIPOS SZA JMP IDBL1 /ACCUM A IS DOUBLE, B NOT KNOWN LAC INTMA SZA!CLL JMP IDBL2 /ACCUM B IS DOUBLE IS SINGLE LAC INT2 SNA JMP* INTMPY /ACCUM A IS ZERO-RETURN LAC INTMB SNA!CLL JMP INTMZ /ACCUM B IS ZERO - GO TO ZERO RETURN DAC .+3 /SET UP MULTIPLIER LAC INT2 /SET UP MULTIPLICAND MUL /MULTIPLY XX DAC INT1 /STORE RESULT LACQ DAC INT2 INTMTS LAC BOXX /SIGN RESULT SZA JMS INTACP JMP* INTMPY INTMZ DZM INT1 /ZERO ROUTINE-SET ACCUM A TO ZERO DZM INT2 JMP* INTMPY IDBL1 LAC INTMA /SEE IF ACCUM B IS ALSO DOUBLE SNA!CLL JMP IDBL2 /NOT DOUBLE - PROCEED I0VFLM LAW 2 /OVERFLOW WILL OCCUR IN MULT. JMS* .ERROR LAC BOXX / LOAD AC WITH SIGN JMS LARGEI / ON OVERFLOW SET TO LARGEST + OR - JMP* INTMPY / INTEGER IDBL2 LAC INT2 /DEVELOP AR*BR DAC .+3 LAC INTMB MUL XX DAC INTM3 /STORE IT LACQ DAC INTM4 LAC INT1 /DEVELOP AL*BR*2**18 DAC .+3 LAC INTMB MUL XX SZA JMP I0VFLM /OVERFLOW DURING MULT. LACQ TAD INTM3 /ADD TO PREVIOUS RESULT SZL!CLL JMP I0VFLM /OVERFLOW ON ADDING DAC INTM3 LAC INT2 /DEVELOP AR*BL*2**18 DAC .+3 LAC INTMA MUL XX SZA JMP I0VFLM /OVERFLOW ON MULTIPLYING LACQ TAD INTM3 /ADD TO PREVIOUS RESULT SZL!CLL JMP I0VFLM /OVERFLOW ON ADDING SPA JMP I0VFLM /OVERFLOW INTO SIGN BIT OCCURED DAC INT1 /STORE INTO ACCUMULATOR A LAC INTM4 DAC INT2 JMP INTMTS /GO BACK TO PICK UP SIGN /MULTIPLY ACCUMULATOR BY REAL NUMBER MULRL LAC MODEA /GET MODE OF ACC. SPA!RTL JMP COMPMS SNL JMP INTGM1 SPA JMP DOUBM1 MULS JMS SPRMUL JMP .NEXT INTGM1 JMS .FLOTA /CONVERT TO FLOAT SAD (200000 JMP MULS /SINGLE PRECISION MULTIPLY JMP MULBL2 /DOUBLE PRECISION MULTIPLY DOUBM1 DZM B3 /EXTEND FRACTION LENGTH DZM B4 JMP MULBL2 /DOUBLE PRECISION MULTIPLY COMPMS JMS ZEROIB JMS MULCPX /DO COMPLEX MULT. JMP .NEXT /MULTIPLY ACCUMULATOR BY DOUBLE PRECISION NUMBER MULBL LAC MODEA SPA!RTL JMP COMPMD /COMPLEX SNL JMP INTGM2 /INTEGER SMA JMP REALM2 /REAL MULBL2 JMS DPRMUL /DOUBLE JMP .NEXT INTGM2 JMS .FLOTA /CONVERT TO FLOAT SAD (300000 JMP MULBL2 /DOUBLE REALM2 DZM A3 /EXTEND FRACTION LENGTH DZM A4 JMP MULBL2 /DOUBLE PRECISION MULTIPLY COMPMD JMS ZEROIB JMS MULDCP JMP .NEXT /MULTIPLY ACCUMULATOR BY SINGLE PRECISION COMPLEX MULCPX XX LAC MULCPX DAC MULDCP LAC MODEA /IS AC COMPLEX SMA!RTL JMS MKCPX /MAKE ACC A COMPLEX SPA JMP MCPX2 /YES-MAKE B DOUBLE LAC (JMS SPARST DAC CM0 LAC (JMS SPRMUL /NO SET UP FOR SINGLE OPERATIONS DAC CM1 LAC (JMS SPARLD DAC CM2 LAC (JMS SPRADD CXMTIE DAC CM3 JMP MDCP3 MCPX2 DZM BI3 DZM BI4 DZM B3 DZM B4 MDCP2 LAC (JMS DPARST DAC CM0 LAC (JMS DPRMUL /SET UP FOR DOUBLE OPERATIONS DAC CM1 LAC (JMS DPARLD DAC CM2 LAC (JMS DPRADD JMP CXMTIE /MULTIPLY ACC BY DOUBLE PRECISION COMPLEX / MULDCP XX LAC MODEA /IS ACC COMPLEX SMA!RTL JMS MKCPX /MAKE ACC A COMPLEX SPA JMP MDCP2 DZM A3 /NO-MAKE IT DOUBLE DZM A4 JMP MDCP2 MDCP3 LAC (SIGNS CM0 XX /SAVE A CM1 XX /GET A*B LAC (SIGNH XCT CM0 /STORE A*B JMS SWAPIT /AI TO A XCT CM1 /GET B*AI LAC (SIGNS /A TO ACC B CM2 XX LAC (SIGNS /STORE B*AI XCT CM0 JMS .SPBIA /BI TO A XCT CM1 /GET A*BI LAC (SIGNS XCT CM2 /B*AI TO ACC B CM3 XX /GET A*BI + B*AI JMS SWAPA /BI TO B,A TO BI,AI TO A XCT CM1 /GET AI*BI LAC SIGNA / (DO NOT WORRY ABOUT GENERATING -0 HERE XOR (400000 / SINCE THE ADDER HANDLES IT ) DAC SIGNA /COMPLEMENT SIGNA LAC (SIGNH XCT CM2 /A*B TO ACC B XCT CM3 /A*B - (AI*BI) LAC MODEA XOR (600000 DAC MODEA /RESTORE COMPLEX MODE JMS MVIMA /BI TO AI JMP* MULDCP / /SINGLE PRECISION REAL MULTIPLY SPRMUL XX LAC (200000 DAC MODEA /SET MODE TO SINGLE LAC MOSTA SNA!CLL JMP* SPRMUL / ANSWER WILL BE ZERO DAC SPM1 / STORE FOR MULT'S DAC SPM3 LAC MOSTB /CHECK FOR ACC B = 0 SNA JMP SPMZER DAC SPM2 LAC EXPA / CALC NEW EXP ADD EXPB DAC EXPA SZL!CLL JMP SPMEXP LAC SIGNA / GET NEW SIGN XOR SIGNB DAC SIGNA LAC LEASTB MUL SPM1 XX DAC INTMB / STORE TEMP LAC LEASTA MUL SPM2 XX TAD INTMB DAC LEASTA GLK / GET CARRY DAC INTMA / TEMP STORAGE LAC MOSTB / CALC MOST SIGNIF. MUL SPM3 XX / MOSTA TAD INTMA DAC MOSTA LACQ / GET LEAST SIGNIF PART TAD LEASTA DAC LEASTA GLK / GET CARRY TAD MOSTA DAC MOSTA SPA!CLL!RAL / IS IT NORM? SHIFT TO NORM JMP* SPRMUL / ANSWER WAS FINE DAC MOSTA LAC LEASTA CLL!RAL DAC LEASTA SZL!CLL ISZ MOSTA LAW -2 / DECREMENT EXP BY 1 ADD EXPA SZL!CLL!CMA /ANY OVER OR UNDER FLOW JMP SPMEXP / YES SNA!CMA / IF ACC 0 THEN EXP = -0 CLA / MAKE +0 DAC EXPA JMP* SPRMUL SPMZER JMS ZERVAL / MAKE ACC A 0 JMP* SPRMUL SPMEXP LAC SPRMUL / MOVE RETURN ADDRESS DAC DPRMUL / USE DPRMUL'S ERROR ROUTINE JMP DPMEXP / /DOUBLE PRECISION REAL MULTIPLY DPRMUL XX LAC (300000 /SET MODE TO DOUBLE DAC MODEA LAC MOSTA SNA JMP* DPRMUL LAC MOSTB SNA JMP DPMZER DZM BOXX DZM SIZE DZM INTMA DZM INTMB DZM INTM3 DZM INTM4 LAC (LAC A4 DAC DPLM1 /SET UP FOR FIRST MULTIPLY LAC (LAC MOSTB /OF FIRST LOOP DAC DPLM2 LAW -4 DAC MOVCNT DPLM1 XX /SET UP MULTIPLIER DAC .+4 DPLM2 XX /SET UP MULTIPLICAND CLL MUL XX TAD INTM4 /ADD TO WORD 4 DAC INTM4 /MQ PORTION IS LOST ANYWAY SZL!CLL /PROPOGATE CARRY INTO WORD 3 ISZ INTM3 ISZ DPLM2 /INCREMENT TO NEXT MULTIPLICAND LAW -1 /DECREMENT TO NEXT MULTIPLIER TAD DPLM1 DAC DPLM1 ISZ MOVCNT /TEST FOR END OF LOOP JMP DPLM1 /REPEAT FWITH NEXT PAIR LAC (LAC A3 /SET UP FOR FIRST MULTIPLY DAC DPLM3 /OF SECOND LOOP LAC (LAC MOSTB DAC DPLM4 LAW -3 DAC MOVCNT DPLM3 XX DAC .+4 /MULTIPLY DPLM4 XX CLL MUL XX TAD INTM3 /ADD RESULT TO WORK AREA DAC INTM3 SZL!CLL ISZ INTMB LACQ TAD INTM4 DAC INTM4 SZL!CLL ISZ SIZE ISZ DPLM4 /MODIFY ADDRESSES LAW -1 TAD DPLM3 DAC DPLM3 ISZ MOVCNT /TEST FOR END OF LOOP JMP DPLM3 LAC (LAC LEASTA /SET UP FOR FIRST MUL. DAC DPLM5 /OF THIRD LOOP LAC (LAC MOSTB DAC DPLM6 LAW -2 DAC MOVCNT DPLM5 XX DAC .+4 /MULTIPLY DPLM6 XX CLL MUL XX TAD INTMB /ADD RESULT TO WORK AREA DAC INTMB SZL!CLL ISZ INTMA LACQ TAD INTM3 DAC INTM3 SZL!CLL ISZ BOXX ISZ DPLM6 /MODIFY ADDRESSES LAW -1 TAD DPLM5 DAC DPLM5 ISZ MOVCNT /TEST FOR END OF LOOP JMP DPLM5 LAC MOSTA /DO LAST MUL. DAC .+4 LAC MOSTB CLL MUL XX TAD INTMA /ADD TO WORK AREA DAC INTMA LAC INTM3 TAD SIZE / START ADDING IN CARRIES DAC INTM3 SZL!CLL ISZ BOXX LACQ / GET INTMB FROM MQ TAD INTMB SZL!CLL ISZ INTMA TAD BOXX DAC INTMB SZL!CLL ISZ INTMA LAC EXPA /COMPUTE EXPONENT ADD EXPB SZL!CLL JMP DPMEXP /OVERFLOW OR UNDERFLOW? SAD (777777 CMA / GENERATE+0 DAC EXPA LAC SIGNA /SIGN OF RESULT XOR SIGNB DAC SIGNA LAC INTMA /IS IT NORMALIZED DAC MOSTA SPA!RAL!CLL JMP DPMMVR /YES-MOVE TO ACCUM A DAC MOSTA /NORMALIZE BY ROTATING LAC INTM4 /AT MOST ONE LEADING ZERO CLL!RAL /SHIFT ONE LEFT DAC A4 LAC INTM3 RAL DAC A3 LAC INTMB RAL DAC LEASTA SZL!CLL ISZ MOSTA / CARRY TO MOSTA LAW -2 / -1 IN 1'S COMP ADD EXPA / ADJUST EXP SZL!CLL JMP DPMXUN /EXPONENT UNDERFLOW SAD (777777 CMA DAC EXPA JMP* DPRMUL /RETURN DPMMVR LAC INTMB /MOVE RESULT TO ACCUM A DAC LEASTA LAC INTM3 DAC A3 /MOVE RESULT TO ACCUM A LAC INTM4 DAC A4 JMP* DPRMUL /RETURN /ROUTINE TO DETERMINE WHETHER UNDER OR OVERFLOW OCCURRED / / /AND DO SOMETHING ABOUT IT DPMEXP LAC EXPA SPA!CLA JMP DPMXUN /UNDERFLOW JMS* .ERROR /ERROR 0: EXPONENT OVERFLOW JMS INFIN /AET A TO INFINITY JMP* DPRMUL /RETURN DPMXUN LAW 1 /UNDERFLOW JMS* .ERROR DPMZER JMS ZERVAL /SET A TO ZERO JMP* DPRMUL /INFINITY ROUTINE INFIN XX CLA!CMA!CLL DAC MOSTA DAC LEASTA DAC A3 DAC A4 RAR / = LAC (377777 DAC EXPA JMP* INFIN /ZERO ROUTINE ZERVAL XX DZM MOSTA DZM LEASTA DZM A3 DZM A4 LAC (400000 DAC EXPA DZM SIGNA JMP* ZERVAL / / ZERO IA ZEROIA XX DZM MOSTIA DZM LESTIA DZM AI3 DZM AI4 LAC (400000 DAC EXPIA DZM SIGNIA JMP* ZEROIA / / ZERO IB ZEROIB XX DZM MOSTIB DZM LESTIB DZM BI3 DZM BI4 LAC (400000 DAC EXPIB DZM SIGNIB JMP* ZEROIB / .EJECT / / /**************************************************************** / / STORE ROUTINES. / NOTE: 1) ANY MIXED ARITHMETIC IS ALLOWED. WARNINGS ARE ISSUED / IF COMPLEX IS STORED INTO INTEGER OR REAL. / 2) LOGICAL MAY ONLY BE STORED IN LOGICAL / 3) CHARACTER MAY BE STORED IN ANYTHING. / 5) INTO CHARACTER MAY ONLY BE STORED CHARACTER / 6) TEMPORARY ACC'S ARE DESTINATIONS ONLY. / /**************************************************************** / / .STORE XX STOAGN LAC* BOX /CHECK DESTINATION MODE SPA!RAL JMP STOCLC /COMPLEX,LOGICAL,TEMPORARY, OR CHARACTER SPA!RTL / PRECISION BIT IN LINK NOW JMP STORL / DESTINATION IS REAL / / DESTINATION IS INTEGER STOINT LAC MODEA SZA JMP STONIN / ACC A NOT INTEGER / DESTINATION INTEGER, ACC A INTEGER. (DESTINATION TEMP, ACC A INTEGER / COMES HERE ALSO). / STORE SINGLE AND DOUBLE INTEGER AND CHECK FOR OVERFLOW / ON SINGLE INTEGER STOTIN LAC INT1 SZL JMP DTSTOR / GO STORE DOUBLE / HAVE A SINGLE INTEGER DESTINATION SPA JMP NEGINT / ACCUMULATOR IS NEG / ACCUMULATOR IS POSITIVE POSINT SZA JMP POSOVF LAC INT2 SPA JMP POSOVF STSIN DAC* AUTO2 / SINGLE INTEGER IS IN RANGE, STORE IT JMP* .STORE / / ACCUMULATOR IS NEGATIVE NEGINT ISZ INT1 JMP NEGOVF / INT1 NOT 777777 LAC INT2 SPA JMP STSIN / / NEGATIVE INTEGER TOO LARGE NEGOVF LAC (400000 SKP / POSITIVE INTEGER TOO LARGE POSOVF LAC (377777 DAC* AUTO2 LAW 2 JMS* .ERROR JMP* .STORE / / HAVE A DOUBLE INTEGER DESTINATION, STORE IT. DTSTOR DAC* AUTO2 LAC INT2 DAC* AUTO2 JMP* .STORE / DESTINATION INTEGER, ACC A NOT INTEGER STONIN SMA!RAL JMP STORIN / ACC A REAL SPA!RAL JMP STALCH / ACC A IS LOGICAL OR CHARACTER LAW 10 JMS* .ERROR / COMPLEX INTO INTEGER, ISSUE WARNING / DESTINATION INTEGER, ACC A REAL OR COMPLEX STORIN LAC MODEA JMS ROUND DZM MODEA JMS .FIX / MAKE ACC A INTEGER JMP STOAGN / GO GET PRECISION BIT IN LINK AGAIN / / / DESTINATION REAL STORL LAC MODEA /DESTINATION IS REAL, WHAT IS ACC A SNA JMS .FLOTA /FLOAT IF INTEGER SPA!RTL JMP STOLCC /ACC A IS COMPLEX,LOGICAL OR CHARACTER / DESTINATION IS REAL, ACC A IS REAL STOMTA LAC* BOX JMS ROUND JMS STORE1 /STORE SINGLE OR DOUBLE PRECISION JMP* .STORE / DESTINATION IS REAL, ACC A IS COMPLEX, LOGICAL, OR CHARACTER STOLCC SZL JMP STALCH / ACC A IS LOGICAL OR CHARACTER / DESTINATION IS REAL, ACC A IS COMPLEX LAW 10 JMS* .ERROR JMP STOMTA / GO STORE REAL PART / / / / DESTINATION IS COMPLEX, LOGICAL, TEMPORARY, OR CHARACTER / STOCLC SMA!RAL JMP STOCPX / COMPLEX SMA JMP STOLOG / LOGICAL / DESTINATION TEMPORARY, OR CHARACTER IF ACC A IS CHARACTER THEN / SO IS THE DESTINATION. LAC MODEA SAD (700000 JMP STOCK2 / DESTINATION CHARACTER, ACC A CHARACTER / / / / DESTINATION IS TEMPORARY DAC* AUTO2 /STORE MODE WORD SPA!RAL JMP STOTCL / ACC A IS COMPLEX, OR LOGICAL SMA!RTL / PRECISION BIT TO LINK JMP STOTIN / ACC A IS INTEGER / DESTINATION TEMPORARY, ACC A REAL, OR COMPLEX STOTCX LAC SIGNA DAC* AUTO2 LAC EXPA DAC* AUTO2 LAC MOSTA DAC* AUTO2 LAC LEASTA DAC* AUTO2 SNL /TEST PRECISION BIT JMP TESTC /SINGLE LAC A3 /DOUBLE DAC* AUTO2 LAC A4 DAC* AUTO2 TESTC LAC MODEA /CHECK FOR COMPLEX SMA JMP* .STORE /NON-COMPLEX, EXIT LAC SIGNIA /STORE COMPLEX PART DAC* AUTO2 LAC EXPIA DAC* AUTO2 LAC MOSTIA DAC* AUTO2 LAC LESTIA DAC* AUTO2 SNL /TEST PRECISION BIT JMP* .STORE /SINGLE, EXIT LAC AI3 /DOUBLE, STORE REMAINDER DAC* AUTO2 LAC AI4 DAC* AUTO2 JMP* .STORE / / DESTINATION TEMPORARY, ACC A COMPLEX OR LOGICAL STOTCL SMA!RTL / PRECISION BIT TO LINK JMP STOTCX /COMPLEX JMP ERR11 / LOGICAL INTO THESE TEMPORARYS IS ILLEGAL / / / / DESTINATION COMPLEX STOCPX LAC MODEA SNA JMS .FLOTA / FLOAT IF INTEGER SPA!RTL JMP STCLCC / ACC A IS COMPLEX, LOGICAL, OR CHARACTER / DESTINATION IS COMPLEX, ACC A IS REAL LAC* BOX JMS ROUND JMS STORE1 LAC (777400 / SET IMAGINARY PART TO ZERO SNEAKY LIKE DAC EXPA DZM SIGNA JMS STORE1 JMP* .STORE / DESTINATION COMPLEX, ACC A IS COMPLEX, LOGICAL, OR CHARACTER STCLCC SZL JMP STALCH / ACC A IS LOGICAL OR CHARACTER /DESTINATION IS COMPLEX, ACC A IS COMPLEX LAC* BOX JMS ROUND JMS STORE1 JMS SWAPIT / AI TO A JMP STOMTA / GO STORE IMAGINARY PART / / / / DESTINATION IS LOGICAL STOLOG LAC MODEA SAD (600000 SKP JMP STLCHK / ACC A IS NOT LOGICAL / DESTINATION IS LOGICAL, ACC A IS LOGICAL LAC LOGACC DAC* AUTO2 JMP* .STORE / DESTINATION IS LOGICAL, ACC A IS ARITHMETIC OR CHARACTER STLCHK SAD (700000 JMP STACH / ACC A IS CHARACTER JMP ERR11 / ERROR - NON LOGICAL OR CHAR INTO LOGICAL / / / / DESTINATION IS ARITHMETIC, ACC A IS LOGICAL OR CHARACTER STALCH SPA JMP STACH / ACC A IS CHARACTER ERR11 LAW 11 / ERROR - ILLEGAL STORE JMP* .NERR / / / / DESTINATION IS ANYTHING, ACC A IS CHARACTER STACH LAC* BOX JMS .CHRGT DAC SIGNB JMP STOCK3 / / GET NUMBER OF CHARACTERS IN VARIABLE ELEMENT .CHRGT XX CLL SPA!RTL JMP CHRG2 /COMPLEX OR LOGICAL XOR (12 CHRG3 SMA LRS 1 /I*2,R*4,C*4 SNL RAR /I*2,I*4,C*4,C*8 AND (77 JMP* .CHRGT CHRG2 SZL LAW 53 / LOGICAL XOR (51 /COMPLEX JMP CHRG3 / / / DESTINATION CHARACTER, ACC A IS ALSO CHARACTER / STOCK2 LAC* AUTO2 CLL!RAL RTL JMS GETCNT / GET SIZE OF DESTINATION IN SIGNB / / MOVE (SIGNB) CHARACTERS TO (AUTO2) / FROM (SIGNA) CHARACTERS AT (AUTO1) / STOCK3 LAC SIGNB /CALCULATE NUMBER OF WORDS TO BE MOVED TAD (2 JMS WORDS DAC COUNT2 /-WORDS-1 / LAC SIGNA /GET SMALLER OF (SIGNA) AND (SIGNB) CMA TAD SIGNB SPA!CMA CLA TAD SIGNB JMS MOVCHR JMP* .STORE / / SUBROUTINE TO MOVE CHARACTERS MOVCHR XX JMS WORDS /SPLIT WORD COUNT INTO THOSE BEFORE DAC COUNT LACQ TAD COUNT2 /AND THOSE AFTER DAC COUNT2 JMP LOOP2 /SPACE INSERTIONS / WORDS XX CLL!RAL /MULTIPLY BY 2 IDIV 5 RTL /MULTIPLY REMAINDER BY 4 TAD (JMP EVEN /SET SPACE INSERTIONS ENTRY POINT DAC LOOP3 /BASED ON REMAINDER LACQ CMA JMP* WORDS / LOOP4 DAC* AUTO2 /MOVE CONTIGUOUS BLOCK OF CHARACTERS LOOP2 LAC* AUTO3 ISZ COUNT JMP LOOP4 LOOP3 XX / / WARNING: THE LABELS EVEN,X3,XX1,X4,XX2 MUST OCCUR IN THAT ORDER / WITH A SPACING OF FOUR WORDS BECAUSE THEY ARE ENTERED BY A / CALCULATED JMP. / B1 XOR SPAC /ROUTINE TO PAD BALANCE OF DAC* AUTO2 /VARIABLE WITH 5/7 ASCII SPACES ISZ COUNT2 SKP!CLA JMP* MOVCHR B2 XOR SPAC+1 DAC* AUTO2 EVEN ISZ COUNT2 SKP!CLA JMP* MOVCHR JMP B1 X3 XOR SPAC+1 /KEEP LAST HALF OF THIRD CHARACTER AND (700000 /AND FILL THE REST WITH SPACES ISZ COUNT2 JMP B2 XX1 XOR SPAC /KEEP ONE CHARACTER AND FILL AND (774000 /THE REST WITH SPACES ISZ COUNT2 JMP B1 X4 XOR SPAC+1 /KEEP FOURTH CHARACTER AND FILL THE REST AND (777400 /WITH SPACES ISZ COUNT2 JMP B2 XX2 XOR SPAC /KEEP SECOND CHARACTER AND FILL AND (777760 /THE REST WITH SPACES ISZ COUNT2 JMP B1 / SPAC .ASCII ' ' /5 SPACES FOR PADDING COUNT;COUNT2 / / / SUBROUTINE TO STORE SINGLE OR / DOUBLE FLOATING POINT NUMBER / STORE1 XX LAC SIGNA CLL!RAL /PUT SIGN INTO LINK LAC MOSTA SNA / IF ACC A IS ZERO CLL / MAKE SURE IT IS STORED AS +0.0 RAL /CHOP MOST SIG BIT;SIGN INTO AC 17 DAC* AUTO2 /STORE FIRST WORD LACQ /GET PRECISION INDICATOR FROM ROUND SZA JMP SDOUBL LAC EXPA GSM RAL XOR LEASTA RET DAC* AUTO2 /STORE LAST WORD JMP* STORE1 SDOUBL LAC LEASTA DAC* AUTO2 LAC A3 DAC* AUTO2 LAC EXPA GSM RAL XOR A4 JMP RET / / ROUNDING ROUTINE TO ROUND ACC A TO PRECISION DEMANDED BY LINK / DOUBLE IF 1 , SINGLE IF 0 / ROUND XX AND (100000 /GET PRECISION OF DESTINATION LMQ /SAVE IT FOR STORE1 SZA!CLL JMP R2 /ROUND DOUBLE / LAC (400 TAD LEASTA AND (777000 /PERFORM ROUND OFF DAC LEASTA SZL!CLA!RAR JMP R3 /CARRY OCCURRED / R5 LAC EXPA R7 GSM /CHECK THAT ABS (EXPA) < 377 TAD (-377 SPA JMP* ROUND / SZL!CLA /ZERO AC JMP R9 /OVERFLOW SAD MOSTA /CHECK IF MOSTA =0 JMP R8 /ZERO RESULT LAW 4 /ISSUE STORAGE EXPONENT UNDERFLOW JMS* .ERROR R8 LAC (777400 /ONLY EXPONENT MATTERS R10 DAC EXPA /ON UNDER AND OVERFLOW JMP* ROUND / R2 AND MODEA /CHECK IF WE ARE TRYING DOUBLE SNA /PRECISION ROUND ON R*4 DATA JMP R6 / LAC (400 TAD A4 AND (777000 DAC A4 SNL!CLA!RAR /400000 TO AC JMP R5 /NO CARRY ISZ A3 JMP R5 ISZ LEASTA JMP R5 R3 ISZ MOSTA JMP R5 DAC MOSTA /RESET TO 400000 / RTL ADD EXPA /ADD 1 TO EXPONENT DAC EXPA SNL /TEST FOR OVERFLOW JMP R7 /GO CHECK EXPONENT RANGE / R9 LAW 3 JMS* .ERROR /OVERFLOW ERROR=0 LAC (377 /SET EXPONENT TO MAXIMUM JMP R10 / R6 DZM A3 /EXTEND R*4 TO R*8 DZM A4 JMP R5 / / AI TO A / SWAPIT XX LAC EXPIA DAC EXPA LAC SIGNIA DAC SIGNA LAC MOSTIA DAC MOSTA LAC LESTIA DAC LEASTA LAC AI3 DAC A3 LAC AI4 DAC A4 JMP* SWAPIT / / CONVERT FLOATING POINT TO DOUBLE INTEGER / SHIFT MOSTA+LEASTA BY THE AMOUNT SPECIFIED IN THE / EXPONENT / .FIX XX LAC EXPA SPA!SNA /BOTH MUST BE SATISFIED JMP FIX1 /NEGATIVE EXPONENT OR ZERO EXP TAD (-44 SMA JMP FIX2 /GREATER THAN 2**44 SNA JMP FIX3 /EQUAL TO 2**44 CMA TAD (1 TAD (LRS /LRS +N=44 DAC FIXIT /EQUIVIVALENT TO MOVING CLL /DECIMAL POINT TO RIGHT LAC LEASTA /N PLACES LMQ LAC MOSTA FIXIT XX DAC INT1 LACQ DAC INT2 LAC SIGNA SPA JMS INTACP JMP* .FIX /POSITIVE NUMBER EXIT FIX1 DZM INT1 DZM INT2 JMP* .FIX FIX2 LAC SIGNA / GENERATE +- LARGEST INTEGER JMS LARGEI LAW 2 /ISSUE INTEGER OVERFLOW JMS* .ERROR JMP* .FIX FIX3 LAC (NOP DAC FIXIT JMP FIXIT-3 / / LARGEI XX / INTEGER OVERFLOW SIGN IN AC SMA LAC (377777 DAC INT1 SMA!CLA CMA DAC INT2 JMP* LARGEI / / / STORE NEGATIVE ROUTINE COMPLEMENT NUMBER / AND CALL STORE / .STORN LAC MODEA SAD (600000 JMP STORN2 / ITS LOGICAL JMS .CMPIT / COMPLIMENT THE NUMBER .STORP JMS .STORE JMP .NEXT STORN2 LAC LOGACC CMA DAC LOGACC JMP .STORP / GO DO A STORE NOW .EJECT / / THE FOLLOWING ROUTINES PERFORM THE GT,GTN,LT,LTN,EQ, AND EQN / OPERATIONS BETWEEN ALL INTEGER(*2 AND *4) AND REAL(*4 AND *8) / VARIABLES. THE APPROACH IS TO CONVERT THE XCT USED TO ENTER / THIS ROUTINE INTO A CALL TO THE APPROPRIATE ADD OR SUBTRACT / AND THEN ANALYSE THE RESULTS. / GREAT TAD (SUBR-GTN /SUB_GT,ADD_GTN JMS SPLITR NOP /LEAVE AC FOR + OR - CLA /SET AC=0 FOR 0.0 / LESS TAD (SUBR-LTN /SUB_LT,ADD_LTN JMS SPLITR CMA /COMPLEMENT AC FOR + OR - CLA /SET AC=0 FOR 0.0 / EQUAL TAD (SUBR-EQN /SUB_EQ,ADD_EQN JMS SPLITR CLA /SET AC=0 FOR + OR -1 CLA!CMA /SET AC=-1 FOR 0.0 / / SPLITR XX DAC SPLTOP LAC MODEA SAD (700000 JMP CHRS / EXIT FOR CHARACTER SPLTOP XX /DO ADD/SUBTRACT LAC MODEA SPA!RAL JMP ERR17 /INVALID RESULT,COMPLEX SMA JMP SPLIT1 /INTEGER RESULT LAC MOSTA SMA JMP SPLIT4 /0.0 RESULT LAC SIGNA SPA!CLA!CMA /SET AC=-1 FOR + SPLIT2 CLA /SET AC=0 FOR - SPLIT3 XCT* SPLITR /ADJUST IT DAC LOGACC /STORE LOGICAL RESULT LAC (600000 DAC MODEA /SET MODE JMP .NEXT / SPLIT1 LAC INT1 SPA JMP SPLIT2 /NEGATIVE VALUE SZA!CLA!CMA JMP SPLIT3 /POSITIVE VALUE LAC INT2 SNA!CLA!CMA /SKIP IF POSITIVE SPLIT4 ISZ SPLITR /ZERO RESULT JMP SPLIT3 / ERR17 LAW 17 /COMPLEX VARIABLE WITH RELATIONAL OPERATOR JMP* .NERR / / THE CHARACTER COMPARE ROUTINES FOLLOW CHRS LAC* BOX SPA JMP CJOIN1 / MUST BE CHAR. COMPLEX & LOGIC ILLEGAL .AND (077777 DAC* (AUTO4 .LACI BOX AND (700000 JMS .CHRGT DAC SIGNB CJOIN2 LAC* (AUTO3 DAC* (AUTO5 CJOIN3 LAW -5 TAD SIGNA SPA JMP A.LT.5 DAC SIGNA AAA LAW -5 TAD SIGNB SPA JMP B.LT.5 DAC SIGNB BBB STL!CLA!CMA TAD* AUTO5 CMA!CML TAD* AUTO4 SZA!CMA!CML JMP CJOIN4 TAD* AUTO5 CMA!CML TAD* AUTO4 SNA!CML JMP CJOIN3 CJOIN4 SZL!CLA!CMA JMP SPLIT2 JMP SPLIT3 / CJOIN1 LAC* (AUTO2 DAC* (AUTO4 JMP CJOIN2 / A.LT.5 TAD SIGNB SAD (-5 JMP SPLIT4 / EQUAL LAC* (AUTO5 DAC* (AUTO3 LAC (MOSTA-1 DAC* (AUTO5 DAC* (AUTO2 LAW -3 DAC COUNT2 LAC SIGNA DZM SIGNA JMS MOVCHR JMP AAA / B.LT.5 LAC* (AUTO4 DAC* (AUTO3 LAC (MOSTB-1 DAC* (AUTO4 DAC* (AUTO2 LAW -3 DAC COUNT2 LAC SIGNB DZM SIGNB JMS MOVCHR JMP BBB .EJECT / / / /SINGLE PRECISION INTEGER DIVIDE INTDIV LAC MODEA /GET MODE SZA JMP MXD1 /MIXED MODE LAC* AUTO2 GSM /FORM 2S COMPLEMENT IF NEGATIVE SZL TAD (1 DZM INTMA /EXPAND LEFT WITH ZEROS JMS INTDVD /PERFORM INTEGER DIVIDE JMP .NEXT /RETURN MXD1 JMS PICK1 /GET INTEGER JMS .FLOTB /FLOAT IT JMP DIVRL /PERFORM REAL DIVIDE / DOUBLE PRECISION INTEGER DIVIDE DINTDV LAC MODEA /GET MODE SZA JMP MIXD2 /MIXED MODE LAC* AUTO2 /GET FIRST WORD GSM DAC INTMA /STORE IT LAC* AUTO2 /GET NEXT WORD SNL / IF NEGATIVE, FORM 2S COMPLEMENT JMP DDIV CMA!CLL TAD (1 SZL!CLL!CML /PROPOGATE CARRY ISZ INTMA DDIV JMS INTDVD /PERFORM INTEGER DIVIDE JMP .NEXT /RETURN MIXD2 JMS PICK2 / GET DOUBLE INTEGER JMS .FLOTB /FLOAT IT SAD (200000 JMP DIVRL /SINGLE JMP DIVBL /PERFORM DOUBLE PRECISION DIVIDE /DIVIDE ACCUMULATOR BY REAL NUMBER DIVRL LAC MODEA /GET MODE OF ACCUM SPA!RTL JMP COMPDS /COMPLEX SNL JMP INTGD1 /INTEGER SPA JMP DOUBD1 /DOUBLE DIVS JMS SPRDIV /DO REAL DIVIDE JMP .NEXT /RETURN INTGD1 JMS .FLOTA /FLOAT IT SAD (200000 JMP DIVS /SINGLE DOUBD1 DZM B3 /MAKE IT DOUBLE DZM B4 JMP DIVBL2 /DO DOUBLE PRECISION DIVIDE COMPDS JMS ZEROIB /MAKE IT COMPLEX JMS DIVCPX /DO COMPLEX DIVIDE JMP .NEXT / /DIVIDE ACCUMULATOR BY DOUBLE PRECISION NUMBER / DIVBL LAC MODEA /CHECK MODE OF ACCUM SPA!RTL JMP COMPDD /COMPLEX SNL JMP INTGD2 /INTEGER SMA JMP REALD2 /REAL DIVBL2 JMS DPRDIV /DOUBLE PRECISION DIVIDE JMP .NEXT /RETURN INTGD2 JMS .FLOTA /INTEGER - MAKE REAL SAD (300000 JMP DIVBL2 /DOUBLE REALD2 DZM A3 /MAKE DOUBLE DZM A4 JMP DIVBL2 /GO TO DOUBLE DIVIDE COMPDD JMS ZEROIB /MAKE ACC B COMPLEX JMS DIVDCP /GO TO COMPLEX DIVIDE JMP .NEXT / /DIVDE ACCUMULATOR BY SINGLE PRECISION COMPLEX NUMBER / DIVCPX XX LAC DIVCPX DAC DIVDCP /SET UP RETURN LAC MODEA /GET ACCUM MODE SMA!RTL JMS MKCPX /MAKE COMPLEX SMA JMP SETSGL /SET UP FOR SINGLE PRECISION DZM BI3 /MAKE DOUBLE DZM BI4 DZM B3 DZM B4 JMP SETDBL /SET UP FOR DOUBLE PRECISION / /DIVIDE ACCUMULATOR BY DOUBLE PRECISION COMPLEX / DIVDCP XX LAC MODEA /GET MODE SMA!RTL JMS MKCPX /MAKE COMPLEX SPA JMP SETDBL DZM A3 /MAKE A DOUBLE DZM A4 SETDBL LAC (JMS DPARST /SET UP FOR DOUBLE PRECISION DAC CD1 LAC (JMS DPRMUL DAC CD2 LAC (JMS LDDBL DAC CD3 LAC (JMS DPARLD DAC CD4 LAC (JMS DPRADD DAC CD5 LAC (JMS DPRDIV JMP CDXTIE SETSGL LAC (JMS SPARST /SET UP FOR SINGLE PRECISION DAC CD1 LAC (JMS SPRMUL DAC CD2 LAC (JMS LDREAL DAC CD3 LAC (JMS SPARLD DAC CD4 LAC (JMS SPRADD DAC CD5 LAC (JMS SPRDIV CDXTIE DAC CD6 LAC (SIGNH CD1 XX /STORE A CD2 XX /GET A*B LAC (SIGNS XCT CD1 /SAVE A*B JMS SWAPIT /AI TO A XCT CD2 /GET B*AI LAC (SIGND XCT CD1 /SAVE B*AI CD3 XX /B TO ACC A XCT CD2 /GET B*B LAC (SIGNE XCT CD1 /SAVE B*B JMS SWAPIB /BI TO B JMS .SPBIA /BI TO A XCT CD2 /GET BI*BI LAC (SIGNE CD4 XX /B*B TO ACC B CD5 XX /ADD LAC (SIGNE XCT CD1 /SAVE B*B + BI*BI JMS .SPBIA /BI TO ACC A LAC (SIGNH XCT CD4 /A TO ACC B XCT CD2 /GET A*BI LAC SIGNA XOR (400000 DAC SIGNA /COMPLEMENT ACC A LAC (SIGND XCT CD4 /B*AI TO ACC B XCT CD5 /GET -A*BI + B*AI LAC (SIGNE XCT CD4 /B*B + BI*BI TO ACC B CD6 XX /DIVIDE JMS SWAPA /BI TO B,A TO BI,AI TO A XCT CD2 /GET AI*BI LAC (SIGNS XCT CD4 /A*B TO ACC B XCT CD5 /ADD LAC (SIGNE XCT CD4 /B*B + BI*BI TO ACC B XCT CD6 /DIVIDE LAC MODEA XOR (600000 DAC MODEA /RESTORE COMPLEX MODE JMS MVIMA /BI TO AI JMP* DIVDCP / MKCPX XX /MAKE ACC A COMPLEX AND SNL JMS .FLOTA /FLOAT IF INTEGER JMS ZEROIA / GET MODE OF A INTO ACCUMULATOR LAC MODEA / FOR NEXT TEST RTL JMP* MKCPX / / SETUP FOR A REVERSE DIVIDE- A_B/A / REVERSE DIVIDE SWITCHS ACC'S A & B AND BASED ON THE INITIAL / MODEA XCT'S THE APPROPRIATE DIVIDE THUS SIMULATING A NORMAL / DIVIDE ENTRY. SINCE THE LOAD ROUTINE DO NOT STORE MODEB MUST SET / IT UP. / RDINTD LAC (JMS PICK2 DAC RDIV2 LAC (JMS LDBINT / LOAD DOUBLE INT. JMP RDIVER RINTDI LAC (JMS PICK1 DAC RDIV2 LAC (JMS LDINT / LOAD SINGLE INT. RDIVER DAC RDIV0 LAC MODEA SZA!CLL JMP RDIV2 / MIXED MODE LAC INT1 / ACC A TO B DAC INTMA LAC INT2 DAC INTMB RDIV0 XX / LOAD ACC A LAC INTMA / SIGN & MAG. OF INTDVD GSM DAC INTMA LAC INTMB SNL JMP RDIV1 CMA!CLL TAD (1 SZL!STL ISZ INTMA RDIV1 JMS INTDVD JMP .NEXT RDIV2 XX JMS .FLOTB JMP RDIVMX / RDIVDC LAC (500000 JMP RDIVDE RDIVCX LAC (400000 JMP RDIVDE RDIVDB LAC (300000 JMP RDIVDE RDIVRL LAC (200000 RDIVDE DAC MODEB / MODEB NOW ESTABLISHED RDIVMX LAC MODEA SNA JMS .FLOTA / MIXED MODE CLL RTL; RTL TAD (XCT DENTRY / GET ENTRY TO DIVIDE DAC .+2 JMS REVRSG XX JMP .NEXT /IN CASE DIVIDE IS COMPLEX (JMS IN SUBR TABLE) / /DIVIDE ROUTINE FOR INTEGERS INTDVD XX DAC INTMB /STORE SECOND HALF DIVISOR CLA!RAR / GET SIGN AND STORE DAC BOXX LAC INT1 /GET FIRST WORD OF DIVIDEND SMA /TEST SIGN ANDSET LINK=0 FOR POS JMP DIPOS /POSITIVE BYPASS COMPLEMENTING JMS INTACP /COMPLEMENT DIVIDEND LAC (400000 XOR BOXX DAC BOXX /FINAL SIGN NOW OBTAINED LAC INT1 /IS DIVIDEND DOUBLE DIPOS SZA JMP IDVBL1 /YES LAC INTMA / IS DIVISOR DOUBLE SZA JMP IDVBL2 / YES LAC INTMB / IS DIVISOR ZERO SNA JMP INTDZ / DIVIDE BY ZERO ERROR DAC INTDDD / STORE FOR DIVIDE LAC INT2 / IS DIVIDEND ZERO SNA JMP* INTDVD / LEAVE AS ZERO IDIV /DIVIDE INTDDD XX LACQ /GET RESULT INTO AC DAC INT2 /PUT RESULT BACK DZM INT1 INTDTS LAC BOXX /SIGN THE RESULT SZA JMS INTACP JMP* INTDVD INTDZ LAW 5 /DIVIDING BY ZERO JMS* .ERROR /COMPLAIN LAC BOXX JMS LARGEI / GENERATE LARGE INTEGER JMP* INTDVD IDVBL1 LAC INTMB DAC .+4 /DIVIDE DOUBLE BY SINGLE DAC .+13 LAC INT1 /GET FIRST WORD IDIV /DIVIDE 18 BITS ,DIVIDE IN TWO STEPS XX /AVOIDS ANY POSSIBLE OVERFLOW DAC INTMA /SAVE REMAINDER LACQ /STORE FIRST WORD OF QUOTIENT DAC INT1 LAC INT2 /GET SECOND WORD LMQ /PUT INTO MQ AND LAC INTMA /GET REMAINDER INTO AC DIV /DIVIDE 36 BITS XX LACQ /STORE SECOND WORD OF QUOTIENT DAC INT2 JMP INTDTS / IDVBL2 DAC IDVSR1 / INTMA=C STILL IN ACC DAC IDVSR2 / STORE FOR FUTURE DIVIDES DAC IDVSR4 CMA / WILL ANSWER BE 0 TAD (1 TAD INT1 / IS C>A ? SMA!CLL JMP .+4 DZM INT1 / YES DZM INT2 JMP* INTDVD / RETURN LAC INTMB / SETUP FOR * , D DAC IDVSR3 LAC INT1 MUL / A*D IDVSR3 XX DAC INTMA LACQ DAC INTMB LAC INTMA / START X/C FOR A*D/C IDIV / LINK=0 IDVSR1 XX DAC IDVSR1 / SAVE REMAINDER LACQ CMA!CLL / GENERATE -(A*D)/C DAC INTMA LAC INTMB LMQ LAC IDVSR1 / RESTORE REMAINDER DIV / FINISH DIVIDE BY C IDVSR2 XX LACQ CMA!CLL / MAKE LEAST -(A*D)/C TAD (1 / GENERATE POSSIBLE CARRY SZL!CLL ISZ INTMA / PROPAGATE CARRY NOP TAD INT2 / ADD B GEN CARRY & DROP REST GLK TAD INTMA / A+(B-(A*D)/C) TAD INT1 CLL IDIV IDVSR4 XX / ANSWER IS ALWAYS < 2**18 LACQ DAC INT2 DZM INT1 JMP INTDTS / / / SINGLE PRECISION DIVIDE / SPRDIV XX / T = 133 MICROSECONDS LAC MOSTB /SET UP DIVISOR SZA JMP .+4 DIVSZ LAW 5 /DIVIDE BY ZERO -ERROR JMS* .ERROR JMP DOVER / GENERATE INFINITY DAC RDVDR1 /STORING C FOR FUTURE DIVIDES DAC RDVDR2 DAC RDVDR3 LAC LEASTB DAC RMPYR1 / D LAC MOSTA / MAKE NUMERATOR SMALLER THEN DEN SNA!CLL!RAR /TO AVOID DIVIDE OVERFLOW JMP* SPRDIV / ANSWER WILL BE ZERO-RETURN DAC MOSTA LAC LEASTA RAR DAC LEASTA LAC MOSTA /A CLL MUL RMPYR1 XX /(A*D) DIV RDVDR1 XX /((A*D)/C) LACQ /SMASH REMAINDER SINCE IT IS LOST CMA!CLL / ANY WAY TAD (1 /GET -((A*D)/C) TAD LEASTA /ADD B LMQ /STORE IN MQ FOR DIVIDE SZL!CLA!CMA!CLL /ALL 0'S TO ALL 1'S ON TWO'S COMP CLA /TO ALL 0'S IF CARRY FROM ADDITION TAD MOSTA /A+(B-((A*D)/C) ADD A CLL DIV RDVDR2 XX /DIVIDE A BY C DAC RDVDR2 /STORE REMAINDER LACQ DAC MOSTA LAC RDVDR2 FRDIV RDVDR3 XX /ANSWER IN AC & MQ AFTER NEXT INSTR. LAC MOSTA /(A+(B-((A*D)/C)))/C SMA!STL /IF NO SHIFT-L_0,ASSUME L_1 LLSS+1 /L_0 , SHIFT TO NORMALIZE DAC MOSTA /STORE RESULT LACQ DAC LEASTA LAC SIGNA /DETERMINE RESULT SIGN XOR SIGNB DAC SIGNA GLK / NO SHIFT THEN INCR EXPA ADD EXPA CMA / GET NEG. ADD EXPB / = -(FINAL EXPA VALUE) SZL / ANY OVER OR UNDER FLOW JMP DVOVUN / YES SNA!CMA / CORRECT EXPA SIGN ; -0? CLA / -0 TO +0 DAC EXPA JMP* SPRDIV DVOVUN LAC EXPB /OVERFLOW OR UNDERFLOW SMA!CLA JMP DVUN /UNDERFLOW JMS* .ERROR DOVER JMS INFIN /MAKE INFINITY JMP* SPRDIV /RETURN DVUN LAW 1 /UNDERFLOW -COMPLAIN JMS* .ERROR JMS ZERVAL /MAKE ZERO JMP* SPRDIV /RETURN / / /DOUBLE PRECISION DIVIDE IS OBTAINED BY CALCULATING / 1/B USING A SINGLE PRECISION DIVIDE AND IMPROVING BY ONE / ITERATION OF NEWTON RAPHASON ROUTINE AND THEN MULTIPLYING / BY A. / / IF WE LET F(XI) = B-1/XI / / THEN IF F(XI)=0 THEN XI = 1/B / / X(I+1)= X(I)*(2-B*X(I) / / SINCE X(I+1) = X(I) - F(X(I))/F'(X(I)) / / THE FINAL ANSWER IS A*X(I+1) / / / DPRDIV XX LAC MOSTB / IS ANSWER INFINITY SZA JMP DPRNZ LAC DPRDIV / TRANSFER RETURN ADDRESS DAC SPRDIV JMP DIVSZ / CONNECT TO ERROR POINT DPRNZ LAC MOSTA / WILL ANSWER BE ZERO SNA JMP* DPRDIV LAC (DPDSTA / STORE ACC A TEMP JMS DPARST JMS .LOAD1 /SET ACC A TO 1.0 JMS SPRDIV / GET SPRDIV XI = 1/B LAC (SIGNH / STORE XI JMS SPARST DZM A3 / MAKE XI DOUBLE DZM A4 JMS DPRMUL / GET B*XI LAC (400000 / B*XI .GE. 0 DAC MOSTB DAC SIGNA /GET -( B*XI) DZM SIGNB / PUT 2 IN ACC B LAC (2 DAC EXPB DZM LEASTB / EXTEND TO DOUBLE PREC. DZM B3 DZM B4 JMS DPRADD / GET (2-B*XI) LAC (SIGNH / XI TO ACC B JMS SPARLD JMS DPRMUL / XI*(2-B*XI) LAC (DPDSTA / LOAD ACC A FROM STORE TO ACC B JMS DPARLD JMS DPRMUL / ANS=A*(1/B) JMP* DPRDIV / / .EJECT / / WATRAN EXPONENTIATION PACKAGE / / / / -(ACC A) ** SINGLE INTEGER / NINTXP JMS IRSEPX JMS .CMPIT / / ACC A ** SINGLE INTEGER / INTEXP LAC* AUTO2 /LOAD INTEGER INTO EXPONENT STORAGE DAC LEASTN SPA!CLA CMA DAC MOSTN TOINT JMS ITEXP /DO INTEGER EXPONENTIATION JMP .NEXT / / -(ACC A) ** DOUBLE INTEGER / NDNTXP JMS IRSEPX JMS .CMPIT / / ACC A ** DOUBLE INTEGER / DNTEXP LAC* AUTO2 /LOAD DOUBLE INTEGER INTO EXPONENT STORAGE DAC MOSTN LAC* AUTO2 DAC LEASTN JMP TOINT /INTEGER EXPONENTIATION / / -(ACC A) ** SINGLE PRECISION REAL / NRELXP JMS COMPLA JMP RELEXP / / -(ACC A) ** -(SINGLE PRECISION REAL) / NRELXN JMS COMPLA / / ACC A ** -(SINGLE PRECISION REAL) / RELXPN JMS COMPLB / / ACC A ** SINGLE PRECISION REAL / RELEXP JMS MODCHK /ENSURE ACC A IS REAL SAD (300000 /AC CONTAINS MODEA STL /SET LINK IF DOUBLE PRECISION LAC (200000 / SET UP MODE OF B AS REAL DAC MODEB JMS REVRSG / SWAP ACC'S SNL /TEST LINK JMP SPEXP /ACC A IS SINGLE PRECISION,DO REAL**REAL JMP DBLAD / / -(ACC A) ** DOUBLE PRECISION REAL / NDBLXP JMS COMPLA JMP DBLEXP / / -(ACC A) ** -(DOUBLE PRECISION REAL) / NDBLXN JMS COMPLA / / ACC A ** -(DOUBLE PRECISION REAL) / DBLXPN JMS COMPLB / / ACC A ** DOUBLE PRECISION REAL / DBLEXP JMS MODCHK /ENSURE ACC A IS REAL SAD (300000 /AC CONTAINS MODEA STL /SET LINK IF DOUBLE REAL LAC (300000 / SET UP MODE OF B AS DOUBLE REAL DAC MODEB JMS REVRSG /SWAP ACC'S SNL /TEST LINK JMP DBLAR /ACC A IS SINGLE REAL JMP DPEXP /DO DOUBLE ** DOUBLE / / SINGLE INTEGER ** ACC A / RINTXP JMS IRSEPX SPA /SKIP IF ACC A IS INTEGER JMP RIXPRL JMS LDEXPI /LOAD ACC A INTEGER INTO EXPONENT STORAGE JMS LDINT /LOAD INTEGER INTO ACC A JMP TOINT /DO INTEGER EXPONENTIATION RIXPRL JMS LDINT JMP BRNEXP /ACC A IS REAL; DO REAL**REAL OR DOUBLE ** DOUBLE / / DOUBLE INTEGER ** ACC A / RDNTXP JMS IRSEPX SPA /SKIP IF INTEGER JMP RDXPRL JMS LDEXPI /LAOD ACC A INTEGER INTO EXPONENT STORAGE JMS LDBINT /LOAD DOUBLE INTEGER JMP TOINT RDXPRL JMS LDBINT JMP BRNEXP /ACC A REAL; DO REAL ** REAL OR DOUBLE ** DOUBLE / / -(SINGLE PRECISION REAL) ** ACC A / RNRELX JMS COMPLB JMP RRELXP / / -(SINGLE PRECISION REAL) ** -(ACC A) / RNREXN JMS COMPLB / / SINGLE PRECISION REAL ** -(ACC A) / RRELXN JMS .CMPIT / / SINGLE PRECISION REAL ** ACC A / RRELXP LAC MODEA SZA JMP RTOR JMS LDEXPI /INT ACC A TO EXPONENT JMS LDREAL /BASE TO ACC A JMP TOINT RTOR JMS MODCHK /ENSURE ACC A IS REAL SAD (200000 /AC CONTAINS MODEA JMP SPEXP /ACC A IS SP; DO REAL ** REAL DBLAR DZM B3 /ACC A IS DOUBLE; SET ACC B TO DP DZM B4 JMP DPEXP /DO DOUBLE ** DOUBLE / / -(DOUBLE PRECISION REAL) ** ACC A / RNDBLX JMS COMPLB JMP RDBLXP / / -(DOUBLE PRECISION REAL) ** -(ACC A) / RNDBXN JMS COMPLB / / DOUBLE PRECISION REAL ** -(ACC A) / RDBLXN JMS .CMPIT / / DOUBLE PRECISION ** ACC A / RDBLXP LAC MODEA SZA JMP DTOR JMS LDEXPI /INT ACC A TO EXPONENT JMS LDDBL /BASE TO ACC A JMP TOINT DTOR JMS MODCHK /ENSURE ACC A IS REAL SAD (300000 /AC CONTAINS MODEA JMS DPEXP /DO DOUBLE ** DOUBLE DBLAD DZM A3 /ACC A IS SINGLE; SET TO DOUBLE DZM A4 LAC (300000 DAC MODEA JMP DPEXP / / -(ACC A) ** -(SINGLE INTEGER) / NINTXN JMS IRSEPX JMS .CMPIT / / ACC A ** -(SINGLE INTEGER) / INTXPN LAW -1 /LOAD INTEGER COMPLEMENT INTO EXPONENT STORAGE TAD* AUTO2 CMA DAC LEASTN SPA!CLA CMA DAC MOSTN JMP TOINT /DO INTEGER EXPONTIATION / / -(ACC A) ** -(DOUBLE INTEGER) / NDNTXN JMS IRSEPX JMS .CMPIT / / ACC A ** -(DOUBLE INTEGER) / DNTXPN LAC* AUTO2 /LOAD INTEGER COMPLEMENT INTO EXPONENT STORAGE CMA DAC MOSTN LAC* AUTO2 CMA!CLL TAD (1 DAC LEASTN SZL ISZ MOSTN JMP TOINT /DO INTEGER EXPONENTIATION / / SINGLE INTEGER ** -(ACC A) / RINTXN JMS IRSEPX SPA /SKIP ON INTEGER ACC A JMP RIXNRL JMS INTACP /COMPLEMENT INTEGER ACC A JMS LDEXPI /LOAD EXPONENT STORAGE FROM INTEGER ACC JMS LDINT /LOAD INTEGER JMP TOINT /DO INTEGER EXPONENTIATION RIXNRL JMS COMPLA /ACC A REAL; COMPLEMENT IT JMS LDINT /LOAD INTEGER BASE JMP BRNEXP /DO APPROPRIATE REAL EXPONENTIATION / / DOUBLE INTEGER ** -(ACC A) / RDNTXN JMS IRSEPX SPA /SKIP ON INTEGER ACC A JMP RDXNRL JMS INTACP /COMPLIMENT INTEGER ACC JMS LDEXPI /LOAD ACC INTO EXPONENT STORAGE JMS LDBINT /LOAD DOUBLE INTEGER INTO ACC JMP TOINT /DO INTEGER EXPONENTIATION RDXNRL JMS COMPLA /ACC A REAL; COMPLEMENT IT JMS LDBINT /LOAD DOUBLE INTEGER JMP BRNEXP /DO APPROPRIATE REAL EXPONENTIATION / / -(SINGLE INTEGER) ** ACC A / RNINTX JMS IRSEPX SPA /SKIP IF ACC A INTEGER JMP RNIXRL JMS LDEXPI /LOAD EXPONENT FROM ACC A INTEGER JMS LNINT /LOAD NEGATIVE INTEGER JMP TOINT /DO INTEGER EXPONENTIATE RNIXRL JMS LNINT /LOAD NEGATIVE INTEGER JMP BRNEXP /DO APPROPRIATE REAL EXPONENTIATE / / -(DOUBLE INTEGER) ** ACC A / RNDNTX JMS IRSEPX SPA /SKIP IF INTEGER JMP RNDXRL JMS LDEXPI /LOAD EXPONENT FROM INTEGER ACC A JMS LNBINT /LOAD NEGATIVE DOUBLE INTEGER JMP TOINT RNDXRL JMS LNBINT /LOAD NEGATIVE DOUBLE INTEGER JMP BRNEXP /DO REAL EXPONENTIATE / / -(SINGLE INTEGER) ** -(ACC A) / RNINXN JMS IRSEPX SPA /SKIP IF ACC A INTEGER JMP RNINRL JMS INTACP /COMPLEMENT INTEGER ACC A JMS LDEXPI /LOAD EXPONENT FROM INTEGER ACC A JMS LNINT /LOAD NEGATIVE SINGLE INTEGER JMP TOINT /INTEGER EXPONENTIATE RNINRL JMS COMPLA JMS LNINT /LOAD NEGATIVE INTEGER JMP BRNEXP /REAL EXPONENTIATE / / -(DOUBLE INTEGER) ** -(ACC A) / RNDNXN JMS IRSEPX SPA /SKIP IF ACC A INTEGER JMP RNDNRL JMS INTACP /COMPLEMENT INTEGER ACC A JMS LDEXPI /LOAD EXPONENT FROM INTEGER ACC A JMS LNBINT /LOAD NEGATIVE DOUBLE INTEGER JMP TOINT /INTEGER EXPONENTIATE RNDNRL JMS COMPLA /COMPLEMENT ACC A JMS LNBINT /LOAD NEGATIVE DOUBLE INTEGER JMP BRNEXP /REAL EXPONENTIATE / / BRNEXP IS USED IN REVERSE EXPONENTIATE WHEN AN INTEGER / IS RAISED TO A REAL POWER. IT FLOATS THE INTEGER AND THEN / BRANCHES TO EITHER REAL ** REAL OR DOUBLE ** DOUBLE. / BRNEXP JMS .FLOTB /FLOAT INTEGER ACC A INTO ACC B LAC ADDR1 /RESTORE MODEA WHICH WAS DESTROYED DAC MODEA /WHEN THE INTEGER WAS LOADED. LAC MODEB /CHECK FOR SINGLE OR DOUBLE PRECISION ACC B RTL SPA /SKIP ON SINGLE PRECISION JMP RDBLXP JMP RRELXP /REVERSE REAL EXPONENTIATE / / IRSEPX XX LAC MODEA DAC ADDR1 SPA!RAL JMP EXPERR /EXPONENT COMPLEX,LOGICAL,OR CHARACTER JMP* IRSEPX / EXPERR LAW 20 /ILLEGAL MODE MIXING JMP* .NERR / / COMPLEMENT INTEGER ACC A / INTACP XX LAC INT2 CMA!CLL TAD (1 DAC INT2 LAC INT1 CMA!SZL TAD (1 DAC INT1 JMP* INTACP / / LOAD INTEGER ACC A INTO EXPONENT / LDEXPI XX LAC INT1 DAC MOSTN LAC INT2 DAC LEASTN JMP* LDEXPI / / CHECK MODEA; FLOAT IF INTEGER, ISSUE ERROR IF COMPLEX,LOGICAL / OR CHARACTER. RETURN WITH MODEA IN AC UNLESS ERROR. / IF ERROR THE EXPONENTIATION IS NOT PERFORMED. / MODCHK XX LAC MODEA SPA!RCL JMP EXPERR /ACC A IS COMPLEX,LOGICAL, OR CHARACTER SMA!RAR JMS .FLOTA JMP* MODCHK / / THIS ROUTINE COMPLEMENTS ACC A WHETHER IT'S REAL OR INTEGER / .CMPIT XX LAC MODEA SZA JMP EXREAL / ITS REAL JMS INTACP / COMPLIMENT INTEGER JMP* .CMPIT EXREAL JMS COMPLA / COMPLIMENT REAL JMP* .CMPIT / / ACC A ** INTEGER / ITEXP XX LAC MOSTN /EXPONENT IN MOSTN,LEASTN SMA!CMA /COMPLEMENT IF NEGATIVE JMP EXPOS DAC MOSTN LAC LEASTN CMA!CLL TAD (1 SZL ISZ MOSTN DAC LEASTN CLC!SKP EXPOS CLA DAC SIGNEN /STORE EXPONENT SIGN LAC MODEA /CHECK MODE OF BASE SPA!RCL JMP CCLI /COMPLEX,LOGICAL OR CHARACTER SMA!RAL JMP INTSET /INTEGER SPA JMP DBLSET /DOUBLE PRECISION REAL / LAC (JMS SPARST /SINGLE PRECISION REAL SET UP. DAC OP0 LAC (JMS SPARLD DAC OP1 LAC (JMS SPRMUL DAC OP2 LAC (JMS SPRDIV DAC OP3 LAC (JMS .LODBS EXPI DAC OP4 / / INTEGER EXPONENTIATION / LAC MOSTN SZA!STL JMP MODGOT / EXPONENT IS NEITHER 0 NOR 1 SAD LEASTN JMP EXPZRO / EXPONENT IS ZERO RAL / SET AC TO 1 SAD LEASTN JMP EXPONE / EXPONENT IS ONE / MODGOT LAC LEASTN /EXPONENT TO AC,MQ LMQ LAC MOSTN NORMS /NORMALIZE DAC MOSTN LAW 17700 OSC TAD (2 DAC SESS /SET UP SHIFT COUNTER LAC MOSTN LLS 1 /STORE NEW EXPONENT DAC MOSTN LACQ DAC LEASTN LAC (ADDR1 OP0 XX /STORE ACC A OP4 XX /LOAD ACC B FROM ACC A OP2 XX /MULTIPLY TO FORM SQUARE OF ORIGINAL ACC A LAC LEASTN /EXPONENT TO AC,MQ LMQ LAC MOSTN LLS 1 DAC MOSTN LACQ DAC LEASTN LAC MOSTN SMA JMP XTAG /IF NEXT BIT 0, INCREMENT COUNTER AND REPEAT LAC (ADDR1 /IF 1, MULTIPLY BY ORIGINAL ACC A OP1 XX XCT OP2 XTAG ISZ SESS /INCREMENT SHIFT COUNTER JMP OP4 /ANSWER NOT YET COMPLETE LAC MODEA SNA /CHECK FOR INTEGER MODE JMP INVINT INVERT LAC SIGNEN /IF EXPONENT WAS NEGATIVE,INVERT IT SNA JMP* ITEXP LAC MODEA SMA JMP ANSRL /REAL LAC MOSTIA /COMPLEX SZA!CLA JMP LONE ANSRL LAC MOSTA SNA!CLA JMP EXWRN /ERROR: 0.0**X WHERE X.LE.0 LONE XCT OP4 /ACC A TO ACC B JMS .LOAD1 /1.0 TO ACC A JMS ZEROIA /ZERO AI OP3 XX /DIVIDE JMP* ITEXP / EXWRN JMS INFIN WRNXIT LAW 22 JMS* .ERROR JMP* ITEXP / INVINT LAC SIGN /CHECK IF ANSWER SHOULD BE COMPLEMENTED SZA JMS INTACP JMP* ITEXP / / BASE IS DOUBLE PRECISION REAL / DBLSET LAC (JMS DPARST DAC OP0 LAC (JMS DPARLD DAC OP1 LAC (JMS DPRMUL DAC OP2 LAC (JMS DPRDIV DAC OP3 LAC (JMS LOADBD JMP EXPI / / BASE IS INTEGER / INTSET LAC SIGNEN /CHECK EXPONENT SIGN SMA!CLA!STL JMP CHKSGN /EXPONENT IS POSITIVE SAD INT1 SKP JMP ENTERI SAD INT2 JMP IEXWRN /0**I WHERE I.LT.0 ENTERI SAD INT1 /MINUS EXPONENT. IF BASE IS 1 ANSWER IS 1 RAL!SKP /IF NOT 1 ANSWER IS 0 JMP ZERINT SAD INT2 JMP* ITEXP ZERINT DZM INT1 DZM INT2 JMP* ITEXP CHKSGN LAC INT1 SMA!CLA /CHECK FOR NEGATIVE BASE JMP SETSGN JMS INTACP LAC LEASTN RCR SZL!CLA CMA SETSGN DAC SIGN /SIGN=-1 IF BASE IS NEGATIVE AND EXPONENT IS ODD. LAC (JMS INARST DAC OP0 LAC (JMS INARLD DAC OP1 LAC (JMS INTMPY DAC OP2 LAC (JMS LOADBI JMP EXPI / IEXWRN JMS LARGEI JMP WRNXIT / / BASE IS COMPLEX,LOGICAL OR CHARACTER / CCLI SPA!RAL JMP EXPERR /LOGICAL OR CHARACTER SPA JMP CDXSET / / BASE IS SINGLE PRECISION COMPLEX / LAC (JMS CXARST DAC OP0 LAC (JMS CXARLD DAC OP1 LAC (JMS MULCPX DAC OP2 LAC (JMS DIVCPX DAC OP3 LAC (JMS LOADCX JMP EXPI / / BASE IS DOUBLE PRECISION COMPLEX / CDXSET LAC (JMS CDARST DAC OP0 LAC (JMS CDARLD DAC OP1 LAC (JMS MULDCP DAC OP2 LAC (JMS DIVDCP DAC OP3 LAC (JMS LOADDX JMP EXPI / / EXPONENT IS ZERO / EXPZRO LAC MODEA SZA /SEPARATE INTEGER JMP CKRELZ LAC INT1 SAD INT2 SZA SKP!CLA!STL JMP IEXERR /0**0 DAC INT1 RAL DAC INT2 /I**0=1 JMP* ITEXP / CKRELZ SMA JMP CKRS /BASE IS REAL LAC MOSTIA /BASE IS COMPLEX OR ILLEGAL SNA JMP CKRS JMS ZEROIA JMP CKNZ CKRS LAC MOSTA SNA JMP IEXERR /ERROR 0.0**0 CKNZ JMS .LOAD1 /X**0=1.0 JMP* ITEXP / IEXERR LAW 21 JMS* .ERROR / / EXPONENT IS ONE / EXPONE LAC MODEA SZA /SEPARATE INTEGER JMP INVERT LAC SIGNEN SNA!CLA!STL JMP* ITEXP JMP ENTERI / / LOAD SINGLE PRECISION REAL FROM ACC A INTO ACC B / .LODBS XX LAC SIGNA DAC SIGNB LAC EXPA DAC EXPB LAC MOSTA DAC MOSTB LAC LEASTA DAC LEASTB JMP* .LODBS / / LOAD DOUBLE PRECISION REAL FROM ACC A INTO ACC B / LOADBD XX JMS .LODBS LAC A3 DAC B3 LAC A4 DAC B4 JMP* LOADBD / / LOAD SINGLE PRECISION COMPLEX FROM ACC A INTO ACC B / LOADCX XX JMS .LODBS LAC SIGNIA DAC SIGNIB LAC EXPIA DAC EXPIB LAC MOSTIA DAC MOSTIB LAC LESTIA DAC LESTIB JMP* LOADCX / / LOAD DOUBLE PRECISION COMPLEX FROM ACC A INTO ACC B / LOADDX XX JMS LOADCX LAC A3 DAC B3 LAC A4 DAC B4 LAC AI3 DAC BI3 LAC AI4 DAC BI4 JMP* LOADDX / / LOAD INTEGER FROM ACC A IO INTEGER WORK SPACE / LOADBI XX LAC INT1 DAC INTMA LAC INT2 JMP* LOADBI / / TEMPORARY INTEGER STORE / INARST XX LAC INT1 DAC ADDR1 LAC INT2 DAC ADDR1+1 JMP* INARST / / TEMPORARY INTEGER LOAD / INARLD XX LAC ADDR1 DAC INTMA LAC ADDR1+1 JMP* INARLD / / TEMPORARY SINGLE PRECISION COMPLEX STORE / CXARST XX JMS SPARST LAC MOSTIA STL SZA!RAR LAC EXPIA DAC* AUTO6 LAC SIGNIA CLL!RAL LAC MOSTIA RAL DAC* AUTO6 LAC LESTIA DAC* AUTO6 JMP* CXARST / / TEMPORARY SINGLE PRECISION COMPLEX LOAD / CXARLD XX JMS SPARLD LAC* AUTO6 SAD (400000 JMP ZERCX DAC EXPIB STL LAC* AUTO6 RAR DAC MOSTIB CLA!RAR DAC SIGNIB LAC* AUTO6 DAC LESTIB JMP* CXARLD ZERCX JMS ZEROIB JMP* CXARLD / / TEMPORARY DOUBLE PRECISION COMPLEX STORE / CDARST XX JMS CXARST LAC A3 DAC* AUTO6 LAC A4 DAC* AUTO6 LAC AI3 DAC* AUTO6 LAC AI3 DAC* AUTO6 JMP* CDARST / / TEMPORARY DOUBLE PRECISION COMPLEX LOAD / CDARLD XX JMS CXARLD LAC (400000 SAD EXPB JMP CDCHIB LAC* AUTO6 DAC B3 LAC* AUTO6 DAC B4 LAC (400000 CDCHIB SAD EXPIB JMP* CDARLD LAC* AUTO6 DAC BI3 LAC* AUTO6 DAC BI4 JMP* CDARLD / / ROUTINE TO LOAD 1.0 INTO ACC A / .LOAD1 XX JMS ZERVAL DAC MOSTA LAC (1 DAC EXPA JMP* .LOAD1 / / REAL ** REAL / SPEXP JMS CHEKIT LAC (SAVEY JMS SPARST JMS LDREAL JMS .SPLG2 LAC (SAVEY JMS SPARLD JMS SPRMUL JMS .SPXP2 JMP .NEXT / / DOUBLE ** DOUBLE / DPEXP JMS CHEKIT LAC (SAVEY JMS DPARST JMS LDDBL JMS .DPLG2 LAC (SAVEY JMS DPARLD JMS DPRMUL JMS .DPXP2 JMP .NEXT / / ROUTINE TO CHECK SPECIAL EXPONENTIATION CASES / CHEKIT XX LAC MOSTB SZA JMP BNOT LAC SIGNA SZA JMP RWRN /0**X WHERE X IS NEGATIVE LAC MOSTA SNA JMP IEXERR /0**0 JMS ZERVAL /0**X WHERE X.GT.0, RESULT IS ZERO JMP .NEXT BNOT LAC MOSTA SZA JMP* CHEKIT JMS .LOAD1 /X**0=1 JMP .NEXT / RWRN LAC (.NEXT DAC ITEXP JMP EXWRN / / MISCELLANEOUS STORAGE / SESS;MOSTN;LEASTN;SIGNEN LARGE;SIGN / / .EJECT / .IABS XX JMS .IFIX / CHECK MODE LAC INT1 SPA JMS INTACP / INTEGER IS NEGATIVE , COMPLIMENT IT. JMP* .IABS / / .FLOAT XX CLL!RAL SZL JMP ILMODE / COMPLEX MODE,ERROR SMA!RAR JMS .FLOTA / INTEGER MODE,FLOAT IT JMP* .FLOAT / .IFIX XX CLL!RAL SZL JMP ILMODE / COMPLEX MODE,ERROR SPA!RAR JMS .FIX / REAL MODE, FIX IT DZM MODEA / MARK AS INTEGER JMP* .IFIX / / NON COMPLEX TO SINGLE REAL .SNGL XX JMS .FLOAT LAC (200000 DAC MODEA / MARK AS REAL MODE JMP* .SNGL / / / ALOG10 CALCULATES LOG X TO BASE 10 / .ALG10 XX JMS .SNGL /CHECK MODE JMS .SPLG2 /CALCULATE LOG X TO BASE 2 LAC .LOG2 JMS SPARLD JMS SPRMUL /MULTIPLY BY LOG 2 TO BASE 10 JMP* .ALG10 / ILMODE LAW 24 JMP* .NERR .EJECT / / SINGLE PRECISION LOG ROUTINES / / .SPLG2 CALCULATES LOG X TO BASE 2 .SPLG2 XX LAC SIGNA SZA JMP ILLARG /NEGATIVE ARGUMENT LAC MOSTA SNA JMP ILLARG /ZERO ARGUMENT LAC EXPA SPA TAD (1 DAC INT2 /SAVE EXPONENT SPA!CLA CMA DAC INT1 DZM EXPA LAC (ADDR1 JMS SPARST /SAVE FRACTION IN ADDR1 LAC .MPT63 JMS SPARLD JMS SPADD /SUBTRACT 0.63 LAC SIGNA SZA JMP FIRST LAC .MPT16 JMS SPARLD JMS SPADD /SUBTRACT 0.16 LAC SIGNA SZA JMP SECOND LAC (6 /SET POINTER TO THIRD GROUP JMP .+3 FIRST SKP!CLA /SET POINTER TO FIRST GROUP SECOND LAC (3 /SET POINTER TO SECOND GROUP DAC PNTR LAC (ADDR1 JMS SPARLD /LOAD F JMS LDREAL /INTO ACC A LAC PNTR TAD .S JMS SPARLD JMS SPADD /F+S(F) LAC (ADDR2 JMS SPARST /STORE F+S(F) LAC PNTR TAD .S JMS SPARLD JMS COMPLB JMS LDREAL LAC (ADDR1 JMS SPARLD JMS SPADD /F-S(F) LAC (ADDR2 JMS SPARLD /LOAD F+S(F) JMS SPRDIV /R IN ACC A LAC (ADDR1 JMS SPARST /STORE R JMS .LODBS JMS SPRMUL /FORM R**2 LAC .C JMS SPARLD JMS SPADD /C+R**2 IN ACC A LAC .B JMS SPARLD LAC (200000 DAC MODEB /SET MODEB BEFORE CALLING REVRSG JMS REVRSG JMS SPRDIV /B/(C+R**2) LAC .A JMS SPARLD JMS SPADD /A+B/(C+R**2) LAC (ADDR1 JMS SPARLD JMS SPRMUL /R*(A+B/(C+R**2)) LAC .T TAD PNTR JMS SPARLD /-T(F) IN ACC B JMS SPADD /A+B/(C+R**2)-T(F) JMS .FLOTB /FLOAT EXPONENT INTO ACC B JMS SPADD /CALCULATE FULL LOG JMP* .SPLG2 /NORMAL EXIT ILLARG LAW 7 JMS* .ERROR /ISSUE ERROR LAC (400000 /ZERO OR NEGATIVE ARGUMENT DAC SIGNA JMS INFIN /SET ACC A TO - INFINITY JMP* .SPLG2 / / SINGLE PRECISION EXPONENTIAL ROUTINES / / .SPXP2 CALCULATES 2**X .SPXP2 XX LAC (ADDR1 JMS SPARST LAC SIGNA JMS .LDPT5 JMS SPADD /ADD 0.5 JMS .FIX /VALUE M IN INT1,INT2 LAC INT1 SZA CMA SZA!CLA /AC MUST NOW BE ZERO TO PREVENT FUTURE JMP OVFL /EXPONENT OVERFLOW LAC INT2 DAC LARGE /SAVE INT2 AS IT WILL BE DESTROYED BY FLOAT JMS .FLOTA /FLOAT M AND PLACE IN ACC A LAC (ADDR1 JMS SPARLD /LOAD X INTO ACC B JMS COMPLA /COMPLEMENT ACC A AND JMS SPADD /ADD TO PRODUCE R LAC (ADDR1 JMS SPARST /STORE R IN ADDR1 JMS .LODBS JMS SPRMUL /R**2 IN ACC A LAC (ADDR2 JMS SPARST /STORE R**2 IN ADDR2 LAC .C4 JMS SPARLD JMS SPRADD /C4+R**2 IN ACC A LAC (ADDR1 JMS SPARLD /R IN ACC B JMS SPRMUL /(C4+R**2)*R LAC .C3 JMS SPARLD JMS SPRMUL /(C4+R**2)*R*C3=B(R) LAC (ADDR1 JMS SPARST /B(R) IN ADDR1 LAC .C2 JMS SPARLD JMS LDREAL /C2 IN ACC A LAC (ADDR2 JMS SPARLD JMS SPRADD /C2+R**2 LAC (ADDR2 JMS SPARLD JMS SPRMUL /(C2+R**2)*R**2 LAC .C1 JMS SPARLD /C1 IN ACC B JMS SPRADD /(C2+R**2)*R**2+C1=A(R) LAC (ADDR2 JMS SPARST /A(R) IN ADDR2 LAC (ADDR1 JMS SPARLD /B(R) IN ACC B JMS COMPLB JMS SPADD /A(R)-B(R) IN ACC A LAC (ADDR1 JMS SPARLD LAC (ADDR1 JMS SPARST /STORE A(R)-B(R) JMS LDREAL LAC (ADDR2 JMS SPARLD JMS SPADD /A(R)+B(R) LAC (ADDR1 JMS SPARLD /A(R)-B(R) IN ACC B JMS SPRDIV /DIVIDE,RESULT=2**R LAC LARGE /GET M SPA TAD (-1 /2'S COMPLEMENT TO 1'S COMPLEMENT CLL ADD EXPA DAC EXPA /MULTIPLY RESULT BY 2**M SNL!CLA JMP* .SPXP2 /NORMAL EXIT OVFL JMS* .ERROR / OVERFLOW ISSUE ERROR JMS INFIN / GENERATE INFINITY JMP* .SPXP2 /AND EXIT / / TEMPORARY STORAGE FOR Y SAVEY .BLOCK 5 / ADDR1 .BLOCK 5 ADDR2 .BLOCK 5 / TEMPORARY STORAGE LOCATIONS .CNTR;PNTR .EJECT / / / ROUTINE TO CALCULATE DP LOG X TO BASE 2 / X IN ACC A / .DPLG2 XX LAC .DPLG2 DAC .SPLG2 /RETURN ADDRESS IN CASE OF ERROR LAC SIGNA SZA!STL JMP ILLARG /NEGATIVE ARGUMENT ILLEGAL LAC MOSTA SNA!RAR /AC=400000 JMP ILLARG /ZERO ARGUMENT LAC EXPA SPA TAD (1 /1'S COMPLEMENT TO 2' COMPLEMENT DAC INT2 SPA!CLA CMA DAC INT1 /SAVE K IN INTEGER ACC A DZM EXPA LAC (ADDR1 /STORE M JMS DPARST LAC .MSQ2O2 /GET -SQRT(2)/2 JMS DPARLD DZM SIGNB /+SQRT(2)/2 JMS DPRADD /DENOMINATOR OF Y LAC (ADDR2 /STORE DENOMINATOR JMS DPARST LAC (ADDR1 /GET M JMS DPARLD JMS LDDBL /M IN ACC A LAC .MSQ2O2 /-SQRT(2)/2 JMS DPARLD JMS DPRADD /CALCULATE NUMERATOR OF Y LAC (ADDR2 /GET DENOMINATOR JMS DPARLD JMS DPRDIV /Y NOW IN ACC A LAC (ADDR1 /STORE Y JMS DPARST LAC (ADDR1 /GET Y JMS DPARLD JMS DPRMUL /ACC A=Y*Y LAC (ADDR2 /STORE Y*Y JMS DPARST LAW -14 /SET UP COUNTER FOR SERIES CALCULATION DAC .CNTR LAC .CE25 JMS DPSER LAC (ADDR1 JMS DPARLD JMS DPRMUL /LOG Y IN ACC A LAC (400000 JMS .LDPT5 /LOAD -0.5 JMS DPRADD /CALCULATE LOG M JMS .FLOTB /FLOAT K INTO ACC B DZM B3 DZM B4 /ZERO OUT EXTENSION JMS DPRADD JMP* .DPLG2 /EXIT WITH LOG IN ACC A / / / SUBROUTINE TO CALCULATE 2**X WHERE X IS DOUBLE PRECISION / AND IN ACC A / .DPXP2 XX LAC .DPXP2 DAC .SPXP2 /RETURN ADDRESS IN CASE OF ERROR LAC MOSTA SNA JMP EXIT1 /2**0=1 LAC SIGNA /SAVE SIGN DAC SIGN DZM SIGNA /TAKE ABSOLUTE VALUE LAC EXPA /START ARGUMENT SEPARATION ADD (4 DAC EXPA /MULTIPLY X BY 16 JMS .FIX /FIX TO OBTAIN K+F1 IN INT1,INT2 LAC INT1 SZA CMA SZA!CLA JMP OVFL /IF INT1 NON-ZERO, OVERFLOW WILL OCCUR LAC INT2 DAC LARGE /SAVE INT2 AS FLOAT WILL DESTROY IT JMS .FLOTB DZM B3 /ZERO OUT EXTENSION DZM B4 JMS COMPLB JMS DPRADD LAW -5 ADD EXPA DAC EXPA /ACC A=F2/LN 2 LAC .LN2 JMS DPARLD JMS DPRMUL LAC (ADDR2 /STORE F2 JMS DPARST LAW -10 /START SETUP FOR SERIES DAC .CNTR LAC .DC8 JMS DPSER LAC (SAVEY /SAVE 2**F2 JMS DPARST LAC LARGE /START RETRIEVING F1 AND (17 /EXTRACT F1 DAC LEASTN /PREPARE FOR REAL**I DZM MOSTN LAC .RT216 /LOAD SIXTEENTH ROOT OF 2 JMS DPARLD JMS LDDBL /INTO ACC A JMS ITEXP LAC (SAVEY /GET 2**F2 JMS DPARLD JMS DPRMUL /ACC A=2**(F1+F2) LAC LARGE SPA TAD (-1 /2'S COMPLEMENT TO 1'S COMPLEMENT LRSS 4 /RETRIEVE K ADD EXPA DAC EXPA SZL!CLA JMP OVFL LAC SIGN /GET SIGN SMA!CLA JMP* .DPXP2 /SIGN POSITIVE; EXIT JMS LOADBD JMS .LOAD1 /1.0 TO ACC A JMS DPRDIV JMP* .DPXP2 / EXIT1 JMS .LOAD1 JMP* .DPXP2 / / ROUTINE TO EVALUATE DOUBLE PRECISION SERIES / DPSER XX DAC PNTR JMS DPARLD JMS DPRMUL LAC PNTR TAD (5 DAC PNTR JMS DPARLD JMS DPRADD LAC (ADDR2 ISZ .CNTR JMP DPSER+2 JMP* DPSER / / /SINGLE PRECISION ADD, NO TRUNCATION / SPADD XX LAC (SKP DAC GRIND+1 JMS SPRADD LAC TAG DAC GRIND+1 JMP* SPADD TAG TAD (400 / / / SINGLE PRECISION TEMPORARY LOAD AND STORE ROUTINES SPARST XX /STORE ACC A IN ADDRESS SPECIFIED BY AC TAD (-1 DAC* (AUTO6 LAC MOSTA STL SZA!RAR LAC EXPA DAC* AUTO6 LAC SIGNA CLL!RAL LAC MOSTA RAL DAC* AUTO6 LAC LEASTA DAC* AUTO6 JMP* SPARST / SPARLD XX /LOADS ACC B FROM ADDRESS SPECIFIED BY AC TAD (-1 DAC* (AUTO6 LAC* AUTO6 SAD (400000 JMP ZEROLD DAC EXPB STL LAC* AUTO6 RAR DAC MOSTB CLA!RAR DAC SIGNB LAC* AUTO6 DAC LEASTB JMP* SPARLD ZEROLD STL JMS ZERINF CMA DAC EXPB /GENERATE ZERO IN ACC B DZM SIGNB / MAKE SURE ITS +0 JMP* SPARLD / / DOUBLE PRECISION LOAD AND STORE / DPARST XX JMS SPARST LAC A3 DAC* AUTO6 LAC A4 DAC* AUTO6 JMP* DPARST / DPARLD XX JMS SPARLD LAC MOSTB SNA JMP* DPARLD LAC* AUTO6 DAC B3 LAC* AUTO6 DAC B4 JMP* DPARLD / / ROUTINE TO LOAD 0.5 INTO ACCUMULATOR B / .LDPT5 XX DAC SIGNB LAC (400000 DAC MOSTB DZM LEASTB DZM EXPB DZM B3 DZM B4 JMP* .LDPT5 / / EQUIVALENCES FOR GLOBALED ITEMS .SPRML=SPRMUL;.SPRDV=SPRDIV;.SPADD=SPADD;.SPRST=SPARST;.SPRLD=SPARLD .DPRML=DPRMUL;.DPRDV=DPRDIV;.DPADD=DPRADD;.DPRST=DPARST;.DPRLD=DPARLD .LDREL=LDREAL;.LDDBL=LDDBL;.LODBD=LOADBD;.DPSER=DPSER .CMPLA=COMPLA;.CMPLB=COMPLB;.RVRSG=REVRSG;.ZRVAL=ZERVAL;.ZROIA=ZEROIA .PICK1=PICK1;.PICK2=PICK2 .SWPIT=SWAPIT;.SWPUS=SWAPUS;.SWPBI=SWAPBI;.SWPIB=SWAPIB .MVIMA=MVIMA;.ILMDE=ILMODE .ADDR1=ADDR1;.ADDR2=ADDR2 / .END