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