From:	HENRY::IN%"GREGG%nemo.math.okstate.EDU%relay.cs.net@RCA.COM" 31-OCT-1987 19:19
To:	VI-TO@nemo.math.okstate.edu
Subj:	VI part 2 of 14

....................... Cut between dotted lines and save ......................
$!..............................................................................
$! VAX/VMS archive file created by VMS_SHAR V-4.03 05-Aug-1987
$! which was written by Michael Bednarek (U3369429@ucsvc.dn.mu.oz.au)
$! To unpack, simply save and execute (@) this file.
$!
$! This archive was created by GREGG
$!      on Tuesday 20-OCT-1987 22:08:42.93
$!
$! It contains the following 5 files:
$! MAKE.COM STEPWISE.TPU TPUSUBS.MAR TPUSUBS.OPT VI.MAR
$!==============================================================================
$ Set Symbol/Scope=(NoLocal,NoGlobal)
$ Version=F$GetSYI("VERSION") ! See what VMS version we have here:
$ If Version.ges."V4.4" then goto Version_OK
$ Write SYS$Output "Sorry, you are running VMS ",Version, -
                ", but this procedure requires V4.4 or higher."
$ Exit 44
$Version_OK: CR[0,8]=13
$ Pass_or_Failed="failed!,passed."
$ Goto Start
$Convert_File:
$ Read/Time_Out=0/Error=No_Error1/Prompt="creating ''File_is'" SYS$Command ddd
$No_Error1: Define/User_Mode SYS$Output NL:
$ Edit/TPU/NoSection/NoDisplay/Command=SYS$Input/Output='File_is' -
        VMS_SHAR_DUMMY.DUMMY
f:=Get_Info(Command_Line,"File_Name");b:=Create_Buffer("",f);
o:=Get_Info(Command_Line,"Output_File");Set (Output_File,b,o);
Position (Beginning_of(b));Loop x:=Erase_Character(1); Loop ExitIf x<>"V";
Move_Vertical(1);x:=Erase_Character(1);Append_Line;Move_Horizontal
(-Current_Offset);EndLoop;Move_Vertical(1);ExitIf Mark(None)=End_of(b)
EndLoop;Exit;
$ Delete VMS_SHAR_DUMMY.DUMMY;*
$ Checksum 'File_is
$ Success=F$Element(Check_Sum_is.eq.CHECKSUM$CHECKSUM,",",Pass_or_Failed)+CR
$ Read/Time_Out=0/Error=No_Error2/Prompt=" CHECKSUM ''Success'" SYS$Command ddd
$No_Error2: Return
$Start:
$ File_is="[.SRC]MAKE.COM"
$ Check_Sum_is=1648981559
$ if f$search("SRC.DIR;1") .eqs. "" then -
     CREATE/LOG/DIRECTORY [.SRC]
$ Copy SYS$Input VMS_SHAR_DUMMY.DUMMY
X$ do="@[-.exe]do"
X$ if f$logical ("vi$root") .nes. "" THEN do="@[exe]do"
X$ if p1 .eqs. "ALL" then p1="TPUSUBS,EXE,VI"
X$ if p1 .eqs. "" then p1 = "VI"
X$ opers =","+p1+","
X$ i = 1
X$!
X$ NEXT_ELEM:
X$	next = f$element (i, ",", opers)
X$	i = i + 1
X$	if (next .eqs. "") .or. (next .eqs. ",") then goto done
X$	write sys$output "* Making ''next'"
X$	on warning then goto go_err
X$	goto 'next'
X$ go_err:
X$	write sys$output "   \''next'\"
X$	goto next_elem 
X$!
X$ VI:
X$	on warning then stop
X$	do edit/tpu/command=stepwise.tpu/nodispay/nosection vi.tpu
X$	do rename vi.gbl [-.exe]
X$	goto next_elem
X$!
X$ TPUSUBS:
X$	on warning then stop
X$	do macro tpusubs
X$	do link/share/exe=[-.exe]tpusubs tpusubs/opt
X$	goto next_elem
X$!
X$ EXE:
X$	on warning then stop
X$	do macro vi
X$	do link/exe=[-.exe]vi vi
X$	goto next_elem
X$!
X$ CLEAN:
X$	on warning then stop
X$	do purge/log VI$ROOT:[*...]*.*
X$	do delete/log VI$ROOT:[SRC]*.obj;,VI$ROOT:[SRC]MAKE.OUT;
X$	goto next_elem
X$!
X$ DONE:
X$	on warning then stop
X$	exit
$ GoSub Convert_File
$ File_is="[.SRC]STEPWISE.TPU"
$ Check_Sum_is=2017999485
$ if f$search("SRC.DIR;1") .eqs. "" then -
     CREATE/LOG/DIRECTORY [.SRC]
$ Copy SYS$Input VMS_SHAR_DUMMY.DUMMY
XPROCEDURE step_compile (fn)
X	LOCAL
X		pos,
X		buf,
X		spos,
X		epos,
X		rng;
X
X	ON_ERROR
X		IF ERROR = TPU$_COMPILEFAIL THEN
X			QUIT;
X		ENDIF;
X	ENDON_ERROR
X
X	buf := CREATE_BUFFER ("$$temp_buf$$", fn);
X	IF (buf = 0) THEN
X		MESSAGE ("Error loading file!!!");
X		RETURN;
X	ENDIF;
X
X	POSITION (BEGINNING_OF (buf));
X	pos := MARK (NONE);
X	LOOP
X		rng := SEARCH (line_begin & "PROC", FORWARD, EXACT);
X		EXITIF (rng = 0);
X		spos := BEGINNING_OF (rng);
X		POSITION (spos);
X		MESSAGE (CURRENT_LINE);
X		rng := SEARCH (line_begin & "ENDPROC", FORWARD, EXACT);
X		EXITIF (rng = 0);
X		epos := BEGINNING_OF (rng);
X		POSITION (epos);
X		MOVE_VERTICAL (1);
X		pos := MARK (NONE);
X		MOVE_HORIZONTAL (-1);
X		COMPILE (CREATE_RANGE (spos, MARK (NONE), NONE));
X	ENDLOOP;
X
X	POSITION (pos);
X	COMPILE ("PROCEDURE step_compile ENDPROCEDURE;");
X	EXECUTE (COMPILE (CREATE_RANGE (pos, END_OF (CURRENT_BUFFER), NONE)));
XENDPROCEDURE;
X
Xstep_compile (GET_INFO (COMMAND_LINE, "FILE_NAME"));
Xquit;
$ GoSub Convert_File
$ File_is="[.SRC]TPUSUBS.MAR"
$ Check_Sum_is=729567644
$ if f$search("SRC.DIR;1") .eqs. "" then -
     CREATE/LOG/DIRECTORY [.SRC]
$ Copy SYS$Input VMS_SHAR_DUMMY.DUMMY
X		.TITLE	TPUSUBS
X
X;
X;	This file contains TPU CALL_USER support routines for VI.
X;
X;	Written by Gregg Wonderly, June, 1987
X;
X
X		$ssdef
X		$rmsdef
X		$lnmdef
X		$iodef
X		$qiodef
X		$trmdef
X		$ttdef
X	 	$dcdef
X
XTPU_CWD=1
XTPU_TRNLNM_JOB=2
XTPU_TRNLNM_PROC=3
XTPU_TRNLNM_SYS=4
XTPU_TRNLNM_GROUP=5
XTPU_GETMSG=6
XTPU_SET_SYSDISK=7
XTPU_SLEEP=8
XTPU_PASTHRU_ON=9
XTPU_PASTHRU_OFF=10
X
X		.psect	data,rd,wrt,noexe
X
X		.macro	trnlnm_item,code,len,bufaddr,retlenaddr
X		.word	len
X		.word	code
X		.address -
X			bufaddr
X		.address -
X			retlenaddr
X		.endm
X
X		.macro	put_item,buf,code,len,bufaddr,retlenaddr
X		movw	len,buf
X		movw	code,buf+2
X		moval	bufaddr,buf+4
X		moval	retlenaddr,buf+8
X		.endm
X
Xsysc_descr:
X		.ASCID	/SYS$COMMAND/
X
Xiochan:
X		.word	0
X
Xnewchar_buf:
X		.blkl	3
Xnewchar_buf_len = .-newchar_buf
X;
Xtempchar_buf:
X		.blkb	newchar_buf_len
X;
Xpar_settings:
X		.long	0
X
Xtt_descr:
X		.ASCID	/TT:/
Xjob_descr:
X		.ASCID	/LNM$JOB/
Xsys_descr:
X		.ASCID	/LNM$SYSTEM/
Xproc_descr:
X		.ASCID	/LNM$PROCESS/
Xgroup_descr:
X		.ASCID	/LNM$GROUP/
Xsysdisk_descr:
X		.ASCID	/SYS$DISK/
X
Xitemlist:
X		trnlnm_item	0,0,0,0
Xitemlist_2:
X		trnlnm_item	0,0,0,0
X
Xmsgnum:
X		.long	0
Xstat:
X		.long	0
Xi_parm_descr:
X		.blkb	8
Xi_res_descr:
X		.blkb	8
Xi_parm:
X		.blkb	512
Xi_res:
X		.blkb	512
X
Xtimebuf:
X		.long	0
X		.long	0
X
Xdummy:
X		.long	0
X
Xtenths=-1000000
X
X		.psect	code,exe,rd,nowrt,pic
X;
X;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
X;
X;
X;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
X;
X
X		.entry	sleep,^m<r2,r3,r4,r5,r6>
X		movl	4(ap),r0
X		mull3	r0,#tenths,r1
X		movl	r1,timebuf
X		movl	#-1,timebuf+4
X		$schdwk_s -
X			daytim=timebuf
X		blbc	r0,10$
X		$hiber_s
X		blbs	r0,20$
X10$:
X		pushl	r0
X		calls	#1,g^lib$signal
X20$:
X		ret
X;
X;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
X;
X;
X;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
X;
X
X		.entry	atoi,^m<r2,r3,r4,r5>
X		movl	4(ap),r0		;Get the descriptor address
X		clrl	r1			;Clear the accumulator
X		movl	4(r0),r2		;Get the string address
X		cvtwl	(r0),r0			;Get the length
X10$:
X		mull2	#10,r1			;multiply by 10
X		cvtbl	(r2)+,r3
X		addl3	r3,#-48,r4		;Add in digit
X		addl	r4,r1
X		sobgtr	r0,10$
X		movl	r1,r0
X		ret
X
X;
X;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
X;
X;
X;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
X;
X		.entry	tpu$calluser,^m<r2,r3,r4,r5>
X
X		movl	#512,i_res_descr
X		movab	i_res,i_res_descr+4
X
X		movl	#512,i_parm_descr
X		movab	i_parm,i_parm_descr+4
X
X		pushl	8(ap)
X		pushab	i_parm_descr
X		calls	#2,g^str$copy_dx
X
X		pushab	dummy
X		pushab	i_parm_descr
X		pushl	8(ap)
X		calls	#3,g^str$analyze_sdesc
X
X		put_item -
X			itemlist,#lnm$_string,#512,i_res,i_res_descr
X
X		put_item -
X			itemlist_2,#0,#0,#0,#0
X
X		movl	4(ap),r1
X		casew	(r1),#TPU_CWD,#TPU_PASTHRU_OFF
Xcase_1:
X		.word	do_cwd - case_1
X		.word	do_trnlnm_job - case_1
X		.word	do_trnlnm_proc - case_1
X		.word	do_trnlnm_sys - case_1
X		.word	do_trnlnm_group - case_1
X		.word	do_getmsg - case_1
X		.word	do_set_sysdisk - case_1
X		.word	do_sleep - case_1
X		.word	do_pasthru_on - case_1
X		.word	do_pasthru_off - case_1
X;
X		.word	case_2 - case_1
Xcase_2:
X		movl	#SS$_BADPARAM,r0
X		ret
X
X;
X;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
X;
X;
X;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
X;
Xdo_cwd:
X		movw	i_parm_descr,r1		;Get the length of parameter
X		tstl	r1			;If zero, then get current dir
X		bneq	10$
X		pushal	i_res_descr		;Push args
X		pushal	i_res_descr
X		pushl	#0
X		calls	#3,g^sys$setddir
X		brw	out
X10$:						;Otherwise set the current dir
X		pushal	i_res_descr
X		pushal	i_res_descr
X		pushal	i_parm_descr
X		calls	#3,g^sys$setddir
X		brw	out
X		
X;
X;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
X;
X;
X;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
X;
Xdo_trnlnm_job:
X		$trnlnm_s -
X			attr=#LNM$M_CASE_BLIND,-
X			tabnam=job_descr,-
X			lognam=i_parm_descr,-
X			itmlst=itemlist
X		brw	out
X
X;
X;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
X;
X;
X;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
X;
Xdo_trnlnm_proc:
X		$trnlnm_s -
X			attr=#LNM$M_CASE_BLIND,-
X			tabnam=proc_descr,-
X			lognam=i_parm_descr,-
X			itmlst=itemlist
X		brw	out
X
X;
X;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
X;
X;
X;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
X;
Xdo_trnlnm_sys:
X		$trnlnm_s -
X			attr=#LNM$M_CASE_BLIND,-
X			tabnam=sys_descr,-
X			lognam=i_parm_descr,-
X			itmlst=itemlist
X		brw	out
X
X;
X;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
X;
X;
X;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
X;
Xdo_trnlnm_group:
X		$trnlnm_s -
X			attr=#LNM$M_CASE_BLIND,-
X			tabnam=group_descr,-
X			lognam=i_parm_descr,-
X			itmlst=itemlist
X		brw	out
X
X;
X;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
X;
X;
X;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
X;
Xdo_getmsg:
X		pushal	i_parm_descr		;Convert the string to a number
X		calls	#1,atoi
X		movl	r0,msgnum		;Store the result
X		movl	#512,i_res_descr
X		$getmsg_s -
X			msgid=msgnum,-
X			msglen=i_res_descr,-
X			bufadr=i_res_descr
X		brw	out
X
X;
X;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
X;
X;
X;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
X;
Xdo_set_sysdisk:
X		pushal	i_parm_descr
X		pushal	sysdisk_descr
X		calls	#2,g^lib$set_logical
X		clrl	i_res_descr
X		brw	out
X
X;
X;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
X;
X;
X;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
X;
Xdo_sleep:
X		pushal	i_parm_descr		;Convert the string to a number
X		calls	#1,atoi
X		pushl	r0
X		calls	#1,sleep
X		clrl	i_res_descr
X		brw	out
X
X;
X;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
X;
X;
X;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
X;
Xdo_pasthru_on:
X		$assign_s -
X			devnam=tt_descr,-
X			chan=iochan
X		blbs	r0,10$
X5$:
X		pushl	r0
X		pushl	r0
X		calls	#1,g^lib$signal
X		movl	(sp)+,r0
X		brw	out
X10$:
X		movab	dassign,(fp)
X		$qiow_s -
X			chan=iochan,-
X			func=#IO$_SENSEMODE,-
X			p1=newchar_buf,-
X			p2=#newchar_buf_len
X		blbs	r0,20$
X15$:
X		movl	r0,r2
X		$dassgn_s -
X			chan=iochan
X		clrw	iochan
X		movl	r2,r0
X		brw	5$
X;
X20$:
X		bisl2	#TT2$M_PASTHRU,newchar_buf+8
X		$qiow_s -
X			chan=iochan,-
X			func=#IO$_SETMODE,-
X			p1=newchar_buf,-
X			p2=#newchar_buf_len
X		blbc	r0,15$
X
X		$dassgn_s -
X			chan=iochan
X		clrw	iochan
X		clrl	(fp)
X		clrl	i_res_descr
X		brw	out
X
X;
X;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
X;
X;
X;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
X;
X		.entry	dassign,^m<>
X		tstw	iochan
X		beql	10$
X		$dassgn_s -
X			chan=iochan
X		clrw	iochan
X10$:
X		clrl	i_res_descr
X		ret
X
X;
X;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
X;
X;
X;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
X;
Xdo_pasthru_off:
X		$assign_s -
X			devnam=tt_descr,-
X			chan=iochan
X		blbs	r0,10$
X5$:
X		pushl	r0
X		pushl	r0
X		calls	#1,g^lib$signal
X		movl	-(sp),r0
X		brw	out
X10$:
X		movab	dassign,(fp)
X		$qiow_s -
X			chan=iochan,-
X			func=#IO$_SENSEMODE,-
X			p1=newchar_buf,-
X			p2=#newchar_buf_len
X		blbs	r0,20$
X15$:
X		movl	r0,r2
X		$dassgn_s -
X			chan=iochan
X		clrw	iochan
X		movl	r2,r0
X		brw	5$
X;
X20$:
X		bicl2	#TT2$M_PASTHRU,newchar_buf+8
X		$qiow_s -
X			chan=iochan,-
X			func=#IO$_SETMODE,-
X			p1=newchar_buf,-
X			p2=#newchar_buf_len
X		blbc	r0,15$
X
X		$dassgn_s -
X			chan=iochan
X		clrw	iochan
X		clrl	(fp)
X		clrl	i_res_descr
X		brw	out
X
X;
X;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
X;
X;
X;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
X;
Xout:
X		blbc	r0,err
X		pushal	i_res_descr
X		pushl	12(ap)
X		calls	#2,g^str$copy_dx
X
X		movl	12(ap),r1
X		movw	i_res_descr,(r1)
X		movl	#SS$_NORMAL,r0
Xerr:
X		ret
X		.end
$ GoSub Convert_File
$ File_is="[.SRC]TPUSUBS.OPT"
$ Check_Sum_is=677272624
$ if f$search("SRC.DIR;1") .eqs. "" then -
     CREATE/LOG/DIRECTORY [.SRC]
$ Copy SYS$Input VMS_SHAR_DUMMY.DUMMY
XTPUSUBS.OBJ
XUNIVERSAL=TPU$CALLUSER
$ GoSub Convert_File
$ File_is="[.SRC]VI.MAR"
$ Check_Sum_is=1275572245
$ if f$search("SRC.DIR;1") .eqs. "" then -
     CREATE/LOG/DIRECTORY [.SRC]
$ Copy SYS$Input VMS_SHAR_DUMMY.DUMMY
X;
X;	This file contains the source to a program that exercises callable
X;	TPU.  You will be interested in using this program ONLY if you
X;	make use of more than ONE TPU utility that requires a CALL_USER
X;	routine, and/or you like to define TPUSECINI as opposed to using
X;	the /SECTION quailfier of EDIT/TPU.
X;
X;	This program expects to be able to use the VI$CALLUSER logical
X;	to find the call_user routines for VI.  It also uses VISECINI
X;	for the name of the TPU section file.  Just to be complete, it will
X;	also use TPU$CALLUSER and TPUSECINI if the VI logicals do not exist.
X;
X;	Written by Gregg Wonderly, 10-jul-1987
X;
X		$ssdef
X		$lnmdef
X		$psldef
X		$fabdef
X		$rabdef
X		$namdef
X		.macro	item,code,blen,badr,radr
X		.word	blen
X		.word	code
X		.address -
X			badr
X		.address -
X			radr
X		.endm
X
X;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
X;
X;	Program data section
X;
X;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
X
X		.psect	rwdata,rd,wrt,noexe
X
Xfabdef:
X		$fab
Xfablen=.-fabdef
X
Xrabdef:
X		$rab
Xrablen=.-rabdef
X
Xnamdef:
X		$nam
Xnamlen=.-namdef
X
Xblkdescr:
X		.address	0
Xexit_h:
X		.long	0
X		.address exit_handler
X		.long	0
X		.address exit_stat
X;
Xexit_stat:
X		.long	0
X;
Xclean_flags:
X		.long	TPU$M_DELETE_JOURNAL!-
X			TPU$M_DELETE_EXITH!-
X			TPU$M_RESET_TERMINAL!-
X			TPU$M_KILL_PROCESSES!-
X			TPU$M_LAST_TIME
Xbvpval:
X		.long	0
X;
Xbvp:
X		.address -
X			tpu_init
X		.long	0
X;
Xcalluserd:
X		.long	0
X		.long	0
X;
Xfileiod:
X		.address -
X			TPU$FILEIO
X		.long	0
X;
Xcrelnm_items:
X		item	LNM$_STRING,0,trnlnm_string,dummy
X		.long	0
Xdummy:
X		.long	0
X
Xtrnlnm_items:
X		item	LNM$_STRING,512,trnlnm_string,string_len
X		.long	0
X		.long	0
X
Xtrnlnm_string:
X		.blkb	512
X
Xsectdescr:
Xstring_len:
X		.long
X		.address -
X			trnlnm_string
X
Xvicalldescr:
X		.ascid	/VI$CALLUSER/
X
Xtpucalldescr:
X		.ascid	/TPU$CALLUSER/
X
Xvisectdescr:
X		.ascid	/VISECINI/
X
Xtpusectdescr:
X		.ascid	/TPUSECINI/
X
Xprocdescr:
X		.ascid	/LNM$PROCESS_TABLE/
X
Xbadvicall:
X		.ascid	/%VI-F-BADTPUCALL, improper definition of VI$CALLUSER/
X
Xbadtpucall:
X		.ascid	/%VI-F-BADTPUCALL, improper definition of TPU$CALLUSER/
X
Xnocalluser:
X		.ascid	/%VI-F-NOCALLUSER, no calluser routine could be loaded/
X
X		.psect	code,rd,exe,nowrt
X
X		.entry	noerr,^m<>
X		ret
X
X;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
X;
X;	The program itself, straight forward no?
X;
X;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
X
X		.entry	viedit,^m<r2,r3,r4,r5,r6>
X
X		movab	noerr,(fp)		;Forget about errors we will
X						;handle them
X		pushal	calluserd		;Push return address location
X		pushab	tpucalldescr		;Routine name
X		pushab	vicalldescr		;Image to search through
X		calls	#3,g^lib$find_image_symbol	;Find the symbol
X		blbs	r0,10$			;Branch on success
X;
X		cmpl	r0,#RMS$_FNF		;If FNF then try TPU$CALLUSER
X		beql	5$
X		pushl	r0			;Save the exit value
X		pushab	badvicall		;Pass the right message
X		brw	8$			;Join the other code
X5$:
X;
X;	There is no VI$CALLUSER image, so try TPU$CALLUSER.
X;
X		pushal	calluserd		;Push return address location
X		pushab	tpucalldescr		;Routine name
X		pushab	tpucalldescr		;Image to search through
X		calls	#3,g^lib$find_image_symbol	;Find the symbol
X		blbs	r0,10$			;Branch if we got that
X
X		pushl	r0			;Save the status
X
X		cmpl	r0,#RMS$_FNF		;If FNF then say the right thing
X		beql	7$			;Go set up the right parameter
X
X		pushab	badtpucall		;Push the message descr
X		brb	8$			;Join other code
X;
X7$:
X		pushab	nocalluser		;Push the message descr
X;
X8$:
X		calls	#1,g^lib$put_output	;Output the message
X		calls	#1,g^lib$stop		;Stop with the status pushed
X;
X;	Got the calluser routine, continue processing
X;
X10$:
X		clrl	(fp)			;Remove condition handler
X
X		$trnlnm_s -
X			tabnam=procdescr,-
X			lognam=visectdescr,-
X			itmlst=trnlnm_items	;Get the VISECINI defintion
X		blbc	r0,20$			;If that fails then don't worry
X						;If /SECTION is not there, then
X						;TPU will bark for us.
X
X		pushaq	sectdescr		;On success, redefine TPUSECINI
X		pushaq	tpusectdescr		;to be VISECINI's value
X		calls	#2,g^lib$set_logical
X		blbs	r0,20$
X		pushl	r0
X		calls	#1,g^lib$signal		;Signal the condition
X20$:
X		movab	g^tpu$handler,(fp)	;Establish tpu$handler
X
X		pushab	calluserd		;Pass the BVP's to parseinfo
X		pushab	fileiod			;Use TPU$FILEIO
X		calls	#2,g^tpu$parseinfo	;Get the command line stuff
X		movl	r0,bvpval		;This is the value for the
X						;call back routine to return
X						;to tpu$initialize, so save it.
X
X		pushab	bvp			;Pass the BVP for the callback
X		calls	#1,g^tpu$initialize	;Initialize TPU
X		blbc	r0,err			;Branch on error
X
X		$dclexh_s -
X			desblk=exit_h		;Establish an exit handler
X		blbc	r0,err
X
X		calls	#0,g^tpu$execute_inifile ;Execute the initialization
X
X		blbc	r0,err
X		cmpl	r0,#TPU$_SUCCESS
X		bneq	done			;Skip control if not SUCCESS
X
X		calls	#0,g^tpu$control	;Call control to do editing.
X		blbc	r0,err
Xdone:
X		brb	out
Xerr:
X		pushl	r0			;Signal any error
X		calls	#1,g^lib$signal
X
Xout:
X		ret				;Back to caller
X;
X;	Merely return the value that tpu$parseinfo returned to us
X;
X		.entry	tpu_init,^m<>
X		movl	bvpval,r0
X		ret
X
X;
X;	This exit handler is called at image exit to cleanup the things that
X;	are of no more interest to us.  Sadly enough, there is not a perfect
X;	policy for the journal file that satisfies everyone.  I have always
X;	written out my changes from time to time, so I really don't ever use
X;	the journal.  The current itemlist to tpu$cleanup causes the journal
X;	to be deleted.  WARNING, don't $FORCEX a VI that you wish to have the
X;	journal from.
X;
X		.entry	exit_handler,^m<>
X		pushal	clean_flags
X		calls	#1,g^tpu$cleanup
X		movl	exit_stat,r0
X		ret
X
X;
X;
X;
X;
X		.entry	vi$fileio,^m<r2,r3,r4,r5,r6,r7,r8,r9>
X
X		movl	@4(ap),r1		;Get the code
X		cmpl	r1,#TPU$K_OPEN
X		bneq	10$
X		jmp	tpu_open
X;
X10$:
X		cmpl	r1,#TPU$K_CLOSE
X		bneq	20$
X		jmp	tpu_close
X;
X20$:
X		cmpl	r1,#TPU$K_CLOSE_DELETE
X		bneq	30$
X		jmp	tpu_close_delete
X;
X30$:
X		cmpl	r1,#TPU$K_GET
X		bneq	40$
X		jmp	tpu_get
X;
X40$:
X		cmpl	r1,#TPU$K_PUT
X		beql	tpu_put
X		movl	#SS$_BADPARAM,r0
X		ret
X;
X;	$PUT routine for VI to use
X;
Xtpu_put:
X		
X;
X;	$GET routine for VI to use
X;
Xtpu_get:
X
X;
X;	$CLOSE with delete for VI to use
X;
Xtpu_close_delete:
X
X;
X;	$CLOSE for VI to use
X;
Xtpu_close:
X
X;
X;	$OPEN for VI to use
X;
Xtpu_open:
X
X
X		ret
X		.end	viedit
$ GoSub Convert_File
$ Exit
