1 /* voc 2.1.0 [2019/11/01]. Bootstrapping compiler for address size 8, alignment 8. xrtspamS */
2
3 #define SHORTINT INT8
4 #define INTEGER INT16
5 #define LONGINT INT32
6 #define SET UINT32
7
8 #include "SYSTEM.h"
9 #include "Configuration.h"
10 #include "Heap.h"
11 #include "OPB.h"
12 #include "OPC.h"
13 #include "OPM.h"
14 #include "OPP.h"
15 #include "OPT.h"
16 #include "OPV.h"
17 #include "Platform.h"
18 #include "Strings.h"
19 #include "VT100.h"
20 #include "extTools.h"
21
22
23
24
25 static void Compiler_FindLocalObjectFiles (CHAR *objectnames, ADDRESS objectnames__len);
26 export void Compiler_Module (BOOLEAN *done);
27 static void Compiler_PropagateElementaryTypeSizes (void);
28 export void Compiler_Translate (void);
29 static void Compiler_Trap (INT32 sig);
30
31
Compiler_Module(BOOLEAN * done)32 void Compiler_Module (BOOLEAN *done)
33 {
34 BOOLEAN ext, new;
35 OPT_Node p = NIL;
36 OPP_Module(&p, OPM_Options);
37 if (OPM_noerr) {
38 OPV_Init();
39 OPT_InitRecno();
40 OPV_AdrAndSize(OPT_topScope);
41 OPT_Export(&ext, &new);
42 if (OPM_noerr) {
43 OPM_OpenFiles((void*)OPT_SelfName, 256);
44 OPM_DeleteObj((void*)OPT_SelfName, 256);
45 OPC_Init();
46 OPV_Module(p);
47 if (OPM_noerr) {
48 if ((__IN(10, OPM_Options, 32) && __STRCMP(OPM_modName, "SYSTEM") != 0)) {
49 OPM_DeleteSym((void*)OPT_SelfName, 256);
50 OPM_LogVT100((CHAR*)"32m", 4);
51 OPM_LogWStr((CHAR*)" Main program.", 16);
52 OPM_LogVT100((CHAR*)"0m", 3);
53 } else {
54 if (new) {
55 OPM_LogVT100((CHAR*)"32m", 4);
56 OPM_LogWStr((CHAR*)" New symbol file.", 19);
57 OPM_LogVT100((CHAR*)"0m", 3);
58 OPM_RegisterNewSym();
59 } else if (ext) {
60 OPM_LogWStr((CHAR*)" Extended symbol file.", 24);
61 OPM_RegisterNewSym();
62 }
63 }
64 } else {
65 OPM_DeleteSym((void*)OPT_SelfName, 256);
66 }
67 }
68 }
69 OPM_CloseFiles();
70 OPT_Close();
71 OPM_LogWLn();
72 *done = OPM_noerr;
73 }
74
Compiler_PropagateElementaryTypeSizes(void)75 static void Compiler_PropagateElementaryTypeSizes (void)
76 {
77 OPT_Struct adrinttyp = NIL;
78 OPT_sysptrtyp->size = OPM_AddressSize;
79 OPT_sysptrtyp->idfp = OPT_sysptrtyp->form;
80 OPM_FPrint(&OPT_sysptrtyp->idfp, OPT_sysptrtyp->size);
81 OPT_adrtyp->size = OPM_AddressSize;
82 OPT_adrtyp->idfp = OPT_adrtyp->form;
83 OPM_FPrint(&OPT_adrtyp->idfp, OPT_adrtyp->size);
84 adrinttyp = OPT_IntType(OPM_AddressSize);
85 OPT_adrtyp->strobj = adrinttyp->strobj;
86 OPT_sinttyp = OPT_IntType(OPM_ShortintSize);
87 OPT_inttyp = OPT_IntType(OPM_IntegerSize);
88 OPT_linttyp = OPT_IntType(OPM_LongintSize);
89 OPT_sintobj->typ = OPT_sinttyp;
90 OPT_intobj->typ = OPT_inttyp;
91 OPT_lintobj->typ = OPT_linttyp;
92 switch (OPM_LongintSize) {
93 case 4:
94 OPT_settyp = OPT_set32typ;
95 break;
96 default:
97 OPT_settyp = OPT_set64typ;
98 break;
99 }
100 OPT_setobj->typ = OPT_settyp;
101 if (__STRCMP(OPM_Model, "C") == 0) {
102 OPT_cpbytetyp->strobj->name[4] = 0x00;
103 } else {
104 OPT_cpbytetyp->strobj->name[4] = '@';
105 }
106 }
107
Compiler_FindLocalObjectFiles(CHAR * objectnames,ADDRESS objectnames__len)108 static void Compiler_FindLocalObjectFiles (CHAR *objectnames, ADDRESS objectnames__len)
109 {
110 OPT_Link l = NIL;
111 CHAR fn[64];
112 Platform_FileIdentity id;
113 objectnames[0] = 0x00;
114 l = OPT_Links;
115 while (l != NIL) {
116 __COPY(l->name, fn, 64);
117 Strings_Append((CHAR*)".sym", 5, (void*)fn, 64);
118 if (Platform_IdentifyByName(fn, 64, &id, Platform_FileIdentity__typ) == 0) {
119 __COPY(l->name, fn, 64);
120 Strings_Append((CHAR*)".o", 3, (void*)fn, 64);
121 if (Platform_IdentifyByName(fn, 64, &id, Platform_FileIdentity__typ) == 0) {
122 Strings_Append((CHAR*)" ", 2, (void*)objectnames, objectnames__len);
123 Strings_Append(fn, 64, (void*)objectnames, objectnames__len);
124 } else {
125 OPM_LogVT100((CHAR*)"91m", 4);
126 OPM_LogWStr((CHAR*)"Link warning: a local symbol file is present for module ", 57);
127 OPM_LogWStr(l->name, 256);
128 OPM_LogWStr((CHAR*)", but local object file '", 26);
129 OPM_LogWStr(fn, 64);
130 OPM_LogWStr((CHAR*)"' is missing.", 14);
131 OPM_LogVT100((CHAR*)"0m", 3);
132 OPM_LogWLn();
133 }
134 }
135 l = l->next;
136 }
137 }
138
Compiler_Translate(void)139 void Compiler_Translate (void)
140 {
141 BOOLEAN done;
142 CHAR linkfiles[2048];
143 if (OPM_OpenPar()) {
144 for (;;) {
145 OPM_Init(&done);
146 if (!done) {
147 return;
148 }
149 OPM_InitOptions();
150 Compiler_PropagateElementaryTypeSizes();
151 Heap_GC(0);
152 Compiler_Module(&done);
153 if (!done) {
154 OPM_LogWLn();
155 OPM_LogWStr((CHAR*)"Module compilation failed.", 27);
156 OPM_LogWLn();
157 Platform_Exit(1);
158 }
159 if (!__IN(13, OPM_Options, 32)) {
160 if (__IN(14, OPM_Options, 32)) {
161 extTools_Assemble(OPM_modName, 32);
162 } else {
163 if (!__IN(10, OPM_Options, 32)) {
164 extTools_Assemble(OPM_modName, 32);
165 } else {
166 Compiler_FindLocalObjectFiles((void*)linkfiles, 2048);
167 extTools_LinkMain((void*)OPM_modName, 32, __IN(15, OPM_Options, 32), linkfiles, 2048);
168 }
169 }
170 }
171 }
172 }
173 }
174
Compiler_Trap(INT32 sig)175 static void Compiler_Trap (INT32 sig)
176 {
177 Heap_FINALL();
178 if (sig == 3) {
179 Platform_Exit(0);
180 } else {
181 if (sig == 4) {
182 OPM_LogWStr((CHAR*)" --- Oberon compiler internal error", 36);
183 OPM_LogWLn();
184 }
185 Platform_Exit(2);
186 }
187 }
188
189
main(int argc,char ** argv)190 export int main(int argc, char **argv)
191 {
192 __INIT(argc, argv);
193 __MODULE_IMPORT(Configuration);
194 __MODULE_IMPORT(Heap);
195 __MODULE_IMPORT(OPB);
196 __MODULE_IMPORT(OPC);
197 __MODULE_IMPORT(OPM);
198 __MODULE_IMPORT(OPP);
199 __MODULE_IMPORT(OPT);
200 __MODULE_IMPORT(OPV);
201 __MODULE_IMPORT(Platform);
202 __MODULE_IMPORT(Strings);
203 __MODULE_IMPORT(VT100);
204 __MODULE_IMPORT(extTools);
205 __REGMAIN("Compiler", 0);
206 __REGCMD("Translate", Compiler_Translate);
207 /* BEGIN */
208 Platform_SetInterruptHandler(Compiler_Trap);
209 Platform_SetQuitHandler(Compiler_Trap);
210 Platform_SetBadInstructionHandler(Compiler_Trap);
211 Compiler_Translate();
212 __FINI;
213 }
214