From 03002f5ea0dda57d11cf2fcbca5ab83ea0d6d155 Mon Sep 17 00:00:00 2001
From: ketmar <ketmar@ketmar.no-ip.org>
Date: Sat, 30 Sep 2023 20:21:27 +0000
Subject: [PATCH] UrForth: added "$INCLUDE" and "$INCLUDE-ONCE"

FossilOrigin-Name: ec50467d9d01c71a763ae185d9d8313ca09863af5c620ebf8b5435e7a0e95abd
---
 src/urforth.c | 92 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++--
 1 file changed, 89 insertions(+), 3 deletions(-)

diff --git a/src/urforth.c b/src/urforth.c
index 9b5c486..f1dd163 100644
--- a/src/urforth.c
+++ b/src/urforth.c
@@ -5,7 +5,7 @@
 //#define UFO_UPPERCASE_DICT_WORDS
 
 
-#define UFO_DEBUG_FATAL_ABORT
+//#define UFO_DEBUG_FATAL_ABORT
 //#define UFO_DEBUG_PARSE
 //#define UFO_DEBUG_INLCUDE
 
@@ -4734,7 +4734,7 @@ UFWORD(DLR_IF_IMM) { ufoProcessConditional(); }
 
 // INCLUDE
 // ( addr count -- )
-UFWORD(DLR_INCLUDE) {
+UFWORD(INCLUDE) {
   char fname[1024];
   uint32_t count = ufoPop();
   uint32_t addr = ufoPop();
@@ -4785,6 +4785,89 @@ UFWORD(DLR_INCLUDE) {
 }
 
 
+//==========================================================================
+//
+//  ufoDollarIncludeCommon
+//
+//==========================================================================
+static void ufoDollarIncludeCommon (const char *defname) {
+  char fname[1024];
+  uint32_t dpos = 0;
+  int system = 0, softinclude = 0;
+  uint32_t ch, qch;
+  int skipit = (defname != NULL && ufoHasCondDefine(defname));
+
+  ch = ufoGetInChar();
+  while (ch != 0 && ch != '"' && ch != '<') {
+    ch = ufoGetInChar();
+  }
+
+  if (ch == 0) ufoFatal("quoted file name expected");
+
+  if (ch == '<') { system = 1; qch = '>'; } else qch = '"';
+  ch = ufoGetInChar();
+  while (ch != qch) {
+    if (ch == 0) ufoFatal("properly quoted file name expected");
+    if (ch == '!') {
+      if (system) ufoFatal("invalid file name (duplicate system mark)");
+      system = 1;
+    } else if (ch == '?') {
+      if (softinclude) ufoFatal("invalid file name (duplicate soft mark)");
+      softinclude = 1;
+    } else {
+      break;
+    }
+    // skip spaces
+    do { ch = ufoGetInChar(); } while (ch != 0 && ch != qch);
+  }
+
+  // get filename
+  dpos = 0;
+  while (ch != 0 && ch != qch) {
+    if ((size_t)dpos >= sizeof(fname)) ufoFatal("include file name too long");
+    fname[dpos] = (char)ch; dpos += 1;
+    ch = ufoGetInChar();
+  }
+  fname[dpos] = 0;
+  // final parsing checks
+  if (ch == 0) ufoFatal("properly quoted file name expected");
+  ch = ufoGetInChar();
+  // skip spaces
+  do { ch = ufoGetInChar(); } while (ch != 0 && ch <= 32);
+  if (ch != 0) ufoFatal("unexpected extra text");
+
+  if (!skipit) {
+    if (defname != NULL) ufoAddCondDefine(defname);
+    char *ffn = ufoCreateIncludeName(fname, system);
+    FILE *fl = ufoOpenFileOrDir(&ffn);
+    if (!fl) {
+      if (softinclude) { free(ffn); return; }
+      ufoFatal("$INCLUDE: file '%s' not found", ffn);
+    }
+    ufoPushInFile();
+    ufoInFile = fl;
+    ufoInFileLine = 0;
+    ufoInFileName = ffn;
+  }
+
+  // trigger next line loading
+  ufoSetTIB(0); ufoSetIN(0);
+  ufoImgPutU32(0, 0);
+}
+
+
+// $INCLUDE-ONCE define-guard filename
+UFWORD(DLR_INCLUDE_ONCE) {
+  ufoParseNameToTempBuf();
+  ufoDollarIncludeCommon(ufoTempCharBuf);
+}
+
+// $INCLUDE filename
+UFWORD(DLR_INCLUDE) {
+  ufoDollarIncludeCommon(NULL);
+}
+
+
 // DUMP-STACK
 // ( -- )
 UFWORD(DUMP_STACK) {
@@ -5924,7 +6007,10 @@ static void ufoInitCommon (void) {
   UFWORDX_IMM("$LABEL-DATA:", DLR_LABEL_DATA_IMM);
   UFWORDX_IMM("$LABEL-CODE:", DLR_LABEL_CODE_IMM);
 
-  UFWORDX("INCLUDE", DLR_INCLUDE);
+  UFWORDX_IMM("$INCLUDE", DLR_INCLUDE);
+  UFWORDX_IMM("$INCLUDE-ONCE", DLR_INCLUDE_ONCE);
+
+  UFWORDX("INCLUDE", INCLUDE);
 
 
   (void)ufoCreateVocSetOnlyDefs("UFO", NULL);
-- 
2.11.4.GIT