;; SYSCAL macro.


; from EAK;MACROS >
; macro to reserve space in variables section
; VAR FOO reserves 1 word of space for FOO
; VAR BAR(N) reserves n words of space for BAR
define	var x
irps a,b,[x]
  ifse b,(,	.vector x
  .else		.scalar x
  .istop
  termin
termin


ifndef loss,loss=.lose 1400	   ;default thing to do when you lose

cnt==4000,,0			;control
cnti==5000,,0			;control immediate
errret==3000,,0			;error return
argi==1000,,0			;immediate argument
val==2000,,0			;value return

;; From RWK;EMPTY >

DEFINE SYSCAL A,B,C=<debug"calerr>
	.CALL [SETZ ? SIXBIT/A/ ? B ? setz+errret+c] TERMIN

var debug"calerr



define .pure
ifn syscal".pure.,.err Two .PURE's without a corresponding .UPURE
syscal".pure.==-1
syscal"..unpr==.
loc syscal"..pure
termin

define .upure
ife syscal".pure.,.err Two .UPURE's without a correspponding .PURE
syscal".pure.==0
syscal"..pure==.
loc syscal"..unpr
termin


ifndef .M".purpg,.M".purpg==1	   ;# of first pure page
syscal"..unpr==100
syscal"..pure==2000*.m".purpg
syscal".pure.==0		   ;initially allocating impure

;; Macro to check for overlap of pure and impure
define .perch
define .pch. xx,yy,zz
printc \
Impure storage from 0 to yy
Pure storage from xx to zz
\
termin
.pch. \.m".purpg*2000,\syscal"..unpr,\syscal"..pure
ifl .M".purpg*2000-syscal"..unpr,.err UNPURE overlaps with PURE
termin

define norm7 c			   ;normallize a 7-bit byte pointer
       skipge c
         sub c,[430000,,1]
termin

define decbp c			   ;decrement byte pointer
	add c,[70000,,]		   ;back up the byte pointer
	skipge c		   ;did we cross a word boundary?
	  sub c,[430000,,1]	   ;then fix it
termin

define decbp6 c			   ;decrement byte pointer
	add c,[60000,,]		   ;back up the byte pointer
	skipge c		   ;did we cross a word boundary?
	  sub c,[440000,,1]	   ;then fix it
termin

;;; This macro takes two arguments, the first is a starting location in
;;; memory, and the second is a # of characters after that.
;;; It returns the BP that you'd get after that # of IDPB's into that buffer
define bpend buf,ln
<<000700+<<<<5-<ln-<ln/5>*5>>*7>+1>_14>>,,<buf+<ln/5>>> termin

define upper chr		   ;uppercase a character
	cail chr,141		   ;lower "a"
	  caile chr,172		   ;lower "z"
	    caia		   ;if got here, it's not lower a-z, skip
	    subi chr,40		   ;convert case
termin

define curpos vert,horz		   ;move cursor to absolute position
	.iot tyoc,[^P]
	.iot tyoc,["V]
	movei 0,-1(vert)
	.iot tyoc,0
	.iot tyoc,[^P]
	.iot tyoc,["H]
	movei 0,-1(horz)
	.iot tyoc,0
termin

ifndef $type,$type=0		   ;default
ifn $TYPE,[
define type chan=tyoc,&STRING
	push sp,[outspc chan,string]
	call syscal"typer
	pop sp,
termin

define error &mesage
	push sp,[outspc dspc,mesage]
	call syscal"typer
	pop sp,errmsg
termin

define outspc chan,&string
	<<chan_16>+<.length string>>,,[asciz string]
termin

.begin syscal
.pure
typer:	push sp,a
	push sp,b
	push sp,c
	hrlzi a,440700
	hrr a,-4(sp)
	ldb b,[221600,,-4(sp)]
	movem b,siotct
var .M"SIOTCT
	ldb c,[400400,,-4(sp)]
	syscal siot,[c ? a ? siotct]
	  .lose 1400
	pop sp,c
	pop sp,b
	pop sp,a
	ret
.upure
.end syscal
]


define	do stuff,else,\label
define ddoo exit
	jrst [stuff
jrst label]
!else!

label::
termin

ddoo <jrst label>

termin


define tabdef name
	define name cruft
	 cruft
	termin

define a!name more
	 name [define name cruft
			cruft
			more]
		termin
	 termin
termin

;;; basic definitions
pjrst==jrst			   ;for pushj sp, ? popj sp, sequences.
call=pushj sp,
ret=popj sp,

;;; macros to evaluate system symbols and locations

define seval a,b		;get value of symbol B in A
	move a,[squoze 0,/b/]
	.eval a,
	  loss
termin

define eval a,b
	seval a,b
	hrl a,a			;move to left
	hrri a,a		;destination is a
	.getloc a,		;get it into a
termin				;done!

define pcall routin,args
	push sp,args
	call routin
	pop sp,x
termin
