section "cpu" // needs "display" get "libhdr" get "clihdr" manifest $( binary.display = false // make true if binary display $) global $( display : ug+0 // rtn(display.value) rc : ug+1 //reference count t : ug+2 // time mod tickpersecond*5/50 refc : ug+3 // -> incremented word q : ug+4 // quotient r : ug+5 // remainder av : ug+6 // average usage cycle : ug+7 // cycle value idleid : ug+8 // idling task mainid : ug+9 // main task oldq.times.100 : ug+10 // used for damping ds : ug+11 // display string $) let start(pkt) be // PKT is zero if run under a cli, non-zero if run // as a task $( // if run as a command (under the cli) ... if pkt=0 do $( let seglist = vec 3 seglist!0, seglist!1, seglist!2, seglist!3 := 3, tcb!tcb.seglist!1, 0, cli.module // create the idling task idleid := createtask(seglist, 100, 1) if idleid=0 do error("CPU already running?") seglist!2 := tcb!tcb.seglist!2 // BLIB library // create the high priority task for pri = maxint-1 to maxint-500 by -1 do $( mainid := createtask(seglist, 100, pri) unless mainid=0 break $) if mainid=0 do $( deletetask(idleid) error("Createtask failure") $) // start up the low priority task sendpkt(-1, idleid, 0) // start up the high priority task sendpkt(-1, mainid, idleid) // make sure the cli does NOT unload this code segment cli.module := 0 finish $) // return the start up packet idleid := pkt!pkt.type qpkt(pkt) // if this is the low priority cpu task ... if idleid=0 do $( returncode := returncode+1 repeatuntil testflags(4) deletetask(taskid) abort(100) $) // otherwise, this is the high priority task // find the address of the word that the idle task // is incrementing refc := rootnode!rtn.tasktab!idleid!tcb.gbase+[@returncode-@globsize] rc := 0 t := 0 av := 0 cycle := 0 // find address of cli prompt for display ds := rootnode!rtn.tasktab!task.cli!tcb.gbase![@cli.prompt-@globsize] ds%0:=5; ds%4:='>'; for i = 1 to 3 ds%i:='0' ds%5 := ' ' $( !refc := 0 delay(1) update() t := [t+1] rem [tickspersecond*5/50] $) repeat $) and update() be $( let c = !refc if testflags(1) do exit() test t=0 then $( if c>rc do rc := c if rc=0 do rc := 1 q := muldiv(rc-av, [binary.display -> bitsperword, 100], rc) if result2>[rc/2] do q := q+1 unless binary.display if q=1 do q := 0 test binary.display THEN $( Q := (Q*100 + OLDQ.TIMES.100)/2 // Damping OLDQ.TIMES.100 := Q Q := (Q + 50)/100 r := [not #0]<<[bitsperword-q] $) else $( r := 4096*cycle + 256*[q/100] + 16*[q/10 rem 10] + q rem 10 cycle := [cycle+1] rem 16 $) av := c display(r) $) else $( av := av*t + c av := av/(t+1) $) $) AND error(message) BE $( writef("%s failed - %s*n", cli.commandname, message) stop(return.severe) $) and exit() be $( // clear the display display(0) // make the idling task self-destruct when next active setflags(idleid, 4) // make sure it runs // note that the highest priority should always // be available, as (by convention) it is only // used by tasks which never suspend (and that are // of short duration!) while changepri(idleid, maxint)=0 loop // delete this task, freeing this code segment endtask(tcb!tcb.seglist!3) $) and display(n) be $( ds%1 := hexch(n>>8) ds%2 := hexch(n>>4) ds%3 := hexch(n) $) and hexch(n) = VALOF $( n := n RESULTIS n<=9->n+#X30,n+#X37 $)