vishapoberon/compiler
1
0
Fork 0
mirror of https://github.com/vishapoberon/compiler.git synced 2026-04-06 13:22:26 +00:00
Code Issues Projects Releases Packages Wiki Activity Actions

fixed forceNewSym/Verbose mistake, working on new types relations. -- noch

Browse source
This commit is contained in:
Norayr Chilingarian 2015-03-11 18:49:01 +04:00
parent 747943b008
commit a2e64ff15f
5 changed files with 29 additions and 19 deletions
Download patch file Download diff file Expand all files Collapse all files

34
src/voc/OPB.Mod
View file

@ -155,12 +155,14 @@ MODULE OPB; (* RC 6.3.89 / 21.2.94 *) (* object model 17.1.93 *)
END EmptySet; END EmptySet;
PROCEDURE SetIntType(node: OPT.Node); PROCEDURE SetIntType(node: OPT.Node);
VAR v: LONGINT; VAR v: LONGINT(*SYSTEM.INT64*);
BEGIN v := node^.conval^.intval; BEGIN v := node^.conval^.intval;
IF (OPM.MinSInt <= v) & (v <= OPM.MaxSInt) THEN node^.typ := OPT.sinttyp IF (OPM.MinSInt <= SYSTEM.VAL(LONGINT, v)) & (SYSTEM.VAL(LONGINT, v) <= OPM.MaxSInt) THEN node^.typ := OPT.sinttyp
ELSIF (OPM.MinInt <= v) & (v <= OPM.MaxInt) THEN node^.typ := OPT.inttyp ELSIF (OPM.MinInt <= SYSTEM.VAL(LONGINT, v)) & (SYSTEM.VAL(LONGINT, v) <= OPM.MaxInt) THEN node^.typ := OPT.inttyp
ELSIF (OPM.MinLInt <= v) & (v <= OPM.MaxLInt) (*bootstrap or cross*) THEN ELSIF (OPM.MinLInt <= v) & (v <= OPM.MaxLInt) (*bootstrap or cross*) THEN
node^.typ := OPT.linttyp node^.typ := OPT.linttyp
(*ELSIF (OPM.MinInt64 <= v) & (v <= OPM.MaxInt64) THEN
node^.typ := OPT.int64typ*)
ELSE err(203); node^.typ := OPT.sinttyp; node^.conval^.intval := 1 ELSE err(203); node^.typ := OPT.sinttyp; node^.conval^.intval := 1
END END
END SetIntType; END SetIntType;
@ -510,7 +512,7 @@ MODULE OPB; (* RC 6.3.89 / 21.2.94 *) (* object model 17.1.93 *)
ELSE res := eql ELSE res := eql
END END
ELSE ELSE
OPM.WriteString("/* this should not happen. handle this. OPB.ConstCmp(); -- noch */"); OPM.WriteLn; OPM.LogWStr("/* this should not happen. handle this. OPB.ConstCmp(); -- noch */"); OPM.LogWLn;
END ; END ;
x^.typ := OPT.booltyp; RETURN res x^.typ := OPT.booltyp; RETURN res
END ConstCmp; END ConstCmp;
@ -523,13 +525,13 @@ MODULE OPB; (* RC 6.3.89 / 21.2.94 *) (* object model 17.1.93 *)
IF g = String THEN CharToString(x) IF g = String THEN CharToString(x)
ELSE err(100); y^.typ := x^.typ; yval^ := xval^ ELSE err(100); y^.typ := x^.typ; yval^ := xval^
END ; END ;
| SInt: | SInt(*, Int8*):
IF g IN intSet THEN x^.typ := y^.typ IF g IN intSet THEN x^.typ := y^.typ
ELSIF g = Real THEN x^.typ := OPT.realtyp; xval^.realval := xval^.intval ELSIF g = Real THEN x^.typ := OPT.realtyp; xval^.realval := xval^.intval
ELSIF g = LReal THEN x^.typ := OPT.lrltyp; xval^.realval := xval^.intval ELSIF g = LReal THEN x^.typ := OPT.lrltyp; xval^.realval := xval^.intval
ELSE err(100); y^.typ := x^.typ; yval^ := xval^ ELSE err(100); y^.typ := x^.typ; yval^ := xval^
END END
| Int: | Int(*, Int16, Int32, Int64*):
IF g = SInt THEN y^.typ := OPT.inttyp IF g = SInt THEN y^.typ := OPT.inttyp
ELSIF g IN intSet THEN x^.typ := y^.typ ELSIF g IN intSet THEN x^.typ := y^.typ
ELSIF g = Real THEN x^.typ := OPT.realtyp; xval^.realval := xval^.intval ELSIF g = Real THEN x^.typ := OPT.realtyp; xval^.realval := xval^.intval
@ -685,7 +687,7 @@ MODULE OPB; (* RC 6.3.89 / 21.2.94 *) (* object model 17.1.93 *)
ELSE xval^.intval := BoolToInt(ConstCmp() # lss) ELSE xval^.intval := BoolToInt(ConstCmp() # lss)
END END
ELSE ELSE
OPM.WriteString("/* this should not happen. handle this. OPB.ConstOp(); -- noch */ "); OPM.WriteLn; OPM.LogWStr("this should not happen. handle this. OPB.ConstOp(); -- noch "); OPM.LogWLn;
END END
END ConstOp; END ConstOp;
@ -760,7 +762,7 @@ MODULE OPB; (* RC 6.3.89 / 21.2.94 *) (* object model 17.1.93 *)
CASE z^.typ^.form OF CASE z^.typ^.form OF
Char: Char:
IF z^.class = Nconst THEN CharToString(z) ELSE err(100) END IF z^.class = Nconst THEN CharToString(z) ELSE err(100) END
| SInt: | SInt(*, Int8*):
IF g IN intSet + realSet THEN Convert(z, y^.typ) IF g IN intSet + realSet THEN Convert(z, y^.typ)
ELSE err(100) ELSE err(100)
END END
@ -769,7 +771,7 @@ MODULE OPB; (* RC 6.3.89 / 21.2.94 *) (* object model 17.1.93 *)
ELSIF g IN intSet + realSet THEN Convert(z, y^.typ) ELSIF g IN intSet + realSet THEN Convert(z, y^.typ)
ELSE err(100) ELSE err(100)
END END
| LInt: | LInt(*, Int16, Int32, Int64*):
IF g IN intSet THEN Convert(y, z^.typ) IF g IN intSet THEN Convert(y, z^.typ)
ELSIF g IN realSet THEN Convert(z, y^.typ) ELSIF g IN realSet THEN Convert(z, y^.typ)
ELSE err(100) ELSE err(100)
@ -864,7 +866,7 @@ MODULE OPB; (* RC 6.3.89 / 21.2.94 *) (* object model 17.1.93 *)
ELSIF f # Undef THEN err(94); z^.typ := OPT.undftyp ELSIF f # Undef THEN err(94); z^.typ := OPT.undftyp
END END
| plus: | plus:
IF ~(f IN {Undef, SInt..Set}) THEN err(105); typ := OPT.undftyp END ; IF ~(f IN {Undef, SInt..Set, Int8..Int64}) THEN err(105); typ := OPT.undftyp END ;
do := TRUE; do := TRUE;
IF f IN intSet THEN IF f IN intSet THEN
IF (z^.class = Nconst) & (z^.conval^.intval = 0) THEN do := FALSE; z := y END ; IF (z^.class = Nconst) & (z^.conval^.intval = 0) THEN do := FALSE; z := y END ;
@ -872,7 +874,7 @@ MODULE OPB; (* RC 6.3.89 / 21.2.94 *) (* object model 17.1.93 *)
END ; END ;
IF do THEN NewOp(op, typ, z, y) END IF do THEN NewOp(op, typ, z, y) END
| minus: | minus:
IF ~(f IN {Undef, SInt..Set}) THEN err(106); typ := OPT.undftyp END ; IF ~(f IN {Undef, SInt..Set, Int8..Int64}) THEN err(106); typ := OPT.undftyp END ;
IF ~(f IN intSet) OR (y^.class # Nconst) OR (y^.conval^.intval # 0) THEN NewOp(op, typ, z, y) END IF ~(f IN intSet) OR (y^.class # Nconst) OR (y^.conval^.intval # 0) THEN NewOp(op, typ, z, y) END
| or: | or:
IF f = Bool THEN IF f = Bool THEN
@ -886,17 +888,19 @@ MODULE OPB; (* RC 6.3.89 / 21.2.94 *) (* object model 17.1.93 *)
ELSIF f # Undef THEN err(95); z^.typ := OPT.undftyp ELSIF f # Undef THEN err(95); z^.typ := OPT.undftyp
END END
| eql, neq: | eql, neq:
IF (f IN {Undef..Set, NilTyp, Pointer, ProcTyp}) OR strings(z, y) THEN typ := OPT.booltyp IF (f IN {Undef..Set, NilTyp, Pointer, ProcTyp, Int8..Int64}) OR strings(z, y) THEN typ := OPT.booltyp
ELSE err(107); typ := OPT.undftyp ELSE err(107); typ := OPT.undftyp
END ; END ;
NewOp(op, typ, z, y) NewOp(op, typ, z, y)
| lss, leq, gtr, geq: | lss, leq, gtr, geq:
IF (f IN {Undef, Char..LReal}) OR strings(z, y) THEN typ := OPT.booltyp IF (f IN {Undef, Char..LReal, Int8..Int64}) OR strings(z, y) THEN typ := OPT.booltyp
ELSE err(108); typ := OPT.undftyp ELSE
OPM.LogWStr("ELSE in Op()"); OPM.LogWLn;
err(108); typ := OPT.undftyp
END ; END ;
NewOp(op, typ, z, y) NewOp(op, typ, z, y)
ELSE ELSE
OPM.WriteString(" /* OPB.Op(), not handled case possibility; -- noch */ "); OPM.WriteLn; OPM.LogWStr(" OPB.Op(), not handled case possibility; -- noch"); OPM.LogWLn;
END END
END ; END ;
x := z x := z

4
src/voc/OPM.cmdln.Mod
View file

@ -235,7 +235,7 @@ MODULE OPM; (* RC 6.3.89 / 28.6.89, J.Templ 10.7.89 / 22.7.96 *)
IF mainlinkstat IN glbopt THEN INCL(glbopt, mainprog); mainLinkStat := TRUE ELSE mainLinkStat := FALSE END; IF mainlinkstat IN glbopt THEN INCL(glbopt, mainprog); mainLinkStat := TRUE ELSE mainLinkStat := FALSE END;
IF notcoloroutput IN glbopt THEN notColorOutput := TRUE ELSE notColorOutput := FALSE END; IF notcoloroutput IN glbopt THEN notColorOutput := TRUE ELSE notColorOutput := FALSE END;
IF forcenewsym IN glbopt THEN forceNewSym := TRUE ELSE forceNewSym := FALSE END; IF forcenewsym IN glbopt THEN forceNewSym := TRUE ELSE forceNewSym := FALSE END;
IF verbose IN glbopt THEN Verbose := TRUE ELSE forceNewSym := FALSE END; IF verbose IN glbopt THEN Verbose := TRUE ELSE Verbose := FALSE END;
GetProperties; (* GetProperties moved here in order to call it after ScanOptions because we have an option whether to use par file or not, noch *) GetProperties; (* GetProperties moved here in order to call it after ScanOptions because we have an option whether to use par file or not, noch *)
END; END;
@ -256,7 +256,7 @@ MODULE OPM; (* RC 6.3.89 / 28.6.89, J.Templ 10.7.89 / 22.7.96 *)
IF mainprog IN opt THEN mainProg := TRUE ELSE mainProg := FALSE END; IF mainprog IN opt THEN mainProg := TRUE ELSE mainProg := FALSE END;
IF mainlinkstat IN opt THEN INCL(glbopt, mainprog); mainLinkStat := TRUE ELSE mainLinkStat := FALSE END; IF mainlinkstat IN opt THEN INCL(glbopt, mainprog); mainLinkStat := TRUE ELSE mainLinkStat := FALSE END;
IF forcenewsym IN glbopt THEN forceNewSym := TRUE ELSE forceNewSym := FALSE END; IF forcenewsym IN glbopt THEN forceNewSym := TRUE ELSE forceNewSym := FALSE END;
IF verbose IN glbopt THEN Verbose := TRUE ELSE forceNewSym := FALSE END; IF verbose IN glbopt THEN Verbose := TRUE ELSE Verbose := FALSE END;
END InitOptions; END InitOptions;
PROCEDURE Init*(VAR done: BOOLEAN; VAR mname : ARRAY OF CHAR); (* get the source for one translation *) PROCEDURE Init*(VAR done: BOOLEAN; VAR mname : ARRAY OF CHAR); (* get the source for one translation *)

10
src/voc/OPT.Mod
View file

@ -1000,13 +1000,19 @@ WHILE ref < impCtxt.nofr DO
i := 1; WHILE i < maxImps DO expCtxt.locmno[i] := -1; INC(i) END ; i := 1; WHILE i < maxImps DO expCtxt.locmno[i] := -1; INC(i) END ;
OutObj(topScope^.right); OutObj(topScope^.right);
ext := sfpresent & symExtended; new := ~sfpresent OR symNew; ext := sfpresent & symExtended; new := ~sfpresent OR symNew;
IF OPM.forceNewSym THEN new := TRUE END; (* for bootstrapping -- noch *) IF OPM.forceNewSym THEN
new := TRUE;
OPM.LogWStr("forceNewSym = TRUE"); OPM.LogWLn;
END; (* for bootstrapping -- noch *)
IF OPM.noerr & sfpresent & (impCtxt.reffp # expCtxt.reffp) THEN IF OPM.noerr & sfpresent & (impCtxt.reffp # expCtxt.reffp) THEN
new := TRUE; new := TRUE;
IF ~extsf THEN err(155) END IF ~extsf THEN err(155) END
END ; END ;
newsf := FALSE; symNew := FALSE; (* because of call to FPrintErr from OPL *) newsf := FALSE; symNew := FALSE; (* because of call to FPrintErr from OPL *)
IF ~OPM.noerr OR findpc THEN OPM.DeleteNewSym END IF ~OPM.noerr OR findpc THEN
OPM.DeleteNewSym;
OPM.LogWStr("DeleteNewSym called"); OPM.LogWLn;
END
(* OPM.RegisterNewSym is called in OP2 after writing the object file *) (* OPM.RegisterNewSym is called in OP2 after writing the object file *)
END END
END END

BIN
voc
View file

Binary file not shown.

BIN
vocstatic.linux.gcc.x86_64
View file

Binary file not shown.