sumex/maps.mcr017

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