{                In the name of Allah                 }
{  Example program to test Pascal_Rexx_Support.unit   }
{                                                     }
{Programmed by:                                       }
{     HOSSEIN SHIRDASHTZADEH                          }
{     All rights reserved (c) 1376-77 (1997-98)       }
{                                                     }
{Copyright notice:                                    }
{     You are NOT free to include this code in  your  }
{     software. Please read the PascalRexx.readme in  }
{     this archive for more information.              }
{                                                     }
{Email:                                               }
{       Shirdash@www.dci.co.ir                        }
{Snail:                                               }
{       No. 132                                       }
{       Kerdabad,Jey st.,                             }
{       Isfahan,                                      }
{       Iran                                          }
{       Zip code: 81599                               }
(*****************************************************)
{Compile notice:

        Please compile this unit by
                Kick-Pascal or Maxon-Pascal
        Also note that you must have the file:
             "rexxsyslib.lib"
        in your include files. ("Kp:include/")
        and also in "kp:include/rexx/" MUST have the following files:
                 "rxslib.h"
                 "rexxio.h"
                 "errors.h"
                 "storage.h"
        You may get these files from Maxon-Pascal package.
}
(*****************************************************)
(*****************************************************)
UNIT Pascal_Rexx_Support;

Interface
uses exec;

Type
      p_RexxMsg=^RexxMsg;

TYPE RexxMsg = RECORD
 rm_Node      : Message;
 rm_TaskBlock : Ptr;
 rm_LibBase   : Ptr;
 rm_Action    : LongInt;
 rm_Result1   : LongInt;
 rm_Result2   : LongInt;
 rm_Args      : ARRAY[0..15] OF Str;
 rm_PassPort  : p_MsgPort;
 rm_CommAddr  : Str;
 rm_FileExt   : Str;
 rm_Stdin     : LongInt;
 rm_Stdout    : LongInt;
 rm_avail     : LongInt;
END;

{const Hss_Rexxmsg_defined=1;} {You need not to use this constant!}
(*****************)
Function   rx_OpenPort(portname:str):p_msgport;
PROCEDURE  rx_ClosePort(port:P_msgport);
PROCEDURE  outtext(msg:p_RexxMsg;tx:string);
Function   Wait_REXX_PORT(Port:p_MsgPort):p_RexxMsg;
Procedure  Reply_REXX_PORT(msg:p_RexxMsg);
PROCEDURE  Reply_All(port:p_msgport);
Procedure  CloseRexxLib;
(*****************)
Implementation
{$incl "rexxsyslib.lib"}
(*********************************)
var
 Rexx_sig : LONG;
(*********************************)
Procedure ExHere(a:long);
var st:string;
begin
        st:="Pascal AREXX Error code="+intstr(a);
        error(st);
end;
(*********************************)
Function rx_OpenPort{(portname:str):p_msgport;};
var
  port:p_msgport;
  exc:long;

begin
  exc:=$00000000;{No Errors}
  NEW(port);
  Forbid;
  IF FindPort(portname)<>nil then
    exc:=$00000001
  ELSE
  begin
    port^.mp_sigtask:=FindTask(nil);
    port^.mp_flags:=PA_SIGNAL;
    port^.mp_node.ln_name:=portname;
    port^.mp_node.ln_type:=NT_MSGPORT;
    Rexx_sig:=AllocSignal(-1);
    IF Rexx_sig=0 then
      exc:=$00000002
    ELSE
    begin
      port^.mp_sigbit:=Rexx_sig;
      AddPort(port)
    END
  END;
 Permit;
 IF exc<>0 THEN ExHere(exc);
 rx_openport:=port;
 Rexx_sig:=LONG(1) Shl LONG(Rexx_sig);
END;
(*********************************)
PROCEDURE rx_ClosePort{(port:P_msgport)};
begin
  IF port<>nil then
  begin
    FreeSignal(port^.mp_sigbit);
    RemPort(port);
    Dispose(port)
  END
END;
(*********************************)
PROCEDURE outtext{(msg:p_RexxMsg;tx:string)};
begin
msg^.rm_Result2:=Long(CreateArgString(tx,length(tx)));
end;
(*********************************)
Function Wait_REXX_PORT{(Port:p_MsgPort):p_RexxMsg};
var
  m : LONG;
  msg  : p_RexxMsg;
BEGIN
    m := _Wait(Rexx_sig);
    IF (m AND Rexx_sig)=Rexx_sig THEN
    BEGIN
      msg := p_RexxMsg(GetMsg(port));
      msg^.rm_Result1 := 0;
      msg^.rm_Result2 := 0;
      Wait_REXX_PORT:=msg;
    END;
End;
(*********************************)
Function Reply_REXX_PORT{(msg:p_RexxMsg)};
BEGIN
      ReplyMsg(p_Message(msg));
End;
(*********************************)
PROCEDURE Reply_All{(port:p_msgport)};
var
  msg  : p_RexxMsg;
begin
  Forbid;
  msg := p_RexxMsg(GetMsg(port));
  WHILE msg <> NIL DO
  BEGIN
    ReplyMsg(p_Message(msg));
    msg := p_RexxMsg(GetMsg(port));
  END;
  Permit;
end;
(********************************)
Procedure CloseRexxLib;
begin
       if  RexxSysBase<>nil then closelib(RexxSysBase);
end;
(************----------- MAIN ------------*****************)
BEGIN
  RexxSysBase:=nil;
  OpenLib(RexxSysBase, "rexxsyslib.library",0);
  if  RexxSysBase=nil then error("Rexx library not open!");
  addexitserver(closeRexxLib);
END.