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