; -*-MIDAS-*-
.SYMTAB 10000.
TITLE DECUUO -- DEC UUO emulator for ITS
VERSION==.FNAM2

; For information on how to use DECUUO, read .info.;decuuo order.
; If you care about the revision history, see MC:DECSYS;DECUUO HISTOR

	subttl	Conditional Assembly

; MACRO's to clean up the source

define TWO
ifn TWOSW!termin
define NOTWO
ife TWOSW!termin

ifndef TWOSW,TWOSW==-1	;separate code into pure and impure pages

QQUOTE==^^		;quote character for unmapping TV keyboard input
CTRL==^B
META==^C		;character interpreted as META bit
CTLMTA==^F


;AC assignments

M=1		;used for display
A=2		;don't change these without changing the drawing program
B=3
C=4
D=5
E=6
P=7
T=10		;don't use these AC's in the UUO handler
TT=11		;             ""

LOWAC==M		;lowest AC used by UUO handler
HIGHAC==P		;highest AC used by UUO handler

	subttl	Macros and Storage Area Definitions

NOTWO,[DEFINE STORAGE (A)
TERMIN	]

TWO,[
DEFINE STORAGE (NAM)
IFE LCPURE-LCCURR,LCPURE==.
IFE LCIMPU-LCCURR,LCIMPU==.
.==LC!NAM
LCCURR==.
TERMIN
];TWO

TVBUF==700000		;PDP-11 TV BUFFER IN OUR MAP
TVPAGS==10		;10 PAGES OF TV BUFFER

	IMPURE==TVBUF+<TVPAGS+1>*2000		;ORIGIN OF IMPURE AREA
	PURE==740000				;ORIGIN OF PURE AREA
	AVAILP==<IMPURE+1777>/2000		;PAGES AVAILABLE FOR CLIENT

LOC IMPURE

LCIMPU==IMPURE
LCPURE==PURE
LCCURR==IMPURE

DEFINE PHASE X
	OFFSET X-.
TERMIN

DEFINE DEPHASE
	OFFSET 0
TERMIN

DEFINE	POINT (S,ADDR,B=-1,)
<<<<35.-.RADIX 10.,B>&77>_30.\<<.RADIX 10.,S>&77>_24.> ADDR>TERMIN

DEFINE INSIRP A,B
IRPS XXX,,[B]
     A,XXX
TERMIN TERMIN

DEFINE SYSCAL NAME,ARGS
	.CALL [SETZ ? SIXBIT/NAME/ ? ARGS ((SETZ))]
TERMIN

DEFINE SYSCLV NAME,ARGS
	.CALL [SETZ ? SIXBIT/NAME/ ? ARGS ((SETZ))]
	 .LOSE 1000
TERMIN

DEFINE ERROUT STRING/
	.SUSET [.RJPC,,ERRJPC]
	MOVE HIGHAC,[UUOACS,,LOWAC]
	BLT HIGHAC,HIGHAC
	SOS UUOH
	.VALUE [ASCIZ \:STRING
2\]
	SETZM UUO40
	JRST 2,@UUOH
TERMIN

COMMENT 

.XCREF A,B,C,D,E,P

HERE ARE THE ITS AND DEC UUOS LINED UP FOR ALL TO SEE
THOSE WHICH ARE NOT IMPLEMENTED ARE DENOTED WITH A "*".

40	.IOT		CALL
41	.OPEN		INIT
42	.OPER
43	.CALL
44	.USET
45	.BREAK
46	.STATUS
47	.ACCESS		CALLI
50			OPEN
51			TTCALL
52
53
54
55			RENAME
56			IN
57			OUT
60			SETSTS
61			STATO
62			GETSTS
63			STATZ
64			INBUF
65			OUTBUF
66			INPUT
67			OUTPUT
70			CLOSE
71			RELEASE
72			MTAPE
73			UGETF*
74			USETI
75			USETO
76			LOOKUP
77			ENTER
100			UJEN*



IFNDEF .JB41,[
.INSRT SYS:DECDFS >
.DECDF
.DEC.J .DECS1	;WE WANT THE JOBDAT SYMBOLS IN OUR OWN BLOCK BECAUSE WE DON'T
.DECJH .DECHK	;HAVE A JOBDAT.REL LINKED IN WITH US.
]

.INSRT SYS:DECBTS >

CL.LOS==1000		;CLOSE SHOULDN'T FILE AWAY (IE, SHOULD RENAME FIRST).

;IO CHANNELS

LOADCH==0		;CHANNEL USED FOR LOADING
;CHANNELS 16, 17 INITIALLY USED FOR TTY I/O BUT THEY MAY BE CHANGED
;DURING OPRERATION - SEE TTYOCH AND TTYICH.
;SIMILARLY, 14 INITIALLY USED FOR DISPLAY HACKERY.

SIXCH==15

;DPY TYPES

DPY340==0		;DEC 340
DPYGT4==1		;GT40
DPYTV==2		;PDP-11 TV
TVOR==16		;TV ALU MODES
TVSET==17		;WE PREFER ZENITH
TVXOR==6
TVNXM==TVBUF+<TVPAGS*2000> ;FIRST ILLEGAL LOC AFTER TV MAP
TVCREG==TVNXM
DEFINE TVALU
[341000,,TVCREG]TERMIN

PGLEN==20		;NUMBER OF PIECES OF GLASS
PPLEN==1		;NUMBER OF PIECES OF PAPER
PGPPLN==PGLEN+PPLEN
PPHDL==2		;LENGTH OF PIECE OF PAPER HEADER
PPBKL==200		;SIZE OF CURRENT PIECE OF PAPER BUFFER

HIBASE==600000		;BASE ADDRESS OF DISPLAY LIST STORAGE

MAXJ==200		;MAX # JOBS (AS FAR AS SIMULATED PROGRAM IS CONCERNED)
			;OUGHT TO BE > I.T.S. MAX # OF JOBS.

	subttl	PDP-6 Display Program

STORAGE(PURE)

SIXPRG==.

DIS==130
SIXORG==100		;ORIGIN OF PDP-6 PROGRAM IN PDP-6

PHASE SIXORG

SIXGO::	CONO DIS,100	;GRAB THE 340
6WAIT::	SKIPN DLSTOP-HIBASE
	JRST .-1
	MOVEI A,DLVIS-HIBASE
LOOP::	JUMPE A,6WAIT	;END OF LIST
	CONO DIS,100	;RESET 340
	MOVE A,(A)
	HLRZ B,A	;POINTS TO BLKO POINTER
	HRRZS A
	CAIE A,0	;DONT RELOCATE NULL POINTER
	SUBI A,HIBASE
	JUMPE B,LOOP	;POINTS AT NOTHING
	SUBI B,DLPP-DLPP6+HIBASE	;POINTS TO BLKO POINTER
	SKIPL B,(B)	;THE BLKO POINTER
	JRST LOOP	;NOT REALLY BLKO POINTER
	SUBI B,HIBASE

LOOP1::	MOVEI C,100	;TIME OUT IN CASE DISPLAY HANGS
	CONSO DIS,200	;WAIT FOR DONE
	SOJG C,.-1
	JUMPE C,ERR
	SKIPN DLSTOP-HIBASE
	JRST 6WAIT	;DISPLAY STOPPED BY PDP10
	BLKO DIS,B
	JRST .+2	;BLKO COUNTED OUT
	JRST LOOP1	;MORE TO GO
	MOVEI C,200
	CONSO DIS,100	;WAIT FOR DONE
	SOJG C,.-1
	JRST LOOP

ERR::	CONSO DIS,5000
	JRST LOOP
	CONO DIS,200	;EDGE PROTECTION VIOLATION
	JRST LOOP1

SIXPAT::BLOCK 20

SIXEND::0

DEPHASE

HIUSE==SIXEND

DEFINE DPYSTG(NAME,LENGTH)
NAME=HIUSE+HIBASE ? HIUSE==HIUSE+LENGTH
TERMIN

DPYSTG(DLSTOP,1)	;-1=>DISPLAY RUNNING
DPYSTG(PPBLK,PPBKL)	;BUFFER FOR ACTIVE PIECE OF PAPER
DPYSTG(DLVIS,PGPPLN)	;THAT WHICH IS GIVEN TO THE SYSTEM
DPYSTG(DLPP6,1)		;BLKO POINTER TO ACTIVE PIECE OF PAPER (MUST PRECEDE DLPG6)
DPYSTG(DLPG6,PGPPLN)	;340 PAGE POINTERS (BLKO FORMAT)(ACCESSIBLE TO PDP-6)

	subttl	Configuration Variables

STORAGE IMPURE
IFN .-IMPURE,.ERR IMPURE WORDS ASSEMBLED BEFORE COMFIGURATION VARS

;ADD TO THIS PAGE ONLY AT THE END.

;WORDS TO SET TO DEBUG PROGRAM'S REACTIONS TO ADVERSE OPERATING SYSTEM CONDITIONS

CORMAX:	HIBASE		;# OF WORDS JOB CAN HAVE.
FT2REL::
TWOSEG:	-1		;WE DO HANDLE TWO SEGMENTS


;WORDS THAT ENABLE OR DISABLE SYSTEM FUNCTIONS SELECTIVELY

FT5UUO:	-1		;IF 0, ALL CALLS THAT REQUIRE IT SIMPLY FAIL TO SKIP.
			;SINCE SOME AREN'T IMPLEMENTED AND WILL GO TO MISSING,
			;SOME PROGRAMS CAN ONLY BE SIMULATED WITH THIS SWITCH = 0.

PRIVIL:	0		;NONZERO => JOB IS PRIVILEGED. THAT MEANS THAT PRIVILEGED
			;SYSTEM FUNCTIONS WILL GO TO MISSING INSTEAD OF JUST
			;FAILING TO SKIP.
			;THIS WORD IS READ IN BY GETTAB AS THE JOB'S PRIVILEGE WORD.

;FLAGS TO MAKE SPECIFIC UUOS AVOID COMPLAINING.

ZDISK.:	0		;0 => DISK. JUST RETURNS. -1 => CALLS MISSING
FTTMP::
ZTMPCO:	0		;0 => TMPCOR SAYS FILE NOT FOUND. -1 => MISSING
ZREASS:	0		;0 => REASSI TRIES TO AVOID COMPLAINING. -1 => MISSING
ZSEEK:	0		;0 => SEEK IS A NO-OP. -1 => MISSING
FTSFD:	-1		;0 => PATH. NOT IMPLEMENTED. -1 => TRIES TO WORK.
ZSFDTRN:-1		;0 => NO SFD'S EXIST.  -1 => SFD "FOO" IS I.T.S. UFD "FOO".
ZPTLOA:	0		;0 => PTLOAD IS NO-OP. -1 => MISSING.
	0		;(obsolete)

	0		;(obsolete)
FTSET:	-1		;-1 => SETUUO EXISTS (BUT IS EITHER MISSING, PRIV OR NO-OP).
ZSTUUO:	0		;0 => UNIMPLEMENTED UNPRIVILEGED SETUUO FUNCTIONS ARE NO-OPS.
			;-1 => THEY ARE MISSING.
ZJOBS:	0		;-1 => JOBS OTHER THAN THIS ONE SAY MISSING.
			;0 => THEY GIVE "JOB DOESN'T EXIST" RETURN.
ZPROT:	0		;-1 => BARF IF TRY TO SET PROTECTION CODE WITH ENTER
ZCRDAT:	0		;-1 => BARF IF TRY TO SET CREATION DATE WITH ENTER
ZMPV:	-1		;0 => DON'T LET USER PROGRAM ENABLE MPV WITH APRENB
			;(JUST IGNORE ATTEMPTS).  MPV'S ALWAYS CAUSE ERRORS.
	0		;(obsolete)
ZGTTAB:	-1		;0 => IMPORTANT GETTABS THAT WE CAN'T HANDLE FAIL.
			;-1 => THEY ARE MISSING.
FTPTYUUO:-1		;-1 => JOBSTS AND CTLJOB UUOS EXIST, MINIMALLY.
ZPHYS:	0		;0 => IGNORE UU.PHY, UU.PHS, UU.DER, UU.DEL.  -1 => MISSING
	0		;(obsolete)
ZNDATE:	0		;0 => GMT TIME RETURNED AS 0 (ENOUGH FOR COMPIL!); -1 => MISSING
ztrmop:	0		;0 => TRMOP. is a no-op
			;-1 => it is missing
zobsolete:0		;0 => obsolete UUO's work normally
			;-1 => they are obsolete
zimplement:0		;0 => never implemented UUO's are no-ops
			;-1 => they are never implemented

STORAGE PURE

	subttl	Impure Storage

;INTERRUPT LEVEL STORAGE

TTYBFL==200
TTYBPW==4	;NUMBER BYTES PER WORD IN TTY BUFFER
INT1PL==20
INTPDL==3*<INT1PL+20>

STORAGE(IMPURE)

DITSVR:	.FNAM1		;SOURCE FILE IN SIXBIT
	.FNAM2
WATCH:	0		;JOB'S WATCH BITS.
APRBIT:	0		;APR TRAP BITS ENABLED
CLKENB:	0		;-1 => CLOCK INTS ARE NEEDED, SO ENABLE THEM.
ACTCHR:	0		;NUMBER ACTIVE CHARACTERS IN TTYBUF
ACTLIN:	0		;NUMBER LINEFEEDS IN TTYBUF
GETCC:	0		;GET CHARACTER COUNTER
GETBPT:	0		;GET BYTE POINTER
PUTCC:	0		;PUT CHARACTER COUNTER
PUTBPT:	0		;PUT BYTE POINTER
RIB:	0		;RUBOUT IN PROGRESS
CHAR:	0		;CHARACTER TYPED
TTYNUM:	0		;THE TTY NUMBER OF OUR CONSOLE
QUOTE:	QQUOTE		; THE CHARACTER THAT UNMAPS TV KEYBOARD INPUT
QUOTEF:	0		; -1 IF TV KEYBOARD QUOTE CHARACTER TYPED
TCTYPE:	0		;CONSOLE TYPE
TCMXH:	0		;HORIZ SIZE OF TTY
TCMXV:	0		;VERT SIZE OF TTY
TTYOPT:	0		;TTY CHARACTERISTICS BITS
TTYST1:	0		;OUR TTY'S TTYST1 VARIABLE IN I.T.S.
TTYST2:	0		;OUR TTY'S TTYST2 VARIABLE.
TTYSTS:	0		;OUR TTY7S TTYSTS VARIABLE.
TVDPY:	0		;-1 IF ON A TV
TVCORE:	0		;HAVE TV PAGES IN MAP
TTYMTA:	0		;-1 IF META BITS IN CHARACTER SUPPLIED BY I.T.S.
BRKTAB:	BLOCK 4		;TTY BREAK TABLE, 1 BIT FOR EACH ASCII CHARACTER
STKSW:	0		;-1=>WE HAVE STANFORD KEYBOARD
TICKS:	0		;# HALF SECOND CLOCK TICKS
INBLNK:	0		;DLVIS INDEX FOR BLINKING PIECE OF GLASS
BLNTIM:	0		;1/2 SECOND CLOCK COUNTDOWN FOR BLINK THROTTLE
PGBLNK:	0		;BLINKING PIECE OF GLASS
BLNKIT:	0		;-1=>NEXT UPGIOT WILL BLINK
TTYBUF:	BLOCK TTYBFL	;TTY BUFFER
INTPDP:	-INTPDL,,INTPDB-1;INTERRUPT LEVEL PUSH DOWN POINTER
INTPDB:	BLOCK INTPDL	;INTERRUPT LEVEL PUSH DOWN STACK

TTYICH:	-1		;TTY INPUT CHANNEL NUMBER, OR -1 IF THERE IS NONE.
TTYOCH:	-1		;TTY OUTPUT CHANNEL NUMBER, ...
DSPCH:	-1		;DISPLAY OUTPUT CHANNEL NUMBER, ...

ERRJPC:	0		;JPC AT LAST ERROR RETURN TO USER
			;FOR FINDING WHERE IN DECUUO THE ERROR WAS DETECTED.
INTJPC:	0		;JPC AT LAST INTERRUPT.
INTPC:	0		;PC AT LAST INTERRUPT (FOR DEBUGGING)
INTBTS:	0		;LAST INTERRUPT'S BITS (FOR DEBUGGING)

JOBNAM:	0		;JOB NAME AS SET BY SETNAM.

HSGNUM:	-1		;"JOB NUMBER" OF HISEG.
INFNAM:	'HISEG0		;JNAME TO USE WHEN OPENING INFERIOR TO SAV EA HISEG IN.

IFNDEF HSGTBL,HSGTBL==10 ;WE CAN HAVE ONLY THAT MANY INFERIORS ANYWAY.
HSGNUT:	BLOCK HSGTBL	;REMEMBER THE JOB #S OF ALL OUR INFERIORS.

IFNDEF DEVCSL,DEVCSL==20
DEVCSH:	BLOCK DEVCSL	;EACH ENTRY IS NAME OF DEV KNOWN TO EXIST OR TO NOT EXIST, OR 0.
DEVCS1:	BLOCK DEVCSL	;-1 IF CORRESP. DEV. IN DEVCSH EXISTS; 0 IF IT DOES'T EXIST.


TTYLCH:	0		;TELETYPE GETCHR WORD AND TTY I/O STATUS WORD.

;LH IS HACKED BY GETLCH AND SETLCH.
;RH REFLECTS CHDMOD OF LAST TTY CHANNEL TO HAVE INIT, OPEN OR SETSTS.

;LH BITS

 TT.III==400000		;(SAIL ONLY) THIS TTY IS AN III.
 TT.HDX==10000		;HALF DUPLEX TERMINAL
 TT.IMP==1000		;(SAIL ONLY) THIS TTY IS A PTY BEING RUN BY A STELNT.
 TT.PWT==400		;(SAIL ONLY) TTY INPUT SHOULD TERMINATE PTY INPUT WAIT.
 TT.ACT==100		;(DEC ONLY) AN ACTIVATION CHAR IS PRESENT IN INPUT BUFFER.
			;(SAIL ONLY) SPECIAL ACTIVATION MODE.
 TT.RUB==40		;RUBBING OUT IS IN PROGRESS.
 TT.NCC==20		;NO CONVERSION OF LOWER CASE TO UPPER.
 TT.TAB==10		;(DEC) TTY HAS HDWR TABS (SAIL) TTY DOESN'T HAVE HDWR TABS.
			;ALL TTYS ALWAYS CLAIM TO HAVE THEM.
 TT.NEC==4		;DON'T ECHO (TREAT TTY AS HALF-DUPLEX)
 TT.ILF==2		;(DEC ONLY) PAPER TAPE MODE.
			;(SAIL ONLY) INHIBIT INSERTION OF LF AFTER CR.

 TT.DEC==36		;DEC SYSTEM ALLOWS THESE BITS TO BE SET.
 TT.SAI==101536		;SAIL ALLOWS THESE BITS TO BE SET.
 TT.LOS==1012		;THESE BITS ARE MISSING IF USER TRIES TO CHANGE THEM.

;TT.RUB, AND TT.ACT IN DEC MODE, DON'T REALLY LIVE IN TTYLCH.
;THEY ARE COMPUTED BY GETLCH.

;RH BITS

 IO.FLS==1000		;1 => OUTPUT HAS BEEN SILENCED BY ^O OR FLUSHING A --MORE--.
 IO.TEC==SETZ_-27.	;(DEC) DON'T ECHO ALTMODE
			;(SAIL) DON'T ECHO CONTROL AND META CHARS.
 IO.SUP==SETZ_-28.	;DON'T ECHO ANYTHING
 IO.FCS==SETZ_-29.	;(DEC) FULL CHARACTER SET.  RUBOUT, ^U ARE PASSED TO PROGRAM.

	subttl	I/O Channel Tables

CHDEV:	BLOCK 20	;DEVICE NAME OF CHANNEL. 0 => CHANNEL NOT INITTED.
CHNAME:	BLOCK 20	;FN1 OF CHANNEL
CHEXTE:	BLOCK 20
CHSNAM:	BLOCK 20	;"PPN" OF CHANNEL.
CHSFD:	BLOCK 20	;SFD NAME OF CHANNEL'S PATH
CHOSNM:	BLOCK 20	;I.T.S. DIRECTORY OF FILE. = CHSFD, OR CHSNAM IF CHSFD = 0.
CHRDEV:	BLOCK 20	;"REAL" (TRANSLATED) DEVICE NAME OF CHANNEL.
CHIHDR:	BLOCK 20	;INPUT BUFFER HEADER ADDRESS. -1 => DUMP MODE.
			;0 => NO HEADER OR CHANNEL NOT INITTED.
CHOHDR:	BLOCK 20	;SIMILAR, FOR OUTPUT BUFFER HEADER.
CHIOPN:	REPEAT 20,-1	;-1 => INPUT SIDE OF THIS DEC CHANNEL ISN'T FULLY OPEN YET.
			;ELSE # OF I.T.S. CHANNEL IN USE BY IT.
			;20 => FULLY OPEN, BUT DOESN'T NEED ANY I.T.S. CHANNEL.
			;1,,<CH> FULLY OPEN SIMULATED UFD, READING I.T.S. UFD ON
			;CHANNEL <CH>.
CHOOPN:	REPEAT 20,-1	;LIKE CHIOPN, BUT FOR OUTPUT SIDE OF DEC CHANNEL.
CHIMOD:	BLOCK 20	;I.T.S. MODE FOR INPUT SIDE. RANDOM IF CHANNEL NOT INITTED.
CHOMOD:	BLOCK 20	;I.T.S. MODE FOR OUTPUT SIDE. RANDOM IF CHANNEL NOT INITTED.
CHDMOD:	BLOCK 20	;DEC I/O MODE CHANNEL IS INITTED IN. "  "   "   "   "   "
CHLKEN:	BLOCK 20	;BIT 4.9 => ENTER DONE. BIT 4.8 => LOOKUP DONE.
 CHBENT==400000
 CHBLKP==200000
 CHBREN==100000		;DURING RENAME, C HAS <CHBENT+CHBREN,,>
CHOLKE:	BLOCK 20	;0 => NO LOOKUP OR ENTER DONE ON THIS CHANNEL
			;1 => MOST RECENT LOOKUP OR ENTER SUCCEEDED
			;-1 => MOST RECENT ONE FAILED.  USED TO DECIDE WHETHER RENAME WINS.
CHNDLE:	BLOCK 20	;NONZERO => THIS DEVICE NEEDS LOOKUP/ENTER. 0 IF NOT INITTED.
CHDIDX:	BLOCK 20	;NEGATIVE => INDEX OF INITTED DEVICE IN DEVTAB AND OTHER TABLES.
			;IN THIS CASE, THE DEVICE IS A KNOWN ONE.
			;0 => CHANNEL NOT INITTED.
			;ELSE RH IS INDEX OF "DSK" IN DEVTAB AND OTHER TABLES.
CHEOFC:	BLOCK 20	;0=>CHANNEL CLEAR
			;0,,-1=>EOF SEEN NOT AT BEGINNING OF A TRANSFER
			;-1 => AN IN OR INPUT WAS GIVEN WHEN AT EOF.
chufdu:	block 20	;useti pointer for simulated ufd's(sigh)
CHIWRD:	BLOCK 20	;BUFFERED-AHEAD WORD OF INPUT.
CHOPN:	BLOCK 20	;-1 => I.T.S. CHANNEL IS OPEN
			;CAN BE SET IF SIMULATED CHANNEL IS FREE, IF ITS CHANNEL
			;IS IN USE AS TTYICH, TTYOCH OR DSPCH.
			;CAN BE OFF IF SIMULATED CHANNEL IS IN USE FOR A DEVICE
			;SUCH AS TTY, THAT DOESN'T NEED AN ITS CHANNEL.
			;ITS CHANNEL MAY BE IN USE FOR INTERNAL REASON AT SAME
			;TIME THAT SIMULATED CHANNEL IS IN USE BUT DOESN'T NEED
			;AN ITS CHANNEL.

ENNAME:	0		;ARGS TO ENTER/LOOKUP/RENAME PUT HERE FOR PRELIMINARY
ENEXTE:	0		;DECODING. BEFORE BEING TRANSFERED TO CHNAME, CHEXTE, CHSNAM.
ENSNAM:	0
ENOSNM:	0
ENSFD:	0

SNAME:	0		;THESE THREE ARE INITIAL VALUES OF THE .SUSET VARIABLES.
UNAME:	0
XUNAME:	0
SFD:	0		;INITIAL DEFAULT SFD IS 0 (NONE).
ITSVER:	0		;VERSION OF THIS MACHINE'S I.T.S.
MNAME:	0		;NAME OF THIS MACHINE.

;THE FILE TO OPEN, FOR RUN/GETSEG/SWAP.

OPNDEV:	SIXBIT /DSK/
OPNFN1:	0
OPNFN2:	0
OPNSNM:	0

RUNDEV:	0		;THE "REAL" DEV NAME AT RUNI (BEFORE CHANGING SYS: TO DECSYS;).
RUNOFS:	0		;IN RUN UUO, HOLDS START-ADDRESS OFFSET
RUNCOR:	0		;IN RUN UUO, HOLDS USER-SPEC'D CORE SIZE.
RUNLDH:	0		;-1 IN RUNI WHEN OLD HISEG IF ANY HAS BEEN CLOBBERED.
RUNLDL:	0		;-1 IN RUNI WHEN OLD LOWSEG IF ANY HAS BEEN CLOBBERED.

;.CBLK AC,

	;AC 4.9 MUST BE ZERO
	;4.7 USED INTERNALLY IN CODE (W RQ ON PDP-6)
	;4.3-4.1 = 0 GET PAGE FROM SELF
	;	= 1 GET ABSOLUTE PAGE
	;	= 2 GET PAGE FROM USER OPEN ON CH # 3.1-3.8
	;	= 3 GET PAGE FROM USER NUMBER 3.1-3.8
	;	= 4 GET PAGE
	;	= 5 GET PAGE (PUBLIC)
	;	= 6 MAKE PAGE PRIVATE
	;	= 7 MAKE PAGE PUBLIC
	;3.9=1 REQUEST WRITE PERMISSION (IGNORED ON FRESH PAGE, OTHERWISE VALID ONLY FOR
	;		SELF OR DIRECT INFERIOR OPEN ON CH OR PUBLIC PAGE)
	;3.1-3.8  USER NUMBER OR CH # (377 = CREATOR IF JOB DEVICE)
	;2.9=1 INSERT PAGE, 0 DELETE (IGNORES 4.3-4.1 EXCEPT FOR 6 OR 7 WHEN IT IS IGNORED)
	;2.1-2.8 VIRTUAL PAGE TO BE AFFECTED
	;1.1-1.9 BLOCK # IN ABSOLUTE OR OTHER USER (OR SELF IF 4.3-4.1 = 0)

CWORD1:	0		;USED BY .CBLK TO MANIPULATE DISPLAY SEGMENT
CURPG:	0		;SELECTED PIECE OF GLASS

UUOPDL==60
UUOPDP:	-UUOPDL,,UUOPDB-1;UUO LEVEL PUSH DOWN POINTER
UUOPDB:	BLOCK UUOPDL	;UUO LEVEL PUSH DOWN STACK

UUO40:	0
UUO41:	JSR UUOH
UUO42:	-TSINTL,,TSINT
UUOJPC:	0

UUOACS:	BLOCK HIGHAC-LOWAC+1	;USER ACS STORED HERE DURING UUO

UUOH:	0			;UUO PC STORED HERE
	.SUSET [.RJPC,,UUOJPC]
	JRST UUOH1

;INTERRUPT TABLE FOR CATCHING MPV'S WHEN LOOKING FOR THEM
MEMINT:	P
	%PIMPV ? 0 ? -1 ? -1 ? .+1
MEMINL==.-MEMINT
	SYSCLV DISMIS,[P ? MOVEI MEMHIT]

PRSVEX:	0		;-1 IF /PRSV SWITCH WAS EXPLICITLY SPEC'D
			;(AS OPPOSED TO TURNED ON BECAUSE A PROGRAM
			;NAMED LOADER OR LINK WAS RUN).
DEBUG:	-1		;-1 => SIMULATOR BEING DEBUGGED. ZEROED BY PURIFY.
OPTION:	0		;JOB'S OPTION BITS
JCLGOT:	0		;-1 => JCL HAS BEEN SNARFED AND HANDLED APPROPRIATELY.
TITROP:	0		;-1 => EXIT 1, KILLS THE JOB.
IIIRN:	0		;ATTEMPT TO GOBBLE DISPLAY AT RUN TIME IF SET
METARN:	0		;GIVER USER TTY META BITS IF SET
MAPRN:	0		;-1 => DO PHYSICAL MAPPING OF TV KBD TO SAIL KBD.
SYMSRN:	0		;PASS CLIENT'S SYMBOLS UP TO DDT
DBUGRN:	0		;GOES TO DDT BEFORE STARTING CLIENT, PASSES UP SYMBOLS
DECRN:	0		;0 => SIMULATE SAIL  -1 => SIMULATE DEC SYSTEM.
TTYRN:	0		;RUN WITHOUT THE TTY
FN2RN:	0		;-1 => ASSUME EXTENSION IN LOOKUP/ENTER/RENAME TAKES
			;A WHOLE WORD.  USED FOR PJ'S SEMI-CONVERTED PROGRAMS
			;THAT WANT TO BE ABLE TO WIN WITH I.T.S. FIE NAMES.
PRSVRN:	0		;-1 => EXIT 0, SHOULD REFRAIN FROM SUICIDE.
			;SET TO -1 BY RUNNING A PROGRAM NAMED LOADER OR LINK.

	subttl	TS Initiialization

COMMENT 

This is the startup code for DECUUO.  The purpose is look around at
JCL and our JNAME and open a disk file which will be a program (here after
called the CLIENT) filled with DEC TOPS-10 system calls.  The starting address
of the CLIENT is left at the top of stack. When ITSGO finally gets around to
returning with a POPJ; the CLIENT will start and everyone will be happy.

If the JNAME is one of the known programs (e.g. SAIL, FAIL, PUB, WL, D), various
switches which configure the UUO handler are set to the assembled in values.  If
the JNAME is not known, the JCL is scanned for a file name, and for switch
settings.

The switches of interest are IIIRN and METARN.  IIIRN will try to grab a display
and will simulate the SAIL III display system.  The currently available displays
include the 340, GT-40's and the TV's.  METARN will attempt to simulate the
effect of the control and meta keys of the TV keyboards, no matter what keyboard
you are near.

Good luck!


DDTBFL==80./5			;80 CHARACTERS OF STORAGE

STORAGE IMPURE

DDTCMD:	0			;COMMAND FROM DDT FLAG
DDTPTR:	0			;BYTE POINTER INTO DDT BUFFER
DDTEOF:	0			;SEEN END OF DDT BUFFER
DDTBUF:	BLOCK DDTBFL
DDTEND:	0			;FENCE POST FOR DDTBUF
MATCH:	0			;PARTIAL MATCH FLAG FOR SWITCH RECOGNIZER
EXACT:	0			;EXACT MATCH FLAG FOR SWITCH RECOGNIZER
JNAME:	0			;JOB NAME

;THIS IS THE TABLE OF KNOWN PROGRAMS TO LOAD

DEFINE CHECK(TAG,LEN)
IFN .-TAG-LEN,[PRINTX /TAG LOSES
/]
TERMIN

DEFINE FNAM(SNAME,FN1,FN2)
[ SIXBIT /FN1/ ? SIXBIT /FN2/ ? SIXBIT /SNAME/ ]TERMIN

STORAGE PURE

;ASEMBLE THE TABLE OF SWITCH NAMES, AND ASSIGN THE BITS TO THE SWITCHES.
SWTNAM:
IRPS X,,III META SYMS TTY DBUG DEC MAP SAIL SDIS FN2 PRSV
	010700,,[ASCIZ /X/]-1
X!BT==1_.IRPCN
TERMIN
NSWTS==.-SWTNAM

ONBITS==DECBT	;THE DEFAULTS FOR JCL SPECIFIED CLIENT

JNMTBL:	0			;HOLDS SPACE FOR JCL SPECIFIED CLIENT
	SIXBIT /D/
	SIXBIT /PC/
	SIXBIT /WL/
	SIXBIT /NODIPS/
	SIXBIT /DPLT/
	SIXBIT /PCPLT/
	SIXBIT /SAIL/
	SIXBIT /PUB/
JNMLEN==.-JNMTBL

OPNTBL:	0			;HOLDS SPACE FOR JCL SPECIFIED CLIENT
	FNAM(DRAW,D,BIN)
	FNAM(DRAW1,PC,BIN)
	FNAM(DRAW1,WL,BIN)
	FNAM(DRAW1,WL,NODIPS)
	FNAM(DRAW1,DPLT,BIN)
	FNAM(DRAW1,PCPLT,BIN)
	FNAM(SAIL,SAIL,BIN)
	FNAM(PUB,PUB,BIN)
CHECK OPNTBL,JNMLEN

STORAGE IMPURE

SWTTMP:	BLOCK NSWTS		;TEMPORARY AREA FOR SWITCH NAME RECOGIZER

BITTBL:	ONBITS			;HOLDS SPACE FOR JCL SPECIFIED CLIENT
	IIIBT\METABT\MAPBT	;III, AND META BITS FOR DRAWING PROGRAM
	IIIBT\METABT\MAPBT	;PC
	METABT			;NOIII BUT META BITS FOR WIRE LISTER
	METABT\SYMSBT		;NODIPS ALSO WANTS SYMBOLS LOADED WITH IT
	0			;DPLT
	0			;PCPLT
	0			;SAIL
	0			;PUB
CHECK BITTBL,JNMLEN

STORAGE PURE

;THIS IS DECUUO'S NORMAL STARTING ADDRESS.
GO:	TDZA D,D
;BOOTSTRAP ENTERS HERE
	 SKIPA D,[-1]
	SETZ 17,
	MOVE P,UUOPDP		;USE THE TTY BUFFER FOR A PUSH DOWN AREA
	HLRZ B,17
	SKIPE B			;IF BOOTSTRAPPER PROVIDED A FLAG-SETTING ROUTINE,
	 JSR (B)		;CALL IT.
	MOVE B,17
	PUSHJ P,DOBIT1		;PROCESS THE SWITCHES GIVEN BY THE BOOTSTRAP, IF ANY.
	HRRZM P,UUO40		;RIGHT NOW WE WANT UUOS TO BE ITS-HANDLED, NOT SIMULATED
	.SUSET [.RSNAM,,SNAME]
	.SUSET [.RUNAM,,UNAME]
	.SUSET [.RXUNAM,,XUNAME]
	.SUSET [.RXJNAM,,A]
	MOVEM A,JNAME
	MOVEM A,JOBNAM
	SYSCLV SSTATU,[MOVEM A ? MOVEM A ? MOVEM A ? MOVEM A ? MOVEM A ? MOVEM MNAME ? MOVEM ITSVER]
	.SUSET [.S40AD,,[UUO40]]
	.SUSET [.ROPTI,,A]
	TLO A,OPTDEC\OPTINT	;TRAP SYSTEM UUO'S AT UUO40
	MOVEM A,OPTION		;SAVE AWAY THE OPTION BITS
	.SUSET [.SOPTI,,A]
	MOVE A,APRBIT		;INIT .MASK.
	PUSHJ P,XAPRE1
	MOVEI A,1		;IF WE GO TO ILLUUO, LEAVE PC SET TO 0.
	MOVEM A,UUOH
	JUMPE D,GO3		;IF WE HAVE BEEN BOOTSTRAPPED IN, FIND OUT HOW
	PUSHJ P,JOBVAR		;MUCH CORE OUR PROGRAM HAS
	PUSHJ P,JOBVA1
	SETO D,
GO3:	SKIPN MEMT		;IF JUST LOADED, AND NOT BOOTSTRAPPED, DON'T LOOK AT
	 JRST GO2		;.JBSA BECAUSE THE CORE DOESN'T EXIST.
	SKIPE .JBSA		;IF WE ARE INCLUDED WITH A PROGRAM ALREADY,
	 JRST GO1		;AVOID FLUSHING IT.
GO2:	SKIPN OPNFN1		;IF WE'VE BEEN PATCHED WITH NAME OF FILE, USE IT.
	 PUSHJ P,SETOPN		;SET UP THE FILE TO OPEN
	PUSHJ P,ZAPCOR		;FLUSH ALL CORE BUT SIMULATOR AND 1K LOWSEG.
GO1:	MOVE A,PRSVRN
	MOVEM A,PRSVEX		;REMEMBER WHETHER /PRSV WAS EXPLICITLY SPEC'D.
	PUSHJ P,INITTY
	MOVE A,APRBIT		;INIT .MASK AND .MSK2 AGAIN, NOW THAT CLKENB
	PUSHJ P,XAPRE1		;HAS BEEN SET UP BY INITTY.
	SKIPE .JBSA		;IF INCLUDED WITH A PROGRAM IN CORE ALREADY,
	 JRST DDTGO		;NO NEED TO LOAD ONE.
	PUSHJ P,RUNI		;DO A RUN UUO TO LOAD IN THE PROGRAM.
	 CAIA
	  JRST DDTGO
	MOVEI A,1000		;IN CASE USER WANTS TO $X SOME STUFF, MAKE BUFFER RING
	HRLM A,.JBSA		;CREATION HAVE A PLACE TO ALLOCATE FROM.
	MOVEM A,.JBFF
	SKIPE OPNFN1		;OMIT ERROR MESSAGE IF FAILURE BECAUSE NO FILE WAS SPEC'D
	 PUSHJ P,XRUNE2		;RUN UUO FAILED => PRINT ERR MSG AND
	SETOM DBUGRN		;STOP IN DDT WITH PC=0.
	HLLZS .JBSA
	JRST DDTGO

; The sources for DECUUO live on MC:DECSYS;.
; They are DECUUO > (the main body) and DECBOT > (which, assembled separately,
; gives the mergeable bootstrap).

; An unPURIFY'd binary should exist on all machines as DECSYS;DECUUO BIN.
; The installed pure binary should be called DECSYS;TS DEC, linked to from SYS.
; In addition, on AI, the DRAWing system programs actually run DRAW;TS DECUUO
; which should point to the pure binary which has been installed for the
; DRAWing system (normally also DECSYS;TS DEC, but sometimes may be an older version).

; When a new version is installed, the old DECSYS;DECUUO BIN should be moved
; to BACKUP;DECUUO BINnnn where nnn is the version number.  The date of
; the new file should be set to that of the old.  Then, the old version's
; binary should be copied to DECSYS;DECUUO BIN, loaded, and  PURIFY'd with
; PURIFY$G.

; After assembling a new version of DECUUO, it should be loaded up and dumped
; back out with GAPFLS$G.  This will flush most of the wasted space,
; making loading the file much faster.  Page 0 is not flushed, since flushing
; it would disable breakpoint-proceed in DDT until the time DECUUO gets around
; to recreating that page.  PURIFY does flush the page, since otherwise
; booting in DECUUO would clobber page 0 of the program doing the booting.

; When DECUUO is patched, PDM$G should be used instead of :PDUMP alone.
; This will barf if the job to be dumped has been run significantly already.

;START HERE TO PURIFY.
PURIFY:	SKIPE MEMT
	 .LOSE
	MOVE P,UUOPDP
	SETZM DEBUG
TWO,[
	.VALUE [ASCIZ *B..BTAD/0
P*]
	MOVE C,[-CLEAN,,<PURE+1777>/2000]
	SYSCLV CORBLK,[MOVEI %CBRED ? 1000,,-1 ? C]
]
	MOVSI C,-AVAILP		;FLUSH ALL INBETWEEN PAGES LEFT BY LOADING
	PUSHJ P,ZAPLOW		;INCLUDING PG 0, ELSE WHEN BOOTING PAGE 0 WOULD BE LOST.
	.VALUE [ASCIZ /:pdump DECSYS;TS DEC/]


;START HERE TO MERELY FLUSH THE WASTED PAGES.
GAPFLS:	MOVE P,UUOPDP
	MOVE C,[1-AVAILP,,1]
	PUSHJ P,ZAPLOW
PDM:	SKIPE MEMT
	 .LOSE
	.VALUE [ASCIZ /:pdump/]

SETOPN:	MOVE B,JNAME
	MOVEI D,0		;HAVE TRIED LOPING DIGITS FLAG
SETOP1:	MOVSI A,-JNMLEN
	CAME B,JNMTBL(A)
	AOBJN A,.-1
	JUMPGE A,SIGH		;LOP OFF TRAILING DIGITS AND TRY AGAIN
	MOVS B,OPNTBL(A)
	HRRI B,OPNFN1		;BLT IN THE FILE NAME
	BLT B,OPNSNM
DOBITS:	MOVE B,BITTBL(A)
DOBIT1:	TRNE B,SDISBT
	 TRO B,SAILBT\METABT\MAPBT\IIIBT
	TRNE B,DECBT
	 SETOM DECRN
	TRNE B,SAILBT
	 SETZM DECRN
	TRNE B,IIIBT
	 SETOM IIIRN
	TRNE B,METABT
	 SETOM METARN
	TRNE B,MAPBT
	 SETOM MAPRN
	TRNE B,SYMSBT
	 SETOM SYMSRN
	TRNE B,TTYBT
	 SETOM TTYRN
	TRNE B,DBUGBT
	 SETOM DBUGRN
	TRNE B,FN2BT
	 SETOM FN2RN
	TRNE B,PRSVBT
	 SETOM PRSVRN
	POPJ P,

;HERE TO LOP OFF TRAILING DIGITS FROM THE JNAME TO TRY AGAIN

SIGH:	JUMPN D,JCLCMD		;AVOID INFINITE LOOPS
SIGH1:	MOVEI C,0
	ADDI D,6		;SHIFT 6 AT A TIME
	LSHC B,-6
	JUMPE C,SIGH2		;IF SPACE, THEN SHIFT AGAIN
	CAML C,[SIXBIT /0/]
	CAMLE C,[SIXBIT /9/]
	JRST [	LSHC B,(D)	;ITS NOT A DIGIT, TRY AGAIN
		JRST SETOP1]
SIGH2:	JUMPN B,SIGH1		;JUMP IF STILL MORE TO TRY

;HERE TO JCL COMMAND FOR CLIENT AND HIS SWITCHES

JCLCMD:	.LOGOUT			;IF WE ARE TOP LEVEL, . . .
	PUSHJ P,JCLGET		;SNARF OUR JCL INTO DDTBUF
	SKIPN A,DDTBUF		;IF NO JCL, LEAVE OPNFN1 ZERO, SO THAT
	 JRST DOBITS		;NO ATTEMPT TO LOAD A FILE WILL BE MADE.
	.BREAK 12,[SETZ [0](5)]
	SKIPE DDTBUF
	 SETOM JCLGOT
	MOVE A,[440700,,DDTBUF]
	MOVEM A,DDTPTR
	SETZM DDTEOF
	PUSHJ P,GETFIL		;PARSE THE FILE NAME
	 JFCL
	SKIPN A			;DEVICE
	MOVSI A,'DSK
	MOVEM A,OPNDEV
	MOVEM C,OPNFN1
	MOVEM D,OPNFN2
	MOVEM E,OPNSNM
	MOVEI A,ONBITS
	MOVEM A,BITTBL		;THE DEFAULT BITS
	MOVEI A,0		;INDEX FOR CLIENT'S BITS
SWLOOP:	JUMPLE B,DOBITS		;REMATURE END
	CAIN B,15
	JRST DOBITS		;GOT TO THE END
	CAIE B,"/		;IS THIS A SWITCH WHICH FOLLOWS
	JRST NOJCL		;UNKNOWN SWITCH, OR GARBAGE AT END OF COMMAND LINE
	PUSHJ P,RSWITCH		;PROCESS SWITCH
	JRST SWLOOP

NOJCL:	.VALUE [ASCIZ *:Bad JCL
2*]
	SETZM JCLGOT
	JRST GO

;HERE TO PROCESS A SWITCH

RSWITC:	MOVE B,[SWTNAM,,SWTTMP]	;GET SWITCH NAMES INTO TEMPORARY AREA
	BLT B,SWTTMP+NSWTS-1
	SETZB C,D		;ACCUMULATE DECIMAL IN D AND OCTAL IN C
	MOVEI E,1		;KEEP SIGN IN E
SWTARG:	PUSHJ P,NEXTC		;GET NEXT CHARACTER
	JUMPLE B,CPOPJ		;JUMPE IF END
	CAIN B,"-		;MINUS SIGN IS FINE
	JRST [	JUMPL E,CPOPJ		;DOUBLE MINUS IS A NO, NO
		MOVNI E,1		;PLUNK IN THE SIGN
		JRST SWTARG]
	CAIL B,"0		;TEST FOR DIGIT
	CAILE B,"9
	JRST NOTDIG
	IMULI C,10
	IMULI D,10.
	ADDI C,-"0(B)
	ADDI D,-"0(B)
	JRST SWTARG

JCLGET:	SETZM DDTBUF		;READ THE JCL (IF ANY) FROM DDT INTO DDTBUF
	.SUSET [.ROPTI,,C]
	TLNN C,OPTCMD
	 JRST CPOPJ		;CAN'T READ HIS MIND
	MOVE C,[DDTBUF,,DDTBUF+1]
	SETZM DDTBUF
	BLT C,DDTBUF+DDTBFL-1
	SETOM DDTEND		;DDT WILL NOT CLOBBER NON-ZERO WORD
	.BREAK 12,[5,,DDTBUF]	;READ THE JCL
	SETZM DDTEND		;GUARATEES THERE WILL BE A WELL DEFINED END
	POPJ P,

;HERE WHEN ARGUMENT TO SWITCH IS EATEN

NOTDIG:	JUMPE C,[	MOVE C,E	;RETURN "SIGN"
			MOVE D,E
			JRST SWTRED]	;GET NAME OF SWITCH
	IMUL C,E
	IMUL D,E
SWTRED:	PUSH P,C
	HRLM D,(P)		;DECIMAL,,OCTAL ON TOP OF STACK
	PUSHJ P,FNDSWT		;FIND THAT SWITCH
	JUMPGE C,NOJCL		;JUMP IF SWITCH NOT FOUND
	MOVEI D,1
	LSH D,(C)		;BIT POSITION OF FLAG
	POP P,E			;GET ARG OFF STACK
	SKIPL E
	IORM D,BITTBL		;HE WANTS BIT ON
	SKIPGE E
	ANDCAM D,BITTBL		;HE WANTS BIT OFF
	POPJ P,

FNDSWT:	MOVSI C,-<NSWTS>
	SETOM MATCH
	SETZM EXACT
	SKIPA			;WE ALREADY HAVE FIRST CHARACTER OF SWITCH
FNDSW2:	PUSHJ P,NEXTC
	JUMPLE B,FNDSW3		;END OF STRING?
	PUSHJ P,UPPER		;CONVERT TO UPPER CASE
	JRST FNDSW3		;    NON-SKIP RETURN FOR CAN'T CONVERT TO UPPER CASE
	PUSHJ P,FNDSRC		;SEARCH FOR THAT ONE
	JUMPL C,FNDSW2	
	POPJ P,			;NO MATCHES ON THAT CHARACTER

FNDSW3:	SKIPE MATCH		;WAS MATCH UNIQUE?
	MOVEI C,0		;    NOT UNIQUE
	SKIPE EXACT		;WELL, MAYBE IT WAS EXACT
	MOVE C,EXACT		;    FOUND EXACT MATCH
	POPJ P,

;HERE TO TEST NEXT CHARACTER IN STRING AGAINST BOARD NAMES

FNDSRC:	SETOM MATCH			;SEEN A MATCH FLAG
	SETZM EXACT			;EXACT MATCH FLAG
FNDS1:	SKIPG SWTTMP(C)			;IS THIS STRING EXHAUSTED?
	JRST FNDS2			;   YEP, ADVANCE TO NEXT NAME
	ILDB TT,SWTTMP(C)		;NEXT CHARACTER FROM TABLE
	SKIPE TT			;PERHAPS THIS IS LAST CHARACTER OF STRING
	CAME B,TT			;MATCH?
	JRST FNDS1A			;    YEP
	AOSN MATCH			;MATCH, TRIP MATCH FLAG
	PUSH P,C			;SAVE FIRST MATCH
	MOVE TT,SWTTMP(C)		;CHECK FOR EXACT MATCH
	ILDB TT,TT
	JUMPN TT,FNDS2			;JUMP IF NOT EXACT MATCH
	MOVEM C,EXACT			;YES, THAT IS AN EXACT MATCH
	SKIPA
FNDS1A:	SETOM SWTTMP(C)			;DOES NOT MATCH, ELIMINATE FROM CONSIDERATION
FNDS2:	AOBJN C,FNDS1			;INCREMENT ALL BYTE POINTERS YET?
	SKIPL MATCH			;ANY MATCHES?
	POP P,C				;   YES, THIS IS THE FIRST ONE
	POPJ P,

;TAKES CHARACTER IN B CONVERTS TO UPPER CASE TAKES NON-SKIP RETURN IF CHARACTER IS
;NOT ALPHABETIC

UPPER:	CAIL B,"0
	CAILE B,"Z
	SKIPA
	JRST POPJ1	;ITS UPPER CASE ALREADY
	CAIL B,"a
	CAILE B,"z
	POPJ P,		;ITS NOT ALPHABETIC
	SUBI B,"a-"A	;MAKE IT UPPER CASE
	JRST POPJ1

.BEGIN FNR
;its style command line scanner
;	non-skip return for null file spec
;clobbers acs with reckless abandon

break=b		;returns with character that broke scan
dev=a		;returns dev,fn1,fn2,sname
fn1=c
fn2=d
sname=e
ac=t
char=tt
acptr=12
limbo=13	;scanner read ahead character
		;cannot leave psname until zero

;filnam subroutines

getcc:	skipn break,limbo
	pushj p,nextc
	setzm limbo
	popj p,

.U"nextc:	movei break,0		;assume no more
	skipe ddteof
	popj p,
	ildb break,ddtptr
	jumpn break,cpopj
	setom ddteof
	popj p,

psname:	pushj p,getcc		;break off word from input stream
	caie break,40		;ignore leading spaces
	cain break,11		;tabs too
	jrst psname
	move acptr,[440600,,ac]
	tdza ac,ac
name1:	pushj p,getcc
	pushj p,brktst
	jrst nambrk		;found a break character
name2:	tlne acptr,770000	;ignore everything after 6 characters
	idpb char,acptr
	jrst name1

nambrk:	jumpn char,cpopj	;no trailing spaces
nambr1:	pushj p,getcc
	caie break,40		;ignore trailing spaces
	cain break,11
	jrst nambr1
	pushj p,brktst
	popj p,			;a break character
	movem break,limbo	;space broke us
	movei break,40
	popj p,

;converts break to sixbit and puts result in char
;^Q quotes next character
;fails to skip on break character

brktst:	cain break,11
	movei break,40
	pushj p,sixtst
	jumpl char,[	caie break,21		;^Q
			popj p,		;non-sixbit breaks us
			pushj p,getcc
			pushj p,sixtst
			jumpl char,cpopj	;non-sixbit
			jrst brkt1]
	jumpe char,cpopj
	caie char,':
	cain char,';
	popj p,
	cain char,'/
	popj p,
brkt1:	aos (p)
	popj p,

;convert break to sixbit

sixtst:	movni char,1
	cail break,40
	caile break,"_
	jrst sixt1	;might be lower case
	movei char,-40(break)
	popj p,
sixt1:	cail break,"a
	caile break,"z
	popj p,
	movei char,<"A-"a-40>(break)
	popj p,

;this routine scans command line for file specification

.U"getfil:setzb fn1,fn2
	setzb dev,sname
	setzm limbo
	pushj p,psname
	jumpe ac,cpopj
	aosa (p)
getf1:	pushj p,psname		;break off first name
	jumpe ac,cpopj		;let initl worry about it
	cain break,":
	jrst [	move dev,ac
		jrst getf1]
	cain break,";
	jrst [	move sname,ac
		jrst getf1]

;this must be fn1 or fn2

	caie break,40
	jrst [	jumpn fn1,[	move fn2,ac
				popj p,]
		move fn1,ac
		popj p,]
	jumpn fn1,[	move fn2,ac
			jrst getf1]
	move fn1,ac
	jrst getf1

.END FNR

;INITIALIZE THE TTY AND VARIABLES ASSOCIATED WITH IT.

INITTY:	SETOB M,DPYTYP		;ASSUME NO DPY
	SETZM TVDPY
	PUSHJ P,TTYIRS		;CLEAR INPUT BUFFER TO INIT INPUT.
	MOVE C,[HIBASE/2000-AVAILP,,HIBASE/2000]
	PUSHJ P,ZAPLOW		;FLUSH CORE USED FOR DISPLAY HANDLING (WE WILL GET AGAIN IF NEC)
IRPS X,,TTYICH TTYOCH DSPCH
	SKIPL A,X
	 SETZM CHOPN(A)
	SETOM X
TERMIN
INSIRP SETZM 0,SIXSW CLKENB DISPSW TVCORE TTYICB
	SETZB C,STKSW		;ASSUME NOT STK DEVICE UNTIL PROVEN OTHERWISE
	SKIPE TTYRN
	JRST NOTTY		;DON'T TRY TTY
	PUSHJ P,ALCHAN		;ELSE GET IN D A CHANNEL TO TRY.
	SYSCAL OPEN,[D ? 5000,,%TJDIS+.UAO ? ['TTY,,]]
	 JRST NOTTY		;OPEN FAILS, DON'T TRY IT
	MOVEM D,TTYOCH		;REMEMBER THE TTY OUTPUT CHANNEL
	SETOM CHOPN(D)
	PUSHJ P,ALCHAN		;AND GET AN INPUT CHANNEL
	MOVEM D,TTYICH
	SETOM CHOPN(D)
;HAVE A TTY; SEE WHAT KIND.
	.SUSET [.RTTY,,A]
	ANDI A,77
	MOVEM A,TTYNUM
	SYSCLV CNSGET,[	TTYOCH		;FOR TTY OPEN ON THIS CHANNEL
			2000,,TCMXH	;HORIZONTAL SCREEN SIZE
			2000,,TCMXV	;VERTICAL SCREEN SIZE
			2000,,TCTYPE	;TCTYPE
			2000,,TTYOPT	;TTYCOM (DISCARD)
			2000,,TTYOPT]		;TTYOPT
	SETOM TTYMTA
	MOVE A,TTYOPT
	TLNE A,%TOFCI		;TTYMTA GETS -1 IF TTY CAN SUPPLY CTL AND META BITS
	 SKIPN METARN		;AND THIS PROGRAM WANTS THEM.
	  SETZM TTYMTA
	MOVSI B,TT.NCC		;WE DON'T WANT CASE CONVERSION (BUT PROGRAM CAN CLEAR).
	SKIPE DECRN		;INITIALIZE TTYLCH.  TT.TAB IS ON FOR DEC, OFF FOR SAIL.
	 TLO B,TT.TAB
	TLNE A,%TOHDX		;TT.HDX AND TT.NEC SET FOR HALF-DUPLEX TERMINALS.
	 TLO B,TT.HDX\TT.NEC
	MOVEM B,TTYLCH
	TRNE A,%TP11T		;TV11 TERMINAL?
	 SETOM TVDPY		;LET D KNOW WE HAVE A TV
	JRST ITSG1

ITSG1:	MOVEI A,%TINWT\%TIINT	;OPEN MODE FOR NORMAL TTY - ASCII MODE FOR NOW.
	SKIPE TTYMTA
	 IORI A,%TIFUL		;HE CAN HAVE CONTROL AND META BITS DIRECTLY
	SYSCAL OPEN,[TTYICH ? ['TTY,,] ? 4000,,A]
	 .LOSE 1000
	PUSHJ P,TTYLM		;INITIALIZE TTY BREAK TABLE
	SETOM INBLNK		;MAKE SURE WE DON'T TRY TO BLINK ANYTHING
	JRST ITSGO0

;COME HERE TO RUN WITH NO TTY.
NOTTY:	SETZM TTYRN
	SETZM IIIRN
ITSGO0:	MOVEI B,1		;NOW SET UP TTYICB TO THE INT. BIT CORRESPONDING
	MOVE A,TTYICH		;TO THE CHANNEL IN TTYICH.
	LSH B,(A)
	MOVEM B,TTYICB
	MOVEI B,1
	MOVE A,TTYOCH		;SIMILAR FOR TTYOCH.
	LSH B,(A)
	MOVEM B,TTYOCB
	IOR B,TTYICB
	.SUSET [.SMSK2,,B]
	JRST ITSG2

TTYSET:	SYSCLV TTYSET,TTYOCH ? TTYST1 ? TTYST2 ? TTYSTS
	POPJ P,

;NOW, IF WE WANT TO TRY TO SIMULATE STANFORD DISPLAYS, SEE IF IT'S POSSIBLE
;AND BY WHAT METHOD, AND INITIALIZE FOR IT.

ITSG2:	SKIPN IIIRN		;ATTEMPT TO HACK THE DISPLAY?
	 JRST NODPY
	SYSCLV STATUS,[TTYICH ? MOVEM A]
	TRNN A,200000
	 JRST ITSGO3		;ISN'T NEAR THE 340
	SETOM SIXSW		;TRY TO GET THE PDP-6 FIRST
	.IOPUS SIXCH,
	SYSCAL OPEN,[	1000,,SIXCH
			5000,,7		;OPEN MODE
			['USR,,]
			UNAME
			[SIXBIT /PDP6/]]
	PUSHJ P,SIXNOT
	SKIPN SIXSW
	JRST ITSGO1		;WE DID NOT GET THE PDP-6, TRY GRABBING THE 340
	.RESET SIXCH,
	SYSCLV ACCESS,[MOVEI SIXCH ? MOVEI SIXORG]
	MOVE A,[-HIUSE,,SIXPRG]
	SYSCLV IOT,[1000,,SIXCH ? A]
	MOVE A,[2000+400+SIXCH,,HIBASE/2+400000]
	.CBLK A,
	 .LOSE
	MOVEM A,CWORD1
	SETZM SIXSW		;FORCE TYPE OUT ON TTY
	MOVEI A,[ASCIZ /
Start the PDP-6/]
	PUSHJ P,XOUTS0
	SETOM SIXSW
	MOVE A,[JRST SIXGO]
	MOVEM A,HIBASE+41
	.IOPOP SIXCH,
	JRST ITSGO2

ITSGO1:	.IOPOP SIXCH,
	PUSHJ P,ALCHAN
	MOVEM D,DSPCH
	SETOM DISPSW
	SYSCAL OPEN,[DSPCH ? ['DIS,,] ? 5000,,7]
	PUSHJ P,DSPNOT
	SKIPN DISPSW
	JRST NODPY		;WE DON'T HAVE THE DISPLAY
ITSGO2:	SETOM CLKENB		;ENABLE CLOCK INTERRUPTS FOR BLINKING
	SETZB M,DPYTYP		;WE HAVE A 340
	JRST GOTDPY

;DON'T HAVE 340; CHECK FOR TV OR IMLAC OR GT40.
ITSGO3:	SKIPE TVDPY
	JRST [	MOVEI M,DPYTV
		MOVEM M,DPYTYP
		SETOM CLKENB
					;FIRST WORD OF EXTRA PAGE IS CONSOLE REGISTER
		MOVE A,[-<TVPAGS+1>,,TVBUF/2000]
		MOVEI B,0
		SYSCLV CORBLK,[1000,,600000 ? 1000,,-1 ? A ? 1000,,-2 ? B]
		SETOM TVCORE
		JRST GOTDPY]
	MOVE B,TTYOPT
	MOVE A,TCTYPE		;IMLACS CAN SIMULATE GT-40'S (SIGH)
	TLNE B,%TOFCI		;if we have a meta keyboard, we are probably winning
	 JRST [	SETZM GTYPE
		CAIN A,%TNSFW	; SIMLAC? (DOUBLE SIGH)
		 SETOM GTYPE
		 JRST ITSGO4]
	CAIE A,%TNDP		;TRY TO CHECK FOR A GT40.
	 JRST NODPY
	TLNN B,%TOOVR		;WHICH IS THE ONLY OVERPRINTING DATAPOINT.
	 JRST NODPY
ITSGO4:	MOVEI M,DPYGT40
	MOVEM M,DPYTYP
	PUSHJ P,ALCHAN
	MOVEM D,DSPCH
	SYSCLV OPEN,[DSPCH ? ['TTY,,] ? 5000,,41]	; UNIT SUP. IMAGE FOR SIOT
	PUSHJ P,PPFRGT		; CLEAR GT40 OR IMLAC SCREEN
	MOVEI A,%TNIML		; IF IMLAC, SEND OUT INITIALIZING CTRL CHARS
	CAME A,TCTYPE
	JRST GOTDPY
	MOVE A,[ASCII //]	; ^A^K^D SET GT40 GRAPHICS
	MOVEM A,TYOBUF
	MOVEI A,5
	MOVEM A,DSPCNT
	MOVE A,[440700,,TYOBUF]
	PUSHJ P,DSPTYO			; ^A^N SET SAIL CHARACTER SET MODE
	JRST GOTDPY

GOTDPY:	MOVSI A,TT.III		;SET FOR THE DISPLAY
	IORM A,TTYLCH
	CAIA
NODPY:	 SETOM DSPCH
	SKIPL A,DSPCH
	 SETOM CHOPN(A)
	SKIPN IIIRN
	 JRST NODPY1
	SKIPN A,CWORD1
	MOVE A,[4000,,HIBASE/2+400000]	;INITIALIZE DISPLAY SEGMENT
	MOVEM A,CWORD1
	SKIPE SIXSW
	JRST .+3
	.CBLK A,
	 .LOSE
	MOVEI A,2000-HIUSE
	MOVEM A,DLBFL
	PUSHJ P,@PPFRSH(M)
	SETZM CURPP
	PUSHJ P,DLCLR
NODPY1:	SKIPE TTYRN
	 POPJ P,
	sysclv ttyget,[ttyoch ? movem a ? movem b ? movem c]
	tlo a,(%tgimg_36)	;output control chars im image mode
	ior b,[<%tgimg_22>#<%tgimg_14>#<%tgimg_6>];output cr, ro, alt in image mode.
	tlo c,%tsint		.see itsg3 ;int on next char
	movem a,ttyst1
	movem b,ttyst2
	movem c,ttysts		;the ttyset will be done there
	SKIPN IIIRN
	 JRST ITSG4
	MOVSI A,%TSMOR		;TURN OFF --MORE-- WHEN SIMULATING AN III.
	MOVE B,TTYOPT
	TLNE B,%TOSAI		;ALSO, USE SAIL CHAR SET IF TTY CAN HANDLE IT.
	 TLO A,%TSSAI
	IORM A,TTYSTS
ITSG4:	MOVEI A,IO.SUP
	IOR A,TTYLCH		;TURN ON IO.SUP TO PREVENT ECHOING,
	EXCH A,TTYLCH
	PUSHJ P,TTYSET		;SET UP OUR TTYSTS; ALSO READ IN ALL TYPE-AHEAD.
	MOVEM A,TTYLCH		;THEN RESTORE IO.SUP.
	MOVE A,[202020,,202020]	.SEE %TGPIE
	ANDCAM A,TTYST1		;NOW THAT ALL CHARS WILL INTERRUPT AND BE ECHOED
	ANDCAM A,TTYST2		;BY US, TURN OFF SYSTEM ECHOING.
	JRST TTYSET

;MAJOR RESET OF DISPLAY

DLCLR:	PUSHJ P,@DSTOP(M)	;MARK DISPLAY STOPPED FOR INTERRUPT ROUTINE
	SETOM PGBLNK		;INITIALIZE DISPLAY PROCESSOR
	SETOM INBLNK
	SETZM BLNKIT
	MOVEI A,HIBASE+HIUSE	;CLEAR DISPLAY SPACE
	MOVEM A,DLBFP
	MOVE D,DLBFL
	XCT BYTES(M)
	MOVEM D,DLBCNT
	MOVEM D,DLFBYT
	HRLI A,1(A)
	MOVS B,A
	SETZM (A)
	ADD A,DLBFL
	BLT B,-1(A)

	MOVEI A,DLLIST+1	;INITIALIZE 340 DISPLAY CHAIN
	MOVEI B,0
	MOVEM A,DLLIST(B)
	ADDI A,1
	CAIGE B,PGPPLN-2
	AOJA B,.-3
	SETZM DLMODE
	SETZM DLLIST+PGPPLN-1
	SETZM IIIPG		;PIECE OF GLASS MAP
	MOVE A,[IIIPG,,IIIPG+1]
	BLT A,IIIPG+PGLEN-1
	SETZM PGSG		;NO ENTRIES IN SORTED LIST
	PUSHJ P,@DPYCLR(M)
	SETZM IIIPC		;INITIALIZE III VARIABLES
	SETZM IIIX
	SETZM IIIY
	MOVEI A,7
	MOVEM A,IIIBRT
	SETZM IIISIZ
	SETZM IIIFLG
	AOS IIIFLG		;ALWAYS HAS 1.1 SET
	CAIE M,DPYTV
	JRST FLASH
	SETOM TVPURE		;DEBUGGING CHECK FOR RECURSIVE CALLS TO TVSIM
	SETZM TVBLNK
	MOVE A,[TVBLNK,,TVBLNK+1]
	BLT A,TVBLNK+PGLEN-1
	JRST TVCLR		;CLEAR SCREEN

DSPNOT:	SETZM DISPSW
	MOVEI A,[ASCIZ /
Display not available type "C" to continue without it */]
DSPN1:	PUSHJ P,XOUTS0
	PUSH P,A
	SOS -1(P)
	SOS -1(P)
	SKIPG ACTCHR
	 PUSHJ P,TIHANG
	PUSHJ P,GETCHA
	CAIE A,"C
	CAIN A,"c
	SKIPA
	JRST POPAJ
	AOS -1(P)
	AOS -1(P)
	JRST POPAJ

SIXNOT:	SETZM SIXSW
	MOVEI A,[ASCIZ /
PDP-6 not available, type "C" to continue without it */]
	JRST DSPN1

ZAPLOW:	SYSCLV CORBLK,[1000,,0 ? 1000,,-1 ? C]
	POPJ P,

ZAPRUN:	MOVSI C,-200		;IN RUNI, LOADING LOWSEG:
	SKIPN RUNLDH		;IF HISEG WAS JUST LOADED, DON'T FLUSH IT NOW.
ZAPCOR:	 MOVSI C,-HIBASE/2000
	PUSHJ P,ZAPLOW		;FLUSH ALL CORE
	SETZM MEMT
	PUSH P,A
	MOVEI A,400000
	SKIPN RUNLDH
	 MOVEM A,HMEMT
	MOVEI A,1777		;THEN GET 1K OF LOWSEG.
	PUSHJ P,XCORER
	 .LOSE
	PUSHJ P,INSBOT
	JRST POPAJ

IFN 0,[
;INITIALIZE THE DISPLAY PAGES IF NECESSARY

	SKIPN IIIRN
	POPJ P,			;GO AWAY IMMEDIATELY IF NO DISPLAY
	SKIPE DISPSW		;CHECK FOR 340
	MOVE A,[2400+SIXCH,,HIBASE/2+400000]
	SKIPE SIXSW		;GET FIRST PAGE OF DISPLAY STORAGE
	MOVE A,[4000,,HIBASE/2+400000]
	MOVEM A,CWORD1
	JUMPL A,CPOPJ		;SOMETHING OTHER THAN 340
	.CBLK A,
	 .LOSE
	POPJ P,
]

;GET HERE AFTER FINISHING UP IN ITSGO. POPJ'S OUT TO THE STARTING ADDRESS
;OF THE CLIENT PROGRAM.  IF DBUGRN IS SET, STOPS IN DDT BEFORE THE 1ST INSTRUCTION.
;$G WILL ALSO WORK FROM DDT

DDTGO:	HRRZ A,.JBSA
	MOVEM A,UUOH
	MOVE HIGHAC,[UUOACS,,LOWAC]
	BLT HIGHAC,HIGHAC
	SKIPE DBUGRN
	 .VALUE [ASCIZ /2/]
	SETZM UUO40
	JRST @UUOH

	subttl	Interrupt Routines

STORAGE(IMPURE)
MPVXIT:	0		;INTERRUPTING PC SAVED HERE WHEN DISMISSING VIA MPVBRK.
INTFLG:	0		;NONZERO => INTERRUPT IN PROGRESS.
INTLOS:	0		;.LOSE CODE FOR MPV OR PDL OV, USED IN ERROR HANDLING.
TSINT:	SETZ INTPDP(HIGHAC+1)
	-1 ? 0 ? #%PIPDL ? -1 ? PURINT ;ERROR AND CLOCK INTERRUPTS
	0			;TYPE-IN INTERRUPTS
TTYICB:	0
	#%PIPDL ? -1 ? TYIINT
	0			;BOTTOM OF PAGE INTERRUPTS
TTYOCB:	0
	#%PIPDL ? 0 ? MORINT
TSINTL==.-TSINT

DEFINE INTINI
	AOS INTFLG
	MOVE E,INTPDP
	SUBI E,HIGHAC+4	;E -> SAVED PC ON INT. STACK.
	MOVE P,[INT1PL,,INT1PL]
	ADD P,INTPDP
	EXCH P,INTPDP	;PUSH INT1PL WORDS ON INT STACK; P POINTS BELOW THEM.
	HRLI P,1-INT1PL	;MAKE P A PDL POINTER TO THOSE INT1PL WORDS.
	MOVE A,(E)
	MOVEM A,INTPC
	SKIPN A,-4(E)
	 MOVSI A,400000
	IOR A,-3(E)	;THIS CREATES AN OLD-STYLE "INTERRUPT BIT" WORD
	MOVEM A,INTBTS	;WHICH WINS SINCE NO GROUP HAS BOTH 1ST WD AND 2ND WD INTS.
	SKIPE TVCORE
	 PUSH P,TVCREG
	PUSH P,UUO40
	SETOM UUO40
	MOVE M,DPYTYP
TERMIN

;JUMP HERE TO RETURN FROM AN INTERRUPT.
INTRET:	SOS INTFLG	;CLEAR INTERRUPT IN PROGRESS FLAG
	POP P,UUO40
	SKIPE TVCORE
	 POP P,TVCREG
	MOVE A,[-<INT1PL,,INT1PL>]
	ADDM A,INTPDP
	SYSCLV DISMIS,[INTPDP ? 5000,,(SETZ (HIGHAC+1))]

STORAGE(PURE)
PURINT:	INTINI
	MOVE -4(E)		;GET THE BITS OF THIS INTERRUPT.
	SKIPE (P)		;IF INT. CAME FROM USER MODE, IS IT A
	 JRST TSINT1
	MOVE A,APRBIT		;USER-ENABLE APRENB INTERRUPT?
	SKIPN ZMPV
	 TRZ A,AP.ILM
	TDNN 0,A
	 JRST TSINT1
	SKIPN A,.JBAPR
	 .LOSE			;USER HAS NO HANDLER?
	MOVE B,0
	AND B,APRBIT		;TELL THE USER ABOUT ONLY THE BITS HE HAS ENABLED.
	TLZE B,%PJFOV
	 IORI B,AP.FOV		;MOVE ITS'S FLOATING OVFL BIT INTO DEC'S.
	MOVEM B,.JBCNI		;STORE HIS INT. BITS.
	EXCH A,(E)		;CHANGE HIS PC.
	MOVEM A,.JBTPC
	ANDCM APRBIT		;MARK INTS GIVEN TO USER AS HANDLED FOR OUR SAKE.
	MOVE B,APRBIT
	TRNE B,AP.REN		;IF THE USER DOESN'T WANT AUTO-RE-ENABLE,
	 JRST TSINT1
	SETZB A,APRBIT		;TURN OFF HIS INT. HANDLING.
	PUSHJ P,XAPRE1
TSINT1:	TRZE %PICLK
	 JRST CLKBRK
	TRZE %PIPDL
	 JRST PDLBRK
	TRZE %PIMPV
	 JRST MPVBRK
	JUMPE INTRET
	.LOSE

PDLBRK:	SKIPA C,[1+.LZ %PIPDL]
MPVBRK:	 MOVEI C,1+.LZ %PIMPV
	MOVEM C,INTLOS		;REMEMBER THE .LOSE ARG TO SIGNAL THIS INT. TO DDT.
	MOVE A,(E)
	HRRZ B,A		;IF PC IS AT 32, DDT IS HACKING BREAKPOINT PROCEED,
	CAIN B,31		;SO SAVE WHAT THE PC WAS REALLY SUPPOSED TO BE.
	 HRR A,32
	HRRI A,-1(A)
	MOVEM A,MPVXIT		;MPVXIT GETS REAL RETURN ADDRESS; RETURN TO
	MOVEI B,MPVBR3		;MPVBR3 FOR MPV'S OR PDL OV'S FROM SIMULATOR, OR TO
	SKIPN (P)
	 MOVEI B,MPVBR2		;MPVBR2 FOR MPV'S OR PDL OV'S FROM USER MODE.
	ANDI A,-1
	CAIE A,MPVOK1
	 CAIN A,MPVOK2		;MPV'S FROM THESE SPECIAL PLACES ARE SURE TO BE
	  MOVEI B,MPVBR5	;THE USER'S FAULT, SO SAY SO.
	CAIE A,MPVOK3
	 CAIN A,MPVOK4
	  MOVEI B,MPVBR5
	MOVEM B,(E)
	MOVEI A,[ASCIZ /Error in Simulator:/]
	CAIN B,MPVBR3
	 PUSHJ P,XOUTS0
	JRST TSINT1

MPVBR3:	JFCL			;THESE 2 TAGS MUSTN'T BE EQUAL, SO CAIN CAN DISTINGUISH.
MPVBR2:	SYSCAL LOSE,[INTLOS ? MPVXIT ? 5000,,4]
	 .LOSE
	JRST .-1

MPVBR5:	ERROUT Address Check

;HANDLE --MORE-- INTERRUPTS

MORINT:	INTINI
	SKIPE IIIRN
	 JRST INTRET
	PUSH P,TTYLCH
	MOVEI A,IO.FCS		;TEMPORARILY ENTER FULL CHAR SET MODE
	IORM A,TTYLCH		;SO WAY CAN GET HANDS ON THE RUBOUT.
	MOVEI A,[ASCIZ /--More--/]
	PUSHJ P,XOUTS0		;PRINT --MORE-- SAYING WE ARE SMART.
	SKIPG ACTCHR
	 PUSHJ P,TIHANG		;WAIT FOR AN INPUT CHARACTER
	POP P,TTYLCH
	MOVE A,GETBPT
	SKIPG GETCC
	 MOVE A,[1100,,TTYBUF-1]
	ILDB A,A		;LOOK AHEAD AT THE CHARACTER
	CAIN A,40
	 JRST MORPRC		;SPACE => PROCEED
	CAIN A,177
	 PUSHJ P,GETCHA		;RUBOUT SHOULD BE GOBBLED.
	MOVEI A,[ASCIZ /Flushed
/]
	PUSHJ P,XOUTS0		;ANY NON-SPACE MEANS FLUSH.
	MOVEI A,IO.FLS		;WHICH WE DO BY SILENCING TYPEOUT
	IORM A,TTYLCH
	MOVEI B,2
	HRRZ A,(E)		;IF THE PC IS POINTING AT THE TTY OUTPUT CALL,
	CAIE A,STYO
	 ADDM B,(E)		;SKIP OVER IT.
	JRST INTRET

MORPRC:	PUSHJ P,GETCHA		;GOBBLE THE SPACE.
	PUSHJ P,CRLF		;CONTINUE FROM --MORE--: JUST TYPE CRLF AND RETURN
	JRST INTRET

TYIINT:	INTINI
TYILOP:
TYINT:	PUSHJ P,TYI	;CHARACTER TYPED
	JUMPE A,TYILOP	;IGNORE NULLS
	JUMPL A,INTRET	;JUMP IF NO MORE CHARACTERS
	HRRZ B,(E)
	CAIN B,TIHAN1	;IF PROGRAM IS IN THE .IOT TYIC, USE AS A .HANG,
	 AOS (E)	;MAKE IT CONTINUE PAST.
	SKIPE MAPRN
	SKIPN IIIRN
	JRST NOMAP
	AOSE QUOTEF			;ARE WE GOING TO QUOTE THIS CHARACTER?
	MOVE B,TTYOPT
	TLNN B,%TOFCI		        ;META KEYBOARD?
	JRST NOMAP		        ;NO, SKIP MAPPING
	MOVE B,A
	ANDI B,177
	CAMN B,QUOTE
	JRST [	SETOM QUOTEF
		PUSHJ P,ECHO
		JRST TYILOP]
	HLRZ B,TTYMAP(B)
	SKIPE B				; (characters echo as mapped)
	DPB B,[700,,A]			; A "physical" mapping, for keyboard convenience
NOMAP:	SKIPE METARN
	 JRST NOMAP4
	CAIE A,^O
	 CAIN A,^S
	  JRST CTLO
NOMAP4:	PUSH P,TTYLCH
	MOVEI B,IO.FLS
	ANDCAB B,TTYLCH			;DURING ECHOING, IGNORE ^O (IO.FLS)
	TRNE B,IO.FCS
	 JRST NOMAP2
	CAIN A,177
	 JRST RUBOUT
	SKIPE METARN
	 JRST NOMAP2
	CAIN A,^U
	 JRST CTLU
NOMAP2:	PUSH P,A
	ANDI A,177
	CAIL A,"A+40			;CONVERT LOWER-CASE TO UPPER UNLESS INHIBITED.
	 CAILE A,"Z+40
	  JRST NOMAP3
	TLNN B,TT.NCC
	 TRZ A,40
NOMAP3:	SKIPE RIB			;IF WE HAD BEEN RUBBING OUT, PRINT A "\".
	PUSHJ P,RUBEND
	POP P,A
	PUSHJ P,ECHO
	SKIPN IIIRN			; map the TV chars into SAIL chars
	 JRST NOMAP1			; This is a "permanent" mapping,
	MOVE B,A			; not quotable, echos as typed
	ANDI B,177
	HRRZ B,TTYMAP(B)
	SKIPE B
	DPB B,[700,,A]
NOMAP1:	SKIPN TTYMTA			; ARE META BITS IN CHARACTER?
	 JRST [	SKIPN METARN
		JRST .+1		; HE'S NOT INTERESTED IN SIMULATING META BITS
		CAIN A,CTRL
		JRST TYCTRL
		CAIN A,META
		JRST TYMETA
		CAIN A,CTLMTA
		JRST TYCTLM
		JRST .+1]
	IORM A,CHAR
	TDZ A,[-1,,777600]
	CAIN A,15
	PUSHJ P,TYICR
	CAIN A,12
	MOVEM A,CHAR
	PUSHJ P,PUTCH
TYIXIT:	POP P,TTYLCH
	JRST TYILOP

; MAP TV11 KEYBOARD CHARACTERS INTO STANFORD CHARACTERS FOR D

;THERE ARE TWO REASONS FOR MAPPING CHARACTERS ON INPUT
;Renaming: Some of the codes for a given printing representation are different
;	on the TV keyboards. The codes are changed to the character code that
;	prints that way at Stanford. Therefore, these keys will have their
;	meaning to the Drawing program defined by the figure on the keytop.
;	This is what happens normally when using the Stanford keyboard
;	on the 340.
;	This mapping takes place whenever SAIL display programs are in use.

;Physically moving: Of the eight cursor moving characters, ()[] /\, seven
;	are physically displaced on the TV keyboard. For convenience, the
;	codes for []{}\/| are mapped so that they will mean ()[]/\ to the
;	Drawing program. Of course this is fine for cursor moving
;	commands, but other types of keyboard input (i.e., text on points)
;	will be mapped also. In this case, the user may type the quote character ()
;	to prevent the mapping.
;	In addition, caret (^) is mapped into + since there is no code
;	anyway in the Stanford set for caret and at best it would be
;	equivalent to uparrow. With this convention, drawing lines is easier.(??)
comment 
;These are the logical mappings, designed to preserve the visual semantics.
;The table makes more sense in 1FSSAIL$ mode!
Input from ITS KBD	code to SAIL program		(whose meaning in ITS is)
	 13 		136 				^
	 30 		137 				_
	 32 		 33 				<alt>
	136 ^		 (no such character)
	137 _		 30 _				
	175 }		176 }				~
	176 ~		032 ~				
;These are the "physical" mappings for convenience.
	 57 /		134 \				\
	133 [		 50 (				(
	134 \		 57 /				/
	135 ]		 51 )				)
	136 ^		 53 +				+
	173 {		133 [				[
	174 |		 17 				
	175 }		135 ]				]

TTYMAP:	LOC TTYMAP+13?	0,,136	; up-arrow
	LOC TTYMAP+30?	0,,137	; left-arrow
	LOC TTYMAP+32?	0,,33	; not-equal
	LOC TTYMAP+57?	134,,	;INTO BACKSLASH		*
	LOC TTYMAP+133?	50,,	;INTO OPEN-PAREN	*
	LOC TTYMAP+134?	57,,	;INTO SLASH		*
	LOC TTYMAP+135?	51,,	;INTO CLOSE-PAREN	*
	LOC TTYMAP+136?	53,,	;INTO PLUS		*
	LOC TTYMAP+137?	0,,30	; underbar
	LOC TTYMAP+173?	133,,	;INTO OPEN BRACKET	*
	LOC TTYMAP+174?	17,,	;INTO PARTIAL		*
	LOC TTYMAP+175?	135,,176;INTO CLOSE BRACKET	*
				; close-brace
	LOC TTYMAP+176?	0,,32	; tilde

	LOC TTYMAP+200

;HERE FOR HALF SECOND CLOCK --BLINK--

CLKBRK:	CAIE M,DPYTV
	 JRST CLKBR1
	SKIPL INBLNK		;BLINKING ENABLED??
	SOSL BLNTIM		;Throttle blinking if it is eating too much time
	 JRST TSINT1
	.RDTIM B,
	PUSH P,B
	MOVEI B,PGLEN-1
CLKBR3:	SKIPE IIIPG(B)		;BLINK ALL THE PGS MARKED
	SKIPN TVBLNK(B)
	 CAIA
	  PUSHJ P,TVSIM		;XOR THAT PG
CLKBR2:	SOJGE B,CLKBR3
	.RDTIM B,
	SUB B,(P)		;Time used for Blinking, 4 usec. units
	SUB P,[1,,1]
	ADDI B,4		;Round up
	ASH B,-3		;fair-ticks = time-used * 1/30sec/(50% * 1/2sec) = 2**-3
	SKIPGE B
	 SETZ B,
	MOVEM B,BLNTIM
	JRST TSINT1

CLKBR1:	SKIPE DLSTOP
	SKIPGE B,INBLNK
	JRST TSINT1	;NO BLINKING
	SKIPL C,PGBLNK
	CAILE C,17
	JRST TSINT1	;GARBAGE, MIGHT BE JUST BEFORE DPYOUT
	SKIPN IIIPG(C)
	JRST TSINT1	;PIECE OF GLASS NOT ACTIVE
	MOVEI A,DLPG(C)
	CAIL B,DLVIS
	CAILE B,DLVIS+PGLEN-1
	 .lose
	AOS D,TICKS
	TRNE D,1
	JRST BLANK	;BLANK THE BLINK
	HRLM A,(B)
	JRST TSINT1

BLANK:	HRRZS (B)
	JRST TSINT1

TYCTRL:	SKIPA B,[200]
TYMETA:	MOVEI B,400
TYCM:	IORM B,CHAR
	JRST TYIXIT

TYCTLM:	MOVEI B,600
	JRST TYCM

RUBOUT:	SKIPN RIB
	 SKIPE ACTCHR
	  CAIA
	   JRST TYIXIT
	SKIPN RIB
	 PUSHJ P,RUBEG
	SKIPE A,CHAR
	 PUSHJ P,RBMETA
	PUSHJ P,BACKUP
	MOVE B,TTYLCH
	TRNE B,IO.SUP
	 JRST TYIXIT
	JUMPE A,[	SETZM RIB
			SYSCLV IOT,[TTYOCH ? ["\]]
			PUSHJ P,CRLF
			JRST TYIXIT]
	TRNE A,600
	 PUSHJ P,RBMETA
	PUSHJ P,TYO
	JRST TYIXIT

TYI:	SYSCLV IOT,[TTYICH ? A]
	JUMPL A,CPOPJ
	ANDI A,777
	POPJ P,

RUBEND:	SETZM RIB
	JRST RUB1

RUBEG:	SETOM RIB
RUB1:	PUSH P,B
	MOVE B,TTYLCH
	TRNE B,IO.SUP		;SUPPRESS ECHOING SUPPRESSES RUBBINGOUT AS WELL.
	 JRST POPBJ
	POP P,B
	SKIPA A,["\]
TYO:	JUMPE A,CPOPJ
	PUSH P,A		; throw away other bits temporarily to avoid
	ANDI A,177		; I.T.S. hacking of meta bits on output
	CAIE A,177
	 PUSHJ P,TYOAND
	JRST POPAJ
TYOAND:
	JUMPGE M,@PPTYO(M)
	CAIN A,^P		; CHECK FOR ^P LOSSAGE
	 JRST [	PUSHJ P,STYO
		MOVEI A,"P
		JRST STYO]
STYO:	PUSH P,B
	MOVEI B,IO.FLS
	TDNE B,TTYLCH
	 JRST POPBJ
	SYSCLV IOT,[TTYOCH ? A]
	JRST POPBJ

CRLF:	MOVEI A,15
CRLF1:	PUSHJ P,TYO
	MOVEI A,12
	PUSHJ P,TYO
	MOVEI A,^M
	POPJ P,

RBMETA:	PUSH P,A
	SETZM CHAR
RBM3:	TRNE A,200
	TRNN A,400
	JRST RBM1
	MOVEI A,CTLMTA
RBM2:	PUSHJ P,TYO
POPAJ:	POP P,A
	POPJ P,

RBM1:	TRNE A,200
	SKIPA A,[CTRL]
	MOVEI A,META
	JRST RBM2

ECHO:	PUSH P,B
	MOVE B,[TT.NEC,,IO.SUP]
	SKIPE DECRN
	 CAIE A,33
	  TRNE A,600
	   TRO B,IO.TEC
	TDNE B,TTYLCH	;SEE IF APPROPRIATE FLAVOR OF NO-ECHO BITS ARE SET.
	 JRST POPBJ
	POP P,B
	CAIN A,^U
	 SKIPN DECRN
	  CAIA
	   POPJ P,
	CAIN A,15
	 JRST CRLF1
	TRNN A,600	;CHECK FOR EXTRA BITS
	 JRST [	jumpge m,tyo		;fix Drawing Program lossage
		sysclv iot,[ttyoch ? a ? 5000,,%tjech]
		popj p,]
	PUSH P,.-1	;POPJ TO TYO
	PUSH P,A
	JRST RBM3

TTYOFF:	SKIPN INTFLG
	.SUSET [.SPICL,,[0]]
	POPJ P,

TTYON:	SKIPN INTFLG
	.SUSET [.SPICL,,[-1]]
	POPJ P,

;^O => COMPLEMENT THE SUPPRESS-TYPEOUT FLAG.
CTLO:	PUSH P,TTYLCH
	MOVEI B,IO.FLS
	XORM B,(P)
	ANDCAM B,TTYLCH
	PUSHJ P,TYO
	PUSHJ P,CRLF
	JRST TYIXIT

;^U => CLEAR THE INPUT BUFFER.
CTLU:	PUSHJ P,TTYIRS
	MOVEI A,[ASCIZ /^U
/]
	PUSHJ P,XOUTS0
	JRST TYIXIT

;SKIP IF 9-BIT CHAR IN A ISN'T A BREAK CHARACTER.  CLOBBERS B, C, D.
BREAK:	MOVE B,TTYLCH
	TLNN B,TT.ACT	;SKIP IFF SPECIAL ACTIVATION MODE.
	 JRST BREAK1	;NO PROBLEM WITH DEC SYS SINCE TT.ACT IS VIRTUAL (SEE XGETLC)
	TRNN A,600
	 JRST BREAK2
	MOVE B,BRKTAB+3
	TRNN B,1	;UNLESS BIT 35 OF LAST BRKTAB WORD IS SET,
	 POPJ P,	;CHARS WITH CONTROL BITS ALWAYS ACTIVATE.
	CAIGE A,600
	 JRST BREAK2
	TRNE B,4	;BIT 33 => ALL CONTROL-META CHARACTERS ACTIVATE.
	 POPJ P,
BREAK2:	HRRZ B,A	;ELSE FIND BIT IN BRKTAB FOR THE BOTTOM 7 BITS THIS CHAR HAS.
	ANDI B,177
	IDIVI B,36.
	MOVNS C
	MOVSI D,400000
	LSH D,(C)
	TDNN D,BRKTAB(B)
	 AOS (P)
	POPJ P,

BREAK1:	TRNE A,600	;NORMALLY, ALL CONTROL AND META CHARACTERS ACTIVATE IN SAIL MODE
	 POPJ P,
	MOVE B,A
	ANDI B,177	;TEST FOR THE NORMAL (NOT SPECIAL ACTIVATION MODE) BREAK CHARS
	CAIE B,177	;WHICH DO NOT HAVE THE CONTROL BIT.
	 CAIN B,33
	  POPJ P,
	CAIN B,^J
	 POPJ P,
	SKIPE METARN	;WHEN META BITS IN USE, OTHER ACT. CHARS ARE REALLY CONTROLS
	 JRST POPJ1	;AND THE ASCII-CONTROLS ARE SAIL GRAPHICS, WHICH DON'T ACTIVATE.
	CAIE B,^C
	 CAIN B,^R
	  POPJ P,
	CAIE B,^G
	 CAIN B,^J
	  POPJ P,
	caie b,^L
	 cain b,^K
	  popj p,
	CAIE B,^U
	 CAIN B,^Z
	  POPJ P,
	JRST POPJ1

BACKUP:	SOSGE ACTCHR
	JRST [	SETZB A,ACTCHR
		POPJ P,]
	AOS A,PUTCC
	CAILE A,TTYBFL*TTYBPW
	PUSHJ P,BACKWP
	LDB A,PUTBPT
	LDB B,[360600,,PUTBPT]
	ADDI B,11
	CAIL B,44
	JRST [	SOS PUTBPT
		MOVEI B,0
		JRST .+1]
	DPB B,[360600,,PUTBPT]
	POPJ P,

BACKWP:	MOVEI A,1
	MOVEM A,PUTCC
	MOVE A,[1100,,TTYBUF+TTYBFL-1]
	MOVEM A,PUTBPT
	POPJ P,

TYICR:	MOVEM A,CHAR
	PUSHJ P,PUTCH
	MOVEI A,12
	POPJ P,

PUTCH:	AOSLE B,ACTCHR
	CAILE B,TTYBFL*TTYBPW
	 .LOSE
	SOSGE B,PUTCC
	PUSHJ P,PUTWRP
	MOVEI A,0
	EXCH A,CHAR
	PUSHJ P,BREAK	;SKIPS ON NON BREAK CHARACTER
	AOS ACTLIN
	IDPB A,PUTBPT
	POPJ P,

PUTWRP:	MOVEI A,TTYBFL*TTYBPW-1
	MOVEM A,PUTCC
	MOVE A,[1100,,TTYBUF-1]
	MOVEM A,PUTBPT
	POPJ P,

GETCHA:	SOSGE ACTCHR
	JRST [	SETZB A,ACTCHR
		POPJ P,]
	SOSGE GETCC
	PUSHJ P,GETWRP
	ILDB A,GETBPT
	PUSHJ P,BREAK
	SOS ACTLIN
	POPJ P,

GETWRP:	MOVEI A,TTYBFL*TTYBPW-1
	MOVEM A,GETCC
	MOVE A,[1100,,TTYBUF-1]
	MOVEM A,GETBPT
	POPJ P,

	subttl	UUO Dispatch Table and Routines

UUOLOW==40		;LOWEST LEGAL UUO CODE
IOTLOW==700		;LOWEST LEGAL IOT CODE
FIXOP==110		;OPCODE FOR "FIX" INSN

UUOH1:	MOVEM A,UUOACS+A-LOWAC
	LDB A,[POINT 9,UUO40,8]
	CAIN A,FIXOP		;SIMULATE STANFORD'S FIX INSN (IF DECRN,
	 JSP A,FIXUUO		;WILL COME BACK AND EVENTUALLY GET TO ILLUUO).
	MOVEM M,UUOACS+M-LOWAC
	MOVE M,[B,,UUOACS+B-LOWAC]
	BLT M,UUOACS+HIGHAC-LOWAC
	MOVE P,UUOPDP
	LDB B,[270400,,UUO40]
	MOVE M,DPYTYP
	SKIPGE UUO40
	 JRST IOTUUO		;AN IOT TRAPPED
	SUBI A,UUOLOW
	JUMPL A,ILLUUO
	CAIL A,UUOMAX
	 JRST UUOH2
IOTUU1:	XCT UUOTAB(A)
	 CAIA
UUOXSK:	  AOS UUOH
UUOXIT:	SETZM UUO40		;BEGIN SIMULATING UUOS AGAIN.
	MOVE HIGHAC,[UUOACS,,LOWAC]
	BLT HIGHAC,HIGHAC
	JRST 2,@UUOH

UUOH2:	HLRZ C,UUO40		;"PORTAL" SHOULD BE JUST A JUMP.
	CAIN C,(JRST 1,)
	 JRST [	HRRZ C,UUO40
		HRRM C,UUOH
		JRST UUOXIT]

;COME HERE WHEN USER DOES SOMETHING ILLEGAL UNDER DEC SYSTEM.
;RETURN TO DDT WITH AN ILOPR INTERRUPT, W/ PC -> USER'S UUO.
;WE DON'T SOS UUOH SINCE DDT WILL SOS THE PC AFTER RETUEN (BECAUSE OPTOPC=0).
ILLUUO:	.SUSET [.RJPC,,ERRJPC]
	MOVE HIGHAC,[UUOACS,,LOWAC]
	BLT HIGHAC,HIGHAC
	.VALUE [ASCIZ *2.PIRQC/%PIILO
P*]
	SETZM UUO40
	JRST 2,@UUOH

;COME HERE WHEN THE USER REQUESTS SOMETHING LEGITIMATE THAT WE CAN'T HANDLE.
;RETURN TO DDT WITH THE PC POINTING AT THE USER'S UUO.
MISSING:
	ERROUT Simulator Deficiency Encountered

IOTUUO:	SUBI A,IOTLOW	;HERE IF IOT TRAPS
	JUMPL A,ILLUUO
	caig a,iotmax
	 SKIPE DECRN	;SAIL'S IOT UUOS DON'T EXIST UNDER DEC SYSTEM
	  JRST ILLUUO
	ADDI A,IOTTAB-UUOTAB
	JRST IOTUU1

UUOTAB:	PUSHJ P,XCALL	; 40
	JRST XINIT	; 41
	JRST ILLUUO	; 42
	JRST ILLUUO	; 43
	JRST ILLUUO	; 44
	JRST ILLUUO	; 45
	JRST ILLUUO	; 46
	PUSHJ P,XCALLI	; 47
	PUSHJ P,XOPEN	; 50
	PUSHJ P,XTTYUU	; 51
	JRST ILLUUO	; 52
	JRST ILLUUO	; 53
	JRST ILLUUO	; 54
	PUSHJ P,XRENAM	; 55
	PUSHJ P,XIN	; 56
	PUSHJ P,XOUT	; 57
	PUSHJ P,XSTSTS	; 60
	JRST XSTATO	; 61
	PUSHJ P,XGTSTS	; 62
	JRST XSTATZ	; 63
	PUSHJ P,XINBUF	; 64
	PUSHJ P,XOUTBUF	; 65
	PUSHJ P,XINPUT	; 66
	PUSHJ P,XOUTPUT	; 67
	PUSHJ P,XCLOSE	; 70
	PUSHJ P,XRELEAS	; 71
	pushj p,xmtape	; 72 (MTAPE)
	JFCL		; 73 (UGETF)
	JRST XUSET	; 74
	JRST XUSET	; 75
	PUSHJ P,XLOOKUP	; 76
	PUSHJ P,XENTER	; 77
	JRST illuuo	; 100 (UJEN)
UUOMAX==.-UUOTAB

IOTTAB:	JRST ILLUUO	;700
	JRST .DPYCLR	;701
	JRST .PPIOT	;702
	JRST .UPGIOT	;703
REPEAT 710-704+1,JRST ILLUUO
	JRST XPTYUUO	;711
	JRST ILLUUO	;712
	JRST .UPGME	;713
	JRST .UPGMM	;714
	JRST .PGIOT	;715
IOTMAX==.-IOTTAB

STORAGE(IMPURE)
FIXAC:	0		;SAVE AC FIELD OF FIX INSN
STORAGE(PURE)

USAVEA==UUOACS-LOWAC+A
USAVEB==UUOACS-LOWAC+B
USAVEC==UUOACS-LOWAC+C
USAVED==UUOACS-LOWAC+D

;HANDLE STANFORD'S FIX INSTRUCTION. A ALREADY SAVED IN UUOACS BUT OTHER ACS UNSAVED.
;A HAS ADDR TO JUMP INTO UUOH1 AND FALL THROUGH TO ILLUUO IN CASE WE ARE
;NOT SIMULATING SAIL.
FIXUUO:	SKIPE DECRN
	 JRST (A)
	MOVEM B,USAVEB
	MOVEM C,USAVEC
	MOVEM D,USAVED
	SKIPL FIXINP		;TRY TO COMPILE THE INSN IF ALLOWED.
	 JRST FIXCMP
FIXCMX:	LDB B,[270400,,UUO40]
	MOVEM B,FIXAC
	MOVE A,USAVEA
	MOVE B,USAVEB
	MOVE A,@FIXAC
	MOVE C,A
	ASH C,8				;SHOVE OVER FRACTION TO LEFT EDGE
	MOVMS A
	LDB D,[111100,,UUO40]		; EXPONENT OF FIX INSTRUCTION
	LDB B,[331100,,A]		;EXPONENT OF NUMBER
	SUBI B,8(D)			; FIX SHIFT PLUS COMPENSATE FOR ASH BEFORE
	ASH C,(B)
	EXCH C,FIXAC
	MOVE D,USAVED
	MOVE B,USAVEB
	MOVE A,USAVEA
	SETZM UUO40
	CAIN C,C
	JRST [	MOVE C,FIXAC
		JRST 2,@UUOH]
	EXCH C,FIXAC
	MOVEM C,@FIXAC
	MOVE C,USAVEC
	JRST 2,@UUOH

FIXCMP:	HRRZ A,UUOH	;CAN'T COMPILE IF EXECUTED IN AN AC.
	CAIGE A,20
	 JRST FIXCMX
	MOVE A,-1(A)
	CAME A,UUO40	;CAN'T COMPILE IF INDEXED, INDIRECT, OR XCT'D.
	 JRST FIXCMX
	SETZ B,		;SEE IF WE'VE ALREADY HANDLED THIS INSN BEFORE
FIXCM0:	CAMN B,FIXINP	;(MUST HAVE SAME OPCODE, AC AND ADDRESS).
	 JRST FIXCM1	;NO - WE'VE CHECKED ALL INSNS SEEN BEFORE.
	CAME A,FIXINS(B)
	 AOJA B,FIXCM0
	ADD B,[XCT FIXXCT]	;YES! DO XCT OF A JSR TO FIXJSR, INSTEAD OF THE FIX INSN
	HRRZ A,UUOH
	MOVEM B,-1(A)
	JRST FIXCMX	;NOW GO AHEAD AND RUN THE FIX THIS TIME.

;HERE IF INSN HASN'T BEEN SEEN BEFORE
FIXCM1:	CAIL B,FIXINL	;NO ROOM IN TABLE => CAN'T COMPILE.
	 JRST FIXCMX
	MOVEM A,FIXINS(B)
	AOS FIXINP	;ELSE GOBBLE NEXT TABLE ENTRY FOR THIS INSN
	JRST FIXCM0	;AND PRETEND ENTRY WAS ALREADY THERE.

STORAGE IMPURE

IFNDEF FIXINL,FIXINL==10 ;# OF DIFFERENT INSNS WE CAN COMPILE.

FIXINP:	0		;POINTER TO FIRST UNUSED ENTRY IN FIXINS

FIXINS:	BLOCK FIXINL	;EACH DIFFERENT-LOOKING INSN WE COMPILE GETS AN ENTRY
			;IN THIS TABLE.

FIXJSR:	0
	JRST FIXJS1

STORAGE PURE

FIXJS1:	MOVEM A,USAVEA
	MOVEM B,USAVEB
	MOVEM C,USAVEC
	MOVEM D,USAVED
	MOVE A,FIXJSR
	MOVEM A,UUOH
	HRRZ A,-1(A)	;GET THE ADDRESS FIELD OF THE XCT INSN
	MOVE A,FIXINS-FIXXCT(A)	;GET THE CORRESPONDING INSN IN FIXINS
	MOVEM A,UUO40	;AND GO EXECUTE THAT INSN
	JRST FIXCMX	;WITHOUT TRYING TO COMPILE IT AGAIN!

FIXXCT:	REPEAT FIXINL,JSR FIXJSR
			;COMPILE INSN IS AN XCT OF SOME WORD IN FIXJSR.
			;FIXJSR USES THE PRECISE ADDRESS OF THE XCT TO SEE
			;WHICH INSN IN FIXINS SHOULD BE RUN.

;THESE ARE SOME OF THE STANFORD UUOS (INCLUDING ALL THE ONES WE SIMULATE).

IFN 0,[
DPYCLR=	701_33
]
PPIOT=	702_33
UPGIOT=	703_33
UINBF=	704_33
UOUTBF=	705_33
FBREAD=	706_33
FBWRT=	707_33
MAIL=	710_33
PTYUUO=	711_33
POINTS=	712_33
UPGMVE=	713_33
UPGMVM=	714_33
PGIOT=	715_33

IFN 0,[
PPSEL=	PPIOT 0,
PPACT=	PPIOT 1,
DPYPOS=	PPIOT 2,
DPYSIZ=	PPIOT 3,
PPREL=	PPIOT 4,
PGSEL=	PGIOT 0,
PGACT=	PGIOT 1,
PGCLR=	PGIOT 2,
DPYOUT=	UPGIOT
]

	subttl	TTY UUO Action Routines

;HANDLE SAIL'S TTYUUO OR DEC'S TTCALL.
XTTYUU:	HLRZ C,XTTYUT(B)
	SKIPN DECRN
	 HRRZ C,XTTYUT(B)
	JRST (C)

XTTYUT:	XINCW,,XINCW	; 0
	XOUTCH,,XOUTCH	; 1
	XINCS,,XINCS	; 2
	XOUTST,,XOUTST	; 3
	XINCWL,,XINCWL	; 4
	XINCSL,,XINCSL	; 5
	XGETLC,,XGETLC	; 6
	XSETLC,,XSETLC	; 7
	XRESCA,,XRESCA	;10
	XCLRBI,,XCLRBI	;11
	XCLRBO,,XCLRBO	;12
	XSKPIC,,XINSKI	;13
	XSKPIL,,XINWAI	;14
	XIONEO,,XSETAC	;15
	uuoxit,,MISSING	;16
	uuoxit,,MISSING	;17

DEFINE LINMOD FLAG
	MOVEI A,IO.FCS\IO.FLS
	ANDCAM A,TTYLCH
TERMIN

DEFINE CHRMOD
	MOVEI A,IO.FLS
	ANDCAM A,TTYLCH
	MOVEI A,IO.FCS
	IORM A,TTYLCH
TERMIN

XINCWL:	PUSHJ P,XINWAI	;4 (INCHWL)
	JRST XINCW1

XINCW:	CHRMOD		;0 (INCHRW)
	SKIPG ACTCHR
	 PUSHJ P,TIHANG
XINCW1:	PUSHJ P,GETCHA
	SKIPN METARN	;UNLESS SIMULATING META-BITS, ^C => RETURN TO HACTRN
	 CAIE A,^C
	  JRST UPUTA
	SOS UUOH	;WHICH IS DONE BY SOS'ING PC AND THEN EXIT 1,ING.
	JRST XEXIT1

XOUTCH:	PUSHJ P,UGETA	;1
	JUMPE A,CPOPJ
	JRST TYO

XINCSL:	LINMOD		;5 (INCHSL)
	SKIPG ACTLIN
	 POPJ P,
	JRST XINCS1

XINCS:	CHRMOD		;2 (INCHRS)
	SKIPG ACTCHR
	 POPJ P,	;NO CHARACTERS, NON-SKIP RETURN
XINCS1:	AOS (P)
	JRST XINCW1

XOUTST:	PUSHJ P,UGETAI	;3 (OUTSTR)
XOUTS0:	HRLI A,440700
	MOVE B,A
XOUTS1:	ILDB A,B
	JUMPE A,CPOPJ
	PUSHJ P,TYO
	JRST XOUTS1

XGETLC:	PUSHJ P,UGETA	;6 (GETLCH)
	JSP B,THSTTY
	HLLZ A,TTYLCH
	SKIPE RIB
	 TLO A,TT.RUB	;TT.RUB SAYS RUBBING OUT IS IN PROGRESS.
	SKIPE ACTLIN
	 SKIPN DECRN	;IN DEC MODE, TT.ACT IS 1 IFF ACTLIN > 0.
	  CAIA
	   TLO A,TT.ACT
	HRR A,TTYNUM
	SKIPE DECRN
	 TRO A,200000	;DEC WANTS THIS BIT WITH THE TTY NUMBER.
	SKIPE TTYRN
	 SETO A,
	JRST UPUTA

;JSP B,THSTTY TO COMPLAIN UNLESS C(A) SPECIFIES OUR TTY
THSTTY:	JUMPL A,(B)
	ANDI A,177777	;FLUSH THE IGNORED BITS.
	CAMN A,TTYNUM
	 JRST (B)
	JRST MISSING

XSETLC:	PUSHJ P,UGETA	;7 (SETLCH)
	MOVSI C,TT.SAI
	SKIPE DECRN	;GET A MASK TO THE BITS THAT CAN SUPPOSEDLY BE SET
	 MOVSI C,TT.DEC
	PUSHJ P,TTYOFF
	XOR A,TTYLCH	;WHICH BITS IS USER TRYING TO CHANGE?
	AND A,C		;FORGET ABOUT THOSE THE REAL SYSTEM WON'T LET HIM CHANGE.
	TLNE A,TT.LOS	;THESE ARE THE ESSENTIAL BITS THAT WE CAN'T HANDLE.
	 JRST MISSING
	XORM A,TTYLCH
	JRST TTYON

XCLRBI:	PUSHJ P,TTYOFF	;11 (CRLBFI)
	SYSCLV RESET,TTYICH
CLRBI1:	PUSHJ P,TTYIRS	;RESET THOSE POINTERS
TTYXIT:	PUSHJ P,TTYON
	JRST UUOXIT

XCLRBO:	SYSCLV RESET,TTYOCH	;12 (CLRBFO)
	JRST UUOXIT

XINSKI:	HRRE A,UUO40	;13 (INSKIP) SIGN OF ADDRESS DECIDES WHETHER
	JUMPGE A,XSKPIC	;TO TEST FOR 1 CHAR OR A LINE.
XSKPIL:	LINMOD		;14 (SKPINL)
	SKIPG ACTLIN
	 POPJ P,
	JRST POPJ1

XSKPIC:	CHRMOD		;13 (SKPINC OR INSKIP)
	SKIPG ACTCHR
	 POPJ P,
	JRST POPJ1

XINWAI:	LINMOD		;14 (INWAIT)
	SKIPG ACTLIN
	 PUSHJ P,TIHANG
	POPJ P,

XRESCA:	HRRZ B,UUO40	;10 (RESCAN)
	SETZB A,DDTBUF	;DDTBUF=0 => WE HAVEN'T GOT JCL FOR THIS RESCAN.
	SKIPN JCLGOT
	 PUSHJ P,JCLGET	;IF HAVEN'T ALREADY SNARFED OUR JCL, TRY TO SNARF IT.
	SKIPN DDTBUF	;IF SOME WAS SNARFED,
	 JRST XRESC1
	SKIPE DECRN
	 SETOM JCLGOT	;SAIL WILL LET YOU RE-RESCAN, BUT DEC WON'T.
	PUSHJ P,TTYOFF	;PREVENT TTY INTERRUPTS WHILE WE SIMULATE SOME.
	PUSH P,B
	PUSH P,PUTCC
	PUSH P,PUTBPT
	MOVE A,[440700,,DDTBUF]
	PUSH P,A
	SETZ C,
XRESC4:	ILDB B,A	;SCAN THROUGH THE JCL, COUNTING # CHARS IN C.
	CAIN B,^M
	 AOSA C
	  SKIPE B
	   AOJA C,XRESC4
	PUSH P,C	;PUSH # CHARS.
	MOVE B,GETBPT	;WE WANT TO PUT THOSE CHARS IN THE INPUT BUFFER BEFORE
	SKIPG A,GETCC
	 MOVE B,[1100,,TTYBUF+TTYBFL-1]
	ADD A,C		;THE CHARS ALREADY IN IT; GETCC AND GETBPT POINT AT WHERE THEY
	ROT C,-2
	SUBI B,(C)	;SHOULD STOP; FIND OUT WHERE THEY SHOULD START.
	ROT C,2
	ANDI C,3	;ESSENTIALLY SUBTRACT # CHARS FROM GETCC AND GETBPT, WRAPPING
	IMUL C,[110000,,]
	ADD B,C		;AROUND IF NECESSARY, TO GET PLACE TO START STORING
	SKIPGE B
	 SUB B,[440000,,1]
	CAIGE A,TTYBFL*TTYBPW
	 JRST XRESC3
	SUBI A,TTYBFL*TTYBPW
	ADDI B,TTYBFL
XRESC3:	MOVEM A,PUTCC	;WHICH IS PUT WHERE PUTCH LOOKS.
	MOVEM B,PUTBPT
	MOVEM A,GETCC	;INPUT WILL READ THESE CHARS BEFORE WHAT WAS ALREADY THERE.
	MOVEM B,GETBPT
XRESCL:	ILDB A,-1(P)	;THEN SCAN JCL AGAIN
	JUMPE A,XRESC2
	PUSHJ P,XRESCP	;GOBBLING EACH CHAR AS INPUT.
	LDB B,-1(P)
	MOVEI A,^J
	CAIN B,^M
	 PUSHJ P,XRESCP
	JRST XRESCL

XRESCP:	MOVEM A,CHAR	;STORE CHAR IN A IN TYPE-IN BUFFER, COUNTING # CHARS STORED.
	JRST PUTCH

XRESC2:	POP P,A
	SUB P,[1,,1]
	POP P,PUTBPT
	POP P,PUTCC
	POP P,B
	PUSHJ P,TTYON
XRESC1:	SKIPN DECRN
	 JUMPN B,UPUTA	;SAIL => STORE ZERO IN ADDRESSED WORD, UNLESS IT IS AC. 0.
	TRNE B,1	;DEC => IF USER WANTS SKIP ON FAILURE, GIVE IT TO HIM.
	 JUMPE A,POPJ1
	POPJ P,

;HERE TO HANG FOR TTY INPUT TO MAKE INTERRUPT DRIVEN PTY'S HAPPY
;(I.E. THE FRIENDLY PEOPLE AT DM)

TIHANG:	SOS (P)			;POINT RETURN PC AT "FLSINS"
	SOS (P)
	SKIPE STKSW
	JRST STKHNG
	PUSH P,A
TIHAN1:	SYSCAL IOT,[TTYICH ? 5000,,%TIPEK\%TINWT\%TIINT ? A]
	 JFCL
	XCT @-1(P)	;A TTY INT. HAPPENED; IS CONDITION TRUE NOW?
	 JRST TIHAN1	;NO, WAIT SOME MORE.
	POP P,A
STKHNG:	XCT @(P)	;STK MUST DO A HANG
	.HANG
	POPJ P,

XSETAC:	PUSHJ P,UGETA	;15 (SETBRK)
	TLNN A,-1
	 JRST XSETA1	;DOESN'T WANT TO SAVE OLD TABLE
	MOVE B,A
	MOVE C,A
	HRLI B,BRKTAB
	BLT B,3(C)
XSETA1:	TRNN A,-1
	 JRST UUOXIT	;DOESN'T WANT NEW TABLE
	PUSHJ P,TTYOFF
	MOVS B,A
	HRRI B,BRKTAB
	BLT B,BRKTAB+3
	JRST CLRBI1

XIONEO==xoutch		;IONEOU is an OUTCHR, because:
			;(1)	ITS does not have 8-bit OUTPUT
			;(2)	DECUUO does not have image mode
			;	to reset
			;(3)	For 7-bit output, the only difference
			;	between OUTCHR and IONEOU is that
			;	OUTCHR does not do nulls.  DECUUO's
			;	OUTCHR does, since it doesn't make
			;	any difference anyway, so there is
			;	no difference between the two.
			;	This may change if image mode is ever
			;	implemented!

;SET UP INITIAL SPECIAL ACTIVATION TABLE AND RESET INPUT.
TTYLM:	MOVE C,[[	777777,,777777
			777700,,037600
			000000,,374777
			000007,,600000],,BRKTAB]
	BLT C,BRKTAB+3
	POPJ P,

TTYIRS:	SETZM ACTLIN
	SETZM ACTCHR
	PUSH P,A
	MOVE A,GETCC
	MOVEM A,PUTCC
	MOVE A,GETBPT
	MOVEM A,PUTBPT
	SETZM RIB
	JRST POPAJ

XPTYUU:	PUSHJ P,UGETAI	;GETS EFFECTIVE ADDRESS OF UUO IN A
	SKIPE (A)
	 JRST MISSING	;ONLY ALLOW TO SELF
	JRST @.+1(B)	;DISPATCH ON ACFIELD
	MISSING	; 0 (PTYGET)
	MISSING	; 1 (PTYREL)
	XPTIFR	; 2 (PTIFRE)
	MISSING	; 3 (PTOCNT)
	UUOXIT	; 4 (PTRD1S)
	UUOXIT	; 5 (PTRD1W)
	XPTW1S	; 6 (PTWR1S)
	XPTW1W	; 7 (PTWR1W)
	UUOXIT	;10 (PTRDS)
	XPTWS7	;11 (PTWRS7)
	XPTWS9	;12 (PTWRS9)
	MISSING	;13 (PTGETL)
	MISSING	;14 (PTSETL)
	XPTLOA	;15 (PTLOAD)
	XPTJOB	;16 (PTJOBX)
	ILLUUO	;17

XPTIFR:	MOVEI C,TTYBFL*TTYBPW	;# CHARACTERS IN EMPTY BUFFER
	SUB C,ACTCHR
	PUSHJ P,UPUTC1
	JRST UUOXIT

PTYPUT:	PUSHJ P,UGETC1
	PUSHJ P,TTYOFF
	PUSH P,CHAR
	MOVEM C,CHAR		;CHARACTER TO PUT IN BUFFER
	PUSHJ P,PUTCH
PTPXIT:	POP P,CHAR
	JRST TTYON

XPTW1S:	PUSHJ P,PTYPUT
	JRST UUOXSK

XPTW1W:	PUSHJ P,PTYPUT
	JRST UUOXIT

XPTWS7:	PUSHJ P,UGETC1
	TLNN C,7777
	 HRLI C,440700	;MAKE IT INTO A BYTE POINTER
	PUSHJ P,PTWRSX
	JRST UUOXIT

PTWRSX:	PUSHJ P,TTYOFF
	PUSH P,CHAR
	PUSH P,C
PTWLOP:	ILDB A,(P)
	JUMPE A,[	SUB P,[1,,1]
			JRST PTPXIT]
	MOVEM A,CHAR
	PUSHJ P,PUTCH
	JRST PTWLOP

XPTWS9:	PUSHJ P,UGETC1
	TLNN C,7777
	 HRLI C,441100	;MAKE IT 9-BIT BYTE STRING
	PUSHJ P,PTWRSX
	JRST UUOXIT

XPTLOA:	SKIPN ZPTLOA
	 POPJ P,
	JRST MISSING

XPTJOB:	PUSHJ P,UGETC1	;COMMAND
	JUMPG C,[SOJA C,XPTJO1]
	MOVE A,C
	MOVSI C,-6
	CAME A,XPTJBN(C)
	 AOBJN C,.-1
	ANDI C,-1
XPTJO1:	CAIL C,6
	 JRST ILLUUO
	MOVEI D,IO.SUP
	XCT XPTJBT(C)
	 JRST UUOXIT
	JRST UUOXSK

XPTJBT:	JRST ILLUUO	;HALT
	AOSA UUOH	;CONT SKIPS TWICE
	IORM D,TTYLCH	;DOFF
	ANDCAM D,TTYLCH	;DON
	JRST MISSING	;LOGIN
	JFCL		;SKIP IF INPUT WAIT

XPTJBN:	SIXBIT/HALT/
	SIXBIT/CONT/
	SIXBIT/DOFF/
	SIXBIT/DON/
	SIXBIT/LOGIN/
	SIXBIT/IWAITS/

;AC MAPPING NON-SENSE

UGETAI:	MOVEI A,@UUO40
UGET1:	CAIL A,LOWAC
	 CAILE A,HIGHAC
	  POPJ P,
	ADDI A,UUOACS-LOWAC	;MAP THE ACS THAT UUOH SAVES.
	POPJ P,

UGET3:	PUSHJ P,UGET1
	JRST UGET2
UGETA:	PUSHJ P,UGETAI
MPVOK1::
UGET2:	MOVE A,(A)
	POPJ P,

UPUTA:	PUSH P,A
	PUSHJ P,UGETAI
MPVOK2::
UPUT1:	POP P,(A)
	POPJ P,

UGETAC:	LDB A,[270400,,UUO40]
UGETA1:	PUSHJ P,UGET1
	JRST UGET2

UPUTAC:	PUSH P,A
	LDB A,[270400,,UUO40]
	PUSHJ P,UGET1
	JRST UPUT1

UGETC1:	MOVEI A,@UUO40
UGETCI:	ADDI A,1
UGETC:	PUSH P,A
	PUSHJ P,UGET1
MPVOK3::
	MOVE C,(A)
	JRST POPAJ

UPUTC1:	MOVEI A,@UUO40
UPUTCI:	ADDI A,1
UPUTC:	PUSH P,A
	PUSHJ P,UGET1
MPVOK4::
	MOVEM C,(A)
	JRST POPAJ

	subttl	INIT and OPEN

;INIT SNARFS ITS ARGS FUNNY AND THEN DOES AN OPEN,
;AFTER WHICH THE PC IS INCREMENTED AN EXTRA 2 TIMES.

XINIT:	MOVE A,UUOH
	MOVEI A,-1(A)	;GET THE ADDR OF THE INIT
	CAIN A,BOTGO	;IF THIS INIT IS REALLY THE .OPEN AT THE BEGINNING OF DECBOT,
	 JRST DDTGO	;JUST START THE USER PROGRAM SINCE THE USER MUST HAVE TYPED $G.
	CAIE A,31
	 JRST XINIT1
	HRRZ A,32	;IF EXECUTED FROM 31, DDT IS HACKING PROCEED FROM BREAKPOINT,
	HRRM A,UUOH	;SO MAKE UUOH -> WHERE UUO IS SUPPOSED TO BE
	JRST XINIT	;SINCE THAT'S WHERE THE INIT'S ARGS REALLY ARE.

XINIT1:	HRRZ C,UUO40	;GET THE 1ST ARG, WITH ZEROS IN THE LH (UU.PHS, ETC)
	PUSHJ P,INIT0	;DO THE WORK, WITH AN EXTRA SKIP IF IT SUCCEEDS.
	 CAIA
	  AOS UUOH
	MOVEI A,2	;SKIP OVER THE ARGS
	ADDM A,UUOH
	JRST UUOXIT

XOPEN:	HRRZ A,UUO40
	PUSHJ P,UGETC	;DO PAY ATTENTION TO LH OF USER'S 1ST ARG FOR OPEN.
INIT0:	PUSH P,C	;SAVE 1ST ARG (I/O MODE)
	PUSHJ P,UGETCI	;GET DEVICE NAME
	PUSH P,C
	PUSHJ P,UGETCI	;GET IHDR,,OHDR.
	PUSH P,C
	SETZ A,
	SKIPE CHDEV(B)	;RELEAS ANY INITTED DEVICE ON THIS CHANNEL.
	 PUSHJ P,CHREL
	POP P,A		;HEADER ADDRS INTO A
	POP P,E		;DEVICE NAME INTO E
	POP P,C		;I/O MODE INTO C.
	SKIPN ZPHYS
	 TLZ C,(UU.DEL\UU.DER\UU.PHS)
	TDNE C,[UU.AIO\UU.DEL\UU.DER\UU.PHS]
	 JRST MISSING	;WE CAN'T DO ASYNCHRONOUS IO OR HACK ERROR LOGGING.
	MOVEM C,CHDMOD(B)
	ANDI C,17	;GET JUST THE BASIC IO MODE
	MOVE D,INITMT(C) ;WHAT I.T.S. MODES DOES THAT CORRESPOND TO?
	HRRZM D,CHOMOD(B)
	HLRZM D,CHIMOD(B)
	setzm chufdu(b)	;no ufd useti yet(sigh)
	SETZM CHLKEN(B)	;NO LOOKUP/ENTER DONE YET.
	JUMPE E,ILLUUO	;DEVICE IS 0?
INSIRP PUSH P,A B C E
	MOVE A,E		;DECODE THE DEVICE TO SEE IF IT EXISTS.
	PUSHJ P,DEVDCD
	 JRST [	SUB P,[4,,4]	;IT DOESN'T; THE UUO SHOULD FAIL.
		POPJ P,]
INSIRP POP P,E C
	EXCH B,(P)		;POP THE CHANNEL # AND STORE DEV NAME RETURNED
	POP P,CHRDEV(B)		;BY DEVDCD AS THE "REAL"" DEV NAME.
	POP P,A
	HLRZ D,E		;NOW WE MUST CONVERT "TTYnn" TO "Tnn"
	cain d,'mta
	 movsi e,'mt0
	CAIN D,'TTY		;BEFORE THE ACTUAL OPEN.
	 TRNN E,-1
	  JRST INIT3
	LSH E,14
	TLC E,<'T#'Y>_14	;SHIFT SO HAVE JUST Ynn, THEN CHANGE Y TO T.
INIT3:	MOVEM E,CHDEV(B)	;CHANNEL OFFICIALLY INITTED.
	HRRZM A,CHIHDR(B)	;SO WE CAN STORE THE HEADER ADDRESSES.
	HLRZM A,CHOHDR(B)
	CAIGE C,.IOIDP
	 JRST INIT1
	HRROS CHIHDR(B)	;DUMP MODE => SET SIGN BIT OF BOTH HEADER ADDRESS WORDS
	HRROS CHOHDR(B)
	JRST INIT2

INIT1:	HRL C,INITBT(C)	;BUFFERED MODE => GET APPROPRIATE BYTE SIZE
	CAMN E,['PLT,,]
	 HRLI C,700	;PLOTTER NEEDS 7-BIT BYTES.
IRPS X,,CHIHDR CHOHDR
	SKIPN D,X(B)
	 JRST .+11
	skipn decrn	;apparently only DEC system cares(?)
	 jrst .+4
	caile d,.jbpfi	;all I/O must be above .JBPFI
	 caml d,memt	;and below C(.JBREL)
	  jrst initck	;addr check
	SETZM (D)	;INITIALIZE BOTH BUFFER HEADERS.
	SETZM 2(D)
	HLLZM C,1(D)
TERMIN
INIT2:	MOVSI A,-DEVTLN
	MOVE C,CHRDEV(B)
	CAME C,DEVTAB(A) ;FIND THIS DEVICE IN DEVTAB, OR LEAVE A -> END OF DEVTAB.
	 AOBJN A,.-1
	MOVE C,CHDMOD(B)
	ANDI C,17	;NOW THAT WE KNOW WHICH DCHTAB WORD TO USE, SEE IF THIS DEV
	MOVEI D,1	;SUPPORTS THE SPECIFIED DATA MODE.
	LSH D,(C)
	TDNN D,DCHTAB(A)
	 JRST ILLMOD
	MOVEM A,CHDIDX(B) ;REMEMBER THE DEVTAB INDEX.
	HRRZ C,CHDMOD(B)
	TRNN A,-1	;ALL INITS & OPENS OF TTY SET TTYLCH'S RH TO I/O STATUS WORD.
	 HRRM A,TTYLCH
	SETZM CHNDLE(B)	;NOW SET CHNDLE UNLESS DEVICE IS MENTIONED IN DEVTAB.
	JUMPL A,POPJ1
	SETOM CHNDLE(B)
	JRST POPJ1

INITCK:	SETZM CHDEV(B)	;UNDO WHAT WE'VE DONE SO FAR SINCE OPEN ISN'T SUCCEEDING.
	SETZM CHRDEV(B)
	ERROUT Address Check in buffer headers

INITMT:	REPEAT 2,  .BAI,,.BAO
	REPEAT 16, .BII,,.BIO

INITBT:	REPEAT 3,  0700
	REPEAT 15, 4400

ILLMOD:	SETZM CHDEV(B)
	SETZM CHRDEV(B)
	SETZM CHIHDR(B)
	SETZM CHOHDR(B)
ILLMO1:	ERROUT Illegal or Unsimulated Data Mode

;TABLE OF KNOWN DEVICE NAMES.
;MUST INCLUDE ALL DEVICES THAT ARE NOT TO BE TREATED JUST LIKE DSK.
;TTY MUST COME FIRST.

DEVTAB:	'TTY,, ? 'MTA,, ? 'NUL,, ? 'PTR,, ? 'PTP,, ? 'DIS,, ? 'PLT,, ? 'LPT,, ? 'TPL,,
DEVTLN==.-DEVTAB

;DEVCHR WORD FOR A DEVICE, INDEXED BY CHDIDX (DEVTAB TABLE IDX).
;NOTE WE SAY ALL DEVICES ARE AVAILABLE AND ASSIGNED. THAT MIGHT BE FALSE FOR A FEW
;BUT THERE IS NO EASY WAY TO TELL.
;THERE IS AN EXTRA ENTRY AT THE END FOR ALL UNKNOWN DEVICES (INCL. DSK).
;FOR DEVS NOT IN DEVTAB, THE AOBJN POINTER, FULLY AOBJN'ED, POINTS THERE.
DCHTAB:	030053,,600003	;TTY
	000063,,574403	;MTA
	773777,,774403	;NUL
	000242,,404003	;PTR
	000441,,404003	;PTP
	000041,,400003	;DIS
	000041,,574403	;PLT
	040041,,400403	;LPT
	040041,,400403	;TPL
	201047,,774403	;DSK, AND ALL UNKNOWN DEVICES.
IFN .-DCHTAB-DEVTLN-1,.ERR WRONG TABLE LENGTH

;TABLE OF DEVTYP VALUES, EXCEPT FOR THE JOB # OF JOB ASSIGNED TO.
DTYTAB:	57,,3		;TTY
	47,,2		;MTA
	47,,		;NUL
	46,,4		;PTR
	45,,5		;PTP
	45,,61		;DIS
	45,,13		;PLT
	45,,7		;LPT
	61,,7		;TPL
	400043,,0	;DSK, ETC.
IFN .-DTYTAB-DEVTLN-1,.ERR WRONG TABLE LENGTH

;TABLE OF DEFAULT BUFFER SIZES, WHICH INCLUDE THE THREE OVERHEAD WORDS OF THE BUFFER.
DSZTAB:	23		;TTY
	203		;MTA
	203		;NUL
	43		;PTR
	43		;PTP
	43		;DIS
	43		;PLT
	37		;LPT
	37		;TPL
	203		;DSK, ETC.
IFN .-DSZTAB-DEVTLN-1,.ERR WRONG TABLE LENGTH

;table of devsts coni instructions
dsttab:	setz a,		;TTY
	coni 344,a	;MTA
	setz a,		;NUL
	coni 104,a	;PTR
	coni 100,a	;PTP
	coni 130,a	;DIS
	coni 140,a	;PLT
	coni 124,a	;LPT
	coni 124,a	;TPL
	coni 270,a	;DSK
ifn .-dsttab-devtln-1,.err Wrong Table Length

	subttl	LOOKUP and ENTER

XLOOKU:	SKIPA C,[CHBLKP,,CHBENT]
XENTER:	 MOVE C,[CHBENT,,CHBLKP]
	SKIPN CHDEV(B)
	 JRST IOUNAS
	SKIPN CHNDLE(B)
	 JRST POPJ1		;NON-DIRECTORY-DEVICE; ALWAYS SUCCEED.
	TSNE C,CHLKEN(B)	;TRYING TO DO BOTH DIRCETIONS =>
	 JRST XENTL1		;IT'S EITHER ILGL SEQUENCE OF UUOS, OR UPDATE (UNSUPPORTED)
	TRZ C,-1
	SETZ A,
	PUSH P,C
	PUSHJ P,[ JUMPL C,OCLS	;CLOSE THE SIDE OF THE CHANNEL THAT'S BEING HACKED.
		  JRST ICLS]
	POP P,C
	PUSHJ P,XENTD		;FETCH ARGS AND BEGIN DECODING THEM IN ENNAME, ETC.
				;ALSO D HAS THE EXTENSION.
IRPS X,,ENNAME ENEXTE ENSNAM ENOSNM ENSFD,Y,,CHNAME CHEXTE CHSNAM CHOSNM CHSFD
	MOVE A,X
	MOVEM A,Y(B)
TERMIN
	SKIPN E,CHNAME(B)
	 JRST XENTL3		;COMPLAIN TO PROGM IF FILENAME IS ILLEGAL.
	SKIPN FN2RN
	 ANDCMI D,-1
	CAMN E,[SIXBIT/-FILE-/]	;PROVIDE A WAY TO SPECIFY THE I.T.S. FILE DIRECTORIES:
	 MOVE E,['.FILE.]	;-FILE-. TURNS INTO .FILE. (DIR)
	CAMN E,['.FILE.]
	 MOVE D,[SIXBIT /(DIR)/]
	CAMN E,[SIXBIT/M-F-D-/]	;AND M-F-D-. TURNS INTO M.F.D. (FILE)
	 MOVE E,['M.F.D.]
	CAMN E,['M.F.D.]
	 MOVE D,[SIXBIT/(FILE)/]
	MOVEM D,CHEXTEN(B)
	PUSHJ P,[ JUMPL C,OOPEN	;NOW TRY TO ACTUALLY OPEN THIS SIDE OF CHANNEL.
		  JRST IOPEN]
	 JRST XENTL2		;FAILURE; E HAS I.T.S. ERROR CODE; GIVE USER THE DEC ERROR CODE.
	IORM C,CHLKEN(B)
	MOVS A,CHEXTE(B)
	CAIN A,'UFD
	 JRST XLUFD
	HRRZM P,CHOLKE(B)	;SAY WE HAD A SUCCESSFUL LOOKUP OR ENTER ON THIS CHANNEL.

;THE LOOKUP OR ENTER HAS WON, SO STORE BACK APPROPRIATE VALUES IN ARGUMENT BLOCK.
XENT2:	HRRZ A,UUO40
	PUSH P,C
	PUSHJ P,UGETC
	MOVE D,C
	POP P,C
	SKIPE DECRN
	TLNE D,-1
	 CAIA
	  JUMPN D,XENTY		;VALUES OF EXTENDED LOOKUP/ENTER STORED DIFFERENTLY.
	ADDI A,3		;MAKE A POINT AT PLACE TO STORE SIZE.
	JUMPL C,XENT1
	hlrz c,chexte(b)	; get extension
	cain c,'UFD		; a directory?
	 jrst [	move c,chname(b); get file name
		camn c,[1,,1]	; the MFD?
		 skipa c,[512.]	; never even this big
		  movei c,256.	; UFD's even smaller
		jrst xent2a]	; and be done with it
	SYSCAL FILLEN,CHIOPN(B) ? MOVEM C
	 SETZ C,		;FOR LOOKUP, GET LENGTH OF FILE
	CAIGE C,400000		;CONVERT TO EITHER NEGATIVE SIZE IN WORDS
	 MOVNS C
	CAIL C,400000
	 LSH C,-7		;OR POSITIVE SIZE IN BLOCKS
xent2a:	HRLZS C
	PUSHJ P,UPUTC
XENT1:	PUSHJ P,DATCNV		;GET .RBPRV IN C AND RB.CRX IN E.
	SUBI A,1
	PUSHJ P,UPUTC
	SUBI A,1
	PUSHJ P,UGETC		;NOW STORE RB.CRX IN WORD 1.
	HRR C,E
	PUSHJ P,UPUTC
	JRST POPJ1

;HANDLE ERROR-RETURNS FROM LOOKUP/ENTER/RENAME

XENTL1:	JUMPL C,MISSING		;ENTER AFTER LOOKUP MISSING.
XENTL5:	SKIPA D,[ERISU%]	;LOOKUP AFTER ENTER IS ERRONEOUS.
XENTL4:	 MOVEI D,ERSNF%		;COME HERE IF PATH CONTAINING SFD'S IS SPEC'D.
	JRST XENTL0

XENTL2:	MOVEI D,ERIPP%
	SKIPE CHSFD(B)
	 MOVEI D,ERSNF%
	CAIE E,%ENSDR
XENTL3:	 MOVEI D,ERFNF%
	JRST XENTL0

XENTL7:	SKIPA D,[ERLVL%]
XENTL6:	 MOVEI D,ERAEF%
XENTL0:	SETOM CHOLKE(B)		;SAY LAST LOOKUP/ENTER/RENAME ON THIS CHANNEL FAILED.
	HRRZ A,UUO40		;STORE THE ERROR CODE IN B.
	PUSHJ P,UGETC		;IT GOES IN ADDR+1 FOR ORDINARY LOOKUP,
	TLNN C,-1		;IN ADDR+.RBEXT FOR EXTENDED ONE.
	 ADDI A,.RBEXT-1
	PUSHJ P,UGETCI		;ADD 1 TO A, READ WORD POINTED AT.
	HRR C,D			;STICK ERROR CODE INTO RH AND WRITE BACK.
	PUSHJ P,UPUTC
	JRST UUOXIT

UNMON==270400	;BYTE FIELD FOR MONTH
UNDAY==220500	;BYTE FIELD FOR DAY
UNYRB==330700	;BYTE FIELD FOR YEAR
UNTIME==002200	;BYTE FIELD FOR # HALF SECONDS SINCE MIDNIGHT

;CONVERT AN ITS DISK FORMAT DATE/TIME TO DEC FORMAT.
;ALSO MERGE IN THE DATA MODE, TO GET (IN C) A WORD SUITABLE FOR .RBPRV.
;E'S RH HAS THE RB.CRX FIELD SET UP IN IT, FOR PUTTING IN .RBEXT
DATCNV:	MOVE C,CHIOPN(B)
	TDNE C,[-20]			;FIGURE OUT WHICH CHANNEL REALLY HAS FILE OPEN.
	 MOVE C,CHOOPN(B)
	SYSCAL RFDATE,c ? MOVEM E
	 SETZ E,
	LDB C,[UNYRB,,E]
	SUBI C,64.
	IMULI C,12.			;YEAR
	LDB D,[UNMON,,E]
	ADDI C,-1(D)
	IMULI C,31.			;MONTH
	LDB D,[UNDAY,,E]
	ADDI C,-1(D)			;DAY
	LDB D,[UNTIME,,E]
	IDIVI D,2*60.			;MINUTES SINCE MIDNIGHT
	LDB E,[140300,,C]		;GET THE TOP 3 BITS WHICH MUST GO IN .RBEXT
	LSH E,15.
	DPB D,[141300,,C]		;STORE THE TIME IN WITH THE DATE.	
	LDB D,[0400,,CHDMOD(B)]
	DPB D,[270400,,C]
	POPJ P,

;FETCH THE ARGS TO A RENAME, LOOKUP OR ENTER AND PARTIALLY TEST THEM FOR VALIDITY.
;RETURN WITH THE ARGS IN ENNAME, ENEXTE AND ENSNAM;  THE EXTENSION ALSO IN D.
;DOESN'T CLOBBER B OR C.

XENTD:	HRRZ A,UUO40
	PUSH P,C
	PUSHJ P,UGETC		;KEEP INCREMENTING A AND FETCHING, GETTING INTO C
	MOVE D,C
	SKIPN DECRN
	 JRST XENTD1
	TLNN D,-1		;IF 1ST ARG'S LH IS 0, WE HAVE AN EXTENDED CALL.
	 JUMPN D,XENTX		;EXTENDED LOOKUP/ENTER FETCHES ARGS DIFFERENTLY
XENTD1:	MOVEM D,ENNAME		;THE 4 ARGS: NAME, EXTENSION, PROT/MODE/DATE, SNAME.
	PUSHJ P,UGETCI
	MOVEM C,ENEXTE
	PUSHJ P,UGETCI
	MOVEM C,D
	PUSHJ P,UGETCI
	MOVEM C,ENSNAM
	POP P,C
;COME HERE WITH ENNAME, ENEXTE AND ENSNAM SET UP; D HAS .RBPRV OR EQUIVALENT.
XENT3:	JUMPGE C,XENT4
	SKIPN ZPROT		;FOR ENTER, COMPLAIN IF SETTING MISSING DATA.
	 TLZ D,777000		;ZPROT=0 => DON'T COMPLAIN IF SETS PROTECTION CODE.
	TLZ D,740		;NEVER COMPLAIN JUST BECAUSE DATA MODE FIELD IS NONZERO.
	SKIPN ZCRDAT		;ZCRDAT=0 => DON'T COMPLAIN ABOUT CREATION DATE
	 AND D,[-40,,]
	JUMPN D,MISSING
	HRRZ D,ENEXTE
	SKIPE FN2RN		;IF WE'RE HACKING FULL WORD EXTENSIONS, ITS NO ERROR
	 JRST XENT4		;IF RH IS NONZERO.
	SKIPE ZCRDAT		;COMPLAIN ABOUT SETTING ACCESS DATE UNLESS ZCRDAT=0.
	 JUMPN D,MISSING
	HLLZS ENEXTE		;IF NOT FN2SW, EVEN IF DON'T BARF AT RH, MUST IGNORE IT.
XENT4:	SETZM ENSFD		;INITIALLY ASSUME NO SFD SPEC'D.
	SKIPE D,ENSNAM
	 JRST XENT5
	MOVE D,SFD		;PATH DEFAULTED => USE DEFAULTS FOR SFD AND SNAME.
	TLNE C,CHBREN
	 MOVE D,CHSFD(B)	;FOR RENAME, DEFAULT IS PATH OF LOOKED-UP FILE.
	MOVEM D,ENSFD
	MOVE D,SNAME		;0 => USE THE DEFAULT.
	TLNE C,CHBREN
	 MOVE D,CHSNAM(B)
XENT5:	TLNN D,-1
	 JRST [	SKIPE E,3(D)	;PATHS SUPPORTED ONLY IF SPECIFY NO SFD'S.
		 PUSHJ P,XENT6	;PROCESS A PATH WHICH SPEC'S AN SFD.
		MOVE D,2(D)	;GET OUT THE SPEC'D UFD AND MAKE IT THE SNAME.
		JRST .+1]
	MOVEM D,ENSNAM
	SKIPE ENSFD		;USE SNAME=SFD IF SFD TO BE USED, ELSE USE SNAME=PPN.
	 MOVE D,ENSFD
	MOVEM D,ENOSNM
	SKIPN D,ENEXTEN		;I.T.S. DOESN'T ALLOW BLANK FN2, SO USE ">" INSTEAD.
	 MOVSI D,(SIXBIT/>/)
	CAME D,['UFD,,]
	 JRST XENTD2
	JUMPL C,XENTL3		;ERROR IF TRY TO WRITE A UFD OR RENAME A FILE INTO ONE.
	MOVE E,ENSNAM
	CAME E,[1,,1]
	 JRST XENTL3		;UFDS ARE FOUND ONLY ON 1,,1.
XENTD2:	CAMN D,['SFD,,]
	 JRST [	TLNN C,CHBLKP\CHBREN
		 JRST XENTL7	;CAN'T ENTER AN SFD,
		JRST XENTL3]	;AND NONE EXIST ALREADY. ALSO, ERROR TO RENAME TO SFD.
	POPJ P,

XENT6:	SKIPE ZSFDTRN		;BARF IF SFD => SNAME FEATURE OFF.
	 SKIPE 4(D)		;BARF AT NESTED SFD'S IN ANY CASE.
	  JRST XENTL4
	MOVEM E,ENSFD		;ELSE MARK SFD AS SPEC'D.
	POPJ P,

;DECODE ARGUMENTS OF EXTENDED LOOKUP/ENTER
XENTX:	POP P,C
	CAIGE A,.JBPFI
	 JRST MISSING
	CAIGE D,.RBEXT
	 JRST XENTL3	;TOO FEW ARGS.
	PUSH P,A
	ADDI A,-1(D)	;MAKE SURE GET MPV NOW IN ACCEPTIBLE PLACE
	PUSHJ P,UGET3	;IF WE ARE GOING TO GET ONE AT ALL.
	POP P,A
	JUMPG C,XENTX1
XENTX2:	SKIPN PRIVIL	;IGNORE PRIVILEGED ARGS FOR UNPRIVILEGED PROGRAM.
	 JRST XENTX1
IRPS X,,.RBMTA .RBSTS .RBAUT .RBNXT .RBPRD
	CAIGE D,X
	 JRST XENTX1
	SKIPE X(A)
	 JRST priv
TERMIN
XENTX1:	HRROI A,.RBEXT(A)	;NO UNHANDLEABLE ARGS: PROCESS THE IMPORTANT ONES.
	POP A,ENEXTE
	POP A,ENNAME
	POP A,ENSNAM
	MOVE D,.RBPRV(A)
	JRST XENT3	;GO DEFAULT THEM, ETC. AS FOR NORMAL LOOKUP/ENTER.

;STORE VALUES OF EXTENDED LOOKUP/ENTER
;A HAS ADDR OF ARG BLOCK, D HAS 1ST WORD (# OF FOLLOWING WORDS).
;B AND C HAVE CONTENTS AS OF XENTER/XLOOKUP.
XENTY:	HRRZI E,.RBVER+1(A)
	HRLI E,-1(E)	;FIRST, ZERO OUT ALL VALUES ASKED FOR
	PUSH P,A	;STARTING WITH .RBVER.
	ADD A,D
	SETZM -1(E)
	CAIL A,(E)
	 BLT E,(A)
	MOVE E,CHSNAM(B)
	MOVS A,CHRDEV(B)
	CAIN A,'SYS
	 MOVE E,['DECSYS]
	CAIN A,'COM
	 MOVE E,['COMMON]
	POP P,A
	SKIPN .RBPPN(A)	;WRITE BACK SNAME IF WASN'T SPEC'D.
	 MOVEM E,.RBPPN(A)
	CAIGE D,.RBSIZ	;RETURN SIZE IN .RBSIZ IF .RBSIZ IS THERE.
	 JRST XENTY1
	hlrz e,.rbext(a)	; get extension
	cain e,'UFD		; a UFD or MFD?
	 jrst [	move e,.rbnam(a); get the name
		camn e,[1,,1]	; is it the MFD?
		 skipa e,[512.]	; reasonable default for MFD I think
		  movei e,256.	;     "         "     "  UFD "   "
		movem e,.rbsiz(a); save it in RIB block
		jrst xenty1]	; and continue with date hackery
	SYSCAL FILLEN,CHIOPN(B) ? movem .RBSIZ(A)
	 SETZM .RBSIZ(A)
XENTY1:	PUSH P,D
	PUSHJ P,DATCNV		;CALCULATE .RBPRV AND RB.CRX
	POP P,D
	CAIL D,.RBPRV
	 MOVEM C,.RBPRV(A)
	HRRM E,.RBEXT(A)
	CAIGE D,.RBALC
	 JRST POPJ1
	MOVE E,.RBSIZ(A)
	trne e,177		;see if unfilled last block
	 addi e,200		;yes, count it too!
	LSH E,-7
	MOVEM E,.RBALC(A)
	CAIGE D,.RBDEV
	 JRST POPJ1
	movs e,chrdev(b)	;get device name
	caie e,'DSK
	 cain e,'SYS
	  movs e,mname		;moby translation for simulation of structures
	cain e,'COM
	 movs e,mname
	MOVSM E,.RBDEV(A)
	CAIGE D,.RBAUT
	 JRST POPJ1
	MOVE E,CHSNAM(B)
	MOVEM E,.RBAUT(A)
	CAIGE D,.RBTIM
	 JRST POPJ1
	SKIPE ZNDATE
	 JRST MISSING
	SETZM .RBTIM(A)
	JRST POPJ1

;COME HERE FROM IN/INPUT WHEN INPUT SIDE ISN'T FULLY OPENED.
IOPENX:	SKIPN CHDEV(B)		;CHANNEL NOT INITTED => ERROR MESSAGE.
	 JRST IOUNAS
	SKIPE CHNDLE(B)
	 JRST NOFILE		;GIVE UP IF DIRECTORY DEVICE.
	PUSHJ P,IOPEN		;ELSE TRY TO OPEN.
	 skipa e,[iopen,,ocls4]	; failed, try closing output
	POPJ P,			;ELSE CONTINUE WITH THE IN/INPUT.
mtarev:	move a,chdidx(b)	; get device index
	move a,dchtab(a)	; and do a DEVCHR on it
	tlnn a,(dv.dsk)		; kludge for NUL
	 tlnn a,(dv.mta)	; was it an MTA?
	  jrst wrndir		; no; probably wrong direction I/O
	pushj p,(e)		; close the other side
	movss e			; get address to try opening
	pushj p,(e)		; and try again
	 .lose			; strange lossage
	popj p,			; excelsior

;SIMILAR FOR OUT/OUTPUT.
OOPENX:	SKIPN CHDEV(B)
	 JRST IOUNAS
	SKIPE CHNDLE(B)
	 JRST NOFILE
	PUSHJ P,OOPEN
	 skipa e,[oopen,,icls3]	; failed, try closing input
	POPJ P,
	jrst mtarev		; reverse what magtape is doing
;OPEN THE INPUT SIDE OF CHANNEL IN B.  DON'T CLOBBER C.
;SKIP IF SUCCESSFUL, ELSE RETURN I.T.S. ERROR CODE IN E.
IOPEN:	PUSHJ P,IOPEN1		;DO THE OPEN
	 POPJ P,
	AOS (P)			;THEN GOBBLE UP A WORD TO FILL THE LOOK-AHEAD BUFFER "CHIWRD".
	HRRZ E,CHIOPN(B)	;(BUT TTY'S DON'T DO THAT)
	CAIN E,20
	 POPJ P,
	SETZ E,
	JRST XCTIN2

IOPEN1:	SKIPA A,[CHIOPN,,CHIMOD]
OOPEN:	 MOVE A,[CHOOPN,,CHOMOD]
	ADDI A,(B)		;GET ADDR OF MODE TO OPEN IN
	PUSH P,C
	MOVE E,CHRDEV(B)	;GET THE TRANSLATED DEV NAME TO FIGURE WHAT TYPE DEVICE.
	MOVE C,CHDEV(B)		;OPEN THE REAL DEV NAME, NOT TRANSLATED.  THE OPEN WILL TRANSLATE IT.
	MOVE D,['DECSYS]
	CAMN E,['SYS,,]		;TURN SYS: INTO DECSYS;
	 MOVEM D,CHOSNM(B)
	CAMN E,['SYS,,]
	 MOVSI C,'DSK		;DO THE ACTUAL OPEN ON DSK: INSTEAD OF SYS:
	movem c,chdev(b)
	MOVEI D,20
	CAMN E,['TTY,,]		;IF DEVICE IS TTY, JUST MARK SIDE AS OPEN ON CHANNEL 20.
	 JRST IOPEN3
	HRRZ D,B		;ELSE FIND AN I.T.S. CHANNEL TO OPEN ON.
	SKIPN CHOPN(D)		;FIRST TRY THE SAME # AS THAT OF THE DEC CHANNEL.
	 JRST IOPEN2
	PUSHJ P,ALCHAN
;D HAS THE I.T.S. CHANNEL TO USE FOR THIS SIDE.
IOPEN2:	MOVS E,CHEXTE(B)
	CAIN E,'UFD
	 JRST [	move e,chname(b)
		camn e,[1,,1]	;is it the MFD?
		 jrst [	syscal open,[d ? 5000,,.bii ? 3000,,e ? c
				     ['M.F.D.] ? [sixbit/(FILE)/]]
			 .lose 1000
			JRST IOPEN4]
		SYSCAL OPEN,[D ? 5000,,.BII ? 3000,,E
				c ? ['.FILE.] ? [SIXBIT /(DIR)/] ? CHNAME(B)]
		 JRST POPCJ
		JRST IOPEN4]
	SYSCAL OPEN,[D ? 4000,,(A) ? C ? CHNAME(B) ? CHEXTE(B) ? CHOSNM(B) ? 3000,,E]
	 JRST POPCJ
IOPEN4:	SETOM CHOPN(D)		;WE WIN! MARK I.T.S. CHANNEL AS IN USE
IOPEN3:	POP P,C
	HLRZS A
	ADDI A,(B)
	MOVEM D,(A)		;AND SAY THIS SIDE IS USING IT.
	JRST POPJ1

NOFILE:	MOVEI D,IO.IMP
	IORM D,CHDMOD(B)
	JRST UUOXIT

;FIND A FREE I.T.S. CHANNEL AND LEAVE NUMBER IN D.  SCAN FROM TOP DOWN TO AVOID USING
;I.T.S. CHANNELS CORRESPONDING TO DEC CHANNELS THE USER IS LIKELY TO USE.
ALCHAN:	MOVEI D,17
ALCHA1:	SKIPN CHOPN(D)
	 POPJ P,
	SOJGE D,ALCHA1
TMCH:	ERROUT Too many I/O channels in use
	
IOUNAS:	ERROUT I/O to Unassigned Channel

ADRCHK:	ERROUT Address Check in Buffer Ring Creation

WRNDIR:	SOS UUOH
	MOVE HIGHAC,[UUOACS,,LOWAC]
	BLT HIGHAC,HIGHAC
	SETZM UUO40
	SYSCLV LOSE,[[IOPEN2,,1000] ? UUOH]

POPCJ:	POP P,C
	POPJ P,

	subttl	CLOSE and RELEASE

XCLOSE:	HRRZ A,UUO40
	ANDI A,CL.IN\CL.OUT\CL.RST\CL.ACS
CHCLS:	PUSH P,A
	TRNN A,CL.OUT
	 PUSHJ P,OCLS
	POP P,A
	TRNE A,CL.IN
	 POPJ P,
ICLS:	MOVSI C,CHBLKP	;SAY LOOKUP HASN'T BEEN DONE THIS CH.
	ANDCAM C,CHLKEN(B)
	SETZM CHEOFC(B)	;CLOSING INPUT CLEARS THE EOF FLAG.
	MOVEI D,IO.EOF
	ANDCAM D,CHDMOD(B)
	MOVEI D,CHIHDR(B) ;GIVE ADDRESS OF HEADER SO CAN CLEAR THE BYTE COUNT.
	SKIPN CHNDLE(B)	;IF FILE-STRUCTURED DEVICE, CLOSE THE CHANNEL NOW.
	 JRST ICLS2
icls3:	SETO C,
	EXCH C,CHIOPN(B) ;SAY THIS CHANNEL'S INPUT SIDE IS CLOSED, GET I.T.S. CHNL #.
ICLS1:	ANDI C,-1
	CAIL C,20
	 JRST ICLS2	;I.T.S. CHANNEL 20 => DEVICE DOESN'T NEED AN I.T.S. CHANNEL.
			;-1 => THIS SIDE WAS CLOSED ALREADY.
	SYSCLV CLOSE,C
	SETZM CHOPN(C)
ICLS2:	SKIPLE C,(D)	;IF THERE'S A BUFFER HEADER,
	 SETZM 2(C)	;ZERO THE BYTE COUNT IN IT.
	SKIPN (C)
	 POPJ P,	;(DON'T SET BF.VBR IF NO BUFFERS IN HEADER)
	MOVSI D,(BF.VBR)
	SKIPLE C
	 IORM D,(C)	;MARK BUFFER AS RESTORED TO VIRGINITY.
	POPJ P,

OCLS:	SKIPGE CHOOPN(B)
	 JRST OCLS1
	TRNN A,CL.ACS
	 JRST OCLS3
	SYSCAL RESRDT,CHOOPN(B)
	 JFCL
OCLS3:	HRRZ C,CHOOPN(B)
	CAIGE C,20	;(IGNORE CL.RST ON TTY'S; ELSE IOPUSH WOULD FAIL).
	 TRNN A,CL.RST	;CL.RST SAYS DON'T REALLY CLOSE FILE IF AN OLD ONE EXISTS.
	  JRST OCLS2
	SYSCLV IOPUSH,CHOOPN(B)
	SYSCAL OPEN,[CHOOPN(B) ? CHDEV(B) ? CHNAME(B) ? CHEXTEN(B) ? CHSNAM(B) ? 4000,,CHIMOD(B)]
	 CAIA
	  TRO A,CL.LOS	;OPEN SUCCEEDED; SAY DON'T CLOBBER THE OLD FILE.
	SYSCLV IOPOP,CHOOPN(B)
OCLS2:	TRNE A,CL.LOS	;DON'T WANT TO REALLY WRITE THE FILE =>
	 SYSCAL RENMWO,[CHOOPN(B) ? ['_DECUU] ? [SIXBIT/>/]]
	  JFCL		;RENAME IT AWAY SO DON'T CLOBBER ANYTHING.
	TRNN A,CL.LOS
	 SKIPG A,CHOHDR(B) ;PICKUP CHANNEL HEADER POINTER
	  JRST OCLS1	;NO HEADER POINTER
	SKIPLE (A)	;NO OUTPUT FOR VIRGIN BUFFER
	 PUSHJ P,LASTO	;PUSH OUT THAT LAST LITTLE BIT
OCLS1:	MOVSI C,CHBENT
	ANDCAM C,CHLKEN(B)
	MOVEI D,CHOHDR(B)
	SKIPN CHNDLE(B)
	 JRST ICLS2
ocls4:	SETO C,
	EXCH C,CHOOPN(B)
	JRST ICLS1

;D -> THE CHIHDR OR CHOHDR WORD OF A CHANNEL.  FREE THE BUFFER HEADER.
RELBUF:	MOVE A,(D)
	JUMPLE A,RELBU1	;NO BUFFER HEADER
	MOVSI C,400000	;MARK BUFFER RING AS FREE
	SKIPE (A)	;SKIP IF BUFFER RING NEVER SET UP.
	 IORM C,(A)
RELBU1:	SETZM (D)	;SAY NO HEADER ADDRESS KNOWN THIS CHANNEL.
	POPJ P,

;RESDV. RESETS A SINGLE CHANNEL.  LIKE RELEAS, BUT THROWS AWAY ANY OUTPUT FILE.
XRESDV:	PUSHJ P,UGETAC
	MOVE B,A
	SKIPN CHDEV(B)
	 JRST XRETM1
	AOS (P)
	JRST CHRELI

XRELEA:	SKIPE DECRN
	 TDZA A,A	;DEC, RELEAS PRESERVES OUTPUT FILE.
	  HRRZ A,UUO40	;SAIL, CL.OUT => DISCARD OUTPUT FILE.
	ANDI A,CL.OUT
	TRZE A,CL.OUT
CHRELI:	 MOVEI A,CL.LOS	;RELEASE CHANNEL AND DISCARD OUTPUT FILE.
CHREL:	SETOM CHNDLE(B)	;MAKE SURE CHCLS CLOSES THE I.T.S. CHANNELS.
	PUSHJ P,CHCLS
	SETZM CHLKEN(B)	;CLEAR OUT AND FORGET ABOUT THE BUFFER HEADERS.
	MOVEI D,CHIHDR(B)
	PUSHJ P,RELBUF
	MOVEI D,CHOHDR(B)
	PUSHJ P,RELBUF
	SETZM CHDMOD(B)
	SETZM CHNDLE(B)
	SETZM CHDEV(B)
	SETZM CHRDEV(B)
	SETZM CHDIDX(B)
	SETZM CHOLKE(B)
	POPJ P,

XSTATO:	pushj p,xgtst1
	TDNN A,UUO40
	 JRST UUOXIT
	JRST UUOXSK

XSTATZ:	pushj p,xgtst1
	TDNE A,UUO40
	 JRST UUOXIT
	JRST UUOXSK

XGTSTS:	pushj p,xgtst1
	JRST UPUTA

xgtst1:	hrrz a,chdmod(b)	;get status word
	move c,chdidx(b)	;get device index
	move c,dchtab(c)	;now get it's chars
	tlnn c,(dv.dsk)		;kludge for NUL:
	 tlnn c,(dv.mta)	;is it an MTA?
	  popj p,		;no, return
	.suset [.roption,,c]	;read options
	tlz c,optdec
	.suset [.soption,,c]	;allow coni's
	consz 344,100000	;at load point?
	 tro a,io.bot		;set bot bit
	consz 344,4000		;at eot?
	 tro a,io.eot		;set eot bit
	consz 344,20000		;parity error?
	 tro a,io.dte		;set parity error bit
	consz 344,403620	;device error?
	 tro a,io.der		;set device error bit
	consz 344,40000		;illegal op.?
	 tro a,io.imp		;set improper i/o bit
	tlo c,optdec
	.suset [.soption,,c]	;back to dec mode
	popj p,			;and return

XSTSTS:	SKIPN CHDEV(B)
	 JRST IOUNAS
	HRRZ A,UUO40
	LDB C,[.BP 17,A]
	MOVEI D,1
	LSH D,(C)		;FIND DEVCHR BIT FOR THE DESIRED NEW MODE.
	HRRZ E,CHDIDX(B)
	TDNN D,DCHTAB(E)
	 JRST ILLMO1		;BARF IF MODE NOT SUPPORTED.
	SKIPN E			;STETSTS OF TTY SHOULD BE REMEMBERED SO WILL HAVE
	 HRRM A,TTYLCH		;DESIRED EFFECT ON ECHOING, ETC.
	HRRM A,CHDMOD(B)
	SETO A,
	CAIGE C,.IOIDP		;IS THE NEW MODE DUMP MODE?
	 SETZ A,		;IF SO, PROPAGATE IT INTO LH OF CHIHDR & CHOHDR TO
	HLLM A,CHIHDR(B)	;INFORM THE IN AND OUT ROUTINES.
	HLLM A,CHOHDR(B)
	POPJ P,

XRENAM:	SKIPN CHDEV(B)
	 JRST IOUNAS		;MUST HAVE DONE INIT OR OPEN.
	SKIPN CHNDLE(B)
	 JRST POPJ1		;ALWAYS SUCCEED ON NON-DIR-DEVS
	MOVE D,CHOLKE(B)
	JUMPE D,XENTL5		;BARF IF HASN'T DONE LOOKUP OR ENTER
	JUMPL D,XENTL3		;OR IF MOST RECENT ONE FAILED
	MOVSI C,CHBENT\CHBREN	;WE ARE SOMEWHAT LIKE AN ENTER, BUT REALLY A RENAME.
	PUSHJ P,XENTD		;GO FETCH ARGS, MOSTLY LIKE AN ENTER.
	MOVEM D,ENEXTE
	SKIPN ENNAME		;DETECT DELETES.
	 JRST XRENDL
	MOVE A,CHOSNM(B)
	CAME A,ENOSNM
	 JRST MISSING		;I.T.S. CAN'T RENAME FROM ONE DIR TO ANOTHER.
XREND1:	PUSH P,CHLKEN(B)
	SKIPE CHLKEN(B)		;IF FILE ISN'T OPEN, OPEN IT ON SOME CHANNEL SO THAT
	 JRST XRENA1
	PUSHJ P,IOPEN		;XENT2'S SYSTEM CALLS WILL SUCCEED.
	 JRST XENTL2		;CAN'T OPEN => RETURN ERROR TO USER.
XRENA1:	SKIPGE A,CHOOPN(B)
	 MOVE A,CHIOPN(B)	;GET IN A THE CHANNEL IT IS OPEN ON.
	SYSCAL RENMWO,[A ? ENNAME ? ENEXTE ? 3000,,E]
	 JRST XRENML
	SUB P,[1,,1]
	MOVE A,ENNAME		;COPY RENAME'S ARGS INTO NAMES OF OPEN FILE.
	MOVEM A,CHNAME(B)
	MOVE A,ENEXTE
	MOVEM A,CHEXTE(B)
	PUSHJ P,XENT2		;STORE FILE LENGTH, CR. DATE., ETC.
	 .lose
	SETZ A,
	PUSHJ P,CHCLS		;THEN CLOSE THE CHANNEL.
	JRST POPJ1

XRENML:	POP P,A
	SKIPN A
	 PUSHJ P,CHCLS		;RENAME LOST: CLOSE FILE IF WE HAD JUST OPENED IT NOW.
	CAIN E,%EEXFL
	 JRST XENTL6		;"FILE ALREADY EXISTS" HAS A SPECIAL ERROR CODE.
	JRST XENTL2

XRENDL:	MOVE A,[[SIXBIT /_DECUU/ ? SIXBIT /DELETE/],,ENNAME]
	BLT A,ENEXTE
	SKIPN CHLKEN(B)		;IF FILE IS OPEN, RENAME IT AS GARBAGE TO
	 JRST XREND2
	PUSHJ P,XREND1		;PREVENT DELETING THE WRONG THING.
	 .LOSE
XREND2:	SYSCAL DELETE,[CHDEV(B) ? CHNAME(B) ? CHEXTE(B) ? CHOSNM(B) ? 3000,,E]
	 JRST XENTL2
	JRST POPJ1

	subttl	Buffers and I/O Transfers

;CREATE AN INPUT BUFFER RING FOR CHANNEL IN B.
XINBU1:	SKIPE (A)		;IF ALREADY BUFFERS, INPUT SHOULDN'T MAKE NEW ONES.
	 POPJ P,
	SKIPA D,[2]		;D GETS # OF BUFFERS.
XINBUF:	 HRRZ D,UUO40
	SKIPN CHDEV(B)
	 JRST IOUNAS
	SKIPG A,CHIHDR(B)
	 JRST ADRCHK
	MOVSI E,400000		;SAY INPUTR BUFFERS ARE ALWAYS FULL OF DATA.
IOBUF1:	SKIPN D			;DEFAULT # OF BUFFERS IS 2, IN INBUF/OUTBUF
	 MOVEI D,2		;THAT DOESN'T SPECIFY.
	HRRZ C,CHDIDX(B)
	PUSH P,DSZTAB(C)	;PUSH THE BUFFER SIZE OF THIS DEVICE.
	MOVE C,D		;GET # BUFFERS TIMES TOTAL SIZE OF BUFFER.
	IMUL C,(P)
	ADD C,.JBFF		;GET START OF BUFFER, AND MOVE .JBFF UP OVER THEM.
	PUSH P,A
	PUSH P,B
	PUSH P,C		;IF MAKING THE BUFFERS WILL REQUIRE MORE CORE, GET IT.
	PUSH P,D
	PUSH P,E
	MOVE A,C
	CAMG A,MEMT
	 JRST IOBUF2
	SUBI A,1
	PUSHJ P,XCORER
	 JRST ADRCHK
IOBUF2:	POP P,E
	POP P,D
	POP P,C
	POP P,B
	MOVE A,(P)
	EXCH C,.JBFF		;C HAS ADDR OF START OF 1ST BUFFER.
	ADDI C,1
	HRLI C,(BF.VBR)		;MAKE HEADER POINT TO 1ST BUFFER, AND MARK RING FRESH.
	MOVEM C,(A)
	TSO E,-1(P)		;MERGE BUFFER SIZE IN WITH THE BUFFER-FULL-OF-DATA BIT.
	SUB E,[2,,]		;CONVERT TOTAL SIZE TO DATA AREA SIZE.
	SETZ A,			;INITIAL "PREVIOUS BUFFER'S ADDR" IS 0 SINCE NO PREVIOUS
IOBUF3:	MOVEM A,(C)		;MAKE THIS BUFFER POINT AT PREVIOUS.
	MOVE A,C		;THIS BUFFER BECOMES PREVIOUS
	HLL A,E			;(MERGE IN DESIRED LH FOR WD 1 OF NEXT BUFFER)
	ADD C,-1(P)		;C -> NEXT BUFFER.
	SOJG D,IOBUF3		;NEED MORE => REPEAT.
	EXCH A,(P)		;DONE => GET BACK ADDR OF HEADER
	MOVE C,(A)		;WHICH POINTS AT THE FIRST BUFFER.
	POP P,(C)		;MAKE IT POINT AT LAST BUFFER.
	SUB P,[1,,1]		;FLUSH SAVED BUFFER LENGTH
	MOVE C,CHDMOD(B)
	MOVSI D,(BF.IBC)
	TLNE C,(UU.IBC)		;COPY UU.IBC SPEC'D WHEN CHANNEL WAS OPENED
	 IORM D,(A)		;INTO BF.IBC OF BUFFER.
	POPJ P,

XOUTB1:	SKIPE (A)
	 POPJ P,
	SKIPA D,[2]
XOUTBU:	 HRRZ D,UUO40
	SKIPN CHDEV(B)
	 JRST IOUNAS
	SKIPG A,CHOHDR(B)
	 JRST ADRCHK
	SETZ E,
	JRST IOBUF1

;SPECIAL HACKS FOR TTY DEVICE IO

TTYO:	PUSH P,A
	PUSH P,B
	HRRZ B,(A)	;GET POINTER TO ILDB 1ST CHAR OF BUFFER.
	ADD B,[010700,,1]
	MOVE E,1(A)
	IBP E		;GET POINTER TO STOP BEFORE LDB'ING THROUGH.
TTYO1:	IBP B
	CAMN B,E
	 JRST POPBAJ
	LDB A,B
	PUSHJ P,TYO
	JRST TTYO1

POPBAJ:	POP P,B
	JRST POPAJ

TTYI:	PUSH P,A
	PUSH P,B
	HRRZ B,(A)
	ADD B,[010700,,1]
	PUSH P,B	;THIS WILL BECOME B.P. TO END OF BUFFER.
	PUSH P,B	;THIS IS B.P. TO STUFF INTO BUFFER THROUGH.
	HLRZ E,-1(B)
	TRZ E,400000
	SUBI E,1
	ADDM E,-1(P)
	PUSH P,[0]	;THIS IS # OF CHARS READ SO FAR.
	PUSH P,A
	PUSHJ P,XINWAI
	POP P,A
TTYI1:	SKIPG ACTCHR
	 PUSHJ P,TIHANG
	PUSHJ P,GETCHA
	AOS (P) 	;CHARACTER COUNT
	SKIPE METARN	;Only convert ^C to ^Z and non-insertion of ^Z in buffer
	 JRST TTYI4	;if a non-META-bit version
	CAIN A,^C	;^C AND ^Z BOTH MEAN EOF (ONE IS DEC STANDARD, ONE IS I.T.S.)
	 MOVEI A,^Z
	skipn decrn	;If a SAIL version, ...
	 caie a,^Z	; ... and ^Z, it is not put in the buffer
ttyi4:	  IDPB A,-1(P)
	skipn metarn
	 caie a,^Z
	  JRST TTYI3
	MOVE B,-3(P)	;EOF ISN'T PASSED TO PROGRAM; IT CAUSES NEXT INPUT TO FAIL.
	HLLOS CHEOFC(B)
	JRST TTYI2

TTYI3:	MOVE E,-1(P)
	CAMN E,-2(P)
	 JRST TTYI2	;FILLED THE WHOLE BUFFER => STOP.
	PUSHJ P,BREAK
	 CAIA 		;FOUND A BREAK => STOP
	  JRST TTYI1
TTYI2:	POP P,C
	SUB P,[2,,2]	;IGNORE BYTE POINTER AND END POINTER
	POP P,B
	POP P,A
	MOVEM C,2(A)	;BYTE COUNT INTO BUFFER HEADER
	MOVE D,(A)
	ADDI D,1
	HRLI D,010700
	MOVEM D,1(A)
	JRST UUOXIT	;WORKS FOR BOTH IN AND INPUTS


;"IN" UUO.
XIN:	SKIPL A,CHIHDR(B) ;IF NOT DUMP MODE, CREATE A BUFFER RING IF THERE ISN'T ONE.
	 PUSHJ P,XINBU1
	SKIPGE CHIOPN(B) ;IF INPUT SIDE NOT FULLY OPEN, FINISH OPENING IT.
	 PUSHJ P,IOPENX
	SKIPGE A,CHIHDR(B)
	 JRST UBFIN	;UNBUFFERED INPUT.
	JRST BLKIN	;BUFFERED INPUT.

XOUT:	SKIPL A,CHOHDR(B)
	 PUSHJ P,XOUTB1	;IF NOT DUMP MODE, CREATE BUFFERS IF NECESSARY.
	SKIPGE CHOOPN(B)
	 PUSHJ P,OOPENX	;IF OUTPUT SIDE ISN'T FULLY OPEN, FINISH OPENING IT.
	SKIPGE A,CHOHDR(B)
	 JRST UBFOUT	;UNBUFFERED IO
	SKIPGE (A)
	 JRST XOUT2	;NO OUTPUT FOR FRESH BUFFER
	PUSHJ P,XCTOUT
	 CAIA
	  AOS (P)
XOUT2:	PUSHJ P,CLRBUF
	MOVE D,(A)	;FOR OUTPUT, REGARDLESS OF # CHARS OUTPUT THE WHOLE OF THE
	HLRZ C,(D)	;NEW BUFFER IS AVAILABLE FOR MORE.
	TRZ C,400000
	SUBI C,1
	JRST BLKIO2

XINPUT:	PUSHJ P,XIN
	 POPJ P,
	POPJ P,

XOUTPUT:
	PUSHJ P,XOUT
	 POPJ P,
	POPJ P,

;A -> BUFFER HEADER;  ADVANCE TO NEXT BUFFER AND ZERO IT. ALSO STORE STATUS, ETC.
CLRBUF:	MOVE D,(A)		;GET CURRENT BUFFER ADDRESS.
	HRRZ C,UUO40		;DID USER SPECIFY NEXT BUFFER'S ADDRESS?
	SKIPN C
	 HRRZ C,(D)		;NO, GET IT FROM THIS BUFFER.
	HRRM C,(A)		;MARK IT NOW AS CURRENT BUFFER.
	HRRZ D,CHDMOD(B)
	MOVEM D,-1(C)		;STORE THE CHANNEL STATUS IN THE BUFFER.
	MOVSI D,(BF.VBR)
	ANDCAB D,(A)		;MARK RING AS HAVING HAD I/O DONE IN IT.
	TLNE D,(BF.IBC)		;THE RING CAN SAY
	 POPJ P,		;THAT THE BUFFER SHOULDN'T BE CLEARED.
	HLRZ D,(C)		;ELSE, ZERO OUT THE DATA AREA.
	TRZ D,400000		;BUFFER DATA AREA SIZE + 1.
	ADDI C,2		;START OF DATA AREA OF BUFFER.
	HRLI C,1(C)
	MOVSS C			;1ST DATA WORD,,2ND DATA WORD.
	SETZM -1(C)
	ADDI D,-2(C)		;ADDRESS OF 1ST WORD AFTER BUFFER.
	BLT C,-1(D)
	POPJ P,

;BUFFERED I/O ROUTINES

BLKIN:	PUSHJ P,CLRBUF	;ADVANCE AROUND RING AND ZERO THE BUFFER.
	SKIPE CHEOFC(B)
	 JRST BLKIO1	;AT EOF => READ NOTHING AND FAIL.
	PUSHJ P,XCTIN	;ELSE READ SOME STUFF
	move c,cheofc(b)	;kludge for simulated useti
	aoje c,blkio1		;on simulated ufd(ugh!)
	SUB E,D		;SUBTRACT POINTER BEFORE IOT FROM POINTER AFTER
	MOVEI C,(E)	;SO RH GETS # OF WORDS TRANSFERED.
	JUMPE C,BLKIO1	;GOT NO NEW WORDS GIVE EOF RETURN
BLKIO2:	LDB E,[300600+A,,1]
	MOVEI D,36.
	IDIV D,E	;NUMBER OF BYTES PER WORD FOR USER'S B.P. SIZE.
	IMUL C,D	;NUMBER OF BYTES IN BUFFER
	MOVEM C,2(A)	;INTO HEADER
	MOVE C,1(A)	;OLD BYTE POINTER
	TLZ C,770077
	HRRZ D,(A)
	HRRI C,1(D)
	MOVEM C,1(A)	;NEW BYTE POINTER
	POPJ P,

BLKIO1:	SETZM 2(A)		;ATTEMPTED BUFFERED INPUT AT EOF. UUO FAILS.
	SETOM CHEOFC(B)
	MOVEI D,IO.EOF
	IORM D,CHDMOD(B)
POPJ1:	AOS (P)			;ERROR RETURN
CPOPJ:	POPJ P,

;WRITE LAST OUTPUT BUFFER.  CALLED FROM OCLS.
LASTO:	MOVS E,CHRDEV(B)
	CAIN E,'TTY
	 JRST TTYO		;SPECIAL HACK FOR TTY
	HRRZ E,1(A)		;FIND ADDR OF LAST DATA WORD HACKED.
	MOVE D,CHDMOD(B)
	TRNN D,IO.UWC
	 JRST LASTO3
	HRRZ E,(A)		;IF IO.UWC IS SET, GET BUFFER BEGINNING
	ADD E,1(E)		;AND ADD IN THE USER'S WORD COUNT.
	MOVEI E,1(E)
LASTO3:	HRRZ D,(A)
	CAIN E,1(D)		;IF NO WORDS ARE IN THE BUFFER, IGNORE IT.
	 POPJ P,
	PUSH P,E
	MOVE D,CHIMOD(B)
	CAIE D,.BAI		;IF I.T.S. CHANNEL IN ASCII MODE,
	 JRST LASTO2		;REPLACE TRAILING ^@'S IN LAST WORD WITH ^C'S.
	HRLI E,010700		;GET PTR TO AFTER LAST WORD WRITTEN IN BUFFER.
LASTO1:	LDB D,E
	JUMPN D,LASTO2		;ALSO STOP AT NON-^@.
	MOVEI D,^C
	DPB D,E
	ADD E,[070000,,]
	JUMPGE E,LASTO1		;BACK THROUGH LAST WORD, STOPPING AT HIGH END.
LASTO2:	POP P,E			;THE LAST WORD THAT HE HACKED
	SUB E,(A)		;SUBTRACT OF ORIGIN OF BUFFER
	SOJE E,CPOPJ		;THIS BUFFER IS EMPTY
	MOVN D,E		;MAKE WORD COUNT NEGATIVE
	MOVS E,D
	HRR E,(A)		;AOBJN POINTER TO BUFFER
	ADDI E,2
	JRST XCTOU1

XCTIN:	MOVE E,CHIOPN(B)
	CAIN E,20
	 JRST TTYI		;SPECIAL HACK FOR TTY
	PUSHJ P,BUFAOB
;COME HERE WITH AOBJN IN E TO REGION TO BE READ INTO.
XCTIN1:	PUSH P,E
	HLRZ E,CHIOPN(B)
	CAIN E,1		;SPECIAL HACK FOR READING A UFD.
	 JRST [	POP P,E ? JRST UFDIN]
	POP P,E
	PUSH P,CHIWRD(B)
	POP P,(E)		;FIRST, SNARF THE BUFFERED-AHEAD WORD.
	AOBJP E,XCTIN2
	SYSCLV IOT,CHIOPN(B) ? E ;THEN, READ FROM FILE.
XCTIN2:	JUMPL E,XCTINE
	PUSH P,E		;IF WE MANAGE TO FILL THE BUFFER,
	HRROI E,CHIWRD(B)	;READ AHEAD 1 WORD AGAIN TO SEE IF WE ARE AT EOF.
	SYSCLV IOT,CHIOPN(B) ? E
	JUMPGE E,POPEJ
	POP P,E
XCTINE:	PUSH P,E		;WE HAVE JUST READ THE LAST WORD OF THE FILE.
	HLLOS CHEOFC(B)		;WE ARE AT EOF; MAKE SURE WE DON'T TRY TO READ ANY MORE
	PUSH P,D
	MOVE D,CHIMOD(B)	;IF THE I.T.S. CHANNEL IS OPEN IN ASCII MODE,
	CAIE D,.BAI
	 JRST POPDEJ
	HRLI E,010700		;CONVERT TRAILING ^C'S IN LAST WORD TO ^@'S.
	SUBI E,1
XCTIN3:	LDB D,E
	CAIE D,^C
	 JRST POPDEJ
	SETZ D,
	DPB D,E
	ADD E,[070000,,]	;BACK UP B.P.
	JUMPL E,POPDEJ		;BUT QUIT AFTER ROCESSING ONE WORD.
	JRST XCTIN3

POPDEJ:	POP P,D
POPEJ:	POP P,E
	POPJ P,

XCTOUT:	MOVS E,CHRDEV(B)
	CAIN E,'TTY
	 JRST TTYO		;SPECIAL HACK FOR TTY
	SKIPGE CHDIDX(B)
	 JRST LASTO		;FOR NON-DISK, OUTPUT ONLY THE FILLED PART OF BUFFER.
	PUSHJ P,BUFAOB
XCTOU1:	SYSCLV IOT,CHOOPN(B) ? E
	POPJ P,

BUFAOB:	MOVE E,(A)
	HLL E,(E)
	TLZ E,400000
	TLC E,-1
	ADD E,[2,,2]
	MOVE D,E
	POPJ P,

;UNBUFFERED IO ROUTINES

UBFOUT:	SKIPA C,[UBFOUZ]
UBFIN:	MOVEI C,CHEOFC(B)
	MOVEI D,@UUO40	;CHANNEL COMMAND PC
UBFIO1:	MOVE A,D
	PUSHJ P,UGET1
	SKIPL E,(A)
	JRST [	JUMPE E,CPOPJ	;END COMMAND LIST
		TLNE E,-1
		 .LOSE		;GARBAGE IN LEFT HALF
		MOVE D,E	;CHANNEL JUMP
		JRST UBFIO1]
	ADDI E,1	;WAS IOWRD, NOW IS AOBJN
	SKIPE (C)
	 JRST [	HRLOS (C)
		movei c,io.eof
		iorm c,chdmod(b)
		JRST POPJ1]	;TAKE ERROR EXIT, TRIED TO READ PAST EOF
	PUSHJ P,UBFIO2
	SKIPGE E		;IF DIDN'T FILLTHE BUFFER ON INPUT
	 SKIPN CHNDLE(B)	;FROM A DSK-LIKE DEVICE
	  AOJA D,UBFIO1
	push p,c		;ufd useti could have set eof
	move c,(c)		;so this losing routine
	aoje c,[pop p,c		;has to try and undo by losing
		movei c,io.eof
		iorm c,chdmod(b)
		jrst popj1]	;on input
	pop p,c			;***end of crock***
	HRRZ A,(A)		;IMPLEMENT THE CROCK THAT DSK ALWAYS XFERS 200 WDS
	ADDI A,200		;WHAT WOULD BE LAST WORD XREFED INTO?
	CAIGE A,(E)		;NOTE MORE THAN 1 RECORD MAY HAVE BEEN XFERRED.
	 JRST .-2		;SO FIND END OF LAST ONE THA WAS.
	SETZM (E)		;THEN ZERO OUT REST OF THAT RECORD.
	CAIE A,(E)
	 AOJA E,.-2
	AOJA D,UBFIO1

UBFOUZ:	0		;FOR UBFOUT, C -> THIS WORD, WHICH ALWAYS IS 0
			;SO OUTPUT NEVER THINKS IT'S AT EOF.

UBFIO2:	CAIE C,UBFOUZ	;ALSO, C IS USED TO TELL WHICH DIRECTION OF IOT TO DO.
	 JRST XCTIN1
	JRST XCTOU1

;A CHANNEL ON WHICH A SIMULATD DEC UFD IS OPEN HAS CHIOPN/  1,,<ITS CHANNEL>.
;ALSO, CHNDLE WILL BE -1 SINCE THE DEVCE IS CLEARLY A DIRECTORY DEVICE.
;CHOLKE WILL ALWAYS BE 0 TO PREVENT RENAMES.
;CHIWRD IS A BUFFERED-AHEAD WORD, UNLESS IT IS ZERO.
;THAT IS USED FOR BUFFERING BACK THE EXTENSIONS OF FILES.

;READ FROM A SIMULATED UFD INTO AOBJN IN E.
UFDIN:	PUSH P,A
	PUSH P,C
	HRRZ C,CHIOPN(B)
	push p,d
	skipn d,chufdu(b);was there a simulated useti?
	 jrst [	pop p,d	;no, no cretinous crockery needed
		jrst ufdin1]
	caig d,400	;ridiculous arg?
	 pushj p,ufdinw	;no, get a word
	  jrst [pop p,d	;ran out
		setom cheofc(b)
		jrst popcaj+1]
	sojg d,.-2	;and continue the crockery
	pop p,d		;don't forget to get d back!
UFDIN1:	PUSHJ P,UFDINW	;COMPUTE THE NEXT UFD WORD
	 JRST POPCAJ	;NO MORE?
	AOBJN E,UFDIN1	;LOOP TILL BUFFER FULL.
	aosa (P)
POPCAJ:	 hllos cheofc(b)
	POP P,C
	JRST POPAJ

;READ INTO (E) THE NEXT WORD OF A SIMULATED UFD OPEN ON CHANNEL IN B.
;SKIPS IF SUCCESSFUL;  ELSE THERE ARE NO MORE WORDS IN SIMULATED UFD.
UFDINW:	SKIPE A,CHIWRD(B)	;ABOUT TO READ A FILE'S EXTENSION => IT HAS ALREADY
	 JRST UFDINA	;BEEN READ AND PUT IN CHIWRD(B).
UFDIN2:	HRROI A,(E)
	PUSHJ P,UFDRD1	;ELSE READ NEXT I.T.S. FILE'S NAME
	JUMPL A,UFDINE	;END OF I.T.S. UFD => NON-SKIP RETURN.
	HRROI A,CHIWRD(B)
	PUSHJ P,UFDRD1	;AND FN2.

; This kludge assumes that each second word of MFD entry is zero -- may
; cause problems if ITS is changed.

	skipn chiwrd(b)	;kludge for MFD
	 jrst [	movsi a,'UFD
		movem a,chiwrd(b)
		jrst popj1]
	MOVE A,[-3,,DDTBUF]
	PUSHJ P,UFDRD1	;SKIP THE REMAINING 3 WDS OF AN I.T.S. UFD ENTRY.
	MOVE A,CHIWRD(B)
	SKIPN FN2RN
	 TRNN A,-1	;FN2 > 3 CHARS => INACCESSIBLE FROM DECUUO, SO DON'T MENTION.
	  JRST POPJ1	;ELSE WE WON; FN1 ALREADY IN (E).
	JRST UFDIN2

UFDINA:	MOVEM A,(E)
	SETZM CHIWRD(B)
	JRST POPJ1

UFDINE:	SETZM (E)
	POPJ P,

UFDRD1:	SYSCLV IOT,C ? A
	POPJ P,

;FINISH LOOKING UP A SIMULATED UFD.
XLUFD:	PUSH P,C
	HRRZ C,CHIOPN(B)	;C GETS I.T.S. CHANNEL # FOR UFDRD1.
	SETZM CHOLKE(B)		;PREVENT RENAMES
	SETZM CHIWRD(B)		;NO EXTENSION IS BUFFERED BACK YET.
	MOVEI A,1
	HRLM A,CHIOPN(B)	;MARK THIS CHANNEL AS HAVING A SIMULATED UFD OPEN.
	HRROI A,DDTBUF+1	;1 WORD WAS READ BY IOPEN.  READ THE 2ND
	PUSHJ P,UFDRD1		; (2ND IS PTR TO NAME AREA OF UFD)
	MOVNI A,2
	ADDM A,DDTBUF+1		;ACCOUNT FOR THE TWO WORDS ALREADY READ
XLUFD1:	HRROI A,DDTBUF
	PUSHJ P,UFDRD1		;SKIP UNTIL REACH THE NAME AREA.
	SOSE DDTBUF+1
	 JRST XLUFD1
	POP P,C
	JRST XENT2		;NOW GO BACK AND STORE VALUES INTO LOOKUP-BLOCK.

;USETI AND USETO
XUSET:	SKIPN CHDEV(B)
	 JRST IOUNAS
	SKIPGE D,CHIOPN(B)
	 JRST XUSETO
	JUMPL D,UUOXIT
XUSTO1:	CAIN D,20
	 JRST UUOXIT
	setzm chufdu(b)
	HRRZ A,UUO40
	HLRZ C,D
	CAIN C,1
	 jrst [	lsh a,7		;convert to blocks for simulated
		subi a,200
		jumple a,uuoxit
		movem a,chufdu(b) ;useti on simulated ufd (sigh)
		jrst uuoxit]
	SOJL A,XUSET1	;DETECT 0, -1, -2, ETC.
	LSH A,7		;ELSE A HAS ORIGIN-0 BLOCK #; CONVERT TO WORD #.
XUSET3:	SYSCLV ACCESS,[D ? A]
	SETZB E,CHEOFC(B)
	skipl chiopn(b)		;do not do input if file not open for it
	 PUSHJ P,XCTIN2
	JRST UUOXIT

XUSET1:	CAME A,[-1]
	 JRST MISSING		;WE CAN'T HANDLE READING RIB'S.
	LDB C,[331100,,UUO40]	;ARG WAS -1; USETI AND USETO DIFFER
	CAIE C,74
	 JRST XUSET2		;USETO MOVES BACK 1 BLOCK.
	SYSCAL FILLEN,[D ? MOVEM A]
	 JRST UUOXIT		;GIVE UP IF NOT DISK.
	JRST XUSET3		;USETI -1 ACESSES TO EOF.

XUSET2:	HRLZ A,D
	HRRI A,XUSETB
	.RCHST A,		;READ THE CURRENT ACCESS POINTER
	MOVE A,XUSETB+4
	JUMPL A,UUOXIT		;GIVE UP IF FILE NOT RANDOM ACCESS.
	SUBI A,200
	JRST XUSET3		;MOVE BACK ONE BLOCK.

XUSETO:	SKIPGE D,CHOOPN(B)	;SO IS CHANNEL OPEN FOR WRITING?
	 JRST UUOXIT		;NOPE, RETURN
	SKIPE DECRN		;THIS SAIL?
	 JRST XUSTO1		;NOPE, DON'T NEED TO DO THE REST
	LDB C,[331100,,UUO40]	;CHECK IF USETO
	SKIPL A,CHOHDR(B)	;MUST BE BUFFERED OUTPUT
	 CAIE C,75		;AND USETO
	  JRST XUSTO1		;NOT USETO OR UNBUFFERED, SO DON'T NEED THIS
	PUSH P,UUO40		;RH MUST BE ZERO
	HLLZS UUO40
	PUSHJ P,XOUT		;OUTPUT ANY FILLED BUFFERS
	 JRST XUSTO2
	POP P,UUO40
	JRST UUOXIT		;IF FAILED, JUST RETURN

XUSTO2:	POP P,UUO40
	MOVE D,CHOOPN(B)	;RESTORE D AND CONTINUE
	JRST XUSTO1		;ELSE CONTINUE WITH PROCESSING

STORAGE IMPURE
XUSETB:	BLOCK 8
STORAGE PURE

;MTAPE

xmtape:	skipn chdev(b)		; insure device on this channel
	 jrst iounas		; ** I/O to unassigned channel **
	move a,chdidx(b)	; get device index
	move a,dchtab(a)	; get device DEVCHR word
	tlnn a,(dv.dsk)		; crock; NUL is DSK and MTA
	 tlnn a,(dv.mta\dv.dta)	; is it a magtape or DECtape?
	  jrst uuoxit		; no, then it's a no-op
	skipge d,chiopn(b)	; get the ITS channel--try input
	 move d,choopn(b)	; hmm...try output
	caige d,		; is there any ITS channel for it?
	 jrst [	pushj p,iopen1	; no, assign it an ITS channel
		 jrst wrndir	; lose
		move d,chiopn(b); win
		jrst .+1]	; finished assigning
	hrrz c,uuo40		; get MTAPE argument
	hrr a,c			; and copy it
	hrli a,1		; do it once
	cain c,3		; EOF?
	 hrri a,5
	cain c,7		; BACKSPACE record?
	 move a,[-1,,6]
	cain c,11		; UNLOAD?
	 hrri a,2
	cain c,13		; 3" blank tape?
	 hrri a,4
	cain c,16		; SPACE file?
	 hrri a,7
	cain c,17		; BACKSPACE file?
	 move a,[-1,,7]
	cain c,100		; I'm hacking DEC-style tapes already
	 jrst uuoxit
	cain c,101		; I don't know how to hack industry
	 jrst missing		; tapes, so I am missing
	hrls d			; channel to LH
	hrri d,a		; function to RH
	.mtape d,		; do it
	setzm cheofc(b)		; clear EOF nonsense
	jrst uuoxit		; and return


	subttl	CALL and CALLI

DEFINE CALLS
DECALL RESET,0,XRESET
DECALL DDTIN,1,setz MISSING
DECALL SETDDT,2,XSETDD
DECALL DDTOUT,3,setz XDDTOU
DECALL DEVCHR,4,XDEVCH
DECALL DDTGT,5,setz UUOXIT
DECALL GETCHR,6,setz XDEVCH
DECALL DDTRL,7,setz UUOXIT
DECALL WAIT,10,UUOXIT
DECALL CORE,11,XCORE
DECALL EXIT,12,XEXIT
DECALL UTPCLR,13,UUOXIT
DECALL DATE,14,XDATE
DECALL LOGIN,15,PRIV
DECALL APRENB,16,XAPREN
DECALL LOGOUT,17,xexit
DECALL SWITCH,20,XSWITC
DECALL REASSI,21,XREASS
DECALL TIMER,22,XTIMER
DECALL MSTIME,23,XMSTIM
DECALL GETPPN,24,XGETPP
DECALL TRPSET,25,PRIV
DECALL TRPJEN,26,setz ILLUUO
DECALL RUNTIM,27,XRUNTI
DECALL PJOB,30,XPJOB
DECALL SLEEP,31,XSLEEP
DECALL SETPOV,32,setz xsetpo
DECALL PEEK,33,PRIV
DECALL GETLIN,34,XGETLI
DECALL RUN,35,XRUN
DECALL SETUWP,36,XSETUW
DECALL REMAP,37,XREMAP
DECALL GETSEG,40,XGETSE
DECALL GETTAB,41,XGETTA
DECALL SPY,42,PRIV
DECALL SETNAM,43,XSETNA
DECALL TMPCOR,44,XTMPCO
DECALL DSKCHR,45,XDSKCH
DECALL SYSSTR,46,xsysst
DECALL JOBSTR,47,XJBSTR
DECALL STRUUO,50,uuoxit
DECALL SYSPHY,51,XSYSPH
DECALL FRECHN,52,nvrimp
DECALL DEVTYP,53,XDEVTY
DECALL DEVSTS,54,XDEVST
DECALL DEVPPN,55,XDEVPP
DECALL SEEK,56,XSEEK
DECALL RTTRP,57,PRIV
DECALL LOCK,60,PRIV
DECALL JOBSTS,61,XJBSTS
DECALL LOCATE,62,uuoxit
DECALL WHERE,63,uuoxit
DECALL DEVNAM,64,XDEVNA
DECALL CTLJOB,65,XCTLJB
DECALL GOBSTR,66,XGBSTR
DECALL ACTIVA,67,nvrimp
DECALL DEACTI,70,nvrimp
DECALL HPQ,71,PRIV
DECALL HIBER,72,xhiber
DECALL WAKE,73,uuoxit
DECALL CHGPPN,74,PRIV
DECALL SETUUO,75,XSTUUO
DECALL DEVGEN,76,nvrimp
DECALL OTHUSR,77,xgetpp
DECALL CHKACC,100,XCHKAC
DECALL DEVSIZ,101,XDEVSI
DECALL DAEMON,102,uuoxit
DECALL JOBPEK,103,PRIV
DECALL ATTACH,104,PRIV
DECALL DAEFIN,105,PRIV
DECALL FRCUUO,106,PRIV
DECALL DEVLNM,107,XDEVLN
DECALL PATH.,110,XPATH.
DECALL METER.,111,PRIV
DECALL MTCHR.,112,XMTCHR
DECALL JBSET.,113,PRIV
DECALL POKE.,114,PRIV
DECALL TRMNO.,115,XTRMNO
DECALL TRMOP.,116,xtrmop
DECALL RESDV.,117,XRESDV
DECALL UNLOK.,120,uuoxit
DECALL DISK.,121,XDISK.
DECALL DVRST.,122,PRIV
DECALL DVURS.,123,PRIV
DECALL XTTSK.,124,nvrimp
DECALL CAL11.,125,PRIV
DECALL MTAID.,126,priv
DECALL IONDX.,127,MISSING
DECALL CNECT.,130,MISSING
DECALL MVHDR.,131,XMVHDR
DECALL ERLST.,132,MISSING
DECALL SENSE.,133,MISSING
DECALL CLRST.,134,MISSING
DECALL PIINI.,135,MISSING
DECALL PISYS.,136,MISSING
DECALL DEBRK.,137,MISSING
DECALL PISAV.,140,MISSING
DECALL PIRST.,141,MISSING
DECALL IPCFR.,142,uuoxit
DECALL IPCFS.,143,uuoxit
DECALL IPCFQ.,144,uuoxit
DECALL PAGE.,145,uuoxit
DECALL SUSET.,146,PRIV
DECALL COMPT.,147,nvrimp
DECALL SCHED.,150,PRIV
DECALL ENQ.,151,uuoxit
DECALL DEQ.,152,uuoxit
DECALL ENQC.,153,uuoxit
DECALL TAPOP.,154,MISSING
DECALL FILOP.,155,MISSING
DECALL CAL78.,156,PRIV
DECALL NODE.,157,uuoxit
DECALL ERRPT.,160,priv
DECALL ALLOC.,161,priv
DECALL PERF.,162,priv
TERMIN

;DEFINE THE SAIL SYSTEM CALLS WE RECOGNIZE.
DEFINE SCALLS
DECALL OSETNA,400002,XSETNA
DECALL SHOWIT,400011,UUOXIT
DECALL TTYMES,400047,XTTYME
DECALL SWAP,400004,XSWAP
DECALL CORE2,400015,XCOR2
DECALL DSKPPN,400071,XDSKPP
DECALL PNAME,400007,XPNAME
DECALL SEGNUM,400021,XSGNUM
DECALL ATTSEG,400016,XATTSE
DECALL DETSEG,400017,XDETSE
TERMIN

;THIS IS THE CALL NAME TABLE.
;THERE ARE NO ENTRIES FOR CALLI'S AFTER 55
	SIXBIT /LIGHTS/
NAMTAB:
DEFINE DECALL NAME,NUMBER,ADDR
IFL NUMBER-56,	SIXBIT /NAME/
TERMIN
	CALLS
NAMTLN==.-NAMTAB

;THIS IS THE DISPATCH ADDRESS TABLE.
	XLIGHT
DSPTAB:
DEFINE DECALL NAME,NUMBER,ADDR
IFN .-DSPTAB-NUMBER,.ERR DECALL NAME OF ORDER
IFN NAME-<CALLI NUMBER>,.ERR DECALL NAME MISNUMBERED
	ADDR
TERMIN
	CALLS
DSPTLN==.-DSPTAB

LSACAL==44			;HIGHEST # DEC CALLI THAT SAIL HAS

XCALLI:	hrre c,uuo40		;get the calli effective address
	trne c,400000		;and skip the uu.phy cruft
	 jrst xcali1		;if it is negative!
	MOVEI C,200000		;IF WE ARE SUPPOSED TO IGNORE UU.PHY AND UU.PHS,
	SKIPN ZPHYS
	 ANDCAM C,UUO40		;CLEAR IT OUT.
	HRRE C,UUO40
xcali1:	MOVE D,C		;(IN CASE GO TO XCALLS)
	PUSHJ P,UGETAC		;SET UP AC CONTENTS IN A FOR THE ROUTINE.
	TRNE C,200000
	 JUMPGE C,MISSING	;WANTS SUPPRESS LOGICAL DEVNAMES FEATURE.
	CAMGE C,[-1]
	 JRST XCALLS
	SKIPN DECRN
	 CAIGE C,LSACAL		;SAIL DOESN'T HAVE ALL THE DEC CALLI'S.
	  CAIL C,DSPTLN
	   JRST uuoxit		;non-existant calli is a no-op
	skipe zobsolete		;do obsolete UUO's work?
	 skipl dsptab(c)	;no, is the UUO obsolete?
	  JRST @DSPTAB(C)
	errout Obsolete UUO

XCALL:	PUSHJ P,UGETA
	MOVE D,A
	PUSHJ P,UGETAC		;SET UP AC CONTENTS IN A FOR THE ROUTINE.
	MOVSI C,-NAMTLN
	CAME D,NAMTAB(C)
	AOBJN C,.-1
	JUMPL C,@DSPTAB(C)
	MOVEI C,-1
	CAMN D,['LIGHTS]
	 JRST @DSPTAB(C)
;HERE TO DECODE A SAIL-ONLY CALL OR CALLI. NAME OR NUMBER IN A.
XCALLS:	SKIPE DECRN
	 jrst uuoxit		;no customer defined calli's--no-op
	MOVSI C,-SCALTL
	CAME D,SCALT(C)
	 AOBJN C,.-1
	JUMPGE C,ILLUUO
	JRST @SCALD(C)

SCALT:
DEFINE DECALL NAME,NUMBER,ADDR
SIXBIT /NAME/ ? -1,,NUMBER
TERMIN

SCALLS
SCALTL==.-SCALT

SCALD:
DEFINE DECALL NAME,NUMBER,ADDR
ADDR ? ADDR
TERMIN

SCALLS


;COME HERE WHEN PROGRAM REQUESTS A PRIVILEGED FUNCTION.  EITHER GIVE THE
;SIMULATED PROGRAM AN ERROR RETURN OR COMPLAIN TO THE USER.
PRIV:	SKIPN PRIVIL
	 JRST UUOXIT
	ERROUT Privileged UUO

;come here when the UUO was never implemented by DEC

nvrimp:	skipn zimplement
	 jrst uuoxit
	errout Never Implemented by DEC

	subttl	RUN, GETSEG and SWAP UUOs;  Loading Binary Files

XSWAP:	TLNE A,-1
	 JRST MISSING
	JUMPE A,CPOPJ
XRUN:	PUSHJ P,XRESET
XGETSE:	PUSHJ P,UGETAC
	HLRM A,RUNOFS		;RUN UUO'S START OFFSET IS IN LH(AC)
	ANDI A,-1
	PUSH P,A
	PUSHJ P,UGET3		;GET FIRST WORD OF BLOCK
	MOVEM A,OPNDEV
	AOS A,(P)		;FILE NAME 1
	PUSHJ P,UGET3
	MOVEM A,OPNFN1
	AOS A,(P)		;FILE NAME 2
	PUSHJ P,UGET3
	MOVEM A,OPNFN2
	AOS A,(P)		;STARTING ADDRESS OFFSET FOR SWAP UUO
	PUSHJ P,UGET3
	HRRZ B,UUO40
	CAIE B,RUN
	 HRRM A,RUNOFS
	HLRZM A,RUNCOR		;SWAP UUO'S CORE SIZE IS IN 3RD WORD
	AOS A,(P)		;PPN
	PUSHJ P,UGET3
	MOVEM A,OPNSNM
	AOS A,(P)
	PUSHJ P,UGET3
	CAIN B,RUN
	 HRRZM A,RUNCOR		;CORE SIZE FOR RUN UUO IN 5TH WORD
	SUB P,[1,,1]
	CAIN B,GETSEG
	 JRST XGETS1
	PUSHJ P,RUNI		;LOAD UP THE FILES.
	 JRST XRUNE
	MOVE A,RUNCOR
	CAMG A,MEMT
	 JRST XRUN1
	SUBI A,1		;IF UUO SPEC'D MORE CORE THAN MINIMUM,
	PUSHJ P,XCORER		;GET IT.
	 JRST XRUNEC
XRUN1:	JRST DDTGO		;THEN START THE PROGRAM.

;HERE FOR GETSEG, AFTER GETTING ARGS.
XGETS1:	PUSHJ P,RUNINI		;SET UP FOR RUN/GETSEG
	MOVEI B,ERILU%
	SKIPN TWOSEG
	 JRST XRUNE
	SETZB B,A
	PUSHJ P,CHREL		;RELEASE CHANNEL 0 (SINCE DEC SYS DOES IT TOO)
	SKIPN A,OPNFN2
	 JRST XGETS2
	MOVEI B,ERFNF%
	.CALL LODOPN
	 JRST XRUNE
	PUSHJ P,LODH1		;OPENED THE SPEC'D FILENAME; LOAD IT.
	 JRST XRUNE
	JRST POPJ1

XGETS2:	PUSHJ P,LODHGH		;DIDN'T SPEC FN2 => TRY THE STANDARD ONES.
	 JRST XRUNE
	 JRST XRUNE
	MOVE A,.JBSA		;FLUSH THE START AND RE-ENTER ADDRESSES
	TRNE A,400000		;IF THEY ARE IN THE HISEG THAT WAS THROWN AWAY.
	 HLLZS .JBSA
	MOVE A,.JBREN
	TRNE A,400000
	 SETZM .JBREN
	JRST POPJ1

;ERROR HANDLING FOR RUN AND GETSEG UUOS.

;COME HERE TO REPORT A NOT-ENOUGH-CORE ERROR.
XRUNEC:	MOVEI B,ERNEC%

;COME HERE WITH ERROR CODE IN B.  EITHER REPORT TO USER OR TYPE ERR MSG.
XRUNE:	MOVE A,UUOH
	TRNE A,400000
	 SKIPL RUNLDH
	  SKIPGE RUNLDL
	   JRST XRUNE1		;RETURN ADDR CLOBBERED BY LOADING; USER CAN'T HANDLE.
	SKIPN DECRN		;ON SAIL, USER NEVER HANDLES THE ERROR ??
	 JRST XRUNE1		;AT LEAST, UUO MANUAL GIVES THAT IMPRESSION.
	PUSHJ P,UGETA
	HLRZS A
	CAIN A,(JRST 4,)
	 JRST XRUNE1		;USER'S ERROR RETURN IS A HALT => HE DOESN'T WANT IT.
	MOVE A,B
	JRST UPUTAC		;ELSE JUST GIVE HIM ERROR CODE AND TAKE THE DIRCET EXIT.

;COME HERE IF USER CAN'T OR WON'T HANDLE THE ERROR, TO PRINT A MESSAGE AND ERR OUT.
XRUNE1:	PUSHJ P,XRUNE2	
	JRST ILLUUO

XRUNE2:	MOVE A,XRUNET(B)	;GET ERR MSG FOR THIS ERROR CODE.
XRUNE3:	PUSHJ P,XOUTS0		;PRINT IT ON THE TTY
	MOVEI A,[ASCIZ / - /]
	PUSHJ P,XOUTS0
	PUSHJ P,LSTFIL		;ALONG WITH NAME OF LOSING FILE.
	MOVEI A,[ASCIZ /
/]
	JRST XOUTS0

XRUNET:	OFFSET -.
	[ASCIZ /File can't be OPENed/]
	BLOCK 6
	[ASCIZ /Attempt to load bad-format file/]
	[ASCIZ /Not enough core available to load file/]
	BLOCK 2
	[ASCIZ /Illegal UUO (eg, GETSEG on 1-segment machine)/]
	OFFSET 0

;PRINT OUT THE FILENAMES IN OPNDEV, ETC.
LSTFIL:	
IRPS X,Y,[;OPNDEV:OPNSNM;OPNFN1 OPNFN2,]Z,,4 SNAME 1 2
	SKIPN B,X
IFSE Z,SNAME,	MOVE B,SNAME
.ELSE		JRST .+Z
	PUSHJ P,LSTSIX
IFSN [Y][,][
	MOVEI A,"Y
	PUSHJ P,TYO
]
TERMIN
	POPJ P,

LSTSIX:	SETZ A,		;PRINT SIXBIT WORD IN B AS A FILENAME.
	ROTC A,6
	ADDI A,40
	CAIE A,":
	 CAIN A,";
	  PUSHJ P,LSTSI1
	CAIE A,"/
	 CAIG A,40
	  PUSHJ P,LSTSI1
	PUSHJ P,TYO
	JUMPN B,LSTSIX
	POPJ P,

LSTSI1:	PUSH P,A
	MOVEI A,^Q
	PUSHJ P,TYO
	JRST POPAJ

;LOAD UP FILES FOR A RUN UUO, ACCORDING TO THE FILENAMS IN OPNDEV, ETC.
RUNI:	PUSHJ P,RUNINI
	PUSHJ P,LODHGH		;TRY TO LOAD A HISEG
	 JRST RUNLOW		 ;THERE IS NO FILE FOR ONE.
	 POPJ P,		 ;THERE IS, AND LOADING IT FAILED.
	PUSHJ P,VESTIG		;SET JOBDAT AREA FROM VESTIGIAL ONE IN FILE
	HLRZ A,.JBCOR		;IF FILE SAYS IT HAS A LOSEG FILE, LOAD IT.
	CAIGE A,140
	 JRST RUNNL
RUNLOW:	PUSHJ P,LODLOW
	 POPJ P,
	CAIA
RUNNL:	 SETZM .SGLOW		;NO LOWSEG FILE LOADED => TELL USER.
	MOVE .SGNAM,OPNFN1	;TELL HIM THE OTHER NAMES OF WHAT WAS LOADED
	MOVE .SGDEV,RUNDEV
	SKIPN A,OPNSNM
	 MOVE A,SNAME
	MOVEM A,.SGPPN-LOWAC+UUOACS
	MOVE A,OPNFN1		;SET UP THE DEC SYSTEM "JOB NAME" BASED ON THE NAME
	CAMN A,[SIXBIT /TS/]	;OF THE PROGRAM WE ARE ABOUT TO LOAD.
	 MOVE A,OPNFN2
	MOVEM A,JOBNAM
	HLRZ A,.JBSA
	MOVEM A,.JBFF
	HRRZ C,.JBSA		;UPDATE START ADDR FROM FILE BY OFFSET SPEC'D IN UUO.
	ADD C,RUNOFS
	HRRM C,.JBSA
	HRRZ A,.JBCOR
	CAMG A,RUNCOR		;IF FILES SAY WANT MORE CORE THAN WAS LOADED,
	 JRST POPJ1
	PUSHJ P,XCORER		;GET IT.
	 JRST LODNC
	JRST POPJ1

;AFTER LOADING A HIGH SEGMENT, INITIALIZE THE JOB DATA AREA FROM THE VESTIGIAL
;JOB DATA AREA.
VESTIG:	HRROI A,.JBHSM+.JBHGH	;POINT AT LAST WORD IN VESTIGIAL JOBDAT AREA
	POP A,.JBSYM		;HANDLE .JBHSY
	POP A,B			;IGNORE .JBHNM
	POP A,.JBVER		;HANDLE .JBHVR
	POP A,B			;HANDLE .JBHRN
	HRRM B,.JBREN
	HLLM B,.JBHRL
	POP A,.JBCOR		;HANDLE .JBHCR
	POP A,.JB41		;HANDLE .JBH41
	POP A,.JBSA		;HANDLE .JBHSA
	POPJ P,

;INITIALIZE FOR RUN/GETSEG.  SAY THAT NEITHER SEGMENT HAS BEEN CLOBBERED,
;AND CHANGE DEVICE "SYS:" TO "DSK:DECSYS;"
RUNINI:	SETZM RUNLDH
	SETZM RUNLDL
	MOVEI A,1
	MOVEM A,XSETU1	;AFTER GETTING NEW HISEG, IT'S SUPPOSED TO BE PURE.
	MOVE A,OPNDEV
	MOVEM A,RUNDEV
	CAME A,[SIXBIT /SYS/]
	 POPJ P,
	MOVE A,[SIXBIT/DECSYS/]
	MOVEM A,OPNSNM
	MOVE A,[SIXBIT/DSK/]
	MOVEM A,OPNDEV
	POPJ P,

;TRY TO LOAD THE HISEG FILE OF THE PROGRAM TO BE RUN.
;EXTENSIONS SHR AND HGH HAVE THEIR DEC MEANINGS.
;EXTENSION HBIN IMPLIES AN ITS BINARY FILE (MUST BE PDUMP'ED).
;THE SPECIFIED EXTENSION IS IGNORED, AND ONLY THOSE THREE ARE TRIED.
;USUALLY, NONE OF THEM EXISTS.
;NO SKIP RETURN => FILE NOT FOUND.
;1 SKIP RETURN => FILE FOUND, BUT IT COULDN'T LOAD PROPERLY; ERR CODE IN B.
;2 SKIP RETURN => SUCCESS.

LODHGH:
IRPS HGH,,SHR HGH HBIN
	MOVE A,[SIXBIT/HGH/]
	.CALL LODOPN
	 CAIA
	  JRST LODH1
TERMIN
	JRST LODLO3		;CAN'T FIND ANY OF THE THREE NORMAL NAMES.

LODH1:	AOS (P)
	SETOM RUNLDH		;SAY USER'S OLD HISEG IF ANY HAS BEEN CLOBBERED.
	PUSH P,A		;WHEN WE DO, WE'LL NEED TO KNOW WHICH FORMAT TO LOAD.
	MOVSI A,1		;FOUND A FILE; FLUSH EXISTING HISEG.
	PUSHJ P,XCORER
	 .LOSE
	POP P,A
	CAME A,['HGH,,]
	 CAMN A,['SHR,,]	;DETERMINE WHICH FORMAT TO LOAD.
	  JRST LODHD
	PUSHJ P,LODITS
	 POPJ P,		;LODITS FAILS => WE FAIL; ERR CODE IN B ALREADY.
	HRRZ B,.JBHSA;.JBHGH	;GET I.T.S. START ADDRESS AND PUT IT IN VESTIGIAL
	SKIPN B
	 HRRZM C,.JBHSA+.JBHGH	;JOB DATA AREA SO IT WILL BE SEEN BY EVERYONE ELSE.
	JRST LODH3

;LOAD THE LOW SEGMENT FILE OF THE SPECIFIED PROGRAM.  IF AN EXTENSION
;WAS SPECIFIED, IT IS USED HERE; OTHERWISE, LOW, SAV AND BIN ARE TRIED.
LODLOW:	SKIPN A,OPNFN2
	 JRST LODLO1
	.CALL LODOPN
	 JRST LODLO3
	JRST LODLO2

LODLO1:
IRPS LOW,,SAV LOW BIN
	MOVE A,[SIXBIT/LOW/]
	.CALL LODOPN
	 CAIA
	  JRST LODLO2
TERMIN
LODLO3:	MOVEI B,ERFNF%
	POPJ P,			;NO FILE WAS FOUND WITH A STANDARD FN2.

LODLO2:	MOVEM A,.SGLOW
	PUSHJ P,ZAPRUN		;FLUSH OUR LOWSEG, AND OUR HISEG IF IT WASN'T JUST LOADED.
	SETOM RUNLDL
	SETOM RUNLDH
	CAME A,['LOW,,]
	 CAMN A,['SAV,,]
	  JRST LODLD		;DEC STANDARD EXTENSION => LOAD DEC FORMAT.
	PUSHJ P,LODITS		;LOAD AN ITS FORMAT FILE, AND LEAVE START ADDR IN C.
	 POPJ P,
	HRRZ A,.JBSA
	SKIPN A			;DON'T CLOBBER HIS IDEA OF STARTING ADDRESS
	 HRRM C,.JBSA		;WHAT THE HECK, HE MAY BE INTERESTED
	PUSHJ P,JOBVA1
LODH3:	.CLOSE LOADCH,
	JRST POPJ1

LODOPN:	SETZ ? SIXBIT /OPEN/
	1000,,LOADCH ? 5000,,.BII
	OPNDEV ? OPNFN1 ? A ? SETZ OPNSNM

;LOAD A DEC SHR OR HGH FILE. CLOBBERS ALL UUO ACS.
LODHD:	MOVEI B,%CBNDR		;FIRST, TRY MAPPING THE PAGES.
	CAME A,['SHR,,]		;DON'T SHARE IF FN2 ISN'T SHARE.
	 MOVEI B,%CBCPY
	MOVE A,[-<HIBASE-400000>/2000,,200]
	SYSCAL CORBLK,[B ? MOVEI -1 ? A ? MOVEI LOADCH]
	 JFCL
	CAMN A,[-<HIBASE-400000>/2000,,200]
	 JRST LODHD1		;GOT NO PAGES => CHANCES ARE IT ISN'T DSK:, SO IOT INSTEAD.
	JUMPG A,MISSING		;CAN'T LOAD UP MORE THAN TILL HIBASE - SORRY.
	LSH A,10.
	HRRZM A,HMEMT
	SETOM HSPURE		;INDICATE OUR HISEG IS REALLY PURE.
	JRST LODH3

LODHD1:	HRLZ A,HMEMT
	PUSHJ P,XCORER		;ADD 1 PAGE TO HISEG.
	 JRST LODNC
	MOVE A,HMEMT
	SUB A,[2000,,2000]	;MAKE AOBJN PTR TO NEWLY ADDED K.
	.CALL LODIOT
	 .LOSE 1000
	JUMPGE A,LODHD		;FILLED THIS K => TRY TO LOAD ANOTHER.
	TLNE A,1777		;DIDN'T FILL ANY OF THE LAST K =>
	 JRST LODH3
	HRLZI A,-1(A)		;FLUSH IT.
	PUSHJ P,XCORER
	 .LOSE
	JRST LODH3

;LOAD A DEC SAV OR LOW FILE. RETURN START ADDRESS IN C. CLOBBERS ALL UUO ACS.
LODLD:	HRROI A,C
	.CALL LODIOT		;READ 1 WORD INTO C.
	 .LOSE 1000
	JUMPL A,LODBF
	JUMPGE C,LODLD2		;IT IS POSITIVE => IT IS START INSTRUCTION.
	HRRI C,1(C)		;ELSE CONVERT IOWD INTO AOBJN POINTER
	HLRE A,C
	SUBM C,A		;COMPUTE ADDR OF 1ST WORD AFTER THE BLOCK TO BE LOADED
	ANDI A,-1
	CAMG A,MEMT		;IF WON'T FIT IN EXISTING CORE,
	 JRST LODLD1
	SUBI A,1		;GET MORE. CONVERT TO HIGHEST ADDR THAT SHOULD EXIST.
	PUSH P,C
	PUSHJ P,XCORER
	 JRST [	POP P,C ? JRST LODNC]
	POP P,C
LODLD1:	MOVE A,C
	.CALL LODIOT		;NOW READ THE DATA INTO WHERE IT GOES IN CORE.
	 .LOSE 1000
	JUMPL A,LODBF
	JRST LODLD		;AND READ THE NEXT BLOCK.

LODLD2:	PUSHJ P,JOBVAR
	MOVE A,114
	SKIPN .JBDDT		;THE DEC MONITOR LIKES TO SAVE .JBDDT AND .JB41
	 MOVEM A,.JBDDT
	MOVE A,122		;AS IF THEY WERE IN 114 AND 122.
	SKIPN .JB41
	 MOVEM A,.JB41
	JRST LODH3

LODNC:	MOVEI B,ERNEC%		;GIVE UP AND REPORT NO CORE AVL.
	JRST LODERR

LODBF:	MOVEI B,ERNSF%		;GIVE UP AND REPORT ILGL FORMAT FILE.
LODERR:	.CLOSE LOADCH,
	POPJ P,

;LOAD THE ITS-FORMAT BINARY FILE OPEN ON LOADCH.  RETURN THE START ADDR IN C.
LODITS:	SYSCAL LOAD,[MOVEI -1 ? MOVEI LOADCH]
	 JRST LODBF
	SYSCLV CORTYP,[MOVEI -1 ? MOVEI 200 ? MOVEM A]
	SKIPLE A		;IF PAGE 200 EXISTS AND IS PURE,
	 SETOM HSPURE		;SAY WE HAVE A REALLY PURE HISEG.
	HRROI A,C		;READ 1 WORD INTO C
	.CALL LODIOT		;IT IS THE STARTING ADDRESS.
	 .LOSE 1000
	JUMPL A,LODBF
	PUSHJ P,JOBVAR

;PASS SYMBOLS TO DDT IF DESIRED.
	.SUSET [.ROPTIO,,A]
	TLNN A,OPTDDT
	 JRST POPJ1
	SKIPN SYMSRN
	 JRST POPJ1		;HE'S NOT INTERESTED IN THE SYMBOLS
	PUSH P,C
	HRROI A,C		;READ WORD INTO C
	.CALL LODIOT		;GET AOBJN POINTER TO SYMBOLS.
	 .LOSE 1000	
	JUMPL A,LODBF
	JUMPGE C,POPJ1		;JUMPE IF NO SYMBOLS IN FILE
	HRR C,MEMT		;WHERE THE SYMBOLS WILL START
	PUSH P,C		;SAVE IT
	HLRES C
	MOVN A,C		;# WORDS IN SYMBOL TABLE
	ADD A,MEMT
	SUBI A,1
	PUSHJ P,XCORER		;GET THE CORE
	 .LOSE
	MOVE A,(P)		;AOBJN POINTER TO SYMBOL TABLE
	.CALL LODIOT
	 .LOSE 1000
	JUMPL A,[SUB P,[2,,2] ? JRST LODBF]
	MOVEI A,(P)		;POINTER TO AOBJN POINTER
	HRLI A,400007		;WRITE SYMBOLS INTO DDT
	.BREAK 12,A
	POP P,A
	MOVEI A,-1(A)		;FLUSH THE EXTRA CORE.
	PUSHJ P,XCORER
	 .LOSE
POPCJ1:	POP P,C
	JRST POPJ1

LODIOT:	SETZ ? 'IOT,,
	MOVEI LOADCH ? SETZ A

;HERE TO SET JOB DATA AREA

JOBVAR:	PUSHJ P,INSBOT		;PUT THE BOOTSTRAP IN IT, W/ SWITCHES.
	MOVEI B,0
	MOVEI E,HIBASE
	PUSHJ P,MEMSIZ		;DETERMINE SIZE OF LOW CORE
	MOVEM B,MEMT
	MOVEI E,400000
	MOVEM E,HMEMT		;DETECT THE CASE OF LOWSEG LONGER THAN 200K,
	CAML B,E		;AND SAY THERE'S NO HISEG.
	 JRST [	SKIPN .JBHRL	;WAS THIS FILE 2 SEGS WHEN DUMPED, THOUGH?
		 POPJ P,
		SKIPN B,.JBREL
		 POPJ P,
		AOS B
		LSH B,-10.
		HRLI B,-200(B)	;DELETE THE GAP PAGES THAT SHOULDN'T EXIST
		SYSCLV CORBLK,[MOVEI 0 ? MOVEI -1 ? B]
		MOVEI A,[ASCIZ /has 2 segs; should be :PDUMP'd, not $Y'D/]
		PUSHJ P,XRUNE3	;TELL USER TO FIX THINGS
		JRST JOBVAR]	;REFIGURE MEMT AND HMEMT NOW THAT GAP IS THERE.
	MOVE B,E
	MOVEI E,HIBASE
	PUSHJ P,MEMSIZ		;AND THEN HIGH SEGMENT
	MOVEM B,HMEMT
	POPJ P,

JOBVA1:	MOVE A,MEMT
	HLRZ B,.JBSA
	SKIPN B
	 HRLM A,.JBSA		;INIT THINGS THAT POINT TO TOP, IF USER HASN'T.
	HLRZ A,.JBSA
	CAMG A,MEMT		;MAKE SURE CORE EXTENDS PAST PROGRAM BREAK.
	 JRST XCOREX
	SUBI A,1
	PUSHJ P,XCORER
	 .LOSE
	POPJ P,

;HERE TO FIND FIRST MPV IN CORE BETWEEN C(B) AND C(E).  RETURN ADDR IN B.

MEMSIZ:	PUSH P,A
	PUSH P,UUO42		;SAVE POINTER TO NORMAL INTERRUPT GUY
	.SUSET [.SDF1,,[#%PIMPV]]
	.SUSET [.SDF2,,[-1]]	;DEFER ALL INTS BUT THOSE WE WANT TO HANDLE.
	MOVE A,[-MEMINL,,MEMINT]
	MOVEM A,UUO42
MEMSZ1:	MOVE A,100(B)		;AC WILL NEVER GIVE MPV, SPLIT CYCLE DETECTS WRITE PROTECTED PAGES
	CAML B,E		;MAYBE THERE NEVER WILL BE AN MPV
	 JRST MEMHIT		;RETURN HIGHEST LEGAL ADDRESS
	ADDI B,2000
	JRST MEMSZ1

MEMHIT:	POP P,UUO42		;RESTORE OLD INTERRUPT HANDLER
	.SUSET [.SDF2,,[0]]
	.SUSET [.SDF1,,[0]]
	JRST POPAJ

	subttl	System Commands

;CMDSAV IS THE SUBROUTINE USED TO SAVE CRUFT AND PRETEND TO BE IN A UUO.
;THE PC WHEN JRST 45 OR WHATEVER WAS $X'D IS PUT IN UUOH.
;IF A UUO IS ALREADY IN PROGRESS, EITHER WAIT FOR IT TO FINISH
;OR BACK OUT OF IT IF WE KNOW HOW.  IF AN INTERRUPT IS IN PROGRESS,
;JUST BARF (BUT MANAGE NOT TO CLOBBER THINGS)

STORAGE IMPURE

CMDACA:	0		;SAVE AC A IF CMDSAV CALLED WHILE UUO IN PROGRESS.
CMDACB:	0		;SAVE B, ETC
CMDACC:	0

CMDSAV:	0
	JRST CMDSA1

STORAGE PURE

CMDSA1:	SKIPE INTFLG	;INT IN PROGRESS? IF SO, LOSE.
	 JRST CMDINT
	SKIPE UUO40	;IF INSIDE A UUO, CAN'T AFFORD TO SAVE IN UUOACS, ETC.
	 JRST CMDUUO	;SO CLOBBER EXIT AND RETURN TO UUO, WHICH WILL COME BACK HERE.
CMDUOX:	MOVEM M,UUOACS+M-LOWAC
	MOVE M,[A,,UUOACS+A-LOWAC]
	BLT M,UUOACS+HIGHAC-LOWAC
	MOVE P,UUOPDP
	MOVE M,DPYTYP
	HRRZM P,UUO40
	.VALUE [ASCIZ *..XECP/ 2/ 1Q
P*]
	MOVEM A,UUOH	;THE USER'S "$X PC" IS OUR RETURN ADDRESS.
	JRST 2,@CMDSAV

CMDINT:	.VALUE [ASCIZ *:Interrupt in progress - can't do system command

P*]
	.BREAK 16,400000

;GET HERE IF USER DOES JRST 45$X OR SOME SUCH WHILE INSIDE A UUO.
CMDUUO:	MOVEM A,CMDACA
	MOVEM B,CMDACB
	MOVEM C,CMDACC
	.VALUE [ASCIZ *..XECP/ 2/ 1Q
P*]				;GET THE UUO HANDLER'S PC.
	MOVE B,A
	MOVEI A,CMDUOX		;SET UUO TO RETURN TO US (CMDUOX)
	EXCH A,UUOH		;AND PUT UUO'S OLD RET ADDR IN ..XECP
	HRRZ C,B		;SO THAT WHEN WE ARE RE-ENTERED AFTER THE UUO WE WILL
	CAIN C,TIHAN1		;USE IT AS OUR RETURN ADDRESS.
	 MOVEI B,UUOXIT		;IF HE WAS JUST WAITING IN TYI, PCLSR HIM.
	CAIN B,UUOXIT
	 SOS A
	CAIE B,UUOXIT
	 .VALUE [ASCIZ *:Finishing up a UUO first...

P*]
	.VALUE [ASCIZ *2/ ..XECP/ 1Q
P*]
	MOVE A,CMDACA		;RESTORE OUR ACS, PUTTING UUO HANDLER PC IN CMDACB.
	EXCH B,CMDACB
	MOVE C,CMDACC
	JRST 2,@CMDACB		;GO FINISH THE UUO.

;45 CONTAINS A JUMP TO HERE:
DECS1:	JSR CMDSAV
DECS2:	MOVE P,UUOPDP
	PUSH P,[DECSAX]
	MOVEI A,[ASCIZ /
Command: /]
	PUSHJ P,XOUTS0
	SKIPG ACTCHR
	 PUSHJ P,TIHANG		;READ A CHARACTER FROM THE TERMINAL.
	PUSHJ P,GETCHA
	CAIL A,140
	 SUBI A,40
	CAIN A,"D		;D => DO S, V, P AND F.
	 JRST DECDMP
	CAIN A,"S		;S => DO A DECSAV.
	 JRST DECSAV
	CAIN A,"F		;F => DO A DECFLS
	 JRST DECFLS
	CAIN A,"R		;R => RE-ENTER.
	 JRST DECRE1
	CAIN A,"V		;V => STUFF THE VESTIGIAL JOBDAT AREA
	 JRST DECVES
	CAIN A,"P		;P => PURIFY HIGH SEGMENT (FOR PDUMPING)
	 JRST DECPUR
	cain a,"?		;? => list the available commands
	 jrst dechlp
	cain a,"H		;H => list commands with more detail
	 jrst dechl1
	caie a,"N		;N => No-op to finish off UUO
	 JRST DECS2
	movei a,[asciz/o-op/]
	pushj p,xouts0
	move highac,[uuoacs,,lowac]
	blt highac,highac
	.value [asciz/2:vk /]
	setzm @uuo40
	jrst 2,@uuoh

; Type out a little help cruft

dechlp:	movei a,[asciz/ Dump, Flush, Help, No-op, Purify, Reenter, Symbols, Vestigal/]
	pushj p,xouts0
	jrst decs2

dechl1:	movei a,hlpcrf
	pushj p,xouts0
	jrst decs2

hlpcrf:	asciz/elp for system commands.  Type one of:

D	Prepare simulated program for :PDUMPing
F	Flush DECUUO from core
H	Help cruft typeout
N	(No-op)Merely finish up current UUO
P	Purify high segment, does a V also
R	Reenter program from .JBREN
S	Pass simulated program's symbols up to DDT
V	Copy job data information to Vestigal JOBDAT area
?	Short list of commands
/
;HANDLE "R" = RE-ENTER
DECRE1:	movei a,[asciz/eenter/]
	pushj p,xouts0
	SKIPN A,.JBREN
	 JRST [	.VALUE [ASCIZ *:
No REENTER address
P*]
		POPJ P,] ;$X-RETURN, TO RESTORE USER'S PC.
	EXCH A,UUOH
	HRRZ B,A
	CAIE B,31
	 JRST DECRE2
	HRR A,32
	SUBI A,1
DECRE2:	MOVEM A,.JBOPC
	JRST UUOXIT

DECVES:	movei a,[asciz/estigal/]
	pushj p,xouts0
DECVS1:	MOVE B,HMEMT		;"V" - STUFF VESTIGIAL JOBDAT ARE WITH PROPER DATA.
	CAIN B,400000		;WORKS ONLY IF THERE IS A HISEG.
	 JRST [	.VALUE [ASCIZ *:
No high segment
P*]
		POPJ P,]
	MOVEI A,377777
	SETZ B,
	MOVE C,.JBREN
	HLL C,.JBHRL
IRPS X,,.JBSA .JB41 .JBCOR C .JBVER B .JBSYM
	PUSH A,X
TERMIN
	POPJ P,

;PURIFY THE PAGES OF THE SIMULATED HIGH SEGMENT.
DECPUR:	movei a,[asciz/urify/]
	pushj p,xouts0
DECPR1:	MOVN B,HMEMT
	LSH B,18.-10.		;GET AOBJN TO ALL SIMULATED PAGES
	ADD B,[200,,200]	;TAKE THE LOW HALF OF MEMORY AWAY
	JUMPGE B,CPOPJ		;NO HIGH SEG?
	PUSH P,B
	SYSCLV CORTYP,[MOVEI -1 ? MOVEI 200 ? MOVEM B]
	SKIPGE B		;DON'T TRY WRITING IN HISEG IF IT'S PURE.
	 PUSHJ P,DECVS1		;BETTER SET UP VESTIG JOBDAT AREA WHILE STILL CAN.
	POP P,B
	SYSCLV CORBLK,[MOVEI %CBRED ? MOVEI -1 ? B]
	SETOM HSPURE		;SAY WE HAVE A TRULY PURE HISEG.
	POPJ P,

;DECFL1 FLUSHES DECUUO FROM CORE, AND MAKES THE I.T.S. START ADDRESS POINT AT
;THE BOOTSTRAP.

decfls:	movei a,[asciz/lush/]
	pushj p,xouts0
DECFL1:	.BREAK 12,[400001,,[JUMPA BOTGO]]
	.SUSET [.ROPTIO,,A]
	TLZ A,OPTDEC
	.SUSET [.SOPTIO,,A]
	.SUSET [.SMASK,,[0]]
	.SUSET [.SMSK2,,[0]]
	PUSHJ P,INSBOT		;INSERT BOT (BOOTSTRAP) IN JOBDAT AREA
	move a,[.lose]
	MOVEM A,BOTBEG		;REFUSE TO RECOGNIZE SYSTEM COMMANDS NOW.
	HRRZ A,.JBFF
	CAML A,MEMT		;NOW ZERO ALL CORE FROM .JBFF TO TOP OF LOW SEG.
	 JRST DECFL2
	SETZM (A)
	ADDI A,1
	CAML A,MEMT
	 JRST DECFL2
	HRLI A,-1(A)
	BLT A,@.JBREL
DECFL2:	MOVE 15,[DECSAB,,.JBDDT+1]
	BLT 15,DECSAE		;PUT FLUSH ROUTINE IN JOB DATA AREA.
	MOVE 17,HMEMT
	CAIN 17,400000
	 MOVE 17,MEMT
	LSH 17,-10.		;TELL FLUSH ROUTINE HOW MUCH CORE TO PRESERVE.
	HRRM 17,.JBDDT+1
	SETZ 0,			;CLEAR ALL ACS SO IN CASE LOADED IN BY DECUUO
	MOVEI 17,1		;IT WON'T CLOBBER LODITS'S ACS.
	BLT 17,17
	JRST .JBDDT+1

DECSAB:	OFFSET .JBDDT+1-.	;FLUSH ROUTINE TO EXPUNGE DECUUO FROM CORE.
	.CORE 10000.
	 .LOSE
	.BREAK 16,100000
DECSAE::JRST BOTGO
	OFFSET 0

INSBOT:	MOVE A,[BOTBOT,,BOTBEG]	;PUT THE BOOTSTRAP INTO THE JOB DATA AREA.
	BLT A,BOTEND
	SETZ A,
IRPS X,,FN2RN TTYRN DECRN MAPRN METARN IIIRN PRSVEX,Y,,[
	FN2BT TTYBT DECBT MAPBT METABT IIIBT PRSVBT]
	SKIPE X
	 TRO A,Y
TERMIN
	HRRM A,BOTSWITCH	;PUT OUR CURRENT SWITCH SETTINGS INTO BOOTSTRAP.
	POPJ P,

;DECSAV CONVERTS A DEC FORMAT SYMBOL TABLE IN THE CORE IMAGE TO AN
;ITS FORMAT SYMBOL TABLE AND PASSES IT UP TO DDT.

;DECDMP DOES DECSAV AND THEN DECFLS.

decsav:	movei a,[asciz/ymbols/]
	pushj p,xouts0
	PUSHJ P,DECSA0		;FIRST, PASS UP THE SYMBOLS.
DECSAX:	MOVE HIGHAC,[UUOACS,,LOWAC]
	BLT HIGHAC,HIGHAC
	SETZM UUO40
	.BREAK 16,700000	;THEN SAY WE WON.

decdmp:	movei a,[asciz/ump/]
	pushj p,xouts0
	MOVE P,UUOPDP
	PUSHJ P,DECSA0		;FIRST, PASS UP THE SYMBOLS.
	PUSHJ P,DECPR1		;THEN SET UP VESTIG AREA AND PURIFY HIGH SEG.
	JRST DECFL1		;THEN SET START ADDR -> BOOT, AND FLUSH US FROM CORE.

;SUBOUTINE TO PASS A DEC-STYLE IN-CORE SYM TAB UP TO DDT, AND THEN FLUSH IT
;FROM CORE IF POSSIBLE (UNLESS THERE'S A DEC-STYLE DDT IN CORE)
DECSA0:	HLRE A,.JBSYM
	JUMPE A,CPOPJ	;RETURN IF NO SYMS IN CORE.
	MOVNS A		;GET # WDS SYMTAB NEEDS
	ADD A,MEMT
	SUBI A,1	;GET ENOUGH NEW CORE TO COPY THE SYMTAB
	PUSH P,MEMT	;AT THE TOP OF THE LOW SEG.
	PUSHJ P,XCORER
	 .LOSE
	POP P,A
	MOVE B,A
	HRL B,.JBSYM
	HLRE C,.JBSYM
	SUBM A,C
	BLT B,-1(C)	;COPY THE SYMTAB
	SETZ C,
	HLL A,.JBSYM	;AOBJN -> COPY.
	PUSH P,A
DECSAL:	SKIPN B,(A)
	 JRST DECSA4	;ZERO SYMBOLS COME AT BEGINNGING OF PROGRAMS.
	TLZ B,740000	;BLOCK NAMES COME AT END.
	JUMPE B,DECSA4
DECSA3:	CAML B,[50*50*50*50*50]
	 JRST DECSA5
	IMULI B,50	;AND LEFT-JUSTIFY IT.
	JRST DECSA3

DECSA5:	DPB B,[4000,,(A)] ;STORE THE NOW LEFT-JUSTIFIED SQUOZE
	MOVE B,(A)	;GET BACK THE SYMBOL FLAGS
	TLNE B,740000	;IF IT'S A PROGRAM NAME, WE MUST HACK AROUND
	 JRST DECSA2	;SINCE I.T.S. AND TOPS-10 HAVE DIFFERENT CONVENTIONS.
	SETZM 1(A)	;MAKE VALUE OF PROGRAM NAME BE 0 FOR DDT'S SAKE.
	JUMPE C,DECSA2	;IF WE KNOW WHERE THIS PROGRAM STARTED IN SYMTAB,
	MOVE D,(A)	;EXCHANGE THE PROGRAM NAME WITH THE ZERO SYMBOL THERE
	EXCH D,(C)
	MOVEM D,(A)
	MOVE D,1(A)
	EXCH D,1(C)
	MOVEM D,1(A)
	SETZ C,		;AND SAY THAT ZERO-SYMBOL HAS BEEN USED UP.
	JRST DECSA2

DECSA4:	HRRZ C,A	;REMEMBER ADDR OF THE ZERO SYMBOL THAT STARTS THE BLOCK,
	MOVE B,[SQUOZE 44,FOOFOO]
	MOVEM B,(A)	;AND MAKE IT NOT BE ZERO SO DDT WON'T LOSE.
DECSA2:	AOBJP A,.+1
	AOBJN A,DECSAL
	POP P,A		;GET BACK THE AOBJN TO THE COPY.
	.VALUE [ASCIZ *2/P*]	;PASS THE COPY TO DDT.
	HLRE B,.JBSYM	;RH(A) HAS START ADDR OF COPY. WILL FLUSH CORE DOWN TO THERE.
	MOVNS B
	ADD B,.JBSYM	;FIND ADDR OF 1ST WORD AFTER THE UN-COPIED SYMTAB
	ANDI B,-1
	CAMN B,.JBFF	;IF IT IS AT THE END OF USED CORE
	 SKIPE .JBDDT	;AND NO DDT NEEDS THE SYMTAB
	  JRST DECSA6
	HRRZ A,.JBSYM	;FLUSH THE SYMTAB'S CORE AS WELL AS THE COPY'S CORE.
	HRRZM A,.JBFF
	HRLM A,.JBSA
	MOVEI B,-1(A)
	HRLM B,.JBCOR
	SETZM .JBSYM
DECSA6:	MOVEI A,-1(A)
	PUSHJ P,XCORER	;NOW FLUSH THE CORE HOLDING THE COPY.
	 .LOSE
	POPJ P,

	subttl	Random CALLI Routines

XRESET:	MOVEI B,17
XRESE1:	PUSHJ P,CHRELI
	SOJGE B,XRESE1
	HLRZ A,.JBSA		;SET .JBFF FROM .JBSA
	MOVEM A,.JBFF
	MOVEI A,1
	MOVEM A,XSETU1		;SET THE SO-CALLED WRITE-PROTECT BIT
	MOVE A,PRSVEX
	iorm a,prsvrn		;prsvrn := prsvrn | prsvex | JNAME={LINK | LOADER}
	MOVE A,JOBNAM
	CAME A,['LOADER]
	 CAMN A,[SIXBIT/LINK/]
	  JRST [SETOM PRSVRN	;RUNNING LOADER => INHIBIT SUICIDE ON EXIT 1,
		SETZM TITROP	;IN CASE LOADER WAS RUN BY CCL.
		JRST .+1]
	CAME A,['CCL,,]		;ONCE WE RUN CCL, EXIT 1, SHOULD KILL THE JOB
	 CAMN A,['COMPIL]	;SINCE CUSPS LIKE TO DO EXIT 1, WHEN RUN BY CCL.
	  SETOM TITROP
	HLLZS TTYLCH		;RESET TTY I/O STATUS WORD
	SKIPE DECRN
	 POPJ P,
	PUSHJ P,SEGFLS		;THROW AWAY REMEMBERED SAIL HISEGS.
	HRLOI A,TT.ACT\TT.ILF
	ANDCAM A,TTYLCH		;RESET A COUPLE OF LIN CHARACTERISTICS BITS
	JRST TTYLM		;AND RE-INIT SPECIAL ACTIVATION TABLE.

; HIBER UUO.  The teletype input wake bits are missing because there
; is no excuse for them not to be there.  The other bits are ignored,
; since there is no WAKE, PTYs, or IPCF.

xhiber:	tlne a,(hb.rtc\hb.rtl)
	 jrst missing
	hrrzs a
	imuli a,30.
	idivi a,1000.
	.sleep a,
	aos (p)
	popj p,

XSLEEP:	IMULI A,30.
	.SLEEP A,
	POPJ P,

XDSKPP:	JUMPE A,XDSKP1
	.SUSET [.SSNAM,,A]
	MOVEM A,SNAME
	POPJ P,

XDSKP1:	MOVE A,SNAME
	JRST UPUTAC

XGETPP:	MOVE A,UNAME
	JRST UPUTAC

XSWITC:	.RDSW A,		; datai won't win w/ optdec set
	JRST UPUTAC

XPJOB:	.SUSET [.RUIND,,A]
	JRST UPUTAC

XTTYME:	MOVE B,(A)		; name of destination terminal
	TLNE B,-1		; can be sixbit or numeric
	 JRST [	XOR B,['TTY,,]
		JUMPE B,XTTYMW	; exactly TTY => win
		JRST MISSING]	; somebody will have to make TTYnn work.
	CAME B,TTYNUM
	 JRST MISSING		; trying to hack someone else's TTY?
XTTYMW:	MOVE B,1(A)
	TLNN B,770000
	 TLO B,440000		; default pointer to start of word
	LDB C,[221400,,B]	; cretinous way to pack count
	SKIPN C
	 MOVEI C,777777		; 0 means infinite
	TLZ B,7777		; set up 7 bit bp
	TLO B,0700
XTTYML:	ILDB A,B
	JUMPE A,UUOXIT
	PUSHJ P,TYO
	SOJG C,XTTYML
	JRST UUOXIT

XEXIT:	PUSHJ P,INSBOT
	MOVEI A,IO.FLS
	ANDCAM A,TTYLCH
	LDB A,[270400,,UUO40]
	JUMPE A,XEXIT0
	SKIPN DEBUG		;EXIT 1,: IF TITROP AND NOT DEBUGGING, KILL JOB
	 SKIPN TITROP		;OTHERWISE RETURN RELATIVELY QUIETLY TO DDT.
	  JRST XEXIT1		;TITROP IS SET :CCL SINCE CUSPS SEEM TO DO EXIT 1,
	SKIPN PRSVRN
	 .BREAK 16,160000
XEXIT1:	MOVE HIGHAC,[UUOACS,,LOWAC]
	BLT HIGHAC,HIGHAC
	.VALUE [ASCIZ /2:VK /]
	SETZM UUO40
	JRST 2,@UUOH

XEXIT0:	MOVSI B,-20
XEXIT2:	SETZ A,
	SETOM CHNDLE(B)
	PUSHJ P,CHCLS		;FIRST, CLOSE ALL FILES (ELSE THE RESET WOULD FLUSH THEM)
	AOBJN B,XEXIT2
	push p,prsvrn		; xreset clears prsvrn
	PUSHJ P,XRESET		;THEN CLOSE ALL DEVICES.
	.LOGOUT
	pop p,a			; get old value of prsvrn in a
	skipn a			; and see if i should suicide
	 SKIPE DEBUG
	  JRST XEXIT3
	.BREAK 16,160000
XEXIT3:	MOVEI A,^P
	PUSHJ P,STYO
	MOVEI A,"A
	PUSHJ P,STYO
	MOVE HIGHAC,[UUOACS,,LOWAC]
	BLT HIGHAC,HIGHAC
	setzm uuo40		; clear UUO in progress
.VALUE [ASCIZ /:EXIT

:vk /]
	.value [asciz/:Can't Continue

:vk /]
	jrst .-1		;never continue on EXIT 0,

;DEVCHR UUO
XDEVCH:	PUSHJ P,DEVDCD
	 JRST XRETN0
	MOVE A,DCHTAB(A)
	JUMPGE C,UPUTAC
	IORI A,200000
	JRST UPUTAC

;DEVTYP UUO
XDEVTY:	SKIPN FT5UUO
	 POPJ P,
	AOS (P)
	PUSHJ P,DEVDCD
	 JRST XRETN0
	MOVE A,DTYTAB(B)
	JUMPGE C,UPUTAC
	.SUSET [.RUIND,,B]
	LSH B,9
	IOR A,B
	JRST UPUTAC

;DEVSIZ AC,    AC/ ADDR    ADDR/ MODE ? SIXBIT/DEVICE/
XDEVSI:	SKIPN FT5UUO
	 POPJ P,
	AOS (P)		;THIS UUO ALWAYS SKIPS IFF IMPLEMENTED.
	PUSH P,A
	PUSHJ P,UGETA1	;GET 1ST WORD OF BLOCK ADDRESSED BY AC.
	MOVE D,A
	POP P,A
	AOS A
	PUSHJ P,UGETA1	;GET 2ND WORD (THE DEVICE NAME)
	PUSHJ P,DEVDCD	;DECODE IT.
	 JRST XPUTM1	;NON-EX DEVICE => RETURN -1.
	ANDI D,17	;GET THE DATA MODE SPEC'D IN 1ST WORD.
	CAIL D,.IOIDP
	 JRST XPUTA0	;DUMP MODE => RETURN 0.
	MOVEI C,1
	LSH C,(D)	;FIND BIT IN DCHTAB WORD FOR SPEC'D MODE.
	TDNN C,DCHTAB(A)
	 JRST XPUTM2	;ILLEGAL MODE => RETURN -2.
	HRRZ A,DSZTAB(A)
	HRLI A,2
	JRST UPUTAC

XPUTA0:	TDZA A,A
XPUTM1:	 MOVNI A,1
	JRST UPUTAC

XPUTM2:	MOVNI A,2
	JRST UPUTAC

;DECODE A DEVICE OR CHANNEL IN A.
;NO SKIP => ILLEGAL DEVICE OR CHANNEL NOT INITTED.
;ELSE RETURN IN B THE DEVICE NAME;  IN A, THE DEVTAB IDX;
;IN C, NEGATIVE IFF THE DEVICE IS INITTED ON ANY CHANNEL.
DEVDCD:	TDNE A,[-20]
	 JRST DEVDC1
	MOVE B,CHRDEV(A)
	SKIPN A,CHDIDX(A)
	 POPJ P,
	JRST DEVDC2

DEVDCH==0

DEVDC1:	SYSCLV TRANS,[A ? MOVEM B]
	CAME A,B		;IF SPEC'D DEVICE NAME GETS TRANSLATED,
	 JRST DEVDC3		;USER MUST MEAN TO SAY IT EXISTS.
	CAME B,['TTY,,]
	 CAMN B,['DSK,,]	;DSK: AND TTY: EXIST.
	  JRST DEVDC3
	MOVSI C,-20		;IF DEVICE IS INITTED, IT MUST EXIST.
	CAME B,CHRDEV(C)
	 AOBJN C,.-1
	JUMPL C,DEVDC3
	MOVSI C,-DEVCSL		;IF DEVICE IS IN THE ASSOCIATIVE MEMORY,
	CAME B,DEVCSH(C)
	 AOBJN C,.-1
	JUMPL C,[SKIPL DEVCS1(C)
		  POPJ P,	;THAT MEMORY SAYS WHETHER IT EXISTS.
		 JRST DEVDC3]
	HLRZ C,B
	cain c,'mta		;convert device MTA to...
	 movsi b,'mt0		; ...MT0 for ITS happiness
	CAIN C,'TTY
	 TRNN B,-1
	  JRST DEVDC5
	LSH B,14		;HE'S USING TTYnn TO SPECIFY A PARTICULAR TTY
	TLC B,<'T#'Y>_14	;SHIFT SO HAVE JUST Ynn, THEN CHANGE Y TO T.
DEVDC5:	.IOPUS DEVDCH,		;FIND OUT WHETHER DEVICE EXISTS.
	SYSCAL OPEN,[MOVEI DEVDCH ? ['DSK,,] ? ['JOBDEV] ? B ? ['DEVICE]]
	 CAIA			;THIS OPEN IS LOGICALLY SUPERFLUOUS
	  JRST DEVDC4		;BUT SAVES MUCH TIME IF DEVICE IS "ML", ETC.
	SYSCAL OPEN,[MOVEI DEVDCH ? B ? ['.FILE.] ? [SIXBIT /(DIR)/] ? 3000,,C]
	 CAIE C,%ENSDV		;ERROR IS NO SUCH DEVICE => DEVDCD FAILS.
	  JRST DEVDC4		;SUCCESS, OR LOST FOR OTHER REASON, => DEV EXISTS.
	.IOPOP DEVDCH,
	TDZA C,C		;MARK DEV IN A AS NOT EXISTING, USING DEVCSH
DEVDC8:	 SETO C,		;MARK DEV IN A AS EXISTING
	MOVE B,A
	PUSH P,E
	MOVSI E,-DEVCSL		;PUT THIS DEV IN AT FRONT, MOVING ALL OTERS DOWN
DEVDC7:	EXCH B,DEVCSH(E)
	EXCH C,DEVCS1(E)
	CAME B,DEVCSH(E)	;AND FLUSHING ANY DUPLICATE ENTRY.
	 AOBJN E,DEVDC7
	JRST POPEJ

DEVDC4:	PUSHJ P,DEVDC8		;DEV EXISTS; MARK IT SO.
	.IOPOP DEVDCH,
	MOVE B,A
DEVDC3:	MOVSI A,-DEVTLN
	CAME B,DEVTAB(A)
	 AOBJN A,.-1
DEVDC2:	MOVSI C,-20
	CAME B,CHRDEV(C)
	 AOBJN C,.-1
	JRST POPJ1

XRUNTI:	JSP B,THSJOB	;ERROR RETURN IF FOR OTHER JOB THAN THIS ONE
	 JRST XRETN0
	.SUSET [.RRUNT,,A]
	IDIVI A,250.
	JRST UPUTAC

;FOR A DEC CALL THAT TAKES A JOB # OR 0 FOR CURRENT JOB,
;JSP B,THSJOB TO COMPLAIN IF ANOTHER JOB IS SPEC'D.
;SKIPS IF CURRENT JOB IS SPEC'D.  OTHERWISE, DOESN'T SKIP
;OR GOES TO MISSING ACCORDING TO ZJOBS.
THSJOB:	JUMPE A,1(B)
THSJO1:	.SUSET [.RUIND,,C]
	CAMN A,C
	 JRST 1(B)
	SKIPE ZJOBS
	 JRST MISSING
	JRST (B)

XDATE:	MOVEI A,0
	.RDATE B,
	CAMN B,[-1]
	 JRST UPUTAC	;DATE NOT AVAILABLE
	MOVE C,[440600,,B]
	PUSHJ P,POOF	;YEAR
	SUBI D,64.	;THIS PROGRAM WILL NOT WORK IN 28 YEARS
	MOVE A,D
	IMULI A,12.
	PUSHJ P,POOF	;MONTH
	SUBI D,1
	ADD A,D
	IMULI A,31.
	PUSHJ P,POOF	;DAY
	SUBI D,1
	ADD A,D
XDATE1:	PUSHJ P,UPUTAC
	JRST UUOXIT

XTIMER:	PUSHJ P,TIME1
	IMULI A,60.
	JRST UPUTAC

XMSTIM:	PUSHJ P,TIME1	;TIME OF DAY IN SECONDS
	IMULI A,1000.
	JRST UPUTAC

;CALCULATE NUMBER SECONDS SINCE MIDNIGHT

TIME1:	MOVEI A,0
	.RTIME B,
	CAMN B,[-1]
	 JRST XDATE1	;TIME NOT AVAILABLE
	MOVE C,[440600,,B]
	PUSHJ P,POOF	;HOURS
	IMULI D,60.*60.
	MOVE A,D
	PUSHJ P,POOF	;MINUTES
	IMULI D,60.
	ADD A,D
	PUSHJ P,POOF	;SECONDS
	ADD A,D
	POPJ P,

;GOBBLES DOWN 2 SIXBIT DECIMAL DIGITS AND
;RETURNS NUMBER IN D

POOF:	ILDB D,C
	SUBI D,'0
	ILDB E,C
	SUBI E,'0
	IMULI D,10.
	ADD D,E
	POPJ P,

STORAGE IMPURE

MEMT:	0		;CURRENT TOP OF LOW SEG
HMEMT:	400000		;CURRENT TOP OF HIGH SEG

STORAGE PURE

;CORE AC,  WHERE AC HAS  <HITOP>,,<LOWTOP>, OR ZERO IN EITHER HALF FOR NO CHANGE.
;RETURNS CORMAX IN AC. SKIPS IF SUCCESSFUL.

XCORE:	MOVE B,[JRST DECS1]
	MOVEM B,BOTBEG	;SET UP 45 IN CASE LOADER HAS JUST CLOBBERED IT.
	JUMPE A,XCORE9
	SKIPN DECRN	;SAIL IGNORES THE L.H. AND HAS A SPECIAL CORE2 UUO
	 ANDI A,-1
XCOR2A:	PUSHJ P,XCORER
	 CAIA
	  AOS (P)
XCORE9:	MOVE A,CORMAX
	JRST UPUTAC

;SAIL'S CORE2 UUO - SETS HISEG SIZE.
XCOR2:	SKIPN A
	 AOSA A		;0 => KILL HISEG; CHANGE TO "MAKE IT END BELOW 400000"
	  IORI A,401777	;ELSE ROUND UP AND IGNORE BIT 2.9.
	HRLZS A		;PUT IN LH TO MAKE LOOK LIKE A DEC-STYLE SET HISEG SIZE.
	JRST XCOR2A

;"INTERNAL" CORE UUO: ARG IN A.  SKIPS/ACTS JUST LIKE CORE UUO.
XCORER:	SETZ D,		;SET UP BEG, END AND ARG FOR LOW SEG
	MOVEI B,MEMT	;AND PTR TO CURRENT SIZE
	HRRZ C,A
	PUSHJ P,XCORE1
	 JRST XCOREX
	MOVEI B,HMEMT	;THEN DO THE SAME FOR HIGH SEG
	MOVEI D,400000
	HLRZ C,A
	SKIPN TWOSEG	;IF ONLY ONE SEG ALLOWED, REFUSE TO CREATE HISEG
	 CAIGE C,400000
	  PUSHJ P,XCORE1
	   JRST XCOREX
	AOS (P)

;SET .JBREL AND .JBHRL FROM MEMT AND HMEMT
XCOREX:	MOVE A,MEMT
	SUBI A,1
	MOVEM A,.JBREL
	MOVE A,HMEMT
	CAIN A,400000
	 TDZA A,A
	  SUBI A,1
	MOVEM A,.JBHRL
	SKIPN A		;IF HISEG HAS BEEN FLUSHED, SAY IT HAS NO # ASSIGNED.
	 SETOM HSGNUM	;ELSE NEXT TIME ONE IS CREATED WE MIGHT THINK IT HAD ONE.
	SKIPN A
	 SETZM HSPURE	;FLUSHING THE HISEG => IF WE MAKE ANOTHER, IT WON'T BE PURE.
	POPJ P,

;ADJUST CORE IN ONE SEGMENT.
;B -> MEMT OR HMEMT
;C = DESIRED HIGHEST EXISTENT ADDRESS
;D = BOTTOM
;E = HIGHEST TOP SIMULATOR CAN HANDLE.
XCORE1:	JUMPE C,POPJ1
	TRO C,1777
	AOS C
	CAMG C,D	;ADJUST NEW TOP AT LEAST UP TO BOTTOM
	 MOVE C,D
	CAIL C,HIBASE
	 JRST MISSING
	CAIG C,400000
	 JRST XCORE4
	MOVEI E,MEMT+HMEMT
	SUBI E,(B)	;E -> THE ONE OF (MEMT, HMEMT) WHICH B DOESN'T POINT TO.
	MOVE E,(E)
	CAILE E,400000	;TRYING TO MAKE BOTH SEGS GO ABOVE 200K LOSES
	 JRST MISSING	;(IE, TRYING TO HAVE NONNULL HISEG NOT STARTING AT 200K)
XCORE4:	SUB C,(B)	;GET AMOUNT OF CHANGE IN WORDS
	JUMPE C,POPJ1
	JUMPL C,XCORE2	;SHRINKING...
	MOVE E,C
	ADD E,MEMT	;COMPUTE NEW TOTAL SIZE,
	ADD E,HMEMT	;AND COMPLAIN IF TOO BIG
	SUBI E,400000
	CAMLE E,CORMAX	;(TO ALLOW DEBUGGING OF NO-CORE-AVAILABLE RECOVERY)
	 POPJ P,
	MOVN E,C	;GROWING.
	HRLZS E
	HRR E,(B)	;AOBJN -> RANGE TO ACQUIRE
	MOVEI D,%CBWRT	;SAY GET IT.
XCORE3:	ASH E,-10.
	SYSCLV CORBLK,[D ? 1000,,-1 ? E ? 1000,,400001]
	ADDM C,(B)	;ADJUST MEMT OR HMEMT
	JRST POPJ1

XCORE2:	HRLZ E,C
	HRR E,(B)
	ADD E,C		;AOBJN -> RANGE TO FLUSH
	SETZ D,		;SAY FLUSH IT.
	JRST XCORE3

XSETUW:	SKIPN TWOSEG	;SETUWP PRETENDS TO WORK, BUT DOESN'T REALLY DO ANYTHING.
	 JRST XRETN0
	AOS (P)
	ANDI A,1
	EXCH A,XSETU1
	PUSHJ P,UPUTAC
	SKIPN XSETU1	;IF HE WANTS IT IMPURE, AND IT IS REALLY PURE,
	 SKIPN HSPURE
	  POPJ P,
	MOVN A,HMEMT	;MUST UNPURIFY IT, BY COPYING PAGES 1 AT A TIME.
	CAMN A,[-HIBASE]
	 JRST MISSING	;WE NEED A SCRATCH PAGE TO COPY INTO. USE THE ONE BELOW HIBASE.
	LSH A,8.	;-<1 + LAST HISEG PAGE>
	ADD A,[200,,200] ;AOBJN -> HISEG PAGES.
	MOVEI B,400000	;AND B -> 1ST ADDR OF PAGE A POINTS AT.
XSETU2:	SYSCLV CORBLK,[MOVEI %CBWRT ? MOVEI -1 ? MOVEI HIBASE/2000-1 ? MOVEI 400001]
	HRLZ C,B
	HRRI C,HIBASE-2000
	BLT C,HIBASE-1	;COPY THE DATA INTO THE FRESH PAGE, THEN REPLACE ORIGINAL PAGE.
	SYSCLV CORBLK,[MOVEI %CBWRT ? MOVEI -1 ? MOVEI (A) ? MOVEI -1 ? MOVEI HIBASE/2000-1]
	ADDI B,2000
	AOBJN A,XSETU2	;DO THIS FOR ALL THE HISEG PAGES.
	SYSCLV CORBLK,[MOVEI 0 ? MOVEI -1 ? MOVEI HIBASE/2000-1]	;CLEAN OUT SCRATCH SLOT.
	SETZM HSPURE	;HISEG NOW ISN'T REALLY PURE.
	POPJ P,

STORAGE IMPURE
XSETU1:	1		;1 => HISEG IS SUPPOSEDLY PURE (NEED NOT REALLY BE).
HSPURE:	0		;-1 => HISEG IS REALLY PURE.
STORAGE PURE


XREMAP:	SKIPN TWOSEG
	 POPJ P,
	TRO A,1777	;ROUND UP TO TOP OF A PAGE
	MOVEI A,1(A)	;GET NEW MEMT AFTER REMAPPING
	CAMLE A,MEMT
	 POPJ P,	;REMAPPING A NEGATIVE # OF WORDS?
	MOVE B,MEMT
	CAILE B,400000
	 JRST MISSING
	PUSH P,A
	MOVSI A,377777	;FLUSH ANY EXISTING HISEG.
	PUSHJ P,XCORER
	 .LOSE
	MOVE A,(P)
	SUB A,MEMT	;# OF WORDS TO REMAP
	PUSH P,A
	HRLZS A
	HRRI A,400000
	ASH A,-10.	;AOBJN PTR TO THEIR PAGES
	MOVE B,-1(P)
	LSH B,-10.	;COPY THOSE PAGES INTO HISEG
	SYSCLV CORBLK,[1000,, %CBWRT
		1000,,-1 ? A ? 1000,,-1 ? B]
	POP P,A
	MOVMS A		;GET # WORDS REMAPPED
	ADDI A,400000	;NEW HISEG TOP
	MOVEM A,HMEMT
	PUSHJ P,UGETAC
	LSH A,-35.
	SKIPE DECRN	;ON SAIL, SET WRITE-PROTECT BIT ONLY IF SIGN OF ARG SET
	 MOVEI A,1	;FOR DEC, ALWAYS SET IT.
	MOVEM A,XSETU1	;WRITE-PROTECT THE NEW SEGMENT.
	POP P,A		;ORIGINAL ARG (DESIRED LOSEG TOP) +1
	SUBI A,1	;ORIGINAL ARG TO REMAP (BUT STILL ROUNDED UP)
	JRST XCORER	;GO FLUSH THE REMAPPED CORE FROM THE LOW SEG.

;SHSNUM IS CALLED TO CREATE AN INFERIOR IN WHICH WE CAN LATER SAVE TH
;PAGES OF OUR HISEG, SO THAT THE "JOB NUMBER" OF THE HISEG CAN BE KNOWN.
;THE NUMBER IS PUT IN HSGNUM, AND ALSO IN AN ENTRY IN HSGNUT, WHICH IS
;A LIST OF THE NUMBERS OF ALL OUR HISEGS.
;SKIPS IF SUCCESSFUL.

SHSNUM:	SKIPL HSGNUM	;IF INFERIOR NOT CREATED, CREATE ONE.
	 JRST POPJ1
	.IOPUS LOADCH,
SHSNU0:	SYSCAL OPEN,[[.BIO,,LOADCH] ? ['USR,,] ? MOVEI 0 ? INFNAM ? 3000,,A]
	 CAIA
	  JRST SHSNU2
	CAIN A,%EFLDR	;DIR FULL (TOO MANY INFS)?
	 JRST SHSNUL	;IT'S HOPELESS.
	AOS INFNAM	;ELSE TRY AGAIN WITH A DIFFERENT JNAME.
	JRST SHSNU0

SHSNU2:	.USET LOADCH,[.RUIND,,A]
	MOVEM A,HSGNUM	;HISEG NUMBER NOW KNOWN.
	MOVSI B,-HSGTBL
	SKIPE HSGNUT(B)	;NOW ENTER THE NUMBER IN HSGNUT SO WE'LL REMEMBER
	 AOBJN B,.-1
	SKIPL B		;THAT WE HAVE A HISEG WITH THAT NUMBER.
	 .LOSE		;HSGNUT OUGHT TO BE BIG ENOUGH TO HOLD ALL 8 THAT WE CAN HAVE.
	MOVEM A,HSGNUT(B)
	AOS (P)
SHSNUL:	.IOPOP LOADCH,
	POPJ P,

;SWPSEG CREATES AN INFERIOR IF NECESSARY, THEN PUSHES THE HISEG PAGES INTO IT.
;SKIPS IF SUCCESSFUL.

SWPSEG:	PUSHJ P,SHSNUM	;MAKE SURE THE INFERIOR EXISTS.
	 POPJ P,
	MOVEI B,400000/2000
	MOVE A,[-<HIBASE-400000>/2000,,400000/2000]
	MOVE C,HSGNUM
	SYSCAL CORBLK,[MOVEI %CBWRT\%CBNDR ? MOVEI 400000(C) ? A ? MOVEI -1 ? B]
	 JFCL
	JRST POPJ1

;THROW AWAY ALL OUR INFERIOR HISEGS.
SEGFLS:	MOVSI A,-HSGTBL
	.IOPUS LOADCH,
SEGFL1:	SKIPN B,HSGNUT(A)
	 JRST SEGFL2
	SYSCAL OPEN,[[.BII,,LOADCH] ? ['USR,,] ? MOVEI 400000(B) ? MOVEI 0]
	 JRST SEGFL2
	.UCLOSE LOADCH,
	SETZM HSGNUT(A)
SEGFL2:	AOBJN A,SEGFL1
	SETOM HSGNUM	;OUR CURRENT HISEG, IF ANY, NOW HAS NO # ASSIGNED.
	JRST SHSNUL

;DETSEG UUO. DETACH THE CURRENT HISEG, SO THAT WE HAVE NONE, BUT THE PAGES
;ARE SWAPPED INTO AN INFERIOR.
XDETSE:	LDB A,[270400,,UUO40]
	TRNE A,1
	 JRST MISSING
	MOVE B,HMEMT
	CAIG B,400000
	 POPJ P,
	PUSHJ P,SWPSEG
	 .LOSE
	MOVSI A,377777
	PUSHJ P,XCORER
	 .LOSE
	POPJ P,

;ATTSEG UUO. SPECIFIES A HISEG THAT WE HAVE DETACHED (RIGHT NOW, BY NUMBER ONLY)
;AND GETS BACK THE PAGES OF IT, MAKING IT OUR CURRENT HISEG.
;NOT ALLOWED IF A HISEG EXISTS ALREADY.
XATTSE:	MOVE B,HMEMT
	CAIE B,400000
	 JRST XRETN4	;ERROR IF HISEG EXISTS.
	MOVE B,MEMT
	CAILE B,400000
	 JRST MISSING	;WE DON'T KNOW HOW TO HAVE HISEG NOT START AT 400000.
	TDNE A,[-100]
	 JRST MISSING	;WE DON'T KNOW HOW TO HACK SEGMENT NAMES; ONLY ALLOW #S AS ARGS.
	MOVSI B,-HSGTBL
	CAME A,HSGNUT(B)
	 AOBJN B,.-1
	JUMPGE B,XRETN2	;ERROR IF # ISN'T THAT OF ONE OF OUR HISEGS.
	MOVEM A,HSGNUM	;ELSE WE WIN; MAKE THIS HISEG CURRENT.
	MOVE B,[-<HIBASE-400000>/2000,,400000/2000]
	MOVEI C,400000/2000
	SYSCAL CORBLK,[MOVEI %CBWRT\%CBNDR ? MOVEI -1 ? B ? MOVEI 400000(A) ? C]
	 JFCL
	ANDI B,-1	;GET PAGE # OF 1ST NON-EX PAGE.
	LSH B,10.
	MOVEM B,HMEMT	;THAT IS TOP OF HISEG.
	AOS (P)
	JRST XCOREX	;THEN SET .JBHRL.

XRETN2:	SKIPA A,[2]
XRETN4:	 MOVEI A,4
	PUSHJ P,UPUTAC
	JRST UUOXIT

;SEGNUM UUO.  RETURN HISEG # IN AC, OR 0 IF NO HISEG.  TAKES JOB # OR 0 => THIS JOB
;IN AC.  MUST ASSIGN HISEG # AND CREATE INFERIOR IF THAT WASN'T DONE ALREADY.
XSGNUM:	JSP B,THSJOB
	 JRST XRETN0
	MOVE B,HMEMT
	CAIG B,400000
	 JRST XRETN0
	PUSHJ P,SHSNUM
	 .LOSE
	MOVE A,HSGNUM
	JRST UPUTAC

;DEC SYSTEM INTERRUPT BITS

;AP.REN==400000	;RE-ENABLE INTERRUPTS AUTOMATICLY
;AP.POV==200000	;PDL OVERFLOW
;AP.ABK== 40000	;ADDRESS BREAK (WE COULD USE THE MAR, BUT BETTER TO LET DDT ALONE).
;AP.ILM== 20000	;MEMORY PROTECTION
;AP.NXM== 10000	;NON EX-MEM
;AP.PAR==  4000	;PARITY ERROR
;AP.CLK==  1000	;CLOCK
;AP.FOV==   100	;FLOATING OVERFLOW
;AP.AOV==    10	;ARITHMETIC OVERFLOW

AP.OK==AP.REN+AP.POV+AP.ILM+AP.AOV+AP.FOV	;BITS THAT CAN BE HANDLED
AP.IGN==AP.NXM\AP.PAR\AP.ABK			;BITS WE CAN CLAIM TO HANDLE BUT WHICH
						 ;WILL NEVER BE SET.
AP.NUL==102667					;BITS THAT MEAN NOTHING

; SETPOV UUO is an obsolete way of trapping for PDL overflows.  This
;  is the way TEN50 does it and therefore (I presume) the way TOPS-10
;  does it.

xsetpo:	movem a,.jbapr			; ac contains routine address
	movei a,ap.pov			; load APR CONI bit for PDL OV
;	jrst xapren			; and do an APRENB

XAPREN:	TRNE A,#AP.OK#AP.IGN#AP.NUL
	 JRST MISSING
	MOVEM A,APRBIT
XAPRE1:	TRZ A,AP.REN\AP.NUL\AP.IGN	;FLUSH BITS THAT AREN'T I.T.S. INT BITS
		;NOTE WE REMEMBER HE ENABLED THEM, BUT DON'T DO ANYTHING FOR THEM.
	IORI A,%PIPDL\%PIMPV		;AND THE BITS DECUUO IS ENABLING
	SKIPE CLKENB
	 IORI A,%PICLK
	TRZE A,AP.FOV
	 TLO A,%PJFOV
	.SUSET [.SMASK,,A]		;HANDLE BOTH GROUPS.
	POPJ P,

XDDTOU:	JRST XOUTS0

XDEVPP:	PUSHJ P,DEVDCD
	 POPJ P,
	PUSHJ P,XDEVP1
	JUMPE A,CPOPJ
	AOS (P)
	JRST UPUTAC

XDEVP1:	SETZ A,
	CAMN B,['SYS,,]
	 MOVE A,['DECSYS]
	CAMN B,['COM,,]
	 MOVE A,['COMMON]
	POPJ P,

XREASS:	SKIPE ZREASS
	 JRST MISSING
	JUMPLE A,MISSING
XRETN0:	TDZA A,A
XRET1:	 MOVEI A,1
	PUSHJ P,UPUTAC
	JRST UUOXIT

;GETLIN - AC GETS EITHER DEV NAME OF TTY,
;OR RH OF DEV NAME OF MOST RECENT TTY IF THERE IS NONE NOW.
XGETLI:	MOVE A,[SIXBIT/TTY00/]
	MOVE B,TTYNUM
	DPB B,[060300,,A]	;STORE THE TTY NUMBER'S 2 DIGITS INTO THE TWO 0'S.
	LSH B,-3
	DPB B,[140300,,A]
	SKIPE TTYRN
	 ANDI A,-1
	JRST UPUTAC

XRETM2:	SKIPA A,[-2]
XRETM1:	 MOVNI A,1
	PUSHJ P,UPUTAC
	JRST UUOXIT

XSETDD:	MOVEM A,.JBDDT
	POPJ P,

XSETNA:	MOVEM A,JOBNAM
	POPJ P,

;sysstr/sysphy uuo

xsysph:				;[237] sysphy <==> sysstr
xsysst:	movsi b,-strcnt		; load number of strs
	came a,strtab(b)	; match with a str?
	 aobjn b,.-1		; not yet
	jumpge b,cpopj		; err out if not found
	aos (p)			; bump return pc
	move a,strtab+1(b)	; get next str in table
	jrst uputac		; and return

strtab:	0 ? sixbit/ai/ ? sixbit/mc/ ? sixbit/ml/ ? sixbit/dm/
strcnt==.-strtab
	0			; end of table

;GOBSTR AND JOBSTR UUOS.

XGBSTR:	TLNN A,-1
	 HRLI A,3	;# ARGS NOT SPEC'D => ASSUME 3.
	HLRZ B,A
	CAIL B,3
	 CAILE B,5
	  JRST XGBSE1
	PUSH P,A
	ANDI A,-1
	PUSHJ P,UGET3
	JUMPE A,XGBST1	;0 => SYSTEM SEARCH LIST.
	JSP B,THSJO1	;ELSE MUST BE THIS JOB
	 JRST XGBSE4	;WHAT DO WE DO IF NOT??
	HRRZ A,(P)
	PUSHJ P,UGETCI
	CAME C,SNAME
	 JRST XGBSE2	;SNAME AND JOB # DON'T MATCH??
XGBST1:	POP P,A
	ADD A,[-2,,2]	;FLUSH THE ARGS SPECIFIC TO GOBSTR, LEAVING THOSE FOR JOBSTR.
XJBSTR:	HLRZ B,A
	TRNN B,-1
	 MOVEI B,3
	ANDI A,-1
	PUSHJ P,UGETC	;GET USER'S PREVIOUS FILE STR NAME.
	MOVE D,C
	SETZ C,
	camn d,[-1]	;for -1, return machine name
	 move c,mname
	cain d,0	;for 0, return -1
	 seto c,
	came d,mname	;for machine name, return 0
	 jumpe c,xgbse3	;else it is not one of [-1,mname,0]
	PUSHJ P,UPUTC
	SETZ C,
	CAIE B,1	;UNLESS THERE'S ONLY 1 WORD IN ARG BLOCK,
	 PUSHJ P,UPUTCI	;STORE ZERO IN 2ND.
	CAIN B,3
	 PUSHJ P,UPUTCI	;STORE 0 IN 3RD IF THERE IS ONE.
	JRST POPJ1

XGBSE1:	MOVEI A,12	;WRONG # OF ARGS ERROR; RETURN CODE IN ACS.
	JRST UPUTAC

XGBSE4:	SUB P,[1,,1]	;JOB DOESN'T EXIST.  IS THIS THE RIGHT ERROR CODE??
XGBSE2:	SKIPA A,[6]	;JOB # AND PPN DON'T MATCH.
XGBSE3:	 MOVEI A,3	;ARG ISN'T A FILE STRUCTURE.
	JRST UPUTAC

XCTLJB:	SKIPE FTPTYUUO
	 JSP B,THSJOB
	  POPJ P,
	JRST XRETM1	;SAY JOB NOT CONTROLED BY PTY.

XJBSTS:	SKIPN FTPTYUUO
	 POPJ P,
	JUMPGE A,CPOPJ	;CHANNEL => GIVE ERROR RETN, SINCE CHANNEL CAN'T HAVE PTY OPEN.
	MOVNS A
	JSP B,THSJOB	;JOB # => MUST BE THIS JOB.
	 JRST XRETN0
	HRLI A,600000	;SAY THIS JOB IS RUNNING AND JOB # IS ASSIGNED.
	AOS (P)
	JRST UPUTAC

;PATH. READS THE PATH OF A CHANNEL,
;OR READS OR SETS THE DEFAULT PATH.
;AC/ NARGS,,ARG1  ARG1/ DEVNAME OR CHANNEL OR JOB,,CODE
;ARG1+1/ SCAN SWITCH  ARG1+2/ PPN   ARG1+3/ 1ST SFD NAME ... ARG1+N-1/ 0
;ARGS AFTER ARG1+NARGS-1 ARE TREATED AS 0.
XPATH.:	SKIPN FTSFD
	 POPJ P,
	PUSH P,A	;SAVE NARGS,,ARG1 FOR PUTARG
	MOVE E,A	;PUT IT IN E FOR GETARG.
	PUSHJ P,GETARG	;GET ARG1
	TDNN A,[-20]
	 JRST XPATHC	;ARG IS CHANNEL #.
	HRRE B,A
	CAML B,[-4]
	 JUMPL B,XPATHD	;ARG IS A SPECIAL CODE (-1, -2, -3 OR -4).
	POP P,E		;ARG IS A DEVICE NAME.  START PUTTING VALUES.
	PUSHJ P,DEVDCD
	 JRST XRETN0
	JUMPL A,XRETN0	;DEV NON EX OR NOT A DISK-LIKE DEV => RETURN 0.
	MOVE C,B
	PUSHJ P,PUTARG	;ELSE RETURN THE DEV NAME, THE SCAN SWITCH,
	MOVE C,PATHSS
	PUSHJ P,PUTARG
	MOVE C,SNAME	;AND THE APPROPRIATELY HACKED SNAME.
	MOVS A,B
	MOVEI B,-CHLKEN+[0]	;FAKE OUT CODE EXPECTING A CHANNEL # IN B.
	JRST XPATHA

XPATHC:	POP P,E		;NOW START PUTTING ARGS INSTEAD OF GETTING.
	SKIPG CHDIDX(A)
	 JRST XRETN0	;ERROR CODE 0 IF CHANNEL DOESN'T HAVE A DISK DEVICE OPEN.
	MOVE B,A
	MOVE C,CHRDEV(B)
	PUSHJ P,PUTARG	;PUT DEVICE NAME FIRST.
	MOVE C,PATHSS	;THEN DEFAULT SCAN SWITCH
	PUSHJ P,PUTARG
	MOVE C,CHSNAM(B) ;THEN FILE'S SNAME IF THERE IS ONE,
	SKIPN CHLKEN(B)
	 MOVE C,SNAME	;ELSE THE DEFAULT.
	MOVS A,CHRDEV(B)
XPATHA:	CAIN A,'SYS	;BUT IF DEVICE IS SYS, USE SYS.  SIMILAR FOR COM.
	 MOVE C,['DECSYS]
	CAIN A,'COM
	 MOVE C,['COMMON]
	PUSHJ P,PUTARG	;STORE THIS SNAME
	SKIPN CHLKEN(B)
	 SKIPA C,SFD	;DECIDE WHICH PATH'S SFD TO RETURN,
	  MOVE C,CHSFD(B)
	JRST XPATR3	;AND RETURN IT, FOLLOWED BY A ZERO.

XPATHD:	HLRES A		;ARG IS A SPECIAL CODE: SEE WHAT JOB THE LH SPECIFIES.
	PUSH P,B
	JUMPLE A,XPATH1	;OUT OF RANGE => SELF.
	CAIL A,MAXJ
	 JRST XPATH1
	JSP B,THSJO1	;ELSE MUST BE THIS JOB'S NUMBER.
	 JRST UUOXIT	;ELSE ERROR RETURN FROM UUO.
XPATH1:	POP P,B
	JRST XPATHT(B)	;DECODE THE SPECIAL CODE (-1, -2, -3 OR -4)

	JRST XPATRA	;-4 => RETURN THE ADDITIONAL PATH.
	JRST MISSING	;-3 => SET THE ADDITIONAL PATH.
	JRST XPATSD	;-2 => SET DEFAULT PATH.
	JRST XPATRD	;-1 => READ DEFAULT PATH.
XPATHT:	.lose

XPATRA:	SETZ C,		;READ ADDITIONAL PATH: RETURN 0, SCAN SW, 0.
	POP P,E
	PUSHJ P,PUTARG
	MOVE C,PATHSS
	PUSHJ P,PUTARG
XPATR2:	SETZ C,
	PUSHJ P,PUTARG
	JRST POPJ1

XPATRD:	SETZ C,		;READ DEFAULT: RETURN 0, SCAN SW, SNAME, 0.
	POP P,E
	PUSHJ P,PUTARG
	MOVE C,PATHSS
	PUSHJ P,PUTARG
	MOVE C,SNAME
	PUSHJ P,PUTARG
	MOVE C,SFD
XPATR3:	SKIPE C
	 PUSHJ P,PUTARG
	JRST XPATR2

XPATSD:	PUSHJ P,GETARG	;GET AND PUSH 2ND ARG
	PUSH P,A
	PUSHJ P,GETARG	;GET AND PUSH 3RD ARG
	PUSH P,A
	PUSHJ P,GETAR0	;GET AND PUSH 4TH ARG, OR 0 IF ONLY 3
	SKIPE ZSFDTRN
	 PUSH P,A
	PUSHJ P,GETAR0
	JUMPN A,XRETM1	;BETTER NOT HAVE A NONZERO 5TH ARG.
	SKIPE ZSFDTRN
	 POP P,SFD	;IF SFD TRANSLATION ENABLED, SET DEFAULT SFD.
	JUMPN A,XRETM1	;ERROR IF 4TH ARG NONZERO (A SFD IS SPEC'D).
	POP P,SNAME	;3RD ARG IS NEW DEFAULT SNAME
	POP P,PATHSS	;2ND ARG IS NEW SCAN SWITCH.
POP1J1:	SUB P,[1,,1]	;THROW AWAY PUTARG POINTER.
	JRST POPJ1

;LIKE GETARG, BUT RETURNS 0 AS THE ARG IF IT WASN'T SPEC'D, INSTEAD OF BOMBING OUT.
GETAR0:	SETZ A,
	TLNN E,-1
	 POPJ P,

;E HAS <# ARGS LEFT>,,<ADDR OF NEXT ARG>.  LOAD NEXT ARG INTO A AND ADVANCE POINTER.
GETARG:	MOVE A,E
	TLZN A,-1
	 JRST XRETN0	;RUN OUT OF ARGS => RETURN 0 FROM THE UUO.
	ADD E,[-1,,1]	;ELSE COUNT THIS ARG AND ADVANCE POINTER.
	JRST UGET3	;AND GET THE ARG INTO A.

;E HAS <# ARGS LEFT>,,<ADDR OF NEXT ARG>.  STORE C IN NEXT ARG AND ADVANCE POINTER.
PUTARG:	MOVE A,E
	TLZN A,-1
	 POPJ P,
	ADD E,[-1,,1]
	JRST UPUTC

STORAGE IMPURE
PATHSS:	0		;DEFAULT PATH SCAN SWITCH.  DOESN'T AFFECT ANYTHING
			;BUT REMEMBERED IN CASE USER SETS IT AND THEN READS IT.
STORAGE PURE

XGETTA:	HRRE E,A		;GET TABLE # IN E.
	JUMPL E,CPOPJ
	SKIPE DECRN
	 CAIL E,GETMAX
	  POPJ P,		;TABLE DOESN'T EXIST => FAIL.
	HLRES A
	MOVE C,GETTBL(E)	;TABLE IS PER JOB => CHECK THE INDEX.
	TLNN C,200000
	 JRST XGETT3
	CAMN A,[-2]		;FOR A TABLE INDEXED BY HISEG #, -2 IS OK.
	 JRST XGETT2
	JUMPGE C,GETTLS		;ELSE IF HISEG # IS ONLY ALLOWED INDEX, BARF.
XGETT3:	JUMPGE C,XGETT2
	CAMN A,[-1]		;FOR TABLES IDXD BY JOB #,
	 JRST XGETT2		;EITHER -1 OR OUR OWN JOB # IS OK.
	JSP B,THSJO1
	 JRST XRETN0
XGETT2:	LDB B,[270400,,GETTBL(E)] ;FIGURE OUT WHAT OP-CODE TO USE.
	XCT XGETTI(B)		;EXECUTE IT, WITH APPROPRIATE ADDRESS FOR THIS TABLE.
XGETT1:	AOS (P)			;SKIP AND RETURN THE CONTENTS.
	JRST UPUTAC

XGETTI:	   OFFSET -.
GT$JMP::    JRST @GETTBL(E)	;CODE FOR JRST IS ASSUMED BELOW TO BE 0.
GT$PSJ::    PUSHJ P,@GETTBL(E)
GT$MOV::    MOVE A,@GETTBL(E)
GT$MVI::    MOVEI A,@GETTBL(E)
	   OFFSET 0

GETTBL:	TRN gt$mov,[440004,,]	;.GTSTS		;JOB STATUS WORD
	TRN gt$psj,getadr	;.GTADR		;RELOCATE & PROTECT REGISTERS
	TRN GT$MOV,UNAME	;.GTPPN		;JOB'S PPN
	TRN GT$MOV,JOBNAM	;.GTPRG		;PROGRAM NAME
	SETZ GT$PSJ,GETRNT	;.GTTIM		;RUN TIME IN TICKS
	SETZ UUOXIT		;.GTKCT		;KILO-CORE-TICKS
	SETZ GT$MOV,PRIVIL	;.GTPRV		;PRIVILEGES
	TRN UUOXIT		;.GTSWP
	SETZ GETTLS		;.GTTTY
	0 GT$PSJ,GETCNF		;.GTCNF
	0 GT$PSJ,GETNSW		;.GTNSW
	UUOXIT			;.GTSDT
	SETZ GETTLS		;.GTSGN
	UUOXIT			;.GTODP
	0 GT$PSJ,GETLVD		;.GTLVD
	SETZ UUOXIT		;.GTRCT
	SETZ UUOXIT		;.GTWCT
	UUOXIT			;.GTDBS
	UUOXIT			;.GTTDB
	UUOXIT			;.GTSLF
	MOVE GT$MOV,RUNDEV	;.GTDEV
	0 gt$mov,['rnrnrn]	;.GTWSN
	SETZ GT$MVI,0		;.GTLOC		;JOB'S LOGICAL STATION #.
	UUOXIT			;.GTCOR
	UUOXIT			;.GTCOM
	SETZ GT$MOV,XUNAME	;.GTNM1		;THESE 2 ARE USER'S NAME IN SIXBIT
	SETZ GT$MVI,0		;.GTNM2		;12 CHARS IN ALL.
	SETZ UUOXIT		;.GTCNO
	SETZ UUOXIT		;.GTTMP
	SETZ GT$MOV,WATCH	;.GTWCH
	SETZ GT$MVI,0		;.GTSPL
	SETZ UUOXIT		;.GTRTD
	SETZ GT$MVI,0		;.GTLIM
	UUOXIT			;.GTQQQ
	SETZ GT$MVI,0		;.GTQJB
	UUOXIT			;.GTCM2
	UUOXIT			;.GTCRS
	UUOXIT			;.GTISC
	UUOXIT			;.GTOSC
	UUOXIT			;.GTSSC
	UUOXIT			;.GTRSP
	UUOXIT			;.GTSYS
	UUOXIT			;.GTWHY
	SETZ UUOXIT		;.GTTRQ
	UUOXIT			;.GTSPS
	GETTLS			;.GTC0C
	GETTLS			;.GTC0V
REPEAT 10.,0 GT$JMP UUOXIT	;TABLES FOR OTHER CPU'S DON'T EXIST IN THIS MONITOR.
	0 gt$psj,getfet		;.GTFET
REPEAT 16.,UUOXIT		;.GTEDN ... .GTABS
	GETTLS			;.GTCMP -- WE SHOULD USE THIS!!
REPEAT 13.,UUOXIT		;.GTVM ... .GTENQ
	GETTLS			;.GTJLT
REPEAT 4.,UUOXIT		;.GTEBT ... .GTMBR
GETMAX==.-GETTBL

GETTLS:	SKIPN ZGTTAB		;HERE FOR GETTAB'S WE CAN'T SIMULATE, THAT CAN MATTER.
	 JRST XRETN0		;EITHER FAIL OR COMPLAIN ACC. TO SWITCH.
	JRST MISSING

;VARIOUS GETTABL TABLE ROUTINES

GETRNT:	.SUSET [.RRUNT,,A]
	LSH A,-12.		;CONVERT 4.069 USEC UNITS TO 1/60 SEC UNITS.
	POPJ P,

getadr:	camn a,[-2]		;a high segment?
	 skipa a,hmemt		;yup
	  move a,memt		;nope
	movss a			;anyway, swap ourselves
	popj p,			;and return

GETLVD:	CAIL A,%LDMAX
	 JRST UUOXIT
	MOVE A,GETLVT(A)
	POPJ P,

GETLVT:	OFFSET -.
	1,,1		;%LDMFD
	'DECSYS		;%LDSYS
	'.TAPE0		;%LDFFA
	'.INFO.		;%LDHLP
	'.LPTR.		;%LDQUE
	0		;%LDSPB
	0		;%LDSTR
	0		;%LDUNI
	0		;%LDSWP
	69.		;%LDCRN
	000		;%LDSTP
	777		;%LDUFP
	2		;%LDMBN
	'DSK,,		;%LDQUS
	SIXBIT/CRASH/	;%LDCRP
	0		;%LDSFD
	000		;%LDSPP
	000		;%LDSYP
	000		;%LDSSP
	0		;%LDMNU
	100000		;%LDMXT
	'DECSYS		;%LDNEW
	'DECSYS		;%LDOLD
	'DEC,,		;%LDUMD
	2		;%LDNDB
	0		;%LDMSL
	'DECSYS		;%LDALG
	'DECSYS		;%LDBLI
	'DECSYS		;%LDFOR
	'DECSYS		;%LDMAC
	'DECSYS		;%LDUNV
	'SYS,,		;%LDPUB
	'.TECO.		;%LDTED
	'DECSYS		;%LDREL
	'DECSYS		;%LDRNO
	'DECSYS		;%LDSNO
	'.INFO.		;%LDDOC
	'DECSYS		;%LDFAI
	'DECSYS		;%LDMUS
	'DECSYS		;%LDDEC
	0		;%LDSLP
	'DECSYS		;%LDBAS
	'DECSYS		;%LDCOB
	'DECSYS		;%LDMXI
	'DECSYS		;%LDNEL
	'BACKUP		;%LDDMP
	'DECSYS		;%LDPOP
	'DECSYS		;%LDTST
	0		;%LDLSO
	0		;%LDMBR
	0		;%LDBBP
%LDMAX::	OFFSET 0

GETNSW:	CAIGE A,%NSMAX	;WE CAN ONLY HANDLE A FEW .GTNSW WORDS.
	 CAIGE A,10	;THOSE BELOW %NSCMX CONTAIN GARBAGE, SO TELL THE USER
	  JRST UUOXIT	;HIS PROGRAM IS OBSOLETE.
	XCT GETNST-10(A)
	POPJ P,

GETNST:	OFFSET 10-.
	MOVE A,CORMAX
	JRST UUOXIT
	MOVEI A,69.	;FREE VIRT CORE (GARBAGE VALUE)
	JRST UUOXIT
	JRST UUOXIT
	JRST [.RDTIM A, ? LSH A,1 ? POPJ P,]
	JRST UUOXIT
	SETZ A,
	.SUSET [.RUIND,,A]
	JRST UUOXIT
	JRST UUOXIT
	MOVSI A,<512.*2000>_-18.
REPEAT 8.,JRST UUOXIT
	MOVSI A,1
REPEAT 8.,JRST UUOXIT
%NSMAX::	OFFSET 0

;GETTAB ROUTINE FOR THE CONFIGURATION TABLE.

GETCNF:	JUMPL A,UUOXIT
	CAIL A,GETCNL
	 JRST UUOXIT
	XCT GETCNT(A)
	POPJ P,

GETCNT:	JRST GTMNM1	;%CNFG0  ;NAME OF SYSTEM IS "MIT-XX I.T.S.", XX=MACHINE NAME.
	JRST GTMNM2
	MOVE A,[ASCII /.S./]
	SETZ A,
	SETZ A,
	SETZ A,		;%CNDT0
	SETZ A,
	MOVSI A,'DSK	;%CNTAP
	JRST GTTOD	;%CNTIM
	JRST GTDATE	;%CNDAT
	setz a,		;%CNSIZ
	SETZ A,		;%CNOPR  ;WE HAVE NO OPERATOR.
	JRST UUOXIT	;%CNDEV
	MOVE A,[-MAXJ,,MAXJ]	;%CNSJN
	MOVE A,TWOSEG	;%CNTWR
	MOVE A,[641015,,500]	;%CNSTS
	MOVEI A,69.	;%CNSER
	MOVEI A,1000.	;%CNNSM
	SETZ A,		;%CNPTY
REPEAT 9,JRST UUOXIT	;%CNFRE ... %CNLNP
	MOVEI A,60200	;%CNVER (DEC 6.02 IS LATEST DEC MONITOR)
REPEAT 6,JRST UUOXIT	;%CNDSC ... %CNPUC
	SETZ A,		;%CNWHY
	MOVEI A,60.	;%CNTIC
	JRST UUOXIT	;%CNPDB
	MOVEI A,250000.	;%CNRTC
	JRST UUOXIT	;%CNCHN
	MOVEI A,20.	;%CNLMX
	SETZ A,		;%CNBMX
	SETZ A,		;%CNBMN
	jrst gettls	;%CNDTM
	MOVEI A,1	;%CNLOG
	SETZ A,		;%CNBAT
REPEAT 6,JRST GTYEAR	;%CNYER ... %CNSEC
	JRST GETTLS	;%CNGMT
	SETZ A,		;%CNDBG
	JRST UUOXIT	;%CNFRU
	JRST UUOXIT	;%CNTCM
	MOVE A,DITSVR+1	;%CNCVN -- VERSION OF DECUUO
	MOVE A,ITSVER	;%CNDVN -- VERSION OF I.T.S. (WHY NOT??)
REPEAT 12.,JRST UUOXIT	;%CNDFC ... %CNEXM
	MOVEI A,20	;%CNST2
REPEAT 3.,JRST UUOXIT	;%CNPIM ... %CNPIA
	MOVEI A,20000	;%CNMNT (GUESS WHAT!  2 MEANS I.T.S.!)
REPEAT 2.,JRST UUOXIT	;%CNOCR ... %CNOCP
	MOVEI A,2000	;%CNPGS
	MOVSI A,1	;%CNMMX
REPEAT 4.,JRST UUOXIT	;%CNNSC ... %CNHSL
	MOVSI A,2	;%CNNWC
GETCNL==.-GETCNT

%CN602==123	; LAST ONE IN 6.02

IFN GETCNL-%CN602-1,.ERR GETCNT TABLE BAD

;ROUTINES FOR ENTRIES IN THE CONFIGURATION TABLE.

GTMNM1:	LDB A,[360600,,MNAME]
	ADDI A,40
	LSH A,1
	ADD A,[ASCII /MIT-/]
	POPJ P,

GTMNM2:	LDB A,[300600,,MNAME]
	ROT A,-7
	ADD A,[ASCII /  I.T/]
	POPJ P,

GTTOD:	PUSHJ P,TIME1	;GET SECONDS SINCE MIDNIGHT
	IMULI A,60.
	POPJ P,		;RETURN JIFFIES SINCE MIDNIGHT.

GTDATE:	AOS UUOH
	JRST XDATE

CNYER==%CNYER_-18.

;GET HERE TRYNG TO READ YEAR, MONTH, DAY, HOUR, MIN OR SEC.
GTYEAR:	MOVE C,GTYERT-CNYER(A)	;DECIDE WHAT INFO TO EXTRAC FROM A, B.
	.RDATIM A,	;READ DATE AND TIME INTO A, B.
	PUSHJ P,POOF	;GOBBLE DESIRED FIELD INTO NUMBER IN D
	MOVE D,A
	POPJ P,

GTYERT:	440600,,A
	300600,,A
	140600,,A
	440600,,B
	300600,,B
	140600,,B

;gettab routine for feature table

getfet:	jumpl a,uuoxit		;barf if negative
	cail a,getftl		;too large?
	 jrst uuoxit		;lose
	move a,getftt(a)	;load the feature
	popj p,			;and return

getftt:	403			;%ftuuo
	4			;%ftrts
	440			;%ftcom
	5			;%ftacc
	0			;%fterr
	0			;%ftdeb
	30			;%ftstr
	430000			;%ftdsk
	0			;%ftscn
	0			;%ftper
getftl==.-getftt		;end of table

XLIGHT:	MOVEM A,LITES
	POPJ P,

STORAGE IMPURE
LITES:	0
STORAGE PURE

XSEEK:	SKIPN ZSEEK
	 POPJ P,
	JRST MISSING

XTMPCO:	SKIPN ZTMPCO
	 JRST XRETN0
	JRST MISSING

XDISK.:	SKIPN ZDISK.
	 JRST POPJ1
	JRST MISSING

XTRMNO:	SKIPN FT5UUO
	 POPJ P,
	JSP B,THSJOB		;REFUSE TO TRY TO HACK ANY JOB BUT SELF
	 JRST XRETN0		;IF USER WANTS NO COMPLAINTS, JUST RETURN "JOB NON-EX".
	.SUSET [.RTTY,,A]	;RETURN 200000+TTY # IF HAVE TTY, ELSE 0 AND NO SKIP
	JUMPL A,XRETN0		
	AOS (P)
	MOVEI A,200000(A)
	JRST UPUTAC

xtrmop:	skipn ztrmop
	 popj p,
	jrst missing

XDEVNA:	SKIPN FT5UUO		;ALLOW USER TO SAY UUO ISN'T IMPLEMENTED.
	 POPJ P,		;DEVNAM AC, WHERE AC HAS DEV NAME OR CHANNEL #
XPNAME:	PUSHJ P,DEVDCD		;RETURNS THE PHYSICAL DEVICE NAME, OR 0 IF NONE.
	 JRST [	SKIPN DECRN
		 POPJ P,	;SAIL'S PNAME UUO DOESN'T CHANGE AC IF NO SUCH DEV.
		JRST XRETN0]	;DEC'S DEVNAM UUO SETS AC TO 0 IN THAT CASE.
	MOVE A,B
	JRST XGETT1

XMTCHR:	SKIPN FT5UUO
	 POPJ P,
	JRST XRETM1

XMVHDR:	MOVE B,A
	LDB A,[270400,,UUO40]
	ADDI A,1
	ANDI A,17		;GET THE # OF "AC+1", WHERE AC IS WHAT WAS SPEC'D.
	PUSHJ P,UGET3		;GET ITS CONTENTS
	SKIPN CHDEV(B)
	 JRST XRET1		;RETURN 1 IF CHANNEL NOT INITTED.
	TLNE A,-1		;ELSE SET THE HEADER ADDR'S, EXCEPT THAT ARG=0
	 HLRM A,CHOHDR(B)	;IMPLIES "DON'T CHANGE THIS ONE".
	TRNE A,-1
	 HRRM A,CHIHDR(B)
	JRST POPJ1

XDEVLN:	skipn ft5uuo
	 popj p,
	pushj p,devdcd		;decode device name
	 jrst [movni a,1 ? pushj p,uputac ? jrst uuoxit]
	ldb a,[270400,,uuo40]
	aoj a,
	andi a,17		;point to ac+1
	pushj p,uget3		;get its contents
	syscal tranad,[[400003,,-1] ? [-1,,a] ? [-1,,b]]
	 popj p,		;failed somehow
	jrst popj1		; and return
XDEVST:	SKIPN FT5UUO
	 POPJ P,
	pushj p,devdcd		;decode device
	 jrst xretn0		;sigh
	move a,dsttab(a)	;get appropriate coni
	.suset [.roption,,c]	;read options
	tlz c,optdec		;allow coni to win
	.suset [.soption,,c]	; by turning off dec option
	xct a			;do the coni
	tlo c,optdec		;re-enable dec options
	.suset [.soption,,c]	;set it
	aos (p)			;set skip return
	jrst uputac		;and return

XCHKAC:	SKIPN FT5UUO
	 POPJ P,
	AOS (P)
	JRST XRETN0		;ALWAYS SAY ACCESS IS ALLOWED.

XSTUUO:	SKIPN FTSET
	 POPJ P,
	HLRZ B,A	;GET FUNCTION CODE IN B.
	CAIL B,.STMAX
	 POPJ P,
	CAIN B,.STWTC		;SETTING THE WATCH BITS IS ALLOWED.
	 JRST [	HRRZM A,WATCH
		JRST POPJ1]	;THE WATCH BITS DO NOTHING, BUT CAN BE READ BACK.
	SETZ C,
	LSHC B,-4
	ROT C,5		;GET TOP BITS IF FUNCTION CODE IN B, LOW 4 BITS (TIMES 2) IN C.
	MOVE D,XSTTAB(B)
	ROT D,2(C)	;EXTRACT THE BITS FROM XSTTAB THAT REFER TO THIS FUNCTION CODE.
	ANDI D,3
	JRST .+1(D)
	 JRST PRIV
	 SKIPN ZSTUUO
	  JRST POPJ1
	 JRST MISSING

XSTTAB: .BYTE 2		;8 CODES PER LINE; MUST HAVE .WALGN AFTER EACH GROUP OF 2 LINES.
0 ? 0 ? 0 ? 0 ? 1 ? 1 ? 1 ? 0	;CODES 0-7
0 ? 0 ? 0 ? 0 ? 0 ? 0 ? 0 ? 0	;CODES 10-17
	.WALGN
0 ? 1 ? 1 ? 1 ? 1 ? 1 ? 1 ? 1	;CODES 20-27
.STMAX==.BYTC
	.BYTE

XDSKCH:	jumpl a,xsdskc		; undocumented short dskchr(sigh)
	pushj p,ugetc		;losing way to set up names
irps quux,,[0,.dcsnm,.dculn,.dcupn,.dcuid]
	movem c,dskcht+quux	;. . .
termin
	.suset [.ruind,,dskcht+.dcsaj]
	tlnn a,-1		;expect at least 1 argument
	 hrli a,1		;well, i got an argument, didn't i?
	hlrz d,a		;get # of arguments
	caile d,.dcufs		;more than i can handle?
	 jrst uuoxit		;lose then
	movns d			;negate # of args
	soj a,			;kludge to debump a first(sigh)
	hrlz b,d		;make it an aobjn pntr
	move c,dskcht(b)	;load "dskchr" table word
	pushj p,uputci		;and save it for user
	aobjn b,.-2		;and do some more
xsdskc:	movei a,2020		;result in ac for simulated dskchr
	aos (p)			;success return
	jrst uputac		;and value return

storage impure			;thanks robt@ml!!!

dskcht:	0			;device name or something
	400000			;.dcuft := infinity
	3000.			;.dcfct := random
	3000.			;.dcunt ditto
	0			;.dcsnm
	5012,,310		;.dcuch := blocks/thing
	4000000.		;.dcusz := some random number
	1			;.dcsmt := 1 luser known by decuuo
	160			;.dcwps := what s.i.t. has
	4			;.dcspu :=  "    "     "
	0			;.dck4s := imagine no nasty swapping
	0			;.dcsaj := job #
repeat 3.,0			;.dculn ... .dcuid
	0			;.dcufs := no swapping again

storage pure			;back to pure again

	subttl	III UUO Action Routines

.PPIOT:	JUMPE B,.+2	;PPSEL
	CAIN B,1
	 jrst missing	;ppact
	CAIN B,2
	JRST .DPYPOS	;DPYPOS
	CAIN B,3
	JRST .DPYSIZ	;DPYSIZ
	CAIN B,4
	JRST .PPREL	;PPREL
	jrst missing	;don't know

.DPYPOS:
	MOVNI D,-1000
	HRRE E,UUO40
	MOVEM E,IIIPOS		;REMEMBER III COORDS OF PP
	PUSHJ P,IIICKE		; ?? meaningfull when not in DPYOUT ??
	PUSHJ P,ITOD
	MOVEM E,PPORG
	PUSHJ P,@DPYPOS(M)
	JRST UUOXIT

.DPYSI:	PUSHJ P,TTYOFF	;INHIBIT TTY INTERRUPTS WHILE WE DO THIS
	PUSH P,PPORG
	PUSHJ P,@PPFRSH(M)
	POP P,PPORG
	PUSHJ P,@DPYSIZ(M)
	HRRZ A,UUO40
	IDIVI A,1000
	CAIN A,0
	MOVEI A,1
	CAIN B,0
	MOVEI B,1
	MOVEM A,PPGLTS
	MOVEM B,PPGLSZ
	JRST TTYXIT	;ENABLE TTY INTERRUPTS AND EXIT

.PPREL==missing

.DPYCLR:
	PUSHJ P,DLCLR
	JRST UUOXIT

.UPGME:	MOVE B,CURPG
	SKIPE IIIPG(B)
	PUSHJ P,UPGCHK
	 .lose		;display protection violation
	ADD A,C		;POINTS INTO DISPLAY SPACE
	MOVE A,(A)	;III DISPLAY INSTRUCTION
	TRNN A,1	;TEXT OR RESTORE WORD...
	TRNE A,2	;OR SVW, OR LVW, OR TSS...
	JRST UPGME1	;REQUIRE NO RELOCATION
	HRRZ D,(D)	;RELOCATION BASE
	SUB C,D		;USER BASE-RELOCAION BASE
	HRLZS C
	ADD A,C
UPGME1:	PUSHJ P,UPUTAC
	JRST UUOXIT

.UPGMM:	MOVE B,CURPG
	SKIPN IIIPG(B)
	JRST UUOXIT	;FORGIVE AND FORGET
	PUSHJ P,UPGCHK
	 .lose		;illegal

;RELOCATE USER'S DISPLAY WORD TO CURRENT BASE

	CAIN M,DPYTV
	PUSHJ P,TVERASE		; CLEAR THIS PGLASS OFF TV SCREEN
	MOVE E,D	;DISPLAY SPACE ORIGIN
	ADD E,A		;POINTS INTO DISPLAY SPACE
	PUSHJ P,UGETAC	;GET DISPLAY INSTRUCITION
	PUSHJ P,@DSTOP(M)
	HRRZ D,(D)	;RELOCATION BASE
	TRNN A,1
	TRNE A,2
	JRST UPGMM1
	SUB D,C		;RELOCATION BASE-USER DISPLAY ORIGIN
	HRLZS D
	ADD A,D		;RELOCATE

;FIRST WE SAVE III PORTION OF PIECE OF GLASS IN FREE STORAGE

UPGMM1:	MOVEM A,(E)	;INTO DISPLAY SPACE
	PUSH P,DLBFP	;DESTINATION
	MOVE C,IIIPG(B)
	HLRO A,(C)
	MOVNS A		;# WORDS IN III DISPLAY LIST
	PUSH P,IIIPG(B)
	HRLM A,(P)	;# WORDS,,SOURCE
	PUSHJ P,UPGBLT

;FLUSH PIECE OF GLASS FROM DISPLAY SPACE

	PUSH P,PGBLNK
	PUSH P,IIIUPG(B)
	PUSHJ P,PGCLR	;CLEAR OUT THAT PIECE OF GLASS
	POP P,IIIUPG(B)
	POP P,PGBLNK

;NOW WE ATTACH SAVE III DISPLAY LIST TO DISPLAY SPACE

	POP P,A
	HLRZS A		;# WORDS IN III DISPLAY LIST
	POP P,C		;ORIGIN OF III DISPLAY LIST
	PUSH P,(C)	;CURRENT RELOCATION BASE
	PUSH P,DLBFP
	MOVE D,(C)
	HLLM D,(P)	;AOBJN POINTER TO III DISPLAY LIST
	MOVE D,DLBFP
	HRL D,C		;SOURCE,,DESTINATION
	ADDB A,DLBFP
	BLT D,-1(A)
	JRST IIISIM	;COMPILE 340 DISPLAY LIST

;HERE TO CHECK FOR DISPLAY PROTECTION VIOLATION
;RETURNS
;	A/ OFFSET INTO DISPLAY LIST
;	C/ USER DISPLAY ORIGIN
;	D/ DISPLAY SPACE ORIGIN

UPGCHK:	PUSHJ P,UGETAI
	HRRZ C,IIIUPG(B)
	SUB A,C		;OFFSET INTO DISPLAY LIST
	JUMPLE A,CPOPJ	;ILLEGAL
	HRRZ D,IIIPG(B)	;DISPLAY SPACE ORIGIN
	HLRO E,(D)
	MOVNS E		;LENGTH OF DISPLAY LIST
	CAMLE A,E
	POPJ P,		;ILLEGAL
	JRST POPJ1

UPGBLT:	MOVS C,-1(P)
	HRR C,DLBFP		;SOURCE,,DESTINATION
	HLRZ D,-1(P)		;# WORDS IN DISPLAY LIST
	XCT BYTES(M)		;# HALF WORDS
	EXCH D,DLFBYT
	SUBB D,DLFBYT
	JUMPGE D,UPGBL1		;JUMP IF ENOUGH ROOM IN DISPLAY SPACE
	PUSHJ P,GETHI		;NOT ENOUGH ROOM
	SKIPGE DLFBYT
	JRST .-2
UPGBL1:	HLRZ D,-1(P)
	ADDB D,DLBFP		;UPDATE FIRST FREE BYTE
	BLT C,-1(D)		;INTO DISPLAY SPACE
	POPJ P,

GETHI:	SKIPE INTFLG
	 .lose		;ppblk needs to be bigger
	PUSH P,D
	MOVEI D,1000	;GETS MORE CORE FOR DISPLAY SPACE
	SKIPE SIXSW
	MOVEI D,1001
	ADDB D,CWORD1
	.CBLK D,
	.VALUE	 .lose
	MOVEI D,2000	;# WORDS WE GET
	ADDM D,DLBFL	;# WORDS IN DISPLAY SPACE
	XCT BYTES(M)	;# BYTES
	ADDM D,DLFBYT	;# FREE BYTES
	POP P,D
	POPJ P,

.UPGIOT:
	PUSHJ P,PGCLR		;CLEAR OUT THAT PIECE OF GLASS
	SKIPGE @UUO40		;DOES HE WANT BLINKING?
	SETOM BLNKIT		;    YES
	SETZM TVBLNK(B)		; in case no blinking
	AOSE BLNKIT		;DOES HE WANT BLINKING?
	JRST UPG4
	SETOM TVBLNK(B)		;TURN ON BLINKER FOR THIS PAGE
	MOVEM B,PGBLNK		; for old 340 routines that only win on one PG
UPG4:	HRRZ A,UUO40		;POINTS TO USER DISPLAY LIST
	MOVN C,1(A)		;-# WORDS IN SAME
	JUMPE C,.PGA1
	CAMN C,[-1]
	JRST .PGA1		;NULL DISPLAY LIST
	SOJGE C,[.lose]		;ILLEGAL
	PUSH P,(A)		;POINTS TO USER DISPLAY LIST
	PUSH P,DLBFP		;ORIGIN OF III DISPLAY LIST
	HRLM C,(P)		;AOBJN POINTER INTO DISPLAY SPACE
	HRL C,(A)
	HLRZM C,IIIUPG(B)	;ORIGIN OF USER DISPLAY LIST
	PUSH P,(A)		;SOURCE
	MOVE C,1(A)
	ADDI C,1		;AN EXTRA WORD FOR A HALT AT THE END
	HRLM C,(P)		;# WORDS,,SOURCE
	PUSHJ P,UPGBLT
	POP P,(P)
	MOVE C,DLBFP		;PUT A HALT AT THE END
	SETZM -1(C)

;STATE OF STACK AT THIS POINT
;	-1(P)	CURRENT RELOCATION BASE
;	  (P)	AOBJN POINTER TO III DISPLAY LIST IN DISPLAY SPACE

IIISIM:	CAIN M,DPYTV
	 SETOM INBLNK
	PUSHJ P,UPGREL		;RELOCATE III DISPLAY PROGRAM IN DISPLAY SPACE
	HLRO C,(P)
	MOVNS C
	MOVE A,(P)
	HRL A,C			;# WORDS,,ORIGIN OF PIECE OF GLASS
	MOVEM A,IIIPG(B)
	MOVE D,PGSG		;ADD TO SORTED LIST
	AOS PGSG
	HRL A,B			;PIECE OF GLASS,,ORIGIN
	MOVEM A,PGSORT(D)
	SUB P,[2,,2]
	CAIE M,DPYTV
	JRST DO340
	AOSN TVFRSH		;NEED TO REFRESH ENTIRE SCREEN
	MOVSI B,-PGLEN		;DO ALL PGS THEN
	SKIPE IIIPG(B)		;ANYTHING THERE??
	 PUSHJ P,TVSIM
	AOBJN B,.-2
CHKBLN:	MOVEI B,PGLEN-1
	SKIPN TVBLNK(B)
	 SOJGE B,.-1
	JUMPL B,UUOXIT
	SETZM INBLNK		;AT LEAST ONE NEEDS BLINKING
	JRST UUOXIT

DO340:	CAIN C,1
	JRST .PGA1		;NULL DISPLAY PROGRAM
	PUSH P,DLBFP		;ORIGIN OF DPY DISPLAY LIST
	HRRZM A,IIIPC
	AOS IIIPC		;START DISPLAY RUNNING HERE
	SETZM DLBCNT
	SETZM IIIFLG
	AOS IIIFLG
	SETZM IIISIZ
	AOS IIISIZ
	SETZM IIIX
	SETZM IIIY
	PUSHJ P,@DPYINT(M)	;CENTER BEAM ETC.
	PUSH P,B		;MUST DO PUSH, WE MIGHT HAVE COME FROM .UPGMM

UPGLOP:	PUSHJ P,IIIINS		;EXECUTE INSTRUCTION
	MOVE A,IIIFLG
	TRNE A,1
	JRST UPGLOP		;III STILL RUNNING

	SKIPN C,DLBCNT		;III STOPPED PREPARE TO FLASH DPY
	 .lose			;no 340 code generated
	POP P,B
	PUSHJ P,@DPYEND(M)
	MOVE A,DLBCNT		;# PDP10 WORDS IN DPY LIST
	HLRZ C,IIIPG(B)
	ADD C,A
	HRLM C,IIIPG(B)		;INCLUDE DPY DISPLAY LIST IN PIECE OF GLASS
	ADDM A,DLBFP
	MOVNS A
	POP P,C			;ORIGIN OF DPY DISPLAY LIST
	HRLI A,-1(C)
	MOVSM A,DLPG(B)		;BLKO POINTER TO DPY DISPLAY LIST
	MOVEI A,DLPG(B)
	HRLM A,DLLIST(B)	;MAKE VISIBLE
.PGA1:	PUSHJ P,FLASH		;FLASH THE DPY
	CAIE M,DPYTV
	 JRST UUOXIT
	JRST CHKBLN

;HERE TO RESTART THE DISPLAY

FLASH:	CAIN M,DPYTV
	POPJ P,			;no need for diddling 340 variables
	SETOM INBLNK
	SETZM BLNTIM		;Blink throttle reset to full speed
	MOVEI A,DLLIST		;ONLY DISPLAY THOSE WHICH ARE VISIBLE
	MOVEI C,DLVIS+1
	MOVEI D,DLVIS+2
	MOVE B,[DLPP,,DLVIS+1]	;initial PPaper
	MOVEM B,DLVIS
	SETZB B,DLVIS+1
FLASH1:	MOVE A,(A)		; next BLKO ptr for PGlass
	TLNN A,-1
	JRST FLASH2		; empty
	MOVE E,A		; LH has ptr to BLKO wrd
	HRR E,D			; chain in DLVIS list
	MOVEM E,(C)
	CAMN B,PGBLNK
	MOVEM C,INBLNK		;HE WANTS THIS PIECE OF GLASS BLINKING
	ADDI D,1
	ADDI C,1
FLASH2:	TRNE A,-1
	AOJA B,FLASH1
	HLLZS -1(C)		;END OF LIST
	JRST @DSTART(M)

;dlvis:
;	[BLKO for piece of paper],,.+1
;	[BLKO for first piece of glass visible],,.+1
;	...
;	[BLKO for last piece of glass],,0

.PGIOT:	JUMPE B,.PGSEL
	CAIN B,1
	JRST .PGACT
	CAIN B,2
	JRST .PGCLR
	 jrst illins	;illuuo

.PGSEL:	HRRZ A,UUO40
	CAILE A,17
	 jrst illins	;illegal piece of glass
	MOVEM A,CURPG
	JRST UUOXIT

.PGACT:	jrst missing		;THIS CODE LOOKS WRONG
ifn 0,[
	CAIN M,DPYTV
	JRST UUOXIT
	HRRZ  A,UUO40
	MOVE B,CURPG
	SKIPN B,IIIPG(B)
	 .lose
	MOVEI C,400000
	MOVN D,CURPG
	LSH C,(D)
	PUSHJ P,@DSTOP(M)
	TLNN A,C		; ???
	JRST [	HRRZS DLLIST(B)	;MAKE INVISIBLE ??? B CLOBBERED ???
		JRST .PGA1]
	SKIPN DLPG(B)		;MAKE VISIBLE
	 .lose			;no display list
	MOVEI C,DLPG(B)
	HRLM C,DLLIST(B)
	JRST .PGA1		;flash it
];; end ifn 0

.PGCLR:	SETOM INBLNK
	SETZM BLNTIM
	MOVEI B,PGLEN-1
	PUSHJ P,PGCLR
	SOJGE B,.-1
	JRST UUOXIT

PGCLR:	PUSHJ P,@DSTOP(M)
	CAIN M,DPYTV
	PUSHJ P,TVERAS		;CLEAR THIS PG
	SETZM TVBLNK(B)	;STOP BLINKING FOR THIS PAGE
	CAMN B,PGBLNK	;WAS THIS PAGE BLINKING
	SETOM PGBLNK	;NO LONGER
	SKIPLE C,PGSG	;CHECK TO SEE IF SORTED LIST STILL VAILID
	SOJA C,PGCBLT	;WIN, DO NOT HAVE TO SORT
	JUMPE C,CPOPJ	;NO ENTRIES IN LIST, DONE
	.lose		;LIST SHOULD NEVER NEED SORTING

;SORT PHASE OVER PREPARE TO BLT
;GET HERE WITH HIGHEST VALID PGSORT INDEX IN C

PGCBLT:	PUSH P,B	;SAVE PIECE OF GLASS
	MOVEI A,0
PGCBL0:	HLRZ D,PGSORT(A);FIND OUR PIECE OF GLASS IN PGSORT
	CAMN B,D
	JRST PGCBL1	;FOUND HIM
	CAMGE A,C
	AOJA A,PGCBL0
	SKIPA A,[-1]	;NOT FOUND

;HERE WITH PIECE OF GLASS IN B AND PGSORT INDEX IN A

PGCBL1:	PUSH P,IIIPG(B)	;DESTINATION OF BLT
	SETZM IIIPG(B)
	SETZM DLPG(B)
	SETZM IIIUPG(B)
	HRRZS DLLIST(B)	;MAKE INVISIBLE
	JUMPL A,POPBJ	;JUMP IF PIECE OF GLASS NOT ACTIVE
	PUSH P,A
	PUSHJ P,@DELITM(M)
	POP P,A
	SOSG PGSG
	JRST PGCF1	;DONE IF NO ACTIVE PIECE OF GLASS
	CAMN A,PGSG
	JRST [	MOVE C,(P)	;BEGINNING OF FREE STORAGE
		JRST PGCFIN]	;NO BLT NECESSARY
	HLRZ C,(P)
	MOVNS C		;RELOCATION CONSTANT
	ADDI A,1	;SET FOR NEXT PGSORT ENTRY
	HLRZ B,PGSORT(A);PIECE OF GLASS NUMBER
	PUSH P,IIIPG(B)	;SOURCE OF BLT
	SKIPA D,[0]	;# WORDS TO BLT
PGCBL2:	HLRZ B,PGSORT(A)
	HLRZ E,IIIPG(B)
	ADD D,E
	ADDM C,IIIPG(B)
	ADDM C,DLPG(B)
	MOVE E,PGSORT(A)	;SHIFT BACK SORTED LIST
	MOVEI B,-1(A)
	ADD E,C
	MOVEM E,PGSORT(B)
	CAMGE A,PGSG
	AOJA A,PGCBL2

;FINALLY WE DO THE BLT

	POP P,B		;SOURCE
	MOVE A,(P)	;DESTINATION
	HRL A,B		;SOURCE,,DESTINATION
	MOVEI B,(A)
	ADD B,D
	BLT A,-1(B)	;WHEW!!!
	SKIPA C,B
PGCF1:	MOVEI C,HIBASE+HIUSE	;DLBFP=HIBASE+HIUSE
PGCFIN:	POP P,D		;IIIPG
	HLRZS D		;WORD COUNT
	XCT BYTES(M)	;BYTE COUNT
	ADDM D,DLFBYT	;MORE FREE BYTES
	HRRZM C,DLBFP	;NEW BUFFER
POPBJ:	POP P,B
	POPJ P,

;HERE TO RELOCATE III DISPLAY PROGRAM
;CALLED WITH TWO ARGUMENTS ON STACK
;	-2(P)	ORIGIN OF SOURCE DISPLAY LIST
;	-1(P)	AOBJN POINTER TO CURRENT DISPLAY LIST

UPGREL:	HRRZ C,-1(P)
	HRRZ A,-2(P)
	SUB C,A
	HRLZS C		;RELOCATION CONSTANT
	MOVE A,-1(P)
	CAMN A,(A)
	POPJ P,		;NO RELOCATION NECESSARY
	MOVEM A,(A)	;VALIDATE
	AOBJP A,CPOPJ	;NULL DISPLAY LIST

PGRLOP:	MOVE D,(A)
	trne d,3	;DON'T RELOCATE TEXT OR RESTORE WORD
	 jrst pgrlo1	;DON'T RELOCATE SVW(2), LVW(6), OR TSS(12)
	ADDM C,(A)	;RELOCATE ALL OTHERS
	hlrz d,(a)
	sub d,-1(p)
	trnn d,-1
	 setzm (a)
pgrlo1:	AOBJN A,PGRLOP
	POPJ P,


	subttl	III Display Simulator

IIIINS:	MOVE A,@IIIPC		;INSTRUCTION
	AOS IIIPC		;INCREMENT PC
	TRNE A,1
	JRST @CHR(M)		;CHARACTER MODE
	LDB B,[010300,,A]	;DISPATCH ON NEXT 3 BITS
	MOVSS A			;PUT ADDRESS IN RIGHT HALF
	JRST @.+1(B)

		JMPHLT	; 0 JMP(20) OR HALT(0)
		SVW	; 2 SHORT VECTOR WORD
		JMSJSR	; 4 JMS(4), JSR(24), OR SAVE(64)
		LVW	; 6 LONG VECTOR WORD
		ILLINS	;10 ILLEGAL INSTRUCTION
		TSS	;12 TEST SET AND SKIP
		REST	;14 RESTORE
		ILLINS	;16 ILLEGAL INSTRUCTION

illins==illuuo

IIIUPK:	LDB B,[IIIXBP,,A]	;X	UNPACKS III STATUS WORD
	PUSHJ P,IIILNM
	MOVE D,B
	LDB B,[IIIYBP,,A]	;Y
	PUSHJ P,IIILNM
	MOVE E,B
	LDB B,[IIIBBP,,A]	;BRIGHTNESS
	CAIE B,0
	MOVEM B,IIIBRT
	LDB B,[IIISBP,,A]	;SIZE
	CAIE B,0
	MOVEM B,IIISIZ
	POPJ P,

;MASK TO USE IN $T MODE IN DDT TO TYPE OUT III INSTUCTIONS

LVWMSK==777600034260	;X(11),Y(11),BRT(3),SIZ(3),UNUSD(1),MODE(1),T(2),OPCD(4)
SVWMSK==774014017717	;DX1(7),DY1(7),T1(2),DX2(7),DY(2),T2(2),OPCD(4)
TSSMSK==776003774057	;RESET(8),SET(8),TEST(8),UNUSD(7),I(1),OPCD(4)
STSMSK==776000343400	;X(11),Y(11),BRT(3),SIZ(3),FLGS(8)

;SOME HANDY BYTE POINTERS

IIIXBP==311300	;POINTS TO X FIELD IN POSITION WORD
IIIYBP==161300	;Y FIELD
IIIBBP==130300	;BRIGHTNESS
IIISBP==100300	;SIZE
IIIFBP==001000	;FLAGS

JMPHLT:	TLNN A,20
	JRST HLT
JMP:	HRRZM A,IIIPC		;JUMP
	POPJ P,

JMSJSR:	TLNN A,20
	JRST ILLINS		;JMS ILLEGAL
	TLNN A,40
	JRST XJSR		;JSR
	MOVE B,IIIX		;HERE TO EXECUTE SAVE INSTRUCTION
	DPB B,[IIIXBP,,C]	;X
	MOVE B,IIIY
	DPB B,[IIIYBP,,C]	;Y
	MOVE B,IIIBRT
	DPB B,[IIIBBP,,C]	;BRIGHTNESS
	MOVE B,IIISIZ
	DPB B,[IIISBP,,C]	;SIZE
	MOVE B,IIIFLG
	DPB B,[IIIFBP,,C]	;FLAGS
	MOVEM C,(A)
	POPJ P,

XJSR:	HRLZ C,IIIPC
	IORI C,20
	MOVEM C,(A)
	AOJA A,JMP		;DO THE JUMP

HLT:	MOVEI A,1		;CLEAR RUNNING FLAG
	ANDCAM A,IIIFLG
	POPJ P,

IIILNM:	TRNE B,2000		;NORMALIZE LONG VECTOR COORDINATE TO 36 BITS
	TDO B,[-1,,776000]
	POPJ P,

IIISNM:	TRNE B,100		;NORMALIZE SHORT VECTOR COORDINATE TO 36 BITS
	TDO B,[-1,,777600]
	POPJ P,

REST:	MOVE C,(A)
	TRNN C,1
	 .lose			;running flag not set
	TLNN A,40
	JRST RESTFL
	PUSH P,A
	PUSH P,C
	MOVE A,C
	PUSHJ P,IIIUPK
	SUB D,IIIX
	SUB E,IIIY
	MOVEI B,2		;DO INVISIBLE SET POINT
	PUSHJ P,ASVW
	POP P,C
	POP P,A
RESTFL:	TLNN A,20
	POPJ P,
	LDB B,[IIIFBP,,C]	;RESTORE FLAGS
	MOVEM B,IIIFLG
	POPJ P,

TSS:	MOVSS A			;GET A BACK INTO ORIGINAL SHAPE
TV.TSS:	MOVEI D,0		;NONE SKIP CONDITION
	LDB B,[141000,,A]	;SKIP BITS
	MOVE E,IIIFLG		;MANIPULATE FLAGS IN E
	PUSHJ P,TSS1		;SWAP BITS TO USE TSS NOMENCLATURE
	TDNE E,B
	MOVEI D,1		;SET SKIP CONDITION
	MOVEI B,1		;NOW TO DECIDE WHETHER TO SKIP OR NOT
	TRNN A,20
	MOVEI B,0
	XOR D,B			;SKIP CONDITION AND BIT 31 OF INSTUCTION
	TRNE D,1
	AOS IIIPC		;SKIP!!!!
	LDB B,[341000,,A]	;RESET BITS
	LDB C,[241000,,A]	;SET BITS
	MOVE D,C
	AND D,B			;COMPLEMENT BITS IN D
	TRZ B,(D)		;ZERO COMPLEMENT BITS IN SET AND RESET
	TRZ C,(D)
	TRZ E,(B)		;RESET
	TRO E,(C)		;SET
	TRC E,(D)		;COMPLEMENT
	PUSHJ P,TSS1
	TRO E,1			;ALWAYS RUNNING
	MOVEM E,IIIFLG
	POPJ P,

TSS1:	TRCE E,11	;INTERCHANGE WRAP AROUND AND NOT RUNNING MASK
	TRCE E,11
	TRCE E,11
	POPJ P,

SVW:	MOVSS A			;GET THE RIGHT ORDER
	LDB B,[350700,,A]	;DX1
	PUSHJ P,IIISNM		;NORMALIZE
	MOVE D,B
	LDB B,[260700,,A]	;DY1
	PUSHJ P,IIISNM
	MOVE E,B
	LDB B,[240200,,A]	;T1
	PUSHJ P,ASVW		;ACTION ROUTINE
	LDB B,[150700,,A]	;DX2
	PUSHJ P,IIISNM
	MOVE D,B
	LDB B,[060700,,A]	;DY2
	PUSHJ P,IIISNM
	MOVE E,B
	LDB B,[040200,,A]	;T2
ASVW:	PUSH P,A
	CAIN B,3		;CALLED WITH MODE IN B, (X AND Y) IN (D AND E)
	 .lose			;undefined
	ADDM D,IIIX
	ADDM E,IIIY
	PUSHJ P,IIICKE		;CHECK EDGE OVERFLOW
	JUMPE B,@SVW2(M)	;WANTS TO DRAW VECTOR
	JRST @SVW1(M)		;DO POINT

LVW:	MOVSS A			;RIGHT ORDER
	PUSHJ P,IIIUPK		;UNPACK STATUS REGISTER
	LDB B,[040200,,A]	;TYPE
	TRNN A,100
	JRST LVW0		;RELATIVE MODE
	SUB D,IIIX
	SUB E,IIIY
LVW0:	JUMPN B,ASVW		;JUMP IF NOT VECTOR

LVW1:	PUSHJ P,LVWCHK		;CHECK TO SEE THAT THE 340 CAN HACK IT
	JRST ASVW		;VECTOR SHORT ENOUGH, NO HASSLE
	JRST @LVW2(M)		;DO A LONG VECTOR

IIICKE:	PUSH P,D	;CHECK FOR EDGE OVERFLOW
	MOVE D,IIIX
	PUSHJ P,IIICK1
	MOVE D,IIIY
	PUSHJ P,IIICK1
	POP P,D
	POPJ P,

IIICK1:	CAMGE D,[1000]
	CAMGE D,[-1000]
	JRST .+2
	POPJ P,		;OKAY
	MOVEI D,40
	IORM D,IIIFLG	;SET EDGE OVERFLOW
	POPJ P,

ITOD:	ADDI D,1000	;SHIFT FROM III COORDINATES TO 340
	ADDI E,1000
	SKIPGE D	;CLIP IF NECESSARY
	MOVEI D,0
	SKIPGE E
	MOVEI E,0
	CAML D,[2000]
	MOVEI D,1777
	CAML E,[2000]
	MOVEI E,1777
	POPJ P,

LVWCHK:	CAMGE E,SYMAX(M)
	CAMG E,SYMIN(M)
	JRST POPJ1	;VECTOR TOO LONG FOR 340
	CAMGE D,SXMAX(M)
	CAMG D,SXMIN(M)
	JRST POPJ1
	POPJ P,

ADBYTE:	SOSGE DLFBYTE	;DISPLAY LIST FREE BYTES
	PUSHJ P,GETHI	;OVERFLOW
	AOS DLBCNT	;BYTE COUNT
	IDPB A,DLPC	;HALF WORD INTO DISPLAY LIST
	POPJ P,


SGNMAG:	JUMPGE D,SGNM1	;CONVERT TO SIGN MAGNITUDE
	MOVNS D
	IOR D,A		;SIGN BIT
SGNM1:	JUMPGE E,CPOPJ
	MOVNS E
	IOR E,A
	POPJ P,

CHRSET:	MOVEI B,5	;7 BIT CHARACTERS PER WORD
	MOVEI A,@IIIPC
	SUBI A,1	;PC HAS BEEN ALREADY AOSED
	HRLI A,440700
	MOVEM A,IIIBP	;BYTE POINTER
	POPJ P,

CHRPOS:	MOVE D,IIISIZ	;GET CHARACTER SIZE
	HRRZ E,STAB(D)
	HLRZ D,STAB(D)
	MOVNS E
	CAIE A,15
	JRST DCHP0A
	MOVNI D,1000	;CARRIAGE RETURN GOES ALL THE WAY
	MOVEM D,IIIX
	JRST DCHP0
DCHP0A:	CAIN A,12	;LINE FEED
	JRST [	ADDM E,IIIY
		JRST DCHP0]
	ADDM D,IIIX
DCHP0:	PUSHJ P,IIICKE	;CHECK EDGE OVERFLOW
	POPJ P,

;STAB INDEXED BY CHARACTER SIZE
;TABLE ENTRY:	DX,,DY
;THE GOSPEL ACCORDING TO HELLIWELL:  CURSOR ENDS AT BOTTOM RIGHT OF CHARACTER

STAB:	0	;0 ILLEGAL
	10,,20	;1
	12,,24	;2
	14,,30	;3
	20,,40	;4
	30,,60	;5
	40,,100	;6
	60,,140	;7


	subttl	Display Type Dispatch Tables

;ALL OF THESE TABLES ARE INDEXED ON M
;	-1	NO DISPLAY
;	 0	DEC 340
;	 1	GT-40
;	 2	TV DISPLAY

	CPOPJ
DSTOP:	STP340	;STOPS DISPLAY
	CPOPJ
	CPOPJ

	CPOPJ
DSTART:	STRT34	;STARTS DISPLAY
	STRTGT
	CPOPJ

	CPOPJ
DPYINT:	INT340	;INITIALIZE DISPLAY LIST
	INTGT
	CPOPJ

	CPOPJ
DPYEND:	END340	;CLOSE DISPLAY LIST
	ENDGT
	CPOPJ

	CPOPJ
DPYCLR:	CLR340	;INTIALIZE PIECE OF GLASS VARIABLES
	CLRGT
	CLRTV

	CPOPJ
DELITM:	CPOPJ	;DELETES A PIECE OF GLASS FROM DISPLAY LIST
	DELIGT
	CPOPJ

	CPOPJ
DPYSIZ:	DPYP1
	SIZGT
	CPOPJ

	CPOPJ
DPYPOS:	DPYP2
	POSGT
	TVPOS

	CPOPJ
PPFRSH:	PPFR34	;CLEARS ALL PIECES OF PAPER
	PPFRGT
	CPOPJ

	JFCL
BYTES:	ASH D,1	;CONVERTS # WORDS IN D TO # BYTES
	ASH D,1
	JFCL

	JRST 4,.
SVW1:	SVW134	;DOES SET POINT (B=1 FOR VISIBLE, ELSE INVISIBLE)
	SVW1GT
	JRST 4,.

	JRST 4,.
SVW2:	SVW234	;DRAWS SHORT VECTOR
	SVW2GT
	JRST 4,.

	JRST 4,.
LVW2:	LVW234	;DRAWS LONG VECTOR
	LVW2GT
	JRST 4,.

	JRST 4,.
CHR:	CHR340	;CHARACTERS
	CHRGT
	JRST 4,.

	JRST 4,.
PPTYO:	PPTY34	;PIECE OF PAPER TYO
	PPTYGT
	TVTYO

	0
SXMAX:	200
	100
	0

	0
SXMIN:	-200
	-100
	0

	0
SYMAX:	200
	100
	0

	0
SYMIN:	-200
	-100
	0

	subttl	TV Display Stuff

TVW==576.		;number of points in line
TVV==454.		;number of lines on screen
NECHO==3		; echo lines at bottom of TV screen

; SIMULATE III BUFFER IN PGlass B

TVSIM:	AOSN TVPURE		; Attempting a recursive call to this impure code??
	SKIPN IIIPG(B)
	 .lose
	PUSH P,A
	PUSH P,B		;SAVE PIECE OF GLASS #
	PUSH P,C
	PUSH P,D
	PUSH P,E
	HRRZ A,IIIPG(B)
	HRRZ C,(A)
	CAME A,C		;1ST WORD SHOULD POINT TO SELF IF RELOCATED RIGHT
	JRST [	MOVE A,IIIPG(B)
		PUSH P,(A)		;OLD RELOCATION ADDRESS
		HLL A,(A)		; COPY IN OLD AOBJN COUNT
		PUSH P,A		; NEW RELOCATION
		PUSHJ P,UPGREL
		SUB P,[2,,2]
		JRST .+1]
	HRRZ A,IIIPG(B)
	AOJ A,
	MOVEM A,IIIPC
	MOVEI A,1
	MOVEM A,IIIFLG
	MOVEM A,IIISIZ
;	SETZM IIIX		; Drawing prgm expects X and Y to be
;	SETZM IIIY		; miraculously saved between PG's
	SETCMM TVPHAS(B)	;SCREEN IS NOW IN OTHER CLR/SET STATE
	MOVEM B,TVPG		;SAVE TO ALLOW THE SET UP OF THE CONSOLE REGISTER
TVLUP:	MOVEI A,TVSET
	DPB A,TVALU
	MOVE A,@IIIPC
	AOS IIIPC
	TRNE A,1
	JRST TVCHR
	LDB B,[10300,,A]
	JRST @.+1(B)
	 [	TRNE A,20
		JRST TVJMP
		SETOM TVPURE	;WERE OUT OF IMPURE CODE NOW.
		POP P,E
		POP P,D
		POP P,C
		POP P,B
		POP P,A
		POPJ P,]
	 TVSVW			; SHORT VECTOR
	 TVJSR
	 TVLVW			; LONG VECTOR
	 TVILL
	 TVTSS			;TEST AND SKIP
	 TVRESTORE
	 TVILL


; III LONG VECTOR

TVLVW:	LDB B,[IIISBP,,A]	;LONG VECTOR (IN A)
	SKIPE B
	MOVEM B,IIISIZ
	LDB B,[IIIXBP,,A]
	LDB D,[IIIYBP,,A]
	TRNE B,2000
	ORCMI B,3777			;EXTEND SIGN
	TRNE D,2000
	ORCMI D,3777
	TRNE A,100
	JRST [	SUB B,IIIX
		SUB D,IIIY
		SUBI D,1000-TVV		;MAKE ACTUAL TOP OF SCREEN APPEAR AS 1000
		JRST .+1]
	PUSHJ P,TVREL
EDGECK:	MOVEI A,40		; Edge overflow flag
	SKIPL XOFF
	SKIPGE YOFF
	IORM A,IIIFLG
	JRST TVLUP

TVREL:	LDB E,[40200,,A]		;type
	JRST @TVDISP(E)
TVDISP:	TVVECT				;VISIBLE VECTOR
	TVPOINT				;END POINT
	TVINVIS				;INVISIBLE
	TVPOINT

TVPOINT:	TDZA E,E
TVINVIS:	SETO E,
	ADDB B,IIIX
	ADDB D,IIIY
	SETZM XOFF			;ASSUME X,Y ARE ON SCREEN
	SETZM YOFF
	CAML B,[-TVW]
	CAIL B,TVW
	SETOB E,XOFF			;X IS OFF
	CAML D,[-TVV]
	CAIL D,TVV
	SETOB E,YOFF			;Y IS OFF
	JUMPN E,CPOPJ		;invisible or off screen
	MOVNS D				;LOWER PART OF SCREEN IS HIGHER IN CORE
	ADDI D,TVV			;OFFSET SO 0,0 IS IN MIDDLE
	LSH D,-1			;2 III PTS 1 TV PT
	IMULI D,18.			; 18 WDS PER TV LINE
	ADDI B,TVW
	IDIVI B,32.*2			;CONVERT X TO WORD, BIT # (*2)
	ADD D,B				; WORD ADDRESSED
	MOVE E,TVBIT(C)
	XORM E,TVBUF(D)
	POPJ P,


TVVECT:	JUMPE B,TVVERT			;X DELTA=0, TRY ALL VERTICAL VECTOR
	JUMPE D,TVHORZ			;Y DELTA=0
	MOVEM B,DX			;NEITHER=0, DO HARD CASE BY DDA
	MOVEM D,DY
	SKIPL E,XOFF
	MOVE E,YOFF			; REMEMBER IF STARTING PT IS OFF SCREEN
	SETZM XOFF
	SETZM YOFF
	ADD B,IIIX
	ADD D,IIIY
	CAML B,[-TVW]			; IS END POINT OFF??
	CAIL B,TVW
	SETOB E,XOFF
	CAML D,[-TVV]
	CAIL D,TVV
	SETOB E,YOFF
	EXCH B,IIIX			; update x,y
	EXCH D,IIIY
	JUMPL E,CPOPJ
	ADDI B,TVW
	IDIVI B,32.*2
	MOVNS D
	ADDI D,TVV
	ASH D,-1
	IMULI D,18.
	ADD D,B
	MOVE E,TVBIT(C)
	MOVM A,DX
	MOVM B,DY
	CAMGE A,B		;x is major axis??
	JRST STEPY
	HRLZS B			;dda rate has binary point in 2.9
	IDIV B,A			; dy/dx
	MOVEM B,RATE
	MOVM B,DX		;iteration count
	ASH B,-1	;<	;III PTS -> TV PTS
	MOVEI A,200000		;dda accumulator starts at 1/4
VX:	SKIPGE DX
	JRST [	ROT E,1			;step x axis
		TRNN E,17
		JRST VX1
		MOVEI E,20
		soja d,VX1]
	ROT E,-1
	TRNN E,17
	JRST VX1
	AOJ D,
	MOVSI E,400000
VX1:	ADD A,RATE
	SKIPGE DY
	JRST [	TLZE A,1	;step -y
		ADDI D,18.
		XORM E,TVBUF(D)
;		trne a,400000
;		xorm e,tvbuf+18.(d)
		SOJG B,VX
		POPJ P,]
	TLZE A,1
	SUBI D,18.
	XORM E,TVBUF(D)
;	trne a,400000
;	xorm e,tvbuf-18.(d)
	SOJG B,VX
	POPJ P,

;Major axis of vector is Y

STEPY:	HRLZS A
	IDIV A,B			; dx/dy
	MOVEM A,RATE
	MOVM B,DY
	ASH B,-1
	MOVEI A,200000
VY:	SKIPGE DY			; step in y axis
	ADDI D,18.
	SKIPL DY
	SUBI D,18.
	ADD A,RATE
	SKIPL DX
	JRST VYRITE
	TLZN A,1			;now step x if dda carried
	JRST VYR
	ROT E,1
	TRNN E,17			;bit wrapped past left edge?
	JRST VYR
	SOJ D,				; step to next word
	MOVEI E,20
VYR:	XORM E,TVBUF(D)
;	trnn a,400000
;	jrst vyr1
;	move c,e
;	rot c,1
;	trne c,17
;	jrst [	movei c,20
;		xorm c,tvbuf-1(d)
;		jrst vyr1]
;	xorm c,tvbuf(d)
VYR1:	SOJG B,VY
	POPJ P,

VYRITE:	TLZN A,1			;minor axis (x) steps right
	JRST VYL
	ROT E,-1
	TRNN E,17
	JRST VYL
	AOJ D,
	MOVSI E,400000
VYL:	XORM E,TVBUF(D)
;	trnn a,400000
;	jrst vyr1
;	move c,e
;	rot c,-1
;	trne c,17
;	jrst [	movsi c,400000
;		xorm c,tvbuf+1(d)
;		jrst vyr1]
;	xorm c,tvbuf(d)
	JRST VYR1

; Vector is horizontal only
; B = delta X
TVHORZ:	MOVE D,B	;d has delta x
	ADDB B,IIIX
	JUMPL D,[	MOVMS D
		JRST .+2]
	SUB B,D		;leftmost x
	ADDI B,TVW		;offset to center
	SETZM XOFF
	JUMPGE B,HON	;on screen
	ADD D,B		;will we get on during vector
	JUMPL D,TVXOFF	;nope
	SETZ B,
HON:	CAIL B,TVW*2
	JRST TVXOFF
	SKIPGE YOFF
	POPJ P,
	MOVEI C,TVW*2-1
	SUB C,B		;steps to right edge
	CAMLE D,C
	SETOM XOFF
	CAMLE D,C
	MOVE D,C	;only step up to right edge
	IDIVI B,32.*2	;iii pointswords,bits*2
	MOVN E,IIIY
	ADDI E,TVV
	LSH E,-1
	IMULI E,18.
	ADD B,E
	MOVE E,C
	ADD E,D		;delta+bit position
	CAIGE E,32.*2
	JRST [	MOVE E,TVMASK(E)	;fits in one word
		ANDCA E,TVMASK(C)	;mask off bits beyond right edge of vector
		XORM E,TVBUF(B)
		POPJ P,]
	MOVE C,TVMASK(C)
	XORM C,TVBUF(B)
	MOVNI D,20		;all ones to tv11
TVH1:	SUBI E,32.*2
	CAIL E,32.*2
	JRST [	XORM D,TVBUF+1(B)
		AOJA B,TVH1]
	SETCM C,TVMASK(E)	;left over bits
	TRZ C,17
	XORM C,TVBUF+1(B)
	POPJ P,


; vector is strictly vertical
; D = delta Y

TVVERT:	SKIPN B,D
	POPJ P,
	ADDB B,IIIY
	JUMPL D,[MOVNS D	;b now has small of pair of points
		ADD B,D		;get what will eventually be topmost point
		JRST .+1]
	MOVNS B			;make +y the top of the screen
	ADDI B,TVV
	SETZM YOFF
	JUMPGE B,VON
	ADD D,B
	JUMPL D,TVYOFF
	SETZ B,
VON:	CAIL B,TVV*2
	JRST TVYOFF
	SKIPGE XOFF
	POPJ P,
	MOVEI C,TVV*2-1
	SUB C,B
	CAMLE D,C
	SETOM YOFF		;will run off
	CAML D,C
	MOVE D,C
	MOVE E,B		;y position
	LSH E,-1
	IMULI E,18.		;   " in words
	MOVE B,IIIX
	ADDI B,TVW
	IDIVI B,32.*2
	ADD B,E
	ASH D,-1
	MOVE C,TVBIT(C)
	XORM C,TVBUF(B)
	ADDI B,18.
	SOJG D,.-2
	POPJ P,

; displays word of packed ascii

TVCHR:	MOVE C,TVPG		;THE PIECE OF GLASS WE'RE PROCESSING
	MOVEI B,TVOR
	SKIPGE TVMODE(C)	; CAN WE JUST WRITE CHARACTERS IN SOLID??
	MOVEI B,TVXOR		; NO, WE'LL HAVE TO ERASE SOMETIME
	DPB B,TVALU		; setup character store instructions
	HRRZ B,IIISIZ
	HLRZ B,STAB(B)		;real iii character spacing
	CAIN B,10		; typical scale (which is too small!)
	MOVEI B,6*2		;best we can do for now
	MOVEM B,TVSTEP
	HRRZ A,IIIPC
	SOJ A,
	HRLI A,440700
TVCHRL:	ILDB B,A
	JUMPE B,TVCH3
	CAIN B,15
	JRST [	MOVNI B,-TVW		;reset to left edge
		MOVEM B,IIIX
		SETZM XOFF
		JRST TVCH1]
	CAIN B,12
	JRST [	HRRZ C,IIISIZ
		HRRZ B,STAB(C)		;vertical spacing in this size
		MOVNS B
		ADDB B,IIIY
		CAMGE B,[-TVV]
		SETOM YOFF
		JRST TVCH1]
	SKIPL YOFF
	SKIPGE XOFF
	JRST TVCH1
	IMULI B,5.		;font entries are 5 words each
	HRLI B,-5.
	MOVE C,IIIX
	ADDI C,TVW
	IDIVI C,32.*2		; horizontal C=word, D=bit*2
	MOVN E,IIIY		; III coordinates
	ADDI E,TVV-8.*2		; line address*2, offset up to top line of char
	SKIPGE E		;character might not quite fit at the top
	SETZ E,			;why not gronk it down a little
	ASH E,-1		; line number for top of character
	CAML E,tvbot1		; is top of character just down in echo area?
	JRST TVCH1		; yes, don't display
				; but otherwise the bottom line will probably fit too
	IMULI E,18.		; word address for line that will have top of char
	ADD C,E			; add in address within line
	MOVNS D			; bits to right that character is offset (*2)
	ASH D,-1
	SUBI D,4		;extra 4 shifts to close gap at low end of word
	HRRM D,TVLSH		;shift character right by x bit position
TVCH2:	MOVE D,FONT(B)		; LH first row, RH second row
	TRZ D,-1
	SETZ E,
	LSHC D,@TVLSH
	LSH D,4
;	caile c,<tvpags*2000>-2
;	jrst .+3		;character off screen
	MOVEM D,TVBUF(C)	;either XORM or IORM
	MOVEM E,TVBUF+1(C)
	HRLZ D,FONT(B)
	SETZ E,
	LSHC D,@TVLSH
	LSH D,4
	ADDI C,18.
;	caile c,<tvpags*2000>-2
;	jrst .+3		;character off screen
	MOVEM D,TVBUF(C)
	MOVEM E,TVBUF+1(C)
	ADDI C,18.
	AOBJN B,TVCH2
TVCH1:	SETZM XOFF
	MOVE B,TVSTEP
	ADDB B,IIIX
	CAML B,[-TVW]
	CAIL B,TVW
	SETOM XOFF
TVCH3:	TLNE A,760000
	JRST TVCHRL
	JRST TVLUP


; III short vector word

TVSVW:	PUSH P,A		;SAFE PLACE
	LDB B,[350700,,A]
	LDB D,[260700,,A]
	TRNE B,100
	ORCMI B,77
	TRNE D,100
	ORCMI D,77
	LDB E,[240200,,A]
	PUSHJ P,@TVDISP(E)
	POP P,A
	LDB B,[150700,,A]
	LDB D,[60700,,A]
	TRNE B,100
	ORCMI B,77
	TRNE D,100
	ORCMI D,77
	PUSHJ P,TVREL
	JRST EDGECK

; III test and skip

TVTSS:	PUSHJ P,TV.TSS		;TEST SKIP
	JRST TVLUP

TVILL:	.lose

; III restore instruction

TVRESTORE:
	HLRZ C,A
	MOVE C,(C)
	LDB B,[IIIFBP,,C]
	TRNE A,20		;RESTORE FLAGS?
	MOVEM B,IIIFLG
	TRNN A,40	;restore x,y
	JRST TVLUP
	MOVE A,C	;look like vector
	TRO A,146	;absolute invis
	JRST TVLVW

; III SAVE instruction

TVSAV:	SETZ C,
	MOVE B,IIIX
	DPB B,[IIIXBP,,C]
	MOVE B,IIIY
	DPB B,[IIIYBP,,C]
	MOVE B,IIISIZ
	DPB B,[IIISBP,,C]
	MOVE B,IIIFLG
	DPB B,[IIIFBP,,C]
	TRO C,1		;make into a safe dpy wrd (character)
	HLRZ B,A
	MOVEM C,(B)
	JRST TVLUP

; III jsr

TVJSR:	TRNE A,40	;save = 64
	JRST TVSAV
	HLRZ B,A
	HRLZ C,IIIPC
	TRO C,20
	MOVEM C,(B)
	JRST TVLUP

; III jmp

TVJMP:	HLRZM A,IIIPC
	JRST TVLUP


; Clear screen, erase PGlass

ZEROS:	BLOCK 4*18.

CLRTV:	SYSCLV SCML,[TTYICH ? 1000,,0]	; RESET TO 0 ECHO LINES
TVCLR:	PUSH P,A
	PUSH P,B
	SETOM INBLNK
	SETOM TVFRSH		; NEED TO UPDATE ALL PGLASS NOW
	SETZM TVPHAS		; ALL PG'S ARE IN CLEAR MODE NOW.
	MOVE A,[TVPHAS,,TVPHAS+1]
	BLT A,TVPHAS+PGLEN-1
	MOVEI A,TVBUF
TVCLR1:	MOVE B,A
	HRLI B,ZEROS
	BLT B,4*18.-1(A)
	ADDI A,4*18.
	camge a,tvbot2		; don't clear bottom echo area
	JRST TVCLR1
	POP P,B
	JRST POPAJ

TVERASE:
	SETOM INBLNK		;STOP BLINKER, FOR GOD'S SAKE
	SKIPL TVFRSH		;ALREADY CLEARED WHOLE SCREEN
	SKIPN IIIPG(B)
	POPJ P,
	SKIPL TVMODE(B)		; AN XOR TYPE PGLASS??
	JRST TVCLR
	SKIPE TVPHAS(B)		; AND FORTUNATELY NOW IN CLEAR STATE
	JRST TVSIM		; HAVE TO WIPE IT OUT
	POPJ P,			; SERENDIPITY

TVXOFF:	SETOM XOFF
	POPJ P,

TVYOFF:	SETOM YOFF
	POPJ P,

TVPOS:	SETZ B,
	SKIPGE IIIPOS		;PPaper in top half??
	SYSCLV SCML,[TTYICH ? CNECHO]	; SET NUMBER OF ECHO LINES
	POPJ P,

storage impure
cnecho:	necho			; Number of echo lines
tvbotm==<necho>*10.+8.		; leave echo lines and who line
tvbot1:	tvv-tvbotm		; tv bottom value #1
tvbot2:	tvbuf+<tvw/32.>*<tvv-tvbotm>
storage pure

TVTYO:	CAIN A,20		; CHECK FOR ^P LOSSAGE
	 JRST [	PUSHJ P,STVTYO
		MOVEI A,120
		JRST STVTYO]
STVTYO:	SYSCLV IOT,[TTYOCH ? A ? 5000,,400]
	POPJ P,

TVI==<-1,,777760>
TVII==TVI
TVMASK:	REPEAT 40,[
	TVI
	TVI
	TVI==<TVI_-1>&TVII
]

TVI==<400000,,0>
TVBIT:	REPEAT 40,[
	TVI
	TVI
	TVI==TVI_-1
]

; TV font tables - !!! Note that this is the Stanford character set !!!
font:
000000,,000000?000000,,000000?000000,,000000?000000,,000000?000000,,000000  ; 0
000000,,100000?100000,,100000?100000,,520000?340000,,100000?000000,,000000  ; 
000000,,000000?000000,,320000?440000,,440000?440000,,320000?000000,,000000  ; 
000000,,000000?000000,,340000?420000,,740000?420000,,740000?400000,,400000  ; 3
000000,,000000?000000,,100000?240000,,420000?000000,,000000?000000,,000000  ; 
000000,,000000?000000,,000000?760000,,020000?000000,,000000?000000,,000000  ; 
000000,,000000?000000,,140000?200000,,340000?200000,,140000?000000,,000000  ; 
000000,,000000?000000,,760000?240000,,240000?240000,,240000?000000,,000000  ; 
;10
000000,,000000?400000,,400000?200000,,100000?240000,,420000?000000,,000000  ; 10
700000,,200000?200000,,200000?000000,,140000?120000,,140000?120000,,140000  ; 11
400000,,400000?400000,,700000?000000,,160000?100000,,140000?100000,,000000  ; 12
500000,,500000?500000,,200000?000000,,160000?040000,,040000?040000,,000000  ; v.t.
;000000,,100000?340000,,520000?100000,,100000?100000,,100000?000000,,000000  ; 
000000,,100000?100000,,760000?100000,,100000?760000,,000000?000000,,000000  ; 14
340000,,400000?400000,,340000?000000,,340000?220000,,340000?220000,,220000  ; 15
000000,,000000?000000,,240000?520000,,520000?240000,,000000?000000,,000000  ; 
000000,,300000?040000,,020000?360000,,420000?420000,,340000?000000,,000000  ; 
;20
000000,,000000?360000,,400000?400000,,400000?360000,,000000?000000,,000000  ; 
000000,,000000?740000,,020000?020000,,020000?740000,,000000?000000,,000000  ; 
000000,,000000?340000,,420000?420000,,420000?000000,,000000?000000,,000000  ; 
000000,,000000?420000,,420000?420000,,340000?000000,,000000?000000,,000000  ; 
000000,,420000?420000,,760000?420000,,240000?240000,,100000?000000,,000000  ; 
000000,,760000?020000,,020000?360000,,020000?020000,,760000?000000,,000000  ; 
000000,,000000?340000,,660000?520000,,660000?340000,,000000?000000,,000000  ; 
000000,,100000?040000,,760000?040000,,100000?200000,,760000?200000,,100000  ; 
;30
000000,,000000?000000,,000000?000000,,000000?000000,,000000?000000,,760000  ; _
;000000,,000000?100000,,200000?760000,,200000?100000,,000000?000000,,000000  ; 
000000,,000000?100000,,040000?760000,,040000?100000,,000000?000000,,000000  ; 
320000,,540000?000000,,000000?000000,,000000?000000,,000000?000000,,000000  ; TILDA
;000000,,020000?040000,,760000?100000,,760000?200000,,400000?000000,,000000  ; 
000000,,020000?040000,,760000?100000,,760000?200000,,400000?000000,,000000  ; 
;000000,,100000?100000,,240000?420000,,240000?100000,,100000?000000,,000000  ; 
000000,,040000?100000,,200000?100000,,040000?000000,,340000?000000,,000000  ; 
000000,,200000?100000,,040000?100000,,200000?000000,,340000?000000,,000000  ; 
000000,,000000?760000,,000000?760000,,000000?760000,,000000?000000,,000000  ; 
000000,,000000?000000,,420000?240000,,100000?000000,,000000?000000,,000000  ; 

;40
000000,,000000?000000,,000000?000000,,000000?000000,,000000?000000,,000000  ;  
000000,,100000?100000,,100000?100000,,100000?000000,,100000?000000,,000000  ; !
240000,,240000?240000,,000000?000000,,000000?000000,,000000?000000,,000000  ; "
000000,,000000?240000,,760000?240000,,240000?760000,,240000?000000,,000000  ; #
100000,,340000?520000,,500000?340000,,120000?520000,,340000?100000,,000000  ; $
000000,,760000?620000,,040000?100000,,200000?460000,,460000?000000,,000000  ; %
000000,,200000?500000,,500000?200000,,520000?440000,,320000?000000,,000000  ; &
300000,,300000?600000,,000000?000000,,000000?000000,,000000?000000,,000000  ; '
;50
000000,,020000?040000,,100000?100000,,100000?040000,,020000?000000,,000000  ; (
000000,,400000?200000,,100000?100000,,100000?200000,,400000?000000,,000000  ; )
000000,,100000?520000,,340000?100000,,340000?520000,,100000?000000,,000000  ; *
000000,,000000?100000,,100000?760000,,100000?100000,,000000?000000,,000000  ; +
000000,,000000?000000,,000000?000000,,000000?300000,,300000?600000,,000000  ; ,
000000,,000000?000000,,000000?760000,,000000?000000,,000000?000000,,000000  ; -
000000,,000000?000000,,000000?000000,,000000?300000,,300000?000000,,000000  ; .
000000,,000000?020000,,040000?100000,,200000?400000,,000000?000000,,000000  ; /
;60
000000,,340000?420000,,460000?520000,,620000?420000,,340000?000000,,000000  ; 0
000000,,100000?300000,,100000?100000,,100000?100000,,340000?000000,,000000  ; 1
000000,,340000?420000,,020000?040000,,100000?200000,,760000?000000,,000000  ; 2
000000,,340000?420000,,020000?140000,,020000?420000,,340000?000000,,000000  ; 3
000000,,040000?140000,,240000?440000,,760000?040000,,040000?000000,,000000  ; 4
000000,,760000?400000,,740000?020000,,020000?420000,,340000?000000,,000000  ; 5
000000,,140000?200000,,400000?740000,,420000?420000,,340000?000000,,000000  ; 6
000000,,760000?020000,,040000?040000,,100000?100000,,100000?000000,,000000  ; 7
;70
000000,,340000?420000,,420000?340000,,420000?420000,,340000?000000,,000000  ; 8
000000,,340000?420000,,420000?360000,,020000?040000,,300000?000000,,000000  ; 9
000000,,000000?000000,,300000?300000,,000000?300000,,300000?000000,,000000  ; :
000000,,000000?000000,,300000?300000,,000000?300000,,300000?600000,,000000  ; ;
000000,,000000?040000,,100000?200000,,100000?040000,,000000?000000,,000000  ; <
000000,,000000?000000,,760000?000000,,760000?000000,,000000?000000,,000000  ; =
000000,,000000?200000,,100000?040000,,100000?200000,,000000?000000,,000000  ; >
000000,,340000?420000,,040000?100000,,100000?000000,,100000?000000,,000000  ; ?

;100
000000,,340000?420000,,560000?520000,,560000?400000,,340000?000000,,000000  ; @
000000,,340000?420000,,420000?760000,,420000?420000,,420000?000000,,000000  ; A
000000,,740000?420000,,420000?740000,,420000?420000,,740000?000000,,000000  ; B
000000,,340000?420000,,400000?400000,,400000?420000,,340000?000000,,000000  ; C
000000,,740000?220000,,220000?220000,,220000?220000,,740000?000000,,000000  ; D
000000,,760000?400000,,400000?740000,,400000?400000,,760000?000000,,000000  ; E
000000,,760000?400000,,400000?740000,,400000?400000,,400000?000000,,000000  ; F
000000,,340000?420000,,400000?400000,,460000?420000,,340000?000000,,000000  ; G
;110
000000,,420000?420000,,420000?760000,,420000?420000,,420000?000000,,000000  ; H
000000,,340000?100000,,100000?100000,,100000?100000,,340000?000000,,000000  ; I
000000,,020000?020000,,020000?020000,,020000?420000,,340000?000000,,000000  ; J
000000,,420000?440000,,500000?600000,,500000?440000,,420000?000000,,000000  ; K
000000,,400000?400000,,400000?400000,,400000?400000,,760000?000000,,000000  ; L
000000,,420000?660000,,520000?420000,,420000?420000,,420000?000000,,000000  ; M
000000,,420000?420000,,620000?520000,,460000?420000,,420000?000000,,000000  ; N
000000,,340000?420000,,420000?420000,,420000?420000,,340000?000000,,000000  ; O
;120
000000,,740000?420000,,420000?740000,,400000?400000,,400000?000000,,000000  ; P
000000,,340000?420000,,420000?420000,,520000?440000,,320000?000000,,000000  ; Q
000000,,740000?420000,,420000?740000,,500000?440000,,420000?000000,,000000  ; R
000000,,340000?420000,,400000?340000,,020000?420000,,340000?000000,,000000  ; S
000000,,760000?100000,,100000?100000,,100000?100000,,100000?000000,,000000  ; T
000000,,420000?420000,,420000?420000,,420000?420000,,340000?000000,,000000  ; U
000000,,420000?420000,,420000?420000,,240000?240000,,100000?000000,,000000  ; V
000000,,420000?420000,,420000?420000,,520000?660000,,420000?000000,,000000  ; W
;130
000000,,420000?420000,,240000?100000,,240000?420000,,420000?000000,,000000  ; X
000000,,420000?420000,,240000?100000,,100000?100000,,100000?000000,,000000  ; Y
000000,,760000?020000,,040000?760000,,200000?400000,,760000?000000,,000000  ; Z
160000,,100000?100000,,100000?100000,,100000?100000,,100000?160000,,000000  ; [
000000,,000000?400000,,200000?100000,,040000?020000,,000000?000000,,000000  ; \
700000,,100000?100000,,100000?100000,,100000?100000,,100000?700000,,000000  ; ]
000000,,100000?340000,,520000?100000,,100000?100000,,100000?000000,,000000  ; 
;100000,,240000?420000,,000000?000000,,000000?000000,,000000?000000,,000000  ; ^
000000,,000000?100000,,200000?760000,,200000?100000,,000000?000000,,000000  ; 
;000000,,000000?000000,,000000?000000,,000000?000000,,000000?000000,,760000  ; _

;140
140000,,140000?060000,,000000?000000,,000000?000000,,000000?000000,,000000  ; `
000000,,000000?000000,,340000?020000,,360000?420000,,360000?000000,,000000  ; a
000000,,400000?400000,,740000?420000,,420000?420000,,740000?000000,,000000  ; b
000000,,000000?000000,,340000?420000,,400000?400000,,360000?000000,,000000  ; c
000000,,020000?020000,,360000?420000,,420000?420000,,360000?000000,,000000  ; d
000000,,000000?000000,,340000?420000,,740000?400000,,340000?000000,,000000  ; e
000000,,140000?220000,,200000?700000,,200000?200000,,200000?000000,,000000  ; f
000000,,000000?000000,,340000?420000,,420000?420000,,360000?020000,,340000  ; g
;150
000000,,400000?400000,,740000?420000,,420000?420000,,420000?000000,,000000  ; h
000000,,000000?100000,,000000?100000,,100000?100000,,100000?000000,,000000  ; i
000000,,000000?020000,,000000?020000,,020000?020000,,020000?420000,,340000  ; j
000000,,400000?400000,,420000?440000,,700000?440000,,420000?000000,,000000  ; k
000000,,100000?100000,,100000?100000,,100000?100000,,100000?000000,,000000  ; l
000000,,000000?000000,,640000?520000,,520000?520000,,520000?000000,,000000  ; m
000000,,000000?000000,,540000?620000,,420000?420000,,420000?000000,,000000  ; n
000000,,000000?000000,,340000?420000,,420000?420000,,340000?000000,,000000  ; o
;160
000000,,000000?000000,,740000?420000,,420000?420000,,740000?400000,,400000  ; p
000000,,000000?000000,,340000?420000,,420000?420000,,360000?020000,,020000  ; q
000000,,000000?000000,,540000?620000,,400000?400000,,400000?000000,,000000  ; r
000000,,000000?000000,,360000?400000,,340000?020000,,740000?000000,,000000  ; s
000000,,100000?100000,,760000?100000,,100000?100000,,060000?000000,,000000  ; t
000000,,000000?000000,,420000?420000,,420000?420000,,340000?000000,,000000  ; u
000000,,000000?000000,,420000?420000,,420000?240000,,100000?000000,,000000  ; v
000000,,000000?000000,,420000?420000,,520000?520000,,240000?000000,,000000  ; w
;170
000000,,000000?000000,,420000?240000,,100000?240000,,420000?000000,,000000  ; x
000000,,000000?000000,,420000?420000,,420000?240000,,100000?200000,,400000  ; y
000000,,000000?000000,,760000?040000,,340000?200000,,760000?000000,,000000  ; z
020000,,040000?040000,,040000?100000,,040000?040000,,040000?020000,,000000  ; {
100000,,100000?100000,,100000?100000,,100000?100000,,100000?100000,,100000  ; |
000000,,100000?100000,,240000?420000,,240000?100000,,100000?000000,,000000  ; 
;400000,,200000?200000,,200000?100000,,200000?200000,,200000?400000,,000000  ; }
400000,,200000?200000,,200000?100000,,200000?200000,,200000?400000,,000000  ; CLOSE BRACE
;320000,,540000?000000,,000000?000000,,000000?000000,,000000?000000,,000000  ; TILDA
760000,,760000?760000,,760000?760000,,760000?760000,,760000?760000,,760000  ; 177

	subttl	340 Display Routines

;HANDY MACROS

DEFINE DLWORD(MODE,LITPEN,STOP,SCALE,INTENS)
<.BYTE -18.,-2,3,2,2,-2,3,4
 MODE+0 ? LITPEN+0 ? STOP+0 ? SCALE+0 ? INTENS+0>TERMIN

DEFINE DLPOINT(POS,MODE,LITPEN,INTENS,COORD)
<.BYTE -18.,-1,1,3,2,1,10.
 POS+0 ? MODE+0 ? LITPEN+0 ? INTENS+0 ? COORD+0>TERMIN

;INITIALIZE ALL VARIABLES CONCERNED WITH PIECES OF PAPER

CHR340:	MOVEI C,3	;TEST FOR CHARACTER
	CAMN C,DLMODE
	JRST CHR1	;ALREADY IN CHARACTER MODE
	PUSHJ P,GETPAR	;GET 340 INTO PARAMETER MODE
	MOVEM C,DLMODE	;ENTER CHARACTER MODE
	MOVE A,IIISIZ
	MOVE A,SIZTAB(A)
	PUSHJ P,ADBYTE	;REFLECT IT IN DISPLAY LIST
	PUSHJ P,DCHSET	;SET UP BUFFER POINTERS FOR CHARACTER MODE
	SETOM DCHCAS	;START WITH SHIFT IN
	MOVEI A,35
	PUSHJ P,DCHPT1
CHR1:	PUSHJ P,CHRSET
CHR2:	ILDB A,IIIBP	;CHARACTER
	SKIPE A
	PUSHJ P,DCHPUT	;MAP ASCII TO 340 CODE AND SALT AWAY
	SOJG B,CHR2
	POPJ P,

DCHOUT:	PUSH P,A
	PUSHJ P,DCHP1
	SKIPE DCHCAS	;BELL MEANS UNPRINTABLE CONTROL CHARACTER
	JRST POPAJ	;CAN'T BE BELL, WRONG CASE
	LDB A,DCHBP	;THE CHARACTER WE JUST WROTE
	CAIE A,63
	JRST POPAJ	;ITS NOT BELL!!
	POP P,A
	TDZ A,[-1,,777600]
	ADDI A,100	;MAKE IT UPPER CASE
	JRST DCHP1	;DISPLAY AND RETURN

;HERE TO SALT AWAT AN ASCII CHARACTER INTO 340 DISPLAY LIST

DCHPUT:	CAIN A,11
	POPJ P,		;TAB DOES NOTHING
	PUSHJ P,CHRPOS	;UPDATE CURSOR POSITION
DCHP1:	PUSHJ P,DCHMAP	;MAP CHARACTER, DOES CASE SHIFTING
DCHPT1:	IDPB A,DCHBP
	SOSLE DCHCNT
	POPJ P,
DCHSET:	MOVE A,DLPC	;SET UP CHARACTER BYTE POINTER
	MOVEM A,DCHBP
	MOVEI A,6
	DPB A,[300600,,DCHBP]	;SWITCH TO 6 BIT BYTES
	MOVEI A,3	;CHARACTER COUNTER FOR HALF WORD
	MOVEM A,DCHCNT
	MOVEI A,373737	;ESCAPE FROM CHARACTER MODE
	JRST ADBYTE

DCHMAP:	TDZ A,[-1,,777600]	;CLEAR THOSE RANDOM BITS
	TRZE A,100	;TAKES ASCII IN A AND RETURNS 340 CODE
	SKIPA A,CTAB(A)
	MOVS A,CTAB(A)	;CONTROL CHARACTER
	TRNE A,200
	POPJ P,		;DON'T CARE ABOUT CASE
	SKIPE DCHCAS	;SKIPS ON SHIFT OUT
	JRST [	TRNE A,100	;ALREADY SHIFT IN
		POPJ P,		;YES
		PUSH P,[36]	;SWITCH TO SHIFT OUT
		JRST DCHM1]
	TRNN A,100
	POPJ P,		;ALREADY SHIFT OUT
	PUSH P,[35]	;SWITCH TO SHIFT IN
DCHM1:	SETCMM DCHCAS	;SWITCH CASE
	EXCH A,(P)	;SHIFT CODE
	PUSHJ P,DCHPT1	;OUTPUT THE SHIFT CODE
	JRST POPAJ	;OUT GOES THE CHARACTER CODE

;CTAB INDEXED BY 6 LOW ORDER BITS OF CHARACTER
;TABLE ENTRY:	CONTROL,,NON-CONTROL
;1.7 SHIFT IN=1, SHIFT OUT=0
;1.8 DON'T CARE=1

CTAB:	0,,100		;NULL,,@
	50,,101		;DOWN ARROW,,A
	63,,102		;ALPHA(BELL),,B
	63,,103		;BETA(BELL),,C
	41,,104		;AND,,D
	43,,105		;NOT,,E
	63,,106		;EPSILON(BELL),,F
	63,,107		;PI(BELL),,G
	63,,110		;LAMBDA(BELL),,H
	240,,111	;TAB(NOTHING),,I
	233,,112	;LF,,J
	0,,113		;VT(NOTHING),,K
	0,,114		;FF(NOTHING),,L
	234,,115	;CR,,M
	57,,116		;INF(CENTER DOT),,N
	63,,117		;DELTA(BELL),,O
	45,,120		;SUBSET,,P
	44,,121		;SUPERSET,,Q
	63,,122		;INTERSECTION(BELL),,R
	63,,123		;UNION(BELL),,S
	63,,124		;FOR ALL(BELL),,T
	63,,125		;THERE EXISTS(BELL),,U
	63,,126		;XOR(BELL),,V
	63,,127		;SWAP(BELL),,W
	60,,130		;_,,X
	47,,131		;FORWARD,,Y
	43,,132		;TILDE,,Z
	63,,53		;NEQ(BELL),,[
	63,,52		;LEQ(BELL,,\
	63,,54		;GEQ(BELL),,]
	63,,46		;EQUIV(BELL),,^
	42,,51		;OR,,_
	240,,66		;SPACE,,ACCENT GRAVE
REPEAT 32,140+.RPCNT,,.RPCNT
	173,,55		;;,,OPEN CURLY
	174,,62		;LESS THAN,,VERTICAL BAR
	175,,56		;=,,CLOSE CURLY
	176,,43		;GREATER THAN,,TILDE
	177,,52		;?,,\

SIZTAB:

REPEAT 5,	DLWORD(3,0,0,5,17)
REPEAT 2,	DLWORD(3,0,0,6,17)
		DLWORD(3,0,0,7,17)

PPFR34:	SETZM DLPP
	SETZM DLPP6
	MOVEI A,<PPBKL-PPHDL>*2
	MOVEM A,PPFBYT
	MOVEI A,PPHDL*2
	MOVEM PPBCNT
	MOVE A,[222200,,PPBLK+PPHDL]
	MOVEM A,PPPC
	MOVE A,[000600,,PPBLK+PPHDL-1]
	MOVEM A,PPCHBP
	MOVEI A,3
	MOVEM A,PCHCNT
	SETZM PCHCAS
	SETZM GLTFUL
	SETZM GLTLF
	MOVEI A,4
	MOVEM A,PPGLSZ
	MOVEI A,5
	MOVEM A,PPGLTS
	MOVEI A,1777	;TOP OF SCREEN IN 340 COORDINATES
	MOVEM A,PPORG
	SETZM PPBLK
	MOVE A,[PPBLK,,PPBLK+1]
	BLT A,PPBLK+PPBKL-1
	PUSHJ P,DPYP1
	MOVEI A,333436		;CR, LF, SHIFT OUT
	HRRM A,PPBLK+PPHDL-1
	MOVSI A,373737
	MOVEM A,PPBLK+PPHDL
	MOVE A,[-PPHDL-1,,PPBLK-1]	;BLKO POINTER TO PPBLK
	MOVEM A,DLPP
	MOVEM A,DLPP6
	POPJ P,

;TTY OUTPUT GOES TO 340

DEFINE SWAPB(VAR1,VAR2)
	EXCH A,VAR1
	EXCH A,VAR2
	EXCH A,VAR1
TERMIN

PPTY34:	PUSH P,B
	PUSH P,A
	PUSHJ P,TTYOFF
	PUSHJ P,SWPGPP
	PUSHJ P,DCHOUT
	MOVE A,(P)
	TRZ A,600	;CLEAR OUT THE GARBAGE
	CAIN A,12
	PUSHJ P,PPLF
	POP P,A
	HRRZ B,DLPC	;LAST ACTIVE WORD IN BUFFER
	SUBI B,PPBLK-1	;NUMBER OF ACTIVE WORDS IN BUFFER
	MOVNS B
	HRLI B,PPBLK-1
	MOVSM B,DLPP	;BLKO POINTER TO PPBLK
	MOVSM B,DLPP6
	POP P,B
	PUSHJ P,SWPGPP
	JRST TTYON

SWPGPP:	SWAPB(PPFBYT,DLFBYT)
	SWAPB(PPBCNT,DLBCNT)
	SWAPB(PPPC,DLPC)
	SWAPB(PPCHBP,DCHBP)
	SWAPB(PCHCNT,DCHCNT)
	SWAPB(PCHCAS,DCHCAS)
	POPJ P,

PPLF:	AOS B,GLTLF
	CAMGE B,PPGLSZ
	POPJ P,		;MORE LINES LEFT IN GLITCH
	SETZM DLPP	;DON'T DISPLAY TEXT FOR A WHILE
	SETZM DLPP6
	SETZB A,GLTLF
	PUSHJ P,DCHP1
PPLF1:	MOVEI A,0
	HLRZ B,DCHBP
	CAIE B,600
	JRST [	PUSHJ P,DCHP1	;ALIGN GLITCHES ON FULLWORD WITH SHIFT OUT
		JRST PPLF1]
	AOS B,GLTFUL
	CAMGE B,PPGLTS
	POPJ P,		;STILL UNFILLED GLITCHES
	MOVE B,[600,,PPBLK+PPHDL-1]
	MOVEI C,0
PPLF2:	ILDB A,B	;FLUSH THE FIRST GLITCH
	CAIE A,33	;LINE FEED
	JRST PPLF2
	ADDI C,1
	CAMGE C,PPGLSZ	;END OF GLITCH?
	JRST PPLF2	;NO
	ILDB A,B
	CAIE A,0
	ILDB A,B
	CAIE A,0
	 .lose		;glitch must end with lf (so) 0
	ADDI B,1	;POINTS TO BEGINNING OF NEXT GLITCH
	HRLI B,PPBLK+PPHDL
	MOVS A,B	;SOURCE,,DESTINATION
	HRRZ C,B
	SUBI C,@DLPC
	MOVNS C
	MOVEI D,PPBLK+PPHDL(C)	;DESTINATION OF BLT
	HLRZ C,B
	SUBI C,(B)
	ADDM C,DCHBP	;UPDATE BYTE POINTERS
	ADDM C,DLPC
	ASH C,1		;HALF WORDS
	ADDM C,DLBCNT
	MOVNS C		;MAKE C POSITIVE
	ADDM C,DLFBYT
	BLT A,(D)	;ZAP
	ADDI D,1	;POINTS TO FIRST FREE WORD OF BUFFER
	SETZM (D)	;ZERO THE REST OF THE BUFFER
	HRLI D,1(D)
	MOVSS D
	BLT D,PPBLK+PPBKL-1
	POPJ P,

DPYP1:	MOVE A,[DLWORD(1,0,0,5,17)]
	HRLM A,PPBLK
	MOVE A,[DLPOINT(0,1,0,0,0)]
	HRRM A,PPBLK
DPYP2:	MOVE A,[DLPOINT(1,3,0,0,0)]
	IOR A,PPORG
	HRLM A,PPBLK+1
	POPJ P,

CLR340:	SETZM DLSIZE		;INITIALIZE 340 VARIABLES
	SETZM DLPG
	MOVE A,[DLPG,,DLPG+1]
	BLT A,DLPG+PGPPLN-1	;CLEAR 340 PIECES OF GLASS
	POPJ P,

INT340:	HRRZ A,DLBFP
	SUBI A,1
	HRLI A,002200
	MOVEM A,DLPC		;BYTE POINTER INTO 340 DISPLAY LIST
	SETZM DLMODE
	MOVE A,[DLWORD(1,0,0,4,17)]	;POINT MODE, SIZE 0, AND BRIGHTEST
	PUSHJ P,CENT0		;CENTER BEAM
	POPJ P,

END340:	MOVEI A,0		;340 NO-OP
	PUSHJ P,ADBYTE
	PUSHJ P,ADBYTE
	TRNE C,1
	PUSHJ P,ADBYTE		;MAKE DISPLAY LIST END ON FULL WORD
	MOVE A,DLBCNT
	LSH A,-1
	MOVEM A,DLBCNT
	POPJ P,

;HERE TO CENTER THE BEAM

	MOVEI A,1
	CAMN A,DLMODE
	JRST CENT1
	PUSHJ P,GETPAR
	MOVE A,[DLWORD(1,0,0,4,0)]
CENT0:	PUSHJ P,ADBYTE		;SET SCALE 0, AND ENTER POINT MODE
	AOS DLMODE		;SET POINT MODE
CENT1:	MOVE A,[DLPOINT(0,1,0,0,1000)]
	PUSHJ P,ADBYTE		;X
	MOVE A,[DLPOINT(1,1,0,0,1000)]
	JRST ADBYTE		;Y


STP340:	SETZM DLSTOP
	.DSTOP
	POPJ P,

STRT34:	SKIPE SIXSW
	JRST [	MOVE A,[DLPP,,DLPP6]	;WE GOT THE PDP-6, DON'T DSTART
		BLT A,DLPP6+PGPPLN-1
		JRST FLASH3]
	SKIPN DISPSW
	POPJ P,		;DON'T HAVE THE 340 EITHER
	.DSTART	DLVIS
	.VALUE [ASCIZ /: No 340 
/]
FLASH3:	SETOM DLSTOP	;TELL INTERRUPT LEVEL DISPLAY STARTED
	POPJ P,

GETPAR:	PUSH P,A	;GETS 340 INTO PARAMETER MODE
	SKIPN A,DLMODE
	JRST POPAJ	;ALREADY IN PARAMETER MODE
	SETZM DLMODE
	CAIN A,4	;VECTOR MODE TAKES CARE OF ITSELF
	JRST POPAJ
	CAIN A,3
	JRST GETP1	;ESCAPE FROM CHARACTER MODE
	CAIE A,1	;MUST BE POINT MODE
	 .lose		;got into random mode
	LDB A,DLPC
	TRZ A,20000	;ESCAPE TO PARAMETER MODE
	DPB A,DLPC
	JRST POPAJ

GETP1:	PUSH P,D
	PUSH P,E
	MOVE D,IIIX
	MOVE E,IIIY
	PUSHJ P,ITOD
	MOVE A,[DLWORD(1,0,0,4,0)]
	PUSHJ P,ADBYTE
	MOVE A,[DLPOINT(0,1,0,0,0)]
	IOR A,E			;SET THE Y
	PUSHJ P,ADBYTE
	MOVE A,D		;SET THE X, GET INTO PARAMETER MODE
	PUSHJ P,ADBYTE
	POP P,E
	POP P,D
	JRST POPAJ


SVW134:	MOVEI A,1		;SET POINT MODE
	CAMN A,DLMODE
	JRST SVW0		;ALREADY IN POINT
	PUSHJ P,GETPAR		;GET INTO PARAMETER MODE
	MOVE A,[DLWORD(1,0,0,0,10)]
	IOR A,IIIBRT		;BRIGHTNESS
	AOS DLMODE
	PUSHJ P,ADBYTE		;ENTER POINT MODE
SVW0:	MOVE D,IIIX
	MOVE E,IIIY
	PUSHJ P,ITOD		;CONVERT X AND Y TO 340 COORDINATES
	MOVE A,[DLPOINT(1,1,0,0,0)]
	IOR A,E
	PUSHJ P,ADBYTE		;FIRST THE Y
	CAIE B,1
	SKIPA A,[DLPOINT(0,1,0,0,0)]	;INVISIBLE
	MOVE A,[DLPOINT(0,1,0,1,0)]	;VISIBLE
	IOR A,D
SVW5:	PUSHJ P,ADBYTE		;NOW THE X
	JRST POPAJ

;HERE TO DRAW VECTOR

SVW234:	MOVEI A,4
	CAME A,DLMODE
	JRST [	PUSHJ P,GETPAR
		MOVEM A,DLMODE	;ENTER VECTOR MODE
		MOVE A,[DLWORD(4,0,0,4,10)]
		IOR A,IIIBRT
		PUSHJ P,ADBYTE
		JRST SVW4]
	LDB A,DLPC		;ALREADY IN VECTOR MODE
	TRZ A,400000		;CLEAR ESCAPE BIT
	DPB A,DLPC
SVW4:	MOVEI A,200		;SIGN BIT
	PUSHJ P,SGNMAG
	MOVE A,D
	DPB E,[101000,,A]
	TRO A,600000		;TURN ON ESCAPE FROM MODE AND INTENSITY BITS
	JRST SVW5

;DIVIDE AND CONQUER FOR VECTORS TOO LONG FOR 340

LVW234:	SETZB A,C
	TRNE D,1
	MOVEI A,1
	TRNE E,1
	MOVEI C,1
	ASH D,-1
	ASH E,-1
	ADD A,D
	ADD C,E
	PUSH P,A
	PUSH P,C
	PUSHJ P,LVW1
	POP P,E
	POP P,D
	JRST LVW1

	subttl	GT40 Routines

;GT40 OPCODES

DPYJMP==160000
DPYNOP==164000
DPYSTP==173400		;STOP DISPLAY AND CAUSE INTERRUPT
DPYJSR==DPYSTP+1	;CALL DPY SUBROUTINE
DPYRTS==DPYSTP+2	;RETURN FROM DPY SUBROUTINE
SETPNT==114000
RPOINT==130000
SVWGT==104000
LVWGT==110000
CHARS==100000
DPYNRM==3724		;NORMAL SET GRAPHIC MODE BITS
			;	INTENSITY 7
			;	NO LIGHT PEN
			;	NO BLINK
			;	NO ITALICS
			;	SOLID LINE
DBLINK==10		;	YES BLINK (IF ENABLED)

STSNRM=171640		;NORMAL A REGISTER SETTINGS
			;	ENABLE STOP INTERRUPTS
			;	DISABLE LIGHT PEN INTERRUPTS
SYNC==4			;	SYNCS DPU WITH CLOCK
ITALICS==20		;	CAUSE ITALICS
LITEPN==200		;	ENABLE LIGHT PEN INTERRUPTS

ESCHR==20	;ESCAPE FROM CHARACTER MODE (^P)
SESCHR==206	;ESCAPE FOR LISP DISPLAY SLAVE FOR SIMLACS
LODER==0	;ENTER LODER

XTRA==6		;EXTRA BYTES IN BLOCK (SIZE, PIECE OF GLASS, CHECKSUM)
BLKMRK==1	;MARKS BEGINNING OF BLOCK
DELBLK==2	;LIST OF PIECES OF GLASS TO BE DELETED
%BOOTJ==232	; A SPECIAL IMLAC CODE WHICH NEEDES TO BE QUOTED.

CHRGT:	MOVEI C,3
	CAMN C,DLMODE
	JRST CHRG1
	MOVEM C,DLMODE
	MOVEI A,CHARS
	PUSHJ P,ADBYTE
	PUSHJ P,SETCBP		;SET CHARACTER BYTE POINTERS
	SETOM DCHCAS
	MOVEI A,17		;SHIFT IN
	PUSHJ P,GCHP1
CHRG1:	PUSHJ P,CHRSET		;SET TO READ 5 CHARACTERS FROM III INSTRUCTION
CHRG2:	ILDB A,IIIBP
	SKIPE A
	PUSHJ P,GCHPUT
	SOJG B,CHRG2
	POPJ P,

SETCBP:	SETZM DCHCNT		;INITIALIZE CHARACTER VARIABLES
	MOVE C,DLPC
	MOVEI A,10		;SWITCH TO 8 BIT BYTE SIZE
	DPB A,[300600,,C]
	MOVEM C,DCHBP		;FOR HIGH ORDER PDP11 BYTES
	IBP C			;LOSING GT40
	MOVEM C,DCHBP+1		;FOR LOW ORDER PDP11 BYTES
	POPJ P,

GCHPUT:	PUSHJ P,CHRPOS		;SALT AWAY CHARACTER INTO GT40 DISPLAY LIST
	PUSHJ P,GCHMAP		;DO THE BEST WE CAN FOR CONTROL CHARACTERS
GCHP1:	SOSL C,DCHCNT
	JRST GCHP2
	PUSH P,A
	MOVEI A,0
	PUSHJ P,ADBYTE
	MOVNS C,DCHCNT
	POP P,A
GCHP2:	IDPB A,DCHBP(C)
	IBP DCHBP(C)		;LOSING GT40
	POPJ P,

;TRY TO MAP CONTROL CHARACTERS TO SOMETHING REASONABLE IN THE GT40 SET
;	WE CAN'T ALWAYS WIN AND SOME SUBSTITUTIONS ARE VERY ARBITRARY!

GCHMAP:	TDZ A,[-1,,777600]	;ONLY 7 LOW ORDER BITS
	MOVNI C,1		;ASSUME WE WANT SHIFT IN
	CAIL A,40
	JRST GCHM1		;YES, ITS UPPER CASE
	TRNE A,1
	SKIPA D,CTAB40(A)
	MOVS D,CTAB40(A)
	HRRES D
	JUMPL D,GCHM1		;ITS REALLY SHIFT IN
	MOVEI C,0
	MOVE D,A
GCHM1:	CAMN C,DCHCAS
	POPJ P,
	PUSH P,A
	MOVEM C,DCHCAS
	MOVE A,1+[	17	;SHIFT IN
			16](C)	;SHIFT OUT
	PUSHJ P,GCHP1
	JRST POPAJ

CTAB40:	-1,,31			;MAGIC
	 1,, 4
	13,,33
	25,,20
	 0,,-1
	-1,,-1
	-1,,-1
	22,, 5
	 6,, 7
	10,,11
	32,,12
	 2,,24
	26,,27
	35,,34
	15,,16
	14,,36

;HERE FOR SET POINT

SVW1GT:	PUSHJ P,LVWCHK
	JRST SVW1G0	;RELATIVE SET POINT SUFFICES
SVW1G5:	MOVEI A,1
	CAMN A,DLMODE
	JRST SVW1G1
	MOVEM A,DLMODE
	MOVEI A,SETPNT
	PUSHJ P,ADBYTE
SVW1G1:	MOVE D,IIIX
	MOVE E,IIIY
	PUSHJ P,ITOD	;CONVERT TO GT40 COORDINATES
	MOVE A,D
	CAIN B,1
LVW2G2:	IORI A,40000	;MAKE VISIBLE
	PUSHJ P,ADBYTE
	MOVE A,E
SVW1G3:	PUSHJ P,ADBYTE
	JRST POPAJ

;HERE FOR RELATIVE SET POINT

SVW1G0:	MOVEI A,7
	CAMN A,DLMODE
	JRST SVW1G4
	EXCH A,DLMODE
	CAIN A,3	;CHECK FOR CHARACTER  MODE
	JRST SVW1G5	;AND DO ABSOLUTE SET POINT IF NECESSARY
	MOVEI A,RPOINT
	PUSHJ P,ADBYTE
SVW1G4:	MOVEI A,100	;SIGN BIT
	PUSHJ P,SGNMAG	;COMVERT TO SIGN MAGNITUDE
	MOVE A,D
	LSH A,7
	IOR A,E
	CAIN B,1
	IORI A,40000	;VISIBLE
	JRST SVW1G3

;HERE FOR SHORT VECTOR (III)

SVW2GT:	PUSHJ P,LVWCHK
	CAIA		;SHORT GT40 VECTOR SUFFICES
	JRST LVW2G0
	MOVEI B,1	;MAKES IT VISIBLE
	MOVEI A,4
	CAMN A,DLMODE
	JRST SVW1G4
	MOVEM A,DLMODE
	MOVEI A,SVWGT
	PUSHJ P,ADBYTE
	JRST SVW1G4

;HERE FOR LONG VECTOR

LVW2GT:	ADDM D,IIIX
	ADDM E,IIIY
LVW2G0:	MOVEI A,5
	CAMN A,DLMODE
	JRST LVW2G1
	MOVEM A,DLMODE
	MOVEI A,LVWGT
	PUSHJ P,ADBYTE
LVW2G1:	MOVEI A,20000
	PUSHJ P,SGNMAG
	MOVE A,D
	PUSH P,A	;RETURNS WITH A POPAJ
	JRST LVW2G2

;INITIALIZE GT40 DISPLAY LIST POINTERS

INTGT:	MOVEI A,1
	MOVEM A,DLMODE
	PUSHJ P,INTGT1
	MOVEI A,SETPNT
	CAMN B,PGBLNK
	IORI A,DPYNRM+DBLINK	;BLINK IT
	PUSHJ P,ADBYTE
	MOVEI A,1000
	PUSHJ P,ADBYTE
	JRST ADBYTE

INTGT1:	HRRZ A,DLBFP
	SUBI A,1
	HRLI A,042000
	MOVEM A,DLPC
	POPJ P,

CLRGT:	SYSCLV SCML,[TTYICH ? 1000,,0]
	JRST PPFRGT

;HERE TO SEND DISPLAY LIST TO GT40 OVER TTY, B HAS PIECE OF GLASS

ENDGT:	PUSH P,B	;PIECE OF GLASS
	CAMN B,PGBLNK
	JRST [	MOVEI A,CHARS+DPYNRM	;TURN OFF BLINKING
		PUSHJ P,ADBYTE
		JRST .+1]
	MOVEI A,DPYRTS
	PUSHJ P,ADBYTE
	PUSHJ P,INTGT1	;SET UP THAT BYTE POINTER AGAIN
	PUSHJ P,SETCBP
	PUSHJ P,TTYOFF	;DON'T WANT SPURIOUS ECHO CHARACTERS
	MOVEI E,BLKMRK
	PUSHJ P,SETLOD	;SEND OUT ESCAPE TO ABSOLUTE LOADER, AND HEADER
	MOVE D,DLBCNT
	ASH D,1		;# PDP11 BYTES
	PUSHJ P,GSWRD
	JUMPG D,.-1
	MOVN A,E	;CHECKSUM
	MOVEM A,CKS	;FOR DEBUGGING
	PUSHJ P,PUTWRD
	PUSHJ P,FPUT	;PUSH OUT BUFFER AND PAD
	MOVE A,DLBCNT	;RETURN # PDP10 WORDS IN DISPLAY LIST
	ASH A,-1
	MOVEM A,DLBCNT
	POP P,B		;PIECE OF GLASS
	JRST TTYON

;HERE TO ENTER LOADER AND SEND HEADER

SETLOD:	PUSH P,B	;PIECE OF GLASS
	PUSHJ P,SETBUF	;SET UP BUFFER POINTERS
	MOVEI A,ESCHR
	SKIPE GTYPE
	 MOVEI A,SESCHR
	PUSHJ P,PUTCH1
	MOVEI A,LODER
	PUSHJ P,PUTCHR
	MOVEI A,0	;INITIALIZE CHECKSUM
	EXCH A,E
	PUSHJ P,PUTWRD
	MOVE A,DLBCNT
	ASH A,1		;# PDP11 BYTES
	ADDI A,XTRA
	PUSHJ P,PUTWRD
	POP P,A
	JRST PUTWRD	;OUT GOES PIECE OF GLASS #

;READ 2 EIGHT BIT BYTES.  PACK INTO 6 4 6 FORMAT FOR GT40'S AND OLD IMLACS.
;SET UP A BYTE BUFFER FOR SIOT

GSWRD:	PUSHJ P,GETBYT
	ANDI A,377
	LSHC A,-44
	SOSLE D
	PUSHJ P,GETBYT	;DON'T GET BYTE UNLESS THERE IS ON THERE
	SOS D
	AOSE A		;SKIPS ON END OF BLOCK
	SOS A		;GET IT BACK
	LSH A,10
	ADDB A,B
PUTWRD:	MOVE B,A
	LSH A,-10	;CHECK SUM FIRST
	ANDI A,377
	ADD E,A
	MOVE A,B
	ANDI A,377
	ADD E,A
;	SKIPE GTYPE
;	 JRST PUT8	; USE 8 BIT FORMAT
	ANDI A,77	;NOW PUT OUT 3 CHARACTERS
	PUSHJ P,PUTCHR
	MOVE A,B
	LSH A,-6
	ANDI A,17
	PUSHJ P,PUTCHR
	MOVE A,B
	LSH A,-12
	ANDI A,77

PUTCHR:	IORI A,100

PUTCH1:	IDPB A,TYOBP
	SOSLE TYOCNT
	POPJ P,
	MOVE A,TYOSIZ
	MOVEM A,DSPCNT
	MOVE A,TYOBP0
	JRST DSPTYO

PUT8:	PUSHJ P,PUT8Q
	MOVE A,B
	LSH A,-10
	ANDI A,377
	PUSHJ P,PUT8Q
	POPJ P,

PUT8Q:	PUSH P,B
	CAIN A,%TDORS		; CHECK FOR CODES WHICH GET HANDLED BY SIMLAC WHICH
	 JRST PUT8Q1		; NEED TO BE QUOTED.
	CAIN A,%BOOTJ
	 JRST PUT8Q1
	CAIN A,%TDQOT
	 JRST PUT8Q1
	CAIGE A,%8BMAX		; CHECK FOR CODES 375 AND GREATER
	 JRST PUT8Q2
	MOVEI B,%8BMAX		; CONVENTION IS 375 QUOTES NEXT CHAR WHICH IS
	PUSHJ P,PUTCHQ		; 375-1+<NEXT CHAR>&3
	SUBI A,%8BMAX
	AOJ A,
	JRST PUT8Q2

PUT8Q1:	MOVEI B,%TDQOT		; QUOTE SPECIAL CODES
	PUSHJ P,PUTCHQ

PUT8Q2:	POP P,B
	JRST PUTCH1

PUTCHQ:	PUSH P,A
	MOVE A,TYOCNT		; MAKE SURE THERE IS ENOUGH SPACE FOR TWO CODES
	CAIN A, 1
	 PUSHJ P,FPUT		; NO, FORCE BUFFER FIRST
	MOVE A,B
	PUSHJ P,PUTCH1
	POP P,A
	POPJ P,

SETBUF:	MOVE A,TYORTL
	IMULI A,4
	MOVEM A,TYOCNT
	MOVEM A,TYOSIZ
	MOVE A,[441000,,TYOBUF]
	MOVEM A,TYOBP0
	MOVEM A,TYOBP
	POPJ P,

FPUT:	MOVE A,TYOSIZ
	SUB A,TYOCNT
	MOVEM A,DSPCNT
	MOVE A,TYOBP0

DSPTYO:	SYSCLV SIOT,[DSPCH ? 5000,,400 ? A ? DSPCNT ]
	JRST SETBUF

GETBYT:	SOSGE C,DCHCNT
	JRST [	MOVNS C
		MOVEM C,DCHCNT
		JRST .+1]
	SOSGE DLPC
	JRST [	MOVNI A,1
		POPJ P,]
	ILDB A,DCHBP(C)
	IBP DCHBP(C)
	POPJ P,

;HERE TO DELETE A PIECE OF GLASS

DELIGT:	PUSHJ P,TTYOFF
	SETZM DLBCNT
	MOVEI E,DELBLK	;BLOCK TYPE
	PUSHJ P,SETLOD
	MOVN A,E
	MOVEM A,CKS
	PUSHJ P,PUTWRD
	PUSHJ P,FPUT		; FORCE THE CRUFT OUT
	JRST TTYON

;ODDS AND ENDS

PPFRGT:	MOVEI A,20		; CLEAR MAIN PROGRAM AREA
	PUSHJ P,STYO
	MOVEI A,103
	PUSHJ P,STYO
	MOVEI A,20		; HOME DOWN IN MAIN PROGRAM AREA
	PUSHJ P,STYO
	MOVEI A,132
	PUSHJ P,STYO
	MOVEI A,20		; ^PC CLEAR ECHO AREA
	PUSHJ P,STVTYO
	MOVEI A,103
	JRST STVTYO

SIZGT:	POPJ P,
POSGT==TVPOS
PPTYGT==TVTYO
STRTGT:	POPJ P,

.INSRT DECBOT

LITTER:	CONSTA

	STORAGE(IMPURE)
VARS::	VARIABLES

PAT: PATCH:
	BLOCK 100
PATCHE:	0

DEFINE REPORT STRING,VALUE
PRINTX /STRING VALUE
/TERMIN

;VARIABLES PERTAINING TO III SIMULATION.
;THEY GO AT THE END OF IMPURE SPACE TO REDUCE THE WORKING SET SIZE
;WHEN III SIMULATION IS NOT IN USE.

;VARIABLES WHICH DESCRIBE STATE OF 340

DLMODE:	0		;MODE OF OPERATION
			;0 PARAMETER
			;1 POINT
			;3 CHARACTER
			;4 VECTOR
			;5 VECTOR CONTINUE
			;6 INCREMENT
			;7 RELATIVE POINT
DLSIZE:	0		;SIZE
DLINT:	0		;INTENSITY
DLFBYT:	0		;NUMBER OF FREE BYTES LEFT IN DISPLAY LIST
DLBCNT:	0		;NUMBER OF BYTES IN DISPLAY LIST
DLPC:	0		;BYTE POINTER TO LAST BYTE IN DISPLAY LIST
DLLIST:	BLOCK PGPPLN	;340 DISPLAY CHAIN
DLPP:	0		;BLKO POINTER TO ACTIVE PIECE OF PAPER (MUST PRECEDE DLP6)
DLPG:	BLOCK PGPPLN	;340 PAGE POINTERS (BLKO FORMAT)
DLBFP:	0		;POINTER TO DISPLAY BUFFER
DLBFL:	0		;DISPLAY BUFFER SIZE
DCHCAS:	0		;CHARACTER MODE CASE
			;0=SHIFT OUT, -1=SHIFT IN
DCHCNT:	0		;NUMBER FREE CHARACTERS LEFT IN THIS DISPLAY BYTE
DCHBP:	BLOCK 2		;BYTE POINTER TO LAST CHARACTER IN DISPLAY LIST
PGSG:	0		;-1=PIECE OF GLASS SORTED LIST INVALID, ELSE # ENTRIES
PGSORT:	BLOCK PGPPLN	;PIECE OF GLASS SORTED LIST
			;PIECE GLASS #,,POINTER TO 340 DISPLAY LIST-1
DPYTYP:	0		;DPY TYPE WE ARE RUNNING WITH
SIXSW:	0		;-1=WE HAVE THE PDP-6
DISPSW:	0		;-1=ITS RUNNING THE DISPLAY

;VARIABLES WHICH DESCRIBE STATE OF III DISPLAY

IIIPC:	0		;PROGRAM COUNTER
IIIX:	0		;CURRENT X
IIIY:	0		;CURRENT Y
IIIBRT:	0		;BRIGHTNESS
			;1 DIMMEST, 7 BRIGHTEST
IIISIZ:	0		;CHARACTER SIZE
			;1 SMALLEST, 7 LARGEST
IIIFLG:	1		;FLAG REGISTER
			;1.8 CONTROL BIT
			;1.7 LIGHT PEN FLAG
			;1.6 EDGE OVERFLOW FLAG
			;1.5 WRAP AROUND FLAG
			;1.4 WRAP AROUND MASK
			;1.3 LIGHT PEN MASK
			;1.2 EDGE OVERFLOW MASK
			;1.1 RUNNING FLAG (ALWAYS 1)
IIIPG:	BLOCK PGPPLN	;PIECES OF GLASS MAP(LENGTH,,FIRST WORD)
;IIIPG:		PTRS TO EACH BLOCK OF STORAGE ASSOCIATED WITH A PIECE OF GLASS
;BLOCK--	-LENGTH OF III PRGM,,.	;(MAY BE OTHER THAN . IF NEEDS RELOCATION)
;		<USERS III PRGM>
;		<COMPILED 340 DISPLAY PROGRAM>
IIIUPG:	BLOCK PGLEN	;ORIGIN OF USER DISPLAY LIST
IIIBP:	0		;BYTE POINTER FOR CHARACTER MODE
IIIPOS:	0		; III PIECE OF PAPER VERTICAL POSITION

;VARIABLES USED BY TV VECTOR ROUTINES

XOFF:	0		;OFF SCREEN IN X
YOFF:	0		;  "   IN Y
TVSTEP:	0		;HORIZ STEP PER CHARACTER
DX:	0		;III DELTA X
DY:	0		;DELTA Y
RATE:	0		;DDA RATE WORD, BINARY POINT 2.9
TVLSH:	LSHC D,.	; SHIFT FOR CHARACTER MODE
TVPHAS:	BLOCK PGLEN	; PHASE OF BLINKER, 0 MEANS PGLASS CLEAR NOW
TVBLNK:	BLOCK PGLEN	; THIS PG BLINKS IF -1
TVMODE:	-1		; 0 CURSOR
	-1		; 1 FOLLOWING ANGLES
	-1		; 2 B P S L
	-1		; 3 BLINKER PAGE
REPEAT 20+TVMODE-.,0	;-1 IF THIS PGlass CAN BE ERASED BY XORING
			;ELSE, SCREEN NEEDS TO BE CLEARED.
TVFRSH:	0		;-1 IF REDISPLAY NEEDED BECAUSE OF CLEAR DONE
TVPURE:	0		;0 IF IN TVSIM, -1 OTHERWISE (IMPURE BUGHALT)
TVPG:	400000		;PIECE OF GLASS WHILE PROCESSING UPGIOT

;PIECE OF PAPER VARIABLES

PPFBYT:	0	;NUMBER OF FREE HALF WORDS IN PPBLK
PPBCNT:	0	;NUMBER OF HALF WORDS IN PPBLK
PPPC:	0	;BYTE POINTER TO LAST HALF WORD IN PPBLK
PPCHBP:	0	;BYTE PONITER TO LAST DISPLAY CHARACTER IN PPBLK
PCHCNT:	0	;NUMBER FREE CHARACTERS LEFT IN CURRENT HALFWORD
PCHCAS:	0	;CHARACTER CASE
CURPP:	0	;CURRENTLY SELECTED PIECE OF PAPER
PPGLSZ:	0	;NUMBER LINES/GLITCH
PPGLTS:	0	;NUMBER GLITCHES
PPORG:	0	;TOP OF PIECE OF PAPER IN 340 COORDINATES
GLTFUL:	0	;NUMBER OF FILLED GLITHCES
GLTLF:	0	;NUMBER OF LINES IN THIS GLITCH SO FAR

;VARIABLES USED BY THE GT40 ROUTINES

TYOBFL==3000	;OUTPUT BUFFER LENGTH
%8BMAX==375	; MAX 8 BIT CODE

CKS:	0		;CHECKSUM SENT ON LAST BLOCK
TYOCNT:	0		;TYO BUFFER BYTE COUNTER
TYOSIZ:	0		; TYO BUFFER SIZE IN BYTES
DSPCNT:	0		; COUNT OF BYTES TO SIOT
TYOBP0:	0		; INITIAL VALUE OF TYOBP USED BY SIOT
TYOBP:	0		;BYTE POINTER INTO TYOBUF
TYORTL:	TYOBFL		;USED TO MAKE SIZE OF BUFFER SMALLER AT RUN TIME
GTYPE:	0		; -1 IF SIMLAC, ELSE GT40 OR ORDINARY IMLAC

;THIS SHOULD BE THE VERY LAST THING IN IMPURE SPACE,
;SINCE IT'S SO BIG AND SO RARELY USED.
TYOBUF:	BLOCK TYOBFL	;GT40 TYPEOUT BUFFER.

TWO,[

DIRTY==<.-IMPURE+1777>/2000

	STORAGE(PURE)

CLEAN==<.-PURE+1777>/2000

REPORT Impure Pages =,\DIRTY
REPORT Pure Pages =,\CLEAN
];TWO

	END GO
