v04i093: TPUVI for VMS part 2 of 17
Gregg Wonderly
gregg at a.cs.okstate.edu
Mon Sep 26 11:47:27 AEST 1988
Posting-number: Volume 4, Issue 93
Submitted-by: "Gregg Wonderly" <gregg at a.cs.okstate.edu>
Archive-name: vms-vi-2/Part02
$ 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
$jpidef
$dvidef
$prcdef
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
DEBUG = 0
.psect data,rd,wrt,noexe,pic
;+ ---
;
;- ---
.MACRO DEBUG,str
.IF NE DEBUG
pushab str
calls #1,g^lib$put_output
.ENDC
.ENDM
;+ ---
;
;- ---
.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
;+ ---
;
;- ---
iosb:
.quad 0
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
.long 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 ;Build result descriptor
movab i_res,i_res_descr+4
movl #512,i_parm_descr ;Build parameter copy descriptor
movab i_parm,i_parm_descr+4
pushl 8(ap) ;Make a copy of the parameter
pushab i_parm_descr
calls #2,g^str$copy_dx
pushab dummy ;Set the length of the string
pushab i_parm_descr
pushl 8(ap)
calls #3,g^str$analyze_sdesc
put_item - ;Set descriptor up for $TRNLNM
itemlist,#lnm$_string,-
#512,i_res,i_res_descr
put_item -
itemlist_2,#0,#0,#0,#0 ;Dummy up descriptor
movl 4(ap),r1 ;Get address of case value
casew (r1),#TPU_CWD,#TPU_PASTHRU_OFF;Do case
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 /VI_SECTION/
tpusectdescr:
.ascid /TPU$SECTION/
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 thing
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^sys$exit ;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^sys$exit ;Exit with 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^sys$exit
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]
$ set noon
$ mcr install
vi$root:[exe]vi.gbl/replace
$ set on
$ 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
More information about the Comp.sources.misc
mailing list