<div id='wikitext'>
<pre><b> File: MULTI8.RA of Tape: Sources/Fortran/os8-f4-3</b></pre>
<pre><b>(Source file text) </b></pre>
<hr />
<pre>
/GENERAL MULTI8 BACKGROUND FUNCTIONS
/
/
/ VERSION 40A 29-MAY-80 WVDM
/
/
/THE FOLLOWING IS A SET OF 8 MODE (RALF TYPE)
/ROUTINES THAT ENABLE MULTI8 BACKGROUND FUNCTIONS
/THESE ROUTINES ARE CALLABLE AT THE FORTRAN LEVEL
/
/  CALL MULTI8(OPTION,VALUE1,VALUE2)
/
/THE FOLLOWING OPTIONS ARE SUPPORTED:
/
/	0  READ TIME OF DAY (HOURS,MINUTES)
/	1  MACHINE (BACKGROUND, TERMINAL)
/	2  DISABLE KEYBOARD ECHO (NO VALUES)
/	3  ENABLE KEYBOARD ECHO (NO VALUES)
/	4  NOT IMPLEMENTED
/	5  NOT IMPLEMENTED
/	6  SLEEP (NUMBER OF SECONDS,...)
/	7  MULTI8 LOGICAL (LOGICAL,...)
/	8  CPU TIME (VALUE [.1SECS],...)
/	9  NOT IMPLEMENTED
/	10 MULTI8 VERSION (VERSION CHAR,EDIT #)
/	11 RELEASE !ALL! DEVICES (NO VALUES)
/
	SECT8 MULTI8
	BSW=7002
	MQA=7501
/
	BASE	0
	STARTD
	SETX	XR0
	FLDA%	0,1	/GET PTR TO FUNCTION ARG
	FSTA	3
	STARTF
	FLDA%	3	/USER ARG TO FAC
	JLT	ERROR	/NEGATIVE FUNCTION ?
	ATX	0	/INTEGER AND PASS TO 8 CODE
	XTA	0	/FP INTERPRETER
	FSUB	MXFUN	/TOO BIG ?
	JGT	ERROR	/YES, FATAL
	STARTD
	FLDA%	0,2	/GET FIRST EXTRA ARG
	FSTA	3	/LEAVE 3 POINTING AT ARG FOR END
	STARTF
	FLDA%	3	/FIRST EXTRA ARG TO XR4
	ATX	4
	XTA	0	/GET BACK FUNCTION
	ALN	7	/*2
	STARTD
	FADD	JATAB	/ADD BASE OF DISPATCH TABLE
	FSTA	DISPA
	STARTF
DISPA,	JA	.
M8TBL,	JA	TIME	/0:
JATAB,	JA	M8TBL	/1: BG&amp;TERM SAME FORMAT AS TIME
	JA	NOECH	/2:
	JA	NOECH	/3: ECHOON SAME FORMAT AS NOECHO
	JA	ERROR	/4:
	JA	ERROR	/5:
	JA	TIME	/6: SLEEP SAME AS TIME
	JA	M8TES	/7:
	JA	MACCR	/8:
	JA	ERROR	/9:
	JA	TIME	/10:VERSION SAME FORMAT AS TIME
	JA	NOECH	/11:RELEASE SAME AS NOECH
MXFUN,	F 11.0
	EXTERN	#ARGER
ERROR,	TRAP4	#ARGER
/
NOECH,	TRAP4	GIOT
	JA	GOBAK	/NO ARGS
/
M8TES,	TRAP4	M8T8
	JA	CONT
/
MACCR,	TRAP4	GIOT
			/MQ IS IN LOW-ORDER XR6
	XTA	0
	ATX	5	/AC TO HIGH-ORDER XR5
	LDX	27,4	/27 TO EXP XR4
	FLDA	XR4	/NOW GET FP NUMBER
	FNORM
	JA	CONT2	/GIVE BACK VALUE
/
TIME,	TRAP4	GIOT
/	...
CONT,	XTA	4	/ANSWER IS IN XR4,XR5
CONT2,	FSTA%	3	/GIVE ANS TO CALLER (3 STILL SET!)
	STARTD
	FLDA%	0,3	/THIRD ARGUMENT
	FSTA	3
	STARTF
	XTA	5
	FSTA%	3	/GIVE BACK THIRD ARG OR RUBBISH
GOBAK,	FLDA	30	/RTN TO CALLER
	JAC
M8T8,	0
	CLA IAC
	6254		/SKIP ON MULTI8
	 CLA
	DCA	XR4	/SET LEFT BYTE
	DCA	XR5	/CLEAR RIGHT BYTE
	CIF CDF 0
	JMP%	M8T8
/
GIOT,	0
	TAD	XR4	/GET ARG TO GIOT
	DCA	GARG
	TAD	XR0
	6770
	JMP 	.+2
GARG,	HLT
	DCA	XR0	/NOW XR0 = GIOT AC
	TAD	XR0
	AND	M77
	DCA	XR5	/RIGHT BYTE
	TAD	XR0
	BSW
	AND	M77
	DCA	XR4	/LEFT BYTE
	MQA
	DCA	XR6	/MQ CONTENTS
	CIF CDF 0
	JMP%	GIOT
M77,	77
/
XR0,	0		/GETS FUNCTION ON INPUT, GIOT AC ON OUTPUT
XR1,	1		/FOR ARG1
XR2,	2		/FOR ARG2
XR3,	3		/FOR ARG3
XR4,	0		/GETS LEFT BYTE		ALSO: FP EXP
XR5,	0		/GETS RIGHT BYTE	      FP HI
XR6,	0		/GETS GIOT MQ		      FP LO
XR7,	26		/FOR MULTIPLYING INTEGER
	END
</pre>
<hr/>
</div>