{	Packing and Unpacking Procedures 
	================================


This is an include file to be included in RPC stubs. It contains simple (not
superefficient) packing routines. The buffer is packed in big-endian (MSB
first) format. 

	25 Apr 86	Uses pointer to buffer
	12 May 86	Tags used instead of IF..ENDIF
	26 May 86	unpack_byte added.
	15 Aug 86	(un)pack_string added
			IF used instead of tags
	12 Sep 86	NOALIGN option added for more efficiency.
			(Must match between server and client! )
	26 Sep 86	CERNCROSS verison uses library -- must match this file!
	23 Oct 86	(un)pack routines noew take rpc_p_buf parameter.
			No warning or debug or traceback for CERNCROSS
	16 Dec 86	_p_buffer ---> rpc_p_buf (M6809 can't handle _xxx).
			Use rpc_ch field of message. Added M6809 conversion
			of reals.					(TJA)
	 8 Jan 87	Bug fix in VAX real conversion - weird byte order
	28 Jan 87	PACKMODULE include identifier.			(TJA)
	20 Feb 87	pointer checking turned off explicitly on 68k
	 5 Mar 87	Bug fix of M6809 real conversion.		(TJA)
	20 Mar 87	Pack_ and unpack_ renamed to pck_ and upk_
			for Omegasoft unambiguity
	27 Apr 87	Altered usage of PACKMODULE			(TJA)
	17 May 88	PCTURBO option added.				(PL)
			VMS versions made async.			(TBL)
	20 May 88	opimize(all, inline)				(TBL)
	16 Aug 88	MACTURBO option added.		    (Roberto Bagnara)
	23 Aug 88	Kludge removed, editing this file is no longer  (RB)
			necessary. Requires new version of INCLUDE !

Note that the pointer 'rpc_p_buf^.m_index' is used throughout, as the
pointer to the next byte to be packed, in the message buffer.  It must be
intialised to the appropriate header size before use.

For most compilers, these routines should be in a separate module from the rest
of the stub, so they can be shared between all the clients/servers in one
program. However on the VAX the compiler can generate efficient inline code so
this code should be INCLUDEd into the stub. For the other compilers the
PACKMODULE INCLUDE identifier may be used to generate the separate module
that will be linked with the stubs. PACKMODULE should be used when INCLUDE
is run directly on RPCSTUB.

Allowed combinations of INCLUDE keywords:

	VAXVMS			include file for VAX/VMS stubs for inline code
	M6809			include file for M6809 stubs
	PACKMODULE M6809	separate module for M6809
	PACKMODULE PCTURBO	separate module for IBM PC TurboPascal
	PACKMODULE MACTURBO	separate module for Macintosh TurboPascal
	CERNCROSS		include file of external references
}

*IF DEF CERNCROSS 1
    {$d-} {$l-} {$k-} { Turn off pointer checking, stack checking & listing }

*IF DEF PCTURBO
*DEFINE TURBO
*ENDIF
*IF DEF MACTURBO
*DEFINE TURBO
*ENDIF
*IF DEF TURBO
*IF DEF PCTURBO 1
UNIT rpcstub;
*IF DEF MACTURBO 1
UNIT RPCStub(2);

INTERFACE

*IF DEF PCTURBO 1
uses rpcpcpas;
*IF DEF MACTURBO
*IF DEF HARD_DEBUG
{$D+}
{$R+}
{$S+}
{$S RPCStub}
*ENDIF
{$U RPCMacPas}

USES MemTypes,   {basic Memory Manager data types}
     QuickDraw,  {interface to QuickDraw}
     OSIntf,     {interface to the Operating System}
     RPCMacPas;
*ENDIF

procedure upk_char(rpc_p_buf: rpc_message_pointer;
			var ch:char);
procedure pck_char(rpc_p_buf: rpc_message_pointer;
			ch:char);
PROCEDURE pck_byte(rpc_p_buf: rpc_message_pointer;
			X : rpc_byte);		{ Unsigned Byte }
PROCEDURE upk_byte(rpc_p_buf: rpc_message_pointer;
			VAR X : rpc_byte);	{ Unsigned Byte }
PROCEDURE pck_short(rpc_p_buf: rpc_message_pointer;
			what : rpc_short);
PROCEDURE upk_short(rpc_p_buf: rpc_message_pointer;
			VAR what : rpc_short);
PROCEDURE pck_long(rpc_p_buf: rpc_message_pointer;
			what : rpc_long);
PROCEDURE upk_long(rpc_p_buf: rpc_message_pointer;
			VAR what : rpc_long);
PROCEDURE pck_integer(rpc_p_buf: rpc_message_pointer;
			what : rpc_integer);
PROCEDURE upk_integer(rpc_p_buf: rpc_message_pointer;
			 VAR what : rpc_integer);
PROCEDURE pck_real32(rpc_p_buf: rpc_message_pointer;
			what : rpc_real32);
PROCEDURE upk_real32(rpc_p_buf: rpc_message_pointer;
			VAR what : rpc_real32);
IMPLEMENTATION
*ENDIF
{____________________________________________________________________________}

*IF -DEF TURBO
*IF DEF PACKMODULE
MODULE RPCPACK;

CONST
*INCLUDE RPC$CONST
TYPE
*INCLUDE RPC$TYPES
*ENDIF
*ENDIF

*IF DEF PACKMODULE
*DEFINE INCLUDE_BODIES
*ENDIF
*IF DEF VAXVMS
*DEFINE INCLUDE_BODIES
*ENDIF
*IF DEF INCLUDE_BODIES

{	Character
	---------

A single character is padded with zeroes to make it up to 16 bits,
unless the NOALIGN option is given. }


*IF DEF VAXVMS 1
[asynchronous, optimize(all,inline)]
*IF DEF MACTURBO
procedure upk_char;
*ELSE
procedure upk_char(rpc_p_buf: rpc_message_pointer;
			var ch:char);
*ENDIF
*IF DEF PACKMODULE
*IF DEF M6809 1
Entry;
*ENDIF

begin
    with rpc_p_buf^ do begin
*IF -DEF NOALIGN 2
	ch := rpc_ch[m_index+1];
	m_index := m_index + 2;
*IF DEF NOALIGN 2
	ch := rpc_ch[m_index];
	m_index := m_index + 1;
  end;
end;

*IF DEF VAXVMS 1
[asynchronous, optimize(all,inline)]
*IF DEF MACTURBO
procedure pck_char;
*ELSE
procedure pck_char(rpc_p_buf: rpc_message_pointer;
			ch:char);
*ENDIF
*IF DEF PACKMODULE
*IF DEF M6809 1
Entry;
*ENDIF
begin
    with rpc_p_buf^ do begin
*IF -DEF NOALIGN 3
	b[m_index] := byte_0;		{ for courier standard }
	rpc_ch[m_index+1] := ch;
	m_index := m_index + 2;
*IF DEF NOALIGN 2
	rpc_ch[m_index] := ch;
	m_index := m_index + 1;
    end;
end;
                                                                          

{	Byte
	----
}
*IF DEF VAXVMS 1
[asynchronous, optimize(all,inline)]
*IF DEF MACTURBO
PROCEDURE pck_byte;
*ELSE
PROCEDURE pck_byte(rpc_p_buf: rpc_message_pointer;
			X : rpc_byte);		{ Unsigned Byte }
*ENDIF
*IF DEF PACKMODULE
*IF DEF M6809 1
Entry;
*ENDIF
begin
    with rpc_p_buf^ do begin
*IF -DEF NOALIGN 3
	b[m_index]:=byte_0;		{ pad for compatibility }
	b[m_index+1]:=X;
	m_index:=m_index+2;
*IF DEF NOALIGN 2
	b[m_index]:=X;
	m_index:=m_index+1;
    end;
end;

*IF DEF VAXVMS 1
[asynchronous, optimize(all,inline)]
*IF DEF MACTURBO
PROCEDURE upk_byte;
*ELSE
PROCEDURE upk_byte(rpc_p_buf: rpc_message_pointer;
			VAR X : rpc_byte);	{ Unsigned Byte }
*ENDIF
*IF DEF PACKMODULE
*IF DEF M6809 1
Entry;
*ENDIF
begin
    with rpc_p_buf^ do begin
*IF -DEF NOALIGN 2
	X := b[m_index+1];
	m_index:=m_index+2;
*IF DEF NOALIGN 2
	X := b[m_index];
	m_index:=m_index+1;
    end;
end;


{	SHORT (16 bit word)
	------------------
}
*IF DEF VAXVMS 1
[asynchronous, optimize(all,inline)]
*IF DEF MACTURBO
PROCEDURE pck_short;
*ELSE
PROCEDURE pck_short(rpc_p_buf: rpc_message_pointer;
			what : rpc_short);
*ENDIF
*IF DEF PACKMODULE
*IF DEF M6809 1
Entry;
*ENDIF
TYPE	ambiguous_short=	packed record case boolean of
					true:	(l: rpc_short);
*IF DEF VAXVMS 1
					false:	(a0, a1: rpc_byte);
*IF DEF CERNCROSS 1
	       				false:	(a1, a0: rpc_byte);
*IF DEF M6809 1
	       				false:	(a1, a0: rpc_byte);
*IF DEF PCTURBO 1
					false:	(a0, a1: rpc_byte);
*IF DEF MACTURBO 1
	       				false:	(a1, a0: rpc_byte);
				end;
VAR	fudge: ambiguous_short;

BEGIN
    With fudge, rpc_p_buf^ do begin
	l:=what;
	b[m_index]:=a1;
	b[m_index+1]:=a0;
	m_index := m_index + 2;
    end;
END;


*IF DEF VAXVMS 1
[asynchronous, optimize(all,inline)]
*IF DEF MACTURBO
PROCEDURE upk_short;
*ELSE
PROCEDURE upk_short(rpc_p_buf: rpc_message_pointer;
			VAR what : rpc_short);
*ENDIF
*IF DEF PACKMODULE
*IF DEF M6809 1
Entry;
*ENDIF

TYPE	ambiguous_short=	packed record case boolean of
					true:	(l: rpc_short);
*IF DEF VAXVMS 1
					false:	(a0, a1: rpc_byte);
*IF DEF CERNCROSS 1
					false:	(a1, a0: rpc_byte);
*IF DEF M6809 1
					false:	(a1, a0: rpc_byte);
*IF DEF PCTURBO 1
					false:	(a0, a1: rpc_byte);
*IF DEF MACTURBO 1
	       				false:	(a1, a0: rpc_byte);
				end;
VAR	fudge: ambiguous_short;

BEGIN
    With fudge, rpc_p_buf^ do begin
	a1:=b[m_index];
	a0:=b[m_index+1];
	m_index := m_index + 2;
	what:=l;
    end;
END;

{	LONG (32-bit word)
	------------------
}
*IF DEF VAXVMS 1
[asynchronous, optimize(all,inline)]
*IF DEF MACTURBO
PROCEDURE pck_long;
*ELSE
PROCEDURE pck_long(rpc_p_buf: rpc_message_pointer;
			what : rpc_long);
*ENDIF
*IF DEF PACKMODULE
*IF DEF M6809 1
Entry;
*ENDIF

TYPE	ambiguous_long=		packed record case boolean of
					true:	(l: rpc_long);
*IF DEF VAXVMS 1
					false:	(a0, a1, a2, a3: rpc_byte);
*IF DEF CERNCROSS 1
					false:	(a3, a2, a1, a0: rpc_byte);
*IF DEF M6809 1
					false:	(a3, a2, a1, a0: rpc_byte);
*IF DEF PCTURBO 1
					false:	(a0, a1, a2, a3: rpc_byte);
*IF DEF MACTURBO 1
					false:	(a3, a2, a1, a0: rpc_byte);
				end;

VAR	fudge: ambiguous_long;

BEGIN
    With fudge, rpc_p_buf^ do begin
	l:=what;
	b[m_index]:=a3;
	b[m_index+1]:=a2;                
	b[m_index+2]:=a1;
	b[m_index+3]:=a0;
	m_index := m_index + 4;
    end;
END;


*IF DEF VAXVMS 1
[asynchronous, optimize(all,inline)]
*IF DEF MACTURBO
PROCEDURE upk_long;
*ELSE
PROCEDURE upk_long(rpc_p_buf: rpc_message_pointer;
			VAR what : rpc_long);
*ENDIF
*IF DEF PACKMODULE
*IF DEF M6809 1
Entry;
*ENDIF

TYPE	ambiguous_long=		packed record case boolean of
					true:	(l: rpc_long);
*IF DEF VAXVMS 1
					false:	(a0, a1, a2, a3: rpc_byte);
*IF DEF CERNCROSS 1
					false:	(a3, a2, a1, a0: rpc_byte);
*IF DEF M6809 1
					false:	(a3, a2, a1, a0: rpc_byte);
*IF DEF PCTURBO 1
					false:	(a0, a1, a2, a3: rpc_byte);
*IF DEF MACTURBO 1
					false:	(a3, a2, a1, a0: rpc_byte);
				end;

VAR	fudge: ambiguous_long;

BEGIN
    With fudge, rpc_p_buf^ do begin
	a3 := b[m_index];
	a2 := b[m_index+1];
	a1 := b[m_index+2];
	a0 := b[m_index+3];
	m_index := m_index + 4;
	what:=l;
    end;
END;

{	INTEGER (Local size with 16-bit values)
	---------------------------------------
}
*IF DEF VAXVMS 1
[asynchronous, optimize(all,inline)]
*IF DEF MACTURBO
PROCEDURE pck_integer;
*ELSE
PROCEDURE pck_integer(rpc_p_buf: rpc_message_pointer;
			what : rpc_integer);
*ENDIF
*IF DEF PACKMODULE
*IF DEF M6809 1
Entry;
*ENDIF

TYPE	ambiguous_integer=		packed record case boolean of
					true:	(l: rpc_integer);
*IF DEF VAXVMS 1
					false:	(a0, a1, a2, a3: rpc_byte);
*IF DEF CERNCROSS 1
	      				false:	(a3, a2, a1, a0: rpc_byte);
*IF DEF M6809 1
	      				false:	(a1, a0: rpc_byte);
*IF DEF PCTURBO 1
	      				false:	(a0, a1: rpc_byte);
*IF DEF MACTURBO 1
	      				false:	(a1, a0: rpc_byte);
				end;

VAR	fudge: ambiguous_integer;

BEGIN
    With fudge, rpc_p_buf^ do begin
	l:=what;
	b[m_index]:=a1;
	b[m_index+1]:=a0;
	m_index := m_index + 2;
    end;
END;


*IF DEF VAXVMS 1
[asynchronous, optimize(all,inline)]
*IF DEF MACTURBO
PROCEDURE upk_integer;
*ELSE
PROCEDURE upk_integer(rpc_p_buf: rpc_message_pointer;
			 VAR what : rpc_integer);
*ENDIF
*IF DEF PACKMODULE
*IF DEF M6809 1
Entry;
*ENDIF

TYPE	ambiguous_integer=		packed record case boolean of
					true:	(l: rpc_short);
*IF DEF VAXVMS 1
					false:	(a0, a1: rpc_byte);
*IF DEF CERNCROSS 1
					false:	(a1, a0: rpc_byte);
*IF DEF M6809 1
	      				false:	(a1, a0: rpc_byte);
*IF DEF PCTURBO 1
	      				false:	(a0, a1: rpc_byte);
*IF DEF MACTURBO 1
	      				false:	(a1, a0: rpc_byte);
				end;

VAR	fudge: ambiguous_integer;

BEGIN
    With fudge, rpc_p_buf^ do begin
	a1 := b[m_index+0];
	a0 := b[m_index+1];
	m_index := m_index + 2;
	what:=l;	{ Let system extend to 4 bytes if necessary 
			  NB: If VAX or 68k, then we extend (with sign!)
			      If 6809, we can't extend but we don't need to }
    end;
END;

{	Real Number  (32 bit)
	--------------------
}

*IF DEF VAXVMS 1
[asynchronous, optimize(all,inline)]
*IF DEF MACTURBO
PROCEDURE pck_real32;
*ELSE
PROCEDURE pck_real32(rpc_p_buf: rpc_message_pointer;
			what : rpc_real32);
*ENDIF
*IF DEF PACKMODULE
*IF DEF M6809 1
Entry;
*ENDIF

TYPE	ambiguous_real32=		packed record case boolean of
					true:	(l: rpc_real32);
*IF DEF VAXVMS 1
					false:	(a2, a3, a0, a1: rpc_byte);
*IF DEF CERNCROSS 1
					false:	(a3, a2, a1, a0: rpc_byte);
*IF DEF M6809 1
					false:	(a3, a2, a1, a0: rpc_byte);
*IF DEF PCTURBO 1
					false:  (a3, x, y, a0, a1, a2: rpc_byte);
*IF DEF MACTURBO 1
					false:	(a3, a2, a1, a0: rpc_byte);
				end;

VAR	fudge: ambiguous_real32;
*IF DEF M6809 1
	e:	integer;   

BEGIN
    With fudge, rpc_p_buf^ do begin
	l:=what;
*IF -DEF M6809
*IF -DEF PCTURBO
*IF DEF VAXVMS 2
	if (a3 mod 128) = 0 then l:= 0.0; 	{ If underflow, set to zero }
	if l <> 0.0 then a3:= a3 - 1; 		{ Adjust to IEEE format }
 	b[m_index]:= a3;
	b[m_index+1]:=a2;
*ENDIF
*ENDIF
*IF DEF M6809
	if l = 0.0            
	then e:= 0
	else e:= ord(a3 and #127) + 126;
	b[m_index]:= (a3 and #128) or chr(e >> 1);
	if odd(e)
	then b[m_index+1]:= a2
	else b[m_index+1]:= a2 and #127;
*ENDIF
*IF DEF PCTURBO
	if a3 = 0.0 then
	begin
	  l := 0.0;
	  b[m_index] := 0;
	  b[m_index+1] := 0;
	end
	else
	begin
	  b[m_index] := ((a2 and $80) or (a3 shr 1)) - 1;
	  if a3 = (a3 or 1) then
	    b[m_index+1] := a2 or $80
	  else
	    b[m_index+1] := a2 and $7F;
	end;
*ENDIF
	b[m_index+2]:=a1;
	b[m_index+3]:=a0;
	m_index := m_index + 4;
    end;
END;


*IF DEF VAXVMS 1
[asynchronous, optimize(all,inline)]
*IF DEF MACTURBO
PROCEDURE upk_real32;
*ELSE
PROCEDURE upk_real32(rpc_p_buf: rpc_message_pointer;
			VAR what : rpc_real32);
*ENDIF
*IF DEF PACKMODULE
*IF DEF M6809 1
Entry;
*ENDIF

TYPE	ambiguous_real32=		packed record case boolean of
					true:	(l: rpc_real32);
*IF DEF VAXVMS 1
					false:	(a2, a3, a0, a1: rpc_byte);
*IF DEF CERNCROSS 1
					false:	(a3, a2, a1, a0: rpc_byte);
*IF DEF M6809 1
					false:	(a3, a2, a1, a0: rpc_byte);
*IF DEF PCTURBO 1
					false:  (a3,x,y,a0,a1,a2: rpc_byte);
*IF DEF MACTURBO 1
					false:	(a3, a2, a1, a0: rpc_byte);
				end;

VAR	fudge:  ambiguous_real32;
*IF DEF M6809 1
    	e:	integer;

BEGIN
    With fudge, rpc_p_buf^ do begin
*IF -DEF M6809
*IF -DEF PCTURBO
	if ((b[m_index] mod 128) = 0) and (b[m_index+1] < 128)
	then l:= 0.0
	else
	begin
	     	a3 := b[m_index];
*IF DEF VAXVMS 3
		if (b[m_index] mod 128) > 126
		then m_status:= rpc_s_conversion_error
		else a3:= a3 + 1;
		a2 := b[m_index+1];
		a1 := b[m_index+2];
		a0 := b[m_index+3];
	end;
*ENDIF
*ENDIF
*IF DEF M6809
   	e:= ord((b[m_index] << #1) or (b[m_index+1] >> #7)) - 126;
	if e < -64
	then l:= 0.0	{ If zero or underflow, then put in 0.0 }
	else if (e > 63)
             then m_status:= rpc_s_conversion_error
             else
             begin
                     a3:= (b[m_index] and #128) or (chr(e) and #127);
                     a2:= b[m_index+1] or #128;
                     a1:= b[m_index+2];
                     a0:= b[m_index+3];
             end;
*ENDIF
*IF DEF PCTURBO
	if ((b[m_index] mod 128) = 0) and (b[m_index+1] < 128) then
	    l := 0.0
	else
	begin
	    if (b[m_index] mod 128) > 126 then
		m_status := rpc_s_conversion_error;
	    b[m_index] := b[m_index]+1;
	    a3 := b[m_index] shl 1;
	    if b[m_index+1] = (b[m_index+1] or $80) then
		a3 := a3 or 1
	    else
		a3 := a3 and $FE;
	    a2 := b[m_index+1];
	    if b[m_index] = (b[m_index] or $80) then
		a2 := a2 or $80
	    else
		a2 := a2 and $7F;
	    a1:= b[m_index+2];
	    a0:= b[m_index+3];
	    x := 0;
	    y := 0;
	end;
*ENDIF
	m_index := m_index + 4;
	what:=l;
    end;
END;

*IF DEF PACKMODULE
*IF -DEF M6809
*IF -DEF CERNCROSS 1
END.
*ENDIF
*IF DEF CERNCROSS 1
   .
*IF DEF M6809 1
MODEND.
*ENDIF
*ENDIF

{_____________________________________________________________________________}
*IF -DEF INCLUDE_BODIES

{		Declarations as external procedures
}

PROCEDURE pck_char(rpc_p_buf: rpc_message_pointer;
			ch:char);
*IF -DEF M6809 1
Extern;
*IF DEF M6809 1
External;

PROCEDURE upk_char( rpc_p_buf: rpc_message_pointer;
			var ch:char);		
*IF -DEF M6809 1
Extern;
*IF DEF M6809 1
External;

PROCEDURE pck_byte( rpc_p_buf: rpc_message_pointer;
				X : rpc_byte);		
*IF -DEF M6809 1
Extern;
*IF DEF M6809 1
External;

PROCEDURE upk_byte( rpc_p_buf: rpc_message_pointer;
			VAR X : rpc_byte);	
*IF -DEF M6809 1
Extern;
*IF DEF M6809 1
External;

PROCEDURE pck_short( rpc_p_buf: rpc_message_pointer;
				X : rpc_short);		
*IF -DEF M6809 1
Extern;
*IF DEF M6809 1
External;

PROCEDURE upk_short( rpc_p_buf: rpc_message_pointer;
			VAR X : rpc_short);	
*IF -DEF M6809 1
Extern;
*IF DEF M6809 1
External;

PROCEDURE pck_long( rpc_p_buf: rpc_message_pointer;
				X : rpc_long);		
*IF -DEF M6809 1
Extern;
*IF DEF M6809 1
External;

PROCEDURE upk_long( rpc_p_buf: rpc_message_pointer;
			VAR X : rpc_long);	
*IF -DEF M6809 1
Extern;
*IF DEF M6809 1
External;

PROCEDURE pck_integer( rpc_p_buf: rpc_message_pointer;
				X : rpc_integer);		
*IF -DEF M6809 1
Extern;
*IF DEF M6809 1
External;

PROCEDURE upk_integer( rpc_p_buf: rpc_message_pointer;
			VAR X : rpc_integer);	
*IF -DEF M6809 1
Extern;
*IF DEF M6809 1
External;

PROCEDURE pck_real32( rpc_p_buf: rpc_message_pointer;
				X : rpc_real32);	
*IF -DEF M6809 1
Extern;
*IF DEF M6809 1
External;

PROCEDURE upk_real32( rpc_p_buf: rpc_message_pointer;
			VAR X : rpc_real32);	
*IF -DEF M6809 1
Extern;
*IF DEF M6809 1
External;
*ENDIF