\ 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 ;