X-Git-Url: https://jxself.org/git/?a=blobdiff_plain;f=%3Cmdl.int%3E%2Finitm.mid.371;fp=%3Cmdl.int%3E%2Finitm.mid.371;h=1134e5958e3b889f8a61178cb5950ca9fd7ef954;hb=bab072f950a643ac109660a223b57e635492ac25;hp=0000000000000000000000000000000000000000;hpb=233a3c5245f8274882cc9d27a3c20e9b3678000c;p=pdp10-muddle.git diff --git a//initm.mid.371 b//initm.mid.371 new file mode 100644 index 0000000..1134e59 --- /dev/null +++ b//initm.mid.371 @@ -0,0 +1,1360 @@ +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,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] + .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 + \ No newline at end of file