Google
 

Trailing-Edge - PDP-10 Archives - klad_sources - klad.sources/util1.mac
There are no other files named util1.mac in the archive.
TITLE	UTIL1
SUBTTL	GENERAL UTILITIES AND TTY I/O

;SOME GENERAL UTILITIES THAT DON'T REQUIRE ANY I/O EXCEPT
;FOR THE SUBROUTINE PACKAGE CALLS .....

	SEARCH	DEFINS,MONSYM

	ENTRY	QSTN,CHARIN,.NUMIN,NUMIN,PNTHEX,PNTHXF,PNTBCD,PNFBCD
	ENTRY	TSCAN,ICORE,XCOMP,COMPBB,COMPBW,TYPBIT,PVHEX,PVHEXF
	ENTRY	TYPLIN,PSDN,POCT,POCDEC,POCDEF
	ENTRY	TEXT.,TEXTF.,SWCHPT,STCLOK,RUNTME,RUNTMF,DLYTMR
	ENTRY	APRSN,.CLOSE,.RESET,.EXIT,.GTCOR,CORSIZ
	ENTRY	RNSEED,GENRAN,MONTRV

	INTERN	.SEED

	EXTERN	DEVREL,RANDF,NORPT,SHMODE,FRECOR

;QSTN -- ROUTINE TO INPUT ANSWERS (Y OR N) AND BRANCH
;THIS ROUTINE AUTOMATICALLY OUTPUTS THE "Y OR N" PROMT MSG.
;CALLING SEQUENCE:
;	GO	QSTN	;CALL THE ROUTINE
;	RTN-1		;TIMEOUT
;	RTN-2		;ANSWER WAS A NO
;	RTN-3		;ANSWER WAS A YES 

QSTN:	PFORCE			;FORCE THIS TO PRINT
	TTIYES			;INPUT FROM THE TERMINAL
	JRST	QSTNB		;NO OR TIMEOUT HAS OCCURED
	AOS	(P)
QSTNA:	AOS	(P)
	JFCL
	RTN

QSTNB:	SKIPLE	$TWCNT		;WAS THERE A TIMEOUT
	JRST	QSTNA		;NOPE. THE ANSWER WAS A NO

;CHARIN -- ROUTINE TO INPUT A SPECIFIC CHAR FROM THE TTY
;CALLING SEQUENCE:
;	MOVEI	0,CHAR		;SPECIFY THE CHARACTER YOU WANT
;	GO	CHARIN		;GO AND DO INPUT
;	RTN-1			;NO RESPONSE. TIMEOUT
;	RTN-2			;WRONG CHARACTER (AC0 HOLDS CHAR)
;	RTN-3			;CORRECT CHAR (AC0 HOLDS CHAR) 

CHARIN:	PUT	0		;SAVE DESIRED CHAR ONTHE STACK
	TTICHR			;DO TTY INPUT
	JRST	CHARA		;TIMEOUT
	AOS	-1(P)		;LEGAL. BUMP THE RETURN
	EXCH	0,(P)		;PUT THE CHAR ON THE STACK
	CAMN	0,(P)		;IS THE CHAR AS EXPECTED ?
	AOS	-1(P)		;YES. BUMP THE RETURN
CHARA:	PCRLF			;A FREE CR LF PAIR
	GET 	0		;GET THE CHAR
	RTN			;AND TAKE PROPER RETURN


;.NUMIN - GET NUMBER AT RANDOM OR FROM TTY
;ROUTINE  INPUTS AND CHECKS RANGE OF NUMBER.
;NUMBER IS RETURNED IN AC0.
;
;	CALL	SEQ:
;	MOVE	0,[LIM1,,LIM2]	;SET UP LIMITS
;	GO	.NUMIN		;CALL THE ROUTINE
;	RTN-1			;HERE IF TTY TIMEOUT
;	RTN-2			;HERE IF TTY INPUT ERROR
;	RTN-3			;HERE IF NUMBER IN RANGE
;
;	THIS ROUTINE LOOKS AT "RANDF" TO DETERMINE WHERE THE
;	NUMBER IS TO COME FROM. 

.NUMIN:	SKIPE	RANDF		;RANDOM OR TTY ?
	JRST	RND1		;RANDOM
	GO	NUMIN		;DO TTY INPUT
	RTN			;TIMEOUT
	SKIPA			;INPUT ERROR
	AOS	(P)		;FOR RETURN+2
	AOS	(P)
	RTN

;HERE BECAUSE WE WANT RANDOM NUMBERS
;ORDER THE LIMITS ON THE STACK. LAST LIMIT ON STACK IS HIGH LIMIT

RND1:	AOS	(P)		;1ST 2 RETURNS ARE IMPOSSIBLE
	AOS	(P)
	PUT	0		;SAVE AC0
	ADD	P,[2,,2]	;RESERVE STACK SPACE
	HRREM	0,-1(P)		;SAVE RIGHT LIMIT
	HLREM	0,(P)		;SAVE LEFT LIMIT
	MOVE	0,-1(P)		;GET 1ST LIMIT
	CAML	0,(P)		;IS 1ST SMALLER
	EXCH	0,(P)		;NO. RE-ORDER
	MOVEM	0,-1(P)		;NOW ORDERED CORRECTLY

;SEE IF LIMITS ARE EQUAL. IF THEY ARE, EXIT

	MOVE	0,(P)		;GET ONE OF THE LIMITS
	CAMN	0,-1(P)		;ARE THEY EQUAL ?
	JRST	.NUMX		;YES. NO NEED TO GENERATE

;GENERATE A RANDOM NUMBER

RND2:	MOVE	0,(P)		;GET UPPER LIMIT
	GO	GENRAN		;GENERATE THE RANDOM PARAMETER
	CAMGE	0,-1(P)		;RANGE TEST AGAINST LOWER LIMIT
	JRST	RND2		;OUT OF RANGE

;EXIT CODE. NUMBER IS NOW IN AC0

.NUMX:	MOVEM	0,-2(P)		;SAVE RESULT ON STACK AS AC0
	SUB	P,[2,,2]	;RECLAIM STACK SPACE
	GET	0		;GET THE NUMBER
	RTN			;TAKE +3 RTN



;NUMIN -- INPUT AND RANGE TEST A CONVERTABLE NUMBER 
;MULTIPLE RETURNS ARE SUPPLIED FOR BRANCHING.
;
;CALLING SEQ:
;	MOVE	0,[LIM1,,LIM2]	;SPECIFY THE LIMITS
;	GO	NUMIN		;CALL THE ROUTINE
;	RTN-1			;TIMEOUT. NO RESPONSE (AC0 UNCHANGED)
;	RTN-2			;ILLEGAL OR OUT OF RANGE (AC0 UNCHANGED)
;	RTN-3			;NORMAL. (36 BIT NUM IN AC0) 

NUMIN:	PUT	0		;SAVE ORIGINAL AC0
	ADD	P,[2,,2]	;GET SOME STACK SPACE

;SET UP 36 BIT LIMITS WITH LOWER OF THE 2 FIRST ON THE STACK

	HRREM	0,-1(P)		;SAVE 36 BIT RIGHT LIMIT
	HLREM	0,(P)		;SAVE 36 BIT LEFT LIMIT
	MOVE	0,-1(P)		;GET THE FIRST LIMIT
	CAML	0,(P)		;SEE IF FIRST IS SMALLER OF THE 2
	EXCH	0,(P)		;NO. EXCHANGE
	MOVEM	0,-1(P)		;LIMITS NOW ORDERED CORRECTLY

;INPUT A CONVERTABLE NUMBER

	TTICNV			;DOES TTY INPUT
	JRST	NUMIE		;ERROR OR TIMEOUT
	AOS	-3(P)		;INPUT OK. BUNMP THE RETURN
	CAML	0,-1(P)		;RANGE TEST THE NUMBER
	CAMLE	0,(P)
	JRST	NUMIEX		;OUT OF RANGE
	EXCH	0,-2(P)		;IN RANGE. PUT ON THE STACK
	AOS	-3(P)		;BUMP THE RETURN
NUMIEX:	SUB	P,[2,,2]	;RELINQUISH STACK SPACE
	GET	0		;RECOVER THE NUMBER
	RTN			;AND TAKE THE PROPER RETURN

NUMIE:	SKIPLE	$TWCNT		;WAS THERE A TIMEOUT ?
	AOS	-3(P)		;NO. BUMP THE RETURN
	JRST	NUMIEX		;TIMEOUT.

;PNTHEX -- PRINT 2 DIGIT HEX NUMBER FROM AC0 
;CALL SEQ:
;	MOVE	0,N		;GET NUMBER
;	GO	PNTHEX		;CALL THE ROUTINE
;	RTN-1			;RETURNS HERE ALWAYS 

PNTHEX:	PUT	0		;SAVE AC0
	LSH	-4		;POSITION HIGH ORDER DIGIT
	GO	HEXOUT		;PRINT DIGIT
	MOVE	(P)		;GET LOW ORDER DIGIT
	GO	HEXOUT		;PRINT IT
	TEXT	[ASCIZ/ /]	;A SPACE
	GET	0		;RESOTRE A.C.
	RTN			;EXIT
HEXOUT:	ANDI	0,17		;SAVE 4 BITS
	IORI	0,60		;CONVERT TO ASCII
	CAILE	0,"9"		;DIGIT GREATER THAN "9"?
	ADDI	0,7		;YES MAKE A LETTER
	PNTCHR			;PRINT THE CHARACTER
	RTN			;EXIT

;PNTHXF -- FORCE PRINT 2 DIGIT HEX NUMBER FROM AC0 
;CALL SEQ:
;	MOVE	0,N		;GET NUMBER
;	GO	PNTHXF		;CALL THE ROUTINE
;	RTN-1			;RETURNS HERE ALWAYS 

PNTHXF:	PUT	0		;SAVE AC0
	LSH	-4		;POSITION HIGH ORDER DIGIT
	GO	HEXOT		;PRINT DIGIT
	MOVE	(P)		;GET LOW ORDER DIGIT
	GO	HEXOT		;PRINT IT
	TEXTF	[ASCIZ/ /]	;A SPACE
	GET	0		;RESOTRE A.C.
	RTN			;EXIT
HEXOT:	ANDI	0,17		;SAVE 4 BITS
	IORI	0,60		;CONVERT TO ASCII
	CAILE	0,"9"		;DIGIT GREATER THAN "9"?
	ADDI	0,7		;YES MAKE A LETTER
	PNTCHF			;PRINT THE CHARACTER
	RTN			;EXIT

;PVHEX -- PRINT A VARIABLE # OF HEX DIGITS FROM AC0
;THIS ROUTINE EXPECTS DATA IN AC0 TO BE INTERPRETED AND PRINTED IN
;IN HEXIDECIMAL. AC0 MAY CONTAIN FROM 1 TO 9 HEX DIGITS WORTH OF DATA
;BECAUSE THATS HOW MANY FIT IN IN 36 BITS. AC2 WILL CONTAIN A NUMBER
;BETWEEN 1 AND 9 WHICH SPECIFIES HOW MANY HEX DIGITS WE HAVE PACKED
;IN AC0. THE ROUTINE GETS THE DIGITS OUT OF AC0 FROM LEFT TO RIGHT
;AND ASSUMES THAT THE RIGHTMOST HEX DIGIT IS FOUND IN BITS 32-35.
;
;A SPACE IS PRINTED AFTER THE SPECIFIED NUMBER OF HEX DIGITS HAS
;BEEN PRINTED. PRINTING IS NOT FORCED.
;
;CALL SEQ:
;	MOVE	0,ARG0		;DATA TO BE PRINTED IN HEXIDECIMAL
;	MOVE	1,ARG2		;NUMBER OF HEX DIGITS IN AC0 (RIGHT JUSTIFIED)
;	GO	PVHEX		;CALL THE ROUTINE
;	RTN			;RTN+1 ALWAYS

PVHEX:	CAILE	1,0		;SEE IF # DIGITS 1 THRU 8
	CAILE	1,^D9		
	RTN			;ERROR .... 

	PUT	0		;OK. SAVE AC'S
	PUT	1
	PUT	2
	MOVE	2,1		;GET COUNT TO AC2
	MOVE	1,[POINT 4,-2(P),3] ;POINT TO LEFTMOST POSSIBLE BYTE
	SUBI	2,^D9		;N-9= (-# OF BYTES BEFORE DATA)
	JUMPE	2,.+3		;SKIP IF RESULT IS 0
	IBP	1		;BUMP POINTER IN AC1
	AOJN	2,.-1		;STEP UP TO THE DATA

;BYTE POINTER NOW AT FIRST VALID HEX DIGIT FIELD

	MOVN	2,-1(P)		;GET -# OF HEX DIGITS TO BE PRINTED
DIGI:	LDB	0,1		;GET A DIGIT
	GO	HEXUT		;PRINT IT
	IBP	1		;ADVANCE BYTE POINTER
	AOJN	2,DIGI		;PRINT ALL THE DIGITS
	TEXT	[ASCIZ/ /]	;PRINT A SPACE
	GET	2		;RESTORE AC'S
	GET	1
	GET	0
	RTN			;EXIT

;CONVERT CHAR IN AC0 TO HEX AND PRINT IT

HEXUT:	ANDI	0,17		;SAVE 4 BITS
	IORI	0,60		;CONVERT TO ASCII
	CAILE	0,"9"		;DIGIT GREATER THAN "9"?
	ADDI	0,7		;YES MAKE A LETTER
	PNTCHR			;PRINT THE CHARACTER
	RTN			;EXIT

;PVHEXF -- FORCE PRINT A VARIABLE # OF HEX DIGITS FROM AC0
;THIS ROUTINE EXPECTS DATA IN AC0 TO BE INTERPRETED AND PRINTED IN
;IN HEXIDECIMAL. AC0 MAY CONTAIN FROM 1 TO 9 HEX DIGITS WORTH OF DATA
;BECAUSE THATS HOW MANY FIT IN IN 36 BITS. AC2 WILL CONTAIN A NUMBER
;BETWEEN 1 AND 9 WHICH SPECIFIES HOW MANY HEX DIGITS WE HAVE PACKED
;IN AC0. THE ROUTINE GETS THE DIGITS OUT OF AC0 FROM LEFT TO RIGHT
;AND ASSUMES THAT THE RIGHTMOST HEX DIGIT IS FOUND IN BITS 32-35.
;
;A SPACE IS PRINTED AFTER THE SPECIFIED NUMBER OF HEX DIGITS HAS
;BEEN PRINTED. PRINTING IS FORCED.
;
;CALL SEQ:
;	MOVE	0,ARG0		;DATA TO BE PRINTED IN HEXIDECIMAL
;	MOVE	1,ARG2		;NUMBER OF HEX DIGITS IN AC0 (RIGHT JUSTIFIED)
;	GO	PVHEXF		;CALL THE ROUTINE
;	RTN			;RTN+1 ALWAYS

PVHEXF:	CAILE	1,0		;SEE IF # DIGITS 1 THRU 8
	CAILE	1,^D9		
	RTN			;ERROR .... 

	PUT	0		;OK. SAVE AC'S
	PUT	1
	PUT	2
	MOVE	2,1		;GET COUNT TO AC2
	MOVE	1,[POINT 4,-2(P),3] ;POINT TO LEFTMOST POSSIBLE BYTE
	SUBI	2,^D9		;N-9= (-# OF BYTES BEFORE DATA)
	JUMPE	2,.+3		;SKIP IF RESULT IS 0
	IBP	1		;BUMP POINTER IN AC1
	AOJN	2,.-1		;STEP UP TO THE DATA

;BYTE POINTER NOW AT FIRST VALID HEX DIGIT FIELD

	MOVN	2,-1(P)		;GET -# OF HEX DIGITS TO BE PRINTED
DIGIF:	LDB	0,1		;GET A DIGIT
	GO	HEXUTF		;PRINT IT
	IBP	1		;ADVANCE BYTE POINTER
	AOJN	2,DIGIF		;PRINT ALL THE DIGITS
	TEXTF	[ASCIZ/ /]	;PRINT A SPACE
	GET	2		;RESTORE AC'S
	GET	1
	GET	0
	RTN			;EXIT

;CONVERT CHAR IN AC0 TO HEX AND PRINT IT

HEXUTF:	ANDI	0,17		;SAVE 4 BITS
	IORI	0,60		;CONVERT TO ASCII
	CAILE	0,"9"		;DIGIT GREATER THAN "9"?
	ADDI	0,7		;YES MAKE A LETTER
	PNTCHF			;PRINT THE CHARACTER
	RTN			;EXIT

;PNTBCD -- PRINT LOW ORDER PART OF AC0 IN BCD
;THIS ROUTINE PRINTS THE LOW ORDER 16 BITS OF AC0 AS A
;4 DIGIT BCD NUMBER.
;
;CALL SEQ:
;	MOVE	0,ARG1		;GET THE VALUE TO AC0
;	GO	PNTBCD		;CALL THE ROUTINE
;	RTN+1			;RETURNS +1 ALWAYS 

PNTBCD:	PUT	0		;SAVE THE VALUE
	LDB	0,[POINT 4,(P),23] ;GET FIRST DIGIT FROM STACK
	PNTDEC			;PRINT IN DECIMAL
	LDB	0,[POINT 4,(P),27] ;GET 2ND DIGIT FROM STACK
	PNTDEC			;PRINT IN DECIMAL
	LDB	0,[POINT 4,(P),31] ;GET 3RD DIGIT FROM STACK
	PNTDEC			;PRINT IN DECIMAL
	LDB	0,[POINT 4,(P),35] ;GET 4TH DIGIT FROM STACK
	PNTDEC			;PRINT IN DECIMAL
	TEXT	[ASCIZ/./]	;FOLLOWED BY A PERIOD
	GET	0		;RESTORE THE AC
	RTN			;AND EXIT

;PNFBCD -- FORCE PRINT LOW ORDER PART OF AC0 IN BCD
;THIS ROUTINE PRINTS THE LOW ORDER 16 BITS OF AC0 AS A
;4 DIGIT BCD NUMBER.
;
;CALL SEQ:
;	MOVE	0,ARG1		;GET THE VALUE TO AC0
;	GO	PNFBCD		;CALL THE ROUTINE
;	RTN+1			;RETURNS +1 ALWAYS 

PNFBCD:	PUT	0		;SAVE THE VALUE
	LDB	0,[POINT 4,(P),23] ;GET FIRST DIGIT FROM STACK
	PNTDCF			;PRINT IN DECIMAL
	LDB	0,[POINT 4,(P),27] ;GET 2ND DIGIT FROM STACK
	PNTDCF			;PRINT IN DECIMAL
	LDB	0,[POINT 4,(P),31] ;GET 3RD DIGIT FROM STACK
	PNTDCF			;PRINT IN DECIMAL
	LDB	0,[POINT 4,(P),35] ;GET 4TH DIGIT FROM STACK
	PNTDCF			;PRINT IN DECIMAL
	TEXTF	[ASCIZ/./]	;FOLLOWED BY A PERIOD
	GET	0		;RESTORE THE AC
	RTN			;AND EXIT

;TSCAN -- SCANS TABLE FOR AN ENTRY AND RETURNS INDEX 
;THIS ROUTINE IS PASSED SOME DATA AND TABLE POINTER AND
;ITS FUNCTION IS TO SEARCH THE TABLE FOR THE DATA ENTRY. IF FOUND
;THE INDEX INTO THE TABLE WHERE IT WAS FOUND IS PLACED IN AC1. IF
;THE ENTRY WAS NOT FOUND, AC'S ARE UNCHANGED.
;CALL SEQ:
;	MOVE	AC2,ARG		;DATA YOU ARE LOOKING FOR
;	MOVE	AC1,ARG		;START ADDRESS OF TABLE
;	RTN+1			;ENTRY NOT FOUND (AC1 UNCHANGED)
;	RTN+2			;ENTRY FOUND, INDEX IN AC1
;
;	THE END OF THE TABLE IS MARKED BY A ZERO ENTRY 

TSCAN:	PUT	1		;SAVE AC1
	SUBI	1,1		;POINTING TO TABLE ADDR-1

TSLOOP:	ADDI	1,1		;BUMP THE POINTER
	CAME	2,(1)		;ENTRY=DATA ?
	JRST	TFZ		;NO. TEST FOR ZERO
	AOS	-1(P)		;YES. BUMP THE RETURN
	SUB	1,(P)		;AC1 NOW AN INDEX VALUE
	MOVEM	1,(P)		;TO AC1 ON STACK
	JRST	TSX		;TO EXIT CODE
TFZ:	SKIPE	(1)		;IS THE ENTRY=0
	JRST	TSLOOP		;NO. TRY NEXT ONE
TSX:	GET	1		;RESTORE THE AC
	RTN			;AND EXIT

;ICORE -- INIT CORE TO A CONSTANT PATTERN
;USED TO CLEAR CORE AND GENERATE DATA BUFFERS
;CALLING SEQ
;	MOVE	AC1,ARG1	;+WC,,BUFFER ADDRESS
;	MOVE	AC2,ARG2	;DATA PATTERN
;	GO	ICORE		;CAL THE ROUTINE
;	RTN+1			;ALWAYS RETURNS HERE 

ICORE:	PUT	1		;WC,,ADDR
	PUT	2		;SAVE DATA
	MOVEM	2,(1)		;SETS UP 1ST LOCATION
	HRLZ	2,1		;SOURCE,,0
	ADDI	1,1		;TWC,,ADR+1
	HRR	2,1		;SOURCE,,DEST
	HLRZ	1,1		;0,,TWC
	ADD	1,2		;SOURCE,,DEST+WC
	SUBI	1,2		;SOURCE,,DEST+WC-2
	BLT	2,(1)		;DOES THE FILL
	GET	2		;RESTORE AC'S
	GET	1
	RTN			;AND EXIT


;XCOMP -- SET BUFFER "B" TO COMPLEMENT OF BUFFER "A"
;CALLING SEQ
;	MOVE	AC1,ARG1	;WC,,ADDR OF BUFFER "A"
;	MOVE	AC2,ARG2	;ADDR OF BUFFER "B"
;	GO	XCOMP		;CALL THE ROUTINE
;	RTN+1			;RETURNS HERE ALWAYS 

XCOMP:	PUT	0		;SAVE 0
	PUT	1		;WDS,,ADR-A
	PUT	2		;0,,ADR-B
	HLRZ	1,-1(P)		;0,,WDS
	MOVN	1,1		;-WDS
	HRLZ	1,1		;-WDS,,0
	HRR	1,-1(P)		;-WDS,,ADR-A
	HRRZ	2,(P)		;ADDRES OF B - BUFFER
XC1:	MOVE	0,(1)		;FETCH "A" WORD
	SETCAM	0,(2)		;COMP WORD "A" TO "B" WORD
	AOS	2		;BUMP DESTINATION POINTER
	AOBJN	1,XC1		;BUMP WC,,ADDR. JUMP IF NOT DONE
	GET	2		;RESTORE AC'S
	GET	1
	GET 	0
	RTN			;AND EXIT


;COMPBB - COMPBW -- COMPARE ROUTINES
;COMPBW - DOES A COMPARE OF ENTIRE BUFFER TO A WORD (CONSTANT)
;COMPBB - DOES A BUFFER TO BUFFER COMPARISON ONE WORD AT A TIME
;
;ONLY THE FIRST 3 COMARE ERRORS ARE PRINTED UNLESS THE SWITCH
;PALERS IS SET. THIS ROUTINE LOOKS AT A FLAG "NORPT" AND IF
;THE FLAG IS NON-ZERO, NO PRINTING IS DONE.
;AC1 ALWAYS RETURNS A NUMBER THAT IS EQUAL TO THE NUMBER OF
;COMPARE FAILURES THAT WERE ENCOUNTERED. THIS HAPPENS WETHER
;OR NOT YOU PRINT THEM ALL. IT IS USEFUL FOR ERROR LOGGING
;
;CALLING SEQ:
;	MOVE	AC1,ARG1	;+WORD COUNT,,BUFFER ADDRESS
;	MOVE	AC2,ARG2	;DATA WORD ADR, OR OTHER BUFFER ADDRESS
;	GO	COMPXX		;WHERE "XX" IS "BB" OR "BW"
;	RTN+1			;DATA COMPARISON ERRORS DETECTED
;	RTN+2			;NO DATA COMPARISON ERRORS FOUND
;
;	AC1 CONTAINS A COUNT = #OF COMPARE ERRORS  

COMPBB:	SETZM	BB#		;FLAG BUFFER TO BUFFER MODE
	AOSA	BB		;NOW=1
COMPBW:	SETZM	BB		;FLAG NOW=0
	PUT	0		;SAVE AC'S
	PUT	1
	PUT	2
	PUT	3
	HLRZ	1,-2(P)		;0,,WC
	MOVN	1,1		;-WC
	HRLZ	1,1		;-WC,,0
	HRR	1,-2(P)		;-WC,,ADR
	SETZM	WD#		;POINTER TO 1ST WORD
	AOS	WD		;NOW AT 1ST (FOR ERROR REPORTING)
	SETZM	CMPFLG#		;HEADER MESSAGE FLAG
	SETZM	CECNT#		;COMPARISON ERROR COUNTER
CLOOP:	MOVE	3,(1)		;FETCH BUFFER WORD (READ WORD)
	CAMN	3,@2		;DO A COMPARE
	JRST	COM.OK		;GOOD COMPARE
	GO	CMPERR		;REPORT THE ERROR
COM.OK:	AOBJP	1,COMDN		;BUMP POINTER.JUMP IF DONE
	AOS	WD		;NOT DONE. BUMP WORD COUNTER
	SKIPE	BB		;BUFFER TO (BUFFER OR WORD) MODE
	AOS	2		;BB MODE. BUMP OTHER POINTER
	JRST	CLOOP		;EITHER MODE
COMDN:	GET	3		;RESTORE AC'S
	GET	2
	GET	1
	GET	0
	SKIPN	1,CECNT		;GET ERROR TOTALS AND ADJUST RTN
	AOS	(P)		;NO. BUMP RTN
	RTN			;TAKE PROPER RETURN

CMPERR:	PUT	0		;SAVE AC'S
	PUT	2
	SKIPE	NORPT		;WANT ERRORS PRINTED ??
	JRST	LOGIT		;NO. JUST COUNT
	MOVE	0,CECNT		;CURRENT ERROR FLAG
	CAIGE	0,3		;PRINT 1ST 3 ERRORS
	JRST	.+4
	SWITCH			;READ THE SWITCHES
	TLNN	0,PALERS	;SEE IF WE WANT THEM PRINTED
	JRST	LOGIT		;NO. BUT LOG THE ERROR
	MOVE	2,@2		;AC2=GOOD AC3=BAD
	SKIPE	CMPFLG		;TEST PRINT HEADER FLAG
	JRST	REPORT		;ALREADY PRINTED
	TEXT	[ASCIZ/  *** DATA COMPARE ERROR
WORD	EXPECTED	BAD WORD	BITS IN ERROR	CORE ADDRESS
/]
	AOS	CMPFLG		;SET HEADER MESSAGE FLAG
REPORT:	MOVE	0,WD		;THE WORD #
	GO	PSDN		;PRINT A DECIMAL WORD#
	TEXT	[ASCIZ/	/]	;A TAB
	MOVE	0,2		;GOOD WORD TO AC0
	PNTOCT			;PRINT IN OCTAL
	TEXT	[ASCIZ/	/]	;A TAB
	MOVE	0,3		;BAD WORD TO AC0
	PNTOCT			;PRINT IN OCTAL
	TEXT	[ASCIZ/	/]	;A TAB
	MOVE	0,3		;BAD WORD TO AC0
	XOR	0,2		;DIFFERENCE TO AC0
	PNTOCT			;PRINT IN OCTAL
	TEXT	[ASCIZ/   /]	;A TAB AND 2 SPACES
	MOVE	0,1		;GET CORE ADDRESS
	PNT6			;PRINT IT
	PCRL
LOGIT:	AOS	CECNT		;ADD TO TOTALS COUNT...
	GET	2		;RESTORE AC'S
	GET	0
	RTN			;EXIT

;TYPBIT -- TABLE BIT PRINTER
;THIS ROUTINE IS USED TO TRANSLATE ONES IN A 36 BIT
;DATA WORD TO A SERIES OF EQUIV. SIXBIT MESSAGES TAKEN
;FROM A TABLE. THIS ROUTINE MERELY
;TRANSLATES ONE TO SIXBIT MESSAGES AND ALSO TYPES ERROR
;MESSAGES IF IT FINDS ONES IN BIT POSITIONS WHERE THEY ARE NOT EXPECTED.
;
;CALL SEQ:
;	MOVE 	AC1,ARG1	;36 BITS OF DATA
;	MOVE	AC2,ARG2	;POINTER TO DESCRIPTOR TABLE
;	GO	TYPBIT		;CALL THE ROUTINE
;	RETURN			;RETURNS +1 ALWAYS
;
;
;FUNCTIONS OF AC'S FOR THIS ROUTINE
;AC	FUNCTION
;--	----------
;0	USED FOR PRINTING
;1	HOLDS 36 BIT DATA WORD
;2	HOLDS UPDATED TABLE POINTER
;3	HOLDS MASK-1 (EXPECTED 1'S)
;4	HOLDS MASK- 2 (EXPECTED 0'S)
;5	A SINGLE BIT MASK (SHIFTS TO RIGHT)
;6	A SCRATCH AC FOR A JFFO
	

TYPBIT:	PUT	0		;SAVE AC0
	SKIPE	SHMODE		;SHORT PRINTOUT MODE ?
	JRST	EXG0		;YES
	MOVE	CONSW		;GET CONSOLE SWITCHES
	TLNE	TXTINH		;SHORT PRINTOUT ONLY ??
	JRST	EXG0		;YES. THEN EXIT
	PUT	1		;NO. SAVE SOME MORE
	PUT	2
	PUT	3
	PUT	4
	PUT	5
	PUT	6

;GET THE AC'S READY TO GO

	ADDI	2,2		;GET POINTER TO FIRST MESSAGE
	MOVE	3,-2(2)		;GETS FIRST MASK WORD
	MOVE	4,-1(2)		;GETS SECOND MASK WORD
	SETZ	5,		;CLEAR THE MASK
	TLO	5,(1B0)		;AND CREATE A SINGLE BIT MASK

TSX1:	TDNN	3,5		;MW-1 A ONE ??
	JRST	TSX2		;NO
	TDNE	1,5		;YES. IS DATA BIT A ONE ??
	GO	TSXM1		;YES. GO PRINT A MESSAGE
	AOS	2		;NO. BUMP THE POINTER
 	JRST	TSX3		;GO AND UPDATE THE MASK
TSX2:	TDNN	1,5		;IS DATA A ONE ??
	JRST	TSX3		;NO.
	TDNE	4,5		;YES. MW-2 A ONE ??
	GO	TSXM2		;YES. GO PRINT ERROR MSG
TSX3:	LSH	5,-1		;SHIFT MASK BIT TO RIGHT
	JUMPN	5,TSX1		;JUMP IF MASK IS NOT YET ZERO
	GET	6		;OTHERWISE RESTORE AC'S
	GET	5
	GET	4
	GET 	3
	GET	2
	GET	1
EXG0:	GET	0
	RTN			;AND RETURN

;HERE ARE THE 2 MESSAGE SUBROUTINES

TSXM1:	MOVE	0,(2)		;GETS MESSAGE
	PNTSIX			;PRINTS IT
	TEXT	[ASCIZ/ /]	;A BLANK
	RTN

TSXM2:	TEXT	[ASCIZ/?BIT-/]
	JFFO	5,.+1		;GET REAL BIT POSITION
	MOVE	0,6		;GET POSITION FOR PRINTING
	GO	PSDN		;PRINT IT
	TEXT	[ASCIZ/? /]	;QESTION MARK FOLLOWED BY BLANK
	RTN			;AND EXIT


;TYPLIN -- TABLE ASCIZ MESSAGE PRINTER
;THIS ROUTINE IS USED TO TRANSLATE 1'S IN A 36 BIT
;DATA WORD TO A SERIES OF EQUIV. ASCIZ MESSAGES TAKEN
;FROM A TABLE. THIS ROUTINE MERELY
;TRANSLATES ONE TO SIXBIT MESSAGES AND ALSO TYPES ERROR
;MESSAGES IF IT FINDS ONES IN BIT POSITIONS WHERE THEY ARE 
;NOT EXPECTED.
;
;CALL SEQ:
;	MOVE 	AC1,ARG1	;36 BITS OF DATA
;	MOVE	AC2,ARG2	;POINTER TO DESCRIPTOR TABLE
;	GO	TYPLIN		;CALL THE ROUTINE
;	RETURN			;RETURNS +1 ALWAYS
;
;FUNCTIONS OF AC'S FOR THIS ROUTINE
;AC	FUNCTION
;--	----------
;0	USED FOR PRINTING
;1	HOLDS 36 BIT DATA WORD
;2	HOLDS UPDATED TABLE POINTER
;3	HOLDS MASK-1 (EXPECTED 1'S)
;4	HOLDS MASK- 2 (EXPECTED 0'S)
;5	A SINGLE BIT MASK (SHIFTS TO RIGHT)
;6	A SCRATCH AC FOR A JFFO

TYPLIN:	PUT	0		;SAVE AC0
	SKIPE	SHMODE		;SHORT PRINTOUT MODE ?
	JRST	.EXG0		;YES
	MOVE	CONSW		;GET CONSOLE SWITCHES
	TLNE	TXTINH		;SHORT PRINTOUT ONLY ??
	JRST	.EXG0		;YES. THEN EXIT
	PUT	1		;NO. SAVE SOME MORE
	PUT	2
	PUT	3
	PUT	4
	PUT	5
	PUT	6

;GET THE AC'S READY TO GO

	ADDI	2,2		;GET POINTER TO FIRST MESSAGE
	MOVE	3,-2(2)		;GETS FIRST MASK WORD
	MOVE	4,-1(2)		;GETS SECOND MASK WORD
	SETZ	5,		;CLEAR THE MASK
	TLO	5,(1B0)		;AND CREATE A SINGLE BIT MASK

.TSX1:	TDNN	3,5		;MW-1 A ONE ??
	JRST	.TSX2		;NO
	TDNE	1,5		;YES. IS DATA BIT A ONE ??
	GO	.TSXM1		;YES. GO PRINT A MESSAGE
	AOS	2		;NO. BUMP THE POINTER
 	JRST	.TSX3		;GO AND UPDATE THE MASK
.TSX2:	TDNN	1,5		;IS DATA A ONE ??
	JRST	.TSX3		;NO.
	TDNE	4,5		;YES. MW-2 A ONE ??
	GO	.TSXM2		;YES. GO PRINT ERROR MSG
.TSX3:	LSH	5,-1		;SHIFT MASK BIT TO RIGHT
	JUMPN	5,.TSX1		;JUMP IF MASK IS NOT YET ZERO
	GET	6		;OTHERWISE RESTORE AC'S
	GET	5
	GET	4
	GET 	3
	GET	2
	GET	1
.EXG0:	GET	0
	RTN			;AND RETURN

;HERE ARE THE 2 MESSAGE SUBROUTINES

.TSXM1:	PCRL			;ADVANCE TO NEXT LINE
	TEXT	@(2)		;PRINT MESSAGE VIA TABLE POINTER
	TEXT	[ASCIZ/ /]	;A BLANK
	RTN

.TSXM2:	TEXT	[ASCIZ/
?BIT-/]				;ADVANCE AND START ERROR MESSAGE
	JFFO	5,.+1		;GET REAL BIT POSITION
	MOVE	0,6		;GET POSITION FOR PRINTING
	GO	PSDN		;PRINT IT
	TEXT	[ASCIZ/? /]	;QESTION MARK FOLLOWED BY BLANK
	RTN			;AND EXIT

;PSDN -- PRINTS SIGNED DECIMAL NUMBERS
;PSDN PRINTS THE CONTENTS OF AC0 AS A SIGNED DECIMAL 
;NUMBER FOLLOWED BY A PERIOD. LEADING ZEROS ARE
;SURPRESSED.  
;
;CALL SEQ:
;	MOVE	0,ARG0		;GET THE NUMBER TO AC0
;	GO	PSDN		;CALL THE ROUTINE
;	RTN			;RETURN+1 ALWAYS

PSDN:	PUT	0
	JUMPL	0,PSDN1
PSDN0:	PNTDEC			;PRINT THE NUMBER
	TEXT	[ASCIZ/./]	;A PERIOD
	GET	0
	RTN
PSDN1:	TEXT	[ASCIZ/-/]	;A MINUS SIGN
	MOVN	0,(P)
	JRST	PSDN0

;POCT -- OCTAL NUMBER PRINTER
;POCT PRINTS THE CONTENTS OF AC0 AS AN OCTAL NUMBER. 
;LEADING ZEROS ARE SURPRESSED.
;CALL SEQ:
;	MOVE	0,ARG0		;NUMBER TO AC0
;	GO	POCT		;CALL THE ROUTINE
;	RTN-1			;+1 ALWAYS
;
;FUNCTIONS OF AC'S FOR THE ROUTINE:
;AC	FUNCTION
;--	--------
;0	HOLDS PRINT CHAR
;1	DIGIT COUNTER
;2	A FLAG
;3	OCTAL DIGIT BYTE POINTER 

POCT:	PUT	0		;SAVE AC'S
	PUT	1
	PUT	2
	PUT	3
	MOVEI	1,^D12		;# OF OCTAL DIGITS POSSIBLE
	SETZ	2,		;ZERO THE FLAG
	MOVE	3,[POINT 3,-3(P)] ;BYTE POINTER
POCT1:	ILDB	0,3		;GETS NEXT DIGIT
	JUMPN	2,POCT3		;JUMP IF FLAG NON ZERO
	JUMPE	0,POCT2		;JUMP IF DIGIT IS ZERO
	MOVEI	2,1		;SET THE FLAG
	JRST	POCT3		;GO AND CONVERT
POCT2:	CAIE	1,1		;CNT=1 ??
	JRST	POCT4		;NO
POCT3:	ADDI	0,60		;CONVERT TO ASCII
	PNTCHR			;PRINT THE CHARACTER
POCT4:	SOJG	1,POCT1		;LOOP IF COUNT IS NOT YET ZERO
	GET	3
	GET	2
	GET	1
	GET	0
	RTN			;AND EXIT.

;POCDEC -- PRINT AC0  IN BOTH OCTAL AND DECIMAL
;THIS ROUTINE PRINTS AC0 AS A 36 BIT QUANTITY. AC0 IS PRINTED
;FIRST AS AN OCTAL VALUE (LEADING ZEROS SURPRESSED) AND RIGHT
;BESIDE IT AS A SIGNED DECIMAL NUMBER IN PARENTHESIS (LEADING
;ZEROS ALSO SURPRESSED.
;CALL	SEQ:
;	MOVE	0,ARG0		;A 36 BIT VALUE
;	GO 	POCDEC		;CALL THE ROUTINE
;	RTN			;RETURNS +1 ALWAYS

POCDEC:	GO	POCT		;PRINT IN OCTAL
	TEXT	[ASCIZ/(/]
	GO	PSDN		;NOW IN DECIMAL
	TEXT	[ASCIZ/)/]
	RTN			;AND EXIT

;POCDEF -- PRINT AC0  IN BOTH OCTAL AND DECIMAL
;THIS ROUTINE PRINTS AC0 AS A 36 BIT QUANTITY. AC0 IS PRINTED
;FIRST AS AN OCTAL VALUE (LEADING ZEROS SURPRESSED) AND RIGHT
;BESIDE IT AS A SIGNED DECIMAL NUMBER IN PARENTHESIS (LEADING
;ZEROS ALSO SURPRESSED. ALL PRINTING IS FORCED.
;CALL	SEQ:
;	MOVE	0,ARG0		;A 36 BIT VALUE
;	GO 	POCDEF		;CALL THE ROUTINE
;	RTN			;RETURNS +1 ALWAYS

POCDEF:	GO	.POCT		;PRINT IN OCTAL
	TEXTF	[ASCIZ/(/]
	GO	.PSDN		;NOW IN DECIMAL
	TEXTF	[ASCIZ/)/]
	RTN			;AND EXIT

;PRINT AC0 AS A SIGNED DECIMAL NUMBER

.PSDN:	PUT	0
	JUMPL	0,.PSDN1
.PSDN0:	PNTDCF			;PRINT THE NUMBER FORCED
	TEXTF	[ASCIZ/./]	;A PERIOD
	GET	0
	RTN
.PSDN1:	TEXTF	[ASCIZ/-/]	;A MINUS SIGN
	MOVN	0,(P)
	JRST	.PSDN0


;ROUTINE TO PRINT AC0 AS AN OCTAL NUMBER WITH LEAD ZEROS SURPRESSED

.POCT:	PUT	0		;SAVE AC'S
	PUT	1
	PUT	2
	PUT	3
	MOVEI	1,^D12		;# OF OCTAL DIGITS POSSIBLE
	SETZ	2,		;ZERO THE FLAG
	MOVE	3,[POINT 3,-3(P)] ;BYTE POINTER
.POCT1:	ILDB	0,3		;GETS NEXT DIGIT
	JUMPN	2,.POCT3	;JUMP IF FLAG NON ZERO
	JUMPE	0,POCT.2	;JUMP IF DIGIT IS ZERO
	MOVEI	2,1		;SET THE FLAG
	JRST	.POCT3		;GO AND CONVERT
POCT.2:	CAIE	1,1		;CNT=1 ??
	JRST	.POCT4		;NO
.POCT3:	ADDI	0,60		;CONVERT TO ASCII
	PNTCHF			;PRINT THE CHARACTER
.POCT4:	SOJG	1,.POCT1	;LOOP IF COUNT IS NOT YET ZERO
	GET	3
	GET	2
	GET	1
	GET	0
	RTN			;AND EXIT.

;TEXT. - TEXTF. -- HERE ARE 2 TEXT UUO UTILITIES
;THESE UUO'S USE THE UUO E-FIELD AS A POINTER TO TEXT
;IN ASCIZ FORMAT. THEY MERELY PRINT THE TEXT IN THE
;NORMAL OR FORCED PRINTOUT MODE.
;
;THESE PRESERVE AC0 AND DO PROPER RELEASING OF DEVICES IF
;RUNNING AN ON-LINE DIAGNOSTIC IN USER MODE....
;
;	THE UUO'S MUST BE DEFINED IN THE PROGRAMS TITLE FILE.
;	EG.	OPDEF	TEXT	[30B8]	;PRINT NORMAL
;		OPDEF	TEXTF	[31B8]	;PRINT FORCED
;
;		LUUO30=	TEXT.
;		LUUO31=	TEXTF.		;SERVICE ROUTINE 

TEXT.:	PUT	0		;SAVE AC0
	HRRZ	0,$SVUUO	;GET MESSAGE ADDR
	PNTAL			;PRINT THE MESSAGE
	GET	0		;RESTORE THE AC
	RTN			;EXIT THE UUO

TEXTF.:	PUT	0		;SAVE THE AC
	PUT	$SVUUO		;SAVE UUO ADDRESS
	PUT	$SVUPC		;SAVE UUO PC
	GO	DEVREL		;RELEASE THE DEVICE
	SKIPN	USER		;USER MODE ?
	JRST	.+6		;NO.. SKIP INPUT BUFFER CLEAR CODE
	SKIPE	MONTYP		;BRANCH ACCORDING TO MON TYPE
	JRST	.+3		;IT'S TOPS-20
	CLRBFI			;IT'S TOPS-10 EXECUTE UUO
	SKIPA			;AND SKIP
	CFIBF			;EXECUTE THE JSYS
	HRRZ	0,-1(P)		;GET UUO E-FIELD FROM THE STACK
	PNTALF			;FORCE PRINT THE MESSAGE
	GET	$SVUPC		;RESTORE UUO PC
	GET	$SVUUO		;RESTORE THE ACTUAL UUO
	GET	0		;RESTORE THE AC
	RTN			;EXIT THE UUO

;SWCHPT -- PRINTS CURRENT STATE OF SWITCHES FROM "CONSW"

SWCHPT:	PUT	0
	TEXTF	[ASCIZ/SWITCHES - /]
	MOVE	CONSW
	PNTHWF
	TEXTF	[ASCIZ/
/]
	GET	0
	RTN

;STCLOK -- ROUTINE TO INITIALIZE PROGRAM RUNTIME CLOCK
;THIS ROUTINE INITIALIZES THE CLOCK FOR THE PROGRAM. IT IS USED
;IN CONCUNCTION WITH ROUTINE "RUNTME". 
;
;IN EXEC MODE THIS ROUTINE RESETS, RESTARTS AND THEN READS THE
;CURRENT MICROSECOND TIME CLOCK INTO MEMORY FOR REFERENCE BY
;THE RUNTIME CALCULATOR "RUNTME". THE CLOCK IS SET UP SO THAT
;IT CAUSES A HARDWARE INTERRUPT, IT MERELY FREE RUNS.
;
;IN USER MODE THE PROGRAM RUN TIME IS OBTAINED IN MILLISECONDS
;WITH A MONITOR CALL, CONVERTED TO MICROSECONDS AND STORED FOR
;FUTURE REFERENCE BY THE RUNTIME CALCULATOR "RUNTME"
;
;THIS ROUTINE MAY BE CALLED AT ANY TIME TO RESET THE PROGRAMS
;RUNTIME ...
;
;CALL SEQ:
;	GO	STCLOK		;CALLS THE ROUTINE
;	RTN-1			;ALWAYS RETURNS +1

STCLOK:	PUT	0		;SAVE AC'S
	PUT	1
	SKIPE	USER		;IN USER MODE ?
	JRST	STCU		;YES 
	CONO	24,1B18!1B22	;STOP AND RESET THE CLOCK
	SETZM	510		;CLEAR EPT LOCATIONS
	SETZM	511		;  FOR TIMER DATA
	CONO	24,1B25		;TURNS THE METER ON
	DATAI	20,TMRST1	;SAVE A DOUBLE WORD
	JRST	STCX		;DOEN. EXIT.
STCU:	GO	MONTIM		;GET MONITOR TIME IN MICROSECONDS
	JFCL			;	IN METER FORMAT
	DMOVEM	1,TMRST1	;SAVE A DOUBLE WORD
STCX:	GET	1		;RESTORE
	GET	0
	RTN			;EXIT

TMRST1:	BLOCK	2		;2 WORD INITIAL TIME STORAGE
	
;HERE IS A SUBROUTINE CALLED BY BOTH STCLOK AND RUNTME. IT READS
;THE CURRENT PROGRAM RUNTIME IN MILLISECONDS FROM THE MONITOR, CONVERTS
;THE TIME TO MICROSECONDS AND THEN POSITIONS THAT MICROSECOND COUNT IN
;AC2 AND AC1 IN THE SAME 59 BIT FORMAT YOU GET WHEN YOU READ THE METER
;BOARD MICROSECOND CLOCK. THE MICROSECOND COUNT IS THEN RETURNED IN
;AC1 AND AC2 .....
;
; 	CALL SEQ:
;	GO	MONTIM		;CALL THE ROUTINE
;	RTN+1			;MICROSECOND TIME IN AC1 AND AC2

MONTIM:	PUT	3		;SAVE AC3 (RUNTM JSYS DESTROYS IT)
	SKIPE	MONTYP		;TOPS10 OR TOPS20 ?
	JRST	MTM20		;TOPS20
	MOVEI	1,0		;CLEAR AC (0=CURRENT JOB)
	RUNTIM	1,		;EXECUTE A RUNTIME UUO
	JRST	MTCOM		;GO TO COMMON CODE
MTM20:	MOVEI	1,.FHSLF	;GET PROCESS HANDLE
	RUNTM			;DOES A RUNTM JSYS
	  ERCAL	[RTN]		;ERROR NOT LIKELY
MTCOM:	SETZM	2		;CLEAR AC2
	MULI	1,^D1000	;CONVERTS MS TO US
	ASHC	1,^D12		;PUTS DATA IN PROPER MICROSECOND FORMAT
MTCX:	GET	3		;RESTORE AC3
	RTN			;AND EXIT


;RUNTME -- CALCULATE AND PRINT PROGRAM RUNTIME
;THIS REPORTS THE PROGRAM RUNTIME (EXEC OR USER MODE) SINCE
;THE LAST CALL TO THE INITIALIZE ROUTINE "STCLOK".
;
;THIS SOFTWARE CAN EASILY HANDLE RUNTIMES IN EXCESS OF 3000 HOURS
;
;THE RUNTIME IS PRINTED ON THE CURRENT LINE AND NO LINE FEED IS
;PRINTED AT THE END OF THE MESSAGE. THE MESSAGE LOOKS LIKE THIS:
;
;(SPACE)RUNTIME(HH:MM:SS) XX:XX:XX(SPACE,SPACE)
;
;IN EXEC MODE THE TIME IS CALCULATED BY USING THE MICROSECOND
;CLOCK THAT WAS INITIALIZED IN THE CALL TO "STCLOK". 
;
;IN USER MODE, "RUNTIME" MONITOR CALLS ARE USED AND THE DIFFERENCE
;IS CALCULATED FROM THE LAST CALL TO "STCLOK"
;
;CALL	SEQ:
;	GO	RUNTME		;CALL THE ROUTINE
;	RTN+1			;ALWAYS RETURNS +1

RUNTME:	PUT	0		;SACE AC'S
	PUT	1
	PUT	2
	SKIPE	USER		;IN USER MODE ??
	JRST	RNUSR		;YES.
	DATAI	20,TMRUN1	;EXEC MODE. GET DBLE WORD TIME
	JRST	RNTC1		;TO COMMON CODE
RNUSR:	GO	MONTIM		;GET TIME FROM MONITOR CALLS TO AC1 AND AC2
	DMOVEM	1,TMRUN1	;SAVE MICROSECOND COUNT IN DOUBLE WORD
RNTC1:	DMOVE	0,TMRUN1	;GET CURRENT RUN TIME
	DSUB	0,TMRST1	;CALCULATES ACTUAL RUN TIME
	ASHC	0,-^D12		;RIGHT JUSTIFY
	DIV	0,[^D1000000]	;CNVT US. TO SEC.
RNTCOM:	TEXT	[ASCIZ/ RUNTIME(HH:MM:SS) /]
	IDIVI	0,^D3600	;CNVT SECONDS TO HOURS
	CAIG	0,^D9		;SINGLE DIGIT ?
	TEXT	[ASCIZ/0/]	;YES. PAD WITH ZERO
	PNTDEC			;PRINT IN DECIMAL
	TEXT	[ASCIZ/:/]
	MOVE	0,1		;REMAINDER TO AC1
	IDIVI	0,^D60		;CONVERT REMAINDER TO MINUTES
	CAIG	0,^D9		;SINGLE DIGIT ?
	TEXT	[ASCIZ/0/]	;YES. PAD WITH ZERO
	PNTDEC			;PRINT IN DECIMAL
	TEXT	[ASCIZ/:/]
	MOVE	0,1		;GET REMAINDER WHICH IS IN SECONDS
	CAIG	0,^D9		;SINGLE DIGIT ?
	TEXT	[ASCIZ/0/]	;YES. PAD WITH ZERO
	PNTDEC			;PRINT IN DECIMAL
	TEXT	[ASCIZ/  /]	;2 SPACES
	GET	2		;RESTORE AC'S
	GET	1
	GET	0
	RTN			;AND EXIT

;RUNTMF -- CALCULATE AND FORCE PRINT PROGRAM RUNTIME
;THIS REPORTS THE PROGRAM RUNTIME (EXEC OR USER MODE) SINCE
;THE LAST CALL TO THE INITIALIZE ROUTINE "STCLOK".
;
;THIS SOFTWARE CAN EASILY HANDLE RUNTIMES IN EXCESS OF 3000 HOURS
;
;THE RUNTIME IS PRINTED ON THE CURRENT LINE AND NO LINE FEED IS
;PRINTED AT THE END OF THE MESSAGE. THE MESSAGE LOOKS LIKE THIS:
;
;(SPACE)RUNTIME(HH:MM:SS) XX:XX:XX(SPACE,SPACE)
;
;IN EXEC MODE THE TIME IS CALCULATED BY USING THE MICROSECOND
;CLOCK THAT WAS INITIALIZED IN THE CALL TO "STCLOK". 
;
;IN USER MODE, "RUNTIME" MONITOR CALLS ARE USED AND THE DIFFERENCE
;IS CALCULATED FROM THE LAST CALL TO "STCLOK"
;
;CALL	SEQ:
;	GO	RUNTMF		;CALL THE ROUTINE
;	RTN+1			;ALWAYS RETURNS +1

RUNTMF:	PUT	0		;SACE AC'S
	PUT	1
	PUT	2
	SKIPE	USER		;IN USER MODE ??
	JRST	.RNUSR		;YES.
	DATAI	20,TMRUN1	;EXEC MODE. GET DBLE WORD TIME
	JRST	.RNTC1		;TO COMMON CODE
.RNUSR:	GO	MONTIM		;GET TIME FROM MONITOR CALLS TO AC1 AND AC2
	DMOVEM	1,TMRUN1	;SAVE MICROSECOND COUNT IN DOUBLE WORD
.RNTC1:	DMOVE	0,TMRUN1	;GET CURRENT RUN TIME
	DSUB	0,TMRST1	;CALCULATES ACTUAL RUN TIME
	ASHC	0,-^D12		;RIGHT JUSTIFY
	DIV	0,[^D1000000]	;CNVT US. TO SEC.
	TEXTF	[ASCIZ/ RUNTIME(HH:MM:SS) /]
	IDIVI	0,^D3600	;CNVT SECONDS TO HOURS
	CAIG	0,^D9		;SINGLE DIGIT ?
	TEXTF	[ASCIZ/0/]	;YES. PAD WITH ZERO
	PNTDCF			;PRINT IN DECIMAL
	TEXTF	[ASCIZ/:/]
	MOVE	0,1		;REMAINDER TO AC1
	IDIVI	0,^D60		;CONVERT REMAINDER TO MINUTES
	CAIG	0,^D9		;SINGLE DIGIT ?
	TEXTF	[ASCIZ/0/]	;YES. PAD WITH ZERO
	PNTDCF			;PRINT IN DECIMAL
	TEXTF	[ASCIZ/:/]
	MOVE	0,1		;GET REMAINDER WHICH IS IN SECONDS
	CAIG	0,^D9		;SINGLE DIGIT ?
	TEXTF	[ASCIZ/0/]	;YES. PAD WITH ZERO
	PNTDCF			;PRINT IN DECIMAL
	TEXTF	[ASCIZ/  /]	;2 SPACES
	GET	2		;RESTORE AC'S
	GET	1
	GET	0
	RTN			;AND EXIT

TMRUN1:	BLOCK	2		;MICROSECOND RUNTIME SAVED HERE...

;DLYTMR -- ROUTINE TO WATE A SPECIFIED AMOUT OF TIME
;THIS ROUTINE IS USED TO PROVIDE PROGRAM DELAYS AS OPPOSED TO USING 
;INSTRUCTION LOOPS. THIS ROUTINE USES THE REAL TIME CLOCK IN EXEC
;MODE AND MONITOR CALLS IN USER MODE TO CALCULATE THE ELAPSED TIME.
;
;IN USER MODE IT IS MEASURING ELAPSED TIME BASED ON WALL CLOCK TIME.
;
;THE TIME YOU WISH TO DELAY IS SPECIFIED IN AC1 ON THE CALL. YOUR DELAY TIME
;MUST BE SPECIFIED IN MILLISECONDS AND ACCURATE IN EXEC MODE TO ABOUT 25-50
;MICROSECONDS. IN USER MODE THE ACCURACY IS QUITE DIFFERENT. THE TIME YOU
;DELAY IS ACTUALLY THE TIME YOU SPECIFY (ACCURATE TO ABOUT 2 MS) BUT MANY
;TIMES BECOMES EXTENDED DUE TO PERIOD WHEN YOUR JOB IS NOT RUNNING.
;
;WHAT WE END UP WITH HERE IS A ROUTINE THAT USES HARDWARE CLOCKS TO PROVIDE
;A DELAY WHICH IS "GUARANTEED" AS A MINIMUM DELAY.
;
;YOU MUST HAVE FIRST MADE A CALL TO THE ROUTINE "STCLOK" AT THE BEGINNING 
;OF YOUR PROGRAM TO INSURE THAT THE CLOCK GETS STARTED IN EXEC MODE.
;
;CALLING SEQ:
;	MOVE	1,ARG1		;DESIRED DELAY (IN MILLISECONDS)
;	GO	DLYTMR		;CALL THE ROUTINE
;	RTN			;RTN+1 ALWAYS

DLYTMR:	PUT	1		;SAVE SOME AC'S
	PUT	2
	TLZ	1,(1B0)		;MAKE SURE SIGN BIT IS ZERO
	MOVEM	1,DLYTIM	;SAVE DELAY TIME IN MILLISECONDS

;HERE WE GET CURRENT TIME FROM EITHER THE METER BOARD OR MONITOR, CONVERTED
;TO MICROSECONDS IN METER BOARD FORMAT AND SAVE IN DSTRT

	SKIPE	USER		;USER/EXEC MODE ?
	JRST	DLY1		;USER MODE
	DATAI	20,DSTRT	;READ METER BOARD VALUE (DOUBLE WORD)
	JRST	DLY2		;AND GO TO COMMON CODE
DLY1:	GO	.MONTM		;GET MICROSECOND TIME FROM MONITOR 
	DMOVEM	1,DSTRT		;SAVE DOUBLWORD (US. IN METER FORMAT)

;HERE WE READ THE TIME NOW AND SAVE IT TO SEE IF WE'VE WAITED LONG ENOUGH

DLY2:	SKIPE	USER		;USER/EXEC MODE ?
	JRST	DLY3		;USER MODE
	DATAI	20,DNOW		;READ METER BOARD VALUE (DOUBLE WORD)
	JRST	DLY4		;AND GO TO COMMON CODE
DLY3:	GO	.MONTM		;GET MICROSECOND TIME FROM MONITOR 
	DMOVEM	1,DNOW		;SAVE DOUBLWORD (US. IN METER FORMAT)

;HAVE INITIAL TIME IN DSTRT AND PRESENT TIME IN DNOW. CALCULATE DIFFERENCE
;AND SEE IF WE'VE WAITED LONG ENOUGH. IF NOT WE KEEP LOOKING.

DLY4:	DMOVE	1,DNOW		;GET CURRENT TIME (DOUBLE WORD)
	DSUB	1,DSTRT		;CALCULATES ELAPSED TIME (DOUBLE WORD)
	ASHC	1,-^D12		;RIGHT JUSTIFY THE DOUBLE WORD
	DIVI	1,^D1000	;CONVERT US TO MS
	TLZ	1,(1B0)		;MAKE SURE SIGN BIT IS ZERO
	CAMGE	1,DLYTIM	;HAVE DELAYED LONG ENOUGH ?
	JRST	DLY2		;NO. MARK MORE TIME.

DLYX:	GET	2
	GET	1
	RTN

;LOCAL STORAGE FOR DLYTMR

DLYTIM:	Z			;HOLDS USERS TIME IN MILLISECONDS
DSTRT:	BLOCK	2		;DOUBLE WORD IN METER BOARD FORMAT
DNOW:	BLOCK	2		;DOUBLE WORD IN METER BOARD FORMAT

;HERE IS A SUBROUTINE CALLED BY DLYTMR. IT READS
;THE CURRENT SYSTEM RUNTIME IN MILLISECONDS FROM THE MONITOR, CONVERTS
;THE TIME TO MICROSECONDS AND THEN POSITIONS THAT MICROSECOND COUNT IN
;AC2 AND AC1 IN THE SAME 59 BIT FORMAT YOU GET WHEN YOU READ THE METER
;BOARD MICROSECOND CLOCK. THE MICROSECOND COUNT IS THEN RETURNED IN
;AC1 AND AC2 .....
;
; 	CALL SEQ:
;	GO	.MONTM		;CALL THE ROUTINE
;	RTN+1			;MICROSECOND TIME IN AC1 AND AC2

.MONTM:	PUT	3		;SAVE AC3 (RUNTM JSYS DESTROYS IT)
	SKIPE	MONTYP		;TOPS10 OR TOPS20 ?
	JRST	.MTM20		;TOPS20
	MOVEI	1,0		;CLEAR AC (0=CURRENT JOB)
	MSTIME	1,		;EXECUTE A MSTIME UUO
	JRST	.MTCOM		;GO TO COMMON CODE
.MTM20:	MOVEI	1,.FHSLF	;GET PROCESS HANDLE
	TIME			;DOES A TIME JSYS
	  ERCAL	[RTN]		;ERROR NOT LIKELY
.MTCOM:	SETZM	2		;CLEAR AC2
	MULI	1,^D1000	;CONVERTS MS TO US
	ASHC	1,^D12		;PUTS DATA IN PROPER MICROSECOND FORMAT
.MTCX:	GET	3		;RESTORE AC3
	RTN			;AND EXIT

;APRSN -- ROUTINE TO GET SERIAL NUMBER OF THE CPU
;THIS ROUTINE RETURNS IN AC1, THE SERIAL NUMBER OF THE CPU/APR
;
;CALL SEQ:
;	GO	APRSN		;THE CALL
;	RTN-1			;+1 ALWAYS 

APRSN:	MOVE	1,APRID		;GET CURRENT VALUE OF THIS CELL
	SKIPE	1		;WE ALREADY HAVE SN IF THIS IS NON-0
	RTN			;RTN IF WE ALREADY HAVE IT
GS1:	SKIPE	USER		;USER/EXEC MODE ?
	JRST	GS2		;USER MODE ....
	BLKI	APR,1		;EXEC MODE
	JRST	GSSV		;GO SAVE VALUE
GS2:	SKIPN	MONTYP		;TOPS10/TOPS20 ?
	JRST	GS3		;TOPS10
	PUT	2		;SAVE AC2
	MOVE	1,[SIXBIT/APRID/] ;TABLE ENTRY THAT WE WANT
	SYSGT			;FETCH WITH A JSYS CALL
	 ERCAL	[RTN]		;ERROR RTN
	GET	2		;RESTORE AC2
	JRST	GSSV		;GO SAVE VALUE
GS3:	MOVE	1,[20,,11]	;ENTRY-20 IN TABLE-11
	GETTAB			;DOES A GETTAB
	 JFCL			;ERROR RTN
GSSV:	ANDI	1,7777		;SAVE THE SERIAL NUMBER
	MOVEM	1,APRID		;SAVE FOR SUCCESSIVE CALLS
	RTN

APRID:	Z

;.CLOSE -- SUBROUTINE TO CLOSE OPENED FILES
;THIS DOES NOTHIN IN EXEC MODE. IN USER MODE UNDER TOPS10 AND
;TOPS20 IT TAKES THE NECESSARY STEPS TO CLOSE THE OUTPUT FILE
;WHICH IS NECESSARY IF YOU'VE BEEN OUTPUTTING TO A DISK FILE
;AND WISH TO LEAVE THE PROGRAM ....
;
;	NOTE *** ONCE YOU DO A CLOSE FROM A CTRL-C INTERCEPT THE PNT
;	FILE GETS CLOSED CORRECTLY BUT IF YOU CONTINUE, THE SUBRTN
;	PKG CREATES A NEW PNT FILE AND YOU LOOSE THE OLD ONE ....
;
;CALL SEQ:
;	GO	.CLOSE		;THE CALL
;	RTN			;RTN+1 ALWAYS

.CLOSE:	SKIPN	USER		;SKIP IF WE'RE IN USER MODE
	RTN			;EXEC MODE
	DROPDV			;SUBRTN PKG UUO OR IT WON'T WORK CORRECTLY
	PUT	1		;SAVE AC
	SKIPN	MONTYP		;NON-0 MEANS TOPS20
	JRST	CLS10		;TOPS10 ...
	MOVEI	1,.FHSLF	;GET FORK HANDLE
	CLZFF			;CLOSE ALL FILES JSYS ..
	 ERCAL	[RTN]		;ERROR RETURN
	JRST	CLSX		;EXIT
CLS10:	070000,,000000		;CLOSE D,0 UUO ... CLOSES FILES
	JFCL
CLSX:	GET	1		;RESTORE AC
	RTN			;AND EXIT

;.RESET -- SUBROUTINE TO ISSUE A RESET JSYS/UUO
;IN EXEC MOD IT DOES NOTHING. IN USER MODE IT ISSUES THE APPROPRIATE
;RESET UUO OR RESET JSYS THAT MAY BE DESIREABLE AT THE START OR END
;OF A PROGRAM.
;
;CALL	SEQ:
;	GO	.RESET		;THE CALL
;	RTN1			;RTN+1 ALWAYS

.RESET:	SKIPN	USER		;USER MODE ?
	RTN			;EXEC MODE ...
	SKIPN	MONTYP		;NON-0 MEANS TOPS20
	JRST	RST10		;TOPS10
	RESET			;A RESET JSYS
	 ERCAL [RTN]		;ERROR RTN
	JRST	RSTX		;TO EXIT CODE
RST10:	047000,,000000		;RESET UUO, CALLI AC,0 ...
	 JFCL			;ERROR RTN
RSTX:	RTN			;EXIT

;EXIT -- SUBROUTINE TOEXIT JOB IN USER MODE
;IN EXEC MOD IT DOES NOTHING. IN USER MODE IT ISSUES THE APPROPRIATE
;EXIT UUO OR HALTF JSYS GETTING YOU BACK TO MONITOR LEVEL. THIS ALSO
;ALLOWS YOU TO CONTINUE WITH A CONTINUE COMMAND.
;
;CALL	SEQ:
;	GO	.EXIT		;THE CALL
;	RTN1			;RTN+1 ALWAYS

.EXIT:	SKIPN	USER		;USER MODE ?
	RTN			;EXEC MODE ...

	PUT	1		;SAVE AC1
	SKIPN	MONTYP		;NON-0 MEANS TOPS20
	JRST	EXT10		;TOPS10

	MOVEI	1,.FHSLF	;GET FORK HANDLE
	HALTF			;HALT... TO MONITOR LEVEL
	JFCL			;HERE ON A CONTINUE COMMAND
	JRST	EXTX		;TO EXIT CODE

EXT10:	047040,,000012		;EXIT 1,  UUO  (CALLI  12 F=1)
	JFCL			;HERE ON A CONTINUE COMMAND

EXTX:	GET	1		;RESTORE THE AC
	RTN			;EXIT

;.GTCOR - GETS CORE AND EXPANDS THE SIZE OF YOUR PROGRAM
;THIS UTILITY IS USED PRIMARILY TO EXPAND CORE IN USER MODE AND 
;CLEAR THE NEW CORE IT EXPANDS IN SO THE PAGES WILL HAVE BEEN 
;TOUCHED AND PAGE FAULTS WON'T OCCUR WHEN YOUR LOCKED IN CORE.
;THE ROUTINE IS USED ALSO IN EXEC MODE TO MERELY MANAGE YOUR
;POINTERS AND CLEAR CORE. EACH TIME THIS ROUTINE EXPANDS CORE
;IT REPORTS THE SIZE OF MEMORY BEING USED BY THE PROGRAM.
;
; .JBREL (RH) ALWAYS HIGHEST AVAILABLE ADDRESS AVAIL TO USER
;
;YOU MUST DEFINE A LOCATION "FRECOR" IN YOUR PROGRAM. FRECOR SHOULD
;BE INITIALIZED TO THE VALUE FROM .JBSA(RIGHT) WHICH RESETS IT TO
;THE FIRST LOCATION ABOVE THE PROGRAM. EACH CALL TO THIS ROUTINE THEN
;UPDATES "FRECOR" SO IT IS ALWAYS POINTING TO THE FIRST FREE CORE
;LOCATION NOT IN USE BY THE PROGRAM.
;
;CALL SEQ:
;	MOVE	1,ARG1		;# OF WORDS OF MEMORY YOU WANT
;	GO	.GTCOR		;THE CALL
;	RTN1			;+1 AC1 POINTS TO START OF BUFFER (CLEARED)

.GTCOR:	PUT	4		;SAVE AC'S
	PUT	3
	PUT	2

;SAVE CURRENT VALUE OF .JBREL FOR USE AT THE END OF THIS ROUTINE ..

	MOVE	2,.JBREL	;GET CURRENT VALUE
	MOVEM	2,.JRLSV#	;SAVE IN A LOCAL LOCATION

;CODE TO INITIALIZE FRECOR IF USER DIDN'T (OR WE WIPE HIS MEMORY)

	SKIPE	FRECOR		;IS FRECOR A VALID NUMBER ?
	JRST	.+3		;YES. NO NEED TO INIT
	HLRZ	2,.JBSA		;GET FIRST NON-PROGRAM LOCATION
	MOVEM	2,FRECOR	;NOW INITIALIZED PROPERLY

;GET LIMITS FOR NEW MEMORY SPACE

	MOVE	2,FRECOR	;THIS IS THE START
	MOVE	3,2		;A COPY TO AC3
	ADD	3,1		;AC1 NOW END ADDR+1
	SUBI	3,1		;AC1 NOW FINAL ADDR
	MOVE	4,3		;GET COPY TO AC4 FOR LATER USE

;CHECH USER/EXEC MODE AND MONITOR TYPES. IF NECESSARY DO A CORE UUO.

	SKIPN	USER		;USER/EXEC ?
	JRST	GTCOR1		;EXEC
	SKIPE	MONTYP		;TOPS10/TOPS20 ?
	JRST	GTCOR1		;TOPS20
	CAMG	3,.JBREL	;TOPS10. SEE IF WE NEED MORE CORE ?
	JRST	GTCOR1		;NO WE DON'T
	CORE	3,		;DO A CORE UUO ...
	 JRST    GTCORE		;ERROR RETURN

;SET UP NEW POINTERS AND CLEAR THE NEW CORE AREA

GTCOR1:	MOVE	1,FRECOR	;GET USERS POINTER TO START 
	AOS	4		;POINTING TO FREE CORE
	MOVEM	4,FRECOR	;SAVE IT IN POINTER
	MOVE	2,1		;START ADDR TO AN INDEX REG
	SETZM	0(2)		;CLEAR LOCATION
	AOS	2		;BUMP THE POINTER
	CAMGE	2,FRECOR	;SEE OF WE'RE DONE
	JRST	.-3		;NOT DONE

;IF EXEC MODE OR UNDER TOPS20, ADJUST .JBREL 

	SKIPN	USER		;USER/EXEC ?
	JRST	.+3		;EXEC MODE.... ADJUST.
	SKIPN	MONTYP		;USER MODE. TOPS10/10PS20 ?
	JRST	GTCRX		;TOPS10. NO NEED TO ADJUST
	MOVE	3,FRECOR	;EXEC MODE OR UNDER TOPS20 IF HERE
	CAMG	3,.JBREL	;UPDATE .JBREL ONLY IF FRECOR LARGER
	JRST	GTCRX		; NO NEED TO UPDATE ...
	SUBI	3,1		;POINT TO LAST LOCATION USED BY PROG
	IORI	3,777		;ROUND TO LAST LOCATION ON THAT PAGE
	MOVEM	3,.JBREL	;NOW HAVE CORE LIMIT CORRECTLY...

;EXIT CODE.. BEFORE WE EXIT, SEE IF .JBREL HAS CHANGED, IF SO, REPORT..

GTCRX:	MOVE	2,.JBREL	;GET CURRENT VALUE OF .JBREL
	CAME	2,.JRLSV	;IS IT THE SAME AS THE INITIAL VALUE ?
	GO	CORSIZ		;NOPE ... PRINT NEW SIZE OF MEMORY
	GET	2		;DONE. RESTORE AC'S
	GET	3
	GET	4
	RTN			;EXIT

;THE ERROR HANDLER FOR CORE UUO

GTCORE:	TEXTF 	[ASCIZ/
CORE UUO FAILURE. SET CORMIN=0 AND CORMAX=0 AND RESTART PROGRAM.

/]

	GO	.RESET		;ISSUE A RESET
	EXIT			;STOP THE JOB
	JRST	.-1

;CORSIZ -- ROUTINE TO REPORT THE CURRENT (USER MODE) CORE USEAGE
;PRINTS MEMORY USEAGE IN BOTH OCTAL AND DECIMAL (K AND PAGES)
;WITH THE FOLLOWING TYPICAL MESSAGE:
;
;PROGRAM USING  100(64.)K  200(128.)PAGES
;
;THE CALCULATIONS ARE ALL MADE FROM .JBREL
;
;#K = [.JBREL+1.] / 1024. (+1 IF THERE IS A REMAINDER)
;#PAGES = [.JBREL+1.] / 512.
;
;CALL SEQ:
;	GO	CORSIZ		;THE CALL
;	RTN			;+1 ALWAYS

CORSIZ:	SKIPN	USER		;USER MODE ?
	RTN			;NO. DON'T PRINT

	PUT	0		;SAVE AC'S
	PUT	1
	TEXT	[ASCIZ/PROGRAM USING  /]
	MOVE	0,.JBREL	;GET .JBREL
	ADDI	0,1		;A ROUNDING FACTOR
	IDIVI	0,^D1024	;CONVERT TO "K"
	SKIPE	1		;IS THERE A REMAINDER ?
	AOS	0		;YES .... ROUND UP
	GO	POCDEC		;PRINT OCTAL AND DECIMAL
	TEXT	[ASCIZ/K  /]
	MOVE	0,.JBREL	;GET .JBREL
	ADDI	0,1		;ROUNDING FACTOR
	IDIVI	0,^D512		;GETS NUMBER OF PAGES
	GO	POCDEC		;PRINT OCTAL AND DECIMAL
	TEXT	[ASCIZ/PAGES
/]
	GET	1		;RESTORE AC'S
	GET	0
	RTN			;EXIT


;GENRAN -- RANDOM PARAMETER GENERATOR
;THIS ROUTINE GENERATES A RANDOM NUMBER (POSITIVE) AND LESS THAN 
;THE NUMBER SPECIFIED IN AC0 WHEN THE ROUTINE IS CALLED.
;AC0 MAY BE 0 THRU <2**35 - 1>
;
;THE ROUTINE NEEDS TO BE INITIALIZED AT THE START OF YOUR PROGRAM BY 
;CALLING 'RNSEED'. THIS ESTABLISHES A SEED FOR THE RANDOM NUMBER GENERATOR
;TO BASE ITS CALCULATIONS ON. IF YOU FAIL TO INITIALIZE, THE ROUTINE
;WILL STILL FUNCTION BUT STARTS WITH A SEED=0
;
;	CALLING SEQUENCE:
;	MOVE	0, ARG0	;ARG0 IS THE MAXIMUM PARAMETER DESIRED
;	GO	GENRAN
;	RTN			;RETURNS HERE


GENRAN:	PUT	1		;SAVE AC1
	PUT	2		;SAVE THE AC
	MOVE	1,.SEED		;GET THE CURRENT SEED ...
	MUL	1, RCOEFF	;MULTIPLY CURRENT # BY COEFFICIENT
	MOVE	1, 2		;KEEP JUST LOW ORDER WORD
	
;WE'RE DOING OUR CALCULATIONS MOD 400000,,0 SO SEE IF
;THE NEXT STEP WILL OVERFLOW

	CAMG	1, RNDTST	;WILL WE OVERFLOW ?
	JRST	.+3		;NO
	SUB	1, [200000,,0]	;YES, SO SUBTRACT 2*(2**34)
	SUB	1, [200000,,0]

;NOW WE CAN ADD OUR CONSTANT TO AC1 WITHOUT FEAR OF OVERFLOW

	ADD	1, RCONST	;CALCULATE THE NEW RANDOM NUMBER
	MOVEM	1,.SEED		;SAVE AS SEED FOR NEXT CALCULATION

;NOW ADJUST THE RANDOM NUMBER ACCORDING TO THE LIMIT PASSED IN AC0

	CAML	1, RNDMAX	;TEST FOR BOUNDARY CONDITION
	SOS	1
	AOS	0		;BUMP THE MAX DESIRED PARAMETER
	MUL	1, 0		;MULTIPLY RANDOM # BY MAX+1
	DIV	1, RNDMAX	;AND THEN DIVIDE BY LARGEST POSSIBLE RANDOM #

	MOVE	0, 1		;RETURN THE RESULT IN AC0
	GET	1		;RESTORE AC'S
	GET	2		;RESTORE AC2
	RTN

RCOEFF:	144417,,665215
RCONST:	 66062,,613515
RNDMAX:	377777,,777777		;RNDMAX = 2**35 - 1
RNDTST:	311715,,164262		;RNDTST = RNDMAX - RCONST
.SEED:	Z			;THE RANDOM NUMBER SEED WILL BE HERE


;ROUTINE TO GENERATE A SEED FOR THE RANDOM NUMBER GENERATOR
;EACH TIME THIS ROUTINE IS CALLED, IT GENERATES A NEW SEED FOR THE
;RANDOM NUMBER GENERATOR 'GENRAN'
;
;IN EXEC MODE IT DERIVES THIS SEED BY READING THE HIGH PRECISION CLOCK
;SO YOU OUGHT TO HAVE THE CLOCK RUNNING (A CALL TO 'STCLOK' DOES IT)
;
;IN USER MODE UNDER TOPS10 IT GETS THE SEED BY READING THE CLOCK
;WITH A MSTIME UUO.
;
;IN USER MODE UNDER TOPS20 IT GETS THE SEED BY READING THE DAY AND TIME
;WITH A DAY AND TIME JSYS (GTAD).
;
;CALLING SEQUENCE:
;	GO	RNSEED		;THE CALL
;	RTN			;THE RETURN

RNSEED:	PUT	0		;SAVE AC'S
	PUT	1
	SKIPN	USER		;USER MODE ?
	JRST	RNSDA		;NO
	SKIPN	MONTYP		;TOPS20 ?
	JRST	RNSDB		;NO

;TOPS20 USER MODE

	GTAD			;TOPS20 - DAY AND TIME TO AC1
	JRST	RNSCOM		;TO COMMON CODE

;EXEC MODE

RNSDA:	DATAI	20, 0		;EXEC - SYSTEM TIMER TO AC0,AC1
	JRST	RNSCOM		;TO COMMON CODE

;TOPS10 USER MODE

RNSDB:	MSTIME	1,		;TOPS10 - TIME TO AC1

;COMMON CODE

RNSCOM:	TLZ	1,(1B0)		;CLEAR THE SIGN BIT
	MOVEM	1,.SEED		;SAVE THE SEED
	GET	1		;RESTORE AC'S
	GET	0
	RTN

; - GET MONITOR VERSION NUMBER
;	GO	MONTRV
;	RTN+1
;AC1 WILL HAVE THE MONITOR VERSION NUMBER IN THE RIGHT HALF
;RIGHT JUSTIFIED. 
; * CAUTION * THIS ROUTINE DESTROYS AC1


MONTRV:	SKIPN	USER		;MUST BE IN USER MODE
	RTN			;NOPE
	PUT	0
	PUT	2
	PUT	3
	SKIPE	MONTYP		;TOPS10?
	JRST	TOP20A		;NO, TOPS20
	MOVE	1,[34,,11]	;GET MONITOR VERSION NUMBER
	GETTAB	1,		;GO DO IT
	  ERCAL	[RTN]		;ERROR NOT LIKELY
	LSH	1,-6		;EXAMPLE - 70100 => 701
	JRST	MONTEX		;EXIT


TOP20A:	MOVEI	1,.FHSLF	;PROCESS HANDLE
	RPCAP			;READ CAPABILITIES
	 ERCAL	[RTN]		;IGNORE ERRORS
	MOVE	3,2		;GET CAPABILITIES TO AC3
	EPCAP			;NOW ENABLE
	 ERCAL	[RTN]		;IGNORE ERRORS
	MOVE	1,[1,,137]	;GET MONITOR VERSION
	MOVEI	2,1		; IN AC1
	PEEK			;DO IT
	 ERCAL	[PEEKF]
	MOVS	1,1		;SWAP HALVES
	LSH	1,-6		;RIGHT JUSTIFY
	TDZ	1,[-10]		; JUST THE VERSION NUMBER
MONTEX:	GET	0
	GET	2
	GET	3
	RTN

PEEKF:	TEXT	[ASCIZ/
NEED PRIVILEDGES TO GET MONITOR VERSION NUMBER
/]
	HALTF			;HALT
	JRST	START		;IF A CONTINUE


	END			;END OF FILE