--- /dev/null
+
+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
+\f\ 3\f
\ No newline at end of file
projects / pdp10-muddle.git / blobdiff