![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to locals.fs CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [Qemu by Fabrice Bellard] / qemu / roms / SLOF / slof / fs / fcode|
Return to locals.fs CVS log | Up to [Qemu by Fabrice Bellard] / qemu / roms / SLOF / slof / fs / fcode |
1.1 root 1: \ *****************************************************************************
2: \ * Copyright (c) 2011 IBM Corporation
3: \ * All rights reserved.
4: \ * This program and the accompanying materials
5: \ * are made available under the terms of the BSD License
6: \ * which accompanies this distribution, and is available at
7: \ * http://www.opensource.org/licenses/bsd-license.php
8: \ *
9: \ * Contributors:
10: \ * IBM Corporation - initial implementation
11: \ ****************************************************************************/
12: \ *
13: \ * Support for old-fashioned local values in FCODE.
14: \ *
15: \ * There is one old FCODE tokenizer that uses the FCODE opcodes in the range
16: \ * of 0x407 to 0x41f for supporting Forth local values. Each locals stack
17: \ * frame contains 8 variables. The opcodes from 0x407 to 0x40f are used to
18: \ * push 0 up to 8 values from the normal data stack into the current locals
19: \ * stack frame. All other variables in the current stack frame are not
20: \ * pre-initialized.
21: \ * The opcodes from 0x410 to 0x417 can be used for reading the first, second,
22: \ * ... eighth value out of the locals stack frame, and the opcode from 0x418
23: \ * to 0x41f can be used to set the first, second, ... eighth value in the
24: \ * stack frame respectively.
25: \ *
26:
27: 80 cells CONSTANT LOCALS-STACK-SIZE
28:
29: LOCALS-STACK-SIZE BUFFER: localsstackbuf
30:
31: localsstackbuf VALUE localsstack
32:
33:
34: : fc-local@ ( n -- val )
35: cells localsstack swap - @
36: ;
37:
38: : fc-local-1-@ 1 fc-local@ ;
39: : fc-local-2-@ 2 fc-local@ ;
40: : fc-local-3-@ 3 fc-local@ ;
41: : fc-local-4-@ 4 fc-local@ ;
42: : fc-local-5-@ 5 fc-local@ ;
43: : fc-local-6-@ 6 fc-local@ ;
44: : fc-local-7-@ 7 fc-local@ ;
45: : fc-local-8-@ 8 fc-local@ ;
46:
47:
48: : fc-local! ( val n -- )
49: cells localsstack swap - !
50: ;
51:
52: : fc-local-1-! 1 fc-local! ;
53: : fc-local-2-! 2 fc-local! ;
54: : fc-local-3-! 3 fc-local! ;
55: : fc-local-4-! 4 fc-local! ;
56: : fc-local-5-! 5 fc-local! ;
57: : fc-local-6-! 6 fc-local! ;
58: : fc-local-7-! 7 fc-local! ;
59: : fc-local-8-! 8 fc-local! ;
60:
61:
62: 0 VALUE uses-locals?
63:
64: \ Create space for the current function on the locals stack.
65: \ Pre-initialized the n first locals with the n top-most data stack items.
66: \ Note: Each function can use up to 8 (initialized or uninitialized) locals.
67: : (fc-push-locals) ( ... n -- )
68: \ cr ." pushing " dup . ." locals" cr
69: 8 cells localsstack + TO localsstack
70: localsstack localsstackbuf -
71: LOCALS-STACK-SIZE > ABORT" Locals stack exceeded!"
72: ?dup IF
73: ( ... n ) 1 swap DO
74: i fc-local! \ Store pre-initialized locals
75: -1 +LOOP
76: THEN
77: ;
78:
79: : fc-push-locals ( n -- )
80: \ cr ." compiling push for " dup . ." locals" cr
81: uses-locals? ABORT" Definition pushes locals multiple times!"
82: true TO uses-locals?
83: ( n ) ['] literal execute
84: ['] (fc-push-locals) compile,
85: ;
86:
87: : fc-push-0-locals 0 fc-push-locals ;
88: : fc-push-1-locals 1 fc-push-locals ;
89: : fc-push-2-locals 2 fc-push-locals ;
90: : fc-push-3-locals 3 fc-push-locals ;
91: : fc-push-4-locals 4 fc-push-locals ;
92: : fc-push-5-locals 5 fc-push-locals ;
93: : fc-push-6-locals 6 fc-push-locals ;
94: : fc-push-7-locals 7 fc-push-locals ;
95: : fc-push-8-locals 8 fc-push-locals ;
96:
97:
98: : fc-pop-locals ( -- )
99: \ ." popping locals" cr
100: localsstack 8 cells - TO localsstack
101: localsstack localsstackbuf - 0 < ABORT" Locals stack undeflow!"
102: ;
103:
104:
105: : fc-locals-exit
106: uses-locals? IF
107: \ ." compiling pop-locals for exit" cr
108: ['] fc-pop-locals compile,
109: THEN
110: ['] exit compile,
111: ;
112:
113: : fc-locals-b(;)
114: uses-locals? IF
115: \ ." compiling pop-locals for b(;)" cr
116: ['] fc-pop-locals compile,
117: THEN
118: false TO uses-locals?
119: ['] b(;) execute
120: ;
121:
122:
123: : fc-set-locals-tokens ( -- )
124: ['] fc-push-0-locals 1 407 set-token
125: ['] fc-push-1-locals 1 408 set-token
126: ['] fc-push-2-locals 1 409 set-token
127: ['] fc-push-3-locals 1 40a set-token
128: ['] fc-push-4-locals 1 40b set-token
129: ['] fc-push-5-locals 1 40c set-token
130: ['] fc-push-6-locals 1 40d set-token
131: ['] fc-push-7-locals 1 40e set-token
132: ['] fc-push-8-locals 1 40f set-token
133:
134: ['] fc-local-1-@ 0 410 set-token
135: ['] fc-local-2-@ 0 411 set-token
136: ['] fc-local-3-@ 0 412 set-token
137: ['] fc-local-4-@ 0 413 set-token
138: ['] fc-local-5-@ 0 414 set-token
139: ['] fc-local-6-@ 0 415 set-token
140: ['] fc-local-7-@ 0 416 set-token
141: ['] fc-local-8-@ 0 417 set-token
142:
143: ['] fc-local-1-! 0 418 set-token
144: ['] fc-local-2-! 0 419 set-token
145: ['] fc-local-3-! 0 41a set-token
146: ['] fc-local-4-! 0 41b set-token
147: ['] fc-local-5-! 0 41c set-token
148: ['] fc-local-6-! 0 41d set-token
149: ['] fc-local-7-! 0 41e set-token
150: ['] fc-local-8-! 0 41f set-token
151:
152: ['] fc-locals-exit 1 33 set-token
153: ['] fc-locals-b(;) 1 c2 set-token
154: ;
155: fc-set-locals-tokens
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.