(* ----------------------------------------------------------------------
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;
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. *)
