\ RexxView by Martin Kees
\ JForth REXX peeker
\ CLI utility to monitor REXX message traffic
\ Usage: rexxview outfile
\ Terminate by sending: closerexxview to REXX port
\ 3/JUN/91
\ Freely Distributable


getmodule includes
include? addport()   ju:exec_support

anew task_rexxview

0" REXX"   0string RXSDIR   

:STRUCT RexxMsg
     STRUCT Message rm_Node             (  EXEC message structure        )
     APTR rm_TaskBlock              (  pointer to global structure   )
     APTR rm_LibBase                (  library base                  )
     LONG rm_Action                 (  command [action] code         )
     LONG rm_Result1                (  primary result [return code]  )
     LONG rm_Result2                (  secondary result              )
   ( %?)   16 4 *  BYTES rm_Args    (  argument block [ARG0-ARG15]   )

     APTR rm_PassPort        (  forwarding port               )
     APTR rm_CommAddr               (  host address [port name]      )
     APTR rm_FileExt                (  file extension                )
     LONG rm_Stdin                  (  input stream [filehandle]     )
     LONG rm_Stdout                 (  output stream [filehandle]    )
     LONG rm_avail                  (  future expansion              )
   ;STRUCT 
                                  (  size: 128 bytes               )

15   constant MAXRMARG (  maximum arguments             )

(  Command [action] codes for message packets                           )
$ 01000000   constant RXCOMM (  a command-level invocation    )
$ 02000000   constant RXFUNC (  a function call               )
$ 03000000   constant RXCLOSE (  close the port                )
$ 04000000   constant RXQUERY (  query for information         )
$ 07000000   constant RXADDFH (  add a function host           )
$ 08000000   constant RXADDLIB (  add a function library        )
$ 09000000   constant RXREMLIB (  remove a function library     )
$ 0A000000   constant RXADDCON (  add/update a ClipList string  )
$ 0B000000   constant RXREMCON (  remove a ClipList string      )
$ 0C000000   constant RXTCOPN (  open the trace console        )
$ 0D000000   constant RXTCCLS (  close the trace console       )

(  Command modifier flag bits            )
16   constant RXFB_NOIO (  suppress I/O inheritance?     )
17   constant RXFB_RESULT (  result string expected?       )
18   constant RXFB_STRING (  program is a "string file"?   )
19   constant RXFB_TOKEN (  tokenize the command line?    )
20   constant RXFB_NONRET (  a "no-return" message?        )

(  Modifier flags                )
1   RXFB_RESULT <<  constant RXFF_RESULT
1   RXFB_STRING <<  constant RXFF_STRING
1   RXFB_TOKEN <<  constant RXFF_TOKEN
1   RXFB_NONRET <<  constant RXFF_NONRET
1   RXFB_NOIO   <<  constant RXFF_NOIO

$ FF000000   constant RXCODEMASK
$ 0000000F   constant RXARGMASK

0 value rxpri
0 value myport
0 value rxport
0 value rmsg
0 value ofile


: FORBID() ( -- )
    callvoid exec_lib forbid
;

: PERMIT() ( -- )
    callvoid exec_lib permit 
;


: dscanlist ( port -- rexxport true | 0 )
  begin
    s@ ln_succ dup
    IF dup s@ ln_name ?dup
      IF
       RXSDIR 4 compare
       IF-NOT true exit
       THEN
      THEN 
    THEN
    dup
  until-not  
;

\ Not needed after I found that the message port list
\ is priority sorted but ...
: uscanlist ( port -- rexxport true | 0 )
  begin
    s@ ln_pred dup
    IF dup s@ ln_name ?dup
      IF
       RXSDIR 4 compare
       IF-NOT true exit
       THEN
      THEN
    THEN
    dup
  until-not
;

: Openmyport ( -- flag )
  0 -> myport
  forbid()
  RXSDIR findport() dup -> rxport
  IF  rxport ..@ ln_pri -> rxpri
      RXSDIR rxpri 1+ Createport() -> myport
  THEN
  permit()
  myport
;

: Closemyport ( -- )
  myport   ?dup IF deleteport()
                   0 -> myport
                THEN
;

: msg>taskname ( msg -- 0$task )
  s@ mn_replyport
  s@ mp_SigTask
  s@ ln_name
;

: msg>arg0 ( msg -- 0str )
  .. rm_args @ >rel 
;

: fcr
  10 pad c! ofile pad 1 fwrite drop
;


: >ofile ( srt -- )
  ofile swap count fwrite drop
;

: ?0type ( 0str str -- )
  ofile swap count fwrite drop
  0count
  ?dup IF ofile -rot fwrite drop
       ELSE drop ofile " Null" fwrite drop
       THEN
  fcr
;

: term.rv ( msg -- )
   replymsg()
   begin myport getmsg() ?dup
   while replymsg()
   repeat
   closemyport
   ofile fclose
;

: SendToRexx ( msg -- flag )
  forbid()
  myport dscanlist
  ?dup IF-NOT  myport uscanlist
       THEN
  IF swap putmsg()   true
  ELSE   false
  THEN
  permit()
  IF-NOT
     " REXX port closed!" >ofile
     term.rv
  THEN
;

: aboutmsg
  ofile " RexxView by Martin Kees " count fwrite drop fcr
  ofile " (c) 1991 M C Kees"        count fwrite drop fcr
  ofile " Freely Distributable"     count fwrite drop fcr
;


: .action ( msg -- )
  " Action: " swap
  ..@ rm_action  RXCODEMASK AND
CASE
RXCOMM   OF   0" RXCOMM"
         ENDOF
RXFUNC   OF   0" RXFUNC"
         ENDOF
RXCLOSE  OF   0" RXCLOSE"
         ENDOF
RXQUERY  OF   0" RXQUERY"
         ENDOF
RXADDFH  OF   0" RXADDFH"
         ENDOF
RXADDLIB OF   0" RXADDLIB"
         ENDOF
RXREMLIB OF   0" RXREMLIB"
         ENDOF
RXADDCON OF   0" RXADDCON"
         ENDOF
RXREMCON OF   0" RXREMCON"
         ENDOF
RXTCOPN  OF   0" RXTCOPN"
         ENDOF
RXTCCLS  OF   0" RXTCCLS"
         ENDOF
         0" UNKNOWN" swap
ENDCASE
    swap ?0type
;

: .modifier ( msg -- )
  " Modifier: " >ofile
  ..@ rm_action
  dup RXFF_RESULT  and IF " RXFB_RESULT " >ofile
                       THEN
  dup RXFF_STRING  and IF " RXFB_STRING " >ofile
                       THEN
  dup RXFF_TOKEN   and IF " RXFB_TOKEN  " >ofile
                       THEN
  dup RXFF_NONRET  and IF " RXFB_NONRET " >ofile
                       THEN
  dup RXFF_NOIO    and IF " RXFB_NOIO   " >ofile
                       THEN
  drop fcr
;



: rexxview ( -- )
  new fileword
  dup 1+ c@ ascii ? = over c@ 0= OR
  IF drop cr
     ." Usage: rexxview  OutputFileName" cr
     ." Terminate by sending to REXX: closerexxview"  cr
     exit
  THEN
  $fopen -> ofile
  ofile
 IF
  openmyport
  IF aboutmsg
    BEGIN
     myport waitport() drop
     myport getmsg() -> rmsg
     rmsg msg>taskname " From Task: " ?0type
     rmsg .action
     rmsg .modifier
     rmsg msg>arg0
      dup " Arg0: " ?0type fcr
       0" closerexxview" 0count compare
       IF-NOT rmsg term.rv
              exit
       THEN
     rmsg sendtorexx
    AGAIN
  ELSE ofile fclose
       rxport IF-NOT ." REXX not found " cr exit
              THEN
  THEN
  myport IF-NOT ." No memory for RexxView port!" cr exit
         THEN
 ELSE
  ." Couldn't open output file" cr
 THEN
;
