Pascal News

2801
2802
2803
2804
2805
2806
2807
2808
2809
2810
2811
2812
2813
2814
2815
2816
2817
2818
2819
2820
2821
2822
2823
2824
2825
2826
2827
2828
2829
2830
2831
2832
2833
2834
2835
2836
2837
2838
2839
2840
2841
2842
2843
2844
2846
2848
2849
2851
2852
2853
2854
2855
2856
if aspnil then
case asp'.form of
scalar:
if asp=realptr then genO (op emf) else
if asp=longptr then genO(op::::emd) else genO(op_cmi);
pointer:
if (lsy=eqsy) or (lsy=nesy) then genO(op_cmp) else
asperr(+0216);
power:
case lsy of
eqsy,nesy: setop(op emu);
ltsy,gtsy: asperr(+0217);
lesy: l'a=b' equivalent to 'a=b+a')
begin sz:=even(sizeof(asp»; gen1(op dup,2*sz);
gen1(op beg,-sz); setop(op ior); -
setop(op emu); lsy:=eqsy -
end -
end; {case)
arrays:
if string( asp) then
begin 13: =lino; gen1(op mrk,O); exehange(ll,13);
gen1(op loe,asp' .size); gensp(BCP)
end -
else asperr{+0218);
records: asperr(+0219);
files: asperr(+0220)
end; {case)
case lsy of
ltsy: genO (op tlt);
lesy: genO (op-tle);
gtsy: genO(op-tgt);
gesy: genO(op-tge);
nesy: genO(op-tne);
eqsy: genO(op::::teq)
end
end;
asp:=boolptr; ak:=loaded
end;
end end;
{== = = = == = = = == = = === = == = ==== = = = = = == = = = = == = = == = = == = = = = = = = = = = = = = == == = = = = )
proc"liure statement(fsys :sos); forward;
{this forward declaration can be avoided}
procedure assigrnnent( fSys :sos; fiD :ip);
var la:attr; 11,12:integer;
begin
11: =lino; seleetor( fsys+[becomesl, fip, [assigned l); 12: =lino;
la:=a; nextif(beeomes,+0221);
expression(fsys}; loadcheap; cbeckasp( la.asp,+(222);
2857
2858
2859
2860
2861
2862
2863
2864
2865
2866
2867
2869
2870
2871
2872
2873
2874
2875
2876
2877
2878
2879
2880
2881
2882
2883
2884
2885
2886
2887
2888
2889
2890
2891
2892
2893
2894
2895
2896
2897
2899
2900
2901
2902
2903
2905
2906
2907
2908
2909
2910
2911
2912
exehange(ll,12); a:=la;
if not formof(la.asp,[arrays .. recordsJ) then store else
begin loadaddr;
if la.asp' .formearray then
gen 1(op blm,even(sizeof(la.asp»)
else -
begin genl(op mrk,O); descraddr(la.asp' .arpos); gensp(ASZ);
genO (op blsT
end; -
end;
end;
procedure gotostatement;
{jtunps into structured statements can give strange results. }
label 1;
var 11p:lp; lbp:bp; diff:integer;
begin
if syintcst then error(+0223) else
begin IIp:=searehlab(b.lehain,val);
if 11pnil then
if 11p' .seen then ·genl (op brb,11p' .labname)
else gen 1 (op brf ,11p' .labname)
else -
begin lbp:=b.nextbp; diff:=l;
while lbpnil do
begin 11p:=searehlab( lbp' .lehain, val);
if 11pnil then goto 1;
lbp:=lbp' .nextbp; diff:·=diff+l;
end;
1: if 11p=nil then errint(+0224, val) else
begin
if 11p' .labdlb=O then
begin dlbno:=dlbno+l; Up' .labdlb:=dlbno;
gend(ps fwa,dlbno); {forward data reference}
end; -
gen 1 (op mrk,diffl; gend (op_lae·, 11p' .labdlb); gensp(GTO);
end; -
end;
insym;
end
end;
procedure compoundstatement( fsys :808; err :integer);
begin
repeat statement(fsys+[semieolonJ)
until endofloop( fsys I [beginsy .. casesy] I semicolon ,err)
end;
procedure ifstatement(fsys :808);
var Ib1,lb2:integer;
begin with b do begin
expression( fsys+[ thensy ,elsesyl);
force(boolptr ,+0225); ilbno :=ilbno+l; lbl: =i1bno; gen 1(op_zeq,lbl );
next1f(thensy ,+0226); statement( fsys+[elsesyl);
if find3(elsesy,fsys,+0227) then
begin ilbno:=ilbno+l; lb2:=ilbno; gen1(op_brf,lb2);
,.
-0
'"
'"