radi386.pas 12 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251
  1. {
  2. $Id$
  3. Copyright (c) 1998 by Florian Klaempfl
  4. Reads inline assembler and writes the lines direct to the output
  5. This program is free software; you can redistribute it and/or modify
  6. it under the terms of the GNU General Public License as published by
  7. the Free Software Foundation; either version 2 of the License, or
  8. (at your option) any later version.
  9. This program is distributed in the hope that it will be useful,
  10. but WITHOUT ANY WARRANTY; without even the implied warranty of
  11. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  12. GNU General Public License for more details.
  13. You should have received a copy of the GNU General Public License
  14. along with this program; if not, write to the Free Software
  15. Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  16. ****************************************************************************
  17. }
  18. unit radi386;
  19. interface
  20. uses
  21. tree;
  22. function assemble : ptree;
  23. implementation
  24. uses
  25. files,i386,hcodegen,globals,scanner,aasm,
  26. cobjects,symtable,types,verbose,asmutils;
  27. function assemble : ptree;
  28. var
  29. retstr,s,hs : string;
  30. c : char;
  31. ende : boolean;
  32. sym : psym;
  33. code : paasmoutput;
  34. l : longint;
  35. procedure writeasmline;
  36. var
  37. i : longint;
  38. begin
  39. i:=length(s);
  40. while (i>0) and (s[i] in [' ',#9]) do
  41. dec(i);
  42. s[0]:=chr(i);
  43. if s<>'' then
  44. code^.concat(new(pai_direct,init(strpnew(s))));
  45. { consider it set function set if the offset was loaded }
  46. if assigned(procinfo.retdef) and
  47. (pos(retstr,upper(s))>0) then
  48. procinfo.funcret_is_valid:=true;
  49. s:='';
  50. end;
  51. begin
  52. ende:=false;
  53. s:='';
  54. if assigned(procinfo.retdef) and
  55. is_fpu(procinfo.retdef) then
  56. procinfo.funcret_is_valid:=true;
  57. if assigned(procinfo.retdef) and
  58. (procinfo.retdef<>pdef(voiddef)) then
  59. retstr:=upper(tostr(procinfo.retoffset)+'('+att_reg2str[procinfo.framepointer]+')')
  60. else
  61. retstr:='';
  62. c:=asmgetchar;
  63. code:=new(paasmoutput,init);
  64. while not(ende) do
  65. begin
  66. tokenpos.line:=current_module^.current_inputfile^.line_no;
  67. tokenpos.column:=get_file_col;
  68. tokenpos.fileindex:=current_module^.current_index;
  69. case c of
  70. 'A'..'Z','a'..'z','_' : begin
  71. hs:='';
  72. while ((ord(c)>=ord('A')) and (ord(c)<=ord('Z')))
  73. or ((ord(c)>=ord('a')) and (ord(c)<=ord('z')))
  74. or ((ord(c)>=ord('0')) and (ord(c)<=ord('9')))
  75. or (c='_') do
  76. begin
  77. inc(byte(hs[0]));
  78. hs[length(hs)]:=c;
  79. c:=asmgetchar;
  80. end;
  81. if upper(hs)='END' then
  82. ende:=true
  83. else
  84. begin
  85. if c=':' then
  86. begin
  87. getsym(upper(hs),false);
  88. if srsym<>nil then
  89. Message(assem_w_using_defined_as_local);
  90. end;
  91. if upper(hs)='FWAIT' then
  92. FwaitWarning
  93. else
  94. { access to local variables }
  95. if assigned(aktprocsym) then
  96. begin
  97. { is the last written character an special }
  98. { char ? }
  99. if (s[length(s)]='%') and
  100. ret_in_acc(procinfo.retdef) and
  101. ((pos('AX',upper(hs))>0) or
  102. (pos('AL',upper(hs))>0)) then
  103. procinfo.funcret_is_valid:=true;
  104. if (s[length(s)]<>'%') and
  105. (s[length(s)]<>'$') and
  106. ((s[length(s)]<>'0') or (hs[1]<>'x')) then
  107. begin
  108. if assigned(aktprocsym^.definition^.localst) then
  109. sym:=aktprocsym^.definition^.localst^.search(upper(hs))
  110. else
  111. sym:=nil;
  112. if assigned(sym) then
  113. begin
  114. if sym^.typ=varsym then
  115. begin
  116. {variables set are after a comma }
  117. {like in movl %eax,I }
  118. if pos(',',s) > 0 then
  119. pvarsym(sym)^.is_valid:=1
  120. else
  121. if (pos('MOV',upper(s)) > 0) and (pvarsym(sym)^.is_valid=0) then
  122. Message1(sym_n_local_var_not_init_yet,hs);
  123. hs:='-'+tostr(pvarsym(sym)^.address)+'('+att_reg2str[procinfo.framepointer]+')';
  124. end
  125. else
  126. { call to local function }
  127. if (sym^.typ=procsym) and (pos('CALL',upper(s))>0) then
  128. begin
  129. hs:=pprocsym(sym)^.definition^.mangledname;
  130. end;
  131. end
  132. else
  133. begin
  134. if assigned(aktprocsym^.definition^.parast) then
  135. sym:=aktprocsym^.definition^.parast^.search(upper(hs))
  136. else
  137. sym:=nil;
  138. if assigned(sym) then
  139. begin
  140. if sym^.typ=varsym then
  141. begin
  142. l:=pvarsym(sym)^.address;
  143. { set offset }
  144. inc(l,aktprocsym^.definition^.parast^.call_offset);
  145. hs:=tostr(l)+'('+att_reg2str[procinfo.framepointer]+')';
  146. if pos(',',s) > 0 then
  147. pvarsym(sym)^.is_valid:=1;
  148. end;
  149. end
  150. { I added that but it creates a problem in line.ppi
  151. because there is a local label wbuffer and
  152. a static variable WBUFFER ...
  153. what would you decide, florian ?
  154. else
  155. begin
  156. getsym(upper(hs),false);
  157. sym:=srsym;
  158. if assigned(sym) and (sym^.typ = varsym)
  159. or (sym^.typ = typedconstsym) then
  160. hs:=sym^.mangledname;
  161. if (sym^.typ=procsym) and (pos('CALL',upper(s))>0) then
  162. begin
  163. if assigned(pprocsym(sym)^.definition^.nextoverloaded) then
  164. begin
  165. exterror:=strpnew(' calling an overloaded procedure in asm');
  166. warning(user_defined);
  167. end;
  168. hs:=pprocsym(sym)^.definition^.mangledname;
  169. end;
  170. end }
  171. else if upper(hs)='__SELF' then
  172. begin
  173. if assigned(procinfo._class) then
  174. hs:=tostr(procinfo.ESI_offset)+'('+att_reg2str[procinfo.framepointer]+')'
  175. else
  176. Message(assem_e_cannot_use_SELF_outside_a_method);
  177. end
  178. else if upper(hs)='__RESULT' then
  179. begin
  180. if assigned(procinfo.retdef) and
  181. (procinfo.retdef<>pdef(voiddef)) then
  182. begin
  183. hs:=retstr;
  184. end
  185. else
  186. Message(assem_w_void_function);
  187. end
  188. else if upper(hs)='__OLDEBP' then
  189. begin
  190. { complicate to check there }
  191. { we do it: }
  192. if lexlevel>2 then
  193. hs:=tostr(procinfo.framepointer_offset)
  194. +'('+att_reg2str[procinfo.framepointer]+')'
  195. else
  196. Message(assem_e_cannot_use___OLDEBP_outside_nested_procedure);
  197. end;
  198. end;
  199. { end;}
  200. end;
  201. end;
  202. s:=s+hs;
  203. end;
  204. end;
  205. '{',';',#10,#13 : begin
  206. if pos(retstr,s) > 0 then
  207. procinfo.funcret_is_valid:=true;
  208. writeasmline;
  209. c:=asmgetchar;
  210. end;
  211. #26 : Message(scan_f_end_of_file);
  212. else
  213. begin
  214. inc(byte(s[0]));
  215. s[length(s)]:=c;
  216. c:=asmgetchar;
  217. end;
  218. end;
  219. end;
  220. writeasmline;
  221. assemble:=genasmnode(code);
  222. end;
  223. end.
  224. {
  225. $Log$
  226. Revision 1.5 1998-06-12 10:32:32 pierre
  227. * column problem hopefully solved
  228. + C vars declaration changed
  229. Revision 1.4 1998/06/04 23:51:58 peter
  230. * m68k compiles
  231. + .def file creation moved to gendef.pas so it could also be used
  232. for win32
  233. }