sumex/create.mcr035

   1 TITLE PROCESS-HACKER FOR MUDDLE\r
   2 \r
   3 RELOCATABLE\r
   4 \r
   5 .INSRT MUDDLE >\r
   6 \r
   7 .GLOBAL ICR,NAPT,IGVAL,CHKARG,RESFUN,RETPROC,SWAP,MAINPR,PROCHK,NOTRES\r
   8 .GLOBAL PSTAT,LSTRES,TOPLEV,MAINPR,1STEPR,INCONS\r
   9 .GLOBAL TBINIT,APLQ\r
  10 \r
  11 MFUNCTION PROCESS,SUBR\r
  12 \r
  13         ENTRY 1\r
  14         GETYP   A,(AB)          ;GET TYPE OF ARG\r
  15                                 ;MUST BE SOME APPLIABLE TYPE\r
  16         PUSHJ   P,APLQ\r
  17         JRST    NAPT            ;NO, ERROR - NON-APPLIABLE TYPE\r
  18 OKFUN:\r
  19 \r
  20         PUSHJ   P,ICR   ;CREATE A NEW PROCESS\r
  21         MOVE    C,TPSTO+1(B)    ;GET ITS SRTACK\r
  22         PUSH    C,[TENTRY,,TOPLEV]\r
  23         PUSH    C,[1,,0]        ;TIME\r
  24         PUSH    C,[0]\r
  25         PUSH    C,SPSTO+1(B)\r
  26         PUSH    C,PSTO+1(B)\r
  27         MOVE    D,C\r
  28         ADD     D,[3,,3]\r
  29         PUSH    C,D     ;SAVED STACK POINTER\r
  30         PUSH    C,[SUICID]\r
  31         MOVEM   C,TPSTO+1(B)    ;STORE NEW TP\r
  32         HRRI    D,1(C)  ;MAKE A TB\r
  33         HRLI    D,2     ;WITH A TIME\r
  34         MOVEM   D,TBINIT+1(B)\r
  35         MOVEM   D,TBSTO+1(B)    ;SAVE ALSO FOR SIMULATED START\r
  36         MOVE    C,(AB)  ;STORE ARG\r
  37         MOVEM   C,RESFUN(B)     ;INTO PV\r
  38         MOVE    C,1(AB)\r
  39         MOVEM   C,RESFUN+1(B)\r
  40         MOVEI   0,RUNABL\r
  41         MOVEM   0,PSTAT+1(B)\r
  42         JRST FINIS\r
  43 \r
  44 REPEAT 0,[\r
  45 MFUNCTION       RETPROC,SUBR\r
  46 ; WHO KNOWS WHAT THIS SHOULD REALLY DO\r
  47 ;PROBABLY, JUST AN EXIT\r
  48 ;FOR NOW, PRINT OUT AN ERROR MESSAGE\r
  49         PUSH    TP,$TATOM\r
  50         PUSH    TP,EQUOTE ATTEMPT-TO-RETURN-OUT-OF-PROCESS\r
  51         JRST    CALER1\r
  52 \r
  53 \r
  54 \r
  55 \r
  56 \r
  57 \r
  58 \r
  59 MFUNCTION RESUME,FSUBR\r
  60 ;RESUME IS CALLED WITH TWO ARGS\r
  61 ;THE FIRST IS A PROCESS FORM OF THE PROCESS TO BE RESUMED\r
  62 ;THE SECOND IS A FUNCTION TO BE CALLED WHEN THIS PROCESS\r
  63 ;    (THE PARENT) IS ITSELF RESUMED\r
  64 ;IF THE FUNCTION IS NOT GIVEN SOME STANDARD FUNCTION IS\r
  65 ;PLUGGED IN\r
  66 ;\r
  67 ; NOTE - TYPE AND NUMBER OF ARGS CHECKS MUST BE ADDED TO BOTH RESUME AND CREATE\r
  68 \r
  69         ENTRY   1\r
  70         HRRZ    C,@1(AB)                ;GET CDR ADDRESS\r
  71         JUMPE   C,NOFUN         ;IF NO SECOND ARG, SUPPLY STANDARD\r
  72         HLLZ    A,(C)           ;GET CDR TYPE\r
  73         CAME    A,$TATOM                ;ATOMIC?\r
  74         JRST    RES2            ;NO, MUST EVAL TO GET FUNCTION\r
  75         MOVE    B,1(C)          ;YES\r
  76         PUSHJ   P,IGVAL         ;TRY TO GET GLOBAL VALUE\r
  77         CAMN    A,$TUNBOUND     ;GLOBALLY UNBOUND?\r
  78         JRST    LFUN            ;YES, TRY FOR LOCAL VALUE\r
  79 RES1:   MOVEM   A,RESFUN(PVP)   ;STORE IN THIS PROCESS\r
  80         MOVEM   B,RESFUN+1(PVP)\r
  81 \r
  82         HRRZ    C,1(AB)         ;GET CAR ADDRESS\r
  83         PUSH    TP,(C)          ;PUSH PROCESS FORM\r
  84         PUSH    TP,1(C)\r
  85         JSP     E,CHKARG        ;CHECK FOR DEFERED TYPE\r
  86                                 ;INSERT CHECKS FOR PROCESS FORM\r
  87         MCALL   1,EVAL          ;EVAL PROCESS FORM WHICH WILL SWITCH\r
  88                                 ; PROCESSES\r
  89         JRST    FINIS\r
  90 \r
  91 RES2:   PUSH    TP,(C)          ;PUSH FUNCTION ARG\r
  92         PUSH    TP,1(C)\r
  93         JSP     E,CHKARG        ;CHECK FOR DEFERED\r
  94         MCALL   1,EVAL          ;EVAL TO GET FUNCTION\r
  95         JRST    RES1\r
  96 \r
  97 LFUN:   HRRZ    C,1(AB)         ;GET CDR ADDRESS\r
  98         PUSH    TP,(C)\r
  99         PUSH    TP,1(C)\r
 100         MCALL   1,VALUE ;GET LOCAL VALUE OF ATOM FOR FUNCTION\r
 101         JRST    RES1\r
 102 \r
 103 NOFUN:  MOVSI   A,TUNBOUND      ;MAKE RESUME FUNCTION UNBOUND\r
 104         JRST    RES1\r
 105 ]\r
 106 \r
 107 ; PROCHK - SETUP LAST RESUMER SLOT\r
 108 \r
 109 PROCHK: CAME    B,MAINPR        ; MAIN PROCESS?\r
 110         MOVEM   PVP,LSTRES+1(B)\r
 111         POPJ    P,\r
 112 \r
 113 ; THIS FUNCTION RESUMES A PROCESS, CALLED WITH ONE OR TWO ARGS\r
 114 ; THE FIRST IS A VALUE TO RETURN TO THE OTHER PROCESS OR PASS TO ITS\r
 115 ;       RESFUN\r
 116 ; THE SECOND IS THE PROCESS TO RESUME (IF NOT SUPPLIED, USE THE LSTRES)\r
 117 \r
 118 \r
 119 MFUNCTION RESUME,SUBR\r
 120 \r
 121         ENTRY\r
 122         JUMPGE  AB,TFA\r
 123         CAMGE   AB,[-4,,0]\r
 124         JRST    TMA\r
 125         CAMGE   AB,[-2,,0]\r
 126         JRST    CHPROC          ; VALIDITY CHECK ON PROC\r
 127         SKIPN   B,LSTRES+1(PVP) ; ANY RESUMERS?\r
 128         JRST    NORES           ; NO, COMPLAIN\r
 129 GOTPRO: MOVE    C,AB\r
 130         CAMN    B,PVP           ; DO THEY DIFFER?\r
 131         JRST    RETARG\r
 132         MOVE    A,PSTAT+1(B)    ; CHECK STATE\r
 133         CAIE    A,RUNABL        ; MUST BE RUNABL\r
 134         CAIN    A,RESMBL        ; OR RESUMABLE\r
 135         JRST    RESUM1\r
 136 NOTRES:\r
 137 NOTRUN: PUSH    TP,$TATOM\r
 138         PUSH    TP,EQUOTE PROCESS-NOT-RUNABLE-OR-RESUMABLE\r
 139         JRST    CALER1\r
 140 \r
 141 RESUM1: PUSHJ   P,PROCHK        ; FIX LISTS UP\r
 142         MOVEI   A,RESMBL        ; GET NEW STATE\r
 143         MOVE    D,B             ; FOR SWAP\r
 144 STRTN:  JSP     C,SWAP          ; SWAP THEM\r
 145         MOVEM   A,PSTAT+1(E)    ; CLOBBER OTHER STATE\r
 146         MOVE    A,PSTAT+1(PVP)  ; DECIDE HOW TO PROCEED\r
 147         MOVEI   0,RUNING\r
 148         MOVEM   0,PSTAT+1(PVP)  ; NEW STATE\r
 149         MOVE    C,ABSTO+1(E)    ; OLD ARGS\r
 150         CAIE    A,RESMBL\r
 151         JRST    DORUN           ; THEY DO RUN RUN, THEY DO RUN RUN\r
 152 RETARG: MOVE    A,(C)\r
 153         MOVE    B,1(C)          ; RETURN\r
 154         JRST    FINIS\r
 155 \r
 156 DORUN:  PUSH    TP,RESFUN(PVP)\r
 157         PUSH    TP,RESFUN+1(PVP)\r
 158         PUSH    TP,(C)\r
 159         PUSH    TP,1(C)\r
 160         MCALL   2,APPLY\r
 161         PUSH    TP,A            ; CALL SUICIDE WITH THESE ARGS\r
 162         PUSH    TP,B\r
 163         MCALL   1,SUICID        ; IF IT RETURNS, KILL IT\r
 164         JRST    FINIS\r
 165 \r
 166 CHPROC: GETYP   A,2(AB)\r
 167         CAIE    A,TPVP\r
 168         JRST    WTYP2\r
 169         MOVE    B,3(AB)\r
 170         JRST    GOTPRO\r
 171 \r
 172 NORES:  PUSH    TP,$TATOM\r
 173         PUSH    TP,EQUOTE NO-PROCESS-TO-RESUME\r
 174         JRST    CALER1\r
 175 \r
 176 ; FUNCTION TO CAUSE PROCESSES TO SELF DESTRUCT\r
 177 \r
 178 MFUNCTION SUICIDE,SUBR\r
 179 \r
 180         ENTRY\r
 181 \r
 182         JUMPGE  AB,TFA\r
 183         HLRE    A,AB\r
 184         ASH     A,-1    ; DIV BY 2\r
 185         AOJE    A,NOPROC        ; NO PROCESS GIVEN\r
 186         AOJL    A,TMA\r
 187         GETYP   A,2(AB) ; MAKE SURE OF PROCESS\r
 188         CAIE    A,TPVP\r
 189         JRST    WTYP2\r
 190         MOVE    C,3(AB)\r
 191         JRST    SUIC2\r
 192 \r
 193 NOPROC: SKIPN   C,LSTRES+1(PVP) ; MAKE SURE OF EDLIST\r
 194         MOVE    C,MAINPR        ; IF NOT DEFAULT TO MAIN\r
 195 SUIC2:  CAMN    C,PVP           ; DONT SUICIDE TO SELF\r
 196         JRST    SUSELF\r
 197         MOVE    B,PSTAT+1(C)\r
 198         CAIE    B,RUNABL\r
 199         CAIN    B,RESMBL\r
 200         JRST    .+2\r
 201         JRST    NOTRUN\r
 202         MOVE    B,C\r
 203         PUSHJ   P,PROCHK\r
 204         MOVE    D,B             ; RESTORE NEWPROCESS\r
 205         MOVEI   A,DEAD\r
 206         JRST    STRTN\r
 207 \r
 208 SUSELF: PUSH    TP,$TATOM\r
 209         PUSH    TP,EQUOTE ATTEMPT-TO-SUICIDE-TO-SELF\r
 210         JRST    CALER1\r
 211 \r
 212 \r
 213 MFUNCTION RESER,SUBR,RESUMER\r
 214 \r
 215         ENTRY\r
 216         MOVE    B,PVP\r
 217         JUMPGE  AB,GTLAST\r
 218         CAMGE   AB,[-2,,0]\r
 219         JRST    TMA\r
 220 \r
 221         GETYP   A,(AB)  ; CHECK FOR PROCESS\r
 222         CAIE    A,TPVP\r
 223         JRST    WTYP1\r
 224         MOVE    B,1(AB) ; GET PROCESS\r
 225 GTLAST: MOVSI   A,TFALSE        ; ASSUME NONE\r
 226         SKIPN   B,LSTRES+1(B)   ; GET IT IF IT EXISTS\r
 227         JRST    FINIS\r
 228         MOVSI   A,TPVP          ; GET TYPE\r
 229         JRST    FINIS\r
 230 \r
 231 ; FUNCTION TO PUT AN EVAL CALL ON ANOTHER PROCESSES STACK\r
 232 \r
 233 MFUNCTION BREAKSEQ,SUBR,BREAK-SEQ\r
 234 \r
 235         ENTRY   2\r
 236 \r
 237         GETYP   A,2(AB)         ; 2D ARG MUST BE PROCESS\r
 238         CAIE    A,TPVP\r
 239         JRST    WTYP2\r
 240 \r
 241         MOVE    B,3(AB)         ; GET PROCESS\r
 242         CAMN    B,PVP           ; SKIP IF NOT ME\r
 243         JRST    BREAKM\r
 244         MOVE    A,PSTAT+1(B)    ; CHECK STATE\r
 245         CAIE    A,RESMBL        ; BEST BE RESUMEABLE\r
 246         JRST    NOTRUN\r
 247         MOVE    C,TBSTO+1(B)    ; GET SAVE ACS TO BUILD UP A DUMMY FRAME\r
 248         MOVE    D,TPSTO+1(B)    ; STACK POINTER\r
 249         MOVE    E,SPSTO+1(B)    ; FIX UP OLD FRAME\r
 250         MOVEM   E,SPSAV(C)\r
 251         MOVEI   E,CALLEV        ; FUNNY PC\r
 252         MOVEM   E,PCSAV(C)\r
 253         MOVE    E,PSTO+1(B)     ; SET UP P,PP AND TP SAVES\r
 254         MOVEM   E,PSAV(C)\r
 255         PUSH    D,[0]           ; ALLOCATES SOME SLOTS\r
 256         PUSH    D,[0]\r
 257         PUSH    D,(AB)          ; NOW THAT WHIC IS TO BE EVALLED\r
 258         PUSH    D,1(AB)\r
 259         MOVEM   D,TPSAV(C)\r
 260         HRRI    E,-1(D)         ; BUILD UP ARG POINTER\r
 261         HRLI    E,-2\r
 262         PUSH    D,[TENTRY,,BREAKE]\r
 263         PUSH    D,C             ; OLD TB\r
 264         PUSH    D,E             ; NEW ARG POINTER\r
 265 REPEAT 4,PUSH   D,[0]           ; OTHER SLOTS\r
 266         MOVEM   D,TPSTO+1(B)\r
 267         MOVEI   C,(D)           ; BUILD NEW AB\r
 268         AOBJN   C,.+1\r
 269         MOVEM   C,TBSTO+1(B)    ; STORE IT\r
 270         MOVE    A,2(AB)         ; RETURN PROCESS\r
 271         MOVE    B,3(AB)\r
 272         JRST    FINIS\r
 273 \r
 274 MQUOTE BREAKER\r
 275 \r
 276 BREAKE: \r
 277 CALLEV: MOVEM   A,-3(TP)        ; HERE TO EVAL THE GOODIE (SAVE REAL RESULT)\r
 278         MOVEM   B,-2(TP)\r
 279         MCALL   1,EVAL\r
 280         POP     TP,B\r
 281         POP     TP,A\r
 282         JRST    FINIS\r
 283 \r
 284 BREAKM: PUSH    TP,$TATOM\r
 285         PUSH    TP,EQUOTE ATTEMPT-TO-BREAK-OWN-SEQUENCE\r
 286         JRST    CALER1\r
 287 \r
 288 ; FUNCTION TOP PUT PROCESS IN 1 STEP MODE\r
 289 \r
 290 MFUNCTION 1STEP,SUBR\r
 291         PUSHJ   P,1PROC\r
 292         MOVEM   PVP,1STEPR+1(B) ; CLOBBER TARGET PROCESS\r
 293         JRST    FINIS\r
 294 \r
 295 ; FUNCTION TO UNDO ABOVE\r
 296 \r
 297 MFUNCTION %%FREE,SUBR,FREE-RUN\r
 298         PUSHJ   P,1PROC\r
 299         CAME    PVP,1STEPR+1(B)\r
 300         JRST    FNDBND\r
 301         SETZM   1STEPR+1(B)\r
 302         JRST    FINIS\r
 303 \r
 304 FNDBND: SKIPE   1STEPR+1(B)     ; DOES IT HAVE ANY 1STEPPER?\r
 305         JRST    NOTMIN          ; YES, COMPLAIN\r
 306         MOVE    D,B             ; COPY PROCESS\r
 307         ADD     D,[1STEPR,,1STEPR]      ; POINTER FOR SEARCH\r
 308         HRRZ    C,SPSTO+1(B)    ; GET THIS BINDING STACK\r
 309 \r
 310 FNDLP:  GETYP   0,(C)           ; IS THIS A TBVL?\r
 311         CAIN    0,TBVL\r
 312         CAME    D,1(C)          ; SKIP IF THIS IS SAVED 1STEP SLOT\r
 313         JRST    FNDNXT\r
 314         SKIPN   3(C)            ; IS IT SAVING A REAL 1STEPPER?\r
 315         JRST    FNDNXT\r
 316         CAME    PVP,3(C)        ; IS IT ME?\r
 317         JRST    NOTMIN\r
 318         SETZM   3(C)            ; CLEAR OUT SAVED 1STEPPER\r
 319         JRST    FINIS\r
 320 FNDNXT: HRRZ    C,(C)           ; NEXT BINDING\r
 321         JUMPN   C,FNDLP\r
 322 \r
 323 NOTMIN: MOVE    C,$TCHSTR\r
 324         MOVE    D,CHQUOTE NOT-YOUR-1STEPEE\r
 325         PUSHJ   P,INCONS\r
 326         MOVSI   A,TFALSE\r
 327         JRST    FINIS\r
 328 \r
 329 1PROC:  ENTRY   1\r
 330         GETYP   A,(AB)\r
 331         CAIE    A,TPVP\r
 332         JRST    WTYP1\r
 333         MOVE    B,1(AB)\r
 334         MOVE    A,(AB)\r
 335         POPJ    P,\r
 336 \r
 337 ; FUNCTION TO RETRUN THE MAIN PROCESS\r
 338 \r
 339 MFUNCTION MAIN%%,SUBR,MAIN\r
 340         ENTRY   0\r
 341 \r
 342         MOVE    B,MAINPR\r
 343 MAIN1:  MOVSI   A,TPVP\r
 344         JRST    FINIS\r
 345 \r
 346 ; FUNCTION TO RETURN THE CURRENT PROCESS\r
 347 \r
 348 MFUNCTION ME,SUBR\r
 349         ENTRY   0\r
 350 \r
 351         MOVE    B,PVP\r
 352         JRST    MAIN1\r
 353 \r
 354 ; FUNCTION TO RETURN THE STATE OF A PROCESS\r
 355 \r
 356 MFUNCTION STATE,SUBR\r
 357         ENTRY   1\r
 358         GETYP   A,(AB)\r
 359         CAIE    A,TPVP\r
 360         JRST    WTYP1\r
 361         MOVE    A,1(AB)         ; GET PROCESS\r
 362         MOVE    A,PSTAT+1(A)\r
 363         MOVE    B,@STATES(A)    ; GET STATE\r
 364         MOVSI   A,TATOM\r
 365         JRST    FINIS\r
 366 \r
 367 STATES:\r
 368         IRP A,,[ILLEGAL,RUNABLE,RESUMABLE,RUNNING,DEAD,BLOCKED]\r
 369         MQUOTE A\r
 370         TERMIN\r
 371 \r
 372 \r
 373 \r
 374 END\r
 375 \f\r