;;; CALRET - Call Return routines.  DAM.
;;;	This facility is based on a similar one by Michael Spier
;;;** NOTE FORMAT OF CERTAIN MACROS HAS BEEN CHANGED SINCE CALRET 8
;;;** Rewritten to make literals etc. work.  Max 10 arguments.
;;;   This is entirely due to the losiness of IRP wrt brackets.
;;;   FORMAT OF STACK FRAME CHANGED - VERSION 16

IF1,[		;STUFF THAT ONLY NEEDS TO BE DONE ONCE

; MACRO TO TELL WHAT VERSION INSERT FILE THIS IS

DEFINE TELLVERSION
IF1,[
.TYO6 .IFNM1
PRINTX " "
.TYO6 .IFNM2
PRINTX " Included in this assembly.
"
]
TERMIN

TELLVERSION

;;; Registers

;;; Temporary Registers - destroyed by calls, may not be passed as arg.
;;; Note:  T0 is not an index register; The order may be relied upon

T0=0
T1=1
T=2
TT=3

;;; Registers Used Internally by the System

P=17		;PushDown List Pointer
.CF.=16		;Current Stack Frame Pointer
.PF.=15		;Previous Stack Frame Pointer
.AP.=14		;Argument List Pointer

;;; Registers which may be used as variables and passed as arg,
;;;  by means of a REGISTER declaration.

.PRSVA=4	;First Preserved Register
.PRSVZ=13	;Last Preserved Register

;;; Format of the Stack Frame
;;; 
;;;           Return Address (Previous Routine's PC)
;;;	      Previous Routine's Registers, i.e.
;;;  .CF. ->   .PRSVA - .PRSVZ, .AP., .PF.
;;;           User's LOCAL variables + System Generated Locals
;;;	      Temporaries Pushed
;;;  P ->      on the Stack
;;;   next Frame will begin here


;;; Macro used at start of program to set up environment

DEFINE PROGRAM NAME,SPEC
SPEC		;SET STACK SIZE IF USER SAID TO
IFNDEF STACK, STACK=100	;DEFAULT TO 100 WORDS
IFNDEF PDL, PDL: BLOCK STACK

NAME:	.BEGIN NAME
	IF2 .STZZ.==.STSZ.-1	;final stack size
	.STSZ.==1		;minimum size frame
	.REGS.==.PRSVA-1

	MOVE .CF., [-STACK,,PDL-1]	;SET UP PDL
	MOVE P, [.STZZ.-STACK,,PDL+.STZZ.-1]
IF1 EXPUNGE PDL
TERMIN

;;; Macro to define a Procedure
;     NAME:  PROCEDURE ARG1,ARG2,...

DEFINE PROCEDURE -PARAMS
	.BEGIN 			;Name picked from tag
	IF2 .STZZ.==.STSZ.-1	;final stack size
	.STSZ.==1		;minimum size frame
	.REGS.==.PRSVA-1
	ENTRY PARAMS
TERMIN

DEFINE ENTRY -PARAMZ		;you will lose unless .U"NAME:  ENTRY 
	.PARM.==0
	IRPW PARAMS,,[PARAMZ]
	 IRP PARAM,,[PARAMS]	;declare the formal parameters
	  .DEF. PARAM,.AP.,\.PARM.,@
	  .PARM.==.PARM.+1
	  TERMIN
	 TERMIN
	JSP T, .ENTR.		;invoke entry operator
	.STZZ.,,.STZZ.		;on 2nd pass, becomes stack adjustment
TERMIN

DEFINE .DEF. NAME,BASE,OFFS,MOD
DEFINE NAME
MOD!OFFS(BASE)TERMIN
TERMIN

; To end a procedure, just use .END

;;; Macro to declare variables that reside in registers

DEFINE REGISTER -NAMES1
 IRPW NAMES,,[NAMES1]
  IRPS NAME,,[NAMES]
	.REGS.==.REGS.+1
	IFG .REGS.-.PRSVZ, INFORM TOO MANY REGISTERS DECLARED - ,NAME
	NAME=.REGS.
  TERMIN
 TERMIN
TERMIN

;;; Macro to declare local variables
;;;  for a multiword var, follow name by length in parentheses.
;;;  the length must be a number or constant symbol (no A+1, etc.)

DEFINE LOCAL -NAMES1
IRPW NAMES,,[NAMES1]
 .ARG.==0		;FLAG FOR LENGTH FROB
  IRPS NAME,DELIM,[NAMES]
    IFN .ARG.,[ .STSZ.==.STSZ.+NAME-1	;LENGTH OF PREV VAR
		.ARG.==0
	      ]
    .ELSE [				;NORMAL VAR
      IFSE [DELIM](, .ARG.==1		;LENGTH FOLLOWS
      .DEF. NAME,.CF.,\.STSZ.
      .STSZ.==.STSZ.+1
      ]
  TERMIN
 TERMIN
TERMIN


;;; Macro to generate a call

DEFINE CALL ROUTINE?A,B,C,D,E,F,G,H,I,J
	.NARG.==0	;count arguments
	.NFRM.==0	;count formals passed as arg, which require kludgery
	IRP ARG,,[[A],[B],[C],[D],[E],[F],[G],[H],[I],[J]]
	 IFSE [ARG], .ISTOP
	 .NARG.==.NARG.+1
	 .ARG.==<ARG>
	 IFNDEF .ARG.,.STOP	;undef skip it
	 .TAG.==<.ARG._-18.>&17
	 IFN <.TAG.>*<.TAG.-.CF.>,[	;have to copy it
		MOVEI T0, ARG
		MOVEM T0, .STSZ.(.CF.)
		.STSZ.==.STSZ.+1
		.NFRM.==.NFRM.+1
	     ]
	 TERMIN
	 IFN .NARG.,[		;create argument list
	 MOVEI T1, [ IRP ARG,,[[A],[B],[C],[D],[E],[F],[G],[H],[I],[J]]
			IFSE [ARG], .ISTOP
			.ARG.==<ARG>	;evaluate the argument's address
			IF1 IFNDEF .ARG., .ARG.==.	;PASS 1 UNDEFINED
			.TAG.==<.ARG._-18.>&17
			.IND.==.ARG.&<@>
			.ARG.==.ARG.&777777
			IFE .TAG.-.CF., .ARG.==0 .ARG.(.PF.)  ;passing local
			IFE .TAG.,[
			    IFE .ARG.&777760, .ARG.==0 .ARG.-.PF.(.CF.) ;reg
			    .ELSE ;passing a static variable
			    ]
			IFN <.TAG.>*<.TAG.-.CF.>,[	;passing via copy
				.IND.==<@>
				.ARG.==0 .STSZ.-.NFRM.(.PF.)
				.NFRM.==.NFRM.-1
				]
			.ARG.+.IND.	;now generate the argument pointer
		     TERMIN
		  ]]
	PUSHJ P, ROUTINE
 TERMIN

;;; Macro to generate a return

DEFINE RETURN
	JRST .RETN.
TERMIN

;;; Error Macro

DEFINE INFORM A,B,C,D,E,F,G,H,I,J
	PRINTX\A!B!C!D!E!F!G!H!I!J
\
TERMIN

];END MOBY IF1

;;; Entry Operator

.ENTR.:	MOVEI TT, 1(P)		;save registers between frames
	HRLI TT, .PRSVA
	ADD P, [.PF.-.PRSVA+1,,.PF.-.PRSVA+1] ;protect reg save area
	BLT TT, 0(P)
	MOVE .AP., T1		;set called routine's registers
	MOVE .PF., .CF.
	MOVE .CF., P
	ADD P, 0(T)		;adjust stack
	JUMPL P, 1(T)		;and go to called routine
	.SUSET [.SIPIRQ,,[%PIPDL]]
	JRST 1(T)

;;; Return Operator

.RETN.:	MOVE P, .CF.		;pop frame off
	MOVE .CF., .PF.
	MOVSI TT, -<.PF.-.PRSVA>(P)  ;restore registers
	HRRI TT, .PRSVA
	BLT TT, .PF.
	SUB P, [.PF.-.PRSVA+1,,.PF.-.PRSVA+1] ;pop regs off
	POPJ P,			;and return

CONSTANTS

IF1,[		;MORE ONCE-ONLY STUFF

;;; Conditional-Jump Generator Used Internally.
;;; COND may be a skip or a JUMP or an AOJ or a SOJ, if condition true.
;;; COND may also be several instructions - the last is looked at
;;; to see whether it is a skip or a jump - all are assembled in.
;;; Generates code to jump to TAG if the condition is false.

DEFINE .COND. COND,TAG
	.JUMP.==0		;condition type flag
	.CRGL.==004000,,	;opcode sense inverter
IRPW CND,,[COND]
    IRPS CN,,[CND]
	.OPCD.==770000000000&<CN>
	IFSE CN,AOBJN,[ .JUMP.==1 ? .CRGL.==1000,,]
	IFSE CN,AOBJP,[ .JUMP.==1 ? .CRGL.==1000,,]
	.ISTOP
    TERMIN
    .ICNT.==.IRPCNT		;count instructions
TERMIN
	IFE .OPCD.-JUMP, .JUMP.==1
	IFE .OPCD.-AOJ, .JUMP.==1
	IFE .OPCD.-SOJ, .JUMP.==1
	IFE .JUMP.,[			; skip - code it followed by JRST
		COND
		JRST TAG
		]
	IFN .JUMP.,[			; jump - alter sense of last instr (the jump)
	    IRPW CND,,[COND]
		IFN .IRPCNT-.ICNT., CND
		.ELSE <<CND>#.CRGL.>+TAG
	    TERMIN
	      ]
TERMIN

;;; Iteration Macros

DEFINE WHILE COND,BODY\EAT,BTAG,ETAG
    DEFINE EXITLOOP
	JRST ETAG
    TERMIN
BTAG:	.COND. [COND]ETAG
	BODY
	JRST BTAG
ETAG:
	.XCREF BTAG,ETAG,EXITLOOP
TERMIN

DEFINE UNTIL COND,BODY\EAT,BTAG,ETAG
    DEFINE EXITLOOP
	JRST ETAG
    TERMIN
BTAG:	BODY
	.COND. [COND]BTAG
ETAG:
	.XCREF BTAG,ETAG,EXITLOOP
TERMIN

;;; If - Then - Else Macros

DEFINE IF COND,THENCLAUSE\EAT,TAG
DEFINE .IFTG.
TAG==.
TERMIN			;remember TAG for redefinition

	.COND. [COND]TAG	;if false, skip THEN clause
	THENCLAUSE
TAG==.
TERMIN

DEFINE ELSE ELSECLAUSE\EAT,TAG
	JRST TAG		;make THEN clause skip ELSE clause
.IFTG.				;redefine tag generated by IF
	ELSECLAUSE
TAG:
TERMIN

DEFINE ELSEIF COND,THENCLAUSE
	ELSE [IF [COND][THENCLAUSE]]
TERMIN

;;; System-Call Macro.

DEFINE .CALL PROC,IN,OUT,CTLB
	;COUNT ARGUMENTS
	.CLST.==0
	.CLCT. IN
	.CLCT. OUT
	.CLCT. CTLB

043000,,[SETZ
	.1STWD SIXBIT/PROC/
	.CLAG. 4000,CTLB
	.CLAG. 0,IN
	.CLAG. 2000,OUT
	IFN .CLST.,INFORM BAD FORMAT SYSTEM CALL - PROC
]
TERMIN

DEFINE .CLCT. ?A,B,C,D,E,F,G,H		;CROCK DUE TO IRP LOSS
IFNB [A] .CLST.==.CLST.+1
IFNB [B] .CLST.==.CLST.+1
IFNB [C] .CLST.==.CLST.+1
IFNB [D] .CLST.==.CLST.+1
IFNB [E] .CLST.==.CLST.+1
IFNB [F] .CLST.==.CLST.+1
IFNB [G] .CLST.==.CLST.+1
IFNB [H] .CLST.==.CLST.+1
TERMIN

;;; ARGUMENT POINTER GENERATOR FOR ABOVE
;;; A # INDICATES AN IMMEDIATE ARGUMENT

DEFINE .CLAG. BITS?A,B,C,D,E,F,G,H
IFNB [A] .CLG1. BITS,A
IFNB [B] .CLG1. BITS,B
IFNB [C] .CLG1. BITS,C
IFNB [D] .CLG1. BITS,D
IFNB [E] .CLG1. BITS,E
IFNB [F] .CLG1. BITS,F
IFNB [G] .CLG1. BITS,G
IFNB [H] .CLG1. BITS,H
TERMIN

DEFINE .CLG1. BITS?ARG
  .CLST.==.CLST.-1	;COUNT ARGS
  .CLG2.==0
  IRPNC 0,1,-1,CH,REST,[ARG]
    IFE "CH-"#,[ <IFE .CLST.,[400000]+BITS+1000>,,0*"CH+REST
		 .CLG2.==1	;the 0 times is per order rms
		]	;Immediate
    IFE "CH-"?,[ <IFE .CLST.,[400000]+3000>,,0*"CH+REST
		 .CLG2.==1
		]	;Error-code argument
    IFN "CH-40, .ISTOP	;STOP ON FIRST NON BLANK
  TERMIN
  IFE .CLG2., <IFE .CLST.,[400000]+BITS>,,ARG
TERMIN
];END MOBY IF1

;;; Interrupt Facilities

DEFINE INTSET ?Z\IB	;arg is one line per interrupt, usual four things

IB:	P
	IRPW X,,Z
	 IRP Y,,[X]
	  ZZ==.IRPCNT
	  IFN ZZ-4, Y
	  .ELSE [ 0,,[ PUSHJ P, .INTR. ? Y ] ]
	  TERMIN
	 IFN ZZ-4, INFORM ERROR: INTSET - NOT FIVE THINGS - ,[X]
	 TERMIN
	;end interrupt list
	ZZ==.
	LOC 42
	IB-ZZ,,IB
	LOC ZZ

; Interrupt Interface Routine - allows Standard Procedures as handlers

.INTR.:	PUSH P, T		;save temporary registers
	PUSH P, T1
	PUSH P, T0
	EXCH TT, -3(P)		;saves TT and gets call addr
	PUSHJ P, @0(TT)		;invoke handler. Entry seq saves rest of regs
	POP P, T0		;restore regs
	POP P, T1
	POP P, T
	POP P, TT
	.CALL DISMISS,P		;and dismiss interrupt

TERMIN


;;; End of CALRET
