/49 NON-RES MCR FOR RTS8 V3
/
/ M. HURLEY / R. LARY
/THE MONITOR CONSOLE ROUTINE ALLOWS THE OPERATOR/PROGRAMMER OF AN
/RTS-8 SYSTEM TO CONTROL AND OBSERVE THE STATE OF THE SYSTEM
/THROUGH THE CONSOLE TELETYPE.
/
/	MADE NON-RESIDENT-ABLE LATE DEC, 1975
/	4-JAN-76   FIXED BUG RE RE TO EARLIER TIMES
/	3-MAY-76   ADDED 'MCRFLD' AND 'MCRCLK'
/		   ADDED DECNET/8 NAMES TO NAME TABLE
/	14-JUN-76	ADDED TLK, LSN
/	30-JUN-76	ADDED  DIAGNOSTIC TASK NAMES (IN-HOUSE USE ONLY)
/	02-OCT-76	FIXED TIMING PROBLEMS
/			ADDED 'MCRCDV' PARAMETER
/			INCREASED INPUT BUFFER IF USING NULL8A NULL TASK
/			ADDED TTY2 AND EXIT TO NAME TABLE
/			MODIFIED 'EXIT' CODE
/ #10	V2B CONVERSION TO MACREL
/ #11	EXTEND DATE TO 2069
/ #12	FIX ASSEMBLY ERRORS IN #11
/ #13	PUT IN EAESV CONDITIONAL
/ #14	MAKE MCR AWARE OF 4000 TERMINATOR FOR TTY
/ #15	MAKE DSECT FROM NTAB, PULL IN MCREF, CLEANUP
/ #16	PUT IN KT8A SUPPORT
/ #17	NMTBL HAS TO GO TO EXEC BECAUSE OF LOADING ORDER
/	TAKE OUT CDF, CIF TO 0
/ #18	[17] HAD NO / ON IT!!
/ #19	MISSING .EXTERNAL TO TSWFLG
/ #20	TURN OFF KT8A ON EXIT
/ #21	MAKE SECONDS PRINT OUT (LN)
/ #22	MATCH EXIT ACTION WITH OS8SUP
/ #23	MINOR FIX FOR #22
/ #24	ELIMINATE .FSECT LITERALS
/ #25	FIXED CANCEL CALL TO CLOCK			S.R.
/ #26	PAGE OVERFLOW FOR KT8A CASE
/ #27   PUT LITERALS BACK IN, TAKE OUT CUR
/ #28	FIXED BUG IN COPYRIGHT STATEMENT		S.R.
/ #29	CLEANUP S.R.
/	ADDED 6-CHARACTER NAMES
/ #30   PAGE OVERFLOW
/ #31   CHANGE USE OF SYMBOL 'TASK'
/ #32	CHANGED OUTPUT TO BE UNPACKED ASCII		S.R.
/ #33   BEAUTIFY NULL DATE
/ #34   RTFLD TO RTS8
/ #35	FIXED NMTBL
/ #36	SPLIT INTO 2 FIELDS (AGAINST MY BETTER JUDGEMENT)
/	EDIT ENCOMPASSES ENTIRE SOURCE AND IS TOO BIG TO DETAIL
/ #37	FIX LEVEL
/ #38	CODE REARRANGEMENT
/ #39   MOVE NUL TASK TO SANITIZE SYMBOL 'TASK'
/ #40   FIXES FOR WRITABLE
/ #41   FIX NUMBER BUG
/ #42	REMOVED SOME GENERATED LINKS AND MOVED XFLD TO MCRF1
/	ALLOWED X BIT TO MEAN NON-EXISTENT WAIT IN MCR SYSTAT
/ #43	CLEANUP
/ #44	FIXED VV IN SYSTAT
/ #45   100+ TASK PRINTOUT FIX
/ #46   UNDO PREVIOUS NON-RESIDENT IMPLEMENTATION
/ #47   MCRCLK CONDITIONAL
/ #48   OUTPUT LINE OVERFLOW FIX
/ #49   GENERALIZE HANDLING OF KTFLDS
	VERS=49.		/MCR VERSION NUMBER
	VERS2=31.	/NULL TASK VERSION NUMBER
/
/
/
/
/
/
/
/
/
/
/COPYRIGHT  (C)  1974,1975,1976,1977,1978,1979 BY DIGITAL EQUIPMENT CORPORATION
/
/
/
/
/
/
/
/
/
/
/THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE
/AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
/CORPORATION.  DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY
/FOR ANY ERRORS THAT MAY APPEAR IN THIS DOCUMENT.
/
/THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER
/UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED
/(WITH INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH
/SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL.
/
/DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE
/OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY
/DIGITAL.
/
/
/
/
/
/
/
/
/
/
	XLIST	0	/LIST TASK
	IFNDEF CLOCK	<MCRCLK=0>
	IFDEF CLOCK	< IFNDEF MCRCLK < MCRCLK=1 >>
	IFNDEF MCRCDV	<MCRCDV=TTY>

	IFNDEF	MCRSYS	<MCRSYS=1>	/DEFAULT INCLUDES SYSTAT

/PARAMETERS FOR SOMEWHAT FANCIER NULL TASK WHICH COMES WITH MCR

	IFNDEF	NULL8A	<
TASK2=	NTASKS+1/LOWEST PRIORITY TASK IN SYSTEM - UNADDRESSABLE
	>
	IFDEF	NULL8A	<
	IFNZRO	NULL8A-NTASKS-1	<
TASK2=	NTASKS+1/LOWEST PRIORITY TASK IN SYSTEM - UNADDRESSABLE
	>>
INIWT2=	0	/COMES UP RUNNING

/****

/	PARAMETERS WHICH DEPEND ON SPACE FREE IN MCR PAGES:
INLENG=	60	/LENGTH OF INPUT BUFFER (USED TO BE 54)
/********
	.RSECT	MC.RES,ROOT

	MCRF1=	MC.RES
	.TASK	MCR		/MCR'S NAME TO TABLE ALSO
	.EXTERNAL	TFTABL,MSGTBL,TSTABL,TODL,TODH,DATE,YEAR
	.GLOBAL		MCREF	/LET TTY FIND MCREF TO POST ON ^C
	.EXTERNAL	NMTBL,TSWFLG	/LET US FIND NMTBL,TSWFLG

/	RESIDENT PORTION OF MCR:

MCRMES,	ZBLOCK 3
	2000+INLENG
	INBUF
L7600,	7600		/TEXT FOR CLOSE ANGLE, NULL

	IFDEF	TASK2	<
	NULL=TASK2
	.TASK	NULL,,START2,INIWT2,VERS2
BKGCT,
START2,	TAD	L7600	/RSX-11D STYLE NULL TASK
1$:	ISZ	BKGCT
	ISZ	BKGCT
	ISZ	BKGCT
	ISZ	BKGCT
	ISZ	BKGCT
	JMP	1$
	RAL		/IDENTIFY V3
	JMP	1$
	>

ERMSG,	ZBLOCK	3	/STANDARD MESSAGE HEADER
	1000		/SIXBIT MESSAGE, END WITH CRLF, INDIRECT
	0		/NO INPUT
ERRA,	0		/JMS PUTS POINTER TO ERROR MESSAGE HERE
	CAL		/AC RANDOM BUT IRRELEVANT
	SENDW+FREE
	MCRCDV
	ERMSG
START,	CAL
	SENDW+FREE
	MCRCDV
	MCRMES
	CIF CDF	MCRF2
	JMP I	(STARTY

ENDZE,	IOF		/"WAITM" REQUIRES IOF ON ENTRY
	CIF	RTS8	/PUT WAITM TO CORRECT FIELD
	TAD	WATVAL	/4000+MCR
	DCA	MCREF	/NOW PLACE LOCALLY
	AC4000		/4000 IN AC FREES PARTITION WITH NEW EXEC
			/SUSPEND MCR ON ^C EVENT FLAG
	WAITM		/WITHOUT LETTING INTERRUPTS GO BACK ON!
	EFWT
	JMP	START
$CHRER,	JMS	ERRA
	TEXT	/BAD CHAR/
$NAMER,	JMS	ERRA
	TEXT	/BAD NAME/
$DLMER,	JMS	ERRA
	TEXT	/BAD DELIM/
$NUMER,	JMS	ERRA
	TEXT	/BAD NUMBER/
MCREF,	0	/MCRE EVENT FLAG

TTOUT,	0
	CAL
	SENDW+FREE
	MCRCDV		/SEND MESSAGE TO TTY AND WAIT
	EXMSG
	CIF	MCRF2	/LEAVE CDF HERE TO FETCH SAVED CONTEXT
	JMP I	TTOUT

EXMSG,	ZBLOCK	3	/OUTPUT BUFFER SHARES SPACE WITH INPUT BUFFER
WATVAL,	4000+MCR	/SERVES TTY AS NOPACK
	0
E1MSG,
INBUF,	ZBLOCK	INLENG	/INPUT BUFFER
SVPC=INBUF+61		/SAVE ENTRY POINT TO VTTOUT HERE
SVV=INBUF+60		/SAVE NON-RESIDENT STATE HERE
SVP=INBUF+57		/OUTPUT CAN'T BE THIS LONG
SVNUMB=INBUF+56		/INPUT DONES'NT MATTER
SVALT=INBUF+55
	PAGE
/	NON-RESIDENT PORTION OF MCR:

	.RSECT	MC.SWP

	MCRF2=MC.SWP

TASK=MCR		/TASK WAS SET TO NUL JOB !!
	.NONRES		/MCR DOES NOT HAVE TO BE WRITTEN OUT

/ROUTINE TO PARSE OFF A TASK NAME OR NUMBER

NAMEA,	XNAME
XNAME,	0	/USED FOR TEMP STORAGE OF ACCUMULATED NAME
XNAME1,	0
XNAME2,	0

ZOO,
GETTSK,	0		/THIS SUBR RETURNS TASK NUMBER IN "TSKWD"
	JMS	NAMGET
	JMP	NUMTSK
	JMS	NAMCOM	/OK SO FAR.
			/NOW CHECK FOR NAME DUPLICATION
	JMP	NAMER
	TAD	G3	/NAMCOM LEFT FOUND INDEX HERE
GOTASK,	TAD	(NTASKS+1	/GET NUMBER ASSOC. WITH THIS NAME
	DCA	TSKWD	/AND THAT'S THE TASK NUMBER
	TAD	TSKWD
	JMP I	GETTSK	/RETURN WITH TASK NUMBER IN AC
NUMTSK,	JMS I	(BACKUP	/IT'S A NUMBER - MUST BACK UP PTR
	JMS I	(GETNUM	/SO GO ACCUMULATE IT
	CLL		/SET UP TO CHECK LEGAL RANGE FOR TASK
	SZA		/TASK ZERO IS WRONG, SKIP TO ERROR
	TAD	(-NTASKS-1
	SNL SZA		/SKIP IF OUT OF RANGE
	JMP	GOTASK	/GO REFURBISH NUMBER
NUMER,	CDF CIF MCRF1
	JMP I	($NUMER
/
/  COME HERE TO DO REST OF 'NAME' COMMAND
/
NAMFIL,	JMS	NAMGET	/GET THE NAME
	JMP	NAMER
	JMS	NAMCOM	/ALREADY SUCH A NAME?
	JMP	NAMFL2	/OK, KEEP GOING
NAMER,	CDF CIF MCRF1
	JMP I	($NAMER

NAMFL2,	CDF	NMTBL
	TAD	XNAME
	DCA I	ZOO
	ISZ	ZOO
	TAD	XNAME1
	DCA I	ZOO
	ISZ	ZOO
	TAD	XNAME2
	DCA I	ZOO
	JMP	BKELEN	/BKELEN HANDLES STRAY CDF
NAMGET,	0
	TAD	NAMEA
	DCA	G7
	AC7775
	DCA	G3
	TAD	(4040
	DCA	XNAME1
	TAD	(4040
	DCA	XNAME2
	JMS I	(ALPNUM	/ONLY ALPHAS + NUMBERS LEGAL
	JMP	CHRER
	TAD	L7500	/SPLIT ALPHA-NUMERIC
	SPA		/NAME OR NUMBER?
	JMP	NAMEX	/BY NUMBER
	ISZ	NAMGET
NXT,	AND	L77
	STL RTL		/40 IN LOW 6 BITS
	RTL
	RTL
	DCA I	G7
	JMS I	(ALPNUM
	JMP	ENDX	/2ND CHAR IS NOT ALPHANUMERIC
	AND	L77
	TAD	(-40	/REMOVE LOW 40
	TAD I	G7
	DCA I	G7	/SAVE 1ST 2 CHARS
	ISZ	G7
	ISZ	G3	/4 CHARS YET?
	JMS I	(ALPNUM
	JMP	ENDX	/3RD CHAR NON-ALPHANUMERIC
	JMP	NXT	/GO DO 3RD+4TH CHARS
ENDX,	JMS I	(BACKUP
END,	JMS I	(LEGAL
	JMP	END
NAMEX,	CLA
	JMP I	NAMGET

G3,	0
G7,	0
TSKWD,	0
/COMPARE NAME IN XNAME WITH NMTBL, LOOKING FOR MATCHES.

NAMCOM,	0
	TAD	(NMTBL+1	/NMTBL USED TO POINT TO NAME OF TASK 1 !!
	DCA	G7
	TAD	(-NTASKS-1
	DCA	G3
MISSD,	ISZ	G7	/MOVE TO FRONT OF NEXT ENTRY
L77:	77
CHKMO,	ISZ	G7	/UPDATE PAST UNNEED INFO
L7500,	7500		/ISZ MIGHT SKIP, THIS CAN'T!
	ISZ	G3	/DONE?
	SKP
	JMP	NAMEX$	/YES
	CDF	NMTBL
	TAD I	G7	/GET 2 CHARACTERS FROM NMTBL
	ISZ	G7
	CIA
	TAD	XNAME	/COMPARE TO NAME UNDER INVESTIGATION
	SZA CLA
	JMP	MISSD	/N.G. CONTINUE THRU NMTBL
	TAD	XNAME1	/TRY 2ND 2 CHARS FOR MATCH
	CIA
	TAD I	G7
	ISZ	G7
	SZA CLA
	JMP	CHKMO	/NOT CLOSE ENOUGH
	TAD I	G7
	CIA
	TAD	XNAME2
	SZA CLA
	JMP	CHKMO
	ISZ	NAMCOM	/FOUND IT
NAMEX$:	CDF	.
	JMP I	NAMCOM

CHRER,	CDF CIF MCRF1
	JMP I	($CHRER
	PAGE
/COMMAND CLEANUP AND NEW COMMAND FETCH

CRALT,	0

BKELEN,	JMS	BACKUP
	JMS	EOLA
ENDS,	CDF CIF	MCRF1
	ISZ	CRALT	/ALT-MODE EXIT?
	JMP I	(START
	JMP I	(ENDZE
/
/  COME HERE WITH NEW COMMAND
/
STARTY,	TAD	COMZOT	/SET DELIMITER TO COMMA
	DCA	ZOT
	TAD	(INBUF
	DCA	IP
	TAD	(E1MSG
	DCA	W	/IN CASE ERRORED OUT IN MIDDLE OF BUFFER
	DCA	CRALT
	JMS	LEGAL	/LOOK AT FIRST CHAR
	JMP	.+3	/SOMETHING USEFUL
	JMP	ENDS	/CR OR ALT - NULL LINE
	JMP	.-3	/SPACE OR COMMA - KEEP LOOKING FOR MEAT
	JMS	BACKUP	/FOUND MEAT - BACK UP OVER IT
	JMS I	(NAMGET	/GET COMMAND NAME
	JMP I	(NAMER
	TAD	(CMDLST-1
	DCA	DISP
L$:	ISZ	DISP
	TAD I	DISP	/GET 1ST 2 CHARS OF A COMMAND
	ISZ	DISP
	SZA		/0 TERMINATES COMMAND LIST
	TAD I	(XNAME
	SZA	CLA	/A MATCH?
	JMP	L$	/NO-TRY AGAIN
	TAD I	DISP	/YES - GET COMMAND DISPATCH ADDRESS
	DCA	DISP
	JMP I	DISP	/WE'RE ON OUR WAY

/DETERMINES IF NEXT CHARACTER IS ALPHABETIC OR NUMERIC
/EXIT IF NOT; EXIT+1 IF ALPHA OR NUM

ALPNUM,	0		
	JMS	GETA
	TAD	(-333
	CLL
	TAD	(32
	SZL		/TEST FOR ALPHA
	ISZ	ALPNUM	/BUMP RETURN IF ALPHA
	TAD	(301	/RESTORE CHAR, TEST FOR NUMERIC
	JMS	ISITNM
	ISZ	ALPNUM
	JMP I	ALPNUM

/SEE IF CHARACTER IN AC IS NUMERAL
/EXIT IF IS; EXIT+1 IF NOT

ISITNM,	0	
	TAD	(-"9-1
	CLL
	TAD	(12	/CHECK FOR RANGE 260-271
	SNL
	ISZ	ISITNM	/BUMP RETURN ADDRESS IF NOT IN RANGE
	TAD	(260	/RESTORE CHAR
	JMP I	ISITNM

PUTWX,	0		/ROUTINE TO STORE A WORD IN THE OUTPUT BUFFER
	CDF	MCRF1
	DCA I	W
	CDF	.
	ISZ	W
	JMP I	PUTWX

W,	E1MSG		/OUTPUT DATA POINTER
/
GETA,	0
	CDF	MCRF1
	TAD I	IP
	ISZ	IP
	CDF	.
	JMP I	GETA

IP,	0		/INPUT DATA POINTER
/
DISP,
BACKUP,	0
	CLA CMA
	TAD	IP
	DCA	IP
	JMP I	BACKUP
/CHECK NEXT CHAR FOR TYPE OF DELIMITER
/EXIT=	NOT CR,ALTMODE,SPACE, OR COMMA
/EXIT+1=CR OR ALTMODE, OR ABORTED INPUT!
/EXIT+2=SPACE OR COMMA

LEGAL,	0
	JMS	GETA
	SMA SZA		/SKIP ON TERMINATORS 0,-1,4000
	JMP	NOCRAL	/NO
	RAL		/SIGN BIT TO LINK
	STA RAL		/0 (CR) GOES TO -2; OTHER TWO GO TO -1
	DCA	CRALT
	JMP	ITSEOL
NOCRAL,	TAD	(-240	/BLANK?
	SZA
	TAD	ZOT	 /COMMA?
	SZA CLA
	JMP	NOGOOD	/NEITHER
	ISZ	LEGAL	/SPACE OR COMMA
ITSEOL,	ISZ	LEGAL	/CR,ALT
NOGOOD,	JMP I	LEGAL
EOLA,	0		/SEARCH FOR C.R. OR ALTMODE
	JMS	LEGAL
	JMP	DLMER	/CRAP AT END OF LINE
	JMP I	EOLA
	JMP	EOLA+1

ZOT,	240-",		/CHANGED BY DATE GETTER

COMZOT,	240-",

DLMER,	CIF CDF MCRF1
	JMP I	($DLMER

/ASSOCIATE A NAME WITH A TASK NUMBER

NAME,	JMS I	(GETTSK	/GET TASK NUMBER TO GIVE THIS NAME TO
	DCA	ZOO
	TAD	ZOO	/JOIN TEMP'S TO FIT
	CLL RAL		/INDEX INTO NMTBL
	TAD	ZOO
	TAD	(NMTBL	/NMTBL POINTS TO TASK '0'
	DCA	ZOO	/SAVE POINTER FOR LATER FILL
	JMS	BACKUP
	JMS	LEGAL
	JMP	DLMER
	JMP	DLMER	/NO CR BEFORE NUMBER
	JMP	NAMFIL	/COMPLETE ON OTHER PAGE
/
	PAGE
/
/
/  ##  PUTCDF  ##
/
/  MAKE # IN P INTO A CDF, PLACE IN LINE, EXECUTE
/
/  IF NUMBER IN P IS TOO BIG, GO TO NUMER
/
PUTCDF,	0
	TAD	P	/LIMIT CHECK FIRST
	IFZERO	KT8A	<
	TAD	(7770
	SMA		/SKIP IF DIDN'T OVERFLOW
	JMP	NUMER	/TOO BIG, ERROR OUT
	CLL RAL		/SHIFT INTO PLACE
	RTL
	TAD	(6276	/MAKE CDF, REMEMBERING TO COUNTERACT 7770
	>
	IFNZRO	KT8A	<
	TAD	(-KTFLDS /MAXIMUM NUMBER OF ENABLED FIELDS FOR KT8A
			/MAY HAVE VALUE OF 20 OR 40
	SMA		/SKIP IF DIDN'T OVERFLOW
	JMP	NUMER	/TOO BIG, PREVENT WRAP-AROUND
	CLL CML RTR	/ HAD  1 1 1 1 1 1 1 A B C D E
	RTR		/ HAVE  C D E 1 1 1 1 1 1 1 1 A , WITH B IN LINK
	BSW		/ HAVE  1 1 1 1 1 A C D E 1 1 1 , WITH B IN LINK
	SZL		/SKIP ON NO B
	TAD	(4	/PUT B INTO PLACE
	TAD	(4^KTFLDS+6172  /MAKE CDF
	>
	DCA	ZIPPER
ZIPPER,	HLT
	JMP I	PUTCDF
/
/
DEPSIT,	JMS	GET2OC
	JMP	NUMER	/DON'T HAVE CONTENTS TO DEPOSIT, ERROR
L$:	DCA	PR12BT	/SAVE VALUE TO DEPOSIT
	TAD	NUMB	/ADDRESS TO PUT IT IN
	DCA	POSTDF	/GET IT ON PAGE FOR INDIRECT
	JMS	PUTCDF	/TARGET CDF
	TAD	PR12BT	/CONTENTS
	DCA I	POSTDF	/ZOT!
	CDF	.FLD	/SAFETY
	TAD	CRALT	/DID WE HIT END OF LINE
	SZA CLA		/SKIP IF TO KEEP LOOKING
	JMP I	(ENDS	/HIT THE END, NEXT COMMAND
	ISZ	NUMB	/INCREMENT ADDRESS
	SKP
	ISZ	P
	JMS	GETNUM	/ MORE CONTENTS
	JMP	L$
/POST EVENT FLAG GIVEN ADDRESS

POSTEF,	JMS	GET2OC	/GET 5-DIGIT ADDRESS
	SKP		/SHOULD BE ONLY 1 NUMBER
	JMP	NUMER	/MORE IS ERROR
	JMS	PUTCDF
	CDF	.FLD
	TAD	ZIPPER	/SET UP DATA FIELD FOR POST
	DCA	POSTDF
	TAD	NUMB	/LOW ADDRESS PART
	CAL
	POST		/PRAY WHAT WE ARE POSTING IS REALLY
POSTDF,	HLT		/AN EVENT FLAG
	JMP I	(ENDS
/RUN THE REQUESTED TASK. TO SCHED FIRST

	IFZERO	MCRCLK	<
SCHED,	JMS I	(GETTSK	
	>
REQUST,	IFNZRO	MCRCLK	<TAD I	(TSKWD>
	CAL
	RUN
	JMP	BKELEN

/STOP THE REQUESTED TASK

STOP,	JMS I	(GETTSK
	CAL
	SUSPND
	JMP	BKELEN

/ENABLE A TASKS EXECUTION

ENABLE,	JMS I	(GETTSK
	CAL
	UNBARG
	ENABWT
	JMP	BKELEN

/DISABLE A TASKS EXECUTION

DISABL,	JMS I	(GETTSK
	CAL
	BLKARG
	ENABWT		/ENABLE WAIT
	JMP	BKELEN	/CLEAN UP
/
PR12BT,	0		/PRINT 2 3-BIT NUMBERS
	DCA	PUTCDF	/TEMPORARY STORAGE
	TAD	PUTCDF
	IFZERO	OMNI	<
	CLL RTR
	RTR
	RTR
	>
	IFNZRO	OMNI	<
	BSW
	>
	AND	(77	/SEND HALF TO 2 OCTAL PRINTER
	JMS	PRNTNM	/PASS 2 DIGIT NO.
	TAD	PUTCDF
	AND	(77	/AND THE OTHER HALF
	JMS	PRNTNM	/PASS LAST 2 DIGITS
	JMP I	PR12BT

/
/  PRINT A 7 BIT NUMBER, 2 CHARS IF NOT BIGGER THAN 77
/
PRNTNM,	0
	CLL
	TAD	(7700	/LEADING BIT TO LINK
	AND	(77
	DCA	POSTDF	/TEMPORARY STORAGE
	SNL		/SKIP IF NEED A LEADING 1 (TASK NUMBER)
	JMP	1$	/DON'T
	TAD	("1
	JMS I	(PUTWX
1$:	TAD	POSTDF
	CLL RTL
	RAL
	AND	(707	/GET LEFT DIGIT
	TAD	POSTDF
	AND	(707	/RIGHT DIGIT
	TAD	(6060
	JMS I	(PUT2X
	JMP I	PRNTNM
/	PUT2X			WHOLE ROUTINE IS NEW

PUT2X,	0
	DCA	ZIPPER	/TEMPORARY STORAGE TO SAVE PACKED SIXBIT
	TAD	ZIPPER
	IFZERO	OMNI	<
	RTR
	RTR
	RTR
	>
	IFNZRO	OMNI	<
	BSW
	>
	TAD	(40
	AND	(77
	TAD	(40
	JMS I	(PUTWX
	TAD	ZIPPER
	TAD	(40
	AND	(77
	TAD	(40
	JMS I	(PUTWX
	JMP I	PUT2X

	PAGE
/
/  MAJOR SURGERY ON THIS WHOLE PAGE TO SUPPORT KT8A 6 DIGIT NUMBERS
/
/  FOR KT8A ARITHMETIC, A RIGHT JUSTIFIED NUMBER IS 0000000ABCDE
/  WHERE ABCDE ARE THE BITS OF THE NUMBER, A CDF IS 11001ACDEB01
/
/  NOTE, KT8A MACHINES MUST HAVE BTYE SWAP INSTRUCTION
/
/
/  ##  GET2OC  ##
/
/  GET AN ADDRESS, FOLLOWED BY A 12 BIT NUMBER
/
/  SKIP RETURN WITH NUMBER IN AC, WHEN THE 12 BIT NUMBER WAS FOUND
/
/  IMMEDIATE RETURN WITH AC=0 WHEN NO 12 BIT NUMBER FOLLOWING ADDRESS
/
/  NUMB IS SET UP WITH THE LOW 12 BITS OF THE ADDRESS
/
/  V, P, NMACLOW, NMACH USED, (SOME BY GETNUM)
/
GET2OC,	0
	TAD	LIT50	/CALL GETNUM WITH 50 IN AC TO GET DBL WORD #
	JMS	GETNUM	/TELL GETNUM TO ACCEPT EXTENDED PRECISION NUMBER
	DCA	NUMB	/SAVE ADDRESS PART
	TAD	NMACH	/NOW SAVE HIGH ORDER PART TO MAKE INTO A CDF
	DCA	P	/SAVING IT IN CASE WE INCREMENT FIELD!
	TAD	CRALT	/DID WE HIT END OF LINE (GETNUM DID THIS FOR US)
LITSZA,	SZA CLA		/SKIP IF NO END OF LINE, WANT LITERAL SZA CLA
	JMP I	GET2OC	/END OF LINE, IMMEDIATE RETURN
	ISZ	GET2OC	/MORE, SKIP RETURN
	JMS	GETNUM	/CALL WITH 0, TAKE ONLY A 12 BIT NUMBER
	JMP I	GET2OC	/GO BACK
/  ##  GETNUM  ##
/
/  ASSEMBLES NUMBER FROM TYPED INPUT (OCTAL)
/  HIGH ORDER DIGITS BEYOND 24 BITS WORTH ARE DISCARDED
/
/  CALL WITH AC=0 TO GET A 12 BIT NUMBER
/  CALL WITH AC=50 TO GET A DOUBLE PRECISION NUMBER
/
/  IF NO OCTAL DIGIT FOUND, GO TO NUMER
/
/  GETNUM PLACES THE ASSEMBLED NUMBER INTO NMACH, NMACLOW
/  CONTENTS OF NMACLOW ARE RETURNED IN AC
/
/  GETNUM CALL LEGAL TO CHECK DELIMITER
/
/
GETNUM,	0
	TAD	LITSZA	/SINGLE: SZA CLA . DOUBLE: SPA CLA
	DCA	GETEST	/PLACE FOR TEST WHEN NUMBER DONE
	AC4000		/INIT ACH, HIGH BIT TELLS US WHETHER ANY INPUT
	DCA	NMACH
M$:	DCA	NMACLOW	/REGULAR ZERO INTO LOW
	JMS	GETA	/NEXT DIGIT
	TAD	L7510	/CHECK OCTAL RANGE; -270 IS A SPA!
	CLL
	TAD	LIT10	/LITERAL 10
	DCA	TMP	/HOLD OCTAL, !SAFE TEMPORARY!
	SNL		/SKIP IF IT REALLY WAS OCTAL
	JMP	GETDON	/NO, CHECK DELIMITER ETC.
	AC7775		/3 TIMES THRU SHIFT LOOP
	DCA	V$
L$:	TAD	NMACLOW
	CLL RAL		/MULTIPLY NMACH, NMACLOW PAIR BY 2
	DCA	NMACLOW
	TAD	NMACH
	RAL
	DCA	NMACH
	ISZ	V$	/DONE
	JMP	L$
	TAD	NMACLOW	/PUT IN ACQUIRED DIGIT
	TAD	TMP
	JMP	M$	/NEXT DIGIT

V$:	0
NMACLOW,	0
NMACH,	0
GETDON,	TAD	NMACH	/DID WE GET RIGHT SIZE NUMBER
GETEST,	HLT		/SPA CLA  OR  SZA CLA PUT HERE. A MINUS NMACH
/			/SAYS NO DIGITS WERE OBTAINED!
	JMP	NUMER	/ERROR OUT
	JMS	BACKUP	/CHECK DELIMITER
	JMS	LEGAL
	JMP	DLMER	/ILLEGAL
LIT50,	50		/KEEPS AC 0; LATER USE CRALT TO TELL IF AT END
	TAD	NMACLOW	/RETURN LOW PART OF ANSWER IN AC
	JMP I	GETNUM
/
/  VTTOUT
/
/  SAVE ENTRY POINT AND REGISTERS CRALT, NUMB, P, V IN RESIDENT;
/  DO TTY OUTPUT, RESTORE REGISTERS IN NON-RESIDENT.
/  THIS ALLOWS NON-RESIDENT TO BE NON-WRITABLE
/
TMP,
VTTOUT,	0
	JMS	PUTWX	/TERMINATE OUTPUT BUFFER
	TAD	CRALT
	CDF CIF MCRF1
	DCA I	(SVALT
	TAD	NUMB
	DCA I	(SVNUMB
	TAD	P
	DCA I	(SVP
	TAD	V
	DCA I	(SVV
	TAD	VTTOUT
	DCA I	(SVPC
	JMS I	(TTOUT
	TAD I	(SVPC
	DCA	VTTOUT
	TAD I	(SVV	/DATA FIELD TO RESIDENT
	DCA	V
	TAD I	(SVP
	DCA	P
	TAD I	(SVNUMB
	DCA	NUMB
	TAD I	(SVALT
	CDF	.
	DCA	CRALT
	TAD	(E1MSG
	DCA	W	/RESET POINTER FOR OUTPUT
	JMP I	VTTOUT
NUMB,	0		/LOW ORDER BITS OF ADDRESS
P,	0		/HIGH ORDER BITS OF ADDRESS
V,	0		/COUNT OF ITEMS TO DO
/
/EXAMINE LOCATION OR RANGE OF LOCATIONS

EXAM,	JMS	GET2OC	/GET OCTAL VALUES
LIT10,	10		/KEEP AC 0, LITERAL
	SNA		/IF 2D NUM IS ZERO,
	IAC		/EXAMINE ONLY 1 LOC
	CIA
	DCA	V	/NUMBER TO DO
PRNCON,	TAD	P	/HIGH ORDER ADDRESS BITS
	IFZERO	KT8A	<
	TAD	(260	/MAKE TO ASCII
	JMS	PUTWX
	>
	IFNZRO	KT8A	<
	JMS	PRNTNM
	>
	TAD	NUMB
	JMS I	(PR12BT	/PRINT THE LOCATION NEXT
	TAD	(5740	/PRINT A SLASH BEFORE CONTENTS
	JMS I	(PUT2X
	JMS	PUTCDF	/SET DATA FIELD CORRESPONDING TO P
	TAD I	NUMB	/GET CONTENTS
	CDF	.FLD
	JMS I	(PR12BT	/PRINT IT
	JMS	VTTOUT	/SAVE STATUS, PRINT A LINE
	ISZ	V	/DONE?
L7510:	SPA		/SPA ALWAYS SKIPS; IS LITERAL -270
	JMP I	(ENDS	/DONE!
	ISZ	NUMB
	SKP
	ISZ	P
	JMP	PRNCON	/KEEP GOING
/
	PAGE
	IFNZRO	MCRCLK	<

ACLOW,	0
ACH,	0
/
TIME,	TAD	CRALT	
	SZA	CLA
	JMP	PRNTM	/PRINT TIME
DOTIME,	JMS I	(HRMIN	/DECODE HOURS + MINS
	TAD	CRALT
	SNA CLA
	JMS I	(EOLA
	TAD	ACLOW
	CDF	TODL
	CIF	.FLD	/INHIBIT INTERRUPTS BETWEEN HALVES
	DCA I	(TODL
	TAD	ACH
	DCA I	(TODH
	JMP I	(ENDS
PRNTM,	DCA	ACH
	DCA	ACLOW
	CDF	TODL
	TAD	(TODL
	JMS	DBLADD	/GET TIME OF DAY FROM PAGE 0 FIELD 0
	TAD	(FUDGEL
	JMS	DBLSUB	/TAKE OFF THE MIDNIGHT FUDGE
	TAD	(HRCON	/SET UP POINTER TO DIVISOR LIST
	DCA	CLKT
	JMS	TIMEC	/DO TIME SUBROUTINE TO GET HOURS
	JMS I	(PR4BIT	/PUT ANSWER IN OUTPUT STRING
	TAD	(":	/PRINT COLON
	JMS I	(PUTWX
	JMS	TIMEC	/DO MINUTES
	JMS I	(PR4BIT
	TAD	(":	/PRINT COLON
	JMS I	(PUTWX
	JMS	TIMEC	/NOW DO THE SECONDS
TIMEX,	JMS I	(PR4BIT
	JMS	VTTOUT
	JMP I	(ENDS

/  ##  TIMEC  ##
/
/  DIVIDE ROUTINE FOR TIME COMPUTATION
/
TIMEC,	0
	DCA	CLKT1	/CLEAR COUNTER
TIMLOP,	TAD	CLKT	/DIVIDE: SUBTRACT UNTIL OVERFLOW
	JMS	DBLSUB
	ISZ	CLKT1
	SZL		/LINK IS 0 ON OVERFLOW
	JMP	TIMLOP	/KEEP GOING
	TAD	CLKT	/RECONSTRUCT REMAINDER
	JMS	DBLADD
	ISZ	CLKT	/BUMP THE DIVISOR POINTER
	ISZ	CLKT
	ISZ	CLKT
	STA		/RETURN RESULT-1 IN AC
	TAD	CLKT1
	JMP I	TIMEC
DBLADD,	0		/DOUBLE PRECISION ADD ROUTINE
	DCA	DBLSUB	/USE EACH OTHER'S ENTRY FOR TEMP
	CLL
	CIF	.FLD	/INHIBIT INTERRUPTS
	TAD I	DBLSUB
	TAD	ACLOW
	DCA	ACLOW
	ISZ	DBLSUB	/PREPARE FOR HI WORD
	RAL		/UPDATE HI WORD
	TAD I	DBLSUB
	TAD	ACH
	DCA	ACH
	CDF	.FLD
	JMP I	DBLADD

DBLSUB,	0		/** CAN BE CALLED WITH DF=.FLD OR DF=RTFLD **
	DCA	DBLADD	/USE EACH OTHER'S ENTRY AS TEMP
	CIF	.FLD	/HOLD INTERRUPTS BETWEEN HALVES
	TAD I	DBLADD	/GET LO VALUE
	CIA CLL
	TAD	ACLOW
	DCA	ACLOW
	ISZ	DBLADD	/UPDATE FOR HI VALUE
	CML RAL
	TAD I	DBLADD
	CIA
	TAD	ACH
	DCA	ACH
	CDF	.FLD
	JMP I	DBLSUB	/LINK IS 0 IF RESULT OVERFLOWED

GETN,	0		/GET A NUMBER ROUTINE
	DCA	NUMB	/INITIALIZE NUMBER TO 0
PSTSPC,	JMS	GETA
	JMS I	(ISITNM	/DIGIT?
	JMP	YSITIS	/YES - GO BUILD NUMBER
	TAD	(-240
	SNA CLA
	JMP	PSTSPC	/PERMIT LEADING SPACES
	JMP I	(NUMER
YSITIS,	TAD	(-260
	DCA	CLKT1
	TAD	NUMB
	CLL RTL
	TAD	NUMB
	RAL		/NUMBER SO FAR *10
	TAD	CLKT1	/+ NEW NUMBER
	DCA	NUMB
	JMS	GETA
	JMS I	(ISITNM
	JMP	YSITIS
	JMP I	GETN	/RETURN WITH DELIMITER IN AC
CLKT,	0
CLKT1,	0
/
CLKMSG,	CAL		/STUCK HERE FOR SPACE, CAN PUT IN FSECT
	SEND
	CLOCK
	SCHMES
	JMP	BKELEN
/
	PAGE
/REQUEST A TASK:

/A)	IMMEDIATELY
/B)	AFTER AN INTERVAL
/C)	AT A TIME OF DAY
/D)	AFTER AN INTERVAL AND PERIODICALLY
/E)	AT A TIME OF DAY AND PERIODICALLY

SCHED,	JMS I	(GETTSK	/GET TASK
	JMS I	(BACKUP
	JMS I	(LEGAL
	JMP I	(DLMER	/MUST BE DELIM
	JMP I	(REQUST	/JUST A REQUEST
	DCA	ACH
	DCA	ACLOW	/INITIALIZE INTERVAL
	JMS	GETA
	TAD	(-",	/CHECK FOR NULL INTERVAL
	SNA
	JMP	SAVTIM	/YES - GET PERIOD
	TAD	(",-"@	/CHECK FOR @ TIME-OD-DAY
	SZA CLA
	JMP	INTSCH
	JMS I	(HRMIN	/DECODE TIME SPECIFICATION
	TAD	(TODL
	CDF	TODL
	JMS I	(DBLSUB	/SUBTRACT CURRENT T.O.D. TO GET INTERVAL
	SZL
	JMP	SAVTIM
	TAD	(FUDGEL
	JMS I	(DBLSUB
SAVTIM,	TAD	ACH
	DCA	SCHDHI
	TAD	ACLOW
	DCA	SCHDLO
	TAD	CRALT
	SZA CLA		/END OF LINE SEEN?
	JMP	ZROINT	/YES - NO INTERVAL
	JMS	GETINT
	TAD	ACH
	DCA	RSCHHI	/SAVE RESCHEDULE UNITS IN CLOCK MESSAGE
	TAD	ACLOW
	DCA	RSCHLO
	AC2000
ZROINT,	TAD	(1000
	TAD I	(TSKWD
SNDCLK,	DCA	SCHDWD
	JMP	CLKMSG	/GO SEND MESSAGE TO CLOCK
/ROUTINE TO GET AN INTERVAL -
/INTERVALS ARE A NUMBER FOLLOWED BY H,M,S OR T
/THIS ROUTINE IS JUMPED INTO BY "HRMIN"

GETINT,	0
	JMS I	(GETN
	DCA	S2	/THIS IS THE ALPHA FOR UNIT
	TAD	(INTTBL
	DCA	S1
	DCA	ACH
	DCA	ACLOW	/CLEAR AC PRIOR TO ADDS
NXTINT,	TAD I	S1	/NOW CHECK FOR MATCHING UNITS
	ISZ	S1
	SNA
	JMP I	(CHRER	
	CIA
	TAD	S2
	SNA CLA
	JMP	FNDINT	/FOUND THEM
	ISZ	S1
	ISZ	S1
	JMP	NXTINT	/TRY AGAIN
FNDINT,	TAD	NUMB	/PREPARE COUNT ** HRMIN ENTERS HERE **
	SNA		/NEW: CHECK FOR 0 MINUTES
	JMP	NOMIN
	CIA
	DCA	S2
MORUNT,	TAD	S1	/PASS UNITS FOR ADD
	JMS I	(DBLADD
	ISZ	S2
	JMP	MORUNT
NOMIN,	JMS I	(LEGAL
	JMP I	(DLMER	/ILLEGAL TERMINATING DELIMITER
SC7000,	7000		/EITHER SPACE, COMMA, OR EOL IS OK
	JMP I	GETINT

INTSCH,	JMS I	(BACKUP
	JMS	GETINT	/GET INTERVAL
	JMP	SAVTIM

CANCEX,	JMS I	(GETTSK	/TASK NUMBER
	TAD	SC7000	/CODE FOR CANCEL
	JMP	SNDCLK	/JOIN UP
SCHMES,	ZBLOCK 3
SCHDWD,	0		/2000+TASK NUM
SCHDHI,	0
SCHDLO,	0
S1,
RSCHHI,	0
S2,
RSCHLO,	0	/RESCHEDULE INTERVAL (IF APPLICABLE)
/
/DECIMAL PRINT ROUTINE FOR NUMBERS UP TO 63 DECIMAL

PR4BIT,	0	
	DCA	S1	/SAVE CALL
LOOP,	DCA	S2	/FIRST TIME, ZERO TENS, LATER REPLACE TENS
	TAD	S1	/SUBTRACT ANOTHER 10
	TAD	(-12
	SPA		/SKIP IF STILL NOT DONE
	JMP	PDONE
	DCA	S1	/SAVE
	TAD	S2	/UPDATE TENS
	TAD	(100
	JMP	LOOP
PDONE,	TAD	S2	/ADD IN TENS
	TAD	(6072	/CANCEL EXTRA -12, 6060 FOR ASCII
	JMS I	(PUT2X
	JMP I	PR4BIT

	PAGE
/COMPUTE THE NUMBER OF TICKS IN A DAY FOR THE TIME-OF-DAY FUDGE

MCNT,
HRMIN,	0		/IF SPEC HRS,MUST HAVE MINS
	JMS I	(GETN
	TAD	(-":	/ONLY : BET HRS + MINS
	SZA CLA
	JMP I	(NUMER	/NO : - ERROR
	TAD	HRMIN
	DCA I	(GETINT	/FAKE OUT "GETINT" TO DO SOME WORK FOR US LATER
	TAD	NUMB	/MULTIPLY HRS BY 60 TO GET MINS
	STL CMA RTL
	RTL
	TAD	NUMB
	CLL CMA RTL
	DCA	HRMIN
	JMS I	(GETN	/GET MINS
	JMS I	(BACKUP
	TAD	(MINCON
	DCA I	(S1	/SET UNITS TO MINUTES
	DCA	ACLOW
	DCA	ACH
	TAD	(FUDGEL
	JMS I	(DBLADD	/INITIALIZE AC TO MIDNIGHT FUDGE
	TAD	HRMIN	/BEFORE WE ADD IN TICKS
	JMP I	(FNDINT	/CONVERT MINUTES TO TICKS AND RETURN
/
PRNTDT,	CDF	DATE
	TAD I	(DATE	
	CDF	.FLD
	DCA	DATEWD	/SAVE CURRENT DATE
	TAD	DATEWD
	AND	(370	/GET DAY
	CLL RTR
	RAR
	JMS I	(PR4BIT
	TAD	("-
	JMS I	(PUTWX		/PRINT DASH
	TAD	DATEWD
	AND	(7400
	CLL RTL
	RTL
	RTL		/MONTH TIMES 2
	TAD	(MONTHS
	DCA	DATMP
	TAD I	DATMP
	JMS I	(PUT2X
	ISZ	DATMP
	TAD I	DATMP
	JMS I	(PUT2X
	CDF	YEAR	/OBTAIN YEAR FROM EXEC
	TAD I	(YEAR
	CDF	.FLD
	TAD	(106	/ADD IN 70 DECIMAL TO GET REAL YEAR
	JMP	TIMEX
DATEX,	TAD	CRALT
	SZA CLA		/PRINT OR GET?
	JMP	PRNTDT	/PRINT DATE
	JMS I	(GETN
	TAD	(-"-
	SZA CLA
	JMP I	(DLMER
	TAD	NUMB
	AND	(37
	CLL RTL
	RAL
	DCA	DATEWD
	TAD	(240-"-	/CHANGE DELIMITER TO HYPHEN
	DCA	ZOT
	JMS I	(NAMGET	/GET A NAME
	JMP I	(DLMER	/BAD NAME
	TAD	(MONTHS+1
	DCA	DATMP
	DCA	MCNT
NO$:	ISZ	DATMP
L$:	ISZ	MCNT
	TAD I	DATMP
	SNA
	JMP I	(DLMER	/MONTH NAME DOES NOT MATCH
	ISZ	DATMP
	CIA
	TAD I	(XNAME
	SZA CLA		/DO FIRST TWO CHARS AGREE?
	JMP	NO$	/NO
	TAD I	DATMP	/YES
	ISZ	DATMP
	AND	(7700
	CIA
	TAD I	(XNAME1
	AND	(7700
	SZA CLA		/DOES THIRD CHARACTER MATCH?
	JMP	L$	/NO
	TAD	MCNT
	JMP	MATCH	/GO TO FSECT FOR REST OF CODE

DATMP,	0
/
	PAGE
	>
	IFNZRO	MCRSYS	<
/PRINT A STATUS TABLE
/FORMAT IS: NO. OF TASK
/	AFFILIATED NAME IF ANY
/	STATE OF FLAGS:
/	E=	EVENT		M=	MESSAGE
/	S=	SWAP		R=	RUN
/	U=	USER		D=	DISABLED
/	O=	EVENT OR MESSAGE N=	NON-RESIDENT
/	X=	DOESN'T EXIST

SYSTAT,	DCA	V
	JMS	BACKUP
	JMS	LEGAL
	JMP I	(DLMER
	JMP	FULSYS	/NO ARGS - DO FOA ALL TASKS, NO STATE
	JMS I	(GETTSK	/DELIMITER - GET TASK ID
	DCA	V
	DCA	P	/SET FOR ONE TASK, WITH STATE
	JMP	ONETSK
FULSYS,	TAD	(-NTASKS
	DCA	P	/-MAX. NO. ENTRIES
UPCHCK,	ISZ	V
ONETSK,	TAD	(TFTABL
	TAD	V
	DCA	ST2	/INDEX INTO FLAG TABLE
	CDF	TFTABL
	TAD I	ST2	/GET TFTABL WORD
	CDF	.FLD
	DCA	ST2
	STA		/CHECK FOR FLAGS=1, NOT EXISTS
	TAD	ST2
	SNA CLA		/SKIP UNLESS WAS =1
	JMP	NXTTSK	/MOVE ON TO NEXT TASK
	TAD	V	/PRINT TASK NO.
	JMS I	(PRNTNM
	JMS	SYSOUT
	TAD	V
	CLL RAL
	TAD	V
	TAD	(NMTBL	/INDEX INTO NAME TABLE, POINTING AT TASK 0
	/***********
	DCA	ST1
	AC7775
	DCA	TEM
1$:	CDF	NMTBL
	TAD I	ST1
	CDF	.FLD
	JMS	SYSOUT	/ADD NAME TO WRITE BUFFER
	ISZ	ST1
	ISZ	TEM
	JMP	1$
	TAD	(FLGTBL-1	/INSERT TASK WAIT CODES INTO LINE
	DCA	ST1	/DECODE WAIT CODE
FLGLP,	ISZ	ST1
	TAD I	ST1	/GET NEXT TABLE ENTRY
	ISZ	ST1
	SNA
	JMP	NOMOFG	/ZERO ENDS TABLE
	AND	ST2	/IF WE ARE WAITING ON THIS CODE,
	SNA CLA		/WE WILL PUT THE CORRESPONDING CODE LETTER OUT
	JMP	FLGLP
	TAD I	ST1
	JMS	PUT2X
	JMP	FLGLP
NOMOFG,	TAD	V
	CLL RAL
	TAD	(MSGTBL
	DCA	TEM
	CDF	MSGTBL
	TAD I	TEM
	CDF	.FLD
	SNA CLA
	JMP	.+3
	TAD	(4052
	JMS	PUT2X
	TAD	P
	SZA CLA
	JMP	NODTL
	IFNZRO	EAESV	<
	TAD	(-5	/FIVE ENTRIES IN EAESV ASSEMBLY
	>
	IFZERO	EAESV	<
	TAD	(-4
	>
	DCA	ST2
	TAD	V	/PRINT 4 WORDS FROM TASK STATE TABLE ENTRY
	CLL RTL		/FOR THIS TASK
	IFNZRO	EAESV	<
	TAD	V	/MULTIPLY BY FIVE FOR EAESV ASSEMBLY
	>
	TAD	(TSTABL
	DCA	ST1
	JMS	SYSOUT
	TAD	ST1
	JMS I	(PR12BT	/PRINT LOCATION OF JOB STATE TABLE ENTRY
	TAD	(272	/A COLON
	JMS	PUTWX
PRDTLP,	TAD	(240	/1 SPACE NOT TWO, SO ALL FITS IN BUFFER
	JMS	PUTWX
	CDF	TSTABL
	TAD I	ST1
	CDF	.FLD
	JMS I	(PR12BT
	ISZ	ST1
	ISZ	ST2
	JMP	PRDTLP

NODTL,	JMS	VTTOUT	/SEND MESSAGE TO TTY
NXTTSK,	ISZ	P	/END OF TABLE?
	TAD	P
	SPA CLA
	JMP	UPCHCK	/NO
	JMP	ENDS	/YES - GO AWAY

SYSOUT,	0
	SNA		/PRINT CONTENTS OF AC
	TAD	(4040	/OR BLANKS.
	JMS	PUT2X
	JMP I	SYSOUT

ST1,	0
ST2,	0

TEM,	0
	PAGE
	>

	.FSECT	MC.F
	FIELD	MC.SWP
	IFNDEF	EXIT	<
EXITT,	TAD I	(XNAME1
	TAD	(-'IT	/VERIFY THAT "EXIT" WAS TYPED
	SZA CLA
	JMP I	(EXAM	/OTHERWISE ASSUME USER MEANT "EXAMINE"
	IFDEF	OS8	<	/SPECIAL ACTION TO SHUT OS8
	.EXTERNAL	OSBOOT
	CIF	OSBOOT		/CALL SUBROUTINE
	JMS I	(OSBOOT
	>
	CDF	TSWFLG
	DCA I	(TSWFLG	/INHIBIT TASK SWITCHING
	ISZ	V$
	JMP	.-1	/ALLOW (MOST) I/O TO COMPLETE
	ISZ	DLAY$
	JMP	.-3
	IOF
	IFNZRO	KT8A	<6200>	/TURN OFF KT8A
	IFNZRO	OMNI	<CAF>
	CDF CIF	0
	IFNDEF	OS8	<	/FORCE BATCH TO BE RELOADED
	TAD I	(7746		/IF RELEVANT
	AND	(7377
	DCA I	(7746
	>
	JMP I	(7600	/GO TO OS8

V$:	0
DLAY$:	-60
	>
/
	IFDEF	EXIT	<
EXITT,	TAD I	(XNAME1
	TAD	(-'IT	/VERIFY THAT "EXIT" WAS TYPED
	SZA CLA
	JMP	EXAM	/OTHERWISE ASSUME USER MEANT "EXAMINE"
	TAD	(EXIT
	CAL
	RUN		/RUN EXIT TASK IF ONE IS SUPPLIED
	CDF CIF MCRF1
	JMP I	(ENDZE	/GO AWAY
	>
	IFNZRO	MCRCLK	<
MATCH,	CLL RTR
	RTR
	RAR
	TAD	DATEWD
	DCA	DATEWD
	JMS I	(GETN	/FETCH THE YEAR IN BINARY
	CLA		/IGNORE DELIMITER FOR NOW
	TAD	NUMB	/FETCH ACCUMULATED NUMBER
	TAD	(-106	/EXPRESS AS YEAR - 1970
	CDF	YEAR	/PREPARE TO ACCESS YEAR WORD IN EXEC
	DCA I	(YEAR	/PLACE YEAR-1970 AS YEAR
	TAD I	(YEAR	/NEED A COPY BACK AGAIN
	SPA		/SKIP ON  1970 THRU 1999, REGULAR
	TAD	(4	/2000 THRU 2069, ADJUST MODULO 8 COUNTER
	AND	(7	/KEEPING ONLY THE THREE BIT COUNTER
	TAD	DATEWD	/MERGE WITH REST OF DATE WORD
	DCA I	(DATE
	CDF	.FLD
	JMS I	(BACKUP
	JMS I	(LEGAL
	JMP I	(DLMER
	JMP I	(ENDS
	JMP I	(DOTIME	/MAY BE FOLLOWED BY TIME
DATEWD,	0
	>
	.DSECT	MC.D
	FIELD	MC.SWP
	IFNZRO	MCRCLK	<
MONTHS,	TEXT	"???-JAN-FEB-MAR-APR-MAY-JUN-JUL-AUG-SEP-OCT-NOV-DEC-"


/THIS TABLE CONTAINS THE CONVERSION FACTORS FOR HOURS,
/MINUTES & SECONDS TO TICKS. EACH IS A 2 WORD VALUE
/BECAUSE ALL THIS IS DONE BY DOUBLE WORD ARITHMETIC.
/THE HOUR TO TICKS VALUE = 60*60*SHERTZ = 7020(OCT)*SHERTZ
/THE LOW WORD VALUE IS DETERMINED FOR THIS MULTIPLICATION
/BY THE ASSEMBLER.
/THE HIGH WORD IS (7020*SHERTZ)/10000.
/THIS MUST BE REDUCED FOR THE ASSEMBLER
/IT IS = 341*SHERTZ/400 = 340*SHERTZ/400+SHERTZ/400 =
/ 7*SHERTZ/10+SHERTZ/400 = (7*SHERTZ+SHERTZ/40)/10

INTTBL,	"H
HRCON,	7020^SHERTZ
HRCON1,	7^SHERTZ+<SHERTZ%40>%10

	"M
MINCON,	74^SHERTZ
MINCN1,	17^SHERTZ%2000

	"S
SECCON,	SHERTZ
	0

	"T
TICCON,	1
	0

	0	/EOT
/
FUDGEL,	-600^SHERTZ
FUDGEH,	-25^SHERTZ-<3^SHERTZ%40>-1
	>
CMDLST,	-'ST;	STOP	/STOP
	-'EN;	ENABLE	/ENABLE
	-'DI;	DISABL	/DISABLE
	-'NA;	NAME	/NAME
	IFNZRO	MCRCLK	<
	-'DA;	DATEX	/DATE
	-'TI;	TIME	/TIME
	-'CA;	CANCEX	/CANCEL
	>
	-'RE;	SCHED	/REQUEST
	-'OP;	EXAM	/OPEN
	-'DE;	DEPSIT	/DEPOSIT
	-'PO;	POSTEF	/POST
	IFNZRO	MCRSYS	<
	-'SY;	SYSTAT	/SYSTAT
	>
	-'EX;	EXITT	/EXIT
	0;	NAMER	/END OF LIST
	IFNZRO	MCRSYS	<
/
FLGTBL,	MSGWT;	4015	/M
	EFWT;	4005	/E
	RUNWT;	4022	/R
	SWPWT;	4023	/S
	USERWT;	4025	/U
	ENABWT;	4004	/D
	EORMWT;	4017	/O
	NONRWT;	4016	/N
	DNEWT;	4030	/X
	0
	>