ITS Muddle.

[pdp10-muddle.git] / MUDDLE / create.14

diff --git a/MUDDLE/create.14 b/MUDDLE/create.14
new file mode 100644 (file)
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\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