** ** ADD TWO FLOATING POINT QUANTITIES ** ** ADMUP NOP LDA ADMUP STA STK24 LDA STK4 ADMU1 CMA,INA EXPONENT ADA EXP DIFFERENCE SSA,RSS ARG 1 LARGER? JMP ADMU2 YES LDA A1 NO, LDB A2 SWAP STA A2 ARGUMENTS STB A1 LDA C1 LDB C2 STA C2 STB C1 LDA EXP LDB STK4 STA STK4 STB EXP JMP ADMU1 ADMU2 ADA M25 SHIFT COUNT >= LDB C1 SSA,RSS 25 ? JMP ADMU4 YES, IGNORE SMALLER ARGUMENT CMA,CLE NO, COMPUTE ADA M25 SHIFT COUNT STA STK4 LDA A2 LOAD SMALLER LDB C2 MANTISSA ADMU3 ISZ STK4 JMP ADMU5 YES ADB C1 NO, ADD LOW MANTISSAS CLO RBR,ELB SAVE (E) IN B(0) CLE ADA A1 ADD HIGH MANTISSAS SLB OVERFLOW FROM LOWER MANTISSA? INA YES, ADD IT IN ERB,CLE,ELB ERASE B(0) SOS OVERFLOW? JMP ADMU4+1 NO ERA YES, SHIFT ERB MANTISSA DOWN AND ISZ EXP CORRECT EXPONENT JMP ADMU4+1 RSS ADMU4 LDA A1 RETRIEVE HIGH MANTISSA JSB .PACK NORMALIZE AND PACK JMP STK24,I ADMU5 CLE,SLA,ARS ARITHMETIC CME DOUBLE ERB,CLE SHIFT JMP ADMU3 ** *** ADD TWO FLOATING POINT NUMBERS ** ** .FAD NOP JSB UNPAK UNPACK THE ARGUMENTS LDA .FAD STA STK6 JSB ADMUP ADD THEM UP JMP STK6,I ** *** SUBTRACT TWO FLOATING POINT NUMBERS ** ** .FSB NOP JSB UNPAK UNPACK THE ARGUMENTS LDA .FSB STA STK6 LDA A2 TWO'S COMPLEMENT CMA THE SECOND ARGUMENT CMB,INB,SZB LOW PART ZERO? JMP .FSB1 NO SSA,INA,RSS YES, ORIGINAL NUMBER NEGATIVE? SSA,RSS YES, STILL NEGATIVE? JMP .FSB1 NO RAR YES, SHIFT DOWN AND ISZ STK4 .FSB1 STB C2 SAVE COMPLEMENTED STA A2 NUMBER JSB ADMUP ADD ARGUMENTS JMP STK6,I ** *** UNPACK ARGUMENTS FOR ARITHMETIC OPERATIONS ** ** UNPAK NOP STA A1 SAVE HIGH PART OF ARG 1 SZA,RSS UNPACK CLB,INB SECOND JSB .FLUN WORD STB C1 SAVE LOW PART OF ARG 1 STA EXP SAVE EXPONENT OF ARG 1 LDA UNPAK COMPUTE ADDRESS OF ADA M2 CALLING ROUTINE LDB 0,I ISZ 0,I SET CALLING ROUTINE-S RETURN LDB 1,I LOAD RBL,CLE,SLB,ERB JMP *-2 LDA 1,I LOAD INB ARG 2 LDB 1,I STA A2 SAVE HIGH PART OF ARG 2 SZA,RSS UNPACK CLB,INB SECOND JSB .FLUN STB C2 SAVE LOW PART OF ARG 2 STA STK4 JMP UNPAK,I ** *** MULTIPLY TWO FLOATING POINT NUMBERS ** ** .FMP NOP UNPACK THE JSB UNPAK ARGUMENTS ADA EXP ADD EXPONENTS INA PLUS 1 FOR STA EXP NORMALIZATION RBR POSITION LOW PART OF ARG 2 LDA 1 COMPUTE A JSB MPY CROSS PRODUCT DEF A1 STA C2 SAVE RESULT LDA .FMP STA STK6 LDA C1 LOAD AND POSITION RAR LOW PART OF ARG 1 STB C1 SAVE REST OF PRIOR RESULT JSB MPY COMPUTE SECOND DEF A2 CROSS PRODUCT ADB C1 ADD CLE CROSS ADA C2 PRODUCTS SEZ CORRECT INB FOR CARRY STB C2 SAVE RESULT LDA A1 COMPUTE JSB MPY HIGH PART DEF A2 OF PRODUCT CLE,ERA POSITION LOW PART ADA C2 ADD IN CROSS TERMS CLE,ELA REPOSITION SEZ,RSS CARRY FROM LOW PART? JMP *+4 SOC YES, POSITIVE CARRY? INB,RSS YES ADB M1 NO STA A1 EXCHANGE LDA 1 LDB A1 REGISTERS JSB .PACK NORMALIZE AND PACK JMP STK6,I ** *** PERFORM FLOATING DIVIDE ** ** .FDV NOP JSB UNPAK UNPACK ARGUMENTS LDB .FDV STB STK6 LDB A2 DIVISOR SZB,RSS ZERO? JMP .FDV2 YES LDB A1 NO,DIVIDEND SZB,RSS ZERO? JMP .FDV1 YES CMA,INA NO, COMPUTE INA EXPONENT ADA EXP DIFFERENCE STA EXP PLUS 1 LDA C1 LOAD DIVIDEND CLE,SLB,BRS ARITHMETIC CME RIGHT SHIFT ERA TWICE TO CLE,SLB,BRS PREVENT CME DIVISION ERA OVERFLOW JSB IDIV DIVIDE STA STK4 BRS DIVIDE REMAINDER BY 2 TO CLA PREVENT DIVISION OVERFLOW JSB IDIV DIVIDE REMAINDER AND STA STK7 LDB C2 CLA,CLE SCALE TO ERB,BRS PREVENT BRS OVERFLOW JSB IDIV COMPUTE B2/A2 = Q CMA,INA COMPUTE JSB MPY -HIGH QUOTIENT*Q DEF STK4 BLS,CLE,ELB SHIFT SIGN TO (E) LDA STK7 SSA NEGATIVE? CCA,RSS YES, SET (A)=-1 (EXTEND CLA NO, SET (A)=0 SIGN) CMA,SEZ IF (E)=1 SUBTRACT INA 1 AS EXTENSION CMA,CLE OF PRODUCT ADB STK7 SEZ CARRY INA INTO (A) CLE,ELB POSITION ELA REGISTERS ADA STK4 RSS .FDV1 CLA SET MANTISSA TO ZERO JSB .PACK NORMALIZE AND PACK JMP STK6,I .FDV2 JSB ERROR DIVIDE-BY-ZERO DBYZR LDA A1 JSB OVFLW RETURN INFINITY JMP STK6,I ** *** INTEGER DIVIDE ** ** IDIV NOP DIVIDEND IN (B) AND (A) STB A1 SAVE HIGH DIVIDEND LDB A2 CLE,SSB SET (B) TO ABS(B) CMB,CME,INB AND (E) TO SIGN(B) STB .FAD SAVE POSITION DIVISOR CMB,INB SAVE STB .FSB NEGATIVE DIVISOR LDB M16 SET STB C1 COUNTER LDB M2 SET STB SIGN STB .FMP SIGNS LDB A1 RETRIEVE HIGH DIVIDEND SSB,RSS POSITIVE? JMP IDIV1 YES ISZ .FMP NO, SET REMAINDER SIGN CMB,CME NEGATIVE AND COMPLEMENT SZA THE DIVISOR CMA,INA,RSS AND (E) INB IDIV1 SEZ QUOTIENT POSITIVE? ISZ SIGN NO IDIV2 CLE,ELA SHIFT ELB DIVIDEND ADB .FSB SUBTRACT DIVISOR SSB,RSS OK? INA,RSS YES ADB .FAD NO, RESTORE DIVIDEND ISZ C1 DONE? JMP IDIV2 NO CMA,INA YES, NEGATE QUOTIENT ISZ SIGN RESULT TO BE POSITIVE? CMA,INA YES ISZ .FMP NO,REMAINDER POSITIVE? JMP IDIV,I YES CMB,INB NO JMP IDIV,I SKP * ****************************** * SYMBOL TABLE SEARCH SUBROUTINE * ****************************** * SSYMT NOP STA STEMP STORE IDENTIFIER AND .15 ISOLATE IDENTIFIER TYPE ADA M4 SSA,INA JMP *+4 JUMP IF ARRAY TYPE LDA STEMP RESTORE A STA 1 STORE IN B JMP SYMT1+3 SSA SKIP IF UNDIMENSIONED JMP SYMT1 LDA STEMP RESTORE A AND MSK3 177771B SET TYPE TO 1 STA 1 INB SET TYPE IN 3 TO 2 JMP *+4 SYMT1 CCB SET DIMENSIONED FLAG TO B LDA .3 IOR STEMP SET TYPE TO UNDEFINED STA STEMP+1 STORE A STB STEMP+2 STORE B LDB SYMTF START OF SYMBOL TABLE JMP SYMT4 SYMT2 LDA 1,I PICK UP 1ST WORD OF ENTRY CPA STEMP COMPARE WITH IDENTIFIER JMP SSYMT,I MATCH? RETURN CPA STEMP+1 COMPARE WITH DIFFERENT DIM. JMP SYMT3 CPA STEMP+2 COMPARE WITH DIFFERENT DIM. JMP SYMT3 LDA 1,I AND .15 CPA .15 JMP *+5 ADA M4 SSA INB INB ADB .2 SYMT4 CPB SYMTA CCB,RSS JMP SYMT2 LDA STEMP JMP SSYMT,I SYMT3 LDA STEMP RESTORE A ISZ STEMP+2 DIMENSIONED IDENTIFIER? RSS NO, SKIP STA 1,I YES CHANGE 1ST WORD OF ENTRY TO JMP SSYMT,I APPROPRIATE DIMENSION TYPE SKP ** *** ERROR TABLE ** ** ERR DEF EOF+1 PREMATURE STATEMENT END DEF RTLE INPUT EXCEEDS 71 CHARACTERS DEF INVSC SYSTEM COMMAND NOT RECOGNIZED DEF SYNE1 NO STATEMENT TYPE FOUND DEF NUMER+1 DEF SYE16 NO LETTER WHERE EXPECTED DEF SYNE2 LET STATEMENT HAS NO STORE DEF SYNE3 ILLIGAL COM STATEMENT DEF SYNE4+1 NO FUNCTION IDENTIFIER (OR BAD) DEF SYNE5 MISSING PARAMETER DEF SYNE6+1 MISSING ASSIGNMENT OPERATOR DEF SYNE7 MISSING 'THEN' DEF SYNE8+1 MISSING OR IMPROPER FOR-VARIABLE DEF SYNE9 MISSING 'TO' DEF SYE10 BAD 'STEP' PART IN FOR STATEMENT DEC -1 DEC -1 DEF SYE12 NO CONSTAND WHERE EXPECTED DEF SYE13 NO VARIABLE WHERE EXPECTED DEF SYE14 NO CLOSING QUOTE FOR STRING DEF SYE15 PRINT JUXTAPOSES FORMULAS DEF SYE17 IMPROPER WORD IN MAT STATEMENT DEF SYE18 NO COMMA WHERE EXPECTED DEF SYE19 IMPROPER ARRAY FUNCTION DEF SYE20 NO SUBSCRIPT WHERE EXPECTED DEF SYE21 ARRAY INVERSION INTO SELF DEF SYE22 MISSING MULTIPLICATION OPERATOR DEF SYE23 IMPROPER ARRAY OPERATOR DEF SYE24+1 ARRAY MULTIPLICATION INTO SELF DEF FSCE1+1 MISSING LEFT PARENTHESIS DEF FSCE2+1 MISSING RIGHT PARENTHESIS DEF FSCE3+1 UNRECOGNIZED OPERAND DEF ARRE1 MISSING SUBSCRIPT DEF ARRE2 MISSING ARRAY IDENTIFIER DEF SYE25+1 MISSING OR BAD INTEGER DEF NOEOF+1 CHARACTERS AFTER STATEMENT END DEF FSCE4+1 DEF PRERR PHOTO READER NOT READY DEF MER4 FUNCTION MULTIPLY DEFINED DEF MER6 UNMATCHED FOR STATEMENT DEF MER3 UNMATCHED NEXT DEF MER8 OUT OF STORAGE-SYMBOL TABLE DEF MSYM INCONSISTENT DIMENSIONS DEF MLOP6 DEF MER5 ARRAY DOUBLE DIMENSIONED DEF MER10 NO OF DIMENSIONS UNSPECIFIED DEF MER9 ARRAY TOO LARGE DEF MER7 OUT OF STORAGE-ARRAY ALLOCATION DEF E6 SUBSCRIPT TOO LARGE DEF E8 UNDEFINED OPERAND ACCESSED DEF BASER NEGATIVE BASE POWERED TO REAL DEF POWER ZERO TO ZERO POWER DEF XEC5 MISSING STATEMENT DEF E2 GOSUBS NESTED 10 DEEP DEF E3 RETURN FINDS NO ADDRES DEF E4 OUT OF DATA DEF E1+1 OUT OF STORAGE - EXECUTION DEF E7 RE-DIMENSIONED ARRAY TOO LARGE DEF LERR+1 DEF LCHK5 MATRIX UNASSIGNED DEF LDUM1 NEARLY SINGULAR MATRIX DEF TRGER ARGUMENT TOO LARGE DEF SQRER SQRT HAS NEGATIVE ARGUMENT DEF LOGER LOG OF NEGATIVE ARGUMENT RCERR EQU * ** RECOVERABLE ERRORS FOLLOW ** DEF OVRER OVERFLOW DEF UNDER UNDERFLOW DEF LNZR LOG OF ZERO DEF EXPER EXPONTIAL OVERFLOW DEF DBYZR DIVIDE BY ZERO DEF ZRTNG ZERO TO NEGATIVE POWER ** *** OUTPUT A NUMBER ** ** NUMOT NOP NUMBER (A) AND (B) STA EXPON SAVE NUMBER LDA NUMOT STA STK9 LDA EXPON SEZ,RSS SIGN? JMP NS2 NO SSA,RSS YES,NEGATIVE NUMBER? JMP NS1 NO JSB ARINV YES, INVERT IT STA EXPON LDA .45 RSS NS1 LDA .32 STORE STA SIGN SIGN LDA EXPON NS2 STB STK8 JSB IFIX INTEGERIZE NOP LDA STK9,I STA NUMO1 STA NUMO3 ISZ STK9 SOC WAS IT AN INTEGER? JMP NUMO2 NO CLA STB B1+1 ADB M1000 SSB,RSS ADA .3 ADA .6 ADA CCNT CMA,INA STA MLBX1+1 ADA .74 SSA NUMO1 NOP NO LDA SIGN SZA SIGN? JSB OUTCR YES, OUTPUT IT LDA B1+1 JSB OUTIA,I THE INTEGER JMP STK9,I NUMO2 CCA SET 'FIXED' STA FFLAG FLAG FALSE LDA EXPON LOAD * *** THESE TWO INSTRUCTIONS CHECK FOR AN NUMERIC UNDERFLOW. *** IF MANTISSA IS ZERO, GIVE AN ERROR 50 MESSAGE. *** OTHERWISE, CONTINUE TO OUTPUT NUMBER * SZA,RSS ZERO MANTISSA? JMP E8-1 YES - ERROR (UNDERFLOW) * LDB STK8 JSB .FADA,I IS NUMBER DEF MAXFX LESS THAN SSA,RSS 999999.5? JMP NUMO5 NO LDA EXPON YES, IS LDB STK8 JSB .FADA,I LESS DEF MINFX THAN LDB .12 SAVE SSA,RSS ISZ FFLAG NUMO5 LDB .15 WIDTH ADB CCNT SAVE CMB,INB END-OF-FIELD STB MLBX1+1 ADB .75 ROOM SSB ENOUGH? NUMO3 NOP NO ** *** OUTPUT A FLOATING POINT NUMBER ** ** LDA EXPON STA MANT1 LDB STK8 JSB .FLUN STB MANT2 NUMBER STA EXP LDA SIGN SZA SIGN JSB OUTCR YES, OUTPUT IT CLA INITIALIZE COUNTER STA EXPON FOR DECIMAL EXPONENT CPA EXP EXPONENT ZERO? JMP EOUT4 YES EOUT2 JSB MBY10 NO, LDA EXP MULTIPLY CMA,INA NUMBER BY 10 SSA UNTIL JMP *+3 ISZ EXPON GREATER JMP EOUT2 THAN 1 JSB DBY10 DIVIDE BY 10 LDA EXPON EOUT3 LDB EXP DIVIDE CMB,INB NUMBER SSB,RSS BY 10 JMP EOUT4 UNTIL STA EXPON IT IS JSB DBY10 LESS CCA THAN ADA EXPON 1 JMP EOUT3 EOUT4 CMA SET EXPONENT STA EXPON TO TRUE VALUE-1 LDB M7 SET DIGIT STB STK10 CCB SET DECIMAL STB STK4 CPB FFLAG FIXED POINT? JMP EOUT6 NO CMA YES, SET STA STK4 CPA .1 .1? JMP EOUT5 YES SSA,RSS LEADING DECIMAL POINT? JMP EOUT7+2 YES EOUT6 JSB GETDG OUTPUT ADA .48 A JSB OUTCR DIGIT JMP EOUT8 EOUT5 LDA .46 OUTPUT JSB OUTCR DECIMAL POINT LDA .48 OUTPUT JMP EOUT8-1 LEADING ZERO EOUT7 ISZ STK4 JMP EOUT6 NO LDA .46 YES, JSB OUTCR OUTPUT IT EOUT8 ISZ STK10 JMP EOUT7 YES LDA CCNT NO, STA NUMO1 SAVE LDA BADDR OUTPUT STA NUMO3 POINTERS JSB GETDG NEXT DIGIT ADA M5 FIVE OR SSA GREATER? JMP EOUT1 NO CCA SET DECIMAL ERND1 STA STK11 JSB RETCR RETRIEVE CHARACTER CPA .46 DECIMAL POINT? JMP ERND1-1 YES, FLAG IT JSB DIGCK NO, DIGIT? JMP ERND2 NO CPA .9 YES,9? JMP *+3 ADA .49 NO, BUMP JMP ERND3 DIGIT 1 LDA .48 OVERLAY JSB OUTCR A ZERO JSB RETCR BACKSPACE CCA DECREMENT ADA STK11 JMP ERND1 COUNTER ERND2 JSB OUTCR RESTORE CHARACTER ISZ EXPON CORRECT NOP EXPONENT LDA .49 OVERLAY A1 LDB FFLAG SZB JMP ERND3 NO JSB OUTCR A ZERO LDA .48 OVERLAY ISZ STK11 JMP *-3 NO LDA .46 YES ERND3 JSB OUTCR LDA NUMO1 RESTORE STA CCNT OUTPUT LDA NUMO3 POINTERS STA BADDR EOUT1 ISZ FFLAG NO, FIXED POINT? JMP EOUT9 YES LDA E NO, JSB OUTCR OUTPUT 'E' LDA .45 LOAD '-' LDB EXPON POSITIVE SSB EXPONENT? CMB,INB,RSS NO LDA .43 YES, LOAD '+' STB EXPON JSB OUTCR OUTPUT SIGN LDB EXPON LDA .48 COMPUTE ADB M10 SSB EXPONENT JMP *+3 INA DIGIT JMP *-4 ADB .58 COMPUTE STB EXPON SECOND DIGIT JSB OUTCR OUTPUT LDA EXPON JSB OUTCR EXPONENT JMP STK9,I EOUT9 JSB RETCR RETRIEVE CHARACTER CPA .48 ZERO? JMP EOU10 YES JSB OUTCR NO, RESTORE CHARACTER JMP STK9,I EOU10 LDA .32 OVERLAY JSB OUTCR A BLANK JSB RETCR JMP EOUT9 ** *** GET DIGIT TO OUTPUT ** ** GETDG NOP JSB MBY10 MULTIPLY BY 10 LDB EXP GET EXPONENT IN (B) CMB,INB AS NEGATIVE AND HIMSK KEEP 5 HIGH BITS OF (A) RAL NORMALIZE TO BIT 15 SSB,INB ROTATE INTEGER JMP *-2 INTO (A) AND MSK0 STA STK7 LDB EXP ROTATE CMB,INB RAR BACK SSB,INB JMP *-2 XOR MANT1 REMOVE LDB MANT2 DIGIT JSB NORML NORMALIZE REMAINDER LDA STK7 JMP GETDG,I * *** RETRIEVE CHARACTER FROM OUTPUT BUFFER ** * RETCR NOP LDB CCNT DECREMENT ADB M1 CHARACTER STB CCNT COUNT LDA BADDR,I POSITION SLB,RSS AND ALF,ALF EXTRACT AND MSK0 SLB FIRST CHARACTER OF WORD? JMP RETCR,I NO LDB BADDR YES, DECREMENT ADB M1 BUFFER STB BADDR POINTER JMP RETCR,I HED LIBRARY ROUTINES * ****************************** * SUBROUTINE TO CALCULATE TAN(X) * ****************************** * ETAN JSB .FMPA,I DEF FOPI 4/PI STA XTEMP STB XTEMP+1 JSB .FADA,I DEF K1 JSB .PWR2 DEC -2 JSB .IENT JSB ERROR TRGER JSB FLOAT JSB ARINV JSB .PWR2 DEC 2 JSB .FADA,I DEF XTEMP STA XTEMP STB XTEMP+1 X=X-4*ENTIER((X+1)/4) JSB .FSBA,I DEF K1 STA SBOXX SSA X<1? JMP ELSE1 YES LDA K2 NO LDB K2+1 JSB .FSBA,I DEF XTEMP BOTH1 STA YTEMP STB YTEMP+1 Y= 2-X JSB .FMPA,I DEF YTEMP JSB .FMPA,I DEF K2 JSB .FSBA,I DEF K1 JSB .CHEB DEF COEFF JSB .FMPA,I DEF YTEMP STA YTEMP STB YTEMP+1 Y=Y*CHEBY(2*Y**2-1) LDA SBOXX SSA X<1? JMP ELSE2 YES LDA K1 LDB K1+1 JSB .FDVA,I DEF YTEMP JMP FR12A,I ELSE1 LDA XTEMP LDB XTEMP+1 JMP BOTH1 Y=X ELSE2 LDA YTEMP LDB YTEMP+1 JMP FR12A,I FOPI DEC 1.273239545 4/PI K1 DEC 1. XTEMP BSS 2 YTEMP BSS 2 UTEMP BSS 2 K2 DEC 2. COEFF DEC 1.4458E-8 DEC 2.013766E-7 DEC 2.804816E-6 DEC 3.906637E-5 DEC 5.4417038E-4 DEC 7.586101578E-3 DEC .10675392857 DEC 1.7701474227 OCT 0 SKP * ****************************** * SUBROUTINE TO CALCULATE ATN(X) * ****************************** * EATN STA XTEMP STB XTEMP+1 LDA 1 AND MSK0 STA SBOXX SZA SLA ABS (X) > 1 ? JMP ELS1 NO LDA K1 LDB K1+1 JSB .FDVA,I DEF XTEMP U=1/X BTH1 STA UTEMP STB UTEMP+1 JSB .FMPA,I DEF UTEMP JSB .FMPA,I DEF K2 JSB .FSBA,I DEF K1 JSB .CHEB DEF COEF JSB .FMPA,I DEF UTEMP STA YTEMP STB YTEMP+1 Y=U*CHEBY(2*U**2-1) LDA SBOXX SZA SLA ABS(X)>1 ? JMP ELS2 NO LDA XTEMP SSA X= 15 JSB FLOAT JSB .FMPA,I DEF MM4 JSB .FADA,I DEF XTEMP STA XTEMP STB XTEMP+1 X=X-4*ENTIER((X+1)/4) JSB .FSBA,I DEF K1 SSA X<1 ? JMP PAST YES LDA K2 LDB K2+1 JSB .FSBA,I DEF XTEMP STA XTEMP STB XTEMP+1 X=2-X PAST LDA XTEMP LDB XTEMP+1 JSB .FMPA,I DEF XTEMP JSB .PWR2 DEC 1 JSB .FSBA,I DEF K1 JSB .CHEB DEF COEF1 JSB .FMPA,I DEF XTEMP JMP FR12A,I TOPI DEC .636619772 2/PI MM4 DEC -4. COEF1 DEC 1.18496E-6 DEC -1.365875E-4 DEC 9.118016E-3 DEC -.2852615692 DEC 2.5525579248 OCT 0 SPC 10 * ***************************** * SUBROUTINE TO COMPUTE ABS (X) * ***************************** EABS SSA JSB ARINV YES, NEGATE IT JMP FR12A,I SKP * **************************** * SUBROUTINE TO COMPUTE RND(X) * **************************** * * ERND CLA STA EXP INITIALIZE EXPONENT LDA XH COMPUTE ALS HIGH ADA XH PART LDB XL 2*XH CLE,ERB + XH + ADA 1 XL*2^15 LDB XL RBL,CLE,SLB,ERB ADD XL[15] TO INA (A) (FROM 2*XL$ CLE,ELB 2*XL ADB XL + XL ELA,CLE,SLA,ERA ADD OVERFLOW CLE,INA TO (A) ADB FLGBT ADD IN TRAILING BIT OF XL*2^15 SEZ ADD OVERFLOW INA TO (A) ELA,CLE,ERA ERASE A[15] STA XH STORE STB XL INTEGER JSB .PACK NORMALIZE AND PACK JMP FR12A,I SKP * ****************************** * SUBROUTINE TO CALCULATE SQR(X) * ****************************** * ESQR SZA,RSS JMP FR12A,I SSA X