{ unit for implementing co-procedures (co-routines) in a Pascal simulation environment, Object Oriented Turbo Pascal 6.0} {THIS UNIT CONTAINS THE BASIC CONTEXT SWITCH ROUTINES. -> PROC_MAN is the Process Manager } { Author : Lin Jensen Date : Feb. 10, 1991 } { March 14, 1991 - process ProcDescr as object } { November 24, 1996 - fix up Init of Main, report on terminated (for trace) } UNIT COPROC; {$F+} INTERFACE USES CLOCK, {for writing process reports} QUEUE; {procdescr is object(queueElement), will be linked in PROC_MAN} CONST LifeCycleOff = 16; {16 for vers. 6.0, change to 20 for vers 7.0 offset of lifecycle address in VMT} { ============================================================ A Process is an object with its own thread of control. i.e. a CO-ROUTINE Create a process class as follows: TYPE GIANTptr = ^ GIANT; GIANT = OBJECT (procdescr) field1: ) ..... ) Globally accessible variables of this process type fieldN: ) constructor init (name:pname, index:integer, ... ) ; --- OPTIONAL may beef up standard init -- procedure lifecycle; VIRTUAL; - MUST define a life cycle < other special methods > end; The minimum requirement is: Giant = object (procdescr) procedure lifecycle; VIRTUAL; end; Create instances, and initialize, using NEW and Init: VAR bigboy : GiantPtr; NEW (bigboy, init('Rumble-Buffin', 42, ... )); (replaces CREATE) RESUME (bigboy); -- to put on ready queue (replaces START) =========================================================================== A process needs its own stack, and a small record to record its state when it is not running. The state includes : Program counter Stack pointer It also could use: An external name (string) A numeric identifier, which could be used to index a table of neighbor processes (e.g. #3 has neighbors 2 & 4) A pointer slot so processes could be linked in a queue A wakeup time for sleeping processes (simulated time in this case) status : (running, ready, sleeping, suspended, blocked ... ) AND it can have its own particular (visible) state variables. Its code, or life cycle, is a procedure, declared as a VIRTUAL method named LifeCycle. To Create a new process, Allocate a block of heap memory for its stack Allocate a process record (pointer to be returned) Store its starting address (of the procedure defining it) and stack info in its record. For main, we need a process record with pointer to self, and keep a pointer to main, when it transfers control to first co-outine, that will initialize its saved stack and program counter fields. A Transfer between processes is accomplished by saving the program counter (CS:IP) for resuming, changing the stack and stack pointer, and jumping to the program counter of the new process. =================================================================== (in PROC_MAN ) Further utilities include a monitor for scheduling processes, using a ready queue (FIFO), a sleep queue (ordered by simulated-time wakeup), Semaphores, and message passing primitives. =================================================================== } TYPE pname = string[10]; {process has external name} statustype = (running, ready, suspended, blocked, sleeping, terminated); process = ^procdescr; procdescr = OBJECT(queueElement) { next : ElementPtr; -- inherited from QUEUE } { -----------^^^^^^^^^^^^ !!!! must typecast to process, see PROC_MAN} {VMT address here!!} stack : pointer; {segment : offset of start of stack} {segment goes in SS offset goes in global StackLimit} StackPointer : word; {save current stack pointer} {CS:IP of non-running proc is on top of its stack} BasePointer : word; {save current BP -- sept 96} name : pname; {string for external name} index : integer; {might be useful for indexing a table of neighbors} Status : statustype; {what this process is doing} WakeUp : REAL; {simulated wakeup time for sleeping procs} Since : REAL; {time of last state change, for report} {---- methods ----} constructor Init (myname:pname; aNumber:Integer); procedure lifeCycle; VIRTUAL; {user must define life cycle, for a descendent object!} function before (old:ElementPtr): BOOLEAN; virtual; {for ordered lists, define what it means for SELF to come before an old element} procedure report; virtual; {report on current status} private constructor MAKEMAIN; destructor Kill; {process kills itself by marking status of } { terminated. TRANSFER kills on its behalf} end; {-------- for reporting purposes, keep a list (stack) of processes created. Terminating processes will be replaced by NIL, surviving processes will be reported upon at end of RunSimulation ---------} plistelemptr = ^ plistelem; plistelem = OBJECT (queueElement) proc : process; constructor init (pr : process); function equal (old:ElementPtr): BOOLEAN; virtual; {for Erase, define what object equality means} end; plistobj = object (STACKwithErase) termCount : Word; procedure erase (body:process); end; {-----------------------------------------------------------------} procedure TRANSFER (me:process; you:process); {context switch} {procedure MAKEMAIN (VAR main:process); } {gives main a block} {========================================================================} VAR curproc : process; {so running process can point to itself} main : process; {monitor (RESCHEDULE) can get back to main} processlist : plistobj; {record created procs, for report} IMPLEMENTATION USES PROC_MAN; {needs to reference TERMINATE } CONST StackSize = 1024; {size of stack area for each process - watch it!} type proc = procedure; {-----------------------------------------------------------------} { on the stack at the start of process life-cycle execution is: | | | | top of stack--> | adr of lifecycle | started by a RETF | adr of terminate | "return" here at end of life cycle | pointer to self | only (assumed) parameter of method |-----------------------| } stackframeptr = ^stackframe; stackframe = record freespace : array [1..StackSize-12] of BYTE; startadr : pointer; termadr : pointer; selfadr : process; end; var corpse : process; {points to terminated process to be killed} {----------------------------------------------------------------------- Initial Stack for a process, as though life cycle has just been called, and we actually start it by getting its address with a RETF instr.: self (seg) implied parameter self (offset) ret. adr (seg) ret. adr (offset) BP--> adr of lifecycle (seg) adr of lifecycle (offset) } constructor procdescr.init (myname:pname; aNumber:Integer); {initialize a process block with its own stack} {code is the procedure defining what the process does} var life : pointer; pptr : plistelemptr; selfadd : pointer; frameptr : stackframeptr; begin New (frameptr); {allocate space for stack frame} status := suspended; name := myname; index := aNumber; wakeup := 0.0; since := 0.0; {remember process for reporting (in proc_man)} selfadd := Addr(self); new (pptr, init(selfadd)); { pptr^.proc := selfadd;} processlist.push (pptr); stack := frameptr; {get address of life cycle from VMT} asm les di,self {addr of vmt addr ?} mov di,es:[di+4] {offset of VMT} mov ax, [di+lifecycleoff] {lifecycle is 3rd Virtual method. add 4 for version 7.0 due to altered VMT fmt} mov word ptr life,ax mov ax, [di+lifecycleoff+2] mov word ptr [life+2], ax end; with frameptr^ do {set up initial stack addresses} begin startadr := life; termadr := Addr (Terminate); selfadr := selfadd; end; stackpointer := Ofs(frameptr^) + StackSize -12; {initial stack pointer} end; {========================================================================} procedure ProcDescr.LifeCycle; {process classes must be defined with their own life cycles: object(procdescr)} BEGIN WRITELN ('WARNING, ', GetName, ' has no life cycle defined!'); END; procedure Procdescr.Report ; {report on one process} begin WRITE (name:20, index:5, ' since ', since:8:2, ' is '); CASE status of running : begin Write ('Started Running at '); TheClock.rite; Writeln; end; ready : Writeln ('Ready'); suspended : Writeln ('Suspended'); blocked : Writeln ('Blocked at a semaphore or port'); sleeping : Writeln ('Sleeping until ', Wakeup:8:2); terminated: Writeln ('Terminated'); end {case} end; {ProcessReport} function procdescr.Before ( old:ElementPtr) : BOOLEAN; begin if (old = nil) then Before := TRUE else Before := {self} wakeup < process(old)^.wakeup end; {time comparison: Before} destructor procdescr.Kill; {release the space of a terminated process} begin FreeMem (stack, stacksize); end; {========================================================================} procedure TRANSFER (me:process; you:process); {context switch} {me must be currently running process} label {!!!!! assumed model is FAR call since in interf!!!} BackHere; begin if me^.status = terminated then corpse := me; {prepare to release space} { me^. } asm les di,[bp+10] {es:di points to me} {note: first 4 bytes for queue slot} {===> LOOK INTO USING stack TO GET THIS OFFSET, INCASE ANCESTOR OBJ. CHANGES} mov ax,StackLimit mov es:[di+6],ax {.stack (offset) } mov es:[di+8],SS mov ax,cs push ax {save far return on stack} lea bx,BackHere push bx mov es:[di+10],SP {save stack pointer -- AFTER pushing address !!} mov es:[di+12],BP {also save BP} {------------ now change stacks -----} les di,[bp+6] {point to you} mov ax, es:[di+6] mov StackLimit,ax mov SS, es:[di+8] {restore stack segment} mov SP, es:[di+10] {restore stack pointer} mov BP, es:[di+12] end; {-- Now using stack of new process} if corpse <> nil then begin {free space of terminated process} Dispose (corpse,kill) ; corpse := nil end; asm RETF {control to you} BackHere: end; end; {TRANSFER} constructor procdescr.MAKEMAIN {(VAR main:process)}; {Make a process control block for the main program, so that it can participate in process swaps.} begin { NEW (main); with main^ do begin } status := running; name := 'MAINLINE'; index := maxint; wakeup := 0.0; since := 0.0; { end; } end; {MAKEMAIN} { ----------------- Methods for list of processes (used for report) -------} constructor pListElem.init (pr : process); begin queueelement.init; proc := pr; end; function pListElem.Equal ( old:ElementPtr) : BOOLEAN; begin if typeof(self) <> typeof(old^) then writeln('INVALID COMPARE'); Equal := (proc = plistelemptr(old)^.proc) end; procedure plistobj.erase (body : process); {find this process in list and remove its entry, no longer keeping track of it} var handle : plistelemptr; begin termcount := termcount + 1; {keep count of terminated procs for report} new (handle,init(body)); { handle^.proc := body; } IF TypeOf(plistelem) = TypeOf(handle^) then list . erase ( handle ); dispose (handle); end; begin { --- INITIALIZATION --- } new (main, MAKEMAIN); corpse := nil; curproc := main; processlist . init; processlist . termcount := 0; end.