<mdl.int>/maps.mid.29

   1
   2 TITLE MAPS -- MAP FUNCTIONS FOR MUDDLE
   3
   4 RELOCATABLE
   5
   6 .INSRT MUDDLE >
   7
   8 .GLOBAL TYPSEG,NXTLM,NAPT,APLQ,INCR1,SPECBI,FRMSTK,MAPPLY
   9 .GLOBAL CHFSWP,SSPEC1,ILVAL,CHUNW,DSTORE,PVSTOR,TVSTOR
  10
  11 ; PSTACK OFFSETS
  12
  13 INCNT==0        ; INNER LOOP COUNT
  14 LISTNO==-1      ; ARG NUMBER BEING HACKED
  15 ARGCNT==-2      ; FINAL ARG COUNTER
  16 NARGS==-3       ; NUMBER OF STRUCTURES
  17 NTHRST==-4      ; 0=> MAP REST, OTHERWISE MAP FIRST
  18
  19 ; MAP THE "CAR" OF EACH LIST
  20
  21 IMFUNCTION MAPF,SUBR
  22
  23         PUSH    P,.             ; PUSH NON-ZERO
  24         JRST    MAP1
  25
  26 ; MAP THE "CDR" OF EACH LIST
  27
  28 IMFUNCTION MAPR,SUBR
  29
  30         PUSH    P,[0]
  31
  32 MAP1:   ENTRY
  33         HLRE    C,AB            ; HOW MANY ARGS
  34         ASH     C,-1            ; TO # OF PAIRS
  35         ADDI    C,2             ; AT LEAST 3
  36         JUMPG   C,TFA           ; NOT ENOUGH
  37         GETYP   A,(AB)          ; TYPE OF CONSTRUCTOR
  38         CAIN    A,TFALSE        ; ANY CONSING NEEDE?
  39         JRST    MAP2            ; NO, SKIP CHECK
  40         PUSHJ   P,APLQ          ; CHECK IF APPLICABLE
  41         JRST    NAPT            ; NO, ERROR
  42 MAP2:   MOVNS   C               ; POS NO. OF ARGS (-3)
  43         PUSH    P,C             ; SAVE IT
  44         PUSH    TP,[TATOM,,-1]  ; ALL **GFP** INSTRUCTIONS ARE TO DO WITH MAPRET
  45         PUSH    TP,IMQUOTE LMAP,[LMAP ]INTRUP
  46         PUSHJ   P,FRMSTK        ; **GFP**
  47         PUSH    TP,[0]          ; **GFP**
  48         PUSH    TP,[0]          ; **GFP**
  49         PUSHJ   P,SPECBIND      ; **GFP**
  50         MOVE    C,(P)           ; RESTORE COUNT OF ARGS
  51         MOVE    A,AB            ; COPY ARG POINTER
  52         MOVSI   0,TAB           ; CLOBBER A'S TYPE
  53         MOVE    PVP,PVSTOR+1
  54         MOVEM   0,ASTO(PVP)
  55         JUMPE   C,ARGSDN                ; NOA ARGS?
  56
  57 ARGLP:  INTGO                   ; STACK MAY OVERFLOW
  58         PUSH    TP,4(A)         ; SKIP FCNS
  59         PUSH    TP,5(A)
  60         ADD     A,[2,,2]
  61         SOJG    C,ARGLP         ; ALL UP ON STACK
  62
  63 ; ALL STRUCTURES ARE ON THE STACK, NOW PUSH THE CONSTRUCTOR
  64
  65 ARGSDN: PUSH    TP,(AB)         ; CONSTRUCTOR
  66         PUSH    TP,1(AB)
  67         MOVE    PVP,PVSTOR+1
  68         SETZM   ASTO(PVP)
  69         PUSH    P,[-1]          ; FUNNY TEMPS
  70         PUSH    P,[0]
  71         PUSH    P,[0]
  72
  73 ; OUTER LOOP CDRING  EACH STRUCTURE
  74
  75 OUTRLP: SETZM   LISTNO(P)       ; START AT 0TH LIST
  76         MOVE    0,NARGS(P)      ; TOTAL # OF STRUCS
  77         MOVEM   0,INCNT(P)      ; AS COUNTER IN INNER LOOP
  78         PUSH    TP,2(AB)        ; PUSH THE APPLIER
  79         PUSH    TP,3(AB)
  80
  81 ; INNER LOOP, CONS UP EACH APPLICATION
  82
  83 INRLP:  INTGO
  84         SOSGE   INCNT(P)
  85         JRST    INRLP2
  86         MOVEI   E,2             ; READY TO BUMP LISTNO
  87         ADDB    E,LISTNO(P)     ; CURRENT STORED AND IN C
  88         ADDI    E,(TB)4         ; POINT TO A STRUCTURE
  89         MOVE    A,(E)           ; PICK IT UP
  90         MOVE    B,1(E)          ; AND VAL
  91         PUSHJ   P,TYPSEG        ; SETUP TO REST IT ETC.
  92         MOVE    E,LISTNO(P)
  93         ADDI    E,4(TB)
  94         SKIPL   ARGCNT(P)       ; DONT INCR THE 1ST TIME
  95         XCT     INCR1(C)        ; INCREMENT THE LOSER
  96         MOVE    0,DSTORE        ; UPDATE THE LIST
  97         MOVEM   0,(E)
  98         MOVEM   D,1(E)          ; CLOBBER AWAY
  99         PUSH    TP,DSTORE       ; FOR REST CASE
 100         PUSH    TP,D
 101         PUSHJ   P,NXTLM         ; SKIP IF GOT ONE, ELSE DONT
 102         JRST    DONEIT          ; FINISHED
 103         SETZM   DSTORE
 104         SKIPN   NTHRST(P)       ; SKIP IF MAP REST
 105         JRST    INRLP1
 106         MOVEM   A,-1(TP)        ; IUSE AS ARG
 107         MOVEM   B,(TP)
 108 INRLP1: JRST    INRLP           ; MORE, GO DO THEM
 109
 110
 111 ; ALL ARGS PUSHED, APPLY USER FCN
 112
 113 INRLP2: SKIPGE  ARGCNT(P)       ; UN NEGATE ARGCNT
 114         SETZM   ARGCNT(P)
 115         MOVE    A,NARGS(P)      ; GET # OF ARGS
 116         ADDI    A,1
 117         ACALL   A,MAPPLY        ; APPLY THE BAG BITER
 118
 119         GETYP   0,(AB)          ; GET TYPE OF CONSTRUCTOR
 120         CAIN    0,TFALSE        ; SKIP IF ONE IS THERE
 121         JRST    OUTRL1
 122         PUSH    TP,A
 123         PUSH    TP,B
 124         AOS     ARGCNT(P)
 125         JRST    OUTRLP
 126
 127 OUTRL1: MOVEM   A,-1(TP)        ; SAVE PARTIAL VALUE
 128         MOVEM   B,(TP)
 129         JRST    OUTRLP
 130
 131 ; HERE IF ALL FINISHED
 132
 133 DONEIT: HRLS    C,LISTNO(P)     ; HOW MANY DONE
 134         SUB     TP,[2,,2]       ; FLUSH SAVED VAL
 135         SUB     TP,C            ; FLUSH TUPLE OF CRUFT
 136 DONEI1: SKIPGE  ARGCNT(P)
 137         SETZM   ARGCNT(P)       ; IN CASE STILL NEGATIVE
 138         SETZM   DSTORE          ; UNSCREW
 139         GETYP   0,(AB)          ; ANY CONSTRUCTOR
 140         CAIN    0,TFALSE
 141         JRST    MFINIS          ; NO, LEAVE
 142         AOS     D,ARGCNT(P)     ; IF NO ARGS
 143         ACALL   D,APPLY         ; APPLY IT
 144
 145         JRST    FINIS
 146
 147 ; HERE TO FINISH IF CONSTRUCTOR WAS #FALSE ()
 148
 149 MFINIS: POP     TP,B
 150         POP     TP,A
 151         JRST    FINIS
 152
 153 ; **GFP** FROM HERE TO THE END
 154
 155 MFUNCTION MAPLEAVE,SUBR
 156
 157         ENTRY
 158
 159         CAMGE   AB,[-3,,0]
 160         JRST    TMA
 161         MOVE    B,IMQUOTE LMAP,[LMAP ]INTRUP
 162         PUSHJ   P,ILVAL
 163         GETYP   0,A
 164         CAIE    0,TFRAME        ; MAKE SURE WINNER
 165         JRST    NOTM
 166         PUSH    TP,A
 167         PUSH    TP,B
 168         MOVEI   B,-1(TP)        ; POINT TO FRAME POINTER
 169         PUSHJ   P,CHFSWP
 170         PUSHJ   P,CHUNW
 171         JUMPL   C,MAPL1         ; RET VAL SUPPLIED
 172         MOVSI   A,TATOM
 173         MOVE    B,IMQUOTE T
 174         JRST    FINIS
 175
 176 MAPL1:  MOVE    A,(C)
 177         MOVE    B,1(C)
 178         JRST    FINIS
 179
 180 MFUNCTION MAPSTOP,SUBR
 181
 182         ENTRY
 183
 184         PUSH    P,[1]
 185         JRST    MAPREC
 186
 187 MFUNCTION MAPRET,SUBR
 188
 189         ENTRY
 190
 191         PUSH    P,[0]
 192 MAPREC: MOVE    B,IMQUOTE LMAP,[LMAP ]INTRUP
 193         PUSHJ   P,ILVAL         ; GET VALUE
 194         GETYP   0,A             ; FRAME?
 195         CAIE    0,TFRAME
 196         JRST    NOTM
 197         PUSH    TP,A
 198         PUSH    TP,B
 199         MOVEI   B,-1(TP)
 200         POP     P,0             ; RET/STOP SWITCH
 201         JUMPN   0,MAPRC1        ; JUMP IF STOP
 202         PUSHJ   P,CHFSWP        ; CHECK IT OUT (AND MAYBE SWAP)
 203         PUSH    P,[NLOCR]
 204         JRST    MAPRC2
 205 MAPRC1: PUSHJ   P,CHFSWP
 206         PUSH    P,[NLOCR1]
 207 MAPRC2: HRRZ    E,SPSAV(B)      ; UNBIND BEFORE RETURN
 208         PUSH    TP,$TAB
 209         PUSH    TP,C
 210         ADDI    E,1             ; FUDGE FOR UNBINDER
 211         PUSHJ   P,SSPEC1        ; UNBINDER
 212         HLRE    D,(TP)          ; FIND NUMBER
 213         JUMPE   D,MAPRE1        ; SKIP IF NONE TO MOVE
 214         MOVNS   E,D             ; AND PLUS IT
 215         HRLI    E,(E)           ; COMPUTE NEW TP
 216         ADD     E,TPSAV(B)      ; NEW TP
 217         HRRZ    C,TPSAV(B)      ; GET OLD TOP
 218         MOVEM   E,TPSAV(B)
 219         HRL     C,(TP)          ; AND NEW BOT
 220         ADDI    C,1
 221         BLT     C,(E)           ; BRING IT ALL DOWN
 222 MAPRE1: ASH     D,-1            ; NO OF ARGS
 223         HRRI    TB,(B)          ; PREPARE TO FINIS
 224         MOVSI   A,TFIX
 225         MOVEI   B,(D)
 226         POP     P,0             ; GET PC TO GO TO
 227         MOVEM   0,PCSAV(TB)
 228         JRST    CONTIN          ; BACK TO MAPPER
 229
 230 NLOCR1: TDZA    A,A             ; ZER SW
 231 NLOCR:  MOVEI   A,1
 232         GETYP   0,(AB)          ; CHECK IF BUILDING
 233         CAIN    0,TFALSE
 234         JRST    FLUSHM          ; REMOVE GOODIES
 235         ADDM    B,ARGCNT(P)     ; BUMP ARG COUNTER
 236 NLOCR2: JUMPE   A,DONEI1
 237         JRST    OUTRLP
 238
 239 FLUSHM: ASH     B,1             ; FLUSH GOODIES DROPPED
 240         HRLI    B,(B)
 241         SUB     TP,B
 242         JRST    NLOCR2
 243
 244 NOTM:   ERRUUO  EQUOTE NOT-IN-MAP-FUNCTION
 245
 246 END
 247 \f\ 3\f