Extract tasker from VF Disk3 into fth files.

Copy over tmp6502asm.fth and x16tmpheap.fth from cc64.
This commit is contained in:
Philip Zembrod 2024-06-12 19:23:03 +02:00
parent c565886d25
commit 76ce66e2a4
5 changed files with 152 additions and 1 deletions

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

View File

@ -0,0 +1,8 @@
cr .( tmpheap transient forth assembler) cr
here $800 tmp-hallot dp !
include 6502asm.fth
dp !

View File

@ -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.