To use this file copy and paste this:    // #URL-lib "http://pin1.org/forthlib/flb/Interupts/rr-shed.flb"   into BV Terminal 3 or here to download.

// * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
// Round robbin scheduler using timer 0
// Words are placed into the schedule by using s-add. It fills an area
// in memory with the words added. The other words are:
// ps.    - to see the words in the  list
// s-del  - removes a word from the list
// s-pause - pause a word from the schedule
// s-resume - opposite
// s-start - starts timer0 and the scheduler
// s-clr  - clears schedule table, muts be run for initialisation
// s-interval - returns variable address to set T0 interval in ms
//
// NOTE this method will give interval time to each scheduled word
// in turn, so if there are 10 words to be scheduled and the interval
// is 5 then each word will be serviced at 50ms intervals  
// * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 


// REQUIRES:
// #URL-lib "http://pin1.org/forthlib/flb/General/soft1.flb"  sid=99
// #URL-lib "http://pin1.org/forthlib/flb/General/pinsel.flb"  sid=100
// #URL-lib "http://pin1.org/forthlib/flb/Interupts/interrupt.flb"


// CONSTANTS:
&e0004000 constant T0IR
&e0004004 constant T0TCR
&e0004008 constant T0TC
&e000400c constant T0PR
&e0004014 constant T0MCR
&e0004018 constant T0MR0
//
integer nextShed    // next scheduled task
variable interval    // in ms
80 constant s-size  // in bytes, each cfa is 4 bytes
s-size vspace$ s-table  // schedule table

Full Contents of File

// * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
// Round robbin scheduler using timer 0
// Words are placed into the schedule by using s-add. It fills an area
// in memory with the words added. The other words are:
// ps. - to see the words in the list
// s-del - removes a word from the list
// s-pause - pause a word from the schedule
// s-resume - opposite
// s-start - starts timer0 and the scheduler
// s-clr - clears schedule table, muts be run for initialisation
// s-interval - returns variable address to set T0 interval in ms
//
// NOTE this method will give interval time to each scheduled word
// in turn, so if there are 10 words to be scheduled and the interval
// is 5 then each word will be serviced at 50ms intervals
// * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *

// REQUIRES:
// #URL-lib "http://pin1.org/forthlib/flb/General/soft1.flb" sid=99
// #URL-lib "http://pin1.org/forthlib/flb/General/pinsel.flb" sid=100
// #URL-lib "http://pin1.org/forthlib/flb/Interupts/interrupt.flb"

// CONSTANTS:
&e0004000  constant  T0IR
&e0004004  constant  T0TCR
&e0004008  constant  T0TC
&e000400c  constant  T0PR
&e0004014  constant  T0MCR
&e0004018  constant  T0MR0
//
integer  nextShed        // next scheduled task
variable  interval        // in ms
80  constant  s-size    // in bytes, each cfa is 4 bytes
s-size  vspace$  s-table    // schedule table


// -------------- Schedule table management -----------------------
// The schedulr table consists of a list of cfa's in memory
// one afer the other. This allows the table to expand up to the max
// size and contarct as required.

// this checks the word cfa-x against v for equality, excluding
// bit 1, that may be set or not depending on the suspended state
: =s ( v cfa-x -- t/f )   &fffffffe  and  =  ;
 
: <0>s-clr ( -- )   s-table  s-size  0  fill  ;    // clear all schedules

// prints name of word, prefixed by S if suspended
: (ps) ( cfa -- )
    dup  1  and      // check for suspended
    if
        ."  (S)   "
    then   
    &fffffffe  and  8  -  stype  cr
;   
       
// see all words in schedule
: <0>ps. ( -- )
    s-size  s-table  +  s-table
    do
        i  @
        dup  0=
        if
            drop  leave
        else
            (ps)     // get nfa and type
        then
    4  +loop   
;                   

// adds a word to the schedule
: <0>s-add ( cfa -- t/f )
    0  swap  // error value
    s-size  s-table  +  s-table
    do
        i  @  0=    // looking for free space
        if
            i  !  1-  leave    // store cfa to free space, leave true
        then       
    4  +loop
    -1  =  if  -1  else  drop  0  then  ;       
; 

// used by s-del to pull back the values from i to the
// end of the table and overwrite the deleted one.
: (s-del) ( i -- )
      s-size  s-table  +  swap    // move all other words down
      do
          i  4  +  @  i  !
      4  +loop
;
     
// Removes a word form the schedule by shifting all of the
// folowing words down one
: <0>s-del ( cfa -- t/f )
    0  swap  // error value
    s-size  s-table  +  s-table
    do
        dup  i  @  =s    // see if same
        if
            i  (s-del)
            -1        // leave true
            leave
        then
    4  +loop
    -1  =  if  2drop  -1  then  ;       
;

// suspends or resumes words in schedule by setting or clearing
// bit 1
: (s-sus) ( s cfa -- )
    s-size  s-table  +  s-table
    do
        dup  i  @  =s    // see if same
        if
            drop        // original cfa
            i  @          // get word
            swap  1  =  if  1+  else  &fffffffe  and  then
            i  !          // save
        then
    4  +loop
;

// pauses word from being shceduled by setting bit 1
: <0>s-pause ( cfa -- )   1  swap  (s-sus)   ;
// resumes word by clearing bit 1
: <0>s-resume ( cfa -- )   0  swap  (s-sus)   ;

// -------------- round robbin scheduler ------------------------

// gets next cfa to execute from schedule table, returns 0 if there are
// no words in the table
: s-next ( -- cfa|0)  
    s-table  @  0=        // special case
    if
        0
    else   
        nextshed  4  *        // words are 4 bytes
        dup  s-size  <
        if
            s-table  +  @      // get the cfa (or 0)
            dup  0=            // don't continue if EOT reached
            if 
                0  =>  nextShed      // reset pointer
                drop  s-table  @              // retun first word
            else 
                1  +>  nextShed      // for next time
            then
        else
            0  =>  nextShed  // end of table
        then
    then   
;           

// This word will enable fast interrupts for timer0
// in the VIC registers, start timer 0, start it and enable
// the global interrupts which are disabled each time
// an interrupt is called
: setShed
        0  =>  nextShed            // start at 0
        TIMER0  intSel      // selct
        TIMER0  intEn        // enable
        efiq        // enable irupts, at start up all disabled
;

// this is the word that gets called when the interrupt is fired
// the word MUST do the following:
// 1. clear the interrupt, in this case it is the timer0 interrupt
// 2. carry out what it needs to do
// 3. re-enable the interrupt if we want to come back here
// This is the scheduler, a case statement controls the tsaks
: T0int
        1  t0IR  !        // clear interrupt
        s-next            // get cfa of word to execute
        ?dup  0  <> 
        if
            dup  1  and  0=  if  execute  else  drop  then    // execute if not suspended or 0
        then   
        TIMER0  intEn  // re-enable for return
;

// sets timer 1 as a counter, the values
// given makes T0TC increment every 100 us
// or every 0.1ms, in other words 1 second is
// equal to 1000 counts
// A match has been set up at every 10,000 counts (10 seconds)
// this will generate an interrupt via the T0MCR register
: <0>s-start
        interval  @  0=  if  10  interval  !  then
        pclk  1000  / T0PR ! // sets regardless of CLK
        2  T0TCR  !              // reset
        1  T0TCR  !              // enable
        interval  @  t0MR0  !        // match on interval
        3  t0MCR  !              // interrupt and reset to 0
        // now place cfa of T0int ti interupt table
        [']  T0int    // get cfa of t0int
        TIMER0        // into timer slot (4)
        int>>          // do it
        setShed                      // set interrupts
; 

: <0>s-intervalinterval  ;