From: George H. <geo...@us...> - 2006-09-13 09:35:01
|
Update of /cvsroot/win32forth/win32forth/src/kernel In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv28933/win32forth/src/kernel Modified Files: fkernel.f Log Message: gah:More dexing and minor optimisations Index: fkernel.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/kernel/fkernel.f,v retrieving revision 1.36 retrieving revision 1.37 diff -C2 -d -r1.36 -r1.37 *** fkernel.f 25 Aug 2006 12:54:02 -0000 1.36 --- fkernel.f 13 Sep 2006 09:34:57 -0000 1.37 *************** *** 1463,1467 **** \ EDX = pointer for compare ! CODE SEARCH ( adr1 len1 adr2 len2 -- adr3 len3 flag ) test ebx, ebx jne short @@1 --- 1463,1470 ---- \ EDX = pointer for compare ! CODE SEARCH ( c-addr1 u1 c-addr2 u2 -- c-addr3 u3 flag ) ! \ *G Search the string specified by c-addr1 u1 for the string specified by c-addr2 u2. ! \ ** If flag is true, a match was found at c-addr3 with u3 characters remaining. ! \ ** If flag is false there was no match and c-addr3 is c-addr1 and u3 is u1. test ebx, ebx jne short @@1 *************** *** 1645,1649 **** next c; ! CODE +PLACE ( addr len dest -- ) \ append string addr,len to counted dest pop ecx \ get length pop eax \ source in eax --- 1648,1653 ---- next c; ! CODE +PLACE ( addr len addr2 -- ) \ W32F String Extra ! \ *G Append string addr,len to counted string at addr2. pop ecx \ get length pop eax \ source in eax *************** *** 1672,1675 **** --- 1676,1687 ---- next c; + CODE +NULL ( addr -- ) \ W32F String Extra + \ *G Append a NULL to string. + movzx ecx, byte [ebx] \ length + lea ebx, 1 [ebx] [ecx] \ point at char + mov byte [ebx], # 0 \ zero the char + pop ebx + next c; + CODE -TRAILCHARS ( addr n1 c1 -- addr n2 ) \ remove trailing c1's from addr,n1 mov eax, ebx *************** *** 3309,3315 **** ; ! : Z", ( a1 n1 -- ) \ compile a1,n1 at here ! HERE OVER ALLOT SWAP CMOVE ! ; : Z," ( -<string">- ) \ compile string" at here --- 3321,3327 ---- ; ! : Z", ( addr len -- ) \ W32F String Extra ! \ *G Compile the string, addr len at here. ! HERE OVER ALLOT place ; : Z," ( -<string">- ) \ compile string" at here *************** *** 3317,3321 **** ; ! DEFER NEW$ ' TEMP$ IS NEW$ ( a1 -- a2 ) |: ((P")) ( -- addr len buff buff ) \ internal for ((x")) words --- 3329,3333 ---- ; ! DEFER NEW$ ' TEMP$ IS NEW$ ( -- addr ) |: ((P")) ( -- addr len buff buff ) \ internal for ((x")) words *************** *** 3337,3346 **** exec c; \ go do it - : C" ( -<string">- ) - STATE @ - IF COMPILE (C") ," - ELSE ((C")) - THEN ; IMMEDIATE - NCODE (S") ( -- addr len ) \ for s" type strings push ebx --- 3349,3352 ---- *************** *** 3353,3365 **** exec c; \ go do it - : S" ( -<string">- ) - \ *G Compiletime: s" parses the input stream until it finds the next " and - \ ** compiles it into the current definition. Runtime: s" leaves the address - \ ** and the length of the compiled string on the stack. - STATE @ - IF COMPILE (S") ," \ see also ." and .( - ELSE ((S")) - THEN ; IMMEDIATE - NCODE (Z") ( -- addr ) \ for z" type strings push ebx --- 3359,3362 ---- *************** *** 3371,3380 **** exec c; \ go do it - : Z" ( -<string">- ) \ If compiling puts string in the dictionary - STATE @ \ or else it puts the address and length n the stack - IF COMPILE (Z") ," - ELSE ((C")) dup dup c@ + 1+ 0 swap c! 1+ - THEN ; IMMEDIATE - NCODE (.") ( -- addr len ) \ for ." push ebx --- 3368,3371 ---- *************** *** 3387,3390 **** --- 3378,3404 ---- exec c; \ go do it + in-system + + : C" ( -<string">- ) + STATE @ + IF COMPILE (C") ," + ELSE ((C")) + THEN ; IMMEDIATE + + : S" ( -<string">- ) + \ *G Compiletime: s" parses the input stream until it finds the next " and + \ ** compiles it into the current definition. Runtime: s" leaves the address + \ ** and the length of the compiled string on the stack. + STATE @ + IF COMPILE (S") ," \ see also ." and .( + ELSE ((S")) + THEN ; IMMEDIATE + + : Z" ( -<string">- ) \ If compiling puts string in the dictionary + STATE @ \ or else it puts the address and length n the stack + IF COMPILE (Z") ," + ELSE ((C")) dup dup c@ + 1+ 0 swap c! 1+ + THEN ; IMMEDIATE + : ." ( -<string">- ) \ See also s" and .( \ *G Compiletime: Parses the input stream until it finds the next " and *************** *** 3393,3407 **** COMPILE (.") ," ; IMMEDIATE - CODE +NULL ( a1 -- ) \ append a NULL just beyond the counted chars - movzx ecx, byte [ebx] \ length - lea ebx, 1 [ebx] [ecx] \ point at char - mov byte [ebx], # 0 \ zero the char - pop ebx - next c; - : SLITERAL ( a1 n1 -- ) \ compile string as literal COMPILE (S") HERE >R ", 0 C, ALIGN R> COUNT \N->CRLF ; IMMEDIATE \ tjz, as posted from Bernd Paysan Thu, 05 Jul 2001 Thanks Bernd --- 3407,3416 ---- COMPILE (.") ," ; IMMEDIATE : SLITERAL ( a1 n1 -- ) \ compile string as literal COMPILE (S") HERE >R ", 0 C, ALIGN R> COUNT \N->CRLF ; IMMEDIATE + in-application + \ tjz, as posted from Bernd Paysan Thu, 05 Jul 2001 Thanks Bernd *************** *** 3902,3907 **** r/o w/o + constant r/w \ READ/WRITE ! : ascii-z ( addr len buff -- buff-z ) \ make an ascii string ! dup>r place r> count over + 0 swap c! ; : open-file ( adr slen fmode -- fileid ior ) --- 3911,3918 ---- r/o w/o + constant r/w \ READ/WRITE ! : ascii-z ( addr len buff -- buff-z ) \ W32F String Extra ! \ *G Make a null-terminated copy of string addr len in buff and return the address of the ! \ ** first character. ! dup>r place r> dup +null 1+ ; : open-file ( adr slen fmode -- fileid ior ) *************** *** 4155,4158 **** --- 4166,4171 ---- THEN DROP ; + in-system + : ABORT" ( -- ) COMPILE (ABORT") ," ; IMMEDIATE *************** *** 4162,4166 **** : ?PAIRS ( n1 n2 -- ) XOR THROW_MISMATCH ?THROW ; ! in-system : ?EXEC STATE @ THROW_INTERPONLY ?THROW ; --- 4175,4179 ---- : ?PAIRS ( n1 n2 -- ) XOR THROW_MISMATCH ?THROW ; ! \ in-system : ?EXEC STATE @ THROW_INTERPONLY ?THROW ; |