LnSOS BOOT 1.1 SOS.KERNEL SOS KRNLI/O ERRORFILE 'SOS.KERNEL' NOT FOUND%INVALID KERNEL FILE: xةw,@  ȱlmi8#)!)O^50A # -CALC.MAC.TEXTA  .CALC.MAIN.TEXT A .CALC.SCT.TEXTA A CALC.TEXTA A III.SRC.020.Au' +CALC.0.TEXT AЬ +CALC.1.TEXT7lA(%+CALC.2.TEXTJ/\A-CALC.211.TEXTy'LA (0 -CALC.212.TEXT'LA ( +CALC.3.TEXT >dLԡm#i㰼m#iЕOLԡȱfg hi !dLԡ憦  Ljmkm l y`2 Lԡ8(Je稽)ʈ@L  q4-2000  sysP2 .byte 080,006,072,074,006,0FC,0F4,005,018,098,019 .byte 080,00F,06C,09B,03D,054,014,0E1,0AD,008,052 .byte 080,015,07D,0F0,0D8,04A,0C3,0A3,05F,0AF,08A p_sysp2 .word sysp2-2000  sysP3 .byte 080,005,0C4,067,000,000 .byte 080,006,08E,01A,0E1,092,032,09C,060,03A,0DE .byte 080,008,041,0C1,083,09F,007,0F5,07E,002,0AB .byte 080,009,0A6,0F1,0F8,07A,013,0E4,07B,0DA,0E9 .byte 080,008,032,01B,012,0FA,0AC,077,028,024,05E p_q4 .word .byte 080,00B,05A,0A7,010,08B,038,07B,077,06F,021 .byte 080,013,020,003,0B1,082,09B,07B,0E8,05C,0C8 .byte 080,017,037,02D,0F8,014,0E7,009,083,07E,006 p_q3 .word q3-2000  Q4 .byte 080,001,000,000,000,000,000,000,000,000,000,000,000,000,000,000 N10 .byte 080,004,020,000,000,000,000,000,000,000,000 NI2 .byte 080,000,000,000,000,000,000,000,000,000,000 Q3 .byte 080,001,000,000,000,000,000,000,000,000,000 ,001,035,004,0F3,033,0F9,0DE,064,084,059 ILN2 .byte 080,001,038,0AA,03B,029,05C,017,0F0,0BB,0BF LN2 .byte 080,000,031,072,017,0F7,0D1,0CF,079,0AB,0CA MN .byte 080,010,000,000,000,000,000,000,000,000,000 N1 .byte 080,001,000,000,0RING .block 20,0ff ;OUTPUT STRING p_STRING .word string ; ; INTERNAL CONSTANTS ; ILN10 .byte 07F,0FF,05E,05B,0D8,0A9,037,028,071,095,035 LN10 .byte 080,002,013,05D,08D,0DD,0AA,0A8,0AC,016,0EA SQR2 .byte 080TR1 .block 10,00 LY .block 01,00 DP .block 10,00 MANT .block 0b,00 ESIGN .byte 000 MSIGN .byte 000 CHAR .byte 00 ;DISP IN STRING LCNT .byte 00 ;LOOP COUNTER ST ;RETURN ADDRESS CHRAD .equ 0BE ;CHARACTER ADDRESS ; ; LOCAL DATA AREAS ; pol_fx .block 0b,00 Z .equ * FX .block 0b,00 W .equ * FX2 .block 0b,00 Q .block 0b,00  EXP .block 0f,00 equ 095 SIGN .equ 096 ERR_number .equ 097 ;FLOATING POINT ERROR # AD1 .equ 098 ;FP AND DP OPERAND RAD .equ 09A ; LOAD REGISTERS FR1 .equ 09C ;FLOATING POINT FR2 .equ 0B0 ; MATH REGISTERS RETAD .equ 0BC 08B R12 .equ 08C R13 .equ 08D R14 .equ 08E R15 .equ 08F xb_r6 .equ 1687 xb_r10 .equ 168b   M1L .equ 090 ;TWO BYTE INTEGER M1H .equ 091 ;MATH REGISTERS M2L .equ 092 M2H .equ 093 M3L .equ 094 M3H . ; COMMON DATA R0 .equ 080 ;GENERAL PURPOSE R1 .equ 081 ;REGISTERS R2 .equ 082 R3 .equ 083 R4 .equ 084 R5 .equ 085 R6 .equ 086 R7 .equ 087 R8 .equ 088 R9 .equ 089 R10 .equ 08A R11 .equ D0,0BC,0BB,0F7,0F9,0B3,0F5 .byte 080,008,06C,029,018,0DD,06D,093,089,009,06D .byte 080,00A,089,042,0CA,0A5,0A1,0D0,09F,0AD,046 .byte 080,009,032,01B,012,0FA,0AC,077,028,024,052 p_sysp3 .word sysp3-2000 ;* * ;**************************************** ;* SYSDOUT ; ; INIT AND OUTPUT THE SIGN ; LM CHAR,#0 ;INIT CHAR COUNT LDA FR1 ;CHECK FOR 0 ORA FR1+1 BNE IN * ;* CHARACTERS * ;* * ;* NOTES: * ;* 1) THE STRING ENDS IN A HEX 00 * ;* 2) USES SYSDLOG, SYSDEXP, * ;* SYSDMUL, SYSDFIX AND SYSCVDC * * ;* * ;* INPUTS: * ;* FR1 - NUMBER TO CONVERT * ;* * ;* OUTPUTS: * ;* Y-A - ADDRESS OF STRING ISION * ;* NUMBERS TO APPLE SCREEN CHARACTER * ;* STRINGS. * ;* * ;* BY MIKE WESTERFIELD * ;* COPYRIGHT (C) JANUARY 1983 * ;* BY HAYDEN BOOK COMPANY, INC. ( 0.if test 0.ascii "SYSDOUT" 0.endc ( ;**************************************** ;* * ;* SYSDOUT - DOUBLE PRECISION OUTPUT * ;* * ;* CONVERTS BINARY DOUBLE PREC !"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGH1 2 3 4 5 6 jj  O^5_a1 moveb #"0",string 'inc char ;2.11 'jmp rt1 ;2.11 ' ;2.11 moveb #0ff,string+1 @;2.11 LDA p_STRING @;2.11 LDY p_STRING+1 @;2.11 RTS @ @ IN_a1 LDA FR1+2 ;OUTPUT SIGN BPL SE1_b AND #07F STA FR1+2 LM STRING,#"-" INC CHAR ; ; STRIP OFF THE EXPONENT, LEAVING A ; NUMBER X SUCH THAT 1.0 <= X < 10.0 ; SE1_b movenum FR1,TR1 ;EXP=INT(LOG(FR1)) STY CHAR ; ; SET AND FLAG AND RETURN ; RT1 jsr adj_display ;*** DA never returns if my H;display in effect 'LDY CHAR LDA #0ff ;*** DA STA STRING,Y LDA p_STRING YSCVDC LDX #0 LDA #"0" EX_a3 CMP R2,X BNE EX_a4 INX CPX #4 BNE EX_a3 EX_a4 LDY CHAR EX_a5 LDA R2,X STA STRING,Y INX INY CPX #5 BNE EX_a5 ;OUTPUT SIGN 'sta exp_sgn_flag ;*** DA BPL EX_a2 SUB0 SOUT_EXP,SOUT_EXP LDA #"-" STA STRING,Y INY EX_a2 STY CHAR movew SOUT_EXP,R0 ;OUTPUT DIGITS JSR S_EXP ;CHECK FOR 0 ORA SOUT_EXP+1 BEQ RT1 LDY CHAR ;OUTPUT "E" LDA #" " STA STRING,Y INY LDA #"E" STA STRING,Y INY LDA SOUT_EXP+1 BEQ EX_a1 RZ3 LDY CHAR LDA #"0" RZ4 CMP STRING-1,Y BNE RZ5 DEY BNE RZ4 RZ5 LDA STRING-1,Y CMP #"." BNE RZ6 DEY RZ6 STY CHAR ; ; OUTPUT THE EXPONENT ; EX_a1 LDA SOUT STA STRING,Y INC2 SOUT_EXP RM2 INY STY CHAR ; ; REMOVE TRAILING ZEROS ; RZ1 LDY #3 ;INSURE TRAILING ZEROS LDA #"." ;CAN EXIST RZ2 CMP STRING,Y BEQ RZ3 DBNE Y,RZ2 CMP #"."+1 ;CHECK FOR "." BNE RM2 DEY ;DO ONE"S DIGIT CLC LDA STRING,Y ADC #1 STA STRING,Y CMP #":" BNE RM2 LDA #"1" ;...=10 ;SKIP IF FR1<.5 BNE RZ1 ORA FR1 BEQ RZ1 LDY CHAR ;ADD 1 TO DIGIT(S) RM1 DEY CLC LDA STRING,Y ADC #1 STA STRING,Y CMP #":" BEQ RM1 LDA FR1 ORA FR1+1 BEQ RZ1 ' 'dec lcnt 'bne mn1 ;DBNE LCNT,MN1 ' ; ; ROUND THE MANTISSA. IF ROUNDING IS ; NOT NEEDED, OMIT ALL CODE FROM HERE ; TO THE NEXT BLOCK COMMENT. ; LDA FR1+1 INC CHAR LM LCNT,#12 ;OUTPUT THE NEXT MN1 movenum N10,FR2 ;18 DIGITS JSR SYSDMUL JSR SYSDFIX LDA M1L ORA #"0" LDY CHAR STA STRING,Y INC CHAR STRING,Y INY STY CHAR LM LCNT,#11 BNE MN1 MN0 ORA #"0" LDY CHAR STA STRING,Y INC CHAR LDA FR1 ORA FR1+1 BEQ RZ1 LDA #"." STA STRING+1,Y 0a ;SPECIAL CASE: INITIAL BNE MN0 ;DIGIT IS 10 INC2 SOUT_EXP LDA #"1" LDY CHAR STA STRING,Y INY LDA #"." STA STRING,Y INY LDA #"0" STA movenum LN10,FR2 JSR SYSDMUL JSR SYSDEXP movenum TR1,FR2 JSR SYSDMUL ; ; OUTPUT THE MANTISSA ; JSR SYSDFIX ;OUTPUT FIRST DIGIT LDA M1L ;AND DECIMAL POINT CMP # JSR SYSDLOG LDA FR1+2 BPL SE2 movenum N1,FR2 JSR SYSDSUB SE2 JSR SYSDFIX movew M1L,SOUT_EXP JSR SYSDFLT ;FR1=TR1*10^(-EXP) LDA FR1+2 EOR #080 STA FR1+2 LDY p_STRING+1 'RTS  SOUT_EXP .byte 00,00  .if test (.ascii "SYSDPIN" (.endc ' ;**************************************** ;* * ;* SYSDPIN - DOUBLE PRECISION INPUT * ;* * ;* BY MIKE WESTERFIELD * ;* COPYRIGHT (C) JANUARY 1983 * ;* BY HAYDEN BOOK COMPANY, INC. * ;* * ;* INPUTS: * ;* A-Y - ADDR movenum FR1,FR2 JSR SYSDFLT JMP SYSDADD (.if test (.ascii "SYSDDIV" (.endc  ;**************************************** ;* * ;* SYSDDIV - DOUBLE PRECISION DIVIDE * ;* 0,Y CMP #" " BNE RTS_1 INY JMP GT1 RTS_1 STY LY RTS DIGIT AND #0F ;FR1=FR1*10+A STA M1L LM M1H,#0 movenum N10,FR2 JSR SYSDMUL N X AND THE NEXT BEQ GETCHR ;CHARACTER IN A CMP #"-" BNE RTS_1 LDX #080 GETCHR LDY LY ;GET NEXT NON-BLANK INY ;CHARACTER GT1 LDA @R1OUND FINAL ANSWER ; LDA FR1+2 AND #07F ORA MSIGN STA FR1+2 JSR SYSDRND RTS ; ; INTERNAL SUBROUTINES ; FSN LDX #0 ;FIND SIGN, PUT IT CMP #"+" ;I movew M3L,M1L JSR SYSDFLT JSR SYSDADD movenum LN10,FR2 JSR SYSDMUL JSR SYSDEXP ;FR1=EXP(FR1) movenum MANT,FR2 ;FR1=FR1*MANT JSR SYSDMUL ; ; SET SIGN AND RIGIT JSR GETCHR ;LOOP JMP EE1 EE2 LDA ESIGN ;SET EXPONENT SIGN BEQ EE3 LDA FR1+2 EOR #080 STA FR1+2 EE3 movenum FR1,FR2 ;FR1=FR1+M3 <> E CMP #"E" BNE EE3 JSR GETCHR ;SET SIGN JSR FSN STX ESIGN EE1 JSR SYSNMID ;BR IF NOT NUMBER BCC EE2 JSR DIGIT ;FR1=FR1*10+DR JMP FN_a1 FN_a4 movenum FR1,MANT ;SAVE MANTISA ; ; EVALUATE EXPONENT ; (lda #00 ;was LA FR1,0 FR1=0 (sta fr1  sta fr1+1   LDA @R10,Y ;BR IF CHAR LDA DP ;BR IF DP=NO BEQ LOOP ' lda m3l ;was DEC2 M3L EXP-EXP-1 'bne $010 'dec m3l+1 $010 dec m3l ' LOOP JSR GETCHR ;LOOP NEXT CHARACTE ;SET DP BEQ FN_a2 OVFLOW FERR #2 RTS FN_a2 INC DP JMP LOOP FN_a3 JSR SYSNMID ;BR IF NOT DIGIT BCC FN_a4 JSR DIGIT ;FR1=FR1*10+DIGIT ;FIND SIGN STX MSIGN ldx #00 ;was LA FR1,0,X FR1=0 (stx fr1 (stx fr1+1  FN_a1 CMP #02E ; was #0AE BR IF NOT . BNE FN_a3 LDA DP LDA @R10,Y ;GET 1ST NON-BLANK CMP #" " ;CHARACTER BNE IN_b1 INY JMP IN_b0 IN_b1 STY LY ;SAVE Y ; ; FIND NUMBER ; JSR FSN ;**************************************** ;* SYSDPIN ; ; INITIALIZATION ; STA R11 STY R10 LDY #0 STY DP ;NO DECIMAL POINT STY M3L ;EXP=0 STY M3H IN_b0 ESS OF FLOATING POINT * ;* STRING * ;* * ;* OUTPUTS: * ;* FR1 - FLOATING POINT NUMBER * ;* * * ;* BY MIKE WESTERFIELD * ;* COPYRIGHT (C) JANUARY 1983 * ;* BY HAYDEN BOOK COMPANY, INC. * ;* * ;* INPUTS: * ;* FR1 - NUMERATOR * ;* FR2 - DENOMINATOR * ;* * ;* OUTPUTS: * ;* FR1 - RESULT * ;* * ;************************ BEQ OVFL_2 LDA FR1+2 ;SET SIGN AND #07F ORA SIGN STA FR1+2 RTS OVFL_2 JMP OVFL_1 ; ; INTERNAL ROUTINE: COMPARE FR1 AND FR2 ; MANTISAS ; CP12 LDX #0 CP1 LDA FR1+11.,X +1 ;SHIFTS SBC M1L STA FR1+1 LDA FR1 SBC M1H STA FR1 BCS DV_a5 LDA #0FF CMP M1L BNE OVFL_2 CMP M1H BNE OVFL_2 DV_a5 ORA FR1+1 1+13. ROL FR1+12. ROL FR1+11. INC2 M1L ;INC SHIFT COUNT LDA FR1+2 ;CHECK FOR DONE BPL DV_a2 SEC ;ACCOUNT FOR EXTRA LDA FR1 ROL FR1+7 ROL FR1+6 ROL FR1+5 ROL FR1+4 ROL FR1+3 ROL FR1+2 ROL FR1+19. ROL FR1+18. ROL FR1+17. ROL FR1+16. ROL FR1+15. ROL FR1+14. ROL FR SEC ;SUBTRACT LDX #8 DV_a3 LDA FR1+11.,X SBC FR2+2,X STA FR1+11.,X DBPL X,DV_a3 DV_a4 ROL FR1+0a ;SHIFT IN DIVIDE BIT ROL FR1+9 ROL FR1+8; ; DO 9 BYTE DIVIDE UNTIL LEFT JUSTIFIED ; (lda #0B7 ;LA M1L,-73 SET SHIFT COUNT (sta m1l (lda #0ff (sta m1l+1 (nop (nop (nop ( ( DV_a2 JSR CP12 BLT DV_a4 IN_f9 DEC FR1 IN_f9 LDA FR1 ORA FR1+1 BEQ OVFL_1 IN_f10 LSR FR2+2 ROR FR2+3 ROR FR2+4 ROR FR2+5 ROR FR2+6 ROR FR2+7 ROR FR2+8 ROR FR2+9 ROR FR2+0a +13. ROR FR1+14. ROR FR1+15. ROR FR1+16. ROR FR1+17. ROR FR1+18. ROR FR1+19. JMP IN_f10 IN_f8 DEC FR1+1 ;PRESHIFT FR2 LDA FR1+1 CMP #0FF BNE IN_f7 LDA FR1+2,X STA FR1+11.,X STY FR1+2,X DBPL X,IN_f7 JSR CP12 ;CHECK FOR PRESHIFT BLT IN_f8 ;OF FR1 LSR FR1+11. ROR FR1+12. ROR FR1 IN_f6 LDA FR1 EOR FR2 BPL IN_f6 PLA OVFL_1 FERR #2 RTS IN_f6 PLA STA FR1 LDX #8 ;MOVE NUMBER TO WORK LDY #0 ;AREA AND ZERO FR1 IN_f5 IN_f4 EOR #080 STA FR2+2 IN_f5 SEC ;SUBTRACT EXPONENTS LDA FR1+1 SBC FR2+1 STA FR1+1 LDA FR1 SBC FR2 EOR #080 PHA EOR FR1 BPL2 EOR #080 STA FR1+2 LDA #0 IN_f3 STA SIGN LDA FR2+2 ;FR2=ABS(FR2); BPL IN_f4 ;SIGN = SIGN(FR1*FR2) LDA SIGN EOR #080 STA SIGN JMP IN_f1 LDA FR1 ;ZERO IF FR1 IS ZERO ORA FR1+1 BEQ RTS_2 LDA FR1+2 ;FR1=ABS(FR1) BPL IN_f2 ;SIGN = SIGN(FR1) LDA #080 BNE IN_f3 IN_f**************** ;* SYSDDIV ; ; INITIALIZATION ; LDA FR2 ;EXCEPTION IF FR2 IS ORA FR2+1 ;ZERO BNE IN_f1 FERR #4 RTS_2 RTS CMP FR2+2,X BNE CP2 INX CPX #9 BNE CP1 CP2 RTS (.if test (.ascii "SYSDMUL" (.endc  ;**************************************** ;* * ;* SYSDMUL - DOUBLE PRECISION MULTIPLY * ;* * ;* BY MIKE WESTERFIELD * ;* COPYRIGHT (C) JANUARY 1983 * ;* BY HAYDEN BOOK COMPANY, INC. * ;* * ;* INPUTS: ML4 DEY ;NEXT BIT H;was DEY Y ??!? H JNE ML1 ; ; SET SIGN ; SS1 LDA FR1+2 ;SHIFT LEFT 1 BIT IF BMI SS2 ;SHIELD BIT NOT JSR SYSDROL 6 STA FR1+6 LDA FR1+5 ADC FR2+5 STA FR1+5 LDA FR1+4 ADC FR2+4 STA FR1+4 LDA FR1+3 ADC FR2+3 STA FR1+3 LDA FR1+2 ADC FR2+2 STA FR1+2 R1+10. ADC FR2+10. STA FR1+10. LDA FR1+9 ADC FR2+9 STA FR1+9 LDA FR1+8 ADC FR2+8 STA FR1+8 LDA FR1+7 ADC FR2+7 STA FR1+7 LDA FR1+6 ADC FR2+ ROR FR1+12. ROR FR1+13. ROR FR1+14. ROR FR1+15. ROR FR1+16. ROR FR1+17. ROR FR1+18. ROR FR1+19. BCC ML4 CLC ;ADD PARTIAL PRODUCT LDA F BEQ SS1 ML3 LSR FR1+2 ;SHIFT RIGHT 1 BIT ROR FR1+3 ROR FR1+4 ROR FR1+5 ROR FR1+6 ROR FR1+7 ROR FR1+8 ROR FR1+9 ROR FR1+10. ROR FR1+11. #8 BLT ML3 LDX #16. ;SHIFT RIGHT 8 BITS ML2 LDA FR1+2,X STA FR1+3,X DBPL X,ML2 LDA #0 STA FR1+2 SEC TYA SBC #8 TAY BNE ML1 LDA FR1+1,X STA FR1+10.,X STY FR1+1,X DBNE X,IN_d7 ; ; DO 9 DIGIT MULTIPLY ; LDY #72. ;72 BIT MULTIPLY ML1 LDA FR1+19. ;CHECK FOR 8 CLEAR BNE ML3 CPY #0 ;SHIELD FROM STA FR2+11. ;OVERFLOW CLC JSR SYSDR2R IN_d6 LDX #9 ;MOVE NUMBER TO WORK LDY #0 ;AREA AND ZERO FR1 IN_d7 ;ADD EXPONENTS EOR FR2 BPL IN_d5A OVFL_3 FERR #2 RTS IN_d5 JSR AEXP ;SIGNS DIFFERENT- NO ;OVERFLOW POSSIBLE IN_d5A LDAN_d4 LDA FR1 ;ADD EXPONENTS EOR FR2 ;SPLIT BASED ON BMI IN_d5 ;EXPONENT SIGNS JSR AEXP ;BOTH THE SAME #0 IN_d2 STA SIGN LDA FR2+2 ;FR2=ABS(FR2); BPL IN_d3 ;SIGN=SIGN(FR1*FR2) LDA SIGN EOR #080 STA SIGN JMP IN_d4 IN_d3 EOR #080 STA FR2+2 I_d0A STA FR1 STA FR1+1 RTS_3 RTS IN_d0A LDA FR1+2 ;FR1=ABS(FR1); BPL IN_d1 ;SIGN=SIGN(FR1) LDA #080 BNE IN_d2 IN_d1 EOR #080 STA FR1+2 LDA ;**************************************** ;* SYSDMUL ; ; INITIALIZATION ; LDA FR1 ;ZERO IF FR1 OR FR2 ORA FR1+1 ;IS ZERO BEQ RTS_3 LDA FR2 ORA FR2+1 BNE IN * ;* FR1,FR2 - NUMBERS TO MULTIPLY * ;* * ;* OUTPUTS: * ;* FR1 - RESULT * ;* * ;USED SS2 LDA FR1+2 ;SET SIGN AND #07F ORA SIGN STA FR1+2 RTS ; ; INTERNAL ROUTINE: ADD EXPONENTS ; AEXP CLC LDA FR1+1 ADC FR2+1 STA FR1+1 LDA FR1 ADC FR2 EOR #080 STA FR1 RTS (.if test (.ascii "SYSDSUB & SYSDADD" (.endc  ;**************************************** ;* * ;* SYSDSUB - DOUBLE PRECISION SUBTRACT * ;* SYSDADD JSR SYSDR2R DBNE X,SF5 ; ; ADD FR1 AND FR2 ; AD1_a CLC ;10 BYTE ADD LDX #0b AD2 LDA FR1,X ADC FR2,X STA FR1,X DBNE X,AD2 LDA FR1+1 ;SAVR2,X DBNE X,SF3 SF4 LDA R4 ;SHIFT RIGHT BIT BY AND #7 ;BIT, MAINTAINING BEQ AD1_a ;SIGN BIT. TAX SF5 LDA FR2+1 ASL A ;SIGN BITS. SEC LDA #0b SBC R5 TAY LDX #0b SF2 LDA FR2,Y STA FR2,X DEX DBNE Y,SF2 LDA #0 LDY FR2+1 BPL SF3 LDA #0FF SF3 STA F ;> 80 CMP #81. BLT SF1B SF1A JMP SE1_a SF1B lsr a ; was MLSR A,3 SHIFT RIGHT BY FULL (lsr a (lsr a ( BEQ SF4 ;BYTES, MAINTAINING STA R5 ; MATCH EXPONENTS BY SHIFTING ; SF1_c SEC ;SET # SHIFTS LDA R1 SBC R3 STA R4 LDA R0 SBC R2 BNE SF1A ;QUIT IF # SHIFTS LDA R4 LDX #0a SEC XP8 LDA #0 SBC FR2,X STA FR2,X DBNE X,XP8 BEQ SF1_c XP9 ORA #080 ;SET HIGH BIT FOR STA FR2+2 ;POSITIVE NUMBER ; FR1 BEQ XP7 XP6 ORA #080 ;SET HIGH BIT FOR STA FR1+2 ;POSITIVE NUMBER XP7 LDA FR2+2 ;COMPLEMENT FR2 IF BPL XP9 ;IT IS NEGATIVE BYTES AND STA FR1+1 ;ROUNDING BIT STA FR2+1 STA FR1+11. STA FR2+11. LDA FR1+2 ;COMPLEMEMT FR1 IF BPL XP6 ;IT IS NEGATIVE JSR CXP3C LDA FR2+1 ;SAVE EXPONENT STA R3 ;OF FR2 movew FR1,R0 ;SAVE EXPONENT ;OF FR1 LDA #0 ;SET HIGHDX #0a XP3 LDA FR2,X LDY FR1,X STA FR1,X STY FR2,X DBPL X,XP3 XP3A LDA FR2 ;QUIT IF FR2=0 STA R2 ORA FR2+1 BNE XP3C RTS ;IF THE EXPONENT OF CMP FR2 ;FR1 IS SMALLER BNE XP1 ;THAN THAT OF FR2, LDA FR1+1 ;SWITCH THEM CMP FR2+1 XP1 BGE XP3A L FR1-FR2 * ;* * ;**************************************** ;* SYSDSUB LDA FR2+2 EOR #080 STA FR2+2 SYSDADD ; ; INITIALIZE NUMBERS FOR SHIFTING ; LDA FR1 ;* INPUTS: * ;* FR1,FR2 - NUMBERS TO ADD OR * ;* SUBTRACT * ;* * ;* OUTPUTS: * ;* FR1 - ANSWER: FR1+FR2 OR * ;* - DOUBLE PRECISION ADD * ;* * ;* BY MIKE WESTERFIELD * ;* COPYRIGHT (C) JANUARY 1983 * ;* BY HAYDEN BOOK COMPANY, INC. * ;* * E SIGN AND #080 STA SIGN BPL NM1 ;BR IF FR1 > 0 JSR CFR1 ;COMPLEMENT FR1 ; ; NORMALIZE THE RESULT ; NM1 LDX #9 ;CHECK FOR ZERO NM1A LDA FR1,X BNE NM2 DBNE X,NM1A STA FR1 RTS NM2 LDA FR1+1 BEQ NM5 SEC ;SHIFT RIGHT 1 BIT JSR ROR_1 INC R1 BNE NM2A INC R0 NM2A BNE SE1_a OVFL_;* * ;* OUTPUTS: * ;* FR2 - SHIFTED RIGHT 1 BIT * ;* * ;**************************************** ;* SYSDR2R ROR FR2+2 ROR F * ;* COPYRIGHT (C) JANUARY 1983 * ;* BY HAYDEN BOOK COMPANY, INC. * ;* * ;* INPUTS: * ;* FR2 - REGISTER TO ROLL *  .if test (.ascii "SYSDR2R" (.endc  ;**************************************** ;* * ;* SYSDR2R - ROLL 2 RIGHT 1 BIT * ;* * ;* BY MIKE WESTERFIELD ROL FR1+13. ROL FR1+12. ROL FR1+11. SYSDR10 ROL FR1+10. ROL FR1+9 ROL FR1+8 ROL FR1+7 ROL FR1+6 ROL FR1+5 ROL FR1+4 ROL FR1+3 ROL FR1+2 RTS CMP FR1+1 BNE RL1 DEC FR1 LDA FR1 ORA FR1+1 BNE RL1 FERR #5 RTS RL1 ASL FR1+17. ;SHIFT LEFT 1 BIT ROL FR1+16. ROL FR1+15. ROL FR1+14. ANTISSA WITHOUT CHANGING * ;* THE EXPONENT. * ;* * ;**************************************** ;* SYSDROL LDA #0FF ;DEC EXPONENT DEC FR1+1 C - MOST SIGNIFICANT BIT OF * ;* MANTISSA * ;* FR1 - RESULT * ;* * ;* NOTES: * ;* 1) ENTRY AT SYSDR10 SHIFTS THE * ;* MBY HAYDEN BOOK COMPANY, INC. * ;* * ;* INPUTS: * ;* FR1 - NUMBER TO SHIFT * ;* * ;* OUTPUTS: * ;* ;* LEFT 1 BIT AND DECRIMENTS THE * ;* EXPONENT. THE HIGH BIT OF THE * ;* MANTISSA IS LEFT IN THE CARRY FLAG. * ;* * ;* BY MIKE WESTERFIELD * ;* COPYRIGHT (C) JANUARY 1983 * ;* cii "SYSDROL" (.endc  ;**************************************** ;* * ;* SYSDROL - ROLL FR1 LEFT 1 BIT * ;* * ;* THIS ROUTINE SHIFTS THE MANTISSA * ;ROLL FR1 RIGHT ROR FR1+3 ;1 BIT ROR FR1+4 ROR FR1+5 ROR FR1+6 ROR FR1+7 ROR FR1+8 ROR FR1+9 ROR FR1+10. ROR FR1+11. RTS ' ' (.if test (.asGN STA FR1+2 RTS ; ; INTERNAL SUBROUTINES ; CFR1 LDX #0a ;COMPLEMENT FR1 SEC CF2 LDA #0 SBC FR1,X STA FR1,X DBNE X,CF2 RTS ROR_1 % ROR FR1+2 NM5 LDA FR1+2 ;LOOP IF NOT NORMAL BPL NM3 ; ; SET THE SIGN AND EXPONENT AND QUIT ; SE1_a movew R0,FR1 ;SET EXPONENT LDA FR1+2 ;SET SIGN AND #07F ORA SI4 FERR #2 RTS NM3 ASL FR1+11. ;SHIFT LEFT 1 BIT JSR SYSDR10 DEC R1 LDX #0FF CPX R1 BNE NM4 DEC R0 NM4 LDA R0 ORA R1 BEQ OVFL_4 R2+3 ROR FR2+4 ROR FR2+5 ROR FR2+6 ROR FR2+7 ROR FR2+8 ROR FR2+9 ROR FR2+10. ROR FR2+11. RTS * ;* NOTES: * ;* 1) DEVELOPED FROM HART, PP 105- * ;* 111 AND TABLE 2706. * ;* * ;**************************************** ;* SYSDLNX ; * ;* INPUTS: * ;* FR1 - NUMBER TO TAKE LOG OF * ;* * ;* OUTPUTS: * ;* FR1 - DOUBLE PRECISION LOG * ;* ;* SYSDLNX - DOUBLE PRECISION NATURAL * ;* LOGARITHM * ;* * ;* BY MIKE WESTERFIELD * ;* COPYRIGHT (C) JANUARY 1983 * ;* BY HAYDEN BOOK COMPANY, INC. * ;* OG JSR SYSDLNX movenum ILN10,FR2 JSR SYSDMUL RTS (.if test (.ascii "SYSDLNX" (.endc  ;**************************************** ;* * * ;* OUTPUTS: * ;* FR1 - DOUBLE PRECISION COMMON * ;* LOG * ;* * ;**************************************** ;* SYSDL;* BY MIKE WESTERFIELD * ;* COPYRIGHT (C) JANUARY 1983 * ;* BY HAYDEN BOOK COMPANY, INC. * ;* * ;* INPUTS: * ;* FR1 - NUMBER TO TAKE LOG OF * ;* (.if test (.ascii "SYSDLOG" (.endc  ;**************************************** ;* * ;* SYSDLOG - DOUBLE PRECISION COMMON * ;* LOG * ;* * IKLMNOPQRSTUVWXYZ[\]^_`abcdefghijklmnopqrstuvw1 2 3 4 CCO^5g ; ERROR IF FR1<=0 ; LDA FR1 ORA FR1+1 BEQ ER1 LDA FR1+2 BPL SF_d1 ER1 FERR #3 RTS ; ; SPLIT FR1 INTO COMPONENT PARTS ; SF_d1 movew FR1,EXP ;SAVE EXPONENT LDA #080 ;.5 <= FR1 < 1.0 STA FR1 LDA #0 STA FR1+1 movenum SQR2,FR2 ;1/SQR(2) <= JSR SYSDMUL ;FR1 < SQR(2) ; ; DETERMINE Z=(X-1)/(X+1) ; LDX;SET SIGN AND #07F ORA SIGN STA FR1+2 BPL EX_b6 SUB0 M2L,M2L EX_b6 LDA FR1 ;IF ABS(FR1) >= 1/2, BPL PW1 ;DIVIDE BY 2 INC M3L DEC FR1+X_b4 LDA FR1+2 ;FRACTIONAL PART BMI EX_b5 JSR SYSDROL DBPL X,EX_b4 ( (lda #00 ;LA FR1,0 FR1=0 (sta fr1 (sta fr1+1 ( EX_b5 LDA FR1+2 CMP #080 BNE EX_b2 LDA FR1+1 BEQ EX_b3 EX_b2 JSR SYSDROL ROL M2L ROL M2H LDA M2H BPL EX_b1 OVFL_5 FERR #2 RTS EX_b3 LDX #080 ;LEFT JUSTIFY E STA FR1+2 LDA #0 ;REMOVE INTEGER PART STA M2L STA M2H STA M3L LDA FR1 ORA FR1+1 BEQ PW1 LDA FR1 BPL EX_b5 EX_b1 LDA FR1 SYSDMUL ; ; REDUCE THE RANGE TO -1/2 < FR1 < 1/2 ; BY: ; 1) REMOVING INTEGER PART ; 2) DIVIDING BY 2 IF RESULT > 1/2 ; LDA FR1+2 ;SAVE SIGN AND #080 STA SIGN LDA FR1+2 ORA #080 104 AND TABLE 1324. * ;* * ;**************************************** ;* SYSDEXP ; ; DIVIDE BY LN(2) TO CONVERT THE PROBLEM ; FROM FINDING EXP(X) TO FINDING 2^X ; movenum ILN2,FR2 JSR ;* FR1 - RESULT * ;* * ;* NOTES: * ;* 1) USES SYSDADD,SYSDDIV, * ;* SYSDMUL,SYSDPOL,SYSDSUB * ;* 2) DEVELOPED FROM HART, PP 96- * ;* HAYDEN BOOK COMPANY, INC. * ;* * ;* INPUTS: * ;* FR1 - ARGUMENT * ;* * ;* OUTPUTS: * ************************************** ;* * ;* SYSDEXP - EXP(X) * ;* * ;* BY MIKE WESTERFIELD * ;* COPYRIGHT (C) JANUARY 1983 * ;* BY M1L LDA EXP EOR #080 STA M1H JSR SYSDFLT movenum Z,FR2 JSR SYSDADD movenum LN2,FR2 JSR SYSDMUL RTS (.if test (.ascii "SYSDEXP" (.endc  ;** JSR SYSDDIV movenum Z,FR2 JSR SYSDMUL ; ; RESULT = LN(2)*(FR1/LN(2)-.5+FLOAT(EXP)) ; FN_b1 movenum ILN2,FR2 JSR SYSDMUL movenum NI2,FR2 JSR SYSDSUB movenum FR1,Z LDA EXP+1 STA LA R6,Q4 LM R8,#4 JSR SYSDPOL LDX #0a ES1 LDA FR1,X STA Q,X LDA W,X STA FR1,X DBPL X,ES1 LA R6,sysP3 LM R8,#3 JSR SYSDPOL movenum Q,FR2 L X,DZ2 JSR SYSDSUB movenum W,FR2 JSR SYSDDIV ; ; LN(FR1)=FR1*P(FR1^2)/Q(FR1^2) ; ;MOVE FR1,(Z,FR2),#0b 'movenum fr1,z 'movenum fr1,fr2 ' JSR SYSDMUL movenum FR1,W #0a DZ1 LDA FR1,X STA Z,X LDA N1,X STA FR2,X DBPL X,DZ1 JSR SYSDADD LDX #0a DZ2 LDA FR1,X STA W,X LDA Z,X STA FR1,X LDA N1,X STA FR2,X DBP1 DEC FR1 ; ; FR1 = 2^FR1 = 2*FR1*P(FR1^2)/(Q(FR1^2) ; -FR1*P(FR1^2))+1 ; PW1 movenum fr1,fr2 ;move FR1,(FR2,FX),#0b (movenum fr1,fx 'JSR SYSDMUL movenum FR1,FX2 LA R6,sysP2 LM R8,#2 JSR SYSDPOL movenum FX,FR2 JSR SYSDMUL LDX #0a PW2 LDA FR1,X STA FX,X LDA FX2,X STA FR1,X DBPL X,PW2 LA R6,Q3 LM R8,#3 JSR SYSDPOL STA FR1+2 CLV RTS ERTS LDA #07F ;SEV ADC #8 RTS  .if test (.ascii "SYSDFLT" (.endc  ;**************************************** ;* * ;* SYSDFMALIZE RESULT BMI DF_a6 JSR SYSDROL JMP DF_a5 DF_a6 LDA SIGN ;SET SIGN OF RESULT BPL DF_a7 SUB0 M1L,M1L DF_a7 LDA FR1+2 ;FR1=ABS(FR1) AND #07F DEC FR1 JMP DF_a1 DF_a3 LDX #7 ;CHECK FOR 0 DF_a4 LDA FR1+2,X BNE DF_a5 DBPL X,DF_a4 STA FR1 STA FR1+1 BMI DF_a6 DF_a5 LDA FR1+2 ;NOR ROL FR1+6 ROL FR1+5 ROL FR1+4 ROL FR1+3 ROL FR1+2 ROL M1L ROL M1H BMI ERTS DEC FR1+1 ;SHIFT EXPONENT LDA FR1+1 CMP #0FF BNE DF_a1 3 DF_a1 LDA FR1 ;CHECK FOR < 1 CMP #080 BNE DF_a2 LDA FR1+1 BEQ DF_a3 DF_a2 ASL FR1+10. ;SHIFT MANTISSA ROL FR1+9 ROL FR1+8 ROL FR1+7 YSDFIX LDA FR1+2 ;FR1=-ABS(FR1) STA SIGN ORA #080 STA FR1+2 (lda #00 ;was LA M1L,0 CHECK FOR < .1 (sta m1l (sta m1l+1 ( LDA FR1 BPL DF_a;* M1L - SIGNED INTEGER RESULT * ;* FR1 - POSITIVE FRACTIONAL * ;* REMAINDER * ;* V - SET IF OVERFLOW * ;* * ;**************************************** ;* SCOMPANY, INC. * ;* * ;* INPUTS: * ;* FR1 - DOUBLE PRECISION NUMBER * ;* * ;* OUTPUTS: * * ;* SYSDFIX - CONVERT DOUBLE PRECISION * ;* TO INTEGER * ;* * ;* BY MIKE WESTERFIELD * ;* COPYRIGHT (C) JANUARY 1983 * ;* BY HAYDEN BOOK LDA FR1+1 ;EXPONENT ADC M2L STA FR1+1 LDA FR1 ADC M2H STA FR1 RTS (.if test (.ascii "SYSDFIX" (.endc  ;**************************************** ;* BPL FN_c2 ;EXPONENT SIGNS JSR ADEXP EOR M2H BMI FN_c3 OVFL_6 JMP OVFL_5 FN_c2 JSR ADEXP FN_c3 RTS ; ; INTERNAL SUBROUTINES ; ADEXP CLC ;ADD M2 TO FR1 num FR1,FR2 JSR SYSDMUL ; ; ADD IN 2^M2 (M2 IS THE INTEGER PART ; REMOVED DURING RANGE REDUCTION. ; FN_c1 LDA FR1 ;ADD EXPONENTS EOR M2L ;SPLIT BASED ON PW4 INC FR1 PW4 LDA FR1 ORA FR1+1 BEQ OVFL_6 PW5 movenum N1,FR2 JSR SYSDADD ; ; IF DIVISION BY ZERO WAS USED ; DURING RANGE REDUCTION, SQUARE ; THE RESULT. ; LDA M3L BEQ FN_c1 move movenum FX,FR2 JSR SYSDSUB LDX #0a PW3 LDA FR1,X STA FR2,X LDA FX,X STA FR1,X DBPL X,PW3 JSR SYSDDIV LDA FR1 ORA FR1+1 BEQ PW5 INC FR1+1 BNELT - DOUBLE PRECISION FLOAT * ;* * ;* BY MIKE WESTERFIELD * ;* COPYRIGHT (C) JANUARY 1983 * ;* BY HAYDEN BOOK COMPANY, INC. * ;* * ;* INPUTS: * ;* M1 - NUMBER TO FLOAT * ;* * ;* OUTPUTS: * ;* FR1 - DOUBLE PRECISION FLOATING * ;* POINT NUMBER * ;* INPUTS: * ;* FR1 - NUMBER TO ROUND * ;* * ;**************************************** ;* SYSDRND ROL FR1+10. BCC RTS_4 LDA FR1+2 ;* SYSDRND - ROUND A NUMBER * ;* * ;* BY MIKE WESTERFIELD * ;* COPYRIGHT (C) JANUARY 1983 * ;* BY HAYDEN BOOK COMPANY, INC. * ;* * ;* DBPL Y,DP3 JSR SYSDADD ' 'dec r8 'bne dp2 ;DBNE R8,DP2 NEXT TERM RTS (.if test (.ascii "SYSDRND" (.endc  ;**************************************** ;* * ;TOTAL BY X ' clc ;was ADD R6,#11 ADD IN NEXT COEF ' lda r6 (adc #0b (sta r6  bcc $010 (inc r6+1 $010 ' LDY #0b DP3 LDA @R6,Y STA FR2,Y OL LDY #0a ;INITIALIZE DP1 LDA FR1,Y STA pol_FX,Y LDA @R6,Y STA FR1,Y DBPL Y,DP1 DP2 movenum pol_FX,FR2 ;MULTIPLY CURRENT JSR SYSDMUL FR1 - RESULT * ;* * ;* NOTES: * ;* 1) USES SYSDMUL AND SYSDADD * ;* * ;**************************************** ;* SYSDP;* COEFFICIENTS, IN REVERSE * ;* ORDER (HIGH ORDER COEF * ;* TO LOW ORDER COEF) * ;* R8 - ORDER OF POLYNOMIAL * ;* * ;* OUTPUTS: * ;* OPYRIGHT (C) JANUARY 1983 * ;* BY HAYDEN BOOK COMPANY, INC. * ;* * ;* INPUTS: * ;* FR1 - ARGUMENT * ;* R6 - ADDRESS OF POLYNOMIAL * * POLYNOMIAL * ;* * ;* EVALUATES A DOUBLE PRECISION * ;* POLYNOMIAL IN FR1. * ;* * ;* BY MIKE WESTERFIELD * ;* C LDA FR1+2 AND #07F ORA SIGN STA FR1+2 RTS (.if test (.ascii "SYSDPOL" (.endc  ;**************************************** ;* * ;* SYSDPOL - DOUBLE PRECISION * ; BMI DF_b4 ; ; SHIFT FOR PRECISION ; DF_b3 ASL FR1+3 ;HIGH BIT IS ZERO, ROL FR1+2 ;START WITH SHIFT DEC FR1+1 LDA FR1+2 BPL DF_b3 ; ; SET SIGN AND RETURN ; DF_b4 L DF_b2 ;INTEGER SEC ;CHANGE SIGN ROR SIGN SUB0 M1L,M1L ;COMPLEMENT DF_b2 LM FR1+3,M1L ;MOVE IN INTEGER LM FR1+2,M1H FR1+1 RTS DF_b1 movenum MN,FR1 ;MOVE IN MODEL ;NUMBER LDA #0 ;INIT SIGN STA SIGN LDA M1H ;CHECK SIGN OF BP * ;**************************************** ;* SYSDFLT ; ; INITIALIZE NUMBER AND EXPONENT ; LDA M1L ;CHECK FOR 0 INTEGER ORA M1H BNE DF_b1 STA FR1 STA ;SAVE SIGN AND #080 STA SIGN LDA FR1+2 ORA #080 STA FR1+2 LDX #9 ;ADD IN NEW BIT RN1 INC FR1,X BNE RN2 DBPL X,RN1 OVFL_7 FERR #2 RTS RN2 TXA BNE RN3 LDA FR1 CMP #080 BEQ OVFL_7 RN3 LDA FR1+2 ;SET SIGN AND #07F ORA SIGN STA FR1+2 RTS_4 RTS (.if test (.ascii "SYSCVDC" (.endc  ;*****ERO BNE DV_b0 LDA #07F ;... SEV ADC #008 RTS DV_b0 JSR SYSSIGN ;POSITIVE NUMBERS! ' ';sec if M1>=M3 by subtracting m1-m3 ';no borrow means carry set ' ' lda m1h 1) USES SSIGN * ;* * ;**************************************** ;* SYSDIVD ; ; INITIALIZE ; LDA M3L ;CHECK FOR DIVISION ORA M3H ;BY Z;* OUTPUTS: * ;* M1 - RESULT * ;* M2 - POSITIVE REMAINDER * ;* V - SET IF DIVISION BY ZERO * ;* * ;* NOTES: * ;* BY HAYDEN BOOK COMPANY, INC. * ;* * ;* INPUTS: * ;* M1 - NUMERATOR * ;* M3 - DENOMINATOR * ;* * ;* * ;* SYSDIVD - TWO BYTE SIGNED INTEGER * ;* DIVIDE * ;* * ;* BY MIKE WESTERFIELD * ;* COPYRIGHT (C) JANUARY 1983 * ;* ************************************* ;* SYSNMID CMP #"0" BLT $020 CMP #"9"+1 BGE $010 SEC RTS $010 CLC $020 RTS (.if test (.ascii "SYSDIVD" (.endc  ;****************************************;* INPUTS: * ;* A - DIGIT TO CHECK * ;* * ;* OUTPUTS: * ;* C - SET IF NUMBER * ;* * ;**** ;* SYSNMID - IDENTIFY A NUMBER * ;* * ;* BY MIKE WESTERFIELD * ;* COPYRIGHT (C) JANUARY 1983 * ;* BY HAYDEN BOOK COMPANY, INC. * ;* * ;LOOP CPX #4 BNE CV1 RTS HDH .byte 027,003,000,000,000 HDL .byte 010,0E8,064,00A,001 (.if test (.ascii "SYSNMID" (.endc  ;**************************************** ;* YSDIVD ;DIVIDE M1=DECIMAL LDA M1L ;SET DEC CHAR ORA #030 LDX R7 STA R2,X ' 'movew m2l,m1l ;was move m2l,m1l but botched x value ' INC R7 LM R7,#0 ;SET LOOP CNTR movew R0,M1L ;MOVE HEX NUMBER CV1 LDX R7 ;SET DENOMINATOR LDA HDL,X STA M3L LDA HDH,X STA M3H JSR S- HEX VALUE TO CONVERT * ;* * ;* OUTPUTS: * ;* R2-R6 - DECIMAL PRINT CHARS * ;* * ;**************************************** ;* SYSCVDC * ;* BY MIKE WESTERFIELD * ;* COPYRIGHT (C) JANUARY 1983 * ;* BY HAYDEN BOOK COMPANY, INC. * ;* * ;* INPUTS: * ;* R0,R1 *********************************** ;* * ;* SYSCVDC * ;* * ;* CONVERS THE HEX VALUE IN R0,R1 TO * ;* DECIMAL PRINT DIGITS * ;* ;was CMP2 M1L,M3L (cmp m3h (bne $010 ' lda m1L (cmp m3L $010 ' ' ;IF M10, ELSE NON * ;* ;* COPYRIGHT (C) JANUARY 1983 * ;* BY HAYDEN BOOK COMPANY, INC. * ;* * ;* INPUTS: * ;* M1 - NUMBER * ;* M3 - NUMBER * ;* * ;* SYSSIGN - OBTAIN THE SIGN FOR * ;* INTEGER MULTIPLY AND DIVIDE * ;* ROUTINES * ;* * ;* BY MIKE WESTERFIELD * SIGN ;BRANCH IF PLUS BEQ $010 SUB0 M1L,M1L ;NEGATE M1 $010 CLV RTS  .if test (.ascii "SYSSIGN" (.endc  ;**************************************** ;* DBNE Y,DV_b5 ; LOOP BEQ DV_b7 DV_b6 INC M1L ;DIGIT IS 1 DBNE Y,DV_b5 ;LOOP DV_b7 STA M2L ;SAVE REMAINDER ; ; SET SIGN ; RTS_5 LDADV_b5 ASL M1L ;ROLL UP NEXT NUMBER ROL A SEC ;SUBTRACT FOR THIS SBC M3L ;DIGIT BCS DV_b6 ADC M3L ;DIGIT IS 0 Y,DV_b2 ;LOOP NEXT BIT BEQ RTS_5 ;GO DO SIGN ; ; 8 BIT DIVIDE ; DV_b4 LDA #0 ;INIT REMAINDER LDY #8 ;8 BITS TO GO 2L ;DIGIT SBC M3L TAX LDA M2H SBC M3H BCC DV_b3 ;BRANCH IF MINUS STX M2L ;TURN BIT ON STA M2H INC M1L DV_b3 DBNE BIT DIVIDE ; LDY #016. ;16 BITS TO GO DV_b2 ASL M1L ;ROLL UP NEXT NUMBER ROL M1H ROL M2L ROL M2H SEC ;SUBTRACT FOR THIS LDA M rts 1 2 3 4 5 6 8tB O^5clr_entry .equ 003 ;cntl-c pi .equ 022 ;quote ; e .equ 065 ;e  undo_cmd .equ 002 ;cntl-u  start (jmp entry (.ascii "K" (.word start-1 (.word impl. ; 2.00 initial testing version ; ;------------------------------------------------------------------ test .equ 0  numlen .equ 0b ;double precision = 11 bytes/number rest_mem .equ 012 ;cntl-r fixed re-show of first char typed ; 2.03 added Clr, ce and cr=add handlers, fixed chained ops handler ; and unified display of results, etc. ; 2.02 remove put_char and add back cursor to error char beep ; 2.01 initial version with fulleck for double E.- chars ; also allows leading - sign ; ; 2.06 set getnum to default to prev result for no num entry ; and filtered cntl chars out on first char typed ; 2.05 added my_display to SYSDOUT to handle non-E numbers ; 2.04; changed clears to cntl-Z = zero and cntl-C = clear ; added dummy pi and e constants ; added EXP function with cntl-L (for antilog) ; clear out supermacros on entry and restore at exit ; added logic to get_num to ch no longer clearing screen on entry ; loading result on eXit into = macro unless too big ; no loading of = macro if Quit used ; added simple error trap to display * (beep) and zero result ; added undo (cntl-U) command remove e const, change e to exp fn ; added Help line display ; added deg and %pct functions ; 2.07 added SIN COS TAN functions ; changed entry command to (K)alc ; added memory register with save/restore (cntl-S,R) ; and .01 display as .01. ; ; 2.10 fixes for - neg nums and macro loading for E1 numbers ; ; 2.09 fixes for 2.08 ; 2.08 fixes for 2.07 ; changed string store locs from x'30 to x'20 bytes ; change undo to backup ; 0.PROC CALC,0 ;------------------------------------------------------------------ ; ; calc 2.11 9/05/86 ; ; 2.11 fix to handle "0" value storage in macro correctly ; fix to handle incorrect re-display for 0>x>.01 ; xz{|}~ end-start (.ascii "QuikCalc"  (.INCLUDE CALC.MAC (.include pkymacs (.include callmacs (.include zpcommon  entry jsr my_init 0jsr do_it 0jsr wrap_up 0rts  ; COMMON DATA R0 .equ 080 ;GENERAL PURPOSE R1 .equ 081 ;REGISTERS R2 .equ 082 R3 .equ 083 R4 .equ 084 R5 .equ 085 R6 .equ 086 R7 .equ 087 R8 .equ 088 R9 .equ 089 R10 .equ 08A R11 .equ 08B R12 .equ 08C R13 .equ 08Dchk_for_op ;char is not ok for number (ldx max_ops $010 cmp op_table,x (beq is_an_op (dex (bpl $010 (jsr beep_n_back (jmp get_one  is_an_op ;is an op (stx save_op_num (sta savte 01 alpha_tbl .ascii "E." alpha_f_tbl e_cnt .byte 0ff dp_cnt .byte 0ff char_is_ok ;char is ok for number jsr put_string ;add char to string (jmp get_one  ;checks for 0-9 (bcs char_is_ok ( chk_alpha (ldx alpha_cnt $005 cmp alpha_tbl,x (beq $010 (dex (bpl $005 (bmi chk_for_op $010 inc alpha_f_tbl,x (beq char_is_ok (jmp beep_n_back alpha_cnt .by0 (lda #020 ;show a dummy space instead 2.10 $010 jsr put_char (pla $090 rts ( ( get_one jsr get_char (cmp #clr_entry ;cntl-c is clear-entry... (bne chk_num (jmp get_num ( chk_num jsr SYSNMID (bne $040 (movenum save_undo,fr1 (rts $040 jsr clear_n_showit ;2.10 (jmp chk_num clear_n_showit (pha (jsr clear_display pla (pha (cmp #020 (bcs $010 ;don't display cntl chars 2.1g & jmp to get_one 2.10 ( $010 cmp #pi (bne $020 (movenum const_pi,fr1 (rts $020 cmp #rest_mem ;cntl-r (bne $030 (movenum mem_reg,fr1 (rts  $030 cmp #undo_cmd ;cntl-u r get_char chk_first ;check for constants e pi(") or restore or undo command (cmp #"-" (bne $010 ;leading minus sign ok (jsr clear_n_showit ;puts up the "-" 2.10 (jmp char_is_ok ;does put_strin save_op (stx save_op_num (dex (stx dp_cnt ;initialize these to ff so one inc -> 0 (stx e_cnt ( (CALL m_msg0,p_gn_msg  (jsr result_2_fr1 (jsr SYSDOUT (jsr result_2_fr1 (CALL m_msg,p_string get_first (jsget_num ;accept char input for proper number 0;terminated by an operator 0;result is fr1 << number 0; save_op << operator char ( ; save_op_num << operator number in table ( (ldx #00 (stx string_index (stx erands for binop (jsr result_2_fr1 gnum_2a jsr do_the_op (jsr fr1_2_result (bit op_pend_flag (bmi gnum_1a (bpl gnum_1 ;---------------------------------------------------- ;check for binary op (lda bin_op_tbl,x (cmp #02 (bne gnum_2a gnum_2 (jsr get_num ;second number for binary ops (moveb save_op,next_op (jsr handle_op2 (movenum fr1,fr2 ;set up two opqu 0BE ;CHARACTER ADDRESS do_it gnum_1 jsr get_num ;num--> fr1, op--> save_op  gnum_1a moveb #00,op_pend_flag (jsr fr1_2_result (moveb save_op,curr_op (moveb save_op_num,curr_op_num ( (tax ERR_number .equ 097 ;FLOATING POINT ERROR # AD1 .equ 098 ;FP AND DP OPERAND RAD .equ 09A ; LOAD REGISTERS FR1 .equ 09C ;FLOATING POINT FR2 .equ 0B0 ; MATH REGISTERS RETAD .equ 0BC ;RETURN ADDRESS CHRAD .e R14 .equ 08E R15 .equ 08F xb_r6 .equ 1687 xb_r10 .equ 168b   M1L .equ 090 ;TWO BYTE INTEGER M1H .equ 091 ;MATH REGISTERS M2L .equ 092 M2H .equ 093 M3L .equ 094 M3H .equ 095 SIGN .equ 096 e_op (lda string_index (beq $090 ;leave old string there if no new nmbr (lda #0ff (jsr put_string $090 ldy adj_p_string (lda adj_p_string+1 (jsr SYSDPIN ;convert string to FR1 number ( (rts fr1_2_result (ldx #numlen-1 $005 lda result,x (sta save_undo,x (lda fr1,x (sta result,x (dex (bpl $005 (rts  result_2_fr1 (movenum result,fr1 (rts   beep_n_back  lda #07 ;beep (jsr put_char sv_1a80 .block 40,0 ;x'80-BF  save_op .byte 00 save_op_num .byte 00 string_index .byte 00 get_num_msg .ascii "CALC >> " 0.byte 0ff  p_gn_msg .word get_num_msg max_ops .byte ;2.10 0sta @zp_key_data,y 0dey 0dex 0bpl $005 0dec zp_key_data+1 $090 rts 0 0 ; ; LOCAL DATA AREAS ; macro_len .byte 00 sv_xb_r6 .byte 00 sv_xb_r10 .byte 00 table of the = key @;we will bump ptr up one page then use @;the 0D * 10 (macro entry len) = D0 as a @;ptr to the base of the = entry 0clc 0lda #0d0 0adc macro_len 0tay 0 0inc zp_key_data+1 0 $005 lda string,x bcc $002 0lda #010 0 $002 sta macro_len ora #080 0ldy #1d ;offset to = key macro 0sta @zp_on_flags,y ;set the flag value 0 0and #7f 0tax 0 ;1D is offset into macro $020 lda save_the_exp+1 ;don't load macro if the 0and #7f ;result is > e15 or < e-15 0bne $090 0lda save_the_exp 0cmp #10 0bcs $090 0 lda actual_len 0cmp #011 0#02 $005 lda save_123,y (sta @zp_on_1_flag,y (dey (bpl $005 (rts  set_macro 0lda fr1 ;2.11 check for "0" 0ora fr1+1 0bne $020 0lda #01 0sta actual_len 0bne $002 0 (moveb sv_xb_r10,xb_r10 (rts  save_123_macs (ldx #00 (ldy #02 $005 lda @zp_on_1_flag,y (sta save_123,y (txa (sta @zp_on_1_flag,y (dey (bpl $005 (rts save_123 .byte 00,00,00 rest_123_macs  ldy 0ffef (sta xb_r6 (sta xb_r10 (jsr save_123_macs  (CALL m_msg,p_help_msg (rts  wrap_up (jsr rest_123_macs (ldy #3f $005 lda sv_1a80,y (sta 1a80,y (dey (bpl $005 ( (moveb sv_xb_r6,xb_r6 ;---------------------- init and wrap stuff ------------------------  my_init (moveb #00,err_number  moveb xb_r6,sv_xb_r6 (moveb xb_r10,sv_xb_r10  (ldy #3f $005 lda 1a80,y (sta sv_1a80,y (dey (bpl $005 ( (lda do_it 0 do_memstore movenum fr1,mem_reg 0rts do_deg_fn movenum k_pi_div_180,fr2 0jmp SYSDMUL do_pct_fn jsr SYSDMUL 0movenum N100,fr2 0jmp SYSDDIV  L m_put_char 0rts do_exit jsr set_macro ;save number string in + macro H;unless "E" format  do_quit pla 0pla do_null do_eq rts do_zero lda #00 0sta result 0sta result+1 0pla 0pla 0jmp ,op_pend_flag (moveb next_op,save_op $090 rts (  do_the_op (lda curr_op_num (asl a (tay (lda opfn_tbl+1,y (pha (lda opfn_tbl,y (pha (rts (  get_char CALL m_get_char 0and #7f 0rts put_char CAL(ldy string_index (sta string,y (iny (sty string_index (rts handle_op2 ;set op pending flag for second op which @;is a binary op (ldx save_op_num (lda bin_op_tbl,x (cmp #02 (bne $090 (moveb #80(lda #08 ;backup (jsr put_char (lda #20 (jsr put_char (lda #08 (jsr put_char (rts  clear_display (CALL m_msg0,p_gn_msg (lda #1f (jsr put_char ;clear to end of line (rts   put_string 13 op_table .byte 00 ;null op does eq 0.ascii "+-*/^=" 0.byte 011 ;cntl-Q is QUIT 0.byte 018 ;cntl-X is eXit 0.byte 01a ;cntl-Z is Zero 0.byte 00d ;cr does add 0.ascii "Ll" ;LOG, LN 0.byte 013 ;cntl-S is memStore 0.ascii "e" ;e is antilog (EXP) 0.ascii "sct" ;SIN COS TAN 0.ascii "d%" next_op .byte 00  op_pend_flag .byte 00 (.if test (.ascii "-------undo---------" (.endc ( save_undo .block numlen,00 mem_reg .block numlen,00  result .block numlen,00  exp_sgn_flag .byte 00 18,0DD,06D,093,089,009,06D .byte 080,00A,089,042,0CA,0A5,0A1,0D0,09F,0AD,046 .byte 080,009,032,01B,012,0FA,0AC,077,028,024,052 p_sysp3 .word sysp3-2000 curr_op .byte 00 curr_op_num .byte 00 5,018,098,019 .byte 080,00F,06C,09B,03D,054,014,0E1,0AD,008,052 .byte 080,015,07D,0F0,0D8,04A,0C3,0A3,05F,0AF,08A p_sysp2 .word sysp2-2000  sysP3 .byte 080,005,0C4,067,0D0,0BC,0BB,0F7,0F9,0B3,0F5 .byte 080,008,06C,029,03A,0DE .byte 080,008,041,0C1,083,09F,007,0F5,07E,002,0AB .byte 080,009,0A6,0F1,0F8,07A,013,0E4,07B,0DA,0E9 .byte 080,008,032,01B,012,0FA,0AC,077,028,024,05E p_q4 .word q4-2000  sysP2 .byte 080,006,072,074,006,0FC,0F4,00 .byte 080,013,020,003,0B1,082,09B,07B,0E8,05C,0C8 .byte 080,017,037,02D,0F8,014,0E7,009,083,07E,006 p_q3 .word q3-2000  Q4 .byte 080,001,000,000,000,000,000,000,000,000,000 .byte 080,006,08E,01A,0E1,092,032,09C,060,0000,000,000,000,000  ; N1 .byte 080,001,000,000,000,000,000,000,000,000,000 N1 Q3 .byte 080,001,000,000,000,000,000,000,000,000,000 .byte 080,00B,05A,0A7,010,08B,038,07B,077,06F,021 8,0AA,03B,029,05C,017,0F0,0BB,0BF LN2 .byte 080,000,031,072,017,0F7,0D1,0CF,079,0AB,0CA MN .byte 080,010,000,000,000,000,000,000,000,000,000 N10 .byte 080,004,020,000,000,000,000,000,000,000,000 NI2 .byte 080,000,000,000,000,000,byte 080,007,048,000,000,000,000,000,000,000,000  ILN10 .byte 07F,0FF,05E,05B,0D8,0A9,037,028,071,095,035 LN10 .byte 080,002,013,05D,08D,0DD,0AA,0A8,0AC,016,0EA SQR2 .byte 080,001,035,004,0F3,033,0F9,0DE,064,084,059 ILN2 .byte 080,001,03p_STRING .word string adj_p_string .word string-2000 ; ; INTERNAL CONSTANTS ; ; const_e .byte 080,002,02d,0f8,054,058,0a2,0bb,04a,09a,0af k_pi_div_180 .byte 07f,0fb,00e,0fa,035,012,094,0e9,0c7,009,067 N100 . .byte 000 MSIGN .byte 000 CHAR .byte 00 ;DISP IN STRING LCNT .byte 00 ;LOOP COUNTER STRING .block 20,0ff ;OUTPUT STRING .equ * FX2 .block numlen,00 Q .block numlen,00 MANT .block numlen,00  EXP .block 0f,00 ;check length TR1 .block 10,00 ;check length  LY .byte 000 DP .byte 000 ESIGN .word do_memstore-1 0.word SYSDEXP-1 0.word SYSDSIN-1 0.word SYSDCOS-1 0.word SYSDTAN-1  .word do_deg_fn-1 0.word do_pct_fn-1 0 0 pol_fx .block numlen,00 Z .equ * FX .block numlen,00 W0.word SYSDADD-1 0.word SYSDSUB-1 0.word SYSDMUL-1 0.word SYSDDIV-1 0.word SYSDPWR-1 0.word do_eq-1 0.word do_quit-1 0.word do_exit-1 0.word do_zero-1 0.word SYSDADD-1 ;cr=add 0.word SYSDLOG-1 0.word SYSDLNX-1  ;DEG PCT 0 binop_tbl .byte 01 0.byte 02,02,02,02,02,01 0.byte 01 0.byte 01 0.byte 01 0.byte 02 0.byte 01,01 0.byte 01 0.byte 01 0.byte 01,01,01 0.byte 01,02   opfn_tbl .word do_null-1 ;contains sout_exp+1  my_exp .word 0000 save_the_exp .word 0000 my_len .byte 00 actual_len .byte 00  my_string .block 20,0ff p_my_string .word my_string (.if test (.ascii "adj display" (.endc  adj_display (moveb char,actual_len ;2.10 (dec actual_len ;2.10 ( (lda err_number ;do error check here (beq $002 (moveb #"*",string (moveb #0ff,string+1 (lda #07 (jsr put_char (lda 1 2 3 4 5 6 SOUT ]9IC ! !`CO^50.INCLUDE CALC.1 0.INCLUDE CALC.2 0 end 0.END   .ascii "^Zero ^Clear ^X exit ^Quit Log lnx exp deg adds" .byte 0d,01f .ascii "^Backup ^Store ^Recall cos sin tan %ct +-/*^" .byte 0d,01f,0ff  p_help_msg .word help_msg 0.include CALC.SCT ng,y 0iny 0dec my_len 0rts 0 get_nxt_num (lda string,x (inx (cmp #"." (beq get_nxt_num (cmp #20 (bne $005 (sta string,x ;bump space right to flag next 0 $005 rts help_msg  .byte 01a,000,013,01f,0d jsr get_nxt_num (cmp #20 (beq adj_out ;2.11, was beq rts_xx (jsr build_string (bne $010 adj_out (lda #0ff (sta my_string,y (dey (sty actual_len rts_xx rts build_string sta my_stri(jmp adj_out adj_neg ;convert 1.23456 E-3 0;to .00123456 0; 0;also 1 E-2 0;to .01 (lda #"." (jsr build_string (lda #"0" $005 dec my_exp (beq $010  jsr build_string (bne $005 $010o 12000. $005 jsr get_nxt_num (cmp #20 (bne $007 (lda #"0" $007 jsr build_string (dec my_exp (bpl $005 (lda #"." $008 jsr build_string jsr get_nxt_num (cmp #20 (bne $008 ( (lda string ;check for leading minus sign (cmp #"-" (bne $090 (inx (iny (sta my_string ( $090 bit exp_sgn_flag (bmi adj_neg ( adj_pos ;convert 1.23456 E3 0;to 1234.56 0; 0;also 1.2 E4 0;t(lda my_exp (beq $090 ;no adj for exp=0 (cmp #10 ;cc if exp<16 $090 rts (  do_adj moveb #10,my_len (lda #00 (tax ;index to old string (tay ;index to my new string (lda my_string,x (sta string,x (cmp #0ff (bne $005 (pla (pla $090 rts  chk_adj sec ;return cset=no adj, cclr=do adj (lda my_exp+1 ;check for exp > 15 or exp < -15 (and #7f (bne $090 #00 (sta result (sta result+1 (sta err_number (rts $002 ' movew sout_exp,my_exp ;*** DA save for later display chk (movew sout_exp,save_the_exp (jsr chk_adj (bcs $090 (jsr do_adj (ldx #0ff $005 inx mmon  entry jsr my_init 0jsr do_it 0jsr wrap_up 0rts  ; COMMON DATA R0 .equ 080 ;GENERAL PURPOSE R1 .equ 081 ;REGISTERS R2 .equ 082 R3 .equ 083 R4 .equ 084 R5 .equ 085 R6 .equ 086;e  undo_cmd .equ 002 ;cntl-u  start (jmp entry (.ascii "K" (.word start-1 (.word end-start (.ascii "QuikCalc"  (.INCLUDE CALC.MAC (.include pkymacs (.include callmacs (.include zpco numlen .equ 0b ;double precision = 11 bytes/number rest_mem .equ 012 ;cntl-r clr_entry .equ 003 ;cntl-c pi .equ 022 ;quote ; e .equ 065 s, etc. ; 2.02 remove put_char and add back cursor to error char beep ; 2.01 initial version with full impl. ; 2.00 initial testing version ; ;------------------------------------------------------------------ test .equ 0 ered cntl chars out on first char typed ; 2.05 added my_display to SYSDOUT to handle non-E numbers ; 2.04 fixed re-show of first char typed ; 2.03 added Clr, ce and cr=add handlers, fixed chained ops handler ; and unified display of resultantilog) ; clear out supermacros on entry and restore at exit ; added logic to get_num to check for double E.- chars ; also allows leading - sign ; ; 2.06 set getnum to default to prev result for no num entry ; and filt; added simple error trap to display * (beep) and zero result ; added undo (cntl-U) command ; changed clears to cntl-Z = zero and cntl-C = clear ; added dummy pi and e constants ; added EXP function with cntl-L (for changed entry command to (K)alc ; added memory register with save/restore (cntl-S,R) ; no longer clearing screen on entry ; loading result on eXit into = macro unless too big ; no loading of = macro if Quit used changed string store locs from x'30 to x'20 bytes ; change undo to backup ; remove e const, change e to exp fn ; added Help line display ; added deg and %pct functions ; 2.07 added SIN COS TAN functions ; orage in macro correctly ; fix to handle incorrect re-display for 0>x>.01 ; and .01 display as .01. ; ; 2.10 fixes for - neg nums and macro loading for E1 numbers ; ; 2.09 fixes for 2.08 ; 2.08 fixes for 2.07 ; 0.PROC CALC,0 ;------------------------------------------------------------------ ; ; calc 2.12 9/05/86 ; ; 2.12 want fix for macro 1.23 from 1.234 ; want fix for Zero command after 123 -> 023 ; 2.11 fix to handle "0" value st R7 .equ 087 R8 .equ 088 R9 .equ 089 R10 .equ 08A R11 .equ 08B R12 .equ 08C R13 .equ 08D R14 .equ 08E R15 .equ 08F xb_r6 .equ 1687 xb_r10 .equ 168b   M1L .equ 090 ;TWO BYTE INTEGER M1H .equ 091 ;MATH REGISTERS M2L .equ 092 M2H .equ 093 M3L .equ 094 M3H .equ 095 SIGN .equ 096 ERR_number .equ 097 ;FLOATING POINT ERROR # AD1 .equ 098 ;FP AND DP OPERAND RAD .equ 09A ; LOAD REGISTERSstring+1 (jsr SYSDPIN ;convert string to FR1 number ( (rts fr1_2_result (ldx #numlen-1 $005 lda result,x (sta save_undo,x (lda fr1,x (sta result,x (dex (bpl $005 (rts  result_2_fr1 (movenum result,fr1 ( get_one  is_an_op ;is an op (stx save_op_num (sta save_op (lda string_index (beq $090 ;leave old string there if no new nmbr (lda #0ff (jsr put_string $090 ldy adj_p_string (lda adj_p_ jsr put_string ;add char to string (jmp get_one  chk_for_op ;char is not ok for number (ldx max_ops $010 cmp op_table,x (beq is_an_op (dex (bpl $010 (jsr beep_n_back (jmp (beq char_is_ok (jmp beep_n_back alpha_cnt .byte 01 alpha_tbl .ascii "E." alpha_f_tbl e_cnt .byte 0ff dp_cnt .byte 0ff char_is_ok ;char is ok for number (bne chk_num (jmp get_num ( chk_num jsr SYSNMID ;checks for 0-9 (bcs char_is_ok ( chk_alpha (ldx alpha_cnt $005 cmp alpha_tbl,x (beq $010 (dex (bpl $005 (bmi chk_for_op $010 inc alpha_f_tbl,x  #020 (bcs $010 ;don't display cntl chars 2.10 (lda #020 ;show a dummy space instead 2.10 $010 jsr put_char (pla $090 rts ( ( get_one jsr get_char (cmp #clr_entry ;cntl-c is clear-entry... (rts  $030 cmp #undo_cmd ;cntl-u (bne $040 (movenum save_undo,fr1 (rts $040 jsr clear_n_showit ;2.10 (jmp chk_num clear_n_showit (pha (jsr clear_display pla (pha (cmp p the "-" 2.10 (jmp char_is_ok ;does put_string & jmp to get_one 2.10 ( $010 cmp #pi (bne $020 (movenum const_pi,fr1 (rts $020 cmp #rest_mem ;cntl-r (bne $030 (movenum mem_reg,fr1 SYSDOUT (jsr result_2_fr1 (CALL m_msg,p_string get_first (jsr get_char chk_first ;check for constants e pi(") or restore or undo command (cmp #"-" (bne $010 ;leading minus sign ok (jsr clear_n_showit ;puts uperator number in table ( (ldx #00 (stx string_index (stx save_op (stx save_op_num (dex (stx dp_cnt ;initialize these to ff so one inc -> 0 (stx e_cnt ( (CALL m_msg0,p_gn_msg  (jsr result_2_fr1 (jsr (bpl gnum_1 ;---------------------------------------------------- get_num ;accept char input for proper number 0;terminated by an operator 0;result is fr1 << number 0; save_op << operator char ( ; save_op_num << ocond number for binary ops (moveb save_op,next_op (jsr handle_op2 (movenum fr1,fr2 ;set up two operands for binop (jsr result_2_fr1 gnum_2a jsr do_the_op (jsr fr1_2_result (bit op_pend_flag (bmi gnum_1a 00,op_pend_flag (jsr fr1_2_result (moveb save_op,curr_op (moveb save_op_num,curr_op_num ( (tax ;check for binary op (lda bin_op_tbl,x (cmp #02 (bne gnum_2a gnum_2 (jsr get_num ;se FR1 .equ 09C ;FLOATING POINT FR2 .equ 0B0 ; MATH REGISTERS RETAD .equ 0BC ;RETURN ADDRESS CHRAD .equ 0BE ;CHARACTER ADDRESS do_it gnum_1 jsr get_num ;num--> fr1, op--> save_op  gnum_1a moveb #rts   beep_n_back  lda #07 ;beep (jsr put_char (lda #08 ;backup (jsr put_char (lda #20 (jsr put_char (lda #08 (jsr put_char (rts  clear_display (CALL m_msg0,p_gn_msg (lda #1f (jsr put_char ;clear to end of line (rts   put_string (ldy string_index (sta string,y (iny (sty string_index (rts handle_op2 ;set op pending flag for second op which @;is a binary op (l ;cntl-Z is Zero 0.byte 00d ;cr does add 0.ascii "Ll" ;LOG, LN 0.byte 013 ;cntl-S is memStore 0.ascii "e" ;e is antilog (EXP) 0.ascii "sct" .word get_num_msg max_ops .byte 13 op_table .byte 00 ;null op does eq 0.ascii "+-*/^=" 0.byte 011 ;cntl-Q is QUIT 0.byte 018 ;cntl-X is eXit 0.byte 01a sv_xb_r6 .byte 00 sv_xb_r10 .byte 00 sv_1a80 .block 40,0 ;x'80-BF  save_op .byte 00 save_op_num .byte 00 string_index .byte 00 get_num_msg .ascii "CALC >> " 0.byte 0ff  p_gn_msg0 0inc zp_key_data+1 0 $005 lda string,x ;2.10 0sta @zp_key_data,y 0dey 0dex 0bpl $005 0dec zp_key_data+1 $090 rts 0 0 ; ; LOCAL DATA AREAS ; macro_len .byte 00 value 0 0and #7f 0tax 0 ;1D is offset into macro table of the = key @;we will bump ptr up one page then use @;the 0D * 10 (macro entry len) = D0 as a @;ptr to the base of the = entry 0clc 0lda #0d0 0adc macro_len 0tay 0 0bcs $090 0 lda actual_len 0cmp #011 0bcc $002 0lda #010 0 $002 sta macro_len ora #080 0ldy #1d ;offset to = key macro 0sta @zp_on_flags,y ;set the flag 0bne $020 0lda #01 0sta actual_len 0bne $002 0 $020 lda save_the_exp+1 ;don't load macro if the 0and #7f ;result is > e15 or < e-15 0bne $090 0lda save_the_exp 0cmp #1(rts save_123 .byte 00,00,00 rest_123_macs  ldy #02 $005 lda save_123,y (sta @zp_on_1_flag,y (dey (bpl $005 (rts  set_macro 0lda fr1 ;2.11 check for "0" 0ora fr1+1 80,y (sta 1a80,y (dey (bpl $005 ( (moveb sv_xb_r6,xb_r6 (moveb sv_xb_r10,xb_r10 (rts  save_123_macs (ldx #00 (ldy #02 $005 lda @zp_on_1_flag,y (sta save_123,y (txa (sta @zp_on_1_flag,y (dey (bpl $005 005 lda 1a80,y (sta sv_1a80,y (dey (bpl $005 ( (lda 0ffef (sta xb_r6 (sta xb_r10 (jsr save_123_macs  (CALL m_msg,p_help_msg (rts  wrap_up (jsr rest_123_macs (ldy #3f $005 lda sv_1ado_pct_fn jsr SYSDMUL 0movenum N100,fr2 0jmp SYSDDIV  ;---------------------- init and wrap stuff ------------------------  my_init (moveb #00,err_number  moveb xb_r6,sv_xb_r6 (moveb xb_r10,sv_xb_r10  (ldy #3f $ do_zero lda #00 0sta result 0sta result+1 0sta sout_exp 0sta sout_exp+1 0pla 0pla 0jmp do_it 0 do_memstore movenum fr1,mem_reg 0rts do_deg_fn movenum k_pi_div_180,fr2 0jmp SYSDMUL  get_char CALL m_get_char 0and #7f 0rts put_char CALL m_put_char 0rts do_exit jsr set_macro ;save number string in + macro H;unless "E" format  do_quit pla 0pla do_null do_eq rts dx save_op_num (lda bin_op_tbl,x (cmp #02 (bne $090 (moveb #80,op_pend_flag (moveb next_op,save_op $090 rts (  do_the_op (lda curr_op_num (asl a (tay (lda opfn_tbl+1,y (pha (lda opfn_tbl,y (pha (rts ( ;SIN COS TAN 0.ascii "d%" ;DEG PCT 0 binop_tbl .byte 01 0.byte 02,02,02,02,02,01 0.byte 01 0.byte 01 0.byte 01 0.byte 02 0.byte 01,01 0.byte 01 0.byte 01 0.byte 01,01,01 0.byte 01,02   opfn_tbl .word do_null-1 0.word SYSDADD-1 0.word SYSDSUB-1 0.word SYSDMUL-1 0.word SYSDDIV-1 0.word SYSDPWR-1 0.word do_eq-1 0.word do_quit-1 0.word do_exit-1 0.word do_zero-1 0.word SYSDADD-1 y_string (.if test (.ascii "adj display" (.endc  adj_display (moveb char,actual_len ;2.10 ( ;2.12 dec actual_len ( (lda err_number ;do error check here (beq $002 (moveb #"*",s.block numlen,00  exp_sgn_flag .byte 00 ;contains sout_exp+1  my_exp .word 0000 save_the_exp .word 0000 my_len .byte 00 actual_len .byte 00  my_string .block 20,0ff p_my_string .word mcurr_op .byte 00 curr_op_num .byte 00 next_op .byte 00  op_pend_flag .byte 00 (.if test (.ascii "-------undo---------" (.endc ( save_undo .block numlen,00 mem_reg .block numlen,00  result D0,0BC,0BB,0F7,0F9,0B3,0F5 .byte 080,008,06C,029,018,0DD,06D,093,089,009,06D .byte 080,00A,089,042,0CA,0A5,0A1,0D0,09F,0AD,046 .byte 080,009,032,01B,012,0FA,0AC,077,028,024,052 p_sysp3 .word sysp3-2000 q4-2000  sysP2 .byte 080,006,072,074,006,0FC,0F4,005,018,098,019 .byte 080,00F,06C,09B,03D,054,014,0E1,0AD,008,052 .byte 080,015,07D,0F0,0D8,04A,0C3,0A3,05F,0AF,08A p_sysp2 .word sysp2-2000  sysP3 .byte 080,005,0C4,067,000,000 .byte 080,006,08E,01A,0E1,092,032,09C,060,03A,0DE .byte 080,008,041,0C1,083,09F,007,0F5,07E,002,0AB .byte 080,009,0A6,0F1,0F8,07A,013,0E4,07B,0DA,0E9 .byte 080,008,032,01B,012,0FA,0AC,077,028,024,05E p_q4 .word .byte 080,00B,05A,0A7,010,08B,038,07B,077,06F,021 .byte 080,013,020,003,0B1,082,09B,07B,0E8,05C,0C8 .byte 080,017,037,02D,0F8,014,0E7,009,083,07E,006 p_q3 .word q3-2000  Q4 .byte 080,001,000,000,000,000,000,000,000,0,000,000,000,000,000,000 NI2 .byte 080,000,000,000,000,000,000,000,000,000,000  ; N1 .byte 080,001,000,000,000,000,000,000,000,000,000 N1 Q3 .byte 080,001,000,000,000,000,000,000,000,000,000 01,035,004,0F3,033,0F9,0DE,064,084,059 ILN2 .byte 080,001,038,0AA,03B,029,05C,017,0F0,0BB,0BF LN2 .byte 080,000,031,072,017,0F7,0D1,0CF,079,0AB,0CA MN .byte 080,010,000,000,000,000,000,000,000,000,000 N10 .byte 080,004,020,000,000 07f,0fb,00e,0fa,035,012,094,0e9,0c7,009,067 N100 .byte 080,007,048,000,000,000,000,000,000,000,000  ILN10 .byte 07F,0FF,05E,05B,0D8,0A9,037,028,071,095,035 LN10 .byte 080,002,013,05D,08D,0DD,0AA,0A8,0AC,016,0EA SQR2 .byte 080,0STRING .block 20,0ff ;OUTPUT STRING p_STRING .word string adj_p_string .word string-2000 ; ; INTERNAL CONSTANTS ; ; const_e .byte 080,002,02d,0f8,054,058,0a2,0bb,04a,09a,0af k_pi_div_180 .byte ngth  LY .byte 000 DP .byte 000 ESIGN .byte 000 MSIGN .byte 000 CHAR .byte 00 ;DISP IN STRING LCNT .byte 00 ;LOOP COUNTER numlen,00 Z .equ * FX .block numlen,00 W .equ * FX2 .block numlen,00 Q .block numlen,00 MANT .block numlen,00  EXP .block 0f,00 ;check length TR1 .block 10,00 ;check le ;cr=add 0.word SYSDLOG-1 0.word SYSDLNX-1  .word do_memstore-1 0.word SYSDEXP-1 0.word SYSDSIN-1 0.word SYSDCOS-1 0.word SYSDTAN-1  .word do_deg_fn-1 0.word do_pct_fn-1 0 0 pol_fx .block tring (moveb #0ff,string+1 (lda #07 (jsr put_char (lda #00 (sta result (sta result+1 (sta err_number (rts $002 ' movew sout_exp,my_exp ;*** DA save for later display chk (movew sout_exp,save_the_exp (jsr chk_adj (bcs $090 (jsr do_adj (ldx #0ff $005 inx (lda my_string,x (sta string,x (cmp #0ff (bne $005 (pla (pla $090 rts  chk_adj sec ;return cset=no adj, cclr=do adj (lda my_ex 1 2 5 3\ 4 6 7 8 9 10 Y Ymm)(O^99 .ascii "^B)ack ^S)tore ^R)ecall c)os s)in t)an %)pct +-/*^" .byte 0d,01f,0ff  p_help_msg .word help_msg 0.include CALC.SCT 0.INCLUDE CALC.1 0.INCLUDE CALC.2 0 end 0.END  #20 (bne $005 (sta string,x ;bump space right to flag next 0 $005 rts help_msg  .byte 01a,000,013,01f,0d  .ascii "^Z)ero ^C)lear ^X)exit ^Q)uit l)nx L)og e)xp d)eg adds" .byte 0d,01f my_string,y ( ;2.12 dey (sty actual_len rts_xx rts build_string sta my_string,y 0iny 0dec my_len 0rts 0 get_nxt_num (lda string,x (inx (cmp #"." (beq get_nxt_num (cmp 05 dec my_exp (beq $010  jsr build_string (bne $005 $010 jsr get_nxt_num (cmp #20 (beq adj_out ;2.11, was beq rts_xx (jsr build_string (bne $010 adj_out (lda #0ff (sta $008 jsr build_string jsr get_nxt_num (cmp #20 (bne $008 (jmp adj_out adj_neg ;convert 1.23456 E-3 0;to .00123456 0; 0;also 1 E-2 0;to .01 (lda #"." (jsr build_string (lda #"0" $0os ;convert 1.23456 E3 0;to 1234.56 0; 0;also 1.2 E4 0;to 12000. $005 jsr get_nxt_num (cmp #20 (bne $007 (lda #"0" $007 jsr build_string (dec my_exp (bpl $005 (lda #"." ;index to old string (tay ;index to my new string ( (lda string ;check for leading minus sign (cmp #"-" (bne $090 (inx (iny (sta my_string ( $090 bit exp_sgn_flag (bmi adj_neg ( adj_pp+1 ;check for exp > 15 or exp < -15 (and #7f (bne $090 (lda my_exp (beq $090 ;no adj for exp=0 (cmp #10 ;cc if exp<16 $090 rts (  do_adj moveb #10,my_len (lda #00 (tax LDA FR1+1 CMP EPS+1 BGE cos_PE1 cos_SG2 movenum HALFPI,FR2 ;MAP TO RADIANS JSR SYSDMUL JMP cos_SS1 ; ; POLYNOMIAL EXPANSION ; cos_PE1 movenum FR1,FR2 ;N = FR1 +movenum FR1,N JSR SYSDM;FR1=2-FR1 LDA FR1+2 ORA #080 STA FR1+2 JSR SYSDADD ; ; DONE IF FR1 < EPS (SMALL ANGLE ; APPROXIMATION ; cos_SG1 LDA FR1 ;CHECK SIZE CMP EPS BLT cos_SG2 BNE cos_PE1 R1+2 JSR SYSDADD LDA cos_SGN EOR #080 STA cos_SGN cos_RR10 LDA FR1 ;QUIT IF < .5 BPL cos_SG1 LDA FR1+1 ;BRANCH IF < 1 BEQ cos_SG1 movenum N2,FR2 ;QUIT IF < .5 BPL cos_SG1 LDA FR1+1 ;BRANCH IF < 2 CMP #02 BLT cos_RR10 movenum N4,FR2 ;FR1 = 4-FR1, LDA FR1+2 ;SGN = -SGN ORA #080 STA F BMI cos_RTS cos_RR7 LDA FR1+2 BMI cos_RR8 JSR SYSDROL JMP cos_RR7 cos_RR8 LDA FR1+2 ;RESTORE SIGN AND #07F STA FR1+2 ; ; REDUCE RANGE FROM [0,4] TO [0,1] ; cos_RR9 LDA FR1 BLT cos_RR6 cos_RR5 JSR SYSDROL ;REMOVE INTEGER JMP cos_RR4 cos_RR6 LDX #15. ;NORMALIZE cos_RR6A LDA FR1+2,X BNE cos_RR7 DBPL X,cos_RR6A STA FR1 STA FR1+1 cos_RR4 LDA FR1 ;USE EXTENDED RESULT TO BPL cos_RR6 ;MAINTAIN PRECISION CMP #080 ;WHILE REMOVING MULTIPLES BNE cos_RR5 ;OF 2*PI LDA FR1+1 CMP #03 ;CHECK SIZE cos_RR1 LDA FR1,X CMP MAX,X BLT cos_RR3 BNE cos_RR2 INX CPX #10. BNE cos_RR1 cos_RR2 FERR #1 cos_RTS RTS cos_RR3 movenum IHPI,FR2 ;FR1=FR1*2/PI JSR SYSDMUL 8; REMOVE MULTIPLES OF 2*PI, MAPPING THE 8; UNIT CIRCLE FROM [0,2*PI] TO [0,4] 8; SYSDSIN LDA FR1+2 ;REMOVE AND SAVE SIGN AND #080 STA cos_SGN LDA FR1+2 ORA #080 STA FR1+2 LDX #0 3346 FROM HART. * ;* * ;**************************************** ;* SYSDCOS ; CHANGE ARGUMENT: COS(X) = SIN(X+PI/2) 'movenum HALFPI,FR2 JSR SYSDADD 8; PUTS: * ;* FR1 - RESULT * ;* * ;* NOTES: * ;* 1) ALGORITHM DEVELOPED FROM * ;* CODY, PP 125-149. TABLE * ;* COPYRIGHT (C) JANUARY 1983 * ;* BY HAYDEN BOOK COMPANY, INC. * ;* * ;* INPUTS: * ;* FR1 - ARGUMENT * ;* * ;* OUT ;**************************************** ;* * ;* SYSDCOS - COS(X) * ;* SYSDSIN - SIN(X) * ;* * ;* BY MIKE WESTERFIELD * ;* UL ;FR1 = N^2 LA R6,P09 ;FR1 = P(N^2)*N LM R8,#9 JSR SYSDPOL movenum N,FR2 JSR SYSDMUL ; ; SET SIGN ; cos_SS1 LDA cos_SGN EOR FR1+2 STA FR1+2 RTS ;**************************************** ;* * ;* SYSDTAN - TAN (X) * ;* * ;* BY MIKE WESTERFIELD * ;* COPYRIGHT (C) JANUARY 1983 * ;* BY HAYDEN LDA FR1+2 EOR #080 STA FR1+2 movenum TR1,FR2. JSR SYSDADD ; ; EVALUATE FR1=FR1*P(FR1)+ATNX1 ; EF1 movenum FR1,FR2 'movenum FR1,TR1 JSR SYSDMUL LA R6,P7 LM R8,#7 JSR SYD LDX #10. RR4 LDA FR1,X STA TR2,X LDA TR1,X STA FR1,X STA FR2,X DBPL X,RR4 JSR SYSDMUL movenum N1,FR2 JSR SYSDADD movenum TR2,FR2 JSR SYSDDIV LDA #LX2-22. ADC #0 STA R5 LDY #10 RR3 LDA @R0,Y STA ATNX1,Y LDA @R4,Y STA FR2,Y STA TR1,Y DBPL Y,RR3 JSR SYSDAD ;IF I=1 THEN BNE RR2 LA ATNX1,0 ;ATNX1=0 JEQ EF1 RR2 CLC ;ELSE LDA #ATNX-22. STA R1 CLC CMP #11. BGE BS1 ; ; REDUCE RANGE ; JSR CPF ;WHICH SIDE? BGE RR1 ADD R0,#11. RR1 SEC ;COMPUTE DISPLACEMENT LDA R0 SBC # fr1, op--> save_op $005 moveb #00,op_pend_flag (movenum fr1,result (moveb save_op,curr_op (moveb save_op_num,curr_op_num ( (tax ;check f( (moveb sv_xb_r6,xb_r6 (moveb sv_xb_r10,xb_r10 (rts  05 lda 1a00,y (sta sv_1a00,y (iny (bne $005  rts  sv_xb_r6 .byte 00 sv_xb_r10 .byte 00 sv_1a00 .block 100,0  wrap_up (ldy #00 $005 lda sv_1a00,y (sta 1a00,y (iny (bne $005 result ;---------------------- init and wrap stuff ------------------------  my_init (jsr save_all (lda 0ffef (sta xb_r6 (sta xb_r10 (rts save_all  moveb xb_r6,sv_xb_r6 (moveb xb_r10,sv_xb_r10  (ldy #00 $0_mul-1 0.word do_div-1 0.word do_pwr-1 0.word do_eq-1  do_add jmp SYSDADD do_sub jmp SYSDSUB do_mul jmp SYSDMUL do_div jmp SYSDDIV do_pwr jmp SYSDPWR do_eq jmp show_get_num_msg .ascii "Enter >> " 0.byte 0ff  p_gn_msg .word get_num_msg max_ops .byte 05 op_table .ascii "+-*/^=" binop_tbl .byte 02,02,02,02,02,01 opfn_tbl .word do_add-1 0.word do_sub-1 0.word doar 0and #7f 0rts put_char CALL m_put_char 0rts  save_op .byte 00 save_op_num .byte 00 string_index .byte 00 string .block 40,0 p_string .word string ; ??? -2000 sr put_char (jmp $002  $025 ;is an op (stx save_op_num (sta save_op ( (ldy p_string (lda p_string+1 (jsr SYSDPIN ;convert string to FR1 number (rts  get_char CALL m_get_chring,y (iny (sty string_index (bne $002 ;always  $020 ;char is not ok for number (ldx max_ops $022 cmp op_table,x (beq $025 (dex (bpl $022  lda #07 ;beep (j(jsr SYSNMID ;checks for 0-9 (bcs $010 (cmp #"E" (beq $010 (cmp #"e" (beq $010 (cmp #"." (bne $020 $010 ;char is ok for number (jsr put_char (ldy string_index (sta str in table (lda #30 ;set the string to a "0" for possible (sta string ;entry of an operator only here (lda #0d ; (sta string+1 ; ( (CALL m_msg0,p_gn_msg ( $002 jsr get_char ( result (movenum result,fr1 (jsr SYSDPOUT (rts  ( get_num ;accept char input for proper number 0;terminated by an operator 0;result is fr1 << number 0; save_op << operator char ( ; save_op_num << operator numbeave_op_num (lda bin_op_tbl,x (cmp #02 (bne $090 (moveb #80,op_pend_flag (moveb next_op,save_op $090 rts (  do_the_op (lda curr_op_num (asl a (tay (lda opfn_tbl+1,y (pha (lda opfn_tbl,y (pha (rts (  show_(movenum result,fr1  $010 jsr do_the_op (movenum fr1,result (jsr show_result (bit op_pend_flag (bmi $005 (jmp main_loop ( handle_op2 ;set op pending flag for second op which @;is a binary op (ldx sor binary op (lda bin_op_tbl,x (cmp #02 (bne $010 ( (jsr get_num ;second number for binary ops (moveb save_op,next_op (jsr handle_op2 (movenum fr1,fr2 ;set up two operands for binop BLT sct_RR3 BNE sct_RR2 INX CPX #3. BNE sct_RR1 sct_RR2 FERR #1 sct_RTS RTS sct_RR3 movenum IHPI,FR2 ;FR1=FR1*2/PI JSR SYSDMUL sct_RR4 LDA FR1 ;USE EXTENDED RESULT TO ascii "SYSDSIN" (.endc  SYSDSIN LDA FR1+2 ;REMOVE AND SAVE SIGN AND #080 STA sct_SGN LDA FR1+2 ORA #080 STA FR1+2 LDX #0 ;CHECK SIZE sct_RR1 LDA FR1,X CMP MAX,X (.ascii "SYSDCOS" (.endc ( SYSDCOS ; CHANGE ARGUMENT: COS(X) = SIN(X+PI/2) 'movenum HALFPI,FR2 JSR SYSDADD 8; 8; REMOVE MULTIPLES OF 2*PI, MAPPING THE 8; UNIT CIRCLE FROM [0,2*PI] TO [0,4] 8; (.if test (. * ;* 1) ALGORITHM DEVELOPED FROM * ;* CODY, PP 125-149. TABLE * ;* 3346 FROM HART. * ;* * ;**************************************** ;* (.if test * ;* FR1 - ARGUMENT * ;* * ;* OUTPUTS: * ;* FR1 - RESULT * ;* * ;* NOTES: SIN(X) * ;* * ;* BY MIKE WESTERFIELD * ;* COPYRIGHT (C) JANUARY 1983 * ;* BY HAYDEN BOOK COMPANY, INC. * ;* * ;* INPUTS: ; ; could save a few bytes by replacing the refs to N2 and N4 by N1's with ; appropriate incs of the dest reg+1 ; ;**************************************** ;* * ;* SYSDCOS - COS(X) * ;* SYSDSIN -  1 2 5 3\ 4 6 7 8 9 10 VV::AO^9Y BPL sct_RR6 ;MAINTAIN PRECISION CMP #080 ;WHILE REMOVING MULTIPLES BNE sct_RR5 ;OF 2*PI LDA FR1+1 CMP #03 BLT sct_RR6 sct_RR5 JSR SYSDROL ;REMOVE INTEGER JMP sct_RR4 sct_RR6 LDX #15. ;NORMALIZE sct_RR6A LDA FR1+2,X BNE sct_RR7 DBPL X,sct_RR6A STA FR1 STA FR1+1 BMI sct_RTS sct_RR7 08B,062,0C5 '.byte 07F,0FD,023,035,0E3,03B,0AD,057,00C,078,043 '.byte 080,000,0A5,05D,0E7,031,02D,0F2,095,0F3,043 '.byte 080,001,049,00F,0DA,0A2,021,068,0C2,034,0C4 p_p09 .word p09-2000  .byte 07F,0E2,0B7,0D6,0A2,01F,046,0D5,09B,007,007 '.byte 07F,0E8,074,07A,019,0BE,047,0CC,088,0FC,059 '.byte 07F,0EE,0F1,083,0A7,0EE,014,04E,0C4,0AE,0BC '.byte 07F,0F4,028,03C,01A,043,0F5,0EF,0DD,064,0D2 '.byte 07F,0F9,099,069,066,073,015,0EA,N2 .byte 080,002,000,000,000,000,000,000,000,000,000 N4 .byte 080,003,000,000,000,000,000,000,000,000,000 EPS .byte 07F,0BC P09 .byte 07F,0D4,0BF,05A,04E,07E,0A8,0C1,029,0FA,0EF '.byte 07F,0DB,055,05D,060,031,011,073,06C,05E,0DB ' numlen,00  ; ; DATA AREAS ; MAX .byte 080,022,0C9 const_PI .byte 080,002,049,00F,0DA,0A2,021,068,0BF,0E5,0C2  HALFPI .byte 080,001,049,00F,0DA,0A2,021,068,0BF,0E5,0C2 IHPI .byte 080,000,022,0F9,083,06E,04E,044,015,029,0FC FR1,X STA TFR2,X LDA TFR1,X STA FR1,X DBPL X,DT1 JSR SYSDSIN movenum TFR2,FR2 JMP SYSDDIV  sct_SGN .byte 00 sct_N .block numlen,00  TFR1 .block numlen,00 TFR2 .block FR2 - RESULT * ;* * ;**************************************** ;* (.if test (.ascii "SYSDTAN" (.endc  SYSDTAN movenum FR1,TFR1 JSR SYSDCOS LDX #10. DT1 LDA ;* BY HAYDEN BOOK COMPANY, INC. * ;* * ;* INPUTS: * ;* FR1 - ARGUMENT * ;* * ;* OUTPUTS: * ;* *********************** ;* * ;* SYSDTAN - TAN (X) * ;* * ;* BY MIKE WESTERFIELD * ;* COPYRIGHT (C) JANUARY 1983 * ;FR1 = N^2 LA R6,P09 ;FR1 = P(N^2)*N LM R8,#9 JSR SYSDPOL movenum sct_N,FR2 JSR SYSDMUL ; ; SET SIGN ; sct_SS1 LDA sct_SGN EOR FR1+2 STA FR1+2 RTS ;*****************1 CMP EPS+1 BGE sct_PE1 sct_SG2 movenum HALFPI,FR2 ;MAP TO RADIANS JSR SYSDMUL JMP sct_SS1 ; ; POLYNOMIAL EXPANSION ; sct_PE1 movenum FR1,FR2 ;N = FR1 +movenum FR1,sct_N JSR SYSDMUL LDA FR1+2 ORA #080 STA FR1+2 JSR SYSDADD ; ; DONE IF FR1 < EPS (SMALL ANGLE ; APPROXIMATION ; sct_SG1 LDA FR1 ;CHECK SIZE CMP EPS BLT sct_SG2 BNE sct_PE1 LDA FR1+ LDA sct_SGN EOR #080 STA sct_SGN sct_RR10 LDA FR1 ;QUIT IF < .5 BPL sct_SG1 LDA FR1+1 ;BRANCH IF < 1 BEQ sct_SG1 movenum N2,FR2 ;FR1=2-FR1 BPL sct_SG1 LDA FR1+1 ;BRANCH IF < 2 CMP #02 BLT sct_RR10 movenum N4,FR2 ;FR1 = 4-FR1, LDA FR1+2 ;SGN = -SGN ORA #080 STA FR1+2 JSR SYSDADD LDA FR1+2 BMI sct_RR8 JSR SYSDROL JMP sct_RR7 sct_RR8 LDA FR1+2 ;RESTORE SIGN AND #07F STA FR1+2 ; ; REDUCE RANGE FROM [0,4] TO [0,1] ; sct_RR9 LDA FR1 ;QUIT IF < .5 1 2 3 4 5 6 SOUT ]9IC ! !`CO^5 numlen .equ 0b ;double precision = 11 bytes/number rest_mem .equ 012 ;cntl-r clr_entry .equ 003 ;cntl-c pi .equ 022 ;quote ; e .equ 065 s, etc. ; 2.02 remove put_char and add back cursor to error char beep ; 2.01 initial version with full impl. ; 2.00 initial testing version ; ;------------------------------------------------------------------ test .equ 0 ered cntl chars out on first char typed ; 2.05 added my_display to SYSDOUT to handle non-E numbers ; 2.04 fixed re-show of first char typed ; 2.03 added Clr, ce and cr=add handlers, fixed chained ops handler ; and unified display of resultantilog) ; clear out supermacros on entry and restore at exit ; added logic to get_num to check for double E.- chars ; also allows leading - sign ; ; 2.06 set getnum to default to prev result for no num entry ; and filt; added simple error trap to display * (beep) and zero result ; added undo (cntl-U) command ; changed clears to cntl-Z = zero and cntl-C = clear ; added dummy pi and e constants ; added EXP function with cntl-L (for changed entry command to (K)alc ; added memory register with save/restore (cntl-S,R) ; no longer clearing screen on entry ; loading result on eXit into = macro unless too big ; no loading of = macro if Quit used changed string store locs from x'30 to x'20 bytes ; change undo to backup ; remove e const, change e to exp fn ; added Help line display ; added deg and %pct functions ; 2.07 added SIN COS TAN functions ; orage in macro correctly ; fix to handle incorrect re-display for 0>x>.01 ; and .01 display as .01. ; ; 2.10 fixes for - neg nums and macro loading for E1 numbers ; ; 2.09 fixes for 2.08 ; 2.08 fixes for 2.07 ; 0.PROC CALC,0 ;------------------------------------------------------------------ ; ; calc 2.12 9/05/86 ; ; 2.12 want fix for macro 1.23 from 1.234 ; want fix for Zero command after 123 -> 023 ; 2.11 fix to handle "0" value st ;e  undo_cmd .equ 002 ;cntl-u  start (jmp entry (.ascii "K" (.word start-1 (.word end-start (.ascii "QuikCalc"  (.INCLUDE CALC.MAC (.include pkymacs (.include callmacs (.include zpcommon  entry jsr my_init 0jsr do_it 0jsr wrap_up 0rts  ; COMMON DATA R0 .equ 080 ;GENERAL PURPOSE R1 .equ 081 ;REGISTERS R2 .equ 082 R3 .equ 083 R4 .equ 084 R5 .equ 085 R6 .equ 086 jsr put_string ;add char to string (jmp get_one  chk_for_op ;char is not ok for number (ldx max_ops $010 cmp op_table,x (beq is_an_op (dex (bpl $010 (jsr beep_n_back (jmp (beq char_is_ok (jmp beep_n_back alpha_cnt .byte 01 alpha_tbl .ascii "E." alpha_f_tbl e_cnt .byte 0ff dp_cnt .byte 0ff char_is_ok ;char is ok for number (bne chk_num (jmp get_num ( chk_num jsr SYSNMID ;checks for 0-9 (bcs char_is_ok ( chk_alpha (ldx alpha_cnt $005 cmp alpha_tbl,x (beq $010 (dex (bpl $005 (bmi chk_for_op $010 inc alpha_f_tbl,x  #020 (bcs $010 ;don't display cntl chars 2.10 (lda #020 ;show a dummy space instead 2.10 $010 jsr put_char (pla $090 rts ( ( get_one jsr get_char (cmp #clr_entry ;cntl-c is clear-entry... (rts  $030 cmp #undo_cmd ;cntl-u (bne $040 (movenum save_undo,fr1 (rts $040 jsr clear_n_showit ;2.10 (jmp chk_num clear_n_showit (pha (jsr clear_display pla (pha (cmp p the "-" 2.10 (jmp char_is_ok ;does put_string & jmp to get_one 2.10 ( $010 cmp #pi (bne $020 (movenum const_pi,fr1 (rts $020 cmp #rest_mem ;cntl-r (bne $030 (movenum mem_reg,fr1 SYSDOUT (jsr result_2_fr1 (CALL m_msg,p_string get_first (jsr get_char chk_first ;check for constants e pi(") or restore or undo command (cmp #"-" (bne $010 ;leading minus sign ok (jsr clear_n_showit ;puts uperator number in table ( (ldx #00 (stx string_index (stx save_op (stx save_op_num (dex (stx dp_cnt ;initialize these to ff so one inc -> 0 (stx e_cnt ( (CALL m_msg0,p_gn_msg  (jsr result_2_fr1 (jsr (bpl gnum_1 ;---------------------------------------------------- get_num ;accept char input for proper number 0;terminated by an operator 0;result is fr1 << number 0; save_op << operator char ( ; save_op_num << ocond number for binary ops (moveb save_op,next_op (jsr handle_op2 (movenum fr1,fr2 ;set up two operands for binop (jsr result_2_fr1 gnum_2a jsr do_the_op (jsr fr1_2_result (bit op_pend_flag (bmi gnum_1a 00,op_pend_flag (jsr fr1_2_result (moveb save_op,curr_op (moveb save_op_num,curr_op_num ( (tax ;check for binary op (lda bin_op_tbl,x (cmp #02 (bne gnum_2a gnum_2 (jsr get_num ;se FR1 .equ 09C ;FLOATING POINT FR2 .equ 0B0 ; MATH REGISTERS RETAD .equ 0BC ;RETURN ADDRESS CHRAD .equ 0BE ;CHARACTER ADDRESS do_it gnum_1 jsr get_num ;num--> fr1, op--> save_op  gnum_1a moveb #M1H .equ 091 ;MATH REGISTERS M2L .equ 092 M2H .equ 093 M3L .equ 094 M3H .equ 095 SIGN .equ 096 ERR_number .equ 097 ;FLOATING POINT ERROR # AD1 .equ 098 ;FP AND DP OPERAND RAD .equ 09A ; LOAD REGISTERS R7 .equ 087 R8 .equ 088 R9 .equ 089 R10 .equ 08A R11 .equ 08B R12 .equ 08C R13 .equ 08D R14 .equ 08E R15 .equ 08F xb_r6 .equ 1687 xb_r10 .equ 168b   M1L .equ 090 ;TWO BYTE INTEGER get_one  is_an_op ;is an op (stx save_op_num (sta save_op (lda string_index (beq $090 ;leave old string there if no new nmbr (lda #0ff (jsr put_string $090 ldy adj_p_string (lda adj_p_string+1 (jsr SYSDPIN ;convert string to FR1 number ( (rts fr1_2_result (ldx #numlen-1 $005 lda result,x (sta save_undo,x (lda fr1,x (sta result,x (dex (bpl $005 (rts  result_2_fr1 (movenum result,fr1 (sv_xb_r6 .byte 00 sv_xb_r10 .byte 00 sv_1a80 .block 40,0 ;x'80-BF  save_op .byte 00 save_op_num .byte 00 string_index .byte 00 get_num_msg .ascii "CALC >> " 0.byte 0ff  p_gn_msg0 0inc zp_key_data+1 0 $005 lda string,x ;2.10 0sta @zp_key_data,y 0dey 0dex 0bpl $005 0dec zp_key_data+1 $090 rts 0 0 ; ; LOCAL DATA AREAS ; macro_len .byte 00 value 0 0and #7f 0tax 0 ;1D is offset into macro table of the = key @;we will bump ptr up one page then use @;the 0D * 10 (macro entry len) = D0 as a @;ptr to the base of the = entry 0clc 0lda #0d0 0adc macro_len 0tay 0 0bcs $090 0 lda actual_len 0cmp #011 0bcc $002 0lda #010 0 $002 sta macro_len ora #080 0ldy #1d ;offset to = key macro 0sta @zp_on_flags,y ;set the flag 0bne $020 0lda #01 0sta actual_len 0bne $002 0 $020 lda save_the_exp+1 ;don't load macro if the 0and #7f ;result is > e15 or < e-15 0bne $090 0lda save_the_exp 0cmp #1(rts save_123 .byte 00,00,00 rest_123_macs  ldy #02 $005 lda save_123,y (sta @zp_on_1_flag,y (dey (bpl $005 (rts  set_macro 0lda fr1 ;2.11 check for "0" 0ora fr1+1 80,y (sta 1a80,y (dey (bpl $005 ( (moveb sv_xb_r6,xb_r6 (moveb sv_xb_r10,xb_r10 (rts  save_123_macs (ldx #00 (ldy #02 $005 lda @zp_on_1_flag,y (sta save_123,y (txa (sta @zp_on_1_flag,y (dey (bpl $005 005 lda 1a80,y (sta sv_1a80,y (dey (bpl $005 ( (lda 0ffef (sta xb_r6 (sta xb_r10 (jsr save_123_macs  (CALL m_msg,p_help_msg (rts  wrap_up (jsr rest_123_macs (ldy #3f $005 lda sv_1ado_pct_fn jsr SYSDMUL 0movenum N100,fr2 0jmp SYSDDIV  ;---------------------- init and wrap stuff ------------------------  my_init (moveb #00,err_number  moveb xb_r6,sv_xb_r6 (moveb xb_r10,sv_xb_r10  (ldy #3f $ do_zero lda #00 0sta result 0sta result+1 0sta sout_exp 0sta sout_exp+1 0pla 0pla 0jmp do_it 0 do_memstore movenum fr1,mem_reg 0rts do_deg_fn movenum k_pi_div_180,fr2 0jmp SYSDMUL  get_char CALL m_get_char 0and #7f 0rts put_char CALL m_put_char 0rts do_exit jsr set_macro ;save number string in + macro H;unless "E" format  do_quit pla 0pla do_null do_eq rts dx save_op_num (lda bin_op_tbl,x (cmp #02 (bne $090 (moveb #80,op_pend_flag (moveb next_op,save_op $090 rts (  do_the_op (lda curr_op_num (asl a (tay (lda opfn_tbl+1,y (pha (lda opfn_tbl,y (pha (rts ( (lda #1f (jsr put_char ;clear to end of line (rts   put_string (ldy string_index (sta string,y (iny (sty string_index (rts handle_op2 ;set op pending flag for second op which @;is a binary op (lrts   beep_n_back  lda #07 ;beep (jsr put_char (lda #08 ;backup (jsr put_char (lda #20 (jsr put_char (lda #08 (jsr put_char (rts  clear_display (CALL m_msg0,p_gn_msg .word get_num_msg max_ops .byte 13 op_table .byte 00 ;null op does eq 0.ascii "+-*/^=" 0.byte 011 ;cntl-Q is QUIT 0.byte 018 ;cntl-X is eXit 0.byte 01a