;++ ; SCAN4.MAR - DCL Command Scan Facility ; (c) Copyright 1994, Chris Olive & Siemens Medical Systems, Inc. ; All commercial rights reserved ; ; ENVIRONMENT ; ; OpenVMS AXP v1.5-1H1, OpenVMS VAX v5.5-2 ; VMS MACRO ; ; ABSTRACT ; ; Scans for text in the output of a DCL command by executing the ; command in the background in the context of a sub-process whose ; output is directed to a mailbox. The output records are then ; read from the mailbox and scanned for the text for which are ; looking. Matched records are then printed to SYS$OUTPUT. ; ; Limitation: Text is matched *exactly*. No windows in first version. ; ; AUTHOR, INSTALLATION and DATE ; ; Chris Olive ; VMS Systems Consultant ; Aerotek Engineering Consultants ; Rolling Meadows, IL ; 22 JUN 1994 ; ; CODE GENERATION ; ; VAX ----------------------------------------------- ; ; Assemble: $ MACRO/NOLIST SCAN4 ; CLD: $ SET COMMAND/OBJECT SCAN4_CLD ; Link: $ LINK/NOMAP/NOTRACEBACK SCAN4, SCAN4_CLD ; Setup: $ SCAN*4 :== $device:[directory]SCAN4 ; Usage: $ SCAN4 match-text DCL-command ; ; AXP ----------------------------------------------- ; ; "Assemble": $ MACRO/NOLIST/OBJECT=SCAN4.ALPHA_OBJ - ; SCAN4 ; CLD: $ SET COMMAND/OBJECT=SCAN4_CLD.ALPHA_OBJ - ; SCAN4_CLD ; Link: $ LINK /OUTPUT=SCAN4.ALPHA_EXE - ; SCAN4.ALPHA_OBJ, - ; SCAN4_CLD.ALPHA_OBJ ; Setup: $ SCAN*4 :== $device:[directory]SCAN4.ALPHA_EXE ; Usage: $ SCAN4 match-text DCL-command ; ; ; MODIFICATION HISTORY ; ; Date Author Modification(s) ; ----------- ------------- --------------------------------------------- ; 22 JUN 1994 Chris Olive v1.00-000 - Original, working executable. ; v1.00-001 - Added syntax output in lieu of ; errors ;-- .page .title scan4 .ident 'v1.00-001' ;--- Macro inherits section --- $dscdef ;--- Macro definition section --- ; Error handling macro .macro on_err, reg=r0, do=ret, ?lbl blbs reg, lbl do lbl: .endm on_err ; Read mailbox record macro .macro readmbx, desc movzwl desc, r1 ; Save length from descriptor $qiow_s chan=channel, - ; Channel to mailbox func=#IO$_READVBLK, - ; I/O func code & modified iosb=iosb, - ; I/O status block reference p1=@, - ; Buffer address from descriptor p2=r1 ; Buffer length movzwl iosb, r1 ; Move I/O return status to R1 .endm readmbx ;--- Equates section --- MBX_MSG_LEN = 512*4 ; How about a nice, big 4-page buffer? MBX_BUF_QUO = 512*2 ; And half that for our buffer quota... DCL_CMD_LEN = 255 ; Maximum command length ;--- Data section --- .page .sbttl Data section .psect scan4_data, rd, wrt, noexe, long parse_dsc: .long PARSE_LEN ; Parse descriptor .address parse_buf ; dcl_dsc: .long DCL_CMD_LEN ; DCL cmd line descriptor .address dcl_buf ; parse_buf: .ascii 'SCAN4 ' ; Parse buffer PARSE_LEN = . - parse_buf ; Parse buffer length dcl_buf: .blkb DCL_CMD_LEN ; DCL cmd line buffer mailbox_dsc: .ascid 'SCAN4_MBX' ; Scan4 mailbox name null_dsc: .ascid 'NL:' ; Null device desc channel: .word 0 ; Mailbox channel pid: .long 0 ; Return PID of sub-proc iosb: .quad 0 ; I/O status block syntax_dsc: .ascid 'Syntax: SCAN4 ["]match-text["] DCL-command' .external scan4_cld ; External CLD object match_ent: .ascid 'MATCH' ; MATCH entity cmd_ent: .ascid 'COMMAND' ; COMMAND entity match_dsc: .long DCL_CMD_LEN ; Match text descriptor .address .+4 ; .blkb DCL_CMD_LEN ; Match text buffer exhblk: .blkl 1 ; FLINK .address exit_handler ; Address of handler .long 1 ; Argument count .address iosb ; Just use I/O stat ;--- Code section --- .page .sbttl Main Code section .psect scan4_code, rd, nowrt, exe, long .entry scan4, ^m<> ; Get the DCL foreign command line. pushaw dcl_dsc ; Return length pushl #0 ; Reference to prompt descriptor pushaq dcl_dsc ; Return descriptor calls #3, g^lib$get_foreign ; Bang... Get the DCL command line on_err tstw dcl_dsc ; Anything in there? bneq 10$ ; Yep, so move on... brw 99$ ; Nope, so go give a hint ; "Append" the DCL foreign command line and facility name (parse ; buffer) and parse over the CLD. 10$: addw2 dcl_dsc, parse_dsc ; "Appends" the buffers pushal scan4_cld ; Reference internal CLD pushaq parse_dsc ; Reference parse descriptor calls #2, g^cli$dcl_parse ; Bang... Parse the cmd line on_err do= ; Handle any errors ; Get the values of the two entities we need. pushaw match_dsc ; Reference return match length pushaq match_dsc ; Reference return match descriptor pushaq match_ent ; Reference match entity calls #3, g^cli$get_value ; Bang... Get match text on_err pushaw dcl_dsc ; Reference return DCL cmd length pushaq dcl_dsc ; Reference return DCL cmd descriptor pushaq cmd_ent ; Reference command entity calls #3, g^cli$get_value ; Bang... Get DCL command to execute on_err ; Create a temporary mailbox which will serve as standard output for ; a sub-process we'll create later, and as our input "file" for SCAN4. $crembx_s chan=channel, - ; Mailbox channel reference maxmsg=#MBX_MSG_LEN, - ; Mailbox message size bufquo=#MBX_BUF_QUO, - ; Mailbox buffered quota size lognam=mailbox_dsc ; Mailbox logical name reference on_err ; Handle any return errors ; Now we'll create a sub-process to execute in the background the ; DCL command found on the DCL foreign command line. We'll point the ; sub-process' SYS$OUTPUT to the mailbox device which we will read ; from later. pushl #CLI$M_NOWAIT ; Put LIB$SPAWN flag on stack moval (sp), r1 ; Save flag stack address pushal pid ; Return PID address pushl #0 ; Default process-name pushl r1 ; Reference flags on stack pushaq mailbox_dsc ; Std output -> pushaq null_dsc ; Std input -> null device pushaq dcl_dsc ; Command to execute calls #6, g^lib$spawn ; Bang... Execute command in sub-proc popl r1 ; Pop off LIB$SPAWN flag still on stack on_err ; Handle any return errors ; Declare an exit handler to lop off the sub-process if for some ; reason this gets aborted. $dclexh_s desblk=exhblk ; Setup exit handler on_err ; Now we'll just keep reading records out of the mailbox until we get ; an EOF. If there is a match in any record we read, we'll print that ; record to SYS$OUTPUT. 20$: movl #DCL_CMD_LEN, dcl_dsc ; Fix up the return descriptor length readmbx dcl_dsc ; Read a mailbox record on_err ; If we have an error, then end on_err r1 ; Same if we have an error in IOSB movw iosb+2, dcl_dsc ; Set return length matchc match_dsc, @, - ; Scan for a match dcl_dsc, @ ; bneq 20$ ; No match, try again pushaq dcl_dsc ; Reference matched record calls #1, g^lib$put_output ; Bang... Print the record on_err ; Handle any errors brw 20$ ; Go back for more... 99$: pushaq syntax_dsc ; Reference syntax descriptor calls #1, g^lib$put_output ; Bang... Explain syntax to user ret ; Return to caller ; Exit handler for cleaning things up when we're done. .entry exit_handler, ^m<> $dassgn_s chan=channel ; Deassign the mailbox channel $delprc_s pidadr=pid ; Try and delete the sub-process... movl #SS$_NORMAL, r0 ; ...even if it doesn't exist anymore ret ; Return to caller .end scan4