home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 7 / 07.iso / c / c221 / 5.ddi / MWHC.005 / L3 < prev    next >
Encoding:
Text File  |  1992-12-09  |  5.9 KB  |  151 lines
  1. { (C) Copyright  1986-1992 MetaWare Incorporated;  Santa Cruz, CA 95060. }
  2.  
  3. pragma C_include('implement.pf');
  4.  
  5. package MSDOS;
  6.    pragma Routine_aliasing_convention(Implement.RTE_aliasing);
  7.    type byte = 0..255; 
  8.        word = Implement.Byte_count;      -- See Implement.pf.
  9.    with Loopholes:[Address,Longptr];
  10. #if 0
  11.    Use these routines to communicate directly with MS-DOS if the
  12.    routines supplied in the SYSTEM package are insufficient.
  13.    To call MSDOS:  Set the Register values the way you want them in
  14.    the global Registers record.
  15.    Then, call CALLDOS.    CALLDOS will load the actual machine
  16.    registers with the values in the register block below.
  17.    Upon return, the Registers will contain the register contents
  18.    when DOS returned.  The Flags word contains the contents of the
  19.    808x flags register after MS-DOS returns.
  20.    As a variation, CALLINT will call an arbitrary interrupt number,
  21.    using the registers in a similar way.  E.g., CALLINT(#21) = CALLDOS().
  22. #endif
  23.    pragma data(common,Implement.RTE || 'dosregs');
  24.    -- 4-byte register communication is provided for MS-DOS since DOS-extender
  25.    -- software permits 32-bit offsets to DOS calls and provides translation.
  26.    type Register = record
  27.       case Boolean of
  28.      True:(L,H:Byte);    -- Lower & Upper portions of register.
  29.      False:(R:Word);    -- Entire register; 2 bytes/286, 4 bytes/386.
  30.                  -- However, segment regs are always 2 bytes, even on 386.
  31.      end;
  32.    type DOS_communication = record
  33.       ax,bx,cx,dx,
  34.       si,di,ds,es: Register;
  35.       -- The rightmost bit of Flags is the carry bit.  MS-DOS usually sets
  36.       -- carry if an error occurs.
  37.       -- Thus, if Flags is odd on return, an error occurred;
  38.       -- ax contains the error number #.
  39.       Flags: Word;
  40.       end;
  41. #if 0
  42.    Here are the registers to modify.  You can either assign into
  43.    these registers directly, or create your own DOS_communication
  44.    block of registers and assign that block into Registers before
  45.    calling CALLDOS. 
  46. >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
  47. >> WARNING!!!  The run-time library uses CALLDOS and this Registers      <<
  48. >> variable.  So DO NOT expect it to be preserved across calls to        <<
  49. >> the library that require DOS communication (e.g., Professional Pascal <<
  50. >> "writeln" or High C "printf").                                        <<
  51. >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
  52. #endif
  53.    var Registers: DOS_communication;
  54.    pragma data;
  55.  
  56.    -- Use this for your own direct communication with MS-DOS.
  57.    procedure CALLDOS;                     external;
  58.    procedure CALLINT(INT:Integer);             external;
  59.  
  60.    -- This gets the value of the DS register.  Use it with small-data
  61.    -- models to set Registers.DS, since the Adr function returns only
  62.    -- the 16-bit offset.
  63.    function GETDS():Cardinal;                external;
  64.  
  65.    -- The following are private and should not be used.
  66.    procedure DOS(I:Byte);                external;
  67.    procedure Load_ptr(var Rs,Rd: register; A:Address);    external;
  68.    procedure Load_DS_DX(A:Address);            external;
  69.    procedure DOS_Name(const Name:string; I:Byte);    external;
  70.    procedure C_DOS_name(Name:Implement.Charp; I:Byte);    external;
  71.    procedure Set_DMA(A:Address);            External;
  72.    -- The preceding is valid only for MS-DOS, not for OS/2. 
  73.    
  74.    type Strcopy = packed array[1..100] of char;
  75.    -- Convert Pstring to a nul-terminated string, placing result in Buf.
  76.    -- Also, return address of Buf.  Remove trailing blanks in Pstring 
  77.    -- (due to DOS 2.1 bug on file open on some "compatibles").
  78.    function Cstring(const Pstring:String; var Buf:Strcopy):Address;    External;
  79.    -- Used by library implementation to handle differences between
  80.    -- C and Pascal strings:
  81.    -- Set Errno after call to OS/2:
  82.    procedure Doerr(Err:Cardinal);                External;
  83.  
  84. #define LongAdr(X) Retype(Adr(X),Longptr)   
  85. #if HCLIB
  86. #define DOS_name(N,X) C_dos_name(N,X)
  87. #define Stringparm(Name) Name:Charp
  88. #define Stringproc(Pname,Cname) Cname
  89. #define definebuf         -- OS/2 use. 
  90. #define Makestring(S) Retype(S,Longptr)    -- OS/2 use.
  91. #else
  92. #define DOS_name(N,X) DOS_name(N,X)
  93. #define Stringparm(Name) const Name:String
  94. #define Stringproc(Pname,Cname) Pname
  95. #define definebuf var Buf:Strcopy;      -- OS/2 use. 
  96. #define Makestring(S) Retype(Cstring(S,Buf),Longptr)    -- OS/2 use.
  97. #endif
  98.    end;
  99. #if 0
  100. Here's an extended example of how to use CALLDOS:
  101. pragma include('msdos.pf');
  102. with msdos;
  103. program p;
  104.    function KB_status(var C:Char):Boolean;
  105.       begin
  106.       Registers.AX.H := #B;
  107.       Calldos;
  108.       C := Chr(Registers.AX.L);
  109.       return(C <> chr(0));
  110.       end;
  111.    function KB_input_no_echo:Char;
  112.       begin
  113.       Registers.AX.H := #8;
  114.       Calldos;
  115.       return(Chr(Registers.AX.L));
  116.       end;
  117.    procedure KB_write_char(C:Char);
  118.       begin
  119.       Registers.AX.H := 2; Registers.DX.L := Ord(C);
  120.       Calldos;
  121.       end;
  122.    procedure KB_write_string(const S:String);
  123.       with Loopholes:[Address,Adr,Sizeof];
  124.       var Cheat: record case boolean of
  125.          True:  (A:Address);
  126.          False: (Offset, Segment: Word);
  127.            -- Segment not present in small-data models.
  128.          end;
  129.       with Registers;
  130.       begin
  131.       AX.H := #9;
  132.       Cheat.A := Adr(S[1]);
  133.       DX.R := Cheat.Offset;
  134.       -- A little tricky here:  must set Registers.DS to the segment
  135.       -- value for S if non-small-data; otherwise, to the current value of DS.
  136.       -- That's the reason for the GETDS function.
  137.       if Sizeof(Address) > 2 then DS.R := Cheat.Segment
  138.       else DS.R := GETDS();
  139.       CallDOS;   
  140.       end;
  141.    var I,J:Integer;    C:Char;
  142.    const CRLF = Chr(#0d) || Chr(#0a);
  143.    begin
  144.    while not KB_status(C) do begin
  145.       for I := 1 to 3000 do J := I;
  146.       KB_write_string('I''m waiting for you to type a character...' || crlf || '$');
  147.       end;
  148.    KB_write_string('Thank you for typing the character:$');
  149.    KB_write_char(KB_input_no_echo());   
  150.    end.
  151.