--- /dev/null
+TITLE PROCESS-HACKER FOR MUDDLE\r
+\r
+RELOCATABLE\r
+\r
+.INSRT MUDDLE >\r
+\r
+.GLOBAL ICR,NAPT,IGVAL,CHKARG,RESFUN,RETPROC,SWAP,MAINPR,PROCHK,NOTRES\r
+.GLOBAL PSTAT,LSTRES,TOPLEV,MAINPR,1STEPR,INCONS\r
+.GLOBAL TBINIT,APLQ\r
+\r
+MFUNCTION PROCESS,SUBR\r
+\r
+ ENTRY 1\r
+ GETYP A,(AB) ;GET TYPE OF ARG\r
+ ;MUST BE SOME APPLIABLE TYPE\r
+ PUSHJ P,APLQ\r
+ JRST NAPT ;NO, ERROR - NON-APPLIABLE TYPE\r
+OKFUN:\r
+\r
+ PUSHJ P,ICR ;CREATE A NEW PROCESS\r
+ MOVE C,TPSTO+1(B) ;GET ITS SRTACK\r
+ PUSH C,[TENTRY,,TOPLEV]\r
+ PUSH C,[1,,0] ;TIME\r
+ PUSH C,[0]\r
+ PUSH C,SPSTO+1(B)\r
+ PUSH C,PSTO+1(B)\r
+ MOVE D,C\r
+ ADD D,[3,,3]\r
+ PUSH C,D ;SAVED STACK POINTER\r
+ PUSH C,[SUICID]\r
+ MOVEM C,TPSTO+1(B) ;STORE NEW TP\r
+ HRRI D,1(C) ;MAKE A TB\r
+ HRLI D,2 ;WITH A TIME\r
+ MOVEM D,TBINIT+1(B)\r
+ MOVEM D,TBSTO+1(B) ;SAVE ALSO FOR SIMULATED START\r
+ MOVE C,(AB) ;STORE ARG\r
+ MOVEM C,RESFUN(B) ;INTO PV\r
+ MOVE C,1(AB)\r
+ MOVEM C,RESFUN+1(B)\r
+ MOVEI 0,RUNABL\r
+ MOVEM 0,PSTAT+1(B)\r
+ JRST FINIS\r
+\r
+REPEAT 0,[\r
+MFUNCTION RETPROC,SUBR\r
+; WHO KNOWS WHAT THIS SHOULD REALLY DO\r
+;PROBABLY, JUST AN EXIT\r
+;FOR NOW, PRINT OUT AN ERROR MESSAGE\r
+ PUSH TP,$TATOM\r
+ PUSH TP,EQUOTE ATTEMPT-TO-RETURN-OUT-OF-PROCESS\r
+ JRST CALER1\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+MFUNCTION RESUME,FSUBR\r
+;RESUME IS CALLED WITH TWO ARGS\r
+;THE FIRST IS A PROCESS FORM OF THE PROCESS TO BE RESUMED\r
+;THE SECOND IS A FUNCTION TO BE CALLED WHEN THIS PROCESS\r
+; (THE PARENT) IS ITSELF RESUMED\r
+;IF THE FUNCTION IS NOT GIVEN SOME STANDARD FUNCTION IS\r
+;PLUGGED IN\r
+;\r
+; NOTE - TYPE AND NUMBER OF ARGS CHECKS MUST BE ADDED TO BOTH RESUME AND CREATE\r
+\r
+ ENTRY 1\r
+ HRRZ C,@1(AB) ;GET CDR ADDRESS\r
+ JUMPE C,NOFUN ;IF NO SECOND ARG, SUPPLY STANDARD\r
+ HLLZ A,(C) ;GET CDR TYPE\r
+ CAME A,$TATOM ;ATOMIC?\r
+ JRST RES2 ;NO, MUST EVAL TO GET FUNCTION\r
+ MOVE B,1(C) ;YES\r
+ PUSHJ P,IGVAL ;TRY TO GET GLOBAL VALUE\r
+ CAMN A,$TUNBOUND ;GLOBALLY UNBOUND?\r
+ JRST LFUN ;YES, TRY FOR LOCAL VALUE\r
+RES1: MOVEM A,RESFUN(PVP) ;STORE IN THIS PROCESS\r
+ MOVEM B,RESFUN+1(PVP)\r
+\r
+ HRRZ C,1(AB) ;GET CAR ADDRESS\r
+ PUSH TP,(C) ;PUSH PROCESS FORM\r
+ PUSH TP,1(C)\r
+ JSP E,CHKARG ;CHECK FOR DEFERED TYPE\r
+ ;INSERT CHECKS FOR PROCESS FORM\r
+ MCALL 1,EVAL ;EVAL PROCESS FORM WHICH WILL SWITCH\r
+ ; PROCESSES\r
+ JRST FINIS\r
+\r
+RES2: PUSH TP,(C) ;PUSH FUNCTION ARG\r
+ PUSH TP,1(C)\r
+ JSP E,CHKARG ;CHECK FOR DEFERED\r
+ MCALL 1,EVAL ;EVAL TO GET FUNCTION\r
+ JRST RES1\r
+\r
+LFUN: HRRZ C,1(AB) ;GET CDR ADDRESS\r
+ PUSH TP,(C)\r
+ PUSH TP,1(C)\r
+ MCALL 1,VALUE ;GET LOCAL VALUE OF ATOM FOR FUNCTION\r
+ JRST RES1\r
+\r
+NOFUN: MOVSI A,TUNBOUND ;MAKE RESUME FUNCTION UNBOUND\r
+ JRST RES1\r
+]\r
+\r
+; PROCHK - SETUP LAST RESUMER SLOT\r
+\r
+PROCHK: CAME B,MAINPR ; MAIN PROCESS?\r
+ MOVEM PVP,LSTRES+1(B)\r
+ POPJ P,\r
+\r
+; THIS FUNCTION RESUMES A PROCESS, CALLED WITH ONE OR TWO ARGS\r
+; THE FIRST IS A VALUE TO RETURN TO THE OTHER PROCESS OR PASS TO ITS\r
+; RESFUN\r
+; THE SECOND IS THE PROCESS TO RESUME (IF NOT SUPPLIED, USE THE LSTRES)\r
+\r
+\r
+MFUNCTION RESUME,SUBR\r
+\r
+ ENTRY\r
+ JUMPGE AB,TFA\r
+ CAMGE AB,[-4,,0]\r
+ JRST TMA\r
+ CAMGE AB,[-2,,0]\r
+ JRST CHPROC ; VALIDITY CHECK ON PROC\r
+ SKIPN B,LSTRES+1(PVP) ; ANY RESUMERS?\r
+ JRST NORES ; NO, COMPLAIN\r
+GOTPRO: MOVE C,AB\r
+ CAMN B,PVP ; DO THEY DIFFER?\r
+ JRST RETARG\r
+ MOVE A,PSTAT+1(B) ; CHECK STATE\r
+ CAIE A,RUNABL ; MUST BE RUNABL\r
+ CAIN A,RESMBL ; OR RESUMABLE\r
+ JRST RESUM1\r
+NOTRES:\r
+NOTRUN: PUSH TP,$TATOM\r
+ PUSH TP,EQUOTE PROCESS-NOT-RUNABLE-OR-RESUMABLE\r
+ JRST CALER1\r
+\r
+RESUM1: PUSHJ P,PROCHK ; FIX LISTS UP\r
+ MOVEI A,RESMBL ; GET NEW STATE\r
+ MOVE D,B ; FOR SWAP\r
+STRTN: JSP C,SWAP ; SWAP THEM\r
+ MOVEM A,PSTAT+1(E) ; CLOBBER OTHER STATE\r
+ MOVE A,PSTAT+1(PVP) ; DECIDE HOW TO PROCEED\r
+ MOVEI 0,RUNING\r
+ MOVEM 0,PSTAT+1(PVP) ; NEW STATE\r
+ MOVE C,ABSTO+1(E) ; OLD ARGS\r
+ CAIE A,RESMBL\r
+ JRST DORUN ; THEY DO RUN RUN, THEY DO RUN RUN\r
+RETARG: MOVE A,(C)\r
+ MOVE B,1(C) ; RETURN\r
+ JRST FINIS\r
+\r
+DORUN: PUSH TP,RESFUN(PVP)\r
+ PUSH TP,RESFUN+1(PVP)\r
+ PUSH TP,(C)\r
+ PUSH TP,1(C)\r
+ MCALL 2,APPLY\r
+ PUSH TP,A ; CALL SUICIDE WITH THESE ARGS\r
+ PUSH TP,B\r
+ MCALL 1,SUICID ; IF IT RETURNS, KILL IT\r
+ JRST FINIS\r
+\r
+CHPROC: GETYP A,2(AB)\r
+ CAIE A,TPVP\r
+ JRST WTYP2\r
+ MOVE B,3(AB)\r
+ JRST GOTPRO\r
+\r
+NORES: PUSH TP,$TATOM\r
+ PUSH TP,EQUOTE NO-PROCESS-TO-RESUME\r
+ JRST CALER1\r
+\r
+; FUNCTION TO CAUSE PROCESSES TO SELF DESTRUCT\r
+\r
+MFUNCTION SUICIDE,SUBR\r
+\r
+ ENTRY\r
+\r
+ JUMPGE AB,TFA\r
+ HLRE A,AB\r
+ ASH A,-1 ; DIV BY 2\r
+ AOJE A,NOPROC ; NO PROCESS GIVEN\r
+ AOJL A,TMA\r
+ GETYP A,2(AB) ; MAKE SURE OF PROCESS\r
+ CAIE A,TPVP\r
+ JRST WTYP2\r
+ MOVE C,3(AB)\r
+ JRST SUIC2\r
+\r
+NOPROC: SKIPN C,LSTRES+1(PVP) ; MAKE SURE OF EDLIST\r
+ MOVE C,MAINPR ; IF NOT DEFAULT TO MAIN\r
+SUIC2: CAMN C,PVP ; DONT SUICIDE TO SELF\r
+ JRST SUSELF\r
+ MOVE B,PSTAT+1(C)\r
+ CAIE B,RUNABL\r
+ CAIN B,RESMBL\r
+ JRST .+2\r
+ JRST NOTRUN\r
+ MOVE B,C\r
+ PUSHJ P,PROCHK\r
+ MOVE D,B ; RESTORE NEWPROCESS\r
+ MOVEI A,DEAD\r
+ JRST STRTN\r
+\r
+SUSELF: PUSH TP,$TATOM\r
+ PUSH TP,EQUOTE ATTEMPT-TO-SUICIDE-TO-SELF\r
+ JRST CALER1\r
+\r
+\r
+MFUNCTION RESER,SUBR,RESUMER\r
+\r
+ ENTRY\r
+ MOVE B,PVP\r
+ JUMPGE AB,GTLAST\r
+ CAMGE AB,[-2,,0]\r
+ JRST TMA\r
+\r
+ GETYP A,(AB) ; CHECK FOR PROCESS\r
+ CAIE A,TPVP\r
+ JRST WTYP1\r
+ MOVE B,1(AB) ; GET PROCESS\r
+GTLAST: MOVSI A,TFALSE ; ASSUME NONE\r
+ SKIPN B,LSTRES+1(B) ; GET IT IF IT EXISTS\r
+ JRST FINIS\r
+ MOVSI A,TPVP ; GET TYPE\r
+ JRST FINIS\r
+\r
+; FUNCTION TO PUT AN EVAL CALL ON ANOTHER PROCESSES STACK\r
+\r
+MFUNCTION BREAKSEQ,SUBR,BREAK-SEQ\r
+\r
+ ENTRY 2\r
+\r
+ GETYP A,2(AB) ; 2D ARG MUST BE PROCESS\r
+ CAIE A,TPVP\r
+ JRST WTYP2\r
+\r
+ MOVE B,3(AB) ; GET PROCESS\r
+ CAMN B,PVP ; SKIP IF NOT ME\r
+ JRST BREAKM\r
+ MOVE A,PSTAT+1(B) ; CHECK STATE\r
+ CAIE A,RESMBL ; BEST BE RESUMEABLE\r
+ JRST NOTRUN\r
+ MOVE C,TBSTO+1(B) ; GET SAVE ACS TO BUILD UP A DUMMY FRAME\r
+ MOVE D,TPSTO+1(B) ; STACK POINTER\r
+ MOVE E,SPSTO+1(B) ; FIX UP OLD FRAME\r
+ MOVEM E,SPSAV(C)\r
+ MOVEI E,CALLEV ; FUNNY PC\r
+ MOVEM E,PCSAV(C)\r
+ MOVE E,PSTO+1(B) ; SET UP P,PP AND TP SAVES\r
+ MOVEM E,PSAV(C)\r
+ PUSH D,[0] ; ALLOCATES SOME SLOTS\r
+ PUSH D,[0]\r
+ PUSH D,(AB) ; NOW THAT WHIC IS TO BE EVALLED\r
+ PUSH D,1(AB)\r
+ MOVEM D,TPSAV(C)\r
+ HRRI E,-1(D) ; BUILD UP ARG POINTER\r
+ HRLI E,-2\r
+ PUSH D,[TENTRY,,BREAKE]\r
+ PUSH D,C ; OLD TB\r
+ PUSH D,E ; NEW ARG POINTER\r
+REPEAT 4,PUSH D,[0] ; OTHER SLOTS\r
+ MOVEM D,TPSTO+1(B)\r
+ MOVEI C,(D) ; BUILD NEW AB\r
+ AOBJN C,.+1\r
+ MOVEM C,TBSTO+1(B) ; STORE IT\r
+ MOVE A,2(AB) ; RETURN PROCESS\r
+ MOVE B,3(AB)\r
+ JRST FINIS\r
+\r
+MQUOTE BREAKER\r
+\r
+BREAKE: \r
+CALLEV: MOVEM A,-3(TP) ; HERE TO EVAL THE GOODIE (SAVE REAL RESULT)\r
+ MOVEM B,-2(TP)\r
+ MCALL 1,EVAL\r
+ POP TP,B\r
+ POP TP,A\r
+ JRST FINIS\r
+\r
+BREAKM: PUSH TP,$TATOM\r
+ PUSH TP,EQUOTE ATTEMPT-TO-BREAK-OWN-SEQUENCE\r
+ JRST CALER1\r
+\r
+; FUNCTION TOP PUT PROCESS IN 1 STEP MODE\r
+\r
+MFUNCTION 1STEP,SUBR\r
+ PUSHJ P,1PROC\r
+ MOVEM PVP,1STEPR+1(B) ; CLOBBER TARGET PROCESS\r
+ JRST FINIS\r
+\r
+; FUNCTION TO UNDO ABOVE\r
+\r
+MFUNCTION %%FREE,SUBR,FREE-RUN\r
+ PUSHJ P,1PROC\r
+ CAME PVP,1STEPR+1(B)\r
+ JRST FNDBND\r
+ SETZM 1STEPR+1(B)\r
+ JRST FINIS\r
+\r
+FNDBND: SKIPE 1STEPR+1(B) ; DOES IT HAVE ANY 1STEPPER?\r
+ JRST NOTMIN ; YES, COMPLAIN\r
+ MOVE D,B ; COPY PROCESS\r
+ ADD D,[1STEPR,,1STEPR] ; POINTER FOR SEARCH\r
+ HRRZ C,SPSTO+1(B) ; GET THIS BINDING STACK\r
+\r
+FNDLP: GETYP 0,(C) ; IS THIS A TBVL?\r
+ CAIN 0,TBVL\r
+ CAME D,1(C) ; SKIP IF THIS IS SAVED 1STEP SLOT\r
+ JRST FNDNXT\r
+ SKIPN 3(C) ; IS IT SAVING A REAL 1STEPPER?\r
+ JRST FNDNXT\r
+ CAME PVP,3(C) ; IS IT ME?\r
+ JRST NOTMIN\r
+ SETZM 3(C) ; CLEAR OUT SAVED 1STEPPER\r
+ JRST FINIS\r
+FNDNXT: HRRZ C,(C) ; NEXT BINDING\r
+ JUMPN C,FNDLP\r
+\r
+NOTMIN: MOVE C,$TCHSTR\r
+ MOVE D,CHQUOTE NOT-YOUR-1STEPEE\r
+ PUSHJ P,INCONS\r
+ MOVSI A,TFALSE\r
+ JRST FINIS\r
+\r
+1PROC: ENTRY 1\r
+ GETYP A,(AB)\r
+ CAIE A,TPVP\r
+ JRST WTYP1\r
+ MOVE B,1(AB)\r
+ MOVE A,(AB)\r
+ POPJ P,\r
+\r
+; FUNCTION TO RETRUN THE MAIN PROCESS\r
+\r
+MFUNCTION MAIN%%,SUBR,MAIN\r
+ ENTRY 0\r
+\r
+ MOVE B,MAINPR\r
+MAIN1: MOVSI A,TPVP\r
+ JRST FINIS\r
+\r
+; FUNCTION TO RETURN THE CURRENT PROCESS\r
+\r
+MFUNCTION ME,SUBR\r
+ ENTRY 0\r
+\r
+ MOVE B,PVP\r
+ JRST MAIN1\r
+\r
+; FUNCTION TO RETURN THE STATE OF A PROCESS\r
+\r
+MFUNCTION STATE,SUBR\r
+ ENTRY 1\r
+ GETYP A,(AB)\r
+ CAIE A,TPVP\r
+ JRST WTYP1\r
+ MOVE A,1(AB) ; GET PROCESS\r
+ MOVE A,PSTAT+1(A)\r
+ MOVE B,@STATES(A) ; GET STATE\r
+ MOVSI A,TATOM\r
+ JRST FINIS\r
+\r
+STATES:\r
+ IRP A,,[ILLEGAL,RUNABLE,RESUMABLE,RUNNING,DEAD,BLOCKED]\r
+ MQUOTE A\r
+ TERMIN\r
+\r
+\r
+\r
+END\r
+\f\r
projects / pdp10-muddle.git / blobdiff