3 IMPORT SYSTEM
, Kernel
, Files
, Console
, Strings
;
6 ProcSize
* = 4; (* PROCEDURE type *)
7 PointerSize
* = 4; (* POINTER type *)
8 DArrSizeA
* = 8; (* dyn array descriptor *)
9 DArrSizeB
* = 4; (* size = A + B * typ.n *)
12 MaxIndex
* = 7FFFFFFFH
; (* maximal index value for array declaration *)
14 MinReal32Pat
= 0FF7FFFFFH
; (* most positive, 32-bit pattern *)
15 MinReal64PatL
= 0FFFFFFFFH
; (* most negative, lower 32-bit pattern *)
16 MinReal64PatH
= 0FFEFFFFFH
; (* most negative, higher 32-bit pattern *)
17 MaxReal32Pat
= 07F7FFFFFH
; (* most positive, 32-bit pattern *)
18 MaxReal64PatL
= 0FFFFFFFFH
; (* most positive, lower 32-bit pattern *)
19 MaxReal64PatH
= 07FEFFFFFH
; (* most positive, higher 32-bit pattern *)
20 InfRealPat
= 07F800000H
; (* real infinity pattern *)
23 (* inclusive range of parameter of standard procedure HALT *)
27 (* inclusive range of register number of procedures SYSTEM.GETREG and SYSTEM.PUTREG *)
31 (* maximal value of flag used to mark interface structures *)
32 MaxSysFlag
* = 127; (* shortint *)
33 CProcFlag
* = 1; (* code procedures *)
35 (* maximal condition value of parameter of SYSTEM.CC *)
38 (* initialization of constant address, must be different from any valid constant address *)
41 (* whether hidden pointer fields have to be nevertheless exported *)
45 (* whether hidden untagged pointer fields have to be nevertheless exported *)
46 ExpHdUtPtrFld
* = TRUE
;
47 HdUtPtrName
* = "@utptr";
49 (* whether hidden procedure fields have to be nevertheless exported (may be used for System.Free) *)
51 HdProcName
* = "@proc";
53 (* whether hidden bound procedures have to be nevertheless exported *)
55 HdTProcName
* = "@tproc";
57 (* maximal number of exported stuctures: *)
58 MaxStruct
* = 16000; (* must be < MAX(INTEGER) DIV 2 in object model *)
60 (* maximal number of record extensions: *)
61 MaxExts
* = 15; (* defined by type descriptor layout *)
63 (* whether field leaf of pointer variable p has to be set to FALSE, when NEW(p) or SYSTEM.NEW(p, n) is used *)
66 (* special character (< " ") returned by procedure Get, if end of text reached *)
70 longreal
* = 0; largeint
* = 1; realConst
* = 2; copy
* = 3; lchr
* = 4; lentier
* = 5; invar
* = 6; outvar
* = 7;
72 (* language options *)
74 com
* = 2; comAware
* = 3;
75 som
* = 4; somAware
* = 5;
77 java
* = 7; javaAware
* = 8;
82 sys386
= 10; sys68k
= 20; (* processor type in options if system imported *)
88 SFtag
= 6F4F5346H
; (* symbol file tag *)
89 OFtag
= 6F4F4346H
; (* object file tag *)
94 Directory
* = POINTER TO RECORD
101 LEHost
*: BOOLEAN; (* little or big endian host *)
102 MinReal32
*, MaxReal32
*, InfReal
*,
103 MinReal64
*, MaxReal64
*: REAL;
104 noerr
*: BOOLEAN; (* no error found until now *)
105 curpos
*, startpos
*, errpos
*: INTEGER; (* character, start, and error position in source file *)
106 searchpos
*: INTEGER; (* search position in source file *)
108 breakpc
*: INTEGER; (* set by OPV.Init *)
109 options
*: SET; (* language options *)
110 file
*: Files
.File
; (* used for sym file import *)
111 legacy
*: BOOLEAN; (* use BlackBox subsystems *)
113 codePath
*: Files
.Name
;
114 symPath
*: Files
.Name
;
115 codeDir
*: ARRAY 16 OF CHAR;
116 symDir
*: ARRAY 16 OF CHAR;
117 name
*: Files
.Name
; (* source name *)
118 checksum
*: INTEGER; (* symbol file checksum *)
122 ObjFName
: Files
.Name
;
124 in
: POINTER TO ARRAY OF CHAR;
125 oldSymFile
, symFile
, objFile
: Files
.File
;
127 outSym
, outObj
: Files
.Writer
;
129 errNo
, errPos
: ARRAY maxErrors
OF INTEGER;
131 crc32tab
: ARRAY 256 OF INTEGER;
134 PROCEDURE^ err
* (n
: INTEGER);
136 PROCEDURE Init
* (source
: POINTER TO ARRAY OF CHAR);
139 noerr
:= TRUE
; options
:= {};
140 curpos
:= 0; errpos
:= curpos
; lastpos
:= curpos
- 11; errors
:= 0;
141 codePath
:= ""; symPath
:= ""; name
:= "";
142 codeDir
:= OFdir
; symDir
:= SFdir
;
147 oldSymFile
:= NIL; inSym
:= NIL;
148 symFile
:= NIL; outSym
:= NIL;
149 objFile
:= NIL; outObj
:= NIL;
153 PROCEDURE Get
* (VAR ch
: CHAR);
155 ch
:= in
[curpos
]; INC(curpos
)
158 PROCEDURE LineColOf (pos
: INTEGER; OUT line
, col
, beg
, end
: INTEGER);
161 i
:= 0; line
:= 1; col
:= 1; beg
:= 0; end
:= 0;
171 ELSIF in
[i
] = 0AX
THEN
176 ELSIF in
[i
] = 09X
THEN
182 WHILE (in
[i
] # 0DX
) & (in
[i
] # 0AX
) & (in
[i
] # 0X
) DO
188 PROCEDURE LineOf
* (pos
: INTEGER): INTEGER;
189 VAR line
, col
, beg
, end
: INTEGER;
191 LineColOf(pos
, line
, col
, beg
, end
);
195 PROCEDURE LoWord (r
: REAL): INTEGER;
199 IF ~LEHost
THEN INC(x
, 4) END;
204 PROCEDURE HiWord (r
: REAL): INTEGER;
208 IF LEHost
THEN INC(x
, 4) END;
213 PROCEDURE Compound (lo
, hi
: INTEGER): REAL;
217 SYSTEM
.PUT(SYSTEM
.ADR(r
), lo
); SYSTEM
.PUT(SYSTEM
.ADR(r
) + 4, hi
)
219 SYSTEM
.PUT(SYSTEM
.ADR(r
) + 4, lo
); SYSTEM
.PUT(SYSTEM
.ADR(r
), hi
)
225 (* sysflag control *)
227 PROCEDURE ValidGuid
* (IN str
: ARRAY OF SHORTCHAR
): BOOLEAN;
228 VAR i
: INTEGER; ch
: SHORTCHAR
;
230 IF (LEN(str$
) # 38) OR (str
[0] # "{") & (str
[37] # "}") THEN RETURN FALSE
END;
234 IF (i
= 9) OR (i
= 14) OR (i
= 19) OR (i
= 24) THEN
235 IF ch
# "-" THEN RETURN FALSE
END
237 IF (ch
< "0") OR (ch
> "9") & (CAP(ch
) < "A") OR (CAP(ch
) > "Z") THEN RETURN FALSE
END
244 PROCEDURE GetProcSysFlag
* (IN id
: ARRAY OF SHORTCHAR
; num
: SHORTINT; VAR flag
: SHORTINT);
247 IF id
= "code" THEN num
:= 1
248 ELSIF id
= "callback" THEN num
:= 2
249 ELSIF id
= "nostkchk" THEN num
:= 4
250 ELSIF id
= "ccall" THEN num
:= -10
251 ELSIF id
= "ccall16" THEN num
:= -12
252 ELSIF id
= "guarded" THEN num
:= 8
253 ELSIF id
= "noframe" THEN num
:= 16
254 ELSIF id
= "native" THEN num
:= -33
255 ELSIF id
= "bytecode" THEN num
:= -35
258 IF (options
* {sysImp
, sys386
, sys68k
} # {}) & ((num
= 1) OR (num
= 2)) THEN INC(flag
, num
)
259 ELSIF (sys68k
IN options
) & (num
= 4) THEN INC(flag
, num
)
260 ELSIF (options
* {sys386
, interface
} # {}) & (num
= -10) & (flag
= 0) THEN flag
:= -10
261 ELSIF (options
* {sys386
, interface
} # {}) & (num
= -12) & (flag
= 0) THEN flag
:= -12
262 ELSIF (options
* {sys386
, com
} # {}) & (num
= 8) & (flag
= 0) THEN flag
:= 8
263 ELSIF (options
* {sysImp
, sys386
} # {}) & (num
= 16) & (flag
= 0) THEN flag
:= 16
264 ELSIF ({sysImp
, java
} - options
= {}) & ((num
= -33) OR (num
= -35)) & (flag
= 0) THEN flag
:= num
265 ELSE err(225); flag
:= 0
269 PROCEDURE GetVarParSysFlag
* (IN id
: ARRAY OF SHORTCHAR
; num
: SHORTINT; VAR flag
: SHORTINT);
272 old
:= flag
; flag
:= 0;
273 IF (options
* {sys386
, sys68k
, interface
, com
} # {}) THEN
274 IF (num
= 1) OR (id
= "nil") THEN
275 IF ~
ODD(old
) THEN flag
:= SHORT(old
+ 1) END
276 ELSIF ((num
= 2) OR (id
= "in")) & (oberon
IN options
) THEN
277 IF old
<= 1 THEN flag
:= SHORT(old
+ 2) END
278 ELSIF ((num
= 4) OR (id
= "out")) & (oberon
IN options
) THEN
279 IF old
<= 1 THEN flag
:= SHORT(old
+ 4) END
280 ELSIF ((num
= 8) OR (id
= "new")) & (options
* {com
, interface
} # {}) THEN
281 IF old
<= 1 THEN flag
:= SHORT(old
+ 8) END
282 ELSIF ((num
= 16) OR (id
= "iid")) & (com
IN options
) THEN
283 IF old
<= 1 THEN flag
:= SHORT(old
+ 16) END
286 IF flag
= 0 THEN err(225) END
287 END GetVarParSysFlag
;
289 PROCEDURE GetRecordSysFlag
* (IN id
: ARRAY OF SHORTCHAR
; num
: SHORTINT; VAR flag
: SHORTINT);
292 old
:= flag
; flag
:= 0;
293 IF (num
= 1) OR (id
= "untagged") THEN
294 IF (options
* {sysImp
, sys386
, sys68k
, interface
, com
, som
} # {}) & (old
= 0) THEN flag
:= 1 END
295 ELSIF (num
= 3) OR (id
= "noalign") THEN
296 IF (options
* {sys386
, sys68k
, interface
, com
, som
} # {}) & (old
= 0) THEN flag
:= 3 END
297 ELSIF (num
= 4) OR (id
= "align2") THEN
298 IF (options
* {sys386
, interface
, com
} # {}) & (old
= 0) THEN flag
:= 4 END
299 ELSIF (num
= 5) OR (id
= "align4") THEN
300 IF (options
* {sys386
, interface
, com
} # {}) & (old
= 0) THEN flag
:= 5 END
301 ELSIF (num
= 6) OR (id
= "align8") THEN
302 IF (options
* {sys386
, interface
, com
} # {}) & (old
= 0) THEN flag
:= 6 END
303 ELSIF (num
= 7) OR (id
= "union") THEN
304 IF (options
* {sys386
, sys68k
, interface
, com
} # {}) & (old
= 0) THEN flag
:= 7 END
305 ELSIF (num
= 10) OR (id
= "interface") OR ValidGuid(id
) THEN
306 IF (com
IN options
) & (old
= 0) THEN flag
:= 10 END
307 ELSIF (num
= -11) OR (id
= "jint") THEN
308 IF (java
IN options
) & (old
= 0) THEN flag
:= -11 END
309 ELSIF (num
= -13) OR (id
= "jstr") THEN
310 IF (java
IN options
) & (old
= 0) THEN flag
:= -13 END
311 ELSIF (num
= 20) OR (id
= "som") THEN
312 IF (som
IN options
) & (old
= 0) THEN flag
:= 20 END
314 IF flag
= 0 THEN err(225) END
315 END GetRecordSysFlag
;
317 PROCEDURE GetArraySysFlag
* (IN id
: ARRAY OF SHORTCHAR
; num
: SHORTINT; VAR flag
: SHORTINT);
320 old
:= flag
; flag
:= 0;
321 IF (num
= 1) OR (id
= "untagged") THEN
322 IF (options
* {sysImp
, sys386
, sys68k
, interface
, com
, som
} # {}) & (old
= 0) THEN flag
:= 1 END
323 ELSIF (num
= -12) OR (id
= "jarr") THEN
324 IF (java
IN options
) & (old
= 0) THEN flag
:= -12 END
325 ELSIF (num
= -13) OR (id
= "jstr") THEN
326 IF (java
IN options
) & (old
= 0) THEN flag
:= -13 END
328 IF flag
= 0 THEN err(225) END
331 PROCEDURE GetPointerSysFlag
* (IN id
: ARRAY OF SHORTCHAR
; num
: SHORTINT; VAR flag
: SHORTINT);
334 old
:= flag
; flag
:= 0;
335 IF (num
= 1) OR (id
= "untagged") THEN
336 IF (options
* {sys386
, sys68k
, interface
, com
, som
} # {}) & (old
= 0) THEN flag
:= 1 END
337 ELSIF (num
= 2) OR (id
= "handle") THEN
338 IF (sys68k
IN options
) & (old
= 0) THEN flag
:= 2 END
339 ELSIF (num
= 10) OR (id
= "interface") THEN
340 IF (com
IN options
) & (old
= 0) THEN flag
:= 10 END
341 ELSIF (num
= 20) OR (id
= "som") THEN
342 IF (som
IN options
) & (old
= 0) THEN flag
:= 20 END
344 IF flag
= 0 THEN err(225) END
345 END GetPointerSysFlag
;
347 PROCEDURE GetProcTypSysFlag
* (IN id
: ARRAY OF SHORTCHAR
; num
: SHORTINT; VAR flag
: SHORTINT);
349 IF ((num
= -10) OR (id
= "ccall")) & (options
* {sys386
, interface
} # {}) THEN flag
:= -10
350 ELSIF ((num
= -12) OR (id
= "ccall16")) & (options
* {sys386
, interface
} # {}) THEN flag
:= -12
351 ELSE err(225); flag
:= 0
353 END GetProcTypSysFlag
;
355 PROCEDURE PropagateRecordSysFlag
* (baseFlag
: SHORTINT; VAR flag
: SHORTINT);
357 IF (baseFlag
= 1) OR (baseFlag
>= 3) & (baseFlag
<= 7) THEN (* propagate untagged .. union *)
358 IF flag
= 0 THEN flag
:= baseFlag
359 ELSIF (flag
= 6) & (baseFlag
< 6) THEN (* OK *) (* special case for 8 byte aligned records *)
360 ELSIF flag
# baseFlag
THEN err(225); flag
:= 0
362 ELSIF (baseFlag
# 10) & (flag
= 10) THEN err(225)
364 END PropagateRecordSysFlag
;
366 PROCEDURE PropagateRecPtrSysFlag
* (baseFlag
: SHORTINT; VAR flag
: SHORTINT);
368 IF (baseFlag
= 1) OR (baseFlag
>= 3) & (baseFlag
<= 7) THEN (* pointer to untagged .. union is untagged *)
369 IF flag
= 0 THEN flag
:= 1
370 ELSIF (flag
# 1) & (flag
# 2) THEN err(225); flag
:= 0
372 ELSIF baseFlag
= 10 THEN (* pointer to interface is interface *)
373 IF flag
= 0 THEN flag
:= 10
374 ELSIF flag
# 10 THEN err(225); flag
:= 0
376 ELSIF baseFlag
= -11 THEN (* pointer to java interface is java interface *)
377 IF flag
# 0 THEN err(225) END;
379 ELSIF baseFlag
= -13 THEN (* pointer to java string is java string *)
380 IF flag
# 0 THEN err(225) END;
383 END PropagateRecPtrSysFlag
;
385 PROCEDURE PropagateArrPtrSysFlag
* (baseFlag
: SHORTINT; VAR flag
: SHORTINT);
387 IF baseFlag
= 1 THEN (* pointer to untagged or guid is untagged *)
388 IF flag
= 0 THEN flag
:= 1
389 ELSIF (flag
# 1) & (flag
# 2) THEN err(225); flag
:= 0
391 ELSIF baseFlag
= -12 THEN (* pointer to java array is java array *)
392 IF flag
# 0 THEN err(225) END;
394 ELSIF baseFlag
= -13 THEN (* pointer to java string is java string *)
395 IF flag
# 0 THEN err(225) END;
398 END PropagateArrPtrSysFlag
;
403 PROCEDURE PutUtf8
* (VAR str
: ARRAY OF SHORTCHAR
; val
: INTEGER; VAR idx
: INTEGER);
405 ASSERT((val
>= 0) & (val
< 65536));
407 str
[idx
] := SHORT(CHR(val
)); INC(idx
)
408 ELSIF val
< 2048 THEN
409 str
[idx
] := SHORT(CHR(val
DIV 64 + 192)); INC(idx
);
410 str
[idx
] := SHORT(CHR(val
MOD 64 + 128)); INC(idx
)
412 str
[idx
] := SHORT(CHR(val
DIV 4096 + 224)); INC(idx
);
413 str
[idx
] := SHORT(CHR(val
DIV 64 MOD 64 + 128)); INC(idx
);
414 str
[idx
] := SHORT(CHR(val
MOD 64 + 128)); INC(idx
)
418 PROCEDURE GetUtf8
* (IN str
: ARRAY OF SHORTCHAR
; VAR val
, idx
: INTEGER);
421 ch
:= str
[idx
]; INC(idx
);
425 val
:= ORD(ch
) - 192;
426 ch
:= str
[idx
]; INC(idx
); val
:= val
* 64 + ORD(ch
) - 128
428 val
:= ORD(ch
) - 224;
429 ch
:= str
[idx
]; INC(idx
); val
:= val
* 64 + ORD(ch
) - 128;
430 ch
:= str
[idx
]; INC(idx
); val
:= val
* 64 + ORD(ch
) - 128
437 PROCEDURE LogW
* (ch
: CHAR);
439 Console
.WriteChar(ch
)
442 PROCEDURE LogWStr
* (IN s
: ARRAY OF CHAR);
447 PROCEDURE LogWPar
* (IN key
: ARRAY OF CHAR; IN p0
, p1
: ARRAY OF SHORTCHAR
);
448 VAR s
, s0
, s1
: ARRAY 256 OF CHAR; i
, res
: INTEGER;
450 Kernel
.Utf8ToString(p0
, s0
, res
);
451 Kernel
.Utf8ToString(p1
, s1
, res
);
452 IF key
= "#Dev:NotImplementedIn" THEN s
:= "^0 not implemented in ^1"
453 ELSIF key
= "#Dev:NotImplemented" THEN s
:= "^0 not implemented"
454 ELSIF key
= "#Dev:InconsistentImport" THEN s
:= "^0.^1 is not consistently imported"
455 ELSIF key
= "#Dev:ChangedLibFlag" THEN s
:= "changed library flag"
456 ELSIF key
= "#Dev:IsNoLongerInSymFile" THEN s
:= "^0 is no longer in symbol file"
457 ELSIF key
= "#Dev:IsRedefinedInternally" THEN s
:= "^0 is redefined internally"
458 ELSIF key
= "#Dev:IsRedefined" THEN s
:= "^0 is redefined"
459 ELSIF key
= "#Dev:IsNewInSymFile" THEN s
:= "^0 is new in symbol file"
460 ELSIF key
= "#Dev:NewSymFile" THEN s
:= "new symbol file"
467 |
"0": Console
.WriteStr(s0
)
468 |
"1": Console
.WriteStr(s1
)
470 ELSE Console
.WriteChar("^")
474 Console
.WriteChar(s
[i
]);
480 PROCEDURE LogWNum
* (i
, len
: INTEGER);
481 VAR s
: ARRAY 32 OF CHAR;
483 Strings
.IntToStringForm(i
, 10, len
, " ", FALSE
, s
);
492 PROCEDURE Mark
* (n
, pos
: INTEGER);
494 IF (n
>= 0) & ~
((oberon
IN options
) & (n
>= 181) & (n
<= 190)) THEN
496 IF pos
< 0 THEN pos
:= 0 END;
497 IF (pos
< lastpos
) OR (lastpos
+ 9 < pos
) THEN
499 IF errors
< maxErrors
THEN
500 errNo
[errors
] := n
; errPos
[errors
] := pos
504 IF trap
IN options
THEN HALT(100) END;
505 ELSIF (n
<= -700) & (errors
< maxErrors
) THEN
506 errNo
[errors
] := n
; errPos
[errors
] := pos
; INC(errors
)
510 PROCEDURE err
* (n
: INTEGER);
515 PROCEDURE GetErrorMsg (err
: INTEGER; OUT msg
: ARRAY OF CHAR);
518 |
0: msg
:= 'undeclared identifier'
519 |
1: msg
:= 'multiply defined identifier'
520 |
2: msg
:= 'illegal character in number'
521 |
3: msg
:= 'illegal character in string'
522 |
4: msg
:= 'identifier does not match procedure name'
523 |
5: msg
:= 'comment not closed'
524 |
9: msg
:= '
"=" expected'
525 |
12: msg
:= 'type definition starts with incorrect symbol'
526 |
13: msg
:= 'factor starts with incorrect symbol'
527 |
14: msg
:= 'statement starts with incorrect symbol'
528 |
15: msg
:= 'declaration followed by incorrect symbol'
529 |
16: msg
:= '
MODULE expected'
530 |
19: msg
:= '
"." missing'
531 |
20: msg
:= '
"," missing'
532 |
21: msg
:= '
":" missing'
533 |
23: msg
:= '
")" missing'
534 |
24: msg
:= '
"]" missing'
535 |
25: msg
:= '
"}" missing'
536 |
26: msg
:= '
OF missing'
537 |
27: msg
:= '
THEN missing'
538 |
28: msg
:= '
DO missing'
539 |
29: msg
:= '
TO missing'
540 |
35: msg
:= '
"," or
OF expected'
541 |
36: msg
:= '
CONST, TYPE, VAR, PROCEDURE, BEGIN, or
END missing'
542 |
37: msg
:= '
PROCEDURE, BEGIN, or
END missing'
543 |
38: msg
:= '
BEGIN or
END missing'
544 |
40: msg
:= '
"(" missing'
545 |
41: msg
:= 'illegally marked identifier'
546 |
42: msg
:= 'constant not an integer'
547 |
43: msg
:= '
UNTIL missing'
548 |
44: msg
:= '
":=" missing'
549 |
46: msg
:= '
EXIT not within loop statement'
550 |
47: msg
:= 'string expected'
551 |
48: msg
:= 'identifier expected'
552 |
49: msg
:= '
";" missing'
553 |
50: msg
:= 'expression should be constant'
554 |
51: msg
:= '
END missing'
555 |
52: msg
:= 'identifier does not denote a type'
556 |
53: msg
:= 'identifier does not denote a record type'
557 |
54: msg
:= 'result type of procedure is not a basic type'
558 |
55: msg
:= 'procedure call of a function'
559 |
56: msg
:= 'assignment to non
-variable'
560 |
57: msg
:= 'pointer not bound to record or array type'
561 |
58: msg
:= 'recursive type definition'
562 |
59: msg
:= 'illegal open array parameter'
563 |
60: msg
:= 'wrong type of case label'
564 |
61: msg
:= 'inadmissible type of case label'
565 |
62: msg
:= 'case label defined more than once'
566 |
63: msg
:= 'illegal value of constant'
567 |
64: msg
:= 'more actual than formal parameters'
568 |
65: msg
:= 'fewer actual than formal parameters'
569 |
66: msg
:= 'element types of actual array and formal open array differ'
570 |
67: msg
:= 'actual parameter corresponding to open array is not an array'
571 |
68: msg
:= 'control variable must be integer'
572 |
69: msg
:= 'parameter must be an integer constant'
573 |
70: msg
:= 'pointer or
VAR / IN record required as formal receiver'
574 |
71: msg
:= 'pointer expected as actual receiver'
575 |
72: msg
:= 'procedure must be bound to a record of the same scope'
576 |
73: msg
:= 'procedure must have level
0'
577 |
74: msg
:= 'procedure unknown in base type'
578 |
75: msg
:= 'invalid call of base procedure'
579 |
76: msg
:= 'this
variable (field
) is read only'
580 |
77: msg
:= 'object is not a record'
581 |
78: msg
:= 'dereferenced object is not a variable'
582 |
79: msg
:= 'indexed object is not a variable'
583 |
80: msg
:= 'index expression is not an integer'
584 |
81: msg
:= 'index out of specified bounds'
585 |
82: msg
:= 'indexed variable is not an array'
586 |
83: msg
:= 'undefined record field'
587 |
84: msg
:= 'dereferenced variable is not a pointer'
588 |
85: msg
:= 'guard or test type is not an extension of variable type'
589 |
86: msg
:= 'guard or testtype is not a pointer'
590 |
87: msg
:= 'guarded or tested variable is neither a pointer nor a
VAR- or
IN-parameter record'
591 |
88: msg
:= 'open array not allowed as variable
, record field or array element'
592 |
89: msg
:= 'ANYRECORD may not be allocated'
593 |
90: msg
:= 'dereferenced variable is not a character array'
594 |
92: msg
:= 'operand of
IN not an integer
, or not a set'
595 |
93: msg
:= 'set element type is not an integer'
596 |
94: msg
:= 'operand of
& is not of type
BOOLEAN'
597 |
95: msg
:= 'operand of
OR is not of type
BOOLEAN'
598 |
96: msg
:= 'operand not applicable
to (unary
) +'
599 |
97: msg
:= 'operand not applicable
to (unary
) -'
600 |
98: msg
:= 'operand of ~ is not of type
BOOLEAN'
601 |
99: msg
:= 'ASSERT fault'
602 |
100: msg
:= 'incompatible operands of dyadic operator'
603 |
101: msg
:= 'operand type inapplicable to
*'
604 |
102: msg
:= 'operand type inapplicable to
/'
605 |
103: msg
:= 'operand type inapplicable to
DIV'
606 |
104: msg
:= 'operand type inapplicable to
MOD'
607 |
105: msg
:= 'operand type inapplicable to
+'
608 |
106: msg
:= 'operand type inapplicable to
-'
609 |
107: msg
:= 'operand type inapplicable to
= or
#'
610 |
108: msg
:= 'operand type inapplicable to relation'
611 |
109: msg
:= 'overriding method must be exported'
612 |
110: msg
:= 'operand is not a type'
613 |
111: msg
:= 'operand inapplicable
to (this
) function'
614 |
112: msg
:= 'operand is not a variable'
615 |
113: msg
:= 'incompatible assignment'
616 |
114: msg
:= 'string too long to be assigned'
617 |
115: msg
:= 'parameter does not match'
618 |
116: msg
:= 'number of parameters does not match'
619 |
117: msg
:= 'result type does not match'
620 |
118: msg
:= 'export mark does not match with forward declaration'
621 |
119: msg
:= 'redefinition textually precedes procedure bound to base type'
622 |
120: msg
:= 'type of expression following
IF, WHILE, UNTIL or ASSERT is not
BOOLEAN'
623 |
121: msg
:= 'called object is not a procedure'
624 |
122: msg
:= 'actual
VAR-, IN-, or OUT
-parameter is not a variable'
625 |
123: msg
:= 'type is not identical with that of formal
VAR-, IN-, or OUT
-parameter'
626 |
124: msg
:= 'type of result expression differs from that of procedure'
627 |
125: msg
:= 'type of case expression is neither
INTEGER nor
CHAR'
628 |
126: msg
:= 'this expression cannot be a type or a procedure'
629 |
127: msg
:= 'illegal use of object'
630 |
128: msg
:= 'unsatisfied forward reference'
631 |
129: msg
:= 'unsatisfied forward procedure'
632 |
130: msg
:= '
WITH clause does not specify a variable'
633 |
131: msg
:= '
LEN not applied to array'
634 |
132: msg
:= 'dimension in
LEN too large or negative'
635 |
133: msg
:= 'function without
RETURN'
636 |
135: msg
:= 'SYSTEM not imported'
637 |
136: msg
:= '
LEN applied to untagged array'
638 |
137: msg
:= 'unknown array length'
639 |
138: msg
:= '
NEW not allowed for untagged structures'
640 |
139: msg
:= 'Test applied to untagged record'
641 |
140: msg
:= 'untagged receiver'
642 |
141: msg
:= 'SYSTEM
.NEW not implemented'
643 |
142: msg
:= 'tagged structures not allowed for
NIL compatible var parameters'
644 |
143: msg
:= 'tagged pointer not allowed in untagged structure'
645 |
144: msg
:= 'no pointers allowed in BYTES argument'
646 |
145: msg
:= 'untagged open array not allowed as value parameter'
647 |
150: msg
:= 'key inconsistency of imported module'
648 |
151: msg
:= 'incorrect symbol file'
649 |
152: msg
:= 'symbol file of imported module not found'
650 |
153: msg
:= 'object or symbol file not
opened (disk full?
)'
651 |
154: msg
:= 'recursive import not allowed'
652 |
155: msg
:= 'generation of new symbol file not allowed'
653 |
160: msg
:= 'interfaces must be extensions of IUnknown'
654 |
161: msg
:= 'interfaces must not have fields'
655 |
162: msg
:= 'interface procedures must be abstract'
656 |
163: msg
:= 'interface records must be abstract'
657 |
164: msg
:= 'pointer must be extension of queried interface type'
658 |
165: msg
:= 'illegal guid constant'
659 |
166: msg
:= 'AddRef
& Release may not be used'
660 |
167: msg
:= 'illegal assignment to
[new
] parameter'
661 |
168: msg
:= 'wrong
[iid
] - [new
] pair'
662 |
169: msg
:= 'must be an interface pointer'
663 |
177: msg
:= '
IN only allowed for records and arrays'
664 |
178: msg
:= 'illegal attribute'
665 |
179: msg
:= 'abstract methods of exported records must be exported'
666 |
180: msg
:= 'illegal receiver type'
667 |
181: msg
:= 'base type is not extensible'
668 |
182: msg
:= 'base procedure is not extensible'
669 |
183: msg
:= 'non
-matching export'
670 |
184: msg
:= 'Attribute does not match with forward declaration'
671 |
185: msg
:= 'missing
NEW attribute'
672 |
186: msg
:= 'illegal
NEW attribute'
673 |
187: msg
:= 'new empty procedure in non extensible record'
674 |
188: msg
:= 'extensible procedure in non extensible record'
675 |
189: msg
:= 'illegal attribute change'
676 |
190: msg
:= 'record must be abstract'
677 |
191: msg
:= 'base type must be abstract'
678 |
192: msg
:= 'unimplemented abstract procedures in base types'
679 |
193: msg
:= 'abstract or limited records may not be allocated'
680 |
194: msg
:= 'no supercall allowed to abstract or empty procedures'
681 |
195: msg
:= 'empty procedures may not have out parameters or return a value'
682 |
196: msg
:= 'procedure is implement
-only exported'
683 |
197: msg
:= 'extension of limited type must be limited'
684 |
198: msg
:= 'obsolete oberon type'
685 |
199: msg
:= 'obsolete oberon function'
686 |
200: msg
:= 'not yet implemented'
687 |
201: msg
:= 'lower bound of set range greater than higher bound'
688 |
202: msg
:= 'set element greater than
MAX(SET) or less than
0'
689 |
203: msg
:= 'number too large'
690 |
204: msg
:= 'product too large'
691 |
205: msg
:= 'division by zero'
692 |
206: msg
:= 'sum too large'
693 |
207: msg
:= 'difference too large'
694 |
208: msg
:= 'overflow in arithmetic shift'
695 |
209: msg
:= 'case range too large'
696 |
210: msg
:= 'code too long'
697 |
211: msg
:= 'jump distance too large'
698 |
212: msg
:= 'illegal real operation'
699 |
213: msg
:= 'too many cases in case statement'
700 |
214: msg
:= 'structure too large'
701 |
215: msg
:= 'not enough registers
: simplify expression'
702 |
216: msg
:= 'not enough floating
-point registers
: simplify expression'
703 |
217: msg
:= 'unimplemented SYSTEM function'
704 |
218: msg
:= 'illegal value of
parameter (0 <= p
< 128)'
705 |
219: msg
:= 'illegal value of
parameter (0 <= p
< 16)'
706 |
220: msg
:= 'illegal value of parameter'
707 |
221: msg
:= 'too many pointers in a record'
708 |
222: msg
:= 'too many global pointers'
709 |
223: msg
:= 'too many record types'
710 |
224: msg
:= 'too many pointer types'
711 |
225: msg
:= 'illegal sys flag'
712 |
226: msg
:= 'too many exported procedures'
713 |
227: msg
:= 'too many imported modules'
714 |
228: msg
:= 'too many exported structures'
715 |
229: msg
:= 'too many nested records for import'
716 |
230: msg
:= 'too many
constants (strings
) in module'
717 |
231: msg
:= 'too many link table
entries (external procedures
)'
718 |
232: msg
:= 'too many commands in module'
719 |
233: msg
:= 'record extension hierarchy too high'
720 |
235: msg
:= 'too many modifiers '
721 |
240: msg
:= 'identifier too long'
722 |
241: msg
:= 'string too long'
723 |
242: msg
:= 'too many meta names'
724 |
243: msg
:= 'too many imported variables'
725 |
249: msg
:= 'inconsistent import'
726 |
250: msg
:= 'code proc must not be exported'
727 |
251: msg
:= 'too many nested function calls'
728 |
254: msg
:= 'debug position not found'
729 |
255: msg
:= 'debug position'
730 |
260: msg
:= 'illegal
LONGINT operation'
731 |
261: msg
:= 'unsupported mode or size of second argument of SYSTEM
.VAL'
732 |
265: msg
:= 'unsupported string operation'
733 |
270: msg
:= 'interface pointer reference counting restriction violated'
734 |
301: msg
:= 'implicit type cast'
735 |
302: msg
:= 'guarded variable can be side
-effected'
736 |
303: msg
:= 'open
array (or pointer to array
) containing pointers'
737 |
401: msg
:= 'bytecode restriction
: no structured assignment'
738 |
402: msg
:= 'bytecode restriction
: no procedure types'
739 |
403: msg
:= 'bytecode restriction
: no nested procedures'
740 |
404: msg
:= 'bytecode restriction
: illegal SYSTEM function'
741 |
410: msg
:= 'variable may not have been assigned'
742 |
411: msg
:= 'no proofable return'
743 |
412: msg
:= 'illegal constructor call'
744 |
413: msg
:= 'missing constructor call'
745 |
501: msg
:= 'user defined error'
752 |
777: msg
:= 'register not released'
753 |
778: msg
:= 'float register not released'
754 |
779: msg
:= 'float register overallocated'
755 |
900: msg
:= 'never used'
756 |
901: msg
:= 'never set'
757 |
902: msg
:= 'used before set'
758 |
903: msg
:= 'set but never used'
759 |
904: msg
:= 'used as varpar
, possibly not set'
760 |
905: msg
:= 'also declared in outer scope'
761 |
906: msg
:= 'access
/assignment to intermediate'
762 |
907: msg
:= 'redefinition'
763 |
908: msg
:= 'new definition'
764 |
909: msg
:= 'statement after
RETURN/EXIT'
765 |
910: msg
:= 'for loop variable set'
766 |
911: msg
:= 'implied type guard'
767 |
912: msg
:= 'superfluous type guard'
768 |
913: msg
:= 'call might depend on evaluation sequence of params
.'
769 |
930: msg
:= 'superfluous semicolon'
770 ELSE Strings
.IntToString(err
, msg
)
774 PROCEDURE InsertMarks
*;
775 VAR i
, j
, x
, y
, n
, line
, col
, beg
, end
: INTEGER; s
: ARRAY 128 OF CHAR;
778 IF n
> maxErrors
THEN n
:= maxErrors
END;
782 x
:= errPos
[i
]; y
:= errNo
[i
]; j
:= i
-1;
783 WHILE (j
>= 0) & (errPos
[j
] < x
) DO
784 errPos
[j
+1] := errPos
[j
];
785 errNo
[j
+1] := errNo
[j
];
788 errPos
[j
+1] := x
; errNo
[j
+1] := y
; INC(i
)
792 WHILE n
> 0 DO DEC(n
);
793 LineColOf(errPos
[n
], line
, col
, beg
, end
);
794 IF name
= "" THEN Console
.WriteStr("???")
795 ELSE Console
.WriteStr(name
)
797 Console
.WriteChar(":");
798 Strings
.IntToString(line
, s
); Console
.WriteStr(s
);
799 Console
.WriteChar(":");
800 Strings
.IntToString(col
, s
); Console
.WriteStr(s
);
801 Console
.WriteChar(":");
802 Strings
.IntToString(errPos
[n
], s
); Console
.WriteStr(s
);
803 Console
.WriteStr(": ");
804 IF errNo
[n
] >= 0 THEN Console
.WriteStr("error: ")
805 ELSE Console
.WriteStr("warning: ")
807 GetErrorMsg(errNo
[n
], s
);
810 Console
.WriteStr(" ");
811 FOR i
:= beg
TO end
DO
812 IF in
[i
] = 09X
THEN Console
.WriteStr(" ")
813 ELSE Console
.WriteChar(in
[i
])
817 Console
.WriteStr(" ");
818 FOR i
:= 1 TO col
- 2 DO
819 Console
.WriteChar(" ")
821 Console
.WriteChar("^");
831 PROCEDURE InitCrcTab
;
832 (* CRC32, high bit first, pre & post inverted *)
833 CONST poly
= {0, 1, 2, 4, 5, 7, 8, 10, 11, 12, 16, 22, 23, 26}; (* CRC32 polynom *)
834 VAR x
, c
, i
: INTEGER;
838 c
:= x
* 1000000H
; i
:= 0;
840 IF c
< 0 THEN c
:= ORD(BITS(c
* 2) / poly
)
845 crc32tab
[ORD(BITS(x
) / BITS(255))] := ORD(BITS(c
) / BITS(255));
850 PROCEDURE FPrint
* (VAR fp
: INTEGER; val
: INTEGER);
854 fp := SYSTEM.ROT(ORD(BITS(fp) / BITS(val)), 1) (* bad collision detection *)
856 (* CRC32, high bit first, pre & post inverted *)
857 c
:= ORD(BITS(fp
* 256) / BITS(crc32tab
[ORD(BITS(fp
DIV 1000000H
) / BITS(val
DIV 1000000H
)) MOD 256]));
858 c
:= ORD(BITS(c
* 256) / BITS(crc32tab
[ORD(BITS(c
DIV 1000000H
) / BITS(val
DIV 10000H
)) MOD 256]));
859 c
:= ORD(BITS(c
* 256) / BITS(crc32tab
[ORD(BITS(c
DIV 1000000H
) / BITS(val
DIV 100H
)) MOD 256]));
860 fp
:= ORD(BITS(c
* 256) / BITS(crc32tab
[ORD(BITS(c
DIV 1000000H
) / BITS(val
)) MOD 256]));
863 PROCEDURE FPrintSet
* (VAR fp
: INTEGER; set
: SET);
864 BEGIN FPrint(fp
, ORD(set
))
867 PROCEDURE FPrintReal
* (VAR fp
: INTEGER; real
: SHORTREAL
);
868 BEGIN FPrint(fp
, SYSTEM
.VAL(INTEGER, real
))
871 PROCEDURE FPrintLReal
* (VAR fp
: INTEGER; lr
: REAL);
873 FPrint(fp
, LoWord(lr
)); FPrint(fp
, HiWord(lr
))
876 PROCEDURE ChkSum (VAR fp
: INTEGER; val
: INTEGER); (* symbolfile checksum *)
878 (* same as FPrint, 8 bit only *)
879 fp
:= ORD(BITS(fp
* 256) / BITS(crc32tab
[ORD(BITS(fp
DIV 1000000H
) / BITS(val
)) MOD 256]))
886 PROCEDURE WriteLInt (w
: Files
.Writer
; i
: INTEGER);
889 w
.WriteByte(SHORT(SHORT(i
MOD 256))); i
:= i
DIV 256;
891 w
.WriteByte(SHORT(SHORT(i
MOD 256))); i
:= i
DIV 256;
893 w
.WriteByte(SHORT(SHORT(i
MOD 256))); i
:= i
DIV 256;
895 w
.WriteByte(SHORT(SHORT(i
MOD 256)))
898 PROCEDURE ReadLInt (r
: Files
.Reader
; VAR i
: INTEGER);
899 VAR b
: BYTE; x
: INTEGER;
901 r
.ReadByte(b
); x
:= b
MOD 256;
903 r
.ReadByte(b
); x
:= x
+ 100H
* (b
MOD 256);
905 r
.ReadByte(b
); x
:= x
+ 10000H
* (b
MOD 256);
907 r
.ReadByte(b
); i
:= x
+ 1000000H
* b
;
911 PROCEDURE WriteNum (w
: Files
.Writer
; i
: INTEGER);
912 BEGIN (* old format of Oberon *)
913 WHILE (i
< -64) OR (i
> 63) DO ChkSum(checksum
, i
MOD 128 - 128); w
.WriteByte(SHORT(SHORT(i
MOD 128 - 128))); i
:= i
DIV 128 END;
914 ChkSum(checksum
, i
MOD 128);
915 w
.WriteByte(SHORT(SHORT(i
MOD 128)))
918 PROCEDURE ReadNum (r
: Files
.Reader
; VAR i
: INTEGER);
919 VAR b
: BYTE; s
, y
: INTEGER;
921 s
:= 0; y
:= 0; r
.ReadByte(b
);
922 IF ~r
.eof
THEN ChkSum(checksum
, b
) END;
923 WHILE b
< 0 DO INC(y
, ASH(b
+ 128, s
)); INC(s
, 7); r
.ReadByte(b
); ChkSum(checksum
, b
) END;
924 i
:= ASH((b
+ 64) MOD 128 - 64, s
) + y
;
927 PROCEDURE WriteNumSet (w
: Files
.Writer
; x
: SET);
932 PROCEDURE ReadNumSet (r
: Files
.Reader
; VAR x
: SET);
935 ReadNum(r
, i
); x
:= BITS(i
)
938 PROCEDURE WriteReal (w
: Files
.Writer
; x
: SHORTREAL
);
940 WriteLInt(w
, SYSTEM
.VAL(INTEGER, x
))
943 PROCEDURE ReadReal (r
: Files
.Reader
; VAR x
: SHORTREAL
);
946 ReadLInt(r
, i
); x
:= SYSTEM
.VAL(SHORTREAL
, i
)
949 PROCEDURE WriteLReal (w
: Files
.Writer
; x
: REAL);
951 WriteLInt(w
, LoWord(x
)); WriteLInt(w
, HiWord(x
))
954 PROCEDURE ReadLReal (r
: Files
.Reader
; VAR x
: REAL);
957 ReadLInt(r
, l
); ReadLInt(r
, h
); x
:= Compound(l
, h
)
961 (* read symbol file *)
963 PROCEDURE SymRCh
* (VAR ch
: SHORTCHAR
);
966 inSym
.ReadByte(b
); ch
:= SHORT(CHR(b
));
970 PROCEDURE SymRInt
* (): INTEGER;
973 ReadNum(inSym
, k
); RETURN k
976 PROCEDURE SymRSet
* (VAR s
: SET);
981 PROCEDURE SymRReal
* (VAR r
: SHORTREAL
);
986 PROCEDURE SymRLReal
* (VAR lr
: REAL);
991 PROCEDURE eofSF
* (): BOOLEAN;
996 PROCEDURE OldSym
* (IN modName
: ARRAY OF SHORTCHAR
; VAR done
: BOOLEAN);
997 VAR tag
: INTEGER; d
: Directory
;
999 PROCEDURE Old (IN path
: Files
.Name
; IN modName
: ARRAY OF SHORTCHAR
; legacy
: BOOLEAN): Files
.File
;
1000 VAR f
: Files
.File
; res
: INTEGER; loc
: Files
.Locator
; dir
, name
: Files
.Name
;
1002 Kernel
.Utf8ToString(modName
, name
, res
);
1003 loc
:= Files
.dir
.This(path
);
1005 Kernel
.SplitName(name
, dir
, name
);
1006 Kernel
.MakeFileName(name
, Kernel
.symType
);
1007 loc
:= loc
.This(dir
).This(symDir
);
1008 f
:= Files
.dir
.Old(loc
, name
, Files
.shared
);
1009 IF (f
= NIL) & (dir
= "") THEN
1010 loc
:= Files
.dir
.This(path
).This(SYSdir
).This(symDir
);
1011 f
:= Files
.dir
.Old(loc
, name
, Files
.shared
)
1014 Kernel
.MakeFileName(name
, Kernel
.symType
);
1015 f
:= Files
.dir
.Old(loc
, name
, Files
.shared
)
1022 IF modName
= "@file" THEN
1025 oldSymFile
:= Old(symPath
, modName
, legacy
);
1027 WHILE (oldSymFile
= NIL) & (d
# NIL) DO
1028 oldSymFile
:= Old(d
.path
, modName
, d
.legacy
);
1032 IF oldSymFile
# NIL THEN
1033 inSym
:= oldSymFile
.NewReader(inSym
);
1035 ReadLInt(inSym
, tag
);
1036 IF tag
= SFtag
THEN done
:= TRUE
ELSE err(151) END
1041 PROCEDURE CloseOldSym
*;
1043 IF oldSymFile
# NIL THEN oldSymFile
.Close
; oldSymFile
:= NIL END
1047 (* write symbol file *)
1049 PROCEDURE SymWCh
* (ch
: SHORTCHAR
);
1051 ChkSum(checksum
, ORD(ch
));
1052 outSym
.WriteByte(SHORT(ORD(ch
)))
1055 PROCEDURE SymWInt
* (i
: INTEGER);
1060 PROCEDURE SymWSet
* (s
: SET);
1062 WriteNumSet(outSym
, s
)
1065 PROCEDURE SymWReal
* (r
: SHORTREAL
);
1067 WriteReal(outSym
, r
)
1070 PROCEDURE SymWLReal
* (r
: REAL);
1072 WriteLReal(outSym
, r
)
1075 PROCEDURE SymReset
*;
1080 PROCEDURE NewSym
* (IN modName
: ARRAY OF SHORTCHAR
);
1081 VAR res
: INTEGER; loc
: Files
.Locator
; dir
: Files
.Name
;
1083 Kernel
.Utf8ToString(modName
, ObjFName
, res
);
1084 loc
:= Files
.dir
.This(symPath
);
1086 Kernel
.SplitName(ObjFName
, dir
, ObjFName
);
1087 loc
:= loc
.This(dir
).This(symDir
)
1089 symFile
:= Files
.dir
.New(loc
, Files
.ask
);
1090 IF symFile
# NIL THEN
1091 outSym
:= symFile
.NewWriter(NIL);
1092 WriteLInt(outSym
, SFtag
)
1098 PROCEDURE RegisterNewSym
*;
1099 VAR res
: INTEGER; name
: Files
.Name
;
1101 IF symFile
# NIL THEN
1103 Kernel
.MakeFileName(name
, Kernel
.symType
);
1104 symFile
.Register(name
, Kernel
.symType
, Files
.ask
, res
);
1109 PROCEDURE DeleteNewSym
*;
1111 IF symFile
# NIL THEN symFile
.Close
; symFile
:= NIL END
1115 (* write object file *)
1117 PROCEDURE ObjW
* (ch
: SHORTCHAR
);
1119 outObj
.WriteByte(SHORT(ORD(ch
)))
1122 PROCEDURE ObjWNum
* (i
: INTEGER);
1127 PROCEDURE ObjWInt (i
: SHORTINT);
1129 outObj
.WriteByte(SHORT(SHORT(i
MOD 256)));
1130 outObj
.WriteByte(SHORT(SHORT(i
DIV 256)))
1133 PROCEDURE ObjWLInt
* (i
: INTEGER);
1135 ObjWInt(SHORT(i
MOD 65536));
1136 ObjWInt(SHORT(i
DIV 65536))
1139 PROCEDURE ObjWBytes
* (IN bytes
: ARRAY OF SHORTCHAR
; n
: INTEGER);
1140 TYPE P
= POINTER TO ARRAY [untagged
] 100000H
OF BYTE;
1143 p
:= SYSTEM
.VAL(P
, SYSTEM
.ADR(bytes
));
1144 outObj
.WriteBytes(p^
, 0, n
)
1147 PROCEDURE ObjLen
* (): INTEGER;
1152 PROCEDURE ObjSet
* (pos
: INTEGER);
1157 PROCEDURE NewObj
* (IN modName
: ARRAY OF SHORTCHAR
);
1158 VAR res
: INTEGER; loc
: Files
.Locator
; dir
: Files
.Name
;
1161 Kernel
.Utf8ToString(modName
, ObjFName
, res
);
1162 loc
:= Files
.dir
.This(codePath
);
1164 Kernel
.SplitName(ObjFName
, dir
, ObjFName
);
1165 loc
:= loc
.This(dir
).This(codeDir
)
1167 objFile
:= Files
.dir
.New(loc
, Files
.ask
);
1168 IF objFile
# NIL THEN
1169 outObj
:= objFile
.NewWriter(NIL);
1170 WriteLInt(outObj
, OFtag
)
1176 PROCEDURE RegisterObj
*;
1177 VAR res
: INTEGER; name
: Files
.Name
;
1179 IF objFile
# NIL THEN
1181 Kernel
.MakeFileName(name
, Kernel
.objType
);
1182 objFile
.Register(name
, Kernel
.objType
, Files
.ask
, res
);
1183 objFile
:= NIL; outObj
:= NIL
1187 PROCEDURE DeleteObj
*;
1189 IF objFile
# NIL THEN objFile
.Close
; objFile
:= NIL END
1194 VAR test
: SHORTINT; lo
: SHORTCHAR
;
1196 test
:= 1; SYSTEM
.GET(SYSTEM
.ADR(test
), lo
); LEHost
:= lo
= 1X
;
1197 InfReal
:= SYSTEM
.VAL(SHORTREAL
, InfRealPat
);
1198 MinReal32
:= SYSTEM
.VAL(SHORTREAL
, MinReal32Pat
);
1199 MaxReal32
:= SYSTEM
.VAL(SHORTREAL
, MaxReal32Pat
);
1200 MinReal64
:= Compound(MinReal64PatL
, MinReal64PatH
);
1201 MaxReal64
:= Compound(MaxReal64PatL
, MaxReal64PatH
)