C!T ROM 2/ctrom_ii_b.zip/ctrom_ii_b/PROGRAM/PASCAL/MULTI12/MULTI.PAS

Pascal/Delphi Source File | 1989-06-04 | 15KB | 603 lines

Unit Multi;

{
       MULTI-PROGRAMMING KERNEL FOR TURBO PASCAL 5.0, VERSION 1.2
       ==========================================================

      Copyright 1989 Anders Wolf Pedersen. You may use this product on a
    shareware basis, i.e. if you find it usefull you should send
    Dkr 150, US$ 20 or what you deem appropriate to

                     Anders Wolf Pedersen
                     Vejlegade 9,5.th
                     DK 2100 Koebenhavn
                     Denmark

    Small contributions will be accepted with gratitude, large with greed.
    If you use this product and do not make a contribution, bad luck will
    haunt you: spurious bugs will appear in your programs, your disks will
    crash, your computer will die in a puff of blue smoke, your dog will
    bite you, and your life will in general be miserable.
      You may distribute this product freely on the conditions that you
    a) include this message, b) do not charge anything for it, and c) do not
    modify it in any way.
      I can not accept responsability for any problems you may encounter
    as a result of using this product, nor can I guarantie that it will
    perform as claimed. I have, however, checked it as carefully as I
    possibly can and I hope that you will find it usefull. Your use of the
    program constitutes an accept of all responsability of the consequenses.
      This file should be accompanied by a file MULTI.DOC which contains
    documentation for the product. If you have any comments to the unit
    or suggestions for improvement, I will be glad to hear from you. I can
    be reached on bitnet address ANDERSWP@DKNBI51 or FIDO-net address
    2:231/47 Anders Pedersen.
      However, I can not assist you in debugging your multiprograms or
    otherwise give you any service; you are on your own. Good luck.

}


Interface

Uses  Dos;


Const TimerIntNo =  8;                 { Interruptno. for timer }
      SavedInt   = 78;                 { Int.no. for rerouting timer }
      Interleave =  1;                 { Interleave factor for timeslicing }

Type  QueueType         = ^ProcDescriptor;
      Process           = QueueType;

      ProcDescriptor    = Record
                               Next      : QueueType;
                            Inqueue   : ^QueueType;
                     Sseg,
                            Sp,
                            ProcStack : Word;
                            Ptr       : Pointer;
                          End;


      Semaphore         = Record
                            Queue   : QueueType;
                            Counter : Integer;
                          End;

      Msgtype           = Pointer;

      MsgSemaphore      = Record
                            ProcQueue,
                            MsgQueue  : QueueType;
                          End;

      GetMode           = (Stay, Return);

      SwitchMode        = (Timer, NoTimer);


Procedure Wait(Var Sem: Semaphore);

Procedure Signal(Var Sem: Semaphore);

Procedure InitSem(Var Sem : Semaphore);

Procedure GetMsg(Var MsgSem: MsgSemaphore; Var Msg : Msgtype;
                  Mode: Getmode);

Procedure PutMsg(Var MsgSem : MsgSemaphore; Msg : Msgtype );

Procedure InitMsgSem(Var MsgSem : MsgSemaphore);

Procedure CreateProcess(body: Pointer; StackSize: Word;
                        Var Proc: QueueType);

Procedure Kill(Proc: Process);

Procedure StopMulti;

Procedure StartMulti(Mode : SwitchMode);

Procedure Die;

Function  NoProcesses : Integer;


{ ----------------------------------------------------------------------- }


Implementation

Var Tick,                              { Counts elapsed clock ticks }
    NoProc       : Integer;            { No. of processes in multiprogram }
    ReadyQueue,                        { Queue for processes ready to run }
    CurrentProc,                       { Pointer to currently running Proc }
    Dead,                              { Queue of Dead processes }
    Main         : QueueType;          { Pointer to desc. for Main program }
    Regs         : Registers;          { used for sofware interrupt }
    MainProg     : Process;            { Proc.descriptor for Main program }


{ ----------------------------------------------------------------------- }


Procedure Cli; Inline($FA);      { Disable interrupts }

Procedure Sti; Inline($FB);      { Enable interrupts }


{ ----------------------------------------------------------------------- }


Procedure Enqueue(Var Proc,Queue: QueueType);

{ Inserts ProcDescriptor pointed to by Proc in Queue }

   Begin
     If Queue=Nil
     Then Begin
            Queue:=Proc;
            Proc^.Next:=Proc;
          End
     Else Begin
        Proc^.Next:=Queue^.Next;
        Queue^.Next:=Proc;
            Queue:=Proc;
          End;
     Proc^.inqueue:=@Queue;
   End; { Enqueue }


{ ----------------------------------------------------------------------- }


Procedure Dequeue(Var Proc,Queue : QueueType);

{ Retreives a ProcDescriptor from Queue and returns Pointer to it in Proc. }

   Begin
     Proc:=Queue^.Next;
     If Queue=Proc
     Then Queue:=Nil
     Else Queue^.Next:=Proc^.Next;
   End; { Dequeue }


{ ----------------------------------------------------------------------- }


{$F+}

Procedure SwitchContext(OldProc,NewProc: QueueType);

{$F-}

{ Switches context from OldProc to NewProc - must compiled as FAR call }

{$IFDEF VER40 }

   Var Ofs,Seg : Word;
       Proc    : Process;

{$ELSE}

   Var Seg,Ofs : Word;
       Proc    : Process;

{$ENDIF}

   Begin
     { Save current bp,Sseg:Sp }
     Inline($55);                           { Push bp }
     OldProc^.Sp:=Sptr;
     OldProc^.Sseg:=Sseg;

     { Remove Dead processes if there are any }
     While Dead<>Nil Do
     Begin
       Dequeue(Proc,Dead);
       Dispose(Proc);
     End;

     { Get New values of Sseg:Sp for NewProc via local variables Seg,Ofs }
     Seg:=NewProc^.Sseg;
     Ofs:=NewProc^.Sp;

     Inline($8B/$46/$FE);                   { Mov  ax,ss:[bp-2] }
     Inline($8B/$5E/$FC);                   { Mov  bx,ss:[bp-4] }
     Inline($8E/$D0);                       { Mov  ss,ax }
     Inline($8B/$E3);                       { Mov  Sp,bx }

     Inline($5D);                           { Pop  bp }

   End; { SwitchContext }


{ ----------------------------------------------------------------------- }


Procedure Wakeup(Var Queue: QueueType);

   Var OldProc,NewProc : QueueType;

   Begin
     While Queue=Nil Do           { If no Processes, Wait for something to }
     Begin                        { happen }
       Sti;
       Cli;
     End;

     Dequeue(OldProc,CurrentProc);
     Enqueue(OldProc,ReadyQueue);

     Dequeue(NewProc,Queue);
     Enqueue(NewProc,CurrentProc);

     SwitchContext(OldProc,CurrentProc);
   End;


{ ----------------------------------------------------------------------- }


Procedure Sleep(Var Queue: QueueType);

   Var OldProc,NewProc : QueueType;

   Begin
     Dequeue(OldProc,CurrentProc);
     Enqueue(OldProc,Queue);

     While ReadyQueue=Nil Do      { If no Processes, Wait for something to }
     Begin                        { happen }
       Sti;
       Cli;
     End;

     Dequeue(NewProc,ReadyQueue);
     Enqueue(NewProc,CurrentProc);

     SwitchContext(OldProc,CurrentProc);
   End;


{ ----------------------------------------------------------------------- }


Procedure Wait(Var Sem: Semaphore);

{ Performs WAIT-operation on Semaphore Sem }

   Begin
     Cli;

     With Sem Do
     Begin
       If Counter=0 Then Sleep(Queue);
       Counter:=Counter-1;
     End;

     Sti;
   End; { Wait }


{ ----------------------------------------------------------------------- }


Procedure Signal(Var Sem: Semaphore);

{ Performs SIGNAL operation on Semaphore Sem }

   Begin
     Cli;

     With Sem Do
     Begin
       Counter:=Counter+1;
       If Queue<>Nil Then Wakeup(Queue)
                     Else Sleep(ReadyQueue);
     End;

     Sti;
   End; { signal }


{ ----------------------------------------------------------------------- }


Procedure InitSem(Var Sem : Semaphore);

{ Initializes Semaphore Sem. MUST be done BEFORE Semaphore is used }

   Begin
     Sem.Queue:=Nil;
     Sem.Counter:=0;
   End; { InitSem }


{ ----------------------------------------------------------------------- }


Procedure GetMsg(Var MsgSem: MsgSemaphore; Var Msg : Msgtype;
                 Mode: Getmode);

{ Gets a message from message Semaphore MSGSEM. A Pointer to the
   message is returned in MSG. If Mode = Stay and there are no messages
   available, the Process will Sleep until a message arrives. If
   Mode = Return the Process will Return no matter what buf MSG will be
   Nil if there were no messages. The content of the Pointer-field of
   the message (the first 8 bytes) is undefined when returning.
}

   Var Ptr : Process;

   Begin
     Cli;

     If MsgSem.MsgQueue<>Nil
     Then Begin
            Dequeue(Ptr,MsgSem.MsgQueue);
            Msg:=Ptr;
          End
     Else case Mode of

          Stay   : Begin
                     Sleep(MsgSem.ProcQueue);
                     Dequeue(Ptr,MsgSem.MsgQueue);
                     Msg:=Ptr;
                   End;

          Return : Msg:=Nil;

          End; { Case }

     Sti;
   End; { GetMsg }


{ ----------------------------------------------------------------------- }


Procedure PutMsg( Var MsgSem : MsgSemaphore; Msg : Msgtype);

{ Puts a message pointed to by MSG in the message Semaphore MSGSEM. }

   Var Ptr : Process;

   Begin
     Cli;

     Ptr:=Msg;
     Enqueue(Ptr,MsgSem.MsgQueue);
     If MsgSem.ProcQueue<>Nil
     Then Wakeup(MsgSem.ProcQueue)
     Else Sleep(ReadyQueue);

     Sti;
   End; { PutMsg }


{ ----------------------------------------------------------------------- }


Procedure InitMsgSem(Var MsgSem : MsgSemaphore);

{ Initializes message-Semaphore MSGSEM. MUST be done BEFORE Semaphore
   is used }

   Begin
     MsgSem.MsgQueue:=Nil;
     MsgSem.ProcQueue:=Nil;
   End; { InitMsgSem }


{ ----------------------------------------------------------------------- }

{$F+}

Procedure StartProc;

{ All processes start by executing this procedure which provides
   a legitimate exit from the kernel by enabling interrupts. }

   Begin
     Sti;
   End; { StartProc }

{$F-}


{ ----------------------------------------------------------------------- }


Procedure CreateProcess(body: Pointer; StackSize: Word;
                        Var Proc: QueueType);

{ Creates a Process and adds it to the system. Process id is returned in
   form of a Pointer to the Process-descriptor in Proc. }

   Var Adr      : Longint;          { Adress of stack space for Process }
       ParmSize : Integer;          { Size of parameters in SwitchContext }

   Begin
     Cli;

     New(Proc);

     With Proc^ Do
     Begin
       { Get stack space from heap }
       getmem(Ptr,StackSize);
       Adr:=Longint(Seg(Ptr))*16+Ofs(Ptr);
       Sseg:=Adr shr 4;
       Sp:=(Adr and 15)+StackSize-64;
       ProcStack:=StackSize;

       ParmSize:=2*SizeOf(Process);

       { Set up stack to Return to body^ when Process is activated }
       MemW(.Sseg:Sp   .):=Sp+2;
       MemW(.Sseg:Sp+ 2.):=Sp+8+ParmSize;
       MemW(.Sseg:Sp+ 4.):=Ofs(StartProc);
       MemW(.Sseg:Sp+ 6.):=Seg(StartProc);
       MemW(.Sseg:Sp+ParmSize+ 8.):=Ofs(body^);
       MemW(.Sseg:Sp+ParmSize+10.):=Seg(body^);

       Enqueue(Proc,ReadyQueue);

       { Increase no. of processes in system }
       NoProc:=NoProc+1;

    End; { With }

    Sti;
  End; { CreateProcess }


{ ----------------------------------------------------------------------- }


Procedure TimeOut;
Interrupt;

{ This procedure is hooked into the timer interrupt. It switches Process
   after having called the regular driver for the timer. }

   Begin
     Cli;

     Intr(SavedInt,Regs);

     Inc(Tick);
     If ((Tick mod Interleave)=0) and (ReadyQueue<>Nil)
     Then Sleep(ReadyQueue);

     Sti;
   End; { TimeOut }


{ ----------------------------------------------------------------------- }


Procedure Kill(Proc: Process);

{ Kills the Process pointed to by Proc }

   Var QueueProc : Process;

   Begin
     Cli;

     FreeMem(Proc^.Ptr,Proc^.ProcStack);   { Release stack space on heap }

     NoProc:=NoProc-1;                     { If no processes left, stop }
     If NoProc=0 Then StopMulti;           { multiprogram }

     If Proc^.inqueue^=CurrentProc         { If killed Process was running, }
     Then Sleep(Dead)                      { start another.                 }
     Else
       Repeat                              { Otherwise remove Process. }
         Dequeue(QueueProc,Proc^.inqueue^);
         If QueueProc<>Proc Then Enqueue(QueueProc,Proc^.inqueue^);
       Until
         QueueProc=Proc;

     Sti;
   End; { Kill }


{ ----------------------------------------------------------------------- }


Procedure Die;

{ Kills the current Process }

   Begin
     Kill(CurrentProc);
   End; { Die }



{ ----------------------------------------------------------------------- }



Procedure StartMulti(Mode : SwitchMode);

{ Starts the multiprogram }

   Var IntPtr : Pointer;

   Begin
     Cli;

     { Hook TimeOut-procedure to timer interrupt }
     GetIntVec(TimerIntNo,IntPtr);
     SetIntVec(SavedInt,IntPtr);

     If Mode=Timer Then SetIntVec(TimerIntNo,@TimeOut);

     { Save Main program info }
     CurrentProc:=MainProg;
     MainProg^.Sseg:=Sseg;
     MainProg^.Sp:=Sptr;
     Sleep(Main);

     Sti;
   End; { StartMulti }


{ ----------------------------------------------------------------------- }


Procedure StopMulti;

{ Stops the multiprogram - returns to Main program }

   Var IntPtr : Pointer;

   Begin
     Cli;

     { Put timer driver back into place }
     GetIntVec(SavedInt,IntPtr);
     SetIntVec(TimerIntNo,IntPtr);

     { Return to Main program }
     Wakeup(Main);

     Sti;
   End; { StopMulti }


{ ----------------------------------------------------------------------- }


Function NoProcesses : Integer;

{ Returns the current number of processes in the system }

   Begin
     NoProcesses:=NoProc;
   End; { NoProcesses }


{ ----------------------------------------------------------------------- }


Begin { Unit Main body }

  { Initialize queues }
  ReadyQueue:=Nil;
  CurrentProc:=Nil;
  Dead:=Nil;
  Main:=Nil;

  NoProc:=0;
  Tick:=0;

  { Make descriptor for Main program and set it up as current Process }
  New(MainProg);
  Enqueue(MainProg,CurrentProc);
End.