VAR
n: exprNode ;
BEGIN
- NEW(n) ;
+ NEW (n) ;
WITH n^ DO
tag := function ;
CASE tag OF
END
END ;
- PushAddress(exprStack, n)
+ PushAddress (exprStack, n)
END InitFunction ;
BEGIN
IF type=Char
THEN
- RETURN( char )
+ RETURN char
ELSIF type=Boolean
THEN
- RETURN( boolean )
- ELSIF IsRealType(type)
+ RETURN boolean
+ ELSIF IsRealType (type)
THEN
- RETURN( rtype )
- ELSIF IsComplexType(type)
+ RETURN rtype
+ ELSIF IsComplexType (type)
THEN
- RETURN( ctype )
- ELSIF IsOrdinalType(type)
+ RETURN ctype
+ ELSIF IsOrdinalType (type)
THEN
- RETURN( ztype )
+ RETURN ztype
ELSE
- RETURN( unknown )
+ RETURN unknown
END
END TypeToMeta ;
PROCEDURE buildConstFunction (func: CARDINAL; n: CARDINAL) ;
VAR
- i : CARDINAL ;
- f, s: exprNode ;
+ i : CARDINAL ;
+ first,
+ second: exprNode ;
BEGIN
- f := NIL ;
- s := NIL ;
+ first := NIL ;
+ second := NIL ;
IF n=1
THEN
- f := PopAddress(exprStack)
+ first := PopAddress (exprStack)
ELSIF n>=2
THEN
i := n ;
WHILE i>2 DO
- s := PopAddress(exprStack) ;
- DISPOSE(s) ;
- DEC(i)
+ second := PopAddress (exprStack) ;
+ DISPOSE (second) ;
+ DEC (i)
END ;
- s := PopAddress(exprStack) ;
- f := PopAddress(exprStack)
+ second := PopAddress (exprStack) ;
+ first := PopAddress (exprStack)
END ;
IF func=Val
THEN
- InitConvert(cast, NulSym, f, s)
+ InitConvert (cast, NulSym, first, second)
ELSIF (func=Max) OR (func=Min)
THEN
- InitFunction(unknown, func, NulSym, f, s, FALSE)
+ InitFunction (unknown, func, NulSym, first, second, FALSE)
ELSE
- InitFunction(TypeToMeta(GetSkippedType(func)), func, GetSkippedType(func), f, s, n>2)
+ InitFunction (TypeToMeta(GetSkippedType(func)), func, GetSkippedType(func),
+ first, second, n>2)
END
END buildConstFunction ;
THEN
IF (func=Min) OR (func=Max)
THEN
- IF IsEnumeration(sym) OR IsSet(sym)
+ IF IsSet (sym)
THEN
type := SkipType(GetType(sym))
ELSE
type := getEtype(first) ;
RETURN( TRUE )
END ;
- RETURN( WalkFunctionParam(func, first) )
+ RETURN WalkFunctionParam (func, first)
ELSE
MetaError1('not expecting this function inside a constant expression {%1Dad}', func)
END
BEGIN
IF d=NIL
THEN
- RETURN( FALSE )
+ RETURN FALSE
ELSE
- RETURN( doWalkDes(d) )
+ IF Debugging
+ THEN
+ DebugDes (d)
+ END ;
+ RETURN doWalkDes (d)
END
END WalkDes ;
IMPLEMENTATION MODULE PHBuild ;
-FROM M2LexBuf IMPORT currentstring, currenttoken, GetToken, InsertToken, InsertTokenAndRewind, GetTokenNo ;
+FROM M2LexBuf IMPORT currentstring, currenttoken, GetToken, InsertToken,
+ InsertTokenAndRewind, GetTokenNo, MakeVirtualTok ;
+
FROM M2Error IMPORT ErrorStringAt ;
FROM NameKey IMPORT NulName, Name, makekey ;
FROM M2Reserved IMPORT NulTok, ByTok, PeriodPeriodTok, tokToTok, toktype ;
FROM M2Quads IMPORT PushT, PopT, PushTF, PopTF, PopNothing, Annotate,
PushTtok, PushTFtok, PopTtok, PopTFtok, OperandTok,
+ PushTFntok, Top,
StartBuildDefFile, StartBuildModFile,
BuildModuleStart,
EndBuildFile,
BeginVarient, EndVarient, ElseVarient,
BeginVarientList, EndVarientList,
AddVarientRange, AddVarientEquality,
- CheckWithReference,
+ BuildDefaultFieldAlignment, BuildPragmaField,
+ CheckWithReference, DisplayStack, Annotate,
IsAutoPushOn, PushAutoOff, PushAutoOn, PopAuto ;
FROM P3SymBuild IMPORT P3StartBuildProgModule,
BuildSubrange,
BuildNulName ;
+FROM P3SymBuild IMPORT CheckCanBeImported ;
+
FROM SymbolTable IMPORT MakeGnuAsm, PutGnuAsmVolatile, PutGnuAsm, PutGnuAsmInput,
PutGnuAsmOutput, PutGnuAsmTrash, PutGnuAsmVolatile,
MakeRegInterface,
StartScope, EndScope,
PutIncluded,
IsVarParam, IsProcedure, IsDefImp, IsModule,
- IsRecord,
+ IsRecord, IsProcType,
RequestSym,
GetSym, GetLocalSym ;
FROM M2Reserved IMPORT NulTok, ImportTok, ExportTok, QualifiedTok, UnQualifiedTok,
EqualTok, HashTok, LessGreaterTok, LessTok, LessEqualTok,
GreaterTok, GreaterEqualTok, InTok, PlusTok, MinusTok,
- OrTok, TimesTok, DivTok, DivideTok, ModTok, RemTok, AndTok, AmbersandTok ;
+ OrTok, TimesTok, DivTok, DivideTok, ModTok, RemTok, AndTok,
+ AmbersandTok ;
IMPORT M2Error ;
CONST
Debugging = FALSE ;
- Pass1 = FALSE ; (* permanently disabled for the time being *)
- Pass2 = FALSE ; (* permanently disabled for the time being *)
- Pass3 = FALSE ;
VAR
WasNoError: BOOLEAN ;
+(*
+ BlockAssert - used when developing, if disabled the bug (incorrect stack level)
+ will be caught by the block and a user error issued.
+ This procedure useful to detect the failure earlier.
+*)
+
+PROCEDURE BlockAssert (value: BOOLEAN) ;
+BEGIN
+ IF Debugging
+ THEN
+ Assert (value)
+ END
+END BlockAssert ;
+
+
PROCEDURE ErrorString (s: String) ;
BEGIN
ErrorStringAt(s, GetTokenNo()) ;
END ErrorArray ;
+PROCEDURE ErrorArrayAt (a: ARRAY OF CHAR; tok: CARDINAL) ;
+BEGIN
+ ErrorStringAt (InitString(a), tok)
+END ErrorArrayAt ;
+
% declaration PHBuild begin
(NOT InStopSet(identtok, stopset0, stopset1, stopset2))
THEN
(* SyntaxCheck would fail since currentoken is not part of the stopset
- we check to see whether any of currenttoken might be a commonly omitted token *)
+ we check to see whether any of currenttoken might be a commonly
+ omitted token. *)
IF CheckAndInsert(semicolontok, stopset0, stopset1, stopset2) OR
CheckAndInsert(rsbratok, stopset0, stopset1, stopset2) OR
CheckAndInsert(rparatok, stopset0, stopset1, stopset2) OR
Expect -
*)
-PROCEDURE Expect (t: toktype; stopset0: SetOfStop0; stopset1: SetOfStop1; stopset2: SetOfStop2) ;
+PROCEDURE Expect (tok: toktype; stopset0: SetOfStop0; stopset1: SetOfStop1;
+ stopset2: SetOfStop2) ;
BEGIN
- IF currenttoken=t
+ IF currenttoken=tok
THEN
- GetToken ;
- IF Pass1
- THEN
- PeepToken(stopset0, stopset1, stopset2)
- END
+ GetToken
ELSE
- MissingToken(t)
+ MissingToken (tok)
END ;
- SyntaxCheck(stopset0, stopset1, stopset2)
+ SyntaxCheck (stopset0, stopset1, stopset2)
END Expect ;
PROCEDURE CompilationUnit () : BOOLEAN ;
BEGIN
WasNoError := TRUE ;
- FileUnit(SetOfStop0{eoftok}, SetOfStop1{}, SetOfStop2{}) ;
- RETURN( WasNoError )
+ FileUnit (SetOfStop0{eoftok}, SetOfStop1{}, SetOfStop2{}) ;
+ RETURN WasNoError
END CompilationUnit ;
PROCEDURE Ident (stopset0: SetOfStop0; stopset1: SetOfStop1; stopset2: SetOfStop2) ;
BEGIN
- IF IsAutoPushOn()
+ IF IsAutoPushOn ()
THEN
- PushTF(makekey(currentstring), identtok)
+ PushTF (makekey (currentstring), identtok)
END ;
- Expect(identtok, stopset0, stopset1, stopset2)
+ Expect (identtok, stopset0, stopset1, stopset2)
END Ident ;
Number := Integer | Real =:
+
Qualident := % VAR name: Name ;
Type, Sym, tok: CARDINAL ; %
Ident
{ "." Ident } % END %
=:
+PushQualident := % VAR name : Name ;
+ init, ip1 : CARDINAL ;
+ tok, tokstart: CARDINAL ; %
+ % PushAutoOn %
+ Ident % IF IsAutoPushOn()
+ THEN
+ PopTtok (name, tokstart) ;
+ tok := tokstart ;
+ init := GetSym (name) ;
+ IF init=NulSym
+ THEN
+ PushTFntok (NulSym, NulSym, name, tok)
+ ELSE
+ WHILE IsDefImp (init) OR IsModule (init) DO
+ IF currenttoken # periodtok
+ THEN
+ ErrorArrayAt ("expecting '.' after module in the construction of a qualident", tok) ;
+ IF tok#tokstart
+ THEN
+ tok := MakeVirtualTok (tokstart, tokstart, tok)
+ END ;
+ PushTtok (init, tok) ;
+ PopAuto ;
+ RETURN
+ ELSE
+ Expect (periodtok, stopset0, stopset1, stopset2 + SetOfStop2{identtok}) ;
+ StartScope (init) ;
+ Ident (stopset0, stopset1, stopset2) ;
+ PopTtok (name, tok) ;
+ ip1 := GetSym (name) ;
+ IF ip1 = NulSym
+ THEN
+ ErrorArrayAt ("unknown ident in the construction of a qualident", tok) ;
+ EndScope ;
+ IF tok#tokstart
+ THEN
+ tok := MakeVirtualTok (tokstart, tokstart, tok)
+ END ;
+ PushTFntok (NulSym, NulSym, name, tok) ;
+ PopAuto ;
+ RETURN
+ ELSE
+ PutIncluded (ip1)
+ END ;
+ EndScope ;
+ CheckCanBeImported (init, ip1) ;
+ init := ip1
+ END
+ END ;
+ IF tok#tokstart
+ THEN
+ tok := MakeVirtualTok (tokstart, tokstart, tok)
+ END ;
+ IF IsProcedure (init) OR IsProcType (init)
+ THEN
+ PushTtok (init, tok)
+ ELSE
+ PushTFtok (init, GetType(init), tok)
+ END
+ END
+ ELSE %
+ { "." Ident } % END %
+ % PopAuto %
+ =:
+
ConstantDeclaration := % PushAutoOn %
% VAR tokno: CARDINAL ; %
( Ident "=" % tokno := GetTokenNo () %
[ ArraySetRecordValue ] % BuildConstructorEnd (GetTokenNo()) %
'}' =:
-ConstSetOrQualidentOrFunction := Qualident
- [ Constructor | ConstActualParameters % BuildConstFunctionCall %
- ]
- | % BuildTypeForConstructor %
- Constructor =:
+ConstSetOrQualidentOrFunction := % PushAutoOn %
+ (
+ Qualident
+ [ Constructor |
+ ConstActualParameters % BuildConstFunctionCall %
+ ]
+ | % BuildTypeForConstructor %
+ Constructor
+ ) % PopAuto %
+ =:
ConstAttribute := "__ATTRIBUTE__" "__BUILTIN__" "(" "(" ConstAttributeExpression ")" ")" =:
Alignment := [ ByteAlignment ] =:
-TypeDeclaration := Ident "=" Type Alignment
+TypeDeclaration := % VAR top: CARDINAL ; %
+ % top := Top () %
+ Ident "=" Type Alignment
+ % BlockAssert (top = Top ()) %
=:
Type :=
| ProcedureType ) % PopAuto %
=:
-SimpleType := Qualident [ SubrangeType ] | Enumeration | SubrangeType =:
+SimpleType := % VAR top: CARDINAL ; %
+ % top := Top () %
+ ( Qualident [ SubrangeType ] | Enumeration | SubrangeType )
+ % BlockAssert (top = Top ()) %
+ =:
Enumeration := "("
( IdentList
RecordType := "RECORD" [ DefaultRecordAttributes ] FieldListSequence "END" =:
-DefaultRecordAttributes := '<*' AttributeExpression '*>' =:
+DefaultRecordAttributes := '<*' % PushAutoOn %
+ AttributeExpression % BuildDefaultFieldAlignment %
+ % PopAuto %
+ '*>' =:
RecordFieldPragma := [ '<*' FieldPragmaExpression
- { ',' FieldPragmaExpression } '*>' ] =:
+ { ',' FieldPragmaExpression } '*>' ] =:
-FieldPragmaExpression := % PushAutoOff %
- Ident [ '(' ConstExpression ')' ] % PopAuto %
+FieldPragmaExpression := % PushAutoOn %
+ Ident PragmaConstExpression % BuildPragmaField %
+ % PopAuto %
=:
-AttributeExpression := % PushAutoOff %
- Ident '(' ConstExpression ')' % PopAuto %
- =:
+PragmaConstExpression := ( '(' ConstExpression ')' | % PushT(NulSym) %
+ % Annotate('NulSym||no pragma const') %
+ ) =:
+
+AttributeExpression := Ident '(' ConstExpression ')' =:
FieldListSequence := FieldListStatement { ";" FieldListStatement } =:
Factor := Number | string | SetOrDesignatorOrFunction |
"(" Expression ")" | "NOT" Factor | ConstAttribute =:
--- again Set | Designator causes problems as both has a first symbol, ident or Qualident
+-- again Set | Designator causes problems as both have a first symbol, ident or Qualident
+
+ParseConstructor := "{" [ SilentElement { "," SilentElement } ] "}" =:
+
-SetOrDesignatorOrFunction := ( Qualident [ Constructor |
- SimpleDes [ ActualParameters ]
- ] | Constructor
+SetOrDesignatorOrFunction := % VAR n: CARDINAL ; %
+ % n := Top () %
+ % Assert (NOT IsAutoPushOn ()) %
+ ( Qualident [ ParseConstructor
+ |
+ SilentSimpleDes [ SilentActualParameters ]
+ ] |
+ ParseConstructor
)
+ % Assert (n = Top ()) %
=:
-- SimpleDes := { "." Ident | "[" ExpList "]" | "^" } =:
ProcedureBlock := { Declaration } [ "BEGIN" BlockBody ] "END"
=:
-Block := { Declaration } InitialBlock FinalBlock "END" =:
+Block := % VAR top: CARDINAL ; %
+ % top := Top () %
+ { Declaration } % BlockAssert (top = Top ()) %
+ InitialBlock % BlockAssert (top = Top ()) %
+ FinalBlock % BlockAssert (top = Top ()) %
+ "END" =:
InitialBlock := [ "BEGIN" BlockBody ] =: