--- /dev/null
+TITLE MUDEX -- TENEX DEPENDANT MUDDLE CODE
+
+RELOCATABLE
+
+.INSRT MUDDLE >
+.INSRT STENEX >
+
+MFORK==400000
+XJRST==JRST 5,
+
+.GLOBAL %SSNAM,%RSNAM,%KILLM,%LOGOU,%SLEEP,%VALRE,NOTTY,DEMFLG,MSGTYP,TTYOP2
+.GLOBAL %UNAM,%XUNA,%JNAM,%XJNA,%RUNAM,%RXUNA,%RJNAM,%RXJNA,%GCJOB,%VALFI
+.GLOBAL %SHWND,%SHFNT,%GETIP,%INFMP,SGCLBK,TWENTY,MULTSG,MLTUUP
+.GLOBAL GCHN,WNDP,FRNP,MESSAG,INITFL,6TOCHS,SGSNAM,MTYO,PGINT,WHOAMI
+.GLOBAL %TOPLQ,IBLOCK,TMTNXS,TNXSTR,%HANG,ILLUUO,UUOH,IPCINI,CTIME,BFLOAT
+.GLOBAL GCRSET,%MPINT,%GBINT,%CLSMP,%GCJB1,%CLMP1,%SAVIN,%MPIN,%MPIN1,%IMSV1
+.GLOBAL %PURIF,%MPINX,%CLSJB,%KILJB,%IFMP1,%OPGFX,STOSTR,%SAVRP,%RSTRP,GETSQU
+.GLOBAL WIND,%FDBUF,%CWINF,P.TOP,BUFGC,PURBOT,%IFMP2,%CLSM1,GETBUF,KILBUF
+.GLOBAL CERR1,CERR2,CERR3,COMPERR,CALER1,%LDRDO,%MPRDO,SQBLK,SQLOD,SQKIL,GETSQU
+.GLOBAL SQUPNT,SFRK,IJFNS,GETJS,OPBLK,SJFNS,OPSYS,GCLDBK,ILDBLK,IJFNS1,TILDBL
+.GLOBAL TBINIT,PVSTOR,SECBLK,PURCLN,NSEGS,INTINT,PURBTB,%CLNCO,OUTRNG
+.GLOBAL MULTI,NOMULT,THIBOT,%PURMD
+.GLOBAL C%11,C%22,C%33,C%44,C%55,C%66,C%0,C%1,C%2,C%3,C%M1,C%M2,C%M10
+.GLOBAL C%M20,C%M30,C%M40,C%M60
+
+GCHN==0
+CTTRAP==1000
+CTEXST==10000
+CTREAD==100000
+CTEXEC==20000
+CTWRIT==40000
+CTCW==400
+
+MFORK==400000
+CTREAD==100000 ; READ BIT
+CTEXEC==20000 ; EXECUTE BIT
+CTWRIT==40000 ; WRITE BIT
+CTCW==400 ; COPY ON WRITE
+
+
+FREAD==200000 ; READ BIT FOR OPENF
+FEXEC==40000 ; EXEC BIT FOR OPENF
+FTHAW==2000
+FWRITE==100000
+
+GJ%SHT==1 ; SHORT FORM GTJFN
+GJ%OLD==100000 ; FILE MUST EXIST
+OP%36B==440000 ; 36 BIT BYTES
+OP%7B==700000 ; 7 BIT BYTES
+CR%CAP==200000
+
+SQLOD: MOVEI A,1
+ JRST @[.+1] ; RUN IN 0 FOR BIZARRE BUGS
+ PUSHJ P,GETBUF
+ HRRM B,SQUPNT
+ HLRZ A,SJFNS
+ JUMPE A,SQLOD1
+ HRRZS SJFNS
+ CLOSF
+ JFCL
+SQLOD1: HRROI B,SQBLK
+ SKIPE OPSYS
+ HRROI B,TSQBLK
+ MOVSI A,GJ%SHT+GJ%OLD
+ GTJFN
+ FATAL CANT GET SQUOZE
+ HRLM A,SJFNS
+ MOVEI D,(A)
+ MOVE B,[OP%36B,,FREAD]
+ OPENF
+ FATAL CANT OPEN SQUOZE
+ SIZEF
+ FATAL CANT SIZEF SQUOZE
+ MOVSI A,(D)
+ MOVNS B
+ HRLM B,SQUPNT
+ HRRZ B,SQUPNT
+ ASH B,-9.
+ HRLI B,MFORK
+ MOVSI C,CTREAD+CTEXEC
+
+ PMAP
+ ADDI A,1
+ ADDI B,1
+ PMAP
+ MOVEI A,(D)
+ CLOSF
+ JFCL
+ SKIPN MULTSG
+ POPJ P,
+ POP P,B
+ MOVEI A,0
+ XJRST A
+
+
+SQKIL: PUSHJ P,KILBUF
+ HLLZS SQUPNT
+CPOPJ:
+%PURIF:
+%GETIP: POPJ P,
+
+%PURMD: MOVE A,[MFORK,,THIBOT]
+ MOVEI 0,777-THIBOT
+%PURMX: RPACS
+ TLNN B,CTWRIT+CTCW ; SKIP IF NOT READ ONLY
+ TLNN B,CTEXST ; SKIP IF EXISTS (OTHERWISE WE'LL CREATE IT)
+ JRST .+3 ; SKIP IF NOT READ ONLY
+ MOVSI B,CTREAD+CTEXEC
+ SPACS
+ ADDI A,1
+ SOJGE 0,%PURMX
+ POPJ P,
+
+GETSQU: HRRZ 0,SQUPNT
+ JUMPN 0,CPOPJ
+ JRST SQLOD
+
+
+CTIME: SKIPE OPSYS ; skip if TOPS20
+ JRST .+4
+ MOVEI A,400000
+ RUNTM
+ JRST .+2
+ JOBTM ; get run time in milli secs
+ IDIVI A,400000
+ FSC B,233
+ FSC A,254
+ FADR B,A
+ FDVRI B,(1000.0) ; Change to units of seconds
+ MOVSI A,TFLOAT
+ POPJ P,
+
+; THE GLOBAL SNAME
+
+%RSNAM: PUSHJ P,TMTNXS ; GET STRING ON STACK (POINTER IN E)
+ GJINF ; USER NUMBER IS IN A
+ PUSHJ P,INFSTR ; MAKE INFO STRING
+
+%SSNAM: POPJ P,
+
+; KILL THE CURRENT JOB
+
+%VALFI:
+%KILLM: HALTF
+ POPJ P,
+
+; STRING IS IN A
+%VALRE: HRROS A
+ RSCAN ; PASS STRING
+ JFCL
+ MOVEI A,0
+ RSCAN ; MAKE IT AVAILABLE FOR USE
+ JFCL
+ JRST %KILLM
+
+; LOGOUT OF SYSTEM (MUST BE "TOP LEVEL")
+
+%LOGOU: LGOUT
+ POPJ P,
+
+; GO TO SLEEP A WHILE
+
+%SLEEP: IMULI A,33. ; TO MILLI SECS
+ DISMS
+ POPJ P,
+
+; HANG FOR EVER
+
+%HANG: WAIT
+
+; READ JNAME
+
+%RXJNA:
+%RJNAM: GETNM ; RETURNS SIXBIT IN A
+ MOVEM A,%JNAM
+ POPJ P,
+
+; READ UNAME
+
+%RXUNA:
+%RUNAM: PUSHJ P,TMTNXS ; GET STRING ON STACK (POINTER IN E)
+ GJINF ; USER NUMBER IS IN A
+ MOVE B,A ; USER NUMBER TO B
+ PUSHJ P,INFST1 ; MAKE INFO STRING
+CPOPJ1: AOS (P) ; SKIP RETURN
+ POPJ P,
+
+; MAKE A STRING FROM DIRST GOODIES
+INFSTR: TDZA 0,0
+INFST1: MOVEI 0,1 ; FLAG WHETHER TO SCAN
+ HRROI A,1(E) ; STRING POINTER IN A
+ DIRST ; GET THE NAME
+ FATAL ATTACHED DIRECTORY DOESN'TEXIST
+ MOVEI B,1(E) ; A AND B BOUND STRING
+ JUMPN 0,INFST2 ; NO NEED TO SCAN
+ SKIPE OPSYS
+ JRST INFST2
+
+ HRLI B,440700
+ MOVE A,B
+
+ ILDB 0,B ; FLUSH : AND <>
+ CAIE 0,"<
+ JRST .-2
+
+ ILDB 0,B
+ CAIN 0,">
+ JRST .+3
+ IDPB 0,A
+ JRST .-4
+
+ MOVE B,A
+ MOVEI 0,0
+ IDPB 0,B
+ MOVEI B,1(E)
+
+
+INFST2: SUBM P,E ; RELATIVIZE E
+ PUSHJ P,TNXSTR ; BUILD STRING (IN A AND B)
+ MOVE C,(P) ; GET RETURN PC FROM PUSHJ
+ SUB P,E ; P BACK TO NORMAL
+ JRST (C)
+
+; HERE TO SEE IF WE ARE A TOP LEVEL JOB
+
+%TOPLQ: GJINF
+ JUMPL D,CPOPJ1
+ JRST CPOPJ
+
+; ERRORS IN COMPILED CODE MAY END UP HERE
+
+CERR1: ERRUUO EQUOTE NEGATIVE-ARGUMENT
+
+CERR2: ERRUUO EQUOTE NTH-REST-PUT-OUT-OF-RANGE
+
+CERR3: ERRUUO EQUOTE UVECTOR-PUT-TYPE-VIOLATION
+
+COMPERR:
+ ERRUUO EQUOTE ERROR-IN-COMPILED-CODE
+
+\f
+; GET AN INFERIOR FOR THE GARBAGE COLLECTOR
+
+%GCJOB: PUSH P,A
+ MOVEI A,CR%CAP ; GET BITS FOR FORK
+ CFORK ; MAKE AN IFERIOR FORK
+ FATAL CANT GET GC FORK
+ MOVEM A,GCFRK ; SAVE HANDLE
+ POP P,A ; RESTORE PAGE
+ MOVEI B,FRNP
+ PUSHJ P,%SHWND
+ POPJ P,
+
+; HERE TO SHARE WINDOW
+
+%SHWNF: PUSH P,0
+ MOVE 0,GCFK1
+ JRST SHWND1
+
+%SHWND: PUSH P,0
+ MOVE 0,GCFRK
+
+SHWND1: PUSH P,A
+ PUSH P,B
+ PUSH P,C
+ ASH B,1 ; TO CRETINOUT TENEX PAGE SIZE
+ HRLI B,MFORK
+ ASH A,1 ; TIMES 2
+ HRL A,0
+ MOVSI C,CTREAD+CTWRIT ; READ AND WRITE ACCESS
+
+ PMAP
+ ADDI A,1
+ ADDI B,1
+ PMAP
+ ASH B,9. ; POINT TO PAGE
+ MOVES (B) ; CLOBBER TOP
+ MOVES -1(B) ; AND UNDER
+ POP P,C
+ POP P,B
+ POP P,A
+ POP P,0
+ POPJ P,
+
+; HERE TO MAP INFERIOR BACK AND KILL SAME
+
+%INFMP: PUSH P,C
+ PUSH P,D
+ PUSH P,E
+ ASH A,1
+ ASH B,1
+ MOVE D,A ; POINT TO PAGES
+ MOVE E,B ; FOR COPYING
+ PUSH P,A ; SAVE FOR TOUCHING
+
+; HERE FOR OPTIONAL MULTI FORK HACK
+
+ SKIPLE A,SFRK ; SKIP NOT ENABLED OR NOT ACTIVE
+ KFORK ; FLUSH THE OLD EXTRA
+
+ MOVS A,GCFRK
+ SKIPE SFRK ; SKIP IF NOT MULTI FORK
+ HLRZM A,SFRK ; SAVE THIS AS IT
+ MOVSI B,MFORK
+ MOVSI C,CTREAD+CTEXEC+CTCW ; READ AND WRITE COPY
+ SKIPE SFRK
+ MOVSI C,CTREAD+CTEXEC+CTWRIT
+
+LP1: HRRI A,(E)
+ HRRI B,(D)
+ PMAP
+ ADDI E,1
+ AOBJN D,LP1
+
+; HERE TO TOUCH PAGES TO INSURE KEEPING THEM (KLUDGE)
+
+ POP P,E ; RESTORE MY FIRST PAGE #
+ SKIPE SFRK ; SKIP IF NOT MULTI CASE
+ JRST ALDON
+ MOVEI A,(E) ; COPY FOR LOOP
+ ASH A,9. ; TO WORD ADDR
+ MOVES (A) ; WRITE IT
+ AOBJN E,.-3 ; FOR ALL PAGES
+
+ MOVE A,GCFRK
+ KFORK
+ALDON: POP P,E
+ POP P,D
+ POP P,C
+ POPJ P,
+
+; HACK TO PRINT MESSAGE OF INTEREST TO USER
+
+MESOUT: MOVSI A,(JFCL)
+ MOVEM A,MESSAG ; DO ONLY ONCE
+ RESET
+ SKIPE SFRK
+ SETOM SFRK ; NO FORK TO HACK RIGGHT NOW
+ PUSHJ P,GETJS ; GET SOME JFNS
+
+ MOVEI A,400000
+ MOVE B,[1,,ILLUUO]
+ MOVE C,[40,,UUOH]
+ SCVEC
+ SETZB SP,FRM ; HACK TO AVOID LOSSAGE WITH GARBAGE IN SP
+ ; FIRST TIME
+ PUSHJ P,GCRSET
+ MOVE A,[MFORK,,THIBOT]
+ MOVSI B,CTREAD+CTEXEC
+ MOVEI 0,777-THIBOT
+ SPACS
+ ADDI A,1
+ SOJGE 0,.-2
+ PUSHJ P,PGINT ; INITIALIZE PAGE MAP
+ GJINF
+ AOJN D,.+3 ; JUMP IF HAS TTY
+ SETOM DEMFLG
+ SETOM NOTTY
+ SKIPN DEMFLG
+ JRST TTON
+ MOVEI A,MFORK ; GET FORK HANDLE
+ RPCAP
+ MOVE C,B ; HAIR TO ENABLE CAPABILITIES OF DEMON
+ EPCAP
+TTON: PUSHJ P,TTYOP2
+ SKIPN DEMFLG ; SKIP IF DEMON
+ SKIPE NOTTY ; HAVE A TTY?
+ JRST RESNM ; NO, SKIP THIS STUFF
+
+ MOVEI A,MESBLK
+ MOVEI B,0
+ GTJFN
+ JRST RESNM
+ MOVE B,[OP%7B,,FREAD]
+ OPENF
+ JRST RESNM
+
+MSLP: BIN
+ MOVE D,B ; SAVE BYTE
+ GTSTS
+ TLNE B,1000
+ JRST RESNM
+ EXCH D,A
+ CAIN A,14
+ PBOUT
+ MOVE A,D
+ JRST MSLP
+
+RESNM2: CLOSF
+IPCINI: JFCL
+
+RESNM: PUSHJ P,TWENTY
+RESNM1: SKIPN MULTSG
+ POPJ P,
+ POP P,C ; STAY IN MAIN SEG
+ HRLI C,FSEG
+ JRST (C)
+
+\f
+; GET JFNS TO MDL INTERPRETER, AGC AND SGC, SAVE IN IJFNS AND IJFNS1
+GETJS: MOVEI A,$TLOSE
+ LSH A,-11
+ HRLI A,MFORK ; THIS FORK
+ RMAP
+ JUMPGE A,GETJS1 ; HAPPY?
+; HERE TO GET MDL INTERPRETER JFN EXPLICITLY RATHER THAN THROUGH RMAP
+ HRROI B,ILDBLK
+ SKIPE OPSYS
+ HRROI B,TILDBL
+ MOVSI A,GJ%SHT+GJ%OLD
+ GTJFN
+ FATAL INTERPRETER EXE FILE MISSING
+ MOVE B,[OP%36B,,FREAD+FWRITE]
+ OPENF
+ FATAL CANT OPEN MDL INTERPRETER EXE FILE
+ HRLM A,A
+GETJS1: HLRZM A,IJFNS ; SAVE JFN TO INTERPRETER
+ POPJ P,
+
+; GTJFN BLOCK FOR MESSAGE FILE
+MESBLK: 100000,,
+ 377777,,377777
+ -1,,[ASCIZ /DSK/]
+ -1,,[ASCIZ /MDL/]
+ -1,,[ASCIZ /MUDDLE/]
+ -1,,[ASCIZ /MESSAG/]
+ 0
+ 0
+ 0
+
+MUDINT: MOVSI 0,(JFCL) ; CLOBBER MUDDLE INIT SWITCH
+ MOVEM 0,INITFL
+
+; LOOP TO TOUCH ALL PAGES SO PURIFY CAN WORK
+
+ SKIPN A,DEMFLG ; SKIP IF A DEMON
+ JRST FINDIR ; GET USERS DIRECTORY
+ AOJE A,FINDIR
+ MOVE A,DEMFLG ; GET SIXBIT OF DIRECTORY NAME
+ PUSHJ P,6TOCHS ; TO CHARACACTER STRING
+ JRST DIRCON
+
+FINDIR: GJINF ; GET INFO NEEDED
+ MOVEM A,SJFNS
+ PUSHJ P,TMTNXS ; MAKE A TEMP STRING FOR TENEX INFO
+ ; (POINTER LEFT IN E)
+ PUSHJ P,INFSTR
+DIRCON: PUSH TP,$TATOM
+ PUSH TP,IMQUOTE SNM
+ PUSH TP,A
+ PUSH TP,B
+ MCALL 2,SETG
+ SKIPE WHOAMI
+ JRST SUBSYS
+ MOVE A,[SIXBIT/MUDDLE/]
+ PUSHJ P,6TOCHS ; MAKE A CHARACTER STRING
+ PUSH TP,$TCHSTR
+ PUSH TP,CHQUOTE READ
+ PUSH TP,A
+ PUSH TP,B
+ PUSH TP,$TCHSTR ; NOW THE .INIT
+ PUSH TP,CHQUOTE .INIT
+ MCALL 2,STRING ; MAKE A STRING
+ PUSH TP,A ; ARGS TO FOPEN
+ PUSH TP,B
+ MCALL 2,FOPEN
+ GETYP A,A
+ CAIN A,TCHAN
+ JRST ISVCHN
+SUBSYS: PUSH TP,$TCHSTR
+ PUSH TP,CHQUOTE READ
+ MOVE A,[SIXBIT /MUDDLE/]
+ SKIPE WHOAMI
+ MOVE A,WHOAMI
+ PUSHJ P,6TOCHS
+ PUSH TP,A
+ PUSH TP,B
+ PUSH TP,$TCHSTR
+ PUSH TP,CHQUOTE INIT
+ PUSH TP,$TCHSTR
+ PUSH TP,CHQUOTE DSK
+ PUSH TP,$TCHSTR
+ PUSH TP,CHQUOTE MUDDLE
+ MCALL 5,FOPEN
+ GETYP A,A
+ CAIE A,TCHAN
+ POPJ P,
+ISVCHN: PUSH TP,$TCHAN
+ PUSH TP,B
+ MOVEI B,INITSTR ; TELL USER WHAT'S HAPPENING
+ SKIPE WHOAMI
+ JRST INCOM
+ SKIPE DEMFLG ; SKIP IF NOT A DEMON
+ JRST INCOM
+ SKIPN NOTTY
+ PUSHJ P,MSGTYP
+INCOM: MCALL 1,MLOAD
+ POPJ P,
+
+TMTNXS: POP P,D ; SAVE RET ADDR
+ MOVE E,P ; BUILD A STRING SPACE ON PSTACK
+ MOVEI 0,20. ; USE 20 WORDS (=100 CHARS)
+ PUSH P,C%0
+ SOJG 0,.-1
+
+ JRST (D)
+
+
+TNXSTR: SUBI B,(P)
+ PUSH P,B
+ ADDI B,-1(P)
+ SUBI B,(A) ; WORDS TO B
+ IMULI B,5 ; TO CHARS
+ LDB 0,[360600,,A] ; GET BYTE POSITION
+ IDIVI 0,7 ; TO A REAL BYTE POSITION
+ MOVNS 0
+ ADDI 0,5
+ SUBM 0,B ; FINAL LENGTH IN BYTES TO B
+ PUSH P,B ; SAVE IT
+ MOVEI A,4(B) ; TO WORDS
+ IDIVI A,5
+ PUSH P,E ; SAVE E
+ PUSHJ P,IBLOCK ; GET STRING
+ POP P,E
+ POP P,A
+ POP P,C
+ ADDI C,(P)
+ MOVE D,B ; COPY POINTER
+ MOVE 0,(C) ; GET A WORD
+ MOVEM 0,(D)
+ ADDI C,1
+ AOBJN D,.-3
+
+ HRLI A,TCHSTR
+ HRLI B,00700 ; MAKE INTO BYTER
+ SOJA B,CPOPJ
+
+INITSTR: ASCIZ /MUDDLE INIT/
+
+; HERE TO RECOPY PAGE 0 WHICH CONTAINS IMFORMATION FOR REMAPPING IN INFERIOR
+%OPGFX: PUSH P,B ; SAVE B
+ PUSH P,A
+ MOVEI B,STOSTR ; TOP OF CONSTANTS
+ ADDI B,1777 ; ROUND
+ ANDCMI B,1777
+ ASH B,-10. ; TO PAGES
+ MOVN A,B
+ MOVEI B,WNDP ; GET WINDOW
+ HRLZS A ; START WITH PAGE 0
+OPGFX2: JUMPGE A,OPGFX1
+ PUSH P,A
+ HRRZS A
+ PUSHJ P,%SHWNF
+ HRRZ A,(P)
+ ASH A,10. ; TO START OF PAGE
+ HRLS A ; SET UP BLT POINTER
+ HRRI A,WIND
+ MOVEI B,WIND
+ BLT A,1777(B) ; OUT INTO THE BUFFER
+ POP P,A ; RESTORE A
+ AOBJN A,OPGFX2
+OPGFX1: POP P,A
+ POP P,B
+ POPJ P,
+
+; ROUTINE TO PROTECT A CORE IMAGE BY SAVING IT IN AN INFERIOR
+; A==FORK HANDLE B== AOBJN POINTER
+
+
+PROTCT: TRNN B,-1 ; SEE IF PAGE 0 IS INCLUDED
+ ADD B,C%11 ; INC PAGE
+ ASH B,1
+ PUSH P,C ; SAVE C
+ MOVE C,B ; COPY AOBJN
+ MOVSI A,MFORK ; FORK HANDLE
+ JUMPE C,PRTDON ; IF ZERO THEN WE ARE DONE
+PROTC1: HRRI A,(C) ; GET PAGE
+ HRRZ D,C
+ ASH D,9.
+ RPACS
+ TLNN B,CTWRIT+CTCW ; SKIP IF NOT READ ONLY
+ TLNN B,CTEXST ; SKIP IF EXISTS (OTHERWISE WE'LL CREATE IT)
+ MOVES 20(D) ; TOUCH PAGE
+ MOVSI B,CTREAD+CTEXEC ; SET UP TO MARK PAGES TO TRAP ON ANY REF
+ SPACS ; CHANGE MODE OF PAGE
+ AOBJN C,PROTC1
+PRTDON: POP P,C ; RESTORE C
+ POPJ P,
+
+%FDBUF: HRRZ A,PURBOT
+ SUB A,P.TOP ; CALCULATE ROOM FOR PROSPECTIVE BUFFER
+ CAIG A,2000 ; SEE IF ROOM
+ JRST FDBUF1
+ MOVE A,P.TOP ; START OF BUFFER
+ HRRM A,BUFGC
+ POPJ P,
+FDBUF1: SETOM BUFGC ; INDICATE NO BUFFER FOUND
+ POPJ P,
+
+; HERE TO SIMULATE A COPY ON WRITE TO AN INFERIOR. IF A PAGE HAS NO WRITE BITS
+; IT WILL COPY IT INTO THE GCFRK1 FORK. A== START OF PAGE, B== START OF BUFFER PAGE
+
+%CWINF: PUSH P,A
+ PUSH P,B ; SAVE AC'S
+ PUSH P,C
+ ANDI A,-1 ; CLEAN OUT LEFT HALF OF A
+ ASH A,-9. ; TO PAGES
+ PUSH P,C%0
+ HRLI A,MFORK ; GET FORK HANDLE
+ RPACS ; READ PAGE BITS
+ MOVEM B,(P)
+ TLNE B,CTEXST ; SKIP IF DOESN'T EXIST
+ TLNE B,CTWRIT ; SEE IF WRITABLE
+ JRST CWINFX ; NO, EXIT
+ MOVSI B,CTEXEC+CTREAD+CTCW
+ SPACS ; RESTORE PAGE TO NORMAL
+CWINFX: ADDI A,1
+ RPACS ; READ PAGE BITS
+ TLNE B,CTEXST ; SKIP IF DOESN'T EXIST
+ TLNE B,CTWRIT ; SEE IF WRITABLE
+ JRST CWINFY ; NO, EXIT
+ MOVSI B,CTEXEC+CTREAD+CTCW
+ SPACS
+ SUB P,C%11
+ JRST CWINFZ
+CWINFY: POP P,B
+ TLNE B,CTEXST ; SKIP IF DOESN'T EXIST
+ TLNE B,CTWRIT ; SEE IF WRITABLE
+ JRST CWINF1 ; NO, EXIT
+CWINFZ: HRRZI A,-1(A)
+ ASH A,-1
+ MOVE B,-1(P) ; SET UP BUFFER PAGE
+ ASH B,-10. ; TO PAGE NUMBER
+ PUSHJ P,%SHWNF ; SHARE A WINDOW
+ HRLZ A,-2(P) ; PREPARE FOR BLT
+ HRR A,-1(P)
+ HRRZ B,-1(P)
+ BLT A,1777(B) ; SAVE THE PAGE
+CWINF1: MOVE B,-1(P)
+ ASH B,-9. ; TO PAGES
+ MOVNI A,1
+ HRLI B,MFORK ; SET UP HANDLE
+ MOVEI C,0
+ PMAP ; FLUSH BUFFER
+ POP P,C
+ POP P,B
+POPAJ: POP P,A
+ POPJ P,
+
+
+
+; ROUTINE TO RESTORE THE IMAGE FROM A SAVED FORK IMAGE.
+; A== FORK HANDLE B== AOBJN POINTER TO MUDDLE
+; C== START IN INF
+
+
+RSTIM: ASH B,1 ; TO CONVERT TO TENEX PAGES
+ ASH C,1
+ HRLZS A ; FORK HANDLE TO LEFT HALF
+ JUMPE C,RSTIM1 ; SEE IF NO WORK TO DO
+RSTIM2: HRRI A,(C)
+ PUSH P,B ; SAVE B
+ RPACS ; READ PAGE BITS
+ TLNN B,CTEXST ; SKIP IF IT EXISTS
+ JRST RSTIM3
+ HRRZ B,(P) ; GET PAGE
+ HRLI B,MFORK ; GET PAGE BACK TO ME
+ PUSH P,C
+ MOVSI C,CTREAD+CTCW+CTEXEC ; PAGE MODES
+ PMAP ; GET THE PAGE
+ POP P,C ;RESTORE C
+ ASH B,9. ; TO START OF PAGE
+ MOVES 20(B) ; TOUCH PAGE
+RSTIM3: POP P,B ; GET BACK B
+ ADDI C,1 ; INC C
+ AOBJN B,RSTIM2 ; GO BACK IN LOOP
+RSTIM1: POPJ P, ; DONE
+
+
+; ROUTINE TO MAP OUT PARTS OF THE INTERPRETER IN ORDER TO PRESERVE IT
+
+%MPINX: MOVE 0,GCFK1
+ JRST MPIN
+
+%MPIN:
+%MPIN1: MOVE 0,GCFRK
+MPIN: PUSH P,C ; SAVE B
+ MOVE C,A
+ MOVE A,0 ; GET FORK HANDLE
+ PUSHJ P,RSTIM
+ POP P,C
+ POPJ P, ; EXIT
+
+%SAVIN: PUSH P,B ; SAVE AC'S
+ PUSH P,A
+ MOVSI A,CR%CAP
+ CFORK
+ FATAL AGC--CAN'T GET GC FORK
+ MOVEM A,GCFK1 ; SAVE FORK HANDLE
+ POP P,B ; RESTORE AOBJN
+ PUSHJ P,PROTCT ; PROTECT IMAGE
+ MOVE A,[MFORK,,THIBOT]
+ MOVEI 0,777-THIBOT
+%SAVLP: RPACS
+ TLNN B,CTWRIT+CTCW ; SKIP IF NOT READ ONLY
+ TLNN B,CTEXST ; SKIP IF EXISTS (OTHERWISE WE'LL CREATE IT)
+ JRST .+3 ; SKIP IF NOT READ ONLY
+ MOVSI B,CTREAD+CTCW+CTEXEC
+ SPACS
+ ADDI A,1
+ SOJGE 0,%SAVLP
+ POP P,B ; RESTORE AC
+ POPJ P,
+
+%MPRDO: HRLI B,-1
+ HRR B,A
+ JRST PROTCT
+
+
+; CREATE A JOB FOR MARKING HACKS (PURIFY AND GC-DUMP) AND SAVES HANDLE IN TWO SEPERATE
+; PLACES.
+
+%GCJB1: PUSHJ P,%GCJOB ; CREATE FORK
+ MOVE A,GCFRK ; GET HANDLE
+ MOVEM A,GCFK2
+ POPJ P,
+
+%CLSMP: MOVE 0,GCFK2 ; GET BACK FROM FORK CONTAINING UPDATED WORLD
+ PUSHJ P,%GBINT
+%CLSM1: MOVE A,GCFK2 ; KILL THE FORK
+KFK1: KFORK
+%IFMP1:
+%CLSJB: POPJ P, ; IN ITS CLOSES AN INFERIORS CHANNEL WITHOUT
+ ; KILLING IT
+
+; HERE TO KILL THE IMAGE SAVING INFERIOR
+
+%KILJB: PUSH P,A ; SAVE MAPPING PARAMS
+ MOVE A,GCFK1
+ KFORK
+ JRST IFMP3 ; GO FIX UP CORE IMAGE
+
+; HERE TO MAP IN SAVED WORLD AND KILL INF CONTAINING IT
+
+;%IFMP1: POPJ P,
+
+; HERE TO MAP IN A PAGE IN READ ONLY MODE FROM THE AGD INFERIOR
+
+%LDRDO: MOVE 0,GCFK1
+ PUSH P,A ; SAVE PAGE POINTER
+ MOVE B,A
+ HRLI B,-1 ; MAKE UP PAGE POINTER
+ PUSHJ P,MPIN ; MAP IN THE PAGES
+ HRLI B,CTREAD+CTEXEC
+ HRLI A,MFORK ; SET UP HANDLE
+ HRR A,(P)
+ ASH A,1 ; CONVERT TO TENEX PATES
+ HRRZ C,A
+ ASH C,9
+ MOVES 20(C)
+ SPACS
+ ADDI A,1
+ HRRZ C,A
+ ASH C,9
+ MOVES 20(C)
+ SPACS
+ SUB P,C%11 ; CLEAN OFF STACK
+ POPJ P,
+
+%IFMP2: PUSH P,A ; SAVE POINTER
+ MOVE 0,GCFK1
+ PUSHJ P,MPIN ; MAP IT IN
+ MOVE A,GCFK1 ; KILL IT
+ KFORK
+IFMP3: POP P,C
+ ASH C,1
+ MOVSI A,MFORK ; SET UP FORK HANDLE
+ JUMPGE C,IFMP2 ; IF DONE
+DORPA: HRR A,C ; GET PAGE #
+ RPACS
+ TLNN B,CTEXST ; SKIP IF IT EXISTS
+ JRST .+3
+ MOVSI B,CTREAD+CTWRIT+CTEXEC ; CAPABILATIES
+ SPACS ; SET CAPABILATIES
+ AOBJN C,DORPA
+IFMP2: POPJ P,
+
+
+%CLMP1: MOVE A,GCFK1 ; KILL THE FIRST FORK
+ JRST KFK1
+
+%IMSV1:
+%MPINT: PUSH P,C ; SAVE C
+ PUSH P,B
+ PUSH P,D
+ ASH A,1
+ MOVEI C,0
+ MOVE D,A
+MPINT1: MOVSI A,MFORK ; SET UP ARGS TO RMAP
+ HRRI A,(D)
+ RMAP
+ MOVEM A,RMPTAB(C)
+ ADDI C,1
+ AOBJN D,MPINT1
+ POP P,D
+ POP P,B
+ POP P,C
+ POPJ P,
+
+
+; ROUTINE TO GET BACK THE INTERPRETER. IT MAPS
+%GBINT: PUSH P,E
+ PUSH P,B
+ PUSH P,C ; SAVE AC'S
+ PUSH P,D
+ ASH A,1
+ MOVE D,A ; COPY UDDATED AOBJN
+ MOVEI E,0 ; ZERO INDEX TO TABLE
+GBINT1: MOVE A,RMPTAB(E) ; GET FILE HANDLE
+ MOVSI B,MFORK ; SET UP INTERPRETER ARG
+ HRRI B,(D)
+ MOVSI C,CTREAD+CTEXEC
+ PMAP ; IN IT COMES
+ ADDI E,1 ; INC INDEX
+ AOBJN D,GBINT1
+ POP P,D
+ POP P,C
+ POP P,B
+ POP P,E
+ POPJ P,
+
+; HERE TO SAVE RMAP TABLE FOR PURIFY
+
+%SAVRP: PUSH P,A ; SAVE AC
+ MOVE A,[RMPTAB,,ORMTAB]
+ BLT A,ENDRPT-1 ; SAVE RMAP TABLE
+ JRST POPAJ
+; POP P,A ; RESTORE A
+; POPJ P,
+
+; HERE TO RESTORE THE RMAP TABLE FOR PURIFY
+
+%RSTRP: PUSH P,A ; SAVE A
+ MOVE A,[ORMTAB,,RMPTAB]
+ BLT A,ORMTAB-1
+ JRST POPAJ
+; POP P,A ; RESTORE A
+; POPJ P,
+
+SQBLK: ASCIZ /PS:<MDL>MDLXXX.SQUOZE/
+TSQBLK: ASCIZ /DSK:<MDL>MDLXXX.SQUOZE/
+
+; 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,
+
+;%CLNCO -- FLUSH SOME PAGES FOR SAFETY
+; C ==> ADDR OF PAGE PREV TO LOSERS
+; E ==> JUST ABOVE LOSERS
+
+%CLNCO: PUSH P,C
+ PUSH P,E
+ ADDI C,777
+ ASH C,-9.
+ ASH E,-9.
+ SKIPE MULSEC
+ JRST @[.+1] ; RUN IN SECT 0
+ CAIG E,1(C)
+ JRST %CLN1
+ PUSH P,A
+ PUSH P,B
+
+ MOVSI B,MFORK
+ HRRI B,(C)
+ MOVNI A,1
+ MOVEI C,0
+
+ PMAP
+ CAIL E,2(B)
+ AOJA B,.-2
+
+ POP P,B
+ POP P,A
+
+%CLN1: POP P,E
+ POP P,C
+ SKIPN MULSEC
+ POPJ P,
+
+ XJRST .+1 ; BACK TO SECT 1
+ 0
+ FSEG,,CPOPJ
+
+; MULTI -- ENTER MULTI SEGMENT MODE
+; THIS ROUTINE MAPS EVERYTHING UP AND THEN GOES UP THERE
+
+MULTI: PUSHJ P,PURCLN ; UNMAP ANY CORRENTLY MAPPED FBINS
+ PUSHJ P,SQKIL ; AND SQUOZE TABLE
+ SETOM MULTSG
+ MOVE A,PURBOT ; MUNG TABLE OF THESE GUYS
+ MOVN B,NSEGS
+ MOVSI B,(B)-1
+
+ MOVEM A,PURBTB(B)
+ AOBJN B,.-1
+
+ MOVE A,VECTOP ; CWRITE GC SPACE
+ ANDCMI A,777
+ MOVES (A)
+ SUBI A,1000
+ JUMPG A,.-2
+
+ MOVEI A,0 ; FIRST CREATE OTHER SECTIONS
+ MOVE B,[MFORK,,FSEG]
+ MOVE C,[CTREAD+CTWRIT+CTEXEC,,1]
+ MOVE D,NSEGS
+ SMAP
+ ADDI B,1
+ SOJG D,.-2
+
+; CREATE GC SEGMENT
+
+ HRRI B,GCSEG
+ SMAP
+
+; NOW LOOP AROUND MAPPING PAGES (MAY TAKE SOME TIME)
+
+ MOVEI D,FSEG_9.
+ MOVEI PVP,FSEG
+ ADD PVP,NSEGS
+ LSH PVP,9. ; PVP NOW HIGHEST PAGE TO MAP
+ MOVSI E,-1000 ; 1ST PAGE AND COUNTER
+
+PAGLP: MOVSI A,MFORK
+ HRRI A,(E)
+ RMAP
+ CAME A,C%M1
+ JRST .+3
+ MOVSI A,MFORK
+ HRRI A,(E)
+ MOVSI B,MFORK
+ HRRI B,(E)
+ IORI B,(D)
+ MOVSI C,CTREAD+CTWRIT+CTEXEC
+ PMAP
+LPON: AOBJN E,PAGLP
+
+ MOVSI E,-1000
+ ADDI D,1_9.
+ CAMGE D,PVP
+ JRST PAGLP
+
+; SETUP MULTI SEG LUUO HANDLER
+
+ MOVEI A,MFORK
+ MOVEI B,2 ; CODE FOR SETUP OF UUO TABLE
+ MOVE C,[FSEG,,MLTUUP]
+ SWTRP
+ MOVEI C,FSEG
+ MOVE B,PVSTOR+1
+ MOVE B,TBINIT+1(B)
+ HRLM C,PCSAV(B)
+ PUSHJ P,INTINT
+
+ POP P,C
+ HRLI C,FSEG ; MAKE INTO FUNNY ADDRESS
+ MOVEI B,0
+ TLO TB,400000 ; MAKE TB BE A LOCAL INDEX
+ XJRST B
+
+NOMULT: PUSHJ P,PURCLN
+ JRST @[.+1] ; RUN IN SECTION 0
+ SETZM MULTSG
+ MOVNI A,1
+ MOVE B,[MFORK,,FSEG]
+ MOVEI C,1
+ MOVE D,NSEGS
+ SMAP
+ ADDI B,1
+ SOJG D,.-2
+
+; FLUSH GC SEG
+
+ HRRI B,GCSEG
+ SMAP
+
+ JRST INTINT
+; PUSHJ P,INTINT
+; POPJ P,
+
+MFUNCTION MMS,SUBR,MULTI-SECTION
+
+ ENTRY
+
+ PUSH P,NSEGS
+ PUSH P,MULTSG
+ JUMPGE AB,RMULT ; NO ARGS==>LEAVE
+ CAMGE AB,C%M30 ; [-3,,]
+ JRST TMA
+ GETYP 0,(AB)
+ CAIE 0,TFIX
+ JRST INOUT
+ MOVE 0,1(AB)
+ CAIL 0,2
+ CAILE 0,30
+ JRST OUTRNG
+ MOVEM 0,NSEGS
+INOUT: GETYP 0,(AB)
+ CAIE 0,TFALSE
+ JRST EMULT
+LMULT: SKIPE (P)
+ PUSHJ P,NOMULT
+ JRST RMULT
+
+EMULT: SKIPN (P)
+ PUSHJ P,MULTI
+
+RMULT: POP P,A
+ POP P,B ; POSSIBLE PREV NSEGS
+ JUMPN A,TMULT
+ MOVSI A,TFALSE
+ MOVEI B,0
+ JRST FINIS
+
+TMULT: MOVSI A,TFIX
+ JRST FINIS
+IMPURE
+
+DEMFLG: 0 ; FLAG INDICATING DEMON
+ ; (IF DEMON SIXBIT OF DIRECTORY)
+SFRK: -1 ; FLAG FOR EXTRA INFERIOR HACK
+GCFRK: 0
+GCFK1: 0
+GCFK2: 0
+RMPTAB: BLOCK 25.
+ORMTAB: BLOCK 25.
+ENDRPT:
+
+MESSAG: PUSHJ P,MESOUT ; MESSAGE SWITCH
+
+INITFL: PUSHJ P,MUDINT ; MUDDLE INIT SWITCH
+
+PURE
+
+END