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%
err==2
rsb==1
inton:
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
jfns%
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
end