Enter your search terms Submit search form
	Web pdp-10.trailing-edge.com

	title	gtbufa - routines to cope with f77 character variables
	search	crcsym,macsym,monsym
	entry	gtascz,ptspac,gtbufa,ptbufa
	external gtbypt,chunw.,chmrk.,%chalc
;
;call GTASCZ from MACRO with argument offset in t1
;	returns	t1	byte pointer to an asciz string
;	trashes t1 to q2
;
;call GTBUFA from MACRO with argument offset in t1
;	returns	t1	byte pointer
;		t2	length in characters
;	trashes t1-t2 and q1-q2
;
;PTBUFA called with argument offset in t1
;	copies string from the f77 scratch area to user's area
;		and releases space from the scratch area
;	trashes t1 to q2
;
;MARK	called with no arguments
;       marks the scratch space
;	saves t1
;
;PTSPAC called with no arguments
;	releases space from the f77 scratch area.
;
;	forarg	<arg1,arg2>		;define argument offsets
;fill:	movx	t1,arg1			;want the first arg, o/p arg
;	call	gtbufa			;copy to f77 scratch space
;	...
;	movx	t1,arg2
;	call	gtascz			;get arg2 as asciz, i/p arg
;
;	do something here ...
;
;	movx	t1,arg1			;want the first arg
;	call	ptbufa			;copy out, and release scratch space
;	ret
;
;
;set up the block of accumulators for the movslj instruction
;
;		_________________________________
; slen	t1	| 000	| source string length	|
; sptr	t2	|{	source string byte ptr }|
;	t3	|{			       }|
; dlen	t4	| 000	| dest. string length	|
; dptr	q1	|{	dest. string byte ptr. }|
;	q2	|{			       }|
;		---------------------------------
slen==1		;give alternative names to registers	;source length
sptr==2		;for movcha macro (movslj) to use	;source pointer
dlen==4		;also movst instruction			;destination length
dptr==5							;destination pointer
;
;	data area for arg block and saved info
;
	-1,,0
m:	ifiw	2,savssm		;arg block for chmrk. and chunw.
savssm:	block	1			;storage for the string stack marker
savsbd:	block	1			;and scratch byte descriptor
;
gtascz:	call	gtbypt			;get a byte pointer to it, may be f77
	cain	t2,0			;no length if f66
	 ret				;...yes do nothing, use "as is".
	call	mark			;mark the scratch area
	move	q1,t2			;get the string length
	aoj	q1,			;add 1 to length for a null
	call	%chalc			;allocate space for it
	push	p,q2			;save byte pointer
	dmovem	q1,dlen			;put o/p descriptor in place
	exch	slen,sptr		;put the i/p byte pointer in place
	movcha	slen,0			;move and fill with nulls
	pop	p,t1			;restore byte pointer
	ret
;
;	get a byte pointer to output area for characters, f66 or f77
;
gtbufa:	call	gtbypt			;get a byte pointer to it, may be f77
	cain	t2,0			;no length if f66
	 ret				;...yes do nothing, use "as is".
	call	mark			;mark the scratch area
	move	q1,t2			;get the string length
	call	%chalc			;allocate space for it
	movem	q2,savsbd		;save scratch byte descriptor
	dmovem	q1,t1			;put the string length back
	exch	t1,t2			;put the byte pointer in place
	ret
;
ptbufa:	call	gtbypt			;get a byte pointer to it, may be f77
	cain	t2,0			;no length if f66
	 ret				;...yes do nothing, as string ok already
	exch	slen,sptr		;get the right way round for movst.
	dmove	dlen,slen		;get destination from gtbypt.
	move	sptr,savsbd		;get the saved scratch byte descriptor
;**	setz	slen,			;clear the length
;
;move string using crtab as the translation table, which terminates on null
;
	txo	slen,1b0		;set the bit S, (start translation)
	extend	slen,[	movst	0,crtab	;move string translated, stop on null
				" "]	;fill with blanks
	 nop				;ignore truncation
	jumpe	dlen,done		;is any destination left ?
	setz	slen,			;clear length to stop source, blank fill
	movcha	slen			;move the non-string, blank filling
done:	call	ptspac			;release space from scratch area
	ret
;
;	mark the scratch area, if it hasn't been already
;
mark:	skipe	savssm			;have we marked the scratch area
	 ret				;yes, don't repeat
	push	p,t1			;save t1
	push	p,cx			;save arg pointer
	xmovei	cx,m			;get new arg block
	call	chmrk.			;get f77 to mark the string stack
	pop	p,cx			;restore arg pointer
	pop	p,t1			;restore t1
	ret
;
;	return scratch area, as first marked
;
ptspac:	skipn	savssm			;have we marked the scratch area
	 ret				;no, don't release
	push	p,cx			;save arg pointer
	xmovei	cx,m			;get the arg block
	call	chunw.			;get f77 to unwind the string stack
	pop	p,cx			;restore arg pointer
	setzm	savssm			;clear the marker
	ret
;
;move string translation table, which terminates on null
;
	code==2
crtab:	100000,,1			;terminate on null, ^A is o.k.
	repeat ^d63,<			;translation table
	code,,code+1			;these characters remain the same
	code==code+2 >			;^B to delete

	end