aabc2/KOS_qrcodes
1
0
Fork 0
forked from KolibriOS/kolibrios
Code Pull Requests Activity

Oberon07: some extensions

Browse Source 
git-svn-id: svn://kolibrios.org@7107 a494cfbc-eb01-0410-851d-a64ba20cac60
This commit is contained in:
Anton Krotov
2017-11-02 16:36:50 +00:00
parent 5161f3acf0
commit b6bb3d2c62
17 changed files with 698 additions and 538 deletions
Download Patch File Download Diff File Expand all files Collapse all files
programs/develop/oberon07/Source/Compiler.ob07
+262 -217
View File
@@ -1,5 +1,5 @@
(*
Copyright 2016 Anton Krotov
Copyright 2016, 2017 Anton Krotov
This file is part of Compiler.
@@ -52,10 +52,10 @@ CONST
stABS = 1; stODD = 2; stLEN = 3; stLSL = 4; stASR = 5; stROR = 6; stFLOOR = 7; stFLT = 8;
stORD = 9; stCHR = 10; stLONG = 11; stSHORT = 12; stINC = 13; stDEC = 14; stINCL = 15;
stEXCL = 16; stCOPY = 17; stNEW = 18; stASSERT = 19; stPACK = 20; stUNPK = 21; stDISPOSE = 22;
stBITS = 23; stLSR = 24; stLENGTH = 25;
stBITS = 23; stLSR = 24; stLENGTH = 25; stMIN = 26; stMAX = 27;
sysADR = 101; sysSIZE = 102; sysINF = 103; sysGET = 104; sysPUT = 105;
sysCODE = 106; sysTYPEID = 107; sysMOVE = 108;
sysCODE = 106; sysTYPEID = 107; sysMOVE = 108; sysCOPY = 109;
TYPE
@@ -198,11 +198,11 @@ BEGIN
loc := id.Offset
ELSIF (id.VarKind = DECL.paramvar) OR (id.T.tType IN TSTRUCT) THEN
IF DECL.Dim(e.T) > 0 THEN
n := DECL.Dim(e.T);
FOR i := n TO 1 BY -1 DO
X86.LocalAdr(id.Offset + i * 4, bases);
X86.Load(TINTEGER)
END
n := DECL.Dim(e.T);
FOR i := n TO 1 BY -1 DO
X86.LocalAdr(id.Offset + i * 4, bases);
X86.Load(TINTEGER)
END
END;
X86.LocalAdr(id.Offset, bases);
X86.Load(TINTEGER)
@@ -219,9 +219,9 @@ BEGIN
ELSIF id.T.tType = TSTRING THEN
s := DECL.GetString(e.Value);
IF s.Len = 1 THEN
X86.PushConst(ORD(s.Str[0]))
X86.PushConst(ORD(s.Str[0]))
ELSE
X86.PushInt(s.Number)
X86.PushInt(s.Number)
END
END
|IDPROC:
@@ -249,32 +249,32 @@ BEGIN
e.deref := FALSE;
Assert2(e.T.tType IN TOBJECT, 105);
IF e.T.tType = TPOINTER THEN
e.Read := FALSE;
LoadVar;
e.T := e.T.Base;
X86.Load(TINTEGER);
IF ~guard THEN
X86.CheckNIL
END
e.Read := FALSE;
LoadVar;
e.T := e.T.Base;
X86.Load(TINTEGER);
IF ~guard THEN
X86.CheckNIL
END
END;
NextCheck(lxIDENT);
Coord(coord);
name := SCAN.id;
T := e.T;
REPEAT
f := DECL.GetField(T, name);
T := T.Base
f := DECL.GetField(T, name);
T := T.Base
UNTIL (f # NIL) OR (T = NIL);
Assert(f # NIL, coord, 99);
IF f.Unit # DECL.unit THEN
Assert(f.Export, coord, 99)
Assert(f.Export, coord, 99)
END;
IF glob # -1 THEN
glob := glob + f.Offset
glob := glob + f.Offset
ELSIF loc # -1 THEN
loc := loc + f.Offset
loc := loc + f.Offset
ELSE
X86.Field(f.Offset)
X86.Field(f.Offset)
END;
e.T := f.T;
e.vparam := FALSE;
@@ -283,29 +283,29 @@ BEGIN
|lxLSquare:
LoadVar;
REPEAT
Assert2(e.T.tType = TARRAY, 102);
NextCoord(coord);
pExpr(e1);
IntType(e1.T, coord);
Load(e1);
IF e.T.Len = 0 THEN
BaseT := DECL.OpenBase(e.T);
X86.PushConst(BaseT.Size);
X86.OpenIdx(DECL.Dim(e.T))
ELSE
IF e1.eType = eCONST THEN
idx := FLOOR(e1.Value);
Assert((idx >= 0) & (idx < e.T.Len), coord, 159);
IF e.T.Base.Size # 1 THEN
X86.Drop;
X86.PushConst(e.T.Base.Size * idx)
END;
X86.Idx
ELSE
X86.FixIdx(e.T.Len, e.T.Base.Size)
END
END;
e.T := e.T.Base
Assert2(e.T.tType = TARRAY, 102);
NextCoord(coord);
pExpr(e1);
IntType(e1.T, coord);
Load(e1);
IF e.T.Len = 0 THEN
BaseT := DECL.OpenBase(e.T);
X86.PushConst(BaseT.Size);
X86.OpenIdx(DECL.Dim(e.T))
ELSE
IF e1.eType = eCONST THEN
idx := FLOOR(e1.Value);
Assert((idx >= 0) & (idx < e.T.Len), coord, 159);
IF e.T.Base.Size # 1 THEN
X86.Drop;
X86.PushConst(e.T.Base.Size * idx)
END;
X86.Idx
ELSE
X86.FixIdx(e.T.Len, e.T.Base.Size)
END
END;
e.T := e.T.Base
UNTIL SCAN.tLex # lxComma;
Check(lxRSquare);
e.vparam := FALSE;
@@ -317,7 +317,7 @@ BEGIN
e.Read := FALSE;
X86.Load(TINTEGER);
IF ~guard THEN
X86.CheckNIL
X86.CheckNIL
END;
e.T := e.T.Base;
e.vparam := FALSE;
@@ -327,36 +327,36 @@ BEGIN
|lxLRound:
LoadVar;
IF e.T.tType IN TOBJECT THEN
IF e.T.tType = TRECORD THEN
Assert2(e.vparam, 108)
END;
NextCheck(lxIDENT);
Coord(coord);
T := DECL.IdType(coord);
Assert(T # NIL, coord, 42);
IF e.T.tType = TRECORD THEN
Assert(T.tType = TRECORD, coord, 106)
ELSE
Assert(T.tType = TPOINTER, coord, 107)
END;
Assert(BaseOf(e.T, T), coord, 108);
e.T := T;
Check(lxRRound);
Next;
IF e.T.tType = TPOINTER THEN
IF (SCAN.tLex = lxDot) OR (SCAN.tLex = lxCaret) THEN
X86.DupLoadCheck
ELSE
X86.DupLoad
END;
guard := TRUE;
T := T.Base
ELSE
X86.LocalAdr(e.id.Offset, DECL.unit.Level - e.id.Level)
END;
X86.Guard(T.Number, FALSE)
IF e.T.tType = TRECORD THEN
Assert2(e.vparam, 108)
END;
NextCheck(lxIDENT);
Coord(coord);
T := DECL.IdType(coord);
Assert(T # NIL, coord, 42);
IF e.T.tType = TRECORD THEN
Assert(T.tType = TRECORD, coord, 106)
ELSE
Assert(T.tType = TPOINTER, coord, 107)
END;
Assert(BaseOf(e.T, T), coord, 108);
e.T := T;
Check(lxRRound);
Next;
IF e.T.tType = TPOINTER THEN
IF (SCAN.tLex = lxDot) OR (SCAN.tLex = lxCaret) THEN
X86.DupLoadCheck
ELSE
X86.DupLoad
END;
guard := TRUE;
T := T.Base
ELSE
X86.LocalAdr(e.id.Offset, DECL.unit.Level - e.id.Level)
END;
X86.Guard(T.Number, FALSE)
ELSE
break := TRUE
break := TRUE
END
ELSE
break := TRUE
@@ -393,8 +393,10 @@ BEGIN
pExpr(b);
IntType(b.T, coord);
IF b.eType = eCONST THEN
Assert(ASR(FLOOR(b.Value), 5) = 0, coord, 53);
Assert(a.Value <= b.Value, coord, 54)
Assert(ASR(FLOOR(b.Value), 5) = 0, coord, 53);
IF a.eType = eCONST THEN
Assert(a.Value <= b.Value, coord, 54)
END
END;
Load(b)
ELSE
@@ -547,10 +549,10 @@ BEGIN
Load(e1);
IF e1.eType = eCONST THEN
IF e1.T.tType = TSTRING THEN
str := DECL.GetString(e1.Value);
e.Value := LONG(FLT(ORD(str.Str[0])))
str := DECL.GetString(e1.Value);
e.Value := LONG(FLT(ORD(str.Str[0])))
ELSE
e.Value := e1.Value
e.Value := e1.Value
END;
e.eType := eCONST
END;
@@ -606,8 +608,8 @@ BEGIN
IF e1.T.tType = TSTRING THEN
str := DECL.GetString(e1.Value);
IF str.Len = 1 THEN
X86.Mono(str.Number);
X86.StrMono
X86.Mono(str.Number);
X86.StrMono
END;
e.Value := LONG(FLT(LENGTH(str.Str)));
e.eType := eCONST
@@ -615,13 +617,39 @@ BEGIN
Str(e1);
e.T := inttype;
X86.StFunc(X86.stLENGTH)
|stMIN, stMAX:
pExpr(e1);
IntType(e1.T, coord);
Load(e1);
Check(lxComma);
NextCoord(coord);
pExpr(e2);
IntType(e2.T, coord);
Load(e2);
IF (e1.eType = eCONST) & (e2.eType = eCONST) THEN
a := FLOOR(e1.Value);
b := FLOOR(e2.Value);
CASE func OF
|stMIN: a := MIN(a, b)
|stMAX: a := MAX(a, b)
ELSE
END;
e.Value := LONG(FLT(a));
e.eType := eCONST
END;
IF func = stMIN THEN
X86.StFunc(X86.stMIN)
ELSE
X86.StFunc(X86.stMAX)
END;
e.T := inttype
|sysADR:
Assert((SCAN.tLex = lxIDENT) OR (SCAN.tLex = lxSTRING) OR (SCAN.tLex = lxCHX), coord, 43);
IF SCAN.tLex = lxIDENT THEN
Designator(e1);
Assert((e1.eType = eVAR) OR (e1.eType = ePROC) OR (e1.T = strtype), coord, 43);
IF e1.eType = ePROC THEN
X86.PushInt(e1.id.Number)
X86.PushInt(e1.id.Number)
END
ELSE
pFactor(e1)
@@ -629,8 +657,8 @@ BEGIN
IF e1.T = strtype THEN
str := DECL.GetString(e1.Value);
IF str.Len = 1 THEN
X86.Drop;
X86.PushInt(str.Number)
X86.Drop;
X86.PushInt(str.Number)
END
END;
e.T := inttype;
@@ -645,7 +673,7 @@ BEGIN
e.T := inttype;
Assert(T.tType IN TOBJECT, coord, 47);
IF T.tType = TPOINTER THEN
T := T.Base
T := T.Base
END;
e.Value := LONG(FLT(T.Number));
X86.PushConst(T.Number)
@@ -676,9 +704,9 @@ VAR sp: INTEGER; stk: ARRAY 100, 2 OF DECL.pTYPE;
VAR Res: BOOLEAN;
BEGIN
IF (T1.tType = TARRAY) & (T2.tType = TARRAY) & (T1.Len = 0) & (T2.Len = 0) THEN
Res := TypeComp(T1.Base, T2.Base)
Res := TypeComp(T1.Base, T2.Base)
ELSE
Res := ProcTypeComp1(T1, T2)
Res := ProcTypeComp1(T1, T2)
END
RETURN Res
END TypeComp;
@@ -689,8 +717,8 @@ VAR sp: INTEGER; stk: ARRAY 100, 2 OF DECL.pTYPE;
i := 0;
res := FALSE;
WHILE (i < sp) & ~res DO
res := ((stk[i][0] = T1) & (stk[i][1] = T2)) OR ((stk[i][0] = T2) & (stk[i][1] = T1));
INC(i)
res := ((stk[i][0] = T1) & (stk[i][1] = T2)) OR ((stk[i][0] = T2) & (stk[i][1] = T1));
INC(i)
END
RETURN res
END Check;
@@ -703,16 +731,16 @@ VAR sp: INTEGER; stk: ARRAY 100, 2 OF DECL.pTYPE;
Res := TRUE
ELSE
IF (T1.tType = TPROC) & (T2.tType = TPROC) & (T1 # T2) THEN
Res := (T1.Call = T2.Call) & (T1.Fields.Count = T2.Fields.Count) & ProcTypeComp1(T1.Base, T2.Base);
fp := T1.Fields.First(DECL.FIELD);
ft := T2.Fields.First(DECL.FIELD);
WHILE Res & (fp # NIL) DO
Res := (fp.ByRef = ft.ByRef) & TypeComp(fp.T, ft.T);
fp := fp.Next(DECL.FIELD);
ft := ft.Next(DECL.FIELD)
END
Res := (T1.Call = T2.Call) & (T1.Fields.Count = T2.Fields.Count) & ProcTypeComp1(T1.Base, T2.Base);
fp := T1.Fields.First(DECL.FIELD);
ft := T2.Fields.First(DECL.FIELD);
WHILE Res & (fp # NIL) DO
Res := (fp.ByRef = ft.ByRef) & TypeComp(fp.T, ft.T);
fp := fp.Next(DECL.FIELD);
ft := ft.Next(DECL.FIELD)
END
ELSE
Res := T1 = T2
Res := T1 = T2
END
END;
DEC(sp)
@@ -750,25 +778,25 @@ BEGIN
|TARRAY:
IF param THEN
IF T.Len = 0 THEN
IF (T.Base.tType = TCHAR) & (e.T.tType = TSTRING) THEN
Res := TRUE
ELSE
Res := ArrComp(e.T, T)
END
IF (T.Base.tType = TCHAR) & (e.T.tType = TSTRING) THEN
Res := TRUE
ELSE
Res := ArrComp(e.T, T)
END
ELSE
IF (T.Base.tType = TCHAR) & (e.T.tType = TSTRING) THEN
Res := LenString(e.Value) <= T.Len
ELSE
Res := e.T = T
END
IF (T.Base.tType = TCHAR) & (e.T.tType = TSTRING) THEN
Res := LenString(e.Value) <= T.Len
ELSE
Res := e.T = T
END
END
ELSE
IF T.Len = 0 THEN
Res := FALSE
Res := FALSE
ELSIF (T.Base.tType = TCHAR) & (e.T.tType = TSTRING) THEN
Res := LenString(e.Value) <= T.Len
Res := LenString(e.Value) <= T.Len
ELSE
Res := e.T = T
Res := e.T = T
END
END
|TRECORD: Res := BaseOf(T, e.T)
@@ -789,17 +817,17 @@ BEGIN
CASE T.tType OF
|TINTEGER, TREAL, TLONGREAL, TCHAR,
TSET, TBOOLEAN, TPOINTER, TCARD16:
Res := e.T = T
Res := e.T = T
|TARRAY:
IF T.Len > 0 THEN
Res := e.T = T
ELSE
Res := ArrComp(e.T, T)
END
IF T.Len > 0 THEN
Res := e.T = T
ELSE
Res := ArrComp(e.T, T)
END
|TRECORD:
Res := BaseOf(T, e.T)
Res := BaseOf(T, e.T)
|TPROC:
Res := ProcTypeComp(e.T, T)
Res := ProcTypeComp(e.T, T)
ELSE
END
ELSE
@@ -826,12 +854,12 @@ BEGIN
END;
IF param.ByRef & (e1.T.tType = TRECORD) THEN
IF e1.vparam THEN
X86.LocalAdr(e1.id.Offset - 4, DECL.unit.Level - e1.id.Level);
X86.Load(TINTEGER)
X86.LocalAdr(e1.id.Offset - 4, DECL.unit.Level - e1.id.Level);
X86.Load(TINTEGER)
ELSIF e1.deref THEN
X86.DerefType(0)
X86.DerefType(0)
ELSE
X86.PushConst(e1.T.Number)
X86.PushConst(e1.T.Number)
END
END;
IF ~param.ByRef & (param.T.tType IN TFLOAT) THEN
@@ -840,24 +868,24 @@ BEGIN
IF (e1.T.tType = TSTRING) & (param.T.tType = TARRAY) THEN
s := DECL.GetString(e1.Value);
IF s.Len = 1 THEN
X86.Mono(s.Number)
X86.Mono(s.Number)
END;
IF param.T.Len = 0 THEN
A[0] := s.Len + 1;
X86.OpenArray(A, 1)
A[0] := s.Len + 1;
X86.OpenArray(A, 1)
END
END;
IF (e1.T.tType = TARRAY) & (DECL.Dim(param.T) > DECL.Dim(e1.T)) THEN
n := DECL.Dim(param.T) - DECL.Dim(e1.T);
TA := DECL.OpenBase(e1.T);
FOR i := 0 TO n - 1 DO
A[i] := TA.Len;
TA := TA.Base
A[i] := TA.Len;
TA := TA.Base
END;
IF DECL.Dim(e1.T) = 0 THEN
X86.OpenArray(A, n)
X86.OpenArray(A, n)
ELSE
X86.ExtArray(A, n, DECL.Dim(e1.T))
X86.ExtArray(A, n, DECL.Dim(e1.T))
END
END;
param := param.Next(DECL.FIELD);
@@ -881,24 +909,24 @@ BEGIN
Designator(e);
IF e.eType = ePROC THEN
IF SCAN.tLex = lxLRound THEN
Assert2(e.id.T.Base.tType # TVOID, 73);
Next;
X86.PushCall(begcall);
Call(e.id.T.Fields.First(DECL.FIELD));
X86.EndCall;
e.eType := eEXP;
e.T := e.id.T.Base;
IF e.id.Level = 3 THEN
ccall := 0
ELSIF e.id.Level > DECL.curBlock.Level THEN
ccall := 1
ELSE
ccall := 2
END;
X86.Call(e.id.Number, TRUE, e.T.tType IN TFLOAT, e.id.T.Call, ccall, e.id.Level - 3,
DECL.curBlock.Level - 3, e.id.ParamSize, DECL.curBlock.LocalSize)
Assert2(e.id.T.Base.tType # TVOID, 73);
Next;
X86.PushCall(begcall);
Call(e.id.T.Fields.First(DECL.FIELD));
X86.EndCall;
e.eType := eEXP;
e.T := e.id.T.Base;
IF e.id.Level = 3 THEN
ccall := 0
ELSIF e.id.Level > DECL.curBlock.Level THEN
ccall := 1
ELSE
ccall := 2
END;
X86.Call(e.id.Number, TRUE, e.T.tType IN TFLOAT, e.id.T.Call, ccall, e.id.Level - 3,
DECL.curBlock.Level - 3, e.id.ParamSize, DECL.curBlock.LocalSize)
ELSE
X86.PushInt(e.id.Number)
X86.PushInt(e.id.Number)
END
ELSIF (e.eType = eVAR) & (e.T.tType = TPROC) & (SCAN.tLex = lxLRound) THEN
Assert2(e.T.Base.tType # TVOID, 73);
@@ -934,9 +962,9 @@ BEGIN
e.Value := LONG(FLT(p));
s := DECL.GetString(e.Value);
IF s.Len = 1 THEN
X86.PushConst(ORD(s.Str[0]))
X86.PushConst(ORD(s.Str[0]))
ELSE
X86.PushInt(s.Number)
X86.PushInt(s.Number)
END
ELSE
str2 := DECL.AddMono(SCAN.vCHX);
@@ -1037,17 +1065,17 @@ BEGIN
Assert(m # 0, coord, 48);
n := log2(m);
IF n = -1 THEN
X86.idivmod(Op = lxMOD)
X86.idivmod(Op = lxMOD)
ELSE
X86.Drop;
IF Op = lxMOD THEN
n := ORD(-BITS(LSL(-1, n)));
X86.PushConst(n);
X86.Set(lxMult)
ELSE
X86.PushConst(n);
X86.StFunc(X86.stASR)
END
X86.Drop;
IF Op = lxMOD THEN
n := ORD(-BITS(LSL(-1, n)));
X86.PushConst(n);
X86.Set(lxMult)
ELSE
X86.PushConst(n);
X86.StFunc(X86.stASR)
END
END
ELSE
X86.idivmod(Op = lxMOD)
@@ -1146,9 +1174,9 @@ BEGIN
IF (uOp = lxMinus) & (e.eType = eCONST) THEN
CASE e.T.tType OF
|TINTEGER:
Assert(e.Value # LONG(FLT(SCAN.minINT)), ucoord, DECL.IOVER)
Assert(e.Value # LONG(FLT(SCAN.minINT)), ucoord, DECL.IOVER)
|TSET:
e.Value := -LONG(FLT(ORD(-BITS(FLOOR(e.Value)))))
e.Value := -LONG(FLT(ORD(-BITS(FLOOR(e.Value)))))
ELSE
END;
e.Value := -e.Value
@@ -1189,25 +1217,25 @@ BEGIN
IF Op = lxIS THEN
Assert(e.T.tType IN TOBJECT, coord, 37);
IF e.T.tType = TRECORD THEN
Assert(e.vparam, coord, 37)
Assert(e.vparam, coord, 37)
END;
Check(lxIDENT);
Coord(coord2);
T := DECL.IdType(coord2);
Assert(T # NIL, coord2, 42);
IF e.T.tType = TRECORD THEN
Assert(T.tType = TRECORD, coord2, 106)
Assert(T.tType = TRECORD, coord2, 106)
ELSE
Assert(T.tType = TPOINTER, coord2, 107)
Assert(T.tType = TPOINTER, coord2, 107)
END;
Assert(BaseOf(e.T, T), coord, 37);
IF e.T.tType = TRECORD THEN
X86.Drop;
X86.LocalAdr(e.id.Offset, DECL.unit.Level - e.id.Level)
X86.Drop;
X86.LocalAdr(e.id.Offset, DECL.unit.Level - e.id.Level)
END;
Load(e);
IF e.T.tType = TPOINTER THEN
T := T.Base
T := T.Base
END;
X86.Guard(T.Number, TRUE);
e.T := booltype;
@@ -1228,16 +1256,16 @@ BEGIN
IF ~DECL.Const THEN
CASE e.T.tType OF
|TREAL, TLONGREAL:
X86.PushFlt(e.Value)
X86.PushFlt(e.Value)
|TINTEGER, TSET, TBOOLEAN, TNIL:
X86.PushConst(FLOOR(e.Value))
X86.PushConst(FLOOR(e.Value))
|TSTRING:
s := DECL.GetString(e.Value);
IF s.Len = 1 THEN
X86.PushConst(ORD(s.Str[0]))
ELSE
X86.PushInt(s.Number)
END
s := DECL.GetString(e.Value);
IF s.Len = 1 THEN
X86.PushConst(ORD(s.Str[0]))
ELSE
X86.PushInt(s.Number)
END
ELSE
END
END
@@ -1468,32 +1496,32 @@ BEGIN
iValue := FLOOR(Value);
Assert(iValue # 0, coord, 122);
IF iValue < 0 THEN
IF proc = stINC THEN
proc := stDEC
ELSE
proc := stINC
END;
iValue := -iValue
IF proc = stINC THEN
proc := stDEC
ELSE
proc := stINC
END;
iValue := -iValue
END;
IF iValue # 1 THEN
X86.PushConst(iValue);
IF proc = stDEC THEN
X86.StProc(X86.stDEC)
ELSE
X86.StProc(X86.stINC)
END
X86.PushConst(iValue);
IF proc = stDEC THEN
X86.StProc(X86.stDEC)
ELSE
X86.StProc(X86.stINC)
END
ELSE
IF proc = stDEC THEN
X86.StProc(X86.stDEC1)
ELSE
X86.StProc(X86.stINC1)
END
IF proc = stDEC THEN
X86.StProc(X86.stDEC1)
ELSE
X86.StProc(X86.stINC1)
END
END
ELSE
IF proc = stDEC THEN
X86.StProc(X86.stDEC1)
X86.StProc(X86.stDEC1)
ELSE
X86.StProc(X86.stINC1)
X86.StProc(X86.stINC1)
END
END
|stINCL, stEXCL:
@@ -1521,8 +1549,8 @@ BEGIN
IF e1.T.tType = TSTRING THEN
str := DECL.GetString(e1.Value);
IF str.Len = 1 THEN
X86.Mono(str.Number);
X86.StrMono
X86.Mono(str.Number);
X86.StrMono
END
END;
Str(e1);
@@ -1571,18 +1599,18 @@ BEGIN
Assert(e2.T.tType = TINTEGER, coord, 128);
Assert(~e2.Read, coord, 115);
IF e1.T.tType = TLONGREAL THEN
X86.StProc(X86.stUNPK)
X86.StProc(X86.stUNPK)
ELSE
X86.StProc(X86.stUNPK1)
X86.StProc(X86.stUNPK1)
END
ELSE
Expr(e2);
IntType(e2.T, coord);
Load(e2);
IF e1.T.tType = TLONGREAL THEN
X86.StProc(X86.stPACK)
X86.StProc(X86.stPACK)
ELSE
X86.StProc(X86.stPACK1)
X86.StProc(X86.stPACK1)
END
END
|sysPUT, sysGET:
@@ -1606,9 +1634,9 @@ BEGIN
Expr(e2);
Assert(~(e2.T.tType IN TSTRUCT), coord, 90);
IF e2.T.tType = TSTRING THEN
Assert(LenString(e2.Value) = 1, coord, 94)
Assert(LenString(e2.Value) = 1, coord, 94)
ELSIF e2.T.tType = TVOID THEN
e2.T := inttype
e2.T := inttype
END;
Load(e2);
X86.Save(e2.T.tType)
@@ -1636,12 +1664,29 @@ BEGIN
Expr(e1);
IntType(e1.T, coord);
Load(e1);
|sysCOPY:
begcall := X86.current;
Designator(e1);
Assert(e1.eType = eVAR, coord, 63);
Check(lxComma);
X86.PushCall(begcall);
X86.Param;
NextCoord(coord);
Designator(e1);
Assert(e1.eType = eVAR, coord, 63);
Assert(~e1.Read, coord, 115);
Check(lxComma);
X86.EndCall;
NextCoord(coord);
Expr(e1);
IntType(e1.T, coord);
Load(e1);
ELSE
Assert(FALSE, coord2, 132)
END;
Check(lxRRound);
Next;
IF proc = sysMOVE THEN
IF (proc = sysMOVE) OR (proc = sysCOPY) THEN
X86.StProc(X86.sysMOVE)
END
END StProc;
@@ -1664,21 +1709,21 @@ BEGIN
X86.PushConst(e1.T.Size);
X86.PushConst(e1.T.Number);
IF e1.vparam THEN
X86.LocalAdr(e1.id.Offset - 4, DECL.unit.Level - e1.id.Level);
X86.Load(TINTEGER)
X86.LocalAdr(e1.id.Offset - 4, DECL.unit.Level - e1.id.Level);
X86.Load(TINTEGER)
ELSIF e1.deref THEN
X86.DerefType(12)
X86.DerefType(12)
ELSE
X86.PushConst(e1.T.Number)
X86.PushConst(e1.T.Number)
END
ELSIF e2.T.tType = TARRAY THEN
X86.PushConst(e2.T.Size)
ELSIF (e2.T.tType = TSTRING) & (e1.T.tType = TARRAY) THEN
s := DECL.GetString(e2.Value);
IF s.Len = 1 THEN
X86.Mono(s.Number)
X86.Mono(s.Number)
END;
X86.PushConst(UTILS.min(s.Len + 1, e1.T.Len))
X86.PushConst(MIN(s.Len + 1, e1.T.Len))
END;
X86.Save(e1.T.tType)
ELSIF e1.eType = ePROC THEN
@@ -1718,7 +1763,7 @@ BEGIN
Assert(AssComp(e2, e1.T, FALSE), coord, 131);
Assert(~((e2.eType = ePROC) & (e2.id.Level > 3)), coord, 116);
IF e2.eType = eVAR THEN
X86.Load(TPROC)
X86.Load(TPROC)
END;
X86.Save(TPROC)
ELSE
@@ -1779,19 +1824,19 @@ VAR SelfName, SelfPath, CName, CExt, FName, Path, StdPath,
PROCEDURE hexdgt(c: CHAR): BOOLEAN;
RETURN ("0" <= c) & (c <= "9") OR
("A" <= c) & (c <= "F") OR
("a" <= c) & (c <= "f")
("A" <= c) & (c <= "F") OR
("a" <= c) & (c <= "f")
END hexdgt;
PROCEDURE hex(c: CHAR): INTEGER;
VAR res: INTEGER;
BEGIN
IF ("0" <= c) & (c <= "9") THEN
res := ORD(c) - ORD("0")
res := ORD(c) - ORD("0")
ELSIF ("A" <= c) & (c <= "F") THEN
res := ORD(c) - ORD("A") + 10
res := ORD(c) - ORD("A") + 10
ELSIF ("a" <= c) & (c <= "f") THEN
res := ORD(c) - ORD("a") + 10
res := ORD(c) - ORD("a") + 10
END
RETURN res
END hex;
programs/develop/oberon07/Source/DECL.ob07
+150 -138
View File
@@ -1,5 +1,5 @@
(*
Copyright 2016 Anton Krotov
Copyright 2016, 2017 Anton Krotov
This file is part of Compiler.
@@ -43,10 +43,10 @@ CONST
stABS = 1; stODD = 2; stLEN = 3; stLSL = 4; stASR = 5; stROR = 6; stFLOOR = 7; stFLT = 8;
stORD = 9; stCHR = 10; stLONG = 11; stSHORT = 12; stINC = 13; stDEC = 14; stINCL = 15;
stEXCL = 16; stCOPY = 17; stNEW = 18; stASSERT = 19; stPACK = 20; stUNPK = 21; stDISPOSE = 22;
stBITS = 23; stLSR = 24; stLENGTH = 25;
stBITS = 23; stLSR = 24; stLENGTH = 25; stMIN = 26; stMAX = 27;
sysADR = 101; sysSIZE = 102; sysINF = 103; sysGET = 104; sysPUT = 105;
sysCODE = 106; sysTYPEID = 107; sysMOVE = 108;
sysCODE = 106; sysTYPEID = 107; sysMOVE = 108; sysCOPY = 109;
TINTEGER = 1; TREAL = 2; TLONGREAL = 3; TCHAR = 4; TSET = 5; TBOOLEAN = 6; TVOID = 7; TNIL = 8;
TCARD16 = 9; TSTRING = 10; TARRAY = 11; TRECORD = 12; TPOINTER = 13; TPROC = 14;
@@ -261,25 +261,25 @@ VAR code: INTEGER;
BEGIN
IF SCAN.tLex # key THEN
CASE key OF
|lxMODULE: code := 21
|lxIDENT: code := 22
|lxSemi: code := 23
|lxEND: code := 24
|lxDot: code := 25
|lxEQ: code := 35
|lxRRound: code := 38
|lxTO: code := 40
|lxOF: code := 41
|lxRCurly: code := 51
|lxLRound: code := 56
|lxComma: code := 61
|lxTHEN: code := 98
|lxMODULE: code := 21
|lxIDENT: code := 22
|lxSemi: code := 23
|lxEND: code := 24
|lxDot: code := 25
|lxEQ: code := 35
|lxRRound: code := 38
|lxTO: code := 40
|lxOF: code := 41
|lxRCurly: code := 51
|lxLRound: code := 56
|lxComma: code := 61
|lxTHEN: code := 98
|lxRSquare: code := 109
|lxDO: code := 118
|lxUNTIL: code := 119
|lxAssign: code := 120
|lxRETURN: code := 124
|lxColon: code := 157
|lxDO: code := 118
|lxUNTIL: code := 119
|lxAssign: code := 120
|lxRETURN: code := 124
|lxColon: code := 157
ELSE
END;
Assert2(FALSE, code)
@@ -386,37 +386,39 @@ END PushSysType;
PROCEDURE StIdent;
BEGIN
Guard;
PushStProc("ABS", stABS);
PushStProc("ASR", stASR);
PushStProc("ASSERT", stASSERT);
PushStProc("ABS", stABS);
PushStProc("ASR", stASR);
PushStProc("ASSERT", stASSERT);
PushStType("BOOLEAN", TBOOLEAN);
PushStType("CHAR", TCHAR);
PushStProc("CHR", stCHR);
PushStProc("COPY", stCOPY);
PushStProc("DEC", stDEC);
PushStType("CHAR", TCHAR);
PushStProc("CHR", stCHR);
PushStProc("COPY", stCOPY);
PushStProc("DEC", stDEC);
PushStProc("DISPOSE", stDISPOSE);
PushStProc("EXCL", stEXCL);
PushStProc("FLOOR", stFLOOR);
PushStProc("FLT", stFLT);
PushStProc("INC", stINC);
PushStProc("INCL", stINCL);
PushStProc("EXCL", stEXCL);
PushStProc("FLOOR", stFLOOR);
PushStProc("FLT", stFLT);
PushStProc("INC", stINC);
PushStProc("INCL", stINCL);
PushStType("INTEGER", TINTEGER);
PushStProc("LEN", stLEN);
PushStProc("LSL", stLSL);
PushStProc("LONG", stLONG);
PushStProc("LEN", stLEN);
PushStProc("LSL", stLSL);
PushStProc("LONG", stLONG);
PushStType("LONGREAL", TLONGREAL);
PushStProc("NEW", stNEW);
PushStProc("ODD", stODD);
PushStProc("ORD", stORD);
PushStProc("PACK", stPACK);
PushStType("REAL", TREAL);
PushStProc("ROR", stROR);
PushStType("SET", TSET);
PushStProc("SHORT", stSHORT);
PushStProc("UNPK", stUNPK);
PushStProc("BITS", stBITS);
PushStProc("LSR", stLSR);
PushStProc("LENGTH", stLENGTH);
PushStProc("NEW", stNEW);
PushStProc("ODD", stODD);
PushStProc("ORD", stORD);
PushStProc("PACK", stPACK);
PushStType("REAL", TREAL);
PushStProc("ROR", stROR);
PushStType("SET", TSET);
PushStProc("SHORT", stSHORT);
PushStProc("UNPK", stUNPK);
PushStProc("BITS", stBITS);
PushStProc("LSR", stLSR);
PushStProc("LENGTH", stLENGTH);
PushStProc("MIN", stMIN);
PushStProc("MAX", stMAX);
Guard
END StIdent;
@@ -428,9 +430,9 @@ BEGIN
WHILE (cur # NIL) & (cur.iType # IDGUARD) DO
IF cur.Name = Name THEN
IF (Unit # unit) & ~cur.Export THEN
res := NIL
res := NIL
ELSE
res := cur
res := cur
END;
cur := NIL
ELSE
@@ -533,9 +535,9 @@ BEGIN
Res := Arith(a, b, Ta, Op, coord)
ELSIF Ta.tType = TSET THEN
CASE Op OF
|lxPlus: Res := LONG(FLT(ORD(BITS(ai) + BITS(bi))))
|lxPlus: Res := LONG(FLT(ORD(BITS(ai) + BITS(bi))))
|lxMinus: Res := LONG(FLT(ORD(BITS(ai) - BITS(bi))))
|lxMult: Res := LONG(FLT(ORD(BITS(ai) * BITS(bi))))
|lxMult: Res := LONG(FLT(ORD(BITS(ai) * BITS(bi))))
|lxSlash: Res := LONG(FLT(ORD(BITS(ai) / BITS(bi))))
ELSE
END
@@ -636,23 +638,23 @@ BEGIN
NamePtrBase := Name;
id := GetQIdent(Unit, Name);
IF Unit # unit THEN
Assert2(id # NIL, 42);
Assert2(id.iType = IDTYPE, 77);
Coord(coord);
Next;
Res := id.T
Assert2(id # NIL, 42);
Assert2(id.iType = IDTYPE, 77);
Coord(coord);
Next;
Res := id.T
ELSE
IF id = NIL THEN
Assert2((unit.Level = 3) & unit.typedecl, 42);
Coord(coord);
Next;
Res := NIL
ELSE
Assert2(id.iType = IDTYPE, 77);
Coord(coord);
Next;
Res := id.T
END
IF id = NIL THEN
Assert2((unit.Level = 3) & unit.typedecl, 42);
Coord(coord);
Next;
Res := NIL
ELSE
Assert2(id.iType = IDTYPE, 77);
Coord(coord);
Next;
Res := id.T
END
END
ELSE
Assert2(FALSE, 77)
@@ -689,21 +691,21 @@ BEGIN
cur.T := Tf;
IF Rec THEN
IF Tf.Align > Tr.Align THEN
Tr.Align := Tf.Align
Tr.Align := Tf.Align
END;
IF Tr.Rec = record THEN
cur.Offset := FieldOffset(Tf.Align, Tr.Size);
Assert2(cur.Offset <= SCAN.maxINT - Tf.Size, 83);
Tr.Size := cur.Offset + Tf.Size
cur.Offset := FieldOffset(Tf.Align, Tr.Size);
Assert2(cur.Offset <= SCAN.maxINT - Tf.Size, 83);
Tr.Size := cur.Offset + Tf.Size
ELSIF Tr.Rec = noalign THEN
cur.Offset := FieldOffset(1, Tr.Size);
Assert2(cur.Offset <= SCAN.maxINT - Tf.Size, 83);
Tr.Size := cur.Offset + Tf.Size
cur.Offset := FieldOffset(1, Tr.Size);
Assert2(cur.Offset <= SCAN.maxINT - Tf.Size, 83);
Tr.Size := cur.Offset + Tf.Size
ELSIF Tr.Rec = union THEN
IF Tf.Size > Tr.Size THEN
Tr.Size := Tf.Size
END;
cur.Offset := 0
IF Tf.Size > Tr.Size THEN
Tr.Size := Tf.Size
END;
cur.Offset := 0
END
ELSE
Tr.Len := Tr.Len + 4 * (ORD((Tf.tType = TRECORD) & cur.ByRef) + Dim(Tf) + ORD((Tf.tType = TLONGREAL) & ~cur.ByRef) + 1)
@@ -734,7 +736,7 @@ BEGIN
field := GetField(T, Name);
IF field # NIL THEN
IF (field.Unit = unit) OR field.Export THEN
res := FALSE
res := FALSE
END
END;
T := T.Base
@@ -744,7 +746,7 @@ END Unique;
PROCEDURE notrecurs(id: BOOLEAN; T: pTYPE): BOOLEAN;
RETURN ~(id & (unit.Idents.Last(IDENT).iType = IDTYPE) & (unit.Idents.Last(IDENT).T = T) &
(T.tType IN TSTRUCT))
(T.tType IN TSTRUCT))
END notrecurs;
PROCEDURE ReadFields(T: pTYPE);
@@ -776,9 +778,9 @@ BEGIN
Assert(notrecurs(id_T, Tf), coord, 96);
SetFields(T, Tf, TRUE);
IF SCAN.tLex = lxSemi THEN
NextCheck(lxIDENT)
NextCheck(lxIDENT)
ELSE
Assert2(SCAN.tLex = lxEND, 86)
Assert2(SCAN.tLex = lxEND, 86)
END
ELSE
Assert2(FALSE, 85)
@@ -819,9 +821,9 @@ BEGIN
ProgSize := ProgSize + UTILS.Align(ProgSize)
ELSE
IF cur.VarKind = 0 THEN
cur.Offset := curBlock.ParamSize - curBlock.VarSize - n
cur.Offset := curBlock.ParamSize - curBlock.VarSize - n
ELSE
cur.Offset := curBlock.VarSize - 8 + 4 * (cur.Level + ORD((cur.VarKind = paramvar) & (T.tType = TRECORD)))
cur.Offset := curBlock.VarSize - 8 + 4 * (cur.Level + ORD((cur.VarKind = paramvar) & (T.tType = TRECORD)))
END
END;
Assert2(curBlock.VarSize <= SCAN.maxINT - n, 93);
@@ -901,9 +903,9 @@ BEGIN
INC(curBlock.ParamCount);
fp := unit.Idents.Last(IDENT);
IF ByRef THEN
fp.VarKind := paramvar
fp.VarKind := paramvar
ELSE
fp.VarKind := param
fp.VarKind := param
END
END;
Next;
@@ -915,7 +917,7 @@ BEGIN
Assert(Dim(Tf) <= X86.ADIM, coord, 110);
SetFields(T, Tf, FALSE);
IF proc THEN
SetVars(Tf)
SetVars(Tf)
END;
cont := FALSE
ELSE
@@ -932,9 +934,9 @@ BEGIN
REPEAT
Section(T);
IF SCAN.tLex = lxSemi THEN
Next
Next
ELSE
break := TRUE
break := TRUE
END
UNTIL break
END
@@ -1054,6 +1056,9 @@ BEGIN
Check(lxIDENT);
nov.Base := IdType(coord);
Assert(nov.Base # NIL, coord, 42);
IF (nov.Base.tType = TPOINTER) & (nov.Base.Base.tType = TRECORD) THEN
nov.Base := nov.Base.Base
END;
Assert(nov.Base.tType = TRECORD, coord, 80);
Assert(notrecurs(TRUE, nov.Base), coord, 96);
nov.Size := nov.Base.Size;
@@ -1194,10 +1199,16 @@ BEGIN
last := unit.Idents.Last(IDENT);
Check(lxEQ);
Next;
NEW(NewType);
MemErr(NewType = NIL);
last.T := NewType;
T := StructType(FALSE, NewType);
IF SCAN.tLex = lxIDENT THEN
last.T := ParseType(coord)
ELSE
NEW(NewType);
MemErr(NewType = NIL);
last.T := NewType;
T := StructType(FALSE, NewType)
END;
Check(lxSemi);
Next
END
@@ -1210,16 +1221,16 @@ BEGIN
IdentDef;
PushIdent(Name, coord, IDVAR, NIL, NIL, Export, 0);
IF SCAN.tLex = lxComma THEN
NextCheck(lxIDENT)
NextCheck(lxIDENT)
ELSIF SCAN.tLex = lxColon THEN
NextCoord(coord);
T := ParseType(coord);
Assert(T # NIL, coord, 42);
SetVars(T);
Check(lxSemi);
Next
NextCoord(coord);
T := ParseType(coord);
Assert(T # NIL, coord, 42);
SetVars(T);
Check(lxSemi);
Next
ELSE
Assert2(FALSE, 85)
Assert2(FALSE, 85)
END
END
END;
@@ -1237,8 +1248,8 @@ BEGIN
id.Proc := curproc;
IF id.Export & main THEN
IF Platform IN {1, 6} THEN
curproc.used := TRUE;
Assert((Name # SCAN._START) & (Name # SCAN._version), coord, 133)
curproc.used := TRUE;
Assert((Name # SCAN._START) & (Name # SCAN._version), coord, 133)
END;
X86.ProcExport(id.Number, Name, X86.NewLabel())
END;
@@ -1266,7 +1277,7 @@ BEGIN
Expr(e);
Assert(AssComp(e, curBlock.T.Base, FALSE), coord, 125);
IF e.eType = eVAR THEN
X86.Load(e.T.tType)
X86.Load(e.T.tType)
END
ELSE
Assert2(SCAN.tLex # lxRETURN, 123)
@@ -1335,12 +1346,12 @@ VAR cond: INTEGER; coord, namecoord: SCAN.TCoord;
SCAN.Backup(unit.scanner);
COPY(name.Name, FName);
IF ~((~self.Std & pReadModule(Path, FName, UTILS.Ext)) OR pReadModule(Std, FName, UTILS.Ext)) THEN
IF FName = "SYSTEM" THEN
unit := sys;
self.sys := TRUE
ELSE
Assert(FALSE, namecoord, 32)
END
IF FName = "SYSTEM" THEN
unit := sys;
self.sys := TRUE
ELSE
Assert(FALSE, namecoord, 32)
END
END;
SCAN.Recover(self.scanner);
u := unit;
@@ -1363,28 +1374,28 @@ BEGIN
Next;
CASE cond OF
|0: Check(lxIDENT);
name := SCAN.id;
Coord(coord);
Coord(namecoord);
alias := name;
cond := 1
name := SCAN.id;
Coord(coord);
Coord(namecoord);
alias := name;
cond := 1
|1: CASE SCAN.tLex OF
|lxComma: AddUnit(0)
|lxSemi: AddUnit(4); Next
|lxAssign: cond := 2
ELSE
Assert2(FALSE, 28)
END
|lxComma: AddUnit(0)
|lxSemi: AddUnit(4); Next
|lxAssign: cond := 2
ELSE
Assert2(FALSE, 28)
END
|2: Check(lxIDENT);
name := SCAN.id;
Coord(namecoord);
cond := 3
name := SCAN.id;
Coord(namecoord);
cond := 3
|3: CASE SCAN.tLex OF
|lxComma: AddUnit(0)
|lxSemi: AddUnit(4); Next
ELSE
Assert2(FALSE, 29)
END
|lxComma: AddUnit(0)
|lxSemi: AddUnit(4); Next
ELSE
Assert2(FALSE, 29)
END
ELSE
END
END
@@ -1409,14 +1420,15 @@ VAR temp: UNIT;
BEGIN
temp := unit;
Header(SCAN.AddNode("SYSTEM"));
PushSysProc("ADR", sysADR);
PushSysProc("SIZE", sysSIZE);
PushSysProc("ADR", sysADR);
PushSysProc("SIZE", sysSIZE);
PushSysProc("TYPEID", sysTYPEID);
PushSysProc("GET", sysGET);
PushSysProc("PUT", sysPUT);
PushSysProc("CODE", sysCODE);
PushSysProc("MOVE", sysMOVE);
PushSysProc("INF", sysINF);
PushSysProc("GET", sysGET);
PushSysProc("PUT", sysPUT);
PushSysProc("CODE", sysCODE);
PushSysProc("MOVE", sysMOVE);
PushSysProc("COPY", sysCOPY);
PushSysProc("INF", sysINF);
PushSysType("CARD16", TCARD16);
sys := unit;
unit := temp
@@ -1531,7 +1543,7 @@ VAR cur: Proc;
WHILE cur # NIL DO
p := cur.Proc(Proc);
IF ~p.used THEN
ProcHandling(p)
ProcHandling(p)
END;
cur := cur.Next(IDENT)
END;
programs/develop/oberon07/Source/ERRORS.ob07
+2 -2
View File
@@ -1,5 +1,5 @@
(*
Copyright 2016 Anton Krotov
Copyright 2016, 2017 Anton Krotov
This file is part of Compiler.
@@ -200,7 +200,7 @@ BEGIN
| 77: str := "®¦¨¤ «áï ¨¤¥­â¨ä¨ª â®à ⨯ "
| 78: str := "¤«¨­  ⨯ -¬ áᨢ  ¤®«¦­  ¡ëâì ¡®«ìè¥ ­ã«ï"
| 79: str := "®¦¨¤ «®áì 'OF' ¨«¨ ','"
| 80: str := "®¦¨¤ «áï ¨¤¥­â¨ä¨ª â®à ⨯ -§ ¯¨á¨"
| 80: str := "®¦¨¤ «áï ¨¤¥­â¨ä¨ª â®à ⨯ -§ ¯¨á¨ ¨«¨ ⨯ -㪠§ â¥«ï"
| 81: str := "¡ §®¢ë© ⨯ ⨯ -㪠§ â¥«ï ¤®«¦¥­ ¡ëâì § ¯¨áìî"
| 82: str := "⨯ १ã«ìâ â  ¯à®æ¥¤ãàë ­¥ ¬®¦¥â ¡ëâì § ¯¨áìî ¨«¨ ¬ áᨢ®¬"
| 83: str := "à §¬¥à ⨯  ᫨誮¬ ¢¥«¨ª"
programs/develop/oberon07/Source/UTILS.ob07
+7 -15
View File
@@ -1,5 +1,5 @@
(*
Copyright 2016 Anton Krotov
Copyright 2016, 2017 Anton Krotov
This file is part of Compiler.
@@ -28,7 +28,7 @@ CONST
Ext* = ".ob07";
MAX_PATH = 1024;
MAX_PARAM = 1024;
Date* = 1451606400; (* 2016-01-01 *)
Date* = 1509580800; (* 2017-11-02 *)
TYPE
@@ -53,7 +53,7 @@ TYPE
VAR
Params: ARRAY MAX_PARAM, 2 OF INTEGER;
ParamCount*, Line*, Unit*: INTEGER;
ParamCount*, Line*, Unit*: INTEGER;
FileName: STRING;
PROCEDURE SetFile*(F: STRING);
@@ -113,8 +113,8 @@ BEGIN
WHILE (j < len) & (i <= Params[n, 1]) DO
c := GetChar(i);
IF c # 22X THEN
str[j] := c;
INC(j)
str[j] := c;
INC(j)
END;
INC(i)
END
@@ -199,14 +199,6 @@ BEGIN
Line := newLine
END UnitLine;
PROCEDURE min*(a, b: INTEGER): INTEGER;
BEGIN
IF a > b THEN
a := b
END
RETURN a
END min;
PROCEDURE Align*(n: INTEGER): INTEGER;
RETURN (4 - n MOD 4) MOD 4
END Align;
@@ -333,7 +325,7 @@ BEGIN
END;
Path[i + 1] := 0X
END Split;
PROCEDURE LinuxParam;
VAR p, i, str: INTEGER; c: CHAR;
BEGIN
@@ -350,7 +342,7 @@ BEGIN
Params[i, 1] := str - 1
END;
DEC(ParamCount)
END LinuxParam;
END LinuxParam;
PROCEDURE Time*;
VAR sec, dsec: INTEGER;
programs/develop/oberon07/Source/X86.ob07
+7 -5
View File
@@ -1,5 +1,5 @@
(*
Copyright 2016 Anton Krotov
Copyright 2016, 2017 Anton Krotov
This file is part of Compiler.
@@ -36,7 +36,7 @@ CONST
stDEC* = 14; stINCL* = 15; stEXCL* = 16; stCOPY* = 17; stNEW* = 18; stASSERT* = 19;
stPACK* = 20; stUNPK* = 21; stDISPOSE* = 22; stFABS* = 23; stINC1* = 24;
stDEC1* = 25; stASSERT1* = 26; stUNPK1* = 27; stPACK1* = 28; stLSR* = 29;
stLENGTH* = 30;
stLENGTH* = 30; stMIN* = 31; stMAX* = 32;
sysMOVE* = 108;
@@ -1232,7 +1232,9 @@ BEGIN
|stASR: PopECX; OutCode("58D3F8"); PushEAX
|stLSL: PopECX; OutCode("58D3E0"); PushEAX
|stLSR: PopECX; OutCode("58D3E8"); PushEAX
|stORD: PopEDX; OutCode("85D274036A015A"); PushEDX
|stORD: PopEDX; OutCode("85D274036A015A"); PushEDX;
|stMIN: PopEDX; OutCode("3914247E025852");
|stMAX: PopEDX; OutCode("3B14247E025852");
|stLENGTH: CallRTL(_length); PushEAX
ELSE
END
@@ -1269,12 +1271,12 @@ BEGIN
|TCHAR, TBOOLEAN:
IF lastcmd.tcmd = ECMD THEN
del;
OutCode("33D28A");
OutCode("0FB6");
IntByte("55", "95", offset);
PushEDX
ELSE
PopEDX;
OutCode("33C98A0A");
OutCode("0FB60A");
PushECX
END
|TLONGREAL: