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;