Browse Source

+ released port[] and made them assembler procedures

peter 27 years ago
parent
commit
3fe8cd8217
1 changed files with 208 additions and 252 deletions
  1. 208 252
      rtl/dos/go32.pp

+ 208 - 252
rtl/dos/go32.pp

@@ -15,67 +15,69 @@
 
 unit go32;
 
-{$S-}{no stack check, used by DPMIEXCP !! }
 {$i os.inc}
-  interface
 
-    const
-    { contants for the run modes returned by get_run_mode }
-       rm_unknown = 0;
-       rm_raw     = 1;     { raw (without HIMEM) }
-       rm_xms     = 2;     { XMS (for example with HIMEM, without EMM386) }
-       rm_vcpi    = 3;     { VCPI (for example HIMEM and EMM386) }
-       rm_dpmi    = 4;     { DPMI (for example DOS box or 386Max) }
-
-    { flags }
-       carryflag     = $001;
-       parityflag    = $004;
-       auxcarryflag  = $010;
-       zeroflag      = $040;
-       signflag      = $080;
-       trapflag      = $100;
-       interruptflag = $200;
-       directionflag = $400;
-       overflowflag  = $800;
-
-    type
-       tmeminfo = record
-          available_memory,
-          available_pages,
-          available_lockable_pages,
-          linear_space,
-          unlocked_pages,
-          available_physical_pages,
-          total_physical_pages,
-          free_linear_space,
-          max_pages_in_paging_file,
-          reserved0,
-          reserved1,
-          reserved2 : longint;
-       end;
-
-       tseginfo = record
-          offset  : pointer;
-          segment : word;
-       end;
+{$S-}{no stack check, used by DPMIEXCP !! }
 
-       trealregs = record
-         case integer of
-          1: { 32-bit } (EDI, ESI, EBP, Res, EBX, EDX, ECX, EAX: longint;
-                         Flags, ES, DS, FS, GS, IP, CS, SP, SS: word);
-          2: { 16-bit } (DI, DI2, SI, SI2, BP, BP2, R1, R2: word;
-                         BX, BX2, DX, DX2, CX, CX2, AX, AX2: word);
-          3: { 8-bit }  (stuff: array[1..4] of longint;
-                         BL, BH, BL2, BH2, DL, DH, DL2, DH2,
-                         CL, CH, CL2, CH2, AL, AH, AL2, AH2: byte);
-          4: { Compat } (RealEDI, RealESI, RealEBP, RealRES,
-                         RealEBX, RealEDX, RealECX, RealEAX: longint;
-                         RealFlags,
-                         RealES, RealDS, RealFS, RealGS,
-                         RealIP, RealCS, RealSP, RealSS: word);
-       end;
+interface
+
+const
+{ contants for the run modes returned by get_run_mode }
+   rm_unknown = 0;
+   rm_raw     = 1;     { raw (without HIMEM) }
+   rm_xms     = 2;     { XMS (for example with HIMEM, without EMM386) }
+   rm_vcpi    = 3;     { VCPI (for example HIMEM and EMM386) }
+   rm_dpmi    = 4;     { DPMI (for example DOS box or 386Max) }
+
+{ flags }
+   carryflag     = $001;
+   parityflag    = $004;
+   auxcarryflag  = $010;
+   zeroflag      = $040;
+   signflag      = $080;
+   trapflag      = $100;
+   interruptflag = $200;
+   directionflag = $400;
+   overflowflag  = $800;
+
+type
+   tmeminfo = record
+      available_memory,
+      available_pages,
+      available_lockable_pages,
+      linear_space,
+      unlocked_pages,
+      available_physical_pages,
+      total_physical_pages,
+      free_linear_space,
+      max_pages_in_paging_file,
+      reserved0,
+      reserved1,
+      reserved2 : longint;
+   end;
+
+   tseginfo = record
+      offset  : pointer;
+      segment : word;
+   end;
+
+   trealregs = record
+     case integer of
+      1: { 32-bit } (EDI, ESI, EBP, Res, EBX, EDX, ECX, EAX: longint;
+                     Flags, ES, DS, FS, GS, IP, CS, SP, SS: word);
+      2: { 16-bit } (DI, DI2, SI, SI2, BP, BP2, R1, R2: word;
+                     BX, BX2, DX, DX2, CX, CX2, AX, AX2: word);
+      3: { 8-bit }  (stuff: array[1..4] of longint;
+                     BL, BH, BL2, BH2, DL, DH, DL2, DH2,
+                     CL, CH, CL2, CH2, AL, AH, AL2, AH2: byte);
+      4: { Compat } (RealEDI, RealESI, RealEBP, RealRES,
+                     RealEBX, RealEDX, RealECX, RealEAX: longint;
+                     RealFlags,
+                     RealES, RealDS, RealFS, RealGS,
+                     RealIP, RealCS, RealSP, RealSS: word);
+   end;
+  registers = trealregs;
 
-      registers = trealregs;
 
     { this works only with real DPMI }
     function allocate_ldt_descriptors(count : word) : word;
@@ -149,21 +151,12 @@ unit go32;
     procedure disable;
     procedure enable;
 
-    function inportb(port : word) : byte;
-    function inportw(port : word) : word;
-    function inportl(port : word) : longint;
-
-    procedure outportb(port : word;data : byte);
-    procedure outportw(port : word;data : word);
-    procedure outportl(port : word;data : longint);
     function get_run_mode : word;
 
-{$ifndef V0_6}
     function transfer_buffer : longint;
     function tb_size : longint;
     procedure copytodos(var addr; len : longint);
     procedure copyfromdos(var addr; len : longint);
-{$endif not VER0_6}
 
     procedure dpmi_dosmemput(seg : word;ofs : word;var data;count : longint);
     procedure dpmi_dosmemget(seg : word;ofs : word;var data;count : longint);
@@ -181,35 +174,47 @@ unit go32;
        dosmemfillchar : procedure(seg,ofs : word;count : longint;c : char)=dpmi_dosmemfillchar;
        dosmemfillword : procedure(seg,ofs : word;count : longint;w : word)=dpmi_dosmemfillword;
 
-{$ifdef SUPPORT_PORT}
-    type
-       tport = class
-          procedure writeport(p : word;data : byte);
-          function readport(p : word) : byte;
-          property pp[w : word] : byte read readport write writeport;default;
-       end;
-
-       tportw = class
-          procedure writeport(p : word;data : word);
-          function readport(p : word) : word;
-          property pp[w : word] : word read readport write writeport;default;
-       end;
-
-       tportl = class
-          procedure writeport(p : word;data : longint);
-          function readport(p : word) : longint;
-          property pp[w : word] : longint read readport write writeport;default;
-       end;
-    var
-       { we don't need to initialize port, because neither member
-         variables nor virtual methods are accessed
-       }
-       port,portb : tport;
-       portw : tportw;
-       portl : tportl;
-{$endif SUPPORT_PORT}
-
-  implementation
+{*****************************************************************************
+                               IO Port Access
+*****************************************************************************}
+
+function inportb(port : word) : byte;
+function inportw(port : word) : word;
+function inportl(port : word) : longint;
+procedure outportb(port : word;data : byte);
+procedure outportw(port : word;data : word);
+procedure outportl(port : word;data : longint);
+
+type
+   tport = class
+      procedure writeport(p : word;data : byte);
+      function  readport(p : word) : byte;
+      property pp[w : word] : byte read readport write writeport;default;
+   end;
+
+   tportw = class
+      procedure writeport(p : word;data : word);
+      function  readport(p : word) : word;
+      property pp[w : word] : word read readport write writeport;default;
+   end;
+
+   tportl = class
+      procedure writeport(p : word;data : longint);
+      function  readport(p : word) : longint;
+      property pp[w : word] : longint read readport write writeport;default;
+   end;
+var
+{ we don't need to initialize port, because neither member
+  variables nor virtual methods are accessed }
+   port,
+   portb : tport;
+   portw : tportw;
+   portl : tportl;
+
+
+implementation
+
+{$ASMMODE ATT}
 
 {$ifndef go32v2}
 
@@ -449,66 +454,6 @@ unit go32;
            end ['ESI','EDI','ECX'];
       end;
 
-    procedure outportb(port : word;data : byte);
-
-      begin
-         asm
-            movw port,%dx
-            movb data,%al
-            outb %al,%dx
-         end ['EAX','EDX'];
-      end;
-
-    procedure outportw(port : word;data : word);
-
-      begin
-         asm
-            movw port,%dx
-            movw data,%ax
-            outw %ax,%dx
-         end ['EAX','EDX'];
-      end;
-
-    procedure outportl(port : word;data : longint);
-
-      begin
-         asm
-            movw port,%dx
-            movl data,%eax
-            outl %eax,%dx
-         end ['EAX','EDX'];
-      end;
-
-    function inportb(port : word) : byte;
-
-      begin
-         asm
-            movw port,%dx
-            inb %dx,%al
-            movb %al,__RESULT
-         end ['EAX','EDX'];
-      end;
-
-    function inportw(port : word) : word;
-
-      begin
-         asm
-            movw port,%dx
-            inw %dx,%ax
-            movw %ax,__RESULT
-         end ['EAX','EDX'];
-      end;
-
-    function inportl(port : word) : longint;
-
-      begin
-         asm
-            movw port,%dx
-            inl %dx,%eax
-            movl %eax,__RESULT
-         end ['EAX','EDX'];
-      end;
-
     function get_cs : word;
 
       begin
@@ -537,6 +482,7 @@ unit go32;
          end;
       end;
 
+{$ASMMODE DIRECT}
     procedure test_int31(flag : longint);[alias : 'test_int31'];
       begin
          asm
@@ -554,6 +500,7 @@ unit go32;
             popl  %ebx
          end;
       end;
+{$ASMMODE ATT}
 
     function set_pm_interrupt(vector : byte;const intaddr : tseginfo) : boolean;
 
@@ -702,6 +649,7 @@ unit go32;
     because the exception processor sets the ds limit to $fff
     at hardware exceptions }
 
+{$ASMMODE DIRECT}
     function get_rm_callback(pm_func : pointer;const reg : trealregs;var rmcb : tseginfo) : boolean;
       begin
          asm
@@ -730,6 +678,7 @@ unit go32;
             movw  %cx,4(%eax)
          end;
       end;
+{$ASMMODE ATT}
 
     function allocate_ldt_descriptors(count : word) : word;
 
@@ -1075,14 +1024,15 @@ unit go32;
          sti
       end;
 
+{$ASMMODE DIRECT}
     function get_run_mode : word;
-
       begin
          asm
             movw _run_mode,%ax
             movw %ax,__RESULT
          end ['EAX'];
       end;
+{$ASMMODE ATT}
 
     function map_device_in_memory_block(handle,offset,pagecount,device:longint):boolean;
       begin
@@ -1100,6 +1050,7 @@ unit go32;
          end;
       end;
 
+{$ASMMODE DIRECT}
     function get_core_selector : word;
 
       begin
@@ -1108,11 +1059,10 @@ unit go32;
             movw %ax,__RESULT
          end;
       end;
+{$ASMMODE ATT}
 
-{$ifndef V0_6}
 
     function transfer_buffer : longint;
-
       begin
          transfer_buffer := go32_info_block.linear_address_of_transfer_buffer;
       end;
@@ -1145,71 +1095,129 @@ unit go32;
 {$endif GO32V2}
        end;
 
-{$endif not V0_6}
 
-{$ifdef SUPPORT_PORT}
+{*****************************************************************************
+                              IO PORT ACCESS
+*****************************************************************************}
 
-    { to give easy port access }
+procedure outportb(port : word;data : byte);assembler;
+asm
+        movw port,%dx
+        movb data,%al
+        outb %al,%dx
+end ['EAX','EDX'];
 
-    procedure tport.writeport(p : word;data : byte);
 
-      begin
-         outportb(p,data);
-      end;
+procedure outportw(port : word;data : word);assembler;
+asm
+        movw port,%dx
+        movw data,%ax
+        outw %ax,%dx
+end ['EAX','EDX'];
 
-    function tport.readport(p : word) : byte;
 
-      begin
-         readport:=inportb(p);
-      end;
+procedure outportl(port : word;data : longint);assembler;
+asm
+        movw port,%dx
+        movl data,%eax
+        outl %eax,%dx
+end ['EAX','EDX'];
 
-    procedure tportw.writeport(p : word;data : word);
 
-      begin
-         outportw(p,data);
-      end;
+function inportb(port : word) : byte;assembler;
+asm
+        movw port,%dx
+        inb %dx,%al
+end ['EAX','EDX'];
 
-    function tportw.readport(p : word) : word;
 
-      begin
-         readport:=inportw(p);
-      end;
+function inportw(port : word) : word;assembler;
+asm
+        movw    port,%dx
+        inw     %dx,%ax
+end ['EAX','EDX'];
 
-    procedure tportl.writeport(p : word;data : longint);
 
-      begin
-         outportl(p,data);
-      end;
+function inportl(port : word) : longint;assembler;
+asm
+        movw port,%dx
+        inl %dx,%eax
+end ['EAX','EDX'];
 
-    function tportl.readport(p : word) : longint;
+{ to give easy port access like tp with port[] }
+
+procedure tport.writeport(p : word;data : byte);assembler;
+asm
+        movw    p,%dx
+        movb    data,%al
+        outb    %al,%dx
+end ['EAX','EDX'];
+
+
+function tport.readport(p : word) : byte;assembler;
+asm
+        movw    p,%dx
+        inb     %dx,%al
+end ['EAX','EDX'];
+
+
+procedure tportw.writeport(p : word;data : word);assembler;
+asm
+        movw    p,%dx
+        movw    data,%ax
+        outw    %ax,%dx
+end ['EAX','EDX'];
 
-      begin
-         readport:=inportl(p);
-      end;
 
-{$endif SUPPORT_PORT}
+function tportw.readport(p : word) : word;assembler;
+asm
+        movw    p,%dx
+        inw     %dx,%ax
+end ['EAX','EDX'];
+
+
+procedure tportl.writeport(p : word;data : longint);assembler;
+asm
+        movw    p,%dx
+        movl    data,%eax
+        outl    %eax,%dx
+end ['EAX','EDX'];
+
+
+function tportl.readport(p : word) : longint;assembler;
+asm
+        movw    p,%dx
+        inl     %dx,%eax
+end ['EAX','EDX'];
+
+
+{*****************************************************************************
+                               Initialization
+*****************************************************************************}
 
 begin
-   int31error:=0;
 {$ifndef go32v2}
-   if not (get_run_mode=rm_dpmi) then
-     begin
-        dosmemget:=@raw_dosmemget;
-        dosmemput:=@raw_dosmemput;
-        dosmemmove:=@raw_dosmemmove;
-        dosmemfillchar:=@raw_dosmemfillchar;
-        dosmemfillword:=@raw_dosmemfillword;
-     end
-   else
+  if not (get_run_mode=rm_dpmi) then
+   begin
+     dosmemget:=@raw_dosmemget;
+     dosmemput:=@raw_dosmemput;
+     dosmemmove:=@raw_dosmemmove;
+     dosmemfillchar:=@raw_dosmemfillchar;
+     dosmemfillword:=@raw_dosmemfillword;
+   end
+  else
 {$endif}
-     begin
-       dosmemselector:=get_core_selector;
-     end;
+   begin
+     dosmemselector:=get_core_selector;
+   end;
 end.
 
 {
   $Log$
-  Revision 1.4  1998-04-24 08:26:50  pierre
+  Revision 1.5  1998-05-31 14:16:49  peter
+    + released port[] and made them assembler procedures
+
+  Revision 1.4  1998/04/24 08:26:50  pierre
     * had to rename property from p to pp to
       avoid duplicate identifier error in
       implementation of readport and writeport
@@ -1217,56 +1225,4 @@ end.
 
   Revision 1.3  1998/04/12 22:35:29  florian
     + support of port-array added
-
-  Revision 1.2  1998/03/29 17:26:20  florian
-    * small improvements
-
-  Revision 1.1.1.1  1998/03/25 11:18:41  root
-  * Restored version
-
-  Revision 1.8  1998/03/24 15:54:14  peter
-    - raw_ functions are not necessary for go32v2, $ifdef'd them
-
-  Revision 1.7  1998/03/24 09:33:59  peter
-    + new trealregs from the mailinglist
-    + 2 new functions get_page_size, map_device_in_mem_block
-
-  Revision 1.6  1998/02/01 09:32:21  florian
-    * some clean up
-
-  Revision 1.5  1998/01/26 11:56:27  michael
-  + Added log at the end
-
-  revision 1.4
-  date: 1997/12/12 13:14:37;  author: pierre;  state: Exp;  lines: +2 -1
-     + added handling of swap_vectors if under exceptions
-       i.e. swapvector is not dummy under go32v2
-     * bug in output, exceptions where not allways reset correctly
-       now the code in dpmiexcp is called from v2prt0.as exit routine
-     * in crt.pp corrected init_delay calibration loop
-       and added it for go32v2 also (was disabled before due to crashes !!)
-       the previous code did a wrong assumption on the time need to call
-       get_ticks compared to an internal loop without call
-  ----------------------------
-  revision 1.3
-  date: 1997/12/11 11:50:37;  author: pierre;  state: Exp;  lines: +2 -2
-    *  bug in get_linear_addr corrected
-       thanks to Raul who found this bug.
-  ----------------------------
-  revision 1.2
-  date: 1997/12/01 12:15:46;  author: michael;  state: Exp;  lines: +10 -3
-  + added copyright reference in header.
-  ----------------------------
-  revision 1.1
-  date: 1997/11/27 08:33:50;  author: michael;  state: Exp;
-  Initial revision
-  ----------------------------
-  revision 1.1.1.1
-  date: 1997/11/27 08:33:50;  author: michael;  state: Exp;  lines: +0 -0
-  FPC RTL CVS start
-  =============================================================================
-
-  History:
-       6th november 1996:
-         + dosmem* implemented
 }