Enter your search terms Submit search form
	Web pdp-10.trailing-edge.com

COMMENT * SIMULA specification;
OPTIONS(/E:CODE,today);
TEXT PROCEDURE today;
COMMENT Returns a text object of length 10 with contents according to 
yyyy-mm-dd, where yyyy is year, mm is month (1-12), dd is day (1-31).
;

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

	TITLE	today
	ENTRY	today
	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 ;!

	result==ZBI%S
	DF decade,2(XWAC1),2*7,2*7-1
	DF year,2(XWAC1),2*7,4*7-1
	DF ym,2(XWAC1),1*7,5*7-1
	DF month,3(XWAC1),2*7,2*7-1
	DF md,3(XWAC1),1*7,3*7-1
	DF day,3(XWAC1),2*7,5*7-1
	DEFINE putdec(f)<
	EXEC	.putdec
	SF	,f
	>
.putdec:IDIVI	^D10
	LI	XIAC,"0"(X1)
	IDIVI	^D10
	LI	"0"(X1)
	LSH	7
	ADDI	(XIAC)
	RETURN


today:	PROC
	LI	XWAC1,^D10
	EXEC	TXBL		;! Blanks(10)
	XWD	0,0
	STD	XWAC1,result(XCB)
	DATE	XWAC3,
	IDIVI	XWAC3,^D31
	LI	1(XWAC4)
	putdec	day
	IDIVI	XWAC3,^D12
	LI	1(XWAC4)
	putdec	month
	LI	^D19
	IF	;! No longer 20th century
		CAIGE	XWAC3,^d2000-^d1964
		GOTO	FALSE
	THEN	LI	^d20	;! Don't expect it to last!
		SUBI	XWAC3,^D2000-^D1964
	FI
	putdec	decade
	LI	(XWAC3)
	ADDI	^D64
	putdec	year
	LI	"-"
	SF	,ym
	SF	,md
	BRANCH	CSEP
	EPROC
	LIT
	END;