From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: by sourceware.org (Postfix, from userid 1499) id 2D5A13858410; Tue, 16 Nov 2021 23:22:27 +0000 (GMT) DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org 2D5A13858410 Content-Type: text/plain; charset="us-ascii" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit From: Gaius Mulley To: gcc-cvs@gcc.gnu.org Subject: [gcc/devel/modula-2] Generate scope headings prior to emitting error messages. X-Act-Checkin: gcc X-Git-Author: Gaius Mulley X-Git-Refname: refs/heads/devel/modula-2 X-Git-Oldrev: 416ca65d27c7067e0d8230f96d4157ce135ece59 X-Git-Newrev: e61ec3e2739ffae1f0a992ad6e14eb039e9e4fe5 Message-Id: <20211116232227.2D5A13858410@sourceware.org> Date: Tue, 16 Nov 2021 23:22:27 +0000 (GMT) X-BeenThere: gcc-cvs@gcc.gnu.org X-Mailman-Version: 2.1.29 Precedence: list List-Id: Gcc-cvs mailing list List-Unsubscribe: , List-Archive: List-Help: List-Subscribe: , X-List-Received-Date: Tue, 16 Nov 2021 23:22:27 -0000 https://gcc.gnu.org/g:e61ec3e2739ffae1f0a992ad6e14eb039e9e4fe5 commit e61ec3e2739ffae1f0a992ad6e14eb039e9e4fe5 Author: Gaius Mulley Date: Tue Nov 16 23:19:23 2021 +0000 Generate scope headings prior to emitting error messages. 2021-11-16 Gaius Mulley ChangeLog: * Makefile.in : Rebuilt. * configure : Rebuilt. gcc/m2/ChangeLog: * gm2-compiler/M2Error.def (NameKey): Imported identifier Name. (AnnounceScope) defined and exported. (EnterDefinitionScope) defined and exported. (EnterImplementationScope) defined and exported. (EnterProcedureScope) defined and exported. (EnterProgramScope) defined and exported. (EnterModuleScope) defined exported. (LeaveScope) defined and exported. (DepthScope) defined and exported. * gm2-compiler/M2Error.mod (M2Debug): Import Assert. (M2StackWord) Import StackOfWord, InitStackWord, InitStackWord, NoOfItemsInStackWord, PopWord, and PushWord. (M2ColorString) Import quoteOpen and quoteClose. (M2Error) Added scopeKind. (ScopeBlock) Added scopeName and kindScope. (New) Reformatted. (SetScope) New procedure. (AddToRange) call InitScopeBlock. (GetGlobalQuads) Rewritten to call SetScope whether a new error scope occurs. Ensure that scope starts when a new file starts and ends. (GetProcQuads) Rewritten to start and end error scope when procedure or module starts or ends. (DisplayScope) rewritten to display the error scope. (InitScopeBlock) initialize kindScope to unsetscope. (KillScopeBlock) Reformatted. (ForeachScopeBlockDo) call enter and leave for every scope. (enter) New procedure. (leave) New procedure. * gm2-compiler/Output.mod (WriteKey) assign buffer to result of ConCat. (StartBuffer) fixbug call InitString with an empty string. gm2-compiler/P0SymBuild.mod (M2Error): Imported. (RegisterProgramModule) call EnterProgramModule. (RegisterImplementationModule) call EnterImplementationScope. (RegisterInnerModule) call EnterModuleScope. (RegisterProcedure) call EnterProcedureScope. (EndModule) call LeaveScope. * gm2-compiler/P2SymBuild.mod (P2StartBuildDefModule) call EnterDefinitionScope. (P2EndBuildDefModule) call LeaveScope. (P2StartBuildImplementationModule) call EnterImplementationScope. (P2StartBuildProgramModule) call EnterProgramScope. (P2EndBuildProgramModule) call LeaveScope. (StartBuildInnerModule) call EnterModuleScope. (EndBuildInnerModule) call LeaveScope. (StartBuildProcedure) call EnterProcedureScope. (EndBuildProcedure) call LeaveScope. * gm2-compiler/P3SymBuild.mod (P3StartBuildDefModule) call EnterDefinitionScope. (P3EndBuildDefModule) call LeaveScope. (P3EndBuildImpModule) call LeaveScope. (P3StartBuildProgModule) call EnterProgramScope. (P3EndBuildProgModule) call LeaveScope. (StartBuildInnerModule) call EnterModuleScope. (EndBuildInnerModule) call LeaveScope. (StartBuildProcedure) call EnterProcedureScope. (EndBuildProcedure) call LeaveScope. (PCStartBuildDefModule) call EnterDefinitionScope. (PCEndBuildDefModule) call LeaveScope. (PCStartBuildImpModule) call EnterImplementationScope. (PCEndBuildImpModule) call LeaveScope. (PCStartBuildProgModule) call EnterProgramScope. (PCEndBuildProgModule) call LeaveScope. (PCStartBuildInnerModule) call EnterModuleScope. (PCEndBuildInnerModule) call LeaveScope. (PCStartBuildProcedure) call EnterProcedureScope. (PCEndBuildProcedure) call LeaveScope. * gm2-compiler/SymbolTable.def (GetDeclaredDefinition) exported. (GetDeclaredModule) exported. Signed-off-by: Gaius Mulley Diff: --- Makefile.in | 56 +++++++++ configure | 2 + gcc/gdbinit.in | 8 ++ gcc/m2/gm2-compiler/M2Error.def | 68 +++++++++- gcc/m2/gm2-compiler/M2Error.mod | 182 ++++++++++++++++++++++++--- gcc/m2/gm2-compiler/M2GCCDeclare.mod | 70 +++++++++-- gcc/m2/gm2-compiler/M2GenGCC.mod | 61 +++++---- gcc/m2/gm2-compiler/M2MetaError.mod | 112 ++++++++++++++++- gcc/m2/gm2-compiler/M2Quads.mod | 12 +- gcc/m2/gm2-compiler/M2SSA.mod | 3 +- gcc/m2/gm2-compiler/M2Scope.mod | 233 ++++++++++++++++++++++++++--------- gcc/m2/gm2-compiler/Output.mod | 4 +- gcc/m2/gm2-compiler/P0SymBuild.mod | 22 ++-- gcc/m2/gm2-compiler/P2SymBuild.mod | 31 +++-- gcc/m2/gm2-compiler/P3SymBuild.mod | 59 +++++---- gcc/m2/gm2-compiler/PCSymBuild.mod | 32 +++-- gcc/m2/gm2-compiler/SymbolTable.def | 17 +++ gm2tools/Makefile.in | 2 +- 18 files changed, 792 insertions(+), 182 deletions(-) diff --git a/Makefile.in b/Makefile.in index d45974c231b..791a584534e 100644 --- a/Makefile.in +++ b/Makefile.in @@ -1903,6 +1903,7 @@ install-dvi-host: maybe-install-dvi-c++tools install-dvi-host: maybe-install-dvi-gnattools install-dvi-host: maybe-install-dvi-lto-plugin install-dvi-host: maybe-install-dvi-libcc1 +install-dvi-host: maybe-install-dvi-gm2tools install-dvi-host: maybe-install-dvi-gotools install-dvi-host: maybe-install-dvi-libctf @@ -1928,6 +1929,7 @@ install-dvi-target: maybe-install-dvi-target-libffi install-dvi-target: maybe-install-dvi-target-zlib install-dvi-target: maybe-install-dvi-target-rda install-dvi-target: maybe-install-dvi-target-libada +install-dvi-target: maybe-install-dvi-target-libgm2 install-dvi-target: maybe-install-dvi-target-libgomp install-dvi-target: maybe-install-dvi-target-libitm install-dvi-target: maybe-install-dvi-target-libatomic @@ -42200,6 +42202,33 @@ install-info-gm2tools: \ @endif gm2tools +.PHONY: maybe-install-dvi-gm2tools install-dvi-gm2tools +maybe-install-dvi-gm2tools: +@if gm2tools +maybe-install-dvi-gm2tools: install-dvi-gm2tools + +install-dvi-gm2tools: \ + configure-gm2tools \ + dvi-gm2tools + @: $(MAKE); $(unstage) + @[ -f ./gm2tools/Makefile ] || exit 0; \ + r=`${PWD_COMMAND}`; export r; \ + s=`cd $(srcdir); ${PWD_COMMAND}`; export s; \ + $(HOST_EXPORTS) \ + for flag in $(EXTRA_HOST_FLAGS) ; do \ + eval `echo "$$flag" | sed -e "s|^\([^=]*\)=\(.*\)|\1='\2'; export \1|"`; \ + done; \ + echo "Doing install-dvi in gm2tools"; \ + (cd $(HOST_SUBDIR)/gm2tools && \ + $(MAKE) $(BASE_FLAGS_TO_PASS) "AR=$${AR}" "AS=$${AS}" \ + "CC=$${CC}" "CXX=$${CXX}" "LD=$${LD}" "NM=$${NM}" \ + "RANLIB=$${RANLIB}" \ + "DLLTOOL=$${DLLTOOL}" "WINDRES=$${WINDRES}" "WINDMC=$${WINDMC}" \ + install-dvi) \ + || exit 1 + +@endif gm2tools + .PHONY: maybe-install-pdf-gm2tools install-pdf-gm2tools maybe-install-pdf-gm2tools: @if gm2tools @@ -56960,6 +56989,33 @@ install-info-target-libgm2: \ @endif target-libgm2 +.PHONY: maybe-install-dvi-target-libgm2 install-dvi-target-libgm2 +maybe-install-dvi-target-libgm2: +@if target-libgm2 +maybe-install-dvi-target-libgm2: install-dvi-target-libgm2 + +install-dvi-target-libgm2: \ + configure-target-libgm2 \ + dvi-target-libgm2 + @: $(MAKE); $(unstage) + @[ -f $(TARGET_SUBDIR)/libgm2/Makefile ] || exit 0; \ + r=`${PWD_COMMAND}`; export r; \ + s=`cd $(srcdir); ${PWD_COMMAND}`; export s; \ + $(NORMAL_TARGET_EXPORTS) \ + echo "Doing install-dvi in $(TARGET_SUBDIR)/libgm2"; \ + for flag in $(EXTRA_TARGET_FLAGS); do \ + eval `echo "$$flag" | sed -e "s|^\([^=]*\)=\(.*\)|\1='\2'; export \1|"`; \ + done; \ + (cd $(TARGET_SUBDIR)/libgm2 && \ + $(MAKE) $(BASE_FLAGS_TO_PASS) "AR=$${AR}" "AS=$${AS}" \ + "CC=$${CC}" "CXX=$${CXX}" "LD=$${LD}" "NM=$${NM}" \ + "RANLIB=$${RANLIB}" \ + "DLLTOOL=$${DLLTOOL}" "WINDRES=$${WINDRES}" "WINDMC=$${WINDMC}" \ + install-dvi) \ + || exit 1 + +@endif target-libgm2 + .PHONY: maybe-install-pdf-target-libgm2 install-pdf-target-libgm2 maybe-install-pdf-target-libgm2: @if target-libgm2 diff --git a/configure b/configure index 663ce71dee0..bbe54d6c23d 100755 --- a/configure +++ b/configure @@ -10113,6 +10113,8 @@ done + + # Generate default definitions for YACC, M4, LEX and other programs that run # on the build machine. These are used if the Makefile can't locate these # programs in objdir. diff --git a/gcc/gdbinit.in b/gcc/gdbinit.in index 7d7c2be2297..be57b04933c 100644 --- a/gcc/gdbinit.in +++ b/gcc/gdbinit.in @@ -383,3 +383,11 @@ skip JUMP_LABEL_AS_INSN # Restore pagination to the previous state. python if __gcc_prev_pagination: gdb.execute("set pagination on") + +break lhd_print_error_function +# run $HOME/Sandpit/chisel/m2/foo.mod +# run -fq -I/home/gaius/GM2/graft-combine/build-devel-modula2-enabled/x86_64-pc-linux-gnu/./libgm2/libm2pim:/home/gaius/GM2/graft-combine/gcc-git-devel-modula2/gcc/testsuite/../m2/gm2-libs -I/home/gaius/GM2/graft-combine/build-devel-modula2-enabled/x86_64-pc-linux-gnu/./libgm2/libm2iso:/home/gaius/GM2/graft-combine/gcc-git-devel-modula2/gcc/testsuite/../m2/gm2-libs-iso -I/home/gaius/GM2/graft-combine/gcc-git-devel-modula2/gcc/testsuite/gm2/extensions/pass -fpim -fno-diagnostics-show-caret -fno-diagnostics-show-line-numbers -fdiagnostics-color=never -O /home/gaius/GM2/graft-combine/gcc-git-devel-modula2/gcc/testsuite/gm2/extensions/run/pass/align4.mod +# +# +break M2Error_NewError +run -g -fm2-g -Wunused-variable -fsoft-check-all -g -fm2-g -funbounded-by-reference -fpim -fextended-opaque -Wpedantic-cast -Wpedantic-param-names -ffunction-sections -fdata-sections -I/home/gaius/GM2/graft-combine/gcc-git-devel-modula2/gcc/m2/gm2-compiler -I/home/gaius/GM2/graft-combine/gcc-git-devel-modula2/gcc/m2/gm2-libs -I/home/gaius/GM2/graft-combine/gcc-git-devel-modula2/gcc/m2/gm2-gcc -I/home/gaius/GM2/graft-combine/gcc-git-devel-modula2/gcc/m2/gm2-libiberty /home/gaius/GM2/graft-combine/gcc-git-devel-modula2/gcc/testsuite/gm2/pim/pass/program2.mod -o - \ No newline at end of file diff --git a/gcc/m2/gm2-compiler/M2Error.def b/gcc/m2/gm2-compiler/M2Error.def index 17882ec78f6..8603fbd7680 100644 --- a/gcc/m2/gm2-compiler/M2Error.def +++ b/gcc/m2/gm2-compiler/M2Error.def @@ -31,6 +31,7 @@ DEFINITION MODULE M2Error ; FROM SYSTEM IMPORT BYTE ; FROM DynamicStrings IMPORT String ; +FROM NameKey IMPORT Name ; EXPORT QUALIFIED Error, InternalError, WriteFormat0, WriteFormat1, WriteFormat2, WriteFormat3, @@ -41,7 +42,10 @@ EXPORT QUALIFIED Error, ErrorStringAt, ErrorStringAt2, ErrorStringsAt2, WarnStringAt, WarnStringAt2, WarnStringsAt2, ErrorAbort0, - WarnFormat0, WarnFormat1, MoveError ; + WarnFormat0, WarnFormat1, MoveError, + AnnounceScope, EnterImplementationScope, + EnterModuleScope, EnterDefinitionScope, EnterProgramScope, + EnterProcedureScope, LeaveScope, DepthScope ; TYPE Error ; @@ -218,4 +222,66 @@ PROCEDURE FlushWarnings ; PROCEDURE ErrorAbort0 (a: ARRAY OF CHAR) ; +(* + AnnounceScope - return the error string s with a scope description prepended + assuming that scope has changed. +*) + +PROCEDURE AnnounceScope (e: Error; s: String) : String ; + + +(* + EnterImplementationScope - signifies to the error routines that the front end + has started to compile implementation module scopeName. +*) + +PROCEDURE EnterImplementationScope (scopename: Name) ; + + +(* + EnterProgramScope - signifies to the error routines that the front end + has started to compile program module scopeName. +*) + +PROCEDURE EnterProgramScope (scopename: Name) ; + + +(* + EnterModuleScope - signifies to the error routines that the front end + has started to compile an inner module scopeName. +*) + +PROCEDURE EnterModuleScope (scopename: Name) ; + + +(* + EnterDefinitionScope - signifies to the error routines that the front end + has started to compile definition module scopeName. +*) + +PROCEDURE EnterDefinitionScope (scopename: Name) ; + + +(* + EnterProcedureScope - signifies to the error routines that the front end + has started to compile definition module scopeName. +*) + +PROCEDURE EnterProcedureScope (scopename: Name) ; + + +(* + LeaveScope - leave the current scope and pop into the previous one. +*) + +PROCEDURE LeaveScope ; + + +(* + DepthScope - returns the depth of the scope stack. +*) + +PROCEDURE DepthScope () : CARDINAL ; + + END M2Error. diff --git a/gcc/m2/gm2-compiler/M2Error.mod b/gcc/m2/gm2-compiler/M2Error.mod index 29de1878f34..9b4dfe03648 100644 --- a/gcc/m2/gm2-compiler/M2Error.mod +++ b/gcc/m2/gm2-compiler/M2Error.mod @@ -34,9 +34,11 @@ FROM M2RTS IMPORT ExitOnHalt ; FROM SYSTEM IMPORT ADDRESS ; FROM M2Emit IMPORT EmitError ; FROM M2LexBuf IMPORT UnknownTokenNo ; +FROM M2StackWord IMPORT StackOfWord, InitStackWord, InitStackWord, PushWord, PopWord, NoOfItemsInStackWord ; +FROM M2Debug IMPORT Assert ; FROM M2ColorString IMPORT filenameColor, endColor, errorColor, warningColor, noteColor, - range1Color, range2Color ; + range1Color, range2Color, quoteOpen, quoteClose ; IMPORT M2Emit ; @@ -49,17 +51,26 @@ TYPE Error = POINTER TO RECORD parent, child, - next : Error ; + next : Error ; note, - fatal : BOOLEAN ; - s : String ; - token : CARDINAL ; (* index of token causing the error *) - color : BOOLEAN ; + fatal : BOOLEAN ; + s : String ; + (* index of token causing the error *) + token : CARDINAL ; + color : BOOLEAN ; + scopeKind: KindScope ; + scopeName: Name ; END ; + KindScope = (noscope, definition, implementation, program, module, procedure) ; + VAR - head : Error ; - InInternal: BOOLEAN ; + head : Error ; + InInternal : BOOLEAN ; + scopeName : Name ; + lastKind, + scopeKind : KindScope ; + scopeStack : StackOfWord ; (* @@ -390,8 +401,10 @@ BEGIN child := NIL ; note := FALSE ; fatal := TRUE ; - color := FALSE + color := FALSE ; END ; + e^.scopeKind := scopeKind ; + e^.scopeName := scopeName ; IF (head=NIL) OR (head^.token>AtTokenNo) THEN e^.next := head ; @@ -550,7 +563,11 @@ END ErrorString ; PROCEDURE Init ; BEGIN head := NIL ; - InInternal := FALSE + InInternal := FALSE ; + scopeStack := InitStackWord () ; + scopeName := NulName ; + scopeKind := noscope ; + lastKind := noscope END Init ; @@ -614,7 +631,7 @@ BEGIN IF (FatalStatus=fatal) AND (s#NIL) THEN CheckIncludes (token, 0) ; - EmitError (fatal, note, token, s) ; + EmitError (fatal, note, token, AnnounceScope (e, s)) ; IF (child#NIL) AND FlushAll (child, FatalStatus) THEN END ; @@ -667,7 +684,7 @@ END FlushErrors ; PROCEDURE FlushWarnings ; BEGIN - IF FlushAll(head, FALSE) + IF FlushAll (head, FALSE) THEN END END FlushWarnings ; @@ -778,10 +795,10 @@ BEGIN THEN WriteFormat0(a) END ; - IF NOT FlushAll(head, TRUE) + IF NOT FlushAll (head, TRUE) THEN WriteFormat0('unidentified error') ; - IF FlushAll(head, TRUE) + IF FlushAll (head, TRUE) THEN END END ; @@ -790,6 +807,143 @@ BEGIN END ErrorAbort0 ; +(* + AnnounceScope - return the error string s with a scope description prepended + assuming that scope has changed. +*) + +PROCEDURE AnnounceScope (e: Error; s: String) : String ; +VAR + desc, + pre, + quoted, + filename, + fmt : String ; +BEGIN + IF (scopeKind#e^.scopeKind) OR (scopeName#e^.scopeName) OR (lastKind#e^.scopeKind) + THEN + lastKind := e^.scopeKind ; + scopeKind := e^.scopeKind ; + scopeName := e^.scopeName ; + Assert (e^.scopeKind # noscope) ; + filename := FindFileNameFromToken (e^.token, 0) ; + IF filename = NIL + THEN + pre := InitString ('') + ELSE + pre := Sprintf1 (Mark (InitString ("%s: ")), filename) + END ; + quoted := quoteOpen (InitString ('')) ; + quoted := ConCat (quoted, Mark (InitStringCharStar (KeyToCharStar (scopeName)))) ; + quoted := quoteClose (quoted) ; + CASE scopeKind OF + + definition : desc := InitString ("In definition module") | + implementation: desc := InitString ("In implementation module") | + program : desc := InitString ("In program module") | + module : desc := InitString ("In inner module") | + procedure : desc := InitString ("In procedure") + + END ; + fmt := ConCat (pre, desc) ; + fmt := ConCat (fmt, Sprintf1 (Mark (InitString (" %s:\n")), quoted)) ; + s := ConCat (fmt, s) + END ; + RETURN s +END AnnounceScope ; + + +(* + EnterImplementationScope - signifies to the error routines that the front end + has started to compile implementation module scopeName. +*) + +PROCEDURE EnterImplementationScope (scopename: Name) ; +BEGIN + PushWord (scopeStack, scopeKind) ; + PushWord (scopeStack, scopeName) ; + scopeKind := implementation ; + scopeName := scopename +END EnterImplementationScope ; + + +(* + EnterProgramScope - signifies to the error routines that the front end + has started to compile program module scopeName. +*) + +PROCEDURE EnterProgramScope (scopename: Name) ; +BEGIN + PushWord (scopeStack, scopeKind) ; + PushWord (scopeStack, scopeName) ; + scopeKind := program ; + scopeName := scopename +END EnterProgramScope ; + + +(* + EnterModuleScope - signifies to the error routines that the front end + has started to compile an inner module scopeName. +*) + +PROCEDURE EnterModuleScope (scopename: Name) ; +BEGIN + PushWord (scopeStack, scopeKind) ; + PushWord (scopeStack, scopeName) ; + scopeKind := module ; + scopeName := scopename +END EnterModuleScope ; + + +(* + EnterDefinitionScope - signifies to the error routines that the front end + has started to compile definition module scopeName. +*) + +PROCEDURE EnterDefinitionScope (scopename: Name) ; +BEGIN + PushWord (scopeStack, scopeKind) ; + PushWord (scopeStack, scopeName) ; + scopeKind := definition ; + scopeName := scopename +END EnterDefinitionScope ; + + +(* + EnterProcedureScope - signifies to the error routines that the front end + has started to compile definition module scopeName. +*) + +PROCEDURE EnterProcedureScope (scopename: Name) ; +BEGIN + PushWord (scopeStack, scopeKind) ; + PushWord (scopeStack, scopeName) ; + scopeKind := procedure ; + scopeName := scopename +END EnterProcedureScope ; + + +(* + LeaveScope - leave the current scope and pop into the previous one. +*) + +PROCEDURE LeaveScope ; +BEGIN + scopeName := PopWord (scopeStack) ; + scopeKind := PopWord (scopeStack) +END LeaveScope ; + + +(* + DepthScope - returns the depth of the scope stack. +*) + +PROCEDURE DepthScope () : CARDINAL ; +BEGIN + RETURN NoOfItemsInStackWord (scopeStack) +END DepthScope ; + + BEGIN Init END M2Error. diff --git a/gcc/m2/gm2-compiler/M2GCCDeclare.mod b/gcc/m2/gm2-compiler/M2GCCDeclare.mod index e41a70ed01d..552ec6057b0 100644 --- a/gcc/m2/gm2-compiler/M2GCCDeclare.mod +++ b/gcc/m2/gm2-compiler/M2GCCDeclare.mod @@ -233,7 +233,7 @@ VAR PROCEDURE mystop ; BEGIN END mystop ; -(* *************************************************** +(* *************************************************** *) (* PrintNum - *) @@ -271,7 +271,7 @@ BEGIN DebugSet('NilTypedArrays', NilTypedArrays) ; DebugSet('ToBeSolvedByQuads', ToBeSolvedByQuads) END DebugSets ; -************************************************ *) +(* ************************************************ *) (* @@ -5437,8 +5437,15 @@ END IsVarDependants ; *) PROCEDURE WalkPointerDependants (sym: CARDINAL; p: WalkAction) ; +VAR + align: CARDINAL ; BEGIN - p(GetSType(sym)) + p(GetSType(sym)) ; + align := GetAlignment(sym) ; + IF align#NulSym + THEN + p(align) + END END WalkPointerDependants ; @@ -5448,8 +5455,24 @@ END WalkPointerDependants ; *) PROCEDURE IsPointerDependants (sym: CARDINAL; q: IsAction) : BOOLEAN ; +VAR + align: CARDINAL ; + final: BOOLEAN ; BEGIN - RETURN( q(GetSType(sym)) ) + final := TRUE ; + IF NOT q(GetSType(sym)) + THEN + final := FALSE + END ; + align := GetAlignment (sym) ; + IF final AND (align # NulSym) + THEN + IF NOT q(align) + THEN + final := FALSE + END + END ; + RETURN final END IsPointerDependants ; @@ -5784,13 +5807,13 @@ END WalkVarientFieldDependants ; PROCEDURE IsArrayDependants (sym: CARDINAL; q: IsAction) : BOOLEAN ; VAR result : BOOLEAN ; + align : CARDINAL ; subscript: CARDINAL ; high, low: CARDINAL ; type : CARDINAL ; BEGIN result := TRUE ; Assert(IsArray(sym)) ; - result := TRUE ; type := GetSType(sym) ; IF NOT q(type) @@ -5815,6 +5838,11 @@ BEGIN result := FALSE END ; IF NOT q(high) + THEN + result := FALSE + END ; + align := GetAlignment(sym) ; + IF (align#NulSym) AND (NOT q(align)) THEN result := FALSE END @@ -5829,6 +5857,7 @@ END IsArrayDependants ; PROCEDURE WalkArrayDependants (sym: CARDINAL; p: WalkAction) ; VAR + align : CARDINAL ; subscript: CARDINAL ; high, low: CARDINAL ; type : CARDINAL ; @@ -5847,7 +5876,12 @@ BEGIN low := GetTypeMin(type) ; high := GetTypeMax(type) ; p(low) ; - p(high) + p(high) ; + align := GetAlignment (sym) ; + IF align#NulSym + THEN + p(align) + END END END WalkArrayDependants ; @@ -6068,16 +6102,22 @@ END WalkUnboundedDependants ; PROCEDURE IsTypeDependants (sym: CARDINAL; q: IsAction) : BOOLEAN ; VAR - type : CARDINAL ; - result: BOOLEAN ; + align: CARDINAL ; + type : CARDINAL ; + final: BOOLEAN ; BEGIN type := GetSType(sym) ; - result := TRUE ; + final := TRUE ; IF (type#NulSym) AND (NOT q(type)) THEN - result := FALSE + final := FALSE END ; - RETURN( result ) + align := GetAlignment(sym) ; + IF (align#NulSym) AND (NOT q(align)) + THEN + final := FALSE + END ; + RETURN( final ) END IsTypeDependants ; @@ -6087,12 +6127,18 @@ END IsTypeDependants ; PROCEDURE WalkTypeDependants (sym: CARDINAL; p: WalkAction) ; VAR - type: CARDINAL ; + align: CARDINAL ; + type : CARDINAL ; BEGIN type := GetSType(sym) ; IF type#NulSym THEN p(type) + END ; + align := GetAlignment(sym) ; + IF align#NulSym + THEN + p(align) END END WalkTypeDependants ; diff --git a/gcc/m2/gm2-compiler/M2GenGCC.mod b/gcc/m2/gm2-compiler/M2GenGCC.mod index b71d37a26ab..afc1ef9b30a 100644 --- a/gcc/m2/gm2-compiler/M2GenGCC.mod +++ b/gcc/m2/gm2-compiler/M2GenGCC.mod @@ -242,7 +242,6 @@ FROM M2Quads IMPORT QuadOperator, GetQuad, IsReferenced, GetNextQuad, DisplayQuadList ; FROM M2Check IMPORT ParameterTypeCompatible, AssignmentTypeCompatible ; - FROM M2SSA IMPORT EnableSSA ; @@ -385,7 +384,6 @@ BEGIN END IsExportedGcc ; - (* ConvertQuadsToTree - runs through the quadruple list and converts it into the GCC tree structure. @@ -394,9 +392,9 @@ END IsExportedGcc ; PROCEDURE ConvertQuadsToTree (Start, End: CARDINAL) ; BEGIN REPEAT - CodeStatement(Start) ; + CodeStatement (Start) ; Start := GetNextQuad (Start) - UNTIL (Start > End) OR (Start = 0) + UNTIL (Start > End) OR (Start = 0) ; END ConvertQuadsToTree ; @@ -556,46 +554,45 @@ BEGIN tokenno := CurrentQuadToken ; IF tokenno=0 THEN - tokenno := QuadToTokenNo(quad) + tokenno := QuadToTokenNo (quad) END ; - GetQuad(quad, op, op1, op2, op3) ; - + GetQuad (quad, op, op1, op2, op3) ; CASE op OF - StandardFunctionOp : FoldStandardFunction(tokenno, p, quad, op1, op2, op3) | + StandardFunctionOp : FoldStandardFunction (tokenno, p, quad, op1, op2, op3) | BuiltinConstOp : FoldBuiltinConst (tokenno, p, quad, op1, op3) | - BuiltinTypeInfoOp : FoldBuiltinTypeInfo(tokenno, p, quad, op1, op2, op3) | - LogicalOrOp : FoldSetOr(tokenno, p, quad, op1, op2, op3) | - LogicalAndOp : FoldSetAnd(tokenno, p, quad, op1, op2, op3) | - LogicalXorOp : FoldSymmetricDifference(tokenno, p, quad, op1, op2, op3) | + BuiltinTypeInfoOp : FoldBuiltinTypeInfo (tokenno, p, quad, op1, op2, op3) | + LogicalOrOp : FoldSetOr (tokenno, p, quad, op1, op2, op3) | + LogicalAndOp : FoldSetAnd (tokenno, p, quad, op1, op2, op3) | + LogicalXorOp : FoldSymmetricDifference (tokenno, p, quad, op1, op2, op3) | BecomesOp : FoldBecomes (tokenno, p, quad, op1, op3) | - AddOp : FoldAdd(tokenno, p, quad, op1, op2, op3) | - SubOp : FoldSub(tokenno, p, quad, op1, op2, op3) | - MultOp : FoldMult(tokenno, p, quad, op1, op2, op3) | - DivM2Op : FoldDivM2(tokenno, p, quad, op1, op2, op3) | - ModM2Op : FoldModM2(tokenno, p, quad, op1, op2, op3) | - DivTruncOp : FoldDivTrunc(tokenno, p, quad, op1, op2, op3) | - ModTruncOp : FoldModTrunc(tokenno, p, quad, op1, op2, op3) | - DivCeilOp : FoldDivCeil(tokenno, p, quad, op1, op2, op3) | - ModCeilOp : FoldModCeil(tokenno, p, quad, op1, op2, op3) | - DivFloorOp : FoldDivFloor(tokenno, p, quad, op1, op2, op3) | - ModFloorOp : FoldModFloor(tokenno, p, quad, op1, op2, op3) | + AddOp : FoldAdd (tokenno, p, quad, op1, op2, op3) | + SubOp : FoldSub (tokenno, p, quad, op1, op2, op3) | + MultOp : FoldMult (tokenno, p, quad, op1, op2, op3) | + DivM2Op : FoldDivM2 (tokenno, p, quad, op1, op2, op3) | + ModM2Op : FoldModM2 (tokenno, p, quad, op1, op2, op3) | + DivTruncOp : FoldDivTrunc (tokenno, p, quad, op1, op2, op3) | + ModTruncOp : FoldModTrunc (tokenno, p, quad, op1, op2, op3) | + DivCeilOp : FoldDivCeil (tokenno, p, quad, op1, op2, op3) | + ModCeilOp : FoldModCeil (tokenno, p, quad, op1, op2, op3) | + DivFloorOp : FoldDivFloor (tokenno, p, quad, op1, op2, op3) | + ModFloorOp : FoldModFloor (tokenno, p, quad, op1, op2, op3) | NegateOp : FoldNegate (tokenno, p, quad, op1, op3) | - SizeOp : FoldSize(tokenno, p, quad, op1, op2, op3) | - RecordFieldOp : FoldRecordField(tokenno, p, quad, op1, op2, op3) | - HighOp : FoldHigh(tokenno, p, quad, op1, op2, op3) | + SizeOp : FoldSize (tokenno, p, quad, op1, op2, op3) | + RecordFieldOp : FoldRecordField (tokenno, p, quad, op1, op2, op3) | + HighOp : FoldHigh (tokenno, p, quad, op1, op2, op3) | ElementSizeOp : FoldElementSize (tokenno, p, quad, op1, op2) | - ConvertOp : FoldConvert(tokenno, p, quad, op1, op2, op3) | - CoerceOp : FoldCoerce(tokenno, p, quad, op1, op2, op3) | - CastOp : FoldCast(tokenno, p, quad, op1, op2, op3) | + ConvertOp : FoldConvert (tokenno, p, quad, op1, op2, op3) | + CoerceOp : FoldCoerce (tokenno, p, quad, op1, op2, op3) | + CastOp : FoldCast (tokenno, p, quad, op1, op2, op3) | InclOp : FoldIncl (tokenno, p, quad, op1, op3) | ExclOp : FoldExcl (tokenno, p, quad, op1, op3) | IfLessOp : FoldIfLess (tokenno, quad, op1, op2, op3) | IfInOp : FoldIfIn (tokenno, quad, op1, op2, op3) | IfNotInOp : FoldIfNotIn (tokenno, quad, op1, op2, op3) | LogicalShiftOp : FoldSetShift(tokenno, p, quad, op1, op2, op3) | - LogicalRotateOp : FoldSetRotate(tokenno, p, quad, op1, op2, op3) | - ParamOp : FoldBuiltinFunction(tokenno, p, quad, op1, op2, op3) | + LogicalRotateOp : FoldSetRotate (tokenno, p, quad, op1, op2, op3) | + ParamOp : FoldBuiltinFunction (tokenno, p, quad, op1, op2, op3) | RangeCheckOp : FoldRange (tokenno, quad, op3) | StatementNoteOp : FoldStatementNote (op3) @@ -614,7 +611,7 @@ BEGIN printf0('after resolving expressions with gcc\n') ; DisplayQuadList END ; - RETURN( Changed ) + RETURN Changed END ResolveConstantExpressions ; diff --git a/gcc/m2/gm2-compiler/M2MetaError.mod b/gcc/m2/gm2-compiler/M2MetaError.mod index ca0ef37fdb6..4289e5ec862 100644 --- a/gcc/m2/gm2-compiler/M2MetaError.mod +++ b/gcc/m2/gm2-compiler/M2MetaError.mod @@ -25,7 +25,7 @@ IMPLEMENTATION MODULE M2MetaError ; FROM M2Base IMPORT ZType, RType ; FROM NameKey IMPORT Name, KeyToCharStar, NulName ; FROM StrLib IMPORT StrLen ; -FROM M2LexBuf IMPORT GetTokenNo ; +FROM M2LexBuf IMPORT GetTokenNo, UnknownTokenNo ; FROM M2Error IMPORT Error, NewError, NewWarning, NewNote, ErrorString, InternalError, ChainError, SetColor, FlushErrors ; FROM FIO IMPORT StdOut, WriteLine ; FROM SFIO IMPORT WriteS ; @@ -36,7 +36,7 @@ FROM StrCase IMPORT Lower ; FROM libc IMPORT printf ; FROM SYSTEM IMPORT ADDRESS ; FROM M2Error IMPORT MoveError ; - +FROM M2Debug IMPORT Assert ; FROM DynamicStrings IMPORT String, InitString, InitStringCharStar, ConCat, ConCatChar, Mark, string, KillString, @@ -54,9 +54,11 @@ FROM SymbolTable IMPORT NulSym, IsSubscript, IsSubrange, IsSet, IsHiddenType, IsError, GetSymName, GetScope, IsExported, GetType, SkipType, GetDeclaredDef, GetDeclaredMod, + GetDeclaredModule, GetDeclaredDefinition, GetScope, GetFirstUsed, IsNameAnonymous ; IMPORT M2ColorString ; +IMPORT M2Error ; CONST @@ -957,6 +959,108 @@ BEGIN END chooseError ; +(* + doErrorScopeMod - potentially create an error referring to the definition + module, fall back to the implementation or program module if + there is no declaration in the definition module. +*) + +PROCEDURE doErrorScopeMod (VAR eb: errorBlock; sym: CARDINAL) ; +VAR + scope: CARDINAL ; +BEGIN + scope := GetScope (sym) ; + IF scope = NulSym + THEN + doError (eb, GetDeclaredMod (sym)) + ELSE + IF IsProcedure (scope) + THEN + M2Error.EnterProcedureScope (GetSymName (scope)) ; + doError (eb, GetDeclaredMod (sym)) ; + ELSE + IF IsModule (scope) + THEN + IF IsInnerModule (scope) + THEN + M2Error.EnterModuleScope (GetSymName (scope)) ; + doError (eb, GetDeclaredMod (sym)) + ELSE + M2Error.EnterProgramScope (GetSymName (scope)) ; + doError (eb, GetDeclaredMod (sym)) + END + ELSE + Assert (IsDefImp (scope)) ; + (* if this fails then we need to skip to the outer scope. + REPEAT + OuterModule := GetScope(OuterModule) + UNTIL GetScope(OuterModule)=NulSym ; *) + IF GetDeclaredModule (sym) = UnknownTokenNo + THEN + M2Error.EnterDefinitionScope (GetSymName (scope)) ; + doError (eb, GetDeclaredDef (sym)) + ELSE + M2Error.EnterImplementationScope (GetSymName (scope)) ; + doError (eb, GetDeclaredMod (sym)) + END + END + END ; + M2Error.LeaveScope + END +END doErrorScopeMod ; + + +(* + doErrorScopeDef - potentially create an error referring to the definition + module, fall back to the implementation or program module if + there is no declaration in the definition module. +*) + +PROCEDURE doErrorScopeDef (VAR eb: errorBlock; sym: CARDINAL) ; +VAR + scope: CARDINAL ; +BEGIN + scope := GetScope (sym) ; + IF scope = NulSym + THEN + doError (eb, GetDeclaredDef (sym)) + ELSE + IF IsProcedure (scope) + THEN + M2Error.EnterProcedureScope (GetSymName (scope)) ; + doError (eb, GetDeclaredDef (sym)) ; + ELSE + IF IsModule (scope) + THEN + IF IsInnerModule (scope) + THEN + M2Error.EnterModuleScope (GetSymName (scope)) ; + doError (eb, GetDeclaredDef (sym)) + ELSE + M2Error.EnterProgramScope (GetSymName (scope)) ; + doError (eb, GetDeclaredDef (sym)) + END + ELSE + Assert (IsDefImp (scope)) ; + (* if this fails then we need to skip to the outer scope. + REPEAT + OuterModule := GetScope(OuterModule) + UNTIL GetScope(OuterModule)=NulSym ; *) + IF GetDeclaredDefinition (sym) = UnknownTokenNo + THEN + M2Error.EnterImplementationScope (GetSymName (scope)) ; + doError (eb, GetDeclaredMod (sym)) + ELSE + M2Error.EnterDefinitionScope (GetSymName (scope)) ; + doError (eb, GetDeclaredDef (sym)) + END + END + END ; + M2Error.LeaveScope + END +END doErrorScopeDef ; + + (* declaredDef - creates an error note where sym[bol] was declared. *) @@ -965,7 +1069,7 @@ PROCEDURE declaredDef (VAR eb: errorBlock; sym: ARRAY OF CARDINAL; bol: CARDINAL BEGIN IF bol <= HIGH (sym) THEN - doError (eb, GetDeclaredDef (sym[bol])) + doErrorScopeDef (eb, sym[bol]) END END declaredDef ; @@ -978,7 +1082,7 @@ PROCEDURE declaredMod (VAR eb: errorBlock; sym: ARRAY OF CARDINAL; bol: CARDINAL BEGIN IF bol <= HIGH (sym) THEN - doError (eb, GetDeclaredMod (sym[bol])) + doErrorScopeMod (eb, sym[bol]) END END declaredMod ; diff --git a/gcc/m2/gm2-compiler/M2Quads.mod b/gcc/m2/gm2-compiler/M2Quads.mod index 8c1fac13273..a08055f5bfd 100644 --- a/gcc/m2/gm2-compiler/M2Quads.mod +++ b/gcc/m2/gm2-compiler/M2Quads.mod @@ -107,6 +107,7 @@ FROM SymbolTable IMPORT ModeOfAddr, GetMode, PutMode, GetSymName, IsUnknown, PushSize, PushValue, PopValue, GetVariableAtAddress, IsVariableAtAddress, MakeError, UnknownReported, + IsInnerModule, GetUnboundedRecordType, GetUnboundedAddressOffset, @@ -239,9 +240,10 @@ FROM M2Range IMPORT InitAssignmentRangeCheck, FROM M2CaseList IMPORT PushCase, PopCase, AddRange, BeginCaseList, EndCaseList, ElseCase ; FROM PCSymBuild IMPORT SkipConst ; - FROM m2builtins IMPORT GetBuiltinTypeInfoType ; +IMPORT M2Error ; + CONST DebugStackOn = TRUE ; @@ -442,7 +444,7 @@ END SetOptionProfiling ; (* SetOptionCoding - builds a code quadruple if the profiling - option was given to the compiler. + option was given to the compiler. *) PROCEDURE SetOptionCoding (b: BOOLEAN) ; @@ -1920,9 +1922,9 @@ PROCEDURE StartBuildDefFile ; VAR ModuleName: Name ; BEGIN - PopT(ModuleName) ; - PushT(ModuleName) ; - GenQuad(StartDefFileOp, GetPreviousTokenLineNo(), NulSym, GetModule(ModuleName)) + PopT (ModuleName) ; + PushT (ModuleName) ; + GenQuad (StartDefFileOp, GetPreviousTokenLineNo (), NulSym, GetModule (ModuleName)) END StartBuildDefFile ; diff --git a/gcc/m2/gm2-compiler/M2SSA.mod b/gcc/m2/gm2-compiler/M2SSA.mod index 9bf1ba0501d..03e4f56fb68 100644 --- a/gcc/m2/gm2-compiler/M2SSA.mod +++ b/gcc/m2/gm2-compiler/M2SSA.mod @@ -146,8 +146,7 @@ BEGIN PushWord (stack, scope) ; IF CompilerDebugging THEN - printf1 ("DiscoverSSA %d\n", scope) ; - printf0 ("ForeachScopeBlockDo\n") + printf1 ("DiscoverSSA %d\n", scope) END ; IF CompilerDebugging diff --git a/gcc/m2/gm2-compiler/M2Scope.mod b/gcc/m2/gm2-compiler/M2Scope.mod index c0c0600e224..61d03fa49cc 100644 --- a/gcc/m2/gm2-compiler/M2Scope.mod +++ b/gcc/m2/gm2-compiler/M2Scope.mod @@ -30,17 +30,22 @@ FROM SymbolTable IMPORT IsProcedure, IsDefImp, GetProcedureQuads, GetScope, GetSymName, NulSym ; FROM M2Options IMPORT DisplayQuadruples ; -FROM M2Printf IMPORT printf1 ; +FROM M2Printf IMPORT printf0, printf1 ; FROM M2Quads IMPORT QuadOperator, GetFirstQuad, GetNextQuad, GetQuad, DisplayQuadRange ; FROM M2StackWord IMPORT StackOfWord, InitStackWord, KillStackWord, PopWord, PushWord, PeepWord ; +IMPORT M2Error ; + CONST Debugging = FALSE ; TYPE - ScopeBlock = POINTER TO scopeblock ; - scopeblock = RECORD + scopeKind = (unsetscope, ignorescope, procedurescope, modulescope, definitionscope, implementationscope, programscope) ; + + ScopeBlock = POINTER TO RECORD + scopeSym : CARDINAL ; + kindScope: scopeKind ; low, high: CARDINAL ; next : ScopeBlock ; END ; @@ -55,9 +60,9 @@ VAR PROCEDURE New (VAR sb: ScopeBlock) ; BEGIN - IF FreeList=NIL + IF FreeList = NIL THEN - NEW(sb) + NEW (sb) ELSE sb := FreeList ; FreeList := FreeList^.next @@ -77,6 +82,17 @@ BEGIN END Dispose ; +(* + SetScope - assigns the scopeSym and kindScope. +*) + +PROCEDURE SetScope (sb: ScopeBlock; sym: CARDINAL; kindScope: scopeKind) ; +BEGIN + sb^.scopeSym := sym ; + sb^.kindScope := kindScope +END SetScope ; + + (* AddToRange - returns a ScopeBlock pointer to the last block. The, quad, will be added to the end of sb or a later block @@ -92,7 +108,7 @@ BEGIN THEN sb^.high := sb^.low END ; - sb^.next := InitScopeBlock(0) ; + sb^.next := InitScopeBlock (NulSym) ; sb := sb^.next END ; IF sb^.low=0 @@ -100,7 +116,7 @@ BEGIN sb^.low := quad END ; sb^.high := quad ; - RETURN( sb ) + RETURN sb END AddToRange ; @@ -124,20 +140,20 @@ BEGIN (IsProcedure(GetScope(scope)) OR (IsModule(scope) AND IsModuleWithinProcedure(scope))) THEN - GetProcedureQuads(GetProcedureScope(scope), i, start, end) ; - GetQuad(i, op, op1, op2, op3) ; + GetProcedureQuads (GetProcedureScope (scope), i, start, end) ; + GetQuad (i, op, op1, op2, op3) ; WHILE (op#ModuleScopeOp) OR (op3#scope) DO - i := GetNextQuad(i) ; - GetQuad(i, op, op1, op2, op3) + i := GetNextQuad (i) ; + GetQuad (i, op, op1, op2, op3) END ; end := i ; - GetQuad(end, op, op1, op2, op3) ; + GetQuad (end, op, op1, op2, op3) ; WHILE (op#FinallyEndOp) OR (op3#scope) DO - end := GetNextQuad(end) ; - GetQuad(end, op, op1, op2, op3) + end := GetNextQuad (end) ; + GetQuad (end, op, op1, op2, op3) END ELSE - i := GetFirstQuad() ; + i := GetFirstQuad () ; end := 0 END ; nb := sb ; @@ -146,17 +162,17 @@ BEGIN LOOP IF i=0 THEN - RETURN( sb ) + RETURN sb END ; - GetQuad(i, op, op1, op2, op3) ; + GetQuad (i, op, op1, op2, op3) ; IF op=ProcedureScopeOp THEN - INC(NestedLevel) + INC (NestedLevel) ELSIF op=ReturnOp THEN IF NestedLevel>0 THEN - DEC(NestedLevel) + DEC (NestedLevel) END ; IF NestedLevel=0 THEN @@ -165,16 +181,35 @@ BEGIN ELSE IF NestedLevel=0 THEN - nb := AddToRange(nb, First, i) ; + IF op=StartDefFileOp + THEN + nb := AddToRange (nb, TRUE, i) ; + SetScope (nb, op3, definitionscope) + ELSIF op=StartModFileOp + THEN + nb := AddToRange (nb, TRUE, i) ; + IF IsDefImp (op3) + THEN + SetScope (nb, op3, implementationscope) + ELSE + SetScope (nb, op3, programscope) + END + ELSE + nb := AddToRange (nb, First, i) ; + IF First + THEN + SetScope (nb, NulSym, unsetscope) (* is this reachable? *) + END + END ; First := FALSE END END ; (* IF (i=end) *) IF (i=end) (* OR (op=EndFileOp) *) THEN - RETURN( sb ) + RETURN sb END ; - i := GetNextQuad(i) + i := GetNextQuad (i) END END GetGlobalQuads ; @@ -195,10 +230,10 @@ VAR s : StackOfWord ; n : Name ; BEGIN - s := InitStackWord() ; + s := InitStackWord () ; IF Debugging THEN - n := GetSymName(proc) ; + n := GetSymName (proc) ; printf1("GetProcQuads for %a\n", n) END ; Assert(IsProcedure(proc)) ; @@ -217,46 +252,54 @@ BEGIN nb := sb ; sb^.low := scope ; sb^.high := 0 ; + SetScope (sb, proc, procedurescope) ; WHILE (i<=end) AND (start#0) DO - GetQuad(i, op, op1, op2, op3) ; + GetQuad (i, op, op1, op2, op3) ; IF (op=ProcedureScopeOp) OR (op=ModuleScopeOp) THEN IF (PeepWord(s, 1)=proc) AND (op3=proc) THEN - nb := AddToRange(nb, First, last) ; + nb := AddToRange (nb, First, last) ; First := FALSE END ; - PushWord(s, op3) + PushWord (s, op3) ; + IF op=ProcedureScopeOp + THEN + SetScope (nb, proc, procedurescope) + ELSE + SetScope (nb, proc, modulescope) + END ELSIF (op=ReturnOp) OR (op=FinallyEndOp) THEN - op3 := PopWord(s) ; - IF PeepWord(s, 1)=proc + op3 := PopWord (s) ; + IF PeepWord (s, 1) = proc THEN First := TRUE END ELSE - IF PeepWord(s, 1)=proc + IF PeepWord (s, 1) = proc THEN - nb := AddToRange(nb, First, i) ; + nb := AddToRange (nb, First, i) ; First := FALSE END END ; last := i ; - i := GetNextQuad(i) + i := GetNextQuad (i) END ; IF start<=nb^.high THEN nb^.high := end ELSE - nb^.next := InitScopeBlock(0) ; + nb^.next := InitScopeBlock (NulSym) ; nb := nb^.next ; + SetScope (nb, proc, unsetscope) ; WITH nb^ DO low := start ; high := end END END ; - s := KillStackWord(s) ; - RETURN( sb ) + s := KillStackWord (s) ; + RETURN sb END GetProcQuads ; @@ -265,11 +308,33 @@ END GetProcQuads ; *) PROCEDURE DisplayScope (sb: ScopeBlock) ; +VAR + name: Name ; BEGIN - DisplayQuadRange(sb^.low, sb^.high) ; - IF sb^.next#NIL - THEN - DisplayScope(sb^.next) + WITH sb^ DO + printf0 ("scope: ") ; + CASE sb^.kindScope OF + + unsetscope : printf0 ("unset") | + ignorescope : printf0 ("ignore") | + procedurescope : name := GetSymName (scopeSym) ; + printf1 ("procedure %a", name) | + modulescope : name := GetSymName (scopeSym) ; + printf1 ("inner module %a", name) | + definitionscope : name := GetSymName (scopeSym) ; + printf1 ("definition module %a", name) | + implementationscope: name := GetSymName (scopeSym) ; + printf1 ("implementation module %a", name) | + programscope : name := GetSymName (scopeSym) ; + printf1 ("program module %a", name) + + END ; + printf0 ("\n") ; + DisplayQuadRange (low, high) ; + IF next#NIL + THEN + DisplayScope (next) + END END END DisplayScope ; @@ -281,31 +346,29 @@ END DisplayScope ; PROCEDURE InitScopeBlock (scope: CARDINAL) : ScopeBlock ; VAR sb: ScopeBlock ; - n : Name ; BEGIN - New(sb) ; + New (sb) ; WITH sb^ DO next := NIL ; - IF scope=0 + kindScope := unsetscope ; + IF scope=NulSym THEN low := 0 ; high := 0 ELSE - IF IsProcedure(scope) + IF IsProcedure (scope) THEN - sb := GetProcQuads(sb, scope) + sb := GetProcQuads (sb, scope) ELSE - sb := GetGlobalQuads(sb, scope) ; - IF DisplayQuadruples - THEN - n := GetSymName (scope) ; - printf1("scope %a is defined by\n", n) ; - DisplayScope(sb) - END + sb := GetGlobalQuads (sb, scope) ; + END ; + IF DisplayQuadruples + THEN + DisplayScope (sb) END END END ; - RETURN( sb ) + RETURN sb END InitScopeBlock ; @@ -318,10 +381,10 @@ VAR t: ScopeBlock ; BEGIN t := sb ; - WHILE t#NIL DO + WHILE t # NIL DO sb := t ; t := t^.next ; - Dispose(sb) ; + Dispose (sb) ; END ; sb := NIL END KillScopeBlock ; @@ -333,18 +396,72 @@ END KillScopeBlock ; PROCEDURE ForeachScopeBlockDo (sb: ScopeBlock; p: ScopeProcedure) ; BEGIN + IF DisplayQuadruples + THEN + printf0 ("ForeachScopeBlockDo\n") + END ; WHILE sb#NIL DO WITH sb^ DO - IF (low#0) AND (high#0) + IF DisplayQuadruples THEN - p(low, high) - END + DisplayScope (sb) + END ; + enter (sb) ; + IF (low # 0) AND (high # 0) + THEN + p (low, high) + END ; + leave (sb) END ; sb := sb^.next - END + END ; + IF DisplayQuadruples + THEN + printf0 ("end ForeachScopeBlockDo\n\n") + END ; END ForeachScopeBlockDo ; +(* + enter - +*) + +PROCEDURE enter (sb: ScopeBlock) ; +BEGIN + WITH sb^ DO + CASE kindScope OF + + unsetscope, + ignorescope : | + procedurescope : M2Error.EnterProcedureScope (GetSymName (scopeSym)) | + modulescope : M2Error.EnterModuleScope (GetSymName (scopeSym)) | + definitionscope : M2Error.EnterDefinitionScope (GetSymName (scopeSym)) | + implementationscope: M2Error.EnterImplementationScope (GetSymName (scopeSym)) | + programscope : M2Error.EnterProgramScope (GetSymName (scopeSym)) + + END + END +END enter ; + + +(* + leave - +*) + +PROCEDURE leave (sb: ScopeBlock) ; +BEGIN + CASE sb^.kindScope OF + + unsetscope, + ignorescope : | + + ELSE + M2Error.LeaveScope + END +END leave ; + + + (* Init - initializes the global variables for this module. *) diff --git a/gcc/m2/gm2-compiler/Output.mod b/gcc/m2/gm2-compiler/Output.mod index ef6880de26b..cffaf449c36 100644 --- a/gcc/m2/gm2-compiler/Output.mod +++ b/gcc/m2/gm2-compiler/Output.mod @@ -132,7 +132,7 @@ BEGIN THEN KillWriteS (InitStringCharStar (KeyToCharStar (key))) ELSE - ConCat (buffer, Mark (InitStringCharStar (KeyToCharStar (key)))) + buffer := ConCat (buffer, Mark (InitStringCharStar (KeyToCharStar (key)))) END END WriteKey ; @@ -175,7 +175,7 @@ BEGIN THEN buffer := KillString (buffer) END ; - buffer := InitString (buffer) + buffer := InitString ('') END StartBuffer ; diff --git a/gcc/m2/gm2-compiler/P0SymBuild.mod b/gcc/m2/gm2-compiler/P0SymBuild.mod index 9fca4ca2aaa..bf36a7a96b3 100644 --- a/gcc/m2/gm2-compiler/P0SymBuild.mod +++ b/gcc/m2/gm2-compiler/P0SymBuild.mod @@ -32,6 +32,7 @@ FROM M2Reserved IMPORT ImportTok ; FROM M2Debug IMPORT Assert ; FROM M2MetaError IMPORT MetaErrorT1, MetaErrorT2, MetaError1, MetaError2 ; FROM M2LexBuf IMPORT GetTokenNo, UnknownTokenNo ; +IMPORT M2Error ; CONST @@ -389,7 +390,8 @@ BEGIN sym := MakeProgramSource(tok, n) ; SetCurrentModule(sym) ; SetFileModule(sym) ; - BeginBlock(n, program, sym, tok) + BeginBlock(n, program, sym, tok) ; + M2Error.EnterProgramScope (n) END RegisterProgramModule ; @@ -410,7 +412,8 @@ BEGIN sym := MakeImplementationSource(tok, n) ; SetCurrentModule(sym) ; SetFileModule(sym) ; - BeginBlock(n, defimp, sym, tok) + BeginBlock(n, defimp, sym, tok) ; + M2Error.EnterImplementationScope (n) END RegisterImplementationModule ; @@ -431,7 +434,8 @@ BEGIN sym := MakeDefinitionSource(tok, n) ; SetCurrentModule(sym) ; SetFileModule(sym) ; - BeginBlock(n, defimp, sym, tok) + BeginBlock(n, defimp, sym, tok) ; + M2Error.EnterDefinitionScope (n) END RegisterDefinitionModule ; @@ -450,7 +454,8 @@ BEGIN PopTtok (n, tok) ; PushTtok (n, tok) ; RegisterLocalModule(n) ; - BeginBlock(n, inner, NulSym, tok) + BeginBlock(n, inner, NulSym, tok) ; + M2Error.EnterModuleScope (n) END RegisterInnerModule ; @@ -466,7 +471,8 @@ BEGIN INC (Level) ; PopTtok (n, tok) ; PushTtok (n, tok) ; - BeginBlock (n, procedure, NulSym, tok) + BeginBlock (n, procedure, NulSym, tok) ; + M2Error.EnterProcedureScope (n) END RegisterProcedure ; @@ -501,7 +507,8 @@ BEGIN MakeError (end, NameEnd), MakeError (start, curBP^.name)) END END ; - EndBlock + EndBlock ; + M2Error.LeaveScope END EndProcedure ; @@ -536,7 +543,8 @@ BEGIN MakeError (end, NameEnd), MakeError (start, curBP^.name)) END END ; - EndBlock + EndBlock ; + M2Error.LeaveScope END EndModule ; diff --git a/gcc/m2/gm2-compiler/P2SymBuild.mod b/gcc/m2/gm2-compiler/P2SymBuild.mod index dab4cb2124a..b3e139c7907 100644 --- a/gcc/m2/gm2-compiler/P2SymBuild.mod +++ b/gcc/m2/gm2-compiler/P2SymBuild.mod @@ -140,6 +140,7 @@ FROM M2Comp IMPORT CompilingDefinitionModule, FROM M2Const IMPORT constType ; FROM M2Students IMPORT CheckForVariableThatLooksLikeKeyword ; +IMPORT M2Error ; CONST @@ -186,7 +187,8 @@ BEGIN Assert(IsDefImp(ModuleSym)) ; Assert(CompilingDefinitionModule()) ; PushT(name) ; - Annotate("%1n||definition module name") + Annotate("%1n||definition module name") ; + M2Error.EnterDefinitionScope (name) END P2StartBuildDefModule ; @@ -224,7 +226,8 @@ BEGIN IF NameStart#NameEnd THEN WriteFormat2('inconsistant definition module name, module began as (%a) and ended with (%a)', NameStart, NameEnd) - END + END ; + M2Error.LeaveScope END P2EndBuildDefModule ; @@ -257,7 +260,8 @@ BEGIN Assert(IsDefImp(ModuleSym)) ; Assert(CompilingImplementationModule()) ; PushT(name) ; - Annotate("%1n||implementation module name") + Annotate("%1n||implementation module name") ; + M2Error.EnterImplementationScope (name) END P2StartBuildImplementationModule ; @@ -290,7 +294,8 @@ BEGIN IF NameStart#NameEnd THEN WriteFormat1('inconsistant implementation module name %a', NameStart) - END + END ; + M2Error.LeaveScope END P2EndBuildImplementationModule ; @@ -323,7 +328,8 @@ BEGIN Assert(CompilingProgramModule()) ; Assert(NOT IsDefImp(ModuleSym)) ; PushT(name) ; - Annotate("%1n||program module name") + Annotate("%1n||program module name") ; + M2Error.EnterProgramScope (name) END P2StartBuildProgramModule ; @@ -361,7 +367,8 @@ BEGIN IF NameStart#NameEnd THEN WriteFormat2('inconsistant program module name %a does not match %a', NameStart, NameEnd) - END + END ; + M2Error.LeaveScope END P2EndBuildProgramModule ; @@ -391,7 +398,8 @@ BEGIN StartScope (ModuleSym) ; Assert(NOT IsDefImp (ModuleSym)) ; PushTtok (name, tok) ; - Annotate ("%1n||inner module name") + Annotate ("%1n||inner module name") ; + M2Error.EnterModuleScope (name) END StartBuildInnerModule ; @@ -424,7 +432,8 @@ BEGIN THEN WriteFormat2('inconsistant inner module name %a does not match %a', NameStart, NameEnd) - END + END ; + M2Error.LeaveScope END EndBuildInnerModule ; @@ -1221,7 +1230,8 @@ BEGIN END ; PushTtok (ProcSym, tokno) ; Annotate ("%1s(%1d)||procedure start symbol") ; - StartScope (ProcSym) + StartScope (ProcSym) ; + M2Error.EnterProcedureScope (name) END StartBuildProcedure ; @@ -1261,7 +1271,8 @@ BEGIN THEN WriteFormat2('end procedure name does not match beginning %a name %a', NameStart, NameEnd) END ; - EndScope + EndScope ; + M2Error.LeaveScope END EndBuildProcedure ; diff --git a/gcc/m2/gm2-compiler/P3SymBuild.mod b/gcc/m2/gm2-compiler/P3SymBuild.mod index b69f3955edc..fd8a9e22c78 100644 --- a/gcc/m2/gm2-compiler/P3SymBuild.mod +++ b/gcc/m2/gm2-compiler/P3SymBuild.mod @@ -62,6 +62,7 @@ FROM M2Comp IMPORT CompilingDefinitionModule, FROM FifoQueue IMPORT GetSubrangeFromFifoQueue ; FROM M2Reserved IMPORT NulTok, ImportTok ; +IMPORT M2Error ; (* @@ -85,14 +86,15 @@ VAR name : Name ; ModuleSym: CARDINAL ; BEGIN - PopTtok(name, tok) ; - ModuleSym := MakeDefinitionSource(tok, name) ; - SetCurrentModule(ModuleSym) ; - SetFileModule(ModuleSym) ; - StartScope(ModuleSym) ; - Assert(IsDefImp(ModuleSym)) ; - Assert(CompilingDefinitionModule()) ; - PushT(name) + PopTtok (name, tok) ; + ModuleSym := MakeDefinitionSource (tok, name) ; + SetCurrentModule (ModuleSym) ; + SetFileModule (ModuleSym) ; + StartScope (ModuleSym) ; + Assert (IsDefImp (ModuleSym)) ; + Assert (CompilingDefinitionModule ()) ; + PushT (name) ; + M2Error.EnterDefinitionScope (name) END P3StartBuildDefModule ; @@ -126,7 +128,8 @@ BEGIN THEN WriteFormat2('inconsistant definition module was named (%a) and concluded as (%a)', NameStart, NameEnd) - END + END ; + M2Error.LeaveScope END P3EndBuildDefModule ; @@ -151,14 +154,15 @@ VAR name : Name ; ModuleSym: CARDINAL ; BEGIN - PopTtok(name, tok) ; - ModuleSym := MakeImplementationSource(tok, name) ; - SetCurrentModule(ModuleSym) ; - SetFileModule(ModuleSym) ; - StartScope(ModuleSym) ; - Assert(IsDefImp(ModuleSym)) ; - Assert(CompilingImplementationModule()) ; - PushT(name) + PopTtok (name, tok) ; + ModuleSym := MakeImplementationSource (tok, name) ; + SetCurrentModule (ModuleSym) ; + SetFileModule (ModuleSym) ; + StartScope (ModuleSym) ; + Assert (IsDefImp(ModuleSym)) ; + Assert (CompilingImplementationModule()) ; + PushT (name) ; + M2Error.EnterImplementationScope (name) END P3StartBuildImpModule ; @@ -195,7 +199,8 @@ BEGIN *) WriteFormat0('too many errors in pass 3') ; FlushErrors - END + END ; + M2Error.LeaveScope END P3EndBuildImpModule ; @@ -229,7 +234,8 @@ BEGIN StartScope(ModuleSym) ; Assert(CompilingProgramModule()) ; Assert(NOT IsDefImp(ModuleSym)) ; - PushT(name) + PushT(name) ; + M2Error.EnterProgramScope (name) END P3StartBuildProgModule ; @@ -266,7 +272,8 @@ BEGIN *) WriteFormat0('too many errors in pass 3') ; FlushErrors - END + END ; + M2Error.LeaveScope END P3EndBuildProgModule ; @@ -297,7 +304,8 @@ BEGIN StartScope(ModuleSym) ; Assert(NOT IsDefImp(ModuleSym)) ; SetCurrentModule(ModuleSym) ; - PushT(name) + PushT(name) ; + M2Error.EnterModuleScope (name) END StartBuildInnerModule ; @@ -334,7 +342,8 @@ BEGIN WriteFormat0('too many errors in pass 3') ; FlushErrors END ; - SetCurrentModule(GetModuleScope(GetCurrentModule())) + SetCurrentModule(GetModuleScope(GetCurrentModule())) ; + M2Error.LeaveScope END EndBuildInnerModule ; @@ -457,7 +466,8 @@ BEGIN ProcSym := RequestSym (tok, name) ; Assert (IsProcedure (ProcSym)) ; PushTtok (ProcSym, tok) ; - StartScope (ProcSym) + StartScope (ProcSym) ; + M2Error.EnterProcedureScope (name) END StartBuildProcedure ; @@ -500,7 +510,8 @@ BEGIN WriteFormat0('too many errors in pass 3') ; FlushErrors END ; - EndScope + EndScope ; + M2Error.LeaveScope END EndBuildProcedure ; diff --git a/gcc/m2/gm2-compiler/PCSymBuild.mod b/gcc/m2/gm2-compiler/PCSymBuild.mod index 6f5d69d85cc..bdfada86008 100644 --- a/gcc/m2/gm2-compiler/PCSymBuild.mod +++ b/gcc/m2/gm2-compiler/PCSymBuild.mod @@ -98,6 +98,8 @@ FROM M2StackWord IMPORT StackOfWord, InitStackWord, KillStackWord, PushWord, PopWord, PeepWord, IsEmptyWord, NoOfItemsInStackWord ; +IMPORT M2Error ; + CONST Debugging = FALSE ; @@ -218,7 +220,8 @@ BEGIN StartScope(ModuleSym) ; Assert(IsDefImp(ModuleSym)) ; Assert(CompilingDefinitionModule()) ; - PushT(name) + PushT(name) ; + M2Error.EnterDefinitionScope (name) END PCStartBuildDefModule ; @@ -252,7 +255,8 @@ BEGIN THEN WriteFormat2('inconsistant definition module was named (%a) and concluded as (%a)', NameStart, NameEnd) - END + END ; + M2Error.LeaveScope END PCEndBuildDefModule ; @@ -284,7 +288,8 @@ BEGIN StartScope(ModuleSym) ; Assert(IsDefImp(ModuleSym)) ; Assert(CompilingImplementationModule()) ; - PushTtok(name, tok) + PushTtok(name, tok) ; + M2Error.EnterImplementationScope (name) END PCStartBuildImpModule ; @@ -321,7 +326,8 @@ BEGIN *) WriteFormat0('too many errors in pass 3') ; FlushErrors - END + END ; + M2Error.LeaveScope END PCEndBuildImpModule ; @@ -355,7 +361,8 @@ BEGIN StartScope(ModuleSym) ; Assert(CompilingProgramModule()) ; Assert(NOT IsDefImp(ModuleSym)) ; - PushTtok(name, tok) + PushTtok(name, tok) ; + M2Error.EnterProgramScope (name) END PCStartBuildProgModule ; @@ -392,7 +399,8 @@ BEGIN *) WriteFormat0('too many errors in pass 3') ; FlushErrors - END + END ; + M2Error.LeaveScope END PCEndBuildProgModule ; @@ -423,7 +431,8 @@ BEGIN StartScope(ModuleSym) ; Assert(NOT IsDefImp(ModuleSym)) ; SetCurrentModule(ModuleSym) ; - PushTtok(name, tok) + PushTtok(name, tok) ; + M2Error.EnterModuleScope (name) END PCStartBuildInnerModule ; @@ -460,7 +469,8 @@ BEGIN WriteFormat0('too many errors in pass 3') ; FlushErrors END ; - SetCurrentModule(GetModuleScope(GetCurrentModule())) + SetCurrentModule(GetModuleScope(GetCurrentModule())) ; + M2Error.LeaveScope END PCEndBuildInnerModule ; @@ -608,7 +618,8 @@ BEGIN ProcSym := RequestSym (tok, name) ; Assert (IsProcedure (ProcSym)) ; PushTtok (ProcSym, tok) ; - StartScope (ProcSym) + StartScope (ProcSym) ; + M2Error.EnterProcedureScope (name) END PCStartBuildProcedure ; @@ -651,7 +662,8 @@ BEGIN WriteFormat0('too many errors in pass 3') ; FlushErrors END ; - EndScope + EndScope ; + M2Error.LeaveScope END PCEndBuildProcedure ; diff --git a/gcc/m2/gm2-compiler/SymbolTable.def b/gcc/m2/gm2-compiler/SymbolTable.def index a5187a6c38c..aaba4c4b893 100644 --- a/gcc/m2/gm2-compiler/SymbolTable.def +++ b/gcc/m2/gm2-compiler/SymbolTable.def @@ -123,6 +123,7 @@ EXPORT QUALIFIED NulSym, GetReadQuads, GetWriteQuads, GetReadLimitQuads, GetWriteLimitQuads, GetDeclaredDef, GetDeclaredMod, PutDeclared, + GetDeclaredDefinition, GetDeclaredModule, GetFirstUsed, PutProcedureBegin, PutProcedureEnd, GetProcedureBeginEnd, GetGnuAsmInput, GetGnuAsmOutput, GetGnuAsmTrash, GetGnuAsm, @@ -1705,6 +1706,22 @@ PROCEDURE GetDeclaredDef (Sym: CARDINAL) : CARDINAL ; PROCEDURE GetDeclaredMod (Sym: CARDINAL) : CARDINAL ; +(* + GetDeclaredDefinition - returns the token where this symbol + was declared in the definition module. +*) + +PROCEDURE GetDeclaredDefinition (Sym: CARDINAL) : CARDINAL ; + + +(* + GetDeclaredModule - returns the token where this symbol was declared + in an implementation or program module. +*) + +PROCEDURE GetDeclaredModule (Sym: CARDINAL) : CARDINAL ; + + (* PutDeclared - adds an entry to symbol, Sym, indicating that it was declared at, tok. This routine diff --git a/gm2tools/Makefile.in b/gm2tools/Makefile.in index d228a6a9b39..386f2e4163a 100644 --- a/gm2tools/Makefile.in +++ b/gm2tools/Makefile.in @@ -639,8 +639,8 @@ distclean-generic: maintainer-clean-generic: @echo "This command is intended for maintainers to use" @echo "it deletes files that may require special tools to rebuild." -@NATIVE_FALSE@install-exec-local: @NATIVE_FALSE@uninstall-local: +@NATIVE_FALSE@install-exec-local: clean: clean-am clean-am: clean-binPROGRAMS clean-generic mostlyclean-am