; -*- Midas -*-

title MacITS - Library of MacLisp/ITS interface routines

.fasl

if1, .insrt sys:.fasl defs

maxpush==10			; Largest n for which 0PUSH-n will work.

; (%GETSYS name) returns a list of fixnums representing the data returned by
; .GETSYS for SIXBIT /name/.
.entry %GETSYS SUBR 2		; 1 arg
	pushj p,sixmak		; TT: sixbit argument
	move r,tt		; R=D+1: area name
	setzi a,		; A: accumulate list of answers
	jsp t,0push-maxpush	; Make room for data area on FXPDL
	hrrzi d,1-maxpush(fxp)
	hrli d,-maxpush		; D: aobjn to data area
	.getsys d,
	 jrst getsy2
	subi d,1-maxpush(fxp)	; RH(D): # of words of data
	hlre tt,d
	imul tt,[-<1,,1>]
	sub fxp,tt		; Discard extra words from FXPDL
	hrrzi f,(d)		; F: # of words of data
	jumple f,cpopj		; No words => all done
getsy1:	movei b,(a)
	pop fxp,tt
	jsp t,fxcons
	jsp t,%cons
	sojg f,getsy1
	popj p,

getsy2:	sub fxp,r70+maxpush
	jumpe r,cpopj
	hlre tt,d		; TT: -# words needed
	movn f,tt		; F: # words delivered
	push fxp,[0]		; allocate that many on FXPDL
	aojl tt,.-1
	.getsys d,
	 .lose			; Can't happen.
	jrst getsy1

; (%EVAL name) looks up the name in Exec DDT's symbol table.  Returns NIL
; if the symbol isn't found.
.entry %EVAL SUBR 2		; 1 arg
	pushj p,squeeze
	.eval tt,
	 tdza a,a
	  jrst fix1
	popj p,

; (%GETLOC addr) return the contents addr in the system.
.entry %GETLOC SUBR 2		; 1 arg
	push p,cfix1		; NCALLable
	jsp t,fxnv1
	hrlzi t,(tt)
	hrri t,tt
	.getloc t,
	popj p,

; (%SIXBIT name) returns a number.
.entry %SIXBIT SUBR 2		; 1 arg
	push p,cfix1		; NCALLable
	jrst sixmak

; (%UNSIXBIT num) returns a symbol.
.entry %UNSIXBIT SUBR 2		; 1 arg
	jsp t,fxnv1
	jrst sixatm

;  SQUOZE			 SIXBIT
;  0
;  1 - 12	"0" - "9"	20 - 31
; 13 - 44	"A" - "Z"	41 - 72
; 45		"*"		12
; 46		"$"		04
; 47		"%"		05

; (%SQUOZE name) returns a number.
.entry %SQUOZE SUBR 2		; 1 arg
	push p,cfix1		; NCALLable
	jrst squeeze

; (%UNSQUOZE num) returns a symbol.
; Works by converting to SIXBIT because MacLisp lacks a built-in routine to
; do this properly.
.entry %UNSQUOZE SUBR 2		; 1 arg
	jsp t,fxnv1
	ldb d,[004000,,tt]	; D: squoze number less flags
	setzi f,
unsqu1:	idivi d,50
	jumpe r,unsqu3
	cail r,45
	 jrst unsqu2
	addi r,'A-13
	caige r,'A
	 subi r,<'A-1>-'9
unsqu3:	lshc r,-6
	jumpn d,unsqu1
	move tt,f
	jrst sixatm

unsqu2:	subi r,45-'*
	caie r,'*
	 subi r,<'*+1>-'$
	jrst unsqu3

fasend