WebSVN – MB01 Project – Blame – /trunk/sources/lst/FE/float.lst

Rev	Author	Line No.	Line
1	-	1	Tue Jul 17 11:00:22 2018 Page 1
		2
		3
		4
		5
		6
		7
		8
		9	2500 A.D. 65816 Macro Assembler #26960 - Version 5.02g
		10	-----------------------------------------------------
		11
		12	Input Filename : src\FE\float.asm
		13	Output Filename : obj\FE\float.obj
		14	Listing Has Been Relocated
		15
		16
		17	2585 .LIST on
		18	2586
		19	2587 ;.INCLUDE inc\dirp01.inc
		20	2588 F8FFB1 .INCLUDE inc\dpcbm.inc
		21	2589 ;; cbm emulation
		22	2590
		23	2591 ;;CBMP0 .EQU $7F00
		24	2592
		25	2593 ; sezione COMMON -- questo permette di includere il file in piu' file
		26	2594
		27	2595 DPCBM: .SECTION page0, ref_only, common
		28	2596
		29	2597 000000 .ABSOLUTE ;; inizia sempre da $00
		30	2598 000000 .ORG 0x00
		31	2599
		32	2600 ;;MAXLF .EQU $10 ; max. logical files
		33	2601 00000B MAXLF .EQU 11 ; max. logical files
		34	2602 000008 MAXVIEC .EQU 8 ; max. virtual iec device #
		35	2603 000000 .DS 16
		36	2604 000010
		37	2605 000010 00 subflg .DB ; ($10)
		38	2606 000011 00 .DB ; ($11)
		39	2607 000012 00 .DB ; ($12)
		40	2608 000013 00 .DB ; ($13)
		41	2609 000014 0000 lineno .DW ; ($14-$15) line number used by editor
		42	2610 000016 00 tmppt .DB ; ($16)
		43	2611 000017 00 tcnt .DB ; ($17) temp. counter/index
		44	2612 000018 0000 .DW ; ($18-$19)
		45	2613 00001A 0000 .DW ; ($1A-$1B)
		46	2614 00001C 0000 .DW ; ($1C-$1D)
		47	2615 00001E 0000 .DW ; ($1E-$1F)
		48	2616 000020 00 .DB ; ($20)
		49	2617
		50	2618 ; basic/p-code virtual machine work area
		51	2619 000021 0000 .DW ; ($21-$22)
		52	2620 000023 0000 .DW ; ($23-$24)
		53	2621 000025 0000 .DW ; ($25-$26)
		54	2622 000027 0000 .DW ; ($27-$28)
		55	2623 000029 0000 .DW ; ($29-$2A)
		56	2624 00002B 0000 .DW ; ($2B-$2C)
		57	2625 00002D 0000 .DW ; ($2D-$2E)
		58	2626 00002F 0000 arytab .DW ; ($2F-$30)
		59	2627 000031 0000 strend .DW ; ($31-$32)
		60	2628 000033 0000 freetop .DW ; ($33-$34)
		61	2629 000035 0000 freespc .DW ; ($35-$36)
		62	2630 000037 0000 memsiz .DW ; ($37-$38)
		63	Tue Jul 17 11:00:22 2018 Page 2
		64
		65
		66
		67
		68	2631 000039 0000 curline .DW ; ($39-$3A) current line number in execution
		69	2632 00003B 0000 oldline .DW ; ($3B-$3C) previous line number in execution
		70	2633 00003D 0000 oldtxt .DW ; ($3D-$3E) saved pointer to text in basic execution
		71	2634 00003F 0000 datlin .DW ; ($3F-$40)
		72	2635 000041 0000 datptr .DW ; ($41-$42)
		73	2636 000043 0000 inpptr .DW ; ($43-$44)
		74	2637 000045 0000 varnam .DW ; ($45-$46)
		75	2638 000047 0000 varpnt .DW ; ($47-$48)
		76	2639 000049 0000 forpnt .DW ; ($49-$4A) basic
		77	2640 00004B 0000 opptr .DW ; ($4B-$4C) basic
		78	2641 00004D 00 opmask .DB ; ($4D)
		79	2642 00004E 0000 defpnt .DW ; ($4E-$4F)
		80	2643 000050 0000 dscpnt .DW ; ($50-$51)
		81	2644 000052 00 dsclen .DB ; ($52)
		82	2645 000053 00 prompt .DB ; ($53) prompt flag/CMD channel - editor/basic ($13)
		83	2646
		84	2647 ; equates for p-code virtual machine
		85	2648 00003B prtrap .EQU oldline ; ($3B) p-code trap errors flag
		86	2649 00003C pcstack .EQU oldline+1 ; ($3C-$3D) p-code save stack
		87	2650 00003E prterr .EQU oldtxt+1 ; ($3E) p-code run time error number
		88	2651 00003F psrline .EQU datlin ; ($3F-$40) pascal source line number
		89	2652 000041 prseed .EQU datptr ; ($41-$42) p-code random generator
		90	2653 000043 pbrkcnt .EQU inpptr ; ($43) p-code counter for break check
		91	2654 000044 tmpy .EQU inpptr+1 ; ($44) p-code temp. for save Y
		92	2655 000045 inqidx .EQU varnam ; ($45) p-code index to input buffer
		93	2656 000046 inqcnt .EQU varnam+1 ; ($46) p-code input buffer counter
		94	2657 000047 tmpv1 .EQU varpnt ; ($47) p-code temp.
		95	2658 000048 tmpv2 .EQU varpnt+1 ; ($48) p-code temp.
		96	2659 000049 tmpa .EQU forpnt ; ($49) p-code temp. save A
		97	2660 00004A tmpwa .EQU forpnt+1 ; ($4A) p-code tmp. save byte to write
		98	2661 00004B tmpx .EQU opptr ; ($4B) p-code tmp. save X when print
		99	2662 00004C pcterr .EQU opptr+1 ; ($4C) p-code compiler error flag
		100	2663 00004D tmpdsk .EQU opmask ; ($4D) p-code default temp. disk unit
		101	2664 00004E defprn .EQU defpnt ; ($4E) p-code default printer #device
		102	2665 00004F pcdbg .EQU defpnt+1 ; ($4F) p-code debug run after error
		103	2666 000050 pcptr .EQU dscpnt ; ($50-$51) pointer to p-code (debug)
		104	2667 000052 autolf .EQU dsclen ; ($52) p-code auto line feed flag
		105	2668
		106	2669 000054 tmpwrk .DS 4 ; ($54-$57) temp. area editor/virtual iec
		107	2670 000058 00 tmpb0 .DB ; ($58)
		108	2671 000059 00 argbits .DB ; ($59) FAC #1 guard bits
		109	2672 00005A 00 tmpb2 .DB ; ($5A) tmp. byte - used by fpu
		110	2673 00005B 00 txtlen .DB ; ($5B) tmp. word length of text to insert in buffer
		111	2674 00005C 00 tmpb1 .DB ; ($5C) tmp. byte used by editor and float point unit
		112	2675 00005D 0000 tmpval .DW ; ($5D-$5E) temp. word used by editor/fpu
		113	2676 00005F 0000 tlnptr .DW ; ($5F-$60) temp. line text pointer used by editor/fpu
		114	2677 000061 00 facexp .DB ; ($61) FAC #1 exponent
		115	2678 000062 facm .DS 4 ; ($62-$65) FAC #1 mantissa
		116	2679 000066 00 facsgn .DB ; ($66) FAC #1 sign
		117	2680 000067 00 sercnt .DB ; ($67) FAC #1 series evaluation
		118	2681 000068 00 facov .DB ; ($68) FAC #1 overflow
		119	2682 000069 00 argexp .DB ; ($69) FAC #2 exponent
		120	2683 00006A argm .DS 4 ; ($6A-$6D) FAC #2 mantissa
		121	2684 00006E 00 argsgn .DB ; ($6E) FAC #2 sign
		122	2685 00006F 00 arisgn .DB ; ($6F) FAC #1 & #2 sign comparison
		123	2686 000070 00 facbits .DB ; ($70) FAC #1 guard bits
		124	2687 000071 0000 fbufpt .DW ; ($71-$72) FAC series evaluation pointer
		125	Tue Jul 17 11:00:22 2018 Page 3
		126
		127
		128
		129
		130	2688 000073 00 fbufpt2 .DB ; ($73) FAC series evaluation bank (progr. bank)
		131	2689
		132	2690 ; tmp. variables (equates) used by float point unit
		133	2691 000054 factmp .EQU tmpwrk ; ($54-$57) used by fpu mult/div
		134	2692 00005A cprmsk .EQU tmpb2 ; ($5A) used by trigs. funcs.
		135	2693 00005B faclsb .EQU txtlen ; ($5B) used by float point unit
		136	2694 00005D dccnt .EQU tmpval ; ($5D) digit count after decimal dot
		137	2695 00005E expval .EQU tmpval+1 ; ($5E) exponent value when convert
		138	2696 00005F dotfg .EQU tlnptr ; ($5F) flag decimal dot when convert
		139	2697 000060 expsgn .EQU tlnptr+1 ; ($60) flag exponent sign when conver
		140	2698 000067 sgnfg .EQU sercnt ; ($67) flag: minus sign when convert
		141	2699 000071 decidx .EQU fbufpt ; ($71) string index when convert
		142	2700 000072 s2fer .EQU fbufpt+1 ; ($72) string to float flag error
		143	2701 000073 decidx2 .EQU fbufpt+2 ; ($73) used when convert float to str
		144	2702
		145	2703 000074 0000 s2fstk .DW ; ($74-$75) save stack when string to float conversion
		146	2704 000076 longp LP ; ($76-$77-$78) temp. long pointer
		147	2705 000079 00 s2fptr .DB ; ($79) flag trap overflow err. string to float conv.
		148	2706
		149	2707 00007A 0000 txtp .DW ; ($7A-$7B) current pointer to text
		150	2708 00007C 00 pcdsk .DB ; ($7C) flag for pascal compiler
		151	2709 ; <7> : compile in memory
		152	2710
		153	2711 00007D iecrp LP ; ($7D) iec: pointer to read buffer for include file
		154	2712 000080 00 iecalt .DB ; ($80) iec: flag read from include file
		155	2713 000081 iectp LP ; ($81) iec: pointer to read main text buffer
		156	2714 000084 00 iecndx .DB ; ($84) iec: index main text buffer
		157	2715 000085 00 ieceof .DB ; ($85) iec: end of file flag main text buffer
		158	2716 000086 iecwp LP ; ($86) iec: pointer to write buffer
		159	2717 000089 00 iecfg .DB ; ($89) iec: flag main text buffer
		160	2718 00008A 0000 iecndx2 .DW ; ($8A) iec: index buffer include file
		161	2719 00008C 00 iecbuf .DB ; ($8C) iec: byte buffer
		162	2720 00008D 00 svbnk .DB ; ($8D) save vbnk when run pascal compiler
		163	2721 00008E 00 ieceof2 .DB ; ($8E) iec: flag eof include file
		164	2722 00008F 00 vxflag .DB ; ($8F) flag valid text in x-bank
		165	2723 000090 00 kstat .DB ; ($90) CBM emulated IEC status
		166	2724 000091 00 errno .DB ; ($91) saved error number
		167	2725 000092 00 keyfg .DB ; ($92) keyboard flag: KbdFlag
		168	2726 000093 00 keyctl .DB ; ($93) flag control key from get key
		169	2727 000094 00 keysh .DB ; ($94) flag keyboard: KbdShift
		170	2728 000095 00 keytg .DB ; ($95) flag keyboard: KbdToggle
		171	2729 000096 00 basic .DB ; ($96) flag current 'basic' mode
		172	2730 ; <7>: flag basic mode
		173	2731 ; <6>: flag pascal compiler running
		174	2732 000097 00 runf .DB ; ($97) flag current run mode
		175	2733 000098 00 ldtnd .DB ; ($98) number of open files
		176	2734 000099 00 dfltn .DB ; ($99) default input device
		177	2735 00009A 00 dflto .DB ; ($9A) default output device
		178	2736 00009B 00 skpbk .DB ; ($9B) skip blank flag
		179	2737 00009C 00 w2sf .DB ; ($9C) integer to string flag conversion
		180	2738 00009D 00 msgflg .DB ; ($9D) flag message
		181	2739 00009E 00 autof .DB ; ($9E) flag auto-increment line numbering
		182	2740 00009F 0000 wauto .DW ; ($9F-$A0) auto-increment for line numbering
		183	2741 0000A1 00 tbnk .DB ; ($A1) bank that hold basic/pascal text
		184	2742 0000A2 00 vbnk .DB ; ($A2) bank that hold basic var/pascal pcode-stack
		185	2743 0000A3 00 cbnk .DB ; ($A3) compiler bank/temp. bank for exchange
		186	2744 0000A4 00 jbnk .DB ; ($A4) bank for obj, when compiling (3 bank max.)
		187	Tue Jul 17 11:00:22 2018 Page 4
		188
		189
		190
		191
		192	2745 0000A5 00 xbnk .DB ; ($A5) exchange bank for text buffer
		193	2746 0000A6 00 dbnk .DB ; ($A6) bank for ram disk (jbnk + 3)
		194	2747 0000A7 0000 botmem .DW ; ($A7-$A8) start of memory on the text bank
		195	2748 0000A9 0000 topmem .DW ; ($A9-$AA) top of memory on the text bank
		196	2749 0000AB 0000 txtbeg .DW ; ($AB-$AC) begin of text buffer
		197	2750 0000AD 0000 txtend .DW ; ($AD-$AE) end of text buffer + 1
		198	2751 0000AF 0000 txttop .DW ; ($AF-$B0) top of memory + 1 reserved to text buffer
		199	2752 0000B1 0000 varbeg .DW ; ($B1-$B2) start of basic var/pcode
		200	2753 0000B3 0000 vartop .DW ; ($B3-$B4) top of basic var/pcode + 1
		201	2754 0000B5 0000 xtop .DW ; ($B5-$B6) top of text + 1 in x-bank
		202	2755 0000B7 00 fnlen .DB ; ($B7) length of current filename
		203	2756 0000B8 00 lacur .DB ; ($B8) current logical file number
		204	2757 0000B9 00 sacur .DB ; ($B9) current secondary address
		205	2758 0000BA 00 facur .DB ; ($BA) current device number
		206	2759 0000BB 0000 fnadr .DW ; ($BB-$BC) pointer to current filename
		207	2760 0000BD 00 fnadr2 .DB ; ($BD) - bank that hold file name
		208	2761 0000BE 00 objdsk .DB ; ($BE) compiler: option '1' specified
		209	2762 0000BF 00 truedsk .DB ; ($BF) true disk for load pascal soource file
		210	2763 0000C0 0000 curstk .DW ; ($C0-$C1) current stack when in edit mode
		211	2764 0000C2 00 pcodef .DB ; ($C2) flag p-code present for execution
		212	2765
		213	2766 0000C3 latb .DS MAXLF ; logical files table
		214	2767 0000CE fatb .DS MAXLF ; devices numbers table
		215	2768 0000D9 satb .DS MAXLF ; secondary addresses table
		216	2769
		217	2770 ;=============================================================
		218	2771
		219	2772 0000E4 0000 cmdlin .DW ; command line ptr for pscal program
		220	2773 0000E6 00 fpcflag .DB ; fpc flags (new style)
		221	2774 ; <7>: new style compiler
		222	2775 ; <6>: no save exec. file
		223	2776 ; <5>: save obj. file
		224	2777
		225	2778 0000E6 .RELATIVE
		226	2779 .ENDS
		227	2780
		228	2781 ; basic work area starting at $FF00 of bank that hold text buffer
		229	2782 CBMHIM: .SECTION ref_only, common
		230	2783 000000 .ABSOLUTE
		231	2784 00FF00 .ORG $FF00
		232	2785 ; .ORG 0
		233	2786
		234	2787 0000A2 TBUFMAX .EQU $A2 ; size of input buffer
		235	2788 00AA55 VALIDSGN .EQU $AA55 ; valid signature
		236	2789
		237	2790 00FF00 cbmwork .DS 4 ; first 4 bytes free for insert text line
		238	2791 00FF04 TXTBUF .DS TBUFMAX ; input buffer for text insertion
		239	2792 00FFA6 NUMSTR .DS 32 ; room for numeric string
		240	2793
		241	2794 00FFC6 0000 TMPPTR .DW ; temp. pointer
		242	2795 00FFC8 0000 .DW
		243	2796 00FFCA 0000 .DW
		244	2797 00FFCC 0000 .DW
		245	2798 00FFCE 0000 .DW
		246	2799 00FFD0 GFNAME .DS 32 ; global file name
		247	2800 00FFF0 .DS 8
		248	2801 00FFF8
		249	Tue Jul 17 11:00:22 2018 Page 5
		250
		251
		252
		253
		254	2802 ;;.ORG $FFF8
		255	2803 00FFF8 0000 TXTEND2 .DW ; saved text end + 1
		256	2804 00FFFA 0000 TXTVSGN .DW ; valid text buffer signature
		257	2805 00FFFC 0000 XTOP2 .DW ; saved text end + 1 in exchange bank
		258	2806 00FFFE 0000 XBVSGN .DW ; valid x-bank buffer signature
		259	2807
		260	2808 00FFFE .RELATIVE
		261	2809 .ENDS
		262	2810
		263	2811 .COMMENT @
		264	2812 cbmwork .EQU $FF00 ; first 4 bytes free for insert text line
		265	2813 TXTBUF .EQU $FF04 ; input buffer for text insertion
		266	2814 NUMSTR .EQU $FFA6 ; room for numeric string
		267	2815
		268	2816 TMPPTR .EQU $FFC6 ; temp. pointer
		269	2817
		270	2818 TXTEND2 .EQU $FFF8 ; saved text end + 1
		271	2819 TXTVSGN .EQU $FFFA ; valid text buffer signature
		272	2820 XTOP2 .EQU $FFFC ; saved text end + 1 in exchange bank
		273	2821 XBVSGN .EQU $FFFE ; valid x-bank buffer signature
		274	2822 @
		275	2823
		276	2824 ; basic/pascal work area starting at $FF00 of bank that hold variables/p-code
		277	2825 CBMHIV: .SECTION common, ref_only
		278	2826 000000 .ABSOLUTE
		279	2827 00FF00 .ORG $FF00
		280	2828 ; .ORG 0
		281	2829
		282	2830 00005A QINSIZ .EQU $5A ; input buffer max. 90 chars.
		283	2831 000020 NUMSIZ .EQU $20 ; size of numeric buffer for conversion
		284	2832 000018 MAX2LF .EQU ((MAXLF + 1) * 2) ; size of p-code logical files table
		285	2833 000013 MAXFNLEN .EQU 19 ; max. length of file name '@x:yyyyyyyyyyyyyyyy'
		286	2834
		287	2835 00FF00 MINBUF .DS QINSIZ
		288	2836 00FF5A MNUMSTR .DS NUMSIZ
		289	2837 00FF7A 0000 MTMPW0 .DW
		290	2838 00FF7C 0000 MTMPW1 .DW
		291	2839 00FF7E 00 MTMPB0 .DB
		292	2840 00FF7F MFNAME .DS 16 ; file name buffer
		293	2841 00FF8F MTMPNAM .DS 15 ; tmp. file name
		294	2842 00FF9E MPOW10 .DS 10 ; power of 10 table
		295	2843 00FFA8 MTRUE .DS 6
		296	2844 00FFAE MFALSE .DS 6
		297	2845 00FFB4 MSTDF0 .DS 4 ; descriptor for file #0 (consolle)
		298	2846 00FFB8 MSTDF1 .DS 4 ; descriptor for file #1 (disk command chann.)
		299	2847 00FFBC MSTDF2 .DS 4 ; descriptor for file #2 (used by compiler)
		300	2848 00FFC0 MMSET .DS 16 ; set variables
		301	2849 00FFD0 MFILET .DS MAX2LF ; table of logical files: #0 consolle, #1 disk
		302	2850 00FFE8 FAC1TMP .DS 5 ; these 3 used by float routines
		303	2851 00FFED FAC2TMP .DS 5
		304	2852 00FFF2 FAC3TMP .DS 5
		305	2853 00FFF7 FAC4TMP .DS 5 ; free to use
		306	2854 00FFFC 0000 MTPTR .DW ; used by new/dispose
		307	2855 00FFFE 0000 MTMPW2 .DW
		308	2856
		309	2857 00FFFE .RELATIVE
		310	2858 .ENDS
		311	Tue Jul 17 11:00:22 2018 Page 6
		312
		313
		314
		315
		316	2859
		317	2860 .COMMENT @
		318	2861 MINBUF .EQU $FF00
		319	2862 MNUMSTR .EQU $FF5A
		320	2863 MTMPW0 .EQU $FF7A
		321	2864 MTMPW1 .EQU $FF7C
		322	2865 MTMPB0 .EQU $FF7E
		323	2866 MFNAME .EQU $FF7F ; file name buffer
		324	2867 MTMPNAM .EQU $FF8F ; tmp. file name
		325	2868 MPOW10 .EQU $FF9E ; power of 10 table
		326	2869 MTRUE .EQU $FFA8
		327	2870 MFALSE .EQU $FFAE
		328	2871 MSTDF0 .EQU $FFB4 ; descriptor for file #0 (consolle)
		329	2872 MSTDF1 .EQU $FFB8 ; descriptor for file #1 (disk command chann.)
		330	2873 MSTDF2 .EQU $FFBC ; descriptor for file #2 (used by compiler)
		331	2874 MMSET .EQU $FFC0 ; set variables
		332	2875 MFILET .EQU $FFD0 ; table of logical files: #0 consolle, #1 disk
		333	2876 FAC1TMP .EQU $FFE8 ; these 3 used by float routines
		334	2877 FAC2TMP .EQU $FFED
		335	2878 FAC3TMP .EQU $FFF2
		336	2879 FAC4TMP .EQU $FFF7 ; free to use
		337	2880 MTPTR .EQU $FFFC ; used by new/dispose
		338	2881 MTMPW2 .EQU $FFFE
		339	2882 @
		340	2883
		341	2884 ; temp. file names in x-bank
		342	2885 00FF00 PASSRC .EQU $FF00
		343	2886 00FF20 OBJDST .EQU $FF20
		344	2887 00FF40 EXEDST .EQU $FF40
		345	2888 00FF60 OBJDEL .EQU $FF60
		346	2889
		347	2890
		348	2891 00FF5A TTNUMSTR .EQU MNUMSTR
		349	2892
		350	2893 .CODEFE
		351	2894 .LONGA off
		352	2895 .LONGI off
		353	2896
		354	2897 .EXTERN cbm_chrget, cbm_chrgot, cbm_err, vpmerr
		355	2898 .GLOBAL XBBD4, XBBA2, XBC5B, XBA8C, XBB12, XBA2B, XB853, XB86A
		356	2899 .GLOBAL XBAFE, XBAE2, XBCF3P, XBCF3, XBBA2T,XBDDD, XE26B, XE264
		357	2900 .GLOBAL XE2B4, XE30E, XBFED, XBF7B, XBF71, XB9EA, XBC49, XBB0F
		358	2901 .GLOBAL XB9BC, XBBC7, XBBA2T, XB9E0, FCON05, XB867, FCON10
		359	2902 .GLOBAL XBBA2L, XBA8CK, XBBA2K, XLN10, XBC0C, XB9BC, XBA28
		360	2903 FE938D
		361	2904 ;---------------------------------------------------------------------------
		362	2905 ; move FAC #2 routines
		363	2906 ;---------------------------------------------------------------------------
		364	2907
		365	2908 ; move float number at address AY to FAC #2
		366	2909 ; address is in current data bank
		367	2910 FE938D XBA8C:
		368	2911 FE938D 85 76 sta <longp
		369	2912 FE938F 84 77 sty <longp+1
		370	2913 FE9391 A0 04 ldy #4
		371	2914 FE9393 B1 76 lda (longp),y
		372	2915 FE9395 85 6D sta <argm+3
		373	Tue Jul 17 11:00:22 2018 Page 7
		374
		375
		376
		377
		378	2916 FE9397 88 dey
		379	2917 FE9398 B1 76 lda (longp),y
		380	2918 FE939A 85 6C sta <argm+2
		381	2919 FE939C 88 dey
		382	2920 FE939D B1 76 lda (longp),y
		383	2921 FE939F 85 6B sta <argm+1
		384	2922 FE93A1 88 dey
		385	2923 FE93A2 B1 76 lda (longp),y
		386	2924 FE93A4 85 6E sta <argsgn
		387	2925 FE93A6 45 66 eor <facsgn
		388	2926 FE93A8 85 6F sta <arisgn
		389	2927 FE93AA A5 6E lda <argsgn
		390	2928 FE93AC 09 80 ora #$80
		391	2929 FE93AE 85 6A sta <argm
		392	2930 FE93B0 88 dey
		393	2931 FE93B1 B1 76 lda (longp),y
		394	2932 FE93B3 85 69 sta <argexp
		395	2933 FE93B5 A5 61 lda <facexp
		396	2934 FE93B7 60 rts
		397	2935
		398	2936 ; move float number at address AY in current program bank to FAC #2
		399	2937 FE93B8 XBA8CK:
		400	2938 FE93B8 85 76 sta longp
		401	2939 FE93BA 84 77 sty longp+1
		402	2940 FE93BC A2 FE ldx #^XBA8CK
		403	2941 FE93BE 80 04 bra XBA8CK2
		404	2942
		405	2943 ; move float number at address AYX to FAC #2
		406	2944 FE93C0 XBA8CL:
		407	2945 FE93C0 85 76 sta <longp
		408	2946 FE93C2 84 77 sty <longp+1
		409	2947
		410	2948 FE93C4 XBA8CK2:
		411	2949 FE93C4 86 78 stx <longp+2
		412	2950 FE93C6 A0 04 ldy #4
		413	2951 FE93C8 B7 76 lda [longp],y
		414	2952 FE93CA 85 6D sta <argm+3
		415	2953 FE93CC 88 dey
		416	2954 FE93CD B7 76 lda [longp],y
		417	2955 FE93CF 85 6C sta <argm+2
		418	2956 FE93D1 88 dey
		419	2957 FE93D2 B7 76 lda [longp],y
		420	2958 FE93D4 85 6B sta <argm+1
		421	2959 FE93D6 88 dey
		422	2960 FE93D7 B7 76 lda [longp],y
		423	2961 FE93D9 85 6E sta <argsgn
		424	2962 FE93DB 45 66 eor <facsgn
		425	2963 FE93DD 85 6F sta <arisgn
		426	2964 FE93DF A5 6E lda <argsgn
		427	2965 FE93E1 09 80 ora #$80
		428	2966 FE93E3 85 6A sta <argm
		429	2967 FE93E5 88 dey
		430	2968 FE93E6 B7 76 lda [longp],y
		431	2969 FE93E8 85 69 sta <argexp
		432	2970 FE93EA A5 61 lda <facexp
		433	2971 FE93EC XB848:
		434	2972 FE93EC 60 rts
		435	Tue Jul 17 11:00:22 2018 Page 8
		436
		437
		438
		439
		440	2973
		441	2974 ;---------------------------------------------------------------------------
		442	2975 ; subctraction implementation
		443	2976 ;---------------------------------------------------------------------------
		444	2977
		445	2978 XB849: ; compute FAC #1 + 0.5
		446	2979 FE93ED A9 AC lda #<FCON05
		447	2980 FE93EF A0 9C ldy #>FCON05
		448	2981 FE93F1 80 16 bra XB867 ; add costant stored in current program bank
		449	2982 FE93F3
		450	2983 XB850: ; compute [float at address AYK] - FAC #1
		451	2984 FE93F3 20 B8 93 jsr XBA8CK ; move float at AYK address to FAC #2
		452	2985
		453	2986 XB853: ; compute FAC #2 - FAC #1
		454	2987 FE93F6 A5 66 lda <facsgn
		455	2988 FE93F8 49 FF eor #$FF
		456	2989 FE93FA 85 66 sta <facsgn
		457	2990 FE93FC 45 6E eor <argsgn
		458	2991 FE93FE 85 6F sta <arisgn
		459	2992 FE9400 A5 61 lda <facexp
		460	2993 FE9402 80 08 bra XB86A
		461	2994
		462	2995 ;---------------------------------------------------------------------------
		463	2996 ; addition implementation
		464	2997 ;---------------------------------------------------------------------------
		465	2998
		466	2999 FE9404 XB862:
		467	3000 FE9404 20 6B 95 jsr XB999 ; shift right mantissa
		468	3001 FE9407 90 3C bcc XB8A3 ; always return CF = 0
		469	3002
		470	3003 ; add float at address AYK to FAC #1
		471	3004 FE9409 XB867:
		472	3005 FE9409 20 B8 93 jsr XBA8CK ; move float in mem. to FAC #2
		473	3006
		474	3007 ; add FAC #1 to FAC #2 - in input A = FAC #1 exponent
		475	3008 FE940C XB86A:
		476	3009 FE940C D0 03 bne ?02
		477	3010 FE940E 4C BE 97 jmp XBBFC ; move FAC #2 to FAC #1
		478	3011 FE9411 ?02:
		479	3012 FE9411 A6 70 ldx <facbits
		480	3013 FE9413 86 59 stx <argbits
		481	3014 FE9415 A2 69 ldx #argexp
		482	3015 FE9417 A5 69 lda <argexp
		483	3016 FE9419 XB877:
		484	3017 FE9419 A8 tay
		485	3018 FE941A F0 D0 beq XB848 ; exit (FAC #2 = 0)
		486	3019 FE941C 38 sec
		487	3020 FE941D E5 61 sbc <facexp
		488	3021 FE941F F0 24 beq XB8A3 ; same exponent
		489	3022 FE9421 90 12 bcc ?02
		490	3023 FE9423 84 61 sty <facexp
		491	3024 FE9425 A4 6E ldy <argsgn
		492	3025 FE9427 84 66 sty <facsgn
		493	3026 FE9429 49 FF eor #$FF
		494	3027 FE942B 69 00 adc #$00
		495	3028 FE942D A0 00 ldy #$00
		496	3029 FE942F 84 59 sty <argbits
		497	Tue Jul 17 11:00:22 2018 Page 9
		498
		499
		500
		501
		502	3030 FE9431 A2 61 ldx #facexp
		503	3031 FE9433 D0 04 bne ?04
		504	3032 FE9435 A0 00 ?02: ldy #$00
		505	3033 FE9437 84 70 sty <facbits
		506	3034 FE9439 C9 F9 ?04: cmp #$F9
		507	3035 FE943B 30 C7 bmi XB862
		508	3036 FE943D A8 tay
		509	3037 FE943E A5 70 lda <facbits
		510	3038 FE9440 56 01 lsr <$01,x
		511	3039 FE9442 20 82 95 jsr XB9B0
		512	3040 FE9445 XB8A3:
		513	3041 FE9445 24 6F bit <arisgn
		514	3042 FE9447 10 5D bpl XB8FE ; add mantissa
		515	3043 FE9449 A0 61 ldy #facexp
		516	3044 FE944B E0 69 cpx #argexp
		517	3045 FE944D F0 02 beq ?02
		518	3046 FE944F A0 69 ldy #argexp
		519	3047 FE9451 38 ?02: sec
		520	3048 FE9452 49 FF eor #$FF
		521	3049 FE9454 65 59 adc <argbits
		522	3050 FE9456 85 70 sta <facbits
		523	3051 FE9458 8B phb ; save data bank
		524	3052 FE9459 A9 00 lda #0 ; set data bank = 0
		525	3053 FE945B 48 pha ; need this because don't exist DP,y
		526	3054 FE945C AB plb
		527	3055 FE945D B9 04 7F lda !CBMP0+$04,y
		528	3056 FE9460 F5 04 sbc <$04,x
		529	3057 FE9462 85 65 sta <facm+3
		530	3058 FE9464 B9 03 7F lda !CBMP0+$03,y
		531	3059 FE9467 F5 03 sbc <$03,x
		532	3060 FE9469 85 64 sta <facm+2
		533	3061 FE946B B9 02 7F lda !CBMP0+$02,y
		534	3062 FE946E F5 02 sbc <$02,x
		535	3063 FE9470 85 63 sta <facm+1
		536	3064 FE9472 B9 01 7F lda !CBMP0+$01,y
		537	3065 FE9475 F5 01 sbc <$01,x
		538	3066 FE9477 85 62 sta <facm
		539	3067 FE9479 AB plb ; restore data bank
		540	3068
		541	3069 FE947A XB8D2:
		542	3070 FE947A B0 03 bcs XB8D7
		543	3071 FE947C 20 EE 94 jsr XB947
		544	3072 FE947F
		545	3073 FE947F XB8D7:
		546	3074 FE947F A0 00 ldy #$00
		547	3075 FE9481 98 tya
		548	3076 FE9482 18 clc
		549	3077 FE9483 A6 62 ?02: ldx <facm
		550	3078 FE9485 D0 49 bne XB929
		551	3079 FE9487 A6 63 ldx <facm+1
		552	3080 FE9489 86 62 stx <facm
		553	3081 FE948B A6 64 ldx <facm+2
		554	3082 FE948D 86 63 stx <facm+1
		555	3083 FE948F A6 65 ldx <facm+3
		556	3084 FE9491 86 64 stx <facm+2
		557	3085 FE9493 A6 70 ldx <facbits
		558	3086 FE9495 86 65 stx <facm+3
		559	Tue Jul 17 11:00:22 2018 Page 10
		560
		561
		562
		563
		564	3087 FE9497 84 70 sty <facbits
		565	3088 FE9499 69 08 adc #$08
		566	3089 FE949B C9 20 cmp #$20
		567	3090 FE949D D0 E4 bne ?02
		568	3091
		569	3092 XB8F7: ; clear FAC #1
		570	3093 FE949F A9 00 lda #$00
		571	3094 XB8F9: ; set FAC #1 exponent
		572	3095 FE94A1 85 61 sta <facexp
		573	3096 XB8FB: ; set FAC #1 sign
		574	3097 FE94A3 85 66 sta <facsgn
		575	3098 FE94A5 60 rts
		576	3099
		577	3100 XB8FE: ; add mantissa of FAC #2 to mantissa of FAC #1
		578	3101 FE94A6 65 59 adc <argbits
		579	3102 FE94A8 85 70 sta <facbits
		580	3103 FE94AA A5 65 lda <facm+3
		581	3104 FE94AC 65 6D adc <argm+3
		582	3105 FE94AE 85 65 sta <facm+3
		583	3106 FE94B0 A5 64 lda <facm+2
		584	3107 FE94B2 65 6C adc <argm+2
		585	3108 FE94B4 85 64 sta <facm+2
		586	3109 FE94B6 A5 63 lda <facm+1
		587	3110 FE94B8 65 6B adc <argm+1
		588	3111 FE94BA 85 63 sta <facm+1
		589	3112 FE94BC A5 62 lda <facm
		590	3113 FE94BE 65 6A adc <argm
		591	3114 FE94C0 85 62 sta <facm
		592	3115 FE94C2 80 19 bra XB936 ; normalize
		593	3116
		594	3117 XB91D: ; shift left mantissa bit by bit
		595	3118 FE94C4 69 01 adc #$01
		596	3119 FE94C6 06 70 asl <facbits
		597	3120 FE94C8 26 65 rol <facm+3
		598	3121 FE94CA 26 64 rol <facm+2
		599	3122 FE94CC 26 63 rol <facm+1
		600	3123 FE94CE 26 62 rol <facm
		601	3124
		602	3125 XB929: ; shift left mantissa if need -- A = exponent
		603	3126 FE94D0 10 F2 bpl XB91D
		604	3127 FE94D2 38 sec
		605	3128 FE94D3 E5 61 sbc <facexp
		606	3129 FE94D5 B0 C8 bcs XB8F7 ; underflow -> clear FAC #1
		607	3130 FE94D7 49 FF eor #$FF ; 2's complement
		608	3131 FE94D9 69 01 adc #$01
		609	3132 FE94DB 85 61 sta facexp
		610	3133
		611	3134 XB936: ; normalize FAC #1 if carry
		612	3135 FE94DD 90 0E bcc XB946 ; no carry: exit
		613	3136
		614	3137 XB938: ; increment FAC #1 exponent
		615	3138 FE94DF E6 61 inc <facexp
		616	3139 FE94E1 F0 42 beq XB97E ;OVERFLOW
		617	3140 FE94E3 66 62 ror <facm
		618	3141 FE94E5 66 63 ror <facm+1
		619	3142 FE94E7 66 64 ror <facm+2
		620	3143 FE94E9 66 65 ror <facm+3
		621	Tue Jul 17 11:00:22 2018 Page 11
		622
		623
		624
		625
		626	3144 FE94EB 66 70 ror <facbits
		627	3145 FE94ED 60 XB946: rts
		628	3146
		629	3147 XB947: ; FAC #1 2's complement
		630	3148 FE94EE A5 66 lda <facsgn
		631	3149 FE94F0 49 FF eor #$FF
		632	3150 FE94F2 85 66 sta <facsgn
		633	3151
		634	3152 XB94D: ; mantissa 2's complement
		635	3153 FE94F4 A5 62 lda <facm
		636	3154 FE94F6 49 FF eor #$FF
		637	3155 FE94F8 85 62 sta <facm
		638	3156 FE94FA A5 63 lda <facm+1
		639	3157 FE94FC 49 FF eor #$FF
		640	3158 FE94FE 85 63 sta <facm+1
		641	3159 FE9500 A5 64 lda <facm+2
		642	3160 FE9502 49 FF eor #$FF
		643	3161 FE9504 85 64 sta <facm+2
		644	3162 FE9506 A5 65 lda <facm+3
		645	3163 FE9508 49 FF eor #$FF
		646	3164 FE950A 85 65 sta <facm+3
		647	3165 FE950C A5 70 lda <facbits
		648	3166 FE950E 49 FF eor #$FF
		649	3167 FE9510 85 70 sta <facbits
		650	3168 FE9512 E6 70 inc <facbits
		651	3169 FE9514 D0 0E bne XB97D ; exit
		652	3170
		653	3171 XB96F: ; increment mantissa
		654	3172 FE9516 E6 65 inc <facm+3
		655	3173 FE9518 D0 0A bne XB97D ; exit
		656	3174 FE951A E6 64 inc <facm+2
		657	3175 FE951C D0 06 bne XB97D ; exit
		658	3176 FE951E E6 63 inc <facm+1
		659	3177 FE9520 D0 02 bne XB97D ; exit
		660	3178 FE9522 E6 62 inc <facm
		661	3179 FE9524 60 XB97D: rts
		662	3180
		663	3181 XB97E: ; overflow error
		664	3182 FE9525 24 96 bit <basic
		665	3183 FE9527 30 27 bmi ?10
		666	3184 FE9529 A6 97 ldx <runf
		667	3185 FE952B F0 23 beq ?10
		668	3186 FE952D A5 79 lda <s2fptr ; error from conversion routine ?
		669	3187 FE952F 10 1A bpl ?08 ; no - handle runtime error
		670	3188 FE9531 85 72 sta <s2fer ; setup conversion error flag
		671	3189 FE9533 A0 00 ldy #$00
		672	3190 FE9535 INDEX16
		673	3191 FE9535 C2 10 rep #PXFLAG
		674	3192 .LONGI on
		675	3193 .MNLIST
		676	3194 FE9537 A6 74 ldx <s2fstk ; recover stack pointer
		677	3195 FE9539 9A txs
		678	3196 FE953A A5 A2 lda <vbnk ; setup right data bank
		679	3197 FE953C 48 pha
		680	3198 FE953D AB plb
		681	3199 FE953E 88 dey
		682	3200 FE953F 8C E8 FF sty FAC1TMP
		683	Tue Jul 17 11:00:22 2018 Page 12
		684
		685
		686
		687
		688	3201 FE9542 8C EA FF sty FAC1TMP+2
		689	3202 FE9545 INDEX08
		690	3203 FE9545 E2 10 sep #PXFLAG
		691	3204 .LONGI off
		692	3205 .MNLIST
		693	3206 FE9547 8C EC FF sty FAC1TMP+4
		694	3207 FE954A 60 rts
		695	3208 FE954B A2 09 ?08: ldx #$09 ; pascal: floating point overflow
		696	3209 FE954D 4C 50 1B jmp vpmerr
		697	3210 FE9550 A2 0F ?10: ldx #$0F ; overflow
		698	3211 FE9552 4C 47 01 jmp cbm_err
		699	3212
		700	3213 XB983: ; shift right temp. mantissa by 8 bits
		701	3214 FE9555 A2 53 ldx #factmp-1
		702	3215
		703	3216 XB985: ; shift right 8 bits mantissa pointed by X
		704	3217 ; A = negative of shift count * 8
		705	3218 FE9557 B4 04 ldy <$04,x
		706	3219 FE9559 84 70 sty <facbits
		707	3220 FE955B B4 03 ldy <$03,x
		708	3221 FE955D 94 04 sty <$04,x
		709	3222 FE955F B4 02 ldy <$02,x
		710	3223 FE9561 94 03 sty <$03,x
		711	3224 FE9563 B4 01 ldy <$01,x
		712	3225 FE9565 94 02 sty <$02,x
		713	3226 FE9567 A4 68 ldy facov
		714	3227 FE9569 94 01 sty <$01,x
		715	3228
		716	3229 XB999: ; shift right mantissa
		717	3230 FE956B 69 08 adc #$08
		718	3231 FE956D 30 E8 bmi XB985 ; shift 8 bits
		719	3232 FE956F F0 E6 beq XB985 ; shift 8 bits
		720	3233 FE9571 E9 08 sbc #$08
		721	3234 FE9573 A8 tay ; Y = number of negative right shift
		722	3235 FE9574 A5 70 lda <facbits
		723	3236 FE9576 B0 14 bcs XB9BA ; no shift
		724	3237
		725	3238 FE9578 XB9A6:
		726	3239 FE9578 16 01 asl <$01,x
		727	3240 FE957A 90 02 bcc ?02
		728	3241 FE957C F6 01 inc <$01,x
		729	3242 FE957E 76 01 ?02: ror <$01,x
		730	3243 FE9580 76 01 ror <$01,x
		731	3244
		732	3245 FE9582 XB9B0:
		733	3246 FE9582 76 02 ror <$02,x
		734	3247 FE9584 76 03 ror <$03,x
		735	3248 FE9586 76 04 ror <$04,x
		736	3249 FE9588 6A ror a
		737	3250 FE9589 C8 iny
		738	3251 FE958A D0 EC bne XB9A6
		739	3252 FE958C XB9BA:
		740	3253 FE958C 18 clc
		741	3254 FE958D 60 rts
		742	3255
		743	3256 ;---------------------------------------------------------------------------
		744	3257 ; LN() implementation
		745	Tue Jul 17 11:00:22 2018 Page 13
		746
		747
		748
		749
		750	3258 ;---------------------------------------------------------------------------
		751	3259
		752	3260 ; compute LN(FAC #1)
		753	3261 FE958E XB9EA:
		754	3262 FE958E 20 ED 97 jsr XBC2B ; check if FAC #1 is zero or negative
		755	3263 FE9591 F0 02 beq ?02 ; error
		756	3264 FE9593 10 12 bpl XB9F4
		757	3265 FE9595 24 96 ?02: bit <basic
		758	3266 FE9597 30 09 bmi ?04
		759	3267 FE9599 A6 97 ldx <runf
		760	3268 FE959B F0 05 beq ?04
		761	3269 FE959D A2 0C ldx #$0C ; pascal error: complex log or square root
		762	3270 FE959F 4C 50 1B jmp vpmerr
		763	3271 FE95A2 A2 0E ?04: LDX #$0E ; error: illegal quantity
		764	3272 FE95A4 4C 47 01 JMP cbm_err
		765	3273 FE95A7 XB9F4:
		766	3274 FE95A7 A5 61 lda <facexp ; here always CF = 0
		767	3275 FE95A9 E9 7F sbc #$7F ; depolarize
		768	3276 FE95AB 48 pha
		769	3277 FE95AC A9 80 lda #$80 ; reduce FAC #1
		770	3278 FE95AE 85 61 sta <facexp
		771	3279 FE95B0 A9 C6 lda #<XB9D6 ; 0.5 * SQRT(2)
		772	3280 FE95B2 A0 9C ldy #>XB9D6
		773	3281 FE95B4 20 09 94 jsr XB867 ; add to FAC #1
		774	3282 FE95B7 A9 CB lda #<XB9DB ; SQRT(2)
		775	3283 FE95B9 A0 9C ldy #>XB9DB
		776	3284 FE95BB A2 FE ldx #^XB9F4 ; current program bank
		777	3285 FE95BD 20 91 96 jsr XBB0F ; divide by SQRT(2)
		778	3286 FE95C0 A9 A2 lda #<XB9BC ; 1.0
		779	3287 FE95C2 A0 9C ldy #>XB9BC
		780	3288 FE95C4 20 F3 93 jsr XB850 ; compute 1.0 - [FAC #1]
		781	3289 FE95C7 A9 B1 lda #<XB9C1 ; polynomial table
		782	3290 FE95C9 A0 9C ldy #>XB9C1
		783	3291 FE95CB 20 A7 9B jsr XE043 ; compute polynomial
		784	3292 FE95CE A9 D0 lda #<XB9E0
		785	3293 FE95D0 A0 9C ldy #>XB9E0
		786	3294 FE95D2 20 09 94 jsr XB867 ; add -0.5 to FAC #1
		787	3295 FE95D5 68 pla
		788	3296 FE95D6 20 92 99 jsr XBD7E ; add exponent to FAC #1
		789	3297 FE95D9 A9 D5 lda #<XB9E5 ; LN(2)
		790	3298 FE95DB A0 9C ldy #>XB9E5
		791	3299 FE95DD A2 FE ldx #^XB9F4 ; current program bank
		792	3300 ; mult LN(2)
		793	3301 FE95DF
		794	3302 ;---------------------------------------------------------------------------
		795	3303 ; multiplication implementation
		796	3304 ;---------------------------------------------------------------------------
		797	3305
		798	3306 ; compute [float at address AYX] * [FAC #1]
		799	3307 FE95DF XBA28:
		800	3308 FE95DF 20 C0 93 jsr XBA8CL ; move float from long address to FAC #2
		801	3309
		802	3310 ; compute [FAC #2] * [FAC #1]
		803	3311 XBA2B: ; A = FAC #1 exponent
		804	3312 FE95E2 F0 59 beq XBA8B ; exit if FAC #1 = 0
		805	3313 FE95E4 20 3E 96 jsr XBAB7 ; add the 2 exponents
		806	3314 FE95E7 64 54 stz <factmp ; clear temp. mantissa
		807	Tue Jul 17 11:00:22 2018 Page 14
		808
		809
		810
		811
		812	3315 FE95E9 64 55 stz <factmp+1
		813	3316 FE95EB 64 56 stz <factmp+2
		814	3317 FE95ED 64 57 stz <factmp+3
		815	3318 FE95EF A5 70 lda <facbits ; mult. byte by byte
		816	3319 FE95F1 20 0B 96 jsr XBA59
		817	3320 FE95F4 A5 65 lda <facm+3
		818	3321 FE95F6 20 0B 96 jsr XBA59
		819	3322 FE95F9 A5 64 lda <facm+2
		820	3323 FE95FB 20 0B 96 jsr XBA59
		821	3324 FE95FE A5 63 lda <facm+1
		822	3325 FE9600 20 0B 96 jsr XBA59
		823	3326 FE9603 A5 62 lda <facm
		824	3327 FE9605 20 10 96 jsr XBA5E
		825	3328 FE9608 4C 20 97 jmp XBB8F ; copy temp. mantissa to FAC #1
		826	3329
		827	3330 XBA59: ; mult byte A with FAC #2 mantissa and put result in temp. mantissa LA07B
		828	3331 FE960B D0 03 bne XBA5E
		829	3332 FE960D 4C 55 95 jmp XB983 ; shift right temp. mantissa
		830	3333 FE9610 XBA5E:
		831	3334 FE9610 4A lsr a
		832	3335 FE9611 09 80 ora #$80
		833	3336 FE9613 A8 ?02: tay
		834	3337 FE9614 90 19 bcc ?04
		835	3338 FE9616 18 clc
		836	3339 FE9617 A5 57 lda <factmp+3
		837	3340 FE9619 65 6D adc <argm+3
		838	3341 FE961B 85 57 sta <factmp+3
		839	3342 FE961D A5 56 lda <factmp+2
		840	3343 FE961F 65 6C adc <argm+2
		841	3344 FE9621 85 56 sta <factmp+2
		842	3345 FE9623 A5 55 lda <factmp+1
		843	3346 FE9625 65 6B adc <argm+1
		844	3347 FE9627 85 55 sta <factmp+1
		845	3348 FE9629 A5 54 lda <factmp
		846	3349 FE962B 65 6A adc <argm
		847	3350 FE962D 85 54 sta <factmp
		848	3351 FE962F 66 54 ?04: ror <factmp
		849	3352 FE9631 66 55 ror <factmp+1
		850	3353 FE9633 66 56 ror <factmp+2
		851	3354 FE9635 66 57 ror <factmp+3
		852	3355 FE9637 66 70 ror <facbits
		853	3356 FE9639 98 tya
		854	3357 FE963A 4A lsr a
		855	3358 FE963B D0 D6 bne ?02
		856	3359 FE963D 60 XBA8B: rts
		857	3360
		858	3361 XBAB7: ; add exponents
		859	3362 FE963E A5 69 lda <argexp
		860	3363
		861	3364 FE9640 XBAB9:
		862	3365 FE9640 F0 20 beq XBADA ; clear FAC #1 and exit
		863	3366 FE9642 18 clc
		864	3367 FE9643 65 61 adc <facexp
		865	3368 FE9645 90 05 bcc ?02
		866	3369 FE9647 30 1E bmi XBADF
		867	3370 FE9649 18 clc
		868	3371 FE964A 80 02 bra ?04
		869	Tue Jul 17 11:00:22 2018 Page 15
		870
		871
		872
		873
		874	3372 FE964C 10 14 ?02: bpl XBADA
		875	3373 FE964E 69 80 ?04: adc #$80
		876	3374 FE9650 85 61 sta <facexp
		877	3375 FE9652 D0 03 bne ?06
		878	3376 FE9654 4C A3 94 jmp XB8FB
		879	3377 FE9657 A5 6F ?06: lda <arisgn
		880	3378 FE9659 85 66 sta <facsgn
		881	3379 FE965B 60 rts
		882	3380
		883	3381 FE965C XBAD4:
		884	3382 FE965C A5 66 lda <facsgn
		885	3383 FE965E 49 FF eor #$FF
		886	3384 FE9660 30 05 bmi XBADF
		887	3385 XBADA: ; skip return address and clear FAC #1
		888	3386 FE9662 68 pla
		889	3387 FE9663 68 pla
		890	3388 FE9664 4C 9F 94 jmp XB8F7
		891	3389 FE9667
		892	3390 XBADF: ; overflow
		893	3391 FE9667 4C 25 95 jmp XB97E
		894	3392
		895	3393 XBAE2: ; compute (FAC #1) * 10
		896	3394 FE966A 20 CE 97 jsr XBC0C ; round FAC #1 and move it to FAC #2
		897	3395 FE966D AA tax
		898	3396 FE966E F0 10 beq XBAF8
		899	3397 FE9670 18 clc
		900	3398 FE9671 69 02 adc #$02 ; mult * 4
		901	3399 FE9673 B0 F2 bcs XBADF ; overflow
		902	3400 FE9675 A2 00 XBAED: ldx #$00
		903	3401 FE9677 86 6F stx <arisgn
		904	3402 FE9679 20 19 94 jsr XB877 ; add itself
		905	3403 FE967C E6 61 inc <facexp ; mult * 2
		906	3404 FE967E F0 E7 beq XBADF ; overflow
		907	3405 FE9680 60 XBAF8: rts
		908	3406
		909	3407 ;---------------------------------------------------------------------------
		910	3408 ; division implementation
		911	3409 ;---------------------------------------------------------------------------
		912	3410
		913	3411 ; compute [FAC #1] / 10
		914	3412 FE9681 XBAFE:
		915	3413 FE9681 20 CE 97 jsr XBC0C ; round FAC #1 and move it to FAC #2
		916	3414 FE9684 A9 A7 lda #<FCON10
		917	3415 FE9686 A0 9C ldy #>FCON10
		918	3416 FE9688 A2 00 ldx #0 ; comparison sign
		919	3417
		920	3418 ; compute [FAC #2] / [float at AY address (in current program bank)]
		921	3419 FE968A XBB07:
		922	3420 FE968A 86 6F stx <arisgn ; X = comparison sign
		923	3421 FE968C 20 49 97 jsr XBBA2K ; move from addr. AY (program bank) to FAC #1
		924	3422 FE968F 80 03 bra XBB12
		925	3423 FE9691
		926	3424 ; compute [float at AYX address] / [FAC #1]
		927	3425 FE9691 XBB0F:
		928	3426 FE9691 20 C0 93 jsr XBA8CL ; move from address AYX to FAC #2
		929	3427 FE9694
		930	3428 ; compute [FAC #2] / [FAC #1]
		931	Tue Jul 17 11:00:22 2018 Page 16
		932
		933
		934
		935
		936	3429 XBB12: ; A = FAC #1 exponent
		937	3430 FE9694 F0 78 beq ?16 ; division by zero error
		938	3431 FE9696 20 DD 97 jsr XBC1B ; round FAC #1
		939	3432 FE9699 A9 00 lda #$00
		940	3433 FE969B 38 sec
		941	3434 FE969C E5 61 sbc <facexp ; 2's complement
		942	3435 FE969E 85 61 sta <facexp
		943	3436 FE96A0 20 3E 96 jsr XBAB7 ; add exponents
		944	3437 FE96A3 E6 61 inc <facexp
		945	3438 FE96A5 F0 C0 beq XBADF ; overflow
		946	3439 ;ldx #$04 ; here different !
		947	3440 FE96A7 A2 FF ldx #$FF ; here different !
		948	3441 FE96A9 A9 01 lda #$01
		949	3442 FE96AB A4 6A ?02: ldy <argm
		950	3443 FE96AD C4 62 cpy <facm
		951	3444 FE96AF D0 10 bne ?04
		952	3445 FE96B1 A4 6B ldy <argm+1
		953	3446 FE96B3 C4 63 cpy <facm+1
		954	3447 FE96B5 D0 0A bne ?04
		955	3448 FE96B7 A4 6C ldy <argm+2
		956	3449 FE96B9 C4 64 cpy <facm+2
		957	3450 FE96BB D0 04 bne ?04
		958	3451 FE96BD A4 6D ldy <argm+3
		959	3452 FE96BF C4 65 cpy <facm+3
		960	3453 FE96C1 08 ?04: php
		961	3454 FE96C2 2A rol a
		962	3455 FE96C3 90 0D bcc ?06
		963	3456 FE96C5 E8 inx
		964	3457 FE96C6 E0 04 cpx #$04
		965	3458 FE96C8 B0 39 bcs ?14
		966	3459 ;dex ; here different !
		967	3460 ;bmi ?14 ; no store !
		968	3461 FE96CA 95 54 sta <factmp,x
		969	3462 FE96CC E0 03 cpx #$03
		970	3463 FE96CE F0 2F beq ?12
		971	3464 FE96D0 A9 01 lda #$01
		972	3465 FE96D2 28 ?06: plp
		973	3466 FE96D3 B0 0E bcs ?10
		974	3467 FE96D5 06 6D ?08: asl <argm+3
		975	3468 FE96D7 26 6C rol <argm+2
		976	3469 FE96D9 26 6B rol <argm+1
		977	3470 FE96DB 26 6A rol <argm
		978	3471 FE96DD B0 E2 bcs ?04
		979	3472 FE96DF 30 CA bmi ?02
		980	3473 FE96E1 10 DE bpl ?04
		981	3474 FE96E3 A8 ?10: tay
		982	3475 FE96E4 A5 6D lda <argm+3
		983	3476 FE96E6 E5 65 sbc <facm+3
		984	3477 FE96E8 85 6D sta <argm+3
		985	3478 FE96EA A5 6C lda <argm+2
		986	3479 FE96EC E5 64 sbc <facm+2
		987	3480 FE96EE 85 6C sta <argm+2
		988	3481 FE96F0 A5 6B lda <argm+1
		989	3482 FE96F2 E5 63 sbc <facm+1
		990	3483 FE96F4 85 6B sta <argm+1
		991	3484 FE96F6 A5 6A lda <argm
		992	3485 FE96F8 E5 62 sbc <facm
		993	Tue Jul 17 11:00:22 2018 Page 17
		994
		995
		996
		997
		998	3486 FE96FA 85 6A sta <argm
		999	3487 FE96FC 98 tya
		1000	3488 FE96FD 80 D6 bra ?08
		1001	3489 FE96FF A9 40 ?12: lda #$40
		1002	3490 FE9701 D0 CF bne ?06
		1003	3491 FE9703 0A ?14: asl a
		1004	3492 FE9704 0A asl a
		1005	3493 FE9705 0A asl a
		1006	3494 FE9706 0A asl a
		1007	3495 FE9707 0A asl a
		1008	3496 FE9708 0A asl a
		1009	3497 FE9709 85 70 sta <facbits
		1010	3498 FE970B 28 plp
		1011	3499 FE970C 80 12 bra XBB8F
		1012	3500 FE970E 24 96 ?16: bit <basic
		1013	3501 FE9710 30 09 bmi ?18
		1014	3502 FE9712 A6 97 ldx <runf
		1015	3503 FE9714 F0 05 beq ?18
		1016	3504 FE9716 A2 12 ldx #$12 ; pascal: division by zero
		1017	3505 FE9718 4C 50 1B jmp vpmerr
		1018	3506 FE971B A2 14 ?18: ldx #$14 ; division by zero
		1019	3507 FE971D 4C 47 01 jmp cbm_err
		1020	3508
		1021	3509 XBB8F: ; copy mantissa
		1022	3510 FE9720 A5 54 lda <factmp
		1023	3511 FE9722 85 62 sta <facm
		1024	3512 FE9724 A5 55 lda <factmp+1
		1025	3513 FE9726 85 63 sta <facm+1
		1026	3514 FE9728 A5 56 lda <factmp+2
		1027	3515 FE972A 85 64 sta <facm+2
		1028	3516 FE972C A5 57 lda <factmp+3
		1029	3517 FE972E 85 65 sta <facm+3
		1030	3518 FE9730 4C 7F 94 jmp XB8D7 ; normalize FAC #1
		1031	3519
		1032	3520 ;---------------------------------------------------------------------------
		1033	3521 ; move FAC #1 routines
		1034	3522 ;---------------------------------------------------------------------------
		1035	3523
		1036	3524 ; move float number at address AY in current data bank to FAC #1
		1037	3525 FE9733 XBBA2:
		1038	3526 FE9733 85 76 sta <longp
		1039	3527 FE9735 84 77 sty <longp+1
		1040	3528 FE9737 8B phb
		1041	3529 FE9738 FA plx
		1042	3530 FE9739 80 14 bra XBBA2X
		1043	3531 FE973B
		1044	3532 ; move float number at address AYX to FAC #1
		1045	3533 FE973B XBBA2L:
		1046	3534 FE973B 85 76 sta <longp
		1047	3535 FE973D 84 77 sty <longp+1
		1048	3536 FE973F 80 0E bra XBBA2X
		1049	3537
		1050	3538 ; move float number at address AY in data bank that hold FAC1TMP to FAC #1
		1051	3539 FE9741 XBBA2T:
		1052	3540 FE9741 85 76 sta <longp
		1053	3541 FE9743 84 77 sty <longp+1
		1054	3542 FE9745 A6 A2 ldx <vbnk
		1055	Tue Jul 17 11:00:22 2018 Page 18
		1056
		1057
		1058
		1059
		1060	3543 FE9747 80 06 bra XBBA2X
		1061	3544
		1062	3545 ; move float number at address AY in current program bank to FAC #1
		1063	3546 FE9749 XBBA2K:
		1064	3547 FE9749 85 76 sta <longp
		1065	3548 FE974B 84 77 sty <longp+1
		1066	3549 FE974D A2 FE ldx #^XBBA2K
		1067	3550 FE974F XBBA2X:
		1068	3551 FE974F 86 78 stx <longp+2
		1069	3552 FE9751 A0 04 ldy #4
		1070	3553 FE9753 B7 76 lda [longp],y
		1071	3554 FE9755 85 65 sta <facm+3
		1072	3555 FE9757 88 dey
		1073	3556 FE9758 B7 76 lda [longp],y
		1074	3557 FE975A 85 64 sta <facm+2
		1075	3558 FE975C 88 dey
		1076	3559 FE975D B7 76 lda [longp],y
		1077	3560 FE975F 85 63 sta <facm+1
		1078	3561 FE9761 88 dey
		1079	3562 FE9762 B7 76 lda [longp],y
		1080	3563 FE9764 85 66 sta <facsgn
		1081	3564 FE9766 09 80 ora #$80
		1082	3565 FE9768 85 62 sta <facm
		1083	3566 FE976A 88 dey
		1084	3567 FE976B B7 76 lda [longp],y
		1085	3568 FE976D 85 61 sta <facexp
		1086	3569 FE976F 84 70 sty <facbits
		1087	3570 FE9771 60 rts
		1088	3571
		1089	3572 ; round FAC #1 and move to FAC1TMP
		1090	3573 FE9772 XBBC7:
		1091	3574 FE9772 A2 E8 ldx #<FAC1TMP
		1092	3575 FE9774 A0 FF ldy #>FAC1TMP
		1093	3576 FE9776 A5 A2 lda <vbnk ; bank that hold FAC1TMP/FAC2TMP
		1094	3577 FE9778 80 1A bra XBBD4X
		1095	3578
		1096	3579 ; round FAC #1 and move to FAC2TMP
		1097	3580 FE977A XBBCA:
		1098	3581 FE977A A2 ED ldx #<FAC2TMP
		1099	3582 FE977C A0 FF ldy #>FAC2TMP
		1100	3583 FE977E A5 A2 lda <vbnk ; bank that hold FAC1TMP/FAC2TMP
		1101	3584 FE9780 80 12 bra XBBD4X
		1102	3585
		1103	3586 ; round FAC #1 and move to FAC3TMP
		1104	3587 FE9782 XBBX3:
		1105	3588 FE9782 A2 F2 ldx #<FAC3TMP
		1106	3589 FE9784 A0 FF ldy #>FAC3TMP
		1107	3590 FE9786 A5 A2 lda <vbnk ; bank that hold FAC1TMP/FAC2TMP
		1108	3591 FE9788 80 0A bra XBBD4X
		1109	3592
		1110	3593 ; round FAC #1 and move to forpnt and bank that hold basic variables
		1111	3594 FE978A XBBD0:
		1112	3595 FE978A A6 49 ldx <forpnt
		1113	3596 FE978C A4 4A ldy <forpnt+1
		1114	3597
		1115	3598 ; round FAC #1 and move to XY addr, in data bank that hold basic variables
		1116	3599 FE978E XBBD4V:
		1117	Tue Jul 17 11:00:22 2018 Page 19
		1118
		1119
		1120
		1121
		1122	3600 FE978E A5 A2 lda <vbnk
		1123	3601 FE9790 80 02 bra XBBD4X
		1124	3602 FE9792
		1125	3603 ; round FAC #1 and move to XY address in current data bank
		1126	3604 FE9792 XBBD4:
		1127	3605 FE9792 8B phb ; A = current data bank
		1128	3606 FE9793 68 pla
		1129	3607
		1130	3608 FE9794 XBBD4L:
		1131	3609 FE9794 XBBD4X:
		1132	3610 FE9794 86 76 stx <longp
		1133	3611 FE9796 84 77 sty <longp+1
		1134	3612 FE9798 85 78 sta <longp+2
		1135	3613 FE979A 20 DD 97 jsr XBC1B ; round FAC #1
		1136	3614 FE979D A0 04 ldy #$04
		1137	3615 FE979F A5 65 lda <facm+3
		1138	3616 FE97A1 97 76 sta [longp],y
		1139	3617 FE97A3 88 dey
		1140	3618 FE97A4 A5 64 lda <facm+2
		1141	3619 FE97A6 97 76 sta [longp],y
		1142	3620 FE97A8 88 dey
		1143	3621 FE97A9 A5 63 lda <facm+1
		1144	3622 FE97AB 97 76 sta [longp],y
		1145	3623 FE97AD 88 dey
		1146	3624 FE97AE A5 66 lda <facsgn
		1147	3625 FE97B0 09 7F ora #$7F
		1148	3626 FE97B2 25 62 and <facm
		1149	3627 FE97B4 97 76 sta [longp],y
		1150	3628 FE97B6 88 dey
		1151	3629 FE97B7 A5 61 lda <facexp
		1152	3630 FE97B9 97 76 sta [longp],y
		1153	3631 FE97BB 84 70 sty <facbits
		1154	3632 FE97BD 60 rts
		1155	3633
		1156	3634 XBBFC: ; move FAC #2 to FAC #1
		1157	3635 FE97BE A5 6E lda <argsgn
		1158	3636 XBBFE: ; set FAC #1 sign and move abs FAC #2 to FAC #1
		1159	3637 FE97C0 85 66 sta <facsgn
		1160	3638 FE97C2 A2 05 ldx #$05
		1161	3639 FE97C4 B5 68 ?02: lda <argexp-1,x
		1162	3640 FE97C6 95 60 sta <facexp-1,x
		1163	3641 FE97C8 CA dex
		1164	3642 FE97C9 D0 F9 bne ?02
		1165	3643 FE97CB 86 70 stx <facbits
		1166	3644 FE97CD 60 rts
		1167	3645
		1168	3646 XBC0C: ; round FAC #1 and move it to FAC #2
		1169	3647 FE97CE 20 DD 97 jsr XBC1B
		1170	3648
		1171	3649 XBC0F: ; move FAC #1 to FAC #2 without before rounding FAC #1
		1172	3650 FE97D1 A2 06 ldx #$06
		1173	3651 FE97D3 B5 60 ?02: lda <facexp-1,x
		1174	3652 FE97D5 95 68 sta <argexp-1,x
		1175	3653 FE97D7 CA dex
		1176	3654 FE97D8 D0 F9 bne ?02
		1177	3655 FE97DA 86 70 stx <facbits
		1178	3656 FE97DC 60 XBC1A: rts
		1179	Tue Jul 17 11:00:22 2018 Page 20
		1180
		1181
		1182
		1183
		1184	3657
		1185	3658 XBC1B: ; round FAC #1
		1186	3659 FE97DD A5 61 lda <facexp
		1187	3660 FE97DF F0 FB beq XBC1A
		1188	3661 FE97E1 06 70 asl <facbits
		1189	3662 FE97E3 90 F7 bcc XBC1A
		1190	3663
		1191	3664 XBC23: ; increment mantissa and normalize
		1192	3665 FE97E5 20 16 95 jsr XB96F
		1193	3666 FE97E8 D0 F2 bne XBC1A
		1194	3667 FE97EA 4C DF 94 jmp XB938
		1195	3668
		1196	3669 ;---------------------------------------------------------------------------
		1197	3670 ; sgn/abs function's
		1198	3671 ;---------------------------------------------------------------------------
		1199	3672
		1200	3673 XBC2B: ; get sign of FAC #1
		1201	3674 FE97ED A5 61 lda <facexp
		1202	3675 FE97EF F0 09 beq XBC38
		1203	3676 FE97F1 A5 66 XBC2F: lda <facsgn
		1204	3677 FE97F3 2A XBC31: rol a
		1205	3678 FE97F4 A9 FF lda #$FF
		1206	3679 FE97F6 B0 02 bcs XBC38
		1207	3680 FE97F8 A9 01 lda #$01
		1208	3681 FE97FA 60 XBC38: rts
		1209	3682
		1210	3683 XBC39: ; sign function (return a float)
		1211	3684 FE97FB 20 ED 97 jsr XBC2B
		1212	3685
		1213	3686 XBC3C: ; convert a signed byte in A to float format
		1214	3687 FE97FE 85 62 sta <facm
		1215	3688 FE9800 64 63 stz <facm+1
		1216	3689 FE9802 A2 88 ldx #$88 ; exponent for a byte
		1217	3690 FE9804 A5 62 XBC44: lda <facm
		1218	3691 FE9806 49 FF eor #$FF
		1219	3692 FE9808 2A rol a
		1220	3693 FE9809 A9 00 XBC49: lda #$00 ; CF = 1 positive, CF = 0 negative
		1221	3694 FE980B 85 65 sta <facm+3
		1222	3695 FE980D 85 64 sta <facm+2
		1223	3696 FE980F 86 61 XBC4F: stx <facexp
		1224	3697 FE9811 85 70 sta <facbits
		1225	3698 FE9813 85 66 sta <facsgn
		1226	3699 FE9815 4C 7A 94 jmp XB8D2 ; normalize FAC #1
		1227	3700
		1228	3701 XBC58: ; absolute value
		1229	3702 FE9818 64 66 stz <facsgn
		1230	3703 FE981A 60 rts
		1231	3704
		1232	3705 ;---------------------------------------------------------------------------
		1233	3706 ; comparison function's
		1234	3707 ;---------------------------------------------------------------------------
		1235	3708
		1236	3709 ; compare float at address AY in current data bank with FAC #1
		1237	3710 FE981B XBC5B:
		1238	3711 FE981B 85 76 sta <longp
		1239	3712 FE981D XBC5D:
		1240	3713 FE981D 84 77 sty <longp+1
		1241	Tue Jul 17 11:00:22 2018 Page 21
		1242
		1243
		1244
		1245
		1246	3714 FE981F 8B phb
		1247	3715 FE9820 FA plx
		1248	3716 FE9821 86 78 XBC5DX: stx <longp+2
		1249	3717 FE9823 A0 00 ldy #$00
		1250	3718 FE9825 B7 76 lda [longp],y
		1251	3719 FE9827 C8 iny
		1252	3720 FE9828 AA tax
		1253	3721 FE9829 F0 C2 beq XBC2B
		1254	3722 FE982B B7 76 lda [longp],y
		1255	3723 FE982D 45 66 eor <facsgn
		1256	3724 FE982F 30 C0 bmi XBC2F
		1257	3725 FE9831 E4 61 cpx <facexp
		1258	3726 FE9833 D0 21 bne XBC92
		1259	3727 FE9835 B7 76 lda [longp],y
		1260	3728 FE9837 09 80 ora #$80
		1261	3729 FE9839 C5 62 cmp <facm
		1262	3730 FE983B D0 19 bne XBC92
		1263	3731 FE983D C8 iny
		1264	3732 FE983E B7 76 lda [longp],y
		1265	3733 FE9840 C5 63 cmp <facm+1
		1266	3734 FE9842 D0 12 bne XBC92
		1267	3735 FE9844 C8 iny
		1268	3736 FE9845 B7 76 lda [longp],y
		1269	3737 FE9847 C5 64 cmp <facm+2
		1270	3738 FE9849 D0 0B bne XBC92
		1271	3739 FE984B C8 iny
		1272	3740 FE984C A9 7F lda #$7F
		1273	3741 FE984E C5 70 cmp <facbits
		1274	3742 FE9850 B7 76 lda [longp],y
		1275	3743 FE9852 E5 65 sbc <facm+3
		1276	3744 FE9854 F0 37 beq XBCBA
		1277	3745 FE9856 A5 66 XBC92: lda <facsgn
		1278	3746 FE9858 90 99 bcc XBC31
		1279	3747 FE985A 49 FF eor #$FF
		1280	3748 FE985C 80 95 bra XBC31
		1281	3749
		1282	3750 ; compare float at address AYK with FAC #1
		1283	3751 FE985E XBC5BK:
		1284	3752 FE985E 85 76 sta <longp
		1285	3753 FE9860 84 77 sty <longp+1
		1286	3754 FE9862 A2 FE ldx #^XBC5BK
		1287	3755 FE9864 80 BB bra XBC5DX
		1288	3756
		1289	3757 ; compare float at FAC1/2/3TMP with FAC #1
		1290	3758 FE9866 XBC5BT:
		1291	3759 FE9866 85 76 sta <longp
		1292	3760 FE9868 84 77 sty <longp+1
		1293	3761 FE986A A6 A2 ldx <vbnk
		1294	3762 FE986C 80 B3 bra XBC5DX
		1295	3763 FE986E
		1296	3764 ;---------------------------------------------------------------------------
		1297	3765 ; extraction of the integer part of FAC #1
		1298	3766 ;---------------------------------------------------------------------------
		1299	3767
		1300	3768 ; convert float FAC #1 in 4-bytes signed integer
		1301	3769 FE986E XBC9B:
		1302	3770 FE986E A5 61 lda <facexp
		1303	Tue Jul 17 11:00:22 2018 Page 22
		1304
		1305
		1306
		1307
		1308	3771 FE9870 F0 4A beq XBCE9
		1309	3772 FE9872 38 sec
		1310	3773 FE9873 E9 A0 sbc #$A0
		1311	3774 FE9875 24 66 bit <facsgn
		1312	3775 FE9877 10 09 bpl ?02
		1313	3776 FE9879 AA tax
		1314	3777 FE987A A9 FF lda #$FF
		1315	3778 FE987C 85 68 sta <facov
		1316	3779 FE987E 20 F4 94 jsr XB94D
		1317	3780 FE9881 8A txa
		1318	3781 FE9882 A2 61 ?02: ldx #facexp
		1319	3782 FE9884 C9 F9 cmp #$F9
		1320	3783 FE9886 10 06 bpl XBCBB
		1321	3784 FE9888 20 6B 95 jsr XB999
		1322	3785 FE988B 84 68 sty <facov
		1323	3786 ;stz <facov
		1324	3787 FE988D 60 XBCBA: rts
		1325	3788 FE988E A8 XBCBB: tay
		1326	3789 FE988F A5 66 lda <facsgn
		1327	3790 FE9891 29 80 and #$80
		1328	3791 FE9893 46 62 lsr <facm
		1329	3792 FE9895 05 62 ora <facm
		1330	3793 FE9897 85 62 sta <facm
		1331	3794 FE9899 20 82 95 jsr XB9B0
		1332	3795 FE989C 84 68 sty <facov
		1333	3796 ;stz <facov
		1334	3797 FE989E 60 rts
		1335	3798
		1336	3799 XBCCC: ; basic int() function
		1337	3800 FE989F A5 61 lda <facexp
		1338	3801 FE98A1 C9 A0 cmp #$A0
		1339	3802 FE98A3 B0 20 bcs XBCF2
		1340	3803 FE98A5 20 6E 98 jsr XBC9B
		1341	3804 FE98A8 84 70 sty <facbits
		1342	3805 FE98AA A5 66 lda <facsgn
		1343	3806 FE98AC 84 66 sty <facsgn
		1344	3807 FE98AE 49 80 eor #$80
		1345	3808 FE98B0 2A rol a
		1346	3809 FE98B1 A9 A0 lda #$A0
		1347	3810 FE98B3 85 61 sta <facexp
		1348	3811 FE98B5 A5 65 lda <facm+3
		1349	3812 FE98B7 85 5B sta <faclsb
		1350	3813 FE98B9 4C 7A 94 jmp XB8D2 ; normalize
		1351	3814
		1352	3815 XBCE9: ; clear FAC #1 mantissa
		1353	3816 FE98BC 85 62 sta <facm
		1354	3817 FE98BE 85 63 sta <facm+1
		1355	3818 FE98C0 85 64 sta <facm+2
		1356	3819 FE98C2 85 65 sta <facm+3
		1357	3820 FE98C4 A8 tay
		1358	3821 FE98C5 60 XBCF2: rts
		1359	3822
		1360	3823 ;---------------------------------------------------------------------------
		1361	3824 ; conversion decimal string to float
		1362	3825 ;---------------------------------------------------------------------------
		1363	3826
		1364	3827 ; conversion routine in pascal mode - return float in FAC1TMP and FAC #1
		1365	Tue Jul 17 11:00:22 2018 Page 23
		1366
		1367
		1368
		1369
		1370	3828 FE98C6 XBCF3P:
		1371	3829 FE98C6 A2 80 ldx #$80 ; trap overflow run time error
		1372	3830 FE98C8 86 79 stx <s2fptr ; this avoid run time error in conversion
		1373	3831 FE98CA 20 D8 98 jsr XBCF3 ; call conversion routine
		1374	3832 ; here return after an overflow error too
		1375	3833 FE98CD 64 9B stz <skpbk ; from now skip blank while scan string
		1376	3834 FE98CF 64 79 stz <s2fptr ; re-enable overflow error
		1377	3835 FE98D1 A5 72 lda <s2fer ; if not zero error pending exit with A <> 0
		1378	3836 FE98D3 D0 F0 bne XBCF2
		1379	3837 FE98D5 4C 04 03 jmp cbm_chrgot ; return last char scanned (must be zero)
		1380	3838 FE98D8
		1381	3839 ; conversion routine different from the one of cbm basic
		1382	3840 FE98D8 XBCF3:
		1383	3841 FE98D8 INDEX16
		1384	3842 FE98D8 C2 10 rep #PXFLAG
		1385	3843 .LONGI on
		1386	3844 .MNLIST
		1387	3845 FE98DA BA tsx ; save current stack pointer
		1388	3846 FE98DB 86 74 stx <s2fstk ; for error recover if pascal mode
		1389	3847 FE98DD INDEX08
		1390	3848 FE98DD E2 10 sep #PXFLAG
		1391	3849 .LONGI off
		1392	3850 .MNLIST
		1393	3851 FE98DF A2 1A ldx #(fbufpt2-argbits) ; clear working area
		1394	3852 FE98E1 74 59 ?02: stz <argbits,x
		1395	3853 FE98E3 CA dex
		1396	3854 FE98E4 10 FB bpl ?02
		1397	3855 FE98E6 64 9B stz <skpbk ; skip blank at string beginning
		1398	3856 FE98E8 20 04 03 jsr cbm_chrgot ; get first char. not blank
		1399	3857 FE98EB 90 11 bcc ?14 ; first char is digit: after don't skip blank
		1400	3858 FE98ED C9 2B cmp #'+' ; at beginning only '+' or '-' allowed
		1401	3859 FE98EF F0 08 beq ?10 ; next char (still skip blanks)
		1402	3860 FE98F1 C9 2D cmp #'-'
		1403	3861 FE98F3 D0 64 bne ?36 ; end conversion: exit with float = 0
		1404	3862 FE98F5 A2 80 ldx #$80
		1405	3863 FE98F7 86 67 stx <sgnfg ; set flag minus sign
		1406	3864 FE98F9 20 FE 02 ?10: jsr cbm_chrget ; next char after sign: expected a digit
		1407	3865 FE98FC B0 57 bcs ?35a ; error: no digit or end of string
		1408	3866 FE98FE A2 80 ?14: ldx #$80
		1409	3867 FE9900 86 9B stx <skpbk ; from now don't skip blank
		1410	3868 FE9902 20 84 99 ?16: jsr XBD6A ; add digit to partial FAC #1
		1411	3869 FE9905 20 FE 02 ?18: jsr cbm_chrget ; next char
		1412	3870 FE9908 90 F8 bcc ?16 ; is a digit
		1413	3871 FE990A C9 2E cmp #'.' ; is decimal dot ?
		1414	3872 FE990C F0 3C beq ?35 ; set dot flag
		1415	3873 FE990E C9 45 cmp #'E' ; exponential form ?
		1416	3874 FE9910 F0 04 beq ?22
		1417	3875 FE9912 C9 65 cmp #'e'
		1418	3876 FE9914 D0 43 bne ?36 ; end conversion: setup float (no exponent)
		1419	3877 FE9916 20 FE 02 ?22: jsr cbm_chrget ; next char: expected a digit or a sign
		1420	3878 FE9919 90 1F bcc ?32 ; if digit add to partial exponent value
		1421	3879 FE991B C9 2B cmp #'+'
		1422	3880 FE991D F0 16 beq ?30 ; get next exponent digit
		1423	3881 FE991F 24 96 bit <basic
		1424	3882 FE9921 10 04 bpl ?24 ; token only in basic mode
		1425	3883 FE9923 C9 AA cmp #$AA ; token '+' in basic mode
		1426	3884 FE9925 F0 0E beq ?30 ; get next exponent digit
		1427	Tue Jul 17 11:00:22 2018 Page 24
		1428
		1429
		1430
		1431
		1432	3885 FE9927 C9 2D ?24: cmp #'-'
		1433	3886 FE9929 F0 08 beq ?28 ; set exponent sign flag
		1434	3887 FE992B 24 96 bit <basic
		1435	3888 FE992D 10 10 bpl ?34 ; end: setup float with exponent
		1436	3889 FE992F C9 AB cmp #$AB ; token '-' in basic mode
		1437	3890 FE9931 D0 0C bne ?34 ; end: setup float with exponent
		1438	3891 FE9933 66 60 ?28: ror <expsgn ; here CF = 1 so bit 7 = 1
		1439	3892 FE9935 20 FE 02 ?30: jsr cbm_chrget ; next exponent digit
		1440	3893 FE9938 B0 05 bcs ?34 ; no digit -- end of exponent scan
		1441	3894 FE993A 20 A5 99 ?32: jsr XBD91 ; evaluate partial exponent
		1442	3895 FE993D 80 F6 bra ?30 ; next digit
		1443	3896 FE993F 24 60 ?34: bit <expsgn ; evaluate full exponent value
		1444	3897 FE9941 10 16 bpl ?36 ; positive exponent
		1445	3898 FE9943 A9 00 lda #0
		1446	3899 FE9945 38 sec
		1447	3900 FE9946 E5 5E sbc <expval ; negative exponent
		1448	3901 FE9948 80 11 bra ?38
		1449	3902 FE994A 66 5F ?35: ror <dotfg ; here CF = 1 - set dot flag
		1450	3903 FE994C 24 5F bit <dotfg ; check if already dot flag
		1451	3904 FE994E 70 05 bvs ?35a ; more than one only decimal dot
		1452	3905 FE9950 20 FE 02 jsr cbm_chrget ; after decimal dot expected one digit
		1453	3906 FE9953 90 AD bcc ?16 ; ok, add digit to float and continue scan
		1454	3907 FE9955 A2 80 ?35a: ldx #$80 ; 2 dot or no digit after dot or after sign
		1455	3908 FE9957 86 72 stx <s2fer ; set conversion error
		1456	3909 FE9959 A5 5E ?36: lda <expval ; exponent value
		1457	3910 FE995B 38 ?38: sec ; compute true exponent
		1458	3911 FE995C E5 5D sbc <dccnt ; subtract decimal place number
		1459	3912 FE995E 85 5E sta <expval
		1460	3913 FE9960 F0 12 beq ?44 ; no adjustment
		1461	3914 FE9962 10 09 bpl ?42 ; mult * 10 loop
		1462	3915 FE9964 20 81 96 ?40: jsr XBAFE ; div / 10 loop
		1463	3916 FE9967 E6 5E inc <expval
		1464	3917 FE9969 D0 F9 bne ?40
		1465	3918 FE996B F0 07 beq ?44
		1466	3919 FE996D 20 6A 96 ?42: jsr XBAE2 ; mult * 10 loop
		1467	3920 FE9970 C6 5E dec <expval
		1468	3921 FE9972 D0 F9 bne ?42
		1469	3922 FE9974 A5 67 ?44: lda <sgnfg
		1470	3923 FE9976 10 03 bpl ?46 ; positive float
		1471	3924 FE9978 20 4A 9B jsr XBFB4 ; negate float
		1472	3925 FE997B 64 9B ?46: stz <skpbk ; from now skip blank while scan string
		1473	3926 FE997D 24 96 bit <basic
		1474	3927 FE997F 30 42 bmi XBDB0 ; finish here in basic mode
		1475	3928 FE9981 4C 72 97 jmp XBBC7 ; round FAC #1 and move to FAC1TMP
		1476	3929
		1477	3930 XBD6A: ; accumulate current digit in A into FAC #1
		1478	3931 FE9984 48 pha
		1479	3932 FE9985 24 5F bit <dotfg
		1480	3933 FE9987 10 02 bpl ?02
		1481	3934 FE9989 E6 5D inc <dccnt ; increment decimal digit count
		1482	3935 FE998B 20 6A 96 ?02: jsr XBAE2 ; [FAC #1] * 10
		1483	3936 FE998E 68 pla
		1484	3937 FE998F 38 sec
		1485	3938 FE9990 E9 30 sbc #$30
		1486	3939
		1487	3940 XBD7E: ; add a byte value to FAC #1
		1488	3941 FE9992 48 pha
		1489	Tue Jul 17 11:00:22 2018 Page 25
		1490
		1491
		1492
		1493
		1494	3942 FE9993 20 CE 97 jsr XBC0C ; round FAC #1 and move to FAC #2
		1495	3943 FE9996 68 pla
		1496	3944 FE9997 20 FE 97 jsr XBC3C ; convert byte A in float in FAC #1
		1497	3945 FE999A A5 6E lda <argsgn
		1498	3946 FE999C 45 66 eor <facsgn
		1499	3947 FE999E 85 6F sta <arisgn
		1500	3948 FE99A0 A6 61 ldx <facexp
		1501	3949 FE99A2 4C 0C 94 jmp XB86A ; add FAC #1 and FAC #2
		1502	3950
		1503	3951 XBD91: ; compute partial exponent
		1504	3952 FE99A5 E9 2F sbc #$2F ; here come with CF = 0
		1505	3953 FE99A7 85 5C sta <tmpb1 ; save digit
		1506	3954 FE99A9 A5 5E lda <expval ; current exponent value
		1507	3955 FE99AB C9 0A cmp #$0A
		1508	3956 FE99AD 90 09 bcc ?02 ; exponent < 10 -> can mult *10
		1509	3957 FE99AF A9 64 lda #$64 ; max. exp. = +/-100
		1510	3958 FE99B1 24 60 bit <expsgn
		1511	3959 FE99B3 30 0C bmi ?04 ; min. negative exponent = -100
		1512	3960 FE99B5 4C 25 95 jmp XB97E ; overflow if exponent positive
		1513	3961 FE99B8 0A ?02: asl a ; mult. partial exponent *10
		1514	3962 FE99B9 0A asl a
		1515	3963 FE99BA 18 clc
		1516	3964 FE99BB 65 5E adc <expval
		1517	3965 FE99BD 0A asl a
		1518	3966 FE99BE 18 clc
		1519	3967 FE99BF 65 5C adc <tmpb1 ; add current digit
		1520	3968 FE99C1 85 5E ?04: sta <expval ; store exponent
		1521	3969 FE99C3 60 XBDB0: rts
		1522	3970
		1523	3971 ;---------------------------------------------------------------------------
		1524	3972 ; conversion float to decimal string
		1525	3973 ;---------------------------------------------------------------------------
		1526	3974
		1527	3975 ; final string is TTNUMSTR in variables/p-code bank
		1528	3976 FE99C4 XBDDD:
		1529	3977 FE99C4 A0 01 ldy #$01 ; index to final string
		1530	3978 FE99C6 XBDDF:
		1531	3979 FE99C6 8B phb ; save current data bank
		1532	3980 FE99C7 A5 A2 lda <vbnk
		1533	3981 FE99C9 48 pha
		1534	3982 FE99CA AB plb
		1535	3983 FE99CB A9 20 lda #' '
		1536	3984 FE99CD 24 66 bit <facsgn
		1537	3985 FE99CF 10 02 bpl ?02
		1538	3986 FE99D1 A9 2D lda #'-'
		1539	3987 FE99D3 99 59 FF ?02: sta !TTNUMSTR-1,y
		1540	3988 FE99D6 64 66 stz <facsgn
		1541	3989 FE99D8 84 71 sty <decidx
		1542	3990 FE99DA C8 iny
		1543	3991 FE99DB A9 30 lda #$30
		1544	3992 FE99DD A6 61 ldx <facexp
		1545	3993 FE99DF D0 03 bne ?04
		1546	3994 FE99E1 4C FC 9A jmp ?58
		1547	3995 FE99E4 A9 00 ?04: lda #$00
		1548	3996 FE99E6 E0 80 cpx #$80
		1549	3997 FE99E8 F0 02 beq ?06
		1550	3998 FE99EA B0 0B bcs ?08
		1551	Tue Jul 17 11:00:22 2018 Page 26
		1552
		1553
		1554
		1555
		1556	3999 FE99EC A9 EE ?06: lda #<XBDBD
		1557	4000 FE99EE A0 9C ldy #>XBDBD
		1558	4001 FE99F0 A2 FE ldx #^XBDDD
		1559	4002 FE99F2 20 DF 95 jsr XBA28 ; mult
		1560	4003 FE99F5 A9 F7 lda #$F7
		1561	4004 FE99F7 85 5D ?08: sta <dccnt
		1562	4005 FE99F9 A9 E9 ?10: lda #<XBDB8 ; manage float so 1e8 <= x <= 1e9
		1563	4006 FE99FB A0 9C ldy #>XBDB8
		1564	4007 FE99FD 20 5E 98 jsr XBC5BK
		1565	4008 FE9A00 F0 1E beq ?20
		1566	4009 FE9A02 10 12 bpl ?16
		1567	4010 FE9A04 A9 E4 ?12: lda #<XBDB3
		1568	4011 FE9A06 A0 9C ldy #>XBDB3
		1569	4012 FE9A08 20 5E 98 jsr XBC5BK
		1570	4013 FE9A0B F0 02 beq ?14
		1571	4014 FE9A0D 10 0E bpl ?18
		1572	4015 FE9A0F 20 6A 96 ?14: jsr XBAE2 ; mult * 10
		1573	4016 FE9A12 C6 5D dec <dccnt
		1574	4017 FE9A14 D0 EE bne ?12
		1575	4018 FE9A16 20 81 96 ?16: jsr XBAFE ; div by 10
		1576	4019 FE9A19 E6 5D inc <dccnt
		1577	4020 FE9A1B D0 DC bne ?10
		1578	4021 FE9A1D 20 ED 93 ?18: jsr XB849 ; round to +0.5
		1579	4022 FE9A20 20 6E 98 ?20: jsr XBC9B ; convert to integer 32 bits
		1580	4023 FE9A23 A2 01 ldx #$01
		1581	4024 FE9A25 A5 5D lda <dccnt
		1582	4025 FE9A27 18 clc
		1583	4026 FE9A28 69 0A adc #$0A
		1584	4027 FE9A2A 30 09 bmi ?22
		1585	4028 FE9A2C C9 0B cmp #$0B
		1586	4029 FE9A2E B0 06 bcs ?24
		1587	4030 FE9A30 69 FF adc #$FF
		1588	4031 FE9A32 AA tax
		1589	4032 FE9A33 A9 02 lda #$02
		1590	4033 FE9A35 38 ?22: sec
		1591	4034 FE9A36 E9 02 ?24: sbc #$02
		1592	4035 FE9A38 85 5E sta <expval
		1593	4036 FE9A3A 86 5D stx <dccnt
		1594	4037 FE9A3C 8A txa
		1595	4038 FE9A3D F0 02 beq ?26 ; decimal form
		1596	4039 FE9A3F 10 19 bpl ?30 ; exponential form
		1597	4040 FE9A41 A4 71 ?26: ldy <decidx
		1598	4041 FE9A43 A9 30 lda #'0' ; store '0.' or '0.0'
		1599	4042 FE9A45 C8 iny
		1600	4043 FE9A46 99 59 FF sta !TTNUMSTR-1,y
		1601	4044 FE9A49 A9 2E lda #$2E
		1602	4045 FE9A4B C8 iny
		1603	4046 FE9A4C 99 59 FF sta !TTNUMSTR-1,y
		1604	4047 FE9A4F 8A txa
		1605	4048 FE9A50 F0 06 beq ?28
		1606	4049 FE9A52 A9 30 lda #$30
		1607	4050 FE9A54 C8 iny
		1608	4051 FE9A55 99 59 FF sta !TTNUMSTR-1,y
		1609	4052 FE9A58 84 71 ?28: sty <decidx
		1610	4053 FE9A5A A0 00 ?30: ldy #$00
		1611	4054 FE9A5C A2 80 ldx #$80
		1612	4055 FE9A5E 8B ?32: phb
		1613	Tue Jul 17 11:00:22 2018 Page 27
		1614
		1615
		1616
		1617
		1618	4056 FE9A5F 4B phk
		1619	4057 FE9A60 AB plb
		1620	4058 FE9A61 A5 65 ?34: lda <facm+3
		1621	4059 FE9A63 18 clc
		1622	4060 FE9A64 79 F6 9C adc !XBF16+3,y
		1623	4061 FE9A67 85 65 sta <facm+3
		1624	4062 FE9A69 A5 64 lda <facm+2
		1625	4063 FE9A6B 79 F5 9C adc !XBF16+2,y
		1626	4064 FE9A6E 85 64 sta <facm+2
		1627	4065 FE9A70 A5 63 lda <facm+1
		1628	4066 FE9A72 79 F4 9C adc !XBF16+1,y
		1629	4067 FE9A75 85 63 sta <facm+1
		1630	4068 FE9A77 A5 62 lda <facm
		1631	4069 FE9A79 79 F3 9C adc !XBF16,y
		1632	4070 FE9A7C 85 62 sta <facm
		1633	4071 FE9A7E E8 inx
		1634	4072 FE9A7F B0 04 bcs ?36
		1635	4073 FE9A81 10 DE bpl ?34
		1636	4074 FE9A83 30 02 bmi ?38
		1637	4075 FE9A85 30 DA ?36: bmi ?34
		1638	4076 FE9A87 8A ?38: txa
		1639	4077 FE9A88 90 04 bcc ?40
		1640	4078 FE9A8A 49 FF eor #$FF
		1641	4079 FE9A8C 69 0A adc #$0A
		1642	4080 FE9A8E 69 2F ?40: adc #$2F
		1643	4081 FE9A90 C8 iny
		1644	4082 FE9A91 C8 iny
		1645	4083 FE9A92 C8 iny
		1646	4084 FE9A93 C8 iny
		1647	4085 FE9A94 84 73 sty <decidx2
		1648	4086 FE9A96 A4 71 ldy <decidx
		1649	4087 FE9A98 C8 iny
		1650	4088 FE9A99 AA tax
		1651	4089 FE9A9A 29 7F and #$7F
		1652	4090 FE9A9C AB plb
		1653	4091 FE9A9D 99 59 FF sta !TTNUMSTR-1,y
		1654	4092 FE9AA0 C6 5D dec <dccnt
		1655	4093 FE9AA2 D0 06 bne ?42
		1656	4094 FE9AA4 A9 2E lda #$2E
		1657	4095 FE9AA6 C8 iny
		1658	4096 FE9AA7 99 59 FF sta !TTNUMSTR-1,y
		1659	4097 FE9AAA 84 71 ?42: sty <decidx
		1660	4098 FE9AAC A4 73 ldy <decidx2
		1661	4099 FE9AAE 8A txa
		1662	4100 FE9AAF 49 FF eor #$FF
		1663	4101 FE9AB1 29 80 and #$80
		1664	4102 FE9AB3 AA tax
		1665	4103 FE9AB4 C0 24 cpy #$24
		1666	4104 FE9AB6 F0 04 beq ?44
		1667	4105 FE9AB8 C0 3C cpy #$3C
		1668	4106 FE9ABA D0 A2 bne ?32
		1669	4107 FE9ABC A4 71 ?44: ldy <decidx
		1670	4108 FE9ABE B9 59 FF ?46: lda !TTNUMSTR-1,y
		1671	4109 FE9AC1 88 dey
		1672	4110 FE9AC2 C9 30 cmp #$30
		1673	4111 FE9AC4 F0 F8 beq ?46
		1674	4112 FE9AC6 C9 2E cmp #$2E
		1675	Tue Jul 17 11:00:22 2018 Page 28
		1676
		1677
		1678
		1679
		1680	4113 FE9AC8 F0 01 beq ?48
		1681	4114 FE9ACA C8 iny
		1682	4115 FE9ACB A9 2B ?48: lda #$2B
		1683	4116 FE9ACD A6 5E ldx <expval
		1684	4117 FE9ACF F0 2E beq ?60
		1685	4118 FE9AD1 10 08 bpl ?50
		1686	4119 FE9AD3 A9 00 lda #$00
		1687	4120 FE9AD5 38 sec
		1688	4121 FE9AD6 E5 5E sbc <expval
		1689	4122 FE9AD8 AA tax
		1690	4123 FE9AD9 A9 2D lda #$2D
		1691	4124 FE9ADB 99 5B FF ?50: sta !TTNUMSTR+1,y
		1692	4125 FE9ADE A9 45 lda #$45
		1693	4126 FE9AE0 99 5A FF sta !TTNUMSTR,y
		1694	4127 FE9AE3 8A txa
		1695	4128 FE9AE4 A2 2F ldx #$2F
		1696	4129 FE9AE6 38 sec
		1697	4130 FE9AE7 E8 ?52: inx
		1698	4131 FE9AE8 E9 0A sbc #$0A
		1699	4132 FE9AEA B0 FB bcs ?52
		1700	4133 FE9AEC 69 3A adc #$3A
		1701	4134 FE9AEE 99 5D FF sta !TTNUMSTR+3,y
		1702	4135 FE9AF1 8A txa
		1703	4136 FE9AF2 99 5C FF sta !TTNUMSTR+2,y
		1704	4137 FE9AF5 A9 00 lda #$00
		1705	4138 FE9AF7 99 5E FF sta !TTNUMSTR+4,y
		1706	4139 FE9AFA F0 08 beq ?62
		1707	4140 FE9AFC 99 59 FF ?58: sta !TTNUMSTR-1,y
		1708	4141 FE9AFF A9 00 ?60: lda #$00
		1709	4142 FE9B01 99 5A FF sta !TTNUMSTR,y
		1710	4143 FE9B04 AB ?62: plb ; restore data bank
		1711	4144 FE9B05 A9 5A lda #<TTNUMSTR
		1712	4145 FE9B07 A0 FF ldy #>TTNUMSTR
		1713	4146 FE9B09 60 rts
		1714	4147
		1715	4148 ;---------------------------------------------------------------------------
		1716	4149 ; sqrt() function implementation - sqrt(x) = exp(ln(x) * 0.5)
		1717	4150 ;---------------------------------------------------------------------------
		1718	4151
		1719	4152 ; compute SQRT([FAC #1])
		1720	4153 FE9B0A XBF71:
		1721	4154 FE9B0A 20 CE 97 jsr XBC0C ; round FAC #1 and move to FAC #2
		1722	4155 FE9B0D A9 AC lda #<FCON05
		1723	4156 FE9B0F A0 9C ldy #>FCON05
		1724	4157 FE9B11 20 49 97 jsr XBBA2K ; move AYK to FAC #1
		1725	4158
		1726	4159 ;---------------------------------------------------------------------------
		1727	4160 ; power() function implementation - power(x,y) = x^y = exp(ln(x) * y)
		1728	4161 ;---------------------------------------------------------------------------
		1729	4162
		1730	4163 ; compute [FAC #2] ^ [FAC #1] - A = FAC #1 exponent
		1731	4164 FE9B14 XBF7B:
		1732	4165 FE9B14 F0 3F beq XBFED ; if null go to exp(0)
		1733	4166 FE9B16 A5 69 lda <argexp
		1734	4167 FE9B18 D0 03 bne ?02
		1735	4168 FE9B1A 4C A1 94 jmp XB8F9
		1736	4169 FE9B1D 20 82 97 ?02: jsr XBBX3 ; round FAC #1 and move to FAC3TMP
		1737	Tue Jul 17 11:00:22 2018 Page 29
		1738
		1739
		1740
		1741
		1742	4170 FE9B20 A5 6E lda <argsgn
		1743	4171 FE9B22 10 0F bpl ?04
		1744	4172 FE9B24 20 9F 98 jsr XBCCC ; to int
		1745	4173 FE9B27 A9 F2 lda #<FAC3TMP
		1746	4174 FE9B29 A0 FF ldy #>FAC3TMP
		1747	4175 FE9B2B 20 66 98 jsr XBC5BT ; compare in temp. fac bank
		1748	4176 FE9B2E D0 03 bne ?04
		1749	4177 FE9B30 98 tya
		1750	4178 FE9B31 A4 5B ldy <faclsb
		1751	4179 FE9B33 20 C0 97 ?04: jsr XBBFE ; copy FAC #1 to #FAC #2
		1752	4180 FE9B36 5A phy
		1753	4181 FE9B37 20 8E 95 jsr XB9EA ; compute ln()
		1754	4182 FE9B3A A9 F2 lda #<FAC3TMP
		1755	4183 FE9B3C A0 FF ldy #>FAC3TMP
		1756	4184 FE9B3E A6 A2 ldx <vbnk ; bank that old FAC3TMP
		1757	4185 FE9B40 20 DF 95 jsr XBA28 ; mult with FAC3TMP
		1758	4186 FE9B43 20 55 9B jsr XBFED ; compute exp()
		1759	4187 FE9B46 68 pla
		1760	4188 FE9B47 4A lsr a
		1761	4189 FE9B48 90 0A bcc XBFBE ; if even
		1762	4190
		1763	4191 XBFB4: ; change sign
		1764	4192 FE9B4A A5 61 lda <facexp
		1765	4193 FE9B4C F0 06 beq XBFBE
		1766	4194 FE9B4E A5 66 lda <facsgn
		1767	4195 FE9B50 49 FF eor #$FF
		1768	4196 FE9B52 85 66 sta <facsgn
		1769	4197 FE9B54 60 XBFBE: rts
		1770	4198
		1771	4199 ;---------------------------------------------------------------------------
		1772	4200 ; exp() function implementation
		1773	4201 ;---------------------------------------------------------------------------
		1774	4202
		1775	4203 ; compute exp([FAC #1])
		1776	4204 FE9B55 XBFED:
		1777	4205 FE9B55 A9 DA lda #<XBFBF ; 1/LN(2)
		1778	4206 FE9B57 A0 9C ldy #>XBFBF
		1779	4207 FE9B59 A2 FE ldx #^XBFBF ; current program bank
		1780	4208 FE9B5B 20 DF 95 jsr XBA28 ; mult 1/LN(2)
		1781	4209 FE9B5E A5 70 lda <facbits
		1782	4210 FE9B60 69 50 adc #$50
		1783	4211 FE9B62 90 03 bcc ?02
		1784	4212 FE9B64 20 E5 97 jsr XBC23 ; increment mantissa
		1785	4213 FE9B67 85 59 ?02: sta <argbits
		1786	4214 FE9B69 20 D1 97 jsr XBC0F ; copy FAC # 1 to FAC #2 (no rounding before)
		1787	4215 FE9B6C A5 61 lda <facexp
		1788	4216 FE9B6E C9 88 cmp #$88
		1789	4217 FE9B70 90 03 bcc ?06
		1790	4218 FE9B72 20 5C 96 ?04: jsr XBAD4
		1791	4219 FE9B75 20 9F 98 ?06: jsr XBCCC ; compute integer part
		1792	4220 FE9B78 A5 5B lda <faclsb
		1793	4221 FE9B7A 18 clc
		1794	4222 FE9B7B 69 81 adc #$81
		1795	4223 FE9B7D F0 F3 beq ?04
		1796	4224 FE9B7F 38 sec
		1797	4225 FE9B80 E9 01 sbc #$01
		1798	4226 FE9B82 48 pha
		1799	Tue Jul 17 11:00:22 2018 Page 30
		1800
		1801
		1802
		1803
		1804	4227 FE9B83 A2 05 ldx #$05 ; exchange FAC #1 and FAC #2
		1805	4228 FE9B85 B5 69 ?08: lda <argexp,x
		1806	4229 FE9B87 B4 61 ldy <facexp,x
		1807	4230 FE9B89 95 61 sta <facexp,x
		1808	4231 FE9B8B 94 69 sty <argexp,x
		1809	4232 FE9B8D CA dex
		1810	4233 FE9B8E 10 F5 bpl ?08
		1811	4234 FE9B90 A5 59 lda <argbits
		1812	4235 FE9B92 85 70 sta <facbits
		1813	4236 FE9B94 20 F6 93 jsr XB853 ; [FAC #2] - [FAC #1]
		1814	4237 FE9B97 20 4A 9B jsr XBFB4 ; negate FAC #1
		1815	4238 FE9B9A A9 17 lda #<XBFC4 ; compute exp() polynomial
		1816	4239 FE9B9C A0 9D ldy #>XBFC4
		1817	4240 FE9B9E 20 C3 9B jsr XE059
		1818	4241 FE9BA1 64 6F stz <arisgn
		1819	4242 FE9BA3 68 pla
		1820	4243 FE9BA4 4C 40 96 jmp XBAB9 ; add exponent
		1821	4244 FE9BA7
		1822	4245 ;---------------------------------------------------------------------------
		1823	4246 ; series evaluation implementation
		1824	4247 ;---------------------------------------------------------------------------
		1825	4248
		1826	4249 FE9BA7 XE043:
		1827	4250 FE9BA7 85 71 sta <fbufpt
		1828	4251 FE9BA9 84 72 sty <fbufpt+1
		1829	4252 FE9BAB 20 7A 97 jsr XBBCA ; round FAC #1 and move it to FAC2TMP
		1830	4253 FE9BAE A9 ED lda #<FAC2TMP
		1831	4254 FE9BB0 A0 FF ldy #>FAC2TMP
		1832	4255 FE9BB2 A6 A2 ldx <vbnk ; bank that old FAC2TMP
		1833	4256 FE9BB4 20 DF 95 jsr XBA28 ; compute X^2
		1834	4257 FE9BB7 20 C7 9B jsr XE05D ; compute P(X^2)
		1835	4258 FE9BBA A9 ED lda #<FAC2TMP
		1836	4259 FE9BBC A0 FF ldy #>FAC2TMP
		1837	4260 FE9BBE A6 A2 ldx <vbnk ; bank that old FAC2TMP
		1838	4261 FE9BC0 4C DF 95 jmp XBA28 ; compute X*P(X^2)
		1839	4262 FE9BC3
		1840	4263 FE9BC3 XE059:
		1841	4264 FE9BC3 85 71 sta <fbufpt
		1842	4265 FE9BC5 84 72 sty <fbufpt+1
		1843	4266 FE9BC7 XE05D:
		1844	4267 FE9BC7 20 72 97 jsr XBBC7 ; round FAC #1 and move it to FAC1TMP
		1845	4268 FE9BCA A9 FE lda #^XE043
		1846	4269 FE9BCC 85 73 sta <fbufpt+2 ; polynomial coefficient in program bank
		1847	4270 FE9BCE B7 71 lda [fbufpt],y
		1848	4271 FE9BD0 85 67 sta <sercnt ; number of coefficients
		1849	4272 FE9BD2 A5 71 lda <fbufpt
		1850	4273 FE9BD4 1A inc a
		1851	4274 FE9BD5 D0 02 bne ?02
		1852	4275 FE9BD7 E6 72 inc <fbufpt+1
		1853	4276 FE9BD9 85 71 ?02: sta <fbufpt
		1854	4277 FE9BDB A4 72 ldy <fbufpt+1
		1855	4278 FE9BDD A6 73 ldx <fbufpt+2
		1856	4279 FE9BDF 20 DF 95 ?04: jsr XBA28 ; [FAC #1] * coeff[n]
		1857	4280 FE9BE2 A5 71 lda <fbufpt
		1858	4281 FE9BE4 A4 72 ldy <fbufpt+1
		1859	4282 FE9BE6 18 clc
		1860	4283 FE9BE7 69 05 adc #$05
		1861	Tue Jul 17 11:00:22 2018 Page 31
		1862
		1863
		1864
		1865
		1866	4284 FE9BE9 90 01 bcc ?06
		1867	4285 FE9BEB C8 iny
		1868	4286 FE9BEC 85 71 ?06: sta <fbufpt
		1869	4287 FE9BEE 84 72 sty <fbufpt+1
		1870	4288 FE9BF0 20 09 94 jsr XB867 ; [FAC #1] + coeff[n+1]
		1871	4289 FE9BF3 A9 E8 lda #<FAC1TMP
		1872	4290 FE9BF5 A0 FF ldy #>FAC1TMP
		1873	4291 FE9BF7 A6 A2 ldx <vbnk ; bank that old FAC1TMP
		1874	4292 FE9BF9 C6 67 dec <sercnt
		1875	4293 FE9BFB D0 E2 bne ?04
		1876	4294 FE9BFD 60 XE0X: rts
		1877	4295
		1878	4296 ;---------------------------------------------------------------------------
		1879	4297 ; arctan() function implementation
		1880	4298 ;---------------------------------------------------------------------------
		1881	4299
		1882	4300 FE9BFE XE30E:
		1883	4301 FE9BFE A5 66 lda <facsgn
		1884	4302 FE9C00 48 pha
		1885	4303 FE9C01 10 03 bpl ?02
		1886	4304 FE9C03 20 4A 9B jsr XBFB4 ; change sign
		1887	4305 FE9C06 A5 61 ?02: lda <facexp
		1888	4306 FE9C08 48 pha
		1889	4307 FE9C09 C9 81 cmp #$81
		1890	4308 FE9C0B 90 09 bcc ?04 ; x <= 1
		1891	4309 FE9C0D A9 A2 lda #<XB9BC ; 1.0
		1892	4310 FE9C0F A0 9C ldy #>XB9BC
		1893	4311 FE9C11 A2 FE ldx #^XE30E
		1894	4312 FE9C13 20 91 96 jsr XBB0F ; x = 1/x
		1895	4313 FE9C16 A9 6E ?04: lda #<XE33E ; polynomial table
		1896	4314 FE9C18 A0 9D ldy #>XE33E
		1897	4315 FE9C1A 20 A7 9B jsr XE043
		1898	4316 FE9C1D 68 pla
		1899	4317 FE9C1E C9 81 cmp #$81
		1900	4318 FE9C20 90 07 bcc ?06
		1901	4319 FE9C22 A9 40 lda #<XE2E0 ; pi / 2
		1902	4320 FE9C24 A0 9D ldy #>XE2E0
		1903	4321 FE9C26 20 F3 93 jsr XB850 ; pi/2 - [FAC 31]
		1904	4322 FE9C29 68 ?06: pla
		1905	4323 FE9C2A 10 D1 bpl XE0X ; exit
		1906	4324 FE9C2C 4C 4A 9B jmp XBFB4 ; change sign
		1907	4325
		1908	4326 ;---------------------------------------------------------------------------
		1909	4327 ; cos() function implementation -- cos(x) = sin(x + pi/2)
		1910	4328 ;---------------------------------------------------------------------------
		1911	4329
		1912	4330 ; compute cos([FAC #1])
		1913	4331 FE9C2F XE264:
		1914	4332 FE9C2F A9 40 lda #<XE2E0 ; PI/2
		1915	4333 FE9C31 A0 9D ldy #>XE2E0
		1916	4334 FE9C33 20 09 94 jsr XB867
		1917	4335
		1918	4336 ;---------------------------------------------------------------------------
		1919	4337 ; sin() function implementation
		1920	4338 ;---------------------------------------------------------------------------
		1921	4339
		1922	4340 ; compute sin([FAC #1])
		1923	Tue Jul 17 11:00:22 2018 Page 32
		1924
		1925
		1926
		1927
		1928	4341 FE9C36 XE26B:
		1929	4342 FE9C36 20 CE 97 jsr XBC0C ; round FAC #1 and move to FAC #2
		1930	4343 FE9C39 A9 45 lda #<XE2E5 ; 2 * PI
		1931	4344 FE9C3B A0 9D ldy #>XE2E5
		1932	4345 FE9C3D A6 6E ldx <argsgn
		1933	4346 FE9C3F 20 8A 96 jsr XBB07 ; divide by 2*pi (reduction angle)
		1934	4347 FE9C42 20 CE 97 jsr XBC0C ; round FAC #1 and move to FAC #2
		1935	4348 FE9C45 20 9F 98 jsr XBCCC ; to int
		1936	4349 FE9C48 64 6F stz <arisgn
		1937	4350 FE9C4A 20 F6 93 jsr XB853 ; now argument is reduced to 2 * pi max.
		1938	4351 FE9C4D A9 4A lda #<XE2EA ; 0.25
		1939	4352 FE9C4F A0 9D ldy #>XE2EA
		1940	4353 FE9C51 20 F3 93 jsr XB850 ; 0.25 - [FAC #1]
		1941	4354 FE9C54 A5 66 lda <facsgn
		1942	4355 FE9C56 48 pha
		1943	4356 FE9C57 10 0D bpl XE29D
		1944	4357 FE9C59 20 ED 93 jsr XB849 ; add 0.5
		1945	4358 FE9C5C A5 66 lda <facsgn
		1946	4359 FE9C5E 30 09 bmi XE2A0
		1947	4360 FE9C60 A5 5A lda <cprmsk
		1948	4361 FE9C62 49 FF eor #$FF
		1949	4362 FE9C64 85 5A sta <cprmsk
		1950	4363 FE9C66 XE29D:
		1951	4364 FE9C66 20 4A 9B jsr XBFB4 ; change sign
		1952	4365 FE9C69 XE2A0:
		1953	4366 FE9C69 A9 4A lda #<XE2EA ; 0.25
		1954	4367 FE9C6B A0 9D ldy #>XE2EA
		1955	4368 FE9C6D 20 09 94 jsr XB867 ; add 0.25
		1956	4369 FE9C70 68 pla
		1957	4370 FE9C71 10 03 bpl ?02
		1958	4371 FE9C73 20 4A 9B jsr XBFB4 ; change sign
		1959	4372 FE9C76 A9 4F ?02: lda #<XE2EF
		1960	4373 FE9C78 A0 9D ldy #>XE2EF
		1961	4374 FE9C7A 4C A7 9B jmp XE043 ; compute sin() polynomial
		1962	4375
		1963	4376 ;---------------------------------------------------------------------------
		1964	4377 ; tan() function implementation -- tan(x) = sin(x) / cos(x)
		1965	4378 ;---------------------------------------------------------------------------
		1966	4379
		1967	4380 ; compute tan([FAC #1])
		1968	4381 FE9C7D XE2B4:
		1969	4382 FE9C7D 20 7A 97 jsr XBBCA ; move FAC #1 rounded to FAC1TMP
		1970	4383 FE9C80 64 5A stz <cprmsk
		1971	4384 FE9C82 20 36 9C jsr XE26B ; compute sin()
		1972	4385 FE9C85 20 82 97 jsr XBBX3 ; move FAC #1 rounded to FAC3TMP
		1973	4386 FE9C88 A9 ED lda #<FAC2TMP
		1974	4387 FE9C8A A0 FF ldy #>FAC2TMP
		1975	4388 FE9C8C 20 41 97 jsr XBBA2T
		1976	4389 FE9C8F 64 66 stz <facsgn
		1977	4390 FE9C91 A5 5A lda <cprmsk
		1978	4391 FE9C93 20 9F 9C jsr ?02
		1979	4392 FE9C96 A9 F2 lda #<FAC3TMP
		1980	4393 FE9C98 A0 FF ldy #>FAC3TMP
		1981	4394 FE9C9A A6 A2 ldx <vbnk
		1982	4395 FE9C9C 4C 91 96 jmp XBB0F ; div
		1983	4396 FE9C9F 48 ?02 pha
		1984	4397 FE9CA0 80 C4 bra XE29D
		1985	Tue Jul 17 11:00:22 2018 Page 33
		1986
		1987
		1988
		1989
		1990	4398
		1991	4399 ;---------------------------------------------------------------------------
		1992	4400 ; some floating point costants
		1993	4401 ;---------------------------------------------------------------------------
		1994	4402
		1995	4403 FE9CA2 81 00 00 00 00 XB9BC: .DB $81,$00,$00,$00,$00 ; 1.0
		1996	4404 FE9CA7 84 20 00 00 00 FCON10: .DB $84,$20,$00,$00,$00 ; 10.0
		1997	4405 FE9CAC 80 00 00 00 00 FCON05: .DB $80,$00,$00,$00,$00 ; 0.5
		1998	4406
		1999	4407 FE9CB1 03 XB9C1: .DB $03 ; LN polynomial table degree 4
		2000	4408 FE9CB2 7F 5E 56 CB 79 .DB $7F,$5E,$56,$CB,$79 ; B9C2
		2001	4409 FE9CB7 80 13 9B 0B 64 .DB $80,$13,$9B,$0B,$64 ; B9C7
		2002	4410 FE9CBC 80 76 38 93 16 .DB $80,$76,$38,$93,$16 ; B9CC
		2003	4411 FE9CC1 82 38 AA 3B 20 .DB $82,$38,$AA,$3B,$20 ; B9D1
		2004	4412
		2005	4413 FE9CC6 80 35 04 F3 34 XB9D6: .DB $80,$35,$04,$F3,$34 ; 0.5 * SQRT(2)
		2006	4414 FE9CCB 81 35 04 F3 34 XB9DB: .DB $81,$35,$04,$F3,$34 ; SQRT(2)
		2007	4415 FE9CD0 80 80 00 00 00 XB9E0: .DB $80,$80,$00,$00,$00 ; -0.5
		2008	4416 FE9CD5 80 31 72 17 F8 XB9E5: .DB $80,$31,$72,$17,$F8 ; LN(2)
		2009	4417 FE9CDA 81 38 AA 3B 29 XBFBF: .DB $81,$38,$AA,$3B,$29 ; 1/LN(2)
		2010	4418 FE9CDF 82 13 5D 8D DE XLN10 .DB $82,$13,$5D,$8D,$DE ; LN(10)
		2011	4419
		2012	4420 FE9CE4 9B 3E BC 1F FD XBDB3: .DB $9B,$3E,$BC,$1F,$FD ; used by float to string conversion
		2013	4421 FE9CE9 9E 6E 6B 27 FD XBDB8: .DB $9E,$6E,$6B,$27,$FD ; 1E8
		2014	4422 FE9CEE 9E 6E 6B 28 00 XBDBD: .DB $9E,$6E,$6B,$28,$00 ; 1E9
		2015	4423
		2016	4424 FE9CF3 FA 0A 1F 00 XBF16: .DB $FA,$0A,$1F,$00 ; -100000000
		2017	4425 FE9CF7 00 98 96 80 .DB $00,$98,$96,$80 ; 10000000
		2018	4426 FE9CFB FF F0 BD C0 .DB $FF,$F0,$BD,$C0 ; -1000000
		2019	4427 FE9CFF 00 01 86 A0 .DB $00,$01,$86,$A0 ; 100000
		2020	4428 FE9D03 FF FF D8 F0 .DB $FF,$FF,$D8,$F0 ; -10000
		2021	4429 FE9D07 00 00 03 E8 .DB $00,$00,$03,$E8 ; 1000
		2022	4430 FE9D0B FF FF FF 9C .DB $FF,$FF,$FF,$9C ; -100
		2023	4431 FE9D0F 00 00 00 0A .DB $00,$00,$00,$0A ; 10
		2024	4432 FE9D13 FF FF FF FF .DB $FF,$FF,$FF,$FF ; -1
		2025	4433
		2026	4434 FE9D17 07 XBFC4: .DB $07 ; EXP polynomial table degree 8
		2027	4435 FE9D18 71 34 58 3E 56 .DB $71,$34,$58,$3E,$56
		2028	4436 FE9D1D 74 16 7E B3 1B .DB $74,$16,$7E,$B3,$1B
		2029	4437 FE9D22 77 2F EE E3 85 .DB $77,$2F,$EE,$E3,$85
		2030	4438 FE9D27 7A 1D 84 1C 2A .DB $7A,$1D,$84,$1C,$2A
		2031	4439 FE9D2C 7C 63 59 58 0A .DB $7C,$63,$59,$58,$0A
		2032	4440 FE9D31 7E 75 FD E7 C6 .DB $7E,$75,$FD,$E7,$C6
		2033	4441 FE9D36 80 31 72 18 10 .DB $80,$31,$72,$18,$10
		2034	4442 FE9D3B 81 00 00 00 00 .DB $81,$00,$00,$00,$00
		2035	4443
		2036	4444 FE9D40 81 49 0F DA A2 XE2E0 .DB $81,$49,$0F,$DA,$A2 ; pi * 0.5
		2037	4445 FE9D45 83 49 0F DA A2 XE2E5 .DB $83,$49,$0F,$DA,$A2 ; pi * 2
		2038	4446 FE9D4A 7F 00 00 00 00 XE2EA .DB $7F,$00,$00,$00,$00 ; 0.25
		2039	4447
		2040	4448 FE9D4F 05 XE2EF .DB $05 ; SIN polynomial table degree 6
		2041	4449 FE9D50 84 E6 1A 2D 1B .DB $84,$E6,$1A,$2D,$1B
		2042	4450 FE9D55 86 28 07 FB F8 .DB $86,$28,$07,$FB,$F8
		2043	4451 FE9D5A 87 99 68 89 01 .DB $87,$99,$68,$89,$01
		2044	4452 FE9D5F 87 23 35 DF E1 .DB $87,$23,$35,$DF,$E1
		2045	4453 FE9D64 86 A5 5D E7 28 .DB $86,$A5,$5D,$E7,$28
		2046	4454 FE9D69 83 49 0F DA A2 .DB $83,$49,$0F,$DA,$A2
		2047	Tue Jul 17 11:00:22 2018 Page 34
		2048
		2049
		2050
		2051
		2052	4455
		2053	4456 FE9D6E 0B XE33E: .DB $0B ; ARCTAN polynomial table degree 12
		2054	4457 FE9D6F 76 B3 83 BD D3 .DB $76,$B3,$83,$BD,$D3
		2055	4458 FE9D74 79 1E F4 A6 F5 .DB $79,$1E,$F4,$A6,$F5
		2056	4459 FE9D79 7B 83 FC B0 10 .DB $7B,$83,$FC,$B0,$10
		2057	4460 FE9D7E 7C 0C 1F 67 CA .DB $7C,$0C,$1F,$67,$CA
		2058	4461 FE9D83 7C DE 53 CB C1 .DB $7C,$DE,$53,$CB,$C1
		2059	4462 FE9D88 7D 14 64 70 4C .DB $7D,$14,$64,$70,$4C
		2060	4463 FE9D8D 7D B7 EA 51 7A .DB $7D,$B7,$EA,$51,$7A
		2061	4464 FE9D92 7D 63 30 88 7E .DB $7D,$63,$30,$88,$7E
		2062	4465 FE9D97 7E 92 44 99 3A .DB $7E,$92,$44,$99,$3A
		2063	4466 FE9D9C 7E 4C CC 91 C7 .DB $7E,$4C,$CC,$91,$C7
		2064	4467 FE9DA1 7F AA AA AA 13 .DB $7F,$AA,$AA,$AA,$13
		2065	4468 FE9DA6 81 00 00 00 00 .DB $81,$00,$00,$00,$00
		2066
		2067
		2068	Lines Assembled : 4446 Errors : 0
		2069
		2070
		2071

Subversion Repositories MB01 Project

(root)/trunk/sources/lst/FE/float.lst – Rev 1