X-Git-Url: https://jxself.org/git/?p=pdp10-muddle.git;a=blobdiff_plain;f=%3Cmdl.int%3E%2Fmudsqu.mid.28;fp=%3Cmdl.int%3E%2Fmudsqu.mid.28;h=17253f615777d6a1e4c1cb5200b18a9a7d205aa6;hp=0000000000000000000000000000000000000000;hb=bab072f950a643ac109660a223b57e635492ac25;hpb=233a3c5245f8274882cc9d27a3c20e9b3678000c

diff --git a/<mdl.int>/mudsqu.mid.28 b/<mdl.int>/mudsqu.mid.28
new file mode 100644
index 0000000..17253f6
--- /dev/null
+++ b/<mdl.int>/mudsqu.mid.28
@@ -0,0 +1,181 @@
+
+TITLE SQUOZE TABLE HANDLER FOR MUDDLE
+
+RELOCATABLE
+
+XJRST==JRST 5,
+
+.INSRT MUDDLE >
+
+SYSQ
+
+.GLOBAL SQUPNT,ATOSQ,SQUTOA,GETSQU,CSQUTA,MPOPJ,SAT,SQUKIL,SQKIL
+.GLOBAL MULTSG
+
+; ROUTINE TO KILL FIXUP TABLE SOMETIMES
+
+SQUKIL:	PUSH	P,0			; SAVE ACS
+	HRRZ	0,SQUPNT		; SEE IF IN INTERPRETER
+	CAIG	0,HIBOT
+	JRST	POPJ0
+	PUSH	P,A
+	PUSH	P,B
+	PUSH	P,C
+	PUSH	P,D
+	PUSH	P,E
+	PUSHJ	P,SQKIL			; KILL THE BUFFER AND RESTORE INTERPRETER
+	POP	P,E
+	POP	P,D
+	POP	P,C			; RESTORE AC'S
+	POP	P,B
+	POP	P,A
+POPJ0:	POP	P,0
+	POPJ	P,
+
+
+; POINTER TO TABLE FILLED IN BY INITM
+
+; SUBR TO INTERFACE TO MUDDLE SQUOZE TABLE.
+; IT TAKES AN ARGUMENT OF PRIMTYPE WORD AND RETURNS A FIX GIVING THE
+; LOCATION IF IT IS IN THE SQUOZE TABLE AND OTHERWISE RETURNS FALSE
+
+	MFUNCTION SQUOTA,SUBR
+	ENTRY 1
+
+	GETYP	A,(AB)
+	PUSHJ	P,SAT		; GET SAT OF ARGUMENT
+	CAIE	A,S1WORD	; BETTER BE OF PRIMTYPE WORD
+	JRST	WTYP1
+	MOVE	A,1(AB)		; GET ARGUMENT INTO A
+	PUSHJ	P,CSQUTA
+	JFCL
+	JRST	FINIS
+
+
+; COMPILER ENTRY TAKES ARGUMENT IN A
+
+CSQUTA:	SUBM	M,(P)		; RELATAVIZE P
+	MOVE	E,A		; ARG TO SQUOTA
+	TLZ	E,740000	; FLUSH EXTRA BITS FOR LOOKUP
+	PUSHJ	P,SQUTOA
+	JRST	GTFALS
+	SOS	(P)		; AND SKIP RETURN
+	PUSHJ	P,SQUKIL
+	MOVSI	A,TFIX		; RETURN FIX
+	MOVE	B,E
+	JRST	MPOPJ
+GTFALS:	PUSHJ	P,SQUKIL
+	MOVE	A,$TFALSE
+	MOVEI	B,0
+	JRST	MPOPJ		; RETURN A FALSE
+
+
+; GIVEN LOCN OF SUBR RET SQUO NAME ARG AND VAL IN E
+
+ATOSQ:	PUSH	P,B
+	PUSH	P,A
+	PUSHJ	P,GETSQU
+IFE ITS,[
+	SKIPE	MULTSG
+	 PUSHJ	P,@[.+1]	; RUN IN 0
+	MOVE	A,SQUPNT	; GET TABLE POINTER
+	MOVE	B,[2,,2]
+	CAMN	E,1(A)
+	JRST	ATOSQ1
+	ADD	A,B
+	JUMPL	A,.-3
+POPABJ:	PUSH	P,E			; SAVE RESULT
+	PUSHJ	P,SQUKIL
+	POP	P,E
+IFE ITS,[
+	SKIPN	MULTSG
+	 JRST	GOON
+	POP	P,B			; GET PC
+	MOVEI	A,0
+	HRRI	B,GOON			; RUN IN CALLERS SECTIO
+	XJRST	A
+]
+GOON:	POP	P,B
+	POP	P,A
+	POPJ	P,
+
+ATOSQ1:	MOVE	E,(A)
+IFE ITS,[
+	SKIPN	MULTSG
+	 AOS	-2(P)
+	SKIPE	MULTSG
+	 AOS	-3(P)
+]
+IFN ITS,[
+	AOS	-2(P)
+]
+	JRST	POPABJ
+
+; BINARY SEARCH FOR SQUOZE SYMBOL ARG IN E
+
+SQUTOA:	PUSH	P,A
+	PUSH	P,B
+	PUSH	P,C
+	PUSH	P,E
+	PUSHJ	P,GETSQU
+	POP	P,E
+
+IFE ITS,[
+	SKIPE	MULTSG
+	 PUSHJ	P,@[.+1]	; RUN IN SEC 0
+]
+	MOVE	A,SQUPNT		; POINTER TO TABLE
+	HLRE	B,SQUPNT
+	MOVNS	B
+	HRLI	B,(B)		; B IS CURRENT OFFSET
+
+UP:	ASH	B,-1		; HALVE TABLE
+	AND	B,[-2,,-2]	; FORCE DIVIS BY 2
+	MOVE	C,A		; COPY POINTER
+	JUMPLE	B,LSTHLV	; CANT GET SMALLER
+	ADD	C,B
+	CAMLE	E,(C)		; SKIP IF EITHER FOUND OR IN TOP
+	MOVE	A,C		; POINT TO SECOND HALF
+	CAMN	E,(C)		; SKIP IF NOT FOUND
+	JRST	WON
+	CAML	E,(C)		; SKIP IF IN TOP HALF
+	JRST	UP
+	HLLZS	C		; FIX UP OINTER
+	SUB	A,C
+	JRST	UP
+
+WON:	MOVE	E,1(C)		; RET VAL IN E
+IFE ITS,[
+	SKIPN	MULTSG
+	 AOS	-3(P)
+	SKIPE	MULTSG
+	 AOS	-4(P)
+]
+IFN ITS,	AOS	-3(P)		; SKIP RET
+WON1:
+IFE ITS,[
+	SKIPN	MULTSG
+	 JRST	GOON1
+	POP	P,B			; GET PC
+	MOVEI	A,0
+	HRRI	B,GOON1			; RUN IN CALLERS SECTIO
+	XJRST	A
+]
+GOON1:	POP	P,C
+	POP	P,B
+	POP	P,A
+	POPJ	P,
+
+LSTHLV:	CAMN	E,(C)		; LINEAR SERCH REST
+	JRST	WON
+	ADD	C,[2,,2]
+	JUMPL	C,.-3
+	JRST	WON1		; ALL GONE, LOSE
+
+
+IMPURE
+SQUPNT:	0
+
+PURE
+END
+
\ No newline at end of file