home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 7 / 07.iso / c / c221 / 5.ddi / MWHC.005 / X3 < prev    next >
Encoding:
Text File  |  1992-12-09  |  2.2 KB  |  71 lines
  1. -- An exact copy of this module appears in both the Pascal and C libraries.
  2. {*********************************************************************
  3. (C) Copyright 1983-92 MetaWare Incorporated;  Santa Cruz, CA 95060.
  4. *********************************************************************}
  5. Export(System,MSDOS,Fileh_type);
  6. pragma include('STATUS.pf');
  7. pragma include('SYSTEM.pf');
  8. pragma include('MSDOS.pf');
  9. pragma fragmented_implementation(System);
  10. pragma fragmented_implementation(MSDOS);
  11. with Status;
  12.  
  13. program Implement_DOS_interface;
  14. pragma Alias(Implement_DOS_interface,Implement.RTE || 'dos_interface3');
  15. pragma off(emit_names); pragma on(optimize_for_space);
  16.  
  17. with Registers;
  18. with Loopholes:[Address,Adr,Retype,&,Move,<<,|];
  19.  
  20. #if PPLIB
  21. function Cstring(const Pstring:String; var Buf:Strcopy):Address;
  22.    var Last:Cardinal;
  23.    begin
  24.    Move(Adr(Pstring[1]),Adr(Buf),Min(Maxlength(Buf),Length(Pstring)));
  25.    -- Due to PCDOS 2.1 bug, we can't have extra blanks at the
  26.    -- end of a file name.  So we must place the null character right
  27.    -- after the text.  (This bug wasn't on PCDOS 2.0 or on Victor systems.)
  28.    Last := Length(Pstring)+1 %Min Maxlength(Buf);
  29.    -- Do not put chr(0) after a blank if we can avoid it:
  30.    while (Last > 1) and then (Buf[Last-1] = ' ') do Dec(Last);
  31.    Buf[Last] := Chr(0);
  32.    return(Buf!Adr);
  33.    end;
  34. #endif   
  35.  
  36. procedure Stringproc(Dos_name,C_DOS_Name) (Stringparm(Name); I:Byte);
  37. #if PPLIB
  38.    var S: Strcopy; 
  39. #endif   
  40.    begin
  41. #if PPLIB
  42.    Load_DS_DX(Cstring(Name,S));
  43. #else
  44.    Load_DS_DX(Name %Retype Address);
  45. #endif
  46.    DOS(I);
  47.    end;
  48.  
  49. function Stringproc(Create,C_create) (Stringparm(Name); Mode: File_mode): File_handle;
  50.    begin
  51.    CX.R := Retype(Mode,Byte);
  52.    DOS_name(Name,60);
  53.    return(AX.L);
  54.    end;
  55.  
  56. value Sharing_mode := Compatibility;
  57.  
  58. function Stringproc(Open,C_open) (Stringparm(Name); Method: Open_method): File_handle;
  59.    begin
  60.    AX.L := (Sharing_mode!Ord << 4) | Method!Ord;
  61.    DOS_name(Name,61);
  62.    return(AX.L);
  63.    end;
  64.  
  65. procedure Stringproc(Unlink,C_unlink) (Stringparm(Name));
  66.    begin
  67.    DOS_name(Name,65);
  68.    end;
  69.  
  70. -- (C) Copyright 1983,84,85 MetaWare Incorporated;  Santa Cruz, CA 95060.
  71.