.iif ndf $list, .nlist
;\p';'\o'mac'\r'|rel|'2.1E'\r'|lev|'2'
;\r'|processor|'PDP-11'\r'|system|'ALL'
;\r'|descr|'Macro interface to Pascal program modules for 2.1/1.3 & greater'
;\r'|who|'KRIS'\r'|upddate|'12-Mar-1986'\r'|updtime|'12:57:18'
;\r'|purpose|'replaced header with preprocessor directives'
;\i'cc:cpr80'
;\c'nodirct'\c'norepl'
	.enabl	lc
;
; This file contains a number of macro definitions designed to make
; it easier to write external routines in macro for use with Pascal-2.
;
; One set of macros is used to provide a structure definition capability
; similar to the Pascal "record" definition. The other set provides the
; user with pascal-like declarations which make it very easy to interface
; to the code generated with the compiler.
;

; Structure definition macros.
;
; These macros provide the equivalent of a pascal "record" definition.
; They are used to define field offsets within a structure, and compute
; the total size of the structure.
;
; The package consists of three macros:
;
; 1. 	record	typename	Begins the definition of a record definition
;				for type "typename"
;
; 2.	field	name,type	Defines a field "name" of type "type within
;				The record.
;
; 3.	endrec			Ends a record definition.
;
; A record definition begins with a call to "record", which initializes
; the local storage counter and defines the name of the record type.
;
; Each field is defined with a call to "field", with the name for the
; field and the size of the field given by "type".  This defines that
; name as the field offset within the record, and increments the local storage
; counter by the size of the field.  Alignment within the field is taken
; into account.
;
; Finally, the record is terminated with "endrec", which sets the record type
; name to the total size of the record.
;
; Field names are used within later code as offsets relative to the start
; of the record.
;
.macro	record	typen
q$$r1	=	0
.macro	$prece	total
typen	=	total
.endm	$prece
.endm	record
;
;
.macro	field	name,size
 .if	gt	<size>-1
q$$r1	=	q$$r1+1&^o177776
 .endc
name	=	q$$r1
q$$r1	=	q$$r1+<size>
.endm	field
;
;
.macro	endrec
	$prece	q$$r1
.endm	endrec



; Procedure declaration package
;
; These macros provide a simple way for the macro programmer
; to address parameters, declare local variables, and save registers.
; The macros will automatically generate proper code for procedure entry
; and exit, do the register save and restore, and compute the proper
; offsets for accessing the parameters and local variables.
;
; Briefly, the macros consist of:
;
;	proc	Declare a procedure entry
;	func	Declare a function entry
;	param	Declare an parameter to the procedure
;	var	Declare a local variable
;	save	Specify general registers to save and restore
;	rsave	Specify real accumulators to save and restore (fpp)
;	begin	Begin the body of the procedure
;	endpr	End the body of the procedure and return to caller.
;
; The required sequence is:
;
;	proc/func	one of these is required
;	param		as many as required (or none)
;	var		as many as required (or none)
;	save/rsave	either or both, as needed
;	begin		required
;
;	<user code>
;
;	endpr		required.
;
; This sequence is enforced by the macros, and an error message will result
; if the macros appear out of sequence.
;
; Within the package, types are represented by constants equal to their
; length in bytes, so "integer" would be equivalent to "2".  A set of
; standard types is defined at the end of this macro package.

; Internally, the macro package stores data as symbol values and as
; macro bodies.
; The following are use by the package, and are retained
; globally across macro invocations.
;
;	q$arct		Number of params so far
;	q$arln		Total length of parameters so far
;	q$cur		Current address being allocated
;	q$regs		Has bits set for registers to save
;	q$rgln		Length of register save area
;	q$stat		Current state, bits set as macros called
;	q$via		accumulator used to store ac4 and ac5
;	q$vrct		Number of variables so far
;	q$vrln		Total length of variables so far
;
; The following are used locally within macros.  Whenever possible,
; a variety of macros will share the same symbols.
;
;	q$$c1, q$$c2, q$$i0
;
; The following macros are generated dynamically as needed by the
; package
;
;	$par0..$parn	Declare parameters
;	$presn		Declares result name for function
;	$pstrt		Generates entry point for procedure
;	$pva0..$pvan	Declare variables

; Procedure declaration macro
;
;	proc	procedure_name, [check=1]
;
; procedure_name	The entry name of the current procedure
; check			If non-zero (default), generate stack check
;
; This macro begins any procedure declaration.  It specifies the name
; of the procedure, and whether stack overflow checking is desired.
; This macro (or the "func") macro must be called before any other
; macros in this package can be called.
;
;
; The basic action is to check for proper sequencing, initialize the
; internal variables and macro definitions, and save the procedure name
; as the body of the macro "q$strt" for later use by the "begin" macro
;
.macro	proc	name,check=1
  .if	ndf	q$stat
q$stat	=	0
  .endc
	$pchk	0,<^b111111>,1
q$arln	=	0
q$vrln	=	0
q$rgln	=	0
q$via	=	-1
q$arct	=	0
q$vrct	=	0
q$regs	=	check
 .macro	$par0
 .endm	$par0
 .macro	$pva0
 .endm	$pva0
 .macro	$presn
 .endm	$presn
 .macro	$pstrt
name::
 .endm	$pstrt
.endm	proc



; Function declaration macro
;
;	func	function_name, result_name, result_type, [ check=1 ]
;
; function_name		Entry name of the current function
; result_name		Name for referencing the result value
; result_type		Length of result name
; check			If non-zero (default), generate stack check
;
; Similar to the "proc" macro, except that a result_name is defined.
; the result_ name may be used within the function body to refer to the
; location where the function result is stored.  Like all parameters
; and local variables, the result_name is relative to the stack pointer
; after local variables are allocated and all registers saved. 
;
; for example:
;
;	mov	r0,resnam(sp)
;
; stores the value in r0 as the procedure result.
;
;
; The macro begins by calling "proc", then defines the body of the macro
; "$presn" so that the result_name can be set in begin.  This name has to
; be saved and set later, since the parameter and variable lengths are
; not known until the "begin" macro is called.
;
; Note that the result type is not used in this implementation, it is
; included as a documentation tool, and in case it is needed for some
; later feature.
;
;
.macro	func	name,resnam,restyp,check=1
	proc	name,check
 .macro	$presn
resnam	=	q$cur
 .endm	$presn
.endm	func


; Parameter definition macro
;
;	param	parmname,parmtype
;
; parmname		Name to be used to refer to this parameter
; parmtype		The length of the parameter (type)
;
; This macro defines an parameter to the procedure or function.
; Within the body of the procedure, parameters are refered to
; by the parameter name relative to sp.  For instance, the code
;
;	mov	parm1(sp),r0
;
; will move the contents of parm1 to r0.  The relative location
; computed takes the local variables and register save locations,
; but not any changes to the stack after the "begin" macro.  The
; user must include such changes himself.
;
; A many "param"s as needed may be specified.  A "var" parameter will be
; passed as the address of the real parameter, and "parmtype" argument
; should be an address length.  The user will have to do the necessary
; indirection himself.
;
;
; Since the total size of parameters, variables, and register save area
; is not known until the "begin" macro is called, this macro just stores
; the parameter name as a macro body.  The parameters are assigned in
; decreasing order, which further complicates things.  The internal
; macro "q$nitm" creates a macro to define the parameter.  See the
; description of that macro for data.  The parm count "q$arct" and
; total parm length "q$arln" are also changed by this macro.
;
; Note the code to round up odd sizes, since the stack always pushes
; full words
;
;
.macro	param	name,len
	$pchk	1,<^b111100>,<^b10>
q$$c1	=	len
 .if	nz	<len>&1
q$$c1	=	q$$c1+1
 .endc
q$arln	=	q$arln+q$$c1
	$pnitm	$par,\q$arct,\q$arct+1,name,\q$$c1
q$arct	=	q$arct+1
.endm	param


; variable declaration macro
;
;	var	var_name,var_type
;
; var_name		name of local variable
; var_type		size of local variable
;
; This is similar to the "param" macro, except that space will be allocated
; on the stack at procedure entry time to hold the local variables.
; Local variables are not initialized.  They are referenced in the same
; way as parameters.
;
; The implementation is almost the same as for parameters, except that
; alignment to an even address is done only if the size of the variable
; is greater than 1.
;
;
.macro	var	name,len
	$pchk	1,<^b111000>,<^b100>
 .if	gt	<len>-1
  .if	nz	q$vrln&1
q$vrln	=	q$vrln+1
  .endc
 .endc
q$vrln	=	q$vrln+<len>
	$pnitm	$pva,\q$vrct,\q$vrct+1,name,\<len>
q$vrct	=	q$vrct+1
.endm	var


; Register save macro
;
;	save	<reg1,reg2,...regn>
;
; "Save" specifies which registers are to be saved and restored.
; According to Pascal 2 calling conventions, all registers used within
; a procedure must be saved on entry and restored on exit.  This macro
; sets up data on the registers to be saved and restored, and the "begin"
; and "endpr" macros actually generate code to do the save and restore.
; If more than 3 registers are listed, a call to a pascal support routine
; will be generated.  "Sp" and "pc" may not be saved.
;
; For example:
;
;	save	<r0,r1,r2>
;
; requests code to save and restore registers r0, r1 and r2.
;
;
; This macro actually builds a bit mask in "q$regs", with a bit
; set for each register to be saved.  If more than three registers
; are specified, a bit is set to indicate the use of the library
; procedure instead.  The total length of the register save area is
; saved in "q$rgln" for later use in computing offsets.
;
;
.macro	save	regs
	$pchk	1,<^b101000>,<^b1000>
q$$c1	=	0
q$$c2	=	0
 .irp	reg,<regs>
 	.ntype	q$$c3,reg
  .if	gt	q$$c3-7
	.error	q$$c3	; Only registers can be saved
  .iff
   .if	gt	q$$c3-5
	.error	q$$c3	; Cannot save sp or pc
   .endc
  .endc
	$pinc	q$$c2,q$$c3+1
q$$c1	=	q$$c1+2
 .endm
 .if	gt	q$$c1-6
q$$c2	=	1
q$$c1	=	^d12
 .endc
q$rgln	=	q$rgln+q$$c1
q$regs	=	q$regs!<q$$c2*2>
.endm	save


; Real register save macro, fpp only
;
;	rsave	<ac1,..acn>[ ,double=0 ]
;
; This is identical to the "save" macro, except that real registers
; are saved.  This is useful only for machines with "fpp", of course.
; If "ac4" or "ac5" is specified, some lower register must also be
; specified, since these registers cannot be loaded and stored
; directly.
;
; If the argument "double" is specified and non-zero, the fpp is assumed
; to be in double mode, and space is allocated accordingly.  This does not
; set the processor into double mode.
;
; The internal logic is very similar to "save", and the same symbols
; are set.  The label "q$via" is set to a register in ac0..ac3 for
; use in saving ac4 and ac5.
;
;
.macro	rsave	regs,double=0
	$pchk	1,<^b110000>,<^b10000>
q$$c1	=	0
 .irp	reg,<regs>
	.ntype	q$$c2,reg
  .if	gt	q$$c2-5
	.error	q$$c2	; Only real accumulators may be saved
  .endc
  .if	lt	q$$c2-4
q$via	=	q$$c2
  .endc
	$pinc	q$$c1,q$$c2
q$rgln	=	q$rgln+4+<4*double>
 .endm
 .if	nz	q$$c1&^b110000
  .if	lt	q$via
	.error		; Cannot save a4 or a5 without a0, a1, a2, or a3
q$via	=	0
  .endc
 .endc
q$regs	=	q$regs!<q$$c1*^o400>
.endm	rsave


; Code begin macro
;
;	begin
;
; This marks the beginning of the actual procedure code.  Using
; data accumulated from preceeding macros, it defines the procedure
; globally, generates procedure entry code to push variable space
; and save the registers, and defined all parameter and variable
; addresses.
;
; This macro calls the macros defined by the preceeding macros, pushes
; the variable space, then calls "$pregs" to save the registers.  The
; symbol "q$cur" is used as a local variable (and parameter) allocation
; counter.  the macros "$presn", "$par0" and "$pva0" depend on this
; exact label being used.
;
;
.macro	begin
	$pchk	1,<^b100000>,<^b100000>
 .if	nz	q$vrln&1
q$vrln	=	q$vrln+1
 .endc
q$cur	=	q$arln+q$vrln+q$rgln+2
	$presn
	$par0
q$cur	=	q$cur-2
	$pva0
	$pstrt
	$padsp	-q$vrln
	$pregs
.endm	begin


; Procedure return macro
;
;	endpr
;
; This macro marks the end of executable code for the procedure, and
; generates code to restore registers, remove local variables and parameters
; from the stack, and return from the procedure.  Exactly one "endpr" is
; allowed for any procedure.  The procedure takes care to generate good
; return code.  It assumes that the stack pointer "sp" has the same value
; as it did after the "begin" macro call (delete your own temps, fellows).
;
; The procedure first calls "$pregr" to restore registers pushed, then
; generates return code.  The return code copies the return address back over
; the parameters (if any), adjusts the stack, and does a "rts pc".  Most of
; the work in the macro is done to reduce the work of stack adjustment.
;
;
.macro	endpr
	$pchk	<^b100001>,0,0
	$pregr
 .if	le	q$arln-4
	$padsp	q$vrln
  .rept	q$arln/2
	mov	(sp)+,(sp)
  .endm
 .iff
  .if	z	q$vrln
	mov	(sp)+,q$arln-2(sp)
	$padsp	q$arln-2
  .iff
	mov	q$vrln(sp),q$arln+q$vrln(sp)
	$padsp	q$arln+q$vrln
  .endc
 .endc
	rts	pc
q$stat	=	0
;; An "E" flag here means you forgot the .END directive
.endm	endpr


; Internal macro for sequence check
;
;	$pchk	required_bits, forbidden_bits, new_bits
;
; required_bits		Bits which must be set in "q$stat"
; forbidden_bits	Bits which must not be set in "q$stat"
; new_bits		Bits to set after the test
;
; If required bits are absent, or forbidden bits are included,
; This macro generates an error message.  After the check, the
; "new_bits" are ored into "q$stat".  This macro is called at
; the start of each sequenced macro to make sure that sequence is
; correct.
;
; Bits used in this package are:
;
; 	proc	^B000001
;	func	^B000001
;	param	^B000010
;	var	^B000100
;	save	^B001000
;	rsave	^B010000
;	begin	^B100000
;
;
.macro	$pchk	require,forbid,include
 .if	z	q$stat&require-require
  .if	z	q$stat&forbid
q$stat	=	q$stat!include
	.mexit
  .endc
 .endc
	.error		;Macros used in wrong sequence
q$stat	=	q$stat!include
.endm	$pchk


; Internal macro for adding an item to the variable or parm list
;
;	$pnitm	prefix, \suffix, \suffix+1, name, length
;
; prefix		characters to prefix to the macro name
; \suffix		suffix for this macro
; \suffix+1		suffix for next macro in the set
; name			name of parameter or variable
; length		length of parameter or variable
;
; This macro is used in defining parameter and variable offsets.
; It defines a macro of the form:
;
;	macro	prefix'suffix
; name	=	offset
;	prefix'suffix+1
;	endm
;
; Thus each macro defines an offset, then calls another macro to define
; the next name.  As this macro is defined, the macro "prefix'suffix+1"
; is defined as an empty macro.  This rather baroque mechanism is a way
; of getting an indefinite number of lines of code in temporary storage.
;
; The macro generated is actually more complicated, as it computes
; the offset from the global symbol "q$cur", and decrements "q$cur"
; to account for the item.  Items are allocated from high addresses
; to low addresses, since this is the order in which parameters are
; pushed onto the stack.
;
; The arguments "suffix" and "suffix+1" are arbitrary, but the intent
; is to pass the numeric value of a counter using "\" at the calling
; location.
;
;
.macro	$pnitm	prefix,suf,sufp1,name,len
 .macro	prefix'suf
q$cur	=	q$cur-<len>
  .if	nz	q$cur&1
   .if	gt	<len>-1
q$cur	=	q$cur-1
   .endc
  .endc
name	=	q$cur
	prefix'sufp1
 .endm	prefix'suf
 .macro	prefix'sufp1
 .endm	prefix'sufp1
.endm	$pnitm


; Internal macro to include a bit in a word
;
;	$pinc	result,bit_number
;
; result		Symbol to have bit included
; bit_number		Bit to be included.
;
; Includes the bit specified in the value of the global symbol
; specifies.  Bit 0 is the least significant bit.
;
;
.macro	$pinc	result,bit
q$$i0	=	1
 .rept	bit
q$$i0	=	q$$i0*2
 .endm
result	=	result!q$$i0
.endm	$pinc


; Internal macro to save registers
;
;	$pregs
;
; Uses the value in q$regs to generate code to save the general and
; floating point registers.  This is called from "begin".  The macro
; scans the bits, and generates either the saves, or the call to the 
; system register save routine.  If specified, it also generates a
; call to the stack check routine.
; 
; The only complication is in saving real registers, in that the
; upper accumulators cannot be loaded or saved directly, and the
; global "q$via" is used as a register for saving and restoring them.
;
; The sequence is...
;
;	save lower real registers
;	save upper real registers
;	save general registers
;	generate stack check.
;
;
.macro	$pregs
q$$c1	=	0
q$$c2	=	^o400
 .rept	4
  .if	ne	q$regs&q$$c2
	stf	%q$$c1,-(sp)
  .endc
q$$c1	=	q$$c1+1
q$$c2	=	q$$c2*2
 .endm
 .rept	2
  .if	ne	q$regs&q$$c2
	ldf	%q$$c1,%q$via
	stf	%q$via,-(sp)
  .endc
q$$c1	=	q$$c1+1
q$$c2	=	q$$c2*2
 .endm
 .if	nz	q$regs&^b10
	.globl	p$75
	jsr	pc,p$75
 .iff
q$$c1	=	5
q$$c2	=	^o200
  .rept	6
   .if	ne	q$regs&q$$c2
	mov	%q$$c1,-(sp)
   .endc
q$$c1	=	q$$c1-1
q$$c2	=	q$$c2/2
  .endm
  .if	ne	q$regs&^b1
	.globl	p$127
	jsr	pc,p$127
  .endc
 .endc
.endm	$pregs


; Internal macro to generate register restores
;
;	$pregr
;
; This is exactly analogous to the "$pregs" macro, except that it
; restores registers rather than saving them.
;
;
.macro	$pregr
 .if	nz	q$regs&^b10
	.globl	p$77
	jsr	pc,p$77
 .iff
q$$c1	=	0
q$$c2	=	^o4
  .rept	6
   .if	ne	q$regs&q$$c2
	mov	(sp)+,%q$$c1
   .endc
q$$c1	=	q$$c1+1
q$$c2	=	q$$c2*2
  .endm
 .endc
q$$c1	=	5
q$$c2	=	^o20000
 .rept	2
  .if	ne	q$regs&q$$c2
	ldf	(sp)+,%q$via
	stf	%q$via,%q$$c1
  .endc
q$$c1	=	q$$c1-1
q$$c2	=	q$$c2/2
 .endm
 .rept	4
  .if	ne	q$regs&q$$c2
	ldf	(sp)+,%q$$c1
  .endc
q$$c1	=	q$$c1-1
q$$c2	=	q$$c2/2
 .endm
.endm	$pregr


; Utility macro to increment the stack pointer (sp)
;
; This macro is used to add or subtract a constant amount from
; the stack pointer (sp).  It checks for and handles special cases 
; which can be handled with single word instructions.
;
; The calling sequence is
;
;	$padsp	amount
;
;
.macro	$padsp	amount
  .if	eq	amount-2
	tst	(sp)+
	.mexit
  .endc
  .if	eq	amount-4
	cmp	(sp)+,(sp)+
	.mexit
  .endc
  .if	eq	amount+2
	tst	-(sp)
	.mexit
  .endc
  .if	eq	amount+4
	cmp	-(sp),-(sp)
	.mexit
  .endc
  .if	nz	amount
	add	#amount,sp
  .endc
.endm	$padsp



; Constants for standard type sizes
;
;
char	=	1
boolean	=	1
scalar	=	1
integer	=	2
pointer	=	2
address	=	2
real	=	4
double	=	^d8
	record	procpar
	field	pp.proc,address
	field	pp.stat,address
	endrec

.iif ndf $list, .list
