Thread: [Win32forth-cvs] win32forth-stc/src ANSFILE.F, 1.1, 1.2 primutil.f, 1.4, 1.5 task.f, 1.1, 1.2

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

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

Modified Files:
	ANSFILE.F primutil.f task.f 
Log Message:
gah:Added to primutils words for multi-tasker and got task working.Newest version of Ansfile.

Index: task.f
===================================================================
RCS file: /cvsroot/win32forth/win32forth-stc/src/task.f,v
retrieving revision 1.1
retrieving revision 1.2
diff -C2 -d -r1.1 -r1.2
*** task.f	21 Sep 2006 16:26:33 -0000	1.1
--- task.f	25 Sep 2006 11:57:53 -0000	1.2
***************
*** 19,27 ****
  \ -------------------- Task Start Initialisation --------------------

! 1 proc ExitThread \ as exit-task     ( n -- )     \ exit the thread

  : (task)        ( parm cfa -- )                 \ helper routine
                  catch                           \ execute cfa and catch errors gah 27nov03
!                 call ExitThread                       \ and exit the thread, never returns
                  ;

--- 19,27 ----
  \ -------------------- Task Start Initialisation --------------------

! 1 proc ExitThread  as exit-task     ( n -- )     \ exit the thread

  : (task)        ( parm cfa -- )                 \ helper routine
                  catch                           \ execute cfa and catch errors gah 27nov03
!                 Exit-Task                       \ and exit the thread, never returns
                  ;

***************
*** 32,43 ****
                  push    esi
                  mov     ebp, esp
                  call    ' task-entry            \ setup stacks, error-handler etc (in kernel)
!                 mov     ecx, 5 cells [ebp]      \ get task block
                  mov     TCB [UP] , ecx          \ save in TCB
!                 mov     ebx, 4 [ecx]            \ parameter
!                 mov     -4 [ebp], ebx           \ save it
                  lea     ebp, -4 [ebp]
                  mov     eax, 0 [ecx]            \ cfa = tos
!                 jmp     [dword] ' (task)        \ get helper entry point
                  next    c;

--- 32,44 ----
                  push    esi
                  mov     ebp, esp
+                 mov     esi, esp
                  call    ' task-entry            \ setup stacks, error-handler etc (in kernel)
!                 mov     ecx, 5 cells [esi]      \ get task block
                  mov     TCB [UP] , ecx          \ save in TCB
!                 mov     edx, 4 [ecx]            \ parameter
!                 mov     -4 [ebp], edx           \ save it
                  lea     ebp, -4 [ebp]
                  mov     eax, 0 [ecx]            \ cfa = tos
!                 jmp     ' (task)                \ get helper entry point
                  next    c;

***************
*** 51,55 ****
                  swap ( CREATE_SUSPENDED | 0  )  \ run it later? from state on stack
                  r@                              \ parameter (ptr to cfa/parm pair)
!                 begin-task                      \ task entry code
                  0 0                             \ stack, thread attributes
                  call CreateThread dup
--- 52,56 ----
                  swap ( CREATE_SUSPENDED | 0  )  \ run it later? from state on stack
                  r@                              \ parameter (ptr to cfa/parm pair)
!                 ['] begin-task                      \ task entry code
                  0 0                             \ stack, thread attributes
                  call CreateThread dup
***************
*** 175,178 ****
--- 176,183 ----
  \ forgotten to avoid CRASHING !! YOU HAVE BEEN WARNED

+ module
+ 
+ \s
+ 
  in-system
  \s

Index: primutil.f
===================================================================
RCS file: /cvsroot/win32forth/win32forth-stc/src/primutil.f,v
retrieving revision 1.4
retrieving revision 1.5
diff -C2 -d -r1.4 -r1.5
*** primutil.f	24 Sep 2006 08:42:06 -0000	1.4
--- primutil.f	25 Sep 2006 11:57:53 -0000	1.5
***************
*** 201,208 ****

! \ needed by ansfile; uncomment \s to load ansfile (I tested it at home with my own
! \ primutil.f and hopefully merged everything correctly but can't test @ work so any
! \ other corrections will have to wait til mon 23/9/6 gah.
! \ It's seem's to work for me, so I have added ansfile.f to the CVS (Sonntag, September 24 2006 dbu)

  \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
--- 201,205 ----

! \ needed by ansfile.

  \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
***************
*** 250,251 ****
--- 247,284 ----
                  st1 count st2 count compare ;

+ \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
+ \       Locking for Windows
+ \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
+ 
+ defer (controllock)
+ defer (controlunlock)
+ defer (dialoglock)
+ defer (dialogunlock)
+ defer (classnamelock)
+ defer (classnameunlock)
+ defer (pointerlock)
+ defer (pointerunlock)
+ defer (dynlock)
+ defer (dynunlock)
+ 
+ : init-system-locks-off ( -- )
+ \ *G Set all the system deferred words for locking to noops. This is done automatically
+ \ ** by the system at start-up so code that uses it will work correctly before the locks
+ \ ** are initialised.
+      ['] noop is (controllock)
+      ['] noop is (controlunlock)
+      ['] noop is (dialoglock)
+      ['] noop is (dialogunlock)
+      ['] noop is (classnamelock)
+      ['] noop is (classnameunlock)
+      ['] noop is (pointerlock)
+      ['] noop is (pointerunlock)
+      ['] noop is (dynlock)
+      ['] noop is (dynunlock)
+ ;
+ 
+ init-system-locks-off
+ 
+ initialization-chain chain-add init-system-locks-off
+ 
+ \s

Index: ANSFILE.F
===================================================================
RCS file: /cvsroot/win32forth/win32forth-stc/src/ANSFILE.F,v
retrieving revision 1.1
retrieving revision 1.2
diff -C2 -d -r1.1 -r1.2
*** ANSFILE.F	24 Sep 2006 08:42:06 -0000	1.1
--- ANSFILE.F	25 Sep 2006 11:57:52 -0000	1.2
***************
*** 1,4 ****
--- 1,8 ----
  \ $Id$

+ \ *D doc
+ \ *! p-ansfile W32F ansfile
+ \ *T File and directory searching words.
+ 
  \ *P These words are extensions to the ANSI file words for finding files.
  \ The ANSI words are defined in the kernel.
***************
*** 28,31 ****
--- 32,37 ----
  2 PROC FileTimeToSystemTime

+ \ *S Glossary
+ 
  cell newuser _hdl-search ( -- addr )
  \ *G Variable holding handle.
***************
*** 108,112 ****
     r> release ;                              \ free buff

- 
  : find-next-file ( -- addr ior )
  \ *G Find-first-file word must be called
--- 114,117 ----
***************
*** 118,122 ****
     swap 0= ;                                 \ adrd ior - 0 = success

- 
  : find-close ( -- ior )
  \ *G Close the _hdl-search handle.
--- 123,126 ----
***************
*** 135,168 ****

  : get-DOS-create-datetime ( -- ;convert 64 bit file time to MS_DOS )
! \ date and time values
! \ need to call find-first-file or find-next-file word
! \ before using this word
     1 (DOSTime) ;

  : get-DOS-access-datetime ( -- ;convert 64 bit file time to MS_DOS )
! \ date and time values
! \ need to call find-first-file or find-next-file word
! \ before using this word
     3 (DOSTime) ;

  : get-DOS-write-datetime ( -- ;convert 64 bit file time to MS_DOS )
! \ date and time values
! \ need to call find-first-file or find-next-file word
! \ before using this word
     5 (DOSTime) ;

! : get-file-size ( -- size )
! \ need to call find-first-file or find-next-file word
! \ before using this word
     _win32-find-data 8 cells+ @ ;

  : get-file-name ( -- adr; address for file name )
! \ need to call find-first-file or find-next-file word
! \ before using this word
     _win32-find-data 11 cells+ ;

  : dir-attribute?  ( - flag )
  \ *G Returns true when a file is a directory. \n
! \ ** Need to call find-first-file or find-next-file word before using this word. \n
  \ ** Can be used in combination with ForAllFileNames
          _win32-find-data @ FILE_ATTRIBUTE_DIRECTORY and ;
--- 139,175 ----

  : get-DOS-create-datetime ( -- ;convert 64 bit file time to MS_DOS )
! \ *G Date and time values of creation. \n
! \ ** You need to call find-first-file or find-next-file word in the current task
! \ ** before using this word.
     1 (DOSTime) ;

  : get-DOS-access-datetime ( -- ;convert 64 bit file time to MS_DOS )
! \ *G date and time values of last access. \n
! \ ** You need to call find-first-file or find-next-file word in the current task
! \ ** before using this word.
     3 (DOSTime) ;

  : get-DOS-write-datetime ( -- ;convert 64 bit file time to MS_DOS )
! \ *G Date and time values of last write. \n
! \ ** You need to call find-first-file or find-next-file word in the current task
! \ ** before using this word.
     5 (DOSTime) ;

! : get-file-size ( -- size )  \ W32F               Files Extra
! \ *G Size of the last found file. \n
! \ ** You need to call find-first-file or find-next-file word in the current task
! \ ** before using this word.
     _win32-find-data 8 cells+ @ ;

  : get-file-name ( -- adr; address for file name )
! \ *G get the name of the last found file. \n
! \ ** You need to call find-first-file or find-next-file word in the current task
! \ ** before using this word.
     _win32-find-data 11 cells+ ;

  : dir-attribute?  ( - flag )
  \ *G Returns true when a file is a directory. \n
! \ ** You need to call find-first-file or find-next-file word in the current task
! \ ** before using this word. \n
  \ ** Can be used in combination with ForAllFileNames
          _win32-find-data @ FILE_ATTRIBUTE_DIRECTORY and ;
***************
*** 202,206 ****

  : dir->file-name ( -- adr count )
! \ *G Returns the adres and count of a file in a directory. \n
  \ ** Need to call find-first-file or find-next-file word before using this word. \n
  \ ** Can be used in combination with ForAllFileNames
--- 209,213 ----

  : dir->file-name ( -- adr count )
! \ *G Returns the address and count of a file in a directory. \n
  \ ** Need to call find-first-file or find-next-file word before using this word. \n
  \ ** Can be used in combination with ForAllFileNames
***************
*** 254,257 ****
--- 261,266 ----
                  then ;

+ dpr-warning? dpr-warning-off checkstack
+ 
  : _print-dir-files ( adr slen -- )
                  0 total-file-bytes !
***************
*** 270,273 ****
--- 279,284 ----
                  REPEAT ; deprecated

+ to dpr-warning?
+ 
  : .file-size-name  ( adr len - )
  \ *G Print the size or directory indication and the name of file.
***************
*** 295,307 ****
  \ *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
!                 THEN dup count + 1- c@ ':' =         \ if just a drive, add \
                  IF   s" \"   pocket +place
!                 THEN dup count + 1- c@ '\' =         \ if it ends in a \, add *.*
                  IF   s" *.*" pocket +place
                  THEN count print-dir-files ;
--- 306,319 ----
  \ *G Print all the files and sub-directories in a directory that match a specific
  \ ** pattern. \n
! \ ** If "name" is missing or ends in \ or / 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
!                 THEN dup count + 1- c@ [char] : =     \ if just a drive, add \
                  IF   s" \"   pocket +place
!                 THEN dup count + 1- c@ dup [char] \ = \ if it ends in a \,
!                      swap [char] / = or               \ or a /, add *.*
                  IF   s" *.*" pocket +place
                  THEN count print-dir-files ;
***************
*** 309,314 ****
  : do-rename-afile { RenamePart1$ RenamePart2$ \ RenameTemp$ -- } \ rename one file
                  MAXSTRING LocalAlloc: RenameTemp$
!                 _win32-find-data 11 CELLS+                      \ adrz
!                 zcount                                          \ adrz -- adr len
                  2dup 2dup RenamePart1$ count caps-search
                  IF      2dup 2>r nip -              RenameTemp$  place \ leading part
--- 321,325 ----
  : do-rename-afile { RenamePart1$ RenamePart2$ \ RenameTemp$ -- } \ rename one file
                  MAXSTRING LocalAlloc: RenameTemp$
!                 dir->file-name
                  2dup 2dup RenamePart1$ count caps-search
                  IF      2dup 2>r nip -              RenameTemp$  place \ leading part

Thread: [Win32forth-cvs] win32forth-stc/src ANSFILE.F, 1.1, 1.2 primutil.f, 1.4, 1.5 task.f, 1.1, 1.2

win32forth-cvs