Builders for OFW on Windows32 and Window64

Previously, OFW extensions were only built for ESP8266.
This patch adds ofw-windows32 and ofw-windows64 targets
that run under Windows with OFW extensions.

11 files changed, 472 insertions, 33 deletions

diff --git a/build/ofw-windows32/Makefile b/build/ofw-windows32/Makefile
index e81074b..4cb0542 100644
--- a/build/ofw-windows32/Makefile
+++ b/build/ofw-windows32/Makefile
@@ -4,7 +4,7 @@ all: default
 
 TOPDIR=../..
 PREFIX += CBP=$(realpath $(TOPDIR)/src)
-PREFIX += BP=$(realpath $(TOPDIR)/../../svn/openfirmware)
+PREFIX += BP=$(realpath $(TOPDIR)/../openfirmware)
 CC = gcc
 
 CONFIG += -DBITS32 -m32
diff --git a/build/ofw-windows64/Makefile b/build/ofw-windows64/Makefile
index d880556..db2890d 100644
--- a/build/ofw-windows64/Makefile
+++ b/build/ofw-windows64/Makefile
@@ -4,7 +4,7 @@ all: default
 
 TOPDIR=../..
 PREFIX += CBP=$(realpath $(TOPDIR)/src)
-PREFIX += BP=$(realpath $(TOPDIR)/../../svn/openfirmware)
+PREFIX += BP=$(realpath $(TOPDIR)/../openfirmware)
 CC = gcc
 
 CONFIG += -DBITS64 -m64
diff --git a/src/app/ofw/app.fth b/src/app/ofw/app.fth
new file mode 100644
index 0000000..a59896a
--- /dev/null
+++ b/src/app/ofw/app.fth
@@ -0,0 +1,31 @@
+\ Load file for application-specific Forth extensions
+
+fl ../../lib/misc.fth
+fl ../../lib/dl.fth
+fl ../../lib/random.fth
+fl ../../lib/ilog2.fth
+fl ../../lib/tek.fth
+
+fl ../../cforth/printf.fth
+
+: .commit  ( -- )  'version cscount type  ;
+
+: .built  ( -- )  'build-date cscount type  ;
+
+: banner  ( -- )
+   cr ." CForth built " .built
+   ."  from " .commit
+   cr
+;
+
+\ Replace 'quit' to make CForth auto-run some application code
+\ instead of just going interactive.
+: app  banner  hex  quit  ;
+
+alias id: \
+
+\ Open Firmware stuff; omit if you don't need it
+fl ${CBP}/ofw/loadofw.fth      \ Mostly platform-independent
+fl ofw-rootnode.fth \ ESP8266-specific
+
+" app.dic" save
diff --git a/src/app/ofw/extend-win32.c b/src/app/ofw/extend-win32.c
new file mode 100644
index 0000000..49de48d
--- /dev/null
+++ b/src/app/ofw/extend-win32.c
@@ -0,0 +1,151 @@
+#include <stdio.h>
+#include <windows.h>
+#ifndef _WIN32_IE
+#define _WIN32_IE	0x0400
+#endif
+#include "forth.h"
+
+cell open_file(cell stradr)          // Open file
+{
+    char *name = (char *)stradr;
+    HANDLE hFile;
+
+    printf("name %s %s\n", stradr, name);
+    hFile = CreateFileA(name,
+                    GENERIC_READ | GENERIC_WRITE, 0, 0,
+                    OPEN_EXISTING,
+                    FILE_ATTRIBUTE_NORMAL,
+                    0);
+    if (hFile == INVALID_HANDLE_VALUE)
+        printf("Error %d\n", GetLastError());
+    return (cell)hFile;
+}
+
+void rename_file(cell new, cell old)
+{
+    MoveFile((LPCSTR)old, (LPCSTR)new);
+}
+
+void close_file(cell handle)
+{
+    CloseHandle((HANDLE)handle);
+}
+
+cell write_file(cell handle, cell len, cell buffer)
+{
+    DWORD actual;
+    (void)WriteFile((HANDLE)handle, (LPCVOID)buffer, (DWORD)len,
+                    (LPDWORD) &actual, NULL);
+    return actual;
+}
+
+cell read_file(cell handle, cell len, cell buffer)
+{
+    DWORD actual;
+    BOOL ret;
+    ret = ReadFile((HANDLE)handle, (LPVOID)buffer, (DWORD)len,
+                    &actual, NULL);
+    return actual;
+}
+
+#define WINDOWS_TICK 10000000
+#define SEC_TO_UNIX_EPOCH 11644473600LL
+static unsigned WindowsTickToUnixSeconds(long long windowsTicks)
+{
+     return (unsigned)(windowsTicks / WINDOWS_TICK - SEC_TO_UNIX_EPOCH);
+}
+
+cell file_date(cell stradr)
+{
+    WIN32_FIND_DATA ffd;
+    if (FindFirstFile((LPCTSTR)stradr, &ffd)
+	== INVALID_HANDLE_VALUE) {
+	return -1;
+    }
+
+    PFILETIME mtime = &ffd.ftLastWriteTime;
+    long long wintime = ((long long)mtime->dwHighDateTime << 32) |
+	mtime->dwLowDateTime;
+
+    return WindowsTickToUnixSeconds(wintime);
+}
+
+
+cell
+ms(cell nms)
+{
+    Sleep((DWORD)(unsigned)nms);
+}
+
+// Adapted from src/win32/usleep.c in the Extended Module Player source
+cell us(cell nus)
+{
+    LARGE_INTEGER lFrequency;
+    LARGE_INTEGER lEndTime;
+    LARGE_INTEGER lCurTime;
+
+    QueryPerformanceFrequency (&lFrequency);
+    if (lFrequency.QuadPart) {
+	QueryPerformanceCounter (&lEndTime);
+	lEndTime.QuadPart += (LONGLONG) nus * lFrequency.QuadPart / 1000000;
+	do {
+	    QueryPerformanceCounter (&lCurTime);
+	    Sleep(0);
+	} while (lCurTime.QuadPart < lEndTime.QuadPart);
+    }
+}
+
+cell get_msecs(void)
+{
+    FILETIME time;
+    GetSystemTimeAsFileTime(&time);
+    ULARGE_INTEGER ltime;
+    ltime.u.LowPart = time.dwLowDateTime;
+    ltime.u.HighPart = time.dwHighDateTime;
+    ltime.QuadPart /= 10000;  // 100 nsec to msec
+    return (cell)ltime.QuadPart;
+
+//    MMTIME mmt;
+//    timeGetSystemTime(&mmt, sizeof(mmt));
+//    return mmt.u.ms;
+}
+
+cell version_adr(void)
+{
+    extern char version[];
+    return (cell)version;
+}
+
+cell build_date_adr(void)
+{
+    extern char build_date[];
+    return (cell)build_date;
+}
+
+#include <time.h>
+struct tm *calendar_time()
+{
+    time_t t;
+    (void)time(&t);
+    return gmtime(&t);
+}
+
+cell ((* const ccalls[])()) = {
+  // OS-independent functions
+  C(ms)                //c ms             { i.ms -- }
+  C(get_msecs)         //c get-msecs      { -- i.ms }
+  C(us)                //c us             { i.microseconds -- }
+
+  C(open_file)         //c h-open-file    { $.name -- i.handle }
+  C(close_file)        //c h-close-handle { i.handle -- }
+  C(write_file)        //c h-write-file   { a.buf i.len i.handle -- i.actual }
+  C(read_file)         //c h-read-file    { a.buf i.len i.handle -- i.actual }
+
+  C(rename_file)       //c rename-file    { $.old $.new -- }
+  C(file_date)         //c file-date      { $.name -- i.unixtime }
+
+  C(build_date_adr)   //c 'build-date     { -- a.value }
+  C(version_adr)      //c 'version        { -- a.value }
+
+  C(calendar_time)    //c 'calendar-time  { -- a.tmstruct }
+};
diff --git a/src/app/ofw/ofw-rootnode.fth b/src/app/ofw/ofw-rootnode.fth
new file mode 100644
index 0000000..de2c66d
--- /dev/null
+++ b/src/app/ofw/ofw-rootnode.fth
@@ -0,0 +1,229 @@
+\ Platform-specific Open Firmware driver
+
+$200 constant pagesize
+
+: ram-range  ( -- start end )  origin pagesize round-down  rp0 @ pagesize round-up  ;
+
+fload ${BP}/ofw/core/memops.fth		\ Call memory node methods
+
+\ The ESP8266 RTC is just a counter
+
+: time&date  ( -- sec min hr dy mth yr )
+   'calendar-time   ( adr )
+   6 0  do  dup @ swap na1+  loop  ( sec min hr dy mth yr-1900 adr' )
+   drop  #1900 +    ( sec min hr dy mth yr )
+;
+: now  ( -- s m h )  time&date 3drop  ;
+: today  ( -- d m y )  time&date >r >r >r  3drop r> r> r>  ;
+
+[ifdef] ext2fs-support
+\needs unix-seconds>  fload ${BP}/ofw/fs/unixtime.fth	\ Unix time calculation
+\needs ($crc16)       fload ${BP}/forth/lib/crc16.fth
+support-package: ext2-file-system
+   fload ${CBP}/ofw/fs/ext2fs/ext2fs.fth	\ Linux file system
+end-support-package
+[then]
+
+[ifdef] ntfs-support
+support-package: nt-file-system
+   fload ${BP}/ofw/fs/ntfs/loadpkg.fth	\ NT file system reader
+end-support-package
+[then]
+
+[ifdef] ufs-support
+support-package: ufs-file-system
+   fload ${BP}/ofw/fs/ufs/loadpkg.fth	\ Unix file system
+end-support-package
+[then]
+
+[ifdef] zipfs-support
+support-package: zip-file-system
+   fload ${BP}/ofw/fs/zipfs.fth		\ Zip file system
+end-support-package
+[then]
+
+support-package: fat-file-system
+   fload ${CBP}/ofw/fs/fatfs/loadpkg.fth	\ FAT file system reader
+end-support-package
+
+support-package: disk-label
+   fload ${CBP}/ofw/disklabel/loadpkg.fth	\ Disk label package
+end-support-package
+
+fload ${BP}/ofw/fs/fatfs/fdisk2.fth	\ Partition map administration
+
+6 buffer: mac-addr
+1 value wifi#
+: system-mac-address  ( -- adr 6 )  " "(01 02 03 04 05 06)"  ;
+
+0 [if]
+def-load-base ' load-base set-config-int-default
+
+true ' fcode-debug? set-config-int-default
+\ false  ' auto-boot?    set-config-int-default
+
+" com1" ' output-device set-config-string-default
+" com1" ' input-device set-config-string-default
+[then]
+
+0 value load-limit	\ Top address of area at load-base
+
+
+
+: root-map-in  ( phys len -- virt )  drop  ;  \ Physical addressing
+: root-map-out  ( virt len -- )  2drop  ;
+
+fl ${BP}/ofw/core/memlist.fth     \ Resource list common routines
+fl ${BP}/ofw/core/showlist.fth
+
+dev /
+extend-package
+
+1 " #address-cells" integer-property
+1 " #size-cells" integer-property
+
+" PC" model
+" Windows PC" encode-string  " architecture" property
+" PC" encode-string  " banner-name" property
+
+hex
+
+\ Static methods
+: decode-unit  ( adr len -- phys )  push-hex  $number  if  0  then  pop-base  ;
+: encode-unit  ( phys -- adr len )  push-hex  (u.)  pop-base  ;
+
+\ Not-necessarily-static methods
+: open  ( -- true )  true  ;
+: close  ( -- )  ;
+
+: map-in   ( phys size -- virt )  drop  ;
+: map-out  ( virtual size -- )  2drop  ;
+
+: dma-range  ( -- start end )  ram-range  ;
+
+\ Used with "find-node" to locate a physical memory node containing
+\ enough memory in the DMA range.
+\ We first compute the intersection between the memory piece and the
+\ range reachable by DMA.  If the regions are disjoint, then ok-high
+\ will be (unsigned) less than ok-low.  We then subtract ok-low from
+\ ok-high to give the (possibly negative) size of the intersection.
+: in-range?  ( size mem-low mem-high range-low range-high -- flag )
+   rot umin -rot              ( size min-high mem-low mem-high )
+   umax                       ( size min-high max-low )
+   - <=                       ( flag )
+;
+
+: dma-ok?  ( size node-adr -- size flag )
+   node-range				 ( size mem-adr mem-len )
+   over +                                ( size mem-adr mem-end )
+
+   3dup dma-range in-range?  if          ( size mem-adr mem-end )
+      2drop true exit                    ( size true )
+   then                                  ( size mem-adr mem-end )
+
+   2drop false                           ( size false )
+;
+
+
+\ Find an available physical address range suitable for DMA.  This word
+\ doesn't actually claim the memory (that is done later), but simply locates
+\ a suitable range that can be successfully claimed.
+: find-dma-address  ( size -- true | adr false )
+   " physavail" memory-node @ $call-method  	( list )
+   ['] dma-ok?  find-node is next-node  drop	( size' )
+   next-node 0=  if  drop true exit  then	( size' )
+   next-end                                     ( size mem-end )
+   dma-range                                    ( size mem-end range-l,h )
+   nip umin  swap -   false		        ( adr false )
+;
+
+: dma-alloc  ( size -- virt )
+   pagesize round-up                            ( size' )
+
+   \ Locate a suitable physical range
+   dup  find-dma-address  throw			( size' phys )
+
+   \ Claim it
+   over 0  mem-claim				( size' phys )
+
+   nip                                          ( addr )
+;
+warning off
+
+: dma-free  ( virt size -- )
+   pagesize round-up				( virt size' )
+   mem-release					( )
+;
+
+: dma-map-in  ( virt size cache? -- phys )
+   2drop    \ There is no data cache and virt==phys
+;
+: dma-map-out  ( virt phys size -- )  3drop  ;
+: dma-sync     ( virt phys size -- )  3drop  ;
+: dma-push     ( virt phys size -- )  3drop  ;
+: dma-pull     ( virt phys size -- )  3drop  ;
+warning on
+
+finish-device
+
+device-end
+headerless
+
+fl ${BP}/ofw/core/clntphy1.fth
+fl ${BP}/ofw/core/allocph1.fth
+fl ${BP}/ofw/core/availpm.fth
+
+: (memory?)  ( padr -- flag )  ram-range within  ;
+' (memory?) to memory?
+
+\ Call this after the system-mac-address is determined, which is typically
+\ done near the end of the probing process.
+: set-system-id  ( -- )
+   system-mac-address  dup  if        ( adr 6 )
+      " /" find-device                ( adr 6 )
+
+      \ Convert the six bytes of the MAC address into a string of the
+      \ form 0NNNNNNNNNN, where N is an uppercase hex digit.
+      push-hex                        ( adr 6 )
+
+      <#  bounds  swap 1-  ?do        ( )
+         i c@  u# u#  drop            ( )
+      -1 +loop                        ( )
+      0 u# u#>                        ( adr len )
+
+      2dup upper                      ( adr len )  \ Force upper case
+
+      pop-base                        ( adr len )
+
+      encode-string  " system-id"  property   ( )
+
+      device-end
+   else
+      2drop
+   then
+;
+headers
+
+\ End of rootnode stuff
+
+support-package: dropin-file-system
+   fload ${BP}/ofw/fs/dropinfs.fth	\ Dropin file system
+end-support-package
+
+" /openprom" find-device
+   " MitchBradley,3.0" encode-string " model" property
+device-end
+
+fl ${CBP}/ofw/filenv.fth
+
+: install-options  ( -- )
+   " /file-nvram" open-dev  to nvram-node
+   nvram-node 0=  if
+      ." The configuration EEPROM is not working" cr
+   then
+   config-valid?  if  exit  then
+   ['] init-config-vars catch drop
+;
+stand-init: Pseudo-NVRAM
+   install-options
+;
diff --git a/src/app/ofw/targets.mk b/src/app/ofw/targets.mk
new file mode 100644
index 0000000..9e54471
--- /dev/null
+++ b/src/app/ofw/targets.mk
@@ -0,0 +1,46 @@
+# For building a host Forth application with serial port tools
+
+default: app.dic
+
+# Application code directory - i.e. this directory
+APPPATH=$(TOPDIR)/src/app/ofw
+
+# APPLOADFILE is the top-level "Forth load file" for the application code.
+APPLOADFILE = app.fth
+
+# APPSRCS is a list of Forth source files for dependency checking
+APPSRCS = $(APPPATH)/app.fth
+
+HOSTOBJS += date.o
+
+SRC=$(TOPDIR)/src
+include $(SRC)/common.mk
+include $(SRC)/cforth/targets.mk
+
+ifeq ($(OS),Windows_NT)
+  API = win32
+else
+  UNAME_S := $(shell uname -s)
+ifeq ($(UNAME_S),Darwin)
+	API = posix
+ else
+	API = posix
+endif
+endif
+
+# EXTENDSRC is the source file for extensions; it is compiled to extend.o
+EXTENDSRC = $(APPPATH)/extend-$(API).c
+
+VPATH += $(APPPATH)
+INCS += -I$(APPPATH)
+
+VPATH += $(TOPDIR)/src/lib
+INCS += -I$(TOPDIR)/src/lib
+
+HOSTOBJS += $(MYOBJS)
+
+forth: $(MYOBJS)
+extend.o: $(EXTENDSRC)
+
+app.dic:  forth forth.dic $(APPSRCS)
+	$(PREFIX) ./forth forth.dic ccalls.fth $(GCALLS) $(APPPATH)/$(APPLOADFILE)
diff --git a/src/cforth/decompm.fth b/src/cforth/decompm.fth
index 925cfa8..ee87866 100755
--- a/src/cforth/decompm.fth
+++ b/src/cforth/decompm.fth
@@ -86,7 +86,9 @@ alias rslist 2drop
 : unbug 0 <ip !  ;
 
 : unaligned-w@  dup c@ swap 1+ c@ bwjoin   ;
+: unaligned-w!  ( w adr -- )  >r wbsplit  r@ 1+ c!  r> c!  ;
 : unaligned-l@  >r r@ c@  r@ 1+ c@  r@ 2+ c@  r> 3 + c@  bljoin ;
+: unaligned-l!  ( l adr -- )  >r lwsplit  r@ 2+ unaligned-w!  r> unaligned-w! ;
 : unaligned-@  unaligned-l@  ;
 : d@ 2@ ;
 [ifdef] notdef
diff --git a/src/cforth/printf.fth b/src/cforth/printf.fth
index 6db000a..e1cd4af 100644
--- a/src/cforth/printf.fth
+++ b/src/cforth/printf.fth
@@ -10,25 +10,7 @@ purpose: printf and sprintf
    drop
 ;
 
-\ text$ means ( text-adr text-len )
-0 value delim
-
-\ lex scans text$ for each character in delim$
-\ when one is found, lex splits text$ at that delimiter and leaves
-: lex   ( text$ delim$ -- rem$ head$ delim true | text$ false )
-   0 is delim
-   2over bounds ?do                     ( text$ delim$ )
-      2dup i c@ cindex if               ( text$ delim$ [ index ] )
-         nip nip c@  dup is delim       ( text$ delim )
-         left-parse-string  leave       ( rem$ head$ )
-      then                              ( text$ delim$ | rem$ head$ )
-   loop                                 ( text$ delim$ | rem$ head$ )
-   delim if
-      delim true
-   else
-      2drop false
-   then
-;
+\needs lex fl ../lib/lex.fth
 
 d# 1024 buffer: spbuf
 0 value splen
diff --git a/src/lib/misc.fth b/src/lib/misc.fth
index 497329b..1910e54 100644
--- a/src/lib/misc.fth
+++ b/src/lib/misc.fth
@@ -32,10 +32,6 @@
 : be-w!   ( w adr -- )   2dup 1+ c!  swap 8 rshift swap c!  ;
 [then]
 
-[ifndef] lbflip
-: lbflip  ( l -- l )  lbsplit  swap 2swap swap bljoin  ;
-[then]
-
 [ifndef] comp
 : comp  ( adr1 adr2 len -- diff )  tuck compare  ;
 [then]
diff --git a/src/ofw/loadofw.fth b/src/ofw/loadofw.fth
index b905129..f93d376 100644
--- a/src/ofw/loadofw.fth
+++ b/src/ofw/loadofw.fth
@@ -29,7 +29,6 @@ fl ${CBP}/ofw/core/deblock.fth
 fl ${BP}/forth/lib/seechain.fth
 
 fl ../lib/stringar.fth
-fl ../lib/lex.fth
 
 \ : fl parse-word 2dup type space included ;
 \ alias fload fl
diff --git a/src/ofw/ofw-support.fth b/src/ofw/ofw-support.fth
index 6ef80fc..f34d5b1 100644
--- a/src/ofw/ofw-support.fth
+++ b/src/ofw/ofw-support.fth
@@ -82,13 +82,13 @@ alias do-is (to)
 : wpoke  ( w adr -- okay? )  w! true  ;
 : lpoke  ( l adr -- okay? )  l! true  ;
 
-: wbflip  ( w -- w )  wbsplit swap bwjoin  ;
-: lwflip  ( l -- l )  lwsplit swap wljoin  ;
-\needs lbflip : lbflip  ( l -- l )  lbsplit swap 2swap swap bljoin  ;
+\ : wbflip  ( w -- w )  wbsplit swap bwjoin  ;
+\ : lwflip  ( l -- l )  lwsplit swap wljoin  ;
+\ \needs lbflip : lbflip  ( l -- l )  lbsplit swap 2swap swap bljoin  ;
 
-: lbflips  ( adr len -- )   bounds  ?do  i l@ lbflip i l!  /l +loop  ;
-: wbflips  ( adr len -- )   bounds  ?do  i w@ wbflip i w!  /w +loop  ;
-: lwflips  ( adr len -- )   bounds  ?do  i l@ lwflip i l!  /l +loop  ;
+\ : lbflips  ( adr len -- )   bounds  ?do  i l@ lbflip i l!  /l +loop  ;
+\ : wbflips  ( adr len -- )   bounds  ?do  i w@ wbflip i w!  /w +loop  ;
+\ : lwflips  ( adr len -- )   bounds  ?do  i l@ lwflip i l!  /l +loop  ;
 
 #260 constant /stringbuf
 /stringbuf 2* buffer: stringbuf
@@ -202,6 +202,7 @@ alias resident noop
 alias headerless? false
 alias ascii [char]
 alias partial-headers noop
+alias external headers
 create cforth
 \needs standalone?  false value standalone?
 alias eval evaluate
@@ -215,12 +216,14 @@ defer minimum-search-order
 : round-down  ( adr granularity -- adr' )  1- invert and  ;
 
 fl ${BP}/forth/kernel/splits.fth
+fl ${BP}/forth/lib/split.fth
 fl ${BP}/forth/kernel/endian.fth
-alias unaligned-l! le-l!
 32\ alias unaligned-! unaligned-l!
 64\ alias unaligned-! !
 64\ alias rx@ @
 64\ alias rx! !
+64\ alias x, ,
+64\ alias xa1+ cell+
 
 : -leading  ( adr len -- adr' len' )  
    begin  dup  while