mirror of
https://github.com/forth-ev/VolksForth.git
synced 2025-02-19 09:31:02 +00:00
Extract tasker from VF Disk3 into fth files.
Copy over tmp6502asm.fth and x16tmpheap.fth from cc64.
This commit is contained in:
parent
c565886d25
commit
76ce66e2a4
25
6502/C64/src/multitask.fth
Normal file
25
6502/C64/src/multitask.fth
Normal file
@ -0,0 +1,25 @@
|
||||
\ *** Block No. 58, Hexblock 3a
|
||||
|
||||
\ Multitasker BP 13.9.84 )
|
||||
|
||||
\needs Code include trns6502asm.fth
|
||||
|
||||
Code stop
|
||||
SP 2dec IP lda SP X) sta
|
||||
IP 1+ lda SP )Y sta
|
||||
SP 2dec RP lda SP X) sta
|
||||
RP 1+ lda SP )Y sta
|
||||
6 # ldy SP lda UP )Y sta
|
||||
iny SP 1+ lda UP )Y sta
|
||||
1 # ldy tya clc UP adc W sta
|
||||
txa UP 1+ adc W 1+ sta
|
||||
W 1- jmp end-code
|
||||
|
||||
| Create taskpause Assembler
|
||||
$2C # lda UP X) sta ' stop @ jmp
|
||||
end-code
|
||||
|
||||
: singletask
|
||||
[ ' pause @ ] Literal ['] pause ! ;
|
||||
|
||||
: multitask taskpause ['] pause ! ;
|
26
6502/C64/src/taskdemo.fth
Normal file
26
6502/C64/src/taskdemo.fth
Normal file
@ -0,0 +1,26 @@
|
||||
\ *** Block No. 62, Hexblock 3e
|
||||
|
||||
\ Taskdemo clv12aug87
|
||||
|
||||
: taskmark ; \needs cbm>scr : cbm>scr ;
|
||||
|
||||
: scrstart ( -- adr)
|
||||
(64 $288 C) (16 $53e C) c@ $100 * ;
|
||||
|
||||
Variable counter counter off
|
||||
|
||||
$100 $100 Task Background
|
||||
|
||||
: >count ( n -)
|
||||
Background 1 pass
|
||||
counter !
|
||||
BEGIN counter @ -1 counter +! ?dup
|
||||
WHILE pause 0 <# #s #>
|
||||
0 DO pause dup I + c@ cbm>scr
|
||||
scrstart I + c! LOOP drop
|
||||
REPEAT
|
||||
BEGIN stop REPEAT ; \ stop's forever
|
||||
: wait Background sleep ;
|
||||
: go Background wake ;
|
||||
|
||||
multitask $100 >count page
|
92
6502/C64/src/tasker.fth
Normal file
92
6502/C64/src/tasker.fth
Normal file
@ -0,0 +1,92 @@
|
||||
\ *** Block No. 57, Hexblock 39
|
||||
|
||||
\ Multitasker BP 13.9.84 )
|
||||
|
||||
Onlyforth
|
||||
|
||||
\needs multitask include multitask.fth save
|
||||
|
||||
\ *** Block No. 59, Hexblock 3b
|
||||
|
||||
\ pass activate ks 8 may 84 )
|
||||
|
||||
: pass ( n0 .. nr-1 Tadr r -- )
|
||||
BEGIN [ rot ( Trick ! ) ]
|
||||
swap $2C over c! \ awake Task
|
||||
r> -rot \ IP r addr
|
||||
8 + >r \ s0 of Task
|
||||
r@ 2+ @ swap \ IP r0 r
|
||||
2+ 2* \ bytes on Taskstack
|
||||
\ incl. r0 & IP
|
||||
r@ @ over - \ new SP
|
||||
dup r> 2- ! \ into ssave
|
||||
swap bounds ?DO I ! 2 +LOOP ;
|
||||
restrict
|
||||
|
||||
: activate ( Tadr --)
|
||||
0 [ -rot ( Trick ! ) ] REPEAT ;
|
||||
-2 allot restrict
|
||||
|
||||
: sleep ( Tadr --)
|
||||
$4C swap c! ; \ JMP-Opcode
|
||||
|
||||
: wake ( Tadr --)
|
||||
$2C swap c! ; \ BIT-Opcode
|
||||
|
||||
|
||||
\ *** Block No. 60, Hexblock 3c
|
||||
|
||||
\ building a Task BP 13.9.84 )
|
||||
|
||||
| : taskerror ( string -)
|
||||
standardi/o singletask
|
||||
." Task error : " count type
|
||||
multitask stop ;
|
||||
|
||||
: Task ( rlen slen -- )
|
||||
allot \ Stack
|
||||
here $FF and $FE =
|
||||
IF 1 allot THEN \ 6502-align
|
||||
up@ here $100 cmove \ init user area
|
||||
here $4C c, \ JMP opcode
|
||||
\ to sleep Task
|
||||
up@ 1+ @ ,
|
||||
dup up@ 1+ ! \ link Task
|
||||
3 allot \ allot JSR wake
|
||||
dup 6 - dup , , \ ssave and s0
|
||||
2dup + , \ here + rlen = r0
|
||||
under + here - 2+ allot
|
||||
['] taskerror over
|
||||
[ ' errorhandler >body c@ ] Literal + !
|
||||
Constant ;
|
||||
|
||||
|
||||
|
||||
\ *** Block No. 61, Hexblock 3d
|
||||
|
||||
\ more Tasks ks/bp 26apr85re)
|
||||
|
||||
: rendezvous ( semaphoradr -)
|
||||
dup unlock pause lock ;
|
||||
|
||||
| : statesmart
|
||||
state @ IF [compile] Literal THEN ;
|
||||
|
||||
: 's ( Tadr - adr.of.taskuservar)
|
||||
' >body c@ + statesmart ; immediate
|
||||
|
||||
\ Syntax: 2 Demotask 's base !
|
||||
\ makes Demotask working binary
|
||||
|
||||
: tasks ( -)
|
||||
." MAIN " cr up@ dup 1+ @
|
||||
BEGIN 2dup - WHILE
|
||||
dup [ ' r0 >body c@ ] Literal + @
|
||||
6 + name> >name .name
|
||||
dup c@ $4C = IF ." sleeping" THEN cr
|
||||
1+ @ REPEAT 2drop ;
|
||||
|
||||
|
||||
|
||||
|
||||
|
8
6502/C64/src/tmp6502asm.fth
Normal file
8
6502/C64/src/tmp6502asm.fth
Normal file
@ -0,0 +1,8 @@
|
||||
|
||||
cr .( tmpheap transient forth assembler) cr
|
||||
|
||||
here $800 tmp-hallot dp !
|
||||
|
||||
include 6502asm.fth
|
||||
|
||||
dp !
|
@ -5,7 +5,7 @@
|
||||
\ tmpclear will remove all words on the tmpheap, wheras regular clear
|
||||
\ will remove all words on tmpheap and heap together.
|
||||
|
||||
\ Other than the reference tmpheap living on the regular heap, this
|
||||
\ In contrast to the reference tmpheap living on the regular heap, this
|
||||
\ custom tmpheap needs no initialization as its position and
|
||||
\ size (8k) is fixed.
|
||||
|
||||
|
Loading…
x
Reference in New Issue
Block a user