Menu
▾
▴
[Win32forth-cvs] win32forth-stc/src/kernel gkernel.f,1.43,1.44
|
From: George H. <geo...@us...> - 2008-09-09 20:54:44
|
Update of /cvsroot/win32forth/win32forth-stc/src/kernel In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv10948 Modified Files: gkernel.f Log Message: Corrected bug in (LOCAL) Index: gkernel.f =================================================================== RCS file: /cvsroot/win32forth/win32forth-stc/src/kernel/gkernel.f,v retrieving revision 1.43 retrieving revision 1.44 diff -C2 -d -r1.43 -r1.44 *** gkernel.f 17 Aug 2007 02:57:20 -0000 1.43 --- gkernel.f 9 Sep 2008 20:54:40 -0000 1.44 *************** *** 1601,1608 **** mov eax, ecx next; ! code lastchar ( str -- char ) \ returns last character from c-string movzx ecx, byte [eax] ! movzx eax, byte [eax] [ecx] next c; --- 1601,1608 ---- mov eax, ecx next; ! code lastchar ( str -- char ) \ returns last character from c-string movzx ecx, byte [eax] ! movzx eax, byte [eax] [ecx] next c; *************** *** 1944,1948 **** : -trailing ( addr n1 -- addr n2 ) \ remove trailing blanks from addr,n1 bl -trailchars ; ! : -nulls ( addr n1 -- addr n2 ) \ remove trailing nulls from addr,n1 0 -trailchars ; --- 1944,1948 ---- : -trailing ( addr n1 -- addr n2 ) \ remove trailing blanks from addr,n1 bl -trailchars ; ! : -nulls ( addr n1 -- addr n2 ) \ remove trailing nulls from addr,n1 0 -trailchars ; *************** *** 4264,4269 **** xor throw_mismatch ?throw ; ! : >mark ( -- addr ) ! sync-code code-here ; \ mark a link for later resolution by : <resolve ( orig -- ) \ fixup relative jump at orig --- 4264,4269 ---- xor throw_mismatch ?throw ; ! : >mark ( -- addr ) ! sync-code code-here ; \ mark a link for later resolution by : <resolve ( orig -- ) \ fixup relative jump at orig *************** *** 4586,4590 **** \ EXIT compiles __LOCALFREE, but leaves LOCALSTK alone so that ; can ! \ also compile __LOCALFREE : exit ( -- ) \ exit current word --- 4586,4590 ---- \ EXIT compiles __LOCALFREE, but leaves LOCALSTK alone so that ; can ! \ also compile __LOCALFREE : exit ( -- ) \ exit current word *************** *** 4630,4634 **** (comp-only) compilation> ; ! |: ;noname ( -- ) \ ; for :noname drop \ because after compilation> --- 4630,4634 ---- (comp-only) compilation> ; ! |: ;noname ( -- ) \ ; for :noname drop \ because after compilation> *************** *** 4641,4645 **** ofa 1+ (ofa-calc) \ length calculation (don't include the ret) reveal ; \ reveal the name ! \ Words to support : --- 4641,4645 ---- ofa 1+ (ofa-calc) \ length calculation (don't include the ret) reveal ; \ reveal the name ! \ Words to support : *************** *** 4749,4753 **** code-here compiles-last \ make the defined word compile this ; ! : compile-only> ( -- ) \ shorthand for (comp-only) comp (comp-only) --- 4749,4753 ---- code-here compiles-last \ make the defined word compile this ; ! : compile-only> ( -- ) \ shorthand for (comp-only) comp (comp-only) *************** *** 5386,5390 **** \ Code to fetch local values ! gcode _localn mov -4 [ebp], eax lea ebp, -4 [ebp] --- 5386,5390 ---- \ Code to fetch local values ! gcode _localn mov -4 [ebp], eax lea ebp, -4 [ebp] *************** *** 5462,5487 **** then ; - : (local) ( addr cnt -- ) \ create name in locals vocab - (comp-only) compilation> drop - dup if \ looks like std vocab header - 1 +to localstk \ total count of stack parms - localstk #-locals > throw_localstoomany ?throw - get-current >r \ save current - also locals definitions \ move to locals area - last @ last-link @ 2>r \ save last (we wipe out) - latestxt @ >r - >local - "header \ build a header - tloc tfa! \ mark as a local - local> - localstk cells [ local-ptrs cell- ] literal \ table is zero offset - + @ xtptr! \ return correct xt and make it xt (local n) - r> latestxt ! - 2r> last-link ! last ! \ restore last, last-link - previous r> set-current \ back out of locals - locflg +to localsi \ locflg counts initialised - else 2drop localsgen, \ go on to create locals - then ; - : nextword ( char -- adr flag ) \ flag=true if we got a word, else false begin dup word dup c@ 0= --- 5462,5465 ---- *************** *** 5506,5509 **** --- 5484,5516 ---- [ ' locals >body ] literal off ; \ clean thread in vocabulary + |: {local} ( addr cnt -- ) \ create name in locals vocab + 1 +to localstk \ total count of stack parms + localstk #-locals > throw_localstoomany ?throw + get-current >r \ save current + also locals definitions \ move to locals area + last @ last-link @ 2>r \ save last (we wipe out) + latestxt @ >r + >local + "header \ build a header + tloc tfa! \ mark as a local + local> + localstk cells [ local-ptrs cell- ] literal \ table is zero offset + + @ xtptr! \ return correct xt and make it xt (local n) + r> latestxt ! + 2r> last-link ! last ! \ restore last, last-link + previous r> set-current \ back out of locals + locflg +to localsi ; \ locflg counts initialised + + : (local) ( addr cnt -- ) \ create name in locals vocab + (comp-only) compilation> drop + localstk 0= if + locals-init + false to locdir \ reversed stack order + then + dup if \ looks like std vocab header + {local} + else 2drop localsgen, \ go on to create locals + then ; + : { ( -- ) \ begin local variables (comp-only) compilation> drop *************** *** 5515,5519 **** 2dup s" \" str= >r \ is it { [...] \ ... 2dup s" |" str= r> or not \ is it { [...] | ... ! if postpone (local) \ no, it's a local else 2drop 0 to locflg then \ onto uninited locals repeat --- 5522,5526 ---- 2dup s" \" str= >r \ is it { [...] \ ... 2dup s" |" str= r> or not \ is it { [...] | ... ! if {local} \ no, it's a local else 2drop 0 to locflg then \ onto uninited locals repeat *************** *** 5529,5534 **** : locals| ( -- ) \ ans standard locals (comp-only) compilation> drop - locals-init - false to locdir \ reversed stack order begin localword 2dup s" |" str= not --- 5536,5539 ---- *************** *** 5583,5587 **** __localsave (copy-code) -1 to localstk \ mark as localalloc ! then __localalloc (copy-code) ; --- 5588,5592 ---- __localsave (copy-code) -1 to localstk \ mark as localalloc ! then __localalloc (copy-code) ; |
