<mdl.int>/mudsqu.28

   1
   2 TITLE SQUOZE TABLE HANDLER FOR MUDDLE
   3
   4 RELOCATABLE
   5
   6 XJRST==JRST 5,
   7
   8 .INSRT MUDDLE >
   9
  10 SYSQ
  11
  12 .GLOBAL SQUPNT,ATOSQ,SQUTOA,GETSQU,CSQUTA,MPOPJ,SAT,SQUKIL,SQKIL
  13 .GLOBAL MULTSG
  14
  15 ; ROUTINE TO KILL FIXUP TABLE SOMETIMES
  16
  17 SQUKIL: PUSH    P,0                     ; SAVE ACS
  18         HRRZ    0,SQUPNT                ; SEE IF IN INTERPRETER
  19         CAIG    0,HIBOT
  20         JRST    POPJ0
  21         PUSH    P,A
  22         PUSH    P,B
  23         PUSH    P,C
  24         PUSH    P,D
  25         PUSH    P,E
  26         PUSHJ   P,SQKIL                 ; KILL THE BUFFER AND RESTORE INTERPRETER
  27         POP     P,E
  28         POP     P,D
  29         POP     P,C                     ; RESTORE AC'S
  30         POP     P,B
  31         POP     P,A
  32 POPJ0:  POP     P,0
  33         POPJ    P,
  34
  35
  36 ; POINTER TO TABLE FILLED IN BY INITM
  37
  38 ; SUBR TO INTERFACE TO MUDDLE SQUOZE TABLE.
  39 ; IT TAKES AN ARGUMENT OF PRIMTYPE WORD AND RETURNS A FIX GIVING THE
  40 ; LOCATION IF IT IS IN THE SQUOZE TABLE AND OTHERWISE RETURNS FALSE
  41
  42         MFUNCTION SQUOTA,SUBR
  43         ENTRY 1
  44
  45         GETYP   A,(AB)
  46         PUSHJ   P,SAT           ; GET SAT OF ARGUMENT
  47         CAIE    A,S1WORD        ; BETTER BE OF PRIMTYPE WORD
  48         JRST    WTYP1
  49         MOVE    A,1(AB)         ; GET ARGUMENT INTO A
  50         PUSHJ   P,CSQUTA
  51         JFCL
  52         JRST    FINIS
  53
  54
  55 ; COMPILER ENTRY TAKES ARGUMENT IN A
  56
  57 CSQUTA: SUBM    M,(P)           ; RELATAVIZE P
  58         MOVE    E,A             ; ARG TO SQUOTA
  59         TLZ     E,740000        ; FLUSH EXTRA BITS FOR LOOKUP
  60         PUSHJ   P,SQUTOA
  61         JRST    GTFALS
  62         SOS     (P)             ; AND SKIP RETURN
  63         PUSHJ   P,SQUKIL
  64         MOVSI   A,TFIX          ; RETURN FIX
  65         MOVE    B,E
  66         JRST    MPOPJ
  67 GTFALS: PUSHJ   P,SQUKIL
  68         MOVE    A,$TFALSE
  69         MOVEI   B,0
  70         JRST    MPOPJ           ; RETURN A FALSE
  71
  72
  73 ; GIVEN LOCN OF SUBR RET SQUO NAME ARG AND VAL IN E
  74
  75 ATOSQ:  PUSH    P,B
  76         PUSH    P,A
  77         PUSHJ   P,GETSQU
  78 IFE ITS,[
  79         SKIPE   MULTSG
  80          PUSHJ  P,@[.+1]        ; RUN IN 0
  81 ]
  82         MOVE    A,SQUPNT        ; GET TABLE POINTER
  83         MOVE    B,[2,,2]
  84         CAMN    E,1(A)
  85         JRST    ATOSQ1
  86         ADD     A,B
  87         JUMPL   A,.-3
  88 POPABJ: PUSH    P,E                     ; SAVE RESULT
  89         PUSHJ   P,SQUKIL
  90         POP     P,E
  91 IFE ITS,[
  92         SKIPN   MULTSG
  93          JRST   GOON
  94         POP     P,B                     ; GET PC
  95         MOVEI   A,0
  96         HRRI    B,GOON                  ; RUN IN CALLERS SECTIO
  97         XJRST   A
  98 ]
  99 GOON:   POP     P,B
 100         POP     P,A
 101         POPJ    P,
 102
 103 ATOSQ1: MOVE    E,(A)
 104 IFE ITS,[
 105         SKIPN   MULTSG
 106          AOS    -2(P)
 107         SKIPE   MULTSG
 108          AOS    -3(P)
 109 ]
 110 IFN ITS,[
 111         AOS     -2(P)
 112 ]
 113         JRST    POPABJ
 114
 115 ; BINARY SEARCH FOR SQUOZE SYMBOL ARG IN E
 116
 117 SQUTOA: PUSH    P,A
 118         PUSH    P,B
 119         PUSH    P,C
 120         PUSH    P,E
 121         PUSHJ   P,GETSQU
 122         POP     P,E
 123
 124 IFE ITS,[
 125         SKIPE   MULTSG
 126          PUSHJ  P,@[.+1]        ; RUN IN SEC 0
 127 ]
 128         MOVE    A,SQUPNT                ; POINTER TO TABLE
 129         HLRE    B,SQUPNT
 130         MOVNS   B
 131         HRLI    B,(B)           ; B IS CURRENT OFFSET
 132
 133 UP:     ASH     B,-1            ; HALVE TABLE
 134         AND     B,[-2,,-2]      ; FORCE DIVIS BY 2
 135         MOVE    C,A             ; COPY POINTER
 136         JUMPLE  B,LSTHLV        ; CANT GET SMALLER
 137         ADD     C,B
 138         CAMLE   E,(C)           ; SKIP IF EITHER FOUND OR IN TOP
 139         MOVE    A,C             ; POINT TO SECOND HALF
 140         CAMN    E,(C)           ; SKIP IF NOT FOUND
 141         JRST    WON
 142         CAML    E,(C)           ; SKIP IF IN TOP HALF
 143         JRST    UP
 144         HLLZS   C               ; FIX UP OINTER
 145         SUB     A,C
 146         JRST    UP
 147
 148 WON:    MOVE    E,1(C)          ; RET VAL IN E
 149 IFE ITS,[
 150         SKIPN   MULTSG
 151          AOS    -3(P)
 152         SKIPE   MULTSG
 153          AOS    -4(P)
 154 ]
 155 IFN ITS,        AOS     -3(P)           ; SKIP RET
 156 WON1:
 157 IFE ITS,[
 158         SKIPN   MULTSG
 159          JRST   GOON1
 160         POP     P,B                     ; GET PC
 161         MOVEI   A,0
 162         HRRI    B,GOON1                 ; RUN IN CALLERS SECTIO
 163         XJRST   A
 164 ]
 165 GOON1:  POP     P,C
 166         POP     P,B
 167         POP     P,A
 168         POPJ    P,
 169
 170 LSTHLV: CAMN    E,(C)           ; LINEAR SERCH REST
 171         JRST    WON
 172         ADD     C,[2,,2]
 173         JUMPL   C,.-3
 174         JRST    WON1            ; ALL GONE, LOSE
 175
 176
 177 IMPURE
 178 SQUPNT: 0
 179
 180 PURE
 181 END
 182 \f