Google
 

Trailing-Edge - PDP-10 Archives - decuslib20-04 - decus/20-0135/comp/filist.mac
There are 3 other files named filist.mac in the archive. Click here to see a list.
00100	COMMENT * filist, SIMULA specification;
00200	OPTIONS(/E:QUICK,filist);
00300	PROCEDURE filist(inf,outf,count,breakchar);
00400	NAME count, breakchar;
00500	REF(Infile)inf; REF(Outfile)outf;
00600	INTEGER count, breakchar;
00700	COMMENT Copies characters from INF to OUTF, counting down COUNT
00800	by one for each line feed copied. The returned value of COUNT is
00900	interpreted as follows:
01000	COUNT = 0: The initial COUNT of line feeds has been copied.
01100	BREAKCHAR = next non-null character or -1 on EOF.
01200	COUNT > 0: FILIST returned after finding a  control  character  other
01300	than  LF,  TAB  or CR, or after reaching End Of File. Null characters
01400	are ignored. BREAKCHAR will contain the control character,  which  is
01500	NOT  copied to the output file. End of file gives BREAKCHAR = -1. The
01600	value of COUNT is the remaining number  of  line  feeds  out  of  the
01700	initial COUNT.
01800	Special case: If OUTF == NONE, no output will be done.
01900	;
02000	
02100	!*;! MACRO-10 code !*;!
02200	
02300		TITLE	filist
02400		ENTRY	filist
02500		SUBTTL	SIMULA utility, Lars Enderin Jan 1979
02600	
02700	;!*** Copyright 1979 by the Swedish Defence Research Institute. ***
02800	;!*** Copying is allowed.					***
02900	
03000	
03100		sall
03200		search	simmac,simmcr,simrpa
03300		macinit
03400	
03500		;! Local definitions ;!
03600	
03700	inf==XWAC1
03800	outf==XWAC2
03900	count==outf+1
04000	breakchar==count+2
04100	xob==XBH+1
04200	breakad==xob+1
04300	outpad==breakad+1
04400	savchar==outpad+1
04500	cnt==OFFSET(ZBHCNT)
04600	bup==OFFSET(ZBHBUP)
04700	
04800	filist:	PROC
04900		LI breakad,(breakchar+1)
05000		ADDI breakad,(breakchar)
05100		SETZ savchar,
05200		EXCH savchar,(breakad)	;! savchar:= breakchar;! breakchar:= 0
05300		LF XBH,ZFIIBH(inf)	;! Buffer header address
05400		SUBI XBH,1		;! for input file
05500		ADDI count+1,(count)	;! Abs addr for count variable
05600		L count,(count+1)	;! Initial value of count
05700		IF	;! count <= 0
05800			JUMPG count, FALSE
05900		THEN	;! Error
06000			OUTSTR [ASCIZ/
06100	?FILIST error, count <= 0
06200	/]
06300			RTSERR QDSCON,214
06400		FI
06500		IF	;! outf =/= NONE
06600			CAIN outf,NONE
06700			GOTO FALSE
06800		THEN	;! Get buffer header address, real output address
06900			LF xob,ZFIOBH(outf)
07000			SUBI xob,1
07100			LI outpad,L3()
07200			L savchar	;! Get saved character
07300			CAIN QLF	;! IF line feed,
07400			 SOJA count,L3	;! count and output
07500			JUMPN L3	;! otherwise just output if not null
07600		ELSE	;! Another address for "output"
07700			LI outpad,L4()
07800		FI
07900		LOOP
08000	L1():!		SOSGE cnt(XBH)
08100			 GOTO L5()	;! Input buffer exhausted
08200			ILDB bup(XBH)	;! Next character
08300			CAIGE " "	;! Control character?
08400			 CAIN QCR	;! CR is copied directly
08500			  GOTO (outpad)	;! Not a control character
08600			CAIN QHT	;! HT is also directly copied
08700			 GOTO (outpad)
08800			JUMPE L1	;! Ignore null
08900			CAIN QLF
09000			 SOJA count,(outpad) ;! Count LF
09100			ST (breakad)	;! BREAKCHAR:= FF or other
09200			GOTO L2		;! Do not output the character
09300	L3():!		SOSGE cnt(xob)
09400			 GOTO L6()	;! Get a new output buffer
09500			IDPB bup(xob)	;! Place the character in buffer
09600		AS
09700	L4():!		JUMPG count,TRUE
09800		SA
09900		JSP outpad,L1		;! Go find next non-null character
10000		ST (breakad)		;! Save it in BREAKCHAR, do not output
10100	L2():!	ST count,(count+1)	;! Remaining count
10200		RET
10300	
10400	L5():!	;! Read a new buffer
10500		STACK count
10600		SETON	ZFINB(inf)
10700		EXEC	IORB
10800		SETOFF	ZFINB(inf)
10900		UNSTK count
11000		IFOFF	ZFIEND(inf)
11100		 GOTO L1
11200		SETON	ZIFEND(inf)
11300		SETOM (breakad)		;! BREAKCHAR:= -1 on EOF
11400		GOTO L2
11500	
11600	L6():!	;! Get a new output buffer
11700		STACK XBH
11800		STACK XWAC1
11900		STACK count
12000		L XBH,xob
12100		L XWAC1,outf
12200		SKIPG cnt(XBH)
12300		 XEC IONB
12400		UNSTK count
12500		UNSTK XWAC1
12600		UNSTK XBH
12700		GOTO L3
12800		EPROC
12900		LIT
13000		END;