diff --git a/ueforth/Makefile b/ueforth/Makefile index 13613e0..4a976aa 100644 --- a/ueforth/Makefile +++ b/ueforth/Makefile @@ -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 >$@ diff --git a/ueforth/common/calling.h b/ueforth/common/calling.h index 1a6b21b..2349165 100644 --- a/ueforth/common/calling.h +++ b/ueforth/common/calling.h @@ -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) \ diff --git a/ueforth/common/terminal.fs b/ueforth/common/terminal.fs new file mode 100644 index 0000000..afcebf7 --- /dev/null +++ b/ueforth/common/terminal.fs @@ -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" ; + diff --git a/ueforth/posix/posix.fs b/ueforth/posix/posix.fs index 5271646..bcfa0d6 100644 --- a/ueforth/posix/posix.fs +++ b/ueforth/posix/posix.fs @@ -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 diff --git a/ueforth/windows/windows.fs b/ueforth/windows/windows.fs new file mode 100644 index 0000000..e01d867 --- /dev/null +++ b/ueforth/windows/windows.fs @@ -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 + diff --git a/ueforth/windows/windows_main.c b/ueforth/windows/windows_main.c index 9ea758f..9f36846 100644 --- a/ueforth/windows/windows_main.c +++ b/ueforth/windows/windows_main.c @@ -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"