perm filename PROCSS[S,AIL]3 blob
sn#019046 filedate 1973-01-07 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00007 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 HISTORY
C00003 00003 EXECS FOR SPROUT
C00006 00004 EXECS FOR DEPENDENTS
C00008 00005 AN EXEC TO SET UP A KILL LIST VAR -- IF NEED ONE
C00010 00006 EXECS FOR EVENTS
C00011 00007 EXECS FOR POLLING
C00014 ENDMK
C⊗;
COMMENT ⊗HISTORY
AUTHOR,REASON
021 002000000012 ⊗;
COMMENT ⊗
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
HLRZ LPSA,%TLINK(LPSA) ;PROCEDURE SEMBLK
HRRZ PNT,$VAL(LPSA) ;PD SEMBLK
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
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)
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
TLNN TBITS,SIMPLE!EXTRNL ;OR EXTERNAL
SKIPE SIMPSW ;OR INSIDE A SIMPLE PROC
POPJ P, ;YES
;;#IY#
MOVE PNT,GENLEF+2 ;LOOK AT THE BEGIN
;;#JM# RHT 10-4-72 ↓ MOVE KILL SET IN BLOCK SEMBLK (2 OF 3)
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
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
MOVE PNT,GENLEF+2
;;#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)
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)
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,
COMMENT ⊗EXECS FOR POLLING⊗
ZERODATA ()
↑POLINT: 0 ;INTERVAL (NO OF INSTRUCTIONS) TO PUT OUT BETWEEN POLLS
;IF ≤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
COMMENT ⊗REQPLL -- SETS POLINT⊗
↑REQPLL:
MOVE PNT,GENLEF+1 ;
PUSHJ P,GETAD ;GET SEMANTICS
TLNE TBITS,CNST ;BETTER BE CONSTANT INTEGER
TRNN TBITS,INTEGR ;
ERR <INVALID SPEC TO REQUIRE>,1,REQPX
MOVE A,$VAL(PNT) ;GET VALUE
MOVEM A,POLINT ;
JUMPG A,INMAIN
REQPX: POPJ P,
BEND PROCSS