.MCALL	.MODULE
.MODULE	IDCOMP,VERSION=02,COMMENT=<SYSLIB/IDCOMP>,IDENT=NO,LIB=YES

; Copyright (c) 1998 by Mentec, Inc., Nashua, NH.
; All rights reserved
;
; This software is furnished under a license for use only on a
; single computer system and  may  be  copied  only  with  the
; inclusion of the above copyright notice.  This software,  or
; any other copies thereof, may not be provided  or  otherwise
; made available to any other person except for  use  on  such
; system and to one who agrees to these license  terms.  Title
; to  and  ownership of the software shall at all times remain
; in Mentec, Inc.
;
; The information in this document is subject to change without
; notice and should not be construed as a commitment by Digital
; Equipment Corporation, or Mentec, Inc.
;
; Digital and Mentec  assume  no  responsibility for the use or
; reliability of its software on equipment which is not supplied
; by Digital  or Mentec,  and listed  in the  Software  Product
; Description.
; FORTRAN-callable SYSLIB function 
;
; MODULE:
;
;	IDCOMP
;
; FUNCTIONAL DESCRIPTION:
;
;	IDCOMP compares two RT-11 date words.  It returns a code that 
;	indicates whether the first date is before, equal to, or after
;	the second date.
;
; CALLING SEQUENCE:
;
;	I = IDCOMP( DATE1 [, DATE2])
;
; PASSED ARGUMENTS:
;
;	DATE1 and DATE2 are RT-11 date words.  If DATE2 is not supplied,
;	then the current system date is substituted for DATE2.
;
; RETURNED ARGUMENT VALUES:
;
;	<none>
;
; RETURNED FUNCTION VALUE:
;
;	I = -1	Indicates DATE1 is BEFORE DATE2
;	I = 0		  DATE1 and DATE2 are the same
;	I = 1		  DATE1 is AFTER DATE2
;	I = -257.	  Invalid or missing arguments
;
; EXTERNAL REFERENCES:

	.GLOBL	$SYSLB
	.GLOBL	$ARGER
	.GLOBL	$NXVAL

; METHOD:
;
;  IDCOMP performs comparisons in the following order:
;
;	Compare AGE and YEAR bits in both dates
;	If not equal, go to step 2
;	Compare all bits in both dates
;	If equal, return (0)
;Step2:
;	If higher, return (+1)
;	Else return (-1)
.SBTTL	Macro References

	.MCALL	.DATE, .GTIM

.SBTTL	Definitions and Equates

DA.AGE	=:	140000			; "Age" bit mask
DA.YR	=:	000037			; Year bit mask
DA.MON	=:	036000			; Month bit mask
DA.DAY	=:	001740			; Day bit mask

.SBTTL	IDCOMP	Date Comparison Code

	.PSECT	SYS$I,I
	.ENABL	LSB

IDCOMP::MOV	(R5)+,R4		; get arg count
	CALL	$NXVAL			; must have at least one arg
	BCS	ERROR			; otherwise, we trap out.
	MOV	R0,R1			; save 1st arg
	CALL	$NXVAL			; try for second arg
	BCC	10$			; if none, 
	CMP	-(SP),-(SP)		; allocate space for GTIM
	.GTIM	SP,SP			; ensure date roll-over
	CMP	(SP)+,(SP)+		; reclaim stack space
	.DATE				; get today's date

10$:	MOV	R0,R2			; store date word 2
	CLR	R0			; assume match
	MOV	R1,R3			; copy first date
	MOV	R2,R4			; copy second date
	BIC	#^c<DA.AGE!DA.YR>,R3	; clear all but age and year
	BIC	#^c<DA.AGE!DA.YR>,R4	; clear all but age and year
	CMP	R3,R4			; compare age and year
	BNE	20$			; unequal
	CMP	R1,R2			; compare month and day
					;    (age and year match)
	BEQ	EQUAL			; all equal
20$:
	BHI	AFTER

BEFORE:	DEC	R0			; "before" return
EQUAL:					; "equal" return
	RETURN

AFTER:	INC	R0			; "after" return
	RETURN

ERROR:	MOV	#$ARGER,R0		; error return
	RETURN

	.DSABL	LSB

	.END