2 TITLE MAPS -- MAP FUNCTIONS FOR MUDDLE
8 .GLOBAL TYPSEG,NXTLM,NAPT,APLQ,INCR1,SPECBI,FRMSTK,MAPPLY
9 .GLOBAL CHFSWP,SSPEC1,ILVAL,CHUNW,DSTORE,PVSTOR,TVSTOR
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
19 ; MAP THE "CAR" OF EACH LIST
23 PUSH P,. ; PUSH NON-ZERO
26 ; MAP THE "CDR" OF EACH LIST
33 HLRE C,AB ; HOW MANY ARGS
34 ASH C,-1 ; TO # OF PAIRS
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
42 MAP2: MOVNS C ; POS NO. OF ARGS (-3)
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**
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
55 JUMPE C,ARGSDN ; NOA ARGS?
57 ARGLP: INTGO ; STACK MAY OVERFLOW
58 PUSH TP,4(A) ; SKIP FCNS
61 SOJG C,ARGLP ; ALL UP ON STACK
63 ; ALL STRUCTURES ARE ON THE STACK, NOW PUSH THE CONSTRUCTOR
65 ARGSDN: PUSH TP,(AB) ; CONSTRUCTOR
69 PUSH P,[-1] ; FUNNY TEMPS
73 ; OUTER LOOP CDRING EACH STRUCTURE
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
81 ; INNER LOOP, CONS UP EACH APPLICATION
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
91 PUSHJ P,TYPSEG ; SETUP TO REST IT ETC.
94 SKIPL ARGCNT(P) ; DONT INCR THE 1ST TIME
95 XCT INCR1(C) ; INCREMENT THE LOSER
96 MOVE 0,DSTORE ; UPDATE THE LIST
98 MOVEM D,1(E) ; CLOBBER AWAY
99 PUSH TP,DSTORE ; FOR REST CASE
101 PUSHJ P,NXTLM ; SKIP IF GOT ONE, ELSE DONT
102 JRST DONEIT ; FINISHED
104 SKIPN NTHRST(P) ; SKIP IF MAP REST
106 MOVEM A,-1(TP) ; IUSE AS ARG
108 INRLP1: JRST INRLP ; MORE, GO DO THEM
111 ; ALL ARGS PUSHED, APPLY USER FCN
113 INRLP2: SKIPGE ARGCNT(P) ; UN NEGATE ARGCNT
115 MOVE A,NARGS(P) ; GET # OF ARGS
117 ACALL A,MAPPLY ; APPLY THE BAG BITER
119 GETYP 0,(AB) ; GET TYPE OF CONSTRUCTOR
120 CAIN 0,TFALSE ; SKIP IF ONE IS THERE
127 OUTRL1: MOVEM A,-1(TP) ; SAVE PARTIAL VALUE
131 ; HERE IF ALL FINISHED
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
141 JRST MFINIS ; NO, LEAVE
142 AOS D,ARGCNT(P) ; IF NO ARGS
143 ACALL D,APPLY ; APPLY IT
147 ; HERE TO FINISH IF CONSTRUCTOR WAS #FALSE ()
153 ; **GFP** FROM HERE TO THE END
155 MFUNCTION MAPLEAVE,SUBR
161 MOVE B,IMQUOTE LMAP,[LMAP ]INTRUP
164 CAIE 0,TFRAME ; MAKE SURE WINNER
168 MOVEI B,-1(TP) ; POINT TO FRAME POINTER
171 JUMPL C,MAPL1 ; RET VAL SUPPLIED
180 MFUNCTION MAPSTOP,SUBR
187 MFUNCTION MAPRET,SUBR
192 MAPREC: MOVE B,IMQUOTE LMAP,[LMAP ]INTRUP
193 PUSHJ P,ILVAL ; GET VALUE
200 POP P,0 ; RET/STOP SWITCH
201 JUMPN 0,MAPRC1 ; JUMP IF STOP
202 PUSHJ P,CHFSWP ; CHECK IT OUT (AND MAYBE SWAP)
205 MAPRC1: PUSHJ P,CHFSWP
207 MAPRC2: HRRZ E,SPSAV(B) ; UNBIND BEFORE RETURN
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
219 HRL C,(TP) ; AND NEW BOT
221 BLT C,(E) ; BRING IT ALL DOWN
222 MAPRE1: ASH D,-1 ; NO OF ARGS
223 HRRI TB,(B) ; PREPARE TO FINIS
226 POP P,0 ; GET PC TO GO TO
228 JRST CONTIN ; BACK TO MAPPER
230 NLOCR1: TDZA A,A ; ZER SW
232 GETYP 0,(AB) ; CHECK IF BUILDING
234 JRST FLUSHM ; REMOVE GOODIES
235 ADDM B,ARGCNT(P) ; BUMP ARG COUNTER
236 NLOCR2: JUMPE A,DONEI1
239 FLUSHM: ASH B,1 ; FLUSH GOODIES DROPPED
244 NOTM: ERRUUO EQUOTE NOT-IN-MAP-FUNCTION