PageRenderTime 27ms CodeModel.GetById 21ms app.highlight 2ms RepoModel.GetById 0ms app.codeStats 1ms

/compiler/arm/cpubase.pas

https://github.com/slibre/freepascal
Pascal | 686 lines | 431 code | 116 blank | 139 comment | 21 complexity | a07d2b41d5a4b27aed782440fe917bec MD5 | raw file
Possible License(s): LGPL-2.0, LGPL-2.1, LGPL-3.0
  1{
  2    Copyright (c) 1998-2002 by Florian Klaempfl and Peter Vreman
  3
  4    Contains the base types for the ARM
  5
  6    This program is free software; you can redistribute it and/or modify
  7    it under the terms of the GNU General Public License as published by
  8    the Free Software Foundation; either version 2 of the License, or
  9    (at your option) any later version.
 10
 11    This program is distributed in the hope that it will be useful,
 12    but WITHOUT ANY WARRANTY; without even the implied warranty of
 13    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 14    GNU General Public License for more details.
 15
 16    You should have received a copy of the GNU General Public License
 17    along with this program; if not, write to the Free Software
 18    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
 19
 20 ****************************************************************************
 21}
 22{# Base unit for processor information. This unit contains
 23   enumerations of registers, opcodes, sizes, and other
 24   such things which are processor specific.
 25}
 26unit cpubase;
 27
 28{$define USEINLINE}
 29
 30{$i fpcdefs.inc}
 31
 32  interface
 33
 34    uses
 35      globtype,globals,
 36      cpuinfo,
 37      cgbase
 38      ;
 39
 40
 41{*****************************************************************************
 42                                Assembler Opcodes
 43*****************************************************************************}
 44
 45    type
 46      TAsmOp= {$i armop.inc}
 47      {This is a bit of a hack, because there are more than 256 ARM Assembly Ops
 48       But FPC currently can't handle more than 256 elements in a set.}
 49      TCommonAsmOps = Set of A_None .. A_UQASX;
 50
 51      { This should define the array of instructions as string }
 52      op2strtable=array[tasmop] of string[11];
 53
 54    const
 55      { First value of opcode enumeration }
 56      firstop = low(tasmop);
 57      { Last value of opcode enumeration  }
 58      lastop  = high(tasmop);
 59
 60{*****************************************************************************
 61                                  Registers
 62*****************************************************************************}
 63
 64    type
 65      { Number of registers used for indexing in tables }
 66      tregisterindex=0..{$i rarmnor.inc}-1;
 67
 68    const
 69      { Available Superregisters }
 70      {$i rarmsup.inc}
 71
 72      RS_PC = RS_R15;
 73
 74      { No Subregisters }
 75      R_SUBWHOLE = R_SUBNONE;
 76
 77      { Available Registers }
 78      {$i rarmcon.inc}
 79
 80      { aliases }
 81      NR_PC = NR_R15;
 82
 83      { Integer Super registers first and last }
 84      first_int_supreg = RS_R0;
 85      first_int_imreg = $10;
 86
 87      { Float Super register first and last }
 88      first_fpu_supreg    = RS_F0;
 89      first_fpu_imreg     = $08;
 90
 91      { MM Super register first and last }
 92      first_mm_supreg    = RS_S0;
 93      first_mm_imreg     = $30;
 94
 95{ TODO: Calculate bsstart}
 96      regnumber_count_bsstart = 64;
 97
 98      regnumber_table : array[tregisterindex] of tregister = (
 99        {$i rarmnum.inc}
100      );
101
102      regstabs_table : array[tregisterindex] of shortint = (
103        {$i rarmsta.inc}
104      );
105
106      regdwarf_table : array[tregisterindex] of shortint = (
107        {$i rarmdwa.inc}
108      );
109      { registers which may be destroyed by calls }
110      VOLATILE_INTREGISTERS = [RS_R0..RS_R3,RS_R12..RS_R14];
111      VOLATILE_FPUREGISTERS = [RS_F0..RS_F3];
112      VOLATILE_MMREGISTERS =  [RS_D0..RS_D7,RS_D16..RS_D31,RS_S1..RS_S15];
113
114      VOLATILE_INTREGISTERS_DARWIN = [RS_R0..RS_R3,RS_R9,RS_R12..RS_R14];
115
116    type
117      totherregisterset = set of tregisterindex;
118
119{*****************************************************************************
120                          Instruction post fixes
121*****************************************************************************}
122    type
123      { ARM instructions load/store and arithmetic instructions
124        can have several instruction post fixes which are collected
125        in this enumeration
126      }
127      TOpPostfix = (PF_None,
128        { update condition flags
129          or floating point single }
130        PF_S,
131        { floating point size }
132        PF_D,PF_E,PF_P,PF_EP,
133        { load/store }
134        PF_B,PF_SB,PF_BT,PF_H,PF_SH,PF_T,
135        { multiple load/store address modes }
136        PF_IA,PF_IB,PF_DA,PF_DB,PF_FD,PF_FA,PF_ED,PF_EA,
137        { multiple load/store vfp address modes }
138        PF_IAD,PF_DBD,PF_FDD,PF_EAD,
139        PF_IAS,PF_DBS,PF_FDS,PF_EAS,
140        PF_IAX,PF_DBX,PF_FDX,PF_EAX,
141        { FPv4 postfixes }
142        PF_32,PF_64,PF_F32,PF_F64,
143        PF_F32S32,PF_F32U32,
144        PF_S32F32,PF_U32F32
145      );
146
147      TOpPostfixes = set of TOpPostfix;
148
149      TRoundingMode = (RM_None,RM_P,RM_M,RM_Z);
150
151    const
152      cgsize2fpuoppostfix : array[OS_NO..OS_F128] of toppostfix = (
153        PF_None,
154        PF_None,PF_None,PF_None,PF_None,PF_None,PF_None,PF_None,PF_None,PF_None,PF_None,
155        PF_S,PF_D,PF_E,PF_None,PF_None);
156
157      oppostfix2str : array[TOpPostfix] of string[8] = ('',
158        's',
159        'd','e','p','ep',
160        'b','sb','bt','h','sh','t',
161        'ia','ib','da','db','fd','fa','ed','ea',
162        'iad','dbd','fdd','ead',
163        'ias','dbs','fds','eas',
164        'iax','dbx','fdx','eax',
165        '.32','.64','.f32','.f64',
166        '.f32.s32','.f32.u32',
167        '.s32.f32','.u32.f32');
168
169      roundingmode2str : array[TRoundingMode] of string[1] = ('',
170        'p','m','z');
171
172{*****************************************************************************
173                                Conditions
174*****************************************************************************}
175
176    type
177      TAsmCond=(C_None,
178        C_EQ,C_NE,C_CS,C_CC,C_MI,C_PL,C_VS,C_VC,C_HI,C_LS,
179        C_GE,C_LT,C_GT,C_LE,C_AL,C_NV
180      );
181
182      TAsmConds = set of TAsmCond;
183
184    const
185      cond2str : array[TAsmCond] of string[2]=('',
186        'eq','ne','cs','cc','mi','pl','vs','vc','hi','ls',
187        'ge','lt','gt','le','al','nv'
188      );
189
190      uppercond2str : array[TAsmCond] of string[2]=('',
191        'EQ','NE','CS','CC','MI','PL','VS','VC','HI','LS',
192        'GE','LT','GT','LE','AL','NV'
193      );
194
195{*****************************************************************************
196                                   Flags
197*****************************************************************************}
198
199    type
200      TResFlags = (F_EQ,F_NE,F_CS,F_CC,F_MI,F_PL,F_VS,F_VC,F_HI,F_LS,
201        F_GE,F_LT,F_GT,F_LE);
202
203{*****************************************************************************
204                                Operands
205*****************************************************************************}
206
207      taddressmode = (AM_OFFSET,AM_PREINDEXED,AM_POSTINDEXED);
208      tshiftmode = (SM_None,SM_LSL,SM_LSR,SM_ASR,SM_ROR,SM_RRX);
209
210      tupdatereg = (UR_None,UR_Update);
211
212      pshifterop = ^tshifterop;
213
214      tshifterop = record
215        shiftmode : tshiftmode;
216        rs : tregister;
217        shiftimm : byte;
218      end;
219
220      tcpumodeflag = (mfA, mfI, mfF);
221      tcpumodeflags = set of tcpumodeflag;
222
223      tspecialregflag = (srC, srX, srS, srF);
224      tspecialregflags = set of tspecialregflag;
225
226{*****************************************************************************
227                                 Constants
228*****************************************************************************}
229
230    const
231      max_operands = 6;
232
233      maxintregs = 15;
234      maxfpuregs = 8;
235      maxaddrregs = 0;
236
237{*****************************************************************************
238                                Operand Sizes
239*****************************************************************************}
240
241    type
242      topsize = (S_NO,
243        S_B,S_W,S_L,S_BW,S_BL,S_WL,
244        S_IS,S_IL,S_IQ,
245        S_FS,S_FL,S_FX,S_D,S_Q,S_FV,S_FXX
246      );
247
248{*****************************************************************************
249                                 Constants
250*****************************************************************************}
251
252    const
253      maxvarregs = 7;
254      varregs : Array [1..maxvarregs] of tsuperregister =
255                (RS_R4,RS_R5,RS_R6,RS_R7,RS_R8,RS_R9,RS_R10);
256
257      maxfpuvarregs = 4;
258      fpuvarregs : Array [1..maxfpuvarregs] of tsuperregister =
259                (RS_F4,RS_F5,RS_F6,RS_F7);
260
261{*****************************************************************************
262                          Default generic sizes
263*****************************************************************************}
264
265      { Defines the default address size for a processor, }
266      OS_ADDR = OS_32;
267      { the natural int size for a processor,
268        has to match osuinttype/ossinttype as initialized in psystem }
269      OS_INT = OS_32;
270      OS_SINT = OS_S32;
271      { the maximum float size for a processor,           }
272      OS_FLOAT = OS_F64;
273      { the size of a vector register for a processor     }
274      OS_VECTOR = OS_M32;
275
276{*****************************************************************************
277                          Generic Register names
278*****************************************************************************}
279
280      { Stack pointer register }
281      NR_STACK_POINTER_REG = NR_R13;
282      RS_STACK_POINTER_REG = RS_R13;
283      { Frame pointer register (initialized in tarmprocinfo.init_framepointer) }
284      RS_FRAME_POINTER_REG: tsuperregister = RS_NO;
285      NR_FRAME_POINTER_REG: tregister = NR_NO;
286      { Register for addressing absolute data in a position independant way,
287        such as in PIC code. The exact meaning is ABI specific. For
288        further information look at GCC source : PIC_OFFSET_TABLE_REGNUM
289      }
290      NR_PIC_OFFSET_REG = NR_R9;
291      { Results are returned in this register (32-bit values) }
292      NR_FUNCTION_RETURN_REG = NR_R0;
293      RS_FUNCTION_RETURN_REG = RS_R0;
294      { The value returned from a function is available in this register }
295      NR_FUNCTION_RESULT_REG = NR_FUNCTION_RETURN_REG;
296      RS_FUNCTION_RESULT_REG = RS_FUNCTION_RETURN_REG;
297
298      NR_FPU_RESULT_REG = NR_F0;
299
300      NR_MM_RESULT_REG  = NR_D0;
301
302      NR_RETURN_ADDRESS_REG = NR_FUNCTION_RETURN_REG;
303
304      { Offset where the parent framepointer is pushed }
305      PARENT_FRAMEPOINTER_OFFSET = 0;
306
307      NR_DEFAULTFLAGS = NR_CPSR;
308      RS_DEFAULTFLAGS = RS_CPSR;
309
310      { Low part of 64bit return value }
311      function NR_FUNCTION_RESULT64_LOW_REG: tregister;{$ifdef USEINLINE}inline;{$endif USEINLINE}
312      function RS_FUNCTION_RESULT64_LOW_REG: shortint;{$ifdef USEINLINE}inline;{$endif USEINLINE}
313      { High part of 64bit return value }
314      function NR_FUNCTION_RESULT64_HIGH_REG: tregister;{$ifdef USEINLINE}inline;{$endif USEINLINE}
315      function RS_FUNCTION_RESULT64_HIGH_REG: shortint;{$ifdef USEINLINE}inline;{$endif USEINLINE}
316
317{*****************************************************************************
318                       GCC /ABI linking information
319*****************************************************************************}
320
321    const
322      { Registers which must be saved when calling a routine declared as
323        cppdecl, cdecl, stdcall, safecall, palmossyscall. The registers
324        saved should be the ones as defined in the target ABI and / or GCC.
325
326        This value can be deduced from the CALLED_USED_REGISTERS array in the
327        GCC source.
328      }
329      saved_standard_registers : array[0..6] of tsuperregister =
330        (RS_R4,RS_R5,RS_R6,RS_R7,RS_R8,RS_R9,RS_R10);
331
332      { this is only for the generic code which is not used for this architecture }
333      saved_mm_registers : array[0..0] of tsuperregister = (RS_INVALID);
334
335      { Required parameter alignment when calling a routine declared as
336        stdcall and cdecl. The alignment value should be the one defined
337        by GCC or the target ABI.
338
339        The value of this constant is equal to the constant
340        PARM_BOUNDARY / BITS_PER_UNIT in the GCC source.
341      }
342      std_param_align = 4;
343
344
345{*****************************************************************************
346                                  Helpers
347*****************************************************************************}
348
349    { Returns the tcgsize corresponding with the size of reg.}
350    function reg_cgsize(const reg: tregister) : tcgsize;
351    function cgsize2subreg(regtype: tregistertype; s:Tcgsize):Tsubregister;
352    function is_calljmp(o:tasmop):boolean;{$ifdef USEINLINE}inline;{$endif USEINLINE}
353    procedure inverse_flags(var f: TResFlags);
354    function flags_to_cond(const f: TResFlags) : TAsmCond;
355    function findreg_by_number(r:Tregister):tregisterindex;
356    function std_regnum_search(const s:string):Tregister;
357    function std_regname(r:Tregister):string;
358
359    function inverse_cond(const c: TAsmCond): TAsmCond; {$ifdef USEINLINE}inline;{$endif USEINLINE}
360    function conditions_equal(const c1, c2: TAsmCond): boolean; {$ifdef USEINLINE}inline;{$endif USEINLINE}
361
362    procedure shifterop_reset(var so : tshifterop); {$ifdef USEINLINE}inline;{$endif USEINLINE}
363    function is_pc(const r : tregister) : boolean; {$ifdef USEINLINE}inline;{$endif USEINLINE}
364
365    function is_shifter_const(d : aint;var imm_shift : byte) : boolean;
366    function is_thumb_imm(d : aint) : boolean; { Doesn't handle ROR_C detection }
367    function split_into_shifter_const(value : aint;var imm1: dword; var imm2: dword):boolean;
368    function dwarf_reg(r:tregister):shortint;
369
370    function IsIT(op: TAsmOp) : boolean;
371    function GetITLevels(op: TAsmOp) : longint;
372
373  implementation
374
375    uses
376      systems,rgBase,verbose;
377
378
379    const
380      std_regname_table : TRegNameTable = (
381        {$i rarmstd.inc}
382      );
383
384      regnumber_index : array[tregisterindex] of tregisterindex = (
385        {$i rarmrni.inc}
386      );
387
388      std_regname_index : array[tregisterindex] of tregisterindex = (
389        {$i rarmsri.inc}
390      );
391
392
393    function cgsize2subreg(regtype: tregistertype; s:Tcgsize):Tsubregister;
394      begin
395        case regtype of
396          R_MMREGISTER:
397            begin
398              case s of
399                OS_F32:
400                  cgsize2subreg:=R_SUBFS;
401                OS_F64:
402                  cgsize2subreg:=R_SUBFD;
403                else
404                  internalerror(2009112701);
405              end;
406            end;
407          else
408            cgsize2subreg:=R_SUBWHOLE;
409        end;
410      end;
411
412
413    function reg_cgsize(const reg: tregister): tcgsize;
414      begin
415        case getregtype(reg) of
416          R_INTREGISTER :
417            reg_cgsize:=OS_32;
418          R_FPUREGISTER :
419            reg_cgsize:=OS_F80;
420          R_MMREGISTER :
421            begin
422              case getsubreg(reg) of
423                R_SUBFD,
424                R_SUBWHOLE:
425                  result:=OS_F64;
426                R_SUBFS:
427                  result:=OS_F32;
428                else
429                  internalerror(2009112903);
430              end;
431            end;
432          else
433            internalerror(200303181);
434          end;
435        end;
436
437
438    function is_calljmp(o:tasmop):boolean;{$ifdef USEINLINE}inline;{$endif USEINLINE}
439      begin
440        { This isn't 100% perfect because the arm allows jumps also by writing to PC=R15.
441          To overcome this problem we simply forbid that FPC generates jumps by loading R15 }
442        is_calljmp:= o in [A_B,A_BL,A_BX,A_BLX];
443      end;
444
445
446    procedure inverse_flags(var f: TResFlags);
447      const
448        inv_flags: array[TResFlags] of TResFlags =
449          (F_NE,F_EQ,F_CC,F_CS,F_PL,F_MI,F_VC,F_VS,F_LS,F_HI,
450          F_LT,F_GE,F_LE,F_GT);
451      begin
452        f:=inv_flags[f];
453      end;
454
455
456    function flags_to_cond(const f: TResFlags) : TAsmCond;
457      const
458        flag_2_cond: array[F_EQ..F_LE] of TAsmCond =
459          (C_EQ,C_NE,C_CS,C_CC,C_MI,C_PL,C_VS,C_VC,C_HI,C_LS,
460           C_GE,C_LT,C_GT,C_LE);
461      begin
462        if f>high(flag_2_cond) then
463          internalerror(200112301);
464        result:=flag_2_cond[f];
465      end;
466
467
468    function findreg_by_number(r:Tregister):tregisterindex;
469      begin
470        result:=rgBase.findreg_by_number_table(r,regnumber_index);
471      end;
472
473
474    function std_regnum_search(const s:string):Tregister;
475      begin
476        result:=regnumber_table[findreg_by_name_table(s,std_regname_table,std_regname_index)];
477      end;
478
479
480    function std_regname(r:Tregister):string;
481      var
482        p : tregisterindex;
483      begin
484        p:=findreg_by_number_table(r,regnumber_index);
485        if p<>0 then
486          result:=std_regname_table[p]
487        else
488          result:=generic_regname(r);
489      end;
490
491
492    procedure shifterop_reset(var so : tshifterop);{$ifdef USEINLINE}inline;{$endif USEINLINE}
493      begin
494        FillChar(so,sizeof(so),0);
495      end;
496
497
498    function is_pc(const r : tregister) : boolean; {$ifdef USEINLINE}inline;{$endif USEINLINE}
499      begin
500        is_pc:=(r=NR_R15);
501      end;
502
503
504    function inverse_cond(const c: TAsmCond): TAsmCond; {$ifdef USEINLINE}inline;{$endif USEINLINE}
505      const
506        inverse: array[TAsmCond] of TAsmCond=(C_None,
507          C_NE,C_EQ,C_CC,C_CS,C_PL,C_MI,C_VC,C_VS,C_LS,C_HI,
508          C_LT,C_GE,C_LE,C_GT,C_None,C_None
509        );
510      begin
511        result := inverse[c];
512      end;
513
514
515    function conditions_equal(const c1, c2: TAsmCond): boolean; {$ifdef USEINLINE}inline;{$endif USEINLINE}
516      begin
517        result := c1 = c2;
518      end;
519
520
521    function is_shifter_const(d : aint;var imm_shift : byte) : boolean;
522      var
523         i : longint;
524      begin
525        if current_settings.cputype in cpu_thumb2 then
526          begin
527            for i:=0 to 24 do
528              begin
529                 if (dword(d) and not($ff shl i))=0 then
530                   begin
531                     imm_shift:=i;
532                     result:=true;
533                     exit;
534                   end;
535              end;
536          end
537        else
538          begin
539            for i:=0 to 15 do
540              begin
541                 if (dword(d) and not(roldword($ff,i*2)))=0 then
542                   begin
543                      imm_shift:=i*2;
544                      result:=true;
545                      exit;
546                   end;
547              end;
548          end;
549        result:=false;
550      end;
551
552    function is_thumb_imm(d: aint): boolean;
553      var
554        t : aint;
555        i : longint;
556        imm : byte;
557      begin
558        result:=false;
559        if (d and $FF) = d then
560          begin
561            result:=true;
562            exit;
563          end;
564        if ((d and $FF00FF00) = 0) and
565           ((d shr 16)=(d and $FFFF)) then
566          begin
567            result:=true;
568            exit;
569          end;
570        if ((d and $00FF00FF) = 0) and
571           ((d shr 16)=(d and $FFFF)) then
572          begin
573            result:=true;
574            exit;
575          end;
576        if ((d shr 16)=(d and $FFFF)) and
577           ((d shr 8)=(d and $FF)) then
578          begin
579            result:=true;
580            exit;
581          end;
582        if is_shifter_const(d,imm) then
583          begin
584            result:=true;
585            exit;
586          end;
587      end;
588
589    function split_into_shifter_const(value : aint;var imm1: dword; var imm2: dword) : boolean;
590      var
591        d, i, i2: Dword;
592      begin
593        Result:=false;
594        {Thumb2 is not supported (YET?)}
595        if current_settings.cputype in cpu_thumb2 then exit;
596        d:=DWord(value);
597        for i:=0 to 15 do
598          begin
599            imm1:=d and rordword($FF, I*2);
600            imm2:=d and not (imm1); {remove already found bits}
601            {is the remainder a shifterconst? YAY! we've done it!}
602            {Could we start from i instead of 0?}
603            for i2:=0 to 15 do
604              begin
605                 if (imm2 and not(rordword($FF,i2*2)))=0 then
606                   begin
607                      result:=true;
608                      exit;
609                   end;
610              end;
611          end;
612      end;
613
614    function dwarf_reg(r:tregister):shortint;
615      begin
616        result:=regdwarf_table[findreg_by_number(r)];
617        if result=-1 then
618          internalerror(200603251);
619      end;
620
621      { Low part of 64bit return value }
622    function NR_FUNCTION_RESULT64_LOW_REG: tregister; {$ifdef USEINLINE}inline;{$endif USEINLINE}
623    begin
624      if target_info.endian=endian_little then
625        result:=NR_R0
626      else
627        result:=NR_R1;
628    end;
629
630    function RS_FUNCTION_RESULT64_LOW_REG: shortint; {$ifdef USEINLINE}inline;{$endif USEINLINE}
631    begin
632      if target_info.endian=endian_little then
633        result:=RS_R0
634      else
635        result:=RS_R1;
636    end;
637
638      { High part of 64bit return value }
639    function NR_FUNCTION_RESULT64_HIGH_REG: tregister; {$ifdef USEINLINE}inline;{$endif USEINLINE}
640    begin
641      if target_info.endian=endian_little then
642        result:=NR_R1
643      else
644        result:=NR_R0;
645    end;
646
647    function RS_FUNCTION_RESULT64_HIGH_REG: shortint; {$ifdef USEINLINE}inline;{$endif USEINLINE}
648    begin
649      if target_info.endian=endian_little then
650        result:=RS_R1
651      else
652        result:=RS_R0;
653    end;
654
655    function IsIT(op: TAsmOp) : boolean;
656      begin
657        case op of
658          A_IT,
659          A_ITE, A_ITT,
660          A_ITEE, A_ITTE, A_ITET, A_ITTT,
661          A_ITEEE, A_ITTEE, A_ITETE, A_ITTTE,
662          A_ITEET, A_ITTET, A_ITETT, A_ITTTT:
663            result:=true;
664        else
665          result:=false;
666        end;
667      end;
668
669    function GetITLevels(op: TAsmOp) : longint;
670      begin
671        case op of
672          A_IT:
673            result:=1;
674          A_ITE, A_ITT:
675            result:=2;
676          A_ITEE, A_ITTE, A_ITET, A_ITTT:
677            result:=3;
678          A_ITEEE, A_ITTEE, A_ITETE, A_ITTTE,
679          A_ITEET, A_ITTET, A_ITETT, A_ITTTT:
680            result:=4;
681        else
682          result:=0;
683        end;
684      end;
685
686end.