1 { 2 Copyright (c) 1998-2002 by Florian Klaempfl 3 4 Generate code for i8086 assembler for type converting nodes 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 unit n8086cnv; 23 24 {$i fpcdefs.inc} 25 26 interface 27 28 uses 29 node,ncgcnv,nx86cnv,defutil,defcmp; 30 31 type 32 33 { t8086typeconvnode } 34 35 t8086typeconvnode = class(tx86typeconvnode) 36 protected typecheck_int_to_intnull37 function typecheck_int_to_int: tnode;override; typecheck_proc_to_procvarnull38 function typecheck_proc_to_procvar: tnode;override; 39 procedure second_proc_to_procvar;override; 40 end; 41 42 43 implementation 44 45 uses 46 verbose,systems,globals,globtype, 47 aasmbase,aasmtai,aasmdata,aasmcpu, 48 symconst,symdef,symcpu, 49 cgbase,cga,procinfo,pass_1,pass_2, 50 ncon,ncal,ncnv,nmem,n8086mem, 51 cpubase,cpuinfo, 52 cgutils,cgobj,hlcgobj,cgx86,ncgutil, 53 tgobj; 54 t8086typeconvnode.typecheck_int_to_intnull55 function t8086typeconvnode.typecheck_int_to_int: tnode; 56 begin 57 Result:=inherited typecheck_int_to_int; 58 if (is_16bitint(totypedef) or is_8bitint(totypedef)) and (left.nodetype=addrn) then 59 begin 60 if left.nodetype=addrn then 61 ti8086addrnode(left).get_offset_only:=true; 62 end; 63 end; 64 65 t8086typeconvnode.typecheck_proc_to_procvarnull66 function t8086typeconvnode.typecheck_proc_to_procvar: tnode; 67 begin 68 Result:=inherited typecheck_proc_to_procvar; 69 if tcnf_proc_2_procvar_get_offset_only in convnodeflags then 70 begin 71 if resultdef.typ<>procvardef then 72 internalerror(2018040401); 73 exclude(tprocvardef(resultdef).procoptions,po_far); 74 end 75 else if (tcnf_proc_2_procvar_2_voidpointer in convnodeflags) and 76 (current_settings.x86memorymodel in x86_far_code_models) then 77 begin 78 if resultdef.typ<>procvardef then 79 internalerror(2018040402); 80 include(tprocvardef(resultdef).procoptions,po_far); 81 end; 82 end; 83 84 85 procedure t8086typeconvnode.second_proc_to_procvar; 86 begin 87 if (tcnf_proc_2_procvar_get_offset_only in convnodeflags) and 88 is_proc_far(tabstractprocdef(resultdef)) then 89 internalerror(2018040403); 90 inherited; 91 end; 92 93 94 begin 95 ctypeconvnode:=t8086typeconvnode 96 end. 97