<| \ ARTH1.F08 HEX :CODE D+ \ ( D1 D2 --- D3 ) \ ( UD1 UD2 --- UD3 ) \ D1 + D2 = D3 7 ,X LDA, 3 ,X ADD, 7 ,X STA, 6 ,X LDA, 2 ,X ADC, 6 ,X STA, 5 ,X LDA, 1 ,X ADC, 5 ,X STA, 4 ,X LDA, 0,X ADC, 4 ,X STA, INX, INX, INX, INX, RTS, CODE; :CODE D- \ ( D1 D2 --- D3 ) \ ( UD1 UD2 --- UD3 ) \ D1 - D2 = D3 7 ,X LDA, 3 ,X SUB, 7 ,X STA, 6 ,X LDA, 2 ,X SBC, 6 ,X STA, 5 ,X LDA, 1 ,X SBC, 5 ,X STA, 4 ,X LDA, 0,X SBC, 4 ,X STA, INX, INX, INX, INX, RTS, CODE; :CODE D2/ \ ( D1 --- D2 ) 0,X LDA, A. ASL, \ Shift Bit7 to Carry 0,X ROR, 1 ,X ROR, 2 ,X ROR, 3 ,X ROR, RTS, CODE; :CODE D2* \ ( D1 --- D2 ) 3 ,X ASL, 2 ,X ROL, 1 ,X ROL, 0,X ROL, RTS, CODE; : D@ \ ( Addr --- D1 ) DUP 2+ @ SWAP @ ; : D! \ ( D1 Addr --- ) only RAM SWAP OVER ! 2+ ! ; : D, , , ; \ ( D1 --- ) :CODE 2/ \ ( N1 --- N2 ) 0,X LDA, A. ASL, \ Shift Bit7 to Carry 0,X ROR, 1 ,X ROR, RTS, CODE; : 2* 1D \ ( N1 --- D1 ) DEX, DEX, \ Expands 16 Bit to 32 Bit N CLR, 2 ,X LDA, 1 $ BPL, N DEC, 1 $: N LDA, 0,X STA, 1 ,X STA, RTS, CODE; ." -> ARTH2.F08" |> <| \ ARTH2.F08 : NEGATE NOT 1+ ; \ ( N1 --- N2 ) : DNEGATE 0 0 2SWAP D- ; \ ( DN1 --- DN2 ) : ABS DUP 8000 AND IF NEGATE THEN ; \ ( N1 --- N2 ) : DABS DUP 8000 AND IF DNEGATE THEN ; \ ( DN1 --- DN2 ) \ ------------------------------------------------------------ \ include NEGATE DNEGATE U* U/ U/MOD ; uses CPU-Stack :CODE * \ ( N1 N2 --- D1 ) 2 ,X LDA, PHA, 1 $ BPL, INX, INX, ' NEGATE JSR, DEX, DEX, 1 $: PLA, 0,X EOR, PHA, 0,X LDA, 2 $ BPL, ' NEGATE JSR, 2 $: ' U* JSR, PLA, 3 $ BEQ, ' DNEGATE JSR, 3 $: RTS, CODE; :CODE / \ ( D1 N1 --- N2 ) 2 ,X LDA, PHA, 1 $ BPL, INX, INX, ' DNEGATE JSR, DEX, DEX, 1 $: PLA, 0,X EOR, PHA, 0,X LDA, 2 $ BPL, ' NEGATE JSR, 2 $: ' U/ JSR, PLA, 3 $ BEQ, ' NEGATE JSR, 3 $: RTS, CODE; :CODE /MOD \ ( D1 N1 --- UN2 N3 ) 2 ,X LDA, PHA, 1 $ BPL, INX, INX, ' DNEGATE JSR, DEX, DEX, 1 $: PLA, 0,X EOR, PHA, 0,X LDA, 2 $ BPL, ' NEGATE JSR, 2 $: ' U/MOD JSR, PLA, 3 $ BEQ, ' NEGATE JSR, 3 $: RTS, CODE; : */ * / ; \ ( N1 N2 N3 --- N4 ) ." -> ARTH3.F08" |> <| \ ARTH3.F08 \ V11HINZC > < = \ EEEE EEEE 6A 01101010 1 = FFFF \ 7FFF 1234 68 01101000 1 > FFFF \ 1234 7FFF 6D 01101101 1 < FFFF \ 8457 8156 68 01101000 1 > FFFF -31657 -32426 \ 8156 8457 6D 01101101 1 < FFFF \ 7567 8123 ED 11101101 1 > FFFF \ 8123 7567 E8 11101000 1 < FFFF \ 0 0 0 0 1 1 \ 0 1 0 1 1 0 :CODE < \ ( N1 N2 --- F1 ) \ N1 < N2 F1 = 0001 N CLR, \ N1 > N2 F1 = 0000 3 ,X LDA, \ N1 = N2 F1 = 0000 1 ,X SUB, 2 ,X LDA, 0,X SBC, 1 $ BEQ, TPA, N 1+ STA, A. ROR, A. ROR, N 1+ EOR, 1 $ BPL, N DEC, 1 $: N LDA, 2 ,X STA, 3 ,X STA, INX, INX, RTS, CODE; :CODE > \ ( N1 N2 --- F1 ) \ N1 > N2 F1 = 0001 N CLR, \ N1 < N2 F1 = 0000 3 ,X LDA, \ N1 = N2 F1 = 0000 1 ,X SUB, 2 ,X LDA, 0,X SBC, 1 $ BEQ, TPA, N 1+ STA, A. ROR, A. ROR, N 1+ EOR, 1 $ BMI, N DEC, 1 $: N LDA, 2 ,X STA, 3 ,X STA, INX, INX, RTS, CODE; : UD> \ ( UD1 UD2 --- Flag ) ROT 2DUP = IF 2DROP U> ELSE U< SWAP DROP SWAP DROP THEN ; : 0< 8000 AND ; \ ( UN1 --- Flag ) ." -> OUT.F08" |> <| \ OUT.F08 \ ---------------------------------------------------------- \ include D+ D- D2* UD> DNEGATE DECIMAL TABLE D-TAB 15258 , 51711 , \ 999 999 999 1525 , 57599 , \ 99 999 999 152 , 38527 , \ 9 999 999 15 , 16959 , \ 999 999 1 , 34463 , \ 99 999 0 , 9999 , 0 , 999 , 0 , 99 , 0 , 9 , HEX : (D.) \ ( D1 , # --- ) D1 = 0 - 7FFFFFFF \ # = 2 - A : digits printed A SWAP - 1 IF 1 0 D+ 2SWAP \ ( --- D2 , D1 ) 9 1 DO \ D2 = ... 10000 1000 100 10 2OVER D- \ ( --- D2 D1' ) 2OVER 2OVER UD> \ ( --- D2 D1' F ) IF LEAVE I THEN LOOP 30 + EMIT \ ( --- D2 D1' ) 2SWAP 2DROP ELSE 2DROP 30 EMIT \ Emit ZERO THEN 4 +LOOP DROP 30 + EMIT ; : D. \ ( D1 --- ) \ Emits D1 = 0 - 7FFFFFFF, rightadjusted, \ with leading ZEROs as 10 chars A (D.) SPACE ; : SD. \ ( D1 --- ) \ Emits a Sign and \ Needs DNEGATE DD. DUP 8000 = HOPP 0 = LAND IF 2DROP ." -2147483648 " \ 8000'0000 ELSE DUP 8000 AND IF DNEGATE 2D ELSE 2B THEN EMIT D. THEN ; ." -> IN.F08" |> <| \ IN.F08 HEX \ ------------------------------------------------------------ \ include D2* D+ D- DNEGATE : D: \ ( --- D1 ) Input D1, UD1 STRING SB C@ DUP 2D = DUP ROT 2B = LOR IF SB SB 1- 0C CMOVE THEN \ ( F1 --- ) F1= 1 if negative A 0 DO SB I + C@ DUP 20 = IF DROP I 1- 0 LEAVE ELSE DUP 30 U< SWAP 39 U> LOR 11 ?ERROR THEN LOOP 11 ?ERROR \ ( F1 C1 --- ) C1 points to last digit DUP DUP 0 DO DUP I = OVER I U< LOR IF LEAVE ELSE SB I + OVER SB + 2DUP C@ SWAP C@ ROT C! SWAP C! 1- THEN LOOP DROP 00 00 ROT 0 DO SB I + C@ 0F AND 00 I IF I 1- 0 DO 2DUP 2DUP D2* D2* D2* D+ D+ LOOP THEN D+ LOOP ROT IF DNEGATE THEN ; |> <| \ CMOVE.F08 HEX :CODE CMOVE> \ ( Addr1 Addr2 N1 --- ) \ Addr1 = FROM \ Addr2 = TO \ N1 = Number of Bytes \ Last Byte copied first 0,X LDA, 1 ,X ORA, 4 $ BEQ, NOPC C6 #. MOV, \ hhhh LDA, 5 ,X LDA, 1 ,X ADD, 01 #. SUB, NOPC 2+ STA, 4 ,X LDA, 0,X ADC, 00 #. SBC, NOPC 1+ STA, NOPC 3 + C7 #. MOV, \ hhhh STA, 3 ,X LDA, 1 ,X ADD, 01 #. SUB, NOPC 5 + STA, 2 ,X LDA, 0,X ADC, 00 #. SBC, NOPC 4 + STA, 3 $: NOPC JSR, NOPC 5 + LDA, 3 ,X CMP, 5 $ BNE, NOPC 4 + LDA, 2 ,X CMP, 4 $: TXA, 06 #. ADD, TAX, NOPC 3 + 81 #. MOV, \ RTS, RTS, 5 $: NOPC 2+ LDA, \ From 01 #. SUB, NOPC 2+ STA, NOPC 1+ LDA, 00 #. SBC, NOPC 1+ STA, NOPC 5 + LDA, \ to 01 #. SUB, NOPC 5 + STA, NOPC 4 + LDA, 00 #. SBC, NOPC 4 + STA, 3 $ BRA, CODE; |>