Usenet 1994 January

home *** CD-ROM | disk | FTP | other *** search

/ Usenet 1994 January / usenetsourcesnewsgroupsinfomagicjanuary1994.iso / sources / misc / volume1 / 8710 / vms-vi / 2 < prev next >

Wrap

Internet Message Format | 1990-07-13 | 17.3 KB

Path: uunet!husc6!necntc!ncoast!allbery From: gregg@a.cs.okstate.edu@mandrill.CWRU.Edu (Gregg Wonderly) Newsgroups: comp.sources.misc Subject: VI in TPU part 2/13 Message-ID: <4851@ncoast.UUCP> Date: 13 Oct 87 02:49:13 GMT Sender: allbery@ncoast.UUCP Organization: Oklahoma State Univ., Stillwater Lines: 885 Approved: allbery@ncoast.UUCP X-Archive: comp.sources.misc/8710/vms-vi/2 $ show default $ if f$search("SRC.DIR;1") .eqs. "" then - CREATE/LOG/DIRECTORY [.SRC] $ write sys$output "Creating [.SRC]TPUSUBS.MAR" $ create [.SRC]TPUSUBS.MAR $ DECK/DOLLARS="*$*$*EOD*$*$*" .TITLE TPUSUBS ; ; This file contains TPU CALL_USER support routines for VI. ; ; Written by Gregg Wonderly, June, 1987 ; $ssdef $rmsdef $lnmdef $iodef $qiodef $trmdef $ttdef $dcdef TPU_CWD=1 TPU_TRNLNM_JOB=2 TPU_TRNLNM_PROC=3 TPU_TRNLNM_SYS=4 TPU_TRNLNM_GROUP=5 TPU_GETMSG=6 TPU_SET_SYSDISK=7 TPU_SLEEP=8 TPU_PASTHRU_ON=9 TPU_PASTHRU_OFF=10 .psect data,rd,wrt,noexe .macro trnlnm_item,code,len,bufaddr,retlenaddr .word len .word code .address - bufaddr .address - retlenaddr .endm .macro put_item,buf,code,len,bufaddr,retlenaddr movw len,buf movw code,buf+2 moval bufaddr,buf+4 moval retlenaddr,buf+8 .endm sysc_descr: .ASCID /SYS$COMMAND/ iochan: .word 0 newchar_buf: .blkl 3 newchar_buf_len = .-newchar_buf ; tempchar_buf: .blkb newchar_buf_len ; par_settings: .long 0 tt_descr: .ASCID /TT:/ job_descr: .ASCID /LNM$JOB/ sys_descr: .ASCID /LNM$SYSTEM/ proc_descr: .ASCID /LNM$PROCESS/ group_descr: .ASCID /LNM$GROUP/ sysdisk_descr: .ASCID /SYS$DISK/ itemlist: trnlnm_item 0,0,0,0 itemlist_2: trnlnm_item 0,0,0,0 msgnum: .long 0 stat: .long 0 i_parm_descr: .blkb 8 i_res_descr: .blkb 8 i_parm: .blkb 512 i_res: .blkb 512 timebuf: .long 0 .long 0 dummy: .long 0 tenths=-1000000 .psect code,exe,rd,nowrt,pic ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; .entry sleep,^m<r2,r3,r4,r5,r6> movl 4(ap),r0 mull3 r0,#tenths,r1 movl r1,timebuf movl #-1,timebuf+4 $schdwk_s - daytim=timebuf blbc r0,10$ $hiber_s blbs r0,20$ 10$: pushl r0 calls #1,g^lib$signal 20$: ret ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; .entry atoi,^m<r2,r3,r4,r5> movl 4(ap),r0 ;Get the descriptor address clrl r1 ;Clear the accumulator movl 4(r0),r2 ;Get the string address cvtwl (r0),r0 ;Get the length 10$: mull2 #10,r1 ;multiply by 10 cvtbl (r2)+,r3 addl3 r3,#-48,r4 ;Add in digit addl r4,r1 sobgtr r0,10$ movl r1,r0 ret ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; .entry tpu$calluser,^m<r2,r3,r4,r5> movl #512,i_res_descr movab i_res,i_res_descr+4 movl #512,i_parm_descr movab i_parm,i_parm_descr+4 pushl 8(ap) pushab i_parm_descr calls #2,g^str$copy_dx pushab dummy pushab i_parm_descr pushl 8(ap) calls #3,g^str$analyze_sdesc put_item - itemlist,#lnm$_string,#512,i_res,i_res_descr put_item - itemlist_2,#0,#0,#0,#0 movl 4(ap),r1 casew (r1),#TPU_CWD,#TPU_PASTHRU_OFF case_1: .word do_cwd - case_1 .word do_trnlnm_job - case_1 .word do_trnlnm_proc - case_1 .word do_trnlnm_sys - case_1 .word do_trnlnm_group - case_1 .word do_getmsg - case_1 .word do_set_sysdisk - case_1 .word do_sleep - case_1 .word do_pasthru_on - case_1 .word do_pasthru_off - case_1 ; .word case_2 - case_1 case_2: movl #SS$_BADPARAM,r0 ret ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; do_cwd: movw i_parm_descr,r1 ;Get the length of parameter tstl r1 ;If zero, then get current dir bneq 10$ pushal i_res_descr ;Push args pushal i_res_descr pushl #0 calls #3,g^sys$setddir brw out 10$: ;Otherwise set the current dir pushal i_res_descr pushal i_res_descr pushal i_parm_descr calls #3,g^sys$setddir brw out ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; do_trnlnm_job: $trnlnm_s - attr=#LNM$M_CASE_BLIND,- tabnam=job_descr,- lognam=i_parm_descr,- itmlst=itemlist brw out ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; do_trnlnm_proc: $trnlnm_s - attr=#LNM$M_CASE_BLIND,- tabnam=proc_descr,- lognam=i_parm_descr,- itmlst=itemlist brw out ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; do_trnlnm_sys: $trnlnm_s - attr=#LNM$M_CASE_BLIND,- tabnam=sys_descr,- lognam=i_parm_descr,- itmlst=itemlist brw out ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; do_trnlnm_group: $trnlnm_s - attr=#LNM$M_CASE_BLIND,- tabnam=group_descr,- lognam=i_parm_descr,- itmlst=itemlist brw out ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; do_getmsg: pushal i_parm_descr ;Convert the string to a number calls #1,atoi movl r0,msgnum ;Store the result movl #512,i_res_descr $getmsg_s - msgid=msgnum,- msglen=i_res_descr,- bufadr=i_res_descr brw out ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; do_set_sysdisk: pushal i_parm_descr pushal sysdisk_descr calls #2,g^lib$set_logical clrl i_res_descr brw out ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; do_sleep: pushal i_parm_descr ;Convert the string to a number calls #1,atoi pushl r0 calls #1,sleep clrl i_res_descr brw out ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; do_pasthru_on: $assign_s - devnam=tt_descr,- chan=iochan blbs r0,10$ 5$: pushl r0 pushl r0 calls #1,g^lib$signal movl (sp)+,r0 brw out 10$: movab dassign,(fp) $qiow_s - chan=iochan,- func=#IO$_SENSEMODE,- p1=newchar_buf,- p2=#newchar_buf_len blbs r0,20$ 15$: movl r0,r2 $dassgn_s - chan=iochan clrw iochan movl r2,r0 brw 5$ ; 20$: bisl2 #TT2$M_PASTHRU,newchar_buf+8 $qiow_s - chan=iochan,- func=#IO$_SETMODE,- p1=newchar_buf,- p2=#newchar_buf_len blbc r0,15$ $dassgn_s - chan=iochan clrw iochan clrl (fp) clrl i_res_descr brw out ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; .entry dassign,^m<> tstw iochan beql 10$ $dassgn_s - chan=iochan clrw iochan 10$: clrl i_res_descr ret ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; do_pasthru_off: $assign_s - devnam=tt_descr,- chan=iochan blbs r0,10$ 5$: pushl r0 pushl r0 calls #1,g^lib$signal movl -(sp),r0 brw out 10$: movab dassign,(fp) $qiow_s - chan=iochan,- func=#IO$_SENSEMODE,- p1=newchar_buf,- p2=#newchar_buf_len blbs r0,20$ 15$: movl r0,r2 $dassgn_s - chan=iochan clrw iochan movl r2,r0 brw 5$ ; 20$: bicl2 #TT2$M_PASTHRU,newchar_buf+8 $qiow_s - chan=iochan,- func=#IO$_SETMODE,- p1=newchar_buf,- p2=#newchar_buf_len blbc r0,15$ $dassgn_s - chan=iochan clrw iochan clrl (fp) clrl i_res_descr brw out ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; out: blbc r0,err pushal i_res_descr pushl 12(ap) calls #2,g^str$copy_dx movl 12(ap),r1 movw i_res_descr,(r1) movl #SS$_NORMAL,r0 err: ret .end *$*$*EOD*$*$* $ if f$search("SRC.DIR;1") .eqs. "" then - CREATE/LOG/DIRECTORY [.SRC] $ write sys$output "Creating [.SRC]VI.MAR" $ create [.SRC]VI.MAR $ DECK/DOLLARS="*$*$*EOD*$*$*" ; ; This file contains the source to a program that exercises callable ; TPU. You will be interested in using this program ONLY if you ; make use of more than ONE TPU utility that requires a CALL_USER ; routine, and/or you like to define TPUSECINI as opposed to using ; the /SECTION quailfier of EDIT/TPU. ; ; This program expects to be able to use the VI$CALLUSER logical ; to find the call_user routines for VI. It also uses VISECINI ; for the name of the TPU section file. Just to be complete, it will ; also use TPU$CALLUSER and TPUSECINI if the VI logicals do not exist. ; ; Written by Gregg Wonderly, 10-jul-1987 ; $ssdef $lnmdef $psldef $fabdef $rabdef $namdef .macro item,code,blen,badr,radr .word blen .word code .address - badr .address - radr .endm ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; ; Program data section ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; .psect rwdata,rd,wrt,noexe fabdef: $fab fablen=.-fabdef rabdef: $rab rablen=.-rabdef namdef: $nam namlen=.-namdef blkdescr: .address 0 exit_h: .long 0 .address exit_handler .long 0 .address exit_stat ; exit_stat: .long 0 ; clean_flags: .long TPU$M_DELETE_JOURNAL!- TPU$M_DELETE_EXITH!- TPU$M_RESET_TERMINAL!- TPU$M_KILL_PROCESSES!- TPU$M_LAST_TIME bvpval: .long 0 ; bvp: .address - tpu_init .long 0 ; calluserd: .long 0 .long 0 ; fileiod: .address - TPU$FILEIO .long 0 ; crelnm_items: item LNM$_STRING,0,trnlnm_string,dummy .long 0 dummy: .long 0 trnlnm_items: item LNM$_STRING,512,trnlnm_string,string_len .long 0 .long 0 trnlnm_string: .blkb 512 sectdescr: string_len: .long .address - trnlnm_string vicalldescr: .ascid /VI$CALLUSER/ tpucalldescr: .ascid /TPU$CALLUSER/ visectdescr: .ascid /VISECINI/ tpusectdescr: .ascid /TPUSECINI/ procdescr: .ascid /LNM$PROCESS_TABLE/ badvicall: .ascid /%VI-F-BADTPUCALL, improper definition of VI$CALLUSER/ badtpucall: .ascid /%VI-F-BADTPUCALL, improper definition of TPU$CALLUSER/ nocalluser: .ascid /%VI-F-NOCALLUSER, no calluser routine could be loaded/ .psect code,rd,exe,nowrt .entry noerr,^m<> ret ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; ; The program itself, straight forward no? ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; .entry viedit,^m<r2,r3,r4,r5,r6> movab noerr,(fp) ;Forget about errors we will ;handle them pushal calluserd ;Push return address location pushab tpucalldescr ;Routine name pushab vicalldescr ;Image to search through calls #3,g^lib$find_image_symbol ;Find the symbol blbs r0,10$ ;Branch on success ; cmpl r0,#RMS$_FNF ;If FNF then try TPU$CALLUSER beql 5$ pushl r0 ;Save the exit value pushab badvicall ;Pass the right message brw 8$ ;Join the other code 5$: ; ; There is no VI$CALLUSER image, so try TPU$CALLUSER. ; pushal calluserd ;Push return address location pushab tpucalldescr ;Routine name pushab tpucalldescr ;Image to search through calls #3,g^lib$find_image_symbol ;Find the symbol blbs r0,10$ ;Branch if we got that pushl r0 ;Save the status cmpl r0,#RMS$_FNF ;If FNF then say the right thin g beql 7$ ;Go set up the right parameter pushab badtpucall ;Push the message descr brb 8$ ;Join other code ; 7$: pushab nocalluser ;Push the message descr ; 8$: calls #1,g^lib$put_output ;Output the message calls #1,g^lib$stop ;Stop with the status pushed ; ; Got the calluser routine, continue processing ; 10$: clrl (fp) ;Remove condition handler $trnlnm_s - tabnam=procdescr,- lognam=visectdescr,- itmlst=trnlnm_items ;Get the VISECINI defintion blbc r0,20$ ;If that fails then don't worry ;If /SECTION is not there, then ;TPU will bark for us. pushaq sectdescr ;On success, redefine TPUSECINI pushaq tpusectdescr ;to be VISECINI's value calls #2,g^lib$set_logical blbs r0,20$ pushl r0 calls #1,g^lib$signal ;Signal the condition 20$: movab g^tpu$handler,(fp) ;Establish tpu$handler pushab calluserd ;Pass the BVP's to parseinfo pushab fileiod ;Use TPU$FILEIO calls #2,g^tpu$parseinfo ;Get the command line stuff movl r0,bvpval ;This is the value for the ;call back routine to return ;to tpu$initialize, so save it. pushab bvp ;Pass the BVP for the callback calls #1,g^tpu$initialize ;Initialize TPU blbc r0,err ;Branch on error $dclexh_s - desblk=exit_h ;Establish an exit handler blbc r0,err calls #0,g^tpu$execute_inifile ;Execute the initialization blbc r0,err cmpl r0,#TPU$_SUCCESS bneq done ;Skip control if not SUCCESS calls #0,g^tpu$control ;Call control to do editing. blbc r0,err done: brb out err: pushl r0 ;Signal any error calls #1,g^lib$signal out: ret ;Back to caller ; ; Merely return the value that tpu$parseinfo returned to us ; .entry tpu_init,^m<> movl bvpval,r0 ret ; ; This exit handler is called at image exit to cleanup the things that ; are of no more interest to us. Sadly enough, there is not a perfect ; policy for the journal file that satisfies everyone. I have always ; written out my changes from time to time, so I really don't ever use ; the journal. The current itemlist to tpu$cleanup causes the journal ; to be deleted. WARNING, don't $FORCEX a VI that you wish to have the ; journal from. ; .entry exit_handler,^m<> pushal clean_flags calls #1,g^tpu$cleanup movl exit_stat,r0 ret ; ; ; ; .entry vi$fileio,^m<r2,r3,r4,r5,r6,r7,r8,r9> movl @4(ap),r1 ;Get the code cmpl r1,#TPU$K_OPEN bneq 10$ jmp tpu_open ; 10$: cmpl r1,#TPU$K_CLOSE bneq 20$ jmp tpu_close ; 20$: cmpl r1,#TPU$K_CLOSE_DELETE bneq 30$ jmp tpu_close_delete ; 30$: cmpl r1,#TPU$K_GET bneq 40$ jmp tpu_get ; 40$: cmpl r1,#TPU$K_PUT beql tpu_put movl #SS$_BADPARAM,r0 ret ; ; $PUT routine for VI to use ; tpu_put: ; ; $GET routine for VI to use ; tpu_get: ; ; $CLOSE with delete for VI to use ; tpu_close_delete: ; ; $CLOSE for VI to use ; tpu_close: ; ; $OPEN for VI to use ; tpu_open: ret .end viedit *$*$*EOD*$*$* $ if f$search("SRC.DIR;1") .eqs. "" then - CREATE/LOG/DIRECTORY [.SRC] $ write sys$output "Creating [.SRC]TPUSUBS.OPT" $ create [.SRC]TPUSUBS.OPT $ DECK/DOLLARS="*$*$*EOD*$*$*" TPUSUBS.OBJ UNIVERSAL=TPU$CALLUSER *$*$*EOD*$*$* $ if f$search("SRC.DIR;1") .eqs. "" then - CREATE/LOG/DIRECTORY [.SRC] $ write sys$output "Creating [.SRC]STEPWISE.TPU" $ create [.SRC]STEPWISE.TPU $ DECK/DOLLARS="*$*$*EOD*$*$*" PROCEDURE step_compile (fn) LOCAL pos, buf, spos, epos, rng; ON_ERROR IF ERROR = TPU$_COMPILEFAIL THEN QUIT; ENDIF; ENDON_ERROR buf := CREATE_BUFFER ("$$temp_buf$$", fn); IF (buf = 0) THEN MESSAGE ("Error loading file!!!"); RETURN; ENDIF; POSITION (BEGINNING_OF (buf)); pos := MARK (NONE); LOOP rng := SEARCH (line_begin & "PROC", FORWARD, EXACT); EXITIF (rng = 0); spos := BEGINNING_OF (rng); POSITION (spos); MESSAGE (CURRENT_LINE); rng := SEARCH (line_begin & "ENDPROC", FORWARD, EXACT); EXITIF (rng = 0); epos := BEGINNING_OF (rng); POSITION (epos); MOVE_VERTICAL (1); pos := MARK (NONE); MOVE_HORIZONTAL (-1); COMPILE (CREATE_RANGE (spos, MARK (NONE), NONE)); ENDLOOP; POSITION (pos); COMPILE ("PROCEDURE step_compile ENDPROCEDURE;"); EXECUTE (COMPILE (CREATE_RANGE (pos, END_OF (CURRENT_BUFFER), NONE))); ENDPROCEDURE; step_compile (GET_INFO (COMMAND_LINE, "FILE_NAME")); quit; *$*$*EOD*$*$* $ if f$search("SRC.DIR;1") .eqs. "" then - CREATE/LOG/DIRECTORY [.SRC] $ write sys$output "Creating [.SRC]MAKE.COM" $ create [.SRC]MAKE.COM $ DECK/DOLLARS="*$*$*EOD*$*$*" $ do="@[-.exe]do" $ if f$logical ("vi$root") .nes. "" THEN do="@[exe]do" $ if p1 .eqs. "ALL" then p1="TPUSUBS,EXE,VI" $ if p1 .eqs. "" then p1 = "VI" $ opers =","+p1+"," $ i = 1 $! $ NEXT_ELEM: $ next = f$element (i, ",", opers) $ i = i + 1 $ if (next .eqs. "") .or. (next .eqs. ",") then goto done $ write sys$output "* Making ''next'" $ on warning then goto go_err $ goto 'next' $ go_err: $ write sys$output " \''next'\" $ goto next_elem $! $ VI: $ on warning then stop $ do edit/tpu/command=stepwise.tpu/nodispay/nosection vi.tpu $ do rename vi.gbl [-.exe] $ goto next_elem $! $ TPUSUBS: $ on warning then stop $ do macro tpusubs $ do link/share/exe=[-.exe]tpusubs tpusubs/opt $ goto next_elem $! $ EXE: $ on warning then stop $ do macro vi $ do link/exe=[-.exe]vi vi $ goto next_elem $! $ CLEAN: $ on warning then stop $ do purge/log VI$ROOT:[*...]*.* $ do delete/log VI$ROOT:[SRC]*.obj;,VI$ROOT:[SRC]MAKE.OUT; $ goto next_elem $! $ DONE: $ on warning then stop $ exit *$*$*EOD*$*$* $ exit