2 TITLE PROCESS-HACKER FOR MUDDLE
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
12 MFUNCTION PROCESS,SUBR
15 GETYP A,(AB) ;GET TYPE OF ARG
16 ;MUST BE SOME APPLIABLE TYPE
18 JRST NAPT ;NO, ERROR - NON-APPLIABLE TYPE
21 MOVEI A,TPLNT/2 ;SMALL STACK PARAMETERS
23 PUSHJ P,ICR ;CREATE A NEW PROCESS
24 MOVE C,TPSTO+1(B) ;GET ITS SRTACK
25 PUSH C,[TENTRY,,TOPLEV]
32 PUSH C,D ;SAVED STACK POINTER
34 MOVEM C,TPSTO+1(B) ;STORE NEW TP
35 HRRI D,1(C) ;MAKE A TB
36 HRLI D,400002 ;WITH A TIME
38 MOVEM D,TBSTO+1(B) ;SAVE ALSO FOR SIMULATED START
39 MOVE C,(AB) ;STORE ARG
40 MOVEM C,RESFUN(B) ;INTO PV
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
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
68 ; NOTE - TYPE AND NUMBER OF ARGS CHECKS MUST BE ADDED TO BOTH RESUME AND CREATE
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
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
84 HRRZ C,1(AB) ;GET CAR ADDRESS
85 PUSH TP,(C) ;PUSH PROCESS FORM
87 JSP E,CHKARG ;CHECK FOR DEFERED TYPE
88 ;INSERT CHECKS FOR PROCESS FORM
89 MCALL 1,EVAL ;EVAL PROCESS FORM WHICH WILL SWITCH
93 RES2: PUSH TP,(C) ;PUSH FUNCTION ARG
95 JSP E,CHKARG ;CHECK FOR DEFERED
96 MCALL 1,EVAL ;EVAL TO GET FUNCTION
99 LFUN: HRRZ C,1(AB) ;GET CDR ADDRESS
102 MCALL 1,VALUE ;GET LOCAL VALUE OF ATOM FOR FUNCTION
105 NOFUN: MOVSI A,TUNBOUND ;MAKE RESUME FUNCTION UNBOUND
109 ; PROCHK - SETUP LAST RESUMER SLOT
111 PROCHK: MOVE PVP,PVSTOR+1
112 CAME B,MAINPR ; MAIN PROCESS?
113 MOVEM PVP,LSTRES+1(B)
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
119 ; THE SECOND IS THE PROCESS TO RESUME (IF NOT SUPPLIED, USE THE LSTRES)
122 MFUNCTION RESUME,SUBR
129 JRST CHPROC ; VALIDITY CHECK ON PROC
131 SKIPN B,LSTRES+1(PVP) ; ANY RESUMERS?
132 JRST NORES ; NO, COMPLAIN
134 CAMN B,PVSTOR+1 ; DO THEY DIFFER?
136 MOVE A,PSTAT+1(B) ; CHECK STATE
137 CAIE A,RUNABL ; MUST BE RUNABL
138 CAIN A,RESMBL ; OR RESUMABLE
141 NOTRUN: ERRUUO EQUOTE PROCESS-NOT-RUNABLE-OR-RESUMABLE
143 RESUM1: PUSHJ P,PROCHK ; FIX LISTS UP
144 MOVEI A,RESMBL ; GET NEW STATE
146 STRTN: JSP C,SWAP ; SWAP THEM
147 MOVEM A,PSTAT+1(E) ; CLOBBER OTHER STATE
149 MOVE A,PSTAT+1(PVP) ; DECIDE HOW TO PROCEED
151 MOVEM 0,PSTAT+1(PVP) ; NEW STATE
152 MOVE C,ABSTO+1(E) ; OLD ARGS
154 JRST DORUN ; THEY DO RUN RUN, THEY DO RUN RUN
159 DORUN: PUSH TP,RESFUN(PVP)
160 PUSH TP,RESFUN+1(PVP)
164 PUSH TP,A ; CALL SUICIDE WITH THESE ARGS
166 MCALL 1,SUICID ; IF IT RETURNS, KILL IT
169 CHPROC: GETYP A,2(AB)
175 NORES: ERRUUO EQUOTE NO-PROCESS-TO-RESUME
177 ; FUNCTION TO CAUSE PROCESSES TO SELF DESTRUCT
179 MFUNCTION SUICIDE,SUBR
186 AOJE A,NOPROC ; NO PROCESS GIVEN
188 GETYP A,2(AB) ; MAKE SURE OF PROCESS
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
206 MOVE D,B ; RESTORE NEWPROCESS
210 SUSELF: ERRUUO EQUOTE ATTEMPT-TO-SUICIDE-TO-SELF
213 MFUNCTION RESER,SUBR,RESUMER
221 GETYP A,(AB) ; CHECK FOR PROCESS
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
228 MOVSI A,TPVP ; GET TYPE
231 ; FUNCTION TO PUT AN EVAL CALL ON ANOTHER PROCESSES STACK
233 MFUNCTION BREAKSEQ,SUBR,BREAK-SEQ
237 GETYP A,2(AB) ; 2D ARG MUST BE PROCESS
241 MOVE B,3(AB) ; GET PROCESS
242 CAMN B,PVSTOR+1 ; SKIP IF NOT ME
244 MOVE A,PSTAT+1(B) ; CHECK STATE
245 CAIE A,RESMBL ; BEST BE RESUMEABLE
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
251 MOVEI E,CALLEV ; FUNNY PC
253 MOVE E,PSTO+1(B) ; SET UP P,PP AND TP SAVES
255 PUSH D,[0] ; ALLOCATES SOME SLOTS
257 PUSH D,(AB) ; NOW THAT WHIC IS TO BE EVALLED
260 HRRI E,-1(D) ; BUILD UP ARG POINTER
262 PUSH D,[TENTRY,,BREAKE]
264 PUSH D,E ; NEW ARG POINTER
265 REPEAT 4,PUSH D,[0] ; OTHER SLOTS
267 MOVEI C,(D) ; BUILD NEW AB
269 MOVEM C,TBSTO+1(B) ; STORE IT
270 MOVE A,2(AB) ; RETURN PROCESS
277 CALLEV: MOVEM A,-3(TP) ; HERE TO EVAL THE GOODIE (SAVE REAL RESULT)
284 BREAKM: ERRUUO EQUOTE ATTEMPT-TO-BREAK-OWN-SEQUENCE
286 ; FUNCTION TOP PUT PROCESS IN 1 STEP MODE
291 MOVEM PVP,1STEPR+1(B) ; CLOBBER TARGET PROCESS
294 ; FUNCTION TO UNDO ABOVE
296 MFUNCTION %%FREE,SUBR,FREE-RUN
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
310 FNDLP: GETYP 0,(C) ; IS THIS A TBVL?
312 CAME D,1(C) ; SKIP IF THIS IS SAVED 1STEP SLOT
314 SKIPN 3(C) ; IS IT SAVING A REAL 1STEPPER?
317 CAME PVP,3(C) ; IS IT ME?
319 SETZM 3(C) ; CLEAR OUT SAVED 1STEPPER
321 FNDNXT: HRRZ C,(C) ; NEXT BINDING
324 NOTMIN: MOVE C,$TCHSTR
325 MOVE D,CHQUOTE NOT-YOUR-1STEPEE
338 ; FUNCTION TO RETRUN THE MAIN PROCESS
340 MFUNCTION MAIN%%,SUBR,MAIN
347 ; FUNCTION TO RETURN THE CURRENT PROCESS
355 ; FUNCTION TO RETURN THE STATE OF A PROCESS
362 MOVE A,1(AB) ; GET PROCESS
364 MOVE B,@STATES(A) ; GET STATE
369 IRP A,,[ILLEGAL,RUNABLE,RESUMABLE,RUNNING,DEAD,BLOCKED]