home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 4 / Apprentice-Release4.iso / Source Code / Libraries / PNL Libraries / MyDriver.p < prev    next >
Encoding:
Text File  |  1995-03-19  |  13.8 KB  |  346 lines  |  [TEXT/CWIE]
  1. unit MyDriver;
  2.  
  3. { Code thanks to Pete Resnick }
  4.  
  5. interface
  6.  
  7.     uses
  8.         Devices;
  9.         
  10.     const
  11.         dOpened = $0020;
  12.         dRAMBased = $0040;
  13.  
  14. { Structure of the driver resource }
  15.     type
  16.         DriverRecord = record
  17.                 drvrFlags: integer;
  18.                 drvrDelay: integer;
  19.                 drvrEMask: integer;
  20.                 drvrMenu: integer;
  21.                 drvrOpen: integer;
  22.                 drvrPrime: integer;
  23.                 drvrCtl: integer;
  24.                 drvrStatus: integer;
  25.                 drvrClose: integer;
  26.                 drvrName: str63;
  27. { driver name and code follows }
  28.             end;
  29.         DriverPtr = ^DriverRecord;
  30.         DriverHandle = ^DriverPtr;
  31.         DCtlArray = array[0..1000] of DCtlHandle;
  32.         DCtlArrayPtr = ^DCtlArray;
  33.  
  34. { These two routines are the ones you want to call }
  35.     function InstallRAMDriver (name: Str255; var refnum: integer; openit: boolean): OSErr;
  36.     function RemoveRAMDriver (refnum: integer): OSErr;
  37.  
  38.     function DriverIsOpen (name: Str255): boolean;
  39.  
  40. { These are used internally but might be useful in unusual circumstances }
  41.     function GetDriverRefNum (name: str255): integer;
  42.     function SizeUTable (entries: integer): OSErr;
  43.     function DriverAvail (var unitNum: integer): OSErr;
  44.     function Get1XResource (var rsrcHndl: Handle; rsrcType: ResType; rsrcID: integer; rsrcInd: integer; rsrcName: StringPtr): OSErr;
  45.     function Get1SysXRsrc (var rsrcHndl: Handle; rsrcType: ResType; rsrcID: integer; rsrcInd: integer; rsrcName: StringPtr): OSErr;
  46.     function PtrInZone (theZone: THz; thePtr: univ Ptr): boolean;
  47.     function HandleInZone (theZone: THz; theHandle: univ Handle): boolean;
  48.  
  49. { Undefined, but documented routines }
  50.     function DriverInstall (drvrHandle: handle; refnum: integer): OSErr;
  51.     inline
  52.         $301F, $205F, $2050, $A03D, $3E80;
  53.     function DriverRemove (refnum: integer): OSErr;
  54.     inline
  55.         $301F, $A03E, $3E80;
  56.  
  57. { Interupt enable/disable }
  58.     function DisableInterrupts: integer;
  59.     inline
  60.         $4007, $46FC, $2600;
  61.     procedure ResetStatusRegister (oldSR: integer);
  62.     inline
  63.         $46DF;
  64.  
  65. { Access low memory globals }
  66.     function LMUTableBase: DCtlArrayPtr;
  67.     inline
  68.         $2EB8, $011C;
  69.  
  70.     procedure LMSetUTableBase (addr: univ DCtlArrayPtr);
  71.     inline
  72.         $21DF, $011C;
  73.  
  74.     function LMUnitEntryCount: integer;
  75.     inline
  76.         $3EB8, $1D2;
  77.  
  78.     procedure LMSetUnitEntryCount (n: integer);
  79.     inline
  80.         $31DF, $01D2;
  81.  
  82. implementation
  83.  
  84.     uses
  85.         Resources,TextUtils;
  86.         
  87. { *    The following code is to install and remove RAM drivers in the system}
  88. { *    heap. Written by Pete Resnick with the help of J. Geagan, Joe Holt,}
  89. { *    Tom Johnson, Michael A. Libes, Charles Martin, John Norstad, Phil}
  90. { *    Shapiro, Eric Braun, David Brown and Matthias Urlichs. Feel free to}
  91. { *    use this in your code, though I do ask that you give credit. Please}
  92. { *    report any bugs to Pete Resnick - resnick@cogsci.uiuc.edu. Please read}
  93. { *    the README file and check defines in drvrincludes.h before you use}
  94. { *    this code!!}
  95. { *}
  96. { *    Change Log}
  97. { *    ----------}
  98. { *    Date:        Change:                                                Who:}
  99. { *    -----        -------                                                ----}
  100. { *    6/2/92        Changed ThinkCleanup so that it compiles and works    pr}
  101. { *    6/22/92        Corrected declaration of DisableInterrupts            eb}
  102. { *    7/1/92        Corrected declaration of DrvrInstall and DrvrRemove    eb/pr}
  103. { *    10/15/92    Changed Get1SysRsrc to Get1SysXRsrc                    pr}
  104. { *    10/18/92    Got rid of thinkReOpen; just return 1 from close    pr}
  105. { *                Fixed up PtrInZone to make it a little quicker        pr}
  106. { *    11/6/92        Got rid of auto initialize for newCode and oldCode    pr}
  107. { *                Changed PBxxx calls to PBxxxSync                    pr}
  108. { *    11/8/92        A little cleanup; moved a few things                pr}
  109. { *    12/17/92    Added HNoPurge to Get1SysXRsrc                        db/pr}
  110. { *    1/24/93        Fixed double deletion of DATA handle and dispose    db/pr}
  111. { *                of code handle -- major changes to all ThinkXXX}
  112. { *                routines and THINKProc.c}
  113. { *    2/5/93        Made DriverAvail a little more efficent                pr}
  114. { *    2/6/93        Re-wrote all of the Think routines and THINKProc.c    pr}
  115. { *                so that the THINK proc is a pointer instead of a}
  116. { *                handle (needed for locked drivers).}
  117. { *    2/23/93        Passed drvrInstFlags to RemoveRAMDriver    from        pr}
  118. { *                InstallRAMDriver error}
  119. { *    10/21/93    Check for nil handles in RemoveRAMDriver            pr}
  120. { *                Zero out close block in RemoveRAMDriver}
  121. { *                Prettified GetDriverRefNum}
  122. { *                Moved DisableInterrupts, ResetInterrupts,}
  123. { *                DrvrInstall, and DrvrRemove from driver.h to}
  124. { *                drvrincludes.h}
  125. { *                    }
  126. { *    19940212    Convert to Pascal                PNL}
  127.  
  128.  
  129. { *    InstallRAMDriver will install the named driver into the system heap}
  130. { *    return the driver reference number in refNum. }
  131.  
  132.     function InstallRAMDriver (name: Str255; var refnum: integer; openit: boolean): OSErr;
  133.         var
  134.             err, junk: OSErr;
  135.             drvrHandle: handle;
  136.             rsrcType: ResType;
  137.             rsrcID, unitNum: integer;
  138.             hndlState: signedByte;
  139.             ctlEntryPtr: DCtlPtr;
  140.             drvrPtr: DriverPtr;
  141.             pb: ParamBlockRec;
  142.     begin
  143.  
  144.         err := noErr;
  145.  
  146.         if GetDriverRefNum(name) <> 0 then
  147.             err := badUnitErr;
  148.  
  149.         if err = noErr then
  150.             err := DriverAvail(unitNum);
  151.  
  152.         if err = noErr then
  153.             err := Get1SysXRsrc(drvrHandle, 'DRVR', 0, 0, @name);
  154. { Why not just rely on the resource being set to system and non-purgeable and just use Get1NamedResource??? }
  155.  
  156.         if err = noErr then begin
  157.             GetResInfo(drvrHandle, rsrcID, rsrcType, name);
  158.             err := ResError;
  159.  
  160.             if err = noErr then begin
  161.                 DetachResource(drvrHandle);
  162.                 err := ResError;
  163.             end;
  164.  
  165.             if err <> noErr then
  166.                 ReleaseResource(drvrHandle);
  167.         end;
  168.  
  169.         if err = noErr then begin
  170.  
  171.     { Install DRVR with the refNum.  }
  172.             refnum := -(unitNum + 1);
  173.             hndlState := HGetState(drvrHandle);
  174.             HLock(drvrHandle);
  175.             err := DriverInstall(drvrHandle, refnum);
  176.             HSetState(drvrHandle, hndlState);
  177.  
  178.     { Cleanup on errors }
  179.             if err <> noErr then
  180.                 DisposeHandle(drvrHandle);
  181.         end;
  182.  
  183.         if err = noErr then begin
  184.     { Move the important information to the driver entry }
  185.             ctlEntryPtr := GetDCtlEntry(refnum)^;
  186.             drvrPtr := DriverHandle(drvrHandle)^;
  187.             ctlEntryPtr^.dCtlDriver := ptr(drvrHandle);
  188.             ctlEntryPtr^.dCtlFlags := BOR(drvrPtr^.drvrFlags, dRAMBased);
  189.             ctlEntryPtr^.dCtlDelay := drvrPtr^.drvrDelay;
  190.             ctlEntryPtr^.dCtlEMask := drvrPtr^.drvrEMask;
  191.             ctlEntryPtr^.dCtlMenu := drvrPtr^.drvrMenu;
  192.  
  193.     { Open the driver }
  194.             if openit then begin
  195.                 pb.ioCompletion := nil;
  196.                 pb.ioNamePtr := @name;
  197.                 pb.ioPermssn := fsCurPerm;
  198.                 err := PBOpenSync(@pb);
  199.             end;
  200.  
  201.     { If an error occurred during the open, remove the DRVR }
  202.             if err <> noErr then
  203.                 junk := RemoveRAMDriver(refnum);
  204.         end;
  205.  
  206.         InstallRAMDriver := err;
  207.     end;
  208.  
  209.  
  210. { *    RemoveRAMDriver removes the driver installed in the system heap by}
  211. { *    InstallRAMDriver.}
  212.  
  213.     function RemoveRAMDriver (refnum: integer): OSErr;
  214.         var
  215.             err: OSErr;
  216.             drvrHandle: handle;
  217.             ctlEntryHndl: DCtlHandle;
  218.             pb: ParamBlockRec;
  219.     begin
  220.         err := noErr;
  221.  
  222.     { Get the driver control entry }
  223.         ctlEntryHndl := GetDCtlEntry(refNum);
  224.         if ctlEntryHndl = nil then
  225.             err := unitEmptyErr;
  226.  
  227.     { Check for nil handle }
  228.         if (err = noErr) & (ctlEntryHndl^ = nil) then
  229.             err := nilHandleErr;
  230.  
  231.         if err = noErr then begin
  232.     { Get the driver handle }
  233.             drvrHandle := handle(ctlEntryHndl^^.dCtlDriver);
  234.  
  235. { close the driver }
  236.             if BAND(ctlEntryHndl^^.dCtlFlags, dOpened) <> 0 then begin
  237.                 pb.ioResult := 0;
  238.                 pb.ioNamePtr := nil;
  239.                 pb.ioVRefNum := 0;
  240.                 pb.ioRefNum := refNum;
  241.                 pb.ioPermssn := 0;
  242.                 err := PBCloseSyn
  243.                 end;
  244.             end
  245.             else begin
  246.                 err := unitTblFullErr;
  247.             end;
  248.         end;
  249.  
  250.         DriverAvail := err;
  251.     end;
  252.  
  253.  
  254. { *    Get1XResource gets a handle to a resource. The resource}
  255. { *    will be retrieved according to resource type and either resource name,}
  256. { *    or resource index, or resource ID, in that order, whichever is}
  257. { *    non-zero.}
  258.  
  259.     function Get1XResource (var rsrcHndl: Handle; rsrcType: ResType; rsrcID: integer; rsrcInd: integer; rsrcName: StringPtr): OSErr;
  260.         var
  261.             err: OSErr;
  262.     begin
  263.         if rsrcName <> nil then begin
  264.             rsrcHndl := Get1NamedResource(rsrcType, rsrcName^);
  265.         end
  266.         else if rsrcInd <> 0 then begin
  267.             rsrcHndl := Get1IndResource(rsrcType, rsrcInd);
  268.         end
  269.         else begin
  270.             rsrcHndl := Get1Resource(rsrcType, rsrcID);
  271.         end;
  272.         err := ResError;
  273.         if (err = noErr) & (rsrcHndl = nil) then
  274.             err := resNotFound;
  275.         Get1XResource := err;
  276.     end;
  277.  
  278.  
  279. { *    Get1SysXRsrc gets a handle to the requested resource making sure that}
  280. { *    both the resource itself and the master pointer are in the system heap}
  281. { *    and non-purgeable. }
  282.  
  283.     function Get1SysXRsrc (var rsrcHndl: Handle; rsrcType: ResType; rsrcID: integer; rsrcInd: integer; rsrcName: StringPtr): OSErr;
  284.         var
  285.             savedZone, tempSysZone: THz;
  286.             err, ptrCode: OSErr;
  287.     begin
  288.     { Make sure everything loads in the system heap }
  289.         savedZone := GetZone;
  290.         tempSysZone := SystemZone;
  291.         SetZone(tempSysZone);
  292.         SetResLoad(true);
  293.  
  294.         err := Get1XResource(rsrcHndl, rsrcType, rsrcID, rsrcInd, rsrcName);
  295.         if (err = noErr) & not HandleInZone(tempSysZone, rsrcHndl) then begin
  296.             ReleaseResource(rsrcHndl);
  297.             err := Get1XResource(rsrcHndl, rsrcType, rsrcID, rsrcInd, rsrcName);
  298.         end;
  299.         if (err = noErr) & not HandleInZone(tempSysZone, rsrcHndl) then begin
  300.             ReleaseResource(rsrcHndl);
  301.             err := memAZErr;
  302.         end;
  303.         if err = noErr then begin
  304.             HNoPurge(rsrcHndl);
  305.         end;
  306.  
  307.     { Restore the zone to what it was }
  308.         SetZone(savedZone);
  309.         Get1SysXRsrc := err;
  310.     end;
  311.  
  312.  
  313. { *    PtrInZone just checks to see whether the specified pointer is within}
  314. { *    the specified zone.}
  315.  
  316.     function PtrInZone (theZone: THz; thePtr: univ Ptr): boolean;
  317.         var
  318.             stripMask, testPtr, dataStart, dataLim: longInt;
  319.     begin
  320.         testPtr := longInt(StripAddress(thePtr));
  321.         dataStart := longInt(StripAddress(@theZone^.heapData));
  322.         dataLim := longInt(StripAddress(theZone^.bkLim));
  323.         PtrInZone := (dataStart <= testPtr) & (testPtr < dataLim);
  324.     end;
  325.  
  326.  
  327. { *    HandleInZone just checks to see whether the specified pointer is within}
  328. { *    the specified zone.}
  329.  
  330.     function HandleInZone (theZone: THz; theHandle: univ Handle): boolean;
  331.     begin
  332.         HandleInZone := PtrInZone(theZone, theHandle) & PtrInZone(theZone, theHandle^);
  333.     end;
  334.  
  335.  
  336. { *    DriverIsOpen is self evident }
  337.  
  338.     function DriverIsOpen (name: Str255): boolean;
  339.         var
  340.             refnum: integer;
  341.     begin
  342.         refnum := GetDriverRefNum('.ipp');
  343.         DriverIsOpen := (refnum <> 0) & (BAND(GetDCtlEntry(refnum)^^.dCtlFlags, dOpened) <> 0);
  344.     end;
  345.  
  346. end.