From 76ce66e2a457c55e46b8a1e90a83e74edfe36517 Mon Sep 17 00:00:00 2001
From: Philip Zembrod <pzembrod@gmail.com>
Date: Wed, 12 Jun 2024 19:23:03 +0200
Subject: [PATCH] Extract tasker from VF Disk3 into fth files. Copy over
 tmp6502asm.fth and x16tmpheap.fth from cc64.

---
 6502/C64/src/multitask.fth  | 25 ++++++++++
 6502/C64/src/taskdemo.fth   | 26 +++++++++++
 6502/C64/src/tasker.fth     | 92 +++++++++++++++++++++++++++++++++++++
 6502/C64/src/tmp6502asm.fth |  8 ++++
 6502/C64/src/x16tmpheap.fth |  2 +-
 5 files changed, 152 insertions(+), 1 deletion(-)
 create mode 100644 6502/C64/src/multitask.fth
 create mode 100644 6502/C64/src/taskdemo.fth
 create mode 100644 6502/C64/src/tasker.fth
 create mode 100644 6502/C64/src/tmp6502asm.fth

diff --git a/6502/C64/src/multitask.fth b/6502/C64/src/multitask.fth
new file mode 100644
index 0000000..5703da7
--- /dev/null
+++ b/6502/C64/src/multitask.fth
@@ -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 ! ;
diff --git a/6502/C64/src/taskdemo.fth b/6502/C64/src/taskdemo.fth
new file mode 100644
index 0000000..d5dd4e1
--- /dev/null
+++ b/6502/C64/src/taskdemo.fth
@@ -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
diff --git a/6502/C64/src/tasker.fth b/6502/C64/src/tasker.fth
new file mode 100644
index 0000000..a2c019d
--- /dev/null
+++ b/6502/C64/src/tasker.fth
@@ -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 ;
+
+
+
+
+
diff --git a/6502/C64/src/tmp6502asm.fth b/6502/C64/src/tmp6502asm.fth
new file mode 100644
index 0000000..f220469
--- /dev/null
+++ b/6502/C64/src/tmp6502asm.fth
@@ -0,0 +1,8 @@
+
+ cr .( tmpheap transient forth assembler) cr
+
+here   $800 tmp-hallot dp !
+
+  include 6502asm.fth
+
+dp !
diff --git a/6502/C64/src/x16tmpheap.fth b/6502/C64/src/x16tmpheap.fth
index 07b9a90..973c1c7 100644
--- a/6502/C64/src/x16tmpheap.fth
+++ b/6502/C64/src/x16tmpheap.fth
@@ -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.