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;
33 String
= POINTER TO ARRAY OF CHAR;
35 Selector
= POINTER TO RECORD
41 Module
= POINTER TO RECORD
44 selectors
: Selector
; (* with head, list of selectors for this module *)
46 imp
: ARRAY maxImps
OF Module
;
48 worker
: DswProcs
.Process
;
53 mno
, rno
: INTEGER; (* num modules *)
54 modList
, lnkList
, cmpList
: ARRAY maxImps
OF Module
;
55 def
: Selector
; (* with head, global list of selectors *)
60 PROCEDURE IdentLen (IN s
: ARRAY OF CHAR): INTEGER;
64 IF Strings
.IsIdentStart(s
[0]) THEN
65 REPEAT INC(i
) UNTIL ~Strings
.IsIdent(s
[i
])
70 PROCEDURE Define (n
: ARRAY OF CHAR);
71 VAR i
: INTEGER; v
: BOOLEAN; s
: Selector
;
75 IF ~
((n
[i
] = 0X
) OR (((n
[i
] = "+") OR (n
[i
] = "-")) & (n
[i
+ 1] = 0X
))) THEN
76 Log
.String("option -D expect + or - after identifier"); Log
.Ln
; INC(err
)
78 v
:= n
[i
] # "-"; n
[i
] := 0X
; s
:= def
;
79 WHILE (s
.next
# NIL) & (s
.next
.name$
# n$
) DO s
:= s
.next
END;
82 Strings
.StringToUtf8(n
, s
.next
.name
, i
);
87 Log
.String("option -D expect identifier"); Log
.Ln
; INC(err
)
91 PROCEDURE Undefine (IN n
: ARRAY OF CHAR);
92 VAR i
: INTEGER; s
: Selector
;
95 IF (i
# 0) & (n
[i
] = 0X
) THEN
97 WHILE (s
.next
# NIL) & (s
.next
.name$
# n$
) DO s
:= s
.next
END;
98 IF s
.next
# NIL THEN s
.next
:= s
.next
.next
END
100 Log
.String("option -U expect identifier"); Log
.Ln
; INC(err
)
104 PROCEDURE CopySelectorList (base
: Selector
): Selector
;
105 VAR s
, t
, x
: Selector
;
107 ASSERT(base
# NIL, 20);
108 s
:= base
; NEW(t
); x
:= t
;
111 IF s
.next
# NIL THEN NEW(x
.next
); x
:= x
.next
END;
115 END CopySelectorList
;
117 PROCEDURE AddModule (IN n
: ARRAY OF CHAR; selectors
: Selector
);
118 VAR i
, res
: INTEGER; m
: Module
;
121 IF (i
# 0) & (n
[i
] = 0X
) THEN
123 WHILE (i
< mno
) & (modList
[i
].name$
# n$
) DO INC(i
) END;
126 Strings
.StringToUtf8(n
, m
.name
, res
);
128 m
.selectors
:= CopySelectorList(selectors
);
133 Log
.String("module name must be identifier"); Log
.Ln
; INC(err
)
137 PROCEDURE StrToInt (IN s
: ARRAY OF CHAR; def
: INTEGER): INTEGER;
140 Strings
.StringToInt(s
, x
, res
);
142 Log
.String("expected integer"); Log
.Ln
; INC(err
);
153 CASE DswOpts
.GetOpt("ao:j:D:U:") OF
155 |
"o": exe
:= DswOpts
.str
156 |
"j": IF DswOpts
.str
= NIL THEN jobs
:= maxJobs
ELSE jobs
:= MIN(MAX(StrToInt(DswOpts
.str
, 0), 1), maxJobs
) END
157 |
"D": Define(DswOpts
.str
)
158 |
"U": Undefine(DswOpts
.str
)
159 |
":": Log
.String("missing argument for option -"); Log
.String(DswOpts
.str
); Log
.Ln
; INC(err
)
160 |
"?": Log
.String("unknown option -"); Log
.String(DswOpts
.str
); Log
.Ln
; INC(err
)
161 |
"$": AddModule(DswOpts
.str
, def
)
167 PROCEDURE Import (m
: Module
; IN name
: DevCPT
.Name
);
168 VAR i
, j
: INTEGER; imp
: Module
;
171 ASSERT(name
# "", 21);
172 IF debugImport
THEN Log
.String(" import "); Log
.String(name$
) END;
173 IF name
= "SYSTEM" THEN INCL(DevCPM
.options
, DevCPM
.sysImp
)
174 ELSIF name
= "COM" THEN INCL(DevCPM
.options
, DevCPM
.com
)
175 ELSIF name
= "JAVA" THEN INCL(DevCPM
.options
, DevCPM
.java
)
177 IF debugImport
THEN Log
.Char(" ") END;
178 i
:= 0; (* find module in local list *)
179 WHILE (i
< m
.mno
) & (m
.imp
[i
].name$
# name$
) DO INC(i
) END;
181 j
:= 0; (* find module in global list *)
182 WHILE (j
< mno
) & (modList
[j
].name$
# name$
) DO INC(j
) END;
184 NEW(imp
); imp
.name
:= name$
; imp
.selectors
:= CopySelectorList(m
.selectors
);
185 modList
[mno
] := imp
; INC(mno
)
189 m
.imp
[m
.mno
] := imp
; INC(m
.mno
)
193 IF debugImport
THEN Log
.Ln
END;
196 PROCEDURE ParseModule (m
: Module
);
197 VAR sym
: BYTE; SelfName
, impName
, aliasName
: DevCPT
.Name
;
199 PROCEDURE err (n
: SHORTINT);
203 PROCEDURE CheckSym(s
: SHORTINT);
205 IF sym
= s
THEN DevCPS
.Get(sym
) ELSE DevCPM
.err(s
) END
209 IF debugImport
THEN Log
.String("module " + m
.name
); Log
.Ln
END;
210 DevCPS
.Init
; DevCPS
.Get(sym
);
211 IF sym
= module
THEN DevCPS
.Get(sym
) ELSE err(16) END;
213 SelfName
:= DevCPS
.name$
; DevCPS
.Get(sym
);
215 INCL(DevCPM
.options
, DevCPM
.interface
); DevCPS
.Get(sym
);
216 IF sym
= eql
THEN DevCPS
.Get(sym
)
217 ELSE INCL(DevCPM
.options
, DevCPM
.noCode
)
219 IF sym
= string
THEN INCL(m
.flags
, library
); DevCPS
.Get(sym
)
225 IF sym
= import
THEN DevCPS
.Get(sym
);
228 aliasName
:= DevCPS
.name$
; impName
:= aliasName$
; DevCPS
.Get(sym
);
229 IF sym
= becomes
THEN DevCPS
.Get(sym
);
230 IF sym
= ident
THEN impName
:= DevCPS
.name$
; DevCPS
.Get(sym
) ELSE err(ident
) END
235 IF sym
= comma
THEN DevCPS
.Get(sym
)
236 ELSIF sym
= ident
THEN err(comma
)
247 PROCEDURE CheckModule (m
: Module
; source
: String
; OUT ok
: BOOLEAN);
252 DevCPM.symList := m.insym;
253 DevCPM.codePath := m.outcode;
254 DevCPM.symPath := m.outsym;
256 DevCPM
.name
:= m
.name$
;
258 IF m.found THEN INCL(DevCPM.options, DevCPM.comAware) END;
259 IF errorTrap IN m.opts THEN INCL(DevCPM.options, DevCPM.trap) END;
260 IF oberon IN m.opts THEN INCL(DevCPM.options, DevCPM.oberon) END;
263 s
:= m
.selectors
.next
;
265 DevCPR
.Set(s
.name
, s
.value
);
277 PROCEDURE GetSource (IN modName
: ARRAY OF CHAR; OUT path
: Files
.Name
; OUT s
: String
);
278 CONST modDir
= "Mod"; sysDir
= "System";
279 VAR dir
, name
: Files
.Name
; loc
: Files
.Locator
;
280 text
: DswDocuments
.Model
; r
: DswDocuments
.Reader
; i
, res
: INTEGER;
282 PROCEDURE MakePath (dir
, name
: Files
.Name
; type
: Files
.Type
; OUT path
: Files
.Name
);
284 ASSERT(name
# "", 21);
285 IF dir
= "" THEN path
:= modDir
+ "/" + name
286 ELSE path
:= dir
+ "/" + modDir
+ "/" + name
288 Kernel
.MakeFileName(path
, type
)
292 s
:= NIL; path
:= "";
293 Kernel
.SplitName(modName
, dir
, name
);
294 loc
:= Files
.dir
.This(dir
).This(modDir
);
295 (* --> Kernel.MakeFileName(name, Kernel.docType); <-- *)
296 MakePath(dir
, name
, "cp", path
);
297 DswDocuments
.Open(loc
, name
+ ".cp", text
, res
);
299 MakePath(dir
, name
, "odc", path
);
300 DswDocuments
.Open(loc
, name
+ ".odc", text
, res
);
301 IF (text
= NIL) & (dir
= "") THEN
302 MakePath(sysDir
, name
, "cp", path
);
303 loc
:= Files
.dir
.This(sysDir
).This(modDir
);
304 DswDocuments
.Open(loc
, name
+ ".cp", text
, res
);
306 MakePath(sysDir
, name
, "odc", path
);
307 DswDocuments
.Open(loc
, name
+ ".odc", text
, res
);
315 NEW(s
, text
.Length() + 1);
317 r
:= text
.NewReader(NIL);
318 FOR i
:= 0 TO text
.Length() - 1 DO
319 r
.Read
; s
[i
] := r
.char
325 PROCEDURE Trace (m
, parent
: Module
; depth
: INTEGER; VAR lno
: INTEGER);
328 m
.depth
:= MAX(m
.depth
, depth
);
329 IF ~
(trace
IN m
.flags
) THEN
330 INCL(m
.flags
, trace
);
332 FOR i
:= 0 TO m
.mno
- 1 DO
333 Trace(m
.imp
[i
], m
, depth
+ 1, lno
)
336 IF ~
(imported
IN m
.flags
) THEN
337 INCL(m
.flags
, imported
);
343 Log
.String("recursive import of " + m
.name
+ " in " + parent
.name
); Log
.Ln
; INC(err
)
348 VAR i
, j
: INTEGER; m
: Module
;
350 ASSERT((mno
= 0) OR (lnkList
[0] # NIL), 20);
356 WHILE (j
>= 0) & (cmpList
[j
].depth
< m
.depth
) DO
357 cmpList
[j
+ 1] := cmpList
[j
];
366 VAR i
, j
, num
: INTEGER; m
: Module
; s
: String
; ok
: BOOLEAN;
369 WHILE (err
= 0) & (i
< mno
) DO
371 GetSource(m
.name$
, m
.path
, s
);
373 CheckModule(m
, s
, ok
);
374 IF ~ok
THEN INC(err
) END
376 Log
.String("unable to open module " + m
.name
); Log
.Ln
; INC(err
)
381 FOR i
:= 0 TO rno
- 1 DO
382 Trace(modList
[i
], modList
[i
], 0, num
);
384 ASSERT((err
# 0) OR (num
= mno
), 100);
388 PROCEDURE IsCompiled (m
: Module
): BOOLEAN;
389 CONST target
= {hasSym
, hasObj
};
390 VAR i
: INTEGER; ready
: BOOLEAN;
394 ready
:= ~
(hasErrors
IN m
.flags
) & (m
.flags
* target
= target
);
395 WHILE ready
& (i
< m
.mno
) DO
396 ready
:= IsCompiled(m
.imp
[i
]);
402 PROCEDURE Ready (m
: Module
): BOOLEAN;
403 CONST target
= {hasSym
, hasObj
};
404 VAR i
: INTEGER; ready
: BOOLEAN;
407 ready
:= ~
(hasErrors
IN m
.flags
) & (m
.flags
* target
# target
) & (m
.worker
= NIL);
408 WHILE ready
& (i
< m
.mno
) DO
409 ready
:= IsCompiled(m
.imp
[i
]);
415 PROCEDURE ExecuteCompiler (m
: Module
): DswProcs
.Process
;
416 VAR w
: DswProcs
.Process
; ok
: BOOLEAN;
419 ASSERT(m
.path
# "", 21);
420 ASSERT(m
.worker
= NIL, 22);
421 w
:= DswProcs
.dir
.New();
423 w
.PutParam("-legacy");
427 Log
.String("Compile " + m
.name
+ " (" + m
.path
+ ")"); Log
.Ln
;
435 VAR i
, j
, num
: INTEGER; ok
: BOOLEAN; m
: Module
; w
: DswProcs
.Process
;
437 IF mno
= 0 THEN RETURN END;
439 WHILE (err
= 0) & (num
< mno
) OR (j
> 0) DO
441 WHILE (err
= 0) & (i
< mno
) & (j
< jobs
) DO
444 w
:= ExecuteCompiler(m
);
445 IF debugJobs
THEN Log
.String("Start job " + m
.name
) END;
447 IF debugJobs
THEN Log
.String(" ok") END;
451 IF debugJobs
THEN Log
.String(" fail") END;
452 INCL(m
.flags
, hasErrors
);
455 IF debugJobs
THEN Log
.Ln
END
459 WHILE (err
= 0) & (j
>= jobs
) OR (j
> 0) DO
461 WHILE (j
> 0) & (i
< mno
) DO
464 IF (w
# NIL) & w
.IsTerminated() THEN
465 IF debugJobs
THEN Log
.String("Stop job " + m
.name
); Log
.Int(w
.Result()); Log
.Ln
END;
466 IF w
.Result() = 0 THEN
467 INCL(m
.flags
, hasObj
);
468 INCL(m
.flags
, hasSym
);
471 INCL(m
.flags
, hasErrors
);
484 VAR p
: DswProcs
.Process
; i
: INTEGER; ok
: BOOLEAN;
486 ASSERT(exe
# NIL, 20);
487 ASSERT(exe^
# "", 21);
488 p
:= DswProcs
.dir
.New();
492 p
.PutParam("-kernel");
493 p
.PutParam("Kernel");
495 p
.PutParam("Kernel");
496 p
.PutParam("-legacycodedir");
502 IF ~
(library
IN lnkList
[i
].flags
) THEN
503 p
.PutParam(lnkList
[i
].name$
)
511 Log
.String("linker terminated with error"); Log
.Int(i
); Log
.Ln
;
515 Log
.String("unable to execute linker"); Log
.Int(i
); Log
.Ln
;
520 PROCEDURE WriteSelector (s
: Selector
);
523 IF s
.value
THEN Log
.Char("+") ELSE Log
.Char("-") END
527 VAR m
: Module
; s
: Selector
; p
: DswProcs
.Process
; ok
: BOOLEAN; i
, res
: INTEGER;
529 IF Kernel
.trapCount
# 0 THEN Kernel
.Quit(1) END;
536 IF exe
# NIL THEN Link
END;
541 Log
.String("no errors"); Log
.Ln
;
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