TITLE INITIALIZATION FOR MUDDLE RELOCATABLE HTVLNT==3000 ; GUESS OF TVP LENGTH LAST==1 ;POSSIBLE CHECKS DONE LATER .INSRT MUDDLE > SYSQ XBLT==123000,, GCHN==0 IFE ITS,[ FATINS==.FATAL" SEVEC==104000,,204 .INSRT STENEX > ] IMPURE OBSIZE==151. ;DEFAULT OBLIST SIZE .LIFG .LOP .VALUE .ELDC .GLOBAL SHRRM,SHRLM,SMOVEM,SSETZM,SXBLT,SHLRZ .GLOBAL SETUP,TPBAS,GCPDL,GCPVP,PVBASE,PVLNT,PARNEW,AAGC,ICR,SWAP,OBLNT,MSGTYP,POPUNW .GLOBAL ICLOS,OCLOS,GLOBASE,GLOBSP,PARBOT,PARTOP,CODTOP,START,BEGIN,VECBOT,VECTOP,TPBASE .GLOBAL LISTEN,ROOT,INITIAL,TBINIT,TOPLEV,INTOBL,ERROBL,MUDOBL,TTYOPE,RESFUN,QUITTER .GLOBAL IOINS,BUFRIN,IOIN2,ECHO,MTYI,MTYO,IMTYO,MUDSTR,P.TOP,TTICHN,TTOCHN,TYPVEC,SQDIR .GLOBAL PDLBUF,PHIBOT,%UNAM,PURVEC,STOSTR,ISTOST,TD.LNT,TD.PUT,TD.GET,CAFRE1 .GLOBAL FRETOP,LPUR,SQBLK,REALGC,INTDIR,AGCLD,PAGEGC,TD.AGC,TVSTRT,REALTV,PVSTOR .GLOBAL GCSTOP,SPSTOR,DSTORE,SQBYTE,INBYTE,GCBYTE,FRSTCH,OPSYS,IJFNS,GETJS .GLOBAL HASHTB,ILOOKC LPUR==.LPUR ; SET UP SO LPUR WORKS ; INIITAL AMOUNT OF AFREE SPACE STOSTR: LOC TVSTRT-1 ISTOST: TVSTRT-STOSTR,,0 BLOCK HTVLNT ; TVP SETUP: MOVEI 0,0 ; ZERO ACS MOVEI 17,1 BLT 17,17 IFN ITS, .SUSET [.RUNAM,,%UNAM] ; FOR AGC'S BENFIT MOVE P,GCPDL ;GET A PUSH DOWN STACK IFN ITS, .SUSET [.SMASK,,[200000]] ; ENABLE PDL OVFL MOVE 0,[TVBASE,,TVSTRT] BLT 0,TVSTRT+HTVLNT-3 ; BLT OVER TVP IFE ITS, PUSHJ P,TWENTY ; FIND OUT WHETHER IT IS TOPS20 OR NOT PUSHJ P,TTYOPE ;OPEN THE TTY AOS A,20 ; TOP OF LOW SEGG HRRZM A,P.TOP SOSN A ; IF NOTHING YET IFN ITS, .SUSET [.RMEMT,,P.TOP] IFE ITS, JRST 4, MOVE A,P.TOP SUB A,FRETOP ; SETUP FOR GETTING NEEDED CORE SUBI A,3777 ASH A,-10. ; TO PAGES HRLS A ; SET UP AOBJN HRRZ 0,P.TOP ASH 0,-10. SUBI 0,1 HRR A,0 IFN ITS,[ .CALL HIGET ; GET THEM FATAL INITM--CORE NOT AVAILABLE FOR INITIALIZATION ASH A,10. ; TO WORDS MOVEM A,P.TOP SUBI A,2000 ; WHERE FRETOP IS MOVEM A,FRETOP ] IFE ITS,[ MOVE A,FRETOP ADDI A,2000 MOVEM A,P.TOP ] HRRE A,P.TOP ; CHECK TOP TRNE A,377777 ; SKIP IF ALL LOW SEG JUMPL A,PAGLOS ; COMPLAIN MOVE A,HITOP ; FIND HI SEG TOP ADDI A,1777 ANDCMI A,1777 MOVEM A,RHITOP ; SAVE IT MOVEI A,200 SUBI A,PHIBOT JUMPE A,HIBOK MOVSI A,(A) HRRI A,200 IFN ITS,[ .CALL GIVCOR .VALUE ] HIBOK: MOVEI B,[ASCIZ /MUDDLE INITIALIZATION. /] PUSHJ P,MSGTYP ;PRINT IT MOVE A,CODTOP ;CHECK FOR A WINNING LOAD CAML A,VECBOT ;IT BETTER BE LESS JRST DEATH1 ;LOSE COMPLETELY SETTV: MOVE PVP,[-PVLNT*2,,GCPVP] ;AND A PROCESS VECTOR MOVEM PVP,PVSTOR+1 MOVEM PVP,PVSTOR+1-TVSTRT+TVBASE MOVEI A,(PVP) ;SET UP A BLT HRLI A,PVBASE ;FROM PROTOTYPE BLT A,PVLNT*2-1(PVP) ;INITIALIZE MOVE TP,[-ITPLNT,,TPBAS] ;GET A STACK FOR THIS PROCCESS MOVEI TB,(TP) ;AND A BASE IFN ITS, HRLI TB,1 IFE ITS, HRLI TB,400001 ; FOR MULTI SEG HACKING SUB TP,[1,,1] ;POP ONCE ; FIRST BUILD MOBY HASH TABLE MOVEI A,1023. ; TRY THIS OUT FOR SIZE PUSHJ P,IBLOCK MOVEM B,HASHTB+1-TVSTRT+TVBASE ; STORE IN TVP POINTER HLRE A,B SUB B,A MOVEI A,TATOM+.VECT. HRLM A,(B) ; ALLOCATE SOME OBLISTS FOR INITIAL ATOMS PUSH P,[5] ;COUNT INITIAL OBLISTS PUSH P,OBLNT ;SAVE CURRENT OBLIST DEFAULT SIZE MAKEOB: SOS A,-1(P) MOVE A,OBSZ(A) MOVEM A,OBLNT MCALL 0,MOBLIST ;GOBBLE AN OBLIST PUSH TP,$TOBLS ;AND SAVE THEM PUSH TP,B MOVE A,(P)-1 ;COUNT DOWN MOVEM B,@OBTBL(A) ;STORE JUMPN A,MAKEOB POP P,OBLNT ;RESTORE DEFAULT OBLIST SIZE MOVE C,[-TVLNT+2,,TVBASE] MOVE D,[-HTVLNT+2,,TVSTRT] ;MAIN INITIALIZE LOOP - SCAN XFER VECTOR FOR ATOMS, UPDATE ;OFFSETS IN CODE, UNIQUIFY ATOMS AND COMPACT XFER VECTOR ILOOP: HLRZ A,(C) ;FIRST TYPE JUMPE A,TVEXAU ;USEFUL STUFF EXHAUSTED CAIN A,TCHSTR ;CHARACTER STRING? JRST CHACK ;YES, GO HACK IT CAIN A,TATOM ;ATOM? JRST ATOMHK ;YES, CHECK IT OUT MOVE A,(C) ;MOVE TO NEW HOME (MAY BE SAME) MOVEM A,(D) MOVE A,1(C) MOVEM A,1(D) SETLP: AOS (P) ;COUNT NUMBER OF PAIRS IN XFER VECTOR ADD D,[2,,2] ;OUT COUNTER SETLP1: ADD C,[2,,2] ;AND IN COUNTER JUMPL C,ILOOP ;JUMP IF MORE TO DO ;NEW XFER VECTOR FINISHED, NOW GIVE AWAY THE REST TVEXAU: HLRE B,D ; LEFT HALF OF AOBJN MOVNI TVP,HTVLNT-2 ; CALCULATE LENGTH OF TVP SUB TVP,B ; GET -LENGTH OF TVP IN TVP HRLS TVP HRRI TVP,TVSTRT ; BUILD A TASTEFUL TVP POINTER MOVNI C,TVLNT-HTVLNT+2(B) ; SMASH IN LENGTH INTO END DOPE WORDS HRLM C,TVSTRT+HTVLNT-1 MOVSI E,400000 MOVEM E,TVSTRT+HTVLNT-2 HLRE C,TVP MOVNI C,-2(C) ; CLOBBER LENGTH INTO REAL TVP HLRE B,TVP SUBM TVP,B MOVEM E,(B) HRLM C,1(B) ; PUT IN LENGTH MOVE PVP,PVSTOR+1 MOVEM TVP,REALTV+1(PVP) ; FIX UP TYPE VECTOR MOVE A,TYPVEC+1 ;GET POINTER MOVEI 0,0 ;FOR POSSIBLE NULL SLOTS MOVSI B,TATOM ;SET TYPE TO ATOM MOVEI D,400000 ; TYPE CODE HACKS TYPLP: HLLM B,(A) ;CHANGE TYPE TO ATOM MOVE C,@1(A) ;GET ATOM HLRE E,C ; FIND DOPE WORD SUBM C,E HRRM D,(E) ; STUFF INTO ATOM MOVEM C,1(A) ADDI D,1 ADD A,[2,,2] ;BUMP JUMPL A,TYPLP ; CLOSE TTY CHANNELS IFN ITS,[ .CLOSE 1, .CLOSE 2, ] ;GENERAT THE LOGICAL TTY IN AND OUT CHANNELS ;SETUP CALL TO OPEN OUTPUT TTY CHANNNEL IRP A,,[[PRINT,TCHSTR],[TTY:,TCHSTR]] IRP B,C,[A] PUSH TP,$!C PUSH TP,CHQUOTE B .ISTOP TERMIN TERMIN MCALL 2,FOPEN ;OPEN THE OUT PUT CHANNEL MOVEM B,TTOCHN+1 ;SAVE IT ;ASSIGN AS GLOBAL VALUE PUSH TP,$TATOM PUSH TP,IMQUOTE OUTCHAN PUSH TP,A PUSH TP,B MOVE A,[PUSHJ P,MTYO] ;MORE WINNING INS MOVEM A,IOINS(B) ;CLOBBER MCALL 2,SETG ;SETUP A CALL TO OPEN THE TTY CHANNEL IRP A,,[[READ,TCHSTR],[TTY:,TCHSTR]] IRP B,C,[A] PUSH TP,$!C PUSH TP,CHQUOTE B .ISTOP TERMIN TERMIN MCALL 2,FOPEN ;OPEN INPUTCHANNEL MOVEM B,TTICHN+1 ;SAVE IT PUSH TP,$TATOM ;ASSIGN AS A GLOBAL VALUE PUSH TP,IMQUOTE INCHAN PUSH TP,A PUSH TP,B MOVE C,BUFRIN(B) ;GET AUX BUFFER PTR MOVE A,[PUSHJ P,MTYI] MOVEM A,IOIN2(C) ;MORE OF A WINNER MOVE A,[PUSHJ P,IMTYO] MOVEM A,ECHO(C) ;ECHO INS MCALL 2,SETG MOVEI A,3 ;FIRST CHANNEL AFTER INIT HAPPENS MOVEM A,FRSTCH ;GENERATE AN INITIAL PROCESS AND SWAP IT IN MOVEI A,TPLNT ;STACK PARAMETERS MOVEI B,PLNT PUSHJ P,ICR ;CREATE IT MOVE PVP,PVSTOR+1 MOVE 0,SPSTO+1(B) MOVEM 0,SPSTOR+1 MOVE 0,REALTV+1(PVP) MOVEM 0,REALTV+1(B) ; STUFF IN TRANSFER VECTOR POINTER MOVEI 0,RUNING MOVEM 0,PSTAT"+1(B) MOVE D,B ;SET UP TO CALL SWAP JSP C,SWAP ;AND SWAP IN MOVEM PVP,MAINPR" ;SAVE AS THE MAIN PROCESS PUSH TP,[TENTRY,,TOPLEV] ;BUILD DUMMY FRAME PUSH TP,[1,,0] MOVEI A,-1(TP) PUSH TP,A PUSH TP,SPSTOR+1 PUSH TP,P MOVE C,TP ;COPY TP ADD C,[3,,3] ;FUDGE PUSH TP,C ;TPSAV PUSHED PUSH TP,[TOPLEV] HRRI TB,(TP) ;SETUP TB IFN ITS, HRLI TB,2 IFE ITS, HRLI TB,400002 ADD TB,[1,,1] MOVE PVP,PVSTOR+1 MOVEM TB,TBINIT+1(PVP) MOVSI A,TSUBR MOVEM A,RESFUN(PVP) MOVEI A,LISTEN" MOVEM A,RESFUN+1(PVP) PUSH TP,$TATOM PUSH TP,IMQUOTE THIS-PROCESS PUSH TP,$TPVP PUSH TP,PVP MCALL 2,SETG ; FIND TVP OFFSET FOR THE ATOM 'T' FOR TEMPLATE MOVEI A,IMQUOTE T SUBI A, TVTOFF==0 ADDSQU TVTOFF MOVEM A,SQULOC-1 PUSH TP,$TATOM PUSH TP,IMQUOTE TVTOFF,,MUDDLE PUSH TP,$TFIX PUSH TP,A MCALL 2,SETG ; HERE TO SETUP SQUOZE TABLE IN PURE CORE PUSHJ P,SQSETU ; GO TO ROUTINE PUSHJ P,DUMPGC MOVEI A,400000 ; FENCE POST PURE SR VECTOR HRRM A,PURVEC MOVE A,TP HLRE B,A SUBI A,-PDLBUF(B) ;POINT TO DOPE WORDS MOVEI B,12 ;GROWTH SPEC IORM B,(A) MOVE PVP,PVSTOR+1 MOVE 0,REALTV+1(PVP) HLRE E,0 SUBI 0,-1(E) HRRZM 0,CODTOP IFE ITS, PUSHJ P,GETJS PUSHJ P,AAGC ;DO IT AOJL A,.-1 MOVE PVP,PVSTOR+1 MOVE A,TPBASE+1(PVP) SUB A,[640.,,640.] MOVEM A,TPBASE+1(PVP) ; CREATE LIST OF ROOT AND NEW OBLIST MOVEI A,5 PUSH P,A NAMOBL: PUSH TP,$TATOM PUSH TP,@OBNAM-1(A) ; NAME PUSH TP,$TATOM PUSH TP,IMQUOTE OBLIST PUSH TP,$TOBLS PUSH TP,@OBTBL1-1(A) MCALL 3,PUT ; NAME IT SOS A,(P) PUSH TP,$TOBLS PUSH TP,@OBTBL1(A) PUSH TP,$TATOM PUSH TP,IMQUOTE OBLIST PUSH TP,$TATOM PUSH TP,@OBNAM(A) MCALL 3,PUT SKIPE A,(P) JRST NAMOBL SUB P,[1,,1] ;Define MUDDLE version number MOVEI A,5 MOVEI B,0 ;Initialize result MOVE C,[440700,,MUDSTR+2] VERLP: ILDB D,C ;Get next charcter digit CAIG D,"9 ;Non-digit ? CAIGE D,"0 JRST VERDEF SUBI D,"0 ;Convert to number IMULI B,10. ADD B,D ;Include number into result SOJG A,VERLP ;Finished ? VERDEF: PUSH TP,$TATOM PUSH TP,IMQUOTE MUDDLE PUSH TP,$TFIX PUSH TP,B MCALL 2,SETG ;Make definition OPIPC: IFN ITS,[ PUSH TP,$TCHSTR PUSH TP,CHQUOTE IPC PUSH TP,$TATOM PUSH TP,MQUOTE IPC-HANDLER MCALL 1,GVAL PUSH TP,A PUSH TP,B PUSH TP,$TFIX PUSH TP,[1] MCALL 3,ON MCALL 0,IPCON ] ; Allocate inital template tables MOVEI A,10 PUSHJ P,CAFRE1 MOVSI A,(B) HRRI A,1(B) SETZM (B) BLT A,7(B) ADD B,[10,,10] ; REST IT OFF MOVEM B,TD.LNT+1 MOVEI A,10 PUSHJ P,CAFRE1 MOVEI 0,TUVEC ; SETUP UTYPE HRLM 0,10(B) MOVEM B,TD.GET+1 MOVSI A,(B) HRRI A,1(B) SETZM (B) BLT A,7(B) MOVEI A,10 PUSHJ P,CAFRE1 MOVEI 0,TUVEC ; SETUP UTYPE HRLM 0,10(B) MOVEM B,TD.PUT+1 MOVSI A,(B) HRRI A,1(B) SETZM (B) BLT A,7(B) MOVEI A,10 PUSHJ P,CAFRE1 MOVEI 0,TUVEC ; SETUP UTYPE HRLM 0,10(B) MOVEM B,TD.AGC+1 MOVSI A,(B) HRRI A,1(B) SETZM (B) BLT A,7(B) PTSTRT: MOVEI A,SETUP ADDI A,1 SUB A,PARBOT ;FIND WHERE PAIRS SHOULD GO MOVEM A,PARNEW ; PURIFY/IMPURIFY THE WORLD (PDL) IFN ITS,[ PURIMP: MOVE A,FRETOP SUBI A,1 LSH A,-12 MOVE B,A MOVNI A,1(A) HRLZ A,A DOTCAL CORBLK,[[1000,,310000],[1000,,-1],A] FATAL INITM -- CAN'T IMPURIFY LOW CORE MOVEI A,PHIBOT ADDI B,1 SUB A,B MOVNS A HRL B,A DOTCAL CORBLK,[[1000,,0],[1000,,-1],B] FATAL INITM -- CAN'T FLUSH MIDDLE CORE MOVE A,[-<400-PHIBOT>,,PHIBOT] DOTCAL CORBLK,[[1000,,210000],[1000,,-1],A] FATAL INITM -- CAN'T PURIFY HIGH CORE ] IFE ITS,[ MOVEI A,400000 MOVE B,[1,,START] SEVEC ] PUSH P,[15.,,15.] ;PUSH A SMALL PRGRM ONTO P MOVEI A,1(P) ;POINT TO ITS START PUSH P,[JRST AAGC] ;GO TO AGC PUSH P,[MOVE PVP,PVSTOR+1] PUSH P,[MOVE B,PSTO+1(PVP)] ;GET SAVED P PUSH P,[SUB B,-14.(P)] ;FUDGE TO POP OFF PROGRAM PUSH P,[MOVEM B,PSAV(TB)] ;INTO FRAME PUSH P,[MOVE B,TPSTO+1(PVP)] ;GET TP PUSH P,[MOVEM B,TPSAV(TB)] ;STORE IT PUSH P,[MOVE B,SPSTOR+1] ;SP PUSH P,[MOVEM B,SPSAV(TB)] PUSH P,[MOVEI B,TOPLEV] ;WHERE TO GO PUSH P,[MOVEM B,PCSAV(TB)] IFN ITS, PUSH P,[MOVSI B,(.VALUE )] IFE ITS, PUSH P,[MOVSI B,(JRST)] PUSH P,[HRRI B,C] PUSH P,[JRST B] ;GO DO VALRET PUSH P,[B] PUSH P,A ; PUSH START ADDR MOVE B,[JRST -12.(P)] MOVE 0,[JUMPA START] IFE ITS, MOVE C,[HALTF] IFE ITS, SKIPE OPSYS MOVE C,[ASCII \0/9\] MOVE D,[ASCII \B/1Q\] MOVE E,[ASCIZ \ * \] ;TERMINATE POPJ P, ; GO ; CHECK PAIR SPACE PAIRCH: CAMG A,B JRST SETTV ;O.K. DEATH1: MOVEI B,[ASCIZ /LOSSAGE--CODE AND DATA OVERLAP /] PUSHJ P,MSGTYP .VALUE ;CHARACTER STRING HACKER CHACK: MOVE A,(C) ;GET TYPE HLLZM A,(D) ;STORE IN NEW HOME MOVE B,1(C) ;GET POINTER HLRZ E,B ;-LENGHT HRRM E,(D) PUSH P,E+1 ; IDIVI WILL CLOBBER ADDI E,4+5*2 ; ROUND AND ACCOUNT FOR DOPE WORDS IDIVI E,5 ; E/ WORDS LONG PUSHJ P,EBPUR ; MAKE A PURIFIED COPY POP P,E+1 HRLI B,010700 ;MAKE POINT BYTER SUBI B,1 MOVEM B,1(D) ;AND STORE IT ANDI A,-1 ;CLEAR LH OF A JUMPE A,SETLP ;JUMP IF NO REF HRRZ B,-1(A) ;SEE IF PREVIOUS INSTRUCTION REFERS TO $TCHSTR CAIE B,$TCHSTR ;SKIP IF IT DOES JRST CHACK1 ;NO, JUST DO CHQUOTE PART HRRM D,-1(A) ;CLOBBER CHACK1: MOVEI E,1(D) HRRM E,(A) ;STORE INTO REFERENCE MOVEI E,0 DPB E,[220400,,(A)] JRST SETLP ; SUBROUTINE TO COPY A HUNK OF STRUCTURE TO THE HIGH SEGMENT EBPUR: PUSH P,E PUSH P,A ADD E,HITOP ; GET NEW TOP CAMG E,RHITOP ; SKIP IF TOO BIG JRST EBPUR1 ; CODE TO GROW HI SEG MOVEI A,2000 ADDB A,RHITOP ; NEW TOP TLNE A,777776 JRST HIFUL IFN ITS,[ ASH A,-10. ; NUM OF BLOCKS SUBI A,1 ; BLOCK TO GET .CALL HIGET .VALUE ] EBPUR1: MOVEI A,-1(E) ; NEEDED TO TERMINATE BLT EXCH E,HITOP HRLI E,(B) MOVEI B,(E) BLT E,(A) POP P,A POP P,E POPJ P, GIVCOR: SETZ SIXBIT /CORBLK/ 1000,,0 1000,,-1 SETZ A HIGET: SETZ SIXBIT /CORBLK/ 1000,,100000 1000,,-1 A 401000,,400001 ; PROCESS AN ATOM AND ADD IT TO AN APPROPRIATE OBLIST IF IT ISN'T ; ALREADY THERE ATOMHK: PUSH TP,$TOBLS ; SAVE OBLIST PUSH TP,[0] ; FILLED IN LATER PUSH TP,$TVEC ;SAVE TV POINTERS PUSH TP,C PUSH TP,$TVEC PUSH TP,D MOVE C,1(C) ;GET THE ATOM PUSH TP,$TATOM ;AND SAVE PUSH TP,C PUSH TP,$TATOM PUSH TP,[0] HRRZ B,(C) ;GET OBLIST SPEC FROM ATOM LSH B,1 ADDI B,1(TB) ;POINT TO ITS HOME HRRM B,-9(TP) MOVE B,(B) MOVEM B,-10(TP) ; CLOBBER SETZM 2(C) ; FLUSH CURRENT OBLIST SPEC MOVEI E,0 MOVE D,C PUSH P,[LOOKCR] ADD D,[3,,3] JUMPGE D,.+4 PUSH P,(D) ADDI E,1 AOBJN D,.-2 PUSH P,E MOVSI A,TOBLS JRST ILOOKC LOOKCR: MOVEM B,(TP) JUMPN B,CHCKD ;HERE IF THIS ATOM MUST BE PUT ON OBLIST USEATM: MOVE B,-2(TP) ; GET ATOM HLRZ E,(B) ; SEE IF PURE OR NOT TRNN E,400000 ; SKIP IF IMPURE JRST PURATM PUSH TP,$TATOM PUSH TP,B PUSH TP,$TOBLS PUSH TP,-13(TP) MCALL 2,INSERT PUSHJ P,VALMAK ;MAKE A GLOBAL VALUE FOR THIS LOSER PURAT2: MOVE C,-6(TP) ;RESET POINTERS MOVE D,-4(TP) SUB TP,[12,,12] MOVE B,(C) ;MOVE THE ENTRY HLLZM B,(D) ;DON'T WANT REF POINTER STORED MOVE A,1(C) ;AND MOVE ATOM MOVEM A,1(D) MOVEI A,1(D) ANDI B,-1 ;CHECK FOR REAL REF JUMPE B,SETLP1 ;DON'T SAVE THIS ATOM ON TVP HRRM A,(B) ;CLOBBER CODE MOVEI A,0 DPB A,[220400,,(B)] ; CLOBBER TVP PORTION JRST SETLP ; HERE TO MAKE A PURE ATOM PURATM: HRRZ B,-2(TP) ; POINT TO IT HLRE E,-2(TP) ; - LNTH MOVNS E ADDI E,2 PUSHJ P,EBPUR ; PURE COPY HRRM B,-2(TP) ; AND STORE BACK MOVE B,-2(TP) JUMPE 0,PURAT0 HRRZ D,0 HLRE E,0 SUBM D,E HLRZ 0,2(D) JUMPE 0,PURAT8 CAIG 0,HIBOT FATAL INITM--PURE IMPURE LOSSAGE JRST PURAT8 PURAT0: HRRZ E,(C) MOVE D,-2(TP) ; GET ATOM BACK HRRZ 0,(D) ; GET OBLIST CODE JUMPE E,PURAT9 PURAT7: HLRZ D,1(E) MOVEI D,-2(D) SUBM E,D HLRZ D,2(D) CAILE D,HIBOT ; IF NEXT PURE & I AM ROOT JUMPE 0,PURAT8 ; TAKES ADVANTAGE OF SYSTEM=0 JUMPE D,PURAT8 MOVE E,D JRST PURAT7 PURAT8: HLRZ D,1(E) SUBI D,2 SUBM E,D HLRE C,B SUBM B,C HLRZ E,2(D) HRLM E,2(B) HRLM C,2(D) JRST PURAT6 PURAT9: HLRE A,-2(TP) SUBM B,A HRRZM A,(C) PURAT6: MOVE B,-10(TP) ; GET BUCKET BACK MOVE C,-2(TP) HRRZ 0,-9(TP) HRRM 0,2(C) ; STORE OBLIST IN ATOM PURAT1: HRRZ C,(B) ; GET CONTENTS JUMPE C,HICONS ; AT END, OK CAIL C,HIBOT ; SKIP IF IMPURE JRST HICONS ; CONS IT ON MOVEI B,(C) JRST PURAT1 HICONS: HRLI C,TATOM PUSH P,C PUSH P,-2(TP) PUSH P,B MOVEI B,-2(P) MOVEI E,2 PUSHJ P,EBPUR ; MAKE PURE LIST CELL MOVE C,(P) SUB P,[3,,3] HRRM B,(C) ; STORE IT MOVE B,1(B) ; ATOM BACK MOVE C,-6(TP) ; GET TVP SLOT HRRM B,1(C) ; AND STORE HLRZ 0,(B) ; TYPE OF VAL MOVE C,B CAIN 0,TUNBOU ; NOT UNBOUND? JRST PURAT3 ; UNBOUND, NO VAL MOVEI E,2 ; COUNT AGAIN PUSHJ P,EBPUR ; VALUE CELL MOVE C,-2(TP) ; ATOM BACK HLLZS (B) ; CLEAR LH MOVSI 0,TLOCI MOVEM B,1(C) SKIPA PURAT3: MOVEI 0,0 HRRZ A,(C) ; GET OBLIST CODE MOVE A,OBTBL2(A) HRRM A,2(C) ; STORE OBLIST SLOT MOVEM 0,(C) JRST PURAT2 ; A POSSIBLE MATCH ARRIVES HERE CHCKD: MOVE D,(TP) ;THEY MATCH!, GET EXISTING ATOM MOVEI A,(D) ;GET TYPE OF IT MOVE B,-2(TP) ;GET NEW ATOM HLRZ 0,(B) TRZ A,377777 ; SAVE ONLY 400000 BIT TRZ 0,377777 CAIN 0,(A) ; SKIP IF WIN JRST IM.PUR MOVSI 0,400000 ANDCAM 0,(B) ANDCAM 0,(D) HLRZ A,(D) JUMPN A,A1VAL MOVE A,(B) ;MOVE VALUE MOVEM A,(D) MOVE A,1(B) MOVEM A,1(D) MOVE B,D ;EXISTING ATOM TO B MOVEI 0,(B) CAIL 0,HIBOT JRST .+3 PUSHJ P,VALMAK ;MAKE A VALUE JRST .+2 PUSHJ P,PVALM ;NOW FIND ATOMS OCCURENCE IN XFER VECTOR OFFIND: MOVE D,-4(TP) ;GET CURRENT POINTER INTO TP MOVE C,[-TVLNT,,TVSTRT] ;AND A COPY OF TVP MOVEI A,0 ;INITIALIZE COUNTER ALOOP: CAMN B,1(C) ;IS THIS IT? JRST AFOUND ADD C,[2,,2] ;BUMP COUNTER CAMG C,D AOJA A,ALOOP ;NO, KEEP LOOKING MOVEI B,[ASCIZ /LOSSAGE--ATOM DISAPPEARED /] TYPIT: PUSHJ P,MSGTYP .VALUE AFOUND: LSH A,1 ;FOUND ATOM, GET REAL OFFSET ADDI A,1 ADDI A,TVSTRT MOVE C,-6(TP) ;GET TV POINTER TO NEW ATOM HRRZ B,(C) ;POINT TO REFERENCE SKIPE B ;ANY THERE? HRRM A,(B) ;YES, CLOBBER AWAY SUB TP,[12,,12] MOVEI A,0 DPB A,[220400,,(B)] ; KILL TVP POINTER JRST SETLP1 ;AND GO ON A1VAL: HLRZ C,(B) ;GET VALUE'S TYPE MOVE B,D ;NOW PUT EXISTING ATOM IN B CAIN C,TUNBOU ;UNBOUND? JRST OFFIND ;YES, WINNER MOVEI B,[ASCIZ /LOSSAGE--ATOM TRIES TO HAVE 2 VALUES /] JRST TYPIT IM.PUR: MOVEI B,[ASCIZ /LOSSAG--ATOM TRIES TO BE BOTH PURE AND IMPURE /] JRST TYPIT PAGLOS: MOVEI B,[ASCIZ /LOSSAGE--IMPURE CORE EXTENDS INTO HIGH SEGMENT /] JRST TYPIT HIFUL: MOVEI B,[ASCIZ /LOSSAGE--HI SEG FULL /] JRST TYPIT ;MAKE A VALUE IN SLOT ON GLOBAL SP VALMAK: HLRZ A,(B) ;TYPE OF VALUE CAIE A,400000+TUNBOU CAIN A,TUNBOU ;VALUE? JRST VALMA1 MOVE A,GLOBSP+1 ;GET POINTER TO GLOBAL SP SUB A,[4,,4] ;ALLOCATE SPACE CAMG A,GLOBAS+1 ;CHECK FOR OVERFLOW JRST SPOVFL MOVEM A,GLOBSP+1 ;STORE IT BACK MOVE C,(B) ;GET TYPE CELL TLZ C,400000 HLLZM C,2(A) ;INTO TYPE CELL MOVE C,1(B) ;GET VALUE MOVEM C,3(A) ;INTO VALUE SLOT MOVSI C,TGATOM ;GET TATOM,,0 MOVEM C,(A) MOVEM B,1(A) ;AND POINTER TO ATOM MOVSI C,TLOCI ;NOW CLOBBER THE ATOM MOVEM C,(B) ;INTO TYPE CELL ADD A,[2,,2] ;POINT TO VALUE MOVEM A,1(B) POPJ P, VALMA1: SETZM (B) POPJ P, SPOVFL: MOVEI B,[ASCIZ /LOSSAGE--GLOBAL SP OVERFLOW /] JRST TYPIT PVALM: HLRZ 0,(B) CAIE 0,400000+TUNBOU CAIN 0,TUNBOU JRST VALMA1 MOVEI E,2 PUSH P,B PUSHJ P,EBPUR POP P,C MOVEM B,1(C) MOVSI 0,TLOCI MOVEM 0,(C) MOVE B,C POPJ P, ;SET UP LIST OF INTERNAL NAMES AND ADDRESS NEEDED BY COMPILER VECTGO DUMMY1 IRP A,,[FINIS,SPECBIND,WNA,WRONGT,$TLOSE,CALER1,POPUNW ILOC,IGLOC,IDVAL,IDVAL1,ILVAL,IGVAL,INTFLG,LCKINT,ONINT,TYPLOO,TDEFER IFALSE,UNAS,UNBOU,RCALL,SEGMNT,SEGLST,NUMPRI,OPSYS,SSPEC1,COMPERR MAKACT,MAKENV,BFRAME,TTP,TTB,$TTP,$TTB,MAKTUP,TPALOC,IBIND,SSPECS CILVAL,CISET,CIGVAL,CSETG,IBLOK1,IBLOCK,CLLOC,CGLOC,CASSQ,CGASSQ CILNT,CILNQ,CILEGQ,CEMPTY,CIEQUA,CIREST,CINTH,CIAT,CSETLO,CIN CIPUT,CIGET,CIGETL,CIMON,CISTRU,CIMEMQ,CIMEMB,CITOP,CIBACK,TYPSEG C1CONS,CICONS,CIUVEC,CIVEC,IIFORM,IILIST,CISTNG,HITOP,INCR1,TYPG,VALG,TESTR OTBSAV,CITYPE,CFRAME,CARGS,CFUNCT,CUTYPE,CPTYPE,CTYPEP,CTYPEQ,CCHUTY CIREMA,RTFALS,CIPUTP,CIGETP,CIGTPR,MPOPJ,TAB,$TAB,ICONS,CSTO,DSTO,NTPALO CPLUS,CTIMES,CTIME,CDIVID,CMINUS,CLQ,CLEQ,CGQ,CGEQ,CLOG,CSIN,CCOS,CATAN,CSQRT CFIX,CFLOAT,CEXP,CRAND,CINEQU,SPECBND,PGGIVE,PGFIND,MTYO,CMIN,CMAX,RCL,R1C,W1C CALLTY,CTYPEC,CTYPEW,NOTTY,CHKAB,CTMPLT,IUNWIN,UNWIN2,NOSHUF,ROOT,ERROBL,INTOBL CINSER,CIRMV,CLOOKU,CATOM,CIPNAM,ISTRCM,CITERP,CIPRIN,CIPRN1,CIPRNC,CGFALS CPATM,CP1ATM,CPCATM,CPSTR,CP1STR,CPCSTR,CPCH,CREADC,CNXTCH,CREDC1,CNXTC1 CGBOUN,IIGLOC,MAKTU2,CIFLTZ,CIUPRS,SAT,TFA,WTYP,NAPT,PTYPE,APLQ,PURBOT,GCSBOT GLOTOP,TYPVEC,1STEPR,LSTRES,NODES,MAINPR,CVTYPE,CSPNAM,CSBSTR,INTBCK,CICRLF CERR1,CERR2,CERR3,CANDP,CORP,CSQUTA,CIMAGE,ATOSQ,CFILLE,CPRTYC,FMPOPJ TD.PUT,TD.GET,TD.LNT,CBYTES,MARK,MARK2G,TD.AGC,DSTORE,RCLV,NUMSAT,RMCALL,NPRFLG NSPOPJ,NFPOPJ,PURCLN,FRETOP,PURVEC,SWAPGC,NTTYPE,CLRSTR,VECBOT] .GLOBAL A ADDSQU A TERMIN VECRET ; ROUTINE TO SORT AND PURIFY SQUOZE TABLE SQSETU: MOVE A,[SQUTBL-SQULOC+2,,SQUTBL] MOVEI 0,1 SQ2: MOVE B,(A) CAMG B,2(A) JRST SQ1 MOVEI 0,0 EXCH B,2(A) MOVEM B,(A) MOVE B,1(A) EXCH B,3(A) MOVEM B,1(A) SQ1: ADD A,[2,,2] JUMPL A,SQ2 JUMPE 0,SQSETU IFE ITS,[ STSQU: MOVE B,[440700,,SQBLK] PUSHJ P,MNGNAM HRROI B,SQBLK MOVSI A,600001 GTJFN FATAL CANT MAKE FIXUP FILE MOVEI E,(A) MOVE B,[440000,,100000] OPENF FATAL CANT OPEN FIXUP FILE MOVE B,[444400,,SQUTBL] MOVNI C,SQULOC-SQUTBL SOUT MOVEI A,(E) CLOSF JFCL MOVE A,[SQUTBL-SQULOC,,SQUTBL] MOVEM A,SQUPNT" ] IFN ITS,[ .GLOBAL CSIXBT STSQU: MOVE C,MUDSTR+2 ; CALCULATE SECOND FILE NAME FOR SQUOZE TABLE PUSHJ P,CSIXBT HRRI C,(SIXBIT/TAB/) ; TABxxx IS SECOND NAME OF FILE MOVSS C MOVEM C,SQBLK+2 ; STORE IN APPROPRIATE BLOCKS MOVEM C,SQWBLK+2 .SUSET [.SSNAM,,SQDIR] .OPEN GCHN,SQWBLK ; OPEN FILE FATAL CAN'T CREATE SQUOZE FILE MOVE A,[SQUTBL-SQULOC,,SQUTBL] MOVEM A,SQUPNT" .IOT GCHN,A .CLOSE GCHN ; CLOSE THE CHANNEL ] POPJ P, RHITOP: 0 OBSZ: 151. 13. 151. 151. 317. OBTBL2: ROOT+1 ERROBL+1 INTOBL+1 MUDOBL+1 INITIAL+1 OBTBL: INITIAL+1-TVSTRT+TVBASE MUDOBL+1-TVSTRT+TVBASE INTOBL+1-TVSTRT+TVBASE ERROBL+1-TVSTRT+TVBASE ROOT+1-TVSTRT+TVBASE OBNAM: MQUOTE INITIAL IMQUOTE MUDDLE MQUOTE INTERRUPTS MQUOTE ERRORS MQUOTE ROOT OBTBL1: INITIAL+1 MUDOBL+1 INTOBL+1 ERROBL+1 ROOT+1 IFN ITS,[ SQWBLK: SIXBIT / 'DSK/ SIXBIT /SQUOZE/ SIXBIT /TABLE/ ] IFE ITS,[ MNGNAM: MOVE A,[440700,,MUDSTR+2] ; FOR NAME HACKING ILDB 0,A ; SEE IF IT IS A VERSION CAIN 0,177 POPJ P, MOVE A,B ILDB 0,A CAIN 0,"X ; LOOK FOR X'S JRST .+3 MOVE B,A JRST .-4 MOVE A,[440700,,MUDSTR+2] ILDB 0,A IDPB 0,B ILDB 0,A IDPB 0,B ILDB 0,A IDPB 0,B POPJ P, ] IFN ITS,[ .GLOBAL VCREATE,MUDSTR DEBUG: MOVE E,[440600,,[SIXBIT /EXPERIMENTAL/]] MOVEI 0,12. JRST STUFF VCREATE: .SUSET [.SSNAM,,[SIXBIT /MUDSYS/]] .OPEN 0,OP% .VALUE MOVEI 0,0 ; SET 0 TO DO THE .RCHST .RCHST 0 .CLOSE 0 .FDELE DB% .VALUE MOVE E,[440600,,B] MOVEI 0,6 STUFF: MOVE D,[440700,,MUDSTR+2] STUFF1: ILDB A,E ; GET A CHAR CAIN A,0 ;SUPRESS SPACES MOVEI A,137 ;RUBOUT'S DON'T TYPE OUT ADDI A,40 ; TO ASCII IDPB A,D ; STORE SOJN 0,STUFF1 SETZM 34 SETZM 35 SETZM 36 .VALUE OP%: 1,,(SIXBIT /DSK/) SIXBIT /MUD%/ SIXBIT />/ DB%: (SIXBIT /DSK/) SIXBIT /MUD%/ SIXBIT /_<-9.>> HLLZS (A) LDB B,[331100,,(C)] DPB B,[331100,,(A)] MOVE A,D JUMPN A,%DBG1 %DBG2: MOVE B,[440700,,DECBLK] PUSHJ P,MNGNAM ; VERSION TO NAME IF NECESSARY HRROI B,DECBLK MOVSI A,600001 GTJFN FATAL CANT WRITE OUT GC MOVEI E,(A) MOVE B,[440000,,100000] OPENF FATAL CANT OPEN GC FILE MOVNI C,SECLEN ASH C,10. MOVE B,[444400,,REALGC+RLENGC+RSLENG] MOVEI A,(E) SOUT MOVEI A,(E) CLOSF JFCL MOVEI D,SECLEN+SECLEN MOVNI A,1 MOVEI B,REALGC+RLENGC ASH B,-9. HRLI B,400000 PMAP ADDI B,1 SOJG D,.-2 MOVE B,[440700,,ILDBLK] SKIPE OPSYS MOVE B,[440700,,TILDBL] PUSHJ P,MNGNAM MOVSI C,-1000 MOVSI A,400000 RPA: RPACS TLNE B,10000 TLNN B,400 ; SKIP IF NOT PRIVATE SKIPA MOVES (C) ADDI C,777 ADDI A,1 AOBJN C,RPA MOVNI A,1 CLOSF FATAL CANT CLOSE STUFF HRROI B,ILDBLK MOVSI A,100001 GTJFN ; GET A JFN FATAL GARBAGE COLLECTOR IS MISSING HRRZS E,A ; SAVE JFN MOVE B,[440000,,300000] OPENF FATAL CANT OPEN GC FILE MOVEI A,(E) ; FIND OUT LENGTH OF MAP BIN ; GET LENGTH WORD HLRZ 0,B CAIE 0,1776 ; TOPS20 SSAVE FILE FORMAT CAIN 0,1000 ; TENEX SSAVE FILE FORMAT JRST .+2 FATAL NOT AN SSAVE FILE MOVEI A,(B) ; ISOLATE SIZE OF MAP HLRE B,TP ; MUST BE SPACE FOR CRUFT MOVNS B CAIGE B,(A) ; ROOM? FATAL NO ROOM FOR PAGE MAP (GULP) MOVN C,A MOVEI A,(E) ; READY TO READ IN MAP MOVEI B,1(TP) ; ONTO TP STACK HRLI B,444400 SIN ; SNARF IT IN MOVEI A,1(TP) ; POINT TO MAP CAIE 0,1000 JRST RPA1 ; GO TO THE TOPS20 CODE LDB 0,[221100,,(A)] ; GET FORK PAGE CAIE 0,PAGEGC+PAGEGC ; GOT IT? AOJA A,.-2 JRST RPA2 RPA1: ADDI A,1 ; POINT TO PROCESS PAGE NUMBER LDB 0,[331100,,(A)] ; REPEAT COUNT IN 0 LDB B,[3300,,(A)] ; FIRST PAGE NUMBER IN B ADD 0,B ; LARGEST PAGE NUMBER CAIL 0,PAGEGC+PAGEGC CAILE B,PAGEGC+PAGEGC AOJA A,RPA1 ; NEXT PAIR OF WORDS PLEASE SUBI A,1 ; POINT TO FILE PAGE NUMBER SUBI B,PAGEGC+PAGEGC MOVN B,B ADDM B,(A) ; SET UP THE PAGE RPA2: HRRZ B,(A) ; GET PAGE MOVEI A,(E) ; GET JFN ASH B,9. SFPTR FATAL ACCESS OF FILE FAILED MOVEI A,(E) MOVE B,[444400,,AGCLD] MOVNI C,LENGC ASH C,10. SOUT MOVEI A,(E) CLOSF JFCL POPJ P, ; CODE TO DISTINGUISH BETWEEN TOPS20 AND TENEX AT SETUP TIME TWENTY: HRROI A,C ; RESULTS KEPT HERE HRLOI B,600015 MOVEI C,0 ; CLEAN C UP DEVST JFCL MOVEI A,1 ; TENEX HAS OPSYS = 1 CAME C,[ASCII/NUL/] ; TOPS20 GIVES "NUL" MOVEM A,OPSYS ; TENEX GIVES "NIL" POPJ P, %TBL: IRP A,,[HRRM,HRLM,MOVEM,SETZM,HLRZ,XBLT] S!A <<(A)>_<-9.>> TERMIN GCLDBK: ASCIZ /MDLXXX.AGC/ SGCLBK: ASCIZ /MDLXXX.SGC/ SECBLK: ASCIZ /MDLXXX.SEC/ ILDBLK: ASCIZ /MDLXXX.EXE/ TILDBL: ASCIZ /MDLXXX.SAV/ DECBLK: ASCIZ /MDLXXX.DEC/ ] END SETUP