From fc74e8fb54612a066d31ec972c33d01aa4c1fd23 Mon Sep 17 00:00:00 2001
From: Philip Zembrod <pzembrod@gmail.com>
Date: Sat, 2 Apr 2022 01:10:56 +0200
Subject: [PATCH] Initial CPM Makefile with rule to run the MSDOS volks4th as
 editor here and with a copy of msdos/src/include.fb (with modified comment in
 block 0) to have a starting point for implementing an .fth file include for
 CP/M.

---
 8080/CPM/Makefile    |  11 ++++
 8080/CPM/include.fb  |   1 +
 8080/CPM/include.fth | 152 +++++++++++++++++++++++++++++++++++++++++++
 3 files changed, 164 insertions(+)
 create mode 100644 8080/CPM/Makefile
 create mode 100644 8080/CPM/include.fb
 create mode 100644 8080/CPM/include.fth

diff --git a/8080/CPM/Makefile b/8080/CPM/Makefile
new file mode 100644
index 0000000..43cb6a7
--- /dev/null
+++ b/8080/CPM/Makefile
@@ -0,0 +1,11 @@
+
+fth: include.fth
+
+run-editor: msdos
+	FORTHPATH="f:\\;f:\\msdos" ../../8086/msdos/emulator/run-in-dosbox.sh f:\\msdos\\volks4th.com
+
+msdos:
+	ln -s ../../8086/msdos msdos
+
+%.fth: %.fb ../../tools/fb2fth.py
+	../../tools/fb2fth.py $< $@
diff --git a/8080/CPM/include.fb b/8080/CPM/include.fb
new file mode 100644
index 0000000..cfaf3b2
--- /dev/null
+++ b/8080/CPM/include.fb
@@ -0,0 +1 @@
+\ include for stream sources for cp/m                phz 02apr22                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                \ load screen                                        phz 06feb22                                                                  1 6 +thru                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                     \ fib /fib #fib eolf?                                phz 06feb22                                                                  context @ dos also context !                                    $50 constant /tib                                               variable tibeof tibeof off                                                                                                      : eolf? ( c -- f )                                                \ f=-1: not yet eol; store c and continue                       \ f=0: eol but not yet eof; return line and flag continue       \ f=1: eof: return line and flag eof                           tibeof off                                                       dup #lf = IF drop 0 exit THEN                                   -1 = IF tibeof on  1 ELSE -1 THEN ;                                                                                                                                                                                                                         \ incfile incpos inc-fgetc                           phz 06feb22                                                                  variable incfile                                                variable incpos 2 allot                                                                                                         : inc-fgetc  ( -- c )                                             incfile @ f.handle @ 0= IF                                        incpos 2@  incfile @  fseek THEN                              incfile @ fgetc                                                 incpos 2@ 1. d+ incpos 2! ;                                                                                                                                                                                                                                                                                                                                                                                                                                 \ freadline probe-for-fb                             phz 06feb22                                                                  : freadline ( -- eof )                                          tib /tib bounds DO                                                inc-fgetc dup eolf? under 0< IF I c! ELSE drop THEN             0< 0= IF I tib - #tib ! ENDLOOP tibeof @ exit THEN            LOOP /tib #tib !                                                ." warning: line exteeds max " /tib . cr                        ." extra chars ignored" cr                                      BEGIN inc-fgetc eolf? 1+ UNTIL tibeof @ ;                                                                                     | : probe-for-fb  ( -- flag )                                       \ probes whether current file looks like a block file         /tib 2+ 0 DO isfile@ fgetc #lf = IF ENDLOOP false exit THEN     LOOP true ;                                                                                                                   \ save/restoretib                                    phz 16jan22                                                                  $50 constant /stash                                             create stash[  /stash allot  here constant ]stash               variable stash>   stash[ stash> !                                                                                               : savetib  ( -- n )                                                 #tib @ >in @ -  dup stash> @ + ]stash u>                          abort" tib stash overflow"   >r                               tib >in @ +  stash> @  r@ cmove                                 r@ stash> +!  r> ;                                                                                                          : restoretib  ( n -- )                                              dup >r negate stash> +!   stash> @ tib r@ cmove                 r> #tib !  >in off ;                                                                                                      \ interpret-via-tib include                          phz 06feb22                                                                  : interpret-via-tib                                             BEGIN freadline >r .status >in off interpret                    r> UNTIL ;                                                                                                                      : include ( -- )                                                pushfile  use  cr file?                                         probe-for-fb isfile@ freset IF 1 load close exit THEN           incfile push  isfile@ incfile !                                 incpos push  incpos off  incpos 2+ dup push off                 savetib >r  interpret-via-tib close  r> restoretib ;                                                                            : (stashquit  stash[ stash> !  (quit ;                          : stashrestore  ['] (stashquit IS 'quit ;                       ' stashrestore IS 'restart                                    \ \                                                  phz 25feb22                                                                  : \  blk @ IF >in @ negate  c/l mod  >in +!                          ELSE #tib @ >in ! THEN ; immediate                                                                                       \ : \needs  have 0=exit                                         \      blk @ IF >in @ negate  c/l mod  >in +!                   \      ELSE #tib @ >in ! THEN ;                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                 
\ No newline at end of file
diff --git a/8080/CPM/include.fth b/8080/CPM/include.fth
new file mode 100644
index 0000000..8f568a0
--- /dev/null
+++ b/8080/CPM/include.fth
@@ -0,0 +1,152 @@
+
+\ *** Block No. 0, Hexblock 0
+
+\ include for stream sources for cp/m                phz 02apr22
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+\ *** Block No. 1, Hexblock 1
+
+\ load screen                                        phz 06feb22
+
+  1 6 +thru
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+\ *** Block No. 2, Hexblock 2
+
+\ fib /fib #fib eolf?                                phz 06feb22
+
+  context @ dos also context !
+  $50 constant /tib
+  variable tibeof tibeof off
+
+  : eolf? ( c -- f )
+    \ f=-1: not yet eol; store c and continue
+    \ f=0: eol but not yet eof; return line and flag continue
+    \ f=1: eof: return line and flag eof
+   tibeof off
+    dup #lf = IF drop 0 exit THEN
+    -1 = IF tibeof on  1 ELSE -1 THEN ;
+
+
+
+
+\ *** Block No. 3, Hexblock 3
+
+\ incfile incpos inc-fgetc                           phz 06feb22
+
+  variable incfile
+  variable incpos 2 allot
+
+  : inc-fgetc  ( -- c )
+    incfile @ f.handle @ 0= IF
+      incpos 2@  incfile @  fseek THEN
+    incfile @ fgetc
+    incpos 2@ 1. d+ incpos 2! ;
+
+
+
+
+
+
+
+\ *** Block No. 4, Hexblock 4
+
+\ freadline probe-for-fb                             phz 06feb22
+
+  : freadline ( -- eof )
+  tib /tib bounds DO
+    inc-fgetc dup eolf? under 0< IF I c! ELSE drop THEN
+    0< 0= IF I tib - #tib ! ENDLOOP tibeof @ exit THEN
+  LOOP /tib #tib !
+  ." warning: line exteeds max " /tib . cr
+  ." extra chars ignored" cr
+  BEGIN inc-fgetc eolf? 1+ UNTIL tibeof @ ;
+
+| : probe-for-fb  ( -- flag )
+    \ probes whether current file looks like a block file
+  /tib 2+ 0 DO isfile@ fgetc #lf = IF ENDLOOP false exit THEN
+  LOOP true ;
+
+
+\ *** Block No. 5, Hexblock 5
+
+\ save/restoretib                                    phz 16jan22
+
+  $50 constant /stash
+  create stash[  /stash allot  here constant ]stash
+  variable stash>   stash[ stash> !
+
+  : savetib  ( -- n )
+      #tib @ >in @ -  dup stash> @ + ]stash u>
+        abort" tib stash overflow"   >r
+      tib >in @ +  stash> @  r@ cmove
+      r@ stash> +!  r> ;
+
+  : restoretib  ( n -- )
+      dup >r negate stash> +!   stash> @ tib r@ cmove
+      r> #tib !  >in off ;
+
+
+\ *** Block No. 6, Hexblock 6
+
+\ interpret-via-tib include                          phz 06feb22
+
+  : interpret-via-tib
+  BEGIN freadline >r .status >in off interpret
+  r> UNTIL ;
+
+  : include ( -- )
+  pushfile  use  cr file?
+  probe-for-fb isfile@ freset IF 1 load close exit THEN
+  incfile push  isfile@ incfile !
+  incpos push  incpos off  incpos 2+ dup push off
+  savetib >r  interpret-via-tib close  r> restoretib ;
+
+  : (stashquit  stash[ stash> !  (quit ;
+  : stashrestore  ['] (stashquit IS 'quit ;
+  ' stashrestore IS 'restart
+
+\ *** Block No. 7, Hexblock 7
+
+\ \                                                  phz 25feb22
+
+  : \  blk @ IF >in @ negate  c/l mod  >in +!
+       ELSE #tib @ >in ! THEN ; immediate
+
+\ : \needs  have 0=exit
+\      blk @ IF >in @ negate  c/l mod  >in +!
+\      ELSE #tib @ >in ! THEN ;
+
+
+
+
+
+
+
+