+
+TITLE PROCESS-HACKER FOR MUDDLE
+
+RELOCATABLE
+
+.INSRT MUDDLE >
+
+.GLOBAL ICR,NAPT,IGVAL,CHKARG,RESFUN,RETPROC
+
+MFUNCTION CREATE,SUBR
+
+ ENTRY 1
+ GETYP A,(AB) ;GET TYPE OF ARG
+ ;MUST BE SOME APPLIABLE TYPE
+ CAIE A,TSUBR ;SUBR?
+ CAIN A,TEXPR ;EXPR?
+ JRST OKFUN
+ CAIE A,TFSUBR ;FSUBR?
+ CAIN A,TFUNARG ;FUNARG?
+ JRST OKFUN
+ CAIE A,TFIX ;CALL TO GET? (ALLOWING THIS IS QUESTIONABLE)
+ JRST NAPT ;NO, ERROR - NON-APPLIABLE TYPE
+OKFUN:
+
+ PUSHJ P,ICR ;CREATE A NEW PROCESS
+ MOVE C,TPSTO+1(B) ;GET ITS SRTACK
+ PUSH C,[TENTRY,,RETPROC]
+ PUSH C,[1,,0] ;TIME
+ PUSH C,[0]
+ PUSH C,SPSTO+1(B)
+ PUSH C,PSTO+1(B)
+ MOVE D,C
+ ADD D,[3,,3]
+ PUSH C,D ;SAVED STACK POINTER
+ PUSH C,PPSTO+1(B) ;
+ PUSH C,[RETPROC]
+ MOVEM C,TPSTO+1(B) ;STORE NEW TP
+ HRRI D,1(C) ;MAKE A TB
+ HRLI D,2 ;WITH A TIME
+ MOVEM D,TBINIT+1(B)
+ MOVEM D,TBSTO+1(B) ;SAVE ALSO FOR SIMULATED START
+ MOVE C,(AB) ;STORE ARG
+ MOVEM C,RESFUN(B) ;INTO PV
+ MOVE C,1(AB)
+ MOVEM C,RESFUN+1(B)
+ JRST FINIS
+
+MFUNCTION RETPROC,SUBR
+; WHO KNOWS WHAT THIS SHOULD REALLY DO
+;PROBABLY, JUST AN EXIT
+;FOR NOW, PRINT OUT AN ERROR MESSAGE
+ PUSH TP,$TATOM
+ PUSH TP,MQUOTE ATTEMPT-TO-RETURN-OUT-OF-PROCESS
+ JRST CALER1\r
+
+
+
+
+
+
+MFUNCTION RESUME,FSUBR
+;RESUME IS CALLED WITH TWO ARGS
+;THE FIRST IS A PROCESS FORM OF THE PROCESS TO BE RESUMED
+;THE SECOND IS A FUNCTION TO BE CALLED WHEN THIS PROCESS
+; (THE PARENT) IS ITSELF RESUMED
+;IF THE FUNCTION IS NOT GIVEN SOME STANDARD FUNCTION IS
+;PLUGGED IN
+;
+; NOTE - TYPE AND NUMBER OF ARGS CHECKS MUST BE ADDED TO BOTH RESUME AND CREATE
+
+ ENTRY 1
+ HRRZ C,@1(AB) ;GET CDR ADDRESS
+ JUMPE C,NOFUN ;IF NO SECOND ARG, SUPPLY STANDARD
+ HLLZ A,(C) ;GET CDR TYPE
+ CAME A,$TATOM ;ATOMIC?
+ JRST RES2 ;NO, MUST EVAL TO GET FUNCTION
+ MOVE B,1(C) ;YES
+ PUSHJ P,IGVAL ;TRY TO GET GLOBAL VALUE
+ CAMN A,$TUNBOUND ;GLOBALLY UNBOUND?
+ JRST LFUN ;YES, TRY FOR LOCAL VALUE
+RES1: MOVEM A,RESFUN(PVP) ;STORE IN THIS PROCESS
+ MOVEM B,RESFUN+1(PVP)
+
+ HRRZ C,1(AB) ;GET CAR ADDRESS
+ PUSH TP,(C) ;PUSH PROCESS FORM
+ PUSH TP,1(C)
+ JSP E,CHKARG ;CHECK FOR DEFERED TYPE
+ ;INSERT CHECKS FOR PROCESS FORM
+ MCALL 1,EVAL ;EVAL PROCESS FORM WHICH WILL SWITCH
+ ; PROCESSES
+ JRST FINIS
+
+RES2: PUSH TP,(C) ;PUSH FUNCTION ARG
+ PUSH TP,1(C)
+ JSP E,CHKARG ;CHECK FOR DEFERED
+ MCALL 1,EVAL ;EVAL TO GET FUNCTION
+ JRST RES1
+
+LFUN: HRRZ C,1(AB) ;GET CDR ADDRESS
+ PUSH TP,(C)
+ PUSH TP,1(C)
+ MCALL 1,VALUE ;GET LOCAL VALUE OF ATOM FOR FUNCTION
+ JRST RES1
+
+NOFUN: MOVSI A,TUNBOUND ;MAKE RESUME FUNCTION UNBOUND
+ JRST RES1
+
+END
+\f\ 3\f
\ No newline at end of file