Windows working.

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 >$@
 

ueforth/common/calling.h

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

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" ;
+

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

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
+

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"