<mdl.int>/mudsqu.mcr025.1

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