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