.iif ndf $list, .nlist
	.enabl	lc
; NOTICE OF COPYRIGHT AND OWNERSHIP OF SOFTWARE:
;
; Copyright 1980, 1981, 1982  by Oregon Software, Inc.
; All Rights Reserved.
;
; This computer program is the property of Oregon Software, Inc.
; of Portland, Oregon, U.S.A., and may be used
; and copied only as specifically permitted under written
; license agreement signed by Oregon Software, Inc.
;
; Whether this program is copied in whole or in part and whether this
; program is copied in original or in modified form, ALL COPIES OF THIS
; PROGRAM MUST DISPLAY THIS NOTICE OF COPYRIGHT AND OWNERSHIP IN FULL.
;
; Pascal-2 interface macros
; Release version: 2.0K  Level: 2  Date: 15-Jan-1982 13:34:22
; Processor: PDP11, System: All
;
; 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
p$$r1	=	0
.macro	$prece	total
typen	=	total
.endm	$prece
.endm	record
;
;
.macro	field	name,size
 .if	gt	<size>-1
p$$r1	=	p$$r1+1&^o177776
 .endc
name	=	p$$r1
p$$r1	=	p$$r1+<size>
.endm	field
;
;
.macro	endrec
	$prece	p$$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.
;
;	p$arct		Number of params so far
;	p$arln		Total length of parameters so far
;	p$cur		Current address being allocated
;	p$regs		Has bits set for registers to save
;	p$rgln		Length of register save area
;	p$stat		Current state, bits set as macros called
;	p$via		accumulator used to store ac4 and ac5
;	p$vrct		Number of variables so far
;	p$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.
;
;	p$$c1, p$$c2, p$$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 "p$strt" for later use by the "begin" macro
;
.macro	proc	name,check=1
  .if	ndf	p$stat
p$stat	=	0
  .endc
	$pchk	0,<^b111111>,1
p$arln	=	0
p$vrln	=	0
p$rgln	=	0
p$via	=	-1
p$arct	=	0
p$vrct	=	0
p$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	=	p$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 "p$nitm" creates a macro to define the parameter.  See the
; description of that macro for data.  The parm count "p$arct" and
; total parm length "p$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>
p$$c1	=	len
 .if	nz	<len>&1
p$$c1	=	p$$c1+1
 .endc
p$arln	=	p$arln+p$$c1
	$pnitm	$par,\p$arct,\p$arct+1,name,\p$$c1
p$arct	=	p$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	p$vrln&1
p$vrln	=	p$vrln=1
  .endc
 .endc
p$vrln	=	p$vrln+<len>
	$pnitm	$pva,\p$vrct,\p$vrct+1,name,\<len>
p$vrct	=	p$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 "p$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 "p$rgln" for later use in computing offsets.
;
;
.macro	save	regs
	$pchk	1,<^b101000>,<^b1000>
p$$c1	=	0
p$$c2	=	0
 .irp	reg,<regs>
 	.ntype	p$$c3,reg
  .if	gt	p$$c3-7
	.error	p$$c3	; Only registers can be saved
  .iff
   .if	gt	p$$c3-5
	.error	p$$c3	; Cannot save sp or pc
   .endc
  .endc
	$pinc	p$$c2,p$$c3+1
p$$c1	=	p$$c1+2
 .endm
 .if	gt	p$$c1-6
p$$c2	=	1
p$$c1	=	^d12
 .endc
p$rgln	=	p$rgln+p$$c1
p$regs	=	p$regs!<p$$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 "p$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>
p$$c1	=	0
 .irp	reg,<regs>
	.ntype	p$$c2,reg
  .if	gt	p$$c2-5
	.error	p$$c2	; Only real accumulators may be saved
  .endc
  .if	lt	p$$c2-4
p$via	=	p$$c2
  .endc
	$pinc	p$$c1,p$$c2
p$rgln	=	p$rgln+4+<4*double>
 .endm
 .if	nz	p$$c1&^b110000
  .if	lt	p$via
	.error		; Cannot save a4 or a5 without a0, a1, a2, or a3
p$via	=	0
  .endc
 .endc
p$regs	=	p$regs!<p$$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 "p$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	p$vrln&1
p$vrln	=	p$vrln+1
 .endc
p$cur	=	p$arln+p$vrln+p$rgln+2
	$presn
	$par0
p$cur	=	p$cur-2
	$pva0
	$pstrt
	$padsp	-p$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	p$arln-4
	$padsp	p$vrln
  .rept	p$arln/2
	mov	(sp)+,(sp)
  .endm
 .iff
  .if	z	p$vrln
	mov	(sp)+,p$arln-2(sp)
	$padsp	p$arln-2
  .iff
	mov	p$vrln(sp),p$arln+p$vrln(sp)
	$padsp	p$arln+p$vrln
  .endc
 .endc
	rts	pc
p$stat	=	0
.endm	endpr

; Internal macro for sequence check
;
;	$pchk	required_bits, forbidden_bits, new_bits
;
; required_bits		Bits which must be set in "p$stat"
; forbidden_bits	Bits which must not be set in "p$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 "p$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	p$stat&require-require
  .if	z	p$stat&forbid
p$stat	=	p$stat!include
	.mexit
  .endc
 .endc
	.error		;Macros used in wrong sequence
p$stat	=	p$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 "p$cur", and decrements "p$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
p$cur	=	p$cur-<len>
  .if	nz	p$cur&1
   .if	gt	<len>-1
p$cur	=	p$cur-1
   .endc
  .endc
name	=	p$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
p$$i0	=	1
 .rept	bit
p$$i0	=	p$$i0*2
 .endm
result	=	result!p$$i0
.endm	$pinc

; Internal macro to save registers
;
;	$pregs
;
; Uses the value in p$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 "p$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
p$$c1	=	0
p$$c2	=	^o400
 .rept	4
  .if	ne	p$regs&p$$c2
	stf	%p$$c1,-(sp)
  .endc
p$$c1	=	p$$c1+1
p$$c2	=	p$$c2*2
 .endm
 .rept	2
  .if	ne	p$regs&p$$c2
	ldf	%p$$c1,%p$via
	stf	%p$via,-(sp)
  .endc
p$$c1	=	p$$c1+1
p$$c2	=	p$$c2*2
 .endm
 .if	nz	p$regs&^b10
	.globl	$b75
	jsr	pc,$b75
 .iff
p$$c1	=	5
p$$c2	=	^o200
  .rept	6
   .if	ne	p$regs&p$$c2
	mov	%p$$c1,-(sp)
   .endc
p$$c1	=	p$$c1-1
p$$c2	=	p$$c2/2
  .endm
  .if	ne	p$regs&^b1
	.globl	$b127
	jsr	pc,$b127
  .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	p$regs&^b10
	.globl	$b77
	jsr	pc,$b77
 .iff
p$$c1	=	0
p$$c2	=	^o4
  .rept	6
   .if	ne	p$regs&p$$c2
	mov	(sp)+,%p$$c1
   .endc
p$$c1	=	p$$c1+1
p$$c2	=	p$$c2*2
  .endm
 .endc
p$$c1	=	5
p$$c2	=	^o20000
 .rept	2
  .if	ne	p$regs&p$$c2
	ldf	(sp)+,%p$via
	stf	%p$via,%p$$c1
  .endc
p$$c1	=	p$$c1-1
p$$c2	=	p$$c2/2
 .endm
 .rept	4
  .if	ne	p$regs&p$$c2
	ldf	(sp)+,%p$$c1
  .endc
p$$c1	=	p$$c1-1
p$$c2	=	p$$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