.title change .library /sys$library:lib.mlb/ $climsgdef $dscdef $fabdef $ihadef $ihddef $ihidef $namdef $rabdef $ssdef .psect impure,rd,wrt,noexe,lcl,con,long image_fab: $fab dnm=<.exe>,- fac=,- nam=image_nam image_nam: $nam ess=nam$c_maxrss,- esa=image_es,- rss=nam$c_maxrss,- rsa=image_rs image_rab: $rab fab=image_fab,- bkt=1,- rop=bio,- ubf=image_header,- usz=512 image_header: .blkb 512 image_es: .blkb nam$c_maxrss image_rs: .blkb nam$c_maxrss dynamic_string: .long ^X020E0000,0 .psect pure,rd,nowrt,noexe,lcl,con,long parameter_name: .ascid /input1/ qualifier_name: .ascid /debug/ .psect code,rd,exe,nowrt,lcl,con,long .entry change,^m<> moval dynamic_string,r2 ; Use index registers to hold moval image_fab,r3 ; frequently referenced addresses moval image_rab,r4 moval image_header,r5 bsbw name_image_file ; assign name to image file bsbw read_image_header ; read image header bsbw verify_image_header ; make sure file looks like ; an image header pushal qualifier_name ; Retrieve /DEBUG or /NODEBUG calls #1,g^cli$present ; qualifier from CLI cmpl #cli$_negated,r0 ; see if /NODEBUG present beql 10$ ; if eql, then it was ; ; We have been asked to enable the debugger ; bsbw enable_debug brb 20$ ; ; /NODEBUG was present ; 10$: bsbw disable_debug 20$: $exit_s r0 name_image_file: pushl r2 ; dynamic string for file name pushal parameter_name ; parameter name calls #2,g^cli$get_value ; request parameter from CLI ; (name of file to be modified) blbs r0,10$ ; if lbs, no error pushl r0 ; signal error calls #1,g^lib$signal $exit_s r0 ; and exit with error status 10$: cvtwb dsc$w_length(r2),- ; fill in missing fields of FAB fab$b_fns(r3) ; specifically insert file name movl dsc$a_pointer(r2),- ; address (returned by CLI) and fab$l_fna(r3) ; length of file name into FAB rsb read_image_header: $open fab=(r3) ; try to open this file blbs r0,10$ ; if lbs, open successful pushl fab$l_stv(r3) ; insert error codes into pushl r0 ; lib$signal calling sequence calls #2,g^lib$signal ; and display error $exit_s r0 ; exit with error status 10$: $connect rab=(r4) ; now issue a connect to this file blbs r0,20$ ; if lbs, connect successful pushl rab$l_stv(r4) ; insert error codes into pushl r0 ; lib$signal calling sequence calls #2,g^lib$signal ; and display error $exit_s r0 ; exit with error status 20$: $read rab=(r4) ; read VBN of file. This block ; contains info we want. blbs r0,30$ ; if lbs, read successful pushl rab$l_stv(r4) ; insert error codes into pushl r0 ; lib$signal calling sequence calls #2,g^lib$signal ; and display error. $exit_s r0 ; exit with error status. 30$: rsb verify_image_header: pushr #^m ; save registers modified by ; cmpc3 instruction moval image_nam,r8 ; for easy reference movzbl nam$b_name(r8),r1 ; length of name portion of ; filespec cmpb ihd$b_imgtype(r5),- ; make sure that type says this #ihd$k_exe ; is an executable image bneq 10$ ; if neq, something is wrong movzwl ihd$w_activoff(r5),r6 ; get offset to image activation ; record cmpl r6,#512 ; make sure offset is in 1st ; block bgeq 10$ ; if geq, then something is wrong movzwl ihd$w_imgidoff(r5),r7 ; get offset to image id record cmpl r7,#512 ; make sure that this offset is ; within 1st block also bgeq 10$ ; if geq, something is wrong movab (r5)[r6],r6 ; calculate start of image ; activation record tstl iha$l_tfradr1(r6) ; make sure transfer address is ; non zero and within p0 address ; space bleq 10$ movab (r5)[r7],r7 ; calculate address of image id ; record cmpb #ihi$s_imgnam,(r7) ; make sure that image name is ; within acceptable limits bleq 10$ ; if leq, something wrong cmpb (r7)+,r1 ; make sure image name and name ; portion of file spec are same ; length bneq 10$ ; if neq, something is wrong cmpc3 r1,- ; now compare contents of name @nam$l_name(r8),- ; fields (r7) bneq 10$ ; if neq, something is wrong popr #^m ; restore registers rsb ; and return 10$: movzbl nam$b_rsl(r8),r0 ; build file name descriptor movl nam$l_rsa(r8),r1 pushr #^m ; and push on stack pushl sp ; descriptor address pushl #1 ; 1 fao argument pushl #cli$_imgname pushl #0 ; 0 fao arguments movl #ss$_badimghdr,r0 ; primary exception name pushl r0 calls #5,g^lib$signal ; display error message $exit_s r0 ; and exit with error status enable_debug: moval @#sys$imgsta,r0 ; for easy reference bbss #ihd$v_lnkdebug,- ; do nothing if debugger ihd$l_lnkflags(r5),- ; requested in link 30$ bbcs #ihd$v_lnkdebug,- ; Turn on debugger request ihd$l_lnkflags(r5),- ; in image header 10$ cmpl iha$l_tfradr1(r6),r0 ; Debug start up already present beql 20$ ; if eql, yes - don't insert 10$: movl iha$l_tfradr2(r6),- ; shift transfer addresses one iha$l_tfradr3(r6) ; longword movl iha$l_tfradr1(r6),- iha$l_tfradr2(r6) movl r0,- ; Make sure condition handler iha$l_tfradr1(r6) ; gets established 20$: bsbb write_header 30$: rsb disable_debug: moval @#sys$imgsta,r0 ; for easy reference bbcc #ihd$v_lnkdebug,- ; do nothing if no debugger ihd$l_lnkflags(r5),- ; requested in link 30$ bbsc #ihd$v_lnkdebug,- ; Cancel debugger request ihd$l_lnkflags(r5),- 10$ 10$: cmpl iha$l_tfradr1(r6),r0 ; don't shift address if not beql 20$ ; condition handler movl iha$l_tfradr2(r6),- ; shift transfer addresses one iha$l_tfradr1(r6) ; longword movl iha$l_tfradr3(r6),- iha$l_tfradr2(r6) clrl iha$l_tfradr3(r6) 20$: bsbb write_header 30$: rsb write_header: $write rab=(r4) ; Write modified image header blbs r0,10$ ; if lbs, no error pushl rab$l_stv(r4) ; Build calling sequence to pushl r0 ; lib$signal calls #2,g^lib$signal ; and display error code $exit_s r0 ; Exit with error status 10$: $close fab=(r3) ; Close image file blbs r0,20$ ; If lbs, no error pushl fab$l_stv(r3) ; Pick up error codes and pushl r0 ; build argument list for ; lib$signal calls #2,g^lib$signal ; Signal error condition 20$: rsb .end change