/SI - UWM VERSION 25
/
/COPYRIGHT 1971, 1975		DIGITAL EQUIPMENT CORPORATION
/				MAYNARD, MASSACHUSETTS
/
/EXTENSIVELY MODIFIED AND CORRECTED BY:
/	RICHARD BARTLEIN, 1974, 1976
/	UNIVERSITY OF WISCONSIN, MILWAUKEE
/
	*0
	CLA CLL
C6201,	CDF		/CHANGE TO FIELD ZERO
	JMP I .+1
SI1,	COM
SKIP=	JMS I .
	SKIPS

	*10
IX1,	0	/SI AUTO-INDEX REGISTERS
IX2,	0
IX3,	0
IX4,	0

C0002,	2
C0003,	3
C0004,	4
C0005,	5
C0006,	6
C0007,	7
C0010,	10
C0037,	37
C0100,	100
C0200,	200
C0400,	400
C1000,	1000
C4000,	4000
C7637,	7637	/MASK FOR CLEANING THE PROTECTION-CODE
C7700,	7700
C7770,	7770
P7777,	-1

/WORDS USED BY 'SI' IN FIELD 0
COMCNT,	SIDATA
COMDSP,	SIDATA+1
COMPTR,	SIDATA+2	/LAST DDB EXAMINED
SICHAR,	SIDATA+3
SIFLG,	SIDATA+4
SIREG,	SIDATA+5
SIREGA=	SIDATA+5

CONDVA,	CONDBA
TTYCHR,	TTCHAR

SIBUF,	F1BUF	/SAVED FETCH POINTERS
SIECNT,	F1ECNT
SITCNT,	F1TCNT
SIJOB,	0
SIKBD,	0
CHDFA,	0	/TEMP LOC USED BY MANY ROUTINES
CHDF=	6221
COMDB0,	0	/ADDRESS OF COMMAND DDB
COMDBT,	0	/SET TO POINT TO CHARACTER TOTAL IN INPUT DDB
COMRDB,	0	/RESPONSE DDB ADDRESS
COMBFA,	COMBUF-1
COMTBE,	0	/COMMAND TABLE ENTRY ADDRESS
COMFLG,	0	/COMMAND CONTROL FLAGS
FRECTA,	FRECNT
IOTPAR,	.	/IOT PARAMETER BLOCK
IOTP0,	0
IOTP1,	0
IOTP2,	0
IOTP3,	0
IOTP4,	0
IOTP5,	0
IOTP6,	0
IOTP7,	0

/***** CHAR & NUMHO MUST REMAIN ADJACENT FOR 'ASCOUT' *****
CHAR,	0	/CURRENT SCAN CHARACTER
NUMHO,	0	/HIGH ORDER FOR NUMBIN
	0
	0

ACCTIN=	JMS I .
	ACC0
ASCOUT=	JMS I .
	ASCOU0	/ASCII OUTPUT
ASCSIX=	JMS I .
	ASCSI0	/ASCII TO SIXBIT
ASSCOR=	JMS I .
	ASSCO0
BLT=	JMS I .
	BLT0	/BLOCK TRANSFER
BUFDEL=	JMS I .
	BUFDE0	/BUFFER DELETE
CALFIP=	JMP I .
	CALFI0	/FIP OVERLAY
CHKACT=	JMS I .
	CHKAC0	/CHECK TYPE OF USER
CHKIO=	JMS I .
	CHKIO0	/CHECK IF I/O IS ACTIVE
CLRPRV=	JMS I .
	CLRPV0	/CLEAR JOB'S PRIVILEGE BIT
COMGET=	JMS I .
	COMGE0	/GET COMMAND STRING CHARACTER
COMWAT=	JMP I .
	COMWT0	/COMMAND WAIT
CORE=	JMS I .
	CORSRC	/FIELD 0 CORE-SEARCH
CORES=	JMS I .
	CORSER
DECRCT=	JMS I .
	DECRC0	/DECREMENT COMCNT
ENDTST=	JMS I .
	ENDTS0	/TEST FOR END OF COMMAND
EXIT=	JMP I .
EXITA,	COMEXT
GETBLK=	JMS I .
	GETB	/GET A BLOCK FROM FREE-CORE
GETDDB=	JMS I .
	GETDB0	/GET A DEVICE DATA-BLOCK
GETFBL=	JMS I .
	GETFB0	/GET FREE BLOCK
GETJTA=	JMS I .
	GETJTB	/GET ADDRESS OF LINKED ENTRY
GETNAM=	JMS I .
	NULLNA	/GET A PROGRAM NAME
GETTBA=	JMS I .
	GETTB0	/GET JOB TABLE ADDRESS
GETWRD=	JMS I .
	GETWR0	/GET STATUS WORD
NUMBIN=	JMS I .
	NUMBI0	/NUMBER CONVERT
OCTASC=	JMS I .
	OCTAS0	/OCTAL TO ASCII
PRINT=	JMS I .
	PRINT0	/QUEUE A CHARACTER FOR PRINTING
REBOOT=	JMS I .
	RBOOT	/INITIATE AUTOMATIC RESTART
RELCOR=	JMS I .
	RELCO0
RESDDB=	JMS I .
	RESPDB	/GET RESPONSE DDB
RETBKS=	JMS I .
	RETBK0	/RETURN BLOCKS
RETBLK=	JMS I .
	RETB	/FIELD 0 ROUTINE TO RETURN A BLOCK
RETDBL=	JMS I .
	RETDB0	/RETURN BLOCK
RETPAR=	JMS I .
	RETPA0	/RETURN PARAMETERS
SETJOB=	JMS I .
	SETJB0	/SET UP 'JOBDAT'
SIERR=	JMS I .
	SYSER0
TEXTS=	JMS I .
	CTEXT	/ASCII READ
WAIT=	JMP I .
	WSCHED	/RESCHEDULE

COMERA,	COMERR	/ERROR RETURN
COMES1,	COMLGM

/***** CRITICAL!!! THESE TWO WORDS MUST NOT BE MOVED!!! *****
	IFNZRO 147-.&4000	<GLITCH>
	*147	/MUST BE AT 0147 FOR BOOTSTRAP!!!
	150	/ THIS OVERLAYS 7750 & 7751 DURING
	150	/ BOOTSTRAP READ!!

COMEXA,	COMRET	/OK RETURN
COMEXP,	COMRET	/FOR RESETTING COMEXA
COMSET,	RESTBP
CORTBA,	CORTBL-1
DEVTBA,	DEVTBL
DEVTND,	-DEVTBE+1	/ADDRESS OF LAST KEYBOARD ENTRY
DSUTBA,	DSUTBL
IOTEND,	FIPEND
JOBA,	JOB
JOBDAT,	CJOBDA		/POINTER TO JOB STATUS ENTRY
JOBTBA,	JOBTBL
LNGIOT,	FOPEN1	/LONG IOT
MJBMAX,	-JOBMAX
SHTIOT,	ACSET	/SHORT IOT
SWBASE,	SWDEX	/START OF SWAPPING TRACKS
TTYTBA,	TTYTBL	/START OF TTY TABLE
CORJOB,	0	/JOB-WORD FOR SPECIAL CORE-ASSIGNS
ERRFLG,	0	/NON-ZERO IF A COMMAND ENDED IN ERROR
ILLMSG,	ILLREQ	/"ILLEGAL REQUEST" MESSAGE

/COMMAND CONTROL FLAGS

NOLOG=	4000	/LOGIN NOT REQUIRED
USERM=	2000	/REFERENCES USER MEMORY
USAVE=	1000	/SAVE USER REGISTERS
UREST=	400	/RESTORE USER REGISTERS
PRBUF=	200	/PRINT BUFFER
PRQM=	100	/PRINT ?
PRCRLF=	20	/PRINT CRLF
NOMESS=	10	/PRINT NO MESSAGE (CURRENTLY UNUSED)
/
/BITS 9-11 CONTAIN # FREE BLOCKS REQUIRED
	PAGE

/SI IS ENTERED HERE FOR EACH COMMAND PROCESSED. WE SCAN
/ALL THE INPUT DDB'S FOR COMMANDS TO PROCESS. WHEN
/WE CAN FIND NOTHING ELSE TO DO, WE ZERO 'COMCNT' IN
/FIELD 0 & EXIT.

COM,	DCA ERRFLG	/CLEAR THE ERROR-FLAG
	DCA COMFLG
	DCA CORJOB
	TAD I JOBA
	AND C0037
	DCA SIJOB
	TAD SIJOB
	SZA CLA		/DO WE ALREADY HAVE A JOB #?
	JMP COMFIP	/YES - WE HAVE AN ERROR OR ARE RETURNING FROM FIP
	TAD I COMPTR
	DCA IX1
	TAD IX1
	DCA IOTP0
	DATFLD
COM1,	DCA COMRDB
	TAD DEVTND
	TAD IX1
	SZA CLA		/END OF TABLE?
	JMP COM2	/NO
	STA
	TAD DEVTBA	/YES. RESET TO BEGIN OF TABLE
	DCA IX1
COM2,	TAD I IX1	/GET TABLE ENTRY
	SZA
	JMP COM3
COM4,	TAD IX1
	CIA
	TAD IOTP0
	SZA CLA		/SCANNED ENTIRE TABLE?
	JMP COM1	/NO
	CDF
	DCA I COMCNT	/YES - CLEAR THE COMMAND COUNT
COMWT0,
COMEXT,	RELCOR		/RELEASE COR
	CDF
	DCA I COMDSP
	CIF
	WAIT		/RESCHEDULE

COM3,	DCA COMDB0	/SAVE THE INPUT-DDB LOC.
	TAD I COMDB0	/GET THE DDB STATUS-BITS
	AND COMDSI
	SNA CLA		/IS HE IN COMMAND MODE?
	JMP COM4	/NO
	TAD DEVTBA
	CIA
	TAD IX1
	CLL RAR
	DCA SIKBD	/SAVE HIS KEYBOARD NUMBER
	TAD COMDB0
	DCA IX2
	TAD I IX2	/YES - GET OWNER'S JOB NUMBER
	AND C0037
	DCA SIJOB
	CDF
	TAD IX1
	DCA I COMPTR	/ & SAVE THE COMMAND POINTER
	RESDDB		/SET UP 'COMRDB' FOR EVERYONE
	CLA
	DATFLD
	TAD SIJOB
	SNA		/IS HE LOGGED IN?
	JMP COM31	/NO
	TAD JOBTBA	/YES - SET UP HIS JOB-DATA POINTER
	DCA CHDFA
	TAD I CHDFA
COM31,	DCA I JOBDAT
	TAD I JOBDAT
	CHDF
	SNA CLA		/IS HE LOGGED IN?
	JMP .+6		/NO
	GETWRD		/YES - CHECK THE 'HLT' BIT
	 JOBSTS
	AND COMSTP
	SZA CLA		/IS THIS A 'HLT' CALL?
	JMP I COMHLT	/YES
	DATFLD
	TAD I COMDB0	/NO - GET THE DDB STATUS-BITS
	AND COMBIT
	SNA CLA		/IS THERE A COMMAND OR A CTRL/C WAITING?
	JMP COM4	/NO
	TAD I IOTP7
	AND COMINH
	DCA I IOTP7	/TURN OFF HIS ERROR-INHIBIT FLAG
	JMS I COMSET	/SET THE BUFFER POINTERS FOR 'COMGET'
	TAD SIJOB
	CDF
	TAD I JOBA
	DCA I JOBA
	DATFLD
	TAD I COMDB0
	CHDF
	AND COMCOM
	SNA CLA		/IS THERE A COMMAND WAITING?
	JMP I .+2	/NO - MUST BE A CTRL/C
	JMP I .+2	/YES - GO SCAN IT
	SICTLC
	COM41

COMBIT,	SICOM+CTRLC+DECHO
COMCOM,	SICOM+DECHO
COMHLT,	PRGHLT
COMINH,	-JSINER-1
	IFNZRO JSHLT-200	<GLITCH>
COMSTP=	C0200	/JSHLT
	IFNZRO DSI-1000		<GLITCH>
COMDSI=	C1000	/DSI
	IFNZRO SICOM-100	<GLITCH>
COMSIC=	C0100	/SICOM
COMFND=	IOTP7	/COUNT OF SEARCH MATCHES
COMLNK=	IOTP5
COMNXT=	IOTP6
COMFIP,	TAD I COMDSP
	SNA		/RETURNING FROM SI CALL?
	JMP COMFI2	/NO - MUST BE ERROR
	DCA IOTP0	/YES - SAVE DISPATCH ADDRESS
	DCA I COMDSP
	TAD I SIFLG	/RESTORE CONTROL FLAGS
	DCA COMFLG
	TAD I SICHAR
	DCA CHAR
	TAD I COMPTR
	DCA COMDB0
	DATFLD
	TAD I COMDB0
	DCA COMDB0
	TAD I JOBDAT
	SNA		/JOB LOGGED-IN?
		IFNZRO DEBUG <
	REBOOT		/NO - ERROR *****
		>
		IFZERO DEBUG <
	JMP COMFI1	/NO - IN A PRODUCTION SYSTEM, KEEP GOING
		>
	IAC
	DCA CHDFA
	TAD I CHDFA
	AND C0007
	SNA CLA		/WAS THERE A SYSTEM ERROR?
COMFI1,	ISZ IOTP0	/NO - SET TO NORMAL ADDRESS
	RESDDB		/SET UP 'COMRDB' FOR EVERYONE
	CLA
	JMP I IOTP0	/NOW DISPATCH
COMFI2,	JMP I .+1
	SYSERR
	PAGE

COM41,	DATFLD
	TAD I COMDB0
	AND COMECH
	SNA		/IS AN ECHO OF THE LINE WANTED?
	JMP COM43	/NO
	CMA
	AND I COMDB0	/YES - CLEAR THE BIT
	DCA I COMDB0
	COMGET		/IS THE BUFFER EMPTY?
	JMP I COMEXA	/YES - JUST EXIT (ECHOING CR-LF AND MAYBE '.')
	DECRCT		/DECREMENT THE 'BREAK' COUNT
	TAD SIJOB
	SNA CLA		/IS HE LOGGED-IN?
	JMP COM44	/NO - DON'T ECHO HIS LOGIN
	ASCOUT		/THEN TYPE "="
	 COMEQU
	NOP
	JMS I COMPB	/NOW PRINT THE CURRENT LINE
	JMS I COMSET	/ & RESET THE BUFFER POINTERS
	CLA CLL CML RTL
	ENDTST		/LAST CHARACTER A LINE TERMINATOR?
	JMP COM45	/YES - SCAN THE LINE
	JMP COM44	/NO - JUST EXIT
COM43,	COMGET		/GET A CHARACTER
	JMP COM44	/NONE LEFT - JUST EXIT
	CLA CLL CML RTL
	ENDTST		/END-OF-LINE?
	JMP COM45	/YES - PROCESS THE COMMAND
	JMP COM43	/NO - KEEP CHECKING
COM44,	JMS CLRSI	/COMMAND INCOMPLETE - CLEAR THE FLAG
	COMWAT		/ AND WAIT FOR THE REST

COM45,	JMS I COMSET	/RESET THE POINTERS
	DCA CHAR
	TAD COMBFA	/GET COMMAND NAME
	TEXTS
	CIA
	TAD COMBFA
	SNA CLA		/NULL STRING?
	JMP COM60	/YES
	DCA COMFND	/CLEAR 'PARTIAL FIND' COUNTER
	TAD COMTBA
COM6,	DCA COMLNK
	TAD I COMLNK
	SNA
	JMP I COM9A	/END OF TABLE
	DCA COMNXT
	TAD COMLNK
	TAD C0003
	DCA IX2
	TAD COMBFA
	DCA IX3
COM5,	TAD IX2
	CMA
	TAD COMNXT
	SNA CLA		/HAVE WE REACHED THE END OF THIS ENTRY?
	JMP COM99	/YES - WE MAY HAVE AN EXACT MATCH
	TAD I IX3	/NO - GET THE NEXT COMMAND CHARACTER
	SNA		/END OF COMMAND?
	JMP COM8	/YES - WE HAVE A PARTIAL MATCH
	TAD I IX2
	SNA CLA
	JMP COM5
	JMP COM7
COM8,	ISZ COMFND	/PARTIAL MATCH
	TAD COMLNK
	DCA COMTBE
COM7,	TAD COMNXT
	JMP COM6

COM99,	TAD I IX3
	SNA CLA		/IS THERE ANY MORE TO THE COMMAND?
	JMP I COM91A	/NO - WE HAVE AN EXACT MATCH
	JMP COM7	/YES - THEN WE HAVE NO MATCH AT ALL

/GETS HERE IF COMMAND IS NULL STRING.
COM60,	CLA CLL CMA RAL
	ENDTST		/END OF COMMAND REACHED?
	JMP I COM64A	/YES - JUST EXIT
COM12,	DCA COMFLG	/NO - CLEAR ANY OLD COMMAND FLAGS
	TAD SIJOB
	SNA CLA		/NO - IS HE LOGGED IN?
	TAD COMES1	/NO - TYPE "LOGIN PLEASE"
	JMP I COMERA	/YES - JUST ECHO THE COMMAND

/ROUTINE TO CLEAR THE 'SICOM' IN THIS JOB'S DDB.

CLRSI,	0
	DATFLD
	TAD I COMDB0	/GET THE CONTROL-WORD
	AND COMMSI	/ & CLEAR THE BIT
	DCA I COMDB0
	CHDF
	JMP I CLRSI	/THEN RETURN

COMTBA,	COMTBL
COM64A,	COM64
COM9A,	COM9
COM91A,	COM91
COMECH,	DECHO
COMMSI,	-SICOM-CTRLC-DFORC-DECHO-CTRLB-1
COMPB,	COMPBF
COMEQU,	215;215;"=;0
LOGE4,	"S;"Y;"S;"T;"E;"M;" ;"R;"E;"S;"T;"R;"I;"C;"T;"E;"D;0
TALKM1,	215;212;207;"*;"*;" ;"K;0
TALKM2,	"/;0
	PAGE

/ROUTINE TO SEE IF JOB IS RUNNING WHEN COMMAND REQUIRING FIP IS ISSUED.
/IF SO, WE CAN'T HONOR COMMAND
/THE MESSAGE "TYPE ^BS FIRST" IS GIVEN

/CALL	TAD IOT ENTRY FROM COMMAND TABLE
/	JMS FIPCHK
/	RETURN IF OK TO PROCEED  [OTHERWISE RETURN IS TO COMERR]

FIPCHK,	0
	DCA IOTP0	/SAVE THE IOT
	TAD IOTP0
	TAD FIPCDR
	SZA		/IS IT AN 'EXAM'?
	TAD FIPCDW
	SZA CLA		/OR A 'DEPOSIT'? (WE CAN DO THOSE)
	TAD SIJOB	/NO - GET THE JOB NUMBER
	SNA CLA		/IS HE LOGGED-IN?
	JMP I FIPCHK	/NO - THEN HE CAN'T BE ACTIVE
	GETWRD		/YES - IS HIS PROGRAM RUNNING?
	 JOBSTS		/ IF SO HIS RUN BIT IS ON
	SMA		/IS HE ACTUALLY RUNNING?
	AND FIPMSK
	SZA CLA		/NO - IS FIP STILL BUSY FOR HIM?
	JMP FIPCH2	/YES - CAN'T HANDLE THE COMMAND NOW
	ISZ IOTP7
	DATFLD
	TAD I IOTP7	/GET 'STR1'
	RAR
	CMA RAL		/CHECK THE WAIT-MASK FOR EVERYTHING BUT 'JSWAIT'
	ISZ IOTP7
	ISZ IOTP7
	AND I IOTP7	/ANY BITS IN THE MASK NOT SET IN STR1?
	AND FLBITS	/ IN PARTICULAR, FILE I/O BITS
	CHDF
	CLL RAR
	SNA SZL CLA	/ANYTHING ACTIVE THAT WOULD INTERFERE?
	JMP I FIPCHK	/NO - JUST RETURN NORMALLY
	
FIPCH2,	CLA
	TAD COMFLG
	AND FIMRST	/DON'T RESTORE UNSAVED REGISTERS
	DCA COMFLG
	TAD FIPTCB
	JMP I COMERA	/"TYPE ^BS FIRST"

FIPCDR,	-DMAR
FIPCDW,	DMAR-DMAW
FIPMSK,	JSIOT+JSIOTC
FIPTCB,	TYCRLB
FIMRST,	-UREST-1
FLBITS,	JSF0+JSF1+JSF2+JSF3+JSWAIT

/
/ROUTINE TO CLEAR THE 'PRIVILEGE' BIT FOR THIS JOB
CLRPV0,	0
	GETWRD		/GET HIS STATUS-WORD
	 JOBSTS
	AND CLRPV1	/ AND ZAP THE BIT
	DATFLD
	DCA I IOTP7
	CHDF
	JMP I CLRPV0	/THEN RETURN

CLRPV1,	-JSPRIV-1
/
/THIS HANDLES THE 'PROTECT' COMMAND. WE ALTER
/THE PROTECTION CODE OF A FILE; THIS ALSO
/ALTERS THE FILE EXTENSION.
	SIERR
	JMP I IOTEND
PROTEC,	NUMBIN		/FILE #
	 -"7
	JMP I COMERA
	AND C0003
	CLL RTL
	RTL
	RAL
	DCA IOTP1
	NUMBIN
	 -"7
	JMP I COMERA
	AND C7637
	TAD IOTP1
	JMP I SHTIOT

/
/TYPE OUT THE WORDS EXAMINED BY THE 'EXAM' COMMAND
EXAMI1,	CHDF
	ASCOUT
	 CRLF
	JMP I EXAMI5
	TAD IOTP3
	DCA NUMHO
	TAD COMBFA
	DCA IX2		/SET POINTER TO THE BUFFER
EXAMI3,	TAD I IX2	/GET A WORD
	OCTASC		/ CONVERT IT TO ASCII
	 IOTPAR
	ASCOUT		/ AND TYPE IT
	 IOTP0
	JMP I EXAMI5
	ISZ NUMHO
	SKP
	JMP I EXAMI5	/ALL DONE
	ASCOUT
	 SPACE
	JMP I EXAMI5
	JMP EXAMI3

EXAMI5,	DEPOS3

/
/CODE TO INITIATE THE AUTOMATIC SYSTEM REBOOT
RBOOT,	0
	IOF
	CLA
	TAD RBOOT
	CIF
	JMP I .+1	/OFF TO FIELD 0 FOR BOOTSTRAP
	RELOAD
	SIERR
	JMP I IOTEND	/GOOD RETURN FROM FIP
CLOSE,	NUMBIN		/GET THE INTERNAL FILE INDEX
	 -"7
	JMP CLOSE2	/NO MORE NUMBERS - DO THE CLOSE
	AND C0003
	CMA
	DCA IOTP2
	CLA CLL CML
	RAR		/NOW POSITION THE PROPER BIT
	ISZ IOTP2
	JMP .-2
	DCA IOTP2
	TAD IOTP2
	CMA
	AND IOTP1	/ZAP THE BIT
	TAD IOTP2	/ AND THEN SET IT
	DCA IOTP1
	JMP CLOSE	/GO SEE IF THIS IS A MULTIPLE CLOSE

CLOSE2,	TAD IOTP1
	SNA		/WERE WE GIVEN ANYTHING TO CLOSE?
	CLA CMA		/NO - THEN JUST CLOSE EVERYTHING
	JMP I SHTIOT

ASSIND,	"A;"S;"S;"I;"G;"N;"E;"D;0
	PAGE

CSWAP,	FSWP+SI
CUSERM=	CLA CLL CML RTR	/AC =2000
FIPCOM,	FIPCHK

/WE FOUND ONE OR MORE PARTIAL MATCHES ON OUR COMMAND.
COM9,	STA
	TAD COMFND
	SNA CLA		/WAS THERE EXACTLY ONE MATCH?
	JMP COM92	/YES
	TAD AUTOPK	/NO - ASSUME "R" COMMAND
	SKP

/WE FOUND AN EXACT MATCH ON THE COMMAND.
COM91,	TAD COMLNK
	DCA COMTBE
COM92,	ISZ COMTBE	/GET COMMAND FLAGS
	TAD I COMTBE
	DCA COMFLG
	TAD COMFLG
	AND C0007	/GET THE # FREE BLOCKS REQUIRED
	CIA
	CDF
	TAD I FRECTA
	CHDF
	SPA CLA		/ENOUGH FREE-CORE AVAILABLE?
	COMWAT		/NO
	CUSERM		/AC=2000
	AND COMFLG	/USER MEMORY REFERENCE?
	SNA CLA
	JMP COM16	/NO
	TAD SIJOB
	TAD CSWAP
	CORES
	SZA CLA		/YES - IS HE BEING SWAPPED?
	COMWAT		/YES - RE-TRY LATER
COM16,	ISZ COMTBE
	TAD IOTPAR
	DCA IX1
	TAD C7770
	DCA CHDFA
	DCA I IX1
	ISZ CHDFA
	JMP .-2
	TAD I COMTBE	/STORE IOT
	SZA		/NON RESIDENT IOT?
	JMS I  FIPCOM	/YES--IS HE RUNNING A PROGRAM?
	DCA IOTP7	/GETWRD IN FIPCHK MESSES UP IOTP7
	ISZ COMTBE
	TAD I COMTBE
	DCA COMTBE
	TAD COMFLG
	SPA CLA		/LOGIN REQUIRED?
	JMP I COMTBE	/NO. DISPATCH
	TAD SIJOB
	SNA CLA		/NULL JOB?
	JMP I COM12A	/YES - TYPE "LOGIN PLEASE"
	TAD COMFLG	/SAVE REGISTERS?
	AND C1000
	SNA CLA
	JMP I COMTBE	/NO. DISPATCH
	GETTBA
	 JOBREG
	DCA COMREG
	CIF
	BLT
	 DATFLD
COMREG,	 0
	 CDF
	 SIREGA
	 -3
	DATFLD		/PC:=-1
	STA
	DCA I COMREG
	CHDF
	JMP I COMTBE

COM12A,	COM12

/DUMMY COMMAND PACKET FOR THE AUTOMATIC "R" COMMAND
AUTOPK,	.
	USERM+2
	OPEN
	AUTOR
/WE COME HERE TO SET THE PARAMETERS FOR FIP AND START THE
/DISC ACCESS TO SWAP FIP IN. FIP IS THEN STARTED WHEN
/THE OVERLAY IS COMPLETE.

CALFI0,	STA CLL RAL	/SAVE RETURN ADDRESS
	TAD COMTBE
	CDF
	DCA I COMDSP
	TAD COMFLG	/SAVE FLAGS
	DCA I SIFLG
	TAD CHAR
	DCA I SICHAR
	TAD CALFBA
LOADUS,	DCA CALFI2
	ASSCOR		/ASSIGN CORE
	TAD CALFI4
	TAD DSUTBA
	GETFBL
	COMWAT
	DCA CALFI1
	CIF
	BLT
	 CHDF		/SOURCE FIELD
CALFI2,	 0		/SOURCE ADDR
	 DATFLD		/DESTINATION FLD
CALFI1,	 0		/DESTINATION ADDR
OFF1,	 -10
	CIF CDF
	ISZ I DSBSYA	/DISC ALREADY BUSY?
	WAIT		/YES - JUST WAIT
	JMP I .+1	/NO - START UP THE TRANSFER
	OVRLA1
DEPEXA,	TAD CALFI5
	JMP LOADUS

CALFI5,	IOTP0
DSBSYA,	DSBUSY

CALFBA,	.+1
	DMAR
	FIPDEX
CALFI4,	10	/MEMORY EXT IN 7-9
	-FIPWC
	-1
	0
	OVERLA
	0
/'OFFLINE' COMMAND - RESTRICTS NEW LOGINS TO MANAGERS.
/CAN ONLY BE USED BY SYSTEM MANAGER (ACCOUNT # 000X)
/** MUST ** BE IN EFFECT FOR MANAGER #1 TO LOGIN!
/THIS EFFECTIVELY REQUIRES 2 PASSWORDS FOR ACCOUNT 1.
/
/'ONLINE' COMMAND - RESTORES NORMAL LOGINS.
/THEREBY RE-ENABLING SYSTEM. CAN ONLY BE DONE BY MANAGER.
/
OFFLIN,	TAD OFF1	/SET MASK TO 7770
ONLIN,	DCA ON1		/CLEAR ACCOUNT MASK
	CHKACT		/CHECK USER'S ACCOUNT #
	JMP I COMERA	/ORDINARY USER - BAD!!
	JMP I COMERA	/MERE SYSTEMS PERSONNEL
	TAD ON1		/MANAGER - GET ACCOUNT MASK
	DATFLD
	DCA I OFFJOB	/SET THE MASK INTO FIELD 1
	JMP I COMEXA

OFFJOB,	F1OFFJ		/POINTER TO LOGIN ACCOUNT-MASK
ON1=	CALFI1
	PAGE

COMCRF,	PRCRLF
COMFLE=	COMCRF	/FLAG FOR ERROR RETURN
COMQM,	PRQM
COMURE,	UREST
COPBQM,	PRBUF+PRQM	/MORE FLAGS IF NO ERROR MSG
COPRBF,	PRBUF
MSEMI,	-";
MCR,	-215

/HANDLES THE CTRL/C TYPED WHEN A KEYBOARD IS IN 'SI' MODE
/JUST SET 'ERRFLG' SO THE BUFFER IS RE-CLEARED AND EXIT.
SICTLC,	ISZ ERRFLG
	JMP COMRET

COMERR,	DCA COMESA
	ISZ ERRFLG	/INDICATE WE RETURNED IN ERROR
	TAD COMFLG
	AND C7700
	TAD COMFLE	/SET FLAGS FOR ERROR MESSAGE
	DCA COMFLG
	TAD COMESA
	SZA CLA		/ANY MESSAGE TO PRINT?
	JMP COMRET+1	/YES
	TAD COPBQM	/NO - ECHO THE COMMAND W/ "?"
	TAD COMFLG
COM64,	DCA COMFLG	/GETS HERE ON 'NULL' COMMAND

COMRET,	DCA COMESA
	CHDF
	TAD COMFLG
	AND COMURE
	SNA CLA		/RESTORE REGISTERS?
	JMP COMRE0	/NO
	GETTBA
	 JOBREG
	DCA COMRES
	CIF
	BLT		/RESTORE USER'S REGISTERS
	 CDF
	 SIREGA
	 DATFLD
COMRES,	 0
	 -3
COMRE0,	ASCOUT		/START BY TYPING <CR-LF>
	 CRLF
	JMP COMRE3
	TAD COMESA
	SNA CLA		/ANY MESSAGE TO PRINT?
	JMP .+4		/NO
	ASCOUT		/OUTPUT MESSAGE
COMESA,	 0
	JMP COMRE3	/WON'T FIT
	TAD COMFLG
	AND COPRBF
	SZA CLA		/ECHO-PRINT THE BUFFER?
	JMS COMPBF	/YES - PRINT THE WHOLE LINE
COMRE3,	CLA
	TAD ERRFLG
	SZA CLA		/DID WE HAVE AN ERROR?
	CLA CLL CML RTL	/YES - THEN ZAP THE WHOLE BUFFER
	ENDTST		/IS THIS THE LAST CHARACTER IN THE COMMAND?
	JMP COMRE4	/YES
	COMGET		/NO - GET THE NEXT CHARACTER
	SKP		/NONE THERE
	JMP COMRE3	/ OR CHECK AGAIN
COMRE4,	BUFDEL		/DELETE TO CURRENT POINTER
	TAD COMFLG
	AND COMQM
	SNA CLA		/PRINT "?" ?
	JMP COM13	/NO
	ASCOUT
	 QEST
	JMP COM10
COM13,	TAD COMFLG
	AND COMCRF
	SNA		/PRINT <CR-LF>?
	TAD COMESA
	SNA CLA		/DID WE JUST PRINT A MESSAGE?
	JMP COM10	/NO
	ASCOUT
	 CRLF
	NOP
COM10,	TAD CHAR
	TAD MSEMI
	SNA CLA		/LAST CHAR A SEMI?
	JMP I .+2	/YES
	JMP I .+2	/NO
	COM26
	COM20

/ROUTINE TO PRINT THE CURRENT COMMAND BUFFER.

COMPBF,	0
	DCA COMRES	/CLEAR THE 'FULL' FLAG
	DCA CHAR+1	/ *** CHAR+1 MUST BE SCRATCH ***
	JMS I COMSET	/RE-SET THE BUFFER POINTERS
COMPB1,	COMGET		/GET A CHARACTER
	JMP I COMPBF	/NONE - RETURN
	TAD MCR
	SNA CLA		/IS IT <CR>?
	JMP I COMPBF	/YES - RETURN
	TAD COMRES
	SZA CLA		/HAS 'ASCOUT' FAILED?
	JMP .+4		/YES - SAVE TIME LOOKING FOR TERMINATOR
	ASCOUT		/NO - TYPE IT
	 CHAR
	ISZ COMRES	/WON'T FIT - SET 'FULL' FLAG
	CLA CLL CML RTL
	ENDTST		/IS IT A LINE TERMINATOR?
	JMP I COMPBF	/YES - RETURN
	JMP COMPB1	/NO - GET NEXT CHARACTER

LOGE1,	"S;"Y;"S;"T;"E;"M;" ;"F;"U;"L;"L;0
JOBNO,	"J;"O;"B;" ;0
TALKM3,	":;" ;0
WHERAC,	" ;"A;"C;"=;0
	PAGE

/WE GET HERE WHEN THE LAST CHARACTER OF A COMMAND HAS BEEN REACHED.

COM20,	TAD CHAR
	TAD COMCLN
	SZA CLA		/LAST CHAR A COLON?
	JMP COM22	/NO
	TAD SIJOB
	SZA CLA		/USER LOGGED IN?
	JMS JOBATV	/YES - IS A PROGRAM RUNNING?
	JMP COM28	/NO - THEN COLON ISN'T LEGAL
	DATFLD		/YES - SET 'JSDEL' TO INDICATE
	ISZ IOTP7	/ A DELIMITER WAS FOUND
	TAD I IOTP7
	AND COMKEY
	TAD COMKEF
	DCA I IOTP7
COM22,	CHDF
	TAD COMDB0
	SNA CLA		/IS THERE AN INPUT DDB?
	JMP COM25	/NOPE - JUST TYPE "."
	TAD SIJOB
	SNA CLA		/IS HE LOGGED IN?
	JMP COM23	/NO - DELETE THE DDB IF EMPTY
	JMS JOBATV	/IS A PROGRAM RUNNING?
	JMP COM24	/NO - JUST TYPE "."
	DATFLD		/YES - CLEAR 'DSI'
	TAD I COMDB0
	AND COMSIF
	DCA I COMDB0
	ISZ IOTP7	/NOW POINTS TO STR0
	CLA CLL CML RTL
	TAD IOTP7
	DCA NUMHO	/SAVE POINTER TO WAIT-MASK
	CLA IAC
	TAD NUMHO
	DCA NUMHO+1	/ AND TO THE DEVICE WAIT STATUS
	TAD I NUMHO
	SNA
	TAD I NUMHO+1
	SZA CLA		/IS HE IN A NORMAL WAIT?
	JMP .+3		/YES
	TAD I IOTP7
	DCA I NUMHO	/NO - SET THE WAIT-MASK = STR1
	DECRCT		/DECREMENT THE COMMAND COUNT
	EXIT		/ALL DONE - JUST EXIT
COM23,	TAD CHAR
	SZA CLA		/LAST CHARACTER NULL?
	JMP COM26	/NO
	CDF		/YES - END-OF-BUFFER REACHED
	TAD I COMPTR	/GET THE DEVTBL POINTER
	DCA CHDFA
	DATFLD
	DCA I CHDFA	/ZERO THE DEVTBL ENTRY
	CHDF
	TAD COMDB0
	RETDBL		/THEN RELEASE THE DDB
	JMP COM25	/NO STATUS-BIT LEFT TO CLEAR

COM24,	TAD CHAR
	SZA CLA		/WAS THE END OF THE BUFFER REACHED?
	JMP COM26	/NO
	JMS I CLRSIA	/YES - CLEAR 'SICOM' BIT
COM25,	DECRCT		/ AND DECREMENT THE COMMAND COUNT
COM26,	CLA
	ASCOUT		/FINALLY, TYPE "."
	 PERIOD
	NOP
	EXIT		/ AND EXIT

/HERE WE FUDGE UP SOME FLAGS SO WE CAN PRINT A REASONABLE
/ERROR MESSAGE WHEN A COLON IS USED TO END A COMMAND
/AND THERE IS NO PROGRAM ACTIVE TO READ THE REMAINDER
/OF THE BUFFER.
COM28,	TAD CLNFLG
	DCA COMFLG	/SET SPECIAL FLAGS FOR ERROR MESSAGE
	TAD COMCMS
	JMP I COMERA	/THEN TAKE ERROR EXIT

CLNFLG,	PRBUF+PRCRLF+PRQM
CLRSIA,	CLRSI
COMCLN,	-":
COMCMS,	.+1;":;0
COMKEY,	-JSDEL-1
	IFNZRO JSDEL-100	<GLITCH>
COMKEF=	C0100	/JSDEL
COMSIF,	-DSI-SICOM-CTRLC-1

/ROUTINE TO SEE IF THE CURRENT JOB IS ACTIVE AND
/SKIP IF IT IS.

JOBATV,	0
	GETWRD		/GET THE RUN-BIT
	 JOBSTS
	SPA CLA		/IS IT SET?
	ISZ JOBATV	/YES - SKIP NEXT INSTRUCTION
	JMP I JOBATV
/
/END-CODE FOR 'ASSIGN'.
ASSIG9,	ASCOUT		/TELL USER WHAT HE GOT
	 CRLF
	NOP
	JMS ASSUNI
	ASCOUT
	 ASSIND		/TYPE "ASSIGNED"
	NOP
	JMP I COMEXA	/AND LEAVE

ASSOUT,	0		/TYPE CHARACTER IN AC OUT; 
	CIA		/FOLLOWED BY SPACE
	DCA ASSBUF	/CALLED WITH - CHAR IN AC
	ASCOUT
	 ASSBUF		/TYPE STRING
	NOP
	JMP I ASSOUT

ASSUNI,	0	/ROUTINE TO TYPE OUT UNIT NAME
	GETWRD		/FIRST FIGURE OUT WHAT HE WANTED
	 JOBREG		/PC CONTAINS ORIGINAL REQUEST
	AND C0037
	DCA IOTP0	/DEVICE #
	TAD IOTP0	/WHAT KIND OF DEVICE
	TAD C7760
	SPA		/DEVICE #'S .GE. 20 ARE DTA
	JMP ASSG10	/NOT DTA
	DCA IOTP0	/UNIT #
	TAD ASSDD
	JMS ASSOUT	/TYPE "D SPACE"
	TAD IOTP0
	TAD C0260
	CIA
ASSG11,	JMS ASSOUT	/TYPE "N SPACE"; N=0,1,...,7
	JMP I ASSUNI	/RETURN

ASSG10,	TAD ASSTBZ	/END OF ASSIGNMENT TABLE
	DCA IOTP0	/    +UNIT # -5 = PTR TO ASSTBL
	TAD I IOTP0
	JMP ASSG11	/TYPE OUT DEVICE ASSIGNED

ASSDD,	-304		/-D
C0260,	260
C7760,	-20
ASSTBZ,	ASSTBL+1+20
ASSBUF,	0
	240
	0
	PAGE

/GET A TEXT STRING
/CALL	TAD ADDRESS OF BUFFER -1
/	TEXTS
/	RETURN WITH POINTER TO LAST CHAR IN AC

CTEXA,	-"!
CTEXZ,	-"_
CTEXCN,	-":
CTEX6,	-6	/MAXIMUM LENGTH OF STRING

CTEXT,	0
	DCA IX1		/INITIALIZE INDEX
	SKIP		/SKIP SPACES AND TABS
	JMP CTEXT2	/NOTHING LEFT - EXIT
	DCA CTEXNU
	TAD CHAR
CTEXT1,	JMS FIXLC	/CONVERT IT TO UPPER-CASE
	TAD CTEXCN	/BLAME DOUG DYMENT FOR THIS ALTERATION
	CLL RAR
	SNA CLA		/COLON OR SEMICOLON?
	JMP CTEXT2	/YES - END OF STRING
	TAD CHAR
	TAD CTEXA
	SPA CLA		/NO - IS IT A LEGAL NON-BLANK CHARACTER?
	JMP CTEXT2	/NO
	TAD CHAR
	TAD CTEXZ
	SMA SZA CLA	/IS IT .GE. "!" AND .LE. "_"?
	JMP CTEXT2	/NO - THEN IT'S THE END OF THE STRING
	TAD CTEXNU
	TAD CTEX6
	SMA CLA		/YES - DO WE ALREADY HAVE 6 CHARACTERS?
	JMP .+3		/YES - THEN JUST IGNORE THIS
	TAD CHAR
	DCA I IX1	/NO - STORE THE CHARACTER
	ISZ CTEXNU	/ & INCREMENT THE CHARACTER COUNT
	COMGET		/GET ANOTHER CHAR
	SKP		/NONE THERE - WE'RE DONE
	JMP CTEXT1
CTEXT2,	DCA I IX1	/STORE A ZERO TO INDICATE END
	CLA CMA
	TAD IX1		/NOW RETURN WITH AC = END OF STRING BUFFER
	JMP I CTEXT
/SUBROUTINE TO CONVERT THE CHARACTER IN THE AC TO UPPER-CASE.

FIXLC,	0
	DCA CHAR	/SAVE THE CHARACTER
	TAD CHAR
	TAD MLCA
	SPA		/IS IT LOWER-CASE?
	JMP FIXLC1	/NO
	TAD MLCZ
SKISPA,	SMA SZA		/ (ALSO -240)
	JMP FIXLC1	/NO
	TAD KLCFIX	/YES - CONVERT IT TO UPPER
	DCA CHAR
FIXLC1,	CLA CLL
	TAD CHAR
	JMP I FIXLC	/RETURN W/ AC= CHARACTER

KLCFIX,	372-40
MLCA,	-341	/LOWER-CASE "A"
MLCZ,	341-372	/ AND "Z"

/SKIP LEADING SPACES AND TABS
/CALL	JMS SKIPS
/	BUFFER EMPTY
/	NORMAL RETURN

SKITAB,	240-211

CTEXNU,
SKIPS,	0
	TAD CHAR
	JMP .+3
SKIPS1,	COMGET
	JMP I SKIPS	/NONE LEFT
	SZA		/NULL CHARACTER?
	TAD SKISPA
	SZA		/NO - SPACE?
	TAD SKITAB
	SNA CLA		/NO - TAB?
	JMP SKIPS1	/YES - IGNORE IT
	ISZ SKIPS
	JMP I SKIPS
/GET A CHARACTER FROM COMMAND STRING
/CALL	COMGET	(AC=0 FOR NON-DESTRUCTIVE READ)
/	NONE
/	RETURN WITH CHARACTER IN 'CHAR' & AC

CG0377,	377
CG7400,	7400
CG7766,	-12

COMGE0,	0
	CLA
	DATFLD
	TAD I SITCNT	/GET THE TOTAL CHARACTER COUNT
	CIA
	TAD I COMDBT
	SPA SNA CLA	/ANYTHING LEFT TO FETCH?
	JMP COMGE3	/NO
	ISZ COMGE0	/YES - SKIP ON RETURN
	ISZ I SITCNT	/INCREMENT THE FETCH COUNT
	ISZ I SIECNT	/ AND INCREMENT THE EMPTY COUNT
	JMP COMGE1	/THEN GO FETCH THE CHARACTER
	TAD CG7766
	DCA I SIECNT	/OOPS, HIT THE END OF THIS BLOCK
	TAD I SIBUF
	DCA COMGT1
	TAD I COMGT1	/GET THE POINTER TO THE NEXT BLOCK
	DCA I SIBUF
COMGE1,	TAD I SIECNT
	TAD C0003
	SMA		/ARE WE FETCHING THE FRAGMENTED CHARACTERS?
	STL RAL		/YES
	SPA
	STL CIA
	TAD I SIBUF
	DCA COMGT1	/SAVE THE WORD POINTER
	TAD I COMGT1
	SZL		/IS THIS JUST A PIECE?
	JMP COMGE2	/NO
	AND CG7400	/YES - ZAP THE OTHER BITS
	DCA CHAR
	ISZ COMGT1
	TAD I COMGT1
	AND CG7400	/NOW GET THE OTHER HALF-CHARACTER
	CLL RTR
	RTR
	TAD CHAR	/COMBINE THE TWO HALVES
	RTR
	RTR
COMGE2,	AND CG0377
COMGE3,	DCA CHAR	/SAVE THE FINAL CHARACTER
	TAD CHAR	/ AND RETURN WITH IT
	CHDF
	JMP I COMGE0
/GET A FREE BLOCK AND RETURN ITS ADDRESS
/CALL	TAD FIELD 0 LINK
/	GETFBL
/	NONE AVAILABLE
/	ADDR IN AC

COMGT1,
GETFB0,	0
	DCA CHDFA
	TAD CHDFA
	CIF
	GETBLK
	JMP I GETFB0
	DATFLD
	TAD I CHDFA
	CHDF
	ISZ GETFB0
	JMP I GETFB0
	PAGE

/NUMBER INPUT
/CALL	NUMBIN
/	 -N	N=7,9 IN ASCII
/	NOT A NUMBER
/	# IN AC

C0177,	177
NUMAGN=	NUMHO+1		/MAGNITUDE
NUMB17,	17
NUMCNT,	0	/DIGIT COUNT
NUMCOM,	" -",
	IFNZRO NUMOCT-NUMDEC-10	<GLITCH>
NUMDIF=	C0010	/NUMOCT-NUMDEC
NUMDSP,	JMP NUMDEC
NUMINU,	"+-"-
NUMM5,	-5
NUMPLS,	-"+
NUMSPC,	-240
NUMZER,	-"0

NUMBI0,	0
	TAD I NUMBI0	/SET CONVERSION DISPATCH
	AND C0002
	SNA CLA		/IS THE PARM A "7" OR "9"?
	TAD NUMDIF	/"7" - OCTAL
	TAD NUMDSP	/"9" - DECIMAL
	DCA NUMDEC-1
	CLA CMA
	DCA NUMSGN	/INITIALIZE
	DCA NUMAGN
	DCA NUMHO
	DCA NUMCNT
	SKIP		/SKIP SPACES AND TABS
	JMP NUMBI4	/BUFFER EMPTY
	TAD CHAR
	TAD NUMPLS
	SNA		/"+"?
	JMP NUMBI1	/YES
	TAD NUMINU
	SZA CLA		/"-"?
	JMP NUMBI2	/NO
	DCA NUMSGN	/YES - SET (-) INDICATOR
NUMBI1,	COMGET		/GET A CHARACTER
	JMP NUMBI3
	SKP
NUMBI2,	TAD CHAR
	TAD NUMZER
	SPA CLA		/DIGIT?
	JMP NUMBI3	/NO
	TAD CHAR
	TAD I NUMBI0
	SMA SZA CLA	/CHAR <= PARAMETER?
	JMP NUMBI3
	TAD CHAR
	AND NUMB17
	DCA CHDFA
	ISZ NUMCNT
	TAD NUMCNT	/MORE THAT 4 DIGITS?
	TAD NUMM5
	SPA CLA
	JMP NUMBI5	/NO
	TAD NUMHO	/SHIFT HIGH ORDER
	CLL RTL
	RAL
	AND C7770
	DCA NUMHO
	TAD NUMAGN
	CLL RTL
	RTL
	AND C0007
	TAD NUMHO
	DCA NUMHO
NUMBI5,	TAD NUMAGN
	CLL RTL
	RAL
	AND C7770
	 HLT
NUMDEC,	CLL
	TAD NUMAGN
	SZL
	ISZ NUMHO
	CLL
	TAD NUMAGN
	SZL
	ISZ NUMHO
NUMOCT,	CLL
	TAD CHDFA
	SZL
	ISZ NUMHO
	DCA NUMAGN
	JMP NUMBI1

NUMBI3,	TAD CHAR
	TAD NUMSPC
	SZA		/WAS TERMINATOR A SPACE?
	TAD NUMCOM
	SNA CLA		/ OR A COMMA?
	JMP NUMBI6	/YES - IT'S OK THEN
	ENDTST		/NO--WAS IT AN ACCEPTABLE END CHAR?
	SKP		/YES, OK
	JMP NUMBI4	/NO, COMPLAIN

NUMBI6,	TAD NUMCNT	/ANY VALID DIGITS IN STRING?
	SNA CLA
	JMP NUMBI4	/NOPE
	ISZ NUMBI0	/YES, IT WAS A VALID STRING.
	TAD NUMAGN
	ISZ NUMSGN	/NEGATIVE NUMBER?
	CIA		/YES - NEGATE IT
NUMBI4,	ISZ NUMBI0
	JMP I NUMBI0
/OUTPUT ASCII MESSAGE
/CALL	TAD ADDR OF DDB OR 0 IF RESPONSE DDB
/	ASCOUT
/	POINTER TO MESSAGE (TERMINATED BY 0)
/	WON'T FIT
/	OK

ASCOT1=	NUMBI0

NUMSGN,
ASCOU0,	0
	SNA
	RESDDB		/GET THIS USER'S OUTPUT DDB
	CDF
	DCA I CONDVA	/SET IN FIELD 0 FOR 'PRINT'
	CHDF
	TAD I ASCOU0
	DCA ASCOT1
	ISZ ASCOU0
ASCOU1,	TAD I ASCOT1	/GET NEXT CHAR
	SNA		/END OF STRING?
	JMP ASCOU2	/YES
	CIF
	PRINT		/ AND STORE THE CHARACTER
	JMP I ASCOU0	/WON'T FIT
	ISZ ASCOT1
	JMP ASCOU1
ASCOU2,	ISZ ASCOU0	/SKIP THE PARAMETER
	JMP I ASCOU0	/ AND RETURN

WHERMQ,	" ;"M;"Q;"=;0
WHERSC,	" ;"S;"C;"=;0
	PAGE

/GET JOB TABLE ADDRESS
/CALL	GETTBA
/	 RELATIVE ADDRESS
/	RETURN

GETTB0,	0
	DATFLD
	TAD I JOBDAT
	CHDF
	SNA CLA		/IS 'JOBDAT' DEFINED?
		IFNZRO DEBUG <
	REBOOT		/NO - ERROR *****
		>
		IFZERO DEBUG <
	JMP GETTB2	/NO - MAYBE IT WON'T BE FATAL
		>
	TAD I GETTB0
	DCA GETTB1
	TAD JOBDAT
	CIF
	GETJTA
GETTB1,	 0
	SNA		/REASONABLE ADDRESS?
		IFNZRO DEBUG <
	REBOOT		/NO - ERROR *****
		>
		IFZERO DEBUG <
	NOP		/NO - HOPE THIS GETS BY ALSO
		>
GETTB2,	ISZ GETTB0
	JMP I GETTB0


/SEARCH FOR JOB IN CORE
/CALL	TAD SEARCH ITEM
/	CORES
/	RETURN WITH CORE ARG IN AC

CORSER,	0
	CIF
	CORE
	 FSWP+SI+CJOB
	CLA
	JMP I CORSER
/GET RESPONSE DDB ADDRESS
/CALL	RESDDB
/	ADDR IN AC AND COMRDB

	IFNZRO DDBINC-5	<GLITCH>
RESPCT=	C0005	/DDBINC

RESPDB,	0
	TAD COMRDB
	SZA CLA		/DDB ALREADY SET UP?
	JMP RESPD3	/YES
	CDF
	TAD COMDB0
	TAD RESPCT
	DCA COMDBT	/SET A POINTER TO THE TOTAL CHARACTER COUNT
	IAC
	TAD I COMPTR
	DCA COMRDB	/SET POINTER TO OUTPUT DEVTBL ENTRY
RESPD3,	CHDF
	TAD COMRDB
	JMP I RESPDB

/
/DECREMENT COMCNT
/CALL	DECRCT
/	RETURN

DECRC0,	0
	CDF
	STA
	TAD I COMCNT	/BACK UP THE COMMAND COUNTER
	SPA		/ BUT IT CAN'T GO NEGATIVE
	CLA
	DCA I COMCNT
	CHDF
	JMP I DECRC0
/DELETE BUFFER TO CURRRENT POINTER
/CALL	JMS BUFDEL
/	RETURN

	IFNZRO DDBOUP-7	<GLITCH>
BUFOUP=	C0007		/DDBOUP
	IFNZRO DDBINP-4	<GLITCH>
BUFINP=	C0004	/DDBINP
BUFIM1=	C0003	/DDBINP-1
	IFNZRO DDBINC-5	<GLITCH>
BUFTCT=	C0005
BUFDT0,	0

BUFDE0,	0
	TAD COMDB0
	SNA		/DOES IT EXIST?
	JMP BUFDE4	/NO - NOTHING TO DELETE
	TAD BUFINP
	DCA BUFDT0	/POINTER TO FILL-POINTER
	DATFLD
	TAD I BUFDT0
	SNA CLA		/ANYTHING IN BUFFER?
	JMP BUFDE4	/NO - JUST EXIT
	TAD COMDB0
	TAD BUFOUP
	DCA BUFDT0	/NOW POINTS TO EMPTY-POINTER
BUFDE1,	TAD I SIBUF
	CIA
	TAD I BUFDT0
	SNA CLA		/ARE WE CAUGHT UP ON BLOCKS?
	JMP BUFDE2	/YES - JUST UPDATE THE COUNTERS
	TAD I BUFDT0
	CHDF
	RETDBL		/NO - RETURN A BLOCK
	DATFLD
	DCA I BUFDT0	/ AND UPDATE THE POINTER
	JMP BUFDE1	/THEN CHECK AGAIN
BUFDE2,	TAD BUFIM1
	TAD COMDB0
	DCA IX1		/SET POINTER TO CONTROL-WORDS
	TAD I SITCNT
	CIA
	TAD I COMDBT
	SNA		/ANY CHARACTERS LEFT?
	JMP BUFDE3	/NO
	ISZ IX1
	DCA I IX1	/YES - SET THE NEW TOTAL COUNT
	TAD I SIECNT
	DCA I IX1	/ AND THE EMPTY COUNTER
	JMP BUFDE5
/
BUFDE3,	TAD I BUFDT0
	CHDF
	RETBKS		/RETURN ALL THE FREE BLOCKS
	DATFLD
	DCA I IX1
	DCA I IX1
	DCA I IX1
	DCA I IX1
BUFDE4,	DCA CHAR	/ZERO SO EVERYONE KNOWS IT'S EMPTY
BUFDE5,	CHDF
	JMP I BUFDE0	/THEN RETURN

/ASCII TO SIXBIT CONVERT
/CALL	ASCSIX
/	 SOURCE-1	(TERMINATED BY 0)
/	 DESTINATION-1
/	RETURN

ASC240,	-240

ASCSI0,	0
	TAD I ASCSI0
	DCA IX1
	ISZ ASCSI0
	TAD I ASCSI0
	DCA IX2
	ISZ ASCSI0
ASCSI1,	TAD I IX1
	SNA
	JMP  I ASCSI0	/THAT'S ALL
	TAD ASC240	/CONVERT TO SIXBIT
	CLL RTL
	RTL
	RTL
	DCA CHDFA
	TAD I IX1
	SNA		/END OF STRING?
	JMP ASCSI2	/YES - STORE THE LAST PIECE
	TAD ASC240
	TAD CHDFA
	DCA I IX2
	JMP ASCSI1
ASCSI2,	TAD CHDFA
	DCA I IX2
	JMP I ASCSI0

IOTSET,	GETTBA		/GET THE IOT LINKAGE POINTER
	 JOBLNK
	DCA CHDFA
	TAD IOTP0
	DATFLD
	DCA I CHDFA	/STORE THE IOT
	CALFIP		/ AND OFF TO FIP
	PAGE
/TEST FOR END OF COMMAND STRING
/CALL	ENDTST	WITH CHARACTER IN CHAR
/	END RETURN
/	NOT END

ENDTS0,	0
	TAD ENDTBA
	DCA IX3
	TAD I IX3
	SNA		/AND END OF LIST?
	JMP .+5		/YES - THEN CHAR ISN'T A BREAK CHAR
	TAD CHAR
	SZA CLA		/IS THIS EQUAL TO CHAR?
	JMP .-5		/NO - CONTINUE CHECKING
	SKP
	ISZ ENDTS0
	JMP I ENDTS0

ENDTBA,	.
	-273	/; (FIRST CHARACTER NORMALLY CHECKED)
	-272	/:
	-215	/CR
	-212	/LF
	-213	/VT
	-214	/FF
	0

/OCTAL TO ASCII CONVERT
/CALL	TAD OCTAL #
/	OCTASC
/	 BUFFER ADDR-1
/	RETURN

OCTAS0,	0
	CLL RAL
	DCA OCTASN	/SAVE THE NUMBER
	TAD OCTM4
	DCA OCTACT	/SET THE DIGIT COUNTER
	TAD I OCTAS0
	DCA IX1		/ & THE BUFFER POINTER
	ISZ OCTAS0
OCTAS1,	TAD OCTASN
	RTL
	RAL
	DCA OCTASN
	TAD OCTASN
	AND C0007	/GET THE NEXT OCTAL DIGIT
	TAD OCTZER	/ & MAKE IT ASCII
	DCA I IX1
	ISZ OCTACT
	JMP OCTAS1
	DCA I IX1	/SET ZERO AS TERMINATOR
	JMP I OCTAS0

OCTM4,	-4
OCTZER,	"0

/GET USER STATE WORD
/CALL	GETWRD
/	 RELATIVE ADDRESS
/	RETURN WITH USER WORD IN AC, ADDRESS IN IOTP7

GETWR0,	0
	TAD I GETWR0
	DCA GETWR1
	ISZ GETWR0
	GETTBA
GETWR1,	 0
	DCA IOTP7
	DATFLD
	TAD I IOTP7
	CHDF
	JMP I GETWR0
/
OCTASN=	GETWR0
OCTACT=	GETWR1

/ASSIGN THIS FIELD TO JOB
/CALL	ASSCOR

ASSCO0,	0
	CDF
	TAD CORJOB
	SNA		/SPECIAL FIELD ASSIGNMENT?
	TAD I JOBA	/NO - SET FOR THIS JOB
	DCA I FANFLD
	CHDF
	JMP I ASSCO0

/RELEASE THIS FIELD
/CALL	RELCOR

RELCOM,	FSWP+NOTRUN+FIP+SI

RELCO0,	0
	CDF
	TAD I FANFLD
	AND RELCOM
	DCA I FANFLD
	CHDF
	JMP I RELCO0
/
FANFLD,	CORTBL+1	/POINTS TO PHANTOM ENTRY

/ROUTINE TO CHECK THE TYPE OF ACCOUNT THIS USER HAS
/CALL:	CHKACT
/	 --	/IF ORDINARY USER
/	 --	/IF SYSTEM OPERATOR (I.E. 00XX)
/	 --	/IF SYSTEM MANAGER (I.E. 000X)

CHKAC0,	0
	GETWRD		/GET HIS ACCOUNT NUMBER
	 JOBACT
	AND C7770
	SNA		/MANAGER'S ACCOUNT?
	JMP CHKAC1	/YES
	AND C7700
	SZA CLA		/NO - OPERATOR'S ACCOUNT?
	JMP I CHKAC0	/NO - JUST A NORMAL USER
	TAD SIKBD
	SZA CLA		/IS HE ON K00?
	JMP I CHKAC0	/NO - THEN HE CAN'T BE OPERATING NOW
	SKP
CHKAC1,	ISZ CHKAC0
	ISZ CHKAC0
	JMP I CHKAC0	/RETURN

/SIXBIT TO ASCII CONVERT
/CALL	JMS SIXASC
/	 SIXBIT ADDR (TERMINATED BY 0 OR SIXTH CHAR)
/	ASCII BUFFER-1
/	RETURN

SIXADR=	ASSCO0
SIXCNT=	RELCO0
C0077,	77

SIXASC,	0
	SNA
	CLA CLL CMA RTL	/AC = -3 (WORD-COUNT)
	DCA SIXCNT
	TAD I SIXASC
	DCA SIXADR
	ISZ SIXASC
	TAD I SIXASC
	DCA IX2
	ISZ SIXASC
SIXAS2,	TAD I SIXADR
	AND C7700
	SNA
	JMP SIXAS1
	CLL RTR
	RTR
	RTR
	TAD SIX240
	DCA I IX2
	TAD I SIXADR
	AND C0077
	SNA
	JMP SIXAS1
	TAD SIX240
	DCA I IX2
	ISZ SIXADR
	ISZ SIXCNT
	JMP SIXAS2
SIXAS1,	DCA I IX2	/CLEAR LAST WORD
	JMP I SIXASC

SIX240=	.
HASITM,	" ;"H;"A;"S;" ;0
BELMSG,	207;207;0
PERIOD,	".;0
	PAGE
/RETURN PARAMETERS
/CALL	RETPAR
/	RETURN


RETPA0,	0
	GETWRD
	 JOBLNK
	IAC
	DCA RETPA1
	CIF
	BLT
	 DATFLD		/SOURCE FLD
RETPA1,	 0		/SOURCE ADDR
	 CHDF		/DESTINATION FIELD
	 IOTP0		/DEST ADDR
	 -7		/-COUNT
	STA		/RETURN PARAMETER LBLOCK TO FREE STORAGE
	TAD RETPA1
	CIF
	RETBLK
	CLA
	DATFLD
	DCA I IOTP7	/JOBLNK:=0
	CHDF
	JMP I RETPA0
/RESTORE BUFFER POINTERS
/CALL	JMS RESTBP
/	RETURN

	IFNZRO DDBOUC-6 <GLITCH>
RESTEC=	C0005	/DDBOUC-1

RESTBP,	0
	TAD COMDB0
	SNA		/DO WE HAVE A DDB?
		IFNZRO DEBUG <
	REBOOT		/NO - ERROR *****
		>
		IFZERO DEBUG <
	NOP		/NO - BUT CONTINUE IN A PRODUCTION SYSTEM
		>
	TAD RESTEC
	DCA IX1		/POINTS TO THE EMPTY COUNT
	DATFLD
	DCA I SITCNT	/CLEAR THE FETCH COUNT
	TAD I IX1
	DCA I SIECNT	/ AND THE EMPTY COUNT
	TAD I IX1
	DCA I SIBUF	/ AND THE FIRST BLOCK POINTER
	CHDF
	JMP I RESTBP

/
/CODE TO STORE THE 'PRGTBL' ENTRY BEFORE OPENING A FILE.
SAVNAM,	CHKIO		/CHECK FOR ACTIVE DTA AND RK05 I/O
	CLRPRV		/CLEAR JOB'S "PRIVILEGE"
	TAD SIJOB	/PRGTBL INDEX=3*JOB
	TAD SIJOB
	TAD SIJOB
	TAD PRGTBA	/START OF PRGTBL-3 (NO ENTRY FOR JOB 0)
	DCA IX1
	DATFLD
	TAD IOTP3	/TRANSFER 3 WORD BLOCK
	DCA I IX1
	TAD IOTP4
	DCA I IX1
	TAD IOTP5
	DCA I IX1
	CHDF
	TAD C0003	/FILE 3
	DCA IOTP1
	JMP I LNGIOT	/GO DO OPEN

PRGTBA,	PRGTBL-3-1

/ROUTINE TO CHECK FOR RK05 OR DECTAPE I/O ACTIVITY.

CHKIO0,	0
	GETWRD		/GET THE DEVICE WAIT WORD
	 JOBDWT
	SNA CLA		/ANYTHING GOING?
	JMP I CHKIO0	/NO
	TAD .+2
	JMP I COMERA	/YES - TYPE "WAIT FOR I/O"
	WAITIO

/ROUTINE TO GET USER'S ACCOUNT # IN FORM M,N OR M
/CALL
/	ACCTIN
/	ILLEGAL CHARACTER IN STRING
/	RETURN WITH ACCOUNT # IN AC

ACC0,	0
	DCA ACC1	/CLEAR #
ACC3,	NUMBIN		/GET ONE COMPONENT
	 -"7
	JMP ACC4	/COULDN'T DO IT
	TAD ACC1	/ACCUMULATE INTO TOTAL
	DCA ACC1
	TAD CHAR	/TERMINATOR A COMMA
	TAD ACCOMA
	SNA CLA
	JMP ACC2	/YES-- SO SHIFT NUMBER THUS FAR INTO LEFT HALF OF WORD
	TAD ACC1	/NO- RETURN WHOLE #
	ISZ ACC0	/SKIP TO INDICATE GOODNESS
ACC4,	JMP I ACC0

ACC2,	TAD ACC1	/SHIFT IT LEFT 6 PLACES
	CLL RTL
	RTL
	RTL
	DCA ACC1	/SAVE IT
	COMGET		/GET PAST THE OFFENDING COMMA
 	JMP ACC4	/NONE LEFT, BUT WE NEED ONE--ERROR
	CLA
	JMP ACC3	/GET NEXT PART OF NUMBER

ACC1=	RESTBP
ACCOMA,	-",
/ROUTINE TO TYPE A MESSAGE ON EVERYBODY'S CONSOLE AT ONCE
/THE USER MUST BE LOGGED-IN ON A SYSTEM ACCOUNT.

BROAD,	CHKACT		/CHECK THE TYPE OF USER
	JMP I COMERA	/MERE MORTAL - ERROR!!
	NOP		/OPERATOR ACCOUNT
	TAD BROBRK
	DCA IOTP1	/POINTS TO END OF BUFFER
	SKIP
	JMP BROAD2	/NO CHARACTERS LEFT
	TAD CHAR	/SAVE CHARACTER IN BUFFER
BROAD1,	DCA I IOTP1
	ISZ IOTP1	/READY FOR NEXT CHARACTER
	SKP
		IFNZRO DEBUG <
	REBOOT		/ERROR - 'VERBRK' BUFFER NOT LARGE ENOUGH *****
		>
		IFZERO DEBUG <
	JMP I COMERA	/PRODUCTION SYSTEM - BUT HOW COULD HE TYPE SO MUCH?
		>
	STL CLA RTL	/AC=2
	ENDTST		/LOOK FOR CR, LF, FF, VT
	JMP BROAD2	/FOUND ONE OF THE ABOVE
	COMGET		/GET ANOTHER CHARACTER
	JMP BROAD2	/NONE
	JMP BROAD1	/AND LOOK AT IT

BROAD2,	DCA I IOTP1	/END THE STRING
	TAD BROLN	/INITIALIZE FOR ALL CONSOLES
	DCA IOTP3
	TAD DEVTBA	/GET POINTER TO FIRST OUTPUT DDB
	DCA IX1

BROAD3,	DATFLD
	TAD I IX1	/GET DDB ADDRESS
	CHDF
	SNA CLA		/DOES IT EXIST
	JMP BROAD4	/NO; SO DON'T BOTHER
	TAD IX1
	DCA IOTP2	/SAVE DEVTBL ENTRY ADDRESS FOR TALK5
	JMS I BROTAK	/PUSH STRING CR-LF STARS THRU
	 STARS
	JMS I BROTAK	/OUTPUT MESSAGE
BROBRK,	 VERBRK
	JMS I BROTAK	/CR-LF
	 CRLF
BROAD4,	ISZ IX1		/ON TO NEXT CONSOLE
	ISZ IOTP3	/ARE WE DONE?
	JMP BROAD3	/NO, CONTINUE
	JMP I COMEXA	/YES, GO AWAY

BROLN,	-BRDMAX-1	/ONLY BROADCAST TO EXISTING TTY'S
BROTAK,	TALK5
	PAGE
/
/HANDLER FOR THE 'LOGIN' COMMAND - WE PICK UP THE ACCOUNT
/NUMBER & PASSWORD AND BUILD THE JOB STATUS-BLOCKS; THEN
/WE CALL FIP TO CHECK THE ACCOUNT/PASSWORD COMBINATION.
/IF THE USER SPECIFIES A JOB NUMBER AFTER HIS PASSWORD,
/WE'LL LET HIM LOG IN AS A PARTICULAR JOB IF WE CAN;
/IF HE SPECIFIES A JOB NUMBER & WE CAN'T LET HIM HAVE IT,
/WE GIVE HIM A MESSAGE AND DON'T LET HIM IN AT ALL.

LOGIEA,	LOGINE
LOGIFA,	LOGINF

	JMP I LOGIEA	/FIP ERROR RETURN
	JMP I LOGIFA	/OK RETURN
LOGIN,	TAD SIJOB
	SZA CLA		/ALREADY HAVE A JOB #?
	JMP LOGER1	/YES - "ALREADY LOGGED IN"
	ACCTIN		/NO - FETCH HIS ACCOUNT NUMBER
	JMP LOGER3	/BAD NUMBER - SAY "ILLEGAL REQUEST"
	DCA IOTP2
	TAD COMBFA
	TEXTS		/GET HIS PASSWORD IN ASCII
	CLA
	ASCSIX		/ AND CONVERT IT TO TSS/8 6-BIT
	 COMBUF-1
	 IOTP3-1
	DATFLD
	TAD I COMDB0
	AND LOGCTB
	SNA CLA		/WAS THE COMMAND PRECEDED BY CTRL/B?
	JMP LOGER5	/NO - THIS IS FOR HIS OWN GOOD!
	CLA CMA
	TAD IOTP2
	SZA CLA		/IS THIS MANAGER #1 LOGGING IN?
	JMP .+5		/NO
	TAD I LOGMSK
	SNA CLA		/YES - IS THE SYSTEM RESTRICTED BY 'OFF'?
	JMP LOGER4	/NO - THAT MEANS IT IS FOR MGR1
	SKP CLA		/YES - HE CAN LOGIN, BUT NOT WITHOUT A PASSWORD
	TAD I COMDB0	/CHECK THE 'FORCED' BIT
	AND LOGFRC
	SNA		/WAS THIS LOGIN FORCED BY A MANAGER?
	JMP .+4
	DCA IOTP4	/YES - SET THE SECOND WORD NON-ZERO
	DCA IOTP3	/ AND ZERO THE FIRST WORD OF PASSWORD
	SKP CLA		/ ALSO ALLOW THE FORCED ACCOUNT PAST ANY LOCK
	TAD IOTP2
	AND I LOGMSK
	CHDF
	SZA CLA		/IS THIS USER ALLOWED IN?
	JMP LOGER4	/NO - SYSTEM LOCKED UP BY MANAGER
	NUMBIN		/PICK UP ANY JOB # SPECIFIED
	 -"7
	JMP LOGIN1	/BAD JOB # - PICK ONE FOR HIM
	SNA		/TRYING TO GET JOB 0?
	JMP LOGER3	/YES - SHOOT HIM DOWN
	DCA IOTP7
	CLA CLL CML
	TAD IOTP7
	DATFLD
	TAD MJBMAX
	SZA SNL CLA	/IS IT A LEGAL JOB #?
	JMP LOGER3	/NO - "ILLEGAL REQUEST"
	CLA CMA
	TAD IOTP7
	TAD JOBTBA
	DCA IX4		/YES - GET THE 'JOBTBL' ENTRY
	TAD I IX4
	SNA CLA		/IS THERE ALREADY A JOB THERE?
	JMP LOGIN4	/NO - HE CAN HAVE THE SLOT

LOGER1,	TAD LOGME0	/"ALREADY LOGGED IN"
LOGER3,	TAD ILLMSG	/"ILLEGAL REQUEST"
	JMP I COMERA
/
/HE DIDN'T SPECIFY A JOB # IN HIS LOGIN COMMAND SO
/WE USE THE FIRST AVAILABLE JOB SLOT.
LOGIN1,	TAD JOBTBA
	DCA IX4		/SET POINTER TO 'JOBTBL'
	DATFLD
	TAD MJBMAX
	DCA CHDFA	/ & THE NUMBER OF SLOTS
LOGIN2,	TAD I IX4
	SNA CLA		/IS THIS JOB SLOT EMPTY?
	JMP LOGIN3	/YES - WE HAVE A JOB NUMBER
	ISZ CHDFA	/NO - DECREMENT COUNTER
	JMP LOGIN2
LOGER2,	TAD LOGME1	/TYPE "SYSTEM FULL"
LOGER4,	TAD LOGME4	/ OR "SYSTEM ACCESS RESTRICTED"
LOGER5,	TAD LOGME5	/ OR "PRECEDE LOGIN BY ^B"
	JMP I COMERA

LOGIN3,	TAD JOBTBA
	CIA
	TAD IX4
	DCA IOTP7	/SAVE THE JOB #
/
/AT THIS POINT, WE HAVE A JOB NUMBER IN 'IOTP7'.
/IF WE HAVE SUFFICIENT FREE-CORE TO BUILD HIS TABLES,
/THE ONLY THING THAT CAN STOP HIM NOW IS A BAD
/ACCOUNT NUMBER / PASSWORD COMBINATION.
LOGIN4,	CDF
	TAD I FRECTA	/GET THE NUMBER OF FREE-CORE BLOCKS
	TAD LOGMIN
	SPA CLA		/ENOUGH AVAILABLE TO LOG IN?
	JMP LOGER2	/NO - SAY "SYSTEM FULL"
	TAD IOTP7
	DCA SIJOB	/SET OUR JOB NUMBER
	TAD SIJOB
	TAD I JOBA
	DCA I JOBA
	TAD COMDB0
	IAC
	DCA CHDFA	/POINTS TO JOB # IN DDB
	DATFLD
	TAD I CHDFA
	AND C7700
	TAD SIJOB
	DCA I CHDFA	/SET THE JOB # IN THE INPUT DDB
	DATFLD
	TAD SIJOB	/PUT ENTRY IN TTYTBL
	TAD TTYTBA
	DCA CHDFA
	TAD SIKBD
	DCA I CHDFA	/STORE UNIT # IN TTYTBL
	TAD I COMRDB
	SZA		/ALREADY HAVE AN OUTPUT DDB?
	JMP LOGN4A	/YES
	TAD COMRDB
	CHDF
	GETFBL		/NO - GET A FREE BLOCK
	REBOOT		/OOPS *****
LOGN4A,	DCA IX1
	TAD SIJOB
	DATFLD
	DCA I IX1	/SET THE JOB NUMBER INTO IT
	CHDF
	TAD IX4
	GETFBL		/GET JOB STATUS BLOCK #0
	REBOOT		/BUT WE ALREADY CHECKED 'FRECNT' - ERROR *****
	JMP I .+1	/ON TO THE NEXT PAGE
	LOGIN5

	IFNZRO CTRLB-2	<GLITCH>
LOGCTB=	C0002	/CTRLB
	IFNZRO DFORC-4	<GLITCH>
LOGFRC=	C0004	/DFORC
LOGMSK,	F1OFFJ	/ACCOUNT NUMBER MASK
LOGME0,	LOGE0-ILLREQ
LOGME1,	LOGE1-LOGE4
LOGME4,	LOGE4-LOGE5
LOGME5,	LOGE5
LOGMIN,	-STOMIN	/MINIMUM FREE STORAGE FOR NEW JOB
	PAGE
/
/COMPLETION OF THE 'PRE-FIP' LOGIN HANDLING
LOGIN5,	DCA LOGST0	/SAVE THE POINTER TO STATUS BLOCK #0
	TAD LOGST0
	GETFBL		/GET JOB STATUS BLOCK #1
	REBOOT
	GETFBL		/GET JOB STATUS BLOCK #2
	REBOOT		/ ***** SHOULD NOT HAPPEN!! *****
	CLA
	TAD LOGST0	/GET THE LOCATION OF STATUS BLK #0
	DATFLD
	DCA I JOBDAT	/ AND SET 'JOBDAT'
	GETTBA		/NOW STORE HIS ACCOUNT #
	 JOBACT
	DCA IOTP7	/GET THE POINTER
	TAD IOTP2	/ & HIS ACCOUNT #
	DATFLD
	DCA I IOTP7	/THEN STORE IT
	GETTBA
	 JOBLNK
	GETFBL		/GET AN IOT LINKAGE BLOCK
	REBOOT		/ ***** SHOULD NOT HAPPEN!! *****
	DCA LOGPMA
	ISZ LOGST0
	CIF
	BLT		/NOW INITIALIZE JSB #0
	 CHDF		/SOURCE FLD
	 LOGSR0		/SOURCE ADDR
	 DATFLD		/DEST FLD
LOGST0,	 0		/DEST ADDR
	 -5
	CIF
	BLT		/SET UP THE IOT LINKAGE
	 CHDF		/SOURCE FLD
	 IOTPAR+1	/SOURCE ADDR
	 DATFLD		/DEST FLD
LOGPMA,	 0		/DEST ADDR
	 -10		/-COUNT
	CALFIP		/GO CHECK HIS ACCOUNT # AND PASSWORD
/
/ERROR RETURN FROM LOGIN IOT IN FIP - UNDO ALL OUR TABLES
LOGINE,	JMS LOGIE0
	SIERR
	JMP I COMERA

LOGIE0,	0
	DATFLD
	TAD COMDB0
	SNA
	JMP LOGIE1
	IAC
	DCA IOTP0
	TAD I IOTP0
	AND C7700
	DCA I IOTP0
LOGIE1,	TAD I COMRDB
	SNA		/ANY OUTPUT DDB NOW?
	JMP LOGIE2	/NO
	DCA IX1
	DCA I IX1	/YES - CLEAR THE JOB NUMBER
LOGIE2,	CDF
	TAD I JOBA	/SET JOB = 0
	AND C7700
	DCA I JOBA
	TAD SIJOB
	TAD JOBTBA	/SET JOBTBL ENTRY=0
	DCA CHDFA
	DATFLD
	DCA I CHDFA
	TAD I JOBDAT	/RETURN JOB STATUS BLOCKS
	CHDF
	RETBKS
	DATFLD
	DCA I JOBDAT
	CHDF
	DCA SIJOB
	JMP I LOGIE0

LOGUNA,	UNACCT

/
/NORMAL RETURN FOR FIP LOGIN - CHECK THE AC STATUS AND
/TYPE THE SYSTEM INTRO MESSAGE.
LOGINF,	GETWRD
	 JOBREG+2
	SNA CLA		/ANY PROBLEM?
	JMP LOGIF1	/NO
	JMS LOGIE0	/YES - UN-BUILD OUR TABLES
	TAD LOGUNA
	JMP I COMERA	/"UNAUTHORIZED ACCOUNT"

LOGIF1,	ASCOUT		/FINISH TYPING MESSAGES ON LOGIN
VERSMA,	 VERSIM		/FIRST OUTPUT VERSION #
	NOP
	TAD SIJOB	/NOW OUTPUT JOB#
	JMS I LOGUSR	/ AND THE 'USER' INFO
	NOP
	ASCOUT		/A FEW SPACES
	 SPACES
	NOP
	TAD LOGFA2	/FUDGE COMRET TO GO TO LOGIF2 ON COMPLETION
	DCA COMEXA	/	OF TIME EVALUATION
	TAD SIJOB	/PUT "LOGIN" IN PRGTBL FOR THIS JOB
	TAD SIJOB
	TAD SIJOB	/PRGTBL INDEX IS 3*JOB#
	TAD LOGPRG	/START OF PRGTBL-3-1
	DCA IX1
	DATFLD
	TAD LOGN5A	/LO
	DCA I IX1
	TAD LOGN5B	/GI
	DCA I IX1
	TAD LOGN5C	/N
	DCA I IX1
	CHDF
	JMP I .+1	/NOW GO DO TIME EVALUATION
	TIME3

LOGPRG,	PRGTBL-3-1
LOGN5A,	5457	/LO
LOGN5B,	4751	/GI
LOGN5C,	5600	/N

VERSIN,	TAD VERSMA	/TYPE OUT VERSION #
	JMP I COMEXA

LOGUSR,	USER0	/PRINT USER # LINE
LOGFA2,	LOGIF2

/THIS HANDLES THE 'EXTEND' AND 'REDUCE' COMMANDS
	SIERR
	JMP I IOTEND
EXTEND,			/SAME AS REDUCE EXCEPT FOR IOT
REDUCE,	NUMBIN		/GET THE FILE #
	 -"7
	JMP I COMERA	/BAD NUMBER
	AND C0003
	DCA IOTP1	/STORE THE FILE I.D.
	NUMBIN
	 -"9
	JMP I COMERA
	DCA IOTP2	/ AND THE NUMBER OF SEGMENTS TO ADD/DELETE
	JMP I LNGIOT	/THEN OFF TO FIP
	PAGE

ASSTBL,	.
	-"R
	-"P
	-"I
	-"L
	-"C
ASSD,	-"D
	0
ASSCAL,	IOTSET
ASGOFF,	ASSD-ASSTBL-1-20	/OFFSET TO GET DECTAPE DEVICE CODE

	SIERR
	JMP ASSIGF
ASSIGN,	CHKIO
	CLRPRV		/MAKE SURE HE CAN'T GET 'PRIVILEGED' DEVICES
	SKIP		/GET TO THE NEXT NON-BLANK CHARACTER
	JMP I COMERA	/NONE - ERROR
	TAD ASSTBL
	DCA IOTP2
ASSIG2,	ISZ IOTP2
	TAD I IOTP2
	SNA
	JMP ASSIG4
	TAD CHAR
	SZA CLA		/MATCH?
	JMP ASSIG2	/NO
	TAD CHAR	/YES. DECTAPE?
	TAD ASSD
	SZA CLA
	JMP ASSIG3	/NO
	DCA CHAR	/ (CLEAR SO NUMBIN WILL 'SKIP')
	NUMBIN		/YES. GET UNIT #
	 -"7
	JMP ASSIG6	/HE WANTS US TO CHOOSE FOR HIM
ASSIG7,	DCA IOTP1
	TAD IOTP1
	AND C7770
	SZA CLA		/IS UNIT # .LE. 7?
	JMP ASSIG4	/NO...ERROR
	TAD ASGOFF	/APPLY AN OFFSET TO GET THE DEVICE CODE
ASSIG3,	TAD ASSTBL
	CMA
	TAD IOTP2
	TAD IOTP1
	TAD C4000

ACSET,	DCA IOTP1	/SAVE AC IN BOTH USER'S AC AND PC
	GETTBA
	 JOBREG
	DCA CHDFA
	TAD IOTP1
	DATFLD
	DCA I CHDFA
	ISZ CHDFA
	ISZ CHDFA	/NOW POINTS TO USERS AC
	TAD IOTP1
	DCA I CHDFA
	CHDF
	JMP I ASSCAL

ASSIG6,	TAD ASSDTA	/POSITION OF DTA IN DEVTBL-1
	DCA IX2
	TAD ASSCNT	/(-) NUMBER OF DRIVES TO CHECK
	DCA IX1
	DATFLD
	TAD I IX2	/PICK UP DEVTBL ENTRY
	SNA CLA		/AVAILABLE?
	JMP ASSG60	/YES
	ISZ IX1		/NO...TRY THE NEXT ONE
	JMP .-4
ASSIG8,	CLA
	TAD ASSNON
	JMP I COMERA	/"NO SUCH DEVICE"

ASSG60,	CHDF
	TAD IX1		/GOT ONE; UNIT # IN BITS 8-11 OF IX1
	AND C0007
	JMP ASSIG7


ASSIGF,	GETWRD		/HOW DID WE FARE IN FIP
	 JOBREG+2
	SNA
	JMP I ASSG9A	/WE GOT IT; NOW TELL USER
	SPA
	JMP ASSIG8	/ASSIGNMENT FAILED. TOUGH!
	DCA IOTP0
	TAD IOTP0
	TAD C7701
	SNA CLA		/IS THE OWNER JOB "77"?
	JMP ASSIG8	/YES; IT REALLY DOESN'T EXIST
	ASCOUT
	 CRLF
	NOP
	TAD IOTP0	/NO; SOMEONE REAL OWNS IT
	JMS I ASSUPN	/ SO TYPE INFO ABOUT HIM
	NOP
	ASCOUT
	 HASITM
	NOP
	JMS I ASSUNA	/TYPE OUT DEVICE NAME
	ASCOUT
	 CRLF
	NOP
	JMP I COMEXA

ASSUPN,	USER0

C7701,	7701	/-77
ASSUNA,	ASSUNI
ASSNON,	NONSUC		/NO SUCH DEVICE
ASSG9A,	ASSIG9
ASSDTA,	DEVTBE+20-1+DTAMIN
ASSCNT,	-10+DTAMIN

	SIERR
	JMP RELF
RELEAS,	JMP ASSIGN

RELF,	GETWRD
	 JOBREG+2
	SNA CLA
	JMP I COMEXA
ASSIG4,	TAD ILLMSG	/"ILLEGAL REQUEST"
	JMP I COMERA

/ROUTINE TO GET A FILENAME AND CHECK FOR A NULL NAME
NULLNA,	0
	TAD COMBFA
	TEXTS		/GET THE NAME
	CIA
	TAD COMBFA
	SNA CLA		/WAS ANYTHING FOUND?
	JMP I COMERA	/NO - ERROR!
	JMP I NULLNA

SPACES,	240;240;240
SPACE,	240;0
	PAGE

	SIERR
	JMP I IOTEND
FOPEN,	NUMBIN		/FILE #
	 -"7
	JMP I COMERA
	AND C0003
	DCA IOTP1
	GETNAM		/GET THE FILENAME AND CHECK FOR A NULL NAME
	ASCSIX
	 COMBUF-1
	 IOTP3-1
	ENDTST
	JMP FOPEN1
	ACCTIN		/ACCOUNT #
	SKP
	DCA IOTP2
FOPEN1,	GETTBA
	 JOBLNK
	GETFBL
	COMWAT		/NONE. TRY LATER
	DCA FOPEN2
	CIF
	BLT
	 CHDF	/SOURCE FLD
	 IOTPAR+1	/SOURCE ADDR
	 DATFLD	/DEST FLD
FOPEN2,	 0	/DEST ADDR
	 -10	/-COUNT
	CALFIP

	SIERR
	JMP I IOTEND
CREATE,	GETNAM		/GET THE FILENAME
	ASCSIX
	 COMBUF-1
	 IOTP1-1
	JMP I LNGIOT

/THIS HANDLES THE PROGRAMMATIC 'HLT'. WE JUST CALL
/THE SUBROUTINE TO EXECUTE THE 'S' COMMAND & CLEAR
/THE 'JSHLT' BIT IN HIS JOB STATUS WORD.
PRGHLT,	JMS SCOMND	/STOP HIS PROGRAM
/?	DECRCT		/JUST DECREMENT THE COUNT (IF HLT CLEARS INPUT)
	NOP
	EXIT		/ AND EXIT

/
/THIS HANDLES THE 'S' COMMAND. WE SIMPLY STOP THE
/EXECUTION OF THE CURRENTLY RUNNING PROGRAM.
S,	JMS SCOMND	/JUST CALL OUR 'S' SUBROUTINE
	JMP I COMEXA	/THEN EXIT

SCOMND,	0
	GETWRD		/OK, IS HE ACTIVE ALREADY?
	 JOBSTS
	AND SBIT1	/TURN OFF HIS RUN BITS
	DATFLD
	DCA I IOTP7
	TAD IOTP7
	DCA STEMP
	CHDF
	GETWRD		/GET HIS DEVICE-WAIT WORD
	 JOBDWT
	DATFLD
	AND C0007
	TAD .+3		/FORM THE APPROPRIATE DISPATCH
	DCA .+1
	 .-.
	JMP I .+1	/NORMAL EXIT IF NO DEVICE WAITS
	SEXIT
		IFNZRO TC01 <
	WAIT1
	WAIT2	>
		IFZERO TC01 <
	SEXIT
	SEXIT	>
		IFNZRO RK05+RK8E <
	WAIT3	>
		IFZERO RK05+RK8E <
	SEXIT	>
		IFNZRO CDR <
	SEXIT	>	/NOTHING SPECIAL FOR THE CARD-READER NOW
		IFZERO CDR <
	SEXIT	>
	SEXIT		/CATCH ANY STRANGE STUFF THAT FLOATS BY
	SEXIT
	SEXIT
SEXIT,	DATFLD
	TAD I STEMP
	AND SBIT2	/CLEAR THE REST OF THE BITS IN STR0
	DCA I STEMP
	TAD I SDVRK5
	SNA		/ANYONE HAVE THE RK05?
	JMP I SCOMND	/NO - JUST EXIT
	DCA IX1
	TAD I IX1
	CIA
	TAD SIJOB
	SZA CLA		/YES - DO WE HAVE IT?
	JMP I SCOMND	/NO - RETURN
	TAD I SDVRK5
	CHDF
	RETDBL		/YES - FREE IT
	CLA
	DATFLD
	DCA I SDVRK5	/ AND CLEAR THE DEVTBL ENTRY
	JMP I SCOMND	/RETURN

SBIT1,	-JSRUN-1
SBIT2,	-JSRUN-JSHLT-JSPRIV-1
SDVRK5,	DEVTBE+30	/POINTER TO RK05 (DRIVE 0) ENTRY
STEMP=	IOTP6

/CHECK TO SEE IF THE JOB HAS EITHER CONTROLLER
WAIT1,	TAD I DTJOBA
	CIA
	TAD SIJOB
	SNA CLA		/DOES THIS JOB CURRENTLY HAVE THE CONTROLLER?
	JMP SEXIT	/YES - LEAVE IT ALONE
WAIT3,	TAD I RKJOBA
	CIA
	TAD SIJOB
	SNA CLA		/DOES THIS JOB HAVE THE CONTROLLER?
	COMWAT		/YES - HAVE TO WAIT FOR IT TO FINISH
	DCA I IOTP7	/CLEAR THE DEVICE WAIT WORD
	CLA CLL CMA RAL
	TAD IOTP7
	DCA IOTP7	/NOW POINTS TO DEVICE STATUS
	CLA CMA
	DCA I IOTP7	/SET STATUS OF -1 TO SHOW TRANSFER INTERRUPTED
WAIT2A,	CHDF
	GETWRD		/NOW GET HIS AC LOCATION
	 JOBREG+2
	DATFLD
	CLA
	DCA I IOTP7	/ AND CLEAR HIS AC
	JMP SEXIT

/STOP THE TIMER
WAIT2,	TAD SIJOB
	CHDF
	CIF 10
	JMS I DTSTP	/USE FIELD 1 ROUTINE TO STOP THE TIMER
	JMP WAIT2A	/DEVICE-WAIT AND STATUS ALREADY SET, GO CLEAR HIS AC

DTJOBA,	DTJOB
DTSTP,	F1DTST
RKJOBA,	RKJOB
	PAGE

STBITS,	-JSRUN-JSHLT-JSINER-7-1
STCLR,	JSPRIV
STERF,	-JSWAIT-JSERR-1

START,	CHKIO		/CAN'T START IF RK05 OR DTA ACTIVE
	GETTBA		/GET PC LOCATION
	 JOBREG
	DCA IOTP2
	CLRPRV		/CLEAR 'PRIVILEGE' HERE (NOT FOR 'R' OR 'RUN')
	ENDTST		/IS THERE ANY MORE TO COMMAND?
	JMP START1	/NO - JUST RE-START PROGRAM AT SAME LOCATION
	NUMBIN		/YES - GET THE STARTING ADDRESS
	 -"7
	JMP I COMERA	/NOT A NUMBER - ERROR!
START2,	DATFLD
	DCA I IOTP2	/SET NEW PC
	ISZ IOTP2
	DCA I IOTP2	/ZERO LINK, MODE 'B', GT, & SC
	ISZ IOTP2
	DCA I IOTP2	/ AND THE AC
	ISZ IOTP2
	DCA I IOTP2	/ AND THE MQ
	CHDF
	GETTBA		/GET START OF JSB #0
	 JOBSTS
	DCA START3
	DATFLD
	TAD I START3	/GET 'STR0'
	AND STCLR	/ AND CLEAR EVERYTHING EXCEPT THE PRIVILEGE BIT
	DCA I START3
	ISZ START3	/THEN SET POINTER TO 'STR1'
	CHDF
	CIF
	BLT		/RESET STATUS REGISTERS
	 CHDF	/SOURCE FLD
	 LOGSR0+1
	 DATFLD	/DEST FLD
START3,	 0	/DEST ADDR
	 -4
START1,	GETWRD		/GET STATUS REGISTERS
	 JOBSTS
	AND STBITS	/CLEAR THE ERROR CODE
	TAD C4000	/ & SET THE 'RUN' BIT
	DATFLD
	DCA I IOTP7	/ AND PUT IT BACK
	ISZ IOTP7
	TAD I IOTP7	/GET STR1
	AND STERF	/CLEAR THE 'ERROR' BIT
	IAC		/ & SET THE 'JSWAIT'
	DCA I IOTP7
	ISZ IOTP7
	ISZ IOTP7
	CLL CLA CMA RAL	/JUST BE SURE THE 'JSWAIT'
	AND I IOTP7	/ IS SET IN WAIT MASK #1
	IAC
	DCA I IOTP7
	CHDF
	JMP I COMEXA	/THEN JUST EXIT

/THIS IS USED SIMPLY TO INITIALIZE THE STATUS REGISTERS
/AND WAIT MASKS IN JOB STATUS BLOCK #0.
LOGSR0,	0	/STR0
	JSWAIT	/STR1
	0	/DEVICE STATUS
	JSWAIT	/WAIT MASK 1
	0	/DEVICE WAIT MASK
/  SOMEDAY 8/E VERSION SHOULD PRINT OUT EAE MODE AS A OR B
/	AND ALSO THE GT FLAG.  FOR NOW MODE IS BIT 0 OF SC.
/	0-MODE A AND 1-MODE B.
/
WHERE,	ASCOUT
	 CRLF
	JMP I COMEXA
	JMS WHEPRT
	JMP I COMEXA

WHEPRT,	0
	TAD WHEVEC
	DCA IX2
WHERE1,	TAD I IX2	/GET NEXT ITEM
	SNA		/END OF LIST?
	JMP I WHEPRT	/YES - RETURN
	DCA WHERE2
	TAD I IX2
	DCA WHERE3
	ASCOUT		/TYPE THE LABEL
WHERE2,	 0
	JMP I WHEPRT	/NO ROOM - JUST RETURN
	GETWRD		/NOW GET THE WORD
WHERE3,	 0
	DCA WHERE3
	TAD WHERE2
	CIA
	TAD WHEVL
	SZA CLA		/IS IT THE LINK?
	JMP WHERE5	/NO
	TAD WHERE3	/YES - JUST GET ONE BIT
	CLL RTL		/ AWAY FROM MODE, GT, & SC
	CLA RAL
	OCTASC		/CONVERT IT TO ASCII
	 COMBUF-1
	ASCOUT		/ AND TYPE IT
	 COMBUF+3
	JMP I WHEPRT	/NO ROOM
	JMP WHERE1	/THEN GO GET THE NEXT
WHERE5,	TAD WHERE3	/RE-GET THE VALUE
	OCTASC		/ AND CONVERT IT TO ASCII
	 COMBUF-1
	ASCOUT		/ AND TYPE IT
	 COMBUF
	JMP I WHEPRT
	JMP WHERE1	/THEN CONTINUE

WHEVEC,	.
	WHERPC
	JOBREG
	WHERAC
	JOBREG+2
WHEVL,	WHERLK
	JOBREG+1
	WHERSW
	JOBSWR
	IFNZRO MQREG	<
	WHERMQ
	JOBEAE	>
	IFNZRO EAE	<
	WHERSC
	JOBREG+1	>
	0

/ROUTINE TO HANDLE THE 'RENAME' COMMAND.

	SIERR
	JMP I IOTEND
RENAME,	NUMBIN		/GET THE FILE I.D.
	 -"7
	JMP I COMERA
	AND C0003
	DCA IOTP1
	GETNAM		/NOW GET THE NEW NAME
	ASCSIX		/ AND CONVERT IT TO 6-BIT
	 COMBUF-1
	 IOTP2-1
	JMP I LNGIOT	/THEN OFF TO FIP
	PAGE
/
/ROUTINE TO FORCE A STRING INTO AN INPUT BUFFER
/USER MUST BE LOGGED-IN ON A SYSTEM ACCOUNT.

FORSE,	CHKACT		/CHECK TYPE OF USER
	JMP I COMERA	/ORDINARY USER - ERROR!
	TAD FORDIF	/SYSTEM OPERATOR - ALLOW ONLY ACTUAL TTY'S
	TAD DEVTND	/MANAGER - ALLOW ANY CONFIGURED LINE
	DCA FORMX	/SAVE THE MAXIMUM ALLOWED LINE #
	NUMBIN		/GET CONSOLE #
	 -"7
	JMP I COMERA	/BAD CONVERSION, QUIT
	DCA FORDEV
	TAD FORDEV
	SPA CLA		/IS IT CLOSE?
	JMP I COMERA	/NO - ERROR!!
	TAD FORDEV
	CLL RAL
	TAD DEVTBA	/GET THE DEVTBL POINTER
	DCA FORDEV	/ FOR THE INPUT DDB
	TAD FORDEV
	TAD FORMX
	SMA CLA		/IS IT A LEGAL KEYBOARD # ?
	JMP I COMERA	/NO
	DATFLD
	TAD I FORDEV
	CHDF
	SZA CLA		/DOES IT ALREADY HAVE AN INPUT DDB?
	JMP FOR1	/YES
	TAD FORDEV	/NO; GET ONE
	CIF
	GETDDB
	JMP I COMERA	/NONE TO GET- NEVER HAPPENS
	DATFLD
	TAD I FORDEV	/GET THE DDB LOCATION
	DCA CHDFA
	TAD I CHDFA
	TAD COMDSI	/ & SET THE 'DSI' BIT
	DCA I CHDFA
	CHDF
/
/HERE WE CHECK TO PREVENT A MERE OPERATOR FROM FORCING
/A MANAGER'S ACCOUNT NUMBER.
FOR1,	CHKACT		/CHECK OUR OWN ACCOUNT FIRST
	REBOOT
	SKP		/OPERATOR - CHECK THE FORCEE
	JMP FOR3	/MANAGER - HE CAN FORCE ANYONE
	DATFLD
	TAD I FORDEV	/GET THE DDB
	DCA IX1
	TAD I IX1	/GET THE JOB NUMBER
	SZA
	SETJOB		/ AND SET UP FOR OUR CHECK
	JMP .+4		/NO JOB ACTIVE - CAN'T FORCE
	CHKACT		/NOW CHECK THE OWNER'S ACCOUNT
	NOP
	JMP FOR2	/OK - HE'S MERELY MORTAL
	SETJOB		/BAD - RESET 'JOBDAT'
	REBOOT
	TAD .+2
	JMP I COMERA	/HE'S TRYING TO FORCE A MANAGER
	FORMSG

FOR2,	SETJOB		/RESTORE 'JOBDAT'
	REBOOT
FOR3,	SKIP		/IGNORE ANY SPACES
	JMP I COMEXA
	DATFLD
	TAD I FORDEV
	DCA CHDFA	/POINTS TO DDB WORD 0
	TAD I CHDFA
	AND FORCLR	/CLEAR THE 'FORCED' FLAG
	TAD FORFLG	/ AND THEN SET IT
	DCA I CHDFA
	TAD CHAR
FOR4,	TAD FORMSL
	SZA CLA		/IS IT A SLASH (INDICATING CTRL)?
	JMP FOR5	/NO
	COMGET		/YES - GET THE NEXT CHARACTER
	JMP I COMEXA	/ (ALSO SHOULD NEVER HAPPEN)
	JMS I FORFLC	/CONVERT THIS TO UPPER-CASE
	AND FORCTL	/ AND MAKE IT A CTRL-CHARACTER
	SKP
FOR5,	TAD CHAR
	CDF
	DCA I TTYCHR	/STORE THE CHARACTER FOR GIR
	CHDF
	CIF
	GIR		/NOW PROCESS THE CHARACTER
FORDEV,	 0
	JMP I COMERA	/NO ROOM - TAKE ERROR EXIT
	CLA CLL CML RTL
	ENDTST		/LINE TERMINATOR?
	JMP I COMEXA	/YES - WE'RE DONE
	COMGET		/NO - GET THE NEXT CHARACTER
	JMP I COMEXA	/ (SHOULD NEVER HAPPEN)
	JMP FOR4

FORCLR,	-DFORC-1
FORFLG,	0	/CHANGE TO 'DFORC' (4) AND MGR CAN FORCE A LOGIN W/O PASSWORD
FORCTL,	-100-1
FORDIF,	NULINE+NULINE-FRCMAX-FRCMAX	/FUDGE FACTOR FOR ACTUAL TTY'S
FORFLC,	FIXLC
FORMSL,	-"/	/INDICATES NEXT CHARACTER SHOULD BE CTRL
FORMX=	IOTP1
GIR=	JMS I .
	GIR00

LOGOMA,	5457	/LO
	4757	/GO
	6564	/UT
ODTMA,	5744	/OD
	6450	/TH
	5100	/I
SYSMA,	6371	/SY
	6364	/ST
	4164	/AT

LOGE5,	"P;"R;"E;"C;"E;"D;"E;" ;"L;"O;"G;"I;"N;" ;"B;"Y;" ;"^;"B;0
	PAGE

/THIS HANDLES THE 'F' COMMAND - WE PRINT OUT SOME
/INFORMATION ABOUT THE FILE OPEN ON AN INTERNAL FILE #.
	SIERR
	JMP F2
F,	NUMBIN		/INTERNAL FILE #
	 -"7
	JMP I COMERA	/NO NUMBER - ERROR!
	AND C0003
	DCA IOTP1
	JMP I LNGIOT

F2,	RETPAR
	ASCOUT
	 CRLF
	NOP
	TAD IOTP1	/ACCT #
	SNA
	JMP I COMEXA	/FILE NOT OPEN
	TAD P7777
	SZA CLA		/IS THIS A UFD?
	JMP F3		/NOPE
	TAD IOTP2	/YES - TYPE "NNNN <UFD>"
	DCA IOTP1
	TAD FMSGAD
F3,	TAD FIOT2	/SET SIXBIT MESSAGE ADDRESS
	DCA F4
	TAD IOTP0	/GET THE FIRST 'FINF' WORD
	SMA CLA		/WAS THE FILE EXCLUSIVELY ASSIGNED?
	JMP .+4		/NO
	ASCOUT		/YES - PRINT "X "
	 FXMSG
	NOP
	TAD IOTP1
	OCTASC
	 COMBUF-1
	JMS FOUT	/TYPE THE ACCOUNT NUMBER
	JMS I FSIXAS	/FILE NAME OR "<UFD>"
F4,	 0		/ (6-BIT MESSAGE ADDRESS)
	 COMBUF-1
	JMS FOUT	/ & TYPE IT
	TAD IOTP5
	OCTASC
	 COMBUF-1
	JMS FOUT	/TYPE THE EXTENSION & PROTECTION
	TAD IOTP6
	JMS I FDECOU	/CONVERT THE SIZE TO DECIMAL ASCII
	 COMBUF-1
	ASCOUT		/ AND TYPE IT
	 COMBUF
	JMP I COMEXA
	JMP I COMEXA	/ & EXIT

/ROUTINE TO TYPE 'COMBUF' FOLLOWED BY A SPACE.
FOUT,	0
	ASCOUT
	 COMBUF
	JMP I FOUT
	ASCOUT
	 SPACE
	JMP I FOUT
	JMP I FOUT

FDECOU,	DECOUT
FIOT2,	IOTP2
FMSGAD,	FMSG-IOTP2
FSIXAS,	SIXASC
FMSG,	3465; 4644; 3600	/ "<UFD>" IN SIX-BIT
FXMSG,	"X;" ;0
/'USER' COMMAND - WE TYPE OUT THIS (OR ANY) JOB'S
/JOB NUMBER AND ITS KEYBOARD NUMBER.

USEJOB=	FOUT

USER,	ASCOUT		/TELL USER WHERE HE IS
	 CRLF
	JMP I COMEXA	/NO ROOM, SO SKIP IT
	ENDTST		/ANY MORE TO COMMAND?
	JMP .+4		/NO - ASSUME THIS JOB
	NUMBIN		/NO; WHAT JOB THEN?
	 -"7		/OCTAL JOB #
	JMP I COMERA	/ILLEGAL NUMBER - ERROR!
	JMS USER0	/PRINT THE INFO
	JMP I COMERA	/BAD NUMBER - ERROR
	JMP I COMEXA	/ AND EXIT

/ROUTINE TO PRINT THE 'USER' COMMAND INFO.
USER0,	0
	DCA USEJOB
	TAD USEJOB
	TAD MJBMAX	/-HIGHEST JOB #
	SMA SZA CLA	/LEGAL JOB NUMBER?
	JMP I USER0	/NO - TAKE ERROR RETURN
	ISZ USER0
	TAD USEJOB
	SETJOB		/SET UP 'JOBDAT'
	JMP USER1	/NOT LOGGED IN - SAY NOTHING
	TAD IOTP7	/GET THE JOB # SET BY 'SETJOB'
	DCA USEJOB	/ AND MAKE SURE WE USE THE SAME ONE
	ASCOUT		/TYPE "JOB "
	 JOBNO
	JMP USER1	/NO ROOM - JUST EXIT
	TAD USEJOB
	JMS USRPR	/PRINT 2 OCTAL DIGITS
	ASCOUT
	 LBRACK
	JMP USER1
	GETWRD		/GET THE ACCOUNT NUMBER
	 JOBACT
	OCTASC		/ CONVERT IT TO ASCII
	 COMBUF-1
	ASCOUT		/ AND TYPE IT
	 COMBUF
	JMP USER1
	ASCOUT
	 RBRACK
	JMP USER1
	TAD USEJOB
	TAD TTYTBA	/POINTS TO ENTRY IN TTYTBL
	DCA IOTP1
	DATFLD
	TAD I IOTP1	/GET TTY #
	CHDF
	JMS USRPR	/TYPE THE 2 DIGIT KEYBOARD NUMBER
USER1,	SETJOB		/RESTORE 'JOBDAT'
	NOP
	JMP I USER0	/ & RETURN

/ROUTINE TO TYPE 2-DIGIT OCTAL NUMBER FROM THE AC.
USRPR,	0
	AND C0037
	OCTASC
	 COMBUF-1	/SNEAKY WAY TO SUPPRESS LEADING 00
	ASCOUT
	 COMBUF+2
	NOP
	JMP I USRPR
	PAGE

/THIS CODE HANDLES THE 'R' AND 'RUN' COMMANDS.
/CAUTION SHOULD BE EXERCISED WHEN CHANGING THIS CODE AS
/IT IS ENTERED BY THOSE COMMANDS WHICH LOAD AND START
/PARTICULAR SYSTEM PROGRAMS. ALSO, THIS CODE IS TIED CLOSELY
/TO THE 'LOAD', 'SAVE', AND 'START' COMMAND HANDLERS.

	IFNZRO LIBACT-2 <GLITCH>

RERR,	SIERR
	JMP I COMERA

/THIS HANDLES THE "RUN" COMMAND.
	JMP RERR
	JMP R1
RUN,	JMP I .+1
	LOAD

/THIS HANDLES THE "R" COMMAND.
	JMP RERR
	JMP R1
R,	CLA CLL CML RTL	/AC = 2 (SYSTEM LIBRARY ACCOUNT)
	JMP I .+1
	SAVE1

/THIS HANDLES THE AUTOMATIC "R" PERFORMED FOR
/AN UNRECOGNIZED SYSTEM COMMAND.
	JMP RERR
	JMP AUTOR2
AUTOR,	CLA CLL CML RTL	/AC = 2 (SYSTEM LIBRARY ACCOUNT)
	DCA IOTP2	/SET FOR THE SYSTEM LIBRARY
	JMP I .+1	/ AND GO OPEN THE FILE
	AUTOR1

AUTOR2,	GETWRD		/GET THE RETURNED AC
	 JOBREG+2
	SZA CLA		/GOOD 'OPEN'?
	JMP I COMERA	/NO - JUST ECHO THE COMMAND

R1,	DCA RSTART	/SAVE START-ADDRESS (USUALLY ZERO)
	GETWRD		/RETURN FROM OPEN
	 JOBREG+2
	SZA CLA		/GOOD 'OPEN' STATUS?
	JMP I IOTEND	/NO - PRINT ERROR MESSAGE
	GETTBA
	 JOBSRA
	DCA IOTP7	/SET A POINTER TO THE RESTART-ADDRESS
	TAD RSTART
	DATFLD
	DCA I IOTP7	/ AND INITIALIZE IT TO THE START-ADDR.
	CHDF
	GETTBA
	 JOBLNK
	GETFBL		/NOW LINK ON A PARAMETER BLOCK
	COMWAT
	DCA I R4A
	GETTBA
	 JOBREG
	DCA IOTP2	/SET THE POINTER FOR 'START' CODE
	TAD R6A
	DCA EXITA	/FUDGE EXIT ADDRESS
	TAD RSTART	/NOW GET THE PROGRAM START-ADDRESS
	JMP I .+1	/ AND RUN THROUGH 'START' CODE
	START2

/WE RETURN FROM 'START' CODE HERE - JOB STATUS AND WAIT
/REGISTERS HAVE BEEN SET, ALONG WITH THE AC, PC, & MQ.
R6,	GETWRD		/GET THE STR1 STATUS WORD
	 JOBSTS+1
	AND RJSDEL	/ AND SAVE THE 'JSDEL' FLAG
	DATFLD		/BUT CLEAR JSWAIT SO WE WON'T START RUNNING
	DCA I IOTP7	/ IF WE HAVE TO LOAD HIS SWAP AREA
	TAD C0003	/SET THE FILE NUMBER
	TAD C4000	/ AND THE BIT TO SHOW THIS IS FROM 'SI'
	DCA IOTP2
	STA
	TAD RSTART
	DCA IOTP4	/CORE ADDRESS - 1
	TAD RRFILE
	DCA IOTP0	/SET THE 'RFILE' IOT
	TAD RSTART
	SZA CLA		/IS THE START-ADDRESS ZERO?
	JMP I RLOAD4	/NO - GO LOAD HIS SWAP-AREA IF NEEDED
	JMS I RLSA	/GO BUILD FILE-TRANSFER BLOCK
	TAD SIJOB
	CORES		/SEARCH FOR THE JOB IN CORE
	SZA CLA		/IS THIS JOB ALREADY IN CORE?
	JMP R8		/YES
	ASSCOR		/NO - ASSIGN IT OUR FIELD
R7,	CIF CDF
	JMP I .+1	/NOW GO TO FIELD 0 TO READ IN THE FILE
	READFI

R8,	TAD R6B		/RESTORE EXIT
	DCA EXITA
	RELCOR
	JMP R7

R4A,	R4
R6A,	R6
R6B,	COMEXT
	IFNZRO JSDEL-100	<GLITCH>
RJSDEL=	C0100	/JSDEL
RRFILE,	RFILE
RLOAD4,	LOAD4
RLSA,	RLS
/'SYSTAT' COMMAND - SAME AS TYPING 'R SYSTAT'.

	JMP RERR
	JMP R1
SYSTAT,	TAD SYSM	/SYSTAT COMMAND
	DCA IX1		/POINTER TO FILE NAME
	TAD I IX1	/PUT "SYSTAT" OR "LOGOUT" IN IOTP3,4,5
	DCA IOTP3
	TAD I IX1
	DCA IOTP4
	TAD I IX1
	DCA IOTP5
	CLA CLL CML RTL	/SET THE SYSTEM LIBRARY ACCOUNT
	DCA IOTP2
	JMP I .+1
	SAVNAM		/GO SAVE NAME; THEN OPEN FILE

SYSM,	SYSMA-1

/WE COME HERE TO FINISH UP THE 'LOGIN' - PRINT THE LAST
/OF THE SYSTEM INTRODUCTION & PREPARE TO START
/THE PROGRAM 'LOGIN' TO PRINT A MESSAGE-OF-THE-DAY.
LOGIF2,	DCA .+4		/SAVE THE POINTER TO THE TIME MESSAGE
	TAD COMEXP
	DCA COMEXA	/ AND RESTORE THE 'COMRET' POINTER
	ASCOUT		/TYPE THE TIME
RSTART,	 0
C7000,	NOP
	TAD CHAR
	TAD NSEMI
	SNA CLA		/DID THE COMMAND END WITH A SEMI-COLON?
	JMP I COMEXA	/YES - JUST EXIT

/CODE TO FUDGE POINTERS TO START PROGRAM 'LOGIN'.
/WE SET UP 'SI' POINTERS TO THINK IT'S DOING 'SYSTAT'
	TAD LOGPTR
	DCA SYSM	/STORE POINTER TO 'LOGIN'
	TAD CL40A	/FUDGE 'COMLNK'
	DCA COMLNK
	JMP I .+1	/THEN RE-ENTER 'SI'
	COM91

CL40A,	CL40	/COMMAND PACKET FOR 'SYSTAT'
LOGPTR,	LOGN5A-1	/POINTER TO "LOGIN"
NSEMI,	-";

/THIS HANDLES THE 'LOGOUT' COMMAND - ALL WE DO
/IS LOAD AND START THE LIBRARY PROGRAM 'LOGOUT'. IT
/DELETES THE USER'S TEMPORARY FILES & THEN LOGS HIM
/OUT USING THE 'LOGOUT' IOT.

	JMP RERR	/SYSTEM ERROR DURING 'OPEN'
	JMP R1
LOGOUT,	TAD LOGMA	/GET THE POINTER TO "LOGOUT" STRING
	JMP SYSTAT+1	/ & SHARE 'SYSTAT' CODE

LOGMA,	LOGOMA-1

/THIS HANDLES THE 'ODT' COMMAND; WE LOAD "ODTHI" AND START
/IT AT LOCATION 7000.
	JMP RERR
	JMP ODT1
ODT,	TAD .+2
	JMP SYSTAT+1	/GO OPEN THE "ODTHI"
	ODTMA-1

ODT1,	TAD C7000	/GET 'ODTHI'S START-ADDRESS
	JMP R1		/ AND START IT
	PAGE
/THIS HANDLES THE 'SAVE' COMMAND; NOTE THAT THIS COMMAND
/SHARES MUCH OF THE 'LOAD' COMMAND HANDLER.
	JMP I LOADER	/ERROR DURING 'OPEN'
	JMP SAVE2	/'OPEN' WORKED
SAVE,	JMP SAVE3	/GO PICK UP FILENAME & DO 'OPEN'

SAVE2,	TAD SWFILE	/PICK UP THE 'WFILE' IOT
	JMP LOAD2	/ AND SHARE MORE 'LOAD' CODE
SWFILE,	WFILE

/THIS HANDLES THE 'LOAD' COMMAND; NOTE THAT MUCH OF THIS
/CODE IS SHARED BY OTHER COMMANDS.
	JMP I LOADER
	JMP LOAD1
LOAD,
SAVE3,	ACCTIN
	SKP
SAVE1,	DCA IOTP2	/ACCOUNT #
	ENDTST		/ANY MORE TO COMMAND?
	JMP I COMERA	/NO - ERROR
	TAD COMBFA
	TEXTS		/READ IN THE FILENAME
	CLA
AUTOR1,	ASCSIX		/CONVERT THE FILENAME TO SIX-BIT
	 COMBUF-1
	 IOTP3-1
	JMP I .+1	/ AND SAVE THE PROGRAM NAME IN PRGTBL
	SAVNAM

LOAD1,	TAD LRFILE
LOAD2,	DCA IOTP0
	GETWRD		/ERROR?
	 JOBREG+2
	SZA CLA
	JMP I IOTEND	/YES
	GETTBA		/NO. SET UP RFILE OR WFILE
	 JOBLNK
	GETFBL
	COMWAT
	DCA R4
	CLL CML RTR	/AC=2000
	TAD C0003	/FILE #
	DCA IOTP2
	STA		/DEFAULT CORE ADDRESS
	DCA IOTP4
	ENDTST		/ANY PARAMETERS?
	JMP LOAD3	/NO
	NUMBIN		/YES. FILE ADDRESS O2 CAN BE 6 DIGITS!
	 -"7
	JMP LOAD3
	DCA IOTP5	/LEAST SIGN. 12 BITS
	TAD NUMHO
	DCA IOTP1	/HIGH ORDER
	ENDTST
	JMP LOAD3
	NUMBIN		/STARTING CORE ADDRESS
	 -"7
	JMP LOAD3
	TAD IOTP4
	DCA IOTP4
	ENDTST
	JMP LOAD3
	NUMBIN		/LAST CORE ADDRESS
	 -"7
	CLA CMA
	CIA
	TAD IOTP4
	DCA IOTP3	/WORD COUNT
LOAD3,	TAD LOAD4A
	DCA EXITA
	JMP I COMEXA

LOAD4,	JMS RLS
	TAD SIJOB	/SET UP XFER BLOCK TO LOAD USER AREA
	TAD LOADM1
	TAD SWBASE
	CLL RTL
	DCA LOADEX
	TAD SIJOB
	CORES
	SZA CLA
	JMP I LOAD6A	/JOB IS IN CORE
	TAD LOADUB
	JMP I LOADUA

LOADER,	RERR
LOADUA,	LOADUS
LRFILE,	RFILE
LOAD4A,	LOAD4
LOAD6A,	R8
LOADUB,	.+1
	DMAR
LOADEX,	0	/DISC EXTENSION
	10
	0	/DISC ADDRESS
LOADM1,	-1	/CORE ADDRESS - 1
	0	/ (-) WORD COUNT
	OVERLA
	READFI
/SUBROUTINE CALLED BY "R", "RUN", "LOAD", & "SAVE" TO
/SET UP THE FILE TRANSFER BLOCK POINTED TO BY 'JOBLNK'.

RETTMP,
RLS,	0
	CHDF
	GETTBA		/GET JOB'S WAIT-MASK ADDRESS
	 JOBWMK
	DCA IOTP7
	TAD RJSF3
	DATFLD
	DCA I IOTP7	/SET WAIT FOR FILE # 3
	ISZ IOTP7
	DCA I IOTP7	/ AND CLEAR WAIT-MASK 2
	TAD SIJOB
	CDF
	DCA I SIREG	/SAVE JOB # FOR 'READFI' IN FIELD 0
	CHDF
	TAD SIJOB
	DCA CORJOB	/SET FOR CORE-ASSIGNMENT
	CIF
	BLT		/COPY OVER THE 'RFILE' OR 'WFILE' PARAMETERS
	 CHDF
	 IOTP0
	 DATFLD
R4,	 0
	 -6
	JMP I RLS	/THEN JUST RETURN

RJSF3,	JSF3+JSWAIT

/
/RETURN BLOCK TO FREE STORAGE
/CALL:	TAD ADDR OF BLOCK
/	RETDBL
/	RETURN

RETDB0,	0
	SNA		/IS IT A REASONABLE ADDRESS?
		IFNZRO DEBUG <
	REBOOT		/NO - ERROR *****
		>
		IFZERO DEBUG <
	JMP I RETDB0	/JUST RETURN IF IN A PRODUCTION SYSTEM
		>
	DCA RETTMP
	TAD RETTMP
	CIF
	RETBLK		/USE FIELD 0 ROUTINE TO RELEASE IT
	JMP I RETDB0

/RETURN LINKED BLOCKS TO FREE STORAGE
/CALL:	TAD ADDRESS OF LINKED LIST
/	RETBKS
/	RETURN

RETBK0,	0
	SNA		/REACHED END OF LIST?
	JMP I RETBK0	/YES - RETURN
	RETDBL		/NO - RETURN THE BLOCK
	JMP .-3		/ AND CHECK AGAIN
	PAGE

C7766,	7766
DEPO3A,	DEPOS3

DEPOSI,	CHKIO		/CHECK FOR RK05 OR DECTAPE ACTIVITY
	NUMBIN		/STARTING ADDRESS
	 -"7
	JMP I COMERA
	DCA IOTP5	/LOW ORDER DISC ADDRESS
	TAD C7766
	DCA IOTP1
	TAD COMBFA
	DCA IX1
DEPOS2,	NUMBIN		/CONVERT ARGUMENT LIST
	 -"7
	JMP DEPOS1
	DCA I IX1
	ISZ IOTP1
	JMP DEPOS2
DEPOS1,	TAD IX1
	CIA
	TAD COMBFA
	SNA
	JMP I COMERA	/NOTHING TO DEPOSIT
	DCA IOTP3	/-WORD COUNT
	CLRPRV		/HE'S CHANGING CORE, CLEAR HIS 'PRIVILEGE'
	TAD SIJOB
	CORES
	SZA
	JMP DEPOS4
	TAD DEPO3A

EXAMI2,	DCA SI1		/RETURN ADDRESS
	TAD COMBFA
	DCA IOTP4	/CORE ADDRESS-1
	CLA CMA		/-1 IN AC
	TAD SIJOB
	TAD SWBASE
	CLL RTL
	DCA IOTP1	/DISC EXTENSION
	TAD C0010
	DCA IOTP2
	TAD DEPEX2
	DCA IOTP6
	DCA IOTP7
	TAD IOTP3	/ARE WE GOING INTO NEXT JOB'S DISC IMAGE?
	CLL CMA		/WORD COUNT -1
	TAD IOTP5	/WC+ADDRESS>7777?
	SNL CLA
	JMP I DEPEX	/NO - OK TO PROCEED
	TAD IOTP5
	DCA IOTP3	/YES - FIX IT TO STOP AT 7777
	JMP I DEPEX
DEPEX,	DEPEXA
DEPEX2,	OVERLA

/RETURN AFTER READING OR WRITING USER AREA

DEPOS3,	TAD COMA
	DCA SI1
	JMP I COMEXA

COMF,	CHDF

	IFNZRO COM-200	<GLITCH>
COMA=	C0200
C0070,	70

DEPOS4,	AND C0070
	TAD C6201
	DCA DEDEF
	TAD IOTP5
	DCA DEDEA
	TAD COMF
	DCA DESRF
	TAD BUFFER
	DCA DESRA
	JMS DEMOVE
	JMP I COMEXA

DEMOVE,	0
	TAD IOTP3
	DCA DECNT
	CIF
	BLT
DESRF,	 0	/FROM FLD
DESRA,	 0	/FROM ADDR
DEDEF,	 0	/TO FLD
DEDEA,	 0	/TO ADDR
DECNT,	 0	/-COUNT
	JMP I DEMOVE
EXAMIN,	NUMBIN		/STARTING ADDRESS
	 -"7
	JMP I COMERA
	DCA IOTP5
	NUMBIN
	 -"9
	IAC
	SNA
	IAC
	CIA
	DCA IOTP3
	TAD IOTP3	/GET (-) THE COUNT
	CLL CMA CML IAC
	TAD C7766
	SNA SZL CLA	/IS THE COUNT TOO LARGE?
	JMP .+3
	TAD C7766	/YES - BRING IT INTO LINE
	DCA IOTP3
	TAD SIJOB
	CORES
	SZA
	JMP EXAMI4
	TAD EXAM1A
	JMP EXAMI2

EXAM1A,	EXAMI1
BUFFER,	COMBUF

EXAMI4,	AND C0070
	TAD C6201
	DCA DESRF
	TAD IOTP5
	DCA DESRA
	TAD COMF
	DCA DEDEF
	TAD BUFFER
	DCA DEDEA
	JMS DEMOVE
	JMP I EXAM1A

FORJOB,	" ;"F;"O;"R;" ;"J;"O;"B;" ;0
	PAGE
/THIS HANDLES THE 'SWITCH', 'RESTART', & 'BREAK' COMMANDS.
/THEY SET THE REGISTERS OR, IF NO PARAMETER IS GIVEN, THEY
/SIMPLY PRINT OUT THEIR CURRENT VALUES.

	IFNZRO DDBBRK-2	<GLITCH>

RESTRT,	CLRPRV		/CLEAR HIS 'PRIVILEGE' BIT
	GETWRD		/GET THE STR0 WORD
	 JOBSTS
	AND RESJSC
	TAD RESJSR	/SET THE 'JSRSEN' BIT TO ENABLE CTRL/C
	DATFLD
	DCA I IOTP7
	TAD JBSRA	/GET THE RESTART-ADDRESS
SWITCH,	TAD JBSWR	/GET THE SWITCH-REGISTER
	DCA .+2
	GETTBA		/GET THE REGISTER ADDRESS
	 0
	JMP BRK1	/THEN SHARE THE BREAK CODE
BREAK,	CLA CLL CML RTL
	TAD COMDB0	/GET THE BREAK-MASK LOCATION
BRK1,	DCA IOTP1
	ENDTST		/IS THERE A PARAMETER?
	JMP BRK2	/NO - PRINT THE CURRENT VALUE
	NUMBIN		/YES - GET THE NEW VALUE
	 -"7
	JMP I COMERA	/INVALID CHARACTER IN NUMBER
	DATFLD
	DCA I IOTP1	/SET THE NEW VALUE
	JMP I COMEXA	/ AND EXIT
BRK2,	DATFLD
	TAD I IOTP1	/GET THE CURRENT VALUE
	CHDF
	OCTASC		/CONVERT IT TO ASCII
	 IOTP3-1	/ IN IOTP3 - IOTP7
	TAD .+2
	JMP I COMEXA	/THEN EXIT
	IOTP3

JBSRA,	JOBSRA-JOBSWR
JBSWR,	JOBSWR
RESJSC,	-JSRSEN-1
RESJSR,	JSRSEN

WHERLK,	" ;"L;"=;0
WHERSW,	" ;"S;"W;"=;0
/THIS HANDLES THE 'TALK' COMMAND. "TALK NN ...MSG..."
/CAUSES THE MESSAGE '...MSG...' TO BE SENT TO KEYBOARD 'NN'.

	IFNZRO DTALK-1	<GLITCH>

TALK,	NUMBIN		/GET THE CONSOLE #
	 -"7
	JMP I COMERA	/BAD CHARACTER - ERROR!!
	DCA IOTP0
	TAD IOTP0
	SPA		/NEGATIVE KEYBOARD? (USED FOR FORCING PAST LOCKS)
	CIA
	CLL CML RAL	/ *2+1
	TAD DEVTBA
	DCA IOTP2	/POINTS TO OUTPUT DEVTBL ENTRY
	DATFLD
	TAD I IOTP2
	DCA TALK5
	TAD I TALK5	/GET THE DDB STATUS WORD
	CHDF
	CLL RAR
	SNL CLA		/ARE TALKS TO THIS TERMINAL INHIBITED?
	JMP TALK1	/NO
	CHKACT		/YES - CHECK OUR ACCOUNT NUMBER
	JMP TALKER	/NORMAL USER - TELL HIM "NO TALKS"
	NOP
	TAD IOTP0
	SMA		/OPERATOR OR MANAGER - IS HE OVERRIDING THE LOCK?
	JMP TALKER	/NO
	CIA
	DCA IOTP0	/YES - FIX THE KEYBOARD NUMBER
TALK1,	CLA CLL CML
	TAD IOTP0
	TAD TALKMX
	SNL CLA		/IS THIS A LEGAL KEYBOARD?
	JMP I COMERA	/NO - ERROR!!
TALK2,	TAD SIKBD	/GET NUMBER OF CALLING CONSOLE
	OCTASC		/CONVERT IT TO ASCII
	 COMBUF-1	/ AND PUT IN COMBUF
	JMS TALK5	/"CRLF** K"
	 TALKM1
	JMS TALK5	/"MM"
	 COMBUF+2
	GETWRD		/GET THE SENDER'S ACCOUNT NUMBER
	 JOBACT
	OCTASC		/ & CONVERT IT TO ASCII
	 COMBUF-1
	JMS TALK5	/NOW TYPE "/"
	 TALKM2
	JMS TALK5	/ & THE ACCOUNT NUMBER
	 COMBUF
	JMS TALK5	/ AND ": "
	 TALKM3
	DCA CHAR+1	/ *** CHAR+1 MUST BE SCRATCHABLE ***
	CLA CLL CML RTL
	ENDTST		/END-OF-LINE BEFORE WE START?
	JMP TALK4	/YES
TALK3,	COMGET		/GET MESSAGE CHARACTER
	JMP TALK4	/NONE LEFT; SHOULDN'T HAPPEN
	CLA CLL CML RTL	/ALLOW ':' AND ';' IN MESSAGE
	ENDTST		/TERMINATING MESSAGE?
	JMP TALK4	/YES - SEND CRLF
	TAD CHAR
	AND C0140
	SNA CLA		/IS IT A CONTROL CHARACTER?
	JMP TALK3	/YES - JUST IGNORE IT
	JMS TALK5	/NO - SEND THE CHARACTER
	 CHAR
	JMP TALK3	/ AND GO FETCH THE NEXT
TALK4,	JMS TALK5	/SEND THE <CR-LF>
	 CRLF
	JMP I .+1	/THEN FORCE HIS OWN 'SETQ'
	SETQ

TALKER,	CLA
	TAD .+2
	JMP I COMERA	/ERROR RETURN TYPING "NO TALKS"
	TALKLM

/ROUTINE TO TYPE A MESSAGE ON THE TELETYPE WHOSE DDB
/ADDRESS IS IN IOTP2.
TALK5,	0		/OUTPUT A CHARACTER
	TAD I TALK5	/BUFFER ADDRESS
	DCA .+3
	TAD IOTP2	/DEVTBL ENTRY ADDRESS
	ASCOUT
	 0
	JMP I COMERA	/NO ROOM - JUST TREAT AS ERROR
	ISZ TALK5	/SKIP ARGUMENT
	JMP I TALK5

C0140,	140
TALKMX,	-TLKMAX-1	/(-) FIRST ILLEGAL KEYBOARD
	PAGE

CLK1A,	CLK1
CLK2A,	CLK2
TICLK2,	INCLK2
TICLK1,	INCLK1

TIME,	ENDTST		/ARGUMENT?
	JMP TIME1	/NO - ASSUME THIS JOB
	NUMBIN
	 -"7
	JMP I COMERA	/ILLEGAL PARAMETER - ERROR!
	DCA IOTP0
	CLA CLL CML
	TAD IOTP0
	TAD MJBMAX
	SZA SNL CLA	/LEGAL JOB #?
	JMP I COMERA	/NO
	TAD IOTP0
	SNA		/JOB 0?
	JMP TIME3	/YES - TYPE TIME OF DAY
	SETJOB		/NO - SET UP 'JOBDAT'
	SKP		/NO JOB - JUST EXIT
	JMP TIME2
	SETJOB		/RESTORE 'JOBDAT'
	NOP
	JMP TIME5	/ AND EXIT

TIME2,	CHDF
	GETWRD
	 JOBRTM
	DCA NUMHO+1
	GETWRD
	 JOBRTH		/HI ORDER TIME
TIME4,	DCA NUMHO
	JMS PTIME
	SETJOB		/RESTORE 'JOBDAT' IF ALTERED
	NOP		/NO MATTER IF NOT LOGGED IN
	TAD COMBFA
	IAC
TIME5,	CHDF
	JMP I COMEXA

TIME1,	TAD SIJOB
	SZA CLA		/IS HE LOGGED IN?
	JMP TIME2	/YES - TYPE HIS CPU TIME

TIME3,	CDF
	TAD I CLK1A
	CLL
	TAD TICLK1
	DCA NUMHO+1
	RAL
	TAD I CLK2A
	TAD TICLK2
	CHDF
	JMP TIME4
/ROUTINE TO CONVERT VALUE IN NUMHO AND NUMHO+1 (IN TICKS)
/TO HOURS, MINUTES AND SECONDS. 
/THE RESULT IS STORED IN COMBUF AS HH:MM:SS

PTIME,	0		/ENTER WITH AC=0
	TAD COMBFA	/START OF OUTPUT BUFFER
	DCA IX1
	TAD PTABX	/SET UP TABLE FETCH (LOW)
	DCA PTIMX
	TAD PTABX1	/SET UP TABLE FETCH (HIGH)
	DCA PTIMX1
	TAD PTFORM	/FORMAT MASK
	DCA PTCONT

PTLOOP,	TAD PT0260	/INITIALIZE DIGIT COUNTER
	DCA PTDIGI
	CLL		/DIVIDE LOOP
	TAD NUMHO+1	/DOUBLE PRECISION ADD
PTIMX,	NOP		/(TAD PTAB1+N)
	DCA NUMHO+2	/SAVE LOW ORDER REMAINDER
	RAL		/GET OVERFLOW
	TAD NUMHO	/ADD HIGH ORDER
PTIMX1,	NOP		/(TAD PTAB+N)
	SNL
	JMP PTIMA	/DIVIDE OVERFLOW
	DCA NUMHO	/RESTORE REMAINDER
	TAD NUMHO+2	/LOW ORDER RESTORE
	DCA NUMHO+1
	ISZ PTDIGI	/COUNT THIS SUBTRACTION
	JMP PTIMX-2	/CONTINUE LOOP

PTIMA,	ISZ PTIMX	/ADVANCE TABLE FETCH
	ISZ PTIMX1	/ADVANCE TABLE FETCH
	CLA		/CLEAR OUT REMAINDER
	TAD PTDIGI
	DCA I IX1	/STORE ASCII DIGIT
	TAD PTCONT
	SZA		/ARE WE ALL DONE?
	JMP .+3		/NO
	DCA I IX1	/YES - STORE A ZERO
	JMP I PTIME	/ AND RETURN
	RAL CLL		/TEST FOR COLON PRINT
	DCA PTCONT	/RESTORE FORMAT
	SZL		/PRINT COLON?
	JMP PTLOOP	/CONTINUE LOOP
	TAD PTCOLN	/ADD COLON TO OUTPUT
	DCA I IX1
	JMP PTLOOP	/CONTINUE LOOP

PTABX,	TAD PTAB1	/TABLE FETCH LOW
PTABX1,	TAD PTAB	/TABLE FETCH HIGH
PTFORM,	5200		/FORMAT FOR OUTPUT
PT0260,	260
PTCOLN,	272		/ASCII COLON

PTDIGI,	0		/ASCII DIGIT BUILT HERE
PTCONT,	0		/LOOP CONTROL

	IFNZRO TICSPS-24	<GLITCH>
/DOUBLE PRECISION WORDS...HIGH ORDER BITS
PTAB,	7520		/-TICKS PER 10 HRS
	7756		/-TICKS PER 1  HR
	7775		/-TICKS PER 10 MIN
	7777		/-TICKS PER 1  MIN
	7777		/-TICKS PER 10 SEC
	7777		/-TICKS PER 1  SEC

/DOUBLE PRECISION WORDS...LOW ORDER BITS
PTAB1,	1600		/-TICKS PER 10 HRS
	3300		/-TICKS PER 1 HR
	0440		/-TICKS PER 10 MIN
	5520		/-TICKS PER 1 MIN
	7470		/-TICKS PER 10 SEC
	7754		/-TICKS PER 1 SEC

STARS,	215;212;207;"*;"*;"*;" ;0
QQEST,	"?
QEST,	"?;0
WHERPC,	"P;"C;"=;0
	PAGE
/'SEGS' COMMAND - TYPE THE NUMBER OF FREE DISC SEGMENTS

SEGS0,	ASCOUT
	 CRLF
	JMP I COMEXA
	CDF
	TAD I SEGCNT	/GET THE NUMBER FROM FIELD 0
	CHDF
	JMS DECOUT	/ CONVERT IT TO DECIMAL
	 COMBUF-1
	ASCOUT		/ AND TYPE IT
	 COMBUF
	JMP I COMEXA
	ASCOUT
	 FSEGMS
	JMP I COMEXA
	JMP I COMEXA	/THEN EXIT
/
SEGCNT,	NFSEGS
/ROUTINE TO CONVERT CONTENTS OF AC INTO DECIMAL ASCII
/CALL:	TAD (VALUE)
/	JMS I (DECOUT
/	 BUFFER-1
/
DECOUT,	0
	DCA DECNUM	/SAVE THE VALUE
	TAD I DECOUT
	DCA IX1		/SET THE BUFFER POINTER
	ISZ DECOUT
	TAD DECTAD
	DCA DECOT2	/SET TABLE FETCH
	CLL CMA RTL	/AC:=-3
	DCA NUMHO	/SET DIGIT COUNTER
	DCA DECPRT	/CLEAR OUTPUT FLAG
DECOT1,	DCA DECDIG	/ZERO THE DIGIT
DECOT2,	TAD DECTAD+1
	CLL CML
	TAD DECNUM	/13-BIT SUBTRACT
	SZL		/HAS IT GONE NEGATIVE?
	JMP .+5		/YES - WE WENT TOO FAR
	DCA DECNUM
	ISZ DECDIG	/INCREMENT THE DIGIT
	ISZ DECPRT	/ & SET THE 'PRINT' FLAG
	JMP DECOT2
	CLA
	TAD DECPRT
	SNA CLA		/ARE WE PRINTING?
	JMP .+4		/NO - NO NON-ZERO YET
	TAD DECDIG
	TAD DEC260
	DCA I IX1	/YES - STORE THE DIGIT
	ISZ DECOT2	/INCREMENT THE TABLE-FETCH
	ISZ NUMHO
	JMP DECOT1	/DO THE NEXT DIGIT
	TAD DECNUM
	TAD DEC260
	DCA I IX1	/ALWAYS DO THE LAST DIGIT
	DCA I IX1	/ AND STORE A ZERO TERMINATOR
	JMP I DECOUT

DEC260,	260
DECDIG,	0
DECNUM,	0
DECTAD,	TAD .+1
	-1750	/1000
	-144	/100
	-12	/10
/ROUTINE TO SET UP 'JOBDAT' FOR DIFFERENT JOB NUMBERS

DECPRT,
SETJB0,	0
	DATFLD
	AND C0037
	SNA		/ANY PARAMETER PASSED?
	TAD SIJOB	/NO - SET CURRENT JOB
	DCA IOTP7
	CLA CLL CML
	TAD IOTP7
	SNA		/IS HE LOGGED IN?
	JMP SETJB1	/NO - CLEAR JOBDAT
	TAD MJBMAX
	SZA SNL CLA	/LEGAL JOB #?
	JMP SETJB1	/NO - JUST CLEAR 'JOBDAT'
	TAD IOTP7
	TAD JOBTBA	/START OF JOBTBL
	DCA DECOUT
	TAD I DECOUT
	SZA		/IS THE JOB ACTIVE?
	ISZ SETJB0	/YES - SKIP NEXT INSTRUCTION
SETJB1,	DCA I JOBDAT
	CHDF
	JMP I SETJB0	/RETURN
COMLGM,	"L;"O;"G;"I;"N;240;"P;"L;"E;"A;"S;"E;0
UNACCT,	"U;"N;"A;"U;"T;"H;"O;"R;"I;"Z;"E;"D;240
	"A;"C;"C;"O;"U;"N;"T
CRLF,	215
LINE,	212
	0
ILLREQ,	"I;"L;"L;"E;"G;"A;"L;240;"R;"E;"Q;"U;"E;"S;"T;0
/
/COMMAND BUFFER AND ASCII OUTPUT BUFFER
	0
COMBUF,	0
	0
	0
	0
	0
	0
	0
	0
	0
	0
	0
	0

FIPFLS=	USAVE+UREST	/CONTROL-BITS FOR 'FIP' COMMANDS

COMTBL,	CL1			/LOGIN O1 S1;
	NOLOG+PRCRLF		/IOTP2:=O1	ACCOUNT #
	LIN			/IOTP3-4:=S1	PASSWORD
	LOGIN			/RESP: VERSION #	HR:MIN
	-"L			/.
	-"O
	-"G
	-"I
	-"N
CL1,	CL2			/LOGOUT;
	USERM+2			/RESP: .
	OPEN			/.
	LOGOUT
	-"L
	-"O
	-"G
	-"O
	-"U
	-"T
CL2,	CL3			/TIME;
	NOLOG		/RESP:	HR:MIN
	0			/.
	TIME
	-"T
	-"I
	-"M
	-"E
CL3,	CL4			/ASSIGN L1 O1;
	FIPFLS+2		/AC0-5:=DEVICE # OF L1
	ASD			/AC6-11:=O1	UNIT #
	ASSIGN			/ERROR:	AC NOT 0
	-"A			/RESP: .
	-"S
	-"S
	-"I
	-"G
	-"N
CL4,	CL5			/RELEAS L1 O1;
	FIPFLS+2		/SAME AS ASSIGN
	REL
	RELEAS
	-"R
	-"E
	-"L
	-"E
	-"A
	-"S
CL5,	CL7			/TALK C1 S1
	0			/C1=CONSOLE TO TALK TO
	0			/S1=MESAGE TO TRANSMIT
	TALK			/RESP: CR-LF .
	-"T			/ON RECEIVERS TTY: ** KXX/NNNN: S1
	-"A			/ WHERE KXX IS SENDER'S TTY
	-"L			/ AND NNNN IS SENDER'S ACCOUNT #
	-"K
CL7,	CL8			/OPEN O1 S1 O2;
	FIPFLS+2		/IOTP1:=O1	INTERNAL FILE #
	OPEN			/IOTP2:=O2	ACCOUNT #
	FOPEN			/IOTP3-5:=S1	FILE NAME
	-"O			/ERROR: AC NOT 0
	-"P			/RESP: .
	-"E
	-"N
CL8,	CL9			/CLOSE S1;
	FIPFLS+2		/ACI:=1	I=0,1,2,3
	CLOS			/ERROR:	AC NOT 0
	CLOSE			/RESP:
	-"C			/.
	-"L
	-"O
	-"S
	-"E
CL9,	CL10			/CREATE S1;
	FIPFLS+2		/IOTP1-3:=S1	FILE NAME
	CRF			/ERROR:	AC NOT 0
	CREATE			/RESP:
	-"C			/.
	-"R
	-"E
	-"A
	-"T
	-"E
CL10,	CL11			/RENAME O1 S1;
	FIPFLS+2		/IOTP1:=O1	INTERNAL FILE #
	REN			/IOTP2-4:=S1	NEW NAME
	RENAME			/ERROR:	AC NOT 0
	-"R			/RESP: .
	-"E
	-"N
	-"A
	-"M
	-"E
CL11,	CL12			/XOPEN O1 S1 O2
	FIPFLS+2		/OPEN FILE WITH EXCLUSIVE USE
	XOPEN
	FOPEN
	-"X
	-"O
	-"P
	-"E
	-"N
CL12,	CL13			/REDUCE O1 D1;
	FIPFLS+2		/IOTP1:=O1	INTERNAL FILE #
	RED			/IOTP2:=D1	# SEGMENTS TO REMOVE
	REDUCE			/ERROR:	AC NOT 0
	-"R			/RESP: .
	-"E
	-"D
	-"U
	-"C
	-"E
CL13,	CL14			/EXTEND O1 D1;
	FIPFLS+2		/SAME AS REDUCE
	EXT
	EXTEND
	-"E
	-"X
	-"T
	-"E
	-"N
	-"D
CL14,	CL16			/PROTECT O1 O2;
	FIPFLS+2		/AC5-6:=O1	INTERNAL FILE #
	PROT			/AC7-11:=O2	NEW PROTECTION
	PROTEC			/ERROR:	AC NOT 0
	-"P			/RESP: .
	-"R
	-"O
	-"T
	-"E
	-"C
CL16,	CL17			/F O1;
	FIPFLS+3		/IOTP1:=O1	INTERNAL FILE #
	FINF			/ERROR:	AC NOT 0
	F			/RESP: ACCT-# FILE-NAME PROT SIZE
	-"F			/.
CL17,	CL18			/SAVE S1 O1 O2 O3;
	USAVE+UREST+USERM+2
	XOPEN
	SAVE
	-"S
	-"A
	-"V
	-"E
CL18,	CL19			/LOAD O1 S1 O2 O3 O4;
	USAVE+UREST+USERM+2
	OPEN
	LOAD
	-"L
	-"O
	-"A
	-"D
CL19,	CL20			/START O1;
	0
	0
	START
	-"S
	-"T
	-"A
	-"R
	-"T
CL20,	CL21			/S;
	0
	0
	S
	-"S
CL21,	CL22			/WHERE;
	3
	0
	WHERE
	-"W
	-"H
	-"E
	-"R
	-"E
CL22,	CL23			/USER O1;
	NOLOG+1
	0
	USER
	-"U
	-"S
	-"E
	-"R
CL23,	CL29			/SWITCH 01;
	0
	0
	SWITCH
	-"S
	-"W
	-"I
	-"T
	-"C
	-"H
CL29,	CL32		/DUPLEX;
	0
	0
	DUPLEX
	-"D
	-"U
	-"P
	-"L
	-"E
	-"X
CL32,	CL33		/R S1
	USERM+2		/S1=FILE NAME
	OPEN
	R
	-"R
CL33,	CL34		/RUN C1 S1
	USERM+2		/C1=ACCOUNT OF FILE OWNER (OPTIONAL)
	OPEN		/S1=FILE NAME
	RUN
	-"R
	-"U
	-"N
CL34,	CL35		/EXAMINE C1 D1
	USERM+1		/C1=STARTING ADDRESS
	DMAR
	EXAMIN		/D1=#OF LOCATIONS TO EXAMINE
	-"E
	-"X
	-"A
	-"M
	-"I
	-"N
CL35,	CL36		/DEPOSIT C1 C2 C3 ... C13
	USERM+1		/C1=STARTING ADDRESS
	DMAW		/C2,...,C13=NEW VALUES
	DEPOSI
	-"D
	-"E
	-"P
	-"O
	-"S
	-"I
CL36,	CL37		/VERSION
	NOLOG			/RESP: TSS/8.C1
	0
	VERSIN		/C1=VERSION #
	-"V
	-"E
	-"R
	-"S
	-"I
	-"O
CL37,	CL38	/BREAK O1
	0
	0
	BREAK
	-"B
	-"R
	-"E
	-"A
	-"K

CL38,	CL39	/RESTART O1
	0
	0
	RESTRT
	-"R
	-"E
	-"S
	-"T
	-"A
	-"R
CL39,	CL40		/UNDUPLEX
	0
	0
	UNDUPL
	-"U
	-"N
	-"D
	-"U
	-"P
	-"L
CL40,	CL41		/SYSTAT
	USERM+2
	OPEN
	SYSTAT
	-"S
	-"Y
	-"S
	-"T
	-"A
	-"T
CL41,	CL42		/KJOB
	USERM+2		/EQUIVALENT TO .R LOGOUT
	OPEN
	LOGOUT
	-"K
	-"J
	-"O
	-"B
CL42,	CL43		/BROADCAST S1
	0		/SEND MESSAGE S1 TO ALL LOGGED IN CONSOLES
	0		/MUST BE LOGGED-IN ON SYSTEM ACCOUNT
	BROAD
	-"B
	-"R
	-"O
	-"A
	-"D
	-"C
CL43,	CL44		/FORCE C1 ^ S1
	0		/FORCE STRING S1 INTO INPUT BUFFER OF CONSOLE C1
	0		/MUST BE LOGGED-IN ON SYSTEM ACCT
	FORSE		/IF S1 BEGINS WITH ^, IT IS PRECEEDED BY ^B
	-"F
	-"O
	-"R
	-"C
	-"E
CL44,	CL45		/ONLINE
	0		/RE-ENABLES SYSTEM STOPPED BY OFFLINE
	0
	ONLIN
	-"O
	-"N
CL45,	CL46		/OFFLINE
	0		/GRACEFULLY STOPS THE SYSTEM BY
	0		/ DISALLOWING MORE LOGINS
	OFFLIN
	-"O		/USER MUST BE SYSTEM MANAGER
	-"F
	-"F
CL46,	CL47		/ODT
	USERM+2		/LOADS & STARTS 'ODTHI'
	OPEN
	ODT
	-"O
	-"D
	-"T
	-"H
	-"I
CL47,	CL48		/SEGS
	NOLOG+2		/TYPE THE NUMBER OF FREE SEGMENTS
	0
	SEGS0
	-"S
	-"E
	-"G
	-"S
CL48,	CL49		/HALF-DUPLEX HARDWARE (IGNORE 'DUP' IOTS)
	0
	0
	SETH
	-"S
	-"E
	-"T
	-"H
CL49,	CL50		/FULL-DUPLEX HARDWARE (SAME AS 'DUPLEX')
	0
	0
	DUPLEX
	-"S
	-"E
	-"T
	-"F
CL50,	CL51		/INHIBIT TALKS TO THIS TERMINAL
	0
	0
	SETS
	-"S
	-"E
	-"T
	-"S
CL51,	CL52		/REENABLE TALKS TO THIS TERMINAL AFTER 'SETS'
	0
	0
	SETQ
	-"S
	-"E
	-"T
	-"Q
CL52,	0
NONSUC,	"N;"O;"T;" ;"A;"V;"A;"I;"L;"A;"B;"L;"E;0

SYBCLR,	SICLR
SYJSER,	-JSERR-1
SYSCLE,	-JSRUN-JSHLT-JSPRIV-JSINER-7-1
	IFNZRO DSI-1000		<GLITCH>
SYSDSI=	C1000	/DSI
SYSEJN,	USRPR
	IFNZRO JSINER-10	<GLITCH>
SYSINH=	C0010	/JSINER
SYSPRT,	WHEPRT

SYSERR,	TAD SIJOB
	TAD TTYTBA
	DCA COMDB0	/POINTER TO TTYTBL
	DATFLD
	TAD I COMDB0
	CLL RAL		/UNIT*2= POSITION IN DEVTBL
	TAD DEVTBA
	DCA COMDB0
	TAD COMDB0
	CDF
	DCA I COMPTR	/SET SO 'RESDDB' WILL WORK
	DCA COMRDB
	DATFLD
	TAD I COMDB0	/GET THE DDB ADDRESS
	SNA		/IS THERE ONE?
		IFNZRO DEBUG <
	REBOOT		/NO - ERROR *****
		>
		IFZERO DEBUG <
	JMP SYSRR1
		>
	DCA COMDB0
	TAD SYSDSI
	CMA
	AND I COMDB0
	TAD SYSDSI
	DCA I COMDB0	/SET JOB INTO 'SI' MODE
SYSRR1,	CHDF
	JMS SYSER0
	ASCOUT		/RING-A-DING
	 BELMSG
	NOP
	TAD IOTP6
	AND SYSINH
	SZA CLA		/IS THE FULL ERROR-MESSAGE INHIBITED?
	EXIT		/YES - JUST EXIT NOW
	TAD IOTP6
	SMA CLA		/WAS HIS PROGRAM ACTIVE?
	JMP SYSRR2	/NO
	TAD COMDB0
	DATFLD
	CIF
	JMS I SYBCLR	/OFF TO FIELD 0 TO CLEAR HIS INPUT BUFFER
	JMS I SYSPRT	/PRINT THE 'WHERE' INFO
SYSRR2,	ASCOUT
	 CRLF
	NOP
	ASCOUT
	 PERIOD
	NOP
	EXIT

SYSER0,	0
	GETWRD		/GET THE JOB STATUS WORD
	 JOBSTS
	DCA IOTP6
	DATFLD
	TAD IOTP6
	AND C0007
	TAD SYSETB
	DCA SYSER1	/SAVE THE POINTER TO THE ERROR MESSAGE
	TAD IOTP6
	AND SYSCLE	/CLEAR THE ERROR-CODE
	TAD SYSINH	/ AND SET 'ERROR INHIBIT' NOW
	DCA I IOTP7
	ISZ IOTP7
	TAD I IOTP7
	AND SYJSER	/ AND CLEAR JSERR IN STR1
	DCA I IOTP7
	CHDF
	TAD IOTP6
	AND SYSINH
	SZA CLA		/WAS 'INHIBIT' ALREADY SET?
	JMP I SYSER0	/YES - DON'T PRINT ANYTHING
	TAD I SYSER1
	DCA SYSER1
	ASCOUT
	 CRLF
	JMP SYSER2
	ASCOUT		/NOW TYPE THE ERROR MESSAGE
SYSER1,	 0
	NOP
SYSER2,	ASCOUT		/ "FOR JOB"
	 FORJOB
	JMP SYSER4
	TAD SIJOB
	JMS I SYSEJN	/ AND THE 2-DIGIT JOB #
	ASCOUT
	 CRLF
	NOP
SYSER4,	JMP I SYSER0

SYSETB,	.+1
	QQEST
	SYSET1
	SYSET2
	SYSET3
	QQEST
	SYSET5
	SYSET6
	QQEST

SYSET1,	"I;"L;"L;"E;"G;"A;"L;" ;"I;"O;"T;0
SYSET2,
SYSET3,	"S;"W;"A;"P;" ;"E;"R;"R;"O;"R;0
SYSET5,	"D;"I;"S;"C;" ;"E;"R;"R;"O;"R;0
SYSET6,	"H;"U;"N;"G;" ;"D;"E;"V;"I;"C;"E;0
/RETURN FOR FILE COMMANDS

FIPEND,	GETWRD
	 JOBREG+2
	SNA		/ANY ERROR CODE RETURNED?
	JMP I COMEXA	/NO - JUST EXIT
	DCA IOTP1
	TAD FIPETB
	DCA IX1
FIPEN1,	TAD I IX1
	SNA		/REACHED END OF TABLE?
	JMP FIPEN2	/YES - MUST BE 'EXTEND' FAILURE
	TAD IOTP1
	SZA CLA		/THIS CODE?
	JMP FIPEN1	/NO - KEEP LOOKING
	TAD IX1		/GET MESSAGE ADDRESS
	TAD FIPMTB
	DCA IOTP1
	TAD I IOTP1
	JMP I COMERA

FIPEN2,	ASCOUT
	 CRLF
	NOP
	ASCOUT		/ "FAILED BY N SEGMENTS"
	 FAILBY
	NOP
	TAD IOTP1
	JMS I FIPDEC	/CONVERT THE NUMBER TO DECIMAL
	 COMBUF-1
	ASCOUT		/ AND TYPE IT
	 COMBUF
	NOP
	ASCOUT
	 SEGMTA
	NOP
	JMP I COMEXA

FIPDEC,	DECOUT

	IFNZRO DHALF-10	<GLITCH>
	IFNZRO DUPL-200	<GLITCH>

SETH,	TAD C0010	/HALF-DUPLEX HARDWARE FLAG
UNDUPL,	TAD C0200	/UNDUPLEX BIT
DUPLEX,	DCA IOTP0
	DATFLD
	TAD I COMDB0	/WORD 1 OF DDB
	AND MDUPL	/CLEAR BIT
	TAD IOTP0
	DCA I COMDB0	/SET NEW BITS
	JMP I COMEXA
MDUPL,	-DUPL-DHALF-1

/COMMAND HANDLER TO INHIBIT/REENABLE TALKS TO A TERMINAL
	IFNZRO DTALK-1	<GLITCH>

SETS,	TAD SIKBD
	SNA CLA		/IS HE TRYING TO LOCK OUT TALKS ON K00?
	JMP I COMERA	/YES - BUT THAT'S THE CONSOLE!!
	CLA IAC
SETQ,	DCA IOTP0	/SAVE THE FLAG TO SET
	RESDDB		/GET THE OUTPUT DDB ADDRESS
	DCA IOTP1
	DATFLD
	TAD I IOTP1
	SNA		/IS THERE ONE?
	JMP I COMERA	/NO - ERROR
	DCA IOTP1
	CLA CLL CMA RAL
	AND I IOTP1
	TAD IOTP0	/NOW SET (OR CLEAR) THE TALK-INHIBIT
	DCA I IOTP1
	JMP I COMEXA

FIPETB,	.
	-4000	/FILE NOT OPEN
	-4400	/FILE IN USE
	-5000	/DIRECTORY FULL
	-5400	/BAD DIRECTORY
	-6000	/PROTECTION VIOLATION
	-6400	/BAD FILE NAME FOR RENAME
	-7000	/FILE NOT FOUND
	-7400	/DISC FULL
	0
FIPMTB,	.-FIPETB
	FM4000
	FM4400
	FM5000
	SYSET5
	FM6000
	FM6400
	FM7000
	FM7400

FM4000,	"F;"I;"L;"E;" ;"N;"O;"T;" ;"O;"P;"E;"N;0
FM6000,	"P;"R;"O;"T;"E;"C;"T;"I;"O;"N;" ;"V;"I;"O;"L;"A;"T;"I;"O;"N;0
FM7000,	"F;"I;"L;"E;" ;"N;"O;"T;" ;"F;"O;"U;"N;"D;0
LOGE0,	"A;"L;"R;"E;"A;"D;"Y;" ;"L;"O;"G;"G;"E;"D;" ;"I;"N;0
LBRACK,	" ;"[;0
RBRACK,	"];" ;"O;"N;" ;"K;0
TYCRLB,	"T;"Y;"P;"E;" ;"^;"B;"S;" ;"F;"I;"R;"S;"T;0
FORMSG,	"I;"L;"L;"E;"G;"A;"L;" ;"F;"O;"R;"C;"E;0
FSEGMS,	" ;"F;"R;"E;"E
SEGMTA,	" ;"S;"E;"G;"M;"E;"N;"T;"S;0
TALKLM,	"N;"O;" ;"T;"A;"L;"K;"S;";;" ;"U;"S;"E;" ;"M;"A;"I;"L;0
WAITIO,	"W;"A;"I;"T;" ;"F;"O;"R;" ;"I;"/;"O;0

VERDG1=	VERNUM%12
VERDG2=	-VERDG1^12+VERNUM
VERSIM,	215;212;"U;"W;"M;"';"S;" ;"T;"S;"S;"-
	IFNZRO CPU-3  <
	"8
		IFZERO CPU	<"/;"I>
		IFZERO CPU-2	<"/;"E>
		IFZERO CPU-4	<"/;"A>
	>
	IFZERO CPU-3  <"1;"2>
	".;"0+VERDG1;"0+VERDG2
	" ;" ;" ;0
VERBRK=	-130	/SPACE FOR 'BROADCAST' TEXT (87 CHARACTERS)
	IFNZRO VERBRK-.&4000	<GLITCH>
	*VERBRK
/NOTE THAT THE 'VERBRK' BUFFER CAN OVERLAY
/ANYTHING FROM HERE TO THE END OF THIS FIELD.
/ANYTHING PLACED HERE SHOULD ONLY BE USED
/IMMEDIATELY AFTER SI IS LOADED. FOR EXAMPLE,
/THE 'FAILED BY N SEGMENTS' MESSAGE IS ONLY TYPED
/AFTER A RETURN FROM FIP, IT DOESN'T MATTER IF IT IS
/CLOBBERED, THEREFORE.

FAILBY,	"F;"A;"I;"L;"E;"D;" ;"B;"Y;" ;0
FM4400,	"F;"I;"L;"E;" ;"I;"N;" ;"U;"S;"E;0
FM5000,	"D;"I;"R;"E;"C;"T;"O;"R;"Y;" ;"F;"U;"L;"L;0
FM6400,	"B;"A;"D;" ;"F;"I;"L;"E;"N;"A;"M;"E;0
FM7400,	"D;"I;"S;"C;" ;"F;"U;"L;"L;0
	IFNZRO 7745-.&4000	<GLITCH>
	*7745
/
/SUPER-SHORT HAND-KEYABLE BOOTSTRAP FOR TSS/8!!
/KEYIN (IN FIELD 0):
/	7750 - 6603
/	7751 - 7600
/	7752 - 5352
/
/THEN LOAD ADDRESS 7750 AND START (OR 'CLEAR' & 'CONT').
/IF DISC COPY OF TSS/8 IS INTACT, SYSTEM WILL RESTART.
/
/NOTE THAT WE SET THE DATA-BREAK CONTROL WORDS INDIRECTLY;
/THIS ALLOWS THIS BOOTSTRAP TO BE USED IF IT HAPPENS TO BE
/IN ANOTHER FIELD ALREADY.
/
BOOT1,	DFSC		/WAIT FOR TRANSFER TO COMPLETE
	JMP .-1
	JMP BOOT	/THEN GO LOAD 'INIT'
/
	7751	/THESE MUST BE HERE BECAUSE THEY
	7751	/ OVERLAY CORE!!!
	JMP BOOT1	/THIS OVERLAYS 'JMP .'
/
BOOT,	CDF
	IFNZRO CPU-2	<IOF>
	IFZERO CPU-2	<CAF>
	CLA CLL CMA	/SET UP TO READ 'INIT'
	DCA I K7751
	DCA I K7750	/SET (-) WORD-COUNT
	TAD BTFLD

	IFZERO RF08 <
	DIML		/SET MEMORY FIELD
	CLA CLL CML RTL
	DXAL		/SET DISC TRACK #
	>
	IFZERO RF08-40 <
	DEAL
	CLA
	>
	DMAR		/ AND READ THE TRACK
	DFSC
	JMP .-1		/WAIT FOR COMPLETION
	CIF CDF INFLD
	JMP I .+1	/THEN ENTER 'INIT'
	4200

	IFZERO RF08 <
BTFLD,	INFLD		/FIELD TO PUT 'INIT' INTO
	>
	IFZERO RF08-40 <
BTFLD,	200+INFLD	/'INIT' TRACK & IT'S FIELD
	>
K7750,	7750
K7751,	7751

/////	$$$$$
	$$$$$