-
Notifications
You must be signed in to change notification settings - Fork 0
/
k11cpy.mac
273 lines (220 loc) · 8.93 KB
/
k11cpy.mac
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
.title K11CPY copy file from input to output
.ident /3.42/
; 03-Feb-84 15:08:54 Brian Nelson
;
; Copyright (C) 1984 Change Software, Inc.
;
; Bob Denny 05-Mar-84 Remove SY: defaulting. Not required, and it
; [RBD01] prevents DECnet (DAP) remote file access to
; VMS and other systems which don't understand
; SY:.
;
; Bob Denny 07-Mar-84 Close input file if output file open fails,
; [RBD02] so copy may be tried again.
;
; Brian Nelson 17-Mar-84 Put back the SY: defaulting for RSTS rms11v2
;
; Brian Nelson 08-Jan-86 Cut buffer size to reduce size
.if ndf, K11INC
.ift
.include /IN:K11MAC.MAC/
.endc
.library /LB:[1,1]RMSMAC.MLB/
.mcall fab$b ,fab$e ,rab$b ,rab$e
.mcall $compar ,$fetch ,$set ,$store
.mcall $connec ,$disco ,$read ,$write
.mcall $close ,$creat ,$open
.mcall ifaof$ ; access the ifab for the fab
ifaof$ rms$l ; get the ifab symbols defined
.psect k11cpy ,rw,d,lcl,rel,con
; Allocate a large buffer for $read and $write
; Also define the FABs and RAB for the copy.
copbfs = 2000 ; nice that RMS in seqeuntial mode
copbuf: .blkb copbfs ; will fix the next blocknumber based
; based on the size of the last write
copfb1: fab$b
f$fac fb$rea ; allowed i/o operations
f$fop fb$sup ; supercede old versions
f$lch 1 ; channel number to use
f$rfm fb$var
f$rat fb$cr
fab$e
copfb2: fab$b
f$fac <fb$wrt!fb$rea> ; allow block mode write's
f$fop fb$sup ; supercede old versions
f$lch 2 ; channel number to use
fab$e
coprb1: rab$b ; define record access block
r$fab copfb1 ; associate a fab with this rab
r$rac rb$seq ; access sequentially
r$rbf copbuf ; where to return the data
r$ubf copbuf ; where to return the data
r$usz 512. ; size of myrec (maximum size)
rab$e ; end of record access block
coprb2: rab$b ; define record access block
r$fab copfb2 ; associate a fab with this rab
r$rac rb$seq ; access sequentially
r$rbf copbuf ; where to return the data
r$ubf copbuf ; where to return the data
r$usz 512. ; size of myrec (maximum size)
rab$e ; end of record access block
.sbttl copy one file to another
.psect $code
copy:: save <r2,r3,r4> ; save r2-r4 please
sub #100 ,sp ; allocate a buffer for the
mov sp ,r3 ; fully parsed input filename
sub #100 ,sp ; allocate a buffer for the
mov sp ,r4 ; fully parsed output filename
calls fparse ,<@r5,r3> ; simple to do
tst r0 ; expand the input filename first
bne 100$ ; it failed, exit please
calls fparse ,<2(r5),r4> ; build the output filespec next
tst r0 ; did the parse of the name succeed?
bne 100$ ; no, exit with the RMS error
mov #copfb1 ,r1 ; point to the input FAB
mov #copfb2 ,r2 ; point to the output FAB
$store r3,FNA ,r1 ; stuff the input filename in FAB
$store r4,FNA ,r2 ; stuff the output filename in FAB
strlen r3 ; get the input filename length
$store r0,FNS ,r1 ; stuff it into the FAB
strlen r4 ; get the input filename length
$store r0,FNS ,r2 ; stuff it into the FAB
tst fu$def ; do we really need a def device
beq 10$ ; no
$store #sydska ,DNA,r1 ; stuff defaults for the name in
$store #sydskl ,DNS,r1 ; FAB since we already parsed and
$store #sydska ,DNA,r2 ; expanded the input and output
$store #sydskl ,DNS,r2 ; filenames with our defaults.
10$: $open r1 ; open the input file up please
$fetch r0,STS ,r1 ; get the error code out now
bmi 100$ ; error exit now
call copyatr ; yes, move file org stuff to out FAB
$create r2 ; try to create the output file now
$fetch r0,STS ,r2 ; get the RMS status from the FAB
bmi 90$ ; it didn't work out, close input file
call copyfi ; do the file copy now
call fixatr ; fix the atttribute data up
$close r2 ; Close output file ;RBD02
90$: $close r1 ; Close input file ;RBD02
100$: tst r0 ; set ret. codes to zero if > 0
bmi 110$ ; ok
clr r0 ; say it worked
110$: add #100*2 ,sp ; pop local filename buffers
mov r4 ,r1 ; number of blocks copied
unsave <r4,r3,r2> ; pop local registers and exit
return
.sbttl fix the file attribute data up by looking at the IFAB
; input: r1 --> FAB for the input file
; r2 --> FAB for the output file
;
; Since these fields all follow each other in order we could
; of course use .assume or assert macros to check for their
; order, but then if rms were altered we would be in trouble.
; As it stands, by doing this (looking at IFABS), we may be
; in trouble for future versions of RMS anyway. It would be
; much simpler if RMS would provide a means to override the
; eof and recordsize markers at runtime.
fixatr: save <r3,r4> ; save temps please
mov o$ifi(r1),r3 ; point to the input file IFAB
mov o$ifi(r2),r4 ; point to the output file IFAB
cmpb o$rfm(r1),#fb$stm ; stream file as input ?
bne 10$ ; no
tst f$rsiz(r3) ; yes, stream. Any valid recordsize?
bne 10$ ; yes, assume that the rest is valid
clrb f$ratt(r4)
clrb f$forg(r4)
clr f$rsiz(r4)
clr f$hvbn(r4)
clr f$lvbn(r4)
clr f$heof(r4)
clr f$leof(r4)
clr f$ffby(r4)
clrb f$hdsz(r4)
clrb f$bksz(r4)
clr f$mrs(r4)
clr f$deq(r4)
clr f$rtde(r4)
br 100$
10$: movb f$ratt(r3),f$ratt(r4) ; stuff the input record attributes
movb f$forg(r3),f$forg(r4) ; also stuff the input file org in
mov f$rsiz(r3),f$rsiz(r4) ; and the input record size please
mov f$hvbn(r3),f$hvbn(r4) ; and the input eof markers
mov f$lvbn(r3),f$lvbn(r4) ; like hi and low virtual block
mov f$heof(r3),f$heof(r4) ; and the high and low eof block
mov f$leof(r3),f$leof(r4) ; numbers also
mov f$ffby(r3),f$ffby(r4) ; and, at last, the first free byte
movb f$hdsz(r3),f$hdsz(r4) ; VFC header size next
movb f$bksz(r3),f$bksz(r4) ; and largest bucket size
mov f$mrs(r3) ,f$mrs(r4) ; the maximum record size
mov f$deq(r3) ,f$deq(r4) ; and the default extenstion size
mov f$rtde(r3),f$rtde(r4) ; and the run time extentsion size
100$: unsave <r4,r3> ; all done
return
.sbttl copyatr copy the input record format to the output file's FAB
; We don't really need this as it turns out we will have to
; do a read attributes for the input file and a write for the
; output file anyway due to problems in marking the EOF point
; and in copying stream ascii files in general.
; It would have been nice to avoid all that. We could avoid
; it if all files had attributes (unlike RSTS) and if we had
; access to RMS blocks regarding EOF info.
copyat: mov o$alq+0(r1),o$alq+0(r2) ; allocation is a double word field.
mov o$alq+2(r1),o$alq+2(r2) ; $fetch to r0 would clobber r1 also
$fetch r0,BKS ,r1 ; the macros select the proper size
$store r0,BKS ,r2 ; of the move at a cost in space.
$fetch r0,DEQ ,r1 ; done with the allocation and bucket
$store r0,DEQ ,r2 ; size, now stuff the extension size.
$fetch r0,FOP ,r1 ; o$fop(r2) := o$fop(r1)
$set r0,FOP ,r2 ; possibly want a contiguous file
$fetch r0,FSZ ,r1 ; get the VFC fixed control size
$store r0,FSZ ,r2 ; o$fsz(r2) := o$fsz(r1)
$fetch r0,LRL ,r1 ; get the longest record size
$store r0,LRL ,r2 ; o$lrl(r2) := o$lrl(r1)
$fetch r0,MRS ,r1 ; get the maximum record size
$store r0,MRS ,r2 ; o$mrs(r2) := o$mrs(r1)
$fetch r0,ORG ,r1 ; get the file organization now
$store r0,ORG ,r2 ; o$org(r2) := o$org(r1)
$fetch r0,RAT ,r1 ; get the record attributes now
$store r0,RAT ,r2 ; o$rat(r2) := o$rat(r1)
$fetch r0,RFM ,r1 ; get the record format next
$store r0,RFM ,r2 ; o$rfm(r2) := o$rfm(r1)
$fetch r0,RTV ,r1 ; get the cluster size next
$store r0,RTV ,r2 ; o$rtv(r2) := o$rtv(r1)
return ; ... at last ..........
.sbttl connect, copy and disconnect from the files to be copied
copyfi: save <r1,r2,r5> ; save the old FAB addresses
clr r4 ; blocks := 0
mov #coprb1 ,r1 ; connect up first please
$connec r1 ; connect up now
$fetch r0,STS ,r1 ; get the error code out
bmi 100$ ; oops
mov #coprb2 ,r2 ; connect up first please
$connec r2 ; connect up now
$fetch r0,STS ,r2 ; get the error code out
bmi 100$ ; oops
10$: clr o$bkt+0(r1) ; setup for sequential reads and writes
clr o$bkt+2(r1) ; two words for block numbers
clr o$bkt+0(r2) ; do it to both the input RAB and the
clr o$bkt+2(r2) ; output RAB
$store #copbfs,USZ,r1 ; stuff the buffer size in
$store #copbuf,UBF,r1 ; and also the buffer address please
$read r1 ; get the next block
$fetch r0,STS ,r1 ; get the error code out
bmi 90$ ; oops, exit on error please
$fetch r5,RSZ ,r1 ; get the byte count please
$store r5,RSZ ,r2 ; stuff the buffer size in
$store #copbuf ,RBF,r2 ; and also the buffer address please
$write r2 ; write the next block
$fetch r0,STS ,r2 ; get the error code out
bmi 90$ ; oops, exit on error please
ash #-11 ,r5 ; convert byte count to blocks
add r5 ,r4 ; blocks := blocks + bytecount/512
br 10$ ; next please
90$: $discon r1 ; disconnect from input RAB
$discon r2 ; disconnect from the output RAB
cmp r0 ,#ER$EOF ; normal exit is always EOF
bne 100$ ; exit with error_code = 0
clr r0 ; error_code := 0
100$: unsave <r5,r2,r1> ; pop the old FAB addresses now.
return ; access streams and return.
.end