alx/ueforth
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Add args support for windows.

Browse Source
This commit is contained in:
Brad Nelson
2022-01-28 23:41:59 -08:00
parent 3441c0101a
commit af99eef307
9 changed files with 55 additions and 15 deletions
Download Patch File Download Diff File Expand all files Collapse all files

6
ueforth/Makefile
View File

@ -156,7 +156,7 @@ POSIX_BOOT = common/boot.fs common/conditionals.fs common/vocabulary.fs \
common/hide_calls.fs common/ansi.fs common/floats.fs \
posix/posix.fs posix/posix_highlevel.fs posix/termios.fs \
common/tasks.fs common/utils.fs common/highlevel.fs common/filetools.fs \
common/locals.fs posix/posix_desktop.fs \
common/locals.fs common/desktop.fs posix/posix_desktop.fs \
common/streams.fs common/blocks.fs \
posix/sockets.fs posix/telnetd.fs posix/httpd.fs posix/web_interface.fs \
posix/autoboot.fs \
@ -167,8 +167,10 @@ $(GEN)/posix_boot.h: common/source_to_string.js $(POSIX_BOOT) | $(GEN)
WINDOWS_BOOT = common/boot.fs common/conditionals.fs common/vocabulary.fs \
common/hide_calls.fs common/ansi.fs common/floats.fs \
windows/windows.fs windows/windows_highlevel.fs common/highlevel.fs \
common/tasks.fs common/utils.fs common/filetools.fs common/streams.fs \
common/tasks.fs common/utils.fs common/locals.fs common/desktop.fs \
common/filetools.fs common/streams.fs \
common/blocks.fs common/locals.fs \
posix/autoboot.fs \
common/fini.fs
$(GEN)/windows_boot.h: common/source_to_string.js $(WINDOWS_BOOT) | $(GEN)
$< -win boot $(VERSION) $(REVISION) $(WINDOWS_BOOT) >$@

20
ueforth/common/desktop.fs Normal file
View File

@ -0,0 +1,20 @@
\ Copyright 2021 Bradley D. Nelson
\
\ Licensed under the Apache License, Version 2.0 (the "License");
\ you may not use this file except in compliance with the License.
\ You may obtain a copy of the License at
\
\ http://www.apache.org/licenses/LICENSE-2.0
\
\ Unless required by applicable law or agreed to in writing, software
\ distributed under the License is distributed on an "AS IS" BASIS,
\ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
\ See the License for the specific language governing permissions and
\ limitations under the License.
forth definitions internals
: argc ( -- n ) 'argc @ ;
: argv ( n -- a n ) cells 'argv @ + @ z>s ;
forth

4
ueforth/common/opcodes.h
View File

@ -65,10 +65,12 @@ typedef int64_t dcell_t;
Y(OVER, DUP; tos = sp[-1]) \
Y(DROP, DROP) \
X("@", AT, tos = *(cell_t *) tos) \
X("L@", LAT, tos = *(int32_t *) tos) \
X("SL@", SLAT, tos = *(int32_t *) tos) \
X("SW@", SWAT, tos = *(int16_t *) tos) \
X("C@", CAT, tos = *(uint8_t *) tos) \
X("!", STORE, *(cell_t *) tos = *sp--; DROP) \
X("L!", LSTORE, *(int32_t *) tos = *sp--; DROP) \
X("W!", WSTORE, *(int16_t *) tos = *sp--; DROP) \
X("C!", CSTORE, *(uint8_t *) tos = *sp--; DROP) \
X("SP@", SPAT, DUP; tos = (cell_t) sp) \
X("SP!", SPSTORE, sp = (cell_t *) tos; DROP) \

4
ueforth/posix/posix.fs
View File

@ -30,7 +30,7 @@ posix
: sysfunc ( z n "name" -- ) 0 sofunc ;
: shared-library ( z "name" -- )
RTLD_NOW dlopen dup 0= throw create , does> @ sofunc ;
: sign-extend ( n -- n ) >r rp@ l@ rdrop ;
: sign-extend ( n -- n ) >r rp@ sl@ rdrop ;
( Major Syscalls )
z" open" 3 sysfunc open
@ -66,7 +66,7 @@ z" readdir" 1 sysfunc readdir
( Errno )
z" __errno_location" 0 sysfunc __errno_location
: errno ( -- n ) __errno_location l@ ;
: errno ( -- n ) __errno_location sl@ ;
( Default Pipes )
0 constant stdin

4
ueforth/posix/posix_desktop.fs
View File

@ -12,11 +12,9 @@
\ See the License for the specific language governing permissions and
\ limitations under the License.
( Arguments )
forth definitions internals
: argc ( -- n ) 'argc @ ;
: argv ( n -- a n ) cells 'argv @ + @ z>s ;
( Load Libraries )
: xlib s" posix/xlib_test.fs" included ;
forth

4
ueforth/posix/termios.fs
View File

@ -39,7 +39,7 @@ create new-termios sizeof(termios) allot
: termios! ( a -- ) stdin TCSAFLUSH rot tcsetattr throw ;
old-termios termios@
: raw-mode new-termios termios@
_ECHO ICANON or invert new-termios .c_lflag l@ and new-termios .c_lflag l!
_ECHO ICANON or invert new-termios .c_lflag sl@ and new-termios .c_lflag l!
0 VTIME new-termios .c_cc[] c!
0 VMIN new-termios .c_cc[] c!
new-termios termios! ;
@ -50,7 +50,7 @@ $5413 constant TIOCGWINSZ
4 2 * constant sizeof(winsize)
create winsize sizeof(winsize) allot
: form ( -- h w ) stdin TIOCGWINSZ winsize ioctl throw
winsize l@ dup $ffff and swap $10000 / ;
winsize sl@ dup $ffff and swap $10000 / ;
0 value pending
: termios-key? ( -- f ) pending if -1 else stdin-key to pending pending 0<> then ;

4
ueforth/posix/xlib_test.fs
View File

@ -61,8 +61,8 @@ create event xevent-size allot
event c@ MotionNotify = if ." MotionNotify" then
event c@ DestroyNotify = if ." DestroyNotify" then
event c@ ConfigureNotify = if
event 3 16 * 8 + + l@ width !
event 3 16 * 12 + + l@ height !
event 3 16 * 8 + + sl@ width !
event 3 16 * 12 + + sl@ height !
." width & height: " width @ . height @ .
." ConfigureNotify"
then

2
ueforth/site/internals.html
View File

@ -87,7 +87,7 @@ are then used to build up a small set of core opcodes defined in 1-3 lines each:
<pre>
0= 0&lt; + U/MOD */MOD AND OR XOR
LSHIFT RSHIFT DUP SWAP OVER DROP
@ L@ C@ ! L! C! SP@ SP! RP@ RP!
@ SL@ SW@ C@ ! L! W! C! SP@ SP! RP@ RP!
&gt;R R&gt; R@ : ; EXIT
EXECUTE BRANCH 0BRANCH DONEXT DOLIT
ALITERAL CELL DOES&gt; IMMEDIATE 'SYS

22
ueforth/windows/windows.fs
View File

@ -59,6 +59,7 @@ z" User32.dll" dll User32
z" MessageBoxA" 4 User32 MessageBoxA
z" Kernel32.dll" dll Kernel32
z" AllocConsole" 0 Kernel32 AllocConsole
z" ExitProcess" 1 Kernel32 ExitProcess
z" GetStdHandle" 1 Kernel32 GetStdHandle
@ -80,6 +81,24 @@ z" SetFilePointer" 4 Kernel32 SetFilePointer
z" SetEndOfFile" 1 Kernel32 SetEndOfFile
z" GetFileSize" 2 Kernel32 GetFileSize
z" GetCommandLineW" 0 Kernel32 GetCommandLineW
z" Shell32.dll" dll Shell32
z" CommandLineToArgvW" 2 Shell32 CommandLineToArgvW
variable wargc variable wargv
GetCommandLineW wargc CommandLineToArgvW wargv !
: wz>sz ( a -- a n )
here swap begin dup sw@ 0<> while dup sw@ c, 2 + repeat drop 0 c, align ;
: wargs-convert ( dst )
wargv @ wargc @ for aft
dup @ wz>sz >r swap r> over ! cell+ swap cell+
then next 2drop ;
also internals
wargc @ 'argc !
here 'argv ! wargc @ cells allot
'argv @ wargs-convert
AllocConsole drop
STD_INPUT_HANDLE GetStdHandle constant stdin
STD_OUTPUT_HANDLE GetStdHandle constant stdout
@ -157,8 +176,7 @@ r/o w/o or constant r/w
( Other Utils )
: ms ( n -- ) Sleep ;
forth
only forth
( Setup entry )
internals : ok ." uEforth" raw-ok ; forth
' forth ( leave on stack for fini.fs )