mirror of
https://github.com/forth-ev/VolksForth.git
synced 2024-11-29 21:49:17 +00:00
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.
This commit is contained in:
parent
e3bf763d3b
commit
fc74e8fb54
11
8080/CPM/Makefile
Normal file
11
8080/CPM/Makefile
Normal file
@ -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 $< $@
|
1
8080/CPM/include.fb
Normal file
1
8080/CPM/include.fb
Normal file
File diff suppressed because one or more lines are too long
152
8080/CPM/include.fth
Normal file
152
8080/CPM/include.fth
Normal file
@ -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 ;
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
Loading…
Reference in New Issue
Block a user