Subversion Repositories Kolibri OS

Rev

Rev 7696 | Go to most recent revision | Only display areas with differences | Regard whitespace | Details | Blame | Last modification | View Log | RSS feed

Rev 7696 Rev 7983
1
(*
1
(*
2
    BSD 2-Clause License
2
    BSD 2-Clause License
3
 
3
 
4
    Copyright (c) 2018-2019, Anton Krotov
4
    Copyright (c) 2018-2020, Anton Krotov
5
    All rights reserved.
5
    All rights reserved.
6
*)
6
*)
7
 
7
 
8
MODULE IL;
8
MODULE IL;
9
 
9
 
10
IMPORT LISTS, SCAN, STRINGS, CHL := CHUNKLISTS, C := COLLECTIONS;
10
IMPORT LISTS, SCAN, STRINGS, CHL := CHUNKLISTS, C := COLLECTIONS, TARGETS;
11
 
11
 
12
 
12
 
13
CONST
13
CONST
14
 
14
 
15
    little_endian* = 0;
15
    little_endian* = 0;
16
    big_endian* = 1;
16
    big_endian* = 1;
17
 
17
 
18
    call_stack* = 0;
18
    call_stack* = 0;
19
    call_win64* = 1;
19
    call_win64* = 1;
20
    call_sysv*  = 2;
20
    call_sysv*  = 2;
21
 
21
 
22
    opJMP* = 0; opLABEL* = 1; opCOPYS* = 2; opGADR* = 3; opCONST* = 4; opLLOAD32* = 5;
22
    opJMP* = 0; opLABEL* = 1; opCOPYS* = 2; opGADR* = 3; opCONST* = 4; opLLOAD32* = 5;
23
    opCOPYA* = 6; opCASET* = 7; opMULC* = 8; opMUL* = 9; opDIV* = 10; opMOD* = 11;
23
    opCOPYA* = 6; opCASET* = 7; opMULC* = 8; opMUL* = 9; opDIV* = 10; opMOD* = 11;
24
    opDIVL* = 12; opMODL* = 13; opDIVR* = 14; opMODR* = 15; opUMINUS* = 16;
24
    opDIVL* = 12; opMODL* = 13; opDIVR* = 14; opMODR* = 15; opUMINUS* = 16;
25
    opADD* = 17; opSUB* = 18; opADDL* = 19; opSUBL* = 20; opADDR* = 21; opSUBR* = 22;
25
    opADD* = 17; opSUB* = 18; opADDL* = 19; opSUBL* = 20; opADDR* = 21; opSUBR* = 22;
26
    opSAVE* = 23; opSAVEC* = 24; opSAVE8* = 25; opSAVE8C* = 26; opCHKBYTE* = 27; opDROP* = 28;
26
    opSAVE* = 23; opSAVEC* = 24; opSAVE8* = 25; opSAVE8C* = 26; opCHKBYTE* = 27; opDROP* = 28;
27
    opNOT* = 29;
27
    opNOT* = 29;
28
 
28
 
29
    opEQ*  = 30; opNE* = opEQ + 1; opLT* = opEQ + 2; opLE* = opEQ + 3; opGT* = opEQ + 4; opGE* = opEQ + 5 (* 35 *);
29
    opEQ*  = 30; opNE* = opEQ + 1; opLT* = opEQ + 2; opLE* = opEQ + 3; opGT* = opEQ + 4; opGE* = opEQ + 5 (* 35 *);
30
    opEQC* = 36; opNEC* = opEQC + 1; opLTC* = opEQC + 2; opLEC* = opEQC + 3; opGTC* = opEQC + 4; opGEC* = opEQC + 5; (* 41 *)
30
    opEQC* = 36; opNEC* = opEQC + 1; opLTC* = opEQC + 2; opLEC* = opEQC + 3; opGTC* = opEQC + 4; opGEC* = opEQC + 5; (* 41 *)
31
    opEQF* = 42; opNEF* = opEQF + 1; opLTF* = opEQF + 2; opLEF* = opEQF + 3; opGTF* = opEQF + 4; opGEF* = opEQF + 5; (* 47 *)
31
    opEQF* = 42; opNEF* = opEQF + 1; opLTF* = opEQF + 2; opLEF* = opEQF + 3; opGTF* = opEQF + 4; opGEF* = opEQF + 5; (* 47 *)
32
    opEQS* = 48; opNES* = opEQS + 1; opLTS* = opEQS + 2; opLES* = opEQS + 3; opGTS* = opEQS + 4; opGES* = opEQS + 5; (* 53 *)
32
    opEQS* = 48; opNES* = opEQS + 1; opLTS* = opEQS + 2; opLES* = opEQS + 3; opGTS* = opEQS + 4; opGES* = opEQS + 5; (* 53 *)
33
    opEQSW* = 54; opNESW* = opEQSW + 1; opLTSW* = opEQSW + 2; opLESW* = opEQSW + 3; opGTSW* = opEQSW + 4; opGESW* = opEQSW + 5 (* 59 *);
33
    opEQSW* = 54; opNESW* = opEQSW + 1; opLTSW* = opEQSW + 2; opLESW* = opEQSW + 3; opGTSW* = opEQSW + 4; opGESW* = opEQSW + 5 (* 59 *);
34
 
34
 
35
    opVLOAD32* = 60; opGLOAD32* = 61;
35
    opVLOAD32* = 60; opGLOAD32* = 61;
36
 
36
 
37
    opJNE* = 62; opJE* = 63;
37
    opJNE* = 62; opJE* = 63;
38
 
38
 
39
    opSAVE32* = 64; opLLOAD8* = 65;
39
    opSAVE32* = 64; opLLOAD8* = 65;
40
 
40
 
41
    opCONSTF* = 66; opLOADF* = 67; opSAVEF* = 68; opMULF* = 69; opDIVF* = 70; opDIVFI* = 71;
41
    opCONSTF* = 66; opLOADF* = 67; opSAVEF* = 68; opMULF* = 69; opDIVF* = 70; opDIVFI* = 71;
42
    opUMINF* = 72; opADDFI* = 73; opSUBFI* = 74; opADDF* = 75; opSUBF* = 76;
42
    opUMINF* = 72; opADDFI* = 73; opSUBFI* = 74; opADDF* = 75; opSUBF* = 76;
43
 
43
 
44
    opACC* = 77; opJG* = 78;
44
    opACC* = 77; opJG* = 78;
45
    opINCCB* = 79; opDECCB* = 80; opINCB* = 81; opDECB* = 82;
45
    opINCCB* = 79; opDECCB* = 80; opINCB* = 81; opDECB* = 82;
46
 
46
 
47
    opCASEL* = 83; opCASER* = 84; opCASELR* = 85;
47
    opCASEL* = 83; opCASER* = 84; opCASELR* = 85;
48
 
48
 
49
    opPOPSP* = 86;
49
    opPOPSP* = 86;
50
    opWIN64CALL* = 87; opWIN64CALLI* = 88; opWIN64CALLP* = 89; opLOOP* = 90; opENDLOOP* = 91;
50
    opWIN64CALL* = 87; opWIN64CALLI* = 88; opWIN64CALLP* = 89; opLOOP* = 90; opENDLOOP* = 91;
51
 
51
 
52
    opLOAD8* = 92; opLOAD16* = 93; opLOAD32* = 94; opPRECALL* = 95; opRES* = 96; opRESF* = 97;
52
    opLOAD8* = 92; opLOAD16* = 93; opLOAD32* = 94; opPRECALL* = 95; opRES* = 96; opRESF* = 97;
53
    opPUSHC* = 98; opSWITCH* = 99;
53
    opPUSHC* = 98; opSWITCH* = 99;
54
 
54
 
55
    opSBOOL* = 100; opSBOOLC* = 101; opNOP* = 102;
55
    opSBOOL* = 100; opSBOOLC* = 101; opNOP* = 102;
56
 
56
 
57
    opMULS* = 103; opMULSC* = 104; opDIVS* = 105; opDIVSC* = 106;
57
    opMULS* = 103; opMULSC* = 104; opDIVS* = 105; opDIVSC* = 106;
58
    opADDS* = 107; opSUBS* = 108; opADDSL* = 109; opSUBSL* = 110; opADDSR* = 111; opSUBSR* = 112;
58
    opADDS* = 107; opSUBS* = 108; opADDSL* = 109; opSUBSL* = 110; opADDSR* = 111; opSUBSR* = 112;
59
    opUMINS* = 113; opIN* = 114; opINL* = 115; opINR* = 116;
59
    opUMINS* = 113; opIN* = 114; opINL* = 115; opINR* = 116;
60
    opRSET* = 117; opRSETL* = 118; opRSETR* = 119; opRSET1* = 120; opLENGTH* = 121;
60
    opRSET* = 117; opRSETL* = 118; opRSETR* = 119; opRSET1* = 120; opLENGTH* = 121;
61
 
61
 
62
    opLEAVEC* = 122; opCODE* = 123; opALIGN16* = 124;
62
    opLEAVEC* = 122; opCODE* = 123; opALIGN16* = 124;
63
    opINCC* = 125; opINC* = 126; opDEC* = 127;
63
    opINCC* = 125; opINC* = 126; opDEC* = 127;
64
    opINCL* = 128; opEXCL* = 129; opINCLC* = 130; opEXCLC* = 131; opNEW* = 132; opDISP* = 133;
64
    opINCL* = 128; opEXCL* = 129; opINCLC* = 130; opEXCLC* = 131; opNEW* = 132; opDISP* = 133;
65
    opPACK* = 134; opPACKC* = 135; opUNPK* = 136; opCOPY* = 137; opENTER* = 138; opLEAVE* = 139;
65
    opPACK* = 134; opPACKC* = 135; opUNPK* = 136; opCOPY* = 137; opENTER* = 138; opLEAVE* = 139;
66
    opCALL* = 140; opSAVEP* = 141; opCALLP* = 142; opEQP* = 143; opNEP* = 144; opLEAVER* = 145;
66
    opCALL* = 140; opSAVEP* = 141; opCALLP* = 142; opEQP* = 143; opNEP* = 144; opLEAVER* = 145;
67
    opGET* = 146; opSAVE16* = 147; opABS* = 148; opFABS* = 149; opFLOOR* = 150; opFLT* = 151;
67
    opGET* = 146; opSAVE16* = 147; opABS* = 148; opFABS* = 149; opFLOOR* = 150; opFLT* = 151;
68
    opODD* = 152; opORD* = 153; opASR* = 154; opLSL* = 155; opROR* = 156;
68
    opORD* = 153; opASR* = 154; opLSL* = 155; opROR* = 156;
69
    opASR1* = 157; opLSL1* = 158; opROR1* = 159; opASR2* = 160; opLSL2* = 161; opROR2* = 162;
69
    opASR1* = 157; opLSL1* = 158; opROR1* = 159; opASR2* = 160; opLSL2* = 161; opROR2* = 162;
70
    opPUSHP* = 163; opLADR* = 164; opTYPEGP* = 165; opIS* = 166; opPUSHF* = 167; opVADR* = 168;
70
    opPUSHP* = 163; opLADR* = 164; opTYPEGP* = 165; opIS* = 166; opPUSHF* = 167; opVADR* = 168;
71
    opPUSHT* = 169; opTYPEGR* = 170; opISREC* = 171; opCHKIDX* = 172; opPARAM* = 173;
71
    opPUSHT* = 169; opTYPEGR* = 170; opISREC* = 171; opCHKIDX* = 172; opPARAM* = 173;
72
    opCHKIDX2* = 174; opLEN* = 175; opROT* = 176; opSAVES* = 177; opSADR* = 178; opERR* = 179;
72
    opCHKIDX2* = 174; opLEN* = 175; opROT* = 176; opSAVES* = 177; opSADR* = 178; opERR* = 179;
73
 
73
 
74
    opCHR* = 180; opENDSW* = 181; opLEAVEF* = 182; opCLEANUP* = 183; opMOVE* = 184;
74
    opCHR* = 180; opENDSW* = 181; opLEAVEF* = 182; opCLEANUP* = 183; opMOVE* = 184;
75
    opLSR* = 185; opLSR1* = 186; opLSR2* = 187;
75
    opLSR* = 185; opLSR1* = 186; opLSR2* = 187;
76
    opMIN* = 188; opMINC* = 189; opMAX* = 190; opMAXC* = 191; opJNZ* = 192;
76
    opMIN* = 188; opMINC* = 189; opMAX* = 190; opMAXC* = 191; opJNZ* = 192;
77
    opEQB* = 193; opNEB* = 194; opINF* = 195; opJZ* = 196; opVLOAD8* = 197; opGLOAD8* = 198;
77
    opEQB* = 193; opNEB* = 194; opINF* = 195; opJZ* = 196; opVLOAD8* = 197; opGLOAD8* = 198;
78
    opLLOAD16* = 199; opVLOAD16* = 200; opGLOAD16* = 201;
78
    opLLOAD16* = 199; opVLOAD16* = 200; opGLOAD16* = 201;
79
    opLOAD64* = 202; opLLOAD64* = 203; opVLOAD64* = 204; opGLOAD64* = 205; opSAVE64* = 206;
79
    opLOAD64* = 202; opLLOAD64* = 203; opVLOAD64* = 204; opGLOAD64* = 205; opSAVE64* = 206;
80
 
80
 
81
    opTYPEGD* = 207; opCALLI* = 208; opPUSHIP* = 209; opSAVEIP* = 210; opEQIP* = 211; opNEIP* = 212;
81
    opTYPEGD* = 207; opCALLI* = 208; opPUSHIP* = 209; opSAVEIP* = 210; opEQIP* = 211; opNEIP* = 212;
82
    opSAVE16C* = 213; opWCHR* = 214; opGETC* = 215; opLENGTHW* = 216;
82
    opSAVE16C* = 213; opWCHR* = 214; opGETC* = 215; opLENGTHW* = 216;
83
 
83
 
84
    opSYSVCALL* = 217; opSYSVCALLI* = 218; opSYSVCALLP* = 219; opSYSVALIGN16* = 220; opWIN64ALIGN16* = 221;
84
    opSYSVCALL* = 217; opSYSVCALLI* = 218; opSYSVCALLP* = 219; opSYSVALIGN16* = 220; opWIN64ALIGN16* = 221;
-
 
85
 
-
 
86
    opONERR* = 222; opSAVEFI* = 223; opHANDLER* = 224;
85
 
87
 
86
 
88
 
87
    opSADR_PARAM* = -1; opLOAD64_PARAM* = -2; opLLOAD64_PARAM* = -3; opGLOAD64_PARAM* = -4;
89
    opSADR_PARAM* = -1; opLOAD64_PARAM* = -2; opLLOAD64_PARAM* = -3; opGLOAD64_PARAM* = -4;
88
    opVADR_PARAM* = -5; opCONST_PARAM* = -6; opGLOAD32_PARAM* = -7; opLLOAD32_PARAM* = -8;
90
    opVADR_PARAM* = -5; opCONST_PARAM* = -6; opGLOAD32_PARAM* = -7; opLLOAD32_PARAM* = -8;
89
    opLOAD32_PARAM* = -9;
91
    opLOAD32_PARAM* = -9;
90
 
92
 
91
    opLADR_SAVEC* = -10; opGADR_SAVEC* = -11; opLADR_SAVE* = -12;
93
    opLADR_SAVEC* = -10; opGADR_SAVEC* = -11; opLADR_SAVE* = -12;
92
 
94
 
93
    opLADR_INCC* = -13; opLADR_INCCB* = -14; opLADR_DECCB* = -15;
95
    opLADR_INCC* = -13; opLADR_INCCB* = -14; opLADR_DECCB* = -15;
94
    opLADR_INC* = -16; opLADR_DEC* = -17; opLADR_INCB* = -18; opLADR_DECB* = -19;
96
    opLADR_INC* = -16; opLADR_DEC* = -17; opLADR_INCB* = -18; opLADR_DECB* = -19;
95
    opLADR_INCL* = -20; opLADR_EXCL* = -21; opLADR_INCLC* = -22; opLADR_EXCLC* = -23;
97
    opLADR_INCL* = -20; opLADR_EXCL* = -21; opLADR_INCLC* = -22; opLADR_EXCLC* = -23;
96
    opLADR_UNPK* = -24;
98
    opLADR_UNPK* = -24;
97
 
99
 
98
 
100
 
99
    _init      *=   0;
101
    _init      *=   0;
100
    _move      *=   1;
102
    _move      *=   1;
101
    _strcmpw   *=   2;
103
    _strcmpw   *=   2;
102
    _exit      *=   3;
104
    _exit      *=   3;
103
    _set       *=   4;
105
    _set       *=   4;
104
    _set1      *=   5;
106
    _set1      *=   5;
105
    _lengthw   *=   6;
107
    _lengthw   *=   6;
106
    _strcpy    *=   7;
108
    _strcpy    *=   7;
107
    _length    *=   8;
109
    _length    *=   8;
108
    _divmod    *=   9;
110
    _divmod    *=   9;
109
    _dllentry  *=  10;
111
    _dllentry  *=  10;
110
    _sofinit   *=  11;
112
    _sofinit   *=  11;
111
    _arrcpy    *=  12;
113
    _arrcpy    *=  12;
112
    _rot       *=  13;
114
    _rot       *=  13;
113
    _new       *=  14;
115
    _new       *=  14;
114
    _dispose   *=  15;
116
    _dispose   *=  15;
115
    _strcmp    *=  16;
117
    _strcmp    *=  16;
116
    _error     *=  17;
118
    _error     *=  17;
117
    _is        *=  18;
119
    _is        *=  18;
118
    _isrec     *=  19;
120
    _isrec     *=  19;
119
    _guard     *=  20;
121
    _guard     *=  20;
120
    _guardrec  *=  21;
122
    _guardrec  *=  21;
-
 
123
 
-
 
124
    _fmul      *=  22;
-
 
125
    _fdiv      *=  23;
-
 
126
    _fdivi     *=  24;
-
 
127
    _fadd      *=  25;
-
 
128
    _fsub      *=  26;
-
 
129
    _fsubi     *=  27;
-
 
130
    _fcmp      *=  28;
-
 
131
    _floor     *=  29;
-
 
132
    _flt       *=  30;
-
 
133
    _pack      *=  31;
-
 
134
    _unpk      *=  32;
121
 
135
 
122
 
136
 
123
TYPE
137
TYPE
124
 
138
 
125
    LOCALVAR* = POINTER TO RECORD (LISTS.ITEM)
139
    LOCALVAR* = POINTER TO RECORD (LISTS.ITEM)
126
 
140
 
127
        offset*, size*, count*: INTEGER
141
        offset*, size*, count*: INTEGER
128
 
142
 
129
    END;
143
    END;
130
 
144
 
131
    COMMAND* = POINTER TO RECORD (LISTS.ITEM)
145
    COMMAND* = POINTER TO RECORD (LISTS.ITEM)
132
 
146
 
133
        opcode*:    INTEGER;
147
        opcode*:    INTEGER;
134
        param1*:    INTEGER;
148
        param1*:    INTEGER;
135
        param2*:    INTEGER;
149
        param2*:    INTEGER;
136
        param3*:    INTEGER;
150
        param3*:    INTEGER;
137
        float*:     REAL;
151
        float*:     REAL;
138
        variables*: LISTS.LIST;
152
        variables*: LISTS.LIST;
139
        allocReg*:  BOOLEAN
153
        allocReg*:  BOOLEAN
140
 
154
 
141
    END;
155
    END;
142
 
156
 
143
    CMDSTACK = POINTER TO RECORD
157
    CMDSTACK = POINTER TO RECORD
144
 
158
 
145
        data: ARRAY 1000 OF COMMAND;
159
        data: ARRAY 1000 OF COMMAND;
146
        top:  INTEGER
160
        top:  INTEGER
147
 
161
 
148
    END;
162
    END;
149
 
163
 
150
    EXPORT_PROC* = POINTER TO RECORD (LISTS.ITEM)
164
    EXPORT_PROC* = POINTER TO RECORD (LISTS.ITEM)
151
 
165
 
152
        label*: INTEGER;
166
        label*: INTEGER;
153
        name*:  SCAN.LEXSTR
167
        name*:  SCAN.LEXSTR
154
 
168
 
155
    END;
169
    END;
156
 
170
 
157
    IMPORT_LIB* = POINTER TO RECORD (LISTS.ITEM)
171
    IMPORT_LIB* = POINTER TO RECORD (LISTS.ITEM)
158
 
172
 
159
        name*:   SCAN.LEXSTR;
173
        name*:   SCAN.LEXSTR;
160
        procs*:  LISTS.LIST
174
        procs*:  LISTS.LIST
161
 
175
 
162
    END;
176
    END;
163
 
177
 
164
    IMPORT_PROC* = POINTER TO RECORD (LISTS.ITEM)
178
    IMPORT_PROC* = POINTER TO RECORD (LISTS.ITEM)
165
 
179
 
166
        label*: INTEGER;
180
        label*: INTEGER;
167
        lib*:   IMPORT_LIB;
181
        lib*:   IMPORT_LIB;
168
        name*:  SCAN.LEXSTR;
182
        name*:  SCAN.LEXSTR;
169
        count:  INTEGER
183
        count:  INTEGER
170
 
184
 
171
    END;
185
    END;
172
 
186
 
173
 
187
 
174
    CODES = RECORD
188
    CODES = RECORD
175
 
189
 
176
        last:       COMMAND;
190
        last:       COMMAND;
177
        begcall:    CMDSTACK;
191
        begcall:    CMDSTACK;
178
        endcall:    CMDSTACK;
192
        endcall:    CMDSTACK;
179
        commands*:  LISTS.LIST;
193
        commands*:  LISTS.LIST;
180
        export*:    LISTS.LIST;
194
        export*:    LISTS.LIST;
181
        import*:    LISTS.LIST;
195
        import*:    LISTS.LIST;
182
        types*:     CHL.INTLIST;
196
        types*:     CHL.INTLIST;
183
        data*:      CHL.BYTELIST;
197
        data*:      CHL.BYTELIST;
184
        dmin*:      INTEGER;
198
        dmin*:      INTEGER;
185
        lcount*:    INTEGER;
199
        lcount*:    INTEGER;
186
        bss*:       INTEGER;
200
        bss*:       INTEGER;
187
        rtl*:       ARRAY 22 OF INTEGER;
201
        rtl*:       ARRAY 33 OF INTEGER;
188
        errlabels*: ARRAY 12 OF INTEGER;
202
        errlabels*: ARRAY 12 OF INTEGER;
189
 
203
 
190
        charoffs:   ARRAY 256 OF INTEGER;
204
        charoffs:   ARRAY 256 OF INTEGER;
191
        wcharoffs:  ARRAY 65536 OF INTEGER;
205
        wcharoffs:  ARRAY 65536 OF INTEGER;
192
 
206
 
193
        fregs:      INTEGER;
207
        fregs:      INTEGER;
194
        wstr:       ARRAY 4*1024 OF WCHAR
208
        wstr:       ARRAY 4*1024 OF WCHAR
195
    END;
209
    END;
196
 
210
 
197
 
211
 
198
VAR
212
VAR
199
 
213
 
200
    codes*: CODES;
214
    codes*: CODES;
201
    endianness: INTEGER;
-
 
202
    numRegsFloat: INTEGER;
215
    endianness, numRegsFloat, CPU: INTEGER;
203
 
216
 
204
    commands, variables: C.COLLECTION;
217
    commands, variables: C.COLLECTION;
205
 
218
 
206
 
219
 
207
PROCEDURE set_dmin* (value: INTEGER);
220
PROCEDURE set_dmin* (value: INTEGER);
208
BEGIN
221
BEGIN
209
    codes.dmin := value
222
    codes.dmin := value
210
END set_dmin;
223
END set_dmin;
211
 
224
 
212
 
225
 
213
PROCEDURE set_bss* (value: INTEGER);
226
PROCEDURE set_bss* (value: INTEGER);
214
BEGIN
227
BEGIN
215
    codes.bss := value
228
    codes.bss := value
216
END set_bss;
229
END set_bss;
217
 
230
 
218
 
231
 
219
PROCEDURE set_rtl* (idx, label: INTEGER);
232
PROCEDURE set_rtl* (idx, label: INTEGER);
220
BEGIN
233
BEGIN
221
    codes.rtl[idx] := label
234
    codes.rtl[idx] := label
222
END set_rtl;
235
END set_rtl;
223
 
236
 
224
 
237
 
225
PROCEDURE NewCmd (): COMMAND;
238
PROCEDURE NewCmd (): COMMAND;
226
VAR
239
VAR
227
    cmd:   COMMAND;
240
    cmd:   COMMAND;
228
    citem: C.ITEM;
241
    citem: C.ITEM;
229
 
242
 
230
BEGIN
243
BEGIN
231
    citem := C.pop(commands);
244
    citem := C.pop(commands);
232
    IF citem = NIL THEN
245
    IF citem = NIL THEN
233
        NEW(cmd)
246
        NEW(cmd)
234
    ELSE
247
    ELSE
235
        cmd := citem(COMMAND)
248
        cmd := citem(COMMAND)
236
    END;
249
    END;
237
 
250
 
238
    cmd.allocReg := FALSE
251
    cmd.allocReg := FALSE
239
 
252
 
240
    RETURN cmd
253
    RETURN cmd
241
END NewCmd;
254
END NewCmd;
242
 
255
 
243
 
256
 
244
PROCEDURE NewVar* (): LOCALVAR;
257
PROCEDURE NewVar* (): LOCALVAR;
245
VAR
258
VAR
246
    lvar:  LOCALVAR;
259
    lvar:  LOCALVAR;
247
    citem: C.ITEM;
260
    citem: C.ITEM;
248
 
261
 
249
BEGIN
262
BEGIN
250
    citem := C.pop(variables);
263
    citem := C.pop(variables);
251
    IF citem = NIL THEN
264
    IF citem = NIL THEN
252
        NEW(lvar)
265
        NEW(lvar)
253
    ELSE
266
    ELSE
254
        lvar := citem(LOCALVAR)
267
        lvar := citem(LOCALVAR)
255
    END;
268
    END;
256
 
269
 
257
    lvar.count := 0
270
    lvar.count := 0
258
 
271
 
259
    RETURN lvar
272
    RETURN lvar
260
END NewVar;
273
END NewVar;
261
 
274
 
262
 
275
 
263
PROCEDURE setlast* (cmd: COMMAND);
276
PROCEDURE setlast* (cmd: COMMAND);
264
BEGIN
277
BEGIN
265
    codes.last := cmd
278
    codes.last := cmd
266
END setlast;
279
END setlast;
267
 
280
 
268
 
281
 
269
PROCEDURE getlast* (): COMMAND;
282
PROCEDURE getlast* (): COMMAND;
270
    RETURN codes.last
283
    RETURN codes.last
271
END getlast;
284
END getlast;
272
 
285
 
273
 
286
 
274
PROCEDURE PutByte (b: BYTE);
287
PROCEDURE PutByte (b: BYTE);
275
BEGIN
288
BEGIN
276
    CHL.PushByte(codes.data, b)
289
    CHL.PushByte(codes.data, b)
277
END PutByte;
290
END PutByte;
278
 
291
 
279
 
292
 
280
PROCEDURE putstr* (s: ARRAY OF CHAR): INTEGER;
293
PROCEDURE putstr* (s: ARRAY OF CHAR): INTEGER;
281
VAR
294
VAR
282
    i, n, res: INTEGER;
295
    i, n, res: INTEGER;
283
BEGIN
296
BEGIN
284
    res := CHL.Length(codes.data);
297
    res := CHL.Length(codes.data);
285
 
298
 
286
    i := 0;
299
    i := 0;
287
    n := LENGTH(s);
300
    n := LENGTH(s);
288
    WHILE i < n DO
301
    WHILE i < n DO
289
        PutByte(ORD(s[i]));
302
        PutByte(ORD(s[i]));
290
        INC(i)
303
        INC(i)
291
    END;
304
    END;
292
 
305
 
293
    PutByte(0)
306
    PutByte(0)
294
 
307
 
295
    RETURN res
308
    RETURN res
296
END putstr;
309
END putstr;
297
 
310
 
298
 
311
 
299
PROCEDURE putstr1* (c: INTEGER): INTEGER;
312
PROCEDURE putstr1* (c: INTEGER): INTEGER;
300
VAR
313
VAR
301
    res: INTEGER;
314
    res: INTEGER;
302
 
315
 
303
BEGIN
316
BEGIN
304
    IF codes.charoffs[c] = -1 THEN
317
    IF codes.charoffs[c] = -1 THEN
305
        res := CHL.Length(codes.data);
318
        res := CHL.Length(codes.data);
306
        PutByte(c);
319
        PutByte(c);
307
        PutByte(0);
320
        PutByte(0);
308
        codes.charoffs[c] := res
321
        codes.charoffs[c] := res
309
    ELSE
322
    ELSE
310
        res := codes.charoffs[c]
323
        res := codes.charoffs[c]
311
    END
324
    END
312
 
325
 
313
    RETURN res
326
    RETURN res
314
END putstr1;
327
END putstr1;
315
 
328
 
316
 
329
 
317
PROCEDURE putstrW* (s: ARRAY OF CHAR): INTEGER;
330
PROCEDURE putstrW* (s: ARRAY OF CHAR): INTEGER;
318
VAR
331
VAR
319
    i, n, res: INTEGER;
332
    i, n, res: INTEGER;
320
 
333
 
321
BEGIN
334
BEGIN
322
    res := CHL.Length(codes.data);
335
    res := CHL.Length(codes.data);
323
 
336
 
324
    IF ODD(res) THEN
337
    IF ODD(res) THEN
325
        PutByte(0);
338
        PutByte(0);
326
        INC(res)
339
        INC(res)
327
    END;
340
    END;
328
 
341
 
329
    n := STRINGS.Utf8To16(s, codes.wstr);
342
    n := STRINGS.Utf8To16(s, codes.wstr);
330
 
343
 
331
    i := 0;
344
    i := 0;
332
    WHILE i < n DO
345
    WHILE i < n DO
333
        IF endianness = little_endian THEN
346
        IF endianness = little_endian THEN
334
            PutByte(ORD(codes.wstr[i]) MOD 256);
347
            PutByte(ORD(codes.wstr[i]) MOD 256);
335
            PutByte(ORD(codes.wstr[i]) DIV 256)
348
            PutByte(ORD(codes.wstr[i]) DIV 256)
336
        ELSIF endianness = big_endian THEN
349
        ELSIF endianness = big_endian THEN
337
            PutByte(ORD(codes.wstr[i]) DIV 256);
350
            PutByte(ORD(codes.wstr[i]) DIV 256);
338
            PutByte(ORD(codes.wstr[i]) MOD 256)
351
            PutByte(ORD(codes.wstr[i]) MOD 256)
339
        END;
352
        END;
340
        INC(i)
353
        INC(i)
341
    END;
354
    END;
342
 
355
 
343
    PutByte(0);
356
    PutByte(0);
344
    PutByte(0)
357
    PutByte(0)
345
 
358
 
346
    RETURN res
359
    RETURN res
347
END putstrW;
360
END putstrW;
348
 
361
 
349
 
362
 
350
PROCEDURE putstrW1* (c: INTEGER): INTEGER;
363
PROCEDURE putstrW1* (c: INTEGER): INTEGER;
351
VAR
364
VAR
352
    res: INTEGER;
365
    res: INTEGER;
353
 
366
 
354
BEGIN
367
BEGIN
355
    IF codes.wcharoffs[c] = -1 THEN
368
    IF codes.wcharoffs[c] = -1 THEN
356
        res := CHL.Length(codes.data);
369
        res := CHL.Length(codes.data);
357
 
370
 
358
        IF ODD(res) THEN
371
        IF ODD(res) THEN
359
            PutByte(0);
372
            PutByte(0);
360
            INC(res)
373
            INC(res)
361
        END;
374
        END;
362
 
375
 
363
        IF endianness = little_endian THEN
376
        IF endianness = little_endian THEN
364
            PutByte(c MOD 256);
377
            PutByte(c MOD 256);
365
            PutByte(c DIV 256)
378
            PutByte(c DIV 256)
366
        ELSIF endianness = big_endian THEN
379
        ELSIF endianness = big_endian THEN
367
            PutByte(c DIV 256);
380
            PutByte(c DIV 256);
368
            PutByte(c MOD 256)
381
            PutByte(c MOD 256)
369
        END;
382
        END;
370
 
383
 
371
        PutByte(0);
384
        PutByte(0);
372
        PutByte(0);
385
        PutByte(0);
373
 
386
 
374
        codes.wcharoffs[c] := res
387
        codes.wcharoffs[c] := res
375
    ELSE
388
    ELSE
376
        res := codes.wcharoffs[c]
389
        res := codes.wcharoffs[c]
377
    END
390
    END
378
 
391
 
379
    RETURN res
392
    RETURN res
380
END putstrW1;
393
END putstrW1;
381
 
394
 
382
 
395
 
383
PROCEDURE push (stk: CMDSTACK; cmd: COMMAND);
396
PROCEDURE push (stk: CMDSTACK; cmd: COMMAND);
384
BEGIN
397
BEGIN
385
    INC(stk.top);
398
    INC(stk.top);
386
    stk.data[stk.top] := cmd
399
    stk.data[stk.top] := cmd
387
END push;
400
END push;
388
 
401
 
389
 
402
 
390
PROCEDURE pop (stk: CMDSTACK): COMMAND;
403
PROCEDURE pop (stk: CMDSTACK): COMMAND;
391
VAR
404
VAR
392
    res: COMMAND;
405
    res: COMMAND;
393
BEGIN
406
BEGIN
394
    res := stk.data[stk.top];
407
    res := stk.data[stk.top];
395
    DEC(stk.top)
408
    DEC(stk.top)
396
    RETURN res
409
    RETURN res
397
END pop;
410
END pop;
398
 
411
 
399
 
412
 
400
PROCEDURE pushBegEnd* (VAR beg, end: COMMAND);
413
PROCEDURE pushBegEnd* (VAR beg, end: COMMAND);
401
BEGIN
414
BEGIN
402
    push(codes.begcall, beg);
415
    push(codes.begcall, beg);
403
    push(codes.endcall, end);
416
    push(codes.endcall, end);
404
    beg := codes.last;
417
    beg := codes.last;
405
    end := beg.next(COMMAND)
418
    end := beg.next(COMMAND)
406
END pushBegEnd;
419
END pushBegEnd;
407
 
420
 
408
 
421
 
409
PROCEDURE popBegEnd* (VAR beg, end: COMMAND);
422
PROCEDURE popBegEnd* (VAR beg, end: COMMAND);
410
BEGIN
423
BEGIN
411
    beg := pop(codes.begcall);
424
    beg := pop(codes.begcall);
412
    end := pop(codes.endcall)
425
    end := pop(codes.endcall)
413
END popBegEnd;
426
END popBegEnd;
414
 
427
 
415
 
428
 
416
PROCEDURE AddRec* (base: INTEGER);
429
PROCEDURE AddRec* (base: INTEGER);
417
BEGIN
430
BEGIN
418
    CHL.PushInt(codes.types, base)
431
    CHL.PushInt(codes.types, base)
419
END AddRec;
432
END AddRec;
420
 
433
 
421
 
434
 
422
PROCEDURE insert (cur, nov: COMMAND);
435
PROCEDURE insert (cur, nov: COMMAND);
423
VAR
436
VAR
424
    old_opcode, param2: INTEGER;
437
    old_opcode, param2: INTEGER;
425
 
438
 
426
 
439
 
427
    PROCEDURE set (cur: COMMAND; opcode, param2: INTEGER);
440
    PROCEDURE set (cur: COMMAND; opcode, param2: INTEGER);
428
    BEGIN
441
    BEGIN
429
        cur.opcode := opcode;
442
        cur.opcode := opcode;
430
        cur.param1 := cur.param2;
443
        cur.param1 := cur.param2;
431
        cur.param2 := param2
444
        cur.param2 := param2
432
    END set;
445
    END set;
433
 
446
 
434
 
447
 
435
BEGIN
448
BEGIN
-
 
449
    IF CPU IN {TARGETS.cpuX86, TARGETS.cpuAMD64, TARGETS.cpuMSP430} THEN
-
 
450
 
436
    old_opcode := cur.opcode;
451
        old_opcode := cur.opcode;
437
    param2 := nov.param2;
452
        param2 := nov.param2;
438
 
453
 
439
    IF (nov.opcode = opPARAM) & (param2 = 1) THEN
454
        IF (nov.opcode = opPARAM) & (param2 = 1) THEN
440
 
455
 
441
        CASE old_opcode OF
456
            CASE old_opcode OF
442
        |opGLOAD64: cur.opcode := opGLOAD64_PARAM
457
            |opGLOAD64: cur.opcode := opGLOAD64_PARAM
443
        |opLLOAD64: cur.opcode := opLLOAD64_PARAM
458
            |opLLOAD64: cur.opcode := opLLOAD64_PARAM
444
        |opLOAD64:  cur.opcode := opLOAD64_PARAM
459
            |opLOAD64:  cur.opcode := opLOAD64_PARAM
445
        |opGLOAD32: cur.opcode := opGLOAD32_PARAM
460
            |opGLOAD32: cur.opcode := opGLOAD32_PARAM
446
        |opLLOAD32: cur.opcode := opLLOAD32_PARAM
461
            |opLLOAD32: cur.opcode := opLLOAD32_PARAM
447
        |opLOAD32:  cur.opcode := opLOAD32_PARAM
462
            |opLOAD32:  cur.opcode := opLOAD32_PARAM
448
        |opSADR:    cur.opcode := opSADR_PARAM
463
            |opSADR:    cur.opcode := opSADR_PARAM
449
        |opVADR:    cur.opcode := opVADR_PARAM
464
            |opVADR:    cur.opcode := opVADR_PARAM
450
        |opCONST:   cur.opcode := opCONST_PARAM
465
            |opCONST:   cur.opcode := opCONST_PARAM
451
        ELSE
466
            ELSE
452
            old_opcode := -1
467
                old_opcode := -1
453
        END
468
            END
454
 
469
 
455
    ELSIF old_opcode = opLADR THEN
470
        ELSIF old_opcode = opLADR THEN
456
 
471
 
457
        CASE nov.opcode OF
472
            CASE nov.opcode OF
458
        |opSAVEC: set(cur, opLADR_SAVEC, param2)
473
            |opSAVEC: set(cur, opLADR_SAVEC, param2)
459
        |opSAVE:  cur.opcode := opLADR_SAVE
474
            |opSAVE:  cur.opcode := opLADR_SAVE
460
        |opINC:   cur.opcode := opLADR_INC
475
            |opINC:   cur.opcode := opLADR_INC
461
        |opDEC:   cur.opcode := opLADR_DEC
476
            |opDEC:   cur.opcode := opLADR_DEC
462
        |opINCB:  cur.opcode := opLADR_INCB
477
            |opINCB:  cur.opcode := opLADR_INCB
463
        |opDECB:  cur.opcode := opLADR_DECB
478
            |opDECB:  cur.opcode := opLADR_DECB
464
        |opINCL:  cur.opcode := opLADR_INCL
479
            |opINCL:  cur.opcode := opLADR_INCL
465
        |opEXCL:  cur.opcode := opLADR_EXCL
480
            |opEXCL:  cur.opcode := opLADR_EXCL
466
        |opUNPK:  cur.opcode := opLADR_UNPK
481
            |opUNPK:  cur.opcode := opLADR_UNPK
467
        |opINCC:  set(cur, opLADR_INCC, param2)
482
            |opINCC:  set(cur, opLADR_INCC, param2)
468
        |opINCCB: set(cur, opLADR_INCCB, param2)
483
            |opINCCB: set(cur, opLADR_INCCB, param2)
469
        |opDECCB: set(cur, opLADR_DECCB, param2)
484
            |opDECCB: set(cur, opLADR_DECCB, param2)
470
        |opINCLC: set(cur, opLADR_INCLC, param2)
485
            |opINCLC: set(cur, opLADR_INCLC, param2)
471
        |opEXCLC: set(cur, opLADR_EXCLC, param2)
486
            |opEXCLC: set(cur, opLADR_EXCLC, param2)
472
        ELSE
487
            ELSE
473
            old_opcode := -1
488
                old_opcode := -1
474
        END
489
            END
475
 
490
 
476
    ELSIF (nov.opcode = opSAVEC) & (old_opcode = opGADR) THEN
491
        ELSIF (nov.opcode = opSAVEC) & (old_opcode = opGADR) THEN
477
        set(cur, opGADR_SAVEC, param2)
492
            set(cur, opGADR_SAVEC, param2)
478
 
493
 
479
    ELSIF (nov.opcode = opMULC) & (old_opcode = opMULC) THEN
494
        ELSIF (nov.opcode = opMULC) & (old_opcode = opMULC) THEN
480
        cur.param2 := param2 * cur.param2
495
            cur.param2 := param2 * cur.param2
481
 
496
 
482
    ELSE
497
        ELSE
483
        old_opcode := -1
498
            old_opcode := -1
-
 
499
        END
-
 
500
    ELSE
-
 
501
        old_opcode := -1
484
    END;
502
    END;
485
 
503
 
486
    IF old_opcode = -1 THEN
504
    IF old_opcode = -1 THEN
487
        LISTS.insert(codes.commands, cur, nov);
505
        LISTS.insert(codes.commands, cur, nov);
488
        codes.last := nov
506
        codes.last := nov
489
    ELSE
507
    ELSE
490
        C.push(commands, nov);
508
        C.push(commands, nov);
491
        codes.last := cur
509
        codes.last := cur
492
    END
510
    END
493
END insert;
511
END insert;
494
 
512
 
495
 
513
 
496
PROCEDURE AddCmd* (opcode: INTEGER; param: INTEGER);
514
PROCEDURE AddCmd* (opcode: INTEGER; param: INTEGER);
497
VAR
515
VAR
498
    cmd: COMMAND;
516
    cmd: COMMAND;
499
BEGIN
517
BEGIN
500
    cmd := NewCmd();
518
    cmd := NewCmd();
501
    cmd.opcode := opcode;
519
    cmd.opcode := opcode;
502
    cmd.param1 := 0;
520
    cmd.param1 := 0;
503
    cmd.param2 := param;
521
    cmd.param2 := param;
504
    insert(codes.last, cmd)
522
    insert(codes.last, cmd)
505
END AddCmd;
523
END AddCmd;
506
 
524
 
507
 
525
 
508
PROCEDURE AddCmd2* (opcode: INTEGER; param1, param2: INTEGER);
526
PROCEDURE AddCmd2* (opcode: INTEGER; param1, param2: INTEGER);
509
VAR
527
VAR
510
    cmd: COMMAND;
528
    cmd: COMMAND;
511
BEGIN
529
BEGIN
512
    cmd := NewCmd();
530
    cmd := NewCmd();
513
    cmd.opcode := opcode;
531
    cmd.opcode := opcode;
514
    cmd.param1 := param1;
532
    cmd.param1 := param1;
515
    cmd.param2 := param2;
533
    cmd.param2 := param2;
516
    insert(codes.last, cmd)
534
    insert(codes.last, cmd)
517
END AddCmd2;
535
END AddCmd2;
518
 
536
 
519
 
537
 
520
PROCEDURE Const* (val: INTEGER);
538
PROCEDURE Const* (val: INTEGER);
521
BEGIN
539
BEGIN
522
    AddCmd(opCONST, val)
540
    AddCmd(opCONST, val)
523
END Const;
541
END Const;
524
 
542
 
525
 
543
 
526
PROCEDURE StrAdr* (adr: INTEGER);
544
PROCEDURE StrAdr* (adr: INTEGER);
527
BEGIN
545
BEGIN
528
    AddCmd(opSADR, adr)
546
    AddCmd(opSADR, adr)
529
END StrAdr;
547
END StrAdr;
530
 
548
 
531
 
549
 
532
PROCEDURE Param1*;
550
PROCEDURE Param1*;
533
BEGIN
551
BEGIN
534
    AddCmd(opPARAM, 1)
552
    AddCmd(opPARAM, 1)
535
END Param1;
553
END Param1;
536
 
554
 
537
 
555
 
538
PROCEDURE NewLabel* (): INTEGER;
556
PROCEDURE NewLabel* (): INTEGER;
539
BEGIN
557
BEGIN
540
    INC(codes.lcount)
558
    INC(codes.lcount)
541
    RETURN codes.lcount - 1
559
    RETURN codes.lcount - 1
542
END NewLabel;
560
END NewLabel;
543
 
561
 
544
 
562
 
545
PROCEDURE SetLabel* (label: INTEGER);
563
PROCEDURE SetLabel* (label: INTEGER);
546
BEGIN
564
BEGIN
547
    AddCmd2(opLABEL, label, 0)
565
    AddCmd2(opLABEL, label, 0)
548
END SetLabel;
566
END SetLabel;
549
 
567
 
550
 
568
 
551
PROCEDURE SetErrLabel* (errno: INTEGER);
569
PROCEDURE SetErrLabel* (errno: INTEGER);
552
BEGIN
570
BEGIN
553
    codes.errlabels[errno] := NewLabel();
571
    codes.errlabels[errno] := NewLabel();
554
    SetLabel(codes.errlabels[errno])
572
    SetLabel(codes.errlabels[errno])
555
END SetErrLabel;
573
END SetErrLabel;
556
 
574
 
557
 
575
 
558
PROCEDURE AddCmd0* (opcode: INTEGER);
576
PROCEDURE AddCmd0* (opcode: INTEGER);
559
BEGIN
577
BEGIN
560
    AddCmd(opcode, 0)
578
    AddCmd(opcode, 0)
561
END AddCmd0;
579
END AddCmd0;
562
 
580
 
563
 
581
 
564
PROCEDURE deleteVarList (list: LISTS.LIST);
582
PROCEDURE deleteVarList (list: LISTS.LIST);
565
VAR
583
VAR
566
    last: LISTS.ITEM;
584
    last: LISTS.ITEM;
567
 
585
 
568
BEGIN
586
BEGIN
569
    WHILE list.last # NIL DO
587
    WHILE list.last # NIL DO
570
        last := LISTS.pop(list);
588
        last := LISTS.pop(list);
571
        C.push(variables, last)
589
        C.push(variables, last)
572
    END
590
    END
573
END deleteVarList;
591
END deleteVarList;
574
 
592
 
575
 
593
 
576
PROCEDURE delete (cmd: COMMAND);
594
PROCEDURE delete (cmd: COMMAND);
577
BEGIN
595
BEGIN
578
    IF cmd.variables # NIL THEN
596
    IF cmd.variables # NIL THEN
579
        deleteVarList(cmd.variables)
597
        deleteVarList(cmd.variables)
580
    END;
598
    END;
581
    LISTS.delete(codes.commands, cmd);
599
    LISTS.delete(codes.commands, cmd);
582
    C.push(commands, cmd)
600
    C.push(commands, cmd)
583
END delete;
601
END delete;
584
 
602
 
585
 
603
 
586
PROCEDURE delete2* (first, last: LISTS.ITEM);
604
PROCEDURE delete2* (first, last: LISTS.ITEM);
587
VAR
605
VAR
588
    cur, next: LISTS.ITEM;
606
    cur, next: LISTS.ITEM;
589
 
607
 
590
BEGIN
608
BEGIN
591
    cur := first;
609
    cur := first;
592
 
610
 
593
    IF first # last THEN
611
    IF first # last THEN
594
        REPEAT
612
        REPEAT
595
            next := cur.next;
613
            next := cur.next;
596
            LISTS.delete(codes.commands, cur);
614
            LISTS.delete(codes.commands, cur);
597
            C.push(commands, cur);
615
            C.push(commands, cur);
598
            cur := next
616
            cur := next
599
        UNTIL cur = last
617
        UNTIL cur = last
600
    END;
618
    END;
601
 
619
 
602
    LISTS.delete(codes.commands, cur);
620
    LISTS.delete(codes.commands, cur);
603
    C.push(commands, cur)
621
    C.push(commands, cur)
604
END delete2;
622
END delete2;
605
 
623
 
606
 
624
 
607
PROCEDURE AddJmpCmd* (opcode: INTEGER; label: INTEGER);
625
PROCEDURE AddJmpCmd* (opcode: INTEGER; label: INTEGER);
608
VAR
626
VAR
609
    prev: COMMAND;
627
    prev: COMMAND;
610
    not:  BOOLEAN;
628
    not:  BOOLEAN;
611
 
629
 
612
BEGIN
630
BEGIN
613
    prev := codes.last;
631
    prev := codes.last;
614
    not := prev.opcode = opNOT;
632
    not := prev.opcode = opNOT;
615
    IF not THEN
633
    IF not THEN
616
        IF opcode = opJE THEN
634
        IF opcode = opJE THEN
617
            opcode := opJNE
635
            opcode := opJNE
618
        ELSIF opcode = opJNE THEN
636
        ELSIF opcode = opJNE THEN
619
            opcode := opJE
637
            opcode := opJE
620
        ELSE
638
        ELSE
621
            not := FALSE
639
            not := FALSE
622
        END
640
        END
623
    END;
641
    END;
624
 
642
 
625
    AddCmd2(opcode, label, label);
643
    AddCmd2(opcode, label, label);
626
 
644
 
627
    IF not THEN
645
    IF not THEN
628
        delete(prev)
646
        delete(prev)
629
    END
647
    END
630
 
648
 
631
END AddJmpCmd;
649
END AddJmpCmd;
632
 
650
 
633
 
651
 
634
PROCEDURE OnError* (line, error: INTEGER);
652
PROCEDURE OnError* (line, error: INTEGER);
635
BEGIN
653
BEGIN
636
    AddCmd(opPUSHC, line);
-
 
637
    AddJmpCmd(opJMP, codes.errlabels[error])
654
    AddCmd2(opONERR, codes.errlabels[error], line)
638
END OnError;
655
END OnError;
639
 
656
 
640
 
657
 
641
PROCEDURE TypeGuard* (op, t: INTEGER; line, error: INTEGER);
658
PROCEDURE TypeGuard* (op, t: INTEGER; line, error: INTEGER);
642
VAR
659
VAR
643
    label: INTEGER;
660
    label: INTEGER;
644
BEGIN
661
BEGIN
645
    AddCmd(op, t);
662
    AddCmd(op, t);
646
    label := NewLabel();
663
    label := NewLabel();
647
    AddJmpCmd(opJE, label);
664
    AddJmpCmd(opJE, label);
648
    OnError(line, error);
665
    OnError(line, error);
649
    SetLabel(label)
666
    SetLabel(label)
650
END TypeGuard;
667
END TypeGuard;
651
 
668
 
652
 
669
 
653
PROCEDURE TypeCheck* (t: INTEGER);
670
PROCEDURE TypeCheck* (t: INTEGER);
654
BEGIN
671
BEGIN
655
    AddCmd(opIS, t)
672
    AddCmd(opIS, t)
656
END TypeCheck;
673
END TypeCheck;
657
 
674
 
658
 
675
 
659
PROCEDURE TypeCheckRec* (t: INTEGER);
676
PROCEDURE TypeCheckRec* (t: INTEGER);
660
BEGIN
677
BEGIN
661
    AddCmd(opISREC, t)
678
    AddCmd(opISREC, t)
662
END TypeCheckRec;
679
END TypeCheckRec;
663
 
680
 
664
 
681
 
665
PROCEDURE New* (size, typenum: INTEGER);
682
PROCEDURE New* (size, typenum: INTEGER);
666
BEGIN
683
BEGIN
667
    AddCmd2(opNEW, typenum, size)
684
    AddCmd2(opNEW, typenum, size)
668
END New;
685
END New;
669
 
686
 
670
 
687
 
671
PROCEDURE fcmp* (opcode: INTEGER);
688
PROCEDURE fcmp* (opcode: INTEGER);
672
BEGIN
689
BEGIN
673
    AddCmd(opcode, 0);
690
    AddCmd(opcode, 0);
674
    DEC(codes.fregs, 2);
691
    DEC(codes.fregs, 2);
675
    ASSERT(codes.fregs >= 0)
692
    ASSERT(codes.fregs >= 0)
676
END fcmp;
693
END fcmp;
677
 
694
 
678
 
695
 
679
PROCEDURE not*;
696
PROCEDURE not*;
680
VAR
697
VAR
681
    prev: COMMAND;
698
    prev: COMMAND;
682
BEGIN
699
BEGIN
683
    prev := codes.last;
700
    prev := codes.last;
684
    IF prev.opcode = opNOT THEN
701
    IF prev.opcode = opNOT THEN
685
        codes.last := prev.prev(COMMAND);
702
        codes.last := prev.prev(COMMAND);
686
        delete(prev)
703
        delete(prev)
687
    ELSE
704
    ELSE
688
        AddCmd0(opNOT)
705
        AddCmd0(opNOT)
689
    END
706
    END
690
END not;
707
END not;
691
 
708
 
692
 
709
 
693
PROCEDURE Enter* (label, params: INTEGER): COMMAND;
710
PROCEDURE Enter* (label, params: INTEGER): COMMAND;
694
VAR
711
VAR
695
    cmd: COMMAND;
712
    cmd: COMMAND;
696
 
713
 
697
BEGIN
714
BEGIN
698
    cmd := NewCmd();
715
    cmd := NewCmd();
699
    cmd.opcode := opENTER;
716
    cmd.opcode := opENTER;
700
    cmd.param1 := label;
717
    cmd.param1 := label;
701
    cmd.param3 := params;
718
    cmd.param3 := params;
702
    cmd.allocReg := TRUE;
719
    cmd.allocReg := TRUE;
703
    insert(codes.last, cmd)
720
    insert(codes.last, cmd)
704
 
721
 
705
    RETURN codes.last
722
    RETURN codes.last
706
END Enter;
723
END Enter;
707
 
724
 
708
 
725
 
709
PROCEDURE Leave* (result, float: BOOLEAN; locsize, paramsize: INTEGER): COMMAND;
726
PROCEDURE Leave* (result, float: BOOLEAN; locsize, paramsize: INTEGER): COMMAND;
710
BEGIN
727
BEGIN
711
    IF result THEN
728
    IF result THEN
712
        IF float THEN
729
        IF float THEN
713
            AddCmd2(opLEAVEF, locsize, paramsize)
730
            AddCmd2(opLEAVEF, locsize, paramsize)
714
        ELSE
731
        ELSE
715
            AddCmd2(opLEAVER, locsize, paramsize)
732
            AddCmd2(opLEAVER, locsize, paramsize)
716
        END
733
        END
717
    ELSE
734
    ELSE
718
        AddCmd2(opLEAVE, locsize, paramsize)
735
        AddCmd2(opLEAVE, locsize, paramsize)
719
    END
736
    END
720
 
737
 
721
    RETURN codes.last
738
    RETURN codes.last
722
END Leave;
739
END Leave;
723
 
740
 
724
 
741
 
725
PROCEDURE EnterC* (label: INTEGER): COMMAND;
742
PROCEDURE EnterC* (label: INTEGER): COMMAND;
726
BEGIN
743
BEGIN
727
    SetLabel(label)
744
    SetLabel(label)
728
    RETURN codes.last
745
    RETURN codes.last
729
END EnterC;
746
END EnterC;
730
 
747
 
731
 
748
 
732
PROCEDURE LeaveC* (): COMMAND;
749
PROCEDURE LeaveC* (): COMMAND;
733
BEGIN
750
BEGIN
734
    AddCmd0(opLEAVEC)
751
    AddCmd0(opLEAVEC)
735
    RETURN codes.last
752
    RETURN codes.last
736
END LeaveC;
753
END LeaveC;
737
 
754
 
738
 
755
 
739
PROCEDURE Call* (proc, callconv, fparams: INTEGER);
756
PROCEDURE Call* (proc, callconv, fparams: INTEGER);
740
BEGIN
757
BEGIN
741
    CASE callconv OF
758
    CASE callconv OF
742
    |call_stack: AddJmpCmd(opCALL, proc)
759
    |call_stack: AddJmpCmd(opCALL, proc)
743
    |call_win64: AddJmpCmd(opWIN64CALL, proc)
760
    |call_win64: AddJmpCmd(opWIN64CALL, proc)
744
    |call_sysv:  AddJmpCmd(opSYSVCALL, proc)
761
    |call_sysv:  AddJmpCmd(opSYSVCALL, proc)
745
    END;
762
    END;
746
    codes.last(COMMAND).param2 := fparams
763
    codes.last(COMMAND).param2 := fparams
747
END Call;
764
END Call;
748
 
765
 
749
 
766
 
750
PROCEDURE CallImp* (proc: LISTS.ITEM; callconv, fparams: INTEGER);
767
PROCEDURE CallImp* (proc: LISTS.ITEM; callconv, fparams: INTEGER);
751
BEGIN
768
BEGIN
752
    CASE callconv OF
769
    CASE callconv OF
753
    |call_stack: AddJmpCmd(opCALLI, proc(IMPORT_PROC).label)
770
    |call_stack: AddJmpCmd(opCALLI, proc(IMPORT_PROC).label)
754
    |call_win64: AddJmpCmd(opWIN64CALLI, proc(IMPORT_PROC).label)
771
    |call_win64: AddJmpCmd(opWIN64CALLI, proc(IMPORT_PROC).label)
755
    |call_sysv:  AddJmpCmd(opSYSVCALLI, proc(IMPORT_PROC).label)
772
    |call_sysv:  AddJmpCmd(opSYSVCALLI, proc(IMPORT_PROC).label)
756
    END;
773
    END;
757
    codes.last(COMMAND).param2 := fparams
774
    codes.last(COMMAND).param2 := fparams
758
END CallImp;
775
END CallImp;
759
 
776
 
760
 
777
 
761
PROCEDURE CallP* (callconv, fparams: INTEGER);
778
PROCEDURE CallP* (callconv, fparams: INTEGER);
762
BEGIN
779
BEGIN
763
    CASE callconv OF
780
    CASE callconv OF
764
    |call_stack: AddCmd0(opCALLP)
781
    |call_stack: AddCmd0(opCALLP)
765
    |call_win64: AddCmd(opWIN64CALLP, fparams)
782
    |call_win64: AddCmd(opWIN64CALLP, fparams)
766
    |call_sysv:  AddCmd(opSYSVCALLP, fparams)
783
    |call_sysv:  AddCmd(opSYSVCALLP, fparams)
767
    END
784
    END
768
END CallP;
785
END CallP;
769
 
786
 
770
 
787
 
771
PROCEDURE AssignProc* (proc: INTEGER);
788
PROCEDURE AssignProc* (proc: INTEGER);
772
BEGIN
789
BEGIN
773
    AddJmpCmd(opSAVEP, proc)
790
    AddJmpCmd(opSAVEP, proc)
774
END AssignProc;
791
END AssignProc;
775
 
792
 
776
 
793
 
777
PROCEDURE AssignImpProc* (proc: LISTS.ITEM);
794
PROCEDURE AssignImpProc* (proc: LISTS.ITEM);
778
BEGIN
795
BEGIN
779
    AddJmpCmd(opSAVEIP, proc(IMPORT_PROC).label)
796
    AddJmpCmd(opSAVEIP, proc(IMPORT_PROC).label)
780
END AssignImpProc;
797
END AssignImpProc;
781
 
798
 
782
 
799
 
783
PROCEDURE PushProc* (proc: INTEGER);
800
PROCEDURE PushProc* (proc: INTEGER);
784
BEGIN
801
BEGIN
785
    AddJmpCmd(opPUSHP, proc)
802
    AddJmpCmd(opPUSHP, proc)
786
END PushProc;
803
END PushProc;
787
 
804
 
788
 
805
 
789
PROCEDURE PushImpProc* (proc: LISTS.ITEM);
806
PROCEDURE PushImpProc* (proc: LISTS.ITEM);
790
BEGIN
807
BEGIN
791
    AddJmpCmd(opPUSHIP, proc(IMPORT_PROC).label)
808
    AddJmpCmd(opPUSHIP, proc(IMPORT_PROC).label)
792
END PushImpProc;
809
END PushImpProc;
793
 
810
 
794
 
811
 
795
PROCEDURE ProcCmp* (proc: INTEGER; eq: BOOLEAN);
812
PROCEDURE ProcCmp* (proc: INTEGER; eq: BOOLEAN);
796
BEGIN
813
BEGIN
797
    IF eq THEN
814
    IF eq THEN
798
        AddJmpCmd(opEQP, proc)
815
        AddJmpCmd(opEQP, proc)
799
    ELSE
816
    ELSE
800
        AddJmpCmd(opNEP, proc)
817
        AddJmpCmd(opNEP, proc)
801
    END
818
    END
802
END ProcCmp;
819
END ProcCmp;
803
 
820
 
804
 
821
 
805
PROCEDURE ProcImpCmp* (proc: LISTS.ITEM; eq: BOOLEAN);
822
PROCEDURE ProcImpCmp* (proc: LISTS.ITEM; eq: BOOLEAN);
806
BEGIN
823
BEGIN
807
    IF eq THEN
824
    IF eq THEN
808
        AddJmpCmd(opEQIP, proc(IMPORT_PROC).label)
825
        AddJmpCmd(opEQIP, proc(IMPORT_PROC).label)
809
    ELSE
826
    ELSE
810
        AddJmpCmd(opNEIP, proc(IMPORT_PROC).label)
827
        AddJmpCmd(opNEIP, proc(IMPORT_PROC).label)
811
    END
828
    END
812
END ProcImpCmp;
829
END ProcImpCmp;
813
 
830
 
814
 
831
 
815
PROCEDURE load* (size: INTEGER);
832
PROCEDURE load* (size: INTEGER);
816
VAR
833
VAR
817
    last: COMMAND;
834
    last: COMMAND;
818
 
835
 
819
BEGIN
836
BEGIN
820
    last := codes.last;
837
    last := codes.last;
821
    CASE size OF
838
    CASE size OF
822
    |1:
839
    |1:
823
        IF last.opcode = opLADR THEN
840
        IF last.opcode = opLADR THEN
824
            last.opcode := opLLOAD8
841
            last.opcode := opLLOAD8
825
        ELSIF last.opcode = opVADR THEN
842
        ELSIF last.opcode = opVADR THEN
826
            last.opcode := opVLOAD8
843
            last.opcode := opVLOAD8
827
        ELSIF last.opcode = opGADR THEN
844
        ELSIF last.opcode = opGADR THEN
828
            last.opcode := opGLOAD8
845
            last.opcode := opGLOAD8
829
        ELSE
846
        ELSE
830
            AddCmd0(opLOAD8)
847
            AddCmd0(opLOAD8)
831
        END
848
        END
832
 
849
 
833
    |2:
850
    |2:
834
        IF last.opcode = opLADR THEN
851
        IF last.opcode = opLADR THEN
835
            last.opcode := opLLOAD16
852
            last.opcode := opLLOAD16
836
        ELSIF last.opcode = opVADR THEN
853
        ELSIF last.opcode = opVADR THEN
837
            last.opcode := opVLOAD16
854
            last.opcode := opVLOAD16
838
        ELSIF last.opcode = opGADR THEN
855
        ELSIF last.opcode = opGADR THEN
839
            last.opcode := opGLOAD16
856
            last.opcode := opGLOAD16
840
        ELSE
857
        ELSE
841
            AddCmd0(opLOAD16)
858
            AddCmd0(opLOAD16)
842
        END
859
        END
843
 
860
 
844
    |4:
861
    |4:
845
        IF last.opcode = opLADR THEN
862
        IF last.opcode = opLADR THEN
846
            last.opcode := opLLOAD32
863
            last.opcode := opLLOAD32
847
        ELSIF last.opcode = opVADR THEN
864
        ELSIF last.opcode = opVADR THEN
848
            last.opcode := opVLOAD32
865
            last.opcode := opVLOAD32
849
        ELSIF last.opcode = opGADR THEN
866
        ELSIF last.opcode = opGADR THEN
850
            last.opcode := opGLOAD32
867
            last.opcode := opGLOAD32
851
        ELSE
868
        ELSE
852
            AddCmd0(opLOAD32)
869
            AddCmd0(opLOAD32)
853
        END
870
        END
854
 
871
 
855
    |8:
872
    |8:
856
        IF last.opcode = opLADR THEN
873
        IF last.opcode = opLADR THEN
857
            last.opcode := opLLOAD64
874
            last.opcode := opLLOAD64
858
        ELSIF last.opcode = opVADR THEN
875
        ELSIF last.opcode = opVADR THEN
859
            last.opcode := opVLOAD64
876
            last.opcode := opVLOAD64
860
        ELSIF last.opcode = opGADR THEN
877
        ELSIF last.opcode = opGADR THEN
861
            last.opcode := opGLOAD64
878
            last.opcode := opGLOAD64
862
        ELSE
879
        ELSE
863
            AddCmd0(opLOAD64)
880
            AddCmd0(opLOAD64)
864
        END
881
        END
865
    END
882
    END
866
END load;
883
END load;
867
 
884
 
868
 
885
 
869
PROCEDURE SysPut* (size: INTEGER);
886
PROCEDURE SysPut* (size: INTEGER);
870
BEGIN
887
BEGIN
871
    CASE size OF
888
    CASE size OF
872
    |1: AddCmd0(opSAVE8)
889
    |1: AddCmd0(opSAVE8)
873
    |2: AddCmd0(opSAVE16)
890
    |2: AddCmd0(opSAVE16)
874
    |4: AddCmd0(opSAVE32)
891
    |4: AddCmd0(opSAVE32)
875
    |8: AddCmd0(opSAVE64)
892
    |8: AddCmd0(opSAVE64)
876
    END
893
    END
877
END SysPut;
894
END SysPut;
878
 
895
 
879
 
896
 
880
PROCEDURE savef*;
897
PROCEDURE savef* (inv: BOOLEAN);
-
 
898
BEGIN
-
 
899
    IF inv THEN
-
 
900
        AddCmd0(opSAVEFI)
881
BEGIN
901
    ELSE
-
 
902
        AddCmd0(opSAVEF)
882
    AddCmd0(opSAVEF);
903
    END;
883
    DEC(codes.fregs);
904
    DEC(codes.fregs);
884
    ASSERT(codes.fregs >= 0)
905
    ASSERT(codes.fregs >= 0)
885
END savef;
906
END savef;
886
 
907
 
887
 
908
 
888
PROCEDURE pushf*;
909
PROCEDURE pushf*;
889
BEGIN
910
BEGIN
890
    AddCmd0(opPUSHF);
911
    AddCmd0(opPUSHF);
891
    DEC(codes.fregs);
912
    DEC(codes.fregs);
892
    ASSERT(codes.fregs >= 0)
913
    ASSERT(codes.fregs >= 0)
893
END pushf;
914
END pushf;
894
 
915
 
895
 
916
 
896
PROCEDURE loadf* (): BOOLEAN;
917
PROCEDURE loadf* (): BOOLEAN;
897
BEGIN
918
BEGIN
898
    AddCmd0(opLOADF);
919
    AddCmd0(opLOADF);
899
    INC(codes.fregs)
920
    INC(codes.fregs)
900
    RETURN codes.fregs < numRegsFloat
921
    RETURN codes.fregs < numRegsFloat
901
END loadf;
922
END loadf;
902
 
923
 
903
 
924
 
904
PROCEDURE inf* (): BOOLEAN;
925
PROCEDURE inf* (): BOOLEAN;
905
BEGIN
926
BEGIN
906
    AddCmd0(opINF);
927
    AddCmd0(opINF);
907
    INC(codes.fregs)
928
    INC(codes.fregs)
908
    RETURN codes.fregs < numRegsFloat
929
    RETURN codes.fregs < numRegsFloat
909
END inf;
930
END inf;
910
 
931
 
911
 
932
 
912
PROCEDURE fbinop* (opcode: INTEGER);
933
PROCEDURE fbinop* (opcode: INTEGER);
913
BEGIN
934
BEGIN
914
    AddCmd0(opcode);
935
    AddCmd0(opcode);
915
    DEC(codes.fregs);
936
    DEC(codes.fregs);
916
    ASSERT(codes.fregs > 0)
937
    ASSERT(codes.fregs > 0)
917
END fbinop;
938
END fbinop;
918
 
939
 
919
 
940
 
920
PROCEDURE saves* (offset, length: INTEGER);
941
PROCEDURE saves* (offset, length: INTEGER);
921
BEGIN
942
BEGIN
922
    AddCmd2(opSAVES, length, offset)
943
    AddCmd2(opSAVES, length, offset)
923
END saves;
944
END saves;
924
 
945
 
925
 
946
 
926
PROCEDURE abs* (real: BOOLEAN);
947
PROCEDURE abs* (real: BOOLEAN);
927
BEGIN
948
BEGIN
928
    IF real THEN
949
    IF real THEN
929
        AddCmd0(opFABS)
950
        AddCmd0(opFABS)
930
    ELSE
951
    ELSE
931
        AddCmd0(opABS)
952
        AddCmd0(opABS)
932
    END
953
    END
933
END abs;
954
END abs;
934
 
955
 
935
 
956
 
936
PROCEDURE floor*;
957
PROCEDURE floor*;
937
BEGIN
958
BEGIN
938
    AddCmd0(opFLOOR);
959
    AddCmd0(opFLOOR);
939
    DEC(codes.fregs);
960
    DEC(codes.fregs);
940
    ASSERT(codes.fregs >= 0)
961
    ASSERT(codes.fregs >= 0)
941
END floor;
962
END floor;
942
 
963
 
943
 
964
 
944
PROCEDURE flt* (): BOOLEAN;
965
PROCEDURE flt* (): BOOLEAN;
945
BEGIN
966
BEGIN
946
    AddCmd0(opFLT);
967
    AddCmd0(opFLT);
947
    INC(codes.fregs)
968
    INC(codes.fregs)
948
    RETURN codes.fregs < numRegsFloat
969
    RETURN codes.fregs < numRegsFloat
949
END flt;
970
END flt;
950
 
971
 
951
 
972
 
952
PROCEDURE shift_minmax* (op: CHAR);
973
PROCEDURE shift_minmax* (op: CHAR);
953
BEGIN
974
BEGIN
954
    CASE op OF
975
    CASE op OF
955
    |"A": AddCmd0(opASR)
976
    |"A": AddCmd0(opASR)
956
    |"L": AddCmd0(opLSL)
977
    |"L": AddCmd0(opLSL)
957
    |"O": AddCmd0(opROR)
978
    |"O": AddCmd0(opROR)
958
    |"R": AddCmd0(opLSR)
979
    |"R": AddCmd0(opLSR)
959
    |"m": AddCmd0(opMIN)
980
    |"m": AddCmd0(opMIN)
960
    |"x": AddCmd0(opMAX)
981
    |"x": AddCmd0(opMAX)
961
    END
982
    END
962
END shift_minmax;
983
END shift_minmax;
963
 
984
 
964
 
985
 
965
PROCEDURE shift_minmax1* (op: CHAR; x: INTEGER);
986
PROCEDURE shift_minmax1* (op: CHAR; x: INTEGER);
966
BEGIN
987
BEGIN
967
    CASE op OF
988
    CASE op OF
968
    |"A": AddCmd(opASR1, x)
989
    |"A": AddCmd(opASR1, x)
969
    |"L": AddCmd(opLSL1, x)
990
    |"L": AddCmd(opLSL1, x)
970
    |"O": AddCmd(opROR1, x)
991
    |"O": AddCmd(opROR1, x)
971
    |"R": AddCmd(opLSR1, x)
992
    |"R": AddCmd(opLSR1, x)
972
    |"m": AddCmd(opMINC, x)
993
    |"m": AddCmd(opMINC, x)
973
    |"x": AddCmd(opMAXC, x)
994
    |"x": AddCmd(opMAXC, x)
974
    END
995
    END
975
END shift_minmax1;
996
END shift_minmax1;
976
 
997
 
977
 
998
 
978
PROCEDURE shift_minmax2* (op: CHAR; x: INTEGER);
999
PROCEDURE shift_minmax2* (op: CHAR; x: INTEGER);
979
BEGIN
1000
BEGIN
980
    CASE op OF
1001
    CASE op OF
981
    |"A": AddCmd(opASR2, x)
1002
    |"A": AddCmd(opASR2, x)
982
    |"L": AddCmd(opLSL2, x)
1003
    |"L": AddCmd(opLSL2, x)
983
    |"O": AddCmd(opROR2, x)
1004
    |"O": AddCmd(opROR2, x)
984
    |"R": AddCmd(opLSR2, x)
1005
    |"R": AddCmd(opLSR2, x)
985
    |"m": AddCmd(opMINC, x)
1006
    |"m": AddCmd(opMINC, x)
986
    |"x": AddCmd(opMAXC, x)
1007
    |"x": AddCmd(opMAXC, x)
987
    END
1008
    END
988
END shift_minmax2;
1009
END shift_minmax2;
989
 
1010
 
990
 
1011
 
991
PROCEDURE len* (dim: INTEGER);
1012
PROCEDURE len* (dim: INTEGER);
992
BEGIN
1013
BEGIN
993
    AddCmd(opLEN, dim)
1014
    AddCmd(opLEN, dim)
994
END len;
1015
END len;
995
 
1016
 
996
 
1017
 
997
PROCEDURE Float* (r: REAL);
1018
PROCEDURE Float* (r: REAL);
998
VAR
1019
VAR
999
    cmd: COMMAND;
1020
    cmd: COMMAND;
1000
 
1021
 
1001
BEGIN
1022
BEGIN
1002
    cmd := NewCmd();
1023
    cmd := NewCmd();
1003
    cmd.opcode := opCONSTF;
1024
    cmd.opcode := opCONSTF;
1004
    cmd.float := r;
1025
    cmd.float := r;
1005
    insert(codes.last, cmd);
1026
    insert(codes.last, cmd);
1006
    INC(codes.fregs);
1027
    INC(codes.fregs);
1007
    ASSERT(codes.fregs <= numRegsFloat)
1028
    ASSERT(codes.fregs <= numRegsFloat)
1008
END Float;
1029
END Float;
1009
 
1030
 
1010
 
1031
 
1011
PROCEDURE precall* (flt: BOOLEAN): INTEGER;
1032
PROCEDURE precall* (flt: BOOLEAN): INTEGER;
1012
VAR
1033
VAR
1013
    res: INTEGER;
1034
    res: INTEGER;
1014
BEGIN
1035
BEGIN
1015
    res := codes.fregs;
1036
    res := codes.fregs;
1016
    AddCmd2(opPRECALL, ORD(flt), res);
1037
    AddCmd2(opPRECALL, ORD(flt), res);
1017
    codes.fregs := 0
1038
    codes.fregs := 0
1018
    RETURN res
1039
    RETURN res
1019
END precall;
1040
END precall;
1020
 
1041
 
1021
 
1042
 
1022
PROCEDURE resf* (fregs: INTEGER): BOOLEAN;
1043
PROCEDURE resf* (fregs: INTEGER): BOOLEAN;
1023
BEGIN
1044
BEGIN
1024
    AddCmd(opRESF, fregs);
1045
    AddCmd(opRESF, fregs);
1025
    codes.fregs := fregs + 1
1046
    codes.fregs := fregs + 1
1026
    RETURN codes.fregs < numRegsFloat
1047
    RETURN codes.fregs < numRegsFloat
1027
END resf;
1048
END resf;
1028
 
1049
 
1029
 
1050
 
1030
PROCEDURE res* (fregs: INTEGER);
1051
PROCEDURE res* (fregs: INTEGER);
1031
BEGIN
1052
BEGIN
1032
    AddCmd(opRES, fregs);
1053
    AddCmd(opRES, fregs);
1033
    codes.fregs := fregs
1054
    codes.fregs := fregs
1034
END res;
1055
END res;
1035
 
1056
 
1036
 
1057
 
1037
PROCEDURE retf*;
1058
PROCEDURE retf*;
1038
BEGIN
1059
BEGIN
1039
    DEC(codes.fregs);
1060
    DEC(codes.fregs);
1040
    ASSERT(codes.fregs = 0)
1061
    ASSERT(codes.fregs = 0)
1041
END retf;
1062
END retf;
1042
 
1063
 
1043
 
1064
 
1044
PROCEDURE drop*;
1065
PROCEDURE drop*;
1045
BEGIN
1066
BEGIN
1046
    AddCmd0(opDROP)
1067
    AddCmd0(opDROP)
1047
END drop;
1068
END drop;
1048
 
1069
 
1049
 
1070
 
1050
PROCEDURE case* (a, b, L, R: INTEGER);
1071
PROCEDURE case* (a, b, L, R: INTEGER);
1051
VAR
1072
VAR
1052
    cmd: COMMAND;
1073
    cmd: COMMAND;
1053
 
1074
 
1054
BEGIN
1075
BEGIN
1055
    IF a = b THEN
1076
    IF a = b THEN
1056
        cmd := NewCmd();
1077
        cmd := NewCmd();
1057
        cmd.opcode := opCASELR;
1078
        cmd.opcode := opCASELR;
1058
        cmd.param1 := a;
1079
        cmd.param1 := a;
1059
        cmd.param2 := L;
1080
        cmd.param2 := L;
1060
        cmd.param3 := R;
1081
        cmd.param3 := R;
1061
        insert(codes.last, cmd)
1082
        insert(codes.last, cmd)
1062
    ELSE
1083
    ELSE
1063
        AddCmd2(opCASEL, a, L);
1084
        AddCmd2(opCASEL, a, L);
1064
        AddCmd2(opCASER, b, R)
1085
        AddCmd2(opCASER, b, R)
1065
    END
1086
    END
1066
END case;
1087
END case;
1067
 
1088
 
1068
 
1089
 
1069
PROCEDURE caset* (a, label: INTEGER);
1090
PROCEDURE caset* (a, label: INTEGER);
1070
BEGIN
1091
BEGIN
1071
    AddCmd2(opCASET, label, a)
1092
    AddCmd2(opCASET, label, a)
1072
END caset;
1093
END caset;
1073
 
1094
 
1074
 
1095
 
1075
PROCEDURE AddExp* (label: INTEGER; name: SCAN.LEXSTR);
1096
PROCEDURE AddExp* (label: INTEGER; name: SCAN.LEXSTR);
1076
VAR
1097
VAR
1077
    exp: EXPORT_PROC;
1098
    exp: EXPORT_PROC;
1078
 
1099
 
1079
BEGIN
1100
BEGIN
1080
    NEW(exp);
1101
    NEW(exp);
1081
    exp.label := label;
1102
    exp.label := label;
1082
    exp.name  := name;
1103
    exp.name  := name;
1083
    LISTS.push(codes.export, exp)
1104
    LISTS.push(codes.export, exp)
1084
END AddExp;
1105
END AddExp;
1085
 
1106
 
1086
 
1107
 
1087
PROCEDURE AddImp* (dll, proc: SCAN.LEXSTR): IMPORT_PROC;
1108
PROCEDURE AddImp* (dll, proc: SCAN.LEXSTR): IMPORT_PROC;
1088
VAR
1109
VAR
1089
    lib: IMPORT_LIB;
1110
    lib: IMPORT_LIB;
1090
    p:   IMPORT_PROC;
1111
    p:   IMPORT_PROC;
1091
 
1112
 
1092
BEGIN
1113
BEGIN
1093
    lib := codes.import.first(IMPORT_LIB);
1114
    lib := codes.import.first(IMPORT_LIB);
1094
    WHILE (lib # NIL) & (lib.name # dll) DO
1115
    WHILE (lib # NIL) & (lib.name # dll) DO
1095
        lib := lib.next(IMPORT_LIB)
1116
        lib := lib.next(IMPORT_LIB)
1096
    END;
1117
    END;
1097
 
1118
 
1098
    IF lib = NIL THEN
1119
    IF lib = NIL THEN
1099
        NEW(lib);
1120
        NEW(lib);
1100
        lib.name := dll;
1121
        lib.name := dll;
1101
        lib.procs := LISTS.create(NIL);
1122
        lib.procs := LISTS.create(NIL);
1102
        LISTS.push(codes.import, lib)
1123
        LISTS.push(codes.import, lib)
1103
    END;
1124
    END;
1104
 
1125
 
1105
    p := lib.procs.first(IMPORT_PROC);
1126
    p := lib.procs.first(IMPORT_PROC);
1106
    WHILE (p # NIL) & (p.name # proc) DO
1127
    WHILE (p # NIL) & (p.name # proc) DO
1107
        p := p.next(IMPORT_PROC)
1128
        p := p.next(IMPORT_PROC)
1108
    END;
1129
    END;
1109
 
1130
 
1110
    IF p = NIL THEN
1131
    IF p = NIL THEN
1111
        NEW(p);
1132
        NEW(p);
1112
        p.name  := proc;
1133
        p.name  := proc;
1113
        p.label := NewLabel();
1134
        p.label := NewLabel();
1114
        p.lib   := lib;
1135
        p.lib   := lib;
1115
        p.count := 1;
1136
        p.count := 1;
1116
        LISTS.push(lib.procs, p)
1137
        LISTS.push(lib.procs, p)
1117
    ELSE
1138
    ELSE
1118
        INC(p.count)
1139
        INC(p.count)
1119
    END
1140
    END
1120
 
1141
 
1121
    RETURN p
1142
    RETURN p
1122
END AddImp;
1143
END AddImp;
1123
 
1144
 
1124
 
1145
 
1125
PROCEDURE DelImport* (imp: LISTS.ITEM);
1146
PROCEDURE DelImport* (imp: LISTS.ITEM);
1126
VAR
1147
VAR
1127
    lib: IMPORT_LIB;
1148
    lib: IMPORT_LIB;
1128
 
1149
 
1129
BEGIN
1150
BEGIN
1130
    DEC(imp(IMPORT_PROC).count);
1151
    DEC(imp(IMPORT_PROC).count);
1131
    IF imp(IMPORT_PROC).count = 0 THEN
1152
    IF imp(IMPORT_PROC).count = 0 THEN
1132
        lib := imp(IMPORT_PROC).lib;
1153
        lib := imp(IMPORT_PROC).lib;
1133
        LISTS.delete(lib.procs, imp);
1154
        LISTS.delete(lib.procs, imp);
1134
        IF lib.procs.first = NIL THEN
1155
        IF lib.procs.first = NIL THEN
1135
            LISTS.delete(codes.import, lib)
1156
            LISTS.delete(codes.import, lib)
1136
        END
1157
        END
1137
    END
1158
    END
1138
END DelImport;
1159
END DelImport;
1139
 
1160
 
1140
 
1161
 
1141
PROCEDURE init* (pNumRegsFloat, pEndianness: INTEGER);
1162
PROCEDURE init* (pCPU: INTEGER);
1142
VAR
1163
VAR
1143
    cmd:    COMMAND;
1164
    cmd:    COMMAND;
1144
    i:      INTEGER;
1165
    i:      INTEGER;
1145
 
1166
 
1146
BEGIN
1167
BEGIN
1147
    commands := C.create();
1168
    commands := C.create();
1148
    variables := C.create();
1169
    variables := C.create();
-
 
1170
 
1149
    numRegsFloat := pNumRegsFloat;
1171
    CPU := pCPU;
1150
    endianness := pEndianness;
1172
    endianness := little_endian;
-
 
1173
    CASE CPU OF
-
 
1174
    |TARGETS.cpuAMD64:  numRegsFloat := 6
-
 
1175
    |TARGETS.cpuX86:    numRegsFloat := 8
-
 
1176
    |TARGETS.cpuMSP430: numRegsFloat := 0
-
 
1177
    |TARGETS.cpuTHUMB:  numRegsFloat := 256
-
 
1178
    END;
1151
 
1179
 
1152
    NEW(codes.begcall);
1180
    NEW(codes.begcall);
1153
    codes.begcall.top := -1;
1181
    codes.begcall.top := -1;
1154
    NEW(codes.endcall);
1182
    NEW(codes.endcall);
1155
    codes.endcall.top := -1;
1183
    codes.endcall.top := -1;
1156
    codes.commands := LISTS.create(NIL);
1184
    codes.commands := LISTS.create(NIL);
1157
    codes.export   := LISTS.create(NIL);
1185
    codes.export   := LISTS.create(NIL);
1158
    codes.import   := LISTS.create(NIL);
1186
    codes.import   := LISTS.create(NIL);
1159
    codes.types    := CHL.CreateIntList();
1187
    codes.types    := CHL.CreateIntList();
1160
    codes.data     := CHL.CreateByteList();
1188
    codes.data     := CHL.CreateByteList();
1161
 
1189
 
1162
    NEW(cmd); cmd.opcode := opNOP; LISTS.push(codes.commands, cmd);
1190
    NEW(cmd); cmd.opcode := opNOP; LISTS.push(codes.commands, cmd);
1163
    codes.last := cmd;
1191
    codes.last := cmd;
1164
    NEW(cmd); cmd.opcode := opNOP; LISTS.push(codes.commands, cmd);
1192
    NEW(cmd); cmd.opcode := opNOP; LISTS.push(codes.commands, cmd);
1165
 
1193
 
1166
    AddRec(0);
1194
    AddRec(0);
1167
 
1195
 
1168
    codes.lcount := 0;
1196
    codes.lcount := 0;
1169
 
1197
 
1170
    codes.fregs := 0;
1198
    codes.fregs := 0;
1171
 
1199
 
1172
    FOR i := 0 TO LEN(codes.charoffs) - 1 DO
1200
    FOR i := 0 TO LEN(codes.charoffs) - 1 DO
1173
        codes.charoffs[i] := -1
1201
        codes.charoffs[i] := -1
1174
    END;
1202
    END;
1175
 
1203
 
1176
    FOR i := 0 TO LEN(codes.wcharoffs) - 1 DO
1204
    FOR i := 0 TO LEN(codes.wcharoffs) - 1 DO
1177
        codes.wcharoffs[i] := -1
1205
        codes.wcharoffs[i] := -1
1178
    END
1206
    END
1179
 
1207
 
1180
END init;
1208
END init;
1181
 
1209
 
1182
 
1210
 
1183
END IL.
1211
END IL.