$!+ $! (c) Copyright Richard Maher. All rights reserved. $!- $ on warning then exit $ if .not. f$privilege("cmkrnl,sysprv") then goto no_priv $ if f$getsyi("arch_name") .nes. "Alpha" then goto no_vax $! $ create dir_watch_exec.mar ;++ ; ; (c) Copyright Tier3 Software. All rights reserved. ; ; Ownership of this software and all associated intellectual ; property rights remain vested in Tier3 Software Ltd. This ; software or any other copies thereof may not be provided ; or otherwise made available to any other person. ; ; Do not remove this copyright notice. ; ; Author: Richard Maher ; ;-- .macro define_service,name,narg=0,flags=0,mode=exec,?endmacro 'mode'_routine_count='mode'_routine_count+1 .call_entry home_args=false, - quad_args=true, - label=name .save_psect local_block .psect 'mode'_list .address name .psect 'mode'_flags .long flags .restore_psect .if not_equal narg cmpb (ap),#narg bgeq endmacro movzwl #ss$_insfarg,r0 ret endmacro: .endc .endm .title DIR_WATCH - Wait for file creation .ident "V1.2" .library "sys$library:lib.mlb" $psldef $lckdef $iosbdef $plvdef $lksbdef $fibdef .irpc arg_idx,<123456789> arg'arg_idx'='arg_idx'*4 .endr volume_name_size=12 devlocknam_size=16 dataseq=4 null=0 promote_flags= kernel_routine_count=0 exec_routine_count=0 .psect exec_list,pic,con,rel,lcl,shr,noexe,rd,nowrt,long exec_table: .psect exec_flags,pic,con,rel,lcl,shr,noexe,rd,nowrt,long exec_flags: .psect kernel_list,pic,con,rel,lcl,shr,noexe,rd,nowrt,long kernel_table: .psect kernel_flags,pic,con,rel,lcl,shr,noexe,rd,nowrt,long kernel_flags: .psect t3$wff_rw_data,pic,con,rel,lcl,noshr,noexe,rd,wrt,quad parse_fab: $fab nam=, - fna=in_file_name .align quad parse_nam: $nam nop=, - esa=, - ess= .align quad expanded_file: .blkb nam$c_maxrss .align quad in_file_name: .blkb nam$c_maxrss .align long child_null_args: .long 12, 0, lck$k_nlmode .address user_lksb .long .address child_resnam_desc parent_id: .long 0, 0, 0, 0, 0, 0, 0 child_id: .long 0 .align quad parent_resnam: .ascii "F11B$v" parent_volnam: .blkb volume_name_size parent_resnam_len =.-parent_resnam .align quad child_resnam: .ascii "F11B$s" child_did_num: .blkw 1 .byte 0 child_did_rvn: .blkb 1 child_resnam_len =.-child_resnam .align quad devnam_desc: .long 0 .address parse_nam+nam$t_dvi+1 disk_chan: .word 0 .align quad devlocknam: .blkb 1 volume_name: .blkb volume_name_size .blkb 3 .align quad dev_class: .long 0 dvi_iosb: .blkb iosb$s_iosb .align quad find_fib: .blkb fib$w_exctl .align quad fib_file_len: .long 0 fib_file_addr: .long 0 iosb: .blkb iosb$s_iosb krnl_lksb: .blkb lksb$b_valblk result_file: .blkb nam$c_maxrss .align quad result_file_len: .blkw 1 .align quad door_bell: .long 0 user_iosb_addr: .blkl 1 astadr: .blkl 1 astprm: .blkl 1 user_ast_adr: .blkl 1 .psect t3$wff_ro_data,pic,con,rel,lcl,shr,noexe,rd,nowrt,quad parent_enq_args: .long 12, 0, lck$k_nlmode .address user_lksb .long .address parent_resnam_desc .long 0, 0, 0, 0, 0, 0, 0 .align quad parent_resnam_desc: .long parent_resnam_len .address parent_resnam child_resnam_desc: .long child_resnam_len .address child_resnam null_did: .byte null[nam$s_did] .align quad dvi_list: .word devlocknam_size,dvi$_devlocknam .address devlocknam .long 0 .word 4,dvi$_devclass .address dev_class .long 0, 0 .align quad fib_desc: .long fib$w_exctl .address find_fib result_file_desc: .long nam$c_maxrss .address result_file .psect t3$wff_common,pic,ovr,rel,gbl,noshr,noexe,rd,wrt,quad synch_ef: .blkl 1 last_seq: .long 0 user_lksb: .blkb lksb$s_lksb .psect t3$wff_code,pic,con,rel,lcl,shr,exe,rd,nowrt,quad define_service t3$$waitfr_file_init,7 10$: tstl parent_id bnequ 97$ clrl last_seq $clref_s efn=arg1(ap) blbs r0,20$ ret 20$: movl arg1(ap),door_bell movl arg2(ap),r6 ifnord #dsc$k_z_bln,(r6),99$ cmpw #nam$c_maxrss,dsc$w_length(r6) blssu 98$ ifnord dsc$w_length(r6),@dsc$a_pointer(r6),99$ movc5 dsc$w_length(r6), - @dsc$a_pointer(r6), - #^a" ",#nam$c_maxrss,in_file_name movb dsc$w_length(r6),parse_fab+fab$b_fns movl arg3(ap),r7 ifnord #dsc$k_z_bln,(r7),99$ ifnowrt dsc$w_length(r7),dsc$a_pointer(r7),99$ movl arg4(ap),r8 beql 30$ ifnowrt #iosb$s_iosb,(r8),99$ clrl (r8) clrl 4(r8) 30$: movl r8,user_iosb_addr movl arg5(ap),astadr movl arg6(ap),astprm movl arg7(ap),user_ast_adr brb 100$ 97$: movzwl #ss$_abort,r0 ret 98$: movzwl #ss$_badparam,r0 ret 99$: movzwl #ss$_accvio,r0 ret 100$: $parse fab=parse_fab blbs r0,120$ tstl r8 beql 110$ movl parse_fab+fab$l_stv,iosb$w_status(r8) 110$: ret 120$: movzbl parse_nam+nam$b_esl,r6 movc5 r6,expanded_file, - #^a" ",dsc$w_length(r7), - @dsc$a_pointer(r7) bitl #, - parse_nam+nam$l_fnb bnequ 98$ cmpc #nam$s_did,parse_nam+nam$w_did,null_did bnequ 130$ movzwl #ss$_unsupported,r0 ret 130$: movc3 #fib$s_did,parse_nam+nam$w_did, - find_fib+fib$w_did movl parse_nam+nam$l_name,fib_file_addr subl3 #expanded_file,fib_file_addr,r7 movzbl parse_nam+nam$b_esl,r6 subl3 r7,r6,fib_file_len movzbl parse_nam+nam$t_dvi,devnam_desc $assign_s devnam=devnam_desc, - chan=disk_chan, - acmode=#psl$c_exec blbs r0,140$ ret 140$: $getdviw_s chan=disk_chan, - itmlst=dvi_list, - iosb=dvi_iosb blbc r0,900$ movl dvi_iosb,r0 blbc r0,900$ cmpl dev_class,#dc$_disk beqlu 150$ movzwl #ss$_unsupported,r0 ret 150$: movc3 #volume_name_size,volume_name, - parent_volnam $cmkrnl_s routin=g^sys$enqw, - arglst=parent_enq_args blbc r0,900$ movzwl user_lksb+lksb$w_status,r0 blbc r0,900$ movl user_lksb+lksb$l_lkid,parent_id movw parse_nam+nam$w_did_num,child_did_num movb parse_nam+nam$b_did_nmx,child_did_rvn $cmkrnl_s routin=g^sys$enqw, - arglst=child_null_args blbc r0,900$ movzwl user_lksb+lksb$w_status,r0 blbc r0,900$ movl user_lksb+lksb$l_lkid,child_id pushal synch_ef calls #1,g^lib$get_ef blbc r0,900$ movzwl #ss$_normal,r0 900$: ret ;+ ; Promote the lock with blocking AST. ; ; Drop back to USER mode for $SYNCHing. It would be churlish ; to dawdle around at KERNEL mode. ;- define_service t3$$waitfr_file_promote,,,kernel 10$: tstl child_id bnequ 20$ clrl r0 ret 20$: movl child_id,user_lksb+lksb$l_lkid $enq_s efn=synch_ef, - lkmode=#lck$k_prmode, - lksb=user_lksb, - flags=#promote_flags, - blkast=g^t3$$wff_krnlblk_ast blbc r0,900$ 900$: ret ;+ ; Kernel mode blocking AST ;- .call_entry quad_args=false, - home_args=false, - label=t3$$wff_krnlblk_ast 10$: tstl child_id beql 900$ movl child_id,krnl_lksb+lksb$l_lkid $enqw_s lkmode=#lck$k_nlmode, - lksb=krnl_lksb, - flags=#lck$m_convert blbc r0,900$ movzwl krnl_lksb+lksb$w_status,r0 blbc r0,900$ pushl #psl$c_user pushl #0 pushl user_ast_adr calls #3,g^sys$dclast blbc r0,900$ 900$: ret ;+ ; Check to see if *our* file's been created ;- define_service t3$$waitfr_file_find movl user_lksb+lksb$b_valblk+dataseq,last_seq $qiow_s chan=disk_chan, - func=#io$_access, - iosb=iosb, - p1=fib_desc, - p2=#fib_file_len, - p3=#result_file_len, - p4=#result_file_desc blbc r0,900$ movzwl iosb+iosb$w_status,r0 blbc r0,900$ 900$: ret ;+ ; Reset the Last Data sequence number to force file check ;- define_service t3$$waitfr_file_zap_seq clrl last_seq movzwl #ss$_normal,r0 900$: ret ;+ ; Common reset routine ;- define_service t3$$waitfr_file_cancel,1,,kernel tstl child_id beql 10$ $deq_s lkid=child_id clrl child_id 10$: tstl parent_id beql 20$ $deq_s lkid=parent_id clrl parent_id 20$: tstw disk_chan beql 30$ $dassgn_s chan=disk_chan clrw disk_chan 30$: tstl synch_ef beql 40$ pushal synch_ef calls #1,g^lib$free_ef clrl synch_ef 40$: tstl user_iosb_addr beql 50$ movl user_iosb_addr,r5 movzwl arg1(ap),iosb$w_status(r5) 50$: $setef_s efn=door_bell clrl door_bell tstl astadr beql 900$ pushl #psl$c_user pushl astprm pushl astadr calls #3,g^sys$dclast clrl astadr clrl astprm 900$: movzwl #ss$_normal,r0 ret krnl_rundown: .jsb_entry ; Entry point for Kernel ; rundown handler tstl child_id beql 10$ $deq_s lkid=child_id 10$: tstl parent_id beql 99$ $deq_s lkid=parent_id 99$: rsb exec_rundown: .jsb_entry ; Entry point for Executive ; rundown handler tstw disk_chan beql 10$ $dassgn_s chan=disk_chan 10$: rsb .PAGE .SBTTL Privileged Library Vector ;+ ; Any psect with the VEC attribute will be automatically moved to ; the start of the image. ;- .psect dickie$services,page,vec,pic,nowrt,exe .long plv$c_typ_cmod ; Set type of vector to ; change mode dispatcher .long 0 ; Reserved .long kernel_routine_count ; # of Kernel mode routines .long exec_routine_count ; # of Executive mode routines .address kernel_table ; Kernel routine list .address exec_table ; Exec routine list .address krnl_rundown ; Kernel rundown handler .address exec_rundown ; Exec rundown handler .long 0 ; RMS Dispatcher .address kernel_flags ; Kernel routine flags .address exec_flags ; Exec routine flags .end $! $ macro/list/enable=quad/preserve=(granularity,atomicity) dir_watch_exec.mar $! $ link /share=dir_watch_exec - /sysexe - /map - /cross - /full - /notrace - /section_binding - dir_watch_exec.obj, - sys$input:/options gsmatch=lequal,1,2 symbol_vector = (t3$$waitfr_file_init=procedure, - t3$$waitfr_file_promote=procedure, - t3$$waitfr_file_find=procedure, - t3$$waitfr_file_cancel=procedure, - t3$$waitfr_file_zap_seq=procedure, - t3$wff_common=psect) protect=yes collect=safe, - t3$wff_common, - t3$wff_rw_data $! $copy/log dir_watch_exec.exe sys$common:[syslib] $! $install:==$install/command $if f$file_attributes("sys$share:dir_watch_exec.exe","KNOWN") $then $ install replace sys$share:dir_watch_exec.exe $else $ install add sys$share:dir_watch_exec.exe /open/header/share/protect $! $! If you have your GH_RSRVPGCNT SYSGEN parameter geared up for it, $! you can install dir_watch_exec.exe as /RESIDENT as in: $! $! install add sys$share:dir_watch_exec.exe /open/protect/resident $endif $! $purge sys$share:dir_watch_exec.exe $set file/protection=(w:e) sys$share:dir_watch_exec.exe $! $ create dir_watch_user.mar $psldef $lksbdef dataseq=4 .irpc arg_idx,<123456789> arg'arg_idx'='arg_idx'*4 .endr .title DIR_WATCH_USER - User mode RTL for Wait for file creation .ident "V1.2" .psect t3$wff_common,pic,ovr,rel,gbl,noshr,noexe,rd,wrt,quad synch_ef: .blkl 1 last_seq: .blkl 1 user_lksb: .blkb lksb$s_lksb .psect t3$wff_code,pic,con,rel,lcl,shr,exe,rd,nowrt,quad .call_entry quad_args=false, - home_args=false, - label=sys$waitfr_file cmpb (ap),#6 bgeq 10$ movzwl #ss$_insfarg,r0 ret 10$: pushab g^t3$$wff_userblk_ast pushl arg6(ap) pushl arg5(ap) pushl arg4(ap) pushl arg3(ap) pushl arg2(ap) pushl arg1(ap) calls #7,g^t3$$waitfr_file_init blbc r0,900$ $dclast_s astadr=g^t3$$wff_userblk_ast, - acmode=#psl$c_user blbc r0,900$ movzwl #ss$_normal,r0 900$: ret ;+ ; Cancel Service ;- .call_entry quad_args=false, - home_args=false, - label=sys$waitfr_file_cancel 10$: pushl #ss$_cancel calls #1,t3$$waitfr_file_cancel blbc r0,900$ movzwl #ss$_normal,r0 900$: ret ;+ ; User mode blocking AST ;- .call_entry quad_args=false, - home_args=false, - label=t3$$wff_userblk_ast calls #0,g^t3$$waitfr_file_promote tstl r0 bnequ 10$ ret 10$: blbc r0,900$ $synch_s efn=synch_ef, - iosb=user_lksb blbc r0,900$ movzwl user_lksb+lksb$w_status,r0 cmpl r0,#ss$_abort bneq 20$ ret 20$: cmpl r0,#ss$_valnotvalid bneq 50$ calls #0,g^t3$$waitfr_file_zap_seq 50$: blbc r0,900$ cmpl user_lksb+lksb$b_valblk+dataseq,last_seq bneq 100$ ret 100$: calls #0,g^t3$$waitfr_file_find cmpl r0,#ss$_nosuchfile bnequ 900$ ret 900$: pushl r0 calls #1,g^t3$$waitfr_file_cancel ret .end $! $ macro/list/enable=quad/preserve=(granularity,atomicity) dir_watch_user.mar $! $ link /share=dir_watch_user - /map - /cross - /full - /notrace - /section_binding - dir_watch_user.obj, - sys$input:/options gsmatch=lequal,1,2 symbol_vector = (sys$waitfr_file=procedure, - sys$waitfr_file_cancel=procedure) sys$library:dir_watch_exec.exe/share $! $copy/log dir_watch_user.exe sys$common:[syslib] $set file/protection=(w:re) sys$share:dir_watch_user.exe $! $install:==$install/command $if f$file_attributes("sys$share:dir_watch_user.exe","KNOWN") $then $ install replace sys$share:dir_watch_user.exe $else $ install add sys$share:dir_watch_user.exe /open/header/share $endif $! $purge sys$share:dir_watch_user.exe $! $create test_dir.cob identification division. program-id. test_dir with ident "V1.2". author. Richard Maher. * data division. working-storage section. 01 timer_ast pic 9(9) comp value external timer_ast. 01 comp_ast pic 9(9) comp value external comp_ast. 01 ss$_cancel pic 9(9) comp value external ss$_cancel. 01 ss$_normal pic 9(9) comp value external ss$_normal. 01 sys_status pic 9(9) comp. * 01 user_exit pic x(1) value "N". 01 in_file pic x(60). 01 out_file pic x(255). 01 out_len pic 9(4) comp. 01 iosb. 03 iosb_status pic 9(9) comp. 03 pic x(4). 01 some_stuff pic x(16) value "Just to show how". 01 two_mins pic s9(11)v9(7) comp value -120. 01 wff_flag pic 9(9) comp. * procedure division. kick_off section. 00. call "lib$get_ef" using wff_flag giving sys_status. if sys_status not = ss$_normal call "lib$stop" using by value sys_status. display "Enter filename: " erase screen no advancing. accept in_file protected reversed bold at end move "Y" to user_exit. perform loop_around until user_exit = "Y". stop run. * loop_around section. 00. call "sys$waitfr_file" using by value wff_flag by descriptor in_file, out_file by reference iosb by value comp_ast by reference some_stuff giving sys_status. if sys_status not = ss$_normal call "lib$stop" using by value sys_status. call "str$trim" using by descriptor out_file, out_file by reference out_len giving sys_status. if sys_status not = ss$_normal call "lib$stop" using by value sys_status. display "Expanded File = ", out_file(1:out_len). call "sys$setimr" using by value 0 by reference two_mins by value timer_ast by reference out_file by value 0 giving sys_status. if sys_status not = ss$_normal call "lib$stop" using by value sys_status. display "Waiting for file to arrive". call "sys$synch" using by value wff_flag by reference iosb giving sys_status. if sys_status = ss$_normal move iosb_status to sys_status. evaluate sys_status when ss$_cancel display "Got fed-up waiting!" when ss$_normal display "Your file has arrived" call "sys$cantim" using out_file omitted when other call "lib$stop" using by value sys_status end-evaluate. * fini. display "Enter filename: " no advancing. accept in_file protected reversed bold at end move "Y" to user_exit. * end program test_dir. identification division. program-id. comp_ast with ident "V1.2". * data division. linkage section. 01 some_stuff pic x(16). * procedure division using some_stuff. kick_off section. 00. display "Here's my parameter - ", some_stuff. exit program. * end program comp_ast. identification division. program-id. timer_ast with ident "V1.2". * data division. working-storage section. 01 ss$_normal pic 9(9) comp value external ss$_normal. 01 sys_status pic 9(9) comp. * procedure division. kick_off section. 00. call "sys$waitfr_file_cancel" giving sys_status. if sys_status not = ss$_normal call "lib$stop" using by value sys_status. exit program. * end program timer_ast. $! $cobol/lis test_dir.cob $link/exe=test_dir.exe test_dir.obj,sys$input/opt sys$library:dir_watch_user.exe/share $! $exit $! $no_priv: $ write sys$output "Insufficient privilege. You need (CMKRNL,SYSPRV)" $ exit 44 $no_vax: $ write sys$output "This code only works on alpha" $ exit 44 $!