b5d4ec95769d797b5321f8efd3230b811f15b4c1
1 MODULE DswCompilerCPfrontMain
;
3 IMPORT Kernel
, HostFiles
, Files
, Console
, Strings
, DswDocuments
,
4 DevCPM
, DevCPT
, DevCPB
, DevCPP
, DevCPE
, DevCPH
, DevCPV
:= CPfrontCPV
, DevCPG
:= CPfrontCPG
;
7 (* compiler options: *)
8 checks
= 0; allchecks
= 1; assert
= 2; obj
= 3; ref
= 4; allref
= 5;
9 srcpos
= 6; reallib
= 7; signatures
= 8;
10 mainprog
= 20; include0
= 21;
11 hint
= 29; oberon
= 30; errorTrap
= 31;
12 (* defopt = {checks, assert, obj, ref, allref, srcpos, signatures}; *)
13 defopt
= {checks
, assert
, obj
};
19 Elem
= POINTER TO RECORD
20 dir
, name
, path
: Files
.Name
;
21 outsym
, outcode
: Files
.Name
; (* dir *)
22 insym
: DevCPM
.Directory
;
23 found
: BOOLEAN; (* COM Aware *)
31 PROCEDURE GetPath (IN path
: ARRAY OF CHAR; OUT dir
, name
: Files
.Name
);
32 VAR i
, j
, len
: INTEGER;
36 WHILE (i
>= 0) & (path
[i
] # '
/'
) DO DEC(i
) END;
38 FOR i
:= 0 TO i
- 1 DO
53 PROCEDURE InitOptions
;
57 insym
, sym
: DevCPM
.Directory
;
58 outsym
, outcode
: Files
.Name
;
65 IF i
>= Kernel
.argc
THEN
66 Console
.WriteStr("required more parameters for ");
67 Console
.WriteStr(p
); Console
.WriteLn
;
73 outsym
:= ""; outcode
:= "";
74 opts
:= defopt
; opts2
:= defopt2
; found
:= FALSE
;
75 h
:= NIL; t
:= NIL; insym
:= NIL;
77 WHILE i
< Kernel
.argc
DO
78 IF Kernel
.argv
[i
, 0] = "-" THEN
83 ELSIF p
= "-outsym" THEN
85 outsym
:= Kernel
.argv
[i
]$
;
87 ELSIF p
= "-outcode" THEN
89 outcode
:= Kernel
.argv
[i
]$
;
91 ELSIF p
= "-symdir" THEN
95 insym
.path
:= Kernel
.argv
[i
]$
;
96 insym
.legacy
:= FALSE
;
99 ELSIF p
= "-legacysymdir" THEN
103 insym
.path
:= Kernel
.argv
[i
]$
;
104 insym
.legacy
:= TRUE
;
107 ELSIF p
= "-allchecks" THEN
108 INCL(opts
, allchecks
)
109 ELSIF p
= "-no-allchecks" THEN
110 EXCL(opts
, allchecks
)
111 ELSIF p
= "-srcpos" THEN
113 ELSIF p
= "-no-srcpos" THEN
115 ELSIF p
= "-structref" THEN
117 ELSIF p
= "-no-structref" THEN
119 ELSIF p
= "-ref" THEN
121 ELSIF p
= "-no-ref" THEN
123 ELSIF p
= "-obj" THEN
125 ELSIF p
= "-no-obj" THEN
127 ELSIF p
= "-assert" THEN
129 ELSIF p
= "-no-assert" THEN
131 ELSIF p
= "-checks" THEN
133 ELSIF p
= "-no-checks" THEN
135 ELSIF p
= "-hints" THEN
137 ELSIF p
= "-no-hints" THEN
139 ELSIF p
= "-trap" THEN
140 Kernel
.intTrap
:= TRUE
;
141 INCL(opts
, errorTrap
)
142 ELSIF p
= "-no-trap" THEN
143 EXCL(opts
, errorTrap
)
144 ELSIF p
= "-oberon" THEN
146 ELSIF p
= "-no-oberon" THEN
148 ELSIF p
= "-com-aware" THEN
150 ELSIF p
= "-no-com-aware" THEN
152 ELSIF (p
= "-v") OR (p
= "-verbose") THEN
153 DevCPM
.verbose
:= MIN(DevCPM
.verbose
+ 1, 3)
154 ELSIF p
= "-main" THEN
156 ELSIF p
= "-no-main" THEN
158 ELSIF p
= "-include0" THEN
160 ELSIF p
= "-no-include0" THEN
162 ELSIF p
= "-includedir" THEN
164 DevCPG
.includePath
:= Kernel
.argv
[i
]$
;
166 ELSIF p
= "-long-calls" THEN
168 ELSIF p
= "-no-long-calls" THEN
171 Console
.WriteStr("unknown option ");
172 Console
.WriteStr(p
); Console
.WriteLn
;
176 IF h
= NIL THEN NEW(h
); t
:= h
177 ELSE NEW(t
.next
); t
:= t
.next
179 t
.path
:= Kernel
.argv
[i
]$
;
180 t
.outcode
:= outcode
;
186 GetPath(t
.path
, t
.dir
, t
.name
);
188 Console
.WriteStr("specified path to directory"); Console
.WriteLn
;
197 PROCEDURE Module (source
: POINTER TO ARRAY OF CHAR; m
: Elem
; OUT error
: BOOLEAN);
198 VAR ext
, new
: BOOLEAN; p
: DevCPT
.Node
;
200 DevCPG
.opt
:= {}; (* !!! *)
202 DevCPM
.symList
:= m
.insym
;
203 DevCPM
.codePath
:= m
.outcode
;
204 DevCPM
.symPath
:= m
.outsym
;
205 DevCPM
.name
:= m
.path
;
206 INCL(DevCPM
.options
, 10); (* !!! allow [ccall] *)
207 INCL(DevCPM
.options
, DevCPM
.allSysVal
); (* !!! make nodes for all SYSTEM.VAL *)
208 INCL(DevCPG
.opt
, DevCPG
.ansi
); (* !!! *)
209 IF m
.found
THEN INCL(DevCPM
.options
, DevCPM
.comAware
) END;
210 IF errorTrap
IN m
.opts
THEN INCL(DevCPM
.options
, DevCPM
.trap
) END;
211 IF oberon
IN m
.opts
THEN INCL(DevCPM
.options
, DevCPM
.oberon
) END;
212 IF mainprog
IN m
.opts
THEN INCL(DevCPG
.opt
, DevCPG
.mainprog
) END;
213 IF include0
IN m
.opts
THEN INCL(DevCPG
.opt
, DevCPG
.include0
) END;
215 (* DevCPB.typSize := DevCPV.TypeSize; *)
216 DevCPB
.typSize
:= DevCPV
.TypSize
;
217 DevCPT
.processor
:= DevCPV
.processor
;
220 IF DevCPT
.libName
# "" THEN EXCL(m
.opts
, obj
) END;
221 DevCPV
.Init(m
.opts
); DevCPV
.AdrAndSize(DevCPT
.topScope
); DevCPT
.Export(ext
, new
);
222 IF DevCPM
.noerr
& (obj
IN m
.opts
) THEN
223 DevCPG
.OpenFiles(DevCPT
.SelfName
);
224 IF emulong
IN m
.opts2
THEN
225 DevCPH
.UseCalls(p
, {DevCPH
.longMop
, DevCPH
.longDop
, DevCPH
.longConv
, DevCPH
.longOdd
});
231 IF DevCPM
.noerr
& (DevCPG
.mainprog
IN DevCPG
.opt
) & (DevCPG
.modName
# "SYSTEM") THEN
233 IF DevCPM
.verbose
> 0 THEN
234 DevCPM
.LogWStr(" main program"); DevCPM
.LogWLn
236 ELSIF DevCPM
.noerr
& (new
OR ext
) THEN
237 DevCPM
.RegisterNewSym
241 IF obj
IN m
.opts
THEN
245 error
:= ~DevCPM
.noerr
;
248 IF DevCPM
.verbose
> 0 THEN DevCPM
.LogWStr(" ") END;
249 IF DevCPM
.errors
= 1 THEN
250 DevCPM
.LogWStr("one error detected");
252 DevCPM
.LogWNum(DevCPM
.errors
, 0); DevCPM
.LogWStr(" errors detected")
256 IF hint
IN m
.opts
THEN DevCPM
.InsertMarks
END
263 PROCEDURE ReadText (s
: Elem
): POINTER TO ARRAY OF CHAR;
265 i
, len
, res
: INTEGER;
266 text
: DswDocuments
.Text
;
267 loc
: Files
.Locator
; f
: Files
.File
; r
: Files
.Reader
;
268 ssrc
: POINTER TO ARRAY OF SHORTCHAR
;
269 src
: POINTER TO ARRAY OF CHAR;
270 x
: POINTER TO ARRAY OF BYTE;
271 num
: ARRAY 32 OF CHAR;
274 loc
:= Files
.dir
.This(s
.dir
);
275 DswDocuments
.Import(loc
, s
.name
, text
, res
);
276 Strings
.IntToString(res
, num
);
280 f
:= Files
.dir
.Old(loc
, s
.name
, Files
.shared
);
283 r
:= f
.NewReader(NIL);
285 r
.ReadBytes(x
, 0, len
);
287 FOR i
:= 0 TO len
- 1 DO
288 ssrc
[i
] := SHORT(CHR(x
[i
]))
293 Kernel
.Utf8ToString(ssrc
, src
, res
);
298 IF DevCPM
.verbose
> 0 THEN
299 Console
.WriteStr("document error ");
300 Console
.WriteStr(num
);
305 Console
.WriteStr("unable to open file ");
306 Console
.WriteStr(s
.path
);
313 PROCEDURE CompileAll
;
314 VAR loc
: Files
.Locator
; m
: Elem
; error
: BOOLEAN; src
: POINTER TO ARRAY OF CHAR;
318 IF DevCPM
.verbose
> 0 THEN
319 Console
.WriteStr("compiling "); Console
.WriteStr(m
.path
); Console
.WriteLn
322 Module(src
, m
, error
);
323 IF error
THEN Kernel
.Quit(1) END;
330 IF Kernel
.trapCount
# 0 THEN Kernel
.Quit(1) END;
331 HostFiles
.SetRootDir(".");
338 Kernel
.intTrap
:= FALSE
;
340 END DswCompilerCPfrontMain
.