Trailing-Edge - PDP-10 Archives - tops10and20_integ_tools_v9_3-aug-86 - tools/crc/browse/crrun.mac
There are no other files named crrun.mac in the archive.
;<CRC-SUBS>CRRUN.MAC.100023, 27-Jan-84 13:44:43, Edit by KEVIN
;	Check for FOROTS loaded, don't call FUNCT. if it isn't.
;<KEVIN>CRRUN.MAC.100024, 19-Jan-84 16:49:30, Edit by KEVIN
;	If no rescan buffer supplied, set up a default with program name.
;<KEVIN>CRRUN.MAC.100040,  3-Aug-83 10:24:49, EDIT BY KEVIN
;	Add control-c traps
	TITLE	CRRUN - run a program, load rescan, wait for exit
;	Subroutine is called from FORTRAN with single argument - a text
;	string specifying the name of the program to run. Also specify a
;	command string for the rescan buffer. Example:
;	call	crrun('sys:tv.exe','edit fil.dat',error)
;	Control-c is trapped during this routine, and aborts the inferior
;	program, not the calling program.
;	Returned errors:
;	0 - success
;	1 - can't find program
;	2 - can't run it
	search	vtmac
	regdef			;define registers, search symbols, etc.
	entry	crrun
	external gtbypt		;fortran v7 text
	external	funct.	;FOROTS
	external forot%

rslin:	block ^d17		;space for command line
;	Storage for PSI system
errcod:	0			;error code from FUNCT.
forstat:	0		;status code from FUNCT.
psichn:	-1			;channel number returned from FOROTS
intadr:	0			;store address of interrput routine here
forcod:	17			;store function code here
ftsblk:	-6,,0			;number of arguments
	z	2,forcod		;function is get interrupt channel
	z	2,errcod		;place error code here
	z	2,forstat		;place status code here
	z	2,psichn		;place channel allocated here
	z	2,[1]			;on level 1
	z	2,intadr		;routine to handle interrupts

crrun:	efort			;fortan entry stuff
	move	t1,cx		;save argument pointer
	TRvar	<prgjfn,frkhnd>
	move	cx,t1		;restore argument pointer
	setz	t1,		;pointer to 1st arg.
	call	gtbypt		;may be fortran v7 text
	move	t2,t1		;gtjfn% wants it in t2
;*	hrroi	t2,@(cx)	;point to filname to pick up
	movx	t1,gj%sht+gj%old	;insist file exists
	gtjfn%			;try and find it
	 erjmp	[movei	t1,1		;can't find program
		movem	t1,@err(cx)	;return error to user
		ret]		;back to caller
	movem	t1,prgjfn	;remeber JFN on prog
	movx	t1,cr%cap	;give inferior our capabilities
	cfork%			;create a fork for it
	 erjmp	cntrun
	movem	t1,frkhnd	;remember fork handle
	hrlz	t1,frkhnd	;fork handle in left half
	hrr	t1,prgjfn	;and JFN in left
	get%			;map process to file
	 erjmp	cntrun
	movei	t1,rsb		;want pointer to rescan buffer
	call	gtbypt		;may be fortran v7 text
	move	t2,t1		;sout% wants it t2
	hrroi	t1,rslin	;point to command line
	setzb	t3,t4
;*	hrroi	t2,@rsb(cx)	;get rescan stuff
	sout%			;write out command line
	 erjmp	[jshlt]
	call chkrsc		;see if we actuall had a rescan line
	movei	t2,15
	idpb	t2,t1		;dump out cr
	movei	t2,12
	idpb	t2,t1		;and lf
	hrroi	t1,rslin	;point to new command line
	rscan%			;load buffer
	 erjmp	cntrun
	move	t1,frkhnd	;handle of inferior
	setz	t2,		;start at START
	sfrkv%			;start at entry vector
	 erjmp	cntrun
	call	setint		;Set up control-c traps
wforit:	move	t1,frkhnd
	wfork%			;wait for it to finish
	 erjmp	[jshlt]		;should never fail
killit:	move	t1,frkhnd	;get fork handle
;	call	chkfrk		;;;*** Check out WFORK logic - temp kludge
;	 jrst	wforit		;;;*** Fork still appears to be OK
	move	t1,frkhnd	;get fork handle
	kfork%			;kill it
	 erjmp	[jshlt]		;should never fail
	call	remint		;release control-c traps
	ret			;back to caller
cntrun:	movei	t1,2		;error code is cannot run
	movem	t2,@err(cx)	;so return it to caller
	ret			;and return control
;	Routine to see if a rescan buffer was supplied, and if not, to create
;	one.
;	On entry, t1/ Current pointer to rescan buffer.
;	On exit, the same.
chkrsc:	skipe	rslin		;is rescan buffer zero ?
	 ret			;no, so a buffer was given
	hrroi	t1,rslin	;yes, so point to it
	move	t2,prgjfn	;get the jfn on the program file
	movx	t3,fld(.jsaof,js%nam) ;write out just the name of the program
	 erjmp	r		;on error, return
	ret			;in fact, return anyway
;	Set control-c traps during execution of inferior fork.
setint:	setzm	inton		;flag no interrupt system yet
	move	t1,[forot%]	;find out what FOROTS we have
	tlne	t1,-1		;is FOROTS shareable ?
	 ret			;no, so probably from MACRO, don't do it.
	jumpe	t1,r		;in V7, FOROT% will be zero if non-shareable
	movei	t1,.fhslf	;read the capabilities
	rpcap%			;of our fork
	txnn	t2,sc%ctc	;do we have control-c capability ?
	 ret			;no, so don't waste any more time
	txo	t3,sc%ctc	;yes, so enable it
	epcap%			;like this
	movei	t1,ctrlc	;address of interrupt routine
	movem	t1,intadr	;store for FOROTS
	setom	psichn		;indicate any channel will do
	movei	t1,17		;function is GPSI
	movem	t1,forcod	;store in arg block
	movx	t1,<-6,,0>	;number of arguments to get a channel
	movem	t1,ftsblk	;store in arg block
	movei	cx,ftsblk+1	;get address of FOROTS FUNCT. block
	call	funct.		;enter FOROTS to do stuff
	skipe	forstat		;return ok ?
	 ret			;no, so just run the prog anyway
	move	t1,psichn	;ok, get channel number
	hrli	t1,.ticcc	;and code for control-c
	ati%			;allocate interrupts
	movx	t1,.fhslf	;now point to our fork
	movx	t2,1b0		;assume channel 0
	movn	t3,psichn	;get negative of channel number
	hrrzs	t3,t3		;make a right half value
	lsh	t2,@t3		;and shift mask to indicate channel
	aic%			;activat the ctrl-C channel
	setom	inton		;flag interrupt system working
	ret			;return to caller
;	REMINT - remove control-c interrupt traps.
remint:	skipn	inton		;interrupt system on ?
	 ret			;no, so return
	movx	t1,.fhslf	;point to our fork
	movx	t2,1b0		;assume channel 0
	movn	t3,psichn	;get negative of channel number
	hrrzs	t3,t3		;make a right half value
	lsh	t2,@t3		;and shift mask to indicate channel
	dic%			;deactivate the ctrl-C channel
	movei	t1,.ticcc	;code for control-c, to deallocate
	dti%			;deallocate interrupts
	movei	t1,20		;function is RPSI
	movem	t1,forcod	;store in arg block
	movx	t1,<-4,,0>	;number of arguments to release a channel
	movem	t1,ftsblk	;store in arg block
	movei	cx,ftsblk+1	;address of argument block
	call	funct.		;tell FOROTS to release the channel
	ret			;ignore errors
;	Control-c trap handler
ctrlc:	movei	t1,.fhslf	;point to our fork
	movei	t2,t3		;point to arg block
	movei	t3,3		;length of arg block
	xrir%			;read interrupt table addresses
	movei	t1,killit	;address of place after WFORK%
	movem	t1,@(t4)	;store as address to resume from
	debrk%			;leave interrupt context
;	Come here due to a temporary kludge - we suspect that WFORK sometimes
;	returns to the caller when it should not.
;	Type out a nasty message if this is the case.
chkfrk:	rfsts%			;read fork status
	 erjmp	[jshlt]		;should never fail
	move	t3,t1		;copy status word
	hrroi	t1,[asciz/
[ERROR - fork is frozen: Report to system programming staff]
	txze	t3,rf%frz	;is the fork frozen ?
	 psout%			;yes, unpleasant error
	hlrzs	t3,t3		;get just the status code
	cain	t3,.rfhlt	;process halted normally ?
	 retskp			;yes, return success
	caie	t3,.rffpt	;forced process termination ?
	 jrst	bad		;no, so wfork should never have returned
	tmsg	<
[ERROR - fork has been halted due to forced termination - report to
DOCAS systems programming staff]
	retskp			;but we cannot continue it
bad:	movei	t1,7		;get a bell
	pbout%			;write it
	tmsg	<
[ERROR: WFORK has returned although process has not halted. Report
immediately to DOCAS staff.]
	ret			;allow program to continue