home *** CD-ROM | disk | FTP | other *** search
/ Beijing Paradise BBS Backup / PARADISE.ISO / software / BBSDOORW / SHSUCD11.ZIP / CDROMS.ADB < prev    next >
Text File  |  1995-06-29  |  7KB  |  189 lines
  1. --************************************************************************
  2. --
  3. --  CDROMS.ADB               Version 3.0
  4. --
  5. --
  6. --  A copyright-reserved, free use program.
  7. --  (c)John H. McCoy, 1994, 1995, Sam Houston St. Univ., TX 77341-2206
  8. --************************************************************************
  9.  
  10. with system;
  11. with text_io; use text_io;
  12. with memory, unchecked_conversion;
  13. with tty;
  14.  
  15. package body CDRoms is
  16.  
  17. CDTbl          : CDArrayAccess;
  18.  
  19. procedure GetCDStatus(Drive       : integer;
  20.                       DeviceStatus: out DEV_ReturnCodes;
  21.                       CDStatus    : out DW;
  22.                       DriverName  : out string16;
  23.                       DriverUnit  : out byte;
  24.                       Label       : out string11) is
  25.  
  26. rh             : rhs;
  27. dta            : bytesAccess;
  28. CB             : CBAccess := new CBs;
  29. begin
  30.    CB(1):= Ioctl_GetCDStatus;
  31.    Label := ("           ");
  32.    rh := ( Length  => 2+rhXs'size/8,
  33.            SubUnit => byte(Drive),
  34.            rhX     => (DeviceIoctlInput,
  35.                       (Status        => DeviceError,
  36.                        reserved      => (others =>0),
  37.                        MediaDesc     => 0,
  38.                        CBPtr         => SA_to_DW(CB(1)'address),
  39.                        TransferCount => word_to_W(5),
  40.                        Start         => word_to_W(0),
  41.                        VolIdPtr      => SA_to_DW(0) )) );
  42.  
  43.    CDs.Call(rh);
  44.    delay(0.0);
  45.    DeviceStatus := rh.rhX.IoctlIn.status;
  46.    if rh.rhX.IoctlIn.status = DeviceDone then
  47.      CDStatus := CB(2..5);
  48.      if (CB(2) AND byte(1) ) = 0 then  -- door closed
  49.        dta := new bytes(1..2048);
  50.        rh := (Length  => 2+rhXs'size/8,
  51.               SubUnit => byte(Drive),
  52.               rhX     => (DeviceReadLong,
  53.                          (Status          => DeviceError,
  54.                           reserved        => (others =>0),
  55.                           AddressMode     => 0,
  56.                           DtaPtr          => SA_to_DW(dta(1)'address),
  57.                           SectorsToRead   => word_to_W(1),
  58.                           StartSector     => Long_to_DW(16),
  59.                           ReadMode        => 0,
  60.                           InterleaveSize  => 0,
  61.                           InterleaveSkip  => 0,
  62.                           filler          => (0,0))));
  63.        CDs.Call(rh);
  64.        delay(0.0);
  65.        if rh.rhX.ReadLong.status = DeviceDone then
  66.          if dta(2..6) = string_to_bytes("CD001") then
  67.            CDTbl(Drive).Label:= bytes_to_string(dta(41..51));
  68.            Label := CDTbl(Drive).Label;
  69.            CDTbl(Drive).VolSize := dta(81..84);
  70.          elsif dta(10..14) = string_to_bytes("CDROM") then
  71.            CDTbl(Drive).Label:= bytes_to_string(dta(49..59));
  72.            Label := CDTbl(Drive).Label;
  73.            CDTbl(Drive).VolSize := dta(89..92);
  74.          else --  we don't know where label is, blank it
  75.            CDTbl(Drive).Label:= (others=>' ');
  76.          end if;
  77.        end if;
  78.        ZapBytes(dta);
  79.        DeviceStatus := rh.rhX.ReadLong.status;
  80.      end if;
  81.    end if;
  82.    ZapCBs(CB);
  83.    DriverName :=(others=>' ');
  84.    if CDTbl(Drive).EType = CD then
  85.      DriverName(1..8) := CDTbl(Drive).Driver.Name(1..8);
  86.    else
  87.      DriverName := CDTbl(Drive).File.Name(1..16);
  88.    end if;
  89.    DriverUnit := CDTbl(Drive).Unit;
  90. end GetCDStatus;
  91.  
  92. task body CDRoms is
  93.   Stop            : boolean := False;
  94.   LastCD          : integer := -1;
  95.   pkt             : pkts;
  96.   rh              : rhs;
  97.   CB             : CBAccess := new CBs;
  98.  
  99.   procedure CallCDDriver (rh: in out rhs) is
  100.     CDIndex         : integer;
  101.   begin
  102.     CDIndex         := integer(rh.SubUnit);
  103.     if CDIndex > LastCD then
  104.       -- the following is a kludge
  105.       -- bytes 5 & 6 in rh are device return code(status) for all subcommands
  106.       pkt    := Rhs_to_Pkts(rh);  -- just convert dont't shift
  107.       pkt(5..6) := W(DeviceError OR DeviceDone OR DeviceUnknownUnit);
  108.       rh     := Pkts_to_Rhs(pkt);
  109.     elsif (CDTbl(CDIndex).EType = IMG) then
  110.       case rh.rhX.command is
  111.         when DeviceReadLong =>
  112.           DIo.Set_Index(CDTbl(CDIndex).File.Img_F.all,
  113.                   DIO.positive_count(DW_to_Long(rh.rhX.ReadLong.StartSector)));
  114.           declare
  115.             dtaPtr : DW :=rh.rhX.ReadLong.dtaPtr;
  116.           begin
  117.             for i in 1..W_to_Word(rh.rhX.ReadLong.SectorsToRead) loop
  118.               if DIO.End_of_File(CDTbl(CDIndex).File.Img_F.all) then
  119.                 rh.rhX.ReadLong.SectorsToRead := Word_to_W(i-1);
  120.                 exit;
  121.               end if;
  122.               DIO.Read(CDTbl(CDIndex).File.Img_F.all,
  123.                   DW_to_SectorsAccess(dtaPtr).all);
  124.               dtaPtr := Long_to_DW(DW_to_Long(dtaPtr)+long_integer(Sectors'last));
  125.             end loop;
  126.           end;
  127.           rh.rhX.ReadLong.Status := DeviceDone;
  128.         when DeviceIoctlInput =>
  129.           CB := DW_to_CBAccess(rh.rhX.IoctlIn.CBPtr);
  130.           case CB(1) is
  131.             when Ioctl_ReadDriveBytes => rh.rhX.IoctlIn.Status := DeviceDone;
  132.             when Ioctl_GetCDStatus => CB.all(2..5):= CDTbl(CDIndex).Status;
  133.                       rh.rhX.IoctlIn.Status := DeviceDone;
  134.             when Ioctl_RetSectorSize => CB.all(2) := 0;
  135.                       CB.all(3..4):= Word_to_W(2048);
  136.                       rh.rhX.IoctlIn.Status := DeviceDone;
  137.             when Ioctl_RetVolSize => CB.all(2..5):= CDTbl(CDIndex).VolSize;
  138.                       rh.rhX.IoctlIn.Status := DeviceDone;
  139.             when Ioctl_MediaChanged => CB.all(2):= 1;
  140.                       rh.rhX.IoctlIn.Status := DeviceDone;
  141.             when others => rh.rhX.IoctlIn.Status := DeviceDone OR
  142.                                               DeviceUnknownCommand OR
  143.                                               DeviceError;
  144.           end case;
  145.         when DeviceIoctlOutput =>
  146.                        rh.rhX.IoctlOut.Status := DeviceDone;
  147.         when DeviceReadLongPrefetch =>
  148.                        rh.rhX.ReadLong.Status := DeviceDone;
  149.         when DeviceSeek =>
  150.                        rh.rhX.Seek.Status := DeviceDone;
  151.        when Others =>  rh.rhX.Other.Status := DeviceDone OR
  152.                                               DeviceUnknownCommand OR
  153.                                               DeviceError;
  154.       end case;
  155.     else
  156.       rh.SubUnit          := CDTbl(CDIndex).Unit;
  157.       pkt                 := Rhs_to_Pkts(rh);
  158.       pkt(3..pkts'last-1) := pkt(4..pkts'last);
  159.       CallDriver (rh              => pkt(1)'address,
  160.                   DeviceStrategy  => CDTbl(CDIndex).Driver.Strategy,
  161.                   DeviceInterrupt => CDTbl(CDIndex).Driver.Interrupt);
  162.       pkt(4..pkts'last)   := pkt(3..pkts'last-1);
  163.       pkt(3)              := 0;
  164.       rh                  := Pkts_to_Rhs(pkt);
  165.       rh.SubUnit          := byte(CDIndex);
  166.     end if;
  167.   end CallCDDriver;
  168.   pragma inline(CallCDDriver);
  169.  
  170. begin
  171.   accept SetUp(pCDTbl: CDArrayAccess ) do
  172.     CDTbl := pCDTbl;
  173.     LastCd := CDTbl.all'last;
  174.   end SetUp;
  175. loop
  176.   select
  177.     accept Call (rh: in out rhs) do
  178.       CallCDDriver(rh);
  179.     end Call;
  180.   or
  181.     accept ShutDown do
  182.       Stop := True;
  183.     end ShutDown;
  184.   end select;
  185.   exit when Stop;
  186. end loop;
  187. end CDRoms;
  188.  
  189. end CDRoms;