--- /dev/null
+;THESE SECTIONS OF CODE HAVE BEEN ABLATED FROM NEVAL 114
+;SO THAT THE TIDE OF HISTORY MAY WASH OVER THE BONES OF THE MULTI-
+;PROCESSED AGGRESSORS
+
+
+;THE FIRST IS THE WAY THE SYSTEM USED TO DO EVALUATIONS WITH
+;RESPECT TO FRAMES-- NOW CALLED EWRTFM.
+
+\r MOVE A,3(AB)
+ HRRZ D,2(AB) ;GET POINTER TO PV DOPE WORD
+ PUSHJ P,SWAPQ ;SEE IF SWAP NECESSARY
+ PUSH TP,(D)
+ PUSH TP,1(D)
+ MCALL 1,EVAL ;NOW DO NORMAL EVALUATION
+UNSWPQ: MOVE D,1(TB) ;GET SAVED PVP
+ CAMN D,PVP ;CHANGED?
+ JRST FINIS ;NO - RETURN
+ PUSHJ P,SPECSTORE ;CLEAN UP
+ MOVE D,(TB)
+ JSP C,SWAP ;SWAP OUT AND BACK
+ JRST FINIS
+
+
+; ROUTINE TO CHANGE PROCID AND POSSIBLY SWAP
+
+SWAPQ: HLRZ C,(D) ;GET LENGTH
+ SUBI D,-1(C) ;POINT TO START OF PV
+ MOVNS C ;NEGATE LENGTH
+ HRLI D,2(C) ;MAKE AOBJN POINTER
+ MOVE E,PVP ;COPY CURRENT PROCESS VECTOR
+ POP P,B ;GET RET ADR SO POPJ WINS IF SWAP OCCURS
+ CAME D,PVP ;IS THIS IT?
+ JSP C,SWAP ;NO, SWAP IN NEW PROCESS
+ PUSH P,B ;NOW, PUT IT BACK
+ PUSH TP,$TPVP ;SAVE PROCESS
+ PUSH TP,E
+ HLL B,OTBSAV(A) ;GET TIME FROM FRAME POINTED AT
+ HRR B,A
+ HRRZ C,A
+ CAIG C,1(TP)
+ CAME B,A ;CHECK THAT THE FRAME IS LEGIT
+ JRST ILLFRA
+ HLRZ C,FSAV(C)
+ CAIE C,TENTRY
+ JRST ILLFRA
+ CAMN SP,SPSAV(A)
+ JRST AEV1
+ MOVE SP,SPSAV(A) ;LOAD UP OLD ENVIRONMENT
+ MOVE A,PVP
+ ADD A,[PROCID,,PROCID] ;GET LOCATIVE TO PROCESS ID
+ PUSH TP,BNDV ;BIND IT TO
+ PUSH TP,A
+ AOSN A,PTIME ;A UNIQUE NUMBER
+ .VALUE [ASCIZ /TIMEOUT/]
+ PUSH TP,$TFIX
+ PUSH TP,A
+ PUSHJ P,SPECBIND
+AEV1: MOVE E,1(TB) ;GET SAVED PROCESS
+ MOVE D,AB ;COPY CURRENT ARG POINTER
+ CAME E,PVP ;HAS PROCESS CHANGED?
+ MOVE D,ABSTO+1(E) ;GET SAV AB
+ POPJ P, ;RETURN TO CALLER
+
+
+
+;THIS FRAGMENT FROM THE EVALUATOR IS WHERE THE SYSTEM USED TO
+;COME TO DO "RESUME." SOME DAY, NO DOUBT, IT WILL AGAIN.
+
+
+RESOMER:
+; 0,1(TB) IS PROCESS VECTOR POINTER TO PROCESS TO BE RESUMED
+; 0,1(AB) IS A FORM CONTAINING ARGS TO SAVED FUNTION
+
+ MOVE D,1(TB) ;GET PVP OF PROCESS TO BE RESUMED
+ GETYP A,RESFUN(D) ; GET TYPE OF FUNCTION
+
+ CAIN A,TSUBR ;SUBR?
+ JRST RESSUBR ;YES
+ CAIN A,TFSUBR ;NO -- FSUBR?
+ JRST RESFSUBR ;YES
+ CAIN A,TEXPR ;NO -- EXPR?
+ JRST RESEXPR ;YES
+ CAIN A,TFIX ;NO -- CALL TO NTH?
+ JRST RESNUM ;YES
+ CAIN A,TFUNARG ;NO -- FUNARG?
+ JRST NOTIMP ;YES
+ JRST NAPT ;NONE OF THE ABOVE
+
+
+;RESFSUBR RESUMES FSUBRS
+
+RESFSUBR:
+ HRRZ A,@1(AB) ;GET THE ARG LIST
+ SUB TP,[2,,2] ;CLEAN UP
+ JSP C,SWAP ;SWAP IN NEW PROCESS
+ PUSH TP,$TLIST
+ PUSH TP,A ; PUSH THE ARG LIST
+ MCALL 1,@RESFUN+1(PVP) ; RESUME WITH THE SAVED FUNCTION
+ JRST FINIS
+
+;RESSUBR RESUMES SUBRS
+
+RESSUBR:
+ HRRZ A,@1(AB) ;GET CDR OF FORM -- ARGLIST
+ PUSH TP,$TLIST ;SAVE THE ARGLIST ON
+ PUSH TP,A ;THE TP
+ PUSH P,[0] ;MAKE SLOT FOR ARGCNT
+RESTUPLUP:
+ SKIPN A,3(TB) ;IS IT NIL?
+ JRST RESMAKPTR ;YES -- DONE
+ PUSH TP,(A) ;NO -- GET CAR OF THE
+ HLLZS (TP) ;ARGLIST
+ PUSH TP,1(A)
+ JSP E,CHKARG
+ MCALL 1,EVAL ;AND EVAL IT.
+ MOVE D,1(TB) ;GET PVP OF P.T.B.R.
+ MOVE C,TPSTO+1(D) ;GET TP OF P.T.B.R.
+ PUSH C,A ;SAVE THE RESULT IN THE GROWING
+ PUSH C,B ;TUPLE OF ARGS IN P.T.B.R.
+ MOVEM C,TPSTO+1(D) ;UPDATE TP OF P.T.B.R.
+ AOS (P) ;BUMP THE ARGCNT
+ HRRZ A,@3(TB) ;SET THE ARGLIST TO
+ MOVEM A,3(TB) ;CDR OF THE ARGLIST
+ JRST RESTUPLUP
+RESMAKPTR:
+ POP P,A ;GET NUMBER OF ARGS IN A
+ MOVE D,1(TB) ;GET PVP OF P.T.B.R.
+ SUB TP,[4,,4] ;GET RID OF GARBAGE
+ JSP C,SWAP ;SWAP IN THE NEW PROCESS
+ ACALL A,RESFUN+1(PVP) ;CALL THE SAVED FUNCTION
+ JRST FINIS
+
+
+
+;RESNUM INTERPRETS NUMBERS AS CALL TO FUNCTION GET
+
+RESNUM:
+ HRRZ A,@1(AB) ;GET ARGLIST
+ JUMPE A,ERRTFA ;NO ARGUMENT
+ PUSH TP,(A) ;GET CAR OF ARGL
+ HLLZS (TP)
+ PUSH TP,1(A)
+ HRRZ A,(A) ;MAKE SURE ONLY ONE ARG
+ JUMPN A,ERRTMA
+ JSP E,CHKARG ;HACK DEFERRED
+ MCALL 1,EVAL
+ MOVE D,1(TB) ;GET PVP OF P.T.B.R.
+ MOVE C,TPSTO+1(D) ;GET TP OF P.T.B.R.
+ PUSH C,A ;PUSH ARG
+ PUSH C,B
+ SUB TP,[2,,2] ;CLEAN UP BEFORE LEAVING
+ JSP C,SWAP ;BRING IN NEW PROCESS
+ PUSH TP,RESFUN(PVP) ;PUSH NUMBER
+ PUSH TP,RESFUN+1(PVP)
+ MCALL 2,NTH
+ JRST FINIS
+
+;RESEXPR RESUMES EXPRS
+;EXPRESSION IS IN 0(AB), FUNCTION IS IN RESFUN(PVP)
+RESEXPR:
+ SKIPN C,RESFUN+1(D);BODY?
+ JRST NOBODY ;NO, ERROR
+
+ MOVE C,TPSTO+1(D) ;GET TP OF P.T.B.R.
+ PUSH C,BNDA ;SPECIAL ATOM CROCK
+ PUSH C,MQUOTE [PPROC ],INTRUP ;PPROC=PARENT PROCESS
+ MOVE B,OTBSAV(TB)
+ PUSHJ P,MAKENV ;MAKE ENVIRONMENT FOR THIS PROCESS
+ PUSH C,A
+ PUSH C,B
+ MOVEM C,TPSTO+1(D) ;UPDATE TP OF P.T.B.R.
+ HRRZ 0,1(AB) ;GET EXPRESSION INTO 0
+ HRRZ A,@0 ;AND ARGLIST INTO A
+ HLL 0,(AB) ;TYPE TO LH OF 0
+ SUB TP,[2,,2] ;CLEAN UP BEFORE LEAVING
+ JSP C,SWAP ;SWAP IN NEW PROCESS
+ PUSH P,0 ;SAVE 0
+ PUSH P,A ;SAVE A=ARGLIST
+ PUSH TP,[0]
+ PUSH TP,[0] ;COMPLETE ARGS FOR PPROC BINDING
+ PUSHJ P,SPECBIND ;BIND THE PARENT PROCESS
+ POP P,D ;POP ARGLIST INTO D
+ POP P,0 ;POP CALL HACK INTO 0
+ MOVE C,RESFUN+1(PVP) ;GET FUNCTION
+ PUSHJ P,BINDRR ;CALL BINDER FOR RESUMED EXPR HACKING
+
+ HRRZ C,@RESFUN+1(PVP) ;GET BODY BACK
+ JUMPE A,DOPROG ;NOW GO RUN IF NO ACTIVIATION
+ PUSH TP,$TLIST ;SAVE ANOTHER COPY FOR REACT
+ PUSH TP,C
+ SKIPL A ;SKIP IF NOT NAME ALA HEWITT
+ HRRZ C,(C) ;ELSE CDR AGAIN
+ JRST DOPROG
+
+;THE FOLLOWING FRAGMENT (INCLUDING COMMENT), IS
+;FROM THE BINDER, WHICH USED TO ATTEMPT TO BIND RESUMED FUNCTIONS,
+;OR SOME SUCH THING, AND, I HAVE FAITH, WILL RISE FROM THE
+;ASHES TO ATTEMPT IT AGAIN.
+
+;THIS ONE IS FOR MULTI-PROCESSING
+
+RSRGEV: JSP E,CHKARG
+ MOVE B,MQUOTE [PPROC ],INTRUP
+ PUSHJ P,ILVAL
+ PUSH TP,A
+ PUSH TP,B
+\r MCALL 2,EVAL
+ POPJ P,\f\ 3\f
\ No newline at end of file
projects / pdp10-muddle.git / blobdiff