home *** CD-ROM | disk | FTP | other *** search
/ DP Tool Club 19 / CD_ASCQ_19_010295.iso / vrac / adaada.zip / ADAADA.ZIP / SRC / CW_ADA / CW_SYS_.ADA < prev    next >
Text File  |  1994-10-12  |  2KB  |  83 lines
  1. -- Copyright (c) 1994 ARINC Research Corporation
  2. -- From material copyright (c) 1991, 1992 Premia Corporation
  3. --
  4. -- This material may be reproduced by or for the US Government pursuant 
  5. -- to the copyright license under DFAR Clause 252.227-7013 (1988)
  6. --
  7. -- Developed for US Air Force under contract no. F41608-90-D-0544-0005
  8. --
  9. -- MODIFICATIONS
  10. --   94/06 - J. Neuse, SD/OSE/EA  - Initial code
  11. --   94/10 - O. Sluder, SD/OSE/EA - Cleanup
  12.  
  13. with CW_TYPES;
  14.  
  15. -- ************
  16. -- *          *
  17. -- *  CW_SYS  *  BODY
  18. -- *          *
  19. -- ************
  20.  
  21. package body CW_SYS is
  22.  
  23.   -- The following pragmas are required by the Meridian OpenAda for
  24.   -- Windows 2.0 compiler in the package spec and body of code to be
  25.   -- included in a DLL, or an application calling the DLL will 
  26.   -- general protection fault
  27.   pragma SUPPRESS (elaboration_check);
  28.   pragma SUPPRESS (storage_check);
  29.  
  30.   -- ..............
  31.   -- .            .
  32.   -- .  MemAlloc  .  BODY
  33.   -- .            .
  34.   -- ..............
  35.  
  36.   function MemAlloc (size : in integer) return SYSTEM.ADDRESS is
  37.  
  38.     Return_LPVOID : CW_TYPES.LPVOID;
  39.  
  40.     -- .................
  41.     -- .               .
  42.     -- .  CW_MemAlloc  .  SPEC
  43.     -- .               .
  44.     -- .................
  45.  
  46.     function CW_MemAlloc (size : in integer) return CW_TYPES.LPVOID;
  47.     pragma INTERFACE (windows, CW_MemAlloc, "MemAlloc");
  48.  
  49.   begin
  50.  
  51.     Return_LPVOID := CW_MemAlloc (size);
  52.     return SYSTEM.ADDRESS (Return_LPVOID);
  53.  
  54.   end MemAlloc;
  55.  
  56.   -- .............
  57.   -- .           .
  58.   -- .  MemFree  .  BODY
  59.   -- .           .
  60.   -- .............
  61.  
  62.   procedure MemFree (blockptr : in SYSTEM.ADDRESS) is
  63.  
  64.     Pass_LPVOID : CW_TYPES.LPVOID;
  65.  
  66.     -- ................
  67.     -- .              .
  68.     -- .  CW_MemFree  .  SPEC
  69.     -- .              .
  70.     -- ................
  71.  
  72.     procedure CW_MemFree (blockptr : in CW_TYPES.LPVOID);
  73.     pragma INTERFACE (windows, CW_MemFree, "MemFree");
  74.  
  75.   begin
  76.  
  77.     Pass_LPVOID := CW_TYPES.LPVOID (blockptr);
  78.     CW_MemFree (Pass_LPVOID);
  79.  
  80.   end MemFree;
  81.  
  82. end CW_SYS;
  83.