Google
 

Trailing-Edge - PDP-10 Archives - decuslib20-03 - decus/20-0078/libsim/filcop.mac
There are 2 other files named filcop.mac in the archive. Click here to see a list.
00100	COMMENT * SIMULA specification;
00200	OPTIONS(/E:CODE,filcopy);
00300	INTEGER PROCEDURE filcopy(source,dest);
00400	REF(Infile)source; TEXT dest;
00500	COMMENT Copies source to dest block by block.
00600	Works only with disk files. Unlike ordinary SIMULA I/O, creation
00700	date will be preserved, also any version number (.RBVER).
00800	Direct buffer-to-buffer copy, no intermediary Image.
00900	Result is -1 if copying succeded, otherwise zero (or 2 if some file
01000	is not on disk).
01100	;
01200	
01300	!*;! MACRO-10 code !*;!
01400	
01500		TITLE	filcopy
01600		ENTRY	filcopy
01700		SUBTTL	SIMULA utility, Lars Enderin Dec 1977
01800	
01900	;!*** Copyright 1977 by the Swedish Defence Research Institute. ***
02000	;!*** Copying is allowed.					***
02100	
02200	
02300		sall
02400		search	simmac,simmcr,simrpa
02500		macinit
02600	
02700		;! Local definitions ;!
02800	
02900		source==XWAC11
03000		dest==XWAC1
03100		result==2
03200		sourcof==result+1
03300		destoff==sourcof+1
03400		sbuf==XWAC5
03500		dbuf==XWAC6
03600		size==XWAC7
03700		nw==XWAC10
03800	
03900	filcopy:PROC
04000		L	XWAC1,sourcof(XCB)
04100		SETZB	XWAC2,XWAC3
04200		XEC	IOOP			;! source.Open(NOTEXT)
04300		XEC	CPNE			;! dest:- NEW Outfile(destspec)
04400		 XWD	0,IOOU
04500		L X2,[1B<%ZFIFND>+1B<%ZFINLE>] ;! No error dialogue, no enter
04600		IORM X2,OFFSET(ZFINLE)(dest)
04700		LD	destoff(XCB)		;! Plant "NAME" parameter
04800		STD	2(dest)
04900		L	source,sourcof(XCB)
04910		IF	;! Source is a DSK file
04920			IFOFF ZFIDSK(source)
04930			GOTO FALSE
04940		THEN	;! Take mode from LOOKUP block
04950			LF X2,ZFIFIL(source)
04960			LDB [POINT 4,2+.RBPRV(X2),12] ;! RB.MOD
04962			CAIL .IODPR
04964			 LI .IOBIN	;! Cannot handle dump mode in RTS OPEN
04970		ELSE
04980			SETZ
04990		FI
04995		SF	,ZFIDMO(XWAC1)
05090		
05200		XEC	CSEN			;! Initialize file object
05300		SKIPL	OFFSET(ZIFEND)(dest)
05400		 GOTO	L8			;! Error occurred
05500		L	source,sourcof(XCB)
05600		ST	dest,destoff(XCB)
05700	
05800		IF ;! Either file is not a DSK file
05900		   IFOFF ZFIDSK(source)
06000		   GOTO TRUE
06100		   IFON ZFIDSK(dest)
06200		   GOTO FALSE
06300		THEN
06400		   OUTSTR [ASCIZ/
06500	%FILCOPY error, handles only disk to disk copy
06600	/]
06700		   LI  2
06800		   GOTO L10
06900		FI
07000		LF	X1,ZFIFIL(dest)		;! X1:- ZXB of dest
07100		LF	X2,ZFIFIL(source)	;! X2:- ZXB of source
07200		LF	,ZXBP2(X2)		;! Source file path
07300		IF	;! Non-zero source path
07400			JUMPE	FALSE
07500		THEN	;! Replace zero dest path
07600			SKIPN	OFFSET(ZXBP2)(X1)
07700			 SF	,ZXBP2(X1)
07800		FI
07900		LF	,ZXBFIL(X2)		;! File name
08000		SF	,ZXBFIL(X1)
08100		WLF	,ZXBEXT(X2)		;! Extension
08200		TLNN	-1			;! No extension given for dest
08300		 HLL	OFFSET(ZXBEXT)(X1)	;! EXT from source as default
08400		WSF	,ZXBEXT(X1)
08500		HLLZ	XIAC,OFFSET(ZXBPRT)(X1) ;! Protection always from dest
08600		TLZ	XIAC,777
08700		WLF	,ZXBPRT(X2)
08800		TLZ	(777B8)
08900		IOR	XIAC
09000		WSF	,ZXBPRT(X1)
09100		LF	,ZXBALC(X2)		;! True allocation
09200		SF	,ZXBLEN(X1)		;! Make it an estimate for dest
09300		ZF	ZXBALC(X1)		;! Do not insist on it
09400		WLF	,ZXBP2(X1)
09500		IF	JUMPE	FALSE
09600		THEN	TLNN	-1
09700			 ADDI	2		;! Adjust path block addr
09800			WSF	,ZXBP2(X1)
09900		FI
10000		ADDI	X1,2			;! Adjust ENTER block addr
10010		L	2+.RBVER(X2)		;! Version
10020		ST	.RBVER(X1)
10030		L	2+.RBSPL(X2)		;! Spooling name
10040		ST	.RBSPL(X1)
10100		HLL	X1,OFFSET(ZFICHN)(dest) ;! Channel for dest
10200		TLO	X1,(ENTER)		;! Make ENTER UUO
10300		XCT	X1
10400		 GOTO	L8			;! ENTER failed
10500		SETZB	XWAC2,XWAC3
10600		XEC	IOOP			;! dest.Open(NOTEXT)
10700		L	source,sourcof(XCB)
10800		LF	X1,ZFIFIL(source)	;! ENTER blk ptr
10900		L	size,2+.RBSIZ(X1)	;! Size of file (words)
11000		HLLZ	OFFSET(ZFICHN)(source)
11100		TLO	(IN)			;! IN sourcechannel,
11200		HLLZ	X1,OFFSET(ZFICHN)(dest)
11300		TLO	X1,(OUT)		;! OUT destchannel,
11400		LF	sbuf,ZFIIBH(source)	;! source buffer header addr
11500		LF	dbuf,ZFIOBH(dest)	;! dest ..
11600		LOOP	;! Through all blocks of source file
11700			XCT			;! IN sourcechannel,
11800			 GOTO	L6	;! Ok
11900			IF	;! EOF
12000				HRRI	740000
12100				HLL	OFFSET(ZFICHN)(source)
12200				TLO	(STATZ)
12300				XCT
12400				 GOTO	FALSE
12500			THEN	;! Copying finished
12600				GOTO	L9
12700			ELSE	;! Error
12800				GOTO	L8
12900			FI
13000	L6():!		;! Prepare for BLT of source buf to dest buf
13100			HRLZ	XIAC,OFFSET(ZBHZBU)-1(sbuf)
13200			HRR	XIAC,OFFSET(ZBHZBU)-1(dbuf)
13300			ADD	XIAC,[2,,2]	;! Move only data
13400			LI	nw,200		;! Buffer size
13500			SUBI	size,200
13600			IF	;! No more full buffer
13700				JUMPGE size,FALSE
13800			THEN	;! nw:= actual count of words left
13900				LI nw,200(size)
14000			FI
14100			ADDI	nw,-1(XIAC)	;! Address of last dest buf word
14200			BLT	XIAC,(nw)	;! Move buffer contents
14300			HRRM	nw,OFFSET(ZBHBUP)-1(dbuf) ;! Adjust byte ptr
14400			XCT	X1		;! Output to dest
14500			 GOTO	L7		;! OK
14600			GOTO	L8
14700	L7():!
14800		AS
14900			JUMPG	size,TRUE
15000		SA
15100		GOTO	L9
15200	L8():!	TDZA	;! ERROR return
15300	L9():!	SETO	;! OK return
15400	L10():!	ST	result(XCB)
15500		XEC	IOCL			;! dest.Close
15600		L	XWAC1,sourcof(XCB)
15700		XEC	IOCL			;! source.Close
15800		BRANCH	CSEP			;! Return
15900		EPROC
16000		LIT
16100		END;