--- /dev/null
+TITLE MAPS -- MAP FUNCTIONS FOR MUDDLE\r
+\r
+RELOCATABLE\r
+\r
+.INSRT MUDDLE >\r
+\r
+.GLOBAL TYPSEG,NXTLM,NAPT,APLQ,INCR1,SPECBI,FRMSTK,MAPPLY\r
+.GLOBAL CHFSWP,SSPEC1,ILVAL,CHUNW\r
+\r
+; PSTACK OFFSETS\r
+\r
+INCNT==0 ; INNER LOOP COUNT\r
+LISTNO==-1 ; ARG NUMBER BEING HACKED\r
+ARGCNT==-2 ; FINAL ARG COUNTER\r
+NARGS==-3 ; NUMBER OF STRUCTURES\r
+NTHRST==-4 ; 0=> MAP REST, OTHERWISE MAP FIRST\r
+\r
+; MAP THE "CAR" OF EACH LIST\r
+\r
+MFUNCTION MAPF,SUBR\r
+\r
+ PUSH P,. ; PUSH NON-ZERO\r
+ JRST MAP1\r
+\r
+; MAP THE "CDR" OF EACH LIST\r
+\r
+MFUNCTION MAPR,SUBR\r
+\r
+ PUSH P,[0]\r
+\r
+MAP1: ENTRY\r
+ HLRE C,AB ; HOW MANY ARGS\r
+ ASH C,-1 ; TO # OF PAIRS\r
+ ADDI C,3 ; AT LEAST 3\r
+ JUMPG C,TFA ; NOT ENOUGH\r
+ GETYP A,(AB) ; TYPE OF CONSTRUCTOR\r
+ CAIN A,TFALSE ; ANY CONSING NEEDE?\r
+ JRST MAP2 ; NO, SKIP CHECK\r
+ PUSHJ P,APLQ ; CHECK IF APPLICABLE\r
+ JRST NAPT ; NO, ERROR\r
+MAP2: MOVNS C ; POS NO. OF ARGS (-3)\r
+ ADDI C,1 ; C/ NOW # OF LISTS...\r
+ PUSH P,C ; SAVE IT\r
+ PUSH TP,[TATOM,,-1] ; ALL **GFP** INSTRUCTIONS ARE TO DO WITH MAPRET\r
+ PUSH TP,MQUOTE LMAP,[LMAP ]INTRUP\r
+ PUSHJ P,FRMSTK ; **GFP**\r
+ PUSH TP,[0] ; **GFP**\r
+ PUSH TP,[0] ; **GFP**\r
+ PUSHJ P,SPECBIND ; **GFP**\r
+ MOVE C,(P) ; RESTORE COUNT OF ARGS\r
+ MOVE A,AB ; COPY ARG POINTER\r
+ MOVSI 0,TAB ; CLOBBER A'S TYPE\r
+ MOVEM 0,ASTO(PVP)\r
+\r
+ARGLP: INTGO ; STACK MAY OVERFLOW\r
+ PUSH TP,4(A) ; SKIP FCNS\r
+ PUSH TP,5(A)\r
+ ADD A,[2,,2]\r
+ SOJG C,ARGLP ; ALL UP ON STACK\r
+\r
+; ALL STRUCTURES ARE ON THE STACK, NOW PUSH THE CONSTRUCTOR\r
+\r
+ PUSH TP,(AB) ; CONSTRUCTOR\r
+ PUSH TP,1(AB)\r
+ SETZM ASTO(PVP)\r
+ PUSH P,[-1] ; FUNNY TEMPS\r
+ PUSH P,[0]\r
+ PUSH P,[0]\r
+\r
+; OUTER LOOP CDRING EACH STRUCTURE\r
+\r
+OUTRLP: SETZM LISTNO(P) ; START AT 0TH LIST\r
+ MOVE 0,NARGS(P) ; TOTAL # OF STRUCS\r
+ MOVEM 0,INCNT(P) ; AS COUNTER IN INNER LOOP\r
+ PUSH TP,2(AB) ; PUSH THE APPLIER\r
+ PUSH TP,3(AB)\r
+\r
+; INNER LOOP, CONS UP EACH APPLICATION\r
+\r
+INRLP: INTGO\r
+ MOVEI E,2 ; READY TO BUMP LISTNO\r
+ ADDB E,LISTNO(P) ; CURRENT STORED AND IN C\r
+ ADDI E,(TB)4 ; POINT TO A STRUCTURE\r
+ MOVE A,(E) ; PICK IT UP\r
+ MOVE B,1(E) ; AND VAL\r
+ PUSHJ P,TYPSEG ; SETUP TO REST IT ETC.\r
+ SKIPL ARGCNT(P) ; DONT INCR THE 1ST TIME\r
+ XCT INCR1(C) ; INCREMENT THE LOSER\r
+ MOVE 0,DSTO(PVP) ; UPDATE THE LIST\r
+ MOVEM 0,(E)\r
+ MOVEM D,1(E) ; CLOBBER AWAY\r
+ PUSH TP,DSTO(PVP) ; FOR REST CASE\r
+ PUSH TP,D\r
+ PUSHJ P,NXTLM ; SKIP IF GOT ONE, ELSE DONT\r
+ JRST DONEIT ; FINISHED\r
+ SETZM DSTO(PVP)\r
+ SKIPN NTHRST(P) ; SKIP IF MAP REST\r
+ JRST INRLP1\r
+ MOVEM A,-1(TP) ; IUSE AS ARG\r
+ MOVEM B,(TP)\r
+INRLP1: SOSE INCNT(P) ; COUNT ARGS\r
+ JRST INRLP ; MORE, GO DO THEM\r
+\r
+\r
+; ALL ARGS PUSHED, APPLY USER FCN\r
+\r
+ SKIPGE ARGCNT(P) ; UN NEGATE ARGCNT\r
+ SETZM ARGCNT(P)\r
+ MOVE A,NARGS(P) ; GET # OF ARGS\r
+ ADDI A,1\r
+ ACALL A,MAPPLY ; APPLY THE BAG BITER\r
+\r
+ GETYP 0,(AB) ; GET TYPE OF CONSTRUCTOR\r
+ CAIN 0,TFALSE ; SKIP IF ONE IS THERE\r
+ JRST OUTRL1\r
+ PUSH TP,A\r
+ PUSH TP,B\r
+ AOS ARGCNT(P)\r
+ JRST OUTRLP\r
+\r
+OUTRL1: MOVEM A,-1(TP) ; SAVE PARTIAL VALUE\r
+ MOVEM B,(TP)\r
+ JRST OUTRLP\r
+\r
+; HERE IF ALL FINISHED\r
+\r
+DONEIT: HRLS C,LISTNO(P) ; HOW MANY DONE\r
+ SUB TP,[2,,2] ; FLUSH SAVED VAL\r
+ SUB TP,C ; FLUSH TUPLE OF CRUFT\r
+DONEI1: SKIPGE ARGCNT(P)\r
+ SETZM ARGCNT(P) ; IN CASE STILL NEGATIVE\r
+ SETZM DSTO(PVP) ; UNSCREW\r
+ GETYP 0,(AB) ; ANY CONSTRUCTOR\r
+ CAIN 0,TFALSE\r
+ JRST MFINIS ; NO, LEAVE\r
+ AOS D,ARGCNT(P) ; IF NO ARGS\r
+ ACALL D,APPLY ; APPLY IT\r
+\r
+ JRST FINIS\r
+\r
+; HERE TO FINISH IF CONSTRUCTOR WAS #FALSE ()\r
+\r
+MFINIS: POP TP,B\r
+ POP TP,A\r
+ JRST FINIS\r
+\r
+; **GFP** FROM HERE TO THE END\r
+\r
+MFUNCTION MAPLEAVE,SUBR\r
+\r
+ ENTRY\r
+\r
+ CAMGE AB,[-3,,0]\r
+ JRST TMA\r
+ MOVE B,MQUOTE LMAP,[LMAP ]INTRUP \r
+ PUSHJ P,ILVAL\r
+ GETYP 0,A\r
+ CAIE 0,TFRAME ; MAKE SURE WINNER\r
+ JRST NOTM\r
+ PUSH TP,A\r
+ PUSH TP,B\r
+ MOVEI B,-1(TP) ; POINT TO FRAME POINTER\r
+ PUSHJ P,CHFSWP\r
+ PUSHJ P,CHUNW\r
+ JUMPL C,MAPL1 ; RET VAL SUPPLIED\r
+ MOVSI A,TATOM\r
+ MOVE B,MQUOTE T\r
+ JRST FINIS\r
+\r
+MAPL1: MOVE A,(C)\r
+ MOVE B,1(C)\r
+ JRST FINIS\r
+\r
+MFUNCTION MAPSTOP,SUBR\r
+\r
+ ENTRY\r
+\r
+ PUSH P,[1]\r
+ JRST MAPREC\r
+\r
+MFUNCTION MAPRET,SUBR\r
+\r
+ ENTRY\r
+\r
+ PUSH P,[0]\r
+MAPREC: MOVE B,MQUOTE LMAP,[LMAP ]INTRUP\r
+ PUSHJ P,ILVAL ; GET VALUE\r
+ GETYP 0,A ; FRAME?\r
+ CAIE 0,TFRAME\r
+ JRST NOTM\r
+ PUSH TP,A\r
+ PUSH TP,B\r
+ MOVEI B,-1(TP)\r
+ POP P,0 ; RET/STOP SWITCH\r
+ JUMPN 0,MAPRC1 ; JUMP IF STOP\r
+ PUSHJ P,CHFSWP ; CHECK IT OUT (AND MAYBE SWAP)\r
+ PUSH P,[NLOCR]\r
+ JRST MAPRC2\r
+MAPRC1: PUSHJ P,CHFSWP\r
+ PUSH P,[NLOCR1]\r
+MAPRC2: HRRZ E,SPSAV(B) ; UNBIND BEFORE RETURN\r
+ PUSH TP,$TAB\r
+ PUSH TP,C\r
+ ADDI E,1 ; FUDGE FOR UNBINDER\r
+ PUSHJ P,SSPEC1 ; UNBINDER\r
+ HLRE D,(TP) ; FIND NUMBER\r
+ JUMPE D,MAPRE1 ; SKIP IF NONE TO MOVE\r
+ MOVNS E,D ; AND PLUS IT\r
+ HRLI E,(E) ; COMPUTE NEW TP\r
+ ADD E,TPSAV(B) ; NEW TP\r
+ HRRZ C,TPSAV(B) ; GET OLD TOP\r
+ MOVEM E,TPSAV(B)\r
+ HRL C,(TP) ; AND NEW BOT\r
+ ADDI C,1\r
+ BLT C,(E) ; BRING IT ALL DOWN\r
+MAPRE1: ASH D,-1 ; NO OF ARGS\r
+ HRRI TB,(B) ; PREPARE TO FINIS\r
+ MOVSI A,TFIX\r
+ MOVEI B,(D)\r
+ POP P,0 ; GET PC TO GO TO\r
+ MOVEM 0,PCSAV(TB)\r
+ JRST CONTIN ; BACK TO MAPPER\r
+\r
+NLOCR1: TDZA A,A ; ZER SW\r
+NLOCR: MOVEI A,1\r
+ GETYP 0,(AB) ; CHECK IF BUILDING\r
+ CAIN 0,TFALSE\r
+ JRST FLUSHM ; REMOVE GOODIES\r
+ ADDM B,ARGCNT(P) ; BUMP ARG COUNTER\r
+NLOCR2: JUMPE A,DONEI1\r
+ JRST OUTRLP\r
+\r
+FLUSHM: ASH B,1 ; FLUSH GOODIES DROPPED\r
+ HRLI B,(B)\r
+ SUB TP,B\r
+ JRST NLOCR2\r
+\r
+NOTM: PUSH TP,$TATOM\r
+ PUSH TP,EQUOTE NOT-IN-MAP-FUNCTION\r
+ JRST CALER1\r
+\r
+END\r
+\f
\ No newline at end of file
projects / pdp10-muddle.git / blobdiff