mirror of
https://github.com/PDP-10/its.git
synced 2026-01-16 08:24:38 +00:00
a81db26a7a
MIDAS and Muddle source get version numbers (as in the 1973 Muddle source); the build files don't.
376 lines
7.6 KiB
Plaintext
376 lines
7.6 KiB
Plaintext
|
||
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
|
||
|