Enter your search terms Submit search form
	Web pdp-10.trailing-edge.com

COMMENT * SIMULA specification;
OPTIONS(/E:CODE,filcopy);
INTEGER PROCEDURE filcopy(source,dest);
REF(Infile)source; TEXT dest;
COMMENT Copies source to dest block by block.
Works only with disk files. Unlike ordinary SIMULA I/O, creation
date will be preserved, also any version number (.RBVER).
Direct buffer-to-buffer copy, no intermediary Image.
Result is -1 if copying succeded, otherwise zero (or 2 if some file
is not on disk).
;

!*;! MACRO-10 code !*;!

	TITLE	filcopy
	ENTRY	filcopy
	SUBTTL	SIMULA utility, Lars Enderin Dec 1977

;!*** Copyright 1977 by the Swedish Defence Research Institute. ***
;!*** Copying is allowed.					***


	sall
	search	simmac,simmcr,simrpa
	macinit

	;! Local definitions ;!

	source==XWAC11
	dest==XWAC1
	result==2
	sourcof==result+1
	destoff==sourcof+1
	sbuf==XWAC5
	dbuf==XWAC6
	size==XWAC7
	nw==XWAC10

filcopy:PROC
	L	XWAC1,sourcof(XCB)
	SETZB	XWAC2,XWAC3
	XEC	IOOP			;! source.Open(NOTEXT)
	XEC	CPNE			;! dest:- NEW Outfile(destspec)
	 XWD	0,IOOU
	L X2,[1B<%ZFIFND>+1B<%ZFINLE>] ;! No error dialogue, no enter
	IORM X2,OFFSET(ZFINLE)(dest)
	LD	X0,destoff(XCB)		;! Plant "NAME" parameter
	STD	X0,2(dest)
	L	source,sourcof(XCB)
	IF	;! Source is a DSK file
		IFOFF ZFIDSK(source)
		GOTO FALSE
	THEN	;! Take mode from LOOKUP block
		LF X2,ZFIFIL(source)
		LDB [POINT 4,2+.RBPRV(X2),12] ;! RB.MOD
		CAIL .IODPR
		 LI .IOBIN	;! Cannot handle dump mode in RTS OPEN
	ELSE
		SETZ
	FI
	SF	,ZFIDMO(XWAC1)
	
	XEC	CSEN			;! Initialize file object
	SKIPL	OFFSET(ZIFEND)(dest)
	 GOTO	L8			;! Error occurred
	L	source,sourcof(XCB)
	ST	dest,destoff(XCB)

	IF ;! Either file is not a DSK file
	   IFOFF ZFIDSK(source)
	   GOTO TRUE
	   IFON ZFIDSK(dest)
	   GOTO FALSE
	THEN
	   OUTSTR [ASCIZ/
%FILCOPY error, handles only disk to disk copy
/]
	   LI  2
	   GOTO L10
	FI
	LF	X1,ZFIFIL(dest)		;! X1:- ZXB of dest
	LF	X2,ZFIFIL(source)	;! X2:- ZXB of source
	LF	,ZXBP2(X2)		;! Source file path
	IF	;! Non-zero source path
		JUMPE	FALSE
	THEN	;! Replace zero dest path
		SKIPN	OFFSET(ZXBP2)(X1)
		 SF	,ZXBP2(X1)
	FI
	LF	,ZXBFIL(X2)		;! File name
	SF	,ZXBFIL(X1)
	WLF	,ZXBEXT(X2)		;! Extension
	TLNN	-1			;! No extension given for dest
	 HLL	OFFSET(ZXBEXT)(X1)	;! EXT from source as default
	WSF	,ZXBEXT(X1)
	HLLZ	XIAC,OFFSET(ZXBPRT)(X1) ;! Protection always from dest
	TLZ	XIAC,777
	WLF	,ZXBPRT(X2)
	TLZ	(777B8)
	IOR	XIAC
	WSF	,ZXBPRT(X1)
	LF	,ZXBALC(X2)		;! True allocation
	SF	,ZXBLEN(X1)		;! Make it an estimate for dest
	ZF	ZXBALC(X1)		;! Do not insist on it
	WLF	,ZXBP2(X1)
	IF	JUMPE	FALSE
	THEN	TLNN	-1
		 ADDI	2		;! Adjust path block addr
		WSF	,ZXBP2(X1)
	FI
	ADDI	X1,2			;! Adjust ENTER block addr
	L	2+.RBVER(X2)		;! Version
	ST	.RBVER(X1)
	L	2+.RBSPL(X2)		;! Spooling name
	ST	.RBSPL(X1)
	HLL	X1,OFFSET(ZFICHN)(dest) ;! Channel for dest
	TLO	X1,(ENTER)		;! Make ENTER UUO
	XCT	X1
	 GOTO	L8			;! ENTER failed
	SETZB	XWAC2,XWAC3
	XEC	IOOP			;! dest.Open(NOTEXT)
	L	source,sourcof(XCB)
	LF	X1,ZFIFIL(source)	;! ENTER blk ptr
	L	size,2+.RBSIZ(X1)	;! Size of file (words)
	HLLZ	OFFSET(ZFICHN)(source)
	TLO	(IN)			;! IN sourcechannel,
	HLLZ	X1,OFFSET(ZFICHN)(dest)
	TLO	X1,(OUT)		;! OUT destchannel,
	LF	sbuf,ZFIIBH(source)	;! source buffer header addr
	LF	dbuf,ZFIOBH(dest)	;! dest ..
	LOOP	;! Through all blocks of source file
		XCT			;! IN sourcechannel,
		 GOTO	L6	;! Ok
		IF	;! EOF
			HRRI	740000
			HLL	OFFSET(ZFICHN)(source)
			TLO	(STATZ)
			XCT
			 GOTO	FALSE
		THEN	;! Copying finished
			GOTO	L9
		ELSE	;! Error
			GOTO	L8
		FI
L6():!		;! Prepare for BLT of source buf to dest buf
		HRLZ	XIAC,OFFSET(ZBHZBU)-1(sbuf)
		HRR	XIAC,OFFSET(ZBHZBU)-1(dbuf)
		ADD	XIAC,[2,,2]	;! Move only data
		LI	nw,200		;! Buffer size
		SUBI	size,200
		IF	;! No more full buffer
			JUMPGE size,FALSE
		THEN	;! nw:= actual count of words left
			LI nw,200(size)
		FI
		ADDI	nw,-1(XIAC)	;! Address of last dest buf word
		BLT	XIAC,(nw)	;! Move buffer contents
		HRRM	nw,OFFSET(ZBHBUP)-1(dbuf) ;! Adjust byte ptr
		XCT	X1		;! Output to dest
		 GOTO	L7		;! OK
		GOTO	L8
L7():!
	AS
		JUMPG	size,TRUE
	SA
	GOTO	L9
L8():!	TDZA	;! ERROR return
L9():!	SETO	;! OK return
L10():!	ST	result(XCB)
	XEC	IOCL			;! dest.Close
	L	XWAC1,sourcof(XCB)
	XEC	IOCL			;! source.Close
	BRANCH	CSEP			;! Return
	EPROC
	LIT
	END;