File: Decl.m3 Last modified on Tue Dec 20 14:54:22 PST 1994 by kalsow modified on Sat Mar 16 01:56:20 1991 by muller
MODULE; IMPORT M3, M3ID, M3String, Token, Error, ESet, Module, Exceptionz; IMPORT Constant, Tipe, Variable, Procedure, Revelation, CG, Target; FROM Scanner IMPORT GetToken, Match, cur; TYPE TK = Token.T; TYPE Attr = { External, Inline, Implicit, CallConv, Obsolete, Unused, LazyAligned }; AttrSet = SET OF Attr; CONST RevealOK = AttrSet { }; ConstantOK = AttrSet { Attr.Obsolete, Attr.Unused, Attr.LazyAligned }; TypeOK = AttrSet { Attr.Obsolete, Attr.Unused, Attr.LazyAligned }; ExceptionOK = AttrSet { Attr.Obsolete, Attr.Unused, Attr.Implicit }; VariableOK = AttrSet { Attr.Obsolete, Attr.Unused, Attr.External, Attr.LazyAligned }; ProcedureOK = AttrSet { Attr.Obsolete, Attr.Unused, Attr.External, Attr.Inline, Attr.CallConv }; PROCEDURE Decl Parse (interface, top_level: BOOLEAN; VAR fails: M3.ExSet) = VAR att: Attributes; got_cc := FALSE; BEGIN att.isInline := FALSE; att.isExternal := FALSE; att.isUnused := FALSE; att.isObsolete := FALSE; att.isImplicit := FALSE; att.alias := M3ID.NoID; att.callingConv := NIL; att.isLazyAligned := Module.LazyAlignmentOn (); LOOP CASE cur.token OF | TK.tEXTERNAL => IF NOT Module.IsInterface () THEN Error.Msg ("External declarations only allowed in interfaces"); END; ParseExternalPragma (att.alias, att.callingConv, got_cc); att.isExternal := TRUE; | TK.tINLINE => att.isInline := TRUE; GetToken (); (* INLINE *) Match (TK.tENDPRAGMA); | TK.tUNUSED => att.isUnused := TRUE; GetToken (); (* UNUSED *) Match (TK.tENDPRAGMA); | TK.tOBSOLETE => att.isObsolete := TRUE; GetToken (); (* OBSOLETE *) Match (TK.tENDPRAGMA); | TK.tIMPLICIT => att.isImplicit := TRUE; GetToken (); (* IMPLICIT *) Match (TK.tENDPRAGMA); | TK.tCALLCONV => att.callingConv := Target.FindConvention (M3ID.ToText (cur.id)); got_cc := TRUE; GetToken (); (* convention name *) Match (TK.tENDPRAGMA); | TK.tLAZYALIGN => att.isLazyAligned := TRUE; Module.SetLazyAlignment (TRUE); GetToken (); (* LAZYALIGN *) Match (TK.tENDPRAGMA); | TK.tSTRICTALIGN => att.isLazyAligned := FALSE; Module.SetLazyAlignment (FALSE); GetToken (); (* LAZYALIGN *) Match (TK.tENDPRAGMA); ELSE EXIT; END; END; CASE cur.token OF | TK.tCONST => CheckAttrs (att, got_cc, ConstantOK, "constant"); Constant.ParseDecl (att); | TK.tTYPE => CheckAttrs (att, got_cc, TypeOK, "type"); Tipe.Parse (att); | TK.tVAR => att.isExternal := att.isExternal OR Module.IsExternal (); CheckAttrs (att, got_cc, VariableOK, "variable"); Variable.ParseDecl (att); | TK.tPROCEDURE => att.isExternal := att.isExternal OR Module.IsExternal (); CheckAttrs (att, got_cc, ProcedureOK, "procedure"); Procedure.ParseDecl (att, interface); | TK.tREVEAL => IF (NOT top_level) THEN Error.Msg ("revelations in nested scopes are not allowed"); END; CheckAttrs (att, got_cc, RevealOK, "revelation"); Revelation.Parse (att); | TK.tEXCEPTION => IF (NOT top_level) THEN Error.Msg ("exception declarations in nested scopes are not allowed"); END; CheckAttrs (att, got_cc, ExceptionOK, "exception"); Exceptionz.ParseDecl (att); | TK.tFATAL => fails := ESet.ParseFails (fails); ELSE IF att.isInline OR att.isExternal OR att.isUnused OR att.isObsolete OR att.isImplicit THEN Error.Msg ("declaration pragma not followed by a declaration"); END; END; END Parse; PROCEDUREParseExternalPragma (VAR alias : M3ID.T; VAR cc : CG.CallingConvention; VAR got_cc : BOOLEAN) = VAR txt: TEXT; BEGIN <* ASSERT cur.token = TK.tEXTERNAL *> GetToken (); (* EXTERNAL *) alias := M3ID.NoID; (* default => use the Modula-3 name *) cc := Target.DefaultCall; got_cc := FALSE; IF (cur.token = TK.tIDENT) OR (cur.token = TK.tTEXTCONST) THEN IF (cur.token = TK.tIDENT) THEN alias := cur.id; ELSE alias := M3ID.Add (M3String.ToText (cur.str)); END; GetToken (); (* IDENT, TEXTCONST *) IF (cur.token = TK.tCOLON) THEN GetToken (); (* : *) IF (cur.token = TK.tIDENT) THEN txt := M3ID.ToText (cur.id); ELSIF (cur.token = TK.tTEXTCONST) THEN txt := M3String.ToText (cur.str); ELSE txt := NIL; END; IF (txt # NIL) THEN cc := Target.FindConvention (txt); got_cc := TRUE; IF (cc = NIL) THEN Error.ID (cur.id, "unsupported language or calling convention"); cc := Target.DefaultCall; END; GetToken (); (* IDENT/TEXTCONST *) ELSE Error.Msg ("Missing language for <*EXTERNAL*> pragma"); END; END; END; Match (TK.tENDPRAGMA); END ParseExternalPragma; PROCEDURECheckAttrs (VAR att: Attributes; got_cc: BOOLEAN; allowed: AttrSet; tag: TEXT) = BEGIN IF att.isUnused AND NOT Attr.Unused IN allowed THEN Error.Msg (tag & "s cannot be unused"); att.isUnused := FALSE; END; IF att.isObsolete AND NOT Attr.Obsolete IN allowed THEN Error.Msg (tag & "s cannot be obsolete"); att.isObsolete := FALSE; END; IF att.isInline AND NOT Attr.Inline IN allowed THEN Error.Msg (tag & "s cannot be inline"); att.isInline := FALSE; END; IF att.isImplicit AND NOT Attr.Implicit IN allowed THEN Error.Msg (tag & "s cannot be declared <*IMPLICIT*>"); att.isImplicit := FALSE; END; IF att.isExternal AND NOT Attr.External IN allowed THEN Error.Msg (tag & "s cannot be external"); att.isExternal := FALSE; att.callingConv := NIL; att.alias := M3ID.NoID; ELSIF got_cc AND att.callingConv # NIL AND NOT Attr.CallConv IN allowed THEN Error.Msg (tag & "s do not have calling conventions"); att.callingConv := NIL; END; END CheckAttrs; BEGIN END Decl.