FROM M2Debug IMPORT Assert ;
-FROM SymbolTable IMPORT MakeModule, MakeDefImp, IsModule, IsDefImp, GetScope, GetLocalSym, GetCurrentScope, GetSym, NulSym ;
+
+FROM SymbolTable IMPORT MakeModule, MakeDefImp, IsModule, IsDefImp,
+ GetScope, GetLocalSym, GetCurrentScope,
+ PutDeclared, GetSym, NulSym ;
+
FROM NameKey IMPORT GetKey, WriteKey ;
FROM M2Printf IMPORT printf2 ;
FROM M2Error IMPORT InternalError ;
Sym := MakeModule (tok, n) ;
Put (Sym, n) ;
Push (Sym)
+ ELSE
+ PutDeclared (tok, Sym)
END ;
RETURN Sym
END MakeProgramSource ;
Sym := MakeDefImp (tok, n) ;
Put (Sym, n) ;
Push (Sym)
+ ELSE
+ PutDeclared (tok, Sym)
END ;
RETURN Sym
END MakeDefinitionSource ;
Sym := MakeDefImp (tok, n) ;
Put (Sym, n) ;
Push (Sym)
+ ELSE
+ PutDeclared (tok, Sym)
END ;
RETURN Sym
END MakeImplementationSource ;
FROM M2Code IMPORT Code ;
FROM M2LexBuf IMPORT OpenSource, CloseSource, ResetForNewPass, currenttoken, GetToken,
- ReInitialize, currentstring, GetTokenNo ;
+ ReInitialize, currentstring, GetTokenNo, BuiltinTokenNo,
+ UnknownTokenNo ;
FROM M2FileName IMPORT CalculateFileName ;
FROM M2Preprocess IMPORT PreprocessModule, MakeSaveTempsFileNameExt, OnExitDelete ;
END compile ;
+(*
+ ExamineHeader - examines up until the ';', '[' or eof and determines if the source file
+ is a program, implementation/definition module.
+*)
+
+PROCEDURE ExamineHeader (VAR name: ADDRESS; VAR isdefimp, module: BOOLEAN) ;
+BEGIN
+ (* Stop if we see one of eof ';' '['. *)
+ WHILE (currenttoken#eoftok) AND
+ (currenttoken#semicolontok) AND (currenttoken#lsbratok) DO
+ IF name = NIL
+ THEN
+ IF (currenttoken=implementationtok) OR (currenttoken=definitiontok)
+ THEN
+ isdefimp := TRUE ;
+ GetToken
+ END ;
+ IF currenttoken=moduletok
+ THEN
+ module := TRUE ;
+ GetToken ;
+ IF currenttoken=identtok
+ THEN
+ name := currentstring
+ END
+ END ;
+ END ;
+ GetToken
+ END ;
+END ExamineHeader ;
+
+
(*
ExamineCompilationUnit - opens the source file to obtain the module name and kind of module.
*)
-PROCEDURE ExamineCompilationUnit (VAR name: ADDRESS; VAR isdefimp: BOOLEAN) ;
+PROCEDURE ExamineCompilationUnit () : CARDINAL ;
VAR
- Message: String ;
+ Message : String ;
+ name : ADDRESS ;
+ module,
+ isdefimp: BOOLEAN ;
BEGIN
+ name := NIL ;
isdefimp := FALSE ; (* default to program module *)
- (* stop if we see eof, ';' or '[' *)
- WHILE (currenttoken#eoftok) AND (currenttoken#semicolontok) AND (currenttoken#lsbratok) DO
- IF (currenttoken=implementationtok) OR (currenttoken=definitiontok)
+ module := FALSE ; (* Seen module keyword? *)
+ ExamineHeader (name, isdefimp, module) ;
+ IF name = NIL
+ THEN
+ IF module
THEN
- isdefimp := TRUE ;
- GetToken
+ Message := MetaString0 (InitString ('no {%kMODULE} keyword seen'))
+ ELSE
+ Message := MetaString0 (InitString ('no module ident seen'))
END ;
- IF currenttoken=identtok
+ m2flex.M2Error (string (Message)) ;
+ exit (1)
+ ELSE
+ (* The token used is will be overwritten when P0 is underway.
+ At this point we are determining the module kind and the tokens
+ read will be discarded (see ReInitialize below). *)
+ IF isdefimp
THEN
- name := currentstring ;
- RETURN
- END ;
- GetToken
- END ;
- Message := MetaString0 (InitString ('no {%kMODULE} name found')) ;
- m2flex.M2Error (string (Message)) ;
- exit (1)
+ RETURN MakeImplementationSource (BuiltinTokenNo, makekey (name))
+ ELSE
+ RETURN MakeProgramSource (BuiltinTokenNo, makekey (name))
+ END
+ END
END ExamineCompilationUnit ;
PROCEDURE PeepInto (s: String) ;
VAR
- name : ADDRESS ;
- isdefimp: BOOLEAN ;
+ mainModule: CARDINAL ;
BEGIN
IF OpenSource (s)
THEN
- ExamineCompilationUnit (name, isdefimp) ;
- IF isdefimp
+ mainModule := ExamineCompilationUnit () ;
+ IF mainModule # NulSym
THEN
- SetMainModule (MakeImplementationSource (GetTokenNo (), makekey (name)))
- ELSE
- SetMainModule (MakeProgramSource (GetTokenNo (), makekey (name)))
+ SetMainModule (mainModule)
END ;
CloseSource ;
ReInitialize
BEGIN
IF AtTokenNo = UnknownTokenNo
THEN
- (* this could be used as a useful debugging hook as the front end
- has forgotten the token no. This can occur if a complex record
- structure or array is used for example. *)
- AtTokenNo := GetTokenNo ()
+ (* This could be used as a useful debugging hook as the front end
+ has forgotten the token no. *)
END ;
NEW(e) ;
WITH e^ DO
BEGIN
Assert (requestDep # NulSym) ;
PushTtok (requestDep, tokno) ;
- PushTF (Adr, Address) ;
+ PushTFtok (Adr, Address, tokno) ;
PushTtok (MakeConstString (tokno, GetSymName (moduleSym)), tokno) ;
PushT (1) ;
BuildAdrFunction ;
- PushTF (Adr, Address) ;
+ PushTFtok (Adr, Address, tokno) ;
PushTtok (MakeConstString (tokno, GetLibName (moduleSym)), tokno) ;
PushT (1) ;
BuildAdrFunction ;
PushTF (Nil, Address) ;
PushTF (Nil, Address)
ELSE
- PushTF (Adr, Address) ;
+ PushTFtok (Adr, Address, tokno) ;
PushTtok (MakeConstString (tokno, GetSymName (depModuleSym)), tokno) ;
PushT (1) ;
BuildAdrFunction ;
- PushTF (Adr, Address) ;
+ PushTFtok (Adr, Address, tokno) ;
PushTtok (MakeConstString (tokno, GetLibName (depModuleSym)), tokno) ;
PushT (1) ;
BuildAdrFunction
VAR
str, m2strnul: CARDINAL ;
BEGIN
- PushTF (Adr, Address) ;
+ PushTFtok (Adr, Address, tok) ;
str := MakeConstString (tok, name) ;
PutConstStringKnown (tok, str, name, FALSE, TRUE) ;
m2strnul := DeferMakeConstStringM2nul (tok, str) ;
(* DeconstructModules (module_name, argc, argv, envp); *)
PushTtok (deconstructModules, tok) ;
- PushTF(Adr, Address) ;
+ PushTFtok (Adr, Address, tok) ;
PushTtok (MakeConstString (tok, GetSymName (moduleSym)), tok) ;
PushT(1) ;
BuildAdrFunction ;
- PushTF(Adr, Address) ;
+ PushTFtok (Adr, Address, tok) ;
PushTtok (MakeConstString (tok, GetLibName (moduleSym)), tok) ;
PushT(1) ;
BuildAdrFunction ;
(* RegisterModule (module_name, init, fini, dependencies); *)
PushTtok (RegisterModule, tok) ;
- PushTF (Adr, Address) ;
+ PushTFtok (Adr, Address, tok) ;
PushTtok (MakeConstString (tok, GetSymName (moduleSym)), tok) ;
PushT (1) ;
BuildAdrFunction ;
- PushTF (Adr, Address) ;
+ PushTFtok (Adr, Address, tok) ;
PushTtok (MakeConstString (tok, GetLibName (moduleSym)), tok) ;
PushT (1) ;
BuildAdrFunction ;
THEN
MarkAsReadWrite(rw) ;
(* pass the address field of an unbounded variable *)
- PushTF(Adr, Address) ;
+ PushTFtok (Adr, Address, OperandTok (pi)) ;
PushTFAD (f^.TrueExit, f^.FalseExit, f^.Unbounded, f^.Dimension) ;
PushT(1) ;
BuildAdrFunction ;
THEN
MarkAsReadWrite(rw) ;
(* pass the address field of an unbounded variable *)
- PushTF(Adr, Address) ;
+ PushTFtok (Adr, Address, OperandTok (pi)) ;
PushTFAD (f^.TrueExit, f^.FalseExit, f^.Unbounded, f^.Dimension) ;
PushT(1) ;
BuildAdrFunction ;
IF Operator = OrTok
THEN
CheckBooleanId ;
- PopBool (t1, f1) ;
+ PopBooltok (t1, f1, rightpos) ;
PopTtok (Operator, OperatorPos) ;
- PopBool (t2, f2) ;
+ PopBooltok (t2, f2, leftpos) ;
Assert (f2=0) ;
- PushBool (Merge (t1, t2), f1)
+ OperatorPos := MakeVirtualTok (OperatorPos, leftpos, rightpos) ;
+ PushBooltok (Merge (t1, t2), f1, OperatorPos)
ELSIF (Operator = AndTok) OR (Operator = AmbersandTok)
THEN
CheckBooleanId ;
- PopBool (t1, f1) ;
+ PopBooltok (t1, f1, rightpos) ;
PopTtok (Operator, OperatorPos) ;
- PopBool (t2, f2) ;
+ PopBooltok (t2, f2, leftpos) ;
Assert (t2=0) ;
- PushBool (t1, Merge (f1, f2))
+ OperatorPos := MakeVirtualTok (OperatorPos, leftpos, rightpos) ;
+ PushBooltok (t1, Merge (f1, f2), OperatorPos)
ELSE
PopTFrwtok (right, righttype, rightrw, rightpos) ;
PopTtok (Operator, OperatorPos) ;
GenQuadO (tokpos, Operator, Operand1, Operand2, 0, FALSE)
END ;
GenQuadO (tokpos, GotoOp, NulSym, NulSym, 0, FALSE) ;
- PushBool (Merge (NextQuad-1, t1), Merge (NextQuad-2, f1))
+ PushBooltok (Merge (NextQuad-1, t1), Merge (NextQuad-2, f1), tokpos)
ELSIF (OperandT (2) = HashTok) OR (OperandT (2) = LessGreaterTok)
THEN
(* are the two boolean expressions the different? *)
GenQuadO (tokpos, Operator, Operand1, Operand2, 0, FALSE)
END ;
GenQuadO (tokpos, GotoOp, NulSym, NulSym, 0, FALSE) ;
- PushBool (Merge (NextQuad-2, f1), Merge (NextQuad-1, t1))
+ PushBooltok (Merge (NextQuad-2, f1), Merge (NextQuad-1, t1), tokpos)
ELSE
MetaError0 ('only allowed to use the relation operators {%Ek=} {%Ek#} rather than {%Ek<} or {%Ek>} on {%EkBOOLEAN} expressions as these do not imply an ordinal value for {%kTRUE} or {%kFALSE}')
END
GenQuadOtok (combinedTok, MakeOp (Op), left, right, 0, FALSE,
leftpos, rightpos, UnknownTokenNo) ; (* True Exit *)
GenQuadO (combinedTok, GotoOp, NulSym, NulSym, 0, FALSE) ; (* False Exit *)
- PushBool (NextQuad-2, NextQuad-1)
+ PushBooltok (NextQuad-2, NextQuad-1, combinedTok)
END
END BuildRelOp ;
BuildVarientSelector,
StartBuildVarientFieldRecord,
EndBuildVarientFieldRecord,
- BuildNulName,
StartBuildArray,
EndBuildArray,
BuildFieldArray, BuildArrayComma,
CaseLabels := ConstExpression [ ".." ConstExpression ] =:
-SetType := % VAR ispacked: BOOLEAN ; %
+SetType := % VAR ispacked: BOOLEAN ;
+ setpos : CARDINAL ; %
+ % setpos := GetTokenNo () %
% ispacked := FALSE %
( "SET" % ispacked := FALSE %
| "PACKEDSET" % ispacked := TRUE %
) "OF" % BuildNulName %
- SimpleType % BuildSetType (ispacked) %
+ SimpleType % BuildSetType (setpos, ispacked) %
=:
-PointerType := "POINTER" "TO" % BuildNulName %
- Type % BuildPointerType %
+PointerType := % VAR pointerpos: CARDINAL ; %
+ % pointerpos := GetTokenNo () %
+ "POINTER" "TO" % BuildNulName %
+ Type % BuildPointerType (pointerpos) %
=:
ProcedureType := "PROCEDURE" % BuildProcedureType ; %
|------------| |-------------|
*)
-PROCEDURE BuildPointerType ;
+PROCEDURE BuildPointerType (pointerpos: CARDINAL) ;
(*
|------------| |-------------|
*)
-PROCEDURE BuildSetType (ispacked: BOOLEAN) ;
+PROCEDURE BuildSetType (setpos: CARDINAL; ispacked: BOOLEAN) ;
(*
FROM NameKey IMPORT Name, MakeKey, makekey, KeyToCharStar, NulName, LengthKey, WriteKey ;
FROM StrLib IMPORT StrEqual ;
FROM M2Debug IMPORT Assert, WriteDebug ;
-FROM M2LexBuf IMPORT UnknownTokenNo, GetTokenNo ;
+FROM M2LexBuf IMPORT UnknownTokenNo, GetTokenNo, MakeVirtual2Tok ;
FROM M2Error IMPORT InternalError, WriteFormat1, WriteFormat2, WriteFormat0, ErrorStringAt, ErrorStringAt2 ;
FROM M2MetaError IMPORT MetaError1, MetaError2, MetaErrorsT2, MetaErrors1, MetaErrors2, MetaErrorString1 ;
FROM DynamicStrings IMPORT String, InitString, InitStringCharStar, Mark, Slice, ConCat, KillString, string ;
|------------| |-------------|
*)
-PROCEDURE BuildPointerType ;
+PROCEDURE BuildPointerType (pointerpos: CARDINAL) ;
VAR
- tok : CARDINAL ;
+ combined,
+ namepos,
+ typepos : CARDINAL ;
name : Name ;
Type,
PtrToType: CARDINAL ;
BEGIN
- PopTtok(Type, tok) ;
- PopT(name) ;
- name := CheckAnonymous(name) ;
+ PopTtok (Type, typepos) ;
+ PopTtok (name, namepos) ;
+ name := CheckAnonymous (name) ;
- PtrToType := MakePointer(tok, name) ;
- PutPointer(PtrToType, Type) ;
+ combined := MakeVirtual2Tok (pointerpos, typepos) ;
+ PtrToType := MakePointer (combined, name) ;
+ PutPointer (PtrToType, Type) ;
CheckForExportedImplementation(PtrToType) ; (* May be an exported hidden type *)
- PushTtok(name, tok) ;
+ PushTtok (name, namepos) ;
Annotate("%1n|%3d||pointer type name") ;
- PushTtok(PtrToType, tok) ;
+ PushTtok(PtrToType, combined) ;
Annotate("%1s(%1d)|%3d||pointer type")
-
END BuildPointerType ;
|------------| |-------------|
*)
-PROCEDURE BuildSetType (ispacked: BOOLEAN) ;
+PROCEDURE BuildSetType (setpos: CARDINAL; ispacked: BOOLEAN) ;
VAR
- tok : CARDINAL ;
- name : Name ;
+ combined,
+ namepos,
+ typepos : CARDINAL ;
+ name : Name ;
Type,
- SetType: CARDINAL ;
+ SetType : CARDINAL ;
BEGIN
- PopTtok(Type, tok) ;
- PopT(name) ;
- SetType := MakeSet (tok, name) ;
+ PopTtok (Type, typepos) ;
+ PopTtok (name, namepos) ;
+ combined := MakeVirtual2Tok (setpos, typepos) ;
+ SetType := MakeSet (combined, name) ;
CheckForExportedImplementation(SetType) ; (* May be an exported hidden type *)
PutSet(SetType, Type, ispacked) ;
- PushT(name) ;
+ PushTtok (name, namepos) ;
Annotate("%1n||set type name") ;
- PushTtok (SetType, tok) ;
+ PushTtok (SetType, combined) ;
Annotate ("%1s(%1d)|%3d||set type|token no")
END BuildSetType ;
CONST
- DebugUnknowns = FALSE ;
+ DebugUnknowns = FALSE ; (* Debug unknown symbols. *)
+ DebugUnknownToken = FALSE ; (* If enabled it will generate a warning every
+ time a symbol is created with an unknown
+ location. *)
(*
The Unbounded is a pseudo type used within the compiler
END GetModuleCtors ;
+(*
+ CheckTok - checks to see that tok is at a known location. If not
+ it uses GetTokenNo as a fall back.
+*)
+
+PROCEDURE CheckTok (tok: CARDINAL; name: ARRAY OF CHAR) : CARDINAL ;
+VAR
+ s: String ;
+BEGIN
+ IF tok = UnknownTokenNo
+ THEN
+ tok := GetTokenNo () ;
+ IF DebugUnknownToken
+ THEN
+ s := InitString (name) ;
+ s := ConCat (s, InitString (' symbol {%W} has been created with an unknown token location')) ;
+ MetaErrorStringT0 (GetTokenNo (), s)
+ END
+ END ;
+ RETURN tok
+END CheckTok ;
+
+
(*
MakeModule - creates a module sym with ModuleName. It returns the
symbol index.
pCall: PtrToCallFrame ;
Sym : CARDINAL ;
BEGIN
+ (* tok := CheckTok (tok, 'module') ; *)
(*
Make a new symbol since we are at the outer scope level.
DeclareSym examines the current scope level for any symbols
(* We cannot use DeclareSym as it examines the current scope *)
(* for any symbols which have the correct name, but are yet *)
(* undefined. *)
-
+ (* tok := CheckTok (tok, 'defimp') ; *)
NewSym(Sym) ;
pSym := GetPsym(Sym) ;
WITH pSym^ DO
pSym: PtrToSymbol ;
Sym : CARDINAL ;
BEGIN
+ tok := CheckTok (tok, 'procedure') ;
Sym := DeclareSym(tok, ProcedureName) ;
IF NOT IsError(Sym)
THEN
VAR
oaf, sym: CARDINAL ;
BEGIN
+ tok := CheckTok (tok, 'record') ;
sym := HandleHiddenOrDeclare (tok, RecordName, oaf) ;
FillInRecordFields (tok, sym, RecordName, GetCurrentScope (), oaf) ;
ForeachOAFamily (oaf, doFillInOAFamily) ;
pSym: PtrToSymbol ;
Sym : CARDINAL ;
BEGIN
+ tok := CheckTok (tok, 'varient') ;
NewSym (Sym) ;
pSym := GetPsym(Sym) ;
WITH pSym^ DO
pSym : PtrToSymbol ;
sym, oaf: CARDINAL ;
BEGIN
+ tok := CheckTok (tok, 'enumeration') ;
sym := CheckForHiddenType (EnumerationName) ;
IF sym=NulSym
THEN
pSym: PtrToSymbol ;
Sym : CARDINAL ;
BEGIN
+ tok := CheckTok (tok, 'hidden') ;
Sym := DeclareSym (tok, TypeName) ;
IF NOT IsError(Sym)
THEN
str: String ;
sym: CARDINAL ;
BEGIN
+ tok := CheckTok (tok, 'constant') ;
str := Sprintf1 (Mark (InitString ("%d")), value) ;
sym := MakeConstLit (tok, makekey (string (str)), Cardinal) ;
str := KillString (str) ;
VAR
sym: CARDINAL ;
BEGIN
+ tok := CheckTok (tok, 'constlit') ;
sym := LookupConstLitPoolEntry (tok, constName, constType) ;
IF sym = NulSym
THEN
VAR
newstr: CARDINAL ;
BEGIN
+ tok := CheckTok (tok, 'conststringcnul') ;
NewSym (newstr) ;
InitConstString (tok, newstr, name, name, cnulstr, TRUE, known) ;
RETURN newstr
pSym : PtrToSymbol ;
sym, oaf: CARDINAL ;
BEGIN
+ tok := CheckTok (tok, 'subrange') ;
sym := HandleHiddenOrDeclare (tok, SubrangeName, oaf) ;
IF NOT IsError(sym)
THEN
PROCEDURE MakeTemporary (tok: CARDINAL; Mode: ModeOfAddr) : CARDINAL ;
BEGIN
+ tok := CheckTok (tok, 'temporary') ;
RETURN buildTemporary (tok, Mode, FALSE, NulSym)
END MakeTemporary ;
pSym : PtrToSymbol ;
VariableSym: CARDINAL ;
BEGIN
+ tok := CheckTok (tok, 'parameter') ;
VariableSym := MakeVar (tok, ParamName) ;
pSym := GetPsym (VariableSym) ;
WITH pSym^ DO
VAR
heapvar: CARDINAL ;
BEGIN
+ tok := CheckTok (tok, 'parameter heap var') ;
heapvar := NulSym ;
type := SkipType (type) ;
IF IsPointer (type)
VAR
oaf, sym: CARDINAL ;
BEGIN
+ tok := CheckTok (tok, 'pointer') ;
sym := HandleHiddenOrDeclare(tok, PointerName, oaf) ;
FillInPointerFields(sym, PointerName, GetCurrentScope(), oaf) ;
ForeachOAFamily(oaf, doFillInOAFamily) ;
pSym : PtrToSymbol ;
oaf, sym: CARDINAL ;
BEGIN
+ tok := CheckTok (tok, 'set') ;
sym := HandleHiddenOrDeclare(tok, SetName, oaf) ;
IF NOT IsError(sym)
THEN
VAR
sym, oaf: CARDINAL ;
BEGIN
+ tok := CheckTok (tok, 'unbounded') ;
oaf := MakeOAFamily(SimpleType) ;
sym := GetUnbounded(oaf, ndim) ;
IF sym=NulSym
pSym : PtrToSymbol ;
oaf, sym: CARDINAL ;
BEGIN
+ tok := CheckTok (tok, 'proctype') ;
sym := HandleHiddenOrDeclare (tok, ProcTypeName, oaf) ;
IF NOT IsError(sym)
THEN
git://gcc.gnu.org / gcc.git / commitdiff