--- /dev/null
+TITLE INITIALIZATION FOR MUDDLE\r
+\r
+RELOCATABLE\r
+\r
+LAST==1 ;POSSIBLE CHECKS DONE LATER\r
+\r
+.INSRT MUDDLE >\r
+\r
+SYSQ\r
+\r
+IFE ITS,[\r
+FATINS==.FATAL"\r
+SEVEC==104000,,204\r
+]\r
+\r
+IMPURE\r
+\r
+OBSIZE==151. ;DEFAULT OBLIST SIZE\r
+\r
+.LIFG <TVBASE+TVLNT-TVLOC>\r
+.LOP .VALUE\r
+.ELDC\r
+\r
+\r
+.GLOBAL SETUP,TPBAS,GCPDL,GCPVP,PVBASE,PVLNT,PARNEW,AAGC,ICR,SWAP,OBLNT,MSGTYP\r
+.GLOBAL ICLOS,OCLOS,GLOBASE,GLOBSP,PARBOT,PARTOP,CODTOP,START,BEGIN,VECBOT,VECTOP,TPBASE\r
+.GLOBAL LISTEN,ROOT,INITIAL,TBINIT,TOPLEV,INTOBL,ERROBL,MUDOBL,TTYOPE,RESFUN,QUITTER\r
+.GLOBAL IOINS,BUFRIN,IOIN2,ECHO,MTYI,MTYO,MUDSTR,P.TOP,TTICHN,TTOCHN,TYPVEC\r
+.GLOBAL PDLBUF,PHIBOT,%UNAM,PURVEC,STOSTR,ISTOST,TD.LNT,TD.PUT,TD.GET,CAFRE1\r
+; INIITAL AMOUNT OF AFREE SPACE\r
+\r
+STOSTR: BLOCK 400 ; A RANDOM AMOUNT\r
+ISTOST: 401,,0\r
+\r
+SETUP:\r
+IFN ITS, .SUSET [.RUNAM,,%UNAM] ; FOR AGC'S BENFIT\r
+ MOVE P,GCPDL ;GET A PUSH DOWN STACK\r
+IFN ITS, .SUSET [.SMASK,,[200000]] ; ENABLE PDL OVFL\r
+ MOVE TVP,[-TVLNT,,TVBASE] ;GET INITIAL TRANSFER VECTOR\r
+ PUSHJ P,TTYOPE ;OPEN THE TTY\r
+ AOS A,20 ; TOP OF LOW SEGG\r
+ HRRZM A,P.TOP\r
+ SOSN A ; IF NOTHING YET\r
+IFN ITS, .SUSET [.RMEMT,,P.TOP]\r
+IFE ITS, JRST 4,\r
+ HRRE A,P.TOP ; CHECK TOP\r
+ TRNE A,377777 ; SKIP IF ALL LOW SEG\r
+ JUMPL A,PAGLOS ; COMPLAIN\r
+ MOVE A,HITOP ; FIND HI SEG TOP\r
+ ADDI A,1777\r
+ ANDCMI A,1777\r
+ MOVEM A,RHITOP ; SAVE IT\r
+ MOVEI A,200\r
+ SUBI A,PHIBOT\r
+ JUMPE A,HIBOK\r
+ MOVSI A,(A)\r
+ HRRI A,200\r
+IFN ITS,[\r
+ .CALL GIVCOR\r
+ .VALUE\r
+]\r
+HIBOK: MOVEI B,[ASCIZ /MUDDLE INITIALIZATION.\r
+/]\r
+ PUSHJ P,MSGTYP ;PRINT IT\r
+ MOVE A,CODTOP ;CHECK FOR A WINNING LOAD\r
+ CAML A,VECBOT ;IT BETTER BE LESS\r
+ JRST DEATH1 ;LOSE COMPLETELY\r
+ MOVE B,PARBOT ;CHECK FOR ANY PAIRS\r
+ CAME B,PARTOP ;ANY LOAD/ASSEMBLE TIME PAIRS?\r
+ JRST PAIRCH ;YES CHECK THEM\r
+ ADDI A,2000 ;BUMP UP\r
+ ANDCMI A,1777\r
+ MOVEM A,PARBOT ;UPDATE PARBOT AND TOP\r
+ MOVEM A,PARTOP\r
+SETTV: MOVE PVP,[-PVLNT*2,,GCPVP] ;AND A PROCESS VECTOR\r
+ MOVEI A,(PVP) ;SET UP A BLT\r
+ HRLI A,PVBASE ;FROM PROTOTYPE\r
+ BLT A,PVLNT*2-1(PVP) ;INITIALIZE\r
+ MOVE TP,[-ITPLNT,,TPBAS] ;GET A STACK FOR THIS PROCCESS\r
+ MOVEI TB,(TP) ;AND A BASE\r
+ HRLI TB,1\r
+ SUB TP,[1,,1] ;POP ONCE\r
+\r
+; ALLOCATE SOME OBLISTS FOR INITIAL ATOMS\r
+\r
+ PUSH P,[5] ;COUNT INITIAL OBLISTS\r
+\r
+ PUSH P,OBLNT ;SAVE CURRENT OBLIST DEFAULT SIZE\r
+\r
+MAKEOB: SOS A,-1(P)\r
+ MOVE A,OBSZ(A)\r
+ MOVEM A,OBLNT\r
+ MCALL 0,MOBLIST ;GOBBLE AN OBLIST\r
+ PUSH TP,$TOBLS ;AND SAVE THEM\r
+ PUSH TP,B\r
+ MOVE A,(P)-1 ;COUNT DOWN\r
+ MOVEM B,@OBTBL(A) ;STORE\r
+ JUMPN A,MAKEOB\r
+\r
+ POP P,OBLNT ;RESTORE DEFAULT OBLIST SIZE\r
+\r
+ MOVE C,TVP ;MAKE 2 COPIES OF XFER VECTOR POINTER\r
+ MOVE D,TVP\r
+\r
+;MAIN INITIALIZE LOOP - SCAN XFER VECTOR FOR ATOMS, UPDATE\r
+;OFFSETS IN CODE, UNIQUIFY ATOMS AND COMPACT XFER VECTOR\r
+\r
+ILOOP: HLRZ A,(C) ;FIRST TYPE\r
+ JUMPE A,TVEXAU ;USEFUL STUFF EXHAUSTED\r
+ CAIN A,TCHSTR ;CHARACTER STRING?\r
+ JRST CHACK ;YES, GO HACK IT\r
+ CAIN A,TATOM ;ATOM?\r
+ JRST ATOMHK ;YES, CHECK IT OUT\r
+ MOVE A,(C) ;MOVE TO NEW HOME (MAY BE SAME)\r
+ MOVEM A,(D)\r
+ MOVE A,1(C)\r
+ MOVEM A,1(D)\r
+SETLP: AOS (P) ;COUNT NUMBER OF PAIRS IN XFER VECTOR\r
+ ADD D,[2,,2] ;OUT COUNTER\r
+SETLP1: ADD C,[2,,2] ;AND IN COUNTER\r
+ JUMPL C,ILOOP ;JUMP IF MORE TO DO\r
+\f;NEW XFER VECTOR FINISHED, NOW GIVE AWAY THE REST\r
+\r
+TVEXAU: HLRE B,C ;GET -LENGTH\r
+ SUBI C,(B) ;POIT TO DOPE WORD\r
+ ANDI C,-1 ;NO LH\r
+ HLRZ A,1(C) ;INTIAL LENGTH TO A\r
+ MOVEI E,(C) ;COPY OF POINTER TO DOPW WD\r
+ SUBI E,(D) ;AMOUNT LEFT OVER TO E\r
+ HRLZM E,1(C) ;CLOBBER INTO DOPE WORD FOR GARBAGE\r
+ MOVSI E,(E) ;PREPARE TO UPDATE TVP\r
+ ADD TVP,E ;NOW POINTS TO THE RIGHT AMOUNT\r
+ HLRE B,D ;-AMOUNT LEFT TO B\r
+ ADD B,A ;AMOUNT OF GOOD STUFF\r
+ HRLZM B,1(D) ;STORE IT IN GODD DOPE WORD\r
+ MOVSI E,400000 ;CLOBBER TO GENERAL IN BOTH CASES\r
+ MOVEM E,(C)\r
+ MOVEM E,(D)\r
+\r
+\r
+; FIX UP TYPE VECTOR\r
+\r
+ MOVE A,TYPVEC+1(TVP) ;GET POINTER\r
+ MOVEI 0,0 ;FOR POSSIBLE NULL SLOTS\r
+ MOVSI B,TATOM ;SET TYPE TO ATOM\r
+\r
+TYPLP: HLLM B,(A) ;CHANGE TYPE TO ATOM\r
+ MOVE C,@1(A) ;GET ATOM\r
+ MOVEM C,1(A)\r
+ ADD A,[2,,2] ;BUMP\r
+ JUMPL A,TYPLP\r
+\f; CLOSE TTY CHANNELS\r
+IFN ITS,[\r
+\r
+ .CLOSE 1,\r
+ .CLOSE 2,\r
+]\r
+\r
+;GENERAT THE LOGICAL TTY IN AND OUT CHANNELS\r
+\r
+;SETUP CALL TO OPEN OUTPUT TTY CHANNNEL\r
+\r
+ IRP A,,[[PRINT,TCHSTR],[TTY:,TCHSTR]]\r
+ IRP B,C,[A]\r
+ PUSH TP,$!C\r
+ PUSH TP,CHQUOTE B\r
+ .ISTOP\r
+ TERMIN\r
+ TERMIN\r
+\r
+ MCALL 2,FOPEN ;OPEN THE OUT PUT CHANNEL\r
+ MOVEM B,TTOCHN+1(TVP) ;SAVE IT\r
+\r
+;ASSIGN AS GLOBAL VALUE\r
+\r
+ PUSH TP,$TATOM\r
+ PUSH TP,IMQUOTE OUTCHAN\r
+ PUSH TP,A\r
+ PUSH TP,B\r
+ MOVE A,[PUSHJ P,MTYO] ;MORE WINNING INS\r
+ MOVEM A,IOINS(B) ;CLOBBER\r
+ MCALL 2,SETG\r
+\r
+;SETUP A CALL TO OPEN THE TTY CHANNEL\r
+\r
+ IRP A,,[[READ,TCHSTR],[TTY:,TCHSTR]]\r
+ IRP B,C,[A]\r
+ PUSH TP,$!C\r
+ PUSH TP,CHQUOTE B\r
+ .ISTOP\r
+ TERMIN\r
+ TERMIN\r
+\r
+ MCALL 2,FOPEN ;OPEN INPUTCHANNEL\r
+ MOVEM B,TTICHN+1(TVP) ;SAVE IT\r
+ PUSH TP,$TATOM ;ASSIGN AS A GLOBAL VALUE\r
+ PUSH TP,IMQUOTE INCHAN\r
+ PUSH TP,A\r
+ PUSH TP,B\r
+ MOVE C,BUFRIN(B) ;GET AUX BUFFER PTR\r
+ MOVE A,[PUSHJ P,MTYI]\r
+ MOVEM A,IOIN2(C) ;MORE OF A WINNER\r
+ MOVE A,[PUSHJ P,MTYO]\r
+ MOVEM A,ECHO(C) ;ECHO INS\r
+ MCALL 2,SETG\r
+\r
+;GENERATE AN INITIAL PROCESS AND SWAP IT IN\r
+\r
+ PUSHJ P,ICR ;CREATE IT\r
+ MOVEI 0,RUNING\r
+ MOVEM 0,PSTAT"+1(B)\r
+ MOVE D,B ;SET UP TO CALL SWAP\r
+ JSP C,SWAP ;AND SWAP IN\r
+ MOVEM PVP,MAINPR" ;SAVE AS THE MAIN PROCESS\r
+ PUSH TP,[TENTRY,,TOPLEV] ;BUILD DUMMY FRAME\r
+ PUSH TP,[1,,0]\r
+ MOVEI A,-1(TP)\r
+ PUSH TP,A\r
+ PUSH TP,SP\r
+ PUSH TP,P\r
+ MOVE C,TP ;COPY TP\r
+ ADD C,[3,,3] ;FUDGE\r
+ PUSH TP,C ;TPSAV PUSHED\r
+ PUSH TP,[TOPLEV]\r
+ HRRI TB,(TP) ;SETUP TB\r
+ HRLI TB,2\r
+ ADD TB,[1,,1]\r
+ MOVEM TB,TBINIT+1(PVP)\r
+ MOVSI A,TSUBR\r
+ MOVEM A,RESFUN(PVP)\r
+ MOVEI A,LISTEN"\r
+ MOVEM A,RESFUN+1(PVP)\r
+ PUSH TP,$TATOM\r
+ PUSH TP,IMQUOTE THIS-PROCESS\r
+ PUSH TP,$TPVP\r
+ PUSH TP,PVP\r
+ MCALL 2,SETG\r
+\r
+; FIND TVP OFFSET FOR THE ATOM 'T' FOR TEMPLATE\r
+\r
+ MOVEI A,MQUOTE T\r
+ SUBI A,(TVP)\r
+TVTOFF==0\r
+ ADDSQU TVTOFF\r
+\r
+ MOVEM A,SQULOC-1\r
+\r
+ PUSH TP,$TATOM\r
+ PUSH TP,IMQUOTE TVTOFF,,MUDDLE\r
+ PUSH TP,$TFIX\r
+ PUSH TP,A\r
+ MCALL 2,SETG\r
+\r
+; HERE TO SETUP SQUOZE TABLE IN PURE CORE\r
+\r
+ PUSHJ P,SQSETU ; GO TO ROUTINE\r
+\r
+ MOVEI A,400000 ; FENCE POST PURE SR VECTOR\r
+ HRRM A,PURVEC(TVP)\r
+ MOVE A,TP\r
+ HLRE B,A\r
+ SUBI A,-PDLBUF(B) ;POINT TO DOPE WORDS\r
+ MOVEI B,12 ;GROWTH SPEC\r
+ IORM B,(A)\r
+ MOVEI 0,ISTOST\r
+ MOVEM 0,CODTOP\r
+ PUSHJ P,AAGC ;DO IT\r
+ AOJL A,.-1\r
+ MOVE A,TPBASE+1(PVP)\r
+ SUB A,[640.,,640.]\r
+ MOVEM A,TPBASE+1(PVP)\r
+\r
+; CREATE LIST OF ROOT AND NEW OBLIST\r
+\r
+ MOVEI A,5\r
+ PUSH P,A\r
+\r
+NAMOBL: PUSH TP,$TATOM\r
+ PUSH TP,@OBNAM-1(A) ; NAME\r
+ PUSH TP,$TATOM\r
+ PUSH TP,IMQUOTE OBLIST\r
+ PUSH TP,$TOBLS\r
+ PUSH TP,@OBTBL-1(A)\r
+ MCALL 3,PUT ; NAME IT\r
+ SOS A,(P)\r
+ PUSH TP,$TOBLS\r
+ PUSH TP,@OBTBL(A)\r
+ PUSH TP,$TATOM\r
+ PUSH TP,IMQUOTE OBLIST\r
+ PUSH TP,$TATOM\r
+ PUSH TP,@OBNAM(A)\r
+ MCALL 3,PUT\r
+ SKIPE A,(P)\r
+ JRST NAMOBL\r
+ SUB P,[1,,1]\r
+\r
+;Define MUDDLE version number\r
+ MOVEI A,5\r
+ MOVEI B,0 ;Initialize result\r
+ MOVE C,[440700,,MUDSTR+2]\r
+VERLP: ILDB D,C ;Get next charcter digit\r
+ CAIG D,"9 ;Non-digit ?\r
+ CAIGE D,"0\r
+ JRST VERDEF\r
+ SUBI D,"0 ;Convert to number\r
+ IMULI B,10.\r
+ ADD B,D ;Include number into result\r
+ SOJG A,VERLP ;Finished ?\r
+VERDEF:\r
+ PUSH TP,$TATOM\r
+ PUSH TP,MQUOTE MUDDLE\r
+ PUSH TP,$TFIX\r
+ PUSH TP,B\r
+ MCALL 2,SETG ;Make definition\r
+OPIPC:\r
+IFN ITS,[\r
+ PUSH TP,$TCHSTR\r
+ PUSH TP,CHQUOTE IPC\r
+ PUSH TP,$TATOM\r
+ PUSH TP,MQUOTE IPC-HANDLER\r
+ MCALL 1,GVAL\r
+ PUSH TP,A\r
+ PUSH TP,B\r
+ PUSH TP,$TFIX\r
+ PUSH TP,[1]\r
+ MCALL 3,ON\r
+ MCALL 0,IPCON\r
+]\r
+\r
+; Allocate inital template tables\r
+\r
+ MOVEI A,10\r
+ PUSHJ P,CAFRE1\r
+ ADD B,[10,,10] ; REST IT OFF\r
+ MOVEM B,TD.LNT+1(TVP)\r
+ MOVEI A,10\r
+ PUSHJ P,CAFRE1\r
+ MOVEI 0,TUVEC ; SETUP UTYPE\r
+ HRLM 0,10(B)\r
+ MOVEM B,TD.GET+1(TVP)\r
+ MOVEI A,10\r
+ PUSHJ P,CAFRE1\r
+ MOVEI 0,TUVEC ; SETUP UTYPE\r
+ HRLM 0,10(B)\r
+ MOVEM B,TD.PUT+1(TVP)\r
+\r
+PTSTRT: MOVEI A,SETUP\r
+ ADDI A,1\r
+ SUB A,PARBOT ;FIND WHERE PAIRS SHOULD GO\r
+ MOVEM A,PARNEW\r
+IFE ITS,[\r
+ MOVEI A,400000\r
+ MOVE B,[1,,START]\r
+ SEVEC\r
+]\r
+ PUSH P,[14.,,14.] ;PUSH A SMALL PRGRM ONTO P\r
+ MOVEI A,1(P) ;POINT TO ITS START\r
+ PUSH P,[JRST AAGC] ;GO TO AGC\r
+ PUSH P,[MOVE B,PSTO+1(PVP)] ;GET SAVED P\r
+ PUSH P,[SUB B,-13.(P)] ;FUDGE TO POP OFF PROGRAM\r
+ PUSH P,[MOVEM B,PSAV(TB)] ;INTO FRAME\r
+ PUSH P,[MOVE B,TPSTO+1(PVP)] ;GET TP\r
+ PUSH P,[MOVEM B,TPSAV(TB)] ;STORE IT\r
+ PUSH P,[MOVE B,SPSTO+1(PVP)] ;SP\r
+ PUSH P,[MOVEM B,SPSAV(TB)]\r
+ PUSH P,[MOVEI B,TOPLEV] ;WHERE TO GO\r
+ PUSH P,[MOVEM B,PCSAV(TB)]\r
+IFN ITS, PUSH P,[MOVSI B,(.VALUE )]\r
+IFE ITS, PUSH P,[MOVSI B,(JRST 4,)]\r
+ PUSH P,[HRRI B,C]\r
+ PUSH P,[JRST B] ;GO DO VALRET\r
+ PUSH P,[B]\r
+ PUSH P,A ; PUSH START ADDR\r
+ MOVE B,[JRST -11.(P)]\r
+ MOVE 0,[JUMPA START]\r
+ MOVE C,[ASCII \\170/\e9\]\r
+ MOVE D,[ASCII \B/\e1Q\]\r
+ MOVE E,[ASCIZ \\r
+\16*\r
+\] ;TERMINATE\r
+ POPJ P, ; GO\r
+\f\r
+; CHECK PAIR SPACE\r
+\r
+PAIRCH: CAMG A,B\r
+ JRST SETTV ;O.K.\r
+\r
+DEATH1: MOVEI B,[ASCIZ /LOSSAGE--CODE AND DATA OVERLAP\r
+/]\r
+ PUSHJ P,MSGTYP\r
+ .VALUE\r
+\r
+;CHARACTER STRING HACKER\r
+\r
+CHACK: MOVE A,(C) ;GET TYPE\r
+ HLLZM A,(D) ;STORE IN NEW HOME\r
+ MOVE B,1(C) ;GET POINTER\r
+ HLRZ E,B ;-LENGHT\r
+ HRRM E,(D)\r
+ PUSH P,E+1 ; IDIVI WILL CLOBBER\r
+ ADDI E,4+5*2 ; ROUND AND ACCOUNT FOR DOPE WORDS\r
+ IDIVI E,5 ; E/ WORDS LONG\r
+ PUSHJ P,EBPUR ; MAKE A PURIFIED COPY\r
+ POP P,E+1\r
+ HRLI B,440700 ;MAKE POINT BYTER\r
+ MOVEM B,1(D) ;AND STORE IT\r
+ ANDI A,-1 ;CLEAR LH OF A\r
+ JUMPE A,SETLP ;JUMP IF NO REF\r
+ MOVE E,(P) ;GET OFFSET\r
+ LSH E,1\r
+ HRRZ B,-1(A) ;SEE IF PREVIOUS INSTRUCTION REFERS TO $TCHSTR\r
+ CAIE B,$TCHSTR ;SKIP IF IT DOES\r
+ JRST CHACK1 ;NO, JUST DO CHQUOTE PART\r
+ HRRM E,-1(A) ;CLOBBER\r
+ MOVEI B,TVP\r
+ DPB B,[220400,,-1(A)] ;CLOBBER INDEX FIELD\r
+CHACK1: ADDI E,1\r
+ HRRM E,(A) ;STORE INTO REFERENCE\r
+ JRST SETLP\r
+\r
+; SUBROUTINE TO COPY A HUNK OF STRUCTURE TO THE HIGH SEGMENT\r
+\r
+EBPUR: PUSH P,E\r
+ PUSH P,A\r
+ ADD E,HITOP ; GET NEW TOP\r
+ CAMG E,RHITOP ; SKIP IF TOO BIG\r
+ JRST EBPUR1\r
+\r
+; CODE TO GROW HI SEG \r
+\r
+ MOVEI A,2000\r
+ ADDB A,RHITOP ; NEW TOP\r
+IFN ITS,[\r
+ ASH A,-10. ; NUM OF BLOCKS\r
+ SUBI A,1 ; BLOCK TO GET\r
+ .CALL HIGET\r
+ .VALUE\r
+]\r
+\r
+EBPUR1: MOVEI A,-1(E) ; NEEDED TO TERMINATE BLT\r
+ EXCH E,HITOP\r
+ HRLI E,(B)\r
+ MOVEI B,(E)\r
+ BLT E,(A)\r
+ POP P,A\r
+ POP P,E\r
+ POPJ P,\r
+\r
+GIVCOR: SETZ\r
+ SIXBIT /CORBLK/\r
+ 1000,,0\r
+ 1000,,-1\r
+ SETZ A\r
+\r
+HIGET: SETZ\r
+ SIXBIT /CORBLK/\r
+ 1000,,100000\r
+ 1000,,-1\r
+ A\r
+ 401000,,400001\r
+\r
+\f\r
+; PROCESS AN ATOM AND ADD IT TO AN APPROPRIATE OBLIST IF IT ISN'T\r
+; ALREADY THERE\r
+\r
+ATOMHK: PUSH TP,$TOBLS ; SAVE OBLIST\r
+ PUSH TP,[0] ; FILLED IN LATER\r
+ PUSH TP,$TVEC ;SAVE TV POINTERS\r
+ PUSH TP,C\r
+ PUSH TP,$TVEC\r
+ PUSH TP,D\r
+ MOVE B,1(C) ;GET THE ATOM\r
+ PUSH TP,$TATOM ;AND SAVE\r
+ PUSH TP,B\r
+ HRRZ A,(B) ;GET OBLIST SPEC FROM ATOM\r
+ LSH A,1\r
+ ADDI A,1(TB) ;POINT TO ITS HOME\r
+ PUSH TP,$TOBLS\r
+ PUSH TP,(A) ;AND SAV IT\r
+ MOVE A,(A)\r
+ MOVEM A,-10(TP) ; CLOBBER\r
+ HLRE E,A\r
+ MOVNS E\r
+\r
+ ADD B,[3,,3] ;POINT TO ATOM'S PNAME\r
+ MOVEI A,0 ;FOR HASHING\r
+ XOR A,(B)\r
+ AOBJN B,.-1\r
+ TLZ A,400000 ;FORCE POSITIVE RESULT\r
+ IDIV A,E\r
+ HRLS B ;REMAINDER IN B IS BUCKET\r
+ ADDB B,(TP) ;UPDATE POINTER\r
+\r
+ SKIPN C,(B) ;GOBBLE BUCKET CONTENTS\r
+ JRST USEATM ;NONE, LEAVE AND USE THIS ATOM\r
+OBLOO3: MOVE E,-2(TP) ;RE-GOBBLE ATOM\r
+ ADD E,[3,,3] ;POINT TO PNAME\r
+ SKIPN D,1(C) ;CHECK LIST ELEMNT\r
+ JRST NXTBCK ;0, CHECK NEXT IN THIS BUCKET\r
+ ADD D,[3,,3] ;POINT TO PNAME\r
+OBLOO2: MOVE A,(D) ;GET A WORD\r
+ CAME A,(E) ;COMPARE\r
+ JRST NXTBCK ;THEY DIFFER, TRY NEX\r
+OBLOOP: AOBJP E,CHCKD ;COULD BE A MATCH, GO CHECK\r
+ AOBJN D,OBLOO2 ;HAVEN'T LOST YET\r
+\r
+NXTBCK: HRRZ C,(C) ;CDR THE LIST\r
+ JUMPN C,OBLOO3 ;IF NOT NIL, KEEP TRYING\r
+\r
+;HERE IF THIS ATOM MUST BE PUT ON OBLIST\r
+\r
+USEATM: MOVE B,-2(TP) ; GET ATOM\r
+ HLRZ 0,(B) ; SEE IF PURE OR NOT\r
+ TRNN 0,400000 ; SKIP IF IMPURE\r
+ JRST PURATM\r
+ MOVE B,(TP) ;POINTER TO BUCKET\r
+ HRRZ C,(B) ;POINTER TO LIST IN THIS BUCKET\r
+ PUSH TP,$TATOM ;GENERATE CALL TO CONS\r
+ PUSH TP,-3(TP)\r
+ PUSH TP,$TLIST\r
+ PUSH TP,C\r
+ MCALL 2,CONS ;CONS IT UP\r
+ MOVE C,(TP) ;REGOBBLE BUCKET POINTER\r
+ HRRZM B,(C) ;CLOBBER\r
+ MOVE B,-2(TP) ;POINT TO ATOM\r
+ MOVE C,-10(TP) ; GET OBLIST\r
+ MOVEM C,2(B) ; INTO ATOM\r
+ PUSHJ P,VALMAK ;MAKE A GLOBAL VALUE FOR THIS LOSER\r
+PURAT2: MOVE C,-6(TP) ;RESET POINTERS\r
+ MOVE D,-4(TP)\r
+ SUB TP,[12,,12]\r
+ MOVE B,(C) ;MOVE THE ENTRY\r
+ HLLZM B,(D) ;DON'T WANT REF POINTER STORED\r
+ MOVE A,1(C) ;AND MOVE ATOM\r
+ MOVEM A,1(D)\r
+ MOVE A,(P) ;GET CURRENT OFFSET\r
+ LSH A,1\r
+ ADDI A,1\r
+ ANDI B,-1 ;CHECK FOR REAL REF\r
+ JUMPE B,SETLP1 ;DON'T SAVE THIS ATOM ON TVP\r
+ HRRM A,(B) ;CLOBBER CODE\r
+ JRST SETLP\r
+\r
+\r
+; HERE TO MAKE A PURE ATOM\r
+\r
+PURATM: HRRZ B,-2(TP) ; POINT TO IT\r
+ HLRE E,-2(TP) ; - LNTH\r
+ MOVNS E\r
+ ADDI E,2\r
+ PUSHJ P,EBPUR ; PURE COPY\r
+ HRRM B,-2(TP) ; AND STORE BACK\r
+ HRRO B,(TP) ; GET BUCKET BACK\r
+PURAT1: HRRZ C,(B) ; GET CONTENTS\r
+ JUMPE C,HICONS ; AT END, OK\r
+ CAIL C,HIBOT ; SKIP IF IMPURE\r
+ JRST HICONS ; CONS IT ON\r
+ MOVEI B,(C)\r
+ JRST PURAT1\r
+\r
+HICONS: HRLI C,TATOM\r
+ PUSH P,C\r
+ PUSH P,-2(TP)\r
+ PUSH P,B\r
+ MOVEI B,-2(P)\r
+ MOVEI E,2\r
+ PUSHJ P,EBPUR ; MAKE PURE LIST CELL\r
+\r
+ MOVE C,(P)\r
+ SUB P,[3,,3]\r
+ HRRM B,(C) ; STORE IT\r
+ MOVE B,1(B) ; ATOM BACK\r
+ MOVE C,-6(TP) ; GET TVP SLOT\r
+ HRRM B,1(C) ; AND STORE\r
+ HLRZ 0,(B) ; TYPE OF VAL\r
+ MOVE C,B\r
+ CAIN 0,TUNBOU ; NOT UNBOUND?\r
+ JRST PURAT3 ; UNBOUND, NO VAL\r
+ MOVEI E,2 ; COUNT AGAIN\r
+ PUSHJ P,EBPUR ; VALUE CELL\r
+ MOVE C,-2(TP) ; ATOM BACK\r
+ HLLZS (B) ; CLEAR LH\r
+ MOVSI 0,TLOCI\r
+ HLLM 0,(C)\r
+ MOVEM B,1(C)\r
+PURAT3: HRRZ A,(C) ; GET OBLIST CODE\r
+ MOVE A,OBTBL2(A)\r
+ MOVEM A,2(C) ; STORE OBLIST SLOT\r
+ HLLZS (C)\r
+ JRST PURAT2\r
+\f\r
+; A POSSIBLE MATCH ARRIVES HERE\r
+\r
+CHCKD: AOBJN D,NXTBCK ;SIZES DIFFER, JUMP\r
+ MOVE D,1(C) ;THEY MATCH!, GET EXISTING ATOM\r
+ MOVEI A,(D) ;GET TYPE OF IT\r
+ MOVE B,-2(TP) ;GET NEW ATOM\r
+ HLRZ 0,(B)\r
+ TRZ A,377777 ; SAVE ONLY 400000 BIT\r
+ TRZ 0,377777\r
+ CAIN 0,(A) ; SKIP IF WIN\r
+ JRST IM.PUR\r
+ MOVSI 0,400000\r
+ ANDCAM 0,(B)\r
+ ANDCAM 0,(D)\r
+ HLRZ A,(D)\r
+ CAIE A,TUNBOU ;UNBOUND?\r
+ JRST A1VAL ;YES, CONTINUE\r
+ MOVE A,(B) ;MOVE VALUE\r
+ MOVEM A,(D)\r
+ MOVE A,1(B)\r
+ MOVEM A,1(D)\r
+ MOVE B,D ;EXISTING ATOM TO B\r
+ MOVEI 0,(B)\r
+ CAIL 0,HIBOT\r
+ JRST .+3\r
+ PUSHJ P,VALMAK ;MAKE A VALUE\r
+ JRST .+2\r
+ PUSHJ P,PVALM\r
+\r
+;NOW FIND ATOMS OCCURENCE IN XFER VECTOR\r
+\r
+OFFIND: MOVE D,-4(TP) ;GET CURRENT POINTER INTO TP\r
+ MOVE C,TVP ;AND A COPY OF TVP\r
+ MOVEI A,0 ;INITIALIZE COUNTER\r
+ALOOP: CAMN B,1(C) ;IS THIS IT?\r
+ JRST AFOUND\r
+ ADD C,[2,,2] ;BUMP COUNTER\r
+ CAMGE C,D ;HAVE WE HIT END\r
+ AOJA A,ALOOP ;NO, KEEP LOOKING\r
+\r
+ MOVEI B,[ASCIZ /LOSSAGE--ATOM DISAPPEARED\r
+/]\r
+TYPIT: PUSHJ P,MSGTYP\r
+ .VALUE\r
+\r
+AFOUND: LSH A,1 ;FOUND ATOM, GET REAL OFFSET\r
+ ADDI A,1\r
+ MOVE C,-6(TP) ;GET TV POINTER TO NEW ATOM\r
+ HRRZ B,(C) ;POINT TO REFERENCE\r
+ SKIPE B ;ANY THERE?\r
+ HRRM A,(B) ;YES, CLOBBER AWAY\r
+ SUB TP,[12,,12]\r
+ JRST SETLP1 ;AND GO ON\r
+\r
+A1VAL: HLRZ C,(B) ;GET VALUE'S TYPE\r
+ MOVE B,D ;NOW PUT EXISTING ATOM IN B\r
+ CAIN C,TUNBOU ;UNBOUND?\r
+ JRST OFFIND ;YES, WINNER\r
+\r
+ MOVEI B,[ASCIZ /LOSSAGE--ATOM TRIES TO HAVE 2 VALUES\r
+/]\r
+ JRST TYPIT\r
+\r
+\r
+IM.PUR: MOVEI B,[ASCIZ /LOSSAG--ATOM TRIES TO BE BOTH PURE AND IMPURE\r
+/]\r
+ JRST TYPIT\r
+\r
+PAGLOS: MOVEI B,[ASCIZ /LOSSAGE--IMPURE CORE EXTENDS INTO HIGH SEGMENT\r
+/]\r
+ JRST TYPIT\r
+\f\r
+;MAKE A VALUE IN SLOT ON GLOBAL SP\r
+\r
+VALMAK: HLRZ A,(B) ;TYPE OF VALUE\r
+ CAIE A,400000+TUNBOU\r
+ CAIN A,TUNBOU ;VALUE?\r
+ POPJ P, ;NO, ALL DONE\r
+ MOVE A,GLOBSP+1(TVP) ;GET POINTER TO GLOBAL SP\r
+ SUB A,[4,,4] ;ALLOCATE SPACE\r
+ CAMG A,GLOBAS+1(TVP) ;CHECK FOR OVERFLOW\r
+ JRST SPOVFL\r
+ MOVEM A,GLOBSP+1(TVP) ;STORE IT BACK\r
+ MOVE C,(B) ;GET TYPE CELL\r
+ TLZ C,400000\r
+ HLLZM C,2(A) ;INTO TYPE CELL\r
+ MOVE C,1(B) ;GET VALUE\r
+ MOVEM C,3(A) ;INTO VALUE SLOT\r
+ MOVSI C,TGATOM ;GET TATOM,,0\r
+ MOVEM C,(A)\r
+ MOVEM B,1(A) ;AND POINTER TO ATOM\r
+ MOVSI C,TLOCI ;NOW CLOBBER THE ATOM\r
+ MOVEM C,(B) ;INTO TYPE CELL\r
+ ADD A,[2,,2] ;POINT TO VALUE\r
+ MOVEM A,1(B)\r
+ POPJ P,\r
+\r
+SPOVFL: MOVEI B,[ASCIZ /LOSSAGE--GLOBAL SP OVERFLOW\r
+/]\r
+ JRST TYPIT\r
+\r
+\r
+PVALM: HLRZ 0,(B)\r
+ CAIE 0,400000+TUNBOU\r
+ CAIN 0,TUNBOU\r
+ POPJ P,\r
+ MOVEI E,2\r
+ PUSH P,B\r
+ PUSHJ P,EBPUR\r
+ POP P,C\r
+ MOVEM B,1(C)\r
+ MOVSI 0,TLOCI\r
+ MOVEM 0,(C)\r
+ MOVE B,C\r
+ POPJ P,\r
+\f;SET UP LIST OF INTERNAL NAMES AND ADDRESS NEEDED BY COMPILER\r
+\r
+VECTGO DUMMY1\r
+\r
+IRP A,,[FINIS,SPECBIND,MESTBL,WNA,WRONGT,$TLOSE,CALER1\r
+ILOC,IGLOC,IDVAL,ILVAL,IGVAL,INTFLG,LCKINT,TYPLOO,TDEFER\r
+IFALSE,UNAS,UNBOU,RCALL,SEGMNT,SEGLST,NUMPRI,DISXTR,SSPEC1,COMPERR\r
+MAKACT,MAKENV,BFRAME,TTP,TTB,$TTP,$TTB,MAKTUP,TPALOC,IBIND,SSPECS\r
+CILVAL,CISET,CIGVAL,CSETG,IBLOK1,IBLOCK,CLLOC,CGLOC,CASSQ,CGASSQ\r
+CILNT,CILNQ,CILEGQ,CEMPTY,CIEQUA,CIREST,CINTH,CIAT,CSETLO,CIN\r
+CIPUT,CIGET,CIGETL,CIMON,CISTRU,CIMEMQ,CIMEMB,CITOP,CIBACK,TYPSEG\r
+CICONS,CIUVEC,CIVEC,IIFORM,IILIST,CISTNG,HITOP,INCR1,TYPG,VALG,TESTR\r
+OTBSAV,CITYPE,CFRAME,CARGS,CFUNCT,CUTYPE,CPTYPE,CTYPEP,CTYPEQ,CCHUTY\r
+CIREMA,RTFALS,CIGETP,CIGTPR,MPOPJ,TAB,$TAB,ICONS,CSTO,DSTO,NTPALO\r
+CPLUS,CTIMES,CTIME,CDIVID,CMINUS,CLQ,CLEQ,CGQ,CGEQ,CLOG,CSIN,CCOS,CATAN,CSQRT\r
+CFIX,CFLOAT,CEXP,CRAND,CINEQU,SPECBND,PGGIVE,PGFIND,MTYO,CMIN,CMAX,RCL,R1C,W1C\r
+CALLTY,CTYPEC,CTYPEW,NOTTY,CHKAB,CTMPLT,IUNWIN,UNWIN2,NOSHUF,ROOT,ERROBL,INTOBL\r
+CINSER,CIRMV,CLOOKU,CATOM,CIPNAM,ISTRCM,CITERP,CIPRIN,CIPRN1,CIPRNC\r
+CPATM,CP1ATM,CPCATM,CPSTR,CP1STR,CPCSTR,CPCH,CREADC,CNXTCH,CREDC1,CNXTC1\r
+CGBOUN,IIGLOC,MAKTU2,CIFLTZ,CIUPRS]\r
+ .GLOBAL A\r
+ ADDSQU A\r
+ MAKAT [A]TFIX,A,MUDDLE,0\r
+TERMIN\r
+\r
+VECRET\r
+\r
+; ROUTINE TO SORT AND PURIFY SQUOZE TABLE\r
+\r
+SQSETU: MOVE A,[SQUTBL-SQULOC+2,,SQUTBL]\r
+ MOVEI 0,1\r
+SQ2: MOVE B,(A)\r
+ CAMG B,2(A)\r
+ JRST SQ1\r
+ MOVEI 0,0\r
+ EXCH B,2(A)\r
+ MOVEM B,(A)\r
+ MOVE B,1(A)\r
+ EXCH B,3(A)\r
+ MOVEM B,1(A)\r
+SQ1: ADD A,[2,,2]\r
+ JUMPL A,SQ2\r
+ JUMPE 0,SQSETU\r
+ MOVEI E,SQULOC-SQUTBL\r
+ MOVEI B,SQUTBL\r
+ PUSHJ P,EBPUR ; TO THE PURE WORLD\r
+ HRLI B,SQUTBL-SQULOC\r
+ MOVEM B,SQUPNT"\r
+ POPJ P,\r
+ \r
+RHITOP: 0\r
+\r
+OBSZ: 151.\r
+ 151.\r
+ 151.\r
+ 151.\r
+ 317.\r
+\r
+OBTBL2: ROOT+1\r
+ ERROBL+1\r
+ INTOBL+1\r
+ MUDOBL+1\r
+ INITIAL+1\r
+\r
+OBTBL: INITIAL+1(TVP)\r
+ MUDOBL+1(TVP)\r
+ INTOBL+1(TVP)\r
+ ERROBL+1(TVP)\r
+ ROOT+1(TVP)\r
+OBNAM: MQUOTE INITIAL\r
+ MQUOTE MUDDLE\r
+ MQUOTE INTERRUPTS\r
+ MQUOTE ERRORS\r
+ MQUOTE ROOT\r
+\r
+END SETUP\r
+\r
+\r
+\f\f\f\r
projects / pdp10-muddle.git / blobdiff