Program MSGPACKET;
 {$nowalkback}
 {$nomain}
 {[A-,B+,K+,L-,R+,T=3] PASMAT DIRECTIVES}


{ File: [22,310]MSGPACKET.PAS     Last Edit: 9-OCT-1989 22:03:38 

  This file is a collection of routines that are used for working with
  Message Packets.
  These routines use the Pascal string package whereever applicable.

  History:

    30-Jan-89.  Philip Hannay.  Created from [16,10]MSGPACKET.PAS
    18-Mar-89.  Philip Hannay.  Expanded to include packet sub types.
    22-May-89.  Philip Hannay.  Added PK_FIELD_VALUE, and increased
                   PK_RESOURCE length.
    19-May-89.  Philip Hannay.  Accomodated changes in MSGPACKET.TYP,
                   added MSGLEN function to return valid length of
                   a message packet (for use by SNDMSG, and by a
                   user if needed).
    8-Aug-89.   Philip Hannay.  Adjusted PK_RECORD length calculation.

}

%include pas$ext:general.typ;
%include pas$ext:string.pkg;
%include pas$ext:msgpacket.typ;

%include pas$ext:vsda.ext;
%include pas$ext:vrcd.ext;
%include pas$ext:catr56.ext;
%include pas$ext:cr56ta.ext;


{ The following message packet handling routines are supplied for
  use either on an AMI generic system or specific sites.  At this
  time, MSGPACKET.TYP includes both generic and site specific packet
  types so they are handled here.  See [22,320]MSGPACKET.TYP for
  further explanation. }


{ Note that in the table below, we supply an ascii translation of
  the packet id.  We try and keep the ascii name as close to the
  scalar (pk_..) name as possible. }

type
  packet_id_array = packed array [message_packet_id_type] of ch20;


const
  packet_id_table = packet_id_array 

                    { alpha translation }   
                       
                    ('Misc message        ',   {pk_misc}
                     'Debug setup         ',   {pk_debug}
                     'Monitor setup       ',   {pk_monitor}
                     'View setup          ',   {pk_view}
                     'Info short          ',   {pk_info_short}
                     'Info long           ',   {pk_info_long}
                     'Check configuration ',   {pk_check_config}
                     'Orderly abort       ',   {pk_orderly_abort}
                     'Wake up             ',   {pk_wake_up_sender}
                     'Send as is          ',   {pk_send_as_is}
                     'ACKed transaction   ',   {pk_ACKed_transaction}
                     'NAKed transaction   ',   {pk_NAKed_transaction}
                     'Resource info       ',   {pk_resource}
                     'Identity info       ',   {pk_identity}
                     'Gate info           ',   {pk_gate}
                     'Report status       ',   {pk_report_status}
                     'Synchronize         ',   {pk_synch}
                     'Scale info          ',   {pk_scale}
                     'Control symbol info ',   {pk_control_symbol}
                     'Control alpha value ',   {pk_control_alpha}
                     'Control numeric val ',   {pk_control_numeric}
                     'Bin info            ',   {pk_bin}
                     'Field value         ',   {pk_field_value}
                     'Record value        ',   {pk_record}
                     'Reserved 9          ',   {pk_reserved9}
                     'Reserved 10         ',   {pk_reserved10}
                     'Reserved 11         ',   {pk_reserved11}
                     'Reserved 12         ',   {pk_reserved12}
                     'Reserved 13         ',   {pk_reserved13}
                     'Reserved 14         ',   {pk_reserved14}
                     'Reserved 15         ',   {pk_reserved15}
                     'Reserved 16         ',   {pk_reserved16}
                     'Reserved 17         ',   {pk_reserved17}
                     'Reserved 18         ',   {pk_reserved18}
                     'Reserved 19         ',   {pk_reserved19}
                     'Reserved 20         ',   {pk_reserved20}
                     'Reserved 21         ',   {pk_reserved21}
                     'Reserved 22         ',   {pk_reserved22}
                     'Reserved 23         ',   {pk_reserved23}

                     'Comment             ',   {pk_comment}

                 { now the site/system specific packets }

                     'Phil example        ',   {pk_phil}


                 { and the trailer - always present, AMI generic }

                     'Unknown             '    {pk_unknown}
                   );



{ Now we define a table that will translate packet sub type set elements
  into ascii strings.  We keep the strings short, since there may be
  a number of elements in the set. }


type
  packet_sub_array = packed array [message_packet_sub_type] of ch10;

const
  packet_sub_table = packet_sub_array 

                    { alpha translation }   
                       
                    ('ack       ',   {ps_ack}
                     'nak       ',   {ps_nak}
                     'ackreq    ',   {ps_ack_requested}
                     'reqinfo   ',   {ps_req_info}
                     'fillinfo  ',   {ps_fill_info}
                     'noinfo    ',   {ps_no_info}
                     'someinfo  ',   {ps_some_info}
                     'fullinfo  ',   {ps_full_info}
                     'start     ',   {ps_start}
                     'stop      ',   {ps_stop}
                     'resume    ',   {ps_resume}
                     'finish    ',   {ps_finish}
                     'event     ',   {ps_event}
                     'alloc     ',   {ps_allocate}
                     'grant     ',   {ps_grant}
                     'deny      ',   {ps_deny}
                     'execute   ',   {ps_execute}
                     'open      ',   {ps_open}
                     'get       ',   {ps_get}
                     'put       ',   {ps_put}
                     'close     ',   {ps_close}
                     'watch     ',   {ps_watch}
                     'nocando   ',   {ps_nocando}
                     'res3      ',   {ps_reserved3}
                     'res4      ',   {ps_reserved4}
                     'res5      ',   {ps_reserved5}
                     'res6      ',   {ps_reserved6}
                     'res7      ',   {ps_reserved7}
                     'res8      ',   {ps_reserved8}
                     'res9      ',   {ps_reserved9}
                     'res10     ',   {ps_reserved10}
                     'res11     '    {ps_reserved11}
                   );




Procedure cpitas(pkt_id: message_packet_id_type;
                 var str: packed array [low..high:integer] of char);
  external;

{ Convert the Message Packet ID in PKT_ID to an alpha name.  STR
  can be a type0 or type1 string of any length.  The name will be
  truncated if required.  A maximum of 20 characters will be used
  in the string. }

Procedure cpitas;

var
  hold: ch20;

Begin
if ord(pkt_id) > ord(pk_unknown)
  then Sassign(str,'Packet out of range')
  else begin
    { convert translation to a type1 string, then assign to param string }
    hold:= packet_id_table[pkt_id];
    Spad(hold,' ',chr(0));
    Sassign(str,hold);
    end;
End;



Procedure cpstas(pkt_sub: message_packet_sub_set;
                 var str: packed array [low..high:integer] of char);
  external;

{ Convert the Message Packet SUB type set elements to an alpha name.  STR
  can be a type0 or type1 string of any length.  Each element that is
  present in the set will be translated and placed in the target string.
  Commas will separate the translation, with no intervening spaces.  The
  string will be truncated if required.  A maximum of 100 characters will
  be used if the set contains all possible elements. }

Procedure cpstas;

var
  hold: ch10;
  first: boolean;
  sub: message_packet_sub_type;

Begin
first:= true;
sassign(str,'<empty>');
for sub:= ps_ack to ps_reserved11 do
  begin
  { check for element in set, if found, translate and add to target string }
  if sub in pkt_sub
    then begin
      { element found in set, get translation, convert to type1 string }
      hold:= packet_sub_table[sub];
      Spad(hold,' ',chr(0));  { replace trailing blanks with nulls }
      if first 
        then begin
          { initialize string with SASSIGN }
          first:= false;
          sassign(str,hold);
          end
        else begin
          { string already started, now add comma and concatenate }
          schconcat(str,',');
          Sconcat(str,hold);
          end;
      end;
  end; {for}
End;


Function MsgLen(var message: message_packet_type):integer;
  External;

{*USER*

Return the "valid" (used) length of the message in MESSAGE.  This is
the byte count of the message that is currently used.  This could be
the entire message (currently 206 byte max), or only part of the
message (will be at least 6 bytes).  The length of the message is
computed based on the MESSAGE_PACKET_TYPE ID field, and then on
string length or byte count fields within that message.  For this
reason, the message in MESSAGE must be filled in, complete and valid before
calling this routine, or an improper length may be calculated.

*ERROR CODES*

There are no errors.
However, any inconsistency found while calculating a message 
length will result
in a length of 206 being returned.  206 is the maximum length of any
message, and thus will guarantee that the message contents, regardless
of their format, will be considered valid.  Keep in mind that 206
is a valid message length for a number of messages.

}

{*WIZARD*

    This function is called internally by MSSEND (at least). The call
    site is hard-coded to call MSGLEN from within a MACRO routine. 

    	***** DO NOT CHANGE THE CALL SITE *****
    
}
    
    
Function MsgLen;

{ Currently, the type MESSAGE_PACKET_TYPE is a 206 byte variant record,
  with the first 2 bytes used for the ID, the second 4 bytes used for
  the SUB sub type subset, and the remaining 200 bytes used by the
  record variants. }

Var
  len: integer;

Begin
len:= 0;

case message.id of
  { for ease of insertion, items are ordered by size, with fixed length
    types first, and the variable length types at the end.  LEN is the
    length of the fixed and variant part of the record.  If not changed, 
    it will remain as zero.  A LEN of zero will be interpreted to be
    "unknown" and the maximum length possible will be substituted for LEN.}

  pk_orderly_abort,
  pk_wake_up_sender,
  pk_reserved9,
  pk_reserved10,
  pk_reserved11,
  pk_reserved12,
  pk_reserved13,
  pk_reserved14,
  pk_reserved15,
  pk_reserved16,
  pk_reserved17,
  pk_reserved18,
  pk_reserved19,
  pk_reserved20,
  pk_reserved21,
  pk_reserved22,
  pk_reserved23,
  pk_unknown: len:= 6;

  pk_synch: len:= 18;  

  pk_gate: len:= 22;

  pk_info_short,
  pk_identity: len:= 26;

  pk_control_symbol: len:= 30;

  pk_resource: len:= 36;

  pk_bin: len:= 46;

  pk_check_config,
  pk_report_status,
  pk_phil: len:= 66;

  pk_debug,
  pk_monitor,
  pk_view: len:= 68;

  pk_scale: len:= 188;

  pk_info_long,
  pk_send_as_is,
  pk_ACKed_transaction,
  pk_NAKed_transaction,
  pk_comment: len:= 7 + slen(message.linfo);
    { NOTE that we used MESSAGE.LINFO for all of this group as it
      overmaps the same type0 string in all }

  pk_record: len:= 8 + (message.record_len * 2);

  pk_control_alpha: len:= 13 + slen(message.alpha_value);

  pk_control_numeric: len:= 14 + (message.numeric_len * 2);

  pk_field_value: len:= 17 + slen(message.field_value);

  otherwise len:= 206;
  end; {case}

if (len <= 0) or (len > size(message_packet_type))
  then msglen:= size(message_packet_type)
  else msglen:= len;
end;  { function msglen }


procedure SndMsg(var dest: packed array [dlow..dhigh: integer] of char;
                 var message: message_packet_type;
                 var send_status: integer
  	);External;

{*USER*
 Send a MESSAGE to the task at DEST.  $DSW from variable send directive is
 returned in SEND_STATUS. }


Procedure SndMsg;

var
  bufadr: address;
  add, len: integer;
  task: ch6;
  rad56_task: rad56;

begin {send string}
len:= msglen(message);
add:= len mod 2;  { see if byte count in len is odd - ADD will be 1 if odd }
len:= (len div 2) + add;  { convert LEN to word count, adding 1 if odd byte }
bufadr:= loophole(address, ref(message));
svassign(task,dest);
catr56(task,rad56_task);
VSDA(rad56_task,bufadr,len,f0);
send_status:= $DSW;
end; { send string }


procedure RcvMsg(var dest: packed array [dlow..dhigh: integer] of char;
                 var message: message_packet_type;
                 var recv_status: integer
  	);External;

{*USER*
Receive a MESSAGE from the task specified in DEST.  If no task specified,
(string is clear - len = 0), then receive from any task.
The $DSW from variable receive directive is
returned in RECV_STATUS. }

Procedure RcvMsg;

type
  Packet_allocation_block = record
    rad56_task: rad56;
    message: packed array [1..512] of char;
    end;    

  ch220 = packed array [1..220] of char;
  ch220_ptr_typ = ^ch220;

var
  PAB: Packet_allocation_block;
  bufadr: address;
  ch220_ptr: ch220_ptr_typ;
  i, len: integer;
  task: ch6;

begin {send string}
if slen(dest) = 0
  then begin
    { no task specified, receive from any sender }
    sclear(task);
    end
  else begin
    { task specified, put in TASK. }
    svassign(task, dest);
    end;
catr56(task, pab.rad56_task);
bufadr:= loophole(address, ref(pab));
VRCD(bufadr,256);
recv_status:= $dsw;
if recv_status >= 2
  then begin
    { successful receive, get the task name and message }
    cr56ta(pab.rad56_task, task);
    svassign(dest, task);
    len:= (recv_status - 2) * 2;
    if len > size(message_packet_type) then len:= size(message_packet_type);
    ch220_ptr:= loophole(ch220_ptr_typ, ref(message));
    for i:=1 to len do ch220_ptr^[i]:= pab.message[i];      
    end;
end; { receive string } 

