6502/VolksForth
1
0
Fork 0
mirror of https://github.com/forth-ev/VolksForth.git synced 2025-02-05 07:34:02 +00:00
Code Issues Projects Releases Wiki Activity

Translation and small fix in "source"

Browse Source
This commit is contained in:
Carsten Strotmann 2021-04-12 15:15:18 +02:00
parent 6a3c1a30ac
commit 269f9a83e2
2 changed files with 15 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
8086/pc-baremetal/Makefile
View File

@ -9,7 +9,7 @@ all: $(TARGET)
$(BLKPACK) < $< > $@ $(BLKPACK) < $< > $@
$(TARGET): kernel.fb meta.fb $(TARGET): kernel.fb meta.fb
emu2 $(BASE)/8086/msdos/volks4th.com "include kernel.fb" emu2 $(BASE)/8086/msdos/volks4th.com "include kernel.fb bye"
.PHONY: clean .PHONY: clean
clean: clean:

28
8086/pc-baremetal/kernel.fth
View File

@ -22,7 +22,7 @@ Port to 8088/86 and MS-DOS by K.Schleisiek dez 87
warning on warning on
flush \ close FORTH.COM flush \ close FORTH.COM
cr .( new kernel as "FORTH.COM" written) cr bell bye cr .( new kernel as "FORTH.COM" written) cr bell
( ----- 002 ) ( ----- 002 )
\\ The use of the 8088/86 register ks 27 oct 86 \\ The use of the 8088/86 register ks 27 oct 86
@ -667,7 +667,7 @@ Label domove I W cmp moveup CS ?]
: tib ( -- addr ) >tib @ ; : tib ( -- addr ) >tib @ ;
: query tib $50 expect span @ #tib ! >in off ; : query tib $50 expect span @ #tib ! >in off ;
( ----- 048 ) ( ----- 048 )
\ skip scan /string ks 22 dez 87 \ skip scan /string ks 22 dez 87
@ -758,7 +758,7 @@ swap ]? C >in #) add
defer source defer source
: (source ( -- addr len ) tib #tib @ ; : (source ( -- addr len ) tib #tib @ ;
' source Is (source ' (source Is source
: word ( char -- addr ) source (word ; : word ( char -- addr ) source (word ;
@ -1169,7 +1169,6 @@ Target Forth also definitions
( ----- 082 ) ( ----- 082 )
\ prompt quit ks 16 sep 88 \ prompt quit ks 16 sep 88
: (prompt .status state @ IF cr ." ] " exit THEN : (prompt .status state @ IF cr ." ] " exit THEN
aborted @ 0= IF ." ok" THEN cr ; aborted @ 0= IF ." ok" THEN cr ;
@ -1179,7 +1178,7 @@ Target Forth also definitions
Defer 'quit ' (quit Is 'quit Defer 'quit ' (quit Is 'quit
: quit r0 @ rp! [compile] [ blk off 'quit ; : quit r0 @ rp! [compile] [ blk off 'quit ;
\ : classical cr .status state @ \ : classical cr .status state @
\ IF ." C> " exit THEN ." I> " ; \ IF ." C> " exit THEN ." I> " ;
@ -1256,7 +1255,7 @@ Target Forth also definitions
: .s sp@ s0 @ over - $20 umin bounds ?DO I @ u. 2 +LOOP ; : .s sp@ s0 @ over - $20 umin bounds ?DO I @ u. 2 +LOOP ;
( ----- 088 ) ( ----- 088 )
\ c/l l/s ks 19 m„r 88 \ c/l l/s
&64 Constant c/l \ Screen line length &64 Constant c/l \ Screen line length
&16 Constant l/s \ lines per screen &16 Constant l/s \ lines per screen
@ -1282,10 +1281,10 @@ Target Forth also definitions
( ----- 091 ) ( ----- 091 )
$10000 Constant limit Variable first $10000 Constant limit Variable first
$408 Constant b/buf \ physikalische Groesse $408 Constant b/buf \ real size of block buffer
$400 Constant b/blk \ bytes/block $400 Constant b/blk \ bytes/block
Defer r/w \ physikalischer Diskzugriff Defer r/w \ low level disk access word
( ----- 092 ) ( ----- 092 )
@ -1481,7 +1480,7 @@ Target Forth also definitions
( ----- 111 ) ( ----- 111 )
\ System patchup ks 16 sep 88 \ System patchup ks 16 sep 88
1 &9 +thru \ MS-DOS interface 1 &10 +thru \ MS-DOS interface
: forth-83 ; \ last word in Dictionary : forth-83 ; \ last word in Dictionary
0 ' limit >body ! $DFF6 s0 ! $E77C r0 ! 0 ' limit >body ! $DFF6 s0 ! $E77C r0 !
@ -1526,7 +1525,7 @@ Target Forth also definitions
\ BDOS keyboard input ks 16 sep 88 \ BDOS keyboard input ks 16 sep 88
\ it really needs to be this complicated, else ^C und ^P would \ it really needs to be this complicated, else ^C und ^P would
\ not work \ not work
\\
| Variable newkey newkey off | Variable newkey newkey off
Code (key@ ( -- 8b ) D push newkey #) D mov D+ D+ or Code (key@ ( -- 8b ) D push newkey #) D mov D+ D+ or
0= ?[ $7 # A+ mov $21 int A- D- mov ]? 0= ?[ $7 # A+ mov $21 int A- D- mov ]?
@ -1541,7 +1540,7 @@ Target Forth also definitions
end-code end-code
( ----- 115 ) ( ----- 115 )
\ empty-keys (key ks 16 sep 88 \ empty-keys (key ks 16 sep 88
\\
Code empty-keys $C00 # A mov $21 int Code empty-keys $C00 # A mov $21 int
0 # newkey 1+ #) byte mov Next end-code 0 # newkey 1+ #) byte mov Next end-code
@ -1549,7 +1548,7 @@ Target Forth also definitions
(key@ ?dup ?exit (key? IF (key@ negate exit THEN 0 ; (key@ ?dup ?exit (key? IF (key@ negate exit THEN 0 ;
( ----- 116 ) ( ----- 116 )
\ BIOS keyboard input ks 16 sep 88 \ BIOS keyboard input ks 16 sep 88
\\
Code (key@ ( -- 8b ) D push A+ A+ xor $16 int Code (key@ ( -- 8b ) D push A+ A+ xor $16 int
A- D- xchg 0 # D+ mov Next end-code A- D- xchg 0 # D+ mov Next end-code
@ -1560,8 +1559,8 @@ Target Forth also definitions
: (key ( -- 8b ) BEGIN pause (key? UNTIL (key@ ; : (key ( -- 8b ) BEGIN pause (key? UNTIL (key@ ;
\ mit diesen Keytreibern sind die Funktionstasten nicht \ when this kernel driver are active the function keys
\ mehr durch ANSI.SYS Sequenzen vorbelegt. \ cannot be used for ANSI.SYS makros
( ----- 117 ) ( ----- 117 )
\ (decode expect ks 16 sep 88 \ (decode expect ks 16 sep 88
@ -1605,3 +1604,4 @@ Target Forth also definitions
(emit (cr tipp (del (page (at (at? [ drop (emit (cr tipp (del (page (at (at? [ drop
( ----- 120 ) ( ----- 120 )