fbForth fbForth—TI Forth with File-based Block I/O [Post #1 UPDATED: 04/13/2021]

[+Lee Stewart]

31 minutes ago, TheBF said:

When I started to use the 64column editor I realized mine worked differently so I looked at my 35 year old dot matrix listings.  

It made code testing and stack juggling testing easy to have the little interpreter window beneath the code available.

 

The FBLOCKS-loadable fbForth 64-column editor is the one from TI Forth with a few changes (very few, I think) and a few corrections. I should take a look at yours to possibly change fbForth’s. As it is, <FCTN+9> exits the editor to whatever graphics mode entered the editor, clearing the screen!

 

...lee

[+TheBF]

I have some dim memory of working on GKEY and I'm not sure if I read about the test window or figured it out myself. (?)

Any way the only line that's changed is in the case statement for the escape key >0F. 

I just remove the VMODE change that is sitting on the R stack.

 

I think the line is this now:

 

5 0 SPRPAT   R> DROP  0 1 GOTOXY QUIT 

 

[+Lee Stewart]

8 minutes ago, TheBF said:

The context switch works!

 

Cool beans! 

 

Regarding your code, if you are going to use my ASM: , you might as well use its complementary ;ASM instead of NEXT, —they are synonyms.

ASM: ME   ( -- addr)  \  orignal name was MYSElf. Already used in FigForth
         SP DECT,
         UP *SP MOV,
;ASM

...lee

[+TheBF]

aHHH

 

I was getting an error with both of them. 

Thanks!

[+Lee Stewart]

44 minutes ago, TheBF said:

I have some dim memory of working on GKEY and I'm not sure if I read about the test window or figured it out myself. (?)

Any way the only line that's changed is in the case statement for the escape key >0F. 

I just remove the VMODE change that is sitting on the R stack.

 

I think the line is this now:

5 0 SPRPAT   R> DROP  0 1 GOTOXY QUIT 

 

 

This line is in the TI Forth 64-column editor, but never used:

: BCK 0 0 GOTOXY QUIT ;

It must have been a carryover from the 40-column Text-mode editor because that editor was exited with BCK —albeit with a more elaborate definition.

 

...lee

[+TheBF]

Making some progress.

 

LOL.  I am not used to Fig Forth anymore.  Thanks to the debugger I realized that I push  ' <word> onto the return stack not   ' <word> CFA.    

 

This works for 1 task.  I think I am messing up linking the round robin queue  when adding the second task.  

Never as easy as I think it will be.   

 

\ MULTI99.FTH for FbFORTH                27 APR2021 Brian Fox
\ Derived from COOPTASK.MAX for MaxForth 68HC11  B Fox 1992
\ Forth multi-tasker using a single workspace with separate
\ data stack, return stack and user area for each task.

21 LOAD    needs the Assembler

FORTH DEFINITIONS

-1 CONSTANT TRUE
 0 CONSTANT FALSE

\ PID (process I.D.) is the base address of a user area
\  orignal name was MYSElf. Already used in FigForth
ASM: ME   ( -- PID)    SP DECT,  UP *SP MOV,   ;ASM
ASM: UP!  ( addr -- )  *SP+ UP MOV,   ;ASM

ME CONSTANT USER0            \ USER0 is the primary Forth task

\  add these user variables to FbFORTH
HEX
 6E USER RSAVE    \ temp storage for RP register
 70 USER TFLAG    \ flag for awake or asleep
 72 USER TLINK    \ link to next task
 74 USER JOB      \ copy of running XT

( ***  CALL INIT-MULTI ONCE before multi-tasking  ***)
: INIT-MULTI ( -- )
     USER0 UP!         \ set my user-pointer register
     ME TLINK !        \ round robin links to ME
     TRUE TFLAG !  ;   \ mark my task flag as AWAKE

\ Coventional Forth Pause
ASM: PAUSE  ( -- )  \ this is the context switcher
     RP DECT,
     SP *RP MOV,

     RP DECT,
     IP *RP  MOV,

     RP  6E @(UP) MOV,     \  RP -> LOCAL RSAVE
     BEGIN,
        72 @(UP) UP MOV,   \ next task's UP -> UP
        70 @(UP) R0 MOV,   \ test the tflag for zero
     NE UNTIL,             \ or try next task

     6E @(UP) RP MOV,      \ restore RP this task
     RP *+ IP MOV,         \ pop this task's IP
     RP *+ SP MOV,         \ pop this task's SP
;ASM                       \ run NEXT

HEX
 80 CONSTANT USTACKS          \ 20 cells per stack per task
 USTACKS 2 * CONSTANT USIZE   \ size of FbForth USER area + STACKS

DECIMAL
\ compute address of a USER variable in any PID
\ Editors note: LOCAL is clever. Comes from early Forth
\ multi-tasking systems. Usage:  TASK1 RSAVE LOCAL @
: LOCAL   ( PID uvar -- addr) ME -  + ;

: SLEEP  ( PID -- )  FALSE SWAP TFLAG LOCAL ! ;
: WAKE   ( PID -- )  TRUE  SWAP TFLAG LOCAL ! ;

HEX
\ compute base address of the local stacks in a PID
: TASK-SP0  ( PID -- addr) USIZE +  40 - ;
: TASK-RP0  ( PID -- addr) USIZE +   2-  ;

\  used to push values onto a local return stack
: TASK-RP-- ( PID -- ) -2 SWAP RSAVE LOCAL +! ;
: TASK>R  ( n PID -- ) DUP TASK-RP--  RSAVE LOCAL @  ! ;

: INIT-USER  ( PID -- )
     DUP USIZE FF FILL  \ init whole user area for debugging
     USER0 SWAP 80 CMOVE ;  \ copy USER0's user variables

: SET-RP0  ( PID -- )  DUP TASK-RP0 SWAP RSAVE LOCAL ! ;
: SET-SP0  ( PID -- )  DUP TASK-SP0 SWAP TASK>R ;

\ add PID to round-robin list
: LINK-TASK  ( PID --)
     TLINK @         ( -- pid previous)
     OVER TLINK !    ( -- pid )
     TLINK LOCAL !
;

: FORK  ( PID -- )
        DUP INIT-USER
        DUP SET-RP0
        DUP LINK-TASK
        DUP SET-SP0
        SLEEP  \ don't wake me up yet :)
;

 HEX
: ASSIGN ( XT PID -- )
         OVER OVER JOB LOCAL !  \ keep a copy for restarting
         TASK>R ;               \ push PFA onto local rstack

DECIMAL
 INIT-MULTI  ( setup the root task for mult-tasking)

\ TEST CODE
0 VARIABLE TASK1   USIZE ALLOT   TASK1 FORK

0 VARIABLE X

: THING1  BEGIN   1 X +!  PAUSE AGAIN ;

' THING1 TASK1 ASSIGN

TASK1 WAKE
TASK2 SLEEP

\ We need a PAUSE loop to run the tasks.
\ Could be build into KEY
: TESTLOOP
    PAGE ." TASK1 Inc X
    BEGIN
           0 2 GOTOXY  X @ .
          PAUSE
          ?TERMINAL
    UNTIL ;

 

[+Lee Stewart]

11 hours ago, TheBF said:

LOL.  I am not used to Fig Forth anymore.  Thanks to the debugger I realized that I push  ' <word> onto the return stack not   ' <word> CFA.    

 

The former, indeed, gives you the pfa. You already know this, but Forth-83 and beyond changed it to the cfa or execution token.

 

11 hours ago, TheBF said:

21 LOAD    \ needs the Assembler

 

 

As long as it is the first thing you do, it is much, much quicker to BLOAD the Assembler with the following LOAD command:

27 LOAD      \ needs the Assembler

Also—though it surely does not matter in your code—words in fbForth that return TRUE, usually return 1 rather than -1. I truly wish that I had bucked figForth and TI Forth in this regard and gone with -1 at the start, which makes much more sense.

 

...lee

 

[+TheBF]

Lee, can you think of way we could re-write KEY,  insert PAUSE in its loop and patch it into the existing KEY?

 

I am also going to make PAUSE a patchable word so it will run NEXT by default and with the SINGLE command, but run the context switcher with the command MULTI.

This gives the most flexibility by letting you turn off the switcher when you want to compile something for example inside a running program.

[+TheBF]

FbForth has a Multi-Tasker

 

The spoiler has MULTI99 for FbForth.  It could be made smaller, but I factored it out to help me debug and explain it better to a new reader.

The demo code is below with a short video.

Seems pretty solid.

 

 

Spoiler

\ MULTI99.FTH for FbFORTH                27 APR2021 Brian Fox
\ Derived from COOPTASK.MAX for MaxForth 68HC11  B Fox 1992
\ Forth multi-tasker using a single workspace with separate
\ data stack, return stack and user area for each task.

21 LOAD    needs the Assembler

FORTH DEFINITIONS

 1 CONSTANT TRUE
 0 CONSTANT FALSE

\ PID (process I.D.) is the base address of a user area
\  orignal name was MYSElf. Already used in FigForth
ASM: ME   ( -- PID)    SP DECT,  UP *SP MOV,   ;ASM
ASM: UP!  ( addr -- )  *SP+ UP MOV,   ;ASM

ME CONSTANT USER0            \ USER0 is the primary Forth task

\  add these user variables to FbFORTH
HEX
 6E USER RSAVE    \ temp storage for RP register
 70 USER TFLAG    \ flag for awake or asleep
 72 USER TLINK    \ link to next task
 74 USER JOB      \ copy of running XT

( ***  CALL INIT-MULTI ONCE before multi-tasking  ***)
: INIT-MULTI ( -- )
     USER0 UP!         \ set my user-pointer register
     ME TLINK !        \ round robin links to ME
     TRUE TFLAG !  ;   \ mark my task flag as AWAKE

\ Coventional Forth Pause
ASM: PAUSE  ( -- )  \ this is the context switcher
     RP DECT,
     SP *RP MOV,

     RP DECT,
     IP *RP  MOV,

     RP  6E @(UP) MOV,     \  RP -> LOCAL RSAVE
     BEGIN,
        72 @(UP) UP MOV,   \ next task's UP -> UP
        70 @(UP) R0 MOV,   \ test the tflag for zero
     NE UNTIL,             \ or try next task

     6E @(UP) RP MOV,      \ restore RP this task
     RP *+ IP MOV,         \ pop this task's IP
     RP *+ SP MOV,         \ pop this task's SP
;ASM                       \ run NEXT

HEX
 80 CONSTANT USTACKS          \ 20 cells per stack per task
 USTACKS 2 * CONSTANT USIZE   \ size of FbForth USER area + STACKS

DECIMAL
\ compute address of a USER variable in any PID
\ Editors note: LOCAL is clever. Comes from early Forth
\ multi-tasking systems. Usage:  TASK1 RSAVE LOCAL @
: LOCAL   ( PID uvar -- addr) ME -  + ;

: SLEEP  ( PID -- )  FALSE SWAP TFLAG LOCAL ! ;
: WAKE   ( PID -- )  TRUE  SWAP TFLAG LOCAL ! ;

HEX
\ compute base address of the local stacks in a PID
: TASK-SP0  ( PID -- addr) USIZE +  40 - ;
: TASK-RP0  ( PID -- addr) USIZE +   2-  ;

\  used to push values onto a local return stack
: TASK-RP-- ( PID -- ) -2 SWAP RSAVE LOCAL +! ;
: TASK>R  ( n PID -- ) DUP TASK-RP--  RSAVE LOCAL @  ! ;

: INIT-USER  ( PID -- PID)
     DUP USIZE FF FILL  \ init whole user area for debugging
     USER0 OVER 80 CMOVE ;  \ copy USER0's user variables

: SET-RP0  ( PID -- PID)  TASK-RP0 OVER RSAVE LOCAL ! ;
: SET-SP0  ( PID -- PID)  TASK-SP0 OVER TASK>R ;

\ add PID to round-robin list
: LINK-TASK  ( PID -- PID)
     TLINK @         ( -- pid previous)
     OVER TLINK !    ( -- pid )
     OVER TLINK LOCAL !
;

: FORK  ( PID -- )
        INIT-USER
        DUP SET-RP0
        LINK-TASK
        DUP SET-SP0
        SLEEP  \ don't wake me up yet :)
;

 HEX
: ASSIGN ( XT PID -- )
         OVER OVER JOB LOCAL !  \ keep a copy for restarting
         TASK>R ;               \ push PFA onto local rstack

DECIMAL
 INIT-MULTI  ( setup the root task for mult-tasking)

 

 

 

\ ------------------------------------------------------------
\ DEMO CODE
0 VARIABLE TASK1   USIZE ALLOT
0 VARIABLE TASK2   USIZE ALLOT
0 VARIABLE TASK3   USIZE ALLOT

TASK1 FORK
TASK2 FORK
TASK3 FORK


0 VARIABLE X
0 VARIABLE Y

: THING1  BEGIN   1 X +!  PAUSE AGAIN ;
: THING2  BEGIN  -1 Y +!  PAUSE AGAIN ;

\ multi-tasking delay must include a PAUSE
: DELAYS  ( n --) 0 DO  PAUSE LOOP ;

\ stop a task and giveup control
: HALT    ( PID --) SLEEP PAUSE ;

\ runs five times and then goes to sleep
: THING3  5 0 DO
               100 DELAYS
               0 0 GOTOXY ." TASK3 is butting in here... :-)"
               30 DELAYS
                0 40 BL VFILL
          LOOP
          0 0 GOTOXY ." Task3 is asleep now."
          ME HALT ;

' THING1 TASK1 ASSIGN
' THING2 TASK2 ASSIGN
' THING3 TASK3 ASSIGN

TASK1 WAKE
TASK2 WAKE
TASK3 WAKE

\ We need a PAUSE loop to run the tasks.
\ Could be build into KEY
: TESTLOOP
    PAGE ." TASK1 INC X, TASK2 DEC Y"
    BEGIN
           0 2 GOTOXY  X @ U. 4 SPACES  Y @ U.
          PAUSE
          ?TERMINAL
    UNTIL ;

 

[GDMike]

Just off the record and subject, talked with Mark lately and he noted that he's been doing some work in FORTH the last few days. I was so glad to hear from him.

I, myself haven't been doing anything besides getting a car up and running, but I plan on getting back into the action soon. Not sure which route to take, TF, FORTH+. 

 

[+Lee Stewart]

4 hours ago, TheBF said:

fbForth has a Multi-Tasker

 

MULTI99 for fbForth could be made smaller, but I factored it out to help me debug and explain it better to a new reader.

     . . .

Seems pretty solid.

 

Nicely done! 

 

The only unfortunate thing is that PAUSE is already a word in the TI Forth/fbForth universe for monitoring keystrokes to pause/resume/break a routine’s execution. Perhaps, another word ( PAUSETASK SHARE  WAIT HESITATE ?) could be used. Redefining it for multitasking removes PAUSE from user programming purview. PAUSE could still be used by defining a multitasking vocabulary, but that may be overkill. I know there are two words ( C, R0 ) in the ASSEMBLER vocabulary that coexist this way with the FORTH vocabulary.

 

...lee

[+TheBF]

2 minutes ago, Lee Stewart said:

 

Nicely done! 

 

The only unfortunate thing is that PAUSE is already a word in the TI Forth/fbForth universe for monitoring keystrokes to pause/resume/break a routine’s execution. Perhaps, another word ( PAUSETASK SHARE  WAIT HESITATE ?) could be used. Redefining it for multitasking removes PAUSE from user programming purview. PAUSE could still be used by defining a multitasking vocabulary, but that may be overkill. I know there are two words ( C, R0 ) in the ASSEMBLER vocabulary that coexist this way with the FORTH vocabulary.

 

...lee

No problem. We can change it to YIELD.  HsForth used YIELD because Jim Kalihan was a non-conformist. Honest. A Forth programmer who didn't like to follow conventions.  

[GDMike]

I've heard of these"wills and wonts" during my reading. 😂 

 

[+Lee Stewart]

10 hours ago, TheBF said:

Lee, can you think of a way we could re-write KEY,  insert PAUSE in its loop and patch it into the existing KEY?

 

I am also going to make PAUSE a patchable word so it will run NEXT by default and with the SINGLE command, but run the context switcher with the command MULTI.

This gives the most flexibility by letting you turn off the switcher when you want to compile something for example inside a running program.

 

Probably not a good idea to hook the interrupt vector for any of this, but the ISR might offer some insight:

Spoiler

*       _____   ____         __  __      ___________ 
*      / _/ /  / __/__  ____/ /_/ /     /  _/ __/ _ \
*     / _/ _ \/ _// _ \/ __/ __/ _ \   _/ /_\ \/ , _/
*    /_//_.__/_/  \___/_/  \__/_//_/  /___/___/_/|_| 
*
;[*** Interrupt Service =======================================================
* This routine is executed for every interrupt.  It processes any pending
* speech and sound.  It then looks to see whether a user ISR is installed in 
* ISR.  If so, it sets up NEXT for execution of the user ISR.  This will work 
* only if the user has installed an ISR using the following steps in the fol-
* lowing order:
*
*   (1) Write an ISR with entry point, say MYISR.
*   (2) Determine code field address of MYISR with this high-level Forth:
*           ' MYISR CFA
* <<< Maybe need a word to do #3 >>>
*   (3) Write CFA of MYISR into user variable ISR.
*
* Steps (2)-(3) in high-level Forth are shown below:
*           ' MYISR CFA
*           ISR !
* 
* <<< Perhaps last step above should be by a word that disables interrupts >>>
*
* The console ISR branches to the contents of >83C4 because it is non-zero,
* with the address, INT1, of the fbForth ISR entry point below (also, the
* contents of INTLNK).  This means that the console ISR will branch to INT1
* with BL *R12 from WP = GPLWS (>83E0), R12 containing INT1 below to first
* process any pending speech and sound.
* 
* If the user's ISR is properly installed, the code that processes the user
* ISR modifies NEXT so that the very next time B *NEXT or B *R15 is executed
* from Forth's workspace (MAINWS), the code at INT2 will process the user's
* ISR just before branching to the normal NEXT entry ($NEXT) in fbForth's
* inner interpreter.
*** ==========================================================================

* ¡¡¡ MUST REMEMBER THAT WE ARE IN GPL WORKSPACE UPON ENTRY. !!!

INT1   
       LI   R0,BRSTK          load address of top of Branch Address Stack
* 
* Set up for pending speech
*
       MOV  @SPCSVC,*R0       save Speech service address onto Branch Stack
       JEQ  SNDCH1            jump to sound-check if no speech
       INCT R0                increment Branch Stack
*
* Set up for pending sound table #1 (ST#1)
*
SNDCH1 MOV  @SND1ST,R2        sound table ST#1 to service?
       JEQ  SNDCH2            process speech and sound if needed
       LI   R1,PLAYT1         load PLAYT1 address and...
       MOV  R1,*R0+           ...push it onto Branch Stack
* 
* Set up for pending sound table #2 (ST#2)
*
SNDCH2 MOV  @SND2ST,R3        sound table ST#2 to service?
       JEQ  PRCSPS            process speech and sound if needed
       LI   R1,PLAYT2         load PLAYT2 address and...
       MOV  R1,*R0+           ...push it onto Branch Stack
*
* Process sound stack if both sound tables idle
*
PRCSPS SOC  R2,R3             OR R2 and R3..both sound tables idle?
       JNE  PRSPS2            nope..skip sound stack processing
       LWPI SND1WS            switch to ST#1 WS
       CI   R4,SNDST0         anything on sound stack?
       JEQ  PRSPS1            no..exit sound stack processing
       DECT R4                pop sound stack position
       MOV  *R4,R2            get sound table address from sound stack
       INC  R0                kick off sound processing of ST#1 (R0=1)
PRSPS1 LWPI GPLWS             switch back to GPL WS
* 
* Check for any pending speech and sound
*
PRSPS2 CI   R0,BRSTK          any speech or sound to process?
       JEQ  USRISR            if not, jump to user ISR processing
       LI   R1,BNKRST         yup..load return address
       MOV  R1,*R0            push return address onto Branch Stack
* 
* Process pending speech and sound
*
       MOV  @MYBANK,@BANKSV   save bank at interrupt
       CLR  @>6002            switch to bank 2 for speech & sound services
       LI   R7,BRSTK          load top of Branch Stack
       MOV  *R7+,R8           pop speech/sound ISR
       B    *R8               service speech/sound
*
* Restore interrupted bank
*
BNKRST                ; return point for speech and sound ISRs
       MOV  @BANKSV,R0        restore bank at interrupt
       SRL  R0,13             get the bank# to correct position
       AI   R0,>6000          make it a real bank-switch address
       CLR  *R0               switch to the bank at interrupt
*
* Process User ISR if defined
*
USRISR MOV  @$ISR+$UVAR,R0     User ISR installed?
       JEQ  INTEX             
*
* Fix NEXT so that the user's ISR is processed the next time B *NEXT (B *R15)
* is executed from Forth's WS (MAINWS = >8300), which it does at the end of
* every CODE word, keyboard scan and one or two other places.
* 
       LI   R1,INT2                 Load entry point, INT2
       MOV  R1,@2*NEXT+MAINWS       Copy it to Forth's NEXT (R15)
* 
* The following 2 instructions are copies of the remainder of the console ROM's
* ISR (except that 'CLR R8' was removed because it is only needed by TI Basic)
* because we're not going back there!
* 
INTEX  LWPI >83C0             Change to console's ISR WS  
       RTWP                   Return to caller of console ISR
* 
* Branch through above-modified NEXT (R15) gets us here. NEXT will be restored
* before executing user's ISR. INT3 (cleanup routine below) will be inserted
* in address list to get us back here for cleanup after user's ISR has finished.
* User's ISR is executed at the end of this section just before INT3.
* 
INT2   LIMI 0                 Disable interrupts
       MOVB @>83D4,R0         Get copy of VR01
       SRL  R0,8              ...to LSB
       ORI  R0,>100           Set up for VR01
       ANDI R0,>FFDF          Clear VDP-interrupt-enable bit
       BLWP @VWTR             Turn off VDP interrupt
       LI   NEXT,$NEXT        Restore NEXT
       SETO @INTACT           Set Forth "pending interrupt" flag
       DECT R                 Set up return linkage by pushing 
       MOV  IP,*R             ...IP (R13, next Forth CFA) to return stack and
       LI   IP,INT3           ...setting IP to INT3 (below) for cleanup
       MOV  @$ISR(U),W        Do the user's Forth ISR by executing
       B    @DOEXEC           ...it through Forth's inner interpreter
* 
* Clean up and re-enable interrupts.
*
INT3   DATA INT3+2            $NEXT (or $SEMIS) puts INT3+2 in W (R10)
       DATA INT3+4            DOEXEC (or $SEMIS) will branch to *W = INT3+4 (next instr)
       MOV  *R+,IP            Start cleanup: pop IP from before call to user's ISR
       CLR  @INTACT           Clear Forth "pending interrupt" flag
       MOVB @>83D4,R0         Prepare to restore VR01 by...
       SRL  R0,8              ...moving payload to LSB (enabling VDP interrupt) and
       AI   R0,>100           ...VR # (01) to MSB
       MOVB @VDPSTA,R1        Remove pending VDP interrupt by reading VDP status
       BLWP @VWTR             Write VR01
       LIMI 2                 Re-enable interrupts
       B    *NEXT             Continue normal task

 

 

I will need to cogitate on this some more. 😱

 

...lee

[+TheBF]

In theory you can drop the context switcher into the ISR but it has to run NEXT when it's finished.

Not sure what that would do. Best to try it and see I guess.

In theory the ISR would switch context and run NEXT forever.   

 

It would be less convenient because now you need protections for critical resources and mutexes and such stuff.

Probably better to just make separate critical stuff run in the ISR and leave the cooperative tasks for less critical things. (IMHO)

 

[+TheBF]

Slightly cleaned up version of MULTI99

 

I took a quick run at making a SINGLE and MULTI word that patches YIELD with NEXT  or (YIELD) [ renamed context switch]

I don't have a good enough understanding of the internals.

 

Perhaps I can leave that as an assignment for someone. 

 

I am trying to finish my documents. 

I am working on some automation to extract things from my source files for a better glossary. It's getting close.

 

Spoiler

\ MULTI99.FTH for FbFORTH                27 APR2021 Brian Fox
\ Derived from COOPTASK.MAX for MaxForth 68HC11  B Fox 1992
\ Forth multi-tasker using a single workspace with separate
\ data stack, return stack and user area for each task.

21 LOAD   \ needs the Assembler

FORTH DEFINITIONS

 1 CONSTANT TRUE
 0 CONSTANT FALSE

\ PID (process I.D.) is the base address of a user area
\  orignal name was MYSElf. Already used in FigForth
ASM: ME   ( -- PID)    SP DECT,  UP *SP MOV,   ;ASM
ASM: UP!  ( addr -- )  *SP+ UP MOV,   ;ASM

ME CONSTANT USER0    \ USER0 is the primary Forth task

\  add these user variables to FbFORTH
HEX
 6E USER RSAVE    \ temp storage for RP register
 70 USER TFLAG    \ flag for awake or asleep
 72 USER TLINK    \ link to next task
 74 USER JOB      \ copy of running XT

( ***  CALL INIT-MULTI ONCE before multi-tasking  ***)
: INIT-MULTI ( -- )
     USER0 UP!         \ reset root user-pointer register
     ME TLINK !        \ round robin links to ME
     TRUE TFLAG !  ;   \ mark my task flag as AWAKE

\ Coventional Forth context switcher
ASM: YIELD  ( -- )
     RP DECT,  SP *RP MOV, \ Rpush SP
     RP DECT,  IP *RP MOV, \ Rpush IP
     RP  6E @(UP) MOV,     \ RP -> LOCAL RSAVE

     BEGIN,
        72 @(UP) UP MOV,   \ switch context
        70 @(UP) R0 MOV,   \ test this tflag for zero
     NE UNTIL,             \ until a task is awake

     6E @(UP) RP MOV,      \ restore RP this task
     RP *+ IP MOV,         \ pop this task's IP
     RP *+ SP MOV,         \ pop this task's SP
;ASM                       \ run NEXT

\ 833A CONSTANT 'NEXT        \ for patching SINGLE

HEX
 80 CONSTANT USTACKS          \ 20 cells per stack per task
 USTACKS 2 * CONSTANT USIZE   \ FbForth USER area + STACKS

DECIMAL
\ compute address of a USER variable in any PID
\ Editors note: LOCAL is clever. Comes from early Forth
\ multi-tasking systems. Usage:  TASK1 RSAVE LOCAL @
: LOCAL   ( PID uvar -- addr) ME -  + ;

: SLEEP  ( PID -- )  FALSE SWAP TFLAG LOCAL ! ;
: WAKE   ( PID -- )  TRUE  SWAP TFLAG LOCAL ! ;

HEX
\ compute base address of the local stacks in a PID
: TASK-SP0  ( PID -- addr) USIZE +  40 - ;
: TASK-RP0  ( PID -- addr) USIZE +   2-  ;

\  used to push values onto a local return stack
: TASK-RP-- ( PID -- ) -2 SWAP RSAVE LOCAL +! ;
: TASK>R  ( n PID -- ) DUP TASK-RP--  RSAVE LOCAL @  ! ;

: INIT-USER  ( PID -- PID)
     DUP USIZE FF FILL  \ init whole user area for debugging
     USER0 OVER 80 CMOVE ;  \ copy USER0's user variables

: SET-RP0  ( PID -- PID)  DUP TASK-RP0 OVER RSAVE LOCAL ! ;
: SET-SP0  ( PID -- PID)  DUP TASK-SP0 OVER TASK>R ;

\ add PID to round-robin list
: LINK-TASK  ( PID -- PID)
     TLINK @         ( -- pid previous)
     OVER TLINK !    ( -- pid )
     OVER TLINK LOCAL !
;

: FORK  ( PID -- )
        INIT-USER  \ copy USER0 into a new task
        SET-RP0    \ set this RP0
        LINK-TASK  \ insert into round robin
        SET-SP0    \ set this SP0
        SLEEP      \ don't wake me up yet :)
;

: ASSIGN ( XT PID -- )
       OVER OVER JOB LOCAL !  \ keep a copy for restarting
       TASK>R ;               \ push PFA onto local rstack

DECIMAL
INIT-MULTI  ( setup the USER0 for mult-tasking)