TITLE INITIALIZATION FOR MUDDLE

RELOCATABLE

LAST==1	;POSSIBLE CHECKS DONE LATER

.INSRT MUDDLE >

.LIFL <TVLNT-TVLOC>
.LOP .VALUE
.ELDC


.GLOBAL SETUP,TPBAS,GCPDL,GCPVP,PVBASE,PVLNT,PARNEW,AGC,ICR,SWAP,OBLNT,MSGTYP
.GLOBAL ICLOS,OCLOS,GLOBASE,GLOBSP,PARBOT,PARTOP,CODTOP,START,VECBOT,VECTOP,TPBASE
.GLOBAL LISTEN,ROOT,TBINIT,TOPLEV,INTOBL,ERROBL,TTYOPE
.GLOBAL IOINS,BUFRIN,IOIN2,ECHO,TYI,TYO

SETUP:	MOVE	P,GCPDL		;GET A PUSH DOWN STACK
	MOVE	TVP,[-TVLNT,,TVBASE]	;GET INITIAL TRANSFER VECTOR
	PUSHJ	P,TTYOPE		;OPEN THE TTY
	MOVEI	B,[ASCIZ /MUDDLE INITIALIZATION.
/]
	PUSHJ	P,MSGTYP	;PRINT IT
	MOVE	A,CODTOP	;CHECK FOR A WINNING LOAD
	CAML	A,VECBOT	;IT BETTER BE LESS
	JRST	DEATH1		;LOSE COMPLETELY
	MOVE	B,PARBOT	;CHECK FOR ANY PAIRS
	CAME	B,PARTOP	;ANY LOAD/ASSEMBLE TIME PAIRS?
	JRST	PAIRCH		;YES CHECK THEM
	ADDI	A,1		;BUMP UP
	MOVEM	A,PARBOT	;UPDATE PARBOT AND TOP
	MOVEM	A,PARTOP
SETTV:	MOVE	PVP,[-PVLNT*2,,GCPVP]	;AND A PROCESS VECTOR
	MOVEI	A,(PVP)		;SET UP A BLT
	HRLI	A,PVBASE	;FROM PROTOTYPE
	BLT	A,PVLNT*2-1(PVP)	;INITIALIZE
	MOVE	TP,[-ITPLNT,,TPBAS]	;GET A STACK FOR THIS PROCCESS
	MOVEI	TB,(TP)		;AND A BASE
	HRLI	TB,1
	SUB	TP,[1,,1]	;POP ONCE

; ALLOCATE SOME OBLISTS FOR INITIAL ATOMS

	PUSH	P,[3]		;COUNT INITIAL OBLISTS

MAKEOB:	MCALL	0,MOBLIST	;GOBBLE AN OBLIST
	PUSH	TP,$TOBLS	;AND SAVE THEM
	PUSH	TP,B
	SOS	A,(P)		;COUNT DOWN
	MOVEM	B,@OBTBL(A)	;STORE
	JUMPN	A,MAKEOB

	MOVE	C,TVP		;MAKE 2 COPIES OF XFER VECTOR POINTER
	MOVE	D,TVP

;MAIN INITIALIZE LOOP - SCAN XFER VECTOR FOR ATOMS, UPDATE
;OFFSETS IN CODE, UNIQUIFY ATOMS AND COMPACT XFER VECTOR

ILOOP:	HLRZ	A,(C)		;FIRST TYPE
	JUMPE	A,TVEXAU	;USEFUL STUFF EXHAUSTED
	CAIN	A,TCHSTR	;CHARACTER STRING?
	JRST	CHACK		;YES, GO HACK IT
	CAIN	A,TATOM		;ATOM?
	JRST	ATOMHK		;YES, CHECK IT OUT
	MOVE	A,(C)		;MOVE TO NEW HOME (MAY BE SAME)
	MOVEM	A,(D)
	MOVE	A,1(C)
	MOVEM	A,1(D)
SETLP:	AOS	(P)		;COUNT NUMBER OF PAIRS IN XFER VECTOR
	ADD	D,[2,,2]	;OUT COUNTER
SETLP1:	ADD	C,[2,,2]	;AND IN COUNTER
	JUMPL	C,ILOOP		;JUMP IF MORE TO DO

;NEW XFER VECTOR FINISHED, NOW GIVE AWAY THE REST

TVEXAU:	HLRE	B,C		;GET -LENGTH
	SUBI	C,(B)		;POIT TO DOPE WORD
	ANDI	C,-1		;NO LH
	HLRZ	A,1(C)		;INTIAL LENGTH TO A
	MOVEI	E,(C)		;COPY OF POINTER TO DOPW WD
	SUBI	E,(D)		;AMOUNT LEFT OVER TO E
	HRLZM	E,1(C)		;CLOBBER INTO DOPE WORD FOR GARBAGE
	MOVSI	E,(E)		;PREPARE TO UPDATE TVP
	ADD	TVP,E		;NOW POINTS TO THE RIGHT AMOUNT
	HLRE	B,D		;-AMOUNT LEFT TO B
	ADD	B,A		;AMOUNT OF GOOD STUFF
	HRLZM	B,1(D)		;STORE IT IN GODD DOPE WORD
	MOVSI	E,400000	;CLOBBER TO GENERAL IN BOTH CASES
	MOVEM	E,(C)
	MOVEM	E,(D)


; FIX UP TYPE VECTOR

	MOVE	A,TYPVEC+1(TVP)	;GET POINTER
	MOVEI	0,0		;FOR POSSIBLE NULL SLOTS
	MOVSI	B,TATOM		;SET TYPE TO ATOM

TYPLP:	HLLM	B,(A)		;CHANGE TYPE TO ATOM
	MOVE	C,@1(A)		;GET ATOM
	MOVEM	C,1(A)
	ADD	A,[2,,2]		;BUMP
	JUMPL	A,TYPLP

;GENERAT THE LOGICAL TTY IN AND OUT CHANNELS

;SETUP CALL TO OPEN OUTPUT TTY CHANNNEL

	IRP	A,,[[PRINT,TCHSTR],[OUTPUT,TCHSTR],[MUDDLE,TCHSTR],[TTY,TCHSTR]]
	IRP	B,C,[A]
	PUSH	TP,$!C
	PUSH	TP,CHQUOTE B
	.ISTOP
	TERMIN
	TERMIN

	MCALL	4,FOPEN		;OPEN THE OUT PUT CHANNEL
	MOVEM	B,TTOCHN+1(TVP)	;SAVE IT

;ASSIGN AS GLOBAL VALUE

	PUSH	TP,$TATOM
	PUSH	TP,MQUOTE OUTCHAN
	PUSH	TP,A
	PUSH	TP,B
	MOVE	A,[PUSHJ P,TYO]	;MORE WINNING INS
	MOVEM	A,IOINS(B)	;CLOBBER
	MCALL	2,SETG

;SETUP A CALL TO OPEN THE TTY CHANNEL

	IRP	A,,[[READ,TCHSTR],[INPUT,TCHSTR],[MUDDLE,TCHSTR],[TTY,TCHSTR]]
	IRP	B,C,[A]
	PUSH	TP,$!C
	PUSH	TP,CHQUOTE B
	.ISTOP
	TERMIN
	TERMIN

	MCALL	4,FOPEN		;OPEN INPUTCHANNEL
	MOVEM	B,TTICHN+1(TVP)	;SAVE IT
	PUSH	TP,$TATOM	;ASSIGN AS A GLOBAL VALUE
	PUSH	TP,MQUOTE INCHAN
	PUSH	TP,A
	PUSH	TP,B
	MOVE	C,BUFRIN(B)	;GET AUX BUFFER PTR
	MOVE	A,[PUSHJ P,TYI]
	MOVEM	A,IOIN2(C)	;MORE OF A WINNER
	MOVE	A,[PUSHJ P,TYO]
	MOVEM	A,ECHO(C)	;ECHO INS
	MCALL	2,SETG

;GENERATE AN INITIAL PROCESS AND SWAP IT IN

	PUSHJ	P,ICR	;CREATE IT
	MOVE	D,B	;SET UP TO CALL SWAP
	JSP	C,SWAP	;AND SWAP IN
	MOVEM	PVP,MAINPR"	;SAVE AS THE MAIN PROCESS
	PUSH	TP,[TENTRY,,TOPLEV]	;BUILD DUMMY FRAME
	PUSH	TP,[1,,0]
	PUSH	TP,[0]
	PUSH	TP,SP
	PUSH	TP,P
	MOVE	C,TP	;COPY TP
	ADD	C,[3,,3]	;FUDGE
	PUSH	TP,C	;TPSAV PUSHED
	PUSH	TP,PP
	PUSH	TP,[TOPLEV]
	HRRI	TB,(TP)	;SETUP TB
	HRLI	TB,2
	ADD	TB,[1,,1]
	MOVEM	TB,TBINIT+1(PVP)

; CREATE LIST OF ROOT AND NEW OBLIST

	MCALL	0,MOBLIST	;MAKE OBLIST
	PUSH	TP,A	;SAVE RESULTS
	PUSH	TP,B
	PUSH	TP,ROOT(TVP)
	PUSH	TP,ROOT+1(TVP)
	MCALL	2,LIST	;MAKE LIST
	MOVEM	A,ROOT(TVP)
	MOVEM	B,ROOT+1(TVP)
	PUSH	TP,$TATOM	;ASSIGN TO GLOBAL VALUE
	PUSH	TP,MQUOTE OBLIST
	PUSH	TP,A
	PUSH	TP,B
	MCALL	2,SETG


	PUSH	TP,$TATOM
	PUSH	TP,MQUOTE QUITTER
	MCALL	1,LIST
	PUSH	TP,$TCHAN		;SET UP CNTL-G INT
	PUSH	TP,TTICHN+1(TVP)
	PUSH	TP,$TFORM
	PUSH	TP,B
	MCALL	2,ONCHAR		;TURN ON INTERRUPT
	MOVEI	A,SETUP		;POINT TO START
	MOVEM	A,CODTOP
	ADDI	A,1
	SUB	A,PARBOT	;FIND WHERE PAIRS SHOULD GO
	MOVEM	A,PARNEW
	PUSH	P,[14.,,14.]	;PUSH A SMALL PRGRM ONTO P
	MOVEI	A,1(P)	;POINT TO ITS START
	PUSH	P,[JRST AGC]	;GO TO AGC
	PUSH	P,[MOVE B,PSTO+1(PVP)]	;GET SAVED P
	PUSH	P,[SUB B,-13.(P)]	;FUDGE TO POP OFF PROGRAM
	PUSH	P,[MOVEM B,PSAV(TB)]	;INTO FRAME
	PUSH	P,[MOVE B,TPSTO+1(PVP)]	;GET TP
	PUSH	P,[MOVEM B,TPSAV(TB)]	;STORE IT
	PUSH	P,[MOVE B,SPSTO+1(PVP)]	;SP
	PUSH	P,[MOVEM B,SPSAV(TB)]
	PUSH	P,[MOVEI B,TOPLEV]	;WHERE TO GO
	PUSH	P,[MOVEM B,PCSAV(TB)]
	PUSH	P,[MOVSI B,(.VALUE )]
	PUSH	P,[HRRI B,C]
	PUSH	P,[JRST B]	;GO DO VALRET
	PUSH	P,[A]	;RETURN ADDRESS FOR AGC
	PUSH	P,A	;SAVE A
	MOVE	A,[JRST -11.(P)]	;WHEER TO START
	SUB	P,[1,,1]	;REMOVE LOSSAGE
	MOVE	0,[JUMPA START]
	MOVE	B,[.VALUE C]	;SETUP VALRET
	MOVE	C,[ASCII \0/9\]
	MOVE	D,[ASCII \B!Qî\]
	MOVE	E,[ASCIZ \*\]		;TERMINATE
	JRST	@1(P)		;GO DO IT

; CHECK PAIR SPACE

PAIRCH:	CAMG	A,B
	JRST	SETTV		;O.K.

DEATH1:	MOVEI	B,[ASCIZ /LOSSAGE--CODE AND DATA OVERLAP
/]
	PUSHJ	P,MSGTYP
	.VALUE

;CHARACTER STRING HACKER

CHACK:	MOVE	A,(C)		;GET TYPE
	HLLZM	A,(D)		;STORE IN NEW HOME
	MOVE	B,1(C)		;GET POINTER
	HLRE	E,B		;-LENGHT
	SUBM	B,E		;E POINTS TO DOPE WORDS
	ADDI	E,1		;POINT TO 2ND
	HRRM	E,(D)		;INTO PE CELL
	HRLI	B,350700	;MAKE POINT BYTER
	MOVEM	B,1(D)		;AND STORE IT
	ANDI	A,-1	;CLEAR LH OF A
	JUMPE	A,SETLP	;JUMP IF NO REF
	MOVE	E,(P)		;GET OFFSET
	LSH	E,1
	HRRZ	B,-1(A)	;SEE IF PREVIOUS INSTRUCTION REFERS TO $TCHSTR
	CAIE	B,$TCHSTR	;SKIP IF IT DOES
	JRST	CHACK1	;NO, JUST DO CHQUOTE PART
	HRRM	E,-1(A)	;CLOBBER
	MOVEI	B,TVP
	DPB	B,[220400,,-1(A)]	;CLOBBER INDEX FIELD
CHACK1:	ADDI	E,1
	HRRM	E,(A)		;STORE INTO REFERENCE
	JRST	SETLP

; PROCESS AN ATOM AND ADD IT TO AN APPROPRIATE OBLIST IF IT ISN'T
; ALREADY THERE

ATOMHK:	PUSH	TP,$TVEC	;SAVE TV POINTERS
	PUSH	TP,C
	PUSH	TP,$TVEC
	PUSH	TP,D
	MOVE	B,1(C)		;GET THE ATOM
	PUSH	TP,$TATOM	;AND SAVE
	PUSH	TP,B
	HRRZ	A,(B)		;GET OBLIST SPEC FROM ATOM
	LSH	A,1
	ADDI	A,1(TB)		;POINT TO ITS HOME
	PUSH	TP,$TOBLS
	PUSH	TP,(A)		;AND SAV IT

	ADD	B,[2,,2]	;POINT TO ATOM'S PNAME
	MOVEI	A,0		;FOR HASHING
	XOR	A,(B)
	AOBJN	B,.-1
	MOVMS	A		;FORCE POSITIVE RESULT
	IDIV	A,OBLNT
	HRLS	B		;REMAINDER IN B IS BUCKET
	ADDB	B,(TP)		;UPDATE POINTER

	SKIPN	C,(B)		;GOBBLE BUCKET CONTENTS
	JRST	USEATM		;NONE, LEAVE AND USE THIS ATOM
OBLOO3:	MOVE	E,-2(TP)	;RE-GOBBLE ATOM
	ADD	E,[2,,2]	;POINT TO PNAME
	SKIPN	D,1(C)		;CHECK LIST ELEMNT
	JRST	NXTBCK		;0, CHECK NEXT IN THIS BUCKET
	ADD	D,[2,,2]	;POINT TO PNAME
OBLOO2:	MOVE	A,(D)		;GET A WORD
	CAME	A,(E)		;COMPARE
	JRST	NXTBCK		;THEY DIFFER, TRY NEX
OBLOOP:	AOBJP	E,CHCKD		;COULD BE A MATCH, GO CHECK
	AOBJN	D,OBLOO2	;HAVEN'T LOST YET

NXTBCK:	HRRZ	C,(C)		;CDR THE LIST
	JUMPN	C,OBLOO3	;IF NOT NIL, KEEP TRYING

;HERE IF THIS ATOM MUST BE PUT ON OBLIST

USEATM:	MOVE	B,(TP)		;POINTER TO BUCKET
	HRRZ	C,(B)		;POINTER TO LIST IN THIS BUCKET
	PUSH	TP,$TATOM	;GENERATE CALL TO CONS
	PUSH	TP,-3(TP)
	PUSH	TP,$TLIST
	PUSH	TP,C
	MCALL	2,CONS		;CONS IT UP
	MOVE	C,(TP)		;REGOBBLE BUCKET POINTER
	HRRZM	B,(C)		;CLOBBER
	MOVE	B,-2(TP)	;POINT TO ATOM
	PUSHJ	P,VALMAK	;MAKE A GLOBAL VALUE FOR THIS LOSER
	MOVE	C,-6(TP)	;RESET POINTERS
	MOVE	D,-4(TP)
	SUB	TP,[8,,8]
	MOVE	B,(C)		;MOVE THE ENTRY
	HLLZM	B,(D)		;DON'T WANT REF POINTER STORED
	MOVE	A,1(C)		;AND MOVE ATOM
	MOVEM	A,1(D)
	MOVE	A,(P)		;GET CURRENT OFFSET
	LSH	A,1
	ADDI	A,1
	ANDI	B,-1		;CHECKFOR REAL REF
	JUMPE	B,SETLP
	HRRM	A,(B)		;CLOBBER CODE
	JRST	SETLP


; A POSSIBLE MATCH ARRIVES HERE

CHCKD:	AOBJN	D,NXTBCK	;SIZES DIFFER, JUMP
	MOVE	D,1(C)		;THEY MATCH!,  GET EXISTING ATOM
	HLRZ	A,(D)		;GET TYPE OF IT
	CAIE	A,TUNBOU	;UNBOUND?
	JRST	A1VAL		;YES, CONTINUE
	MOVE	B,-2(TP)	;GET NEW ATOM
	MOVE	A,(B)		;MOVE VALUE
	MOVEM	A,(D)
	MOVE	A,1(B)
	MOVEM	A,1(D)
	MOVE	B,D		;EXISTING ATOM TO B
	PUSHJ	P,VALMAK	;MAKE A VALUE

;NOW FIND ATOMS OCCURENCE IN XFER VECTOR

OFFIND:	MOVE	D,-4(TP)	;GET CURRENT POINTER INTO TP
	MOVE	C,TVP		;AND A COPY OF TVP
	MOVEI	A,0		;INITIALIZE COUNTER
ALOOP:	CAMN	B,1(C)		;IS THIS IT?
	JRST	AFOUND
	ADD	C,[2,,2]	;BUMP COUNTER
	CAMGE	C,D		;HAVE WE HIT END
	AOJA	A,ALOOP		;NO, KEEP LOOKING

	MOVEI	B,[ASCIZ /LOSSAGE--ATOM DISAPPEARED
/]
TYPIT:	PUSHJ	P,MSGTYP
	.VALUE

AFOUND:	LSH	A,1		;FOUND ATOM, GET REAL OFFSET
	ADDI	A,1
	MOVE	C,-6(TP)	;GET TV POINTER TO NEW ATOM
	HRRZ	B,(C)		;POINT TO REFERENCE
	SKIPE	B		;ANY THERE?
	HRRM	A,(B)		;YES, CLOBBER AWAY
	SUB	TP,[8,,8]
	JRST	SETLP1		;AND GO ON

A1VAL:	MOVE	B,-2(TP)	;GET NEW ATOM POINTER
	HLRZ	C,(B)		;GET VALUE'S TYPE
	MOVE	B,D		;NOW PUT EXISTING ATOM IN B
	CAIN	C,TUNBOU	;UNBOUND?
	JRST	OFFIND		;YES, WINNER

	MOVEI	B,[ASCIZ /LOSSAGE--ATOM TRIES TO HAVE 2 VALUES
/]
	JRST	TYPIT


;MAKE A VALUE IN SLOT ON GLOBAL SP

VALMAK:	HLRZ	A,(B)		;TYPE OF VALUE
	CAIN	A,TUNBOU	;VALUE?
	POPJ	P,		;NO, ALL DONE
	MOVE	A,GLOBSP+1(TVP)	;GET POINTER TO GLOBAL SP
	SUB	A,[4,,4]	;ALLOCATE SPACE
	CAMG	A,GLOBAS+1(TVP)	;CHECK FOR OVERFLOW
	JRST	SPOVFL
	MOVEM	A,GLOBSP+1(TVP)	;STORE IT BACK
	MOVE	C,(B)		;GET TYPE CELL
	HLLZM	C,2(A)		;INTO TYPE CELL
	MOVE	C,1(B)		;GET VALUE
	MOVEM	C,3(A)		;INTO VALUE SLOT
	MOVSI	C,TATOM		;GET TATOM,,0
	MOVEM	C,(A)
	MOVEM	B,1(A)		;AND POINTER TO ATOM
	MOVSI	C,TLOCI		;NOW CLOBBER THE ATOM
	MOVEM	C,(B)		;INTO TYPE CELL
	ADD	A,[2,,2]	;POINT TO VALUE
	MOVEM	A,1(B)
	POPJ	P,

SPOVFL:	MOVEI	B,[ASCIZ /LOSSAGE--GLOBAL SP OVERFLOW
/]
	JRST	TYPIT


OBTBL:	INTOBL+1(TVP)
	ERROBL+1(TVP)
	ROOT+1(TVP)

END SETUP