MUDDLE/mproc.save

   1 ;THESE SECTIONS OF CODE HAVE BEEN ABLATED FROM NEVAL 114
   2 ;SO THAT THE TIDE OF HISTORY MAY WASH OVER THE BONES OF THE MULTI-
   3 ;PROCESSED AGGRESSORS
   4
   5
   6 ;THE FIRST IS THE WAY THE SYSTEM USED TO DO EVALUATIONS WITH
   7 ;RESPECT TO FRAMES-- NOW CALLED EWRTFM.
   8
   9 \r       MOVE    A,3(AB)
  10         HRRZ    D,2(AB)         ;GET POINTER TO PV DOPE WORD
  11         PUSHJ   P,SWAPQ         ;SEE IF SWAP NECESSARY
  12         PUSH    TP,(D)
  13         PUSH    TP,1(D)
  14         MCALL   1,EVAL          ;NOW DO NORMAL EVALUATION
  15 UNSWPQ: MOVE    D,1(TB)         ;GET SAVED PVP
  16         CAMN    D,PVP   ;CHANGED?
  17         JRST    FINIS           ;NO - RETURN
  18         PUSHJ   P,SPECSTORE     ;CLEAN UP
  19         MOVE    D,(TB)
  20         JSP     C,SWAP          ;SWAP OUT AND BACK
  21         JRST    FINIS
  22
  23
  24 ; ROUTINE TO CHANGE PROCID AND POSSIBLY SWAP
  25
  26 SWAPQ:  HLRZ    C,(D)           ;GET LENGTH
  27         SUBI    D,-1(C)         ;POINT TO START OF PV
  28         MOVNS   C               ;NEGATE LENGTH
  29         HRLI    D,2(C)          ;MAKE AOBJN POINTER
  30         MOVE    E,PVP           ;COPY CURRENT PROCESS VECTOR
  31         POP     P,B             ;GET RET ADR SO POPJ WINS IF SWAP OCCURS
  32         CAME    D,PVP           ;IS THIS IT?
  33         JSP     C,SWAP          ;NO, SWAP IN NEW PROCESS
  34         PUSH    P,B             ;NOW, PUT IT BACK
  35         PUSH    TP,$TPVP        ;SAVE PROCESS
  36         PUSH    TP,E
  37         HLL     B,OTBSAV(A)     ;GET TIME FROM FRAME POINTED AT
  38         HRR     B,A
  39         HRRZ    C,A
  40         CAIG    C,1(TP)
  41         CAME    B,A             ;CHECK THAT THE FRAME IS LEGIT
  42         JRST    ILLFRA
  43         HLRZ    C,FSAV(C)
  44         CAIE    C,TENTRY
  45         JRST    ILLFRA
  46         CAMN    SP,SPSAV(A)
  47         JRST    AEV1
  48         MOVE    SP,SPSAV(A)     ;LOAD UP OLD ENVIRONMENT
  49         MOVE    A,PVP
  50         ADD     A,[PROCID,,PROCID]      ;GET LOCATIVE TO PROCESS ID
  51         PUSH    TP,BNDV         ;BIND IT TO
  52         PUSH    TP,A
  53         AOSN    A,PTIME         ;A UNIQUE NUMBER
  54         .VALUE  [ASCIZ /TIMEOUT/]
  55         PUSH    TP,$TFIX
  56         PUSH    TP,A
  57         PUSHJ   P,SPECBIND
  58 AEV1:   MOVE    E,1(TB)         ;GET SAVED PROCESS
  59         MOVE    D,AB            ;COPY CURRENT ARG POINTER
  60         CAME    E,PVP           ;HAS PROCESS CHANGED?
  61         MOVE    D,ABSTO+1(E)    ;GET SAV AB
  62         POPJ    P,              ;RETURN TO CALLER
  63
  64
  65
  66 ;THIS FRAGMENT FROM THE EVALUATOR IS WHERE THE SYSTEM USED TO
  67 ;COME TO DO "RESUME."  SOME DAY, NO DOUBT, IT WILL AGAIN.
  68
  69
  70 RESOMER:
  71 ; 0,1(TB) IS PROCESS VECTOR POINTER TO PROCESS TO BE RESUMED
  72 ; 0,1(AB) IS A FORM CONTAINING ARGS TO SAVED FUNTION
  73
  74         MOVE    D,1(TB)         ;GET PVP OF PROCESS TO BE RESUMED
  75         GETYP   A,RESFUN(D)     ; GET TYPE OF FUNCTION
  76
  77         CAIN    A,TSUBR         ;SUBR?
  78         JRST    RESSUBR         ;YES
  79         CAIN    A,TFSUBR        ;NO -- FSUBR?
  80         JRST    RESFSUBR                ;YES
  81         CAIN    A,TEXPR         ;NO -- EXPR?
  82         JRST    RESEXPR         ;YES
  83         CAIN    A,TFIX          ;NO -- CALL TO NTH?
  84         JRST    RESNUM          ;YES
  85         CAIN    A,TFUNARG       ;NO -- FUNARG?
  86         JRST    NOTIMP  ;YES
  87         JRST    NAPT            ;NONE OF THE ABOVE
  88
  89
  90 ;RESFSUBR RESUMES FSUBRS
  91
  92 RESFSUBR:
  93         HRRZ    A,@1(AB)        ;GET THE ARG LIST
  94         SUB     TP,[2,,2]       ;CLEAN UP
  95         JSP     C,SWAP          ;SWAP IN NEW PROCESS
  96         PUSH    TP,$TLIST
  97         PUSH    TP,A            ; PUSH THE ARG LIST
  98         MCALL   1,@RESFUN+1(PVP) ; RESUME WITH THE SAVED FUNCTION
  99         JRST    FINIS
 100
 101 ;RESSUBR RESUMES SUBRS
 102
 103 RESSUBR:
 104         HRRZ    A,@1(AB)        ;GET CDR OF FORM -- ARGLIST
 105         PUSH    TP,$TLIST       ;SAVE THE ARGLIST ON
 106         PUSH    TP,A            ;THE TP
 107         PUSH    P,[0]           ;MAKE SLOT FOR ARGCNT
 108 RESTUPLUP:
 109         SKIPN   A,3(TB)         ;IS IT NIL?
 110         JRST    RESMAKPTR               ;YES -- DONE
 111         PUSH    TP,(A)          ;NO -- GET CAR OF THE
 112         HLLZS   (TP)            ;ARGLIST
 113         PUSH    TP,1(A)
 114         JSP     E,CHKARG
 115         MCALL   1,EVAL          ;AND EVAL IT.
 116         MOVE    D,1(TB) ;GET PVP OF P.T.B.R.
 117         MOVE    C,TPSTO+1(D)    ;GET TP OF P.T.B.R.
 118         PUSH    C,A             ;SAVE THE RESULT IN THE GROWING
 119         PUSH    C,B             ;TUPLE OF ARGS IN P.T.B.R.
 120         MOVEM   C,TPSTO+1(D)    ;UPDATE TP OF P.T.B.R.
 121         AOS     (P)             ;BUMP THE ARGCNT
 122         HRRZ    A,@3(TB)        ;SET THE ARGLIST TO
 123         MOVEM   A,3(TB)         ;CDR OF THE ARGLIST
 124         JRST    RESTUPLUP
 125 RESMAKPTR:
 126         POP     P,A             ;GET NUMBER OF ARGS IN A
 127         MOVE    D,1(TB)         ;GET PVP OF P.T.B.R.
 128         SUB     TP,[4,,4]       ;GET RID OF GARBAGE
 129         JSP     C,SWAP          ;SWAP IN THE NEW PROCESS
 130         ACALL   A,RESFUN+1(PVP) ;CALL THE SAVED FUNCTION
 131         JRST    FINIS
 132
 133
 134
 135 ;RESNUM INTERPRETS NUMBERS AS CALL TO FUNCTION GET
 136
 137 RESNUM:
 138         HRRZ    A,@1(AB)        ;GET ARGLIST
 139         JUMPE   A,ERRTFA        ;NO ARGUMENT
 140         PUSH    TP,(A)          ;GET CAR OF ARGL
 141         HLLZS   (TP)
 142         PUSH    TP,1(A)
 143         HRRZ    A,(A)           ;MAKE SURE ONLY ONE ARG
 144         JUMPN   A,ERRTMA
 145         JSP     E,CHKARG        ;HACK DEFERRED
 146         MCALL   1,EVAL
 147         MOVE    D,1(TB)         ;GET PVP OF P.T.B.R.
 148         MOVE    C,TPSTO+1(D)    ;GET TP OF P.T.B.R.
 149         PUSH    C,A             ;PUSH ARG
 150         PUSH    C,B
 151         SUB     TP,[2,,2]       ;CLEAN UP BEFORE LEAVING
 152         JSP     C,SWAP          ;BRING IN NEW PROCESS
 153         PUSH    TP,RESFUN(PVP)  ;PUSH NUMBER
 154         PUSH    TP,RESFUN+1(PVP)
 155         MCALL   2,NTH
 156         JRST    FINIS
 157
 158 ;RESEXPR RESUMES EXPRS
 159 ;EXPRESSION IS IN 0(AB),  FUNCTION IS IN RESFUN(PVP)
 160 RESEXPR:
 161         SKIPN   C,RESFUN+1(D);BODY?
 162         JRST    NOBODY          ;NO, ERROR
 163
 164         MOVE    C,TPSTO+1(D)    ;GET TP OF P.T.B.R.
 165         PUSH    C,BNDA          ;SPECIAL ATOM CROCK
 166         PUSH    C,MQUOTE [PPROC ],INTRUP ;PPROC=PARENT PROCESS
 167         MOVE    B,OTBSAV(TB)
 168         PUSHJ   P,MAKENV        ;MAKE ENVIRONMENT FOR THIS PROCESS
 169         PUSH    C,A
 170         PUSH    C,B
 171         MOVEM   C,TPSTO+1(D)    ;UPDATE TP OF P.T.B.R.
 172         HRRZ    0,1(AB)         ;GET EXPRESSION INTO 0
 173         HRRZ    A,@0            ;AND ARGLIST INTO A
 174         HLL     0,(AB)          ;TYPE TO LH OF  0
 175         SUB     TP,[2,,2]       ;CLEAN UP BEFORE LEAVING
 176         JSP     C,SWAP          ;SWAP IN NEW PROCESS
 177         PUSH    P,0             ;SAVE 0
 178         PUSH    P,A             ;SAVE A=ARGLIST
 179         PUSH    TP,[0]
 180         PUSH    TP,[0]          ;COMPLETE ARGS FOR PPROC BINDING
 181         PUSHJ   P,SPECBIND      ;BIND THE PARENT PROCESS
 182         POP     P,D             ;POP ARGLIST INTO D
 183         POP     P,0             ;POP CALL HACK INTO 0
 184         MOVE    C,RESFUN+1(PVP) ;GET FUNCTION
 185         PUSHJ   P,BINDRR        ;CALL BINDER FOR RESUMED EXPR HACKING
 186
 187         HRRZ    C,@RESFUN+1(PVP) ;GET BODY BACK
 188         JUMPE   A,DOPROG        ;NOW GO RUN IF NO ACTIVIATION
 189         PUSH    TP,$TLIST       ;SAVE ANOTHER COPY FOR REACT
 190         PUSH    TP,C
 191         SKIPL   A               ;SKIP IF NOT NAME ALA HEWITT
 192         HRRZ    C,(C)           ;ELSE CDR AGAIN
 193         JRST    DOPROG
 194
 195 ;THE FOLLOWING FRAGMENT (INCLUDING COMMENT), IS
 196 ;FROM THE BINDER, WHICH USED TO ATTEMPT TO BIND RESUMED FUNCTIONS,
 197 ;OR SOME SUCH THING, AND, I HAVE FAITH, WILL RISE FROM THE
 198 ;ASHES TO ATTEMPT IT AGAIN.
 199
 200 ;THIS ONE IS FOR MULTI-PROCESSING
 201
 202 RSRGEV: JSP     E,CHKARG
 203         MOVE    B,MQUOTE [PPROC ],INTRUP
 204         PUSHJ   P,ILVAL
 205         PUSH    TP,A
 206         PUSH    TP,B
 207 \r       MCALL   2,EVAL
 208         POPJ    P,\f\ 3\f