<mdl.int>/create.mid.40

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