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

Windows working.

Browse Source
This commit is contained in:
Brad Nelson
2021-01-04 20:09:33 -08:00
parent 3ccafd0825
commit 4693c30ab3
6 changed files with 120 additions and 38 deletions
Download Patch File Download Diff File Expand all files Collapse all files

5
ueforth/Makefile
View File

@ -27,6 +27,7 @@ STRIP_ARGS = -S \
LIBS=-ldl
WIN_ARCH=i686
#WIN_ARCH=x86_64
WINFLAGS = -mwindows -luser32
TARGETS = $(WEB)/terminal.html \
@ -54,11 +55,11 @@ core_test: $(POSIX)/ueforth common/core_test.fs \
$(GEN):
mkdir -p $@
POSIX_BOOT = common/boot.fs posix/posix.fs
POSIX_BOOT = common/boot.fs common/terminal.fs posix/posix.fs
$(GEN)/posix_boot.h: common/source_to_string.js $(POSIX_BOOT) | $(GEN)
echo "ok" | cat $(POSIX_BOOT) - | $< boot >$@
WINDOWS_BOOT = common/boot.fs
WINDOWS_BOOT = common/boot.fs common/terminal.fs windows/windows.fs
$(GEN)/windows_boot.h: common/source_to_string.js $(WINDOWS_BOOT) | $(GEN)
echo "ok" | cat $(WINDOWS_BOOT) - | $< boot >$@

48
ueforth/common/calling.h
View File

@ -1,20 +1,30 @@
#define CALLING_OPCODE_LIST \
X("CALL0", OP_CALL0, tos = ((cell_t (*)()) tos)()) \
X("CALL1", OP_CALL1, tos = ((cell_t (*)()) tos)(*sp); --sp) \
X("CALL2", OP_CALL2, tos = ((cell_t (*)()) tos)(sp[-1], *sp); sp -= 2) \
X("CALL3", OP_CALL3, tos = ((cell_t (*)()) tos)(sp[-2], sp[-1], *sp); sp -= 3) \
X("CALL4", OP_CALL4, tos = ((cell_t (*)()) tos)(sp[-3], sp[-2], sp[-1], \
*sp); sp -= 4) \
X("CALL5", OP_CALL5, tos = ((cell_t (*)()) tos)(sp[-4], sp[-3], sp[-2], \
sp[-1], *sp); sp -= 5) \
X("CALL6", OP_CALL6, tos = ((cell_t (*)()) tos)(sp[-5], sp[-4], sp[-3], \
sp[-2], sp[-1], *sp); sp -= 6) \
X("CALL7", OP_CALL7, tos = ((cell_t (*)()) tos)(sp[-6], sp[-5], sp[-4], \
sp[-3], sp[-2], sp[-1], *sp); sp -= 7) \
X("CALL8", OP_CALL8, tos = ((cell_t (*)()) tos)(sp[-7], sp[-6], sp[-5], \
sp[-4], sp[-3], sp[-2], sp[-1], *sp); sp -= 8) \
X("CALL9", OP_CALL9, tos = ((cell_t (*)()) tos)(sp[-8], sp[-7], sp[-6], \
sp[-5], sp[-4], sp[-3], sp[-2], sp[-1], *sp); sp -= 9) \
X("CALL10", OP_CALL10, tos = ((cell_t (*)()) tos)(sp[-9], sp[-8], sp[-7], \
sp[-6], sp[-5], sp[-4], sp[-3], sp[-2], sp[-1], *sp); sp -= 10) \
#ifndef CALLTYPE
# define CALLTYPE
#endif
#define CALLING_OPCODE_LIST \
X("CALL0", OP_CALL0, tos = ((CALLTYPE cell_t (*)()) tos) \
()) \
X("CALL1", OP_CALL1, tos = ((CALLTYPE cell_t (*)()) tos) \
(*sp); --sp) \
X("CALL2", OP_CALL2, tos = ((CALLTYPE cell_t (*)()) tos) \
(sp[-1], *sp); sp -= 2) \
X("CALL3", OP_CALL3, tos = ((CALLTYPE cell_t (*)()) tos) \
(sp[-2], sp[-1], *sp); sp -= 3) \
X("CALL4", OP_CALL4, tos = ((CALLTYPE cell_t (*)()) tos) \
(sp[-3], sp[-2], sp[-1], *sp); sp -= 4) \
X("CALL5", OP_CALL5, tos = ((CALLTYPE cell_t (*)()) tos) \
(sp[-4], sp[-3], sp[-2], sp[-1], *sp); sp -= 5) \
X("CALL6", OP_CALL6, tos = ((CALLTYPE cell_t (*)()) tos) \
(sp[-5], sp[-4], sp[-3], sp[-2], sp[-1], *sp); sp -= 6) \
X("CALL7", OP_CALL7, tos = ((CALLTYPE cell_t (*)()) tos) \
(sp[-6], sp[-5], sp[-4], sp[-3], sp[-2], sp[-1], *sp); sp -= 7) \
X("CALL8", OP_CALL8, tos = ((CALLTYPE cell_t (*)()) tos) \
(sp[-7], sp[-6], sp[-5], sp[-4], sp[-3], sp[-2], sp[-1], *sp); sp -= 8) \
X("CALL9", OP_CALL9, tos = ((CALLTYPE cell_t (*)()) tos) \
(sp[-8], sp[-7], sp[-6], sp[-5], sp[-4], sp[-3], sp[-2], \
sp[-1], *sp); sp -= 9) \
X("CALL10", OP_CALL10, tos = ((CALLTYPE cell_t (*)()) tos) \
(sp[-9], sp[-8], sp[-7], sp[-6], sp[-5], sp[-4], sp[-3], \
sp[-2], sp[-1], *sp); sp -= 10) \

16
ueforth/common/terminal.fs Normal file
View File

@ -0,0 +1,16 @@
( Terminal handling )
: n. ( n -- ) base @ swap decimal <# #s #> type base ! ;
: esc 27 emit ;
: at-xy ( x y -- ) esc ." [" 1+ n. ." ;" 1+ n. ." H" ;
: page esc ." [2J" esc ." [H" ;
: normal esc ." [0m" ;
: fg ( n -- ) esc ." [38;5;" n. ." m" ;
: bg ( n -- ) esc ." [48;5;" n. ." m" ;
: clear-to-eol esc ." [0K" ;
: scroll-down esc ." D" ;
: scroll-up esc ." M" ;
: hide esc ." [?25l" ;
: show esc ." [?25h" ;
: terminal-save esc ." [?1049h" ;
: terminal-restore esc ." [?1049l" ;

16
ueforth/posix/posix.fs
View File

@ -60,22 +60,6 @@ $100 constant O_CREAT
$200 constant O_TRUNC
$2000 constant O_APPEND
( Terminal handling )
: n. ( n -- ) base @ swap decimal <# #s #> type base ! ;
: esc 27 emit ;
: at-xy ( x y -- ) esc ." [" 1+ n. ." ;" 1+ n. ." H" ;
: page esc ." [2J" esc ." [H" ;
: normal esc ." [0m" ;
: fg ( n -- ) esc ." [38;5;" n. ." m" ;
: bg ( n -- ) esc ." [48;5;" n. ." m" ;
: clear-to-eol esc ." [0K" ;
: scroll-down esc ." D" ;
: scroll-up esc ." M" ;
: hide esc ." [?25l" ;
: show esc ." [?25h" ;
: terminal-save esc ." [?1049h" ;
: terminal-restore esc ." [?1049l" ;
( Hookup I/O )
: stdout-write ( a n -- ) stdout -rot write drop ;
' stdout-write is type

67
ueforth/windows/windows.fs Normal file
View File

@ -0,0 +1,67 @@
( DLL Handling )
create calls
' call0 , ' call1 , ' call2 , ' call3 , ' call4 , ' call5 ,
' call6 , ' call7 , ' call8 , ' call9 , ' call10 ,
: sofunc ( z n a "name" -- )
swap >r swap GetProcAddress dup 0= throw create , r> cells calls + @ ,
does> dup @ swap cell+ @ execute ;
: dll ( z "name" -- )
LoadLibraryA dup 0= throw create , does> @ sofunc ;
0 constant NULL
0 constant MB_OK
1 constant MB_OKCANCEL
2 constant MB_ABORTRETRYIGNORE
3 constant MB_YESNOCANCEL
4 constant MB_YESNO
5 constant MB_RETRYCANCEL
6 constant MB_CANCELTRYCONTINUE
-10 constant STD_INPUT_HANDLE
-11 constant STD_OUTPUT_HANDLE
-12 constant STD_ERROR_HANDLE
$0001 constant ENABLE_PROCESSED_INPUT
$0002 constant ENABLE_LINE_INPUT
$0004 constant ENABLE_ECHO_INPUT
$0008 constant ENABLE_WINDOW_INPUT
$0010 constant ENABLE_MOUSE_INPUT
$0020 constant ENABLE_INSERT_MODE
$0040 constant ENABLE_QUICK_EDIT_MODE
$0200 constant ENABLE_VIRTUAL_TERMINAL_INPUT
$0001 constant ENABLE_PROCESSED_OUTPUT
$0002 constant ENABLE_WRAP_AT_EOL_OUTPUT
$0004 constant ENABLE_VIRTUAL_TERMINAL_PROCESSING
$0008 constant DISABLE_NEWLINE_AUTO_RETURN
$0010 constant ENABLE_LVB_GRID_WORLDWIDE
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
z" ReadFile" 5 Kernel32 ReadFile
z" WriteFile" 5 Kernel32 WriteFile
z" GetConsoleMode" 2 Kernel32 GetConsoleMode
z" SetConsoleMode" 2 Kernel32 SetConsoleMode
AllocConsole drop
STD_INPUT_HANDLE GetStdHandle constant stdin
STD_OUTPUT_HANDLE GetStdHandle constant stdout
STD_ERROR_HANDLE GetStdHandle constant stderr
variable console-mode
stdout console-mode GetConsoleMode drop
stdout console-mode @ ENABLE_VIRTUAL_TERMINAL_PROCESSING or SetConsoleMode drop
: win-type ( a n -- ) stdout -rot NULL NULL WriteFile drop ;
' win-type is type
: raw-key ( -- n ) 0 >r stdin rp@ 1 NULL NULL ReadFile drop r> ;
: win-key ( -- n ) begin raw-key dup 13 = while drop repeat ;
' win-key is key
: win-bye ( -- ) 0 ExitProcess drop ;
' win-bye is bye

6
ueforth/windows/windows_main.c
View File

@ -1,5 +1,7 @@
#include "windows.h"
#define CALLTYPE WINAPI
#include "common/opcodes.h"
#include "common/calling.h"
@ -7,8 +9,10 @@
#define STACK_SIZE (16 * 1024)
#define PLATFORM_OPCODE_LIST \
X("GETPROCADDRES", OP_GETPROCADDRESS, \
X("GETPROCADDRESS", OP_GETPROCADDRESS, \
tos = (cell_t) GetProcAddress((HMODULE) *sp, (LPCSTR) tos); --sp) \
X("LOADLIBRARYA", OP_LOADLIBRARYA, \
tos = (cell_t) LoadLibraryA((LPCSTR) tos)) \
CALLING_OPCODE_LIST \
#include "common/core.h"