perm filename PROCSS[NEW,AIL] blob
sn#408218 filedate 1979-01-08 generic text, type T, neo UTF8
COMMENT ⊗HISTORY
AUTHOR,REASON
021 102100000005 ⊗;
COMMENT ⊗
VERSION 17-1(5) 12-8-73 BY JRL REMOVE SPECIAL STANFORD CHARACTERS(WHERE POSSIBLE)
VERSION 17-1(4) 12-6-73 BY RHT BUG #PQ# NEEDED TO SET UP AN AC
VERSION 17-1(3) 12-6-73
VERSION 17-1(2) 11-25-73 BY JRL MOVE REQPLL TO GEN, WHERE IT BELONGS
VERSION 17-1(1) 11-25-73
VERSION 17-1(0) 7-26-73 BY RHT **** VERSION 17 ****
VERSION 16(11) 7-15-73 BY RHT ADD SETCP & SETIP & PROVISION FOR SPROUT APPLY
VERSION 16(10) 1-7-73 BY RHT ADD EXEC FOR DEPENDENTS
VERSION 16(9) 11-30-72 BY RHT ADD EXECS FOR POLLING
VERSION 16(8) 11-24-72 BY RHT CURE POTENTIAL LOSSAGE WITH EXT PROCS
VERSION 16(7) 11-21-72 BY RHT BUG #KG# -- ALLSTO MISSING BEFORE SPROUT
VERSION 16(6) 10-4-72 BY RHT BUG #JM# BLOCK GETTING CONFUSED BY TBITS WORD LOSSAGE
VERSION 16(5) 9-25-72 BY RHT BUG #IY# LIMIT CASES IN WHICH BLOCK GETS A KILL SET
VERSION 16(4) 9-25-72
VERSION 16(3) 9-25-72
VERSION 16(2) 9-25-72
VERSION 16(1) 9-25-72
⊗;
COMMENT ⊗EXECS FOR SPROUT⊗
BEGIN PROCSS
↑STDOPT: MOVEI A,0 ;STANDARD CASE IS ALL ZERO
PUSHJ P,CREINT ;
GENMOV(STACK,GETD) ;STACK IT
POPJ P,
;;#KG# RHT ! (11-21-72) REMEMBER THE ALLSTO
↑SPRIT: PUSHJ P,ALLSTO ;
XCALL (SPROUT)
SETZM ADEPTH ;PRETTY ARBITRARY
SETZM SDEPTH ;
FREBLK GENLEF+1
POPJ P,
↑FPREM: GETBLK GENRIG+1
MOVE PNT,GENLEF+1 ;THE PROCEDURE ID
HRRM PNT,$VAL2(LPSA) ;REMEMBER THE PROC WE FORKED
POPJ P,
↑SPRPD: MOVE LPSA,GENLEF+2
;;#PQ# RHT 12-6-73 WASN'T LOADING PNT2
HLRZ PNT2,%TLINK(LPSA) ;PROCEDURE SEMBLK
HRRZ PNT,$VAL(PNT2) ;PD SEMBLK
;;#PQ#
HRRZI D,TEMP ;
PUSHJ P,LODPDA ;GET THE PDA
;NOW PUSH IT
HRLI C,TEMP
EMIT <PUSH RP,NOUSAC!NORLC!USADDR>
AOS ADEPTH
POPJ P,
STDKL1: SKIPA PNT,GENLEF+2
↑STDKLL: ;STANDARD KILL LIST
MOVE PNT,GENLEF+1 ;FORK SEMBLK
HRRZ PNT2,$VAL2(PNT) ;THE PROCEDURE WE FORKED
;;# # RHT ARRANGE FOR SPROUT APPLY
CAIN PNT2,-1 ;
JRST [ MOVE LPSA,TOPBLK ;SPROUT APPLY MUST DEPEND ON TOP BLK
JRST SKLG]
HLRZ LPSA,%TLINK(PNT2) ;THE SECOND BLOCK
HLRZ LPSA,%SAVET(LPSA) ;OLD TTOP
;;#JM# RHT MOVE KILL SET PTR (10-4-72) ! (1 OF 3)
SKLG: HRRZ PNT,$ACNO(LPSA) ;THE KILL LIST
TRNN PNT,-1 ;WE BETTER HAVE ONE
ERR <THERE IS NO DEFAULT KILL SET FOR THIS PROCEDURE>
EMIT <HRRZI TEMP,NOUSAC>
HRLI C,TEMP
EMIT <PUSH RP,NOUSAC!USADDR!NORLC>
AOS ADEPTH
POPJ P,
↑BNKLL:
ERR <KILL LIST BY BLOCK NAME NOT IMPLEMENTED>,1
JRST STDKLL
↑EKLL:
MOVE PNT,GENLEF ;PICK UP THE SET
PUSHJ P,GETAD ;GET SEMANTICS
TLNN TBITS,SET ;MUST BE A SET
JRST KSER
TLNE TBITS,SAFE
TRNN TBITS,INTEGR ;BE SURE KILL SET
KSER: ERR <NOT A KILL SET>,1
GENMOV (STACK,0) ;STACK IT
POPJ P,
↑STKOPT:
MOVE PNT,GENLEF+1
GENMOV (STACK,GETD)
POPJ P,
COMMENT ⊗EXECS FOR DEPENDENTS ⊗
↑BDEPS: MOVE PNT,GENLEF+1
MOVE TBITS2,PPSAV ;PARSE STACK
MOVE SBITS2,GPSAV ;GEN STACK
BCHK: HRRZ C,(TBITS2) ;GET TOKEN
CAMN C,%NBLAT ;TOP OF IT ALL?
ERR <BLOCK NAME NOT FOUND FOR "DEPENDENTS">,1,NLLVAL
CAME C,%NBEG
JRST NXTOK ;NOT A BEGIN
SKIPGE PNT2,(SBITS2) ;SEMANTICS?
SKIPN A,$PNAME+1(PNT2) ;BLOCK NAME?
JRST NXTOK ;NONE
PUSH SP,$PNAME(PNT2) ;
PUSH SP,A ;THIS BLOCK NAME
PUSH SP,$PNAME(PNT) ;
PUSH SP,$PNAME+1(PNT) ;THE ASKED FOR NAME
PUSHJ P,EQU ;COMPARE
JUMPN A,BDGOT ; EQUAL
NXTOK: SOS SBITS2 ;LOOK ON
SOJA TBITS2,BCHK ;
BDGOT: HRRZ A,$ACNO(PNT2) ;KILL SET SEMBLK
JUMPE A,NVCHK ;NO KILL SET
MOVEM A,GENLEF+1 ;KLUGE TO SET PARAM TO STSET
PUSHJ P,STSET ;
MOVE A,GENRIG+1 ;FINISH OUT KLUGE
MOVEM A,GENRIG ;
POPJ P,
NVCHK: ERR < THIS BLOCK IS NOT KNOWN TO BE ABLE TO HAVE DEPENDENTS >,1
NLLVAL: JRST LPPHI ;
COMMENT ⊗AN EXEC TO SET UP A KILL LIST VAR -- IF NEED ONE ⊗
KLNAM: XWD 0,6
POINT 7,.+1
ASCII /KLST../ ;KILL LIST VARIABLE
↑KLSET: ;DECLARE KILL LIST VARIABLE
MOVE TBITS,BITS ;IS THE NEW PROCEDURE SIMPLE?
;;#IY# RHT (9-25-72) RESTRICT CIRCUMSTANCES IN WHICH KILL SET GOES OUT
TDNN TBITS,[SIMPLE!FORTRAN] ;
SKIPE SIMPSW ;OR INSIDE A SIMPLE PROC
POPJ P, ;YES
;;#LR# RHT -- KILL SET FOR EXTERNAL PROCS IS THE OUTER BLOCK
TLNE TBITS,EXTRNL ;OR EXTERNAL
SKIPN PNT,QQBLK ;GET OUTER BLOCK
;;#LR#
;;#IY#
MOVE PNT,GENLEF+2 ;LOOK AT THE BEGIN
;;#JM# RHT 10-4-72 ! MOVE KILL SET IN BLOCK SEMBLK (2 OF 3)
KLS1: MOVE TEMP,$ACNO(PNT) ;DO WE HAVE ONE???
TRNE TEMP,-1
POPJ P, ;THERE IS ONE ALREADY
PUSH P,PNAME
PUSH P,PNAME+1 ;SAVE MUCH CRUFT
PUSH P,HPNT
PUSH P,BITS
PUSH P,NEWSYM
PUSH P,PNT
SETZM NEWSYM
HRROI TEMP,KLNAM+1
POP TEMP,PNAME+1
POP TEMP,PNAME
MOVE TEMP,[XWD SAFE,SET!INTEGR]
MOVEM TEMP,BITS
MOVE LPSA,SYMTAB
PUSHJ P,SHASH
PUSHJ P,ENTERS
MOVE TEMP,NEWSYM
POP P,PNT
;;#JM# RHT 10-4-72 ! MOVE KILL SET IN BLOCK SEMBLK (3 OF 3)
HRRM TEMP,$ACNO(PNT)
POP P,NEWSYM ;PUT EM BACK
POP P,BITS ;THE WAY THEY WAS
POP P,HPNT
POP P,PNAME+1
POP P,PNAME
POPJ P, ;RETURN -- NO PERMANENT DAMAGE (I HOPE)
↑KLSTG: MOVE PNT,GENLEF+1 ;OUTER BLOCK SEMBLK
MOVEM PNT,TOPBLK ;REMEMBER THE TOP BLOCK
JRST KLS1 ;GET HIM A KILL SET
ZERODATA()
TOPBLK: 0 ;USED TO HOLD A POINTER AT THE OUTER BLOCK SEMBLK
ENDDATA
COMMENT ⊗EXECS FOR EVENTS⊗
↑CSIT: PUSHJ P,ALLSTO
XCALL (CAUSE)
MOVNI A,3
ADDM A,ADEPTH
POPJ P,
↑STKIRG: MOVE TBITS,@LEAPSK
TLNN TBITS,LPITM
JRST BNDLST ;IT BETTER BE A LIST OR THE LIKE
JRST BNDITM ;AN ITEM
↑IRIT: PUSHJ P,ALLSTO
XCALL (INTERROGATE)
ADACPJ: MOVNI A,2
ADDM A,ADEPTH
POPJ P,
↑TYPIRG: MOVEI TBITS,ITMVAR
MOVEI SBITS,0
MOVEI D,A
GENMOV (MARK,0)
MOVEM PNT,GENRIG
MOVE A,[XWD CLSIDX,TITV]
MOVEM A,PARRIG
POPJ P,
↑SCPCLL: PUSHJ P,ALLSTO
XCALL(SETCP)
JRST ADACPJ
↑SIPCLL: PUSHJ P,ALLSTO
XCALL(SETIP)
JRST ADACPJ
COMMENT ⊗EXECS FOR POLLING⊗
ZERODATA ()
↑POLINT: 0 ;INTERVAL (NO OF INSTRUCTIONS) TO PUT OUT BETWEEN POLLS
;IF LEQ 0 THEN DONT PUT OUT ANY POLLS AUTOMATICALLY
PPCNT: 0 ;PCNT AT TIME OF LAST EPOLL
ENDDATA
COMMENT ⊗ EPOLL ALWAYS PUTS OUT A POLL -- PRESERVES ALL ACS
EXCEPT PERHAPS TEMP & LPSA
⊗
↑EPOLL: PUSH P,A ;SO ALL IMPORTANT ACS SAVED
PUSH P,C
HRLZ C,PCNT
MOVSM C,PPCNT ;REMEMBER THIS DAY
EXCH C,LIBTAB+RINTRPT;
EMIT <SKIPE NOUSAC!USADDR>
XCALL <DDFINT> ;DO DEFERED INTERRUPT
POP P,C ;
POP P,A ;
POPJ P,
COMMENT ⊗ CAPOLL PUTS OUT A POLL IF WE REQUIRE AUTO POLLING AND
A POLL HASNT GONE OUT RECENTLY -- THIS EXEC IS
CALLED AT STATEMENT LEVEL
⊗
↑CAPOLL:
SKIPG A,POLINT ;
POPJ P, ;NONE GO OUT AUTOMATICALLY
ADD A,PPCNT ;
CAMLE A,PCNT ;IS IT TIME
POPJ P, ;NO
JRST EPOLL ;YES
COMMENT ⊗ APOLL PUTS OUT A POLL IF WE REQUIRE AUTO POLLING ⊗
↑APOLL: SKIPG POLINT ;AUTO POLLING?
POPJ P, ;NO
JRST EPOLL ;YES
BEND PROCSS