home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 7 / 07.iso / c / c221 / 5.ddi / MWHC.005 / Y3 < prev    next >
Encoding:
Text File  |  1992-12-09  |  1.8 KB  |  62 lines
  1. {*********************************************************************
  2. (C) Copyright 1983-92 MetaWare Incorporated;  Santa Cruz, CA 95060.
  3. *********************************************************************}
  4. Export(System,MSDOS,Fileh_type);
  5. pragma include('STATUS.pf');
  6. pragma include('SYSTEM.pf');
  7. pragma include('MSDOS.pf');
  8. pragma fragmented_implementation(System);
  9. pragma fragmented_implementation(MSDOS);
  10. with Status;
  11.  
  12. program Implement_DOS_interface;
  13. pragma Alias(Implement_DOS_interface,Implement.RTE || 'dos_interface4');
  14.  
  15. with Registers;
  16. with Loopholes:[Address,Adr,Retype,&];
  17. pragma off(emit_names); pragma on(optimize_for_space);
  18.  
  19. function Read(F: File_handle; Bufp: Address; Cnt: Byte_count): Byte_count;
  20.    begin
  21.    Load_DS_DX(Bufp);
  22.    CX.R := Cnt;
  23.    BX.R := F;
  24.    DOS(63);
  25.    return(AX.R);
  26.    end;
  27.  
  28. function Write_(F: File_handle; Bufp: Address; Cnt: Byte_count):Byte_count;
  29.    begin
  30.    Load_DS_DX(Bufp);
  31.    CX.R := Cnt;
  32.    BX.R := F;
  33.    DOS(64);
  34.    if (AX.R < Cnt) and (Errno = No_error_occurred) then
  35.        Errno := Error_write_failed;
  36.    return(AX.R);
  37.    end;
  38.  
  39. -- Used when "create" is specified to truncate the file:
  40.  
  41. procedure Trunc(F: File_handle);
  42.    begin
  43.    { Truncating a file is done by writing 0 bytes (how awful!) }
  44.    Write(F,Adr(F),0);
  45.    end;
  46.  
  47. -- Fileclass is called when Open or Create is from the Pascal or C I/O
  48. -- routines.
  49. function Fileclass(F: File_handle): File_class;
  50.    begin
  51.    BX.R := F;
  52.    Ax.L := 0;                { Read fcn. }
  53.    DOS(68);
  54.    if DX.R & #0080 = 0 then return(Disk_file)
  55.    else if DX.R & #0002 <> 0 then return(Console_output)
  56.    else if DX.R & #0001 <> 0 then return(Console_input)
  57.    else return(Other_device);
  58.    end;
  59.  
  60. -- (C) Copyright 1983,84,85 MetaWare Incorporated;  Santa Cruz, CA 95060.
  61.  
  62.