6502/VolksForth
1
0
Fork 0
mirror of https://github.com/forth-ev/VolksForth.git synced 2025-01-27 09:33:13 +00:00
Code Issues Projects Releases Wiki Activity

Working Bare-Metal Kernel

Browse Source
This commit is contained in:
Carsten Strotmann 2021-04-12 19:44:38 +02:00
parent 269f9a83e2
commit dc865fdd5e
1 changed files with 52 additions and 60 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -1,15 +1,13 @@
( ----- 000 ) ( ----- 000 )
\ #### volksFORTH #### cas 18jul20 \ #### volksFORTH #### cas 11apr21
VolksForth has been developed by volksFORTH designed and developed by
the volksFORTH team
K. Schleisiek, B. Pennemann, G. Rehfeld, D. Weineck see https://volksforth.sf.net
Ulli Hoffmann, Philip Zembrod, Carsten Strotmann https://github.com/forth-ev/VolksForth
6502 version by B.Pennemann and K.Schleisiek
Port to C64 "ultraFORTH" by G. Rehfeld for documentation, updated versions and development
Port to 68000 and Atari ST by D.Weineck and B.Pennemann information
Port to 8080 and CP/M by U.Hoffmann jul 86
Port to C16 "ultraFORTH" by C.Vogt
Port to 8088/86 and MS-DOS by K.Schleisiek dez 87
( ----- 001 ) ( ----- 001 )
\ MS-DOS volksForth Load Screen ks cas 18jul20 \ MS-DOS volksForth Load Screen ks cas 18jul20
warning off \ disable warnings during compilation warning off \ disable warnings during compilation
@ -27,11 +25,11 @@ cr .( new kernel as "FORTH.COM" written) cr bell
\\ The use of the 8088/86 register ks 27 oct 86 \\ The use of the 8088/86 register ks 27 oct 86
The assembler uses forth style names for the register The assembler uses forth style names for the register
The assiciation to the Intel register names: Mapping of Forth Registernames to INTEL Register Names:
A <=> AX A- <=> AL A+ <=> AH A <=> AX A- <=> AL A+ <=> AH
C <=> CX C- <=> CL C+ <=> CH C <=> CX C- <=> CL C+ <=> CH
Register A and C are available for general use Register A and C are free to use
D <=> DX D- <=> DL D+ <=> DH D <=> DX D- <=> DL D+ <=> DH
the Top of (Data-) Stack (TOS) the Top of (Data-) Stack (TOS)
@ -57,7 +55,7 @@ nop 5555 # jmp here 2- >label >cold
nop 5555 # jmp here 2- >label >restart nop 5555 # jmp here 2- >label >restart
Create origin here origin! here $100 0 fill Create origin here origin! here $100 0 fill
\ Coldstart valued for user variables \ Coldstart values for user variables
$E9 int end-code -4 , $FC allot $E9 int end-code -4 , $FC allot
\ this is the multitasker initialization in the user area \ this is the multitasker initialization in the user area
@ -667,7 +665,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
@ -1178,10 +1176,10 @@ 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
key? IF key drop THEN
'quit ;
\ : classical cr .status state @
\ IF ." C> " exit THEN ." I> " ;
( ----- 083 ) ( ----- 083 )
\ end-trace abort ks 26 jul 87 \ end-trace abort ks 26 jul 87
@ -1347,7 +1345,7 @@ Target Forth also definitions
Defer custom-remove ' noop Is custom-remove Defer custom-remove ' noop Is custom-remove
: trim ( dic symb -- ) next-link remove : trim ( dic symb -- ) next-link remove
over remove-tasks remove-vocs remove-words over remove-tasks remove-vocs remove-words
custom-remove heap swap - hallot dp ! last off ; custom-remove heap swap - hallot dp ! last off ;
( ----- 102 ) ( ----- 102 )
\ deleting words from dict. ks 02 okt 87 \ deleting words from dict. ks 02 okt 87
@ -1363,7 +1361,7 @@ Target Forth also definitions
: empty [ dp ] Literal @ up@ trim : empty [ dp ] Literal @ up@ trim
[ udp ] Literal @ udp ! ; [ udp ] Literal @ udp ! ;
( ----- 103 ) ( ----- 103 )
\ save bye stop? ?cr ks 1UH 26sep88 \ save stop? ?cr ks 1UH 26sep88
: save here up@ trim up@ origin $100 cmove : save here up@ trim up@ origin $100 cmove
voc-link @ BEGIN dup 4- @ over 2- ! @ ?dup 0= UNTIL ; voc-link @ BEGIN dup 4- @ over 2- ! @ ?dup 0= UNTIL ;
@ -1421,8 +1419,8 @@ Target Forth also definitions
| : (cold origin up@ $100 cmove $80 count | : (cold origin up@ $100 cmove $80 count
$50 umin >r tib r@ move r> #tib ! >in off blk off $50 umin >r tib r@ move r> #tib ! >in off blk off
init-vocabularys 'cold init-vocabularys 'cold Onlyforth $80 c@ 0= IF
Onlyforth page &24 spaces logo count type cr (restart ; page logo count type cr THEN (restart ;
( ----- 107 ) ( ----- 107 )
\ (boot ks 11 m„r 89 \ (boot ks 11 m„r 89
@ -1459,8 +1457,8 @@ Target Forth also definitions
| Code (bye cli A A xor A E: mov #segs # call | Code (bye cli A A xor A E: mov #segs # call
C: D mov D R add R D: mov 0 # I mov I W mov C: D mov D R add R D: mov 0 # I mov I W mov
$200 # C mov rep movs sti \ restore interrupts $200 # C mov rep movs sti \ restore interrupts
$4C # A+ mov C: seg return_code #) A- mov \ $4C # A+ mov C: seg return_code #) A- mov $21 int
$21 int warmboot # call warmboot # call
end-code end-code
: bye empty page (bye ; : bye empty page (bye ;
@ -1469,9 +1467,9 @@ Target Forth also definitions
here >cold 2+ - >cold ! Assembler here >cold 2+ - >cold ! Assembler
(boot # call C: A mov A D: mov A E: mov (boot # call C: A mov A D: mov A E: mov
#segs # call $41 # R add \ another k for the ints \ #segs # call $41 # R add \ another k for the ints
$4A # A+ mov $21 int \ alloc memory \ $4A # A+ mov $21 int \ alloc memory
CS ?[ $10 # return_code #) byte mov ' (bye @ # jmp ]? \ CS ?[ $10 # return_code #) byte mov ' (bye @ # jmp ]?
here s0 #) W mov 6 # W add origin # I mov $20 # C mov here s0 #) W mov 6 # W add origin # I mov $20 # C mov
rep movs ' (cold >body # I mov bootsystem # jmp rep movs ' (cold >body # I mov bootsystem # jmp
end-code end-code
@ -1480,7 +1478,7 @@ Target Forth also definitions
( ----- 111 ) ( ----- 111 )
\ System patchup ks 16 sep 88 \ System patchup ks 16 sep 88
1 &10 +thru \ MS-DOS interface 1 &11 +thru \ PC-BIOS 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 !
@ -1522,30 +1520,9 @@ Target Forth also definitions
]? A I xchg C: A mov A E: mov ]? A I xchg C: A mov A E: mov
A D: mov D pop Next end-code A D: mov D pop Next end-code
( ----- 114 ) ( ----- 114 )
\ BDOS keyboard input ks 16 sep 88
\ it really needs to be this complicated, else ^C und ^P would
\ not work
\\
| Variable newkey newkey off
Code (key@ ( -- 8b ) D push newkey #) D mov D+ D+ or
0= ?[ $7 # A+ mov $21 int A- D- mov ]?
0 # D+ mov D+ newkey 1+ #) mov Next
end-code
Code (key? ( -- f ) D push newkey #) D mov D+ D+ or
0= ?[ -1 # D- mov 6 # A+ mov $21 int 0=
?[ 0 # D+ mov
][ -1 # A+ mov A newkey #) mov -1 # D+ mov
]? ]? D+ D- mov Next
end-code
( ----- 115 ) ( ----- 115 )
\ empty-keys (key ks 16 sep 88
\\
Code empty-keys $C00 # A mov $21 int
0 # newkey 1+ #) byte mov Next end-code
: (key ( -- 16b ) BEGIN pause (key? UNTIL
(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
@ -1555,22 +1532,20 @@ Target Forth also definitions
Code (key? ( -- f ) D push 1 # A+ mov D D xor Code (key? ( -- f ) D push 1 # A+ mov D D xor
$16 int 0= not ?[ D dec ]? Next end-code $16 int 0= not ?[ D dec ]? Next end-code
Code empty-keys $C00 # A mov $21 int Next end-code : empty-keys ;
: (key ( -- 8b ) BEGIN pause (key? UNTIL (key@ ; : (key ( -- 8b ) BEGIN pause (key? UNTIL (key@ ;
\ when this kernel driver are active the function keys
\ cannot be used for ANSI.SYS makros
( ----- 117 ) ( ----- 117 )
\ (decode expect ks 16 sep 88 \ (decode expect ks 16 sep 88
7 Constant #bel 8 Constant #bs 7 Constant #bel 8 Constant #bs
9 Constant #tab $A Constant #lf 9 Constant #tab $A Constant #lf
$D Constant #cr $D Constant #cr $26 Constant #eof
: (decode ( addr pos1 key -- addr pos2 ) : (decode ( addr pos1 key -- addr pos2 )
#bs case? IF dup 0=exit del 1- exit THEN #bs case? IF dup 0=exit del 1- exit THEN
#cr case? IF dup span ! space exit THEN #cr case? IF dup span ! space exit THEN
#lf case? IF exit THEN
#eof case? IF bye THEN
>r 2dup + r@ swap c! r> emit 1+ ; >r 2dup + r@ swap c! r> emit 1+ ;
: (expect ( addr len1 -- ) span ! 0 : (expect ( addr len1 -- ) span ! 0
@ -1579,10 +1554,10 @@ Target Forth also definitions
Input: keyboard [ here input ! ] Input: keyboard [ here input ! ]
(key (key? (decode (expect [ drop (key (key? (decode (expect [ drop
( ----- 118 ) ( ----- 118 )
\ MSDOS character output ks 29 jun 87 \ BIOS character output ks 29 jun 87
Code charout ( char -- ) $FF # D- cmp 0= ?[ D- dec ]? Code charout ( char -- ) D- A- mov
6 # A+ mov $21 int D pop ' pause # W mov W ) jmp $E # A+ mov $10 int D pop ' pause # W mov W ) jmp
end-code end-code
&80 Constant c/row &25 Constant c/col &80 Constant c/row &25 Constant c/col
@ -1594,7 +1569,7 @@ Target Forth also definitions
: (at? 0 0 ; : (at? 0 0 ;
: (page c/col 0 DO cr LOOP ; : (page c/col 0 DO cr LOOP ;
( ----- 119 ) ( ----- 119 )
\ MSDOS character output ks 7 may 85 \ BIOS character output ks 7 may 85
: bell #bel charout ; : bell #bel charout ;
@ -1605,3 +1580,20 @@ Target Forth also definitions
( ----- 120 ) ( ----- 120 )
Code pc@ ( port -- 8b )
D byte in A- D- mov D+ D+ xor Next
end-code
Code pc! ( 8b port -- )
A pop D byte out D pop Next
end-code
( ----- 121 )
\ zero terminated strings cas 25jan06
: counted ( asciz -- addr len )
dup -1 0 scan drop over - ;
: >asciz ( string addr -- asciz ) 2dup >r -
IF count r@ place r@ THEN 0 r> count + c! 1+ ;
: asciz ( -- asciz ) name here >asciz ;