Twenex Muddle.

[pdp10-muddle.git] / <mdl.int> / mudsqu.mid.28

diff --git a/<mdl.int>/mudsqu.mid.28 b/<mdl.int>/mudsqu.mid.28
new file mode 100644 (file)
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
+\f
\ No newline at end of file