1
0
mirror of https://github.com/PDP-10/its.git synced 2026-01-20 09:55:52 +00:00
PDP-10.its/src/mudsys/mudex.183
Adam Sampson a81db26a7a Rename to ITS conventions.
MIDAS and Muddle source get version numbers (as in the 1973 Muddle
source); the build files don't.
2018-04-25 09:32:25 +01:00

1054 lines
19 KiB
Plaintext
Raw Blame History

This file contains invisible Unicode characters

This file contains invisible Unicode characters that are indistinguishable to humans but may be processed differently by a computer. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

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
; 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)
; 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