Menu
▾
▴
[Win32forth-cvs] win32forth-stc/src ANSFILE.F, 1.2, 1.3 extend.f, 1.19, 1.20 optinline.f, 1.7, 1.8 optliterals.f, 1.14, 1.15 primutil.f, 1.32, 1.33
|
From: Alex M. <ale...@us...> - 2007-05-13 21:39:31
|
Update of /cvsroot/win32forth/win32forth-stc/src In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv7404/src Modified Files: ANSFILE.F extend.f optinline.f optliterals.f primutil.f Log Message: arm: remove caps-xxx functions to ansfile optimise case statements reorder kernel source (minor) Index: primutil.f =================================================================== RCS file: /cvsroot/win32forth/win32forth-stc/src/primutil.f,v retrieving revision 1.32 retrieving revision 1.33 diff -C2 -d -r1.32 -r1.33 *** primutil.f 12 May 2007 10:49:12 -0000 1.32 --- primutil.f 13 May 2007 21:39:26 -0000 1.33 *************** *** 410,459 **** \ ------------------------------------------------------------------------ - \ Some case insensitive version of search and compare - \ ------------------------------------------------------------------------ - - \ needed by ansfile.f - - \ enhanced caps-search for source string > 255 bytes - \ search for t-adr,t-len within string s-adr,s-len. f1=true if string was found - : CAPS-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, - \ ** using a case-insensitive search. \n - \ ** If flag is true, a match was found at c-addr3 with u3 characters remaining. \n - \ ** If flag is false there was no match and c-addr3 is c-addr1 and u3 is u1. - { s-adr s-len t-adr t-len \ t-buf t-str -- adr len flag } - MAXSTRING localalloc: t-str - s-len cell+ ALLOCATE 0= - IF to t-buf \ make a buffer big enough for s-adr - t-adr t-len t-str place - t-str count upper - s-adr t-buf s-len move - t-buf s-len upper - t-buf s-len t-str count search - IF nip \ discard found address - s-len swap - \ offset where string was found - s-adr s-len rot /string - \ location of found string in original buf - TRUE - ELSE 2drop - s-adr s-len FALSE - THEN - t-buf FREE drop - ELSE s-adr s-len FALSE \ failed, couldn't allocate buffer - THEN ; - - \ COMPARE compares two strings, ignoring case. The return value is: - \ - \ 0 = string1 = string2 - \ -1 = string1 < string2 - \ 1 = string1 > string2 - : CAPS-COMPARE { sa1 sn1 sa2 sn2 \ st1 st2 -- f1 } - MAXSTRING LocalAlloc: st1 - MAXSTRING LocalAlloc: st2 - sa1 sn1 st1 place st1 count upper - sa2 sn2 st2 place st2 count upper - st1 count st2 count compare ; - - \ ------------------------------------------------------------------------ \ Locking for Windows \ ------------------------------------------------------------------------ --- 410,413 ---- Index: ANSFILE.F =================================================================== RCS file: /cvsroot/win32forth/win32forth-stc/src/ANSFILE.F,v retrieving revision 1.2 retrieving revision 1.3 diff -C2 -d -r1.2 -r1.3 *** ANSFILE.F 25 Sep 2006 11:57:52 -0000 1.2 --- ANSFILE.F 13 May 2007 21:39:26 -0000 1.3 *************** *** 73,76 **** --- 73,121 ---- 2 newuser wMilliseconds + \ ------------------------------------------------------------------------ + \ Some case insensitive version of search and compare + \ ------------------------------------------------------------------------ + + \ enhanced caps-search for source string > 255 bytes + \ search for t-adr,t-len within string s-adr,s-len. f1=true if string was found + : CAPS-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, + \ ** using a case-insensitive search. \n + \ ** If flag is true, a match was found at c-addr3 with u3 characters remaining. \n + \ ** If flag is false there was no match and c-addr3 is c-addr1 and u3 is u1. + { s-adr s-len t-adr t-len \ t-buf t-str -- adr len flag } + MAXSTRING localalloc: t-str + s-len cell+ ALLOCATE 0= + IF to t-buf \ make a buffer big enough for s-adr + t-adr t-len t-str place + t-str count upper + s-adr t-buf s-len move + t-buf s-len upper + t-buf s-len t-str count search + IF nip \ discard found address + s-len swap - \ offset where string was found + s-adr s-len rot /string + \ location of found string in original buf + TRUE + ELSE 2drop + s-adr s-len FALSE + THEN + t-buf FREE drop + ELSE s-adr s-len FALSE \ failed, couldn't allocate buffer + THEN ; + + \ COMPARE compares two strings, ignoring case. The return value is: + \ + \ 0 = string1 = string2 + \ -1 = string1 < string2 + \ 1 = string1 > string2 + : CAPS-COMPARE { sa1 sn1 sa2 sn2 \ st1 st2 -- f1 } + MAXSTRING LocalAlloc: st1 + MAXSTRING LocalAlloc: st2 + sa1 sn1 st1 place st1 count upper + sa2 sn2 st2 place st2 count upper + st1 count st2 count compare ; + + : get-fspace { zroot \ clus freclus b/sec s/clus -- as bs cs ds } \ *G Get a drive's free space, cluster and sector information Index: extend.f =================================================================== RCS file: /cvsroot/win32forth/win32forth-stc/src/extend.f,v retrieving revision 1.19 retrieving revision 1.20 diff -C2 -d -r1.19 -r1.20 *** extend.f 9 May 2007 12:14:08 -0000 1.19 --- extend.f 13 May 2007 21:39:26 -0000 1.20 *************** *** 6,9 **** --- 6,10 ---- sys-fload src\optinline \ inline optimiser fload src\primutil.f + sys-fload src\struct.f \ forth 200x structs sys-fload src\module.f \ scoping support for modules sys-fload src\interpif.f \ interpretive conditionals Index: optliterals.f =================================================================== RCS file: /cvsroot/win32forth/win32forth-stc/src/optliterals.f,v retrieving revision 1.14 retrieving revision 1.15 diff -C2 -d -r1.14 -r1.15 *** optliterals.f 22 Mar 2007 02:13:56 -0000 1.14 --- optliterals.f 13 May 2007 21:39:26 -0000 1.15 *************** *** 126,131 **** : add-v,tos { var } macro[ add var , eax ]macro ; ! : add-v,#n { var n } n if macro[ add var , dword # n ]macro then ; ! : add-tos,#n ( n ) dup if >r macro[ add r@ tos,#n ]macro r>drop else drop then ; : sub-tos,#n ( n ) >r macro[ sub r@ tos,#n ]macro r>drop ; : shl-tos,#n ( n ) >r macro[ shl r@ tos,#n ]macro r>drop ; --- 126,131 ---- : add-v,tos { var } macro[ add var , eax ]macro ; ! : add-v,#n { var n } n if macro[ add var , dword # n ]macro then ; ! : add-tos,#n ( n ) dup if >r macro[ add r@ tos,#n ]macro r>drop else drop then ; : sub-tos,#n ( n ) >r macro[ sub r@ tos,#n ]macro r>drop ; : shl-tos,#n ( n ) >r macro[ shl r@ tos,#n ]macro r>drop ; *************** *** 135,138 **** --- 135,140 ---- : or-tos,#n ( n ) >r macro[ or r@ tos,#n ]macro r>drop ; : xor-tos,#n ( n ) >r macro[ xor r@ tos,#n ]macro r>drop ; + : cmp-tos,#n ( n ) >r macro[ cmp r@ tos,#n ]macro r>drop ; + : jne-mark2 ( -- ) macro[ jne 0 ]macro >mark 2 ; : not-tos ( -- ) macro[ not eax ]macro ; *************** *** 320,322 **** --- 322,335 ---- ' optc! compiles-for c! + : optof ( xt -- ) \ optimise the constant case "n of ... endof" + drop 1+ >r + lits>0? if + lits spop sync-code cmp-tos,#n jne-mark2 + else + postpone over + postpone = + postpone if + then + postpone drop r> ; + previous definitions Index: optinline.f =================================================================== RCS file: /cvsroot/win32forth/win32forth-stc/src/optinline.f,v retrieving revision 1.7 retrieving revision 1.8 diff -C2 -d -r1.7 -r1.8 *** optinline.f 11 Apr 2007 20:22:42 -0000 1.7 --- optinline.f 13 May 2007 21:39:26 -0000 1.8 *************** *** 36,40 **** vocabulary optimise ! also optimise definitions --- 36,40 ---- vocabulary optimise ! also optimise definitions *************** *** 49,55 **** --- 49,63 ---- ' (comp-cons) compiles-for cell ' (comp-cons) compiles-for -cell + ' (comp-val) compiles-for stdin + ' (comp-val) compiles-for stdout + ' (comp-val) compiles-for stderr \ set the words we will inline + ' xt-inline, compiles-for @ + ' xt-inline, compiles-for c@ + ' xt-inline, compiles-for sc@ + ' xt-inline, compiles-for w@ + ' xt-inline, compiles-for sw@ ' xt-inline, compiles-for cells ' xt-inline, compiles-for cells+ *************** *** 75,87 **** ' xt-inline, compiles-for 2swap ' xt-inline, compiles-for 2over - ' xt-inline, compiles-for @ ' xt-inline, compiles-for ! ' xt-inline, compiles-for +! - ' xt-inline, compiles-for c@ - ' xt-inline, compiles-for sc@ ' xt-inline, compiles-for c! ' xt-inline, compiles-for c+! - ' xt-inline, compiles-for w@ - ' xt-inline, compiles-for sw@ ' xt-inline, compiles-for w! ' xt-inline, compiles-for w+! --- 83,90 ---- |
