[Win32forth-cvs] win32forth/src ANSFILE.F, 1.5, 1.6 Primutil.f, 1.17, 1.18

SourceForge Headquarters 225 Broadway Suite 1600 San Diego, CA 92101 +1 (858) 422-6466

Update of /cvsroot/win32forth/win32forth/src
In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv28933/win32forth/src

Modified Files:
	ANSFILE.F Primutil.f 
Log Message:
gah:More dexing and minor optimisations

Index: Primutil.f
===================================================================
RCS file: /cvsroot/win32forth/win32forth/src/Primutil.f,v
retrieving revision 1.17
retrieving revision 1.18
diff -C2 -d -r1.17 -r1.18
*** Primutil.f	11 Aug 2006 10:09:45 -0000	1.17
--- Primutil.f	13 Sep 2006 09:34:57 -0000	1.18
***************
*** 325,334 ****
  in-system
  
! : \-            ( -<word>- )            \ load line if word IS NOT defined
                  defined nip
                  if      POSTPONE \
                  then    ; immediate
  
! : \+            ( -<word>- )            \ load line if word IS defined
                  defined nip 0=
                  if      POSTPONE \
--- 325,336 ----
  in-system
  
! : \-            ( "word" -- )
! \ *G Interpret the rest of the line if "word" isn't defined.
                  defined nip
                  if      POSTPONE \
                  then    ; immediate
  
! : \+            ( "word" -- )
! \ *G Interpret the rest of the line if "word" is defined.
                  defined nip 0=
                  if      POSTPONE \
***************
*** 336,339 ****
--- 338,343 ----
  
  : \IN-SYSTEM-OK ( -<line_to_interpret>- )
+ \ *G Suppress in-system warnings for the rest of the current line, restoring the previous
+ \ ** state of the sys-warning? flag afterwards, even if an error occurs.
                  sys-warning? >r
                  sys-warning-off
***************
*** 381,388 ****
                  ;
  
! : CONVERT       ( ud1 a1 -- ud2 a2 )
                  char+ 64 >number drop ;
  
! VARIABLE SPAN
  
  : EXPECT        ( a1 n1 -- )            \ accept the text
--- 385,404 ----
                  ;
  
! : CONVERT       ( ud1 c-addr1 -- ud2 c-addr2 )   \ ANSI       Core Ext
! \ *G ud2 is the result of converting the characters within the text beginning at the
! \ ** first character after c-addr1 into digits, using the number in BASE, and adding
! \ ** each digit to ud1 after multiplying ud1 by the number in BASE. Conversion continues
! \ ** until a character that is not convertible is encountered. c-addr2 is the location
! \ ** of the first unconverted character. An ambiguous condition exists if ud2 overflows.
! \ *P \b Note: \d This word is obsolescent and is included as a concession to existing
! \ ** implementations. Its function is superseded by >NUMBER.
                  char+ 64 >number drop ;
  
! VARIABLE SPAN   ( -- a-addr )                     \ ANSI        Core Ext
! \ *G a-addr is the address of a cell containing the count of characters stored by the
! \ ** last execution of EXPECT.
! \ *P \b Note: \d This word is obsolescent and is included as a concession to existing
! \ ** implementations.
! 
  
  : EXPECT        ( a1 n1 -- )            \ accept the text
***************
*** 794,798 ****
  \ 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 { s-adr s-len t-adr t-len \ t-buf t-str -- adr len flag }
          MAXSTRING localalloc: t-str
          s-len cell+ ALLOCATE 0=
--- 810,819 ----
  \ 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=

Index: ANSFILE.F
===================================================================
RCS file: /cvsroot/win32forth/win32forth/src/ANSFILE.F,v
retrieving revision 1.5
retrieving revision 1.6
diff -C2 -d -r1.5 -r1.6
*** ANSFILE.F	11 Aug 2006 10:09:45 -0000	1.5
--- ANSFILE.F	13 Sep 2006 09:34:57 -0000	1.6
***************
*** 84,90 ****
  
  : find-first-file ( addr1 len1 -- addr2 ior )
! \ *G Name(addr1) - null-terminated valid directory or path and filename
! \ ** len1 - length of ascii name in bytes
! \ ** addr2 - address of _win32-find-data struc
     max-path malloc dup>r
     ascii-z                                   \ adrz -
--- 84,100 ----
  
  : find-first-file ( addr1 len1 -- addr2 ior )
! \ *G addr1 len1 is a string that specifies a valid directory or path
! \ ** and filename, which can contain wildcard characters (* and ?).
! \ ** This string must not exceed MAX_PATH characters.
! \ ** addr2 is the address of the _win32-find-data structure.
! \ ** ior is 0 for success in which case _hdl-search contains a valid handle.
! \ *P Find-First-File searches a directory for a file whose name matches the
! \ ** specified filename. Find-First-File examines subdirectory names as well as filenames.
! \ *P Find-First-File opens a search handle and returns information about the first
! \ ** file whose name matches the specified pattern. Once the search handle is established, you
! \ ** can use Find-Next-File to search for other files that match the same pattern.
! \ ** When the search handle is no longer needed, close it by using Find-Close.
! \ ** Find-First-File searches for files by name only; it cannot be used for attribute-based
! \ ** searches.
     max-path malloc dup>r
     ascii-z                                   \ adrz -
***************
*** 101,105 ****
  : find-next-file ( -- addr ior )
  \ *G Find-first-file word must be called
! \ ** before this word can be called due to that _hdl-search is needed
     _win32-find-data                          \ lpffd - _WIN32_FIND_DATA
     _hdl-search @                             \ hFindFile
--- 111,115 ----
  : find-next-file ( -- addr ior )
  \ *G Find-first-file word must be called
! \ ** before this word can be called due to the fact that _hdl-search is needed
     _win32-find-data                          \ lpffd - _WIN32_FIND_DATA
     _hdl-search @                             \ hFindFile
***************
*** 217,221 ****
                  REPEAT ;
  
! : print-dir-files ( adr slen -- )
                  cr ." Directory of: " 2dup type
                  ['] _print-dir-files catch
--- 227,233 ----
                  REPEAT ;
  
! : print-dir-files ( adr slen -- ) \ W32F      Files Extra
! \ *G Print all the files and sub-directories in a directory that match a specific
! \ ** pattern.
                  cr ." Directory of: " 2dup type
                  ['] _print-dir-files catch
***************
*** 226,230 ****
                  total-file-bytes @ 1 u,.r ."  bytes of disk." ;
  
! : dir           ( -<name>- )    \ name = f.e where f or e can be ascii's, * , or ?
                  /parse-word dup c@ 0=                    \ if not spec given, use *.*
                  IF   s" *.*" pocket place
--- 238,248 ----
                  total-file-bytes @ 1 u,.r ."  bytes of disk." ;
  
! : dir           ( "name" -- )   \ W32F      Files Extra
! \ *G Print all the files and sub-directories in a directory that match a specific
! \ ** pattern. \n
! \ ** If "name" is missing or ends in \ search for all files that match *.* \n
! \ ** If "name" contains a relative path then it's relative to the current directory. \n
! \ ** If "name" ends in : assume a drive use "name"\*.* for the search pattern. \n
! \ *P The pattern can contain the standard Windows wildcards.
                  /parse-word dup c@ 0=                    \ if not spec given, use *.*
                  IF   s" *.*" pocket place