Isolating windows and some bootstrapping words.
This commit is contained in:
@ -7,3 +7,28 @@
|
||||
: transfer ( "name" ) ' context @ begin 2dup @ <> while @ >link& repeat nip
|
||||
dup @ swap dup @ >link swap ! current @ @ over >link& !
|
||||
current @ ! ;
|
||||
|
||||
( Hide some words in an internals vocabulary )
|
||||
vocabulary internals internals definitions
|
||||
transfer branch
|
||||
transfer 0branch
|
||||
transfer 'notfound
|
||||
transfer notfound
|
||||
transfer immediate?
|
||||
transfer evaluate1
|
||||
transfer 'sys
|
||||
transfer 'heap
|
||||
transfer aliteral
|
||||
transfer leaving(
|
||||
transfer )leaving
|
||||
transfer leaving
|
||||
transfer leaving,
|
||||
transfer (do)
|
||||
transfer (?do)
|
||||
transfer (+loop)
|
||||
transfer parse-quote
|
||||
transfer digit
|
||||
transfer $@
|
||||
transfer see.
|
||||
transfer see-loop
|
||||
forth definitions
|
||||
|
||||
@ -1,6 +1,8 @@
|
||||
( Arguments )
|
||||
internals
|
||||
: 'argc ( -- a ) 'sys 9 cells + ;
|
||||
: 'argv ( -- a ) 'sys 10 cells + ;
|
||||
forth
|
||||
: argc ( -- n ) 'argc @ ;
|
||||
: argv ( n -- a n ) cells 'argv @ + @ z>s ;
|
||||
|
||||
|
||||
@ -1,3 +1,5 @@
|
||||
vocabulary windows windows definitions
|
||||
|
||||
( DLL Handling )
|
||||
create calls
|
||||
' call0 , ' call1 , ' call2 , ' call3 , ' call4 , ' call5 ,
|
||||
@ -102,6 +104,8 @@ $80 constant FILE_ATTRIBUTE_NORMAL
|
||||
: d0<ior ( n -- n ior ) dup 0< ior ;
|
||||
: invalid?ior ( n -- ior ) $ffffffff = ior ;
|
||||
|
||||
forth definitions windows
|
||||
|
||||
( Generic Files )
|
||||
$80000000 constant r/o ( GENERIC_READ )
|
||||
$40000000 constant w/o ( GENERIC_WRITE )
|
||||
@ -133,3 +137,5 @@ r/o w/o or constant r/w
|
||||
|
||||
( Other Utils )
|
||||
: ms ( n -- ) Sleep ;
|
||||
|
||||
forth
|
||||
|
||||
@ -1,4 +1,5 @@
|
||||
( Words with OS assist )
|
||||
windows
|
||||
z" GetProcessHeap" 0 Kernel32 GetProcessHeap
|
||||
z" HeapAlloc" 3 Kernel32 HeapAlloc
|
||||
z" HeapFree" 3 Kernel32 HeapFree
|
||||
@ -7,3 +8,4 @@ GetProcessHeap constant process-heap
|
||||
: allocate ( n -- a ior ) process-heap 0 rot HeapAlloc dup 0= ;
|
||||
: free ( a -- ior ) process-heap 0 rot HeapFree drop 0 ;
|
||||
: resize ( a n -- a ior ) process-heap -rot 0 -rot HeapReAlloc dup 0= ;
|
||||
forth
|
||||
|
||||
Reference in New Issue
Block a user