UNIT ExecSupport;

{$opt q }

INTERFACE

USES Exec1;

PROCEDURE NewList (list: p_List);

FUNCTION  CreatePort (name: Str; pri: Byte) : p_MsgPort;

PROCEDURE DeletePort (port: p_MsgPort);

FUNCTION  CreateStdIO (ioReplyPort: p_MsgPort): Ptr;

PROCEDURE DeleteStdIO (ioStdReq: Ptr);

FUNCTION  CreateExtIO (ioReplyPort: p_MsgPort; size: Long) : Ptr;

PROCEDURE DeleteExtIO (ioExt: Ptr);

PROCEDURE BeginIO (ioReq: Ptr);


IMPLEMENTATION

{$incl 'exec/io.h', 'exec/ports.h' }

CONST
  MEMF_PUBLIC = $1;
  MEMF_CLEAR  = $10000;

TYPE
  typtyp = (_port, _io)
  listptr = ^listtyp;
  listtyp = Record
              next: listptr;
              Case typ: typtyp Of
               _port: (port: p_MsgPort);
               _io  : (io  : Ptr);
            End;

VAR portlist : listptr;


Procedure NewList;
  Begin
    With list^ Do
      Begin
        lh_tail := Nil;
        lh_TailPred := Ptr(list);
        lh_head := Ptr (Long(list) + 4)
      End
  End;


Procedure Aushängen(VAR p: listptr; data: Ptr);
  Var hilf: listptr;
  Begin
    If p=Nil Then Error('DeletePort error');
    If p^.port = data Then
      Begin hilf := p;
            p := p^.next;
            Dispose(hilf) End
    Else Aushängen(p^.next, data)
  End;


Procedure Einhängen( t: typtyp; p: Ptr);
  Var v: listptr;
  Begin
    New (v);
    With v^ Do
      Begin
        typ := t;
        Case t Of
          _port: port := p;
          _io  : io   := p
        End;
        next := portlist
      End;
    portlist := v
  End;


Function CreatePort;
  Var port   : p_MsgPort;
      sigbit : Byte;
  Begin
    port := Ptr (Alloc_Mem (SizeOf(MsgPort), MEMF_CLEAR or MEMF_PUBLIC ));

    sigbit := AllocSignal(-1);
    If sigbit <> -1 Then
      With port^, mp_Node Do
        Begin
          ln_Name := name;
          ln_Pri := pri;
          ln_Type := NT_MSGPORT;
          mp_Flags := PA_SIGNAL;
          mp_SigBit := sigbit;
          mp_SigTask := FindTask(Nil);
          If Ptr(Name) <> Nil Then
            AddPort (port)
          Else
            NewList (^port^.mp_MsgList)
        End;

    Einhängen (_port, port);
    CreatePort := port

  End;


Procedure DeletePort;

  Begin { DeletePort }
    Aushängen (portlist, port);

    If Ptr(port^.mp_Node.ln_Name) <> Nil Then
      RemPort (port);

    port^.mp_Node.ln_Type := $FF;
    port^.mp_MsgList.lh_head := Ptr(-1);

    FreeSignal (port^.mp_SigBit);
    Free_Mem (Long(port), SizeOf (port^) )
  End;


Function CreateStdIO;
  Begin
    CreateStdIO := CreateExtIO (ioReplyPort, SizeOf(IoStdReq));
  End;


Procedure DeleteStdIO;
  Begin
    DeleteExtIO (ioStdReq)
  End;


Function CreateExtIO;
  Var ioReq: p_IORequest;
  Begin
    If ioReplyPort=Nil Then
      CreateExtIO := Nil
    Else
      Begin
        ioReq := Ptr (Alloc_Mem (size, MEMF_CLEAR or MEMF_PUBLIC));
        With ioReq^, io_Message Do
          Begin
            mn_Node.ln_Type := NT_MESSAGE;
            mn_Length := size
            mn_ReplyPort := ioReplyPort
          End;
        Einhängen (_io, ioReq)
        CreateExtIO := ioReq;
      End
  End;


Procedure DeleteExtIO;
  Var io: p_IoRequest;
  Begin
    Aushängen (portlist, ioExt);
    io := ioExt;
    If io <> Nil Then
      With io^ Do
        Begin
          io_Message.mn_Node.ln_Type := $FF;
          io_Device := Ptr(-1);
          io_Unit := Ptr(-1);
          Free_Mem (Long (ioExt), io^.io_Message.mn_Length)
        End;
  End;


Procedure BeginIO;
  Var io: p_IoRequest;
    Library io^.io_Device:
    -30: Procedure Begin_IO (a1:p_IoRequest)
    End;
  Begin
    io := ioReq;
    Begin_IO (io)
  End;


Procedure Exitus;
  { Exit-Server: alle eingerichteten Ports löschen }
  Begin
    While portlist<>Nil Do
      Case portlist^.typ Of
         _port: DeletePort  (portlist^.port)
         _io  : DeleteExtIO (portlist^.io)
       End;
  End;


BEGIN { Init-Teil }
  portlist := nil;
  AddExitServer(Exitus)
End.