Google
 

Trailing-Edge - PDP-10 Archives - BB-4172G-BM - 4-sources/pat.mac
There are 35 other files named pat.mac in the archive. Click here to see a list.
;<4.UTILITIES>PAT.MAC.76,  3-Jan-80 15:26:37, EDIT BY R.ACE
;UPDATE COPYRIGHT DATE
;<4.UTILITIES>PAT.MAC.75,  8-Nov-79 15:16:07, EDIT BY DBELL
;TCO 4.2568 - USE VARYING BYTESIZES FOR MAGTAPES SO EBCDIC TAPES WORK
;<4.UTILITIES>PAT.MAC.74,  7-Nov-79 10:51:17, EDIT BY DBELL
;TCO 4.2566 - GIVE GOOD ARGUMENT TO UFPGS SO FILOP FUNCTION 10 WORKS
;<4.UTILITIES>PAT.MAC.73, 27-Sep-79 13:51:36, EDIT BY DBELL
;TCO 4.2492 - MAKE MTCHR NOT FAIL IF THE MAGTAPE HAPPENS TO NOT BE OPEN
;<EKLUND>PAT.MAC.2, 10-Sep-79 16:28:22, EDIT BY EKLUND
;TCO 4.2451 - MAKE STACK SANE AGAIN ON QUOTA EXCEEDED INTERRUPTS
;<4.UTILITIES>PAT.MAC.71,  4-Sep-79 14:02:42, EDIT BY DBELL
;TCO 4.2437 - MAKE READ BACKWARDS WORK FOR MAGTAPES
;<EKLUND>PAT.MAC.7,  4-Sep-79 09:57:05, EDIT BY EKLUND
;TCO # 4.2435 v4(334) make REWIND of spooled card file work reasonably
;<4.UTILITIES>PAT.MAC.68,  8-Aug-79 10:42:33, EDIT BY HELLIWELL
;DON'T MOUNT DECTAPE UNLESS MUST GET JFN IN MTAPE CODE
;<YODER>PAT.MAC.2, 26-Jul-79 17:10:10, EDIT BY YODER
;TCO # 4.2350 v4(332) fix edit 331, which broke NUL:
;<4.UTILITIES>PAT.MAC.65, 15-Jun-79 13:45:29, EDIT BY YODER
;TCO # 4.2290 v4(331) make DIRCHK give non-skip return for NUL:
;<4.UTILITIES>PAT.MAC.64, 13-Jun-79 15:20:34, EDIT BY R.ACE
;[EDIT ON BEHALF OF STAN WHITLOCK]
;TCO # 4.2285 v4(327) make GETLCH return correct line characteristics, not 0
;<4.UTILITIES>PAT.MAC.63, 23-Apr-79 11:51:16, EDIT BY WHITLOCK
;TCO # 4.2239 v4(326) make MTCHR. return record length in LH of AC
;<4.UTILITIES>PAT.MAC.62,  1-Apr-79 21:03:35, EDIT BY GILBERT
;TCO 4.2231 v4(325) Reserve pages 764 up for DDT.  Define MAXPAT==764000.
;<4.UTILITIES>PAT.MAC.61, 12-Mar-79 14:09:48, EDIT BY KONEN
;UPDATE COPYRIGHT FOR RELEASE 4
;<4.UTILITIES>PAT.MAC.60,  2-Mar-79 16:26:39, EDIT BY MILLER
;TCO 4.2201. REMOVE CODE ADDED IN RELEASE 2 TO FIX MTA POSITIONING OPS
;<WHITLOCK..PA1050>PAT.MAC.59,  1-Mar-79 08:45:43, EDIT BY WHITLOCK
;TCO # 4.2200 v4(324) make edit 322 work with edit 320
;<WHITLOCK..PA1050>PAT.MAC.58, 26-Feb-79 13:06:29, EDIT BY WHITLOCK
;TCO # 4.2199 V4(323) make BREAK key act like 2 ^C if user is trapping ^C
;<WHITLOCK..PA1050>PAT.MAC.57, 26-Feb-79 12:13:55, EDIT BY WHITLOCK
;TCO # 4.2198 V4(322) speed up OUTSTR - use SOUT instead of BOUT loop
;<WHITLOCK..PA1050>PAT.MAC.56, 26-Feb-79 11:44:22, EDIT BY WHITLOCK
;TCO # 4.2197 v4(321) restore user's SFMOD on CONTinue
;<WHITLOCK..PA1050>PAT.MAC.55, 22-Feb-79 16:53:36, EDIT BY WHITLOCK
;TCO # 4.2196 v4(320) disable control char translation on TTY output
;<4.UTILITIES>PAT.MAC.54,  2-Feb-79 14:15:22, EDIT BY ALUSIC
;TCO # 4.2182 V4(317) ISSUE ERROR MSG AND HALT ON CHN 11 INT IF NOT UUO @IOERR
;<4.UTILITIES>PAT.MAC.53, 23-Jan-79 15:02:38, EDIT BY ALUSIC
;TCO # 4.2169 V4(316) FIX TRMOP FUNCTIONS .TONFC AND .TOWID AT TONFCS & TOWIDR.
;<4.UTILITIES>PAT.MAC.52, 27-Dec-78 11:59:42, EDIT BY HELLIWELL
;TCO # 4.2133 V4(315) FIX BUG IN REMAP WHEN MOVING CODE UP
;<4.UTILITIES>PAT.MAC.51, 13-Dec-78 14:47:28, EDIT BY ALUSIC
;TCO # 4.2121 V4(314) SET EOF POINTER TO REFLECT CORRECT # WDS AT MOVBUF+7
;<4.UTILITIES>PAT.MAC.50,  6-Dec-78 17:34:15, EDIT BY HURLEY
;FIX THE MISSING DATA ON THE "CREF" COMMAND. (EMPTY LISTINGS)
;MAKE UCL3 NOT CALL SETEOF IF THE DEVICE IS NOT A DISK (EG A LPT:)
;<4.UTILITIES>PAT.MAC.49, 17-Nov-78 17:18:47, EDIT BY HELLIWELL
;TCO # 4.2091 CHANGE "DSK:<SUBSYS>" TO "PS:<SUBSYS>"
;<4.UTILITIES>PAT.MAC.48, 17-Nov-78 09:52:29, EDIT BY ALUSIC
;TCO# 4.2090 SET USE BITS IN INPUT BUFFER HEADERS, FIXES FORTRAN MTA BACKSPACE
;<ALUSIC.SPR>PAT.MAC.1,  6-Nov-78 11:13:18, EDIT BY ALUSIC
;TCO# 4.2080 MAKE TTCL6 (GETLCH) RETURN 0 IF JOB IS DETACHED
;<4.UTILITIES>PAT.MAC.46, 29-Oct-78 14:13:03, EDIT BY HELLIWELL
;<4.UTILITIES>PAT.MAC.45, 29-Oct-78 13:13:44, EDIT BY HELLIWELL
;SOME MORE FIXES FOR HI SEG FREE POINTER OFF END OF HI SEG
;<4.UTILITIES>PAT.MAC.44, 29-Oct-78 12:32:43, EDIT BY HELLIWELL
;TCO 4.2073 ACCOUNT FOR HI SEG WITH LENGTH EXACT MULTIPLE OF PAGE DURING GETSEG
;<4.UTILITIES>PAT.MAC.43, 20-Oct-78 18:38:23, EDIT BY HELLIWELL
;TCO 4.2057 ADD GETTAB TABLE 100 FOR HI SEG ORIGIN ONLY.
;<4.UTILITIES>PAT.MAC.42, 19-Oct-78 11:00:22, EDIT BY ALUSIC
;TCO 4.2053 MAKE SLEEP WORK CORRECTLY-DELETE THIBR AT IOWAIT.
;<4.UTILITIES>PAT.MAC.41,  3-Oct-78 11:16:49, EDIT BY HURLEY
;TCO 4.2030 - CHANGE LINE FEED CCOC BITS TO BE 2 INSTEAD OF 3
;<4.UTILITIES>PAT.MAC.40, 21-Sep-78 10:36:37, EDIT BY HELLIWELL
;<4.UTILITIES>PAT.MAC.39, 21-Sep-78 10:29:59, EDIT BY HELLIWELL
;TCO # 4.2018 ADD GETTAB TABLE 5 (.GTKCT). RETURN RUNTIME * 20K
;<4.UTILITIES>PAT.MAC.38, 20-Sep-78 17:37:36, EDIT BY HELLIWELL
;TCO # 4.2017 DON'T COPY JOB DATA AREA TO HIGH SEG IF NOT WRITABLE
;<4.UTILITIES>PAT.MAC.37, 19-Sep-78 10:57:30, EDIT BY HELLIWELL
;TCO # 4.2014 IMPLEMENT GETTABS .GTRDV AND .GTRDI
;TCO # 4.2014 ADD CELLS LOWDEV AND LOWPPN AND MAKE SURE THEY ARE SETUP
;<4.UTILITIES>PAT.MAC.36, 23-Aug-78 08:12:34, EDIT BY MILLER
;CHANGE NAME OF .GTHSN TO GTHSNS
;<4.UTILITIES>PAT.MAC.35, 23-Aug-78 07:57:56, EDIT BY MILLER
;RESTORE TOPAGS AND TOPAGR TO THEIR OLD SELVES.
;<4.UTILITIES>PAT.MAC.34, 18-Aug-78 08:10:01, Edit by KONEN
;TCO 4.1987 - DON'T CLOBBER BYTE COUNT FOR NON-DISK FILES IN EXEC CLOSE
;<4.UTILITIES>PAT.MAC.33,  1-Aug-78 14:52:30, Edit by ALUSIC
;TCO #1964 CALL SETEOF AT UCL3+7 TO SET EOF IN FDB DURING CLOSE OUTPUT
;<4.UTILITIES>PAT.MAC.32, 27-Jul-78 08:09:39, EDIT BY MILLER
;MORE FIXES FOR XON/XOFF
;<4.UTILITIES>PAT.MAC.31, 26-Jul-78 18:51:42, EDIT BY MILLER
;CHANGE TOPAGR TO USE MTOPR TO FETCH THE BIT
;<4.UTILITIES>PAT.MAC.30, 26-Jul-78 18:40:51, EDIT BY MILLER
;CHANGE TOPAGS TO DO XON/XOFF PROPERLY
;<4.UTILITIES>PAT.MAC.23, 21-Jul-78 13:38:34, EDIT BY OSMAN
;CHECK .JIT20 (GETJI) INSTEAD OF LOOKING FOR /EXEC/
;<4.UTILITIES>PAT.MAC.22, 14-Jul-78 13:52:19, EDIT BY HURLEY
;FIXED IO ERROR INDICATION ON DATA ERRORS FROM THE DISK
;<3A.UTILITIES>PAT.MAC.18, 27-Jun-78 23:39:45, Edit by HELLIWELL
;<4.UTILITIES>PAT.MAC.20, 26-Jun-78 15:09:20, Edit by HELLIWELL
;SET TERMINAL MODE ON OPEN OF CONTROLLING TERMINAL
;<4.UTILITIES>PAT.MAC.19, 24-Apr-78 14:40:22, Edit by DBELL
;MAKE TMPBLK LARGER SO ENQ/DEQ CAN HAVE LARGER ARGUMENT BLOCKS
;<4.UTILITIES>PAT.MAC.18, 12-Apr-78 12:26:01, Edit by HELLIWELL
;FIX REMAP TO DEFAULT HI SEG ORIGIN PROPERLY
;<4.UTILITIES>PAT.MAC.17, 11-Apr-78 15:24:17, Edit by HELLIWELL
;ADD MISSING INSTRUCTION AT REMAP1+12
;<4.UTILITIES>PAT.MAC.16, 11-Apr-78 14:38:45, Edit by HELLIWELL
;FIX TYPO IN HI SEG ORIGIN EDIT
;<4.UTILITIES>PAT.MAC.15, 11-Apr-78 14:30:26, EDIT BY HURLEY
;TCO 1899 - FIX MAGTAPE BUFFER SIZE DEFAULTING TO USE JOB DEFAULTS
;<4.UTILITIES>PAT.MAC.14, 11-Apr-78 14:12:06, Edit by HELLIWELL
;FIX MANY BUGS HAVING TO DO WITH HI SEG ORIGIN, INCLUDING REWRITE OF REMAP UUO
;<4.UTILITIES>PAT.MAC.13,  7-Apr-78 16:49:20, EDIT BY HURLEY
;FIX TAPE REWINDS - BOT WAS NEVER BEING CLEARED AT GSTATS
;<4.UTILITIES>PAT.MAC.12,  7-Apr-78 12:37:46, Edit by HELLIWELL
;RETURN TO USER AFTER COMPTG (GTJFN) IF PARSE ONLY
;<4.UTILITIES>PAT.MAC.11,  7-Apr-78 11:27:15, Edit by HELLIWELL
;MUST COPY USER STRING TO STRNG1 BUFFER WHEN STPARS FAILS
;<4.UTILITIES>PAT.MAC.10,  6-Apr-78 16:06:44, Edit by HELLIWELL
;FIX COMPT. FUNCTION 3 TO REQUIRE 4 ARGS FOR PPN TO DIR (INCLUDES DEVICE)
;<4.UTILITIES>PAT.MAC.9,  6-Apr-78 15:38:48, Edit by HELLIWELL
;FIX COMPT. FUNCTION 2 (RENAME) TO REQUIRE ONLY 3 ARGS (2 MORE OPTIONAL)
;<4.UTILITIES>PAT.MAC.8,  6-Apr-78 14:29:40, Edit by HELLIWELL
;AT MTAPE7+6 MOUNT DECTAPE EVEN IF ALREADY HAVE JFN
;IN COMPTG, IF STPARS FAILS, USE USER'S ORIGINAL STRING INSTEAD OF GIVING ERROR RETURN
;IN COMPTG, AVOID DVCHR JSYS IF GJ%OFG ON FOR GTJFN (PARSE)
;UNLABLED EDIT:
;FIX SFMOD THAT USESE 770000 INSTEAD OF 170000
;<4.UTILITIES>PAT.MAC.5, 28-Feb-78 16:23:27, Edit by DBELL
;IMPLEMENT FUNCTION 10 OF FILOP. - UPDATE "RIBS"
;<4.UTILITIES>PAT.MAC.4, 28-Feb-78 15:55:57, Edit by BORCHEK
;fix enter returning error in wrong place
;<4.UTILITIES>PAT.MAC.3, 14-Feb-78 17:37:24, EDIT BY HURLEY
;CHANGED TM.ASC TO BE 1B29
;<4.UTILITIES>PAT.MAC.2, 29-Jan-78 18:09:54, Edit by BORCHEK
;DON'T SET INIT BIT FOR LPT AT DEVCHZ
;<4.UTILITIES>PAT.MAC.1, 23-Jan-78 12:01:39, EDIT BY HELLIWELL
;FIX PROTECTION TRANSLATION AT ULK2L, TEST FOR LEAST PROTECTION
;TTYSET NOW CALLED IN OPEN ROUTINE BECAUSE RFMOD CAN'T BE DONE UNTIL OPEN

	TITLE PAT - 10/50 COMPATIBILITY FOR TOPS20
	SEARCH MONSYM,MACSYM
	IFNDEF .PSECT,<
	.DIRECT .XTABM>

.GROUP==0	;GROUP WHO LAST MODIFIED PROGRAM
.MAJOR==4	;MAJOR VERSION NUMBER
.MINOR==0	;MINOR VERSION LETTER
.EDIT==337	;EDIT NUMBER



;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
;  OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;
;COPYRIGHT (C) 1976,1977,1978,1979,1980 BY DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.


PATVER==:<BYTE (3).GROUP(9).MAJOR(6).MINOR(18).EDIT>	;EDIT NUMBER STORED IN PVLOC
SUBTTL DEFINITIONS AND ALLOCATION

COMMENT \

THIS CODE RESIDES IN A HIGH AREA OF USER CORE (CURRENTLY 700000).
IT IS LOADED FROM THE SSAVE FILE SYS:PA1050.EXE BY THE
MONITOR WHENEVER A FORK EXECUTES ITS FIRST 10/50 UUO (40-77, BUT NOT 0).
THE FIRST TIME, ENTRY IS VIA THE SECOND LOCATION OF THE ENTRY VECTOR.
THEREAFTER, 10/50 UUO'S RESULT IN AN IMMEDIATE TRANSFER TO
THIS CODE VIA THE FIRST LOCATION OF THE ENTRY VECTOR.  WHEN
ANY 10/50 UUO IS EXECUTED, THE MONITOR MOVES LOCATION 40 TO
MONUUO (SPECIFIED BY FOURTH WORD OF ENTRY VECTOR), AND THE RETURN
 PC TO MONUPC (SPECIFIED BY FIFTH WORD OF ENTRY VECTOR).  THIS CODE
INTERPRETS THE UUO AND RETURNS DIRECTLY TO THE USER PROGRAM.

THIS CODE USES THREE OF THE RESERVED UUO'S (42-44) FOR INTERNAL
PURPOSES.

ASSEMBLY AND LOADING PROCEDURE:

@LOAD PAT
@START
@

THE START AFTER LOADING CAUSES THE CODE TO BE MOVED FROM ITS LOAD
LOCATION TO ITS RUNNING LOCATION IN HIGH CORE.  THE SYMBOL
TABLE IS ALSO MOVED, AND THE POINTER ADJUSTED.  AN SSAVE FILE
OF PAGES 700-777 SHOULD BE MADE TO BE USED FOR DEBUGGING.
TO PRODUCE THE SYSTEM FILE, START AT MAKEPF (MAKEPF$G).  THIS WILL
WRITE A SSAVE FILE WITH WRITE PROTECTION INTO THE SPECIFIED FILE.

FOR DEBUGGING COMPATIBILITY PACKAGE, FIRST RESET, AND GET
THE TEN-50 PROGRAM TO BE USED FOR TESTING, IF ANY.
THEN, MERGE AN SSAVE FILE (WITH DDT AND SYMBOLS) OF THE
DEBUG VERSION OF PAT, TYPE DDT, THEN DEBUG$G TO SET UP THE
COMPATIBILITY VECTOR, PSI SYSTEM, AND TEMPORARY STORAGE.

\

SAMFRK==1			;PAT IN SAME FORK WITH USER PROG
;THIS CODE AT PRESENT WILL NOT WORK FOR SAMFRK=0, BUT THERE ARE
;VESTIGES AND PARTIALLY IMPLEMENTED SECTIONS WHICH MAY BE MADE TO
;RUN THAT WAY SOME DAY. I.E., WITH PAT RUNNING THE 10/50 PROGRAM AS
;AN INFERIOR PROCESS.
;INTERNAL UUO'S

OPDEF CALL[40B8]		;10/50 CALL UUO

REPEAT 0,<
OPDEF UMOVE[42B8]	;NOTE - NOT COMPLETELY GENERAL.
OPDEF UMOVEM[43B8]	; E.G., CAN'T UMOVE TO EE,FF
OPDEF XCTUU[44B8]	;NOTE ALL XCT'S HAVE SAME OPCODE IF SAMFRK=1
OPDEF XCTUM[44B8]
OPDEF XCTMU[44B8]
>

	DEFINE UMOVE (A,B)<
		PUSHJ P,UXCT
		MOVE A,B>

	DEFINE UMOVEM (A,B)<
		PUSHJ P,UXCT
		MOVEM A,B>

	DEFINE XCTUU (A)<
		PUSHJ P,UXCT
		A>

	DEFINE XCTUM (A)<
		PUSHJ P,UXCT
		A>

	DEFINE XCTMU (A)<
		PUSHJ P,UXCT
		A>

	DEFINE XCTLB (A)<
		PUSHJ P,LBXCT
		A>

	DEFINE XJSYS (INST) <
	PUSHJ P,DOJSYS
	INST>

	DEFINE IJSYS (INST)<
	JSP EE,INJSYS
	INST>

;MACRO TO REFERENCE PAGE NUMBER WITHIN ADDRESS

DEFINE PAGEN (LOC)<POINT 9,LOC,26>

	DEFINE TMSG (MSG)
<	PUSHJ P,TMSGQ
	XWD 440600,[SIXBIT @MSG/@]
>
IFNDEF FTSTAT,<FTSTAT==0>	;KEEP STATISTICS OF PA1050 USAGE
IFNDEF FTFILSER,<FTFILSER==0>	;USE FILSER FOR DEVICE DPA

	MLON
	SALL
;ACCUMULATOR DEFINITIONS

PF=0		;PAT'S FLAG AC
A=1		;FIRST AC'S ARE TEMPS AND JSYS ARGS
B=2
C=3
D=4
E=5
F=6
G=7
AA=10		;CONTAINS DEVICE NUMBER DURING I/O UUO HANDLING
BB=11		;HOLDS BASE OF I/O CHANNEL DATA BLOCK DURING ...
CC=12		;HOLDS ADDRESS OF CURRENT RING BUFFER IN I/O
AC=13		;AC NUMBER IN TEN-FIFTY UUO
CAC=14		;CONTENTS OF THAT AC. LOADED ON ALL UUOS.
EE=15		;EE AND FF ARE USED BY UMOVE AND UMOVEM WITHOUT SAVING
FF=16		; IF USED, BE AWARE THAT THEY WILL BE CHANGED ON UMOVE'S
P=17

;FLAGS IN AC PF. LEFT HALF ARE PERMANENT (HOLD OVER USER PROG)
; RIGHT HALF ARE MEANINGFUL ONLY WITHIN A GIVEN UUO, CLEARED ON ENTRY

R.CLS==1	;FLAG SET DURING CLOSE AND TESTED IN OUTPUT TO AVOID
		;OUTPUTTING 0 LENGTH RECORDS.
R.DIRN==2	;DIRECTION OF TRANSFER IN MTA, USET
R.RUNU==4	;DISTINGUISH RUN UUO FROM GETSEG UUO
R.UEXT==10	;EXTENDED LOOKUP OR ENTER FLAG
R.EXIT==20	;ON FOR EXIT 1, ; OFF FOR EXIT 0, .
R.NOWC==40	;DONT COMPUTE WORD COUNT FOR BUFFER. THERE IS DATA THERE
R.FERR==100	;FATAL ERROR. PREVENTS PMAPPING PAT OUT OF EXISTANCE
R.KJFN==200	;KEEP JFN IN CLOSE ROUTINE.
R.RHLT==400	;RUN OR GETSEG UUO FOLLOWED BY HALT (DON'T RETURN)
R.SYS==1000	;RUN UUO FROM SYS, SO DO SETNM
R.ENT==2000	;DOING AN ENTER, SET PROTECTION FIELD
R.CMR==4000	;CMRETN RETURN FOR STATISTICS GATHERING
R.CVF==10000	;FLAG TO CAUSE CONTROL-V'S TO GO INTO ASCII STRINGS
R.CVC==20000	;FLAG TO MARK THAT A PARTICULAR CHARACTER SHOULD BE QUOTED
R.EXP==40000	;AN EXPUGE WAS DONE DURING THIS UUO, DONT DO ANOTHER
R.ILLJ==100000	;DOING AN XJSYS, DONT TYPE ILL INST
R.SUIC==200000	;COMMITTING SUICIDE

L.DBUG==1	;DEBUGGING PAT ITSELF
L.ONCE==2	;HAVE BEEN THRU ONCE CODE
L.INDF==4	;INDICATE FF BY ^L REQUESTED AT EXEC LEVEL, SO DO SO.
L.GSTA==20	;<SYSTEM>PA1050.STATISTICS WAS FOUND, DO GENERAL STATISTICS
L.LSTA==40	;PA1050.STATISTICS WAS FOUND, DO LOCAL STATISTICS
L.FLSR==100	;FILSER HAS BEEN LOADED INTO ADDRESS SPACE
L.TFA==200	;TTY FORK FOR HIBERNATE IS NOW ACTIVE
L.NCCE==400	;CONTROL-C CANNOT BE ENABLED
L.SMAL==1000	;SMALL SYSTEM (LESS THAN 196K)
;CHARACTERS REFERENCED SYMBOLICALLY
C.CC==3		;CONTROL-C CHARACTER
C.BELL==7	;BELL CHARACTER
C.TAB==11	;TAB
C.LF==12	;LINE FEED
C.FF==14	;FORMFEED CHARACTER
C.CR==15	;CARRIAGE RETURN
C.EOF=="Z"-100	;CONTROL-Z, END-OF-FILE FOR TTY
STDALT==33	;10/50'S STANDARD ALTMODE CHARACTER
ALT1==175	;NON-STANDARD ALTMODE
ALT2==176	;ANOTHER NON-STANDARD ALTMODE

C.RTYP=="R"-100	;RETYPE THE CURRENT LINE COMMAND
C.DELC==177	;SINGLE-CHARACTER DELETE (RUBOUT)
C.DELL=="U"-100	;LINE (BUFFER) DELETE (^U)
C.CNTV=="V"-100	;CONTROL-V HARACTER FOR QUOTING

;DEVICE DESIGNATOR DEFINITIONS

DSK==0
DRM==1
MTA==2
DTA==3
PTR==4
PTP==5
DIS==6
LPT==7
CDR==10
CDP==11
TTY==12
PTY==13
NIL==15
PLT==17
;10/50 JOB AREA LOCATIONS

JOBPD1==45
JOBS41==122

.JBUUO=40
.JBERR=42
.JBREL=44
.JBDDT=74
.JBHSO=75
.JBPFI=114
.JBHRL=115
.JBSYM=116
.JBUSY=117
.JBSA=120
.JBFF=121
.JBREN=124
.JBAPR=125
.JBCNI=126
.JBTPC=127
.JBOPC=130
.JBCOR=133
.JBINT=134
.JBVER=137
.JBDA=140

.JBHSA==0
.JBH41==1
.JBHCR==2
.JBHRN==3
.JBHVR==4
.JBHNM==5
.JBHSM==6
;     ==7
.JBHDA==10			;NEEDED DURING ASSEMBLY

;FLAGS IN RH OF FLAGWD

IO.BIN==10		;BINARY MODE
IO.FCS==100		;FULL CHARACTER SET
IO.SUP==200		;SUPPRESS ECHOING
IO.TEC==400		;TRUTH IN ECHOING MODE
IO.IMP==400000		;IO IMPROPER MODE

;FLAGS IN LH OF FLAGWD IN CHANNEL DATA TABLES (CHTABS)

RNDMF==1	;FILE IS BEING READ RANDOMLY
MTABFS==1	;MTA BUFFERS ARE SET UP
PTYCRF==2	;LAST CHAR SENT TO PTY WAS A <CR>
MTALTW==2	;LAST MAGTAPE TRANSFER WAS A WRITE
PTYCWF==4	;PTY IS WAITING FOR ^C TO TAKE EFFECT
DTACLS==PTYCWF	;DTA JFN WAS CLOSED FOR ANOTHER CHANNEL TO RUN
MTADMS=PTYCWF	;DATA MODE WAS SET ON MTA
RDMFDF==10	;READING MFD, SIMULATE WITH DIRST
RDUFDF==20	;READING UFD, SIMULATE WITH GNJFN
UFDEOF==40	;NO MORE FILES IN DIRECTORY DURING UFD SIMULATION
DTADMP==100	;DTA HAS BEEN OPENED IN DUMP MODE
ENTERF==200
INBUFF==400
IOPENF==1000
LOOKPF==2000
OOPENF==4000
DTAMF==10000	;DTA IS MOUNTED AND DIRECTORY WAS READ
MTARDB==DTAMF	;MAGTAPE READS ARE BACKWARDS
OUTBFF==20000
INFIRF==40000
OUFIRF==100000
INITF==200000


;FLAGS IN LH OF TYSTAT AND LH OF FLAGWD FOR TTY'S ONLY

TT.BIN==PTYCRF		;TTY IS IN BINARY MODE FLAG
TT.CTY==PTYCWF		;TTY IS CONTROLING TTY FOR THIS JOB
TT.ALT==RDMFDF		;USER WANTS NO ALT MODE CONVERSION
TT.GAG==RDUFDF		;DONT TYPE MESSAGES TO USER TTY
TT.XON==UFDEOF		;TTY IN TAPE MODE, NO LF AFTER CR
TT.BKE==DTADMP		;TTY BREAK ON EVERYTHING

;TTY MODE DEFINITIONS

	TM.ECH==3B25		;ECHO FIELD
	TM.IOD==2B25		;IMMEDIATE OR DEFERRED MODE
	TM.WAK==17B23		;ALL TTY WAKE BITS
	TM.BKE==17B23		;BREAK ON EVERYTHING
	TM.FWK==14B23		;FORMAT CONTROLS WAKE
	TM.FCS==14B23		;FORMAT AND NON-FORMAT CONTROLS
	TM.GAG==1B26!1B27	;ADVISE AND LINK
	TM.ASC==1B29		;ASCII OR BINARY
	TM.ATE==3B29		;(320) disable translation on output
;FLAGS FOR DEVICE CHARACTERISTICS

HASDIR==4			;DEVICE HAS DIRECTORY
MTADEV==20			;DEVICE IS MAGTAPE
DTADEV==100			;DEVICE IS DECTAPE
PTRDEV==200			;DEVICE IS PAPERTAPE READER
PTPDEV==400			;DEVICE IS PAPERTAPE PUNCH
TTYDEV==1B32
DSKDEV==200000			;DEVICE IS DISC

IFE SAMFRK,<
LOC 41
	JSYS MYUU		;LOCAL UUO ROUTINE
	RELOC
>

MAXERR==10			;RETRIES WHEN READING MAGTAPE
USRLVL==3			;LEVEL PERMITTED FOR COMPAT FUNCTION 6
USRMXC==0			;MAXIMUM CHANNEL AVAILABLE FOR COMPAT 6

.HSLOC=400000			;DEFAULT (NORMAL) HISEG LOCATION
DDTLOC=770000			;START ADDRESS OF DDT
MAXPAT==764000			;FIRST ADDRESS WE CAN'T USE
B18==400000			;HANDY ABBREVIATION FOR SIGN BIT
TTYDSG==400000			;TTY DESIGNATOR FORMAT

MAXIOL==7000			;BIGGEST DUMP I/O LIST VIROS WILL BUY

MAXFRU==3			;# OF ^C'S BEFORE BOMBING PAT

WHEEL==1B18			;PROCESS CAPABILITY BIT
OPER==1B19			;PROCESS CAPABILITY BIT
MAINT==1B21			;PROCESS CAPABILITY BIT
PRIJFN==100			;PRIMARY INPUT JFN
PROJFN==101			;PRIMARY OUTPUT JFN

PPNLH==4			;LH OF PPN RETURNED BY GETPPN AND GETTAB
MAXDIR==^D1000			;# OF ILLEGAL DIR'S BEFORE EOF
STDPRT=005000,,0		;STANDARD FILE PROTECTION

FDBCTL==1			;FILE DESCRIPTOR BLOCK DEFINITIONS
FDBPRT==4
FDBVER==7
FDBBYV==11
FDBSIZ==12
FDBCRV==13
FDBWRT==14			;LAST WRITE OF FILE
FDBREF==15
FDBDEL==1B3

DV.DSK==1B1			;DEVICE CHARACTERISTICS BITS
DV.LPT==1B3			;DEVICE CHARACTERISTICS BITS
;GET THE 10/50 UUO'S INTO THE SYMBOL TABLE FOR DEBUGGING PAT

DEFINE REDEF(A)<IRP A,<A=:EXP <A>>>
REDEF <CALL,INIT,CALLI,OPEN,TTCALL,RENAME,IN,OUT,SETSTS,STATO>
REDEF <GETSTS,STATZ,INBUF,OUTBUF,INPUT,OUTPUT,CLOSE,RELEAS>
REDEF <MTAPE,UGETF,USETI,USETO,LOOKUP,ENTER>

	DEFINE SYSGET (X)<
		MOVE A,[SIXBIT /X/]
		SKIPN B,X	;HAVE WE GOTTEN THIS ALREADY?
		  SYSGT		;NO, GO GET IT
		MOVEM B,X	;STORE IT FOR FUTURE USE
>

	DEFINE SYSGTA (X)<
		SKIPE A,X
		  JRST .+3
		MOVE A,[SIXBIT/X/]
		SYSGT
		MOVEM A,X
>

;CORE ASSIGHMENTS
;FIRST FOR THE CODE.

PATLOC=:700000			;PLACE WHERE COMPATIBILITY ACTUALLY RUNS
PATPAG==:PATLOC_<-^D9>		;AND AS A PAGE NUMBER TO GET THRU LOADER
FLSRLC=:600000			;START ADR OF FILSER DATA BASE
FLSRPG==:FLSRLC_<-^D9>		;PAGE NUMBER OF START OF FILSER
LODORG==400000			;WHERE THE LOADER WILL LEAVE "HI SEGMENT"
;STORAGE ALLOCATOR FOR TEMP STORAGE

	DEFINE ALC(NAM,SIZ)
	<	NAM=:LC
LC==LC+SIZ
>

;VARIABLE STORAGE FOR PAT

	PATVAR==731		;STORAGE AREA FOR PAT VARIABLES
	TMPPAG==PATVAR		;PAGE FOR TMPCOR DATA BASE FILE
IFE FTSTAT,<STATLP==TMPPAG	;NO STATISTICS PAGE
	    STATGP==TMPPAG>	;NO SYSTEM STATISTICS PAGE
IFN FTSTAT,<STATLP==TMPPAG+1	;DEFINE STATISTICS PAGE
	    STATGP==STATLP+1>	;DEFINE SYSTEM WIDE STATISTICS PAGE
	LC==<STATGP+1>_11	;START OF TEMPORARY PAGES
IFN FTSTAT,<
	STATLC==STATLP_11	;ADDRESS OF LOCAL STAISTICS PAGE
	STATGC==STATGP_11	;ADDRESS OF SYSTEM WIDE STATISTICS PAGE
	STATFW==ST.X_^D24!ST.Y_^D12!ST.Z	;FORMAT WORD
	ST.X==4			;LENGTH OF MISC TABLE
	ST.Y==200		;LENGTH OF CALLI TABLE
	ST.Z==100		;LENGTH OF GETTAB TABLE
	ST.FMT==0		;WHERE TO STORE FORMAT WORD
	ST.TCL==1		;1-20 IS FOR TTCALL'S
	ST.UUO==21		;21-60 IS FOR UUO'S
	ST.VER==61		;COMPATIBILITY PACKAGE VERSION #
	ST.ONC==62		;# OF TIMES THRU ONCE CODE
	ST.UNI==63		;# OF UNIMPLEMENTED CALLI'S EXECUTED
	ST.UEI==64		;# OF UNEXPECTED INTERRUPTS IN PAT
	ST.CLI==61+ST.X		;61+X TO 60+X+Y IS FOR CALLI'S
				;60+X+Y DOWN IS FOR NEGATIVE CALLI'S
	ST.GTB==61+ST.X+ST.Y	;61+X+Y TO 60+X+Y+Z IS FOR GETTAB'S

	ST.TIM==60+ST.X+ST.Y+ST.Z	;OFFSET FOR TIMMING STATISTICS
>

DEFINE STAT(A,B,C)
<IFN FTSTAT,<
	TLNN PF,L.LSTA		;LOCAL STATISTICS WANTED?
	  JRST .+3		;NO, DONT REFERENCE THE PAGE
	AOS STATLC+C(A)		;EXECUTION COUNTER
	ADDM B,STATLC+ST.TIM+C(A) ;INCREMENT TIME SPENT IN UUO
	TLNN PF,L.GSTA		;GLOBAL STATISTICS WANTED?
	  JRST .+3		;NO, DONT REFERENCE PAGE
	AOS STATGC+C(A)		;SYSTEM WIDE COUNTER
	ADDM B,STATGC+ST.TIM+C(A) ;SYSTEM STATISTICS FOR UUO TIMMINGS
>>
	FILPAG==600		;FILSER STARTS AT PAGE 600
	FILEND==677		;HIGHEST PAGE OF FILSER DATA BASE

	TSLOC==LC

	ALC CHTABS,0
	ALC JFNTAB,1		;ONLY NEEDS 7 BITS
	ALC MAPTAB,1		;MAPPING INFO FOR DISK FILES
	ALC BUFHTB,1		;OUTPUT AND INPUT BUFFER HEADERS
	ALC FLAGWD,1		;INTERNAL FLGS,,FILE STATUS
	ALC DEVNUM,1		;DEVICE DESIGNATOR OF THIS DEVICE,
				;  FILLED IN BY INIT
	ALC DEVNAM,1		;SIXBIT DEVICE NAME FROM USER
	ALC FILNAM,1		;SIXBIT FILE NAME FROM USER
	ALC EXT,1		;SIXBIT FILE EXT (3 CHARS) FROM USER
	ALC DIRNUM,1		;DIRECTORY NUMBER
	ALC PROT,1		;PROTECTION VALUE (VIROS STYLE)

	ALC IOBYTP,1		;POINTER TO NEXT WORD IN FILE
	ALC NOMFDC,0		;# OF ILLEGAL DIR NUMBERS PASSED OVER
	ALC IOEOFP,1		;POINTER TO EOF FOR DISK FILES
	ALC MTADAT,0		;MAGTAP INFORMATION (DEFSTR'S BELOW)
	ALC MFDPT,1		;DIRECTORY COUNT FOR MFD READING

	NTABS==LC-CHTABS
	ALC CHTABN,17*NTABS

	ALC HIBWRD,1		;LAST HIBERNATE FLAGS
	ALC WAKEF,1		;-1 = AN EVENT OCCURED FORCING HIBER TO WAKE UP
	ALC IOWATF,1		;WAITING FOR IO TO HAPPEN
	ALC SAVMOD,1		;SAVED TELETYPE MODE
ALC CHTEND,0			;ABOVE HERE CLEARED BY CALLI 0.

;MAGTAP DEFSTRS

	DEFSTR (MTADEN,MTADAT(BB),35,4) ;DENSITY
	DEFSTR (MTADM,MTADAT(BB),31,4)  ;DATA MODE
	ALC JOB,1		;TSS JOB #
	ALC NJOBS,1		;NUMBER OF JOBS
	ALC HGHSGN,1		;NUMBER OF THE HIGH SEG FOR THIS JOB
IFN FTFILSER,<
	ALC TOPNBL,3		;OPEN BLOCK FOR FILSER
>
	ALC CCIENB,1		;CONTROL-C INTERCEPT IS ENABLED
	ALC CCIFLG,1		;CONTROL-C INTERCEPT IS IN PROGRESS
	ALC FRUSTC,1		;NUMBER OF TIMES ^C HAS BEEN HIT
	ALC FIRPTY,1		;FIRST PTY IN TTYJOB TABLE (SETUP BY ONCE)
	ALC TTINPT,1		;PUTTER POINTER FOR TTCALL BUFFER
	ALC TTOUPT,1		;GETTER POINTER FOR TTCALL BUFFER
	ALC TTCNT,1		;BYTE COUNT,TTCALL INPUT BUFFER
	ALC OTTCNT,1		;NUMBER OF CHARS IN LAST LINE (FOR TTCALL 10)
	TTMAXC==100*4		;MAXIMUM # OF CHARS IN TTBUF
	ALC TTBUF,100		;TTCALL INPUT BUFFER
	ALC TTBUFE,0		;END OF TTBUF
	ALC TTLINE,1		;LINE PRESENT FOR TTCALL
	ALC SVMOD,1		;(321) save controlling TTY SFMOD for CONTinue
	ALC DEVNM7,2		;SEVEN BIT DEVICE NAME
	ALC FILNM7,3		;SEVEN BIT FILE NAME (LEAVE ROOM FOR ^V'S)
	ALC EXT7,2		;SEVEN BIT EXTENSION
	ALC SEE,1		;SAVE EE AND FF DURING MYUUO'S
	ALC BUFFER,2
	ALC IAC,20		;AC'S ON INTERRUPT
	ALC ASAVE,1		;TEMPORARY STORAGE AT INTERRUPT LEVEL

IFN FTSTAT,<
	ALC NCALLI,1		;NUMBER OF THE CALLI UUO BEING DONE
>

	ALC IOBPT,1		;BYTE POINTER FOR IN AND OUT
	ALC IOCNT,1		;COUNT FOR IN AND OUT

TMPBKL==^D120			;LENGTH OF TMPBLK
	ALC TMPBLK,TMPBKL	;TEMP BLOCK, USED FOR ENQ/DEQ
BLLEN==30
	ALC STRNG1,BLLEN		;TEMP STRING STORAGE (LARGE ENOUGH FOR GETJI BLOCK)
				;ALSO USED AS STACK IN CSTART ROUTINES
	ALC DIRNAM,12		;STRING SPACE FOR A DIRECTORY NAME
	ALC FDBB,22
	ALC JBLOCK,14		;FOR JFN ARG LIST

	ALC RETSAV,1		;RETURN SAVED BY PSEUDOINTERRUPT
	ALC LV2SAV,1		;LEVEL 2 PC SAVE WORD
	ALC CNIWRD,1		;SAVES OV EN AND FOV EN FOR APR CONI
	ALC HSORG,1		;ORIGIN OF HISEG (ADDRESS)
	ALC JBREL,1		;SAVED .JBREL
	ALC JBHRL,1		;SAVED .JBHRL
	ALC JBDDT,1		;COMPATIBILITY'S COPY OF .JBDDT
	ALC LOWNAM,1		;NAME OF JOB AS SET BY RUN OR SETNAM UUOS
	ALC LOWDEV,1		;DEVICE FROM WHICH LOW SEG CAME
	ALC LOWPPN,1		;PPN OF LOW SEG
	ALC SEGNAM,1		;NAME OF JOB'S HIGH SEGMENT
	ALC SEGDEV,1		;DEVICE FROM WHICH HIGH SEG CAME
	ALC SEGPPN,1		;PPN OF HIGH SEG
	ALC USRENB,1		;WHAT USER ASKED FOR ON LAST APRENB UUO
	ALC DMPLST,2		;MTA IO BY DUMP COMMANDS HERE
	ALC STRRET,1		;INDEX FOR COMPT. UUO TO RETURN GTJFN STRING AND POINTER
	ALC MTDUMP,1		;TEMP IN DUMP I/O
	ALC SPDELC,1		;TEMP IN DUMP I/O
	ALC TMPJFN,1		;JFN OF TMPCOR FILE
	ALC FLSJFN,1		;JFN OF FILSER DATA BASE FILE
	ALC TTYFRK,1		;FORK HANDLE FOR TTY HIBERNATE FORK
	ALC TYSTAT,1		;TTY STATUS (CONTROLLING TTY).
				; SIGN IS ^O FLAG, RH IS INIT BITS
	ALC CSTFLG,1		;FLAG TO FORCE MRETN TO DO A START/REE
	ALC UIFLAG,1		;USER INTERRUPT PENDING FLAG
	ALC UIIFLG,1		;USER INTERRUPT IIC DONE FROM MRETN
	ALC UITRAP,1		;USER INTERRUPT TRAP ADDRESS
	ALC UIACA,1		;PLACE TO SAVE AN AC DURING USER INT
	ALC LEVTAB,3		;PSI LEVEL TABLE
	USRSAV==LEVTAB+2	;POINTER TO USER INTERRUPT PC
	ALC CHNTAB,^D36		;PSI CHANNEL TABLE

	ALC JOBNAM,1		;STORAGE AREA FOR SYSGET MACRO
	ALC TICKPS,1
	ALC SNAMES,1
	ALC SSIZE,1
	ALC SNBLKS,1
	ALC SYSVER,1
	ALC PTYPAR,1
	ALC SYSTAT,1
	ALC TTYJOB,1
	ALC DWNTIM,1		;CEASE TIME
	ALC DMAPTB,NPPN		;TABLE OF DIRECTORY NUMBERS FOR UNMAPPING
	ALC LSTUFD,1		;LAST UFD READ
	ALC LSTUFJ,1		;JFN USED TO READ LAST UFD
	ALC LSTUFP,1		;POINTER INTO UFD
	ALC LSTMFP,1		;POINTER INTO MFD
	ALC LSTMFN,1		;LAST DIR NUM USED IN MFD READ
	ALC NEWJFN,1		;JFN TO BE RELEASED AT LOOKER
	ALC USRMSK,1		;MASK OF CHANNELS DEFINED BY USER
	ALC MAPLST,1		;BIT MASK OF AVAILABLE PREFAULTING PGS
	ALC MAPTOT,1		;# OF FILES THAT ARE BEING PREFAULTED

CLRTOP==LC-1			;LAST LOCATION CLEARED ON FIRST ENTRY

	ALC STIME,1		;RUN TIME AT START OF UUO FOR STATISTICS
	ALC ITIME,1		;UPTIME IN MILLISECONDS FOR MSTIME UUO
	ALC ECHINI,1		;INITIAL ECHO SETTING
	ALC TTWDTH,1		;WIDTH OF LINE BEFORE TURNING OFF CR-LF
	ALC ACS,20		;USER'S AC'S AT TIME OF UUO.
	ALC PFLAGS,1		;STORAGE FOR PF AC WHILE USER RUNS.
	ALC INPAT,1		;IN PAT IF NON-0,IN USER PROG IF 0
	ALC INFLSR,1		;IN FILSER, CONTROL-C'S ARE NOT ALLOWED
	ALC FDBTMP,1		;ROOM TO MODIFY A WORD OF FDB
	ALC MONUUO,1		;COPY OF MONITOR 40
	ALC MONUPC,1		;USER PC SAVED BY MONITOR
	ALC CSTCOD,1		;^C START CODE: -1=ST,
				; -2=REE, -3=DDT,, -4=CLOSE, +N=GOTO N
	ALC CSTOPC,1		;OLD PC WHERE ^C CONT WOULD HAVE GONE
	ALC CLSDEV,1		;LOC TO STORE DEV NAME TO BE CLOSED?
	ALC EXITPC,1		;PC TO CONTINUE AT IF USER CONTINUES AFTER MONRET
	ALC SAVTIW,1		;PLACE TO STORE OLD TERMINAL INT WORD
	ALC RUNDEV,1		;DEVICE SPECIFIED IN RUN UUO
	ALC RUNNAM,1		;NAME OF PROGRAM TO RUN
	ALC RUNEXT,1		;EXT OF PROG TO BE RUN
	ALC RUNPPN,1		;PPN OF PROG TO RUN

PDLL==40
	ALC PDL,PDLL
FPDLEN==10
	ALC FRKPDL,FPDLEN	;STACK FOR TTY FORK
IPDLL==10
	ALC IPDL,IPDLL		;USED AT INTERRUPT LEVEL 1

	ALC FORTY,1		;PLACE TO STORE CONTENTS OF 40 AT TIME OF CALL
				;THIS IS LAST SO THAT THE SECOND PAGE
				;GETS CREATED ON THE FIRST UUO

	TSTOP=LC		;END OF TEMP STORAGE. TRY TO KEEP
				; THIS IN TWO PAGES. (REF IOMPGS)
	NIOPGS==30		;PAGES AVAILABLE FOR PREFAULTING
				;THIS SHOULD BE DIVISIBLE BY NPLPGS
	NPLPGS==4		;NUMBER OF PRELOADED PAGES AT A TIME
	IOMPGS==<<TSTOP>_-11>+1	;MAPPED I/O USES 32. PAGES STARTING HERE
	IOMEND==IOMPGS+NIOPGS	;FIRST FREE PAGE AFTER I/O AREA

	NPATPG==<MAXPAT-PATLOC>_-11 ;# OF PAGES FOR PAT


IFL <MAXPAT-IOMEND>,<PRINTX ? PAT is too big -- reduce NIOPGS>
SUBTTL ENTRY VECTOR AND TOP-LEVEL OF UUO HANDLER

	HISEG
	PHSLOC==PATLOC+.JBHDA
	PHASE PHSLOC

EVEC=PATLOC		;COPY TO PUBLISHED LOCATION

;**** CAUTION!
;	THE ENTRY VECTOR STARTING AT KEVEC IS BLT'ED TO EVEC BY LINIT
;	THEREFORE THERE MUST BE NOTHING SHOULD PRECEED KEVEC 

KEVEC:	JRST COMPAT		;0 - UUO'S NORMALLY ENTER VIA THIS
	JRST PATINI		;1 - FIRST UUO ENTERS VIA THIS
	EXP PATVER		;2 - VERSION OF PAT IS IN FIXED LOC 700002
	MONUUO			;3 - MON 40 DUMPED HERE ON MON UUO
	MONUPC			;4 - USER PC DUMPED HERE ON MON UUO
	JRST MAKSHR		;5 - MAKE SHR VERSION OF SUBSYSTEM
	EXP CCPSIN		;6 - CHANNEL FOR EXEC TO PSI ON FOR ^C REE
	XWD CSTCOD,CSTOPC	;7 - WHERE TO STORE DATA FOR ^C ST SEQ.
	XWD JBHRL,JBREL		;10 - POINTERS SO EXEC CAN DO CORE COMMAND
	XWD LOWNAM,CLSDEV	;11 - LH = LOW SEG NAME FROM RUN OR SETNAM
				;     RH=PLACE FOR EXEC TO PUT DEV NAME OR JFN TO BE CLOSED
	XWD DEBUG1,SEGNAM	;12 - LH = START ADR TO INITIALIZE PAT, 
				;     RH = HIGH SEG NAME
	XWD NTABS,JFNTAB	;13 - LH = LENGTH OF DATA BASE FOR EACH CHANNEL
				;     RH = ADR OF JFN FOR CHANNEL 0
EVECL==.-KEVEC			;LENGTH OF ENTRY VECTOR
CSTMCD==5			;MAX VALUE OF CSTCOD KNOWN ABOUT

SJBSYM: BLOCK 1			;PLACE FOR LINIT TO STASH .JBSYM
PVLOC:	EXP PATVER		;VERSION NUMBER USED BY MAKEPF

;10/50 TYPE UUO'S ARRIVE HERE

PATINI:	SETZM PFLAGS		;FIRST TIME ENTRY. CLEAR FLAG WORD.
COMPAT:
IFN FTFILSER,<	SETZM INFLSR>		;CLEAR FILSER FLAG
	SETZM FRUSTC		;INITIALIZE FRUSTRATION COUNTER
	SETZM IOWATF		;CLEAR WAITING FLAG
	MOVEM 17,ACS+17
	MOVEI 17,ACS
	BLT 17,ACS+16
	SETOM INPAT		;MARK THAT ACS ARE SAVED
	HLLZ PF,PFLAGS		;FLAGS TO AC FOR PAT'S FLAGS.
IFN FTSTAT,<
	MOVEI A,1		;GET RUN TIME IN 10 MICROSECOND INCREMENTS
	TLNE PF,L.LSTA!L.GSTA	;DONT DO HPTIM IF NO STATISTICS BEING DONE
	HPTIM
	  TLZ PF,L.GSTA!L.LSTA	;DONT DO ANY MORE STATISTICS
	MOVEM A,STIME		;SAVE FOR USE AT END OF UUO
>
	MOVE P,PATSTK		;SETUP LOCAL STACK
IFN SAMFRK,<
	MOVE A,MONUUO
	MOVEM A,FORTY		;PRESERVE 40 OVER MYUUO'S
BP:	LDB AC,ACPTR		;GET AC FIELD OF UUO
	MOVE CAC,ACS(AC)	;CONTENTS OF USER AC (MAY BE IRRELEV.)
	MOVE A,MONUPC		;GET CALLING PC OF USER UUO
	MOVEM A,JOBPD1		;PUT IT IN 10/50'S STACK AREA
	PUSH P,A		;AND ON PAT'S STACK
>
IFE SAMFRK,<
	LDB AC,ACPTR		;GET AC FIELD OF UUO
	UMOVE CAC,0(AC)		;CONTENTS OF USER AC (MAY BE IRRELEV.)
	PUSH P,MONUPC
>
	TLNN PF,L.ONCE		;FIRST TIME?
	PUSHJ P,ONCE		;YES. GO SET UP PSI AND TEMP STORAGE
	SETZM NEWJFN		;INITIALIZE THIS LOCATION
	SKIPN CCIENB		;IS ^C INTERCEPT ALREADY SET
	TLNE PF,L.NCCE		;NO, IS CONTROL-C ENABLING ALLOWED?
	  JRST COMPA1		;NO, SO DONT DO IT
	SKIPE A,.JBINT		;IS .JBINT NOW NON-ZERO
	PUSHJ P,CHKCCI		;YES, CHECK TO SEE IF ^C INTERCEPT TO BE SET
COMPA1:	LDB A,[POINT 9,FORTY,8] ;GET UUO NUMBER
	CAIL A,40		;SMALL NUMBERS ARE ILLEGAL
	CAIL A,100		;IS IT A GOOD ONE?
	PUSHJ P,ITRAP		;NO GOOD.
	JRST @COMUTB-40(A)	;WE ONLY WANT TO DO 40-77

COMUTB:	EXP UCALL,UINIT,ITRAP,ITRAP,ITRAP,ITRAP,ITRAP,UCALLI
	EXP UOPEN,UTTCLL,ITRAP,ITRAP,ITRAP,URENME,UIN,UOUT
	EXP USETST,USTATO,UGETST,USTATZ,UINBUF,UOUTBF,UINPUT,UOUTPT
	EXP UCLOSE,URELEA,UMTAPE,UUGETF,UUSETI,UUSETO,ULOOKP,UENTER

ACPTR:	POINT 4,FORTY,12
PATSTK:	IOWD PDLL,PDL		;LOCAL STACK
PSISTK: IOWD PDLL,PDL		;STACK WHILE ON LEVEL 1
;RETURN FROM 10/50 UUO

MRETN2:
	AOS PDL			;SKIP RETURN
MRETN:	MOVEM PF,PFLAGS		;SAVE FLAG AC
	MOVE A,PDL		;GET USER PC
	MOVEM A,JOBPD1		;STORE FOR HIM TO SEE
	HRRI A,1(A)		;SET UP FOR INTERRUPT RETURN
	MOVEM A,MONUPC		;UPDATE RETURN ADDRESS
	SKIPE A,CSTFLG		;CONTROL-C, START DONE?
	JRST CSTMRT		;YES. GO PROCESS IT
MRETNA:
IFN FTSTAT,<
	TLNE PF,L.LSTA!L.GSTA	;IF NOT TAKING STATISTICS, DONT CALL ROUTINE
	PUSHJ P,DOSTAT		;GO DO SOME STATISTICS
>
	MOVSI 17,ACS
	BLT 17,17
	SETZM INPAT		;ACS NOW RESTORED
	SKIPN UIFLAG		;USER INTERRUPT PENDING
	JRSTF @JOBPD1
	SETZM UIFLAG		;CLEAR USER INTERRUPT FLAG
	SETOM UIIFLG		;MARK THAT AN IIC IS BEING DONE
	MOVEI A,.FHSLF		;INTERRUPT BACK UP TO LEVEL 3
	MOVSI B,(1B0)		;CHANNEL 0 IS USER CHANNEL
	IIC
	PUSHJ P,BUGSTP		;SHOULD NEVER GET HERE

CSTMRT:	SETZM CSTFLG		;CLEAR FLAG THAT START DONE.
	SKIPE INFLSR		;WAS CONTROL-C TURNED OFF FOR FILSER?
CSTMR1:	  JRST [SETZM INFLSR	;YES, OK TO ALLOW CONTROL-C'S
		SETZM CCIFLG	;CLEAR CONTROL-C FLAG
		SETZM CCIENB	;MARK THAT CONTROL-C NOT DISABLED
		MOVEI A,3	; GET CONTROL-C CHANNEL
		DTI		;DEACTIVATE IT
		TMSG <^C>	;TYPE OUT ^C
		HALTF		;AND EXIT
		JRST MRETNA]	;RETURN IF CONTINUED
	HLL A,JOBPD1		;PRESERVE USER'S FLAGS
	EXCH A,JOBPD1		;PUT START ADR IN RETURN, GET UNUSED RET
	MOVEM A,.JBOPC		;PUT THE RETURN IN OPC FOR USER
	SKIPN CCIFLG		;IS THERE A ^C INTERCEPT IN PROGRESS?
	  JRST MRETNA		;NO, RETURN TO USER ADR
	SETZM CCIFLG		;YES, CLEAR FLAG
	SKIPN B,.JBINT		;GET POINTER TO INTERCEPT BLOCK
	  JRST CSTMR1		;NOT SET UP, LET ^C TAKE
	MOVE C,1(B)		;GET FLAGS
	SKIPN 2(B)		;IS PC WORD ZERO?
	TRNN C,ER.ICC		;AND, IS CONTROL-C STILL ENABLED?
	  JRST CSTMR1		;NO, LET ^C THROUGH
	MOVEM A,2(B)		;STORE INTERRUPTED ADDRESS
	JRST MRETNA		;AND RETURN TO HIM

BAPOPJ:	POP P,B
APOPJ:	POP P,A
	POPJ P,

CPOPJ2:	AOS (P)
CPOPJ1:	AOS (P)		;SKIP RETURN
CPOPJ:	POPJ P,

;COMMON RETURNS FROM UUO'S

RETZR1:	TDZA A,A		;CLEAR AC A, THEN STOCT1 SKIP RET 
RETZER:	TDZA A,A		;CLEAR AC A, AND SKIP TO STOTAC
STOTC1:	AOS PDL			;SET FOR SKIP RETURN
STOTAC:
IFN SAMFRK,< MOVEM A,ACS(AC)>	;STORE THE AC FOR USER
IFE SAMFRK,< UMOVEM A,0(AC)>	;STORE THE AC FOR THE USER
	JRST MRETN		;AND RETURN FROM THE UUO

RETM11:	AOS PDL			;SKIP RETURN A MINUS 1
RETM1:	MOVNI A,1		;RETURN A MINUS ONE
	JRST STOTAC		;TO USER'S AC
;STATISTICS GATHERING ROUTINES

IFN FTSTAT,<
DOSTAT:	MOVEI A,1		;READ CLOCK AGAIN
	HPTIM
	  POPJ P,		;JUST RETURN WITHOUT DOING STATISTICS
	SUB A,STIME		;GET AMOUNT OF TIME TO DO UUO
	MOVE B,A
	LDB A,[POINT 6,FORTY,8]	;GET UUO OPCODE
	STAT A,B,<ST.UUO-40>	;DO STATISTICS REPORTING
	CAIN A,(TTCALL_-^D9)	;IS THIS A TTCALL UUO?
	  JRST STTTCL		;YES, GO COUNT IT
	TRNE PF,R.CMR		;IS THIS A CMRETN RETURN
	  JRST STUNI		;YES, GO COUNT UNIMPLEMENTED CALLS
	CAIE A,(CALLI_-^D9)	;CALLI UUO?
	CAIN A,(CALL_-^D9)	;OR A CALL UUO?
	  SKIPA A,NCALLI	;YES, GET CALLI #
	  POPJ P,		;NO, THEN WE ARE DONE
	TRNE A,200000		;NEGATIVE CALLI?
	  HRRZI A,200(A)	;YES, GET OFFSET FROM 200
	ANDI A,377777		;CLEAR PHYSICAL ONLY BIT
	TRNE A,777600		;WITHIN BOUNDS?
	  POPJ P,		;NO, DO NO ACCOUNTING
	STAT A,B,<ST.CLI>	;ACCOUNT!
	CAIE A,41		;GETTAB UUO?
	  POPJ P,		;NO, RETURN
	HLRZ A,NCALLI		;GET TABLE #
	TRNE A,777700		;WITHIN BOUNDS?
	  POPJ P,		;NO, RETURN
	STAT A,B,<ST.GTB>	;COUNT IT UP
	POPJ P,			;FINALLY DONE

STTTCL:	LDB A,ACPTR		;GET AC FIELD
	STAT A,B,<ST.TCL>
	POPJ P,			;RETURN

STUNI:	MOVEI A,0
	STAT A,B,<ST.UNI>
	POPJ P,
>
;LOCAL UUO SERVICE

REPEAT 0,<
MYUU:	MOVEM EE,SEE
	MOVEM FF,SFF
IFN SAMFRK,<
	MOVE EE,MONUPC
	MOVEM EE,MYUUO		;PC TO UUO RETURN
>
	LDB EE,[POINT 9,MY40,8]
	SUBI EE,42		;FIRST LOCAL UUO
	CAIL EE,0		;LOCAL UUO?
	CAILE EE,2
	JRST [	MOVE EE,SEE	;NO, MUST HAVE BEEN ^C, REENTER
		JRST COMPT2]	;TREAT AS USER OP
	JRST	@.+1(EE)
	EXP MMOVE,MMOVEM,MXCT

MXCT:	HRRZ EE,MY40		;PTR TO INST TO XCT
	MOVEI EE,@(EE)		;COMPUTE EFFECTIVE ADDR
	CAIGE EE,20
	ADDI EE,ACS		;E IN ACS, OFFSET
	HLL EE,@MY40	
	TLZ EE,37		;FLUSH IND AND INDEX
	XCT EE
	JRST MUR1
	AOS MYUUO		;FOR SKIP TYPE INSTRUCTIONS THAT DID
	JRST MUR1

MMOVE:	LDB EE,[POINT 4,MY40,12]
	HRRZ FF,MY40		;EFFECTIVE ADDR
	CAIGE FF,20		;AC?
	ADDI FF,ACS		;YES, POINT TO SAVED AC'S
	MOVE FF,(FF)		;FETCH OBJECT
	MOVEM FF,(EE)		;PUT INTO PROPER AC
	JRST MUR2

MMOVEM:	LDB EE,[POINT 4,MY40,12]
	MOVE EE,(EE)
	HRRZ FF,MY40
	CAIGE FF,20
	ADDI FF,ACS
	MOVEM EE,(FF)
	JRST MUR2

MUR2:	MOVE FF,SFF
MUR1:	MOVE EE,SEE
	JRSTF @MYUUO
>	;END OF REPEAT 0 CONDITIONAL
UXCT:	MOVE EE,@0(P)		;GET INSTRUCTION TO BE EXECUTED
	MOVEI FF,@EE		;GET EFFECTIVE ADDRESS
	CAML FF,HSORG		;CHECK THE ADDRESS - IN HISEG?
	CAMLE FF,JBHRL		;YES, IS THIS A LEGAL HIGH SEG ADDRESS?
	CAMG FF,JBREL		;IS IT A LEGAL LOW SEG ADR
	  SKIPA			;IT IS LEGAL
	PUSHJ P,ITRAP		;ILLEGAL, GO PRINT OUT MESSAGE
	CAIL FF,20		;IN THE AC'S?
	POPJ P,			;NO, THEN WE CAN DO THIS INST DIRECTLY
	HRRI EE,ACS(FF)		;GET OFFSET EFFECTIVE ADDR
UXCT1:	TLZ EE,37		;CLEAR INDEX AND INDIRECT BITS
	AOS (P)			;SKIP OVER INST
	XCT EE			;DO THE INST (MODIFIED)
	POPJ P,			;NO SKIP
	JRST CPOPJ1		;SKIP RETURN

LBXCT:	MOVE EE,@0(P)		;HERE TO XCT BYTE INSTRUCTIONS
	MOVE FF,@EE		;GET POINTER WORD
	MOVEI FF,@FF		;GET EFFECTIVE ADDRESS OF DESTINATION
	CAML FF,HSORG		;IN HISEG?
	  CAMLE FF,JBHRL	;YES, IS IT LEGAL?
	CAMG FF,JBREL		;LEGAL LOW SEG ADR?
	  SKIPA			;YES, LEGAL ADR
	  PUSHJ P,ITRAP		;ILLEGAL ADR, GO TYPE MESSAGE
	CAIL FF,20		;ADR IN THE ACS
	  POPJ P,		;NO, GO EXECUTE IT
	HLL FF,@EE		;RESTORE P AND S FOR BYTE POINTER
	TLZ FF,37		;CLEAR INDIRECT AND INDEX BITS
	HRRI FF,ACS(FF)		;MAKE IT POINT TO SAVED ACS
	HRRI EE,FF		;MAKE EE USE FF AS POINTER
	JRST UXCT1		;GO DO INSTRUCTION

DOJSYS:	TRO PF,R.ILLJ		;MARK THAT WE ARE IN AN XJSYS MACRO
	XCT @0(P)		;XCT THE JSYS
	AOS 0(P)		;SET UP FOR SKIP RETURN
				;THIS INSTRUCTION IS SKIPED IF AN
				;  INTERRUPT OCCURED DURING THE JSYS
	TRZ PF,R.ILLJ		;CLEAR FLAG FOR INTERRUPT LEVEL
	JRST CPOPJ1		;SKIP OVER JSYS INSTRUCTION ITSELF

INJSYS:	SKIPN UIFLAG		;USER INTERRUPT PENDING?
	SKIPE CSTFLG		;OR ^C INTERRUPT PENDING?
	JRST [	SETZM IOWATF	;CLEAR WAITING FLAG
		SOS PDL		;DECREMENT PC
		JRST MRETN]	;EXIT TO USER
	XCT 0(EE)		;DO THE JSYS
	 JRST 1(EE)		;NON-SKIP RETURN
	JRST 2(EE)		;SKIP RETURN
INJSYE:
SUBTTL UUO PROCESSORS FOR INDIVIDUAL UUO'S
;10/50 CALL AND CALLI TABLES
;NOTE THAT NEGATIVE CALLIS AND 0-55 HAVE SIXBIT CALLS
; WHILE 56 UP DO NOT.
MXSIXB==55			;MAXIMUM CALLI WHICH HAS A SIXBIT ARG

DEFINE MCALLI
<CC LIGHTS,LIGHTS
>
DEFINE PCALLI
<CC RESET,RESET
 CC DDTIN,DDTIN
 CC SETDDT,SETDDT
 CC DDTOUT,DDTOUT
 CC DEVCHR,DEVCHR
 CC DDTGT
 CC GETCHR,GETCHR
 CC DDTRL
;10
 CC WAIT
 CC CORE,CORE
 CC EXIT,EXIT
 CC UTPCLR,UTPCLR
 CC DATE,DATE
 CC LOGIN,ILEGAL
 CC APRENB,APRENB
 CC LOGOUT,LOGOUT
;20
 CC SWITCH,SWITCH
 CC REASSI,REASSI
 CC TIMER,TIMER
 CC MSTIME,MSTIME
 CC GETPPN,GETPPN
 CC TRPSET,ILEGAL
 CC TRPJEN,ILEGAL
 CC RUNTIM,RUNTIM
;30
 CC PJOB,PJOB
 CC SLEEP,SLEEP
 CC SETPOV
 CC PEEK,RETZER
 CC GETLIN,GETLIN
 CC RUN,RUN
 CC SETUWP,MRETN2
 CC REMAP,REMAP
;40
 CC GETSEG,GETSEG
 CC GETTAB,GETTAB
 CC SPY
 CC SETNAM,SETNAM
 CC TMPCOR,TMPCOR
 CC DSKCHR,DSKCHR
 CC SYSSTR,SYSSTR
 CC JOBSTR,JOBSTR
;50
 CC STRUUO,STRUUO
 CC SYSPHY,SYSPHY
 CC FRECHN
 CC DEVTYP,DEVTYP
 CC DEVSTS
 CC DEVPPN,DEVPPN
 CC SEEK
 CC RTTRP
;60
 CC LOCK
 CC JOBSTS,JOBSTS
 CC LOCATE
 CC WHERE
 CC DEVNAM,DVNAM.
 CC CTLJOB,CTLJOB
 CC GOBSTR,GOBSTR
 CC ACTIVA
;70
 CC DEACTI
 CC HPQ
 CC HIBER,HIBER
 CC WAKE,WAKE
 CC CHGPPN
 CC SETUUO
 CC DEVGEN
 CC OTHUSR
;100
 CC CHKACC,CHKACC
 CC DEVSIZ,DEVSIZ
 CC DAEMON
 CC JOBPEK
 CC ATTACH
 CC DAEFIN
 CC FRCUUO
 CC DEVLNM
;110
 CC PATH.,PATH
 CC METER.
 CC MTCHR.,MTCHR
 CC JBSET.
 CC POKE.
 CC TRMNO.,TRMNO
 CC TRMOP.,.TRMOP
 CC RESDV.,RESDV
;120
 CC UNLOK
 CC DISK.
 CC DVRST.
 CC DVURS.
 CC 124
 CC 125
 CC 126
 CC 127
 CC 130
 CC 131
 CC 132
 CC 133
 CC 134
 CC 135
 CC 136
 CC 137
 CC 140
 CC 141
 CC 142
 CC 143
 CC 144
 CC 145
 CC 146
 CC COMPT.,COMPT.
;150
 CC 150
 CC ENQ,.ENQ
 CC DEQ,.DEQ
 CC ENQC,.ENQC
 CC TAPOP,TAPOP
 CC FILOP,FILOP
>

DEFINE CC (A,B)<
IFB <B>,<
	JRST CMRETN		;   A UNIMPLEMENTED
>
IFNB <B>,<
	JRST	B		; A HANDLER
>
>

MCLIT:
MCALLI				;TRANSFER TO NEGATIVE CALLI'S
NMCLI==.-MCLIT			;NUMBER OF MINUS CALLI'S
CALLTV:				;ADDRESS OF TABLE ENTRY FOR CALLI 0

PCALLI				;TRANSFERS FOR POSITIVE CALLI'S

NPCLI==.-CALLTV
;UUO'S
;CALL AND CALLI

UCALL:	UMOVE A,@FORTY	;ARG TO CALL IN SIXBIT, NAME OF ROUTINE
	MOVSI B,-<NPCAL+NMCAL>	;LENGTH OF TWO SIXBIT TABLES
	CAMN A,CALLIT-NMCAL(B)	;THIS ENTRY IN NAME TABLE?
	JRST [MOVEI B,-NMCAL(B)	;YES. GET CALLI NUMBER IT WOULD BE
		JRST UCALL1]	;AND GO TO CALLI HANDLER
	AOBJN B,.-2		;NO, TRY NEXT NAME
CMRETN:
IFN FTSTAT,<
	TRO PF,R.CMR		;MARK THAT AN UNIMPLEMENTED CALL WAS DONE
>
	JRST MRETN		;MAKE A NO-OP.

UCALLI:	HRRZ B,FORTY		;EFFECTIVE ADDR IS THE ARG
	TRNE B,B18		;EXTEND SIGN INTO PHYSICAL BIT.
	TROA B,1B19		;IT'S NEGATIVE.
	TRZ B,1B19		;ITS POSITIVE
	MOVEI A,NPCLI+NMCLI	;TOTAL CALLI LENGTH. CATCHES NEGATIVE
				; OUT OF RANGE TOO, BY HALF-WORD ARITHMETIC
	CAIG A,NMCLI(B)		;OFFSET TO ACCOUNT FOR LEGAL NEGATIVE VALUES
	JRST CMRETN		;LARGE ARGUMENTS ARE NO-OPS
UCALL1:
IFN FTSTAT,<
	HRRM B,NCALLI		;SAVE CALLI # FOR ACCOUNTING
	HRLM CAC,NCALLI		;SAVE GETTAB TABLE # ALSO
>
	JRST @CALLTV(B)		;DISPATCH
SUBTTL UUOS FOR FILE OPERATIONS

;FILE STUFF

GSTATS:	PUSHJ P,SETUP
	MOVE C,FLAGWD(BB)
	CAIN AA,PTY		;IS THIS A PTY?
	  JRST PTYSTS		;YES, GO GET PTY STATUS
	HRRZ A,C
	CAIE AA,MTA		;THIS A MTA?
	POPJ P,
	PUSHJ P,GST2		;YES, GET CURRENT MTA STATUS
	MOVEI B,4000		;CLEAR BOT IN FLAGWD
	ANDCAM B,FLAGWD(BB)	;THIS BIT IS ALWAYS CORRECT FROM GST2
	IORB A,FLAGWD(BB)	;GET CONDITOINS ALREADY SET
	HRRZS A
	POPJ P,

;ROUTINE TO GET STATUS FOR MAGTAPE.
;RETURNS WITH GDSTS DATA IN B, UPDATED 10/50 STATUS IN A.
;IOBKTL ISN'T SET, DUE TO THE COMPLEXITY OF 1B23 OF VIROS GDSTS.
; THE CALLER IS LEFT TO DO THAT

GST2:	HRRZ A,JFNTAB(BB)	;SEE IF JFN IS OPEN
	GTSTS
	JUMPL B,GST3		;IF 1B0 = 1, THEN OPENED
	MOVE B,[440000,,OF%RD]	;NOT OPENED, MUST OPEN IT FIRST
	OPENF
	 JRST GST3		;FAILED, GO GET WHATEVER POSSIBLE
	GDSTS			;GET THE STATUS
	TLO A,(CO%NRJ)		;NOW CLOSE THE JFN
	CLOSF			;BUT KEEP IT FROM BEING RELEASED
	 JFCL
	JRST GST4		;ENTER COMMON CODE

GST3:	HRRZ A,JFNTAB(BB)	;ARGUMENT TO GDSTS
	GDSTS			;GET VIROS STATUS
GST4:	MOVE C,FLAGWD(BB)	;OLD TEN FIFTY STATUS
	TRZ C,707700		;BITS WHICH MAY NEED UPDATING
	MOVE A,B		;VIROS BITS TO A
	TRZE A,MT%IRL		;ILLEGAL RECORD LENGTH?
	TRO A,1B21		;YES, TURN IT INTO TOPS10 BIT
	ANDI A,767600		;ONLY ONES TO KEEP ARE MATCHING HDW BITS
	TRZE A,40000		;SUPPRESS ERROR RETRY?
	TRO A,100		;YES, MOVE TO CORRECT PLACE
	TLNN C,MTALTW		;LAST TRANSFER A WRITE?
	TRZ A,MT%ILW		;NO, WE DONT WANT TO SEE WRITE LOCK BIT
	IOR A,C			;ADD IN OLD STATUS AND IOBKTL
	HRRZS A			;JUST RIGHT-HALF
	POPJ P,0		;RETURN

UGETST:	PUSHJ P,GSTATS
	UMOVEM A,@FORTY
	JRST MRETN

USTATO:	PUSHJ P,GSTATS
	TDNE A,FORTY
	JRST MRETN2		;SKIP RETURN
	JRST MRETN		;NOSKIP RETURN

USTATZ:	PUSHJ P,GSTATS
	TDNN A,FORTY
	JRST MRETN2		;SKIP RETURN
	JRST MRETN		;NOSKIP RETURN
USETST:	PUSHJ P,SETUP
	HRRZ B,FORTY
	HRRM B,FLAGWD(BB)	;SAVE MODE ETC
	CAIN AA,MTA		;THIS A MTA?
	  JRST MTASET		;YES, GO SET UP PARITY AND DENSITY
	MOVSI A,TTYDEV
	TDNN A,DEVTBL(AA)	;TTY?
	JRST MRETN		;NO, DONE
	PUSHJ P,TTYSET		;SET UP NEW TTY MODE
	JRST MRETN

TTYSET:	MOVE A,JFNTAB(BB)	;GET JFN FOR THIS TTY
	MOVE E,FLAGWD(BB)	;AND FLAGS
	TLNN E,TT.CTY		;IS THIS THE CONTROLING TTY?
	  JRST TTSET1		;NO
	HRRM E,TYSTAT		;YES, SAVE THE NEW MODE
	MOVE E,TYSTAT		;GET FLAGS
TTSET1:	JRST TTYST0		;GO SET UP NEW MODE

UOPEN:	TLOA C,-1
UINIT:	TLZ C,-1
	PUSHJ P,SETUPG		;IS A DEVICE ALREADY INIT'ED?
	  JRST UINIT1		;NO
	PUSH P,C		;SAVE WHETHER OPEN OR INIT
	PUSHJ P,URELR		;CALL RELEASE FOR THIS CHANNEL
	POP P,C

UINIT1:	JUMPL C,UOPEN1		;WAS IT OPEN?
	MOVE A,(P)		;A TO POINT AT FIRST OF THREE ARGS
	AOS 0(P)
	AOS 0(P)		;P TO POINT TO R1
	MOVE C,FORTY		;MAY BE THE RESULT OF AN XCT
	SOJA A,UOPEN2

UOPEN1:	HRRZ A,FORTY		;EFFECTIVE ADR IS POINTER TO THREE ARGS
	UMOVE C,(A)
UOPEN2:	HRRZM C,FLAGWD(BB)	;TAKES CARE OF STATUS FOR NOW
	UMOVE C,2(A)
	MOVEM C,BUFHTB(BB)	;XWD OBUFH,IBUFH
	UMOVE C,1(A)		;SIXBIT NAME FROM USER
	CAMN C,[SIXBIT/PTY/]	;IS THIS A GENERIC PTY
	  PUSHJ P,GETPTY	;YES, GO GET A PHYSICAL PTY
	MOVEM C,DEVNAM(BB)	;SAVE IT IN SIXBIT
	PUSHJ P,DEV67		;PUT IT IN DEVNM7
	MOVE C,DEVNAM(BB)	;GET SIXBIT BACK
;FIND OUT WHAT DEVICE REALLY IS
;CHECK FOR LEGAL MODE
;SET BUFFER SIZE AND BYTE SIZE IN C

	HRROI A,DEVNM7
	STDEV			;GET DEVICE CHARACTERISTICS
	  TDZA B,B		;NOT A LEGAL DEVICE NAME, TRY SYS AND TTY
	JRST UOPENE		;FOUND DEVICE, GO OPEN IT
	CAMN C,[SIXBIT /SYS/]
	JRST UOPENE		;CAN'T STDEV ON SYS
	MOVSI B,TTY
	CAMN C,[SIXBIT /TTY/]
	JRST UOPENE
IFN FTFILSER,<
	MOVE A,DEVNAM(BB)	;GET NAME
	PUSHJ P,DPACHK		;SEE IF THIS IS A TOPS-10 PACK
	  JRST MRETN		;IT IS NOT, ERROR
	MOVEM A,DEVNAM(BB)	;SAVE PACK NAME
	JRST TOPEN		;GO DO THE OPEN
>

UOPENE:	MOVEM B,DEVNUM(BB)	;SAVE DEVICE DESIGNATOR
	PUSHJ P,UOPENF		;DO THE OPEN COMMON CODE
	  JRST MRETN		;FAILED
	JRST MRETN2		;OPEN WAS SUCCESSFUL
	JRST UOPEN6		;NOT A DISK, GO DO GTJFN NOW

UOPENF:	MOVE E,FLAGWD(BB)
	LDB AA,PDVNUM		;GET THE VIROS DEVICE TYPE NUMBER
	CAIN AA,TTY		;IS THIS A TTY
	  PUSHJ P,[GJINF	;YES, GET CONTROLING TTY NUMBER
		HRRZ A,DEVNUM(BB)
		CAME A,D	;IS THIS THE CONTROLING TTY?
		  POPJ P,	;NO, JUST RETURN
		HLL E,TYSTAT	;YES, GET CURRENT STATE FLAGS
		TLO E,TT.CTY	;ADD CONTROLLING TERMINAL BIT
		MOVEM E,FLAGWD(BB) ;STORE BITS FOR CHANNEL
		MOVEI A,.CTTRM	;CONTROLLING TTY
		JRST TTPSTS]	;GO SET TERMINAL MODE AND RETURN
	MOVE C,DEVTBL(AA)	;GET LEGAL 10/50 MODE BITS
	ANDI E,17		;WHAT MODE
	MOVEI D,1
	ROT D,(E)		;PUT BIT IN 35-N
	TRNN C,(D)		;IS MODE LEGAL FOR THIS DEVICE
	 POPJ P,		;NO	****NOT RIGHT. SHOULD BE ILLMOD***
	CAILE E,14		;BUFFERED?
	JRST UOPEN4		;NO
	MOVSI C,004400		;FIDDLE WITH MODE NUMBER TO GET BYTE SIZE
	CAIGE E,10		;MODE >=10?
	MOVSI C,000700		;NO, 7 BIT, NOT 36
	MOVEI E,0
	MOVE D,BUFHTB(BB)
	TRNN D,-1		;IS THERE AN INPUT HEADER?
	JRST UOPNE1		;NO
UOPNE0:	UMOVEM E,(D)
	UMOVEM C,1(D)
	UMOVEM E,2(D)

UOPNE1:	HLRZ D,D		;FIRST TIME LEFT HALF IS OUTPUT HEADER
	JUMPN D,UOPNE0		;EITHER NO OUT HDR OR SECOND TIME THRU
UOPEN4:	MOVSI B,INITF		;CHANNEL INIT'ED
	IORB B,FLAGWD(BB)	;MARK IT.
;**; Insert two lines at UOPEN4 + 1 1/2
	CAIN AA,.DVNUL		;[332] NUL?
	JRST CPOPJ2		;[332] YES, FORGET ALL THIS
	MOVE B,DEVTBL(AA)
	TLNN B,DTADEV		;DECTAPE?
	TLNE B,DSKDEV		;OR DSK?
	  JRST CPOPJ1		;YES, CAN'T GTJFN YET.
	MOVE B,DEVTBL(AA)
	TLNN B,MTADEV		;IS IT A MAGTAPE?
	JRST CPOPJ2		;NO, ALL DONE
	SETZM MTADAT(BB)	;INITIALIZE DATA WORD
	MOVSI A,MTARDB		;GET READ BACKWARDS FLAG
	ANDCAM A,FLAGWD(BB)	;AND CLEAR IT
	MOVE A,DEVNUM(BB)	;GET DEVICE DESIGNATOR
	TLO A,(1B3)		;SUPRESS READING DIRECTORY
	MOUNT
	  JRST UOPNF		;MOUNT FAILED GO TRAP OR BOMB
	JRST CPOPJ2		;GIVE DOUBLE SKIP RETURN FOR NON-DISK DEVICES

UOPEN6:	MOVS A,DEVNAM(BB)	;GET DEVICE NAME
	CAIE A,'TTY'		;TTY?
	JRST UOPEN7		;NO
	MOVEI A,PROJFN		;YES, USE PRIMARY
	JRST UOPEN8		;GO STORE JFN

UOPEN7:	PUSHJ P,SETJBK		;SET UP JBLOCK
	SETZM JBLOCK		;  FOR GTJFN
	MOVEI A,JBLOCK
	HRROI B,STRNG1		;GET POINTER TO MAIN STRING
	GTJFN
	  JRST MRETN		;GIVE ERROR TO USER
UOPEN8:	MOVEM A,JFNTAB(BB)
	DVCHR			;GET CHARACTERISTICS
	TXNN B,DV%AV		;AVAILABLE TO THIS JOB?
	JRST UOPEN9		;NO, GIVE FAILURE RETURN
	CAIE AA,PTY		;IS THIS A PTY
	  JRST MRETN2		;NO, THEN DONE
	PUSHJ P,PTYSTF		;YES, GO START UP THE FORKS
	SKIPA
	JRST	 MRETN2
UOPEN9:	PUSHJ P,URELJ		;GO RELEASE JFN AND CLEAR INIT BLOCK
	JRST MRETN		;GIVE ERROR RETURN

UOPNF:	PUSHJ P,MNTFAI		;SEE IF TRAP WAS SET UP
	JFCL
	PUSHJ P,ERROR		;NO, TYPE OUT ERROR (NO RETURN)

PDVNUM:	POINT 6,DEVNUM(BB),17		;NUMERIC DEVICE TYPE FROM DESIGNATOR
UINBUF:	TLOA C,-1
UOUTBF:	TLZ C,-1
	PUSHJ P,SETUP
	MOVE D,FLAGWD(BB)
	TLNN D,INITF		;CHANNEL INIT'ED?
	PUSHJ P,ERRCHN		;NO-YOU LOSE
	MOVE CC,BUFHTB(BB)
	TLNN C,-1		;HEADER POINTER ALREADY IN RIGHT HALF?
	HLRZ CC,CC		;OBUF,IBUF_0,OBUF
	MOVSI B,INBUFF
	TLNN C,-1
	MOVSI B,OUTBFF
	HRRZ C,FORTY		;NUMBER OF BUFFERS IN RING
	CAIN C,0		;DID USRE SPECIFY ZERO BUFFERS?
	MOVEI C,2		;YES, GIVE HIM TWO
	PUSHJ P,IOBUF
	JRST MRETN

IOBUF:	IORM B,FLAGWD(BB)
	PUSH P,C		;SAVE NUMBER OF BUFFERS WANTED
	MOVE B,DEVTB2(AA)	;GET DEFAULT BUFFER SIZE
	CAIE AA,LPT		;LINE PRINTER?
	CAIN AA,CDR		;OR CDR?
	JRST IOBUF1		;YES, WATCH OUT FOR SPOOLED DEVICES
	CAIE AA,MTA		;MAGTAPE?
	JRST IOBUF2		;NO
	PUSHJ P,GETMBS		;GET THE MAGTAPE BUFFER SIZE
	 MOVE B,DEVTB2(AA)	;FAILED, USE THE STANDARD
	MOVE B,A		;GET SIZE IN B
	JRST IOBUF2

IOBUF1:	HRRZ A,JFNTAB(BB)	;GET THE CHARACTERISTICS
	DVCHR			;TO SEE IF IT IS SPOOLED
	TLNE B,(1B3)		;ASSIGNABLE BIT = 0 MEANS SPOOLED
IOBUF3:	SKIPA B,DEVTB2(AA)	;PHYSICAL DEVICE, USE STD BUFFER SIZE
	MOVEI B,200		;SPOOLED DEVICE, USE 200
IOBUF2:	POP P,C			;GET BACK COUNT OF BUFFERS WANTED
	UMOVE D,.JBFF		;WHERE TO START RING
	MOVEI E,(D)		;SPARE COPY OF START
	MOVEI G,3(B)		;TOTAL LENGTH OF EACH BUFFER
	IMULI G,(C)		;TIMES NUMBER OF BUFFERS
	ADDI G,(D)		;PLUS BEGINNING ADDRESS
	CAILE G,PATLOC		;MUST BE BELOW COMPATIBILITY CODE
	PUSHJ P,ERRARG
	CAML G,JBREL		;IS THERE ENOUGH CORE NOW?
	PUSHJ P,XPAND		;NO, GET SOME MORE
	CAIGE D,20		;.JBFF POINT INTO ACS?
	  PUSHJ P,ITRAP		;YES, ADDRESS CHECK
	MOVSI F,400000		;RING USE BIT
	HRRI F,1(D)		;POINTER TO SECOND WORD OF FIRST BUFFER
	UMOVEM F,(CC)		;GOES IN FIRST WORD OF HEADER

	MOVSI F,1(B)		;SIZE+1 IN LH OF SECOND WORD  OF EACH BUFFER

UIOBFL:	HRRI F,1(D)		;POINTER TO SELF IN RIGHT HALF
	ADDI F,3(B)		;PLUS LENGTH OF A COMPLETE BUFFER
	CAIN C,1		;EXCEPT THE LAST BUFFER
	HRRI F,1(E)		;WHICH POINTS BACK TO THE FIRST

	UMOVEM F,1(D)		;SET  RING PTR TO XWD SIZE+1,NXTBUF+1

	ADDI D,3(B)		;POINT BEYOND THIS BUFFER
	SOJG C,UIOBFL		;BACK IF MORE BUFFERS TO SET UP
	XCTUU <HRRM D,.JBFF>	;SET .JBFF BEYOND BUFFERS
	POPJ P,
ULOOKP:	PUSHJ P,SETUP
	MOVE D,FLAGWD(BB)
	TLNN D,INITF
	PUSHJ P,ERRCHN
	PUSHJ P,DIRCHK		;SKIP IF HAS DIRECTORY
	  JRST MRETN2		;NO, NOP.
IFN FTFILSER,<
	HLRZ A,DEVNAM(BB)	;GET GENERIC NAME
	CAIN A,'DPA'		;THIS A TOPS-10 DPA?
	  JRST TLKUP		;YES, DO ITS OWN LOOKUP
>
	SETZM IOCNT		;CLOSE THIS CHANNEL
	PUSHJ P,UCL1R		;CLOSE IT AND RELEASE JFN
	MOVE B,DEVTBL(AA)
	TLNN B,DTADEV		;DECTAPE
	TLNE B,DSKDEV		;OR DSK?
	JRST ULK6		;YES- DO GTJFN NOW
	SKIPN A,JFNTAB(BB)	;NO- MUST HAVE JFN ALREADY
	PUSHJ P,ERRCHN
	JRST ULK7

ULK6:	CAIE AA,DTA		;IS THIS A DTA?
	  JRST ULK6B		;NO
	MOVE A,FLAGWD(BB)	;GET OPEN BITS
	TRNE A,100		;OPENED IN NON-STANDARD MODE?
	JRST MRETN2		;YES, LOOKUP IS A NOP THAT SKIPS
	PUSHJ P,DTAINI		;CLOSE ALL OTHER OPEN JFNS FOR THIS DTA
	PUSHJ P,DTAMNT		;YES, GO MOUNT IT
	  JRST DTMNTF		;MOUNT FAILED, GO MENTION THIS FACT
ULK6B:	PUSHJ P,LUKPAR
	  JRST ER1		;BAD UFD SPECIFICATION
	MOVE B,DEVTBL(AA)	;GET TYPE OF DEVICE
	HLRZ A,EXT(BB)		;GET EXTENSION NAME
	TLNE B,DSKDEV		;IS THIS A DISK?
	CAIE A,(SIXBIT/UFD/)	;AND ARE WE LOOKING UP A UFD?
	  SKIPA			;NO TO ONE OF THE ABOVE QUESTIONS
	PUSHJ P, ULKUFD		;YES, GO SIMULATE UFD READING
	  MOVSI A,100100	;THIS GETS SKIPPED ON A SUCCESFUL ULKUFD RETURN
	HRROI B,STRNG1		;SET UP STRING POINTER
	MOVEM A,JBLOCK		;SAVE FLAGS
	MOVEI A,JBLOCK		;SET UP FOR LONG FORM GTJFN
	GTJFN
	  JRST LOOKER
	MOVEM A,JFNTAB(BB)	;ASSIGNED JFN
	PUSHJ P,FILDIR		;UPDATE DIRNUM(BB)
ULK7:	PUSHJ P,ULKOPN		;GO OPEN THE JFN
	  JRST LOOKER		;OPENF FAILED
	JRST MRETN2		;LOOKUP IS FINISHED

ULKOPN:	MOVEI B,1B19		;OPEN FOR INPUT
ULKOP0:	PUSHJ P,OPENX
	 JRST [	CAIE A,OPNX8	;NOT MOUNTED?
		 POPJ P,
		JRST INMNTF]	;YES, GO COMPLAIN
ULKOP1:	MOVSI B,IOPENF!LOOKPF
	IORM B,FLAGWD(BB)	;DENOTE FILE OPEN SO CLOSE WILL REALLY CLOSE
	SKIPN AA		;IS THIS THE DISK?
	  PUSHJ P,OPNDSK	;YES, GO SET UP EOF POINTER
	MOVSI D,200000		;MULTIPLE DIRECTORY DEVICE BIT
	TDNN D,DEVTBL(AA)	;IS IT ONE OF THOSE?
	JRST CPOPJ1		;NO, ALL DONE FOR NOW
	MOVSI D,RDUFDF		;READING THE UFD?
	TDNE D,FLAGWD(BB)
	JRST [	MOVSI F,(777B8)	;SET UFD PROTECTION TO LOWEST
		JRST ULK2A]	;TEMPORARY ****

	HRRZ A,JFNTAB(BB)	;SET UP JFN
	MOVSI B,22		;XWD 22,0 I.E. WHOLE FDB
	MOVEI C,FDBB		;PSB BUFFER FOR FILE DESCRIPTOR BLOCK
	GTFDB
	 ERJMP CPOPJ1
	MOVE B,FDBB+FDBREF	;LAST REF DATE AND TIME
	PUSHJ P,NODATE
	ANDI D,7777		;12 BITS ONLY
	TRNE PF,R.UEXT		;EXTENDED LOOKUP?
	JRST ULK8
	XCTUU <HRRM D,1(G)>	;2 FOR MDD
	XCTLB <DPB C,[POINT 3,1(G),23]> ;STORE 3 HIGH ORDER DATE BITS
	JRST ULK2
ULK8:	XCTUU <HRRM D,3(G)>
	XCTLB <DPB C,[POINT 3,3(G),23]> ;STORE 3 HIGH ORDER DATE BITS
ULK2:	SETZ F,			;INIT PROTECTION WORD
	MOVE A,[POINT 6,FDBB+FDBPRT,17]
	MOVE B,[POINT 3,F]
	MOVEI E,3		;SET UP FOR THREE PROTECTION FIELDS
ULK2L:	ILDB D,A		;GET THE FIRST PROTECTION CLASS
	MOVEI C,7		;ASSUME HIGHEST PROTECTION
	TRNE D,10		;EXECUTE?
	MOVEI C,6		;YES, REDUCE PROTECTION
	TRNE D,40		;READ?
	MOVEI C,5		;YES, REDUCE PROTECTION
	TRNE D,4		;APPEND?
	MOVEI C,3		;YES, REDUCE PROTECTION
	TRNE D,20		;WRITE?
	MOVEI C,0		;YES, NO PROTECTION (0)
	IDPB C,B		;STORE THIS FIELD IN F
	SOJG E,ULK2L		;LOOP BACK FOR THREE TIMES

	MOVE B,FDBB+FDBWRT	;CREATION DATE OF THIS VERSION
	PUSHJ P,NODATE
	IOR F,D			;ADD DATE,TIME TO PROT ALREADY IN F0-8
	LDB B,[POINT 4,FDBB+FDBBYV,17] ;NOW GET MODE
	DPB B,[POINT 4,F,12]	;RETURN MODE OF LAST OPEN TO USER
ULK2A:	TRNE PF,R.UEXT		;EXTENDED LOOKUP
	JRST ULK9
	UMOVEM F,2(G)		;PROTECTION,0 MODE,TIME AND DATE
	XCTLB <DPB C,[POINT 3,1(G),20]>	;STORE HIGH ORDER 3 DATE BITS
	JRST ULK3
ULK9:	UMOVE E,0(G)		;GET # OF ELEMENTS IN EXTENDED LIST
	CAIGE E,4		;SHOULD WE RETURN PROTECTION
	  JRST ULK3		;NO
	UMOVEM F,4(G)
	XCTLB <DPB C,[POINT 3,3(G),20]>	;STORE HIGH ORDER 3 DATE BITS
ULK3:	LDB B,[POINT 6,FDBB+FDBBYV,11]	;BYTE SIZE
	SKIPN B			;IS B 0?
	  MOVEI B,^D36		;YES, AVOID THE DIVIDE BY 0 AND USE 36
	MOVEI A,^D36
	IDIVI A,(B)		;NO OF BYTES IN A WORD
	MOVE B,FDBB+FDBSIZ	;NO OF BYTES IN FILE
	IDIVI B,(A)		;NO OF WORDS IN FILE
	SKIPE C			;INTEGER WORDS
	ADDI B,1		;ROUND UP
	TRNE PF,R.UEXT		;EXTENDED LOOKUP?
	JRST ULK10
	CAILE B,377777		;<128K WORDS?
	JRST ULK4		;NOPE
	MOVNI B,(B)		;YES, -NO OF WORDS
	JRST ULK5
ULK4:	TRNE B,177		;EVEN NO OF BLOCKS?
	ADDI B,200		;NO, ROUND UP 1 BLOCK
	ASH B,-7		;CONVERT WORDS TO 128 WORD BLOCKS
ULK5:	XCTUU <HRLZM B,3(G)>
	JRST ULK11
ULK10:	MOVE A,DIRNUM(BB)	;GET DIRECTORY NUMBER
	PUSHJ P,PPNUNM		;CONVERT TO PPN
	UMOVEM A,1(G)		;RETURN TO USER
	CAIGE E,5		;ENOUGH ROOM FOR WORD COUNT
	  JRST ULK11		;NO
	UMOVEM B,5(G)		;STORE WORD COUNT
	MOVEI C,6(G)		;ZERO THE EXTENDED LOOKUP AREA
	MOVEI B,6		;STARTING AT ITEM 7
ULK10A:	CAMLE B,E		;DONE?
	  JRST ULK10B		;YES
	XCTUU <SETZM (C)>	;ZERO ELEMENT
	AOS C
	AOJA B,ULK10A		;LOOP BACK
ULK10B:	CAIGE E,11		;WANT SIZE IN BLOCKS?
	  JRST ULK11		;NO
	HRRZ A,FDBBYV+FDBB	;YES, GET SIZE IN PAGES
	ASH A,2			;MULTIPLY BY 4 TO GET BLOCKS
	UMOVEM A,10(G)		;RETURN ALLOCATED BLOCKS
	UMOVEM A,11(G)		;AND ACTUAL BLOCKS
	CAIGE E,16		;WANT .RBDEV?
	  JRST ULK11		;NO
	MOVE B,DEVNAM(BB)	;GIVE USER THE DEVICE NAME
	UMOVEM B,16(G)
	CAIGE E,25		;WANT QUOTA'S
	  JRST ULK11		;NO
	MOVSI A,RDUFDF		;ARE WE READING A UFD
	TDNN A,FLAGWD(BB)
	  JRST ULK10C		;NO, DONT GIVE THIS INFO
	GJINF			;SEE IF THIS IS FOR CONNECTED DIR
	CAME B,DIRNUM(BB)	;...
	  JRST ULK10C		;NO, CANNOT GET THIS INFO
	SETO A,			;THE CONNECTED DIR
	GTDAL			;GET DIR ALLOCAATION
	LSH A,2			;TURN PAGES INTO BLOCKS
	UMOVEM A,22(G)		;STORE AS FCFS QUOTA LEFT
	UMOVEM A,23(G)		;STORE LOGGED OUT QUOTA
	HRROI A,[ASCIZ/DSK/]	;USE CURRENT CONNECTED STR
	PUSHJ P,PAGUSE		;GET NUMBER OF PAGES IN USE
	ASH A,2			;TURN PAGES INTO BLOCKS
	UMOVEM A,25(G)		;STORE BLOCKS
ULK10C:	CAIGE E,26		;WANT .RBAUT?
	  JRST ULK11		;NO
	HRROI B,STRNG1		;NOW GET THE AUTHOR NAME
	HRROI A,[ASCIZ/PS:</]	;BUILD THE STR/DIR NAME STRING
	SETZ C,
	SIN
	MOVSI A,.GFAUT		;NOW ADD THE AUTHOR'S NAME
	HRR A,JFNTAB(BB)	;FROM THE JFN
	GFUST			;GET FILE USER NAME STRING
	 ERJMP ULK10D		;IF NONE, SKIP IT
	MOVEI A,">"		;CLOSE THE STRING
	IDPB A,B		;NOW HAVE "PS:<DIR>"
	MOVEI A,0		;FOLLOW IT WITH A NULL
	IDPB A,B
	HRROI A,STRNG1		;NOW GET THE PPN
	STPPN
	 ERJMP ULK10D
	UMOVEM B,26(G)		;STORE IN ARRAY
ULK10D:	CAIGE E,35		;WANT .RBTIM?
	  JRST ULK11		;NO
	MOVE B,FDBB+FDBWRT	;GET DATE OF THIS VERSION
	UMOVEM B,35(G)		;STORE
ULK11:	JRST CPOPJ1

;THIS ROUTINE CALCULATES THE NUMBER OF PAGES CURRENTLY ALLOCATED
;IN THE CONNECTED DIRECTORY. IT IS CALLED BY:
;		MOVE A,[POINT 7,[ASCIZ/STR/]]
;		PUSHJ P,PAGUSE
;
; RETURNS +1 ALWAYS WITH A=NO OF PAGES

PAGUSE:
	SETO A,
	GTDAL			;GET QUOTA AND USED PAGES
	MOVE A,B		;RETURN USED PAGES
	POPJ P,

REPEAT 0,<
;OLD METHOD OF SCANNING THE DIRECTORY AND COUNTING
	PUSH P,A		;SAVE STRING POINTER
	PUSHJ P,JBKSET		;INITIALIZE THE GTJFN BLOCK
	POP P,JBLOCK+2		;PUT STRING POINTER TO DEVICE NAME IN
	MOVSI A,100100		;SET UP FLAGS
	MOVEM A,JBLOCK
	MOVEI A,JBLOCK		;SET UP FOR GTJFN
	HRROI B,[ASCIZ/*.*.*/]
	GTJFN				;GET A HANDLE
	JRST	[SETZ A,		;EMPTY DIR
		 POPJ P,]		;GO BACK
	SETZ	D,			;ACCUMULAOTR
	PUSH	P,A			;SAVE THE JFN
PAGU1:	HRRZ	A,0(P)			;THE JFN FOR GTFDB
	MOVE	B,[1,,11]		;ONE WORD .THE PAGE COUNT
	MOVEI	C,C			;RETURN IT IN C
	GTFDB				;GET PAGE COUTN
	 ERJMP PAGU2
	ADDI	D,(C)			;ACCUMULATE IT
PAGU2:	MOVE	A,0(P)			;THE FULL JFN AGAIN
	GNJFN				;NEXT!
	SKIPA	A,D			;ALL THROUGH
	JRST	PAGU1			;GOT ANOTHER ONE
	POP	P,(P)			;CLEAR OUT STACK
	POPJ	P,			;RETURN
>
DATE:	SETO B,			;TO REQUEST CURRENT TAD
	PUSHJ P,NODATE
	ANDI D,7777		;12 BITS WORTH ONLY
	LSH C,^D12		;GET HIGH ORDER DATE BITS
	IOR D,C			;PUT IN HIGH ORDER 3 BITS FOR DATE 75
	MOVE A,D		;DATE TO A FOR RETURN TO USER
	JRST STOTAC		; ..

;GET 12 BIT DATE INTO AC D AND HIGH ORDER THREE BITS INTO AC C

NODATE:	SETZ D,			;NORMAL FLAGS
	ODCNV			;GET YEAR, MONTH, DAY, ETC.
	ERJMP [	SETO B,		;ERROR, GET TODAY'S DATE
		JRST NODATE]
	HRRZ A,D		;SAVE SECONDS SINCE MIDNIGHT
	HLRZ D,B		;YEAR
	SUBI D,^D1964		;CONVERT TO 10/50 FORMAT, I.E. ...
	IMULI D,^D12		;(YEAR-1964)*12 
	ADDI D,0(B)
	IMULI D,^D31		;((YEAR-1964)*12+(MONTH-1))*31
	HLRZ C,C
	ADDI D,0(C)		; ... +DAY-1
	LDB C,[POINT 3,D,23]	;GET HIGH ORDER THREE BITS FOR DATE-75
	ANDI D,7777		;12 BITS ONLY
	IDIVI 	A,^D60		;MINUTES
	ANDI A,3777		;ONLY 11 BITS WORTH
	LSH A,^D12
	IOR D,A
	POPJ P,
OPENX:
IFN FTFILSER,<
	HLRZ D,DEVNAM(BB)	;GET GENERIC NAME
	CAIN D,'DPA'		;TOPS-10 PACK?
	  JRST CPOPJ1		;YES, DO NOTHING
>
	SETZM IOBYTP(BB)	;INITIALIZE POINTER TO START OF FILE
	SETZM IOEOFP(BB)	;AND POINTER TO END OF FILE
	MOVE D,FLAGWD(BB)
	TLNE D,RDUFDF		;ARE WE READING A UFD?
	  JRST CPOPJ1		;YES, SO DONT OPEN THE JFN
	TLNE D,INITF		;IS IT INIT'ED?
	SKIPN A,JFNTAB(BB)	;AND HAS IT A JFN?
	PUSHJ P,ERRCHN		;NO
	HRRZS A			;GET RH ONLY OF JFN
	CAIE A,PRIJFN		;PRIMARY INPUT JFN?
	CAIN A,PROJFN		;OR PRIMARY OUTPUT JFN?
	  JRST CPOPJ1		;YES, DONT RE-OPEN IT
	MOVE C,B		;SAVE MODE FOR OPENING
	GTSTS
	JUMPGE B,OPENX3		;IS FILE ALREADY OPEN?
	SKIPE MAPTAB(BB)	;ARE THERE PAGES MAPPED?
	  PUSHJ P,UNMAPP	;YES, GO UNMAP IT SO CLOSF WORKS
	TLNE B,(1B1)		;YES.- OPEN FOR INPUT?
	TRO C,1B19		;YES- SAVE THAT INFO
	TLNE B,(1B2)		;OPEN FOR OUTPUT?
	TRO C,1B20		;YES- SAVE THAT INFO
	TXO A,CO%NRJ+CZ%NUD	;PRESERVE THE JFN
	CLOSF			;AND CLOSE FILE
	PUSHJ P,ERROR
	PUSH P,C		;SAVE OPEN BITS
	JUMPN AA,OPENX5		;IF NOT A DSK, SKIPE THIS CHECK
	MOVE B,[XWD 1,1]	;GET WORD INDICATION DELETION
	MOVEI C,FDBTMP
	HRRZ A,A
	GTFDB
	 ERJMP OPENX5
	MOVSI C,(1B3)
	TDNN C,FDBTMP		;IS FILE DELETED?
	JRST OPENX5		;NO
	HRLI A,FDBCTL+CF%NUD_-^D18	;YES, UNDELETE IT
	MOVSI B,(FDBDEL)
	SETZ C,
	CHFDB

OPENX5:	POP P,C
	HRRZ A,A
OPENX3:	MOVE B,C		;NOW IT CAN BE OPENED
	MOVEI C,17
	ANDI C,(D)		;MODE
	LDB AA,PDVNUM		;GET DEVICE TYPE NUMBER
	MOVE D,DEVTBL(AA)
	TLNE D,DTADEV		;IS THIS DUMP MODE TO DECTAPE?
	CAIG C,14
	SKIPA
	JRST OPENX1		;YES- OPEN IN DUMP MODE
	TLNE D,MTADEV		;IS THIS A MAGTAPE?
	JRST [	MOVSI D,MTABFS	;MARK THAT BUFFERS ARE NOT SET UP
		ANDCAM D,FLAGWD(BB)
		HRLI B,440000	;YES, GET THE BYTE SIZE TO BE USED
		CAIL C,15	;IS THIS A DUMP MODE?
		JRST OPENX1	;YES, GO SET UP FOR DUMP MODE
		JRST OPENX2]	;NO, OPEN IT FOR SIN/SOUT MODE
	HRLI B,070000		;NO- OPEN IN ASCII MODE
	CAIN AA,CDR		;CARD READER?
	JRST [	CAIN C,10	;IMAGE MODE?
		HRLI B,204000	;YES, SET UP SPECIAL MODE
		HRRZ A,JFNTAB(BB) ;GET THE DEVICE CHARACTERISTICS
		PUSH P,B	;SAVE THE BYTE POINTER
		DVCHR
		MOVE A,B
		POP P,B
		TLNN A,(1B3)	;IS THIS THE SPOOLED CDR?
		HRLI B,440000	;YES, OPEN IN 36 BIT MODE
		JRST OPENX2]	;GO DO OPENF
	CAIN AA,PLT		;IS THIS A PLOTTER?
	  JRST [HRLI B,060000	;YES, ASSUME 6-BIT BYTES
		CAIL C,10	;BINARY MODE?
		  HRLI B,440000	;YES, USE 36-BIT WORDS
		JRST OPENX2]	;GO OPEN PLOTTER
	TLNE D,PTRDEV+PTPDEV	;IS PAPER TAPE?
	JRST [	CAIGE C,10	;YES, ASCII MODE?
		JRST OPENX2	;YES
		HRLI B,100000	;BYTE SIZE IS 8 IF IMAGE MODE
		CAIL C,13
		HRLI B,440000	;36 IF BINARY MODE
		DPB C,[POINT 4,B,9] ;PASS ALONG MODE
		JRST OPENX2]
	TLNN D,HASDIR		;UNLESS THIS IS A DIRECTORY DEVICE
	CAIL C,10		;OR BINARY MODE SPECIFIED
	HRLI B,440000		;IN WHICH CASE USE BINARY MODE
	JRST OPENX2

OPENX1:	HRLI B,447400	;DUMP MODE

OPENX2:	CAIN AA,PTY		;IS THIS A PTY?
	  HRRI B,1B19!1B20	;YES, ALWAYS OPEN IT IN READ AND WRITE
	HRRZ A,JFNTAB(BB)
	TRO B,1B28		;NEVER WAIT FOR DEVICES
	OPENF
	JRST OPENX4
	JUMPE AA,CPOPJ1		;IF THIS IS A DISK, GO SET UP POINTERS
	CAIN AA,PTY		;IS THIS A PTY?
	  JRST OPNPTY		;YES, GO MARK THAT IT WAS OPENED
	MOVE B,DEVTBL(AA)
	TLNE B,MTADEV		;MAGTAPE?
	PUSHJ P,MTASTS		;YES, SET MTA STATUS
	MOVE B,DEVTBL(AA)
	TLNE B,TTYDEV		;TTY?
	PUSHJ P,TTYSET		;YES, SETUP MODES
	JRST CPOPJ1
OPENX4:	CAIE A,OPNX8		;UNMOUNTED DEVICE?
	  POPJ P,		;NO, GIVE ERROR RETURN
	MOVE B,DEVTBL(AA)
	TLNN B,PTRDEV		;PAPERTAPE READER?
	  POPJ P,
	MOVEI A,^D5000
	DISMS			;GIVE THE OPERATOR ANOTHER 2 SEC.
	HRRZ A,JFNTAB(BB)
	JRST OPENX2		;AND TRY AGAIN

OPNDSK:	MOVE A,FLAGWD(BB)	;SEE IF A UFD OR MFD
	TLNE A,RDUFDF!RDMFDF	;...
	  POPJ P,		;YES, DONT SET IOEOFP
	PUSHJ P,GETEOF		;GET THE EOF FOR THIS FILE
	MOVEM A,IOEOFP(BB)	;SAVE IT AWAY
	POPJ P,			;AND RETURN


;ROUTINE TO GET THE EOF OF A FILE IN A

GETEOF:	HRRZ A,JFNTAB(BB)	;GET JFN
	MOVE B,[XWD 2,11]	;GET BYTE SIZE AND BYTE COUNT FROM FDB
	MOVEI C,D		;INTO ACS B AND C
	SETZB D,E		;INITIALIZE SIZE AND COUNT TO ZERO
	GTFDB
	 ERJMP .+1		;IGNORE ERROR
	LDB D,[POINT 6,D,11]	;GET BYTE SIZE
	SKIPG D			;DONT ALLOW 0
	  MOVEI D,^D36		;IF FILE DOES NOT EXIST ASSUME 36 BIT BYTES
	MOVEI B,^D36		;CALCULATE THE # OF BYTES PER WORD
	IDIVI B,(D)
	IDIVI E,(B)		;NOW GET # OF WORDS IN THE FILE
	SKIPE F			;ANY ROUND OFF
	  AOS E			;YES, COUNT PARTIAL WORD
	MOVE A,E		;RETURN ANSWER IN A
	POPJ P,
;0 - FILE NOT FOUND
;1 - DIRECTORY NOT FOUND
;2 - READ PROTECTED


LOKERP:	SUB P,[3,,3]		;REMOVE NAME, EXT AND PPN FROM STACK

LOOKER:	MOVE B,FLAGWD(BB)	;GET FLAGS
	TLNE B,RDUFDF		;WAS THIS A FAILURE ON A UFD
	JRST UFDEMT		;YES, IT MUST HAVE BEEN EMPTY
	MOVSI C,-LKERLN		;SET UP TO SCAN TABLE OF ERROR CODES
	TRNN PF,R.ENT		;IS THIS A LOOKUP UUO?
	CAIE A,GJFX24		;YES, IS THIS THE NO NEW FILES ERROR?
	  JRST LOOKLP		;NO, SCAN FOR ERROR CODE
	JRST ER0		;YES, RETURN ERROR CODE 0 (FILE NOT FOUND)
LOOKLP:	HRRZ B,LKERTB(C)	;GET NEXT ERROR CODE FROM TABLE
	CAME A,B		;IS THIS A MATCH?
	AOBJN C,LOOKLP		;NO, TRY OTHER ERROR CODES
	JUMPGE C,ER0		;UNKNOWN CODE, RETURN 0
	HLRZ B,LKERTB(C)	;GET TOPS-10 ERROR CODE TO BE RETURNED
LOOKR2:	SKIPE A,NEWJFN		;IS THERE A JFN TO BE RELEASED
	RLJFN			;YES, RELEASE IT
	JFCL
	SETZM NEWJFN		;CLEAR THIS LOCATION
	HRRZ G,FORTY		;GET USER ARG LIST POINTER
	TRNE PF,R.UEXT		;EXTENDED LOOKUP
	JRST LOOKR3		;YES, STORE FLAGS PROPERLY
	XCTUU <HRRM B,1(G)>	;PUT ERROR NUMBER IN RH E+1
	JRST MRETN

LOOKR3:	XCTUU <HRRM B,3(G)>	;STORE FLAGS IN RH OF EXT WORD
	JRST MRETN		;AND RETURN

ER0:	TRZA B,-1
ER5:	MOVEI B,5
	JRST LOOKR2
ER1:	MOVEI B,1
	JRST LOOKR2

UFDEMT:	MOVSI B,UFDEOF		;MARK THAT THE UFD WAS EMPTY
	IORM B,FLAGWD(BB)
	JRST ULK7		;GO FINISH THE LOOKUP

LKERTB:	XWD 1,GJFX17		;NO SUCH DIR
	XWD 2,GJFX24		;NO NEW FILES
	XWD 2,GJFX29		;DEV NOT AVAILABLE
	XWD 2,OPNX3		;READ ACCESS NOT ALLOWED
	XWD 2,OPNX4		;WRITE ACCESS NOT ALLOWED
	XWD 2,OPNX5		;EXECUTE ACCESS NOT ALLOWED
	XWD 2,OPNX6		;APPEND ACCESS NOT ALLOWED
	XWD 2,OPNX12		;LIST ACCESS NOT ALLOWED
	XWD 2,OPNX13		;ILLEGAL ACCESS
	XWD 2,OPNX15		;NON-READ/WRITE ACCESS NOT ALLOWED
	XWD 2,DELFX1		;CANNOT DELETE BECAUSE OF LACK OF PRIVELEGES
	XWD 2,CFDBX2		;ILLEGAL TO CHANGE THESE FDB BITS
	XWD 2,RNAMX3		;ACCESS TO DESTINATION NOT ALLOWED
	XWD 2,RNAMX8		;ACCESS TO SOURCE NOT ALLOWED
	XWD 3,OPNX1		;ALREADY OPEN
	XWD 3,OPNX9		;FILE BUSY
	XWD 4,GJFX27		;OLD FILE NOT ALLOWED
	XWD 6,OPNX16		;FILE HAS BAD INDEX BLOCK
	XWD 14,GJFX23		;NO ROOM IN DIR
	XWD 14,OPNX10		;NO ROOM
	XWD 14,OPNX23		;QUOTA EXCEEDED
	XWD 16,GJFX22		;NO ROOM IN JSB

LKERLN==.-LKERTB
;TRANSLATE LOOKUP AND ENTER PARAMETERS TO STRINGS

LUKPAR:	MOVSI G,RDUFDF!UFDEOF!DTADMP	;CLEAR BITS
	ANDCAM G,FLAGWD(BB)	;...
	SETZM EXT(BB)		;INITIALIZE A FEW FIELDS
	SETZM PROT(BB)
	SETZM DIRNUM(BB)
	HRRZ G,FORTY		;POINTER TO PARAMETER BLOCK
	UMOVE F,(G)		;NAME IN SIXBIT
	TRZ PF,R.UEXT		;INITIALIZE EXTENDED LOOKUP FLAG
	TLNN F,-1		;IS LEFT HALF ZERO?
	CAIGE F,3		;AND RIGHT HALF >= 3?
	  JRST LUKPR1		;NOT EXTENDED LOOKUP FORMAT
	TRO PF,R.UEXT		;YES - INDICATE EXTENDED ENTER BLOCK
	UMOVE D,2(G)		;GET FILE NAME
	MOVEM D,FILNAM(BB)
	JUMPE D,LUKPR2		;IF NULL FILE NAME, DONT BELIEVE REST OF ARGS
	UMOVE D,3(G)		;GET EXT
	HLLZM D,EXT(BB)
	UMOVE D,1(G)		;GET PPN
	MOVE A,DEVNAM(BB)	;GET SIXBIT DEVICE NAME
	PUSHJ P,GETDIR		;TRANSLATE IT TO DIRECTORY NUMBER
	  POPJ P,		;NO SUCH TRANSLATION
	MOVEM D,DIRNUM(BB)
	XCTLB <LDB D,[POINT 9,4(G),8]>	;GET PROTECTION VALUE
	CAIGE F,4		;WAS THIS SPECIFIED
	  MOVEI D,0		;NO, USE STANDARD
	PUSHJ P,GTPROT		;TRANSLATE TO VIROS STYLE PROTECTION
	MOVEM D,PROT(BB)
	JRST LUKPR2		;GO SET UP JBLOCK

LUKPR1:	MOVEM F,FILNAM(BB)	;NOT EXTENDED TYPE LOOKUP BLOCK
	JUMPE F,LUKPR2		;IF NO NAME, IGNORE OTHER ARGUMENTS
	UMOVE D,1(G)		;GET EXT
	HLLZM D,EXT(BB)
	XCTUU <MOVE D,3(G)>	;GET PPN
	MOVE A,DEVNAM(BB)	;GET SIXBIT DEVICE NAME FOR GETDIR
	PUSHJ P,GETDIR		;GET DIRECTORY NUMBER
	  POPJ P,		;NO MAPPING
	MOVEM D,DIRNUM(BB)	;STORE DIR NUM
	XCTLB <LDB D,[POINT 9,2(G),8]>
	PUSHJ P,GTPROT		;GET VIROS STYLE PROTECTION
	MOVEM D,PROT(BB)
LUKPR2:	AOS (P)			;INSURE A SKIP RETURN
SETJBK:	PUSHJ P,JBKSET		;GO INITIALIZE JBLOCK
	MOVE E,[POINT 7,STRNG1]
	SKIPE D,DEVNAM(BB)	;ANY DEVICE NAME
	  PUSHJ P,JDEV		;YES, GO ADD THIS TO STRING
	SKIPE B,DIRNUM(BB)	;ANY SPECIFIED DIRECTORY?
	 JRST [	HRROI A,STRNG1	;YES, PUT STR:<DIR> IN MAIN STRING
		DIRST
		 JRST .+1
		MOVE E,A	;USE THIS NEW STRING POINTER
		JRST .+1]
	SKIPN D,FILNAM(BB)	;GET FILE NAME
	  JRST SETJB1		;NONE, JUST EXIT
	PUSHJ P,SIX27V		;ADD THIS TO STRING
	MOVEI C,"."		;AND A "."
	IDPB C,E		;OVERWRITE 0 AT END
	MOVE D,EXT(BB)		;NOW ADD EXTENSION
	PUSHJ P,SIX27V
	MOVEI C,";"		;END WITH A ";"
	IDPB C,E
SETJB1:	MOVEI D,0
	IDPB D,E		;END STRING WITH 0
	POPJ P,			;RETURN

JBKSET:	MOVE A,[XWD 377777,377777]	;NO FILES
	MOVEM A,JBLOCK+1
	SETZM JBLOCK+2		;SYSTEM DEFAULTS ON EVERYTHING
	MOVE A,[XWD JBLOCK+2,JBLOCK+3]
	BLT A,JBLOCK+10
	POPJ P,
;ROUTINE TO GET A DIR NUMBER FROM A PPN
;ACCEPTS IN A/	SIXBIT DEVICE NAME
;	    D/	PPN
;USES DEVNAM, DIRNAM, AND STRNG1 AS SCRATCH STRINGS
;RETURNS +1:	NO TRANSLATION
;	 +2:	DIRECTORY NUMBER IN D AND POINTER TO STRING
;			CONTAINING DIR NAME IN AC A

GETDIR:	SKIPG D			;NEGATIVE OR 0 PPN?
	  TDZA D,D		;YES, LEAVE AS 0
	TLNE D,-1		;PATH POINTER?
	  JRST GETDR0		;NO
	UMOVE D,2(D)		;YES, GET PATH PPN
GETDR0:	JUMPE D,CPOPJ1		;IF NONE SPECIFIED JUST RETURN
	PUSH P,D		;SAVE THE PPN
	MOVE D,A		;GET DEV NAME TRANSLATED INTO ASCII
	HRROI E,DEVNM7		;INTO DEVNM7
	PUSHJ P,SIXTO7
	POP P,D			;GET BACK PPN
	PUSHJ P,PPNMAP		;SEE IF IT IS SPECIAL
	 SKIPA			;IT ISNT
	JRST GETDR4		;YES, STRING POINTER IS IN E
	HRROI A,STRNG1		;NOW GET DIR NUMBER
	MOVE B,D		;GET PPN
	HRROI C,DEVNM7
	PPNST			;TRANSLATE THE PPN
	 ERJMP CPOPJ		;NONE
	MOVE E,[POINT 7,STRNG1]	;GET POINTER TO STR/DIR STRING
GETDR4:	MOVE B,E		;GET STRING POINTER
	MOVX A,RC%EMO		;NO RECOGNITION
	RCDIR
	 ERJMP CPOPJ		;NONE
	TXNE A,RC%NOM!RC%AMB	;SUCCEED?
	POPJ P,			;NO
	MOVE D,C		;PUT DIRECTORY NUMBER IN D
	MOVE A,[POINT 7,DIRNAM]	;NOW BUILD DIR NAME STRING IN DIRNAM
GETDR1:	ILDB B,E		;GET A CHARACTER FROM STR/DIR STRING
	JUMPE B,CPOPJ		;FAILED
	CAIE B,"<"		;FOUND START OF DIR YET?
	JRST GETDR1		;NO, LOOP BACK UNTIL FOUND
GETDR2:	ILDB B,E		;GET NEXT DIR NAME CHARACTER
	JUMPE B,GETDR3		;REACHED THE END
	CAIN B,">"		;SEEN THE END?
	JRST GETDR3		;YES
	IDPB B,A		;STORE IT IN DESTINATION
	JRST GETDR2		;LOOP BACK UNTIL THE END IS REACHED

GETDR3:	MOVEI B,0		;END WITH A NULL
	IDPB B,A
	MOVE A,[POINT 7,DIRNAM]
	JRST CPOPJ1		;RETURN SUCCESSFUL


GTPROT:	SKIPN D			;DOES USER WANT DEFAULT
	  POPJ P,		;YES, LET SYSTEM SUPPLY DEFAULT
	SETZ A,			;INITIALIZE ANSWER
	MOVE C,[POINT 3,D,26]
	MOVEI B,3		;SET UP LOOP COUNTER
GTPRTL:	ILDB E,C		;GET NEXT FIELD
	MOVE E,PTAB(E)		;GET TRANSLATION
	LSH A,6
	IORI A,(E)		;ADD IN THIS FIELD
	SOJG B,GTPRTL		;LOOP FOR THREE FIELDS
	MOVE D,A
	POPJ P,

PTAB:	76			;0
	76			;1
	76			;2
	56			;3
	56			;4
	52			;5
	12			;6
	02			;7

JDEV:	CAMN D,[SIXBIT/SYS/]	;DEVICE SYS?
	  JRST JDEV1		;YES
JDEV0:	PUSH P,E		;SAVE STRING POINTER IN E
	MOVE E,[POINT 7,DEVNM7]	;GET POINTER TO DEVICE NAME BLOCK
	MOVEM E,JBLOCK+2	;STORE IN DEFAULT BLOCK
	PUSHJ P,SIX27V		;TRANSLATE TO ASCIZ
	POP P,E			;RESTORE MAIN STRING POINTER
	POPJ P,
JDEV1:	HRROI A,[ASCIZ/SYS/]	;CHECK FOR SYS AS A LOGICAL NAME
	STDEV			;...
	  TDZA A,A		;NOT DEFINED
	JRST JDEV0		;USE SYS AS A DEVICE NAME
	HRROI B,[ASCIZ/PS:<SUBSYS>/]	;GET SYSTEM DIRECTORY NUMBER
	MOVX A,RC%EMO		;NO RECOGNITION
	RCDIR
	 ERJMP JDEV2		;FAILED
	TXNE A,RC%NOM!RC%AMB
JDEV2:	MOVEI C,0		;FAILED, LEAVE NUMBER AS 0
	MOVEM C,DIRNUM(BB)	;SET UP NEW DIRECTORY NUMBER
	POPJ P,			;DEFAULT DEVICE TO DSK
;ROUTINE TO MAP PPN'S TO DIRECTORIES

;CALL:
;	MOVE A,PPN
;	MOVEI B,[ASCIZ/STR/]
;	PUSHJ P,PPN2DR
;	  ERROR - NO CONVERSION
;	SUCCESSFUL WITH DIR NUMBER IN A

PPN2DR:	PUSH P,A		;SAVE ACS
	PUSH P,B
	MOVE D,A		;GET PPN
	PUSHJ P,PPNMAP		;GO SEE IF IT IS SPECIAL
	 JRST PPN2D1		;NO
	POP P,0(P)		;NO LONGER NEED STR NAME
	POP P,0(P)		;OR PPN
	MOVE B,E		;SET UP TO TRANSLATE THIS STRING
	JRST PPN2D2

PPN2D1:	POP P,C			;GET POINTER TO STR NAME
	POP P,B			;GET PPN
	HRROI A,STRNG1		;SET UP TO RECEIVE STR/DIR STRING
	PPNST
	 ERJMP CPOPJ		;FAILED
	HRROI B,STRNG1		;NOW GET DIR NUMBER FROM STRING
PPN2D2:	MOVX A,RC%EMO		;NO RECOGNITION
	RCDIR
	 ERJMP CPOPJ		;FAILED
	TXNE A,RC%NOM!RC%AMB
	POPJ P,			;FAILED HERE TOO
	MOVE A,C		;GET DIR NUMBER INTO A
	JRST CPOPJ1		;GIVE SUCCESSFUL RETURN


;ROUTINE TO GET DIR NUMBER IF HASH TABLE NOT AROUND
;CALL:
;	MOVE D,PPN
;	PUSHJ P,PPNMAP
;	ERROR RETURN - NO MAPPING FOR THIS PPN
;	NORMAL RETURN - ASCIZ POINTER TO DIRECTORY NAME IN E

PPNMAP:	MOVSI C,-NPPN		;SET UP AOBJN COUNTER
	CAME D,PMAPTB(C)	;IS THIS A MATCH
	AOBJN C,.-1		;NO, LOOP BACK
	JUMPGE C,CPOPJ		;NO MATCH, GIVE NON-SKIP RETURN
	MOVE E,SMAPTB(C)	;GET ASCIZ STRING POINTER TO DIR
	JRST CPOPJ1		;SKIP RETURN

;ROUTINE TO MAP DIRECTORIES TO PPN'S
;CALL:	MOVE A,DIRNUM
;	PUSHJ P,PPNUNM
;	RETURN HERE WITH PPN IN A, ALL OTHER ACS WERE SAVED

PPNUNM:	PUSH P,D		;SAVE ALL ACS
	PUSH P,C
	PUSH P,B
	PUSH P,A
	JUMPE A,[GJINF		;IF 0 GIVE BACK OWN PPN
		MOVE A,B
		MOVEM A,0(P)	;PUT DIR NUM ON STACK
		JRST .+1]	;AND CONTINUE ON
	MOVSI D,-NPPN		;SET UP AOBJN POINTER
PPNLOP:	SKIPN C,DMAPTB(D)	;HAS THIS ENTRY BEEN TRANSLATED YET
	  PUSHJ P,[MOVE B,SMAPTB(D) ;NO, GET DIRNUM FOR THIS ENTRY
		MOVX A,RC%EMO	;NO RECOGNITION
		RCDIR		;GET DIR NUMBER
		 ERJMP CPOPJ	;NO TRANSLATION
		TXNE A,RC%NOM!RC%AMB
		POPJ P,		;NO TRANSLATION
		MOVEM C,DMAPTB(D) ;SAVE DIR NUMBER
		POPJ P,]
	CAMN C,0(P)		;IS THIS A MATCH
	  JRST [MOVE A,PMAPTB(D) ;YES, GET MAPPED PPN
		POP P,(P)	;POP OFF A
		JRST PPNDN1]	;CLEAN UP
	AOBJN D,PPNLOP		;LOOP FOR ALL MAPPED PPN'S
	POP P,A			;NO MATCH, USE THIS VALUE
	STPPN			;GET A PPN FROM THIS DIR NUMBER
	 ERJMP BUGSTP		;NO ERRORS ALLOWED
	MOVE A,B		;GET DIR NUMBER INTO A
PPNDN1:	POP P,B			;RESTORE ACS
	POP P,C
	POP P,D
	POPJ P,			;AND RETURN WITH PPN IN A
FILDIR:	JUMPN AA,CPOPJ		;IS THIS A DSK?
	HRROI A,DIRNAM		;YES, GET A DIR NUMBER FROM JFN
	HRRZ B,JFNTAB(BB)	;JFN
	MOVE C,[1B2!1B5!JS%PAF]	;GET STR:<DIR>
	JFNS			;...
	MOVX A,RC%EMO		;NOW GET DIR NUMBER
	HRROI B,DIRNAM		;DIR STRING
	RCDIR
	 ERJMP FILDR1		;FAILED
	TXNN A,RC%NOM!RC%AMB
	MOVEM C,DIRNUM(BB)	;SAVE DIR #
FILDR1:	MOVE A,JFNTAB(BB)	;RESTORE JFN
	POPJ P,
DEFINE MAPPPN
<	MAPGEN(<1,4>,<SUBSYS>)
	MAPGEN(<1,2>,<OPERATOR>)
	MAPGEN(<1,1>,<SYSTEM>)
>

DEFINE MAPGEN(A,B)
<	XWD A>

PMAPTB:	MAPPPN

NPPN=.-PMAPTB

DEFINE MAPGEN(A,B)
<	POINT 7,[ASCIZ/PS:<B>/]>

SMAPTB:	MAPPPN
UENTER:	TRO PF,R.ENT		;MARK THAT AN ENTER IS BEING DONE
	PUSHJ P,SETUP
	MOVE D,FLAGWD(BB)
	TLNN D,INITF
	PUSHJ P,ERRCHN
	CAIN AA,LPT		;LINE PRINTER?
	JRST UENT1		;YES, RELEASE THE JFN AND DO GTJFN AGAIN
	PUSHJ P,DIRCHK		;DIRECTORY TYPE DEVICE?
	  JRST MRETN2		;NO,NOP.
	MOVE A,DEVTBL(AA)	;DEVICE BITS
	TLNN A,DSKDEV		;A DISK?
	JRST UENT1		;NO
IFN FTFILSER,<
	HLRZ A,DEVNAM(BB)	;GET GENERIC NAME
	CAIN A,'DPA'		;TOPS-10 DSK?
	  JRST TENTER		;YES, GO DO FILSER ENTER
>
	MOVE A,FLAGWD(BB)	;YES. GET ITS ST@TUS
	TLnn A,IOPENF		;FILE ALREADY OPEN FOR INPUT?
	jrst uent1		;no
	pushj p,lukpar		;yes
	 jrst er1
	JRST ENTR4		;GO DO IT.
UENT1:	SETZM IOCNT		;PREPARE FOR CLOSE
	PUSHJ P,UCL1R		;CLOSE AND RELEASE JFN
	MOVEI D,17
	AND D,FLAGWD(BB)
	CAIE AA,DTA		;IS THIS A DTA?
	  JRST ENTR3A		;NO
	MOVE A,FLAGWD(BB)	;GET OPEN BITS
	TRNE A,100		;OPENED IN NON-STANDARD MODE?
	JRST MRETN2		;YES, ENTER IS A NOP THAT SKIPS
	PUSHJ P,DTAINI		;YES, GO CLOSE OTHER OPEN JFNS FOR THIS DTA
	PUSHJ P,DTAMNT		;GO MOUNT IT
	  JRST DTMNTF		;FAILED, GO COMPLAIN
ENTR3A:	PUSHJ P,LUKPAR		;SET UP SAME PARAMETERS AS LOOKUP
	  JRST ER1		;UNRECOGNIZABLE UFD
	MOVE D,FILNAM(BB)	;GET SIXBIT FILE NAME
	CAIE AA,LPT		;IF THIS IS A LPT, THEN NUL NAME ALLOWED
	JUMPE D,ER0		;ZERO FILE NAME FOR ENTER
	MOVSI D,IOPENF
	TDNE D,FLAGWD(BB)	;FILE OPENF FOR READING ALREADY?
	PUSHJ P,ERRARG
	MOVSI A,(GJ%FOU)
	MOVEM A,JBLOCK		;STORE FLAGS
ENTR3B:	MOVEI A,JBLOCK		;SET UP POINTER TO E-BLOCK
	HRROI B,STRNG1
	GTJFN
	  JRST [PUSHJ P,WARN	;ERROR - FIRST CHECK IF DIR FULL
		  JRST LOOKER	;UNKNOWN ERROR
		JRST ENTR3B]	;DID AN EXPUNGE, TRY AGAIN
	MOVEM A,JFNTAB(BB)	;SAVE GOTTEN JFN
	MOVEM A,NEWJFN		;IF OPENF FAILS
	PUSHJ P,FILDIR		;UPDATE DIRNUM(BB)
ENTR4:	MOVE B,FLAGWD(BB)	;GET STATUS
	TLNE B,IOPENF		;WRITE OR UPDATE?
	SKIPA B,[OF%RD!OF%WR]	;UPDATE (READ/WRITE)
	MOVX B,OF%WR		;WRITE
	PUSHJ P,OPENX
	  JRST [CAIN AA,DTA	;IS THIS A DTA
		 JRST [	CAIE A,OPNX4	;YES, WRITE LOCKED?
			JRST .+1	;NO, CALL WARN
			PUSHJ P,ILLOUT	;TYPE OUT PROBLEM MESSAGE
			HRRZ A,JFNTAB(BB)
			JRST ENTR4]	;TRY AGAIN
		PUSHJ P,WARN	;FAILURE, GO SEE IF QUOTA EXCEEDED
		  JRST LOOKER	;NOT QUOTA PROBLEMS, GO GIVE ERROR RET
		JRST ENTR4]	;DID AN EXPUNGE SO TRY AGAIN
ENTFIN:	PUSHJ P,SETDAT		;SET CREATION DATE AND TIME IF SPECIFIED
	SKIPE A,DIRNUM(BB)	;IS THERE A PPN?
	PUSHJ P,PPNUNM		;YES, GET THE PPN FROM IT
	HRRZ G,FORTY		;GET POINTER TO ARG BLOCK
	UMOVE F,(G)		;GET FIRST WORD
	TLNN F,-1		;ZERO LH?
	CAIGE F,3		;AND GREATER THAN 3?
	  TRZA PF,R.UEXT	;NO, THEN NOT EXTENDED FORMAT
	TRO PF,R.UEXT		;YES, EXTENDED FORMAT BLOCK
	TRNN PF,R.UEXT		;EXTENDED ARG BLOCK?
	JRST [	UMOVEM A,3(G)	;NO
		JRST ENTFI1]	;STORE PPN IN SHORT FORM BLOCK
	UMOVEM A,1(G)		;EXTENDED BLOCK
	UMOVE B,0(G)		;GET LENGTH OF BLOCK
	MOVE A,DEVNAM(BB)	;GET DEVICE NAME
	CAIGE B,16		;USER WANT RIBDEV?
	JRST ENTFI1		;NO
	UMOVEM A,16(G)		;YES
ENTFI1:	MOVSI A,OOPENF!ENTERF
	IORB A,FLAGWD(BB)
	JUMPN AA,MRETN2		;IF NOT A DSK, RETURN TO USER
	TLNE A,LOOKPF		;SEE IF A LOOKUP WAS DONE
	  JRST [PUSHJ P,OPNDSK	;YES, DONT DIDDLE VERSION COUNT
		JRST MRETN2]	;AFTER SETTING IOEOFP BACK UP
	MOVSI G,-EXTLEN		;NOW SEE IF THE EXTENSION MATCHES
	MOVS A,EXT(BB)		;  ONE OF THE SPECIAL EXTENSIONS
ENTLOP:	HLRZ B,EXTTAB(G)	;GET EXTENSION FROM TABLE
	CAME A,B		;SEE IF THIS IS A MATCH
	AOBJN G,ENTLOP		;NO MATCH, LOOP BACK
	JUMPGE G,MRETN2		;RAN OUT OF ENTRIES?
	HRRZ A,JFNTAB(BB)	;SEE IF THIS IS VERSION 1
	MOVE B,[XWD 1,FDBVER]	;TO SEE IF VERSION COUNT SHOULD BE SET
	MOVEI C,D
	GTFDB
	 ERJMP MRETN2
	HLRZS D			;THIS IS THE VERSION NUMBER
	CAIE D,1		;IS IT 1
	  JRST MRETN2		;NO, DONT DO ANYTHING SPECIAL
	HRRZ C,EXTTAB(G)	;GET DEFAULT NUMBER OF VERSIONS TO KEEP
	ROT C,-6		;POSITION THEM INTO BITS 0-5
	MOVSI B,770000		;SET UP MASK
	HRRZ A,JFNTAB(BB)	;GET JFN
	HRLI A,FDBBYV+CF%NUD_^D18	;AND OFFSET INTO FDB
	XJSYS <CHFDB>		;SET NEW VERSION LIMIT
	  JFCL
	JRST MRETN2

;TABLE OF SPECIAL EXTENSIONS
;  LH - SIXBIT EXTENSION, RH - VERSIONS TO KEEP

EXTTAB:	XWD 'LST',1
	XWD 'REL',1
	XWD 'CRF',1
	XWD 'TMP',1
	XWD 'OVR',1
	XWD 'SYM',1
	XWD 'TEM',1
	XWD 'XPN',1
	XWD 'BIN',1
	XWD 'QUE',1
	XWD 'QUF',1
	XWD 'DIR',1
EXTLEN==.-EXTTAB

SETDAT:	JUMPN AA,CPOPJ		;IF NOT A DSK, JUST RETURN
	HRRZ G,FORTY		;GET POINTER TO DATA BLOCK
	CAIN G,-1		;NO BLOCK?
	POPJ P,			;YES, JUST RETURN AND USE DEFAULT DATE
	UMOVE F,(G)		;GET FIRST WORD
	TLNN F,-1		;ZERO LH?
	CAIGE F,3		;AND GREATER THAN 3?
	  TRZA PF,R.UEXT	;NO, THEN NOT EXTENDED FORMAT
	TRO PF,R.UEXT		;YES, EXTENDED FORMAT BLOCK
	TRNE PF,R.UEXT		;EXTENDED ENTER?
	  JRST [XCTLB <LDB A,[POINT 3,3(G),20]>
		XCTLB <LDB B,[POINT 12,4(G),35]>
		XCTLB <LDB D,[POINT 11,4(G),23]>
		JRST SETDT1]	;YES, GET INFO FROM EXTENDED BLOCK
	XCTLB <LDB A,[POINT 3,1(G),20]>
	XCTLB <LDB B,[POINT 12,2(G),35]>
	XCTLB <LDB D,[POINT 11,2(G),23]>
SETDT1:	LSH A,^D12		;GET HIGH ORDER BITS OF DATE
	IOR A,B			;GET LOW ORDER BITS OF DATE
	JUMPE A,SETDT2		;IF NOT SPECIFIED, RETURN
	IMULI D,^D60		;TURN MINUTES INTO SECONDS FROM MIDNITE
	IDIVI A,^D31		;GET DAY OF THE MONTH IN B
	HRLZ C,B		;STORE FOR JSYS
	IDIVI A,^D12		;GET MONTH AND YEAR
	HRLI B,^D1964(A)	;GET ACTUAL YEAR
	HRROI A,STRNG1		;COLLECT DATE IN STRNG1
	SETZ E,			;STANDARD FLAGS
	XJSYS <ODTNC>		;GET DATE AND TIME
	 JRST SETDT2		;IF ERROR, USE CURRENT DATE
	HRROI A,STRNG1		;NOW GET INTERNAL FORMAT
	SETZ B,			;NO SPECIAL FLAGS
	IDTIM
	  JRST SETDT2		;FAILED, SO SET TODAYS DATE
	SKIPA C,B		;SET UP TO CHANGE FDB
SETDT2:	HRLOI C,377777		;SET C VERY LARGE SO CAMGE FAILS
	GTAD			;GET DATE
	CAMGE A,C		;IS DATE SPECIFIED GREATER THAN TODAY
	  MOVE C,A		;YES, DONT ALLOW THAT
	SETO B,			;ALL BITS IN WORD CHANGE
	HRRZ A,JFNTAB(BB)	;GET FILE JFN
	HRLI A,FDBWRT+CF%NUD_^D18	;CREATION OF THIS VERSION
	XJSYS <CHFDB>		;CHANGE IT
	  JFCL
	POPJ P,			;AND RETURN
URENME:	TRO PF,R.ENT		;PREVENT THE VERSION FIELD FROM BEING SET
	PUSHJ P,SETUP
	MOVE D,FLAGWD(BB)
	TLNN D,INITF
	PUSHJ P,ERRCHN
	PUSHJ P,DIRCHK		;DIRECTORY DEVICE?
	  JRST MRETN2		;NO

	SKIPN JFNTAB(BB)	;SEE IF A FILE WAS PREVIOUSLY OPENED
	  JRST ER5		;NO FILE PREVIOUSLY SELECTED

IFN FTFILSER,<
	HLRZ A,DEVNAM(BB)	;TOPS-10 DSK?
	CAIN A,'DPA'
	  JRST TRENME		;YES, GO TO FILSER
>
	SETZM IOCNT		;NOW DO A CLOSE (FOR LEVEL-D)
	PUSHJ P,UCL1K		;  CLOSE WITHOUT RELEASING JFN

	PUSHJ P,FILDIR		;GET CORRECT DIRECTORY NUMBER
	PUSH P,DIRNUM(BB)	;SAVE OLD DIRECTORY NUMBER
	PUSH P,EXT(BB)		;SAVE OLD EXT
	PUSH P,FILNAM(BB)	;AND FILE NAME
	PUSHJ P,LUKPAR		;SET UP RENAME PARAMETERS
	  JRST [SUB P,[3,,3]	;REMOVE FILE NAME, EXT
		JRST ER1]	;UNRECOGNIZABLE UFD
	SKIPN FILNAM(BB)	;ZERO NAME?
	  JRST RENDEL		;YES, GO DELETE FILE
	MOVSI A,600000
	MOVEM A,JBLOCK		;STORE FLAGS FOR GTJFN
URENM1:	MOVEI A,JBLOCK		;GET E-BLOCK ADDRESS
	HRROI B,STRNG1
	GTJFN
	  JRST [PUSHJ P,WARN	;SEE IF OVER QUOTA
		  JRST LOKERP	;NO, GIVE ERROR RETURN
		JRST URENM1]	;GO TRY AGAIN
	EXCH A,JFNTAB(BB)	;PUT NEW JFN IN
	PUSH P,A		;SAVE JFN
	PUSHJ P,FILDIR		;GET DIRECTORY
	POP P,A			;GET JFN BACK
	EXCH A,JFNTAB(BB)	;RESTORE OLD JFN
 	POP P,B			;GET OLD FILE NAME
	POP P,C			;AND EXT
	POP P,D			;AND DIRECTORY NUMBER
	CAMN B,FILNAM(BB)	;FILE NAME THE SAME?
	CAME C,EXT(BB)		;AND EXT THE SAME
	  JRST URENM2		;NO GO RENAME
	CAME D,DIRNUM(BB)	;HAS DIRECTORY CHANGED
	  JRST URENM2		;YES GO RENAME
	RLJFN			;NO.  RELEASE THE JFN
	  JFCL			;IGNORE ANY ERRORS
	PUSHJ P,URENA1		;CHANGE FILE PARAMETERS ONLY
	  JRST LOOKER		;ERROR RETURN
	JRST MRETN2
URENM2:	PUSHJ P,URENAM		;GO DO THE RENAMING
	  JRST LOOKER		;IT FAILED
	JRST MRETN2		;SUCCESSFUL

URENAM:	PUSH P,A
	HRLI A,FDBPRT		;MAKE IT POSSIBLE TO RENAME THIS FILE
	MOVEI B,770000		;NOT PROTECTED FROM THIS USER
	MOVEI C,770000
	XJSYS <CHFDB>		;CHANGE THE PROTECTION
	  JRST [POP P,(P)		;FAILURE
		POPJ P,]
	HRR A,JFNTAB(BB)		;GET OLD JFN
	XJSYS <CHFDB>		;CHANGE ITS PROTECTION ALSO
	  JRST [POP P,(P)		;FAILURE
		POPJ P,]		;RETURN ERROR CODE
	HRRZ A,JFNTAB(BB)		;OLD JFN
	TLO A,(CO%NRJ)		;DON'T RELEASE IT
	CLOSF			;BE SURE FILE IS CLOSED
	JFCL
	HRRZ A,JFNTAB(BB)		;OLD JFN
	POP P,B			;NEW JFN
	MOVEM B,NEWJFN		;IN CASE RNAMF FAILS, JFN WILL BE RELEASED
	RNAMF
	  POPJ P,			;GIVE ERROR RETURN
	MOVEM B,JFNTAB(BB)		;NEW JFN
URENA1:	HRLI A,FDBPRT		;NOW SET THE DESIRED PROTECTION
	HRR A,JFNTAB(BB)		;IN FDB
	MOVEI B,-1		;ONLY RH IS CHANGED
	HRRZ C,PROT(BB)		;GET DESIRED PROT
	SKIPE C			;IF 0 USE WHAT SYSTEM DEFAULTED
	CHFDB
	ERJMP CPOPJ		;MAY NOT BE ABLE TO CHANGE THE PROTECTION
	PUSHJ P,SETDAT		;SET CREATION DATE AND TIME IF SPECIFIED
	JRST CPOPJ1

RENDEL:	SUB P,[3,,3]		;REMOVE NAME, EXT. AND PPN
	HRRZ A,JFNTAB(BB)	;ZERO FILE NAME ON RENAME, IE DELETE
	SETZ B,			;KEEP NO VERSIONS
	DELNF			;MARK ALL FILES DELETED
	 JRST LOOKER		;ERROR OCCURED
	SETZM JFNTAB(BB)	;INIT DATA BASE
	GTSTS			;GET STATUS OF JFN
	TLNN B,(1B0)		;OPEN?
	JRST [	RLJFN		;NO, JUST RELEASE IT
		 JFCL		;
		JRST MRETN2]	;SUCCESS
	CLOSF			;FILE OPEN, CLOSE AND RELEASE
	 JFCL
	JRST MRETN2		;SUCCESS
UCLOSE:	PUSHJ P,SETUPG
	  JRST MRETN		;NOTHING TO BE OPEN, RETURN IMMEDIATELY
	MOVE A,FORTY		;MOVE CLOSE BITS
	MOVEM A,IOCNT		;TO WHERE UCL1 WILL SEE THEM
	PUSHJ P,UCL1K		;CLOSE, KEEPING JFN
	JRST MRETN

UCL1K:	TROA PF,R.KJFN		;KEEP THE JFN
UCL1R:	TRZ PF,R.KJFN		;RELEASE THE JFN
	TRO PF,R.CLS		;INDICATE CLOSE
	MOVEI B,1
	TDNE B,IOCNT		;CLOSE OUTPUT?
	JRST UCL2			;NO
	PUSH P,IOCNT
	PUSH P,FORTY
	SETZM FORTY
	MOVSI B,OOPENF
	MOVEI A,17
	AND A,FLAGWD(BB)
	CAIG A,14		;BUFFERED MODE?
	TDNN B,FLAGWD(BB)	;AND OPEN FOR OUTPUT?
	JRST UCL1		;NO- ALL DONE
	HLRZ CC,BUFHTB(BB)	;SEE IF THERE IS A BUFFER RING
	JUMPE CC,UCL1		;NO, DONT DO OUTPUT
	UMOVE A,0(CC)		;GET FIRST WORD OF RING
	TLZ A,377777		;CLEAR UN DESIRED BITS
	JUMPLE A,UCL1		;IF VIRGIN OR ZERO, DONT DO OUTPUT
	PUSHJ P,OUTTN		;IF OPEN FOR WRITING, DO LAST OUT
	 JFCL			;PITY
UCL1:	POP P,FORTY
	POP P,IOCNT
	MOVSI B,OOPENF		;CHECK IF FILE OPENED
	TDNN B,FLAGWD(BB)
	SKIPN MAPTAB(BB)	;AND MAPPED PAGE?
	JRST UCL1A		;NO
REPEAT 0,<
	SKIPG A,JFNTAB(BB)	;NOW SET THE SIZE AND # OF WORDS
	  JRST UCL5		;ONLY IF THERE IS A JFN
	HRLI A,FDBSIZ		;BYTE COUNT
	MOVNI B,1		;ALL 36 BITS
	MOVE C,IOEOFP(BB)	;SET EOF
	XJSYS <CHFDB>
	  JFCL
	HRLI A,FDBBYV		;
	MOVSI B,7700
	MOVSI C,(^D36B11)	;SIZE = 36 BITS
	XJSYS <CHFDB>
	  JFCL
>
	JRST UCL5		;GO REMOVE PAGE
UCL1A:	CAIN AA,MTA		;IS THIS A MTA?
	  PUSHJ P,CLSMTA	;YES, GO WRITE EOF
UCL2:
	MOVEI B,2		;CLOSING INPUT SIDE?
	TDNN B,IOCNT		; ..
	SKIPG MAPTAB(BB)	;YES. HAVE A PAGE MAPPED?
	JRST UCL4		;NO.
UCL5:	PUSHJ P,UNMAPP		;GO UN MAP PAGE
UCL4:	MOVE B,FLAGWD(BB)
	MOVE A,IOCNT
	TRNN A,1		;CLOSING OUTPUT?
	TLZN B,OOPENF		;WAS THIS OPENED?
	  JRST UCL6		;NO, DONT SET PROTECTION
	JUMPN AA,UCL6		;DONT SET PROT IF NOT A DISK
	TLNE B,IOPENF!LOOKPF	;WAS IT ALSO OPENED FOR READING?
	  JRST UCL6		;YES, THEN DONT CHANGE PROT EITHER
	MOVSI A,FDBPRT		;YES, SET PROT
	HRR A,JFNTAB(BB)	;GET JFN 
	MOVEI B,-1		;SET ONLY RH
	HRRZ C,PROT(BB)		;GET DESIRED PROTECTION
	JUMPE C,UCL4A		;IF NOT SET, USE SYSTEM DEFAULT PROT
	TRNN A,-1		;WAS THIS FILE CLOSED ALREADY?
	  JRST UCL4A		;YES, DONT CHANGE PROT
	XJSYS <CHFDB>		;NO, OK TO CHANGE PROTECTION
	  JFCL
UCL4A:	MOVE B,FLAGWD(BB)	;GET FLAGS AGAIN
	MOVE A,IOCNT		;SET UP CLOSE BITS AGAIN
	TLZ B,OOPENF		;CLEAR OUTPUT OPEN FLAG
UCL6:	TRNN A,2		;CLOSING INPUT?
	TLZ B,IOPENF		;YES
IFN FTFILSER,<
	HLRZ A,DEVNAM(BB)	;SEE IF THIS IS A DPA
	CAIN A,'DPA'
	  JRST TCLOSE		;YES, GO CLOSE IT WITH FILSER
>
	SKIPLE A,JFNTAB(BB)
	TLNE B,OOPENF+IOPENF	;BOTH SIDE NOW CLOSED?
	JRST UCL3		;NO
	HRRZS A			;GET RH ONLY
	CAIE A,PRIJFN		;PRIMARY INPUT JFN?
	CAIN A,PROJFN		;OR PRIMARY OUTPUT JFN?
	  JRST UCL3		;YES, DONT CLOSE IT
	PUSH P,A		;SAVE JFN
	CAIN AA,DSK		;DSK?
	 PUSHJ P,SETEOF		;YES, GO SET THE EOF
	POP P,A
	HRL A,IOCNT		;GET CLOSE BITS
	TLNN A,40		;FLUSH OUTPUT FILES?
	TLZA A,-1		;NO, CLEAR CLOSF BITS
	HRLI A,(CZ%ABT)		;YES, SET ABORT BIT
	TLO A,(1B0)		;SET SIGN BIT FOR CLOSF
	CLOSF			;CLOSE IT
	  JFCL			;MULTIPLE CLOSE IS NOP
	SKIPLE A,JFNTAB(BB)	;DON'T RELEASE JFN IF IT IS ZERO
	TRNE PF,R.KJFN		;OR CALLER SAID KEEP IT
	JRST UCL3
	HRRZS A
	PUSHJ P,SAVUFD		;IF THIS IS A UFD JFN SAV IT
	  SKIPA			;NOT A UFD
	 JRST UCL6A		;SAVED, DONT RELEASE IT
	RLJFN
	PUSHJ P,ERROR
UCL6A:	SETZM JFNTAB(BB)
UCL3:	CAIN AA,DTA		;DTA?
	  PUSHJ P,DTAMNT	;YES, GO LEAVE DTA MOUNTED
	  JFCL			;IGNORE ERROR RETURN
	MOVEI A,2		;B34
	TDNN A,IOCNT		;OMIT INPUT SIDE?
	PUSHJ P,CLOSEI		;NAH, CLOSE IT
	MOVEI A,1		;B35
	TDNE A,IOCNT		;OUTPUT CLOSE?
	POPJ P,			;NO, RETURN
	CAIN AA,DSK		;IS THIS A DISK?
	PUSHJ P,SETEOF		;SET EOF SIZES IN FDB
	PUSHJ P,CLOSEO		;DO BUFFER HEADER STUFF
	POPJ P,

SETEOF:	MOVE B,FLAGWD(BB)	;CHECK IF DSK FILE
	TLNE B,OOPENF		;WAS FILE OPENED
	TLNE B,RDUFDF+RDMFDF	;YES, IS THIS NOT A DIRECTORY?
	 POPJ P,		;NO, DONT SET EOF ON DIRECTORY JFNS
	SKIPG A,JFNTAB(BB)	;IS THERE A JFN
	 POPJ P,		;NO
	HRLI A,FDBSIZ+CF%NUD_^D18	;BYTE COUNT
	MOVNI B,1		;ALL 36 BITS
	MOVE C,IOEOFP(BB)	;SET EOF
	XJSYS <CHFDB>
	  JFCL
	HRLI A,FDBBYV+CF%NUD_^D18
	MOVSI B,7700
	MOVSI C,(^D36B11)	;SIZE = 36 BITS
	XJSYS <CHFDB>
	  JFCL
	POPJ P,

UNMAPP:	PUSH P,A
	PUSH P,B
	PUSH P,C		;SAVE ALL ACS USED
	SKIPN B,MAPTAB(BB)	;ANY PAGES MAPPED?
	JRST UNMAPD		;NO
	HRLI B,.FHSLF		;YES, UNMAP THEM FROM THIS FORK
	MOVE C,[PM%CNT+NPLPGS]	;ALL OF THEM IN ONE SWELL FOOP
	SETO A,
	PMAP
	MOVSI A,(1B0)		;NOW FREE UP THIS SLOT
	HRRZ B,MAPTAB(BB)	;GET PAGE NUMBER
	MOVNI B,-IOMPGS(B)	;GET NEGATIVE PAGE OFFSET IN PAGE AREA
	IDIVI B,NPLPGS		;GET BIT POSITION IN MAPLST
	LSH A,0(B)
	IORM A,MAPLST		;BLOCK IS NOW AVAILABLE
	SETZM MAPTAB(BB)	;CLEAR POINTER TO IT
	SOS MAPTOT		;COUNT DOWN NUMBER OF MAP SLOTS USED
UNMAPD:	POP P,C			;RESTORE ACS
	POP P,B
	POP P,A
	POPJ P,

;ROUTINE TO SAVE A UFD JFN (TO SPEED UP SCAN AND WILD)
;CALL:	PUSHJ P,SAVUFD
;	  RETURN HERE IF JFN NOT SAVED
;	RETURN HERE IF JFN WAS SAVED AND SHOULD NOT BE RELEASED

SAVUFD:	PUSH P,A		;SAVE ALL ACS USED
	MOVE A,FLAGWD(BB)	;GET FLAGS
	TLNE A,RDUFDF		;IS THIS A UFD JFN
	SKIPG A,JFNTAB(BB)	;GET JFN OF UFD
	  JRST APOPJ		;NOT A UFD JFN, RETURN TO RELEASE IT
	EXCH A,LSTUFJ		;SAVE JFN OF UFD
	HRRZS A
	RLJFN			;RELEASE OLD JFN
	JFCL
	MOVE A,DIRNUM(BB)	;GET DIR NUM
	MOVEM A,LSTUFD		;SAVE FOR LATER
	MOVE A,IOBYTP(BB)	;GET POINTER WORD
	MOVEM A,LSTUFP		;SAVE IT TOO
	POP P,A			;RESTORE AC
	JRST CPOPJ1		;AND SKIP RETURN
CLOSEI:	MOVSI B,IOPENF+INFIRF+LOOKPF
	HRRZ A,BUFHTB(BB)	;PTR TO INPUT BUFFER HEADER
CLOSI2:	TDNN B,FLAGWD(BB)
	POPJ P,
	TRO B,1B22		;CLEAR EOF.
	ANDCAB B,FLAGWD(BB)
	ANDI B,17
	CAIE A,0		;IS THERE A BUFFER?
	CAILE B,14		;AND IN BUFFERED MODE?
	POPJ P,			;NO

	MOVSI B,400000		;CLOSE A BUFFER RING
	XCTUU <SKIPN (A)>	;HAS BUFFER RING BEEN SET UP?
	POPJ P,			;NO
	XCTUU <SETZM 2(A)>	;CLEAR BYTE COUNT
	XCTUU <TDNE B,(A)>	;AND HAS IT BEEN USED?
	POPJ P,			;NO, FORGET IT

	XCTUU <IORB B,(A)>

	MOVEI D,(B)		;EXTRA COPY FOR END TEST
	MOVEI A,100		;SET MAXIMUM # OF BUFFERS IN RING COUNT
BUFLP:	MOVEI C,(B)
	CAMLE C,JBREL		;ARE RING LINK POINTERS OK?
	PUSHJ P,ERRARG		;NO, SMASHED SOMEHOW
	MOVSI B,400000
	XCTUU <ANDCAB B,(C)>	;CLEAR BUFFER USE BIT AND FETCH CHAIN POINTER
	CAIE D,(B)		;BACK AROUND TO FIRST ONE IN RING?
	SOJG A,BUFLP		;NO
	POPJ P,

CLOSEO:	MOVSI B,OOPENF+OUFIRF
	HLRZ A,BUFHTB(BB)
	JRST CLOSI2

DIRCHK:	CAIN AA,.DVNUL		;NULL DEVICE?
	  POPJ P,		;YES, DIRECTORY NOT REQUIRED, RETURN
	MOVE B,DEVTBL(AA)	;GET DEVICE BITS
	TLNE B,HASDIR		;HAVE A DIRECTORY?
	AOS 0(P)		;YES. SKIP RETURN
	POPJ P,0		;RETURN.

DEV67:	MOVE D,DEVNAM(BB)	;GET THE SIXBIT NAME
	HRROI E,DEVNM7		;WHERE ASCIZ SHOULD GET PUT
	JRST SIXTO7		;CONVERT IT.
;SETUP ON ENTRY TO IO UUO'S

SETUP:	PUSHJ P,SETUPG		;CALL CONDITIONAL SETUP ROUTINE
	  PUSHJ P,ERRCHN	;NOT OPEN. ERROR.
	POPJ P,0		;OK.

;CONVERSION FROM SIXBIT TO ASCIZ
;C - CLOBBERABLE
;D - SIXBIT THING TO CONVERT
;E - POINTER TO DESTINATION

SIXTO7:	HRLI E,440700	;ASSUME ALL ASCIZ'S START ON WORD BOUNDARY
	SETZM 0(E)		;CLEAR DESTINATION WORD
SIX27E:	TRZA PF,R.CVF		;CLEAR QUOTING FLAG
SIX27V:	TRO PF,R.CVF		;MARK THAT CHARACTERS SHOULD BE QUOTED
	JUMPE D,SIXT7B		;QUIT IF STRING EMPTY
SIXT7A:	MOVEI C,0
	ROTC C,6		;PUT ONE CHAR INTO C
	CAIGE C,'A'		;SEE IF CHARACTER SHOULD BE QUOTED
	CAIG C,'9'		;A-Z AND 0-9 WONT GET QUOTED
	SKIPA			;SO FAR OK
	  TRO PF,R.CVC		;QUOTE THIS CHAR
	CAIG C,'Z'		;GREATER THAN Z
	CAIGE C,'0'		;OR LESS THAN 0
	  TRO PF,R.CVC		;QUOTE THIS CHAR
	TRZE PF,R.CVC		;THIS CHAR TO BE QUOTED
	TRNN PF,R.CVF		;YES, QUOTE FLAG ON?
	  JRST SIXT7C		;NO, DONT QUOTE ANYTHING
	PUSH P,C		;SAVE CHARACTER
	MOVEI C,C.CNTV		;GET QUOTE CHAR
	IDPB C,E		;STORE IT
	POP P,C			;GET CHARACTER BACK
SIXT7C:	ADDI C,40		;OFFSET
	IDPB C,E		;STORE AWAY
	JUMPN D,SIXT7A		;ANY MORE CHARS IN THING?
SIXT7B:	PUSH P,E		;SAVE BYTE POINTER BEFORE STORING 0
	IDPB D,E		;STORE A ZERO TERMINATOR
	POP P,E			;RESTORE UPDATED BYTE POINTER FOR CALLER
	POPJ P,

SETUPG:	TLNE AC,770000		;SIXBIT NAME?
	JRST SETUPD		;YES, GO SEARCH FOR NAME
	MOVE BB,AC		;CHANNEL NUMBER
	IMULI BB,NTABS
SETUPF:	LDB AA,PDVNUM		;GET NUMERIC DEVICE TYPE
	CAIL AA,MAXDEV		;IS THIS A KNOWN DEVICE?
	POPJ P,			;NO
	SKIPE DEVNAM(BB)		;SOMETHING OF A CROCK.
	AOS 0(P)
	POPJ P,

SETUPD:	MOVEI BB,0		;SCAN FOR DEVICE NAME
SETUPL:	CAMN AC,DEVNAM(BB)	;FOUND IT YET?
	JRST SETUPF		;YES
	ADDI BB,NTABS		;NO, STEP TO NEXT CHANNEL
	CAIG BB,17*NTABS	;REACHED THE END YET?
	JRST SETUPL		;NO, LOOP BACK FOR ALL CHANNELS
	POPJ P,			;RETURN UNSUCCESSFUL
UUSETO:	TROA PF,R.DIRN		;FLAG USETO VS USETI
UUSETI:	TRZ PF,R.DIRN		;USETI VS USETO
	PUSHJ P,SETUP
	CAIN AA,DTA		;IS IT DECTAPE?
	  JRST DTASET		;YES
	JUMPN AA,MRETN		;ONLY ALLOWED FOR DISK AND DTA
	MOVSI A,RNDMF		;MARK THAT FILE IS RANDOM
	IORB A,FLAGWD(BB)	;THEN SEE IF SUPER USETI/O
	TLNN A,LOOKPF!ENTERF	;IS THIS A SUPER USETI OR USETO
	  JRST SUSET		;YES, GO HANDLE IT
	TLNE A,RDUFDF		;IS THIS A UFD WE ARE ADVANCING?
	  JRST UUFDST		;YES IT IS.... ARGH!
	HRRZ B,FORTY		;BUFFER NUMBER
	CAIN B,-1		;IS THIS A SPECIAL CASE?
	  JUMPE AA,UUSET3		;YES, GO SET POINTER TO END OF FILE
	SOJGE B,.+2
	SETZ B,
	IMUL B,DEVTB2(AA)	;BUFFER SIZE
	TRNN PF,R.DIRN		;OUTPUT?
	CAMGE B,IOEOFP(BB)	;NO. INPUT BEYOND EOF?
	JRST UUSET1		;NO
	PUSH P,B		;SAVE POSITION
	PUSHJ P,PTRGET		;GET EOF VALUE
	 JRST [	POP P,B
		JRST MRETN]	;FAILED
	POP P,B			;GET BACK NEW POSITION
	CAMGE B,IOEOFP(BB)	;IS IT BEYOND THE EOF?
	JRST UUSET1		;NO

UUSET3:
IFN FTFILSER,<
	HLRZ A,DEVNAM(BB)	;IS THIS A DPA?
	CAIN A,'DPA'		;...
	  PUSHJ P,TUSET		;YES, GO DO FUNCTION
>
	PUSHJ P,PTRGET		;GET NEW EOF
	 JRST MRETN
	SKIPE B,IOEOFP(BB)	;GET THE END OF FILE
	SOS B			;IF NOT ZERO, DECREMENT IT
	TRZ B,177		;MAKE B = POINTER TO EOF MINUS ONE BLOCK
	TRNE PF,R.DIRN		;IS THIS A USETO
	  JRST UUSET1		;YES, GO STORE VALUE
	MOVE B,IOEOFP(BB)	;NO, GET EOF
	MOVEM B,IOBYTP(BB)	;MARK IT
	HRRZ A,JFNTAB(BB)	;NOW SET THE NEW FILE POINTER
	SFPTR
	 JFCL
UUSETE:	MOVEI A,1B22		;INPUT, EOF FLAG SET
	IORM A,FLAGWD(BB)
	JRST MRETN

UUSET1:	MOVEI C,1B22		;CLEAR EOF BIT
	ANDCAM C,FLAGWD(BB)	;  IN CASE IT WAS ON
IFN FTFILSER,<
	HLRZ C,DEVNAM(BB)	;IS THIS A TOPS-10 PACK?
	CAIN C,'DPA'
	 JRST UUSET2		;YES, DONT DO SFPTR
>
	HRRZ A,JFNTAB(BB)	;GET JFN OF FILE
	SFPTR
	  JFCL			;IGNORE ERROR
UUSET2:	MOVEM B,IOBYTP(BB)	;STORE NEW BYTE POINTER
	CAMLE B,IOEOFP(BB)	;IS THIS A NEW END OF FILE?
	  MOVEM B,IOEOFP(BB)	;YES, UPDATE EOF POINTER
IFN FTFILSER,<
	HLRZ A,DEVNAM(BB)	;IS THIS A DPA?
	CAIN A,'DPA'		;...
	  PUSHJ P,TUSET		;YES, GO DO FUNCTION
>
	JRST MRETN

SUSET:
IFN FTFILSER,<
	HLRZ A,DEVNAM(BB)	;GET GENERIC NAME
	CAIE A,'DPA'		;IS THIS A TOPS-10 PACK
	  JRST BUGSTP		;NO, SUPER USETI/O IS ILLEGAL
	SETZM IOBYTP(BB)	;MAKE SURE EOF DOESNT HAPPEN
	HRLOI A,377777	;GET LARGE NUMBER FOR EOF POINTER
	MOVEM A,IOEOFP(BB)
	JRST TDOUUO		;GO DO UUO
>
IFE FTFILSER,<
	JRST BUGSTP		;NOT ALLOWED
>

FILOP:	XCTUU <HLRZ AC,0(CAC)>
	TRZ AC,400000		;CLEAR OUT PRIVILEGED BIT
	PUSHJ P,SETUP		;SET UP TO POINT TO CHNTAB
	XCTUU <HRRZ A,0(CAC)>	;GET FUNCTION CODE
	CAIN A,11		;USETI
	JRST FILOP1
	CAIN A,12		;USETO
	JRST FILOP2
	CAIE A,10		;UPDATE RIB?
	JRST CMRETN		;NO, ALL OTHERS NOT IMPLEMENTED
	JUMPN AA,MRETN2		;IF NOT A DISK, SUCCESS
	MOVE A,FLAGWD(BB)	;GET FLAGS
	TLNN A,ENTERF		;WRITING TO FILE?
	JRST MRETN2		;NO, SUCCESSFUL RETURN
	HRLZ A,JFNTAB(BB)	;GET JFN AND PAGE TO START AT
	MOVEI B,-1		;MAXIMUM NUMBER OF PAGES (MINUS 1!!)
	UFPGS			;WRITE ALL PAGES TO THE DISK
	 PUSHJ P,ERROR		;SHOULDN'T FAIL
	PUSHJ P,SETEOF		;SET END OF FILE POINTER
	JRST MRETN2		;SKIP RETURN

FILOP1:	TRZA PF,R.DIRN		;INPUT
FILOP2:	TRO PF,R.DIRN		;OUTPUT
	JUMPN AA,CMRETN		;IF NOT A DISK, RETURN ERROR
	MOVSI A,RNDMF		;MARK THAT THE ACCESS IS RANDOM
	IORB A,FLAGWD(BB)	;GET FLAGS
	TLNN A,RDUFDF		;READING A UFD?
	TLNN A,LOOKPF!ENTERF	;OR NO LOOKUP OR ENTER BEEN DONE YET?
	JRST CMRETN		;YES, GIVE ERROR
	UMOVE B,1(CAC)		;GET BLOCK NUMBER
	IMUL B,DEVTB2(AA)	;TURN IT INTO # OF WORDS
	TRNN PF,R.DIRN		;USETI?
	CAMGE B,IOEOFP(BB)	;YES, IS IT PAST THE EOF?
	SKIPA			;NO
	JRST CMRETN		;YES, GIVE ERROR RETURN
	MOVEI C,1B22		;TURN OFF EOF IF IT WAS ON
	ANDCAM C,FLAGWD(BB)
	HRRZ A,JFNTAB(BB)	;NOW SET THE FILE POINTER
	SFPTR			;TO THE DESIRED BYTE
	 PUSHJ P,ERROR		;SHOULD NEVER FAIL
	MOVEM B,IOBYTP(BB)	;STORE THE NEW BYTE POINTER
	CAMLE B,IOEOFP(BB)	;IS THIS A NEW EOF?
	MOVEM B,IOEOFP(BB)	;YES, REMEMBER THAT FACT
	JRST MRETN2		;ALL DONE
PTRGET:	PUSHJ P,DIRCHK		;DIRECTORY DEVICE?
	  POPJ P,0		;NO. NO-OP
	MOVE A,FLAGWD(BB)		;CHANNEL FLAGS
	TLNE A,DTADMP		;IS THIS A DTA DOING DUMP MODE STUFF
	  JRST PTRGT2		;YES, GO HANDLE SPECIAL CASE
	TLNE A,LOOKPF!ENTERF	;MUST BE LOOKED UP OR ENTERED
	TLNN A,OOPENF!IOPENF	;AND OPEN FOR INPUT OR OUTPUT
	  POPJ P,		;ERROR
	JUMPE AA,PTRGT1		;IF DISK, RETURN IOEOFP(BB)
	HRRZ A,JFNTAB(BB)
;NOTE - FOLLOWING IN PLACE OF SIZEF WHICH FAILS IF FILE NEVER CLOSED.
	RFPTR			;WHERE ARE WE IN FILE?
	  POPJ P,
	PUSH P,B		;SAVE IT
	SETO B,			;REQUEST CURRENT EOF
	SFPTR			; ..
	  POPJ P,
	RFPTR			;FIND WHERE THAT IS
	POPJ P,
	EXCH B,0(P)		;SAVE ANSWER
	SFPTR			;RESTORE TO WHERE WE WERE AT CALL
	  POPJ P,
	POP P,B			;RETURN THE LENGTH OF FILE
	AOS(P)			;SKIP RETURN
	POPJ P,

PTRGT1:	HRRZ A,JFNTAB(BB)	;GET CURRENT POINTER TO THE EOF
	MOVE B,[XWD 1,.FBBYV]	;GET BYTE SIZE
	MOVEI C,D		;INTO D
	GTFDB
	 ERCAL ERROR
	SIZEF			;GET SIZE OF FILE
	 PUSHJ P,ERROR
	LDB D,[POINT 6,D,11]	;GET BYTE SIZE
	SKIPG D			;MUST BE NON-ZERO
	MOVEI D,^D36		;IF ZERO, USE 36
	MOVEI C,^D36		;NOW GET BYTES PER WORD
	IDIVI C,(D)		;...
	IDIVI B,(C)		;NOW GET # OF WORDS IN THE FILE
	SKIPE C			;ROUNDED UP
	AOS B			;IF NECESSARY
	CAML B,IOEOFP(BB)	;DO NOT SAVE EOF IF IT IS LOWER
	MOVEM B,IOEOFP(BB)	;SAVE EOF POINTER
	JRST CPOPJ1

PTRGT2:	MOVEI B,1102*200	;RETURN THE # OF WORDS ON A DTA
	JRST CPOPJ1
;IN, OUT, INPUT, OUTPUT

UOUT:	PUSHJ P,OUTT
	MOVE A,FLAGWD(BB)
	TRNE A,742000		;DATA ERRS OR EOT?
	JRST UIOSK1
	JRST UIOSK

UIN:	PUSHJ P,INN
	MOVE A,FLAGWD(BB)
	TRNE A,762000		;DATA ERRS, EOF, OR EOT?
UIOSK1:	AOS 0(P)
UIOSK:	JRST MRETN

UINPUT:	PUSHJ P,INN
	JRST MRETN

UOUTPT:	PUSHJ P,OUTT
	JRST MRETN
;IN AND INPUT OPERATORS

INN:	PUSHJ P,SETUP
	MOVE A,FLAGWD(BB)
	JUMPN AA,INN0		;IS THIS THE DISK?
	TLNE A,LOOKPF		;YES, WAS A LOOKUP DONE
	  JRST INN0		;YES
	MOVEI A,IO.IMP		;NO, SET IO IMPROPER MODE
	IORM A,FLAGWD(BB)	;IN FLAG REGISTER
	POPJ P,			;AND RETURN
INN0:	TLNE A,IOPENF		;OPEN FOR INPUT?
	JRST INN3		;YES
	CAIN AA,TTY		;IS THIS A TTY
	  JRST INNTTO		;YES, OPEN IT FOR BOTH READ AND WRITE
	MOVEI B,1B19
	PUSHJ P,OPENX		;OPEN IT FOR INPUT
	  JRST INMNTF		;OPEN FAILED, SEE IF NEEDS MOUNTING
	MOVSI A,IOPENF!LOOKPF
INN1:	IORM A,FLAGWD(BB)	;MARK THAT FACT
	PUSHJ P,SETDES		;GO SET UP NEW DEVICE DESIGNATOR WORD
	PUSHJ P,SETUP		;SET UP DEVICE DESIGNATOR IN CASE IT CHANGED
	JUMPN AA,INN		;IF NOT A DISK, TRY AGAIN
	PUSHJ P,OPNDSK		;IF DISK FILE, SET UP THE COUNTS
	JRST INN		;GO TRY AGAIN

INNTTO:	MOVEI B,1B19!1B20	;READ AND WRITE
	PUSHJ P,OPENX
	  JRST INMNTF		;FAILED
	MOVSI A,IOPENF!OOPENF	;MARK THAT OPENED FOR BOTH
	JRST INN1

INMNTF:	PUSHJ P,MNTFAI		;SEE IF TRAP SET UP
	JFCL
	PUSHJ P,ILLINP		;NO GO TYPE APPROPRIATE MESSAGE
	JRST INN		;TRY AGAIN

INN3:	ANDI A,17		;GET MODE INITED IN.
	CAIL A,15		;IS IT A BUFFERED MODE?
	JRST INDMP		;NO, DUMP MODE
	HRRZ CC,BUFHTB(BB)	;BUFFER HEADER
	HRRZ A,FORTY
	CAIE A,0		;SPECIFYING NEW RING?
	HRRM A,0(CC)		;YES, STORE ADDRESS
	MOVSI A,INFIRF		;FIRST TIME FLAG
	TDNE A,FLAGWD(BB)	;IS IT?
	SKIPG (CC)		;OR BUFFERS ALREADY SET UP
	  SKIPA			;YES, GO SET UP SIZE ETC.
	  JRST INN2		;NO
	IORB A,FLAGWD(BB)	;YES, BUT NOT NEXT TIME ...
	MOVSI A,IOPENF
	MOVSI B,INBUFF
	MOVEI C,2		;TWO BUFFERS
	XCTUM <HRRZ D,0(CC)>	;GET RH ONLY
	SKIPN D			;BUFFERS SET UP ALREADY?
	PUSHJ P,IOBUF		;NO SET UP A TWO BUFFER RING
	SKIPGE A,(CC)		;DON'T ADVANCE BUFFER THE FIRST 
	JRST INN2B
INN2:	MOVSI A,400000		;CLEAR USE BIT OF CURRENT BUFFER
	ANDCAB A,@(CC)		;ALSO GET POINTER TO NEXT BUFFER
INN2B:	HRRZM A,(CC)	
	TRZ PF,R.DIRN		;MARK THAT INPUT IS BEING DONE
	PUSHJ P,INIBUF		;ZERO BUFFER AND SET UP PTR AND COUNT
	HRRZ A,JFNTAB(BB)
	PUSHJ P,@INDSPT(AA)	;SETUP SHOULD SET UP AA WITH DEVICE NUMBER
	PUSHJ P,SETIBF		;COMPUTE COUNT AND SET UP NEW PTR
	MOVE B,0(CC)		;CURRENT BUFFER ADDRESS
	HRRZ A,FLAGWD(BB)	;FILE STATUS
	UMOVEM A,-1(B)		;STORE STATUS AT BEGINNING OF BUFFER
	POPJ P,

INDSPT:	INDSK			;DSK
	ITRAP			;DRM
	INMTA			;MTA
	INDTA			;DTA
	INBYT			;PTR
	ITRAP			;PTP
	ITRAP			;DSP
	ITRAP			;LPT
	INCDR			;CDR
	INBYT			;FE
	INTTY			;TTY
	INPTY			;PTY
	INTTY			;TTR
	INBYT			;NUL
	INBYT			;NET
	ITRAP			;PLT
	INBYT			;DLX
	ITRAP			;CDP
	INBYT			;DCN
	INBYT			;SRV

NINDSP==.-INDSPT

IF2 <IFN <NINDSP-MAXDEV>,<PRINTX INPUT DISPATCH TABLE "INDSPT" NEEDS FIXING>>

INDMP:	CAIN AA,DTA		;IS THIS A DTA
	  PUSHJ P,DTAINI	;YES, CLOSE ANY OPEN JFNS FOR THIS DTA
	HRRZ A,JFNTAB(BB)	;JFN
	CAIN AA,DSK		;DEVICE DISK?
	JRST INDM2		;YES- SIMULATE DUMPI BY SIN
	HRRZ B,FORTY		;NO- USE DUMPI
	CAIGE B,20		;IN THE AC'S?
	ADDI B,ACS		;YES. POINT TO THEM
	TRZ PF,R.DIRN		;DIRECTION IS INPUT (FOR MTA)
	MOVE C,DEVTBL(AA)	;IS IT A MAGTAPE?
	TLNE C,MTADEV		; ..
	JRST MTALP1		;YES. TREAT SEPARATELY
INDM1:	DUMPI
	  JRST INDMER		;ERROR. SEE IF FIXABLE.
INDM3:	POPJ P,
INDM2:	HRRZ D,FORTY		;COMMAND LIST POINTER
INCML:	CAIGE D,20		;IN THE ACS?
	ADDI D,ACS		;YES. POINT TO STORED ACS
	MOVE C,(D)		;COMMAND LOOP
	JUMPE C,INDM3		;DONE ON ZERO COMMAND
	TLNE C,-1		;ZERO LEFT HALF MEANS GOTO
	JRST INDM4
	MOVE D,C
	JRST INCML		;GET NEW COMMAND

INDM4:	MOVE B,FLAGWD(BB)	;IS THIS A UFD WE ARE READING
	TLNE B,RDUFDF
	  JRST INDUFD		;YES, GO DO GNJFN'S
	TRZ PF,R.DIRN		;MARK THAT WE ARE DOING INPUT
	HRRZM C,IOBPT		;SET UP IO POINTER
	HLROS C			;GET WORD COUNT
	MOVNM C,IOCNT		;STORE AS POSITIVE COUNT OF WORDS TO TRANSFER
	PUSH P,D		;SAVE COUNTER
	PUSHJ P,MOVBUF		;GO TRANSFER THE BUFFER
	 JRST [	POP P,D		;RESTORE STACK
		JRST INDM4B]	;EOF
	POP P,D			;RESTORE COUNTER
	MOVE B,IOBYTP(BB)	;GET FINAL BYTE POINTER
	TRZE B,177		;MAKE SURE IT ENDED ON A 200 WORD BOUNDRY
	 JRST [	ADDI B,200	;IT DIDNT, SO MAKE IT BE ON A BLK BOUND
		IFN FTFILSER,<
		HLRZ A,DEVNAM(BB)
		CAIN A,'DPA'	;CHECK FOR TOPS-10 PACK
		JRST .+1	;IF YES, DO NOT DO THE SFPTR
		>
		HRRZ A,JFNTAB(BB)
		SFPTR		;SET NEW POINTER
		 PUSHJ P,ERROR
		JRST .+1]
	MOVEM B,IOBYTP(BB)	;STORE NEW BYTE POINTER
	SKIPG B,IOCNT		;WAS THIS TRANSFER COMPLETED
	AOJA D,INCML		;YES, GO GET THE NEXT COMMAND TO DO
	AOS IOBPT
	SETZM @IOBPT		;NO, ZERO THE REST OF THE BUFFER AREA
	SOJG B,.-2
	AOJA D,INCML		;GO SEE IF THROUGH

INDM4B:	MOVEI A,1B22		;YES. REALLY EOF.
	IORM A,FLAGWD(BB)	;SET 10/50 EOF BIT
	JRST INDM3		;DONE.
;SET BUFFER FOR USER AFTER INPUT

SETIBF:	MOVE B,IOCNT		;BYTES NOT XFERRED LAST TIME
	LDB C,[POINT 6,IOBPT,11] ;BYTE SIZE OF XFER
	XCTLB <LDB D,[POINT 6,1(CC),11]> ;USER'S BYTE SIZE
	CAIN C,0(D)		;SAME?
	JRST SETIB1		;YES
	CAIG C,0(D)		;XFER SIZE BIGGER?
	JRST SETIB2		;NO
	SKIPE D			;IF 0 DONT DO DIVIDE
	IDIVI C,0(D)		;XFER SIZE BIGGER, GET RATIO
	IMUL B,C		;NUMBER USER-SIZE BYTES NOT XFER'D
SETIB1:	MOVN C,B		;B NOW HAS NUMBER NOT XFERRED
	XCTUU <ADDB C,2(CC)>	;ACTUAL BYTES XFERRED TO USER
	MOVE B,C		;BYTES
	MOVEI C,^D36		;BITS PER WORD
	XCTLB <LDB D,[POINT 6,1(CC),11]>	;USER'S BITS PER BYTE 
	SKIPE D			;IF 0 DONT DIVIDE
	IDIVI C,(D)		;BYTES PER WORD
	IDIVI B,(C)		;WORDS
	SKIPE C			;AND FRACTION THEREOF
	ADDI B,1
	MOVE C,0(CC)		;CURRENT BUFFER ADDRESS
	TRNE PF,R.NOWC		;SHOULD THE WORD COUNT BE STORED?
	  JRST SETIB3		;NO, SO DONT STORE IT
	XCTMU <HRRM B,1(C)>	;STORE THE WORD COUNT WITH BUFFER
SETIB3:	MOVSI A,HASDIR+MTADEV	;SEE IF 36-BIT DEVICE
	TDNE A,DEVTBL(AA)	;IF NOT, THEN BUFFER WAS ALREADY ZEROED
	SKIPN IOCNT		;DID BUFFER GET COMPLETELY FILLED
	  JRST SETIB4		;YES, JUST RETURN
	XCTUM <HLRZ C,0(C)>	;GET SIZE OF BUFFER PLUS ONE
	ANDI C,377777		;CLEAR USE BIT
	SUBI C,1(B)		;GET REMAINING WORDS IN BUFFER
	AOS B,IOBPT		;GET POINTER TO NEXT WORD IN BUFFER
	HRLS B			;SET UP SOURCE WORD FOR BLT
	SETZM 0(B)		;ZERO THE FIRST WORD
	ADDI C,-1(B)		;GET POINTER TO END OF BUFFER
	HRRI B,1(B)		;GET DESTINATION
	CAIL C,0(B)		;BLOCK OF MORE THAN ONE WORD IN LENGTH?
	  BLT B,0(C)		;YES, ZERO BLOCK
SETIB4:	MOVSI A,400000		;BUFFER USE BIT (BF.IOU)
	XCTUU <IORM A,@(CC)>	;SET IN BUFFER HEADER
	POPJ P,			;RETURN

SETIB2:	IDIVI D,0(C)		;BUT OTHERWISE, THIS FIXES UP
	IDIV B,D		;BYTE COUNT
	JRST SETIB1
;ROUTINE TO INPUT FROM DSK VIA PMAP SINCE SIN IS SLOWER.

INDSK:	MOVE B,FLAGWD(BB)	;GET FLAGS FOR THIS CHANNEL
	TLNE B,RDUFDF		;ARE WE READING A UFD
	JRST INUFD		;YES, GO SIMULATE IT
	TRZ PF,R.DIRN		;MARK THAT WE ARE DOING INPUT
	MOVEI A,200		;ALWAYS DO 200 WORDS FOR DISK
	EXCH A,IOCNT
	PUSH P,A		;SAVE ORIGINAL COUNT FOR LATER
	PUSHJ P,MOVBUF		;GO MOVE A BUFFER
	  JRST [POP P,A		;EOF WAS SEEN
		JRST INTY8A]
	POP P,A			;GET ORIGINAL IOCNT
	MOVE B,IOCNT		;GET NEW IOCNT
	ADDI A,-200(B)		;GET IOCNT REFLECTING # OF WORDS RECEIVED
	HRRZM A,IOCNT		;STORE FOR CLEAN UP ROUTINE
	JRST INTTY9		;OK RETURN

INDON1:	AOS IOCNT
	JRST INTTY9

INTTY8:	PUSHJ P,CRLF		;TYPE CRLF ECHO
INTY8A:	MOVEI A,1B22		;EOF FLAG IN STATUS WORD
	IORM A,FLAGWD(BB)
INTTY9:	MOVSI A,400000	;BUFFER USE FLAG
	XCTUU <IORM A,@(CC)>
	LDB A,[POINT 6,IOBPT,11] ; GET BYTE SIZE
	CAIE A,7		;WAS THIS AN ASCII TRANSFER
	  JRST INTTY7		;NO, DONT CLEAR REST OF WORD
	MOVE A,IOCNT
	IDIVI A,5		;DOES IT END ON WORD BOUNDARY?
	JUMPE B,INTTY7		;YES, ALL DONE.
	MOVE A,B
	SETZ B,

FILWD:	XCTLB <IDPB B,IOBPT>	;FILL REST OF LAST WORD WITH ZEROES
	SOS IOCNT
	SOJG A,FILWD

INTTY7:	POPJ P,

CRLF:	PUSH P,A		;TYPE OUT A CRLF
	HRROI A,[ASCIZ/
/]
CPSOUT:	PSOUT
	JRST APOPJ
OUTT:	PUSHJ P,SETUP
	MOVE B,FLAGWD(BB)
	TLNE B,OOPENF		;OPEN FOR OUTPUT?
	JRST OUTTN		;YES
	SKIPN JFNTAB(BB)	;DOES IT HAVE JFN?
	TLNN B,OUFIRF		;OR IS IT FIRST TIME THROUGH?
	TLNN B,INITF		;AND IS IT INIT'ED?
	PUSHJ P,ERRCHN		;NO- ERROR
	SKIPN JFNTAB(BB)	;DOES IT HAVE JFN?
	JRST OUTTN		;NO, DON'T OPEN IT YET
	CAIN AA,TTY		;IS THIS A TTY
	  JRST OUTTTO		;YES, OPEN IT FOR BOTH R+W
	MOVEI B,1B20
	PUSHJ P,OPENX		;OPEN FOR OUTPUT
	  JRST OUTMTF		;OPEN FAILURE, GO SEE IF IT WAS A MOUNT
	MOVSI A,OOPENF
OUTT0:	IORM A,FLAGWD(BB)	;AND MARK IT
REPEAT 0,<			;DONT DO THIS UNLESS PMAPING TO DISK
	PUSHJ P,SETDES		;GO SET NEW DEVICE DESIGNATOR WORD
>
	JRST OUTT

OUTTTO:	MOVEI B,1B19!1B20	;OPEN FOR BOTH READ AND WRITE
	PUSHJ P,OPENX
	  JRST OUTMTF
	MOVSI A,IOPENF!OOPENF
	JRST OUTT0

OUTMTF:	PUSHJ P,MNTFAI		;SEE IF USER WANTS TO TRAP THIS
	JFCL
	PUSHJ P,ILLOUT		;NO TYPE A MESSAGE AND BOMB
	JRST OUTT		;TRY AGAIN

OUTTN:	MOVEI A,17
	AND A,FLAGWD(BB)	;MODE
	CAIL A,15		;IS IT A BUFFERED MODE?
	JRST OUTDMP		;NO
	HLRZ CC,BUFHTB(BB)	;OUTPUT BUFFER HEADER POINTER
	JUMPE CC,CPOPJ		;IF NO BUFFER HEADER, IGNORE CLOSE
	HRRZ A,FORTY
	CAIE A,0		;NEW RING?
	  JRST [HRRM A,0(CC)	;YES, STORE ADDRESS
		MOVSI A,400000	;CLEAR IOUSE BIT
		ANDCAM A,0(CC)
		JRST .+1]
	MOVSI A,OUFIRF		;FIRST TIME THROUGH FLAG
	TDNE A,FLAGWD(BB)	;IS IT?
	SKIPGE 0(CC)		;OR BUFFER NOT SETUP?
	SKIPA			;YES, DO DUMMY OUTPUT
	JRST OUTT2		;NO
	IORM A,FLAGWD(BB)	;YES
	MOVEI C,2
	MOVSI B,OUTBFF		;OUTBUF DONE FLAG
	XCTUU <SKIPN 0(CC)>	;OUTPUT BUFFERS SETUP?
	PUSHJ P,IOBUF		;NOT YET
	XCTUU <SKIPGE A,(CC)>	;HAS USER SET UP HIS OWN BUFFERS?
	JRST OUTT9		;NO, GO FIX UP FIRST BUFFER FOR HIM

OUTT2:	PUSHJ P,SETOBF
	HRRZ A,JFNTAB(BB)	;GET DESTINATION
	SKIPN IOCNT		;ALWAYS OUTPUT IF NON-ZERO
	TRNN PF,R.CLS		;IF ZERO, DON'T OUTPUT IF CLOSE
	PUSHJ P,@OUTLST(AA)
	MOVE B,0(CC)		;CURRENT BUFFER ADDRESS
	HRRZ A,FLAGWD(BB)	;FILE STATUS
	MOVEM A,-1(B)		;STORE LATTER IN BEGINNING OF FORMER
	XCTUU <MOVE A,@(CC)>	;ADVANCE THE BUFFER
OUTT9:	XCTUU <HRRZM A,(CC)>
	TRO PF,R.DIRN		;MARK THAT OUTPUT IS BEING DONE
	PUSHJ P,INIBUF
	POPJ P,
OUTLST:	EXP OUTDSK		;DSK
	EXP ITRAP		;DRM
	EXP OUTMTA		;MTA
	EXP OUTDTA		;DTA
	EXP ITRAP		;PTR
	EXP OUTBYT		;PTP
	EXP ITRAP		;DSP
	EXP OUTBYT		;LPT
	EXP ITRAP		;CDR
	EXP OUTBYT		;FE
	EXP OUTTTY		;TTY
	EXP OUTPTY		;PTY
	EXP ITRAP		;TTR
	EXP OUTBYT		;NUL
	EXP OUTBYT		;NET
	EXP OUTBYT		;PLT
	EXP OUTBYT		;DLX
	EXP OUTBYT		;CDP
	EXP OUTBYT		;DCN
	EXP OUTBYT		;SRV

NOUTDS==.-OUTLST

IF2 <IFN <MAXDEV-NOUTDS>,<PRINTX DISPATCH TABLE "OUTLST" NEEDS FIXING>>

OUTDMP:	MOVSI A,OUFIRF		;MARK THAT OUTPUT WAS DONE
	IORM A,FLAGWD(BB)	;SO CLOSE KNOWS
	CAIN AA,DTA		;DTA?
	  PUSHJ P,DTAINI	;YES, CLOSE ANY OPEN JFNS FOR THIS DTA
	HRRZ A,JFNTAB(BB)	;JFN
	CAIN AA,DSK		;DISK DEVICE TYPE?
	JRST OUTDM2		;YES- SIMULATE DUMPO BY SOUT
	HRRZ B,FORTY		;NO- USE DUMPO
	CAIGE B,20		;POINTER IN AC'S?
	ADDI B,ACS		;YES. POINT TO STORED ACS
	TRO PF,R.DIRN		;DIRECTION IS OUTPUT.
	MOVE C,DEVTBL(AA)
	TLNE C,MTADEV		;MAG TAPE?
	JRST MTALP1		;YES. GO TO MAG TAPE HANDLER
OUTDM1:	DUMPO
	  JRST OUDMER		;LOST. SEE IF RECOVERABLE
OUTDM3:	POPJ P,
OUTDM2:	HRRZ D,FORTY		;COMMAND LIST POINTER
OUTCML:	CAIGE D,20		;IN THE ACS?
	ADDI D,ACS		;YES. POINT TO STORED ACS
	MOVE C,(D)		;COMMAND LOOP
	JUMPE C,OUTDM3		;DONE ON ZERO COMMAND
	TLNE C,-1		;ZERO LEFT HALF MEANS GOTO
	JRST OUTDM4		;NO,REAL IO WORD
	MOVE D,C
	JRST OUTCML

OUTDM4:	TRO PF,R.DIRN		;MARK THAT OUTPUT IS IN PROGRESS
	HRRZM C,IOBPT		;STORE POINTER TO BUFFER IN USER AREA
	HLROS C			;GET NEG WORD COUNT
	MOVNM C,IOCNT		;STORE AS POSITIVE IOCNT
	HRRZ A,JFNTAB(BB)	;GET JFN IN CASE AN SFPTR IS DONE
	MOVE B,IOBYTP(BB)	;GET CURRENT POSITION TO START WRITING
	CAMLE B,IOEOFP(BB)	;NEED TO UPDATE FILE POINTER TO NEXT BLK
	  SFPTR			;YES, ALWAYS START ON A BLOCK BOUNDRY
	  JFCL
	PUSH P,D		;SAVE THE COUNTER
	PUSHJ P,MOVBUF		;MOVE THE BUFFER
	  JFCL			;SHOULD NEVER GET HERE
	POP P,D			;RESTORE COUNTER
	MOVE B,IOBYTP(BB)	;SEE IF TRANSFER ENDED ON A BLOCK BOUNDRY
	ANDI B,177
	JUMPE B,OUDM4D		;IF 0, THEN DONT FILL WITH ZEROS
	HRROI C,-200(B)		;GET NEG # OF ZEROS TO BE WRITTEN
	HRRZ A,JFNTAB(BB)	;GET JFN OF FILE
	MOVE B,IOBYTP(BB)	;FIRST, GET THE BYTE POINTER SET UP
	SFPTR
	 ERCAL ERROR
	MOVSI B,(POINT 0,0,0)	;GET POINTER TO A SOURCE OF ZEROS
	SOUT			;FILL WITH ZEROS

REPEAT 0,<			;PMAP METHOD OF DISK TRANSFERS
	MOVEI A,IOMPGS(AC)	;GET CURRENT POINTER INTO OUTPUT PAGE
	LSH A,11
	MOVE B,IOBYTP(BB)
	ANDI B,777
	ADDB B,A		;GET START OF FREE AREA IN OUTPUT BUF
	TRON A,177		;GET END OF 200 WORD BLOCK
	  JRST OUDM4D		;BLOCK ENDED ON A 200 WORD BOUNDRY
	HRLS B			;GET BLT WORD
	HRRI B,1(B)		;TO ZERO REST OF OUTPUT BLOCK
	SETZM -1(B)		;CLEAR FIRST WORD
	CAIL A,0(B)		;ANY MORE TO DO
	  BLT B,0(A)		;YES, BLT ZEROS THROUGH AREA
>

OUDM4D:	PUSHJ P,FIXEOF		;GO FIX UP THE EOF IF IT NEEDS IT
	MOVE C,IOBYTP(BB)	;GET THE BYTE POINTER AGAIN
	TRZN C,177		;WAS THIS AN EVEN BLOCK TRANSFER?
	AOJA D,OUTCML		;YES, GO DO NEXT COMMAND
	ADDI C,200		;NO, MAKE IT AN EVEN 200
	MOVEM C,IOBYTP(BB)
	AOJA D,OUTCML		;GO DO NEXT COMMAND

IFN SAMFRK,<
OUTBYT:	MOVE 2,IOBPT
	MOVN 3,IOCNT
	JUMPGE 3,CPOPJ		;IT'S POSSIBLE THERE'S NOTHING TO DO
	SOUT
	MOVEM 2,IOBPT
	SETZM IOCNT
	POPJ P,
>

OUTDSK:	MOVE A,IOBYTP(BB)	;GET NEW END OF DATA
	ADD A,IOCNT		;FOR EOF CALCULATION
	PUSH P,A		;SAVE FOR AFTER TRANSFER
IFN FTFILSER,<
	HLRZ B,DEVNAM(BB)	;THIS GOING TO A TOPS-10 PACK?
	CAIN B,'DPA'		;IF YES, THEN LEAVE COUNT ALONE
	  JRST OUTDS1		;YES, LEAVE ACTUAL COUNT FOR FILSER
>
	MOVEI A,200		;ALWAYS TRANSFER 200 WORDS FOR DISK
	MOVEM A,IOCNT		;...
OUTDS1:	TRO PF,R.DIRN		;OUTPUT IN PROGRESS
	PUSHJ P,MOVBUF		;SEND OUT THE BUFFER
	  JFCL
	POP P,A			;GET POSSIBLE NEW EOF POSITION
	CAMLE A,IOEOFP(BB)	;IS THERE A NEW EOF
	 PUSHJ P,UPDEOF		;YES, UPDATE THE EOF
	POPJ P,


;ROUTINE TO UPDATE THE EOF FOR A CHANNEL

FIXEOF:	MOVE A,IOBYTP(BB)	;GET THE NEW BYTE POINTER
	CAMG A,IOEOFP(BB)	;SEE IF EOF NEEDS UPDATING
	POPJ P,			;NO, JUST RETURN
UPDEOF:	MOVEM A,IOEOFP(BB)	;STORE THE NEW EOF
	MOVE A,FLAGWD(BB)	;SEE IF THIS FILE IS A NEW FILE
	TLNN A,IOPENF!LOOKPF	;IF FILE WAS LOOKED UP, THEN DO THE SFPTR
	POPJ P,			;OTHERWISE, NO NEED TO SET EOF POINTER
	HRRZ A,JFNTAB(BB)	;GET THE JFN
	MOVE B,IOEOFP(BB)	;GET THE NEW EOF POINTER
	SFPTR			;SET THE NEW POSITION
	 ERCAL ERROR
	POPJ P,			;RETURN
;MOVE A BUFFER TO OR FROM THE FILE
;PRESERVE AC D ALWAYS

MOVBUF:
IFN FTFILSER,<
	HLRZ A,DEVNAM(BB)	;IS THIS A DPA?
	CAIN A,'DPA'		;...
	  JRST TMOVB		;YES, GO DO UUO INSTEAD
>
	PUSHJ P,MAPINP		;GO TRY TO MAP IN THE PAGE
	SKIPE MAPTAB(BB)	;IS THERE A MAPPED AREA?
	JRST MOVBFP		;YES, GO BLT DATA FROM THERE
	TRNE PF,R.DIRN		;IN OR OUT?
	  SKIPA A,[SOUT]	;OUT
	MOVE A,[SIN]		;IN
	PUSH P,A		;SAVE JSYS TO BE EXECUTED
	MOVE C,IOEOFP(BB)	;(314)GET EOF
	SUB C,IOBYTP(BB)	;(314)GET # OF WORDS LEFT IN FILE
	TRNN PF,R.DIRN		;(314)ONLY CARE IF INPUT
	CAML C,IOCNT		;(314) NOT ENOUGH WORDS TO SATISFY REQUEST?
	  MOVE C,IOCNT		;(314)OK TO USE FULL COUNT
	JUMPLE C,APOPJ		;(314)NO MORE WORDS EOF RETURN TAKEN
	MOVNS C			;(314)C= NEG NUMBER OF WORDS TO TRANSFER
	MOVE B,IOBPT		;AND POINTER TO USER AREA
	HRLI B,(POINT 36,0,35)	;MAKE SURE IT IS A LEGAL BYTE POINTER
	PUSH P,C		;SAVE COUNT
	MOVN A,C		;GET ADDRESS OF WORD BEYOND BUFFER
	ADDI A,1(B)		;SIN ZERO'S 1 WORD AFTER BUFFER
	PUSH P,0(A)		;SAVE WORD
	PUSH P,A		;AND ITS ADDRESS
	HRRZ A,JFNTAB(BB)	;GET JFN
	XCT -3(P)		;DO THE TRANSFER
	POP P,A			;GET BACK ADR OF WORD AFTER BUFFER
	POP P,0(A)		;RESTORE WORD AFTER BUFFER
	POP P,A			;GET BACK ORIGINAL COUNT
	POP P,(P)		;CLEAN UP STACK
	SUB C,A			;CALCULATE # OF WORDS TRANSFERED
	JUMPE C,CPOPJ		;IF NONE TRANSFREED, EOF
	ADDM C,IOBYTP(BB)	;UPDATE FILE POINTER
	SUB C,IOCNT		;UPDATE IOCNT
	MOVNM C,IOCNT		;THOSE WORDS NOT TRANSFERED
	MOVEM B,IOBPT		;AND UPDATED POINTER
	JRST CPOPJ1		;EXIT SUCCESSFULLY

MOVBFP:	MOVE B,IOBYTP(BB)	;GET CURRENT POINTER
	ANDI B,777		;GET WORD WITHIN PAGE
	SUBI B,1000		;GET NEG # OF WORDS LEFT IN PAGE
	MOVE C,IOEOFP(BB)	;GET EOF
	SUB C,IOBYTP(BB)	;GET # OF WORDS LEFT IN FILE
	TRNN PF,R.DIRN		;ONLY CARE IF INPUT
	CAML C,IOCNT		;IS THERE NOT ENOUGH WORDS TO SATISFY REQUEST
	  MOVE C,IOCNT		;OK TO USE FULL COUNT
	CAMGE C,IOCNT		;NEAR THE END OF FILE?
	JRST [	PUSH P,B	;SAVE ACS
		PUSH P,C
		PUSHJ P,GETEOF	;YES, SEE IF THE EOF CHANGED
		POP P,C
		POP P,B
		CAMG A,IOEOFP(BB)
		JRST .+1	;EOF DID NOT CHANGE
		MOVEM A,IOEOFP(BB) ;STORE NEW EOF
		JRST MOVBFP]	;GO TRY AGAIN WITH NEW EOF
	JUMPLE C,CPOPJ		;NO MORE WORDS, EOF RETURN TAKEN
	MOVNS C			;C = NEG # OF WORDS TO TRANSFER
	CAMLE B,C		;ENOUGH WORDS IN PAGE?
	  JRST MOVB1		;NO, DO THIS IN CHUNKS
MOVB2:	MOVE A,IOBYTP(BB)	;GET POSITION WITHIN OF FILE
	IDIVI A,NPLPGS*1000	;GET POSITION WITHIN MAPPED AREA INTO B
	HRRZ A,MAPTAB(BB)	;GET THE START OF THE MAPPED AREA
	LSH A,11		;MAKE IT AN ADDRESS
	ADDI A,(B)		;THIS IS DESTINATION ADDRESS
	HRL A,IOBPT		;NOW GET ADDRESS OF USER BUFFER
	ADD A,[XWD 1,0]
	TRNN PF,R.DIRN		;DOING OUTPUT?
	  MOVSS A		;YES, REVERSE THE DIRECTION OF A
	ADDM C,IOCNT		;COUNT DOWN IOCNT
	MOVN B,C		;GET POS WORD COUNT
	ADDM B,IOBPT		;UPDATE IOBPT
	ADDM B,IOBYTP(BB)	;AND FILE POINTER
	ADDI B,(A)		;GET END OF TRANSFER ADDRESS
MOVINS:	BLT A,-1(B)		;TRANSFER THE DATA
	ERJMP MOVBE		;IF FAILED, GO SEE IF SPARSE FILE
MOVINE:	JRST CPOPJ1

MOVB1:	MOVE C,B		;DO ONLY WHAT IS LEFT IN THIS PAGE
	PUSHJ P,MOVB2
	  JFCL
	JRST MOVBUF		;LOOP BACK FOR REST


MOVBE:	PUSH P,A		;SAVE THE ACS
	PUSH P,B
	TRNE PF,R.DIRN		;DOING AN INPUT?
	JRST MOVBE1		;NO, GO TRY AGAIN
	MOVEI A,.FHSLF		;GET LAST ERROR
	GETER
	HRRZS B			;ONLY WANT THE ERROR CODE
	CAIE B,ILLX01		;ILLEGAL READ?
	JRST MOVBE1		;NO, GO DO BLT AGAIN ONLY LET IT TRAP
	POP P,B			;RESTORE ARGUMENTS
	POP P,A			;GIVE THE USER PROGRAM ZEROES
	SETZM (A)		;ZERO FIRST WORD OF BUFFER
	HRLS A			;SET UP BLT POINTER TO PROPAGATE ZERO
	HRRI A,1(A)		;SET UP DESTINATION ADR
	CAILE B,(A)		;ENOUGH ROOM FOR BLT?
	BLT A,-1(B)		;YES, GIVE REST OF ZEROES TO USER
	JRST CPOPJ1		;RETURN

MOVBE1:	POP P,B			;THIS IS AN UNKNOWN ERROR
	POP P,A			;SO DO THE BLT AGAIN
	BLT A,-1(B)		;BUT LET THE ERROR CAUSE A TRAP
	JRST CPOPJ1		;SO QOUTA AND DATA ERRORS WORK RIGHT
;ROUTINE TO MAP IN THE NEXT 4 PAGES OF A FILE

MAPINP:	SKIPN MAPTAB(BB)	;IS THERE A MAPPED AREA?
	JRST MAPIN0		;NO, GO TRY TO SET ONE UP
	MOVE A,IOBYTP(BB)	;NOW SEE IF WE ARE ON A BOUNDRY
	IDIVI A,NPLPGS*1000
	IMULI A,NPLPGS		;GET FIRST PAGE OF THE SECTION
	HLRZ B,MAPTAB(BB)	;GET FIRST MAPPED PAGE OF FILE
	CAMN A,B		;HAVE THE RIGHT AREA MAPPED
	POPJ P,			;YES, NO NEED TO GO FURTHER
MAPIN0:	SKIPN MAPTAB(BB)	;IS THERE A MAP SLOT YET
	JRST [	PUSHJ P,GETIOP	;NO, GO GET ONE
		 JRST MAPIN1	;NONE LEFT
		MOVEM A,MAPTAB(BB)
		JRST .+1]
	MOVE A,IOBYTP(BB)	;GET PAGE OF FILE TO PRELOAD
	IDIVI A,NPLPGS*1000	;GET ADDRESS OF FIRST PAGE TO MAP
	IMULI A,NPLPGS*1000
	LSH A,-11		;GET PAGE NUMBER OF FIRST MAPPED PAGE
	HRLM A,MAPTAB(BB)	;SAVE PAGE # OF MAPPED FILE PAGE
	HRL A,JFNTAB(BB)	;SET UP FOR PMAP
	HRLI B,.FHSLF		;MAP INTO THIS FORK
	HRR B,MAPTAB(BB)	;GET PAGE NUMBER TO MAP INTO
	MOVE C,[PM%CNT!PM%RD+NPLPGS]
	MOVE D,FLAGWD(BB)	;SEE IF PRELOADING IS TO BE DONE
	TLNN D,RNDMF		;DOING RANDOM ACCESS?
	TRNE PF,R.DIRN		;NO, INPUT?
	SKIPA			;NO, DO NOT PRELOAD ANY PAGES
	TXO C,PM%PLD		;YES, THEN PRELOAD THE PAGES
	TLNE D,OOPENF		;OPENED FOR WRITE?
	TXO C,PM%WR		;YES, TURN ON WRITE BIT
	PMAP			;PREFAULT THE PAGES
	 ERJMP MAPIN1		;IF FAILED, GO USE SIN
	POPJ P,			;AND RETURN

MAPIN1:	SKIPN MAPTAB(BB)	;IS THERE A MAPPED AREA
	POPJ P,			;NO, DO NOT NEED TO DO ANYTHING
	PUSHJ P,UNMAPP		;YES, UNMAP THE PAGES
	HRRZ A,JFNTAB(BB)
	MOVE B,IOBYTP(BB)
	SFPTR			;SET THE BYTE POINTER UP CORRECTLY
	 ERJMP MAPIN2		;PROBLEM - INVESTIGATE...
	POPJ P,			;NOW GO USE SEQUENTIAL IO
MAPIN2:	CAIE A,DESX8		;FILE NOT ON DISK?
	PUSHJ P,ERROR		;NO, SOME OTHER ERROR
	POPJ P,			;NO FILE! JUST RETURN

GETIOP:	TLNN PF,L.SMAL		;SMALL SYSTEM?
	JRST GETIO0		;NO, ALWAYS PREFAULT IF POSSIBLE
	MOVE A,MAPTOT		;HOW MANY FILES ARE OPEN ALREADY?
	CAIL A,5		;REACHED ARBITRARY LIMIT YET?
	POPJ P,			;YES, DO NOT PREFAULT ANY MORE
GETIO0:	MOVE A,MAPLST		;FIND A FREE MAP SLOT
	JFFO A,GETIO1		;IF ANY
	POPJ P,			;NONE LEFT
GETIO1:	MOVSI A,400000		;NOW SET UP A MASK
	MOVN C,B
	LSH A,0(C)
	ANDCAM A,MAPLST		;MARK THIS SLOT IN USE
	AOS MAPTOT		;COUNT UP THE NUMBER OF SLOTS IN USE
	IMULI B,NPLPGS		;CALCULATE THE PAGE # OF THE SLOT
	ADDI B,IOMPGS
	MOVE A,B		;RETURN THE ANSWER IN A
	JRST CPOPJ1		;SKIP RETURN WHEN SUCCESSFUL
;PREPARE FULL BUFFER FOR EMPTYING

SETOBF:	MOVEI B,17
	AND B,FLAGWD(BB)	;MODE
	XCTUU <HLLZ C,1(CC)>	;GET BYTE SIZE BITS
	XCTUU <HRRZ D,1(CC)>	;FETCH RH OF BYTE POINTER
	UMOVE E,(CC)
	SUBI D,1(E)		;PTR TO ZERO'TH WORD OF DATA
	MOVEI A,1B31
	TDNE A,FLAGWD(BB)	;USER WANTS TO SPECIFY OWN COUNT?
	  JRST [UMOVE D,1(E)	;YES, GET COUNT
		JRST .+1]
	MOVEI F,0(D)		;SAVE UN-MULTIPLIED COUNT
	LDB A,[POINT 6,C,11]	;BYTE SIZE
	PUSH P,B		;SAVE B OVER DIVIDE
	PUSH P,A		;PUSH SIZE
	MOVEI A,44		;WORD LENGTH
	SKIPE 0(P)		;IN CASE CLOBBERED
	IDIV A,0(P)		;BYTES PER WORD
	POP P,B			;DISCARD BYTE SIZE
	POP P,B			;RESTORE B
	IMULI D,0(A)		;BYTE COUNT IN THOSE WORDS
	MOVEI C,1(E)		;CONSTRUCT BYTE POINTER FOR XFER
	MOVSI E,HASDIR+MTADEV	;USUAL CHECK FOR WORD TRANSFERS
	HRLI C,0700		;TRANSFER 7-BIT UNLESS
	CAIGE B,10		;MODE IS BINARY, OR
	TDNE E,DEVTBL(AA)	;DEVICE HAS DIRECTORY OR IS MAGTAPE
	HRLI C,4400		;IN WHICH CASE TRANSFER 36-BIT
	MOVEM C,IOBPT
	TLNE C,4000		;IF 36-BIT XFER,
	MOVE D,F		;USE UN-MULTIPLIED COUNT
	MOVEM D,IOCNT		;LEAVE COUNT FOR XFER ROUTINE
	LDB C,[POINT 6,IOBPT,11] ;GET BYTE COUNT FROM IOBPT
	XCTLB <LDB B,[POINT 6,1(CC),11]> ;GET USER'S BYTE COUNT
	CAMG B,C		;IS IOCNT WRONG
	  POPJ P,		;NO, RETURN
	IDIVI B,(C)		;YES, CORRECT IT
	IMULI D,(B)		;GET # OF BYTES PER WORD
	MOVEM D,IOCNT		;STORE CORRECT VALUE
	POPJ P,

SETDES:	MOVSI A,'TTY'		;SET NEW DEVICE DESIGNATOR WORD
	CAMN A,DEVNAM(BB)	;UNLESS IT IS THE TTY
	  POPJ P,		;TTY, JUST RETURN
	HRRZ A,JFNTAB(BB)	;GET JFN
	DVCHR			;GET NEW DEVICE CHARACTERISTICS WORD
	MOVEM A,DEVNUM(BB)	;SAVE NEW DEVICE TYPE IN CASE SPOOLED DEV
	POPJ P,
;PREPARE EMPTY BUFFER

INIBUF:	MOVEI D,17
	AND D,FLAGWD(BB)	;MODE
	MOVSI E,HASDIR+MTADEV	;SEE IF 36-BIT XFER POSSIBLE
	HRRZ B,A		;CHECK IF A POINTS TO ACS
	CAIGE B,20		;THIS WOULD BE ILLEGAL
	  PUSHJ P,ITRAP		;DONT ALLOW THIS, BLT WILL KILL PAT AC'S
	XCTUU <SETZM 1(A)>	;ZERO THE BUFFER
	MOVSI B,1(A)
	HRRI B,2(A)
	HLRZ C,(A)		;SIZE OF DATA AREA+1.
	ANDI C,377777		;CLEAR RING USE BIT
	CAIG C,1		;SHOULD BE NONZERO BUFFER SIZE
	PUSHJ P,ERRARG
	SUBI C,1
	PUSH P,C		;SAVE FOR LATER USE
	ADDI C,1(A)
	CAIGE D,10		;BINARY MODE?
	TDNE E,DEVTBL(AA)	;36-BIT DEVICE?
	  TRNE PF,R.DIRN	;YES, IS THIS INPUT?
	SKIPA			;NO, CLEAR BUFFER
	  JRST INIB1		;DONT HAVE TO CLEAR INPUT BUFFER FOR 36 BIT TRANSFER
	XCTUU <BLT B,(C)>
INIB1:	XCTUU <HLLZ B,1(CC)>	;GET SIZE BITS
	TLZ B,770077
	HRRI B,1(A)
	UMOVEM B,1(CC)		;INITIALIZE BYTE POINTER
	LDB C,[POINT 6,B,11]	;BYTE SIZE
	MOVEI A,44		;WORD SIZE
	PUSH P,B		;SAVE B OVER DIVIDE
	SKIPE C			;IN CASE OF JUNK IN HEADER
	IDIVI A,0(C)		;BYTES PER WORD
	POP P,B			;RESTORE B
	IMUL A,0(P)		;BYTES IN BUFFER
	UMOVEM A,2(CC)		;INIT BYTE COUNT
	CAIN AA,MTA		;MAGTAPE?
	JRST INIBMT		;YES, SPECIAL HANDLING
	POP P,A			;BUFFER LENGTH
	HRLI B,0700		;7-BIT UNLESS...
	CAIGE D,10		;BINARY MODE, OR
	TDNE E,DEVTBL(AA)	;DIRECTORY DEVICE OR MAGTAPE
	HRLI B,4400		;IN WHICH CASE 36-BIT
	CAIN AA,CDR		;IS THIS A CDR?
	JRST [	CAIE D,10	;YES, IS IT IN BINARY MODE
		JRST .+1	;NO
		HRLI B,1400	;YES, USE MODE 10
		MOVEM B,IOBPT	;STORE THE BYTE POINTER
		IMULI A,3	;GET THE NUMBER OF BYTES PER BUFFER
		JRST INIB2]	;GO STORE IT
	MOVEM B,IOBPT
	TLNN B,4000		;SMALL BYTES?
	IMULI A,5		;YES, 5 PER WORD
INIB2:	MOVEM A,IOCNT
	POPJ P,


INIBMT:	POP P,IOCNT		;SET WORD COUNT
	MOVEM B,IOBPT		;REMEMBER POINTER (WITHOUT BYTE SIZE)
	HRRZ A,JFNTAB(BB)	;GET READY
	RFBSZ			;READ CURRENT BYTE SIZE
	 MOVEI B,^D36		;FAILED, ASSUME WORDS
	DPB B,[POINT 6,IOBPT,11]	;FILL IN BYTE SIZE
	MOVEI A,^D36		;HOW MANY BITS IN A WORD
	IDIV A,B		;COMPUTE HOW MANY BYTES IN A WORD
	IMULM A,IOCNT		;CONVERT WORD COUNT TO BYTE COUNT
	POPJ P,			;DONE
URELEA:	PUSHJ P,SETUPG
	JRST MRETN		;NOTHING TO RELEASE

IFN FTFILSER,<
	HLRZ A,DEVNAM(BB)	;IS THIS A DPA?
	CAIN A,'DPA'
	  JRST TRELEA		;YES, DO A FILSER RELEASE
>
	PUSHJ P,URELR		;DO THE RELEASE
	JRST MRETN

URELR:	SKIPN DEVNAM(BB)
	POPJ P,
	LDB AA,PDVNUM		;GET DEVICE TYPE CODE
	SETZM IOCNT
	PUSHJ P,UCL1K		;CLOSE FILE, KEEPING JFN
URELJ:	SKIPG JFNTAB(BB)	;IS THERE A JFN
	  JRST UREL2		;NO, DONT RELEASE IT
	HRRZ A,JFNTAB(BB)
	CAIE A,PRIJFN		;REAL JFN?
	CAIN A,PROJFN		; ..
	JRST UREL3		;NO
	PUSHJ P,SAVUFD		;IF A UFD SAVE JFN
	RLJFN
	  JFCL			;MAY FAIL BECAUSE FILE MAPPED ON ANOTHER CHANNEL

UREL2:	HLLZS FLAGWD(BB)	;CLEAR INIT BITS.
	SETZM CHTABS(BB)
	MOVSI A,CHTABS(BB)
	HRRI A,CHTABS+1(BB)
	BLT A,CHTABS+NTABS-1(BB)
	POPJ P,

UREL3:	HLLZ E,TYSTAT		;GET JUST LEFT HALF OF STATUS
	PUSHJ P,TTPSTS		;GO SET UP NEW TTY STATUS
	JRST UREL2
;SOME DEVICE TYPE THINGS

DSKCHR:	HLRZ F,CAC		;GET LENGTH OF ARG BLOCK
	CAIG F,0		;IS IT NON-ZERO
	  MOVEI F,1		;ASSUME ONE WORD
IFN FTFILSER,<
	UMOVE A,0(CAC)		;GET DEVICE NAME
	PUSHJ P,DPACHK		;SEE IF IT IS A TOPS-10 PACK
	  SKIPA			;NO
	JRST TDOUUO		;YES, GO CALL FILSER
>
	UMOVE D,0(CAC)		;GET USER ARGUMENT
	PUSHJ P,CHKDSK		;SEE IF THIS IS A DSK
	  JRST MRETN		;NO, GIVE ERROR RETURN
	CAIGE F,2		;WANT ANY VALUES RETURNED?
	  JRST DSKCH3		;NO, JUST RETURN THE AC FLAGS
	HRROI A,DEVNM7		;GET POINTER TO STR
	PUSHJ P,PAGUSE		;GET PAGES IN USE
	PUSH P,A		;SAVE ANSWER
	HRROI A,DEVNM7		;GET POINTER TO STR AGAIN
	HRROI B,STRNG1		;BUILD STR: STRING
	SETZ C,
	SIN
	MOVEI C,":"		;TACK ON A COLON
	IDPB C,B
	MOVEI C,0		;FOLLWED BY A NULL
	IDPB C,B
	MOVX A,RC%EMO		;NOW GET A DIR #
	HRROI B,STRNG1
	RCDIR
	 ERJMP DSKCH1
	TXNE A,RC%NOM!RC%AMB	;FOUND ONE?
	JRST DSKCH1		;NO
	MOVE A,C		;GET DIR # IN A
	GTDAL			;GET QUOTA
	POP P,B			;GET PAGES LEFT
	SUB A,B			;CALCULATE PAGES LEFT IN QUOTA
	ASH A,2			;TURN PAGES INTO BLOCKS
	UMOVEM A,1(CAC)		;STORE IT
DSKCH1:	HRROI A,DEVNM7		;GET STR NAME AGAIN
	STDEV			;GET A DEVICE DESIGNATOR
	 JRST DSKCH2		;FAILED
	MOVE A,B		;GET DESIGNATOR INTO A
	GDSKC			;GET FREE BLOCKS LEFT
	LSH B,2			;CHANGE PAGES TO BLOCKS
	CAIGE F,3
	  JRST DSKCH3
	UMOVEM B,2(CAC)
	CAIGE F,4
	  JRST DSKCH3
	UMOVEM B,3(CAC)		;STORE BLKS LEFT ON STR AND UNIT
DSKCH2:	CAIGE F,5		;CHECK ARG LIST LENGTH
	  JRST DSKCH3		;NOT LONG ENOUGH FOR STRUCTURE NAME
	UMOVE E,0(CAC)		;GET DEVICE NAME AGAIN
	UMOVEM E,4(CAC)		;STORE STR NAME
	CAIGE F,16		;LONG ENOUGH FOR PHYSICAL NAME
	  JRST DSKCH3		;NO, JUST RETURN
	UMOVEM E,14(CAC)	;STORE LOGICAL NAME AS "DSK"
	UMOVEM E,15(CAC)	;AND PHYSICAL NAME AS "DSK" TOO.
DSKCH3:	SETZ A,			;SET UP ANSWER
	XCTUM <MOVS B,0(CAC)>	;GET DEVICE NAME AGAIN
	CAIE B,'DSK'		;IS THIS DSK?
	MOVSI A,2		;NO, SAY THAT IT IS NOT GENERIC DSK
	JRST STOTC1		;RETURN ANSWER

CHKDSK:	HRROI E,DEVNM7		;MAKE IT ASCIZ
	PUSHJ P,SIXTO7		;...
	HRROI A,DEVNM7		;NOW GET DEVICE DESIGNATOR
	STDEV
	  POPJ P,
	TLNE B,77777		;IS THIS A DISK?
	  POPJ P,		;NO
	JRST CPOPJ1		;YES
GETCHR:
DEVCHR:	PUSH P,AC		;SAVE AC FOR STOTAC
	TLNE CAC,-1		;DEVICE NAME OR CHANNEL NUMBER?
	JRST DEVCH0		;SIXBIT DEVICE NAME
	CAILE CAC,17		;LEGAL CHANNEL NUMBER
	JRST DEVCHZ		;NO, GIVE ERROR RETURN
	MOVEI AC,(CAC)		;GET CHANNEL NUMBER
	PUSHJ P,SETUPG		;GET INDEX INTO NAME TABLE
	JRST DEVCHZ		;NO DEVICE ON THIS CHANNEL, RETURN 0
	MOVE D,DEVNAM(BB)	;GET DEVICE NAME FROM TABLE
	JRST DEVCH3		;GO GET CHARACTERISTICS
DEVCH0:	MOVEI AC,0		;SET UP TO SEE IF THIS IS ALREADY INITED
DEVCLP:	PUSHJ P,SETUPG		;IS THERE A DEVICE ON THIS CHANNEL?
	JRST DEVCH2		;NO
	CAMN CAC,DEVNAM(BB)	;IS IT SAME AS ARGUMENT
	JRST DEVCH1		;YES, GO GET ITS CHARACTERISTICS
DEVCH2:	CAIGE AC,17		;CHECKED ALL CHANNELS YET
	AOJA AC,DEVCLP		;NO
	SETO BB,		;MARK THAT THIS IS NOT INITED
DEVCH1:	MOVE D,CAC		;SIXBIT DEVICE NAME
DEVCH3:	PUSHJ P,DVCHR1		;CALL COMMON ROUTINE
	  JFCL			;NONEXISTENT DEVICE
	JUMPL BB,DVCHZ1		;IF NOT INITED, STORE THIS ANSWER
	TXNE A,DV.DSK		;IS THIS A DISK?
	  JRST DVCHZ1		;THIS IS THE DSK, DONT SET INITED BIT
	TXNE A,DV.LPT		;IS THIS A LPT?
	  JRST DVCHZ1		;THIS IS THE LPT, DONT SET INITED BIT
	TROA A,1B19		;MARK THAT THIS DEVICE WAS INITED
DEVCHZ:	MOVEI A,0		;RETURN A ZERO
DVCHZ1:	POP P,AC		;RESTORE AC FOR STOTAC
	JRST STOTAC		;AND STORE THE RESULT
	JRST STOTAC		;RETURN AC A TO USER

DEVSIZ:	UMOVE D,1(CAC)		;GET THE SIXBIT ARG DEVICE NAME
	PUSHJ P,DVCHR1		;GET ITS CHARACTERISTICS
	  JRST RETM11		;NO SUCH DEV. RETURN A MINUS 1
	HLRZ C,B		;GET THE VIROS DEVICE TYPE
	ANDI C,777		; ..
	CAILE C,MAXDEV		;KNOWN DEVICE?
	MOVEI C,0		;NO, USE DSK
	UMOVE F,0(CAC)		;AND THE MODE WORD
	MOVE D,F		;GET MODE
	ANDI D,17		;JUST THE MODE FIELD
	MOVNI A,2		;ANSWER IF ILLEGAL
	MOVEI E,1		;BIT FOR MODE
	LSH E,(D)		;TO BIT POSITION
	TDNN E,DEVTBL(C)	;LEGAL?
	JRST STOTC1		;NO. RETURN THE -2
	CAIL D,15		;OK. IS MODE DUMP?
	JRST RETZR1		;YES. SKIP RETURN A ZERO
	HRRZ A,DEVTB2(C)	;NO. BUFFERED. GET BUFFER SIZE
	CAIE C,LPT		;LPT?
	CAIN C,CDR		;OR CDR?
	TLNE B,(1B3)		;YES, IS IT SPOOLED?
	SKIPA			;NO
	MOVEI A,200		;YES, USE 200 WORD BUFFERS
	CAIN C,DTA		;IS THIS A DECTAPE?
	TRNN F,100		;AND IN MODE 100?
	SKIPA			;NO
	  MOVEI A,200		;YES, BUFFER SIZE IS REALLY 200 WORDS
	CAIE C,MTA		;MAGTAPE?
	JRST DEVSI1		;NO, ALL DONE
	PUSHJ P,GETMBS		;YES, GET THE MAGTAPE BUFFER SIZE
	 MOVE A,DEVTB2+MTA	;FAILED, USE THE DEFAULT
DEVSI1:	ADD A,[2,,3]		;LH IS TWO BUFFERS, RH IS SIZE WITH HDR
	JRST STOTC1		;RETURN THAT AS ANSWER, SKIP.

DEVTYP:	MOVE D,CAC		;GET ARGUMENT IN CASE SIXBIT
	TLNE CAC,-1		;DEVICE NAME?
	JRST DVTYP1		;YES.
	CAILE CAC,17		;LEGAL CHANNEL NUMBER?
	JRST MRETN		;NO
	MOVEI A,(CAC)		;YES
	IMULI A,NTABS		;GET TABLE OFFSET
	MOVE CAC,DEVNAM(A)	;GET DEVICE NAME
	SKIPE D,DEVNAM(A)	;A DEVICE THERE?
DVTYP1:	PUSHJ P,DVCHR1		;YES. GET THE BITS FROM VIROS DVCHR TO B
	  JRST RETZR1		;ERROR. SKIP RETURN WITH A ZERO
	HLRZ D,B		;GET THE VIROS INDEX
	ANDI D,777		; ..
	MOVE A,DVTYPT(D)	;GET FIXED BITS
	HLRZ C,C		;GET JOB NUMBER
	CAIN C,-1		;FREE?
	MOVEI C,0		;YES
	JUMPN C,DVTYP3		;IS THERE A JOB NUMBER
	MOVE C,JOB		;LOAD C WITH TSS JOB #
	MOVEI D,17		;SCAN ALL 17 CHANNELS
	MOVEI E,0		; LOOKING FOR THIS DEVICE INITED
DVTYP2:	CAMN CAC,DEVNAM(E)	;FOUND IT YET?
	  JRST DVTYP3		;YES, GO SAY THIS JOB HAS THE DEVICE
	ADDI E,NTABS		;UPDATE CHANNEL INDEX
	SOJGE D,DVTYP2		;LOOP BACK FOR 20 TIMES
	MOVEI C,0		;NOT FOUND RETURN 0
DVTYP3:	DPB C,[POINT 9,A,26]	;PUT IN ANSWER
	TLNE B,(1B5)		;AVAILABLE?
	TLO A,(1B12)		;YES
	TLNN B,(1B3)		;IS THIS A SPOOLED DEVICE?
	TLO A,(1B13)		;YES, SET APPROPRAITE BIT
	JRST STOTC1		;SKIP RETURN WITH ANSWER
;COMMON ROUTINE FOR DEVCHR, DEVSIZ

DVCHR1:	SETZ C,			;INITIALIZE TSS JOB #
	MOVE E,DEVTBL		;CHARACTERISTICS FOR DSK
	MOVSI B,0		;INDEX IS 0 IF DISK (SYS)
	CAMN D,[SIXBIT /SYS/]	;DEVICE SYS?
	JRST DEVC1		;YES, USE CHARS FOR DSK
	MOVE E,CONTTY		;PREPARE CONSOLE TTY BITS
	MOVSI B,(<TTY>B17+DV%AS) ;ASSIGNABLE TTY
	CAMN D,[SIXBIT /TTY/]	;THAT WHAT HE WANTS?
	JRST DEVC1		;YES. RETURN THEM
	PUSH P,D		;SAVE DEVICE NAME
	MOVEI E,BUFFER		;PLACE TO PUT ASCIZ STRING OF DEVICE
	PUSHJ P,SIXTO7
	MOVEI E,0
	MOVNI B,1		;MINUS ONE FLAG IF NOT FOUND BY DVCHR
	HRROI A,BUFFER		;ARGUMENT FOR STRING TO DEVICE
	STDEV			;GET THE DEVICE TYPE
	  JRST DEVC3		;NONE, CHECK TOPS-10 PACK
	POP P,D			;CLEAR OUT STACK
	MOVE A,B		;TO RIGHT AC
	DVCHR			;GET THE BITS
	HLRZ D,B
	ANDI D,777		;DEVICE NUMBER
	CAILE D,MAXDEV		;KNOWN DEVICE?
	MOVEI D,0		;NO, USE DSK
	MOVE E,DEVTBL(D)	;10/50 DEVICE CHARACTERISTICS
	TLNE B,(1B5)		;IS THE THING AVAILABLE TO THIS JOB?
	TLOA E,40		;YES
	TRO E,1B19		;NO, MARK IT INITED BY ANOTHER JOB
	TLNE B,(1B6)		;ASSIGNED?
	TRO E,1B18		;YES. SET ASSCON IN 10/50 MODE WORD
DEVC1:	AOS 0(P)		;SKIP RETURN
DEVC2:	MOVE A,E		;CHARACTERISTICS IN A FOR
	POPJ P,0		;CALLER TO RETURN TO USER

DEVC3:	POP P,A			;GET DEVICE NAME
IFE FTFILSER,<
	JRST DEVC2		;NO DEVICE
>
IFN FTFILSER,<
	PUSHJ P,DPACHK		;SEE IF TOPS-10 PACK
	  JRST [SETZB C,E	;NO
		JRST DEVC2]
	MOVE E,DEVTBL		;YES, RETURN SAME AS DSK
	SETZB B,C
	JRST DEVC1
>
;10/50 DEVICE CHARACTERISTICS

CONTTY:	XWD 030053,400403	;BITS FOR A CONTROLLING TTY
DEVTBL:	XWD 201047,177777	;DSK A,AL,I,B,IB,DR,D (ALL MODES FOR DSK)
	XWD 0,0			;DRM
	XWD 000023,154403	;MTA DITTO DSK
	XWD 001107,154403	;DTA DITTO DSK
	XWD 000202,014403	;PTR A,AL,I,B,IB
	XWD 000401,014403	;PTP DITTO PTR
	XWD 002001,020000	;DSP ID ONLY
	XWD 040001,000403	;LPT A,AL,I
	XWD 100002,010403	;CDR A,AL,I,B
	XWD 100001,014003	;FE A,AL,B,IB
DEVTTY:	XWD 000053,000403	;TTY A,AL,I
	XWD 000013,000003	;PTY
	XWD 000053,000003	;TTR
	XWD 757777,177777	;NUL
	XWD 000047,014403	;NET
	XWD 000001,014403	;PLT
	XWD 201047,177777	;DLX A,AL,I,B,IB,DR,D (ALL MODES FOR DSK)
	XWD 100001,014003	;CDP A,AL,B,IB
	XWD 201047,177777	;DCN A,AL,I,B,IB,DR,D (ALL MODES FOR DSK)
	XWD 201047,177777	;SRV A,AL,I,B,IB,DR,D (ALL MODES FOR DSK)

MAXDEV==.-DEVTBL		;MAXIMUM KNOWN DEVICE


XLIST
LIT
LIST
;THE FOLLOWING ROUTINES ALL HAVE CONVERSIONS TO AND FROM SECONDS

RUNTIM:	MOVEI E,^D1000		;GET DESIRED UNITS IN E
	JUMPE CAC,RUNTM9	;JOB ZERO MEANS SELF
	TRZE CAC,400000		;IS THIS A REQUEST FOR HIGH PRECISION TIMING?
	  JRST RUNTMH		;YES, CAN DO THIS JOB ONLY
RUNTM0:	HRRZ A,CAC		;GET JOB NUMBER
	MOVE B,[-1,,D]		;GET RUNTIME FOR THIS JOB
	MOVEI C,.JIRT		;INTO AC D
	GETJI
	  MOVEI D,0		;IF ILLEGAL, ASSUME 0
	SKIPGE A,D		;IS THE JOB RUNNING?
	 MOVEI A,0		;NEGATIVE NUMBER SAYS NO SUCH JOB
RUNTM2:	MOVE C,A		;SAVE RUNTIM
	SYSGTA (<TICKPS>)	;GET TICKS PER SECOND
	EXCH A,C
	CAMN C,E		;ALREADY CORRECT UNITS?
	JRST RUNTM8		;YES
RUNTM1:	PUSHJ P,CONVRT		;GO CONVERT TIME TO CORRECT UNITS
RUNTM8:	JRST STOTAC		;RETURN TO USER'S AC

RUNTM9:	MOVNI 1,5
	RUNTM			;GET RUN TIME FOR THIS JOB
	JRST RUNTM2

RUNTMH:	SKIPE CAC		;THIS JOB?
	CAMN CAC,JOB		;...
	  SKIPA A,[1]		;YES, CAN DO HPTIM JSYS
	JRST RETZER		;NO, GIVE USER 0 INTSEAD
	HPTIM			;GET MICRO SECOND TIME
	  JRST RETZER		;NOT IMPLEMENTED
	IDIVI A,12		;TURN INTO 10 MICRO SEC INTERVAL
	JRST STOTAC		;AND RETURN IT TO USER
;CONVERT TIME TO DESIRED UNITS
;CALL:	MOVE A,TIME
;	MOVE C,CURRENT UNITS
;	MOVE E,DESIRED UNITS
;	PUSHJ P,CONVRT
;	RETURN HERE WITH NEW TIME IN A

CONVRT:	FLTR E,E
	FLTR C,C
	FLTR A,A
	CAMGE C,E		;IS THE VALUE IN SMALLER UNITS THAN FINAL ANS?
	JRST CONVR3		;NO
	FDVR C,E		;DIVIDE THE LARGER FUDGE FACTOR BY THE SMALLER
CONVR2:	FDVR A,C		;NOW DIVIDE BY THE FF
	FIXR A,A
	POPJ P,

CONVR3:	FMPR A,E		;THIS RESULT SHOULD FIT
	JRST CONVR2

PJOB:	MOVE A,JOB		;GET JOB NUMBER
	JRST STOTAC		;RETURN IT TO USER

TIMER:	MOVEI E,^D60		;CLOCK TICKS (60THS) SINCE MIDNIGHT
	SETO B,			;TO REQUEST CURRENT TIME
	SETZ D,			;NORMAL FLAGS
	ODCNV
	MOVEI A,0(D)		;SECONDS SINCE MIDNIGHT
	MOVEI C,1		;UNITS (SECONDS)
	JRST RUNTM1		;NO, GO CONVERT TO PROPER UNITS AND RETURN

MSTIME:	TIME			;READ TIME SINCE LOAD IN MS
	MOVE F,A		;SAVE TIME FOR LATER
	ADD A,ITIME		;ADD IN TIME FROM MIDNIGHT TO LOAD TIME
	IDIV A,[^D24*^D60*^D60*^D1000] ;CONVERT TO MODULO ONE DAY
	MOVE A,B		;GET TIME SINCE LATEST MIDNIGHT
	SETO B,			;NOW GET ACTUAL TIME SINCE MIDNIGHT
	SETZ D,			;...
	ODCNV
	 ERJMP STOTAC		;IF FAILED, USE PREVIOUSLY CALCULATED ANSWER
	MOVEI B,^D1000		;CONVERT SECONDS TO MILLISECONDS
	IMULI B,0(D)
	CAMG B,A		;HAS CLOCK DRIFTED?
	  JRST STOTAC		;NO
	PUSH P,B		;YES, SAVE TIME
	SUB B,F			;GET NEW BASE TIME
	MOVEM B,ITIME		;STORE NEW BASE
	POP P,A			;GET BACK ANSWER
	JRST STOTAC		;RETURN IT TO USER

GETPPN:	GJINF
	MOVE A,B		;DIRECTORY NUMBER AS A PPN
	PUSHJ P,PPNUNM		;GO GET PPN UNMAPPING
	JRST STOTAC		;RETURN IT
;10/50 STANDARD BUFFER SIZE FOR EACH DEVICE

DEVTB2:	EXP 200,0,200,177,40,40,0,200,33,32,20,20,20,200,100,43,20,32,200,200

;TABLE OF BITS FOR DEVTYP CALLI

DVTYPT:	400003,,0	;DSK
	0		;DRM
	7,,2		;MTA
	400003,,1	;DTA
	6,,4		;PTR
	5,,5		;PTP
	0		;DSP
	5,,7		;LPT
	2,,10		;CDR
	3,,14		;FE
	13,,3		;TTY
	13,,12		;PTY
	13,,3		;TTR
	3,,0		;NIL
	3,,14		;NET
	1,,13		;PLT
	3,,14		;DLX
	1,,11		;CDP
	3,,14		;DCN
	3,,14		;SRV
CORE:	SKIPE CAC		;0 ARG GIVES FREE CORE, ERROR RETURN
	PUSHJ P,COREUU
	SKIPA
	AOS 0(P)		;OK RETURN, R2
	MOVEI A,PATLOC		;RETURN HOW MUCH HE CAN HAVE
	TLNE PF,L.FLSR		;FILSER MAPPED IN?
	  MOVEI A,FLSRLC	;YES, GET START OF FILSER AREA INSTEAD
	LSH A,-^D10		;IN K
	JRST STOTAC		;RETURN IT IN THE AC

COREUU:	TLNN CAC,-1		;ANY CHANGE TO HIGH SEGMENT?
	JRST COREU4		;NO
	HLRZ B,CAC
	TRO B,777
	CAIL B,PATLOC		;TOO LARGE?
	  POPJ P,		;YES, GIVE ERROR RETURN
	TLNN PF,L.FLSR		;FILSER MAPPED IN?
	  JRST COREU1		;NO
	CAIL B,FLSRLC		;YES, TOO LARGE?
	  POPJ P,		;YES, GIVE ERROR RETURN
COREU1:	SKIPE C,JBHRL		;ANY HIGH SEG?
	JRST CORU1A		;YES, USE CURRENT END
	MOVE C,JBREL		;GET CURRENT LOW SEG END
	TRO C,777		;END OF PAGE
	ADDI C,1		;BEGIN NEXT
	CAIGE C,.HSLOC		;ABOVE DEFAULT
	MOVEI C,.HSLOC		;NO, USE DEFAULT
	MOVEM C,HSORG		;SET HI SEG ORIGIN
	SOS C			;LAST WORD USED
CORU1A:	CAMGE B,HSORG		;NEGATIVE HISEG LENGTH?
	JRST FLUSHI		;YES
	CAMLE B,C		;MORE THAN BEFORE?
	JRST COREU3		;YES
COREU2:	PUSH P,A		;SAVE UUO ARG
	MOVEI A,(C)		;GET OLD WORD SIZE
	PUSHJ P,SHRINK		;REMOVE PAGES IF NEEDED.
	POP P,A			;AND RESTORE AC ARG
	JRST COREU3		;ON TO CHECK LOW SEG.
FLUSHI:	HRRZ A,JBHRL		;OLD HIGH SEG SIZE
	MOVE B,HSORG
	SOS B			;NEW SIZE IS ZERO
	PUSHJ P,SHRINK		;SHRINK THE HIGH SEGMENT
	SETZ B,
COREU3:	HRRZM B,JBHRL
	XCTUU <HRRM B,.JBHRL>
	SKIPN JBHRL		;ANY HIGH SEG LEFT
	PUSHJ P,CLRHSN		;NO, CLEAR HIGH SEG NAME
COREU4:	TRNN CAC,-1		;ANY CHANGE TO LOW SEG?
	JRST CPOPJ1		;NO
CORU10:	HRRZ B,CAC
	TRO B,777
	SKIPE JBHRL		;IS THERE A HIGH SEG?
	CAMGE B,HSORG		;DOES USER WANT TO EXPAND INTO HIGH SEG?
	  SKIPA			;NO
	  POPJ P,		;DONT LET HIM OVERWRITE THE HIGH SEG.
	HRRZ C,JBREL
	CAIL B,PATLOC		;ARG OK?
	POPJ P,
	TLNN PF,L.FLSR		;FILSER MAPPED IN?
	  JRST CORU11		;NO
	CAIL B,FLSRLC		;ARG STILL OK?
	  POPJ P,		;NO, ERROR
CORU11:	HRRZM B,JBREL
	XCTUU <HRRM B,.JBREL>	;NEW .JBREL
	HRRZ B,JBREL		;NEW .JBREL
	CAIG B,(C)		;MORE THAN BEFORE?
	JRST COREU7		;NO
REPEAT 0,<
	MOVSI D,1(C)
	HRRI D,2(C)
	SETZM 1(C)
	CAIGE B,(D)
	JRST COREU9
	XCTUU <BLT D,(B)>
>
	JRST COREU9

COREU7:	MOVEI A,0(C)		;NEW LOW SEG
	PUSHJ P,SHRINK		;ADJUST SEGMENT SIZE
COREU9:	JRST CPOPJ1
;SHRINK A SEGMENT. A/ OLD WORDS TOP, B/ NEW WORDS TOP.
SHRINK:	JUMPE A,CPOPJ		;IN CASE OLD VALUE MISSING
	CAIG A,(B)		;OLD REALLY BIGGER?
	POPJ P,0		;NO. RETURN.
	PUSH P,A		;BE TRANSPARENT
	PUSH P,B
	PUSH P,D
	MOVEI D,(A)		;COPY OLD SIZE
	LSH D,-11		;CONVERT TO PAGE NUMBERS
	LSH B,-11
	SETO A,			;REMAP FROM NULL-SPACE
	MOVEI C,0(D)		;CALCULATE COUNT OF PAGES TO BE DELETED
	SUBI C,0(B)		;...
	TLO C,(1B0)		;DO A MULTIPLE PMAP
	HRLI B,.FHSLF		;THIS FORK
	HRRI B,1(B)		;START AT CORRECT PAGE
	PMAP			;PAGE TO REMOVE
	POP P,D			;RESTORE ACS.
	JRST BAPOPJ		;AND RETURN.

XPAND:	PUSH P,CAC		;CORE UUO WANTS ARG IN CAC
	HRRZ CAC,G		;PHONY UP A CORE UUO FOR LOW SEG.
	PUSH P,B
	PUSH P,C
	PUSH P,D
	PUSHJ P,CORU10		;EXPAND CORE TO GET IT
	PUSHJ P,ERROR		;ERROR RETURN- COULDN'T
	POP P,D
	POP P,C
	POP P,B
	POP P,CAC		;RESTORE I/O CALL CAC
	POPJ P,			;OK- ALL DONE.
SUBTTL TTCALL AND OTHER TERMINAL HANDLING UUO'S
;TTCALL UUO, DISPATCH BY AC FIELD.
;AC VALUES ARE:
;0=INCHRW 1=OUTCHR 2=INCHRS 3=OUTSTR 4=INCHWL 5=INCHSL 6=GETLCH
;7=SETLCH 10=RESCAN 11=CLRBFI 12=CLRBFO 13=SKPINC 14=SKPINL
;15=IONEOU 16=CPOPJ 17=CPOPJ

UTTCLL:	MOVE E,TYSTAT		;CARRY AROUND TTY STATUS BITS IN E
	MOVEI A,PRIJFN		;INITIALIZE JFN OF TTY
	PUSHJ P,@TTCLTB(AC)	;CALL TTCALL ROUTINE
	JRST MRETN		;NON-SKIP RETURN
	JRST MRETN2		;SKIP RETURN

TTCLTB:	EXP TTCL0,TTCL1,TTCL2,TTCL3,TTCL4,TTCL5,TTCL6,TTCL7
	EXP TTCL10,TTCL11,TTCL12,TTCL13,TTCL14,TTCL15
	EXP MRETN,MRETN		;16 AND 17 NOT IMPLEMENTED

TBOUND:	HRRZ C,FORTY		;ARG MUST NOT BE BETWEEN 20 AND 137
	CAIGE C,.JBPFI
	CAIGE C,20
	POPJ P,
	PUSHJ P,ERRARG

;TTCALL ROUTINES TO INPUT CHARACTERS

;TTCALL 0, - INPUT A CHARACTER AND WAIT (CHARACTER MODE)

TTCL0:	PUSHJ P,NOCTRO		;TURN OFF CONTROL-O
	PUSHJ P,TBOUND		;SEE IF ARGUMENTS ARE IN BOUNDS
	TLO E,TT.BKE		;BREAK ON ANYTHING
	PUSHJ P,TTPSTS		;GO SET UP NEW MODE FOR PRIMARY TTY
TTCL0A:	PUSHJ P,TTPGET		;GO GET A CHARACTER AND WAIT IF NONE
TTXIT:	UMOVEM B,@FORTY		;STORE CHARACTER INTO USER'S AREA
	POPJ P,			;AND RETURN

;TTCALL 2, - INPUT A CHARACTER AND SKIP (CHARACTER MODE)

TTCL2:	PUSHJ P,NOCTRO		;CLEAR CONTROL-O
	PUSHJ P,TBOUND		;MAKE SURE ARG IS IN BOUNDS
	TLO E,TT.BKE		;SET UP TO BREAK ON EVERYTHING
TTCL2A:	PUSHJ P,TTPSTS		;GO SET UP NEW MODE
	PUSHJ P,TTFILL		;GO PULL IN A CHARACTER IF ONE READY
	  POPJ P,		;NO CHARACTER, GIVE NON-SKIP RETURN
	AOS 0(P)		;SET UP SKIP RETURN
	JRST TTCL0A		;GO GET THE CHARACTER

;TTCALL 4, - INPUT A CHARACTER AND WAIT (LINE MODE)

TTCL4:	PUSHJ P,NOCTRO		;CLEAR CONTROL-O
	PUSHJ P,TBOUND		;SEE IF ARG IS IN BOUNDS
	TLZ E,TT.BKE		;CLEAR BREAK ON EVERYTHING FLAG
	PUSHJ P,TTPSTS		;GO SET UP NEW MODE
	JRST TTCL0A		;GO READ IN A CHARACTER

;TTCALL 5, - INPUT A CHARACTER AND SKIP (LINE MODE)

TTCL5:	PUSHJ P,NOCTRO		;CLEAR CONTROL-O FLAG
	PUSHJ P,TBOUND		;SEE IF ARG IS IN BOUNDS
	TLZ E,TT.BKE		;CLEAR BREAK ON EVERYTHING MODE
	JRST TTCL2A		;GO SEE IF A CHARACTER IS THERE
DDTIN:	HRRZ A,CAC		;GET USER BUFFER ADDRESS
	MOVEI B,21		;CHECK IT FOR BOUNDRIES
	PUSHJ P,ADRCKB		;BOTH ENDS OF THE BUFFER
	MOVEI A,PRIJFN		;DDTIN ALWAYS REFERS TO CONTROLING TTY
	MOVE E,TYSTAT		;GET STATUS OF TTY
	PUSHJ P,NOCTRO		;CLEAR CONTROL-O 
	TLO E,TT.BKE		;SET BREAK ON ANYTHING
	PUSHJ P,TTPSTS		;SET STATUS FOR CONTROLING TTY
	MOVE D,CAC		;GET START OF BUFFER
	HRLI D,(POINT 7,0)	;MAKE A BYTE POINTER INTO USER BUFFER
	MOVEM D,IOBPT
	MOVEI F,21*5-1		;KEEP COUNT OF CHARACTERS STORED
DDTIN1:	PUSHJ P,TTPGET		;GET A CHARACTER
	XCTLB <IDPB B,IOBPT>	;STORE IT IN USER BUFFER
	PUSHJ P,TTFILL		;SEE IF ANY MORE
	  SKIPA			;NO
	SOJG F,DDTIN1		;YES, LOOP BACK FOR ALL CHARACTERS IN BUFFER
	MOVEI B,0		;ALWAYS CLOSE WITH A NULL
	XCTLB <IDPB B,IOBPT>
	JRST MRETN		;AND RETURN
;ROUTINES TO FILL THE INTERNAL BUFFER FOR THE CONTROLING TTY

;TTFILL - READS IN ANY WAITING CHARACTERS UP TO FIRST BREAK CHAR
;	  WILL NOT BLOCK IF THERE ARE NO CHARACTERS

TTFILL:	SKIPE TTLINE		;IS THERE A LINE IN THE BUFFER
	  JRST CPOPJ1		;YES, THEN RETURN
	TLNE E,TT.BKE!TT.BIN	;IN BREAK ON EVERYTHING MODE?
	SKIPG TTCNT		;YES, IS THERE A CHARACTER READY?
	SKIPA A,[PRIJFN]	;NO, SEE IF ONE IN MONITOR BUFFER
	  JRST CPOPJ1		;YES, SKIP RETURN
	SIBE			;ANY CHARACTERS READY TO BE READ IN
	  JRST [PUSHJ P,TTFLW0	;YES, GO READ IN ONE
		JRST TTFILL]	;AND LOOP BACK
	POPJ P,			;NO, DONT BLOCK

;TTFILW - READS IN ONE CHARACTER AND PUTS IT INTO THE INTERNAL BUFFER
;	  THIS ROUTINE WILL BLOCK IF NO CHARACTER IS READY

TTFILW:	PUSHJ P,TTFLW0		;GO WAIT FOR A CHARACTER TO BE TYPED
	PUSHJ P,TTFILL		;ANY CHARACTERS READY YET?
	  JRST TTFILW		;NO, MAY HAVE BEEN ^R, ^U, OR RUBOUT
	POPJ P,

TTFLW0:	TDNE E,[TT.BIN!TT.BKE,,IO.FCS]
	  JRST TTFLWB		;CANNOT USE RDTXT, USE BIN
	MOVE A,[PRIJFN,,PROJFN]	;SET UP FOR RDTXT JSYS
	MOVE B,TTINPT		;GET POINTER INTO BUFFER
	MOVE C,[RD%TOP!RD%RIE!RD%BRK!RD%JFN!RD%BBG+TTMAXC]
	SUB C,TTCNT		;GET NUMBER OF CHARACTERS LEFT IN BUF
	MOVE F,TTCNT		;SAVE THE COUNT FOR LATER
	TLNE E,TT.XON		;IS TTY TAPE ON?
	  TLO C,(RD%CRF)	;GET LF INSTEAD OF CR-LF
	MOVE D,[POINT 8,TTBUF]	;POINTER TO START OF BUFFER
	PUSHJ P,DORDTX		;DO THE RDTXT JSYS
	MOVNI D,-TTMAXC(C)	;GET COUNT OF CHARACTERS IN BUFFER
	HRRZM D,TTCNT		;STORE NEW COUNT
	MOVEM B,TTINPT		;SAVE NEW PUTTER POINTER
	TLNN C,(RD%BTM)		;WAS THERE A BREAK CHARACTER TYPED?
	  JRST [TRNN C,-1	;DID COUNT RUN OUT?
		 JRST TTFLW1	;YES, CAUSE BREAK
		CAME F,TTCNT	;NO, WERE ANY CHARACTERS READ IN?
		  POPJ P,	;YES, RETURN TO CALLER
		MOVEI A,PRIJFN	;NO, WAIT FOR ONE
		PUSHJ P,TTYBIN	;READ IN A CHARACTER
		BKJFN		;BACK UP OVER THIS CHAR
		  PUSHJ P,BUGSTP
		JRST TTFLW0]	;GO LET RDTXT DO ITS THING
	MOVEI A,C.CR		;SEE IF IN TTY TAPE MODE
	TLNE E,TT.XON
	  JRST [PBOUT		;ECHO CR
		DPB A,TTINPT	;CHANGE LF TO CR
		JRST .+1]
TTFLW1:	MOVEI A,PROJFN		;CLEAR CONTROL-O
	PUSHJ P,NOCTRO
	JRST TTBRK

TTFLWB:	PUSHJ P,TTYBIN		;GO DO THE BIN
	PUSHJ P,TTPUTC		;GO STORE THIS CHARACTER
	CAIE B,C.BELL		;IS THIS A BELL?
	CAIL B,175		;OR RUBOUT OR ALTMODE?
	  JRST TTBRK		;YES, THEN SET BREAK CHAR SEEN
	CAIN B,C.EOF		;IS THIS A CONTROL-Z
	  JRST TTBRK		;YES, SET BREAK
	CAIE B,C.DELL		;CONTROL-U?
	CAIN B,STDALT		;OR ALTMODE?
	  JRST TTBRK		;YES, SET BREAK
	CAIGE B,C.CR		;FORMATTING CHARACTER?
	CAIGE B,C.LF		;  NOT INCLUDING CR
	  POPJ P,		;NO, DONT SET BREAK
	JRST TTBRK		;YES, SET BREAK
;ROUTINES TO GET CHARACTERS

;TTPGET - GET A CHARACTER FROM THE CONTROLING TTY AND PERFORM CONVERSION IF DESIRED
;	  THIS ROUTINE WILL WAIT FOR A CHARACTER IF NONE THERE

TTPGET:	PUSHJ P,TTFILL		;GO SEE IF ANY CHARACTERS THERE
	  PUSHJ P,TTFILW	;NO, WAIT FOR ONE
	PUSHJ P,TTGETC		;GO GET THE CHARACTER
	TLNE E,TT.BIN!TT.ALT	;SHOULD ALTMODES BE CONVERTED?
	  POPJ P,		;NO, SO DONT
	CAIE B,ALT1		;IS IT AN ALTMODE
	CAIN B,ALT2		;OR ANOTHER ALTMODE
	  MOVEI B,STDALT	;YES, MAKE ALL ALTMODES THE SAME
	POPJ P,			;AND RETURN

TTBRK:	SETOM TTLINE		;NOW THERE IS A LINE IN MY BUFFER
	PUSH P,A		;SAVE A
	MOVE A,TTCNT		;SAVE COUNT OF CHARS IN LINE
	MOVEM A,OTTCNT		;FOR TTCALL 10 (RESCAN)
	JRST APOPJ

TTBINI:	PUSHJ P,TTYSST		;SET TTY STATUS
	MOVE A,[POINT 8,TTBUF]	;GET START OF BUFFER
	MOVEM A,TTINPT		;SET UP GETTER
	MOVEM A,TTOUPT		;AND PUTTER
	SETZM TTCNT
	SETZM TTLINE
	SETZM OTTCNT
	POPJ P,

TTGTC0:	PUSHJ P,TTFILW		;GET A CHARACTER
TTGETC:	SKIPG TTCNT		;MAKE SURE THERE IS A CHAR
	  JRST TTGTC0		;NO, GO WAIT FOR A CHARACTER
	SOS TTCNT		;COUNT DOWN COUNTER
	ILDB B,TTOUPT		;GET CHAR
	PUSH P,A		;SAVE A
	SKIPLE TTCNT		;ANY CHARACTERS LEFT?
	  JRST TTGTC1		;YES
	MOVE A,[POINT 8,TTBUF]	;INITIALIZE THE POINTERS
	MOVEM A,TTOUPT
	MOVEM A,TTINPT
	SETZM TTLINE		;NO MORE LINE IN BUFFER
TTGTC1:	TRNN E,IO.BIN		;IN BINARY MODE?
	  ANDI B,177		;NO, TRUNCATE TO 7 BITS
	JRST APOPJ		;RESTORE A AND RETURN

TTPUTC:	PUSH P,A		;SAVE A
	MOVE A,TTCNT		;GET CURRENT COUNT
	CAILE A,TTMAXC		;IS THE BUFFER FULL?
	  PUSHJ P,BUGSTP	;YES, THIS IS WORTHY OF A HALT
	IDPB B,TTINPT		;STORE CHAR IN BUFFER
	AOS A,TTCNT		;UPDATE COUNTER
	CAIL A,TTMAXC-5		;BUFFER ALMOST FULL?
	  PUSHJ P,TTBRK		;YES, PRETEND THAT A LINE IS THERE
	JRST APOPJ		;RESTORE A AND RETURN
TTCL1:	MOVEI A,PROJFN		;OUTPUT A SINGLE CHAR
	PUSHJ P,TTCLRB		;CLEAR BINARY MODE IF ON
	UMOVE B,@FORTY
	PUSHJ P,TTYBOU		;OUTPUT CHARACTER, CHECKING ^L, ^O
	POPJ P,

TTCL15:	MOVEI A,PROJFN		;OUTPUT ONE IMAGE CHARACTER.
	RFMOD			;SO SWITCH TTY TO BINARY TO DO IT.
	PUSH P,B		;SAVE PREVIOUS MODE
	TRZ B,3B29		;BINARY
	SFMOD
	UMOVE B,@FORTY		;GET USER'S CHARACTER
	PUSHJ P,TTYBO1		;SEND IT
	POP P,B			;RESTORE PREVIOUS MODE
	SFMOD			; ..
	POPJ P,

TTYBOU:				;ROUTINE TO OUTPUT A BYTE TO TTY
	CAIN A,PRIJFN		;OUTPUT TO PRIMARY INPUT SOMEHOW?
	MOVEI A,PROJFN		;YES. MAKE IT OUTPUT.
	CAIN B,C.FF		;FORMFEED?
	JRST TTYBOF		;YES. GO CHECK INDICATE FLAG
	CAIN B,STDALT		;ESCAPE (33)
	JRST TTYBOI		;YES GO SEND 33 INSTEAD OF $
	;ELSE FALL INTO OUTPUTTER
TTYBO1:	BOUT			;ORDINARY. OUTPUT IT.
	POPJ P,0		;AND RETURN
TTYBOF:	TLNN PF,L.INDF		;FORMFEED. SEND OR INDICATE?
	JRST TTYBO1		;SEND.
	HRROI B,[ASCIZ /^L
/]				;INDICATION. NOTE CLOBBERS B AND C
	MOVEI C,0		;STRING LENGTH COUNTER
	SOUT			;STRING TO TTY (JFN IN A)
	POPJ P,0		;AND RETURN
TTYBOI:	PUSH P,B		;SAVE CHARACTER
	RFMOD			;SWITCH TTY TO BINARY
	PUSH P,B		;SAVE PREVIOUS MODE
	TRZ B,3B29		;SET BINARY
	SFMOD
	MOVE B,-1(P)		;GET CHARACTER BACK
	PUSHJ P,TTYBO1		;SEND IT
	POP P,B			;GET PREVIOS MODE
	SFMOD			;RESTORE IT
	POP P,B			;REMOVE CHARACTER FROM STACK
	POPJ P,			;RETURN

;ROUTINE TO INITIALIZE TTY ON RESET OR RESTART

TTYSST:	MOVEI A,PRIJFN
	MOVE E,TYSTAT		;GET TTY FLAGS
	PUSH P,C		;SAVE AC
	PUSHJ P,TTCLRB		;CLEAR BINARY MODE FIRST
	POP P,C			;RESTORE AC
	SETOM TTWDTH		;(316)FREE CRLF NOT SET (TRMOP .TONFC)
	POPJ P,
;ROUTINE TO SET THE STATUS FOR THE TTY

;TTYSTS - ROUTINE TO CALL IF NOT THE CONTROLING TTY

TTPSTS:	CAMN E,TYSTAT		;SEE IF A CHANGE IS DESIRED IN TTY STATE
	  POPJ P,		;NO, DONT DO ANY JSYS'S
	MOVEM E,TYSTAT		;YES, STORE NEW STATUS BITS
	JRST TTYST0		;GO CHANGE THE MODE

TTYSTS:	MOVE A,JFNTAB(BB)	;GET JFN OF TTY
	TLNE E,TT.CTY		;IS THIS THE CONTROLING TTY?
	  JRST TTPSTS		;YES, GO LET THE OTHER ROUTINE DO THIS
	CAMN E,FLAGWD(BB)	;SAME AS THE LAST TIME?
	  POPJ P,		;YES, THEN THERE IS NO NEED TO CHANGE
	MOVEM E,FLAGWD(BB)	;NO, STORE NEW MODE
TTYST0:	RFMOD			;READ IN MODE OF TTY
	trz b,tm.wak!TM.ECH!tm.iod	;initialize mode word
	trnn e,io.sup		;echo on?
	  ior b,echini		;yes, set up echo mode
	tlne e,tt.bin		;binary mode desired?
	  TRZA B,TM.ATE		;(320) YES, SET BINARY MODE
	TRO B,TM.ATE		;(320) NO, SET ASCII MODE/no output translation
	tlne e,tt.bin!tt.bke	;break on everything mode?
	  tro b,tm.bke		;yes, set the correct bits
	trne e,io.fcs		;full character set?
	  tro b,tm.fcs		;yes, set break on all controls
	tro b,tm.fwk		;always set break on format controls
	sfmod			;set the mode
	tdne e,[tt.bin,,io.tec]	;want truth in echoing?
	  jrst ttyst2		;yes, go set up echo mode for this
	move b,fcoc2		;get first half of control bits
	tlne pf,l.indf		;user want to simulate form feeds
	  trc b,3b25		;no, indicate forms by ^l
	move c,fcoc3		;get other control bits
	tdnn e,[tt.bke,,io.fcs]	;want echo of ^r OR ^W?
	  tlz c,(3b1!3B11)	;NO, ^R MEANS RETYPE LINE, ^W IS WORD DEL
	tlne e,tt.xon		;user in tape mode?
	  trz c,3b27		;yes, dont echo eol
	sfcoc			;set the bits
	popj p,

ttyst2:	move b,selfec		;echo controls as self
	move c,b		;all of them
	sfcoc
	popj p,
;ECHO BYTES FOR CONTROL CHARACTERS:
; 00 MEANS IGNORE, DISCARD.
; 01 MEANS INDICATE BY ^X
; 10 MEANS SEND AND ACCT (SIM IF NECESSARY ONLY)
; 11 MEANS SIMULATE AND ACCT

;		 @,A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q
FCOC2:	BYTE (2) 0,1,1,1,1,1,1,2,2,2,2,2,2,2,1,1,1,1
;		 R,S,T,U,V,W,X,Y,Z,[ \ ] ^ _
FCOC3:	BYTE (2) 1,1,1,0,1,1,1,1,1,3,1,1,1,2
SELFEC:	BYTE (2) 2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2


DDTOUT:	PUSHJ P,DDTOU1		;GO DO OUTPUT
	JRST MRETN		;AND EXIT

DDTOU1:	MOVE D,CAC		;ADDRESS OF STRING TO TYPE OUT
	TLOA D,-1		;MAKE STRING POINTER, SKIP TO OUTPUT
TTCL3:	HRRO D,FORTY
	TRNN D,-20		;IN THE USERS AC'S?
	HRRI D,ACS(D)		;YES. MOVE POINTER
	MOVEI A,PROJFN		;JFN FOR "TTY"
	MOVE E,TYSTAT		;SET UP STATUS WORD FOR TTY
	PUSHJ P,TTCLRB		;CLEAR BINARY MODE IF ON

;**; INSTEAD OF DOING BOUT'S TO CHECK FOR ALTMODE AND ^L DURING
;**; AN OUTSTR, SET UP THE CCOC WORD TO DO THEM CORRECTLY AND
;**; DO A SOUT.

;**; BUT SFMOD set to TM.ATE means ^L will always come out FF on SOUT
;**; (regardless of TERM INDICATE) so pre-scan output & do BOUT loop if
;**; ^L is present

	MOVE C,D		;(324) don't clobber string ptr for later
	HRLI C,440700		;(324) scan string in bytes
	ILDB B,C		;(324) get a byte
	JUMPE B,TTCL3A		;(324) NULL means end & no ^L so use SOUT
	CAIE B,C.FF		;(324) is it an ^L?
	  JRST .-3		;(324) no, get next byte

	HRLI D,440700		;(324) string contains ^L so BOUT loop
	ILDB B,D		;(324) get a byte
	JUMPE B,CPOPJ		;(324) quit on first NULL
	PUSHJ P,TTYBOU		;(324) output, checking ^O, indicate ^L
	JRST .-3		;(324) loop till end of string

TTCL3A:				;(324)
	RFCOC			;(322) GET CCOC WORDS
	PUSH P,B		;(322) SAVE THEM ON THE STACK
	PUSH P,C		;(322)
	TRZ C,3B19		;(322) TURN OFF ALTMODE BITS
	TRO C,2B19		;(322) AND MAKE ALTMODE CODE 2 (SEND)
	TRZ B,3B25		;(322) TURN OFF ^L BITS
	TLNN PF,L.INDF		;(322) SEND OR INDICATE ^L?
	TROA B,2B25		;(322) SEND
	TRO B,1B25		;(322) INDICATE
	SFCOC			;(322) SET THE CCOC WORDS
	HRRO B,D		;(322) GET BYTE PTR TO STRING
	SETZ C,			;(322) THE STRING IS ASCIZ
	SOUT			;(322) PRINT IT
	POP P,C			;(322) RESTORE THE CCOC WORDS
	POP P,B			;(322)
	SFCOC			;(322) TO WHAT THEY USED TO BE.
	JRST CPOPJ		;(322) RETURN

TTCL11:	MOVEI A,PRIJFN		;CLEAR INPUT BUFFER
	CFIBF
	PUSHJ P,TTBINI		;AND CLEAR MY BUFFER
	POPJ P,

TTCL12:	MOVEI A,PROJFN		;CLEAR OUTPUT BUFFER
	PUSHJ P,TTCLRB		;CLEAR BINARY MODE IF ON
	CFOBF
	POPJ P,

TTCL13:	PUSHJ P,NOCTRO		;CLEAR CONTROL O FLAG
	MOVEI A,PRIJFN		;SKIP IF CHAR AVAIL FOR INPUT
	SKIPG TTCNT		; ANY CHAR IN MY BUFFER?
	SIBE
	JRST CPOPJ1		;YES. SKIP RETURN.
	POPJ P,			;NO


TTCL14:	PUSHJ P,NOCTRO		;CLEAR CONTROL O FLAG
	XCTUM <HLRZ B,@MONUPC>	;GET INSTRUCTION AFTER TTCALL 14,
	CAIN B,(JFCL)		;IS THIS A CLEAR CONTROL-O CALL?
	  JRST MRETN2		;YES, JUST RETURN
	PUSHJ P,TTFILL		;NO, TRY TO GET ONE
	JFCL
	SKIPE TTLINE		;ONE THERE NOW?
	  AOS (P)		;YES, SET UP FOR SKIP RETURN
	TLNE PF,L.DBUG		;DEBUGGING?
	  POPJ P,		;YES, DONT DO RESCAN SINCE DDT EATS LINE
	JRST TTRLIN		;GO PUT ALL CHARACTERS BACK INTO RESCAN BUFFER
TTRLIN:	SKIPG C,TTCNT		;ANY CHARACTERS TO BE GOTTEN
	  POPJ P,		;NO, DONT DO ANYTHING
	MOVE D,[POINT 7,STRNG1]	;SET UP A TEMPORARY STRING
	PUSHJ P,TTGETC		;GET A CHARACTER IN B
	IDPB B,D		;STORE IT IN THE STRING
	SOJG C,.-2		;LOOP FOR ALL AVAILABLE CHARACTERS
	MOVEI B,0		;END STRING WITH NULL
	IDPB B,D
	HRROI A,STRNG1		;NOW PUT STRING IN INPUT BUFFER
	RSCAN
	  JRST TRLIN1		;OPPS, GO PUT THE LINE BACK IN INTERNAL BUFFER
	SETZ A,			;AND MAKE IT AVAILABLE TO JOB
	RSCAN
	  JFCL
	POPJ P,

TRLIN1:	MOVE D,[POINT 7,STRNG1]
TRLIN2:	ILDB B,D		;GET NEXT CHAR FROM TEMP STRING
	JUMPE B,CPOPJ		;IF ZERO, THEN WE ARE THRU
	PUSHJ P,TTPUTC		;PUT CHARACTER INTO INTERNAL BUFFER
	JRST TRLIN2		;LOOP FOR ALL CHARACTERS
TTCL6:	PUSHJ P,TBOUND
	UMOVE D,0(C)
	JUMPGE D,TTCL6A		;SPECIFIC TTY ASKED FOR
	PUSH P,A		;
	SETO A,			;(327) CHECK TO SEE IF THIS JOB IS DETACHED
	MOVE B,[-2,,E]		;E/JOBNO,  F/TERMNO,  -1=DETACHED
	SETZ C,			;FIRST TWO WORDS
	GETJI
	  JFCL			;TRY AS USUAL IF THIS FAILS
	POP P,A
	JUMPGE F,TTCL6D		;THERE IS A TTY, GO FIND OUT ABOUT IT
	SETZ C,			;DETACHED, RETURN 0 TO CALLER
	JRST TTCL6E		;
TTCL6D:	DVCHR			;GET THE TRUE POOP ON TTY
	HRLI C,0		;CLEAR LEFT HALF. JUST LINE NUMBER
TTCL6B:	CAML C,FIRPTY		;IS THIS A PTY LINE?
	  TLO C,(1B0)		;YES, REMEMBER THAT
	SKIPL TTLINE		;IS THERE A LINE NOW?
	SIBE			;OR EVEN A CHARACTER?
	  TLO C,(1B11)		;YES, MARK THAT FACT
	MOVEI A,-1		;CONTROLING TERMINAL
	RFMOD			;GET TERMINAL CHARACTERISTICS
	TRNE B,3B33		;SHUFFLE BETWEEN VIROS AND 1050 BITS
	TLO C,(1B5)		;HALF DUPLEX BIT
	TLNE B,(1B2)		;TABS?
	TLO C,(1B14)		;TABS.
	TLNE B,(1B3)		;LOWERCASE?
	TRNE B,1B31		;RAISE?
	  TLZA C,(1B13)		;NO LOWERCASE
	TLO C,(1B13)		;LOWERCASE
	TLNE E,TT.XON		;PAPER TAPE MODE ON?
	  TLO C,(1B16)		;YES
	TRNE E,IO.SUP		;NO ECHO IN INIT FLAGS?
	TLO C,(1B15)		;YES.
TTCL6C:	TRO C,200000		;SET UNIVERSAL I/O INDEX #
TTCL6E:	UMOVEM C,@FORTY		;RETURN THE ANSWER TO USER
	POPJ P,			;END OF UUO

TTCL6A:	ANDI D,177777		;CLEAR UNIVERSAL I/O INDEX BITS
	DVCHR			;GET TTY CHARACTERISTICS
	HRLI C,0		;GET JUST LINE #
	CAMN C,D		;IS THIS OUR LINE BEING ASKED ABOUT
	  JRST TTCL6B		;YES
	MOVE C,D		;GET LINE # TO BE CHECKED
	CAML C,FIRPTY		;IS THIS A PTY LINE?
	  TLO C,(1B0)		;YES, REMEMBER THAT
	HRRZ A,D		;SET UP TTY DEVICE DESIGNATOR
	TRO A,400000		;...
	JRST TTCL6C		;GO GET CHARACTERISTICS
TTCL7:	PUSHJ P,TBOUND		;CHECK ARGUMENT
	RFMOD			;GET CHARACTERISTICS OF TERMINAL
	UMOVE C,0(C)		;GET USER'S DESIRED BITS
	TLNE C,(1B13)		;WANT LOWER CASE?
	  TLOA B,(1B3)		;YES.
	TLZA B,(1B3)		;NO.
	  TRZA B,1B31		;YES, CLEAR CONVERSION BIT ALSO
	TRO B,1B31		;NO, SET CONVERSION FROM LOWER TO UPPER CASE
	TLNE C,(1B14)		;WANT TABS?
	  TLOA B,(1B2)		;YES
	TLZ B,(1B2)		;NO
	TLNE C,(1B15)		;WANT ECHO?
	TROA E,IO.SUP		;YES. TURN IT ON.
	TRZ E,IO.SUP		;CLEAR NO-ECHO IN INIT
	TLNE C,(1B16)		;TAPE MODE ON?
	TLOA E,TT.XON		;YES, SET FLAG IN STATUS WORD
	TLZ E,TT.XON		;NO, CLEAR FLAG
	SFMOD			;GIVE TO MONITOR
	STPAR			;SET THOSE BITS NOT CONTROLED BY SFMOD
	JRST TTPSTS		;GO SET UP NEW MODE, AND RETURN

TTCL10:	SKIPG B,OTTCNT		;WAS THERE A LINE TYPED IN?
	  JRST TCL10A		;NO, GIVE SKIP RETURN
	MOVEM B,TTCNT		;YES, SET UP TTCNT
	PUSHJ P,TTBRK		;GO SET UP TTPNT AND TTLINE
	POPJ P,

TCL10A:	SETZ A,			;DO THE RESCAN
	RSCAN			;ONLY IF FIRST TIME THROUGH
	  JFCL			;DONT CARE IF NOT IMPLEMENTED
	MOVEI A,PRIJFN		;SET UP JFN AGAIN
	PUSHJ P,TTFILL		;GO READ IN CHARACTERS IF ANY
	JFCL
	HRROI A,[0]		;NOW CLEAR THE RESCAN BUFFER
	RSCAN
	  JFCL			;DONT CARE AGAIN IF NOT IMPLEMENTED
	SKIPLE TTCNT		;ANY CHARACTERS READY
	  POPJ P,		;YES, THERE IS DATA THERE
	MOVE A,FORTY		;SEE IF USER WANTS SKIP RETURN
	TRNE A,1		;IF BIT 35 IS ON,
	  JRST CPOPJ1		; THEN SKIP RETURN
	POPJ P,
INTTY:	MOVE A,JFNTAB(BB)	;GET JFN OF TTY
	MOVE E,FLAGWD(BB)	;AND FLAGS FOR TTY
	TLNE E,TT.CTY		;IS THIS THE CONTROLING TTY
	  MOVE E,TYSTAT		;YES, GET CORRECT FLAGS
	PUSHJ P,NOCTRO		;CLEAR CONTROL-O
	TLZ E,TT.BKE		;CLEAR BREAK ON EVERYTHING
	TRNE E,IO.BIN		;IN BINARY MODE?
	  PUSHJ P,TTSETB	;YES, GO SET TT.BIN
	TRNN E,IO.BIN		;IN BINARY MODE?
	  PUSHJ P,TTCLRB	;NO, CLEAR BINARY MODE
	PUSHJ P,TTYSTS		;SET UP TTY STATUS MODE
	TLNE E,TT.CTY		;IS THIS THE CONTROLING TTY?
	  JRST INCTY		;YES, HANDLE IT SPECIALLY
	TDNE E,[TT.BIN!TT.BKE,,IO.FCS]
	  JRST INTTYB		;CANNOT USE RDTXT, USE BIN
	MOVE A,JFNTAB(BB)	;GET JFN OF TTY
	HRLS A			;IN BOTH HALVES
	MOVE B,IOBPT		;GET POINTER TO USER'S BUFFER
	MOVE C,IOCNT		;AND COUNT OF CHARACTERS IN BUFFER
	HRLI C,(RD%TOP!RD%JFN)
	PUSHJ P,DORDTX		;GO READ IN A LINE
	MOVEM B,IOBPT		;STORE UPDATED BYTE POINTER
	HRRZM C,IOCNT		;AND COUNT OF CHARACTERS LEFT IN BUFFER
	JRST INTTY9		;RETURN TO USER

INTTYB:	SOSGE IOCNT		;ANY MORE ROOM IN BUFFER
	  JRST INDON1		;NO
	MOVE A,JFNTAB(BB)	;GET JFN
	PUSHJ P,TTYBIN		;GET A CHARACTER
INTTB1:	IDPB B,IOBPT		;STORE IT IN THE BUFFER
	TLNE E,TT.BIN		;IN BINARY MODE?
	  JRST INTTB2		;YES
	CAIN B,C.EOF		;END OF FILE?
	  JRST INTTY8		;YES, GO SET EOF
INTTB2:	HRRZ A,DEVNUM(BB)	;GET UNIT NUMBER
	TRO A,400000		;MAKE TTY DEV DESIGNATOR
	SIBE			;ANY MORE CHARACTERS?
	  JRST INTTYB		;YES, GO READ THEM IN
	JRST INTTY9		;NO, RETURN TO USER

INCTY:	SOSGE IOCNT		;ANY MORE ROOM?
	  JRST INDON1		;NO
	PUSHJ P,TTPGET		;GET A CHARACTER FROM CONTROLING TTY
	IDPB B,IOBPT		;STORE IT IN BUFFER
	TLNE E,TT.BIN		;BINARY MODE
	JRST INCTY1		;YES, DONT TRANSLATE ^Z
	CAIN B,C.EOF		;CONTROL-Z?
	  JRST INTTY8		;YES, SET EOF
INCTY1:	SKIPLE TTCNT		;ANY MORE CHARACTERS
	  JRST INCTY		;YES, LOOP BACK FOR THEM
	JRST INTTY9		;NO, RETURN TO USER
DORDTX:	IJSYS (RDTXT)		;READ IN A LINE
	  PUSHJ P,BUGSTP	;ERROR, SHOULD NEVER HAPPEN
	POPJ P,			;RETURN TO CALLER

TTYBIN:	CAIN A,PROJFN		;IS IT PRIMARY OUTPUT?
	MOVEI A,PRIJFN		;YES. MAKE PRIMARY INPUT.
	SKIPE CSTFLG		;^C BEEN TYPED
	  JRST CCTRAP		;YES, DONT GO INTO INPUT WAIT
	IJSYS (BIN)		;GET THE CHAR FROM TTY
NOCTRO:	TLNN E,TT.CTY		;IS THIS THE CONTROLING TTY
	  POPJ P,		;NO, CONTROL-O NO SUPPORTED ON OTHER LINES
	PUSH P,B		;SAVE CHARACTER
	RFMOD			;GET MODE WORD
	TLZE B,(1B0)		;IS CONTROL-O IN EFFECT?
	SFMOD			;YES, CLEAR IT
	POP P,B			;RESTORE CHARACTER
	POPJ P,			;RETURN

;ASCII OUTPUT ROUTINES
OUTTTY:	LDB B,[POINT 4,FLAGWD(BB),35]	;IO MODE
	CAIL B,10		;BINARY?
	JRST OUTTTB		;YES.
	MOVE E,FLAGWD(BB)	;SET UP MODE WORD
	TLNE E,TT.CTY		;IS THIS THE CONTROLING TTY?
	  MOVE E,TYSTAT		;YES, GET CORRECT FLAG WORD
	PUSHJ P,TTCLRB		;CLEAR BINARY MODE IF ON
	TLNN E,TT.CTY		;IS THIS THE CONTROLING TTY
	  MOVEM E,FLAGWD(BB)	;NO, STORE NEW FLAG WORD
OUTTTL:	SOSGE IOCNT		;COUNT DOWN THE BYTES
	POPJ P,0		;NO MORE IN BUFFER
	XCTLB <ILDB B,IOBPT>	;GET ANOTHER BYTE FROM USER BUFFER
	SKIPE B			;DONT OUTPUT NULLS
	PUSHJ P,TTYBOU		;OUTPUT THE BYTE, CHECK ^O, INDICATE.
	JRST OUTTTL		;LOOP FOR MORE FROM BUFFER

OUTTTB:	RFMOD			;GET FILE MODE
	PUSH P,B		;SAVE IT
	TRZ B,3B29		;SET TO BINARY FOR OUTPUT
	SFMOD			; ..
OUTTBL:	SOSGE IOCNT		;COUNT OF BYTES
	JRST OUTTTX		;DONE
	XCTLB <ILDB B,IOBPT>	;GET A BYTE
	PUSHJ P,TTYBO1		;DO THE BOUT AT COMMON PC
	JRST OUTTBL		;LOOP THRU BUFFER
OUTTTX:	POP P,B			;GET BACK OLD TTY MODE
	SFMOD
	POPJ P,0

OUTASC:	SOSGE IOCNT		;COUNT BYTES
	POPJ P,			;NO MORE IN BUFFER
	XCTLB <ILDB B,IOBPT>	;FETCH BYTE FROM BUFFER, PTR IN HEADER
	JUMPE B,OUTASC		;IGNORE NULLS
	BOUT			;OUTPUT TO FILE.
	JRST OUTASC

;ROUTINES FOR SETTING AND CLEARING BINARY MODE STATE
;	CALL WITH JFN IN A

TTCLRB:	TLZN E,TT.BIN		;IN BINARY MODE?
	POPJ P,			;NO, DO NOTHING
	TLNN E,TT.CTY		;IS THIS THE CONTROLING TTY?
	  POPJ P,		;NO, DONT STORE TERMINAL INTERRUPT WORD
	PUSH P,A		;SAVE JFN
	MOVNI A,5		;FOR WHOLE JOB...
	SKIPE B,SAVTIW		;GET OLD TERMINAL INTERRUPT WORD
	STIW			;RESTORE IT
	SETZM SAVTIW		;CLEAR OLD INTERRUPT WORD
	POP P,A			;RESTORE JFN
	JRST TTPSTS		;GO SET UP NEW STATUS MODE

TTSETB:	TLOE E,TT.BIN		;BINARY MODE ALREADY IN EFFECT?
	  POPJ P,		;YES, DO NOTHING
	TLNN E,TT.CTY		;IS THIS THE CONTROLING TTY
	  POPJ P,		;DONT STORE TERMINAL INT WORD
	PUSH P,A		;SAVE JFN
	PUSHJ P,SETCCE		;ENABLE TO INTERRCEPT CONTROL C'S
	  JRST TTSTB1		;CONTROL-C ENABLING IS NOT ALLOWED
	MOVNI A,5		;GET TIW FOR WHOLE JOB
	RTIW
	MOVEM B,SAVTIW		;SAVE THIS STATE
	SETZ B,
	STIW			;TURN OFF ALL INTERRUPT WORDS
TTSTB1:	POP P,A			;RESTORE JFN
	JRST TTPSTS		;GO SET UP NEW MODE
;THE COMPT. UUO
;THIS UUO ALLOWS FILE WITH NAMES LONGER THAN 6 CHARACTERS TO BE
;CREATED AND READ FROM TOPS-10 PROGRAMS THROUGH THE COMPATIBILITY
;PACKAGE.
;CALLING SEQUENCE:
;	MOVE AC,[COUNT,,ADR]
;	CALLI AC,147
;	  ERROR RETURN  (AC UNCHANGED MEANS USE NORMAL FILE UUOS
;			 OTHERWISE AC CONTAINS AN ERROR CODE)
;	SUCCESSFUL RETURN

COMPT.:	HLRE C,CAC		;GET COUNT
	JUMPL C,CMPTE1		;IT MUST BE POSITIVE
	XCTUM <HRRE A,0(CAC)>	;GET THE FUNCTION CODE
	JUMPLE A,CMPTE1		;FIRST LEGAL FUNCTION IS 1
	CAILE A,COMPTL		;SEE IF WITHIN DEFINED BOUNDS
	  JRST CMPTE1		;NO, RETURN ERROR CODE
	HLRZ B,COMPTT-1(A)	;GET REQUIRED ARGUMENT COUNT
	CAMLE B,C		;DOES USER HAVE ENOUGH ARGUMENTS?
	  JRST CMPTE1		;NO
	HRRZ A,COMPTT-1(A)	;GET DISPATCH
	JRST (A)		;AND DO SO

COMPTT:	10,,COMPT1		;FUNCTION 1, OPEN, LOOKUP, AND ENTER
	3,,COMPT2		;FUNCTION 2, RENAME
	3,,COMPT3		;FUNCTION 3, PPN TO DIRECTORY
	3,,COMPT4		;FUNCTION 4, RUN
	3,,COMPT5		;FUNCTION 5, JFNS
	2,,COMPT6		;FUNCTION 6, SET UP PSI CHANNEL
	3,,COMPT7		;FUNCTION 7, ERSTR
	1,,COMP10		;FUNCTION 10, GET JFN OF CHANNEL
	0,,COMP11		;FUNCTION 11, COMMIT SUICIDE AND RETURN
	COMPTL==.-COMPTT	;END OF DEFINED FUNCTIONS

COMPT1:	XCTUM <HLRZ AC,0(CAC)>	;GET THE CHANNEL NUMBER
	CAILE AC,17		;CHECK IT FOR LEGALITY
	  JRST CMPTE1		;MUST BE AN AC FIELD
	UMOVE A,7(CAC)		;GET POINTER TO LOOKUP BLOCK
	HRRM A,FORTY		;PUT IN FORTY FOR SETDAT
	PUSHJ P,SETUPG		;SET UP BB
	  SKIPA			;THIS CHANNEL NOT ALREADY INITED
	 PUSHJ P,URELR		;ALREADY INITED, RELEASE THIS CHANNEL
	XCTUM <HRRZ A,4(CAC)>	;GET THE MODE
	HRRZM A,FLAGWD(BB)	;INITIALIZE FLAGS
	XCTUM <HRR A,5(CAC)>	;GET POINTER TO INPUT BUFFER HEADER
	XCTUM <HRL A,6(CAC)>	;GET POINTER TO OUTPUT BUFFER HEADER
	MOVEM A,BUFHTB(BB)	;STORE OBUF,,IBUF
CMPT1C:	MOVEI A,10		;ADDR+10 AND 11 ARE GTJFN RETURN LOCS
	PUSHJ P,COMPTG		;DO A GTJFN FOR USER
	  JRST [JUMPE A,MRETN	;TOPS-10 PACK
		JRST CMPTE2]	;GO RETURN ERROR CODE
	MOVEM A,JFNTAB(BB)	;SAVE JFN
	UMOVE B,1(CAC)		;GET GTJFN BITS
	TLNE B,(1B17)		;SHORT OR LONG FORM?
	JRST CMPT1A		;SHORT, HAVE FLAGS
	UMOVE B,(B)		;LONG, GET FLAGS
CMPT1A:	TLNE B,(1B12)		;GJ%OFG? (PARSE)
	JRST CMPT1D		;IF PARSE ONLY, RETURN TO USER NOW
	DVCHR			;GET DEVICE DESIGNATOR
	MOVEM A,DEVNUM(BB)	;SAVE DEVICE DESIGNATOR
	PUSHJ P,UOPENF		;GO DO OPEN STUFF
	  JRST [MOVE A,JFNTAB(BB) ;ERROR, RELEASE JFN
		RLJFN
		  JFCL
		SETZM JFNTAB(BB)
		JRST MRETN]	;GIVE ERROR RETURN
	JRST CMPT1B		;DISK OR DTA
	CAIE AA,PTY		;IS IT A PTY?
	  JRST CMPT1B		;NO
	PUSHJ P,PTYSTF		;GO INITIALIZE THE PTY
	  SKIPA			;ERROR
	JRST MRETN2		;OK, RETURN TO USER
	PUSHJ P,URELJ		;CLEAN UP AFTER ERROR
	JRST MRETN
CMPT1B:	HRROI A,STRNG1		;GET DEVICE NAME
	HRRZ B,JFNTAB(BB)	;GET JFN
	MOVSI C,(1B2)		;GET DEVICE NAME
	JFNS
	PUSHJ P,SEVN26		;MAKE IT SIXBIT
	MOVEM A,DEVNAM(BB)	;STORE IT FOR DEVCHR AND OTHER UUO'S
	HRROI A,STRNG1		;NOW GET EXT
	HRRZ B,JFNTAB(BB)	;FOR ENTER
	MOVSI C,(1B11)
	JFNS
	PUSHJ P,SEVN26		;GET SIXBIT EXT
	MOVEM A,EXT(BB)		;NEEDED BY ENTFIN
	TRO PF,R.UEXT		;MARK THAT THIS IS AN EXTENDED CALL
	MOVE A,JFNTAB(BB)	;GET JFN
	UMOVE G,7(CAC)		;SET UP POINTER TO ARGUMENT BLOCK
	UMOVE B,3(CAC)		;GET OPEN BITS
	JUMPE B,CMPT1L		;IF 0 ASSUME LOOKUP WITHOUT OPEN
	TRNN B,1B19		;WANT TO READ THE FILE?
	  JRST CMPT1F		;NO. GO CHECK ENTER.
	PUSHJ P,ULKOP0		;YES, GO DO LOOKUP STUFF
	 SKIPA			;ERROR DURING LOOKUP
	JRST CMPT1F		;SEE IF ENTER IS ALSO BEING DONE
	UMOVE B,3(CAC)		;GET BACK OPEN BITS AGAIN
	TRNE B,1B20		;WANT TO ENTER FILE?
	CAIE A,OPNX2		;GOT A FILE NOT FOUND ERROR?
	JRST CMPTE2		;NO. GIVE ERROR MSG.
	JRST CMPT1G		;YES. DO OPEN ANYHOW.
CMPT1F:	UMOVE B,3(CAC)		;GET BACK OPEN BITS.
	TRNN B,1B20
	  JRST MRETN2		;NO, THEN ALL DONE
CMPT1G:	PUSHJ P,OPENX		;GO DO THE OPENING
	  JRST [PUSHJ P,WARN	;ERROR DURING OPEN, SEE IF OVER QUOTA
		  JRST CMPTE2	;NO, RETURN ERROR CODE TO USER
		HRRZ A,JFNTAB(BB)
		RLJFN		;RELEASE JFN
		  JFCL
		SETZM JFNTAB(BB)
		JRST CMPT1C]	;GO TRY AGAIN
	JRST ENTFIN		;GO SET DATE AND FINISH UP

CMPT1D:	SETOM DEVNAM(BB)	;THIS WILL ALLOW COMPT. UUOS LATER
	JRST MRETN2		;RETURN SUCCESS

CMPT1L:	PUSHJ P,ULKOP1		;DONT OPEN JFN
	  JRST CMPTE2		;ERROR DURING OPENF
	JRST MRETN2

COMPT2:	HLLOS FORTY		;NO LOOKUP BLOCK POINTER
	XCTUM <HLRZ AC,0(CAC)>	;SET UP CHANNEL NUMBER
	PUSHJ P,SETUP		;SET UP AA AND BB
	MOVEI A,3		;ADDR+3 AND 4 ARE GTJFN RETURN LOCS
	PUSHJ P,COMPTG		;DO THE GTJFN
	  JRST [JUMPE A,MRETN	;TOPS-10 PACK
		JRST CMPTE2]	;STORE ERROR CODE
	PUSHJ P,URENAM		;GO DO THE RENAME
	  JRST CMPTE2		;FAILED
	JRST MRETN2		;SUCCESSFUL

COMPT4:	PUSHJ P,RRESET		;RESET ALL CHANNELS
	TRO PF,R.RUNU		;MARK THAT A RUN IS BEING DONE
	MOVEI A,4		;ADDR+4 AND 5 ARE GTJFN RETURN LOCS
	PUSHJ P,COMPTG		;DO GTJFN
	  JRST [JUMPE A,MRETN	;TOPS-10 PACK
		XCTUM <HLRZ B,@MONUPC>
		CAIN B,(JRST 4,) ;IS NEXT INST A HALT?
		JRST RUNFA1	;YES, GO TYPE OUT MESSAGE
		JRST CMPTE2]	;RETURN ERROR CODE
	MOVEM A,JFNTAB		;SAVE JFN
	HRROI A,STRNG1		;GET NEW PROGRAM NAME
	HRRZ B,JFNTAB
	MOVSI C,(1B8)		;JUST ITS NAME
	JFNS
	PUSHJ P,SEVN26		;TRANSLATE IT TO SIXBIT
	MOVE B,A		;PUT NAME IN B
	SETZM MTDUMP		;CLEAR OFFSET
;****** NEXT INSTRUCTION TO KEEP PROGRAMS WORKING
;****** UNTIL PAT FIGURES OUT WHAT TO DO ABOUT OFFSETS
	AOS MTDUMP		;DO START+1 IF NO OFFSET GIVEN
;****** 
	HLRZ C,CAC		;GET COUNT
	CAIGE C,4		;GIVING AN OFFSET?
	JRST CMPRUN		;NO, GO DO RUN
	UMOVE C,3(CAC)		;GET OFFSET
	MOVEM C,MTDUMP		;STORE OFFSET
	JRST CMPRUN		;ENTER RUN CODE

COMPTG:	MOVEM A,STRRET		;SAVE INDEX FOR RETURNING GTJFN INFO
CMPTG3:	UMOVE A,1(CAC)		;GET AC1 BITS FOR GTJFN
	TLNN A,(1B17)		;SHORT OR LONG FORM?
	  JRST [UMOVE A,(A)	;LONG FORM, GET FLAGS
		JRST .+1]
	TLNE A,(1B16)		;STRING POINTER IN AC2?
	  JRST [UMOVE A,1(CAC)	;NO, SET UP FOR STRAIGHT GTJFN
		UMOVE B,2(CAC)
		JRST CMPTG1]	;GO DO GTJFN
	UMOVE A,2(CAC)		;GET STRING POINTER
	PUSHJ P,STPARS		;GO SET UP DECODED STRING IN STRNG1
	  PUSHJ P,CMPTG5	;ERROR PARSING, USE ORIGINAL STRING
	UMOVE A,1(CAC)		;GET AC1 BITS
	HRROI B,STRNG1		;USE TRANSLATED STRING AS MAIN STRING
CMPTG1:	GTJFN			;GET A JFN FOR THIS FILE
	  JRST [PUSHJ P,WARN	;SEE IF DIRECTORY FULL
		  JRST CMPTG2	;NO, FIXUP POINTERS AND RETURN ERROR TO USER
		JRST CMPTG3]	;YES, GO TRY AGAIN
	AOS (P)			;GIVE SUCCESSFUL RETURN WITH JFN IN A
;RETURN GTJFN STRING AND POINTER TO IT
CMPTG2:	PUSH P,A
	PUSH P,B
	PUSH P,C
	HLRZ B,CAC		;GET COUNT OF ARGS
	SUB B,STRRET		;COMPARE WITH RETURN LOC OFFSET
	CAIGE B,2		;2 ARGS TO RETURN
	JRST CMPTG4
	MOVE B,CAC
	ADD B,STRRET		;GET POINTER TO USER ARG
	UMOVE B,(B)		;GET IT
	JUMPE B,CMPTG4		;DON'T RETURN IF 0
	LDB A,-1(P)		;GET CHARACTER POINTER POINTS AT
	PUSH P,A		;SAVE IT
	SETZ A,
	DPB A,-2(P)		;CLOBBER IT TO A NULL
	MOVE A,CAC
	ADD A,STRRET		;CALC INDEX OF USERS RETURN STRING POINTER
	UMOVE A,(A)		;GET STRING POINTER
	HRROI B,STRNG1		;THIS IS STRING WE WILL RETURN
	SOUT			;ADVANCE USER POINTER TO CHARACTER IN QUESTION
	IBP A			;MAKE IT POINT AT CHARACTER
	MOVEI B,1(CAC)
	ADD B,STRRET		;WHERE TO RETURN POINTER
	UMOVEM A,(B)		;GIVE IT TO USER
	POP P,A
	DPB A,-1(P)		;PUT ORIGINAL CHAR BACK
	MOVE A,CAC
	ADD A,STRRET		;CALC INDEX OF USERS RETURN STRING POINTER
	UMOVE A,(A)		;GET STRING POINTER
	HRROI B,STRNG1
	SETZ C,
	SOUT			;THIS TIME MOVE WHOLE STRING
	MOVE B,CAC
	ADD B,STRRET
	UMOVEM A,(B)		;RETURN END OF STRING TO USER
CMPTG4:	POP P,C
	POP P,B
	POP P,A
	POPJ P,			;FIXUP POINTERS HERE LATER

CMPTE1:	MOVEI A,-1		;SET UP ERROR RETURN
CMPTE2:	LDB AC,ACPTR		;SET AC UP AGAIN
	JRST STOTAC

CMPTG5:	UMOVE A,2(CAC)		;GET USER STRING POINTER
	HRROI B,STRNG1
	SETZ C,
	SIN			;MOVE USER STRING TO BUFFER
	POPJ P,			;GO DO GTJFN WITH IT
;THIS ROUTINE PARSES A FILE NAME TYPED IN AND RETURNS A VIROS
;FILE SPEC IN STRING1.

;FIRST DEFINE SOME PARAMETERS

SP0==0				;STACK OFFSET FOR MAIN STRING PONTER
CNT0==-1			;COUNT OF CHARACTERS IN MIN STRING
SP1==-2				;POINTER TO STRING AFTER PPN
SPD==-3				;STRING POINTER TO DEVICE
CNTD==-4			;COUNT OF CHARACTERS IN DEVICE
DESIG==-5			;DEVICE DESIGNATOR
CELLS==6			;WORDS OF STACK SPACE NEEDED


STPARS:	TLC A,-1		;SEE IF -1 IN LEFT HALF
	TLCN A,-1
	  HRLI A,(POINT 7,0)	;YES, SET IT UP CORRECTLY
	MOVE C,A		;SAVE STRING POINTER
	MOVEI B,CELLS		;WORDS OF STACK NEEDED
	PUSH P,[0]		;RESERVE IT
	SOJG B,.-1		;GET EM ALL
	MOVEM A,SPD(P)		;SAVE POTERNTIAL DEVICE POINTER
LOKDEV:				;LOOK FO DEVICE FIELD
	ILDB B,A		;GET NEXT BYTE
	CAIN B,":"		;THIS IT?
	JRST DIRLOK		;YES. GO PROCESS IT
	SOS CNTD(P)
	SKIPE B			;AT STRING END?
	JRST LOKDEV		;NO. DO MORE LOOKING
	SETZM CNTD(P)		;YES. BLOT OUT DEVICE COUNT
	MOVE A,C		;AND RESTORE POINTER
;THIS CODE LOOKS FOR THE PPN OR DIRECTORY NUMBER

DIRLOK:	MOVEM A,SP0(P)		;PREFIXING STRING STRT
DIRLK:	ILDB B,A		;GET NEXT BYTE
	CAIE B,"<"		;START OF PPN FIELD?
	CAIN B,"["		;OR THIS TOO?
	JRST COPY0		;YES. GO FIND IT ALL
	JUMPE B,WHOLE		;NO; ATSTRING END?
	SOS CNT0(P)		;NO. BUMP COUNT OF THIS FILED
	JRST DIRLK		;AND GO DO MORE
COPY0:	MOVE C,[POINT 7,DIRNAM]
FND1:	ILDB B,A		;GET PPN TO STRNG2 FOR ANALYSIS
	JUMPE B,FOUND1		;IF AT END WE GOT IT
	CAIE B,">"		;FIELD TERMINATOR?
	CAIN B,"]"		;""""
	JRST FOUND		;YES. AT THE END
	CAIE B,15		;CARRAIGE RETURN AND
	CAIN B,12		;LINE FEED MAY ALSO END PPN
	JRST FND12		;
	IDPB B,C		;SAVE BYTE
	JRST FND1		;AND DO ALL OF PNNN

FND12:	ADD A,[070000,,]	;BACKUP BYTE POINTER
FOUND:	MOVEM A,SP1(P)		;SAVE TERMINATING STRING START
FOUND1:	SETZ B,
	IDPB B,C		;TIE OFF DRECTORY OR PPNM
	MOVE C,SPD(P)		;NOW GET STR:<DIR> INTO STRNG1
	MOVE B,[POINT 7,STRNG1]
FOUND2:	ILDB A,C		;GET A CHARACTER
	IDPB A,B		;STORE IT INTO STRNG1
	CAIE A,">"		;FINISHED?
	CAIN A,"]"		;...
	JRST FOUND3		;YES
	JUMPN A,FOUND2		;IF NOT NULL, LOOP BACK
FOUND3:	MOVEI A,0		;TIE OFF STRING
	IDPB A,B
;NOW ANALYZE DIR OR PPN NAME IN STRNG1 AND DETERMINE ITS VIROS
;DIRECTORY NUMBER

	MOVX A,RC%EMO		;NO RECOGNITION
	HRROI B,STRNG1		;GET POINTER TO STR:<DIR>
	RCDIR			;GET DIR NUMBER
	 ERJMP NODIR0		;FAILED, GO SEE IF PPN
	TXNE A,RC%NOM!RC%AMB
	JRST NODIR0		;FAILED IN ANOTHER WAY
	MOVE A,C		;GET DIR NUMBER INTO A

;WAS A LEGAL DIRECTORY. CAN BUILD FILE NAME NOW


DODIR:	MOVE B,[POINT 7,STRNG1]
	MOVE D,A		;SAVE DIR NUMBER
FAKES:	EXCH A,B		;SET UP FOR DIRST
	MOVE D,A		;SAVE BYTE POINTER
	DIRST			;GET STR:<DIR>
	 MOVE A,D		;FAILED, GET BACK STRING POINTER
	MOVE B,A		;GET STRING POINTER INTO B
	JRST WHOLE1		;SKIP NEXT DEVCPY CALL

WHOLE:	MOVE B,[POINT 7,STRNG1]
	SETZ D,			;NO DIRECTORY
	JSP E,DEVCPY		;COPY DEVICE IF NOT ALREADY DONE
WHOLE1:	MOVE A,SP0(P)		;PREFIXING STRING
	SKIPE C,CNT0(P)		;ANYTHING THERE?
	SIN			;YES. DO IT
	MOVE A,SP1(P)		;TERMINATING STRING
	JUMPE A,FNAL		;IF NONE THERE, DONE
	SETZ C,			;UNTIL THE END
	SIN
	SETZ A,
FNAL:	IDPB A,B		;FINAL CHARACTER
	MOVE A,DESIG(P)		;RETURN DEVICE DESIGNATOR
	SUB P,[CELLS,,CELLS]	;FAST POP
	JRST CPOPJ1		;AND DONE
;COPY DEVICE NAME IF PERTINENT
DEVCPY:	HRROI A,[ASCIZ /DSK/]	;DEFAULT DEVICE
	PUSH P,B
	STDEV			;GET DESIG OF DSK
	 JFCL			;MUST BE A DSK
	POP P,A
	MOVEM B,DESIG(P)	;STASH AWAY DESIGNATOR
	MOVE B,A
	SKIPN C,CNTD(P)		;A COUNT?
	JRST 0(E)		;NO. GO BACK
	SETZM CNTD(P)		;WILL BE NONE FROM NOW ON
	MOVE A,SPD(P)		;POINTER
	SIN			;COPY IT
	PUSH P,B		;SAEV B AGAIN
	SETZ A,
	IDPB A,B		;TIE OFF DEVICE STRING
	HRROI A,STRNG1
	STDEV			;GET DESIG OF THIS DEVOCE
	 JRST UHOH		;NOT A REAL DEVICE
	POP P,A
	MOVEM B,DESIG(P)	;RETURN DEVICE DEVICE DESIG
	MOVE B,A
	MOVEI A,":"		;PUT : BACK ON FOR DEVICE NAME
	IDPB A,B
	JRST 0(E)		;AND GO BACK

UHOH:	MOVE A,STRNG1		;NOT A REAL DEVICE. SEE IF SYS
	TRZ A,377		;CLEAR OUT CRUFT IN LAST CHARACTER SLOT
	CAME A,[ASCIZ /SYS/]	;WELL, IS IT?
	JRST NOSYS		;NOPE.
	POP P,B			;GET ABCK SP
	MOVE B,[POINT 7,STRNG1]	;GO BACK TO START OF BUFFER
	SKIPE D			;DEVICE OUT THERE?
	JRST DEVCPY		;ALREADY A DIRECTORY. JYST FAKE IT
	MOVX A,RC%EMO		;NO RECOGNITION
	MOVE D,B		;SAVE B
	HRROI B,[ASCIZ /PS:<SUBSYS>/] ;SYS IS SUBSYS BY DEFAULT
	RCDIR
	TXNE A,RC%NOM!RC%AMB	;IS IT THERE?
	MOVEI C,0		;NO
	MOVE B,D
	MOVE D,C		;DIR NUMBER TO D
	JRST FAKES		;AND FAKE OUT EVERYBODY

NOSYS:	POP P,(P)		;THROW AWAY POINTER
IFN FTFILSER,<		;DONT DO DPA'S IF NO FILSER
	SETZ A,			;COLLECT SIXBIT DEVICE NAME HERE
	MOVE B,[POINT 6,A]
	MOVE C,[POINT 7,STRNG1]
BGLOOP:	ILDB D,C		;GET  BYTE
	JUMPE D,CALIT		;IF AT THE END GO LOOK FOR DPA
	SUBI D,40		;MAKE IT SIXBIT
	IDPB D,B		;STASH IT AWAY
	TLNE B,770000		;PUT IN SIX?
	JRST BGLOOP		;NO. GO GOBBLE MORE
CALIT:	PUSHJ P,DPACHK		;SEE IF A DPA
>				;END OF FTFILSER CONDITIONAL
	SKIPA A,[0,,GJFX16]	;NO. BAD
	SETZ A,			;YES. GOOD
	SUB P,[CELLS,,CELLS]
	POPJ P,			;DONE
;WAS NOT A VIROS DIRECTORY NAME. TRY A PPN

NODIR0:	PUSH P,[0]
	PUSH P,[0]		;FOR PPN STORAGE
	HRROI A,DIRNAM
	MOVEI C,10		;OCTAL NUMBERS
	NIN			;GET A NUMBER
	 JRST	[LDB B,A	;GET TERMINATOR
		 CAIE B,"-"	;DEFAULT?
		 JRST DO2	;NO, USE NULL FOR FIRST
		 IBP A		;ADVANCE OVER "-"
		 JRST DFLT]	;YES
	MOVEM B,(P)		;SAVE CONVERTED NUMBER
DO2:	LDB B,A			;GET TERMINATOR
	CAIE B,","		;LEGAL SEPERATOR?
	JRST ERR		;NO
	NIN			;NEXT NUMBER
	 CAIA			;DON'T STORE B IF NO NUMBER READ
	MOVEM B,-1(P)		;SAVE VALUE
DFLT:	LDB B,A			;GET TERMINATOR
	JUMPN B,ERR		;LOSE IF WHOLE STRING NOT EATEN
	GJINF			;GET DIR
	MOVE A,B		;CONNECTED
	PUSHJ P,PPNUNM		;CONVERT IR
	POP P,B			;GET TOP VALUE
	SKIPE B			;ANYTHING THER4?
	HRLI A,(B)		;YES. USE IT
	POP P,B			;NEXT VALUE
	SKIPE B
	HRRI A,(B)		;USE THIS IF THERE
	MOVE B,SPD(P)		;GET POINTER TO STR:<DIR>
	SKIPN CNTD(P)		;IS THERE A DEVICE STRING?
	HRROI B,[ASCIZ/DSK:/]	;NO, ASSUME DSK:
	PUSHJ P,PPN2DR		;GO GET A DIR NUMBER FROM PPN
	  JRST ERR1		;NO CONVERSION
	JRST DODIR		;MADE IT. GO OFF

ERR:	SUB P,[2,,2]
ERR1:	MOVE A,SP0(P)
	MOVEM A,SP1(P)
	SETZM CNT0(P)
	JRST WHOLE
COMPT3:	XCTUM <SKIPN A,1(CAC)>	;GET PPN IF ANY
	  JRST CMPT3A		;NONE
	CAIGE C,4		;FOR THIS DIRECTION, MUST HAVE 4 ARGS
	  JRST CMPTE1		;ELSE ARG ERROR
	UMOVE D,3(CAC)		;GET POINTER TO STR NAME STRING
	HRROI E,DEVNM7		;GET OUTPUT STRING POINTER
	PUSHJ P,SIXTO7		;CONVERT SIXBIT DEV NAME TO ASCIZ
	HRROI B,DEVNM7		;NOW CONVERT PPN TO DIR NUMBER
	UMOVE A,1(CAC)		;GET PPN AGAIN
	PUSHJ P,PPN2DR		;GET DIR NUMBER
	  JRST CMPT3E		;NONE
	MOVE B,A		;NOW TURN IT INTO A STRING
	UMOVE A,2(CAC)		;GET STRING POINTER
	DIRST
	  JRST CMPT3E		;ERROR
	UMOVEM A,2(CAC)		;STORE UPDATED STRING POINTER
	JRST MRETN2		;ALL DONE

CMPT3A:	UMOVE B,2(CAC)		;GET STRING POINTER
	MOVX A,RC%EMO		;NO RECOGNITION
	RCDIR			;GET DIR NUMBER
	 ERJMP CMPT3E		;FAILED
	TXNE A,RC%NOM!RC%AMB	;FOUND ONE?
	JRST CMPT3E		;NO
	UMOVEM B,2(CAC)		;STORE UPDATED STRING POINTER
	MOVE A,C		;GET DIR NUMBER IN A
	PUSHJ P,PPNUNM		;GET A PPN FROM DIR NUMBER
	UMOVEM A,1(CAC)		;RETURN PPN IN ARG BLOCK
	JRST MRETN2

CMPT3E:	MOVEI A,1
	JRST STOTAC		;GIVE NON-SKIP RETURN WITH ERROR 1

COMPT5:	XCTUM <HLRZ AC,0(CAC)>	;SET UP CHANNEL NUMBER
	CAILE AC,17		;LEGAL CHANNEL NUMBER?
	  JRST CMPTE1		;NO
	PUSHJ P,SETUP		;SET UP BB AND AA
	UMOVE A,1(CAC)		;GET STRING POINTER
	SKIPG B,JFNTAB(BB)	;GET JFN
	  JRST MRETN		;NO JFN, GIVE ERROR RETURN
	HRRZS B			;CLEAR OUT WILD CARD FLAGS
	UMOVE C,2(CAC)		;GET FLAGS
	JFNS			;DO THE JFN
	JRST MRETN2		;SUCCESSFUL


;COMPAT FUNCTION 6 - SET UP A PSI CHANNEL
;ACCEPTS IN ARG/	LEVEL # ,, LOCATION TO TRAP TO
;	    ARG+1/	PSI CHANNEL # ,, ADR OF PLACE TO STORE PC
;			ARG = 0 MEANS REMOVE PSI CHANNEL IN ARG+1

COMPT6:	XCTUM <HRRZ A,1(CAC)>	;GET TRAP ADDRESS
	PUSHJ P,ADRCHK		;MAKE SURE IT IS A LEGAL ADDRESS
	XCTUM <HRRZ A,2(CAC)>	;GET ADRESS OF PC STORAGE WORD
	PUSHJ P,ADRCHK		;CHECK IT TOO
	XCTUM <HLRZ C,2(CAC)>	;GET PSI CHANNEL NUMBER
	CAILE C,USRMXC		;IS IT LEGAL?
	 JRST RETZER		;NO, GIVE ERROR RETURN
	MOVN B,C		;SET UP MASK
	MOVSI D,400000
	LSH D,(B)
	XCTUM <HLRZ B,1(CAC)>	;GET LEVEL NUMBER
	JUMPE B,CMPT6R		;IF ZERO, REMOVE PSI CHANNEL
	CAIE B,USRLVL		;LEGAL LEVEL #
	 JRST RETZER		;NO, GIVE ERROR RETURN
	IORM D,USRMSK		;ADD THIS CHANNEL TO THOSE TURNED ON
CMPT6A:	MOVEM A,LEVTAB-1(B)	;STORE PC ADDRESS WORD
	UMOVE B,1(CAC)		;GET BACK CHNTAB WORD AGAIN
	HRRZM B,UITRAP		;SAVE TRAP ADDRESS
	HRRI B,USRINT		;SET UP TRAP ADDRESS
	MOVEM B,CHNTAB(C)	;STORE IN CHNTAB
	PUSHJ P,SETPSI		;GO SET UP NEW PSI SETTINGS
	JRST MRETN2		;AND EXIT

CMPT6R:	ANDCAM D,USRMSK		;TURN OFF THIS CHANNEL
	JRST CMPT6A		;GO CLEAN UP

;COMPAT FUNCTION 7 - CONVERT ERROR NUMBER TO STRING
;ACCEPTS IN ARG+1/	DESTINATION STRING POINTER
;	    ARG+2/	COUNT,,ERROR #
COMPT7:	UMOVE A,1(CAC)		;GET STRING POINTER
	XCTUM <HRRZ B,2(CAC)>	;GET ERROR #
	HRLI B,.FHSLF		;CURRENT FORK
	XCTUM <HLLZ C,2(CAC)>	;GET COUNT
	MOVN C,C
	ERSTR
	 JRST CMPTE1		;RETURN -1 FOR NO MESSAGE
	 JFCL			;ASSUME TRUNCATED STRING, AND JUST RETURN
	UMOVEM A,1(CAC)		;RETURN UPDATED STRING POINTER
	JRST MRETN2		;SUCCESSFUL


;FUNCTION 10 - GET JFN OF A CHANNEL

COMP10:	XCTUU <HLRZ A,0(CAC)>	;GET CHANNEL #
	TRZ A,777760		;MAKE SURE IN RANGE
	IMULI A,NTABS		;CONVERT TO TABLE ADDRESS
	HRRZ A,JFNTAB(A)	;GET THE JFN NOW ON THIS FILE
	JUMPE A,STOTAC		;RETURN NON-SKIP IF NULL
	JRST STOTC1		;AND SKIP IF OK.

;FUNCTION 11 - PMAP OURSELF OUT OF THE WATER AND RETURN TO USER

COMP11:	TRO PF,R.SUIC		;THREATEN SUICIDE
	JRST EXIT2		;PULL THE TRIGGER

SUBTTL ONCE AND OTHER RARE ROUTINES

MLON


;FIRST TIME INITIALIZATION

ONCE:	MOVE A,20		;REFERENCE PAGE 0 TO CREATE IT IF NEEDED
	MOVE A,[XWD TSLOC,TSLOC+1]
	SETZM -1(A)
	BLT A,CLRTOP
	MOVSI PF,L.DBUG		;CLEAR ALL FLAGS BUT THIS ONE
	ANDM PF,PFLAGS		; ..
	MOVSI PF,L.ONCE		;AND SET THIS ONE, BEEN THRU ONCE CODE
	IORB PF,PFLAGS		;AND LOAD FLAGS INTO AC.
	PUSHJ P,SETPSI		;SET UP PSEUDO INTERRUPT SYSTEM
	PUSHJ P,SETJDA		;SET UP JOB DATA AREA
	PUSHJ P,SETHSN		;GO SET UP HI SEG NAME, DEV, AND PPN
	PUSHJ P,SETLSN		;SAME FOR LOW SEG
	MOVEI A,PROJFN		;CONTROLLING TERMINAL
	RFMOD			;GET STARTING ECHO CHARACTERISTICS
	ANDI B,TM.ECH		;FOR TTYSTS ROUTINE
	MOVEM B,ECHINI
	MOVSI E,TT.CTY!TT.ALT	;SET CONTROLING TTY BIT IN STATUS WORD
	RFCOC			;SEE WHAT ECHOING OF CONTROLS IS SET AT
	TRNN B,4000		;HAS USER REQUESTED ^L BE INDICATED?
	TLO PF,L.INDF		;YES. CARRY THAT DATUM AROUND IN FLAGS
	PUSHJ P,TTPSTS		;ALSO SET UP CORRECT MODE
	PUSHJ P,TTBINI		;GO INITIALIZE TTCALL BUFFER
	MOVSI A,400000		;INITIALIZE MAPLST
	ASH A,-<NIOPGS/NPLPGS-1> ;TURN ON ALL ALL AVAILABLE SLOTS
	MOVEM A,MAPLST		;STORE AVAILABLE SLOT MASK
	MOVE A,[SIXBIT/NCPGS/]	;SEE IF THIS IS A SMALL SYSTEM
	SYSGT			;GET # OF USER PAGES
	CAIG A,^D130*2		;IS THIS GREATER THAN 130 K CORE?
	TLO PF,L.SMAL		;NO, MARK THIS AS A SMALL SYSTEM
	SYSGTA (<PTYPAR>)	;GET FIRST PTY # IN TTYJOB TABLE
	HRRZM A,FIRPTY		;STORE FOR LATER USE
	MOVE A,[SIXBIT/JOBRT/]	;GET NJOBS
	SYSGT
	HLRO A,B		;LH = NEG NUMBER OF JOBS
	MOVNM A,NJOBS		;STORE NJOBS
	MOVNM A,HGHSGN
	GJINF			;GET TSS JOB #
	MOVEM C,JOB
ONCE3:	SETO B,			;NOW GET TIME SINCE MIDNIGHT
	SETZ D,			;...
	ODCNV
	MOVEI E,0(D)		;SAVE FOR FUTURE USE
	TIME			;GET TIME SINCE LOAD
	SETO B,			;BACK TO GETTING TIME SINCE MIDNIGHT
	SETZ D,
	ODCNV
	CAIE E,0(D)		;MAKE SURE CLOCK DIDNOT TICK JUST THEN
	  JRST ONCE3		;IT DID, GO TRY AGAIN
	IMULI E,^D1000		;CONVERT SECONDS TO MILLISECONDS
	SUB E,A			;GET ACTUAL TIME IN MILLISECONDS
	MOVEM E,ITIME		;STORE IT FOR USE WITH MSTIME UUO
IFN FTSTAT,<
	MOVSI A,100001		;GET THE STATISTICS FILE
	HRROI B,[ASCIZ /PA1050.STATISTICS/]
	GTJFN
	  JRST NOSTAT		;HASN'T BEEN MADE ON SYS
	PUSH P,A		;SAVE JFN
	MOVEI B,302000		;OPEN THAWED, READ, WRITE
	OPENF
	  JRST [POP P,A		;CAN'T OPEN IT. RELEASE JFN
		RLJFN		; ..
		  JFCL		;REALLY CAN'T. IGNORE.
		JRST NOSTAT]	;AND SKIP THIS
	POP P,A			;GET THE JFN
	MOVSI A,(A)		;PAGE 0 OF THE FILE
	MOVE B,[.FHSLF,,STATLP]	;STATISTICS PAGE IN THIS FORK
	MOVSI C,140000		;R/W ACCESS
	PMAP			;MAKE THEM EQUIVALENT
	HLRZS A			;GET JFN
	CLOSF			;CLOSE THE JFN
	  JFCL
	TLO PF,L.LSTA		;MARK THAT STATISTICS FILE WAS FOUND
	MOVE A,PVLOC		;LOAD UP THIS VERSION NUMBER
	MOVEM A,ST.VER+STATLC	;STORE FOR STATISTICS GATHERER
	MOVE A,[STATFW]		;GET FORMAT WORD
	MOVEM A,ST.FMT+STATLC	;STORE IN FILE
NOSTAT:	MOVSI A,100001		;GET THE STATISTICS FILE
	HRROI B,[ASCIZ /<SYSTEM>PA1050.STATISTICS/]
	GTJFN
	  JRST NOSTA1		;HASN'T BEEN MADE ON SYS
	PUSH P,A		;SAVE JFN
	MOVEI B,302000		;OPEN THAWED, READ, WRITE
	OPENF
	  JRST [POP P,A		;CAN'T OPEN IT. RELEASE JFN
		RLJFN		; ..
		  JFCL		;REALLY CAN'T. IGNORE.
		JRST NOSTA1]	;AND SKIP THIS
	POP P,A			;GET THE JFN
	MOVSI A,(A)		;PAGE 0 OF THE FILE
	MOVE B,[.FHSLF,,STATGP]	;STATISTICS PAGE IN THIS FORK
	MOVSI C,140000		;R/W ACCESS
	PMAP			;MAKE THEM EQUIVALENT
	HLRZS A			;GET JFN BACK
	CLOSF			;CLOSE IT 
	  JFCL
	TLO PF,L.GSTA		;MARK THAT GLOBAL STATISTICS LILE WAS FOUND
	MOVE A,PVLOC		;GET PAT VERSION NUMBER
	MOVEM A,ST.VER+STATGC	;STORE FOR ANALYSIS PROGRAM
	MOVE A,[STATFW]		;GET FORMAT WORD
	MOVEM A,ST.FMT+STATGC	;STORE IN FILE
NOSTA1:	MOVEI A,1		;READ HIGH PRECISION CLOCK
	HPTIM			;GET RUNTIME IN MICROSECOND UNITS
	  TLZ PF,L.GSTA!L.LSTA	;NO SENSE IN DOING ANY MORE HPTIM'S
	MOVE B,A
	SUB B,STIME		;CALCULATE TIME TO DO ONCE STUFF
	MOVEM A,STIME		;DONT ADD THIS TO FIRST UUO TIME
	MOVEI A,0		;COUNT UP TIMES THAT PAT HAS BEEN STARTED
	STAT A,B,<ST.ONC>
>				;END OF STATISTICS OPENER
	MOVEM PF,PFLAGS		;STASH PF IN CORE ON EXIT FROM ONCE
	POPJ P,0		;AND RETURN FROM ONCE-ONLY ROUTINE

;DEBUG$G AFTER LOADING SETS UP SO SYSTEM'S PAT WONT BE LOADED.

DEBUG1:	TDZA A,A	;ENTRY FLAG
DEBUG:	MOVEI A,1
	MOVE P,PATSTK		;SET UP A STACK POINTER
	PUSH P,A		;SAVE ENTRY FLAG
	SETOM INPAT		;FLAG FOR UUO PROCESSOR
	MOVSI PF,L.DBUG		;SET FLAG NOT TO GRAB ^C INT
	IORB PF,PFLAGS		;IN CORE AND AC FLAG WORDS
	PUSHJ P,ONCE		;SET UP TEMP STORAGE AND PSI SYS
	PUSHJ P,SETCV		;SET COMPATIBILITY VECTOR
	SETZM INPAT		;NOT PROCESSING IN PAT NOW
	POP P,A			;GET ENTRY FLAG
	SKIPE A			;FROM EXEC?
	JRST DDTLOC		;GO TO DDT
	HALTF			;YES. STOP

SETCV:	MOVEI A,.FHSLF		;THIS FORK
	MOVE B,[XWD EVECL,EVEC]	;SIZE AND LOCATION OF COMPAT VECTOR
	MOVE C,[XWD MONUUO,MONUPC] ;PLACE FOR MONITOR TO STASH UUO, PC
	SCVEC			;SET COMPATIBILITY VECTOR
	POPJ P,0		;RETURN

;ROUTINE TO SET UP JOB DATA AREA

SETJDA:	MOVEI A,140		;GIVE USER AT LEAST 140 WORDS
	HRRZM A,JBREL		;SO UMOVE .JBREL DOESNT FAIL
	UMOVE A,.JBREL
	JUMPN A,SETJD1		;SETUP?
	HRRZ A,.JBCOR		;GET JOB CORE
	JUMPN A,SETJD1		;USE THIS AS .JBREL
	PUSHJ P,HSOCHK		;COMPUTE HI SEG ORIGIN
	 JRST [	PUSHJ P,SETVES	;FOUND IT, SETUP .JBDAT FROM VESTIG
		UMOVE A,.JBREL	;SHOULD NOW HAVE GOODIES
		JRST SETJD1]
	MOVE A,[.FHSLF,,.HSLOC/1000] ;NO, IS THERE A READABLE PAGE 400?
	RPACS
	TLNE B,(1B2)
	PUSHJ P,SETVES		;YES,SETUP JOB DATA AREA FROM VESTIG
	MOVEI C,PATPAG-1	;SCAN MAP TO FIND HIGHEST USED PAGE
	TLNE PF,L.FLSR		;IS FILSER MAPPED IN?
	MOVEI C,FLSRPG-1	;YES, START AT FIRST PAGE UNDER FILSER
	MOVSI A,.FHSLF
	HRRI A,0(C)
	RPACS
	TLNN B,(1B2)		;IS PAGE READABLE?
	SOJG C,.-3		;NO
	MOVEI A,0(C)		;THIS IS HIGHEST PAGE
	LSH A,^D9
	HRRZ B,.JBCOR		;HIGHEST LOAD ADDRESS
	CAIGE A,0(B)		;MAX OF THAT AND HIGHEST PAGE
	MOVEI A,0(B)
SETJD1:	TRO A,777		;EVEN PAGES
	TLNE PF,L.FLSR		;IS FILSER MAPPED IN
	CAIGE A,FLSRLC		;YES, SEE IF FILSER IS OVERLAPPED
	CAIL A,PATLOC		;WITHIN BOUNDS
	  PUSHJ P,CORBUG	;NO, TYPE OUT MESSAGE AND HALT
	UMOVEM A,.JBREL
	HRRZM A,JBREL
	UMOVE A,JOBS41		;SAVED CONTENTS OF 41
	XCTUU <SKIPE 41>	;41 NEEDS SETUP?
	JRST SETJD2
	UMOVEM A,41		;YES
SETJD2:	XCTUU <HRRZ A,.JBHRL>
	JUMPE A,SETJD3		;SKIP SETUP IF NO HIGHSEG
	TRO A,777		;EVEN PAGE
	TLNE PF,L.FLSR		;IS FILSER MAPPED IN
	CAIGE A,FLSRLC		;YES, SEE IF FILSER IS OVERLAPPED
	CAIL A,PATLOC		;WITHIN BOUNDS
	  PUSHJ P,CORBUG	;NO, TYPE OUT MESSAGE AND HALT
	HRRZM A,JBHRL
SETJD3:	PUSHJ P,HSOCHK		;TRY TO CALC HI SEG ORIGIN
	 JFCL			;IF IT LOSES, IT LOSES
	POPJ P,

;COMPUTE BEST GUESS FOR HI SEGMENT ORIGIN
HSOCHK:	XCTUM <SKIPN A,.JBHSO>		;ORIGIN SPECIFIED IN LOW SEG?
	JRST HSOCK1			;NO
	LSH A,9				;YES, MAKE IT ADDRESS
	JRST HSOCK2

HSOCK1:	XCTUM <HRRZ A,.JBHRL>		;GET HI SEG END FROM LOW SEG
	JUMPE A,HSOCK3			;JUMP IF NONE
	XCTUU <HLRZ B,.JBHRL>		;GET HI SEG FREE POINTER
	SUBI A,-1(B)			;SUBTRACT FROM HI SEG END
	TRZ A,777			;FORCE PAGE BOUNDARY
HSOCK2:	CAMG A,JBREL			;IS DESIRED HI SEG ORIGIN LEGAL?
	JRST HSOCK3			;NO
	MOVEM A,HSORG			;YES, USE IT
	POPJ P,				;INDICATE BEST GUESS OK

HSOCK3:	MOVE A,JBREL			;GET END OF LOW SEG
	TRO A,777			;FORCE TO END OF PAGE
	ADDI A,1			;MAKE IT NEXT PAGE
	CAIGE A,.HSLOC			;IS IT ABOVE DEFAULT HI SEG ORIGIN?
	MOVEI A,.HSLOC			;NO, USE DEFAULT
	MOVEM A,HSORG			;STORE HI SEG ORIGIN
	JRST CPOPJ1			;INDICATE BEST GUESS FAILED

;COPY VESTIGAL JOB DATA AREA FROM HISEG TO LOSEG

SETVES:	MOVSI B,-NVSTIG
	MOVE A,HSORG
	HRLI A,B		;CONSTRUCT INDIRECT WORD HISEG(B)
SETVS0:	UMOVE C,@A
	JRST @VESTIG(B)
SETVS1:	AOBJN B,SETVS0
	XCTUM <HRRZ B,.JBHRL>
	TLNE PF,L.FLSR		;IS FILSER MAPPED IN?
	CAIGE B,FLSRLC		;YES, DONT LET IT BE OVERLAPPED
	CAIL B,PATLOC		;WITHIN BOUNDS
	  PUSHJ P,CORBUG	;NO, TYPE OUT MESSAGE AND BOMB
	HRRZM B,JBHRL
	POPJ P,

VESTIG:	[UMOVEM C,.JBSA
		JRST SETVS1]
	[UMOVEM C,41
		JRST SETVS1]
	[UMOVEM C,.JBCOR
		XCTUU <HRRZM C,.JBREL>
		JRST SETVS1]
	JRST [	XCTUU <HRRZM C,.JBREN>
		HLR C,C		;REL TOP OF HIGH SEG
		HRRI C,-1(C)	;ACCOUNT FOR EXACT MULTIPLE OF PAGE
		TRO C,777	;ROUND TO TOP OF PAGE
		ADD C,HSORG	;INCLUDE HISEG ORIGIN
		TLNE C,-1	;HAD ANYTHING?
		UMOVEM C,.JBHRL	;YES, STORE IT
		JRST SETVS1]
	[UMOVEM C,.JBVER
		JRST SETVS1]
NVSTIG==.-VESTIG
;ROUTINE TO READ IN GETJI INFO.  PASS IT GETJI AC1 ARG.  IT
;SETS UP THE REST
;SKIPS/NON-SKIPS PER GETJI.  ON NON-SKIP, GETJI STUFF IN AC1 (PRESUMABLY
;ERROR CODE)

DGETJI:	SETZM STRNG1+.JISRM	;WE DON'T WANT SESSION REMARK
	MOVE B,[-BLLEN,,STRNG1]	;TELL GETJI HOW MANY ENTRIES AND WHERE TO PUT 'EM
	MOVEI C,0		;START WITH FIRST ENTRY
	GETJI			;DO IT
	 RET			;NON-SKIP ON ERROR
	JRST CPOPJ1		;SKIP ON SUCCESS STORY

;ROUTINE WHICH SKIPS IF JOB IS IN "USER" MODE INSTEAD OF "MONITOR"
;MODE.  THIS ROUTINE ASSUMES THE GETJI DATA BLOCK HAS BEEN SET UP
;(BY CALLING DGETJI).  NO AC'S ARE CLOBBERED

SKPUSR:	SAVEAC <A,B,C,D>
	SKIPE STRNG1+.JIT20	;TOPS20 EXEC MODE?
	RET			;YES, NON-SKIP
	JRST CPOPJ1		;NO, SKIP

;SUBROUTINE SETPSI TO SET UP THE PSEUDO INTERRUPT SYSTEM, AND
; SET FOR ^O AS AN INTERRUPT.

SETPSI:	MOVEI A,.FHSLF		;THIS FORK
	DIR			;DISABLE INTERRUPT SYSTEM
	MOVE B,[XWD PSITAB,LEVTAB] ;COPY PURE TABLES TO
	SKIPN LEVTAB		; IMPURE AREA, FIRST TIME ONLY.
	BLT B,CHNTAB+^D35	;FIRST TIME. COPY IT.
	MOVE B,[XWD LEVTAB,CHNTAB] ;TELL MONITOR WHERE THEY ARE
	SIR			; ..
	MOVSI A,3		;SET UP TO ENABLE ^C IF DESIRED
	HRRI A,CCIPSN		;^C CHANNEL #
	SKIPN CCIENB		;(323) ^C interrupt enabled?
	  JRST EDONE		;(323) no
;**; if user is trapping control-C, also trap BREAK (or ATTN) key
;**; which is equivalent to a NULL
	ATI			;(323) enable ^C
	HRLI A,.TICBK		;(323) enable BREAK (ie, NULL)
	ATI			;(323)
EDONE:				;(323)
	MOVEI A,.FHSLF		;THIS FORK
	MOVE B,ONCHNS		;CHANNELS ALWAYS DESIRED
	MOVE C,USRENB		;THOSE USER MAY WANT
	TRNE C,1B19		;PDL OV?
	TLO B,(1B9)		;YES
	TRNE C,1B23!1B22	;ILL MEM REF, NXM?
	TDO B,[EXP 1B16!1B17!1B18]
;	TRNE C,1B26		;CLOCK FLAG
;	TLO B,(1B14)		;TIME OF DAY? *** NOT YET IMPL
	TRNE C,1B29		;FOV?
	TLO B,(1B7)		;YES
	TRNE C,1B32		;AR OV?
	TLO B,(1B6)		;YES.
	SKIPE CCIENB		;^C INTERCEPT ENABLED
	  TRO B,1B<CCIPSN>	;YES, TURN ON THIS CHANNEL
	TDO B,USRMSK		;TURN ON CHANNELS FOR USER (COMPT. 6)
	AIC			;TURN ON THOSE CHANNELS
	ANDCA B,ALLCHN		;TURN OFF UNSELECTED ONES FROM ABOVE
	DIC			; ..
	EIR			;AND ENABLE THE INTERRUPT SYSTEM
	POPJ P,0		;RETURN FROM SETPSI

ONCHNS:	EXP <1B<CCPSIN>>!<1B<CCIPSN>>!<3B<IOCHN+1>>!1B11!1B12!1B15!1B19!1B20!1B22!<1B<TTYCHN>>	;^O,IO ERR, ILL INST, NXPAGE
;AND MASK OF ALL THAT MIGHT WANT TO BE ON
ALLCHN:	EXP <1B<CCPSIN>>!<1B<CCIPSN>>!<3B<IOCHN+1>>!77B5!1B6!1B7!1B9!1B11!1B15!7B18!1B19!1B20!1B22!<1B<TTYCHN>>

CLRPSI:	MOVEI A,.FHSLF		;THIS FORK
	CIS			;CLEAR WAITING INTS
	DIR			;DISABLE INT SYSTEM
	SETO B,			;ALL CHANNELS
	DIC			;DISABLE ALL CHANNELS
	SETZ B,			;INITIALIZE TERMINAL INTERRUPT WORD
	STIW
CLRCCI:	MOVEI A,3		;CLEAR ^C INTERCEPT
	SKIPE CCIENB		;ONLY IF ENABLED
	  DTI
	SETZM CCIENB		;MARK THAT IT IS NOT SET
	POPJ P,0		;AND RETURN FROM CLRPSI

CLRALL:	PUSHJ P,CLRPSI		;CLEAR INTERRUPT SYSTEM
	MOVEI A,.FHSLF		;THIS FORK
	SETZB C,B		;CLEAR COMPATIBILITY VECTOR
	SCVEC			;SO WILL GET NEW ONE AFTER LOADING
				;AND NOT CONFUSE NON-1050 PROGRAMS
	POPJ P,
PSITAB:
				;LEVTAB
	EXP RETSAV		;STORAGE FOR CHANNEL 1 PC
	EXP LV2SAV		;STORAGE FOR LEVEL 2 PC
	0
				;CHNTAB
	0			;CHANNEL 0
	0			;CHANNEL 1
	0			;CHANNEL 2
	0			;CHANNEL 3
	0			;CHANNEL 4
	0			;CHANNEL 5
	XWD 1,OVINT		;OVERFLOW ON CHANNEL 6
	XWD 1,FOVINT		;FLOATING OVERFLOW ON CHANNEL 7
	0			;CHANNEL 8
	XWD 1,PDLINT		;PDL OVERFLOW ON CHANNEL 9
	0			;EOF ON CHANNEL 10
	XWD 1,IOERR		;IO DATA ERROR (11)
	XWD 1,QUOINT		;QUOTA EXCEEDED INTERRUPTS (12)
IOCHN==.-PSITAB-3		;PTY CHANNELS
	XWD 1,PTYINT		;CHANNEL 13 RESERVED FOR PTY HUNGRY
	XWD 1,PTYINT		;CHANNEL 14 RESERVED FOR PTY OUTPUT READY
	XWD 1,INSINT		;ILLEGAL INST, CH 15
	XWD 1,MEMINT		;CHANNEL 16 ILLEGAL READ
	XWD 1,MEMINT		;CHANNEL 17 ILLEGAL WRITE
	XWD 1,MEMINT		;CHANNEL 18 ILLEGAL EXECUTE
TTYCHN==.-PSITAB-3
	XWD 1,TTYINT		;CHANNEL 19 SUBSIDIARY FORK TERMINATION
				;TTY FORK INTERRUPTS HERE
	XWD 1,MACHSZ		;CHANNEL 20 MACHINE SIZE ERROR
	0			;CHANNEL 21 TRAP TO USER
	XWD 1,NXPINT		;CHAN 22, NONEXISTENT PAGE
	0			;CHANNEL 23
	0			;CHANNEL 24
	0			;CHANNEL 25
	0			;CAHNNEL 26
	0			;CHANNEL 27
	0			;CHANNEL 28
	0			;CHANNEL 29
	0			;CHANNEL 30
CCPSIN==.-PSITAB-3		;CHANNEL FOR REENTER HANDLER
	XWD 1,CSTART		;CHANNEL 31
CCIPSN==.-PSITAB-3		;CHANNEL 32 IS FOR ^C INTERCEPT
	XWD 1,CCIINT
	0			;CHANNEL 33
	0			;CHANNEL 34
	0			;CHANNEL 35 IS FOR WATCH; LEAVE 0
WATCHN==1B35

IFN .-PSITAB-^D36-^D3,<PRINTX PSITAB LENGTH WRONG>
SUBTTL ENVIRONMENT STUFF. SAVGET.

RUN:	PUSHJ P,RRESET		;RELEASE ALL THE CHANNELS
	TROA PF,R.RUNU		;DENOTE GETSEG, NOT RUN
GETSEG:	TRZ PF,R.RUNU		;DENOTE RUN, NOT GETSEG
	PUSHJ P,JBKSET		;SET UP JBLOCK FOR GTJFN
	PUSHJ P,REL0		;RELEASE CHANNEL 0
	HLRZM CAC,MTDUMP	;STASH THE CCL OFFSET
	UMOVE A,@PDL		;GET RETURN INSTRUCTION
	LSH A,-30		;SEE IF IT'S A HALT
	CAIN A,2542		; ..
	TRO PF,R.RHLT		;YES. REMEMBER THAT.
	MOVEI AA,1(CAC)		;POINTER TO NAME IN ARG LIST
	UMOVE D,-1(AA)		;DEVICE NAME
	MOVEM D,RUNDEV		;SAVE DEV NAME FOR LATER
	HRROI E,DEVNM7
	MOVEM E,JBLOCK+2
	CAME D,[SIXBIT /SYS/]	;PROGRAM FROM SYS?
	JRST RUN11		;NO
	TRO PF,R.SYS		;YES, REMEMBER THAT
	HRROI A,[ASCIZ/SYS/]	;SEE IF SYS IS A REAL DEV
	STDEV			;OR MAYBE A LOGICAL NAME
	  SKIPA D,[ASCIZ/PS/]	;IT IS NOT, MAKE IT PS:<SUBSYS>
	JRST RUN11		;IT IS, GO USE IT DIRECTLY
	MOVEM D,DEVNM7
	HRROI D,[ASCIZ /SUBSYS/]
	MOVEM D,JBLOCK+3
	MOVSI D,'PS '		;SET UP DEVICE NAME
	MOVEM D,RUNDEV
	MOVE D,[1,,4]		;AND PPN
	MOVEM D,RUNPPN
	JRST RUN12

RUN11:	HRLI E,(POINT 7,0)	;GET LEGAL STRING POINTER
	PUSHJ P,SIX27V		;PUT IN DEVICE NAME FROM USER
	UMOVE D,3(AA)		;PPN FROM USER
	MOVEM D,RUNPPN		;SAVE PPN
	JUMPE D,RUN11A		;SELF IF .LE. 0
	PUSHJ P,PPNMAP		;GET MAPPED DIRECTORY
	  JRST RUN11B		;NO MAPPING
	MOVEM E,JBLOCK+3	;STORE DIRECTORY POINTER WORD
	TRO PF,R.SYS		;MARK CAME FROM SYS DIRECTORY
	JRST RUN12		;CONTINUE...

RUN11B:	UMOVE A,-1(AA)		;GET STR NAME
	PUSHJ P,GETDIR		;GET ASCII TRANSLATION
RUN11A:	  SETZM A		;NO. TRY IN OWN DIRECTORY
	MOVEM A,JBLOCK+3	;STORE POINTER IF ANY

	;FALL THRU
RUN12:	MOVSI A,100000
	MOVEM A,JBLOCK
	UMOVE D,(AA)
	MOVEM D,RUNNAM		;SAVE NAME OF PROGRAM TO RUN
	MOVE E,[POINT 7,STRNG1]	;GET MAIN STRING
	PUSHJ P,SIX27V
	MOVEI A,"."		;FOLLOW NAME WITH A DOT
	IDPB A,E		;IN MAIN STRING
	MOVE G,E		;SAVE UPDATED STRING POINTER IN G
RUN12A:	XCTUU <HLLZ D,1(AA)>	;GET EXTENSION
	JUMPE D,RUN19		;NONE THERE- TRY DEFAULTS
	TRNN PF,R.RUNU		;GETSEG?
	JRST RUN19		;YES. IGNORE SUPPLIED EXT.
	PUSHJ P,RUN15		;USE GIVEN EXT
	  JRST RUN13		;SUCCESS- FOUND IT
	JRST RUNFAI		;FAILED, GO RETURN TO USER

;HERE FOR DEFAULT EXTENSION(S)

RUN19:	PUSHJ P,RUN10		;TRY FOR .EXE
	JRST [	TRNN PF,R.RUNU	;FOUND .EXE - GETSEG OR RUN?
		JRST RUN13	;GETSEG. JUST HIGH PART.
		PUSHJ P,SETHN1	;SET UP NEW NAME
		JRST RUN18]	;RUN. LOAD WHOLE THING.
	PUSHJ P,RUN09A		;TRY NEXT FOR .SAV
	 JRST RUN13		;FOUND A .SAV
	PUSHJ P,RUN08		;TRY TO GET EXTENSION .SHR
	  JRST RUN13		;SUCCESS
	PUSHJ P,RUN09		;NO GOOD- TRY FOR .HGH
	  JRST RUN13		;SUCCESS
RUNFAI:	XCTUM <HLRZ A,@MONUPC>	;GET INST AFTER UUO
	CAIE A,(JRST 4,)	;IS IT A HALT
	  JRST RETZER		;NO, RETURN TO USER
RUNFA1:	TMSG <$? PA1050: >	;YES, TYPE "FILE.EXT NOT FOUND"
	HRROI A,STRNG1
	PSOUT			;TYPE OUT NAME.EXE
	TMSG < NOT FOUND.$>
	JRST EXITM1		;GO EXIT

;HERE AFTER GTJFN SUCCEEDS

RUN13:	MOVEM A,JFNTAB
	PUSHJ P,SETHN1		;SET UP NEW NAME
	TRNE PF,R.RUNU		;RUN UUO? (NOT GETSEG)
	JRST RUN23		;YES
	LDB B,[PAGEN HSORG]	;GET FIRST PAGE OF CURRENT HISEG
	MOVEI C,PATPAG	;GET COUNT OF PAGES TO BE DELETED
	TLNE PF,L.FLSR		;FILSER MAPPED IN?
	  MOVEI C,FLSRPG	;YES, GO ONLY TO START OF FILSER
	SUB C,B			;COMPUTE COUNT OF PAGES TO DELETE
	HRLI B,.FHSLF		;NOTE THIS FORK
	SETO A,
	TLO C,(1B0)		;MARK THAT THERE IS A COUNT IN THE RH OF C
	PMAP			;AWAY GOES THE HIGH SEG
	HRLI A,.FHSLF		;NOW GET THE NEW HIGH SEG INTO THIS FORK
	HRR A,JFNTAB		;CHANNEL 0 HAS JFN
	TRO A,1B19		;MARK THAT THIS IS A BOUNDED GET
	LDB B,[PAGEN HSORG]	;START AT FIRST HISEG PAGE
	HRLZ B,B
	HRRI B,PATPAG-1		;END AT PAT
	TLNE PF,L.FLSR		;FILSER MAPPED IN?
	  HRRI B,FLSRPG-1	;YES, GO ONLY TO START OF FILSER
	GET
	JRST RUN24		;OK, GO FINISH UP
RUN18:	MOVEM A,JFNTAB
RUN23:	UMOVE B,0(AA)		;GET SIXBIT PROGRAM NAME
CMPRUN:	PUSH P,B		;SAVE NEW PROGRAM NAME
	PUSH P,.JBERR		;AND ERROR COUNT
	PUSHJ P,CLRCOR		;CLEAR CURRENT CORE IMAGE
	MOVE A,JFNTAB		;GET JFN OF PROGRAM TO BE RUN AGAIN
	HRLI A,.FHSLF		;CURRENT FORK, THIS JFN
	TRO A,1B19		;DO A BOUNDED GET
	MOVEI B,PATPAG-1	;FROM 0 TO PAT
	TLNE PF,L.FLSR		;FILSER MAPPED IN?
	  MOVEI B,FLSRPG-1	;YES, GO ONLY TO START OF FILSER
	GET
	MOVEI A,.FHSLF		;THIS FORK
	GEVEC			;GET ENTRY VECTOR
	HLRZ A,B		;GET LEFT HALF
	CAIN A,(JRST)		;IS THIS A TOPS10 STYLE ENTRY VECTOR?
	  JRST RUN23A		;YES, DONT SET .JBSA
	XCTUU <HRRM B,.JBSA>	;STORE STARTING ADDRESS
RUN23A:	POP P,.JBERR		;RESTORE ERROR COUNT
	POP P,A			;NAME OF PROGRAM
	MOVEM A,LOWNAM		;SAVE THE NEW PROGRAM NAME
	MOVE B,A		;START WITH SAME NAME FOR BOTH
	TRNN PF,R.SYS		;FROM SUBSYS DIRECTORY?
	MOVE A,[SIXBIT/(PRIV)/]	;NO, SET SUBSYS NAME TO PRIV
	SETSN			;YES. UPDATE SYSTEM TABLES
	  JFCL			;IGNORE ERROR RETURN
	PUSHJ P,CHKRHN		;GO CLEAR HIGH SEG NAME IF NONE
RUN24:	HRRZ A,JFNTAB
	RLJFN			;TRY TO RELEASE JFN
	  JFCL			;WON'T RELEASE IF SSAV FILE
	TRNE PF,R.RUNU		;WAS THIS A RUN UUO?
	JRST RUN21		;YES
	MOVE B,HSORG		;ALLOW ACCESSING OF VESTIGAL AREA
	ADDI B,10
	HRRZM B,JBHRL		;FOR FOLLOWING UMOVE
	MOVE B,HSORG
	UMOVE B,3(B)		;GET NEW HISEG LENGTH
	HLR B,B
	HRRI B,-1(B)		;ACCOUNT FOR EXACT MULTIPLE OF PAGE LENGTH
	TRO B,777		;ROUND TO PAGE
	ADD B,HSORG
	TLNN B,-1		;IS NON-0?
	SETZ B,			;NO
	HRRZM B,JBHRL
	UMOVEM B,.JBHRL
	JRST RUN14
RUN21:	PUSHJ P,SETJDA		;SET UP LOW CORE STUFF
RUN14:	HRRZ A,JBHRL		;GET HIGH SEG CORE ASSIGNMENT
	SKIPN A			;IF NONE CLEAR HIGH SEG NAME
	PUSHJ P,CLRHSQ		;CLEAR THE HIGH SEG NAME QUIETLY
	SETZ BB,
	PUSHJ P,UREL2		;RELEASE CHANNEL 0
	MOVEI A,.FHSLF		;NOTIFY EXEC OF NAME CHANGE
	MOVEI B,WATCHN
	IIC			;WE WONT GET INTERRUPT SINCE CHANNEL NOT ON
	TRNN PF,R.RUNU		;WAS IT A RUN UUO?
	JRST MRETN2		;RETURN SKIPPING FROM GETSEG
	MOVE A,RUNDEV		;SET UP USER ACS
	MOVEM A,ACS+11		;DEVICE NAME
	MOVE A,RUNNAM
	MOVEM A,ACS+0		;PROGRAM NAME
	MOVE A,RUNEXT
	MOVEM A,ACS+17		;EXTENTION
	MOVE A,RUNPPN
	MOVEM A,ACS+7		;PPN
	UMOVE A,.JBSA		;RUN GOES OFF TO PROG START ADR
	ADD A,MTDUMP		;PLUS USER'S CCL OFFSET
	UMOVEM A,.JBSA		;UPDATE .JBSA BY OFFSET
				;;;IF OFFSET OVER 1, MEDDLING...
	HRRZM A,(P)
	JRST MRETN

RUN08:	MOVSI D,(SIXBIT/SHR/)
	JRST RUN15
RUN09:	MOVSI D,(SIXBIT/HGH/)
	JRST RUN15
RUN09A:	MOVSI D,(SIXBIT/SAV/)
	JRST RUN15
RUN10:	MOVSI D,(SIXBIT/EXE/)
RUN15:	MOVE E,G		;GET MAIN STRING POINTER
	PUSHJ P,SIX27V
	MOVEI A,JBLOCK
	HRROI B,STRNG1		;STRNG1 HAS FILE.EXT TO BE RUN
	GTJFN
	  JRST CPOPJ1		;FAILED, GO TRY OTHER EXTENSIONS
	POPJ P,			;SUCCESSFULLY GOT JFN

RUN20:	SETZ BB,
	PUSHJ P,UREL2		;RELEASE CHANNEL 0
	JRST MRETN		;TAKE ERROR EXIT

CLRCOR:	SETO A,			;CLEAR CORE IMAGE
	MOVSI B,.FHSLF
	TLNE PF,L.FLSR		;FILSER MAPPED IN?
	  SKIPA C,[PM%CNT+FLSRPG]	;YES, FROM 0 TO 577
	MOVE C,[PM%CNT+PATPAG]	;FROM 0 TO 677
	PMAP
	POPJ P,
SETHSN:	SETZM SEGNAM		;INIT NAME
	SETZM SEGDEV
	SETZM SEGPPN
	SKIPN JBHRL
	POPJ P,
	LDB A,[PAGEN HSORG]
	MOVE B,A
	LDB C,[PAGEN JBHRL]
	SUBI B,1(C)
	HRL A,B			;MAKE AOBJN POINTER FOR PAGES
	PUSHJ P,GETSN		;GET NAME,DEV,PPN FROM PAGES
	MOVEM A,SEGNAM
	MOVEM B,SEGDEV
	MOVEM C,SEGPPN
	POPJ P,

SETLSN:	LDB A,[PAGEN JBREL]
	MOVNI A,1(A)
	HRLZ A,A
	PUSHJ P,GETSN
	MOVEM A,LOWNAM
	MOVEM B,LOWDEV
	MOVEM C,LOWPPN
	POPJ P,

GETSN:	PUSH P,[0]
	PUSH P,[0]
	PUSH P,[0]
GETSN1:	PUSH P,A
	HRLI A,.FHSLF		;CHECK READ ACCESS OF HIGH SEG
	RPACS
	TLNE B,(1B5)		;PAGE EXIST?
	TLNE B,(1B10)		;PRIVATE PAGE?
	JRST GETSN2		;NOT FILE PAGE, TRY NEXT
	RMAP			;REMAP PAGE TO GET ITS HANDLE
	CAMN A,[-1]		;UNACCESSIBLE?
	JRST GETSN2		;YES
	HLRZ F,1		;GET HANDLE
	MOVSI C,1000		;GET NAME OF HIGH SEG
	PUSHJ P,GTHSNS		;  USING THE JFNS JSYS
	MOVEM A,-1(P)		;STORE FOR RETURN
	MOVSI C,100000		;GET DEVICE
	PUSHJ P,GTHSNS		;  USING JFNS
	MOVEM A,-2(P)		;STORE DEVICE NAME
	MOVE C,[1B2!1B5!1B35]	;GET STR:<DIR>
	MOVE B,F		;...
	HRROI A,STRNG1		;INTO STRNG1
	JFNS
	 ERJMP GETSN2
	MOVX A,RC%EMO		;CONVERT DIRECTORY TO NUMBER
	HRROI B,STRNG1		; INSTEAD OF STRING
	RCDIR
	 ERJMP GETSN2
	TXNE A,RC%NOM!RC%AMB	;FOUND ONE?
	JRST GETSN2		;LOSE
	MOVE A,C		;YES, GET DIR NUMBER INTO A
	PUSHJ P,PPNUNM		;GET UNMAPPING OF PPN
	MOVEM A,-3(P)		;STORE PPN (I.E. DIRECTORY #)
	POP P,(P)		;WIN, FLUSH AOBJN POINTER
GETSN3:	POP P,A			;NAME
	POP P,B			;DEV
	POP P,C			;PPN
	POPJ P,

GETSN2:	POP P,A
	AOBJN A,GETSN1
	JRST GETSN3

CHKRHN:	LDB A,[PAGEN HSORG]
	HRLI A,.FHSLF		;CHECK READ ACCESS OF HIGH SEG
	RPACS
	TLNE B,(1B5)		;PAGE EXIST?
	TLNE B,(1B10)		;YES, PRIVATE?
	JRST CLRHSQ		;NO PAGE OR PRIVATE
	POPJ P,			;LEAVE NAME AS IS

SETHN1:	PUSH P,A		;SAVE ALL ACS USED
	UMOVE A,0(AA)		;GET SIXBIT NAME FROM USER CALL
	MOVEM A,SEGNAM		;STORE IT
	TRNE PF,R.RUNU		;RUN UUO? (NOT GETSEG)
	MOVEM A,LOWNAM		;STORE IT
	UMOVE A,-1(AA)		;GET DEVICE FROM WHENCE IT CAME
	MOVEM A,SEGDEV		;STORE DEV
	TRNE PF,R.RUNU		;RUN UUO? (NOT GETSEG)
	MOVEM A,LOWDEV		;STORE DEV
	UMOVE A,3(AA)		;GET PPN THAT USER USED
	MOVEM A,SEGPPN		;SAVE IT TOO
	TRNE PF,R.RUNU		;RUN UUO? (NOT GETSEG)
	MOVEM A,LOWPPN		;SAVE IT TOO
	JRST APOPJ		;RESTORE ACS AND RETURN

CLRHSQ:	TDZA C,C		;DONT TELL WATCHERS ABOUT THIS
CLRHSN:	MOVE C,SEGNAM		;SAVE CURRENT NAME
	SETZM SEGNAM		;CLEAR HIGH SEG NAME
	SETZM SEGDEV		;AND HIGH SEG DEVICE
	SETZM SEGPPN		;AND PPN
	MOVEI A,.FHSLF		;IF NAME CHANGED INFORM WATCHERS
	MOVEI B,WATCHN
	SKIPE C			;BUT ONLY IF THERE WAS A HIGH SEG BEFORE
	  IIC
	POPJ P,			;AND RETURN
;CALLI 0 RESET HANDLER

RESET:
IFN FTFILSER,<
	TLNE PF,L.FLSR		;HAS FILSER BEEN LOADED?
	  PUSHJ P,TRESET	;YES, GO CLEAN UP OPEN FILES
>
	PUSHJ P,RRESET		;RESET ALL CHANNELS WITHOUT CLOSING
	JRST MRETN		;ALL DONE

;ROUTINE TO RESET EVERYTHING WITHOUT CLOSING OPENED FILES

RRESET:	SETZB AC,BB		;SET UP TO RELEASE ALL JFNS
RS3:	SKIPG A,JFNTAB(BB)	;IS THERE A JFN FOR THIS CHANNEL?
	  JRST RS2		;NO
	HRRZS A			;ONLY WANT RIGHT HALF OF JFN
	CAIE A,PRIJFN		;PRIMARY JFN?
	CAIN A,PROJFN
	  JRST RS2		;YES, DONT CARE ABOUT THESE
	SKIPE MAPTAB(BB)	;IS THERE A PAGE MAPPED?
	  PUSHJ P,UNMAPP	;YES, UNMAP THE PAGE
RS2:	ADDI BB,NTABS		;STEP TO NEXT CHANNEL
	CAIGE AC,17		;DONE ALL OF THEM?
	  AOJA AC,RS3		;NO,LOOP BACK TILL DONE
	MOVE A,[CZ%ABT!.FHSLF]	;NOW CLOSE ALL FILES
	CLZFF			;DELETING ALL FILES BEING CREATED
	MOVE 1,[XWD CHTABS,CHTABS+1]
	SETZM -1(1)
	BLT 1,CHTEND-1		;CLEAR FILE DATA AREA
	XCTUU <HLRZ A,.JBSA>
	XCTUU <MOVEM A,.JBFF>
	PUSHJ P,TTYSST		;GO SET TTY STATUS
	PUSHJ P,SETPSI		;SET UP THE PSI SYSTEM
	POPJ P,			;RETURN
;ROUTINE TO SIMULATE RESDV UUO

RESDV:	JUMPL CAC,RETM1		;NEGATIVE CHANNEL IS ILLEGAL
	CAILE CAC,17		;CHECK FOR LEGAL CHANNEL #
	JRST RETM1		;NOT LEGAL, RETURN -1
	MOVE BB,CAC
	IMULI BB,NTABS		;GET INDEX INTO DEVICE TABLES
	SKIPG A,JFNTAB(BB)	;IS THERE A FILE OPEN HERE?
	JRST RESDV1		;NO
	SKIPE MAPTAB(BB)	;ANY MAPPED PAGES HERE?
	PUSHJ P,UNMAPP		;YES, GO UNMAP THEM
	MOVX A,CZ%ABT		;NOW CLOSE AND ABORT THE FILE
	HRR A,JFNTAB(BB)	;GET JFN BACK
	CLOSF
	 HRRZ A,JFNTAB(BB)	;FAILED, TRY TO RELEASE THE JFN
	RLJFN
	 JFCL
RESDV1:	SETZM CHTABS(BB)	;NOW ZERO THE STORAGE AREA
	HRLI A,CHTABS(BB)	;NOW SET UP THE BLT
	HRRI A,CHTABS+1(BB)
	BLT A,CHTABS+NTABS-1(BB)
	JRST MRETN2		;AND GIVE THE SUCCESS RETURN
IRESET:	PUSHJ P,CLRUFD		;CLEAR UFD JFN IF SAVED
	SETZM USRENB		;CLEAR USER-REQUESTED INTERRUPTS
	PUSHJ P,SETPSI		;AND ADJUST PSI SYSTEM ACCORDINGLY
	MOVEI A,PRIJFN		;SET UP JFN FOR TTY
	MOVE E,TYSTAT		;AND MODE
	PUSHJ P,NOCTRO		;CLEAR CONTROL-O FLAG
	MOVEI BB,NTABS		;CHANNEL 1
	MOVEI AC,1		;PUT CHANNEL # IN AC
	PUSHJ P,URELR		;RELEASE IT
	ADDI BB,NTABS
	CAIE BB,20*NTABS
	AOJA AC,.-3		;NEXT CHANNEL
REL0:	SETZB BB,AC		;CHANNEL 0
	PUSHJ P,URELR		;RELEASE IT
	POPJ P,

CLRUFD:	SKIPN A,LSTUFJ		;IS THERE A SAVED UFD JFN
	  POPJ P,		;NO
	HRRZS A			;YES, RELEASE IT
	RLJFN
	JFCL
	SETZM LSTUFJ		;CLEAR SAVED JFN
	POPJ P,

;CLOSE COMMAND

CLSCMD:	MOVEM 17,ACS+17		;SAVE ALL ACS
	MOVEI 17,ACS
	BLT 17,ACS+16
	SETOM INPAT		;ACS NOW SAVED
	MOVE P,PATSTK		;GET PUSH DOWN LIST
	HLLZ PF,PFLAGS		;AND FLAGS
	SKIPE CAC,CLSDEV	;ANY SPECIFIC DEV TO CLOSE?
	  JRST CLSCM1		;YES, GO DO IT
	PUSHJ P,IRESET		;NO, CLOSE THEM ALL
	JRST CLSDON		;AND CLEAN UP

CLSCM1:	SETZB AC,BB		;INIT ACS
CLSCM2:	HRRZ B,JFNTAB(BB)	;GET THE JFN
	CAME CAC,B		;IS THIS THE JFN TO BE CLOSED?
	CAMN CAC,DEVNAM(BB)	;OR IS THIS A DEV TO BE CLOSED
	  PUSHJ P,URELR		;YES, GO CLOSE IT
	ADDI BB,NTABS		;INCREMENT INDEX
	CAIGE AC,17		;CHECKED ALL CHANNELS?
	  AOJA AC,CLSCM2	;NO, LOOP BACK
CLSDON:	MOVEM PF,PFLAGS		;SAVE FLAGS
	MOVSI 17,ACS		;AND THEN RESTORE ACS
	BLT 17,17
	SETZM INPAT		;AND LEAVE PAT
	HALTF


;ROUTINE TO DO A -5 TYPE OF CLOSE - JUST UNMAP THE FILE PAGES
;	AND SET THE EOF PROPERLY
;THIS ROUTINE IS CALLED BY THE EXEC

UNMCMD:	MOVEM 17,ACS+17		;SAVE ALL ACS
	MOVEI 17,ACS
	BLT 17,ACS+16
	SETOM INPAT		;ACS NOW SAVED
	MOVE P,PATSTK		;GET PUSH DOWN LIST
	HLLZ PF,PFLAGS		;AND FLAGS
	SETZB AC,BB		;SET UP FILE ACS
UNMCM1:	PUSHJ P,UNMAPP		;UNMAP THE PAGES
	LDB AA,PDVNUM		;GET DEVICE TYPE CODE
	CAIN AA,DSK		;DISK?
	PUSHJ P,SETEOF		;YES, SET THE EOF
	ADDI BB,NTABS		;STEP TO THE NEXT JFN
	CAIGE AC,17		;STEPPED THRU THEM ALL YET?
	AOJA AC,UNMCM1		;NO, LOOP BACK FOR THE NEXT ONE
	MOVEM PF,PFLAGS		;SAVE FLAGS
	MOVSI 17,ACS		;AND THEN RESTORE ACS
	BLT 17,17
	SETZM INPAT		;AND LEAVE PAT
	HALTF
;THE TMPCOR UUO AND ITS ROUTINES

;THE TMPUUO CODE WAS LIFTED DIRECTLY FROM THE TOPS-10 MONITOR

;AC DEFINITIONS FOR TOPS-10 ACS

	S=PF
	T1=A
	T2=B
	T3=C
	T4=D
	J=E
	F=F
	M=G
	P1=AA
	P2=BB
	P3=CC
	P4=AC

	TMPBL==4		;BLOCK SIZE FOR DATA
	TMPBKS==<1000/<TMPBL+1>>-1 ;NUMBER OF DATA BLOCKS
	TMPSZ==TMPBKS*TMPBL	;AMOUNT OF DATA STORAGE AVAILABLE
	TMPBKJ==TMPBKS		;BLOCKS PER JOB
	TMPSZJ==TMPBKJ*TMPBL	;DATA SPACE PER USER

	JBTTMP=TMPPAG_11
	TMPTAB=TMPPAG_11+2

;PRARG BLOCK FORMAT:

;0:	NUMBER OF FILES
;1:	ADR OF FIRST FILE
;2:	ADR OF SECOND FILE
;		.
;		.
;N:	ADR OF N'TH FILE
;N+1:	XWD NAME , LEN		;FIRST FILE NAME AND LENGTH
;	   FIRST FILE DATA

;		ETC.

TMPCOR:	SKIPE TMPJFN		;READ IN TMPCOR YET?
	JRST PRATM1		;YES, GO USE IT
	MOVE A,[.PRARD,,.FHSLF]	;GET PROCESS ARGUMENTS
	MOVEI B,JBTTMP
	MOVEI C,1000		;MAX OF ONE PAGE
	PRARG
	JUMPLE C,NOPRA		;NO PROCESS ARGUMENTS SET, USE FILE
	SETOM TMPJFN		;MARK THAT PRARG WAS SUCCESSFUL
PRATM1:	SKIPL TMPJFN		;IS PRARG IN EFFECT
	JRST NOPRA		;NO, GO USE FILE
	HLRZ A,CAC		;GET CODE
	CAILE A,5		;LEGAL CODE
	JRST CMRETN		;NO, BOMB OUT
	JRST @PRATAB(T1)	;DISPATCH

PRATAB:	RETZR1			;SIZE IS ALWAYS 0
	PRARDF			;READ FILE
	PRARDF			;READ AND DELETE
	RETZER			;WRITE
	PRADIR			;READ DIR
	PRADIR			;READ AND DELETE DIR
;READ AND READ AND DELETE

PRARDF:	XCTUU <HLLZ A,0(CAC)>	;GET FILE NAME
	PUSHJ P,PRASRC		;SEARCH FOR THE NAME
	 JRST RETZER		;NOT FOUND
	UMOVE D,1(CAC)		;GET POINTER TO BUFFER
	HRRZ C,0(A)		;GET LENGTH OF FILE
	UMOVEM C,0(AC)		;STORE LENGTH IN AC
	TLNN CAC,1		;DELETE FILE?
	SETZM 0(A)		;YES, DELETE THIS ENTRY
	JUMPE D,PRARDD		;IF USER DOESNT WANT ANY, GO EXIT
PRARDL:	SOJL C,PRARDD		;IF DONE, GO EXIT
	AOS A			;STEP POINTER TO FILE AREA
	MOVE B,0(A)		;GET NEXT WORD OF FILE
	UMOVEM B,1(D)		;STORE IT IN USER BUFFER
	AOBJN D,PRARDL		;LOOP BACK FOR ALL WORDS
PRARDD:	JRST MRETN2		;DONE

;ROUTINE TO SEARCH FOR A NAME
;ACCEPTS IN A/	NAM,,0

PRASRC:	JUMPE A,CPOPJ		;IF NULL NAME, RETURN FAILURE
	MOVN D,JBTTMP		;GET NUMBER OF FILES
	HRLZS D			;SET UP AOBJN COUNTER
	JUMPE D,CPOPJ		;IF NONE, EXIT
PRASR1:	MOVE C,JBTTMP+1(D)	;GET NEXT ARG POINTER
	HLLZ B,JBTTMP(C)	;GET FILE NAME
	CAMN A,B		;FOUND THE ONE WE WANT?
	JRST PRASR2		;YES
	AOBJN D,PRASR1		;NO, LOOP BACK TIL FOUND
	POPJ P,			;NOT FOUND

PRASR2:	MOVEI A,JBTTMP(C)	;FOUND IT, RETURN ADR OF BLOCK
	JRST CPOPJ1


;ROUTINE TO READ THE DIRECTORY

PRADIR:	HRRZ A,JBTTMP		;GET NUMBER OF FILES
	XCTUU <SETZM 0(AC)>	;START WITH 0 FILES
	JUMPE A,MRETN2		;IF NONE, RETURN
	TLNE CAC,1		;DELETE DIR?
	SETZM JBTTMP		;YES
	UMOVE D,1(CAC)		;GET USER BUFFER
	JUMPE D,MRETN2		;USER WANT ANY?
PRADIL:	SKIPE C,JBTTMP+1(A)	;GET NEXT ARG
	SKIPN B,JBTTMP(C)	;GET NAME AND LENGTH OF FILE
	JRST PRADI1		;NOT THERE
	UMOVEM B,1(D)		;STORE NAME AND LEN IN USER BUFFER
	XCTUU <AOS 0(AC)>	;COUNT UP NUMBER OF FILES STORED
	AOBJP D,MRETN2		;RAN OUT OF SPACE YET?
PRADI1:	SOJG A,PRADIL		;LOOP BACK FOR ALL NAMES
	JRST MRETN2		;DONE
NOPRA:	SKIPE A,TMPJFN		;HAS THE TMP FILE BEEN OPENED YET?
	  JRST TMPCR1		;YES, DONT OPEN IT NOW
	HRROI A,STRNG1		;MAKE A FILE NAME FOR THIS TMPCOR FILE
	MOVE B,JOB		;IT SHOULD BE "XXXTMPCOR-DATA-BASE.TMP"
	MOVE C,[XWD 140003,12]	;GET JOB # INTO ASCIZ WITH LEADING 0'S
	NOUT
	  JRST MRETN		;JOB NUMBER TO BIG ( >999 )
	MOVE B,[POINT 7,[ASCIZ/TMPCOR-DATA-BASE.TMP;T/]]
	ILDB C,B		;ADD REST OF FILE NAME TO STRING
	IDPB C,A
	JUMPN C,.-2		;LOOP BACK UNTIL NULL SEEN
	MOVSI A,110001		;NOW SEE IF FILE ALREADY EXISTS
	HRROI B,STRNG1
	GTJFN
	  JRST NOTMPF		;FILE NOT THERE, GO CREATE IT
	MOVE B,[XWD 440000,300000]
	OPENF			;OPEN FILE FOR READ AND WRITE ACCESS
	  JRST MRETN		;FAILED, CANNOT DO TMPCOR UUO
	HRRZM A,TMPJFN		;SAVE THIS JFN FOR ALL SUBSEQUENT UUOS
	HRLZS A			;NOW PMAP FILE INTO CORE
	RPACS			;SEE IF PAGE EXISTS
	TLNN B,(1B5)		;...
	  JRST NOTMP1		;NOT THERE, GO INITIALIZE IT
	MOVSI B,.FHSLF		;INTO THIS FORK
	HRRI B,TMPPAG		;INTO PRESERVED PAGE FOR TMPCOR
	MOVSI C,140000		;READ AND WRITE ACCESS
	PMAP
TMPCR0:	HRRZ T1,TMPJFN		;CLOSE JFN OF TMPCOR
	CLOSF			;SO IT GOES AWAY ON EXIT
	JFCL
TMPCR1:	MOVEI J,1		;ALWAYS BE JOB 1
	MOVE T1,CAC		;GET CONTENTS OF USERS AC
	MOVE M,FORTY		;GET UUO
	MOVEM PF,PFLAGS		;PRESERVE FLAGS
	PUSHJ P,TMPUUO		;GO DO UUO
	  SKIPA
	AOS (P)			;SUCCESSFUL
	MOVE PF,PFLAGS		;RESTORE FLAGS
	JRST MRETN		;RETURN

NOTMPF:	MOVSI A,410001		;NO TMP FILE, SO WE WILL CREATE ONE
	HRROI B,STRNG1		;GET POINTER TO NAME
	GTJFN			;OPEN A NEW TMP FILE
	  JRST [PUSHJ P,WARN	;IF OVER QUOTA OR DIR FULL WARN USER
		JRST MRETN	;GIVE ERROR RETURN
		JRST NOTMPF]	;DID AN EXPUNGE, TRY AGAIN
   IFN 0,<;DON'T DELETE TMPCOR
	HRLI A,FDBCTL		;SET THE DELETED BIT IN FDB
	MOVSI B,(FDBDEL)
	MOVSI C,(FDBDEL)	;MAKE FILE BE DELETED SO IT WONT BE IN
	XJSYS <CHFDB>		;  DIRECTORY
	  JFCL
   >;END IFN 0
	HRRZS A			;RESTORE JFN
	MOVE B,[XWD 440000,300000]
	PUSH P,A		;SAVE JFN
	OPENF			;OPEN IT FOR READING AND WRITING
	  JRST [PUSHJ P,WARN	;WARN USER IF OVER QUOTA
		JRST MRETN	;THEN GIVE ERROR RETURN
		POP P,A		;GET BACK JFN
		RLJFN		;RELEASE IT
		 JFCL
		JRST NOTMPF]	;DID AN EXPUNGE, TRY AGAIN
	HRLZS A			;NOW PMAP FILE INTO CORE
NOTMP1:	MOVSI B,.FHSLF		;INTO THIS FORK
	HRRI B,TMPPAG		;INTO PRESERVED PAGE FOR TMPCOR
	MOVSI C,140000		;READ AND WRITE ACCESS
	PMAP
	MOVEI A,TMPPAG_11+4	;GET START OF TMPCOR SPACE
	HRLI A,TMPSZ		;GET AMOUNT OF DATA SPACE AVAILABLE
	MOVEM A,TMPTAB		;INITIALIZE TABLE
	HRLZI A,TMPSZJ		;GET DATA SPACE PER USER
	HRRI A,TMPBKS		;AND NUMBER OF BLOCKS ALLOWED
	MOVEM A,TMPTAB+1	;SAVE IN TABLE
	HLLZ B,TMPTAB+1		;GET FILE LIMIT PER USER
	MOVEM B,JBTTMP+1	;SAVE IN JBT TABLE
	MOVE A,TMPTAB		;GET START OF SPACE
	MOVEM A,JBTTMP		;STORE
	HRRZ B,TMPTAB+1		;GET COUNT OF BLOCKS
TMPIN1:	ADDI A,TMPBL+1		;LINK ALL BLOCKS TOGETHER
	HRRZM A,-TMPBL-1(A)
	SOJG B,TMPIN1		;LOOP FOR ALL BLOCKS
	HLLZS -TMPBL-1(A)	;ZERO LAST LINK
	POP P,A			;RESTORE JFN
	HRLI A,FDBSIZ+CF%NUD_^D18	;CHANGE FDB TO HAVE A 1 PAGE FILE
	MOVNI B,1		;SET UP EOF POINTER
	MOVEI C,1000		;ONE PAGE LONG
	XJSYS <CHFDB>
	  JFCL
	HRLI A,FDBBYV+CF%NUD_^D18	;NOW SET UP BYTE SIZE
	MOVSI B,7700		;..
	MOVSI C,(^D36B11)	;36 BIT BYTES
	XJSYS <CHFDB>
	  JFCL
	HRRZM A,TMPJFN		;SAVE JFN OF TMPCOR FILE
	JRST TMPCR0		;NOW GO PMAP FILE IN

UUOERR:	MOVE PF,PFLAGS		;GET THE CORRECT FLAGS
	PUSHJ P,BUGSTP		;BOMB THE JOB

GETWD1:	HRRI M,1(M)		;INCREMENT M
GETWDU:	TLZ M,37
	PUSH P,PF		;SAVE AC
	MOVE PF,PFLAGS		;IN CASE ARG OUT OF BOUNDS
	UMOVE T1,@M		;GET VALUE
	POP P,PF		;RESTORE PF
	POPJ P,

PUTWD1:	HRRI M,1(M)		;INCREMENT M
PUTWDU:	TLZ M,37
	PUSH P,PF		;SAVE AC
	MOVE PF,PFLAGS		;SET UP FLAGS IN CASE OF ADRCHK ERROR
	UMOVEM T1,@M		;STORE WORD
	POP P,PF		;RESTORE PF
	POPJ P,
;	TITLE	TMPUUO -- TEMPORARY FILE STORAGE UUO - V010
;	SUBTTL	TONY LAUCK  11 APR 72
;	XP	VTMPUU,10	;PUT VERSION NUMBER IN GLOB AND MAP

REPEAT 0,<

		TEMPORARY FILE STORAGE FOR JOB UUO.

	THE	"TMPCOR" UUO IS USED TO ENABLE A JOB TO LEAVE SEVERAL SHORT
FILES IN CORE FROM THE RUNNING OF ONE USER PROGRAM OR CUSP TO THE
NEXT. THESE FILES MAY BE REFERRED TO BY A THREE CHARACTER FILE NAME,
AND ARE UNIQUE TO EACH JOB, I.E. A JOB CAN ONLY REFERENCE ITS OWN
FILES. ALL FILES ARE ALWAYS DELETED WHEN A JOB IS KILLED.

	EACH	FILE APPEARS TO THE USER AS ONE DUMP MODE BUFFER. THE ACTUAL SIZE OF A
TEMPORARY FILE, THE NUMBER OF TEMPORARY FILES A USER CAN HAVE,
AND THE TOTAL CORE SPACE A USER CAN TIE UP ARE PARAMETERS DETER-
MINED AT MONGEN TIME. ALL TEMPARARY FILES RESIDE IN A FIXED AREA
IN THE MONITOR, BUT THE SPACE IS DYNAMICALLY ALLOCATED AMOUNG
DIFFERENT JOBS AND THE SEVERAL DIFFERENT FILES OF ANY GIVEN JOB.

	THE	PRIMARY PURPOSE OF THE TEMPORARY STORAGE SYSTEM IS FOR SHORT
CONTROL FILES, E.G. CCL FILES, TO LIVE IN CORE, THEREBY SPEEDING
UP RESPONSE TIMES AND REDUCING DISK OPERATIONS. ACCORDINGLY, 
SHOULD A PROGRAM ATTEMPT TO WRITE A FILE WHEN THERE IS 
INSUFFICIENT SPACE, EITHER IN THE ENTIRE BUFFER AREA OR BECAUSE
THE USER HAS EXCEEDED HIS QUOTA, THE UUO GIVES AN ERROR RETURN.
THE CUSP CAN THEN WRITE THE DATA AS A SHORT DISK FILE.
SIMILARLY, SHOULD A PROGRAM FAIL TO FIND A FILE UPON READING IT,
IT WILL GET AN ERROR RETURN AND CAN THEN LOOKUP A SHORT DISK FILE.


	IT	IS VERY IMPORTANT TO REALIZE THE TEMPORARY NATURE OF THESE
FILES. FOR EXAMPLE, UPON WRITING, THE OLD FILE IS DELETED BEFORE
CHECKING FOR SPACE FOR A NEW VERSION. THE OLD FILE COULD BE LOST WITHOUT
A NEW ONE REPLACING IT. ALSO, THERE CAN BE NO GUARANTEE THAT FILES
WILL FIT IN CORE.


	THE	TMPCOR UUO IS NOT INTENDED TO REPLACE A FUTURE, MORE
GENERAL, DEVICE INDEPENDENT SERVICE ROUTINE FOR "CORE". HOWEVER,
THE SPACE TAKEN UP BY DEVICE DATA BLOCKS, ETC., IN THAT MORE
GENERAL ROUTINE WOULD REPRESENT UNNECESSARY OVERHEAD FOR EXTREMELY
SHORT DATA, SUCH AS CCL COMMAND FILES.
>
	REPEAT	0,<
	FORMAT	OF TEMPORARY FILE STORAGE UUO.

	CALL	AC, [SIXBIT /TMPCOR/]	;CALLI INDEX=44
	;ERROR RETURN
	;NORMAL RETURN

	C(AC) MUST ALWAYS BE SET UP BY THE USER PROGRAM PRIOR TO EXECUTING
THE UUO. IT IS CHANGED BY THE UUO AND RETURNS A VALUE THAT DEPENDS
ON THE PARTICULAR FUNCTION PERFORMED.

	C(AC) = XWD CODE,BLOCK

BLOCK:	XWD	NAME,0		;NAME IS FILE NAME
	IOWD	BUFLEN,BUFFER	;USER BUFFER AREA (ZERO  FOR NO BUFFER)
>
	REPEAT	0,<
		CODE-0	--  GET FREE SPACE

	THE	IS THE ONLY FORM OF THE TEMP UUO THAT DOES NOT USE A TWO
WORD PARAMETER BLOCK. C(AC) WOULD ORDINARLY BE SET TO ZERO FOR THE
GET FREE SPACE UUO. THE USER PROGRAM ALWAYS GETS A NORMAL RETURN
(UNLESS THE SYSTEM DOES NOT HAVE THE TEMP UUO). C(AC) IS SET TO
THE NUMBER OF WORDS OF FREE SPACE AVAILABLE TO THE USER.


		CODE=1	--  READ FILE

	IF	THE SPECIFIED FILE NAME IS NOT FOUND, C(AC) IS SET TO THE
NUMBER OF FREE WORDS OF SPACE AVIALABLE FOR TEMP FILES, AND THE
ERROR RETURN IS TAKEN.

	IF	THE FILE IS FOUND, C(AC) IS SET TO THE LENGTH OF THE
FILE IN WORDS, AND AS MUCH OF THE FILE AS WILL FIT IS COPIED INTO
THE USERS BUFFER. THE USER CAN CHECK FOR TRUNCATION BY COMPARING
C(AC) WITH BUFLEN UPON SUCCESSFUL RETURN FROM THE TEMP UUO.


		CODE=2	--  READ AND DELETE FILE

	THIS	IS THE SAME AS CODE=1, EXCEPT THAT IF A FILE WAS FOUND
IT IS ALSO DELETED AND ITS SPACE RECLAIMED.
>
	REPEAT	0,<
		CODE=3	--  WRITE FILE

	IF	THERE IS ALREADY A FILE OF THE SPECIFIED NAME, IT IS
DELETED AND ITS SPACE IS RECLAIMED.

	THE	REQUESTED SIZE OF THE FILE IS SPECIFIED BY BUFLEN. 
IF THERE IS NOT ENOUGH SPACE TO WRITE THE ENTIRE FILE, NOTHING
IS WRITTEN, C(AC) IS SET TO THE NUMBER OF FREE WORDS OF SPACE 
AVAILABLE TO THE USER, AND THE ERROR RETURN IS TAKEN.

	IF	THERE IS ENOUGH SPACE, THE FILE IS WRITTEN. C(AC) IS SET TO
THE AMOUNT OF SPACE LEFT AFTER THE FILE HAS BEEN WRITTEN AND THE
NORMAL RETURN IS TAKEN. FILES ARE ALWAYS FILLED UP WITH ZEROS TO THE
NEXT EVEN MULTIPLE OF THE BLOCK LENGTH (TMPBL).
	THIS	EVEN LENGTH IS READ BACK IN.


		CODE=4	--  READ DIRECTORY

	THE	ERROR RETURN IS NEVER TAKEN.

	C(AC) IS SET TO THE NUMBER OF DIFFERENT FILES IN THE JOB'S
TEMPORARY FILE AREA. IN ADDITION, AN ENTRY IS MADE FOR EACH FILE
IN THE USER BUFFER AREA UNTIL THERE IS NO MORE SPACE OR ALL FILES HAVE
BEEN LISTED. THE USER PROGRAM CAN CHECK FOR TRUNCATION BY COMPARING
C(AC) UPON RETURN WITH BUFLEN.

	DIRECTORY ENTRY FORMAT
	XWD  NAME,SIZE	;NAME=FILE NAME, SIZE =FILE LENGTH IN WORDS.


		CODE=5	--  READ AND CLEAR DIRECTORY

	THIS	IS THE SAME AS CODE=4 EXCEPT THAT ANY FILES IN THE JOB'S
TEMPORARY STORAGE AREA ARE ALSO DELETED AND THEIR SPACE RECLAIMED.

	THIS	UUO IS EXECUTED BY THE LOGOUT CUSP.
>
	REPEAT	0,<
		IMPLEMENTATION

	MASTER	DIRECTORY

	THIS	IS A TABLE JOBN+1 ENTRIES LONG.

JBTTMP:	XWD	FREE,IDLE
JBTTM1:	XWD	SPACE,LINK
	   .
	   .
	   .

MREE = NO. OF FREE BLOCKS IN MONITOR BUFFER AREA
IDLE  =  LINK TO FIRST FREE BLOCK OR 0 IF NO FREE BLOCKS
SPACE  =  NO OF FREE BLOCKS REMAINING IN JOBS QUOTA
LINK  =  LINK TO FIRST BLOCK OF FIRST FILE OF JOB, 0 IF NONE.


	IDLE	BLOCK FORMAT

	XWD	0,LINK
	REPEAT	TMPBL, <0
			>

	LINK  = LINK TO NEXT BLOCK ON IDLE CHAIN, 0 IF NO MORE.

	USER	BLOCK FORMAT

	XWD	NAME,LINK
	BLOCK	TMPBL		;USER DATA OR ZERO FILL.

	NAME	= USER FILE NAME.
	LINK	= LINK TO NEXT BLOCK IN THIS FILE OR NEXT FILE OF THIS USER

	IF	A FILE IS SEVERAL BLOCKS LONG, EACH BLOCK HAS THE FILE NAME.
	A	LINK OF 0 INDICATES NO MORE DATA IN THE FILE, AND NO MORE FILES
FOR THIS USER.

	THEREFORE, A FILE ENDS WHEN ITS LAST BLOCK HAS A ZERO LINK, OR 
WHEN IT LINKS TO A FILE OF DIFFERENT NAME.



	MONITOR	BUFFER AND PARAMETERS

TMPBUF:	BLOCK	TMPBKS*<TMPBL+1>	;BUFFER AREA FOR ALL FILES.

	TMPBKS	IS THE NUMBER OF BLOCKS THE STORAGE AREA IS COMPUTED.
	IT	IS COMPUTED BY MACRO DURING THE ASSEMBLY OF COMMON.
	TMPBL	IS A PARAMETER IN S.MAC.
>
	REPEAT	0,<
	FACTORS	AFFECTING SYSTEM

	1. MONITOR MUST INITALIZE THE TEMP FILES ON RESTART.
	A) CLEAR ENTIRE BUFFER AREA
	B) SET FREE COUNT TO TOTAL NUMBER OF 5 WORD BLOCKS
	C) LINK ALL BLOCKS ON IDLE CHAIN
	D) SET ALL USERS SPACE TO THEIR QUOTA AND LINKS TO 0


	2.  LOGOUT MUST DO A CLEAR OF USERS DIRECTORY

	3. PIP SHOULD CLEAR USERS DIRECTORY ON A DEL *.TMP COMMAND

	4.  PIP SHOULD READ AND WRITE TEMP FILES. DEVICE TMP:?

	5.  ALL CCL CUSPS MUST BE CHANGED TO DO TEMP UUO.
>
;	ENTRY	TMPUUO
;	INTERN	TMPUUO,TMPTAB
;	EXTERN	CPOPJ,CPOPJ1,STOTAC,GETWDU,UUOERR,JBTTMP,GETWD1,PUTWD1

;TMPTAB:	0			;FREE DATA SPACE,ADDRESS OF TABLE
;	0			;USER QUOTA,NUMBER OF BLOCKS
TMPUUO:
;	PUSHJ	P,SAVE4##	;SAVE P1-P4
	AOS	(P)		;SET FOR GOOD RETURN
	MOVE	P4,T1		;GET USERS AC
	TLNN	P4,-1		;IS CODE = 0?
	JRST	TMPSP		;YES, SO JUST RETURN SPACE LEFT
	HRR	M,P4		;SETUP M TO GET FIRST WORD OF BLOCK
	PUSHJ	P,GETWDU	;GET FIRST WORD
	HLLZ	S,T1		;SAVE FILE NAME
	PUSHJ	P,GETWD1	;GET SECOND WORD
	HLRE	F,T1		;GET USER'S BUFFER LENGTH
	MOVNS	F
	HRR	M,T1		;USER'S BUFFER ADDRESS
	HLRZS	P4		;GET CODE
	CAILE	P4,TMPDL		;CHECK IF IT IS LEGAL
	JRST	UUOERR		;NO
	JRST	@TMPDIS-1(P4)	;DISPATCH TO APPROPRIATE ROUTINE

TMPDIS:	JRST	TMPREA
	JRST	TMPREA
	JRST	TMPWR
	JRST	TMPDIR
	JRST	TMPDIR

	TMPDL== .-TMPDIS
	;ROUTINE TO READ, OR READ AND DELETE A TEMPORARY FILE

TMPREA:	PUSHJ	P,TMPSRC	;FIND FILE
	JRST	TMPSPB		;NONE, SO RETURN SPACE
	SETZ	T3,		;ZERO USER COUNT
TMPRE1:	HRLI	P1,-TMPBL	;SET COUNT TO NO WORDS IN BLOCK
TMPRE2:	SOJL	F,TMPR2A	;COUNT DOWN USER BUFFER SPACE
	MOVE	T1,1(P1)
	PUSHJ	P,PUTWD1	;IF SPACE, COPY 1 WORD
TMPR2A:	ADDI	T3,1		;ADD TO USER COUNT
	AOBJN	P1,TMPRE2	;GO ON WITH BUFFER IF MORE WORDS
	SUBI	P1,TMPBL	;GET BACK TO START OF BLOCK
	TRNN	P4,1		;SHOULD WE DELETE?
	PUSHJ	P,TMPDEL	;DELETE THIS BLOCK
	PUSHJ	P,TMPCHA	;CHAIN TO NEXT BLOCK IN FILE
	JRST	TMPRE1		;FOUND, GO HANDLE IT
TMPRE3:	SETZ	T1,
TMPFLL:	SOJL	F,STOT3		;FILL REST OF USERS BUFFER
	PUSHJ	P,PUTWD1	;WITH ZEROS, THEN GIVE HIM COUNT
	AOJA	T4,TMPFLL


	;ROUTINE TO CHAIN TO NEXT BLOCK OF A FILE

TMPCHA:	HRRZ	P1,(P1)		;CHAIN TO NEXT BLOCK
	HLLZ	P3,(P1)		;GET FILE NAME
	CAMN	P3,S		;MATCH?
	JUMPN	P1,CPOPJ	;YES, IS THERE A BLOCK?
	JRST	CPOPJ1		;NO, SKIP RETURN


	;ROUTINE TO FIND A FILE

TMPSRC:	MOVEI	P2,JBTTMP(J)	;GET ADDRESS OF FIRST LINK
TMPSR1:	HRRZ	P1,(P2)		;CHAIN FORWARD
	JUMPE	P1,CPOPJ	;NONE, FILE NOT FOUND
	HLLZ	T2,(P1)		;GET FILE NAME
	CAMN	T2,S		;MATCH?
	JRST	CPOPJ1		;YES, SKIP RETURN
	HRRZ	P2,P1		;SAVE OLD POINTER
	JRST	TMPSR1		;AND KEEP ON LOOKING




	;ROUTINE TO DELETE A BLOCK

TMPDEL:	HRRZ	P3,(P1)		;LINK AROUND BLOCK
	HRRM	P3,(P2)
	HRRZ	P3,JBTTMP	;LINK OLD BLOCK TO IDLE
	MOVEM	P3,(P1)
	HRRM	P1,JBTTMP	;LINK START OF IDLE CHAIN TO BLOCK
	HRRZ	P1,P2		;RESTORE P1 FOR TMPCHA
	MOVSI	P3,TMPBL	;UPDATE FREE COUNTERS
	ADDM	P3,JBTTMP
	ADDM	P3,JBTTMP(J)
	POPJ	P,
	;ROUTINE TO WRITE A FILE FOR USER

TMPWR:	PUSHJ	P,TMPSRC	;SEE IF THERE WAS AN OLD FILE
	JRST	TMPWR2		;NO
TMPWR1:	PUSHJ	P,TMPDEL	;DELETE A BLOCK
	PUSHJ	P,TMPCHA	;CHAIN TO NEXT BLOCK
	JRST	TMPWR1		;THERE WAS ONE, GO ON

TMPWR2:	PUSHJ	P,TMPSPC	;GET SPACE FOR USER
	SKIPE	T3
	CAMLE	F,T3		;DOES HE WANT MORE?
	JRST	TMPSPB		;YES, SO TELL HIM HE LOST

	HRRZ	P3,JBTTMP(J)	;SAVE LINK TO FIRST FILE
	MOVEI	P2,JBTTMP(J)	;SET OLD BLOCK ADDRESS

TMPWR3:	HRRZ	P1,JBTTMP	;GET ADDRESS OF FIRST IDLE BLOCK
	HRRZ	T2,(P1)		;GET ITS SUCCESSOR
	HRRM	T2,JBTTMP	;LINK THAT BLOCK TO IDLE CHAIN
	HRRM	P1,(P2)		;LINK LAST BLOCK OF USER TO NEW BLOCK
	HRRZ	P2,P1		;SAVE OLD BLOCK ADDRESS
	MOVSI	T2,-TMPBL	;DECREASE JOB AND TOTAL SPACE
	ADDM	T2,JBTTMP
	ADDM	T2,JBTTMP(J)

	HLLM	S,(P1)		;INSERT FILE NAME
	HRLI	T4,-TMPBL	;SET FOR NO WORDS/BLOCK
TMPWR4:	SOJL	F,TMPWR6	;DOES HE WANT TO WRITE MORE?
	PUSHJ	P,GETWD1	;GET A WORD
	PUSH	P1,T1		;YES, SO STICK IN HIS WORD
TMPWR5:	AOBJN	T4,TMPWR4	;UPDATE USER ADDR, IS BLOCK DONE?
	JUMPG	F,TMPWR3	;YES, DOES HE HAVE MORE?

	HRRM	P3,-TMPBL(P1)	;NO, LINK LAST BLOCK TO HIS FILES
	JRST	TMPSP		;GET SPACE AND RETURN

TMPWR6:	SETZM	1(P1)		;FILL FINAL BLOCK WITH ZERO
	AOJA	P1,TMPWR5	;AND GO ON UNTIL BLOCK DONE


	;ROUTINE TO COMPUTE SPACE FOR USERS TMP FILES

TMPSPC:	HLRZ	T3,JBTTMP	;TOTAL FREE SPACE
	HLRZ	T2,JBTTMP(J)	;USER LIMIT
	CAMLE	T3,T2		;SPACE IS MINIMUM OF THE TWO
	MOVE	T3,T2
	POPJ	P,


	;ROUTINE TO GET SPACE AND RETURN TO USER (SKIP AND NO SKIP)

TMPSPB:	SOS	(P)		;NO SKIP RETURN
TMPSP:	PUSHJ	P,TMPSPC	;GET SPACE
STOT3:
;	MOVE	T1,T3		;SET TO STORE T3
;	JRST	STOTAC		;RETURN IT
	LDB T1,ACPTR		;GET USER AC
	MOVEM T3,ACS(T1)	;STORE AC
	POPJ P,			;AND RETURN
	;READ DIRECTORY, READ AND CLEAR DIRECTORY

TMPDIR:	SETZ	T3,		;ZERO COUNT OF FILES
	MOVEI	P2,JBTTMP(J)	;SET LINK TO DELETE
	HRRZ	P1,(P2)		;LINK TO FIRST BLOCK
TMPDI1:	JUMPE	P1,TMPRE3	;IF NONE, ZERO REST OF USERS BUFFER
	HLLZ	S,(P1)		;GET FILE NAME
	MOVEI	T1,1		;SET LENGTH TO 1
TMPDI2:	TRNE	P4,1		;DELETE?
	PUSHJ	P,TMPDEL	;YES, DELETE BLOCK
	PUSHJ	P,TMPCHA	;GET NEXT BLOCK OF FILE
	AOJA	T1,TMPDI2	;THERE IS ONE, SO COUNT BLOCKS
	IMULI	T1,TMPBL	;GET LENGTH IN WORDS
	HLL	T1,S		;DONE, GET LENGTH, NAME OF OLD ONE
	SOSL	F		;IS THERE SPACE LEFT IN USER AREA?
	PUSHJ	P,PUTWD1	;YES, STOW ENTRY
	AOJA	T3,TMPDI1	;COUNT FILES, GO ON FOR NEXT ONE
SUBTTL TRAP HANDLING

;APR TRAPS ENABLE
; USER CALL IS
;	MOVEI AC,BITS
;	CALLI AC,16
;
;WHERE BITS ARE 1B18 FOR REPEATED TRAPS (EXCEPT CLK)
;	1B19 FOR PDLOV, 1B22 FOR ILL MEM REF, 1B23 FOR NXM
;	1B26 FOR CLOCK (NOT YET SUPPORTED), 1B29 FOR FOV, 1B32 FOR AROV

APRENB:	MOVEI A,.FHSLF		;THIS FORK
	MOVE B,[XWD LEVTAB,CHNTAB]
	SIR			;NEW PSEUDOINTERRUPT CHANNELS
	MOVEM CAC,USRENB	;SAVE FOR LATER REFERENCE
	LSH CAC,1		;MATCH UP WITH ENABLE FLAGS
	ANDI CAC,220		;FOR OV AND FOV
	MOVEM CAC,CNIWRD	;AND REMEMBER FOR APR CONI
	PUSHJ P,SETPSI		;SET UP PSI AS INDICATED BY USRENB
	EIR			;ENABLE INTERRUPT SYSTEM
	JRST MRETN

LIGHTS:	MOVEI A,.FHSLF		;THIS FORK
	RPCAP			;GET PROCESS CAPABILITIES
	MOVE A,CAC		;GET ARGUMENT TO DISPLAY
	TRNE C,WHEEL!OPER!MAINT	;WILL MONITOR COMPLAIN ABOUT LITES?
	LITES			;NO. DO IT.
	JRST MRETN

SWITCH:	SWTCH
	JFCL			;IGNORE ERROR RETURN
	JRST MRETN

;ADDRESS CHECK ROUTINES
;CALL:	MOVE A,ADDRESS
;	MOVE B,LENGTH		;OPTIONAL IF A BLOCK IS TO BE CHECKED
;	PUSHJ P,ADRCHK		;CALL ADRCKB IF CHECKING A BLOCK
;	RETURN HERE IF OK	;NO RETURN IF OUT OF BOUNDS

ADRCHK:	MOVEI B,1		;MAKE THIS A ONE WORD BLOCK
ADRCKB:	CAIGE A,20		;IN THE AC'S
	  JRST ADRCKL		;YES, GO CHECK END OF BLOCK
	CAML A,HSORG		;HIGH SEG ADDRESS?
	  CAMLE A,JBHRL		;YES, IS IT A LEGAL HIGH SEG?
	CAMG A,JBREL		;NO, IS THIS A LEGAL LOW SEG ADDRESS?
	CAIG A,.JBPFI		;IS THIS ADDRESS ABOVE THE PROTECTED AREA
	  JRST ITRAP		;ONE OF THE ABOVE FAILED
ADRCKL:	ADDI B,-1(A)		;GET LAST WORD IN BLOCK TO CHECK
	CAIGE B,20		;IN THE ACS?
	  POPJ P,		;YES, OK RETURN
	CAML B,HSORG		;HIGH SEG?
	  CAMLE B,JBHRL		;YES, OK?
	CAMG B,JBREL		;NO, OK LOW SEG ADR?
	CAIG B,.JBPFI		;CHECK ALSO PROTECTED DATA AREA
	  JRST ITRAP		;TOO BAD!
	POPJ P,			;BLOCK IS OK

SETDDT:	UMOVEM CAC,.JBDDT	;SET DDT ADDR
	HRRZM CAC,JBDDT		;SAVE DDT ADDR
	JRST MRETN
GETLIN:	GJINF			;GET TTY NUMBER FOR THIS JOB
	JUMPL D,RETZER		;DETACHED, RETURN ZERO
	MOVE B,D		;GET TTY NUMBER
	PUSHJ P,LIN26		;TRANSLATE TO 'TTYN'
	JRST STOTAC		;AND GIVE IT TO USER

;ROUTINE TO TURN TTY LINE # TO SIXBIT/TTYN/
;ACCEPTS IN B/	LINE NUMBER
;RETURNS IN A/	SIXBIT/TTYN/

LIN26:	HRROI A,STRNG1		;NOW GET TTY NUMBER IN ASCII
	MOVEI C,10		;RADIX 8 (OCTAL)
	NOUT
	  PUSHJ P,ERROR
	PUSHJ P,SEVN26		;TRANSLATE SEVEN BIT TO SIXBIT
	MOVSS A			;GET TTY# INTO RH
	HRLI A,'TTY'		;ADD IN TTY
	POPJ P,			;RETURN WITH ANSWER IN A

REASSI:	MOVEI A,0		;PRETEND IT FAILED
	UMOVEM A,1(AC)		;SET AC+1 TO 0
	JRST STOTAC		;AND AC TO 0
	SUBTTL MORE UUOS

;REMAP
; CAC/	DESIRED HISEG ORIGIN ,, DESIRED NEW LOWSEG END
; BLOCK BETWEEN NEW LOWSEG END AND OLD LOWSEG END WILL BE MOVED
; TO NEW HISEG

REMAP:	MOVE A,JBREL		;GET CURRENT LOW SEG END
	SUBI A,(CAC)		;LENGTH OF DATA TO MOVE
	JUMPLE A,MRETN		;RETURN IF .LE. 0
	HRRZ B,CAC		;GET NEW LOW SEG END
	TRO B,777		;FORCE END OF PAGE
	MOVEI C,.HSLOC		;GET DEFAULT HI SEG ORIGIN
	CAMG C,B		;ABOVE LOW SEG END?
	MOVEI C,1(B)		;NO, FORCE ABOVE
	HLRZ D,CAC		;GET DESIRED HI SEG ORIGIN
	SKIPN D			;DID HE SPECIFY
	MOVE D,C		;NO, USE DEFAULT
	TRZ D,777		;FORCE BEGINNING OF PAGE
	CAMG D,B		;ABOVE NEW LOW SEG END?
	JRST MRETN		;NO, RETURN
	MOVE C,D		;COPY HI SEG ORIGIN
	ADDI C,-1(A)		;COMPUTE LAST WORD OF NEW HI SEG
	TRO C,777		;FORCE END OF PAGE
	TLNE PF,L.FLSR		;FILSER MAPPED?
	CAIGE C,FLSRLC		;YES, MUST BE BELOW IT
	CAIL C,PATLOC		;ELSE MUST BE BELOW US
	JRST MRETN		;NEW TOP TO HIGH, RETURN
	XCTUU <HRRZM C,.JBHRL>	;STORE NEW HI SEG END FOR USER
	EXCH C,JBHRL		;EXCHANGE NEW END FOR OLD
	JUMPE C,REMAP1		;JUMP IF NO OLD TO FLUSH
	SETO A,			;PREPARE TO FLUSH OLD HI SEG
	LDB B,[PAGEN HSORG]	;OLD ORIGIN PAGE
	HRLI B,.FHSLF		;OUR FORK
	MOVEI C,PATPAG		;UP TO HERE
	TLNE PF,L.FLSR		;UNLESS FILSER MAPPED
	MOVEI C,FLSRPG		;THEN HERE
	SUBI C,(B)		;NUMBER OF PAGES TO FLUSH
	TLO C,(1B0)		;REPEAT ARG
	PMAP			;GOODBYE TO OLD HI SEG
REMAP1:	HRRZM D,HSORG		;STORE NEW HI SEG ORIGIN
	MOVE B,JBREL		;CURRENT LOW SEG END
	SUBI B,(CAC)		;LENGTH OF DATA TO MOVE
	MOVE C,B		;SAVE COPY OF HI SEG LENGTH
	XCTUU <HRLM B,.JBHRL>	;STORE NEW HI SEG FREE POINTER
	ADDI B,-1(D)		;COMPUTE LAST WORD OF DESTINATION
	CAMG D,JBREL		;IS NEW ORIGIN ABOVE CURRENT END?
	JRST REMAP2		;NO, MUST USE SLOW CODE
	HRLI D,1(CAC)		;NO OVERLAP, GET SOURCE FOR BLT
	BLT D,(B)		;MOVE DATA
	JRST REMAP3

REMAP2:	HRRO A,JBREL		;GET LAST WORD OF SOURCE
REMP2A:	POP A,(B)		;MOVE A WORD ADJUSTING SOURCE
	SUBI B,1		;ADJUST DESTINATION
	SOJG C,REMP2A		;TEST FOR ALL WORDS MOVED AND LOOP
REMAP3:	HRRZ A,CAC		;GET NEW END AGAIN
	TRO A,777		;FORCE END OF PAGE
	MOVEM A,JBREL		;SAVE HERE
	XCTUU <HRRM A,.JBREL>	;AND HERE
	LDB B,[PAGEN JBREL]	;GET LOW SEG END PAGE
	ADDI B,1		;GET FIRST PAGE TO FLUSH
	LDB C,[PAGEN HSORG]	;GET HIGH SEG START PAGE
	SUBI C,(B)		;COMPUTE # OF PAGES TO FLUSH
	JUMPE C,MRETN2		;ALL DONE IF NONE, SUCCESS
	SETO A,			;PREPARE TO FLUSH SOURCE PAGES
	HRLI B,.FHSLF		;FROM US
	TLO C,(1B0)		;INDICATE REPEAT COUNT
	PMAP			;FLUSH
	JRST MRETN2		;SUCCESS
;GETTAB UUO SIMULATOR ROUTINES
;	ONLY CERTAIN TABLES AND INDEXES ARE IMPLEMENTED
;	INDEX = -1, -2, OWN JOB, OR OWN HIGH SEGMENT #


GETTAB:	MOVEI A,.GTTBV		;GET ADDRESS OF BIT TABLE
	MOVEI B,.GTTBC		;AND ADDRESS OF TABLE OF COUNTS
	HRRE C,CAC		;GET DESIRED FUNCTION NUMBER
	JUMPL C,CMRETN		;NEGATIVE NUMBERS NOT SUPPORTED
	CAIG C,.GTMAX		;WITHIN BOUNDS?
	PUSHJ P,.GTDSP		;GET DISPATCH VALUE
	  JRST CMRETN		;NOT SUPPORTED
	XCT .GTTBL(C)		;DO THE FUNCTION
	JRST STOTC1		;STORE ANSWER AND SKIP RETURN

;ROUTINE TO GET A DISPATCH VALUE FROM GETTAB BIT TABLE
;CALLING SEQUENCE:
;	MOVE A,ADR OF BIT TABLE
;	MOVE B,ADR OF COUNT TABLE
;	MOVE C,DESIRED INDEX
;	PUSHJ P,.GTDSP
;	  NOT SUPPORTED INDEX
;	SUCCESSFUL, DISPATCH VALUE IN C

.GTDSP:	IDIVI C,^D36		;GET BIT POSITION IN TABLE
	MOVE E,C		;SAVE WORD INDEX VALUE
	JUMPE C,.GTDS1		;IF IN FIRST WORD, DONT GET COUNT
	ADDI C,-1(B)		;GET INDEX INTO COUNT TABLE
	MOVE C,0(C)		;GET COUNT OF PREVIOUS WORDS
.GTDS1:	SETO B,			;INITIALIZE MASK
	MOVNI D,1(D)		;GET NEGATIVE BIT POS WITHIN WORD
	LSH B,(D)		;GET MASK OF UNWANTED BITS
	ADDI E,(A)		;GET INDEX INTO BIT TAIBLE
	MOVE E,(E)		;GET BIT WORD
	MOVSI F,400000		;SEE IF BIT IS ON
	LSH F,1(D)		;GET MASK
	TDNN F,E		;IS THIS BIT ON?
	  POPJ P,		;NO, UNSUPORTED FUNCTION
	ANDCM E,B		;MASK OUT UNWANTED BITS
	MOVE D,E		;NOW COUNT THE BITS
	LSH E,-1		;SEE HACK MEM ITEM 169 FOR EXPLAINATION
	AND E,[333333,,333333]
	SUB D,E
	LSH E,-1
	AND E,[333333,,333333]
	SUBB D,E		;EACH OCTAL DIGIT IS REPLACED BY THE
	LSH E,-3		;  NUMBER OF 1'S IN IT
	ADD D,E
	AND D,[070707,,070707]
	IDIVI D,77		;CASTING OUT 77'S
	ADDI C,0(E)
	SOJA C,CPOPJ1		;RETURN WITH DISPATCH VALUE IN C

DEFINE GTABLE(NAM),<

NAM'TBL:	GTDEF (NAM)

NAM'TBC:	GTCGEN(NAM,\NAM'L)

NAM'TBV:	GTVGEN(NAM,\NAM'L)
>

DEFINE GVAL(X,Y,Z,NAM),<
IF1,<	IFNDEF NAM'V'Y,<NAM'V'Y==0
		NAM'C'Y==0>
	IFNDEF NAM'MAX,<NAM'MAX==0>
	IFL NAM'MAX-X,<NAM'MAX==X>
	NAM'V'Y==NAM'V'Y!1B<^O'X-^O'Z>
	NAM'C'Y==NAM'C'Y+1
	NAM'L==Y>>

DEFINE GTGEN(A,B,C),<
	A
	ZZ==B/^D36
	ZZZ==ZZ*^D36

	GVAL(B,\ZZ,\ZZZ,<C>)
>

DEFINE GTCGEN(NAM,LEN),<
	ZZ==0
	ZZZ==0
	REPEAT LEN,<
	GTCGN1(<NAM>,\ZZ)
	ZZ==ZZ+1>>

DEFINE GTCGN1(A,B),<
	IFNDEF A'C'B,<A'C'B==0>
	A'C'B+ZZZ
	ZZZ==ZZZ+A'C'B>

DEFINE GTVGEN(A,B),<
	ZZ==0
	REPEAT B+1,<
	GTVGN1(<A>,\ZZ)
	ZZ==ZZ+1>>

DEFINE GTVGN1(A,B),<
	IFNDEF A'V'B,<A'V'B==0>
	A'V'B>

.GTIDX:	HLRZ A,CAC		;GET INDEX VALUE
	CAIN A,-1		;THIS JOB?
	JRST CPOPJ2		;YES, GIVE SKIP RETURN
	CAIN A,-2		;THIS JOB'S HIGH SEGMENT?
	JRST CPOPJ1		;YES, 1-SKIP RETURN
	CAMN A,JOB		;THIS JOB?
	JRST CPOPJ2		;YES
	CAMN A,HGHSGN		;THIS JOB'S HIGH SEG?
	JRST CPOPJ1		;YES
	POPJ P,			;NO, THIS IS AN ERROR

.GTSTS:	PUSHJ P,.GTIDX		;CHECK INDEX VALUE
	JRST [HLRZ E,CAC	;GET JOB NUMBER
		JRST .GTST1]
	  JRST CMRETN		;NO HIGH SEG'S ALLOWED
.GTST2:	MOVSI A,440004		;RUNABLE, LOGGED IN, AND JNA
	JRST STOTC1		;RETURN IT TO USER
.GTST1:	HRRZ A,E		;GET JOB NUMBER
	PUSHJ P,DGETJI		;DO THE GETJI
	 JRST [	CAIE A,GTJIX4	;NOT LOGGED IN ERROR?
		JRST CMRETN	;NO, ILLEGAL JOB NUMBER
		JRST RETZR1]	;YES, RETURN 0
	SKIPN STRNG1+.JIUNO	;IS JOB LOGGED IN?
	  JRST RETZR1		;NO, RETURN 0
	movsi a,440004		;assume runable
	SKIPge C,STRNG1+.JITNO	;IS THERE A TTY FOR IT?
	  jrst .gtst3		;no, can't check input wait
	SYSGET<TTYJOB>		;SEE IF IN TTY INPUT WAIT
	HRL A,C			;GET TTY LINE NUMBER
	HRR A,B			;AND TTYJOB TABLE NUMBER
	GETAB			;RH = -1 IF NOT IN TTY INPUT WAIT
	  JRST CMRETN
	TRC A,-1		;CHECK FOR -1
	TRCN A,-1
	  JRST .GTST2		;NO, JUST RETURN RUNNABLE
	MOVSI A,440164		;NO, JUST SAY JOB IS IN TTY WAIT
.gtst3:	PUSHJ P,SKPUSR		;SKIP IF USER MODE
	  movsi a,40224		;NO, return job in stop queue
	JRST STOTC1

.GTADR:	PUSHJ P,.GTIDX		;GET ARG TYPE
	JRST [	HLRZ E,CAC	;SOME OTHER JOB
		JRST .GTAD1]	;GET ITS JOB NUMBER
	JRST RETZR1		;ALL HIGH SEGS ARE 0
	MOVE E,JOB		;THIS JOB
.GTAD1:	SYSGET<JOBNAM>		;NOW GET THE WORKING SET SIZE OF JOB
	HRR A,B
	HRL A,E			;GET JOB #
	GETAB
	  JRST RETZR1
	MOVE C,A		;SAVE INDEX INTO NAME TABLES
	SYSGET<SNBLKS>		;GET TABLE #
	HRR A,B			;GET NUMBER
	HRL A,C			;AND INDEX
	GETAB			;GET NUMBER OF BLOCKS THAT HAVE OCCURED
	  JRST RETZR1
	MOVE D,A		;SAVE NUMBER OF BLOCKS
	SYSGET <SSIZE>		;GET SIZE INTEGRAL
	HRR A,B			;GET TABLE NUMBER
	HRL A,C			;GET INDEX INTO TABLE
	GETAB			;GET SIZE
	  JRST RETZR1
	IDIV A,D		;GET AVERAGE SIZE
	SKIPE B			;ANY REMAINDER?
	  AOS A			;YES, COUNT UP AVERAGE SIZE
	ASH A,9			;TURN PAGES INTO WORDS
	HRLZI A,-1(A)		;GET HIGHEST LEGAL ADR IN LH
	JRST STOTC1		;AND GIVE IT TO USER

.GTPPN:	PUSHJ P,.GTIDX		;LEGAL INDEX?
	JRST .GTPPJ		;GET THE PPN OF ANOTHER JOB
	JRST .GTSPP		;YES, HIGH SEGMENT PPN NEEDED
.GTPPS:	AOS (P)			;SET UP SKIP RETURN
	JRST GETPPN		;YES, RETURN JOB'S PPN

.GTPPJ:	HLRZ A,CAC		;GET JOB NUMBER
	MOVE B,[-1,,D]		;GET LOGGED IN DIR
	MOVEI C,.JILNO
	GETJI
	 JRST [	CAIE A,GTJIX4	;NOT LOGGED IN ERROR?
		JRST CMRETN	;NO, ILLEGAL JOB NUMBER
		JRST RETZR1]	;YES, RETURN 0
	MOVE A,D		;GET LOGGED IN DIR #
	JUMPE A,STOTC1		;NO JOB LOGGED IN IF 0
	PUSHJ P,PPNUNM
	JRST STOTC1		;STORE ANSWER

.GTPRG:	PUSHJ P,.GTIDX		;CHECK LEGALITY OF INDEX
	JRST [HLRZ E,CAC	;GET JOB # DESIRED
		JRST .GTPR1]
	JRST .GTSNM		;HIGH SEG NAME WANTED
	SKIPE A,LOWNAM		;HAS THE USER DONE A SETNAM UUO?
	  JRST STOTC1		;YES, RETURN THIS NEW NAME
	MOVE E,JOB		;GET OUR JOB NUMBER
.GTPR1:	PUSHJ P,GTJBNM		;GET JOB NAME
	  JRST CMRETN
	JRST STOTC1		;GO STORE DATA AND SKIP RETURN

GTHSNS:	MOVE B,F		;GET HANDLE FOR HIGH SEG
	HRROI A,STRNG1		;SET UP STRING AREA FOR JFNS
	JFNS
	 ERJMP [SETZ A,
		POPJ P,]
SEVN26:	MOVE B,[POINT 7,STRNG1]
SVN26B:	SETZ A,			;INITIALIZE ANSWER AC
	MOVE D,[POINT 6,A]	;SET UP SIXBIT BYTE POINTER
	MOVEI C,6		;ONLY 6 CHARACTER NAME ALLOWED
.GTLOP:	ILDB E,B
	JUMPE E,CPOPJ		;END OF STRING
	SUBI E,40		;TRANSLATE TO 6-BIT
	IDPB E,D		;STORE THIS CHARACTER
	SOJG C,.GTLOP		;LOOP BACK
	POPJ P,			;DO ONLY 6 CHARACTERS

.GTSPP:	MOVE A,SEGPPN		;GET HIGH SEG PPN IF ANY
	JRST STOTC1		;GO RETURN IT TO USER

.GTSNM:	MOVE A,SEGNAM		;GET HIGH SEG NAME IF ANY
	JRST STOTC1		;SKIP RETURN TO CALLER

.GTDEV:	PUSHJ P,.GTIDX		;CHECK INDEX VALUE
	JRST RETZR1		;RETURN 0 FOR ALL OTHER JOB #'S
	SKIPA A,SEGDEV		;GET HIGH SEG DEVICE
	JRST CMRETN		;GETTAB FOR DEVICE OF LOW SEG IS ILLEGAL
	JRST STOTC1		;GO RETURN VALUE TO CALLER

.GTWSN:	HLRZ C,CAC		;GET INDEX
	CAIL C,.GTWLN		;GET LENGTH OF TABLE
	  JRST RETZER		;FAIL
	MOVE A,.GTWTB(C)	;GET SIXBIT QUEUE STATES
	JRST STOTC1

.GTWTB:	SIXBIT/RNWSTS/
	SIXBIT/DSAUMQ/
	SIXBIT/DACBD1/
	SIXBIT/D2DCMT/
	SIXBIT/CAIOTI/
	SIXBIT/DISLNU/
	SIXBIT/STJD/
.GTWLN=.-.GTWTB

.GTCNF:	HLRZ C,CAC		;GET INDEX
	CAILE C,CNFMAX		;IN BOUNDS?
	  JRST CMRETN		;NO
	MOVEI A,CNFTBV		;GET ADR OF BIT TABLE
	MOVEI B,CNFTBC		;AND COUNT TABLE
	PUSHJ P,.GTDSP		;GET DISPATCH INDEX
	  JRST CMRETN		;NO IMPLIMENTED
	XCT CNFTBL(C)		;DO THE FUNCTION
	JRST STOTC1		;GO STORE VALUE AND SKIP RETURN

.GTCNM:	SYSGET (<SYSVER>)	;GET TABLE NUMBER OF VERSION
	HLRE C,B		;GET NEG NUMBER OF ENTRIES
	MOVMS C			;MAKE IT POSITIVE
	HLRZ A,CAC		;GET WORD NUMBER WANTED
	CAML A,C		;IS IT IN BOUNDS?
	JRST CMRETN		;NO!
	HLLZ A,CAC		;SET UP FOR GETAB
	HRR A,B			;GET TABLE #
	GETAB
	JRST CMRETN		;GETAB FAILED
	JRST STOTC1		;RETURN VALUE TO USER

.GTCTM:	AOS (P)			;SKIP RETURN
	JRST TIMER		;LET TIMER ROUTINE DO THE WORK
.GTCDT:	AOS (P)			;SKIP RETURN
	JRST DATE		;LET DATE UUO DO THE WORK

.GTCJN:	HRRO A,NJOBS		;ANSWER IS HGHSGN,,NJOBS
	JRST STOTC1

.GTPTY:	SYSGTA (<PTYPAR>)	;GET # OF TTY'S
	HLRZ A,A		;GET NUM OF PTY'S
	HRL A,FIRPTY		;GET FIRST PTY # IN LH
	JRST STOTC1		;SKIP RETURN

.GTNSW:	HLRZ C,CAC		;GET INDEX
	CAILE C,NSWMAX		;IN BOUNDS?
	  JRST CMRETN		;NO
	MOVEI A,NSWTBV		;GET ADR OF BIT TABLE
	MOVEI B,NSWTBC		;AND COUNT TABLE
	PUSHJ P,.GTDSP		;GET DISPATCH
	  JRST CMRETN		;NOT SUPPORTED
	XCT NSWTBL(C)		;DO FUNCTION
	JRST STOTC1		;STORE VALUE

.GTOHT:	SYSGET (<SYSTAT>)	;GET OVERHEAD TIME
	HRLI A,2		;ITEM 2 IN SYSTAT TABLE
	JRST .GTLS1		;GO RETURN IT TO USER

.GTLST:	SYSGET (<SYSTAT>)	;GET LOST TIME
	HRLI A,1
.GTLS1:	HRR A,B
	GETAB
	  JRST CMRETN
.GTJIF:	AOS (P)
.GTJF1:	MOVEI E,^D60		;GET TIME IN JIFFIES
	JRST RUNTM2

.GTNUP:	TIME
	JRST .GTJIF

.GTKTM:	SYSGET (<DWNTIM>)	;GET TABLE NUMBER OF CEASE TABLE
	HRRZ A,B		;SET UP FOR GETAB
	GETAB			;GET DOWN TIME
	  JRST CMRETN
	JUMPE A,STOTC1		;IF NOT SET, RETURN 0
	PUSH P,A		;SAVE SHUTDOWN TIME
	GTAD			;GET CURRENT TIME
	HRRZ B,0(P)		;GET SHUTDOWN SECONDS FROM MIDNIGHT
	HRRZ C,A		;GET CURRENT SECS
	SUB B,C			;GET DIFFERENCE
	HLRZS A			;GET DAYS IN RH OF A
	HLRZ C,0(P)		;GET SHUT DOWN DAYS
	JUMPGE B,GTKTM1		;IF OVERFLOWED,
	ADDI B,^D24*^D3600	;ADD IN A DAY
	SOS C			;DECREMENT DAYS
GTKTM1:	SUBM C,A		;GET DAYS TIL SHUTDOWN
	IMULI A,^D24*^D60	;CONVERT TO MINUTES
	IDIVI B,^D60		;TURN SECONDS INTO MINUTES
	ADD A,B			;TOTAL SECONDS TIL SHUTDOWN
	SKIPGE A		;ALREADY GONE BY?
	  SETO A,		;YES, RETURN -1
	POP P,(P)		;CLAER OUT STACK
	JRST STOTC1


.GTNMS:	MOVE A,[SIXBIT/NCPGS/]	;GET USER CORE AVAILABLE
	SYSGT
	ASH A,9			;PAGES TO WORDS
	JRST STOTC1

.GTSGN:	PUSHJ P,.GTIDX		;GET INDEX TYPE
	JRST RETZR1		;RETURN 0 FOR ALL OTHER JOBS
	JRST CMRETN		;HIGH SEG NOT ALLOWED
	HRRZ 1,JBHRL		;GET HIGH SEG SIZE
	JUMPE 1,RETZR1		;IF ZERO THEN RETURN ZERO
	MOVE A,HGHSGN		;GET HGHSGN VALUE
	HRLI A,200000		;MARK THAT HIGH SEG IS SHARABLE
	JRST STOTC1		;GO STORE THIS VALUE

.GTNAM:	PUSHJ P,.GTIDX		;IS THIS A REQUEST FOR THIS JOB
	JRST .GTNMJ		;GO GET NAME OF OTHER JOBS
	 JRST CMRETN		;HIGH SEG IS ILLEGAL
	GJINF			;GET JOB INFO
	MOVE B,A		;ALWAYS USE LOGGED IN NAME
.GTNM1:	HRROI A,STRNG1		;SET UP STRING POINTER
	DIRST			;TRANSLATE NUMBER TO ASCII STRING
	  JRST CMRETN		;NO TRANSLATION
	PUSHJ P,SEVN26		;TRANSLATE TO SIXBIT
	HRRZ C,CAC		;GET GETTAB INDEX
	CAIE C,32		;WAS THIS A REQUEST FOR THE SECOND WORD
	JRST STOTC1		;NO, RETURN THIS VALUE
	LDB A,B			;GET LAST CHAR SEEN
	JUMPE A,RETZR1		;IF ZERO, DONT RETURN GARBAGE FROM STRNG1
	PUSHJ P,SVN26B		;GO GET SECOND SIX CHARACTERS
	JRST STOTC1		;RETURN SECOND WORD

.GTNMJ:	HLRZ A,CAC		;GET JOB NUMBER
	MOVE B,[-1,,D]		;GET LOGGED IN DIR NUMBER
	MOVEI C,.JIUNO
	GETJI
	  JRST RETZR1		;ILLEGAL OR NOT LOGGED IN
	SKIPN B,D		;IS JOB LOGGED IN?
	  JRST RETZR1		;NO
	JRST .GTNM1		;YES, GO GIVE NAME TO CALLER

.GTKCT:	SKIPA E,[^D60*^D20]	;ASSUME AVERAGE 20K CORE
.GTTIM:	MOVEI E,^D60		;GET JIFFIES
	PUSHJ P,.GTIDX
	JRST [	AOS (P)
		HLRZS CAC
		JUMPE CAC,NULTIM ;GIVE NULL TIME FOR JOB 0
		JRST RUNTM0]	;SAME AS RUMTIM UUO
	JRST CMRETN		;ILLEGAL FOR HIGH SEG
	AOS (P)
	JRST RUNTM9		;GET OWN JOB'S RUNTIM

.GTNUL:	AOS (P)			;SET UP FOR SKIP RETURN
NULTIM:	MOVE A,[SIXBIT/SYSTAT/]	;GET NULL TIME FROM WORD 0 OF SYSTAT TAB
	SYSGT
	MOVE D,A		;SAVE NULLTIME
	HRLI A,1		;NOW GET LOST TIME
	HRR A,B
	GETAB
	  JRST [SOS 0(P)	;DECREMENT SKIP RETURN
		JRST CMRETN]
	ADD A,D			;TOPS-10 NULL TIME = LOST + IDLE
	JRST .GTJF1		;GO CHANGE UNITS TO JIFFIES

.GTSWP:	PUSHJ P,.GTIDX		;CHECK LEGALITY OF #
	JRST RETZR1		;OTHER JOB = 0
	SKIPA A,JBHRL		;GET SIZE OF HIGH SEG
	JRST RETZR1
	AOS A			;MAKE IT PAGES
	LSH A,-9
	JRST STOTC1

.GTTTY:	PUSHJ P,.GTIDX		;CHECK LEGALITY OF #
	JRST [	HLRZ C,CAC	;GET JOB #
		JRST .GTTY1]
	JRST CMRETN		;ILLEGAL FOR HIGH SEG
	MOVE C,JOB		;GET THIS JOB'S JOB NUMBER
.GTTY1:	HRRZ A,C		;GET JOB NUMBER
	MOVE B,[-1,,D]		;GET TTY NUMBER FOR THIS JOB
	MOVEI C,.JITNO
	GETJI
	 JRST [	CAIE A,GTJIX4	;NOT LOGGED IN ERROR?
		JRST CMRETN	;NO, ILLEGAL JOB NUMBER
		JRST RETZR1]	;YES, RETURN 0
	MOVE A,D		;GET TTY NUMBER
	JRST STOTC1		;AND RETURN IT

.GTLVD:	HLRZ C,CAC		;GET INDEX
	CAILE C,LVDMAX		;WITHIN BOUNDS?
	  JRST CMRETN		;NO
	MOVEI A,LVDTBV		;GET ADR OF BIT TABLE
	MOVEI B,LVDTBC		;AND TABLE OF COUNTS
	PUSHJ P,.GTDSP		;GET DISPATCH VALUE
	  JRST CMRETN		;NOT LEGAL
	XCT LVDTBL(C)		;GET ANSWER
	JRST STOTC1		;RETURN IT TO USER

.GTC0V:	HLRZ C,CAC		;GET INDEX
	CAILE C,C0VMAX		;WITHIN BOUNDS?
	  JRST CMRETN		;NO
	MOVEI A,C0VTBV		;GET ADR OF BIT TABLE
	MOVEI B,C0VTBC		;AND TABLE OF COUNTS
	PUSHJ P,.GTDSP		;GET DISPATCH VALUE
	  JRST CMRETN		;NOT IMPLEMENTED
	XCT C0VTBL(C)		;GET ANSWER
	JRST STOTC1		;RETURN IT TO USER

.GTLIM:	PUSHJ P,.GTIDX		;CHECK JOB #
	JRST [	HLRZ C,CAC	;GET JOB #
		JRST .GTLM1]
	JRST CMRETN		;ILLEGAL FOR HI SEG
	MOVE C,JOB		;OURSELF
.GTLM1:	HRRZ A,C		;SET UP FOR GETJI
	MOVE B,[-2,,C]		;-LENGTH,,BLOCK
	MOVEI C,.JIRTL		;WORD TO START AT
	GETJI
	 JRST CMRETN		;BOO... HISS...
	MOVSI A,(677B9)		;RETURN INFINITE CORE LIMIT MINUS PA1050
	SKIPE D			;BATCH JOB?
	TXO A,1B10		;YES, LIGHT JB.LBT
	IMULI C,^D1000		;CONVERT MSEC TO SEC
	IDIVI C,^D60		; AND SEC TO JIFFIES
	HRR A,C			;STUFF INTO AC 1
	JRST STOTC1		;AND RETURN

.GTUPM:	PUSHJ P,.GTIDX		;FOR WHO?
	 JRST CMRETN		;ILLEGAL FOR OTHER JOBS
	 CAIA			;OK FOR OUR HI SEG
	JRST CMRETN		;ILLEGAL FOR OUR JOB
	SKIPE A,JBHRL		;ANY HI SEG? (0 IF NONE)
	MOVS A,HSORG		;YES, RETURN HI SEG ORIGIN IN LEFT HALF
	JRST STOTC1		;RETURN TO USER

.GTRDV:	PUSHJ P,.GTIDX
	 JRST RETZR1		;RETURN 0 IF NOT US
	 SKIPA A,SEGDEV		;SEGMENT
	MOVE A,LOWDEV		;PROGRAM
	JRST STOTC1

.GTRDI:	PUSHJ P,.GTIDX
	 JRST RETZR1		;RETURN 0 IF NOT US
	 SKIPA A,SEGPPN		;SEGMENT
	MOVE A,LOWPPN		;PROGRAM
	JRST STOTC1
;SET UP MAIN DISPATCH TABLE FOR GETTAB UUO

DEFINE GTDEF (A),<
XLIST
	GTGEN (<JRST .GTSTS>,0,A)
	GTGEN (<JRST .GTADR>,1,A)
	GTGEN (<JRST .GTPPN>,2,A)
	GTGEN (<JRST .GTPRG>,3,A)
	GTGEN (<JRST .GTTIM>,4,A)
	GTGEN (<JRST .GTKCT>,5,A)
	GTGEN (<JRST .GTSWP>,7,A)
	GTGEN (<JRST .GTTTY>,10,A)
	GTGEN (<JRST .GTCNF>,11,A)
	GTGEN (<JRST .GTNSW>,12,A)
	GTGEN (<JRST .GTSGN>,14,A)
	GTGEN (<JRST .GTLVD>,16,A)
	GTGEN (<JRST .GTDEV>,24,A)
	GTGEN (<JRST .GTWSN>,25,A)
	GTGEN (<JRST .GTNAM>,31,A)
	GTGEN (<JRST .GTNAM>,32,A)
	GTGEN (<JRST .GTLIM>,40,A)
	GTGEN (<JRST .GTC0V>,56,A)
	GTGEN (<JRST .GTUPM>,100,A)
	GTGEN (<JRST .GTRDV>,135,A)
	GTGEN (<JRST .GTRDI>,136,A)
LIST
>

	GTABLE (.GT)	;GENERATE .GTTBL,.GTTBC,.GTTBV, AND .GTMAX

;SET UP CONFIGURATION TABLE DISPATCH (TABLE 11)

DEFINE GTDEF (NAM),<
XLIST
	GTGEN (<JRST .GTCNM>,0,NAM)
	GTGEN (<JRST .GTCNM>,1,NAM)
	GTGEN (<JRST .GTCNM>,2,NAM)
	GTGEN (<JRST .GTCNM>,3,NAM)
	GTGEN (<JRST .GTCNM>,4,NAM)
	GTGEN (<JRST .GTCNM>,5,NAM)
	GTGEN (<JRST .GTCNM>,6,NAM)
	GTGEN (<MOVSI A,'DSK'>,7,NAM)
	GTGEN (<JRST .GTCTM>,10,NAM)
	GTGEN (<JRST .GTCDT>,11,NAM)
	GTGEN (<MOVEI A,0>,12,NAM)	;SIZE OF MONITOR
	GTGEN (<JRST .GTCJN>,15,NAM)	;# OF JOBS IN SYSTEM
	GTGEN (<SETO A,>,16,NAM)	;DUAL REGISTER SOFTWARE SUPPORTED
	GTGEN (<MOVSI A,751317>,17,NAM)	;DISK SYSTEM
	GTGEN (<JRST .GTPTY>,22,NAM)	;XWD PTY TO TTY CORR, # OF PTY'S
	GTGEN (<MOVEI A,40000>,112,NAM)	;VIROS MONITOR
LIST
>

	GTABLE (CNF)		;GENERATE CNFTBL, CNFTBC, CNFTBV, CNFMAX

;SET UP NON-SWAPING DATA TABLE (TABLE 12)

DEFINE GTDEF (NAM),<
XLIST
	GTGEN (<MOVSI A,1>,10,NAM)	;CORMAX
	GTGEN (<JRST .GTNUP>,15,NAM)	;UP TIME
	GTGEN (<JRST .GTCJN>,20,NAM)	;HIGHEST JOB NUMBER AVAILABLE
	GTGEN (<JRST .GTLST>,22,NAM)	;LOST TIME
	GTGEN (<JRST .GTNMS>,23,NAM)	;USER CORE AVAILABLE
	GTGEN (<MOVSI A,1>,34,NAM)	;HIGHEST VALUE OF CORMAX
	GTGEN (<JRST .GTKTM>,35,NAM)	;KSYS TIME
LIST
>

	GTABLE (NSW)

;SET UP LEVEL-D TABLE (TABLE 16)

DEFINE GTDEF (NAM),<
XLIST
	GTGEN (<MOVE A,[1,,1]>,0,NAM)	;MFD PPN
	GTGEN (<MOVE A,[1,,4]>,1,NAM)	;SYS PPN
	GTGEN (<MOVE A,[1,,2]>,2,NAM)	;FAILSAFE PPN
	GTGEN (<MOVE A,[3,,3]>,4,NAM)	;SPOOLER PPN
	GTGEN (<MOVSI A,(STDPRT)>,12,NAM) ;STANDARD PROTECTION
	GTGEN (<MOVSI A,775000>,13,NAM)	;STANDARD UFD PROTECTION
	GTGEN (<MOVSI A,'DSK'>,15,NAM)	;SPOOLER PPN
	GTGEN (<MOVSI A,077000>,20,NAM)	;PROTECTION OF SPOOLED FILES
	GTGEN (<MOVSI A,155000>,21,NAM)	;SYSTEM FILE PROTECTION
	GTGEN (<MOVSI A,157000>,22,NAM)	;FILE PROTECTION FOR SYS FILES
LIST
>

	GTABLE (LVD)

;TABLE 56 - CPU0 CDB VARIABLE TABLE

DEFINE GTDEF (NAM),<
XLIST
	GTGEN (<JRST .GTNUP>,5,NAM)	;UPTIME IN JIFFIES
	GTGEN (<JRST .GTLST>,12,NAM)	;LOST TIME IN JIFFIES
	GTGEN (<JRST .GTNUL>,37,NAM)	;NULL TIME IN JIFFIES
	GTGEN (<JRST .GTOHT>,42,NAM)	;OVERHEAD TIME IN JIFFIES
LIST
>

	GTABLE (C0V)
;UUO'S NOT EXECUTED VERY OFTEN

SYSPHY:
SYSSTR:	JUMPE CAC,SYSTR1	;IF 0 RETURN 'DSK'
IFN FTFILSER,<
	MOVE A,CAC		;GET DEVICE NAME
	PUSHJ P,DPACHK		;SEE IF IT IS A TOPS-10 PACK
	  SKIPA			;IT ISNT
	JRST TDOUUO		;YES, GO CALL FILSER
>
	CAME CAC,[SIXBIT/DSK/]	;IS IT DSK?
	 JRST SYSTR2		;NO, CHECK IF OTHER STR
	MOVEI A,0		;FENCE
	JRST STOTC1		;GO RETRUN 0
SYSTR1:	MOVSI A,'DSK'		;RETURN DSK
	JRST STOTC1

SYSTR2:	MOVE D,CAC		;GET NAME
	PUSHJ P,CHKDSK		;SEE IF IT IS A DSK
	 JRST MRETN		;NO
	JRST RETZR1		;YES, MAKE IT BE AT THE END

GETSTR:	MOVEI A,1		;SET A POSITIVE
	CAMN B,[-1]		;-1 = DSK
	  MOVSI A,'DSK'
	CAMN B,[SIXBIT/DSK/]	;DSK = 0
	  SETZ A,
	SKIPN B			;0 = -1
	  MOVNI A,1
	JUMPG A,CPOPJ		;A POSITIVE MEANS ILLEGAL VALUE IN B
	JRST CPOPJ1		;SKIP RETURN

JOBSTR:	UMOVE B,(CAC)		;GET LOC
	PUSHJ P,GETSTR		;GET STR VALUE OF NEXT STR
	  JRST MRETN		;ILLEGAL VALUE IN LOC
	UMOVEM A,(CAC)		;STORE ANSWER
	HLRZ B,CAC		;GET NUMBER OF ARGS
	CAIGE B,3		;ENOUGH FOR STATUS
	  JRST MRETN2		;NO, SKIP RETURN
	XCTUU <SETZM 2(CAC)>	;YES, RETURN ZERO AS STATUS
	JRST MRETN2

GOBSTR:	HLRZ D,CAC		;GET COUNT 
	UMOVE B,2(CAC)		;GET STR VALUE
	PUSHJ P,GETSTR		;TRANSLATE IT
	  JRST GOBST1		;ILLEGAL, GO GIVE ERROR RETURN
	UMOVEM A,2(CAC)		;STORE ANSWER
	CAIGE D,5		;ENOUGH ROOM FOR STATUS
	  JRST MRETN2		;NO
	XCTUU <SETZM 4(CAC)>	;YES, GIVE ZERO
	JRST MRETN2
GOBST1:	SKIPA A,[3]		;RETURN 3
GOBST2:	MOVEI A,6		;RETURN 6
	JRST STOTAC		; IN USERS AC

STRUUO:
IFN FTFILSER,<
	UMOVE A,1(CAC)		;GET STRUCTURE NAME
	PUSHJ P,DPACHK		;SEE IF THIS IS A TOPS-10 PACK
	  SKIPA			;IT ISNT
	JRST TDOUUO		;YES, CALL FILSER
>
	SETZ A,			;INITIALIZE ANSWER
	HLRZ D,CAC		;GET N
	CAIE D,4		;4 IS THE ONLY ALLOWED VALUE
	  JRST STRU1		;GIVE 4 ERROR RETURN
	XCTUU<SKIPE (CAC)>	;0 IS THE ONLY FUNCTION IMPLEMENTED
	  JRST STOTAC		;GO RETURN 0 TO USER
	UMOVE B,1(CAC)		;GET STR
	CAME B,[SIXBIT/DSK/]	;DSK IS THE ONLY ONE ALLOWED
	  AOJA A,STOTAC		;GO GIVE 1 ERROR
	JRST MRETN2		;OK, GIVE SKIP RET
STRU1:	MOVEI A,4		;GIVE 4 ERROR
	JRST STOTAC

DEVPPN:	MOVE A,CAC		;GET ARGUMENT, DEV NAME OR CHNL #
	PUSHJ P,GDVPPN		;GET PPN OF DEVICE
	  JRST MRETN		;NOT A DSK
	MOVE A,B		;GET PPN
	JRST STOTC1		;RETURN IT TO USER

GDVPPN:	PUSH P,A		;SAVE ARG, EITHER DEV NAME OR CHANEL #
	SKIPL A			;CHECK FOR A CHANNEL #  0-17
	CAILE A,17
	  SKIPA 		;NOT A CHANNEL
	JRST [	IMULI A,NTABS	;GET INDEX INTO CHANNEL TABLES
		MOVE B,DEVNAM(A) ;GET DEVICE NAME
		MOVEM B,0(P)	;STORE DEVICE NAME INSTEAD OF CHANNEL #
		MOVE A,DIRNUM(A) ;GET DIRECTORY NUMBER OF FILE
		JRST GDVPPD]	;GO TRANSLATE TO PPN
	PUSHJ P,GETPHY		;SEE IF THERE IS A PPN FOR THIS DEV
	  JUMPE B,GDVPP0	;NO LOGICAL NAME OR NO DIR NUM
	JUMPE B,GDVPP1		;NO PPN FOR THIS LOGICAL NAME
GDVPD0:	MOVE A,B		;GET DIR NUMBER
GDVPPD:	PUSHJ P,PPNUNM		;GET PPN FROM DIR NUMBER
GDVPD1:	MOVE B,A		;RETURN WITH PPN IN B
	POP P,A			;AND DEV NAME IN A
	JRST CPOPJ1		;GIVE SKIP RETURN

GDVPP0:	MOVE A,0(P)		;GET BACK DEVICE NAME
	CAME CAC,[SIXBIT/SYS/]	;SYS?
	  JRST GDVPP1		;NO, GIVE ERROR RETURN
	MOVE B,[XWD 1,4]	;RETURN SYS PPN
	JRST GDVPD1

GDVPP1:	MOVE D,0(P)		;NOW CHECK FOR DSK
	PUSHJ P,CHKDSK
	  JRST APOPJ		;NOT A DSK
	GJINF			;GET CONNECTED DIR
	JRST GDVPD0		;GO RETURN OWN PPN
;ROUTINE TO GET THE PHYSICAL DEVICE NAME FROM A LOGICAL NAME
;CALL:
;	MOVE A,SIXBIT DEVICE NAME
;	PUSHJ P,GETPHY
;	  NO LOGICAL NAME FOR THIS DEVICE
;	LOGICAL NAME IS IN A (SIXBIT)
;	DIR NUMBER OF DEVICE IN B (0 IF NONE SPECIFIED)

;GETPHY USES DEVNM7 AND STRNG1 AS SCRATCH STRINGS

GETPHY:	PUSH P,A		;SAVE SIXBIT NAME
	MOVE D,A		;GET SIXBIT NAME INTO ASCII
	HRROI E,STRNG1
	PUSHJ P,SIXTO7		;CONVERT IT TO ASCII IN STRNG1
	MOVEI B,":"		;ADD A COLON AFTER DEVICE
	IDPB B,E
	MOVEI B,0		;FOLLOWED BY A NULL
	IDPB B,E
	HRROI B,STRNG1		;NOW GET A DIR NUMBER FOR THIS DEV
	MOVX A,RC%EMO		;NO RECOGNITION
	RCDIR			;GET DIR NUMBER
	 ERJMP [MOVEI C,0	;NO SUCH DEVICE, SET DIR # TO 0
		JRST GETPH0]	;AND CONTINUE ON
	TXNE A,RC%NOM!RC%AMB	;DID THIS SUCCEED?
	JRST GETPH1		;NO, NO SUCH DEVICE
GETPH0:	HRROI A,STRNG1		;NOW GET PHYSICAL DEVICE
	STDEV			;GET DEVICE DESIGNATOR
	 ERJMP GETPH1
	DEVST			;AND BACK TO THE PHYSICAL NAME
	 ERJMP GETPH1
	PUSH P,C		;SAVE THE DIRECTORY NUMBER
	PUSHJ P,SEVN26		;GET SIXBIT DEVICE NAME
	POP P,B			;RETURN DIR NUMBER IN B
	POP P,(P)		;CLEAN UP STACK
	JRST CPOPJ1		;GIVE SUCCESSFUL RETURN

GETPH1:	MOVEI B,0		;NO DIR
	JRST APOPJ		;EXIT CLEANING UP THE STACK
DVNAM.:	TLNE CAC,-1		;SIXBIT NAME?
	JRST DEVNM1		;YES
	TRZE CAC,200000		;UDX OF TTY?
	JRST [	MOVE B,CAC	;GET LINE NUMBER
		PUSHJ P,LIN26	;GET SIXBIT NAME
		JRST STOTC1]	;AND GIVE IT TO USER
	SKIPL CAC		;CHECK FOR A CHANNEL NUMBER
	CAILE CAC,17
	  JRST DEVNM1		;NOT A CHANNEL #
	IMULI CAC,NTABS		;GET INDEX INTO CHANNEL TABLES
	SKIPE A,DEVNAM(CAC)	;IS THERE A DEVICE ON THIS CHANNEL
	  JRST STOTC1		;YES, GO RETURN ITS NAME
	JRST MRETN		;NO, GIVE ERROR RETURN

DEVNM1:	MOVE A,CAC		;GET SIXBIT DEV NAME FOR GETPHY
	PUSHJ P,GETPHY
	  SKIPA A,CAC		;NONE, USE WHAT WAS GIVEN BY USER
	EXCH CAC,A		;USE THIS PHYSICAL NAME
	HRROI A,STRNG1		;NOW SEE IF DEVICE EXISTS
	STDEV
	  JRST DEVNM2		;IT DOES NOT EXIST
	MOVE A,CAC		;RETURN SAME NAME
	JRST STOTC1

DEVNM2:
IFN FTFILSER,<
	MOVE A,CAC		;SEE IF THIS IS A TOPS-10 PACK
	PUSHJ P,DPACHK
	  JRST DEVNM5		;NO
	MOVE A,B		;YES, GET ACTUAL NAME
	JRST STOTC1		;AND RETURN IT TO THE USER
>
DEVNM5:	MOVS B,CAC		;CHECK GENERIC NAMES NOW
	SETZB AC,BB		;START AT CHANNEL 0
DEVNM3:	HLRZ A,DEVNAM(BB)	;GET LEFT HALF NAME ONLY
	CAMN A,B		;IS THIS A MATCH?
	  JRST DEVNM4		;YES, GO RETURN ACTUAL DEVICE
	ADDI BB,NTABS
	CAILE AC,17		;LOOKED AT ALL CHANNELS?
	  AOJA 17,DEVNM3	;NO, LOOP BACK
	JRST MRETN		;YES, GIVE ERROR RETURN

DEVNM4:	MOVE A,DEVNAM(BB)	;GET FULL DEVICE NAME
	JRST STOTC1		;GIVE IT TO USER

MTCHR:	SKIPL BB,CAC		;CHECK FOR CHANNEL #
	CAILE BB,17
	  JRST MTCHR1		;NOT A CHANNEL #
	IMULI BB,NTABS		;GET CHANNEL INDEX
MTCHR0:	LDB AA,PDVNUM		;GET NUMERIC DEVICE TYPE
	CAIE AA,MTA		;IS IT A MTA
	  JRST MTCHR2		;NO, THIS IS AN ERROR
	HRRZ A,JFNTAB(BB)	;GET JFN OF TAPE
	MOVEI B,.MORDN		;READ IN DENSITY
	MTOPR
	 ERJMP MTCHR3		;NOT SET YET
	PUSH P,C		;(326) save density
	GDSTS			;(326) get device status
MTCHR4:				;(326)
	HLRZS C			;(326) right-justify byte count
	PUSH P,C		;(326) save byte count
	MOVEI B,.MORDM		;(326) read tape data mode (JFN already set)
	MTOPR			;(326) should never return 0 == system default
	  ERJMP [POP P,C	;FAILED, RESTORE AC
		 SETZ C,	;MAKE ZERO
		 JRST MTCHR5]	;AND RETURN RESULT
	HLRZ B,TPRDMT(C)	;(326) get bytes per word
	POP P,C			;(326) get byte count
	IDIV C,B		;(326) convert bytes to words
	SKIPE D			;(326) round up to next higher word
	  AOS C			;(326) if needed
MTCHR5:	POP P,A			;(326) get density
	HRL A,C			;(326) put in word count
	JRST STOTC1		;RETURN ANSWER
MTCHR3:	GDSTS			;(326) get device chars (JFN already set)
	LDB B,[POINT 2,B,28]	;(326) get density
	SKIPN B			;(326) is it 0 ?
	  MOVEI B,3		;(326) yes, make it 3
	PUSH P,B		;(326) save density
	JRST MTCHR4		;(326) C already set by GDSTS

MTCHR1:	MOVEI D,17		;SEARCH FOR THIS DEV INITED
	TDZA E,E
	ADDI E,NTABS
	CAME CAC,DEVNAM(E)	;IS THIS A MTACH
	  SOJGE D,.-2		;NO, KEEP LOOKING
	JUMPL D,MTCHR2		;NO MATCH, GO GIVE ERROR RET
	MOVE BB,E
	JRST MTCHR0		;GO SEE IF THIS IS A MTA

MTCHR2:	SETO A,
	JRST STOTAC
;TRMOP UUO SIMULATION

.TRMOP:	UMOVE C,1(CAC)		;GET IO INDEX
	TRC C,200000		;CHECK ITS LEGALITY
	MOVE A,[SIXBIT/TTYJOB/]
	SYSGT			;GET MAX # OF TTY'S SUPPORTED
	HLRES B			;...
	MOVNS B			;MAKE COUNT POSITIVE
	CAMLE C,B		;IS THIS A GOOD TTY #
	  JRST RETZER		;NO, GIVE ERROR RETURN
	UMOVE C,2(CAC)		;GET SET VALUE
	UMOVE A,1(CAC)		;GET IO INDEX
	TRC A,600000		;CHANGE INDEX TO TTY NUMBER
	XCTUM <HRRZ B,0(CAC)>	;GET FUNCTION TO BE DONE
	TRNN B,777000		;FUNCTION TYPE 0?
	  JRST TRMOP0		;YES
	TRNN B,776000		;FUNCTION TYPE 1?
	  JRST TRMOP1		;YES
	TRNE B,775000		;FUNCTION TYPE 2?
	  JRST MRETN		;NO, THEN THIS IS AN ERROR
	ANDI B,777		;GET INDEX INTO FUNCTION TABLE
	CAIL B,TRMRSL		;WITHIN BOUNDS?
	  JRST MRETN		;NO, ERROR
	HLRZ D,TRMRST(B)	;GET ADR OF FUNCTION TO BE DONE
	JRST (D)		;GO DO SET FUNCTION SPECIFIED

TRMOP1:	ANDI B,777		;GET FUNCTION INDEX
	CAIL B,TRMRSL		;WITHIN BOUNDS?
	  JRST MRETN		;NO, ERROR
	HRRZ D,TRMRST(B)	;GET ADR OF ROUTINE
	JRST (D)		;GO DO IT

TRMOP0:	CAIL B,TRM0TL		;WITHIN BOUNDS?
	 JRST MRETN		;NO, ERROR
	JRST @TRM0TB(B)		;GO DO FUNCTION

TRM0TB:	MRETN			;0 NOT IMPLEMENTED
	TOSIP			;1 SKIP IF INPUT BUFFER NOT EMPTY
	TOSOP			;2 SKIP IF OUTPUT BUFFER NOT EMPTY
	TOCIB			;3 CLEAR INPUT BUFFER
	TOCOB			;4 CLEAR OUTPUT BUFFER
TRM0TL==.-TRM0TB

TOSIP:	SIBE			;SKIP IF INPUT BUFFER FULL
	JRST MRETN2		;YES, SKIP RETURN
	PUSH P,A		;SAVE TTY NUMBER
	GJINF			;GET OUR CONTROLING TTY
	POP P,A			;GET BACK TTY NUMBER
	TRZ A,TTYDSG		;CLEAR DEVICE TYPE
	CAMN A,D		;IS THIS OUR OWN TTY
	  SKIPG TTCNT		;YES, ANY CHARS IN INTERNAL BUFFER
	JRST MRETN		;NO, THEN NO CHARACTERS
	JRST MRETN2		;THERE ARE CHARACTERS, GIVE SKIP RETURN

TOSOP:	SOBE			;SKIP IF OUTPUT BUFFER FULL
	JRST MRETN2		;YES, SKIP
	JRST MRETN		;NO, DONT SKIP

TOCIB:	CFIBF			;CLEAR MONITOR BUFFER
	PUSHJ P,TTXTST		;SEE IF THIS IS THE CONTROLING TTY
	  JRST MRETN2		;DONT CLEAR INTERNAL BUFFER
	PUSHJ P,TTCL11		;YES, CLEAR THE INTERNAL BUFFER ALSO
	JRST MRETN2		;GIVE SUCCESSFUL RETURN

TOCOB:	CFOBF			;CLEAR OUTPUT BUFFER
	JRST MRETN2		;AND RETURN

TRMRST:	MRETN,,TOOIPR		;0 OUTPUT IN PROGRESS
	MRETN,,TOCOMR		;1 - MONITOR MODE
	TOXONS,,TOXONR		;2 - TAPE MODE
	TOLCTS,,TOLCTR		;3 - LOWER CASE
	MRETN,,MRETN		;4
	TOTABS,,TOTABR		;5 - HARDWARE TABS
	TOFRMS,,TOFRMR		;6 - HARDWARE FORM FEED
	TOLCPS,,TOLCPR		;7 - LOCAL COPY
	TONFCS,,TONFCR		;10 - CR-LF SWITCH
	MRETN,,MRETN		;11
	TOWIDS,,TOWIDR		;12 - PAGE WIDTH
	MRETN,,MRETN		;13
	MRETN,,TOHLFR		;14 - HALF DUPLEX
	MRETN,,MRETN		;15
	MRETN,,MRETN		;16
	TOFLCS,,TOFLCR		;17 - FILLER CLASS
	MRETN,,MRETN		;20
	TOPAGS,,TOPAGR		;21 - TTY PAGE
	MRETN,,MRETN		;22
	TOPSZS,,TOPSZR		;23 - TTY PAGE LENGTH
	MRETN,,MRETN		;24
	MRETN,,MRETN		;25
	TOALTS,,TOALTR		;26 - SUPRESS ALTMODE CONVERSION
TRMRSL==.-TRMRST

TOOIPR:	SOBE			;OUTPUT IN PROGRESS
	  JRST TRMB1R		;YES
	JRST RETZR1		;NO

TRMB1R:	MOVEI A,1		;RETURN A 1
	JRST STOTC1		;SKIP RETURN

TOCOMR:	XCTUM <HRRZ A,1(CAC)>	;GET TTY NUMBER
	TRC A,600000		;MAKE IT 400000+TTY
	PUSHJ P,DGETJI		;DO THE GETJI
	  JRST MRETN		;ILLEGAL TTY NUMBER
	SKIPGE STRNG1+.JIJNO	;IS JOB NUMBER IN USE?
	  JRST TRMB1R		;NO, SAY IT IS IN MONITOR MODE
	PUSHJ P,SKPUSR		;MONITOR MODE?
	  JRST TRMB1R		;YES, GIVE ON RETURN
	JRST RETZR1		;NOT IN MONITOR MODE

TOXONS:	PUSHJ P,TTXTST		;SEE IF THIS IS THE CONTROLING TTY
	  JRST MRETN		;NO, FUNCTION NOT SUPPORTED
	MOVE E,TYSTAT		;GET MODE WORD
	TRNE C,1B35		;SET OR CLEAR
	  TLOA E,TT.XON		;SET
	TLZ E,TT.XON		;CLEAR
	PUSHJ P,TTPSTS		;GO SET UP NEW MODE
	JRST MRETN2		;AND RETURN

TOXONR:	PUSHJ P,TTXTST		;IS THIS THE CONTROLING TTY?
	  JRST MRETN		;NO, NOT SUPPORTED
	TLNN E,TT.XON		;IS TAPE MODE ON OR OFF
	  JRST RETZR1		;OFF
	JRST TRMB1R		;ON

TTXTST:	PUSH P,A		;SAVE ACS
	PUSH P,C
	GJINF
	POP P,C
	POP P,A
	TRO D,TTYDSG		;GET TERMINAL UNIT
	CAME A,D		;SAME AS DESIRED TTY?
	  POPJ P,		;NO, NON-SKIP RETURN
	JRST CPOPJ1		;YES, SKIP

TOLCTR:	RFMOD
	TLNE B,(1B3)		;LOWER CASE MODE ON?
	TRNE B,1B31		;AND NO CONVERSION BEING DONE?
	 JRST TRMB1R		;NO, THIS IS NOT A LOWER CASE TERMINAL
	JRST RETZR1		;LOWER CASE

TOLCTS:	RFMOD
	TRNE C,1B35		;SET OR CLEAR
	  TLZA B,(1B3)		;CLEAR
	TLOA B,(1B3)		;SET
	  TROA B,1B31		;CONVERT TO UPPER CASE
	TRZ B,1B31		;DONT CONVERT
	STPAR
	JRST MRETN2

TOTABR:	RFMOD
	TLNE B,(1B2)		;TAB?
	  JRST TRMB1R		;YES
	JRST RETZR1		;NO

TOTABS:	RFMOD
	TRNN C,1B35		;SET OR CLEAR?
	  TLZA B,(1B2)		;CLEAR
	TLO B,(1B2)		;SET
	STPAR
	JRST MRETN2

TOFRMR:	RFMOD
	TLNE B,(1B1)		;HARDWARE FORM FEED
	  JRST TRMB1R		;YES
	JRST RETZR1		;NO

TOFRMS:	RFMOD
	TRNN C,1B35		;SET OR CLEAR?
	  TLZA B,(1B1)		;CLEAR
	TLO B,(1B1)		;SET
	STPAR
	JRST MRETN2

TOLCPR:	RFMOD
	TRNE B,3B25		;LOCAL COPY ON?
	 JRST RETZR1		;NO
	JRST TRMB1R		;YES

TOLCPS:	RFMOD
	TRZ B,3B25		;ASSUME NO ECHO
	TRNN C,1B35		;SET OR CLEAR?
	  TRO B,1B24		;MAKE ECHOS HAPPEN
	SFMOD
	JRST MRETN2

TONFCR:	PUSHJ P,GETWID		;(316) GET WIDTH =0?
	JUMPE C,TRMB1R		;(316)YES, THEN CR-LF IS OFF
	JRST RETZR1

TONFCS:	TRNN C,1B35		;SET OR CLEAR?
	  JRST [PUSHJ P,GETWID	;(316)CLEAR, GET CURRENT LINE WIDTH
		JUMPN C,MRETN2	;(316)IF 0, CR CLEARED, RETURN
		SKIPGE C,TTWDTH	;(316)DO WE HAVE PREVIOUS WIDTH?
		MOVEI C,^D72	;(316)NO, SET WIDTH TO STANDARD 72
		JRST TOWIDS]	;GO SET WIDTH
	PUSHJ P,GETWID		;(316)GET LINE WIDTH
	MOVEM C,TTWDTH		;(316)REMEMBER THIS WIDTH TO RESTORE IT LATER
	JUMPE C,MRETN2		;IF ALREADY 0, RETURN
	MOVEI C,0
	JRST TOWIDS		;GO SET WIDTH TO 0

TOWIDR:	PUSHJ P,GETWID		;(316) GET LINE WIDTH
	SKIPG A,C		;(316) IF WIDTH =0
	MOVEI A,^D255		;(316) RETURN THE MAXIMUM
	JRST STOTC1		;RETURN IT TO USER

TOWIDS:	MOVEI B,.MOSLW		;(316)SET LINE WIDTH
	MTOPR			;(316)
	  ERJMP CMRETN		;(316)
	JRST MRETN2

GETWID:	MOVEI B,.MORLW		;(316)READ LINE WIDTH
	MTOPR			;(316)
	  ERJMP CMRETN		;(316)
	POPJ P,			;(316)


TOHLFR:	RFMOD
	TRNE B,3B33		;HLAF DUPLEX
	  JRST TRMB1R		;YES
	JRST RETZR1		;NO

TOALTR:	PUSHJ P,TTXTST		;SEE IF THIS IS THE CONTROLING TTY
	  JRST MRETN		;NO, ERROR
	MOVE E,TYSTAT		;GET CONTROLING STATUS
	TLNE E,TT.ALT		;CONVERTING ALTMODES?
	  JRST TRMB1R		;NO
	JRST RETZR1		;YES

TOALTS:	PUSHJ P,TTXTST		;SEE IF THIS IS THE CONTROLING TTY
	  JRST MRETN		;NO, GIVE ERROR RETURN
	MOVE E,TYSTAT		;YES
	UMOVE C,2(CAC)		;GET ARG AGAIN
	TRNN C,1B35		;SET OR CLEAR?
	  TLZA E,TT.ALT		;CLEAR
	TLO E,TT.ALT		;SET
	MOVEM E,TYSTAT
	JRST MRETN2

TOFLCR:	GTTYP			;GET TERMINAL TYPE
	CAIN B,9		;TERMINAL TYPE 9 IS NO FILLER
	  MOVEI B,0
	MOVE A,B
	JRST STOTC1		;RETURN TERMINAL TYPE

TOFLCS:	SKIPN B,C		;USER WANT NO FILL
	MOVEI B,9		;YES, GIVE HIM TYPE 9, NO FILL
	STTYP
	JRST MRETN2

TOPAGS:	RFMOD			;READ IN TTY STATUS
	TRNE C,1B35		;SET OR CLEAR?
	  TROA B,TT%PGM		;SET
	TRZ B,TT%PGM		;CLEAR
	STPAR
	JRST MRETN2

TOPAGR:	RFMOD			;READ PAGE BIT
	TRNE B,TT%PGM		;IS IT SET?
	  JRST TRMB1R		;YES, RETURN ANSWER
	JRST RETZR1		;NO

TOPSZS:	RFMOD			;SET PAGE SIZE
	DPB C,[POINT 7,B,10]
	STPAR
	JRST MRETN2

TOPSZR:	RFMOD			;READ PAGE SIZE
	LDB A,[POINT 7,B,10]
	JRST STOTC1

TRMNO:	HRRZ A,CAC		;GET JOB NUMBER
	PUSHJ P,DGETJI		;DO THE GETJI
	  JRST RETZER		;ILLEGAL JOB NUMBER
	SKIPL A,STRNG1+.JITNO	;IS THERE A TTY FOR THIS JOB?
	SKIPN STRNG1+.JIUNO	;AND IS IT LOGGED IN?
	  JRST RETZER		;NO
	TRO A,200000		;MAKE TTY INTO UNIVERSAL IO INDEX
	JRST STOTC1		;GIVE IT TO USER

CTLJOB:	MOVE A,CAC		;GET JOB NUMBER
	HRROI B,D		;GET ONLY ONE WORD BACK IN D
	MOVEI C,.JICPJ		;GET CONTROLING JOB IF ANY
	GETJI
	 JRST [	CAIE A,GTJIX4	;NOT LOGGED IN ERROR?
		JRST CMRETN	;NO, BAD ARGUMENT
		SETO D,		;YES, RETURN -1
		JRST .+1]
	MOVE A,D		;GET ANSWER
	JRST STOTC1		;AND RETURN IT TO USER
PATH:	UMOVE E,0(CAC)		;GET LOC
	GJINF			;GET OUR PPN INTO AC B
	HRRZ A,E		;GET RH OF ARG 0
	CAIE A,-4		;ALLOW ONLY READING OF PATHS
	CAIN A,-1
	  JRST PATH1		;GO RETURN PATH
	CAIE A,-3		;DONT ALLOW SETTING OF PATHS
	CAIN A,-2
	  JRST CMRETN
	UMOVE A,0(CAC)		;GET DEVICE NAME OR CHANNEL #
	PUSHJ P,GDVPPN		;GET ITS PPN
	  JRST PATH2		;NOT A DISK
IFN FTFILSER,<
	PUSH P,A		;SAVE DEVICE NAME
	PUSH P,B		;SAVE PPN
	PUSHJ P,DPACHK		;SEE IF THIS IS A TOPS-10 PACK
	 JRST [	POP P,B		;GET BACK PPN
		POP P,A		;GET BACK DEVICE
		UMOVEM A,0(CAC)	;STORE DEVICE NAME
		JRST PATH3]
	POP P,B			;YES
	POP P,A
	JRST TDOUUO		;GO CALL FILSER TO DO UUO
>
IFE FTFILSER,<
	UMOVEM A,0(CAC)		;STORE NEW DEVICE NAME
	JRST PATH3		;AND THEN STORE PPN

PATH1:	MOVE A,B		;GET DIR NUM
	PUSHJ P,PPNUNM		;UNMAP IT INTO A PPN
	MOVE B,A
PATH3:	UMOVEM B,2(CAC)
	PUSH P,B		;SAVE PPN
	MOVEI A,0		;GET OWN PPN
	PUSHJ P,PPNUNM
	POP P,B			;GET BACK PPN OF THIS DEV
	CAME A,B		;ARE THEY THE SAME?
	  SKIPA A,[1B30!1B35] ;NO, SET IGNORE BIT
	MOVEI A,1B29!1B35	;YES, DONT SET IGNORE BIT
	UMOVEM A,1(CAC)
	HLRZ A,CAC		;GET ARG COUNT
	CAIGE A,4		;OK TO STORE HERE
	  JRST MRETN2		;NO
	XCTUU <SETZM 3(CAC)>	;MARK END OF PATH
	JRST MRETN2

PATH2:
IFN FTFILSER,<
	UMOVE A,0(CAC)		;GET DEVICE NAME OR CHANNEL #
	TLNN A,-1		;CHANNEL NUMBER?
	CAILE A,17		;...
	JRST PATH4		;NO
	IMULI A,NTABS		;YES, GET INDEX
	MOVE A,DEVNAM(A)	;GET SIXBIT DEVICE NAME
PATH4:	PUSHJ P,DPACHK		;SEE IF IT IS A TOPS-10 PACK
	  SKIPA			;NO
	JRST TDOUUO		;YES, CALL FILSER
>
	JRST RETZR1		;RETURN A 0
;THE CHKACC UUO

CHKACC:
	JRST RETZR1		;ALWAYS SUCCEED

REPEAT 0,<			;CHKACC DOES NOT WORK WHEN CONNECTED TO
				;A DIRECTORY OTHER THAN THE LOGGED IN
				;DIRECTORY (IF USER GROUPS ARE IN USE)
	MOVE A,[1,,2]		;SEE IF THIS IS OPERATOR
	XCTUU <CAMN A,2(CAC)>	;...
	 JRST RETZR1		;YES, ACCESS IS ALWAYS ALLOWED
	XCTLB <LDB D,[POINT 9,0(CAC),35]> ;GET FIL PROT
	JUMPE D,[MOVEI D,-1	;IF 0, ASSUME NO PROTECTION
		JRST CHKAC1]
	PUSHJ P,GTPROT		;GET THE PROTECTION TRANSLATION IN D
CHKAC1:	PUSH P,D		;SAVE PROTECTION
	UMOVE A,1(CAC)		;GET THE DIR PPN
	HRROI B,[ASCIZ/DSK/]	;MUST SUPPLY A STR
	PUSHJ P,PPN2DR		;TRANSLATE IT TO A DIR NUMBER
	 JRST RETZER		;UNKNOWN PPN
	PUSH P,A		;SAVE DIR NUMBER
	UMOVE A,2(CAC)		;GET PPN OF USER
	HRROI B,[ASCIZ/DSK/]
	PUSHJ P,PPN2DR		;TRANSLATE IT TO DIR NUMBER
	 JRST RETZER		;ILLEGAL PPN
	MOVEM A,STRNG1+.CKALD	;LOGGED IN DIR
	MOVEM A,STRNG1+.CKACD	;AND ALSO CONNECTED DIR
	SETZM STRNG1+.CKAEC	;NO ENABLED CAPABILITIES
	POP P,STRNG1+.CKAUD	;SET UP DIR NUMBER
	POP P,STRNG1+.CKAPR	;AND PROTECTION
	XCTUU <HLRZ A,0(CAC)>	;GET ACCESS CODE
	CAIL A,CHKACL		;IS THIS A LEGAL CODE?
	 JRST RETZER		;NO
	MOVE A,CHKACT(A)	;GET TRANSLATED ACCESS CODE FOR JSYS
	MOVEM A,STRNG1+.CKAAC	;STORE FOR THE CHKAC JSYS
	MOVEI A,6		;SIX ARGUMENTS
	MOVEI B,STRNG1		;ADDRESS OF ARGUMENTS
	CHKAC			;CHECK THE ACCESS
	 JRST RETZER		;SOMETHING WAS BAD
	SETCA A,		;TOPS-10 LIKES IT -1=FALSE, 0=TRUE
	JRST STOTC1		;GO RETURN ANSWER

CHKACT:	.CKACF			;(0) CHANGE PROT
	.CKACF			;(1) RENAME
	.CKAWT			;(2) WRITE
	.CKAWT			;(3) UPDATE
	.CKAAP			;(4) APPEND
	.CKARD			;(5) READ
	.CKAEX			;(6) EXECUTE
	.CKACF			;(7) CREATE IN UFD
	.CKADR			;(10) READ DIRECTORY
CHKACL==.-CHKACT		;LENGTH OF TABLE
>			;END OF REPEAT 0 AROUND CHKACC
UUFDST:	TRNE PF,R.DIRN		;USETI?
	JRST MRETN		;NO, ILLEGAL
	HRRZ C,FORTY		;HOW MANY BLOCKS TO SKIP
	SOSGE C			;GET START OF BLOCK INSTEAD OF END
	  PUSHJ P,ERRARG	;ILLEGAL ARGUMENT
	ASH C,6			;100 ENTRIES PER DISK BLOCK
	MOVSI A,RDMFDF		;SEE IF WE ARE READING MFD
	TDNE A,FLAGWD(BB)	;...
	  JRST UMFDST		;YES, GO SIMULATE IT
	SKIPN LSTUFJ		;IS THERE A SAVED UFD?
	  JRST UUFDS0		;NO
	MOVE A,DIRNUM(BB)	;GET DIR NUM OF UFD
	CAMN C,LSTUFP		;IS WORD OF DIR SAME AS SAVED DIR
	CAME A,LSTUFD		;AND IS DIR NUM THE SAME AS SAVED UFD?
	  JRST UUFDS0		;NO, TOO BAD
	HRRZ A,JFNTAB(BB)	;YES, WE WILL USE THE SAVED JFN INSTEAD
	MOVE B,LSTUFJ		;GET SAVED JFN
	CAIE A,(B)		;THE SAME?
	  RLJFN			;NO, RELEASE OLD JFN
	JFCL
	MOVEM B,JFNTAB(BB)	;SAVE NEW JFN
	SETZM LSTUFJ		;CLEAR SAVED JFN WORD
	MOVEM C,IOBYTP(BB)	;STORE CORRECT POINTER WORD
	JRST UUFDSD		;USETI IS DONE
UUFDS0:	CAMGE C,IOBYTP(BB)	;DO WE NEED TO BACK UP
	  JRST UUFDS2		;YES
	SUB C,IOBYTP(BB)	;GET COUNT OF GNJFN'S TO BE DONE
	JUMPE C,UUFDSD		;NONE, JUST RETURN
UUFDS1:	MOVE A,JFNTAB(BB)	;GET FULL JFN
	GNJFN
	  JRST [MOVSI A,UFDEOF	;NO MORE ENTRIES, 
		IORM A,FLAGWD(BB); SET UFDEOF FLAG
		SETZM JFNTAB(BB) ;GET RID OF RELEASED JFN POINTER
		JRST UUSETE]	; AND SET EOF FOR FUTURE INPUT'S
	AOS IOBYTP(BB)		;KEEP COUNT OF WHERE WE ARE
	SOJG C,UUFDS1		;LOOP FOR MANY TIMES
	JRST UUFDSD		;FINALLY DONE

UUFDS2:	HRRZ A,JFNTAB(BB)	;GIVE UP OLD JFN
	RLJFN
	  JFCL
	PUSHJ P,ULKUFA		;SET UP NAME AND DIRECTORY
	  JFCL
	MOVEM A,JBLOCK		;SAVE FLAGS
	MOVEI A,JBLOCK		;SET UP FOR GTJFN
	HRROI B,STRNG1
	GTJFN			;GET NEW JFN
	  PUSHJ P,ERROR		;SHOULD WORK!
	MOVEM A,JFNTAB(BB)	;STORE NEW JFN
	SETZM IOBYTP(BB)	;MARK THAT WE STARTED OVER
	JRST UUFDST		;GO TRY AGAIN

UMFDST:	CAMN C,LSTMFP		;IS THIS TO A KNOWN PLACE
	  JRST [MOVEM C,IOBYTP(BB) ;YES, SAVE POINTER
		MOVE C,LSTMFN	;GET LAST DIR NUMBER USED
		MOVEM C,MFDPT(BB)
		JRST UUFDSD]	;USETI IS DONE
	CAMGE C,IOBYTP(BB)	;DO WE NEED TO BACK UP?
	  JRST [SETZM IOBYTP(BB) ;RESET POINTER
		MOVEI A,1	;SET DIR NUM TO 1
		HRRM A,MFDPT(BB)
		JRST .+1]
	SUB C,IOBYTP(BB)	;GET COUNT OF DIR'S TO BE SKIPPED
	JUMPE C,UUFDSD		;IF NONE, JUST RETURN
UMFDS1:	PUSHJ P,RDMFD		;GET NEXT DIR
	MOVSI A,UFDEOF		;ALL THROUGH?
	TDNE A,FLAGWD(BB)	;...
	  JRST UUSETE		;YES, GO SET EOF
	SOJG C,UMFDS1		;LOOP BACK
UUFDSD:	MOVE A,[XWD UFDEOF,1B22] ;TURN OFF ALL EOF BITS
	ANDCAM A,FLAGWD(BB)
	JRST MRETN		;DONE
ULKUFA:	MOVE D,DIRNUM(BB)	;UFD HAS BEEN LOOKED UP ONCE
	JRST ULKUF1		;SO DONT NEED TO TRANSLATE DIR NUMBER

ULKUFD:	MOVE D,FILNAM(BB)	;GET UFD #
	MOVE A,DEVNAM(BB)	;GET SIXBIT STR NAME
	CAMN D,[XWD 1,1]	;IS THIS THE MFD
	  JRST ULKMFD		;YES
	PUSHJ P,GETDR0		;GET MATCHING DIRECTORY NUMBER
	  POPJ P,		;GIVE ERROR RETURN
	MOVEM D,DIRNUM(BB)	;STORE NEW DIRECTORY NUMBER
ULKUF1:	MOVSI A,RDUFDF		;MARK THAT WE ARE READING A UFD
	IORM A,FLAGWD(BB)
	HRROI A,STRNG1		;SET UP THE MAIN STRING
	MOVE B,D		;GET DIR NUMBER
	DIRST			;PUT STR:<DIR> IN MAIN STRING
	 HRROI A,STRNG1		;FAILED, RESET STRING POINTER
	HRROI B,[ASCIZ/*.*.0/]	;FINISH THE MAIN STRING
	SETZ C,
	SOUT
	MOVSI A,100100		;SET UP PROPER FLAGS
	JRST CPOPJ1		;SKIP RETURN

ULKMFD:	PUSHJ P,GETDR0		;GET A DIR NUMBER
	 POPJ P,		;NONE, FAIL RETURN
	HRRI D,1		;START AT DIR NUMBER 1
	MOVEM D,MFDPT(BB)	;INITIALIZE MFD POINTER
	MOVSI A,RDUFDF!RDMFDF	;SET PORPER FLAGS
	IORM A,FLAGWD(BB)	; IN FLAG WORD
	POP P,(P)		;DONT POPJ AND DO GTJFN
	SETOM JFNTAB(BB)	;SO OPENX WONT COMPLAIN
	JRST ULK7		;THERE IS NO JFN FOR THIS SIMULATION
INDUFD:	TLNE B,UFDEOF		;IS THIS THE END
	  JRST INDM4B		;YES, GO SET EOF BIT
	PUSH P,D		;SAVE THE COMMAND LIST POINTER
INDUF1:	MOVE D,FLAGWD(BB)	;GET FLAGS
	TLNE D,UFDEOF		;ARE WE THROUGH?
	  JRST INDUFE		;YES, GO CLEAR REST OF BUFFER
	PUSHJ P,RDUFD		;NO, GO GET NEXT FILE NAME
	JUMPE D,INDUF1		;IF NO NAME LOOP BACK
	UMOVEM D,1(C)		;STORE FILE NAME
	AOBJP C,INDUE1		;END OF COMMAND?
	UMOVEM E,1(C)		;NO, STORE EXTENSION
	AOBJP C,INDUE1		; END OF COMMAND?
	JRST INDUF1		;NO, LOOP BACK AGAIN

INDUFE:	XCTUU <SETZM 1(C)>	;ZERO THE REST OF THE COMMAND
	AOBJN C,INDUFE
INDUE1:	POP P,D
	AOJA D,INCML		;GO SEE IF MORE COMMANDS

RDUFD:	MOVE D,FLAGWD(BB)	;GET FLAGS
	TLNE D,RDMFDF		;READING MFD?
	  JRST RDMFD		;YES, GO DO IT INSTEAD
	PUSH P,C
RDUFD1:	HRRZ B,JFNTAB(BB)	;GET RH OF JFN ONLY FOR JFNS
	HRROI A,STRNG1		;SET UP TEMPORARY STRING POINTER
	MOVE C,[XWD 1100,2]	;GET NAME AND EXT SEPARATED BY TAB
	JFNS
	MOVE A,[POINT 7,STRNG1]	;NOW DO ASCII TO SIX BIT CONVERSION
	MOVE B,[POINT 6,D]
	SETZB D,E
	MOVEI C,6		;6 CHARACTER NAME ONLY
RDULP:	ILDB F,A		;GET ASCII CHARACTER
	CAIN F,C.CNTV		;CONTROL-V?
	  ILDB F,A		;YES, GET NEXT CHAR
	CAIN F,C.TAB		;TAB?
	JRST RDUEXT		;YES, GO READ THE EXTENSION
	SUBI F,40		;MAKE SIXBIT
	IDPB F,B		;STORE IN D
	SOJG C,RDULP		;LOOP BACK FOR MORE
	ILDB F,A		;SCAN FOR A TAB
	CAIE F,C.TAB		;SINCE LONGER THAN 6 CHARACTER NAMES ALLOWED
	JRST LNGFIL		;LONG FILES ARE NOT ALLOWED
RDUEXT:	MOVEI C,3		;3 CHARACTER EXTENSION MAXIMUM
	MOVE B,[POINT 6,E]
RDULP1:	ILDB F,A		;GET ASCII CHAR
	JUMPE F,RDUFDN		;DONE?
	SUBI F,40		;NO, MAKE IT SIXBIT
	IDPB F,B		;STORE IN E
	SOJG C,RDULP1		;LOOP BACK 
	ILDB F,A		;GET NEXT CHARACTER IN EXTENSION
	JUMPN F,LNGFIL		;TOO LONG?  DONT ALLOW LONG FILES.
RDUFDN:	HRRZ A,JFNTAB(BB)	;GET JFN
	MOVE B,[XWD 1,7]	;SET UP TO GET FILE VERSION #
	MOVEI C,C		;INTO AC C
	GTFDB
	 ERJMP .+1
	HLR E,C			;SAVE VERSION # IN RH OF EXTENSION WORD
	AOS IOBYTP(BB)		;COUNT UP # OF FILES SEEN
	MOVE A,JFNTAB(BB)	;ADVANCE THE JFN POINTER
	GNJFN			;ADVANCE JFN
RDUFDE:	JRST [	MOVSI B,UFDEOF
		IORM B,FLAGWD(BB) ;NO MORE FILES, SET EOF FOR NEXT TIME
		SETZM JFNTAB(BB) ;MARK THAT THE JFN WAS RELEASED
		JRST .+1]
	POP P,C
	POPJ P,			;RETURN

LNGFIL:	SETZB D,E		;NO FILE NAME THIS TIME
	MOVE A,JFNTAB(BB)	;ADVANCE THE FILE POINTER
	GNJFN
	  JRST RDUFDE		;NO MORE FILES
	JRST RDUFD1		;LOOP BACK FOR NEXT FILE NAME

RDMFD:	HRROI A,STRNG1		;SET UP DUMMY STRING POINTER
	MOVE B,MFDPT(BB)	;GET CURRENT MFD POINTER
	DIRST			;SEE IF THIS DIRECTORY NUMBER EXISTS
	  JRST NODIR		;IT DOESNT
	MOVE A,MFDPT(BB)	;GET DIR NUMBER
	PUSHJ P,PPNUNM		;GET PPN
	MOVE D,A		;INTO AC D
	MOVSI E,'UFD'		;MAKE THIS A UFD ENTRY
	AOS A,MFDPT(BB)		;COUNT UP DIR POINTER
	MOVEM A,LSTMFN		;SAVE LAST NUMBER POINTED TO
	SETZM NOMFDC(BB)	;SEEN A LEGAL DIR #
	AOS A,IOBYTP(BB)	;COUNT UP BYTE POINTER
	MOVEM A,LSTMFP		;SAVE LAST MFD POINTER VALUE
	POPJ P,			;AND RETURN

NODIR:	MOVSI B,UFDEOF		;PREPARE FOR EOF
	AOS MFDPT(BB)		;COUNT UP DIR POINTER
	AOS A,NOMFDC(BB)	;GET CURRENT COUNT OF ILLEGAL DIR'S
	CAIG A,MAXDIR		;DONE?
	  JRST RDMFD		;NO, GO LOOK FOR ANOTHER DIR
	IORM B,FLAGWD(BB)	;SET EOF BIT
	SETZB D,E		;CLEAR NAME AND EXTENSION
	POPJ P,			;RETURN WITHOUT COUNTING UP IOBYTP
INUFD:	MOVN A,IOCNT		;GET NEG WORD COUNT
	HRL C,A
	HRR C,IOBPT
INUFD1:	MOVE A,FLAGWD(BB)	;GET FLAGS
	TLNE A,UFDEOF		;ARE WE DONE?
	  JRST INUFD2		;YES, GO SET EOF
	PUSHJ P,RDUFD		;NO, GO GET NEXT FILE NAME
	JUMPE D,INUFD1		;IF NO NAME DONT STORE IT
	UMOVEM D,1(C)		;STORE NAME
	UMOVEM E,2(C)		;AND EXTENSION
	ADD C,[XWD 2,2]		;UPDATE C
	SKIPGE C		;DID WE FINISH A FULL BUFFER
	JRST INUFD1		;NO, GO GET NEXT FILE NAME
INUFD2:	HLRES C			;NOW UPDATE IOCNT AND IOBPT
	ADD C,IOCNT		;GET WORDS NOT USED
	JUMPE C,INTY8A		;IF NO WORDS PUT IN BUFFER, GIVE EOF
	ADDM C,IOBPT		;UPDATE IOBPT
	MOVNS C
	ADDM C,IOCNT		;AND IOCNT
	JRST INTTY9		;AND RETURN TO USER

SLEEP:	MOVE A,CAC		;NUMBER OF SECONDS TO SLEEP
	IMULI A,^D60		;CONVERT TO JIFFIES
	ANDI A,7777		;TRUNCATE TO 12 BITS
				;THIS EXTRA CONVERSION MAKES SLEEP ^D751 WORK
				;WHICH SOME FOLKS EXPECT TO TURN INTO 4 JIFFIES
	IMULI A,^D1000		;CONVERT SECONDS TO MS
	IDIVI A,^D60		;GET IT BACK INTO MILLISECONDS
	SKIPG A			;IS TIME 0
	MOVEI A,^D16		;YES, ALWAYS SLEEP 16 MS
	PUSH P,[MRETN]		;SET UP RETURN PC
	HRRZ B,A		;SAVE LAST HIBERNATE REQUEST
	HRLI B,(HB.RPT)		;ALWAYS MAKE SLEEP WAKE ON PTY ACTIVITY
	MOVEM B,HIBWRD
	SETOM IOWATF		;ALLOW PTY'S TO WAKE US UP
	JRST IOWAT1		;GO TO SLEEP FOR SEPCIFIED AMOUNT
	HB.RTC=1B14		;WAKE ON CHARACTER READY
	HB.RTL=1B13		;WAKE ON LINE READY
	HB.RPT=1B12		;WAKE ON PTY ACTIVITY

HIBER:	PUSH P,[HIBER2]		;SET UP RETURN
	MOVEM CAC,HIBWRD	;REMEMBER LAST COMMAND
	TLNE CAC,(HB.RPT!HB.RTC!HB.RTL)
	  SETOM IOWATF		;ENABLE FOR WAKE UPS
	TLNE CAC,(HB.RTC!HB.RTL) ;ENABLED FOR TTY WAKEUP?
	  JRST STTTYF		;YES, GO START THE TTY FORK
HIBER1:	HRRZ A,CAC		;GET SLEEP TIME
	JUMPE A,IOWAIT		;IF ZERO, DO AN INFINITE SLEEP
	JRST IOWAT1		;GO SLEEP FOR SPECIFIED TIME

STTTYF:	SKIPE TTLINE		;LINE ALREADY THERE?
	  POPJ P,		;YES, RETURN IMMEDIATELY
	TLNN CAC,(HB.RTL)	;WAITING FOR A LINE?
	SKIPG TTCNT		;NO, ANY CHARACTERS ALREADY?
	SKIPA A,TTYFRK		;NO, GET TTY FORK HANDLE
	  POPJ P,		;THERE IS A CHAR, SO JUST RETURN
	JUMPN A,STTTY1		;IF THERE IS A FORK ALREADY, GO USE IT
	MOVE A,[XWD 640000,TTFKST]
	MOVEI B,0		;CREATE A FORK IN SAME SPACE WITH SAME ACS
	CFORK			;AND START IT AT TTFKST
	  PUSHJ P,ERROR		;SOMETHING WENT WRONG
	MOVEM A,TTYFRK		;SAVE FORK HANDLE
STTTY1:	FFORK			;FREEZE THE FORK
	MOVEI B,0		;SET THE ACS TO COPY OF THIS FORKS
	SFACS
	MOVEI B,TTFKST		;GET STARTING ADR
	SFORK			;START THE FORK
	TLO PF,L.TFA		;MARK THAT FORK IS NOW ACTIVE
	RFORK			;AND THAW IT
	JRST HIBER1		;THEN GO TO SLEEP

HIBER2:	SKIPN A,TTYFRK		;HERE WHEN WOKEN UP
	  JRST MRETN2		;NO TTYFRK TO FREEZE
	TLZE PF,L.TFA		;IS THE TTY FORK ACTIVE?
	  FFORK			;YES, ALWAYS FREEZE IT
	JRST MRETN2		;SUCCESFUL RETURN

TTFKST:	MOVE P,[IOWD FPDLEN,FRKPDL]
	MOVEI A,PRIJFN		;GET PRIMARY INPUT JFN
	MOVE E,TYSTAT		;GET TTY STATUS WORD
	TLNN E,TT.BIN		;BINARY MODE?
	TLNE CAC,(HB.RTC)	;OR CHARACTER MODE?
	  TLOA E,TT.BKE		;YES, SET BREAK ON EVERYTHING
	TLZ E,TT.BKE		;NO, CLEAR BKE
	PUSHJ P,TTPSTS		;SET UP NEW MODE
	PUSHJ P,TTFILL		;GO SEE IF ANY CHARACTERS THERE
	  PUSHJ P,TTFILW	;NO, GO WAIT FOR ONE
	HALTF			;HALT 
	PUSHJ P,BUGSTP		;IF CONTINUED, PRINT ERROR MESSAGE

WAKE:	CAME CAC,JOB		;DOING A WAKE ON HIMSELF?
	JUMPG CAC,WAKE1		;GO WAKE THE DESIRED JOB
	SETOM WAKEF		;MARK THAT HIBER SHOULD WAKE UP ONCE
	JRST MRETN2		;SKIP RETURN

WAKE1:	HRRZ A,CAC		;GET JOB NUMBER TO BE WOKEN
	TWAKE			;WAKE IT ******** TEMPORARY
	  JFCL
	JRST MRETN2
;PTY SIMULATION ROUTINES

PTYSTF:	MOVEI B,1B19!1B20	;OPEN THE PTY FOR READ AND WRITE
	PUSHJ P,OPENX
	  POPJ P,		;OPEN FAILED, GIVE ERROR RETURN
	MOVSI B,IOPENF!OOPENF	;MARK THIS IN FLAGWD
	IORM B,FLAGWD(BB)
	HRRZ A,JFNTAB(BB)	;NOW ENABLE INTERUPTS FOR THIS PTY
	MOVE B,[1B0+1B1+<IOCHN>B17+24]
	MTOPR
	 ERJMP .		;IGNORE ERRORS
	JRST CPOPJ1

OPNPTY:	MOVSI A,IOPENF!OOPENF	;MARK THAT IT WAS OPENED FOR BOTH
	IORM A,FLAGWD(BB)	;INPUT AND OUTPUT
	JRST CPOPJ1

INPTY:	HRRZ A,DEVNUM(BB)	;GET UNIT #
	ADD A,FIRPTY		;MAKE TTY #
	IORI A,TTYDSG		;MAKE IT A FILE DESIGNATOR
	SOBE			;ANY CHARACTERS TO GET?
	  SKIPN A,JFNTAB(BB)	;YES, GO READ IN ONE
	JRST INTTY9		;NO, WE ARE THROUGH
	HRRZS A
	MOVE C,B		;SAVE COUNT OF CHARACTERS IN BUFFER
INPTY1:	SOSGE IOCNT		;ANY MORE TO DO?
	  JRST INDON1		;NO, RETURN TO CALLER
	BIN			;READ IN NEXT CHAR
	IDPB B,IOBPT		;STORE IN USERS BUFFER
	SOJG C,INPTY1		;LOOP BACK FOR MORE
	JRST INPTY		;SEE IF MORE CHARS JUST CAME IN

OUTPTY:	PUSHJ P,PTYSHD		;YES, GO SET HALF DUPLEX MODE
	PUSHJ P,PTYPRM		;GO SEE IF PTY NEEDS PRIMING
	  JRST OUTPT4		;NEEDS A CONTROL-C
	  JRST OUTPT0		;DOES NOT NEED A CONTROL-C, JUST WAIT
	JRST OUTPT1		;DOES NOT NEED PRIMING
OUTPT4:	SKIPG C,IOCNT		;SET UP TO SCAN FOR A ^C IN BUFFER
	 POPJ P,		;NO MORE CHARACTERS
	MOVE A,IOBPT		;...
OUTPT3:	ILDB B,A		;GET A CHARACTER
	CAIN B,C.CC		;IS THIS A CONTROL-C
	  SOJA C,[MOVEM C,IOCNT	;SET BUFFER PAST THIS ^C
		MOVEM A,IOBPT
		JRST OUTPT4]	;GO SEND A CONTROL-C
	SKIPN B			;IS THIS A NULL
	SOJG C,OUTPT3		;LOOP BACK UNTIL A NON-NULL IS SEEN
OUTPT2:	MOVE A,JFNTAB(BB)	;GET THE JFN FOR THIS PTY
	MOVEI B,C.CC		;SEND OUT A CONTROL-C TO PRIME LINE
	BOUT
	MOVEI C,^D300		;LOOP FOR 30 SECONDS ONLY
OUTPT0:	MOVEI A,^D100		;AND SLEEP SOME
	IJSYS (DISMS)
	PUSHJ P,PTYPRM		;LINE STILL NEED PRIMING?
	  JRST OUTPTY		;NEEDS A CONTROL-C
	SOJG C,OUTPT0		;LOOP BACK UNTIL LINE IS PRIME
OUTPT1:	SOSGE IOCNT		;ANY CHARS TO SEND OUT
	  POPJ P,		;NO
	XCTLB <ILDB B,IOBPT>	;GET NEXT CHAR
	JUMPE B,OUTPT1		;SKIP NULLS
	HRRZ A,JFNTAB(BB)	;GET JFN FOR PTY
	MOVSI C,PTYCRF		;GET <CR> FLAG
	CAIN B,C.LF		;SENDING OUT A LINE FEED?
	TDNN C,FLAGWD(BB)	;WAS LAST CHAR A <CR>
	BOUT			;SEND OUT CHAR (EXCEPT <CR>)
	ANDCAM C,FLAGWD(BB)	;CLEAR <CR> FLAG
	CAIN B,C.CR		;DID WE JUST SEND A <CR>
	  IORM C,FLAGWD(BB)	;YES, SET <CR> FLAG
	MOVSI C,PTYCWF		;PREPARE TO SET ^C BIT
	CAIN B,C.CC		;WAS THIS A ^C?
	  IORM C,FLAGWD(BB)	;YES, REMEMBER THAT
	AOS C,IOBYTP(BB)	;COUNT UP CHARACTERS SENT OUT
	CAIN B,C.CR		;WAS THIS A BREAK CHARACTER?
	  SETZB C,IOBYTP(BB)	;YES, CLEAR THE COUNT
	CAIGE C,^D80		;FULL BUFFER?
	  JRST OUTPT1		;NO, LOOP BACK
	HRRZ A,DEVNUM(BB)	;GET UNIT NUMBER
	ADD A,FIRPTY		;GET TTY NUMBER
	IORI A,TTYDSG		;MAKE DEVICE DESIGNATOR
	RFMOD			;FORCE THIS BUFFER OUT
	SFMOD
	SETZM IOBYTP(BB)	;CLEAR COUNT
	MOVE A,JFNTAB(BB)	;RESTORE JFN
	JRST OUTPT1		;LOOP BACK UNTIL DONE

PTYSHD:	HRRZ A,DEVNUM(BB)	;GET PTY UNIT #
	ADD A,FIRPTY		;MAKE IT INTO A TTY #
	IORI A,TTYDSG		;CREATE TTY DEVICE DESIGNATOR
	RFMOD			;GET TTY CHARACTERISTICS
	TRC B,3B33		;IS LINE HALF DUPLEX ALREADY?
	TRCN B,3B33		;...
	  POPJ P,		;YES, DONT DO STPAR
	IORI B,3B33		;SET LINE HALF DUPLEX
	STPAR
	POPJ P,			;RETURN

PTYPRM:	SYSGET (<TTYJOB>)	;SEE IF PTY IS PRIMED FOR OUTPUT
	HRRZ A,DEVNUM(BB)	;GET UNIT NUMBER
	ADD A,FIRPTY		;TURN IT INTO TTY NUMBER
	HRLZS A
	HRR A,B			;GET TABLE NUMBER FOR TTYJOB
	GETAB
	  JRST CPOPJ1		;FAILED, TRY TO SEND ANYWAY
	JUMPGE A,CPOPJ2		;LINE IS PRIMED
	TLC A,-1		;SEE IF LINE NEEDS A CONTROL-C
	TLCE A,-1		;-1 MEANS YES, -2 MEANS NO
	  JRST CPOPJ1		;-2 GIVE SINGLE SKIP RETURN
	POPJ P,			;LINE NEEDS PRIMING

TTYINT:	MOVEM A,IAC+A		;SAVE AN AC
	MOVSI A,(HB.RTC!HB.RTL)	;GET TTY WAKE UP BITS
	JRST PTYIN1		;GO OR THEM INTO WAKEF

PTYINT:	MOVEM A,IAC+A		;SAVE AN AC
	MOVSI A,(HB.RPT)	;SET PTY ACTIVITY FLAG
PTYIN1:	IORM A,WAKEF		;SET WAKE UP FLAG WITH WAKE CONDITIONS
	SKIPE INPAT		;IN COMPATIBILITY PACKAGE?
	SKIPN IOWATF		;YES, WAITING FOR INPUT OR OUTPUT
	  JRST IOINR		;NO, JUST RETURN
	MOVE A,HIBWRD		;GET LAST HIBERNATE WORD
	TDNN A,WAKEF		;SEE IF JOB SHOULD BE WOKEN
	  JRST IOINR		;NO, JUST RETURN
	POP P,RETSAV		;YES, DISMIS TO DIFFERENT ADDR
	SETZM WAKEF		;MARK THAT A WAKE WAS DONE
	SETZM IOWATF		;CLEAR IO FLAG SO WE DONT COME HERE AGAIN
IOINR:	MOVE A,IAC+A		;RESTORE AC
	DEBRK

IOWAIT:	MOVSI A,100000		;WAIT FOR A LONG LONG TIME
IOWAT1:	MOVE B,A		;
	SKIPN UIFLAG		;USER INTERUPT WAITING?
	SKIPE CSTFLG		;OR ^C BEEN TYPED?
	  JRST CCTRAP		;YES, DONT GO TO SLEEP

IOWAT3:	SKIPN A,B		;IS IT ZERO STILL
	  MOVEI A,1		;YES, SLEEP FOR AT LEAST 1 MS
	MOVE B,HIBWRD		;GET FLAGS
	TDNE B,WAKEF		;SEEN A WAKE YET
	  JRST IOWAT2		;YES, DONT SLEEP

IOWAT4:	IJSYS (DISMS)		;NO, GO TO SLEEP
IOWAT2:	SETZM IOWATF		;CLEAR IO WAIT FLAG
	SETZM WAKEF		;CLEAR EVENT FLAG
	POPJ P,			; BEFORE STARTING AGAIN
GETPTY:	PUSH P,A		;GET A PHYSICAL PTY
	MOVSI A,600000+PTY	;PTY DEV DESIGNATOR
GETPT1:	MOVE B,A		;SAVE A
	HRROI A,STRNG1		;SEE IF DEVICE IS LEGAL
	DEVST
	  JRST [ MOVSI C,'PTY'
		 JRST GETPT4]	;DEVICE NOT LEGAL, NO MORE PTY'S
	MOVE A,B
	DVCHR			;GET CHARACTERISTICS
	TLNN B,(1B5)		;IS THIS DEVICE AVAILABLE
	  AOJA A,GETPT1		;NO TRY AGAIN
	HRRZ D,A		;GET DEVICE #
	PUSHJ P,GETPT6		;GET 6 BIT PTY NAME
	MOVEI B,17		;NOW SEE IF THIS DEV IS ALREADY INITED
	SETZ D,
GETPT3:	CAME D,BB		;SAME CHANNEL #?
	CAME C,DEVNAM(D)	;MATCH?
	SKIPA			;NO MATCH OR SAME CHANNEL
	  AOJA A,GETPT1		;YES, GO TRY FOR ANOTHER
	ADDI D,NTABS		;UPDATE INDEX
	SOJGE B,GETPT3		;LOOP FOR ALL CHANNELS
GETPT4:	POP P,A
	POPJ P,			;RETURN WITH PTY NAME IN C

GETPT6:	MOVSI C,'PTY'		;SET UP ANSWER AC
	MOVE B,[POINT 6,C,17]
GETPT2:	IDIVI D,10		;GET LOW ORDER CHARACTER
	ADDI E,20		;MAKE IT SIXBIT
	PUSH P,E		;SAVE IT
	SKIPE D			;DONE YET?
	PUSHJ P,GETPT2		;NO, GO GET NEXT CHAR
	POP P,E			;POP OFF NEXT CHAR
	IDPB E,B		;PUT IT IN C
	POPJ P,			;RETURN
JOBSTS:	JUMPL CAC,JBSJOB	;THIS IS A JOB NUMBER
	MOVE BB,CAC		;GET CHANNEL #
	IMULI BB,NTABS		;GET INDEX VALUE
	LDB AA,PDVNUM		;GET DEVICE TYPE
	CAIE AA,PTY		;IS IT A PTY?
	  JRST RETZER		;NO, THIS IS AN ERROR
	HRRE A,DEVNUM(BB)	;GET PTY UNIT NUMBER
	JUMPL A,BUGSTP
	ADD A,FIRPTY		;TURN IT INTO A TTY NUMBER
	MOVEM A,STRNG1+.JITNO	;SAVE TERMINAL NUMBER
	IORI A,TTYDSG		;MAKE IT A TTY NUMBER
	PUSHJ P,DGETJI		;DO THE GETJI
	 SETOM STRNG1+.JIJNO	;FLAG NO JOB ON TTY
JOBST0:	PUSHJ P,JOBST2		;GET BITS IN E
	  JRST RETZER		;SOMETHING WAS WRONG, GIVE ERROR RETURN
	MOVE A,E		;GET ANSWER
	JRST STOTC1		;RETURN

JOBST2:	SETZ E,			;INITIALIZE ANSWER
	SKIPGE STRNG1+.JIJNO	;IS THIS JOB LOGGED IN?
	  JRST JBST2B		;NO
	HRRZ A,JFNTAB(BB)	;NOW CHECK FOR TTY HUNGRY
	MOVEI B,25
	MTOPR			;0=NOT HUNGRY  -1=HUNGRY
	 ERJMP .+1		;IGNORE ERRORS
	SKIPE B
	  TLO E,(1B4)		;MARK THAT TTY IS HUNGRY
JBST2B:	SKIPGE A,STRNG1+.JITNO	;GET TTY NUMBER
	  JRST JBST2A		;THERE ISNT ONE
	IORI A,TTYDSG		;XWD 0,400000+TTY#
	SOBE			;IS BUFFER EMPTY
	  TLO E,(1B3)		;NO, MARK THAT OUTPUT IS READY
JBST2A:	SKIPG A,STRNG1+.JIJNO	;IS THE JOB LOGGED IN?
	  TLO E,(1B4)		;NO, SET HUNGRY BIT
	JUMPL A,JOBST1		;IF NO JOB, SET MONITOR MODE BIT
	TLO E,(1B0)		; SET JOB # ASSIGNED BIT
	HRR E,A			;STORE TSS JOB #
	SKIPE STRNG1+.JIUNO	;IS JOB LOGGED IN?
	  TLO E,(1B1)		;YES, THEN JOB IS LOGGED IN
	PUSHJ P,SKPUSR		;SEE IF IN USER MODE
JOBST1:	TLO E,(1B2)		;LITE MONITOR MODE BIT
	MOVSI A,PTYCWF		;CHECK IF JOB WAITING FOR ^C
	TDNN A,FLAGWD(BB)
	  JRST CPOPJ1		;NO, THEN OK TO RETURN
	TLNN E,(1B2)		;YES, IS JOB IN MONITOR MODE ALREADY?
	  TLZA E,(1B4)		;NO, CLEAR INPUT WAIT BIT
	ANDCAM A,FLAGWD(BB)	;IN MONITOR MODE, CLEAR ^C BIT
	JRST CPOPJ1

;ROUTINE TO GET JOB NAME IN A
;CALL WITH JOB NUMBER IN RH OF E

GTJBNM:	HRRZ A,E		;GET JOB NUMBER
	MOVE B,[-1,,STRNG1]	;GET JOB NAME
	MOVEI C,.JIPNM
	GETJI
	 JRST [	CAIE A,GTJIX4	;NOT LOGGED IN ERROR?
		POPJ P,		;NO, ERROR
		SETZ A,		;RETURN 0 JOB NAME
		JRST CPOPJ1]
	MOVE A,STRNG1		;GET NAME
	JRST CPOPJ1		;SKIP RETURN WITH NAME IN A

JBSJOB:	MOVN A,CAC		;GET JOB NUMBER
	PUSHJ P,DGETJI		;DO THE GETJI
	  JRST RETZR1		;ILLEGAL #
	SKIPN STRNG1+.JIUNO	;IS JOB LOGGED IN?
	  JRST RETZR1		;NO, GIVE BAD RETURN
	SKIPG D,STRNG1+.JITNO	;GET TTY NUMBER
	  JRST JOBST3		;-1 MEANS NO TTY FOR JOB
	SUB D,FIRPTY		;GET PTY NUMBER FROM TTY NUMBER
	HRLI D,600000+PTY	;GET DEVICE DESIGNATOR
	SETZB B,BB		;NOW SEE IF THIS PTY IS INITED
JBSJ0:	CAMN D,DEVNUM(BB)	;MATCH?
	  JRST JOBST0		;YES, GO DO UUO
	CAIL B,17		;CHECKED ALL CHANNELS
	  JRST JOBST3		;YES, GIVE ERROR RETURN
	ADDI BB,NTABS		;INCREMENT INDEX
	AOJA B,JBSJ0		;LOOP BACK FOR ALL CHANNELS

JOBST3:	MOVN A,CAC		;GET JOB NUMBER IN RH OF A
	HRLI A,(1B0!1B1)	;MARK THAT JOB IS LOGGED IN
	JRST STOTC1		;GIVE THIS PARTIAL ANSWER TO CALLER

PTYSTS:	HRRE A,DEVNUM(BB)	;GET TTY NUMBER
	JUMPL A,BUGSTP		;ERROR IF NEGATIVE
	ADD A,FIRPTY		;GET TTY #
	MOVEM A,STRNG1+.JITNO	;SAVE TERMINAL #
	IORI A,TTYDSG		;GET DEVICE DESIGNATOR
	PUSHJ P,DGETJI		;DO THE GETJI
	 SETOM STRNG1+.JIJNO	;MARK NO JOB
	PUSHJ P,JOBST2		;GET BITS IN LH OF E
	  JFCL			;IGNORE ERROR RETURN
	TLNE E,(1B3)		;ANY OUTPUT READY?
	  TRO E,1B25		;YES
	TLNE E,(1B4)		;INPUT WANTED?
	  TRO E,1B24		;YES
	TLNE E,(1B2)		;MONITOR MODE?
	  TRO E,1B26		;YES
	ANDI E,7000		;GET ONLY DESIRED BITS
	HRRZ A,FLAGWD(BB)	;GET OTHER STATUS BITS
	TRO A,(E)		;SET PTY DEPENDENT STATUS BITS
	POPJ P,			;AND RETURN
UTPCLR:	PUSHJ P,SETUPG
	JRST MRETN
	CAIE AA,DTA		;IS IT DECTAPE?
	JRST MRETN		;NO, UTPCLR IS A NOP
	PUSHJ P,DTAINI		;GO CLOSE ANY OPEN JFNS FOR THIS DTA
	MOVE A,DEVNUM(BB)	;GET DECTAPE DEVICE DESIGNATOR
	INIDR
	  PUSHJ P,ERROR
	JRST MRETN
;MNTFAI CHECKS IF AN ERROR WAS CAUSED BECAUSE THE DEVICE WAS NOT MOUNTED
;MNTFAI IS CALLED WITH A PUSHJ SO THAT ERROR WILL TYPE OUT A REASONABLE
;  ERROR ADDRESS.
;MNTFAI GIVES A NO SKIP RETURN IF THE USER DOES NOT WANT THE TRAP
;  AND A SKIP RETURN IF THE DEVICE IS NOT MOUNTED AND NO TRAP IS SET UP

MNTFAI:	CAIN A,GJFX28		;NOT MOUNTED?
	 JRST MNTFA1		;YES
	CAIE A,MNTX2		;AND IS DEVICE NOT MOUNTED?
	CAIN A,OPNX8		;ANOTHER UNMOUNTED MESSAGE TYPE
	  SKIPA			;DEVICE IS NOT MOUNTED, GO TRAP
	  POPJ P,		;ERROR
MNTFA1:	PUSHJ P,DOKTRP		;GO SEE IF OK TO TRAP
	  JRST CPOPJ1		;LET CALLER TYPE MESSAGE OR WHATEVER
	JRST MRETN		;TRAP TO C(.JBINT)

DOKTRP:	HRRZ A,.JBINT		;GET TRAP VECTOR
	JUMPE A,CPOPJ		;IF NOT SET UP JUST RETURN
	XCTUU <SKIPE 2(A)>	;IS PC ZERO
	  POPJ P,		;NO, GIVE ERROR RETURN
	UMOVE B,1(A)		;GET FLAGS
	TRNN B,1B35		;IS THIS USER SET UP FOR DEVICE TRAPS
	  POPJ P,		;NO
	UMOVE C,0(A)		;GET ENTRY ADDRESS
	HRRM C,PDL		;STORE FOR RETURN
	SOS B,JOBPD1		;GET USER PC
	UMOVEM B,2(A)		;STORE TRAPPED ADR
	HRRI B,0(AC)		;GET CHANNEL #
	HRLI B,1B35		;SET TYPE OF TRAP
	UMOVEM B,3(A)		;STORE FOR USER
	JRST CPOPJ1		;SKIP RETURN
DTAMNT:	HRRZ A,DEVNUM(BB)	;GET THE DEVICE NUMBER
	HRLI A,600003		;MOUNT AND READ THE DIRECTORY
	MOUNT			;NO, DO THE MOUNT
	  POPJ P,
	MOVSI C,DTAMF		;MARK THAT DTA WAS MOUNTED
	IORM C,FLAGWD(BB)	;SET THAT WE DID A MOUNT
	JRST CPOPJ1

DTMNTF:	PUSHJ P,MNTFAI		;GO SEE IF IT NEEDS TRAPING
	PUSHJ P,ERROR		;NO, TYPE ERROR MESSAGE
DTMNT1:	TMSG <$? PA1050: DEVICE >
	PUSHJ P,TMSGDV
	TMSG <: NOT MOUNTED$>
	JRST EXITM1		;EXIT TO MONITOR AND DO UUO OVER
				;  AGAIN IF USER TYPES CONTINUE
UUGETF:	PUSHJ P,SETUP		;GET AA AND BB
	MOVE A,FLAGWD(BB)	;CHECK FOR A LOOKUP OR ENTER
	TLNN A,LOOKPF!ENTERF
	  JRST MRETN		;IF NOT MAKE THIS A NOP
	PUSHJ P,PTRGET		;FIRST FREE WORD
	JRST MRETN
	IDIV B,DEVTB2(AA)
	SKIPE C			;FIRST WORD OF BUFFER?
	ADDI B,1		;NO-GO TO NEXT BUFF
	HRRZ A,FORTY		;TARGET ADDRESS
	UMOVEM B,(A)
	JRST MRETN

DTASET:	PUSHJ P,DTAINI		;CLOSE ANY OPEN JFNS FOR THIS DTA
	HRRZ A,JFNTAB(BB)
	JUMPG A,DTAST2		;IS DTA ALREADY OPENED?
	PUSHJ P,DTGTJF		;NO, GO GET A JFN FIRST
	  JRST DTMNTF		;GO PROCESS ERROR
DTAST2:	MOVE B,FLAGWD(BB)	;GET FLAGS
	TLNN B,OOPENF!IOPENF	;IS DECTAPE ALREADY OPENED?
	  JRST DTAST3		;NO, GO OPEN IT
	TLNE B,DTADMP		;YES, IS IT IN DUMP MODE?
	  JRST DTAST4		;YES, DONT REOPEN IT
	HRLI A,(1B0)		;CLOSE IT FIRST
	CLOSF
	  JFCL
DTAST3:	PUSHJ P,DTMTND		;MOUNT IT WITHOUT READING DIR
	  JRST DTMNTF		;MOUNT FAILED
	HRRZ A,JFNTAB(BB)	;GET JFN AGAIN
	MOVE B,[XWD 447400,300000]	;OPEN IN DUMP MODE
	OPENF
	PUSHJ P,ERROR
	MOVSI B,OOPENF!IOPENF!DTADMP
	IORM B,FLAGWD(BB)	;MARK IT AS OPEN
DTAST4:	HRRZ A,JFNTAB(BB)
	MOVEI B,30		;DECLARE BLOCK FOR DUMP I/O
	HRRZ C,FORTY		;BLOCK TO POSITION TO
	TRNN PF,R.DIRN		;DOING USETI
	CAIG C,1101		;HIGHER THAN LIMIT?
	SKIPA			;OK, GO DO MTOPR
	  JRST UUSETE		;OFF THE END, GO SET EOF BIT
	MTOPR
	 ERJMP .		;IGNORE ERRORS
	MOVSI A,UFDEOF		;CLEAR EOF INDICATIONS
	ANDCAB A,FLAGWD(BB)
	TRNN A,100		;IS THIS MODE 100?
	CAIE C,144
	  JRST MRETN		;MODE 100 OR NOT DIRECTORY BLOCK
	MOVSI B,RDUFDF		;READING DIRECTORY
	IORM B,FLAGWD(BB)	;SET UFD BIT
	JRST MRETN

DTGTJF:	PUSHJ P,DTMTND		;GO MOUNT THE TAPE WITHOUT READING DIR
	  POPJ P,		;MOUNTING FAILED
	PUSHJ P,DEV67		;GET ASCIZ STRING FOR DTA
	SETZB B,JBLOCK		;SET UP FOR GTJFN
	PUSHJ P,JBKSET		;SET UP JBLOCK
	HRROI A,DEVNM7		;GET DEVICE NAME
	MOVEM A,JBLOCK+2
	MOVEI A,JBLOCK
	GTJFN
	  PUSHJ P,ERROR
	HRRZM A,JFNTAB(BB)	;STORE JFN
	JRST CPOPJ1

DTMTND:	HRRZ A,DEVNUM(BB)	;GET UNIT NUMBER
	HRLI A,640003		;DONT READ DIRECTORY
	MOUNT			;MOUNT THE DTA
	  POPJ P,		;GIVE ERROR RETURN
	MOVSI A,DTAMF		;MARK THAT DTA IS NO LONGER MOUNTED
	ANDCAM A,FLAGWD(BB)
	JRST CPOPJ1		;SUCCESSFUL

DTAINI:	MOVE E,DEVNUM(BB)	;GET DEVICE DESIGNATOR FOR THIS DTA
	MOVNI F,NTABS		;INITIALIZE INDEX INTO CHANNEL TABLE
	MOVEI G,20		;CHECK ALL CHANNELS
DTAINL:	ADDI F,NTABS		;INCREMENT INDEX
	HRRZ A,JFNTAB(F)	;IS THERE A JFN ON THIS CHANNEL
	  JUMPE A,DTAIN0	;NO, DONT BOTHER WITH THIS CHANNEL
	CAME F,BB		;IS THIS THE CURRENT CHANNEL
	CAME E,DEVNUM(F)	;NO, IS THIS THE SAME DTA
DTAIN0:	SOJG G,DTAINL		;NO, LOOP BACK FOR OTHER CHANNELS
	JUMPLE G,DTAIN2		;CHECKED ALL CHANNELS?
	MOVE D,FLAGWD(F)	;NO, THIS IS A MATCH
	TLNE D,DTACLS		;IS THIS DTA CLOSED ALREADY?
	  JRST DTAIN0		;YES, DONT BOTHER WITH IT
	HRLI A,(1B0)		;KEEP THE JFN
	CLOSF			;BUT CLOSE IT
	  JFCL
	MOVSI B,DTACLS		;MARK THAT THE JFN WAS CLOSED
	IORM B,FLAGWD(F)
	JRST DTAIN0		;CHECK OTHER CHANNELS

DTAIN2:	HRRZ A,JFNTAB(BB)	;GET JFN IF ANY OF THIS DTA
	  JUMPE A,CPOPJ		;NONE, THEN WE'RE DONE
	MOVE E,FLAGWD(BB)	;GET FLAGS
	TLNN E,DTACLS		;WAS THIS JFN CLOSED BEFORE
	  POPJ P,		;NO, THEN RETURN
	TLNE E,DTADMP		;WAS THE TAPE IN DUMP MODE?
	  JRST DTODMP		;YES, GO MOUNT AND OPEN IT AS SUCH
	PUSHJ P,DTAMNT		;GO RE MOUNT THIS TAPE
	  JRST DTMNTF		;MOUNT FAILED
	PUSHJ P,MDTAER		;MULTIPLE DTA FILES OPEN IS NOT ALLOWED

DTODMP:	PUSHJ P,DTMTND		;MOUNT THE DTA WITHOUT READING DIR
	  JRST DTMNTF		;FAILED
	MOVE B,[447400,,300000]	;OPEN DTA IN DUMP MODE
	OPENF
	  PUSHJ P,BUGSTP	;FAILED
	POPJ P,
;THE TAPOP UUO - ONLY PARTIALLY IMPLEMENTED TO SUPPORT COBOL

TAPOP:	PUSH P,AC		;SAVE UUO AC
	UMOVE AC,1(CAC)		;GET CHANNEL NUMBER
	PUSHJ P,SETUP		;SET UP AA AND BB
	POP P,AC		;RESTORE AC VALUE
	HRRZ A,JFNTAB(BB)	;GET JFN INTO A IF THERE IS ONE
	UMOVE C,2(CAC)		;GET ARGUMENT VALUE
	UMOVE D,0(CAC)		;GET FUNCTION
	CAIGE D,1000		;0 - 777?
	JRST TAPOP0		;YES
	CAIGE D,2000		;1000 - 1777?
	JRST TAPOP1		;YES
	CAIL D,3000		;2000 - 2777?
	JRST RETZER		;NO, ILLEGAL FUNCTION
	ANDI D,777		;GET INDEX
	CAIL D,TAPT2L		;LEGAL INDEX?
	JRST RETZER		;NO
	JRST @TAPTB2(D)		;DISPATCH FOR THIS FUNCTION

TAPOP0:	CAIL D,TAPT0L		;LEGAL FUNCTION?
	JRST RETZER		;NO
	JRST @TAPTB0(D)		;DISPATCH

TAPOP1:	ANDI D,777		;MASK OFF 1000
	CAIL D,TAPT1L		;LEGAL FUNCTION?
	JRST RETZER		;NO
	JRST @TAPTB1(D)		;YES, DISPATCH

TAPTB0:
TAPT0L==.-TAPTB0

TAPTB1:	RETZER			;1000
	TAPRDN			;1001 - READ DENSITY
	TAPTYP			;1002 - GET CONTROLLER TYPE
	TAPRRB			;1003 - SEE IF READING BACKWARDS
	RETZER			;1004
	RETZER			;1005
	RETZER			;1006
	TAPRDM			;1007 - READ DATA MODE
TAPT1L==.-TAPTB1

TAPTB2:	RETZER			;2000
	TAPSDN			;2001 - SET DENSITY
	RETZER			;2002
	TAPSRB			;2003 - SET READ BACKWARDS
	RETZER			;2004
	RETZER			;2005
	RETZER			;2006
	TAPSDM			;2007 - SET DATA MODE
TAPT2L==.-TAPTB2

;GET CONTROLLER TYPE

TAPTYP:	MOVEI A,4		;ALWAYS SAY TM02
	JRST STOTC1

;READ DENSITY

TAPRDN:	JUMPE A,TPRDN1		;IF NO JFN, USE MTADEN
	GTSTS
	JUMPGE B,TPRDN1		;IF NOT OPEN, USE MTADEN
	MOVEI B,.MORDN		;MTA IS OPEN, READ DENSITY DIRECTLY
	MTOPR
	 ERJMP RETZER		;FAILED
	SKIPA A,C		;GET ANSWER INTO AC A
TPRDN1:	LOAD A,MTADEN		;GET DENSITY
	JRST STOTC1		;AND RETURN

;GET MAGTAPE BUFFER SIZE

GETMBS:	SETO A,			;GET THE DATA MODE
	HRROI B,C		;INTO C
	MOVEI C,.JIDM		;DATA MODE
	GETJI
	 ERJMP CPOPJ
	HLRZ F,TPRDMT(C)	;GET THE BYTES PER WORD
	SETO A,			;NOW GET DEFAULT RECORDS PER BUFFER
	HRROI B,D		;GET ANSWER IN D
	MOVEI C,.JIRS		;GET RECORD SIZE IN BYTES
	GETJI
	 JRST CPOPJ		;FAILED
	IDIV D,F		;GET NUMBER OF WORDS PER BUFFER
	SKIPE E			;ROUND UP TO NEXT HIGHEST WORD
	AOS D			;IF NEEDED
	MOVE A,D		;GET ANSWER INTO A
	JRST CPOPJ1		;AND RETURN

;READ DATA MODE

TAPRDM:	PUSHJ P,TAPRD0		;GET THE DATA MODE
	 JRST RETZER		;FAILED, RETURN 0
	JRST STOTC1		;RETURN THE ANSWER

TAPRD0:	MOVE B,FLAGWD(BB)	;SEE IF MODE HAS BEEN SET
	TLNN B,MTADMS
	JRST TPRDM1		;NO GO GET IT
	LOAD A,MTADM		;GET DATA MODE
	JRST CPOPJ1		;RETURN OK

TPRDM1:	HRRZ A,JFNTAB(BB)	;GET THE JFN
	JUMPE A,TPRDM2		;IS THERE A JFN
	GTSTS			;YES
	JUMPGE B,TPRDM2		;FILE NOT OPEN
	MOVEI B,.MORDM		;GET MODE
	MTOPR
	 ERJMP TPRDM2		;ON FALUIRE GIVE DEFAULT
	JRST TPRDM3		;GO CONVERT MODE TO 10 MODE

TPRDM2:	SETO A,			;SET UP TO GET DEFAULT MODE IN C
	HRROI B,C
	MOVEI C,.JIDM
	GETJI			;GET DEFAULT MODE
	 ERJMP CPOPJ
TPRDM3:	HRRZ A,TPRDMT(C)	;CONVERT 20 MODE TO 10 MODE
	JRST CPOPJ1

TPRDMT:	1,,0			;SYSTEM DEFAULT (USE CORE DUMP)
	1,,1			;DUMP MODE 9-TRK
	6,,5			;SIXBIT,7-TRK DUMP MODE
	5,,4			;ANSI ASCII (7 BITS IN 8-BIT BYTE)
	4,,2			;INDUSTRY COMPATIBLE MODE

;SET DENSITY

TAPSDN:	STOR C,MTADEN		;STORE DENSITY
	JUMPE A,MRETN2		;IF NO JFN, THEN DONE
	GTSTS			;SEE IF OPEN
	JUMPGE B,MRETN2		;IF NOT OPEN, RETURN
	MOVEI B,.MOSDN		;MTA IS OPEN
	MTOPR			;SET THE DENSITY
	 ERJMP RETZER		;ILLEGAL DENSITY
	JRST MRETN2		;SUCCESSFUL

;SET DATA MODE

TAPSDM:	PUSHJ P,TPSDM		;SAVE DATA MODE
	 JRST RETZER		;ILLIGAL MODE
	JRST MRETN2		;TAKE SKIP RETURN

TPSDM:	MOVSI B,MTADMS		;INDICATE DATA MODE SET
	IORM B,FLAGWD(BB)
	STOR C,MTADM		;SAVE DATA MODE
	SKIPGE C,TPSDMT(C)	;GET DATA MODE
	POPJ P,			;ILLEGAL DATA MODE
	JUMPE A,CPOPJ1		;IF NO JFN, THEN RETURN
	GTSTS			;SEE IF MTA IS OPEN
	JUMPGE B,CPOPJ1		;IF NOT OPEN, RETURN
	MOVEI B,.MOSDM		;SET UP TO SET DATA MODE
	HRRZS C			;GET MODE
	MTOPR
	 ERJMP CPOPJ
	JRST CPOPJ1		;RETURN OK

TPSDMT:	1,,.SJDDM		;CORE DUMP
	1,,.SJDMC		;CORE DUMP (9 TRACK)
	4,,.SJDM8		;INDUSTRY COMPATIBLE MODE
	-1			;6 BIT MODE (9 TRACK)
	5,,.SJDMA		;7 BIT MODE
	6,,.SJDM6		;SIXBIT (7 TRACK)


;READ BACKWARDS FUNCTIONS

TAPRRB:	JUMPE A,RETZR1		;IF NO JFN, THE DIRECTION IS FORWARD
	MOVE A,FLAGWD(BB)	;GET FLAGS
	TLNN A,MTARDB		;SET TO READ BACKWARDS?
	TDZA A,A		;NO, GET A ZERO
	MOVEI A,1		;YES, GET A ONE
	JRST STOTC1		;RETURN ANSWER

TAPSRB:	JUMPE A,CMRETN		;IF NO JFN, THIS IS AN ERROR
	MOVSI B,MTARDB		;GET READ BACKWARDS FLAG
	TRNN C,1		;WANT TO RESET TO NORMAL READING?
	ANDCAM B,FLAGWD(BB)	;YES, CLEAR BIT
	TRNE C,1		;WANT TO READ BACKWARDS INSTEAD?
	IORM B,FLAGWD(BB)	;YES, THEN SET THE BIT
	JRST MRETN2		;SUCCESSFUL
UMTAPE:	PUSHJ P,SETUP
	MOVE A,FLAGWD(BB)	;IS IT INIT'ED?
	TLNN A,INITF
	PUSHJ P,ERRCHN
	CAIN AA,2		;IS DEVICE A MAGTAPE?
	  JRST MTAPE0		;YES
	CAIN AA,DTA		;OR A DECTAPE?
	TLNE A,LOOKPF!ENTERF	;YES, IS IT ALREADY OPENED FOR A FILE?
	  JRST MRETN		; NOP
MTAPE0:
REPEAT 0,<
;********** TEMPROARY CODE TO GET AROUND RELEASE 2 MONITOR BUG *****
	HRRZ A,FORTY		;GET MTAPE NUMBER
	CAIE A,1		;REWIND?
	CAIN A,6		;FORWARD ON RECORD?
	JRST MTAPE6		;YES
	CAIE A,7		;BACKSPACE ONE RECORD?
	CAIN A,11		;UNLOAD?
	JRST MTAPE6		;YES
	CAIE A,16		;FORWARD 1 FILE?
	CAIN A,17		;BACKSPACE 1 FILE?
	JRST MTAPE6		;YES
	JRST MTAPE7		;NO, DO NOT CLOSE THE JFN

MTAPE6:	PUSH P,FORTY		;CLOSE THIS CHANNEL BEFORE ALL MTAPE'S
	SETZM FORTY		;CLOSE BOTH SIDES
	SETZM IOCNT
	PUSHJ P,UCL1K		;KEEP THE JFN
	POP P,FORTY		;GET BACK THE UUO
MTAPE7:
>				;END OF REPEAT 1
	HRRZ A,JFNTAB(BB)	;GET JFN IF ANY
	HRRZ B,FORTY		;GET COMMAND
	CAIE B,100		;HANDLE 100 AND 101 DIFFERENTLY
	CAIN B,101
	JRST MTAPE5
	HRRZ A,JFNTAB(BB)	;GET JFN
	JUMPN A,MTAPE2		;NO GTJFN IF HAVE JFN
	CAIE AA,DTA		;DTA?
	  JRST MTAPE3		;NO
	PUSHJ P,DTMTND		;MOUNT WITH NO DIRECTORY
	  JRST MTMNTF		;GO TRAP TO USER
MTAPE3:	PUSHJ P,JBKSET		;INITIALIZE JBLOCK
	PUSHJ P,DEV67		;MOVE THE NAME TO ASCIZ BLOCK
	HRROI A,DEVNM7		;POINTER TO IT.
	MOVEM A,JBLOCK+2	;DEVICE NAME MTAX
	MOVSI A,(GJ%FOU)		;FOR OUTPUT
	MOVEM A,JBLOCK
	SETZ B,
	MOVEI A,JBLOCK
	GTJFN
	PUSHJ P,ERROR
	MOVEM A,JFNTAB(BB)

MTAPE2:	GTSTS
	JUMPGE B,MTAPE4		;JUMP IF NOT YET OPENED
	PUSHJ P,MTAPE1
	JRST MRETN
MTAPE4:	MOVE B,[XWD 447400,200000] ;OPEN IN DUMP MODE
	HRRZ C,FORTY
	CAIE C,3		;WRITE AN EOF?
	CAIN C,13		;OR ERASE TAPE?
	MOVE B,[447400,,100000]	;YES, OPEN IT FOR WRITE
	OPENF
	PUSHJ P,ERROR
	PUSHJ P,MTAPE1
	HRLI A,(CO%NRJ)		;OPENED IT ONLY TO DO THE MTOPR.
	CLOSF
	PUSHJ P,ERROR
	JRST MRETN

MTAPE5:	MOVEI C,1		;SET FOR 9-TRK CORE DUMP
	CAIE B,100		;IS IT 9-TRK CORE DUMP
	MOVEI C,2		;NO SET TO INDUSTRY COMPATIBLE MODE
	PUSHJ P,TPSDM		;SAVE MODE AND SET IF POSSIBLE
	JRST MRETN		;ILLEGAL MODE SHOULD NOT GET HERE
	JRST MRETN		;RETURN TO USER

MTAPE1:	HRRZ B,FORTY		;GET COMMAND
	MTOPR			;DO IT
	 ERJMP .		;IGNORE ERRORS
	POPJ P,

MTMNTF:	PUSHJ P,MNTFAI		;TRAP TO USER
	PUSHJ P,ERROR		;HE DID NOT WANT TRAP, TYPE MESSAGE
	JRST DTMNT1		;SAY THAT DEVICE IS NOT MOUNTED
INDMER:	PUSHJ P,DTAX3Q		;SEE IF SIZE ERROR ON DTA
	  JRST INDM4B		;EOF SEEN
	PUSH P,B		;YES. STASH POSITION OF OFFENDING IOWD
	PUSH P,0(B)		;STASH THE IOWD ON STACK
INDME1:	MOVSI A,MAXIOL		;SEE IF A K LEFT
	ADD A,0(P)		; ..
	JUMPG A,INDME2		;NO. SHOULD BE READY TO QUIT.
	MOVSI A,-MAXIOL		;A REASONABLE SIZE IOWD
	HRR A,0(P)		;FIRST PART OF THE BIG LIST
	MOVEM A,DMPLST		;PLACE TO STASH IOL
	SETZM DMPLST+1		;TERMINATE LIST
	HRRZ A,JFNTAB(BB)	;READY TO DO SOME I/O. GET JFN
	MOVEI B,DMPLST		;WHERE IO LIST IS
	DUMPI			;TRY THIS
	  JRST INDME4		;GO SEE IF EOF
	MOVE A,[XWD MAXIOL,MAXIOL]	;UPDATE PARTIAL IOWD ON STACK
	ADDM A,0(P)		; ..
	JRST INDME1		;TRY THE REST OF IOLIST
INDME2:	POP P,DMPLST		;SHOULD BE READY TO HANDLE THIS
	HRRZ A,JFNTAB(BB)	;GET THE JFN
	HLLZ B,DMPLST		;IS IT BY LUCK EMPTY NOW?
	JUMPE B,INDME3		;JUMP IF SO
	MOVEI B,DMPLST
	DUMPI			;READ IT
	  JRST INDME5		;GO SEE IF EOF
INDME3:	POP P,B			;RESTORE PLACE IN I/O LIST
	ADDI B,1		;NEXT WORD.
	SKIPE 0(B)		;END OF LIST, I HOPE?
	JRST INDM1		;NO. HAVE TO TRY THAT PART OF LIST
	JRST INDM3		;END. QUIT INDMP SUBR

INDME4:	POP P,DMPLST		;RESTORE DMPLST
INDME5:	POP P,B			;AND B
	CAIE A,IOX4		;IS THIS AN EOF
	  PUSHJ P,ERROR		;NO
	JRST INDM4B		;YES, GO SET EOF BIT

DTAX3Q:	CAIN A,IOX4		;EOF?
	  POPJ P,		;YES, GO SET THE BIT
	CAIE A,DUMPX3		;RECOVERABLE LENGTH ERROR?
	  JRST ERROR		;NO. GIVE ERROR MESSAGE
	LDB A,PDVNUM		;GET DEVICE TYPE CODE.
	CAIE A,DTA		;DECTAPE?
	JRST ERROR		;NOPE. LOSE.
	JRST CPOPJ1		;YES. RETURN.
INDTA:	PUSHJ P,DTAINI		;CLOSE ANY OTHER JFNS FOR THIS DTA
	MOVE B,FLAGWD(BB)	;ARE WE READING A DIRECTORY
	TLNN B,RDUFDF!DTADMP
	  JRST INBYT		;NO, LET INBYT DO THE WORK
	TLNE B,UFDEOF		;EOF YET?
	  JRST INTY8A		;YES
	MOVN C,IOCNT		;SET UP DUMPI COMMAND
	HRLZS C
	HRR C,IOBPT
	SETZ D,
	TDNE B,[XWD RDUFDF,100]	;READING THE DIRECTORY OR IN MODE 100?
	  JRST [SUB C,[XWD 1,1]	;YES, READ 200 WORDS INTO THE 177 WORD
		TRO PF,R.NOWC	;BUFFER. THIS USES THE BYTE COUNT WORD
		JRST .+1]	;AS THE EXTRA WORD.  TOPS-10 KLUDGE!!!
	MOVEI B,C		;POINT TO COMMAND LIST
	DUMPI
	  JRST INDTA1		;GO CHECK FOR EOF
	MOVSI A,RDUFDF
	MOVSI B,UFDEOF		;DIRECTORY IS ONLY ONE BLOCK LONG
	TDNE A,FLAGWD(BB)	;ARE WE READING A DIRECTORY
	  IORM B,FLAGWD(BB)	;YES, MAKE IT BE ONLY ONE BLOCK LONG
	MOVE A,IOCNT		;SET UP IOBPT
	ADDM A,IOBPT
	SETZM IOCNT
	JRST INTTY9		;RETURN

INDTA1:	CAIE A,IOX4		;EOF?
	  PUSHJ P,ERROR		;NO
	JRST INTY8A		;YES, GO SET BIT

IFN SAMFRK,<
INBYT:	HRRZ A,JFNTAB(BB)	;GET JFN (RH ONLY)
	BIN			;GET FIRST BYTE
	MOVE G,B		;SAVE IT
	GTSTS
	TLNE B,1000		;END OF FILE?
	JRST INTY8A		;YES
	MOVE B,G
	SOSGE IOCNT
	JRST INDON1
	IDPB B,IOBPT
	MOVE 2,IOBPT
	MOVN 3,IOCNT
	SIN			;LET MONITOR DO THE LOOPING
	MOVEM 2,IOBPT
	MOVNM 3,IOCNT		;STORE UPDATED BYTE COUNT
	JRST INTTY9
>
OUTDTA:	PUSHJ P,DTAINI		;CLOSE OTHER JFNS FOR THIS DTA
	MOVE B,FLAGWD(BB)	;GET FLAGS
	TLNN B,DTADMP		;IN DUMP MODE FOR DTA
	  JRST OUTBYT		;NO USE SOUT OR BOUT
	TLNE B,UFDEOF		;HAS DIR ALREADY BEEN WRITTEN
	  JRST [MOVEI B,1B22	;YES, SET END OF FILE
		IORM B,FLAGWD(BB)
		POPJ P,]	;AND RETURN
	MOVSI C,-200		;YES, SET UP FOR A FULL 200 WORDS
	HRR C,IOBPT		;GET START OF BUFFER
	SETZ D,
	TDNE B,[RDUFDF,,100]	;MODE 100 OR WRITING DIR?
	  HRRI C,-1(C)		;YES, THE FIRST WORD IS THE WORD COUNT WORD
	MOVEI B,C		;GET COMMAND LIST POINTER
	DUMPO
	  PUSHJ P,ERROR
	MOVE A,IOCNT
	ADDM A,IOBPT
	SETZM IOCNT
	MOVSI B,UFDEOF		;SET EOF FLAG IF THIS WAS THE DIR
	MOVE C,FLAGWD(BB)
	TLNE C,RDUFDF		;ONLY IF WRITING THE DIR
	  IORM B,FLAGWD(BB)	;THEN CLOSE WONT WRITE GARBAGE ON TAPE
	POPJ P,
OUTMTA:	TROA PF,R.DIRN		;FLAG OUTPUT DIRECTION
INMTA:	TRZ PF,R.DIRN		;FLAG INPUT DIRECTION
	SKIPG B,IOCNT
	POPJ P,
	MOVSI A,MTABFS		;SEE IF THE BUFFERS ARE SET UP
	TDNN A,FLAGWD(BB)
	JRST [	IORM A,FLAGWD(BB) ;NO, SET THEM UP BEFORE FIRST USE
		HRRZ A,JFNTAB(BB) ;GET THE JFN OF THE MTA
		MOVEI B,.MORDM	;READ THE DATA MODE
		MTOPR
		 ERJMP .+1	;IF THIS FAILS, USE DEFAULTS FOR JOB
		HLRZ D,TPRDMT(C) ;GET NUMBER OF BYTES PER WORD
		MOVEI B,.MORRS	;READ THE RECORD SIZE
		MTOPR
		 ERJMP .+1	;IF FAILS, DONT CHANGE IT
		HRRZ B,BUFHTB(BB) ;GET POINTER TO BUFFER RING
		TRNE PF,R.DIRN	;DOING OUTPUT?
		HLRZ B,BUFHTB(BB) ;YES, GET OUTPUT BUFFER
		HRRZ B,0(B)	;GET ADDRESS OF FIRST BUFFER IN RING
		LDB B,[POINT 17,0(B),17] ;GET BUFFER SIZE
		IMULI B,0(D)	;GET NUMBER OF RECORDS PER BUFFER
		CAIL C,-1(B)	;IS THE MTA RECORD SIZE TOO SMALL?
		JRST .+1	;NO, DONT CHANGE ANYTHING
		MOVEI C,776(B)	;YES, SET UP LARGER BUFFER
		TRZ C,777	;ROUNDED UP TO THE NEXT PAGE
		MOVEI B,.MOSRS	;SET THE RECORD SIZE
		MTOPR
		 ERJMP .+1
		JRST .+1]
	HRRZ A,JFNTAB(BB)	;GET JFN
	MOVE B,IOBPT		;GET BYTE POINTER
	MOVN C,IOCNT		;AND NEGATIVE COUNT OF BYTES
	TRNE PF,R.DIRN		;IN OR OUT?
	JRST OUTMT1		;OUTPUTTING
	SINR			;READ IN THE RECORD
	 ERJMP SEQMTE		;ERROR OCCURED
SEQMTR:	MOVEM B,IOBPT		;STORE UPDATED BYTE POINTER
	MOVNM C,IOCNT		;AND UPDATED COUNT
	POPJ P,			;AND EXIT

OUTMT1:	SOUTR
	 ERJMP SEQMTE		;ERROR OCCURED ON THE WRITE
	JRST SEQMTR		;GO EXIT

SEQMTE:	MOVEM B,IOBPT		;STORE UPDATED BYTE POINTER
	MOVNM C,IOCNT		;AND COUNT
	HRRZ A,JFNTAB(BB)	;NOW GET ERROR STATUS
	GDSTS
	TRNN B,MT%EOF		;END OF FILE?
	JRST TAPERR		;NO, GO ANALIZE IT
	JRST RECCH1		;YES, GO SET EOF BIT AND EXIT
MTALP2:	MOVEM B,SPDELC		;INITIAL COMMAND
MTALP:	MOVE B,SPDELC		;NEXT OR CORRECTED IOL
	TRNE PF,R.DIRN		;OUTPUT?
	JRST DMP2		;YES. GO DO OUTPUT
	MOVSI C,MTALTW		;MARK LAST TRANSFER NOT A WRITE
	ANDCAM C,FLAGWD(BB)
	DUMPI
	  JRST EOFCHK
	JRST DMP3

MTALP1:	SETOM MTDUMP		;FLAG DUMP MODE REQUEST
	SETZM IOCNT		;SET POSITIVE COUNT SO RECORD LENGTH
	AOS IOCNT		;ERROR DOESN'T HAPPEN SPURIOUSLY
	JRST MTALP2		;GO TO IT

DMP2:	MOVSI C,MTALTW		;MARK LAST TRANSFER WAS A WRITE
	IORM C,FLAGWD(BB)
	DUMPO
	  JRST MTAERR		;ERROR, GIVE USER THE ERROR BITS
DMP3:	MOVE C,IOCNT		;GET SIZE OF BUFFER
	ADDM C,IOBPT		;UPDATE BUFFER POINTER
DMP4:	SETZM IOCNT		;OK
	JRST RECCH1		;UPDATE THE STATUS

EOFCHK:	CAIE A,IOX4		;EOF?
	JRST RECCHK		;NO
	MOVEI A,1B22
	IORM A,FLAGWD(BB)
	JRST DMP4

CLSMTA:	MOVSI A,OUFIRF		;WAS A WRITE DONE?
	MOVE B,FLAGWD(BB)
	ANDI B,17		;GET MODE OF OPEN
	CAIL B,15		;SEQUENTIAL MODE?
	TDNN A,FLAGWD(BB)	;OR NO WRITE DONE?
	  POPJ P,		;YES, DONT DO ANYTHING
	MOVE A,JFNTAB(BB)	;NO, NOW WRITE OUT EOF
	MOVEI B,3		;MTOPR CODE 3 = EOF
	MTOPR
	 ERJMP .		;IGNORE ERRORS
	MTOPR			;DO 2 EOF'S AND BACK OVER ONE
	 ERJMP .		;IGNORE ERRORS
	MOVEI B,7		;MTOPR CODE 7 = BACKSPACE
	MTOPR
	 ERJMP .		;IGNORE ERRORS
	POPJ P,			;THRU
;INPUT ERROR OTHER THAN EOF FROM DUMPI

RECCHK:	HLRO A,(B)		;GET -WC FROM TRANSFER IN PROGRESS
	SKIPE MTDUMP		;AND IF DUMP MODE,
	MOVNM A,IOCNT		;STORE AS LAST TRANSFER ATTEMPT
	HRRZ A,JFNTAB(BB)	;GET THE JFN
	GDSTS			;GET THE VIROS STATUS
	TRNN B,10000		;RECORD LENGTH ERROR?
	  JRST TAPERR		;CHECK OTHER ERRORS
	HLRZ D,C		;WORD COUNT
	MOVEI B,.MORDM		;SET UP TO GET DATA MODE
	MTOPR
	 ERJMP [MOVE C,D	;IF ERROR ASSUME DUMP MODE
		JRST RECCH2]	;AND SKIP DIVIDE
	HLRZ C,TPRDMT(C)	;CONVERT TO 10 MODE
	EXCH C,D		;SET UP FOR DIVIDE
	IDIVI C,(D)		;GET WORDS TRANSFERED
	SKIPE D			;REMAINDER?
	AOS C			;YES
RECCH2:	ADDM C,IOBPT		;UPDATE BUFFER POINTER WORD
	SUB C,IOCNT		;WORDS NOT TRANSFERRED
	MOVNM C,IOCNT
MTAERR:	PUSHJ P,GST2		;CONVERT TO 10/50 ERROR BITS
	SKIPLE IOCNT		;WAS ERROR REALLY TOO LONG?
	TRZ A,1B21		;YES. TOO SHORT ISN'T AN ERROR ON 10/50
	HRRM A,FLAGWD(BB)	;STORE STATUS BITS.
	HRRZ A,JFNTAB(BB)
	SETZ B,
	MTOPR			;CLR ERROR FLAGS
	 ERJMP .		;IGNORE ERRORS
	POPJ P,

;HERE ON SUCCESS FOR DUMPI OR DUMPO, NO ERRORS. JUST UPDATE
; THE PHYSICAL UNIT STATUS BITS

RECCH1:	PUSHJ P,GST2		;UPDATE FLAGS
	HRRM A,FLAGWD(BB)	;IN CHANNEL CONTROL BLOCK
	POPJ P,0		;AND RETURN TO DUMP IO PROCESSOR

TAPERR:	TRNN B,722000		;OTHER KNOWN ERRORS
	  PUSHJ P,ERROR		;NO, GO COMPLAIN
	JRST MTAERR		;YES, MARK THESE ERRORS IN STATUS WORD
;ROUTINE TO DO SETSTS ON MTA

MTASET:	PUSHJ P,MTASTS		;CALL SUBR
	JRST MRETN

MTASTS:	HRRZ A,JFNTAB(BB)	;GET JFN OF MTA
	HRRZ B,FLAGWD(BB)	;GET MODES
	ANDI B,1700		;ONLY CARE ABOUT DENSITY, PARITY AND ERROR RETRY SUPPRESS
	TRZE B,100		;ERROR RETRY SUPPRESS?
	TRO B,40000		;YES, PUT IN POSITION FOR SDSTS
	SDSTS			;SET THESE BITS
	MOVEI B,.MOSDN		;SET UP TO SET DENSITY
	LOAD C,MTADEN		;GET DENSITY IF ANY
	SKIPE C			;HAS IT BEEN SPECIFIED
	MTOPR			;YES, SET IT
	 ERJMP .+1
	MOVEI B,.MOSDR		;SET UP READ BACKWARDS FUNCTION
	MOVSI C,MTARDB		;GET FLAG
	TDNN C,FLAGWD(BB)	;WANT TO READ BACKWARDS?
	TDZA C,C		;NO, GET A ZERO
	MOVEI C,1		;YES, GET A ONE
	MTOPR			;TELL MONITOR WHAT TO DO
	 ERJMP .+1		;IGNORE ERROR
	MOVE B,FLAGWD(BB)	;GET THE FLAGS
	TLNN B,MTADMS		;HAS THE DATA MODE BEEN SET
	POPJ P,			;NO, DO NOT SET IT TAKE SYSTEM DEFAULT
	MOVEI B,.MOSDM		;NOW DO THE DATA MODE SETTING
	LOAD C,MTADM
	HRRE C,TPSDMT(C)	;GET DATA MODE
	JUMPL C,CPOPJ		;IF NONE, RETURN
	MTOPR			;SET THE DESIRED DATA MODE
	 ERJMP .+1
	POPJ P,			;RETURN TO CALLER
OUDMER:	PUSHJ P,DTAX3Q		;SEE IF DTA SIZE ERROR.
	  JRST ERROR		;EOF SEEN
	PUSH P,B		;YES. SAVE POSITION OF IOWD
	PUSH P,0(B)		;STASH OFFENDING IOWD
OUDME1:	MOVSI A,MAXIOL		;A REASONABLE VIROS LENGTH
	ADD A,0(P)		;WITHIN THAT FAR OF END?
	JUMPG A,OUDME2		;JUMP IF SO.
	MOVSI A,-MAXIOL		;MAKE A PARTIAL IOWD
	HRR A,0(P)		; ..
	MOVEM A,DMPLST		;STASH IT FOR DUMPO
	SETZM DMPLST+1		;AND CLEAR FOR A TERMINATOR
	HRRZ A,JFNTAB(BB)	;GET THE JFN
	MOVEI B,DMPLST		;AND WHERE THE SHORT IOL IS
	DUMPO			;TRY IT AGAIN, SAM
	  PUSHJ P,ERROR		;IF THIS LOSES, GIVE UP.
	MOVE A,[XWD MAXIOL,MAXIOL]	;UPDATE THE POINTER
	ADDM A,0(P)		; ..
	JRST OUDME1		;AND TRY THE REST OF IT
OUDME2:	POP P,DMPLST		;GET BACK THE PARTIAL IOLIST LEFT
	HRRZ A,JFNTAB(BB)	;GET THE JFN BACK
	HLLZ B,DMPLST		;DID IOL JUST NOW RUN OUT?
	JUMPE B,OUDME3		;IF SO, SKIP I/O
	MOVEI B,DMPLST		;POINT TO IO LIST
	DUMPO			;TRY TO OUTPUT REMAINING STUFF
	  PUSHJ P,ERROR		;CAN'T
OUDME3:		POP P,B			;GET THE POSITION IN ORIGINAL IOL
	ADDI B,1		;POINT AFTER TROUBLESOME GUY
	SKIPE 0(B)		;MORE TO DO YET?
	JRST OUTDM1		;YES. GO TRY NEXT IOWD
	JRST OUTDM3		;NO. QUIT.
;ENQ/DEQ TRANSLATION

.ENQ:	PUSHJ P,ENQSET		;SET UP THE ARGUMENT BLOCK
	 JRST ENQERE		;FAILED
	IJSYS <ENQ>		;DO THE FUNCTION
	 JRST ENQERR		;FAILED, GO TRANSLATE ERROR CODE
	JRST MRETN2		;SUCCESSFUL

.DEQ:	TLNE CAC,-1		;FUNCTION 0?
	JRST [	HLRZ A,CAC	;NO, GET FUNCTION CODE INTO A
		HRRZ B,CAC	;AND GET REQUEST ID INTO B (IF FUNC 1)
		JRST DEQ1]	;GO DO DEQ JSYS DIRECTLY
	PUSHJ P,ENQSET		;SET UP FOR JSYS
	 JRST ENQERE		;ILLEGAL ARGUMENT BLOCK
DEQ1:	IJSYS <DEQ>		;DO THE JSYS
	 JRST ENQERR		;ERROR, GO TRANSLATE ERROR CODE
	JRST MRETN2		;SUCCESSFUL

.ENQC:	TLNN CAC,-1		;FUNCTION 0 ONLY
	JRST [	MOVEI A,6	;INVALID FUNCTION
		JRST STOTAC]
	PUSHJ P,ENQSET		;SET UP ARG BLOCK FOR JSYS
	 JRST ENQERE		;FAILED
	MOVE C,ACS+1(AC)	;GET THIRD ARG - STATUS BLOCK ADR
	IJSYS <ENQC>
	 JRST ENQERR		;FAILED, TRANSLATE ERROR CODE
	JRST MRETN2

ENQSET:	XCTUU <HRRZ D,0(CAC)>	;GET LENGTH OF ARG BLOCK
	CAILE D,TMPBKL		;TOO BIG?
	 POPJ P,		;YES, GIVE ERROR RETURN
	HRLZ C,CAC		;GET ADR OF ARG BLOCK
	HRRI C,TMPBLK		;MOVE BLOCK TO INSIDE PAT
	ADDI D,TMPBLK-1		;GET END POINT
	BLT C,0(D)
	HLRZ D,TMPBLK		;GET # OF LOCKS
	MOVEI C,TMPBLK+2	;GET POINTER TO FIRST JFN WORD
ENQSLP:	HRRE B,0(C)		;GET LOCK TYPE
	JUMPL B,ENQSL1		;IF NOT A CHANNEL, IGNORE
	IMULI B,NTABS		;GET OFFSET INTO CHANNEL TABLE
	HRRZ A,JFNTAB(B)	;GET JFN
	HRRM A,0(C)		;REPLACE CHANNEL # WITH JFN
ENQSL1:	ADDI C,3		;STEP TO NEXT LOCK
	SOJG D,ENQSLP		;LOOP BACK FOR ALL LOCKS
	HLRZ A,CAC		;GET FUNCTION CODE
	MOVEI B,TMPBLK		;GET POINTER TO ARG BLOCK
	JRST CPOPJ1

ENQERR:	MOVSI D,-ENQTBL		;SET UP TO TRANSLATE ERROR CODE
ENQERL:	HRRZ C,ENQTAB(D)	;GET NEXT ERROR CODE
	CAMN A,C		;FOUND A MATCH YET?
	JRST ENQERF		;YES, GO USE IT
	AOBJN D,ENQERL		;LOOP BACK TILL FOUND
ENQERE:	TDZA A,A		;UNKNOWN ERROR, RETURN 0
ENQERF:	HLRZ A,ENQTAB(D)	;GET ERROR CODE TRANSLATION
	JRST STOTAC

ENQTAB:	6,,ENQX1
	17,,ENQX2
	25,,ENQX3
	22,,ENQX4
	23,,ENQX5
	1,,ENQX6
	24,,ENQX7
	20,,ENQX8
	10,,ENQX9
	7,,ENQX10
	11,,ENQX11
	2,,ENQX12
	15,,ENQX13
	4,,ENQX14
	26,,ENQX15
	12,,ENQX16
	14,,ENQX17
	21,,ENQX18
	5,,ENQX19
	0,,ENQX20
	3,,ENQX21
	13,,MONX01
ENQTBL==.-ENQTAB
;IO ERROR - THIS DOES NOT GET PASSED TO THE USER VIA CNIWRD
; RATHER IT CAUSES IO ERROR BITS TO BE SET IN THE FILE STATUS WORD

IOERR:	MOVEM 17,IAC+17		;SAVE SOME AC'S
	MOVEI 17,IAC
	BLT 17,IAC+16
	SKIPN INPAT
	JRST IOER2		;GIVE ERROR MESSAGE AND HALT.
	MOVEI 7,1B19+1B20	;PREPARE TO SET THESE BITS IN STAT WD
	MOVE 1,BB		;EXTENSIVE CHECK TO BE SURE WE KNOW
	CAIL 1,0		;WHAT WE'RE DOING
	CAIL 1,NTABS*20		;BB SHOULD HAVE INDEX TO IO CHANNEL
	JRST IOER2		;DOESN'T,ISSUE ERROR MESSAGE AND HALT
	IDIVI 1,NTABS		;SHOULD BE POINTING TO FIRST OF BLOCK
	JUMPN 2,IOER2		;NO, ISSUE ERROR MESSAGE AND HALT
	HRRZ A,RETSAV		;GET THE ADR OF THE INSTRUCTION
	CAIL A,MOVINS		;DOING THE BLT AT MOVBUF?
	CAILE A,MOVINE
	SKIPA			;NO
	JRST IOER0		;YES,THEN MARK THE ERROR BITS
	HRRZ 1,IAC+1		;AC1 AT TIME OF INTERRUPT
	HRRZ 2,JFNTAB(BB)	;GET JFN #
	CAME 1,2		;IS THIS A JFN IN 1
	JRST IOER2		;NO,ISSUE ERROR MESSAGE AND HALT
IOER0:	IORM 7,FLAGWD(BB)	;ALL SEEMS IN ORDER, SET ERROR BITS
IOER1:	MOVSI 17,IAC		;RESTORE AC'S
	BLT 17,17
	DEBRK			;AND RESUME IO

IOER2:	MOVE P,[IOWD IPDLL,IPDL]
	TMSG <$? PA1050: I-O ERROR AT ADDRESS > ;(317) FATAL ERROR MESSAGE
	MOVEI 1,PROJFN		;TYPE OUT ADR
	HRRZ 2,RETSAV
	MOVEI 3,10
	NOUT
	 JFCL
	TMSG <$>
	HALTF			;(317) HALT IF NOT PAT GENERATED ERROR


	JRST IOER1		;GO EXIT
;CARD READER INPUT ROUTINE

INCDR:	MOVE A,FLAGWD(BB)	;GET MODE
	ANDI A,17
	CAIE A,10		;IMAGE MODE IS SPECIAL
	JRST INBYT		;DO NORMAL PROCESSING
INCDR1:	HRRZ A,JFNTAB(BB)	;GET JFN
	SOSG IOCNT		;ANY MORE TO DO?
	JRST INTTY9		;NO, GO EXIT
	BIN			;GET A 16 BIT BYTE
	ERJMP INERR		;ERROR OR EOF
	IDPB B,IOBPT		;STORE 12 BITS ONLY
	JRST INCDR1		;LOOP UNTIL DONE

INERR:	MOVEI A,.FHSLF		;GET ERROR CODE
	GETER
	HRRZS B			;GET CODE
	CAIN B,IOX4		;EOF?
	JRST INTY8A		;YES, GO SET EOF
	MOVEI A,1B19+1B20	;NO, SET ERROR BITS
	IORM A,FLAGWD(BB)
	JRST INTTY9		;AND RETURN
;MACHINE SIZE EXCEEDED INTERRUPT

MACHSZ:	MOVEM 17,IAC+17		;SAVE THE ACS
	MOVEI 17,IAC
	BLT 17,IAC+16
	MOVE P,[IOWD IPDLL,IPDL]
	MOVE A,RETSAV		;GET INTERRUPT PC
	TLNN A,10000		;INTERRUPT FROM USER MODE?
	JRST MACHS1		;NO, FATAL ERROR
	TMSG <$%% PA1050: INTERNAL SYSTEM RESOURCES CURRENTLY DEPLETED,$           WAITING 30 SECONDS BEFORE ATTEMPTING TO CONTINUE.$>
	MOVEI T1,^D30000
	DISMS			;WAIT 30 SEC
MACHS0:	MOVSI 17,IAC		;RESTORE ACS
	BLT 17,17
	DEBRK

MACHS1:	TMSG <$? PA1050: INTERNAL SYSTEM RESOURCES CURRENTLY DEPLETED.$>
	HALTF			;FATAL
	JRST MACHS0		;IF USER IS BRAVE, TRY TO CONTINUE
REPEAT 0,<
CTOINT:	MOVEM A,IAC+A		;STASH AC A ON A CONTROL O INT
	MOVEM B,IAC+B		;ALSO AC B
	MOVEM C,IAC+C		;AND C
	MOVEI A,PROJFN		;PRIMARY FILE
	MOVSI B,B18		;SIGN OF TYSTAT
	XORB B,TYSTAT		;COMPLEMENT IT.
	SKIPGE B		;ON NOW?
	CFOBF			;YES. CLEAR TTY OUTPUT BUFFER
	HRROI A,[ASCIZ /^O
/]
	PSOUT			;TYPE OUT THE ECHO FOR THE ^O
	MOVE A,RETSAV		;SEE WHERE THE BREAK WAS FROM
	MOVE B,-1(A)		;GET THE INSTRUCTION
	CAME B,CPSOUT		;PRIMARY I/O?
	CAMN B,CPBOUT		; ..
	JRST CTOIN1		;YES.
	CAME B,CBOUT		;NO. DIRECTED I/O?
	CAMN B,CSOUT		; ..
	SKIPA
	JRST ABDBRK		;NO. JUST DEBREAK
	MOVE B,IAC+A		;YES. GET THE JFN.
	CAIE B,PRIJFN		;PRIMARY FILE?
	CAIN B,PROJFN		; ..
	JRST CTOIN1		;YES
	JRST ABDBRK		;NO. RETURN TO IT
CTOIN1:	TLO A,(1B5)		;FORCE TTY JSYS TO QUIT.
	MOVEM A,RETSAV		;PUT BACK FOR DEBRK
>				;END OF CONTROL-O SIMULATION

ABDBRK:	MOVE A,IAC+A		;GET THE AC'S BACK
	MOVE B,IAC+B		; ..
	MOVE C,IAC+C
	DEBRK			;AND DISMISS THE PSI
;CONTROL-C INTERCEPT ROUTINES

	ER.ICC==1B34		;CONTROL-C ENABLE BIT

CHKCCI:	SKIPE INFLSR		;IS THIS A CALL TO DISABLE CONTROL-C?
	  JRST CHKCC1		;YES, GO DO IT
	SKIPN A,.JBINT		;DOES USER WANT TO DISABLE CONTROL-C?
	  POPJ P,		;NO, RETURN
	MOVE A,1(A)		;GET ENABLE WORD
	TRNE A,ER.ICC		;NO, USER WANT IT TO BE ENABLED?
CHKCC1:	SKIPE CCIENB		;^C ALREADY ENABLED?
	  POPJ P,		;NO, RETURN
	PUSHJ P,SETCCE		;ENABLE FOR INTERCEPTING ^C'S
	  POPJ P,		;CANNOT ENABLE FOR CONTROL-C INT
	SETOM CCIENB		;MARK THAT ^C IS NOW ENABLED
	JRST SETPSI		;GO ENABLE ^C CHANNEL

SETCCE:	MOVEI A,.FHSLF		;READ IN CAPABILITIES
	RPCAP
	TLNN B,(1B0)		;CAN CONTROL-C BE ENABLED?
	  JRST [TLO PF,L.NCCE	;NO, MARK THAT IT CANNOT BE SET
		POPJ P,]	;AND RETURN
	TLON C,(1B0)		;IS ^C ALREADY ON
	  EPCAP			;NO, ENABLE IT
	JRST CPOPJ1

CCIINT:	MOVEM A,IAC+A		;COME HERE ON A ^C INTERRUPT
	MOVEM B,IAC+B
	MOVEM C,IAC+C
	AOS A,FRUSTC		;HOW MANY ^C'S SO FAR?
	CAIL A,MAXFRU		;IS USER TRYING DESPARATLY TO STOP
	 JRST NOCCTP		;YES, STOP
	SKIPN A,.JBINT		;DOES USER WANT TO TRAP?
	  JRST NOCCI		;NO, DONT TRAP
	MOVE B,1(A)		;GET ENABLE BITS
	TRNN B,ER.ICC		;STILL SET?
	  JRST NOCCI		;NO, GO DISABLE FEATURE
	SKIPE 2(A)		;PC WORD ZERO?
	  JRST NOCCI		;NO, LET ^C GO THROUGH TO EXEC
	MOVSI B,ER.ICC		;MARK WHICH TRAP CONDITION OCCURED
	IORM B,3(A)		;IN INTERRUPT BLOCK
CCINT1:	SETOM CCIFLG		;MARK THAT A ^C IS IN PROGRESS
	MOVE A,IAC+A		;RESTORE ACS
	MOVE B,IAC+B
	MOVE C,IAC+C
	JRST CSTART		;GO TRAP TO USER

NOCCI:	SKIPE INPAT		;IN COMPATIBILITY PACKAGE
	SKIPN INFLSR		;AND IN FILSER?
	  SKIPA			;NO
	JRST CCINT1		;YES, DONT LET CONTROL-C GO THROUGH
NOCCTP:	SETZM CCIENB		;DISABLE ^C INTERCEPT
	MOVEI A,3		;DEACTIVATE ^C CHANNEL
	DTI
	MOVEI A,-1		;GET CONTROLING TTY DESIGNATOR
	MOVEI B,C.CC		;GET A ^C
	STI			;PUT IT INTO TTY INPUT BUFFER
	STI			;AND AGAIN BECAUSE CONTROL-C IS DEFERED
	JRST ABDBRK		;NOW DISMIS, ALLOWING ^C TO INTERRUPT EXEC

CCTRAP:	SOS PDL			;BACK UP THE PC
	JRST MRETN		;GO TRAP TO HIM
;ROUTINE TO INTERCEPT USER INTERRUPTS VIA COMPAT 6 UUO

USRINT:	SKIPE UIIFLG		;DOING IIC FROM BELOW?
	JRST USRIN3		;YES
	MOVEM A,UIACA		;SAVE AN AC
	SKIPE INFLSR		;IN FILSER
	 JRST USRIN2		;YES, DELAY INTERRUPT
	HRRZ A,@USRSAV		;GET PC OF INTERRUPTED  PROGRAM
	CAIL A,PATLOC		;IN PAT?
	CAILE A,ENDFF
	 JRST USRIN1		;NO, GO TRAP TO USER
	SKIPN INPAT		;INSIDE PAT PROPER
	 JRST USRIN0		;NO, GO BACK UP PC AND TRAP
	CAIL A,INJSYS		;INTERRUPTABLE JSYS?
	CAIL A,INJSYE
	 JRST USRIN2		;NO
	SETZM IOWATF		;CLEAR WAITING FLAG
	MOVE A,MONUPC		;GET RETURN ADDRESS
	HRRI A,-1(A)		;BACK UP PC
	MOVEM A,@USRSAV		;SET UP INTERRUPT PC
	MOVSI 17,ACS		;RESTORE ACS
	BLT 17,17		;...
	JRST @UITRAP		;TRAP TO USER

USRIN0:	MOVE A,MONUPC		;GET RETURN ADDRESS
	HRRI A,-1(A)		;BACK UP PC
	MOVEM A,@USRSAV		;SET UP INTERRUPT PC
USRIN1:	MOVE A,UIACA		;RESTORE AC
	JRST @UITRAP		;TRAP TO USER PROGRAM

USRIN2:	SETOM UIFLAG		;MARK THAT AN INTERRUPT IS IN PROGRESS
	MOVE A,UIACA		;GET BACK AC
	DEBRK			;FINISH UUO
	PUSHJ P,BUGSTP

USRIN3:	MOVE A,JOBPD1		;GET ADDRESS TO TRAP TO
	MOVEM A,@USRSAV
	MOVE A,ACS+A		;RESTORE ACS
	MOVE B,ACS+B
	SETZM UIIFLG		;CLEAR INTERRUPT FLAG
	JRST @UITRAP		;TRAP TO USER JOB
NXPINT:	MOVEM A,IAC+A
	MOVEM B,IAC+B		;PRESERVE TWO AC'S
	MOVEM C,IAC+C
	HRRZ A,RETSAV		;GET PC OF INTERRUPT
	CAIL A,PATLOC		;IS LESS THAN COMPATIBILITY PACKAGE
	  JRST ABDBRK		;YES, THIS IS OK,  PROBABLY DDT
	MOVEI A,.FHSLF		;THIS FORK
	GTRPW			;GET THE TRAP STATUS WORD
	SKIPN INPAT		;FROM INSIDE PAT?
	TLNE A,1		;OR FROM MONITOR MAP (SPURIOUS)?
	JRST ABDBRK		;YES. QUIT. PROCESS CONTINUES.
	HRRZS A			;ADDRESS REFERRED TO
	TRNE A,776000		;REFERENCE TO PAGE 0 OR 1 IS OK.
	CAMG A,JBREL		;ABOVE USER'S LEGIT AREA?
	JRST ABDBRK		;NO. FILLING IN SPACE. OK.
	CAMGE A,HSORG		;IN HISEG?
	JRST NXPBAD		;NO. BAD.
	CAMG A,JBHRL		;OUT OF BOUNDS IN HIGH SEG?
	JRST ABDBRK		;NO. SCRATCH PAGE IN HIGH SEG.
				;***SHOULD CHECK UWP BIT***
NXPBAD:	MOVEM A,ASAVE		;STASH ADDRESS FOR A MOMENT
	HRRZ B,A		;PAGE REFERENCED BY ACCIDENT
	LSH B,-11		;PAGE NUMBER FROM ADDRESS
	HRLI B,.FHSLF		;IN THIS FORK
	SETO A,			;TO OBLIVION
	SETZ C,			;CLEAR COUNT OF PAGES TO BE DELETED
	PMAP			;GET RID OF THE PAGE
	MOVE A,ASAVE		;GET THE ADDRESS BACK
	MOVE B,USRENB		;DID USER ASK FOR THESE ERRORS?
	TRNE B,1B22!1B23	;BY ILL MEM REF OR NXM?
	JRST MINT1		;YES. GO SNEAK INTO MEMINT CODE.
	MOVEI B,NXPTRP		;PC TO GET THIS TRAP
	EXCH B,RETSAV		;PUT IT IN DE-BREAK PC
	HRL B,A			;SAVE ADDRESS ATTEMPTED TOO
	MOVEM B,MONUPC		;***WHERE SHOULD THIS REALLY GO?
	JRST ABDBRK		;AND DEBREAK, STOPPING USER.
;HERE ON NON-PSI LEVEL AFTER STOPPING USER.
NXPTRP:	MOVEM 17,ACS+17		;STASH USER'S AC'S
	MOVEI 17,ACS
	BLT 17,ACS+16		; ..
	MOVE P,PATSTK		;GET THE STACK AC TO PDL
	MOVE PF,PFLAGS		;AND THE GENERAL FLAGS
	TMSG <$? PA1050: ILLEGAL REFERENCE TO ADDRESS >
	MOVEI A,PROJFN		;TO TTY OUTPUT
	HLRZ B,MONUPC		;ADDRESS ATTEMPTED
	MOVEI C,10		;OCTAL RADIX
	NOUT			;TYPE OUT THE ADDRESS
	  JFCL
ATUSER:	HRROI A,[ASCIZ / AT USER /]
	PSOUT
	MOVEI A,PROJFN		;ADDRESS THE TTY AGAIN
	HRRZ B,MONUPC		;GET THE PC AT TIME OF ERROR
	TLO B,(1B5)		;USER MODE BIT
				; *** LOST OLD ARITH FLAGS. FOO.***
	MOVEM B,PDL		;IN CASE HE SAYS CONTINUE.
	HRRZS B			;CLEAR FOR NOUT
	MOVEI C,10		;RESET OCTAL IN CASE OF ATUSER ENTRY
	NOUT			;TYPE IT OUT
	  JFCL			;"CAN'T FAIL"
	MOVEI A,C.CR		;CRLF
	PBOUT			;TYPE CRLF
	MOVEI A,C.LF		;AND LF
	PBOUT
NXPHLT:	MOVSI 17,ACS		;RESTORE USER AC'S
	BLT 17,17		; ..
	SETZM INPAT		;OUT OF PAT
	HALTF			;HOW TO STOP AND ALLOW CONTINUE, MAKE
				; ALL THIS MORE GENERAL!!!
	MOVE P,PATSTK		;HE TYPED CONTINUE. CAN'T, BUT NEED
	MOVE PF,PFLAGS		;STACK AND FLAGS TO SAY SO.
	PUSHJ P,SETCV		;RESET EXEC CONTROL
	PUSHJ P,SETPSI	; ..
	TMSG <$? PA1050: CAN'T CONTINUE$>
	JRST NXPHLT

OVINT:	SKIPE INPAT
	JRST ERRINT
	MOVEM A,IAC+1
	MOVE A,RETSAV
	TLO A,(1B0)		;MARK OVERFLOW IN SAVED FLAGS
	MOVEM A,.JBTPC		;SETUP RETURN PC
	MOVE A,CNIWRD
	TRO A,10		;OVERFLOW
	JRST INT

FOVINT:	SKIPE INPAT
	JRST ERRINT
	MOVEM A,IAC+1
	MOVE A,RETSAV
	TLO A,(1B0+1B3)		;MARK OV AND FOV IN FLAGS
	MOVEM A,.JBTPC		;SETUP RETURN PC
	MOVE A,CNIWRD
	TRO A,100		;FLOATING OVERFLOW
	JRST INT

PDLINT:	SKIPE INPAT
	JRST ERRINT
	MOVEM A,IAC+1
	MOVE A,RETSAV
	MOVEM A,.JBTPC		;SETUP RETURN PC
	MOVE A,CNIWRD
	TRO A,200000		;PDL OVERLFOW
	JRST INT

MINT1:	MOVE A,IAC+A		;HERE FROM NXPBAD. FAKE MEMINT
	MOVE B,IAC+B		;BY RESETTING AC'S AND THEN
	MOVE C,IAC+C
	JRST MINT2		; JUMPING INTO MEM INT ROUTINE
MEMINT:	SKIPE INPAT
	JRST ERRINT
MINT2:	MOVEM A,IAC+1
	MOVE A,RETSAV
	MOVEM A,.JBTPC		;SETUP RETURN PC
	MOVE A,CNIWRD
	TRO A,20000		;MEM PRO VIOLATION
INT:	MOVEM A,.JBCNI		;SETUP APR CONI
	MOVE A,.JBAPR
	TLZ A,440140		;CLEAR SAME BITS AS DOES TOPS10
	HRRM A,RETSAV		;RETURN TO USER INTERRUPT ROUTINE
	MOVE A,IAC+1
	SETZM INPAT		;TURN OFF PAT UUO SIMULATOR
	DEBRK
	HALTF
INSINT:				;HERE ON ILLEGAL INSTRUCTION TRAP
	MOVEM A,IAC+A		;STASH USER AC
	SKIPN INPAT		;IN COMPATIBILITY PACKAGE?
	  JRST INSIN1		;NO
	TRZE PF,R.ILLJ		;DOING AN XJSYS COMMAND?
	  JRST INSILJ		;YES, GO RETURN ERROR CODE IN A
INSIN1:	MOVEI A,INSTRP		;DIDDLE THE DEBREAK
	EXCH A,RETSAV		;TO COME BACK AT NON-PSI LEVEL
	HRRI A,-1(A)		;DECREMENT PC
	MOVEM A,MONUPC		;STASH THE INT LOCATION
	MOVE A,IAC+A		;RESTORE THE AC
	DEBRK			;CLEAR OFF THE PSI CHANNEL
INSTRP:	MOVEM 17,ACS+17		;STASH ALL AC'S
	MOVEI 17,ACS		; ..
	BLT 17,ACS+16		; ..
	MOVE P,PATSTK		;GET A PDL STACK
	MOVE PF,PFLAGS		;AND SYSTEM FLAGS
	SETOM INPAT		;FLAG PAT STACK READY, ETC.
	TMSG <$? PA1050: ILLEGAL INSTRUCTION >
	HRRZ A,MONUPC		;WHERE IT CAME FROM
	MOVE A,(A)		;GET INSTRUCTION
	PUSHJ P,TYPINS		;GO TYPE OUT INSTRUCTION
	JRST ATUSER		;AND THE PC, THEN STOP.

INSILJ:	MOVE A,[2,,IAC+2]	;SAVE SOME ACS
	BLT A,IAC+10		;  FOR GETER WHICH USES 10 ACS
	MOVEI A,.FHSLF		;GET ERROR CODE FOR THIS FORK
	GETER
	HRRZ A,B		;LEAVE ERROR CODE IN AC A
	MOVE 10,[IAC+2,,2]	;RESTORE ACS
	BLT 10,10
	AOS RETSAV		;SKIP THE AOS 0(P) INSTRUCTION IN DOJSYS
	DEBRK			;RETURN
;ROUTINE TO HANDLE QUOTA EXCEEDED INTERRUPTS

QUOINT:	MOVEM 17,IAC+17		;SAVE ALL ACS
	MOVEI 17,IAC
	BLT 17,IAC+16
	MOVE 17,IAC+17		;(336) FIX STACK UP AGAIN
	SKIPN INPAT		;IN THE MIDDLE OF A UUO?
	JRST QUOTRP		;NO, BETTER NOT TRY TO HANDLE THIS
	MOVE A,RETSAV		;GET PC
	TLNN A,10000		;OUT OF USER MODE?
	JRST QUOTRP		;NO, THIS IS NOT GUARANTEED TO BE RECOVERABLE
	MOVEI A,.FHSLF		;GET THE ERROR CODE
	GETER
	HRRZ A,B		;ERROR CODE TO AC A
	PUSHJ P,WARN		;GO TRY TO EXPUNGE THE DELETED FILES
	 JRST QUOTRP		;DID NOT WORK
	MOVEM PF,IAC+PF		;SAVE THE UPDATED FLAGS
QUOCON:	MOVSI 17,IAC		;RESTORE THE ACS
	BLT 17,17
	DEBRK			;TRY TO CONTINUE

QUOTRP:	TMSG <$? PA1050: >
	MOVEI A,PROJFN		;TYPE OUT ERROR MESSAGE
	HRLOI B,.FHSLF		;GET LAST ERROR
	SETZ C,
	ERSTR
	 JFCL
	 JRST [	TMSG <QUOTA EXCEEDED OR DISK FULL>
		JRST .+1]
	TMSG < AT LOCATION >
	MOVEI A,PROJFN
	HRRZ B,RETSAV		;GET PC
	MOVEI C,10		;IN OCTAL
	NOUT
	 JFCL
	HALTF			;LET USER TRY TO CLEAN UP
	JRST QUOCON		;IN CASE OF A CONTINUE
IFN SAMFRK,<			;THIS ONLY WRITTEN FOR SAME FORK

CSTART:
	SKIPN INPAT		;HAVE AC'S AND STACK?
	JRST CSTNIP		;NO. NOT IN PAT.
	SETZM IOWATF		;CLEAR IOWAIT FLAG IF ON
	PUSH P,A		;STASH AN AC
	HRRZ A,RETSAV		;WHERE IS THE RETURN TO?
	CAIL A,INJSYS		;INTERRUPTABLE JSYS?
	CAIL A,INJSYE
	  JRST CSTRUN		;RUNNING A UUO, LET IT FINISH
	SETZM IOWATF		;CLEAR WAITING FLAG
	MOVE A,MONUPC		;GET ADDRESS OF UUO
	SUBI A,1		;POINT BACK AT THE UUO
	MOVEM A,.JBOPC		;STORE FOR USER
	SETZM INPAT		;SNEAK OUT THE BACK DOOR OF PAT
	PUSHJ P,CSTADR		;FIND ADDRESS OF THE START/ETC
	HRRZM A,RETSAV		;DEBREAK TO HERE
	MOVE A,TTYFRK		;MAKE SURE HIBERNATE TTY FORK IS STOPPED
	TLZE PF,L.TFA		; IS FORK ACTIVE?
	  FFORK			;YES, FREEZE IT
	SETZM CCIFLG		;CLEAR ^C INTERCEPT FLAG IF ON
	MOVSI 17,ACS		;GET THE USER'S AC'S BACK
	BLT 17,17		; ..
	DEBRK			;END OF INTERRUPT
CSTRUN:	PUSHJ P,CSTADR		;GET ADDRESS TO GO TO
	SKIPE CSTFLG		;WAS CSTFLG ALREADY SET?
	 JRST [	SKIPE CCIFLG	;ALREADY HANDLING INT?
		 JRST .+1
		PUSH P,B	;SAVE ACS
		MOVE B,RETSAV	;GET INTERRUPTED PC
		HRRZM A,RETSAV	;DEBRK TO NEW ADDR
		MOVEM B,.JBOPC	;GIVE PC TO USER
		POP P,B		;RESTORE ACS
		POP P,A
		DEBRK]		;AND GO TO NEW ADDRESS
	HRROM A,CSTFLG		;STORE IN FLAG FOR MRETN
	POP P,A			;RESTORE AC A
	DEBRK			;END OF INTERRUPT
CSTNIP:	MOVEM P,SEE		;SAVE USER AC P
	MOVE P,PSISTK		;SET UP A STACK
	PUSH P,A		;AND STASH ANOTHER AC
	PUSH P,EE		;SAVE UMOVE ACS
	PUSH P,FF
	HRRZ A,RETSAV		;WHERE WERE WE?
	CAIN A,EXITH		;DOING EXIT1? (SPECIAL CASE)
	JRST [	MOVE A,.JBOPC	;YES, .JBOPC IS CORRECT
		JRST CSTNI1]
	CAIG A,ENDFF		;IN PAT?
	CAIGE A,PATLOC		; ..
	SKIPA A,RETSAV		;NO. DEBREAK ADDRESS TO .JBOPC
	JRST [MOVE A,MONUPC	;GET ADDRESS OF UUO+1
		SOJA A,.+1]	;ADDRESS TO RETURN TO
	MOVEM A,.JBOPC		;STORE FOR USER TO SEE
CSTNI1:	PUSHJ P,CSTADR		;GET PLACE TO GO TO
	MOVEM A,RETSAV		;AND MAKE DEBRK GO THERE
	SETZM CCIFLG		;CLEAR ^C INTERCEPT FLAG IF ON
	POP P,FF
	POP P,EE
	POP P,A			;RESTORE AC'S USED
	MOVE P,SEE		; ..
	DEBRK			;AND GO TO NEW ADDRESS
CSTADR:	PUSH P,B
	SKIPE CCIFLG		;IS THIS A ^C INTERCEPT?
	  JRST CCIADR		;YES, HANDLE IT DIFFERENTLY
	PUSH P,C
	PUSH P,E
	PUSHJ P,TTBINI		;GO CLEAR TTCALL BUFFER AFTER ^C
	PUSHJ P,SETPSI		;IN CASE NOT ALL CHANNELS ON WHEN
	POP P,E
	POP P,C			; USER TYPED ^C. GET THEM BACK
	POP P,B
	MOVE A,JBREL		;RESTORE .JBREL
	UMOVEM A,.JBREL
	MOVE A,JBHRL		;AND .JBHRL
	XCTMU <HRRM A,.JBHRL>
	SKIPL A,CSTCOD		;GET THE CODE FROM EXEC
	JRST CSTAD1		;POSITIVE IS GOTO ADDR
	MOVMS A			;MAKE CODE POSITIVE
	CAILE A,CSTMCD		;OR OUT OF RANGE?
	MOVEI A,0		;YES. GO STRAIGHT TO VIROS DDT
	XCT [	MOVEI A,DDTLOC		;FORCE DDT
		HRRZ A,.JBSA		;START COMMAND
		HRRZ A,.JBREN		;REENTER COMMAND
		JRST [	HRRZ A,.JBDDT	;USER'S OWN DDT?
			TRNN A,-1	;ANYTHING THERE?
			MOVEI A,DDTLOC	;NO. USE VIROS DDT
			JRST CSTAD1]
		MOVEI A,CLSCMD
		MOVEI A,UNMCMD](A)
	TRNN A,-1		;AN ADDRESS AVAILABLE?
	MOVEI A,CSTADX		;NO.
CSTAD1:	PUSH P,A		;SAVE ADDRESS OF WHERE TO START 
	PUSH P,E		;THIS AC NEEDS SAVING IF ON INT LVL
	MOVEI A,PRIJFN		;GET TTY JFN
	MOVE E,TYSTAT		;AND STATUS WORD
	PUSHJ P,NOCTRO		;CLEAR CONTROL-O ON MON-USER XITION
	POP P,E			;RESTORE AC E
	JRST APOPJ		;RETURN WITH ADDRESS IN A

CSTADX:	TMSG <$? PA1050: NO START ADDRESS$>
	PUSHJ P,CLRALL		;CLEAR PSI AND COMPAT VECTOR
	HALTF
	PUSHJ P,SETCV		;IF CONTINUED, PUT COMP VEC BACK
	PUSHJ P,SETPSI		;AND PSI SYSTEM.
	JRSTF @.JBOPC		;IF HE CONTINUES, GO HERE.
>				;END OF IFN SAMFRK

CCIADR:	MOVE B,.JBINT		;GET INTERCEPT ARGUMENT POINTER
	SKIPE INPAT		;IN PAT?
	SKIPN INFLSR		;AND DISABLING CONTROL-C?
	  SKIPN B		;NO
	JRST [JUMPN B,CCIAD0	;YES, IF INTERCEPT ENABLED, GET ADR
		JRST CCIAD1]
CCIAD0:	SKIPN INPAT		;DELAYED TRAP?
	  MOVEM A,2(B)		;NO, STORE INTERRUPTED PC
	HRRZ A,0(B)		;PICK UP TRAP ADRESS
	SETZM INFLSR		;DISABLE FILSER FLAG SO ^C IS NOT DONE
CCIAD1:	POP P,B			;RESTORE B
	POPJ P,			;AND RETURN
;UTILITY AND ERROR ROUTINES

TMSGQ:	PUSH P,A		;DON'T CLOBBER AC'S
	PUSH P,B
	MOVE B,@-2(P)
TMSG1:	ILDB A,B
	ADDI A,40
	CAIN A,"/"
	JRST [POP P,B
		POP P,A
		JRST CPOPJ1]
	CAIN A,"$"
	JRST [MOVEI A,C.CR	;SEND OUT CR-LF
		PBOUT
		MOVEI A,C.LF	;LF
		JRST CPBOUT]
CPBOUT:	PBOUT
	JRST TMSG1

TMSGDV:	PUSHJ P,DEV67		;GET DEVICE NAME TO BE TYPED
	HRROI A,DEVNM7		;GET POINTER TO STRING
	PSOUT			;TYPE IT
	POPJ P,			;AND RETURN

WARN:	TROE PF,R.EXP		;ALREADY EXPUNGED?
	  POPJ P,		;YES, DONT DO IT AGAIN
	PUSH P,B		;SAVE AN AC
	MOVE B,TYSTAT		;GET CONTROLING TTY STATUS
	CAIN A,IOX11		;QUOTA EXCEEDED OR DISK FULL?
	JRST FULERR		;YES
	CAIN A,OPNX23		;QUOTA EXCEEDED
	 JRST QUOERR		;YES
	CAIN A,OPNX10		;NO ROOM?
	  JRST DSKFUL		;YES, TELL USER
	CAIN A,GJFX23		;DIR FULL
	  JRST DIRFUL		;YES
	POP P,B
	POPJ P,

FULERR:	TLNE B,TT.GAG!TT.BIN	;USER WANT MESSAGES?
	  JRST DIREX1		;NO JUST EXPUNGE
	TMSG <$%% PA1050: QUOTA EXCEEDED OR DISK FULL>
	JRST DIREXP		;GO EXPUNGE

QUOERR:	TLNE B,TT.GAG!TT.BIN	;USER WANT MESSAGES?
	  JRST DIREX1		;NO JUST EXPUNGE
	TMSG <$%% PA1050: QUOTA EXCEEDED>
	JRST DIREXP		;GO EXPUNGE

DSKFUL:	TLNE B,TT.GAG!TT.BIN	;USER WANT MESSAGES?
	  JRST DIREX1		;NO
	TMSG <$%% PA1050: DSK IS FULL>
	JRST DIREXP		;GO EXPUNGE

DIRFUL:	TLNE B,TT.GAG!TT.BIN	;USER WANT MESSAGES?
	  JRST DIREX1		;NO
	TMSG <$%% PA1050: DIRECTORY FULL>
DIREXP:	TMSG < - DELETED FILES BEING EXPUNGED$>
DIREX1:	SKIPN B,DIRNUM(BB)	;GET DIRECTORY OF PROBLEM FILE
	  GJINF			;GET CONNECTED DIR NUM
	SETZ A,			;NO SPECIAL FLAGS
	XJSYS <DELDF>		;EXPUNGE DIRECTORY
	  JFCL			;IGNORE ERROR RETURN
	POP P,B
	JRST CPOPJ1		;GIVE SKIP RETURN

ERRARG:	TMSG <$? PA1050: BAD ARGUMENT FOR UUO CALL.$>
	JRST ERROR2

ERRCHN:	TMSG <$? PA1050: I-O TO UNASSIGNED CHANNEL.$>
	JRST ERROR2

CORBUG:	TMSG <$? PA1050: PROGRAM TOO LARGE, COMPATIBILITY PACKAGE IS OVERLAPPED$>
	JRST TRP3

BUGSTP:	TMSG <$? PA1050: COMPATIBILITY ERROR OR UNIMPLEMENTED FUNCTION$>
	JRST ERROR1

ILLINP:	MOVE A,DEVTBL(AA)	;GET MODES
	TLNE A,2		;INPUT LEGAL?
	  JRST ILLIN1		;YES
	TMSG <$? PA1050: DEVICE >
	PUSHJ P,TMSGDV		;ADD IN DEVICE NAME
	TMSG < CANNOT DO INPUT$>
	JRST ERROR1

ILLIN1:	PUSHJ P,DOKTRP		;SEE IF USER WANTS TO TRAP ON THIS
	  JRST [PUSHJ P,ILLINM	;NO, THEN TYPE OUT MESAGE
		JRST EXITM1]	;AND HALT JOB
	HRRZ A,.JBINT		;NOW SEE IF MESSAGE SHOULD BE TYPED
	XCTUM <SKIPL 1(A)>	;CHECK BIT 0 OF INTLOC+1
	  PUSHJ P,ILLINM	;TYPE OUT MESSAGE
	JRST MRETN		;TRAP TO USER

ILLINM:	TMSG <$? PA1050: DEVICE >
	PUSHJ P,TMSGDV		;DEVICE NAME
	TMSG <: IS OFFLINE, TYPE CONTINUE WHEN DEVICE IS READY$>
	POPJ P,

ILLOUT:	MOVE A,DEVTBL(AA)	;GET MODES
	TLNE A,1		;OUTPUT LEGAL?
	 JRST ILLOU1		;YES
	TMSG <$? PA1050: DEVICE >
	PUSHJ P,TMSGDV
	TMSG <: CANNOT DO OUTPUT$>
	JRST ERROR1

ILLOU1:	PUSHJ P,DOKTRP		;SEE IF USER WANTS A TRAP
	  JRST [PUSHJ P,ILLOUM	;NO, TYPE OUT MESSAGE
		JRST EXITM1]	;AND HALT
	HRRZ A,.JBINT		;NOW SEE IF MESSAGE SHOULD BE TYPED
	XCTUM <SKIPL 1(A)>	;CHECK BIT 0 OF INTLOC+1
	  PUSHJ P,ILLOUM	;TYPE OUT MESSAGE
	JRST MRETN		;TRAP TO USER

ILLOUM:	TMSG <$? PA1050: DEVICE >
	PUSHJ P,TMSGDV
	TMSG <: IS EITHER OFF-LINE OR WRITE LOCKED, TYPE CONTINUE WHEN DEVICE IS READY$>
	POPJ P,

MDTAER:	TMSG <$? PA1050: MULTIPLE OPEN FILES ON A SINGLE DTA IS NOT SUPPORTED$>
	JRST ERROR2

CONERR:	TMSG <$? PA1050: CAN'T CONTINUE$>
	JRST EXIT2

ERROR:	TMSG <$? PA1050: ERROR IN JOB$>
	HRLI B,.FHSLF
	HRR B,A			;GET ERROR CODE TO TRANSLATE
	SETZ C,
	MOVEI A,PROJFN
	ERSTR
	JFCL
	JFCL

ERROR1:	TMSG <$COMPATIBILITY LOCATION = >
	MOVEI A,PROJFN		;GET PRIMARY OUTPUT JFN FOR ERR MESSAGE
	HRRZ B,(P)
	SUBI B,1
	MOVEI C,10
	NOUT
	JFCL
	SETZ C,
ERROR2:	TMSG <$USER LOCATION >
	JRST TRP2

ITRAP:	TMSG <$? PA1050: ADDRESS CHECK OR ILLEGAL UUO AT LOCATION >
TRP2:	HRRZ 2,PDL
	SUBI 2,1
	MOVEI 3,^D8
	MOVEI 1,PROJFN
	NOUT
	  JFCL
	TMSG <$INSTRUCTION = >
	HRRZ 2,PDL
	MOVE 1,-1(2)
	PUSHJ P,TYPINS		;TYPE OUT INSTRUCTION
TRP3:	TMSG <$>
	MOVEI 1,PRIJFN		;CLEAR TYPE AHEAD
	CFIBF			;  ON ERRORS
	TRO PF,R.FERR		;FLAG ERROR TO PREVENT SUICIDE
	JRST EXIT2		;RESTORE ACS AND HALTF

TYPINS:	PUSH P,A		;SAVE INSTRUCTION TO BE TYPED
	HLRZ B,A		;GET LH
	MOVEI A,PROJFN		;GET OUTPUT DESIGNATOR
	MOVEI C,10		;OCTAL
	NOUT
	 JFCL
	TMSG<,,>		;LH,,RH
	HRRZ B,0(P)		;GET RH
	NOUT
	  JFCL
	HLLZ B,0(P)		;GET INSTRUCTION OP CODE
	TLC B,(<JRST 4,0>)	;IS THIS A HALT?
	TLNE B,777400
	  JRST APOPJ		;NO, EXIT
	TMSG< (HALT)>		;YES, TYPE HALT
	JRST APOPJ		;AND RETURN

ERRINT:
IFN FTSTAT,<
	TLNE PF,L.LSTA		;LOCAL STATISTICS BEING DONE?
	  AOS STATLC+ST.UEI	;YES, COUNT UP UNEXPECTED INTERRUPTS
	TLNE PF,L.GSTA		;GLOBAL STATISTICS BEING DONE?
	  AOS STATGC+ST.UEI	;YES
>
	DEBRK
	HALTF
;CALL SIXBIT TABLE HERE BECAUSE RARELY USED.
DEFINE CC (A,B)
<
	SIXBIT /A/ >

MCALT:			;TABLE FOR CALL FOR NEG CALLI'S
MCALLI				;SIXBIT NAMES OF NEGATIVE CALLS
NMCAL==.-MCALT			;NUMBER OF MINUS CALLS

CALLIT:
DEFINE CC (A,B)<
IFLE .-CALLIT-MXSIXB,<
	SIXBIT /A/
>>
PCALLI				;SIXBIT TABLE OF POSITIVE CALLI'S

NPCAL==.-CALLIT			;NUMBER OF POSITIVE CALLS
ILEGAL:	PUSHJ P,ITRAP		;ILLEGAL UUO CATCHER

EXIT:	TRZ PF,R.EXIT		;ASSUME EXIT 0,
	CAIE AC,0		;MONRET AS OPPOSED TO EXIT?
	TROA PF,R.EXIT		;YES. FLAG THAT.
	PUSHJ P,IRESET		;RELEASE IF CALLI 0,12

EXIT2:	MOVE A,PDL		;CALLING PC
	MOVEM A,JOBPD1		;TO STACK
	MOVEM A,.JBOPC		;AND TO .JBOPC EARLY, SINCE WILL KILL PAT.
	SKIPE JBHRL
	PUSHJ P,MAKVES		;YES. MAY BE LOADER EXIT. MAKE HIGH VEST
	MOVE E,TYSTAT		;GET CONTROLING TTY STATUS BITS
	MOVEI A,PRIJFN		;SET UP JFN
	PUSHJ P,NOCTRO		;CLEAR CONTROL O FLAG
	RFMOD
	MOVEM B,SVMOD		;(321) save for possible CONTinue
	TRZ B,77B23+3B25+3B29	;FIELDS OF INTEREST
	TRO B,17B23+2B25+1B29	;NEW VALUES
	SFMOD			;SET THEM.
	TRNE PF,R.SUIC		;SUICIDE COMPT.?
	JRST EXIT4		;YES, TYPE NOTHING
	TRNE PF,R.EXIT!R.FERR	;EXIT OR MONRET, OR FATAL ERROR?
	JRST EXIT3		;MONRET. DON'T SAY "EXIT"
	TMSG <$EXIT$>
EXIT4:	PUSHJ P,CLRALL		;CLEAR ALL PSI ACTIVITY
	SKIPLE A,TMPJFN		;IS THE TMPCOR FILE OPEN?
	  RLJFN			;YES, CLOSE IT
	  JFCL
	SETZM TMPJFN		;CLEAR ITS JFN
	MOVEI A,SUICA-1		;STASH SOME AC'S
	PUSH A,ACS+A		;IN LOW CORE
	PUSH A,ACS+B
	PUSH A,ACS+C
	SETZM INPAT		;NOTE THAT NO LONGER HAVE A STACK
	MOVE A,[XWD ACS+D,D]	;RESTORE REST OF USER'S AC'S
	BLT A,17		; ..
	MOVE A,[XWD KSUIC,SUICID] ;MOVE THE SUICIDE CODE TO LOW CORE
	BLT A,ESUIC		; ..
	MOVE A,[JRSTF @JOBPD1]	;INSTR TO REPLACE HALTF WITH
	TRNE PF,R.SUIC		;COMMITTING SUICIDE?
	MOVEM A,SUICX		;YES, REPLACE HALTF
	TRNE PF,R.SUIC		;ALSO INCR JOBPD1 IF SUICIDE FUNCTION
	AOS JOBPD1		; TO GIVE SKIP RETURN
	MOVSI B,.FHSLF		;THIS FORK FOR PMAP
	SETO A,			;TO NONEXISTENCE
	HRRI B,PATPAG		;CLEAR STARTING AT BEGINING OF PAT
	TLNE PF,L.FLSR		;FILSER MAPPED IN?
	  HRRI B,FLSRPG		;START AT FILSER START ADR
	MOVEI C,NPATPG		;THRU END OF PAT
	TLNE PF,L.FLSR		;FILSER MAPPED IN?
	  ADDI C,PATPAG-FLSRPG	;YES, GET UPDATED COUNT
	TLO C,(1B0)		;WITH A MULTIPLE PMAP
	MOVE 0,ACS		;RESTORE USER AC 0
	JRST SUICID		;AND GO DELETE PA1050 FROM MAP
EXITM1:	SOS PDL			;BACK UP PC TO POINT TO UUO
	SOS MONUPC		;THIS TOO IN CASE DDT IS TYPED (FOR .JBOPC)
EXIT3:	MOVEI A,EXIT1		;GET ADDRESS TO CONTINUE AT
	EXCH A,PDL		;GET USERS PC
	MOVEM A,EXITPC		;SAVE IN CASE HE CONTINUES
	MOVEM A,.JBOPC		;SAVE ADR OF LAST USER PC 
	PUSHJ P,CLRCCI		;CLEAR CONTROL-C INTERCEPT
	JRST MRETN		;RESTORE AC'S AND HALT

EXIT1:	HALTF
EXITH==.			;PC OF HALTF
	MOVEM 17,ACS+17
	MOVEI 17,ACS
	BLT 17,ACS+16
	MOVE P,PATSTK		;SETUP LOCAL STACK
	MOVE B,SVMOD		;(321) get user's SFMOD for controlling TTY
	MOVEI A,PRIJFN		;(321) get JFN for controlling TTY
	SFMOD			;(321) restore user's TT%WAK, TT%ECO, TT%DAM
	HLLZ PF,PFLAGS		;FLAGS TO AC FOR PAT'S FLAGS.
	PUSH P,EXITPC		;SET UP RETURN PC
	TRNE PF,R.FERR		;FATAL ERROR?
	  PUSHJ P,CONERR	;YES, CANT CONTINUE
	PUSHJ P,SETCV		;SET COMPATIBILITY VECTOR
	PUSHJ P,SETPSI		;IF CONTINUED
	JRST MRETN		;IF CONTINUED

KSUIC:				;CODE FOR SUICIDE OF PAT

	PHASE 20			;WHERE TO MOVE IT TO

SUICID:	PMAP			;DO IT.
	MOVEI A,.FHSLF		;CLOSE ALL FILES
	CLZFF
	MOVE A,SUICA		;RESTORE LAST 3 ACS
	MOVE B,SUICB
	MOVE C,SUICC
SUICX:	HALTF			;THIS INSTR GETS REPLACED WITH JRSTF @JOBPD1
				; IF SUICIDE COMPT. UUO INVOKED
	JRST .-1
ESUIC==.-1
SUICA:	BLOCK 1
SUICB:	BLOCK 1
SUICC:	BLOCK 1

	..LPH==.-SUICID		;LENGTH OF THIS PHASE BLOCK
	PHASE KSUIC+..LPH	;RESUME OUTER PHASE BLOCK

SETNAM:	MOVE A,CAC		;SIXBIT NAME OF USER PROGRAM
	MOVEM A,LOWNAM		;SAVE THE NEW NAME FOR VERSION WATCHERS
	MOVEI A,.FHSLF		;GET PRIVILEGES
	RPCAP
	MOVE A,LOWNAM		;GET NAME AGAIN
	MOVE B,A		;GET JOB NAME TOO
	TRNN C,WHEEL!OPER	;WHEEL OR OPERATOR?
	  MOVE A,[SIXBIT/(PRIV)/] ;NO, SET SUBSYS NAME TO PRIVATE
	SETSN
	  JFCL			;IGNORE ERROR RETURN
	JRST MRETN

LOGOUT:	GJINF			;SEE IF JOB IS LOGGED IN
	JUMPN A,EXIT		;IF LOGGED IN, JUST EXIT
	MOVNI A,1		;LOG THE JOB OUT
	LGOUT
	  JRST EXIT		;FAILED, TURN INTO AN EXIT
	JRST EXIT		;SHOULD NOT GET HERE
;COPY VESTIGAL JOB DATA AREA FROM LOSEG TO HISEG

MAKVES:	LDB A,[PAGEN HSORG]	;GET VEST JDA PAGE NUMBER
	HRLI A,.FHSLF
	RPACS			;GET PAGE ACCESS
	TXNN B,PA%WT!PA%CPY	;WRITABLE?
	POPJ P,			;NO, GIVE UP NOW
	MOVSI B,-NVSTIG
	MOVE A,HSORG		;GET HISEG ORIGIN
	HRLI A,B		;CONSTRUCT INDIRECT WORD HIORG(B)
MAKVS0:	JRST @VESTG2(B)

MAKVS2:	UMOVE D,@A		;GET CURRENT VALUE
	CAMN D,C		;IF DIFERENT WE WILL CHANGE IT
	  JRST MAKVS1		;DONT CHANGE IT SINCE PAGE BECOMES PRIVATE
	UMOVEM C,@A

MAKVS1:	AOBJN B,MAKVS0
	POPJ P,

VESTG2:	[UMOVE C,.JBSA
		JRST MAKVS2]
	[UMOVE C,41
		JRST MAKVS2]
	[UMOVE C,.JBCOR
		JRST MAKVS2]
	JRST [XCTUU <HLL C,.JBHRL>
		XCTUU <HRR C,.JBREN>
		JRST MAKVS2 ]
	[UMOVE C,.JBVER
		JUMPE C,MAKVS1
		JRST MAKVS2]
IFN FTFILSER,<

;INTERFACE TO TOPS-10 FILSER ROUTINES

VIRVEC=600000			;ENTRY VECTOR FOR FILSER MODULE

	VTHRIC==0		;THRICE ENTRY
	VUUO==1			;VIRUUO ENTRY
	VMUUO==2		;MONUUO ENTRY
	VMUPC==3		;MONUPC ENTRY
	VTDAT==4		;THSDAT ENTRY
	VTIME==5		;TIME ENTRY
	VDAT==6			;DATE ENTRY
	VPPN==7			;PPN ENTRY
	VACS==10		;ACS ENTRY

TONCE:	PUSHJ P,SETVVV		;GO SET UP VIRVEC VARIABLES
	JRST @VIRVEC+VTHRIC	;CALL ONCE ONLY CODE

TOPEN:	PUSHJ P,TMAP		;SEE IF FILSER IS MAPPED
	  JRST MRETN		;COULD NOT FIND FILSER DATA BASE
	PUSHJ P,SETVVV		;GO SET UP VARIABLES
	MOVE A,[OPEN TOPNBL]	;GET OPEN INSTRUCTION
	DPB AC,[POINT 4,A,12]	;SET UP AC FIELD
	MOVEM A,@VIRVEC+VMUUO	;SET UP UUO TO BE DONE
	SETZM @VIRVEC+VMUPC	;PC IS 0
	MOVEI A,17		;MODE 17 ONLY
	MOVEM A,TOPNBL
	MOVE A,DEVNAM(BB)	;GET DEVICE TO BE OPENED
	MOVEM A,TOPNBL+1	;STORE IN OPEN BLOCK
	SETZM TOPNBL+2		;NO BUFFER HEADERS
	PUSHJ P,@VIRVEC+VUUO	;GO DO UUO
	SKIPG @VIRVEC+VMUPC	;WAS IT SUCCESFUL
	  JRST MRETN		;NO
	SETZ B,
	JRST UOPENE		;CONTINUE THE OPEN

TLKUP:	PUSHJ P,SETVVU		;GO SET UP THE VARIABLES AND UUO
	MOVSI B,IOPENF!LOOKPF	;MARK THAT IT IS OPENED
	IORM B,FLAGWD(BB)
	HRRZ G,FORTY		;GET FILE LENGTH
	UMOVE A,0(G)		;GET FIRST WORD TO SEE IF EXTENDED
	TLNN A,-1		;SIXBIT NAME?
	CAIGE A,3		;NO, GREATER THAN 3 ARGUMENTS?
	  TRZA PF,R.UEXT	;THIS IS AN OLD STYLE LOOKUP
	TRO PF,R.UEXT		;EXTENDED LOOKUP
	UMOVE A,5(G)		;GET EXTENDED LOOKUP VALUE
	TRNE PF,R.UEXT		;EXTENDED LOOKUP?
	  JRST TLKUP1		;YES
	UMOVE A,3(G)		;NO, GET # OF WORDS IN FILE
	JUMPL A,TLKUP0		;NEGATIVE?
	HLRZS A			;GET BLOCKS IN RH OF A
	ASH A,7			;THIS IS + BLOCKS
	JRST TLKUP1
TLKUP0:	HLRES A			;GET NEG WORDS
	MOVNS A
TLKUP1:	MOVEM A,IOEOFP(BB)	;STORE FILE LENGTH
	JRST MRETN		;AND RETURN

TENTER:	PUSHJ P,SETVVU		;GO DO UUO
	MOVSI A,OOPENF!ENTERF	;SET FLAGS
	IORM A,FLAGWD(BB)
	JRST MRETN		;AND RETURN

TRENME:	PUSHJ P,SETVVU		;GO DO UUO
	JRST MRETN		;AND RETURN

TCLOSE:	PUSHJ P,SETVVV		;SET UP VARIABLES
	MOVE A,IOCNT		;GET CLOSE BITS
	HRLI A,(CLOSE)		;SET UP UUO
	DPB AC,[POINT 4,A,12]	;SET UP AC FIELD
	MOVEM A,@VIRVEC+VMUUO	;SAVE UUO
	MOVE A,MONUPC
	MOVEM A,@VIRVEC+VMUPC	;SET UP PC
	PUSHJ P,@VIRVEC+VUUO	;DO THE CLOSE
	JRST UCL3		;RETURN TO THE SIMULATED CLOSE
TUSET:	JRST SETVVU		;GO DO THE UUO

TRELEA:	PUSHJ P,URELR		;GO FORCE OUT THE LAST BUFFERS
	PUSHJ P,SETVVV		;RELEASE UUO
	MOVSI A,(RELEASE)	;SET UP UUO
	DPB AC,[POINT 4,A,12]	;SET UP CHANNEL #
	MOVEM A,@VIRVEC+VMUUO
	MOVE A,MONUPC		;SET UP PC
	MOVEM A,@VIRVEC+VMUPC
	PUSHJ P,@VIRVEC+VUUO	;GO DO RELEASE
	JRST MRETN		;AND THEN RETURN

TMOVB:	MOVE A,IOEOFP(BB)	;CALCULATE # OF WORDS LEFT IN FILE
	SUB A,IOBYTP(BB)	;FOR INPUT ONLY
	TRNN PF,R.DIRN		;IS THIS INPUT
	CAML A,IOCNT		;ARE THERE ENOUGH CHARACTERS
	  MOVE A,IOCNT		;YES
	JUMPLE A,CPOPJ		;IF ZERO DONT DO ANYTHING
	ADDM A,IOBYTP(BB)	;UPDATE POINTER
	MOVN B,A		;GET NEGATIVE COUNT
	ADDM B,IOCNT		;DECREMENT IOCNT
	MOVSS B			;SET UP IOWD FOR UUO
	HRR B,IOBPT		;GET USERS BUFFER AREA
	MOVEM B,TOPNBL		;SAVE IOWD
	ADDM A,IOBPT		;UPDATE BYTE POINTER
	SETZM TOPNBL+1		;ZERO TO END IO COMMAND LIST
	MOVE A,[INPUT TOPNBL]	;GET UUO TO BE DONE
	TRNE PF,R.DIRN		;IS THIS AN OUTPUT
	  HRLI A,(OUTPUT)	;YES, CHANGE IT TO OUTPUT UUO
	DPB AC,[POINT 4,A,12]	;SET UP CHANNEL #
	MOVEM A,@VIRVEC+VMUUO	;SAVE UUO TO BE DONE
	SETZM @VIRVEC+VMUPC
	PUSH P,D		;SAVE D FOR PAT
	PUSHJ P,SETVVV		;SET UP TIME AND DATE
	POP P,D
	PUSHJ P,@VIRVEC+VUUO	;DO THE UUO
	JRST CPOPJ1


TDOUUO:	PUSHJ P,TMAP		;GO SEE IF FILSER IS MAPPED IN
	  JRST MRETN		;HAD SOME TROUBLE
	PUSHJ P,SETVU1		;GO DO THE CURRENT UUO
	JRST MRETN		;AND RETURN TO THE USER

TMAP:	SKIPE FLSJFN		;IS FILSER ALREADY MAPPED?
	  JRST TMAP2		;YES, DONT MAP IT AGAIN
	MOVE A,JBREL		;SEE IF ENOUGH CORE
	CAMG A,JBHRL		;ANY HI-SEG?
	  MOVE A,JBHRL		;YES, USE IT
	CAIL A,FLSRLC		;ROOM LEFT FOR FILSER?
	  JRST TNOCOR		;NO, GO BOMB OUT
	PUSH P,C		;SAVE C FOR OPEN
	HRROI A,STRNG1		;SET UP TO GET FILSER NAME
	MOVEI B,"<"		;SET UP DIRECTORY NAME
	BOUT
	PUSH P,A			;SAVE THE STRING POINTER
	GJINF			;GET LOGGED IN DIR
	MOVE B,A			;ADD IT TO STRING
	POP P,A			;GET BACK STRING POINTER
	DIRST			;GET DIRECTORY NAME INTO STRING
	  JFCL
	MOVEI B,">"		;TERMINATE DIR NAME
	BOUT
	MOVE B,JOB		;WITH JOB NUMBER AS FIRST THREE LETTERS
	MOVE C,[XWD 140003,12]
	NOUT			;GET ASCIZ JOB NUMBER
	  POPJ P,		;OPPS, GIVE ERROR RETURN
	HRROI B,[ASCIZ/FILSER-DATA-BASE.TMP/]
	SETZ C,			;END ON ZERO BYTE
	SOUT			;BUILD GTJFN NAME
	MOVSI A,100001		;GET OLD FILE ONLY
	HRROI B,STRNG1		;SET UP FOR GTJFN
	GTJFN
	  JRST APOPJ		;COULD NOT FIND FILSER FILE
	MOVE B,[XWD 440000,302000]
	OPENF			;OPEN FOR READ AND WRITE
	  JRST APOPJ		;ERROR RETURN
	HRRZM A,FLSJFN		;STORE THIS JFN
	HRLZS A			;NOW MAP IN FILSER
	MOVSI B,.FHSLF		;INTO THIS JOB AREA
	HRRI B,FILPAG
	MOVSI C,140000		;READ AND WRITE
	MOVEI D,FILEND		;LAST PAGE TO BE MAPPED
TMAP0:	PMAP			;MAP IN PAGE
	CAIG D,(B)		;DONE?
	  JRST TMAP1		;YES
	AOS A
	AOJA B,TMAP0		;LOOP BACK FOR REST OF PAGES
	HRRZS A,FLSJFN		;CLOSE AND RELEASE JFN
	CLOSF			;SO IT GOES AWAY ON EXIT
	JFCL
TMAP1:	POP P,C			;RESTORE C
	TLO PF,L.FLSR		;MARK THAT FILSER HAS BEEN LOADED
	MOVSI A,(CALLI)		;FAKE UP A RESET UUO
	MOVEM A,@VIRVEC+VMUUO	;TO CLEAR OUT ANY UNCLOSED FILES
	SETZM @VIRVEC+VMUPC	;USER PC IS 0
	PUSHJ P,@VIRVEC+VUUO	;DO THE RESET
TMAP2:	JRST CPOPJ1		;GIVE SKIP RETURN

TRESET:	JRST SETVU1		;GO DO THE UUO AND POPJ

SETVVU:	SETZM IOBYTP(BB)	;START AT WORD 0
	SETOM JFNTAB(BB)	;PRETEND WE HAVE A JFN
SETVU1:	PUSHJ P,SETVVV		;GO SET TIME AND DATE
	MOVE A,FORTY		;GET UUO TO DO
	MOVEM A,@VIRVEC+VMUUO	;SAVE FOR FILSER
	MOVE A,MONUPC		;GET USER PC
	MOVEM A,@VIRVEC+VMUPC
	PUSHJ P,@VIRVEC+VUUO	;GO DO UUO
	MOVE A,@VIRVEC+VMUPC	;GET NEW USER PC
	MOVEM A,PDL		;STORE FOR RETURN
	POPJ P,			;AND RETURN

SETVVV:	SETO B,			;GET DATE
	PUSHJ P,NODATE
	ANDI D,7777		;12 BITS ONLY
	DPB C,[POINT 3,D,23]	;ADD IN 3 HIGH ORDER BITS ALSO
	MOVEM D,@VIRVEC+VTDAT	;STORE FOR FILSER
	GTAD			;GET TIME AND DATE
	HRRZ B,A		;TRANSLATE TIME TO TOPS-10 FORMAT
	FLTR B,B
	FMPR B,[3.03407407]	;MAGIC NUMBER TO TURN SECONDS INTO TOPS-10 FORMAT
	FIXR B,B
	HLLZS A			;ZERO TIME PART
	ADD A,B			;ADD IN FRACTION OF A DAY
	MOVEM A,@VIRVEC+VDAT
	SETO B,			;NOW GET LOCAL TIME IN SECONDS
	SETZ D,
	ODCNV
	HRRZ A,D
	IMULI A,^D60		;CREATE JIFFIES
	MOVEM A,@VIRVEC+VTIME	;STORE FOR FILSER
	GJINF
	HRRZ A,B		;GET PPN
	PUSHJ P,PPNUNM		;UNMAP IT
	MOVEM A,@VIRVEC+VPPN	;SAVE OUR PPN
	MOVEI A,ACS		;GET USER ACS
	MOVEM A,@VIRVEC+VACS
	SETOM INFLSR		;DISABLE CONTROL-C DURING UUO
	PUSHJ P,CHKCCI		;TO KEEP DATA BASE IN TACT
	  JFCL
	POPJ P,			;AND RETURN

TNOCOR:	TMSG <$? PA1050: NOT ENOUGH CORE TO MERGE IN FILSER-DATA-BASE$>
	JRST EXITM1
;ROUTINE TO SEE IF THIS IS A TOPS-10 PACK
;CALLED WITH SIXBIT NAME IN A
;SKIP RETURNS IF TOPS-10 PACK WITH 'DPAX' IN A AND STR IN B

DPACHK:	PUSH P,A		;SAVE DEV NAME
	PUSHJ P,GETPHY
	  JRST [HLRZ A,0(P)	;NONE, SEE IF NAME WAS DPAX
		CAIE A,'DPA'
		  JRST APOPJ	;NO, RETURN
		POP P,A		;GET NAME BACK
		MOVE B,A	;PUT IT IN B ALSO
		JRST CPOPJ1]	;AND RETURN
	HLRZ B,0(P)		;SEE IF THIS IS DPAX
	CAIN B,'DPA'
	  JRST [MOVE B,A	;YES, PUT PHYSICAL NAME IN B
		POP P,A		;AND DPAX IN A
		JRST CPOPJ1]	;AND RETURN
	HLRZ B,A		;GET GENERIC NAME OF PHYSICAL NAME
	CAIE B,'DPA'		;IS THIS A TOPS-10 PACK?
	  JRST APOPJ		;NO, RETURN
	POP P,B			;YES, GET BACK ORIGINAL NAME INTO B
	JRST CPOPJ1		;AND RETURN
>
;PRODUCE <SUBSYS>'S SHARE FILE OF THIS CODE


MAKEPF:	RESET			;CLEAR THE WORLD
	MOVE P,PATSTK		;NEED A STACK HERE
	PUSHJ P,CLRALL		;MAKE SURE NO LEFTOVER INTS
	MOVEI 1,.FHSLF
	MOVE 2,[XWD EVECL,EVEC]	;EXEC WILL SCVEC FROM THIS EVEC
	SEVEC			; WHEN IT BRINGS IN PA1050 ON A UUO
	HRROI T1,[ASCIZ /
Output file: /]
	PSOUT
	MOVEI T1,[GJ%FOU+GJ%MSG+GJ%CFM
		.PRIIN,,.PRIOU
		0		;DEFAULT DEVICE
		0		;DEFAULT DIR
		-1,,[ASCIZ /PA1050/] ;DEFAULT NAME
		-1,,[ASCIZ /EXE/] ;DEFAULT EXT
		-1,,[ASCIZ /777752/] ;DEF PROTECTION
		0]		;DEFAULT ACCT
	SETZ T2,
	GTJFN
	PUSHJ P,ERROR
	MOVEM A,JFNTAB		;PRESERVE OVER TYPEOUT
	TMSG < SAVED VERSION >	;COMMENT COMPLETED
	SKIPN PVLOC
	JRST [	TMSG <0>
		JRST MAKPF0]
	MOVEI A,PROJFN
	LDB B,[POINT 9,PVLOC,11]
	MOVEI C,10
	SKIPE B
	NOUT
	 JFCL
	LDB B,[POINT 6,PVLOC,17]
	JUMPE B,MAKPF1
	MOVEI A,PROJFN
	SUBI B,1
	IDIVI B,^D26		;1 OR 2 LETTERS?
	JUMPE B,[MOVE B,C
		JRST MAKPF2]
	PUSH P,C		;SAVE SECOND LETTER
	ADDI B,"A"-1
	BOUT
	POP P,B
MAKPF2:	ADDI B,"A"
	BOUT
MAKPF1:	MOVEI A,PROJFN
	HRRZ B,PVLOC		;TYPE VERSION IN OCTAL
	JUMPE B,MAKPF3
	MOVEI B,"("
	BOUT
	HRRZ B,PVLOC
	MOVEI C,10
	SKIPE B			;DON'T PRINT 0
	NOUT			;ON TTY
	  JFCL
	MOVEI A,PROJFN
	MOVEI B,")"
	BOUT
MAKPF3:	LDB B,[POINT 3,PVLOC,2]
	JUMPE B,MAKPF0
	MOVEI A,PROJFN
	MOVEI B,"-"
	BOUT
	LDB B,[POINT 3,PVLOC,2]
	MOVEI C,10
	NOUT
	 JFCL
MAKPF0:	TMSG < AS FILE$ >
	MOVEI A,PROJFN
	HRRZ B,JFNTAB
	MOVE C,[211112,,110011]
	JFNS			;TYPE FILE NAME
	MOVE A,JFNTAB
	HRLI 1,.FHSLF		;THIS FORK,
	HLRE 2,SJBSYM	;GET LENGTH OF SYMBOL TABLE
	MOVNS 2			;POSITIVE LENGTH
	ADDI 2,ENDFF		;PLUS WHERE THEY START IS END OF SYMS.
	LSH 2,-11		;BEGINNING OF THAT PAGE
	MOVNI 2,1(2)		;-<PAGE AFTER END>
	MOVSI 2,PATPAG(2)	;(PLUS START IS -LENGTH) TO LH
	MOVEI 3,PATLOC
	LSH 3,-^D9		;FIRST PAGE
	HRRI 2,120000(3)	;WITH READ AND EXECUTE ALLOW BITS
	MOVEI C,0		;DOCUMENTED TO WANT 0 IN C
	SSAVE			;CREATE SHARE FILE
	PUSHJ P,CRLF
	HALTF
;GET 10/50 .SHR TYPE FILE

GETSHR:	RESET			;CLEAR VIROS STUFF
	CALLI 0			;'FIRST' UUO
	MOVE P,PATSTK
	SETOM INPAT
	HRROI 1,[ASCIZ /
.SHR FILE TO BE LOADED: /]
	PSOUT
	MOVSI 1,120003
	MOVE 2,[XWD PRIJFN,PROJFN]
	GTJFN
	PUSHJ P,ERROR
	MOVE 2,[XWD 440000,200000]
	OPENF
	PUSHJ P,ERROR
	MOVEI 7,.HSLOC		;HIGH SEGMENT ADDRESS
	MOVEM 7,HSORG		;DEFAULT HIGHSEG ORG
GSHR1:	BIN
	JUMPN 2,GSHR3		;IF NON-0, CAN'T BE END OF FILE
	GTSTS
	TLNE 2,1000
	JRST GSHR2
	SETZ 2,			;NOT EOF, STORE THE 0
GSHR3:	MOVEM 2,0(7)
	AOJA 7,GSHR1

GSHR2:	CLOSF
	PUSHJ P,ERROR
	MOVEI A,.HSLOC+10		;GIVE USER AT LEAST SOME HIGH SEG
	MOVEM A,JBHRL		;SO UMOVE'S WONT FAIL
	PUSHJ P,SETVES		;SETUP VESTIGAL DATA
	MOVEI 1,.FHSLF
	HRRZ 2,.JBSA
	HRLI 2,<JRST>B53	;LH SPECIFYING 10/50 ENTRY VECTOR
	SEVEC
	SETZM INPAT
	HALTF
;CREATE 10/50 SHR TYPE FILE

MAKSHR:	CALLI 0
	MOVE P,PATSTK
	SETOM INPAT
	PUSHJ P,MAKVES		;COPY JOB DATA AREA TO VESTIGAL AREA
	MOVEI A,.FHSLF
	UMOVE B,.JBSA
	HRLI B,1
	SEVEC			;SETUP ENTRR VECTOR

MAKS2:	HRROI A,[ASCIZ/
SSAV ON FILE = /]
	PSOUT
	MOVSI A,460003
	MOVE B,[XWD PRIJFN,PROJFN]
	GTJFN
	JRST MAKS2
	HRLI A,.FHSLF
	SETZ C,
	MOVE B,[XWD -300,400+520B26]
	SSAVE			;SSAVE PAGES 400 TO 677 WITH
				;READ, EXECUTE, COPY ON WRITE.
	PUSHJ P,CLRALL		;NO PI'S OR COMPATIBILITY VECTOR
	SETZM INPAT
	HALTF
;AFTER-LOADING FIXUP

LIN2:	MOVE P,PATSTK		;GET A STACK
	PUSHJ P,CLRALL		;CLEAR COMPAT VECTOR AND PSI SYSTEM
	SETO 1,
	MOVSI 2,.FHSLF
	MOVE 3,[1B0!PATPAG]	;CLEAR 0 TO PAT-1
	PMAP			;FLUSH EVERYTHING NOT IN PAT
	HALTF

	XLIST			;LITERALS
	LIT			;HIGH CORE LITERALS
	LIST

FFF0:
FFF:	BLOCK 100		;PATCH SPACE
ENDFF:				;END OF EVERYTHING, USED BY MAKEPF,LINIT

	DEPHASE

IFN SAMFRK,<
	LOC 140			;IN LOW SEGMENT FOR FIXUPS
>
;START HERE AFTER LOADING

LINIT:!	RESET			;TURN OFF PI SYSTEM
	MOVE P,[IOWD TSTKL,TSTK] ;SET UP A STACK TO USE
	MOVEI A,.FHSLF		;CLOBBER THE PSI SYSTEM
	DIR			; DISABLE SYSTEM
	CIS			;CLEAR ANYTHING PENDING
	SETO B,			;ALL ONES
	DIC			;DISABLE ALL CHANNELS
	MOVE A,[JRST COMPAT]	;SHOULD BE FIRST WORD OF PROGRAM
	CAMN A,KEVEC-PATLOC+LODORG ;IS IT?
	JRST LIN0		;YES. OK.
	HRROI A,[ASCIZ /
? LOADING ERROR
/]
	PSOUT			;SOMEONE HAS CHANGED THE LOADER!
	HALTF
LIN0:!	MOVEI B,PATPAG		;PAGE WHERE PAT LIVES
	HRLI B,.FHSLF
	SETO A,
	MOVE C,[1B0!NPATPG]	;CLEAR ALL OF PAT
	PMAP			;CLEAR AREA TO PUT CODE
	MOVE A,[XWD LODORG,PATLOC]	;READY TO BLT THE CODE
	BLT A,ENDFF		;WHERE IT SHOULD END
	MOVE A,[KEVEC,,EVEC]	;MOVE LITERAL VECTOR TO RUNNING VECTOR
	MOVEI B,EVECL(A)	;END OF RUNNING VECTOR
	BLT A,-1(B)		;SEEMS TO BE ONLY WAY TO GET TO 700000.
	HLRE A,.JBSYM		;-LENGTH OF SYM TAB
	MOVMS A			;+ LENGTH OF SYM TAB
	HRLZ B,.JBSYM		;WHERE SYMTAB NOW STARTS
	HRRI B,ENDFF		;WHERE IT WILL START
	HRRM B,.JBSYM		;UPDATE .JBSYM ITSELF
	BLT B,ENDFF(A)		;MOVE THE SYMBOLS
	MOVSI 1,(1B2+1B17)
	HRROI 2,[ASCIZ /SYS:UDDT.EXE/]
	GTJFN
	PUSHJ P,ERROR
	HRLI 1,.FHSLF
	GET			;GET DDT
	MOVE 1,.JBSYM
	MOVEM 1,@DDTLOC+1	;SETUP DDT SYMTAB PTR
	MOVEM 1,SJBSYM		;STORE AT ENTRY VECTOR+DELTA TOO
	MOVE 1,.JBUSY		;GET UNDEFINED SYMBOL TBL POINTER
	MOVEM 1,@DDTLOC+2	;STORE IT
	JRST LIN2		;COMPLETE FIXUP IN HIGH CORE

	TSTKL==10
TSTK:	BLOCK TSTKL

	END LINIT