3 IMPORT Kernel
, Files
, Log
, Strings
, DswOpts
, DswProcs
, DswDocuments
, DevCPM
, DevCPT
, DevCPR
, DevCPS
;
10 null
= 0; times
= 1; slash
= 2; div
= 3; mod
= 4;
11 and
= 5; plus
= 6; minus
= 7; or
= 8; eql
= 9;
12 neq
= 10; lss
= 11; leq
= 12; gtr
= 13; geq
= 14;
13 in
= 15; is
= 16; arrow
= 17; dollar
= 18; period
= 19;
14 comma
= 20; colon
= 21; upto
= 22; rparen
= 23; rbrak
= 24;
15 rbrace
= 25; of
= 26; then
= 27; do
= 28; to
= 29;
17 lparen
= 40; lbrak
= 41; lbrace
= 42; becomes
= 44;
18 number
= 45; nil
= 46; string
= 47; ident
= 48; semicolon
= 49;
19 bar
= 50; end
= 51; else
= 52; elsif
= 53; until
= 54;
20 if
= 55; case
= 56; while
= 57; repeat
= 58; for
= 59;
21 loop
= 60; with
= 61; exit
= 62; return
= 63; array
= 64;
22 record
= 65; pointer
= 66; begin
= 67; const
= 68; type
= 69;
23 var
= 70; out
= 71; procedure
= 72; close
= 73; import
= 74;
24 module
= 75; eof
= 76;
26 (* module state flags *)
27 imported
= 0; trace
= 1; hasObj
= 2; hasSym
= 3; hasErrors
= 4; library
= 5;
34 String
= POINTER TO ARRAY OF CHAR;
36 Selector
= POINTER TO RECORD
42 Module
= POINTER TO RECORD
45 selectors
: Selector
; (* with head, list of selectors for this module *)
46 depth
: INTEGER; (* 0: leaf, MAX: root *)
48 imp
: ARRAY maxImps
OF Module
;
50 worker
: DswProcs
.Process
;
55 mno
, rno
: INTEGER; (* num modules *)
56 modList
, lnkList
, cmpList
: ARRAY maxImps
OF Module
;
57 def
: Selector
; (* with head, global list of selectors *)
62 (* --------- options --------- *)
64 PROCEDURE IdentLen (IN s
: ARRAY OF CHAR): INTEGER;
68 IF Strings
.IsIdentStart(s
[0]) THEN
69 REPEAT INC(i
) UNTIL ~Strings
.IsIdent(s
[i
])
74 PROCEDURE Define (n
: ARRAY OF CHAR);
75 VAR i
: INTEGER; v
: BOOLEAN; s
: Selector
;
79 IF ~
((n
[i
] = 0X
) OR (((n
[i
] = "+") OR (n
[i
] = "-")) & (n
[i
+ 1] = 0X
))) THEN
80 Log
.String("option -D expect + or - after identifier"); Log
.Ln
; INC(err
)
82 v
:= n
[i
] # "-"; n
[i
] := 0X
; s
:= def
;
83 WHILE (s
.next
# NIL) & (s
.next
.name$
# n$
) DO s
:= s
.next
END;
86 Strings
.StringToUtf8(n
, s
.next
.name
, i
);
91 Log
.String("option -D expect identifier"); Log
.Ln
; INC(err
)
95 PROCEDURE Undefine (IN n
: ARRAY OF CHAR);
96 VAR i
: INTEGER; s
: Selector
;
99 IF (i
# 0) & (n
[i
] = 0X
) THEN
101 WHILE (s
.next
# NIL) & (s
.next
.name$
# n$
) DO s
:= s
.next
END;
102 IF s
.next
# NIL THEN s
.next
:= s
.next
.next
END
104 Log
.String("option -U expect identifier"); Log
.Ln
; INC(err
)
108 PROCEDURE CopySelectorList (base
: Selector
): Selector
;
109 VAR s
, t
, x
: Selector
;
111 ASSERT(base
# NIL, 20);
112 s
:= base
; NEW(t
); x
:= t
;
115 IF s
.next
# NIL THEN NEW(x
.next
); x
:= x
.next
END;
119 END CopySelectorList
;
121 PROCEDURE AddModule (IN n
: ARRAY OF CHAR; selectors
: Selector
);
122 VAR i
, res
: INTEGER; m
: Module
;
125 IF (i
# 0) & (n
[i
] = 0X
) THEN
127 WHILE (i
< mno
) & (modList
[i
].name$
# n$
) DO INC(i
) END;
130 Strings
.StringToUtf8(n
, m
.name
, res
);
132 m
.selectors
:= CopySelectorList(selectors
);
137 Log
.String("module name must be identifier"); Log
.Ln
; INC(err
)
141 PROCEDURE StrToInt (IN s
: ARRAY OF CHAR; def
: INTEGER): INTEGER;
144 Strings
.StringToInt(s
, x
, res
);
146 Log
.String("expected integer"); Log
.Ln
; INC(err
);
156 CASE DswOpts
.GetOpt("ao:j:D:U:") OF
158 |
"o": exe
:= DswOpts
.str
159 |
"j": IF DswOpts
.str
= NIL THEN jobs
:= maxJobs
ELSE jobs
:= MIN(MAX(StrToInt(DswOpts
.str
, 0), 1), maxJobs
) END
160 |
"D": Define(DswOpts
.str
)
161 |
"U": Undefine(DswOpts
.str
)
162 |
":": Log
.String("missing argument for option -"); Log
.String(DswOpts
.str
); Log
.Ln
; INC(err
)
163 |
"?": Log
.String("unknown option -"); Log
.String(DswOpts
.str
); Log
.Ln
; INC(err
)
164 |
"$": AddModule(DswOpts
.str
, def
)
170 (* --------- loader --------- *)
172 PROCEDURE Import (m
: Module
; IN name
: DevCPT
.Name
);
173 VAR i
, j
: INTEGER; imp
: Module
;
176 ASSERT(name
# "", 21);
177 IF debugImport
THEN Log
.String(" import "); Log
.String(name$
) END;
178 IF name
= "SYSTEM" THEN INCL(DevCPM
.options
, DevCPM
.sysImp
)
179 ELSIF name
= "COM" THEN INCL(DevCPM
.options
, DevCPM
.com
)
180 ELSIF name
= "JAVA" THEN INCL(DevCPM
.options
, DevCPM
.java
)
182 IF debugImport
THEN Log
.Char(" ") END;
183 i
:= 0; (* find module in local list *)
184 WHILE (i
< m
.mno
) & (m
.imp
[i
].name$
# name$
) DO INC(i
) END;
186 j
:= 0; (* find module in global list *)
187 WHILE (j
< mno
) & (modList
[j
].name$
# name$
) DO INC(j
) END;
189 NEW(imp
); imp
.name
:= name$
; imp
.selectors
:= CopySelectorList(m
.selectors
);
190 modList
[mno
] := imp
; INC(mno
)
194 m
.imp
[m
.mno
] := imp
; INC(m
.mno
)
198 IF debugImport
THEN Log
.Ln
END;
201 PROCEDURE ParseModule (m
: Module
);
202 VAR sym
: BYTE; SelfName
, impName
, aliasName
: DevCPT
.Name
;
204 PROCEDURE err (n
: SHORTINT);
208 PROCEDURE CheckSym(s
: SHORTINT);
210 IF sym
= s
THEN DevCPS
.Get(sym
) ELSE DevCPM
.err(s
) END
214 IF debugImport
THEN Log
.String("module " + m
.name
); Log
.Ln
END;
215 DevCPS
.Init
; DevCPS
.Get(sym
);
216 IF sym
= module
THEN DevCPS
.Get(sym
) ELSE err(16) END;
218 SelfName
:= DevCPS
.name$
; DevCPS
.Get(sym
);
220 INCL(DevCPM
.options
, DevCPM
.interface
); DevCPS
.Get(sym
);
221 IF sym
= eql
THEN DevCPS
.Get(sym
)
222 ELSE INCL(DevCPM
.options
, DevCPM
.noCode
)
224 IF sym
= string
THEN INCL(m
.flags
, library
); DevCPS
.Get(sym
)
230 IF sym
= import
THEN DevCPS
.Get(sym
);
233 aliasName
:= DevCPS
.name$
; impName
:= aliasName$
; DevCPS
.Get(sym
);
234 IF sym
= becomes
THEN DevCPS
.Get(sym
);
235 IF sym
= ident
THEN impName
:= DevCPS
.name$
; DevCPS
.Get(sym
) ELSE err(ident
) END
240 IF sym
= comma
THEN DevCPS
.Get(sym
)
241 ELSIF sym
= ident
THEN err(comma
)
252 PROCEDURE CheckModule (m
: Module
; source
: String
; OUT ok
: BOOLEAN);
257 DevCPM.symList := m.insym;
258 DevCPM.codePath := m.outcode;
259 DevCPM.symPath := m.outsym;
261 DevCPM
.name
:= m
.name$
;
263 IF m.found THEN INCL(DevCPM.options, DevCPM.comAware) END;
264 IF errorTrap IN m.opts THEN INCL(DevCPM.options, DevCPM.trap) END;
265 IF oberon IN m.opts THEN INCL(DevCPM.options, DevCPM.oberon) END;
268 s
:= m
.selectors
.next
;
270 DevCPR
.Set(s
.name
, s
.value
);
282 PROCEDURE GetSource (IN modName
: ARRAY OF CHAR; OUT path
: Files
.Name
; OUT s
: String
);
283 CONST modDir
= "Mod"; sysDir
= "System";
284 VAR dir
, name
: Files
.Name
; loc
: Files
.Locator
;
285 text
: DswDocuments
.Model
; r
: DswDocuments
.Reader
; i
, res
: INTEGER;
287 PROCEDURE MakePath (dir
, name
: Files
.Name
; type
: Files
.Type
; OUT path
: Files
.Name
);
289 ASSERT(name
# "", 21);
290 IF dir
= "" THEN path
:= modDir
+ "/" + name
291 ELSE path
:= dir
+ "/" + modDir
+ "/" + name
293 Kernel
.MakeFileName(path
, type
)
297 s
:= NIL; path
:= "";
298 Kernel
.SplitName(modName
, dir
, name
);
299 loc
:= Files
.dir
.This(dir
).This(modDir
);
300 (* --> Kernel.MakeFileName(name, Kernel.docType); <-- *)
301 MakePath(dir
, name
, "cp", path
);
302 DswDocuments
.Open(loc
, name
+ ".cp", text
, res
);
304 MakePath(dir
, name
, "odc", path
);
305 DswDocuments
.Open(loc
, name
+ ".odc", text
, res
);
306 IF (text
= NIL) & (dir
= "") THEN
307 MakePath(sysDir
, name
, "cp", path
);
308 loc
:= Files
.dir
.This(sysDir
).This(modDir
);
309 DswDocuments
.Open(loc
, name
+ ".cp", text
, res
);
311 MakePath(sysDir
, name
, "odc", path
);
312 DswDocuments
.Open(loc
, name
+ ".odc", text
, res
);
320 NEW(s
, text
.Length() + 1);
322 r
:= text
.NewReader(NIL);
323 FOR i
:= 0 TO text
.Length() - 1 DO
324 r
.Read
; s
[i
] := r
.char
330 PROCEDURE Trace (m
, parent
: Module
; VAR lno
: INTEGER);
333 IF ~
(trace
IN m
.flags
) THEN
334 INCL(m
.flags
, trace
);
335 FOR i
:= 0 TO m
.mno
- 1 DO
336 Trace(m
.imp
[i
], m
, lno
);
337 m
.depth
:= MAX(m
.depth
, m
.imp
[i
].depth
+ 1)
339 IF ~
(imported
IN m
.flags
) THEN
340 INCL(m
.flags
, imported
);
346 Log
.String("recursive import of " + m
.name
+ " in " + parent
.name
); Log
.Ln
; INC(err
)
351 VAR i
, j
: INTEGER; m
: Module
;
353 ASSERT((mno
= 0) OR (lnkList
[0] # NIL), 20);
359 WHILE (j
>= 0) & (cmpList
[j
].depth
> m
.depth
) DO
360 cmpList
[j
+ 1] := cmpList
[j
];
369 VAR i
, j
, num
: INTEGER; m
: Module
; s
: String
; ok
: BOOLEAN;
372 WHILE (err
= 0) & (i
< mno
) DO
374 GetSource(m
.name$
, m
.path
, s
);
376 CheckModule(m
, s
, ok
);
377 IF ~ok
THEN INC(err
) END
379 Log
.String("unable to open module " + m
.name
); Log
.Ln
; INC(err
)
384 FOR i
:= 0 TO rno
- 1 DO
385 Trace(modList
[i
], modList
[i
], num
)
387 ASSERT((err
# 0) OR (num
= mno
), 100);
390 Log
.String("Parallel depth:"); Log
.Ln
;
391 FOR i
:= 0 TO mno
- 1 DO
392 Log
.String(" " + cmpList
[i
].name
); Log
.Int(cmpList
[i
].depth
); Log
.Ln
;
397 PROCEDURE IsCompiled (m
: Module
): BOOLEAN;
398 CONST target
= {hasSym
, hasObj
};
399 VAR i
: INTEGER; ready
: BOOLEAN;
403 ready
:= ~
(hasErrors
IN m
.flags
) & (m
.flags
* target
= target
);
404 WHILE ready
& (i
< m
.mno
) DO
405 ready
:= IsCompiled(m
.imp
[i
]);
411 PROCEDURE Ready (m
: Module
): BOOLEAN;
412 CONST target
= {hasSym
, hasObj
};
413 VAR i
: INTEGER; ready
: BOOLEAN;
416 ready
:= ~
(hasErrors
IN m
.flags
) & (m
.flags
* target
# target
) & (m
.worker
= NIL);
417 WHILE ready
& (i
< m
.mno
) DO
418 ready
:= IsCompiled(m
.imp
[i
]);
424 PROCEDURE ExecuteCompiler (m
: Module
): DswProcs
.Process
;
425 VAR w
: DswProcs
.Process
; ok
: BOOLEAN;
428 ASSERT(m
.path
# "", 21);
429 ASSERT(m
.worker
= NIL, 22);
430 w
:= DswProcs
.dir
.New();
432 w
.PutParam("-legacy");
436 Log
.String("Compile " + m
.name
+ " (" + m
.path
+ ")"); Log
.Ln
;
444 VAR i
, j
, num
: INTEGER; ok
: BOOLEAN; m
: Module
; w
: DswProcs
.Process
;
446 IF mno
= 0 THEN RETURN END;
448 WHILE (err
= 0) & (num
< mno
) OR (j
> 0) DO
450 WHILE (err
= 0) & (i
< mno
) & (j
< jobs
) DO
453 w
:= ExecuteCompiler(m
);
454 IF debugJobs
THEN Log
.String("Start job " + m
.name
) END;
456 IF debugJobs
THEN Log
.String(" ok") END;
460 IF debugJobs
THEN Log
.String(" fail") END;
461 INCL(m
.flags
, hasErrors
);
464 IF debugJobs
THEN Log
.Ln
END
468 WHILE (err
= 0) & (j
>= jobs
) OR (j
> 0) DO
470 WHILE (j
> 0) & (i
< mno
) DO
473 IF (w
# NIL) & w
.IsTerminated() THEN
474 IF debugJobs
THEN Log
.String("Stop job " + m
.name
); Log
.Int(w
.Result()); Log
.Ln
END;
475 IF w
.Result() = 0 THEN
476 INCL(m
.flags
, hasObj
);
477 INCL(m
.flags
, hasSym
);
480 INCL(m
.flags
, hasErrors
);
493 VAR p
: DswProcs
.Process
; i
: INTEGER; ok
: BOOLEAN;
495 ASSERT(exe
# NIL, 20);
496 ASSERT(exe^
# "", 21);
497 p
:= DswProcs
.dir
.New();
501 p
.PutParam("-kernel");
502 p
.PutParam("Kernel");
504 p
.PutParam("Kernel");
505 p
.PutParam("-legacycodedir");
511 IF ~
(library
IN lnkList
[i
].flags
) THEN
512 p
.PutParam(lnkList
[i
].name$
)
520 Log
.String("linker terminated with error"); Log
.Int(i
); Log
.Ln
;
524 Log
.String("unable to execute linker"); Log
.Int(i
); Log
.Ln
;
530 VAR m
: Module
; s
: Selector
; p
: DswProcs
.Process
; ok
: BOOLEAN; i
, res
: INTEGER;
532 IF Kernel
.trapCount
# 0 THEN Kernel
.Quit(1) END;
539 IF exe
# NIL THEN Link
END;
543 IF err
= 0 THEN Kernel
.Quit(0)
553 ==============================
556 cpmake
{options module
}
559 -a Enable automatic dependency resolution
560 -o name Generate executable file
561 -j num Specifies the number of jobs to run simultaneously
562 -D ident
["+"|
"-"] Add preprocessor selector
563 -U ident Remove proprocessor selector