Implementing figFORTH on SH3 assembler
Revision | 711172d9e1780ce2814c68d9496e196476b40f0c (tree) |
---|---|
Time | 2014-03-07 14:05:47 |
Author | Joel Matthew Rees <reiisi@user...> |
Commiter | Joel Matthew Rees |
Stubs for EMIT, KEY, etc., CMOVE
@@ -34,6 +34,7 @@ | ||
34 | 34 | .cpu sh3 |
35 | 35 | |
36 | 36 | NATURAL_SIZE: .equ 4 ; 4 byte word |
37 | +HALF_SIZE: .equ ( NATURAL_SIZE / 2 ) | |
37 | 38 | ALIGN_MASK: .equ ( H'FF & ~(NATURAL_SIZE - 1) ) |
38 | 39 | ALL_BITS8: .equ ( H'FF & -1 ) |
39 | 40 |
@@ -95,6 +96,71 @@ fW: .reg r4 ; currently executing Word definition pointer | ||
95 | 96 | ; we can save a lot of time during interrupt processing. |
96 | 97 | |
97 | 98 | |
99 | +; Structure of the per-USER variables table: | |
100 | + .section usertable, dummy | |
101 | + .org 0 | |
102 | +UORIG: .equ $ | |
103 | + .res.l 3 ; three reserved variables, not sure why | |
104 | +XSPZER: .equ $-UORIG | |
105 | + .res.l 1 ; initial top of data stack for this user | |
106 | +XRZERO: .equ $-UORIG | |
107 | + .res.l 1 ; initial top of return stack | |
108 | +XTIB: .equ $-UORIG | |
109 | + .res.l 1 ; start of terminal input buffer | |
110 | +XWIDTH: .equ $-UORIG | |
111 | + .res.l 1 ; name field width | |
112 | +XWARN: .equ $-UORIG | |
113 | + .res.l 1 ; warning message mode (0 = no disc) | |
114 | +XFENCE: .equ $-UORIG | |
115 | + .res.l 1 ; fence for FORGET | |
116 | +XDP: .equ $-UORIG | |
117 | + .res.l 1 ; dictionary pointer | |
118 | +XVOCL: .equ $-UORIG | |
119 | + .res.l 1 ; vocabulary linking | |
120 | +XBLK: .equ $-UORIG | |
121 | + .res.l 1 ; disc block being accessed | |
122 | +XIN: .equ $-UORIG | |
123 | + .res.l 1 ; scan pointer into the block | |
124 | +XOUT: .equ $-UORIG | |
125 | + .res.l 1 ; cursor position | |
126 | +XSCR: .equ $-UORIG | |
127 | + .res.l 1 ; disc screen being accessed ( O=terminal ) | |
128 | +XOFSET: .equ $-UORIG | |
129 | + .res.l 1 ; disc sector offset for multi-disc | |
130 | +XCONT: .equ $-UORIG | |
131 | + .res.l 1 ; last word in primary search vocabulary | |
132 | +XCURR: .equ $-UORIG | |
133 | + .res.l 1 ; last word in extensible vocabulary | |
134 | +XSTATE: .equ $-UORIG | |
135 | + .res.l 1 ; flag for 'interpret' or 'compile' modes | |
136 | +XBASE: .equ $-UORIG | |
137 | + .res.l 1 ; number base for I/O numeric conversion | |
138 | +XDPL: .equ $-UORIG | |
139 | + .res.l 1 ; decimal point place | |
140 | +XFLD: .equ $-UORIG | |
141 | + .res.l 1 ; | |
142 | +XCSP: .equ $-UORIG | |
143 | + .res.l 1 ; current stack position, for compile checks | |
144 | +XRNUM: .equ $-UORIG | |
145 | + .res.l 1 ; | |
146 | +XHLD: .equ $-UORIG | |
147 | + .res.l 1 ; | |
148 | +XDELAY: .equ $-UORIG | |
149 | + .res.l 1 ; carriage return delay count | |
150 | +XCOLUM: .equ $-UORIG | |
151 | + .res.l 1 ; carriage width | |
152 | +IOSTAT: .equ $-UORIG | |
153 | + .res.l 1 ; last acia status from write/read | |
154 | +; ( 4 spares! ) | |
155 | + .res.l 1 ; | |
156 | + .res.l 1 ; | |
157 | + .res.l 1 ; | |
158 | + .res.l 1 ; | |
159 | +; | |
160 | +UTABLESZ: .equ $-UORIG | |
161 | + | |
162 | + | |
163 | + | |
98 | 164 | ; Structure of the symbol table entry: |
99 | 165 | ; Length byte of the symbol name (NFA) |
100 | 166 | ; high bit set to flag the start byte |
@@ -0,0 +1,59 @@ | ||
1 | + .list ON, EXP | |
2 | + | |
3 | +; Actual driver definitions for fig-FORTH for SH-3 | |
4 | +; Joel Matthew Rees, Hyougo Polytec Center | |
5 | +; 2014.03.05 | |
6 | + | |
7 | +; This is where you put the drivers for your hardware. | |
8 | + | |
9 | +; Monolithic, not separate assembly: | |
10 | +; context.inc must be included before this file. | |
11 | +; .include "context.inc" | |
12 | +; | |
13 | +; .section driver, code | |
14 | + | |
15 | + | |
16 | +; Not sure whether to make headers for these. | |
17 | +; See screens 21 and around 63 in the fig model. | |
18 | + | |
19 | + | |
20 | +; (EMIT) ( c --- ) | |
21 | +; Low level details of outputting a character | |
22 | +; to the current output device. | |
23 | +; | |
24 | + HEADER (EMIT), PEMIT | |
25 | + mov.l @fSP+, r0 | |
26 | + rts | |
27 | + nop | |
28 | + | |
29 | + | |
30 | +; (KEY) ( --- c ) | |
31 | +; Low level details of getting a key | |
32 | +; from the current input device. | |
33 | +; | |
34 | + HEADER (KEY), PKEY | |
35 | + mov.l r0, @-fSP | |
36 | + rts | |
37 | + nop | |
38 | + | |
39 | + | |
40 | +; (?TERMINAL) ( --- f ) | |
41 | +; Low level details of checking the break key. | |
42 | +; | |
43 | + HEADER (?TERMINAL), PQTER | |
44 | + mov #6, r0 | |
45 | + mov.l r0, @-fSP | |
46 | + rts | |
47 | + nop | |
48 | + | |
49 | + | |
50 | +; (CR) ( --- ) | |
51 | +; Low level details of performing carriage return/line feed | |
52 | +; on the current output device. | |
53 | +; | |
54 | + HEADER (CR), PCR | |
55 | + mov.l @fSP+, r0 | |
56 | + rts | |
57 | + nop | |
58 | + | |
59 | + |
@@ -32,12 +32,40 @@ | ||
32 | 32 | ; I ( --- index ) ( limit index *** limit index ) |
33 | 33 | ; Copy the loop index from the return stack. Synonym for R, here. |
34 | 34 | ; |
35 | - HEADER I, xI | |
35 | + HEADER I, I | |
36 | 36 | mov.l @fRP, r0 ; I (loop counter) |
37 | 37 | rts |
38 | 38 | mov.l r0, @-fSP |
39 | - | |
40 | - | |
39 | + | |
40 | + | |
41 | +; U* ( u1 u2 --- ud ) | |
42 | +; Multiplies the top two unsigned integers, yielding a double | |
43 | +; integer product. | |
44 | +; SH3 MAC is a signed multiply/add, so we can't cheat on U*. | |
45 | +; If we cheat and use memory access to grab half words, | |
46 | +; we have to know whether we are LSB or MSB first. | |
47 | +; | |
48 | + HEADER U*, USTAR | |
49 | + .AIFDEF _LIT | |
50 | + mov.w @fSP, r0 | |
51 | + mov.w @(NATURAL_SIZE,fSP), r1 | |
52 | + .etc | |
53 | + .AELSE ; _BIG is default | |
54 | + mov.w @(HALF_SIZE,fSP), r0 | |
55 | + mov.w @(NATURAL_SIZE+HALF_SIZE,fSP), r1 | |
56 | + | |
57 | + .AENDI | |
58 | + | |
59 | +; + ( n1 n2 --- n1+n2 ) | |
60 | +; Add top two words. | |
61 | +; | |
62 | + HEADER +, PLUS | |
63 | + mov.l @fSP+, r0 | |
64 | + mov.l @fSP, r1 | |
65 | + add r1, r0 | |
66 | + rts | |
67 | + mov.l r0, @fSP | |
68 | + | |
41 | 69 | |
42 | 70 | |
43 | 71 |
@@ -0,0 +1,85 @@ | ||
1 | + .list ON, EXP | |
2 | + | |
3 | +; FORTH input/output definitions for fig-FORTH for SH-3 | |
4 | +; Joel Matthew Rees, Hyougo Polytec Center | |
5 | +; 2014.03.05 | |
6 | + | |
7 | +; Monolithic, not separate assembly: | |
8 | +; context.inc must be included before this file. | |
9 | +; .include "context.inc" | |
10 | +; | |
11 | +; .section inputoutput, code | |
12 | + | |
13 | + | |
14 | +; EMIT, KEY, QTERM, and CR are assumed to be the focus | |
15 | +; of porting to new hardware. | |
16 | + | |
17 | +; These are stubs which call real drivers defined in driver.inc | |
18 | +; In the fig-FORTH model, you see the stubs around screen 21. | |
19 | +; And you see the drivers around screen 63. | |
20 | + | |
21 | +; Contrary to usual practice, I am assuming the drivers | |
22 | +; use the stack instead of registers to pass results. | |
23 | +; No particular reason not use the registers, of course. | |
24 | + | |
25 | + | |
26 | +; EMIT ( c --- ) | |
27 | +; Write c to the terminal device, whatever that may be. | |
28 | +; Increment the OUT per USER variable. | |
29 | +; | |
30 | + HEADER EMIT, EMIT | |
31 | + mov.l #PEMIT, r1 ; May be within range of absolute call? | |
32 | + jsr @r1 | |
33 | + nop | |
34 | + mov.l #XOUT, r0 ; We defined XOUT as the offset itself. | |
35 | + mov.l @(r0,fUP), r1 | |
36 | + add #1, r1 | |
37 | + rts | |
38 | + mov.l r1, @(r0,fUP) | |
39 | + | |
40 | + | |
41 | +; KEY ( --- c ) | |
42 | +; Leave the ascii value of the next terminal key struck. | |
43 | +; | |
44 | + HEADER KEY, KEY | |
45 | + mov.l #PKEY, r1 ; May be within range of absolute call? | |
46 | + jsr @r1 | |
47 | + nop | |
48 | + mov.l @fSP, r1 | |
49 | + mov.l #H'000000ff, r0 | |
50 | + and r1, r0 | |
51 | + rts | |
52 | + mov.l r0, @fSP | |
53 | + | |
54 | + | |
55 | +; ?TERMINAL ( --- f ) | |
56 | +; Perform a test of the terminal keyboard for actuation of the break | |
57 | +; key. A true flag indicates actuation. | |
58 | +; In other words, scan keyboard, but do not wait. | |
59 | +; Return true if break key currently pressed, 0 otherwise. | |
60 | +; Ignores any keys buffered up, in theory. | |
61 | +; But this definition is installation dependent, | |
62 | +; and may not give exactly these results. | |
63 | +; | |
64 | + HEADER ?TERMINAL, QTERM | |
65 | + mov.l #PQTER, r1 ; May be within range of absolute call? | |
66 | + jsr @r1 | |
67 | + nop ; Might need to filter results? | |
68 | + rts | |
69 | + nop | |
70 | + | |
71 | + | |
72 | +; CR ( --- ) | |
73 | +; Transmit a carriage return and line feed to the selected output | |
74 | +; device. | |
75 | +; | |
76 | + HEADER CR, CR | |
77 | + mov.l #PCR, r1 ; May be within range of absolute call? | |
78 | + jsr @r1 | |
79 | + nop ; Might push a CR and EMIT, then a LF and EMIT? | |
80 | + rts | |
81 | + nop | |
82 | + | |
83 | + | |
84 | + | |
85 | + |
@@ -5,8 +5,29 @@ | ||
5 | 5 | ; 2014.02.28 |
6 | 6 | |
7 | 7 | .include "context.inc" |
8 | + | |
9 | + | |
10 | + .section main, code, locate=h'8c000000 | |
11 | + .org $ | |
12 | +COLD: | |
13 | + mov.l #PER_USER, fUP | |
14 | + mov.l #fSP_BASE, fSP | |
15 | + mov.l #fRP_BASE, fRP | |
16 | + mov.l #TEST_THINGY, fIP | |
17 | + mov.l #NEXT, r0 | |
18 | + jmp @r0 | |
19 | + nop | |
20 | + | |
21 | +TEST_THINGY: | |
22 | + .data.l LIT | |
23 | + .data.l 1 | |
24 | + .data.l LIT | |
25 | + .data.l -1 | |
26 | + .data.l PLUS | |
27 | + .data.l BRAN | |
28 | + .data.l $+NATURAL_SIZE-TEST_THINGY | |
8 | 29 | |
9 | - .section initialize, code, locate=h'8c000000 | |
30 | + | |
10 | 31 | ; For various reasons, including the above "locate" declaration, |
11 | 32 | ; this will be assembled monolithically, rather than separately. |
12 | 33 | ; Thus: |
@@ -16,10 +37,29 @@ | ||
16 | 37 | .include "parser.inc" |
17 | 38 | .include "evaluator.inc" |
18 | 39 | .include "symbol.inc" |
40 | + .include "inout.inc" | |
41 | + | |
42 | + .include "driver.inc" | |
19 | 43 | |
20 | 44 | |
45 | + .section user, data, locate=h'8c010000 | |
46 | +PER_USER: .equ $ | |
47 | + .res.b UTABLESZ | |
48 | + | |
49 | + .section pstack, stack, locate=PER_USER+h'E000 | |
50 | +fSP_LIMIT: .equ $ | |
51 | + .res.b h'1800 | |
52 | +fSP_BASE: .equ $ | |
21 | 53 | |
54 | + .section rstack, stack, locate=h'8c01F800 | |
55 | +fRP_LIMIT: .equ $ | |
56 | + .res.b h'800 | |
57 | +fRP_BASE: .equ $ | |
58 | + | |
59 | + .section thevoid, dummy, locate=h'8c020000 | |
60 | +OUTERSPACE: .equ $ | |
22 | 61 | |
62 | + | |
23 | 63 | |
24 | 64 | |
25 | 65 |
@@ -18,29 +18,29 @@ | ||
18 | 18 | ; translation is not valid in the specified base, only the false |
19 | 19 | ; flag is returned. |
20 | 20 | ; |
21 | - HEADER DIGIT, xDIGIT | |
21 | + HEADER DIGIT, DIGIT | |
22 | 22 | mov.l @(NATURAL_SIZE,fSP), r0 ; 7ビット文字 |
23 | 23 | mov.b #"0", r1 |
24 | 24 | cmp/ge r1, r0 ; character (r0) >= "0" |
25 | - bf xDIGITno | |
25 | + bf DIGITno | |
26 | 26 | add #-"0", r0 |
27 | 27 | mov.b #9, r1 |
28 | 28 | cmp/gt r1, r0 ; digit (r0) > 9 |
29 | - bf xDIGITbase | |
29 | + bf DIGITbase | |
30 | 30 | mov.b #"A"-"0", r1 |
31 | 31 | cmp/ge r1, r0 ; was it between "9" and "A"? |
32 | - bf xDIGITno | |
32 | + bf DIGITno | |
33 | 33 | add #"9"-"A"+1, r0 |
34 | -xDIGITbase: | |
34 | +DIGITbase: | |
35 | 35 | mov.l @fSP, r1 |
36 | 36 | cmp/ge r1, r0 ; digit (r0) >= base |
37 | - bt xDIGITno | |
37 | + bt DIGITno | |
38 | 38 | mov.l r0, @(NATURAL_SIZE,fSP) |
39 | 39 | mov.b #-1, r0 ; store the converted digit |
40 | 40 | rts |
41 | 41 | mov.l r0, @fSP ; set the flag on our way out |
42 | 42 | ; |
43 | -xDIGITno: | |
43 | +DIGITno: | |
44 | 44 | mov.b #0, r0 |
45 | 45 | add #NATURAL_SIZE, fSP |
46 | 46 | rts |
@@ -52,103 +52,51 @@ xDIGITno: | ||
52 | 52 | ; return the offsets to the first character of the symbol, |
53 | 53 | ; the last character of the symbol, |
54 | 54 | ; and the next character after the symbol. |
55 | +; Walks all over r0-r3 and fW. | |
55 | 56 | ; |
56 | - HEADER ENCLOSE, xENCLOSE | |
57 | + HEADER ENCLOSE, ENCLOS | |
57 | 58 | mov.l @fSP, r2 ; delimiter |
58 | - mov.b #0, r3 ; start the count at zero | |
59 | - mov.l @(NATURAL_SIZE,fSP), r1 | |
60 | -xENCLOSEloopwhite: | |
59 | + mov.l @(NATURAL_SIZE,fSP), r1 ; point to start in the buffer | |
60 | + mov #0, r3 ; count | |
61 | +ENCLOSleadloop: | |
61 | 62 | mov.b @r1+, r0 |
62 | 63 | cmp/eq #0, r0 ; NUL character before symbol? |
63 | - bt xENCLOSEnone | |
64 | + bt ENCLOSnone | |
64 | 65 | cmp/eq r2, r0 ; leading delimiter? (Usually SPACE.) |
65 | - bt xENCLOSEloopwhite | |
66 | - add #1, r3 ; Count it as we go. | |
66 | + bt ENCLOSword | |
67 | + bra ENCLOSleadloop | |
68 | + add #1, r1 ; Count it as we go. | |
67 | 69 | ; |
68 | - add #-1, r3 ; Counted too far. | |
70 | +ENCLOSword: | |
69 | 71 | mov.l r3, @fSP ; Save offset to symbol or NUL. |
70 | - add #-1, r1 ; Back up to what stopped us. | |
71 | -xENCLOSEloopword: | |
72 | + mov.l @r1+, r0 ; get the next one | |
73 | +ENCLOSwordloop: | |
72 | 74 | cmp/eq #0, r0 ; NUL? |
73 | - bt xENCLOSEnul | |
74 | - **** | |
75 | - add #1, r3 | |
76 | - bra xENCLOSEloopword | |
77 | - mov.l @r1+, r0 | |
75 | + bt/s ENCLOSnulterm | |
76 | + add #1, r3 ; count the one before | |
77 | + cmp/eq r2, r0 ; delimiter | |
78 | + bf/s ENCLOSwordloop | |
79 | + mov.l @r1+, r0 ; Get the next one, but not beyond NUL. | |
78 | 80 | ; |
79 | - | |
81 | +; The pointer and character don't matter, just the count. | |
82 | + mov.l r3, @-fSP ; Count to non-NUL delimiter. | |
83 | + add #1, r3 ; Next character that might be part of a symbol. | |
84 | + rts | |
85 | + mov.l r3, @-fSP ; Save it as we go. | |
86 | + | |
80 | 87 | ; found NUL before non-delimiter, therefore there is no word |
81 | -xENCLOSEnone: | |
82 | - mov.l r3, @fSP | |
88 | +ENCLOSnone: | |
89 | + mov.l r3, @fSP ; Save offset to NUL. | |
83 | 90 | add #1, r3 |
84 | - mov.l r3, @-fSP | |
91 | + mov.l r3, @-fSP ; Make the symbol at least one char long. | |
85 | 92 | add #-1, r3 |
86 | 93 | rts |
87 | - mov.l r3, @-fSP | |
94 | + mov.l r3, @-fSP ; But keep us stopped at the NUL. | |
88 | 95 | ; delimited by NUL |
89 | -xENCLOSEnul: | |
90 | - mov.l r3, @-fSP | |
96 | +ENCLOSnulterm: | |
97 | + mov.l r3, @-fSP ; Delimiter is NUL. | |
91 | 98 | rts |
92 | - mov.l r3, @-fSP | |
93 | - | |
99 | + mov.l r3, @-fSP ; No next character included, keep us at the NUL. | |
94 | 100 | |
95 | 101 | |
96 | -;* ######>> screen 20 << | |
97 | -;* ======>> 12 << | |
98 | -; FCB $87 | |
99 | -; FCC 6,ENCLOSE | |
100 | -; FCB $C5 | |
101 | -; FDB PFIND-9 | |
102 | -;* NOTE : | |
103 | -;* FC means offset (bytes) to First Character of next word | |
104 | -;* EW " " to End of Word | |
105 | -;* NC " " to Next Character to start next enclose at | |
106 | -;ENCLOS FDB *+2 | |
107 | -; INS | |
108 | -; PUL B now, get the low byte, for an 8-bit delimiter | |
109 | -; TSX | |
110 | -; LDX 0,X | |
111 | -; CLR N | |
112 | -;* wait for a non-delimiter or a NUL | |
113 | -;ENCL2 LDA A 0,X | |
114 | -; BEQ ENCL6 | |
115 | -; CBA CHECK FOR DELIM | |
116 | -; BNE ENCL3 | |
117 | -; INX | |
118 | -; INC N | |
119 | -; BRA ENCL2 | |
120 | -;* found first character. Push FC | |
121 | -;ENCL3 LDA A N found first char. | |
122 | -; PSH A | |
123 | -; CLR A | |
124 | -; PSH A | |
125 | -;* wait for a delimiter or a NUL | |
126 | -;ENCL4 LDA A 0,X | |
127 | -; BEQ ENCL7 | |
128 | -; CBA ckech for delim. | |
129 | -; BEQ ENCL5 | |
130 | -; INX | |
131 | -; INC N | |
132 | -; BRA ENCL4 | |
133 | -;* found EW. Push it | |
134 | -;ENCL5 LDA B N | |
135 | -; CLR A | |
136 | -; PSH B | |
137 | -; PSH A | |
138 | -;* advance and push NC | |
139 | -; INC B | |
140 | -; JMP PUSHBA | |
141 | -; | |
142 | -;ENCL6 LDA B N found NUL | |
143 | -; PSH B | |
144 | -; PSH A | |
145 | -; INC B | |
146 | -; BRA ENCL7+2 | |
147 | -;* found NUL following the word instead of SPACE | |
148 | -;ENCL7 LDA B N | |
149 | -; PSH B save EW | |
150 | -; PSH A | |
151 | -;ENCL8 LDA B N save NC | |
152 | -; JMP PUSHBA | |
153 | -; | |
154 | 102 |
@@ -17,14 +17,15 @@ | ||
17 | 17 | ; |
18 | 18 | ; Anyway, this is the inner interpreter. |
19 | 19 | ; |
20 | -next: | |
20 | +NEXT: | |
21 | 21 | mov.l @fIP+, fW ; get the pointer to the next definition to execute |
22 | +NEXTloop: | |
22 | 23 | mov.l @fW, r0 ; get the defitinition characteristic |
23 | 24 | jsr @r0 |
24 | 25 | ; 3 cycles to get back to the top of the loop. |
25 | 26 | nop |
26 | - bra next | |
27 | - nop | |
27 | + bra NEXTloop | |
28 | + mov.l @fIP+, fW ; grab the next pointer as we go. | |
28 | 29 | ; Note that, since jumps to absolute addresses have limits in constant-width instruction sets, |
29 | 30 | ; using the subroutine call mode for the virtual machine is not as much a penalty as it might seem. |
30 | 31 | ; It also has the advantage of being more compatible with more conventional code. |
@@ -39,9 +40,8 @@ next: | ||
39 | 40 | ; |
40 | 41 | HEADER LIT, LIT |
41 | 42 | mov.l @fIP+, r0 |
42 | - mov.l r0, @-fSP | |
43 | 43 | rts |
44 | - nop | |
44 | + mov.l r0, @-fSP | |
45 | 45 | |
46 | 46 | |
47 | 47 | ; "character" (byte or word) literal doesn't work on SH3 |
@@ -52,7 +52,7 @@ next: | ||
52 | 52 | ; Jump to address on stack. Used by the "outer" interpreter to |
53 | 53 | ; interactively invoke routines. (Not compile-only in fig.) |
54 | 54 | ; |
55 | - HEADER EXECUTE, EXECUTE | |
55 | + HEADER EXECUTE, EXEC | |
56 | 56 | mov.l @fSP+, fW |
57 | 57 | mov.l @fW, r0 |
58 | 58 | jmp @r0 ; borrow the return there |
@@ -63,25 +63,23 @@ next: | ||
63 | 63 | ; Add the following word from the instruction stream to the |
64 | 64 | ; instruction pointer (postincrement). Causes a program branch. |
65 | 65 | ; |
66 | - HEADER BRANCH, BRANCH | |
66 | + HEADER BRANCH, BRAN | |
67 | 67 | mov.l @fIP+, r0 |
68 | 68 | BRANCHgo: |
69 | - add r0, fIP | |
70 | 69 | rts |
71 | - nop | |
70 | + add r0, fIP | |
72 | 71 | |
73 | 72 | |
74 | 73 | ; 0BRANCH ( f --- ) C |
75 | 74 | ; BRANCH if flag is zero. |
76 | 75 | ; |
77 | - HEADER 0BRANCH, ZBRANCH | |
76 | + HEADER 0BRANCH, ZBRAN | |
78 | 77 | mov.l @fSP+, r0 |
79 | 78 | cmp/eq #0, r0 |
80 | 79 | bt/s BRANCHgo |
81 | 80 | mov.l @fIP+, r0 |
82 | 81 | rts |
83 | 82 | nop |
84 | - | |
85 | 83 | |
86 | 84 | ; fig-FORTH puts temporaries on the control stack. I prefer a third stack. |
87 | 85 | ; But if we put I in registers, (DO) is affected. |
@@ -101,7 +99,7 @@ BRANCHgo: | ||
101 | 99 | ; does not occur, and the index and limit are dropped from the |
102 | 100 | ; return stack. |
103 | 101 | ; |
104 | - HEADER (LOOP), xLOOP | |
102 | + HEADER (LOOP), XLOOP | |
105 | 103 | mov.l @fRP, r0 ; I (loop counter) |
106 | 104 | add #1, r0 |
107 | 105 | mov.l r0, @fRP ; update I |
@@ -121,24 +119,24 @@ BRANCHgo: | ||
121 | 119 | ; limit. A negative n must cause the index to become less than |
122 | 120 | ; the limit to cause loop termination. |
123 | 121 | ; |
124 | - HEADER (+LOOP), xPLOOP | |
122 | + HEADER (+LOOP), XPLOOP | |
125 | 123 | mov.l @fSP+, r1 ; increment |
126 | 124 | mov.l @fRP, r0 ; I (loop counter) |
127 | 125 | add r1, r0 |
128 | 126 | mov.l r0, @fRP ; update I |
129 | 127 | shal r1 ; increment negative or positive? |
130 | - bt/s xPLOOPminus | |
128 | + bt/s XPLOOPminus | |
131 | 129 | mov.l @(NATURAL_SIZE,fRP), r1 ; limit |
132 | 130 | ; |
133 | 131 | ; Stealing too much code would cost more than it would save. |
134 | -xPLOOPplus: | |
132 | +XPLOOPplus: | |
135 | 133 | cmp/ge r0, r1 ; limit (r1) >= counter (I=r0) ? |
136 | 134 | bf/s BRANCHgo ; not yet |
137 | 135 | mov.l @fIP+, r0 ; grab offset and bump fIP before we go |
138 | 136 | rts |
139 | 137 | add.l #2*NATURAL_SIZE, fRP ; drop I and limit before we return |
140 | 138 | ; |
141 | -xPLOOPminus: | |
139 | +XPLOOPminus: | |
142 | 140 | cmp/ge r0, r1 ; limit (r1) >= counter (I=r0) ? |
143 | 141 | bt/s BRANCHgo ; not yet |
144 | 142 | mov.l @fIP+, r0 ; grab offset and bump fIP before we go |
@@ -153,7 +151,7 @@ xPLOOPminus: | ||
153 | 151 | ; (DO) ( limit index --- ) ( *** limit index ) |
154 | 152 | ; Move the loop parameters to the return stack. Synonym for D>R, here. |
155 | 153 | ; |
156 | - HEADER (DO), xPDO | |
154 | + HEADER (DO), XDO | |
157 | 155 | mov.l @fSP+, r0 |
158 | 156 | mov.l @fSP+, r1 |
159 | 157 | add #-2*NATURAL_SIZE, fRP |
@@ -162,7 +160,32 @@ xPLOOPminus: | ||
162 | 160 | mov.l r0, @fRP |
163 | 161 | |
164 | 162 | |
163 | +; CMOVE ( source target count --- ) | |
164 | +; Copy/move count bytes from source to target. Moves ascending | |
165 | +; addresses, so that overlapping only works if the source is | |
166 | +; above the destination. | |
167 | +; Further specification is necessary on word addressing computers. | |
168 | +; Note -- In many cases, the source and target will not be an even | |
169 | +; number of words apart, so we can't optimize to long moves. | |
170 | +; Walks on r0-r3. | |
171 | +; | |
172 | + HEADER CMOVE, CMOVE | |
173 | + mov.l @fSP, r0 ; count | |
174 | + mov.l @(NATURAL_SIZE,fSP), r2 ; target | |
175 | + bra CMOVEenter | |
176 | + mov.l @(2*NATURAL_SIZE,fSP), r1 ; source (as we jump) | |
177 | +CMOVEloop: | |
178 | + mov.b @r1+, r3 | |
179 | + mov.b r3, @r2+ | |
180 | + add #-1, r0 | |
181 | +CMOVEenter: | |
182 | + cmp/eq #0, r0 | |
183 | + bf CMOVEloop | |
184 | +; | |
185 | + rts | |
186 | + add #3*NATURAL_SIZE, fSP ; Drop the parameters as we go. | |
165 | 187 | |
188 | + | |
166 | 189 | |
167 | 190 | |
168 | 191 |
@@ -17,14 +17,13 @@ | ||
17 | 17 | ; leave ptr2 pointing to the next byte. |
18 | 18 | ; Walks all over r0 and r1. Must leave fW untouched. |
19 | 19 | ; |
20 | - HEADER (NAME-SCAN), xNAMESCAN | |
20 | + HEADER (NAME-SCAN), PNAMESCAN | |
21 | 21 | mov.l @fSP, r1 |
22 | 22 | mov.b @r1+, r0 |
23 | -xNAMESCANloop: | |
23 | +PNAMESCANloop: | |
24 | 24 | and #CTFLAG, r0 |
25 | 25 | cmp/eq #CTFLAG, r0 |
26 | -xNAMESCANstart: | |
27 | - bf/s xNAMESCANloop | |
26 | + bf/s PNAMESCANloop | |
28 | 27 | mov.b @r1+, r0 |
29 | 28 | ; |
30 | 29 | add #-1, r1 |
@@ -43,7 +42,7 @@ xNAMESCANstart: | ||
43 | 42 | ; (Names only save 3 significant characters in some FORTHs.) |
44 | 43 | ; Walks all over r0 - r3. Must leave fW untouched. |
45 | 44 | ; |
46 | - HEADER (CHK-NAME), xCHKNAME | |
45 | + HEADER (CHK-NAME), PCHKNAME | |
47 | 46 | sts.l pr, @-fRP ; so we can call stuff |
48 | 47 | mov.l @fSP, r2 ; name in dictionary |
49 | 48 | mov.l @(NATURAL_SIZE, fSP), r3 ; name in buffer |
@@ -51,31 +50,31 @@ xNAMESCANstart: | ||
51 | 50 | and #CTMASK, r0 ; Extract the actual count. |
52 | 51 | mov.b @r3+, r1 ; count byte in buffer |
53 | 52 | cmp/eq r0, r1 |
54 | - bf xCHKNAMEno | |
55 | -xCHKNAMEloop: | |
53 | + bf PCHKNAMEno | |
54 | +PCHKNAMEloop: | |
56 | 55 | mov.b @r2+, r0 ; character in dictionary |
57 | 56 | tst #TAILFLAG, r0 |
58 | - bt xCHKNAMElast | |
57 | + bt PCHKNAMElast | |
59 | 58 | mov.b @r3+, r1 ; character in buffer |
60 | 59 | cmp/eq r0, r1 |
61 | - bt xCHKNAMEloop | |
60 | + bt PCHKNAMEloop | |
62 | 61 | ; |
63 | -xCHKNAMEno: | |
62 | +PCHKNAMEno: | |
64 | 63 | mov #0, r3 ; r3 is not touched by xNAMESCAN |
65 | -xCHKNAMEret: | |
66 | - bsr xNAMESCAN | |
64 | +PCHKNAMEret: | |
65 | + bsr PNAMESCAN | |
67 | 66 | mov.l r2, @fSP ; save it as we go |
68 | 67 | lds.l @fRP+, pr ; Gotta have that return address! |
69 | 68 | rts |
70 | 69 | mov.l r3, @-fSP ; flag it as we go |
71 | 70 | ; |
72 | -xCHKNAMElast: | |
71 | +PCHKNAMElast: | |
73 | 72 | mov.b @r3+, r1 ; last character in buffer |
74 | 73 | and #TAILMASK, r0 |
75 | 74 | cmp/eq r0, r1 |
76 | - bf xCHKNAMEno | |
75 | + bf PCHKNAMEno | |
77 | 76 | ; |
78 | - bra xCHKNAMEret | |
77 | + bra PCHKNAMEret | |
79 | 78 | mov #ALL_BITS8, r3 ; Set the flag as we go. |
80 | 79 | |
81 | 80 |
@@ -86,34 +85,34 @@ xCHKNAMElast: | ||
86 | 85 | ; nfa is the NFA of the last entry in the vocabulary to be searched. |
87 | 86 | ; Walks all over r0 - r3, and fW. |
88 | 87 | ; |
89 | - HEADER (FIND), xPFIND | |
88 | + HEADER (FIND), PFIND | |
90 | 89 | sts.l pr, @-fRP ; so we can call stuff |
91 | 90 | mov.l @fSP, r0 |
92 | -xPFINDloop: | |
91 | +PFINDloop: | |
93 | 92 | mov.b @r0, fW ; We aren't using fW anyway, and it doesn't get walked in. |
94 | - bsr xCHKNAME | |
93 | + bsr PCHKNAME | |
95 | 94 | mov.l @fSP+, r0 ; Did we find it? |
96 | 95 | cmp/eq #0, r0 |
97 | - bf/s xPFINDfound ; Use the true flag in r0 | |
96 | + bf/s PFINDfound ; Use the true flag in r0 | |
98 | 97 | mov.l @fSP, r1 ; LFA needed either way |
99 | 98 | ; |
100 | 99 | mov.l @r1, r0 |
101 | 100 | cmp/eq #0, r0 |
102 | - bt xPFINDnot | |
103 | - bra xPFINDloop | |
101 | + bt PFINDnot | |
102 | + bra PFINDloop | |
104 | 103 | mov.l r0, @fSP ; Store the next one to check as we go. |
105 | 104 | ; |
106 | -xPFINDnot: | |
105 | +PFINDnot: | |
107 | 106 | ; mov #0, r0 ; use the NULL pointer as a false flag |
108 | - bra xPFINDret | |
107 | + bra PFINDret | |
109 | 108 | add #2*NATURAL_SIZE, fSP ; bump as we go |
110 | 109 | ; |
111 | -xPFINDfound: | |
110 | +PFINDfound: | |
112 | 111 | add #2*NATURAL_SIZE, r1 ; pfa |
113 | 112 | mov.l r1, @(NATURAL_SIZE,fSP) |
114 | 113 | mov.l fW, @fSP ; Store the saved count byte, with mode bits. |
115 | 114 | ; mov #ALL_BITS8, r0 ; We can reuse the flag that sent us here. |
116 | -xPFINDret: | |
115 | +PFINDret: | |
117 | 116 | lds.l @fRP+, pr ; Gotta have that return address! |
118 | 117 | rts |
119 | 118 | mov.l r0, @-fSP ; Flag it as we go. |