Subversion Repositories Kolibri OS

Rev

Details | Last modification | View Log | RSS feed

Rev Author Line No. Line
4867 leency 1 
( 28.Mar.2000 Andrey Cherezov  Copyright [C] RU FIG
2 
 
3 
  Использованы идеи следующих авторов:
4 
  Ruvim Pinka; Dmitry Yakimov; Oleg Shalyopa; Yuriy Zhilovets;
5 
  Konstantin Tarasov; Michail Maximov.
6 
 
7 
  !! Работает только в SPF4.
8 
)
9 
 
10 
( Простое расширение СП-Форта локальными переменными.
11 
  Реализовано без использования LOCALS стандарта 94.
12 
 
13 
  Объявление временных переменных, видимых только внутри
14 
  текущего слова и ограниченных временем вызова данного
15 
  слова выполняется с помощью слова "{". Внутри определения
16 
  слова используется конструкция, подобная стековой нотации Форта
17 
  { список_инициализированных_локалов \ сп.неиниц.локалов -- что угодно }
18 
  Например:
19 
 
20 
  { a b c d \ e f -- i j }
21 
 
22 
  Или { a b c d \ e f[ EVALUATE_выражение ] -- i j }
23 
  Это значит что для переменной f[ будет выделен на стеке возвратов участок
24 
  памяти длиной n байт. Использование переменной f[ даст адрес начала этого
25 
  участка. \В стиле MPE\
26 
 
27 
  Или { a b c d \ e [ 12 ] f -- i j }
28 
  Это значит что для переменной f будет выделен на стеке возвратов участок
29 
  памяти длиной 12 байт. Использование переменной f даст адрес начала этого
30 
  участка.
31 
 
32 
  Часть "\ сп.неиниц.локалов" может отсутствовать, например:
33 
 
34 
  { item1 item2 -- }
35 
 
36 
  Это заставляет СП-Форт автоматически выделять место в
37 
  стеке возвратов для этих переменных в момент вызова слова
38 
  и автоматически освобождать место при выходе из него.
39 
 
40 
  Обращение к таким локальным переменным - как к VALUE-переменным
41 
  по имени. Если нужен адрес переменной, то используется "^ имя"
42 
  или "AT имя".
43 
 
44 
 
45 
  Вместо \ можно использовать |
46 
  Вместо -> можно использовать TO
47 
 
48 
  Примеры:
49 
 
50 
  : TEST { a b c d \ e f -- } a . b . c .  b c + -> e  e .  f .  ^ a @ . ;
51 
   Ok
52 
  1 2 3 4 TEST
53 
  1 2 3 5 0 1  Ok
54 
 
55 
  : TEST { a b -- } a . b . CR 5 0 DO I . a . b . CR LOOP ;
56 
   Ok
57 
  12 34 TEST
58 
  12 34
59 
 
60 
  1 12 34
61 
  2 12 34
62 
  3 12 34
63 
  4 12 34
64 
   Ok
65 
 
66 
  : TEST { a b } a . b . ;
67 
   Ok
68 
  1 2 TEST
69 
  1 2  Ok
70 
 
71 
  : TEST { a b \ c } a . b . c . ;
72 
   Ok
73 
  1 2 TEST
74 
  1 2 0  Ok
75 
 
76 
  : TEST { a b -- } a . b . ;
77 
   Ok
78 
  1 2 TEST
79 
  1 2  Ok
80 
 
81 
  : TEST { a b \ c -- d } a . b . c . ;
82 
   Ok
83 
  1 2 TEST
84 
  1 2 0  Ok
85 
 
86 
  : TEST { \ a b } a . b .  1 -> a  2 -> b  a . b . ;
87 
   Ok
88 
  TEST
89 
 
90 
 
91 
  Имена локальных переменных существуют в динамическом
92 
  временном словаре только в момент компиляции слова, а
93 
  после этого вычищаются и более недоступны.
94 
 
95 
  Использовать конструкцию "{ ... }" внутри одного определения можно
96 
  только один раз.
97 
 
98 
  Компиляция этой библиотеки добавляет в текущий словарь компиляции
99 
  Только два слова:
100 
  словарь "vocLocalsSupport" и "{"
101 
  Все остальные детали "спрятаны" в словаре, использовать их
102 
  не рекомендуется.
103 
)
104 
 
105 
MODULE: vocLocalsSupport
106 
 
107 
USER widLocals
108 
USER uLocalsCnt
109 
USER uLocalsUCnt
110 
USER uPrevCurrent
111 
USER uAddDepth
112 
 
113 
: (Local^) ( N -- ADDR )
114 
  RP@ +
115 
;
116 
: LocalOffs ( n -- offs )
117 
  uLocalsCnt @ SWAP - CELLS CELL+ uAddDepth @ +
118 
;
119 
 
120 
BASE @ HEX
121 
: CompileLocalsInit
122 
  uPrevCurrent @ SET-CURRENT
123 
  uLocalsCnt  @ uLocalsUCnt @ - ?DUP IF CELLS LIT, POSTPONE DRMOVE THEN
124 
  uLocalsUCnt @ ?DUP
125 
  IF
126 
     LIT, POSTPONE (RALLOT)
127 
  THEN
128 
  uLocalsCnt  @ ?DUP
129 
  IF CELLS RLIT, ['] (LocalsExit) RLIT, THEN
130 
;
131 
 
132 
: CompileLocal@ ( n -- )
133 
  ['] DUP MACRO,
134 
  LocalOffs DUP  SHORT?
135 
  OPT_INIT SetOP
136 
  IF    8B B, 44 B, 24 B, B, \ mov eax, offset [esp]
137 
  ELSE  8B B, 84 B, 24 B,  , \ mov eax, offset [esp]
138 
  THEN  OPT
139 
  OPT_CLOSE
140 
;
141 
 
142 
\ : CompileLocal@ ( n -- )
143 
\   LocalOffs LIT, POSTPONE RP+@
144 
\ ;
145 
 
146 
: CompileLocal! ( n -- )
147 
  LocalOffs DUP  SHORT?
148 
  OPT_INIT SetOP
149 
  IF    89 B, 44 B, 24 B, B, \ mov  offset [esp], eax
150 
  ELSE  89 B, 84 B, 24 B,  , \ mov  offset [esp], eax
151 
  THEN  OPT
152 
  OPT_CLOSE
153 
  ['] DROP MACRO,
154 
;
155 
 
156 
: CompileLocalRec ( u -- )
157 
  LocalOffs DUP
158 
  ['] DUP MACRO,
159 
  SHORT?
160 
  OPT_INIT SetOP
161 
  IF    8D B, 44 B, 24 B, B, \ lea eax, offset [esp]
162 
  ELSE  8D B, 84 B, 24 B,  , \ lea eax, offset [esp]
163 
  THEN  OPT
164 
  OPT_CLOSE
165 
;
166 
 
167 
BASE !
168 
 
169 
: LocalsStartup
170 
  TEMP-WORDLIST widLocals !
171 
  GET-CURRENT uPrevCurrent !
172 
  ALSO vocLocalsSupport
173 
  ALSO widLocals @ CONTEXT ! DEFINITIONS
174 
  uLocalsCnt 0!
175 
  uLocalsUCnt 0!
176 
  uAddDepth 0!
177 
;
178 
: LocalsCleanup
179 
  PREVIOUS PREVIOUS
180 
  widLocals @ FREE-WORDLIST
181 
;
182 
 
183 
: ProcessLocRec ( "name" -- u )
184 
  [CHAR] ] PARSE
185 
  STATE 0!
186 
  EVALUATE CELL 1- + CELL / \ делаем кратным 4
187 
  -1 STATE !
188 
  DUP uLocalsCnt +!
189 
  uLocalsCnt @ 1-
190 
;
191 
 
192 
: CreateLocArray
193 
  ProcessLocRec
194 
  CREATE ,
195 
;
196 
 
197 
: LocalsRecDoes@ ( -- u )
198 
  DOES> @ CompileLocalRec
199 
;
200 
 
201 
: LocalsRecDoes@2 ( -- u )
202 
  ProcessLocRec ,
203 
  DOES> @ CompileLocalRec
204 
;
205 
 
206 
: LocalsDoes@
207 
  uLocalsCnt @ ,
208 
  uLocalsCnt 1+!
209 
  DOES> @ CompileLocal@
210 
;
211 
 
212 
: ;; POSTPONE ; ; IMMEDIATE
213 
 
214 
 
215 
: ^
216 
  ' >BODY @
217 
  CompileLocalRec
218 
; IMMEDIATE
219 
 
220 
 
221 
: -> ' >BODY @ CompileLocal!  ; IMMEDIATE
222 
 
223 
WARNING DUP @ SWAP 0!
224 
 
225 
: AT
226 
  [COMPILE] ^
227 
; IMMEDIATE
228 
 
229 
: TO ( "name" -- )
230 
  >IN @ NextWord widLocals @ SEARCH-WORDLIST 1 =
231 
  IF >BODY @ CompileLocal! DROP
232 
  ELSE >IN ! [COMPILE] TO
233 
  THEN
234 
; IMMEDIATE
235 
 
236 
WARNING !
237 
 
238 
: в POSTPONE -> ; IMMEDIATE
239 
 
240 
WARNING @ WARNING 0!
241 
\ ===
242 
\ переопределение соответствующих слов для возможности использовать
243 
\ временные переменные внутри  цикла DO LOOP  и независимо от изменения
244 
\ содержимого стека возвратов  словами   >R   R>
245 
 
246 
: DO    POSTPONE DO     [  3 CELLS ] LITERAL  uAddDepth +! ; IMMEDIATE
247 
: ?DO   POSTPONE ?DO    [  3 CELLS ] LITERAL  uAddDepth +! ; IMMEDIATE
248 
: LOOP  POSTPONE LOOP   [ -3 CELLS ] LITERAL  uAddDepth +! ; IMMEDIATE
249 
: +LOOP POSTPONE +LOOP  [ -3 CELLS ] LITERAL  uAddDepth +! ; IMMEDIATE
250 
: >R    POSTPONE >R     [  1 CELLS ] LITERAL  uAddDepth +! ; IMMEDIATE
251 
: R>    POSTPONE R>     [ -1 CELLS ] LITERAL  uAddDepth +! ; IMMEDIATE
252 
: RDROP POSTPONE RDROP  [ -1 CELLS ] LITERAL  uAddDepth +! ; IMMEDIATE
253 
: 2>R   POSTPONE 2>R    [  2 CELLS ] LITERAL  uAddDepth +! ; IMMEDIATE
254 
: 2R>   POSTPONE 2R>    [ -2 CELLS ] LITERAL  uAddDepth +! ; IMMEDIATE
255 
 
256 
\ ===
257 
 
258 
\ { ... | ... -- _____ }
259 
: ParseLocals3
260 
  BEGIN
261 
   PARSE-NAME
262 
   DUP 0= ABORT" Locals bad syntax (3)"
263 
   2DUP S" }" COMPARE 0= IF 2DROP EXIT THEN
264 
   2DROP
265 
  AGAIN
266 
;
267 
 
268 
\ { ... | _____ -- ... }
269 
: ParseLocals2
270 
  BEGIN
271 
   PARSE-NAME
272 
   DUP 0= ABORT" Locals bad syntax (2)"
273 
   2DUP S" --" COMPARE 0= IF 2DROP ParseLocals3 EXIT THEN
274 
   2DUP S" }" COMPARE 0= IF 2DROP EXIT THEN
275 
   2DUP S" [" COMPARE 0=
276 
   IF
277 
     2DROP CreateLocArray LocalsRecDoes@
278 
   ELSE
279 
     CREATED
280 
     LATEST DUP C@ CHARS + C@
281 
     [CHAR] [ =
282 
     IF
283 
       LocalsRecDoes@2
284 
     ELSE
285 
       LocalsDoes@ 1
286 
     THEN
287 
   THEN
288 
   uLocalsUCnt +! IMMEDIATE
289 
  AGAIN
290 
;
291 
 
292 
\ { _____ | ... -- ... }
293 
: ParseLocals1
294 
  BEGIN
295 
    PARSE-NAME
296 
    DUP 0= ABORT" Locals bad syntax (1)"
297 
    2DUP S" |" COMPARE 0= IF 2DROP ParseLocals2 EXIT THEN
298 
    2DUP S" \" COMPARE 0= IF 2DROP ParseLocals2 EXIT THEN
299 
    2DUP S" --" COMPARE 0= IF 2DROP ParseLocals3 EXIT THEN
300 
    2DUP S" }" COMPARE 0= IF 2DROP EXIT THEN
301 
 
302 
    CREATED LocalsDoes@ IMMEDIATE
303 
  AGAIN ;
304 
 
305 
\  uLocalsCnt  @ ?DUP
306 
\  IF CELLS RLIT, ['] (LocalsExit) RLIT, THEN
307 
 
308 
: ;  LocalsCleanup
309 
     S" ;" EVAL-WORD
310 
; IMMEDIATE
311 
 
312 
WARNING !
313 
 
314 
\ =====================================================================
315 
 
316 
EXPORT
317 
 
318 
: {
319 
  LocalsStartup
320 
  ParseLocals1
321 
  CompileLocalsInit
322 
;; IMMEDIATE
323 
 
324 
;MODULE