Trailing-Edge
-
PDP-10 Archives
-
decuslib10-05
-
43,50337/23/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;