(* OPREFS OberonOpts -mai OLinkOpts -mais *)
(*************************************************************************

:Program.    PatchPrDos.mod
:Contents.   dos.library wedge. Installed wedges: 
:Contents.   System() to use UserShell for APIPE:
:Contents.   CreateProc() to use Dos.CreateNewProc()
:Contents.   CreateNewProc() to _always_ copy local vars
:Author.     Franz Schwarz 
:Address.    Mühlenstraße 2, D-78591 Durchhausen, Germany/ R.F.A
:Address.    uucp: Franz.Schwarz@mil.ka.sub.org; Fido: 2:241/7506.18
:Language.   Oberon-2
:Translator. Amiga Oberon V3.00
:History.    V1.0 Feb 17 1993 Franz Schwarz 

*************************************************************************)
  
(* $IFNOT SmallData *)

MODULE PatchPrDos;

IMPORT 
  (* $IF DEBUG *) ng := NoGuru, (* $END *)
  e := Exec, d := Dos, u := Utility, r := Requests, y := SYSTEM; 

CONST
  verStr = "$VER: PatchPrDos 1.0 (18.2.93)";

CONST
  systemOffs = -606;
  createProcOffs = -138;
  createNewProcOffs = -498;

(* $IF DEBUG *)
VAR  
  Dbg * [0300H]: LONGINT;
(* $END *)

TYPE
  Tags2Ptr = UNTRACED POINTER TO u.Tags2;
  SystemT = PROCEDURE (Command{1}: e.STRPTR;
                       Tags{2}   : Tags2Ptr): LONGINT;

VAR
  SystemOld * : SystemT;

CONST
  systemTags = u.Tags2 (d.sysUserShell, d.DOSTRUE,
                        u.done, NIL);

(* $StackChk- $SaveRegs+ $NilChk- $OddChk- *)

PROCEDURE SystemWedge * (CommandPar{1}: e.STRPTR;
                         Tags{2}      : Tags2Ptr): LONGINT;
VAR
  Tags2  : Tags2Ptr;
  ClTags : Tags2Ptr;
  Tg     : u.TagItemPtr;
  Result : LONGINT;
  Command: e.STRPTR;
  Me     : e.TaskPtr;
BEGIN
  Command := CommandPar;  (* d0/d1 parameters are volatile! *)
  Tags2 := NIL;
  ClTags := NIL;
  Me := e.FindTask (NIL);  
  IF Me^.node.type = e.process THEN  
    IF Me^.node.name # NIL THEN      
      IF Me^.node.name^ = "Kicker Process" THEN
        IF (u.FindTagItem (d.sysUserShell, Tags^) = NIL) &
           (u.FindTagItem (d.sysCustomShell, Tags^) = NIL) THEN
          Tags2 := u.AllocateTagItems (LEN (Tags2^));
          IF Tags2 # NIL THEN
            Tags2^ := systemTags;
            (* $IF DEBUG *)
            Dbg := 0C0ADFACEH;
            (* $END *)
            IF Tags # NIL THEN
              Tags2^[1].tag := u.more;
              Tags2^[1].data := Tags;
            END;
            Tags := Tags2;
          END;
        END;
      END;
    END;
  END;
  y.SETREG (14, d.dos);
  Result := SystemOld (Command, Tags);
  IF Tags2 # NIL THEN u.FreeTagItems (Tags2^); END;
  IF ClTags # NIL THEN u.FreeTagItems (ClTags^); END;
  RETURN Result
END SystemWedge;

(* $StackChk= $NilChk= $OddChk= *)


TYPE
  Tags14Ptr = UNTRACED POINTER TO u.Tags14;
  CreateProcT = PROCEDURE (Name{1}     : e.STRPTR;
                           Pri{2}      : LONGINT;
                           SegList{3}  : e.BPTR;
                           StackSize{4}: LONGINT): d.ProcessId;

VAR
  CreateProcOld * : CreateProcT;

CONST
  crProcTags = u.Tags14 (d.npName, NIL, d.npPriority, NIL,
                        d.npSeglist, NIL, d.npStackSize, NIL,
                        d.npFreeSeglist, d.DOSFALSE, d.npCloseInput, d.DOSFALSE,
                        d.npCloseOutput, d.DOSFALSE, d.npCloseError, d.DOSFALSE,
                        d.npInput, NIL, d.npOutput, NIL, d.npError, NIL,
                        d.npCurrentDir, NIL, d.npHomeDir, NIL, u.done, NIL);

(* $StackChk- $SaveRegs+ $NilChk- $OddChk- *)

PROCEDURE CreateProcWedge * (NamePar{1}  : e.STRPTR;
                             Pri{2}      : LONGINT;
                             SegList{3}  : e.BPTR;
                             StackSize{4}: LONGINT): d.ProcessId;
VAR
  Tags14 : Tags14Ptr;
  Result : d.ProcessId;
  Pr     : d.ProcessPtr;    
  Name   : e.STRPTR;
BEGIN
  Name := NamePar;  (* d0/d1 parameters are volatile! *)
  Result := NIL;
  Tags14 := u.AllocateTagItems (LEN(Tags14^));
  IF Tags14 # NIL THEN
    Tags14^ := crProcTags;
    Tags14^[0].data := Name;
    Tags14^[1].data := Pri;
    Tags14^[2].data := y.VAL (LONGINT, SegList);
    Tags14^[3].data := StackSize;
    Pr := d.CreateNewProc (Tags14^);
    IF Pr # NIL THEN Result := d.ProcessToProcessId (Pr); END;
    u.FreeTagItems (Tags14^);
  ELSE
    y.SETREG (14, d.dos);
    Result := CreateProcOld (Name, Pri, SegList, StackSize);
  END;
  y.SETREG (1, Result);
  RETURN Result;
END CreateProcWedge;

(* $StackChk= $NilChk= $OddChk= *)


TYPE
  Tags1Ptr = UNTRACED POINTER TO u.Tags1;
  CreateNewProcT = PROCEDURE (Tags{1}: Tags1Ptr): d.ProcessPtr;
                         
VAR
  CreateNewProcOld * : CreateNewProcT;

(* $StackChk- $SaveRegs+ $NilChk- $OddChk- *)

PROCEDURE CreateNewProcWedge * (TagsPar{1}: Tags1Ptr): d.ProcessPtr;

VAR
  Tags, ClTags : Tags1Ptr;
  Tg           : u.TagItemPtr;
  Result       : d.ProcessPtr;
  
BEGIN
  Tags := TagsPar;  (* d0/d1 parameters are volatile! *)
  Result := NIL;
  ClTags := NIL;
  IF u.GetTagData (d.npCopyVars, d.DOSTRUE, Tags^) = d.DOSFALSE THEN          
    ClTags := u.CloneTagItems (Tags^);
    IF ClTags # NIL THEN
      (* $IF DEBUG *)
      Dbg := 0C070CA70H;
      (* $END *)
      Tags := ClTags;
      Tg := u.FindTagItem (d.npCopyVars, Tags^);
      IF Tg # NIL THEN              
        Tg^.data := d.DOSTRUE;
      END;
    END;
  END;
  y.SETREG (14, d.dos);
  Result := CreateNewProcOld (Tags);
  IF ClTags # NIL THEN u.FreeTagItems (ClTags^); END;
  RETURN Result;
END CreateNewProcWedge;
            
(* $StackChk= $NilChk= $OddChk= *)


BEGIN
  r.Assert (u.base # NIL, "You need OS2.04 or higher!");
  d.PrintF ("%s\n", y.ADR (verStr));
  d.PrintF ("Patching Dos.System() to use UserShell for APIPE:\n");
  d.PrintF ("Patching Dos.CreateProc() to use Dos.CreateNewProc()\n");
  d.PrintF ("Patching Dos.CreateNewProc() to _always_ copy local vars\n");

  SystemOld := y.VAL (SystemT, e.SetFunction (d.dos,
                                              systemOffs,
                                              y.VAL (e.PROC, SystemWedge)));

  CreateProcOld := y.VAL (CreateProcT,
                          e.SetFunction (d.dos,
                                         createProcOffs,
                                         y.VAL (e.PROC, CreateProcWedge)));

  CreateNewProcOld := y.VAL (CreateNewProcT,
                             e.SetFunction (d.dos,
                                            createNewProcOffs,
                                            y.VAL (e.PROC, CreateNewProcWedge)));
                                            
  LOOP
    y.SETREG (0, e.Wait (LONGSET{}));
  END;

END PatchPrDos.


(* $END SmallData *)