3 Copyright (c) 1998-2000 by Carl Eric Codere and Peter Vreman
5 Does the parsing for the AT&T styled inline assembler.
7 This program is free software; you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation; either version 2 of the License, or
10 (at your option) any later version.
12 This program is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 GNU General Public License for more details.
17 You should have received a copy of the GNU General Public License
18 along with this program; if not, write to the Free Software
19 Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
21 ****************************************************************************
32 function assemble
: ptree
;
39 strings
,cobjects
,systems
,verbose
,globals
,
40 files
,aasm
,types
,symconst
,symtable
,scanner
,cpubase
,
50 AS_NONE
,AS_LABEL
,AS_LLABEL
,AS_STRING
,AS_INTNUM
,
51 AS_REALNUM
,AS_COMMA
,AS_LPAREN
,
52 AS_RPAREN
,AS_COLON
,AS_DOT
,AS_PLUS
,AS_MINUS
,AS_STAR
,
53 AS_SEPARATOR
,AS_ID
,AS_REGISTER
,AS_OPCODE
,AS_SLASH
,AS_DOLLAR
,
54 {------------------ Assembler directives --------------------}
55 AS_DB
,AS_DW
,AS_DD
,AS_DQ
,AS_GLOBAL
,
56 AS_ALIGN
,AS_BALIGN
,AS_P2ALIGN
,AS_ASCII
,
57 AS_ASCIIZ
,AS_LCOMM
,AS_COMM
,AS_SINGLE
,AS_DOUBLE
,AS_EXTENDED
,
58 AS_DATA
,AS_TEXT
,AS_END
,
59 {------------------ Assembler Operators --------------------}
60 AS_TYPE
,AS_MOD
,AS_SHL
,AS_SHR
,AS_NOT
,AS_AND
,AS_OR
,AS_XOR
,AS_NOR
);
62 tasmkeyword
= string[10];
65 { These tokens should be modified accordingly to the modifications }
66 { in the different enumerations. }
67 firstdirective
= AS_DB
;
68 lastdirective
= AS_END
;
70 _count_asmprefixes
= 5;
71 _count_asmspecialops
= 25;
72 _count_asmoverrides
= 3;
74 token2str
: array[tasmtoken
] of tasmkeyword
=(
75 '','Label','LLabel','string','integer',
77 ')',':','.','+','-','*',
78 ';','identifier','register','opcode','/','$',
79 '.byte','.word','.long','.quad','.globl',
80 '.align','.balign','.p2align','.ascii',
81 '.asciz','.lcomm','.comm','.single','.double','.tfloat',
82 '.data','.text','END',
83 'TYPE','%','<<','>>','!','&','|','^','~');
87 firsttoken
: boolean = TRUE;
90 curlist
: paasmoutput
;
92 actasmtoken
: tasmtoken
;
93 prevasmtoken
: tasmtoken
;
94 actasmpattern
: string;
96 actasmregister
: tregister
;
98 actcondition
: tasmcond
;
99 iasmops
: Pdictionary
;
100 iasmregs
: ^reg2strtable
;
103 Procedure SetupTables
;
104 { creates uppercased symbol tables for speed access }
108 str2opentry
: pstr2opentry
;
112 for i
:=firstop
to lastop
do
114 new(str2opentry
,initname(upper(att_op2str
[i
])));
116 iasmops
^.insert(str2opentry
);
120 for j
:=firstreg
to lastreg
do
121 iasmregs
^[j
] := upper(att_reg2str
[j
]);
125 {---------------------------------------------------------------------}
126 { Routines for the tokenizing }
127 {---------------------------------------------------------------------}
129 function is_asmopcode(const s
: string):boolean;
131 { We need first to check the long prefixes, else we get probs
132 with things like movsbl }
133 att_sizesuffixstr
: array[0..9] of string[2] = (
134 '','BW','BL','WL','B','W','L','S','Q','T'
136 att_sizesuffix
: array[0..9] of topsize
= (
137 S_NO
,S_BW
,S_BL
,S_WL
,S_B
,S_W
,S_L
,S_FS
,S_IQ
,S_FX
139 att_sizefpusuffix
: array[0..9] of topsize
= (
140 S_NO
,S_NO
,S_NO
,S_NO
,S_NO
,S_NO
,S_FL
,S_FS
,S_IQ
,S_FX
142 att_sizefpuintsuffix
: array[0..9] of topsize
= (
143 S_NO
,S_NO
,S_NO
,S_NO
,S_NO
,S_NO
,S_IL
,S_IS
,S_IQ
,S_NO
146 str2opentry
: pstr2opentry
;
156 actcondition
:=C_None
;
159 { search for all possible suffixes }
160 for sufidx
:=low(att_sizesuffixstr
) to high(att_sizesuffixstr
) do
162 len
:=length(s
)-length(att_sizesuffixstr
[sufidx
]);
163 if copy(s
,len
+1,length(att_sizesuffixstr
[sufidx
]))=att_sizesuffixstr
[sufidx
] then
165 { here we search the entire table... }
167 if {(length(s)>0) and} (len
>0) then
168 str2opentry
:=pstr2opentry(iasmops
^.search(copy(s
,1,len
)));
169 if assigned(str2opentry
) then
171 actopcode
:=str2opentry
^.op
;
172 if att_needsuffix
[actopcode
]=attsufFPU
then
173 actopsize
:=att_sizefpusuffix
[sufidx
]
174 else if att_needsuffix
[actopcode
]=attsufFPUint
then
175 actopsize
:=att_sizefpuintsuffix
[sufidx
]
177 actopsize
:=att_sizesuffix
[sufidx
];
178 actasmtoken
:=AS_OPCODE
;
182 { not found, check condition opcodes }
184 while (j
<CondAsmOps
) do
186 if Copy(s
,1,Length(CondAsmOpStr
[j
]))=CondAsmOpStr
[j
] then
188 cond
:=Copy(s
,Length(CondAsmOpStr
[j
])+1,len
-Length(CondAsmOpStr
[j
]));
191 for cnd
:=low(TasmCond
) to high(TasmCond
) do
192 if Cond
=Upper(cond2str
[cnd
]) then
194 actopcode
:=CondASmOp
[j
];
195 if att_needsuffix
[actopcode
]=attsufFPU
then
196 actopsize
:=att_sizefpusuffix
[sufidx
]
197 else if att_needsuffix
[actopcode
]=attsufFPUint
then
198 actopsize
:=att_sizefpuintsuffix
[sufidx
]
200 actopsize
:=att_sizesuffix
[sufidx
];
202 actasmtoken
:=AS_OPCODE
;
215 Function is_asmdirective(const s
: string):boolean;
220 { GNU as is also not casesensitive with this }
222 for i
:=firstdirective
to lastdirective
do
223 if hs
=token2str
[i
] then
226 is_asmdirective
:=true;
229 is_asmdirective
:=false;
233 Function is_register(const s
: string):boolean;
237 actasmregister
:=R_NO
;
238 for i
:=firstreg
to lastreg
do
239 if s
=iasmregs
^[i
] then
241 actasmtoken
:=AS_REGISTER
;
250 Function is_locallabel(const s
: string):boolean;
252 is_locallabel
:=(length(s
)>=2) and (s
[1]='.') and (s
[2]='L');
260 { save old token and reset new token }
261 prevasmtoken
:=actasmtoken
;
262 actasmtoken
:=AS_NONE
;
265 { while space and tab , continue scan... }
266 while c
in [' ',#9] do
267 c
:=current_scanner
^.asmgetchar
;
269 if
not (c
in [newline
,#
13,'{',';']) then
270 current_scanner^.gettokenpos
;
271 { Local Label, Label, Directive, Prefix or Opcode }
272 if firsttoken
and not(c
in [newline
,#
13,'{',';']) then
276 { directive or local label }
280 actasmpattern
[len
]:=c
;
281 { Let us point to the next character }
282 c:=current_scanner^.asmgetchar
;
283 while c
in ['A'..
'Z','a'..
'z','0'..
'9','_','$'] do
286 actasmpattern
[len
]:=c
;
287 c:=current_scanner^.asmgetchar
;
289 actasmpattern
[0]:=chr(len
);
290 { this is a local label... }
291 if (c
=':') and is_locallabel(actasmpattern
) then
293 { local variables are case sensitive }
294 actasmtoken
:=AS_LLABEL
;
295 c
:=current_scanner
^.asmgetchar
;
299 { must be a directive }
302 { directives are case sensitive!! }
303 if is_asmdirective
(actasmpattern
) then
305 Message1
(asmr_e_not_directive_or_local_symbol
,actasmpattern
);
308 { only opcodes and global labels are allowed now. }
309 while c
in ['A'..'Z','a'..'z','0'..'9','_'] do
312 actasmpattern
[len
]:=c
;
313 c
:=current_scanner
^.asmgetchar
;
315 actasmpattern
[0]:=chr(len
);
319 actasmtoken
:=AS_LABEL
;
320 { let us point to the next character }
321 c
:=current_scanner
^.asmgetchar
;
326 If is_asmopcode(upper(actasmpattern
)) then
328 uppervar(actasmpattern
);
331 { End of assemblerblock ? }
332 if upper(actasmpattern
) = 'END' then
337 message1(asmr_e_unknown_opcode
,actasmpattern
);
338 actasmtoken:=AS_NONE
;
340 else
{ else firsttoken }
341 { Here we must handle all possible cases }
344 '.' : { possiblities : - local label reference , such as in jmp @local1 }
345 { - field of object/record }
348 if
(prevasmtoken
in [AS_ID
,AS_RPAREN
]) then
350 c:=current_scanner^.asmgetchar
;
355 c
:=current_scanner
^.asmgetchar
;
356 while c
in ['A'..
'Z','a'..
'z','0'..
'9','_','$'] do
358 actasmpattern:=actasmpattern
+ c
;
359 c:=current_scanner^.asmgetchar
;
361 if is_asmdirective(actasmpattern
) then
363 { local label references and directives }
364 { are case sensitive }
369 { identifier, register, prefix or directive }
370 '_','A'..'Z','a'..'z':
373 while c
in ['A'..'Z','a'..'z','0'..'9','_','$'] do
376 actasmpattern
[len
]:=c
;
377 c
:=current_scanner
^.asmgetchar
;
379 actasmpattern
[0]:=chr(len
);
380 uppervar(actasmpattern
);
381 { Opcode, can only be when the previous was a prefix }
382 If is_prefix(actopcode
) and is_asmopcode(upper(actasmpattern
)) then
384 uppervar(actasmpattern
);
387 { check for end which is a reserved word unlike the opcodes }
388 if actasmpattern
= 'END' then
393 if actasmpattern
= 'TYPE' then
395 actasmtoken
:=AS_TYPE
;
402 '%' : { register or modulo }
405 actasmpattern
[len
]:='%';
406 c
:=current_scanner
^.asmgetchar
;
407 { to be a register there must be a letter and not a number }
408 if c
in ['0'..
'9'] then
411 {Message(asmr_w_modulo_not_supported);}
415 while c
in ['a'..
'z','A'..
'Z','0'..
'9'] do
418 actasmpattern
[len
]:=c
;
419 c:=current_scanner^.asmgetchar
;
421 actasmpattern
[0]:=chr(len
);
422 uppervar(actasmpattern
);
423 if (actasmpattern
= '%ST') and (c
='(') then
425 actasmpattern
:=actasmpattern
+c
;
426 c
:=current_scanner
^.asmgetchar
;
427 if c
in ['0'..
'9'] then
428 actasmpattern:=actasmpattern
+ c
430 Message
(asmr_e_invalid_fpu_register
);
431 c:=current_scanner^.asmgetchar
;
433 Message
(asmr_e_invalid_fpu_register
)
436 actasmpattern:=actasmpattern
+ c
;
437 c:=current_scanner^.asmgetchar
; { let us point to next character. }
440 if is_register(actasmpattern
) then
442 Message(asmr_e_invalid_register
);
443 actasmtoken:=AS_NONE
;
447 '1'..'9': { integer number }
450 while c
in ['0'..'9'] do
453 actasmpattern
[len
]:=c
;
454 c
:=current_scanner
^.asmgetchar
;
456 actasmpattern
[0]:=chr(len
);
457 actasmpattern
:=tostr(ValDecimal(actasmpattern
));
458 actasmtoken
:=AS_INTNUM
;
461 '0' : { octal,hexa,real or binary number. }
464 c
:=current_scanner
^.asmgetchar
;
468 c:=current_scanner^.asmgetchar
;
469 while c
in ['0','1'] do
471 actasmpattern:=actasmpattern
+ c
;
472 c:=current_scanner^.asmgetchar
;
474 actasmpattern
:=tostr(ValBinary(actasmpattern
));
475 actasmtoken
:=AS_INTNUM
;
480 c
:=current_scanner
^.asmgetchar
;
481 { get ridd of the 0d }
482 if
(c
in ['+','-']) then
485 c:=current_scanner^.asmgetchar
;
489 while c
in ['0'..
'9'] do
491 actasmpattern:=actasmpattern
+ c
;
492 c:=current_scanner^.asmgetchar
;
496 actasmpattern
:=actasmpattern
+ c
;
497 c
:=current_scanner
^.asmgetchar
;
498 while c
in ['0'..
'9'] do
500 actasmpattern:=actasmpattern
+ c
;
501 c:=current_scanner^.asmgetchar
;
503 if upcase(c
) = 'E' then
505 actasmpattern
:=actasmpattern
+ c
;
506 c
:=current_scanner
^.asmgetchar
;
507 if
(c
in ['+','-']) then
509 actasmpattern:=actasmpattern
+ c
;
510 c:=current_scanner^.asmgetchar
;
512 while c
in ['0'..'9'] do
514 actasmpattern
:=actasmpattern
+ c
;
515 c
:=current_scanner
^.asmgetchar
;
518 actasmtoken
:=AS_REALNUM
;
523 Message1(asmr_e_invalid_float_const
,actasmpattern
+c
);
524 actasmtoken:=AS_NONE
;
529 c
:=current_scanner
^.asmgetchar
;
530 while c
in ['0'..
'9','a'..
'f','A'..
'F'] do
532 actasmpattern:=actasmpattern
+ c
;
533 c:=current_scanner^.asmgetchar
;
535 actasmpattern
:=tostr(ValHexaDecimal(actasmpattern
));
536 actasmtoken
:=AS_INTNUM
;
541 actasmpattern
:=actasmpattern
+ c
;
542 while c
in ['0'..'7'] do
544 actasmpattern
:=actasmpattern
+ c
;
545 c
:=current_scanner
^.asmgetchar
;
547 actasmpattern
:=tostr(ValOctal(actasmpattern
));
548 actasmtoken
:=AS_INTNUM
;
551 else { octal number zero value...}
553 actasmpattern
:=tostr(ValOctal(actasmpattern
));
554 actasmtoken
:=AS_INTNUM
;
562 c
:=current_scanner
^.asmgetchar
;
568 current_scanner
^.in_asm_string
:=true;
571 c
:=current_scanner
^.asmgetchar
;
575 { copy also the next char so \" is parsed correctly }
576 actasmpattern:=actasmpattern+c;
577 c:=current_scanner^.asmgetchar;
578 actasmpattern:=actasmpattern+c;
582 c:=current_scanner^.asmgetchar;
586 Message(scan_f_string_exceeds_line);
588 actasmpattern:=actasmpattern+c;
591 actasmpattern:=EscapeToPascal(actasmpattern);
592 actasmtoken:=AS_STRING;
593 current_scanner^.in_asm_string:=false;
599 current_scanner^.in_asm_string:=true;
602 c:=current_scanner^.asmgetchar;
606 { copy also the next char so \" is parsed correctly }
607 actasmpattern:=actasmpattern+c;
608 c:=current_scanner^.asmgetchar;
609 actasmpattern:=actasmpattern+c;
613 c:=current_scanner^.asmgetchar;
617 Message(scan_f_string_exceeds_line);
619 actasmpattern:=actasmpattern+c;
622 actasmpattern:=EscapeToPascal(actasmpattern);
623 actasmtoken:=AS_STRING;
624 current_scanner^.in_asm_string:=false;
630 actasmtoken:=AS_DOLLAR;
631 c:=current_scanner^.asmgetchar;
637 actasmtoken:=AS_COMMA;
638 c:=current_scanner^.asmgetchar;
645 c:=current_scanner^.asmgetchar;
647 c:=current_scanner^.asmgetchar;
654 c:=current_scanner^.asmgetchar;
656 c:=current_scanner^.asmgetchar;
663 c:=current_scanner^.asmgetchar;
670 c:=current_scanner^.asmgetchar;
676 Message(asmr_e_nor_not_supported);
677 c:=current_scanner^.asmgetchar;
678 actasmtoken:=AS_NONE;
684 actasmtoken:=AS_LPAREN;
685 c:=current_scanner^.asmgetchar;
691 actasmtoken:=AS_RPAREN;
692 c:=current_scanner^.asmgetchar;
698 actasmtoken:=AS_COLON;
699 c:=current_scanner^.asmgetchar;
705 actasmtoken:=AS_PLUS;
706 c:=current_scanner^.asmgetchar;
712 actasmtoken:=AS_MINUS;
713 c:=current_scanner^.asmgetchar;
719 actasmtoken:=AS_STAR;
720 c:=current_scanner^.asmgetchar;
726 c:=current_scanner^.asmgetchar;
727 actasmtoken:=AS_SLASH;
731 '{',#13,newline,';' :
733 { the comment is read by asmgetchar }
734 c:=current_scanner^.asmgetchar
;
736 actasmtoken:=AS_SEPARATOR
;
741 current_scanner
^.illegal_char(c
);
747 function consume(t
: tasmtoken
):boolean;
750 if t
<>actasmtoken
then
752 Message2(scan_f_syn_expected
,token2str
[t
],token2str
[actasmtoken
]);
757 until actasmtoken
<>AS_NONE
;
761 procedure RecoverConsume(allowcomma
:boolean);
763 While not (actasmtoken
in [AS_SEPARATOR
,AS_END
]) do
765 if allowcomma
and (actasmtoken
=AS_COMMA
) then
767 Consume(actasmtoken
);
772 {*****************************************************************************
774 *****************************************************************************}
776 Procedure BuildRecordOffsetSize(const expr
: string;var offset
:longint;var size
:longint);
777 { Description: This routine builds up a record offset after a AS_DOT }
778 { token is encountered. }
779 { On entry actasmtoken should be equal to AS_DOT }
786 while (actasmtoken
=AS_DOT
) do
789 if actasmtoken
=AS_ID
then
790 s
:=s
+'.'+actasmpattern
;
791 if not Consume(AS_ID
) then
793 RecoverConsume(true);
797 if not GetRecordOffsetSize(s
,offset
,size
) then
798 Message(asmr_e_building_record_offset
);
802 Procedure BuildConstSymbolExpression(allowref
,betweenbracket
,needofs
:boolean;var value
:longint;var asmsym
:string
);
804 hs
,tempstr
,expr
: string
;
805 parenlevel
,l
,k
: longint
;
822 if allowref
and (prevasmtoken
in [AS_INTNUM
,AS_ID
]) then
831 if (parenlevel
=0) and betweenbracket
then
894 expr
:=expr
+ actasmpattern
;
900 if actasmtoken
<>AS_ID
then
901 Message(asmr_e_dollar_without_identifier
);
906 case Length(actasmpattern
) of
908 l
:=ord(actasmpattern
[1]);
910 l
:=ord(actasmpattern
[2]) + ord(actasmpattern
[1]) shl 8;
912 l
:=ord(actasmpattern
[3]) +
913 Ord(actasmpattern
[2]) shl 8 + ord(actasmpattern
[1]) shl 16;
915 l
:=ord(actasmpattern
[4]) + ord(actasmpattern
[3]) shl 8 +
916 Ord(actasmpattern
[2]) shl 16 + ord(actasmpattern
[1]) shl 24;
918 Message1(asmr_e_invalid_string_as_opcode_operand
,actasmpattern
);
921 expr
:=expr
+ tempstr
;
928 if actasmtoken
<>AS_ID
then
929 Message(asmr_e_type_without_identifier
)
932 tempstr:=actasmpattern
;
934 if actasmtoken
=AS_DOT then
935 BuildRecordOffsetSize
(tempstr
,k
,l
)
938 getsym
(tempstr
,false
);
939 if assigned
(srsym
) then
943 l:=pvarsym
(srsym
)^.getsize
;
945 l:=ptypedconstsym
(srsym
)^.getsize
;
947 l:=ptypesym
(srsym
)^.restype.def^.
size;
949 Message
(asmr_e_wrong_sym_type
);
953 Message1(sym_e_unknown_id
,tempstr
);
957 expr
:=expr
+ tempstr
;
962 tempstr
:=actasmpattern
;
963 prevtok
:=prevasmtoken
;
965 if SearchIConstant(tempstr
,l
) then
968 expr
:=expr
+ tempstr
;
972 if is_locallabel(tempstr
) then
974 CreateLocalLabel(tempstr
,hl
,false);
978 if SearchLabel(tempstr
,hl
,false) then
982 getsym(tempstr
,false);
984 if assigned(sym
) then
989 if sym
^.owner
^.symtabletype
in [localsymtable
,parasymtable
] then
990 Message(asmr_e_no_local_or_para_allowed
);
991 hs:=pvarsym
(srsym
)^.mangledname
;
994 hs
:=ptypedconstsym(srsym
)^.mangledname
;
996 hs
:=pprocsym(srsym
)^.mangledname
;
999 if not(ptypesym(srsym
)^.restype
.def
^.deftype
in [recorddef
,objectdef
]) then
1000 Message(asmr_e_wrong_sym_type
);
1003 Message(asmr_e_wrong_sym_type
);
1007 Message1(sym_e_unknown_id
,tempstr
);
1012 if needofs
and (prevtok
<>AS_DOLLAR
) then
1013 Message(asmr_e_need_dollar
);
1017 Message
(asmr_e_cant_have_multiple_relocatable_symbols
);
1018 if
(expr
='') or (expr
[length(expr
)]='+') then
1020 { don't remove the + if there could be a record field }
1021 if actasmtoken
<>AS_DOT then
1022 delete
(expr
,length(expr
),1);
1025 Message
(asmr_e_only_add_relocatable_symbol
);
1027 if actasmtoken
=AS_DOT
then
1029 BuildRecordOffsetSize(tempstr
,l
,k
);
1031 expr
:=expr
+ tempstr
;
1035 if (expr
='') or (expr
[length(expr
)] in ['+','-','/','*']) then
1036 delete(expr
,length(expr
),1);
1039 { check if there are wrong operator used like / or mod etc. }
1040 if (hs
<>'') and not(actasmtoken
in [AS_MINUS
,AS_PLUS
,AS_COMMA
,AS_SEPARATOR
,AS_LPAREN
,AS_END
]) then
1041 Message(asmr_e_only_add_relocatable_symbol
);
1051 { write error only once. }
1052 if not errorflag
then
1053 Message(asmr_e_invalid_constant_expression
);
1054 { consume tokens until we find COMMA or SEPARATOR }
1055 Consume
(actasmtoken
);
1060 { calculate expression }
1061 if not ErrorFlag
then
1062 value
:=CalculateExpression(expr
)
1068 Function BuildConstExpression(allowref
,betweenbracket
:boolean): longint;
1073 BuildConstSymbolExpression(allowref
,betweenbracket
,false,l
,hs
);
1075 Message(asmr_e_relocatable_symbol_not_allowed
);
1076 BuildConstExpression:=l
;
1080 {****************************************************************************
1082 ****************************************************************************}
1085 P386ATTOperand
=^T386ATTOperand
;
1086 T386ATTOperand
=object(T386Operand
)
1087 Procedure BuildOperand
;virtual;
1089 Procedure BuildReference
;
1090 Procedure BuildConstant
;
1094 Procedure T386ATTOperand
.BuildReference
;
1096 procedure Consume_RParen
;
1098 if actasmtoken
<> AS_RPAREN
then
1100 Message(asmr_e_invalid_reference_syntax
);
1101 RecoverConsume
(true
);
1106 if
not (actasmtoken
in [AS_COMMA
,AS_SEPARATOR
,AS_END
]) then
1108 Message
(asmr_e_invalid_reference_syntax
);
1109 RecoverConsume
(true
);
1114 procedure Consume_Scale
;
1118 { we have to process the scaling }
1119 l
:=BuildConstExpression(false,true);
1120 if ((l
= 2) or (l
= 4) or (l
= 8) or (l
= 1)) then
1121 opr
.ref
.scalefactor
:=l
1124 Message(asmr_e_wrong_scale_factor
);
1125 opr.ref.
scalefactor:=0;
1134 AS_PLUS
: { absolute offset, such as fs:(0x046c) }
1136 { offset(offset) is invalid }
1137 If opr
.Ref
.Offset
<> 0 Then
1139 Message(asmr_e_invalid_reference_syntax
);
1140 RecoverConsume
(true
);
1144 opr.Ref.
Offset:=BuildConstExpression
(false
,true
);
1149 AS_REGISTER
: { (reg ... }
1151 { Check if there is already a base (mostly ebp,esp) than this is
1152 not allowed,becuase it will give crashing code }
1153 if opr
.ref
.base
<>R_NO
then
1154 Message(asmr_e_cannot_index_relative_var
);
1155 opr.ref.
base:=actasmregister
;
1156 Consume
(AS_REGISTER
);
1157 { can either be a register or a right parenthesis }
1159 if actasmtoken
=AS_RPAREN then
1166 if actasmtoken
=AS_REGISTER
then
1168 opr
.ref
.index
:=actasmregister
;
1169 Consume(AS_REGISTER
);
1170 { check for scaling ... }
1185 Message(asmr_e_invalid_reference_syntax
);
1186 RecoverConsume
(false
);
1192 Message(asmr_e_invalid_reference_syntax
);
1193 RecoverConsume
(false
);
1196 AS_COMMA
: { (, ... can either be scaling, or index }
1200 if (actasmtoken
=AS_REGISTER
) then
1202 opr
.ref
.index
:=actasmregister
;
1203 Consume(AS_REGISTER
);
1204 { check for scaling ... }
1219 Message(asmr_e_invalid_reference_syntax
);
1220 RecoverConsume
(false
);
1235 Message(asmr_e_invalid_reference_syntax
);
1236 RecoverConsume
(false
);
1242 Procedure T386ATTOperand
.BuildConstant
;
1247 BuildConstSymbolExpression(false,false,true,l
,tempstr
);
1250 opr
.typ
:=OPR_SYMBOL
;
1252 opr
.symbol
:=newasmsymbol(tempstr
);
1256 opr
.typ
:=OPR_CONSTANT
;
1262 Procedure T386ATTOperand
.BuildOperand
;
1268 procedure AddLabelOperand(hl
:pasmlabel
);
1270 if not(actasmtoken
in [AS_PLUS
,AS_MINUS
,AS_LPAREN
]) and
1271 is_calljmp(actopcode
) then
1273 opr
.typ
:=OPR_SYMBOL
;
1283 procedure MaybeRecordOffset
;
1290 if not(actasmtoken
in [AS_DOT
,AS_PLUS
,AS_MINUS
]) then
1293 hasdot
:=(actasmtoken
=AS_DOT
);
1298 BuildRecordOffsetSize(expr
,toffset
,tsize
);
1300 SetSize(tsize
,true);
1303 if actasmtoken
in [AS_PLUS
,AS_MINUS
] then
1304 inc(l
,BuildConstExpression(true,false));
1305 if opr
.typ
=OPR_REFERENCE
then
1307 if hasdot
and (not hastype
) and (opr
.ref
.options
=ref_parafixup
) then
1308 Message(asmr_e_cannot_access_field_directly_for_parameters
);
1309 inc(opr.ref.
offset,l
)
1315 function MaybeBuildReference
:boolean;
1316 { Try to create a reference, if not a reference is found then false
1319 MaybeBuildReference
:=true;
1325 opr
.ref
.offset
:=BuildConstExpression(True,False);
1326 if actasmtoken
<>AS_LPAREN
then
1327 Message(asmr_e_invalid_reference_syntax
)
1333 AS_ID
: { only a variable is allowed ... }
1335 tempstr
:=actasmpattern
;
1338 if (actasmtoken
=AS_LPAREN
) and
1339 SearchType(tempstr
) then
1343 tempstr2
:=actasmpattern
;
1346 if not SetupVar(tempstr2
,false) then
1347 Message1(sym_e_unknown_id
,tempstr2
);
1350 if not SetupVar(tempstr
,false) then
1351 Message1(sym_e_unknown_id
,tempstr
);
1353 if actasmtoken
=AS_DOT
then
1355 BuildRecordOffsetSize(tempstr
,l
,k
);
1356 inc(opr
.ref
.offset
,l
);
1362 AS_LPAREN
: BuildReference
;
1365 Message(asmr_e_invalid_reference_syntax
);
1366 Consume
(actasmtoken
);
1371 MaybeBuildReference
:=false;
1376 tempreg
: tregister
;
1381 AS_LPAREN
: { Memory reference or constant expression }
1387 AS_DOLLAR
: { Constant expression }
1397 { Constant memory offset }
1398 { This must absolutely be followed by ( }
1400 opr
.ref
.offset
:=BuildConstExpression(True,False);
1401 if actasmtoken
<>AS_LPAREN
then
1402 Message(asmr_e_invalid_reference_syntax
)
1407 AS_STAR
: { Call from memory address }
1410 if actasmtoken
=AS_REGISTER
then
1412 opr
.typ
:=OPR_REGISTER
;
1413 opr
.reg
:=actasmregister
;
1414 size
:=reg_2_opsize
[actasmregister
];
1415 Consume(AS_REGISTER
);
1420 if not MaybeBuildReference
then
1421 Message(asmr_e_syn_operand
);
1423 { this is only allowed for call's and jmp's }
1424 if not is_calljmp(actopcode
) then
1425 Message(asmr_e_syn_operand
);
1428 AS_ID
: { A constant expression, or a Variable ref. }
1431 if is_locallabel(actasmpattern
) then
1433 CreateLocalLabel(actasmpattern
,hl
,false);
1435 AddLabelOperand(hl
);
1439 if SearchLabel(actasmpattern
,hl
,false) then
1442 AddLabelOperand(hl
);
1445 { probably a variable or normal expression }
1446 { or a procedure (such as in CALL ID) }
1448 { is it a constant ? }
1449 if SearchIConstant(actasmpattern
,l
) then
1451 if not (opr
.typ
in [OPR_NONE
,OPR_CONSTANT
]) then
1452 Message(asmr_e_invalid_operand_type
);
1458 expr:=actasmpattern
;
1461 if
(actasmtoken
=AS_LPAREN
) and
1462 SearchType
(expr
) then
1466 tempstr:=actasmpattern
;
1469 if SetupVar
(tempstr
,false
) then
1472 { add a constant expression? }
1473 if
(actasmtoken
=AS_PLUS
) then
1475 l:=BuildConstExpression
(true
,false
);
1476 if opr.typ
=OPR_CONSTANT then
1479 inc(opr.ref.
offset,l
);
1483 Message1
(sym_e_unknown_id
,tempstr
);
1487 if SetupVar
(expr
,false
) then
1490 { add a constant expression? }
1491 if
(actasmtoken
=AS_PLUS
) then
1493 l:=BuildConstExpression
(true
,false
);
1494 if opr.typ
=OPR_CONSTANT then
1497 inc(opr.ref.
offset,l
);
1502 { look for special symbols ... }
1503 if expr
= '__RESULT' then
1506 if expr
= '__SELF' then
1509 if expr
= '__OLDEBP' then
1512 { check for direct symbolic names }
1513 { only if compiling the system unit }
1514 if
(cs_compilesystem
in aktmoduleswitches
) then
1516 if
not SetupDirectVar
(expr
) then
1518 { not found, finally ... add it anyways ... }
1519 Message1
(asmr_w_id_supposed_external
,expr
);
1520 opr.ref.
symbol:=newasmsymbol
(expr
);
1524 Message1(sym_e_unknown_id
,expr
);
1529 { Do we have a indexing reference, then parse it also }
1530 if actasmtoken
=AS_LPAREN
then
1532 if (opr
.typ
=OPR_CONSTANT
) then
1535 opr
.typ
:=OPR_REFERENCE
;
1536 reset_reference(opr
.Ref
);
1543 AS_REGISTER
: { Register, a variable reference or a constant reference }
1545 { save the type of register used. }
1546 tempreg
:=actasmregister
;
1547 Consume(AS_REGISTER
);
1548 if actasmtoken
= AS_COLON
then
1552 opr
.ref
.segment
:=tempreg
;
1553 { This must absolutely be followed by a reference }
1554 if not MaybeBuildReference
then
1556 Message(asmr_e_invalid_seg_override
);
1557 Consume
(actasmtoken
);
1561 else if (actasmtoken
in [AS_END
,AS_SEPARATOR
,AS_COMMA
]) then
1563 if not (opr
.typ
in [OPR_NONE
,OPR_REGISTER
]) then
1564 Message(asmr_e_invalid_operand_type
);
1565 opr.
typ:=OPR_REGISTER
;
1567 size:=reg_2_opsize
[tempreg
];
1570 Message
(asmr_e_syn_operand
);
1577 Message(asmr_e_syn_operand
);
1578 Consume
(actasmtoken
);
1583 {*****************************************************************************
1585 *****************************************************************************}
1588 P386AttInstruction
=^T386AttInstruction
;
1589 T386AttInstruction
=object(T386Instruction
)
1590 procedure InitOperands
;virtual;
1591 procedure BuildOpcode
;virtual;
1594 procedure T386AttInstruction
.InitOperands
;
1599 Operands
[i
]:=new(P386AttOperand
,Init
);
1603 Procedure T386AttInstruction
.BuildOpCode
;
1605 operandnum
: longint;
1606 PrefixOp
,OverrideOp
: tasmop
;
1610 { prefix seg opcode / prefix opcode }
1612 if is_prefix(actopcode
) then
1614 PrefixOp
:=ActOpcode
;
1616 condition
:=ActCondition
;
1618 ConcatInstruction(curlist
);
1622 if is_override(actopcode
) then
1624 OverrideOp
:=ActOpcode
;
1626 condition
:=ActCondition
;
1628 ConcatInstruction(curlist
);
1633 { allow for newline as in gas styled syntax }
1634 while actasmtoken
=AS_SEPARATOR
do
1635 Consume(AS_SEPARATOR
);
1636 until (actasmtoken
<>AS_OPCODE
);
1638 if (actasmtoken
<> AS_OPCODE
) then
1640 Message(asmr_e_invalid_or_missing_opcode
);
1641 RecoverConsume
(true
);
1644 { Fill the instr object with the current state }
1646 condition
:=ActCondition
;
1648 { Valid combination of prefix/override and instruction ? }
1649 if (prefixop
<>A_NONE
) and (NOT CheckPrefix(PrefixOp
,actopcode
)) then
1650 Message1(asmr_e_invalid_prefix_and_opcode
,actasmpattern
);
1651 if
(overrideop
<>A_NONE
) and (NOT CheckOverride
(OverrideOp
,ActOpcode
)) then
1652 Message1
(asmr_e_invalid_override_and_opcode
,actasmpattern
);
1653 { We are reading operands, so opcode will be an AS_ID }
1656 { Zero operand opcode ? }
1657 if actasmtoken
in [AS_SEPARATOR
,AS_END
] then
1662 { Read the operands }
1665 AS_COMMA
: { Operand delimiter }
1667 if operandnum
> MaxOperands
then
1668 Message(asmr_e_too_many_operands
)
1674 AS_END
: { End of asm operands for this opcode }
1679 Operands[operandnum]^.BuildOperand;
1687 Procedure BuildConstant(maxvalue: longint);
1697 expr:=actasmpattern;
1698 if length(expr) > 1 then
1699 Message(asmr_e_string_not_allowed_as_const);
1702 AS_COMMA: Consume(AS_COMMA);
1706 Message(asmr_e_invalid_string_expression);
1708 ConcatString(curlist,expr);
1717 BuildConstSymbolExpression(false,false,false,value,asmsym);
1720 if maxvalue<>longint($ffffffff) then
1721 Message(asmr_w_32bit_const_for_address);
1722 ConcatConstSymbol(curlist,asmsym,value)
1725 ConcatConstant(curlist,value,maxvalue);
1734 Message(asmr_e_syn_constant);
1735 RecoverConsume(false);
1742 Procedure BuildRealConstant(typ : tfloattype);
1754 if actasmtoken=AS_PLUS then
1757 if actasmtoken=AS_MINUS then
1765 expr:=actasmpattern;
1773 Message(asmr_e_invalid_float_expr);
1775 ConcatRealConstant(curlist,r,typ);
1779 expr:=actasmpattern;
1780 Consume(AS_REALNUM);
1781 { in ATT syntax you have 0d in front of the real }
1782 { should this be forced ? yes i think so, as to }
1783 { conform to gas as much as possible. }
1784 if (expr[1]='0') and (upper(expr[2])='D') then
1792 Message(asmr_e_invalid_float_expr);
1794 ConcatRealConstant(curlist,r,typ);
1807 Consume(actasmtoken);
1808 if not errorflag then
1809 Message(asmr_e_invalid_float_expr);
1817 Procedure BuildStringConstant(asciiz: boolean);
1820 errorflag : boolean;
1827 expr:=actasmpattern;
1830 ConcatPasString(curlist,expr);
1844 Consume(actasmtoken);
1845 if not errorflag then
1846 Message(asmr_e_invalid_string_expression);
1854 Function Assemble: Ptree;
1860 instr : T386ATTInstruction;
1862 Message1(asmr_d_start_reading,'AT&T');
1864 if assigned(procinfo^.returntype.def) and
1865 (is_fpu(procinfo^.returntype.def) or
1866 ret_in_acc(procinfo^.returntype.def)) then
1867 procinfo^.funcret_state:=vs_assigned;
1868 { sets up all opcode and register tables in uppercase }
1869 if not _asmsorted then
1874 curlist:=new(paasmoutput,init);
1876 { setup label linked list }
1877 new(LocalLabelList,Init);
1879 c:=current_scanner^.asmgetchar;
1886 if CreateLocalLabel(actasmpattern,hl,true) then
1887 ConcatLabel(curlist,hl);
1893 if SearchLabel(upper(actasmpattern),hl,true) then
1894 ConcatLabel(curlist,hl)
1896 Message1(asmr_e_unknown_label_identifier,actasmpattern);
1903 BuildConstant($ffff);
1908 curlist^.Concat(new(pai_section,init(sec_data)));
1915 curlist^.Concat(new(pai_section,init(sec_code)));
1929 BuildConstant($ffffffff);
1935 BuildRealConstant(s64comp);
1941 BuildRealConstant(s32real);
1947 BuildRealConstant(s64real);
1952 Consume(AS_EXTENDED);
1953 BuildRealConstant(s80real);
1959 if actasmtoken=AS_ID then
1960 ConcatPublic(curlist,actasmpattern);
1962 if actasmtoken<>AS_SEPARATOR then
1963 Consume(AS_SEPARATOR);
1969 l1:=BuildConstExpression(false,false);
1970 if (target_info.target in [target_i386_GO32V1,target_i386_GO32V2]) then
1973 if (l1>=0) and (l1<=16) then
1981 ConcatAlign(curlist,l1);
1982 Message(asmr_n_align_is_target_specific);
1983 if actasmtoken<>AS_SEPARATOR then
1984 Consume(AS_SEPARATOR);
1990 ConcatAlign(curlist,BuildConstExpression(false,false));
1991 if actasmtoken<>AS_SEPARATOR then
1992 Consume(AS_SEPARATOR);
1997 Consume(AS_P2ALIGN);
1998 l1:=BuildConstExpression(false,false);
2000 if (l1>=0) and (l1<=16) then
2007 ConcatAlign(curlist,l1);
2008 if actasmtoken<>AS_SEPARATOR then
2009 Consume(AS_SEPARATOR);
2015 BuildStringConstant(TRUE);
2021 BuildStringConstant(FALSE);
2027 commname:=actasmpattern;
2030 ConcatLocalBss(commname,BuildConstExpression(false,false));
2031 if actasmtoken<>AS_SEPARATOR then
2032 Consume(AS_SEPARATOR);
2038 commname:=actasmpattern;
2041 ConcatGlobalBss(commname,BuildConstExpression(false,false));
2042 if actasmtoken<>AS_SEPARATOR then
2043 Consume(AS_SEPARATOR);
2049 instr.AddReferenceSizes;
2050 instr.SetInstructionOpsize;
2051 instr.CheckOperandSizes;
2052 instr.ConcatInstruction(curlist);
2058 Consume(AS_SEPARATOR);
2063 break; { end assembly block }
2068 Message(asmr_e_syntax_error);
2069 RecoverConsume(false);
2073 { Check LocalLabelList }
2074 LocalLabelList^.CheckEmitted;
2075 dispose(LocalLabelList,Done);
2076 { are we back in the code section? }
2077 if lastsec<>sec_code then
2079 Message(asmr_w_assembler_code_not_returned_to_text);
2080 curlist^.Concat(new(pai_section,init(sec_code)));
2082 { Return the list in an asmnode }
2083 assemble:=genasmnode(curlist);
2084 Message1(asmr_d_finish_reading,'AT&T');
2088 {*****************************************************************************
2090 *****************************************************************************}
2095 procedure ra386att_exit;{$ifndef FPC}far;{$endif}
2097 if assigned(iasmops) then
2098 dispose(iasmops,done);
2099 if assigned(iasmregs) then
2107 exitproc:=@ra386att_exit;
2111 Revision 1.1 2002/02/19 08:23:40 sasu
2114 Revision 1.1.2.1 2000/11/30 00:33:34 pierre
2115 * fix for web bug 1229
2117 Revision 1.1 2000/07/13 06:29:55 michael
2120 Revision 1.85 2000/06/18 19:09:31 peter
2121 * fixed + record.field expressions
2123 Revision 1.84 2000/06/18 18:07:06 peter
2124 * use new illegal_char method
2126 Revision 1.83 2000/06/15 18:07:07 peter
2127 * fix constant parsing which gave an error when constants were used
2129 Revision 1.82 2000/06/14 19:02:41 peter
2130 * fixed TYPE with records and fields
2131 * added TYPE support for ATT reader else it wouldn't be possible to
2132 get the size of a type/variable
2134 Revision 1.81 2000/05/26 18:23:11 peter
2135 * fixed % parsing and added modulo support
2136 * changed some evaulator errors to more generic illegal expresion
2138 Revision 1.80 2000/05/23 20:36:28 peter
2139 + typecasting support for variables, but be carefull as word,byte can't
2140 be used because they are reserved assembler keywords
2142 Revision 1.79 2000/05/18 17:05:16 peter
2143 * fixed size of const parameters in asm readers
2145 Revision 1.78 2000/05/12 21:57:02 pierre
2146 + use of a dictionary object
2147 for faster opcode searching in assembler readers
2148 implemented by Kovacs Attila Zoltan
2150 Revision 1.77 2000/05/11 09:56:21 pierre
2151 * fixed several compare problems between longints and
2152 const > $80000000 that are treated as int64 constanst
2153 by Delphi reported by Kovacs Attila Zoltan
2155 Revision 1.76 2000/05/09 11:56:25 pierre
2156 * Issue an error if opcode is not found
2158 Revision 1.75 2000/05/08 13:23:03 peter
2159 * fixed reference parsing
2161 Revision 1.74 2000/04/29 12:51:33 peter
2162 * fixed offset support intel reader, the gotoffset variable was not
2164 * moved check for local/para to be only used for varsym
2166 Revision 1.73 2000/04/04 13:48:44 pierre
2167 + TOperand.SetCorrectSize virtual method added
2168 to be able to change the suffix according to the instruction
2169 (FIADD word ptr w need a s as ATT suffix
2170 wheras FILD word ptr w need a w suffix :( )
2172 Revision 1.72 2000/03/15 23:10:01 pierre
2173 * fix for bug 848 (that still genrated wrong code)
2174 + better testing for variables used in assembler
2175 (gives an error if variable is not directly reachable !)
2177 Revision 1.71 2000/02/09 13:23:01 peter
2180 Revision 1.70 2000/01/28 09:41:39 peter
2181 * fixed fpu suffix parsing for att reader
2183 Revision 1.69 2000/01/21 10:10:25 daniel
2184 * should work on linux also
2186 Revision 1.68 2000/01/21 00:46:47 peter
2187 * ifdef'd my previous fix as it broken a make cycle sometimes
2189 Revision 1.67 2000/01/20 23:35:01 peter
2190 * fixed fldl where suffix would get S_L instead of S_FL
2192 Revision 1.66 2000/01/07 01:14:34 peter
2193 * updated copyright to 2000
2195 Revision 1.65 1999/12/12 12:57:59 peter
2198 Revision 1.64 1999/11/30 10:40:52 peter
2201 Revision 1.63 1999/11/17 17:05:03 pierre
2202 * Notes/hints changes
2204 Revision 1.62 1999/11/09 23:06:46 peter
2205 * esi_offset -> selfpointer_offset to be newcg compatible
2206 * hcogegen -> cgbase fixes for newcg
2208 Revision 1.61 1999/11/06 14:34:23 peter
2209 * truncated log to 20 revs
2211 Revision 1.60 1999/10/01 07:59:20 peter
2212 * fixed object field parsing
2214 Revision 1.59 1999/09/27 23:44:57 peter
2215 * procinfo is now a pointer
2216 * support for result setting in sub procedure
2218 Revision 1.58 1999/09/08 16:04:01 peter
2219 * better support for object fields and more error checks for
2220 field accesses which create buggy code
2222 Revision 1.57 1999/08/05 16:53:08 peter
2223 * V_Fatal=1, all other V_ are also increased
2224 * Check for local procedure when assigning procvar
2225 * fixed comment parsing because directives
2226 * oldtp mode directives better supported
2227 * added some messages to errore.msg
2229 Revision 1.56 1999/08/04 00:23:25 florian
2230 * renamed i386asm and i386base to cpuasm and cpubase
2232 Revision 1.55 1999/08/03 22:03:09 peter
2233 * moved bitmask constants to sets
2234 * some other type/const renamings
2236 Revision 1.54 1999/07/24 11:17:12 peter
2237 * suffix parsing for at&t fixed for things like movsbl
2238 * string constants are now handle correctly and also allowed in
2239 constant expressions