development/compilers/freepascal/compiler/rautils.pas

   1 {
   2     $Id$
   3     Copyright (c) 1998-2000 by Carl Eric Codere and Peter Vreman
   4
   5     This unit implements some support routines for assembler parsing
   6     independent of the processor
   7
   8     This program is free software; you can redistribute it and/or modify
   9     it under the terms of the GNU General Public License as published by
  10     the Free Software Foundation; either version 2 of the License, or
  11     (at your option) any later version.
  12
  13     This program is distributed in the hope that it will be useful,
  14     but WITHOUT ANY WARRANTY; without even the implied warranty of
  15     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  16     GNU General Public License for more details.
  17
  18     You should have received a copy of the GNU General Public License
  19     along with this program; if not, write to the Free Software
  20     Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  21
  22  **********************************************************************}
  23 Unit RAUtils;
  24 Interface
  25
  26 Uses
  27   strings,
  28   cobjects,
  29   globtype,types,systems,verbose,globals,files,
  30   symconst,symtable,aasm,cpubase,cpuasm
  31 {$ifdef NEWCG}
  32   ,cgbase
  33 {$else}
  34   ,hcodegen
  35 {$endif}
  36   ;
  37
  38 Const
  39   RPNMax = 10;             { I think you only need 4, but just to be safe }
  40   OpMax  = 25;
  41
  42   maxoperands = 3;         { Maximum operands for assembler instructions }
  43
  44
  45 {---------------------------------------------------------------------
  46                        Local Label Management
  47 ---------------------------------------------------------------------}
  48
  49 Type
  50   { Each local label has this structure associated with it }
  51   PLocalLabel = ^TLocalLabel;
  52   TLocalLabel = object(TNamedIndexObject)
  53     Emitted : boolean;
  54     constructor Init(const n:string);
  55     function  Getpasmlabel:pasmlabel;
  56   private
  57     lab : pasmlabel;
  58   end;
  59
  60   PLocalLabelList = ^TLocalLabelList;
  61   TLocalLabelList = Object(TDictionary)
  62     procedure CheckEmitted;
  63   end;
  64
  65 var
  66   LocalLabelList : PLocalLabelList;
  67
  68 function CreateLocalLabel(const s: string; var hl: pasmlabel; emit:boolean):boolean;
  69 Function SearchLabel(const s: string; var hl: pasmlabel;emit:boolean): boolean;
  70
  71
  72 {---------------------------------------------------------------------
  73                  Instruction management
  74 ---------------------------------------------------------------------}
  75
  76 type
  77   TOprType=(OPR_NONE,OPR_CONSTANT,OPR_SYMBOL,OPR_REFERENCE,OPR_REGISTER);
  78
  79   TOprRec = record
  80     case typ:TOprType of
  81       OPR_NONE   : ();
  82       OPR_CONSTANT  : (val:longint);
  83       OPR_SYMBOL    : (symbol:PAsmSymbol;symofs:longint);
  84       OPR_REFERENCE : (ref:treference);
  85       OPR_REGISTER  : (reg:tregister);
  86   end;
  87
  88   POperand = ^TOperand;
  89   TOperand = object
  90     size   : topsize;
  91     hastype,          { if the operand has typecasted variable }
  92     hasvar : boolean; { if the operand is loaded with a variable }
  93     opr    : TOprRec;
  94     constructor init;
  95     destructor  done;virtual;
  96     Procedure BuildOperand;virtual;
  97     Procedure SetSize(_size:longint;force:boolean);
  98     Procedure SetCorrectSize(opcode:tasmop);virtual;
  99     Function  SetupResult:boolean;virtual;
 100     Function  SetupSelf:boolean;
 101     Function  SetupOldEBP:boolean;
 102     Function  SetupVar(const hs:string;GetOffset : boolean): Boolean;
 103     Function  SetupDirectVar(const hs:string): Boolean;
 104     Procedure InitRef;
 105   end;
 106
 107   PInstruction = ^TInstruction;
 108   TInstruction = object
 109     opcode    : tasmop;
 110     opsize    : topsize;
 111     condition : tasmcond;
 112     ops       : byte;
 113     operands  : array[1..maxoperands] of POperand;
 114     constructor init;
 115     destructor  done;virtual;
 116     Procedure InitOperands;virtual;
 117     Procedure BuildOpcode;virtual;
 118     procedure ConcatInstruction(p:PAasmoutput);virtual;
 119     Procedure SwapOperands;
 120   end;
 121
 122
 123   {---------------------------------------------------------------------}
 124   {                   Expression parser types                           }
 125   {---------------------------------------------------------------------}
 126
 127    TExprOperator = record
 128     ch: char;           { operator }
 129     is_prefix: boolean; { was it a prefix, possible prefixes are +,- and not }
 130    end;
 131
 132   String15 = String[15];
 133   {**********************************************************************}
 134   { The following operators are supported:                              }
 135   {  '+' : addition                                                     }
 136   {  '-' : subtraction                                                  }
 137   {  '*' : multiplication                                               }
 138   {  '/' : modulo division                                              }
 139   {  '^' : exclusive or                                                 }
 140   {  '<' : shift left                                                   }
 141   {  '>' : shift right                                                  }
 142   {  '&' : bitwise and                                                  }
 143   {  '|' : bitwise or                                                   }
 144   {  '~' : bitwise complement                                           }
 145   {  '%' : modulo division                                              }
 146   {  nnn: longint numbers                                               }
 147   {  ( and ) parenthesis                                                }
 148   {**********************************************************************}
 149
 150   TExprParse = Object
 151     public
 152      Constructor Init;
 153      Destructor Done;
 154      Function Evaluate(Expr:  String): longint;
 155      Function Priority(_Operator: Char): Integer; virtual;
 156     private
 157      RPNStack   : Array[1..RPNMax] of longint;        { Stack For RPN calculator }
 158      RPNTop     : Integer;
 159      OpStack    : Array[1..OpMax] of TExprOperator;    { Operator stack For conversion }
 160      OpTop      : Integer;
 161      Procedure RPNPush(Num: Longint);
 162      Function RPNPop: Longint;
 163      Procedure RPNCalc(token: String15; prefix: boolean);
 164      Procedure OpPush(_Operator: char; prefix: boolean);
 165      { In reality returns TExprOperaotr }
 166      Procedure OpPop(var _Operator:TExprOperator);
 167   end;
 168
 169   { Evaluate an expression string to a longint }
 170   Function CalculateExpression(const expression: string): longint;
 171
 172   {---------------------------------------------------------------------}
 173   {                     String routines                                 }
 174   {---------------------------------------------------------------------}
 175
 176 Function ValDecimal(const S:String):longint;
 177 Function ValOctal(const S:String):longint;
 178 Function ValBinary(const S:String):longint;
 179 Function ValHexaDecimal(const S:String):longint;
 180 Function PadZero(Var s: String; n: byte): Boolean;
 181 Function EscapeToPascal(const s:string): string;
 182
 183 {---------------------------------------------------------------------
 184                      Symbol helper routines
 185 ---------------------------------------------------------------------}
 186
 187 Function GetRecordOffsetSize(s:string;Var Offset: longint;var Size:longint):boolean;
 188 Function SearchType(const hs:string): Boolean;
 189 Function SearchRecordType(const s:string): boolean;
 190 Function SearchIConstant(const s:string; var l:longint): boolean;
 191
 192
 193 {---------------------------------------------------------------------
 194                   Instruction generation routines
 195 ---------------------------------------------------------------------}
 196
 197   Procedure ConcatPasString(p : paasmoutput;s:string);
 198   Procedure ConcatDirect(p : paasmoutput;s:string);
 199   Procedure ConcatLabel(p: paasmoutput;var l : pasmlabel);
 200   Procedure ConcatConstant(p : paasmoutput;value: longint; maxvalue: longint);
 201   Procedure ConcatConstSymbol(p : paasmoutput;const sym:string;l:longint);
 202   Procedure ConcatRealConstant(p : paasmoutput;value: bestreal; real_typ : tfloattype);
 203   Procedure ConcatString(p : paasmoutput;s:string);
 204   procedure ConcatAlign(p:paasmoutput;l:longint);
 205   Procedure ConcatPublic(p:paasmoutput;const s : string);
 206   Procedure ConcatLocal(p:paasmoutput;const s : string);
 207   Procedure ConcatGlobalBss(const s : string;size : longint);
 208   Procedure ConcatLocalBss(const s : string;size : longint);
 209
 210
 211 Implementation
 212
 213
 214 {*************************************************************************
 215                               TExprParse
 216 *************************************************************************}
 217
 218 Constructor TExprParse.Init;
 219 Begin
 220 end;
 221
 222
 223 Procedure TExprParse.RPNPush(Num : longint);
 224 { Add an operand to the top of the RPN stack }
 225 begin
 226   if RPNTop < RPNMax then
 227    begin
 228      Inc(RPNTop);
 229      RPNStack[RPNTop]:=Num;
 230    end
 231   else
 232    Message(asmr_e_expr_illegal);
 233 end;
 234
 235
 236 Function TExprParse.RPNPop : longint;
 237 { Get the operand at the top of the RPN stack }
 238 begin
 239   if RPNTop > 0 then
 240    begin
 241      RPNPop:=RPNStack[RPNTop];
 242      Dec(RPNTop);
 243    end
 244   else
 245    Message(asmr_e_expr_illegal);
 246 end;
 247
 248
 249 Procedure TExprParse.RPNCalc(Token : String15; prefix:boolean);                       { RPN Calculator }
 250 Var
 251   Temp  : longint;
 252   n1,n2 : longint;
 253   LocalError : Integer;
 254 begin
 255   { Handle operators }
 256   if (Length(Token) = 1) and (Token[1] in ['+', '-', '*', '/','&','|','%','^','~','<','>']) then
 257    Case Token[1] of
 258     '+' :
 259       Begin
 260         if not prefix then
 261          RPNPush(RPNPop + RPNPop);
 262       end;
 263     '-' :
 264       Begin
 265         if prefix then
 266          RPNPush(-(RPNPop))
 267         else
 268          begin
 269            n1:=RPNPop;
 270            n2:=RPNPop;
 271            RPNPush(n2 - n1);
 272          end;
 273       end;
 274     '*' : RPNPush(RPNPop * RPNPop);
 275     '&' :
 276       begin
 277         n1:=RPNPop;
 278         n2:=RPNPop;
 279         RPNPush(n2 and n1);
 280       end;
 281     '|' :
 282       begin
 283         n1:=RPNPop;
 284         n2:=RPNPop;
 285         RPNPush(n2 or n1);
 286       end;
 287     '~' : RPNPush(NOT RPNPop);
 288     '<' :
 289       begin
 290         n1:=RPNPop;
 291         n2:=RPNPop;
 292         RPNPush(n2 SHL n1);
 293       end;
 294     '>' :
 295       begin
 296         n1:=RPNPop;
 297         n2:=RPNPop;
 298         RPNPush(n2 SHR n1);
 299       end;
 300     '%' :
 301       begin
 302         Temp:=RPNPop;
 303         if Temp <> 0 then
 304          RPNPush(RPNPop mod Temp)
 305         else
 306          begin
 307            Message(asmr_e_expr_zero_divide);
 308            { push 1 for error recovery }
 309            RPNPush(1);
 310          end;
 311       end;
 312     '^' : RPNPush(RPNPop XOR RPNPop);
 313     '/' :
 314       begin
 315         Temp:=RPNPop;
 316         if Temp <> 0 then
 317          RPNPush(RPNPop div Temp)
 318         else
 319          begin
 320            Message(asmr_e_expr_zero_divide);
 321            { push 1 for error recovery }
 322            RPNPush(1);
 323          end;
 324       end;
 325    end
 326   else
 327    begin
 328      { Convert String to number and add to stack }
 329      if token='-2147483648' then
 330       begin
 331         temp:=$80000000;
 332         localerror:=0;
 333       end
 334      else
 335       Val(Token, Temp, LocalError);
 336      if LocalError = 0 then
 337       RPNPush(Temp)
 338      else
 339       begin
 340         Message(asmr_e_expr_illegal);
 341         { push 1 for error recovery }
 342         RPNPush(1);
 343       end;
 344    end;
 345 end;
 346
 347
 348 Procedure TExprParse.OpPush(_Operator : char;prefix: boolean);
 349 { Add an operator onto top of the stack }
 350 begin
 351   if OpTop < OpMax then
 352    begin
 353      Inc(OpTop);
 354      OpStack[OpTop].ch:=_Operator;
 355      OpStack[OpTop].is_prefix:=prefix;
 356    end
 357   else
 358    Message(asmr_e_expr_illegal);
 359 end;
 360
 361
 362 Procedure TExprParse.OpPop(var _Operator:TExprOperator);
 363 { Get operator at the top of the stack }
 364 begin
 365   if OpTop > 0 then
 366    begin
 367      _Operator:=OpStack[OpTop];
 368      Dec(OpTop);
 369    end
 370   else
 371    Message(asmr_e_expr_illegal);
 372 end;
 373
 374
 375 Function TExprParse.Priority(_Operator : Char) : Integer;
 376 { Return priority of operator }
 377 { The greater the priority, the higher the precedence }
 378 begin
 379   Case _Operator OF
 380     '(' :
 381       Priority:=0;
 382     '+', '-' :
 383       Priority:=1;
 384     '*', '/','%','<','>' :
 385       Priority:=2;
 386     '|','&','^','~' :
 387       Priority:=0;
 388     else
 389       Message(asmr_e_expr_illegal);
 390   end;
 391 end;
 392
 393
 394 Function TExprParse.Evaluate(Expr : String):longint;
 395 Var
 396   I     : Integer;
 397   Token : String15;
 398   opr   : TExprOperator;
 399 begin
 400   Evaluate:=0;
 401   { Reset stacks }
 402   OpTop :=0;
 403   RPNTop:=0;
 404   Token :='';
 405   { nothing to do ? }
 406   if Expr='' then
 407    exit;
 408   For I:=1 to Length(Expr) DO
 409    begin
 410      if Expr[I] in ['0'..'9'] then
 411       begin       { Build multi-digit numbers }
 412         Token:=Token + Expr[I];
 413         if I = Length(Expr) then          { Send last one to calculator }
 414          RPNCalc(Token,false);
 415       end
 416      else
 417       if Expr[I] in ['+', '-', '*', '/', '(', ')','^','&','|','%','~','<','>'] then
 418        begin
 419          if Token <> '' then
 420           begin        { Send last built number to calc. }
 421             RPNCalc(Token,false);
 422             Token:='';
 423           end;
 424
 425          Case Expr[I] OF
 426           '(' : OpPush('(',false);
 427           ')' : begin
 428                   While OpStack[OpTop].ch <> '(' DO
 429                    Begin
 430                      OpPop(opr);
 431                      RPNCalc(opr.ch,opr.is_prefix);
 432                    end;
 433                   OpPop(opr);                          { Pop off and ignore the '(' }
 434                 end;
 435   '+','-','~' : Begin
 436                   { workaround for -2147483648 }
 437                   if (expr[I]='-') and (expr[i+1] in ['0'..'9']) then
 438                    begin
 439                      token:='-';
 440                      expr[i]:='+';
 441                    end;
 442                   { if start of expression then surely a prefix }
 443                   { or if previous char was also an operator    }
 444                   if (I = 1) or (not (Expr[I-1] in ['0'..'9','(',')'])) then
 445                     OpPush(Expr[I],true)
 446                   else
 447                     Begin
 448                     { Evaluate all higher priority operators }
 449                       While (OpTop > 0) AND (Priority(Expr[I]) <= Priority(OpStack[OpTop].ch)) DO
 450                        Begin
 451                          OpPop(opr);
 452                          RPNCalc(opr.ch,opr.is_prefix);
 453                        end;
 454                       OpPush(Expr[I],false);
 455                     End;
 456                 end;
 457      '*', '/',
 458   '^','|','&',
 459   '%','<','>' : begin
 460                   While (OpTop > 0) and (Priority(Expr[I]) <= Priority(OpStack[OpTop].ch)) DO
 461                    Begin
 462                      OpPop(opr);
 463                      RPNCalc(opr.ch,opr.is_prefix);
 464                    end;
 465                   OpPush(Expr[I],false);
 466                 end;
 467          end; { Case }
 468        end
 469      else
 470       Message(asmr_e_expr_illegal);  { Handle bad input error }
 471    end;
 472
 473 { Pop off the remaining operators }
 474   While OpTop > 0 do
 475    Begin
 476      OpPop(opr);
 477      RPNCalc(opr.ch,opr.is_prefix);
 478    end;
 479
 480 { The result is stored on the top of the stack }
 481   Evaluate:=RPNPop;
 482 end;
 483
 484
 485 Destructor TExprParse.Done;
 486 Begin
 487 end;
 488
 489
 490 Function CalculateExpression(const expression: string): longint;
 491 var
 492   expr: TExprParse;
 493 Begin
 494   expr.Init;
 495   CalculateExpression:=expr.Evaluate(expression);
 496   expr.Done;
 497 end;
 498
 499
 500 {*************************************************************************}
 501 {                         String conversions/utils                        }
 502 {*************************************************************************}
 503
 504 Function EscapeToPascal(const s:string): string;
 505 { converts a C styled string - which contains escape }
 506 { characters to a pascal style string.               }
 507 var
 508   i,len : longint;
 509   hs    : string;
 510   temp  : string;
 511   c     : char;
 512 Begin
 513   hs:='';
 514   len:=0;
 515   i:=0;
 516   while (i<length(s)) and (len<255) do
 517    begin
 518      Inc(i);
 519      if (s[i]='\') and (i<length(s)) then
 520       Begin
 521         inc(i);
 522         case s[i] of
 523          '\' :
 524            c:='\';
 525          'b':
 526            c:=#8;
 527          'f':
 528            c:=#12;
 529          'n':
 530            c:=#10;
 531          'r':
 532            c:=#13;
 533          't':
 534            c:=#9;
 535          '"':
 536            c:='"';
 537          '0'..'7':
 538            Begin
 539              temp:=s[i];
 540              temp:=temp+s[i+1];
 541              temp:=temp+s[i+2];
 542              inc(i,2);
 543              c:=chr(ValOctal(temp));
 544            end;
 545          'x':
 546            Begin
 547              temp:=s[i+1];
 548              temp:=temp+s[i+2];
 549              inc(i,2);
 550              c:=chr(ValHexaDecimal(temp));
 551            end;
 552          else
 553            Begin
 554              Message1(asmr_e_escape_seq_ignored,s[i]);
 555              c:=s[i];
 556            end;
 557         end;
 558       end
 559      else
 560       c:=s[i];
 561      inc(len);
 562      hs[len]:=c;
 563    end;
 564   hs[0]:=chr(len);
 565   EscapeToPascal:=hs;
 566 end;
 567
 568
 569 Function ValDecimal(const S:String):longint;
 570 { Converts a decimal string to longint }
 571 var
 572   vs,c : longint;
 573 Begin
 574   vs:=0;
 575   for c:=1 to length(s) do
 576    begin
 577      vs:=vs*10;
 578      if s[c] in ['0'..'9'] then
 579       inc(vs,ord(s[c])-ord('0'))
 580      else
 581       begin
 582         Message1(asmr_e_error_converting_decimal,s);
 583         ValDecimal:=0;
 584         exit;
 585       end;
 586    end;
 587   ValDecimal:=vs;
 588 end;
 589
 590
 591 Function ValOctal(const S:String):longint;
 592 { Converts an octal string to longint }
 593 var
 594   vs,c : longint;
 595 Begin
 596   vs:=0;
 597   for c:=1 to length(s) do
 598    begin
 599      vs:=vs shl 3;
 600      if s[c] in ['0'..'7'] then
 601       inc(vs,ord(s[c])-ord('0'))
 602      else
 603       begin
 604         Message1(asmr_e_error_converting_octal,s);
 605         ValOctal:=0;
 606         exit;
 607       end;
 608    end;
 609   ValOctal:=vs;
 610 end;
 611
 612
 613 Function ValBinary(const S:String):longint;
 614 { Converts a binary string to longint }
 615 var
 616   vs,c : longint;
 617 Begin
 618   vs:=0;
 619   for c:=1 to length(s) do
 620    begin
 621      vs:=vs shl 1;
 622      if s[c] in ['0'..'1'] then
 623       inc(vs,ord(s[c])-ord('0'))
 624      else
 625       begin
 626         Message1(asmr_e_error_converting_binary,s);
 627         ValBinary:=0;
 628         exit;
 629       end;
 630    end;
 631   ValBinary:=vs;
 632 end;
 633
 634
 635 Function ValHexadecimal(const S:String):longint;
 636 { Converts a binary string to longint }
 637 var
 638   vs,c : longint;
 639 Begin
 640   vs:=0;
 641   for c:=1 to length(s) do
 642    begin
 643      vs:=vs shl 4;
 644      case s[c] of
 645        '0'..'9' :
 646          inc(vs,ord(s[c])-ord('0'));
 647        'A'..'F' :
 648          inc(vs,ord(s[c])-ord('A')+10);
 649        'a'..'f' :
 650          inc(vs,ord(s[c])-ord('a')+10);
 651        else
 652          begin
 653            Message1(asmr_e_error_converting_hexadecimal,s);
 654            ValHexadecimal:=0;
 655            exit;
 656          end;
 657      end;
 658    end;
 659   ValHexadecimal:=vs;
 660 end;
 661
 662
 663 Function PadZero(Var s: String; n: byte): Boolean;
 664 Begin
 665   PadZero:=TRUE;
 666   { Do some error checking first }
 667   if Length(s) = n then
 668     exit
 669   else
 670   if Length(s) > n then
 671   Begin
 672     PadZero:=FALSE;
 673     delete(s,n+1,length(s));
 674     exit;
 675   end
 676   else
 677     PadZero:=TRUE;
 678   { Fill it up with the specified character }
 679   fillchar(s[length(s)+1],n-1,#0);
 680   s[0]:=chr(n);
 681 end;
 682
 683
 684 {****************************************************************************
 685                                    TOperand
 686 ****************************************************************************}
 687
 688 constructor TOperand.init;
 689 begin
 690   size:=S_NO;
 691   hastype:=false;
 692   hasvar:=false;
 693   FillChar(Opr,sizeof(Opr),0);
 694 end;
 695
 696
 697 destructor TOperand.done;
 698 begin
 699 end;
 700
 701
 702 Procedure TOperand.SetCorrectSize(opcode:tasmop);
 703 begin
 704 end;
 705
 706 Procedure TOperand.SetSize(_size:longint;force:boolean);
 707 begin
 708   if force or
 709      ((size = S_NO) and (_size<=extended_size)) then
 710    Begin
 711      case _size of
 712       1 : size:=S_B;
 713       2 : size:=S_W{ could be S_IS};
 714       4 : size:=S_L{ could be S_IL or S_FS};
 715       8 : size:=S_IQ{ could be S_D or S_FL};
 716       extended_size : size:=S_FX;
 717      end;
 718    end;
 719 end;
 720
 721
 722 Function TOperand.SetupResult:boolean;
 723 Begin
 724   SetupResult:=false;
 725   { replace by correct offset. }
 726   if assigned(procinfo^.returntype.def) and
 727      (procinfo^.returntype.def<>pdef(voiddef)) then
 728    begin
 729      if (procinfo^.return_offset=0) and ((m_tp in aktmodeswitches) or
 730         (m_delphi in aktmodeswitches)) then
 731        begin
 732          Message(asmr_e_cannot_use_RESULT_here);
 733          exit;
 734        end;
 735      opr.ref.offset:=procinfo^.return_offset;
 736      opr.ref.base:= procinfo^.framepointer;
 737      { always assume that the result is valid. }
 738      procinfo^.funcret_state:=vs_assigned;
 739      if (opr.ref.offset=0) and
 740         ((m_tp in aktmodeswitches) or (m_delphi in aktmodeswitches)) then
 741        Message(asmr_e_cannot_use_RESULT_here)
 742      else
 743        SetupResult:=true;
 744    end
 745   else
 746    Message(asmr_e_void_function);
 747 end;
 748
 749
 750 Function TOperand.SetupSelf:boolean;
 751 Begin
 752   SetupSelf:=false;
 753   if assigned(procinfo^._class) then
 754    Begin
 755      opr.typ:=OPR_REFERENCE;
 756      opr.ref.offset:=procinfo^.selfpointer_offset;
 757      opr.ref.base:=procinfo^.framepointer;
 758      opr.ref.options:=ref_selffixup;
 759      SetupSelf:=true;
 760    end
 761   else
 762    Message(asmr_e_cannot_use_SELF_outside_a_method);
 763 end;
 764
 765
 766 Function TOperand.SetupOldEBP:boolean;
 767 Begin
 768   SetupOldEBP:=false;
 769   if lexlevel>normal_function_level then
 770    Begin
 771      opr.typ:=OPR_REFERENCE;
 772      opr.ref.offset:=procinfo^.framepointer_offset;
 773      opr.ref.base:=procinfo^.framepointer;
 774      SetupOldEBP:=true;
 775    end
 776   else
 777    Message(asmr_e_cannot_use_OLDEBP_outside_nested_procedure);
 778 end;
 779
 780
 781 Function TOperand.SetupVar(const hs:string;GetOffset : boolean): Boolean;
 782 { search and sets up the correct fields in the Instr record }
 783 { for the NON-constant identifier passed to the routine.    }
 784 { if not found returns FALSE.                               }
 785 var
 786   sym : psym;
 787   harrdef : parraydef;
 788 Begin
 789   SetupVar:=false;
 790 { are we in a routine ? }
 791   getsym(hs,false);
 792   sym:=srsym;
 793   if sym=nil then
 794    exit;
 795   case sym^.typ of
 796     varsym :
 797       begin
 798         { we always assume in asm statements that     }
 799         { that the variable is valid.                 }
 800         pvarsym(sym)^.varstate:=vs_used;
 801         inc(pvarsym(sym)^.refs);
 802         case pvarsym(sym)^.owner^.symtabletype of
 803           objectsymtable :
 804             begin
 805               { this is not allowed, because we don't know if the self
 806                 register is still free, and loading it first is also
 807                 not possible, because this could break code }
 808               { Be TP/Delphi compatible in Delphi or TP modes }
 809               if (m_tp in aktmodeswitches) then
 810                 begin
 811                   opr.typ:=OPR_CONSTANT;
 812                   opr.val:=pvarsym(sym)^.address;
 813                 end
 814               { I do not agree here people using method vars should ensure
 815                 that %esi is valid there }
 816               else
 817                 begin
 818                   opr.ref.base:=self_pointer;
 819                   opr.ref.offset:=pvarsym(sym)^.address;
 820                 end;
 821               hasvar:=true;
 822               SetupVar:=true;
 823               Exit;
 824             end;
 825           unitsymtable,
 826           globalsymtable,
 827           staticsymtable :
 828             opr.ref.symbol:=newasmsymbol(pvarsym(sym)^.mangledname);
 829           parasymtable :
 830             begin
 831               { if we only want the offset we don't have to care
 832                 the base will be zeroed after ! }
 833               if (lexlevel=pvarsym(sym)^.owner^.symtablelevel) or
 834               { this below is wrong because there are two parast
 835                 for global functions one of interface the second of
 836                 implementation
 837               if (pvarsym(sym)^.owner=procinfo^.def^.parast) or }
 838                 GetOffset then
 839                 begin
 840                   opr.ref.base:=procinfo^.framepointer;
 841                 end
 842               else
 843                 begin
 844                   if (procinfo^.framepointer=R_ESP) and
 845                      assigned(procinfo^.parent) and
 846                      (lexlevel=pvarsym(sym)^.owner^.symtablelevel+1) and
 847                      { same problem as above !!
 848                      (procinfo^.parent^.sym^.definition^.parast=pvarsym(sym)^.owner) and }
 849                      (lexlevel>normal_function_level) then
 850                     opr.ref.base:=procinfo^.parent^.framepointer
 851                   else
 852                     message1(asmr_e_local_para_unreachable,hs);
 853                 end;
 854               opr.ref.offset:=pvarsym(sym)^.address;
 855               if (lexlevel=pvarsym(sym)^.owner^.symtablelevel) then
 856                 begin
 857                   opr.ref.offsetfixup:=aktprocsym^.definition^.parast^.address_fixup;
 858                   opr.ref.options:=ref_parafixup;
 859                 end
 860               else
 861                 begin
 862                   opr.ref.offsetfixup:=0;
 863                   opr.ref.options:=ref_none;
 864                 end;
 865               if (pvarsym(sym)^.varspez=vs_var) or
 866                  ((pvarsym(sym)^.varspez=vs_const) and
 867                  push_addr_param(pvarsym(sym)^.vartype.def)) then
 868                 SetSize(target_os.size_of_pointer,false);
 869             end;
 870           localsymtable :
 871             begin
 872               if (vo_is_external in pvarsym(sym)^.varoptions) then
 873                 opr.ref.symbol:=newasmsymbol(pvarsym(sym)^.mangledname)
 874               else
 875                 begin
 876                   { if we only want the offset we don't have to care
 877                     the base will be zeroed after ! }
 878                   if (lexlevel=pvarsym(sym)^.owner^.symtablelevel) or
 879                   {if (pvarsym(sym)^.owner=procinfo^.def^.localst) or}
 880                     GetOffset then
 881                     opr.ref.base:=procinfo^.framepointer
 882                   else
 883                     begin
 884                       if (procinfo^.framepointer=R_ESP) and
 885                          assigned(procinfo^.parent) and
 886                          (lexlevel=pvarsym(sym)^.owner^.symtablelevel+1) and
 887                          {(procinfo^.parent^.sym^.definition^.localst=pvarsym(sym)^.owner) and}
 888                          (lexlevel>normal_function_level) then
 889                         opr.ref.base:=procinfo^.parent^.framepointer
 890                       else
 891                         message1(asmr_e_local_para_unreachable,hs);
 892                     end;
 893                   opr.ref.offset:=-(pvarsym(sym)^.address);
 894                   if (lexlevel=pvarsym(sym)^.owner^.symtablelevel) then
 895                     begin
 896                       opr.ref.offsetfixup:=aktprocsym^.definition^.localst^.address_fixup;
 897                       opr.ref.options:=ref_localfixup;
 898                     end
 899                   else
 900                     begin
 901                       opr.ref.offsetfixup:=0;
 902                       opr.ref.options:=ref_none;
 903                     end;
 904                 end;
 905             end;
 906         end;
 907         case pvarsym(sym)^.vartype.def^.deftype of
 908           orddef,
 909           enumdef,
 910           pointerdef,
 911           floatdef :
 912             SetSize(pvarsym(sym)^.getsize,false);
 913           arraydef :
 914             begin
 915               { for arrays try to get the element size, take care of
 916                 multiple indexes }
 917               harrdef:=Parraydef(PVarsym(sym)^.vartype.def);
 918               while assigned(harrdef^.elementtype.def) and
 919                     (harrdef^.elementtype.def^.deftype=arraydef) do
 920                harrdef:=parraydef(harrdef^.elementtype.def);
 921               SetSize(harrdef^.elesize,false);
 922             end;
 923         end;
 924         hasvar:=true;
 925         SetupVar:=true;
 926         Exit;
 927       end;
 928     typedconstsym :
 929       begin
 930         opr.ref.symbol:=newasmsymbol(ptypedconstsym(sym)^.mangledname);
 931         case ptypedconstsym(sym)^.typedconsttype.def^.deftype of
 932           orddef,
 933           enumdef,
 934           pointerdef,
 935           floatdef :
 936             SetSize(ptypedconstsym(sym)^.getsize,false);
 937           arraydef :
 938             begin
 939               { for arrays try to get the element size, take care of
 940                 multiple indexes }
 941               harrdef:=Parraydef(PTypedConstSym(sym)^.typedconsttype.def);
 942               while assigned(harrdef^.elementtype.def) and
 943                     (harrdef^.elementtype.def^.deftype=arraydef) do
 944                harrdef:=parraydef(harrdef^.elementtype.def);
 945               SetSize(harrdef^.elesize,false);
 946             end;
 947         end;
 948         hasvar:=true;
 949         SetupVar:=true;
 950         Exit;
 951       end;
 952     constsym :
 953       begin
 954         if pconstsym(sym)^.consttyp in [constint,constchar,constbool] then
 955          begin
 956            opr.typ:=OPR_CONSTANT;
 957            opr.val:=pconstsym(sym)^.value;
 958            SetupVar:=true;
 959            Exit;
 960          end;
 961       end;
 962     typesym :
 963       begin
 964         if ptypesym(sym)^.restype.def^.deftype in [recorddef,objectdef] then
 965          begin
 966            opr.typ:=OPR_CONSTANT;
 967            opr.val:=0;
 968            SetupVar:=TRUE;
 969            Exit;
 970          end;
 971       end;
 972     procsym :
 973       begin
 974         if assigned(pprocsym(sym)^.definition^.nextoverloaded) then
 975           Message(asmr_w_calling_overload_func);
 976         opr.typ:=OPR_SYMBOL;
 977         opr.symbol:=newasmsymbol(pprocsym(sym)^.definition^.mangledname);
 978         hasvar:=true;
 979         SetupVar:=TRUE;
 980         Exit;
 981       end;
 982     else
 983       begin
 984         Message(asmr_e_unsupported_symbol_type);
 985         exit;
 986       end;
 987   end;
 988 end;
 989
 990
 991 { looks for internal names of variables and routines }
 992 Function TOperand.SetupDirectVar(const hs:string): Boolean;
 993 {$ifndef OLDDIRECTVAR}
 994 var
 995   p : pasmsymbol;
 996 begin
 997   SetupDirectVar:=false;
 998   p:=getasmsymbol(hs);
 999   if assigned(p) then
1000    begin
1001      opr.ref.symbol:=p;
1002      hasvar:=true;
1003      SetupDirectVar:=true;
1004    end;
1005 end;
1006 {$else}
1007 var
1008   p : pai_external;
1009 Begin
1010    SearchDirectVar:=false;
1011    { search in the list of internals }
1012    p:=search_assembler_symbol(internals,hs,EXT_ANY);
1013      if p=nil then
1014        p:=search_assembler_symbol(externals,hs,EXT_ANY);
1015    if p<>nil then
1016      begin
1017        instr.operands[operandnum].opr.ref.symbol:=p^.sym;
1018         case p^.exttyp of
1019            EXT_BYTE   : instr.operands[operandnum].size:=S_B;
1020            EXT_WORD   : instr.operands[operandnum].size:=S_W;
1021            EXT_NEAR,EXT_FAR,EXT_PROC,EXT_DWORD,EXT_CODEPTR,EXT_DATAPTR:
1022            instr.operands[operandnum].size:=S_L;
1023            EXT_QWORD  : instr.operands[operandnum].size:=S_FL;
1024            EXT_TBYTE  : instr.operands[operandnum].size:=S_FX;
1025          else
1026            { this is in the case where the instruction is LEA }
1027            { or something like that, in that case size is not }
1028            { important.                                       }
1029              instr.operands[operandnum].size:=S_NO;
1030          end;
1031        instr.operands[operandnum].hasvar:=true;
1032        SearchDirectVar:=TRUE;
1033        Exit;
1034      end;
1035 end;
1036 {$endif}
1037
1038 procedure TOperand.InitRef;
1039 {*********************************************************************}
1040 {  Description: This routine first check if the opcode is of     }
1041 {  type OPR_NONE, or OPR_REFERENCE , if not it gives out an error.    }
1042 {  If the operandtype = OPR_NONE or <> OPR_REFERENCE then it sets up  }
1043 {  the operand type to OPR_REFERENCE, as well as setting up the ref   }
1044 {  to point to the default segment.                                   }
1045 {*********************************************************************}
1046 Begin
1047   case opr.typ of
1048     OPR_REFERENCE:
1049       exit;
1050     OPR_NONE: ;
1051     else
1052       Message(asmr_e_invalid_operand_type);
1053   end;
1054   opr.typ := OPR_REFERENCE;
1055   reset_reference(opr.ref);
1056 end;
1057
1058
1059 procedure TOperand.BuildOperand;
1060 begin
1061   abstract;
1062 end;
1063
1064
1065 {****************************************************************************
1066                                  TInstruction
1067 ****************************************************************************}
1068
1069 constructor TInstruction.init;
1070 Begin
1071   Opcode:=A_NONE;
1072   Opsize:=S_NO;
1073   Condition:=C_NONE;
1074   Ops:=0;
1075   InitOperands;
1076 end;
1077
1078
1079 destructor TInstruction.done;
1080 var
1081   i : longint;
1082 Begin
1083   for i:=1 to 3 do
1084    Dispose(Operands[i],Done);
1085 end;
1086
1087
1088 procedure TInstruction.InitOperands;
1089 var
1090   i : longint;
1091 begin
1092   for i:=1 to 3 do
1093    New(Operands[i],init);
1094 end;
1095
1096
1097 Procedure TInstruction.SwapOperands;
1098 Var
1099   p : POperand;
1100 Begin
1101   case Ops of
1102    2 :
1103     begin
1104       p:=Operands[1];
1105       Operands[1]:=Operands[2];
1106       Operands[2]:=p;
1107     end;
1108    3 :
1109     begin
1110       p:=Operands[1];
1111       Operands[1]:=Operands[3];
1112       Operands[3]:=p;
1113     end;
1114   end;
1115 end;
1116
1117
1118 procedure TInstruction.ConcatInstruction(p:PAasmOutput);
1119 begin
1120   abstract;
1121 end;
1122
1123
1124 procedure TInstruction.BuildOpcode;
1125 begin
1126   abstract;
1127 end;
1128
1129
1130 {***************************************************************************
1131                                  TLocalLabel
1132 ***************************************************************************}
1133
1134 constructor TLocalLabel.Init(const n:string);
1135 begin
1136   inherited InitName(n);
1137   lab:=nil;
1138   emitted:=false;
1139 end;
1140
1141
1142 function TLocalLabel.Getpasmlabel:pasmlabel;
1143 begin
1144   if not assigned(lab) then
1145    begin
1146      getlabel(lab);
1147      { this label is forced to be used so it's always written }
1148      inc(lab^.refs);
1149    end;
1150   Getpasmlabel:=lab;
1151 end;
1152
1153
1154 {***************************************************************************
1155                              TLocalLabelList
1156 ***************************************************************************}
1157
1158 procedure LocalLabelEmitted(p:PNamedIndexObject);{$ifndef FPC}far;{$endif}
1159 begin
1160   if not PLocalLabel(p)^.emitted  then
1161    Message1(asmr_e_unknown_label_identifier,p^.name);
1162 end;
1163
1164 procedure TLocalLabelList.CheckEmitted;
1165 begin
1166   ForEach({$ifndef TP}@{$endif}LocalLabelEmitted)
1167 end;
1168
1169
1170 function CreateLocalLabel(const s: string; var hl: pasmlabel; emit:boolean):boolean;
1171 var
1172   lab : PLocalLabel;
1173 Begin
1174   CreateLocalLabel:=true;
1175 { Check if it already is defined }
1176   lab:=PLocalLabel(LocalLabelList^.Search(s));
1177   if not assigned(lab) then
1178    begin
1179      new(lab,init(s));
1180      LocalLabelList^.Insert(lab);
1181    end;
1182 { set emitted flag and check for dup syms }
1183   if emit then
1184    begin
1185      if lab^.Emitted then
1186       begin
1187         Message1(asmr_e_dup_local_sym,lab^.Name);
1188         CreateLocalLabel:=false;
1189       end;
1190      lab^.Emitted:=true;
1191    end;
1192   hl:=lab^.Getpasmlabel;
1193 end;
1194
1195
1196 {****************************************************************************
1197                       Symbol table helper routines
1198 ****************************************************************************}
1199
1200 Function SearchType(const hs:string): Boolean;
1201 begin
1202   getsym(hs,false);
1203   SearchType:=assigned(srsym) and
1204              (srsym^.typ=typesym);
1205 end;
1206
1207
1208
1209 Function SearchRecordType(const s:string): boolean;
1210 Begin
1211   SearchRecordType:=false;
1212 { Check the constants in symtable }
1213   getsym(s,false);
1214   if srsym <> nil then
1215    Begin
1216      case srsym^.typ of
1217        typesym :
1218          begin
1219            if ptypesym(srsym)^.restype.def^.deftype in [recorddef,objectdef] then
1220             begin
1221               SearchRecordType:=true;
1222               exit;
1223             end;
1224          end;
1225      end;
1226    end;
1227 end;
1228
1229
1230 Function SearchIConstant(const s:string; var l:longint): boolean;
1231 {**********************************************************************}
1232 {  Description: Searches for a CONSTANT of name s in either the local  }
1233 {  symbol list, then in the global symbol list, and returns the value  }
1234 {  of that constant in l. Returns TRUE if successfull, if not found,   }
1235 {  or if the constant is not of correct type, then returns FALSE       }
1236 { Remarks: Also handle TRUE and FALSE returning in those cases 1 and 0 }
1237 {  respectively.                                                       }
1238 {**********************************************************************}
1239 Begin
1240   SearchIConstant:=false;
1241 { check for TRUE or FALSE reserved words first }
1242   if s = 'TRUE' then
1243    Begin
1244      SearchIConstant:=TRUE;
1245      l:=1;
1246      exit;
1247    end;
1248   if s = 'FALSE' then
1249    Begin
1250      SearchIConstant:=TRUE;
1251      l:=0;
1252      exit;
1253    end;
1254 { Check the constants in symtable }
1255   getsym(s,false);
1256   if srsym <> nil then
1257    Begin
1258      case srsym^.typ of
1259        constsym :
1260          begin
1261            if (pconstsym(srsym)^.consttyp in [constord,constint,constchar,constbool]) then
1262             Begin
1263               l:=pconstsym(srsym)^.value;
1264               SearchIConstant:=TRUE;
1265               exit;
1266             end;
1267          end;
1268        enumsym:
1269          Begin
1270            l:=penumsym(srsym)^.value;
1271            SearchIConstant:=TRUE;
1272            exit;
1273          end;
1274      end;
1275    end;
1276 end;
1277
1278
1279 Function GetRecordOffsetSize(s:string;Var Offset: longint;var Size:longint):boolean;
1280 { search and returns the offset and size of records/objects of the base }
1281 { with field name setup in field.                              }
1282 { returns FALSE if not found.                                  }
1283 { used when base is a variable or a typed constant name.       }
1284 var
1285   st   : psymtable;
1286   harrdef : parraydef;
1287   sym  : psym;
1288   i    : longint;
1289   base : string;
1290 Begin
1291   GetRecordOffsetSize:=FALSE;
1292   Offset:=0;
1293   Size:=0;
1294   i:=pos('.',s);
1295   if i=0 then
1296    i:=255;
1297   base:=Copy(s,1,i-1);
1298   delete(s,1,i);
1299   if base='SELF' then
1300    st:=procinfo^._class^.symtable
1301   else
1302    begin
1303      getsym(base,false);
1304      sym:=srsym;
1305      st:=nil;
1306      { we can start with a var,type,typedconst }
1307      case sym^.typ of
1308        varsym :
1309          begin
1310            case pvarsym(sym)^.vartype.def^.deftype of
1311              recorddef :
1312                st:=precorddef(pvarsym(sym)^.vartype.def)^.symtable;
1313              objectdef :
1314                st:=pobjectdef(pvarsym(sym)^.vartype.def)^.symtable;
1315            end;
1316          end;
1317        typesym :
1318          begin
1319            case ptypesym(sym)^.restype.def^.deftype of
1320              recorddef :
1321                st:=precorddef(ptypesym(sym)^.restype.def)^.symtable;
1322              objectdef :
1323                st:=pobjectdef(ptypesym(sym)^.restype.def)^.symtable;
1324            end;
1325          end;
1326        typedconstsym :
1327          begin
1328            case ptypedconstsym(sym)^.typedconsttype.def^.deftype of
1329              recorddef :
1330                st:=precorddef(ptypedconstsym(sym)^.typedconsttype.def)^.symtable;
1331              objectdef :
1332                st:=pobjectdef(ptypedconstsym(sym)^.typedconsttype.def)^.symtable;
1333            end;
1334          end;
1335      end;
1336    end;
1337   { now walk all recordsymtables }
1338   while assigned(st) and (s<>'') do
1339    begin
1340      { load next field in base }
1341      i:=pos('.',s);
1342      if i=0 then
1343       i:=255;
1344      base:=Copy(s,1,i-1);
1345      delete(s,1,i);
1346      if st^.symtabletype=objectsymtable then
1347        sym:=search_class_member(pobjectdef(st^.defowner),base)
1348      else
1349        sym:=st^.search(base);
1350      if not assigned(sym) then
1351       begin
1352         GetRecordOffsetSize:=false;
1353         exit;
1354       end;
1355      st:=nil;
1356      case sym^.typ of
1357        varsym :
1358          begin
1359            inc(Offset,pvarsym(sym)^.address);
1360            Size:=PVarsym(sym)^.getsize;
1361            case pvarsym(sym)^.vartype.def^.deftype of
1362              arraydef :
1363                begin
1364                  { for arrays try to get the element size, take care of
1365                    multiple indexes }
1366                  harrdef:=Parraydef(PVarsym(sym)^.vartype.def);
1367                  while assigned(harrdef^.elementtype.def) and
1368                        (harrdef^.elementtype.def^.deftype=arraydef) do
1369                   harrdef:=parraydef(harrdef^.elementtype.def);
1370                  size:=harrdef^.elesize;
1371                end;
1372              recorddef :
1373                st:=precorddef(pvarsym(sym)^.vartype.def)^.symtable;
1374              objectdef :
1375                st:=pobjectdef(pvarsym(sym)^.vartype.def)^.symtable;
1376            end;
1377          end;
1378      end;
1379    end;
1380    GetRecordOffsetSize:=(s='');
1381 end;
1382
1383
1384 Function SearchLabel(const s: string; var hl: pasmlabel;emit:boolean): boolean;
1385 var
1386   sym : psym;
1387   hs  : string;
1388 Begin
1389   hl:=nil;
1390   SearchLabel:=false;
1391 { Check for pascal labels, which are case insensetive }
1392   hs:=upper(s);
1393   getsym(hs,false);
1394   sym:=srsym;
1395   if sym=nil then
1396    exit;
1397   case sym^.typ of
1398     labelsym :
1399       begin
1400         hl:=plabelsym(sym)^.lab;
1401         if emit then
1402          plabelsym(sym)^.defined:=true
1403         else
1404          plabelsym(sym)^.used:=true;
1405         SearchLabel:=true;
1406         exit;
1407       end;
1408   end;
1409 end;
1410
1411
1412  {*************************************************************************}
1413  {                   Instruction Generation Utilities                      }
1414  {*************************************************************************}
1415
1416
1417    Procedure ConcatString(p : paasmoutput;s:string);
1418   {*********************************************************************}
1419   { PROCEDURE ConcatString(s:string);                                   }
1420   {  Description: This routine adds the character chain pointed to in   }
1421   {  s to the instruction linked list.                                  }
1422   {*********************************************************************}
1423   Var
1424    pc: PChar;
1425   Begin
1426      getmem(pc,length(s)+1);
1427      p^.concat(new(pai_string,init_length_pchar(strpcopy(pc,s),length(s))));
1428   end;
1429
1430   Procedure ConcatPasString(p : paasmoutput;s:string);
1431   {*********************************************************************}
1432   { PROCEDURE ConcatPasString(s:string);                                }
1433   {  Description: This routine adds the character chain pointed to in   }
1434   {  s to the instruction linked list, contrary to ConcatString it      }
1435   {  uses a pascal style string, so it conserves null characters.       }
1436   {*********************************************************************}
1437   Begin
1438      p^.concat(new(pai_string,init(s)));
1439   end;
1440
1441   Procedure ConcatDirect(p : paasmoutput;s:string);
1442   {*********************************************************************}
1443   { PROCEDURE ConcatDirect(s:string)                                    }
1444   {  Description: This routine output the string directly to the asm    }
1445   {  output, it is only sed when writing special labels in AT&T mode,   }
1446   {  and should not be used without due consideration, since it may     }
1447   {  cause problems.                                                    }
1448   {*********************************************************************}
1449   Var
1450    pc: PChar;
1451   Begin
1452      getmem(pc,length(s)+1);
1453      p^.concat(new(pai_direct,init(strpcopy(pc,s))));
1454   end;
1455
1456
1457
1458
1459 Procedure ConcatConstant(p: paasmoutput; value: longint; maxvalue: longint);
1460 {*********************************************************************}
1461 { PROCEDURE ConcatConstant(value: longint; maxvalue: longint);        }
1462 {  Description: This routine adds the value constant to the current   }
1463 {  instruction linked list.                                           }
1464 {   maxvalue -> indicates the size of the data to initialize:         }
1465 {                  $ff -> create a byte node.                         }
1466 {                  $ffff -> create a word node.                       }
1467 {                  $ffffffff -> create a dword node.                  }
1468 {*********************************************************************}
1469 Begin
1470   if (maxvalue <> longint($ffffffff)) and (value > maxvalue) then
1471    Begin
1472      Message(asmr_e_constant_out_of_bounds);
1473      { assuming a value of maxvalue }
1474      value:=maxvalue;
1475    end;
1476   if maxvalue = $ff then
1477    p^.concat(new(pai_const,init_8bit(byte(value))))
1478   else
1479    if maxvalue = $ffff then
1480     p^.concat(new(pai_const,init_16bit(word(value))))
1481   else
1482    if maxvalue = longint($ffffffff) then
1483     p^.concat(new(pai_const,init_32bit(longint(value))));
1484 end;
1485
1486
1487   Procedure ConcatConstSymbol(p : paasmoutput;const sym:string;l:longint);
1488   begin
1489     p^.concat(new(pai_const_symbol,initname_offset(sym,l)));
1490   end;
1491
1492
1493   Procedure ConcatRealConstant(p : paasmoutput;value: bestreal; real_typ : tfloattype);
1494   {***********************************************************************}
1495   { PROCEDURE ConcatRealConstant(value: bestreal; real_typ : tfloattype); }
1496   {  Description: This routine adds the value constant to the current     }
1497   {  instruction linked list.                                             }
1498   {   real_typ -> indicates the type of the real data to initialize:      }
1499   {                  s32real -> create a single node.                     }
1500   {                  s64real -> create a double node.                     }
1501   {                  s80real -> create an extended node.                  }
1502   {                  s64bit ->  create a  comp node.                      }
1503   {                  f32bit ->  create a  fixed node. (not used normally) }
1504   {***********************************************************************}
1505     Begin
1506        case real_typ of
1507           s32real : p^.concat(new(pai_real_32bit,init(value)));
1508           s64real : p^.concat(new(pai_real_64bit,init(value)));
1509           s80real : p^.concat(new(pai_real_80bit,init(value)));
1510           s64comp : p^.concat(new(pai_comp_64bit,init(value)));
1511           f32bit  : p^.concat(new(pai_const,init_32bit(trunc(value*$10000))));
1512        end;
1513     end;
1514
1515    Procedure ConcatLabel(p: paasmoutput;var l : pasmlabel);
1516   {*********************************************************************}
1517   { PROCEDURE ConcatLabel                                               }
1518   {  Description: This routine either emits a label or a labeled        }
1519   {  instruction to the linked list of instructions.                    }
1520   {*********************************************************************}
1521    begin
1522      p^.concat(new(pai_label,init(l)));
1523    end;
1524
1525    procedure ConcatAlign(p:paasmoutput;l:longint);
1526   {*********************************************************************}
1527   { PROCEDURE ConcatPublic                                              }
1528   {  Description: This routine emits an global   definition to the      }
1529   {  linked list of instructions.(used by AT&T styled asm)              }
1530   {*********************************************************************}
1531    begin
1532      p^.concat(new(pai_align,init(l)));
1533    end;
1534
1535    procedure ConcatPublic(p:paasmoutput;const s : string);
1536   {*********************************************************************}
1537   { PROCEDURE ConcatPublic                                              }
1538   {  Description: This routine emits an global   definition to the      }
1539   {  linked list of instructions.(used by AT&T styled asm)              }
1540   {*********************************************************************}
1541    begin
1542        p^.concat(new(pai_symbol,initname_global(s,0)));
1543    end;
1544
1545    procedure ConcatLocal(p:paasmoutput;const s : string);
1546   {*********************************************************************}
1547   { PROCEDURE ConcatLocal                                               }
1548   {  Description: This routine emits an local    definition to the      }
1549   {  linked list of instructions.                                       }
1550   {*********************************************************************}
1551    begin
1552        p^.concat(new(pai_symbol,initname(s,0)));
1553    end;
1554
1555   Procedure ConcatGlobalBss(const s : string;size : longint);
1556   {*********************************************************************}
1557   { PROCEDURE ConcatGlobalBss                                           }
1558   {  Description: This routine emits an global  datablock   to the      }
1559   {  linked list of instructions.                                       }
1560   {*********************************************************************}
1561    begin
1562        bsssegment^.concat(new(pai_datablock,init_global(s,size)));
1563    end;
1564
1565   Procedure ConcatLocalBss(const s : string;size : longint);
1566   {*********************************************************************}
1567   { PROCEDURE ConcatLocalBss                                            }
1568   {  Description: This routine emits a local datablcok      to the      }
1569   {  linked list of instructions.                                       }
1570   {*********************************************************************}
1571    begin
1572        bsssegment^.concat(new(pai_datablock,init(s,size)));
1573    end;
1574
1575 end.
1576 {
1577   $Log$
1578   Revision 1.1  2002/02/19 08:23:45  sasu
1579   Initial revision
1580
1581   Revision 1.1.2.4  2000/11/06 16:57:38  pierre
1582    * issue error in TP and Delphi modes if result is a register
1583
1584   Revision 1.1.2.3  2000/10/31 07:30:12  pierre
1585    * fix for bug 1157 second part
1586
1587   Revision 1.1.2.2  2000/10/07 23:41:06  pierre
1588    * fix for bug 1157
1589
1590   Revision 1.1.2.1  2000/08/06 10:29:03  peter
1591     * fixed expression evaluator (bug 1090)
1592
1593   Revision 1.1  2000/07/13 06:29:56  michael
1594   + Initial import
1595
1596   Revision 1.46  2000/05/26 18:23:11  peter
1597     * fixed % parsing and added modulo support
1598     * changed some evaulator errors to more generic illegal expresion
1599
1600   Revision 1.45  2000/05/23 20:36:28  peter
1601     + typecasting support for variables, but be carefull as word,byte can't
1602       be used because they are reserved assembler keywords
1603
1604   Revision 1.44  2000/05/22 12:47:52  pierre
1605    fix wrong handling of var para for size bug 961
1606
1607   Revision 1.43  2000/05/18 17:05:16  peter
1608     * fixed size of const parameters in asm readers
1609
1610   Revision 1.42  2000/05/11 09:56:22  pierre
1611     * fixed several compare problems between longints and
1612       const > $80000000 that are treated as int64 constanst
1613       by Delphi reported by Kovacs Attila Zoltan
1614
1615   Revision 1.41  2000/05/08 13:23:05  peter
1616     * fixed reference parsing
1617
1618   Revision 1.40  2000/04/06 07:56:04  pierre
1619    * bug in TOperand.SetSize corrected
1620
1621   Revision 1.39  2000/04/04 13:48:45  pierre
1622     + TOperand.SetCorrectSize virtual method added
1623       to be able to change the suffix according to the instruction
1624       (FIADD word ptr w need a s as ATT suffix
1625       wheras FILD word ptr w need a w suffix :( )
1626
1627   Revision 1.38  2000/03/28 22:10:12  pierre
1628    * Object fields are simple offsets in TP/Delphi mode
1629
1630   Revision 1.37  2000/03/16 15:10:25  pierre
1631    * correct the fixups for inlined assembler code
1632
1633   Revision 1.36  2000/03/15 23:10:01  pierre
1634     * fix for bug 848 (that still genrated wrong code)
1635     + better testing for variables used in assembler
1636       (gives an error if variable is not directly reachable !)
1637
1638   Revision 1.35  2000/02/09 13:23:03  peter
1639     * log truncated
1640
1641   Revision 1.34  2000/01/07 01:14:37  peter
1642     * updated copyright to 2000
1643
1644   Revision 1.33  1999/12/22 00:57:30  peter
1645     * label are set to used so an error is given if used but not defined
1646
1647   Revision 1.32  1999/12/17 10:43:34  florian
1648     * 761 fixed
1649
1650   Revision 1.31  1999/11/30 10:40:54  peter
1651     + ttype, tsymlist
1652
1653   Revision 1.30  1999/11/17 17:05:04  pierre
1654    * Notes/hints changes
1655
1656   Revision 1.29  1999/11/09 23:06:46  peter
1657     * esi_offset -> selfpointer_offset to be newcg compatible
1658     * hcogegen -> cgbase fixes for newcg
1659
1660   Revision 1.28  1999/11/06 14:34:26  peter
1661     * truncated log to 20 revs
1662
1663   Revision 1.27  1999/09/27 23:44:58  peter
1664     * procinfo is now a pointer
1665     * support for result setting in sub procedure
1666
1667   Revision 1.26  1999/09/08 16:04:04  peter
1668     * better support for object fields and more error checks for
1669       field accesses which create buggy code
1670
1671   Revision 1.25  1999/09/04 20:29:11  florian
1672     * bug 577 fixed
1673
1674   Revision 1.24  1999/08/27 14:37:50  peter
1675     * fixed crash with typedconst array
1676
1677   Revision 1.23  1999/08/13 21:28:38  peter
1678     * more reference types support
1679     * arraydef size returns elementsize, also for multiple indexing array
1680
1681   Revision 1.22  1999/08/04 00:23:28  florian
1682     * renamed i386asm and i386base to cpuasm and cpubase
1683
1684   Revision 1.21  1999/08/03 22:03:12  peter
1685     * moved bitmask constants to sets
1686     * some other type/const renamings
1687
1688   Revision 1.20  1999/07/29 20:54:06  peter
1689     * write .size also
1690
1691 }