perm filename SPACES[S,AIL] blob sn#000844 filedate 1970-06-06 generic text, type T, neo UTF8
00100	
00200	
00300	TITLE SPACES
00400	
00500	INTERNAL SPACES
00600	
00700	EXTERNAL CVS,OUTSTR,GOGTAB
00800	
00850	A←1 ↔ B←2 ↔ C←3 ↔ D←4
00900	
01000	
01100	PRIT:	PUSH	P,A		;NUMBER TO BE PRINTED.
01200		TTCALL	3,(B)		;PRINT MESSAGE.
01300		PUSHJ	P,CVS
01400		PUSHJ	P,OUTSTR
01500		TERPRI	<>		;AND A CARRAIGE RETURN.
01600		POPJ	P,
01700	
01800	DEFINE RFS ' (Q) <
01900		MOVEI	B,[ASCIZ /Q' = /]
02000		PUSHJ	P,PRIT
02100	>
02200	
02300	
02400	SPACES: MOVE	USER,GOGTAB
02500		SKIPN	C,FRELST(USER)
02600		JRST	FRED		;ALL DONE.
02650		MOVEI	A,0
02700	FF:	ADD	A,1(C)		;ADD UP ALL FREE SPACE.
02800		HRRZ	C,(C)
02900		JUMPN	C,FF
03000		RFS	(CORE FREE STORAGE)
03100	FRED:	HRRZ	C,ARRPDP(USER)	;ARRAY STACK.
03200		SKIPN	C
03300		JRST	FREARR
03400		SETZB	A,D
03500	ARS1:	CAMGE	C,ARRPDL(USER)	;DONE?
03600		JRST	PRINQ
03700		SKIPGE	B,(C)		;STACK MARKER?
03800		SOJA	C,ARS1
03900		HRRZ	LPSA,-2(B)	;→ FIRST DATA WORD
04000		SKIPL	-1(LPSA)
04100		 JRST	[SUB A,-1(B)
04200			 SOJA C,ARS1]
04300		SUB	D,-1(B)
04400		SOJA	C,ARS1
04500	PRINQ:	JUMPE	A,PRINQ1
04700		RFS	(ARITHMETIC ARRAYS)
04800	PRINQ1:	JUMPE	D,NOARR
04900		MOVE	A,D
05000		RFS	(STRING ARRAYS)
05100	
05200	NOARR:
05250	FREARR:
05300		SKIPN	D,ARYLS(USER)	;LEAP ARRAYS?
05400		 JRST	 NOLEQ
05500		SETZM	A
05600	A11:	MOVE	B,1(D)
05650		SUB	A,-1(B)		;LENGTH.
05700		HRRZ	D,(D)
05800		JUMPN	D,A11
05900		RFS	(ARRAY DATUMS)
06000	NOLEQ:
06100	
06200		MOVE	A,STTOP(USER)
06300		SUB	A,ST(USER)
06350		PUSH	P,A			;SAVE
06400		RFS	(STRING SPACE)
06500	
06600	;NOW FOR A RANDOM OTHER MESSAGE.
06700	
06800		HLRE	A,ARRPDP(USER)
06900		MOVNS	A
07000		ADD	A,ARRPDP(USER)
07100		HRRZS	A
07200		SUB	A,GOGTAB		;BOTTOM
07300		SUB	A,(P)			;STRING SPACE IS IN THERE.
07400		RFS	(STACKS ETC)
07500	
07600		POP	P,(P)
07700		POPJ	P,
07800	
07900	
08000	END