DEFINITION MODULE ITCUTL;   (*$VER 1.0*)

(* ----------------------------------------------------------------------
                Copyright (c) 1987 by Telepath Systems, Inc.
                            All Rights Reserved

               Inter-Task Communication System Access Library

     This library exports high-level facilities for message processing
     through the AMOS Inter-Task Communication System. Although these
     routines are designed only for messaging on the same system they
     may be easily modified for netword use.
   ---------------------------------------------------------------------- *)

FROM SYSTEM IMPORT BYTE;


CONST
  (* Define more meaningful result constants *)

  MsgSuccess      = 0D;			(* operation was successful       *)
  SocketNotOpen   = 1D;			(* no socket open for sender      *)
  NoPendingMsg    = 2D;			(* no messages are pending        *)
  NotSupported    = 3D;			(* message system not supported   *)
  NetworkNotFound = 4D;			(* destination netword not found  *)
  NodeNotFound    = 5D;			(* destination node not found     *)
  SocketNotFound  = 6D;			(* destination socket not found   *)
  SocketExists    = 7D;			(* socket already exists          *)
  NoMsgBuffers    = 8D;			(* no message buffers available   *)
  NoQueueBlocks   = 9D;			(* no queue blocks available      *)
  ArgOutOfRange   = 10D;		(* arg address outside partition  *)
  SocketFull      = 11D;		(* destinition socket is full     *)
  SocketNotReady  = 12D;		(* destination socket not enabled *)
  MsgTooLong      = 13D;		(* msg length execeeds dest max   *)


PROCEDURE OpenMessage(msglen, msgque: CARDINAL; VAR result: LONGCARD);
  (* Open a message socket to send/receive ITC messages.

     msglen: Size of longest message to be processed.
     msgque: Maximum number of messages that may be pending at one time.
     result: Returns the ITC result code for the operation.
  *)

PROCEDURE CloseMessage(VAR result: LONGCARD);
  (* Close a message socket to end processing. 

     result: Returns the ITC result code for the operation.
  *)

PROCEDURE SendMessage(socket: CARDINAL; code: CARDINAL;
                      VAR msg: ARRAY OF BYTE; VAR result: LONGCARD);
  (* Send a message to another socket.

     socket: The socket to send the message to.
     code:   The message application code. This value is set by the
             sender to signal different types of messages within the
             application. This field is ignored by the ITC system.
     msg:    The message to send. It will be truncated if it exceeds the
             size specified with OpenMessage. This is declared as a VAR
             for speed and is not modified by the procedure.
     result: Returns the ITC result code for the operation.
  *)

PROCEDURE SendControlMsg(socket: CARDINAL; code: CARDINAL;
                         VAR result: LONGCARD);
  (* Send a high-priorty message to another socket.

     socket: The socket to send the message to.
     code:   The special control code to send.
     result: Returns the ITC result code for the operation.

     This procedure is used to send application control messages that do
     not require a message data field. These messages are sent with the
     ITC priority flag set so that the message will be inserted at the
     front of the receiver's message queue.
  *)

PROCEDURE RecvMessage(VAR socket: CARDINAL; VAR code: CARDINAL;
                      VAR msg: ARRAY OF BYTE; VAR result: LONGCARD);
  (* Receive a message from another socket.

     socket: Returns the socket number of the sender.
     code:   Returns the message application code given by the sender.
     msg:    The message data received. It will be truncated if msg
             is shorter than the size specified with OpenMessage.
     result: Returns the ITC result code for the operation.
  *)

PROCEDURE WaitMessage(tenths: CARDINAL): BOOLEAN;
  (* Wait for a message to arrive or time-out.

     tenths:  The time to wait in tenths of seconds.
     returns: TRUE if a message has arrived.
  *)

PROCEDURE CheckMessage(VAR msgs: CARDINAL): BOOLEAN;
  (* Check for pending messages.

     msgs:    Returns the number of pending messages.
     returns: TRUE if there are messages pending.
  *)

PROCEDURE FindSocket(name: ARRAY OF CHAR; VAR socket: CARDINAL);
  (* Find the socket number for a job.
  
     name:   The name of the job to search for.
     socket: The socket number of the job or zero if the job was
             not found.
  *)

END ITCUTL.

================================= CUT HERE =================================

IMPLEMENTATION MODULE ITCUTL;   (*$VER 1.0(101)*)

(* ----------------------------------------------------------------------
                Copyright (c) 1987 by Telepath Systems, Inc.
                            All Rights Reserved

               Inter-Task Communication System Access Library

   
   History: 1.0 100 12/30/87 MDT Original.
                101 01/12/88 MDT Added VAR to CheckMessage declaration.
   ---------------------------------------------------------------------- *)

FROM SYSTEM   IMPORT ADDRESS, BYTE, ADR, TSIZE, VAL, SHORT, LONG;
FROM SYSITC   IMPORT omske, mspri, OM, MS, MSPTR, OPNMSG, CLSMSG, SNDMSG,
                     RCVMSG, CHKMSG, WTMSG;
FROM SYSCOM   IMPORT SCBPTR;
FROM SYSJOB   IMPORT JCBPTR;
FROM Storage  IMPORT ALLOCATE, DEALLOCATE, Available;
FROM FastData IMPORT Move;
FROM Rad50Lib IMPORT StringToLongRad50;


VAR
  HdrLen: CARDINAL;			(* message header size            *)
  MsgLen: CARDINAL;			(* message size without header    *)
  TotLen: CARDINAL;			(* total message size with header *)
  HdrPtr: MSPTR;			(* message header pointer         *)
  MsgPtr: POINTER TO BYTE;		(* message buffer pointer         *)


(*** Internal Procedures ***)

PROCEDURE Min(first, second: CARDINAL): CARDINAL;
BEGIN
  IF first < second THEN
    RETURN first;
  ELSE
    RETURN second;
  END;
END Min;


(*** Exported Procedures ***)

PROCEDURE OpenMessage(msglen, msgque: CARDINAL; VAR result: LONGCARD);
VAR
  arg: OM;
BEGIN
  MsgLen := msglen;			(* save message length            *)
  TotLen := msglen + HdrLen;		(* save size of msg with header   *)

  WITH arg DO				(* init OPNMSG argument block     *)
    flg := {omske};			(* enable socket                  *)
    len := TotLen;			(* message size including header  *)
    max := msgque;			(* max number of waiting messages *)
    msr := NIL;				(* no message service routine     *)
  END;

  OPNMSG(ADR(arg), result);		(* open the socket                *)

  IF result = MsgSuccess THEN
    IF Available(TotLen) THEN
      ALLOCATE(HdrPtr,TotLen);		(* allocate msg send/recv buffer  *)
      MsgPtr := ADR(HdrPtr^.spr);	(* AMOS/L 1.3 doesn't have spr    *)
    ELSE
      CLSMSG(result);			(* close the socket               *)
      result := SocketNotOpen;		(* signal socket didn't open      *)
      HdrPtr := NIL;			(* invalidate pointer             *)
      MsgPtr := NIL;			(* invalidate pointer             *)
    END;
  END;
END OpenMessage;

PROCEDURE CloseMessage(VAR result: LONGCARD);
BEGIN
  CLSMSG(result);			(* close the socket               *)
  IF HdrPtr # NIL THEN
    DEALLOCATE(HdrPtr, TotLen);		(* deallocate msg buffer memory   *)
  END;
END CloseMessage;

PROCEDURE SendMessage(socket: CARDINAL; code: CARDINAL;
                      VAR msg: ARRAY OF BYTE; VAR result: LONGCARD);
VAR
  size: CARDINAL;
BEGIN
  size := Min(MsgLen, SIZE(msg));

  WITH HdrPtr^ DO
    flg := {};				(* normal message                 *)
    dst.network := 0C;			(* destination is on same system  *)
    dst.group   := 0C;
    dst.node    := 0;
    dst.socket  := socket;		(* set destination socket         *)
    siz := size + HdrLen;		(* set size of this msg with hdr  *)
    cod := code;			(* set application message code   *)
  END;

  Move(ADR(msg), MsgPtr, size);		(* put msg in buffer              *)
  SNDMSG(HdrPtr, result, {});		(* send the message               *)
END SendMessage;

PROCEDURE SendControlMsg(socket: CARDINAL; code: CARDINAL;
                         VAR result: LONGCARD);
BEGIN
  WITH HdrPtr^ DO
    flg := {mspri};			(* set high-priority flag         *)
    dst.network := 0C;			(* destination is on same system  *)
    dst.group   := 0C;
    dst.node    := 0;
    dst.socket  := socket;		(* set destination socket         *)
    siz := HdrLen;			(* msg only has a header          *)
    cod := code;			(* set application message code   *)
  END;

  SNDMSG(HdrPtr, result, {});		(* send the message               *)
END SendControlMsg;

PROCEDURE RecvMessage(VAR socket: CARDINAL; VAR code: CARDINAL;
                      VAR msg: ARRAY OF BYTE; VAR result: LONGCARD);
VAR
  size: CARDINAL;
BEGIN
  RCVMSG(HdrPtr, result, {});		(* attempt to receive the msg     *)

  IF result = MsgSuccess THEN
    WITH HdrPtr^ DO
      socket := src.socket;		(* return sender's socket         *)
      code   := cod;			(* return sender applicaton code  *)
    END;

    size := Min(MsgLen, SIZE(msg));
    Move(MsgPtr, ADR(msg), size);	(* return msg                     *)
  ELSE
    socket := 0;
    code := 0;
  END;
END RecvMessage;

PROCEDURE WaitMessage(tenths: CARDINAL): BOOLEAN;
BEGIN
  RETURN WTMSG(LONG(tenths) * 1000D);	(* convert 10ths to microseconds  *)
END WaitMessage;

PROCEDURE CheckMessage(VAR msgs: CARDINAL): BOOLEAN;
VAR
  b: BOOLEAN;
  d: LONGCARD;
BEGIN
  b := CHKMSG(d);
  msgs := SHORT(d);
  RETURN b;
END CheckMessage;

PROCEDURE FindSocket(name: ARRAY OF CHAR; VAR socket: CARDINAL);
  (* This procedure returns the socket number for the *)
  (* specified job. This could easily be modified to  *)
  (* match user name or running program name.         *)

VAR
  jcb: JCBPTR;
  jtp: POINTER TO ADDRESS;
  job: LONGCARD;
  cnt: CARDINAL;
  res: BOOLEAN;

BEGIN
  socket := 0; cnt := 1;
  StringToLongRad50(name, job, res);	(* convert name to rad50          *)
  jtp := SCBPTR^.jobtbl;		(* get pointer to job table       *)
  jcb := jtp^;				(* get first jcb ptr from table   *)

  REPEAT
    IF jcb # NIL THEN			(* skip unallocated table entries *)
      IF jcb^.jobnam = job THEN		(* found the one we want          *)
        socket := cnt;
      END;
    END;
    INC(cnt);				(* increment counter              *)
    INC(jtp,4);				(* increment our job table ptr    *)
    jcb := jtp^;			(* assign jcb address ptr         *)
  UNTIL (jcb = VAL(ADDRESS,-1D)) OR (socket # 0);
END FindSocket;


BEGIN  (*main*)
  (* The size of HdrLen is apparently changing in AMOS/L 2.0 and may be   *)
  (* different in AMOS/32. Probably will add a procedure to set this for  *)
  (* each version once it is clear what the lengths should be. This will  *)
  (* work for AMOS/L 1.3 and maybe AMOS/32 1.0 for now.                   *)

  HdrLen := TSIZE(MS) - 8;		(* AMOS/L 1.3 doesn't have spr    *)

  HdrPtr := NIL;
  MsgPtr := NIL;
END ITCUTL.


.