X-Git-Url: https://jxself.org/git/?a=blobdiff_plain;f=%3Cmdl.int%3E%2Fcreate.mid.40;fp=%3Cmdl.int%3E%2Fcreate.mid.40;h=b0f5b488cc7247a562b491dce5d17732d576e034;hb=bab072f950a643ac109660a223b57e635492ac25;hp=0000000000000000000000000000000000000000;hpb=233a3c5245f8274882cc9d27a3c20e9b3678000c;p=pdp10-muddle.git diff --git a//create.mid.40 b//create.mid.40 new file mode 100644 index 0000000..b0f5b48 --- /dev/null +++ b//create.mid.40 @@ -0,0 +1,376 @@ + +TITLE PROCESS-HACKER FOR MUDDLE + +RELOCATABLE + +.INSRT MUDDLE > + +.GLOBAL ICR,NAPT,IGVAL,CHKARG,RESFUN,RETPROC,SWAP,MAINPR,PROCHK,NOTRES +.GLOBAL PSTAT,LSTRES,TOPLEV,MAINPR,1STEPR,INCONS +.GLOBAL TBINIT,APLQ,PVSTOR,SPSTOR + +MFUNCTION PROCESS,SUBR + + ENTRY 1 + GETYP A,(AB) ;GET TYPE OF ARG + ;MUST BE SOME APPLIABLE TYPE + PUSHJ P,APLQ + JRST NAPT ;NO, ERROR - NON-APPLIABLE TYPE +OKFUN: + + MOVEI A,TPLNT/2 ;SMALL STACK PARAMETERS + MOVEI B,PLNT/2 + PUSHJ P,ICR ;CREATE A NEW PROCESS + MOVE C,TPSTO+1(B) ;GET ITS SRTACK + PUSH C,[TENTRY,,TOPLEV] + PUSH C,[1,,0] ;TIME + PUSH C,[0] + PUSH C,SPSTO(B) + PUSH C,PSTO+1(B) + MOVE D,C + ADD D,[3,,3] + PUSH C,D ;SAVED STACK POINTER + PUSH C,[SUICID] + MOVEM C,TPSTO+1(B) ;STORE NEW TP + HRRI D,1(C) ;MAKE A TB + HRLI D,400002 ;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) + MOVEI 0,RUNABL + MOVEM 0,PSTAT+1(B) + JRST FINIS + +REPEAT 0,[ +MFUNCTION RETPROC,SUBR +; WHO KNOWS WHAT THIS SHOULD REALLY DO +;PROBABLY, JUST AN EXIT +;FOR NOW, PRINT OUT AN ERROR MESSAGE + ERRUUO EQUOTE ATTEMPT-TO-RETURN-OUT-OF-PROCESS + + + + + + + +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: MOVE PVP,PVSTOR+1 + 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 +] + +; PROCHK - SETUP LAST RESUMER SLOT + +PROCHK: MOVE PVP,PVSTOR+1 + CAME B,MAINPR ; MAIN PROCESS? + MOVEM PVP,LSTRES+1(B) + POPJ P, + +; THIS FUNCTION RESUMES A PROCESS, CALLED WITH ONE OR TWO ARGS +; THE FIRST IS A VALUE TO RETURN TO THE OTHER PROCESS OR PASS TO ITS +; RESFUN +; THE SECOND IS THE PROCESS TO RESUME (IF NOT SUPPLIED, USE THE LSTRES) + + +MFUNCTION RESUME,SUBR + + ENTRY + JUMPGE AB,TFA + CAMGE AB,[-4,,0] + JRST TMA + CAMGE AB,[-2,,0] + JRST CHPROC ; VALIDITY CHECK ON PROC + MOVE PVP,PVSTOR+1 + SKIPN B,LSTRES+1(PVP) ; ANY RESUMERS? + JRST NORES ; NO, COMPLAIN +GOTPRO: MOVE C,AB + CAMN B,PVSTOR+1 ; DO THEY DIFFER? + JRST RETARG + MOVE A,PSTAT+1(B) ; CHECK STATE + CAIE A,RUNABL ; MUST BE RUNABL + CAIN A,RESMBL ; OR RESUMABLE + JRST RESUM1 +NOTRES: +NOTRUN: ERRUUO EQUOTE PROCESS-NOT-RUNABLE-OR-RESUMABLE + +RESUM1: PUSHJ P,PROCHK ; FIX LISTS UP + MOVEI A,RESMBL ; GET NEW STATE + MOVE D,B ; FOR SWAP +STRTN: JSP C,SWAP ; SWAP THEM + MOVEM A,PSTAT+1(E) ; CLOBBER OTHER STATE + MOVE PVP,PVSTOR+1 + MOVE A,PSTAT+1(PVP) ; DECIDE HOW TO PROCEED + MOVEI 0,RUNING + MOVEM 0,PSTAT+1(PVP) ; NEW STATE + MOVE C,ABSTO+1(E) ; OLD ARGS + CAIE A,RESMBL + JRST DORUN ; THEY DO RUN RUN, THEY DO RUN RUN +RETARG: MOVE A,(C) + MOVE B,1(C) ; RETURN + JRST FINIS + +DORUN: PUSH TP,RESFUN(PVP) + PUSH TP,RESFUN+1(PVP) + PUSH TP,(C) + PUSH TP,1(C) + MCALL 2,APPLY + PUSH TP,A ; CALL SUICIDE WITH THESE ARGS + PUSH TP,B + MCALL 1,SUICID ; IF IT RETURNS, KILL IT + JRST FINIS + +CHPROC: GETYP A,2(AB) + CAIE A,TPVP + JRST WTYP2 + MOVE B,3(AB) + JRST GOTPRO + +NORES: ERRUUO EQUOTE NO-PROCESS-TO-RESUME + +; FUNCTION TO CAUSE PROCESSES TO SELF DESTRUCT + +MFUNCTION SUICIDE,SUBR + + ENTRY + + JUMPGE AB,TFA + HLRE A,AB + ASH A,-1 ; DIV BY 2 + AOJE A,NOPROC ; NO PROCESS GIVEN + AOJL A,TMA + GETYP A,2(AB) ; MAKE SURE OF PROCESS + CAIE A,TPVP + JRST WTYP2 + MOVE C,3(AB) + JRST SUIC2 + +NOPROC: MOVE PVP,PVSTOR+1 + SKIPN C,LSTRES+1(PVP) + MOVE C,MAINPR ; IF NOT DEFAULT TO MAIN +SUIC2: CAMN C,PVP ; DONT SUICIDE TO SELF + JRST SUSELF + MOVE B,PSTAT+1(C) + CAIE B,RUNABL + CAIN B,RESMBL + JRST .+2 + JRST NOTRUN + MOVE B,C + PUSHJ P,PROCHK + MOVE D,B ; RESTORE NEWPROCESS + MOVEI A,DEAD + JRST STRTN + +SUSELF: ERRUUO EQUOTE ATTEMPT-TO-SUICIDE-TO-SELF + + +MFUNCTION RESER,SUBR,RESUMER + + ENTRY + MOVE B,PVSTOR+1 + JUMPGE AB,GTLAST + CAMGE AB,[-2,,0] + JRST TMA + + GETYP A,(AB) ; CHECK FOR PROCESS + CAIE A,TPVP + JRST WTYP1 + MOVE B,1(AB) ; GET PROCESS +GTLAST: MOVSI A,TFALSE ; ASSUME NONE + SKIPN B,LSTRES+1(B) ; GET IT IF IT EXISTS + JRST FINIS + MOVSI A,TPVP ; GET TYPE + JRST FINIS + +; FUNCTION TO PUT AN EVAL CALL ON ANOTHER PROCESSES STACK + +MFUNCTION BREAKSEQ,SUBR,BREAK-SEQ + + ENTRY 2 + + GETYP A,2(AB) ; 2D ARG MUST BE PROCESS + CAIE A,TPVP + JRST WTYP2 + + MOVE B,3(AB) ; GET PROCESS + CAMN B,PVSTOR+1 ; SKIP IF NOT ME + JRST BREAKM + MOVE A,PSTAT+1(B) ; CHECK STATE + CAIE A,RESMBL ; BEST BE RESUMEABLE + JRST NOTRUN + MOVE C,TBSTO+1(B) ; GET SAVE ACS TO BUILD UP A DUMMY FRAME + MOVE D,TPSTO+1(B) ; STACK POINTER + MOVE E,SPSTO+1(B) ; FIX UP OLD FRAME + MOVEM E,SPSAV(C) + MOVEI E,CALLEV ; FUNNY PC + MOVEM E,PCSAV(C) + MOVE E,PSTO+1(B) ; SET UP P,PP AND TP SAVES + MOVEM E,PSAV(C) + PUSH D,[0] ; ALLOCATES SOME SLOTS + PUSH D,[0] + PUSH D,(AB) ; NOW THAT WHIC IS TO BE EVALLED + PUSH D,1(AB) + MOVEM D,TPSAV(C) + HRRI E,-1(D) ; BUILD UP ARG POINTER + HRLI E,-2 + PUSH D,[TENTRY,,BREAKE] + PUSH D,C ; OLD TB + PUSH D,E ; NEW ARG POINTER +REPEAT 4,PUSH D,[0] ; OTHER SLOTS + MOVEM D,TPSTO+1(B) + MOVEI C,(D) ; BUILD NEW AB + AOBJN C,.+1 + MOVEM C,TBSTO+1(B) ; STORE IT + MOVE A,2(AB) ; RETURN PROCESS + MOVE B,3(AB) + JRST FINIS + +MQUOTE BREAKER + +BREAKE: +CALLEV: MOVEM A,-3(TP) ; HERE TO EVAL THE GOODIE (SAVE REAL RESULT) + MOVEM B,-2(TP) + MCALL 1,EVAL + POP TP,B + POP TP,A + JRST FINIS + +BREAKM: ERRUUO EQUOTE ATTEMPT-TO-BREAK-OWN-SEQUENCE + +; FUNCTION TOP PUT PROCESS IN 1 STEP MODE + +MFUNCTION 1STEP,SUBR + PUSHJ P,1PROC + MOVE PVP,PVSTOR+1 + MOVEM PVP,1STEPR+1(B) ; CLOBBER TARGET PROCESS + JRST FINIS + +; FUNCTION TO UNDO ABOVE + +MFUNCTION %%FREE,SUBR,FREE-RUN + PUSHJ P,1PROC + MOVE PVP,PVSTOR+1 + CAME PVP,1STEPR+1(B) + JRST FNDBND + SETZM 1STEPR+1(B) + JRST FINIS + +FNDBND: SKIPE 1STEPR+1(B) ; DOES IT HAVE ANY 1STEPPER? + JRST NOTMIN ; YES, COMPLAIN + MOVE D,B ; COPY PROCESS + ADD D,[1STEPR,,1STEPR] ; POINTER FOR SEARCH + HRRZ C,SPSTO+1(B) ; GET THIS BINDING STACK + +FNDLP: GETYP 0,(C) ; IS THIS A TBVL? + CAIN 0,TBVL + CAME D,1(C) ; SKIP IF THIS IS SAVED 1STEP SLOT + JRST FNDNXT + SKIPN 3(C) ; IS IT SAVING A REAL 1STEPPER? + JRST FNDNXT + MOVE PVP,PVSTOR+1 + CAME PVP,3(C) ; IS IT ME? + JRST NOTMIN + SETZM 3(C) ; CLEAR OUT SAVED 1STEPPER + JRST FINIS +FNDNXT: HRRZ C,(C) ; NEXT BINDING + JUMPN C,FNDLP + +NOTMIN: MOVE C,$TCHSTR + MOVE D,CHQUOTE NOT-YOUR-1STEPEE + PUSHJ P,INCONS + MOVSI A,TFALSE + JRST FINIS + +1PROC: ENTRY 1 + GETYP A,(AB) + CAIE A,TPVP + JRST WTYP1 + MOVE B,1(AB) + MOVE A,(AB) + POPJ P, + +; FUNCTION TO RETRUN THE MAIN PROCESS + +MFUNCTION MAIN%%,SUBR,MAIN + ENTRY 0 + + MOVE B,MAINPR +MAIN1: MOVSI A,TPVP + JRST FINIS + +; FUNCTION TO RETURN THE CURRENT PROCESS + +MFUNCTION ME,SUBR + ENTRY 0 + + MOVE B,PVSTOR+1 + JRST MAIN1 + +; FUNCTION TO RETURN THE STATE OF A PROCESS + +MFUNCTION STATE,SUBR + ENTRY 1 + GETYP A,(AB) + CAIE A,TPVP + JRST WTYP1 + MOVE A,1(AB) ; GET PROCESS + MOVE A,PSTAT+1(A) + MOVE B,@STATES(A) ; GET STATE + MOVSI A,TATOM + JRST FINIS + +STATES: + IRP A,,[ILLEGAL,RUNABLE,RESUMABLE,RUNNING,DEAD,BLOCKED] + MQUOTE A + TERMIN + + + +END + \ No newline at end of file