TITLE SAVE AND RESTORE STATE OF A MUDDLE

RELOCATABLE

.INSRT DSK:MUDDLE >

SYSQ


UNTAST==0
IFE ITS,[
IF1,[
.INSRT STENEX >
EXPUNGE SAVE
]
]
.GLOBAL MOPEN,MIOT,MCLOSE,MUDSTR,SWAP,STRTO6,GCPDL,RGPRS,ADDNUL,GCSTOP,PHIBOT
.GLOBAL CHNL0,CHNL1,REOPN,AGC,SWAPIN,MASK1,MASK2,IPCBLS,DEMFLG,FSTART,CKVRS
.GLOBAL P.CORE,P.TOP,SGSNAM,%RUNAM,%RSNAM,%RJNAM,INTINT,CLOSAL,TTYOPE,PURBOT,CHKPGI
.GLOBAL NOTTY,PURCLN,6TOCHS,DISXTR,IDVAL1,N.CHNS,PMAPB,PURTOP,HITOP,FRETOP,FREMIN
.GLOBAL SQKIL,SFRK,GETJS,IJFNS,IJFNS1,MULTSG,MULTI,NOMULT,THIBOT
.GLOBAL MAPJFN,DIRCHN

FME==1000,,-1
FLS==1000,,
MFORK==400000

MFUNCTION FSAVE,SUBR

	ENTRY

	JRST	SAVE1

MFUNCTION SAVE,SUBR

	ENTRY
SAVE1:	PUSHJ	P,SQKIL
IFE ITS,[
	SKIPE	MULTSG
	 PUSHJ	P,NOMULT
]
	PUSH	P,.
	PUSH	P,[0]		; GC OR NOT?
IFE ITS,[
	MOVE	B,[400600,,]
	MOVE	C,[440000,,100000]
]
	PUSHJ	P,GTFNM		; GET THE FILE NAME ONTO P
	 JRST	.+2
	JRST	SAVEON
	JUMPGE	AB,TMA		; TOO MUCH STRING
	GETYP	0,(AB)		; WHAT IS ARG
	CAMGE	AB,[-3,,0]	; NOT TOO MANY
	JRST	TMA
	CAIN	0,TFALSE
IFN ITS,	SETOM	-6(P)		; GC FLAG
IFE ITS,	SETOM	(P)
SAVEON:
IFN ITS,[
	MOVSI	A,7		; IMAGE BLOCK OUT
	MOVEM	A,-4(P)		; DIRECTION
	PUSH	P,A
	PUSH	P,-4(P)		; DEVICE
	PUSH	P,[SIXBIT /_MUDS_/]
	PUSH	P,[SIXBIT />/]
	PUSH	P,-4(P)		; SNAME
	MOVEI	A,-4(P)		; POINT TO BLOCK
	PUSHJ	P,MOPEN		; ATTEMPT TO OPEN
	JRST	CANTOP
	SUB	P,[5,,5]	; FLUSH OPEN BLOCK
	PUSH	P,-6(P)		; GC FLAG TO TOP OF STACK (-4 --> -6 TAA)
]
	EXCH	A,(P)		; CHAN TO STACK GC TO A
	JUMPL	A,NOGC
	PUSH	TP,$TFIX		; CAUSE HAIRY GC TO OCCUR
	PUSH	TP,[0]
	PUSH	TP,$TATOM
	PUSH	TP,IMQUOTE T
	MCALL	2,GC
NOGC:	PUSHJ	P,PURCLN

; NOW GET VERSION OF MUDDLE FOR COMPARISON

	MOVE	A,MUDSTR+2	; GET #
	MOVEI	B,177		; CHANGE ALL RUBOUT CHARACTERS
	MOVEI	C,40		; ----- TO SPACES
	PUSHJ	P,HACKV

	PUSHJ	P,WRDOUT
	MOVE	A,P.TOP		; GET TOP OF CORD
	PUSHJ	P,WRDOUT
	MOVEI	A,0		; WRITE ZERO IF FAST
IFN ITS,	SKIPE	-8(P)	; -6 --> -8 TAA
IFE ITS,	SKIPE	-1(P)
	PUSHJ	P,WRDOUT
	MOVE	A,VECTOP	; CORE REQUIREMENTS FOR THIS SAVED MUDDLE
	PUSHJ	P,WRDOUT

IFN ITS,[
	SETZB	A,B		; FIRST, ALL INTS OFF
	.SETM2	A,

; IF FAST SAVE JUMP OFF HERE

	SKIPE	-6(P)
	JRST	FSAVE1

]

IFE ITS,[
	MOVEI	A,400000	; FOR THIS PROCESS
	DIR			; TURN OFF INT SYSTEM

; IF FAST, LEAVE HERE

	SKIPE	-1(P)
	JRST	FSAVE1

; NOW DUMP OUT GC SPACE

]
IFN ITS,[

DMPDN2:	SETZB	A,B		; SET UP RENAME WHILE OPEN ETC.
	MOVE	E,-1(P)
	MOVE	D,-2(P)
	LDB	C,[270400,,0]	; GET CHANNEL
	.FDELE	A		; RENAME IT
	FATAL SAVE RENAME FAILED
	XOR	0,[<.IOT A>#<.CLOSE>]	; CHANGE TO A CLOSE
	XCT	0

	MOVE	A,MASK1		; TURN INTS BACK ON
	MOVE	B,MASK2
	.SETM2	A,
]

IFE ITS,[

DMPDN2:	MOVE	A,0
	CLOSF
	FATAL CANT CLOSE SAVE FILE
	CIS			; CLEAR IT SYSTEM
	MOVEI	A,400000
	EIR			; AND RE-ENABLE
]

SDONE:	MOVE	A,$TCHSTR
	MOVE	B,CHQUOTE SAVED
	JRST	FINIS

; SCAN FOR MANY OCCURENCES OF THE SAME THING


; HERE TO WRITE OUT FAST SAVE FILE

FSAVE1:
IFN UNTAST,[
	PUSHJ	P,PUCHK
]
	MOVE	A,PARTOP	; DONT WRITE OUT "HOLE"
	ADDI	A,1777
	ANDCMI	A,1777
	MOVEI	E,(A)
	PUSHJ	P,WRDOUT
	MOVE	0,(P)		; CHANNEL TO 0
IFN ITS,[
	ASH	0,23.		; TO AC FIELS
	IOR	0,[.IOT A]
	MOVEI	A,5		; START AT WORD 5
]
IFE ITS,[
	MOVE	A,[-<P-E>,,E]
	PUSH	P,(A)
	AOBJN	A,.-1
	MOVE	A,0
	MOVE	B,P		; WRITE OUT P FOR WIINAGE
	BOUT
	MOVE	B,[444400,,20]
	MOVNI	C,20-6
	SOUT			; MAKE PAGE BOUNDARIES WIN
	MOVEI	A,20		; START AT 20
]
	MOVEI	B,(E)		; PARTOP TO B
	PUSHJ	P,FOUT		; WRITE OUT UP TO PAIR TOP
	PUSHJ	P,PUROUT
	SUB	P,[1,,1]	; CLEAN OFF STACK
	JRST	DMPDN2

IFN ITS,[
FOUT:	MOVEI	D,(A)		; SAVE START
	SUB	A,B		; COMPUTE LH OF IOT PNTR
	MOVSI	A,(A)
	SKIPL	A		; IF + MEANS GROSS CORE SIZE
	MOVSI	A,400000	; USE BIGGEST
	HRRI	A,(D)
	XCT	0		; ZAP, OUT IT GOES
	CAMGE	A,B		; SKIP IF ALL WENT
	JRST	FOUT		; DO THE REST
	POPJ	P,		; GO CLOSE FILE
]
IFE ITS,[
FOUT:	MOVEI	C,(A)
	SUBI	C,(B)		; # OF BYTES TP C
	MOVEI	B,(A)		; START TO B
	HRLI	B,444400
	MOVE	A,0
	SOUT			; WRITE IT OUT
	POPJ	P,
]
	

; HERE TO ATTEMPT TO RESTORE A SAVED STATE

MFUNCTION RESTORE,SUBR

	ENTRY
	PUSHJ	P,SQKIL
IFE ITS,[
	MOVE	B,[100600,,]
	MOVE	C,[440000,,240000]
]
	PUSHJ	P,GTFNM
	JRST	TMA
IFN ITS,[
	MOVSI	A,6		; READ/IMAGE/BLOCK
	MOVEM	A,-4(P)
	MOVEI	A,-4(P)
	PUSHJ	P,MOPEN		; OPEN THE LOSER
	JRST	FNF
	SUB	P,[6,,6]	; REMOVE OPEN BLOCK

	PUSH	P,A		; SAVE CHANNEL
	PUSHJ	P,SGSNAM	; SAVE SNAME IN SYSTEM
]
IFE ITS,	PUSH	P,A		; SAVE JFN
	PUSHJ	P,CKVRS		; CHECK THE VERSION NUMBER

IFN ITS,	MCALL	0,IPCOFF	; CLOSE ALL IPC CHANS
	PUSHJ	P,CLOSAL	; CLOSE CHANNELS
IFN ITS,[
	SETZB	A,B		; KILL ALL POSSIBLE INTERRUPTION
	.SETM2	A,
	DOTCAL	UNLOCK,[[1000,,-1]]
	 .VALUE			; UNLOCK LOCKS
]
IFE ITS,[
	MOVEI	A,400000	; DISABLE INTS
	DIR			; INTS OFF

; LOOP TO CLOSE ALL RANDOM JFNS

	MOVE	E,[-JFNLNT,,JFNTBL]

JFNLP:	HRRZ	A,@(E)
	SKIPE	A
	 CLOSF
	  JFCL
	HLRZ	A,@(E)
	SKIPE	A
	 CLOSF
	  JFCL
	SETZM	@(E)
	AOBJN	E,JFNLP

]
	PUSHJ	P,PURCLN	; DONT KEEP PURE SHAREDNESS

	POP	P,E
IFE ITS,[
	MOVEI	C,0
	MOVNI	A,1
	MOVE	B,[MFORK,,1]
	MOVEI	D,THIBOT-1
	PMAP
	ADDI	B,1
	SOJG	D,.-2
	SKIPLE	A,SFRK		; IF WE HAVE AN INFERIOR, KILL IT
	 KFORK
]
	MOVE	A,E
FSTART:	MOVE	P,GCPDL
	PUSH	P,A
IFN ITS,[
	MOVE	0,[1-PHIBOT,,1]
	DOTCAL	CORBLK,[[FLS],[FME],0]
	FATAL CANT FLUSH PURE PAGES
]
	PUSHJ	P,WRDIN		; GET P.TOP
	ASH	A,-10.
	MOVE	E,A
	PUSHJ	P,WRDIN		; READ A WORD (VECTOP) OR 0==>FAST I.E. MAP RESTORE
	JUMPE	A,FASTR

IFE ITS,[
FASTR1:	MOVEI	A,P-1
	MOVEI	B,P-1-E
	POP	P,(A)
	SUBI	A,1
	SOJG	B,.-2
]

IFN ITS,[
FASTR1:
]
IFN ITS,	MOVEM	E,NOTTY		; SAVE TTY FLAG
IFE ITS,[
	MOVEM	E,DEMFLG
	PUSHJ	P,GETJS
	HRRZS	IJFNS
	SETZM	IJFNS1
]
	PUSHJ	P,PURCLN	; IN CASE RESTORED THING HAD PURE STUFF
	PUSHJ	P,INTINT	; USE NEW INTRRRUPTS

IFN ITS,[
	.SUSET	[.RSNAM,,A]
	PUSH	P,A
]

; NOW CYCLE THROUGH CHANNELS
	MOVE	C,[-N.CHNS*2,,CHNL1]	; POINT TO REAL CHANNELS SLOTS
	PUSH	TP,$TVEC
	PUSH	TP,C
	PUSH	P,[N.CHNS]

CHNLP:	HRRE	A,(C)		; SEE IF NEW VALUE
	JUMPL	A,NXTCHN
	SKIPN	B,1(C)		; GET CHANNEL
	JRST	NXTCHN
	PUSHJ	P,REOPN
	PUSHJ	P,CHNLOS
	MOVE	C,(TP)		; GET POINTER
NXTCHN:	ADD	C,[2,,2]	; AND BUMP
	MOVEM	C,(TP)
	SOSE	(P)
	JRST	CHNLP

	SKIPN	C,CHNL0+1	; ANY PSUEDO CHANNELS
	JRST	RDONE		; NO, JUST GO AWAY
	MOVSI	A,TLIST		; YES, REOPEN THEM
	MOVEM	A,(TP)-1
CHNLP1:	MOVEM	C,(TP)		; SAVE POINTER
	SKIPE	B,(C)+1		; GET CHANNEL
	PUSHJ	P,REOPN
	PUSHJ	P,CHNLO1
	MOVE	C,(TP)		; GOBBLE POINTER
	HRRZ	C,(C)		; REST LIST OF PSUEDO CHANNELS
	JUMPN	C,CHNLP1

RDONE:	MOVE	A,VECTOP
	CAMN	A,P.TOP
	JRST	NOCOR
	SETZM	(A)
	HRLS	A
	ADDI	A,1		; SET UP BLT POINTER
	MOVE	B,P.TOP
	BLT	A,-1(B)		; TO THE TOP OF THE WORLD
NOCOR:	SUB	TP,[2,,2]
	SUB	P,[1,,1]
	PUSHJ	P,TTYOPE
IFN ITS,[
	PUSHJ	P,IPCBLS	;BLESS ALL THE IPC CHANNELS
	PUSHJ	P,SGSNAM	; GET SNAME
	SKIPN	A
	MOVE	A,(P)		; GET OLD SNAME
	SUB	P,[1,,1]
	PUSHJ	P,6TOCHS	; TO STRING
]
IFE ITS,[
	PUSHJ	P,SGSNMQ	; SKIPS IF SNAME IS NON-NIL
	 PUSHJ	P,%RSNAM	;  ELSE GETS "REAL" SNAME
	PUSH	TP,A
	PUSH	TP,B
	MCALL	1,SNAME
	SETOM	SFRK
]
	PUSHJ	P,%RUNAM
	PUSHJ	P,%RJNAM
	MOVE	A,$TCHSTR
	MOVE	B,CHQUOTE RESTORED
	JRST	FINIS

IFE ITS,[
;SKIPS IF THERE IS AN SNAME, RETURNING IT
SGSNMQ:	MOVE	B,IMQUOTE SNM
	PUSHJ	P,IDVAL1
	GETYP	0,A
	CAIE	0,TCHSTR
	 JRST	CPOPJ
	HRRZ	0,A
	JUMPE	CPOPJ
	JRST	CPOPJ1
]

FASTR:
IFN ITS,[
	PUSHJ	P,WRDIN
	ADDI	A,1777
	ANDCMI	A,1777		; ROUND AND TO PAGE BOUNDRY
	ASH	A,-10.		; TO PAGES
	MOVNS	A
	MOVSI	A,(A)		; TO PAGE AOBJN
	MOVE	C,A		; COPY OF POINTER
	MOVE	0,NOTTY		; SAVE NOTTY FLAG AROUND
	MOVE	D,(P)		; CHANNEL
	DOTCAL	CORBLK,[[1000,,104000],[1000,,-1],A,D,C]
	FATAL	CORBLK ON RESTORE LOSSAGE
	PUSHJ	P,PURIN		; GET PURIFIED STRUCTURE
	MOVSI	A,(D)		; GET CHANNLEL BACK
	ASH	A,5
	MOVEI	B,E		; WHERE TO STRAT IN FILE
	IOR	A,[.ACCESS B]
	XCT	A		; ACCESS TO RIGHT ACS
	XOR	A,[<.IOT B>#<.ACCESS B>]
	MOVE	B,[D-P-1,,E]
	XCT	A		; GET ACS
	MOVE	E,0		; NO TTY FLAG BACK
	XOR	A,[<.IOT B>#<.CLOSE>]
	XCT	A
	MOVE	A,GCSTOP	; GET CORE AND FOOL P.CORE
	ADDI	A,1777
	ANDCMI	A,1777
	EXCH	A,P.TOP			; GET P.TOP
	ASH	A,-10.		; TO PAGES
	PUSHJ	P,P.CORE
	PUSHJ	P,NOCORE
	JRST	FASTR1
]

IFE ITS,[
FASTR:	POP	P,A		; JFN TO A
	BIN			; CORE TOP TO B
	MOVE	E,B		; SAVE
	BIN			; PARTOP
	MOVE	D,B
	BIN			; SAVED P
	MOVE	P,B
	MOVE	0,DEMFLG	; SAVE DEMFLG FLAG AROUND
	HRL	E,C		; SAVE VECTOP
	MOVSI	A,(A)		; JFN TO LH
	MOVSI	B,400000	; FOR ME
	MOVSI	C,120400	; FLAGS
	ASH	D,-9.		; PAGES TO D
	PMAP
	ADDI	A,1
	ADDI	B,1
	SOJG	D,.-3

	PUSHJ	P,PURIN

	HLRZS	A
	CLOSF
	JFCL
	MOVE	E,0		; DEMFLG TO E
	JRST	FASTR1
]

; HERE TO GROCK FILE NAME FROM ARGS

GTFNM:
IFN ITS,[
	PUSH	P,[0]		; DIRECTION
	PUSH	TP,$TPDL
	PUSH	TP,P
	IRP A,,[DSK,MUDDLE,SAVE]
	PUSH	P,[SIXBIT /A/]
	TERMIN
	PUSHJ	P,SGSNAM	; GET SNAME
	PUSH	P,A		; SAVE SNAME
	JUMPGE	AB,GTFNM1
	PUSHJ	P,RGPRS		; PARSE THESE ARGS
	JRST	.+2
GTFNM1:	AOS	-5(P)		; SKIP RETURN
	MOVE	A,(P)		; GET SNAME
	.SUSET	[.SSNAM,,A]
	MOVE	A,-5(P)		; GET RET ADDR
	SUB	TP,[2,,2]
	JRST	(A)

; HERE TO OUTPUT 1 WORD

WRDOUT:	PUSH	P,B
	PUSH	P,A
	HRROI	B,(P)		; POINT AT C(A)
	MOVE	A,-3(P)		; CHANNEL
	PUSHJ	P,MIOT		 ;WRITE IT
POPJB:	POP	P,A
	POP	P,B
	POPJ	P,

; HERE TO READ 1 WORD
WRDIN==WRDOUT
]
IFE ITS,[
	PUSH	P,C
	PUSH	P,B
	MOVE	B,IMQUOTE SNM
	PUSHJ	P,IDVAL1
	GETYP	0,A
	CAIN	0,TUNBOU
	 JRST	GTFNM0
	TRNN	A,-1		;ANY LENGTH?
	 PUSHJ	P,%RSNAM	;IF <SNAME> IS "", GET REAL ONE
	PUSHJ	P,ADDNUL
	 SKIPA
GTFNM0:	MOVEI	B,0
	PUSH	P,[377777,,377777]
	PUSH	P,[-1,,[ASCIZ /DSK/]]
	PUSH	P,B
	PUSH	P,[-1,,[ASCIZ /MUDDLE/]]
	PUSH	P,[-1,,[ASCIZ /SAVE/]]
	PUSH	P,[0]
	PUSH	P,[0]
	PUSH	P,[77]		; USE AN OBSCURE JFN IF POSSIBLE
	MOVE	A,(AB)
	MOVE	B,1(AB)
	PUSHJ	P,ADDNUL
	MOVEI	A,-10(P)
	GTJFN
	JRST	FNF
	SUB	P,[9.,,9.]
	POP	P,B
	OPENF
	JRST	FNF
	ADD	AB,[2,,2]
	SKIPL	AB
CPOPJ1:	AOS	(P)
CPOPJ:	POPJ	P,

WRDIN:	PUSH	P,B
	MOVE	A,-2(P)		; JFN TO A
	BIN
	MOVE	A,B
	POP	P,B
	POPJ	P,

WRDOUT:	PUSH	P,B
	MOVE	B,-2(P)
	EXCH	A,B
	BOUT
	EXCH	A,B
	POP	P,B
	POPJ	P,
]


;REPLACE ALL OCCURANCES OF CHARACTER (B) TO CHARACTER (C) IN A
HACKV:	PUSH	P,D
	PUSH	P,E
	MOVE	D,[440700,,A]
	MOVEI	E,5
HACKV1:	ILDB	0,D
	CAIN	0,(B)		; MATCH ?
	DPB	C,D		; YES, CLOBBER
	SOJG	E,HACKV1
	POP	P,E
	POP	P,D
	POPJ	P,


CANTOP:	ERRUUO	EQUOTE CANT-OPEN-OUTPUT-FILE

FNF:	ERRUUO	EQUOTE FILE-NOT-FOUND

BADVRS:	ERRUUO	EQUOTE MUDDLE-VERSIONS-DIFFER


CHNLO1:	MOVE	C,(TP)
	SETZM	1(C)
	JRST	CHNLO2

CHNLOS:	MOVE	C,(TP)
	MOVE	B,1(C)
	SETZM	1(B)			; CLOBBER CHANNEL #
	SETZM	1(C)
CHNLO2:	MOVEI	B,[ASCIZ /
CHANNEL-NOT-RESTORED
/]
	JRST	MSGTYP"

IFN ITS,[
NOCORE:	PUSH	P,A
	PUSH	P,B
	MOVEI	B,[ASCIZ /
WAIT, CORE NOT YET HERE
/]
	PUSHJ	P,MSGTYP"
	MOVE	A,-1(P)		; RESTORE BLOCKS NEEDED
	MOVEI	B,1
	.SLEEP	B,
	PUSHJ	P,P.CORE
	JRST	.-4
	MOVEI	B,[ASCIZ /
CORE ARRIVED
/]
	PUSHJ	P,MSGTYP
	POP	P,B
	POP	P,A
	POPJ	P,
]
IFN UNTAST,[
PUCHK:	MOVEI	E,HIBOT		; COMPUTE REAL START OF INTERPRETER
	ASH	E,-10.		; TO PAGES
	MOVE	A,PURTOP	; GET START TO POSSIBLE AREA CONTAINING P.S.
	ASH	A,-10.		; TO PAGES
PURCH1:	PUSHJ	P,CHKPGI	; SEE IF PAGE IS PURIFIED
	JFCL
	ADDI	A,1		; INCREMENT PAGE COUNTER
	CAMG	A,E		; SKIP IF DONE
	JRST	PURCH1
	POPJ	P,
]

; THESE ROUTINES ARE USED BY SAVE AND RESTORE TO GET PAGES OF PURE STRUCTURE
; INTO A SAVE FILE.

PUROUT:	MOVEI	E,HIBOT		; COMPUTE REAL START OF INTERPRETER
	ASH	E,-10.		; TO PAGES
	MOVE	A,PURTOP	; GET START TO POSSIBLE AREA CONTAINING P.S.
	ASH	A,-10.		; TO PAGES
PUROU2:	PUSHJ	P,CHKPGI	; SEE IF PAGE IS PURIFIED
	JRST	INCPUT
	PUSH	P,A		; SAVE A
	ASH	A,10.		; TO WORDS
	HRLI	A,-2000		; MAKE UP AOBJN PTR FOR IOT
	MOVE	B,-2(P)		; RESTORE CHN #
IFN ITS,[
	DOTCAL	IOT,[B,A]
	FATAL	SAVE--IOT FAILED
]
IFE ITS,[
	PUSH	P,C		; SAVE C
	MOVE	B,A		; SET UP BYTE POINTER
	MOVE	A,0		; CHANNEL TO A
	HRLI	B,444400	; SET UP BYTE POINTER
	MOVNI	C,2000
	SOUT			; OUT IT GOES
	POP	P,C
]

	POP	P,A		; RESTORE PAGE #
INCPUT:	ADDI	A,1		; INCREMENT PAGE COUNTER
	CAMG	A,E		; SKIP IF DONE
	JRST	PUROU2
	POPJ	P,


IFN UNTAST,[

CHKPGJ:	TDZA	0,0
]
CHKPGI:
IFN UNTAST,[
	MOVEI	0,1
]
	PUSH	P,A		; SAVE IT
	IDIVI	A,16.		; FIND ENTRY IN PMAP TABLE
	MOVE	C,PMAPB(A)	; GET WORD CONTAINING ENTRY
	HRLZI	D,400000	; SET UP TEST WORD
	IMULI	B,2
	MOVNS	B
	LSH	D,(B)		; GET TO CHECK PAIR
	LSH	D,-1		; TO BIT INDICATING SAVE
	TDON	C,D		; SKIP IF PAGE CONTAINS P.S
	JRST	PUROU1
	POP	P,A
	AOS	(P)		; SKIP ITS A WINNER
IFN UNTAST,[
	JUMPN	0,.+4
	LSH	D,1
	TDNN	C,D
	AOS	(P)
]	POPJ	P,		; EXIT
PUROU1:
IFN UNTAST,[
	JUMPE	0,CHKPG2
IFN ITS,[
	PUSH	P,A
	DOTCAL	CORTYP,[A,[2000,,A],[2000,,0]]
	FATAL DOTCAL FAILURE
	SKIPN	A
	MOVEI	0,0
	POP	P,A
	JUMPGE	0,CHKPG2
]
IFE ITS,[
	PUSH	P,A
	PUSH	P,B
	LSH	A,1
	HRLI	A,400000
	RPACS
	MOVE	0,B
	POP	P,B
	POP	P,A
	TLC	0,150400
	TRNE	0,150400
	JRST	CHKPG2
]
	LSH	D,1
	TDO	C,D
	MOVEM	C,PMAPB(A)
	AOS	-1(P)
CHKPG2:]
	POP	P,A
	POPJ	P,


; ROUTINE TO READ IN PURE STRUCTURE PAGES

IFN ITS,[
PURIN:	PUSH	P,D		; SAVE CHANNEL #
	MOVEI	E,HIBOT		; COMPUTE REAL START OF INTERPRETER
	ASH	E,-10.		; TO PAGES
	MOVE	A,PURTOP	; GET START TO POSSIBLE AREA CONTAINING P.S.
	ASH	A,-10.		; TO WORDS
PURIN1:
IFN UNTAST,	PUSHJ	P,CHKPGJ	; SEE IF PURE PAGE EXISTS
IFE UNTAST,	PUSHJ	P,CHKPGI	; SEE IF PURE PAGE EXISTS
	JRST	NXPGPN
IFN UNTAST,[
	SKIPA	D,[200000]
	MOVEI	D,[104000]
	MOVSI	0,(D)
]
	PUSH	P,A		; SAVE A
	MOVE	D,-1(P)		; RESTORE CHANNEL #
	HRLI	A,-1		; SET UP AOBJN POINTER FOR DOTCAL
IFN UNTAST,[
	DOTCAL	CORBLK,[0,[1000,,-1],A,D]
]
IFE UNTAST,[
	DOTCAL	CORBLK,[[1000,,200000],[1000,,-1],A,D]
]
	FATAL SAVE--CORBLK FAILED
	POP	P,A		; RESTORE A
NXPGPN:	ADDI	A,1
	CAMG	A,E		; SKIP IF DONE
	JRST	PURIN1
	POP	P,D		; RESTORE CHANNEL
	POPJ	P,
]
IFE ITS,[
PURIN:	PUSH	P,A		; SAVE CHANNEL
	MOVEI	E,HIBOT		; TOP OF SCAN
	ASH	E,-10.
	MOVE	A,PURBOT	; BOTTOM OF SCAN
	ASH	A,-10.		; TO PAGES
PURIN1:	PUSHJ	P,CHKPGI	; SEE IF PAGE IS NEEDED
	JRST	NXTPGN
	SKIPA	C,[120000]
	MOVEI	C,120400
	PUSH	P,A
	MOVE	B,A		; COPY TO B
	ASH	B,1		; FOR TEXEX PAGES
	HRLI	B,MFORK		; SET UP ARGS TO PMAP
	MOVSI	C,(C)
	MOVE	A,-1(P)		; GET FILE POINTER
	PMAP			; IN IT COMES
	ADDI	B,1		; INCREMENT B
	ADDI	A,1		; AND A
	PMAP			; SECOND HALF OF ITS PAGE
	ADDI	A,1
	MOVEM	A,-1(P)		; SAVE FILE PAGE
	POP	P,A
NXTPGN:	ADDI	A,1
	CAMG	A,E		; SKIP IF DONE
	JRST	PURIN1
	POP	P,A		; RESTOR CHANNEL
	POPJ	P,		;EXIT
]
CKVRS:	PUSH	P,-1(P)
	PUSHJ	P,WRDIN		; READ MUDDLE VERSION
	MOVEI	B,40		; CHANGE ALL SPACES
	MOVEI	C,177		; ----- TO RUBOUT CHARACTERS
	PUSHJ	P,HACKV
	CAME	A,MUDSTR+2	; AGREE ?
	JRST	BADVRS
	SUB	P,[1,,1]	; POP OFF CHANNEL #
	POPJ	P,

IFE ITS,[
JFNTBL:	SETZ	IJFNS
	SETZ	IJFNS1
	SETZ	MAPJFN
	SETZ	DIRCHN

JFNLNT==.-JFNTBL
]
END