Google
 

Trailing-Edge - PDP-10 Archives - decuslib10-05 - 43,50337/23/sleep.mac
There are 5 other files named sleep.mac in the archive. Click here to see a list.
COMMENT * SIMULA specification;
OPTIONS(/E:QUICK,sleep);
PROCEDURE sleep(t); REAL t;
COMMENT Causes the job to sleep (hibernate) for at least t seconds elapsed
time (real time).

;

!*;! MACRO-10 code !*;!

	TITLE	sleep
	ENTRY	sleep
	SUBTTL	SIMULA utility, Lars Enderin Dec 1975

;! Copyright 1975 by the Swedish Defence Research Institute.
;! Copying is allowed.

	sall
	search	simmac,simmcr,simrpa
	macinit

	;! Local definitions ;!

	t==XWAC1

sleep:	PROC
	IFN QDEC20,<;![225]
	L	X1,T
	OPDEF	DISMS	[104000,,167]
	IF	;!NON-ZERO
		JUMPE	X1,FALSE
	THEN
		FMPRI	X1,(1.0E3)
		FIXR	X1,X1		;! Convert to integer
			IF	;! Too small
			JUMPG	X1,FALSE
		THEN	;! Make it 1 ms
			LI	X1,1
	FI	FI
	DISMS
	RETURN
	>
	IFE QDEC20,<;![225]
	SKIPGE	t
	SETZ	t,	;! Neg or zero - indefinite sleep
	MSTIME	XIAC,	;! Current time of day in msecs
	IF	;! Too long period
		CAMG	t,[6.7E1]
		GOTO	FALSE
	THEN	;! Call DAEMON first
		FIXR	X1,t
		LI	X0,2	;! CLOCK function
		LI	X2,X0
		DAEMON	X2,
		RFAIL	DAEMON failure
		L	X2,X1	;! Remember ms interval
		IMULI	X2,^D1000
		SETZ	X1,	;! DAEMON will wake the job
	ELSE	;! Use HIBER directly
		L	X1,t
		IF	;! Non-zero
			JUMPE	X1,FALSE
		THEN
			FMPRI	X1,(1.0E3)	;! millisecs
			FIXR	X1,X1
			IF	JUMPG	X1,FALSE
			THEN	LI	X1,1
		FI	FI
		HRLI	X1,0		;! Wake up on any signal????
		L	X2,X1		;! Remember ms interval
	FI
	HIBER	X1,
	RTSERR	QDSCON,214
	MSTIME	X1,
	SUB	X1,XIAC	;! Elapsed time
	SUB	X1,X2
	IF	;! The time is not yet up
		JUMPGE	X1,FALSE
	THEN	;! Go back to sleep
		FLTR	X1,X1
		FMPR	X1,[1.0E-3]
		FSBR	t,X1
		GOTO	sleep
	FI
	RETURN
;!Enable codes
HB.RWJ=1B15	;!Only this job can wake itself up
HB.RWP=1B16	;!Programmer code must match
HB.RWT=1B17	;!Project code must match
HB.RTC=1B14	;!Wake on character ready
HB.RTL=1B13	;!Wake up on line of input ready
HB.RPT=1B12	;!Wake on PTY activity since last HIBERNATE (batch)
HB.SWP=1B0	;!Swap out job immediately
HB.IPC=1B10	;!IPCF
>
	EPROC
	LIT
	END;