From 333f20947859bdf3d29d7a24eff2498853ef1f3c Mon Sep 17 00:00:00 2001
From: ketmar <ketmar@ketmar.no-ip.org>
Date: Fri, 27 Oct 2023 19:08:59 +0000
Subject: [PATCH] urasm: implemented "INCBIN"

FossilOrigin-Name: 608b304d8f4508d837d90b95646250c7a855db7e5b10f06646ebefc29c9b6099
---
 dox/urforth.txt                    |  5 +++++
 src/liburforth/urforth.c           | 29 +++++++++++++++++++++++++++++
 urflibs/urasm/ext/00-main-loader.f |  1 +
 urflibs/urasm/ext/incbin.f         | 35 +++++++++++++++++++++++++++++++++++
 urflibs/urasm/main.f               |  8 +++++++-
 5 files changed, 77 insertions(+), 1 deletion(-)
 create mode 100644 urflibs/urasm/ext/incbin.f

diff --git a/dox/urforth.txt b/dox/urforth.txt
index d606cea..61b97fd 100644
--- a/dox/urforth.txt
+++ b/dox/urforth.txt
@@ -809,6 +809,11 @@ if "errflag" is not zero, print error message and abort.
 ( errflag addr count -- )
 if "errflag" is zero, print error message and abort.
 
+(INCLUDE-BUILD-NAME)
+( addr count soft? system? -- addr count )
+build include name, put it to PAD as cell-counted string.
+return string address.
+
 (INCLUDE-LINE-FOFS)
 ( -- fofs )
 return file offset of the current TIB line. offset is at the
diff --git a/src/liburforth/urforth.c b/src/liburforth/urforth.c
index c7adafd..54cd079 100644
--- a/src/liburforth/urforth.c
+++ b/src/liburforth/urforth.c
@@ -5363,6 +5363,34 @@ UFWORD(PAR_INCLUDE_FILE_NAME) {
 }
 
 
+// (INCLUDE-BUILD-NAME)
+// ( addr count soft? system? -- addr count )
+// to PAD
+UFWORD(PAR_INCLUDE_BUILD_NAME) {
+  uint32_t system = ufoPop();
+  uint32_t softinclude = ufoPop();
+  uint32_t count = ufoPop();
+  uint32_t addr = ufoPop();
+
+  if ((count & ((uint32_t)1<<31)) != 0) ufoFatal("invalid include name");
+
+  ufoScanIncludeFileName(addr, count, ufoFNameBuf, sizeof(ufoFNameBuf),
+                         &system, &softinclude);
+
+  char *ffn = ufoCreateIncludeName(ufoFNameBuf, system, (system ? ufoLastSysIncPath : ufoLastIncPath));
+  addr = UFO_PAD_ADDR + 4u;
+  count = 0;
+  while (ffn[count] != 0) {
+    ufoImgPutU8Ext(addr + count, ((const unsigned char *)ffn)[count]);
+    count += 1u;
+  }
+  free(ffn);
+  ufoImgPutU8Ext(addr + count, 0);
+  ufoImgPutU32(addr - 4u, count);
+  ufoPush(addr);
+  ufoPush(count);
+}
+
 // (INCLUDE-NO-REFILL)
 // ( addr count soft? system? -- )
 UFWORD(PAR_INCLUDE_NO_REFILL) {
@@ -8163,6 +8191,7 @@ UFO_DISABLE_INLINE void ufoInitHandleWords (void) {
 //==========================================================================
 UFO_DISABLE_INLINE void ufoInitHigherWords (void) {
   UFWORDX("(INCLUDE)", PAR_INCLUDE);
+  UFWORDX("(INCLUDE-BUILD-NAME)", PAR_INCLUDE_BUILD_NAME);
   UFWORDX("(INCLUDE-NO-REFILL)", PAR_INCLUDE_NO_REFILL);
   UFWORDX("(INCLUDE-LINE-SEEK)", PAR_INCLUDE_LINE_SEEK);
 
diff --git a/urflibs/urasm/ext/00-main-loader.f b/urflibs/urasm/ext/00-main-loader.f
index 2dbfab5..8856353 100644
--- a/urflibs/urasm/ext/00-main-loader.f
+++ b/urflibs/urasm/ext/00-main-loader.f
@@ -12,5 +12,6 @@ $include-once <funcs.f>
 $include-once <org.f>
 $include-once <equ-ass.f>
 $include-once <defx.f>
+$include-once <incbin.f>
 
 prev-defs
diff --git a/urflibs/urasm/ext/incbin.f b/urflibs/urasm/ext/incbin.f
new file mode 100644
index 0000000..9ba7aa2
--- /dev/null
+++ b/urflibs/urasm/ext/incbin.f
@@ -0,0 +1,35 @@
+;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; and now for something completely different...
+;; UrAsm Forth Engine!
+;; GPLv3 ONLY
+;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Z80 Assembler: INCBIN instruction
+;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+
+also-defs: asm-instr
+
+\ INCBIN name [,maxlen]
+\ include binary file "as-is", possibly with max length limit.
+: INCBIN  ( -- )
+  next-token tok-type tk-str <> " quoted file name expected" ?error
+  token false false (include-build-name) 2drop ;; already at PAD
+  \ string:pad-cc@ xtype cr abort
+  string:pad-cc@ handle:load-file ?dup ifnot
+    ." incbin file '" string:pad-cc@ xtype ." ' not found!" cr
+    " incbin file not found" error
+  endif
+  next-token
+  token-eol? ifnot expect-comma asm-expr:expression-const expect-eol
+  else dup handle:size@
+  endif
+  ( stx maxlen )
+  dup 0 65536 within " incbin length too big" ?not-error
+  for i over handle:c@ asm-emit:byte endfor
+  handle:free
+;
+
+ALIAS INCBIN $INCBIN
+
+
+prev-defs
diff --git a/urflibs/urasm/main.f b/urflibs/urasm/main.f
index 14bc717..5891a1c 100644
--- a/urflibs/urasm/main.f
+++ b/urflibs/urasm/main.f
@@ -21,12 +21,13 @@ enum{
 out-sna48 value out-format
 false value out-locked
 
+false value do-org-100
+
 : .curr-file  ( -- )
   0 (include-file-name) xtype
 ;
 
 
-
 also asm-lexer
 also-defs: asm-instr
 
@@ -213,6 +214,7 @@ also-defs: cli-args
 alias --sna --sna48
 : --sna128  ( -- )  out-sna128 to out-format true to out-locked next-arg ;
 : --none  ( -- )  out-none to out-format true to out-locked next-arg ;
+: --org100h  ( -- )  true to do-org-100 next-arg ;
 
 prev-defs
 
@@ -232,6 +234,10 @@ prev-defs
 : RUN-URASM  ( -- )
   begin arg-idx argc < while parse-arg repeat
   arg-fname-idx 0< " assemble what?" ?error
+  do-org-100 if 0x100
+    dup to asm-emit:pc dup to asm-emit:emit-pc
+    dup to asm-emit:ent 1- to asm-emit:clr
+  endif
   arg-fname-idx argv assemble-file
   \ asm-labels:dump-labels
   asm-labels:check-labels
-- 
2.11.4.GIT