Commit 9ce374a0 authored by Denis Budyak's avatar Denis Budyak

Немного разобрался в компиляции системной функции SYSTEM.VAL

parent f0963e8b
......@@ -1283,6 +1283,7 @@ MODULE НяГенКода486;
PROCEDURE^ stat (n: НяФс.Node; VAR end: НяГ486Ну.Label);
(** Если-то-иначе *)
PROCEDURE CondStat (if, last: НяФс.Node; VAR hint: INTEGER; VAR else, end: НяГ486Ну.Label);
VAR local: НяГ486Ну.Label; x: НяГ486Ну.Item; cond, lcond: НяФс.Node;
BEGIN
......
......@@ -1257,13 +1257,13 @@ MODULE НяД;
IF (x.class = Nvar) & (dynArrToo OR (x.typ.comp # DynArr)) THEN x.obj.leaf := FALSE END
END CheckLeaf;
PROCEDURE CheckOldType (x: НяФс.Node);
PROCEDURE ПроверьВоВремяКомпилЧтоЭтоНеУстаревшТипИзОберона (x: НяФс.Node);
BEGIN
IF ~(НяМ.oberon IN НяМ.options)
& ((x.typ = НяФс.lreal64typ) OR (x.typ = НяФс.lint64typ) OR (x.typ = НяФс.lchar16typ)) THEN
err(198)
END
END CheckOldType;
END ПроверьВоВремяКомпилЧтоЭтоНеУстаревшТипИзОберона;
(** Обрабатывает первый, второй и остальные параметры стандартных процедур (ПРАВЬМЯ доделать это): *)
PROCEDURE StPar0*(VAR par0: НяФс.Node; fctno: SHORTINT); (* par0: first param of standard proc *)
......@@ -1337,7 +1337,7 @@ MODULE НяД;
MOp(odd, x)
| minfn: (*MIN*)
IF x.class = Ntype THEN
CheckOldType(x);
ПроверьВоВремяКомпилЧтоЭтоНеУстаревшТипИзОберона(x);
CASE f OF
Bool: x := NewBoolConst(FALSE)
| Char8: x := NewIntConst(0); x.typ := НяФс.char8typ
......@@ -1356,7 +1356,7 @@ MODULE НяД;
END
| maxfn: (*MAX*)
IF x.class = Ntype THEN
CheckOldType(x);
ПроверьВоВремяКомпилЧтоЭтоНеУстаревшТипИзОберона(x);
CASE f OF
Bool: x := NewBoolConst(TRUE)
| Char8: x := NewIntConst(0FFH); x.typ := НяФс.char8typ
......@@ -1446,12 +1446,12 @@ MODULE НяД;
ELSE err(111); x.typ := НяФс.int32typ
END
| adrfn: (*ADR*)
IF x.class = Ntype THEN CheckOldType(x) END;
IF x.class = Ntype THEN ПроверьВоВремяКомпилЧтоЭтоНеУстаревшТипИзОберона(x) END;
CheckLeaf(x, FALSE); MOp(adr, x)
| typfn: (*TYP*)
CheckLeaf(x, FALSE);
IF x.class = Ntype THEN
CheckOldType(x);
ПроверьВоВремяКомпилЧтоЭтоНеУстаревшТипИзОберона(x);
IF x.typ.form = Pointer THEN x := NewLeaf(x.typ.BaseTyp.strobj) END;
IF x.typ.comp # Record THEN err(111) END;
MOp(adr, x)
......@@ -1463,7 +1463,7 @@ MODULE НяД;
| sizefn: (*SIZE*)
IF x.class # Ntype THEN err(110); x := NewIntConst(1)
ELSIF (f IN {Byte..Set, Pointer, ProcTyp, Char16, Int64}) OR (x.typ.comp IN {Array, Record}) THEN
CheckOldType(x); x.typ.pvused := TRUE;
ПроверьВоВремяКомпилЧтоЭтоНеУстаревшТипИзОберона(x); x.typ.pvused := TRUE;
IF typSize # NIL THEN
typSize(x.typ); x := NewIntConst(x.typ.size)
ELSE
......@@ -1495,9 +1495,11 @@ MODULE НяД;
ELSE err(69)
END
| valfn: (*SYSTEM.VAL*)
IF x.class # Ntype THEN err(110)
IF x.class # Ntype THEN err(110) (* аргумент - вообще не тип *)
(* Тип "НеТип" и прочее - это такие типы, что значение не может их иметь. Поэтому
нельзя интерпретировать значение как значение этих типов *)
ELSIF (f IN {Undef, String8, String16, NoTyp, NilTyp}) (* OR (x.typ.comp = DynArr) *) THEN err(111)
ELSE CheckOldType(x)
ELSE ПроверьВоВремяКомпилЧтоЭтоНеУстаревшТипИзОберона(x)
END
| assertfn: (*ASSERT*)
IF (x.class = Ntype) OR (x.class = Nproc) THEN err(126); x := NewBoolConst(FALSE)
......@@ -1529,7 +1531,7 @@ MODULE НяД;
par0 := x
END StPar0;
(* x: second parameter of standard proc *)
(* x: second parameter of standard proc. Результат возвращается в par0 *)
PROCEDURE StPar1*(VAR par0: НяФс.Node; x: НяФс.Node; fctno: BYTE);
VAR f, n, L, i: INTEGER; typ, tp1: НяФс.Struct; p, t: НяФс.Node;
......@@ -1669,10 +1671,12 @@ MODULE НяД;
ELSE err(111)
END ;
p.typ := НяФс.booltyp
| valfn: (*SYSTEM.VAL*) (* type is changed without considering the byte ordering on the target machine *)
| valfn: (*SYSTEM.VAL*) (* тип меняется без учёта порядка байтов на целевой машине *)
(* Напоминаю: x - второй параметр, p := par0; f := x.typ.form; *)
IF (x.class = Ntype) OR (x.class = Nproc) THEN err(126)
ELSIF x.typ.comp = DynArr THEN
IF x.typ.untagged & ((p.typ.comp # DynArr) OR p.typ.untagged) THEN (* ok *)
(** вероятно, здесь проверяется, что при преобразовании дин. массивов число и размеры эл-тов совпадают *)
ELSIF (p.typ.comp = DynArr) & (x.typ.n = p.typ.n) THEN
typ := x.typ;
WHILE typ.comp = DynArr DO typ := typ.BaseTyp END;
......@@ -1682,6 +1686,9 @@ MODULE НяД;
ELSE err(115)
END
ELSIF p.typ.comp = DynArr THEN err(115)
(* Можем интерпретировать строковую константу как целое, в которое превратилась бы такая же не-константа,
при этом кодировка - ascii, т.е. имеют значение первые 4 буквы (не понял, зачем здесь <= 5, но
я и не заглядывал в смысл intval2) *)
ELSIF (x.class = Nconst) & (f = String8) & (p.typ.form = Int32) & (x.conval.intval2 <= 5) THEN
i := 0; n := 0;
WHILE i < x.conval.intval2 - 1 DO n := 256 * n + ORD(x.conval.ext[i]); INC(i) END;
......@@ -1694,7 +1701,9 @@ MODULE НяД;
t := НяФс.NewNode(Nmop); t.subcl := val; t.left := x; x := t
ELSE x.readonly := FALSE
END ;
x.typ := p.typ; p := x
(** В конечном итоге, возвращаем узел, который нам пришёл из второго параметра (или что-то, во что
мы его здесь превратили), а тип ему назначаем от первого параметра *)
x.typ := p.typ; p := x (* par0 потом превратится в p *)
| movefn: (*SYSTEM.MOVE*)
IF (x.class = Ntype) OR (x.class = Nproc) THEN err(126)
ELSIF (x.class = Nconst) & (f IN {Int8, Int16}) THEN Convert(x, НяФс.int32typ)
......
......@@ -74,10 +74,10 @@ MODULE НяМ;
interface* = 1;
com* = 2; comAware* = 3;
som* = 4; somAware* = 5;
oberon* = 6;
oberon* = 6; (* Опция $ из рук-ва "Особенности, зависящие от платформы", см. НяКомпилтор.Module *)
java* = 7; javaAware* = 8;
noCode* = 9;
allSysVal* = 14;
allSysVal* = 14; (* Загадочная опция, но встречается в исходниках лишь 3 раза *)
sysImp* = 15;
trap* = 31;
sys386 = 10; sys68k = 20; (* processor type in options if system imported *)
......@@ -431,7 +431,7 @@ MODULE НяМ;
PROCEDURE LogW* (ch: CHAR);
BEGIN
out.WriteChar(ch);
END LogW;
END LogW;
PROCEDURE LogWStr* (s: ARRAY OF CHAR);
BEGIN
......
......@@ -139,6 +139,8 @@ moudle (moduleSym) отличается написанием")
(! таблица-описания-узлов "" (СПРАВОЧНАЯ-ТАБЛИЦА) "
Выдернуто из (Ня)Фс.kp
Здесь Ntype - видимо, литерал, указывающий тип, например, CHAR.
Nodes:
```
design = Nvar|Nvarpar|Nfield|Nderef|Nindex|Nguard|Neguard|Ntype|Nproc.
......@@ -248,6 +250,39 @@ stat NIL
Ncomp stat stat stat
```
")
(! пример-SYSTEM-точка-VAL "" ()
"""Пытаемся взять одну функцию SYSTEM.VAL и отследить
её историю по всему компилятору.
### Регистрация
Функция регистрируется (становится известной компилятору)
в модуле НямФС: `EnterProc("VAL", valfn);`
Далее нужно искать valfn.
### Документация
«Особенности, зависящие от платформы», Dev/Docu/P-S-I.odc
```
VAL(T, x), значение значение x
интерпретируется как имеющее тип T
```
### Участие в исходных текстах
НяД.StPar0 - обработка первого параметра стандартной функции.
Обработки никакой не происходит, дело сводится к проверкам.
НяД.StPar1 - обработка второго параметра стандартной ф-ии (он обозначается x).
Главное здесь - в конце. Тип результата (x.typ) назначается равным p.typ (типу первого
параметра), а значение результата берётся из второго параметра (p := x)
В итоге первый аргумент и сам вызов SYSTEM.VAL удаляются из дерева.
### Итого
В простом случае обработка функции VAL сводится к тому, что её вызов выбрасывается,
узел её второго аргумента получает другой тип времени компиляции, и его значение
возвращается.
""")
) ; СЕКЦИЯ
This diff is collapsed.
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment