Более быстрая и компактная реализация локально-именованных слов и
и локально-именованных статических переменных и массивов за счет выноса их кода и данных
в другие области памяти
Код:
HERE IMAGE-BASE - 0x100000 + TO IMAGE-SIZE \ увеличим размер образа
CREATE lcode 0x10000 ALLOT lcode VALUE dpl \ область кода для слов с лок именами
CREATE ldata 0x10000 ALLOT ldata VALUE ldhere \ область данных для локально-именованных переменных и массивов
VARIABLE XHERE VARIABLE xdpl \ переменные сохранения указателей компиляции
\ область локальных имен
0x800 CONSTANT lenlvoc
USER-CREATE alvoc lenlvoc USER-ALLOT
USER lhere
USER axtloc
: lvoc ( -- a len ) alvoc lenlvoc ; lvoc ERASE 1 lhere !
\ формирование локального имени ( после последнего символа имени идет 0-й байт )
: lname, ( a u -- axt)
TUCK lhere @ SWAP MOVE lhere @ + DUP 0! 1+ DUP lhere ! DUP axtloc ! ;
0 WARNING !
: L{ dpl xdpl ! DP @ XHERE ! dpl DP ! ; \ переключение на компиляцию в область lcode
: }L dpl DP @ xdpl @ - + TO dpl XHERE @ DP ! ; \ переключение на компиляцию в область CODE
: init-lvoc lhere @ 1 = IF lvoc ERASE lvoc DROP lhere ! THEN ;
: headl ( a u -- ) lname, dpl SWAP ! lhere @ 5 + lhere ! ;
M: nf1-exit ( a u s -- a u ) -ROT 2DUP + 1- C@ -ROT 2SWAP <> IF NOTFOUND EXIT THEN ;
M: nf2-exit ( a u ss -- a u ) -ROT 2DUP + 2- W@ -ROT 2SWAP <> IF NOTFOUND EXIT THEN ;
USER locxt 0 locxt ! \ XT для локально-именованного кода
USER iol 0 iol ! \ направление ввода-вывода в лок переменные типа value
\ начало и конец компиляции определения с "обнулением" признака заполненности лок. словаря
: : 1 lhere ! : ;
\ начало формирования кода с локальным именем
: NOTFOUND ( a u -- ) '(' nf1-exit init-lvoc 1- headl L{ ;
\ окончание формирования кода с локальным именем
: ) ( -- ) RET, }L ; IMMEDIATE
\ окончание формирования кода с локальным именем, оставляющего токен на стеке
: x) ( -- ) RET, }L axtloc @ @ LIT, ; IMMEDIATE
: razd? ( a -- fl) DUP C@ 0= SWAP C@ 0x20 = OR ;
\ процедура поиска имени в лок. словаре
: lsearch { a u a1 u1 \ a2 u2 fl -- a u 0|1 }
0 TO fl BEGIN a u a1 u1 SEARCH >R TO u2 TO a2
R> a2 u1 + razd? a2 1- razd? AND AND
IF 1 TO fl a2 u1 TRUE
ELSE a2 u1 + 1+ TO a u2 u1 - 1- TO u
u u1 < IF 1 TO fl a u FALSE THEN
THEN
fl UNTIL ;
: l' ( 'lname' -- xt ) TRUE locxt ! ; IMMEDIATE \ аналог ' для локально-именованных слов
: is 1 iol ! ; IMMEDIATE \ аналоги TO
: ib 2 iol ! ; IMMEDIATE
: iw 3 iol ! ; IMMEDIATE
: id 4 iol ! ; IMMEDIATE
\ компиляция кода с именами в лок. словаре
: NOTFOUND \ a u --
OVER C@ '`' = IF 1 /STRING TRUE locxt ! THEN
lvoc 2OVER lsearch 0= lhere @ 1 = OR IF 2DROP NOTFOUND EXIT THEN
2SWAP NIP NIP + 1+ @ iol @
IF 12 + iol @ >R R@ 3 > IF 8 ELSE R@ 1 > IF 3 ELSE 0 THEN THEN
RDROP + 0 iol !
THEN locxt @ 0= IF COMPILE, ELSE 0 locxt ! LIT, THEN ;
\ локально-именованные переменые
: NOTFOUND ( a u -- ) \ типа 2variable
')d' nf2-exit init-lvoc 2- headl
L{ ldhere LIT, RET, ldhere 2 CELLS + TO ldhere }L ;
: NOTFOUND ( a u -- ) \ типа variable
')' nf1-exit init-lvoc 1- headl
L{ ldhere LIT, RET, ldhere CELL + TO ldhere }L ;
: NOTFOUND ( a u -- ) \ типа wvariable
')w' nf2-exit init-lvoc 2- headl
L{ ldhere LIT, RET, ldhere 2+ TO ldhere }L ;
: NOTFOUND ( a u -- ) \ типа bvariable
')b' nf2-exit init-lvoc 2- headl
L{ ldhere LIT, RET, ldhere 1+ TO ldhere }L ;
: NOTFOUND ( a u -- ) \ типа value
'!' nf1-exit init-lvoc 1- headl ldhere LIT, !,
L{ ldhere LIT, @, RET, ldhere LIT, !, RET, ldhere 1 CELLS + TO ldhere }L ;
: NOTFOUND ( a u -- ) \ 2value
'!d' nf2-exit init-lvoc 2- headl ldhere LIT, 2!,
L{ ldhere LIT, 2@, RET, ldhere LIT, 2!, RET, ldhere 2 CELLS + TO ldhere }L ;
: NOTFOUND ( a u -- ) \ wvalue
'!w' nf2-exit init-lvoc 2- headl ldhere LIT, W!,
L{ ldhere LIT, W@, RET, ldhere LIT, W!, RET, ldhere 2+ TO ldhere }L ;
: NOTFOUND ( a u -- ) \ bvalue
'!b' nf2-exit init-lvoc 2- headl ldhere LIT, C!,
L{ ldhere LIT, C@, RET, ldhere LIT, C!, RET, ldhere 1+ TO ldhere }L ;
\ локально-именованные статические массивы
: NOTFOUND ( a u -- ) \ размер задается только числовым литералом 20 arr]
']' nf1-exit OP0 @ 4 - @ >CS DROP, init-lvoc 1- headl
L{ ldhere LIT, RET, CS> ldhere + TO ldhere }L ;
: NOTFOUND ( a u -- ) \ размер берется с локального стека $ 8 arr1} или [ величина >CS ] arr}
'}' nf1-exit init-lvoc 1- headl
L{ ldhere LIT, RET, CS> ldhere + TO ldhere }L ;
\ определение слов через ':' в виде name: .... ; вместо : name .... ;
: NOTFOUND ( a u -- ) ':' nf1-exit 1- SHEADER ] HIDE ;
\ определение макросов через ':M' в виде name:M .... ; вместо M: name .... ;
: NOTFOUND ( a u -- ) ':M' nf2-exit 2- SHEADER ] HIDE IMMEDIATE LOAD-TEXT POSTPONE EVALUATE POSTPONE ; ;
\ определение строк многострочныx через ':T' в виде name:T .... ; вместо T: name .... ;
: NOTFOUND ( a u -- ) ':T' nf2-exit 2- SHEADER ] HIDE LOAD-TEXT POSTPONE ; ;
\ EOF
\ сумма попарных произведений для 4 параметров
: d(4) ( a b c d -- ab+ac+ad+bc+bd+cd )
a! b! c! d!
b c + d + a *
c d + b * +
c d * + ;
\ на 'старых' лок. переменных спф
: D(4) { a b c d -- ab+ac+ad+bc+bd+cd }
b c + d + a *
c d + b * +
c d * + ;
: S1 1 2 3 4 d(4) ;
: S2 1 2 3 4 D(4) ;
STARTLOG
SEE d(4)
SEE D(4)
REQUIRE METER ~CHESS\TASK\METER.F
METER S1
METER S2
лог
Код:
CODE d(4)
5CFB37 890560EE5B00 MOV 5BEE60 ( ldata+5 ) , EAX
5CFB3D 8B4500 MOV EAX , 0 [EBP]
5CFB40 8D6D04 LEA EBP , 4 [EBP]
5CFB43 890564EE5B00 MOV 5BEE64 ( ldata+9 ) , EAX
5CFB49 8B4500 MOV EAX , 0 [EBP]
5CFB4C 8D6D04 LEA EBP , 4 [EBP]
5CFB4F 890568EE5B00 MOV 5BEE68 ( ldata+D ) , EAX
5CFB55 8B4500 MOV EAX , 0 [EBP]
5CFB58 8D6D04 LEA EBP , 4 [EBP]
5CFB5B 89056CEE5B00 MOV 5BEE6C ( ldata+11 ) , EAX
5CFB61 8B4500 MOV EAX , 0 [EBP]
5CFB64 8D6D04 LEA EBP , 4 [EBP]
5CFB67 8945FC MOV FC [EBP] , EAX
5CFB6A A164EE5B00 MOV EAX , 5BEE64 ( ldata+9 )
5CFB6F 030568EE5B00 ADD EAX , 5BEE68 ( ldata+D )
5CFB75 03056CEE5B00 ADD EAX , 5BEE6C ( ldata+11 )
5CFB7B F72D60EE5B00 IMUL 5BEE60 ( ldata+5 )
5CFB81 8945F8 MOV F8 [EBP] , EAX
5CFB84 A168EE5B00 MOV EAX , 5BEE68 ( ldata+D )
5CFB89 03056CEE5B00 ADD EAX , 5BEE6C ( ldata+11 )
5CFB8F F72D64EE5B00 IMUL 5BEE64 ( ldata+9 )
5CFB95 0345F8 ADD EAX , F8 [EBP]
5CFB98 8945F8 MOV F8 [EBP] , EAX
5CFB9B A168EE5B00 MOV EAX , 5BEE68 ( ldata+D )
5CFBA0 F72D6CEE5B00 IMUL 5BEE6C ( ldata+11 )
5CFBA6 0345F8 ADD EAX , F8 [EBP]
5CFBA9 8D6DFC LEA EBP , FC [EBP]
5CFBAC C3 RET NEAR
END-CODE
( 118 bytes, 28 instructions )
CODE D(4)
5CFBBF 8945FC MOV FC [EBP] , EAX
5CFBC2 B810000000 MOV EAX , # 10
5CFBC7 8D6DFC LEA EBP , FC [EBP]
5CFBCA E82535F8FF CALL 5530F4 ( DRMOVE )
5CFBCF 6810000000 PUSH , # 10
5CFBD4 6878325500 PUSH , # 553278
5CFBD9 8945FC MOV FC [EBP] , EAX
5CFBDC 8B442410 MOV EAX , 10 [ESP]
5CFBE0 0344240C ADD EAX , C [ESP]
5CFBE4 03442408 ADD EAX , 8 [ESP]
5CFBE8 8945F8 MOV F8 [EBP] , EAX
5CFBEB 8B442414 MOV EAX , 14 [ESP]
5CFBEF F76DF8 IMUL F8 [EBP]
5CFBF2 8945F8 MOV F8 [EBP] , EAX
5CFBF5 8B44240C MOV EAX , C [ESP]
5CFBF9 03442408 ADD EAX , 8 [ESP]
5CFBFD 8945F4 MOV F4 [EBP] , EAX
5CFC00 8B442410 MOV EAX , 10 [ESP]
5CFC04 F76DF4 IMUL F4 [EBP]
5CFC07 0345F8 ADD EAX , F8 [EBP]
5CFC0A 8945F8 MOV F8 [EBP] , EAX
5CFC0D 8B44240C MOV EAX , C [ESP]
5CFC11 8945F4 MOV F4 [EBP] , EAX
5CFC14 8B442408 MOV EAX , 8 [ESP]
5CFC18 F76DF4 IMUL F4 [EBP]
5CFC1B 0345F8 ADD EAX , F8 [EBP]
5CFC1E 8D6DFC LEA EBP , FC [EBP]
5CFC21 C3 RET NEAR
END-CODE
( 99 bytes, 28 instructions )
99 45
171 72
Ok
ps.
1. Быстродействие локально-именованных переменных стало даже чуть выше чем у обычных лок. переменных спф,
а пользоваться локально-именованными переменными стало удобнее, так как их можно вводить
многократно и в любых местах определения , а не один только раз как раньше.
2. Кроме того они не завязаны со стеком возвратов как старые лок. переменые и могут использоваться
в локально-именованных словах.