Google
 

Trailing-Edge - PDP-10 Archives - bb-d868b-bm_tops20_v3a_2020_dist - 3a-sources/opleas.mac
There are 3 other files named opleas.mac in the archive. Click here to see a list.
;<3A.UTILITIES>OPLEAS.MAC.5, 27-Jul-78 18:33:55, EDIT BY MILLER
;CHANGE VERSION NUMBER
;<OSMAN>OPLEAS.MAC.1, 26-Apr-78 11:31:42, EDIT BY OSMAN
;PROPERLY HANDLE OPLEAS.CMD BEING UPDATED WHILE OPLEAS RUNNING
;(PROBLEM WAS AC'S BEING CLOBBERED IN TEMPTY ROUTINE)
;<4.UTILITIES>OPLEAS.MAC.3,  5-Dec-77 21:03:49, Edit by MCLEAN
;ADD RM03
;<4.UTILITIES>OPLEAS.MAC.2,  1-Oct-77 01:34:52, EDIT BY DBELL
;BEFORE ALLOCATING A DEVICE TO A JOB, MAKE SURE THAT THE USER
;HAS NOT GONE AWAY MEANWHILE.  TCO 1869.
;<4.UTILITIES>OPLEAS.MAC.1, 26-Sep-77 13:53:36, EDIT BY HELLIWELL
;<3-UTILITIES>OPLEAS.MAC.7, 23-Sep-77 19:52:18, EDIT BY HELLIWELL
;GENERALIZE TMOUNT (ADD DECTAPES)
;<3-UTILITIES>OPLEAS.MAC.6, 19-Aug-77 14:38:25, EDIT BY HURLEY
;<3-UTILITIES>OPLEAS.MAC.5, 18-Aug-77 14:29:42, EDIT BY KIRSCHEN
;FIX LUUO DEFINITIONS TO ASSEMBLE WITH NEW MACRO
;<3-UTILITIES>OPLEAS.MAC.4, 11-Aug-77 09:17:56, EDIT BY HURLEY
;MAKE OPLEAS LOOK ON SYSTEM: FOR OPLEAS.CMD
;<3-UTILITIES>OPLEAS.MAC.3, 11-May-77 11:27:01, EDIT BY OSMAN
;DON'T SET ABTFLG UNLESS CURRENT USER IS THE ^C'ER.
;<3-UTILITIES>OPLEAS.MAC.2, 11-May-77 11:04:22, EDIT BY OSMAN
;<2-UTILITIES>OPLEAS.MAC.183, 27-Dec-76 17:06:51, EDIT BY HURLEY
;<2-UTILITIES>OPLEAS.MAC.182, 18-Dec-76 17:07:54, EDIT BY OSMAN
;<2-UTILITIES>OPLEAS.MAC.181, 18-Dec-76 17:00:22, EDIT BY OSMAN
;<2-UTILITIES>OPLEAS.MAC.180, 18-Dec-76 16:56:49, EDIT BY OSMAN
;<2-UTILITIES>OPLEAS.MAC.179, 18-Dec-76 16:43:26, EDIT BY OSMAN
;<2-UTILITIES>OPLEAS.MAC.178, 18-Dec-76 16:35:23, EDIT BY OSMAN
;<2-UTILITIES>OPLEAS.MAC.176, 18-Dec-76 15:21:56, EDIT BY OSMAN
;<2-UTILITIES>OPLEAS.MAC.168,  9-Dec-76 14:32:17, EDIT BY OSMAN
;TCO 1637 - MAKE OPLEAS READ PS:[SYSTEM]OPLEAS.CMD
;<2-UTILITIES>OPLEAS.MAC.61, 12-Oct-76 11:05:22, EDIT BY OSMAN
;	TCO 1588 - IMPLEMENT IGTBL CONTAINING UNMOUNTABLE STRUCTURES
;<2-UTILITIES>OPLEAS.MAC.50, 29-Sep-76 16:40:30, EDIT BY OSMAN
;	TCO 1509 - IMPLEMENT SMOUNT AND SDISMOUNT FOR FILE STRUCTURE CONTROL
;<1B-UTILITIES>OPLEAS.MAC.16, 10-JUN-76 14:02:14, Edit by HESS
;	ALLOW OPLEASE TO RUN WITHOUT BEING ENABLED FIRST
;<1B-UTILITIES>OPLEAS.MAC.15,  7-JUN-76 13:28:57, Edit by HESS
;	TCO 1347 - ALLOW COLON AFTER DEVICE NAME (TMOUNT)
;<1B-UTILITIES>OPLEAS.MAC.14,  2-JUN-76 16:24:55, Edit by HESS
;	TCO 1337 (DEVICE OPEN BY JOB -2 BUG)
;<1B-UTILITIES>OPLEAS.MAC.13, 21-MAY-76 12:12:22, Edit by HESS
;<1B-UTILITIES>OPLEAS.MAC.12,  4-MAY-76 13:33:23, Edit by HESS
;	MACRO 50 ANOMALLY IN POINTR MACRO CALLS
;<EXEC>OPLEAS.MAC.11,  8-APR-76 11:56:33, EDIT BY HURLEY
;TCO 1244 - ADD .DIRECT .XTABM FOR MACRO 50 ASSEMBLIES
;<EXEC>OPLEAS.MAC.10, 30-MAR-76 11:35:35, Edit by HESS
;<EXEC>OPLEAS.MAC.9, 26-MAR-76 02:40:55, Edit by HESS
;<EXEC>OPLEAS.MAC.8, 26-MAR-76 00:59:48, Edit by HESS
;<EXEC>OPLEAS.MAC.7, 25-MAR-76 22:36:54, Edit by HESS
;	ADD FEATURE FOR TMOUNT FACILITY

	TITLE OPLEAS


;COPYRIGHT (C) 1976, 1977, DIGITAL EQUIPMENT CORP., MAYNARD MASS. 01754 ***

;THIS PROGRAM IS THE OPERATOR HALF OF THE PLEASE/OPLEAS PAIR OF PROGRAMS.
;EACH OPERATOR WHO WANTS TO BE AVAILABLE TO USERS RUNS A COPY OF OPLEAS,
;SPECIFYING THE OPERATOR'S ID.  USERS RUN PLEASE, SPECIFYING THE OPERATOR,
;AND THE TWO PROGRAMS TALK VIA IPCF MESSAGES.

;THE PDB'S FOR THE MESSAGES ARE SET UP IN THE USUAL WAY; I.E.,
;.IPCFL:	FLAG WORD
;.IPCFS:	SENDER'S PID
;.IPCFR:	RECEIVER'S PID
;.IPCFP:	1000,,PAGE NUMBER

;ALL MESSAGES ARE SENT IN PAGE MODE

;THE FIRST WORD OF EACH MESSAGE CONTAINS A CODE IN THE RIGHT HALF INDICATING
;THE MESSAGE TYPE.  IN A 'TEXT' MESSAGE THE LEFT HALF CONTAINS THE NUMBER OF TEXT
;MESSAGES SENT.  IN A 'BYE' MESSAGE THE LEFT HALF CONTAINS THE NUMBER THAT WAS
;IN THE FIRST WORD OF THE LAST TEXT MESSAGE RECEIVED.  ALL OTHER MESSAGES
;HAVE ZERO IN THE LEFT HALF OF THE FIRST WORD

;THE CONTENTS OF THE REMAINING WORDS OF A MESSAGE VARY WITH THE MESSAGE TYPE.
	SUBTTL DATA DEFINITION

	SEARCH MONSYM,MACSYM	;HAS JSYS DEFINITIONS, BITS, ETC.
	SEARCH COMSYM		;COMMUNICATION SYMBOLS
	.REQUIRE SYS:MACREL.REL ;HAS JSERR
SALL
	IFNDEF .PSECT,<
	.DIRECT .XTABM>

;MACRO TO RESET, HALT, RESTART IF USER CONTINUES.
;RESET PREVENTS INTERRUPT ON MESSAGES SENT TO OLD PID BEFORE
;RESET AT START IS EXECUTED

	DEFINE QUIT1
	<JRST [	RESET
		HALTF
		JRST START2]>
;REGISTER USAGE

;PRIMARY USAGE - CARRIED OVER SUBROUTINE CALLS

;P1/ ADDRESS OF RECEIVE PDB
;P2/ ADDRESS OF SEND PDB
;P3/ ADDRESS OF SEND MESSAGE
;P4/ SIZE OF SEND MESSAGE
;Q1/ FLAG WORD RECEIVED
;Q2/ SENDER'S PID
;Q3/TRANSFER ADDRESS

; TEMPORARY USAGE

;P5/ ASSORTED TEMPORARY VALUES
;P6/DITTO
;REGISTERS FROM ABOVE USED AS LOCAL TEMPORARY VALUES
;T1-T4 USED FOR TEMPORARY VALUES

;AC DEFINITIONS

F=0

A=1
B=2
C=3
D=4			;A,B,C,D OR T1,T2,T3,T4 ARE AC'S 1-4

T1=1
T2=2
T3=3
T4=4
Q1=5
Q2=6
Q3=7
P1=10
P2=11
P3=12
P4=13
P5=14
P6=15
P=17

;DEBUG SWITCH - 1 IF WANT EXTRA PRINTING.  ALL DEBUG PRINTING PRECEDED BY 'D:'

DEBUG:	0

;MASKS FOR FLAG WORD RECEIVED (FIRST WORD IN PDB)

	MSKSTR(ERROR,,IP%CFE)	;ERROR FIELD IN FLAG WORD
	MSKSTR(SYSTEM,,IP%CFC)	;SYSTEM SEND FIELD IN FLAG WORD

;STACK

STKINI:	MOVE P,[IOWD STKSIZ,STK];STACK INITIALIZATION INSTRUCTION
STKSIZ==500
STK:	BLOCK STKSIZ

;REGISTER SAVE AREA. REGISTERS ARE STORED IN ORDER IN INTERRUPT ROUTINES

REGSAV:	BLOCK 17
UUOACS:	BLOCK 17		;SAVED AC'S DURING UUOS


;UUO DEFINITIONS

DEFINE UUODEF(NAME,VALUE)
<
OPDEF NAME [<VALUE>B8]
>

UUODEF UTYPE,1			;TYPE STRING
UUODEF UERROR,2			;FATAL ERROR
UUODEF UWARN,3			;WARNING ERROR

DEFINE TYPE(TEXT)
<
	UTYPE [ASCIZ \TEXT\]
>

DEFINE WARN(TEXT)
<
	UWARN [ASCIZ \TEXT\]
>
DEFINE ERROR(TEXT)
<
	UERROR [ASCIZ \TEXT\]
>
;(SEE "UUOH" FOR UUO HANDLER)

FREESP:	BLOCK 100		;SOME FREE SPACE FOR STRING CREATION, ETC.

;ENTRY VECTOR

PRGVER==3			;VERSION NUMBER
PRGEDT==12			;EDIT NUMBER
PRGMIN==1			;MINOR VERSION
PRGCST==0			;CUSTOMER ID

ENTVEC:	JRST START		;START ADDRESS
	JRST START2		;REENTER ADDRESS
	PRGCST_^D33+PRGVER_^D24+PRGMIN_^D18+PRGEDT


;TRANSFER VECTOR BASED ON CODE RECEIVED
DEFINE TX(ADDRES,CODE)
<
IFG CODE-%%MAX,<%%MAX==CODE>
RELOC GOTAB+CODE
	ADDRES
RELOC GOTAB+%%MAX+1
>
%%MAX==0			;FINAL VALUE IS ONE LESS THAN LENGTH OF TABLE

GOTAB:	TX ONEWAY,PLONE		;PLONE HAS BEEN RECEIVED
	TX QUEST,PLQUES		;PLQUES HAS BEEN RECEIVED
	TX HELLO,PLHEL		;PLHEL HAS BEEN RECEIVED
	TX BYE,PLBYE		;PLBYE HAS BEEN RECEIVED
	TX ABORT,PLABRT		;USER WANTS TO ABORT COMMAND (TYPED ^C)
	TX TEXT,PLTXT		;PLTXT HAS BEEN RECEIVED
   TMNT,<
	TX XHELLO,THELLO		;EXEC WANTS MOUNT SERVICE
	TX XMOUNT,TMOUN		;MOUNT INFO MESSAGE
   >;TMNT
	SMNT,<
	TX SREMOV,SRINFO	;EXEC WANTS A STRUCTURE TO BE REMOVED
	TX SMELLO,SHELLO	;EXEC WANTS SMOUNT SERVICE
	TX SMOUNT,SMINFO	;EXEC IS SENDING SMOUNT INFO
	TX MDONE,SMDONE		;EXEC SUCCEEDED IN INCREMENTING MOUNT COUNT
>;SMNT
	TX LSTADD,SIGNOR	;EXEC WANTS TO CAUSE A STRUCTURE TO BE IGNORED
	TX LSTDEL,SACKN		;EXEC WANTS TO MAKE STRUCTURE MOUNTABLE AGAIN
TABSIZ=.-GOTAB

;BUFFER THAT HOLDS TEXT SENT BY USER

TXTBUF:	BLOCK 1000
BUFEND:
BUFNXT:	XWD -1,TXTBUF		;NEXT LOCATION TO WRITE INTO

IPAGE:	0			;GETS IPCF PAGE NUMBER FOR MESSAGES
IPAGEX:	0			;GETS IPCF ADDRESS FOR MESSAGES
MESSAG:	BLOCK 1777		;IPCF MESSAGE STARTS SOMEWHERE IN HERE

;MESSAGE AREA FOR RECEIVE

;PDB

RMSGSZ=	1000
RPDB:	IP%CFB!IP%TTL!IP%CFV	;DON'T BLOCK; TRUNCATE; PAGE MODE
	block 1			;sender's pid
	BLOCK 1			;receiver's pid
	XWD RMSGSZ,RMSG	;message length,,page
	BLOCK 3			;DIRECTORIES AND PRIVILEGES
RPDBSZ=.-RPDB

IPDB:	BLOCK RPDBSZ		;REAL PDB USED FOR SENDS AND RECEIVES

;MESSAGE

RMSG:	BLOCK RMSGSZ		;MESSAGE AREA


;MESSAGE AREA FOR SEND at interrupt level

SMSGSZ=1000
SPDB:	IP%CFV			;PAGE MODE
	block 1			;SENDER'S PID
	BLOCK 1			;RECEIVER'S PID
	XWD SMSGSZ,SMSG	;MESSAGE LENGTH,,page
SPDBSZ=.-SPDB

;MESSAGE

SMSG:	BLOCK SMSGSZ		;MESSAGE AREA

;PDB

;message area for send at NON-INTerrupt level

;PDB

OMSGSZ=1000
OPDB:	IP%CFV			;PAGE MODE
	block 1			;SENDER'S PID
	block 1			;RECEIVER'S PID
	XWD OMSGSZ,OMSG	;MESSAGE LENGTH,,page NUMBER
OPDBSZ=.-OPDB

;MESSAGE

OMSG:	BLOCK OMSGSZ		;MESSAGE AREA

;THIS AREA CONTAINS THE NAME SENT TO INFO.  INITIALLY IT CONTAINS
;<OPERATOR>OPLEAS.  THE OPERATOR ID IS READ AND CONCATENATED TO THIS
;INITIAL STRING AND SENT TO <SYSTEM>INFO AS AN IDENTIFIER FOR THIS COPY
;OF OPLEAS.  

LINESZ=775			;WORDS AVAILABLE AFTER NAME BEFORE ID ADDED
namlen=21			;LENGTH OF NAME BEFORE ID ADDED
NAMSIZ:	block 1			;SIZE OF NAME SENT TO INFO
				;INCLUDES ID TYPED BY USER

;KEEP THIS BLOCK TOGETHER

MYNAME:	ASCIZ	/<OPERATOR>OPLEAS/
	BLOCK LINESZ-1		;SPACE FOR REST OF NAME


;THE FOLLOWING VALUE IS FIXED

INISIZ=<LINESZ*5>-2		;BYTES AVAILABLE AFTER NAME BEFORE ID ADDED

;THE FOLLOWING IS UPDATED AFTER THE ID IS READ.

inibeg:	block 1			;pointer to FIRST BYTE AFTER NAME

;VARIABLES USED WHILE READING FIRST LINE

JOBNAM:	ASCIZ/OPLEAS/		;OUR PROGRAM NAME
IDFLG:	0			;SET WHEN OPERATOR ID FOUND
CHCNT: 	0			;NUMBER OF NON-PUNCTUATION CHARS PROCESSED
BYTCNT:	0			;NUMBER OF BYTES PROCESSED

;PIDS

MYPID:	0			;OPLEAS'S PID
CURPID:	0			;PID CURRENTLY TALKING TO
   TMNT,<

;TMOUNT STORAGE

TMF:	0			;-1 IF TMOUNT REQUEST IN PROGRESS
TMIND:	0			;DEVICE INDEX
DEVNAM:	0			;TABLE PNTR FOR DEVICE NAMES
DEVCHR:	0			;TABLE PNTR FOR DEVICE CHARS.
DEVUNT:	0			;TABLE PNTR FOR UNIT NUMBERS

DEFINE	TYPES<
MNTMAC	.DVMTA,magtape,MTA
MNTMAC	.DVDTA,dectape,DTA
>

;DEVICE TYPE TABLE
DEFINE	MNTMAC(A,B,C)
<	A
>

TMTYP:	TYPES
TMLEN==.-TMTYP

;DEVICE DESCRIPTION NAME
DEFINE	MNTMAC(A,B,C)
<	[ASCIZ \B\]
>

TMNAM:	TYPES

;DEVICE MNEMONIC
DEFINE	MNTMAC(A,B,C)
<	ASCII \C\
>

TMMN:	TYPES
   >;TMNT

   SMNT,<

;SMOUNT STORAGE

UNITS==10			;LARGEST NUMBER OF UNITS WE CAN HANDLE
CHNS==10			;LARGEST NUMBER OF CHANNELS WE UNDERSTAND
.BADCD==123456			;A DEVICE CODE WE DON'T EVER EXPECT

DEVTYP:				;TABLE OF STRUCTURE TYPES WE UNDERSTAND

	[ASCIZ /RP04/],,.MSRP4
	[ASCIZ /RP05/],,.MSRP5
	[ASCIZ /RP06/],,.MSRP6
	[ASCIZ /RM03/],,.MSRM3
BADDEV:	[ASCIZ /?UNKNOWN DEVICE/],,.BADCD

DEVS==.-DEVTYP			;NUMBER OF KINDS OF STRUCTURES WE UNDERSTAND

MAXPKS==DEVS*UNITS*CHNS		;LARGEST NUMBER OF DISK PACKS WE CAN HANDLE
NOOPGU==^D10			;NUMBER OF MINUTES TO WAIT BEFORE GIVING
				;UP DURING AN SMOUNT REQUEST WHEN NO
				;OPERATOR IS IN ATTENDANCE
SCANT==^D3			;SECONDS BETWEEN SCANS OF DRIVES TO CHECK
				;FOR STRUCTURE COMING ON LINE
ANNOYT==^D5			;MINUTES TO WAIT BEFORE REMINDING THE
				;OPERATOR THAT AN SMOUNT REQUEST IS PENDING

DEFINE TABLE(NAME)
<
NAME:
%%MAX==0
DEFINE Y(ITEM,MONNAM)
<
ITEM=NAME+MONNAM
IFGE MONNAM-%%MAX,
<
%%MAX==MONNAM+1
>
>

DEFINE TABEND(LENGTH)
<
RELOC NAME+%%MAX
LENGTH==.-NAME
>
>


TABLE RNUBLK			;BLOCK FOR READING STATUS OF DISK DRIVE

Y RNUCHN,.MSRCH			;CHANNEL NUMBER
Y RNUUNT,.MSRUN			;UNIT NUMBER
Y RNUCON,.MSRCT			;CONTROLLER NUMBER
Y RNUSTA,.MSRST			;STATUS
Y RNUALS,.MSRSA			;STRUCTURE ALIAS
Y RNUNAM,.MSRSN			;STRUCTURE NAME
Y RNUNUM,.MSRNS			;UNIT OF STRUCTURE,, TOTAL UNITS IN STRUCTURE
TABEND RNULEN

;STRNLN*5-1 IS MAXIMUM NUMBER OF CHARACTERS ALLOWED IN A STRUCTURE NAME STRING(DEFINED IN COMSYM)
SMABLK:	BLOCK STRNLN		;SMOUNT ALIAS REQUEST
SMSBLK:	BLOCK STRNLN		;SMOUNT PHYSICAL REQUEST
ALSBLK:	BLOCK STRNLN		;HOLDS ALIAS NAME STRING FOR JSYS'S
NAMBLK:	BLOCK STRNLN		;PHYSICAL NAME STRING FOR JSYS'S

TABLE MNTBLK			;BLOCK FOR THE MOUNT JSYS (MSTR)

Y MNTNAM,.MSTNM			;NAME OF STRUCTURE
Y MNTALS,.MSTAL			;ALIAS
Y MNTNUM,.MSTNU			;NUMBER OF UNITS IN STRUCTURE
Y MNTTBL,.MSTUI			;TABLE OF INFO FOR EACH PACK IN STRUCTURE
	UNTLEN==.MSTNO		;NUMBER OF WORDS PER PACK OF INFO IN THIS SUBTABLE
	MTLEN==UNTLEN*MAXPKS	;ALLOW ROOM FOR ONE HUMUNGOUS STRUCTURE
Y MTBEND,.MSTUI+MTLEN-1		;LEAVE ROOM FOR ENTIRE SUBTABLE
TABEND MNTLEN

TABLE GSSBLK			;BLOCK FOR GETTING STRUCTURE STATUS

Y GSSALS,.MSGSN			;ALIAS
Y GSSSID,.MSGSI			;STRUCTURE ID
Y GSSSTA,.MSGST			;STRUCTURE STATUS
Y GSSMC,.MSGMC			;MOUNT COUNT
Y GSSOFC,.MSGFC			;OPEN FILE COUNT
TABEND GSSLEN

TABLE GSUBLK			;BLOCK FOR GETTING STRUCTURE USERS

Y GSUALS,.MSUAL			;ALIAS
Y GSUFLG,.MSUFL			;FLAGS,,NUMBER OF ITEMS RETURNED
Y GSULST,.MSUJ1			;BEGINNING OF JOB LIST
GSUJLN==200			;NUMBER OF JOBS THAT CAN FIT IN LIST
Y GSUEND,.MSUJ1+GSUJLN-1	;LEAVE ROOM FOR JOB LIST
TABEND GSULEN

TABLE SSSBLK			;BLOCK FOR SETTING STRUCTURE STATUS

Y SSSALS,.MSSSN			;ALIAS
Y SSSMSK,.MSSMW			;MASK OF BITS TO CHANGE
Y SSSSTA,.MSSST			;NEW VALUES FOR BITS
TABEND SSSLEN

DISALS:	0			;ALIAS OF STRUCTURE BEING DISMOUNTED

DTABLN==MAXPKS			;DRIVE TABLE LENGTH, ONE WORD PER DRIVE
DRV%NA==MS%MNT			;BIT IN DRIVE TABLE MEANING DRIVE UNAVAILABLE

DRVTAB:	BLOCK DTABLN		;DRIVE TABLE
ODRVTB:	BLOCK DTABLN		;OLD DRIVE TABLE, SO PRINTOUT ONLY SHOWS CHANGES

SALIAS:	0			;ALIAS OF STRUCTURE BEING MOUNTED(POINTER THERETO)
STRNAM:	0			;PHYSICAL NAME OF STRUCTURE BEING MOUNTED

;DATA RECEIVED FROM EXEC

RNAMES==RMSG+.NAMES		;LOCATION WHERE NAMES BEGIN
RFLAGS==RMSG+.FLAGS		;LOCATION WHERE CONTROL FLAGS ARE PASSED

NOFLG:	0			;-1 IF WAITING FOR OPERATOR'S REJECTION REASON
SMF:	0			;-1 IF WAITING FOR REQUESTED STRUCTURE TO APPEAR
SMEDSP:	0			;IF NON-0, IS SMOUNT ERROR DISPATCH ADDRESS
SMDIR:	0			;CONNECTED DIR OF SMOUNTER
RMF:	0			;-1 IF WAITING FOR A STRUCTURE TO BE REMOVED
SMFLGS:	0			;SMOUNT FLAGS SENT BY EXEC
TYPNAM:	0			;POINTER TO ASCII NAME OF DEVICE TYPE (LIKE "RP05")
LSTOPR:	0			;SHOWS WHEN THE OPERATOR WAS LAST PRESENT
LASTL:	0			;SHOWS WHEN AVAILABLE DRIVE LIST WAS LAST PRINTED
	>;SMNT
;MAXIMUM MESSAGE SIZE FOR THIS INSTALLATION

MAXMSG:	BLOCK 1			;DETERMINED DURING INITIALIZATION WITH MUTIL

;ASSOCIATED VARIABLE FOR NEXT MESSAGE IN  IPCF QUEUE

NXTMSG:	BLOCK 1			;0 IF THERE WAS NO MESSAGE WAITING
				; AFTER THE LAST RECEIVE


;**** COMMAND INPUT STORAGE AREA

COMNAM:	ASCIZ /SYSTEM:OPLEAS.CMD/	;NAME OF COMMANDS FILE

COMTBL:	COMLEN,,COMLEN		;LIST OF LEGAL COMMANDS
	[ASCIZ /DOMESTIC/],,DOMSTR	;ALLOW STRUCTURE TO BE MOUNTED DOMESTIC
COMLEN==.-COMTBL-1		;NUMBER OF COMMANDS IN TABLE(NOT CHANGED DYNAMICALLY)

COMJFN:	0			;HOLDS HANDLE (JFN) ON COMMANDS FILE
STAMP:	0			;LAST KNOWN WRITE-TIME OF COMMANDS FILE
ATMLEN==100			;LENGTH OF ATOM BUFFER
SAVEDP:	0			;USED TO SAVE STACK POINTER FOR REPARSES
ATMBUF:	BLOCK ATMLEN		;ATOM BUFFER (LAST FIELD READ BY COMND JSYS
CINLEN==100			;LENGTH OF INPUT BUFFER FOR COMND
CINBUF:	BLOCK CINLEN
CMFNP==FBLOCK+.CMFNP
CMDAT==FBLOCK+.CMDAT
CMHLP==FBLOCK+.CMHLP
CMDEF==FBLOCK+.CMDEF
CMFLG==SBLOCK+.CMFLG
CMIOJ==SBLOCK+.CMIOJ
CMRTY==SBLOCK+.CMRTY
CMBFP==SBLOCK+.CMBFP
CMPTR==SBLOCK+.CMPTR
CMCNT==SBLOCK+.CMCNT
CMINC==SBLOCK+.CMINC
CMABP==SBLOCK+.CMABP
CMABC==SBLOCK+.CMABC
CMGJB==SBLOCK+.CMGJB
CMKEY==<.CMKEY>B8
CMNOI==<.CMNOI>B8
CMCFM==<.CMCFM>B8
CMFLD==<.CMFLD>B8
FBLOCK:	BLOCK 4			;FUNCTION BLOCK FOR COMND JSYS
SBLOCK:	BLOCK 12		;STATE BLOCK
;ARGUMENT BLOCK FOR MUTIL

MUTILD:	BLOCK 10		

;FLAGS TO INDICATE STATE

PIFLG:	0			;-1 IFF INTERRUPTS ARE ON
INTFLG:	0			;SET WHEN INTERRUPT PROCESSED
WTFLG:	0			;SET WHEN WAITING FOR AN INTERRUPT
WRKFLG:	0			;-1 IF SMOUNT OR SREMOVE MUST REALLY WAIT FOR SOMETHING
SILNTF:	0			;-1 TO PREVENT TYPEOUT OF LOGOFF MESSAGE
ansflg:	0			;set when waiting for answer to 'ok'

;FLAGS SET BASED ON MESSAGES RECEIVED

ABTFLG:	0			;-1 IF SOMEONE ABORTS COMMAND
BYEFLG:	0			;SOMEONE WANTS TO SAY GOODBYE
				; BIT 0 SET IF USER SAYS GOODBYE
				;BIT 1 SET IF OPERATOR SAYS GOODBYE
TXTFLG:	0			;TEXT FROM USER WAITING IN BUFFER

;FLAG SET WHEN TERMINATE READ BEFORE OPERATOR TYPES TERMINATOR

RDFLG:	0			;SET WHEN RDTTY RETURNS RD%BTM NOT SET

;COUNT OF TEXT MESSAGES SENT AND RECEIVED

SNDCNT:	0			;NUMBER OF MESSAGES SENT BY OPLEAS
RCVCNT:	0			;NUMBER OF LAST MESSAGE RECEIVED BY OPLEAS
TXTCNT:	0			;NUMBER OF LAST MESSAGE RECEIVED BY PLEASE

;INTERRUPT SYSTEM

; [LEVEL,,INTERRUPT ADDRESS]
;MACRO FOR FILLING CHANNEL TABLE:

DEFINE INT(CHANNEL,LEVEL,ROUTINE)<
RELOC CHNTAB+CHANNEL
	LEVEL,,ROUTINE
>

CHNTAB:	INT 0,2,IPCINT		;IPCF ON CHANNEL 0
	INT 1,2,TINT		;^T ON CHANNEL 1
	INT 2,2,CINT		;^C ON CHANNEL 2
	INT 3,2,TYPINT		;INPUT BUFFER NON-EMPTY ON 3
	INT .ICPOV,1,ILL	;PUSHDOWN OVERFLOW SAME AS ILLEGAL INSTRUCTION
	INT .ICILI,1,ILL	;ILLEGAL INSTRUCTION, LEVEL 1, ROUTINE AT "ILL"
RELOC CHNTAB+6*6		;LEAVE ROOM FOR 36 CHANNELS

; [LOCATION WHERE PC STORED BY LEVEL]

LEVTAB:	PCSAV1			;LEVEL 1 PC STORAGE
	PCSAV2			;LEVEL 2 PC STORAGE
	PCSAV3			;LEVEL 3 PC STORAGE

;PC'S SAVED HERE

;****** THESE PC WORDS MUST REMAIN IN ORDER CONTIGUOUSLY
PCSAV1:	BLOCK 1			;LEVEL 1 PC STORAGE
PCSAV2:	BLOCK 1			;LEVEL 2 PC STORAGE 
PCSAV3:	BLOCK 1			;LEVEL 3 PC STORAGE
;******

;INTERNAL QUEUE FOR WAITING USERS

QUESIZ=40			;MAXIMUM NUMBER WAITING (INCLUDES ONE-WAY)
QUEBEG:	BLOCK QUESIZ-1		;QUEUE AREA - CONTAINS PID OR PAGE OF
QUEFIN:	BLOCK 1			; ONEWAY
NXTADD:	QUEBEG			;NEXT LOCATION TO ADD TO
NXTREM:	QUEBEG			;NEXT LOCATION TO REMOVE FROM
QUECNT:	0			;CURRENT NUMBER OF ENTRIES IN QUEUE

;ENABLED CAPABILITIES BEFORE ENABLING EVERYTHING

CAPAB:	BLOCK 1

;LOCATIONS FOR TIMING OUT USER AFTER 'OK' IS SENT

dtime:	0			;TIME TO  GIVE UP
DELAY:	^D60000			;ONE MINUTE IN MILLISECONDS

;BUFFER FOR USER ID INFO - LINE NUMBER, DIRECTORY

USRSIZ=12
USER:	BLOCK USRSIZ

;CHARACTERS USED IN ANSWERING QUESTION ON CTRL/C INTERRUPT

UPPY=131			;UPPER CASE Y
LOWY=171			;LOWER CASE Y
UPPN=116			;UPPER CASE N
LOWN=156			;LOWER CASE N

;UNDETECTABLE STRUCTURE TABLE
;STRUCTURE NAMES IN THIS TABLE ARE UNDETECTABLE BY OPLEAS AS BEING
;ON-LINE, EVEN THOUGH THEY MAY BE SITTING ON SOME DRIVES

IGTLEN==50			;MAXIMUM LENGTH OF TABLE
IGTBL:	BLOCK IGTLEN+1		;LEAVE ROOM FOR HEADER WORD

;TABLE OF STRUCTURES WHICH ARE ALLOWED TO BE MOUNTED DOMESTICALLY

DOMLEN==1000			;ALLOW THIS MANY OR SO
DOMINI:	DOMLEN			;LENGTH,,MAX (INITIAL SETTING)
DOMTBL:	BLOCK DOMLEN+1		;LEAVE ROOM FOR STRUCTURES

;STORAGE SPACE FOR STRINGS, PLEASE SEE "GETMEM" ROUTINE

STRSIZ==3000			;TOTAL NUMBER OF WORDS OF STORAGE AVAILABLE
STRBUF:	BLOCK STRSIZ		;THE STRING STORAGE ITSELF
DICT:	0			;WORD NEEDED BY FREE STRING SPACE MANAGER

;free space for oneway messages

NPAGES==50			;NUMBER OF PAGES FOR ONEWAY MESSAGES
nxtpag:	0			;first available page (first location)
ONEBUF:	BLOCK 1000+NPAGES*1000	;LEAVE ROOM FOR ONEWAY PAGES
lstpag:	0			;indicates end of free space
	SUBTTL INITIALIZATION

; HERE IF RESTARTING AFTER ERROR.  INPUT WILL COME FROM ANSWERS TO QUESTIONS
;AND NOT FROM THE EXEC VIA RSCAN.

START2:	TYPE <%_[Restarting]%_>
	movei t1,.priin		;t1/primary input
	cfibf			;clear input buffer (discard erroNEOus text)
	HRROI T1,T2		;POINT TO INTERNAL AREA
	SETZ T2,		;CLEAR IT
	RSCAN			;PUT NULL IN RESCAN BUFFER SO
				; RSCAN WILL RETURN NO CHARACTERS
	 JSERR			;CATCH ERROR

;HERE ON NORMAL START

START:	RESET			;GET RID OF PIDS, CLEAR INTERRUPTS, ETC.
	MOVE A,[CALL UUOH]	;UUO HANDLER INVOKER
	MOVEM A,41
	XCT STKINI		;SET UP STACK
	CALL ENBCAP		;ENABLE CAPABILITES
	MOVEI T1,777+MESSAG	;GET AN ADDRESS WITHIN MESSAGE AREA
	ANDI T1,777000		;MESSAGE MUST START ON PAGE BOUNDARY
	MOVEM T1,IPAGEX		;MESSAGE ADDRESS
	LSH T1,-9		;MAKE PAGE NUMBER
	MOVEM T1,IPAGE		;REMEMBER FOR IPCF
	MOVEI A,RMSG
	HRRM A,RPDB+.IPCFP	;SET UP MESSAGE ADDRESSES
	MOVEI A,OMSG		;BECAUSE PROGRAM MAY HAVE BEEN HALTED
	HRRM A,OPDB+.IPCFP	;BEFORE "SNDMSG" FIXED THEM
	MOVEI A,SMSG
	HRRM A,SPDB+.IPCFP

;CLEAR VARIOUS LOCATIONS (SEE DATA DEFINITION FOR EXPLANATIONS)

   SMNT,<
	SETZM SMF
	SETZM RMF
>;SMNT
  TMNT,<
	SETZM TMF
   >;TMNT
	SETZM MYPID
	SETZM CURPID
	SETZM WTFLG
	SETZM INTFLG
	SETZM TXTFLG
	SETZM ABTFLG		;CLEAR THE "ABORT" FLAG
	SETZM BYEFLG
	SETZM ANSFLG
	SETZM STAMP		;MAKE SURE COMMANDS FILE GETS READ THE FIRST TIME
	SETZM NXTMSG
	SETZM PCSAV1
	SETZM IDFLG		
	SETZM CHCNT
	SETZM BYTCNT
	SETZM PIFLG		;INTERRUPTS INITIALLY OFF
	SETZM SNDCNT		
	SETZM RCVCNT
	SETZM TXTCNT
	SETZM DTIME
	SETZM QUECNT
	SETZM DICT		;INITIALIZE FREE SPACE SYSTEM
	MOVEI A,STRSIZ		;FREE UP THIS MUCH FREE SPACE (ALL OF IT!)
	MOVEI B,STRBUF		;STARTS AT ADDRESS IN B
	CALL RETMEM		;FREE IT UP IN STANDARD WAY
	MOVEI A,DOMLEN		;INITIALIZE DOMESTIC STRUCTURES TABLE
	MOVEM A,DOMTBL
	MOVEI A,IGTLEN		;GET MAXIMUM LENGTH OF UNDETECTABLE STRUCTURE TABLE
	MOVEM A,IGTBL		;INITIALIZE UNDETECTABLE STRUCTURE TABLE TO 0 ENTRIES

   TMNT,<
	MOVE T1,[SIXBIT "DEVNAM"]
	SYSGT			;INIT TABLE PNTR
	MOVEM T2,DEVNAM
	MOVE T1,[SIXBIT "DEVCHR"]
	SYSGT			;INIT TABLE PNTR
	MOVEM T2,DEVCHR
	MOVE T1,[SIXBIT "DEVUNT"]
	SYSGT			;INIT TABLE PNTR
	MOVEM T2,DEVUNT
   >;TMNT

	call clrtxt		;clear buffer area for received text

;SET UP BUFFER FOR OPERATOR ID. INITIALIZE TO ASSUME BLANK ID.

	MOVE T1,[ASCII /SE/]	;RESTORE NULLS TO BYTES AFTER 'OPLEAS'
	MOVEM T1,MYNAME+3
	MOVE T1,[MYNAME+4,,MYNAME+5] ;CLEAR REMAINING WORDS
	SETZM MYNAME+4
	BLT T1,MYNAME+LINESZ+2
	MOVE T1,[POINT 7,MYNAME+3,13] ;POINT TO LAST BYTE OF
	MOVEM T1,INIBEG		;NAME SENT TO INFO
	MOVEI T1,namlen		;SIZE OF NAMES SENT TO INFO
	MOVEM T1,NAMSIZ		;INITIALIZE TO ASSUME NULL ID

;SET UP QUEUE AREA

	MOVEI T1,QUEBEG
	MOVEM T1,NXTADD
	MOVEM T1,NXTREM
	MOVEI T1,ONEBUF+777	;GET ADDRESS WITHIN FIRST PAGE OF ONEWAY BUFFER
	ANDI T1,777000		;GET ADDRESS OF BEGINNING OF THAT PAGE
	MOVEM T1,NXTPAG		;REMEMBER BEGINNING OF BUFFER
	ADDI T1,<NPAGES-1>*1000	;GET ADDRESS OF BEGINNING OF LAST PAGE IN BUFFER
	MOVEM T1,LSTPAG		;REMEMBER

;FIND OUT MAXIMUM MESSAGE SIZE - USED WHEN RECEIVING IN NON-PAGE MODE

	MOVEI T1,26		;CODE:FIND MAX MESSAGE
	MOVEM T1,MUTILD		;TO MUTIL AREA
	MOVEI T1,2		;T1/SIZE OF MUTIL AREA
	MOVEI T2,MUTILD		;T2/LOCATION OF MUTIL AREA
	MUTIL			;GET SIZE LIMIT
	 JSERR			;ERROR
	MOVE T1,MUTILD+1	;GET MAXIMUM MESSAGE SIZE
	MOVEM T1,MAXMSG		;SAVE

;set up free page area for one-way messages. EACH PAGE POINTS TO NEXT FREE PAGE

	move t1,nxtpag		;t1/first available location
init1:	move t2,t1		;first location in this page
	addi t2,1000		;first location in next page
	movem t2,(t1)		;store next available address in this page
	move t1,t2		;next page 
	CAMGE T1,LSTPAG		;LAST ONE?
	jrst init1		;no.
	setom (t1)		;yes. set last to -1 to indicate end of list
	;..
	SUBTTL FIRST - READS FIRST INPUT LINE

;THIS CODE READS THE LINE TYPED TO THE EXEC.  THIS MAY BE OF THE FORM
;@OPLEAS ID
;@OPLEAS $
;@OPLEAS
;@R OPLEAS
;@START
;ETC.  IT SEARCHES FOR THE ID AND STORES IT IN THE MYNAME AREA.  IT SETS 
;IDFLG ON FINDING AN ID

;READ THE LINE TYPED TO THE EXEC

	;..
	SETZ T1,
	RSCAN			;PUT THE LINE IN INPUT BUFFER
	 JRST [	JSERR
		JRST START2]
	MOVEM T1,P6		;SAVE BYTE COUNT
	JUMPE P6,GTINFO		;IF NO CHARACTERS, STARTED WITH DDT.
				; OR RESTARTED FROM WITHIN

;THERE IS AT LEAST ONE CHARACTER.  SEE IF IT STARTED WITH JOB NAME.
;IF SO, MAY CONTAIN ID.  IF NOT, GO ASK FOR IT.

	MOVE P5,[440700,,JOBNAM] ;POINT TO JOB NAME
FIRST1:	ILDB T2,P5		;GET NEXT CHARACTER IN NAME
	JUMPE T2,FIRST2		;IF ZERO, MATCHED WHOLE NAME
	PBIN			;YES. GET A CHARACTER
	SOS P6			;DECREMENT COUNT OF REMAINING CHARS
	JUMPE P6,GTINFO		;LAST CHARACTER? MUST BE BREAK
	CAMN T1,T2		;DO THEY MATCH?
	JRST FIRST1		;YES. GO LOOK AT NEXT PAIR
	JRST FIRST6		;NO. DIDN'T START WITH JOBNAME

;STARTED WITH JOB NAME.  LOOK FOR FIRST SPACE OR TAB
;JOB NAME MAY BE FOLLOWED BY RECOGNIZED FILE NAME, ETC.

FIRST2:	PBIN			;READ NEXT CHARACTER
	SOS P6			;DECREMENT REMAINING COUNT
	JUMPE P6,GTINFO		;LAST CHARACTER? MUST BE BREAK
	CAIN T1,40		;IS IT A BLANK?
	JRST FIRST3		;YES. ON TO ID AND TEXT
	CAIE T1,.CHTAB		;NO. IS IT TAB?
	JRST FIRST2		;NO. GO TO NEXT CHARACTER

;FOUND SPACE OR TAB AFTER JOBNAME.  LOOK FOR FIRST NON-SPACE,
;NON-TAB TO BEGIN ID OR TEXT.

FIRST3:	PBIN			;YES. READ ONE
	SOS P6			;DECREMENT COUNT OF REMAINING CHARS
	SKIPN P6		;LAST CHARACTER?
	JRST [	CAIN T1,.CHESC	;YES. ESCAPE?
		SETOM IDFLG	;YES. MEANS BLANK ID
		JRST GTINFO]	;IGNORE LAST CHARACTER. MUST BE BREAK
	CAIN T1,40		;SPACE?
	JRST FIRST3		;YES. KEEP LOOKING
	CAIN T1,.CHTAB		;NO.TAB?
	JRST FIRST3		;YES. KEEP LOOKING
	CAIE T1,.CHCRT		;NO. CARRIAGE RETURN?
	JRST FIRST7		;NO.
				;yes. line feed follows

;QUIT BEFORE READING ENTIRE BUFFER. READ AND DISCARD

FIRST6:	JUMPE P6,GTINFO		;IF ZERO, HAVE READ ALL
	PBIN			;READ A CHARACTER
	SOS P6			;DECREMENT COUNT
	JRST FIRST6
;HAVE FOUND 'JOBNAME...CHARACTER'. THE CHARACTER IS NON-BLANK.
;READ IT AND REMAINING CHARACTERS INTO MYNAME AREA
;STARTING AT BYTE POINTED TO BY INIBEG

FIRST7:	MOVEI T1,.PRIIN		;BACK UP POINTER SO READ WILL INCLUDE
	BKJFN			; CHARACTER ALREADY READ
	 JRST [	JSERR		;FAILED
		JRST START2]	;START OVER
	AOS P6			;ADD TO COUNT FOR RE-READ CHARACTER
	MOVE T1,INIBEG		;DEST:BYTE AFTER 'OPLEAS' IN
				; MYNAME
	MOVX T2,RD%BRK!RD%BEL	;STANDARD BREAK PLUS EOL
	HRRI T2,INISIZ		;T2/BYTES AVAILABLE IN BUFFER
	HRR T4,T2		;SAVE LIMIT ON READ
	SETZ T3,		;NO CTRL/R BUFFER
	RDTTY			;READ INPUT LINE
	 jrst [	jserr		;read failed.
		jrst start2]	;start over
	txnn t2,rd%btm		;DID we read A BREAK CHARACTER?
	jrst [	TYPE <
?INPUT TOO LONG.  IT HAS BEEN REJECTED.
>				;no. RAN OUT OF BUFFER SPACE
		jrst start2]	;start over
	MOVE T3,T4		;SPACE ORIGINALLY AVAILABLE
	MOVEM T1,T4		;SAVE POINTER TO LAST BYTE READ
	SUBI T3,(T2)		;COMPUTE BYTES READ FROM BYTES REMAINING
	SUB P6,T3		;NUMBER BYTES STILL IN RESCAN BUFFER
FIRST9:	SKIPE P6		;ANY MORE CHARACTERS TO READ?
	 JRST [	PBIN		;YES. READ ONE AND DISCARD
		SOS P6		;DECREMENT THE COUNT
		JRST FIRST9]	;REPEAT UNTIL ALL READ
	MOVE P6,T4		;P6/POINTER TO LAST BYTE
	LDB P5,P6		;SAVE LAST BYTE
	SETZM CHCNT		;CLEAR COUNT OF NON-BLANK CHARACTERS
	SETZM BYTCNT		;CLEAR COUNT OF BYTES
	MOVE T1,INIBEG		;POINT TO BEGINNING

;LOOK THROUGH CHARACTERS LOOKING FOR ID 

FIRST4:	ILDB P5,T1		;LOOK AT NEXT BYTE
	AOS BYTCNT		;INCREMENT BYTE COUNT
	cain p5,.chesc		;escape?
	jrst [	setom idflg	;yes. operator id is null
		jrst gtinfo]
	CAMN T1,P6		;IS IT THE LAST?
	JRST FIRST8		;YES. IGNORE TERMINATOR
	CAIN P5,.CHCRT		;CARRIAGE RETURN?
	JRST FIRST8		;YES. NO CHARACTERS FOLLOW
	CAIN P5,40		;BLANK?
	JRST FIRST8		;YES. WE HAVE ENOUGH
	CAIN P5,.CHTAB		;NO.TAB?
	JRST FIRST8		;YES. WE HAVE ENOUGH
	CAIN P5,72		;NO. COLON?
	JRST FIRST8		;YES. WE HAVE ENOUGH

;NOT PUNCTUATION, CR OR LAST CHARACTER. MUST BE PART OF ID.

	AOS CHCNT		;INCREMENT CHARACTER COUNT
	JRST FIRST4
	
;PUNCTUATION, CARRIAGE RETURN, OR LAST.  IF ANY CHARACTERS READ, THEY
;MUST BE THE ID.

FIRST8:	SKIPN CHCNT		;READ ANY CHARACTERS?
	JRST GTINFO		;NO. ID NOT ENTERED
	SETOM IDFLG	;YES. WE HAVE AN ID
	MOVE T2,NAMSIZ	;ADD LENGTH OF ID TO NAME SIZE
	ADD T2,BYTCNT
	SOS T2			;DON'T COUNT CURRENT CHARACTER
	MOVEM T2,NAMSIZ
	;..
	SUBTTL GTINFO - GETS INFO NOT ENTERED IN CALL

;HERE AFTER PROCESSING THE LINE TYPED TO THE EXEC.  IDFLG IS SET IF AN
;OPERATOR ID WAS FOUND.  IF IT IS MISSING, THIS CODE PROMPTS FOR IT AND STORES
;THE ANSWER IN THE MYNAME AREA.

;REACHED VIA JRST

	;..
GTINFO:	SKIPE IDFLG		;DO WE HAVE AN OPERATOR ID?
	JRST GTINF5		;YES. DON'T ASK FOR IT
	TYPE <%_What is your operator ID?>
	MOVE T1,INIBEG		;READ ID INTO END OF NAME
	MOVX T2,RD%BRK!RD%BEL	;STANDARD BREAK PLUS BEL
	SETZ T3,		;NO CONTROL/R BUFFER
	HRRI T2,INISIZ		;SPACE AVAILABLE AFTER NAME
	RDTTY			;READ THE OPERATOR ID
	 jrst [	jserr		;ERROR IN READING
		jrst start2]	;start over
	txnn t2,rd%btm		;did we read all that was typed?
	jrst [	TYPE <%_?INPUT TOO LONG.  IT HAS BEEN REJECTED.%_>				;no. print message
		jrst start2]	;start over
	MOVEI T3,INISIZ		;ORIGINAL BYTES AVAILABLE
	MOVEI T2,(T2)		;REMAINING BYTES AVAILABLE
	SUB T3,T2		;COMPUTE NUMBER READ
	MOVEM T3,P6		;P6/ NUMBER OF BYTES READ

	LDB P5,A		;GET LAST CHARACTER
	CAIN P5,33		;ESCAPE?
	CAIE P6,1		;EXACTLY ONE CHARACTER?
	JRST GTINF1		;NOT LONE ALTMODE
	MOVEI P5,0
	DPB P5,A		;CHANGE ALTMODE TO NULL
	TYPE <%_>		;JUST TYPE A CRLF IN RESPONSE TO ALTMODE
	JRST GTINF5		;LEAVE ORIGINAL NAME UNMODIFIED

;USER TYPED ID OR CR.  BACK UP TO LAST CHARACTER NOT A BREAK

GTINF1:	LDB P5,T1		;LOOK AT LAST BYTE
	CAIN P5,.CHLFD		;IS IT A LINE FEED?
	JRST GTINF2		;YES.
	CAIN P5,72		;COLON?
	JRST GTINF2		;YES.
	CAIN P5,.CHCUN		;END OF LINE?
	JRST GTINF2		;YES.
	CAIE P5,.CHCRT		;CARRIAGE RETURN?
	JRST GTINF3		;NO.
	
;LINE FEED, COLON, EOL OR CARRIAGE RETURN.  KEEP BACKING UP

GTINF2:	SOS P6
	JUMPE P6,GTINF5		;ANY MORE CHARACTERS?
	BKJFN			;YES. BACK UP
	 JSERR
	JRST GTINF1
	
;NOT A BREAK CHARACTER

GTINF3:	MOVEM T1,INIBEG		;LAST CHAR IN ID.  SAVE POINTER TO
				; TO BEGINNING OF TEXT
	MOVE T2,NAMSIZ		;INCREASE NAME SIZE BY LENGTH
	ADD T2,P6		; OF ID
	MOVEM T2,NAMSIZ

GTINF5:	JFCL
	;..
	SUBTTL GET A PID

;THIS CODE GETS A PID FOR THIS OPERATOR USING MUTIL.  IT SAVES THE PID
;IN MYPID AND IN THE APPROPRIATE WORD OF THE 3 PDB'S.
	
	;..
GETPID:	SETOM F			;F/0 IF OVER PID QUOTA, -1 IF NOT
GETPI4:	MOVEI T1,.MUCRE		;CREATE A PID
	MOVEM T1,MUTILD		;FUNCTION CODE
	MOVE T1,[0,,.FHSLF]	;MY FORK
	MOVEM T1,MUTILD+1
	MOVEI T1,3		;T1/LENGTH
	MOVEI T2,MUTILD		;T2/LOCATION
	MUTIL
	 JRST GETPI1		;FAILED
	JRST GETPI3		;SUCCEEDED

;UNABLE TO GET PID. IF EXCEEDED PID QUOTA, INCREASE QUOTA AND TRY
;AGAIN

GETPI1:	CAIE T1,IPCF13		;PID QUOTA EXCEEDED?
	 JRST GETPI2		;NO. FATAL ERROR
	JUMPE F,GETPI2		;YES. HAVE WE HAD THIS BEFORE?
	AOS F			;NO. SET FLAG TO SHOW IT HAPPENED
	MOVEI T1,.MUFPQ		;FIND OUT PRESENT QUOTA
	MOVEM T1,MUTILD		;FUNCTION: FIND PID QUOTA
	SETOM MUTILD+1		;JOB NUMBER (-1 FOR ME)
	MOVEI T1,3		;T1/LENGTH OF ARGUMENT BLOCK
	MOVEI T2,MUTILD		;T2/LOCATION OF ARGUMENT BLOCK
	MUTIL			;GET QUOTA
	 JRST GETPI2		;CAN'T GET QUOTA
	SETOM T4		;-1 IF THIS SUCCEEDS, 0 IF FAILS
	MOVEI T1,.MUSPQ		;FUNCTION:SET PID QUOTA
	MOVEM T1,MUTILD
	SETOM MUTILD+1		;JOB NUMBER (-1 FOR ME)
	AOS MUTILD+2		;INCREASE QUOTA BY ONE
	MOVEI T1,3		;T1/LENGTH OF ARGUMENT BLOCK
	MOVEI T2,MUTILD		;T2/LOCATION OF ARGUMENT BLOCK
	MUTIL			;SET THE QUOTA
	 SETZM T4		;CAN'T SET QUOTA
	JUMPN T4, GETPI4	;IF SUCCEEDED IN INCREASING QUOTA, TRY AGAIN
	;..
;FATAL ERROR - NOT QUOTA PROBLEM OR QUOTA PROBLEM REPEATED
;OR COULDN'T INCREASE QUOTA

	;..
GETPI2:	JRST [	JSERR
		QUIT1]

;GOT A PID. SAVE IN PDB'S

GETPI3:	MOVE T1,MUTILD+2	;SAVE THE PID
	MOVEM T1,MYPID
	MOVEI T2,RPDB		;SAVE MY PID IN RECEIVER FIELD FOR
	MOVEM T1,.IPCFR(T2)	; RECEIVES
	MOVEI T2,SPDB		;SAVE IN SENDER FIELD FOR INTERRUPT
	MOVEM T1,.IPCFS(T2)	; LEVEL SENDS
	MOVEI T2,OPDB		;SAVE IN SENDER FIELD FOR OPERATOR
	MOVEM T1,.IPCFS(T2)	; SENDS
	MOVE T2,MYPID	;T2/OPERATOR'S PID
	SKIPE DEBUG		;DEBUGGING?
	TYPE<%_D:Operator's PID is %2O%_>		;YES. PRINT OPERATOR'S PID
;INCREASE QUOTA

	SETOM F			;F/-1 IF CONTINUE, 0 IF RESTART
	MOVEI T1,.MUSSQ		;SET SEND AND RECEIVE QUOTA
	MOVEM T1,MUTILD		;WORD 1/FUNCTION
	MOVE T1,MYPID
	MOVEM T1,MUTILD+1	;WORD 2/PID
	MOVEI T1,777B26+777B35	;SEND AND RECEIVE 777 MESSAGES
	MOVEM T1,MUTILD+2
	MOVEI T1,3		;T1/SIZE OF ARGUMENT BLOCK
	MOVEI T2,MUTILD		;T2/LOCATION OF ARGUMENT BLOCK
	MUTIL			;SET SEND AND RECEIVE QUOTAS
	 JRST [	SETZM F		;FAILED. CHECK FOR INSUFFICIENT PRIVILEGE
		CAIN T1,IPCF10	;NEED WHEEL PRIVILEGE?
		SETOM F		;YES. SET FLAG
		CAIN T1,IPCF11	;NEED WHEEL OR IPCF PRIVILEGE?
		SETOM F		;YES. SET FLAG
		JSERR		;REPORT ERROR
		SKIPN F		;NEED MORE PRIVILEGE?
		JRST .+1	;NO.  START OVER
		TYPE <%_%%Insufficient privilege. Unable to increase quota%_>				;YES. MAY BE ABLE TO CONTINUE
		JRST .+1]
	JUMPE F,START2		;RESTART IF NOT A PRIVILEGE ERROR
	;..
	SUBTTL SET UP INTERRUPTS

;THIS CODE SETS UP FOR INTERRUPTS ON THE FOLLOWING CHANNELS:
;0-IPCF MESSAGE RECEIVED
;1-CTRL/T
;2-CTRL/C
;3-INPUT BUFFER GOES FROM EMPTY TO NON-EMPTY
;IT ACTIVATES CHANNEL 0 BUT DOESN'T ENABLE ANY CHANNELS.  THUS AN
;IPCF INTERRUPT IS DELAYED UNTIL THE INTERRUPTS ARE ENABLED.

;REACHED VIA JRST

	;..
	CIS			;CLEAR THE INTERRUPT SYSTEM
	MOVEI T1,.MUPIC		;ASSOCIATE PID WITH CHANNEL
	MOVEM T1,MUTILD		;FUNCTION CODE
	MOVE T1,MYPID		;PID FOR OPLEASE
	MOVEM T1,MUTILD+1	;PID TO ASSOCIATE WITH CHANNEL
	SETZM MUTILD+2		;CHANNEL 0
	MOVEI T1,3		;T1/LENGTH OF ARGUMENT BLOCK
	MOVEI T2,MUTILD		;T2/LOCATION OF ARGUMENT BLOCK
	MUTIL			;ASSOCIATE CHANNEL WITH PID
	 JRST [	JSERR		;CAN'T SET UP CHANNEL. QUIT
		SKIPN DEBUG	;DEBUGGING?
		QUIT1		;NO. GIVE UP
		MOVE T2,MYPID	;T2/PID USED IN MUTIL
		TYPE <%_D:Trying to associate PID %2O with channel 0%_>	;YES. PRINT PID
		QUIT1]		;GIVE UP
	
	MOVE T1,[.TICCT,,1]	;CTRL/T ON CHANNEL 1
	ATI			;ASSIGN CTRL/T TO CHANNEL 1
	MOVX T1,.FHSLF		;T1/MY FORK
	RPCAP			;GET PRESENT CAPABILITIES
	txnn t2,sc%ctc		;can we enable ctrl/c?
	jrst chan		;no. don't try
	TXO T3,SC%CTC		;ALLOW CTRL/C INTERRUPTS
	EPCAP			;ENABLE THIS PLUS EXISTING
	MOVE T1,[.TICCC,,2]	;CTRL/C ON CHANNEL 2
	ATI			;ASSIGN CTRL/C TO CHANNEL 2
CHAN:	MOVE T1,[.TICTI,,3]	;INPUT BUFFER NON-EMPTY
	ATI			;ASSIGN BUFFER NON-EMPTY TO 3

	MOVX T1,.FHSLF		;MY FORK
	MOVE T2,[LEVTAB,,CHNTAB] ;
	SIR			;SET UP INTERRUPT TABLES
	movei t1,.fhslf		;t1/my fork
	MOVX T2,1B0+1B<.ICILI>+1B<.ICPOV>	;ACTIVATE CHANNELS
	aic			;activate channelS
	;..
;SEND NAME TO INFO.

	;..
	MOVEI P2,OPDB		;P2/ADDRESS OF SEND PDB
	MOVEI P4,OPDBSZ		;P4/SIZE OF SEND PDB
	MOVEI P3,OMSG		;P3/ADDRESS OF SEND MESSAGE
	CALL SNDNAM
	 JRST START2		;FAILED. RESTART

;TRY TO ASSIGN PID TO BE MDA PID

   TMNT,<
	LDB T1,[POINT 7,MYNAME+3,20]
	CAIE T1,.CHESC		;CHECK FOR ESCAPE
	CAIN T1,.CHLFD		; OR LINE-FEED
	MOVEI T1,.CHCRT		;FAKE UP CR
	CAIE T1,.CHCRT		;CHECK FOR NULL ID
	JRST NOMDA		;NO - DONT BECOME MDA
	MOVEI T3,.MURSP		;FCN TO READ MDA PID
	MOVEM T3,MUTILD
	MOVEI T3,.SPMDA		;INDEX INTO SYSTEM PID TABLE
	MOVEM T3,MUTILD+1
	MOVEI T1,3		;LEN OF ARGS
	MOVEI T2,MUTILD		;ADDRS OF ARGS
	MUTIL			;READ TABLE
	  JRST	[CAIE T1,IPCF27	;NO SUCH PID ERROR
		 JSERR		;NO - LOSAGE
		 MOVEI T1,3	;RESTORE T1
		 MOVE T3,MYPID	;SETUP PID TO USE
		 JRST SETMDA]	;...
	MOVE	T3,MYPID	;CHECK IF PID ALREADY THERE
	CAMN	T3,MUTILD+2	;...
	JRST	NOMDA		;NO NEED TO SET ONE
SETMDA:	MOVEM	T3,MUTILD+2	;SET PID IN ARG BLOCK
	MOVEI	T3,.MUSSP	;FCN CODE TO SET PID
	MOVEM	T3,MUTILD	;STORE IN BLOCK
	MUTIL			;SET SYSTEM PID FOR MDA
	  JSERR			;LOSAGE
NOMDA:
   > ;TMNT

;ACTIVATE CTRL/C,CTRL/T, AND INPUT BUFFER CHANNELS.  
;ENABLE INTERRUPT SYSTEM

	MOVX T1,.FHSLF		;T1/MY FORK
	MOVX T2,1B1!1B2!1B3	;T2/CHANNELS TO ACTIVATE
	aic			;activate ctrl/c,ctrl/t,input buffer
	CALL PION		;TURN ON INTERRUPTS

;CAUSE AN INTERRUPT ON THE IPCF CHANNEL IN CASE THERE WAS A MESSAGE
;IN THE QUEUE WHEN THE CHANNEL WAS ACTIVATED. INTERRUPT ROUTINE
;WILL IGNORE THE INTERRUPT IF THE MRECV FAILS.

	MOVEI T1,.FHSLF		;T1/MY FORK
	MOVX T2,1B0		;T2/CHANNEL 0 (IPCF INTERRUPT)
	IIC			;CAUSE INTERRUPT ON CHANNEL IN CASE
				; MESSAGE ALREADY THERE
	;..
	SUBTTL WAKEUP

;THIS IS THE MAIN NON-INTERRUPT LEVEL ROUTINE.  IT IS STARTED FOR THE
;FIRST TIME AFTER THE FORCED IPCF INTERRUPT.  IT CLEARS INTFLG WHEN IT 
;STARTS.  WHEN IT HAS NOTHING TO DO, IT CHECKS INTFLG.  IF IT IS SET, AN
;INTERRUPT HAS OCCURRED SINCE WAKEUP BEGAN, SO IT STARTS OVER.  OTHERWISE, IT
;SETS WTFLG AND SLEEPS.
;EACH INTERRUPT ROUTINE DECIDES WHERE TO RETURN BASED ON WTFLG.  IF IT IS
;SET, THE ROUTINE RETURNS TO WAKEUP.  OTHERWISE, IT RETURNS TO THE
;NEXT LOCATION TO BE EXECUTED WHEN THE INTTERRUPT OCCURRED.

;REACHED VIA DEBRK.

	;..
WAKEUP:
	SETZM INTFLG		;CLEAR INTERRUPT FLAG
	SETZM WTFLG		;CLEAR WAIT FLAG

;IF TEXT HAS COME IN FROM PLEASE, IT IS STORED IN TXTBUF.  PRINT IT.
;THE MESSAGES ARE CONCATENATED.  A NULL FOLLOWS THE LAST MESSAGE.

	MOVX T1,.FHSLF		;T1/MY FORK
	DIR			;NO INTERRUPTS WHILE READING BUFFER
	MOVX T1,.FHSLF		;T1/MY FORK
	EIR			;ENABLE INTERRUPTS

;SEE IF THE OPERATOR HAS TYPED ON THE TERMINAL.

	MOVEI T1,.PRIIN		;T1/PRIMARY INPUT DEVICE
	SIBE			;HAS OPERATOR TYPED ANYTHING?
	JRST WAKE1		;YES. READ IT.
	JRST WAKE3		;NO.

;OPERATOR HAS TYPED. READ IT

WAKE1:	HRROI T1,OMSG+1		;POINT TO BEGINNING OF BUFFER
	MOVX T2,RD%BRK!RD%BEL	;STANDARD BREAK PLUS EOL
	HRRI T2,<OMSGSZ*5>-10	;NUMBER OF BYTES (leave room to
				; add crlf and null if not read)
	SETZ T3,		;NO CTRL/R BUFFER
	SETZM RDFLG		;INITIALIZE TO SAY ALL CHARACTERS READ
	RDTTY
	 JSERR
	SKIPN CURPID		;IS THERE A CURRENT PID?
	JRST [	TYPE<%_%%No current user. Input ignored.%_>
		JRST WAKE3]
   SMNT,<
	SKIPE SMF		;WAITING FOR STRUCTURE TO BE MOUNTED?
	JRST SMOPR		;YES, PERHAPS OPERATOR IS REFUSING
>;SMNT
  TMNT,<
	SKIPE TMF		;TMOUNT REQUEST?
	JRST TMOPR		;YES - HANDLE RESPONSE
   >;TMNT
	TXNE T2,RD%BTM		;DID WE GET EVERYTHING TYPED?
	JRST [	LDB P5,T1	;YES. SAVE LAST CHARACTER TYPED
		JRST WAKE12]	;GO SEND THE MESSAGE
	;..
;read ended on buffer full. operator wants to send more. send this
;much and go read the rest.

	;..
	MOVEM T1,P6		;SAVE POINTER TO LAST CHARACTER READ
	TYPE <%_%%Text exceeds maximum for one message. Message being sent.%_>
	SETOM RDFLG		;SET FLAG TO READ REST OF INPUT
	MOVE T1,P6		;RESTORE POINTER TO T1
	MOVEI T4,.CHCRT		;APPEND A  CR SINCE operator DIDN'T GET IT IN
	IDPB T4,T1		;ADD IT FOR LOOKS AT user'S END
	MOVEI T4,.CHLFD		;SIMILARLY LINE FEED
	IDPB T4,T1
	SETZ T4,		;END WITH NULL FOR SOUT IN upleASE
	IDPB T4,T1

;send as much as we HAVE READ

WAKE12:
	CALL SNDTXT		;SEND WHAT OPERATOR HAS TYPED TO USER
	 JRST WAKEUP		;COULDN'T
	skipe rdflg		;is there more to read?
	jrst wake1		;yes. go read it

;entire message read. check terminator for goodbye

	caie P5,.CHCNZ		;NO. ENDED WITH CTRL/Z?
	CAIN P5,.CHESC		;NO. ESCAPE?
WAKE13:	JRST [	MOVX T2,1B1	;SET BYEFLG TO INDICATE OPR QUIT
		IORM T2,BYEFLG
		JRST wake3]
	jrst wakeup		;see if operator has typed more

;ROUTINE FOR SENDING TEXT TO USER.  SKIPS IFF SUCCEEDS

SNDTXT:	MOVEI A,PLTXT		;CODE IS "TEXT"
	CALL BLURB		;SEND THE TEXT
	 RET			;FAILURE RETURN
	RETSKP			;SUCCESS RETURN

;ROUTINE TO SEND TEXT WITH ARBITRARY CODE (CODE DETERMINES TYPE
;OF TEXT, FOR INSTANCE IS IT AN ERROR MESSAGE OR A BIRTHDAY
;GREETING ??)
;ACCEPTS:
;	A/	CODE TO SEND
;RETURNS:
;	+1	FAILURE
;	+2	WIN

BLURB:	MOVEM A,OMSG		;STORE DESIRED CODE
	MOVEI P2,OPDB		;P2/LOCATION OF SEND PDB
	MOVE T1,CURPID
	MOVEM T1,.IPCFR(P2)	;SEND TO CURRENT PID
	AOS T1,SNDCNT		;INCREMENT COUNT OF TEXT MESSAGES SENT
	HRLM T1,OMSG		;SEND WITH MESSAGE
	MOVEI P4,OPDBSZ
	CALL SNDMSG		;SEND TEXT JUST READ
	 JRST [	CALL ERR1	;FAILED. RETRY IF OVER RECEIVE QUOTA
		 RET		;RETRY FAILED OR COULDN'T RETRY
		JRST .+1]	;RETRY SUCCEEDED
	RETSKP			;SUCCESS
;SEE IF ANYONE HAS SAID GOODBYE

WAKE3:	SKIPN P6,BYEFLG		;HAS ANYONE SAID GOODBYE? LOAD P6
	JRST WAKE6		;NO.

;SOMEONE HAS SAID GOODBYE. IF TEXT HAS BEEN RECEIVED AND NOT
;PRINTED, DUMP THE BUFFER

	MOVE P5,RCVCNT		;SAVE NUMBER OF LAST MESSAGE RECEIVED

;SEE WHO SAID GOODBYE

	TXNE P6,1B0		;WAS IT THE USER? 
	JRST WAKE10		;YES.
	TXNN P6,1B1		;NO. WAS IT OPERATOR?
	JRST WAKE6		;NO.

;OPERATOR HAS SAID GOODBYE AND USER HAS NOT. SEND 'GOODBYE'

	MOVEI P2,OPDB		;p2/address of send pdb
	MOVE T1,CURPID		;SEND TO CURRENT PID
	MOVEM T1,.IPCFR(P2)
	MOVEI T1,PLBYE		;CODE IS GOODBYE
	MOVEM T1,OMSG		;SAVE IN FIRST WORD OF MESSAGE
	HRLM P5,OMSG		;SEND NUMBER OF LAST MESSAGE RECEIVED
	MOVEI P4,OPDBSZ		;P4/LENGTH OF PDB
	CALL SNDMSG		;SEND 'GOODBYE' TO CURRENT USER
	 JRST [	CAIE T1,IPCFX7	;RECEIVER'S QUOTA EXCEEDED?
		JRST .+1	;NO. ASSUME IT WENT AWAY
		MOVEI T1,^D1000	;TIME TO WAIT
		DISMS		;WAIT A WHILE
		CALL SNDMSG	;TRY AGAIN
		 JFCL		;FAILED AGAIN. GIVE UP
		JRST .+1]	;SUCCEEDED SECOND TIME
	JRST WAKE4		;GO PRINT MESSAGE
;USER SAID GOODBYE.  SEE IF ALL THE MESSAGES WE SENT GOT THERE

WAKE10:	MOVE T1,TXTCNT		;T1/NUMBER OF LAST RECEIVED BY PLEASE
	CAML T1,SNDCNT		;SAME AS NUMBER SENT?
	JRST WAKE4		;YES. GOOD
	TYPE <%_%%Part of your message was not transmitted.%_>				;NO. WARN OPERATOR
	SKIPN DEBUG		;DEBUGGING?
	JRST WAKE4		;NO. DON'T PRINT MESSAGE
	MOVE T2,SNDCNT		;T2/NUMBER SENT
	TYPE <%_D:Number of messages sent: %2D>
	MOVE T2,TXTCNT		;T2/NUMBER OF MESSAGES RECEIVED BY UPLEASE
	TYPE <%_D:Number of messages received: %2D>

;PRINT MESSAGE INDICATING FINISHED WITH THIS USER

WAKE4:	MOVX T3,1B0!1B17	;T3/TIME ONLY, NO COLUMNATION
	AOSN SILNTF		;ALLOWED TO PRINT?
	JRST NOPNT		;NO, SKIP THIS THEN
	SKIPE ABTFLG		;DIFFERENT MESSAGE IF USER ABORTS
	TYPE <[User aborted transaction at %3C]%_>
	SKIPN ABTFLG
	TYPE <[Transaction finished at %3C]%_>
NOPNT:
	;..
;RESET FLAGS, CLEAR BUFFERS
;DON'T ALLOW INTERRUPTS WHILE STRAIGHTENING OUT ALL THE FLAGS
	;..
	MOVEI T1,.FHSLF		;T1/MY FORK
	DIR			;DISABLE INTERRUPTS
TMNT,<	SETZM TMF>		;CLEAR TMOUNT FLAG
SMNT,<	SETZM SMF
	SETZM RMF>		;CLEAR SMOUNT FLAG
	SETZM CURPID		;NO CURRENT PID
	SETZM BYEFLG		;NO 'BYE'
	SETZM ABTFLG		;CLEAR "ABORT" FLAG
	SETZM ANSFLG		;NOT WAITING FOR ANSWER
	SETZM SNDCNT		;RESET COUNT OF MESSAGES SENT
	SETZM RCVCNT		;RESET LAST MESSAGE RECEIVED
	SETZM TXTCNT		;RESET LAST MESSAGE RECEIVED BY  UPLEASE
	MOVEI T1,.PRIIN		;CLEAR INPUT BUFFER IN CASE OPERATOR
	CFIBF			; TYPED AFTER GOODBYE DETECTED
	MOVEI T1,.FHSLF		;T1/MY FORK
	EIR			;ENABLE INTERRUPTS

;SEE IF ANYONE IS WAITING IN THE QUEUE.

WAKE9:	SKIPN QUECNT		;ANYONE WAITING?
	JRST WAKE6		;NO. 

;SOMEONE IS WAITING IN THE QUEUE. TAKE FIRST USER.
;IF ENTRY IS PID, USER IS WAITING FOR 2-WAY CONVERSATION.  IF IT IS
;AN ADDRESS, USER SENT ONE-WAY.

	MOVEI T1,.FHSLF
	DIR			;NO INTERRUPTS WHILE ADJUSTING QUEUE
	SOS QUECNT		;YES. DECREMENT QUEUE COUNT
	AOS T1,NXTREM		;INCREMENT POINTER TO OLDEST ETNRY
				; AND LOAD INTO T1
	MOVE P6,-1(T1)		;TAKE PID FROM OLDEST ENTRY
	CAILE T1,QUEFIN		;AT END OF QUEUE AREA?
	JRST [	MOVEI T1,QUEBEG	;YES. POINT TO TOP OF AREA
		MOVEM T1,NXTREM ;SAVE AS NEXT ENTRY TO REMOVE
		jrst .+1]
	txnn p6,777777b17	;is this an address (lh zero)?

;QUEUE entry is location OF ONE-WAY MESSAGE.  print message

	jrst [	move p5,p6	;yes. p5/address of message
		call prtone	;print the message
		call retpag	;return page to free space
		movei t1,.priin	;clear input buffer in case operator
		cfibf		; tried to answer one-way
		movei t1,.fhslf	;t1/my fork
		eir		;enable interrupts
		jrst wake9]	;go get next person in queue
	;..
;entry is a pid. send ok and start two-way communication

	;..
   TMNT,<
	TLZE P6,(1B0)		;CHECK FOR TMOUNT REQUEST
	SETOM TMF		; SET FLAG
   >;TMNT
   SMNT,<
	TLZE P6,(1B1)		;CHECK FOR SMOUNT REQUEST
	SETOM SMF		; SET FLAG
	SKIPE SMF		;DON'T IDENTIFY USER HERE FOR SMOUNT
	JRST WAKESM
   >;SMNT
	CALL USERID		;IDENTIFY THE USER
	 JRST [	MOVEI T1,.FHSLF	;FAILED. T1/MY FORK
		EIR		;ENABLE INTERRUPTS
		JRST WAKE9]	;USER NOT THERE. GET NEXT ONE
   SMNT,<
WAKESM:
   >;SMNT
	SETOM ANSFLG		;WAITING FOR ANSWER TO 'OK'
	MOVEM P6,CURPID		;MAKE THIS THE CURRENT PID
	MOVEI T1,.FHSLF		;T1/MY FORK
	EIR
	MOVEI P2,OPDB		;P2/ADDRESS OF SEND PDB
	MOVEI P4,OPDBSZ		;P4/SIZE OF SEND PDB
	MOVEM P6,.IPCFR(P2)	;RECEIVER - CURRENT PID
	MOVEI T1,PLOK		;MESSAGE IS 'OK'
	MOVEM T1,OMSG
	CALL SNDMSG		;SEND MESSAGE
	 JRST [	CALL ERR1	;FAILED. IF RECEIVE QUOTA FULL, RETRY
		 JRST WAKEUP	;RETRY FAILED OR COULDN'T RETRY
		JRST .+1]	;RETRY SUCCEEDED.

;BEGIN WAITING FOR ANSWER

	TIME			;GET CURRENT TIME
	ADD T1,DELAY		;ADD TIME TO WAIT FOR ANSWER
	MOVEM T1,DTIME		;SAVE  TIME TO GIVE UP
	SETOM WTFLG		;INTERRUPT WILL GO TO WAKEUP
	SKIPE INTFLG		;HAS THERE BEEN AN INTERRUPT
	JRST WAKEUP		;YES. WAKEUP
	move t1,delay		;no. set wait time
	DISMS			;WAIT
	JRST WAKE7		;CAME OUT OF DISMISS WITHOUT
				; GETTING TEXT.
;IF WAITING FOR ANSWER TO 'OK', WAIT LIMITED TIME HERE.
;OTHERWISE, GO TO STANDARD WAIT

WAKE6:	SKIPN ansflg		;WAITING FOR RESPONSE TO 'OK'?
	jrst WAKE8		;NO.
	SKIPE TXTFLG		;YES. HAS ANY TEXT COME IN?
	JRST WAKEUP		;YES. GO LOOK AT IT
	
	time			;NO.what time is it now?
	caml t1,dtime		;did we time out?
	jrst WAKE7		;yes.
	setom wtflg
	skipe intflg		;HAVE THERE BEEN ANY INTERRUPTS?
	jrst wakeup		;YES. GO SEE WHAT
	move t2,dtime		;compute new dismiss time
	subb t2,t1		;save in t1
	disms			;wait

;PLEASE DIDN'T RESPOND TO 'OK' IN TIME.  TELL OPERATOR

WAKE7:	TYPE <%_%%User not responding. (Type ESCAPE to proceed to next user)%_>

;IF INTERRUPTS HAVE COME IN, REPEAT WAKEUP CODE. IF NOT, WAIT
;FOR ANOTHER INTERRUPT.

WAKE8:
   SMNT,<
	SKIPE SMF		;WAITING FOR A STRUCTURE?
	JRST SFIND		;YES, SEE IF IT'S ON-LINE YET
>;SMNT
	SETOM WTFLG		;SET FLAG INDICATING WAITING
	SKIPE INTFLG		;HAS AN INTERRUPT BEEN PROCESSED?
	JRST WAKEUP		;YES. SEE WHAT NEEDS TO BE DONE
	WAIT			;NO. WAIT FOR SOMETHING TO HAPPEN

;SHOULDN'T GET HERE.  PRINT MESSAGE IF DEBUGGING. IGNORE OTHERWISE

	SKIPN DEBUG		;DEBUGGING?
	JRST WAKEUP		;NO. IGNORE ERROR
	TYPE <%_D:At halt after WAIT%_>				;YES. PRINT ERROR AND QUIT
	JRST WAKEUP
	SUBTTL SNDMSG

;SEND A MESSAGE WHOSE PDB AND MESSAGE AREA HAVE BEEN SET UP.
;THIS ROUTINE ASSUMES A REAL 18-BIT ADDRESS IN WORD .IPCFP
;OF THE PDB.  THE ROUTINE MOVES THE MESSAGE TO A PAGE BOUNDARY
;IN FREE SPACE AND MODIFIES .IPCFP ACCORDINGLY.

ACCEPTS:
;P2/ ADDRESS OF SEND PDB
;P4/SIZE OF SEND PDB

;REACHED VIA CALL SNDMSG FROM ROUTINE AT EITHER INTERRUPT OR NON-
;INTERRUPT LEVEL

;RETURNS: +1 SEND FAILED
;          +2: SEND SUCCEEDED

SNDMSG:	MOVEI T1,400000
	DIR			;NO INTERRUPTS DURING MESSING AROUND
	HRLZ T1,.IPCFP(P2)	;GET ADDRESS OF DATA TO SEND
	HRR T1,IPAGEX		;ADDRESS FROM WHICH MSEND REALLY WILL READ DATA
	MOVE T2,IPAGEX
	BLT T1,SMSGSZ-1(T2)	;MOVE DATA TO REAL PAGE FOR IPCF
	HRL T1,P2		;GET ADDRESS OF PDB
	HRRI T1,IPDB		;MOVE TO THE REAL PDB
	MOVS T3,T1		;SAVE BLT POINTER FOR RETURNING THE PDB
	BLT T1,IPDB-1(P4)	;COPY THE PDB
	MOVE T1,IPAGE		;GET IPCF PAGE NUMBER
	HRRM T1,.IPCFP+IPDB	;DUMB SYSTEM REQUIRES REAL PAGE FOR IPCF
	MOVE T1,P4		;T1/ SIZE OF SEND PDB
	MOVEI B,IPDB		;USE OUR OWN PDB
	MSEND			;SEND THE MESSAGE
	 JRST SNDMS1
	HRR T2,.IPCFP(P2)	;SAVE THE MESSAGE ADDRESS
	ADDI T1,-1(P2)		;COMPUTE END ADDRESS OF CALLER'S PDB
	BLT T3,(T1)		;COPY FINAL REAL PDB INTO USER'S PDB
	HRRM T2,.IPCFP(P2)	;PRESERVE CALLER'S ADDSS OF MESSAGE
	MOVEI T1,400000
	EIR			;TURN INTERRUPTS BACK ON
	RETSKP			;SUCCEEDED

;FAILED. PRINT INFO IF DEBUGGING.

SNDMS1:	call pion		;turn interrupts back on
	SKIPN DEBUG		;DEBUGGING?
	RET			;NO. NO MESSAGES.
	MOVE T2,.IPCFR(P2)	;T2/RECEIVER
	TYPE <%_D:Failed on send to PID %2O>
	MOVE T2,SMSG		;T2/FIRST WORD OF MESSAGE
	TYPE <%_D:First word of message: %2O%_>
	RET

;THE FOLLOWING ROUTINE SENDS AN IPCF CODE AT INTERRUPT LEVEL.
;
;ACCEPTS:
;	A/	CODE TO BE SENT
;	B/	PID TO SEND IT TO
;RETURNS:	+1 ALWAYS

SNDCOD:	MOVEM B,.IPCFR+SPDB	;SET UP PID TO SEND MESS TO
	MOVEM A,SMSG		;SET UP CODE BEING SENT
	PUSH P,P4		;DON'T CLOBBER P4
	PUSH P,P2		;OR P2
	MOVEI P4,SPDBSZ		;SET UP SIZE OF PDB
	MOVEI P2,SPDB		;SET UP PDB ADDRESS
	CALL SNDMSG		;SEND THE MESSAGE
	 JFCL			;DON'T WORRY ABOUT ERROR HERE
	POP P,P2
	POP P,P4
	RET

;ROUTINE TO SEND MESSAGE TO OURSELF
;ACCEPTS:
;	A/	CODE TO BE SENT
;RETURNS:	+1 ALWAYS

BABBLE:	MOVE B,MYPID			;SEND MESSAGE TO OURSELF
	CALLRET SNDCOD			;SEND THE CODE
	SUBTTL USERID

;IDENTIFY THE NEXT USER TO BE PROCESSED

;ACCEPTS:
;P6/USER'S PID

;RETURNS: +1 IF USER NOT THERE (INVALID PID, JOB NUMBER)
;	  +2 IF SUCCEED

USERID:
	SETZM USER		;CLEAR AREA TO CONTAIN USER
	MOVE T1,[USER,,USER+1]  ; INFO: LINE NUMBER AND
	BLT T1,USER+USRSIZ-1	; DIRECTORY
	movei t1,.mufoj		;CODE: get job number
	movem t1,mutild		;TO MUTIL AREA
	move t1,p6		;USER'S PID
	movem t1,mutild+1
	movei t1,3		;t1/length
	movei t2,mutild		;t2/location
	mutil			;GET THE USER'S JOB NUMBER
	 JRST [	CALL USERI1	;FAILED. PRINT ERROR
		RET]		;ERROR RETURN
	MOVEI T1,.FHSLF		;T1/MY FORK
	RPCAP			;READ MY CAPABILITIES
	TXO T3,SC%GTB		;ADD GETAB CAPABILITY
	EPCAP			;ENABLE WITH GETAB ADDED
	MOVE T1,MUTILD+2	;T1/JOB NUMBER
	MOVE T2,[-2,,USER]	;T2/2 WORDS, WRITE TO USER
	MOVEI T3,.JITNO		;T3/START WITH TERMINAL NO.
	GETJI			;FIND OUT ABOUT USER'S JOB
	 JRST [	CALL USERI1	;FAILED. PRINT ERROR
		RET]
	HRROI T1,USER+2		;T1/POINTER TO USER AREA
	MOVE T2,USER+1		;T2/USER'S DIRECTORY NUMBER
	DIRST			;CONVERT TO DIRECTORY NAME
	 JSERR			;FAILED. PRINT ERROR AND CONTINUE
	TYPE <%_[>
	SKIPE TMF
	JRST NOTPLS		;IF TMOUNT, THEN NOT PLEASE
	SKIPN SMF
	SKIPE RMF
	CAIA			;IF SMOUNT OR SREMOVE, THEN NOT PLEAS
	TYPE <PLEASE:>
NOTPLS:
   TMNT,<
	SKIPE TMF		;CORRECT HEADING
	TYPE <TMOUNT:>
   >;TMNT
   SMNT,<
	SKIPN RMF		;DON'T SAY "SMOUNT" FOR "SREMOVE"!!
	SKIPN SMF		;CORRECT HEADING
	CAIA
	TYPE <SMOUNT:>
	SKIPE RMF		;CORRECT HEADING
	TYPE <SREMOVE:>
   >;SMNT
	HRROI T1,USER+2		;T1/POINTER TO DIRECTORY NAME
	MOVE T2,MUTILD+2	;T2/JOB NUMBER
	MOVE T3,USER		;T2/TERMINAL NUMBER
	MOVX T4,1B17		;NO COLUMNATION FOR DATE AND TIME
	TYPE <  User %1A  Job %2D  Line %3O  Received at %4C]%_>
   TMNT,<
	SKIPE TMF
	MOVEM T2,TMF		;SAVE JOB # IN FLAG
   >;TMNT
	RETSKP			;SUCCESSFUL RETURN

;UNABLE TO GET INFORMATION ON USER.

USERI1:	CAIN T1,IPCF27		;'NOT A DEFINED PID' FROM MUTIL?
	JRST USERI2		;YES. TELL OPERATOR
	CAIE T1,GTJIX3		;ILLEGAL JOB NUMBER FROM GETJI?
	JRST USERI3		;NO. UNKNOWN ERROR
USERI2:	SKIPE DEBUG		;DEBUGGING?
USERI3:	JSERR
	RET
	SUBTTL PRTONE - PRINT ONEWAY MESSAGE

;ONEWAY MESSAGE IS TO BE PRINTED. CAN BE IN MESSAGE AREA IF JUST RECEIVED.
;IF NOT, IS IN FREE PAGE AREA.

;ACCEPTS:
;P5/ADDRESS OF MESSAGE

;REACHED VIA CALL PRTONE FROM INTERRUPT OR NON-INTERRUPT LEVEL ROUTINE

;RETURNS +1: ALWAYS

PRTONE:
	MOVE T2,1(P5)		;T2/TIME SENT
	TYPE<%_[PLEASE: One-way sent at %2T]>
	HRROI T1,USER+2		;T1/POINT TO STORAGE AREA
	MOVE T2,2(P5)		;T2/USER'S LOGGED IN DIRECTORY
	DIRST			;CONVERT DIRECTORY TO STRING
	 JSERR			;FAILED
	HRROI T1,USER+2		;T1/POINTER TO DIRECTORY NAME
	MOVE T2,3(P5)		;T2/GET USER'S LINE NUMBER
	MOVX T3,1B0!1B17	;T3/TIME ONLY, NO COLUMNATION
	HRROI D,4(P5)		;D/POINTER TO TEXT
	TYPE <%_[User %1A  Line %2O  Received at %3C]%_%4A>
	RET
	SUBTTL MOVTXT

;MOVE TEXT FROM ONEWAY OR TEXT MESSAGE TO BUFFER TO BE PRINTED

;ACCEPTS:
;T2/BYTE POINTER TO TEXT IN MESSAGE AREA

;RETURNS +1: ALWAYS

MOVTXT:
	MOVE T1,BUFNXT		;POINT TO NEXT AVAILABLE LOCATION
				; IN BUFFER
	MOVEI T3,BUFEND		;end of buffer area
	hrrz t4,bufnxt		;next available location
	SUB T3,T4		;words available
	SOS T3			;round down to full word
	JUMPLE T3,MOVTX1	;ERROR IF NO SPACE
	IMULI T3,5		;bytes available
	SETZ T4,		;STOP ON NULL BYTE
	SOUT			;TRANSFER TEXT TO OUTPUT AREA
	BKJFN			;BACKUP THE POINTER TO OVERWRITE THE
	 JFCL			; NULL NEXT TIME (T1 CONTAINS POINTER)
	MOVEM T1,BUFNXT		;UPDATED POINTER
	SETOM TXTFLG		;SET FLAG TO INDICATE BUFFER NON-EMPTY
	JUMPE T3,MOVTX1		;END OF BUFFER?
	RET

;BUFFER OVERFLOW

MOVTX1:	TMSG<
%%Text deleted from incoming message.
>
	RET
	SUBTTL PRNTXT

;PRINT TEXT THAT HAS COME IN AND IS WAITING IN THE BUFFER

;RETURNS +1 ALWAYS

PRNTXT:	CALL PIOFF		;TURN OFF INTERRUPTS WHILE WE DO THIS
	SETZM TXTFLG		;CLEAR TEXT FLAG
	HRROI T1,TXTBUF		;POINT TO BEGINNING OF BUFFER
	PSOUT			;PRINT TEXT
	setzm ansflg		;no longer waiting for answer to 'ok'
	call clrtxt		;clear buffer area and reset bufnxt
	CALL PION
	RET


	subttl clrtxt

;clears txtbuf area - contains text that has been received but not
;typed out.  called at initialiZation and after all characters have
;been typed.  clears the area and resets bufnxt to point to start
;INTERRUPTS HAVE BEEN DISABLED BY CALLING ROUTINE

;REACHED VIA CALL PRNTXT BY NON-INTERRUPT LEVEL ROUTINE

;RETURNS +1 ALWAYS

clrtxt:	setZM txtbuf
	move t1,[txtbuf,,txtbuf+1]
	blt t1,bufend-1
	hrroi t1,txtbuf
	movem t1,bufnxt
	RET
	SUBTTL REMPID

;REMOVE A PID FROM INTERNAL QUEUE.

;ACCEPTS:
;Q2/ PID TO BE REMOVED

;REACHED VIA CALL REMPID FROM INTERRUPT OR NON-INTERRUPT LEVEL ROUTINE

;RETURNS: +1 PID NOT FOUND
;	  +2 PID REMOVED

REMPID:	SKIPN QUECNT		;ANYTHING IN QUEUE?
	 RET			;NO. ERROR
   TMNT,<
	MOVE T3,Q2		;COPY OF PID
	TLO T3,(1B0)		;WITH BIT 0 ON
   >;TMNT
   SMNT,<
	MOVE T2,Q2		;COPY OF PID
	TLO T2,(1B1)		;WITH BIT 1 ON
   >;SMNT
	MOVE T4,NXTREM		;POINT TO FIRST ENTRY
CHECK:	TMNT,<
	CAME T3,(T4)>		;MATCH?
	CAMN Q2,(T4)		;IS THIS THE PID?
	JRST FIND		;YES. GO TAKE IT OUT
   SMNT,<
	CAMN T2,(T4)		;MAYBE ENTRY HAS BIT 1 ON
	JRST FIND		;THESE THREE COMPARES COULD HAVE PROBABLY
				;BEEN BEEN MADE ONE WITHOUT TOO MUCH
				;EFFORT, BUT THERE WERE ALREADY TWO WHEN
				;I ADDED THE THIRD AND DID SO TO MINIMIZE
				;MY CHANCES OF DOING SOMETHING WRONG,
				;CONSIDERING I DIDN'T STUDY THIS ROUTINE
				;TOO CAREFULLY. /EO
>;SMNT
	AOS T4			;NO. POINT TO NEXT LOCATION
	CAILE T4,QUEFIN		;END OF QUEUE AREA?
	MOVEI T4,QUEBEG		;YES. GO TO BEGINNING
	CAME T4,NXTADD		;BEYOND END OF LIST?
	JRST CHECK		;NO. GO SEE IF THIS IS IT.
	RET

;SENDER IN QUEUE. REMOVE AND SQUEEZE LIST

FIND:	SOS QUECNT		;DECREMENT QUEUE COUNT
	SOS T1,NXTADD		;DECREMENT NEXT AVAILABLE LOC
	CAIGE T1,QUEBEG		;BACK TO BEGINNING OF AREA?
	JRST [	MOVEI T1,QUEFIN	;YES. RESET TO END
		MOVEM T1,NXTADD
		JRST .+1]

;MOVE EACH SUCCEEDING ENTRY TO NEXT LOWER-NUMBERED LOCATION

REMPI1:	CAMN T4,NXTADD		;BEYOND END OF LIST?
	RETSKP			;YES. DONE
	MOVEI T3,1(T4)		;T3/NEXT LOCATION,T4/CURRENT LOC
	CAILE T3,QUEFIN		;DOWN TO END OF AREA?
	MOVEI T3,QUEBEG		;YES. RESET TO TOP
	MOVE T2,(T3)		;CONTENTS OF NEXT LOCATION
	MOVEM T2,(T4)		;MOVE TO CURRENT LOCATION
	MOVE T4,T3		;POINT TO NEXT LOCATION
	JRST REMPI1
	SUBTTL IPCF INTERRUPT PROCESSING

;THIS IS THE MAIN ROUTINE FOR PROCESSING IPCF INTERRUPTS. IT IS INVOKED
;WHENEVER THE NUMBER OF MESSAGES WAITING TO BE RECIEVED GOES FROM ZERO
;TO NON-ZERO.
;IT RECIEVES A MESSAGE AND JUMPS TO THE CODE TO PROCESS THE MESSAGE.  WHEN
;THERE ARE NO MORE MESSAGES WAITING, IT RETURNS.

;REACHED VIA INTERRUPT ON CHANNEL 0.

IPCINT:	SETOM INTFLG		;SET INTERRUPT FLAG
	MOVEM 16,REGSAV+16	;SAVE REGISTER 16
	MOVEI 16,REGSAV		;SET UP FOR BLT OF 0 TO REGSAV
	BLT 16,REGSAV+16	;MOVE 0-16 TO REGSAV

;SET UP FOR RECEIVE

IPCIN1:	MOVEI T4,RPDB
	MOVX T1,IP%CFB!IP%TTL!IP%CFV ;DON'T BLOCK;TRUNCATE;PAGE MODE
	MOVEM T1,.IPCFL(T4)	;FLAG WORD
	MOVSI T1,RMSGSZ		;MESSAGE SIZE
	HRR T1,IPAGE		;MESSAGE PAGE
	MOVEM T1,.IPCFP(T4)	;STORE IN PDB (size already set)
	MOVEI T1,RPDBSZ		;T1/LENGTH OF PDB
	MOVEI T2,RPDB		;T2/LOCATION OF PDB
	MRECV			;RECEIVE NEXT MESSAGE
	 JRST IPCIN2		;FAILED
	HRL T1,IPAGEX		;MOVE DATA FROM IPCF PAGE
	HRRI T1,RMSG		;INTO PROGRAM DATA AREA
	BLT T1,RMSG+RMSGSZ-1
	JRST IPCIN5		;SUCCEEDED

;RECEIVE FAILED.  IF PROBLEM IS THAT MESSAGE IS NOT IN PAGE MODE
;TRY RECEIVING WITHOUT PAGE MODE BIT SET.  RECEIVE INTO THE SAME PAGE
;AS IN PAGE MODE

IPCIN2:	CAIE T1,IPCF16		;DATA MODE PROBLEM?
	JRST IPCIN3		;NO.
	MOVX T2,IP%CFB!IP%TTL 	;DON'T BLOCK,TRUNCATE,NO PAGE
	MOVEM T2,.IPCFL(T4)	;TO PDB
	MOVSI T1,MAXMSG		;MESSAGE SIZE
	HRR T1,IPAGEX		;PAGE INTO WHICH TO READ MESSAGE
	MOVEM T1,.IPCFP(T4)	;TO PDB (size already set)
	MOVEI T1,RPDBSZ		;T1/SIZE OF PDB
	MOVEI T2,RPDB		;T2/LOCATION OF PDB
	MRECV			;READ MESSAGE AND DISCARD
	 JRST IPCIN3		;STILL FAILS
	HRL A,IPAGEX		;MOVE DATA FROM IPCF PAGE MESSAGE
	HRRI A,RMSG		;INTO PROGRAM'S MESSAGE AREA
	BLT A,RMSG+RMSGSZ-1
	JRST IPCIN5		;GO PROCESS IT

;NOT A PAGE PROBLEM.  IF THERE WAS NO MESSAGE, IGNORE THE INTERRUPT.
;OTHERWISE, PRINT THE ERROR AND RETRY.

IPCIN3:	CAIE T1,IPCFX2		;NO MESSAGE?
	JRST IPCIN4		;NO.
	SETZM NXTMSG		;YES. CLEAR ASSOCIATED VARIABLE
	JRST ENDINT		;IGNORE THE INTERRUPT
IPCIN4:	JSERR			;UNKNOWN ERROR
	JRST IPCIN1		;TRY AGAIN
;RECEIVE SUCCEEDED.  CHECK FOR UNDELIVERED MAIL AND ERRORS.  IGNORE
;ALL OTHER MESSAGES EXCEPT THOSE FROM PLEASE

IPCIN5:	SETOM NXTMSG		;REMEMBER TO TRY ONE MORE MRECV BEFORE DEBRK
	MOVEI P1,RPDB		;P1/LOCATION OF RECEIVE PDB
	MOVE Q2,.IPCFS(P1)	;Q2/SENDER'S PID
	MOVE Q1,.IPCFL(P1)	;Q1/FLAG WORD RECEIVED
	JXN Q1,IP%CFM,UNDEL	;UNDELIVERED MAIL?
	JXN Q1,IP%CFE,RCVERR	;NO. ERROR?
	JXN Q1,IP%CFC,IPCMDA	;FROM SYSTEM? CHECK MDA
	
;MESSAGE IS NOT FROM SYSTEM, UNDELIVERED, OR ERROR.  TRANSFER
;ACCORDING TO CODE SENT

	HRRZ P6,RMSG		;P6/CODE SENT IN MESSAGE
	MOVEI P2,SPDB		;P2/LOCATION OF SEND PDB
	SKIPE GOTAB(P6)		;MAKE SURE REASONABLE CODE RECEIVED
	CAIL P6,TABSIZ		;CHECK MAX LEGAL
	CAIA
	JRST @GOTAB(P6)		;OK - DISPATCH

; RECEIVED BAD CODE WITHOUT ERROR

	SKIPN DEBUG		;DEBUGGING?
	JRST BADMS1		;NO.
	MOVE T2,P6		;T2/CODE SENT IN MESSAGE
	MOVE T3,Q2		;T2/SENDING PID
	TYPE <%_D:Received code %2O from PID %3O%_>		;YES.
BADMS1:	MOVEM Q2,.IPCFR(P2)	;SEND TO SENDER
	MOVEI T2,PLCON		;CODE IS 'CONFUSED'
	MOVEM T2,SMSG		;STORE CODE IN MESSAGE
	MOVEI P2,SPDB		;P2/ADDRESSOF SEND PDB
	MOVEI P4,SPDBSZ		;P4/SIZE OF SEND PDB
	CALL SNDMSG		;SEND THE MESSAGE
	 JFCL			;FAILED. IGNORE
	;..
;MESSAGE HAS BEEN PROCESSED.  IF THERE WAS ANOTHER MESSAGE WAITING
;WHEN THIS ONE WAS RECEIVED, NXTMSG IS NON-ZERO,  GO RECEIVE THE NEXT
;ONE.  IF NXTMSG IS ZERO. ANY MESSAGE THAT HAS COME IN SINCE THE LAST
;RECEIVE WILL CAUSE A NEW INTERRUPT.

	;..
NOTMNT,<IPCMDA:>
ENDINT:	SKIPE NXTMSG		;ANY MORE MESSAGES IN QUEUE?
	JRST IPCIN1		;GO RECEIVE THE NEXT MESSAGE

;NO MORE TO RECEIVE.  IF CAME FROM WAIT, WAKE UP.  IF NOT,
;RETURN TO WHERE WE WERE BEFORE THE INTERRUPT.

	HRLZI 16,REGSAV		;RESTORE REGISTERS
	BLT 16,16

	SKIPN WTFLG		;CAME FROM A WAIT?
	 DEBRK			;NO. RETURN TO WHERE WE WERE
	CALL ILEVEL		;WHAT INTERRUPT LEVEL ARE WE AT?
	MOVEI B,WAKEUP		;YES. START WAKE-UP PROCEDURE
	MOVEM B,PCSAV1-1(A)	;CHANGE APPROPRIATE PC WORD
	MOVE B,REGSAV+B		;RESTORE AC'S USED HERE
	MOVE C,REGSAV+C
	DEBRK

;SOMETHING FAILED. START OVER

RESTRT:	QUIT1			;START OVER
;MESSAGE FROM SYSTEM, MAY BE RETURN REQUEST OF DEVICE(S)

   TMNT,<
IPCMDA:	LDB Q1,[POINTR (Q1,IP%CFC)]
	CAIE Q1,.IPCCC		;FROM <SYSTEM>IPCF?
	JRST ENDINT		;NO - IGNORE
	MOVE Q1,RMSG		;GET MESSAGE ADDRS
	CAIE Q1,.IPCSA		;MESSAGE CODE OF MDA
	JRST ENDINT		;NO - IGNORE
	HLRZ Q1,.IPCFP(P1)	;LENGTH OF MESSAGE
	MOVNI Q1,-1(Q1)		;-LEN-1
	HRLZS Q1		;-LEN,,0
IPCMD1:	TYPE <%_[TMOUNT: Device >
	MOVE T2,RMSG+1(Q1)	;DEVICE DESIGNATOR
	MOVEI T1,.PRIOU
	DEVST			;PRINT DEVICE NAME
	  JSERR
	TYPE <: returned]_>
	MOVEI T1,.ALCAL		;RETURN DEVICE TO COMMON POOL
	MOVE T2,RMSG+1(Q1)	;...
	MOVNI T3,1		;...
	ALLOC
	  JSERR
	AOBJN Q1,IPCMD1		;LOOP OVER ALL DEVICES
	JRST ENDINT		;DISMISS INTERUPT
   >;TMNT
	SUBTTL HELLO

;'HELLO' RECEIVED.  IF OPERATOR IS FREE, SEND 'OK'.  OTHERWISE PUT PID IN
;INTERNAL QUEUE AND SEND 'WAIT'.

;ACCEPTS:
;P2/ ADDRESS OF SEND PDB
;Q2/ PID OF SENDER

;REACHED VIA JRST FROM IPCINT

;JRSTS TO ENDINT ALWAYS.

   SMNT,<
SMELLO:	TLO Q2,(1B1)		;MARK PID AS SMOUNT
	JRST HELLO		;JOIN COMMON CODE
>;SMNT
   TMNT,<
XHELLO:	TLO Q2,(1B0)		;MARK PID AS TMOUNT
   >;TMNT
HELLO:	SKIPN CURPID		;IS THERE A CURRENT PID?
	SKIPE QUECNT		;NO. ANYONE IN THE QUEUE?
	JRST HELLO3		;YES.

;NO ONE CURRENT OR WAITING. MAKE THIS THE CURRENT PID

   TMNT,<
	TLZE Q2,(1B0)		;CHECK FOR TMOUNT PID
	SETOM TMF		;YES - SET FLAG
   >;TMNT
   SMNT,<
	TLZE Q2,(1B1)		;CHECK FOR SMOUNT PID
	SETOM SMF		;YES - SET FLAG
   >;SMNT
	MOVE P6,Q2		;NO. P6/NEXT PID
   SMNT,<
	SKIPE SMF		;DON'T IDENTIFY SMOUNT USER HERE
	JRST NOID1		;SMOUNT ROUTINE DOES IT
>
	CALL USERID		;IDENTIFY THE USER
	 JRST ENDINT		;USER NOT THERE. FORGET THE HELLO
   SMNT,<
NOID1:
>
	MOVEI P5,PLOK		;MESSAGE IS 'OK'
	MOVEM Q2,CURPID		;MAKE THIS THE CURRENT PID
	JRST HELLO1

;THERE IS A CURRENT PID OR SOMEONE IN THE QUEUE. PUT USER IN QUEUE.

HELLO3:	AOS T1,QUECNT		;YES. INCREMENT QUEUE COUNT
				; AND LOAD INTO T1
	CAILE T1,QUESIZ		;QUEUE FULL?
	JRST HELLO2		;YES. ERROR
	MOVE T2,NXTADD		;STORE PID IN NEXT FREE LOCATION
	MOVEM Q2,(T2)
TMNT,<	TLZ Q2,(1B0)>		;CLEAR FLAG
SMNT,<	TLZ Q2,(1B1)>		;CLEAR FLAG
	AOS T2,NXTADD		;INCREMENT NEXT FREE LOCATION
				; AND LOAD INTO T2
	CAILE T2,QUEFIN		;END OF QUEUE AREA?
	JRST [	MOVEI T2,QUEBEG ;YES. BACK TO TOP
		MOVEM T2,NXTADD
		JRST .+1]
	MOVEI P5,PLWAIT		;MESSAGE IS 'WAIT'

;SEND APPROPRIATE MESSAGE (P5 CONTAINS CODE)

HELLO1:	MOVEM Q2,.IPCFR(P2)	;SEND TO THE SENDER OF 'HELLO'
	MOVEM P5,SMSG		;CODE TO FIRST WORD OF MESSAGE
	MOVEI P4,SPDBSZ		;P4/SIZE OF SEND PDB
	CALL SNDMSG		;SEND MESSAGE
	 JRST [	CALL ERR1	;FAILED. RETRY IF OVER RECEIVE QUOTA
		 JRST ENDINT	;RETRY FAILED
		JRST .+1]	;RETRY SUCCEEDED
	CAIN P5,PLOK		;SENT 'OK' MESSAGE?
	JRST [	SETOM ANSFLG	;YES. INDICATE WAITING FOR ANSWER
		TIME		;GET CURRENT TIME
		ADD T1,DELAY	;ADD TIME TO WAIT FOR ANSWER
		MOVEM T1,DTIME	;SAVE TIME TO GIVE UP
		JRST .+1]
	JRST ENDINT		;SUCCESS

HELLO2:	TYPE<%_%% User queue OVERFLOW.%_>
	sos quecnt		;decrement count incremented above
				; limit - never added this user
	jrst endint
	SUBTTL TMOUNT

   TMNT,<
;'TMOUNT' RECIEVED - GEN MSG FOR OPR

XMOUNT:	CAME Q2,CURPID		;CURRENT?
	JRST TEXT2		;NO - COMMON ERROR
;****** THIS IS TEMPORARY TO WORK WITH OLD EXEC
	SKIPE T1,RMSG+1		;GET AND TEST FOR 0
	CAMN T1,[-1]		;AND -1
	HRRI T1,.DVMTA		;AND ASSUME MTA
	MOVEM T1,RMSG+1
;******  END TEMPORARY HACK
	HRRZ T1,RMSG+1		;GET DEVICE TYPE
	MOVSI T2,-TMLEN		;GET TABLE LENGTH
XMNT1:	CAME T1,TMTYP(T2)	;IS THIS IT?
	AOBJN T2,XMNT1		;NO, KEEP LOOKING
	JUMPGE T2,TEXT2		;GIVE RANDOM ERROR FOR UNKNOWN DEVICE
	HRRZM T2,TMIND		;REMEMBER INDEX
	HRRO T1,TMNAM(T2)	;GET DESCRIPTION
	HRROI T2,RMSG+2		;POINT TO STRING SENT
	TYPE <Mount %1A: ID=%2A>
	SKIPN RMSG+2		;DID USER GIVE VOLID?
	TYPE <(SCRATCH)> ;NO
	TYPE </WRITE->
	SKIPGE RMSG+1
	TYPE <LOCKED>
	SKIPL RMSG+1		;ACCORDING TO USER
	TYPE <ENABLED>
	TYPE <%_>
	CALL DEVFRE		;PRINT FREE DRIVES
	TYPE <Respond with drive name: >
	JRST ENDINT		;DISMISS INTERUPT

;HERE WITH OPR RESPONSE IN OMSG+1 THRU OMSG+OMSGSZ

TMOPR:	LDB T1,[POINT 7,OMSG+1,6] ;GET FIRST CHAR OF MESSAGE
	CAIE T1,.CHESC		;ESC MEANS HE WONT TALK
	CAIN T1,.CHCNZ		;IF ^Z THEN ABORT
	JRST TMABT		;  REQUEST
	CAIG T1,"7"		;IF OCTAL #
	CAIGE T1,"0"
	 SKIPA
	JRST TMOCT		;THEN SEARCH FOR DRIVE
	TRNE T1,100		;LETTER?
	TRZ T1,40		;YES, MAKE SURE UC
	MOVE Q1,TMIND		;GET DEVICE INDEX
	LDB Q1,[POINT 7,TMMN(Q1),6] ;GET FIRST LETTER OF MNEMONIC
	CAMN T1,Q1		;IS IT?
	JRST TMGET		;YES, GET A DRIVE
	CAIN T1,"?"		;WANT HELP?
	JRST TMHLP		;YES - TELL HIM
	CALL CKEOL
	 JRST TMFRE		;TYPE FREE LIST AGAIN
TMERR:	TYPE <%_?Invalid response
Drive name: >
	JRST WAKEUP		;LOOP BACK

;HERE FOR LIST OF FREE DRIVES
TMFRE:	CALL DEVFRE
	TYPE <Drive name: >
	JRST WAKEUP

;HERE FOR HELP

TMHLP:	MOVE T1,TMIND		;GET DEVICE INDEX
	HRRO T2,TMNAM(T1)	;GET POINTER TO DESCRIPTION
	HRROI T1,TMMN(T1)	;GET POINTER TO MNEMONIC
	TYPE <
Mount requested %2A.
Respond with one of the following:
Octal number - For drive %1A#
%1A# - For that drive
<CR> - For list of free drives
<CTRL>Z to abort request

Drive name: >
	JRST WAKEUP
;HERE TO ABORT TMOUNT REQUEST

TMABT:	MOVX T2,1B1		;SET FLAG
	IORM T2,BYEFLG
	JRST WAKE3		;PROCESS

;HERE IF OCTAL NUMBER TYPED - GEN DEVICE NAME

TMOCT:	MOVE Q1,[POINT 7,OMSG+1] ;POINT TO STRING
	MOVEI Q2,0		;INIT NUMBER
TMOCT1:	ILDB T1,Q1		;GET CHAR
	CAIG T1,"7"		;VALID OCTAL?
	CAIGE T1,"0"		;??
	JRST	[CAIN T1,":"	;COLON TERM OK (IGNORE)
		ILDB T1,Q1	;GET NEXT CHAR
		 CALL CKEOL	;MUST NOW BE EOL
		  JRST TMOCT2	; EOL - PROCEED
		 JRST TMERR]
	IMULI Q2,10		;SHIFT ANSWER
	TRNE Q2,777000		;ERROR IF MORE THAN 3 CHARS
	JRST TMERR
	ADDI Q2,-60(T1)		;ADD IT IN
	JRST TMOCT1		;LOOP TILL DONE

TMOCT2:	MOVE T1,TMIND		;GET DEVICE INDE
	HRL Q2,TMTYP(T1)	;GET DEVICE TYPE
	TLO Q2,600000		;MAKE IT DESIGNATOR
	CALL CKDEV		;TO TO ALLOC ETC...
	  JRST TMNOT		;SAY NOT AVAILABLE
TMEXIT:	MOVEI P2,OPDB		;ADDRS OF SEND PDB
	MOVE T1,CURPID		;SEND TO CURRENT PID
	MOVEM T1,OPDB+.IPCFR
	MOVEI T1,XTMNT		;MOUNT SUCCESS CODE
	MOVEM T1,OMSG
	MOVEM Q2,OMSG+1		;STORE DEVICE DESIGNATOR
	MOVEI P4,OPDBSZ		;SIZE OF SEND PDB
	CALL SNDMSG		;SEND AWAY
	  JFCL			;TOUGH
	JRST WAKE4		;ALL DONE

TMGET:	MOVE T1,OMSG+1		;GET RESPONSE
	AND T1,[BYTE(7)137,137,137] ;LOOK AT 1ST 3 CHARS, UC ONLY
	MOVE Q1,TMIND		;GET DEVICE INDEX
	CAME T1,TMMN(Q1)	;MATCH MNEMONIC?
	JRST TMERR		;NO - ERROR
	MOVE Q1,[POINT 7,OMSG+1,20]
	MOVEI Q2,0		;SET UP FOR OCTAL NUMBER STUFF
	JRST TMOCT1		;JOIN COMMON CODE

;ROUTINE TO CHECK LINE TERMINATOR

CKEOL:	CAIE T1,.CHCRT		;CARRIAGE RETURN
	CAIN T1,.CHLFD		; OR LINE-FEED
	RET			;GIVE NON-SKIP
	RETSKP			;ELSE SKIP

;HERE TO DEVICE(S) NOT AVAILABLE

TMNOT:	TYPE <
?Device not available - <CTRL>Z to abort
Drive name: >
	JRST WAKEUP
;ROUTINE TO LOOP OVER ALL DEVICES TO FIND ONE AVAILABLE

DEVFRE:	HRRZ T1,DEVNAM		;TABLE NUMBER OF NAMES
	HRLI T1,-1		;GET # OF ENTRIES
	GETAB
	  JSERR
	HRLZ Q1,T1		;MAKE AOBJN PNTR
	HRRZ T2,TMIND		;GET DEVICE INDEX, CLEAR 1ST TIME FLAG
DEVFR1:	HRLZ T1,Q1		;INDEX TO T1
	HRR T1,DEVUNT
	GETAB			;GET UNIT #
	  JSERR
	MOVE Q2,T1		;SAVE IN Q2
	HRLZ T1,Q1		;BUILD CALL
	HRR T1,DEVCHR		;FOR CHARACTERISTC TABLE
	GETAB			;...
	  JSERR
	LDB T1,[POINTR (T1,DV%TYP)]
	CAME T1,TMTYP(T2)	;CORRECT DEVICE TYPE?
	JRST DEVFR2		;NO
	HRLZ T1,T1
	TLO T1,600000
	HRR T1,Q2		;MAKE DEVICE DESIGNATOR
	PUSH P,T2
	PUSH P,T3
	DVCHR			;GET CHARACTERISTICS
	 ERJMP [POP P,T3
		POP P,T2
		JRST DEVFR2]
	MOVE T1,T3		;COPY JOB #
	POP P,T3
	POP P,T2
	JUMPL T1,DEVFR3		;JUMP IF FREE
DEVFR2:	AOBJN Q1,DEVFR1		;NO - TRY NEXT
	HRRO T1,TMNAM(T2)	;GET DESCRIPTION
	TLNN T2,-1		;FIND ANY?
	TYPE <No free %1A drives.>
	TYPE <%_>
	RET			;...

DEVFR3:	HRRO T1,TMNAM(T2)
	TLNN T2,-1
	TYPE <Free %1A drives: >
	TLNE T2,-1		;ANY PRINTED?
	TYPE <, >		;YES, SEPERATE
	MOVEI T1,.PRIOU		;OUT TO TTY
	HRLZ T2,TMTYP(T2)	;TYPE
	TLO T2,600000		;DESIGNATOR
	HRR T2,Q2		;UNIT
	DEVST			;PRINT NAME
	 JSERR			;FOO!
	TYPE <:>
	HRRO T2,TMIND		;GET INDEX BACK, INDICATE NOT 1ST TIME
	JRST DEVFR2

;ROUTINE TO CHECK ON DEVICE DESIGNATOR AND TRY TO ALLOC

CKDEV:	MOVEI T1,.MUFOJ		;GET CODE TO GET JOB NUMBER
	MOVEM T1,MUTILD		;SAVE IT
	MOVE T1,CURPID		;GET USER'S PID
	MOVEM T1,MUTILD+1	;SAVE IT TOO
	MOVEI T1,3		;WANT THREE ARGUMENTS
	MOVEI T2,MUTILD		;AT THIS LOCATION
	MUTIL			;SEE IF PID STILL EXISTS
	JRST CKDEVG		;FAILURE, GO CHECK IT
	MOVEI T1,.ALCAL		;FCN ALLOCATE TO JOB
	MOVE T2,Q2		;DEVICE
	MOVE T3,TMF		;JOB #
	ALLOC			;TRY TO ALLOCATE
	  JRST	[CAIE T1,ALCX5	;NOT AVAIL?
		 CAIN T1,ALCX6
		 RET		;GIVE NON-SKIP
		 CAIN T1,ALCX4	;JOB VALID?
		 JRST CKDEVJ	;NO - INFORM OPR
		 JSERR]		;ELSE ERROR
	TYPE <%_[>
	MOVEI T1,.PRIOU		;INFORM OPR OF WHAT HAPPENED
	DEVST			;DEVICE NAME
	  JSERR
	MOVE T2,TMF		;JOB # AGAIN
	TYPE <: assigned to job %2D]%_>
	RETSKP			;SKIP RETURN

CKDEVG:	CAIN T1,IPCF27		;PID GONE BECAUSE JOB WENT AWAY?
	JRST CKDEVJ		;YES, GO COMPLAIN
	JSERR			;NO, GIVE WORSE ERROR
	SKIPA			;AND ABORT
CKDEVJ:	TYPE <?Job dissappeared - aborting....%_>
	POP P,0(P)		;CLEAN UP PDL
	JRST TMABT		;AND ABORT

   >;TMNT
	SUBTTL STRLST
;SOMEONE HAS SENT DIRECTIVES ABOUT MANAGING STRUCTURE LISTS.

;"SACKN" SENT TO MAKE STRUCTURE MOUNTABLE AGAIN.

LSTDEL:	CALL WHLOPR		;MAKE SURE HE'S WHEEL OR OPERATOR
	MOVEI A,IGTBL		;POINT TO TABLE OF IGNORED STRUCTURES
	HRROI B,RMSG+.TEXT	;GET POINTER TO STRUCTURE NAME
	TBLUK			;SEE IF IT'S IN THE TABLE
	TXNN B,TL%EXM		;MUST BE EXACT MATCH
	JRST NOTTHR		;IT'S NOT THERE!
	HLRZ D,@B		;GET ADDRESS OF STRING BEING REMOVED
	MOVE B,A		;MOVE ADDRESS OF DELETION CANDIDATE INTO B
	MOVEI A,IGTBL		;GET ADDRESS OF TABLE (AGAIN)
	TBDEL			;REMOVE THE ENTRY
	MOVE A,D		;GET ADDRESS OF STRING TO BE FREED
	CALL STREM		;REMOVE STRING FROM STRING STORAGE SPACE
	JRST LST1		;RETURN TO CALLER

;"SIGNOR" SENT TO MAKE STRUCTURE UNDETECTABLE AS A MOUNTABLE STRUCTURE...

LSTADD:	CALL WHLOPR		;MAKE SURE SENDER IS WHEEL OR OPERATOR
	MOVEI A,IGTBL
	HRROI B,RMSG+.TEXT	;POINT AT NAME BEING ENTERED INTO TABLE
	TBLUK			;SEE IF IT'S ALREADY IN TABLE
	TXNE B,TL%EXM		;SKIP IF NOT ALREADY IN TABLE
	JRST DUP		;ALREADY THERE!
	HRROI A,RMSG+.TEXT	;GET POINTER TO THE NAME SENT
	CALL READNM		;READ IN THE NAME AND SKIP IF ROOM FOR IT
	 JRST NOROOM		;NO ROOM FOR THE ENTIRE NAME
	HRLZ B,A		;PUT ADDRESS OF STORED NAME IN LEFT HALF
	MOVEI A,IGTBL		;POINT TO TABLE OF STRUCTURES BEING IGNORED
	TBADD			;PUT STRUCTURE IN THE LIST
	 ERJMP NOROOM		;ASSUME NO ROOM (ALREADY CHECKED FOR DUPLICATION)
LST1:	MOVEI A,PLOK		;STRUCTURE ADDED, SEND "OK" TO SENDER
	MOVE B,Q2		;SEND TO SENDER
	CALL SNDCOD		;SEND THE "OK"
	JRST ENDINT		;DISMISS THE INTERRUPT

NOTTHR:	HRROI A,[ASCIZ /%Structure wasn't being ignored/]
	JRST EXCUSE		;TELL EXEC WHY WE'RE REFUSING
NOROOM:	HRROI A,[ASCIZ /?No room for another structure on list/]
	JRST excuse		;send the excuse to the sender

;get here when tbadd fails...

adderr:	CALL GETERR		;GET ERROR CODE
	CAIE A,TADDX2		;ENTRY ALREADY IN TABLE?
	jrst noroom		;no, assume no room
DUP:	hrroi a,[asciz /%Structure already set to be ignored/]
	JRST EXCUSE		;SEND THE EXCUSE

;GET TO HERE WITH BYTE POINTER IN A POINTING TO EXCUSE FOR NOT PUTTING
;THE REQUESTED STRUCTURE ON THE LIST OF IGNORED STRUCTURES.

EXCUSE:	MOVE B,A		;COPY FROM THE STRING
	HRROI A,SMSG+.TEXT	;TO THE IPCF MESSAGE PAGE
	MOVEI C,0		;END ON NULL
	SOUT			;COPY IT
	MOVEI A,PLTXT		;CODE IS "TEXT"
	MOVE B,Q2		;SEND TO WHOEVER SENT US THE REQUEST
	CALL SNDCOD		;SEND THE MESSAGE
	JRST ENDINT		;DISMISS THE INTERRUPT

;ROUTINE TO SKIP IFF SENDER IS WHEEL, OPR, OR MAINTENANCE

PRVCHK:	SAVEAC <A>		;DON'T CLOBBER ANYTHING
	MOVE A,RPDB+.IPCFC	;GET PRIVS OF SENDER
	TXNE A,SC%WHL+SC%OPR+SC%MNT	;DOES HE HAVE REQUIRED PRIVS?
	RETSKP			;YES
	RET			;NO

;ROUTINE TO MAKE SURE SENDER IS AN ENABLED WHEEL OR OPERATOR
;RETURNS IFF WHEEL OR OPR

WHLOPR:	CALL PRVCHK		;DOES HE HAVE PRIVS?
	 CAIA			;NO
	RET			;YES
	HRROI A,[ASCIZ /?WHEEL, OPERATOR, or MAINTENANCE capability required/]
	POP P,(P)		;THROW AWAY RETURN FROM THIS ROUTINE
	JRST EXCUSE		;TELL SENDER WHY WE'RE REFUSING
	SUBTTL SMOUNT
SMNT,<
;'SMOUNT' RECEIVED FROM SOME USER'S EXEC (OR FROM SOMEONE SCREWING AROUND!)

SREMOV:	CAME Q2,CURPID		;FROM CURRENT USER?
	JRST TEXT2		;NO, HANG LOOSE...
	SETOM RMF		;SOMEONE WANTS TO REMOVE A STRUCTURE
SMOUNT:	CAME Q2,CURPID		;FROM CURRENT USER?
	JRST TEXT2		;NO, HANG LOOSE...
	SETZM ANSFLG		;WE HAVE RECEIVED RESPONSE FROM "OK"!
	SETZM SMEDSP		;NO ERROR DISPATCH ADDRESS YET
	MOVE A,RPDB+.IPCSD	;GET CONNECTED DIRECTORY OF SMOUNTER
	MOVEM A,SMDIR		;COPY (BECAUSE GETS CLOBBERED WITH NEXT MRECV JSYS)
	SETZM WRKFLG		;FIRST ASSUME THERE'S NO WORK TO DO
	HRROI A,SMABLK		;POINT TO BLOCK TO HOLD DESIRED ALIAS
	HRROI B,RNAMES		;POINT TO NAMES SENT BY EXEC
	MOVEI C,0		;END ON NULL
	MOVEM A,SALIAS		;REMEMBER POINTER TO ALIAS
	SOUT			;COPY THE ALIAS
	HRROI A,SMSBLK		;POINTER TO DESIRED PHYSICAL STRUCTURE NAME
	MOVEM A,STRNAM		;REMEMBER POINTER TO REAL STRUCTURE NAME DESIRED
	SOUT			;COPY THE NAME
	MOVE A,RFLAGS		;GET RECEIVED FLAGS
	MOVEM A,SMFLGS		;SAVE'EM
	call mntini		;do initialization chores
	SETOM SMF		;REMEMBER WE'RE WAITING FOR STRUCTURE TO APPEAR
	SKIPE RMF		;SKIP THE FOLLOWING CHECK IF NOT A REMOVAL REQUEST
	CALL STRMNT		;IS STRUCTURE MOUNTED?
	 JRST RFIND1		;NO
	;...

;STRUCTURE IS MOUNTED, SO MAKE SURE USER ISN'T CONNECTED TO IT, AND
;THAT USER HAS NO OPEN FILES ON IT.

	MOVE B,SMDIR		;GET USER'S CONNECTED DIRECTORY
	HRROI A,FREESP		;POINT TO SOME FREE SPACE
	DIRST			;GET NAME OF CONNECTED STRUCTURE
	 JSERR
	HRROI A,FREESP		;POINT TO NAME
	STDEV			;GET DESIGNATOR OF CONNECTED STRUCTURE
	 JSERR
	MOVE C,B		;REMEMBER DESIGNATOR IN C
	MOVE A,SALIAS		;GET POINTER TO ALIAS NAME
	STDEV			;GET ITS DESIGNATOR
	 JSERR			;COULDN'T
	MOVEI A,UCON		;WHERE TO GO IF USER STILL CONNECTED TO STRUCTURE BEING REMOVED
	CAMN B,C		;MAKE SURE USER ISN'T CONNECTED TO STRUCTURE BEING REMOVED
	MOVEM A,SMEDSP		;REMEMBER TO GO TO "UCON" INSTEAD OF DOING ANY WORK

;*********
;* CODE GOES HERE WHICH MAKES SURE USER
;* HAS NO OPEN FILES ON STRUCTURE BEING
;* REMOVED, BUT ALAS; MR. MONITOR DOESN'T
;* KNOW HOW TO TELL US WHICH FILES USER
;* HAS OPEN.  TUNE IN NEXT WEEK...
;********

RFIND1:	movn a,rmf		;0 for smount, 1 for sremove
	call @[exp strmnt,nostr](a)
	 SETOM WRKFLG		;STRUCTURE NOT IN REQUESTED STATE, REMEMBER THAT THERE'S WORK TO DO
	JRST ENDINT		;START WAKEUP TO LOOK FOR STRUCTURE

;HERE TO SEE IF STRUCTURE HAS BEEN PUT ON-LINE BY SOMEONE YET...

SFIND:	SKIPE SMEDSP		;IS THERE AN ERROR CONDITION?
	JRST @SMEDSP		;YES, GO HANDLE IT
	SKIPE RMF		;WAITING FOR STRUCTURE TO BE REMOVED?
	JRST RFIND		;YES, GO SEE THE STATE OF THE WORLD
	CALL FNDSTR		;TRY TO FIND THE STRUCTURE SITTING ON SOME DRIVES
	 JRST STRNF		;STRUCTURE NOT FOUND
	CALL MSMNT		;STRUCTURE FOUND, MOUNT IT
	 JRST WHOOPS		;COULDN'T MOUNT, GO GIVE EXCUSE
	CALL BBB		;GO PRINT MESSAGE, IF BAT BLOCKS ARE BAD
SFIND2:	CALL COMNDS		;UPDATE COMMANDS TO CHECK FOR DOMESTIC OR FOREIGN
	MOVX B,MS%DOM		;GET DOMESTIC BIT
	MOVE A,SALIAS		;GET POINTER TO STRUCTURE NAME
	MOVEM A,SSSALS		;SET UP ALIAS FOR STRUCTURE BEING MODIFIED
	MOVEM B,SSSMSK		;SET UP MASK TO "DOMESTIC" BIT
	IORM B,SSSSTA		;TURN ON DOMESTIC BIT
	MOVE A,STRNAM		;GET POINTER TO REAL NAME OF STRUCTURE
	CALL DOMQ		;SKIP IF SUPPOSED TO BE MOUNTED DOMESTIC
	 SETCMM SSSSTA		;NOT, SO TURN OFF BIT SO IT WILL BE FOREIGN
	CALL MSSSS		;SET STRUCTURE STATUS, FOREIGN OR DOMESTIC
	SETZM SMF		;WE'RE NO LONGER LOOKING FOR STRUCTURE
	MOVEI A,PLOK		;TELL USER'S EXEC IT'S OK TO INCREMENT MOUNT COUNT NOW
	MOVE B,CURPID		;SEND MESSAGE TO CORRECT USER!
	CALL SNDCOD		;SEND THE "OK"
	JRST WAKEUP		;WAIT FOR EXEC TO INCREMENT MOUNT COUNT

;GET TO HERE FOR REMOVAL REQUEST...

RFIND:	CALL NOSTR		;HAS STRUCTURE BEEN REMOVED?
	 JRST STRNF		;NO, KEEP WAITING
	SETZM RMF		;YES, CLEAR FLAG SO WE KNOW WE'RE DONE
	MOVEI A,PLOK		;TELL EXEC IT WON
	MOVE B,CURPID		;SEND MESSAGE TO CORRECT USER!
	CALL SNDCOD		;SEND THE "OK"
	MOVE A,STRNAM		;GET NAME OF STRUCTURE THAT WAS REMOVED
	SKIPE WRKFLG		;DON'T SAY ANYTHING IF NO WORK GOT DONE
	TYPE <[Structure %1A: removed from drives]%_>
	SKIPN WRKFLG
	SETOM SILNTF		;DON'T SAY "TRANSACTION ENDED..." IF NEVER SAID STARTED!
	JRST WAKE4		;PROCEED TO NEXT USER

;ROUTINE WHICH SKIPS IFF SPECIFIED STRUCTURE (A LA STRNAM,SALIAS) HAS
;BEEN REMOVED FROM DRIVES

NOSTR:	CALL FNDSTR		;IS STRUCTURE DISMOUNTED BUT SPINNING?
	 CAIA			;REMOVED, OR STILL MOUNTED
	RET			;SPINNING, SO NOT REMOVED YET
	CALL STRMNT		;SKIP IF REQUESTED STRUCTURE MOUNTED
	 RETSKP			;CAN'T GET STATUS, SO MUST BE REMOVED
	RET			;GOT STATUS, SO NOT REMOVED YET

;ROUTINE WHICH SKIPS IFF STRUCTURE WHOSE ALIAS IS POINTED TO BY
;SALIAS IS CURRENTLY MOUNTED

STRMNT:	MOVE A,SALIAS
	MOVEM A,GSSALS
	CALL MSGSS		;SEE IF STRUCTURE ALREADY REMOVED
	RET
	RETSKP

;ARRIVE HERE WHEN EXEC HAS SAID IT SUCCEEDED IN INCREMENTING THE
;MOUNT COUNT

MDONE:	CAME Q2,CURPID		;FROM CURRENT USER?
	JRST TEXT2		;NO, HANG LOOSE...
	MOVE A,TYPNAM		;GET POINTER TO DEVICE TYPE NAME
	HRRZ C,MNTNUM		;PICK UP NUMBER OF UNITS IN STRUCTURE
	SKIPE WRKFLG		;DON'T TYPE ANYTHING IF DIDN'T DO ANY WORK!
	TYPE <[%S mounted as a %3D-unit %1A structure]%_>
	SKIPN WRKFLG
	SETOM SILNTF		;DON'T PRINT "TRANSACTIN ENDED..." UNLESS SOME WORK GOT DONE
	jrst bye		;done with request, proceed to next user in queue

;GET TO HERE WHEN THE STRUCTURE ISN'T FOUND THAT WAS ASKED TO BE MOUNTED

STRNF:	SKIPE RMF
	JRST STRNF9		;REMOVAL REQUEST, DON'T CHECK FOR MOUNTED
	CALL STRMNT		;SKIP IF REQUESTED STRUCTURE IS MOUNTED
	CAIA			;NOT YET
	JRST SFIND2		;MOUNTED, SO FINISH UP
				;(THIS SOLVES THE PROBLEM OF US GETTING
				;CALLED TO MOUNT AN ALREADY MOUNTED STRUCTURE)
STRNF9:	MOVE A,SMFLGS		;GET FLAGS
	TXNE A,NO%WT		;DID USER REQUEST NOT TO WAIT FOR STRUCTURE?
	JRST NOWAIT		;YES, SO ABORT NOW
	SETOM WRKFLG		;IF WE EVER GET HERE, WE WEREN'T SATISFIED, SO REMEMBER THERE WAS WORK TO TO
	TIME			;GET CURRENT TIME
	SUB A,LASTL		;CALCULATE TIME SINCE LAST LIST OF AVAILABLE DRIVES
	CAMLE A,[ANNOYT*^D60000]	;HAS A LONG TIME PASSED SINCE LISTING AVAILABLE DRIVES?
	CALL DLISTX		;YES, REMIND THE OPERATOR
	MOVEI A,SCANT*^D1000	;GET TIME FOR SLEEPING BETWEEN SCANS
	DISMS			;SLEEP FOR AWHILE
	TIME			;GET CURRENT TIME
	CALL SKPNOP		;SKIP IF THERE'S NO OPERATOR
	MOVEM A,LSTOPR		;THERE IS, REMEMBER.
	CALL DLIST		;LIST AVAILABLE DRIVES (IF IT'S CHANGED)
	CALL SKPNOP		;SKIP IF NO OPERATOR IN ATTENDANCE
	JRST PRESNT		;THE OPERATOR IS IN.
	TIME			;GET CURRENT TIME
	SUB A,LSTOPR		;CALCULATE WAITING TIME WITH NO OPERATOR
	CAML A,[NOOPGU*^D60000]	;HAVE WE WAITED REAL LONG WITH NO OP?
	JRST GIVEUP		;YES, SO CANCEL THE SMOUNT REQUEST
PRESNT:		JRST WAKEUP		;WAIT FOR STRUCTURE TO APPEAR...

;ROUTINE TO UPDATE DISK DRIVE TABLE, AND LIST IT IF IT'S CHANGED SINCE
;THE LAST LISTING

DLIST:	MOVE A,[DRVTAB,,ODRVTB]	;COPY THE AVAILABILITY TABLE
	BLT A,ODRVTB+DTABLN-1	;SO WE'LL KNOW IF IT'S CHANGED
	CALL DRINFO		;GET INFO ABOUT WHICH DRIVES ARE AVAILABLE
	CALLRET PDINFO		;PRINT OUT THE DRIVE INFO (IF IT HAS CHANGED)

;THIS ROUTINE IDENTIFIES WHO'S REQUESTING AN SMOUNT, AND LISTS THE
;AVAILABLE DISK DRIVES

DLISTX:	MOVX A,DRV%NA		;GET "DRIVE NOT AVAILABLE BIT"
	XORM A,DRVTAB		;CHANGE ITS STATE IN TABLE TO GUARANTEE PRINTOUT
	CALL WHOMNT		;SAY WHO'S DOING THE SMOUNT
	CALLRET DLIST		;FALL INTO CODE THAT PRINTS AVAILABLE DRIVES

;ROUTINE TO DECLARE WHAT TO MOUNT.  PRINTS OUT REQUEST ON THE
;OPERATOR'S CONSOLE.

WHOMNT:	MOVE P6,CURPID		;USE PID OF WHOMEVER'S CURRENT USER
	CALL USERID		;TELL OPERATOR WHO IS DOING THE SMOUNT
	 JFCL			;IGNORE FAILURE (USER PROBABLY TYPED ^C)
	HRROI D,[ASCIZ /mount/]
	SKIPN RMF		;REMOVAL REQUEST?
	JRST NORM		;NO, DIFFERENT MESSAGE
	TYPE <Please remove %S from the drives when it appears on
the list of free drives, or type NO.%_>
	JRST BURST		;SKIP SMOUNT REQUEST MESSAGE
NORM:	TYPE <Please mount %S, or type NO.%_>
BURST:	ret

;THE FOLLOWING ROUTINE LOOKS FOR A SPECIFIED STRUCTURE ON THE
;DISK DRIVES.  ONLY DRIVES NOT CONTAINING PART OF AN ALREADY MOUNTED
;STRUCTURE, AND DRIVES CONTAINING A PACK WHICH ISN'T BEING USED FOR
;AN ON-LINE DIAGNOSTIC, ARE CONSIDERED.  THE ROUTINE MAKES SURE THERE
;AREN'T TWO COMPLETE UNMOUNTED STRUCTURES WITH THE SPECIFIED NAME.  IF
;THE ROUTINE FINDS EXACTLY ONE COMPLETE STRUCTURE OF THE SPECIFIED
;NAME, IT TAKES A SKIP RETURN WITH "MNTBLK" SET UP CORRECTLY FOR
;MOUNTING THE STRUCTURE.  OTHERWISE, THE ROUTINE TAKES A NON-SKIP
;RETURN

FNDSTR:	CALL DRVINI		;INITIALIZE POINTERS SO WE CAN SCAN ALL DRIVES

;FIRST, WE LOOK FOR SOME PACK IN THE STRUCTURE, TO FIND OUT HOW MANY
;PACKS ARE IN THE STRUCTURE ALTOGETHER:

FND1:	CALL MSRNU		;READ STATUS OF NEXT DISK DRIVE
	 RET			;WE NEVER FOUND A SINGLE PACK, SO THE STRUCTURE ISN'T ON LINE YET
	call drvmch		;is this pack off line and the right name?
	jrst fnd1		;NO, keep looking
	HRRZ A,RNUNUM		;GET NUMBER OF UNITS IN THIS STRUCTURE
	CAILE A,MAXPKS		;MAKE SURE THERE AREN'T TOO MANY UNITS
	ERROR <Too many units in structure for this assembly of the mounting program>
	MOVEM A,MNTNUM		;CLEAR FLAGS AND STORE NUMBER OF UNITS IN STRUCTURE

;NOW WE KNOW HOW MANY UNITS WE'RE LOOKING FOR.  THE NEXT STEP IS TO
;RESCAN ALL THE DRIVES, LOOKING FOR ALL THE UNITS, MAKING SURE WE FIND
;EXACTLY ONE OF EACH UNIT OF THE STRUCTURE.

;INITIALIZE THE STRUCTURE TABLE:

	SETOM MNTTBL		;-1 MEANS WE HAVEN'T FOUND ANY UNITS YET
	MOVE A,[MNTTBL,,MNTTBL+1]	;PREPARE TO PUT -1 IN ALL ENTRIES
	BLT A,MNTTBL+MNTLEN-1	;FILL REST WITH -1'S
	MOVEI C,0		;C HOLDS NUMBER OF UNITS OF THE STRUCTURE WE'VE FOUND SO FAR
	CALL DRVINI		;RESTART THE DRIVE SCAN
FND2:	CALL MSRNU		;READ NEXT DISK UNIT
	 JRST FND3		;GO TO FND3 IF ALL HAVE BEEN SCANNED
	CALL DRVMCH		;SKIP IFF PACK IS AVAILABLE AND RIGHT NAME
	 JRST FND2		;IT'S NOT, LOOK AT THE NEXT ONE
	HLRZ A,RNUNUM		;GET UNIT NUMBER WE'VE JUST FOUND
	IMULI A,UNTLEN		;MULTIPLY BY NUMBER OF WORDS USED FOR EACH UNIT
	ADDI A,MNTTBL		;OFFSET INTO THE TABLE
	AOSE (A)		;MAKE SURE THIS IS THE FIRST MATCH ON THIS UNIT
	RET			;SUBSEQUENT, SO AMBIGUITY
	HRLI A,RNUCHN		;PREPARE TO MOVE UNIT INFO
	MOVEI B,UNTLEN-1(A)	;B HOLDS FINAL ADDRESS INTO WHICH TO MOVE DATA
	BLT A,(B)		;MOVE THE INFO FOR THIS UNIT INTO THE MOUNT TABLE
	AOJA C,FND2		;REMEMBER WE'VE FOUND ANOTHER UNIT AND KEEP LOOKING

;NOW THAT WE'VE SCANNED ALL THE DRIVES, MAKE SURE WE'VE FOUND ALL
;THE UNITS

FND3:	CAME C,MNTNUM		;CORRECT NUMBER OF UNITS FOUND?
	RET			;WRONG NUMBER, SO TAKE NON-SKIP

;WE'VE FOUND THEM ALL, SO FINISH SETTING UP "MNTBLK" SO THE MOUNT
;JSYS WILL WORK

	MOVE A,SALIAS		;CORRECT NUMBER, GET DESIRED ALIAS
	MOVEM A,MNTALS		;STORE IT IN MOUNT BLOCK
	MOVE A,STRNAM		;GET STRUCTURE NAME
	MOVEM A,MNTNAM		;STORE AS STRUCTURE NAME BEING MOUNTED
	MOVE A,[MNTTBL,,RNUBLK]	;PREPARE TO MOVE INFO FOR ONE PACK OF STRUCTURE
	BLT A,RNUBLK+UNTLEN	;SET UP INFO FOR ONE PACK
	CALL MSRUS		;READ STATUS OF THIS PACK
	LDB A,[221100,,RNUSTA]	;GET DEVICE TYPE CODE
	CALL DEVIDX		;GET INDEX INTO DEVICE TYPE NAME TABLE
	HLRO A,DEVTYP(A)	;MAKE POINTER TO ASCII NAME
	MOVEM A,TYPNAM		;REMEMBER POINTER TO DEVICE TYPE NAME
	RETSKP			;FOUND THE STRUCTURE, SO TAKE SKIP RETURN

;THE FOLLOWING ROUTINE TAKES A DEVICE TYPE NUMBER AS RETURNED
;BY THE MONITOR AND NORMALIZES IT TO 0 THROUGH N-1 WHERE N IS THE
;NUMBER OF DEVICE TYPES WE UNDERSTAND.
;ACCEPTS:
;	A/	DEVICE TYPE AS RETURNED BY "READ UNIT STATUS"
;RETURNS:	+1 ALWAYS

DEVIDX:	PUSH P,B
	PUSH P,C		;DON'T CLOBBER ANYTHING
	MOVEI B,DEVS		;LENGTH OF TABLE TO SEARCH
DEVID1:	SOJL B,DEVNF		;IF B RUNS OUT, THE DEVICE CODE WAS BAD
	HRRZ C,DEVTYP(B)	;PICK UP DEVICE CODE FROM TABLE
	CAME A,C		;IS THIS THE ONE WE'RE LOOKING FOR?
	JRST DEVID1		;NO, KEEP LOOKING
	MOVE A,B		;YES, RETURN IT
DEVRET:	POP P,C
	POP P,B
	RET			;RETURN

DEVNF:	MOVEI A,BADDEV-DEVTYP	;ON BAD CODE, RETURN A STANDARD BAD ONE
	JRST DEVRET

;HERE'S THE ROUTINE THAT ACTUALLY MOUNTS A STRUCTURE.  IT ASSUMES
;"MNTBLK" IS SET UP FOR THE STRUCTURE TO BE MOUNTED.
;THIS ROUTINE TAKES A SKIP RETURN IFF THE MOUNT SUCCEEDS

MSMNT:	MOVE A,[MNTLEN,,.MSMNT]	;GET LENGTH AND CODE FOR MOUNTING
	MOVEI B,MNTBLK		;POINT AT DATA BLOCK FOR STRUCTURE BEING MOUNTED
	MSTR			;MOUNT THE STRUCTURE
	 ERJMP R		;IF FAILS, JUST GIVE SINGLE RETURN
	RETSKP			;TAKE SKIP RETURN ON SUCCESSFUL MOUNT

;ROUTINE TO CHECK MOUNTED STRUCTURE AND PRINT WARNING MESSAGE
;IF BAT BLOCKS ARE BAD (MS%BBB IS ON IN READ-UNIT-STATUS)

BBB:	MOVE D,MNTNUM		;GET NUMBER OF UNITS IN STRUCTURE
BBBLUP:	SOJL D,BBBDON		;IF SCANNED ALL PACKS, WE'RE DONE
	MOVE A,D		;POINT TO A PACK IN THIS STRUCTURE
	IMULI A,UNTLEN		;MULTIPLY BY SIZE OF PACK INFO BLOCK
	ADDI A,MNTTBL		;CALCULATE ADDRESS OF PACK INFO BLOCK
	HRL A,A			;PUT IN LEFT HALF FOR BLT POINTER
	HRRI A,RNUBLK		;PREPARE TO MOVE BLOCK
	BLT A,RNUBLK+UNTLEN	;MOVE IT
	CALL MSRUS		;GET INFO ON THIS PACK
	MOVE A,RNUSTA		;PICK UP THE STATUS BITS
	TXNN A,MS%BBB		;SKIP IF BAT BLOCKS BAD
	JRST BBBLUP		;NOT BAD, LOOK AT REST OF PACKS
	TYPE <%%%S has bad BAT blocks%_>
BBBDON:	RET		;RETURN AFTER CHECKED ALL, OR FOUND ONE BAD

;THIS ROUTINE SETS BIT "DRV%NA" FOR EVERY
;WORD OF DRVTAB, DEPENDING ON WHETHER THAT DRIVE IS AVAILABLE FOR
;MOUNTING ANOTHER STRUCTURE.  IF THE BIT IS ON, THE DRIVE IS
;UNAVAILABLE.

DRINFO:	MOVX A,DRV%NA		;BIT BEING MODIFIED
	MOVEI B,DTABLN		;INDEX INTO DRIVE TABLE
DRIVE1:	SOJL B,DRIVE2		;JUMP IF WE'VE REFERENCED THE WHOLE TABLE YET
	IORM A,DRVTAB(B)	;FIRST ASSUME DRIVE IS UNAVAILABLE
	JRST DRIVE1		;DO ALL DRIVES
DRIVE2:	CALL DRVINI		;INITIALIZE DRIVE SCAN
DRIVE3:	CALL MSRNU		;READ STATUS OF NEXT DISK UNIT
	RET			;WE'RE DONE IF WE'VE SCANNED ALL DRIVES
DRIVE6:	call drvav		;is drive unused right now?
	 JRST DRIVE3		;NOT AVAILABLE, LOOK AT NEXT ONE
	;...

;GET TO HERE TO TURN OFF "DRIVE UNAVAILABLE" BIT IN TABLE.  DEVICE
;TYPE, CHANNEL, AND UNIT, ARE ENCODED TOGETHER AS AN INDEX INTO THE
;TABLE

	LDB A,[221100,,RNUSTA]	;PICK UP DEVICE TYPE
	CALL DEVIDX		;GET INDEX FROM DEVICE TYPE TABLE
	IMULI A,CHNS		;MULTIPLY BY NUMBER OF CHANNELS ALLOWED PER TYPE
	MOVE D,RNUUNT		;GET UNIT NUMBER OF THIS DRIVE
	JUMPL D,FNYDEV		;DON'T ALLOW A NEGATIVE UNIT NUMBER!
	CAIL D,UNITS		;MAKE SURE WE EXPECT SO LARGE A UNIT NUMBER
	JRST FNYDEV		;WE DON'T, THIS IS A FUNNY DEVICE
	MOVE C,RNUCHN		;GET CHANNEL NUMBER
	JUMPL C,FNYDEV		;MAKE SURE IT'S NON-NEGATIVE
	CAIL C,CHNS		;MAKE SURE IT'S NOT TOO LARGE
	JRST FNYDEV		;TOO LARGE
	ADD A,C			;COMPLETE INDEX INTO DRIVE TABLE
	IMULI A,UNITS		;LEAVE ROOM FOR UNIT DESIGNATOR
	ADD A,D
	MOVE C,RNUSTA		;GET BITS ABOUT THIS DRIVE
	MOVEM C,DRVTAB(A)	;SAVE ALL BITS
	MOVX B,DRV%NA		;GET BIT WE'RE CLEARING
	ANDCAM B,DRVTAB(A)	;CLEAR IT
	JRST DRIVE3		;PROCEED WITH NEXT DRIVE

;IF WE ENCOUNTER A CHANNEL,UNIT, OR DEVICE TYPE THAT IS OUT OF
;RANGE OR UNRECOGNIZED...

FNYDEV:	WARN <Channel, unit, or device type out of range>
	JRST DRIVE3		;PROCEED WITH NEXT DRIVE

;THIS ROUTINE SETS STRUCTURE STATUS

MSSSS:	MOVE A,[SSSLEN,,.MSSSS]	;LENGTH,,FUNCTION
	MOVEI B,SSSBLK		;POINTER TO DATA BLOCK
	MSTR			;DO IT
	RET

;GET STRUCTURE USERS.  SKIPS IFF SUCCESSFUL

MSGSU:	MOVE A,[GSULEN,,.MSGSU]
	MOVEI B,GSUBLK
	MSTR
	 ERJMP R		;NON-SKIP RETURN ON ERROR
	RETSKP

;THIS ONE GETS STRUCTURE STATUS
;SKIPS IFF SUCCESSFUL

MSGSS:	HRROI A,NAMBLK		;ALWAYS WRITE PHYSICAL STRUCTURE-ID INTO "NAMBLK"
	MOVEM A,GSSSID
	MOVE A,[GSSLEN,,.MSGSS]
	MOVEI B,GSSBLK
	MSTR
	 ERJMP R		;NON-SKIP IF ERROR
	RETSKP			;SKIP IF SUCCESSFUL

;DISMOUNT A STRUCTURE...

MSDIS:	MOVE A,[1,,.MSDIS]
	MOVEI B,DISALS		;POINT AT ALIAS OF STRUCTURE BEING DISMOUNTED
	MSTR			;DISMOUNT IT
	RET

;READ STATUS OF DISK UNIT

MSRUS:	push p,a		;don't clobber ac's
	push p,b
	HRROI A,ALSBLK		;GET POINTER TO ALIAS BLOCK
	MOVEM A,RNUALS		;STORE FOR READING STATUS OF DRIVE
	HRROI A,NAMBLK		;NEEDS POINTER FOR PHYSICAL NAME TOO
	MOVEM A,RNUNAM
	MOVE A,[RNULEN,,.MSRUS]
	MOVEI B,RNUBLK		;SAME DATA AREA AS FOR "READ NEXT UNIT"
	MSTR
	pop p,b
	pop p,a
	RET

;ROUTINE TO READ STATUS OF NEXT DISK UNIT
;this routine takes a non-skip return if there are no more drives
;to read the status of, and skips if it successfully reads the status
;of the next drive

MSRNU:	HRROI A,ALSBLK		;GET POINTER TO ALIAS BLOCK
	MOVEM A,RNUALS		;STORE FOR READING STATUS OF DRIVE
	HRROI A,NAMBLK		;NEEDS POINTER FOR PHYSICAL NAME TOO
	MOVEM A,RNUNAM
	MOVE A,[RNULEN,,.MSRNU]	;LENGTH,,FUNCTION
	MOVEI B,RNUBLK		;ADDRESS OF DATA BLOCK
	MSTR			;DO IT
	 ERJMP MSRNUE		;GO ANALYZE THE ERROR
	RETSKP			;SKIP RETURN IF WE HAVE STATUS OF NEXT DISK
MSRNUE:	CALL GETERR		;GET ERROR CODE
	CAIE A,MSTX18		;IS IT "NO MORE DRIVES"?
	 JSERR			;UNEXPECTED ERROR
	ret			;non-skip return if no more drives

;this routine takes a skip return iff a drive contains an unmounted
;pack that's not being used for a diagnostic, and the drive's pack
;is the right name.  the "right name" is that in "strnam".  the
;actual drive data used for checking is that in "rnublk", as set up
;by the "msrnu" routine.

drvmch:	SAVEAC<A,B,C,D>		;SAVE TEMPORARIES
	call drvav		;skip if drive is available
	 ret			;not available
	MOVX A,MS%OFL+MS%HBB	;NOT GOOD (NON-SKIP) IF OFFLINE OR BAD HOME BLOCKS
	TDNE A,RNUSTA		;IS THIS DRIVE OFF-LINE?
	RET			;NOT POSSIBLY THE RIGHT NAME IF OFF-LINE!
	HRROI A,NAMBLK		;POINTER TO NAME OF STRUCTURE WHOSE PACK IS ON THIS DRIVE
	MOVE B,STRNAM		;POINTER TO NAME OF STRUCTURE BEING REQUESTED
	STCMP			;COMPARE NAMES
	CAIE A,0		;THE SAME?
	RET			;NO
	retskp			;a good pack

;this routine skips iff a drive is available.  data in "rnublk" is used
;for making the decision

drvav:	MOVE A,RNUSTA		;GET STATUS BITS FOR THIS DRIVE
	TXNE A,MS%OFL+MS%HBB	;OFF-LINE OR BAD BLOCKS?
	RETSKP			;YES, DEFINITELY AVAILABLE
	TXNE A,MS%DIA		;BEING DIAGNOSED?
	ret			;yes, non-skip
	HRROI A,NAMBLK		;GET NAME OF STRUCTURE
	CALL NOTIGN		;NOT BEING IGNORED?
	RET			;IS BEING IGNORED SO NOT AVAILABLE
	MOVE A,RNUSTA
	TXNN A,MS%MNT		;MOUNTED?
	RETSKP			;NOT MOUNTED, SO AVAILABLE
	;...

;STRUCTURE IS MOUNTED, BUT MAYBE AVAILABLE ANYWAY, SINCE THERE MAY
;BE NO USERS OF IT.  LET'S CHECK.  WE MUST BE CAREFUL, HOWEVER, THAT
;A USER DOESN'T START USING IT AFTER WE'VE DECIDED NOONE'S USING IT,
;BUT BEFORE WE GET AROUND TO DISMOUNTING IT!!...

	HRROI A,ALSBLK		;GET POINTER TO ALIAS NAME
	MOVEM A,GSSALS		;STORE IT FOR STRUCTURE STATUS JSYS
	CALL MSGSS		;GET STRUCTURE STATUS
	 JSERR			;UNEXPECTED FAILURE
	MOVE A,GSSSTA		;GET STATUS BITS
	TXNE A,MS%INI+MS%PPS	;BEING INITIALIZED OR PUBLIC
	RET			;YES, SO UNAVAILABLE
	CALL STRFRE		;SKIP IF THIS STRUCTURE NOT IN USE
	 RET			;IN USE, NOT AVAILABLE
	MOVE A,GSSSTA		;GET STATUS BITS
	TXNE A,MS%INI		;BEING INITIALIZED?
	RET			;YES, SO NOT AVAILABLE
	HRROI A,ALSBLK		;GET POINTER TO ALIAS NAME
	MOVEM A,SSSALS		;SET UP FOR SETTING STRUCTURE STATUS
	MOVX A,MS%DIS		;BIT TO SAY "STRUCTURE BEING DISMOUNTED"
	MOVEM A,SSSSTA		;STORE BIT VALUE
	MOVEM A,SSSMSK		;AND WHICH BIT POSITION WE'RE CHANGING
	CALL MSSSS		;DO THE "SET STRUCTURE STATUS"
	CALL STRFRE		;SKIP IF STRUCTURE STILL FREE
	 CAIA			;NOT FREE (SOMEONE USING IT)
	JRST DRIVE5		;IT'S STILL FREE, SO WE CAN DISMOUNT IT
	SETZM SSSSTA		;TURN OFF "IS BEING DISMOUNTED" BIT
	HRROI A,ALSBLK		;POINT AT STRUCTURE
	MOVEM A,SSSALS		;FOR SETTING STRUCTURE STATUS
	CALL MSSSS		;DO IT
	RET			;UNAVAILABLE BECAUSE SOMEONE SNUCK IN
DRIVE5:	HRROI A,ALSBLK		;POINT TO NAME OF STRUCTURE BEING DISMOUNTED
	MOVEM A,DISALS		;STORE IT IN DISMOUNT DATA BLOCK
	CALL MSDIS		;DISMOUNT THE STRUCTURE
	CALL MSRUS		;REREAD STATUS OF THIS DISK UNIT
	JRST DRVAV		;RECONSIDER IT, SHOULD BE AVAILABLE NOW

;THE FOLLOWING ROUTINE SKIPS IFF THE SPECIFIED MOUNTED STRUCTURE IS
;NOT IN USE, I.E. OPEN FILE COUNT, MOUNT COUNT, CONNECTED COUNT ARE 0.
;STRUCTURE REFERENCED IS ASSUMED TO BE IN "ALSBLK".

STRFRE:	HRROI A,ALSBLK		;POINT AT NAME AGAIN (*SIGH*)
	MOVEM A,GSSALS
	MOVEM A,GSUALS		;STORE FOR USER LIST JSYS
	MOVX A,MS%GTC		;PREPARE TO GET CONNECTORS
	MOVEM A,GSUFLG
	CALL MSGSU		;GET LIST OF CONNECTORS
	 JSERR			;UNEXPECTED FAILURE
	HRRZ A,GSUFLG		;GET NUMBER OF JOBS CONNECTED TO THIS STRUCTURE
	JUMPN A,R		;IF NON-0, STRUCTURE IS IN USE
	CALL MSGSS		;GET STRUCTURE STATUS
	 JSERR			;UNEXPECTED FAILURE
	MOVE A,GSSMC		;GET THE MOUNT COUNT
	ADD A,GSSOFC		;ADD IN THE OPEN FILE COUNT
	JUMPE A,RSKP		;NO OPEN FILES, NO MOUNTERS, AVAILABLE
	RET			;SOME USERS, NOT AVAILABLE

;ROUTINE TO SKIP IFF A STRUCTURE ISN'T SET TO BE IGNORED AS A
;MOUNTABLE STRUCTURE.  GIVE IT POINTER TO STRUCTURE NAME IN A.

NOTIGN:	SAVEAC <A,B,C,D>	;DON'T CLOBBER AC'S
	MOVE B,A		;PUT POINTER TO NAME IN B.
	MOVEI A,IGTBL		;LOOK AT TABLE OF IGNORED STRUCTURES
	CALL INTOFF		;DON'T LET TABLE CHANGE WHILE WE'RE LOOKING AT IT!
	TBLUK			;LOOK UP THE STRUCTURE
	CALL INTON		;TURN INTERRUPTS BACK ON
	TXNE B,TL%EXM		;EXACT MATCH?
	RET			;YES, SO BEING IGNORED, SO TAKE NON-SKIP
	RETSKP			;NO, SO AVAILABLE, SO SKIP

;initialization chores of mounter

mntini:	TIME
	MOVEM A,LSTOPR		;ASSUME OPERATOR JUST LEFT
	CALL ANYWAY		;GUARANTEE REQUEST PRINTOUT THE FIRST TIME
	SETZM NOFLG		;OPERATOR HASN'T REFUSED THE MOUNT YET
	MOVE A,STRNAM		;GET POINTER TO PHYSICAL NAME
	BIN			;GET FIRST CHARACTER (ILDB DOESN'T WORK ON -1,,FOO)
	JUMPN B,NAMCHK		;IF NON-0, USER SPECIFYED A PHYSICAL NAME
	SKIPE RMF		;REMOVAL REQUEST?
	JRST MNTRMF		;YES, GO HANDLE STRUCTURE ID DEFAULTING
	MOVE A,SALIAS		;GET POINTER TO ALIAS
	MOVEM A,STRNAM		;ON SMOUNT, DEFAULT STR ID TO ALIAS
	ret

;GET TO HERE WHEN USER HAS SPECIFIIED SPECIFIC PHYSICAL STRUCTURE NAME.
;WE MUST MAKE SURE THAT IF THE ALIAS HE SPECIFYED IS ALREADY MOUNTED,
;THAT IT'S PHYSICAL NAME IS THAT WHICH THE USER GAVE US.  ALSO, IF
;THE STRUCTURE IS NOT MOUNTED, ONLY ENABLED WHEELS, OPRS, AND MAINTENANCE
;PEOPLE ARE ALLOWED TO SPECIFY A DIFFERENT PHYSICAL NAME THAN THE ALIAS.
;THIS IS SO THAT MALICIOUS USERS CAN'T DO THINGS LIKE MOUNTING A AS
;B AND B AS A, ETC.

NAMCHK:	CALL STRMNT		;IS STRUCTURE MOUNTED?
	 JRST NAM1		;NO, SO WE MAY NOT CARE ABOUT PHYSICAL NAME
	HRROI A,NAMBLK		;MOUNTED, GET MOUNTED ONE'S PHYSICAL NAME
	MOVE B,STRNAM		;GET USER'S SPECIFYED PHYSICAL NAME
	STCMP			;COMPARE THEM
	JUMPN A,NAMBAD		;ERROR IF THEY DISAGREE AND STRUCTURE IS MOUNTED

;SPECIFYED ALIAS IS NOT MOUNTED...

NAM1:	SKIPE RMF		;REMOVAL REQUEST??
	RET			;YES, SO ALL PHYSICAL NAMES OF UNMOUNTED STRUCTURES ARE LEGAL
	MOVE A,SALIAS
	MOVE B,STRNAM		;COMPARE ALIAS AND PHYSICAL NAME USER GAVE US
	STCMP			;A=0 IFF THEY ARE THE SAME
	JUMPE A,R		;IF THEY'RE THE SAME, IT'S ALWAYS LEGAL
	CALL PRVCHK		;NOT THE SAME, MAKE SURE USER IS PRIVILEGED
	 JRST NAMBD1		;HE'S NOT, SO THAT'S AN ERROR
	RET			;PRIVILEGED, SO ALLOW IT

;NOW WE KNOW IT'S A REMOVAL REQUEST.  IF USER DIDN'T SPECIFY PHYSICAL
;STRUCTURE NAME, WE HAVE TO FIGURE IT OUT...

MNTRMF:	MOVE A,SALIAS		;GET ALIAS
	MOVEM A,STRNAM		;FIRST ASSUME WE'RE USING ALIAS AS PHYSICAL NAME
	CALL STRMNT		;SKIP IF STRUCTURE BEING REMOVED IS MOUNTED
	 RET			;NOT MOUNTED, USE GIVEN NAME AS PHYSICAL NAME
	CALL DRVINI		;MOUNTED, SO FIGURE OUT WHAT IT'S REAL NAME IS
INI2:	CALL MSRNU		;GET INFO ON A PACK
	 RET			;CAN'T FIND IT, ASSUME NOT REALLY MOUNTED (MAYBE SOME CLOWN DID "REMOVE DSK:")
	MOVE A,RNUSTA		;GET STATUS BITS FOR THIS PACK
	TXNN A,MS%MNT		;MAKE SURE IT'S MOUNTED
	JRST INI2		;NOT MOUNTED, SO LOOK AT NEXT PACK
	HRROI A,ALSBLK		;LOOK AT THIS STRUCTURE'S ALIAS
	MOVE B,SALIAS		;GET ALIAS OF STRUCTURE BEING REMOVED
	STCMP			;COMPARE NAMES
	JUMPN A,INI2		;IF DIFFERENT, WE HAVEN'T FOUND A GOOD PACK YET
	HRROI A,SMSBLK		;POINT TO PLACE TO STORE PHYSICAL NAME
	MOVEM A,STRNAM		;REMEMBER POINTER TO PHYSICAL NAME
	HRROI B,NAMBLK		;POINT TO THIS STRUCTURE'S PHYSICAL NAME
	MOVEI C,0		;END ON NULL
	SOUT			;COPY NAME TO PHYSICAL STRUCTURE NAME CELL
	RET			;DONE


;the following routine prints out the list of available drives, if it
;has changed.  "odrvtb" contains the old list, and "drvtab" contains
;the new list.

pdinfo:	movei d,0		;pointer to drive table
	movei c,0		;number of available drives seen
	MOVEI B,0		;NUMBER OF DISK DRIVES THAT HAVE CHANGED STATE
pd3:	cail d,dtabln		;have we looked at entire table?
	JRST PD4		;LEAVE LOOP
	move a,drvtab(d)	;get word for disk drive
	txnn a,drV%na		;skip if it's not available
	aoj c,			;available, count it
	XOR A,ODRVTB(D)		;GET OLD AVAILABILITY
	TXNE A,DRV%NA		;DID IT CHANGE STATE?
	AOJ B,			;YES, COUNT IT
	aoja d,pd3
PD4:	JUMPE B,R		;JUST RETURN IF NOTHING HAS CHANGED
	HLRZ A,IGTBL		;GET NUMBER OF STRUCTURES BEING IGNORED
	JUMPE A,PD9		;JUMP TO PD9 IF NONE
	CAIN A,1
	TYPE <Structure being ignored: >
	CAIE A,1
	TYPE <structures being ignored: >
	CAIA			;NO COMMA BEFORE FIRST ONE
PD7:	TYPE <, >
	HLRZ B,IGTBL(A)		;GET ADDRESS HOLDING NAME OF STRUCTURE
	UTYPE @B		;PRINT THE NAME
	SOJG A,PD7		;PRINT ALL OF THEM
	TYPE <%_>
PD9:	TIME
	MOVEM A,LASTL		;REMEMBER WHAT TIME WE PRINTED THIS LIST
	SKIPN RMF		;WAITING FOR SOMETHING TO BE REMOVED?
	JRST PDGONE		;NO, SKIP THIS INFO PRINTING
	MOVE A,SALIAS		;GET NAME OF STRUCTURE AWAITING REMOVAL
	MOVEM A,GSUALS		;PREPARE TO GET CONNECTORS TO STRUCTURE
	MOVEM A,GSSALS
	CALL MSGSS
	 JRST PDGONE		;IF CAN'T GET STATUS, ASSUME IT'S DISMOUNTED
	MOVX A,MS%GTC		;PREPARE TO GET CONNECTORS
	MOVEM A,GSUFLG
	CALL MSGSU		;GET CONNECTORS
	 JSERR			;SHOULDN'T FAIL
	HRRZ D,GSUFLG		;GET NUMBER OF CONNECTORS
	CAIE D,0		;PRINT MESSAGE  IF USERS CONNECTED TO STRUCTURE
	TYPE <%S can't be removed while users are CONNECTed to it%_>
	MOVE A,STRNAM		;GET PHYSICAL NAME OF STRUCTURE BEING REMOVED
	CALL NOTIGN		;MAKE SURE IT'S NOT BEING IGNORED
	TYPE <%S unremovable until someone does "^ESET STR %2A: ACKNOWLEDGED" command%_>
	call notign
	aoj d,			;remember that there was a reason it's unremovable
	MOVE B,GSSSTA		;GET STATUS BITS
	TXNE B,MS%INI
	TYPE <%S can't be removed WHILE  It's being initialized%_>
	SKIPN GSSOFC
	SKIPE GSSMC		;IF NON-0 MOUNT OR OPEN FILE COUNT, CAN'T REMOVE IT
	CAIA			;THERE ARE USERS
	JRST PDY		;NO USERS ON IT
	AOJ D,			;REMEMBER THERE WERE USERS
	TYPE <%S can't be removed until users close files on it and SDISMOUNT it%_>
PDY:	CAIN D,0		;RETURN HERE IF ANY CONNECTORS
	TXNE B,MS%INI	;STRUCTURE UNAVAILABLE FOR REMOVAL?
	RET			;YES, SO DON'T BOTHER LISTING AVAILABLE DRIVES
PDGONE:	jumpe c,pdna		;if none availale, go say so
	HRROI A,[ASCIZ /available drives/]
	SKIPE RMF
	HRROI A,[ASCIZ /Packs available for removal and free drives/]
	type <%1A:

Type	Unit	Channel		Str name	Pack #
----	----	-------		--------	------
>
	movei A,0		;pointer to drive table
	movx b,dRv%na		;get "not available" bit
pd1:	cail A,dtabln		;have we looked at the whole table?
	ret			;yes
	tDnn b,drvtab(A)	;skip if drive not available
	call pdtell		;available, list it
	aoja A,pd1		;loop for rest of drives

;ROUTINE TO PRINT OUT AN AVAILABLE DRIVE, DECODES CONTENTS OF A INTO
;DEVICE TYPE, CHANNEL NUMBER, AND UNIT NUMBER.

PDTELL:	PUSH P,A		;SAVE DRIVE NUMBER
	PUSH P,B		;DON'T CLOBBER BIT BEING TESTED
	IDIVI A,CHNS*UNITS	;LEAVE DEVICE INDEX IN A
	IDIVI B,UNITS		;LEAVE CHANNEL IN B, UNIT IN C
	movem b,rnuchn		;set up for reading drive status
	movem c,rnuunt
	call msrus		;read drive status
	HLRo A,DEVTYP(A)	;get pointer to name of drive type
	type <%1a	%3o	%2o		>	;like "rp04 (unit) 0 (channel) 1"
	MOVE A,RNUSTA		;GET STATUS BITS
	TXNE A,MS%OFL		;OFF-LINE?
	jrst pdol		;this drive is off line
	TXNE A,MS%HBB		;HOMEBLOCKS BAD?
	JRST PDBB		;YES
	hlrz b,rnunum		;get unit within structure
	aoj b,			;add one for "pack 1 of 3" etc.
	hrrz c,rnunum		;get total units in structure
	HRROI A,NAMBLK		;POINT AT STRUCTURE NAME
	type <%1A:		%2d of %3d%_>				;"ps2:  (pack) 1 of 3" for instance
PDEX:	POP P,B			;RESTORE B AND A
	POP P,A			;FOR PDINFO ROUTINE
	RET

pdol:	type <No detectable pack on this drive%_>
	JRST PDEX

PDBB:	TYPE <Bad HOME blocks%_>
	JRST PDEX

;WHEN NO DRIVES ARE AVAILABLE...

PDNA:	SKIPN RMF		;DON'T TYPE THIS IF WAITING FOR STRUCTURE TO BE REMOVED
	TYPE <No drives currently available for mounting new structures...%_>
	RET

;GET TO HERE IF THE OPERATOR TYPES SOMETHING WHILE WE'RE WAITING FOR A
;REQUESTED STRUCTURE TO APPEAR

SMOPR:	MOVEI D,SMERR		;CODE IS "SMOUNT ERROR"
	SKIPE NOFLG		;HAS OPERATOR ALREADY TYPED "NO"?
	JRST REASON		;YES, WE'RE NOW READING THE REASON
	MOVE A,[440700,,OMSG+1]	;NO, THIS IS IT THEN.  SET UP POINTER TO WHAT OPERATOR TYPED.
	CALL GETWRD		;GET THE FIRST WORD
	CAME B,[SIXBIT /NO/]	;DID OPERATOR TYPE "NO"?
	JRST BADNO		;NO, SO COMPLAIN
	SETOM NOFLG		;YES, REMEMBER.
	TYPE <Please type the reason - end with <ret>:%_>
	JRST WAKEUP		;WAIT FOR OPERATOR TO TYPE THE REASON

BADNO:	CALL ANYWAY		;MAKE OPLEAS PRINT OUT THE REQUEST AGAIN
	JRST WAKEUP		;IGNORE THE NON-NO AND WAIT FOR "NO" OR STRUCTURE

;ROUTINE TO MAKE OPLEAS THINK IT'S BEEN A REALLY LONG TIME SINCE THE
;OPERATOR HAS BEEN REMINDED OF THE REQUEST.  THIS IS USED IN PLACES LIKE
;THE FIRST TIME, AND WHEN THE OPERATOR TYPES GARBAGE, IN ORDER TO REMIND
;THE OPERATOR WHAT HE/SHE IS SUPPOSED TO DO.

ANYWAY:	time			;get current time
	sub a,[^d60000*annoyt+1]
	movem a,lastl		;fool opleas into printing the
				;verbose request again (in response
				;to bad typin just received from
				;operator)
	RET

;USER HAS ASKED FOR MOUNTING REMOVAL OF AN ALREADY MOUNTED STRUCTURE,
;AND USER SPECIFYED A PHYSICAL ID, WHICH DOESN'T MATCH THE REAL ONE.

NAMBAD:	MOVEI A,UBLEW		;ERROR DISPATCH
UBLEW2:	MOVEM A,SMEDSP
	RET			;RETURN AND PROCESS ERROR LATER

;OH, IT'S NOW LATER!...

UBLEW:	HRROI B,[ASCIZ /Structure already mounted and wrong STRUCTURE-ID specified/]
	JRST UCON1		;GO PROCESS ERROR

;USER TRIED TO MOUNT A NEW STRUCTURE WITH A DIFFERENT ALIAS THAN THE
;STRUCTURE'S PHYSICAL NAME.

NAMBD1:	MOVEI A,UBLEW1		;ERROR DISPATCH ADDRESS
	JRST UBLEW2		;JOIN COMMON CODE

UBLEW1:	HRROI B,[ASCIZ /OPERATOR, WHEEL, or MAINTENANCE capability required to
 specify STRUCTURE-ID different than alias/]
	JRST UCON1

;ARRIVE HERE WHEN USER HAS REQUESTED REMOVAL OF HIS CONNECTED
;STRUCTURE.  DISALLOW THE REMOVAL, BECAUSE SYSTEM PHILOSOPHY BELIEVES
;EVERYONE HAS A CONNECTED DIRECTORY.  ENFORCE IT.

UCON:	HRROI B,[ASCIZ /Illegal to remove connected structure/]
UCON1:	SETOM SILNTF		;WE DON'T WANT "FINISHED AT..." PRINTED
	JRST GIVERR		;GO GIVE ERROR TO CALLER

;GET TO HERE WHEN GIVING UP AN SMOUNT REQUEST BECAUSE WE WAITED TOO
;LONG FOR THE REQUESTED STRUCTURE TO BE MOUNTED.

GIVEUP:	HRROI B,[ASCIZ /Noone put the structure on line/]
	SKIPE RMF
	HRROI B,[ASCIZ /Noone removed the structure/]
GIVERR:	MOVEI D,SMERR		;CODE IS "SMOUNT ERROR"
GIVE1:	HRROI A,OMSG+1		;PLACE TO PUT REASON
	MOVEI C,0		;END MESSAGE WITH NULL
	SOUT			;STORE REASON FOR FAILURE
	JRST REASON		;FALL INTO CODE THAT SENDS FAILURE REASON

;OPERATOR HAS REJECTED THE MOUNT REQUEST AND TYPED IN THE REASON...

REASON:	MOVE A,D		;GET CODE OF IPCF MESSAGE
	CALL BLURB		;SEND TEXT WITH CODE
	 JRST WAKE13		;COULDN'T TELL USER, SO SAY BYE
	SKIPE RDFLG		;IS THE OPERATOR'S REASON REAL LONG?
	 JRST WAKE1		;YES, READ THE REST OF IT
	JRST WAKE4		;WE'VE SENT REASON, PROCEED TO NEXT USER

;HERE IF MOUNT JSYS FAILS:  GET ERROR STRING AND SEND TO USER
;AS REASON FOR SMOUNT FAILURE

WHOOPS:	HRROI A,OMSG+1		;PUT MESSAGE WHERE EXEC CAN READ IT FROM
	MOVE B,[.FHSLF,,-1]	;SPECIFY LAST ERROR (GERNERATED BY FAILING MOUNT)
	MOVEI C,0		;NO LIMIT TO MESSAGE LENGTH
	TYPE <?Couldn't mount %S, monitor's reason is:%_	%2E%_>
	ERSTR			;GET REASON THAT MOUNT FAILED
	 JSERR
	 JSERR			;ERSTR FAILED
	MOVEI D,SMERR		;THIS IS AN SMOUNT ERROR
	JRST REASON		;GO TELL USER WHY IT FAILED

;GET TO HERE IF STRUCTURE NOT ON-LINE YET, AND USER REQUESTED NOT
;TO WAIT FOR IT

NOWAIT:	SETOM SILNTF		;IF NEVER ANNOUNCED REQUEST, DON'T ANNOUNCE ABORT EITHER
	HRROI B,[ASCIZ /%Structure not on-line/]
	SKIPE RMF		;DIFFERENT FAILURE MESSAGE FOR REMOVAL REQUEST
	HRROI B,[ASCIZ /%Structure  still on-line/]
	MOVEI D,PLTXT		;JUST SEND TEXT, BUT NOT AS AN ERROR MESSAGE
	JRST GIVE1		;USE COMMON CODE FOR SENDING FAILURE NOTIFICATION

;ROUTINE TO INITIALIZE UNIT, CHANNEL, AND CONTROLLER NUMBER, SO THAT
;ENTIRE DRIVE LIST WILL BE SCANNED.

DRVINI:	SETOM RNUCHN
	SETOM RNUCON
	SETOM RNUUNT
	RET

;THE FOLLOWING ROUTINE TAKES A POINTER IN A TO A STRUCTURE NAME
;(NOT ALIAS).  THE ROUTINE SKIPS IFF THE STRUCTURE IS FOUND ON THE
;LIST OF STRUCTURES ALLOWED TO BE MOUNTED DOMESTICALLY.

DOMQ:	SAVEAC <A,B,C>
	MOVE B,A		;PUT POINTER TO NAME IN B
	MOVEI A,DOMTBL		;POINTER TO TABLE IN A
	TBLUK			;SEE IF STRUCTURE IS IN TABLE
	TXNE B,TL%EXM		;EXACT MATCH WITH SOMETHING?
	RETSKP			;YES, TAKE SKIP RETURN
	RET			;NO, SINGLE RETURN, DOMESTIC MOUNTING NOT ALLOWED

;GET TO HERE WHEN "DOMESTIC" COMMAND SEEN IN COMMAND FILE

DOMSTR:	HRROI A,[ASCIZ /STRUCTURE/]	;GUIDE WORD STRING
	MOVEM A,CMDAT		;SPECIFY GUIDE STRING
	MOVX A,CMNOI		;GET "NOISE" FUNCTION
	CALL CREAD		;READ GUIDE WORDS
	MOVX A,CMFLD		;SPECIFY ARBITRARY FIELD
	CALL CREAD		;READ NAME OF STRUCTURE BEING ALLOWED TO BE DOMESTIC
	HRROI A,ATMBUF		;GET POINTER TO STRUCTURE NAME
	CALL READNM		;COPY THE NAME
	 JRST NOSRUM		;NO ROOM
	MOVE D,A		;REMEMBER ADDRESS OF STRUCTURE NAME STRING
	MOVX A,CMCFM		;GET COMMAND CONFIRMATION
	CALL CREAD		;ASSURE GOOD CONFIRMATION
	HRLZ B,D		;MAKE A TABLE ENTRY
	MOVEI A,DOMTBL		;POINT AT DOMESTIC STRUCTURES TABLE
	TBADD			;ADD THIS STRUCTURE TO TABLE
	 ERJMP DOMFAL		;COULDN'T, GO SEE WHY
	JRST ICOMND		;GO READ NEXT COMMAND

;NO ROOM FOR ANOTHER STRING...

NOSRUM:	TYPE <%%No more room, >
	HRROI A,ATMBUF		;GET POINTER TO NAME AGAIN
	TYPE <Structure %1A: not put on domestic structures list%_>
	JRST ICOMND		;GO GET NEXT COMMAND

;TBADD FAILED WHEN TRYING TO ADD STRUCTURE TO DOMESTIC LIST

DOMFAL:	CALL GETERR		;GET ERROR CODE
	CAIN A,TADDX1		;TABLE FULL?
	JRST TABFUL		;YES
	CAIN A,TADDX2		;ENTRY ALREADY THERE?
	JRST TABDUP		;YES
	TYPE <%%%1E, >
NOS2:	HRRO A,D		;MAKE POINTER TO STRUCTURE NAME
	TYPE <Structure %1A: not put on domestic structures list%_>
NOS1:	CALL STREM		;RELEASE STORAGE TAKEN UP BY STRING
	JRST ICOMND		;GO GET NEXT COMMAND

TABFUL:	TYPE <Domestic structures table full, >
	JRST NOS2		;GO SAY WHICH STRUCTURE DIDN'T GET PUT ON LIST

TABDUP:	TYPE <%%Duplicate domestic structure name %1A:%_>
	JRST NOS1		;GO GET NEXT COMMAND
	SUBTTL COMMANDS

;THIS SECTION HANDLES OPLEAS COMMANDS, WHICH ARE READ FROM A SPECIAL
;FILE

;HERE'S THE "COMNDS" ROUTINE.  ANY PLACE WITHIN OPLEAS THAT A DECISION
;MUST BE MADE WHICH DEPENDS ON COMMANDS THAT MIGHT BE IN THE
;COMMAND FILE, MUST CALL THIS ROUTINE BEFORE MAKING THE DECISION.
;(REMEMBER, SOMEONE MIGHT UPDATE THE COMMANDS FILE WHILE OPLEAS
;IS RUNNING)

COMNDS:	MOVEM P,SAVEDP		;REPARSE MAY HAPPEN FROM DEEPER SUBROUTINES
	MOVX A,GJ%OLD+GJ%SHT	;OLD FILE + SHORT FORM GTJFN
	HRROI B,COMNAM		;GET POINTER TO COMMANDS FILE NAME
	GTJFN			;GET HANDLE ON COMMANDS FILE
	 JRST NOCOMS		;GO HANDLE ERROR GETTING HANDLE
	MOVE B,[70000,,OF%RD]	;BITS FOR OPENING FILE FOR READ
	OPENF			;OPEN COMMANDS FILE FOR READING
	 JRST NOOPEN		;GOT JFN, BUT COULDN'T OPEN FILE
	MOVEM A,COMJFN		;REMEMBER NEW HANDLE ON COMMANDS FILE
	GTAD			;GET CURRENT TIME AND DATE
	MOVE D,A		;D CONTAINS A NUMBER GUARANTEED DIFFERENT FROM FILE WRITE DATE
	MOVE A,COMJFN		;GET HANDLE ON COMMANDS FILE
	MOVEI B,D		;WE'LL READ TIME INTO D
	MOVEI C,1		;ONLY ONE DATUM REQUESTED
	RFTAD			;GET LAST WRITE-TIME FOR COMMANDS FILE
	CAMN D,STAMP		;DIFFERENT THAN LAST TIME WE CHECKED?
	RET			;NO, SO COMMANDS ARE UP TO DATE
	;...
;THERE'S A NEW COMMANDS FILE, SO CLEAR OLD COMMANDS STATUS AND READ
;NEW COMMANDS IN.
	MOVEM D,STAMP		;REMEMBER NEW UPDATE STAMP
	CALL PIOFF		;NO INTERRUPTS DURING COMMAND UPDATE
	MOVEI A,DOMTBL		;PREPARE TO EMPTY THE DOMESTIC STRUCTURES TABLE
	CALL TEMPTY		;EMPTY THE TABLE
	MOVE A,DOMINI		;GET INITIAL STATE OF DOMESTIC TABLE
	MOVEM A,DOMTBL		;CLEAR DOMESTIC STRUCTURES TABLE
ICOMND:	CALL READI		;INITIALIZE FOR COMND JSYS
REPARS:	MOVE P,SAVEDP		;FIX STACK ON REPARSE
	MOVEI A,COMTBL		;GET POINTER TO COMMANDS
	MOVEM A,CMDAT
	MOVX A,CMKEY		;SPECIFY "KEYWORD"
	CALL CREAD		;DO COMND JSYS
	MOVE B,(B)		;GET ADDRESS OF COMMAND'S SUPPORT ROUTINE
	JRST (B)		;DO WHAT THE COMMAND WANTS

;ROUTINE TO DO COMND JSYS.  IT RETURNS IFF A SUCCESFUL PARSE HAPPENS.
;CALL IT WITH THE VALUE FOR THE FIRST WORD OF THE FUNCTION BLOCK IN A.

CREAD:	MOVEM A,FBLOCK
	MOVEI A,SBLOCK
	MOVEI B,FBLOCK		;COMMAND STATE BLOCK AND FUNCTION BLOCK
	COMND			;READ COMMAND NAME
	 ERJMP COMEOF		;ERROR, HOPEFULLY END OF FILE
	TXNE A,CM%NOP		;DID IT PARSE CORRECTLY?
	 JRST NOPARS		;NO, GIVE WARNING AND CONTINUE
	RET			;SUCCESFUL COMND JSYS, RETURN

;GET TO HERE ON BAD COMMAND

NOPARS:	HRROI A,ATMBUF		;GET POINTER TO ATOM BUFFER
	TYPE <%%Command line containing "%1A" being ignored%_>
	JRST ICOMND		;GO INPUT NEXT COMMAND

;GET TO HERE ON COMND JSYS ERROR, HOPEFULLY END OF FILE CONDITION

COMEOF:	CALL GETERR		;GET ERROR CODE
	CAIN A,IOX4		;END OF FILE?
	JRST COMEO1		;YES
COMEO2:	TYPE <%%Command file execution failed, reason:%_%2E.
>

;HERE ON END OF COMMAND FILE...

NOCOMS:			;COULDN'T GET JFN ON COMMAND FILE
COMEO1:	CALL PION		;TURN PI'S BACK ON
	MOVE P,SAVEDP		;GET CORRECT STACK LOCALE
	MOVE A,COMJFN		;GET JFN ON COMMANDS FILE
	CLOSF			;CLOSE IT
	 JFCL			;IGNORE FAILURE
	RET			;RETURN TO CALLER

;ROUTINE TO INITIALIZE POINTERS ETC. FOR COMND JSYS

READI:	SETZM CMFNP
	SETZM CMDAT
	SETZM CMHLP
	SETZM CMDEF		;CLEAR FUNCTION DESCRIPTOR BLOCK
	MOVEI A,REPARS
	MOVEM A,CMFLG		;SET UP REPARSE ADDRESS
	HRL A,COMJFN		;INPUT FROM COMMAND FILE JFN
	HRRI A,377777		;NO EDITING OUTPUT
	MOVEM A,CMIOJ
	HRROI A,CINBUF		;POINTER TO USER'S (FILE'S) INPUT
	MOVEM A,CMRTY		;CONTROL-R BUFFER IS REGULAR INPUT BUFFER
	MOVEM A,CMBFP
	MOVEM A,CMPTR		;POINTER TO NEXT FIELD TO BE PARSED
	MOVEI A,CINLEN*5	;GET LENGTH OF INPUT BUFFER
	MOVEM A,CMCNT
	SETZM CMINC		;NO UNPARSED CHARACTERS YET
	HRROI A,ATMBUF		;POINTER TO ATOM BUFFER
	MOVEM A,CMABP
	MOVEI A,ATMLEN*5	;LENGTH OF ATOM BUFFER
	MOVEM A,CMABC
	SETZM CMGJB		;NO GTJFN BLOCK
	RET
	SUBTTL TEXT

;ERROR OPENING COMMAND FILE, RELEASE JFN, GIVE WARNING AND RETURN
;TO CALLER

NOOPEN:	PUSH P,B		;SAVE ERROR CODE
	MOVE A,COMJFN		;GET JFN OF COMMAND FILE
	CLOSF			;CLOSE IT
	 JFCL			;IGNORE ERROR
	POP P,B			;RETRIEVE REASON THAT OPENF FAILED
	JRST COMEO2		;TYPE REASON AND GIVE UP TRYING TO READ COMMANDS
;'TEXT' RECEIVED.  IF FROM CURRENT PID, MOVE TO BUFFER FOR LATER TYPING.
; IF NOT, SEND 'CONFUSED' TO SENDER

;ACCEPTS:
;Q2/ PID OF SENDER
;P2/ ADDRESS OF SEND PDB

;REACHED VIA JRST FROM IPCINT

;JRSTS TO ENDINT ALWAYS

TEXT:	CAME Q2,CURPID		;IS TEXT FROM CURRENT PID?
	JRST TEXT2		;NO. GO SEND 'CONFUSED' MESSAGE

;TEXT IS FROM CURRENT PID

	HLRZ T1,RMSG		;SAVE NUMBER OF THIS MESSAGE
	MOVEM T1,RCVCNT		; TO SEND BACK WITH 'BYE'
	UTYPE RMSG+1		;TYPE MESSAGE
	JRST ENDINT

;TEXT NOT FROM CURRENT USER. ERROR

TEXT2:	MOVE T2,Q2	;T2/PID SENDING TEXT
	SKIPE DEBUG		;DEBUGGING?
	TYPE <%_D:Received text from PID %2O%_>
	
	MOVEI T2,PLCON		;SEND 'CONFUSED' TO SENDER
	MOVEM T2,SMSG		;CODE FIELD IN MESSAGE
	MOVEM Q2,.IPCFR(P2) 	;SEND MESSAGE TO SENDER OF TEXT
	MOVEI P4,SPDBSZ		;P4/SIZE OF SEND PDB
	CALL SNDMSG		;SEND 'CONFUSED' TO SENDER
	 JFCL			;FAILURE. IGNORE.
	JRST ENDINT
	SUBTTL BYE

;'BYE' RECEIVED.  IF FROM CURRENT USER, SET BIT 0 IN BYEFLG.  IF
;NOT, REMOVE FROM INTERNAL QUEUE.

;ACCEPTS:
;Q2/ SENDER'S PID

;REACHED VIA JRST FROM IPCINT

;JRSTS TO ENDINT ALWAYS

ABORT:	CAMN Q2,CURPID		;DON'T SET FLAG IF QUEUED-UP USER ^C'S
	SETOM ABTFLG		;ABORT IS LIKE BYE BUT DIFFERENT SIGN-OFF MESSAGE
BYE:	CAMN Q2,CURPID		;SENT FROM CURRENT PID?
	JRST [	MOVX T1,1B0	;YES. SET BYEFLG TO SAY USER QUIT
		IORM T1,BYEFLG
		HLRZ T1,RMSG	;LAST MESSAGE RECEIVED BY UPLEASE
		MOVEM T1,TXTCNT	;SAVE TO CHECK AGAINST OUR COUNT
		JRST ENDINT]

;NOT FROM CURRENT USER. REMOVE FROM QUEUE.

	CALL REMPID		;REMOVE PID AND SQUEEZE QUEUE

;IGNORE GOODBYE IF FROM PID NOT IN QUEUE.  PROBABLY RECEIVED FROM
;CURRENT PID AFTER OPERATOR TERMINATED.

	 JFCL			;PID NOT IN QUEUE
	JRST ENDINT
	SUBTTL ONEWAY

;RECEIVED ONEWAY MESSAGE. IF OPERATOR IS FREE, PRINT THE MESSAGE.
;IF NOT, ENTER USER IN QUEUE.  IF USER IS ALREADY IN QUEUE, CHANGE
;THE ENTRY TO POINT TO THE MESSAGE.  STORE THE MESSAGE IN A FREE PAGE

;ACCEPTS:
;Q2/SENDER'S PID

;REACHED VIA JRST FROM IPCINT

;JRSTS TO ENDINT ALWAYS

ONEWAY:
	CAIN Q2,CURPID		;FROM CURRENT USER?
	JRST ONEWA4		;YES
	SKIPN CURPID		;IS THERE A CURRENT PID?
	SKIPE QUECNT		;NO. IS ANYONE IN THE QUEUE?
	JRST ONEWA1		;YES. ADD THIS USER TO QUEUE

;OPERATOR IS FREE. PRINT THIS MESSAGE.

	JRST [	MOVEI P5,RMSG	;P5/ADDRESS OF MESSAGE
		CALL PRTONE	;PRINT THE ONEWAY MESSAGE
		JRST ENDINT]

;SOMEONE IS AHEAD OF THIS USER. PUT IN QUEUE

ONEWA1:
	CALL GETPAG		;STORE MESSAGE IN NEXT FREE PAGE.
				; P5/LOCATION OF MESSAGE AFTER STORED
	 jrst [	TYPE <%_%%NUMBER OF ONE-WAY MESSAGES EXCEEDS MAXIMUM%_>				;failed to get page
	jrst endint]
	MOVE T4,NXTREM		;POINT TO FIRST ENTRY IN QUEUE
ONEWA2:	CAMN Q2,(T4)		;IS THIS THE USER?
	JRST [	MOVEM P5,(T4)	;YES. STORE THE PAGE WHERE THE
		JRST ENDINT]	; MESSAGE IS IN THE QUEUE
	AOS T4			;NO. POINT TO NEXT LOCATION
	CAILE T4,QUEFIN		;AT END OF QUEUE AREA?
	MOVEI T4,QUEBEG		;YES. POINT TO BEGINNING
	CAME T4,NXTADD		;BEYOND END OF LIST?
	JRST ONEWA2		;NO. GO LOOK AT NEXT ENTRY
	
;USER NOT IN QUEUE. ADD TO END OF LIST

	AOS T1,QUECNT		;INCREMENT QUEUE COUNT
	CAILE T1,QUESIZ		;QUEUE OVERFLOWED?
	JRST ONEWA3		;YES. PRINT ERROR
	MOVEM P5,(T4)		;SAVE PAGE WHERE MESSAGE STORED
	AOS T4,NXTADD		;INCREMENT NEXT AVAILABLE LOCATION
	CAILE T4,QUEFIN		;BEYOND END OF LIST?
	JRST [	MOVEI T4,QUEBEG	;YES. RESET TO TOP OF LIST
		MOVEM T4,NXTADD
		JRST .+1]
	JRST ENDINT

;QUEUE OVERFLOWED

ONEWA3:	TYPE<%_%%User queue overflow.%_>
	SOS QUECNT		;DECREMENT COUNT INCREMENTED BEFORE
				; OVERFLOW
	CALL RETPAG		;RETURN PAGE TAKEN BEFORE OVERFLOW (P5 CONTAINS ADDRESS)
	JRST ENDINT

;ONEWAY IS FROM CURRENT USER - PROBABLY DIDN'T GET THE OK IN TIME
;USER HAS NOT RECEIVED ANY MESSAGES, SO TXTCNT WILL BE ZERO

ONEWA4:
	UTYPE RMSG+4		;TYPE MESSAGE
	MOVX T1,1B0		;SET BYEFLG TO SAY USER QUIT
	IORM T1,BYEFLG	
	JRST ENDINT
	SUBTTL FREE SPACE ALLOCATION

;ROUTINE TAKING A STRING POINTER IN A.  IT COPIES THE STRING TO FREE SPACE
;AND TAKES A SKIP RETURN, YIELDING THE POINTER TO THE STRING IN
;A.  IF NO ROOM FOR THE STRING, A NON-SKIP RETURN IS TAKEN AND CONTENTS
;OF A IS INDETERMINATE

READNM:	CALL BCOUNT		;HOW MANY WORDS IN THIS STRING?
	PUSH P,A		;SAVE BYTE POINTER TO STRING BEING STORED
	MOVE A,B		;PUT NUMBER OF WORDS NEEDED INTO A.
	CALL GETMEM		;GET THAT MANY
	 JRST NOREAD		;COULDN'T, SO TAKE NON-SKIP RETURN
	HRRO A,B		;MAKE BYTE POINTER TO SPACE OBTAINED
	EXCH B,(P)		;GET ORIGINAL POINTER, SAVE ADDRESS WHERE STRING WILL BE COPIED TO
	MOVEI C,0		;STORE NULL AT END OF STRING
	SOUT			;COPY THE STRING
	POP P,A			;GET ADDRESS WHERE STRING GOT PUT
	HRRO A,A		;MAKE BYTE POINTER
	RETSKP			;SUCCESFUL RETURN
NOREAD:	POP P,(P)		;BAD RETURN, FIX STACK
	RET			;NO ROOM FOR STRING

;STREM ROUTINE TAKES ADDRESS OF STRING IN A, AND "REMOVES" THE STRING
;FROM THE STRING STORAGE SPACE.  THE SPACE WHERE THE STRING WAS IS
;RETURNED TO FREE SPACE

STREM:	PUSH P,A		;PRESERVE ADDRESS
	HRRO A,A		;MAKE BYTE POINTER
	CALL BCOUNT		;COUNT NUMBER OF WORDS IN THE STRING
	EXCH A,B		;PUT LENGTH IN A, ADDRESS IN B
	HRRZ B,B		;GET RID OF BYTE POINTER P AND S
	CALL RETMEM		;RETURN THE SPACE TO THE FREE POOL
	POP P,A			;RESTORE ADDRESS OF STRING (WHICH ISN'T NO MORE!)
	RET

; /GETMEM/ - ROUTINE TO ASSIGN MEMORY AS REQUESTED
; INPUTS:	A - CONTAINS NUMBER OF WORDS WANTED
; OUTPUTS:	A - NUMBER OF WORDS OBTAINED
;		B - CONTAINS ADDRESS OF WORDS GOTTEN
; RETURNS:	SKIPS IF SUCCESSFUL, NON-SKIP IF NO ROOM

GETMEM:	MOVEI B,DICT			;START WITH HEADER OF ODD LIST
GETM2:	MOVE C,B			;REMEMBER WHO POINTS TO CURRENT
	HRRZ B,0(C)		;B IS NOW CURRENT BLOCK
	JUMPE B,R			;IF 0, WE HAVE REACHED END OF THE ROAD
	HLRZ D,0(B)		;GET SIZE OF CURRENT BLOCK
	CAMGE D,A			;IS IT SUFFICIENT FOR REQUEST?
	JRST GETM2			;NO, SO TRY NEXT BLOCK
GETM3:	HRL B,0(B)		;GET LINK OF CURRENT BLOCK
	HLRM B,0(C)		;MAKE PREV LINK BE WHAT WAS OUR LINK
	HRRZS B			;ISOLATE CURRENT BLOCKS ADDRESS
	CAMN D,A			;IS THIS AN EXACT MATCH ON SIZE?
	RETSKP				;SUCCESS, SKIP RETURN
	PUSH P,A			;SAVE NUMBER OF WORDS
	PUSH P,B			;SAVE ADDRESS
	ADD B,A			;GET FIRST WORD TO RETURN
	SUBM D,A			;NUMBER OF WORDS TO RETURN
	CALL RETMEM		;RETURN THE EXTRA WORDS
	POP P,B			;RESTORE ADDRESS OF BLOCK
	POP P,A			;RESTORE NUMBER OF WORDS
	RETSKP				;SUCCESS, SKIP RETURN

; /RETMEM/ - ROUTINE TO DE-ALLOCATE MEMORY WHEN WE ARE THROUGH WITH IT
; INPUT:	A - CONTAINS SIZE OF BLOCK TO RETURN
;		B - CONTAINS ADDRESS OF BLOCK BEING RETURNED
; OUTPUT:	NONE
; RETURNS: ALWAYS CPOPJ
;

RETMEM:	MOVEI C,DICT			;GET PREV SET UP
RETM3:	HRRZ D,0(C)		;GET PREV'S LINK
	SKIPE	D			;IF CURRENT IS 0 OR
	CAIL D,0(B)		;  ITS ADDRESS IS PAST ADDR OF RETURN BLK
	JRST RETM4			; THEN RETURN BLOCK HERE
	MOVE C,D			;MAKE PREV=CURRENT
	JRST RETM3			;CONTINUE

RETM4:	HRRM D,0(B)		;FORWARD PTR OF RETURNED BLOCK
	HRRM B,0(C)		;FORWARD PTR OF PREV BLOCK
	HRLM A,0(B)		;STORE SIZE OF THIS BLOCK
	ADD A,B			;ADD ADDR+SIZE
	CAIE A,0(D)		;ARE WE RIGHT UP AGAINST NEXT BLOCK?
	JRST RETM5			;NO, CANT COMBINE
	HRRZ A,0(D)		;GET NEXT GUYS FORWARD LINK
	HRRM A,0(B)		;MAKE IT OURS. IE POINT PAST HIM
	HLRZ A,0(B)		;GET OUR SIZE
	HLRZ D,0(D)		;GET HIS SIZE
	ADD A,D			;GET OUR NEW COMBINED SIZE
	HRLM A,0(B)		;STORE INTO RETURNED BLOCK
	HRRZ D,0(B)		;GET LINK OF CURRENT BLOCK
RETM5:	HLRZ A,0(C)		;GET PREV BLOCKS SIZE
	ADDI A,0(C)		;ADD HIS ADDRESS AND SIZE
	CAIE A,0(B)		;DOES HE BUTT RIGHT UP AGAINST US?
	RET			;NO, RETURN WITH NO COMBINATION
	HRRM D,0(C)		;MAKE PREV POINT TO OUR NEXT
	HLRZ A,0(C)		;GET HIS SIZE
	HLRZ B,0(B)		;AND OUR SIZE
	ADD A,B			;COMBINE THE SIZES
	HRLM A,0(C)		;STORE COMBINED SIZE
	RET			;RETURN

;BCOUNT ROUTINE TAKES POINTER TO ASCII STRING IN A.  IT ASSUMES THE
;STRING ENDS WITH NULL AND RETURNS THE NUMBER OF WORDS ENCOMPASSED
;BY THE STRING IN B.  EVERYTHING (EXCEPT B DUMMY!) IS PRESERVED.

BCOUNT:	PUSH P,A		;DON'T CLOBBER AC'S
	PUSH P,C
	PUSH P,D
	MOVEI B,0		;DESTINATION POINTER (NONE BECAUSE WE'RE ONLY COUNTING)
	MOVSI C,377777		;A LARGE POSITIVE NUMBER LONGER THAN STRING BEING COUNTED
	MOVEI D,0		;STOP READING WHEN NULL ENCOUNTERED
	SIN			;COUNT LENGTH OF STRING
	SUB C,[<377777,,0>+4]	;COMPUTE NUMBER OF BYTES READ
	IDIVI C,5		;CHANGE TO WORD COUNT
	MOVN B,C		;RETURN IN B
	POP P,D
	POP P,C
	POP P,A
	RET

  ;GETPAG COPIES A ONE-WAY MESSAGE INTO THE NEXT AVAILABLE FREE PAGE AND
;UPDATES NXTPAG.

;REACHED VIA CALL RETPAG FROM ONEWAY

;RETURNS +1: THERE ARE NO FREE PAGES
;        +2: SUCCESS
;            P5/ADDRESS OF PAGE WHERE MESSAGE STORED

GETPAG:
	SKIPGE P5,NXTPAG	;ANY AVAILABLE?
	RET			;NO.
	MOVE T2,(P5)		;GET NEXT LOCATION AFTER FIRST
	MOVEM T2,NXTPAG		;SAVE AS NEW FIRST AVAILABLE
	MOVSI T3,RMSG		;COPY MESSAGE FROM MESSAGE RECEIVE
	HRR T3,P5		; AREA TO FREE PAGE
	BLT T3,1000(P5)		;TRANSFER ONE PAGE
	RETSKP

;RETPAG RETURNS A PAGE TO THE TOP OF THE FREE PAGE LIST

;ACCEPTS:
;P5/ADDRESS OF PAGE TO RETURN TO FREE SPACE

;RETURNS +1: ALWAYS

RETPAG:
	MOVE T2,NXTPAG		;NEXT FREE PAGE
	MOVEM P5,NXTPAG		;MAKE THIS THE FIRST PAGE
	MOVEM T2,(P5)		;MAKE THIS POINT TO PREVIOUS FIRST PAGE
	RET

;ROUTINE TO EMPTY A TABLE.  PASS ADDRESS OF TABLE IN A.  THIS
;ROUTINE MERELY RETURNS ALL THE STRINGS POINTED TO BY THE TABLE TO
;FREE SPACE

TEMPTY:	SAVEAC <A,B,C,D>
	STKVAR <NEMS,TPTR>
	HLRZ D,(A)		;GET NUMBER OF ENTRIES FOR CLEARING
	MOVEM D,NEMS		;COUNTER FOR HOW MANY ENTRIES TO REMOVE
	MOVEM A,TPTR		;SAVE POINTER TO TABLE ENTRY
TEM1:	SOSGE NEMS		;DONE REMOVING EVERYTHING?
	RET			;YES
	AOS B,TPTR		;PRECEDE TO NEXT TABLE ENTRY
	HLRZ A,(B)		;GET ADDRESS OF STRING
	CALL STREM		;RETURN IT TO FREE SPACE
	JRST TEM1		;LOOP FOR REST OF STRINGS
	SUBTTL QUEST

;'QUESTION' RECEIVED.  FIND USER'S POSITION IN QUEUE AND SEND MESSAGE
;returns 0 if user not there, -1 IF CURRENT PID
;MESSAGE CONTAINS (NUMBER ENTRIES IN QUEUE,,USER'S POSITION)

;ACCEPTS:
;P2/ ADDRESS OF SEND PDB
;Q2/ PID OF SENDER

;REACHED VIA JRST FROM IPCINT

;JRSTS TO ENDINT ALWAYS

QUEST:	
	SETZM P5		;CLEAR USER'S POSITION IN QUEUE
	CAMN Q2,CURPID		;CURRENT PID?
	JRST [	SETOM P5	;YES. RETURN -1
		JRST QUEST1]
	SKIPN QUECNT		;ANYONE IN QUEUE?
	JRST QUEST1		;NO. CAN'T BE IN QUEUE
	HRL P5,QUECNT		;YES. SAVE IN LEFT HALF
	MOVEI P6,1		;INITIALIZE POSITION IN QUEUE
	MOVE T4,NXTREM		;LOOK AT FIRST ENTRY

;SEARCH QUEUE FOR SENDER'S PID

QUEST2:	CAMN Q2,(T4)		;IS THIS THE USER?
	JRST [	HRR P5,P6	;YES. SAVE POSITION IN RIGHT HALF
		JRST QUEST1]
	AOS P6			;NO. INCREMENT POSITION COUNT
	AOS T4			;POINT TO NEXT QUEUE ENTRY
	CAILE T4,QUEFIN		;AT END OF QUEUE AREA?
	MOVEI T4,QUEBEG		;YES. POINT TO BEGINNING
	CAME T4,NXTADD		;BEYOND END OF LIST?
	JRST QUEST2		;NO.
				;YES. NOT IN QUEUE. P5 IS 0.

;SEND MESSAGE. ANSWER IS IN P5

QUEST1:	MOVEI P4,SPDBSZ		;P4/SIZE OF SEND PDB
	MOVEM Q2,.IPCFR(P2)	;RECEIVER
	MOVEI T1,PLANS		;CODE IS 'ANSWER'
	MOVEM T1,SMSG
	MOVEM P5,SMSG+1		;(COUNT,,POSITION) TO MESSAGE
	CALL SNDMSG		;SEND THE ANSWER
	 JRST [	CALL ERR1	;FAILED. RETRY IF OVER RECEIVE QUOTA
		 JRST ENDINT	;RETRY FAILED OR COULDN'T RETRY
		JRST .+1]	;RETRY SUCCEEDED
	JRST ENDINT		;SUCCEEDED
	SUBTTL INTERRUPT ON TELETYPE INPUT 

;INPUT BUFFER WENT FROM EMPTY TO NON-EMPTY.  SET INTERRUPT FLAG.
;IF CAME FROM WAIT, WAKE UP.  IF NOT, RETURN TO WHERE WE WERE BEFORE
;THE INTERRUPT.  
;NOTE: IF USING DDT, TYPING TO IT WILL CAUSE INTERRUPT.  SINCE DDT
;WILL HAVE READ THE CHARACTERS, INPUT BUFFER WILL BE EMPTY.  IN
;THAT CASE, IGNORE THE INTERRUPT.

;REACHED VIA INTERRUPT ON CHANNEL 3

;DEBRKS TO WAKEUP IF CAME FROM WAIT
;          CURRENT LOCATION OTHERWISE

TYPINT:	PUSH P,A
	PUSH P,B		;SAVE SOME AC'S
	MOVEI T1,.PRIIN		;T1/PRIMARY INPUT DEVICE
	SIBE			;IGNORE INTERRUPT IF DDT READ IT
	SKIPA 
	JRST TYPIN2		;INPUT BUFFER IS EMPTY

;THERE ARE CHARACTERS TO BE READ.  SET FLAG

TYPIN1:	SETOM INTFLG		;INDICATE INTERRUPT OCCURRED
	SKIPN WTFLG		;CAME FROM WAITING?
	JRST TYPIN2		;NO. GO BACK TO WHERE WE WERE
	CALL ILEVEL		;WHAT INTERRUPT LEVEL?
	MOVEI B,WAKEUP		;YES. START THE WAKEUP ROUTINE 
	MOVEM B,PCSAV1-1(A)		;CHANGE THE PC

TYPIN2:	POP P,B
	POP P,A			;RESTORE AC'S WE USED
	DEBRK
	SUBTTL CTRL/T INTERRUPT

;OPERATOR TYPED CTRL/T - WANTS TO KNOW CURRENT USER AND NUMBER OF USERS
;WAITING.  TYPE THE ANSWER

;REACHED VIA INTERRUPT ON CHANNEL 1

;DEBRKS TO CURRENT LOCATION

TINT:	MOVEM T1,REGSAV+1
	MOVEM T2,REGSAV+2
	MOVEM T3,REGSAV+3
	SETOM T2		;T2/CURRENT TIME
	TYPE <%_[%T>
	SKIPN CURPID		;IS THERE A CURRENT USER?
	
	JRST [	TYPE <  No current user.]> ;NO.
		JRST TINT1]
	HRROI T1,USER+2		;T1/POINT TO USER DIRECTORY
	TYPE <  Talking to user %1A]> ;YES.
TINT1:	MOVE T2,QUECNT
	TYPE<%_[Number of users waiting = %2D ]%_>
	MOVE T1,REGSAV+1
	MOVE T2,REGSAV+2
	MOVE T3,REGSAV+3
	DEBRK
	SUBTTL CTRL/C INTERRUPT

;OPERATOR WANTS TO QUIT.  IF THERE ARE USERS WAITING, TELL THE OPERATOR
;AND MAKE SURE OPERATOR REALLY WANTS TO QUIT.

;REACHED VIA INTERRUPT ON CHANNEL 2

;DEBRKS TO CURRENT LOCATION IF OPERATOR DECIDES NOT TO QUIT
;HALTS IF OPERATOR DECIDES TO QUIT.

CINT:
	SKIPN QUECNT		;ANYONE IN QUEUE?
	JRST CINT3		;NO. QUIT THEN
	MOVEM 16,REGSAV+16	;SAVE REGISTER 16
	MOVEI 16,REGSAV		;SET UP FOR BLT OF 0 TO REGSAV
	BLT 16,REGSAV+16	;MOVE 0-16 TO REGSAV
CINT1:	MOVE T2,QUECNT		;T2/NUMBER ENTRIES IN QUEUE
	TYPE <%_%2D users waiting. Do you want to quit (Y,N)?>
	HRROI T1,P5		;T1/DESTINATION FOR ANSWER
	MOVX T2,RD%BRK!RD%BEL!5B35 ;T2/STANDARD BREAK PLUS END OF LINE
				; MAXIMUM OF 5 BYTES
	SETZ T3,		;NO CTRL/R BUFFER
	RDTTY
	 JSERR
	MOVE T1,[350700,,P5]	;RESET POINTER TO FIRST CHARACTER
	LDB T2,T1		;LOOK AT FIRST CHARACTER
	CAIN T2,UPPY		;UPPER CASE Y?
	JRST CINT3		;YES.
	CAIN T2,LOWY		;LOWER CASE Y?
	JRST CINT3		;YES.
	CAIN T2,UPPN		;UPPER CASE N?
	JRST CINT2		;YES.
	CAIE T2,LOWN		;LOWER CASE N?
	JRST CINT1		;INVALID ANSWER. TRY AGAIN

;OPERATOR DECIDED NOT TO QUIT

CINT2:	HRLZI 16,REGSAV		;RESTORE REGISTERS
	BLT 16,16
	DEBRK			;RETURN TO WHERE WE WERE

;OPERATOR WANTS TO QUIT

CINT3:	QUIT1
	SUBTTL ILLEGAL INSTRUCTION

;PRINT OUT MESSAGE SAYING WHERE ILLEGAL INSTRUCTION GOT EXECUTED.
;THEN RESTART PROGRAM

ILL:	XCT STKINI		;INITIALIZE STACK IN CASE PDL OVERFLOW
	CALL ILEVEL		;FIND OUT WHAT INTERRUPT LEVEL
	HRRZ B,PCSAV1-1(A)	;GET LOCATION OF BAD INSTRUCTION
	SOJ B,			;POINT RIGHT AT LOCATION OF BADDY
	GETNM			;WHAT'S OUR PROGRAM NAME?
	MOVE C,[SETZ -1]	;CODE FOR GETTING LAST ERROR OF THIS PROCESS
	TYPE <%_?Internal %1X error at location %2O%_?%3E%_>
	JRST START2		;RESTART PROGRAM
	SUBTTL SNDNAM

;SEND NAME TO <SYSTEM>INFO. PID HAS ALREADY BEEN SET BY MUTIL.
;CALLED AT BEGINNING OR WHEN INFO REQUESTS NAME

;ACCEPTS:
;P2/ ADDRESS OF SEND PDB
;P3/ADDRESS OF MESSAGE AREA
;P4/SIZE OF SEND PDB

;REACHED VIA CALL SNDNAM AT EITHER INTERRUPT OR NON-INTERRUPT LEVEL

;RETURNS: +1 SEND FAILED
;         +2 SEND SUCCEEDED

SNDNAM:
	SETZM .IPCFR(P2)	;RECEIVER'S PID (0 FOR INFO)
	MOVE T1,[1,,.IPCII]	;CODE,,ASSIGN NAME
	MOVEM T1,.IPCI0(P3)	; INTO MESSAGE
	SETZM .IPCI1(P3)	;NO DUPLICATE REPLY
	HRROI T1,.IPCI2(P3)	;TRANSFER NAME TO MESSAGE
	HRROI T2,MYNAME
	MOVN T3,NAMSIZ		;T3/ NEGATIVE BYTE COUNT
	SOUT			;TRANSFER, UPDATING POINTERS
	CALL SNDMSG		;SEND NAME TO INFO
	 JRST [	CALL NOINFO	;FAILED. PRINT ERROR
		RET]		;ERROR RETURN
	RETSKP			;SUCCESS
	SUBTTL UNDEL

;UNDELIVERED MAIL RECEIVED.  IF FROM INFO, INFO HAS DIED, SO PRINT MESSAGE.
;IF FROM CURRENT USER, TERMINATE.  IF FROM USER IN QUEUE, REMOVE
;FROM QUEUE.  IGNORE ALL OTHERS

;ACCEPTS:
;Q1/FLAG WORD RECEIVED
;Q2/ SENDER'S PID

;REACHED VIA JRST FROM IPCINT

;JRSTS TO ENDINT ALWAYS

UNDEL:	JXE Q1,IP%CFC,UNDEL1	;FROM SYSTEM?
	LOAD T2,SYSTEM,Q1	;YES. LOAD SENDER CODE
	CAIE T2,.IPCCF		;FROM INFO?
	JRST ENDINT		;NO. IGNORE
	TYPE <%_?System jobs not running.%_>
	JRST RESTRT		;GO START OVER

;NOT FROM SYSTEM. 

UNDEL1:	CAMN Q2,CURPID		;FROM CURRENT PID?
	JRST [	MOVX T1,1B0	;YES. SET BYEFLG TO INDICATE
		IORM T1,BYEFLG	; USER QUIT
		TYPE <%_%%Contact lost.%_>
		JRST ENDINT]
	CALL REMPID		;NO. REMOVE FROM QUEUE
	 JFCL			;USER NOT IN QUEUE. IGNORE
	JRST ENDINT		;SUCCESS
	SUBTTL ERROR RECEIVED

;MESSAGE HAS BEEN RECEIVED WITH ERROR FIELD SET IN FLAG WORD. IF ERROR IS 
;'SEND INFO YOUR NAME', DO IT.  PRINT MESSAGE ONLY IF DEBUGGING.

;ACCEPTS:
;Q1/ FLAG WORD RECEIVED

;REACHED VIA JRST FROM ICPINT

;JRSTS TO RESTRT IF SEND TO INFO FAILED
;         ENDINT IF SEND TO INFO SUCCEEDS OR IS NOT NEEDED

RCVERR:	LOAD P5,ERROR,Q1	;LOAD ERROR FIELD
	CAIN P5,.IPCSN		;IS THIS 'SEND INFO YOUR NAME'?
	JRST [	MOVEI P2,SPDB	;YES. P2/ADDRESS OF SEND PDB
		MOVEI P4,SPDBSZ	;P4/SIZE OF SEND PDB
		MOVEI P3,SMSG	;P3/ADDRESS OF SEND MESSAGE
		CALL SNDNAM	;SEND INFO OUR NAME
		 JRST RESTRT	;FAILED
		JRST ENDINT]	;SUCCEEDED
	CAIN P5,.IPCDN		;NO. DUPLICATE NAME?
	JRST [	TYPE <%_?Operator ID in use.%_>				;YES. START OVER
		JRST RESTRT]	;GO TO START OVER

	CAIN P5,.IPCEN		;ILLEGAL NAME?
	JRST [	TYPE <%_?Illegal operator ID.%_>				;YES.
		JRST RESTRT]

;UNKNOWN ERROR

	SKIPN DEBUG		;NO. DEBUGGING?
	JRST ENDINT		;NO. IGNORE ERROR
	MOVE T2,P5		;T2/ERROR CODE
	TYPE <%_D:Error received: %2O%_>		;YES. PRINT ERROR CODE
	JRST ENDINT
	SUBTTL MSEND ERROR

;AN ERROR OCCURRED IN SENDING A MESSAGE
;IF RECEIVER HAS EXCEEDED RECEIVE QUOTA, WAIT AND RETRY.
;OTHERWISE. ASSUME USER QUIT AND SIMULATE RECEIVING A 'GOODBYE'
;ACCEPTS
;T1/ERROR CODE AS RETURNED FROM MSEND
;P2/ADDRESS OF PDB (SENT TO SNDMSG)
;P4/SIZE OF PDB (SENT TO SNDMSG)

;REACHED VIA CALL ERR1 FROM INTERRUPT OR NON-INTERRUPT LEVEL ROUTINE

;RETURNS +1 NOT A QUOTA PROBLEM OR RETRY FAILED
;        +2 SEND SUCCEEDED ON FIRST OR SECOND TRY

ERR1:	CAIE T1,IPCFX7		;RECEIVER OVER QUOTA?
	JRST ERR1A		;NO. SOME OTHER ERROR
	MOVEI T1,^D10000	;YES. SET TIME TO WAIT
	DISMS			;WAIT BEFORE RETRYING
	CALL SNDMSG		;TRY AGAN
	 JRST ERR1A		;FAILED AGAIN
	RETSKP			;RETRY SUCCEEDED
ERR1A:	CAIE T1,IPCFX4		;PID NOT THERE?
	JRST ERR1B		;NO. SOME OTHER ERROR
	TYPE <%_%%Contact lost%_>				;YES.
	JRST ERR1C

;UNKNOWN ERROR

ERR1B:	JSERR			;PRINT THE ERROR

;SET BYEFLG TO SAY USER QUIT BUT NOT OPERATOR.  DON'T WANT TO
;SEND GOODBYE IF USER ALREADY WENT AWAY

ERR1C:	MOVX T1,1B0		;SET BYEFLG TO SAY USER QUIT
	MOVEM T1,BYEFLG
	RET			;FAILURE RETURN
	SUBTTL NO <SYSTEM>INFO

;SEND TO <SYSTEM>INFO FAILED. PRINT MESSAGE.

;ACCEPTS:
;T1/ERROR RETURNED BY MSEND

;REACHED VIA CALL NOINFO 

;RETURNS +1: ALWAYS

NOINFO:	CAIE T1,IPCF19		;NO PID FOR SYSTEM INFO?
	JRST [	JSERR		;NO. SOME OTHER ERROR
		RET]
	TYPE <%_?System jobs not running%_>				;YES.
	RET

;ROUTINES TO SET AND RESET USER CAPABILITIES

ENBCAP:	MOVX T1,.FHSLF		;OURSELF
	RPCAP			;CURRENT CAP
	MOVEM T3,CAPAB		;SAVE
	TXO T3,SC%IPC!SC%WHL!SC%OPR ;ENABLE OTHERS (IF POSSIBLE)
	EPCAP			;...
	RET			;RETURN

RSTCAP:	MOVE T3,CAPAB		;GET OLD CAP
	MOVX T1,.FHSLF
	EPCAP			;RESET THEM
	RET			;RETURN
SUBTTL UUO HANDLER

UUOTAB:	ITRAP			;UUO 0 IS ILLEGAL
	ETYPE			;UUO 1 GENERATED BY "TYPE" MACRO
	ERRUUO			;UUO 2 GENERATED BY "ERROR" MACRO
	WRNUUO			;UUO 3 GENERATED BY "WARN" MACRO
UUOLEN==.-UUOTAB


UUOH:	CALL PIOFF		;NO INTERRUPTS WHILE DOING UUO
				;CAUSE IPCF INTERRUPT WOULD SET UP Q2,
				;AND THEN UUOH WOULD "RESTORE" IT!!
	PUSH P,UUOACS		;SAVE OLD SAVED AC0
	MOVEM 0,UUOACS		;SAVE AC0
	HRRI 0,1(P)		;PREPARE TO STORE BLOCK ON STACK
	HRLI 0,UUOACS+1		;STORING REST OF UUOACS
	ADJSP P,16		;LEAVE ROOM FOR THE OTHER 16 AC'S
	PUSH P,A		;DON'T CLOBBER A
	MOVE A,0		;COPY THE BLT POINTER
	BLT 0,15(A)		;MOVE UUOACS BLOCK ONTO THE STACK
	POP P,A			;RESTORE A
	MOVEM 16,UUOACS+16	;SAVE 16 FIRST, SINCE WE NEED IT FOR BLT POINTER
	MOVE 16,[1,,UUOACS+1]	;(WE'VE ALREADY SAVED AC0)
	BLT 16,UUOACS+15	;SAVE AC'S HERE FOR READING IN UUO ROUTINES
	LDB A,[331100,,40]	;GET OPCODE OF THE UUO
	CAIL A,UUOLEN		;MAKE SURE IT'S A LEGAL VALUE
	ERROR <Illegal instruction executed in OPLEAS>
	CALL @UUOTAB(A)		;DO THE UUO'S WORK
	MOVSI 16,UUOACS
	BLT 16,16		;RESTORE AC'S AS THEY WERE BEFORE UUO
	HRLI 0,-15(P)		;PREPARE TO BLT FROM STACK INTO UUOACS
	HRRI 0,UUOACS+1		;DON'T CLOBBER UUOACS+0 YET
	BLT 0,UUOACS+16		;RESTORE UUOACS+1 THROUGH UUOACS+16 AS THEY WERE BEFORE UUO
	MOVE 0,-16(P)		;GET UUOACS+0 BEFORE UUO
	EXCH 0,UUOACS		;RESTORE UUOACS+0 AND 0 AS THEY WERE BEFORE UUO
	ADJSP P,-17		;UNDO THE STACK
	CALL PION
	RET			;RETURN TO CALLER

;TYPE FOO
;THIS UUO TYPES "FOO".  IF % APPEARS IN FOO, MEMORY LOCATION CONTAINING
;DATA APPEARS AFTER %, AND CHARACTER AFTER NUMBER TELLS HOW TO PRINT
;THE DATA.  FOR INSTANCE, "TYPE THERE ARE %4O DAYS OF SCHOOL LEFT"
;USES CONTENTS OF REGISTER 4 AS NUMBER OF DAYS AND PRINTS IT IN OCTAL.

;HERE'S THE TABLE OF LEGAL CHARACTERS THAT MAY FOLLOW A PERCENT:

PERTAB:	"%",,PERCNT		;"%%" IS REGULAR "%"
	"A",,TASCII		;TYPE ASCII STRING
	"C",,TODAY		;CURRENT DATE AND TIME, CONTROL BITS PASSED IN AN AC
	"D",,DECTYP		;DECIMAL NUMBER
	"E",,ERRMES		;TYPE ERROR MESSAGE
	"O",,OCTYPE		;TYPE IN OCTAL
	"S",,STRTYP		;STRUCTURE FOO:, STRUCTURE FOO: (ALIAS BAR:)
	"T",,TIME		;TIME, NO COLUMNATION
	"X",,SIXTYP		;TYPE OUT SIXBIT
	"_",,TEOL		;TYPE CRLF
PERLEN==.-PERTAB

ETYPE:	HRR C,40		;GET ADDRESS OF STRING TO BE TYPED
	HRLI C,440700		;MAKE ASCII BYTE POINTER
ETYPE1:	ILDB B,C		;PUT CHARACTER IN B
	CAIN B,"%"		;ESCAPE SEQUENCE?
	JRST ESCAPE		;YES
	JUMPE B,ETYPED		;NO, WE'RE DONE IF IT'S NULL
ETYPE2:	CALL CHOUT		;OUTPUT THE NON-SPECIAL CHARACTER
	JRST ETYPE1		;LOOP BACK FOR REST OF STRING

ETYPED:	CALLRET PRNTXT		;PRINT THE ACCUMULATED TEXT

ESCAPE:	MOVE A,C		;MOVE BYTE POINTER TO A
	MOVEI B,0		;IN CASE NIN FAILS
	MOVEI C,8		;SPECIFY OCTAL INPUT
	NIN			;READ THE DATA LOCATION
	 JFCL			;IGNORE ERROR, MAYBE THIS FUNCTION DOESN'T TAKE A VALUE ANYWAY
	BKJFN			;BAKSPACE OVER TERMINATOR
	 JSERR
	MOVE C,A		;POINTS TO CHARACTER AFTER NUMBER
	MOVEI A,PERLEN		;INDEX INTO FUNCTION TABLE
	ILDB D,C		;PICK UP CHARACTER FOR FUNCTION TABLE
	CAIL D,141
	CAILE D,172
	CAIA
	TRZ D,40		;MAKE IT UPPER CASE
ESC1:	SOJL A,ESCNF		;JUMP TO ESCNF IF UNDEFINED FUNCTION
	HLRZ P1,PERTAB(A)	;PICK UP CHARACTER FROM TABLE
	CAIL P1,141
	CAILE P1,172
	CAIA
	TRZ P1,40		;DO EVERYTHING IN UPPER CASE
	CAME P1,D		;CORRECT ENTRY?
	JRST ESC1		;NO, KEEP LOOKING
	HRRZ D,PERTAB(A)	;YES, GET ADDRESS OF ROUTINE
	CAIE B,P		;TRYING TO TYPE OUT STACK POINTER?
	CAIA			;NO
	SKIPA B,P		;YES, LOAD DATA
	MOVE B,UUOACS(B)	;GET CORRECT REGISTER CONTENTS FOR ROUTINE
	PUSH P,C		;REMEMBER BYTE POINTER
	CALL @D			;DO THE SPECIAL FUNCTION
	POP P,C			;RESTORE THE BYTE POINTER
	JRST ETYPE1		;CONTINUE TYPING THE STRING

ESCNF:	MOVEI B,"%"
	CALL CHOUT		;IGNORE SPECIAL FUNCTION IF NOT FOUND
	MOVE B,D
	JRST ETYPE2

;THIS ROUTINE TYPES SIXBIT WORD IN B AS SIXBIT CHARACTERS

SIXTYP:	MOVE C,B		;PUT WORD IN C
	MOVE A,[440600,,C]	;POINTER TO SIXBIT CHARACTERS
SIX1:	TLNN A,770000		;HAVE WE DONE 6 CHARACTERS?
	RET			;YES
	ILDB B,A		;READ NEXT CHARACTER
	JUMPE B,R		;RETURN ON NULL
	ADDI B,40		;CHANGE TO ASCII
	CALL CHOUT		;OUTPUT IT
	JRST SIX1

;"%%" IS REGULAR "%"

PERCNT:	MOVEI B,"%"
	CALLRET CHOUT

;TYPE NUMBER IN B IN DECIMAL...

DECTYP:	MOVEI C,5+5		;SPECIFY DECIMAL RADIX
	JRST NUMTP1		;JOIN COMMON CODE

;TYPE ERROR CODE FROM B

ERRMES:	HRROI A,FREESP		;PUT MESSAGE IN FREE SPACE
	MOVEI C,0		;NO SIZE LIMIT
	ERSTR			;GET MESSAGE
	 JSERR
	 JSERR			;UNEXPECTED ERROR TRYING TO PRINT ERROR MESSAGE
	JRST MOVEIT		;PUT MESSAGE IN REAL TYPEOUT BUFFER

;TYPE CURRENT DATE AND TIME, CONTROL BITS IN B

TODAY:	MOVE C,B		;PUT CONTROL BITS IN AC3
	HRROI B,-1		;SPECIFY CURRENT DATE AND TIME
	HRROI A,FREESP		;GET SOME SPACE TO COPY DATA TO
	ODTIM			;TYPE OUT CURRENT DATE AND/OR TIME
	JRST MOVEIT		;COPY DATA TO OUTPUT AREA AND RETURN

;ROUTINE TO TYPE NUMBER IN B OUT IN OCTAL

OCTYPE:	MOVEI C,8		;SPECIFY OCTAL
NUMTP1:	HRROI A,FREESP		;POINTER TO SOME FREE SPACE
	NOUT			;CREATE THE DIGIT STRING
	 JSERR			;SHOULDN'T FAIL
MOVEIT:	MOVEI B,0
	IDPB B,A		;FINISH WITH NULL
	HRROI B,FREESP		;POINT AT NUMBER AGAIN
	CALLRET MOVTXT		;PRINT THE NUMBER AND EXIT

;THIS ROUTINE TYPES "STRUCTURE FOO:" OR "STRUCTURE FOO: (ALIAS BAR:)"
;DEPENDING ON WHETHER FOO AND BAR ARE THE SAME OR NOT.  FOO IS POINTED
;TO BY STRNAM AND BAR IS POINTED TO BY SALIAS.

STRTYP:	MOVE A,STRNAM		;GET PHYSICAL NAME
	MOVE B,SALIAS		;GET ALIAS
	STCMP			;COMPARE THEM
	MOVE D,A		;REMEMBER COMPARISON (0 MEANS THE SAME)
	MOVE A,STRNAM
	MOVE B,SALIAS		;GET NAMES FOR PRINTING
	CAIN D,0		;NAMES THE SAME?
	TYPE <structure %1A:>
	CAIE D,0		;NAMES DIFFERENT?
	TYPE <structure %1A: (alias %2a:)>
	RET

;TIME WITHOUT COLUMNATION

TIME:	HRROI A,FREESP		;SOME SPACE TO PUT IT
	MOVX C,OT%NDA+OT%SCL	;NO DATE + NO COLUMNATION
	ODTIM
	JRST MOVEIT

;THIS ROUTINE TYPES ASCII STRING OUT WHOSE POINTER IS IN B

TASCII:	CALLRET MOVTXT		;THAT WAS HARD!

;TYPE CRLF

TEOL:	TYPE <
>
	RET

;ROUTINE TO PRINT OUT CHARACTER IN B

CHOUT:	PUSH P,A		;DON'T CLOBBER A
	PUSH P,B		;OR B
	PUSH P,C
	PUSH P,D
	LSH B,44-7		;LEFT JUSTIFY CHARACTER AND END WITH NULL
	MOVEM B,FREESP		;PUT IT IN FREE SPACE
	HRROI B,FREESP		;POINT AT CHARACTER
	CALL MOVTXT		;PRINT IT
	POP P,D
	POP P,C
	POP P,B
	POP P,A
	RET

;ROUTINE FOR WARNING MESSAGES, RETURNS.  USE "ERROR" FOR FATAL MESSAGES.

WRNUUO:	HRRO B,40		;GET THE WARNING
	TYPE <%_%%%2A%_>
	RET			;RETURN TO CALLER

;ROUTINE FOR STANDARD ERROR MESSAGES (FATAL ONES, CAUSE RESTART)

ERRUUO:	HRRO A,40		;GET POINTER TO ERROR MESSAGE
	TYPE <%_?%1A%_>
	JRST START2		;GO TO JAIL, GO DIRECTLY TO JAIL, DO NOT PASS GO, DO NOT COLLECT $200

;ILLEGAL UUO HANDLER

ITRAP:	ERROR <Illegal UUO executed>
SUBTTL MISCALLANEOUS ROUTINES

;ROUTINE WHICH RETURNS ERROR CODE FOR LAST ERROR OF PROGRAM.

GETERR:	PUSH P,B		;DON'T CLOBBER B
	MOVEI A,.FHSLF		;REFER TO OURSELF
	GETER			;GET ERROR CODE
	HRRZ A,B		;ISOLATE ERROR CODE
	POP P,B			;RESTORE B
	RET

;TURN INTERRUPTS OFF.  CALL THIS WHEN YOU ARE READING A DATABASE
;WHICH COULD DETRIMENTALLY BE CHANGED BY AN INTERRUPT ROUTINE WHILE
;YOU ARE LOOKING AT THE DATA.

PIOFF:
INTOFF:	PUSH P,A
	MOVEI A,.FHSLF		;OURSELF
	DIR			;TURN OFF INTERRUPTS
	AOS PIFLG		;REMEMBER HOW MANY TIMES IT'S BEEN TURNED OFF
	POP P,A
	RET

;DON'T FORGET TO TO INTERRUPTS BACK ON WHEN YOU'RE THROUGH!

PION:
INTON:	SKIPGE PIFLG		;PI'S ON?
	RET			;YES, SO WE'RE DONE BEFORE WE START
	PUSH P,A
	MOVEI A,.FHSLF
	SOSGE PIFLG		;DECREMENT COUNT BUT ONLY TURN INTS ON IF ENOUGH CALLS HAVE HAPPENED
	EIR
	POP P,A
	RET

;ROUTINE TO FIGURE OUT WHAT INTERRUPT LEVEL WE'RE AT.  RETURNS
;INTERRUPT LEVEL IN A (PROBABLY 1,2, OR 3)

ILEVEL:	PUSH P,B
	PUSH P,C
	MOVEI A,.FHSLF		;OURSELF
	RWM			;WHAT LEVEL INTERRUPT IS THIS
	JFFO B,.+2		;CHANGE TO INTEGER
	ERROR <Interrupt on unexpected level>
	MOVE A,C			;RETURN ANSWER IN A
	POP P,C
	POP P,B
	RET

;ROUTINE WHICH TAKES BYTE POINTER IN A, AND RETURNS SIXBIT WORD IN B.
;UPDATED BYTE POINTER IS LEFT IN A.

GETWRD:	MOVEI B,0		;START WITH 0 AS THE WORD
	MOVE D,[440600,,B]	;POINTER TO WORD WE'RE CREATING
GET2:	ILDB C,A		;PICK UP FIRST FEW CHARACTERS
	CAIE C,11
	CAIN C,40
	JRST GET2		;SKIP BLANKS
	ADD A,[070000,,]	;PREPARE TO REREAD THAT FIRST NON-BLANK
GET1:	ILDB C,A		;PICK UP NEXT CHARACTER OF WORD
	CAIL C,141
	CAILE C,172		;LOWERCASE LETTER?
	CAIA			;NO
	TRZ C,40		;YES, RAISE TO UPPERCASE
	TLNN D,770000		;ROOM FOR ANOTHER CHARACTER?
	RET			;NO
	CAIL C,101
	CAILE C,132		;LETTER?
	RET			;NO, SO WE'RE DONE
	SUBI C,40		;CHANGE TO SIXBIT
	IDPB C,D		;STORE NEXT LETTER
	JRST GET1		;GO BACK FOR NEXT LETTER OF WORD

;ROUTINE TO SKIP IF OPERATOR NOT IN ATTENDANCE.  DECISION IS
;MADE USING "TMON" JSYS AND LOOKING AT "OPERATOR IN ATTENDANCE"
;BIT.

SKPNOP:	PUSH P,A		;DON'T CLOBBER
	PUSH P,B
	MOVEI A,.SFOPR
	TMON			;GET OPERATOR STATUS
	CAIN B,0		;SKIP IF OPERATOR IN ATTENDANCE
	AOS -2(P)		;WE WANT TO SKIP, BECAUSE OPERATOR NOT THERE
	POP P,B
	POP P,A
	RET

END <3,,ENTVEC>