1 (* ==================================================================== *)
3 (* Builtin Symbols for the Gardens Point Component Pascal Compiler. *)
4 (* Copyright (c) John Gough 1999, 2000. *)
6 (* ==================================================================== *)
20 (* ============================================================ *)
21 CONST (* Here are global ordinals for builtin objects procs *)
22 (* Builtin Functions *)
23 absP
* = 1; ashP
* = 2; bitsP
* = 3; capP
* = 4;
24 chrP
* = 5; entP
* = 6; lenP
* = 7; longP
* = 8;
25 maxP
* = 9; minP
* = 10; oddP
* = 11; ordP
* = 12;
26 shrtP
* = 13; sizeP
* = 14; mStrP
* = 15; tpOfP
* = 16;
27 boxP
* = 17; uBytP
* = 18; lshP
* = 19; rotP
* = 20;
28 (* Builtin Proper Procedures *)
29 asrtP
* = 21; decP
* = 22; incP
* = 23; inclP
* = 24;
30 exclP
* = 25; haltP
* = 26; newP
* = 27; throwP
*= 28;
31 subsP
* = 29; unsbP
* = 30; apndP
* = 31; cutP
* = 32;
32 (* Builtin SYSTEM Functions *)
33 adrP
* = 33; getP
* = 34; putP
* = 35;
35 CONST builtinTypeNum
* = 16;
37 (* ============================================================ *)
39 VAR (* Here are the global descriptors for builtin objects. *)
41 boolTp
- : Symbols
.Type
; (* type descriptor of BOOLEAN *)
42 byteTp
- : Symbols
.Type
; (* type descriptor of BYTE *)
43 uBytTp
- : Symbols
.Type
; (* type descriptor of UBYTE *)
44 charTp
- : Symbols
.Type
; (* type descriptor of CHAR *)
45 sChrTp
- : Symbols
.Type
; (* type descriptor of SHORTCHAR *)
46 intTp
- : Symbols
.Type
; (* type descriptor of INTEGER *)
47 sIntTp
- : Symbols
.Type
; (* type descriptor of SHORTINT *)
48 lIntTp
- : Symbols
.Type
; (* type descriptor of LONGINT *)
49 realTp
- : Symbols
.Type
; (* type descriptor of REAL *)
50 sReaTp
- : Symbols
.Type
; (* type descriptor of SHORTREAL *)
51 anyRec
- : Symbols
.Type
; (* type descriptor of ANYREC *)
52 anyPtr
- : Symbols
.Type
; (* type descriptor of ANYPTR *)
53 setTp
- : Symbols
.Type
; (* type descriptor of SET *)
54 strTp
- : Symbols
.Type
; (* type descriptor of <strings> *)
55 sStrTp
- : Symbols
.Type
; (* type descriptor of <shortSt> *)
56 metaTp
- : Symbols
.Type
; (* type descriptor of META *)
58 chrArr
- : Symbols
.Type
; (* open value array of CHAR *)
60 anyTpId
- : IdDesc
.TypId
;
62 VAR baseTypeArray
- : ARRAY builtinTypeNum
+1 OF Symbols
.Type
;
64 VAR sysBkt
- : INTEGER;
72 (* ============================================================ *)
74 VAR (* Here are more global descriptors for builtin objects *)
75 (* Builtin Functions *)
76 absPd
- : Symbols
.Idnt
; (* ident descriptor of ABS *)
77 ashPd
- : Symbols
.Idnt
; (* ident descriptor of ASH *)
78 bitsPd
- : Symbols
.Idnt
; (* ident descriptor of BITS *)
79 capPd
- : Symbols
.Idnt
; (* ident descriptor of CAP *)
80 chrPd
- : Symbols
.Idnt
; (* ident descriptor of CHR *)
81 entPd
- : Symbols
.Idnt
; (* ident descriptor of ENTIER *)
82 lenPd
- : Symbols
.Idnt
; (* ident descriptor of LEN *)
83 longPd
- : Symbols
.Idnt
; (* ident descriptor of LONG *)
84 maxPd
- : Symbols
.Idnt
; (* ident descriptor of MAX *)
85 minPd
- : Symbols
.Idnt
; (* ident descriptor of MIN *)
86 oddPd
- : Symbols
.Idnt
; (* ident descriptor of ODD *)
87 ordPd
- : Symbols
.Idnt
; (* ident descriptor of ORD *)
88 uBytPd
- : Symbols
.Idnt
; (* ident descriptor of USHORT *)
89 shrtPd
- : Symbols
.Idnt
; (* ident descriptor of SHORT *)
90 sizePd
- : Symbols
.Idnt
; (* ident descriptor of SIZE *)
91 mStrPd
- : Symbols
.Idnt
; (* ident descriptor of MKSTR *)
92 tpOfPd
- : Symbols
.Idnt
; (* ident descriptor of TYPEOF *)
93 boxPd
- : Symbols
.Idnt
; (* ident descriptor of BOX *)
94 (* SYSTEM functions *)
95 adrPd
- : Symbols
.Idnt
; (* ident descriptor of ADR *)
96 getPd
- : Symbols
.Idnt
; (* ident descriptor of GET *)
97 putPd
- : Symbols
.Idnt
; (* ident descriptor of PUT *)
98 lshPd
- : Symbols
.Idnt
; (* ident descriptor of LSH *)
99 rotPd
- : Symbols
.Idnt
; (* ident descriptor of ROT *)
100 (* Builtin Proper Procedures *)
101 asrtPd
- : Symbols
.Idnt
; (* ident descriptor of ASSERT *)
102 decPd
- : Symbols
.Idnt
; (* ident descriptor of DEC *)
103 incPd
- : Symbols
.Idnt
; (* ident descriptor of INC *)
104 inclPd
- : Symbols
.Idnt
; (* ident descriptor of INCL *)
105 exclPd
- : Symbols
.Idnt
; (* ident descriptor of EXCL *)
106 haltPd
- : Symbols
.Idnt
; (* ident descriptor of HALT *)
107 throwPd
-: Symbols
.Idnt
; (* ident descriptor of THROW *)
108 newPd
- : Symbols
.Idnt
; (* ident descriptor of NEW *)
109 subsPd
- : Symbols
.Idnt
; (* ident desc of REGISTER *)
110 unsbPd
- : Symbols
.Idnt
; (* ident desc of DEREGISTER *)
111 apndPd
- : Symbols
.Idnt
; (* ident descriptor of APPEND *)
112 cutPd
- : Symbols
.Idnt
; (* ident descriptor of CUT *)
114 (* ============================================================ *)
116 VAR (* Here are more global descriptors for builtin objects *)
117 (* Builtin Constants *)
118 trueC
- : Symbols
.Idnt
; (* ident descriptor of TRUE *)
119 falsC
- : Symbols
.Idnt
; (* ident descriptor of FALSE *)
120 infC
- : Symbols
.Idnt
; (* ident descriptor of INF *)
121 nInfC
- : Symbols
.Idnt
; (* ident descriptor of NEGINF *)
122 nilC
- : Symbols
.Idnt
; (* ident descriptor of NIL *)
124 (* ============================================================ *)
126 VAR (* some private stuff *)
127 dummyProcType
: Typ
.Procedure
;
128 dummyFuncType
: Typ
.Procedure
;
130 (* ============================================================ *)
132 PROCEDURE MkDummyImport
*(IN nam
: ARRAY OF CHAR;
133 IN xNm
: ARRAY OF CHAR;
134 OUT blk
: IdDesc
.BlkId
);
137 blk
:= IdDesc
.newImpId();
139 blk
.hash
:= NameHash
.enterStr(nam
);
140 IF LEN(xNm
) > 1 THEN blk
.scopeNm
:= LitValue
.strToCharOpen(xNm
) END;
141 jnk
:= CompState
.thisMod
.symTb
.enter(blk
.hash
, blk
);
142 INCL(blk
.xAttr
, Symbols
.isFn
);
145 (* ------------------------------------------------------------ *)
147 PROCEDURE MkDummyClass
*(IN nam
: ARRAY OF CHAR;
150 OUT tId
: IdDesc
.TypId
);
151 VAR ptr
: Typ
.Pointer
;
155 ptr
:= Typ
.newPtrTp();
156 rec
:= Typ
.newRecTp();
157 tId
:= IdDesc
.newTypId(ptr
);
161 rec
.extrnNm
:= blk
.scopeNm
;
163 INCL(rec
.xAttr
, Symbols
.clsTp
); (* new 04.jun.01 *)
164 tId
.SetMode(Symbols
.pubMode
);
166 tId
.hash
:= NameHash
.enterStr(nam
);
167 tId
.SetNameFromHash(tId
.hash
);
168 jnk
:= blk
.symTb
.enter(tId
.hash
, tId
);
171 (* ------------------------------------------------------------ *)
173 PROCEDURE MkDummyMethodAndInsert
*(IN namStr
: ARRAY OF CHAR;
174 prcTyp
: Typ
.Procedure
;
175 hostTp
: Symbols
.Type
;
176 scope
: IdDesc
.BlkId
;
180 VAR mthD
: IdDesc
.MthId
;
186 recT
:= hostTp
.boundRecTp()(Typ
.Record
);
187 prcTyp
.receiver
:= hostTp
;
189 mthD
:= IdDesc
.newMthId();
190 mthD
.SetMode(access
);
191 mthD
.setPrcKind(IdDesc
.conMth
);
192 mthD
.hash
:= NameHash
.enterStr(namStr
);
195 mthD
.bndType
:= hostTp
;
196 mthD
.mthAtt
:= mthAtt
;
197 mthD
.SetNameFromString(BOX(namStr
));
199 rcvD
:= IdDesc
.newParId();
201 rcvD
.parMod
:= rcvFrm
;
203 rcvD
.hash
:= NameHash
.enterStr("this");
207 Typ
.InsertInRec(mthD
, recT
, TRUE
, oldD
, junk
);
208 Symbols
.AppendIdnt(recT
.methods
, mthD
);
209 END MkDummyMethodAndInsert
;
211 (* ------------------------------------------------------------ *)
213 PROCEDURE MkDummyVar
*(IN nam
: ARRAY OF CHAR;
216 OUT vId
: IdDesc
.VarId
);
219 vId
:= IdDesc
.newVarId();
220 vId
.SetMode(Symbols
.pubMode
);
223 vId
.hash
:= NameHash
.enterStr(nam
);
224 jnk
:= blk
.symTb
.enter(vId
.hash
, vId
);
227 (* ------------------------------------------------------------ *)
229 PROCEDURE MkDummyAlias
*(IN nam
: ARRAY OF CHAR;
232 OUT tId
: Symbols
.Idnt
);
233 VAR (* tId : IdDesc.TypId; *)
236 tId
:= IdDesc
.newTypId(typ
);
237 tId
.SetMode(Symbols
.pubMode
);
239 tId
.hash
:= NameHash
.enterStr(nam
);
240 jnk
:= blk
.symTb
.enter(tId
.hash
, tId
);
243 (* ------------------------------------------------------------ *)
245 PROCEDURE SetPtrBase
*(cls
, bas
: IdDesc
.TypId
);
246 VAR ptrC
: Typ
.Pointer
;
248 VAR ptrB
: Typ
.Pointer
;
251 ptrC
:= cls
.type(Typ
.Pointer
);
252 recC
:= ptrC
.boundTp(Typ
.Record
);
253 ptrB
:= bas
.type(Typ
.Pointer
);
254 recB
:= ptrB
.boundTp(Typ
.Record
);
258 (* ============================================================ *)
260 PROCEDURE InitAnyRec(ord
: INTEGER);
264 base
:= Typ
.anyRecTp
;
265 tpId
:= IdDesc
.newTypId(base
);
271 baseTypeArray
[ord
] := base
;
274 PROCEDURE InitAnyPtr(ord
: INTEGER);
278 base
:= Typ
.anyPtrTp
;
279 tpId
:= IdDesc
.newTypId(base
);
284 baseTypeArray
[ord
] := base
;
287 (* -------------------------------------------- *)
289 PROCEDURE StdType(ord
: INTEGER; OUT var
: Symbols
.Type
);
293 base
:= Typ
.newBasTp();
294 tpId
:= IdDesc
.newTypId(base
);
299 baseTypeArray
[ord
] := base
;
302 (* -------------------------------------------- *)
304 PROCEDURE StdConst(typ
: Symbols
.Type
; OUT var
: Symbols
.Idnt
);
305 VAR conD
: IdDesc
.ConId
;
307 conD
:= IdDesc
.newConId();
313 (* -------------------------------------------- *)
315 PROCEDURE StdFunc(ord
: INTEGER; OUT var
: Symbols
.Idnt
);
316 VAR proc
: IdDesc
.PrcId
;
318 proc
:= IdDesc
.newPrcId();
319 proc
.SetKind(IdDesc
.conPrc
);
321 proc
.type
:= dummyFuncType
;
325 (* -------------------------------------------- *)
327 PROCEDURE StdProc(ord
: INTEGER; OUT var
: Symbols
.Idnt
);
328 VAR proc
: IdDesc
.PrcId
;
330 proc
:= IdDesc
.newPrcId();
331 proc
.SetKind(IdDesc
.conPrc
);
333 proc
.type
:= dummyProcType
;
337 (* -------------------------------------------- *)
339 PROCEDURE BindName(var
: Symbols
.Idnt
; IN str
: ARRAY OF CHAR);
343 hash
:= NameHash
.enterStr(str
);
346 var
.SetNameFromString(BOX(str$
));
347 ASSERT(CompState
.thisMod
.symTb
.enter(hash
, var
));
350 (* -------------------------------------------- *)
352 PROCEDURE BindSysName(var
: Symbols
.Idnt
; IN str
: ARRAY OF CHAR);
356 hash
:= NameHash
.enterStr(str
);
359 ASSERT(CompState
.sysMod
.symTb
.enter(hash
, var
));
362 (* -------------------------------------------- *)
364 PROCEDURE RebindBuiltins
*;
366 selfBk
:= NameHash
.enterStr("SELF");
367 basBkt
:= NameHash
.enterStr("BASE");
368 sysBkt
:= NameHash
.enterStr("SYSTEM");
369 xpndBk
:= NameHash
.enterStr("expand");
370 frnBkt
:= NameHash
.enterStr("FOREIGN");
371 constB
:= NameHash
.enterStr("CONSTRUCTOR");
372 noChkB
:= NameHash
.enterStr("UNCHECKED_ARITHMETIC");
373 BindName(boolTp
.idnt
, "BOOLEAN");
374 BindName(byteTp
.idnt
, "BYTE");
375 BindName(uBytTp
.idnt
, "UBYTE");
376 BindName(charTp
.idnt
, "CHAR");
377 BindName(sChrTp
.idnt
, "SHORTCHAR");
378 BindName(intTp
.idnt
, "INTEGER");
379 BindName(sIntTp
.idnt
, "SHORTINT");
380 BindName(lIntTp
.idnt
, "LONGINT");
381 BindName(realTp
.idnt
, "REAL");
382 BindName(sReaTp
.idnt
, "SHORTREAL");
383 BindName(anyRec
.idnt
, "ANYREC");
384 BindName(anyPtr
.idnt
, "ANYPTR");
385 BindName(setTp
.idnt
, "SET");
386 BindName(strTp
.idnt
, "<string>");
387 BindName(sStrTp
.idnt
, "<shortString>");
388 BindName(metaTp
.idnt
, "<META-TYPE>");
390 BindName(absPd
, "ABS");
391 BindName(ashPd
, "ASH");
392 BindName(lshPd
, "LSH");
393 BindName(rotPd
, "ROT");
394 BindName(bitsPd
, "BITS");
395 BindName(capPd
, "CAP");
396 BindName(chrPd
, "CHR");
397 BindName(entPd
, "ENTIER");
398 BindName(lenPd
, "LEN");
399 BindName(longPd
, "LONG");
400 BindName(maxPd
, "MAX");
401 BindName(minPd
, "MIN");
402 BindName(oddPd
, "ODD");
403 BindName(ordPd
, "ORD");
404 BindName(uBytPd
, "USHORT");
405 BindName(shrtPd
, "SHORT");
406 BindName(sizePd
, "SIZE");
407 BindName(mStrPd
, "MKSTR");
408 BindName(boxPd
, "BOX");
409 BindName(tpOfPd
, "TYPEOF");
411 BindSysName(adrPd
, "ADR");
412 BindSysName(getPd
, "GET");
413 BindSysName(putPd
, "PUT");
415 BindName(asrtPd
, "ASSERT");
416 BindName(decPd
, "DEC");
417 BindName(incPd
, "INC");
418 BindName(inclPd
, "INCL");
419 BindName(exclPd
, "EXCL");
420 BindName(haltPd
, "HALT");
421 BindName(throwPd
,"THROW");
422 BindName(newPd
, "NEW");
423 BindName(subsPd
, "REGISTER");
424 BindName(unsbPd
, "DEREGISTER");
425 BindName(apndPd
, "APPEND");
426 BindName(cutPd
, "CUT");
428 BindName(trueC
, "TRUE");
429 BindName(falsC
, "FALSE");
430 BindName(infC
, "INF");
431 BindName(nInfC
, "NEGINF");
432 BindName(nilC
, "NIL");
434 CompState
.sysMod
.hash
:= sysBkt
;
437 (* -------------------------------------------- *)
439 PROCEDURE InitBuiltins
*;
441 InitAnyRec(Typ
.anyRec
);
442 InitAnyPtr(Typ
.anyPtr
);
443 StdType(Typ
.boolN
, boolTp
);
444 StdType(Typ
.byteN
, byteTp
);
445 StdType(Typ
.uBytN
, uBytTp
);
446 StdType(Typ
.charN
, charTp
); chrArr
:= Typ
.mkArrayOf(charTp
);
447 StdType(Typ
.sChrN
, sChrTp
);
448 StdType(Typ
.intN
, intTp
); Typ
.integerT
:= intTp
;
449 StdType(Typ
.sIntN
, sIntTp
);
450 StdType(Typ
.lIntN
, lIntTp
);
451 StdType(Typ
.realN
, realTp
);
452 StdType(Typ
.sReaN
, sReaTp
);
454 StdType(Typ.anyPtr,anyPtr);
456 StdType(Typ
.setN
, setTp
);
457 StdType(Typ
.strN
, strTp
);
458 StdType(Typ
.sStrN
, sStrTp
);
459 StdType(Typ
.metaN
, metaTp
);
461 dummyProcType
:= Typ
.newPrcTp();
462 dummyFuncType
:= Typ
.newPrcTp();
463 dummyFuncType
.retType
:= anyPtr
;
465 StdFunc(absP
, absPd
);
466 StdFunc(ashP
, ashPd
);
467 StdFunc(lshP
, lshPd
);
468 StdFunc(rotP
, rotPd
);
469 StdFunc(bitsP
, bitsPd
);
470 StdFunc(capP
, capPd
);
471 StdFunc(chrP
, chrPd
);
472 StdFunc(entP
, entPd
);
473 StdFunc(lenP
, lenPd
);
474 StdFunc(longP
, longPd
);
475 StdFunc(maxP
, maxPd
);
476 StdFunc(minP
, minPd
);
477 StdFunc(oddP
, oddPd
);
478 StdFunc(ordP
, ordPd
);
479 StdFunc(uBytP
, uBytPd
);
480 StdFunc(shrtP
, shrtPd
);
481 StdFunc(sizeP
, sizePd
);
482 StdFunc(mStrP
, mStrPd
);
483 StdFunc(boxP
, boxPd
);
484 StdFunc(tpOfP
, tpOfPd
);
486 StdFunc(adrP
, adrPd
);
487 StdProc(getP
, getPd
);
488 StdProc(putP
, putPd
);
490 StdProc(asrtP
, asrtPd
);
491 StdProc(decP
, decPd
);
492 StdProc(incP
, incPd
);
493 StdProc(inclP
, inclPd
);
494 StdProc(exclP
, exclPd
);
495 StdProc(haltP
, haltPd
);
496 StdProc(throwP
,throwPd
);
497 StdProc(newP
, newPd
);
498 StdProc(subsP
, subsPd
);
499 StdProc(unsbP
, unsbPd
);
500 StdProc(apndP
, apndPd
);
501 StdProc(cutP
, cutPd
);
503 StdConst(boolTp
, trueC
);
504 StdConst(boolTp
, falsC
);
505 StdConst(sReaTp
, infC
);
506 StdConst(sReaTp
, nInfC
);
507 StdConst(anyPtr
, nilC
);
510 (* ============================================================ *)
511 END Builtin
. (* ============================================== *)
512 (* ============================================================ *)