|
@@ -1,11 +1,4 @@
|
|
|
-(*
|
|
|
|
|
- BSD 2-Clause License
|
|
|
|
|
-
|
|
|
|
|
- Copyright (c) 2018-2023, Anton Krotov
|
|
|
|
|
- All rights reserved.
|
|
|
|
|
-*)
|
|
|
|
|
-
|
|
|
|
|
-MODULE IL;
|
|
|
|
|
|
|
+MODULE IL;
|
|
|
|
|
|
|
|
IMPORT LISTS, SCAN, STRINGS, CHL := CHUNKLISTS, C := COLLECTIONS, TARGETS, PATHS;
|
|
IMPORT LISTS, SCAN, STRINGS, CHL := CHUNKLISTS, C := COLLECTIONS, TARGETS, PATHS;
|
|
|
|
|
|
|
@@ -214,146 +207,112 @@ VAR
|
|
|
|
|
|
|
|
|
|
|
|
|
PROCEDURE set_dmin* (value: INTEGER);
|
|
PROCEDURE set_dmin* (value: INTEGER);
|
|
|
-BEGIN
|
|
|
|
|
- codes.dmin := value
|
|
|
|
|
-END set_dmin;
|
|
|
|
|
|
|
+ BEGIN
|
|
|
|
|
+ codes.dmin := value
|
|
|
|
|
+ END set_dmin;
|
|
|
|
|
|
|
|
|
|
|
|
|
PROCEDURE set_bss* (value: INTEGER);
|
|
PROCEDURE set_bss* (value: INTEGER);
|
|
|
-BEGIN
|
|
|
|
|
- codes.bss := value
|
|
|
|
|
-END set_bss;
|
|
|
|
|
|
|
+ BEGIN
|
|
|
|
|
+ codes.bss := value
|
|
|
|
|
+ END set_bss;
|
|
|
|
|
|
|
|
|
|
|
|
|
PROCEDURE set_rtl* (idx, label: INTEGER);
|
|
PROCEDURE set_rtl* (idx, label: INTEGER);
|
|
|
-BEGIN
|
|
|
|
|
- codes.rtl[idx] := label
|
|
|
|
|
-END set_rtl;
|
|
|
|
|
|
|
+ BEGIN
|
|
|
|
|
+ codes.rtl[idx] := label
|
|
|
|
|
+ END set_rtl;
|
|
|
|
|
|
|
|
|
|
|
|
|
PROCEDURE NewCmd (): COMMAND;
|
|
PROCEDURE NewCmd (): COMMAND;
|
|
|
-VAR
|
|
|
|
|
- cmd: COMMAND;
|
|
|
|
|
- citem: C.ITEM;
|
|
|
|
|
|
|
+ VAR
|
|
|
|
|
+ cmd: COMMAND;
|
|
|
|
|
+ citem: C.ITEM;
|
|
|
|
|
|
|
|
-BEGIN
|
|
|
|
|
- citem := C.pop(commands);
|
|
|
|
|
- IF citem = NIL THEN
|
|
|
|
|
- NEW(cmd)
|
|
|
|
|
- ELSE
|
|
|
|
|
- cmd := citem(COMMAND)
|
|
|
|
|
- END
|
|
|
|
|
|
|
+ BEGIN
|
|
|
|
|
+ citem := C.pop(commands);
|
|
|
|
|
+ IF citem = NIL THEN
|
|
|
|
|
+ NEW(cmd)
|
|
|
|
|
+ ELSE
|
|
|
|
|
+ cmd := citem(COMMAND)
|
|
|
|
|
+ END
|
|
|
|
|
|
|
|
- RETURN cmd
|
|
|
|
|
-END NewCmd;
|
|
|
|
|
|
|
+ RETURN cmd
|
|
|
|
|
+ END NewCmd;
|
|
|
|
|
|
|
|
|
|
|
|
|
PROCEDURE setlast* (cmd: COMMAND);
|
|
PROCEDURE setlast* (cmd: COMMAND);
|
|
|
-BEGIN
|
|
|
|
|
- codes.last := cmd
|
|
|
|
|
-END setlast;
|
|
|
|
|
|
|
+ BEGIN
|
|
|
|
|
+ codes.last := cmd
|
|
|
|
|
+ END setlast;
|
|
|
|
|
|
|
|
|
|
|
|
|
PROCEDURE getlast* (): COMMAND;
|
|
PROCEDURE getlast* (): COMMAND;
|
|
|
- RETURN codes.last
|
|
|
|
|
-END getlast;
|
|
|
|
|
|
|
+ RETURN codes.last
|
|
|
|
|
+ END getlast;
|
|
|
|
|
|
|
|
|
|
|
|
|
PROCEDURE PutByte (b: BYTE);
|
|
PROCEDURE PutByte (b: BYTE);
|
|
|
-BEGIN
|
|
|
|
|
- CHL.PushByte(codes.data, b)
|
|
|
|
|
-END PutByte;
|
|
|
|
|
|
|
+ BEGIN
|
|
|
|
|
+ CHL.PushByte(codes.data, b)
|
|
|
|
|
+ END PutByte;
|
|
|
|
|
|
|
|
|
|
|
|
|
PROCEDURE AlignData (n: INTEGER);
|
|
PROCEDURE AlignData (n: INTEGER);
|
|
|
-BEGIN
|
|
|
|
|
- WHILE CHL.Length(codes.data) MOD n # 0 DO
|
|
|
|
|
- PutByte(0)
|
|
|
|
|
- END
|
|
|
|
|
-END AlignData;
|
|
|
|
|
|
|
+ BEGIN
|
|
|
|
|
+ WHILE CHL.Length(codes.data) MOD n # 0 DO
|
|
|
|
|
+ PutByte(0)
|
|
|
|
|
+ END
|
|
|
|
|
+ END AlignData;
|
|
|
|
|
|
|
|
|
|
|
|
|
PROCEDURE putstr* (s: ARRAY OF CHAR): INTEGER;
|
|
PROCEDURE putstr* (s: ARRAY OF CHAR): INTEGER;
|
|
|
-VAR
|
|
|
|
|
- i, n, res: INTEGER;
|
|
|
|
|
-BEGIN
|
|
|
|
|
- IF TARGETS.WinLin THEN
|
|
|
|
|
- AlignData(16)
|
|
|
|
|
- END;
|
|
|
|
|
- res := CHL.Length(codes.data);
|
|
|
|
|
- i := 0;
|
|
|
|
|
- n := LENGTH(s);
|
|
|
|
|
- WHILE i < n DO
|
|
|
|
|
- PutByte(ORD(s[i]));
|
|
|
|
|
- INC(i)
|
|
|
|
|
- END;
|
|
|
|
|
-
|
|
|
|
|
- PutByte(0)
|
|
|
|
|
-
|
|
|
|
|
- RETURN res
|
|
|
|
|
-END putstr;
|
|
|
|
|
-
|
|
|
|
|
-
|
|
|
|
|
-PROCEDURE putstr1* (c: INTEGER): INTEGER;
|
|
|
|
|
-VAR
|
|
|
|
|
- res: INTEGER;
|
|
|
|
|
-
|
|
|
|
|
-BEGIN
|
|
|
|
|
- IF codes.charoffs[c] = -1 THEN
|
|
|
|
|
|
|
+ VAR
|
|
|
|
|
+ i, n, res: INTEGER;
|
|
|
|
|
+ BEGIN
|
|
|
IF TARGETS.WinLin THEN
|
|
IF TARGETS.WinLin THEN
|
|
|
AlignData(16)
|
|
AlignData(16)
|
|
|
END;
|
|
END;
|
|
|
res := CHL.Length(codes.data);
|
|
res := CHL.Length(codes.data);
|
|
|
- PutByte(c);
|
|
|
|
|
- PutByte(0);
|
|
|
|
|
- codes.charoffs[c] := res
|
|
|
|
|
- ELSE
|
|
|
|
|
- res := codes.charoffs[c]
|
|
|
|
|
- END
|
|
|
|
|
-
|
|
|
|
|
- RETURN res
|
|
|
|
|
-END putstr1;
|
|
|
|
|
|
|
+ i := 0;
|
|
|
|
|
+ n := LENGTH(s);
|
|
|
|
|
+ WHILE i < n DO
|
|
|
|
|
+ PutByte(ORD(s[i]));
|
|
|
|
|
+ INC(i)
|
|
|
|
|
+ END;
|
|
|
|
|
|
|
|
|
|
+ PutByte(0)
|
|
|
|
|
|
|
|
-PROCEDURE putstrW* (s: ARRAY OF CHAR): INTEGER;
|
|
|
|
|
-VAR
|
|
|
|
|
- i, n, res: INTEGER;
|
|
|
|
|
|
|
+ RETURN res
|
|
|
|
|
+ END putstr;
|
|
|
|
|
|
|
|
-BEGIN
|
|
|
|
|
- IF TARGETS.WinLin THEN
|
|
|
|
|
- AlignData(16)
|
|
|
|
|
- ELSE
|
|
|
|
|
- AlignData(2)
|
|
|
|
|
- END;
|
|
|
|
|
- res := CHL.Length(codes.data);
|
|
|
|
|
|
|
|
|
|
- n := STRINGS.Utf8To16(s, codes.wstr);
|
|
|
|
|
|
|
+PROCEDURE putstr1* (c: INTEGER): INTEGER;
|
|
|
|
|
+ VAR
|
|
|
|
|
+ res: INTEGER;
|
|
|
|
|
|
|
|
- i := 0;
|
|
|
|
|
- WHILE i < n DO
|
|
|
|
|
- IF TARGETS.LittleEndian THEN
|
|
|
|
|
- PutByte(ORD(codes.wstr[i]) MOD 256);
|
|
|
|
|
- PutByte(ORD(codes.wstr[i]) DIV 256)
|
|
|
|
|
|
|
+ BEGIN
|
|
|
|
|
+ IF codes.charoffs[c] = -1 THEN
|
|
|
|
|
+ IF TARGETS.WinLin THEN
|
|
|
|
|
+ AlignData(16)
|
|
|
|
|
+ END;
|
|
|
|
|
+ res := CHL.Length(codes.data);
|
|
|
|
|
+ PutByte(c);
|
|
|
|
|
+ PutByte(0);
|
|
|
|
|
+ codes.charoffs[c] := res
|
|
|
ELSE
|
|
ELSE
|
|
|
- PutByte(ORD(codes.wstr[i]) DIV 256);
|
|
|
|
|
- PutByte(ORD(codes.wstr[i]) MOD 256)
|
|
|
|
|
- END;
|
|
|
|
|
- INC(i)
|
|
|
|
|
- END;
|
|
|
|
|
-
|
|
|
|
|
- PutByte(0);
|
|
|
|
|
- PutByte(0)
|
|
|
|
|
|
|
+ res := codes.charoffs[c]
|
|
|
|
|
+ END
|
|
|
|
|
|
|
|
- RETURN res
|
|
|
|
|
-END putstrW;
|
|
|
|
|
|
|
+ RETURN res
|
|
|
|
|
+ END putstr1;
|
|
|
|
|
|
|
|
|
|
|
|
|
-PROCEDURE putstrW1* (c: INTEGER): INTEGER;
|
|
|
|
|
-VAR
|
|
|
|
|
- res: INTEGER;
|
|
|
|
|
|
|
+PROCEDURE putstrW* (s: ARRAY OF CHAR): INTEGER;
|
|
|
|
|
+ VAR
|
|
|
|
|
+ i, n, res: INTEGER;
|
|
|
|
|
|
|
|
-BEGIN
|
|
|
|
|
- IF codes.wcharoffs[c] = -1 THEN
|
|
|
|
|
|
|
+ BEGIN
|
|
|
IF TARGETS.WinLin THEN
|
|
IF TARGETS.WinLin THEN
|
|
|
AlignData(16)
|
|
AlignData(16)
|
|
|
ELSE
|
|
ELSE
|
|
@@ -361,841 +320,875 @@ BEGIN
|
|
|
END;
|
|
END;
|
|
|
res := CHL.Length(codes.data);
|
|
res := CHL.Length(codes.data);
|
|
|
|
|
|
|
|
- IF TARGETS.LittleEndian THEN
|
|
|
|
|
- PutByte(c MOD 256);
|
|
|
|
|
- PutByte(c DIV 256)
|
|
|
|
|
- ELSE
|
|
|
|
|
- PutByte(c DIV 256);
|
|
|
|
|
- PutByte(c MOD 256)
|
|
|
|
|
|
|
+ n := STRINGS.Utf8To16(s, codes.wstr);
|
|
|
|
|
+
|
|
|
|
|
+ i := 0;
|
|
|
|
|
+ WHILE i < n DO
|
|
|
|
|
+ IF TARGETS.LittleEndian THEN
|
|
|
|
|
+ PutByte(ORD(codes.wstr[i]) MOD 256);
|
|
|
|
|
+ PutByte(ORD(codes.wstr[i]) DIV 256)
|
|
|
|
|
+ ELSE
|
|
|
|
|
+ PutByte(ORD(codes.wstr[i]) DIV 256);
|
|
|
|
|
+ PutByte(ORD(codes.wstr[i]) MOD 256)
|
|
|
|
|
+ END;
|
|
|
|
|
+ INC(i)
|
|
|
END;
|
|
END;
|
|
|
|
|
|
|
|
PutByte(0);
|
|
PutByte(0);
|
|
|
- PutByte(0);
|
|
|
|
|
|
|
+ PutByte(0)
|
|
|
|
|
+
|
|
|
|
|
+ RETURN res
|
|
|
|
|
+ END putstrW;
|
|
|
|
|
+
|
|
|
|
|
+
|
|
|
|
|
+PROCEDURE putstrW1* (c: INTEGER): INTEGER;
|
|
|
|
|
+ VAR
|
|
|
|
|
+ res: INTEGER;
|
|
|
|
|
+
|
|
|
|
|
+ BEGIN
|
|
|
|
|
+ IF codes.wcharoffs[c] = -1 THEN
|
|
|
|
|
+ IF TARGETS.WinLin THEN
|
|
|
|
|
+ AlignData(16)
|
|
|
|
|
+ ELSE
|
|
|
|
|
+ AlignData(2)
|
|
|
|
|
+ END;
|
|
|
|
|
+ res := CHL.Length(codes.data);
|
|
|
|
|
+
|
|
|
|
|
+ IF TARGETS.LittleEndian THEN
|
|
|
|
|
+ PutByte(c MOD 256);
|
|
|
|
|
+ PutByte(c DIV 256)
|
|
|
|
|
+ ELSE
|
|
|
|
|
+ PutByte(c DIV 256);
|
|
|
|
|
+ PutByte(c MOD 256)
|
|
|
|
|
+ END;
|
|
|
|
|
|
|
|
- codes.wcharoffs[c] := res
|
|
|
|
|
- ELSE
|
|
|
|
|
- res := codes.wcharoffs[c]
|
|
|
|
|
- END
|
|
|
|
|
|
|
+ PutByte(0);
|
|
|
|
|
+ PutByte(0);
|
|
|
|
|
|
|
|
- RETURN res
|
|
|
|
|
-END putstrW1;
|
|
|
|
|
|
|
+ codes.wcharoffs[c] := res
|
|
|
|
|
+ ELSE
|
|
|
|
|
+ res := codes.wcharoffs[c]
|
|
|
|
|
+ END
|
|
|
|
|
+
|
|
|
|
|
+ RETURN res
|
|
|
|
|
+ END putstrW1;
|
|
|
|
|
|
|
|
|
|
|
|
|
PROCEDURE push (stk: CMDSTACK; cmd: COMMAND);
|
|
PROCEDURE push (stk: CMDSTACK; cmd: COMMAND);
|
|
|
-BEGIN
|
|
|
|
|
- INC(stk.top);
|
|
|
|
|
- stk.data[stk.top] := cmd
|
|
|
|
|
-END push;
|
|
|
|
|
|
|
+ BEGIN
|
|
|
|
|
+ INC(stk.top);
|
|
|
|
|
+ stk.data[stk.top] := cmd
|
|
|
|
|
+ END push;
|
|
|
|
|
|
|
|
|
|
|
|
|
PROCEDURE pop (stk: CMDSTACK): COMMAND;
|
|
PROCEDURE pop (stk: CMDSTACK): COMMAND;
|
|
|
-VAR
|
|
|
|
|
- res: COMMAND;
|
|
|
|
|
-BEGIN
|
|
|
|
|
- res := stk.data[stk.top];
|
|
|
|
|
- DEC(stk.top)
|
|
|
|
|
- RETURN res
|
|
|
|
|
-END pop;
|
|
|
|
|
|
|
+ VAR
|
|
|
|
|
+ res: COMMAND;
|
|
|
|
|
+ BEGIN
|
|
|
|
|
+ res := stk.data[stk.top];
|
|
|
|
|
+ DEC(stk.top)
|
|
|
|
|
+ RETURN res
|
|
|
|
|
+ END pop;
|
|
|
|
|
|
|
|
|
|
|
|
|
PROCEDURE pushBegEnd* (VAR beg, _end: COMMAND);
|
|
PROCEDURE pushBegEnd* (VAR beg, _end: COMMAND);
|
|
|
-BEGIN
|
|
|
|
|
- push(codes.begcall, beg);
|
|
|
|
|
- push(codes.endcall, _end);
|
|
|
|
|
- beg := codes.last;
|
|
|
|
|
- _end := beg.next(COMMAND)
|
|
|
|
|
-END pushBegEnd;
|
|
|
|
|
|
|
+ BEGIN
|
|
|
|
|
+ push(codes.begcall, beg);
|
|
|
|
|
+ push(codes.endcall, _end);
|
|
|
|
|
+ beg := codes.last;
|
|
|
|
|
+ _end := beg.next(COMMAND)
|
|
|
|
|
+ END pushBegEnd;
|
|
|
|
|
|
|
|
|
|
|
|
|
PROCEDURE popBegEnd* (VAR beg, _end: COMMAND);
|
|
PROCEDURE popBegEnd* (VAR beg, _end: COMMAND);
|
|
|
-BEGIN
|
|
|
|
|
- beg := pop(codes.begcall);
|
|
|
|
|
- _end := pop(codes.endcall)
|
|
|
|
|
-END popBegEnd;
|
|
|
|
|
|
|
+ BEGIN
|
|
|
|
|
+ beg := pop(codes.begcall);
|
|
|
|
|
+ _end := pop(codes.endcall)
|
|
|
|
|
+ END popBegEnd;
|
|
|
|
|
|
|
|
|
|
|
|
|
PROCEDURE AddRec* (base: INTEGER);
|
|
PROCEDURE AddRec* (base: INTEGER);
|
|
|
-BEGIN
|
|
|
|
|
- CHL.PushInt(codes.types, base)
|
|
|
|
|
-END AddRec;
|
|
|
|
|
|
|
+ BEGIN
|
|
|
|
|
+ CHL.PushInt(codes.types, base)
|
|
|
|
|
+ END AddRec;
|
|
|
|
|
|
|
|
|
|
|
|
|
PROCEDURE insert (cur, nov: COMMAND);
|
|
PROCEDURE insert (cur, nov: COMMAND);
|
|
|
-VAR
|
|
|
|
|
- old_opcode, param2: INTEGER;
|
|
|
|
|
-
|
|
|
|
|
-
|
|
|
|
|
- PROCEDURE set (cur: COMMAND; opcode, param2: INTEGER);
|
|
|
|
|
- BEGIN
|
|
|
|
|
- cur.opcode := opcode;
|
|
|
|
|
- cur.param1 := cur.param2;
|
|
|
|
|
- cur.param2 := param2
|
|
|
|
|
- END set;
|
|
|
|
|
|
|
+ VAR
|
|
|
|
|
+ old_opcode, param2: INTEGER;
|
|
|
|
|
|
|
|
|
|
|
|
|
-BEGIN
|
|
|
|
|
- IF CPU IN {TARGETS.cpuX86, TARGETS.cpuAMD64, TARGETS.cpuMSP430} THEN
|
|
|
|
|
|
|
+ PROCEDURE set (cur: COMMAND; opcode, param2: INTEGER);
|
|
|
|
|
+ BEGIN
|
|
|
|
|
+ cur.opcode := opcode;
|
|
|
|
|
+ cur.param1 := cur.param2;
|
|
|
|
|
+ cur.param2 := param2
|
|
|
|
|
+ END set;
|
|
|
|
|
|
|
|
- old_opcode := cur.opcode;
|
|
|
|
|
- param2 := nov.param2;
|
|
|
|
|
|
|
|
|
|
- IF (nov.opcode = opPARAM) & (param2 = 1) THEN
|
|
|
|
|
|
|
+ BEGIN
|
|
|
|
|
+ IF CPU IN {TARGETS.cpuX86, TARGETS.cpuAMD64, TARGETS.cpuMSP430} THEN
|
|
|
|
|
+
|
|
|
|
|
+ old_opcode := cur.opcode;
|
|
|
|
|
+ param2 := nov.param2;
|
|
|
|
|
+
|
|
|
|
|
+ IF (nov.opcode = opPARAM) & (param2 = 1) THEN
|
|
|
|
|
+
|
|
|
|
|
+ CASE old_opcode OF
|
|
|
|
|
+ |opGLOAD64: cur.opcode := opGLOAD64_PARAM
|
|
|
|
|
+ |opLLOAD64: cur.opcode := opLLOAD64_PARAM
|
|
|
|
|
+ |opLOAD64: cur.opcode := opLOAD64_PARAM
|
|
|
|
|
+ |opGLOAD32: cur.opcode := opGLOAD32_PARAM
|
|
|
|
|
+ |opLLOAD32: cur.opcode := opLLOAD32_PARAM
|
|
|
|
|
+ |opLOAD32: cur.opcode := opLOAD32_PARAM
|
|
|
|
|
+ |opSADR: cur.opcode := opSADR_PARAM
|
|
|
|
|
+ |opVADR: cur.opcode := opVADR_PARAM
|
|
|
|
|
+ |opCONST: cur.opcode := opCONST_PARAM
|
|
|
|
|
+ ELSE
|
|
|
|
|
+ old_opcode := -1
|
|
|
|
|
+ END
|
|
|
|
|
+
|
|
|
|
|
+ ELSIF old_opcode = opLADR THEN
|
|
|
|
|
+
|
|
|
|
|
+ CASE nov.opcode OF
|
|
|
|
|
+ |opSAVEC: set(cur, opLADR_SAVEC, param2)
|
|
|
|
|
+ |opSAVE: cur.opcode := opLADR_SAVE
|
|
|
|
|
+ |opINC: cur.opcode := opLADR_INC
|
|
|
|
|
+ |opDEC: cur.opcode := opLADR_DEC
|
|
|
|
|
+ |opINCB: cur.opcode := opLADR_INCB
|
|
|
|
|
+ |opDECB: cur.opcode := opLADR_DECB
|
|
|
|
|
+ |opINCL: cur.opcode := opLADR_INCL
|
|
|
|
|
+ |opEXCL: cur.opcode := opLADR_EXCL
|
|
|
|
|
+ |opUNPK: cur.opcode := opLADR_UNPK
|
|
|
|
|
+ |opINCC: set(cur, opLADR_INCC, param2)
|
|
|
|
|
+ |opINCCB: set(cur, opLADR_INCCB, param2)
|
|
|
|
|
+ |opDECCB: set(cur, opLADR_DECCB, param2)
|
|
|
|
|
+ |opINCLC: set(cur, opLADR_INCLC, param2)
|
|
|
|
|
+ |opEXCLC: set(cur, opLADR_EXCLC, param2)
|
|
|
|
|
+ ELSE
|
|
|
|
|
+ old_opcode := -1
|
|
|
|
|
+ END
|
|
|
|
|
+
|
|
|
|
|
+ ELSIF (nov.opcode = opSAVEC) & (old_opcode = opGADR) THEN
|
|
|
|
|
+ set(cur, opGADR_SAVEC, param2)
|
|
|
|
|
+
|
|
|
|
|
+ ELSIF (nov.opcode = opMULC) & (old_opcode = opMULC) THEN
|
|
|
|
|
+ cur.param2 := cur.param2 * param2
|
|
|
|
|
+
|
|
|
|
|
+ ELSIF (nov.opcode = opADDC) & (old_opcode = opADDC) THEN
|
|
|
|
|
+ INC(cur.param2, param2)
|
|
|
|
|
|
|
|
- CASE old_opcode OF
|
|
|
|
|
- |opGLOAD64: cur.opcode := opGLOAD64_PARAM
|
|
|
|
|
- |opLLOAD64: cur.opcode := opLLOAD64_PARAM
|
|
|
|
|
- |opLOAD64: cur.opcode := opLOAD64_PARAM
|
|
|
|
|
- |opGLOAD32: cur.opcode := opGLOAD32_PARAM
|
|
|
|
|
- |opLLOAD32: cur.opcode := opLLOAD32_PARAM
|
|
|
|
|
- |opLOAD32: cur.opcode := opLOAD32_PARAM
|
|
|
|
|
- |opSADR: cur.opcode := opSADR_PARAM
|
|
|
|
|
- |opVADR: cur.opcode := opVADR_PARAM
|
|
|
|
|
- |opCONST: cur.opcode := opCONST_PARAM
|
|
|
|
|
ELSE
|
|
ELSE
|
|
|
old_opcode := -1
|
|
old_opcode := -1
|
|
|
END
|
|
END
|
|
|
|
|
|
|
|
- ELSIF old_opcode = opLADR THEN
|
|
|
|
|
-
|
|
|
|
|
- CASE nov.opcode OF
|
|
|
|
|
- |opSAVEC: set(cur, opLADR_SAVEC, param2)
|
|
|
|
|
- |opSAVE: cur.opcode := opLADR_SAVE
|
|
|
|
|
- |opINC: cur.opcode := opLADR_INC
|
|
|
|
|
- |opDEC: cur.opcode := opLADR_DEC
|
|
|
|
|
- |opINCB: cur.opcode := opLADR_INCB
|
|
|
|
|
- |opDECB: cur.opcode := opLADR_DECB
|
|
|
|
|
- |opINCL: cur.opcode := opLADR_INCL
|
|
|
|
|
- |opEXCL: cur.opcode := opLADR_EXCL
|
|
|
|
|
- |opUNPK: cur.opcode := opLADR_UNPK
|
|
|
|
|
- |opINCC: set(cur, opLADR_INCC, param2)
|
|
|
|
|
- |opINCCB: set(cur, opLADR_INCCB, param2)
|
|
|
|
|
- |opDECCB: set(cur, opLADR_DECCB, param2)
|
|
|
|
|
- |opINCLC: set(cur, opLADR_INCLC, param2)
|
|
|
|
|
- |opEXCLC: set(cur, opLADR_EXCLC, param2)
|
|
|
|
|
|
|
+ ELSIF CPU IN {TARGETS.cpuTHUMB, TARGETS.cpuRVM32I, TARGETS.cpuRVM64I} THEN
|
|
|
|
|
+
|
|
|
|
|
+ old_opcode := cur.opcode;
|
|
|
|
|
+ param2 := nov.param2;
|
|
|
|
|
+
|
|
|
|
|
+ IF (old_opcode = opLADR) & (nov.opcode = opSAVE) THEN
|
|
|
|
|
+ cur.opcode := opLADR_SAVE
|
|
|
|
|
+ ELSIF (old_opcode = opLADR) & (nov.opcode = opINCC) THEN
|
|
|
|
|
+ set(cur, opLADR_INCC, param2)
|
|
|
|
|
+ ELSIF (nov.opcode = opMULC) & (old_opcode = opMULC) THEN
|
|
|
|
|
+ cur.param2 := cur.param2 * param2
|
|
|
|
|
+ ELSIF (nov.opcode = opADDC) & (old_opcode = opADDC) THEN
|
|
|
|
|
+ INC(cur.param2, param2)
|
|
|
ELSE
|
|
ELSE
|
|
|
old_opcode := -1
|
|
old_opcode := -1
|
|
|
END
|
|
END
|
|
|
|
|
|
|
|
- ELSIF (nov.opcode = opSAVEC) & (old_opcode = opGADR) THEN
|
|
|
|
|
- set(cur, opGADR_SAVEC, param2)
|
|
|
|
|
-
|
|
|
|
|
- ELSIF (nov.opcode = opMULC) & (old_opcode = opMULC) THEN
|
|
|
|
|
- cur.param2 := cur.param2 * param2
|
|
|
|
|
-
|
|
|
|
|
- ELSIF (nov.opcode = opADDC) & (old_opcode = opADDC) THEN
|
|
|
|
|
- INC(cur.param2, param2)
|
|
|
|
|
-
|
|
|
|
|
ELSE
|
|
ELSE
|
|
|
old_opcode := -1
|
|
old_opcode := -1
|
|
|
- END
|
|
|
|
|
-
|
|
|
|
|
- ELSIF CPU IN {TARGETS.cpuTHUMB, TARGETS.cpuRVM32I, TARGETS.cpuRVM64I} THEN
|
|
|
|
|
-
|
|
|
|
|
- old_opcode := cur.opcode;
|
|
|
|
|
- param2 := nov.param2;
|
|
|
|
|
|
|
+ END;
|
|
|
|
|
|
|
|
- IF (old_opcode = opLADR) & (nov.opcode = opSAVE) THEN
|
|
|
|
|
- cur.opcode := opLADR_SAVE
|
|
|
|
|
- ELSIF (old_opcode = opLADR) & (nov.opcode = opINCC) THEN
|
|
|
|
|
- set(cur, opLADR_INCC, param2)
|
|
|
|
|
- ELSIF (nov.opcode = opMULC) & (old_opcode = opMULC) THEN
|
|
|
|
|
- cur.param2 := cur.param2 * param2
|
|
|
|
|
- ELSIF (nov.opcode = opADDC) & (old_opcode = opADDC) THEN
|
|
|
|
|
- INC(cur.param2, param2)
|
|
|
|
|
|
|
+ IF old_opcode = -1 THEN
|
|
|
|
|
+ LISTS.insert(codes.commands, cur, nov);
|
|
|
|
|
+ codes.last := nov
|
|
|
ELSE
|
|
ELSE
|
|
|
- old_opcode := -1
|
|
|
|
|
|
|
+ C.push(commands, nov);
|
|
|
|
|
+ codes.last := cur
|
|
|
END
|
|
END
|
|
|
-
|
|
|
|
|
- ELSE
|
|
|
|
|
- old_opcode := -1
|
|
|
|
|
- END;
|
|
|
|
|
-
|
|
|
|
|
- IF old_opcode = -1 THEN
|
|
|
|
|
- LISTS.insert(codes.commands, cur, nov);
|
|
|
|
|
- codes.last := nov
|
|
|
|
|
- ELSE
|
|
|
|
|
- C.push(commands, nov);
|
|
|
|
|
- codes.last := cur
|
|
|
|
|
- END
|
|
|
|
|
-END insert;
|
|
|
|
|
|
|
+ END insert;
|
|
|
|
|
|
|
|
|
|
|
|
|
PROCEDURE AddCmd* (opcode: INTEGER; param: INTEGER);
|
|
PROCEDURE AddCmd* (opcode: INTEGER; param: INTEGER);
|
|
|
-VAR
|
|
|
|
|
- cmd: COMMAND;
|
|
|
|
|
-BEGIN
|
|
|
|
|
- cmd := NewCmd();
|
|
|
|
|
- cmd.opcode := opcode;
|
|
|
|
|
- cmd.param1 := 0;
|
|
|
|
|
- cmd.param2 := param;
|
|
|
|
|
- insert(codes.last, cmd)
|
|
|
|
|
-END AddCmd;
|
|
|
|
|
|
|
+ VAR
|
|
|
|
|
+ cmd: COMMAND;
|
|
|
|
|
+ BEGIN
|
|
|
|
|
+ cmd := NewCmd();
|
|
|
|
|
+ cmd.opcode := opcode;
|
|
|
|
|
+ cmd.param1 := 0;
|
|
|
|
|
+ cmd.param2 := param;
|
|
|
|
|
+ insert(codes.last, cmd)
|
|
|
|
|
+ END AddCmd;
|
|
|
|
|
|
|
|
|
|
|
|
|
PROCEDURE AddCmd2* (opcode: INTEGER; param1, param2: INTEGER);
|
|
PROCEDURE AddCmd2* (opcode: INTEGER; param1, param2: INTEGER);
|
|
|
-VAR
|
|
|
|
|
- cmd: COMMAND;
|
|
|
|
|
-BEGIN
|
|
|
|
|
- cmd := NewCmd();
|
|
|
|
|
- cmd.opcode := opcode;
|
|
|
|
|
- cmd.param1 := param1;
|
|
|
|
|
- cmd.param2 := param2;
|
|
|
|
|
- insert(codes.last, cmd)
|
|
|
|
|
-END AddCmd2;
|
|
|
|
|
|
|
+ VAR
|
|
|
|
|
+ cmd: COMMAND;
|
|
|
|
|
+ BEGIN
|
|
|
|
|
+ cmd := NewCmd();
|
|
|
|
|
+ cmd.opcode := opcode;
|
|
|
|
|
+ cmd.param1 := param1;
|
|
|
|
|
+ cmd.param2 := param2;
|
|
|
|
|
+ insert(codes.last, cmd)
|
|
|
|
|
+ END AddCmd2;
|
|
|
|
|
|
|
|
|
|
|
|
|
PROCEDURE Const* (val: INTEGER);
|
|
PROCEDURE Const* (val: INTEGER);
|
|
|
-BEGIN
|
|
|
|
|
- AddCmd(opCONST, val)
|
|
|
|
|
-END Const;
|
|
|
|
|
|
|
+ BEGIN
|
|
|
|
|
+ AddCmd(opCONST, val)
|
|
|
|
|
+ END Const;
|
|
|
|
|
|
|
|
|
|
|
|
|
PROCEDURE StrAdr* (adr: INTEGER);
|
|
PROCEDURE StrAdr* (adr: INTEGER);
|
|
|
-BEGIN
|
|
|
|
|
- AddCmd(opSADR, adr)
|
|
|
|
|
-END StrAdr;
|
|
|
|
|
|
|
+ BEGIN
|
|
|
|
|
+ AddCmd(opSADR, adr)
|
|
|
|
|
+ END StrAdr;
|
|
|
|
|
|
|
|
|
|
|
|
|
PROCEDURE Param1*;
|
|
PROCEDURE Param1*;
|
|
|
-BEGIN
|
|
|
|
|
- AddCmd(opPARAM, 1)
|
|
|
|
|
-END Param1;
|
|
|
|
|
|
|
+ BEGIN
|
|
|
|
|
+ AddCmd(opPARAM, 1)
|
|
|
|
|
+ END Param1;
|
|
|
|
|
|
|
|
|
|
|
|
|
PROCEDURE NewLabel* (): INTEGER;
|
|
PROCEDURE NewLabel* (): INTEGER;
|
|
|
-BEGIN
|
|
|
|
|
- INC(codes.lcount)
|
|
|
|
|
- RETURN codes.lcount - 1
|
|
|
|
|
-END NewLabel;
|
|
|
|
|
|
|
+ BEGIN
|
|
|
|
|
+ INC(codes.lcount)
|
|
|
|
|
+ RETURN codes.lcount - 1
|
|
|
|
|
+ END NewLabel;
|
|
|
|
|
|
|
|
|
|
|
|
|
PROCEDURE SetLabel* (label: INTEGER);
|
|
PROCEDURE SetLabel* (label: INTEGER);
|
|
|
-BEGIN
|
|
|
|
|
- AddCmd2(opLABEL, label, 0)
|
|
|
|
|
-END SetLabel;
|
|
|
|
|
|
|
+ BEGIN
|
|
|
|
|
+ AddCmd2(opLABEL, label, 0)
|
|
|
|
|
+ END SetLabel;
|
|
|
|
|
|
|
|
|
|
|
|
|
PROCEDURE SetErrLabel* (errno: INTEGER);
|
|
PROCEDURE SetErrLabel* (errno: INTEGER);
|
|
|
-BEGIN
|
|
|
|
|
- codes.errlabels[errno] := NewLabel();
|
|
|
|
|
- SetLabel(codes.errlabels[errno])
|
|
|
|
|
-END SetErrLabel;
|
|
|
|
|
|
|
+ BEGIN
|
|
|
|
|
+ codes.errlabels[errno] := NewLabel();
|
|
|
|
|
+ SetLabel(codes.errlabels[errno])
|
|
|
|
|
+ END SetErrLabel;
|
|
|
|
|
|
|
|
|
|
|
|
|
PROCEDURE AddCmd0* (opcode: INTEGER);
|
|
PROCEDURE AddCmd0* (opcode: INTEGER);
|
|
|
-BEGIN
|
|
|
|
|
- AddCmd(opcode, 0)
|
|
|
|
|
-END AddCmd0;
|
|
|
|
|
|
|
+ BEGIN
|
|
|
|
|
+ AddCmd(opcode, 0)
|
|
|
|
|
+ END AddCmd0;
|
|
|
|
|
|
|
|
|
|
|
|
|
PROCEDURE delete (cmd: COMMAND);
|
|
PROCEDURE delete (cmd: COMMAND);
|
|
|
-BEGIN
|
|
|
|
|
- LISTS.delete(codes.commands, cmd);
|
|
|
|
|
- C.push(commands, cmd)
|
|
|
|
|
-END delete;
|
|
|
|
|
|
|
+ BEGIN
|
|
|
|
|
+ LISTS.delete(codes.commands, cmd);
|
|
|
|
|
+ C.push(commands, cmd)
|
|
|
|
|
+ END delete;
|
|
|
|
|
|
|
|
|
|
|
|
|
PROCEDURE delete2* (first, last: LISTS.ITEM);
|
|
PROCEDURE delete2* (first, last: LISTS.ITEM);
|
|
|
-VAR
|
|
|
|
|
- cur, next: LISTS.ITEM;
|
|
|
|
|
-
|
|
|
|
|
-BEGIN
|
|
|
|
|
- cur := first;
|
|
|
|
|
-
|
|
|
|
|
- IF first # last THEN
|
|
|
|
|
- REPEAT
|
|
|
|
|
- next := cur.next;
|
|
|
|
|
- LISTS.delete(codes.commands, cur);
|
|
|
|
|
- C.push(commands, cur);
|
|
|
|
|
- cur := next
|
|
|
|
|
- UNTIL cur = last
|
|
|
|
|
- END;
|
|
|
|
|
|
|
+ VAR
|
|
|
|
|
+ cur, next: LISTS.ITEM;
|
|
|
|
|
+
|
|
|
|
|
+ BEGIN
|
|
|
|
|
+ cur := first;
|
|
|
|
|
+
|
|
|
|
|
+ IF first # last THEN
|
|
|
|
|
+ REPEAT
|
|
|
|
|
+ next := cur.next;
|
|
|
|
|
+ LISTS.delete(codes.commands, cur);
|
|
|
|
|
+ C.push(commands, cur);
|
|
|
|
|
+ cur := next
|
|
|
|
|
+ UNTIL cur = last
|
|
|
|
|
+ END;
|
|
|
|
|
|
|
|
- LISTS.delete(codes.commands, cur);
|
|
|
|
|
- C.push(commands, cur)
|
|
|
|
|
-END delete2;
|
|
|
|
|
|
|
+ LISTS.delete(codes.commands, cur);
|
|
|
|
|
+ C.push(commands, cur)
|
|
|
|
|
+ END delete2;
|
|
|
|
|
|
|
|
|
|
|
|
|
PROCEDURE Jmp* (opcode: INTEGER; label: INTEGER);
|
|
PROCEDURE Jmp* (opcode: INTEGER; label: INTEGER);
|
|
|
-VAR
|
|
|
|
|
- prev: COMMAND;
|
|
|
|
|
- not: BOOLEAN;
|
|
|
|
|
-
|
|
|
|
|
-BEGIN
|
|
|
|
|
- prev := codes.last;
|
|
|
|
|
- not := prev.opcode = opNOT;
|
|
|
|
|
- IF not THEN
|
|
|
|
|
- IF opcode = opJNZ THEN
|
|
|
|
|
- opcode := opJZ
|
|
|
|
|
- ELSIF opcode = opJZ THEN
|
|
|
|
|
- opcode := opJNZ
|
|
|
|
|
- ELSE
|
|
|
|
|
- not := FALSE
|
|
|
|
|
- END
|
|
|
|
|
- END;
|
|
|
|
|
|
|
+ VAR
|
|
|
|
|
+ prev: COMMAND;
|
|
|
|
|
+ not: BOOLEAN;
|
|
|
|
|
|
|
|
- AddCmd2(opcode, label, label);
|
|
|
|
|
|
|
+ BEGIN
|
|
|
|
|
+ prev := codes.last;
|
|
|
|
|
+ not := prev.opcode = opNOT;
|
|
|
|
|
+ IF not THEN
|
|
|
|
|
+ IF opcode = opJNZ THEN
|
|
|
|
|
+ opcode := opJZ
|
|
|
|
|
+ ELSIF opcode = opJZ THEN
|
|
|
|
|
+ opcode := opJNZ
|
|
|
|
|
+ ELSE
|
|
|
|
|
+ not := FALSE
|
|
|
|
|
+ END
|
|
|
|
|
+ END;
|
|
|
|
|
+
|
|
|
|
|
+ AddCmd2(opcode, label, label);
|
|
|
|
|
|
|
|
- IF not THEN
|
|
|
|
|
- delete(prev)
|
|
|
|
|
- END
|
|
|
|
|
-END Jmp;
|
|
|
|
|
|
|
+ IF not THEN
|
|
|
|
|
+ delete(prev)
|
|
|
|
|
+ END
|
|
|
|
|
+ END Jmp;
|
|
|
|
|
|
|
|
|
|
|
|
|
PROCEDURE AndOrOpt* (VAR label: INTEGER);
|
|
PROCEDURE AndOrOpt* (VAR label: INTEGER);
|
|
|
-VAR
|
|
|
|
|
- cur, prev: COMMAND;
|
|
|
|
|
- i, op, l: INTEGER;
|
|
|
|
|
- jz, not: BOOLEAN;
|
|
|
|
|
-
|
|
|
|
|
-BEGIN
|
|
|
|
|
- cur := codes.last;
|
|
|
|
|
- not := cur.opcode = opNOT;
|
|
|
|
|
- IF not THEN
|
|
|
|
|
- cur := cur.prev(COMMAND)
|
|
|
|
|
- END;
|
|
|
|
|
|
|
+ VAR
|
|
|
|
|
+ cur, prev: COMMAND;
|
|
|
|
|
+ i, op, l: INTEGER;
|
|
|
|
|
+ jz, not: BOOLEAN;
|
|
|
|
|
|
|
|
- IF cur.opcode = opAND THEN
|
|
|
|
|
- op := opAND
|
|
|
|
|
- ELSIF cur.opcode = opOR THEN
|
|
|
|
|
- op := opOR
|
|
|
|
|
- ELSE
|
|
|
|
|
- op := -1
|
|
|
|
|
- END;
|
|
|
|
|
|
|
+ BEGIN
|
|
|
|
|
+ cur := codes.last;
|
|
|
|
|
+ not := cur.opcode = opNOT;
|
|
|
|
|
+ IF not THEN
|
|
|
|
|
+ cur := cur.prev(COMMAND)
|
|
|
|
|
+ END;
|
|
|
|
|
|
|
|
- cur := codes.last;
|
|
|
|
|
|
|
+ IF cur.opcode = opAND THEN
|
|
|
|
|
+ op := opAND
|
|
|
|
|
+ ELSIF cur.opcode = opOR THEN
|
|
|
|
|
+ op := opOR
|
|
|
|
|
+ ELSE
|
|
|
|
|
+ op := -1
|
|
|
|
|
+ END;
|
|
|
|
|
|
|
|
- IF op # -1 THEN
|
|
|
|
|
- IF not THEN
|
|
|
|
|
- IF op = opAND THEN
|
|
|
|
|
- op := opOR
|
|
|
|
|
- ELSE (* op = opOR *)
|
|
|
|
|
- op := opAND
|
|
|
|
|
|
|
+ cur := codes.last;
|
|
|
|
|
+
|
|
|
|
|
+ IF op # -1 THEN
|
|
|
|
|
+ IF not THEN
|
|
|
|
|
+ IF op = opAND THEN
|
|
|
|
|
+ op := opOR
|
|
|
|
|
+ ELSE (* op = opOR *)
|
|
|
|
|
+ op := opAND
|
|
|
|
|
+ END;
|
|
|
|
|
+ prev := cur.prev(COMMAND);
|
|
|
|
|
+ delete(cur);
|
|
|
|
|
+ cur := prev
|
|
|
END;
|
|
END;
|
|
|
- prev := cur.prev(COMMAND);
|
|
|
|
|
- delete(cur);
|
|
|
|
|
- cur := prev
|
|
|
|
|
- END;
|
|
|
|
|
|
|
|
|
|
- FOR i := 1 TO 9 DO
|
|
|
|
|
- IF i = 8 THEN
|
|
|
|
|
- l := cur.param1
|
|
|
|
|
- ELSIF i = 9 THEN
|
|
|
|
|
- jz := cur.opcode = opJZ
|
|
|
|
|
|
|
+ FOR i := 1 TO 9 DO
|
|
|
|
|
+ IF i = 8 THEN
|
|
|
|
|
+ l := cur.param1
|
|
|
|
|
+ ELSIF i = 9 THEN
|
|
|
|
|
+ jz := cur.opcode = opJZ
|
|
|
|
|
+ END;
|
|
|
|
|
+ prev := cur.prev(COMMAND);
|
|
|
|
|
+ delete(cur);
|
|
|
|
|
+ cur := prev
|
|
|
END;
|
|
END;
|
|
|
- prev := cur.prev(COMMAND);
|
|
|
|
|
- delete(cur);
|
|
|
|
|
- cur := prev
|
|
|
|
|
- END;
|
|
|
|
|
|
|
|
|
|
- setlast(cur);
|
|
|
|
|
|
|
+ setlast(cur);
|
|
|
|
|
|
|
|
- IF op = opAND THEN
|
|
|
|
|
- label := l;
|
|
|
|
|
- jz := ~jz
|
|
|
|
|
- END;
|
|
|
|
|
|
|
+ IF op = opAND THEN
|
|
|
|
|
+ label := l;
|
|
|
|
|
+ jz := ~jz
|
|
|
|
|
+ END;
|
|
|
|
|
|
|
|
- IF jz THEN
|
|
|
|
|
- Jmp(opJZ, label)
|
|
|
|
|
|
|
+ IF jz THEN
|
|
|
|
|
+ Jmp(opJZ, label)
|
|
|
|
|
+ ELSE
|
|
|
|
|
+ Jmp(opJNZ, label)
|
|
|
|
|
+ END;
|
|
|
|
|
+
|
|
|
|
|
+ IF op = opOR THEN
|
|
|
|
|
+ SetLabel(l)
|
|
|
|
|
+ END
|
|
|
ELSE
|
|
ELSE
|
|
|
- Jmp(opJNZ, label)
|
|
|
|
|
|
|
+ Jmp(opJZ, label)
|
|
|
END;
|
|
END;
|
|
|
|
|
|
|
|
- IF op = opOR THEN
|
|
|
|
|
- SetLabel(l)
|
|
|
|
|
- END
|
|
|
|
|
- ELSE
|
|
|
|
|
- Jmp(opJZ, label)
|
|
|
|
|
- END;
|
|
|
|
|
-
|
|
|
|
|
- setlast(codes.last)
|
|
|
|
|
-END AndOrOpt;
|
|
|
|
|
|
|
+ setlast(codes.last)
|
|
|
|
|
+ END AndOrOpt;
|
|
|
|
|
|
|
|
|
|
|
|
|
PROCEDURE OnError* (line, error: INTEGER);
|
|
PROCEDURE OnError* (line, error: INTEGER);
|
|
|
-BEGIN
|
|
|
|
|
- AddCmd2(opONERR, codes.errlabels[error], line)
|
|
|
|
|
-END OnError;
|
|
|
|
|
|
|
+ BEGIN
|
|
|
|
|
+ AddCmd2(opONERR, codes.errlabels[error], line)
|
|
|
|
|
+ END OnError;
|
|
|
|
|
|
|
|
|
|
|
|
|
PROCEDURE TypeGuard* (op, t: INTEGER; line, error: INTEGER);
|
|
PROCEDURE TypeGuard* (op, t: INTEGER; line, error: INTEGER);
|
|
|
-VAR
|
|
|
|
|
- label: INTEGER;
|
|
|
|
|
-BEGIN
|
|
|
|
|
- AddCmd(op, t);
|
|
|
|
|
- label := NewLabel();
|
|
|
|
|
- Jmp(opJNZ, label);
|
|
|
|
|
- OnError(line, error);
|
|
|
|
|
- SetLabel(label)
|
|
|
|
|
-END TypeGuard;
|
|
|
|
|
|
|
+ VAR
|
|
|
|
|
+ label: INTEGER;
|
|
|
|
|
+ BEGIN
|
|
|
|
|
+ AddCmd(op, t);
|
|
|
|
|
+ label := NewLabel();
|
|
|
|
|
+ Jmp(opJNZ, label);
|
|
|
|
|
+ OnError(line, error);
|
|
|
|
|
+ SetLabel(label)
|
|
|
|
|
+ END TypeGuard;
|
|
|
|
|
|
|
|
|
|
|
|
|
PROCEDURE TypeCheck* (t: INTEGER);
|
|
PROCEDURE TypeCheck* (t: INTEGER);
|
|
|
-BEGIN
|
|
|
|
|
- AddCmd(opIS, t)
|
|
|
|
|
-END TypeCheck;
|
|
|
|
|
|
|
+ BEGIN
|
|
|
|
|
+ AddCmd(opIS, t)
|
|
|
|
|
+ END TypeCheck;
|
|
|
|
|
|
|
|
|
|
|
|
|
PROCEDURE TypeCheckRec* (t: INTEGER);
|
|
PROCEDURE TypeCheckRec* (t: INTEGER);
|
|
|
-BEGIN
|
|
|
|
|
- AddCmd(opISREC, t)
|
|
|
|
|
-END TypeCheckRec;
|
|
|
|
|
|
|
+ BEGIN
|
|
|
|
|
+ AddCmd(opISREC, t)
|
|
|
|
|
+ END TypeCheckRec;
|
|
|
|
|
|
|
|
|
|
|
|
|
PROCEDURE New* (size, typenum: INTEGER);
|
|
PROCEDURE New* (size, typenum: INTEGER);
|
|
|
-BEGIN
|
|
|
|
|
- AddCmd2(opNEW, typenum, size)
|
|
|
|
|
-END New;
|
|
|
|
|
|
|
+ BEGIN
|
|
|
|
|
+ AddCmd2(opNEW, typenum, size)
|
|
|
|
|
+ END New;
|
|
|
|
|
|
|
|
|
|
|
|
|
PROCEDURE not*;
|
|
PROCEDURE not*;
|
|
|
-VAR
|
|
|
|
|
- prev: COMMAND;
|
|
|
|
|
-BEGIN
|
|
|
|
|
- prev := codes.last;
|
|
|
|
|
- IF prev.opcode = opNOT THEN
|
|
|
|
|
- codes.last := prev.prev(COMMAND);
|
|
|
|
|
- delete(prev)
|
|
|
|
|
- ELSE
|
|
|
|
|
- AddCmd0(opNOT)
|
|
|
|
|
- END
|
|
|
|
|
-END not;
|
|
|
|
|
|
|
+ VAR
|
|
|
|
|
+ prev: COMMAND;
|
|
|
|
|
+ BEGIN
|
|
|
|
|
+ prev := codes.last;
|
|
|
|
|
+ IF prev.opcode = opNOT THEN
|
|
|
|
|
+ codes.last := prev.prev(COMMAND);
|
|
|
|
|
+ delete(prev)
|
|
|
|
|
+ ELSE
|
|
|
|
|
+ AddCmd0(opNOT)
|
|
|
|
|
+ END
|
|
|
|
|
+ END not;
|
|
|
|
|
|
|
|
|
|
|
|
|
PROCEDURE _ord*;
|
|
PROCEDURE _ord*;
|
|
|
-BEGIN
|
|
|
|
|
- IF (codes.last.opcode # opAND) & (codes.last.opcode # opOR) THEN
|
|
|
|
|
- AddCmd0(opORD)
|
|
|
|
|
- END
|
|
|
|
|
-END _ord;
|
|
|
|
|
|
|
+ BEGIN
|
|
|
|
|
+ IF (codes.last.opcode # opAND) & (codes.last.opcode # opOR) THEN
|
|
|
|
|
+ AddCmd0(opORD)
|
|
|
|
|
+ END
|
|
|
|
|
+ END _ord;
|
|
|
|
|
|
|
|
|
|
|
|
|
PROCEDURE Enter* (label, params: INTEGER): COMMAND;
|
|
PROCEDURE Enter* (label, params: INTEGER): COMMAND;
|
|
|
-VAR
|
|
|
|
|
- cmd: COMMAND;
|
|
|
|
|
|
|
+ VAR
|
|
|
|
|
+ cmd: COMMAND;
|
|
|
|
|
|
|
|
-BEGIN
|
|
|
|
|
- cmd := NewCmd();
|
|
|
|
|
- cmd.opcode := opENTER;
|
|
|
|
|
- cmd.param1 := label;
|
|
|
|
|
- cmd.param3 := params;
|
|
|
|
|
- insert(codes.last, cmd)
|
|
|
|
|
|
|
+ BEGIN
|
|
|
|
|
+ cmd := NewCmd();
|
|
|
|
|
+ cmd.opcode := opENTER;
|
|
|
|
|
+ cmd.param1 := label;
|
|
|
|
|
+ cmd.param3 := params;
|
|
|
|
|
+ insert(codes.last, cmd)
|
|
|
|
|
|
|
|
- RETURN codes.last
|
|
|
|
|
-END Enter;
|
|
|
|
|
|
|
+ RETURN codes.last
|
|
|
|
|
+ END Enter;
|
|
|
|
|
|
|
|
|
|
|
|
|
PROCEDURE Leave* (result, float: BOOLEAN; locsize, paramsize: INTEGER): COMMAND;
|
|
PROCEDURE Leave* (result, float: BOOLEAN; locsize, paramsize: INTEGER): COMMAND;
|
|
|
-BEGIN
|
|
|
|
|
- IF result THEN
|
|
|
|
|
- IF float THEN
|
|
|
|
|
- AddCmd2(opLEAVEF, locsize, paramsize)
|
|
|
|
|
|
|
+ BEGIN
|
|
|
|
|
+ IF result THEN
|
|
|
|
|
+ IF float THEN
|
|
|
|
|
+ AddCmd2(opLEAVEF, locsize, paramsize)
|
|
|
|
|
+ ELSE
|
|
|
|
|
+ AddCmd2(opLEAVER, locsize, paramsize)
|
|
|
|
|
+ END
|
|
|
ELSE
|
|
ELSE
|
|
|
- AddCmd2(opLEAVER, locsize, paramsize)
|
|
|
|
|
|
|
+ AddCmd2(opLEAVE, locsize, paramsize)
|
|
|
END
|
|
END
|
|
|
- ELSE
|
|
|
|
|
- AddCmd2(opLEAVE, locsize, paramsize)
|
|
|
|
|
- END
|
|
|
|
|
|
|
|
|
|
- RETURN codes.last
|
|
|
|
|
-END Leave;
|
|
|
|
|
|
|
+ RETURN codes.last
|
|
|
|
|
+ END Leave;
|
|
|
|
|
|
|
|
|
|
|
|
|
PROCEDURE EnterC* (label: INTEGER): COMMAND;
|
|
PROCEDURE EnterC* (label: INTEGER): COMMAND;
|
|
|
-BEGIN
|
|
|
|
|
- SetLabel(label)
|
|
|
|
|
- RETURN codes.last
|
|
|
|
|
-END EnterC;
|
|
|
|
|
|
|
+ BEGIN
|
|
|
|
|
+ SetLabel(label)
|
|
|
|
|
+ RETURN codes.last
|
|
|
|
|
+ END EnterC;
|
|
|
|
|
|
|
|
|
|
|
|
|
PROCEDURE LeaveC* (): COMMAND;
|
|
PROCEDURE LeaveC* (): COMMAND;
|
|
|
-BEGIN
|
|
|
|
|
- AddCmd0(opLEAVEC)
|
|
|
|
|
- RETURN codes.last
|
|
|
|
|
-END LeaveC;
|
|
|
|
|
|
|
+ BEGIN
|
|
|
|
|
+ AddCmd0(opLEAVEC)
|
|
|
|
|
+ RETURN codes.last
|
|
|
|
|
+ END LeaveC;
|
|
|
|
|
|
|
|
|
|
|
|
|
PROCEDURE fastcall (VAR callconv: INTEGER);
|
|
PROCEDURE fastcall (VAR callconv: INTEGER);
|
|
|
-BEGIN
|
|
|
|
|
- IF callconv = call_fast1 THEN
|
|
|
|
|
- AddCmd(opFASTCALL, 1);
|
|
|
|
|
- callconv := call_stack
|
|
|
|
|
- ELSIF callconv = call_fast2 THEN
|
|
|
|
|
- AddCmd(opFASTCALL, 2);
|
|
|
|
|
- callconv := call_stack
|
|
|
|
|
- END
|
|
|
|
|
-END fastcall;
|
|
|
|
|
|
|
+ BEGIN
|
|
|
|
|
+ IF callconv = call_fast1 THEN
|
|
|
|
|
+ AddCmd(opFASTCALL, 1);
|
|
|
|
|
+ callconv := call_stack
|
|
|
|
|
+ ELSIF callconv = call_fast2 THEN
|
|
|
|
|
+ AddCmd(opFASTCALL, 2);
|
|
|
|
|
+ callconv := call_stack
|
|
|
|
|
+ END
|
|
|
|
|
+ END fastcall;
|
|
|
|
|
|
|
|
|
|
|
|
|
PROCEDURE Call* (proc, callconv, fparams: INTEGER);
|
|
PROCEDURE Call* (proc, callconv, fparams: INTEGER);
|
|
|
-BEGIN
|
|
|
|
|
- fastcall(callconv);
|
|
|
|
|
- CASE callconv OF
|
|
|
|
|
- |call_stack: Jmp(opCALL, proc)
|
|
|
|
|
- |call_win64: Jmp(opWIN64CALL, proc)
|
|
|
|
|
- |call_sysv: Jmp(opSYSVCALL, proc)
|
|
|
|
|
- END;
|
|
|
|
|
- codes.last(COMMAND).param2 := fparams
|
|
|
|
|
-END Call;
|
|
|
|
|
|
|
+ BEGIN
|
|
|
|
|
+ fastcall(callconv);
|
|
|
|
|
+ CASE callconv OF
|
|
|
|
|
+ |call_stack: Jmp(opCALL, proc)
|
|
|
|
|
+ |call_win64: Jmp(opWIN64CALL, proc)
|
|
|
|
|
+ |call_sysv: Jmp(opSYSVCALL, proc)
|
|
|
|
|
+ END;
|
|
|
|
|
+ codes.last(COMMAND).param2 := fparams
|
|
|
|
|
+ END Call;
|
|
|
|
|
|
|
|
|
|
|
|
|
PROCEDURE CallImp* (proc: LISTS.ITEM; callconv, fparams: INTEGER);
|
|
PROCEDURE CallImp* (proc: LISTS.ITEM; callconv, fparams: INTEGER);
|
|
|
-BEGIN
|
|
|
|
|
- fastcall(callconv);
|
|
|
|
|
- CASE callconv OF
|
|
|
|
|
- |call_stack: Jmp(opCALLI, proc(IMPORT_PROC).label)
|
|
|
|
|
- |call_win64: Jmp(opWIN64CALLI, proc(IMPORT_PROC).label)
|
|
|
|
|
- |call_sysv: Jmp(opSYSVCALLI, proc(IMPORT_PROC).label)
|
|
|
|
|
- END;
|
|
|
|
|
- codes.last(COMMAND).param2 := fparams
|
|
|
|
|
-END CallImp;
|
|
|
|
|
|
|
+ BEGIN
|
|
|
|
|
+ fastcall(callconv);
|
|
|
|
|
+ CASE callconv OF
|
|
|
|
|
+ |call_stack: Jmp(opCALLI, proc(IMPORT_PROC).label)
|
|
|
|
|
+ |call_win64: Jmp(opWIN64CALLI, proc(IMPORT_PROC).label)
|
|
|
|
|
+ |call_sysv: Jmp(opSYSVCALLI, proc(IMPORT_PROC).label)
|
|
|
|
|
+ END;
|
|
|
|
|
+ codes.last(COMMAND).param2 := fparams
|
|
|
|
|
+ END CallImp;
|
|
|
|
|
|
|
|
|
|
|
|
|
PROCEDURE CallP* (callconv, fparams: INTEGER);
|
|
PROCEDURE CallP* (callconv, fparams: INTEGER);
|
|
|
-BEGIN
|
|
|
|
|
- fastcall(callconv);
|
|
|
|
|
- CASE callconv OF
|
|
|
|
|
- |call_stack: AddCmd0(opCALLP)
|
|
|
|
|
- |call_win64: AddCmd(opWIN64CALLP, fparams)
|
|
|
|
|
- |call_sysv: AddCmd(opSYSVCALLP, fparams)
|
|
|
|
|
- END
|
|
|
|
|
-END CallP;
|
|
|
|
|
|
|
+ BEGIN
|
|
|
|
|
+ fastcall(callconv);
|
|
|
|
|
+ CASE callconv OF
|
|
|
|
|
+ |call_stack: AddCmd0(opCALLP)
|
|
|
|
|
+ |call_win64: AddCmd(opWIN64CALLP, fparams)
|
|
|
|
|
+ |call_sysv: AddCmd(opSYSVCALLP, fparams)
|
|
|
|
|
+ END
|
|
|
|
|
+ END CallP;
|
|
|
|
|
|
|
|
|
|
|
|
|
PROCEDURE AssignProc* (proc: INTEGER);
|
|
PROCEDURE AssignProc* (proc: INTEGER);
|
|
|
-BEGIN
|
|
|
|
|
- Jmp(opSAVEP, proc)
|
|
|
|
|
-END AssignProc;
|
|
|
|
|
|
|
+ BEGIN
|
|
|
|
|
+ Jmp(opSAVEP, proc)
|
|
|
|
|
+ END AssignProc;
|
|
|
|
|
|
|
|
|
|
|
|
|
PROCEDURE AssignImpProc* (proc: LISTS.ITEM);
|
|
PROCEDURE AssignImpProc* (proc: LISTS.ITEM);
|
|
|
-BEGIN
|
|
|
|
|
- Jmp(opSAVEIP, proc(IMPORT_PROC).label)
|
|
|
|
|
-END AssignImpProc;
|
|
|
|
|
|
|
+ BEGIN
|
|
|
|
|
+ Jmp(opSAVEIP, proc(IMPORT_PROC).label)
|
|
|
|
|
+ END AssignImpProc;
|
|
|
|
|
|
|
|
|
|
|
|
|
PROCEDURE PushProc* (proc: INTEGER);
|
|
PROCEDURE PushProc* (proc: INTEGER);
|
|
|
-BEGIN
|
|
|
|
|
- Jmp(opPUSHP, proc)
|
|
|
|
|
-END PushProc;
|
|
|
|
|
|
|
+ BEGIN
|
|
|
|
|
+ Jmp(opPUSHP, proc)
|
|
|
|
|
+ END PushProc;
|
|
|
|
|
|
|
|
|
|
|
|
|
PROCEDURE PushImpProc* (proc: LISTS.ITEM);
|
|
PROCEDURE PushImpProc* (proc: LISTS.ITEM);
|
|
|
-BEGIN
|
|
|
|
|
- Jmp(opPUSHIP, proc(IMPORT_PROC).label)
|
|
|
|
|
-END PushImpProc;
|
|
|
|
|
|
|
+ BEGIN
|
|
|
|
|
+ Jmp(opPUSHIP, proc(IMPORT_PROC).label)
|
|
|
|
|
+ END PushImpProc;
|
|
|
|
|
|
|
|
|
|
|
|
|
PROCEDURE ProcCmp* (proc: INTEGER; eq: BOOLEAN);
|
|
PROCEDURE ProcCmp* (proc: INTEGER; eq: BOOLEAN);
|
|
|
-BEGIN
|
|
|
|
|
- IF eq THEN
|
|
|
|
|
- Jmp(opEQP, proc)
|
|
|
|
|
- ELSE
|
|
|
|
|
- Jmp(opNEP, proc)
|
|
|
|
|
- END
|
|
|
|
|
-END ProcCmp;
|
|
|
|
|
|
|
+ BEGIN
|
|
|
|
|
+ IF eq THEN
|
|
|
|
|
+ Jmp(opEQP, proc)
|
|
|
|
|
+ ELSE
|
|
|
|
|
+ Jmp(opNEP, proc)
|
|
|
|
|
+ END
|
|
|
|
|
+ END ProcCmp;
|
|
|
|
|
|
|
|
|
|
|
|
|
PROCEDURE ProcImpCmp* (proc: LISTS.ITEM; eq: BOOLEAN);
|
|
PROCEDURE ProcImpCmp* (proc: LISTS.ITEM; eq: BOOLEAN);
|
|
|
-BEGIN
|
|
|
|
|
- IF eq THEN
|
|
|
|
|
- Jmp(opEQIP, proc(IMPORT_PROC).label)
|
|
|
|
|
- ELSE
|
|
|
|
|
- Jmp(opNEIP, proc(IMPORT_PROC).label)
|
|
|
|
|
- END
|
|
|
|
|
-END ProcImpCmp;
|
|
|
|
|
|
|
+ BEGIN
|
|
|
|
|
+ IF eq THEN
|
|
|
|
|
+ Jmp(opEQIP, proc(IMPORT_PROC).label)
|
|
|
|
|
+ ELSE
|
|
|
|
|
+ Jmp(opNEIP, proc(IMPORT_PROC).label)
|
|
|
|
|
+ END
|
|
|
|
|
+ END ProcImpCmp;
|
|
|
|
|
|
|
|
|
|
|
|
|
PROCEDURE load* (size: INTEGER);
|
|
PROCEDURE load* (size: INTEGER);
|
|
|
-VAR
|
|
|
|
|
- last: COMMAND;
|
|
|
|
|
-
|
|
|
|
|
-BEGIN
|
|
|
|
|
- last := codes.last;
|
|
|
|
|
- CASE size OF
|
|
|
|
|
- |1:
|
|
|
|
|
- IF last.opcode = opLADR THEN
|
|
|
|
|
- last.opcode := opLLOAD8
|
|
|
|
|
- ELSIF last.opcode = opVADR THEN
|
|
|
|
|
- last.opcode := opVLOAD8
|
|
|
|
|
- ELSIF last.opcode = opGADR THEN
|
|
|
|
|
- last.opcode := opGLOAD8
|
|
|
|
|
- ELSE
|
|
|
|
|
- AddCmd0(opLOAD8)
|
|
|
|
|
- END
|
|
|
|
|
|
|
+ VAR
|
|
|
|
|
+ last: COMMAND;
|
|
|
|
|
|
|
|
- |2:
|
|
|
|
|
- IF last.opcode = opLADR THEN
|
|
|
|
|
- last.opcode := opLLOAD16
|
|
|
|
|
- ELSIF last.opcode = opVADR THEN
|
|
|
|
|
- last.opcode := opVLOAD16
|
|
|
|
|
- ELSIF last.opcode = opGADR THEN
|
|
|
|
|
- last.opcode := opGLOAD16
|
|
|
|
|
- ELSE
|
|
|
|
|
- AddCmd0(opLOAD16)
|
|
|
|
|
- END
|
|
|
|
|
|
|
+ BEGIN
|
|
|
|
|
+ last := codes.last;
|
|
|
|
|
+ CASE size OF
|
|
|
|
|
+ |1:
|
|
|
|
|
+ IF last.opcode = opLADR THEN
|
|
|
|
|
+ last.opcode := opLLOAD8
|
|
|
|
|
+ ELSIF last.opcode = opVADR THEN
|
|
|
|
|
+ last.opcode := opVLOAD8
|
|
|
|
|
+ ELSIF last.opcode = opGADR THEN
|
|
|
|
|
+ last.opcode := opGLOAD8
|
|
|
|
|
+ ELSE
|
|
|
|
|
+ AddCmd0(opLOAD8)
|
|
|
|
|
+ END
|
|
|
|
|
|
|
|
- |4:
|
|
|
|
|
- IF last.opcode = opLADR THEN
|
|
|
|
|
- last.opcode := opLLOAD32
|
|
|
|
|
- ELSIF last.opcode = opVADR THEN
|
|
|
|
|
- last.opcode := opVLOAD32
|
|
|
|
|
- ELSIF last.opcode = opGADR THEN
|
|
|
|
|
- last.opcode := opGLOAD32
|
|
|
|
|
- ELSE
|
|
|
|
|
- AddCmd0(opLOAD32)
|
|
|
|
|
- END
|
|
|
|
|
|
|
+ |2:
|
|
|
|
|
+ IF last.opcode = opLADR THEN
|
|
|
|
|
+ last.opcode := opLLOAD16
|
|
|
|
|
+ ELSIF last.opcode = opVADR THEN
|
|
|
|
|
+ last.opcode := opVLOAD16
|
|
|
|
|
+ ELSIF last.opcode = opGADR THEN
|
|
|
|
|
+ last.opcode := opGLOAD16
|
|
|
|
|
+ ELSE
|
|
|
|
|
+ AddCmd0(opLOAD16)
|
|
|
|
|
+ END
|
|
|
|
|
|
|
|
- |8:
|
|
|
|
|
- IF last.opcode = opLADR THEN
|
|
|
|
|
- last.opcode := opLLOAD64
|
|
|
|
|
- ELSIF last.opcode = opVADR THEN
|
|
|
|
|
- last.opcode := opVLOAD64
|
|
|
|
|
- ELSIF last.opcode = opGADR THEN
|
|
|
|
|
- last.opcode := opGLOAD64
|
|
|
|
|
- ELSE
|
|
|
|
|
- AddCmd0(opLOAD64)
|
|
|
|
|
|
|
+ |4:
|
|
|
|
|
+ IF last.opcode = opLADR THEN
|
|
|
|
|
+ last.opcode := opLLOAD32
|
|
|
|
|
+ ELSIF last.opcode = opVADR THEN
|
|
|
|
|
+ last.opcode := opVLOAD32
|
|
|
|
|
+ ELSIF last.opcode = opGADR THEN
|
|
|
|
|
+ last.opcode := opGLOAD32
|
|
|
|
|
+ ELSE
|
|
|
|
|
+ AddCmd0(opLOAD32)
|
|
|
|
|
+ END
|
|
|
|
|
+
|
|
|
|
|
+ |8:
|
|
|
|
|
+ IF last.opcode = opLADR THEN
|
|
|
|
|
+ last.opcode := opLLOAD64
|
|
|
|
|
+ ELSIF last.opcode = opVADR THEN
|
|
|
|
|
+ last.opcode := opVLOAD64
|
|
|
|
|
+ ELSIF last.opcode = opGADR THEN
|
|
|
|
|
+ last.opcode := opGLOAD64
|
|
|
|
|
+ ELSE
|
|
|
|
|
+ AddCmd0(opLOAD64)
|
|
|
|
|
+ END
|
|
|
END
|
|
END
|
|
|
- END
|
|
|
|
|
-END load;
|
|
|
|
|
|
|
+ END load;
|
|
|
|
|
|
|
|
|
|
|
|
|
PROCEDURE SysPut* (size: INTEGER);
|
|
PROCEDURE SysPut* (size: INTEGER);
|
|
|
-BEGIN
|
|
|
|
|
- CASE size OF
|
|
|
|
|
- |1: AddCmd0(opSAVE8)
|
|
|
|
|
- |2: AddCmd0(opSAVE16)
|
|
|
|
|
- |4: AddCmd0(opSAVE32)
|
|
|
|
|
- |8: AddCmd0(opSAVE64)
|
|
|
|
|
- END
|
|
|
|
|
-END SysPut;
|
|
|
|
|
|
|
+ BEGIN
|
|
|
|
|
+ CASE size OF
|
|
|
|
|
+ |1: AddCmd0(opSAVE8)
|
|
|
|
|
+ |2: AddCmd0(opSAVE16)
|
|
|
|
|
+ |4: AddCmd0(opSAVE32)
|
|
|
|
|
+ |8: AddCmd0(opSAVE64)
|
|
|
|
|
+ END
|
|
|
|
|
+ END SysPut;
|
|
|
|
|
|
|
|
|
|
|
|
|
PROCEDURE savef* (inv: BOOLEAN);
|
|
PROCEDURE savef* (inv: BOOLEAN);
|
|
|
-BEGIN
|
|
|
|
|
- IF inv THEN
|
|
|
|
|
- AddCmd0(opSAVEFI)
|
|
|
|
|
- ELSE
|
|
|
|
|
- AddCmd0(opSAVEF)
|
|
|
|
|
- END
|
|
|
|
|
-END savef;
|
|
|
|
|
|
|
+ BEGIN
|
|
|
|
|
+ IF inv THEN
|
|
|
|
|
+ AddCmd0(opSAVEFI)
|
|
|
|
|
+ ELSE
|
|
|
|
|
+ AddCmd0(opSAVEF)
|
|
|
|
|
+ END
|
|
|
|
|
+ END savef;
|
|
|
|
|
|
|
|
|
|
|
|
|
PROCEDURE saves* (offset, length: INTEGER);
|
|
PROCEDURE saves* (offset, length: INTEGER);
|
|
|
-BEGIN
|
|
|
|
|
- AddCmd2(opSAVES, length, offset)
|
|
|
|
|
-END saves;
|
|
|
|
|
|
|
+ BEGIN
|
|
|
|
|
+ AddCmd2(opSAVES, length, offset)
|
|
|
|
|
+ END saves;
|
|
|
|
|
|
|
|
|
|
|
|
|
PROCEDURE abs* (real: BOOLEAN);
|
|
PROCEDURE abs* (real: BOOLEAN);
|
|
|
-BEGIN
|
|
|
|
|
- IF real THEN
|
|
|
|
|
- AddCmd0(opFABS)
|
|
|
|
|
- ELSE
|
|
|
|
|
- AddCmd0(opABS)
|
|
|
|
|
- END
|
|
|
|
|
-END abs;
|
|
|
|
|
|
|
+ BEGIN
|
|
|
|
|
+ IF real THEN
|
|
|
|
|
+ AddCmd0(opFABS)
|
|
|
|
|
+ ELSE
|
|
|
|
|
+ AddCmd0(opABS)
|
|
|
|
|
+ END
|
|
|
|
|
+ END abs;
|
|
|
|
|
|
|
|
|
|
|
|
|
PROCEDURE shift_minmax* (op: CHAR);
|
|
PROCEDURE shift_minmax* (op: CHAR);
|
|
|
-BEGIN
|
|
|
|
|
- CASE op OF
|
|
|
|
|
- |"A": AddCmd0(opASR)
|
|
|
|
|
- |"L": AddCmd0(opLSL)
|
|
|
|
|
- |"O": AddCmd0(opROR)
|
|
|
|
|
- |"R": AddCmd0(opLSR)
|
|
|
|
|
- |"m": AddCmd0(opMIN)
|
|
|
|
|
- |"x": AddCmd0(opMAX)
|
|
|
|
|
- END
|
|
|
|
|
-END shift_minmax;
|
|
|
|
|
|
|
+ BEGIN
|
|
|
|
|
+ CASE op OF
|
|
|
|
|
+ |"A": AddCmd0(opASR)
|
|
|
|
|
+ |"L": AddCmd0(opLSL)
|
|
|
|
|
+ |"O": AddCmd0(opROR)
|
|
|
|
|
+ |"R": AddCmd0(opLSR)
|
|
|
|
|
+ |"m": AddCmd0(opMIN)
|
|
|
|
|
+ |"x": AddCmd0(opMAX)
|
|
|
|
|
+ END
|
|
|
|
|
+ END shift_minmax;
|
|
|
|
|
|
|
|
|
|
|
|
|
PROCEDURE shift_minmax1* (op: CHAR; x: INTEGER);
|
|
PROCEDURE shift_minmax1* (op: CHAR; x: INTEGER);
|
|
|
-BEGIN
|
|
|
|
|
- CASE op OF
|
|
|
|
|
- |"A": AddCmd(opASR1, x)
|
|
|
|
|
- |"L": AddCmd(opLSL1, x)
|
|
|
|
|
- |"O": AddCmd(opROR1, x)
|
|
|
|
|
- |"R": AddCmd(opLSR1, x)
|
|
|
|
|
- |"m": AddCmd(opMINC, x)
|
|
|
|
|
- |"x": AddCmd(opMAXC, x)
|
|
|
|
|
- END
|
|
|
|
|
-END shift_minmax1;
|
|
|
|
|
|
|
+ BEGIN
|
|
|
|
|
+ CASE op OF
|
|
|
|
|
+ |"A": AddCmd(opASR1, x)
|
|
|
|
|
+ |"L": AddCmd(opLSL1, x)
|
|
|
|
|
+ |"O": AddCmd(opROR1, x)
|
|
|
|
|
+ |"R": AddCmd(opLSR1, x)
|
|
|
|
|
+ |"m": AddCmd(opMINC, x)
|
|
|
|
|
+ |"x": AddCmd(opMAXC, x)
|
|
|
|
|
+ END
|
|
|
|
|
+ END shift_minmax1;
|
|
|
|
|
|
|
|
|
|
|
|
|
PROCEDURE shift_minmax2* (op: CHAR; x: INTEGER);
|
|
PROCEDURE shift_minmax2* (op: CHAR; x: INTEGER);
|
|
|
-BEGIN
|
|
|
|
|
- CASE op OF
|
|
|
|
|
- |"A": AddCmd(opASR2, x)
|
|
|
|
|
- |"L": AddCmd(opLSL2, x)
|
|
|
|
|
- |"O": AddCmd(opROR2, x)
|
|
|
|
|
- |"R": AddCmd(opLSR2, x)
|
|
|
|
|
- |"m": AddCmd(opMINC, x)
|
|
|
|
|
- |"x": AddCmd(opMAXC, x)
|
|
|
|
|
- END
|
|
|
|
|
-END shift_minmax2;
|
|
|
|
|
|
|
+ BEGIN
|
|
|
|
|
+ CASE op OF
|
|
|
|
|
+ |"A": AddCmd(opASR2, x)
|
|
|
|
|
+ |"L": AddCmd(opLSL2, x)
|
|
|
|
|
+ |"O": AddCmd(opROR2, x)
|
|
|
|
|
+ |"R": AddCmd(opLSR2, x)
|
|
|
|
|
+ |"m": AddCmd(opMINC, x)
|
|
|
|
|
+ |"x": AddCmd(opMAXC, x)
|
|
|
|
|
+ END
|
|
|
|
|
+ END shift_minmax2;
|
|
|
|
|
|
|
|
|
|
|
|
|
PROCEDURE len* (dim: INTEGER);
|
|
PROCEDURE len* (dim: INTEGER);
|
|
|
-BEGIN
|
|
|
|
|
- AddCmd(opLEN, dim)
|
|
|
|
|
-END len;
|
|
|
|
|
|
|
+ BEGIN
|
|
|
|
|
+ AddCmd(opLEN, dim)
|
|
|
|
|
+ END len;
|
|
|
|
|
|
|
|
|
|
|
|
|
PROCEDURE Float* (r: REAL; line, col: INTEGER);
|
|
PROCEDURE Float* (r: REAL; line, col: INTEGER);
|
|
|
-VAR
|
|
|
|
|
- cmd: COMMAND;
|
|
|
|
|
|
|
+ VAR
|
|
|
|
|
+ cmd: COMMAND;
|
|
|
|
|
|
|
|
-BEGIN
|
|
|
|
|
- cmd := NewCmd();
|
|
|
|
|
- cmd.opcode := opCONSTF;
|
|
|
|
|
- cmd.float := r;
|
|
|
|
|
- cmd.param1 := line;
|
|
|
|
|
- cmd.param2 := col;
|
|
|
|
|
- insert(codes.last, cmd)
|
|
|
|
|
-END Float;
|
|
|
|
|
|
|
+ BEGIN
|
|
|
|
|
+ cmd := NewCmd();
|
|
|
|
|
+ cmd.opcode := opCONSTF;
|
|
|
|
|
+ cmd.float := r;
|
|
|
|
|
+ cmd.param1 := line;
|
|
|
|
|
+ cmd.param2 := col;
|
|
|
|
|
+ insert(codes.last, cmd)
|
|
|
|
|
+ END Float;
|
|
|
|
|
|
|
|
|
|
|
|
|
PROCEDURE drop*;
|
|
PROCEDURE drop*;
|
|
|
-BEGIN
|
|
|
|
|
- AddCmd0(opDROP)
|
|
|
|
|
-END drop;
|
|
|
|
|
|
|
+ BEGIN
|
|
|
|
|
+ AddCmd0(opDROP)
|
|
|
|
|
+ END drop;
|
|
|
|
|
|
|
|
|
|
|
|
|
PROCEDURE _case* (a, b, L, R: INTEGER);
|
|
PROCEDURE _case* (a, b, L, R: INTEGER);
|
|
|
-VAR
|
|
|
|
|
- cmd: COMMAND;
|
|
|
|
|
|
|
+ VAR
|
|
|
|
|
+ cmd: COMMAND;
|
|
|
|
|
|
|
|
-BEGIN
|
|
|
|
|
- IF a = b THEN
|
|
|
|
|
- cmd := NewCmd();
|
|
|
|
|
- cmd.opcode := opCASELR;
|
|
|
|
|
- cmd.param1 := a;
|
|
|
|
|
- cmd.param2 := L;
|
|
|
|
|
- cmd.param3 := R;
|
|
|
|
|
- insert(codes.last, cmd)
|
|
|
|
|
- ELSE
|
|
|
|
|
- AddCmd2(opCASEL, a, L);
|
|
|
|
|
- AddCmd2(opCASER, b, R)
|
|
|
|
|
- END
|
|
|
|
|
-END _case;
|
|
|
|
|
|
|
+ BEGIN
|
|
|
|
|
+ IF a = b THEN
|
|
|
|
|
+ cmd := NewCmd();
|
|
|
|
|
+ cmd.opcode := opCASELR;
|
|
|
|
|
+ cmd.param1 := a;
|
|
|
|
|
+ cmd.param2 := L;
|
|
|
|
|
+ cmd.param3 := R;
|
|
|
|
|
+ insert(codes.last, cmd)
|
|
|
|
|
+ ELSE
|
|
|
|
|
+ AddCmd2(opCASEL, a, L);
|
|
|
|
|
+ AddCmd2(opCASER, b, R)
|
|
|
|
|
+ END
|
|
|
|
|
+ END _case;
|
|
|
|
|
|
|
|
|
|
|
|
|
PROCEDURE fname* (name: PATHS.PATH);
|
|
PROCEDURE fname* (name: PATHS.PATH);
|
|
|
-VAR
|
|
|
|
|
- cmd: FNAMECMD;
|
|
|
|
|
|
|
+ VAR
|
|
|
|
|
+ cmd: FNAMECMD;
|
|
|
|
|
|
|
|
-BEGIN
|
|
|
|
|
- NEW(cmd);
|
|
|
|
|
- cmd.opcode := opFNAME;
|
|
|
|
|
- cmd.fname := name;
|
|
|
|
|
- insert(codes.last, cmd)
|
|
|
|
|
-END fname;
|
|
|
|
|
|
|
+ BEGIN
|
|
|
|
|
+ NEW(cmd);
|
|
|
|
|
+ cmd.opcode := opFNAME;
|
|
|
|
|
+ cmd.fname := name;
|
|
|
|
|
+ insert(codes.last, cmd)
|
|
|
|
|
+ END fname;
|
|
|
|
|
|
|
|
|
|
|
|
|
PROCEDURE AddExp* (label: INTEGER; name: SCAN.IDSTR);
|
|
PROCEDURE AddExp* (label: INTEGER; name: SCAN.IDSTR);
|
|
|
-VAR
|
|
|
|
|
- exp: EXPORT_PROC;
|
|
|
|
|
|
|
+ VAR
|
|
|
|
|
+ exp: EXPORT_PROC;
|
|
|
|
|
|
|
|
-BEGIN
|
|
|
|
|
- NEW(exp);
|
|
|
|
|
- exp.label := label;
|
|
|
|
|
- exp.name := name;
|
|
|
|
|
- LISTS.push(codes.export, exp)
|
|
|
|
|
-END AddExp;
|
|
|
|
|
|
|
+ BEGIN
|
|
|
|
|
+ NEW(exp);
|
|
|
|
|
+ exp.label := label;
|
|
|
|
|
+ exp.name := name;
|
|
|
|
|
+ LISTS.push(codes.export, exp)
|
|
|
|
|
+ END AddExp;
|
|
|
|
|
|
|
|
|
|
|
|
|
PROCEDURE AddImp* (dll, proc: SCAN.TEXTSTR): IMPORT_PROC;
|
|
PROCEDURE AddImp* (dll, proc: SCAN.TEXTSTR): IMPORT_PROC;
|
|
|
-VAR
|
|
|
|
|
- lib: IMPORT_LIB;
|
|
|
|
|
- p: IMPORT_PROC;
|
|
|
|
|
|
|
+ VAR
|
|
|
|
|
+ lib: IMPORT_LIB;
|
|
|
|
|
+ p: IMPORT_PROC;
|
|
|
|
|
|
|
|
-BEGIN
|
|
|
|
|
- lib := codes._import.first(IMPORT_LIB);
|
|
|
|
|
- WHILE (lib # NIL) & (lib.name # dll) DO
|
|
|
|
|
- lib := lib.next(IMPORT_LIB)
|
|
|
|
|
- END;
|
|
|
|
|
|
|
+ BEGIN
|
|
|
|
|
+ lib := codes._import.first(IMPORT_LIB);
|
|
|
|
|
+ WHILE (lib # NIL) & (lib.name # dll) DO
|
|
|
|
|
+ lib := lib.next(IMPORT_LIB)
|
|
|
|
|
+ END;
|
|
|
|
|
|
|
|
- IF lib = NIL THEN
|
|
|
|
|
- NEW(lib);
|
|
|
|
|
- lib.name := dll;
|
|
|
|
|
- lib.procs := LISTS.create(NIL);
|
|
|
|
|
- LISTS.push(codes._import, lib)
|
|
|
|
|
- END;
|
|
|
|
|
|
|
+ IF lib = NIL THEN
|
|
|
|
|
+ NEW(lib);
|
|
|
|
|
+ lib.name := dll;
|
|
|
|
|
+ lib.procs := LISTS.create(NIL);
|
|
|
|
|
+ LISTS.push(codes._import, lib)
|
|
|
|
|
+ END;
|
|
|
|
|
|
|
|
- p := lib.procs.first(IMPORT_PROC);
|
|
|
|
|
- WHILE (p # NIL) & (p.name # proc) DO
|
|
|
|
|
- p := p.next(IMPORT_PROC)
|
|
|
|
|
- END;
|
|
|
|
|
|
|
+ p := lib.procs.first(IMPORT_PROC);
|
|
|
|
|
+ WHILE (p # NIL) & (p.name # proc) DO
|
|
|
|
|
+ p := p.next(IMPORT_PROC)
|
|
|
|
|
+ END;
|
|
|
|
|
|
|
|
- IF p = NIL THEN
|
|
|
|
|
- NEW(p);
|
|
|
|
|
- p.name := proc;
|
|
|
|
|
- p.label := NewLabel();
|
|
|
|
|
- p.lib := lib;
|
|
|
|
|
- p.count := 1;
|
|
|
|
|
- LISTS.push(lib.procs, p)
|
|
|
|
|
- ELSE
|
|
|
|
|
- INC(p.count)
|
|
|
|
|
- END
|
|
|
|
|
|
|
+ IF p = NIL THEN
|
|
|
|
|
+ NEW(p);
|
|
|
|
|
+ p.name := proc;
|
|
|
|
|
+ p.label := NewLabel();
|
|
|
|
|
+ p.lib := lib;
|
|
|
|
|
+ p.count := 1;
|
|
|
|
|
+ LISTS.push(lib.procs, p)
|
|
|
|
|
+ ELSE
|
|
|
|
|
+ INC(p.count)
|
|
|
|
|
+ END
|
|
|
|
|
|
|
|
- RETURN p
|
|
|
|
|
-END AddImp;
|
|
|
|
|
|
|
+ RETURN p
|
|
|
|
|
+ END AddImp;
|
|
|
|
|
|
|
|
|
|
|
|
|
PROCEDURE DelImport* (imp: LISTS.ITEM);
|
|
PROCEDURE DelImport* (imp: LISTS.ITEM);
|
|
|
-VAR
|
|
|
|
|
- lib: IMPORT_LIB;
|
|
|
|
|
-
|
|
|
|
|
-BEGIN
|
|
|
|
|
- DEC(imp(IMPORT_PROC).count);
|
|
|
|
|
- IF imp(IMPORT_PROC).count = 0 THEN
|
|
|
|
|
- lib := imp(IMPORT_PROC).lib;
|
|
|
|
|
- LISTS.delete(lib.procs, imp);
|
|
|
|
|
- IF lib.procs.first = NIL THEN
|
|
|
|
|
- LISTS.delete(codes._import, lib)
|
|
|
|
|
|
|
+ VAR
|
|
|
|
|
+ lib: IMPORT_LIB;
|
|
|
|
|
+
|
|
|
|
|
+ BEGIN
|
|
|
|
|
+ DEC(imp(IMPORT_PROC).count);
|
|
|
|
|
+ IF imp(IMPORT_PROC).count = 0 THEN
|
|
|
|
|
+ lib := imp(IMPORT_PROC).lib;
|
|
|
|
|
+ LISTS.delete(lib.procs, imp);
|
|
|
|
|
+ IF lib.procs.first = NIL THEN
|
|
|
|
|
+ LISTS.delete(codes._import, lib)
|
|
|
|
|
+ END
|
|
|
END
|
|
END
|
|
|
- END
|
|
|
|
|
-END DelImport;
|
|
|
|
|
|
|
+ END DelImport;
|
|
|
|
|
|
|
|
|
|
|
|
|
PROCEDURE init* (pCPU: INTEGER);
|
|
PROCEDURE init* (pCPU: INTEGER);
|
|
|
-VAR
|
|
|
|
|
- cmd: COMMAND;
|
|
|
|
|
- i: INTEGER;
|
|
|
|
|
|
|
+ VAR
|
|
|
|
|
+ cmd: COMMAND;
|
|
|
|
|
+ i: INTEGER;
|
|
|
|
|
|
|
|
-BEGIN
|
|
|
|
|
- commands := C.create();
|
|
|
|
|
|
|
+ BEGIN
|
|
|
|
|
+ commands := C.create();
|
|
|
|
|
|
|
|
- CPU := pCPU;
|
|
|
|
|
|
|
+ CPU := pCPU;
|
|
|
|
|
|
|
|
- NEW(codes.begcall);
|
|
|
|
|
- codes.begcall.top := -1;
|
|
|
|
|
- NEW(codes.endcall);
|
|
|
|
|
- codes.endcall.top := -1;
|
|
|
|
|
- codes.commands := LISTS.create(NIL);
|
|
|
|
|
- codes.export := LISTS.create(NIL);
|
|
|
|
|
- codes._import := LISTS.create(NIL);
|
|
|
|
|
- codes.types := CHL.CreateIntList();
|
|
|
|
|
- codes.data := CHL.CreateByteList();
|
|
|
|
|
|
|
+ NEW(codes.begcall);
|
|
|
|
|
+ codes.begcall.top := -1;
|
|
|
|
|
+ NEW(codes.endcall);
|
|
|
|
|
+ codes.endcall.top := -1;
|
|
|
|
|
+ codes.commands := LISTS.create(NIL);
|
|
|
|
|
+ codes.export := LISTS.create(NIL);
|
|
|
|
|
+ codes._import := LISTS.create(NIL);
|
|
|
|
|
+ codes.types := CHL.CreateIntList();
|
|
|
|
|
+ codes.data := CHL.CreateByteList();
|
|
|
|
|
|
|
|
- NEW(cmd); cmd.opcode := opNOP; LISTS.push(codes.commands, cmd);
|
|
|
|
|
- codes.last := cmd;
|
|
|
|
|
- NEW(cmd); cmd.opcode := opNOP; LISTS.push(codes.commands, cmd);
|
|
|
|
|
|
|
+ NEW(cmd); cmd.opcode := opNOP; LISTS.push(codes.commands, cmd);
|
|
|
|
|
+ codes.last := cmd;
|
|
|
|
|
+ NEW(cmd); cmd.opcode := opNOP; LISTS.push(codes.commands, cmd);
|
|
|
|
|
|
|
|
- AddRec(0);
|
|
|
|
|
|
|
+ AddRec(0);
|
|
|
|
|
|
|
|
- codes.lcount := 0;
|
|
|
|
|
|
|
+ codes.lcount := 0;
|
|
|
|
|
|
|
|
- FOR i := 0 TO LEN(codes.charoffs) - 1 DO
|
|
|
|
|
- codes.charoffs[i] := -1
|
|
|
|
|
- END;
|
|
|
|
|
|
|
+ FOR i := 0 TO LEN(codes.charoffs) - 1 DO
|
|
|
|
|
+ codes.charoffs[i] := -1
|
|
|
|
|
+ END;
|
|
|
|
|
|
|
|
- FOR i := 0 TO LEN(codes.wcharoffs) - 1 DO
|
|
|
|
|
- codes.wcharoffs[i] := -1
|
|
|
|
|
- END
|
|
|
|
|
|
|
+ FOR i := 0 TO LEN(codes.wcharoffs) - 1 DO
|
|
|
|
|
+ codes.wcharoffs[i] := -1
|
|
|
|
|
+ END
|
|
|
|
|
|
|
|
-END init;
|
|
|
|
|
|
|
+ END init;
|
|
|
|
|
|
|
|
|
|
|
|
|
END IL.
|
|
END IL.
|