helpers.tal (5087B)
1 %BYE { #01 .System/halt DEO BRK } 2 %DEBUG { #ab .System/debug DEO } 3 %IN-RANGE { ROT INCk SWP SUB2 GTH } 4 %MOD { DIVk MUL SUB } 5 %MOD2 { DIV2k MUL2 SUB2 } 6 %NL { #0a .Console/write DEO } 7 %SP { #20 .Console/write DEO } 8 9 @print-string ( string* -- ) 10 LDAk ,¬-end JCN 11 POP2 JMP2r 12 ¬-end 13 LDAk .Console/write DEO 14 INC2 15 ,print-string JMP 16 17 @print-short-decimal ( short* -- ) 18 #03e8 DIV2k 19 DUP ,print-byte-decimal/second JSR 20 MUL2 SUB2 21 #0064 DIV2k 22 DUP ,print-byte-decimal/third JSR 23 MUL2 SUB2 24 NIP ,print-byte-decimal/second JMP 25 26 @print-byte-decimal ( byte -- ) 27 #64 DIVk DUP #30 ADD .Console/write DEO MUL SUB 28 &second 29 #0a DIVk DUP #30 ADD .Console/write DEO MUL SUB 30 &third 31 #30 ADD .Console/write DEO 32 JMP2r 33 34 @print-32z-hex ( 32-zp -- ) 35 #00 SWP 36 ,print-32-hex JMP 37 38 @print-64z-hex ( 64-zp -- ) 39 #00 SWP 40 ( fall through ) 41 42 @print-64-hex ( 64-ptr* -- ) 43 DUP2 #0004 ADD2 SWP2 ( lo32-ptr* hi32-ptr* ) 44 ,print-32-hex JSR 45 ( fall through ) 46 47 @print-32-hex ( 32-ptr* -- ) 48 INC2k INC2 SWP2 ( lo-ptr* hi-ptr* ) 49 LDA2 ,print-short-hex JSR 50 LDA2 ( fall through ) 51 52 @print-short-hex ( short* -- ) 53 SWP ,print-byte-hex JSR 54 ( fall through ) 55 56 @print-byte-hex ( byte -- ) 57 DUP #04 SFT ,print-nibble-hex JSR 58 #0f AND ( fall through ) 59 60 @print-nibble-hex ( nibble -- ) 61 #30 ADD DUP #39 GTH #07 MUL ADD .Console/write DEO 62 JMP2r 63 64 @next-input-byte ( -- number 00 65 OR 01 at end of file ) 66 ,next-input-short JSR ,&eof JCN 67 NIP #00 68 JMP2r 69 70 &eof 71 #01 72 JMP2r 73 74 @next-input-short ( -- number* 00 75 OR 01 at end of file ) 76 LIT2 &ptr :heap 77 LIT2r 0000 78 &ffwd 79 LDAk #3039 IN-RANGE ,&number JCN 80 INC2k SWP2 LDA ,&ffwd JCN 81 ( eof ) 82 POP2 POP2r 83 ;heap ,&ptr STR2 84 #01 JMP2r 85 86 &number 87 LIT2r 000a MUL2r 88 LDAk #30 SUB LITr 00 STH ADD2r 89 INC2 90 LDAk #3039 IN-RANGE ,&number JCN 91 92 ,&ptr STR2 93 STH2r #00 94 JMP2r 95 96 @add64 ( dest-ptr* src-ptr* -- carry ) 97 OVR2 #0004 ADD2 OVR2 #0004 ADD2 98 ,add32 JSR 99 ( fall through ) 100 101 @adc32 ( dest-ptr* src-ptr* carry -- carry ) 102 STH 103 OVR2 #0002 ADD2 OVR2 #0002 ADD2 104 STHr ,adc16 JSR 105 ,adc16 JMP ( tail call ) 106 107 @add64z ( dest-zp src-zp -- carry ) 108 OVR #04 ADD OVR #04 ADD 109 ,add32z JSR 110 ( fall through ) 111 112 @adc32z ( dest-zp src-zp carry -- carry ) 113 STH 114 OVR #02 ADD OVR #02 ADD 115 STHr ,adc16z JSR 116 ,adc16z JMP ( tail call ) 117 118 @add32z-short ( dest-zp src* -- carry ) 119 #00 SWP SWP2 ROT 120 ( fall through ) 121 122 @add32-short ( dest-ptr* src* -- carry ) 123 ,&short STR2 124 ;&src ,add32 JMP ( tail call ) 125 126 &src 0000 &short 0000 127 128 @add32 ( dest-ptr* src-ptr* -- carry ) 129 OVR2 #0002 ADD2 OVR2 #0002 ADD2 130 ,add16 JSR 131 ( fall through ) 132 133 @adc16 ( dest-ptr* src-ptr* carry -- carry ) 134 #00 EQU ,add16 JCN 135 OVR2 ;&one ,add16 JSR STH 136 ,add16 JSR 137 STHr ORA 138 JMP2r 139 140 &one 0001 141 142 @add16 ( dest-ptr* src-ptr* -- carry ) 143 OVR2 LDA2 DUP2 ROT2 LDA2 ( dest-ptr* dest* dest* src* ) 144 ADD2 GTH2k STH NIP2 ( dest-ptr* sum* / carry ) 145 SWP2 STA2 STHr ( carry ) 146 JMP2r 147 148 @add32z ( dest-zp src-zp -- carry ) 149 OVR #02 ADD OVR #02 ADD 150 ,add16z JSR 151 ( fall through ) 152 153 @adc16z ( dest-zp src-zp carry -- carry ) 154 #00 EQU ,add16z JCN 155 OVR #00 SWP ;adc16/one ,add16 JSR STH 156 ,add16z JSR 157 STHr ORA 158 JMP2r 159 160 @add16z ( dest-zp src-zp -- carry ) 161 OVR LDZ2 ROT LDZ2 OVR2 ( dest-zp dest* src* dest* ) 162 ADD2 GTH2k STH NIP2 ( dest-zp sum* / carry ) 163 ROT STZ2 STHr ( carry ) 164 JMP2r 165 166 @gth64 ( left-ptr* right-ptr* -- 01 if left > right 167 OR 00 otherwise ) 168 OVR2 OVR2 ,gth32 JSR ,&greater JCN 169 OVR2 OVR2 SWP2 ,gth32 JSR ,&less JCN 170 #0004 ADD2 SWP2 #0004 ADD2 SWP2 ,gth32 JMP ( tail call ) 171 172 &greater POP2 POP2 #01 JMP2r 173 &less POP2 POP2 #00 JMP2r 174 175 @gth32z ( left-zp* right-zp* -- 01 if left > right 176 OR 00 otherwise ) 177 #00 ROT ROT #00 SWP 178 ( fall through ) 179 180 @gth32 ( left-ptr* right-ptr* -- 01 if left > right 181 OR 00 otherwise ) 182 OVR2 LDA2 OVR2 LDA2 ( left-ptr* right-ptr* left* right* ) 183 EQU2k ,&lo JCN 184 GTH2 NIP2 NIP NIP 185 JMP2r 186 187 &lo 188 POP2 POP2 189 INC2 INC2 LDA2 SWP2 INC2 INC2 LDA2 ( right-lo* left-lo* ) 190 LTH2 191 JMP2r 192 193 @add32z-short-short-mul ( dest-zp a* b* -- carry ) 194 STH2 STH2 #00 SWP STH2r STH2r 195 ( fall through ) 196 197 @add32-short-short-mul ( dest-ptr* a* b* -- carry ) 198 LITr 00 STH LITr 00 STH ( dest-ptr* a* / blo* bhi* ) 199 #00 ROT ROT #00 SWP ( dest-ptr* ahi* alo* / blo* bhi* ) 200 STH2kr OVR2 MUL2 ,&alo-bhi STR2 201 OVR2 STH2r MUL2 ,&ahi-bhi STR2 ( dest-ptr ahi* alo* / blo* ) 202 STH2kr MUL2 ,&alo-blo STR2 ( dest-ptr* ahi* / blo* ) 203 STH2r MUL2 ,&ahi-blo STR2 ( dest-ptr* ) 204 DUP2 ;&sum1 ;add32 JSR2 STH 205 DUP2 ;&sum2 ;add32 JSR2 STH 206 ;&sum3 ;add32 JSR2 207 STH2r ORA ORA 208 JMP2r 209 210 &sum1 &ahi-bhi 0000 &alo-blo 0000 211 &sum2 00 &ahi-blo 0000 00 212 &sum3 00 &alo-bhi 0000 00 213 214 @zero64 ( ptr* -- ) 215 #08 ,zero JMP ( tail call ) 216 217 @zero32z ( zp -- ) 218 #00 SWP 219 ( fall through ) 220 221 @zero32 ( ptr* -- ) 222 #04 223 ( fall through ) 224 225 @zero ( ptr* len -- ) 226 #00 SWP ADD2k NIP2 SWP2 227 &loop 228 DUP2 #00 ROT ROT STA 229 INC2 230 GTH2k ,&loop JCN 231 POP2 POP2 232 JMP2r 233 234 @is-nonzero64 ( ptr* -- flag ) 235 DUP2 ,is-nonzero32 JSR STH 236 #0004 ADD2 ,is-nonzero32 JSR STHr ORA 237 JMP2r 238 239 @is-nonzero32 ( ptr* -- flag ) 240 LDA2k ORA STH 241 INC2 INC2 LDA2 ORA STHr ORA 242 JMP2r 243