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
|
# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
include <fset.h>
include <error.h>
include <mach.h>
define TABSIZE 8
# Procedure to write cardimage files. See wcardimage.hlp for documentation.
procedure t_wcardimage()
char out_file[SZ_FNAME] # input file name list
char in_file[SZ_FNAME] # output file name list
bool verbose # verbose mode ?
char out_fname[SZ_FNAME]
int ncards, file_number, nlines, list, len_list
bool clgetb()
int fstati(), clpopni(), clplen(), mtfile(), mtneedfileno()
int clgeti(), clgfil(), strlen(), btoi()
include "wcardimage.com"
begin
# Flush standard output on newline
if (fstati (STDOUT, F_REDIR) == NO)
call fseti (STDOUT, F_FLUSHNL, YES)
# Get the parameters.
list = clpopni ("textfile")
len_list = clplen (list)
# Get name of output file.
# If no tape file number is given tape output then the program
# asks whether the tape is blank or contains data.
# If it is blank the tape begins writing at file 1 otherwise at EOT.
# Note that at some point this code needs to be modified to
# accept an output file name template.
call clgstr ( "cardfile", out_file, SZ_FNAME)
if (mtfile (out_file) == YES) {
if (mtneedfileno (out_file) == YES) {
if (! clgetb("new_tape"))
call mtfname (out_file, EOT, out_fname, SZ_FNAME)
else
call mtfname (out_file, 1, out_fname, SZ_FNAME)
} else
call strcpy (out_file, out_fname, SZ_FNAME)
}
# Get card_length and determine whether it fits in an integral number
# of characters.
card_length = min (SZ_LINE, clgeti ("card_length"))
if (mod (card_length, SZB_CHAR) != 0)
call error (1, "A card must fit in an integral number of chars.")
# Get number of cards per physical block and convert to packed chars.
cards_per_blk = clgeti ("cards_per_blk")
# Get the formatting parameters.
call clgstr ("contn_string", contn_string, SZ_LINE)
if (strlen (contn_string) > card_length)
call error (2,
"Continuation string cannot be > card_length chars.")
detab = btoi (clgetb ("detab"))
# Get the character type parameters.
ebcdic = btoi (clgetb ("ebcdic"))
ibm = btoi (clgetb ("ibm"))
if (ibm == YES && ebcdic == YES)
call error (3, "Ibm and ebcdic cannot both be true.")
verbose = clgetb ("verbose")
file_number = 1
while (clgfil (list, in_file, SZ_FNAME) != EOF) {
if (mtfile (out_file) == NO) {
if (len_list > 1) {
call sprintf (out_fname[1], SZ_FNAME, "%s%03d")
call pargstr (out_file)
call pargi (file_number)
} else
call strcpy (out_file, out_fname, SZ_FNAME)
} else {
if (file_number == 2)
call mtfname (out_fname, EOT, out_fname, SZ_FNAME)
}
# Copy text file to cardimage file.
iferr {
if (verbose) {
call printf ("File: %s -> %s: ")
call pargstr (in_file)
call pargstr (out_fname)
}
call wc_textfile_to_cardfile (in_file, out_fname, ncards,
nlines)
if (verbose) {
call printf ("%d lines read -> %d cards written\n")
call pargi (nlines)
call pargi (ncards)
}
} then {
call flush (STDOUT)
call erract (EA_FATAL)
} else if (ncards == 0) {
if (verbose)
call printf ("\tInput file is binary or empty\n")
}
file_number = file_number + 1
}
end
# WC_TEXTFILE_TO_CARDFILE -- Reads a textfile from disk and outputs a card
# image file to tape or disk.
procedure wc_textfile_to_cardfile (in_file, out_fname, ncards, nlines)
char in_file[ARB] # input file name
char out_fname[ARB] # output file name
int ncards # number of card images
int nlines # number of text lines
char linebuf[SZ_LINE]
int in, out, nchars, chars_per_blk
int mtopen(), open(), access(), wc_fetchline(), mtfile()
errchk mtopen, open, access, wc_fetchline, write, close, wc_text_to_card
include "wcardimage.com"
begin
nlines = 0
ncards = 0
if (access (in_file, READ_ONLY, TEXT_FILE) != YES)
return
# Open the file.
in = open (in_file, READ_ONLY, TEXT_FILE)
if (mtfile (out_fname) == YES) {
chars_per_blk = cards_per_blk * card_length / SZB_CHAR
out = mtopen (out_fname, WRITE_ONLY, chars_per_blk)
} else
out = open (out_fname, NEW_FILE, BINARY_FILE)
# Write file.
nchars = wc_fetchline (in, linebuf, nlines, card_length+1)
while (nchars != EOF) {
call wc_text_to_card (linebuf, nchars, linebuf)
call write (out, linebuf, card_length/SZB_CHAR)
ncards = ncards + 1
nchars = wc_fetchline (in, linebuf, nlines, card_length+1)
}
call close (in)
call close (out)
end
# WC_TEXT_TO_CARD -- Convert text string into a packed cardimage string
# removing the newline character if necessary, padding with blanks
# if required and optionally translating from ascii to ebcdic or ibm
# ebcdic.
procedure wc_text_to_card (line, nchars, card)
char line[ARB] # input text line
int nchars # number of chars in line
char card[ARB] # output packed card image
int init, ip
errchk ascii_to_ebcdic, ascii_to_ibm, achtsb, chrpak
include "wcardimage.com"
begin
# Pad with blanks.
init = nchars
if (line[init] != '\n')
init = init + 1
for (ip=init; ip <= card_length; ip=ip+1)
line[ip] = ' '
# Pack the line.
if (ebcdic == YES) {
call ascii_to_ebcdic (line, card, card_length)
call achtsb (card, card, card_length)
} else if (ibm == YES) {
call ascii_to_ibm (line, card, card_length)
call achtsb (card, card, card_length)
} else
call chrpak (line, 1, card, 1, card_length)
end
# WC_FETCHLINE -- Procedure to fetch a line of text and split it into pieces
# <= maxch characters long, optionally prefixing the remainders of lines
# with a character string.
int procedure wc_fetchline (fd, linebuf, lp, maxch)
int fd # input file descriptor
char linebuf[ARB] # output chunk of text
int lp # number of lines read
int maxch # maximum size of chunk of text
char line[SZ_LINE], inline[SZ_LINE]
int nchars, ip, op, offset, strsize
int getline(), gstrcpy(), strlen(), strncmp()
errchk getline(), strdetab()
include "wcardimage.com"
data ip /1/
begin
# Get new line and detab if requested.
if (ip == 1) {
if (detab == YES) {
nchars = getline (fd, inline)
call strdetab (inline, line, SZ_LINE, TABSIZE)
} else
nchars = getline (fd, line)
if (nchars == EOF)
return (EOF)
lp = lp + 1
offset = 0
strsize = strlen (contn_string)
if (strsize != 0 && strncmp (line, contn_string, strsize) == 0)
call eprintf ("Warning: Line matches continuation string\n")
} else {
# Otherwise determine length of continuation string.
offset = gstrcpy (contn_string, linebuf, SZ_LINE)
}
# Copy maxch characters to the output buffer.
op = offset + 1
while (line[ip] != EOS && op < maxch && line[ip] != '\n') {
linebuf[op] = line[ip]
ip = ip + 1
op = op + 1
}
# Add newline and EOS reset pointer.
linebuf[op] = '\n'
linebuf[op+1] = EOS
if (line[ip] == EOS || line[ip] == '\n')
ip = 1
return (op)
end
|
