UNIVERSAL DCAM -  Macros to handle double integer comparisons
	SUBTTL Copyright (C) 2012, 2018 by Thomas DeBellis, All Rights Reserved

	LALL ;;Expanded Macro Listing

	COMMENT "Use of quotes in COMMENT is for gnuEmacs highlighting"

; The following MACROs are useful when dealing with signed double word
; integers.  They are NOT skipable and have no immediate modes.  Thus,
; their use would be well coupled with MACSYM's block structured
; macros.
;
; Assuming the following storage declarations:
;
; FOO:  BLOCK 1
; BAR:	ASCII "BOGUS"
; DFOO: BLOCK 2
; DBAR: BLOCK 2
;
; Then the following are incorrect and correct usage examples:
;
; DCAME X,FOO			;Wrong
; DCAME X,DFOO			;Right
;
; DCAME X,[XWD 1,2]		;Wrong
; DCAME X,[EXP 1,2]		;Right
;
; DCAML X,DFOO			;Wrong
;  DCAME Y,DBAR
;   JRST WRONG
;
; DCAML X,DFOO			;Right
; IFSKP.
;   DCAME Y,DBAR
;    JRST RIGHT
; ENDIF.

	SUBTTL Further DCAM Macro Usage Cautions

; Be aware that these macros are tailored for double INTEGER
; arithmatic and *** NOT *** double floating point!  They were
; developed to aid handling unsigned 36 bit integers (which, by
; definition are always positive) by performing the math on 72 bit
; signed doubles.
;
; One basic difference between these two formats is that while
; integers are (effectively) RIGHT justified in a double word,
; floating point numbers are LEFT justified.
;
; Note that the hardware may not appear consistent with the setting
; of bit 0 in the low order word when storing a negative number.
; In particular, consider the following two operations on a register
; pair of:
;
;    T1:T2/ EXP 0,0
;    T3:T4/ EXP 0,1
;
;  (1)	DMOVN T1,T3 produces a result in T1:T2 with bit 0 (1B0) set in
;	the high order word (T1) but *** NOT ***  set in the low order
;	word (T2), giving -1:.INFIN in the register pair,
;
;  (2)	DSUB T1,T3 *** SETS *** bit 0 in BOTH words, yielding -1:-1.
;
; This is because DMOVN uses the double floating point format while
; DSUB is using the signed double integer format.
;
; Thus, to load the negative of a double integer in register pair
; T1:T2, do NOT use a DMOVN, but rather a SETZB T1,T2, DSUB T1,DFOO
; sequence.

	SUBTTL "Final IMPORTANT usage Caution!"

	COMMENT "		; Make OUTSTANDING in gneEmacs

        REMARK Be aware that DCAM macros do NOT work right with an index!

; ****	This works:

	DMOVE	S1,.JWAKE(R)	   ; Load signed double wake time
	DCAMLE  S1,[EXP 0,.INFIN]  ; Is the monitor going to silently clamp?


; ****	This does not:

	DMOVE	S1,[EXP 0,.INFIN]   ; Load maximum valid TIMER% UTC
	DCAMLE  S1,.JWAKE(R)	    ; Is the monitor going to silently clamp?

	REMARK It produces Q errors
"
	SUBTTL .FATAL Macro

; Fatal assembly error macro.  It would be REALLY nice if MACRO had
; something like an .ERROR statement.  Like ... MASM ...  (GASP!)

IFNDEF .FATAL,<
DEFINE .FATAL (MESSAGE) <
 PASS2
 PRINTX ?'MESSAGE
 END
>;;DEFINE .FATAL
>;;IFNDEF

	SUBTTL Argument checking macros

; For address checking, calculate the value and see if doing the same
; register.

; Used for double compares

DEFINE CMPCHK (R,A) <			;;Register and Address Check

IFB <'R>,<.FATAL No register specified to compare with>
IFB <'A>,<.FATAL Not comparing to anything!>
IFG <'R-^O16>,<.FATAL Register 'R is out of bounds>
>;;CMPCHK

; Used for double jumps

DEFINE JMPCHK (R,A) <			;;Register and Address Check
IFB <'R>,<.FATAL No register specified to test>
IFB <'A>,<.FATAL No place to jump to!>
IFG <'R-^O16>,<.FATAL Register 'R is out of bounds>
>;;JMPCHK

; Used for Casting, note that these macros have special cases for
; values that are already in registers called 'mis-casting'.

DEFINE CASCHK (R,A) <			;;Register and Address Check
IFB <'R>,.FATAL No register specified to cast
IFG <'R-^O16>,.FATAL Register 'R is out of bounds
>;;CASCHK

	SUBTTL "Double Signed INTEGER Compare"

; Again, be aware that these macros are for double signed INTEGERS!
;
; For example, it is not necessary to test the low order word of a
; properly normalized floating point number for zero or non-zero; the
; significant bits have already been left justified to the exponent.
;
; The double compare macros will work however with properly formated 
; double floating point numbers.  The reason for this is that
; comparing equality and inequality does not need to check signs.
; Magnitude compares are discussed, below

DEFINE DCAME (R,A,%N) <		;;Double compare and skip if equal

	CMPCHK(R,A)		;;Anything Bogus?

	CAME <'R>,<'A>		;;Compare high order
	 JRST %N		;; Not equal, don't skip
	CAME <'R+1>,<'A+1>	;;Compare low order
%N:!				;; Non-skip return
	.XCREF %N		;;Useless in CREF
>;;DCAME


DEFINE DCAMN (R,A,%N,%S) <	;;Double compare and skip if NOT equal

	CMPCHK(R,A)		;;Anything Bogus?

	CAME <'R>,<'A>		;;Compare high order
	 JRST %S		;; Not equal--skip
	CAMN <'R+1>,<'A+1>	;;Compare low order
%N:!				;; Non-skip return
%S==%N+1			;;  Skip return
	.XCREF %N,%S		;;Useless in CREF
	IF2,<PURGE %N>		;;After calculated %S, %N is never used!
>;;DCAMN


; Magnitude compares are written with the following algorythm.  First
; the high order words are compared for equality.  If they are equal,
; then the low orders are compared.  Otherwise, the high order
; comparison is (re)done with the understanding that they are NOT
; equal.
;
; The basic approach thus also works for double floating point numbers.

DEFINE DCAML (R,A,%N,%S,%L) <	;;Double compare and skip if less

	CMPCHK(R,A)		;;Anything Bogus?

	CAMN <'R>,<'A>		;;Compare high order
	 JRST %L		;; Equal, check low order
	CAML <'R>,<'A>		;;Compare high order, skip if less
	 JRST %N		;; Not less, non-skip
	  JRST %S		;;  Less, skip
%L:!	CAML <'R+1>,<'A+1>	;;Compare low order
%N:!				;; Not less, Non-skip return
%S==%N+1			;;  Less, Skip return
	.XCREF %L,%N,%S		;;Useless in CREF
>;;DCAML


DEFINE DCAMLE (R,A,%N,%S,%L) <	;;Double compare and skip if less or equal

	CMPCHK(R,A)		;;Anything Bogus?

	CAMN <'R>,<'A>		;;Compare high order
	 JRST %L		;; Equal, check low order
	CAML <'R>,<'A>		;;Compare high order, skip if less
	 JRST %N		;; Not less, non-skip
	  JRST %S		;;  Less, skip
%L:!	CAMLE <'R+1>,<'A+1>	;;Compare low order
%N:!				;; Not less, Non-skip return
%S==%N+1			;;  Less or equal, Skip return
	.XCREF %L,%N,%S		;;Useless in CREF
>;;DCAMLE


DEFINE DCAMG (R,A,%N,%S,%L) <	;;Double compare and skip if greater

	CMPCHK(R,A)		;;Anything Bogus?

	CAMN <'R>,<'A>		;;Compare high order
	 JRST %L		;; Equal, check low order
	CAMG <'R>,<'A>		;;Compare high order, skip if greater
	 JRST %N		;; Not greater, non-skip
	  JRST %S		;;  Greater, skip
%L:!	CAMG <'R+1>,<'A+1>	;;Compare low order, skip if greater
%N:!				;; Not greater, Non-skip return
%S==%N+1			;;  Greater, Skip return
	.XCREF %L,%N,%S		;;Useless in CREF
>;;DCAMG


DEFINE DCAMGE (R,A,%N,%S,%L) <	;;Double compare and skip if greater or equal

	CMPCHK(R,A)		;;Anything Bogus?

	CAMN <'R>,<'A>		;;Compare high order
	 JRST %L		;; Equal, check low order
	CAMG <'R>,<'A>		;;Compare high order, skip if greater
	 JRST %N		;; Not greater, non-skip
	  JRST %S		;;  Greater, skip
%L:!	CAMGE <'R+1>,<'A+1>	;;Compare low order, skip if greater
%N:!				;; Not greater, Non-skip return
%S==%N+1			;;  Greater or equal, Skip return
	.XCREF %L,%N,%S		;;Useless in CREF
>;;DCAMGE

	SUBTTL "Double Signed Jump Macros"

; Again, be aware that these macros are for signed double INTEGERS
; and that the double jump macros do *** NOT *** always do the right
; thing for double floating point numbers and--even when they DO
; work--they do *** NOT *** usually produce optimal code.
;
; Note the occasional use of the immediate mode compare instruction.
; This is because such skips are measured to be very slightly faster
; than a conditional jump in certain rare cases on certain engines.
; It could also produce better cache characteristics.


; The Double Jump on Equal to Zero and NOT Equal to Zero would work
; for double floating point numbers, but are inefficient as only the
; (left justified) high order word need be checked.  In other words,
; a simple JUMPE R,A or JUMPN R,A is always the right thing.

DEFINE DJUMPE (R,A) <		;;Jump if register pair is zero

	JMPCHK(R,A)		;;Anything Bogus?

	CAIN 'R,0		;;Compare high order, fall through if zero
	 JUMPE <'R+1>,<'A>	;;Jump if low order also zero
>;;DJUMPE


DEFINE DJUMPN (R,A) <		;;Jump if register pair is NOT zero

	JMPCHK(R,A)		;;Anything Bogus?

	JUMPN 'R,<'A>		;;Jump if high order not zero  ...or...
	JUMPN <'R+1>,<'A>	;;Jump if low order not zero
>;;DJUMPN


; Note Well!! Be aware that the Double Jump on Greater than Zero macro
; will *** NOT *** work for negative double floating numbers with very
; 'wide' mantissa's because--while the first jump will fail on the high
; order negative word--anything in the low order word will ALWAYS be
; positive and that jump will (wrongly) occur.

DEFINE DJUMPG (R,A) <		;;Jump if either register greater than zero

	JMPCHK(R,A)		;;Anything Bogus?

	JUMPG 'R,<'A>		;;High order greater than zero?  ...or...
	JUMPG <'R+1>,<'A>	;;Low order is greater than zero?
>;;DJUMPG


; Note the small optimization: only the high order word needs to be
; checked for negativity.  The low order sign bit will ALWAYS track
; this for integers.
;
; This is also optimal code for a double floating point negative
; number (because that sign bit is irrelevant), a rare case.  However,
; do remember that the low order word's sign bit will *** NOT ***
; track the high order.

DEFINE DJUMPL (R,A) <		;;Jump if high sign is set

	JMPCHK(R,A)		;;Anything Bogus?

	JUMPL 'R,<'A>		;;High order negative?
	REMARK 'R+1,1B0		;;Low order negative bit is a copy
>;;DJUMPL


; N.B., Double Jump if Greater than or Equal to Zero will *** NOT ***
; produce the correct result for a negative double floating point
; number!  It is coded to assume that a negative number will fall
; through both tests.  This will NOT happen for the low order word of
; a floating point number, which will be positive.

DEFINE DJMPGE (R,A) < ;;jump if register pair zero or greater than zero

	JMPCHK(R,A)		;;Anything Bogus?

	JUMPG 'R,<'A>		;;High order positive?
	REMARK 'R,0 ~ 1B0	;;High order is known to be zero or negative
	REMARK 'R+1,1B0		;;Low order negative bit is redundant
	JUMPGE <'R+1>,<'A>	;;Low order greater than or zero?
>;;DJUMPGE


; Note the very small optimization: the low order word is only tested
; to be zero as negative in the high order word is guaranteed to be
; correctly propagated to the low order.  Once negativity is checked
; in the high order, it doesn't need to get checked again.
;
; The correct code for a double floating point number is a simple
; JUMPLE R,.

DEFINE DJMPLE (R,A) < ;;jump if register pair zero or less than zero

	JMPCHK(R,A)		;;Anything Bogus?

	JUMPL 'R,<'A>		;;Is this a double negative number?
	CAIG 'R,0		;;High order positive?
	 JUMPE <'R+1>,<'A>	;;Low order zero?
>;;DJUMPGE

	SUBTTL "Signed and Unsigned Casting Macros"

; CAST macros are non-standard in that, if they determine that they
; are being called with blank a effective address, they assume a
; simple register cast and not ZERO (0) for the address.  This is
; internally called a 'mis-cast' because it assumes the argument to
; mis-cast is already properly positioned in the low order register
; (R+1).
;
; In general, register only 'mis-casts' use either less instructions,
; faster instructions or both.


; Integer casts to longs are fairly straightforward.  You move and
; test the value into the low order word and set or clear the high
; word as appropriate.  Uses two instructions, maximum.
;
; Use FLTR to convert an integer to floating point.  You have to do
; some work by hand to make a double floating number.  See EFTPSR.

DEFINE ICASTL (R,A) <		;;Cast an signed word to a signed long

	CASCHK(R,A)		;;Anything Bogus?

IFNB <'A>,<			;;Case of explicit address
	SKIPL <'R+1>,<'A>	;;Put the signed single in low order
>
IFB <'A>,<			;;Case of no address
	TLNN <'R+1>,(1B0)	;;Test and skip if negative 
>
	 TDZA <'R>,<'R>		;;Positive, zero high order
	  SETO <'R>,		;;Negative, set high order
>;;ICASTL


; The unsigned cast has gone through several iterations and is now
; fairly arcane.  For the case of unsigned numbers equal to or less
; than 34,359,738,367 (or octal 377777,,777777), which still looks
; positive, it takes two instructions, both of which skip.  Greater
; than this takes three instructions to fix both the low order (which
; looked negative) and the high order.

DEFINE UCASTL (R,A) <		;;Cast an UNsigned word to a signed long

	CASCHK(R,A)		;;Anything Bogus?

IFNB <'A>,<			;;Case of explicit address
	SKIPGE <'R+1>,<'A>	;;Put unsigned single in low order and check
	 TLZA <'R+1>,(1B0)	;;Negative, fix low order and skip
>				;;End case of positioning the argument
IFB <'A>,<			;;Case of mis-cast
	 TLZN <'R+1>,(1B0)	;;Test if Negative, fix low order and skip
>				;;End case of NOT positioning the argument
	  TDZA <'R>,<'R>	;;Positive, zero high order and skip
	   MOVEI <'R>,1		;;Propagate sign bit in the high order
>;;UCASTL

	SUBTTL "Cast a double (72 bit signed number) to an unsigned word"

; Note that this macro assumes that the cast 'makes sense'
;
;  (1)	It does not check for negative numbers.
;  (2)	It does not check for values in excess of positive unsigned
;	infinity (68,719,476,735, represented as 1:.INFIN)
;
; BEWARE!! Note that the register-only cast case side-effects the low
; order source while the memory case does NOT.  It is slightly faster
; in certain cases, even if the argument is in a register.  Such is
; efficiency.
;
; Note, the register only (miscast) case also results in the same
; unsigned number being put in the register pair R::R+1.  Perhaps
; useful...

DEFINE LCASTU (R,A) <	;;Cast a signed long to an unsigned word

	CASCHK(R,A)		;;Anything Bogus?

IFB <'A>,<			;;Case of blank address (a miscast)
	CAIE <'R>,0		;;Any high order?
	 TLO <'R+1>,(1B0)	;;Yes, SIDE-EFFECT source low order
	MOVE <'R>,<'R+1>	;;Return as unsigned
>;;End Case Blank address

IFNB <'A>,<			;;Case of explicit address
	MOVE <'R>,<'A+1>	;;Load the low order
	SKIPE <'A>		;;Anything in the high order?
	 TLO <'R>,(1B0)		;;Yes, propagate to low order
>;; End case of explicit memory operand

>;;LCASTU

	END			;End of DCAM.MAC