.title MACROS - a few useful macros

;
;	SETUP macro - set up buffers etc for STATUS, PRINTF.  Do after .library
;	Usage: SETUP
;
		.macro setup, ?L1
		.save_psect
		.psect _MACROS_RW, noshr,noexe,wrt
_faobuf:	descriptor L1, 248
L1:		.blkb 248
		.endm

;
;	STATUS macro - do status check on specified condition code, abort if
;	error detected.  Branch to "crash" in process to allow trapping.
;	Usage:	STATUS code
;	5/7/90/dcs	NOTE: crash now included in macro; will need to be 
;			removed from existing code.
;	10/8/90/dcs	crash moved to SETUP; no SETUP, no crash.  Code 
;			should be changed to include SETUP, but not essential.
;			crash can also bet set to another value before calling
;			SETUP
;	12/6/91/dcs	crash removed from SETUP, if you want it, you set it up.
;			(screws up in exec code!)
;
		.macro status code, ?L1
		blbs code, L1
		.if defined crash
			jsb crash
		.endc
		$EXIT_S code
L1:		.endm

;
;	CALL macro - call a subroutine, pass parameters on stack
;	Usage:	CALL routine [,p1...,p20]
;
		.macro call routine,					-
			    p1,p2,p3,p4,p5,p6,p7,p8,p9,p10,p11,		-
			    p12,p13,p14,p15,p16,p17,p18,p19,p20
		.narg call.argc
		call.argc = call.argc - 1
		call.argn = 20
		.irp call.argv, <p20,p19,p18,p17,p16,p15,p14,p13,p12,	-
				 p11,p10,p9,p8,p7,p6,p5,p4,p3,p2,p1>
			.if less_equal call.argn - call.argc
				pushal call.argv
			.endc
			call.argn = call.argn - 1
		.endr
		calls #call.argc, G^routine
		.endm

;
;	ITEM macro - create itemlist entry.
;	Usage:	ITEM code, buflen, [address, [lenadr]]
;
		.macro item code, buflen, address, lenadr=0
		.blkl 3			; Force itemlist to be viewed as
		.=.-12			; and array of longwords
		.word buflen
		.word code
		.long address
		.long lenadr
		.endm

;
;	DESCRIPTOR macro - create string descriptor
;	Usage:	DESCRIPTOR [string [,length [,type [,class]]]]
;
		.macro descriptor addr=0, len=0, type=T, class=S
		.ascid ""		; Force DEBUG to view the descriptor
		.=.-8			; as a string rather than a word
		.word len
		.byte DSC$K_DTYPE_'type'
		.byte DSC$K_CLASS_'class'
		.long addr
		.endm

;
;	STRING_ARRAY macro - create uninitialised array of string descriptors
;	Default is array of dynamic strings.
;	Usage:	STRING_ARRAY elements [,type [,class]]
;
		.macro string_array elements, type=T, class=D
		.repeat elements
			.ascid ""	; Force DEBUG to view the descriptor
			.=.-8		; as a string rather than a word
			.word 0
			.byte DSC$K_DTYPE_'type'
			.byte DSC$K_CLASS_'class'
			.long 0
		.endr
		.endm

;
;	DEBUG - quick-n-dirty to get into DEBUG, ie forced breakpoint.
;	Usage:	DEBUG
;
		.macro debug
		pushl #SS$_DEBUG
		calls #1, g^LIB$SIGNAL
		.endm

;
;	PRINT - print a line of text
;	Usage:	PRINT text
;	Note: text must be contained in angle-brackets if it includes spaces, eg
;		PRINT <"message with spaces">
;
		.macro print text, ?L1, ?L2
		pushal L1
		calls #1, G^LIB$PUT_OUTPUT
		brb L2
L1:		.ascid text
l2:		.endm

;
;	Word displacement branches
;	Usage: b<cc>w disp
;
		.macro beqlw, dest, ?L1
		bneq L1
		brw dest
L1:		.endm
		.macro bneqw, dest, ?L1
		beql L1
		brw dest
L1:		.endm
		.macro blssw, dest, ?L1
		bgeq L1
		brw dest
L1:		.endm
		.macro bgeqw, dest, ?L1
		blss L1
		brw dest
L1:		.endm
		.macro bgtrw, dest, ?L1
		bleq L1
		brw dest
L1:		.endm
		.macro bleqw, dest, ?L1
		bgtr L1
		brw dest
L1:		.endm

;
;	PRINTF macro - print data using FAO
;	Note that string descriptors should be passed as #address.
;	Usage:	PRINTF ctrstr [,p1 [,p2 ... [, p20]]]
;
		.macro printf faostring,				-
				p1,p2,p3,p4,p5,p6,p7,p8,p9,p10,p11,	-
				p12,p13,p14,p15,p16,p17,p18,p19,p20,	-
				?L1, ?L2
		.narg call.argc
		call.argc = call.argc - 1
		call.argn = 20
		.irp call.argv, <p20,p19,p18,p17,p16,p15,p14,p13,p12,	-
				 p11,p10,p9,p8,p7,p6,p5,p4,p3,p2,p1>
			.if less_equal call.argn - call.argc
				pushl call.argv
			.endc
			call.argn = call.argn - 1
		.endr
		movw #255, _faobuf
		pushaq _faobuf
		pushaq _faobuf
		pushaq L1
		calls #call.argc+3, G^SYS$FAO
		status R0
		pushaq _faobuf
		calls #1, G^LIB$PUT_OUTPUT
		blbs R0, L2
		.if defined crash
			jsb crash
		.endc
		$EXIT_S R0
L1:		.ascid faostring
L2:		.endm