6 Pascal Implementation; Compiler and Assembler/Interpreter185 labvol, labnamet integer186 end;187188 extfliep - 'Mettle;189 fllerec record filenamelalphal nextfllelextfilop end;190191 ("192193194 var195 ("returned by source program scanner196 ineymbol:197AAAAAAAAAA)190199 cyt symbol; ("last symbol")200 op' operator; ("classification of last symbol")201 vol: volu; ("value of last constant")202 lgth: Integer; ("length of last string constant")2U3 id: alpha; ("last identifier (possibly truncated)")204 kkt 1..8; ("nr of chars in last identifier")205 chi char; ("last character")206 toll boolosn; ("end of lino flag")207208209 ("counters!")210(AAAAAAAAAAA)211212 client: integer; ("character counter")213 lc,ici addrrangel ("data location and instruction counter")214 linecounti integer;215216217 ("switches!")218(AAAAAAAAAAA)219220 dp, ("declaration part")221 prterr, ("to allow forward references in pointer type222 declaration by suppressing error message")223 list,prcode,prtablosi booleanl ("output options for224 -- source program listing225 -- printing eymbolic code226 -- displaying ident and etruct tables227 --> procedure option")228 debug' booleang229230231 ("pointers!")232 (AAAAAAAAAAA)233 parmptr,234 intptr,realptr,charptc,235 boolptroilptc,textptr: stp; ("pointers .to entries of etandard ids")236 utypptr,ucetptr,uverptr,23• ufldptr,up'rcptr,ufctptr, ("pointers to entries for undeclared (ds')238 fwptri ctp; (Ahead of chain of torw dccl type Ida")239 fextfilnp: extfilop; (Ahead of chain of external (nee")240 globtentp: teetp; ("last t<strong>net</strong>pointer")241242243 (Abookkeoping of declaration levels:")244(AAAAAAAAAA 44444 AAAAAAAAAAAAAAAAAAAAA)245246 level' levrange; ("current ototic level")247 dies, (Alevul of last id searched by searchid")248 top, dieprangei (Atop of display")A)Compiler Listing 7249250 displays (*whore! moans1")251 array fdisprange) of252 packed record ("back! id is variable 10)253 fnamel ctp; !label! Ibpg ("creel id is (told Id in record with')254 case occur; where of (" constant address")255 cruel (clevi levrange; (".vreci id is field ld in record with')256 cdspli addrrange);( 4 yr:I- table address")257 vrect (vdsplt eddrrange)258 end; (" --> procedure withs6itement")259260261 (*error messages:")262 (AAAAAAAAAAAAAAAAA)263264 errir..:1 0..101 ('or of errors in current source line")265 orrliett266 array 11..10) of267 packed record post integer;260 nmr, 1..400269 end;270271272273 ("expression compilation:")274 (AAAAAAAAAAAAAAAAAAAAAAAAA)275276 gettr: attr; ("describes the expr currently compiled')271278279 ("structured constants:")280 (A AAAAA AAAAAAAAA AAAAAAAA )281282 constbeggys,simptypebegays,typebegsye,blockbegsys,selectamfacbegsya,283 statb,gsys,typedele: setofdys;284 chartp array(char) of chip;285 rut array (1..35("nr. of red. words")) of alpha;286 ft. wl array (1..9) of 1..36(Anr. of tee. words + I");287 royt irray (1..35(Anr. of res. words")) of symbol;288 sey1 array char) of symbol;209 rope nrruy 1..35("nr. of res. words")) of operator;290 cope nrtny char) of operator;291 nat Array 1..351 of slpha;292 ant array 0..601 of packed array (1..4) of char;293 sna: array 1..23) of packed array (1..4) of char;294 cdx: artily 0..60) of -4..+4;295 pdx: array 1..231 of -7..+7;296 ordintt array (char) of integer;297298 intlnbel,mxint10,digmaxi integer;299300 (A A)301302303 procedure endoflitle;304 var lastpos,freepos,currpoa,currnmr,f,k1 integer;305 begin306 if erring > 0 then ("output error messages")307 begin write(output,' **** ':15);308 lastpos 1. 0; freopos r. 1;309 for k 1- 1 to erring do310 begin311 with errlist(k) do312 begin currpoe 1. poe; currnmr nmr end;
8 Pascal Implementation: Compiler and Asse ► bler/Interpreter Compiler Listing 9313 if currpoe laetpos then write(outo. ,/,')314 else315 begin316 while fKeepos < currpoe do117 begin write(output,' '); freepos t. freepos + I end;318 write(output,'"');319 lastpos 1. currpoe320 and;321 if currnmr < 10 then f ► • 1322 oleo if currnmr < 100 then t tft 2323 elan t t ■ 3;324 write(output,currnmrif);325 freepos 1. froepue + f + 1326 end;321 writeln(output); errinx I. 0328 end;329 linccount 1• linacount + 1;330 if list and (not sof(input)) then331 begin write(output i linecountt6, 1 't2);332 if dp then write(output,lct7) else writo(output,ici7);333 write(output,' ')334 end;335 chcnt t. 0336 end (*endofline*)337338 procedure arror(ferrnri integer);339 begin340 if errinx >- 9 then341 begin errlint(101.nmr 255; arrinx 1. 10 end342 else343 begin errinx to errinx + 11344 errlistlerrinxl.nmr ts. ferrnr345 end;346 orrlistIerrinxi•pow chcnt347 end (*error") ;340349 procedure ineymboi;350 (*read next baoic symbol of source program and return its351 description in the global variables sy, op, id, vel and lgth*)352 label 1,2,3;353 var 1,ki integer;354 digit: packed array (1..strglgthl of char;355 string: packed array (1..strglgth) of char;356 lvp, cep; test: bonlean;357358 procedure nextch;359 begin if eol then360 begin if list then writeln(output); endofline361 end;362 if not oof(input) then363 begin eol f. eoln(input); rend(input ech);364 if list than write(output,ch);365 chcnt chcnt + 1366 end367 else368 begin writeln(output,' " 4 sof ','encounterod');369 test 1. false370 and371 end;372373 procedure options;374 begin315 repeat nextch;376 If ch 0 'A' then377 hegin378 if ch 't' then379 begin nextch; prtebles t. ch '+' end380 else381 if ch • '1' then382 begin nextch; list I. ch '+';383 if not list then writeln(output)384 end305 else306 if ch 'd' then387 begin nextch; debug388 elsech '+' end389 if ch 'c' then39U (.fcl'
Change language