0001 0000 ;Pi calculation for CPUville 8-bit processor 0002 0000 0003 0000 ;Macro definitions for three levels of nested call and ret 0004 0000 #define call0(address) \return: .set $+15\ ldm return\ stm return_jump0+1\ ldm return+1\ stm return_jump0+2 0005 0000 #defcont \ jmp address\ .dw $+2 0006 0000 #define ret0 \ jmp return_jump0 0007 0000 #define call1(address) \return: .set $+15\ ldm return\ stm return_jump1+1\ ldm return+1\ stm return_jump1+2 0008 0000 #defcont \ jmp address\ .dw $+2 0009 0000 #define ret1 \ jmp return_jump1 0010 0000 #define call2(address) \return: .set $+15\ ldm return\ stm return_jump2+1\ ldm return+1\ stm return_jump2+2 0011 0000 #defcont \ jmp address\ .dw $+2 0012 0000 #define ret2 \ jmp return_jump2 0013 0000 #define call3(address) \return: .set $+15\ ldm return\ stm return_jump3+1\ ldm return+1\ stm return_jump3+2 0014 0000 #defcont \ jmp address\ .dw $+2 0015 0000 #define ret3 \ jmp return_jump3 0016 0000 #define callA(address) \return: .set $+15\ ldm return\ stm return_jumpA+1\ ldm return+1\ stm return_jumpA+2 0017 0000 #defcont \ jmp address\ .dw $+2 0018 0000 #define retA \ jmp return_jumpA 0019 0000 0020 0000 ;Other macros 0021 0000 #define write_newline \ ldm new_line\ stm ws_inst+1\ ldm new_line+1\ stm ws_inst+2\ call0(write_string) 0022 0000 #define write_tabs \ ldm two_tabs\ stm ws_inst+1\ ldm two_tabs+1\ stm ws_inst+2\ call0(write_string) 0023 0000 0024 0000 ;ROM monitor subroutines, associated variables, and call return jump addresses 0025 0000 monitor_warm_start .equ 0098h 0026 0000 write_string .equ 05E7h ;level 0 subroutine 0027 0000 ws_inst .equ 0833h ;place string address here 0028 0000 byte_to_hex_pair .equ 06B4h ;level 0 subroutine 0029 0000 byte .equ 0812h ;location of byte for subroutine 0030 0000 char_pair .equ 080Ah ;location of returned character pair 0031 0000 hex_pair_to_byte .equ 0654h ;level 1 subroutine 0032 0000 get_line .equ 058Dh ;level 0 subroutine 0033 0000 buff_low .equ 80h ;get_line buffer address 0880h as bytes 0034 0000 buff_high .equ 08h 0035 0000 buffer .equ 0880h ;get_line buffer address as word 0036 0000 return_jump0 .equ 083Fh ;needed for call and ret macros 0037 0000 return_jump1 .equ 0842h 0038 0000 return_jump2 .equ 0845h 0039 0000 0040 0900 .org 0900h ;Page 1 at 0800h is for monitor stuff 0041 0900 1F return .db 1fh ;placeholder for first definition of variable label -- NOP 0042 0901 13 94 0B jmp start 0043 0904 0044 0904 ;Variables and constants for pi program 0045 0904 0046 0904 06 09 new_line .dw $+2 0047 0906 0D 0A 00 .db 0dh,0ah,0 0048 0909 0B 09 two_tabs .dw $+2 0049 090B 09 09 00 .db 09h,09h,0 0050 090E 10 09 heading_str .dw $+2 0051 0910 5369646573 .text "Sides" 0052 0915 09 09 .db 09h,09h ;horizontal tab 0053 0917 50 69 .text "Pi" 0054 0919 00 .db 0 0055 091A 1C 09 hex_str_buff .dw $+2 0056 091C 000000000000 .fill 30,0 0056 0922 000000000000000000000000000000000000000000000000 0057 093A 3C 09 dec_str_buff .dw $+2 0058 093C 000000000000 .fill 30,0 0058 0942 000000000000000000000000000000000000000000000000 0059 095A 5C 09 dec_out_str .dw $+2 0060 095C 000000000000 .fill 30,0 0060 0962 000000000000000000000000000000000000000000000000 0061 097A 7C 09 range_err_hi .dw $+2 0062 097C 0D 0A .db 0dh,0ah 0063 097E 52616E676520 .text "Range error high" 0063 0984 6572726F722068696768 0064 098E 0D 0A 00 .db 0dh,0ah,0 0065 0991 93 09 range_err_lo .dw $+2 0066 0993 0D 0A .db 0dh,0ah 0067 0995 52616E676520 .text "Range error low" 0067 099B 6572726F72206C6F77 0068 09A4 0D 0A 00 .db 0dh,0ah,0 0069 09A7 A9 09 frac_table_addr .dw $+2 0070 09A9 40 4B 4C frac_table .db 40h,4Bh,4Ch ;used by float-to-decimal for forming decimal fractions 0071 09AC A0 25 26 .db 0A0h,25h,26h ;values stored little-endian 0072 09AF D0 12 13 .db 0D0h,12h,13h 0073 09B2 68 89 09 .db 68h,89h,09h 0074 09B5 B4 C4 04 .db 0B4h,0C4h,04h 0075 09B8 5A 62 02 .db 5Ah,62h,02h 0076 09BB 2D 31 01 .db 2Dh,31h,01h 0077 09BE 96 98 00 .db 96h,98h,00h 0078 09C1 4B 4C 00 .db 4Bh,4Ch,00h 0079 09C4 26 26 00 .db 26h,26h,00h 0080 09C7 13 13 00 .db 13h,13h,00h 0081 09CA 89 09 00 .db 89h,09h,00h 0082 09CD C5 04 00 .db 0C5h,04h,00h 0083 09D0 62 02 00 .db 62h,02h,00h 0084 09D3 31 01 00 .db 31h,01h,00h 0085 09D6 99 00 00 .db 99h,00h,00h 0086 09D9 4C 00 00 .db 4Ch,00h,00h 0087 09DC 26 00 00 .db 26h,00h,00h 0088 09DF 13 00 00 .db 13h,00h,00h 0089 09E2 0A 00 00 .db 0Ah,00h,00h 0090 09E5 05 00 00 .db 05h,00h,00h 0091 09E8 02 00 00 .db 02h,00h,00h 0092 09EB 01 00 00 .db 01h,00h,00h 0093 09EE 00 00 00 00 frac_table_ptr .dw 00h,00h 0094 09F2 00 table_index .db 00h 0095 09F3 00 00 00 hex_frac .db 00h,00h,00h ;long word little-endian 0096 09F6 00 exponent: .db 00h 0097 09F7 00 sign: .db 00h 0098 09F8 00 exponent_a: .db 00h 0099 09F9 00 exponent_b: .db 00h 0100 09FA 00 exponent_c: .db 00h 0101 09FB 00 exponent_x: .db 00h 0102 09FC 00 exponent_test: .db 00h 0103 09FD 00 char .db 00h 0104 09FE 00 byte_a .db 00h 0105 09FF 00 byte_b .db 00h 0106 0A00 00 byte_c .db 00h 0107 0A01 00 byte_d .db 00h 0108 0A02 00 00 00 long_a: .db 00h,00h,00h ;for 24-bit values 0109 0A05 00 00 00 long_b: .db 00h,00h,00h 0110 0A08 00 00 00 long_c: .db 00h,00h,00h 0111 0A0B 00 00 00 long_d: .db 00h,00h,00h 0112 0A0E 00 00 00 long_r: .db 00h,00h,00h 0113 0A11 000000000000double_long_a: .db 00h,00h,00h,00h,00h,00h ;for 48-bit values 0114 0A17 000000000000double_long_b: .db 00h,00h,00h,00h,00h,00h 0115 0A1D 000000000000double_long_c: .db 00h,00h,00h,00h,00h,00h 0116 0A23 00 rs_carry_in: .db 00h 0117 0A24 00 rs_carry_out: .db 00h 0118 0A25 00 ls_carry_in: .db 00h 0119 0A26 00 ls_carry_out: .db 00h 0120 0A27 00 divide_rounds: .db 00h 0121 0A28 00 00 00 00 fp_a: .db 00h,00h,00h,00h 0122 0A2C 00 00 00 00 fp_b: .db 00h,00h,00h,00h 0123 0A30 00 00 00 00 fp_c: .db 00h,00h,00h,00h 0124 0A34 00 00 00 00 fp_d: .db 00h,00h,00h,00h 0125 0A38 00 00 00 00 fp_x: .db 00h,00h,00h,00h 0126 0A3C 00 00 00 00 fp_test: .db 00h,00h,00h,00h 0127 0A40 00 00 00 00 fp_square: .db 00h,00h,00h,00h 0128 0A44 00 00 00 00 fp_pi_a: .db 00h,00h,00h,00h 0129 0A48 00 00 00 00 fp_pi_b: .db 00h,00h,00h,00h 0130 0A4C 00 00 00 00 fp_pi_c: .db 00h,00h,00h,00h 0131 0A50 00 00 00 00 fp_pi_d: .db 00h,00h,00h,00h 0132 0A54 00 00 00 00 fp_pi_a_squared: .db 00h,00h,00h,00h 0133 0A58 00 00 00 00 fp_pi_b_squared: .db 00h,00h,00h,00h 0134 0A5C 00 00 00 00 fp_pi_c_squared: .db 00h,00h,00h,00h 0135 0A60 00 00 00 00 fp_pi_d_squared: .db 00h,00h,00h,00h 0136 0A64 00 00 00 00 fp_sides: .db 00h,00h,00h,00h 0137 0A68 00 00 00 00 fp_2pi: .db 00h,00h,00h,00h 0138 0A6C 00 00 00 00 fp_pi: .db 00h,00h,00h,00h 0139 0A70 00 pi_cycles: .db 00h 0140 0A71 00 shift_steps .db 00h 0141 0A72 00 00 dec_out_ptr .dw 0000h 0142 0A74 00 int_flag .db 00h 0143 0A75 ;Extra return jumps for level 3 and A calls 0144 0A75 13 00 00 return_jump3 jmp 0000h 0145 0A78 13 00 00 return_jumpA jmp 0000h 0146 0A7B 0147 0A7B ;Start of code 0148 0A7B 0149 0A7B ;Debug -- test long_to_dec_str 0150 0A7B debug write_newline 0150 0A7B 11 04 09 0150 0A7E 12 34 08 0150 0A81 11 05 09 0150 0A84 12 35 08 0150 0A87 0150 0A87 0150 0A87 11 96 0A 0150 0A8A 12 40 08 0150 0A8D 11 97 0A 0150 0A90 12 41 08 0150 0A93 13 E7 05 0150 0A96 98 0A 0151 0A98 call0(get_line) 0151 0A98 0151 0A98 11 A7 0A 0151 0A9B 12 40 08 0151 0A9E 11 A8 0A 0151 0AA1 12 41 08 0151 0AA4 13 8D 05 0151 0AA7 A9 0A 0152 0AA9 11 80 08 ldm buffer 0153 0AAC 12 0A 08 stm char_pair 0154 0AAF 11 81 08 ldm buffer+1 0155 0AB2 12 0B 08 stm char_pair+1 0156 0AB5 call1(hex_pair_to_byte) 0156 0AB5 0156 0AB5 11 C4 0A 0156 0AB8 12 43 08 0156 0ABB 11 C5 0A 0156 0ABE 12 44 08 0156 0AC1 13 54 06 0156 0AC4 C6 0A 0157 0AC6 12 28 0A stm fp_a 0158 0AC9 11 82 08 ldm buffer+2 0159 0ACC 12 0A 08 stm char_pair 0160 0ACF 11 83 08 ldm buffer+3 0161 0AD2 12 0B 08 stm char_pair+1 0162 0AD5 call1(hex_pair_to_byte) 0162 0AD5 0162 0AD5 11 E4 0A 0162 0AD8 12 43 08 0162 0ADB 11 E5 0A 0162 0ADE 12 44 08 0162 0AE1 13 54 06 0162 0AE4 E6 0A 0163 0AE6 12 29 0A stm fp_a+1 0164 0AE9 11 84 08 ldm buffer+4 0165 0AEC 12 0A 08 stm char_pair 0166 0AEF 11 85 08 ldm buffer+5 0167 0AF2 12 0B 08 stm char_pair+1 0168 0AF5 call1(hex_pair_to_byte) 0168 0AF5 0168 0AF5 11 04 0B 0168 0AF8 12 43 08 0168 0AFB 11 05 0B 0168 0AFE 12 44 08 0168 0B01 13 54 06 0168 0B04 06 0B 0169 0B06 12 2A 0A stm fp_a+2 0170 0B09 11 86 08 ldm buffer+6 0171 0B0C 12 0A 08 stm char_pair 0172 0B0F 11 87 08 ldm buffer+7 0173 0B12 12 0B 08 stm char_pair+1 0174 0B15 call1(hex_pair_to_byte) 0174 0B15 0174 0B15 11 24 0B 0174 0B18 12 43 08 0174 0B1B 11 25 0B 0174 0B1E 12 44 08 0174 0B21 13 54 06 0174 0B24 26 0B 0175 0B26 12 2B 0A stm fp_a+3 0176 0B29 callA(float_to_dec) 0176 0B29 0176 0B29 11 38 0B 0176 0B2C 12 79 0A 0176 0B2F 11 39 0B 0176 0B32 12 7A 0A 0176 0B35 13 C7 23 0176 0B38 3A 0B 0177 0B3A write_newline 0177 0B3A 11 04 09 0177 0B3D 12 34 08 0177 0B40 11 05 09 0177 0B43 12 35 08 0177 0B46 0177 0B46 0177 0B46 11 55 0B 0177 0B49 12 40 08 0177 0B4C 11 56 0B 0177 0B4F 12 41 08 0177 0B52 13 E7 05 0177 0B55 57 0B 0178 0B57 11 5A 09 ldm dec_out_str 0179 0B5A 12 34 08 stm ws_inst+1 0180 0B5D 11 5B 09 ldm dec_out_str+1 0181 0B60 12 35 08 stm ws_inst+2 0182 0B63 call0(write_string) 0182 0B63 0182 0B63 11 72 0B 0182 0B66 12 40 08 0182 0B69 11 73 0B 0182 0B6C 12 41 08 0182 0B6F 13 E7 05 0182 0B72 74 0B 0183 0B74 write_newline 0183 0B74 11 04 09 0183 0B77 12 34 08 0183 0B7A 11 05 09 0183 0B7D 12 35 08 0183 0B80 0183 0B80 0183 0B80 11 8F 0B 0183 0B83 12 40 08 0183 0B86 11 90 0B 0183 0B89 12 41 08 0183 0B8C 13 E7 05 0183 0B8F 91 0B 0184 0B91 13 7B 0A jmp debug 0185 0B94 0186 0B94 0187 0B94 ;Calculate pi 0188 0B94 ;Uses polygons inside a circle with radius 1 0189 0B94 ;Start with square, double sides each cycle 0190 0B94 ;Perimeter approaches 2pi as sides of polygon increase 0191 0B94 ;Initialize variables 0192 0B94 start: write_newline 0192 0B94 11 04 09 0192 0B97 12 34 08 0192 0B9A 11 05 09 0192 0B9D 12 35 08 0192 0BA0 0192 0BA0 0192 0BA0 11 AF 0B 0192 0BA3 12 40 08 0192 0BA6 11 B0 0B 0192 0BA9 12 41 08 0192 0BAC 13 E7 05 0192 0BAF B1 0B 0193 0BB1 11 0E 09 ldm heading_str 0194 0BB4 12 34 08 stm ws_inst+1 0195 0BB7 11 0F 09 ldm heading_str+1 0196 0BBA 12 35 08 stm ws_inst+2 0197 0BBD call0(write_string) 0197 0BBD 0197 0BBD 11 CC 0B 0197 0BC0 12 40 08 0197 0BC3 11 CD 0B 0197 0BC6 12 41 08 0197 0BC9 13 E7 05 0197 0BCC CE 0B 0198 0BCE write_newline 0198 0BCE 11 04 09 0198 0BD1 12 34 08 0198 0BD4 11 05 09 0198 0BD7 12 35 08 0198 0BDA 0198 0BDA 0198 0BDA 11 E9 0B 0198 0BDD 12 40 08 0198 0BE0 11 EA 0B 0198 0BE3 12 41 08 0198 0BE6 13 E7 05 0198 0BE9 EB 0B 0199 0BEB 10 40 ldi 40h ;fp_sides contains number of sides 0200 0BED 12 64 0A stm fp_sides ;0x40800000 is fp for four (start with square) 0201 0BF0 10 80 ldi 80h 0202 0BF2 12 65 0A stm fp_sides+1 0203 0BF5 10 00 ldi 0 0204 0BF7 12 66 0A stm fp_sides+2 0205 0BFA 12 67 0A stm fp_sides+3 0206 0BFD 10 3F ldi 3Fh ;fp_a equals one to start 0207 0BFF 12 44 0A stm fp_pi_a ;0x3F800000 is fp for one 0208 0C02 10 80 ldi 80h 0209 0C04 12 45 0A stm fp_pi_a+1 0210 0C07 10 00 ldi 0 0211 0C09 12 46 0A stm fp_pi_a+2 0212 0C0C 12 47 0A stm fp_pi_a+3 0213 0C0F 10 3F ldi 3Fh ;fp_b equals one to start 0214 0C11 12 48 0A stm fp_pi_b ;0x3F800000 is fp for one 0215 0C14 10 80 ldi 80h 0216 0C16 12 49 0A stm fp_pi_b+1 0217 0C19 10 00 ldi 0 0218 0C1B 12 4A 0A stm fp_pi_b+2 0219 0C1E 12 4B 0A stm fp_pi_b+3 0220 0C21 10 0D ldi 13 ;number of cycles (doublings of polygon sides) 0221 0C23 12 70 0A stm pi_cycles 0222 0C26 pi_loop: 0223 0C26 0224 0C26 ;Calculate fp_c, which is edge length 0225 0C26 ;fp_pi_c equals square root of fp_pi_a squared plus fp_pi_b squared 0226 0C26 ;First square fp_pi_a, result in fp_pi_a_squared 0227 0C26 0228 0C26 11 44 0A ldm fp_pi_a 0229 0C29 12 28 0A stm fp_a 0230 0C2C 12 2C 0A stm fp_b 0231 0C2F 11 45 0A ldm fp_pi_a+1 0232 0C32 12 29 0A stm fp_a+1 0233 0C35 12 2D 0A stm fp_b+1 0234 0C38 11 46 0A ldm fp_pi_a+2 0235 0C3B 12 2A 0A stm fp_a+2 0236 0C3E 12 2E 0A stm fp_b+2 0237 0C41 11 47 0A ldm fp_pi_a+3 0238 0C44 12 2B 0A stm fp_a+3 0239 0C47 12 2F 0A stm fp_b+3 0240 0C4A call0(multiply_float) 0240 0C4A 0240 0C4A 11 59 0C 0240 0C4D 12 40 08 0240 0C50 11 5A 0C 0240 0C53 12 41 08 0240 0C56 13 A7 19 0240 0C59 5B 0C 0241 0C5B 11 30 0A ldm fp_c 0242 0C5E 12 54 0A stm fp_pi_a_squared 0243 0C61 11 31 0A ldm fp_c+1 0244 0C64 12 55 0A stm fp_pi_a_squared+1 0245 0C67 11 32 0A ldm fp_c+2 0246 0C6A 12 56 0A stm fp_pi_a_squared+2 0247 0C6D 11 33 0A ldm fp_c+3 0248 0C70 12 57 0A stm fp_pi_a_squared+3 0249 0C73 0250 0C73 ;Next square fp_pi_b, result in fp_pi_b_squared 0251 0C73 11 48 0A ldm fp_pi_b 0252 0C76 12 28 0A stm fp_a 0253 0C79 12 2C 0A stm fp_b 0254 0C7C 11 49 0A ldm fp_pi_b+1 0255 0C7F 12 29 0A stm fp_a+1 0256 0C82 12 2D 0A stm fp_b+1 0257 0C85 11 4A 0A ldm fp_pi_b+2 0258 0C88 12 2A 0A stm fp_a+2 0259 0C8B 12 2E 0A stm fp_b+2 0260 0C8E 11 4B 0A ldm fp_pi_b+3 0261 0C91 12 2B 0A stm fp_a+3 0262 0C94 12 2F 0A stm fp_b+3 0263 0C97 call0(multiply_float) 0263 0C97 0263 0C97 11 A6 0C 0263 0C9A 12 40 08 0263 0C9D 11 A7 0C 0263 0CA0 12 41 08 0263 0CA3 13 A7 19 0263 0CA6 A8 0C 0264 0CA8 11 30 0A ldm fp_c 0265 0CAB 12 58 0A stm fp_pi_b_squared 0266 0CAE 11 31 0A ldm fp_c+1 0267 0CB1 12 59 0A stm fp_pi_b_squared+1 0268 0CB4 11 32 0A ldm fp_c+2 0269 0CB7 12 5A 0A stm fp_pi_b_squared+2 0270 0CBA 11 33 0A ldm fp_c+3 0271 0CBD 12 5B 0A stm fp_pi_b_squared+3 0272 0CC0 0273 0CC0 ;Next add pi_square_a and pi_square_b, result in fp_pi_c_squared 0274 0CC0 11 54 0A ldm fp_pi_a_squared 0275 0CC3 12 28 0A stm fp_a 0276 0CC6 11 55 0A ldm fp_pi_a_squared+1 0277 0CC9 12 29 0A stm fp_a+1 0278 0CCC 11 56 0A ldm fp_pi_a_squared+2 0279 0CCF 12 2A 0A stm fp_a+2 0280 0CD2 11 57 0A ldm fp_pi_a_squared+3 0281 0CD5 12 2B 0A stm fp_a+3 0282 0CD8 11 58 0A ldm fp_pi_b_squared 0283 0CDB 12 2C 0A stm fp_b 0284 0CDE 11 59 0A ldm fp_pi_b_squared+1 0285 0CE1 12 2D 0A stm fp_b+1 0286 0CE4 11 5A 0A ldm fp_pi_b_squared+2 0287 0CE7 12 2E 0A stm fp_b+2 0288 0CEA 11 5B 0A ldm fp_pi_b_squared+3 0289 0CED 12 2F 0A stm fp_b+3 0290 0CF0 call0(add_float) 0290 0CF0 0290 0CF0 11 FF 0C 0290 0CF3 12 40 08 0290 0CF6 11 00 0D 0290 0CF9 12 41 08 0290 0CFC 13 40 1B 0290 0CFF 01 0D 0291 0D01 11 30 0A ldm fp_c 0292 0D04 12 5C 0A stm fp_pi_c_squared 0293 0D07 11 31 0A ldm fp_c+1 0294 0D0A 12 5D 0A stm fp_pi_c_squared+1 0295 0D0D 11 32 0A ldm fp_c+2 0296 0D10 12 5E 0A stm fp_pi_c_squared+2 0297 0D13 11 33 0A ldm fp_c+3 0298 0D16 12 5F 0A stm fp_pi_c_squared+3 0299 0D19 0300 0D19 ;Next calculate square root of fp_pi_c_squared, result in fp_pi_c 0301 0D19 11 5C 0A ldm fp_pi_c_squared 0302 0D1C 12 38 0A stm fp_x 0303 0D1F 11 5D 0A ldm fp_pi_c_squared+1 0304 0D22 12 39 0A stm fp_x+1 0305 0D25 11 5E 0A ldm fp_pi_c_squared+2 0306 0D28 12 3A 0A stm fp_x+2 0307 0D2B 11 5F 0A ldm fp_pi_c_squared+3 0308 0D2E 12 3B 0A stm fp_x+3 0309 0D31 callA(sqrt_float) 0309 0D31 0309 0D31 11 40 0D 0309 0D34 12 79 0A 0309 0D37 11 41 0D 0309 0D3A 12 7A 0A 0309 0D3D 13 06 1F 0309 0D40 42 0D 0310 0D42 11 3C 0A ldm fp_test 0311 0D45 12 4C 0A stm fp_pi_c 0312 0D48 11 3D 0A ldm fp_test+1 0313 0D4B 12 4D 0A stm fp_pi_c+1 0314 0D4E 11 3E 0A ldm fp_test+2 0315 0D51 12 4E 0A stm fp_pi_c+2 0316 0D54 11 3F 0A ldm fp_test+3 0317 0D57 12 4F 0A stm fp_pi_c+3 0318 0D5A 0319 0D5A ;Have edge length in fp_pi_c, can now calculate pi, result in fp_pi 0320 0D5A ;First calculate total perimeter length 0321 0D5A 11 64 0A ldm fp_sides 0322 0D5D 12 28 0A stm fp_a 0323 0D60 11 65 0A ldm fp_sides+1 0324 0D63 12 29 0A stm fp_a+1 0325 0D66 11 66 0A ldm fp_sides+2 0326 0D69 12 2A 0A stm fp_a+2 0327 0D6C 11 67 0A ldm fp_sides+3 0328 0D6F 12 2B 0A stm fp_a+3 0329 0D72 11 4C 0A ldm fp_pi_c 0330 0D75 12 2C 0A stm fp_b 0331 0D78 11 4D 0A ldm fp_pi_c+1 0332 0D7B 12 2D 0A stm fp_b+1 0333 0D7E 11 4E 0A ldm fp_pi_c+2 0334 0D81 12 2E 0A stm fp_b+2 0335 0D84 11 4F 0A ldm fp_pi_c+3 0336 0D87 12 2F 0A stm fp_b+3 0337 0D8A call0(multiply_float) 0337 0D8A 0337 0D8A 11 99 0D 0337 0D8D 12 40 08 0337 0D90 11 9A 0D 0337 0D93 12 41 08 0337 0D96 13 A7 19 0337 0D99 9B 0D 0338 0D9B 0339 0D9B ;Multiplication result will be in fp_c 0340 0D9B ;Divide fp_c by two and transfer result to fp_pi 0341 0D9B 11 30 0A ldm fp_c ;divide by two by subtracting one from exponent 0342 0D9E 12 FE 09 stm byte_a 0343 0DA1 call3(shift_left_one) ;First extract exponent 0343 0DA1 0343 0DA1 11 B0 0D 0343 0DA4 12 76 0A 0343 0DA7 11 B1 0D 0343 0DAA 12 77 0A 0343 0DAD 13 0C 11 0343 0DB0 B2 0D 0344 0DB2 12 FA 09 stm exponent_c 0345 0DB5 11 31 0A ldm fp_c+1 ;Check for bit 0 of exponent 0346 0DB8 0C 80 andi 10000000b 0347 0DBA 14 C5 0D jpz cpi_next_1 ;if bit 0 zero, done 0348 0DBD 11 FA 09 ldm exponent_c ;if bit 0 one, set it 0349 0DC0 0D 01 ori 00000001b 0350 0DC2 12 FA 09 stm exponent_c 0351 0DC5 11 FA 09 cpi_next_1: ldm exponent_c ;decrement exponent (divide by two) 0352 0DC8 1A dec 0353 0DC9 12 FA 09 stm exponent_c 0354 0DCC 12 FE 09 stm byte_a 0355 0DCF call3(shift_right_one) ;put exponent back in fp_c 0355 0DCF 0355 0DCF 11 DE 0D 0355 0DD2 12 76 0A 0355 0DD5 11 DF 0D 0355 0DD8 12 77 0A 0355 0DDB 13 8D 11 0355 0DDE E0 0D 0356 0DE0 12 30 0A stm fp_c 0357 0DE3 11 FA 09 ldm exponent_c ;check bit 0 of exponent 0358 0DE6 0C 01 andi 00000001b 0359 0DE8 14 F6 0D jpz cpi_next_2 ;bit 0 is zero, set fp_c+1 bit 7 to zero 0360 0DEB 11 31 0A ldm fp_c+1 ;bit 0 is one, set to one 0361 0DEE 0D 80 ori 10000000b 0362 0DF0 12 31 0A stm fp_c+1 0363 0DF3 13 FE 0D jmp cpi_next_3 0364 0DF6 0365 0DF6 11 31 0A cpi_next_2: ldm fp_c+1 ;bit 0 is zero, set to zero 0366 0DF9 0C 7F andi 01111111b 0367 0DFB 12 31 0A stm fp_c+1 0368 0DFE 0369 0DFE 11 30 0A cpi_next_3: ldm fp_c 0370 0E01 12 6C 0A stm fp_pi 0371 0E04 11 31 0A ldm fp_c+1 0372 0E07 12 6D 0A stm fp_pi+1 0373 0E0A 11 32 0A ldm fp_c+2 0374 0E0D 12 6E 0A stm fp_pi+2 0375 0E10 11 33 0A ldm fp_c+3 0376 0E13 12 6F 0A stm fp_pi+3 0377 0E16 0378 0E16 ;Display sides and pi 0379 0E16 0380 0E16 11 64 0A ldm fp_sides 0381 0E19 12 28 0A stm fp_a 0382 0E1C 11 65 0A ldm fp_sides+1 0383 0E1F 12 29 0A stm fp_a+1 0384 0E22 11 66 0A ldm fp_sides+2 0385 0E25 12 2A 0A stm fp_a+2 0386 0E28 11 67 0A ldm fp_sides+3 0387 0E2B 12 2B 0A stm fp_a+3 0388 0E2E callA(float_to_dec) 0388 0E2E 0388 0E2E 11 3D 0E 0388 0E31 12 79 0A 0388 0E34 11 3E 0E 0388 0E37 12 7A 0A 0388 0E3A 13 C7 23 0388 0E3D 3F 0E 0389 0E3F 11 5A 09 ldm dec_out_str 0390 0E42 12 34 08 stm ws_inst+1 0391 0E45 11 5B 09 ldm dec_out_str+1 0392 0E48 12 35 08 stm ws_inst+2 0393 0E4B call0(write_string) 0393 0E4B 0393 0E4B 11 5A 0E 0393 0E4E 12 40 08 0393 0E51 11 5B 0E 0393 0E54 12 41 08 0393 0E57 13 E7 05 0393 0E5A 5C 0E 0394 0E5C write_tabs 0394 0E5C 11 09 09 0394 0E5F 12 34 08 0394 0E62 11 0A 09 0394 0E65 12 35 08 0394 0E68 0394 0E68 0394 0E68 11 77 0E 0394 0E6B 12 40 08 0394 0E6E 11 78 0E 0394 0E71 12 41 08 0394 0E74 13 E7 05 0394 0E77 79 0E 0395 0E79 11 6C 0A ldm fp_pi 0396 0E7C 12 28 0A stm fp_a 0397 0E7F 11 6D 0A ldm fp_pi+1 0398 0E82 12 29 0A stm fp_a+1 0399 0E85 11 6E 0A ldm fp_pi+2 0400 0E88 12 2A 0A stm fp_a+2 0401 0E8B 11 6F 0A ldm fp_pi+3 0402 0E8E 12 2B 0A stm fp_a+3 0403 0E91 callA(float_to_dec) 0403 0E91 0403 0E91 11 A0 0E 0403 0E94 12 79 0A 0403 0E97 11 A1 0E 0403 0E9A 12 7A 0A 0403 0E9D 13 C7 23 0403 0EA0 A2 0E 0404 0EA2 11 5A 09 ldm dec_out_str 0405 0EA5 12 34 08 stm ws_inst+1 0406 0EA8 11 5B 09 ldm dec_out_str+1 0407 0EAB 12 35 08 stm ws_inst+2 0408 0EAE call0(write_string) 0408 0EAE 0408 0EAE 11 BD 0E 0408 0EB1 12 40 08 0408 0EB4 11 BE 0E 0408 0EB7 12 41 08 0408 0EBA 13 E7 05 0408 0EBD BF 0E 0409 0EBF write_newline 0409 0EBF 11 04 09 0409 0EC2 12 34 08 0409 0EC5 11 05 09 0409 0EC8 12 35 08 0409 0ECB 0409 0ECB 0409 0ECB 11 DA 0E 0409 0ECE 12 40 08 0409 0ED1 11 DB 0E 0409 0ED4 12 41 08 0409 0ED7 13 E7 05 0409 0EDA DC 0E 0410 0EDC 0411 0EDC 0412 0EDC 11 70 0A ldm pi_cycles 0413 0EDF 1A dec 0414 0EE0 14 09 11 jpz pi_done 0415 0EE3 12 70 0A stm pi_cycles 0416 0EE6 0417 0EE6 ;If not done, prepare for next cycle 0418 0EE6 ;First double the sides 0419 0EE6 11 64 0A ldm fp_sides ;multiply fp_sides by two by adding one to exponent 0420 0EE9 12 FE 09 stm byte_a 0421 0EEC call3(shift_left_one) ;extract exponent 0421 0EEC 0421 0EEC 11 FB 0E 0421 0EEF 12 76 0A 0421 0EF2 11 FC 0E 0421 0EF5 12 77 0A 0421 0EF8 13 0C 11 0421 0EFB FD 0E 0422 0EFD 12 FA 09 stm exponent_c 0423 0F00 11 65 0A ldm fp_sides+1 ;check bit 0 of exponent 0424 0F03 0C 80 andi 10000000b 0425 0F05 14 13 0F jpz pi_next_A ;if 0, set it to zero 0426 0F08 11 FA 09 ldm exponent_c ;if one, set it to one 0427 0F0B 0D 01 ori 00000001b 0428 0F0D 12 FA 09 stm exponent_c 0429 0F10 13 1B 0F jmp pi_next_1 0430 0F13 11 FA 09 pi_next_A: ldm exponent_c 0431 0F16 0C FE andi 11111110b 0432 0F18 12 FA 09 stm exponent_c 0433 0F1B 0434 0F1B 11 FA 09 pi_next_1: ldm exponent_c ;add one to exponent 0435 0F1E 19 inc 0436 0F1F 12 FA 09 stm exponent_c 0437 0F22 12 FE 09 stm byte_a 0438 0F25 call3(shift_right_one) ;reassemble float 0438 0F25 0438 0F25 11 34 0F 0438 0F28 12 76 0A 0438 0F2B 11 35 0F 0438 0F2E 12 77 0A 0438 0F31 13 8D 11 0438 0F34 36 0F 0439 0F36 12 64 0A stm fp_sides 0440 0F39 11 FA 09 ldm exponent_c ;check bit 0 of exponent 0441 0F3C 0C 01 andi 00000001b 0442 0F3E 14 4C 0F jpz pi_next_B 0443 0F41 11 65 0A ldm fp_sides+1 ;set one 0444 0F44 0D 80 ori 10000000b 0445 0F46 12 65 0A stm fp_sides+1 0446 0F49 13 54 0F jmp pi_next_2 0447 0F4C 11 65 0A pi_next_B: ldm fp_sides+1 ;set zero 0448 0F4F 0C 7F andi 01111111b 0449 0F51 12 65 0A stm fp_sides+1 0450 0F54 0451 0F54 ;The next fp_pi_b is current fp_pi_c divided by two 0452 0F54 11 4C 0A pi_next_2: ldm fp_pi_c ;make fp_pi_b equal to current fp_pi_c 0453 0F57 12 48 0A stm fp_pi_b 0454 0F5A 11 4D 0A ldm fp_pi_c+1 0455 0F5D 12 49 0A stm fp_pi_b+1 0456 0F60 11 4E 0A ldm fp_pi_c+2 0457 0F63 12 4A 0A stm fp_pi_b+2 0458 0F66 11 4F 0A ldm fp_pi_c+3 0459 0F69 12 4B 0A stm fp_pi_b+3 0460 0F6C 0461 0F6C 11 48 0A ldm fp_pi_b ;divide fp_pi_b by two by subtracting one from exponent 0462 0F6F 12 FE 09 stm byte_a 0463 0F72 call3(shift_left_one) ;extract exponent, puts zero in bit 0 0463 0F72 0463 0F72 11 81 0F 0463 0F75 12 76 0A 0463 0F78 11 82 0F 0463 0F7B 12 77 0A 0463 0F7E 13 0C 11 0463 0F81 83 0F 0464 0F83 12 FA 09 stm exponent_c 0465 0F86 11 49 0A ldm fp_pi_b+1 ;check bit 0 of exponent 0466 0F89 0C 80 andi 10000000b 0467 0F8B 14 96 0F jpz pi_next_3 ;done if zero 0468 0F8E 11 FA 09 ldm exponent_c ;if one, set bit 7 of exponent 0469 0F91 0D 01 ori 00000001b 0470 0F93 12 FA 09 stm exponent_c 0471 0F96 0472 0F96 11 FA 09 pi_next_3: ldm exponent_c ;subtract one from exponent (decrement) 0473 0F99 1A dec 0474 0F9A 12 FA 09 stm exponent_c 0475 0F9D 0476 0F9D ;Put exponent back into fp_pi_b 0477 0F9D 11 FA 09 ldm exponent_c 0478 0FA0 12 FE 09 stm byte_a 0479 0FA3 call3(shift_right_one) 0479 0FA3 0479 0FA3 11 B2 0F 0479 0FA6 12 76 0A 0479 0FA9 11 B3 0F 0479 0FAC 12 77 0A 0479 0FAF 13 8D 11 0479 0FB2 B4 0F 0480 0FB4 12 48 0A stm fp_pi_b 0481 0FB7 11 FA 09 ldm exponent_c ;check bit 0 of exponent 0482 0FBA 0C 01 andi 00000001b 0483 0FBC 14 CA 0F jpz pi_next_4 ;if zero, set bit to 0 0484 0FBF 11 49 0A ldm fp_pi_b+1 ;if one,set bit to one 0485 0FC2 0D 80 ori 10000000b 0486 0FC4 12 49 0A stm fp_pi_b+1 0487 0FC7 13 D2 0F jmp pi_next_5 0488 0FCA 0489 0FCA 0490 0FCA 11 49 0A pi_next_4: ldm fp_pi_b+1 ;set bit to zero 0491 0FCD 0C 7F andi 01111111b 0492 0FCF 12 49 0A stm fp_pi_b+1 0493 0FD2 0494 0FD2 ;Set fp_pi_d to square root of one minus fp_pi_b squared. Use macros and subroutine 0495 0FD2 ;First square fp_pi_b, result in fp_pi_b_squared 0496 0FD2 11 48 0A pi_next_5: ldm fp_pi_b 0497 0FD5 12 28 0A stm fp_a 0498 0FD8 12 2C 0A stm fp_b 0499 0FDB 11 49 0A ldm fp_pi_b+1 0500 0FDE 12 29 0A stm fp_a+1 0501 0FE1 12 2D 0A stm fp_b+1 0502 0FE4 11 4A 0A ldm fp_pi_b+2 0503 0FE7 12 2A 0A stm fp_a+2 0504 0FEA 12 2E 0A stm fp_b+2 0505 0FED 11 4B 0A ldm fp_pi_b+3 0506 0FF0 12 2B 0A stm fp_a+3 0507 0FF3 12 2F 0A stm fp_b+3 0508 0FF6 call0(multiply_float) 0508 0FF6 0508 0FF6 11 05 10 0508 0FF9 12 40 08 0508 0FFC 11 06 10 0508 0FFF 12 41 08 0508 1002 13 A7 19 0508 1005 07 10 0509 1007 11 30 0A ldm fp_c 0510 100A 12 58 0A stm fp_pi_b_squared 0511 100D 11 31 0A ldm fp_c+1 0512 1010 12 59 0A stm fp_pi_b_squared+1 0513 1013 11 32 0A ldm fp_c+2 0514 1016 12 5A 0A stm fp_pi_b_squared+2 0515 1019 11 33 0A ldm fp_c+3 0516 101C 12 5B 0A stm fp_pi_b_squared+3 0517 101F 0518 101F ;Next calculate 1-fp_pi_b_squared, result in fp_pi_d_squared 0519 101F 10 3F ldi 3Fh ;fp one is 0x3F800000 0520 1021 12 28 0A stm fp_a 0521 1024 10 80 ldi 80h 0522 1026 12 29 0A stm fp_a+1 0523 1029 10 00 ldi 0 0524 102B 12 2A 0A stm fp_a+2 0525 102E 12 2B 0A stm fp_a+3 0526 1031 11 58 0A ldm fp_pi_b_squared 0527 1034 12 2C 0A stm fp_b 0528 1037 11 59 0A ldm fp_pi_b_squared+1 0529 103A 12 2D 0A stm fp_b+1 0530 103D 11 5A 0A ldm fp_pi_b_squared+2 0531 1040 12 2E 0A stm fp_b+2 0532 1043 11 5B 0A ldm fp_pi_b_squared+3 0533 1046 12 2F 0A stm fp_b+3 0534 1049 call0(subtract_float) 0534 1049 0534 1049 11 58 10 0534 104C 12 40 08 0534 104F 11 59 10 0534 1052 12 41 08 0534 1055 13 02 1D 0534 1058 5A 10 0535 105A 11 30 0A ldm fp_c 0536 105D 12 60 0A stm fp_pi_d_squared 0537 1060 11 31 0A ldm fp_c+1 0538 1063 12 61 0A stm fp_pi_d_squared+1 0539 1066 11 32 0A ldm fp_c+2 0540 1069 12 62 0A stm fp_pi_d_squared+2 0541 106C 11 33 0A ldm fp_c+3 0542 106F 12 63 0A stm fp_pi_d_squared+3 0543 1072 0544 1072 ;Last do square root of result, result in fp_pi_d 0545 1072 11 60 0A ldm fp_pi_d_squared 0546 1075 12 38 0A stm fp_x 0547 1078 11 61 0A ldm fp_pi_d_squared+1 0548 107B 12 39 0A stm fp_x+1 0549 107E 11 62 0A ldm fp_pi_d_squared+2 0550 1081 12 3A 0A stm fp_x+2 0551 1084 11 63 0A ldm fp_pi_d_squared+3 0552 1087 12 3B 0A stm fp_x+3 0553 108A callA(sqrt_float) 0553 108A 0553 108A 11 99 10 0553 108D 12 79 0A 0553 1090 11 9A 10 0553 1093 12 7A 0A 0553 1096 13 06 1F 0553 1099 9B 10 0554 109B 11 3C 0A ldm fp_test 0555 109E 12 50 0A stm fp_pi_d 0556 10A1 11 3D 0A ldm fp_test+1 0557 10A4 12 51 0A stm fp_pi_d+1 0558 10A7 11 3E 0A ldm fp_test+2 0559 10AA 12 52 0A stm fp_pi_d+2 0560 10AD 11 3F 0A ldm fp_test+3 0561 10B0 12 53 0A stm fp_pi_d+3 0562 10B3 0563 10B3 ;Next calculate new fp_pi_a which is one minus fp_pi_d 0564 10B3 10 3F ldi 3Fh ;fp one is 0x3F800000 0565 10B5 12 28 0A stm fp_a 0566 10B8 10 80 ldi 80h 0567 10BA 12 29 0A stm fp_a+1 0568 10BD 10 00 ldi 0 0569 10BF 12 2A 0A stm fp_a+2 0570 10C2 12 2B 0A stm fp_a+3 0571 10C5 11 50 0A ldm fp_pi_d 0572 10C8 12 2C 0A stm fp_b 0573 10CB 11 51 0A ldm fp_pi_d+1 0574 10CE 12 2D 0A stm fp_b+1 0575 10D1 11 52 0A ldm fp_pi_d+2 0576 10D4 12 2E 0A stm fp_b+2 0577 10D7 11 53 0A ldm fp_pi_d+3 0578 10DA 12 2F 0A stm fp_b+3 0579 10DD call0(subtract_float) 0579 10DD 0579 10DD 11 EC 10 0579 10E0 12 40 08 0579 10E3 11 ED 10 0579 10E6 12 41 08 0579 10E9 13 02 1D 0579 10EC EE 10 0580 10EE 11 30 0A ldm fp_c 0581 10F1 12 44 0A stm fp_pi_a 0582 10F4 11 31 0A ldm fp_c+1 0583 10F7 12 45 0A stm fp_pi_a+1 0584 10FA 11 32 0A ldm fp_c+2 0585 10FD 12 46 0A stm fp_pi_a+2 0586 1100 11 33 0A ldm fp_c+3 0587 1103 12 47 0A stm fp_pi_a+3 0588 1106 0589 1106 ;Now ready to calculate side length and pi 0590 1106 13 26 0C jmp pi_loop 0591 1109 0592 1109 13 98 00 pi_done: jmp monitor_warm_start 0593 110C 0594 110C ;Subroutine to arithmetic shift left one a byte 0595 110C ;Call as level 3 subroutine 0596 110C ;Byte to shift passed in byte_a 0597 110C ;Returns with shifted byte in accumulator 0598 110C ;Uses byte_c and byte_d as temp storage 0599 110C 11 FE 09 shift_left_one: ldm byte_a ;byte to shift 0600 110F 12 00 0A stm byte_c ;byte to shift to temp storage 0601 1112 10 00 ldi 0 0602 1114 12 01 0A stm byte_d ;clear byte_d 0603 1117 11 00 0A ldm byte_c 0604 111A 0C 40 andi 01000000b ;check bit 6 0605 111C 14 27 11 jpz slo_check_bit_5 ;leave bit 7 as zero, check next bit 0606 111F 10 80 ldi 10000000b ;set bit 7 to 1 0607 1121 05 01 0A orm byte_d 0608 1124 12 01 0A stm byte_d 0609 1127 11 00 0A slo_check_bit_5: ldm byte_c 0610 112A 0C 20 andi 00100000b 0611 112C 14 37 11 jpz slo_check_bit_4 0612 112F 10 40 ldi 01000000b 0613 1131 05 01 0A orm byte_d 0614 1134 12 01 0A stm byte_d 0615 1137 11 00 0A slo_check_bit_4: ldm byte_c 0616 113A 0C 10 andi 00010000b 0617 113C 14 47 11 jpz slo_check_bit_3 0618 113F 10 20 ldi 00100000b 0619 1141 05 01 0A orm byte_d 0620 1144 12 01 0A stm byte_d 0621 1147 11 00 0A slo_check_bit_3: ldm byte_c 0622 114A 0C 08 andi 00001000b 0623 114C 14 57 11 jpz slo_check_bit_2 0624 114F 10 10 ldi 00010000b 0625 1151 05 01 0A orm byte_d 0626 1154 12 01 0A stm byte_d 0627 1157 11 00 0A slo_check_bit_2: ldm byte_c 0628 115A 0C 04 andi 00000100b 0629 115C 14 67 11 jpz slo_check_bit_1 0630 115F 10 08 ldi 00001000b 0631 1161 05 01 0A orm byte_d 0632 1164 12 01 0A stm byte_d 0633 1167 11 00 0A slo_check_bit_1: ldm byte_c 0634 116A 0C 02 andi 00000010b 0635 116C 14 77 11 jpz slo_check_bit_0 0636 116F 10 04 ldi 00000100b 0637 1171 05 01 0A orm byte_d 0638 1174 12 01 0A stm byte_d 0639 1177 11 00 0A slo_check_bit_0: ldm byte_c 0640 117A 0C 01 andi 00000001b 0641 117C 14 87 11 jpz slo_done 0642 117F 10 02 ldi 0000010b 0643 1181 05 01 0A orm byte_d 0644 1184 12 01 0A stm byte_d 0645 1187 11 01 0A slo_done ldm byte_d 0646 118A ret3 0646 118A 13 75 0A 0647 118D 0648 118D ;Subroutine to arithmetic shift right one a byte 0649 118D ;Call as level 3 subroutine 0650 118D ;Byte to shift passed byte_a 0651 118D ;Returns with shifted byte in accumulator 0652 118D ;Uses byte_c and byte_d as temp storage 0653 118D 11 FE 09 shift_right_one: ldm byte_a ;byte to shift 0654 1190 12 00 0A stm byte_c ;byte to shift to temp storage 0655 1193 10 00 ldi 0 0656 1195 12 01 0A stm byte_d ;clear byte_d 0657 1198 11 00 0A ldm byte_c 0658 119B 0C 02 andi 00000010b ;check bit 1 0659 119D 14 A8 11 jpz sro_check_bit_2 ;leave bit bit 0 as zero, check next bit 0660 11A0 10 01 ldi 00000001b ;set bit 0 to 1 0661 11A2 05 01 0A orm byte_d 0662 11A5 12 01 0A stm byte_d 0663 11A8 11 00 0A sro_check_bit_2: ldm byte_c 0664 11AB 0C 04 andi 00000100b ;check bit 2 0665 11AD 14 B8 11 jpz sro_check_bit_3 ;zero, go to next bie 0666 11B0 10 02 ldi 00000010b ;one, set D reg bit 1 to 1 0667 11B2 05 01 0A orm byte_d 0668 11B5 12 01 0A stm byte_d 0669 11B8 11 00 0A sro_check_bit_3: ldm byte_c 0670 11BB 0C 08 andi 00001000b 0671 11BD 14 C8 11 jpz sro_check_bit_4 0672 11C0 10 04 ldi 00000100b 0673 11C2 05 01 0A orm byte_d 0674 11C5 12 01 0A stm byte_d 0675 11C8 11 00 0A sro_check_bit_4: ldm byte_c 0676 11CB 0C 10 andi 00010000b 0677 11CD 14 D8 11 jpz sro_check_bit_5 0678 11D0 10 08 ldi 00001000b 0679 11D2 05 01 0A orm byte_d 0680 11D5 12 01 0A stm byte_d 0681 11D8 11 00 0A sro_check_bit_5: ldm byte_c 0682 11DB 0C 20 andi 00100000b 0683 11DD 14 E8 11 jpz sro_check_bit_6 0684 11E0 10 10 ldi 00010000b 0685 11E2 05 01 0A orm byte_d 0686 11E5 12 01 0A stm byte_d 0687 11E8 11 00 0A sro_check_bit_6: ldm byte_c 0688 11EB 0C 40 andi 01000000b 0689 11ED 14 F8 11 jpz sro_check_bit_7 0690 11F0 10 20 ldi 00100000b 0691 11F2 05 01 0A orm byte_d 0692 11F5 12 01 0A stm byte_d 0693 11F8 11 00 0A sro_check_bit_7: ldm byte_c 0694 11FB 0C 80 andi 10000000b 0695 11FD 14 08 12 jpz sro_done 0696 1200 10 40 ldi 01000000b 0697 1202 05 01 0A orm byte_d 0698 1205 12 01 0A stm byte_d 0699 1208 11 01 0A sro_done: ldm byte_d 0700 120B ret3 0700 120B 13 75 0A 0701 120E 0702 120E ;Subroutine to shift left one a 24-bit value 0703 120E ;24-bit value in long_c 0704 120E ;Call as level 2 subroutine 0705 120E ;Shifted long returned in long_c 0706 120E 0707 120E 11 0A 0A shift_left_long: ldm long_c+2 0708 1211 12 00 0A stm byte_c 0709 1214 0C 80 andi 10000000b ;check leftmost bit 0710 1216 12 26 0A stm ls_carry_out ;save for carry-in at next step 0711 1219 11 00 0A ldm byte_c 0712 121C 12 FE 09 stm byte_a ;shift subroutine needs byte in byte_a 0713 121F call3(shift_left_one) 0713 121F 0713 121F 11 2E 12 0713 1222 12 76 0A 0713 1225 11 2F 12 0713 1228 12 77 0A 0713 122B 13 0C 11 0713 122E 30 12 0714 1230 12 0A 0A stm long_c+2 ;store shifted byte 0715 1233 11 26 0A ldm ls_carry_out 0716 1236 12 25 0A stm ls_carry_in ;carry-out becomes carry-in for next shift 0717 1239 11 09 0A ldm long_c+1 ;get next byte to shift 0718 123C 12 00 0A stm byte_c ;temp storage 0719 123F 0C 80 andi 10000000b 0720 1241 12 26 0A stm ls_carry_out ;save carry-out before shift 0721 1244 11 00 0A ldm byte_c 0722 1247 12 FE 09 stm byte_a 0723 124A call3(shift_left_one) ;shift one left 0723 124A 0723 124A 11 59 12 0723 124D 12 76 0A 0723 1250 11 5A 12 0723 1253 12 77 0A 0723 1256 13 0C 11 0723 1259 5B 12 0724 125B 12 00 0A stm byte_c ;temp store shifted byte 0725 125E 11 25 0A ldm ls_carry_in 0726 1261 14 6C 12 jpz lsl_no_carry_in_1 ;carry-in? 0727 1264 10 01 ldi 00000001b ;no, skip carry-in 0728 1266 05 00 0A orm byte_c ;yes, put carry in bit 0 and store 0729 1269 13 6F 12 jmp lsl_store_1 0730 126C 11 00 0A lsl_no_carry_in_1: ldm byte_c ;no carry, get shifted byte back and 0731 126F 12 09 0A lsl_store_1: stm long_c+1 ;store shifted byte 0732 1272 11 26 0A ldm ls_carry_out 0733 1275 12 25 0A stm ls_carry_in ;carry-out becomes carry-in for next shift 0734 1278 11 08 0A ldm long_c ;get next byte to shift 0735 127B 12 00 0A stm byte_c ;temp storage 0736 127E 0C 80 andi 10000000b 0737 1280 12 26 0A stm ls_carry_out ;save carry-out 0738 1283 11 00 0A ldm byte_c 0739 1286 12 FE 09 stm byte_a 0740 1289 call3(shift_left_one) 0740 1289 0740 1289 11 98 12 0740 128C 12 76 0A 0740 128F 11 99 12 0740 1292 12 77 0A 0740 1295 13 0C 11 0740 1298 9A 12 0741 129A 12 00 0A stm byte_c ;temp store shifted byte 0742 129D 11 25 0A ldm ls_carry_in 0743 12A0 14 AB 12 jpz lsl_no_carry_in_2 ;carry-in? 0744 12A3 10 01 ldi 00000001b ;no, skip carry-in 0745 12A5 05 00 0A orm byte_c ;yes, put carry in bit 0 and store 0746 12A8 13 AE 12 jmp lsl_store_2 0747 12AB 11 00 0A lsl_no_carry_in_2: ldm byte_c ;no carry, get shifted byte back and 0748 12AE 12 08 0A lsl_store_2: stm long_c ;store shifted byte 0749 12B1 ret2 0749 12B1 13 45 08 0750 12B4 0751 12B4 ;Subroutine to shift right one a 24-bit value 0752 12B4 ;Call as level 2 subroutine 0753 12B4 ;24-bit value in long_d 0754 12B4 ;Returns shifted long in long_d 0755 12B4 0756 12B4 11 0B 0A shift_right_long: ldm long_d 0757 12B7 12 00 0A stm byte_c 0758 12BA 0C 01 andi 00000001b ;check rightmost bit 0759 12BC 12 24 0A stm rs_carry_out ;save for carry-in at next step 0760 12BF 11 00 0A ldm byte_c 0761 12C2 12 FE 09 stm byte_a ;shift routine needs byte in byte_a 0762 12C5 call3(shift_right_one) 0762 12C5 0762 12C5 11 D4 12 0762 12C8 12 76 0A 0762 12CB 11 D5 12 0762 12CE 12 77 0A 0762 12D1 13 8D 11 0762 12D4 D6 12 0763 12D6 12 0B 0A stm long_d ;store shifted byte 0764 12D9 11 24 0A ldm rs_carry_out 0765 12DC 12 23 0A stm rs_carry_in ;carry-out becomes carry-in for next shift 0766 12DF 11 0C 0A ldm long_d+1 ;get next byte to shift 0767 12E2 12 00 0A stm byte_c ;temp storage 0768 12E5 0C 01 andi 00000001b ;check rightmost bit 0769 12E7 12 24 0A stm rs_carry_out ;save carry-out before shift 0770 12EA 11 00 0A ldm byte_c 0771 12ED 12 FE 09 stm byte_a 0772 12F0 call3(shift_right_one) 0772 12F0 0772 12F0 11 FF 12 0772 12F3 12 76 0A 0772 12F6 11 00 13 0772 12F9 12 77 0A 0772 12FC 13 8D 11 0772 12FF 01 13 0773 1301 12 00 0A stm byte_c ;temp store shifted byte 0774 1304 11 23 0A ldm rs_carry_in 0775 1307 14 12 13 jpz rsl_no_carry_in_1 ;carry-in? 0776 130A 10 80 ldi 10000000b ;no, skip carry-in 0777 130C 05 00 0A orm byte_c ;yes, put carry in bit 7 and store 0778 130F 13 15 13 jmp rsl_store_1 0779 1312 11 00 0A rsl_no_carry_in_1: ldm byte_c ;no carry, get shifted byte back and 0780 1315 12 0C 0A rsl_store_1: stm long_d+1 ;store shifted byte 0781 1318 11 24 0A ldm rs_carry_out 0782 131B 12 23 0A stm rs_carry_in ;carry-out becomes carry-in for next shift 0783 131E 11 0D 0A ldm long_d+2 ;get last byte to shift 0784 1321 12 FE 09 stm byte_a ;no need to check carry out 0785 1324 call3(shift_right_one) 0785 1324 0785 1324 11 33 13 0785 1327 12 76 0A 0785 132A 11 34 13 0785 132D 12 77 0A 0785 1330 13 8D 11 0785 1333 35 13 0786 1335 12 00 0A stm byte_c ;temp store shifted byte 0787 1338 11 23 0A ldm rs_carry_in 0788 133B 14 46 13 jpz rsl_no_carry_in_2 ;carry-in? 0789 133E 10 80 ldi 10000000b ;no, skip carry-in 0790 1340 05 00 0A orm byte_c ;yes, put carry in bit 7 and store 0791 1343 13 49 13 jmp rsl_store_2 0792 1346 11 00 0A rsl_no_carry_in_2: ldm byte_c ;no carry, get shifted byte back and 0793 1349 12 0D 0A rsl_store_2: stm long_d+2 ;store shifted byte 0794 134C ret2 0794 134C 13 45 08 0795 134F 0796 134F ;Subroutine to shift left one a 48-bit value 0797 134F ;48-bit value in double_long_a 0798 134F ;Call as level 2 subroutine 0799 134F ;Result in double_long_a 0800 134F 0801 134F 11 16 0A sh_left_double ldm double_long_a+5 0802 1352 12 00 0A stm byte_c 0803 1355 0C 80 andi 10000000b ;check leftmost bit 0804 1357 12 26 0A stm ls_carry_out ;save for carry-in at next step 0805 135A 11 00 0A ldm byte_c 0806 135D 12 FE 09 stm byte_a 0807 1360 call3(shift_left_one) 0807 1360 0807 1360 11 6F 13 0807 1363 12 76 0A 0807 1366 11 70 13 0807 1369 12 77 0A 0807 136C 13 0C 11 0807 136F 71 13 0808 1371 12 16 0A stm double_long_a+5 ;store shifted byte 0809 1374 11 26 0A ldm ls_carry_out 0810 1377 12 25 0A stm ls_carry_in ;carry-out becomes carry-in for next shift 0811 137A 11 15 0A ldm double_long_a+4 ;get next byte to shift 0812 137D 12 00 0A stm byte_c ;temp storage 0813 1380 0C 80 andi 10000000b 0814 1382 12 26 0A stm ls_carry_out ;save carry-out before shift 0815 1385 11 00 0A ldm byte_c 0816 1388 12 FE 09 stm byte_a 0817 138B call3(shift_left_one) ;shift one left 0817 138B 0817 138B 11 9A 13 0817 138E 12 76 0A 0817 1391 11 9B 13 0817 1394 12 77 0A 0817 1397 13 0C 11 0817 139A 9C 13 0818 139C 12 00 0A stm byte_c ;temp store shifted byte 0819 139F 11 25 0A ldm ls_carry_in 0820 13A2 14 AD 13 jpz ls_no_carry_in_1 ;carry-in? 0821 13A5 10 01 ldi 00000001b ;no, skip carry-in 0822 13A7 05 00 0A orm byte_c ;yes, put carry in bit 0 and store 0823 13AA 13 B0 13 jmp ls_store_1 0824 13AD 11 00 0A ls_no_carry_in_1: ldm byte_c ;no carry, get shifted byte back and 0825 13B0 12 15 0A ls_store_1: stm double_long_a+4 ;store shifted byte 0826 13B3 11 26 0A ldm ls_carry_out 0827 13B6 12 25 0A stm ls_carry_in ;carry-out becomes carry-in for next shift 0828 13B9 11 14 0A ldm double_long_a+3 ;get next byte to shift 0829 13BC 12 00 0A stm byte_c ;temp storage 0830 13BF 0C 80 andi 10000000b 0831 13C1 12 26 0A stm ls_carry_out ;save carry-out 0832 13C4 11 00 0A ldm byte_c 0833 13C7 12 FE 09 stm byte_a 0834 13CA call3(shift_left_one) 0834 13CA 0834 13CA 11 D9 13 0834 13CD 12 76 0A 0834 13D0 11 DA 13 0834 13D3 12 77 0A 0834 13D6 13 0C 11 0834 13D9 DB 13 0835 13DB 12 00 0A stm byte_c ;temp store shifted byte 0836 13DE 11 25 0A ldm ls_carry_in 0837 13E1 14 EC 13 jpz ls_no_carry_in_2 ;carry-in? 0838 13E4 10 01 ldi 00000001b ;no, skip carry-in 0839 13E6 05 00 0A orm byte_c ;yes, put carry in bit 0 and store 0840 13E9 13 EF 13 jmp ls_store_2 0841 13EC 11 00 0A ls_no_carry_in_2: ldm byte_c ;no carry, get shifted byte back and 0842 13EF 12 14 0A ls_store_2: stm double_long_a+3 ;store shifted byte 0843 13F2 11 26 0A ldm ls_carry_out 0844 13F5 12 25 0A stm ls_carry_in ;carry-out becomes carry-in for next shift 0845 13F8 11 13 0A ldm double_long_a+2 ;get next byte to shift 0846 13FB 12 00 0A stm byte_c ;temp storage 0847 13FE 0C 80 andi 10000000b 0848 1400 12 26 0A stm ls_carry_out ;save carry-out 0849 1403 11 00 0A ldm byte_c 0850 1406 12 FE 09 stm byte_a 0851 1409 call3(shift_left_one) 0851 1409 0851 1409 11 18 14 0851 140C 12 76 0A 0851 140F 11 19 14 0851 1412 12 77 0A 0851 1415 13 0C 11 0851 1418 1A 14 0852 141A 12 00 0A stm byte_c ;temp store shifted byte 0853 141D 11 25 0A ldm ls_carry_in 0854 1420 14 2B 14 jpz ls_no_carry_in_3 ;carry-in? 0855 1423 10 01 ldi 00000001b ;no, skip carry-in 0856 1425 05 00 0A orm byte_c ;yes, put carry in bit 0 and store 0857 1428 13 2E 14 jmp ls_store_3 0858 142B 11 00 0A ls_no_carry_in_3: ldm byte_c ;no carry, get shifted byte back and 0859 142E 12 13 0A ls_store_3: stm double_long_a+2 ;store shifted byte 0860 1431 11 26 0A ldm ls_carry_out 0861 1434 12 25 0A stm ls_carry_in ;carry-out becomes carry-in for next shift 0862 1437 11 12 0A ldm double_long_a+1 ;get next byte to shift 0863 143A 12 00 0A stm byte_c ;temp storage 0864 143D 0C 80 andi 10000000b 0865 143F 12 26 0A stm ls_carry_out ;save carry-out 0866 1442 11 00 0A ldm byte_c 0867 1445 12 FE 09 stm byte_a 0868 1448 call3(shift_left_one) 0868 1448 0868 1448 11 57 14 0868 144B 12 76 0A 0868 144E 11 58 14 0868 1451 12 77 0A 0868 1454 13 0C 11 0868 1457 59 14 0869 1459 12 00 0A stm byte_c ;temp store shifted byte 0870 145C 11 25 0A ldm ls_carry_in 0871 145F 14 6A 14 jpz ls_no_carry_in_4 ;carry-in? 0872 1462 10 01 ldi 00000001b ;no, skip carry-in 0873 1464 05 00 0A orm byte_c ;yes, put in bit 0 and store 0874 1467 13 6D 14 jmp ls_store_4 0875 146A 11 00 0A ls_no_carry_in_4: ldm byte_c ;no carry, get shifted byte back and 0876 146D 12 12 0A ls_store_4: stm double_long_a+1 ;store shifted byte 0877 1470 11 26 0A ldm ls_carry_out 0878 1473 12 25 0A stm ls_carry_in ;carry-out becomes carry-in for next shift 0879 1476 11 11 0A ldm double_long_a 0880 1479 12 FE 09 stm byte_a ;get next byte to shift 0881 147C call3(shift_left_one) 0881 147C 0881 147C 11 8B 14 0881 147F 12 76 0A 0881 1482 11 8C 14 0881 1485 12 77 0A 0881 1488 13 0C 11 0881 148B 8D 14 0882 148D 12 00 0A stm byte_c ;temp store shifted byte 0883 1490 11 25 0A ldm ls_carry_in 0884 1493 14 9E 14 jpz ls_no_carry_in_5 ;carry-in? 0885 1496 10 01 ldi 00000001b ;no, skip carry-in 0886 1498 05 00 0A orm byte_c ;yes, put in bit 7 and store 0887 149B 13 A1 14 jmp ls_store_5 0888 149E 11 00 0A ls_no_carry_in_5: ldm byte_c ;no carry, get shifted byte back and 0889 14A1 12 11 0A ls_store_5: stm double_long_a ;store shifted byte 0890 14A4 ret2 0890 14A4 13 45 08 0891 14A7 0892 14A7 ;Subroutine to shift right one a 48-bit value 0893 14A7 ;48-bit value in double_long_a 0894 14A7 ;Call as level 2 subroutine 0895 14A7 ;shifted value returned in double_long_a 0896 14A7 11 11 0A sh_right_double ldm double_long_a 0897 14AA 12 00 0A stm byte_c 0898 14AD 0C 01 andi 00000001b ;check rightmost bit 0899 14AF 12 24 0A stm rs_carry_out ;save for carry-in at next step 0900 14B2 11 00 0A ldm byte_c 0901 14B5 12 FE 09 stm byte_a ;shift routine needs byte in byte_a 0902 14B8 call3(shift_right_one) 0902 14B8 0902 14B8 11 C7 14 0902 14BB 12 76 0A 0902 14BE 11 C8 14 0902 14C1 12 77 0A 0902 14C4 13 8D 11 0902 14C7 C9 14 0903 14C9 12 11 0A stm double_long_a ;store shifted byte 0904 14CC 11 24 0A ldm rs_carry_out 0905 14CF 12 23 0A stm rs_carry_in ;carry-out becomes carry-in for next shift 0906 14D2 11 12 0A ldm double_long_a+1 ;get next byte to shift 0907 14D5 12 00 0A stm byte_c ;temp storage 0908 14D8 0C 01 andi 00000001b 0909 14DA 12 24 0A stm rs_carry_out ;save carry-out before shift 0910 14DD 11 00 0A ldm byte_c 0911 14E0 12 FE 09 stm byte_a 0912 14E3 call3(shift_right_one) ;shift one right 0912 14E3 0912 14E3 11 F2 14 0912 14E6 12 76 0A 0912 14E9 11 F3 14 0912 14EC 12 77 0A 0912 14EF 13 8D 11 0912 14F2 F4 14 0913 14F4 12 00 0A stm byte_c ;temp store shifted byte 0914 14F7 11 23 0A ldm rs_carry_in 0915 14FA 14 05 15 jpz rs_no_carry_in_1 ;carry-in? 0916 14FD 10 80 ldi 10000000b ;no, skip carry-in 0917 14FF 05 00 0A orm byte_c ;yes, put carry in bit 7 and store 0918 1502 13 08 15 jmp rs_store_1 0919 1505 11 00 0A rs_no_carry_in_1: ldm byte_c ;no carry, get shifted byte back and 0920 1508 12 12 0A rs_store_1: stm double_long_a+1 ;store shifted byte 0921 150B 11 24 0A ldm rs_carry_out 0922 150E 12 23 0A stm rs_carry_in ;carry-out becomes carry-in for next shift 0923 1511 11 13 0A ldm double_long_a+2 ;get next byte to shift 0924 1514 12 00 0A stm byte_c ;temp storage 0925 1517 0C 01 andi 00000001b 0926 1519 12 24 0A stm rs_carry_out ;save carry-out 0927 151C 11 00 0A ldm byte_c 0928 151F 12 FE 09 stm byte_a 0929 1522 call3(shift_right_one) 0929 1522 0929 1522 11 31 15 0929 1525 12 76 0A 0929 1528 11 32 15 0929 152B 12 77 0A 0929 152E 13 8D 11 0929 1531 33 15 0930 1533 12 00 0A stm byte_c ;temp store shifted byte 0931 1536 11 23 0A ldm rs_carry_in 0932 1539 14 44 15 jpz rs_no_carry_in_2 ;carry-in? 0933 153C 10 80 ldi 10000000b ;no, skip carry-in 0934 153E 05 00 0A orm byte_c ;yes, put carry in bit 7 and store 0935 1541 13 47 15 jmp rs_store_2 0936 1544 11 00 0A rs_no_carry_in_2: ldm byte_c ;no carry, get shifted byte back and 0937 1547 12 13 0A rs_store_2: stm double_long_a+2 ;store shifted byte 0938 154A 11 24 0A ldm rs_carry_out 0939 154D 12 23 0A stm rs_carry_in ;carry-out becomes carry-in for next shift 0940 1550 11 14 0A ldm double_long_a+3 ;get next byte to shift 0941 1553 12 00 0A stm byte_c ;temp storage 0942 1556 0C 01 andi 00000001b 0943 1558 12 24 0A stm rs_carry_out ;save carry-out 0944 155B 11 00 0A ldm byte_c 0945 155E 12 FE 09 stm byte_a 0946 1561 call3(shift_right_one) 0946 1561 0946 1561 11 70 15 0946 1564 12 76 0A 0946 1567 11 71 15 0946 156A 12 77 0A 0946 156D 13 8D 11 0946 1570 72 15 0947 1572 12 00 0A stm byte_c ;temp store shifted byte 0948 1575 11 23 0A ldm rs_carry_in 0949 1578 14 83 15 jpz rs_no_carry_in_3 ;carry-in? 0950 157B 10 80 ldi 10000000b ;no, skip carry-in 0951 157D 05 00 0A orm byte_c ;yes, put carry in bit 7 and store 0952 1580 13 86 15 jmp rs_store_3 0953 1583 11 00 0A rs_no_carry_in_3: ldm byte_c ;no carry, get shifted byte back and 0954 1586 12 14 0A rs_store_3: stm double_long_a+3 ;store shifted byte 0955 1589 11 24 0A ldm rs_carry_out 0956 158C 12 23 0A stm rs_carry_in ;carry-out becomes carry-in for next shift 0957 158F 11 15 0A ldm double_long_a+4 ;get next byte to shift 0958 1592 12 00 0A stm byte_c ;temp storage 0959 1595 0C 01 andi 00000001b 0960 1597 12 24 0A stm rs_carry_out ;save carry-out 0961 159A 11 00 0A ldm byte_c 0962 159D 12 FE 09 stm byte_a 0963 15A0 call3(shift_right_one) 0963 15A0 0963 15A0 11 AF 15 0963 15A3 12 76 0A 0963 15A6 11 B0 15 0963 15A9 12 77 0A 0963 15AC 13 8D 11 0963 15AF B1 15 0964 15B1 12 00 0A stm byte_c ;temp store shifted byte 0965 15B4 11 23 0A ldm rs_carry_in 0966 15B7 14 C2 15 jpz rs_no_carry_in_4 ;carry-in? 0967 15BA 10 80 ldi 10000000b ;no, skip carry-in 0968 15BC 05 00 0A orm byte_c ;yes, put in bit 7 and store 0969 15BF 13 C5 15 jmp rs_store_4 0970 15C2 11 00 0A rs_no_carry_in_4: ldm byte_c ;no carry, get shifted byte back and 0971 15C5 12 15 0A rs_store_4: stm double_long_a+4 ;store shifted byte 0972 15C8 11 24 0A ldm rs_carry_out 0973 15CB 12 23 0A stm rs_carry_in ;carry-out becomes carry-in for next shift 0974 15CE 11 16 0A ldm double_long_a+5 ;get next byte to shift 0975 15D1 12 FE 09 stm byte_a 0976 15D4 call3(shift_right_one) 0976 15D4 0976 15D4 11 E3 15 0976 15D7 12 76 0A 0976 15DA 11 E4 15 0976 15DD 12 77 0A 0976 15E0 13 8D 11 0976 15E3 E5 15 0977 15E5 12 00 0A stm byte_c ;temp store shifted byte 0978 15E8 11 23 0A ldm rs_carry_in 0979 15EB 14 F6 15 jpz rs_no_carry_in_5 ;carry-in? 0980 15EE 10 80 ldi 10000000b ;no, skip carry-in 0981 15F0 05 00 0A orm byte_c ;yes, put in bit 7 and store 0982 15F3 13 F9 15 jmp rs_store_5 0983 15F6 11 00 0A rs_no_carry_in_5: ldm byte_c ;no carry, get shifted byte back and 0984 15F9 12 16 0A rs_store_5: stm double_long_a+5 ;store shifted byte 0985 15FC ret2 0985 15FC 13 45 08 0986 15FF 0987 15FF ;Multiply long integers, using shift and add 0988 15FF ;Call as level 1 subroutine 0989 15FF ;Long words passed in long_a and long_b 0990 15FF ;Product returned in double_long_b 0991 15FF ;Uses double_long_a to hold multiplicand for shifting 0992 15FF ;Uses double_long_b for 48-bit addition 0993 15FF ;Uses long_c for mask for multiplicand bits in long_b 0994 15FF 0995 15FF 10 00 multiply_long: ldi 0 0996 1601 12 11 0A stm double_long_a ;clear multiplicand word 0997 1604 12 12 0A stm double_long_a+1 0998 1607 12 13 0A stm double_long_a+2 0999 160A 12 14 0A stm double_long_a+3 1000 160D 12 15 0A stm double_long_a+4 1001 1610 12 16 0A stm double_long_a+5 1002 1613 12 17 0A stm double_long_b ;clear product word 1003 1616 12 18 0A stm double_long_b+1 1004 1619 12 19 0A stm double_long_b+2 1005 161C 12 1A 0A stm double_long_b+3 1006 161F 12 1B 0A stm double_long_b+4 1007 1622 12 1C 0A stm double_long_b+5 1008 1625 12 08 0A stm long_c 1009 1628 12 09 0A stm long_c+1 1010 162B 10 01 ldi 00000001b ;mask for multiplicand b bits 1011 162D 12 0A 0A stm long_c+2 1012 1630 11 04 0A ldm long_a+2 1013 1633 12 16 0A stm double_long_a+5 ;place multiplicand a in double_long_a 1014 1636 11 03 0A ldm long_a+1 1015 1639 12 15 0A stm double_long_a+4 1016 163C 11 02 0A ldm long_a 1017 163F 12 14 0A stm double_long_a+3 1018 1642 1019 1642 11 07 0A mult_long_loop: ldm long_b+2 ;check bit in multiplicand b with mask 1020 1645 04 0A 0A andm long_c+2 ;mask in long_c 1021 1648 14 4E 16 jpz mult_long_next_1 ;need to check all 3 bytes 1022 164B 13 63 16 jmp mult_long_add ;bit is one, add 1023 164E 11 06 0A mult_long_next_1: ldm long_b+1 1024 1651 04 09 0A andm long_c+1 1025 1654 14 5A 16 jpz mult_long_next_2 1026 1657 13 63 16 jmp mult_long_add 1027 165A 11 05 0A mult_long_next_2: ldm long_b 1028 165D 04 08 0A andm long_c 1029 1660 14 99 16 jpz mult_long_shift ;bit is zero, don't add, shift multiplicand 1030 1663 1031 1663 11 1C 0A mult_long_add: ldm double_long_b+5 ;bit is one, add multiplicand a to product b 1032 1666 00 16 0A addm double_long_a+5 ;48-bit addition 1033 1669 12 1C 0A stm double_long_b+5 ;product will accumulate in double_long_b 1034 166C 11 1B 0A ldm double_long_b+4 1035 166F 01 15 0A adcm double_long_a+4 1036 1672 12 1B 0A stm double_long_b+4 1037 1675 11 1A 0A ldm double_long_b+3 1038 1678 01 14 0A adcm double_long_a+3 1039 167B 12 1A 0A stm double_long_b+3 1040 167E 11 19 0A ldm double_long_b+2 1041 1681 01 13 0A adcm double_long_a+2 1042 1684 12 19 0A stm double_long_b+2 1043 1687 11 18 0A ldm double_long_b+1 1044 168A 01 12 0A adcm double_long_a+1 1045 168D 12 18 0A stm double_long_b+1 1046 1690 11 17 0A ldm double_long_b 1047 1693 01 11 0A adcm double_long_a 1048 1696 12 17 0A stm double_long_b ;partial product in double_long_b 1049 1699 1050 1699 mult_long_shift: call2(sh_left_double) ;shifts multiplicand in double_long_a 1050 1699 1050 1699 11 A8 16 1050 169C 12 46 08 1050 169F 11 A9 16 1050 16A2 12 47 08 1050 16A5 13 4F 13 1050 16A8 AA 16 1051 16AA call2(shift_left_long) ;shifts mask in long_c left one 1051 16AA 1051 16AA 11 B9 16 1051 16AD 12 46 08 1051 16B0 11 BA 16 1051 16B3 12 47 08 1051 16B6 13 0E 12 1051 16B9 BB 16 1052 16BB 11 08 0A ldm long_c ;check long_c if zero (24 shifts done) 1053 16BE 05 09 0A orm long_c+1 1054 16C1 05 0A 0A orm long_c+2 1055 16C4 14 CA 16 jpz mult_long_done ;mask bytes all zeros, done 1056 16C7 13 42 16 jmp mult_long_loop ;not zero, keep multiplying 1057 16CA 1058 16CA mult_long_done ret1 1058 16CA 13 42 08 1059 16CD 1060 16CD ;Subroutine for 24-bit division 1061 16CD ;Call as level 1 1062 16CD ;Divisor passed in long_a 1063 16CD ;Dividend passed in long_b 1064 16CD ;Divisor and dividend words must be left-aligned before passing 1065 16CD ;Does not check for zero divisor 1066 16CD ;Uses double_long_a, b and c and long_d for calculation 1067 16CD ;Quotient returned in long_c 1068 16CD ;Remainder returned in long_r 1069 16CD 1070 16CD 10 00 divide_long: ldi 0 ;clear variables used in calculation 1071 16CF 12 11 0A stm double_long_a 1072 16D2 12 12 0A stm double_long_a+1 1073 16D5 12 13 0A stm double_long_a+2 1074 16D8 12 14 0A stm double_long_a+3 1075 16DB 12 15 0A stm double_long_a+4 1076 16DE 12 16 0A stm double_long_a+5 1077 16E1 12 17 0A stm double_long_b 1078 16E4 12 18 0A stm double_long_b+1 1079 16E7 12 19 0A stm double_long_b+2 1080 16EA 12 1A 0A stm double_long_b+3 1081 16ED 12 1B 0A stm double_long_b+4 1082 16F0 12 1C 0A stm double_long_b+5 1083 16F3 12 1D 0A stm double_long_c 1084 16F6 12 1E 0A stm double_long_c+1 1085 16F9 12 1F 0A stm double_long_c+2 1086 16FC 12 20 0A stm double_long_c+3 1087 16FF 12 21 0A stm double_long_c+4 1088 1702 12 22 0A stm double_long_c+5 1089 1705 12 08 0A stm long_c ;clear quotient 1090 1708 12 09 0A stm long_c+1 1091 170B 12 0A 0A stm long_c+2 1092 170E 10 80 ldi 10000000b ;Set up mask to OR-in quotient bits 1093 1710 12 0B 0A stm long_d 1094 1713 10 00 ldi 0 1095 1715 12 0C 0A stm long_d+1 1096 1718 12 0D 0A stm long_d+2 1097 171B 10 18 ldi 24 1098 171D 12 27 0A stm divide_rounds ;maximum rounds of division 1099 1720 11 02 0A ldm long_a ;set up divisor and dividend in 48-bit words 1100 1723 12 11 0A stm double_long_a ;divisor 1101 1726 11 03 0A ldm long_a+1 1102 1729 12 12 0A stm double_long_a+1 1103 172C 11 04 0A ldm long_a+2 1104 172F 12 13 0A stm double_long_a+2 1105 1732 11 05 0A ldm long_b ;dividend 1106 1735 12 17 0A stm double_long_b 1107 1738 11 06 0A ldm long_b+1 1108 173B 12 18 0A stm double_long_b+1 1109 173E 11 07 0A ldm long_b+2 1110 1741 12 19 0A stm double_long_b+2 1111 1744 1112 1744 11 1C 0A long_divide_loop: ldm double_long_b+5 ;48-bit subtraction of divisor from dividend 1113 1747 02 16 0A subm double_long_a+5 ;B - A is dividend - divisor 1114 174A 12 22 0A stm double_long_c+5 ;result placed in double_long_c 1115 174D 11 1B 0A ldm double_long_b+4 ;move through bytes right to left 1116 1750 03 15 0A sbbm double_long_a+4 1117 1753 12 21 0A stm double_long_c+4 1118 1756 11 1A 0A ldm double_long_b+3 1119 1759 03 14 0A sbbm double_long_a+3 1120 175C 12 20 0A stm double_long_c+3 1121 175F 11 19 0A ldm double_long_b+2 ;move through bytes right to left 1122 1762 03 13 0A sbbm double_long_a+2 1123 1765 12 1F 0A stm double_long_c+2 1124 1768 11 18 0A ldm double_long_b+1 ;move through bytes right to left 1125 176B 03 12 0A sbbm double_long_a+1 1126 176E 12 1E 0A stm double_long_c+1 1127 1771 11 17 0A ldm double_long_b ;move through bytes right to left 1128 1774 03 11 0A sbbm double_long_a 1129 1777 12 1D 0A stm double_long_c ;double_long_c now has result of subtraction 1130 177A 16 9B 17 jpc long_quotient_one ;no borrow, put 1 in quotient and replace dividend 1131 177D 1132 177D 11 27 0A ldm divide_rounds ;borrow, leave 0 in quotient 1133 1780 1A dec ;check if reached divide limit 1134 1781 14 1E 18 jpz long_divide_done ;24 rounds done, quit 1135 1784 12 27 0A stm divide_rounds ;more rounds to do, go on 1136 1787 call2(shift_right_long) ;shift mask in long_d right one 1136 1787 1136 1787 11 96 17 1136 178A 12 46 08 1136 178D 11 97 17 1136 1790 12 47 08 1136 1793 13 B4 12 1136 1796 98 17 1137 1798 13 0A 18 jmp long_divisor_shift ;do not replace dividend, shift divisor 1138 179B 1139 179B 11 08 0A long_quotient_one: ldm long_c ;place a one in quotient word 1140 179E 05 0B 0A orm long_d ;uses long_d as mask for quotient bits 1141 17A1 12 08 0A stm long_c 1142 17A4 11 09 0A ldm long_c+1 1143 17A7 05 0C 0A orm long_d+1 1144 17AA 12 09 0A stm long_c+1 1145 17AD 11 0A 0A ldm long_c+2 1146 17B0 05 0D 0A orm long_d+2 1147 17B3 12 0A 0A stm long_c+2 1148 17B6 1149 17B6 11 1D 0A ldm double_long_c ;replace dividend with subtracted dividend 1150 17B9 12 17 0A stm double_long_b 1151 17BC 11 1E 0A ldm double_long_c+1 1152 17BF 12 18 0A stm double_long_b+1 1153 17C2 11 1F 0A ldm double_long_c+2 1154 17C5 12 19 0A stm double_long_b+2 1155 17C8 11 20 0A ldm double_long_c+3 1156 17CB 12 1A 0A stm double_long_b+3 1157 17CE 11 21 0A ldm double_long_c+4 1158 17D1 12 1B 0A stm double_long_b+4 1159 17D4 11 22 0A ldm double_long_c+5 1160 17D7 12 1C 0A stm double_long_b+5 1161 17DA 1162 17DA 11 17 0A ldm double_long_b ;check if remainder zero 1163 17DD 05 18 0A orm double_long_b+1 1164 17E0 05 19 0A orm double_long_b+2 1165 17E3 05 1A 0A orm double_long_b+3 1166 17E6 05 1B 0A orm double_long_b+4 1167 17E9 05 1C 0A orm double_long_b+5 1168 17EC 14 1E 18 jpz long_divide_done ;remainder zero, quit 1169 17EF 11 27 0A ldm divide_rounds ;remainder not zero, check if reached divide limit 1170 17F2 1A dec 1171 17F3 14 1E 18 jpz long_divide_done ;24 rounds done, quit 1172 17F6 12 27 0A stm divide_rounds ;more rounds to do, go on 1173 17F9 call2(shift_right_long) ;subroutine shifts mask in long_d one right 1173 17F9 1173 17F9 11 08 18 1173 17FC 12 46 08 1173 17FF 11 09 18 1173 1802 12 47 08 1173 1805 13 B4 12 1173 1808 0A 18 1174 180A 1175 180A long_divisor_shift: call2(sh_right_double) ;shift divisor in double_long_a one position 1175 180A 1175 180A 11 19 18 1175 180D 12 46 08 1175 1810 11 1A 18 1175 1813 12 47 08 1175 1816 13 A7 14 1175 1819 1B 18 1176 181B 13 44 17 jmp long_divide_loop 1177 181E 1178 181E 11 22 0A long_divide_done: ldm double_long_c+5 ;put remainder in long_r 1179 1821 12 10 0A stm long_r+2 1180 1824 11 21 0A ldm double_long_c+4 1181 1827 12 0F 0A stm long_r+1 1182 182A 11 20 0A ldm double_long_c+3 1183 182D 12 0E 0A stm long_r 1184 1830 1185 1830 ret1 1185 1830 13 42 08 1186 1833 1187 1833 1188 1833 ;Subroutine for division of floating point numbers 1189 1833 ;Call as level 0 subroutine 1190 1833 ;Performs fp_a divided by fp_b (that is, fp_a is dividend, fp_b is divisor) 1191 1833 ;Uses long_a, long_b, long_c and long_d to perform calculation 1192 1833 ;Quotient returned in fp_c 1193 1833 ;Does not check for zero divisor 1194 1833 1195 1833 divide_float: 1196 1833 1197 1833 ;Calculate sign of quotient first (same as in multiplication) 1198 1833 11 28 0A ldm fp_a 1199 1836 06 2C 0A xorm fp_b ;sign of result is XOR of signs of products 1200 1839 0C 80 andi 10000000b ;mask off remaining bits 1201 183B 12 F7 09 stm sign ;sign is 8-bit mask used to OR-in the sign bit 1202 183E 1203 183E ;Calculate exponent of quotient (same as in multiplication, except subtract exp of fp_b from exp fp_a 1204 183E ;Get exponent of a 1205 183E 11 28 0A ldm fp_a ;need to get bit 0 of exponent from bit 7 of 1206 1841 12 FE 09 stm byte_a 1207 1844 call3(shift_left_one) ;fp_a+1 and combine with the rest of the 1207 1844 1207 1844 11 53 18 1207 1847 12 76 0A 1207 184A 11 54 18 1207 184D 12 77 0A 1207 1850 13 0C 11 1207 1853 55 18 1208 1855 12 F8 09 stm exponent_a ;exponent from fp_a 1209 1858 11 29 0A ldm fp_a+1 ;is bit 7 one? 1210 185B 0C 80 andi 10000000b 1211 185D 14 68 18 jpz dfp_next_2 ;no, skip OR-in (will have a zero from shift) 1212 1860 11 F8 09 ldm exponent_a 1213 1863 0D 01 ori 00000001b ;yes, OR-in a 1 in bit 0 of exponent byte 1214 1865 12 F8 09 stm exponent_a 1215 1868 1216 1868 ;Remove exponent bias and save 1217 1868 11 F8 09 dfp_next_2: ldm exponent_a ;exponent_a has biased exponent 1218 186B 0A 7F subi 127 ;exponent bias 1219 186D 12 F8 09 stm exponent_a ;exponent_a has unbiased exponent 1220 1870 1221 1870 ;Get exponent of b 1222 1870 11 2C 0A ldm fp_b ;need to get bit 0 of exponent from bit 7 of 1223 1873 12 FE 09 stm byte_a 1224 1876 call3(shift_left_one) ;fp_a+1 and combine with the rest of the 1224 1876 1224 1876 11 85 18 1224 1879 12 76 0A 1224 187C 11 86 18 1224 187F 12 77 0A 1224 1882 13 0C 11 1224 1885 87 18 1225 1887 12 F9 09 stm exponent_b ;exponent from fp_a 1226 188A 11 2D 0A ldm fp_b+1 ;is bit 7 one? 1227 188D 0C 80 andi 10000000b 1228 188F 14 9A 18 jpz dfp_next_3 ;no, skip OR-in (will have a zero from shift) 1229 1892 11 F9 09 ldm exponent_b 1230 1895 0D 01 ori 00000001b ;yes, OR-in a 1 in bit 0 of exponent byte 1231 1897 12 F9 09 stm exponent_b 1232 189A 1233 189A ;Remove exponent bias and save 1234 189A 11 F9 09 dfp_next_3: ldm exponent_b ;exponent_a has biased exponent 1235 189D 0A 7F subi 127 ;exponent bias 1236 189F 12 F9 09 stm exponent_b ;exponent_a has unbiased exponent 1237 18A2 1238 18A2 ;Subtract unbiased exponents and save 1239 18A2 11 F8 09 ldm exponent_a ;subtract unbiased exponents A - B 1240 18A5 02 F9 09 subm exponent_b 1241 18A8 12 FA 09 stm exponent_c ;exponent_c has unbiased exponent of quotient 1242 18AB 1243 18AB ;Divide significands 1244 18AB 11 29 0A ldm fp_a+1 ;need to set leftmost bit of significand to one 1245 18AE 0D 80 ori 10000000b ;this bit is implied but not stored in fp 1246 18B0 12 05 0A stm long_b ;for divide_long routine, divisor must be 1247 18B3 11 2A 0A ldm fp_a+2 ;in long_a, dividend in long_b 1248 18B6 12 06 0A stm long_b+1 1249 18B9 11 2B 0A ldm fp_a+3 1250 18BC 12 07 0A stm long_b+2 1251 18BF 1252 18BF 11 2D 0A ldm fp_b+1 1253 18C2 0D 80 ori 10000000b 1254 18C4 12 02 0A stm long_a 1255 18C7 11 2E 0A ldm fp_b+2 1256 18CA 12 03 0A stm long_a+1 1257 18CD 11 2F 0A ldm fp_b+3 1258 18D0 12 04 0A stm long_a+2 1259 18D3 call1(divide_long) ;returns quotient in long_c, remainder in long_r 1259 18D3 1259 18D3 11 E2 18 1259 18D6 12 43 08 1259 18D9 11 E3 18 1259 18DC 12 44 08 1259 18DF 13 CD 16 1259 18E2 E4 18 1260 18E4 1261 18E4 ;Rounding code after division 1262 18E4 ;If remainder returned in long_r is greater than or equal to half the divisor in long_a, add one to quotient in long_c 1263 18E4 ;First divide long_a by 2 using right shift, and add one if rightmost-bit one (round quotient up) 1264 18E4 1265 18E4 11 02 0A ldm long_a ;put long_a into long_d 1266 18E7 12 0B 0A stm long_d 1267 18EA 11 03 0A ldm long_a+1 1268 18ED 12 0C 0A stm long_d+1 1269 18F0 11 04 0A ldm long_a+2 1270 18F3 12 0D 0A stm long_d+2 1271 18F6 call2(shift_right_long) ;shifts long_d (divide by 2) 1271 18F6 1271 18F6 11 05 19 1271 18F9 12 46 08 1271 18FC 11 06 19 1271 18FF 12 47 08 1271 1902 13 B4 12 1271 1905 07 19 1272 1907 1273 1907 ;long_d now holds long_a (divisor) divided by 2, subtract this from the remainder in long_r 1274 1907 1275 1907 11 10 0A ldm long_r+2 ;long_r minus long_d 1276 190A 02 0D 0A subm long_d+2 ;do not store the result, only interested in final borrow 1277 190D 11 0F 0A ldm long_r+1 1278 1910 03 0C 0A sbbm long_d+1 1279 1913 11 0E 0A ldm long_r 1280 1916 03 0B 0A sbbm long_d 1281 1919 16 1F 19 jpc dfp_skip_3 ;no borrow 1282 191C 13 37 19 jmp dfp_loop_1 ;borrow, so no round up (one-half divisor greater than rem.) 1283 191F 11 0A 0A dfp_skip_3 ldm long_c+2 ;no borrow, so round up quotient 24-bit add one 1284 1922 08 01 addi 1 1285 1924 12 0A 0A stm long_c+2 1286 1927 11 09 0A ldm long_c+1 1287 192A 09 00 adci 0 1288 192C 12 09 0A stm long_c+1 1289 192F 11 08 0A ldm long_c 1290 1932 09 00 adci 0 1291 1934 12 08 0A stm long_c 1292 1937 1293 1937 ;Normalize quotient 1294 1937 11 08 0A dfp_loop_1: ldm long_c ;check leftmost bit of quotient 1295 193A 0C 80 andi 10000000b ;test leftmost bit of quotient 1296 193C 14 42 19 jpz dfp_skip_4 1297 193F 13 5D 19 jmp dfp_next_5 ;normalized, assemble final fp 1298 1942 dfp_skip_4 call2(shift_left_long) ;not normalized, shift left and dec exponent 1298 1942 1298 1942 11 51 19 1298 1945 12 46 08 1298 1948 11 52 19 1298 194B 12 47 08 1298 194E 13 0E 12 1298 1951 53 19 1299 1953 11 FA 09 ldm exponent_c 1300 1956 1A dec 1301 1957 12 FA 09 stm exponent_c 1302 195A 13 37 19 jmp dfp_loop_1 1303 195D 1304 195D ;Assemble final fp 1305 195D 11 FA 09 dfp_next_5: ldm exponent_c ;First byte is sign bit and bits 7 to 1 of exponent 1306 1960 08 7F addi 127 ;get quotient exponent and add bias 1307 1962 12 FA 09 stm exponent_c ;exponent_c now has biased exponent 1308 1965 12 FE 09 stm byte_a 1309 1968 call3(shift_right_one) ;move over for sign bit 1309 1968 1309 1968 11 77 19 1309 196B 12 76 0A 1309 196E 11 78 19 1309 1971 12 77 0A 1309 1974 13 8D 11 1309 1977 79 19 1310 1979 05 F7 09 orm sign ;put sign bit in 1311 197C 12 30 0A stm fp_c ;First byte done 1312 197F 11 08 0A ldm long_c ;get first byte of mantissa 1313 1982 12 31 0A stm fp_c+1 ;store in second byte of fp 1314 1985 11 FA 09 ldm exponent_c ;check bit 0 of biased exponent 1315 1988 0C 01 andi 00000001b ;test bit 0 of exponent 1316 198A 14 90 19 jpz dfp_skip_5 ;bit is 0, mask off bit 7 of fp_c+1 1317 198D 13 98 19 jmp dfp_next_6 ;bit is one, leave one in bit 7 of fp_c+1 1318 1990 11 31 0A dfp_skip_5 ldm fp_c+1 1319 1993 0C 7F andi 01111111b 1320 1995 12 31 0A stm fp_c+1 1321 1998 11 09 0A dfp_next_6: ldm long_c+1 ;get second and third quotient bytes 1322 199B 12 32 0A stm fp_c+2 1323 199E 11 0A 0A ldm long_c+2 1324 19A1 12 33 0A stm fp_c+3 ;complete fp quotient now assembled in fp_c 1325 19A4 1326 19A4 ret0 1326 19A4 13 3F 08 1327 19A7 1328 19A7 ;Subroutine to multiply two floating-point variables 1329 19A7 ;Call as level 0 subroutine 1330 19A7 ;Multiplies fp_a and fp_b 1331 19A7 ;Result in fp_c 1332 19A7 ;Uses long_a, long_b, and long_c 1333 19A7 1334 19A7 multiply_float: 1335 19A7 ;Calculate sign of product first 1336 19A7 11 28 0A ldm fp_a 1337 19AA 06 2C 0A xorm fp_b ;sign of result is XOR of signs of products 1338 19AD 0C 80 andi 10000000b ;mask off remaining bits 1339 19AF 12 F7 09 stm sign ;sign is 8-bit mask used to OR-in the sign bit 1340 19B2 1341 19B2 ;Calculate exponent of product 1342 19B2 ;Get exponent of a 1343 19B2 11 28 0A ldm fp_a ;need to get bit 0 of exponent from bit 7 of 1344 19B5 12 FE 09 stm byte_a 1345 19B8 call3(shift_left_one) ;fp_a+1 and combine with the rest of the 1345 19B8 1345 19B8 11 C7 19 1345 19BB 12 76 0A 1345 19BE 11 C8 19 1345 19C1 12 77 0A 1345 19C4 13 0C 11 1345 19C7 C9 19 1346 19C9 12 F8 09 stm exponent_a ;exponent from fp_a 1347 19CC 11 29 0A ldm fp_a+1 ;is bit 7 one? 1348 19CF 0C 80 andi 10000000b 1349 19D1 14 DC 19 jpz mfp_next_2 ;no, skip OR-in (will have a zero from shift) 1350 19D4 11 F8 09 ldm exponent_a 1351 19D7 0D 01 ori 00000001b ;yes, OR-in a 1 in bit 0 of exponent byte 1352 19D9 12 F8 09 stm exponent_a 1353 19DC 1354 19DC ;Remove exponent bias and save 1355 19DC 11 F8 09 mfp_next_2: ldm exponent_a ;exponent_a has biased exponent 1356 19DF 0A 7F subi 127 ;exponent bias 1357 19E1 12 F8 09 stm exponent_a ;exponent_a has unbiased exponent 1358 19E4 1359 19E4 ;Get exponent of b 1360 19E4 11 2C 0A ldm fp_b ;need to get bit 0 of exponent from bit 7 of 1361 19E7 12 FE 09 stm byte_a 1362 19EA call3(shift_left_one) ;fp_a+1 and combine with the rest of the 1362 19EA 1362 19EA 11 F9 19 1362 19ED 12 76 0A 1362 19F0 11 FA 19 1362 19F3 12 77 0A 1362 19F6 13 0C 11 1362 19F9 FB 19 1363 19FB 12 F9 09 stm exponent_b ;exponent from fp_a 1364 19FE 11 2D 0A ldm fp_b+1 ;is bit 7 one? 1365 1A01 0C 80 andi 10000000b 1366 1A03 14 0E 1A jpz mfp_next_3 ;no, skip OR-in (will have a zero from shift) 1367 1A06 11 F9 09 ldm exponent_b 1368 1A09 0D 01 ori 00000001b ;yes, OR-in a 1 in bit 0 of exponent byte 1369 1A0B 12 F9 09 stm exponent_b 1370 1A0E 1371 1A0E ;Remove exponent bias and save 1372 1A0E 11 F9 09 mfp_next_3: ldm exponent_b ;exponent_a has biased exponent 1373 1A11 0A 7F subi 127 ;exponent bias 1374 1A13 12 F9 09 stm exponent_b ;exponent_a has unbiased exponent 1375 1A16 1376 1A16 1377 1A16 ;Add unbiased exponents and save 1378 1A16 11 F8 09 ldm exponent_a ;add exponents 1379 1A19 00 F9 09 addm exponent_b 1380 1A1C 12 FA 09 stm exponent_c ;exponent_c has unbiased exponent of product 1381 1A1F 1382 1A1F ;Multiply significands 1383 1A1F 11 29 0A ldm fp_a+1 ;need to set leftmost bit of significand to one 1384 1A22 0D 80 ori 10000000b ;this bit is implied but not stored in fp 1385 1A24 12 02 0A stm long_a 1386 1A27 11 2A 0A ldm fp_a+2 1387 1A2A 12 03 0A stm long_a+1 1388 1A2D 11 2B 0A ldm fp_a+3 1389 1A30 12 04 0A stm long_a+2 1390 1A33 11 2D 0A ldm fp_b+1 1391 1A36 0D 80 ori 10000000b 1392 1A38 12 05 0A stm long_b 1393 1A3B 11 2E 0A ldm fp_b+2 1394 1A3E 12 06 0A stm long_b+1 1395 1A41 11 2F 0A ldm fp_b+3 1396 1A44 12 07 0A stm long_b+2 1397 1A47 call1(multiply_long) 1397 1A47 1397 1A47 11 56 1A 1397 1A4A 12 43 08 1397 1A4D 11 57 1A 1397 1A50 12 44 08 1397 1A53 13 FF 15 1397 1A56 58 1A 1398 1A58 1399 1A58 ;Normalize product 1400 1A58 11 17 0A ldm double_long_b ;put product in double_long_a for shift 1401 1A5B 12 11 0A stm double_long_a 1402 1A5E 11 18 0A ldm double_long_b+1 1403 1A61 12 12 0A stm double_long_a+1 1404 1A64 11 19 0A ldm double_long_b+2 1405 1A67 12 13 0A stm double_long_a+2 1406 1A6A 11 1A 0A ldm double_long_b+3 1407 1A6D 12 14 0A stm double_long_a+3 1408 1A70 11 1B 0A ldm double_long_b+4 1409 1A73 12 15 0A stm double_long_a+4 1410 1A76 11 1C 0A ldm double_long_b+5 1411 1A79 12 16 0A stm double_long_a+5 1412 1A7C 1413 1A7C 11 11 0A mfp_loop_1: ldm double_long_a ;check leftmost bit of product 1414 1A7F 0C 80 andi 10000000b 1415 1A81 14 87 1A jpz mfp_skip_3 ;not normalized, shift left and dec exponent 1416 1A84 13 A2 1A jmp mfp_next_5 ;normalized, assemble final fp 1417 1A87 mfp_skip_3 call2(sh_left_double) 1417 1A87 1417 1A87 11 96 1A 1417 1A8A 12 46 08 1417 1A8D 11 97 1A 1417 1A90 12 47 08 1417 1A93 13 4F 13 1417 1A96 98 1A 1418 1A98 11 FA 09 ldm exponent_c 1419 1A9B 1A dec 1420 1A9C 12 FA 09 stm exponent_c 1421 1A9F 13 7C 1A jmp mfp_loop_1 1422 1AA2 1423 1AA2 ;Rounding code 1424 1AA2 ;Check high bit of double_long_a+3 1425 1AA2 ;If zero, no rounding (that is, round down) 1426 1AA2 ;If one, check rest of bits in double_long_a+3, +4 and +5 1427 1AA2 ;If all zeros, round down 1428 1AA2 ;If any ones, round up (add one to long word made of double_long_a, +1, +2) 1429 1AA2 ;If rounding up produces carry-out, shift result right and increase exponent before assembling 1430 1AA2 11 14 0A mfp_next_5: ldm double_long_a+3 1431 1AA5 0C 80 andi 10000000b ;is bit 7 zero? 1432 1AA7 14 F6 1A jpz mfp_no_round ;yes, no round 1433 1AAA 11 14 0A ldm double_long_a+3 ;no, check rest of long word for ones 1434 1AAD 0C 7F andi 01111111b ;mask off high bit 1435 1AAF 05 15 0A orm double_long_a+4 1436 1AB2 05 16 0A orm double_long_a+5 1437 1AB5 14 F6 1A jpz mfp_no_round ;no other zeros, no round 1438 1AB8 11 13 0A mfp_round_up: ldm double_long_a+2 ;24-bit add one to three high bytes 1439 1ABB 08 01 addi 1 1440 1ABD 12 13 0A stm double_long_a+2 1441 1AC0 11 12 0A ldm double_long_a+1 1442 1AC3 09 00 adci 0 1443 1AC5 12 12 0A stm double_long_a+1 1444 1AC8 11 11 0A ldm double_long_a 1445 1ACB 09 00 adci 0 1446 1ACD 12 11 0A stm double_long_a 1447 1AD0 16 D6 1A jpc mfp_skip_6 ;carry-out, need to shift right and inc exponent 1448 1AD3 13 F6 1A jmp mfp_no_round ;no carry-out, assemble final fp product 1449 1AD6 mfp_skip_6 call2(sh_right_double) 1449 1AD6 1449 1AD6 11 E5 1A 1449 1AD9 12 46 08 1449 1ADC 11 E6 1A 1449 1ADF 12 47 08 1449 1AE2 13 A7 14 1449 1AE5 E7 1A 1450 1AE7 11 11 0A ldm double_long_a ;if shift, need to put 1 back in leftmost 1451 1AEA 0D 80 ori 10000000b 1452 1AEC 12 11 0A stm double_long_a 1453 1AEF 11 FA 09 ldm exponent_c 1454 1AF2 19 inc 1455 1AF3 12 FA 09 stm exponent_c 1456 1AF6 ;Assemble final fp 1457 1AF6 11 FA 09 mfp_no_round: ldm exponent_c ;First byte is sign bit and bits 7 to 1 1458 1AF9 08 80 addi 128 ;add bias+1 (normalized result has binary point after second digit) 1459 1AFB 12 FA 09 stm exponent_c ;exponent_c now has biased exponent 1460 1AFE 12 FE 09 stm byte_a 1461 1B01 call3(shift_right_one) ;move over for sign bit 1461 1B01 1461 1B01 11 10 1B 1461 1B04 12 76 0A 1461 1B07 11 11 1B 1461 1B0A 12 77 0A 1461 1B0D 13 8D 11 1461 1B10 12 1B 1462 1B12 05 F7 09 orm sign ;put sign bit in 1463 1B15 12 30 0A stm fp_c ;First byte done 1464 1B18 11 11 0A ldm double_long_a ;get first byte of mantissa 1465 1B1B 12 31 0A stm fp_c+1 ;store in second byte of fp 1466 1B1E 11 FA 09 ldm exponent_c ;check bit 0 of biased exponent 1467 1B21 0C 01 andi 00000001b ;test bit 0 of exponent 1468 1B23 14 29 1B jpz mfp_skip_7 1469 1B26 13 31 1B jmp mfp_next_6 ;bit is one, leave one in bit 7 of fp_c+1 1470 1B29 11 31 0A mfp_skip_7 ldm fp_c+1 ;bit is 0, mask off bit 7 of fp_c+1 1471 1B2C 0C 7F andi 01111111b 1472 1B2E 12 31 0A stm fp_c+1 1473 1B31 11 12 0A mfp_next_6: ldm double_long_a+1 ;get second and third product bytes 1474 1B34 12 32 0A stm fp_c+2 1475 1B37 11 13 0A ldm double_long_a+2 1476 1B3A 12 33 0A stm fp_c+3 ;complete fp product now assembled in fp_c 1477 1B3D ret0 1477 1B3D 13 3F 08 1478 1B40 1479 1B40 ;Code to add two positive floating-point numbers 1480 1B40 ;Call as level 0 subroutine 1481 1B40 ;Addends passed in fp_a and fp_b 1482 1B40 ;Uses long_a and long_b, long_c, exponent_a, exponent_b and exponent_c in calculation 1483 1B40 ;Sum returned in fp_c 1484 1B40 1485 1B40 add_float: 1486 1B40 ;Extract mantissas from float 1487 1B40 11 29 0A ldm fp_a+1 ;restore 1 to leftmost bit 1488 1B43 0D 80 ori 10000000b 1489 1B45 12 02 0A stm long_a ;store mantissa in long word 1490 1B48 11 2A 0A ldm fp_a+2 1491 1B4B 12 03 0A stm long_a+1 1492 1B4E 11 2B 0A ldm fp_a+3 1493 1B51 12 04 0A stm long_a+2 1494 1B54 11 2D 0A ldm fp_b+1 1495 1B57 0D 80 ori 10000000b 1496 1B59 12 05 0A stm long_b 1497 1B5C 11 2E 0A ldm fp_b+2 1498 1B5F 12 06 0A stm long_b+1 1499 1B62 11 2F 0A ldm fp_b+3 1500 1B65 12 07 0A stm long_b+2 1501 1B68 1502 1B68 ;Extract exponents from float 1503 1B68 11 28 0A ldm fp_a ;get exponent_a 1504 1B6B 12 FE 09 stm byte_a 1505 1B6E call3(shift_left_one) ;push off sign bit, put zero in bit 0 1505 1B6E 1505 1B6E 11 7D 1B 1505 1B71 12 76 0A 1505 1B74 11 7E 1B 1505 1B77 12 77 0A 1505 1B7A 13 0C 11 1505 1B7D 7F 1B 1506 1B7F 12 F8 09 stm exponent_a 1507 1B82 11 29 0A ldm fp_a+1 1508 1B85 0C 80 andi 10000000b ;get low-order bit of exponent 1509 1B87 14 92 1B jpz af_next_1 ;if zero, move on 1510 1B8A 11 F8 09 ldm exponent_a ;if one, make bit 0 one 1511 1B8D 0D 01 ori 00000001b 1512 1B8F 12 F8 09 stm exponent_a 1513 1B92 1514 1B92 11 2C 0A af_next_1: ldm fp_b ;get exponent_b same way 1515 1B95 12 FE 09 stm byte_a 1516 1B98 call3(shift_left_one) 1516 1B98 1516 1B98 11 A7 1B 1516 1B9B 12 76 0A 1516 1B9E 11 A8 1B 1516 1BA1 12 77 0A 1516 1BA4 13 0C 11 1516 1BA7 A9 1B 1517 1BA9 12 F9 09 stm exponent_b 1518 1BAC 11 2D 0A ldm fp_b+1 1519 1BAF 0C 80 andi 10000000b 1520 1BB1 14 BC 1B jpz af_next_2 1521 1BB4 11 F9 09 ldm exponent_b 1522 1BB7 0D 01 ori 00000001b 1523 1BB9 12 F9 09 stm exponent_b 1524 1BBC 1525 1BBC ;Compare exponents 1526 1BBC 11 F8 09 af_next_2: ldm exponent_a 1527 1BBF 02 F9 09 subm exponent_b ;does a-b 1528 1BC2 16 C8 1B jpc af_skip_1 ;exponent_b is less than or equal to exponent_a 1529 1BC5 13 CE 1B jmp af_next_3 ;exponent_b is greater than exponent_a 1530 1BC8 14 5B 1C af_skip_1 jpz af_add ;exponent_b is equal to exponent_a 1531 1BCB 13 16 1C jmp af_next_4 ;exponent_b is less than exponent_a 1532 1BCE 1533 1BCE ;exponent_b > a -- shift mantissa of fp_a right and increment exponent_a until exponents equal 1534 1BCE 11 02 0A af_next_3: ldm long_a 1535 1BD1 12 0B 0A stm long_d 1536 1BD4 11 03 0A ldm long_a+1 1537 1BD7 12 0C 0A stm long_d+1 1538 1BDA 11 04 0A ldm long_a+2 1539 1BDD 12 0D 0A stm long_d+2 1540 1BE0 af_loop_1: call2(shift_right_long) ;subroutine shifts long_d 1540 1BE0 1540 1BE0 11 EF 1B 1540 1BE3 12 46 08 1540 1BE6 11 F0 1B 1540 1BE9 12 47 08 1540 1BEC 13 B4 12 1540 1BEF F1 1B 1541 1BF1 11 F8 09 ldm exponent_a 1542 1BF4 19 inc 1543 1BF5 12 F8 09 stm exponent_a 1544 1BF8 02 F9 09 subm exponent_b 1545 1BFB 14 01 1C jpz af_align_a_done ;exponents equal, done 1546 1BFE 13 E0 1B jmp af_loop_1 ;not done, continue to shift 1547 1C01 11 0B 0A af_align_a_done: ldm long_d ;put shifted mantissa back in long_a 1548 1C04 12 02 0A stm long_a 1549 1C07 11 0C 0A ldm long_d+1 1550 1C0A 12 03 0A stm long_a+1 1551 1C0D 11 0D 0A ldm long_d+2 1552 1C10 12 04 0A stm long_a+2 1553 1C13 13 5B 1C jmp af_add 1554 1C16 1555 1C16 ;exponent_a > b -- shift mantissa of fp_b right and increment exponent_b until exponents equal 1556 1C16 11 05 0A af_next_4: ldm long_b 1557 1C19 12 0B 0A stm long_d 1558 1C1C 11 06 0A ldm long_b+1 1559 1C1F 12 0C 0A stm long_d+1 1560 1C22 11 07 0A ldm long_b+2 1561 1C25 12 0D 0A stm long_d+2 1562 1C28 af_loop_2: call2(shift_right_long) ;subroutine shifts long_d 1562 1C28 1562 1C28 11 37 1C 1562 1C2B 12 46 08 1562 1C2E 11 38 1C 1562 1C31 12 47 08 1562 1C34 13 B4 12 1562 1C37 39 1C 1563 1C39 11 F9 09 ldm exponent_b 1564 1C3C 19 inc 1565 1C3D 12 F9 09 stm exponent_b 1566 1C40 02 F8 09 subm exponent_a 1567 1C43 14 49 1C jpz af_align_b_done ;exponents equal, done 1568 1C46 13 28 1C jmp af_loop_2 ;not done, continue to shift 1569 1C49 11 0B 0A af_align_b_done: ldm long_d ;put shifted mantissa back in long_b 1570 1C4C 12 05 0A stm long_b 1571 1C4F 11 0C 0A ldm long_d+1 1572 1C52 12 06 0A stm long_b+1 1573 1C55 11 0D 0A ldm long_d+2 1574 1C58 12 07 0A stm long_b+2 1575 1C5B 1576 1C5B ;24-bit add of adjusted mantissas (exponents are equal) 1577 1C5B 11 F8 09 af_add: ldm exponent_a 1578 1C5E 12 FA 09 stm exponent_c ;final exponent of sum 1579 1C61 11 04 0A ldm long_a+2 1580 1C64 00 07 0A addm long_b+2 1581 1C67 12 0A 0A stm long_c+2 1582 1C6A 11 03 0A ldm long_a+1 1583 1C6D 01 06 0A adcm long_b+1 1584 1C70 12 09 0A stm long_c+1 1585 1C73 11 02 0A ldm long_a 1586 1C76 01 05 0A adcm long_b 1587 1C79 12 08 0A stm long_c 1588 1C7C 16 82 1C jpc af_skip_2 ;carry-out, shift right mantissa and inc exp 1589 1C7F 13 C0 1C jmp af_done ;no carry-out, done with math 1590 1C82 1591 1C82 ;Carry-out from add, need to shift sum right and increment exponent 1592 1C82 11 08 0A af_skip_2 ldm long_c ;need to put sum in long_d for shift_right_long subroutine 1593 1C85 12 0B 0A stm long_d 1594 1C88 11 09 0A ldm long_c+1 1595 1C8B 12 0C 0A stm long_d+1 1596 1C8E 11 0A 0A ldm long_c+2 1597 1C91 12 0D 0A stm long_d+2 1598 1C94 call2(shift_right_long) 1598 1C94 1598 1C94 11 A3 1C 1598 1C97 12 46 08 1598 1C9A 11 A4 1C 1598 1C9D 12 47 08 1598 1CA0 13 B4 12 1598 1CA3 A5 1C 1599 1CA5 11 0B 0A ldm long_d 1600 1CA8 0D 80 ori 10000000b ;put 1 from carry-out in high-bit 1601 1CAA 12 08 0A stm long_c ;store shifted mantissa in long_c 1602 1CAD 11 0C 0A ldm long_d+1 1603 1CB0 12 09 0A stm long_c+1 1604 1CB3 11 0D 0A ldm long_d+2 1605 1CB6 12 0A 0A stm long_c+2 1606 1CB9 11 FA 09 ldm exponent_c ;increment exponent 1607 1CBC 19 inc 1608 1CBD 12 FA 09 stm exponent_c 1609 1CC0 1610 1CC0 ;Math done, assemble floating point 1611 1CC0 11 FA 09 af_done: ldm exponent_c ;First fp byte is sign bit and exp bits 7 to 1 1612 1CC3 12 FE 09 stm byte_a 1613 1CC6 call3(shift_right_one) ;move over for sign bit (zero here for positive) 1613 1CC6 1613 1CC6 11 D5 1C 1613 1CC9 12 76 0A 1613 1CCC 11 D6 1C 1613 1CCF 12 77 0A 1613 1CD2 13 8D 11 1613 1CD5 D7 1C 1614 1CD7 12 30 0A stm fp_c ;First byte done 1615 1CDA 11 08 0A ldm long_c ;get first byte of mantissa 1616 1CDD 12 31 0A stm fp_c+1 ;store in second byte of fp 1617 1CE0 11 FA 09 ldm exponent_c ;check bit 0 of biased exponent 1618 1CE3 0C 01 andi 00000001b ;test bit 0 of exponent 1619 1CE5 14 EB 1C jpz af_skip_3 1620 1CE8 13 F3 1C jmp afp_next_6 ;bit is one, leave one in bit 7 of fp_c+1 1621 1CEB 11 31 0A af_skip_3 ldm fp_c+1 ;bit is 0, mask off bit 7 of fp_c+1 1622 1CEE 0C 7F andi 01111111b 1623 1CF0 12 31 0A stm fp_c+1 1624 1CF3 11 09 0A afp_next_6: ldm long_c+1 ;get second and mantissa bytes 1625 1CF6 12 32 0A stm fp_c+2 1626 1CF9 11 0A 0A ldm long_c+2 1627 1CFC 12 33 0A stm fp_c+3 ;complete fp quotient now assembled in fp_c 1628 1CFF 1629 1CFF ret0 1629 1CFF 13 3F 08 1630 1D02 1631 1D02 ;Code to subtract two positive floating-point numbers 1632 1D02 ;Call as level 0 subroutine 1633 1D02 ;Numbers passed in fp_a and fp_b 1634 1D02 ;Performs fp_a - fp_b 1635 1D02 ;Uses long_a and long_b, long_c, exponent_a, exponent_b and exponent_c in calculation 1636 1D02 ;Difference returned in fp_c 1637 1D02 1638 1D02 11 29 0A subtract_float: ldm fp_a+1 ;extract mantissas from float 1639 1D05 0D 80 ori 10000000b ;restore 1 to leftmost bit 1640 1D07 12 02 0A stm long_a 1641 1D0A 11 2A 0A ldm fp_a+2 1642 1D0D 12 03 0A stm long_a+1 1643 1D10 11 2B 0A ldm fp_a+3 1644 1D13 12 04 0A stm long_a+2 1645 1D16 11 2D 0A ldm fp_b+1 1646 1D19 0D 80 ori 10000000b ;restore 1 to leftmost bit 1647 1D1B 12 05 0A stm long_b 1648 1D1E 11 2E 0A ldm fp_b+2 1649 1D21 12 06 0A stm long_b+1 1650 1D24 11 2F 0A ldm fp_b+3 1651 1D27 12 07 0A stm long_b+2 1652 1D2A 1653 1D2A ;Result can be negative, so clear sign variable 1654 1D2A 10 00 ldi 0 1655 1D2C 12 F7 09 stm sign ;0 for positive result, 1 for negative 1656 1D2F 1657 1D2F ;Extract exponents from float 1658 1D2F 11 28 0A ldm fp_a ;get exponent_a 1659 1D32 12 FE 09 stm byte_a 1660 1D35 call3(shift_left_one) ;push off sign bit, sets bit 0 to 0 1660 1D35 1660 1D35 11 44 1D 1660 1D38 12 76 0A 1660 1D3B 11 45 1D 1660 1D3E 12 77 0A 1660 1D41 13 0C 11 1660 1D44 46 1D 1661 1D46 12 F8 09 stm exponent_a 1662 1D49 11 29 0A ldm fp_a+1 1663 1D4C 0C 80 andi 10000000b ;get low-order bit of exponent of fp_a 1664 1D4E 14 59 1D jpz sf_next_1 ;if zero, leave it (will have 0 from shift) 1665 1D51 11 F8 09 ldm exponent_a ;if one, put into exponent_a 1666 1D54 0D 01 ori 00000001b 1667 1D56 12 F8 09 stm exponent_a 1668 1D59 1669 1D59 11 2C 0A sf_next_1: ldm fp_b ;get exponent_b 1670 1D5C 12 FE 09 stm byte_a 1671 1D5F call3(shift_left_one) ;push off sign bit, sets bit 0 to 0 1671 1D5F 1671 1D5F 11 6E 1D 1671 1D62 12 76 0A 1671 1D65 11 6F 1D 1671 1D68 12 77 0A 1671 1D6B 13 0C 11 1671 1D6E 70 1D 1672 1D70 12 F9 09 stm exponent_b 1673 1D73 11 2D 0A ldm fp_b+1 1674 1D76 0C 80 andi 10000000b ;get low-order bit of exponent 1675 1D78 14 83 1D jpz sf_next_2 ;if zero, leave it 1676 1D7B 11 F9 09 ldm exponent_b ;if one, set it 1677 1D7E 0D 01 ori 00000001b 1678 1D80 12 F9 09 stm exponent_b 1679 1D83 1680 1D83 ;Compare exponents 1681 1D83 11 F8 09 sf_next_2: ldm exponent_a 1682 1D86 02 F9 09 subm exponent_b ;do a-b 1683 1D89 16 8F 1D jpc sf_skip_1 ;exponent_a greater than or equal to exponent_b 1684 1D8C 13 95 1D jmp sf_next_3 ;exponent_b is greater than exponent_a 1685 1D8F 14 22 1E sf_skip_1 jpz sf_subtract ;exponent_a is equal to exponent_b 1686 1D92 13 DD 1D jmp sf_next_4 ;exponent_a is greater than exponent_b 1687 1D95 1688 1D95 ;Exponent_b > a -- shift long_a right and increment exponent_a until exponents equal 1689 1D95 11 02 0A sf_next_3: ldm long_a 1690 1D98 12 0B 0A stm long_d 1691 1D9B 11 03 0A ldm long_a+1 1692 1D9E 12 0C 0A stm long_d+1 1693 1DA1 11 04 0A ldm long_a+2 1694 1DA4 12 0D 0A stm long_d+2 1695 1DA7 sf_loop_1: call2(shift_right_long) ;subroutine shifts long_d 1695 1DA7 1695 1DA7 11 B6 1D 1695 1DAA 12 46 08 1695 1DAD 11 B7 1D 1695 1DB0 12 47 08 1695 1DB3 13 B4 12 1695 1DB6 B8 1D 1696 1DB8 11 F8 09 ldm exponent_a 1697 1DBB 19 inc 1698 1DBC 12 F8 09 stm exponent_a 1699 1DBF 02 F9 09 subm exponent_b 1700 1DC2 14 C8 1D jpz sf_align_a_done ;exponents equal, done 1701 1DC5 13 A7 1D jmp sf_loop_1 ;not done, continue to shift 1702 1DC8 1703 1DC8 11 0B 0A sf_align_a_done: ldm long_d ;put shifted mantissa back in long_a 1704 1DCB 12 02 0A stm long_a 1705 1DCE 11 0C 0A ldm long_d+1 1706 1DD1 12 03 0A stm long_a+1 1707 1DD4 11 0D 0A ldm long_d+2 1708 1DD7 12 04 0A stm long_a+2 1709 1DDA 13 22 1E jmp sf_subtract 1710 1DDD 1711 1DDD ;Exponent_a > b -- shift b right and increment exponent until exponents equal 1712 1DDD 11 05 0A sf_next_4: ldm long_b 1713 1DE0 12 0B 0A stm long_d 1714 1DE3 11 06 0A ldm long_b+1 1715 1DE6 12 0C 0A stm long_d+1 1716 1DE9 11 07 0A ldm long_b+2 1717 1DEC 12 0D 0A stm long_d+2 1718 1DEF sf_loop_2: call2(shift_right_long) ;subroutine shifts long_d 1718 1DEF 1718 1DEF 11 FE 1D 1718 1DF2 12 46 08 1718 1DF5 11 FF 1D 1718 1DF8 12 47 08 1718 1DFB 13 B4 12 1718 1DFE 00 1E 1719 1E00 11 F9 09 ldm exponent_b 1720 1E03 19 inc 1721 1E04 12 F9 09 stm exponent_b 1722 1E07 02 F8 09 subm exponent_a 1723 1E0A 14 10 1E jpz sf_align_b_done ;exponents equal, done 1724 1E0D 13 EF 1D jmp sf_loop_2 ;not done, continue to shift 1725 1E10 1726 1E10 11 0B 0A sf_align_b_done: ldm long_d ;put shifted mantissa back in long_b 1727 1E13 12 05 0A stm long_b 1728 1E16 11 0C 0A ldm long_d+1 1729 1E19 12 06 0A stm long_b+1 1730 1E1C 11 0D 0A ldm long_d+2 1731 1E1F 12 07 0A stm long_b+2 1732 1E22 1733 1E22 ;24-bit subtract of adjusted mantissas (exponents are equal) 1734 1E22 11 F8 09 sf_subtract: ldm exponent_a 1735 1E25 12 FA 09 stm exponent_c ;save the equalized exponent 1736 1E28 11 04 0A ldm long_a+2 ;does 24-bit a - b 1737 1E2B 02 07 0A subm long_b+2 1738 1E2E 12 0A 0A stm long_c+2 1739 1E31 11 03 0A ldm long_a+1 1740 1E34 03 06 0A sbbm long_b+1 1741 1E37 12 09 0A stm long_c+1 1742 1E3A 11 02 0A ldm long_a 1743 1E3D 03 05 0A sbbm long_b 1744 1E40 12 08 0A stm long_c 1745 1E43 16 49 1E jpc sf_skip_2 ;no borrow 1746 1E46 13 58 1E jmp sf_next_5 ;borrow requested, result negative 1747 1E49 11 08 0A sf_skip_2 ldm long_c ;result zero or positive, check if zero 1748 1E4C 05 09 0A orm long_c+1 1749 1E4F 05 0A 0A orm long_c+2 1750 1E52 14 F5 1E jpz sf_zero ;result zero, quit 1751 1E55 13 8A 1E jmp sf_loop_3 ;result positive 1752 1E58 1753 1E58 ;Subtraction result negative, long_c is a negative integer 1754 1E58 ;Final fp will have negative sign, with positive mantissa 1755 1E58 10 80 sf_next_5: ldi 10000000b ;change sign to negative 1756 1E5A 12 F7 09 stm sign 1757 1E5D 1758 1E5D ;Negate long_c (two's complement) 1759 1E5D 11 08 0A ldm long_c ;complement long_c 1760 1E60 07 not 1761 1E61 12 08 0A stm long_c 1762 1E64 11 09 0A ldm long_c+1 1763 1E67 07 not 1764 1E68 12 09 0A stm long_c+1 1765 1E6B 11 0A 0A ldm long_c+2 1766 1E6E 07 not 1767 1E6F 12 0A 0A stm long_c+2 1768 1E72 1769 1E72 ;24-bit add 1 to long_c to finish two's complement 1770 1E72 11 0A 0A ldm long_c+2 1771 1E75 08 01 addi 1 1772 1E77 12 0A 0A stm long_c+2 1773 1E7A 11 09 0A ldm long_c+1 1774 1E7D 09 00 adci 0 1775 1E7F 12 09 0A stm long_c+1 1776 1E82 11 08 0A ldm long_c 1777 1E85 09 00 adci 0 1778 1E87 12 08 0A stm long_c 1779 1E8A 1780 1E8A ;Long_c now has two's complement of negative result, or positive result 1781 1E8A ;Normalize by shifting left long_c and decrementing exponent_c 1782 1E8A 11 08 0A sf_loop_3: ldm long_c ;check for leftmost 1 1783 1E8D 0C 80 andi 10000000b 1784 1E8F 14 95 1E jpz sf_skip_4 ;shifting not done 1785 1E92 13 B0 1E jmp sf_done ;shifting done 1786 1E95 sf_skip_4 call2(shift_left_long) ;shift long_c and decrement exponent 1786 1E95 1786 1E95 11 A4 1E 1786 1E98 12 46 08 1786 1E9B 11 A5 1E 1786 1E9E 12 47 08 1786 1EA1 13 0E 12 1786 1EA4 A6 1E 1787 1EA6 11 FA 09 ldm exponent_c 1788 1EA9 1A dec 1789 1EAA 12 FA 09 stm exponent_c 1790 1EAD 13 8A 1E jmp sf_loop_3 1791 1EB0 1792 1EB0 ;Math done, assemble floating point 1793 1EB0 11 FA 09 sf_done: ldm exponent_c 1794 1EB3 12 FE 09 stm byte_a 1795 1EB6 call3(shift_right_one) ;move over for sign bit 1795 1EB6 1795 1EB6 11 C5 1E 1795 1EB9 12 76 0A 1795 1EBC 11 C6 1E 1795 1EBF 12 77 0A 1795 1EC2 13 8D 11 1795 1EC5 C7 1E 1796 1EC7 05 F7 09 orm sign ;OR-in sign bit 1797 1ECA 12 30 0A stm fp_c ;First byte done 1798 1ECD 11 08 0A ldm long_c ;get first byte of mantissa 1799 1ED0 12 31 0A stm fp_c+1 ;store in second byte of fp 1800 1ED3 11 FA 09 ldm exponent_c ;check bit 0 of biased exponent 1801 1ED6 0C 01 andi 00000001b ;test bit 0 of exponent 1802 1ED8 14 DE 1E jpz sf_skip_5 1803 1EDB 13 E6 1E jmp sf_next_6 ;bit is one, leave one in bit 7 of fp_c+1 1804 1EDE 11 31 0A sf_skip_5 ldm fp_c+1 ;bit is 0, mask off bit 7 of fp_c+1 1805 1EE1 0C 7F andi 01111111b 1806 1EE3 12 31 0A stm fp_c+1 1807 1EE6 11 09 0A sf_next_6: ldm long_c+1 ;get second and mantissa bytes 1808 1EE9 12 32 0A stm fp_c+2 1809 1EEC 11 0A 0A ldm long_c+2 1810 1EEF 12 33 0A stm fp_c+3 ;complete fp quotient now assembled in fp_c 1811 1EF2 ret0 1811 1EF2 13 3F 08 1812 1EF5 1813 1EF5 10 00 sf_zero: ldi 0 ;special zero fp value is 0x00000000 1814 1EF7 12 30 0A stm fp_c 1815 1EFA 12 31 0A stm fp_c+1 1816 1EFD 12 32 0A stm fp_c+2 1817 1F00 12 33 0A stm fp_c+3 1818 1F03 ret0 1818 1F03 13 3F 08 1819 1F06 1820 1F06 1821 1F06 ;Code for computing the square root of a positive floating point number 1822 1F06 ;Uses "Babylonian" method 1823 1F06 ;Call as level A subroutine 1824 1F06 ;Floating point number passed in fp_x 1825 1F06 ;Uses fp_a, fp_b, fp_c, fp_square 1826 1F06 ;Square root returned in fp_test 1827 1F06 1828 1F06 ;Extract exponent from float 1829 1F06 11 38 0A sqrt_float: ldm fp_x ;get exponent_x 1830 1F09 12 FE 09 stm byte_a 1831 1F0C call3(shift_left_one) ;push off sign bit 1831 1F0C 1831 1F0C 11 1B 1F 1831 1F0F 12 76 0A 1831 1F12 11 1C 1F 1831 1F15 12 77 0A 1831 1F18 13 0C 11 1831 1F1B 1D 1F 1832 1F1D 12 FB 09 stm exponent_x 1833 1F20 11 39 0A ldm fp_x+1 1834 1F23 0C 80 andi 10000000b ;get low-order bit of exponent 1835 1F25 14 30 1F jpz sqrt_next_1 ;if zero, leave it 1836 1F28 11 FB 09 ldm exponent_x ;if one, set it 1837 1F2B 0D 01 ori 00000001b 1838 1F2D 12 FB 09 stm exponent_x 1839 1F30 1840 1F30 11 FB 09 sqrt_next_1: ldm exponent_x ;remove bias from exponent 1841 1F33 02 7F 00 subm 127 1842 1F36 12 FB 09 stm exponent_x 1843 1F39 1844 1F39 ;Create seed value (initial square root estimate) 1845 1F39 11 FB 09 ldm exponent_x 1846 1F3C 15 42 1F jpm sqrt_skip_1 ;if exponent negative, shift left 1847 1F3F 13 5D 1F jmp sqrt_next_a ;for positive exponent, shift right 1848 1F42 07 sqrt_skip_1 not ;2's complement negation of negative exponent 1849 1F43 19 inc 1850 1F44 12 FE 09 stm byte_a 1851 1F47 call3(shift_left_one) ;for negative exponent need to shift left negated 1851 1F47 1851 1F47 11 56 1F 1851 1F4A 12 76 0A 1851 1F4D 11 57 1F 1851 1F50 12 77 0A 1851 1F53 13 0C 11 1851 1F56 58 1F 1852 1F58 07 not ;convert back to negative 1853 1F59 19 inc 1854 1F5A 13 71 1F jmp sqrt_next_b 1855 1F5D 12 FE 09 sqrt_next_a: stm byte_a 1856 1F60 call3(shift_right_one) ;divide exponent by 2 1856 1F60 1856 1F60 11 6F 1F 1856 1F63 12 76 0A 1856 1F66 11 70 1F 1856 1F69 12 77 0A 1856 1F6C 13 8D 11 1856 1F6F 71 1F 1857 1F71 08 7F sqrt_next_b: addi 127 ;restore bias 1858 1F73 12 FC 09 stm exponent_test 1859 1F76 1860 1F76 ;Create floating point value from seed exponent 1861 1F76 11 FC 09 ldm exponent_test 1862 1F79 12 FE 09 stm byte_a 1863 1F7C call3(shift_right_one) 1863 1F7C 1863 1F7C 11 8B 1F 1863 1F7F 12 76 0A 1863 1F82 11 8C 1F 1863 1F85 12 77 0A 1863 1F88 13 8D 11 1863 1F8B 8D 1F 1864 1F8D 12 3C 0A stm fp_test 1865 1F90 11 FC 09 ldm exponent_test 1866 1F93 0C 01 andi 00000001b 1867 1F95 14 9A 1F jpz sqrt_next_2 1868 1F98 10 80 ldi 10000000b 1869 1F9A 12 3D 0A sqrt_next_2: stm fp_test+1 ;seed in fp_test will be 1 to the exponent_test power 1870 1F9D 10 00 ldi 0 1871 1F9F 12 3E 0A stm fp_test+2 1872 1FA2 12 3F 0A stm fp_test+3 1873 1FA5 1874 1FA5 11 3C 0A sqrt_loop: ldm fp_test ;multiply fp_test by itself (square it) 1875 1FA8 12 28 0A stm fp_a 1876 1FAB 12 2C 0A stm fp_b 1877 1FAE 11 3D 0A ldm fp_test+1 1878 1FB1 12 29 0A stm fp_a+1 1879 1FB4 12 2D 0A stm fp_b+1 1880 1FB7 11 3E 0A ldm fp_test+2 1881 1FBA 12 2A 0A stm fp_a+2 1882 1FBD 12 2E 0A stm fp_b+2 1883 1FC0 11 3F 0A ldm fp_test+3 1884 1FC3 12 2B 0A stm fp_a+3 1885 1FC6 12 2F 0A stm fp_b+3 1886 1FC9 call0(multiply_float) 1886 1FC9 1886 1FC9 11 D8 1F 1886 1FCC 12 40 08 1886 1FCF 11 D9 1F 1886 1FD2 12 41 08 1886 1FD5 13 A7 19 1886 1FD8 DA 1F 1887 1FDA 1888 1FDA 11 30 0A ldm fp_c ;square of test root into fp_square 1889 1FDD 12 40 0A stm fp_square 1890 1FE0 11 31 0A ldm fp_c+1 1891 1FE3 12 41 0A stm fp_square+1 1892 1FE6 11 32 0A ldm fp_c+2 1893 1FE9 12 42 0A stm fp_square+2 1894 1FEC 11 33 0A ldm fp_c+3 1895 1FEF 12 43 0A stm fp_square+3 1896 1FF2 11 38 0A ldm fp_x ;get ratio of fp_square and 1897 1FF5 12 28 0A stm fp_a ;the original number fp_x 1898 1FF8 11 39 0A ldm fp_x+1 1899 1FFB 12 29 0A stm fp_a+1 1900 1FFE 11 3A 0A ldm fp_x+2 1901 2001 12 2A 0A stm fp_a+2 1902 2004 11 3B 0A ldm fp_x+3 1903 2007 12 2B 0A stm fp_a+3 1904 200A 11 40 0A ldm fp_square 1905 200D 12 2C 0A stm fp_b 1906 2010 11 41 0A ldm fp_square+1 1907 2013 12 2D 0A stm fp_b+1 1908 2016 11 42 0A ldm fp_square+2 1909 2019 12 2E 0A stm fp_b+2 1910 201C 11 43 0A ldm fp_square+3 1911 201F 12 2F 0A stm fp_b+3 1912 2022 call0(divide_float) 1912 2022 1912 2022 11 31 20 1912 2025 12 40 08 1912 2028 11 32 20 1912 202B 12 41 08 1912 202E 13 33 18 1912 2031 33 20 1913 2033 1914 2033 ;Extract exponent from fp_c (which is ratio between the square of the test root and fp_x) 1915 2033 1916 2033 11 30 0A ldm fp_c 1917 2036 12 FE 09 stm byte_a 1918 2039 call3(shift_left_one) ;also clears sign bit 1918 2039 1918 2039 11 48 20 1918 203C 12 76 0A 1918 203F 11 49 20 1918 2042 12 77 0A 1918 2045 13 0C 11 1918 2048 4A 20 1919 204A 12 FB 09 stm exponent_x 1920 204D 11 31 0A ldm fp_c+1 ;check bit 0 of exponent 1921 2050 0C 80 andi 10000000b 1922 2052 14 5D 20 jpz sqrt_next_3 ;exponent bit 0 is zero, continue 1923 2055 11 FB 09 ldm exponent_x ;exponent bit 0 is one, set bit 1924 2058 0D 01 ori 00000001b 1925 205A 12 FB 09 stm exponent_x 1926 205D 1927 205D 10 7F sqrt_next_3: ldi 127 ;is ratio small enough? 1928 205F 02 FB 09 subm exponent_x 1929 2062 14 68 20 jpz sqrt_skip_2 ;exponent of ratio = 0, ratio close to 1 1930 2065 13 93 20 jmp sqrt_next_4 ;see if exponent of ratio -1 1931 2068 1932 2068 ;if exponent of ratio 0, check mantissa bytes for zeros 1933 2068 11 31 0A sqrt_skip_2 ldm fp_c+1 ;for exponent of ratio = 0, 1934 206B 12 FE 09 stm byte_a ;check mantissa bytes for zeros 1935 206E call3(shift_left_one) ;knock off high order bit (last bit of exponent) 1935 206E 1935 206E 11 7D 20 1935 2071 12 76 0A 1935 2074 11 7E 20 1935 2077 12 77 0A 1935 207A 13 0C 11 1935 207D 7F 20 1936 207F 05 32 0A orm fp_c+2 1937 2082 14 88 20 jpz sqrt_skip_3 ;first two bytes of mantissa zero, check third 1938 2085 13 BE 20 jmp sqrt_next_5 ;ratio not close enough, make new root and try again 1939 2088 11 33 0A sqrt_skip_3 ldm fp_c+3 1940 208B 0C FC andi 11111100b 1941 208D 14 94 21 jpz sqrt_done ;ratio close enough to 1, quit 1942 2090 13 BE 20 jmp sqrt_next_5 ;ratio not close enough, make new root and try again 1943 2093 1944 2093 10 7E sqrt_next_4: ldi 126 1945 2095 02 FB 09 subm exponent_x ;is ratio small enough? 1946 2098 14 9E 20 jpz sqrt_skip_4 ;exponent of ratio = -1, ratio could be close to 1 1947 209B 13 BE 20 jmp sqrt_next_5 ;exponent neither 127 or 126, make new root 1948 209E 1949 209E ;if exponent of ratio -1, check mantissa bytes for ones 1950 209E 10 7F sqrt_skip_4 ldi 01111111b ;high bit will be zero because exp is 126 1951 20A0 02 31 0A subm fp_c+1 ;if fp_c+1 all 1's, result will be zero 1952 20A3 14 A9 20 jpz sqrt_skip_5 ;might be close enough, check rest of bytes 1953 20A6 13 BE 20 jmp sqrt_next_5 ;not close enough, make new root and try again 1954 20A9 11 32 0A sqrt_skip_5 ldm fp_c+2 ;check next byte 1955 20AC 0E FF xori 11111111b ;result zero if all bits are ones 1956 20AE 14 B4 20 jpz sqrt_skip_6 ;might be close enough, check last byte 1957 20B1 13 BE 20 jmp sqrt_next_5 ;not close enough, make new root and try again 1958 20B4 11 33 0A sqrt_skip_6 ldm fp_c+3 ;check last byte 1959 20B7 0C FC andi 11111100b ;sets bits 0 and 1 to zero 1960 20B9 0E FC xori 11111100b ;checks bits 2 to 7 if ones 1961 20BB 14 94 21 jpz sqrt_done ;ratio close enough to 1, quit 1962 20BE 1963 20BE ;Make new test root 1964 20BE ;First divide fp_x (in fp_a) by last test root (in fp_b) 1965 20BE ;Quotient returned if fp_c 1966 20BE 11 38 0A sqrt_next_5: ldm fp_x 1967 20C1 12 28 0A stm fp_a 1968 20C4 11 39 0A ldm fp_x+1 1969 20C7 12 29 0A stm fp_a+1 1970 20CA 11 3A 0A ldm fp_x+2 1971 20CD 12 2A 0A stm fp_a+2 1972 20D0 11 3B 0A ldm fp_x+3 1973 20D3 12 2B 0A stm fp_a+3 1974 20D6 11 3C 0A ldm fp_test 1975 20D9 12 2C 0A stm fp_b 1976 20DC 11 3D 0A ldm fp_test+1 1977 20DF 12 2D 0A stm fp_b+1 1978 20E2 11 3E 0A ldm fp_test+2 1979 20E5 12 2E 0A stm fp_b+2 1980 20E8 11 3F 0A ldm fp_test+3 1981 20EB 12 2F 0A stm fp_b+3 1982 20EE call0(divide_float) 1982 20EE 1982 20EE 11 FD 20 1982 20F1 12 40 08 1982 20F4 11 FE 20 1982 20F7 12 41 08 1982 20FA 13 33 18 1982 20FD FF 20 1983 20FF 1984 20FF 1985 20FF ;Add test root to quotient 1986 20FF 11 30 0A ldm fp_c 1987 2102 12 28 0A stm fp_a 1988 2105 11 31 0A ldm fp_c+1 1989 2108 12 29 0A stm fp_a+1 1990 210B 11 32 0A ldm fp_c+2 1991 210E 12 2A 0A stm fp_a+2 1992 2111 11 33 0A ldm fp_c+3 1993 2114 12 2B 0A stm fp_a+3 1994 2117 11 3C 0A ldm fp_test 1995 211A 12 2C 0A stm fp_b 1996 211D 11 3D 0A ldm fp_test+1 1997 2120 12 2D 0A stm fp_b+1 1998 2123 11 3E 0A ldm fp_test+2 1999 2126 12 2E 0A stm fp_b+2 2000 2129 11 3F 0A ldm fp_test+3 2001 212C 12 2F 0A stm fp_b+3 2002 212F call0(add_float) 2002 212F 2002 212F 11 3E 21 2002 2132 12 40 08 2002 2135 11 3F 21 2002 2138 12 41 08 2002 213B 13 40 1B 2002 213E 40 21 2003 2140 2004 2140 2005 2140 ;Divide sum by two 2006 2140 11 30 0A ldm fp_c 2007 2143 12 28 0A stm fp_a 2008 2146 11 31 0A ldm fp_c+1 2009 2149 12 29 0A stm fp_a+1 2010 214C 11 32 0A ldm fp_c+2 2011 214F 12 2A 0A stm fp_a+2 2012 2152 11 33 0A ldm fp_c+3 2013 2155 12 2B 0A stm fp_a+3 2014 2158 10 40 ldi 40h ;fp for two is 0x40000000 2015 215A 12 2C 0A stm fp_b 2016 215D 10 00 ldi 0 2017 215F 12 2D 0A stm fp_b+1 2018 2162 12 2E 0A stm fp_b+2 2019 2165 12 2F 0A stm fp_b+3 2020 2168 call0(divide_float) 2020 2168 2020 2168 11 77 21 2020 216B 12 40 08 2020 216E 11 78 21 2020 2171 12 41 08 2020 2174 13 33 18 2020 2177 79 21 2021 2179 2022 2179 2023 2179 ;New quotient becomes new test root 2024 2179 11 30 0A ldm fp_c 2025 217C 12 3C 0A stm fp_test 2026 217F 11 31 0A ldm fp_c+1 2027 2182 12 3D 0A stm fp_test+1 2028 2185 11 32 0A ldm fp_c+2 2029 2188 12 3E 0A stm fp_test+2 2030 218B 11 33 0A ldm fp_c+3 2031 218E 12 3F 0A stm fp_test+3 2032 2191 13 A5 1F jmp sqrt_loop 2033 2194 2034 2194 sqrt_done: retA 2034 2194 13 78 0A 2035 2197 2036 2197 ;Subroutine to convert a 24-bit hex integer to a decimal string 2037 2197 ;Hex integer passed in long_a 2038 2197 ;Uses long_b for temp storage 2039 2197 ;Decimal string returned in dec_str_buff 2040 2197 ;Call as level 0 subroutine 2041 2197 ;Start with ten-millions 2042 2197 10 30 long_to_dec_str ldi 30h ;character for zero 2043 2199 12 FD 09 stm char 2044 219C 11 04 0A l2d_loop_1 ldm long_a+2 ;rightmost byte 2045 219F 0A 80 subi 80h ;ten-millions hex is 0x989680 2046 21A1 12 07 0A stm long_b+2 ;24-bit subtraction 2047 21A4 11 03 0A ldm long_a+1 2048 21A7 0B 96 sbbi 96h 2049 21A9 12 06 0A stm long_b+1 2050 21AC 11 02 0A ldm long_a 2051 21AF 0B 98 sbbi 98h 2052 21B1 12 05 0A stm long_b 2053 21B4 16 BA 21 jpc l2d_next_1 ;no borrow 2054 21B7 13 D6 21 jmp l2d_next_2 ;borrow, done with ten-millions 2055 21BA 2056 21BA 11 FD 09 l2d_next_1 ldm char 2057 21BD 19 inc 2058 21BE 12 FD 09 stm char 2059 21C1 11 05 0A ldm long_b 2060 21C4 12 02 0A stm long_a 2061 21C7 11 06 0A ldm long_b+1 2062 21CA 12 03 0A stm long_a+1 2063 21CD 11 07 0A ldm long_b+2 2064 21D0 12 04 0A stm long_a+2 2065 21D3 13 9C 21 jmp l2d_loop_1 2066 21D6 11 FD 09 l2d_next_2 ldm char 2067 21D9 12 3C 09 stm dec_str_buff+2 ;ten-millions place 2068 21DC 2069 21DC ;Millions 2070 21DC 10 30 ldi 30h ;character for zero 2071 21DE 12 FD 09 stm char 2072 21E1 11 04 0A l2d_loop_2 ldm long_a+2 ;rightmost byte 2073 21E4 0A 40 subi 40h ;millions hex is 0x0F4240 2074 21E6 12 07 0A stm long_b+2 ;24-bit subtraction 2075 21E9 11 03 0A ldm long_a+1 2076 21EC 0B 42 sbbi 42h 2077 21EE 12 06 0A stm long_b+1 2078 21F1 11 02 0A ldm long_a 2079 21F4 0B 0F sbbi 0Fh 2080 21F6 12 05 0A stm long_b 2081 21F9 16 FF 21 jpc l2d_next_3 ;no borrow 2082 21FC 13 1B 22 jmp l2d_next_4 ;borrow, done with millions 2083 21FF 2084 21FF 11 FD 09 l2d_next_3 ldm char ;increment digit 2085 2202 19 inc 2086 2203 12 FD 09 stm char 2087 2206 11 05 0A ldm long_b ;replace long_a with result of subtraction 2088 2209 12 02 0A stm long_a 2089 220C 11 06 0A ldm long_b+1 2090 220F 12 03 0A stm long_a+1 2091 2212 11 07 0A ldm long_b+2 2092 2215 12 04 0A stm long_a+2 2093 2218 13 E1 21 jmp l2d_loop_2 ;loop again 2094 221B 11 FD 09 l2d_next_4 ldm char 2095 221E 12 3D 09 stm dec_str_buff+3 ;millions place 2096 2221 2097 2221 ;Hundred-thousands 2098 2221 10 30 ldi 30h ;character for zero 2099 2223 12 FD 09 stm char 2100 2226 11 04 0A l2d_loop_3 ldm long_a+2 ;rightmost byte 2101 2229 0A A0 subi 0A0h ;hundred-thousand hex is 0x0186A0 2102 222B 12 07 0A stm long_b+2 ;24-bit subtraction 2103 222E 11 03 0A ldm long_a+1 2104 2231 0B 86 sbbi 86h 2105 2233 12 06 0A stm long_b+1 2106 2236 11 02 0A ldm long_a 2107 2239 0B 01 sbbi 01h 2108 223B 12 05 0A stm long_b 2109 223E 16 44 22 jpc l2d_next_5 ;no borrow 2110 2241 13 60 22 jmp l2d_next_6 ;borrow, done with hundred-thousands 2111 2244 2112 2244 11 FD 09 l2d_next_5 ldm char ;increment digit 2113 2247 19 inc 2114 2248 12 FD 09 stm char 2115 224B 11 05 0A ldm long_b ;replace long_a with result of subtraction 2116 224E 12 02 0A stm long_a 2117 2251 11 06 0A ldm long_b+1 2118 2254 12 03 0A stm long_a+1 2119 2257 11 07 0A ldm long_b+2 2120 225A 12 04 0A stm long_a+2 2121 225D 13 26 22 jmp l2d_loop_3 ;loop again 2122 2260 11 FD 09 l2d_next_6 ldm char 2123 2263 12 3E 09 stm dec_str_buff+4 ;hundred-thousands place 2124 2266 2125 2266 ;Ten-thousands 2126 2266 10 30 ldi 30h ;character for zero 2127 2268 12 FD 09 stm char 2128 226B 11 04 0A l2d_loop_4 ldm long_a+2 ;rightmost byte 2129 226E 0A 10 subi 10h ;ten-thousand hex is 0x002710 2130 2270 12 07 0A stm long_b+2 ;24-bit subtraction 2131 2273 11 03 0A ldm long_a+1 2132 2276 0B 27 sbbi 27h 2133 2278 12 06 0A stm long_b+1 2134 227B 11 02 0A ldm long_a 2135 227E 0B 00 sbbi 00h 2136 2280 12 05 0A stm long_b 2137 2283 16 89 22 jpc l2d_next_7 ;no borrow 2138 2286 13 A5 22 jmp l2d_next_8 ;borrow, done with ten-thousands 2139 2289 2140 2289 11 FD 09 l2d_next_7 ldm char ;increment digit 2141 228C 19 inc 2142 228D 12 FD 09 stm char 2143 2290 11 05 0A ldm long_b ;replace long_a with result of subtraction 2144 2293 12 02 0A stm long_a 2145 2296 11 06 0A ldm long_b+1 2146 2299 12 03 0A stm long_a+1 2147 229C 11 07 0A ldm long_b+2 2148 229F 12 04 0A stm long_a+2 2149 22A2 13 6B 22 jmp l2d_loop_4 ;loop again 2150 22A5 11 FD 09 l2d_next_8 ldm char 2151 22A8 12 3F 09 stm dec_str_buff+5 ;ten-thousands place 2152 22AB 2153 22AB ;Thousands 2154 22AB 10 30 ldi 30h ;character for zero 2155 22AD 12 FD 09 stm char 2156 22B0 11 04 0A l2d_loop_5 ldm long_a+2 ;rightmost byte 2157 22B3 0A E8 subi 0E8h ;One-thousand hex is 0x0003E8 2158 22B5 12 07 0A stm long_b+2 ;24-bit subtraction 2159 22B8 11 03 0A ldm long_a+1 2160 22BB 0B 03 sbbi 03h 2161 22BD 12 06 0A stm long_b+1 2162 22C0 11 02 0A ldm long_a 2163 22C3 0B 00 sbbi 00h 2164 22C5 12 05 0A stm long_b 2165 22C8 16 CE 22 jpc l2d_next_9 ;no borrow, not done 2166 22CB 13 EA 22 jmp l2d_next_10 ;borrow, done with one-thousands 2167 22CE 2168 22CE 11 FD 09 l2d_next_9 ldm char ;increment digit 2169 22D1 19 inc 2170 22D2 12 FD 09 stm char 2171 22D5 11 05 0A ldm long_b ;replace long_a with result of subtraction 2172 22D8 12 02 0A stm long_a 2173 22DB 11 06 0A ldm long_b+1 2174 22DE 12 03 0A stm long_a+1 2175 22E1 11 07 0A ldm long_b+2 2176 22E4 12 04 0A stm long_a+2 2177 22E7 13 B0 22 jmp l2d_loop_5 ;loop again 2178 22EA 11 FD 09 l2d_next_10 ldm char 2179 22ED 12 40 09 stm dec_str_buff+6 ;one-thousands place 2180 22F0 2181 22F0 ;Hundreds 2182 22F0 10 30 ldi 30h ;character for zero 2183 22F2 12 FD 09 stm char 2184 22F5 11 04 0A l2d_loop_6 ldm long_a+2 ;rightmost byte 2185 22F8 0A 64 subi 64h ;One-hundred hex is 0x000064 2186 22FA 12 07 0A stm long_b+2 ;24-bit subtraction 2187 22FD 11 03 0A ldm long_a+1 2188 2300 0B 00 sbbi 00h 2189 2302 12 06 0A stm long_b+1 2190 2305 11 02 0A ldm long_a 2191 2308 0B 00 sbbi 00h 2192 230A 12 05 0A stm long_b 2193 230D 16 13 23 jpc l2d_next_11 ;no borrow, not done 2194 2310 13 2F 23 jmp l2d_next_12 ;borrow, done with one-hundreds 2195 2313 2196 2313 11 FD 09 l2d_next_11 ldm char ;increment digit 2197 2316 19 inc 2198 2317 12 FD 09 stm char 2199 231A 11 05 0A ldm long_b ;replace long_a with result of subtraction 2200 231D 12 02 0A stm long_a 2201 2320 11 06 0A ldm long_b+1 2202 2323 12 03 0A stm long_a+1 2203 2326 11 07 0A ldm long_b+2 2204 2329 12 04 0A stm long_a+2 2205 232C 13 F5 22 jmp l2d_loop_6 ;loop again 2206 232F 11 FD 09 l2d_next_12 ldm char 2207 2332 12 41 09 stm dec_str_buff+7 ;hundreds place 2208 2335 2209 2335 ;Tens 2210 2335 10 30 ldi 30h ;character for zero 2211 2337 12 FD 09 stm char 2212 233A 11 04 0A l2d_loop_7 ldm long_a+2 ;rightmost byte 2213 233D 0A 0A subi 0Ah ;Ten hex is 0x00000A 2214 233F 12 07 0A stm long_b+2 ;24-bit subtraction 2215 2342 11 03 0A ldm long_a+1 2216 2345 0B 00 sbbi 00h 2217 2347 12 06 0A stm long_b+1 2218 234A 11 02 0A ldm long_a 2219 234D 0B 00 sbbi 00h 2220 234F 12 05 0A stm long_b 2221 2352 16 58 23 jpc l2d_next_13 ;no borrow, not done 2222 2355 13 74 23 jmp l2d_next_14 ;borrow, done with tens 2223 2358 2224 2358 11 FD 09 l2d_next_13 ldm char ;increment digit 2225 235B 19 inc 2226 235C 12 FD 09 stm char 2227 235F 11 05 0A ldm long_b ;replace long_a with result of subtraction 2228 2362 12 02 0A stm long_a 2229 2365 11 06 0A ldm long_b+1 2230 2368 12 03 0A stm long_a+1 2231 236B 11 07 0A ldm long_b+2 2232 236E 12 04 0A stm long_a+2 2233 2371 13 3A 23 jmp l2d_loop_7 ;loop again 2234 2374 11 FD 09 l2d_next_14 ldm char 2235 2377 12 42 09 stm dec_str_buff+8 ;tens place 2236 237A 2237 237A ;Ones 2238 237A 10 30 ldi 30h ;character for zero 2239 237C 12 FD 09 stm char 2240 237F 11 04 0A l2d_loop_8 ldm long_a+2 ;rightmost byte 2241 2382 0A 01 subi 01h ;One hex is 0x000001 2242 2384 12 07 0A stm long_b+2 ;24-bit subtraction 2243 2387 11 03 0A ldm long_a+1 2244 238A 0B 00 sbbi 00h 2245 238C 12 06 0A stm long_b+1 2246 238F 11 02 0A ldm long_a 2247 2392 0B 00 sbbi 00h 2248 2394 12 05 0A stm long_b 2249 2397 16 9D 23 jpc l2d_next_15 ;no borrow, not done 2250 239A 13 B9 23 jmp l2d_next_16 ;borrow, done with ones 2251 239D 2252 239D 11 FD 09 l2d_next_15 ldm char ;increment digit 2253 23A0 19 inc 2254 23A1 12 FD 09 stm char 2255 23A4 11 05 0A ldm long_b ;replace long_a with result of subtraction 2256 23A7 12 02 0A stm long_a 2257 23AA 11 06 0A ldm long_b+1 2258 23AD 12 03 0A stm long_a+1 2259 23B0 11 07 0A ldm long_b+2 2260 23B3 12 04 0A stm long_a+2 2261 23B6 13 7F 23 jmp l2d_loop_8 ;loop again 2262 23B9 11 FD 09 l2d_next_16 ldm char 2263 23BC 12 43 09 stm dec_str_buff+9 ;ones place 2264 23BF 2265 23BF 10 00 ldi 0 2266 23C1 12 44 09 stm dec_str_buff+10 ;terminating zero 2267 23C4 2268 23C4 ret0 2268 23C4 13 3F 08 2269 23C7 2270 23C7 ;Subroutine to convert a binary float to a decimal fixed-point string 2271 23C7 ;Float passed in fp_a 2272 23C7 ;String returned in dec_out_str 2273 23C7 ;Uses long_d and long_c as temp storage 2274 23C7 ;Call as level A subroutine 2275 23C7 2276 23C7 11 28 0A float_to_dec ldm fp_a ;get exponent from float 2277 23CA 12 FE 09 stm byte_a 2278 23CD call3(shift_left_one) 2278 23CD 2278 23CD 11 DC 23 2278 23D0 12 76 0A 2278 23D3 11 DD 23 2278 23D6 12 77 0A 2278 23D9 13 0C 11 2278 23DC DE 23 2279 23DE 12 F8 09 stm exponent_a 2280 23E1 11 29 0A ldm fp_a+1 ;Check bit 0 of exponent 2281 23E4 0C 80 andi 10000000b 2282 23E6 14 F1 23 jpz f2d_next_1 ;if zero, done 2283 23E9 11 F8 09 ldm exponent_a ;if one, set it 2284 23EC 0D 01 ori 00000001b 2285 23EE 12 F8 09 stm exponent_a 2286 23F1 11 F8 09 f2d_next_1 ldm exponent_a ;remove bias from exponent 2287 23F4 0A 7F subi 127 2288 23F6 12 F8 09 stm exponent_a 2289 23F9 11 29 0A ldm fp_a+1 ;get mantissa 2290 23FC 12 02 0A stm long_a 2291 23FF 11 2A 0A ldm fp_a+2 2292 2402 12 03 0A stm long_a+1 2293 2405 11 2B 0A ldm fp_a+3 2294 2408 12 04 0A stm long_a+2 2295 240B 11 02 0A ldm long_a ;make sure high bit is one 2296 240E 0D 80 ori 10000000b 2297 2410 12 02 0A stm long_a 2298 2413 2299 2413 11 F8 09 ldm exponent_a 2300 2416 15 21 24 jpm f2d_next_2 ;negative exponent 2301 2419 0A 18 subi 24 ;check range of positive exponent 2302 241B 16 F6 26 jpc f2d_err_hi ;out of range high (exp 24 or greater) 2303 241E 13 2B 24 jmp f2d_next_3 ;in range, shift 2304 2421 2305 2421 07 f2d_next_2 not ;negate exponent 2306 2422 19 inc 2307 2423 0A 18 subi 24 ;check range 2308 2425 16 16 27 jpc f2d_err_lo ;out of range low (exp -24 or less) 2309 2428 13 F3 26 jmp f2d_next_4 ;in range, shift 2310 242B 2311 242B 2312 242B ;Positive exponent in range 2313 242B 10 17 f2d_next_3 ldi 23 2314 242D 02 F8 09 subm exponent_a 2315 2430 12 71 0A stm shift_steps ;number of times to shift right to get integer part 2316 2433 11 02 0A ldm long_a ;shift_right_long needs value in long_d 2317 2436 12 0B 0A stm long_d 2318 2439 11 03 0A ldm long_a+1 2319 243C 12 0C 0A stm long_d+1 2320 243F 11 04 0A ldm long_a+2 2321 2442 12 0D 0A stm long_d+2 2322 2445 11 71 0A f2d_loop_1 ldm shift_steps 2323 2448 14 63 24 jpz f2d_next_5 ;done shifting 2324 244B 1A dec ;not done, shift and loop 2325 244C 12 71 0A stm shift_steps 2326 244F call2(shift_right_long) 2326 244F 2326 244F 11 5E 24 2326 2452 12 46 08 2326 2455 11 5F 24 2326 2458 12 47 08 2326 245B 13 B4 12 2326 245E 60 24 2327 2460 13 45 24 jmp f2d_loop_1 2328 2463 2329 2463 ;Convert integer portion to decimal string 2330 2463 11 02 0A f2d_next_5 ldm long_a ;save unshifted mantissa temporarily in long_c 2331 2466 12 08 0A stm long_c 2332 2469 11 03 0A ldm long_a+1 2333 246C 12 09 0A stm long_c+1 2334 246F 11 04 0A ldm long_a+2 2335 2472 12 0A 0A stm long_c+2 2336 2475 11 0B 0A ldm long_d ;place shifted mantissa in long_a 2337 2478 12 02 0A stm long_a 2338 247B 11 0C 0A ldm long_d+1 2339 247E 12 03 0A stm long_a+1 2340 2481 11 0D 0A ldm long_d+2 2341 2484 12 04 0A stm long_a+2 2342 2487 call0(long_to_dec_str) ;result in dec_str_buff 2342 2487 2342 2487 11 96 24 2342 248A 12 40 08 2342 248D 11 97 24 2342 2490 12 41 08 2342 2493 13 97 21 2342 2496 98 24 2343 2498 2344 2498 2345 2498 2346 2498 ;This section uses an indexed ldm and stm instructions to transfer digits to the output string 2347 2498 11 5A 09 ldm dec_out_str ;initialize output string pointer 2348 249B 12 72 0A stm dec_out_ptr 2349 249E 11 5B 09 ldm dec_out_str+1 2350 24A1 12 73 0A stm dec_out_ptr+1 2351 24A4 11 28 0A ldm fp_a ;check sign bit 2352 24A7 0C 80 andi 10000000b 2353 24A9 14 C0 24 jpz f2d_skip_1 ;positive, skip minus sign placement 2354 24AC 10 2D ldi 2Dh ;minus sign 2355 24AE 12 5C 09 stm dec_out_str+2 ;place in output string 2356 24B1 11 72 0A ldm dec_out_ptr ;increment output string pointer 2357 24B4 19 inc 2358 24B5 12 72 0A stm dec_out_ptr 2359 24B8 11 73 0A ldm dec_out_ptr+1 2360 24BB 09 00 adci 0 2361 24BD 12 73 0A stm dec_out_ptr+1 2362 24C0 11 3A 09 f2d_skip_1 ldm dec_str_buff ;Get address of source buffer 2363 24C3 12 CD 24 stm f2d_loop_2+1 ;Place as target of indexed ldm instruction 2364 24C6 11 3B 09 ldm dec_str_buff+1 2365 24C9 12 CE 24 stm f2d_loop_2+2 2366 24CC 11 00 00 f2d_loop_2 ldm 0000h ;address will change during program run 2367 24CF 14 36 25 jpz f2d_next_7 ;string terminator, done with transfer 2368 24D2 0A 30 subi 30h ;skip leading zeros 2369 24D4 14 DC 24 jpz f2d_next_6 2370 24D7 08 30 addi 30h ;restore ASCII value for non-zero character 2371 24D9 13 EE 24 jmp f2d_skip_2 2372 24DC 11 CD 24 f2d_next_6 ldm f2d_loop_2+1 ;increment address of ldm instruction 2373 24DF 19 inc ;low byte of source address 2374 24E0 12 CD 24 stm f2d_loop_2+1 2375 24E3 11 CE 24 ldm f2d_loop_2+2 ;high byte of source address 2376 24E6 09 00 adci 0 2377 24E8 12 CE 24 stm f2d_loop_2+2 2378 24EB 13 CC 24 jmp f2d_loop_2 2379 24EE 2380 24EE 12 FD 09 f2d_skip_2 stm char 2381 24F1 11 CD 24 ldm f2d_loop_2+1 ;pass address to next indexed ldm 2382 24F4 12 2E 25 stm f2d_loop_3+1 2383 24F7 11 CE 24 ldm f2d_loop_2+2 2384 24FA 12 2F 25 stm f2d_loop_3+2 2385 24FD 11 72 0A ldm dec_out_ptr ;Get target buffer pointer 2386 2500 12 0D 25 stm f2d_indx_stm+1 ;Place as target of indexed stm instruction 2387 2503 11 73 0A ldm dec_out_ptr+1 2388 2506 12 0E 25 stm f2d_indx_stm+2 2389 2509 11 FD 09 ldm char 2390 250C 12 00 00 f2d_indx_stm stm 0000h ;indexed store instruction 2391 250F 11 0D 25 ldm f2d_indx_stm+1 ;increment address of stm instruction 2392 2512 19 inc 2393 2513 12 0D 25 stm f2d_indx_stm+1 2394 2516 11 0E 25 ldm f2d_indx_stm+2 2395 2519 09 00 adci 0 2396 251B 12 0E 25 stm f2d_indx_stm+2 2397 251E 11 2E 25 ldm f2d_loop_3+1 ;increment address of ldm instruction 2398 2521 19 inc ;low byte of source address 2399 2522 12 2E 25 stm f2d_loop_3+1 2400 2525 11 2F 25 ldm f2d_loop_3+2 ;high byte of source address 2401 2528 09 00 adci 0 2402 252A 12 2F 25 stm f2d_loop_3+2 2403 252D 11 00 00 f2d_loop_3 ldm 0000h 2404 2530 14 36 25 jpz f2d_next_7 ;string terminator 2405 2533 13 0C 25 jmp f2d_indx_stm 2406 2536 2407 2536 11 0D 25 f2d_next_7 ldm f2d_indx_stm+1 ;save pointer 2408 2539 12 45 25 stm f2d_indx_stm2+1 2409 253C 11 0E 25 ldm f2d_indx_stm+2 2410 253F 12 46 25 stm f2d_indx_stm2+2 2411 2542 10 2E ldi 2Eh ;dot character 2412 2544 12 00 00 f2d_indx_stm2 stm 0000h ;place decimal point character in output string 2413 2547 11 45 25 ldm f2d_indx_stm2+1 2414 254A 19 inc 2415 254B 12 5F 25 stm f2d_indx_stm3+1 2416 254E 12 72 0A stm dec_out_ptr ;save string pointer 2417 2551 11 46 25 ldm f2d_indx_stm2+2 2418 2554 09 00 adci 0 2419 2556 12 60 25 stm f2d_indx_stm3+2 2420 2559 12 73 0A stm dec_out_ptr+1 2421 255C 10 30 ldi 30h ;zero character 2422 255E 12 00 00 f2d_indx_stm3 stm 0000h ;place zero after decimal point 2423 2561 11 5F 25 ldm f2d_indx_stm3+1 2424 2564 19 inc 2425 2565 12 73 25 stm f2d_indx_stmA+1 2426 2568 11 60 25 ldm f2d_indx_stm3+2 2427 256B 09 00 adci 0 2428 256D 12 74 25 stm f2d_indx_stmA+2 2429 2570 10 00 ldi 0 2430 2572 12 00 00 f2d_indx_stmA stm 0000h ;string termination (in case no fraction) 2431 2575 2432 2575 2433 2575 ;Get fraction part from fp with positive or zero exponent 2434 2575 11 A7 09 ldm frac_table_addr ;initialize fraction table pointer 2435 2578 12 EE 09 stm frac_table_ptr 2436 257B 11 A8 09 ldm frac_table_addr+1 2437 257E 12 EF 09 stm frac_table_ptr+1 2438 2581 10 00 ldi 00h ;initialize hex_frac to zero 2439 2583 12 F3 09 stm hex_frac 2440 2586 12 F4 09 stm hex_frac+1 2441 2589 12 F5 09 stm hex_frac+2 2442 258C 2443 258C 11 08 0A ldm long_c ;get unshifted mantissa back 2444 258F 12 02 0A stm long_a ;store in long_a 2445 2592 11 09 0A ldm long_c+1 2446 2595 12 03 0A stm long_a+1 2447 2598 11 0A 0A ldm long_c+2 2448 259B 12 04 0A stm long_a+2 2449 259E 11 F8 09 ldm exponent_a ;unbiased positive exponent 2450 25A1 12 71 0A stm shift_steps ;number of shifts to get fraction bits to left 2451 25A4 10 01 ldi 1 2452 25A6 12 74 0A stm int_flag ;1 if fp integer, 0 if not 2453 25A9 f2d_frac_loop1 call2(shift_left_long) ;shifts long_c 2453 25A9 2453 25A9 11 B8 25 2453 25AC 12 46 08 2453 25AF 11 B9 25 2453 25B2 12 47 08 2453 25B5 13 0E 12 2453 25B8 BA 25 2454 25BA 11 71 0A ldm shift_steps 2455 25BD 1A dec 2456 25BE 14 C7 25 jpz f2d_frac_loop2 2457 25C1 12 71 0A stm shift_steps 2458 25C4 13 A9 25 jmp f2d_frac_loop1 2459 25C7 f2d_frac_loop2 call2(shift_left_long) 2459 25C7 2459 25C7 11 D6 25 2459 25CA 12 46 08 2459 25CD 11 D7 25 2459 25D0 12 47 08 2459 25D3 13 0E 12 2459 25D6 D8 25 2460 25D8 2461 25D8 11 08 0A ldm long_c ;check if frac part zero 2462 25DB 05 09 0A orm long_c+1 2463 25DE 05 0A 0A orm long_c+2 2464 25E1 14 6D 26 jpz f2d_frac_done ;yes, shifting done 2465 25E4 10 00 ldi 0 2466 25E6 12 74 0A stm int_flag ;indicates fp is not an integer 2467 25E9 11 08 0A ldm long_c ;no 2468 25EC 0C 80 andi 10000000b ;one in leftmost bit? 2469 25EE 14 5A 26 jpz f2d_next_9 ;no, go to next step 2470 25F1 11 EE 09 ldm frac_table_ptr ;yes, add partial fraction 2471 25F4 12 FE 25 stm f2d_indx_ldm1+1 2472 25F7 11 EF 09 ldm frac_table_ptr+1 2473 25FA 12 FF 25 stm f2d_indx_ldm1+2 2474 25FD 11 00 00 f2d_indx_ldm1 ldm 0000h ;program will place target 2475 2600 12 05 0A stm long_b ;temp store of fraction part 2476 2603 11 FE 25 ldm f2d_indx_ldm1+1 ;increment pointer 2477 2606 19 inc 2478 2607 12 13 26 stm f2d_indx_ldm2+1 2479 260A 11 FF 25 ldm f2d_indx_ldm1+2 2480 260D 09 00 adci 0 2481 260F 12 14 26 stm f2d_indx_ldm2+2 2482 2612 11 00 00 f2d_indx_ldm2 ldm 0000h 2483 2615 12 06 0A stm long_b+1 2484 2618 11 13 26 ldm f2d_indx_ldm2+1 2485 261B 19 inc 2486 261C 12 28 26 stm f2d_indx_ldm3+1 2487 261F 11 14 26 ldm f2d_indx_ldm2+2 2488 2622 09 00 adci 0 2489 2624 12 29 26 stm f2d_indx_ldm3+2 2490 2627 11 00 00 f2d_indx_ldm3 ldm 0000h 2491 262A 12 07 0A stm long_b+2 2492 262D 11 28 26 ldm f2d_indx_ldm3+1 ;increment pointer 2493 2630 19 inc 2494 2631 12 EE 09 stm frac_table_ptr ;and store 2495 2634 11 29 26 ldm f2d_indx_ldm3+2 2496 2637 09 00 adci 0 2497 2639 12 EF 09 stm frac_table_ptr+1 2498 263C 11 F3 09 ldm hex_frac 2499 263F 00 05 0A addm long_b 2500 2642 12 F3 09 stm hex_frac 2501 2645 11 F4 09 ldm hex_frac+1 2502 2648 01 06 0A adcm long_b+1 2503 264B 12 F4 09 stm hex_frac+1 2504 264E 11 F5 09 ldm hex_frac+2 2505 2651 01 07 0A adcm long_b+2 2506 2654 12 F5 09 stm hex_frac+2 2507 2657 2508 2657 13 C7 25 jmp f2d_frac_loop2 2509 265A 2510 265A 11 EE 09 f2d_next_9 ldm frac_table_ptr ;increment table pointer 2511 265D 08 03 addi 3 2512 265F 12 EE 09 stm frac_table_ptr 2513 2662 11 EF 09 ldm frac_table_ptr+1 2514 2665 09 00 adci 0 2515 2667 12 EF 09 stm frac_table_ptr+1 2516 266A 2517 266A 13 C7 25 jmp f2d_frac_loop2 2518 266D 2519 266D 11 74 0A f2d_frac_done ldm int_flag ;is fp an integer? 2520 2670 14 76 26 jpz f2d_skip_3 ;no, create dec frac string 2521 2673 13 F0 26 jmp f2d_next_10 ;yes, all done 2522 2676 11 02 0A f2d_skip_3 ldm long_a ;store long_a (needed? maybe not) 2523 2679 12 08 0A stm long_c 2524 267C 11 03 0A ldm long_a+1 2525 267F 12 09 0A stm long_c+1 2526 2682 11 04 0A ldm long_a+2 2527 2685 12 0A 0A stm long_c+2 2528 2688 11 F5 09 ldm hex_frac+2 ;put hex_frac into long_a and 2529 268B 12 02 0A stm long_a ;reverse byte order because 2530 268E 11 F4 09 ldm hex_frac+1 ;long_to_dec_str expects 2531 2691 12 03 0A stm long_a+1 ;big-endian long value 2532 2694 11 F3 09 ldm hex_frac 2533 2697 12 04 0A stm long_a+2 2534 269A call0(long_to_dec_str) 2534 269A 2534 269A 11 A9 26 2534 269D 12 40 08 2534 26A0 11 AA 26 2534 26A3 12 41 08 2534 26A6 13 97 21 2534 26A9 AB 26 2535 26AB 2536 26AB ;Transfer decimal fraction string from dec_str_buff to dec_out_str 2537 26AB 11 3A 09 ldm dec_str_buff ;Get address of source buffer 2538 26AE 19 inc ;Skip first character 2539 26AF 12 C7 26 stm f2d_loop_4+1 ;Place as target of indexed ldm instruction 2540 26B2 11 3B 09 ldm dec_str_buff+1 2541 26B5 09 00 adci 0 2542 26B7 12 C8 26 stm f2d_loop_4+2 2543 26BA 11 72 0A ldm dec_out_ptr ;Get target buffer pointer 2544 26BD 12 CA 26 stm f2d_indx_stm4+1 ;Place as target of indexed stm instruction 2545 26C0 11 73 0A ldm dec_out_ptr+1 2546 26C3 12 CB 26 stm f2d_indx_stm4+2 2547 26C6 11 00 00 f2d_loop_4 ldm 0000h ;address will change during program run 2548 26C9 12 00 00 f2d_indx_stm4 stm 0000h ;indexed store instruction 2549 26CC 14 F0 26 jpz f2d_next_10 ;string terminator, done with transfer 2550 26CF 11 CA 26 ldm f2d_indx_stm4+1 ;increment address of stm instruction 2551 26D2 19 inc 2552 26D3 12 CA 26 stm f2d_indx_stm4+1 2553 26D6 11 CB 26 ldm f2d_indx_stm4+2 2554 26D9 09 00 adci 0 2555 26DB 12 CB 26 stm f2d_indx_stm4+2 2556 26DE 11 C7 26 ldm f2d_loop_4+1 ;increment address of ldm instruction 2557 26E1 19 inc ;low byte of source address 2558 26E2 12 C7 26 stm f2d_loop_4+1 2559 26E5 11 C8 26 ldm f2d_loop_4+2 ;high byte of source address 2560 26E8 09 00 adci 0 2561 26EA 12 C8 26 stm f2d_loop_4+2 2562 26ED 13 C6 26 jmp f2d_loop_4 2563 26F0 2564 26F0 f2d_next_10 retA 2564 26F0 13 78 0A 2565 26F3 2566 26F3 ;Negative exponent in range 2567 26F3 13 33 27 f2d_next_4 jmp f2d_quit 2568 26F6 2569 26F6 ;Exponent out-of-range errors 2570 26F6 11 7A 09 f2d_err_hi ldm range_err_hi 2571 26F9 12 34 08 stm ws_inst+1 2572 26FC 11 7B 09 ldm range_err_hi+1 2573 26FF 12 35 08 stm ws_inst+2 2574 2702 call0(write_string) 2574 2702 2574 2702 11 11 27 2574 2705 12 40 08 2574 2708 11 12 27 2574 270B 12 41 08 2574 270E 13 E7 05 2574 2711 13 27 2575 2713 13 33 27 jmp f2d_quit 2576 2716 2577 2716 11 91 09 f2d_err_lo ldm range_err_lo 2578 2719 12 34 08 stm ws_inst+1 2579 271C 11 92 09 ldm range_err_lo+1 2580 271F 12 35 08 stm ws_inst+2 2581 2722 call0(write_string) 2581 2722 2581 2722 11 31 27 2581 2725 12 40 08 2581 2728 11 32 27 2581 272B 12 41 08 2581 272E 13 E7 05 2581 2731 33 27 2582 2733 2583 2733 f2d_quit retA 2583 2733 13 78 0A 2584 2736 2585 2736 return .set 0900h ;assembler needs variable label set back to original value 2586 2736 2587 2736 .end 2588 2736 2589 2736 2590 2736 tasm: Number of errors = 0