X-Git-Url: https://jxself.org/git/?a=blobdiff_plain;f=MUDDLE%2Fcreate.14;fp=MUDDLE%2Fcreate.14;h=b16a28bdc6db48090fc08b01453fd4d6c1b5e039;hb=39c5769144e7f2a58076bdb973d2c80fa603345c;hp=0000000000000000000000000000000000000000;hpb=bab072f950a643ac109660a223b57e635492ac25;p=pdp10-muddle.git

diff --git a/MUDDLE/create.14 b/MUDDLE/create.14
new file mode 100644
index 0000000..b16a28b
--- /dev/null
+++ b/MUDDLE/create.14
@@ -0,0 +1,109 @@
+
+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
+
+
+
+
+
+
+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
+
\ No newline at end of file