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
|
# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
include <ctype.h>
include <printf.h>
.help
.nf _________________________________________________________________________
Process a format descriptor, setting the variables "decpl", "fill_char",
"format_char", and "width" in the fmtio common. Called from PARG_
to determine the format specification for printing a variable.
Format: "%[w[.d]]C[n]", where W is the field width, D the number of decimal
places or precision, C the format type character, and N the radix numeral,
for format type FMT_RADIX only. A negative field width signifies left
justification. A leading zero in the W field sets the fill character to the
numeral zero (when right justifying). Default values will be supplied if
any of the fields are omitted. The minimum format is "%C".
If any of the fields (wdCn) have the value GET_FIELD (= "*") the value of
the field will be taken from the next PARG_ call, rather than from the
format string. This makes it easy to vary the format specification at run
time. For example, "%10.*g" would print a number in G-floating format,
with a constant field width of 10, and with the number of digits of precision
being given by a PARGI call at execution time (followed by a PARG_ call to
pass the value to be printed).
.endhelp ____________________________________________________________________
# The following macro marks the position in the FPRFMT procedure (saves the
# code for the needed field), and returns the not done status to PARG_.
# A subsequent call to a PARG_ (with the value of the field we are waiting for
# as argument) causes FPRFMT to be reentered at the point where we left off.
define (waitfor, if (ival_already_used) { fmt_state = $1; return (NOT_DONE_YET) } ; $1 ival_already_used = true)
#define (waitfor, if (ival_already_used) {
# fmt_state = $1
# return (NOT_DONE_YET)
# }
# $1 ival_already_used = true)
# FPRFMT -- Process a %W.Dn format specification. ALL_DONE is returned when
# the format specification has been fully processed, else NOT_DONE_YET is
# returned, indicating that an additional PARG call is required to complete
# the format (which therefore contained one or more "*" specifiers).
int procedure fprfmt (ival)
int ival # argument value (from parg_)
bool ival_already_used # wait for next parg
int ctoi(), stridx()
char ch, chrlwr()
include "fmt.com"
begin
# This routine functions as a coroutine. If one of the fields in
# the format spec is to be given in a pargi call, an early return
# is taken. The routine is later reentered with the value of the
# needed field, and execution continues at the point it left off.
# (Sorry, I could not think of a simpler way to do it...)
switch (fmt_state) { # return from "waitfor"
case FMT_START: # initial state
ival_already_used = false
case GET_WIDTH_1: # "%*.dC"
goto GET_WIDTH_1
case GET_WIDTH_2: # "%-0*.dC"
goto GET_WIDTH_2
case GET_DECPL: # "%w.*C"
goto GET_DECPL
case GET_FMTCHAR: # "%w.d*"
goto GET_FMTCHAR
case GET_RADIX: # "%w.dr*"
goto GET_RADIX
case GET_OPERAND: # used ival for format
goto GET_OPERAND
}
# It is not an error if there is no format string.
if (format[ip] == EOS || format[ip] != START_OF_FORMAT) {
width = USE_DEFAULT
decpl = USE_DEFAULT
format_char = USE_DEFAULT
fill_char = ' '
left_justify = NO
fmt_state = FMT_START
return (ALL_DONE)
} else
ip = ip + 1 # eat the "%"
if (format[ip] == GET_FIELD) { # "%*.dC"
ip = ip + 1
waitfor (GET_WIDTH_1) # go get field width...
if (ival < 0) # ...and come back here
left_justify = YES
else
left_justify = NO
fill_char = ' '
width = abs (ival)
} else { # "%-0*.dC"
if (format[ip] == '-') { # left or right justify
left_justify = YES
ip = ip + 1
} else
left_justify = NO
fill_char = ' ' # zero or blank fill
if (format[ip] == '0') {
if (IS_DIGIT (format[ip+1]) || format[ip+1] == GET_FIELD) {
fill_char = '0'
ip = ip + 1
} else
fill_char = ' '
}
if (format[ip] == GET_FIELD) {
ip = ip + 1
waitfor (GET_WIDTH_2) # go get field width...
if (ival < 0) # ... and come back here
left_justify = YES
else
left_justify = NO
width = abs (ival)
} else if (ctoi (format, ip, width) <= 0) # "%N.dC"
width = USE_DEFAULT
}
if (width == 0) # make as big as needed
width = USE_DEFAULT
if (format[ip] == '.') { # get decpl field
ip = ip + 1
if (format[ip] == GET_FIELD) { # "%w.*C"
ip = ip + 1
waitfor (GET_DECPL)
decpl = ival
} else if (ctoi (format, ip, decpl) <= 0) # "%w.NC"
decpl = USE_DEFAULT
} else
decpl = USE_DEFAULT
if (format[ip] == GET_FIELD) { # "%w.d*"
ip = ip + 1
waitfor (GET_FMTCHAR)
format_char = ival
} else {
format_char = format[ip] # "%w.dC"
ip = ip + 1
}
ch = format_char
if (stridx (ch, "bcdefghHmMorstuwxz") <= 0) {
call putline (STDERR, "Warning: Unknown format type char\n")
call fmt_err ("", format, ip-1)
format_char = USE_DEFAULT
} else if (format_char == FMT_RADIX) { # get radix
ch = chrlwr (format[ip])
ip = ip + 1
if (ch == GET_FIELD) { # "%w.dr*"
waitfor (GET_RADIX)
radix = ival
} else if (IS_DIGIT (ch)) {
radix = TO_INTEG (ch)
} else if (IS_LOWER (ch)) {
radix = ch - 'a' + 10
} else {
radix = DECIMAL
ip = ip - 1
}
} else if (format_char == FMT_WHITESPACE || format_char == FMT_TOCOLUMN)
ival_already_used = false # no operand
waitfor (GET_OPERAND) # used ival for format,
fmt_state = FMT_START # need to get another
return (ALL_DONE)
end
|
