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_PARS_.ADA < prev    next >
Text File  |  1994-10-12  |  5KB  |  169 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_PARS  *  BODY
  18. -- *           *
  19. -- *************
  20.  
  21. package body CW_PARS 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.   -- .  AddErrorInfoName  .  SPEC
  33.   -- .                    .
  34.   -- ......................
  35.  
  36.   procedure AddErrorInfoName (errInfoName : in string) is
  37.  
  38.     Pass_LPSTR : CW_TYPES.LPSTR;
  39.  
  40.     -- .........................
  41.     -- .                       .
  42.     -- .  CW_AddErrorInfoName  .  SPEC
  43.     -- .                       .
  44.     -- .........................
  45.  
  46.     procedure CW_AddErrorInfoName (errInfoName : in SYSTEM.ADDRESS);
  47.     pragma INTERFACE (windows, CW_AddErrorInfoName, "_AddErrorInfoName");
  48.  
  49.   begin --  procedure AddErrorInfoName
  50.  
  51.     Pass_LPSTR := new STRING'(errInfoName & ascii.nul);
  52.     CW_AddErrorInfoName (Pass_LPSTR.all (Pass_LPSTR.all'FIRST)'ADDRESS);
  53.  
  54.   end AddErrorInfoName;
  55.  
  56.   -- .................
  57.   -- .               .
  58.   -- .  ErrorColumn  .  BODY
  59.   -- .               .
  60.   -- .................
  61.  
  62.   function ErrorColumn (column : in LONG_INTEGER) return LONG_INTEGER is
  63.  
  64.     Return_Long : LONG_INTEGER;
  65.  
  66.     -- ....................
  67.     -- .                  .
  68.     -- .  CW_ErrorColumn  .  SPEC
  69.     -- .                  .
  70.     -- ....................
  71.  
  72.     function CW_ErrorColumn (column : in LONG_INTEGER) return LONG_INTEGER;
  73.     pragma INTERFACE (windows, CW_ErrorColumn, "ErrorColumn");
  74.  
  75.   begin -- function ErrorColumn
  76.  
  77.     Return_Long := CW_ErrorColumn (column);
  78.  
  79.     return Return_Long;
  80.  
  81.   end ErrorColumn;
  82.  
  83.   -- ...............
  84.   -- .             .
  85.   -- .  ErrorLine  .  BODY
  86.   -- .             .
  87.   -- ...............
  88.  
  89.   function ErrorLine (line : in LONG_INTEGER) return LONG_INTEGER is
  90.  
  91.     Return_Long : LONG_INTEGER;
  92.  
  93.     -- ..................
  94.     -- .                .
  95.     -- .  CW_ErrorLine  .  SPEC
  96.     -- .                .
  97.     -- ..................
  98.  
  99.     function CW_ErrorLine (line : in LONG_INTEGER) return LONG_INTEGER;
  100.     pragma INTERFACE (windows, CW_ErrorLine, "ErrorLine");
  101.  
  102.   begin -- function ErrorLine
  103.  
  104.     Return_Long := CW_ErrorLine (line);
  105.  
  106.     return Return_Long;
  107.  
  108.   end ErrorLine;
  109.  
  110.   -- ..................
  111.   -- .                .
  112.   -- .  ErrorMsgLine  .  BODY
  113.   -- .                .
  114.   -- ..................
  115.  
  116.   function ErrorMsgLine (errmsg : in STRING) return SYSTEM.ADDRESS is
  117.  
  118.     Return_Addr : SYSTEM.ADDRESS;
  119.     Pass_LPSTR  : CW_TYPES.LPSTR;
  120.  
  121.     -- .....................
  122.     -- .                   .
  123.     -- .  CW_ErrorMsgLine  .  SPEC
  124.     -- .                   .
  125.     -- .....................
  126.  
  127.     function CW_ErrorMsgLine (errmsg : in SYSTEM.ADDRESS) return SYSTEM.ADDRESS;
  128.     pragma INTERFACE (windows, CW_ErrorMsgLine, "ErrorMsgLine");
  129.  
  130.   begin -- function ErrorMsgLine
  131.  
  132.     Pass_LPSTR  := new STRING'(errmsg & ascii.nul);
  133.     Return_Addr :=
  134.       CW_ErrorMsgLine (Pass_LPSTR.all (Pass_LPSTR.all'FIRST)'ADDRESS);
  135.     return Return_Addr;
  136.  
  137.   end ErrorMsgLine;
  138.  
  139.   -- ..................
  140.   -- .                .
  141.   -- .  ErrorSrcFile  .  BODY
  142.   -- .                .
  143.   -- ..................
  144.  
  145.   function ErrorSrcFile (fname : in STRING) return SYSTEM.ADDRESS is
  146.  
  147.     Return_Addr : SYSTEM.ADDRESS;
  148.     Pass_LPSTR  : CW_TYPES.LPSTR;
  149.  
  150.     -- .....................
  151.     -- .                   .
  152.     -- .  CW_ErrorSrcFile  .  SPEC
  153.     -- .                   .
  154.     -- .....................
  155.  
  156.     function CW_ErrorSrcFile (fname : in SYSTEM.ADDRESS) return SYSTEM.ADDRESS;
  157.     pragma INTERFACE (windows, CW_ErrorSrcFile, "ErrorSrcFile");
  158.  
  159.   begin -- function ErrorSrcFile
  160.  
  161.     Pass_LPSTR  := new STRING'(fname & ascii.nul);
  162.     Return_Addr :=
  163.       CW_ErrorSrcFile (Pass_LPSTR.all (Pass_LPSTR.all'FIRST)'ADDRESS);
  164.     return Return_Addr;
  165.  
  166.   end ErrorSrcFile;
  167.  
  168. end CW_PARS;
  169.