home *** CD-ROM | disk | FTP | other *** search
/ Solo Programadores 22 / SOLO_22.iso / packages / win32ada / data.z / win32-winnt.adb < prev    next >
Encoding:
Text File  |  1995-11-17  |  5.3 KB  |  162 lines

  1. -- $Source: /home/harp/1/proto/monoBANK/winnt/win32-winnt.adb,v $ 
  2. -- $Revision: 1.4 $ $Date: 95/02/12 14:39:05 $ $Author: mg $ 
  3. -------------------------------------------------------------------------------
  4. --
  5. -- THIS FILE AND ANY ASSOCIATED DOCUMENTATION IS FURNISHED "AS IS" WITHOUT 
  6. -- WARRANTY OF ANY KIND, EITHER EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED 
  7. -- TO THE IMPLIED WARRANTIES OF MERCHANTABILITY AND/OR FITNESS FOR A PARTICULAR 
  8. -- PURPOSE.  The user assumes the entire risk as to the accuracy and the 
  9. -- use of this file.
  10. --
  11. -- Copyright (c) Intermetrics, Inc. 1995
  12. -- Royalty-free, unlimited, worldwide, non-exclusive use, modification, 
  13. -- reproduction and further distribution of this file is permitted.
  14. --
  15. -------------------------------------------------------------------------------
  16.  
  17.  
  18. with Ada.Unchecked_Conversion;
  19. with Interfaces;
  20.  
  21. package body Win32.Winnt is
  22.  
  23.     function MAKELANGID (P, S: WORD) return WORD is
  24.       use Interfaces;
  25.     begin
  26.       return WORD(Unsigned_16(P) or Interfaces.Shift_Left(Unsigned_16(S), 10)); 
  27.     end MAKELANGID;
  28.  
  29.     function PRIMARYLANGID (LGID: WORD) return WORD is
  30.       use Interfaces;
  31.     begin
  32.       return WORD(Unsigned_16(LGID) and 16#3ff#);
  33.     end PRIMARYLANGID;
  34.  
  35.     function SUBLANGID (LGID: WORD) return WORD is
  36.       use Interfaces;
  37.     begin
  38.       return WORD(Interfaces.Shift_Right(Unsigned_16(LGID), 10));
  39.     end SUBLANGID;
  40.  
  41.     function MAKELCID (Lgid, Srtid: WORD) return DWORD is
  42.       use Interfaces;
  43.     begin
  44.       return DWORD(Shift_Left(Unsigned_32(Srtid), 16) or Unsigned_32(Lgid));
  45.     end MAKELCID;
  46.  
  47.     function LANGIDFROMLCID (Lcid: DWORD) return WORD is
  48.       use Interfaces;
  49.     begin
  50.       return WORD(Unsigned_32(Lcid) and 16#ffff#);
  51.     end LANGIDFROMLCID;
  52.  
  53.     function SORTIDFROMLCID (Lcid: DWORD) return WORD is
  54.       use Interfaces;
  55.     begin
  56.       return WORD(Shift_Right((Unsigned_32(Lcid) and NLS_VALID_LOCALE_MASK),
  57.                                 16));
  58.     end SORTIDFROMLCID;
  59.  
  60.     function IMAGE_FIRST_SECTION(NTHeader: PIMAGE_NT_HEADERS) return
  61.         PIMAGE_DATA_DIRECTORY is
  62.  
  63.         Dummy: IMAGE_NT_HEADERS;
  64.         subtype Long is Interfaces.C.Long;
  65.         use type Interfaces.C.Long;
  66.         function To_Long is new Ada.Unchecked_Conversion(
  67.             PIMAGE_NT_HEADERS, Long);
  68.         function To_PIMAGE is new Ada.Unchecked_Conversion(
  69.             Long, PIMAGE_DATA_DIRECTORY);
  70.     begin
  71.         return To_PIMAGE(To_Long(NTHeader) +
  72.              Dummy.OptionalHeader'Position +
  73.              Long(NTHeader.FileHeader.SizeOfOptionalHeader));
  74.     end IMAGE_FIRST_SECTION;
  75.  
  76.     function BTYPE(X: BYTE) return BYTE is
  77.       use Interfaces;
  78.     begin
  79.       return BYTE(Unsigned_8(X) and N_BTMASK);
  80.     end BTYPE;
  81.  
  82.     function ISPTR(X: BYTE) return Standard.Boolean is
  83.       use Interfaces;
  84.     begin
  85.       return (Unsigned_8(X) and N_TMASK) =
  86.              Shift_Left(Unsigned_8(IMAGE_SYM_DTYPE_POINTER), N_BTSHFT);
  87.     end ISPTR;
  88.  
  89.     function ISFCN(X: BYTE) return Standard.Boolean is
  90.       use Interfaces;
  91.     begin
  92.       return (Unsigned_8(X) and N_TMASK) =
  93.              Shift_Left(Unsigned_8(IMAGE_SYM_DTYPE_FUNCTION), N_BTSHFT);
  94.     end ISFCN;
  95.  
  96.     function ISARY(X: BYTE) return Standard.Boolean is
  97.       use Interfaces;
  98.     begin
  99.       return (Unsigned_8(X) and N_TMASK) =
  100.              Shift_Left(Unsigned_8(IMAGE_SYM_DTYPE_ARRAY), N_BTSHFT);
  101.     end ISARY;
  102.  
  103.     function ISTAG(X: BYTE) return Standard.Boolean is
  104.       use Interfaces;
  105.     begin
  106.       return X = IMAGE_SYM_CLASS_STRUCT_TAG or
  107.              X = IMAGE_SYM_CLASS_UNION_TAG or
  108.              X = IMAGE_SYM_CLASS_ENUM_TAG;
  109.     end ISTAG;
  110.  
  111.     function INCREF(X: BYTE) return BYTE is
  112.         use Interfaces;
  113.         U8X: Unsigned_8 := Unsigned_8(X);
  114.     begin
  115.         return BYTE((Shift_Left(U8X and not N_BTMASK, N_TSHIFT)) or
  116.                     (Shift_Left(Unsigned_8(IMAGE_SYM_DTYPE_POINTER),N_BTSHFT)) 
  117.             or (U8X and N_BTMASK));
  118.     end INCREF;
  119.  
  120.     function DECREF(X: BYTE) return BYTE is
  121.         use Interfaces;
  122.     begin
  123.       return BYTE((Shift_Right(Unsigned_8(X), N_TSHIFT) and not N_BTMASK) or
  124.                  (Unsigned_8(X) and N_BTMASK));
  125.     end DECREF;
  126.  
  127.     function IMAGE_SNAP_BY_ORDINAL(Ordinal: DWORD) return Standard.Boolean is
  128.         use Interfaces;
  129.     begin
  130.         return Interfaces.Integer_32(Ordinal) < 0;
  131.     end IMAGE_SNAP_BY_ORDINAL;
  132.  
  133.     function IMAGE_ORDINAL(Ordinal: DWORD) return WORD is
  134.         use Interfaces;
  135.     begin
  136.         return WORD(Interfaces.Unsigned_32(Ordinal) and 16#FFFF#);
  137.     end IMAGE_ORDINAL;
  138.  
  139.     function RtlFillMemory
  140.         (Destination : in Win32.PVOID;
  141.          Length      : in Win32.Strings.size_t;
  142.          Fill        : in Win32.BYTE)
  143.         return Win32.PVOID is
  144.     begin
  145.         return Win32.Strings.memset(Destination, Win32.INT(Fill), Length);
  146.     end RtlFillMemory;
  147.  
  148.     function RtlZeroMemory
  149.         (Destination : in Win32.PVOID;
  150.          Length      : in Win32.Strings.size_t) return Win32.PVOID is
  151.     begin
  152.         return Win32.Strings.memset(Destination, 0, Length);
  153.     end RtlZeroMemory;
  154.  
  155. begin
  156.  
  157.     -- In GNAT 2.02 aggregate assignment not supported for unions
  158.     SYSTEM_LUID.Luid.QuadPart := 16#3E7#;
  159.     SYSTEM_LUID.Attributes    := 0;                          -- winnt.h:2206
  160.  
  161. end Win32.Winnt;
  162.