Browse code
(blank.tal) Cleaned up
neauoire authored on 11/12/2021 22:28:10
Showing 1 changed files
| ... | ... |
@@ -1,14 +1,24 @@ |
| 1 | 1 |
( a blank file ) |
| 2 | 2 |
|
| 3 |
-%+ { ADD } %- { SUB } %/ { DIV }
|
|
| 4 |
-%< { LTH } %> { GTH } %= { EQU } %! { NEQ }
|
|
| 5 |
-%++ { ADD2 } %-- { SUB2 } %// { DIV2 }
|
|
| 6 |
-%<< { LTH2 } %>> { GTH2 } %== { EQU2 } %!! { NEQ2 }
|
|
| 7 |
- |
|
| 8 |
-%DEBUG { ;print-hex JSR2 #0a .Console/write DEO }
|
|
| 9 |
-%DEBUG2 { SWP ;print-hex JSR2 ;print-hex JSR2 #0a .Console/write DEO }
|
|
| 10 |
- |
|
| 11 |
-%RTN { JMP2r }
|
|
| 3 |
+%+ { ADD } %- { SUB } %* { MUL } %/ { DIV }
|
|
| 4 |
+%< { LTH } %> { GTH } %= { EQU } %! { NEQ }
|
|
| 5 |
+%++ { ADD2 } %-- { SUB2 } %** { MUL2 } %// { DIV2 }
|
|
| 6 |
+%<< { LTH2 } %>> { GTH2 } %== { EQU2 } %!! { NEQ2 }
|
|
| 7 |
+ |
|
| 8 |
+%2* { #10 SFT } %2/ { #01 SFT } %2** { #10 SFT2 } %2// { #01 SFT2 }
|
|
| 9 |
+%4* { #20 SFT } %4/ { #02 SFT } %4** { #20 SFT2 } %4// { #02 SFT2 }
|
|
| 10 |
+%8* { #30 SFT } %8/ { #03 SFT } %8** { #30 SFT2 } %8// { #03 SFT2 }
|
|
| 11 |
+%10* { #40 SFT } %10/ { #04 SFT } %10** { #40 SFT2 } %10// { #04 SFT2 }
|
|
| 12 |
+%20* { #50 SFT } %20/ { #05 SFT } %20** { #50 SFT2 } %20// { #05 SFT2 }
|
|
| 13 |
+ |
|
| 14 |
+%2MOD { #01 AND } %2MOD2 { #0001 AND2 }
|
|
| 15 |
+%4MOD { #03 AND } %4MOD2 { #0003 AND2 }
|
|
| 16 |
+%8MOD { #07 AND } %8MOD2 { #0007 AND2 }
|
|
| 17 |
+%10MOD { #0f AND } %10MOD2 { #000f AND2 }
|
|
| 18 |
+ |
|
| 19 |
+%DEBUG { ;print-hex/byte JSR2 #0a18 DEO }
|
|
| 20 |
+%DEBUG2 { ;print-hex JSR2 #0a18 DEO }
|
|
| 21 |
+%RTN { JMP2r }
|
|
| 12 | 22 |
|
| 13 | 23 |
( devices ) |
| 14 | 24 |
|
| ... | ... |
@@ -28,10 +38,6 @@ |
| 28 | 38 |
|
| 29 | 39 |
|0000 |
| 30 | 40 |
|
| 31 |
-@lista $3 |
|
| 32 |
-@listb $3 |
|
| 33 |
-@listc $3 |
|
| 34 |
- |
|
| 35 | 41 |
( program ) |
| 36 | 42 |
|
| 37 | 43 |
|0100 ( -> ) |
| ... | ... |
@@ -41,55 +47,35 @@ |
| 41 | 47 |
#0fc5 .System/g DEO2 |
| 42 | 48 |
#0f25 .System/b DEO2 |
| 43 | 49 |
|
| 44 |
- #01 .lista STZ |
|
| 45 |
- #02 .lista INC STZ |
|
| 46 |
- #03 .lista #02 + STZ |
|
| 47 |
- |
|
| 48 |
- #10 .listb STZ |
|
| 49 |
- #20 .listb INC STZ |
|
| 50 |
- #30 .listb #02 + STZ |
|
| 51 |
- |
|
| 52 |
- .lista .listb .listc ;add-lists-loop JSR2 |
|
| 50 |
+BRK |
|
| 53 | 51 |
|
| 54 |
- .listc LDZ DEBUG |
|
| 55 |
- .listc INC LDZ DEBUG |
|
| 56 |
- .listc #02 + LDZ DEBUG |
|
| 52 |
+@print-hex ( value* -- ) |
|
| 53 |
+ |
|
| 54 |
+ SWP ,&byte JSR |
|
| 55 |
+ &byte ( byte -- ) |
|
| 56 |
+ STHk #04 SFT ,&parse JSR #18 DEO |
|
| 57 |
+ STHr #0f AND ,&parse JSR #18 DEO |
|
| 58 |
+ RTN |
|
| 59 |
+ &parse ( byte -- char ) DUP #09 GTH ,&above JCN #30 + RTN |
|
| 60 |
+ &above #57 + RTN |
|
| 57 | 61 |
|
| 58 |
-BRK |
|
| 62 |
+RTN |
|
| 59 | 63 |
|
| 60 |
-( Write a Forth word to add together two integer |
|
| 61 |
-vectors (a.k.a. arrays) of three elements each. ) |
|
| 64 |
+@print-dec ( value* -- ) |
|
| 62 | 65 |
|
| 63 |
-@add-lists-linear ( a b c -- ) |
|
| 64 |
- |
|
| 65 |
- STH |
|
| 66 |
- ( a[0] b[0] + ) LDZk STH SWP LDZk STHr + STHkr STZ |
|
| 67 |
- ( a[1] b[1] + ) INC LDZk STH SWP INC LDZk STHr + STHkr INC STZ |
|
| 68 |
- ( a[2] b[2] + ) INC LDZ SWP INC LDZ + STHr #02 + STZ |
|
| 66 |
+ #2710 DIV2k DUP #30 ADD #18 DEO MUL2 SUB2 |
|
| 67 |
+ #03e8 DIV2k DUP #30 ADD #18 DEO MUL2 SUB2 |
|
| 68 |
+ #0064 DIV2k DUP #30 ADD #18 DEO MUL2 SUB2 |
|
| 69 |
+ #000a DIV2k DUP #30 ADD #18 DEO MUL2 SUB2 |
|
| 70 |
+ #30 ADD #18 DEO POP |
|
| 69 | 71 |
|
| 70 | 72 |
RTN |
| 71 | 73 |
|
| 72 |
-@add-lists-loop ( a b c -- ) |
|
| 73 |
- |
|
| 74 |
- STH |
|
| 75 |
- #00 #03 |
|
| 76 |
- &loop |
|
| 77 |
- ( get incr ) OVR STH |
|
| 78 |
- ( get a[x] ) OVR2 STHkr ADD LDZ |
|
| 79 |
- ( get b[x] ) SWP STHkr ADD LDZ |
|
| 80 |
- ( set c[x] ) ADD STHr STHkr ADD STZ |
|
| 81 |
- ( incr ) SWP INC SWP |
|
| 82 |
- LTHk ,&loop JCN |
|
| 83 |
- POP2 POP2 POPr |
|
| 84 |
- |
|
| 85 |
-JMP2r |
|
| 86 |
- |
|
| 87 |
-@print-hex ( value -- ) |
|
| 88 |
- |
|
| 89 |
- STHk #04 SFT ,&parse JSR .Console/write DEO |
|
| 90 |
- STHr #0f AND ,&parse JSR .Console/write DEO |
|
| 91 |
- RTN |
|
| 92 |
- &parse ( value -- char ) |
|
| 93 |
- DUP #09 GTH ,&above JCN #30 ADD RTN &above #09 SUB #60 ADD RTN |
|
| 74 |
+@print-str ( string* -- ) |
|
| 75 |
+ |
|
| 76 |
+ 1-- |
|
| 77 |
+ &while |
|
| 78 |
+ INC2 LDAk DUP #18 DEO ,&while JCN |
|
| 79 |
+ POP2 |
|
| 94 | 80 |
|
| 95 | 81 |
RTN |
| 96 | 82 |
\ No newline at end of file |