TITLE MAPS -- MAP FUNCTIONS FOR MUDDLE

RELOCATABLE

.INSRT MUDDLE >

.GLOBAL TYPSEG,NXTLM,NAPT,APLQ,INCR1,SPECBI,FRMSTK,MAPPLY
.GLOBAL CHFSWP,SSPEC1,ILVAL,CHUNW,DSTORE,PVSTOR,TVSTOR

; PSTACK OFFSETS

INCNT==0	; INNER LOOP COUNT
LISTNO==-1	; ARG NUMBER BEING HACKED
ARGCNT==-2	; FINAL ARG COUNTER
NARGS==-3	; NUMBER OF STRUCTURES
NTHRST==-4	; 0=> MAP REST, OTHERWISE MAP FIRST

; MAP THE "CAR" OF EACH LIST

IMFUNCTION MAPF,SUBR

	PUSH	P,.		; PUSH NON-ZERO
	JRST	MAP1

; MAP THE "CDR" OF EACH LIST

IMFUNCTION MAPR,SUBR

	PUSH	P,[0]

MAP1:	ENTRY
	HLRE	C,AB		; HOW MANY ARGS
	ASH	C,-1		; TO # OF PAIRS
	ADDI	C,2		; AT LEAST 3
	JUMPG	C,TFA		; NOT ENOUGH
	GETYP	A,(AB)		; TYPE OF CONSTRUCTOR
	CAIN	A,TFALSE	; ANY CONSING NEEDE?
	JRST	MAP2		; NO, SKIP CHECK
	PUSHJ	P,APLQ		; CHECK IF APPLICABLE
	JRST	NAPT		; NO, ERROR
MAP2:	MOVNS	C		; POS NO. OF ARGS (-3)
	PUSH	P,C		; SAVE IT
	PUSH	TP,[TATOM,,-1]	; ALL **GFP** INSTRUCTIONS ARE TO DO WITH MAPRET
	PUSH	TP,IMQUOTE LMAP,[LMAP ]INTRUP
	PUSHJ	P,FRMSTK	; **GFP**
	PUSH	TP,[0]		; **GFP**
	PUSH	TP,[0]		; **GFP**
	PUSHJ	P,SPECBIND	; **GFP**
	MOVE	C,(P)		; RESTORE COUNT OF ARGS
	MOVE	A,AB		; COPY ARG POINTER
	MOVSI	0,TAB		; CLOBBER A'S TYPE
	MOVE	PVP,PVSTOR+1
	MOVEM	0,ASTO(PVP)
	JUMPE	C,ARGSDN		; NOA ARGS?

ARGLP:	INTGO			; STACK MAY OVERFLOW
	PUSH	TP,4(A)		; SKIP FCNS
	PUSH	TP,5(A)
	ADD	A,[2,,2]
	SOJG	C,ARGLP		; ALL UP ON STACK

; ALL STRUCTURES ARE ON THE STACK, NOW PUSH THE CONSTRUCTOR

ARGSDN:	PUSH	TP,(AB)		; CONSTRUCTOR
	PUSH	TP,1(AB)
	MOVE	PVP,PVSTOR+1
	SETZM	ASTO(PVP)
	PUSH	P,[-1]		; FUNNY TEMPS
	PUSH	P,[0]
	PUSH	P,[0]

; OUTER LOOP CDRING  EACH STRUCTURE

OUTRLP:	SETZM	LISTNO(P)	; START AT 0TH LIST
	MOVE	0,NARGS(P)	; TOTAL # OF STRUCS
	MOVEM	0,INCNT(P)	; AS COUNTER IN INNER LOOP
	PUSH	TP,2(AB)	; PUSH THE APPLIER
	PUSH	TP,3(AB)

; INNER LOOP, CONS UP EACH APPLICATION

INRLP:	INTGO
	SOSGE	INCNT(P)
	JRST	INRLP2
	MOVEI	E,2		; READY TO BUMP LISTNO
	ADDB	E,LISTNO(P)	; CURRENT STORED AND IN C
	ADDI	E,(TB)4		; POINT TO A STRUCTURE
	MOVE	A,(E)		; PICK IT UP
	MOVE	B,1(E)		; AND VAL
	PUSHJ	P,TYPSEG	; SETUP TO REST IT ETC.
	MOVE	E,LISTNO(P)
	ADDI	E,4(TB)
	SKIPL	ARGCNT(P)	; DONT INCR THE 1ST TIME
	XCT	INCR1(C)	; INCREMENT THE LOSER
	MOVE	0,DSTORE	; UPDATE THE LIST
	MOVEM	0,(E)
	MOVEM	D,1(E)		; CLOBBER AWAY
	PUSH	TP,DSTORE	; FOR REST CASE
	PUSH	TP,D
	PUSHJ	P,NXTLM		; SKIP IF GOT ONE, ELSE DONT
	JRST	DONEIT		; FINISHED
	SETZM	DSTORE
	SKIPN	NTHRST(P)	; SKIP IF MAP REST
	JRST	INRLP1
	MOVEM	A,-1(TP)	; IUSE AS ARG
	MOVEM	B,(TP)
INRLP1:	JRST	INRLP		; MORE, GO DO THEM


; ALL ARGS PUSHED, APPLY USER FCN

INRLP2:	SKIPGE	ARGCNT(P)	; UN NEGATE ARGCNT
	SETZM	ARGCNT(P)
	MOVE	A,NARGS(P)	; GET # OF ARGS
	ADDI	A,1
	ACALL	A,MAPPLY	; APPLY THE BAG BITER

	GETYP	0,(AB)		; GET TYPE OF CONSTRUCTOR
	CAIN	0,TFALSE	; SKIP IF ONE IS THERE
	JRST	OUTRL1
	PUSH	TP,A
	PUSH	TP,B
	AOS	ARGCNT(P)
	JRST	OUTRLP

OUTRL1:	MOVEM	A,-1(TP)	; SAVE PARTIAL VALUE
	MOVEM	B,(TP)
	JRST	OUTRLP

; HERE IF ALL FINISHED

DONEIT:	HRLS	C,LISTNO(P)	; HOW MANY DONE
	SUB	TP,[2,,2]	; FLUSH SAVED VAL
	SUB	TP,C		; FLUSH TUPLE OF CRUFT
DONEI1:	SKIPGE	ARGCNT(P)
	SETZM	ARGCNT(P)	; IN CASE STILL NEGATIVE
	SETZM	DSTORE		; UNSCREW
	GETYP	0,(AB)		; ANY CONSTRUCTOR
	CAIN	0,TFALSE
	JRST	MFINIS		; NO, LEAVE
	AOS	D,ARGCNT(P)	; IF NO ARGS
	ACALL	D,APPLY		; APPLY IT

	JRST	FINIS

; HERE TO FINISH IF CONSTRUCTOR WAS #FALSE ()

MFINIS:	POP	TP,B
	POP	TP,A
	JRST	FINIS

; **GFP** FROM HERE TO THE END

MFUNCTION MAPLEAVE,SUBR

	ENTRY

	CAMGE	AB,[-3,,0]
	JRST	TMA
	MOVE	B,IMQUOTE LMAP,[LMAP ]INTRUP 
	PUSHJ	P,ILVAL
	GETYP	0,A
	CAIE	0,TFRAME	; MAKE SURE WINNER
	JRST	NOTM
	PUSH	TP,A
	PUSH	TP,B
	MOVEI	B,-1(TP)	; POINT TO FRAME POINTER
	PUSHJ	P,CHFSWP
	PUSHJ	P,CHUNW
	JUMPL	C,MAPL1		; RET VAL SUPPLIED
	MOVSI	A,TATOM
	MOVE	B,IMQUOTE T
	JRST	FINIS

MAPL1:	MOVE	A,(C)
	MOVE	B,1(C)
	JRST	FINIS

MFUNCTION MAPSTOP,SUBR

	ENTRY

	PUSH	P,[1]
	JRST	MAPREC

MFUNCTION MAPRET,SUBR

	ENTRY

	PUSH	P,[0]
MAPREC:	MOVE	B,IMQUOTE LMAP,[LMAP ]INTRUP
	PUSHJ	P,ILVAL		; GET VALUE
	GETYP	0,A		; FRAME?
	CAIE	0,TFRAME
	JRST	NOTM
	PUSH	TP,A
	PUSH	TP,B
	MOVEI	B,-1(TP)
	POP	P,0		; RET/STOP SWITCH
	JUMPN	0,MAPRC1	; JUMP IF STOP
	PUSHJ	P,CHFSWP	; CHECK IT OUT (AND MAYBE SWAP)
	PUSH	P,[NLOCR]
	JRST	MAPRC2
MAPRC1:	PUSHJ	P,CHFSWP
	PUSH	P,[NLOCR1]
MAPRC2:	HRRZ	E,SPSAV(B)	; UNBIND BEFORE RETURN
	PUSH	TP,$TAB
	PUSH	TP,C
	ADDI	E,1		; FUDGE FOR UNBINDER
	PUSHJ	P,SSPEC1	; UNBINDER
	HLRE	D,(TP)		; FIND NUMBER
	JUMPE	D,MAPRE1	; SKIP IF NONE TO MOVE
	MOVNS	E,D		; AND PLUS IT
	HRLI	E,(E)		; COMPUTE NEW TP
	ADD	E,TPSAV(B)	; NEW TP
	HRRZ	C,TPSAV(B)	; GET OLD TOP
	MOVEM	E,TPSAV(B)
	HRL	C,(TP)		; AND NEW BOT
	ADDI	C,1
	BLT	C,(E)		; BRING IT ALL DOWN
MAPRE1:	ASH	D,-1		; NO OF ARGS
	HRRI	TB,(B)		; PREPARE TO FINIS
	MOVSI	A,TFIX
	MOVEI	B,(D)
	POP	P,0		; GET PC TO GO TO
	MOVEM	0,PCSAV(TB)
	JRST	CONTIN		; BACK TO MAPPER

NLOCR1:	TDZA	A,A		; ZER SW
NLOCR:	MOVEI	A,1
	GETYP	0,(AB)		; CHECK IF BUILDING
	CAIN	0,TFALSE
	JRST	FLUSHM		; REMOVE GOODIES
	ADDM	B,ARGCNT(P)	; BUMP ARG COUNTER
NLOCR2:	JUMPE	A,DONEI1
	JRST	OUTRLP

FLUSHM:	ASH	B,1		; FLUSH GOODIES DROPPED
	HRLI	B,(B)
	SUB	TP,B
	JRST	NLOCR2

NOTM:	ERRUUO	EQUOTE NOT-IN-MAP-FUNCTION

END