From c68b2dfbee0c1b4dca798d0ffcc60a6b8b525d19 Mon Sep 17 00:00:00 2001 From: carl Date: Tue, 13 Aug 2002 18:01:50 +0000 Subject: [PATCH] * rename swatoperands to swapoperands + m68k first compilable version (still needs a lot of testing): assembler generator, system information , inline assembler reader. --- compiler/Makefile | 188 +---- compiler/Makefile.fpc | 2 +- compiler/i386/aasmcpu.pas | 14 +- compiler/i386/ra386att.pas | 10 +- compiler/i386/ra386int.pas | 10 +- compiler/i_amiga.pas | 10 +- compiler/i_atari.pas | 10 +- compiler/i_fbsd.pas | 10 +- compiler/i_linux.pas | 14 +- compiler/i_palmos.pas | 10 +- compiler/m68k/aasmcpu.pas | 44 +- compiler/m68k/agcpugas.pas | 426 +++++++++++ compiler/m68k/aoptcpu.pas | 47 ++ compiler/m68k/aoptcpub.pas | 126 ++++ compiler/m68k/cpubase.pas | 25 +- compiler/m68k/cpunode.pas | 62 ++ compiler/m68k/cpuswtch.pas | 117 ++- compiler/m68k/cputarg.pas | 59 ++ compiler/m68k/radirect.pas | 62 ++ compiler/m68k/rasm.pas | 1353 ++++++++++++++++++----------------- compiler/ncgcal.pas | 10 +- compiler/ncgcnv.pas | 48 +- compiler/ncgflw.pas | 9 +- compiler/ncginl.pas | 47 +- compiler/ncgset.pas | 10 +- compiler/psystem.pas | 12 +- compiler/rautils.pas | 14 +- compiler/scandir.pas | 20 +- compiler/x86_64/aasmcpu.pas | 14 +- 29 files changed, 1844 insertions(+), 939 deletions(-) create mode 100644 compiler/m68k/agcpugas.pas create mode 100644 compiler/m68k/aoptcpu.pas create mode 100644 compiler/m68k/aoptcpub.pas create mode 100644 compiler/m68k/cpunode.pas create mode 100644 compiler/m68k/cputarg.pas create mode 100644 compiler/m68k/radirect.pas diff --git a/compiler/Makefile b/compiler/Makefile index 1ffda08478..525ba5474b 100644 --- a/compiler/Makefile +++ b/compiler/Makefile @@ -1,8 +1,8 @@ # -# Don't edit, this file is generated by FPCMake Version 1.1 [2002/08/11] +# Don't edit, this file is generated by FPCMake Version 1.1 [2002/02/27] # default: all -MAKEFILETARGETS=linux go32v2 win32 os2 freebsd beos netbsd amiga atari sunos qnx netware openbsd wdosx +MAKEFILETARGETS=linux go32v2 win32 os2 freebsd beos netbsd amiga atari sunos qnx override PATH:=$(subst \,/,$(PATH)) ifeq ($(findstring ;,$(PATH)),) inUnix=1 @@ -42,9 +42,6 @@ endif ifeq ($(OS_TARGET),netbsd) BSDhier=1 endif -ifeq ($(OS_TARGET),openbsd) -BSDhier=1 -endif ifdef inUnix BATCHEXT=.sh else @@ -111,7 +108,7 @@ ifndef FPC_VERSION FPC_VERSION:=$(shell $(FPC) -iV) endif export FPC FPC_VERSION -unexport CHECKDEPEND ALLDEPENDENCIES +unexport CHECKDEPEND ALL_DEPENDENCIES ifeq ($(findstring 1.0.,$(FPC_VERSION)),) COMPILERINFO:=$(shell $(FPC) -iSP -iTP -iSO -iTO) ifndef CPU_SOURCE @@ -202,7 +199,7 @@ PACKAGESDIR:=$(wildcard $(FPCDIR) $(FPCDIR)/packages/base $(FPCDIR)/packages/ext override PACKAGE_NAME=compiler override PACKAGE_VERSION=1.1 unexport FPC_VERSION -CYCLETARGETS=i386 powerpc +CYCLETARGETS=i386 powerpc m68k ifdef ALPHA PPC_TARGET=alpha endif @@ -311,15 +308,9 @@ endif ifeq ($(OS_TARGET),netbsd) UNIXINSTALLDIR=1 endif -ifeq ($(OS_TARGET),openbsd) -UNIXINSTALLDIR=1 -endif ifeq ($(OS_TARGET),sunos) UNIXINSTALLDIR=1 endif -ifeq ($(OS_TARGET),qnx) -UNIXINSTALLDIR=1 -endif else ifeq ($(OS_SOURCE),linux) UNIXINSTALLDIR=1 @@ -330,15 +321,9 @@ endif ifeq ($(OS_SOURCE),netbsd) UNIXINSTALLDIR=1 endif -ifeq ($(OS_SOURCE),openbsd) -UNIXINSTALLDIR=1 -endif ifeq ($(OS_TARGET),sunos) UNIXINSTALLDIR=1 endif -ifeq ($(OS_TARGET),qnx) -UNIXINSTALLDIR=1 -endif endif ifndef INSTALL_PREFIX ifdef PREFIX @@ -357,9 +342,6 @@ endif endif endif export INSTALL_PREFIX -ifdef INSTALL_FPCSUBDIR -export INSTALL_FPCSUBDIR -endif ifndef DIST_DESTDIR DIST_DESTDIR:=$(BASEDIR) endif @@ -406,27 +388,22 @@ endif endif ifndef INSTALL_SOURCEDIR ifdef UNIXINSTALLDIR +ifdef INSTALL_FPCPACKAGE ifdef BSDhier -SRCPREFIXDIR=share/src +INSTALL_SOURCEDIR:=$(INSTALL_PREFIX)/share/src/fpc-$(FPC_VERSION)/$(PACKAGE_NAME) else -SRCPREFIXDIR=src -endif -ifdef INSTALL_FPCPACKAGE -ifdef INSTALL_FPCSUBDIR -INSTALL_SOURCEDIR:=$(INSTALL_PREFIX)/$(SRCPREFIXDIR)/fpc-$(FPC_VERSION)/$(INSTALL_FPCSUBDIR)/$(PACKAGE_NAME) -else -INSTALL_SOURCEDIR:=$(INSTALL_PREFIX)/$(SRCPREFIXDIR)/fpc-$(FPC_VERSION)/$(PACKAGE_NAME) +INSTALL_SOURCEDIR:=$(INSTALL_PREFIX)/src/fpc-$(FPC_VERSION)/$(PACKAGE_NAME) endif else -INSTALL_SOURCEDIR:=$(INSTALL_PREFIX)/$(SRCPREFIXDIR)/$(PACKAGE_NAME)-$(PACKAGE_VERSION) +ifdef BSDhier +INSTALL_SOURCEDIR:=$(INSTALL_PREFIX)/share/src/$(PACKAGE_NAME)-$(PACKAGE_VERSION) +else +INSTALL_SOURCEDIR:=$(INSTALL_PREFIX)/src/$(PACKAGE_NAME)-$(PACKAGE_VERSION) +endif endif else ifdef INSTALL_FPCPACKAGE -ifdef INSTALL_FPCSUBDIR -INSTALL_SOURCEDIR:=$(INSTALL_BASEDIR)/source/$(INSTALL_FPCSUBDIR)/$(PACKAGE_NAME) -else INSTALL_SOURCEDIR:=$(INSTALL_BASEDIR)/source/$(PACKAGE_NAME) -endif else INSTALL_SOURCEDIR:=$(INSTALL_BASEDIR)/source endif @@ -434,15 +411,18 @@ endif endif ifndef INSTALL_DOCDIR ifdef UNIXINSTALLDIR -ifdef BSDhier -DOCPREFIXDIR=share/doc -else -DOCPREFIXDIR=doc -endif ifdef INSTALL_FPCPACKAGE -INSTALL_DOCDIR:=$(INSTALL_PREFIX)/$(DOCPREFIXDIR)/fpc-$(FPC_VERSION)/$(PACKAGE_NAME) +ifdef BSDhier +INSTALL_DOCDIR:=$(INSTALL_PREFIX)/share/doc/fpc-$(FPC_VERSION)/$(PACKAGE_NAME) else -INSTALL_DOCDIR:=$(INSTALL_PREFIX)/$(DOCPREFIXDIR)/$(PACKAGE_NAME)-$(PACKAGE_VERSION) +INSTALL_DOCDIR:=$(INSTALL_PREFIX)/doc/fpc-$(FPC_VERSION)/$(PACKAGE_NAME) +endif +else +ifdef BSDhier +INSTALL_DOCDIR:=$(INSTALL_PREFIX)/share/doc/$(PACKAGE_NAME)-$(PACKAGE_VERSION) +else +INSTALL_DOCDIR:=$(INSTALL_PREFIX)/doc/$(PACKAGE_NAME)-$(PACKAGE_VERSION) +endif endif else ifdef INSTALL_FPCPACKAGE @@ -534,12 +514,6 @@ HASSHAREDLIB=1 FPCMADE=fpcmade.netbsd ZIPSUFFIX=netbsd endif -ifeq ($(OS_TARGET),openbsd) -EXEEXT= -HASSHAREDLIB=1 -FPCMADE=fpcmade.openbsd -ZIPSUFFIX=openbsd -endif ifeq ($(OS_TARGET),win32) PPUEXT=.ppw OEXT=.ow @@ -565,7 +539,7 @@ ECHO=echo endif ifeq ($(OS_TARGET),amiga) EXEEXT= -PPUEXT=.ppu +PPUEXT=.ppa ASMEXT=.asm OEXT=.o SMARTEXT=.sl @@ -574,7 +548,7 @@ SHAREDLIBEXT=.library FPCMADE=fpcmade.amg endif ifeq ($(OS_TARGET),atari) -PPUEXT=.ppu +PPUEXT=.ppt ASMEXT=.s OEXT=.o SMARTEXT=.sl @@ -612,18 +586,6 @@ EXEEXT= FPCMADE=fpcmade.qnx ZIPSUFFIX=qnx endif -ifeq ($(OS_TARGET),netware) -STATICLIBPREFIX= -PPUEXT=.ppn -OEXT=.on -ASMEXT=.s -SMARTEXT=.sl -STATICLIBEXT=.a -SHAREDLIBEXT=.nlm -FPCMADE=fpcmade.nw -ZIPSUFFIX=nw -EXEEXT=.nlm -endif ifndef ECHO ECHO:=$(strip $(wildcard $(addsuffix /gecho$(SRCEXEEXT),$(SEARCHPATH)))) ifeq ($(ECHO),) @@ -879,15 +841,6 @@ endif ifeq ($(OS_TARGET),qnx) REQUIRE_PACKAGES_RTL=1 endif -ifeq ($(OS_TARGET),netware) -REQUIRE_PACKAGES_RTL=1 -endif -ifeq ($(OS_TARGET),openbsd) -REQUIRE_PACKAGES_RTL=1 -endif -ifeq ($(OS_TARGET),wdosx) -REQUIRE_PACKAGES_RTL=1 -endif ifdef REQUIRE_PACKAGES_RTL PACKAGEDIR_RTL:=$(firstword $(subst /Makefile.fpc,,$(strip $(wildcard $(addsuffix /rtl/$(OS_TARGET)/Makefile.fpc,$(PACKAGESDIR)))))) ifneq ($(PACKAGEDIR_RTL),) @@ -899,7 +852,7 @@ endif ifdef CHECKDEPEND $(PACKAGEDIR_RTL)/$(FPCMADE): $(MAKE) -C $(PACKAGEDIR_RTL) $(FPCMADE) -override ALLDEPENDENCIES+=$(PACKAGEDIR_RTL)/$(FPCMADE) +override ALL_DEPENDENCIES+=$(PACKAGEDIR_RTL)/$(FPCMADE) endif else PACKAGEDIR_RTL= @@ -920,9 +873,6 @@ endif ifneq ($(OS_TARGET),$(OS_SOURCE)) override FPCOPT+=-T$(OS_TARGET) endif -ifeq ($(OS_SOURCE),openbsd) -override FPCOPT+=-FD$(NEW_BINUTILS_PATH) -endif ifdef UNITDIR override FPCOPT+=$(addprefix -Fu,$(UNITDIR)) endif @@ -1030,78 +980,12 @@ ifdef TARGET_RSTS override RSTFILES=$(addsuffix $(RSTEXT),$(TARGET_RSTS)) override CLEANRSTFILES+=$(RSTFILES) endif -.PHONY: fpc_install fpc_sourceinstall fpc_exampleinstall -ifdef INSTALL_UNITS -override INSTALLPPUFILES+=$(addsuffix $(PPUEXT),$(INSTALL_UNITS)) -endif -ifdef INSTALL_BUILDUNIT -override INSTALLPPUFILES:=$(filter-out $(INSTALL_BUILDUNIT)$(PPUEXT),$(INSTALLPPUFILES)) -endif -ifdef INSTALLPPUFILES -override INSTALLPPULINKFILES:=$(subst $(PPUEXT),$(OEXT),$(INSTALLPPUFILES)) $(addprefix $(STATICLIBPREFIX),$(subst $(PPUEXT),$(STATICLIBEXT),$(INSTALLPPUFILES))) -override INSTALLPPUFILES:=$(addprefix $(UNITTARGETDIRPREFIX),$(INSTALLPPUFILES)) -override INSTALLPPULINKFILES:=$(wildcard $(addprefix $(UNITTARGETDIRPREFIX),$(INSTALLPPULINKFILES))) -override INSTALL_CREATEPACKAGEFPC=1 -endif -ifdef INSTALLEXEFILES -override INSTALLEXEFILES:=$(addprefix $(TARGETDIRPREFIX),$(INSTALLEXEFILES)) -endif -fpc_install: all $(INSTALLTARGET) -ifdef INSTALLEXEFILES - $(MKDIR) $(INSTALL_BINDIR) -ifdef UPXPROG - -$(UPXPROG) $(INSTALLEXEFILES) -endif - $(INSTALLEXE) $(INSTALLEXEFILES) $(INSTALL_BINDIR) -endif -ifdef INSTALL_CREATEPACKAGEFPC -ifdef FPCMAKE -ifdef PACKAGE_VERSION -ifneq ($(wildcard Makefile.fpc),) - $(FPCMAKE) -p -T$(OS_TARGET) Makefile.fpc - $(MKDIR) $(INSTALL_UNITDIR) - $(INSTALL) Package.fpc $(INSTALL_UNITDIR) -endif -endif -endif -endif -ifdef INSTALLPPUFILES - $(MKDIR) $(INSTALL_UNITDIR) - $(INSTALL) $(INSTALLPPUFILES) $(INSTALL_UNITDIR) -ifneq ($(INSTALLPPULINKFILES),) - $(INSTALL) $(INSTALLPPULINKFILES) $(INSTALL_UNITDIR) -endif -ifneq ($(wildcard $(LIB_FULLNAME)),) - $(MKDIR) $(INSTALL_LIBDIR) - $(INSTALL) $(LIB_FULLNAME) $(INSTALL_LIBDIR) -ifdef inUnix - ln -sf $(LIB_FULLNAME) $(INSTALL_LIBDIR)/$(LIB_NAME) -endif -endif -endif -ifdef INSTALL_FILES - $(MKDIR) $(INSTALL_DATADIR) - $(INSTALL) $(INSTALL_FILES) $(INSTALL_DATADIR) -endif -fpc_sourceinstall: distclean - $(MKDIR) $(INSTALL_SOURCEDIR) - $(COPYTREE) $(BASEDIR)/* $(INSTALL_SOURCEDIR) -fpc_exampleinstall: $(addsuffix _distclean,$(TARGET_EXAMPLEDIRS)) -ifdef HASEXAMPLES - $(MKDIR) $(INSTALL_EXAMPLEDIR) -endif -ifdef EXAMPLESOURCEFILES - $(COPY) $(EXAMPLESOURCEFILES) $(INSTALL_EXAMPLEDIR) -endif -ifdef TARGET_EXAMPLEDIRS - $(COPYTREE) $(addsuffix /*,$(TARGET_EXAMPLEDIRS)) $(INSTALL_EXAMPLEDIR) -endif .PHONY: fpc_distinstall fpc_distinstall: install exampleinstall .PHONY: fpc_zipinstall fpc_zipsourceinstall fpc_zipexampleinstall ifndef PACKDIR ifndef inUnix -PACKDIR=$(BASEDIR)/../fpc-pack +PACKDIR=$(BASEDIR)/fpc-pack else PACKDIR=/tmp/fpc-pack endif @@ -1389,8 +1273,8 @@ smart: $(addsuffix _smart,$(TARGET_DIRS)) release: $(addsuffix _release,$(TARGET_DIRS)) examples: $(addsuffix _examples,$(TARGET_DIRS)) shared: $(addsuffix _shared,$(TARGET_DIRS)) -sourceinstall: fpc_sourceinstall -exampleinstall: fpc_exampleinstall $(addsuffix _exampleinstall,$(TARGET_DIRS)) +sourceinstall: +exampleinstall: $(addsuffix _exampleinstall,$(TARGET_DIRS)) distinstall: fpc_distinstall zipinstall: fpc_zipinstall zipsourceinstall: fpc_zipsourceinstall @@ -1431,13 +1315,13 @@ MAKEDEP=ppdep$(EXEEXT) MSG2INC=./msg2inc$(EXEEXT) .PHONY: alpha i386 m68k powerpc alpha: - $(MAKE) PPC_TARGET=alpha CPU_UNITDIR=alpha exeonly + $(MAKE) PPC_TARGET=alpha CPU_UNITDIR=alpha all i386: - $(MAKE) PPC_TARGET=i386 CPU_UNITDIR=i386 exeonly + $(MAKE) PPC_TARGET=i386 CPU_UNITDIR=i386 all m68k: - $(MAKE) PPC_TARGET=m68k CPU_UNITDIR=m68k exeonly + $(MAKE) PPC_TARGET=m68k CPU_UNITDIR=m68k all powerpc: - $(MAKE) PPC_TARGET=powerpc CPU_UNITDIR=powerpc exeonly + $(MAKE) PPC_TARGET=powerpc CPU_UNITDIR=powerpc all .PHONY: all compiler echotime ppuclean execlean clean distclean all: $(EXENAME) $(addsuffix _all,$(TARGET_DIRS)) compiler: $(EXENAME) @@ -1476,21 +1360,19 @@ dependencies : $(MAKEDEP) ifdef USEDEPEND include depend endif -.PHONY: exeonly msg $(MSG2INC): $(COMPILERUTILSDIR)/msg2inc.pp $(COMPILER) -FE. $(COMPILERUTILSDIR)/msg2inc.pp msgtxt.inc: $(MSGFILE) $(MAKE) $(MSG2INC) $(MSG2INC) $(MSGFILE) msg msg msg: msgtxt.inc -exeonly: $(EXENAME) ifndef COMPLETE $(EXENAME) : $(wildcard *.pas) $(wildcard *.inc) msg \ $(wildcard targets/*.pas) $(wilcard targets/*.inc) \ $(wildcard $(PPC_TARGET)/*.pas) $(wildcard $(PPC_TARGET)/*.inc) $(COMPILER) pp.pas $(EXECPPAS) - $(MOVE) $(COMPILER_TARGETDIR)/$(PPEXENAME) $(EXENAME) + $(MOVE) $(COMPILER_TARGETDIR)/$(PPEXENAME) $(COMPILER_TARGETDIR)/$(EXENAME) else $(EXENAME) : $(wildcard *.pas) $(wildcard *.inc) msg \ $(wildcard targets/*.pas) $(wilcard targets/*.inc) \ @@ -1501,7 +1383,7 @@ $(EXENAME) : $(wildcard *.pas) $(wildcard *.inc) msg \ $(EXECPPAS) $(COMPILER) pp.pas $(EXECPPAS) - $(MOVE) $(COMPILER_TARGETDIR)/$(PPEXENAME) $(EXENAME) + $(MOVE) $(PPEXENAME) $(EXENAME) endif tokens.dat : $(wildcard *.pas) $(wildcard *.inc) $(COMPILER) tokendat.pas @@ -1574,7 +1456,7 @@ full: fullcycle fullcycle: $(MAKE) cycle $(MAKE) ppuclean - $(MAKE) $(filter-out $(PPC_TARGET),$(CYCLETARGETS)) 'FPC=$(BASEDIR)/$(EXENAME)' + $(MAKE) $(CYCLETARGETS) 'FPC=$(BASEDIR)/$(EXENAME)' htmldocs: $(PASDOC) -p -h -o html$(PATHSEP)$(PPC_TARGET) -d fpc -d gdb -d $(PPC_TARGET) -u $(PPC_TARGET) $(PPC_TARGET)$(PATHSEP)*.pas targets$(PATHSEP)*.pas *.pas .PHONY: quickinstall install installsym diff --git a/compiler/Makefile.fpc b/compiler/Makefile.fpc index c6be8f0cd7..f804f34b64 100644 --- a/compiler/Makefile.fpc +++ b/compiler/Makefile.fpc @@ -30,7 +30,7 @@ fpcdir=.. unexport FPC_VERSION # Which platforms are ready for inclusion in the cycle -CYCLETARGETS=i386 powerpc +CYCLETARGETS=i386 powerpc m68k # Allow ALPHA, POWERPC, M68K, I386 defines for target cpu ifdef ALPHA diff --git a/compiler/i386/aasmcpu.pas b/compiler/i386/aasmcpu.pas index 20670cc978..1b5ad66c78 100644 --- a/compiler/i386/aasmcpu.pas +++ b/compiler/i386/aasmcpu.pas @@ -192,7 +192,7 @@ interface function calcsize(p:PInsEntry):longint; procedure gencode(sec:TAsmObjectData); function NeedAddrPrefix(opidx:byte):boolean; - procedure Swatoperands; + procedure Swapoperands; {$endif NOAG386BIN} end; @@ -649,7 +649,7 @@ implementation end; - procedure taicpu.Swatoperands; + procedure taicpu.Swapoperands; var p : TOper; begin @@ -675,7 +675,7 @@ implementation begin if FOperandOrder<>order then begin - Swatoperands; + Swapoperands; FOperandOrder:=order; end; end; @@ -1796,7 +1796,13 @@ implementation end. { $Log$ - Revision 1.2 2002-07-20 11:57:59 florian + Revision 1.3 2002-08-13 18:01:52 carl + * rename swatoperands to swapoperands + + m68k first compilable version (still needs a lot of testing): + assembler generator, system information , inline + assembler reader. + + Revision 1.2 2002/07/20 11:57:59 florian * types.pas renamed to defbase.pas because D6 contains a types unit so this would conflicts if D6 programms are compiled + Willamette/SSE2 instructions to assembler added diff --git a/compiler/i386/ra386att.pas b/compiler/i386/ra386att.pas index 8cc5c34d12..80f0db151e 100644 --- a/compiler/i386/ra386att.pas +++ b/compiler/i386/ra386att.pas @@ -1620,7 +1620,7 @@ procedure T386AttInstruction.InitOperands; var i : longint; begin - for i:=1to 3 do + for i:=1to max_operands do Operands[i]:=T386AttOperand.Create; end; @@ -2129,7 +2129,13 @@ finalization end. { $Log$ - Revision 1.29 2002-08-12 15:08:42 carl + Revision 1.30 2002-08-13 18:01:52 carl + * rename swatoperands to swapoperands + + m68k first compilable version (still needs a lot of testing): + assembler generator, system information , inline + assembler reader. + + Revision 1.29 2002/08/12 15:08:42 carl + stab register indexes for powerpc (moved from gdb to cpubase) + tprocessor enumeration moved to cpuinfo + linker in target_info is now a class diff --git a/compiler/i386/ra386int.pas b/compiler/i386/ra386int.pas index 6525353f40..178019f343 100644 --- a/compiler/i386/ra386int.pas +++ b/compiler/i386/ra386int.pas @@ -1902,7 +1902,7 @@ Begin instr:=T386IntelInstruction.Create; instr.BuildOpcode; { We need AT&T style operands } - instr.Swatoperands; + instr.Swapoperands; { Must be done with args in ATT order } instr.CheckNonCommutativeOpcodes; instr.AddReferenceSizes; @@ -1959,7 +1959,13 @@ finalization end. { $Log$ - Revision 1.31 2002-08-11 14:32:31 peter + Revision 1.32 2002-08-13 18:01:52 carl + * rename swatoperands to swapoperands + + m68k first compilable version (still needs a lot of testing): + assembler generator, system information , inline + assembler reader. + + Revision 1.31 2002/08/11 14:32:31 peter * renamed current_library to objectlibrary Revision 1.30 2002/08/11 13:24:17 peter diff --git a/compiler/i_amiga.pas b/compiler/i_amiga.pas index f1bb9562f2..2152a47865 100644 --- a/compiler/i_amiga.pas +++ b/compiler/i_amiga.pas @@ -58,7 +58,7 @@ unit i_amiga; newline : #10; dirsep : '/'; files_case_relevent : true; - assem : as_none; + assem : as_gas; assemextern : as_gas; link : nil; linkextern : nil; @@ -85,7 +85,13 @@ initialization end. { $Log$ - Revision 1.2 2002-08-12 15:08:39 carl + Revision 1.3 2002-08-13 18:01:51 carl + * rename swatoperands to swapoperands + + m68k first compilable version (still needs a lot of testing): + assembler generator, system information , inline + assembler reader. + + Revision 1.2 2002/08/12 15:08:39 carl + stab register indexes for powerpc (moved from gdb to cpubase) + tprocessor enumeration moved to cpuinfo + linker in target_info is now a class diff --git a/compiler/i_atari.pas b/compiler/i_atari.pas index c55d2f2474..1c8925cf2a 100644 --- a/compiler/i_atari.pas +++ b/compiler/i_atari.pas @@ -58,7 +58,7 @@ unit i_atari; newline : #10; dirsep : '/'; files_case_relevent : true; - assem : as_none; + assem : as_gas; assemextern : as_gas; link : ld_m68k_atari; linkextern : ld_m68k_atari; @@ -85,7 +85,13 @@ initialization end. { $Log$ - Revision 1.2 2002-08-12 15:08:39 carl + Revision 1.3 2002-08-13 18:01:51 carl + * rename swatoperands to swapoperands + + m68k first compilable version (still needs a lot of testing): + assembler generator, system information , inline + assembler reader. + + Revision 1.2 2002/08/12 15:08:39 carl + stab register indexes for powerpc (moved from gdb to cpubase) + tprocessor enumeration moved to cpuinfo + linker in target_info is now a class diff --git a/compiler/i_fbsd.pas b/compiler/i_fbsd.pas index 2e9e890f1d..786c4df7da 100644 --- a/compiler/i_fbsd.pas +++ b/compiler/i_fbsd.pas @@ -189,7 +189,7 @@ unit i_fbsd; newline : #10; dirsep : '/'; files_case_relevent : true; - assem : as_none; + assem : as_gas; assemextern : as_gas; link : nil; linkextern : nil; @@ -239,7 +239,13 @@ initialization end. { $Log$ - Revision 1.2 2002-08-12 15:08:39 carl + Revision 1.3 2002-08-13 18:01:51 carl + * rename swatoperands to swapoperands + + m68k first compilable version (still needs a lot of testing): + assembler generator, system information , inline + assembler reader. + + Revision 1.2 2002/08/12 15:08:39 carl + stab register indexes for powerpc (moved from gdb to cpubase) + tprocessor enumeration moved to cpuinfo + linker in target_info is now a class diff --git a/compiler/i_linux.pas b/compiler/i_linux.pas index dafa9da909..994fe096d5 100644 --- a/compiler/i_linux.pas +++ b/compiler/i_linux.pas @@ -125,7 +125,7 @@ unit i_linux; newline : #10; dirsep : '/'; files_case_relevent : true; - assem : as_none; + assem : as_gas; assemextern : as_gas; link : nil; linkextern : nil; @@ -253,7 +253,7 @@ unit i_linux; newline : #10; dirsep : '/'; files_case_relevent : true; - assem : as_none; + assem : as_gas; assemextern : as_gas; link : nil; linkextern : nil; @@ -381,7 +381,7 @@ unit i_linux; newline : #10; dirsep : '/'; files_case_relevent : true; - assem : as_none; + assem : as_gas; assemextern : as_gas; link : nil; linkextern : nil; @@ -446,7 +446,13 @@ initialization end. { $Log$ - Revision 1.2 2002-08-12 15:08:39 carl + Revision 1.3 2002-08-13 18:01:51 carl + * rename swatoperands to swapoperands + + m68k first compilable version (still needs a lot of testing): + assembler generator, system information , inline + assembler reader. + + Revision 1.2 2002/08/12 15:08:39 carl + stab register indexes for powerpc (moved from gdb to cpubase) + tprocessor enumeration moved to cpuinfo + linker in target_info is now a class diff --git a/compiler/i_palmos.pas b/compiler/i_palmos.pas index f95b43cc8d..d70f7b9125 100644 --- a/compiler/i_palmos.pas +++ b/compiler/i_palmos.pas @@ -58,7 +58,7 @@ unit i_palmos; newline : #10; dirsep : '/'; files_case_relevent : true; - assem : as_none; + assem : as_gas; assemextern : as_gas; link : ld_m68k_palmos; linkextern : ld_m68k_palmos; @@ -85,7 +85,13 @@ initialization end. { $Log$ - Revision 1.2 2002-08-12 15:08:39 carl + Revision 1.3 2002-08-13 18:01:51 carl + * rename swatoperands to swapoperands + + m68k first compilable version (still needs a lot of testing): + assembler generator, system information , inline + assembler reader. + + Revision 1.2 2002/08/12 15:08:39 carl + stab register indexes for powerpc (moved from gdb to cpubase) + tprocessor enumeration moved to cpuinfo + linker in target_info is now a class diff --git a/compiler/m68k/aasmcpu.pas b/compiler/m68k/aasmcpu.pas index 485d87e4fc..2990b165de 100644 --- a/compiler/m68k/aasmcpu.pas +++ b/compiler/m68k/aasmcpu.pas @@ -71,9 +71,11 @@ type constructor op_sym(op : tasmop;_size : topsize;_op1 : tasmsymbol); { for DBxx opcodes } - constructor op_sym_reg(op: tasmop; _size : topsize; _op1 :tasmsymbol; _op2: tregister); + constructor op_reg_sym(op: tasmop; _size : topsize; _op1: tregister; _op2 :tasmsymbol); constructor op_sym_ofs_reg(op : tasmop;_size : topsize;_op1 : tasmsymbol;_op1ofs:longint;_op2 : tregister); - + + constructor op_sym_ofs(op : tasmop;_size : topsize;_op1 : tasmsymbol;_op1ofs:longint); + constructor op_sym_ofs_ref(op : tasmop;_size : topsize;_op1 : tasmsymbol;_op1ofs:longint;const _op2 : treference); private procedure loadreglist(opidx:longint;r:tregisterlist); @@ -81,6 +83,12 @@ type end; + tai_align = class(tai_align_abstract) + { nothing to add } + end; + + procedure InitAsm; + procedure DoneAsm; implementation @@ -331,16 +339,34 @@ implementation end; - constructor taicpu.op_sym_reg(op: tasmop; _size : topsize; _op1 :tasmsymbol; _op2: tregister); + constructor taicpu.op_reg_sym(op: tasmop; _size : topsize; _op1: tregister; _op2 :tasmsymbol); begin inherited create(op); init(_size); ops:=2; - loadsymbol(0,_op1,0); - loadreg(1,_op2); + loadreg(0,_op1); + loadsymbol(1,_op2,0); end; + constructor taicpu.op_sym_ofs_ref(op : tasmop;_size : topsize;_op1 : tasmsymbol;_op1ofs:longint;const _op2 : treference); + begin + inherited create(op); + init(_size); + ops:=2; + loadsymbol(0,_op1,_op1ofs); + loadref(1,_op2); + end; + + + constructor taicpu.op_sym_ofs(op : tasmop;_size : topsize;_op1 : tasmsymbol;_op1ofs:longint); + begin + inherited create(op); + init(_size); + ops:=1; + loadsymbol(0,_op1,_op1ofs); + end; + constructor taicpu.op_sym_ofs_reg(op : tasmop;_size : topsize;_op1 : tasmsymbol;_op1ofs:longint;_op2 : tregister); begin inherited create(op);; @@ -383,7 +409,13 @@ implementation end. { $Log$ - Revision 1.2 2002-08-12 15:08:43 carl + Revision 1.3 2002-08-13 18:01:52 carl + * rename swatoperands to swapoperands + + m68k first compilable version (still needs a lot of testing): + assembler generator, system information , inline + assembler reader. + + Revision 1.2 2002/08/12 15:08:43 carl + stab register indexes for powerpc (moved from gdb to cpubase) + tprocessor enumeration moved to cpuinfo + linker in target_info is now a class diff --git a/compiler/m68k/agcpugas.pas b/compiler/m68k/agcpugas.pas new file mode 100644 index 0000000000..48dfe76c29 --- /dev/null +++ b/compiler/m68k/agcpugas.pas @@ -0,0 +1,426 @@ +{ + $Id$ + Copyright (c) 1998-2002 by Florian Klaempfl + + This unit implements an asmoutput class for m68k GAS syntax + + This program is free software; you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 2 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program; if not, write to the Free Software + Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. + + **************************************************************************** +} +{ This unit implements an asmoutput class for i386 AT&T syntax +} +unit agcpugas; + +{$i fpcdefs.inc} + +interface + + uses + cclasses,cpubase, + globals, + aasmbase,aasmtai,aasmcpu,assemble,aggas; + + type + TM68kAssembler=class(TGNUassembler) + public + procedure WriteInstruction(hp: tai);override; + end; + + const + gas_op2str:op2strtable= + { 68000 only instructions } + ('abcd','add', 'adda','addi','addq','addx','and','andi', + 'asl','asr','bcc','bcs','beq','bge','bgt','bhi', + 'ble','bls','blt','bmi','bne','bpl','bvc','bvs', + 'bchg','bclr','bra','bset','bsr','btst','chk', + 'clr','cmp','cmpa','cmpi','cmpm','dbcc','dbcs','dbeq','dbge', + 'dbgt','dbhi','dble','dbls','dblt','dbmi','dbne','dbra', + 'dbpl','dbt','dbvc','dbvs','dbf','divs','divu', + 'eor','eori','exg','illegal','ext','jmp','jsr', + 'lea','link','lsl','lsr','move','movea','movei','moveq', + 'movem','movep','muls','mulu','nbcd','neg','negx', + 'nop','not','or','ori','pea','rol','ror','roxl', + 'roxr','rtr','rts','sbcd','scc','scs','seq','sge', + 'sgt','shi','sle','sls','slt','smi','sne', + 'spl','st','svc','svs','sf','sub','suba','subi','subq', + 'subx','swap','tas','trap','trapv','tst','unlk', + 'rte','reset','stop', + { MC68010 instructions } + 'bkpt','movec','moves','rtd', + { MC68020 instructions } + 'bfchg','bfclr','bfexts','bfextu','bfffo', + 'bfins','bfset','bftst','callm','cas','cas2', + 'chk2','cmp2','divsl','divul','extb','pack','rtm', + 'trapcc','tracs','trapeq','trapf','trapge','trapgt', + 'traphi','traple','trapls','traplt','trapmi','trapne', + 'trappl','trapt','trapvc','trapvs','unpk', + { FPU Processor instructions - directly supported only. } + { IEEE aware and misc. condition codes not supported } + 'fabs','fadd', + 'fbeq','fbne','fbngt','fbgt','fbge','fbnge', + 'fblt','fbnlt','fble','fbgl','fbngl','fbgle','fbngle', + 'fdbeq','fdbne','fdbgt','fdbngt','fdbge','fdnbge', + 'fdblt','fdbnlt','fdble','fdbgl','fdbngl','fdbgle','fbdngle', + 'fseq','fsne','fsgt','fsngt','fsge','fsnge', + 'fslt','fsnlt','fsle','fsgl','fsngl','fsgle','fsngle', + 'fcmp','fdiv','fmove','fmovem', + 'fmul','fneg','fnop','fsqrt','fsub','fsgldiv', + 'fsflmul','ftst', + 'fint','fintrz', + 'ftrapeq','ftrapne','ftrapgt','ftrapngt','ftrapge','ftrapnge', + 'ftraplt','ftrapnlt','ftraple','ftrapgl','ftrapngl','ftrapgle', + 'ftrapngle', + { Useful for assembly langage output } + { Protected instructions } + 'cprestore','cpsave', + { FPU Unit protected instructions } + { and 68030/68851 common MMU instructions } + { (this may include 68040 MMU instructions) } + 'frestore','fsave','pflush','pflusha','pload','pmove','ptest', + { Useful for assembly langage output } + '','','',''); + + gas_opsize2str : array[topsize] of string[2] = + ('','.b','.w','.l','.s','.d','.x','' + ); + + gas_reg2str : reg2strtable = + ('', '%d0','%d1','%d2','%d3','%d4','%d5','%d6','%d7', + '%a0','%a1','%a2','%a3','%a4','%a5','%a6','%sp', + '-(%sp)','(%sp)+', + '%ccr','%fp0','%fp1','%fp2','%fp3','%fp4','%fp5', + '%fp6','%fp7','%fpcr','%sr','%ssp','%dfc', + '%sfc','%vbr','%fpsr'); + + + implementation + + uses + cutils,systems, + verbose; + + + + function getreferencestring(var ref : treference) : string; + var + s,basestr,indexstr : string; + + begin + s:=''; + with ref do + begin + inc(offset,offsetfixup); + offsetfixup:=0; + basestr:=gas_reg2str[base]; + indexstr:=gas_reg2str[index]; + if assigned(symbol) then + s:=s+symbol.name; + + if offset<0 then s:=s+tostr(offset) + else if (offset>0) then + begin + if (symbol=nil) then s:=tostr(offset) + else s:=s+'+'+tostr(offset); + end + else if (index=R_NO) and (base=R_NO) and not assigned(symbol) then + s:=s+'0'; + + if (index<>R_NO) and (base=R_NO) and (direction=dir_none) then + begin + if (scalefactor = 1) or (scalefactor = 0) then + s:=s+'(,'+indexstr+'.l)' + else + s:=s+'(,'+indexstr+'.l*'+tostr(scalefactor)+')' + end + else if (index=R_NO) and (base<>R_NO) and (direction=dir_inc) then + begin + if (scalefactor = 1) or (scalefactor = 0) then + s:=s+'('+basestr+')+' + else + InternalError(10002); + end + else if (index=R_NO) and (base<>R_NO) and (direction=dir_dec) then + begin + if (scalefactor = 1) or (scalefactor = 0) then + s:=s+'-('+basestr+')' + else + InternalError(10003); + end + else if (index=R_NO) and (base<>R_NO) and (direction=dir_none) then + begin + s:=s+'('+basestr+')' + end + else if (index<>R_NO) and (base<>R_NO) and (direction=dir_none) then + begin + if (scalefactor = 1) or (scalefactor = 0) then + s:=s+'('+basestr+','+indexstr+'.l)' + else + s:=s+'('+basestr+','+indexstr+'.l*'+tostr(scalefactor)+')'; + end; + end; + getreferencestring:=s; + end; + + + function getopstr(const o:toper) : string; + var + hs : string; + i : tregister; + begin + case o.typ of + top_reg : getopstr:=gas_reg2str[o.reg]; + top_ref : getopstr:=getreferencestring(o.ref^); + top_reglist : begin + hs:=''; + for i:=R_NO to R_FPSR do + begin + if i in o.registerlist then + hs:=hs+gas_reg2str[i]+'/'; + end; + delete(hs,length(hs),1); + getopstr := hs; + end; + top_const : getopstr:='#'+tostr(o.val); + top_symbol : + { compare with i386, where a symbol is considered } + { a constant. } + begin + if assigned(o.sym) then + hs:='#'+o.sym.name + else + hs:='#'; + if o.symofs>0 then + hs:=hs+'+'+tostr(o.symofs) + else + if o.symofs<0 then + hs:=hs+tostr(o.symofs) + else + if not(assigned(o.sym)) then + hs:=hs+'0'; + getopstr:=hs; + end; + else internalerror(10001); + end; + end; + + function getopstr_jmp(const o:toper) : string; + var + hs : string; + begin + case o.typ of + top_reg : getopstr_jmp:=gas_reg2str[o.reg]; + top_ref : getopstr_jmp:=getreferencestring(o.ref^); + top_const : getopstr_jmp:=tostr(o.val); + top_symbol : begin + if assigned(o.sym) then + hs:=o.sym.name + else + hs:=''; + if o.symofs>0 then + hs:=hs+'+'+tostr(o.symofs) + else + if o.symofs<0 then + hs:=hs+tostr(o.symofs) + else + if not(assigned(o.sym)) then + hs:=hs+'0'; + getopstr_jmp:=hs; + end; + else internalerror(10001); + end; + end; + +{**************************************************************************** + TM68kASMOUTPUT + ****************************************************************************} + +(* + ait_instruction : begin + { old versions of GAS don't like PEA.L and LEA.L } + if (paicpu(hp)^.opcode in [ + A_LEA,A_PEA,A_ABCD,A_BCHG,A_BCLR,A_BSET,A_BTST, + A_EXG,A_NBCD,A_SBCD,A_SWAP,A_TAS,A_SCC,A_SCS, + A_SEQ,A_SGE,A_SGT,A_SHI,A_SLE,A_SLS,A_SLT,A_SMI, + A_SNE,A_SPL,A_ST,A_SVC,A_SVS,A_SF]) then + s:=#9+mot_op2str[paicpu(hp)^.opcode] + else + s:=#9+mot_op2str[paicpu(hp)^.opcode]+mit_opsize2str[paicpu(hp)^.opsize]; + if paicpu(hp)^.ops>0 then + begin + { call and jmp need an extra handling } + { this code is only callded if jmp isn't a labeled instruction } + if paicpu(hp)^.opcode in [A_BSR,A_BRA,A_LEA,A_PEA,A_JSR,A_JMP] then + s:=s+#9#9+getopstr_jmp(paicpu(hp)^.oper[0]) + else + s:=s+#9+getopstr(paicpu(hp)^.oper[0]); + if paicpu(hp)^.ops>1 then + begin + s:=s+','+getopstr(paicpu(hp)^.oper[1]); + { three operands } + if paicpu(hp)^.ops>2 then + begin + if (paicpu(hp)^.opcode = A_DIVSL) or + (paicpu(hp)^.opcode = A_DIVUL) or + (paicpu(hp)^.opcode = A_MULU) or + (paicpu(hp)^.opcode = A_MULS) or + (paicpu(hp)^.opcode = A_DIVS) or + (paicpu(hp)^.opcode = A_DIVU) then + s:=s+':'+getopstr(paicpu(hp)^.oper[2]) + else + s:=s+','+getopstr(paicpu(hp)^.oper[2]); + end; + end; + end; + AsmWriteLn(s); + end; + + +ait_labeled_instruction : begin + { labeled operand } + if pai_labeled(hp)^.register = R_NO then + begin + if pai_labeled(hp)^.lab <> nil then + AsmWriteLn(#9+mot_op2str[pai_labeled(hp)^.opcode]+#9+pai_labeled(hp)^.lab^.name) + else + AsmWriteLn(#9+mot_op2str[pai_labeled(hp)^.opcode]+#9+pai_labeled(hp)^.sym^.name); + end + else + { labeled operand with register } + begin + if pai_labeled(hp)^.lab <> nil then + begin + AsmWriteLn(#9+mot_op2str[pai_labeled(hp)^.opcode]+#9+ + gas_reg2str[pai_labeled(hp)^.register]+','+pai_labeled(hp)^.lab^.name); + end + else + { a symbol is the value } + begin + AsmWriteLn(#9+mot_op2str[pai_labeled(hp)^.opcode]+#9+ + gas_reg2str[pai_labeled(hp)^.register]+','+pai_labeled(hp)^.sym^.name); + end; + end; + end; +*) + + { returns the opcode string } + function getopcodestring(hp : tai) : string; + var + op : tasmop; + s : string; + begin + op:=taicpu(hp).opcode; + { old versions of GAS don't like PEA.L and LEA.L } + if (op in [ + A_LEA,A_PEA,A_ABCD,A_BCHG,A_BCLR,A_BSET,A_BTST, + A_EXG,A_NBCD,A_SBCD,A_SWAP,A_TAS,A_SCC,A_SCS, + A_SEQ,A_SGE,A_SGT,A_SHI,A_SLE,A_SLS,A_SLT,A_SMI, + A_SNE,A_SPL,A_ST,A_SVC,A_SVS,A_SF]) then + s:=gas_op2str[op] + else + if op = A_SXX then + s:=gas_op2str[op]+cond2str[taicpu(hp).condition] + else + if op in [a_dbxx,a_bxx,a_fbxx] then + s:=gas_op2str[op]+cond2str[taicpu(hp).condition]+gas_opsize2str[taicpu(hp).opsize] + else + s:=gas_op2str[op]+gas_opsize2str[taicpu(hp).opsize]; + getopcodestring:=s; + end; + + procedure TM68kAssembler. WriteInstruction(hp: tai); + var + op : tasmop; + s : string; + sep : char; + calljmp : boolean; + i : integer; + begin + if hp.typ <> ait_instruction then exit; + op:=taicpu(hp).opcode; + calljmp:=is_calljmp(op); + { call maybe not translated to call } + s:=#9+getopcodestring(hp); + { process operands } + if taicpu(hp).ops<>0 then + begin + { call and jmp need an extra handling } + { this code is only called if jmp isn't a labeled instruction } + { quick hack to overcome a problem with manglednames=255 chars } + if calljmp then + begin + AsmWrite(s+#9); + s:=getopstr_jmp(taicpu(hp).oper[0]); + end + else + begin + for i:=0 to taicpu(hp).ops-1 do + begin + if i=0 then + sep:=#9 + else + if ((op = A_DIVSL) or + (op = A_DIVUL) or + (op = A_MULU) or + (op = A_MULS) or + (op = A_DIVS) or + (op = A_DIVU)) and (i=1) then + sep:=':' + else + sep:=','; + s:=s+sep+getopstr(taicpu(hp).oper[i]) + end; + end; + end; + AsmWriteLn(s); + end; + + +{***************************************************************************** + Initialize +*****************************************************************************} + + const + as_m68k_as_info : tasminfo = + ( + id : as_gas; + idtxt : 'AS'; + asmbin : 'as'; + asmcmd : '-o $OBJ $ASM'; + supported_target : system_any; + outputbinary: false; + allowdirect : true; + needar : true; + labelprefix_only_inside_procedure : false; + labelprefix : '.L'; + comment : '# '; + secnames : ('', + '.text','.data','.bss', + '','','','','','', + '.stab','.stabstr','COMMON') + ); + +initialization + RegisterAssembler(as_m68k_as_info,TM68kAssembler); +end. +{ + $Log$ + Revision 1.1 2002-08-13 18:01:52 carl + * rename swatoperands to swapoperands + + m68k first compilable version (still needs a lot of testing): + assembler generator, system information , inline + assembler reader. + +} diff --git a/compiler/m68k/aoptcpu.pas b/compiler/m68k/aoptcpu.pas new file mode 100644 index 0000000000..c1944c6830 --- /dev/null +++ b/compiler/m68k/aoptcpu.pas @@ -0,0 +1,47 @@ +{ + $Id$ + Copyright (c) 1998-2002 by The FPC Development Team + + This unit implements the 680x0 optimizer object + + This program is free software; you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 2 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program; if not, write to the Free Software + Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. + + **************************************************************************** +} + + +Unit aoptcpu; + +Interface + +uses cpubase, aoptobj, aoptcpub; + +Type + TAOptCpu = Object(TAoptObj) + { uses the same constructor as TAopObj } + End; + +Implementation + +End. +{ + $Log$ + Revision 1.1 2002-08-13 18:01:52 carl + * rename swatoperands to swapoperands + + m68k first compilable version (still needs a lot of testing): + assembler generator, system information , inline + assembler reader. + +} diff --git a/compiler/m68k/aoptcpub.pas b/compiler/m68k/aoptcpub.pas new file mode 100644 index 0000000000..660c78aa2a --- /dev/null +++ b/compiler/m68k/aoptcpub.pas @@ -0,0 +1,126 @@ + { + $Id$ + Copyright (c) 1998-2002 by Jonas Maebe, member of the Free Pascal + Development Team + + This unit contains several types and constants necessary for the + optimizer to work on the 80x86 architecture + + This program is free software; you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 2 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program; if not, write to the Free Software + Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. + + **************************************************************************** +} +Unit aoptcpub; { Assembler OPTimizer CPU specific Base } + +{ enable the following define if memory references can have both a base and } +{ index register in 1 operand } + +{$define RefsHaveIndexReg} + +{ enable the following define if memory references can have a scaled index } + +{ define RefsHaveScale} + +{ enable the following define if memory references can have a segment } +{ override } + +{ define RefsHaveSegment} + +Interface + +Uses + aasmcpu,AOptBase; + +Type + +{ type of a normal instruction } + TInstr = Taicpu; + PInstr = ^TInstr; + +{ ************************************************************************* } +{ **************************** TCondRegs ********************************** } +{ ************************************************************************* } +{ Info about the conditional registers } + TCondRegs = Object + Constructor Init; + Destructor Done; + End; + +{ ************************************************************************* } +{ **************************** TAoptBaseCpu ******************************* } +{ ************************************************************************* } + + TAoptBaseCpu = Object(TAoptBase) + End; + + +{ ************************************************************************* } +{ ******************************* Constants ******************************* } +{ ************************************************************************* } +Const + +{ the maximum number of things (registers, memory, ...) a single instruction } +{ changes } + + MaxCh = 3; + +{ the maximum number of operands an instruction has } + + MaxOps = 3; + +{Oper index of operand that contains the source (reference) with a load } +{instruction } + + LoadSrc = 0; + +{Oper index of operand that contains the destination (register) with a load } +{instruction } + + LoadDst = 1; + +{Oper index of operand that contains the source (register) with a store } +{instruction } + + StoreSrc = 0; + +{Oper index of operand that contains the destination (reference) with a load } +{instruction } + + StoreDst = 1; + +Implementation + +{ ************************************************************************* } +{ **************************** TCondRegs ********************************** } +{ ************************************************************************* } +Constructor TCondRegs.init; +Begin +End; + +Destructor TCondRegs.Done; {$ifdef inl} inline; {$endif inl} +Begin +End; + +End. + +{ + $Log$ + Revision 1.1 2002-08-13 18:01:52 carl + * rename swatoperands to swapoperands + + m68k first compilable version (still needs a lot of testing): + assembler generator, system information , inline + assembler reader. + +} diff --git a/compiler/m68k/cpubase.pas b/compiler/m68k/cpubase.pas index a2fd2d6f95..6febd063c3 100644 --- a/compiler/m68k/cpubase.pas +++ b/compiler/m68k/cpubase.pas @@ -86,10 +86,10 @@ uses { (this may include 68040 mmu instructions) } a_frestore,a_fsave,a_pflush,a_pflusha,a_pload,a_pmove,a_ptest, { useful for assembly langage output } - a_label,a_none,a_dbxx,a_setxx,a_bxx,a_fbxx); + a_label,a_none,a_dbxx,a_sxx,a_bxx,a_fbxx); {# This should define the array of instructions as string } - op2strtable=array[tasmop] of string[8]; + op2strtable=array[tasmop] of string[11]; Const {# First value of opcode enumeration } @@ -123,7 +123,7 @@ uses treg64 = tregister64; {# Type definition for the array of string of register nnames } - reg2strtable = array[tregister] of string[5]; + reg2strtable = array[tregister] of string[7]; Const {# First register in the tregister enumeration } @@ -131,15 +131,6 @@ uses {# Last register in the tregister enumeration } lastreg = high(tregister); -(* - gas_reg2str : reg2strtable = - ('', '%d0','%d1','%d2','%d3','%d4','%d5','%d6','%d7', - '%a0','%a1','%a2','%a3','%a4','%a5','%a6','%sp', - '-(%sp)','(%sp)+', - '%ccr','%fp0','%fp1','%fp2','%fp3','%fp4','%fp5', - '%fp6','%fp7','%fpcr','%sr','%ssp','%dfc', - '%sfc','%vbr','%fpsr'); -*) std_reg2str : reg2strtable = ('', 'd0','d1','d2','d3','d4','d5','d6','d7', 'a0','a1','a2','a3','a4','a5','a6','sp', @@ -313,7 +304,7 @@ uses { S_FS = single type (32 bit) } { S_FD = double/64bit integer } { S_FX = Extended type } - topsize = (S_NO,S_B,S_W,S_L,S_FS,S_FD,S_FX); + topsize = (S_NO,S_B,S_W,S_L,S_FS,S_FD,S_FX,S_IQ); {***************************************************************************** Constants @@ -561,7 +552,13 @@ implementation end. { $Log$ - Revision 1.4 2002-08-12 15:08:44 carl + Revision 1.5 2002-08-13 18:01:52 carl + * rename swatoperands to swapoperands + + m68k first compilable version (still needs a lot of testing): + assembler generator, system information , inline + assembler reader. + + Revision 1.4 2002/08/12 15:08:44 carl + stab register indexes for powerpc (moved from gdb to cpubase) + tprocessor enumeration moved to cpuinfo + linker in target_info is now a class diff --git a/compiler/m68k/cpunode.pas b/compiler/m68k/cpunode.pas new file mode 100644 index 0000000000..731ea4c748 --- /dev/null +++ b/compiler/m68k/cpunode.pas @@ -0,0 +1,62 @@ +{ + $Id$ + Copyright (c) 2000-2002 by Florian Klaempfl + + Includes the 680x0/Coldfire code generator + + This program is free software; you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 2 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program; if not, write to the Free Software + Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. + + **************************************************************************** +} +unit cpunode; + +{$i fpcdefs.inc} + + interface + + implementation + + uses + { generic nodes } + ncgbas,ncgld,ncgflw,ncgcnv,ncgmem,ncgcon,ncgcal,ncgset,ncginl + { to be able to only parts of the generic code, + the processor specific nodes must be included + after the generic one (FK) + } +// nm68kadd, +// nppccal, +// nppccon, +// nppcflw, +// nppcmem, +// nppcset, +// nppcinl, +// nppcopt, + { this not really a node } +// nppcobj, +// nppcmat, +// nppccnv + ; + +end. +{ + $Log$ + Revision 1.1 2002-08-13 18:01:52 carl + * rename swatoperands to swapoperands + + m68k first compilable version (still needs a lot of testing): + assembler generator, system information , inline + assembler reader. + + +} diff --git a/compiler/m68k/cpuswtch.pas b/compiler/m68k/cpuswtch.pas index 4de6e212e9..8078301bde 100644 --- a/compiler/m68k/cpuswtch.pas +++ b/compiler/m68k/cpuswtch.pas @@ -1 +1,116 @@ -ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ \ No newline at end of file +{ + $Id$ + Copyright (c) 1998-2002 by Florian Klaempfl, Pierre Muller + + interprets the commandline options which are 680x0 specific + + This program is free software; you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 2 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program; if not, write to the Free Software + Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. + + **************************************************************************** +} +unit cpuswtch; + +{$i fpcdefs.inc} + +interface + +uses + options; + +type + toptionm68k=class(toption) + procedure interpret_proc_specific_options(const opt:string);override; + end; + +implementation + +uses + cutils,globtype,systems,globals,cpuinfo; + +procedure toptionm68k.interpret_proc_specific_options(const opt:string); +var + j : longint; + More : string; +begin + More:=Upper(copy(opt,3,length(opt)-2)); + case opt[2] of + 'O' : Begin + j := 3; + While (j <= Length(Opt)) Do + Begin + case opt[j] of + '-' : + begin + initglobalswitches:=initglobalswitches-[cs_optimize,cs_fastoptimize,cs_slowoptimize,cs_littlesize, + cs_regalloc,cs_uncertainopts]; + FillChar(ParaAlignment,sizeof(ParaAlignment),0); + end; + 'a' : + begin + UpdateAlignmentStr(Copy(Opt,j+1,255),ParaAlignment); + j:=length(Opt); + end; + 'g' : initglobalswitches:=initglobalswitches+[cs_littlesize]; + 'G' : initglobalswitches:=initglobalswitches-[cs_littlesize]; + 'r' : + begin + initglobalswitches:=initglobalswitches+[cs_regalloc]; + Simplify_ppu:=false; + end; + 'u' : initglobalswitches:=initglobalswitches+[cs_uncertainopts]; + '1' : initglobalswitches:=initglobalswitches-[cs_fastoptimize,cs_slowoptimize]+[cs_optimize]; + '2' : initglobalswitches:=initglobalswitches-[cs_slowoptimize]+[cs_optimize,cs_fastoptimize]; + '3' : initglobalswitches:=initglobalswitches+[cs_optimize,cs_fastoptimize,cs_slowoptimize]; + 'p' : + Begin + If j < Length(Opt) Then + Begin + Case opt[j+1] Of + '2': initoptprocessor := MC68020; + Else IllegalPara(Opt) + End; + Inc(j); + End + Else IllegalPara(opt) + End; + else IllegalPara(opt); + End; + Inc(j) + end; + end; + 'R' : begin + if More='GAS' then + initasmmode:=asmmode_standard + else + IllegalPara(opt); + end; + else + IllegalPara(opt); + end; +end; + + +initialization + coption:=toptionm68k; +end. +{ + $Log$ + Revision 1.4 2002-08-13 18:01:52 carl + * rename swatoperands to swapoperands + + m68k first compilable version (still needs a lot of testing): + assembler generator, system information , inline + assembler reader. + +} diff --git a/compiler/m68k/cputarg.pas b/compiler/m68k/cputarg.pas new file mode 100644 index 0000000000..65420f3633 --- /dev/null +++ b/compiler/m68k/cputarg.pas @@ -0,0 +1,59 @@ +{ + $Id$ + Copyright (c) 2001-2002 by Peter Vreman + + Includes the m68k dependent target units + + This program is free software; you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 2 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program; if not, write to the Free Software + Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. + + **************************************************************************** +} +unit cputarg; + +{$i fpcdefs.inc} + +interface + + +implementation + + uses + systems { prevent a syntax error when nothing is included } + +{************************************** + Targets +**************************************} + + {$ifndef NOTARGETLINUX} + ,t_linux + {$endif} + +{************************************** + Assemblers +**************************************} + + ,agcpugas + ; + +end. +{ + $Log$ + Revision 1.1 2002-08-13 18:01:52 carl + * rename swatoperands to swapoperands + + m68k first compilable version (still needs a lot of testing): + assembler generator, system information , inline + assembler reader. + +} diff --git a/compiler/m68k/radirect.pas b/compiler/m68k/radirect.pas new file mode 100644 index 0000000000..4a76424888 --- /dev/null +++ b/compiler/m68k/radirect.pas @@ -0,0 +1,62 @@ +{ + $Id$ + Copyright (c) 1998-2002 by Florian Klaempfl + + Reads inline assembler and writes the lines direct to the output + This is not supported for the m68k + + This program is free software; you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 2 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program; if not, write to the Free Software + Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. + + **************************************************************************** +} +unit radirect; + +{$i fpcdefs.inc} + +interface + + uses + node; + + function assemble : tnode; + + implementation + + uses + verbose; + + + function assemble : tnode; + + begin + internalerror(20020813); + end; + +{***************************************************************************** + Initialize +*****************************************************************************} + + +end. +{ + $Log$ + Revision 1.1 2002-08-13 18:01:52 carl + * rename swatoperands to swapoperands + + m68k first compilable version (still needs a lot of testing): + assembler generator, system information , inline + assembler reader. + + +} diff --git a/compiler/m68k/rasm.pas b/compiler/m68k/rasm.pas index b85596c472..e19c6d8b19 100644 --- a/compiler/m68k/rasm.pas +++ b/compiler/m68k/rasm.pas @@ -44,11 +44,34 @@ Unit Rasm; Interface +{$i fpcdefs.inc} + Uses - globtype,cpubase,tree; + node; function assemble: tnode; + + +Implementation + + uses + { common } + cutils,cclasses, + { global } + globtype,globals,verbose, + systems, + { aasm } + cpubase,cpuinfo,aasmbase,aasmtai,aasmcpu, + { symtable } + symconst,symbase,symtype,symsym,symtable, + { pass 1 } + nbas, + { parser } + scanner,agcpugas, + rautils + ; + const { this variable is TRUE if the lookup tables have already been setup } { for fast access. On the first call to assemble the tables are setup } @@ -70,15 +93,8 @@ var iasmregs: array[firstasmreg..lastasmreg] of string[6]; -Implementation - -uses - files,globals,systems,RAUtils,strings,hcodegen,scanner,aasm, - cpuasm,cobjects,verbose,symconst,symtable; - - type - tmotorolatoken = ( + tasmtoken = ( AS_NONE,AS_LABEL,AS_LLABEL,AS_STRING,AS_HEXNUM,AS_OCTALNUM, AS_BINNUM,AS_COMMA,AS_LBRACKET,AS_RBRACKET,AS_LPAREN, AS_RPAREN,AS_COLON,AS_DOT,AS_PLUS,AS_MINUS,AS_STAR,AS_INTNUM, @@ -89,6 +105,8 @@ type {------------------ Assembler Operators --------------------} AS_MOD,AS_SHL,AS_SHR,AS_NOT,AS_AND,AS_OR,AS_XOR); + + const firstdirective = AS_DB; lastdirective = AS_END; @@ -112,12 +130,11 @@ const firsttoken : boolean = TRUE; operandnum : byte = 0; var - p : paasmoutput; - actasmtoken: tmotorolatoken; + actasmtoken: tasmtoken; actasmpattern: string; c: char; - Instr: TInstruction; old_exit : pointer; + curlist : taasmoutput; Procedure SetupTables; { creates uppercased symbol tables for speed access } @@ -129,10 +146,10 @@ var { opcodes } new(iasmops); for i:=firstop to lastop do - iasmops^[i] := upper(mot_op2str[i]); + iasmops^[i] := upper(gas_op2str[i]); { opcodes } for j:=firstasmreg to lastasmreg do - iasmregs[j] := upper(mot_reg2str[j]); + iasmregs[j] := upper(std_reg2str[j]); end; @@ -169,7 +186,7 @@ var - Procedure is_asmdirective(const s: string; var token: tmotorolatoken); + Procedure is_asmdirective(const s: string; var token: tasmtoken); {*********************************************************************} { FUNCTION is_asmdirective(s: string; var token: tinteltoken):Boolean } { Description: Determines if the s string is a valid directive } @@ -183,14 +200,14 @@ var begin if s=_asmdirectives[i] then begin - token := tmotorolatoken(longint(firstdirective)+i); + token := tasmtoken(longint(firstdirective)+i); exit; end; end; end; - Procedure is_register(const s: string; var token: tmotorolatoken); + Procedure is_register(const s: string; var token: tasmtoken); {*********************************************************************} { PROCEDURE is_register(s: string; var token: tinteltoken); } { Description: Determines if the s string is a valid register, if } @@ -217,14 +234,14 @@ var - Function GetToken: tmotorolatoken; + Function GetToken: tasmtoken; {*********************************************************************} { FUNCTION GetToken: tinteltoken; } { Description: This routine returns intel assembler tokens and } { does some minor syntax error checking. } {*********************************************************************} var - token: tmotorolatoken; + token: tasmtoken; forcelabel: boolean; begin forcelabel := FALSE; @@ -233,10 +250,10 @@ var token := AS_NONE; { while space and tab , continue scan... } while c in [' ',#9] do - c:=current_scanner^.asmgetchar; + c:=current_scanner.asmgetchar; if not (c in [newline,#13,'{',';']) then - current_scanner^.gettokenpos; + current_scanner.gettokenpos; { Possiblities for first token in a statement: } { Local Label, Label, Directive, Prefix or Opcode.... } if firsttoken and not (c in [newline,#13,'{',';']) then @@ -247,7 +264,7 @@ var begin token := AS_LLABEL; { this is a local label } { Let us point to the next character } - c := current_scanner^.asmgetchar; + c := current_scanner.asmgetchar; end; @@ -257,7 +274,7 @@ var { if there is an at_sign, then this must absolutely be a label } if c = '@' then forcelabel:=TRUE; actasmpattern := actasmpattern + c; - c := current_scanner^.asmgetchar; + c := current_scanner.asmgetchar; end; uppervar(actasmpattern); @@ -269,7 +286,7 @@ var AS_LLABEL: ; { do nothing } end; { end case } { let us point to the next character } - c := current_scanner^.asmgetchar; + c := current_scanner.asmgetchar; gettoken := token; exit; end; @@ -305,11 +322,11 @@ var { - @Result, @Code or @Data special variables. } begin actasmpattern := c; - c:= current_scanner^.asmgetchar; + c:= current_scanner.asmgetchar; while c in ['A'..'Z','a'..'z','0'..'9','_','@','.'] do begin actasmpattern := actasmpattern + c; - c := current_scanner^.asmgetchar; + c := current_scanner.asmgetchar; end; uppervar(actasmpattern); gettoken := AS_ID; @@ -318,11 +335,11 @@ var { identifier, register, opcode, prefix or directive } 'A'..'Z','a'..'z','_': begin actasmpattern := c; - c:= current_scanner^.asmgetchar; + c:= current_scanner.asmgetchar; while c in ['A'..'Z','a'..'z','0'..'9','_','.'] do begin actasmpattern := actasmpattern + c; - c := current_scanner^.asmgetchar; + c := current_scanner.asmgetchar; end; uppervar(actasmpattern); @@ -348,7 +365,7 @@ var end; { override operator... not supported } '&': begin - c:=current_scanner^.asmgetchar; + c:=current_scanner.asmgetchar; gettoken := AS_AND; end; { string or character } @@ -359,7 +376,7 @@ var begin if c = '''' then begin - c:=current_scanner^.asmgetchar; + c:=current_scanner.asmgetchar; if c=newline then begin Message(scan_f_string_exceeds_line); @@ -368,11 +385,11 @@ var repeat if c=''''then begin - c:=current_scanner^.asmgetchar; + c:=current_scanner.asmgetchar; if c='''' then begin actasmpattern:=actasmpattern+''''; - c:=current_scanner^.asmgetchar; + c:=current_scanner.asmgetchar; if c=newline then begin Message(scan_f_string_exceeds_line); @@ -384,7 +401,7 @@ var else begin actasmpattern:=actasmpattern+c; - c:=current_scanner^.asmgetchar; + c:=current_scanner.asmgetchar; if c=newline then begin Message(scan_f_string_exceeds_line); @@ -400,101 +417,101 @@ var exit; end; '$' : begin - c:=current_scanner^.asmgetchar; + c:=current_scanner.asmgetchar; while c in ['0'..'9','A'..'F','a'..'f'] do begin actasmpattern := actasmpattern + c; - c := current_scanner^.asmgetchar; + c := current_scanner.asmgetchar; end; gettoken := AS_HEXNUM; exit; end; ',' : begin gettoken := AS_COMMA; - c:=current_scanner^.asmgetchar; + c:=current_scanner.asmgetchar; exit; end; '(' : begin gettoken := AS_LPAREN; - c:=current_scanner^.asmgetchar; + c:=current_scanner.asmgetchar; exit; end; ')' : begin gettoken := AS_RPAREN; - c:=current_scanner^.asmgetchar; + c:=current_scanner.asmgetchar; exit; end; ':' : begin gettoken := AS_COLON; - c:=current_scanner^.asmgetchar; + c:=current_scanner.asmgetchar; exit; end; { '.' : begin gettoken := AS_DOT; - c:=current_scanner^.asmgetchar; + c:=current_scanner.asmgetchar; exit; end; } '+' : begin gettoken := AS_PLUS; - c:=current_scanner^.asmgetchar; + c:=current_scanner.asmgetchar; exit; end; '-' : begin gettoken := AS_MINUS; - c:=current_scanner^.asmgetchar; + c:=current_scanner.asmgetchar; exit; end; '*' : begin gettoken := AS_STAR; - c:=current_scanner^.asmgetchar; + c:=current_scanner.asmgetchar; exit; end; '/' : begin gettoken := AS_SLASH; - c:=current_scanner^.asmgetchar; + c:=current_scanner.asmgetchar; exit; end; '<' : begin - c := current_scanner^.asmgetchar; + c := current_scanner.asmgetchar; { invalid characters } if c <> '<' then Message(asmr_e_invalid_char_smaller); { still assume << } gettoken := AS_SHL; - c := current_scanner^.asmgetchar; + c := current_scanner.asmgetchar; exit; end; '>' : begin - c := current_scanner^.asmgetchar; + c := current_scanner.asmgetchar; { invalid characters } if c <> '>' then Message(asmr_e_invalid_char_greater); { still assume << } gettoken := AS_SHR; - c := current_scanner^.asmgetchar; + c := current_scanner.asmgetchar; exit; end; '|' : begin gettoken := AS_OR; - c := current_scanner^.asmgetchar; + c := current_scanner.asmgetchar; exit; end; '^' : begin gettoken := AS_XOR; - c := current_scanner^.asmgetchar; + c := current_scanner.asmgetchar; exit; end; '#' : begin gettoken:=AS_APPT; - c:=current_scanner^.asmgetchar; + c:=current_scanner.asmgetchar; exit; end; '%' : begin - c:=current_scanner^.asmgetchar; + c:=current_scanner.asmgetchar; while c in ['0','1'] do Begin actasmpattern := actasmpattern + c; - c := current_scanner^.asmgetchar; + c := current_scanner.asmgetchar; end; gettoken := AS_BINNUM; exit; @@ -502,25 +519,25 @@ var { integer number } '0'..'9': begin actasmpattern := c; - c := current_scanner^.asmgetchar; + c := current_scanner.asmgetchar; while c in ['0'..'9'] do Begin actasmpattern := actasmpattern + c; - c:= current_scanner^.asmgetchar; + c:= current_scanner.asmgetchar; end; gettoken := AS_INTNUM; exit; end; ';' : begin repeat - c:=current_scanner^.asmgetchar; + c:=current_scanner.asmgetchar; until c=newline; firsttoken := TRUE; gettoken:=AS_SEPARATOR; end; '{',#13,newline : begin - c:=current_scanner^.asmgetchar; + c:=current_scanner.asmgetchar; firsttoken := TRUE; gettoken:=AS_SEPARATOR; end; @@ -538,11 +555,11 @@ var { Routines for the parsing } {---------------------------------------------------------------------} - procedure consume(t : tmotorolatoken); + procedure consume(t : tasmtoken); begin if t<>actasmtoken then - Message(asmr_e_syntax_error); + Message(asmr_e_syntax_error); actasmtoken:=gettoken; { if the token must be ignored, then } { get another token to parse. } @@ -578,7 +595,7 @@ var end; - function findopcode(s: string): tasmop; + function findopcode(s: string; var opsize: topsize): tasmop; {*********************************************************************} { FUNCTION findopcode(s: string): tasmop; } { Description: Determines if the s string is a valid opcode } @@ -597,12 +614,12 @@ var case op_size[1] of { For the motorola only opsize size is used to } { determine the size of the operands. } - 'B': instr.opsize := S_B; - 'W': instr.opsize := S_W; - 'L': instr.opsize := S_L; - 'S': instr.opsize := S_FS; - 'D': instr.opsize := S_FL; - 'X': instr.opsize := S_FX; + 'B': opsize := S_B; + 'W': opsize := S_W; + 'L': opsize := S_L; + 'S': opsize := S_FS; + 'D': opsize := S_FD; + 'X': opsize := S_FX; else Message1(asmr_e_unknown_opcode,s); end; @@ -617,354 +634,9 @@ var end; end; - Procedure InitAsmRef(var instr: TInstruction); - {*********************************************************************} - { Description: This routine first check if the instruction is of } - { type OPR_NONE, or OPR_REFERENCE , if not it gives out an error. } - { If the operandtype = OPR_NONE or <> OPR_REFERENCE then it sets up } - { the operand type to OPR_REFERENCE, as well as setting up the ref } - { to point to the default segment. } - {*********************************************************************} - Begin - With instr do - Begin - case operands[operandnum]^.opr.typ of - OPR_REFERENCE: exit; - OPR_NONE: ; - else - Message(asmr_e_invalid_operand_type); - end; - operands[operandnum]^.opr.ref.direction := dir_none; - operands[operandnum]^.opr.typ := OPR_REFERENCE; - operands[operandnum]^.opr.ref.segment := R_NO; - end; - end; - - Function CalculateExpression(expression: string): longint; - var - expr: TExprParse; - Begin - expr.Init; - CalculateExpression := expr.Evaluate(expression); - expr.Done; - end; - - - Procedure ConcatOpCode(var instr: TInstruction); - var - fits : boolean; - instruc: tasmop; - Begin - fits := FALSE; - { setup specific instructions for first pass } - instruc := instr.opcode; - - { Setup special operands } - { Convert to general form as to conform to the m68k opcode table } - if (instruc = A_ADDA) or (instruc = A_ADDI) - then instruc := A_ADD - else - { CMPM excluded because of GAS v1.34 BUG } - if (instruc = A_CMPA) or - (instruc = A_CMPI) then - instruc := A_CMP - else - if instruc = A_EORI then - instruc := A_EOR - else - if instruc = A_MOVEA then - instruc := A_MOVE - else - if instruc = A_ORI then - instruc := A_OR - else - if (instruc = A_SUBA) or (instruc = A_SUBI) then - instruc := A_SUB; - - { Setup operand types } - -(* - in instruc <> A_MOVEM then - Begin - - while not(fits) do - begin - { set the instruction cache, if the instruction } - { occurs the first time } - if (it[i].i=instruc) and (ins_cache[instruc]=-1) then - ins_cache[instruc]:=i; - - if (it[i].i=instruc) and (instr.ops=it[i].ops) then - begin - { first fit } - case instr.ops of - 0 : begin - fits:=true; - break; - end; - 1 : - Begin - if (optyp1 and it[i].o1)<>0 then - Begin - fits:=true; - break; - end; - end; - 2 : if ((optyp1 and it[i].o1)<>0) and - ((optyp2 and it[i].o2)<>0) then - Begin - fits:=true; - break; - end - 3 : if ((optyp1 and it[i].o1)<>0) and - ((optyp2 and it[i].o2)<>0) and - ((optyp3 and it[i].o3)<>0) then - Begin - fits:=true; - break; - end; - end; { end case } - end; { endif } - if it[i].i=A_NONE then - begin - { NO MATCH! } - Message(asmr_e_invalid_combination_opcode_and_operand); - exit; - end; - inc(i); - end; { end while } - *) - fits:=TRUE; - - { We add the opcode to the opcode linked list } - if fits then - Begin - case instr.ops of - - 0: - if instr.opsize <> S_NO then - p^.concat(new(paicpu,op_none(instruc,instr.opsize))) - else - p^.concat(new(paicpu,op_none(instruc,S_NO))); - 1: Begin - case instr.operands[1]^.opr.typ of - OPR_SYMBOL: Begin - p^.concat(new(paicpu,op_sym_ofs(instruc, - instr.opsize, instr.operands[1]^.opr.symbol,instr.operands[1]^.opr.symofs))); - end; - OPR_CONSTANT: Begin - p^.concat(new(paicpu,op_const(instruc, - instr.opsize, instr.operands[1]^.opr.val))); - end; - OPR_REGISTER: p^.concat(new(paicpu,op_reg(instruc, - instr.opsize,instr.operands[1]^.opr.reg))); - OPR_REFERENCE: - if instr.opsize <> S_NO then - Begin - p^.concat(new(paicpu,op_ref(instruc, - instr.opsize,newreference(instr.operands[1]^.opr.ref)))); - end - else - Begin - { special jmp and call case with } - { symbolic references. } - if instruc in [A_BSR,A_JMP,A_JSR,A_BRA,A_PEA] then - Begin - p^.concat(new(paicpu,op_ref(instruc, - S_NO,newreference(instr.operands[1]^.opr.ref)))); - end - else - Message(asmr_e_invalid_opcode_and_operand); - end; - OPR_NONE: Begin - Message(asmr_e_invalid_opcode_and_operand); - end; - else - Begin - Message(asmr_e_invalid_opcode_and_operand); - end; - end; - end; - 2: - Begin - With instr do - Begin - { source } - case operands[1]^.opr.typ of - { reg,reg } - { reg,ref } - OPR_REGISTER: - Begin - case operands[2]^.opr.typ of - OPR_REGISTER: - Begin - p^.concat(new(paicpu,op_reg_reg(instruc, - opsize,operands[1]^.opr.reg,operands[2]^.opr.reg))); - end; - OPR_REFERENCE: - p^.concat(new(paicpu,op_reg_ref(instruc, - opsize,operands[1]^.opr.reg,newreference(operands[2]^.opr.ref)))); - else { else case } - Begin - Message(asmr_e_invalid_opcode_and_operand); - end; - end; { end second operand case for OPR_REGISTER } - end; - { reglist, ref } - OPR_REGLIST: - Begin - case operands[2]^.opr.typ of - OPR_REFERENCE : - p^.concat(new(paicpu,op_reglist_ref(instruc, - opsize,operands[1]^.opr.reglist^,newreference(operands[2]^.opr.ref)))); - else - Begin - Message(asmr_e_invalid_opcode_and_operand); - end; - end; { end second operand case for OPR_REGLIST } - end; - - { const,reg } - { const,const } - { const,ref } - OPR_CONSTANT: - case instr.operands[2]^.opr.typ of - { constant, constant does not have a specific size. } - OPR_CONSTANT: - p^.concat(new(paicpu,op_const_const(instruc, - S_NO,operands[1]^.opr.val,operands[2]^.opr.val))); - OPR_REFERENCE: - Begin - p^.concat(new(paicpu,op_const_ref(instruc, - opsize,operands[1]^.opr.val, - newreference(operands[2]^.opr.ref)))) - end; - OPR_REGISTER: - Begin - p^.concat(new(paicpu,op_const_reg(instruc, - opsize,operands[1]^.opr.val, - operands[2]^.opr.reg))) - end; - else - Begin - Message(asmr_e_invalid_opcode_and_operand); - end; - end; { end second operand case for OPR_CONSTANT } - { ref,reg } - { ref,ref } - OPR_REFERENCE: - case instr.operands[2]^.opr.typ of - OPR_REGISTER: - Begin - p^.concat(new(paicpu,op_ref_reg(instruc, - opsize,newreference(operands[1]^.opr.ref), - operands[2]^.opr.reg))); - end; - OPR_REGLIST: - Begin - p^.concat(new(paicpu,op_ref_reglist(instruc, - opsize,newreference(operands[1]^.opr.ref), - operands[2]^.opr.reglist^))); - end; - OPR_REFERENCE: { special opcodes } - p^.concat(new(paicpu,op_ref_ref(instruc, - opsize,newreference(operands[1]^.opr.ref), - newreference(operands[2]^.opr.ref)))); - else - Begin - Message(asmr_e_invalid_opcode_and_operand); - end; - end; { end second operand case for OPR_REFERENCE } - OPR_SYMBOL: case operands[2]^.opr.typ of - OPR_REFERENCE: - Begin - p^.concat(new(paicpu,op_sym_ofs_ref(instruc, - opsize,instr.operands[1]^.opr.symbol,instr.operands[1]^.opr.symofs, - newreference(operands[2]^.opr.ref)))) - end; - OPR_REGISTER: - Begin - p^.concat(new(paicpu,op_sym_ofs_reg(instruc, - opsize,instr.operands[1]^.opr.symbol,instr.operands[1]^.opr.symofs, - operands[2]^.opr.reg))) - end; - else - Begin - Message(asmr_e_invalid_opcode_and_operand); - end; - end; { end second operand case for OPR_SYMBOL } - else - Begin - Message(asmr_e_invalid_opcode_and_operand); - end; - end; { end first operand case } - end; { end with } - end; - 3: Begin - if (instruc = A_DIVSL) or (instruc = A_DIVUL) or (instruc = A_MULU) - or (instruc = A_MULS) or (instruc = A_DIVS) or (instruc = A_DIVU) then - Begin - if (instr.operands[1]^.opr.typ <> OPR_REGISTER) - or (instr.operands[2]^.opr.typ <> OPR_REGISTER) - or (instr.operands[3]^.opr.typ <> OPR_REGISTER) then - Begin - Message(asmr_e_invalid_opcode_and_operand); - end - else - Begin - p^.concat(new(paicpu, op_reg_reg_reg(instruc,instr.opsize, - instr.operands[1]^.opr.reg,instr.operands[2]^.opr.reg,instr.operands[3]^.opr.reg))); - end; - end - else - Message(asmr_e_invalid_opcode_and_operand); - end; - end; { end case } - end; - end; - - - Procedure ConcatLabeledInstr(var instr: TInstruction); - Begin - if ((instr.opcode >= A_BCC) and (instr.opcode <= A_BVS)) - or (instr.opcode = A_BRA) or (instr.opcode = A_BSR) - or (instr.opcode = A_JMP) or (instr.opcode = A_JSR) - or ((instr.opcode >= A_FBEQ) and (instr.opcode <= A_FBNGLE)) - then - Begin - if instr.ops > 2 then - Message(asmr_e_invalid_opcode_and_operand) - else if instr.operands[1]^.opr.typ <> OPR_SYMBOL then - Message(asmr_e_invalid_opcode_and_operand) - else if (instr.operands[1]^.opr.typ = OPR_SYMBOL) and - (instr.ops = 1) then - if assigned(instr.operands[1]^.opr.symbol) and - (instr.operands[1]^.opr.symofs=0) then - p^.concat(new(pai_labeled,init_sym(instr.opcode, - instr.operands[1]^.opr.symbol))) - else - Message(asmr_e_invalid_opcode_and_operand); - end - else - if ((instr.opcode >= A_DBCC) and (instr.opcode <= A_DBF)) - or ((instr.opcode >= A_FDBEQ) and (instr.opcode <= A_FBDNGLE)) then - begin - if (instr.ops<>2) or - (instr.operands[1]^.opr.typ <> OPR_REGISTER) or - (instr.operands[2]^.opr.typ <> OPR_SYMBOL) or - (instr.operands[2]^.opr.symofs <> 0) then - Message(asmr_e_invalid_opcode_and_operand) - else - p^.concat(new(pai_labeled,init_reg_sym(instr.opcode, - instr.operands[2]^.opr.symbol,instr.operands[1]^.opr.reg))); - end - else - Message(asmr_e_invalid_opcode_and_operand); - end; - Function BuildExpression(allow_symbol : boolean; asmsym : pstring) : longint; {*********************************************************************} { FUNCTION BuildExpression: longint } @@ -981,8 +653,9 @@ var {*********************************************************************} var expr: string; hs, tempstr: string; - sym : psym; - hl : pasmlabel; + sym : tsym; + srsymtable : tsymtable; + hl : tasmlabel; l : longint; errorflag: boolean; Begin @@ -1071,31 +744,39 @@ var if (length(tempstr)>1) and (tempstr[1]='@') then begin CreateLocalLabel(tempstr,hl,false); - hs:=hl^.name + hs:=hl.name end else if SearchLabel(tempstr,hl,false) then - hs:=hl^.name + hs:=hl.name else begin - getsym(tempstr,false); - sym:=srsym; + searchsym(tempstr,sym,srsymtable); if assigned(sym) then - begin - case srsym^.typ of - varsym : - begin - if sym^.owner^.symtabletype in [localsymtable,parasymtable] then - Message(asmr_e_no_local_or_para_allowed); - hs:=pvarsym(srsym)^.mangledname; - end; - typedconstsym : - hs:=ptypedconstsym(srsym)^.mangledname; - procsym : - hs:=pprocsym(srsym)^.mangledname; - else - Message(asmr_e_wrong_sym_type); - end; - end + begin + case sym.typ of + varsym : + begin + if sym.owner.symtabletype in [localsymtable,parasymtable] then + Message(asmr_e_no_local_or_para_allowed); + hs:=tvarsym(sym).mangledname; + end; + typedconstsym : + hs:=ttypedconstsym(sym).mangledname; + procsym : + begin + if assigned(tprocsym(sym).defs^.next) then + Message(asmr_w_calling_overload_func); + hs:=tprocsym(sym).defs^.def.mangledname; + end; + typesym : + begin + if not(ttypesym(sym).restype.def.deftype in [recorddef,objectdef]) then + Message(asmr_e_wrong_sym_type); + end; + else + Message(asmr_e_wrong_sym_type); + end; + end else Message1(sym_e_unknown_id,tempstr); end; @@ -1255,11 +936,11 @@ var Begin r:=0; Message(asmr_e_invalid_float_expr); - ConcatRealConstant(p,r,typ); + ConcatRealConstant(curlist,r,typ); End else Begin - ConcatRealConstant(p,r,typ); + ConcatRealConstant(curlist,r,typ); End; end else @@ -1268,8 +949,99 @@ var end; + Procedure BuildConstant(maxvalue: longint); + {*********************************************************************} + { PROCEDURE BuildConstant } + { Description: This routine takes care of parsing a DB,DD,or DW } + { line and adding those to the assembler node. Expressions, range- } + { checking are fullly taken care of. } + { maxvalue: $ff -> indicates that this is a DB node. } + { $ffff -> indicates that this is a DW node. } + { $ffffffff -> indicates that this is a DD node. } + {*********************************************************************} + { EXIT CONDITION: On exit the routine should point to AS_SEPARATOR. } + {*********************************************************************} + var + strlength: byte; + expr: string; + tempstr: string; + value : longint; + Begin + Repeat + Case actasmtoken of + AS_STRING: Begin + if maxvalue = $ff then + strlength := 1 + else + Message(asmr_e_string_not_allowed_as_const); + expr := actasmpattern; + if length(expr) > 1 then + Message(asmr_e_string_not_allowed_as_const); + Consume(AS_STRING); + Case actasmtoken of + AS_COMMA: Consume(AS_COMMA); + AS_SEPARATOR: ; + else + Message(asmr_e_invalid_string_expression); + end; { end case } + ConcatString(curlist,expr); + end; + AS_INTNUM,AS_BINNUM, + AS_OCTALNUM,AS_HEXNUM: + Begin + value:=BuildExpression(false,nil); + ConcatConstant(curlist,value,maxvalue); + end; + AS_ID: + Begin + value:=BuildExpression(false,nil); + if value > maxvalue then + Begin + Message(asmr_e_constant_out_of_bounds); + { assuming a value of maxvalue } + value := maxvalue; + end; + ConcatConstant(curlist,value,maxvalue); + end; + { These terms can start an assembler expression } + AS_PLUS,AS_MINUS,AS_LPAREN,AS_NOT: Begin + value := BuildExpression(false,nil); + ConcatConstant(curlist,value,maxvalue); + end; + AS_COMMA: BEGIN + Consume(AS_COMMA); + END; + AS_SEPARATOR: ; - Procedure BuildScaling(Var instr: TInstruction); + else + Begin + Message(asmr_e_syntax_error); + end; + end; { end case } + Until actasmtoken = AS_SEPARATOR; + end; + + + + + + +{**************************************************************************** + Tm68kOperand +****************************************************************************} + +type + TM68kOperand=class(TOperand) + Procedure BuildOperand;override; + private + labeled : boolean; + Procedure BuildReference; + Function BuildRefExpression: longint; + Procedure BuildScaling; + end; + + + Procedure TM68kOperand.BuildScaling; {*********************************************************************} { Takes care of parsing expression starting from the scaling value } { up to and including possible field specifiers. } @@ -1281,8 +1053,8 @@ var code: integer; Begin Consume(AS_STAR); - if (instr.operands[operandnum]^.opr.ref.scalefactor <> 0) - and (instr.operands[operandnum]^.opr.ref.scalefactor <> 1) then + if (opr.ref.scalefactor <> 0) + and (opr.ref.scalefactor <> 1) then Message(asmr_e_wrong_base_index); case actasmtoken of AS_INTNUM: str := actasmpattern; @@ -1297,17 +1069,17 @@ var Message(asmr_e_wrong_scale_factor); if ((l = 2) or (l = 4) or (l = 8) or (l = 1)) and (code = 0) then begin - instr.operands[operandnum]^.opr.ref.scalefactor := l; + opr.ref.scalefactor := l; end else Begin Message(asmr_e_wrong_scale_factor); - instr.operands[operandnum]^.opr.ref.scalefactor := 0; + opr.ref.scalefactor := 0; end; - if instr.operands[operandnum]^.opr.ref.index = R_NO then + if opr.ref.index = R_NO then Begin Message(asmr_e_wrong_base_index); - instr.operands[operandnum]^.opr.ref.scalefactor := 0; + opr.ref.scalefactor := 0; end; { Consume the scaling number } Consume(actasmtoken); @@ -1324,9 +1096,9 @@ var end; - Function BuildRefExpression: longint; + Function TM68kOperand.BuildRefExpression: longint; {*********************************************************************} - { FUNCTION BuildExpression: longint } + { FUNCTION BuildRefExpression: longint } { Description: This routine calculates a constant expression to } { a given value. The return value is the value calculated from } { the expression. } @@ -1457,8 +1229,9 @@ var Until false; end; - - Procedure BuildReference(var Instr: TInstruction); + + + Procedure TM68kOperand.BuildReference; {*********************************************************************} { PROCEDURE BuildBracketExpression } { Description: This routine builds up an expression after a LPAREN } @@ -1477,8 +1250,7 @@ var Case actasmtoken of { // (reg ... // } AS_REGISTER: Begin - instr.operands[operandnum]^.opr.ref.base := - findregister(actasmpattern); + opr.ref.base := findregister(actasmpattern); Consume(AS_REGISTER); { can either be a register or a right parenthesis } { // (reg) // } @@ -1488,10 +1260,10 @@ var Consume(AS_RPAREN); if actasmtoken = AS_PLUS then Begin - if (instr.operands[operandnum]^.opr.ref.direction <> dir_none) then + if (opr.ref.direction <> dir_none) then Message(asmr_e_no_inc_and_dec_together) else - instr.operands[operandnum]^.opr.ref.direction := dir_inc; + opr.ref.direction := dir_inc; Consume(AS_PLUS); end; if not (actasmtoken in [AS_COMMA,AS_SEPARATOR]) then @@ -1507,7 +1279,7 @@ var Consume(AS_COMMA); if actasmtoken = AS_REGISTER then Begin - instr.operands[operandnum]^.opr.ref.index := + opr.ref.index := findregister(actasmpattern); Consume(AS_REGISTER); { check for scaling ... } @@ -1526,7 +1298,7 @@ var end; AS_STAR: Begin - BuildScaling(instr); + BuildScaling; end; else Begin @@ -1546,41 +1318,42 @@ var AS_HEXNUM,AS_OCTALNUM, { direct address } AS_BINNUM,AS_INTNUM: Begin case actasmtoken of - AS_INTNUM: str := actasmpattern; - AS_HEXNUM: str := Tostr(ValHexadecimal(actasmpattern)); - AS_BINNUM: str := Tostr(ValBinary(actasmpattern)); - AS_OCTALNUM: str := Tostr(ValOctal(actasmpattern)); + AS_INTNUM: str := actasmpattern; + AS_HEXNUM: str := Tostr(ValHexadecimal(actasmpattern)); + AS_BINNUM: str := Tostr(ValBinary(actasmpattern)); + AS_OCTALNUM: str := Tostr(ValOctal(actasmpattern)); else - Message(asmr_e_syntax_error); + Message(asmr_e_syntax_error); end; Consume(actasmtoken); val(str, l, code); if code <> 0 then - Message(asmr_e_invalid_reference_syntax) + Message(asmr_e_invalid_reference_syntax) else - instr.operands[operandnum]^.opr.ref.offset := l; + opr.ref.offset := l; Consume(AS_RPAREN); if not (actasmtoken in [AS_COMMA,AS_SEPARATOR]) then Begin - { error recovery ... } - Message(asmr_e_invalid_reference_syntax); - while actasmtoken <> AS_SEPARATOR do - Consume(actasmtoken); + { error recovery ... } + Message(asmr_e_invalid_reference_syntax); + while actasmtoken <> AS_SEPARATOR do + Consume(actasmtoken); end; exit; end; else Begin - Message(asmr_e_invalid_reference_syntax); while (actasmtoken <> AS_SEPARATOR) do Consume(actasmtoken); end; end; { end case } end; + - Procedure BuildOperand(var instr: TInstruction); + + Procedure TM68kOperand.BuildOperand; {*********************************************************************} { EXIT CONDITION: On exit the routine should point to either the } { AS_COMMA or AS_SEPARATOR token. } @@ -1588,10 +1361,10 @@ var var tempstr: string; expr: string; - lab: Pasmlabel; + lab: tasmlabel; l : longint; i: tregister; - hl: pasmlabel; + hl: tasmlabel; reg_one, reg_two: tregister; reglist: set of tregister; Begin @@ -1602,23 +1375,23 @@ var { // Memory reference // } AS_LPAREN: Begin - initAsmRef(instr); - BuildReference(instr); + InitRef; + BuildReference; end; { // Constant expression // } AS_APPT: Begin Consume(AS_APPT); - if not (instr.operands[operandnum]^.opr.typ in [OPR_NONE,OPR_CONSTANT]) then + if not (opr.typ in [OPR_NONE,OPR_CONSTANT]) then Message(asmr_e_invalid_operand_type); { identifiers are handled by BuildExpression } - instr.operands[operandnum]^.opr.typ := OPR_CONSTANT; - instr.operands[operandnum]^.opr.val :=BuildExpression(true,@tempstr); + opr.typ := OPR_CONSTANT; + opr.val :=BuildExpression(true,@tempstr); if tempstr<>'' then begin - l:=instr.operands[operandnum]^.opr.val; - instr.operands[operandnum]^.opr.typ := OPR_SYMBOL; - instr.operands[operandnum]^.opr.symofs := l; - instr.operands[operandnum]^.opr.symbol := objectlibrary.newasmsymbol(tempstr); + l:=opr.val; + opr.typ := OPR_SYMBOL; + opr.symofs := l; + opr.symbol := objectlibrary.newasmsymbol(tempstr); end; end; { // Constant memory offset . // } @@ -1626,33 +1399,34 @@ var AS_HEXNUM,AS_INTNUM, AS_BINNUM,AS_OCTALNUM,AS_PLUS: Begin - InitAsmRef(instr); - instr.operands[operandnum]^.opr.ref.offset:=BuildRefExpression; - BuildReference(instr); + InitRef; + opr.ref.offset:=BuildRefExpression; + BuildReference; end; { // A constant expression, or a Variable ref. // } AS_ID: Begin + InitRef; if actasmpattern[1] = '@' then { // Label or Special symbol reference // } Begin if actasmpattern = '@RESULT' then - Begin - InitAsmRef(instr); - instr.operands[operandnum]^.SetUpResult; - end + SetUpResult + else + if actasmpattern = 'SELF' then + SetUpSelf else - if (actasmpattern = '@CODE') or (actasmpattern = '@DATA') then + if (actasmpattern = '@CODE') or (actasmpattern = '@DATA') then Message(asmr_w_CODE_and_DATA_not_supported) - else + else Begin delete(actasmpattern,1,1); if actasmpattern = '' then Message(asmr_e_null_label_ref_not_allowed); CreateLocalLabel(actasmpattern,lab,false); - instr.operands[operandnum]^.opr.typ := OPR_SYMBOL; - instr.operands[operandnum]^.opr.symbol := lab; - instr.operands[operandnum]^.opr.symofs := 0; - instr.labeled := TRUE; + opr.typ := OPR_SYMBOL; + opr.symbol := lab; + opr.symofs := 0; + labeled := TRUE; end; Consume(AS_ID); if not (actasmtoken in [AS_SEPARATOR,AS_COMMA]) then @@ -1662,98 +1436,71 @@ var { or a procedure (such as in CALL ID) } else Begin - { is it a constant ? } - if SearchIConstant(actasmpattern,l) then + { is it a constant ? } + if SearchIConstant(actasmpattern,l) then + Begin + InitRef; + opr.ref.offset:=BuildRefExpression; + BuildReference; + end + else { is it a label variable ? } Begin - InitAsmRef(instr); - instr.operands[operandnum]^.opr.ref.offset:=BuildRefExpression; - BuildReference(instr); - -{ if not (instr.operands[operandnum].opr.typ in [OPR_NONE,OPR_CONSTANT]) then - Message(asmr_e_invalid_operand_type); - instr.operands[operandnum].opr.typ := OPR_CONSTANT; - instr.operands[operandnum].val :=BuildExpression;} - end - else { is it a label variable ? } - Begin { // ID[ , ID.Field.Field or simple ID // } { check if this is a label, if so then } { emit it as a label. } if SearchLabel(actasmpattern,hl,false) then - Begin - instr.operands[operandnum]^.opr.typ := OPR_SYMBOL; - instr.operands[operandnum]^.opr.symbol := hl; - instr.operands[operandnum]^.opr.symofs := 0; - instr.labeled := TRUE; - Consume(AS_ID); - if not (actasmtoken in [AS_SEPARATOR,AS_COMMA]) then - Message(asmr_e_syntax_error); - end - else - { is it a normal variable ? } - Begin - initAsmRef(instr); - if not instr.operands[operandnum]^.SetUpVar(actasmpattern,false) then - Begin - { not a variable.. } - { check special variables.. } - if actasmpattern = 'SELF' then - { special self variable } - Begin - if assigned(procinfo^._class) then - Begin - instr.operands[operandnum]^.opr.ref.offset := procinfo^.selfpointer_offset; - instr.operands[operandnum]^.opr.ref.base := procinfo^.framepointer; - end - else - Message(asmr_e_cannot_use_SELF_outside_a_method); - end - else - if (cs_compilesystem in aktmoduleswitches) then - Begin - if not assigned(instr.operands[operandnum]^.opr.ref.symbol) then - Begin - if getasmsymbol(actasmpattern) =nil then - Message1(asmr_w_id_supposed_external,actasmpattern); - instr.operands[operandnum]^.opr.ref.symbol:=objectlibrary.newasmsymbol(actasmpattern); - end - else - Message(asmr_e_syntax_error); - end - else - Message1(asmr_e_unknown_label_identifier,actasmpattern); - end; - expr := actasmpattern; - Consume(AS_ID); - case actasmtoken of - AS_LPAREN: { indexing } - BuildReference(instr); - AS_SEPARATOR,AS_COMMA: ; + Begin + opr.typ := OPR_SYMBOL; + opr.symbol := hl; + opr.symofs := 0; + labeled := TRUE; + Consume(AS_ID); + if not (actasmtoken in [AS_SEPARATOR,AS_COMMA]) then + Message(asmr_e_syntax_error); + end else - Message(asmr_e_syntax_error); - end; - end; + { is it a normal variable ? } + if (cs_compilesystem in aktmoduleswitches) then + begin + if not SetupDirectVar(expr) then + Begin + { not found, finally ... add it anyways ... } + Message1(asmr_w_id_supposed_external,expr); + opr.ref.symbol:=objectlibrary.newasmsymbol(expr); + end; + end + else + Message1(sym_e_unknown_id,actasmpattern); + end; + expr := actasmpattern; + Consume(AS_ID); + case actasmtoken of + AS_LPAREN: { indexing } + BuildReference; + AS_SEPARATOR,AS_COMMA: ; + else + Message(asmr_e_syntax_error); end; end; - end; + end; { // Pre-decrement mode reference or constant mem offset. // } AS_MINUS: Begin Consume(AS_MINUS); if actasmtoken = AS_LPAREN then Begin - InitAsmRef(instr); + InitRef; { indicate pre-decrement mode } - instr.operands[operandnum]^.opr.ref.direction := dir_dec; - BuildReference(instr); + opr.ref.direction := dir_dec; + BuildReference; end else if actasmtoken in [AS_OCTALNUM,AS_HEXNUM,AS_BINNUM,AS_INTNUM] then Begin - InitAsmRef(instr); - instr.operands[operandnum]^.opr.ref.offset:=BuildRefExpression; + InitRef; + opr.ref.offset:=BuildRefExpression; { negate because was preceded by a negative sign! } - instr.operands[operandnum]^.opr.ref.offset:=-instr.operands[operandnum]^.opr.ref.offset; - BuildReference(instr); + opr.ref.offset:=-opr.ref.offset; + BuildReference; end else Begin @@ -1770,10 +1517,10 @@ var { // Simple register // } if (actasmtoken = AS_SEPARATOR) or (actasmtoken = AS_COMMA) then Begin - if not (instr.operands[operandnum]^.opr.typ in [OPR_NONE,OPR_REGISTER]) then + if not (opr.typ in [OPR_NONE,OPR_REGISTER]) then Message(asmr_e_invalid_operand_type); - instr.operands[operandnum]^.opr.typ := OPR_REGISTER; - instr.operands[operandnum]^.opr.reg := findregister(tempstr); + opr.typ := OPR_REGISTER; + opr.reg := findregister(tempstr); end else { HERE WE MUST HANDLE THE SPECIAL CASE OF MOVEM AND FMOVEM } @@ -1800,8 +1547,8 @@ var end; end; { end case } end; { end while } - instr.operands[operandnum]^.opr.typ:= OPR_REGLIST; - instr.operands[operandnum]^.opr.reglist := newreglist(reglist); + opr.typ:= OPR_REGLIST; + opr.reglist := reglist; end else { error recovery ... } @@ -1845,8 +1592,8 @@ var Consume(actasmtoken); end; { set up instruction } - instr.operands[operandnum]^.opr.typ:= OPR_REGLIST; - instr.operands[operandnum]^.opr.reglist := newreglist(reglist); + opr.typ:= OPR_REGLIST; + opr.reglist := reglist; end; end else @@ -1859,11 +1606,11 @@ var if (actasmtoken = AS_REGISTER) then Begin { set up old field, since register is valid } - instr.operands[operandnum]^.opr.typ := OPR_REGISTER; - instr.operands[operandnum]^.opr.reg := findregister(tempstr); + opr.typ := OPR_REGISTER; + opr.reg := findregister(tempstr); Inc(operandnum); - instr.operands[operandnum]^.opr.typ := OPR_REGISTER; - instr.operands[operandnum]^.opr.reg := findregister(actasmpattern); + opr.typ := OPR_REGISTER; + opr.reg := findregister(actasmpattern); Consume(AS_REGISTER); if not (actasmtoken in [AS_SEPARATOR,AS_COMMA]) then Begin @@ -1898,77 +1645,6 @@ var - Procedure BuildConstant(maxvalue: longint); - {*********************************************************************} - { PROCEDURE BuildConstant } - { Description: This routine takes care of parsing a DB,DD,or DW } - { line and adding those to the assembler node. Expressions, range- } - { checking are fullly taken care of. } - { maxvalue: $ff -> indicates that this is a DB node. } - { $ffff -> indicates that this is a DW node. } - { $ffffffff -> indicates that this is a DD node. } - {*********************************************************************} - { EXIT CONDITION: On exit the routine should point to AS_SEPARATOR. } - {*********************************************************************} - var - strlength: byte; - expr: string; - tempstr: string; - value : longint; - Begin - Repeat - Case actasmtoken of - AS_STRING: Begin - if maxvalue = $ff then - strlength := 1 - else - Message(asmr_e_string_not_allowed_as_const); - expr := actasmpattern; - if length(expr) > 1 then - Message(asmr_e_string_not_allowed_as_const); - Consume(AS_STRING); - Case actasmtoken of - AS_COMMA: Consume(AS_COMMA); - AS_SEPARATOR: ; - else - Message(asmr_e_invalid_string_expression); - end; { end case } - ConcatString(p,expr); - end; - AS_INTNUM,AS_BINNUM, - AS_OCTALNUM,AS_HEXNUM: - Begin - value:=BuildExpression(false,nil); - ConcatConstant(p,value,maxvalue); - end; - AS_ID: - Begin - value:=BuildExpression(false,nil); - if value > maxvalue then - Begin - Message(asmr_e_constant_out_of_bounds); - { assuming a value of maxvalue } - value := maxvalue; - end; - ConcatConstant(p,value,maxvalue); - end; - { These terms can start an assembler expression } - AS_PLUS,AS_MINUS,AS_LPAREN,AS_NOT: Begin - value := BuildExpression(false,nil); - ConcatConstant(p,value,maxvalue); - end; - AS_COMMA: BEGIN - Consume(AS_COMMA); - END; - AS_SEPARATOR: ; - - else - Begin - Message(asmr_e_syntax_error); - end; - end; { end case } - Until actasmtoken = AS_SEPARATOR; - end; Procedure BuildStringConstant(asciiz: boolean); @@ -1991,7 +1667,7 @@ var expr:=actasmpattern; if asciiz then expr:=expr+#0; - ConcatPasString(p,expr); + ConcatPasString(curlist,expr); Consume(AS_STRING); end; AS_COMMA: BEGIN @@ -2010,9 +1686,28 @@ var end; +{***************************************************************************** + TM68kInstruction +*****************************************************************************} + +type + TM68kInstruction=class(TInstruction) + procedure InitOperands;override; + procedure BuildOpcode;override; + procedure ConcatInstruction(p : taasmoutput);override; + Procedure ConcatLabeledInstr(p : taasmoutput); + end; + + procedure TM68kInstruction.InitOperands; + var + i : longint; + begin + for i:=1to max_operands do + Operands[i]:=TM68kOperand.Create; + end; - Procedure BuildOpCode; + Procedure TM68kInstruction.BuildOpCode; {*********************************************************************} { PROCEDURE BuildOpcode; } { Description: Parses the intel opcode and operands, and writes it } @@ -2022,13 +1717,11 @@ var { On ENTRY: Token should point to AS_OPCODE } {*********************************************************************} var asmtok: tasmop; - op: tasmop; expr: string; - segreg: tregister; + operandnum : longint; Begin expr := ''; asmtok := A_NONE; { assmume no prefix } - segreg := R_NO; { assume no segment override } { // opcode // } { allow for newline as in gas styled syntax } @@ -2045,8 +1738,7 @@ var end else Begin - op := findopcode(actasmpattern); - instr.opcode:=op; + opcode := findopcode(actasmpattern,opsize); Consume(AS_OPCODE); { // Zero operand opcode ? // } if actasmtoken = AS_SEPARATOR then @@ -2069,26 +1761,331 @@ var { // End of asm operands for this opcode // } AS_SEPARATOR: ; else - BuildOperand(instr); + Operands[operandnum].BuildOperand; end; { end case } end; { end while } end; + procedure TM68kInstruction.ConcatInstruction(p : taasmoutput); + var + fits : boolean; + Begin + fits := FALSE; + { setup specific opcodetions for first pass } - Function Assemble: Ptree; + { Setup special operands } + { Convert to general form as to conform to the m68k opcode table } + if (opcode = A_ADDA) or (opcode = A_ADDI) + then opcode := A_ADD + else + { CMPM excluded because of GAS v1.34 BUG } + if (opcode = A_CMPA) or + (opcode = A_CMPI) then + opcode := A_CMP + else + if opcode = A_EORI then + opcode := A_EOR + else + if opcode = A_MOVEA then + opcode := A_MOVE + else + if opcode = A_ORI then + opcode := A_OR + else + if (opcode = A_SUBA) or (opcode = A_SUBI) then + opcode := A_SUB; + + { Setup operand types } + +(* + in opcode <> A_MOVEM then + Begin + + while not(fits) do + begin + { set the opcodetion cache, if the opcodetion } + { occurs the first time } + if (it[i].i=opcode) and (ins_cache[opcode]=-1) then + ins_cache[opcode]:=i; + + if (it[i].i=opcode) and (instr.ops=it[i].ops) then + begin + { first fit } + case instr.ops of + 0 : begin + fits:=true; + break; + end; + 1 : + Begin + if (optyp1 and it[i].o1)<>0 then + Begin + fits:=true; + break; + end; + end; + 2 : if ((optyp1 and it[i].o1)<>0) and + ((optyp2 and it[i].o2)<>0) then + Begin + fits:=true; + break; + end + 3 : if ((optyp1 and it[i].o1)<>0) and + ((optyp2 and it[i].o2)<>0) and + ((optyp3 and it[i].o3)<>0) then + Begin + fits:=true; + break; + end; + end; { end case } + end; { endif } + if it[i].i=A_NONE then + begin + { NO MATCH! } + Message(asmr_e_invalid_combination_opcode_and_operand); + exit; + end; + inc(i); + end; { end while } + *) + fits:=TRUE; + + { We add the opcode to the opcode linked list } + if fits then + Begin + case ops of + 0: + if opsize <> S_NO then + p.concat((taicpu.op_none(opcode,opsize))) + else + p.concat((taicpu.op_none(opcode,S_NO))); + 1: Begin + case operands[1].opr.typ of + OPR_SYMBOL: + Begin + p.concat((taicpu.op_sym_ofs(opcode, + opsize, operands[1].opr.symbol,operands[1].opr.symofs))); + end; + OPR_CONSTANT: + Begin + p.concat((taicpu.op_const(opcode, + opsize, operands[1].opr.val))); + end; + OPR_REGISTER: + p.concat((taicpu.op_reg(opcode,opsize,operands[1].opr.reg))); + OPR_REFERENCE: + if opsize <> S_NO then + Begin + p.concat((taicpu.op_ref(opcode, + opsize,operands[1].opr.ref))); + end + else + Begin + { special jmp and call case with } + { symbolic references. } + if opcode in [A_BSR,A_JMP,A_JSR,A_BRA,A_PEA] then + Begin + p.concat((taicpu.op_ref(opcode, + S_NO,operands[1].opr.ref))); + end + else + Message(asmr_e_invalid_opcode_and_operand); + end; + OPR_NONE: + Message(asmr_e_invalid_opcode_and_operand); + else + Begin + Message(asmr_e_invalid_opcode_and_operand); + end; + end; + end; + 2: Begin + { source } + case operands[1].opr.typ of + { reg,reg } + { reg,ref } + OPR_REGISTER: + Begin + case operands[2].opr.typ of + OPR_REGISTER: + Begin + p.concat((taicpu.op_reg_reg(opcode, + opsize,operands[1].opr.reg,operands[2].opr.reg))); + end; + OPR_REFERENCE: + p.concat((taicpu.op_reg_ref(opcode, + opsize,operands[1].opr.reg,operands[2].opr.ref))); + else { else case } + Begin + Message(asmr_e_invalid_opcode_and_operand); + end; + end; { end second operand case for OPR_REGISTER } + end; + { reglist, ref } + OPR_REGLIST: + Begin + case operands[2].opr.typ of + OPR_REFERENCE : + p.concat((taicpu.op_reglist_ref(opcode, + opsize,operands[1].opr.reglist,operands[2].opr.ref))); + else + Begin + Message(asmr_e_invalid_opcode_and_operand); + end; + end; { end second operand case for OPR_REGLIST } + end; + + { const,reg } + { const,const } + { const,ref } + OPR_CONSTANT: + case operands[2].opr.typ of + { constant, constant does not have a specific size. } + OPR_CONSTANT: + p.concat((taicpu.op_const_const(opcode, + S_NO,operands[1].opr.val,operands[2].opr.val))); + OPR_REFERENCE: + Begin + p.concat((taicpu.op_const_ref(opcode, + opsize,operands[1].opr.val, + operands[2].opr.ref))) + end; + OPR_REGISTER: + Begin + p.concat((taicpu.op_const_reg(opcode, + opsize,operands[1].opr.val, + operands[2].opr.reg))) + end; + else + Begin + Message(asmr_e_invalid_opcode_and_operand); + end; + end; { end second operand case for OPR_CONSTANT } + { ref,reg } + { ref,ref } + OPR_REFERENCE: + case operands[2].opr.typ of + OPR_REGISTER: + Begin + p.concat((taicpu.op_ref_reg(opcode, + opsize,operands[1].opr.ref, + operands[2].opr.reg))); + end; + OPR_REGLIST: + Begin + p.concat((taicpu.op_ref_reglist(opcode, + opsize,operands[1].opr.ref, + operands[2].opr.reglist))); + end; + OPR_REFERENCE: { special opcodes } + p.concat((taicpu.op_ref_ref(opcode, + opsize,operands[1].opr.ref, + operands[2].opr.ref))); + else + Begin + Message(asmr_e_invalid_opcode_and_operand); + end; + end; { end second operand case for OPR_REFERENCE } + OPR_SYMBOL: case operands[2].opr.typ of + OPR_REFERENCE: + Begin + p.concat((taicpu.op_sym_ofs_ref(opcode, + opsize,operands[1].opr.symbol,operands[1].opr.symofs, + operands[2].opr.ref))) + end; + OPR_REGISTER: + Begin + p.concat((taicpu.op_sym_ofs_reg(opcode, + opsize,operands[1].opr.symbol,operands[1].opr.symofs, + operands[2].opr.reg))) + end; + else + Begin + Message(asmr_e_invalid_opcode_and_operand); + end; + end; { end second operand case for OPR_SYMBOL } + else + Begin + Message(asmr_e_invalid_opcode_and_operand); + end; + end; { end first operand case } + end; + 3: Begin + if (opcode = A_DIVSL) or (opcode = A_DIVUL) or (opcode = A_MULU) + or (opcode = A_MULS) or (opcode = A_DIVS) or (opcode = A_DIVU) then + Begin + if (operands[1].opr.typ <> OPR_REGISTER) + or (operands[2].opr.typ <> OPR_REGISTER) + or (operands[3].opr.typ <> OPR_REGISTER) then + Begin + Message(asmr_e_invalid_opcode_and_operand); + end + else + Begin + p.concat((taicpu. op_reg_reg_reg(opcode,opsize, + operands[1].opr.reg,operands[2].opr.reg,operands[3].opr.reg))); + end; + end + else + Message(asmr_e_invalid_opcode_and_operand); + end; + end; { end case } + end; + end; + + + Procedure TM68kInstruction.ConcatLabeledInstr(p : taasmoutput); + Begin + if ((opcode >= A_BCC) and (opcode <= A_BVS)) + or (opcode = A_BRA) or (opcode = A_BSR) + or (opcode = A_JMP) or (opcode = A_JSR) + or ((opcode >= A_FBEQ) and (opcode <= A_FBNGLE)) + then + Begin + if ops > 2 then + Message(asmr_e_invalid_opcode_and_operand) + else if operands[1].opr.typ <> OPR_SYMBOL then + Message(asmr_e_invalid_opcode_and_operand) + else if (operands[1].opr.typ = OPR_SYMBOL) and + (ops = 1) then + if assigned(operands[1].opr.symbol) and + (operands[1].opr.symofs=0) then + p.concat(taicpu.op_sym(opcode,S_NO, + operands[1].opr.symbol)) + else + Message(asmr_e_invalid_opcode_and_operand); + end + else + if ((opcode >= A_DBCC) and (opcode <= A_DBF)) + or ((opcode >= A_FDBEQ) and (opcode <= A_FBDNGLE)) then + begin + if (ops<>2) or + (operands[1].opr.typ <> OPR_REGISTER) or + (operands[2].opr.typ <> OPR_SYMBOL) or + (operands[2].opr.symofs <> 0) then + Message(asmr_e_invalid_opcode_and_operand) + else + p.concat(taicpu.op_reg_sym(opcode,opsize,operands[1].opr.reg, + operands[2].opr.symbol)); + end + else + Message(asmr_e_invalid_opcode_and_operand); + end; + + + Function Assemble: tnode; {*********************************************************************} { PROCEDURE Assemble; } { Description: Parses the att assembler syntax, parsing is done } { according to GAs rules. } {*********************************************************************} Var - hl: pasmlabel; - labelptr,nextlabel : pasmlabel; + hl: tasmlabel; + labelptr,nextlabel : tasmlabel; commname : string; - store_p : paasmoutput; - + instr : TM68kInstruction; Begin Message(asmr_d_start_reading); firsttoken := TRUE; @@ -2099,12 +2096,10 @@ var SetupTables; _asmsorted := TRUE; end; - p:=new(paasmoutput,init); - { save pointer code section } - store_p:=p; + curlist:=TAAsmoutput.Create; { setup label linked list } - new(LocalLabelList,Init); - c:=current_scanner^.asmgetchar; + LocalLabelList:=TLocalLabelList.Create; + c:=current_scanner.asmgetchar; actasmtoken:=gettoken; while actasmtoken<>AS_END do Begin @@ -2112,14 +2107,14 @@ var AS_LLABEL: Begin if CreateLocalLabel(actasmpattern,hl,true) then - ConcatLabel(p,hl); + ConcatLabel(curlist,hl); Consume(AS_LLABEL); end; AS_LABEL: Begin { when looking for Pascal labels, these must } { be in uppercase. } if SearchLabel(upper(actasmpattern),hl,true) then - ConcatLabel(p,hl) + ConcatLabel(curlist,hl) else Begin Message1(asmr_e_unknown_label_identifier,actasmpattern); @@ -2150,7 +2145,7 @@ var if actasmtoken <> AS_ID then Message(asmr_e_invalid_global_def) else - ConcatPublic(p,actasmpattern); + ConcatPublic(curlist,actasmpattern); Consume(actasmtoken); if actasmtoken <> AS_SEPARATOR then Begin @@ -2172,6 +2167,17 @@ var Consume(actasmtoken); end; AS_OPCODE: Begin + instr:=TM68kInstruction.Create; + instr.BuildOpcode; +{ instr.AddReferenceSizes;} +{ instr.SetInstructionOpsize;} +{ instr.CheckOperandSizes;} + if instr.labeled then + instr.ConcatLabeledInstr(curlist) + else + instr.ConcatInstruction(curlist); + instr.Free; +{ instr.init; BuildOpcode; instr.ops := operandnum; @@ -2179,7 +2185,7 @@ var ConcatLabeledInstr(instr) else ConcatOpCode(instr); - instr.done; + instr.done;} end; AS_SEPARATOR:Begin Consume(AS_SEPARATOR); @@ -2196,10 +2202,11 @@ var end; { end case } end; { end while } { Check LocalLabelList } - LocalLabelList^.CheckEmitted; - dispose(LocalLabelList,Done); + LocalLabelList.CheckEmitted; + LocalLabelList.Free; - assemble := genasmnode(p); + { Return the list in an asmnode } + assemble:=casmnode.create(curlist); Message(asmr_d_finish_reading); end; @@ -2218,7 +2225,13 @@ Begin end. { $Log$ - Revision 1.4 2002-08-12 15:08:44 carl + Revision 1.5 2002-08-13 18:01:52 carl + * rename swatoperands to swapoperands + + m68k first compilable version (still needs a lot of testing): + assembler generator, system information , inline + assembler reader. + + Revision 1.4 2002/08/12 15:08:44 carl + stab register indexes for powerpc (moved from gdb to cpubase) + tprocessor enumeration moved to cpuinfo + linker in target_info is now a class diff --git a/compiler/ncgcal.pas b/compiler/ncgcal.pas index 68fe5402fc..3585079253 100644 --- a/compiler/ncgcal.pas +++ b/compiler/ncgcal.pas @@ -63,7 +63,7 @@ implementation cginfo,cgbase,pass_2, cpuinfo,cpubase,aasmbase,aasmtai,aasmcpu, nmem,nld,ncnv, - ncgutil,cga,cgobj,tgobj,regvars,rgobj,rgcpu,cg64f32,cgcpu; + ncgutil,cgobj,tgobj,regvars,rgobj,rgcpu,cg64f32,cgcpu; {***************************************************************************** TCGCALLPARANODE @@ -1502,7 +1502,13 @@ begin end. { $Log$ - Revision 1.7 2002-08-12 15:08:39 carl + Revision 1.8 2002-08-13 18:01:51 carl + * rename swatoperands to swapoperands + + m68k first compilable version (still needs a lot of testing): + assembler generator, system information , inline + assembler reader. + + Revision 1.7 2002/08/12 15:08:39 carl + stab register indexes for powerpc (moved from gdb to cpubase) + tprocessor enumeration moved to cpuinfo + linker in target_info is now a class diff --git a/compiler/ncgcnv.pas b/compiler/ncgcnv.pas index 3ed865f62a..fa0a0d40e0 100644 --- a/compiler/ncgcnv.pas +++ b/compiler/ncgcnv.pas @@ -111,7 +111,7 @@ interface st_shortstring : begin inc(left.location.reference.offset); - location.register:=rg.getregisterint(exprasmlist); + location.register:=rg.getaddressregister(exprasmlist); cg.a_loadaddr_ref_reg(exprasmlist,left.location.reference,location.register); end; st_ansistring : @@ -121,12 +121,12 @@ interface begin reference_reset(hr); hr.symbol:=objectlibrary.newasmsymbol('FPC_EMPTYCHAR'); - location.register:=rg.getregisterint(exprasmlist); + location.register:=rg.getaddressregister(exprasmlist); cg.a_loadaddr_ref_reg(exprasmlist,hr,location.register); end else begin - location.register:=rg.getregisterint(exprasmlist); + location.register:=rg.getaddressregister(exprasmlist); cg.a_load_ref_reg(exprasmlist,OS_ADDR,left.location.reference,location.register); end; end; @@ -142,7 +142,7 @@ interface begin reference_reset(hr); hr.symbol:=objectlibrary.newasmsymbol('FPC_EMPTYCHAR'); - location.register:=rg.getregisterint(exprasmlist); + location.register:=rg.getaddressregister(exprasmlist); cg.a_loadaddr_ref_reg(exprasmlist,hr,location.register); end else @@ -185,7 +185,7 @@ interface begin location_release(exprasmlist,left.location); location_reset(location,LOC_REGISTER,OS_ADDR); - location.register:=rg.getregisterint(exprasmlist); + location.register:=rg.getaddressregister(exprasmlist); cg.a_loadaddr_ref_reg(exprasmlist,left.location.reference,location.register); end; @@ -196,7 +196,17 @@ interface location_reset(location,LOC_REFERENCE,OS_NO); case left.location.loc of LOC_REGISTER : - location.reference.base:=left.location.register; + begin + if not rg.isaddressregister(left.location.register) then + begin + location_release(exprasmlist,left.location); + location.reference.base:=rg.getaddressregister(exprasmlist); + cg.a_load_reg_reg(exprasmlist,OS_ADDR, + left.location.register,location.reference.base); + end + else + location.reference.base := left.location.register; + end; LOC_CREGISTER : begin location.reference.base:=rg.getregisterint(exprasmlist); @@ -207,7 +217,7 @@ interface LOC_CREFERENCE : begin location_release(exprasmlist,left.location); - location.reference.base:=rg.getregisterint(exprasmlist); + location.reference.base:=rg.getaddressregister(exprasmlist); cg.a_load_ref_reg(exprasmlist,OS_ADDR,left.location.reference, location.reference.base); end; @@ -279,7 +289,7 @@ interface begin location_release(exprasmlist,left.location); location_reset(location,LOC_REGISTER,OS_ADDR); - location.register:=rg.getregisterint(exprasmlist); + location.register:=rg.getaddressregister(exprasmlist); cg.a_loadaddr_ref_reg(exprasmlist,left.location.reference,location.register); end; end; @@ -332,11 +342,21 @@ interface objectlibrary.getlabel(l1); case left.location.loc of LOC_CREGISTER,LOC_REGISTER: - location.register:=left.location.register; + begin + if not rg.isaddressregister(left.location.register) then + begin + location_release(exprasmlist,left.location); + location.register:=rg.getaddressregister(exprasmlist); + cg.a_load_reg_reg(exprasmlist,OS_ADDR, + left.location.register,location.register); + end + else + location.register := left.location.register; + end; LOC_CREFERENCE,LOC_REFERENCE: begin location_release(exprasmlist,left.location); - location.register:=rg.getregisterint(exprasmlist); + location.register:=rg.getaddressregister(exprasmlist); cg.a_load_ref_reg(exprasmlist,OS_32,left.location.reference,location.register); end; else @@ -503,7 +523,13 @@ end. { $Log$ - Revision 1.24 2002-08-12 20:39:17 florian + Revision 1.25 2002-08-13 18:01:52 carl + * rename swatoperands to swapoperands + + m68k first compilable version (still needs a lot of testing): + assembler generator, system information , inline + assembler reader. + + Revision 1.24 2002/08/12 20:39:17 florian * casting of classes to interface fixed when the interface was implemented by a parent class diff --git a/compiler/ncgflw.pas b/compiler/ncgflw.pas index 5c2025a9dd..47bd9883c1 100644 --- a/compiler/ncgflw.pas +++ b/compiler/ncgflw.pas @@ -94,7 +94,6 @@ implementation cpubase,cpuinfo, nld,ncon, ncgutil, - cga, tgobj,rgobj,paramgr, regvars,cgobj,cgcpu,cg64f32; @@ -1226,7 +1225,13 @@ begin end. { $Log$ - Revision 1.34 2002-08-11 14:32:26 peter + Revision 1.35 2002-08-13 18:01:52 carl + * rename swatoperands to swapoperands + + m68k first compilable version (still needs a lot of testing): + assembler generator, system information , inline + assembler reader. + + Revision 1.34 2002/08/11 14:32:26 peter * renamed current_library to objectlibrary Revision 1.33 2002/08/11 13:24:11 peter diff --git a/compiler/ncginl.pas b/compiler/ncginl.pas index c6e5c220c1..d44d984cee 100644 --- a/compiler/ncginl.pas +++ b/compiler/ncginl.pas @@ -32,7 +32,6 @@ interface type tcginlinenode = class(tinlinenode) procedure pass_2;override; - procedure second_assigned;virtual; abstract; procedure second_assert;virtual; procedure second_sizeoftypeof;virtual; procedure second_length;virtual; @@ -60,7 +59,7 @@ implementation cginfo,cgbase,pass_1,pass_2, cpubase,paramgr, nbas,ncon,ncal,ncnv,nld, - cga,tgobj,ncgutil,cgobj,cg64f32,rgobj,rgcpu; + tgobj,ncgutil,cgobj,cg64f32,rgobj,rgcpu; {***************************************************************************** @@ -105,10 +104,6 @@ implementation begin second_TypeInfo; end; - in_assigned_x : - begin - second_Assigned; - end; in_include_x_y, in_exclude_x_y: begin @@ -410,38 +405,6 @@ implementation end; -{***************************************************************************** - ASSIGNED GENERIC HANDLING -*****************************************************************************} -(* - procedure tcginlinenode.second_Assigned; - var - hreg : tregister; - ptrvalidlabel : tasmlabel; - begin - secondpass(tcallparanode(left).left); - location_release(exprasmlist,tcallparanode(left).left.location); - hreg := rg.getregisterint(exprasmlist); - if (tcallparanode(left).left.location.loc in [LOC_REGISTER,LOC_CREGISTER]) then - begin - { if pointer is non-nil, and is in register, this directly the value we can use } - cg.a_load_reg_reg(exprasmlist, OS_ADDR, tcallparanode(left).left.location.register, hreg); - end - else - begin - objectlibrary.getlabel(ptrvalidlabel); - cg.a_load_const_reg(exprasmlist, OS_INT, 1, hreg); - cg.a_cmp_const_ref_label(exprasmlist, OS_ADDR, OC_NE, 0, - tcallparanode(left).left.location.reference, ptrvalidlabel); - cg.a_load_const_reg(exprasmlist, OS_INT, 0, hreg); - cg.a_label(exprasmlist,ptrvalidlabel); - end; - location.register := hreg; - location_reset(location,LOC_REGISTER,OS_INT); - WriteLn('Exiting assigned node!'); - end; - -*) {***************************************************************************** INCLUDE/EXCLUDE GENERIC HANDLING *****************************************************************************} @@ -641,7 +604,13 @@ end. { $Log$ - Revision 1.12 2002-08-11 14:32:26 peter + Revision 1.13 2002-08-13 18:01:52 carl + * rename swatoperands to swapoperands + + m68k first compilable version (still needs a lot of testing): + assembler generator, system information , inline + assembler reader. + + Revision 1.12 2002/08/11 14:32:26 peter * renamed current_library to objectlibrary Revision 1.11 2002/08/11 13:24:11 peter diff --git a/compiler/ncgset.pas b/compiler/ncgset.pas index 0aeae0020b..8cfecfdc22 100644 --- a/compiler/ncgset.pas +++ b/compiler/ncgset.pas @@ -85,7 +85,7 @@ implementation paramgr, pass_2, ncon, - cga,tgobj,ncgutil,regvars,rgobj; + tgobj,ncgutil,regvars,rgobj; {***************************************************************************** @@ -956,7 +956,13 @@ begin end. { $Log$ - Revision 1.16 2002-08-11 14:32:27 peter + Revision 1.17 2002-08-13 18:01:52 carl + * rename swatoperands to swapoperands + + m68k first compilable version (still needs a lot of testing): + assembler generator, system information , inline + assembler reader. + + Revision 1.16 2002/08/11 14:32:27 peter * renamed current_library to objectlibrary Revision 1.15 2002/08/11 13:24:12 peter diff --git a/compiler/psystem.pas b/compiler/psystem.pas index b2ab2249d0..b3cf9bbf46 100644 --- a/compiler/psystem.pas +++ b/compiler/psystem.pas @@ -40,7 +40,7 @@ implementation uses globals, symconst,symtype,symsym,symdef,symtable, - ninl; + ninl,globtype; procedure insertinternsyms(p : tsymtable); { @@ -294,7 +294,7 @@ begin if (cs_fp_emulation in aktmoduleswitches) then begin s64floattype.setdef(tfloatdef.create(s32real)); - s80floattype.setdef(tfloatdef.create(s32real))) + s80floattype.setdef(tfloatdef.create(s32real)); end else begin @@ -315,7 +315,13 @@ end; end. { $Log$ - Revision 1.33 2002-08-11 15:28:00 florian + Revision 1.34 2002-08-13 18:01:52 carl + * rename swatoperands to swapoperands + + m68k first compilable version (still needs a lot of testing): + assembler generator, system information , inline + assembler reader. + + Revision 1.33 2002/08/11 15:28:00 florian + support of explicit type case ->pointer (delphi mode only) diff --git a/compiler/rautils.pas b/compiler/rautils.pas index 36236e9e42..5961e5109b 100644 --- a/compiler/rautils.pas +++ b/compiler/rautils.pas @@ -79,7 +79,7 @@ type OPR_REFERENCE : (ref:treference); OPR_REGISTER : (reg:tregister); {$ifdef m68k} - OPR_REGLIST : (reglist:pregisterlist); + OPR_REGLIST : (reglist:tregisterlist); {$else not m68k} OPR_REGLIST : (); {$endif m68k} @@ -115,7 +115,7 @@ type Procedure InitOperands;virtual; Procedure BuildOpcode;virtual; procedure ConcatInstruction(p:TAAsmoutput);virtual; - Procedure Swatoperands; + Procedure Swapoperands; end; @@ -1080,7 +1080,7 @@ begin end; -Procedure TInstruction.Swatoperands; +Procedure TInstruction.Swapoperands; Var p : toperand; Begin @@ -1592,7 +1592,13 @@ end; end. { $Log$ - Revision 1.41 2002-08-12 15:08:40 carl + Revision 1.42 2002-08-13 18:01:52 carl + * rename swatoperands to swapoperands + + m68k first compilable version (still needs a lot of testing): + assembler generator, system information , inline + assembler reader. + + Revision 1.41 2002/08/12 15:08:40 carl + stab register indexes for powerpc (moved from gdb to cpubase) + tprocessor enumeration moved to cpuinfo + linker in target_info is now a class diff --git a/compiler/scandir.pas b/compiler/scandir.pas index 1c9ff6c52f..f985cce5f3 100644 --- a/compiler/scandir.pas +++ b/compiler/scandir.pas @@ -158,22 +158,22 @@ implementation {$ifdef m68k} procedure dir_appid; begin - if system_info.target<>system_m68k_palmos then + if target_info.system<>system_m68k_palmos then Message(scan_w_appid_not_support); { change description global var in all cases } { it not used but in win32 and os2 } - current_scanner^.skipspace; - palmos_applicationid:=current_scanner^.readcomment; + current_scanner.skipspace; + palmos_applicationid:=current_scanner.readcomment; end; procedure dir_appname; begin - if system_info.target<>system_m68k_palmos then + if target_info.system<>system_m68k_palmos then Message(scan_w_appname_not_support); { change description global var in all cases } { it not used but in win32 and os2 } - current_scanner^.skipspace; - palmos_applicationname:=current_scanner^.readcomment; + current_scanner.skipspace; + palmos_applicationname:=current_scanner.readcomment; end; {$endif m68k} @@ -948,7 +948,13 @@ implementation end. { $Log$ - Revision 1.18 2002-07-26 21:15:42 florian + Revision 1.19 2002-08-13 18:01:52 carl + * rename swatoperands to swapoperands + + m68k first compilable version (still needs a lot of testing): + assembler generator, system information , inline + assembler reader. + + Revision 1.18 2002/07/26 21:15:42 florian * rewrote the system handling Revision 1.17 2002/07/20 17:16:03 florian diff --git a/compiler/x86_64/aasmcpu.pas b/compiler/x86_64/aasmcpu.pas index b79da2dc83..77815e1635 100644 --- a/compiler/x86_64/aasmcpu.pas +++ b/compiler/x86_64/aasmcpu.pas @@ -196,7 +196,7 @@ interface function calcsize(p:PInsEntry):longint; procedure gencode(sec:TAsmObjectData); function NeedAddrPrefix(opidx:byte):boolean; - procedure Swatoperands; + procedure Swapoperands; {$endif NOAG386BIN} end; @@ -652,7 +652,7 @@ implementation end; - procedure taicpu.Swatoperands; + procedure taicpu.Swapoperands; var p : TOper; begin @@ -678,7 +678,7 @@ implementation begin if FOperandOrder<>order then begin - Swatoperands; + Swapoperands; FOperandOrder:=order; end; end; @@ -1799,7 +1799,13 @@ implementation end. { $Log$ - Revision 1.2 2002-07-25 22:55:33 florian + Revision 1.3 2002-08-13 18:01:53 carl + * rename swatoperands to swapoperands + + m68k first compilable version (still needs a lot of testing): + assembler generator, system information , inline + assembler reader. + + Revision 1.2 2002/07/25 22:55:33 florian * several fixes, small test units can be compiled Revision 1.1 2002/07/24 22:38:15 florian