1
2
3
4
5
6
7
8 %;
9
10
11
12
13
14
15
16
17
18 vfdevl_: vfdcnt:
19
20 procedure (rslts, flags, k); note
21
22
23
24 note
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39 % include varcom;
40 % include concom;
41 % include erflgs;
42 % include codtab;
43
44
45
46 declare inputs_$next ext entry,
47 inputs_$nxtnb ext entry,
48 getid_$getid_ ext entry;
49
50
51
52 declare utils_$ls ext entry (fixed bin (26), fixed bin (26)) returns (fixed bin (26)) ,
53 utils_$rs ext entry (fixed bin (26), fixed bin (26)) returns (fixed bin (26)) ,
54 glpl_$setblk ext entry (fixed bin (26), fixed bin (26)) returns (fixed bin (26)) ,
55 expevl_$expevl_ ext entry (fixed bin (26), fixed bin (26), fixed bin (26)) returns (fixed bin (26)) ,
56 utils_$or ext entry (fixed bin (26), fixed bin (26)) returns (fixed bin (35)),
57 utils_$and ext entry (fixed bin (26), fixed bin (26)) returns (fixed bin (35));
58
59
60
61 declare (eb_data_$jbo, eb_data_$jba, eb_data_$twop18) ext fixed bin (35);
62
63
64
65 declare rslts (128) fixed bin(35);
66 declare ( flags, val, word, lcvec (128) , trel, i, j, k, ibl, nn, iaddr, l, n, let) fixed bin (26);
67 declare vfd_buffer_size init(128) fixed bin int static;
68
69
70
71
72 i = 1;
73 rslts (1) = 0;
74 j = 0;
75 n = 0;
76 let = 0;
77 label_107:
78
79 lcvec(*) = 0;
80
81 trel = 0;
82 flags = 0;
83 call inputs_$nxtnb;
84 goto label_120;
85
86
87 label_110:
88 call inputs_$next;
89 label_120:
90 if (brk (1) = inum) then goto label_200;
91 if (brk (1) = ilet) then goto label_210;
92 if (brk (1) = islash) then goto label_300;
93 goto label_530;
94
95
96 label_200:
97 n = 10*n+utils_$and (brk (2) , 15);
98 goto label_110;
99
100 label_210:
101 let = brk (2);
102 goto label_110;
103
104
105 label_300:
106 if (let = 0) then goto label_310;
107 if (let = eb_data_$jbo) then goto label_320;
108 if (let = eb_data_$jba) then goto label_335;
109 goto label_530;
110
111 label_310:
112 ibl = 0;
113 goto label_325;
114
115 label_320:
116 ibl = 1;
117 label_325:
118 call getid_$getid_;
119 nn = expevl_$expevl_ (ibl, val, iaddr);
120 if (iaddr = 0) then goto label_400;
121 if (n >= 18 & val < eb_data_$twop18) then goto label_326;
122 prntr = 1;
123 goto label_400;
124
125 label_326:
126 k = j+n;
127 l = 0;
128 label_327:
129 if (k <= 36) then goto label_328;
130 k = k-36;
131 l = l+1;
132 goto label_327;
133
134 label_328:
135 if (k ^= 18) then goto label_329;
136 l = l+i;
137 lcvec (l) = utils_$ls (iaddr, 18);
138 trel = 1;
139 goto label_400;
140
141 label_329:
142 if (k ^= 36) then goto label_330;
143 l = l+i;
144 lcvec (l) = utils_$or (lcvec (l) , iaddr);
145 trel = 1;
146 goto label_400;
147
148 label_330:
149 prntr = 1;
150 goto label_400;
151
152 label_335:
153 val = 0;
154
155 label_337:
156 call inputs_$next;
157 if (brk (1) = icomma | brk (1) = inl) then goto label_400;
158 val = utils_$or (512*val, brk (2) );
159 goto label_337;
160
161
162
163 label_400:
164 if n <= 35 then val = utils_$and (val, utils_$rs (-1, 36 - n) );
165 label_420:
166 if ( (j+n) < 36) then goto label_440;
167 n = n- (36-j);
168 rslts (i) = utils_$or (utils_$ls (word, 36-j) , utils_$rs (val, n) );
169 j = 0;
170 i = i+1;
171 if (i > vfd_buffer_size) then goto label_530;
172 label_430:
173 if (n < 36) then goto label_440;
174 n = n-36;
175 rslts (i) = utils_$rs (val, n);
176 i = i+1;
177 if (i > vfd_buffer_size) then goto label_530;
178 goto label_430;
179
180 label_440:
181 if n > 35 then word = val;
182 else word = utils_$or (utils_$ls (word, n) , utils_$and (val, utils_$rs (-1, 36-n) ) );
183 j = j+n;
184 n = 0;
185 let = 0;
186 if (brk (1) = icomma) then goto label_110;
187
188
189 label_500:
190 if (j = 0) then goto label_510;
191 rslts (i) = utils_$ls (word, 36-j);
192 k = i;
193 goto label_520;
194
195
196
197
198
199 label_530:
200
201 prnte = 1;
202 goto label_500;
203
204
205 label_510:
206
207 k = i-1;
208 if (i = 1) then k = 1;
209 label_520:
210
211 if (trel ^= 0) then flags = glpl_$setblk (lcvec (1) , k);
212
213 end vfdevl_;