gpcp/Builtin.cp

   1 (* ==================================================================== *)
   2 (*                                                                      *)
   3 (*  Builtin Symbols for the Gardens Point Component Pascal Compiler.    *)
   4 (*      Copyright (c) John Gough 1999, 2000.                            *)
   5 (*                                                                      *)
   6 (* ==================================================================== *)
   7
   8 MODULE Builtin;
   9
  10   IMPORT
  11         GPCPcopyright,
  12         Console,
  13         NameHash,
  14         CompState,
  15         Symbols,
  16         IdDesc,
  17     LitValue,
  18         Typ := TypeDesc;
  19
  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;
  34
  35   CONST builtinTypeNum* = 16;
  36
  37 (* ============================================================ *)
  38
  39   VAR   (* Here are the global descriptors for builtin objects. *)
  40         (* Builtin Types                                        *)
  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      *)
  57
  58       chrArr- : Symbols.Type;   (* open value array of CHAR     *)
  59
  60       anyTpId- : IdDesc.TypId;
  61
  62   VAR baseTypeArray- : ARRAY builtinTypeNum+1 OF Symbols.Type;
  63
  64   VAR sysBkt- : INTEGER;
  65       frnBkt- : INTEGER;
  66       noChkB- : INTEGER;
  67       constB- : INTEGER;
  68       basBkt- : INTEGER;
  69       selfBk- : INTEGER;
  70       xpndBk- : INTEGER;
  71
  72 (* ============================================================ *)
  73
  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      *)
 113
 114 (* ============================================================ *)
 115
 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      *)
 123
 124 (* ============================================================ *)
 125
 126   VAR (* some private stuff *)
 127       dummyProcType : Typ.Procedure;
 128       dummyFuncType : Typ.Procedure;
 129
 130 (* ============================================================ *)
 131
 132   PROCEDURE MkDummyImport*(IN  nam : ARRAY OF CHAR;
 133                            IN  xNm : ARRAY OF CHAR;
 134                            OUT blk : IdDesc.BlkId);
 135     VAR jnk : BOOLEAN;
 136   BEGIN
 137     blk := IdDesc.newImpId();
 138     blk.dfScp   := blk;
 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);
 143   END MkDummyImport;
 144
 145 (* ------------------------------------------------------------ *)
 146
 147   PROCEDURE MkDummyClass*(IN  nam : ARRAY OF CHAR;
 148                               blk : IdDesc.BlkId;
 149                               att : INTEGER;
 150                           OUT tId : IdDesc.TypId);
 151     VAR ptr : Typ.Pointer;
 152         rec : Typ.Record;
 153         jnk : BOOLEAN;
 154   BEGIN
 155     ptr := Typ.newPtrTp();
 156     rec := Typ.newRecTp();
 157     tId := IdDesc.newTypId(ptr);
 158     ptr.idnt    := tId;
 159     ptr.boundTp := rec;
 160     rec.bindTp  := ptr;
 161     rec.extrnNm := blk.scopeNm;
 162     rec.recAtt  := att;
 163     INCL(rec.xAttr, Symbols.clsTp);             (* new 04.jun.01 *)
 164     tId.SetMode(Symbols.pubMode);
 165     tId.dfScp := blk;
 166     tId.hash  := NameHash.enterStr(nam);
 167         tId.SetNameFromHash(tId.hash);
 168     jnk := blk.symTb.enter(tId.hash, tId);
 169   END MkDummyClass;
 170
 171 (* ------------------------------------------------------------ *)
 172
 173   PROCEDURE MkDummyMethodAndInsert*(IN namStr : ARRAY OF CHAR;
 174                                        prcTyp : Typ.Procedure;
 175                                        hostTp : Symbols.Type;
 176                                        scope  : IdDesc.BlkId;
 177                                        access : INTEGER;
 178                                        rcvFrm : INTEGER;
 179                                        mthAtt : SET);
 180     VAR mthD : IdDesc.MthId;
 181         recT : Typ.Record;
 182         rcvD : IdDesc.ParId;
 183         oldD : IdDesc.OvlId;
 184         junk : BOOLEAN;
 185   BEGIN
 186     recT := hostTp.boundRecTp()(Typ.Record);
 187     prcTyp.receiver := hostTp;
 188
 189     mthD := IdDesc.newMthId();
 190     mthD.SetMode(access);
 191     mthD.setPrcKind(IdDesc.conMth);
 192     mthD.hash := NameHash.enterStr(namStr);
 193     mthD.dfScp := scope;
 194     mthD.type := prcTyp;
 195     mthD.bndType := hostTp;
 196     mthD.mthAtt := mthAtt;
 197         mthD.SetNameFromString(BOX(namStr));
 198
 199     rcvD := IdDesc.newParId();
 200     rcvD.varOrd := 0;
 201     rcvD.parMod := rcvFrm;
 202     rcvD.type := hostTp;
 203         rcvD.hash := NameHash.enterStr("this");
 204         rcvD.dfScp := mthD;
 205
 206     mthD.rcvFrm := rcvD;
 207     Typ.InsertInRec(mthD, recT, TRUE, oldD, junk);
 208     Symbols.AppendIdnt(recT.methods, mthD);
 209   END MkDummyMethodAndInsert;
 210
 211 (* ------------------------------------------------------------ *)
 212
 213   PROCEDURE MkDummyVar*(IN  nam : ARRAY OF CHAR;
 214                             blk : IdDesc.BlkId;
 215                             typ : Symbols.Type;
 216                         OUT vId : IdDesc.VarId);
 217     VAR jnk : BOOLEAN;
 218   BEGIN
 219     vId := IdDesc.newVarId();
 220     vId.SetMode(Symbols.pubMode);
 221     vId.type  := typ;
 222     vId.dfScp := blk;
 223     vId.hash  := NameHash.enterStr(nam);
 224     jnk := blk.symTb.enter(vId.hash, vId);
 225   END MkDummyVar;
 226
 227 (* ------------------------------------------------------------ *)
 228
 229   PROCEDURE MkDummyAlias*(IN  nam : ARRAY OF CHAR;
 230                               blk : IdDesc.BlkId;
 231                               typ : Symbols.Type;
 232                           OUT tId : Symbols.Idnt);
 233     VAR (* tId : IdDesc.TypId; *)
 234         jnk : BOOLEAN;
 235   BEGIN
 236     tId := IdDesc.newTypId(typ);
 237     tId.SetMode(Symbols.pubMode);
 238     tId.dfScp := blk;
 239     tId.hash  := NameHash.enterStr(nam);
 240     jnk := blk.symTb.enter(tId.hash, tId);
 241   END MkDummyAlias;
 242
 243 (* ------------------------------------------------------------ *)
 244
 245   PROCEDURE SetPtrBase*(cls, bas : IdDesc.TypId);
 246     VAR ptrC : Typ.Pointer;
 247         recC : Typ.Record;
 248     VAR ptrB : Typ.Pointer;
 249         recB : Typ.Record;
 250   BEGIN
 251     ptrC := cls.type(Typ.Pointer);
 252     recC := ptrC.boundTp(Typ.Record);
 253     ptrB := bas.type(Typ.Pointer);
 254     recB := ptrB.boundTp(Typ.Record);
 255     recC.baseTp := recB;
 256   END SetPtrBase;
 257
 258 (* ============================================================ *)
 259
 260   PROCEDURE InitAnyRec(ord : INTEGER);
 261     VAR base : Typ.Base;
 262         tpId : IdDesc.TypId;
 263   BEGIN
 264     base := Typ.anyRecTp;
 265     tpId := IdDesc.newTypId(base);
 266     anyRec := base;
 267     anyTpId := tpId;
 268     base.idnt  := tpId;
 269     base.tpOrd := ord;
 270     base.dump  := ord;
 271     baseTypeArray[ord] := base;
 272   END InitAnyRec;
 273
 274   PROCEDURE InitAnyPtr(ord : INTEGER);
 275     VAR base : Typ.Base;
 276         tpId : IdDesc.TypId;
 277   BEGIN
 278     base := Typ.anyPtrTp;
 279     tpId := IdDesc.newTypId(base);
 280     anyPtr := base;
 281     base.idnt  := tpId;
 282     base.tpOrd := ord;
 283     base.dump  := ord;
 284     baseTypeArray[ord] := base;
 285   END InitAnyPtr;
 286
 287 (* -------------------------------------------- *)
 288
 289   PROCEDURE StdType(ord : INTEGER; OUT var : Symbols.Type);
 290     VAR base : Typ.Base;
 291         tpId : IdDesc.TypId;
 292   BEGIN
 293     base := Typ.newBasTp();
 294     tpId := IdDesc.newTypId(base);
 295     base.idnt  := tpId;
 296     base.tpOrd := ord;
 297     base.dump  := ord;
 298     var := base;
 299     baseTypeArray[ord] := base;
 300   END StdType;
 301
 302 (* -------------------------------------------- *)
 303
 304   PROCEDURE StdConst(typ : Symbols.Type; OUT var : Symbols.Idnt);
 305     VAR conD : IdDesc.ConId;
 306   BEGIN
 307     conD := IdDesc.newConId();
 308     conD.SetStd();
 309     conD.type  := typ;
 310     var := conD;
 311   END StdConst;
 312
 313 (* -------------------------------------------- *)
 314
 315   PROCEDURE StdFunc(ord : INTEGER; OUT var : Symbols.Idnt);
 316     VAR proc : IdDesc.PrcId;
 317   BEGIN
 318     proc := IdDesc.newPrcId();
 319     proc.SetKind(IdDesc.conPrc);
 320     proc.SetOrd(ord);
 321     proc.type := dummyFuncType;
 322     var := proc;
 323   END StdFunc;
 324
 325 (* -------------------------------------------- *)
 326
 327   PROCEDURE StdProc(ord : INTEGER; OUT var : Symbols.Idnt);
 328     VAR proc : IdDesc.PrcId;
 329   BEGIN
 330     proc := IdDesc.newPrcId();
 331     proc.SetKind(IdDesc.conPrc);
 332     proc.SetOrd(ord);
 333     proc.type := dummyProcType;
 334     var := proc;
 335   END StdProc;
 336
 337 (* -------------------------------------------- *)
 338
 339   PROCEDURE BindName(var : Symbols.Idnt; IN str : ARRAY OF CHAR);
 340     VAR hash : INTEGER;
 341         temp : IdDesc.BlkId;
 342   BEGIN
 343     hash := NameHash.enterStr(str);
 344     var.hash := hash;
 345     var.dfScp := NIL;
 346     var.SetNameFromString(BOX(str$));
 347     ASSERT(CompState.thisMod.symTb.enter(hash, var));
 348   END BindName;
 349
 350 (* -------------------------------------------- *)
 351
 352   PROCEDURE BindSysName(var : Symbols.Idnt; IN str : ARRAY OF CHAR);
 353     VAR hash : INTEGER;
 354         temp : IdDesc.BlkId;
 355   BEGIN
 356     hash := NameHash.enterStr(str);
 357     var.hash := hash;
 358     var.dfScp := NIL;
 359     ASSERT(CompState.sysMod.symTb.enter(hash, var));
 360   END BindSysName;
 361
 362 (* -------------------------------------------- *)
 363
 364   PROCEDURE RebindBuiltins*;
 365   BEGIN
 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>");
 389
 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");
 410
 411     BindSysName(adrPd, "ADR");
 412     BindSysName(getPd, "GET");
 413     BindSysName(putPd, "PUT");
 414
 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");
 427
 428     BindName(trueC, "TRUE");
 429     BindName(falsC, "FALSE");
 430     BindName(infC,  "INF");
 431     BindName(nInfC, "NEGINF");
 432     BindName(nilC,  "NIL");
 433
 434     CompState.sysMod.hash := sysBkt;
 435   END RebindBuiltins;
 436
 437 (* -------------------------------------------- *)
 438
 439   PROCEDURE InitBuiltins*;
 440   BEGIN
 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);
 453 (*
 454     StdType(Typ.anyPtr,anyPtr);
 455  *)
 456     StdType(Typ.setN,  setTp);
 457     StdType(Typ.strN,  strTp);
 458     StdType(Typ.sStrN, sStrTp);
 459     StdType(Typ.metaN, metaTp);
 460
 461     dummyProcType := Typ.newPrcTp();
 462     dummyFuncType := Typ.newPrcTp();
 463     dummyFuncType.retType := anyPtr;
 464
 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);
 485
 486     StdFunc(adrP,  adrPd);
 487     StdProc(getP,  getPd);
 488     StdProc(putP,  putPd);
 489
 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);
 502
 503     StdConst(boolTp, trueC);
 504     StdConst(boolTp, falsC);
 505     StdConst(sReaTp, infC);
 506     StdConst(sReaTp, nInfC);
 507     StdConst(anyPtr, nilC);
 508   END InitBuiltins;
 509
 510 (* ============================================================ *)
 511 END Builtin.  (* ============================================== *)
 512 (* ============================================================ *)
 513