home *** CD-ROM | disk | FTP | other *** search
/ Solo Programadores 22 / SOLO_22.iso / packages / win32ada / data.z / win32-rpcndr.adb < prev    next >
Encoding:
Text File  |  1995-11-17  |  11.7 KB  |  303 lines
  1. -- $Source: /home/harp/1/proto/monoBANK/winnt/win32-rpcndr.adb,v $ 
  2. -- $Revision: 1.5 $ $Date: 95/02/06 12:01:43 $ $Author: scoleman $ 
  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 Stdarg;
  20. with Stdarg.Impl;
  21. with Interfaces.C;
  22. with System;
  23.  
  24. package body Win32.Rpcndr is
  25.  
  26.     function NDRSContextValue(hContext: access NDR_SCONTEXT) 
  27.                               return System.Address is      -- rpcndr.h:211
  28.     begin
  29.         return hContext.all.userContext'Address;
  30.     end NDRSContextValue;
  31.  
  32.     function To_Int is new Ada.Unchecked_Conversion(Win32.PVOID, integer);
  33.     function To_PVOID is new Ada.Unchecked_Conversion(
  34.                        integer, Win32.PVOID);
  35.  
  36.     su : integer := System.Storage_Unit;
  37.  
  38.     procedure byte_from_ndr(source: in out Win32.Rpcdcep.PRPC_MESSAGE; 
  39.                             target: out    Win32.PBYTE) is  -- rpcndr.h: 264
  40.  
  41.         function To_PBYTE is new Ada.Unchecked_Conversion(Win32.PVOID,
  42.                 Win32.PBYTE);
  43.     begin
  44.         target := To_PBYTE(source.Buffer);
  45.         source.all.Buffer := To_PVOID(To_Int(source.all.Buffer) + 
  46.                               Win32.PCHAR'Size/su);
  47.     end byte_from_ndr;
  48.     pragma inline(byte_from_ndr);
  49.  
  50.     function "-"(l,r: Interfaces.C.unsigned) 
  51.                    return Interfaces.C.unsigned
  52.                    renames Interfaces.C."-";
  53.  
  54.     procedure byte_array_from_ndr(
  55.                 Source    : in out Win32.Rpcdcep.PRPC_MESSAGE; 
  56.                 LowerIndex: in Win32.UINT;
  57.                 UpperIndex: in Win32.UINT; 
  58.                 Target    : Win32.PBYTE) is                 -- rpcndr.h:269
  59.  
  60.         function To_Int is new Ada.Unchecked_Conversion(Win32.PBYTE, integer);
  61.     begin
  62.         NDRcopy (To_PVOID(To_Int(Target) + integer(LowerIndex)),
  63.                  Source.all.Buffer, 
  64.                  UpperIndex - LowerIndex);
  65.         Source.all.Buffer := To_PVOID(
  66.                 To_Int(Source.all.Buffer) + 
  67.                         (integer(UpperIndex - LowerIndex) *
  68.                          Win32.PULONG'Size/su));
  69.     end byte_array_from_ndr;
  70.     pragma inline(byte_array_from_ndr);
  71.  
  72.  
  73.     procedure boolean_from_ndr(
  74.                 source: in out Win32.Rpcdcep.PRPC_MESSAGE;
  75.                 target: out    Win32.PBOOL) is              -- rpcndr.h:278
  76.  
  77.         function To_PBOOL is new Ada.Unchecked_Conversion(Win32.PVOID,
  78.                 Win32.PBOOL);
  79.     begin
  80.         target := To_PBOOL(source.all.Buffer);
  81.         source.all.Buffer := To_PVOID(To_Int(source.all.Buffer) + 
  82.                                Win32.PCHAR'size/su);
  83.     end boolean_from_ndr;
  84.     pragma inline(boolean_from_ndr);
  85.  
  86.     procedure boolean_array_from_ndr(
  87.                 Source    : in out Win32.Rpcdcep.PRPC_MESSAGE;
  88.                 LowerIndex: Win32.UINT;
  89.                 UpperIndex: Win32.UINT;
  90.                 Target    : Win32.PBOOL) is
  91.                                                             -- rpcndr.h:283
  92.         function To_Int is new Ada.Unchecked_Conversion(Win32.PBOOL, integer);
  93.     begin
  94.         NDRcopy (To_PVOID(To_Int(Target) + integer(LowerIndex)),
  95.                  Source.all.Buffer, 
  96.                  UpperIndex - LowerIndex);
  97.         Source.all.Buffer := To_PVOID(
  98.                 To_Int(Source.all.Buffer) + 
  99.                    (integer(UpperIndex - LowerIndex) * Win32.PULONG'size/su));
  100.     end boolean_array_from_ndr;
  101.     pragma inline(boolean_array_from_ndr);
  102.  
  103.     procedure small_from_ndr(source: in out Win32.Rpcdcep.PRPC_MESSAGE;
  104.                              target: out    psmall) is      -- rpcndr.h:292
  105.         function to_psmall is new Ada.Unchecked_Conversion(Win32.PVOID,
  106.                 psmall);
  107.     begin       
  108.         target := to_psmall(source.all.Buffer);
  109.         source.all.Buffer := To_PVOID(To_Int(source.all.Buffer) + 
  110.                                Win32.PCHAR'size/su);
  111.     end;
  112.     pragma inline(small_from_ndr);
  113.  
  114.     procedure small_array_from_ndr(
  115.                 Source    : in out Win32.Rpcdcep.PRPC_MESSAGE;
  116.                 LowerIndex: in Win32.UINT;
  117.                 UpperIndex: in Win32.UINT;
  118.                 Target    : out psmall) is                  -- rpcndr.h:302
  119.  
  120.         function To_Int is new Ada.Unchecked_Conversion(psmall, integer);
  121.     begin
  122.         NDRcopy (To_PVOID(To_Int(Target) + integer(LowerIndex)),
  123.                  Source.all.Buffer,
  124.                  UpperIndex - LowerIndex);
  125.  
  126.         Source.all.Buffer := To_PVOID(
  127.                 To_Int(Source.all.Buffer) +
  128.                     (integer(UpperIndex - LowerIndex) * Win32.PULONG'size/su));
  129.     end small_array_from_ndr;
  130.     pragma inline(small_array_from_ndr);
  131.  
  132.     function To_ULONG is new Ada.Unchecked_Conversion(Win32.PVOID, 
  133.                 Win32.ULONG);
  134.     function To_PVOID is new Ada.Unchecked_Conversion(Win32.ULONG, 
  135.                 Win32.PVOID);
  136.  
  137.     function "+"(l,r: Interfaces.C.unsigned_long) 
  138.                    return Interfaces.C.unsigned_long
  139.                    renames Interfaces.C."+";
  140.     function "*"(l,r: Interfaces.C.unsigned_long) 
  141.                    return Interfaces.C.unsigned_long
  142.                    renames Interfaces.C."*";
  143.     function "/"(l,r: Interfaces.C.unsigned_long) 
  144.                    return Interfaces.C.unsigned_long
  145.                    renames Interfaces.C."/";
  146. --    function "and"(l,r: Interfaces.C.unsigned) 
  147. --                 return Interfaces.C.unsigned
  148. --                 renames Interfaces.C."and";
  149.     function "and"(l,r: Interfaces.C.unsigned_long) 
  150.                    return Interfaces.C.unsigned_long
  151.                    renames Interfaces.C."and";
  152.  
  153.     function To_BUFPTR is new Ada.Unchecked_Conversion(Win32.ULONG, 
  154.                 RPC_BUFPTR);
  155.     function To_ULONG is new Ada.Unchecked_Conversion(RPC_BUFPTR, 
  156.                 Win32.ULONG);
  157.  
  158.     procedure midl_fa2(p : in out RPC_BUFPTR) is            -- rpcndr.h:556
  159.     begin
  160.         p := To_BUFPTR((To_ULONG(p) + Win32.ULONG(Win32.ULONG'Size/su)) 
  161.                                 and  16#fffffffe#);
  162.     end midl_fa2;
  163.  
  164.     procedure midl_fa4(p : in out RPC_BUFPTR) is            -- rpcndr.h:557
  165.     begin
  166.         p := To_BUFPTR((To_ULONG(p)+ 3 * Win32.ULONG(Win32.ULONG'Size/su))
  167.                                 and  16#fffffffc#);
  168.     end midl_fa4;
  169.  
  170.     procedure midl_fa8(p : in out RPC_BUFPTR) is            -- rpcndr.h:558  
  171.     begin
  172.         p := To_BUFPTR((To_ULONG(p) + 7 * Win32.ULONG(Win32.ULONG'Size/su))
  173.                          and 16#fffffff8#);
  174.     end midl_fa8;
  175.  
  176.     procedure midl_addp(p: in out Win32.PVOID;
  177.                         n: in Win32.ULONG ) is              -- rpcndr.h:560
  178.     begin       
  179.         p := To_PVOID(To_ULONG(p) + n * Win32.ULONG(Win32.ULONG'Size/su));
  180.     end midl_addp;
  181.  
  182.     type PPULONG is access all Win32.PULONG;
  183.  
  184.     procedure midl_unmarsh_up(p: in out Win32.PVOID) is     -- rpcndr.h:564
  185.     begin
  186.         p := To_PVOID(To_ULONG(p) + Win32.ULONG(Win32.ULONG'Size/su));
  187.     end midl_unmarsh_up;
  188.  
  189.  
  190.     function midl_ma4_ulong(p: Win32.PVOID) return Win32.PVOID is
  191.         pcopy : Win32.PVOID := p;
  192.     begin
  193.         pcopy := To_PVOID(To_ULONG(p) + Win32.ULONG(Win32.ULONG'Size/su));
  194.         return pcopy;
  195.     end midl_ma4_ulong;
  196.  
  197.     procedure NdrMarshConfStringHdr(p: in out Win32.PVOID; 
  198.                                     s: in Win32.PUCHAR; 
  199.                                     l: in Win32.ULONG ) is  -- rpcndr.h:574
  200.         function PUCHAR_To_PVOID is new Ada.Unchecked_Conversion(Win32.PUCHAR,
  201.                 Win32.PVOID);
  202.         function Int_To_PVOID is new Ada.Unchecked_Conversion(integer,
  203.                 Win32.PVOID);
  204.     begin
  205.         p := midl_ma4_ulong(p);
  206.         p := PUCHAR_To_PVOID(s);
  207.         p := midl_ma4_ulong(p);
  208.         p := Int_To_PVOID(0);
  209.         p := midl_ma4_ulong(p);
  210.         p := To_PVOID(l);
  211.     end NdrMarshConfStringHdr;
  212.  
  213.     procedure NdrUnMarshConfStringHdr(p: in out Win32.PVOID;
  214.                                       s: out Win32.PUCHAR; 
  215.                                       l: out Win32.ULONG ) is
  216.                                                             -- rpcndr.h:578
  217.         function To_PUCHAR is new Ada.Unchecked_Conversion(Win32.PVOID,
  218.                 Win32.PUCHAR);
  219.     begin
  220.         s := To_PUCHAR(midl_ma4_ulong(p));
  221.         midl_addp(p, 4);
  222.         l := To_ULONG(midl_ma4_ulong(p));
  223.     end NdrUnMarshConfStringHdr;
  224.  
  225.     function NdrMarshCCtxtHdl(pc: NDR_CCONTEXT;
  226.                               p : Win32.PVOID)  
  227.                               return Win32.ULONG is         -- rpcndr.h:582
  228.     begin
  229.         NDRCContextMarshall(pc, p );
  230.         return (To_ULONG(p)+20);
  231.     end NdrMarshCCtxtHdl;
  232.  
  233.     function NdrUnMarshCCtxtHdl(pc  : access NDR_CCONTEXT;
  234.                                 p   : Win32.PVOID;
  235.                                 h   : Win32.Rpcdce.RPC_BINDING_HANDLE;
  236.                                 drep: Win32.ULONG)
  237.                                 return Win32.ULONG is       -- rpcndr.h:584
  238.     begin
  239.         NDRCContextUnmarshall(pc, h, p, drep);
  240.         return (To_ULONG(p)+20);
  241.     end NdrUnMarshCCtxtHdl;
  242.  
  243.     procedure NdrUnMarshSCtxtHdl(pc  : out NDR_SCONTEXT;
  244.                                  p   : Win32.PVOID;
  245.                                  drep: Win32.ULONG) is      -- rpcndr.h:587
  246.     begin
  247.         pc := NdrSContextUnMarshall(p,drep );
  248.     end NdrUnMarshSCtxtHdl;
  249.     
  250.     procedure NdrMarshSCtxtHdl(pc: NDR_SCONTEXT;
  251.                                p : Win32.PVOID;
  252.                                rd: NDR_RUNDOWN) is          -- rpcndr.h:590
  253.     begin
  254.         NdrSContextMarshall(pc, p, rd);
  255.     end NdrMarshSCtxtHdl;
  256.  
  257.  
  258.     function NdrFcShort(s: Win32.USHORT) return Win32.UCHAR is
  259.                                                             -- rpcndr.h:595
  260.         function "/"(l, r: Interfaces.C.unsigned_short) 
  261.                 return Interfaces.C.unsigned_short
  262.                 renames Interfaces.C."/";
  263.         function "**"(l: Interfaces.C.unsigned_short;
  264.                       r: Natural) 
  265.                 return Interfaces.C.unsigned_short
  266.                 renames Interfaces.C."**";
  267.     begin
  268.         return  Win32.UCHAR(s/ 2**8);
  269.     end NdrFcShort;
  270.  
  271.     function NdrClientCall(
  272.                 pStubDescriptor: PMIDL_STUB_DESC;
  273.                 pFormat        : PFORMAT_STRING;
  274.                 Args           : Stdarg.ArgList := Stdarg.Empty)
  275.                return CLIENT_CALL_RETURN is                 -- rpcndr.h:1812
  276.     
  277.         function "&" is new Stdarg.Concat(PMIDL_STUB_DESC);
  278.         function "&" is new Stdarg.Concat(PFORMAT_STRING);
  279.  
  280.         use Stdarg, Stdarg.Impl;
  281.  
  282.         Complete_Args: Stdarg.Arglist :=
  283.             Stdarg.Empty & pStubDescriptor & pFormat & Args;
  284.  
  285.         procedure C_NdrClientCall;
  286.         pragma Import(Stdcall, C_NdrClientCall, "NdrClientCall");
  287.  
  288.         function To_CLIENT_CALL_RETURN is new Ada.Unchecked_Conversion (
  289.             Stdarg.C_Param, CLIENT_CALL_RETURN);
  290.  
  291.     begin
  292.         return To_CLIENT_CALL_RETURN(F_Varargs(
  293.             C_NdrClientCall'Address,
  294.             ArgCount(Complete_Args),
  295.             Address_of_First_Arg(Complete_Args)));
  296.  
  297.     end NdrClientCall;
  298.  
  299. end Win32.Rpcndr;
  300.  
  301.  
  302.  
  303.