	.TITLE	STRBLD		
; JEFFREY KODOSKY	ARL	NOV75
;
; UTILITY:	STRING ATOM BUILDER
; ENTRY:	R3 POINTS TO .ASCIZ STRING
; EXIT:		1 ARG		<STR>
;		R3 POINTS TO BYTE FOLLOWING ZERO BYTE
; ERRORS:	NONE
; CALLS:	GETC, FETCH A FREE CELL
; R2 PRESERVED
	.GLOBL	STRBLD,QGETC
STRBLD:	QGETC		;FETCH A CELL FOR HEADER
	MOV	@R5,R0
	MOV	R0,-(R5);STORE POINTER TO CAR IN ORDER TO CHAIN
	CLR	(R0)+	;(CAR SHOULD ALREADY BE CLEAR)
	MOV	#3,@R0	;LOAD STRING FLAG BITS
STR01:	MOVB	(R3)+,-(SP)	;FETCH A CHARACTER
	BEQ	STR03
	MOVB	(R3)+,1(SP)	;IF MORE FETCH ANOTHER
	BNE	STR02	;IF NOT THEN BACK UP SO THAT WE'LL
	DEC	R3	;END ON AN EVEN BYTE
STR02:	QGETC		;ENOUGH TO FILL A NEW CELL, FETCH ONE
	MOV	(R5)+,R0;POP THE NEW CELL
	BIS	R0,@(R5)+	;POP THE OLD CELL STORING POINTER
	MOV	R0,-(R5);TO NEW ONE IN CAR AND SAVE NEW CELL
	MOV	#2,(R0)+;SET DATA BIT
	MOV	(SP)+,@R0	;LOAD TWO CHARACTERS
	BR	STR01
STR03:	CMP	(R5)+,(SP)+	;POP OPEN CDR AND ZERO BYTE
	JMP	@-(R4)	;RETURN A NEW STRING ATOM
	.END
                              