home *** CD-ROM | disk | FTP | other *** search
/ Gold Fish 3 / goldfish_volume_3.bin / files / dev / obero / oberon-a / source / oc / oct.mod < prev   
Encoding:
Text File  |  1995-06-29  |  49.5 KB  |  1,659 lines
  1. (*************************************************************************
  2.  
  3.      $RCSfile: OCT.mod $
  4.   Description: Symbol table handler
  5.  
  6.    Created by: fjc (Frank Copeland)
  7.     $Revision: 5.23 $
  8.       $Author: fjc $
  9.         $Date: 1995/06/29 19:10:08 $
  10.  
  11.   Copyright © 1990-1993, ETH Zuerich
  12.   Copyright © 1993-1995, Frank Copeland
  13.   This module forms part of the OC program
  14.   See OC.doc for conditions of use and distribution
  15.  
  16.   Log entries are at the end of the file.
  17.  
  18. *************************************************************************)
  19.  
  20. <* STANDARD- *> <* MAIN- *>
  21.  
  22. MODULE OCT;
  23.  
  24. IMPORT
  25.   SYS := SYSTEM, E := Exec, Str := Strings, DU := DosUtil,
  26.   F := Files, OCM, OCS, conv := Conversions, OCStrings, OCOut;
  27.  
  28.  
  29. (* --- Exported declarations -------------------------------------------- *)
  30.  
  31. CONST
  32.   maxImps = 64;
  33.  
  34.   (* structure forms *)
  35.   Undef * = 0; Byte * = 1; Bool * = 2; Char * = 3; SInt * = 4; Int * = 5;
  36.   LInt * = 6; Real * = 7; LReal * = 8; BSet * = 9; WSet * = 10; Set * = 11;
  37.   String * = 12; NilTyp * = 13; NoTyp * = 14; PtrTyp * = 15; AdrTyp * = 16;
  38.   BPtrTyp * = 17; Word * = 18; Longword * = 19; TagTyp * = 20;
  39.   Pointer * = 21; ProcTyp * = 24; Array * = 25; DynArr * = 26;
  40.   Record * = 27;
  41.  
  42.   (* standard procedure codes *)
  43.   pABS * = 0; pCAP * = 1; pCHR * = 2; pENTIER * = 3; pHALT * = 4;
  44.   pLONG * = 5; pMAX * = 6; pMIN * = 7; pNEW * = 8; pODD * = 9;
  45.   pORD * = 10; pSHORT * = 11;
  46.  
  47.   pASH * = 19; pASSERT * = 20; pCOPY * = 21; pDEC * = 22; pEXCL * = 23;
  48.   pINC * = 24; pINCL * = 25; pLEN * = 26;
  49.  
  50.   (* module SYSTEM procedure codes *)
  51.   pADR * = 12; pCC * = 13; pDISPOSE * = 14; pREG * = 15; pSIZE * = 16;
  52.   pSTRLEN * = 17; pTAG * = 18;
  53.  
  54.   pAND * = 27; pBIT * = 28; pGET * = 29; pGETREG * = 30; pLSH * = 31;
  55.   pOR * = 32; pPUT * = 33; pPUTREG * = 34; pSETREG * = pPUTREG;
  56.   pROT * = 35; pVAL * = 36; pXOR * = 37;
  57.  
  58.   pINLINE * = 38; pMOVE * = 39; pSYSNEW * = 40;
  59.  
  60.   LastProc * = pSYSNEW;
  61.   TwoPar * = pASH;
  62.  
  63.   (* String lengths *)
  64.  
  65.   NameLen * = 255;
  66.   PathLen = 256;
  67.   LabelLen = NameLen * 2 + 1;
  68.  
  69.   (* Values for visible field of ObjDesc *)
  70.  
  71.   Exp * = -1;
  72.   NotExp * = 0;
  73.   RdOnly * = 1;
  74.  
  75. TYPE
  76.   Name = ARRAY NameLen + 1 OF CHAR;
  77.   Label * = POINTER TO ARRAY (*LabelLen*) OF CHAR;
  78.  
  79.   Object * = POINTER TO ObjDesc;
  80.   Module * = POINTER TO ModDesc;
  81.   Struct * = POINTER TO StrDesc;
  82.  
  83.   ObjDesc * = RECORD
  84.     left *, right *, link * : Object;
  85.     typ * : Struct;
  86.     a0 *, a1 *, a2 * : LONGINT;
  87.     fwd * : BOOLEAN;
  88.     mode * : SHORTINT;
  89.     visible * : SHORTINT;
  90.     name * : LONGINT;
  91.     label * : Label;
  92.   END; (* ObjDesc *)
  93.  
  94.   ModDesc * = RECORD (ObjDesc)
  95.     varLab *, constLab *, gcLab *, endLab * : Label;
  96.   END; (* ModDesc *)
  97.  
  98.   StrDesc * = RECORD
  99.     form *, sysflg *, mno *, ref * : INTEGER;
  100.     n *, size *, adr * : LONGINT;
  101.     BaseTyp * : Struct;
  102.     link *, strobj * : Object;
  103.     label * : Label;
  104.   END; (* StrDesc *)
  105.  
  106.   Desc * = POINTER TO DescRec;
  107.   DescRec = RECORD
  108.     next : Desc;
  109.     mode *, lev * : INTEGER;
  110.     a0 *, a1 *, a2 * : LONGINT;
  111.   END; (* DescRec *)
  112.  
  113.   Item * = RECORD
  114.     mode *, lev * : INTEGER;
  115.     a0 *, a1 *, a2 * : LONGINT;
  116.     typ * : Struct;
  117.     obj * : Object;
  118.     label * : Label;
  119.     wordIndex *, rdOnly * : BOOLEAN;
  120.     desc * : Desc
  121.   END; (* Item *)
  122.  
  123. VAR
  124.   topScope * : Object;
  125.  
  126.   undftyp *, bytetyp *, booltyp *, chartyp *, sinttyp *, inttyp *,
  127.   linttyp *, realtyp *, lrltyp *, settyp *, stringtyp *, niltyp *, notyp *,
  128.   ptrtyp *, adrtyp *, bptrtyp *, bsettyp *, wsettyp *, wordtyp *,
  129.   lwordtyp *, tagtyp *
  130.     : Struct;
  131.  
  132.   nofGmod * : INTEGER; (* nof imports *)
  133.   GlbMod * : ARRAY maxImps OF Module;
  134.  
  135.   ModuleName * : Name;
  136.  
  137.   VarLabel *, ConstLabel *, InitLabel *, EndLabel *, GCLabel *,
  138.   PointerDesc *
  139.     : Label;
  140.  
  141.  
  142. (* --- Local declarations ----------------------------------------------- *)
  143.  
  144.  
  145. CONST
  146.   (* object modes *)
  147.   Var = OCM.Var; VarX = OCM.VarX; Ind = OCM.Ind; IndX = OCM.IndX;
  148.   Con = OCM.Con; Reg = OCM.Reg; RegI = OCM.RegI; RegX = OCM.RegX;
  149.   Fld = OCM.Fld; Typ = OCM.Typ; LProc = OCM.LProc; XProc = OCM.XProc;
  150.   SProc = OCM.SProc; LibCall = OCM.LibCall; TProc = OCM.TProc;
  151.   AProc = OCM.AProc; Mod = OCM.Mod; Head = OCM.Head; VarArg = OCM.VarArg;
  152.   M2Proc = OCM.M2Proc; CProc = OCM.CProc; CallBack = OCM.CallBack;
  153.   VarR = OCM.VarR; IndR = OCM.IndR;
  154.  
  155.   (* System flags *)
  156.  
  157.   OberonFlag = OCM.OberonFlag; M2Flag = OCM.M2Flag; CFlag = OCM.CFlag;
  158.   AsmFlag = OCM.AsmFlag; BCPLFlag = OCM.BCPLFlag; CBackFlag = OCM.CBackFlag;
  159.  
  160.   SFtag * = 53594D08H; (* "SYM" + version # *)
  161.   MinSFtag = 53594D08H; (* Earliest version that can be read. *)
  162.   firstStr = 32; maxStr = 512;
  163.   maxUDP = 128; maxMod = 32; maxParLev = 6; maxExtLib = 8;
  164.   NotYetExp = 0;
  165.  
  166.   (* terminal symbols for symbol file elements *)
  167.   eUndef = 0; eCon = 1; eTypE = 2; eTyp = 3; eVar = 4; eXProc = 5;
  168.   eLibCall = 6; eM2Proc = 7; eCProc = 8; eAProc = 9; ePointer = 10;
  169.   eProcTyp = 11; eArray = 12; eDynArr = 13; eRecord = 14; eParList = 15;
  170.   eValPar = 16; eVarPar = 17; eVarArg = 18; eFldList = 19; eFld = 20;
  171.   eHPtr = 21; eHProc = 22; eTProcE = 23; eTProc = 24; eFixup = 25;
  172.   eMod = 26; eExtLib = 27; eCallBack = 28; eCBackTyp = 29;
  173.  
  174.   (* name buffer size *)
  175.  
  176.   BufSize = 16384;
  177.   MaxBuffers = 16;
  178.   HashTableSize = 251;
  179.  
  180. TYPE
  181.  
  182.   NameBufPtr = POINTER TO ARRAY BufSize OF CHAR;
  183.  
  184. VAR
  185.   universe, syslink : Object;
  186.   strno, udpinx : INTEGER; (* for export *)
  187.   nofExp : SHORTINT;
  188.   SR : F.Rider;
  189.   undPtr : ARRAY maxUDP OF Struct;
  190.   nameBuf : ARRAY MaxBuffers OF NameBufPtr;
  191.   nameX, nameOrg, nameSize : LONGINT;
  192.   nameTab, backupTab : ARRAY HashTableSize OF LONGINT;
  193.  
  194.   nofExtLib : INTEGER;
  195.   extLib : ARRAY maxExtLib OF LONGINT;
  196.  
  197.  
  198. (*--- Procedure declarations -------------------------------------------*)
  199.  
  200.  
  201. (*------------------------------------*)
  202. PROCEDURE Tagged * ( typ : Struct ) : BOOLEAN;
  203. BEGIN (* Tagged *)
  204.   RETURN ((typ.form IN {Record, Pointer}) & (typ.sysflg = OberonFlag))
  205. END Tagged;
  206.  
  207. (*------------------------------------*)
  208. PROCEDURE Address * ( typ : Struct ) : BOOLEAN;
  209. BEGIN (* Address *)
  210.   RETURN
  211.     ((typ.form = Pointer) & (typ.sysflg IN {M2Flag, CFlag, AsmFlag}))
  212.     OR (typ.form = AdrTyp) OR (typ.form = NilTyp)
  213. END Address;
  214.  
  215. (*------------------------------------*)
  216. PROCEDURE IsParam * (obj : Object) : BOOLEAN;
  217.  
  218. BEGIN (* IsParam *)
  219.   RETURN (obj # NIL)
  220.        & (obj.mode IN {Var, VarR, VarArg, Ind, IndR})
  221.        & (obj.a0 >= 0)
  222. END IsParam;
  223.  
  224. (*------------------------------------*)
  225. PROCEDURE Init * ();
  226.  
  227. BEGIN (* Init *)
  228.   topScope := universe; strno := 0; udpinx := 0; nofGmod := 0;
  229.   ModuleName := ""; COPY ("VAR", VarLabel^); COPY ("CONST", ConstLabel^);
  230.   COPY ("INIT", InitLabel^); COPY ("END", EndLabel^); COPY ("GC", GCLabel^);
  231.   nofExtLib := 0;
  232. END Init;
  233.  
  234. (*------------------------------------*)
  235. PROCEDURE Close * ();
  236.  
  237.   VAR i : INTEGER;
  238.  
  239. BEGIN (* Close *)
  240.   F.Set (SR, NIL, 0);
  241.   i := 0; WHILE i < maxImps DO GlbMod [i] := NIL; INC (i) END;
  242.   (* Restore original hash table for reserved names... *)
  243.   nameTab := backupTab; nameX := nameOrg;
  244.   (* ... Assuming that only one name buffer is required *)
  245.   nameSize := BufSize;
  246.   i := 1; WHILE i < MaxBuffers DO nameBuf [i] := NIL; INC (i) END
  247. END Close;
  248.  
  249. (*------------------------------------*)
  250. PROCEDURE^ Join (module, object : LONGINT; VAR name : ARRAY OF CHAR);
  251. PROCEDURE^ InsertName * (n : ARRAY OF CHAR) : LONGINT;
  252.  
  253. PROCEDURE StartModule * ();
  254.  
  255.   VAR mn : LONGINT;
  256.  
  257. BEGIN (* StartModule *)
  258.   mn := InsertName (ModuleName);
  259.   Join (mn, InsertName ("VAR"), VarLabel^);
  260.   Join (mn, InsertName ("CONST"), ConstLabel^);
  261.   Join (mn, InsertName ("GC-OFFSET"), GCLabel^);
  262. END StartModule;
  263.  
  264. (*------------------------------------*)
  265. PROCEDURE ExtLib * ();
  266. BEGIN (* ExtLib *)
  267.   IF nofExtLib >= maxExtLib THEN OCS.Mark (234); nofExtLib := 0 END;
  268.   extLib [nofExtLib] := InsertName (OCS.name); INC (nofExtLib)
  269. END ExtLib;
  270.  
  271. (*------------------------------------*)
  272. PROCEDURE EndModule * ();
  273.  
  274. BEGIN (* EndModule *)
  275. END EndModule;
  276.  
  277. (*------------------------------------*)
  278. PROCEDURE CheckBuf (size : LONGINT);
  279.  
  280.   VAR newBuf : NameBufPtr; newX : LONGINT;
  281.  
  282. BEGIN (* CheckBuf *)
  283.   newX := nameX + size + 4;
  284.   IF newX >= nameSize THEN
  285.     IF newX >= BufSize * MaxBuffers THEN
  286.       OCS.Mark (310); nameX := 0
  287.     ELSE
  288.       IF ((newX-1) MOD BufSize) < (size+4) THEN nameX := nameSize END;
  289.       NEW (newBuf);
  290.       INC (nameSize, BufSize);
  291.       nameBuf [(nameSize - 1) DIV BufSize] := newBuf
  292.     END
  293.   END
  294. END CheckBuf;
  295.  
  296. (*------------------------------------*)
  297. PROCEDURE InsertName * (n : ARRAY OF CHAR) : LONGINT;
  298.  
  299.   VAR i, j, k, len, bufX : INTEGER; x, x1 : LONGINT; ch : CHAR;
  300.       buf : NameBufPtr;
  301.  
  302. <*$CopyArrays-*>
  303. BEGIN (* InsertName *)
  304.   k := 0; len := 0; ch := n [0];
  305.   WHILE ch # 0X DO
  306.     <*$ < OvflChk- *>
  307.     INC (k, ORD (ch));
  308.     <*$ > *>
  309.     INC (len); ch := n [len]
  310.   END;
  311.   k := (k + len) MOD HashTableSize;
  312.   x := nameTab [k];
  313.   LOOP
  314.     IF x = 0 THEN
  315.       CheckBuf (len);
  316.       buf := nameBuf [nameX DIV BufSize];
  317.       bufX := SHORT (nameX MOD BufSize);
  318.       buf [bufX] := CHR (nameTab [k] DIV 10000H); INC (bufX);
  319.       buf [bufX] := CHR (nameTab [k] DIV 100H);   INC (bufX);
  320.       buf [bufX] := CHR (nameTab [k]);            INC (bufX);
  321.       i := 0;
  322.       WHILE i <= len DO buf [bufX] := n [i]; INC (bufX); INC (i) END;
  323.       x := nameX + 3; nameTab [k] := x; nameX := nameX + len + 4;
  324.       RETURN x
  325.     ELSE
  326.       buf := nameBuf [x DIV BufSize];
  327.       bufX := SHORT (x MOD BufSize);
  328.       x1 :=
  329.         (LONG (ORD (buf [bufX - 3])) * 10000H)
  330.         + (LONG (ORD (buf [bufX - 2])) * 100H)
  331.         + LONG (ORD (buf [bufX - 1]));
  332.       i := bufX; j := 0;
  333.       LOOP
  334.         IF buf [i] # n [j] THEN
  335.           x := x1; EXIT
  336.         ELSIF n [j] = 0X THEN
  337.           RETURN x
  338.         ELSE
  339.           INC (i); INC (j)
  340.         END
  341.       END
  342.     END; (* ELSE *)
  343.   END; (* LOOP *)
  344. END InsertName;
  345.  
  346. (*------------------------------------*)
  347. PROCEDURE NameLength (name : LONGINT) : INTEGER;
  348.  
  349.   VAR buf : NameBufPtr; len, bufX : INTEGER;
  350.  
  351. BEGIN (* NameLength *)
  352.   buf := nameBuf [name DIV BufSize];
  353.   bufX := SHORT (name MOD BufSize);
  354.   len := 0;
  355.   WHILE buf [bufX] # 0X DO INC (len); INC (bufX) END;
  356.   RETURN len
  357. END NameLength;
  358.  
  359. (*------------------------------------*)
  360. PROCEDURE GetName * (adr : LONGINT; VAR name : ARRAY OF CHAR);
  361.  
  362.   VAR buf : NameBufPtr; i, bufX : INTEGER; ch :  CHAR;
  363.  
  364. BEGIN (* GetName *)
  365.   buf := nameBuf [adr DIV BufSize];
  366.   bufX := SHORT (adr MOD BufSize);
  367.   i := 0;
  368.   REPEAT
  369.     ch := buf [bufX]; name [i] := ch;
  370.     INC (i); INC (bufX)
  371.   UNTIL ch = 0X;
  372. END GetName;
  373.  
  374. (*------------------------------------*)
  375. PROCEDURE FindObj (obj : Object; name : ARRAY OF CHAR) : Object;
  376.  
  377.   VAR
  378.     buf : NameBufPtr; n1, n2 : LONGINT; bufX, i : INTEGER; ch1, ch2 : CHAR;
  379.  
  380. <*$CopyArrays-*>
  381. BEGIN (* FindObj *)
  382.   n1 := InsertName (name);
  383.   WHILE (obj # NIL) & (obj.name # n1) DO
  384.     n2 := obj.name; i := 0;
  385.     buf := nameBuf [n2 DIV BufSize]; bufX := SHORT (n2 MOD BufSize);
  386.     REPEAT
  387.       ch1 := name [i]; INC (i);
  388.       ch2 := buf [bufX]; INC (bufX)
  389.     UNTIL ch1 # ch2;
  390.     IF ch1 < ch2 THEN obj := obj.left
  391.     ELSE obj := obj.right
  392.     END
  393.   END;
  394.   RETURN obj
  395. END FindObj;
  396.  
  397. (*------------------------------------*)
  398. PROCEDURE FindImport * (mod : Object; VAR res : Object);
  399.  
  400.   VAR obj : Object;
  401.  
  402. BEGIN (* FindImport *)
  403.   obj := FindObj (mod.link, OCS.name);
  404.   IF (obj # NIL) & (obj.mode = Typ) & (obj.visible = NotExp) THEN
  405.     obj := NIL
  406.   END;
  407.   res := obj
  408. END FindImport;
  409.  
  410. (*------------------------------------*)
  411. PROCEDURE Find * (VAR res : Object; VAR level : INTEGER);
  412.  
  413.   VAR obj, head : Object;
  414.  
  415. BEGIN (* Find *)
  416.   head := topScope;
  417.   LOOP
  418.     obj := FindObj (head.link, OCS.name);
  419.     IF obj # NIL THEN level := SHORT (head.a0); EXIT END;
  420.     head := head.left;
  421.     IF head = NIL THEN level := 0; EXIT END;
  422.   END;
  423.   res := obj;
  424. END Find;
  425.  
  426. (*------------------------------------*)
  427. PROCEDURE FindField * (typ : Struct; VAR res : Object);
  428.  
  429.   VAR obj : Object; typ1 : Struct; n : LONGINT;
  430.  
  431. BEGIN (* FindField *)
  432.   (* typ.form = Record *)
  433.   typ1 := typ; n := InsertName (OCS.name);
  434.   LOOP
  435.     obj := typ1.link;
  436.     WHILE (obj # NIL) & (obj.name # n) DO obj := obj.left END;
  437.     IF obj # NIL THEN EXIT END;
  438.     typ1 := typ1.BaseTyp;
  439.     IF typ1 = NIL THEN EXIT END
  440.   END;
  441.   res := obj;
  442. END FindField;
  443.  
  444. (*------------------------------------*)
  445. PROCEDURE SuperCall * (pname : LONGINT; typ : Struct; VAR proc : Object);
  446.  
  447.   VAR obj : Object;
  448.  
  449. BEGIN (* SuperCall *)
  450.   obj := NIL;
  451.   IF (typ # NIL) & (typ.form = Pointer) THEN typ := typ.BaseTyp END;
  452.   IF (typ # NIL) & (typ # undftyp) THEN
  453.     LOOP
  454.       typ := typ.BaseTyp;
  455.       IF typ = NIL THEN EXIT END;
  456.       obj := typ.link;
  457.       WHILE (obj # NIL) & ((obj.mode # TProc) OR (obj.name # pname)) DO
  458.         obj := obj.left
  459.       END;
  460.       IF obj # NIL THEN EXIT END
  461.     END
  462.   END;
  463.   proc := obj
  464. END SuperCall;
  465.  
  466. (*------------------------------------*)
  467. PROCEDURE NextProc * (typ : Struct) : LONGINT;
  468.  
  469.   VAR pno : LONGINT; obj : Object;
  470.  
  471. BEGIN (* NextProc *)
  472.   (* typ.form = Record *)
  473.   pno := 0;
  474.   REPEAT
  475.     obj := typ.link;
  476.     WHILE obj # NIL DO
  477.       IF (obj.mode = TProc) & (obj.a0 > pno) THEN pno := obj.a0 END;
  478.       obj := obj.left
  479.     END;
  480.     typ := typ.BaseTyp;
  481.   UNTIL typ = NIL;
  482.   RETURN pno + 1
  483. END NextProc;
  484.  
  485. (*------------------------------------*)
  486. PROCEDURE InsertObj
  487.   ( VAR name : ARRAY OF CHAR; root : Object; mode : SHORTINT;
  488.     VAR res : Object ) : BOOLEAN;
  489.  
  490.   VAR
  491.     obj, prev : Object; mod : Module; result : BOOLEAN;
  492.     buf : NameBufPtr; n1, n2 : LONGINT; bufX, i : INTEGER; ch1, ch2 : CHAR;
  493.  
  494. BEGIN (* InsertObj *)
  495.  
  496.   prev := root; obj := root.link; n1 := InsertName (name);
  497.   WHILE (obj # NIL) & (obj.name # n1) DO
  498.     prev := obj; n2 := obj.name; i := 0;
  499.     buf := nameBuf [n2 DIV BufSize]; bufX := SHORT (n2 MOD BufSize);
  500.     REPEAT
  501.       ch1 := name [i]; INC (i);
  502.       ch2 := buf [bufX]; INC (bufX)
  503.     UNTIL ch1 # ch2;
  504.     IF ch1 < ch2 THEN obj := obj.left
  505.     ELSE obj := obj.right
  506.     END
  507.   END;
  508.   IF obj = NIL THEN
  509.     IF mode = Mod THEN NEW (mod); obj := mod
  510.     ELSE NEW (obj)
  511.     END;
  512.     obj.name := n1; obj.mode := mode;
  513.     IF prev = root THEN
  514.       root.link := obj
  515.     ELSE
  516.       IF ch1 < ch2 THEN prev.left := obj
  517.       ELSE prev.right := obj
  518.       END
  519.     END;
  520.     result := TRUE
  521.   ELSE
  522.     result := FALSE
  523.   END;
  524.   res := obj;
  525.   RETURN result
  526. END InsertObj;
  527.  
  528. (*------------------------------------*)
  529. PROCEDURE Insert *
  530.   ( VAR name : ARRAY OF CHAR; VAR res : Object; mode : SHORTINT );
  531.  
  532. BEGIN (* Insert *)
  533.   IF ~InsertObj (name, topScope, mode, res) THEN
  534.     IF res.mode # Undef THEN OCS.Mark (1) END;
  535.     res.mode := mode
  536.   END
  537. END Insert;
  538.  
  539. (*------------------------------------*)
  540. PROCEDURE OpenScope * (level : INTEGER);
  541.  
  542.   VAR head : Object;
  543.  
  544. BEGIN (* OpenScope *)
  545.   NEW (head);
  546.   head.mode := Head; head.a0 := level; head.left := topScope;
  547.   topScope := head;
  548. END OpenScope;
  549.  
  550. (*------------------------------------*)
  551. PROCEDURE CloseScope * ();
  552.  
  553. BEGIN (* CloseScope *)
  554.   topScope := topScope.left;
  555. END CloseScope;
  556.  
  557.  
  558. (*--- SYMBOLS ---------------------------------*)
  559.  
  560.  
  561. (*------------------------------------*)
  562. PROCEDURE Join (name1, name2 : LONGINT; VAR name : ARRAY OF CHAR);
  563.  
  564.   VAR src, dst : INTEGER; buf : NameBufPtr; ch : CHAR;
  565.  
  566. BEGIN (* Join *)
  567.   dst := 0;
  568.  
  569.   buf := nameBuf [name1 DIV BufSize];
  570.   src := SHORT (name1 MOD BufSize);
  571.   ch := buf [src];
  572.   WHILE ch # 0X DO
  573.     name [dst] := ch; INC (src); INC (dst); ch := buf [src]
  574.   END; (* WHILE *)
  575.  
  576.   name [dst] := "_"; INC (dst);
  577.  
  578.   buf := nameBuf [name2 DIV BufSize];
  579.   src := SHORT (name2 MOD BufSize);
  580.   ch := buf [src];
  581.   WHILE ch # 0X DO
  582.     name [dst] := ch; INC (src); INC (dst); ch := buf [src]
  583.   END; (* WHILE *)
  584.  
  585.   name [dst] := 0X
  586. END Join;
  587.  
  588. (*------------------------------------*)
  589. PROCEDURE MakeLabel (moduleName, name : LONGINT; VAR label : Label);
  590.  
  591. BEGIN (* MakeLabel *)
  592.   IF label = NIL THEN
  593.     NEW (label, NameLength (moduleName) + NameLength (name) + 4)
  594.   END;
  595.   Join (moduleName, name, label^)
  596. END MakeLabel;
  597.  
  598. (*------------------------------------*)
  599. PROCEDURE MakeInitProcLabel (module, key : LONGINT; VAR label : Label);
  600.  
  601.   VAR
  602.     keyPart : ARRAY 10 OF CHAR;
  603.     modname : ARRAY 40 OF CHAR;
  604.  
  605. BEGIN (* MakeInitProcLabel *)
  606.   GetName (module, modname);
  607.   ASSERT (conv.IntToStr (key, 16, 9, "0", keyPart));
  608.   IF label = NIL THEN NEW (label, Str.Length (modname) + 16) END;
  609.   COPY (modname, label^); Str.Append ("_", label^);
  610.   Str.Append (keyPart, label^);
  611.   IF OCM.SmallData THEN Str.Append ("INITs", label^)
  612.   ELSIF OCM.Resident THEN Str.Append ("INITr", label^)
  613.   ELSE Str.Append ("INIT", label^)
  614.   END;
  615. END MakeInitProcLabel;
  616.  
  617. (*------------------------------------*)
  618. PROCEDURE MakeProcLabel * (obj : Object);
  619.  
  620.   VAR pnoPart : ARRAY 6 OF CHAR; mn : LONGINT;
  621.  
  622. BEGIN (* MakeProcLabel *)
  623.   IF obj.a0 = 0 THEN
  624.     MakeLabel (InsertName (ModuleName), obj.name, obj.label);
  625.   ELSE
  626.     ASSERT (conv.IntToStr (obj.a0, 10, 0, "0", pnoPart));
  627.     NEW (obj.label, Str.Length (ModuleName) + Str.Length (pnoPart) + 4);
  628.     COPY (ModuleName, obj.label^);
  629.     Str.Append ("_", obj.label^);
  630.     Str.Append (pnoPart, obj.label^);
  631.     Str.Append ("P", obj.label^)
  632.   END
  633. END MakeProcLabel;
  634.  
  635. (*------------------------------------*)
  636. PROCEDURE MakeTypeLabel * (typ : Struct);
  637.  
  638.   VAR
  639.     label : ARRAY LabelLen OF CHAR; typname : Name;
  640.     typnum : ARRAY 16 OF CHAR;
  641.  
  642. BEGIN (* MakeTypeLabel *)
  643.   IF
  644.     (typ.label = NIL) & (typ.sysflg = OberonFlag) &
  645.     ( (typ.form = Record) OR
  646.       ((typ.form = Pointer) & (typ.BaseTyp.form = DynArr)))
  647.   THEN
  648.     IF typ.mno > 0 THEN GetName (GlbMod [typ.mno-1].name, label)
  649.     ELSE COPY (ModuleName, label)
  650.     END;
  651.     Str.Append ("_", label);
  652.     ASSERT (conv.IntToStr (typ.adr, 10, 0, "0", typnum));
  653.     Str.Append (typnum, label); Str.Append ("T", label);
  654.     NEW (typ.label, Str.Length (label) + 1);
  655.     COPY (label, typ.label^)
  656.   END
  657. END MakeTypeLabel;
  658.  
  659. (*------------------------------------*)
  660. PROCEDURE MakeTProcLabel * (typ : Struct; proc : Object);
  661.  
  662.   VAR
  663.     modname, typname, procname : Name; typnum : ARRAY 16 OF CHAR;
  664.     label : ARRAY LabelLen OF CHAR;
  665.  
  666. BEGIN (* MakeTProcLabel *)
  667.   IF typ.mno > 0 THEN GetName (GlbMod [typ.mno-1].name, label)
  668.   ELSE COPY (ModuleName, label)
  669.   END;
  670.   Str.Append ("_", label);
  671.   ASSERT (conv.IntToStr (typ.adr, 10, 0, "0", typnum));
  672.   Str.Append (typnum, label); Str.Append ("T_", label);
  673.   GetName (proc.name, procname); Str.Append (procname, label);
  674.   NEW (proc.label, Str.Length (label) + 1);
  675.   COPY (label, proc.label^)
  676. END MakeTProcLabel;
  677.  
  678. (*--- IMPORT ---------------------------------*)
  679.  
  680. (*------------------------------------*)
  681. PROCEDURE ReadInt(VAR i: LONGINT);
  682. (*
  683.   Reads integers written in a compacted form. Taken from J. Templ.
  684.   SPARC-Oberon. User's Guide and Implementation. Computersysteme ETH
  685.   Zürich, Technical Report No. 133, June 1990.
  686. *)
  687.  
  688.   VAR n: LONGINT; s: INTEGER; x: CHAR;
  689.  
  690. BEGIN
  691.   s := 0; n := 0; F.Read(SR, x);
  692.   WHILE ORD(x) >= 128 DO
  693.     INC(n, ASH(ORD(x) - 128, s)); INC(s, 7); F.Read(SR, x)
  694.   END;
  695.   i := n + ASH(ORD(x) MOD 64 - ORD(x) DIV 64 * 64, s)
  696. END ReadInt;
  697.  
  698. (*------------------------------------*)
  699. PROCEDURE ReadLInt (VAR k : LONGINT);
  700.  
  701. BEGIN (* ReadLInt *)
  702.   F.ReadBytes (SR, k, 4);
  703. END ReadLInt;
  704.  
  705. (*------------------------------------*)
  706. PROCEDURE ReadId (VAR id : ARRAY OF CHAR);
  707.  
  708.   VAR i : INTEGER; ch : CHAR;
  709.  
  710. BEGIN (* ReadId *)
  711.   i := 0;
  712.   REPEAT
  713.     F.Read (SR, ch); id [i] := ch; INC (i)
  714.   UNTIL ch = 0X;
  715. END ReadId;
  716.  
  717. (*-----------------------------------*)
  718. PROCEDURE Import * (name, alias : ARRAY OF CHAR);
  719.  
  720.   VAR
  721.     i, m, s, nofLmod, strno, parlev, fldlev : INTEGER;
  722.     k, l, modname : LONGINT;
  723.     obj : Object;
  724.     modobj : Module;
  725.     class : SHORTINT;
  726.     SymFile : F.File;
  727.     LocMod : ARRAY maxMod OF Module;
  728.     struct : ARRAY maxStr OF Struct;
  729.     lastpar, lastfld : ARRAY maxParLev OF Object;
  730.     pathName : ARRAY 256 OF CHAR;
  731.  
  732.     link : Object;
  733.     typ : Struct;
  734.     a0, a1, a2 : LONGINT;
  735.     mode : SHORTINT;
  736.     visible : SHORTINT;
  737.     label : Label;
  738.     objName : ARRAY NameLen+1 OF CHAR;
  739.  
  740.   (*------------------------------------*)
  741.   PROCEDURE reversedList (p : Object) : Object;
  742.  
  743.     VAR q, r : Object;
  744.  
  745.   BEGIN (* reversedList *)
  746.     q := NIL;
  747.     WHILE p # NIL DO r := p.link; p.link := q; q := p; p := r END;
  748.     RETURN q
  749.   END reversedList;
  750.  
  751. <*$CopyArrays-*>
  752. BEGIN (* Import *)
  753.   nofLmod := 0; strno := firstStr; parlev := -1; fldlev := -1;
  754.   IF name = "SYSTEM" THEN
  755.     Insert (alias, obj, Mod); obj.link := syslink;
  756.     obj.a0 := 0; obj.typ := notyp
  757.   ELSE
  758.     IF OCM.FindSymbolFile (name, pathName) THEN SymFile := F.Old (pathName)
  759.     ELSE SymFile := NIL
  760.     END;
  761.     IF SymFile # NIL THEN
  762.       IF OCM.Verbose THEN
  763.         OCOut.Str (" << "); OCOut.Str (pathName); OCOut.Ln
  764.       END;
  765.       F.Set (SR, SymFile, 0); ReadLInt (k);
  766.       IF k >= MinSFtag THEN
  767.         struct [Undef] := undftyp; struct [Byte] := bytetyp;
  768.         struct [Bool] := booltyp; struct [Char] := chartyp;
  769.         struct [SInt] := sinttyp; struct [Int] := inttyp;
  770.         struct [LInt] := linttyp; struct [Real] := realtyp;
  771.         struct [LReal] := lrltyp; struct [Set] := settyp;
  772.         struct [String] := stringtyp; struct [NilTyp] := niltyp;
  773.         struct [NoTyp] := notyp; struct [BSet] := bsettyp;
  774.         struct [WSet] := wsettyp; struct [PtrTyp] := ptrtyp;
  775.         struct [AdrTyp] := adrtyp; struct [BPtrTyp] := bptrtyp;
  776.         struct [Word] := wordtyp; struct [Longword] := lwordtyp;
  777.         struct [TagTyp] := tagtyp;
  778.         LOOP (* read next item from symbol file *)
  779.           F.Read (SR, class); IF SR.eof THEN EXIT END;
  780.           link := NIL; typ := NIL; a0 := 0; a1 := 0; a2 := 0;
  781.           mode := Undef; visible := NotExp; label := NIL;
  782.           objName := "";
  783.           CASE class OF
  784.             eUndef : OCS.Mark (151);
  785.             |
  786.             eCon .. eAProc : (* object *)
  787.               m := 0; ReadInt (l); s := SHORT (l); typ := struct [s];
  788.               CASE class OF
  789.                 eCon :
  790.                   mode := Con;
  791.                   CASE typ.form OF
  792.                     Byte, Char, BSet, Bool, SInt, Int, WSet,
  793.                     Word, LInt, Real, LReal, Set, Longword :
  794.                       ReadInt (a0);
  795.                     |
  796.                     (*LReal : ReadInt (a0); ReadInt (a1);
  797.                     |*)
  798.                     String :
  799.                       ReadInt (a0); ReadInt (a1);
  800.                       IF a1 <= 2 THEN
  801.                         ReadInt (l); a2 := l; label := NIL
  802.                       ELSE
  803.                         label := LocMod[0].constLab
  804.                       END
  805.                     |
  806.                     NilTyp : (* NIL *)
  807.                     |
  808.                     AdrTyp, BPtrTyp, Pointer, ProcTyp :
  809.                       (* This is all VERY dodgy, but ... *)
  810.                       ReadInt (a0)
  811.                     |
  812.                   ELSE
  813.                     OCS.Mark (1002); OCS.Mark (typ.form)
  814.                   END; (* CASE obj.typ.form *)
  815.                 |
  816.                 eTypE, eTyp :
  817.                   mode := Typ; ReadInt (l); m := SHORT (l);
  818.                   IF class = eTypE THEN visible := Exp
  819.                   ELSE visible := NotExp
  820.                   END
  821.                 |
  822.                 eVar :
  823.                   mode := Var; ReadInt (a0); F.Read (SR, visible)
  824.                 |
  825.                 eXProc :
  826.                   mode := XProc;
  827.                   link := reversedList (lastpar [parlev]);
  828.                   DEC (parlev)
  829.                 |
  830.                 eLibCall : (* library call procedure *)
  831.                   mode := LibCall;
  832.                   ReadInt (a0); ReadInt (a1); visible := Exp;
  833.                   link := reversedList (lastpar [parlev]);
  834.                   DEC (parlev);
  835.                 |
  836.                 eM2Proc, eCProc, eAProc :
  837.                   IF class = eM2Proc THEN mode := M2Proc
  838.                   ELSIF class = eCProc THEN mode := CProc
  839.                   ELSE mode := AProc
  840.                   END;
  841.                   link := reversedList (lastpar [parlev]);
  842.                   DEC (parlev);
  843.                   ReadId (objName); NEW (label, Str.Length (objName) + 1);
  844.                   COPY (objName, label^)
  845.                 |
  846.               ELSE
  847.                 OCS.Mark (1003); OCS.Mark (class)
  848.               END; (* CASE class *)
  849.               ReadId (objName);
  850.               IF InsertObj (objName, LocMod [m], mode, obj) THEN
  851.                 obj.link := link; obj.typ := typ; obj.a0 := a0;
  852.                 obj.a1 := a1; obj.a2 := a2; obj.visible := visible;
  853.                 obj.label := label;
  854.                 IF class = eXProc THEN
  855.                   MakeLabel (LocMod [m].name, obj.name, obj.label);
  856.                 ELSIF mode = Typ THEN
  857.                   IF typ.strobj = NIL THEN typ.strobj := obj END
  858.                 END;
  859.               ELSIF mode = Typ THEN
  860.                 struct [s] := obj.typ
  861.               END
  862.             |
  863.             ePointer .. eRecord :
  864.               (* structure *)
  865.               NEW (typ); typ.strobj := NIL; typ.ref := 0;
  866.               typ.sysflg := OberonFlag;
  867.               ReadInt (l); typ.BaseTyp := struct [l];
  868.               ReadInt (l); typ.mno := SHORT (LocMod [l].a0);
  869.               CASE class OF
  870.                 ePointer :
  871.                   typ.form := Pointer; typ.size := OCM.PtrSize;
  872.                   typ.n := 0; typ.label := PointerDesc;
  873.                   ReadInt (l); typ.sysflg := SHORT (l);
  874.                   ReadInt (typ.adr);
  875.                   IF
  876.                     (typ.BaseTyp.form = DynArr) & (typ.sysflg = OberonFlag)
  877.                   THEN
  878.                     typ.size := typ.BaseTyp.size; MakeTypeLabel (typ)
  879.                   END
  880.                 |
  881.                 eProcTyp :
  882.                   typ.form := ProcTyp; typ.size := OCM.ProcSize;
  883.                   typ.link := reversedList (lastpar [parlev]);
  884.                   DEC (parlev);
  885.                 |
  886.                 eArray :
  887.                   typ.form := Array; ReadInt (typ.size);
  888.                   ReadInt (typ.adr); ReadInt (l); typ.n := SHORT (l);
  889.                 |
  890.                 eDynArr :
  891.                   typ.form := DynArr; ReadInt (typ.size);
  892.                   ReadInt (typ.adr);
  893.                 |
  894.                 eRecord :
  895.                   typ.form := Record;
  896.                   ReadInt (typ.size); typ.n := 0;
  897.                   typ.link := reversedList (lastfld [fldlev]);
  898.                   DEC (fldlev);
  899.                   IF typ.BaseTyp = notyp THEN
  900.                     typ.BaseTyp := NIL; typ.n := 0
  901.                   ELSE
  902.                     typ.n := typ.BaseTyp.n + 1;
  903.                   END;
  904.                   ReadInt (l); typ.sysflg := SHORT (l);
  905.                   ReadInt (typ.adr); (* of descriptor *)
  906.                   IF typ.sysflg = OberonFlag THEN MakeTypeLabel (typ) END
  907.                 |
  908.               ELSE
  909.                 OCS.Mark (1004); OCS.Mark (class)
  910.               END; (* CASE class *)
  911.               struct [strno] := typ; INC (strno);
  912.             |
  913.             eParList : (* parameter list start *)
  914.               IF parlev < maxParLev - 1 THEN
  915.                 INC (parlev); lastpar [parlev] := NIL;
  916.               ELSE
  917.                 OCS.Mark (229)
  918.               END
  919.             |
  920.             eValPar, eVarPar, eVarArg : (* parameter *)
  921.               NEW (obj);
  922.               IF class = eValPar THEN obj.mode := Var
  923.               ELSIF class = eVarPar THEN obj.mode := Ind
  924.               ELSE obj.mode := VarArg
  925.               END;
  926.               ReadInt (l); obj.typ := struct [l];
  927.               ReadInt (obj.a0); ReadId (objName);
  928.               obj.name := InsertName (objName);
  929.               obj.link := lastpar [parlev]; lastpar [parlev] := obj
  930.             |
  931.             eFldList : (* start field list *)
  932.               IF fldlev < maxParLev - 1 THEN
  933.                 INC (fldlev); lastfld [fldlev] := NIL;
  934.               ELSE
  935.                 OCS.Mark (229);
  936.               END
  937.             |
  938.             eFld :
  939.               NEW (obj); obj.mode := Fld; obj.link := NIL;
  940.               ReadInt (l); obj.typ := struct [l];
  941.               ReadInt (obj.a0); F.Read (SR, obj.visible);
  942.               ReadId (objName); obj.name := InsertName (objName);
  943.               obj.left := lastfld [fldlev]; lastfld [fldlev] := obj
  944.             |
  945.             eTProcE : (* exported type-bound procedure *)
  946.               NEW (obj); obj.mode := TProc;
  947.               ReadInt (l); typ := struct [l];
  948.               ReadInt (l); obj.typ := struct [l];
  949.               ReadInt (obj.a0); ReadId (objName);
  950.               obj.name := InsertName (objName);
  951.               obj.a1 := typ.n; obj.visible := Exp;
  952.               obj.link := reversedList (lastpar [parlev]);
  953.               DEC (parlev);
  954.               obj.link.a2 := -1; obj.left := typ.link; typ.link := obj;
  955.               MakeTProcLabel (typ, obj)
  956.             |
  957.             eTProc : (* hidden type-bound procedure *)
  958.               NEW (obj); obj.mode := TProc; obj.typ := notyp;
  959.               ReadInt (l); typ := struct [l];
  960.               ReadInt (obj.a0); ReadId (objName);
  961.               obj.name := InsertName (objName);
  962.               obj.a1 := typ.n; obj.visible := NotExp;
  963.               obj.link := NIL; obj.left := typ.link; typ.link := obj;
  964.               MakeTProcLabel (typ, obj); obj.name := -obj.name
  965.             |
  966.             eHPtr : (* hidden pointer field *)
  967.               NEW (obj); obj.mode := Fld;
  968.               ReadInt (obj.a0); obj.name := -1; obj.typ := notyp;
  969.               obj.visible := NotExp; obj.link := NIL;
  970.               obj.left := lastfld [fldlev]; lastfld [fldlev] := obj
  971.             |
  972.             eHProc : (* hidden procedure field *)
  973.               ReadInt (l);
  974.             |
  975.             eFixup : (* fixup pointer typ *)
  976.               ReadInt (l); typ := struct [l];
  977.               ReadInt (l);
  978.               IF typ.BaseTyp = undftyp THEN
  979.                 typ.BaseTyp := struct [l];
  980.                 IF typ.BaseTyp.form = DynArr THEN
  981.                   typ.size := typ.BaseTyp.size;
  982.                   MakeTypeLabel (typ)
  983.                 END
  984.               END
  985.             |
  986.             eMod : (* module anchor *)
  987.               ReadLInt (k);
  988.               ReadId (objName); modname := InsertName (objName);
  989.               IF (modname = InsertName (ModuleName)) THEN OCS.Mark (49) END;
  990.               i := 0;
  991.               WHILE (i < nofGmod) & (modname # GlbMod [i].name) DO
  992.                 INC (i);
  993.               END;
  994.               IF i < nofGmod THEN (* module already present *)
  995.                 IF k # GlbMod [i].a1 THEN OCS.Mark (150); END;
  996.                 modobj := GlbMod [i];
  997.               ELSE
  998.                 NEW (modobj);
  999.                 IF nofGmod < maxImps THEN
  1000.                   GlbMod [nofGmod] := modobj; INC (nofGmod);
  1001.                 ELSE
  1002.                   OCS.Mark (227);
  1003.                 END;
  1004.                 modobj.mode := NotYetExp; modobj.name := modname;
  1005.                 modobj.a1 := k; modobj.a0 := nofGmod;
  1006.                 modobj.link := NIL; modobj.visible := NotExp;
  1007.                 IF class = eMod THEN modobj.a2 := 0 ELSE modobj.a2 := 1 END;
  1008.  
  1009.                 MakeInitProcLabel (modname, k, modobj.label);
  1010.                 MakeLabel (modname, InsertName ("VAR"), modobj.varLab);
  1011.                 MakeLabel (modname, InsertName ("CONST"), modobj.constLab);
  1012.                 MakeLabel (modname, InsertName ("GC-OFFSET"), modobj.gcLab);
  1013.                 MakeLabel (modname, InsertName ("END"), modobj.endLab)
  1014.               END;
  1015.               IF nofLmod < maxMod THEN
  1016.                 LocMod [nofLmod] := modobj; INC (nofLmod)
  1017.               ELSE
  1018.                 OCS.Mark (227);
  1019.               END
  1020.             |
  1021.             eExtLib : (* External library, ignore *)
  1022.               ReadId (objName)
  1023.             |
  1024.           ELSE
  1025.             OCS.Mark (1005); OCS.Mark (class)
  1026.           END; (* CASE class *)
  1027.         END; (* LOOP *)
  1028.         Insert (alias, obj, Mod); modobj := obj (Module);
  1029.         modobj.link := LocMod [0].link; modobj.a0 := LocMod [0].a0;
  1030.         modobj.typ := notyp; LocMod [0].visible := Exp;
  1031.         modobj.visible := NotExp; modobj.label := LocMod [0].label;
  1032.         modobj.varLab := LocMod [0].varLab;
  1033.         modobj.constLab := LocMod [0].constLab;
  1034.         modobj.gcLab := LocMod [0].gcLab;
  1035.         modobj.endLab := LocMod [0].endLab
  1036.       ELSE
  1037.         OCS.Mark (157) (* illegal file tag *)
  1038.       END;
  1039.       F.Set (SR, NIL, 0); F.Close (SymFile)
  1040.     ELSE
  1041.       OCS.Mark (152); (* sym file not found *)
  1042.       OCM.SymbolFileName (name, pathName, FALSE);
  1043.       OCOut.Str1 (OCStrings.OCT1, pathName);
  1044.     END;
  1045.   END (* ELSE *)
  1046. END Import;
  1047.  
  1048.  
  1049. (*------------------------------------*)
  1050. PROCEDURE ModuleInit * (name : ARRAY OF CHAR; VAR lab : Label);
  1051.  
  1052.   VAR
  1053.     s : SHORTINT;
  1054.     k : LONGINT;
  1055.     SymFile : F.File;
  1056.     fileName : ARRAY 32 OF CHAR;
  1057.     pathName : ARRAY 256 OF CHAR;
  1058.     modName : Name;
  1059.  
  1060. <*$CopyArrays-*>
  1061. BEGIN (* ModuleInit *)
  1062.   lab := NIL; k := 0;
  1063.   IF OCM.FindSymbolFile (name, pathName) THEN
  1064.     SymFile := F.Old (pathName);
  1065.     IF SymFile # NIL THEN
  1066.       F.Set (SR, SymFile, 0); ReadLInt (k);
  1067.       IF k >= MinSFtag THEN
  1068.         F.Read (SR, s);
  1069.         IF s = eMod THEN
  1070.           ReadLInt (k); ReadId (modName);
  1071.           IF modName # name THEN
  1072.             OCOut.Str1 (OCStrings.OCT2, pathName)
  1073.           END;
  1074.         ELSE
  1075.           OCOut.Str1 (OCStrings.OCT2, pathName)
  1076.         END
  1077.       ELSE
  1078.         OCOut.Str1 (OCStrings.OCT2, pathName)
  1079.       END;
  1080.       F.Set (SR, NIL, 0); F.Close (SymFile)
  1081.     ELSE
  1082.       OCOut.Str1 (OCStrings.OCT3, pathName)
  1083.     END
  1084.   ELSE
  1085.     OCM.SymbolFileName (name, pathName, FALSE);
  1086.     OCOut.Str1 (OCStrings.OCT1, pathName)
  1087.   END;
  1088.   MakeInitProcLabel (InsertName (name), k, lab)
  1089. END ModuleInit;
  1090.  
  1091.  
  1092. (*--- EXPORT ---------------------------------*)
  1093.  
  1094. (*------------------------------------*)
  1095. PROCEDURE WriteInt(i: LONGINT);
  1096. (*
  1097.   Writes integers written in a compacted form. Taken from J. Templ.
  1098.   SPARC-Oberon. User's Guide and Implementation. Computersysteme ETH
  1099.   Zürich, Technical Report No. 133, June 1990.
  1100. *)
  1101. BEGIN
  1102.   WHILE (i < -64) OR (i > 63) DO
  1103.     F.Write(SR, CHR(i MOD 128 + 128)); i := i DIV 128
  1104.   END;
  1105.   F.Write(SR, CHR(i MOD 128))
  1106. END WriteInt;
  1107.  
  1108. (*------------------------------------*)
  1109. PROCEDURE WriteLInt (k : LONGINT);
  1110. BEGIN (* WriteLInt *)
  1111.   F.WriteBytes (SR, k, 4)
  1112. END WriteLInt;
  1113.  
  1114. (*------------------------------------*)
  1115. PROCEDURE WriteId (i : LONGINT);
  1116.  
  1117.   VAR ch : CHAR; lim, bufX : INTEGER; buf : NameBufPtr;
  1118.  
  1119. BEGIN (* WriteId *)
  1120.   buf := nameBuf [i DIV BufSize];
  1121.   bufX := SHORT (i MOD BufSize);
  1122.   REPEAT
  1123.     ch := buf [bufX]; F.Write (SR, ch); INC (bufX)
  1124.   UNTIL ch = 0X;
  1125. END WriteId;
  1126.  
  1127.  
  1128. (*------------------------------------*)
  1129. PROCEDURE WriteLabel ( label : Label );
  1130.  
  1131.   VAR i : LONGINT; ch : CHAR;
  1132.  
  1133. BEGIN (* WriteLabel *)
  1134.   i := 0;
  1135.   REPEAT
  1136.     ch := label [i]; F.Write (SR, ch); INC (i)
  1137.   UNTIL ch = 0X;
  1138. END WriteLabel;
  1139.  
  1140. (*------------------------------------*)
  1141. PROCEDURE^ OutStr (typ : Struct);
  1142.  
  1143. (*------------------------------------*)
  1144. PROCEDURE OutPars (par : Object; mode : INTEGER);
  1145.  
  1146. BEGIN (* OutPars *)
  1147.   F.Write (SR, eParList);
  1148.   WHILE IsParam (par) DO
  1149.     OutStr (par.typ);
  1150.     IF par.mode = Var THEN F.Write (SR, eValPar)
  1151.     ELSIF par.mode = Ind THEN F.Write (SR, eVarPar)
  1152.     ELSE F.Write (SR, eVarArg)
  1153.     END;
  1154.     WriteInt (par.typ.ref);
  1155.     IF mode IN {LibCall, AProc} THEN WriteInt (par.a0)
  1156.     ELSE WriteInt (0)
  1157.     END;
  1158.     WriteId (par.name);
  1159.     par := par.link
  1160.   END;
  1161. END OutPars;
  1162.  
  1163. (*------------------------------------*)
  1164. PROCEDURE OutFlds (fld : Object; adr : LONGINT; visible : BOOLEAN);
  1165. BEGIN (* OutFlds *)
  1166.   IF visible THEN F.Write (SR, eFldList) END;
  1167.   WHILE fld # NIL DO
  1168.     IF fld.mode = Fld THEN
  1169.       IF visible & (fld.visible # NotExp) THEN
  1170.         OutStr (fld.typ); F.Write (SR, eFld); WriteInt (fld.typ.ref);
  1171.         WriteInt (fld.a0); F.Write (SR, fld.visible); WriteId (fld.name)
  1172.       ELSIF fld.typ.form = Record THEN
  1173.         OutFlds (fld.typ.link, fld.a0 + adr, FALSE)
  1174.       ELSIF
  1175.         ((fld.typ.form = Pointer) & (fld.typ.sysflg = OberonFlag))
  1176.         OR (fld.name < 0)
  1177.       THEN
  1178.         F.Write (SR, eHPtr); WriteInt (fld.a0 + adr)
  1179.       END
  1180.     END;
  1181.     fld := fld.left
  1182.   END;
  1183. END OutFlds;
  1184.  
  1185. (*------------------------------------*)
  1186. PROCEDURE OutProcs (ref : INTEGER; fld : Object);
  1187.  
  1188. BEGIN (* OutProcs *)
  1189.   WHILE fld # NIL DO
  1190.     IF fld.mode = TProc THEN
  1191.       IF fld.visible = Exp THEN
  1192.         OutStr (fld.typ); OutPars (fld.link, TProc);
  1193.         F.Write (SR, eTProcE); WriteInt (ref); WriteInt (fld.typ.ref);
  1194.         WriteInt (fld.a0); WriteId (fld.name)
  1195.       ELSE
  1196.         F.Write (SR, eTProc); WriteInt (ref); WriteInt (fld.a0);
  1197.         WriteId (ABS (fld.name))
  1198.       END
  1199.     END;
  1200.     fld := fld.left
  1201.   END
  1202. END OutProcs;
  1203.  
  1204. (*------------------------------------*)
  1205. PROCEDURE OutMod (VAR m : INTEGER);
  1206.  
  1207.   VAR em : INTEGER; mod : Module;
  1208.  
  1209. BEGIN (* OutMod *)
  1210.   mod := GlbMod [m - 1]; em := mod.mode;
  1211.   IF em = NotYetExp THEN
  1212.     GlbMod [m - 1].mode := nofExp; m := nofExp; INC (nofExp);
  1213.     F.Write (SR, eMod); WriteLInt (mod.a1); WriteId (mod.name);
  1214.   ELSE
  1215.     m := em;
  1216.   END
  1217. END OutMod;
  1218.  
  1219. (*------------------------------------*)
  1220. PROCEDURE OutStr (typ : Struct);
  1221.  
  1222.   VAR m, r : INTEGER; btyp : Struct;
  1223.  
  1224. BEGIN (* OutStr *)
  1225.   IF typ.ref = NotYetExp THEN (* type not yet exported *)
  1226.     m := typ.mno; btyp := typ.BaseTyp;
  1227.     IF m > 0 THEN OutMod (m) END;
  1228.     CASE typ.form OF
  1229.       Undef .. NoTyp :
  1230.       |
  1231.       Pointer :
  1232.         F.Write (SR, ePointer);
  1233.         IF btyp.ref > 0 THEN
  1234.           WriteInt (btyp.ref);
  1235.         ELSE
  1236.           F.Write (SR, eUndef);
  1237.           IF udpinx < maxUDP THEN
  1238.             undPtr [udpinx] := typ; INC (udpinx);
  1239.           ELSE
  1240.             OCS.Mark (224);
  1241.           END
  1242.         END;
  1243.         WriteInt (m); WriteInt (typ.sysflg); WriteInt (typ.adr)
  1244.       |
  1245.       ProcTyp :
  1246.         OutStr (btyp); OutPars (typ.link, ProcTyp);
  1247.         F.Write (SR, eProcTyp); WriteInt (btyp.ref); WriteInt (m);
  1248.       |
  1249.       Array :
  1250.         OutStr (btyp);
  1251.         F.Write (SR, eArray); WriteInt (btyp.ref); WriteInt (m);
  1252.         WriteInt (typ.size); WriteInt (typ.adr); WriteInt (typ.n);
  1253.       |
  1254.       DynArr :
  1255.         OutStr (btyp);
  1256.         F.Write (SR, eDynArr); WriteInt (btyp.ref); WriteInt (m);
  1257.         WriteInt (typ.size); WriteInt (typ.adr);
  1258.       |
  1259.       Record :
  1260.         IF btyp = NIL THEN r := NoTyp
  1261.         ELSE OutStr (btyp); r := btyp.ref
  1262.         END;
  1263.         OutFlds (typ.link, 0, TRUE);
  1264.         F.Write (SR, eRecord);
  1265.         WriteInt (r); WriteInt (m); WriteInt (typ.size);
  1266.         WriteInt (typ.sysflg); WriteInt (typ.adr);
  1267.       |
  1268.     ELSE
  1269.       OCS.Mark (1006); OCS.Mark (typ.form)
  1270.     END; (* CASE typ.form *)
  1271.     typ.ref := strno; INC (strno);
  1272.     IF strno > maxStr THEN OCS.Mark (228) END;
  1273.     IF typ.strobj # NIL THEN
  1274.       IF typ.strobj.visible = Exp THEN F.Write (SR, eTypE)
  1275.       ELSE F.Write (SR, eTyp);
  1276.       END;
  1277.       WriteInt (strno-1); WriteInt (m); WriteId (typ.strobj.name);
  1278.       IF (typ.form = Record)  & (typ.sysflg = OberonFlag) THEN
  1279.         OutProcs (strno-1, typ.link)
  1280.       END
  1281.     END
  1282.   END; (* IF *)
  1283. END OutStr;
  1284.  
  1285. (*------------------------------------*)
  1286. PROCEDURE OutObj (obj : Object);
  1287.  
  1288.   VAR f, m : INTEGER;
  1289.  
  1290. BEGIN (* OutObj *)
  1291.   IF obj # NIL THEN
  1292.     IF obj.visible # NotExp THEN
  1293.       IF obj.mode = Con THEN
  1294.         OutStr (obj.typ); F.Write (SR, eCon);
  1295.         f := obj.typ.form;
  1296.         IF f = Pointer THEN WriteInt (obj.typ.ref)
  1297.         ELSE WriteInt (f)
  1298.         END;
  1299.         CASE f OF
  1300.           Undef :
  1301.           |
  1302.           Byte, Bool, Char, SInt, BSet, Int, WSet,
  1303.           Word, LInt, Real, LReal, Set, Longword :
  1304.             WriteInt (obj.a0)
  1305.           |
  1306.           (*LReal : WriteInt (obj.a0); WriteInt (obj.a1);
  1307.           |*)
  1308.           String :
  1309.             IF obj.a1 <= 2 THEN
  1310.               WriteInt (-1); WriteInt (obj.a1); WriteInt (obj.a2)
  1311.             ELSE
  1312.               WriteInt (obj.a0); WriteInt (obj.a1);
  1313.             END
  1314.           |
  1315.           NilTyp :
  1316.           |
  1317.           AdrTyp, BPtrTyp, Pointer, ProcTyp :
  1318.             (* This is all VERY dodgy, but ... *)
  1319.             WriteInt (obj.a0);
  1320.           |
  1321.         ELSE
  1322.           OCS.Mark (1007); OCS.Mark (f)
  1323.         END; (* CASE f *)
  1324.         WriteId (obj.name);
  1325.       ELSIF obj.mode = Typ THEN
  1326.         OutStr (obj.typ);
  1327.         IF (obj.typ.strobj # obj) & (obj.typ.strobj # NIL) THEN
  1328.           F.Write (SR, eTypE); WriteInt (obj.typ.ref);
  1329.           WriteInt (0);(*<- module no *) WriteId (obj.name);
  1330.         END; (* IF *)
  1331.       ELSIF obj.mode = Var THEN
  1332.         OutStr (obj.typ); F.Write (SR, eVar);
  1333.         WriteInt (obj.typ.ref); WriteInt (obj.a0);
  1334.         F.Write (SR, obj.visible); WriteId (obj.name)
  1335.       ELSIF obj.mode = XProc THEN
  1336.         OutStr (obj.typ); OutPars (obj.link, XProc);
  1337.         F.Write (SR, eXProc); WriteInt (obj.typ.ref); WriteId (obj.name);
  1338.       ELSIF obj.mode IN {M2Proc, CProc, AProc} THEN
  1339.         OutStr (obj.typ); OutPars (obj.link, obj.mode);
  1340.         IF obj.mode = M2Proc THEN F.Write (SR, eM2Proc)
  1341.         ELSIF obj.mode = CProc THEN F.Write (SR, eCProc)
  1342.         ELSE F.Write (SR, eAProc)
  1343.         END;
  1344.         WriteInt (obj.typ.ref); WriteLabel (obj.label);
  1345.         WriteId (obj.name);
  1346.       ELSIF obj.mode = LibCall THEN
  1347.         OutStr (obj.typ); OutPars (obj.link, LibCall);
  1348.         F.Write (SR, eLibCall); WriteInt (obj.typ.ref);
  1349.         WriteInt (obj.a0); WriteInt (obj.a1); WriteId (obj.name);
  1350.       END
  1351.     END; (* IF *)
  1352.     OutObj (obj.left); OutObj (obj.right)
  1353.   END; (* IF *)
  1354. END OutObj;
  1355.  
  1356. (*------------------------------------*)
  1357. PROCEDURE OutImports ();
  1358.  
  1359.   VAR m : INTEGER; mod : Module;
  1360.  
  1361. BEGIN (* OutImports *)
  1362.   FOR m := 0 TO (nofGmod - 1) DO
  1363.     mod := GlbMod [m];
  1364.     IF (mod.visible = Exp) & (mod.mode = NotYetExp) THEN
  1365.       mod.mode := nofExp; INC (nofExp);
  1366.       F.Write (SR, eMod); WriteLInt (mod.a1); WriteId (mod.name);
  1367.     END
  1368.   END;
  1369.   FOR m := 0 TO (nofExtLib - 1) DO
  1370.     F.Write (SR, eExtLib); WriteId (extLib [m])
  1371.   END;
  1372. END OutImports;
  1373.  
  1374. (*------------------------------------*)
  1375. PROCEDURE Export * (
  1376.   name : ARRAY OF CHAR;
  1377.   VAR newSF : BOOLEAN; VAR key : LONGINT);
  1378.  
  1379.   VAR
  1380.     i : INTEGER;
  1381.     ch0, ch1 : CHAR;
  1382.     oldkey : LONGINT;
  1383.     typ : Struct;
  1384.     oldFile, newFile : F.File;
  1385.     res : LONGINT;
  1386.     oldSR : F.Rider;
  1387.     equal : BOOLEAN;
  1388.     pathName, oldPathName : ARRAY 256 OF CHAR;
  1389.  
  1390. <*$CopyArrays-*>
  1391. BEGIN (* Export *)
  1392.   OCM.SymbolFileName (name, pathName, TRUE);
  1393.   newFile := F.New (pathName);
  1394.   IF newFile # NIL THEN
  1395.     F.Set (SR, newFile, 0);
  1396.     WriteLInt (SFtag);
  1397.     F.Write (SR, eMod); WriteLInt (key); WriteId (InsertName (ModuleName));
  1398.  
  1399.     strno := firstStr; nofExp := 1;
  1400.     OutImports ();
  1401.     OutObj (topScope.link);
  1402.  
  1403.     i := 0;
  1404.     WHILE i < udpinx DO
  1405.       typ := undPtr [i]; OutStr (typ.BaseTyp); undPtr [i] := NIL; INC (i);
  1406.       F.Write (SR, eFixup);
  1407.       WriteInt (typ.ref); WriteInt (typ.BaseTyp.ref)
  1408.     END;
  1409.  
  1410.     IF OCM.Force OR ~OCS.scanerr THEN
  1411.       IF OCM.FindSymbolFile (name, oldPathName) THEN
  1412.         oldFile := F.Old (oldPathName)
  1413.       ELSE
  1414.         oldFile := NIL
  1415.       END;
  1416.       IF oldFile # NIL THEN
  1417.         F.Set (oldSR, oldFile, 5); F.ReadBytes (oldSR, oldkey, 4);
  1418.         F.Set (SR, newFile, 9);
  1419.         REPEAT
  1420.           F.Read (oldSR, ch0); F.Read(SR, ch1);
  1421.         UNTIL (ch0 # ch1) OR SR.eof;
  1422.         equal := oldSR.eof & SR.eof;
  1423.         F.Set (oldSR, NIL, 0); F.Close (oldFile);
  1424.         F.Set (SR, NIL, 0);
  1425.         IF equal THEN
  1426.           newSF := FALSE; key := oldkey; F.Purge (newFile);
  1427.         ELSIF newSF THEN
  1428.           F.Register (newFile);
  1429.         ELSE
  1430.           OCS.Mark (155); (*F.Purge (newFile);*) F.Close (newFile);
  1431.           OCOut.Str1 (OCStrings.OCT4, oldPathName)
  1432.         END
  1433.       ELSE
  1434.         F.Set (SR, NIL, 0); F.Register (newFile); newSF := TRUE
  1435.       END;
  1436.  
  1437.       IF newSF THEN
  1438.         IF OCM.Verbose THEN OCOut.Str1 (OCStrings.OCT5, pathName) END;
  1439.         OCM.MakeIcon (pathName, OCM.iconSym)
  1440.       END;
  1441.  
  1442.       MakeInitProcLabel (InsertName (ModuleName), key, InitLabel);
  1443.       MakeLabel (InsertName (ModuleName), InsertName ("END"), EndLabel)
  1444.     ELSE
  1445.       F.Set (SR, NIL, 0); F.Purge (newFile); newSF := FALSE
  1446.     END;
  1447.  
  1448.   ELSE
  1449.     OCOut.Str1 (OCStrings.OCT3, pathName);
  1450.     OCS.Mark (153)
  1451.   END;
  1452. END Export;
  1453.  
  1454. (*--- INITIALISATION ---------------------------------*)
  1455.  
  1456. (*------------------------------------*)
  1457. PROCEDURE InitStruct (VAR typ : Struct; f : INTEGER);
  1458.  
  1459. BEGIN (* InitStruct *)
  1460.   NEW (typ); typ.form := f; typ.ref := f; typ.size := 1;
  1461.   typ.sysflg := OberonFlag
  1462. END InitStruct;
  1463.  
  1464. (*------------------------------------*)
  1465. PROCEDURE EnterConst (name : ARRAY OF CHAR; value : INTEGER);
  1466.  
  1467.   VAR obj : Object;
  1468.  
  1469. <*$CopyArrays-*>
  1470. BEGIN (* EnterConst *)
  1471.   Insert (name, obj, Con); obj.typ := booltyp; obj.a0 := value;
  1472. END EnterConst;
  1473.  
  1474. (*------------------------------------*)
  1475. PROCEDURE EnterTyp (
  1476.   name : ARRAY OF CHAR; form, size : INTEGER; VAR res: Struct);
  1477.  
  1478.   VAR obj : Object; typ : Struct;
  1479.  
  1480. <*$CopyArrays-*>
  1481. BEGIN (* EnterTyp *)
  1482.   Insert (name, obj, Typ); NEW (typ);
  1483.   obj.typ := typ; obj.visible := Exp;
  1484.   typ.form := form; typ.strobj := obj; typ.size := size;
  1485.   typ.sysflg := OberonFlag; typ.ref := form; res := typ;
  1486. END EnterTyp;
  1487.  
  1488. (*------------------------------------*)
  1489. PROCEDURE EnterProc (name : ARRAY OF CHAR; num : INTEGER);
  1490.  
  1491.   VAR obj : Object;
  1492.  
  1493. <*$CopyArrays-*>
  1494. BEGIN (* EnterProc *)
  1495.   Insert (name, obj, SProc); obj.typ := notyp; obj.a0 := num
  1496. END EnterProc;
  1497.  
  1498. BEGIN (* OCT *)
  1499.   nameSize := 0; topScope := NIL;
  1500.   InitStruct (undftyp, Undef); InitStruct (notyp, NoTyp);
  1501.   InitStruct (stringtyp, String); InitStruct (niltyp, NilTyp);
  1502.   OpenScope (0);
  1503.  
  1504.   (* initialisation of module SYSTEM *)
  1505.  
  1506.   EnterTyp ("BYTESET", BSet, OCM.BSetSize, bsettyp);
  1507.   EnterTyp ("WORDSET", WSet, OCM.WSetSize, wsettyp);
  1508.   EnterTyp ("PTR", PtrTyp, OCM.PtrSize, ptrtyp);
  1509.   EnterTyp ("BPTR", BPtrTyp, OCM.PtrSize, bptrtyp);
  1510.   bptrtyp.sysflg := BCPLFlag;
  1511.   EnterTyp ("ADDRESS", AdrTyp, OCM.PtrSize, adrtyp);
  1512.   adrtyp.sysflg := CFlag;
  1513.   EnterTyp ("BYTE", Byte, OCM.ByteSize, bytetyp);
  1514.   EnterTyp ("WORD", Word, 2, wordtyp);
  1515.   EnterTyp ("LONGWORD", Longword, 4, lwordtyp);
  1516.   EnterTyp ("TYPETAG", TagTyp, 4, tagtyp);
  1517.  
  1518.   EnterProc ("ADR", pADR);         EnterProc ("AND", pAND);
  1519.   EnterProc ("BIT", pBIT);         EnterProc ("CC", pCC);
  1520.   EnterProc ("DISPOSE", pDISPOSE); EnterProc ("GET", pGET);
  1521.   EnterProc ("GETREG", pGETREG);   EnterProc ("INLINE", pINLINE);
  1522.   EnterProc ("LOR", pOR);          EnterProc ("LSH", pLSH);
  1523.   EnterProc ("MOVE", pMOVE);       EnterProc ("NEW", pSYSNEW);
  1524.   EnterProc ("PUT", pPUT);         EnterProc ("ROT", pROT);
  1525.   EnterProc ("STRLEN", pSTRLEN);   EnterProc ("PUTREG", pPUTREG);
  1526.   EnterProc ("VAL", pVAL);         EnterProc ("XOR", pXOR);
  1527.   EnterProc ("SETREG", pSETREG);   EnterProc ("REG", pREG);
  1528.   EnterProc ("TAG", pTAG);
  1529.  
  1530.   syslink := topScope.link; universe := topScope; topScope.link := NIL;
  1531.  
  1532.   (* initialisation of predeclared types and procedures *)
  1533.  
  1534.   EnterTyp ("CHAR", Char, OCM.CharSize, chartyp);
  1535.   EnterTyp ("SET", Set, OCM.SetSize, settyp);
  1536.   EnterTyp ("REAL", Real, OCM.RealSize, realtyp);
  1537.   EnterTyp ("INTEGER", Int, OCM.IntSize, inttyp);
  1538.   EnterTyp ("LONGINT", LInt, OCM.LIntSize, linttyp);
  1539.   EnterTyp ("LONGREAL", LReal, OCM.LRealSize, lrltyp);
  1540.   EnterTyp ("SHORTINT", SInt, OCM.SIntSize, sinttyp);
  1541.   EnterTyp ("BOOLEAN", Bool, OCM.BoolSize, booltyp);
  1542.  
  1543.   EnterConst ("FALSE", 0);  EnterConst ("TRUE", 1);
  1544.  
  1545.   EnterProc ("INC", pINC);     EnterProc ("DEC", pDEC);
  1546.   EnterProc ("HALT", pHALT);   EnterProc ("NEW", pNEW);
  1547.   EnterProc ("ABS", pABS);     EnterProc ("CAP", pCAP);
  1548.   EnterProc ("ORD", pORD);     EnterProc ("ENTIER", pENTIER);
  1549.   EnterProc ("ODD", pODD);     EnterProc ("MIN", pMIN);
  1550.   EnterProc ("MAX", pMAX);     EnterProc ("CHR", pCHR);
  1551.   EnterProc ("SHORT", pSHORT); EnterProc ("LONG", pLONG);
  1552.   EnterProc ("INCL", pINCL);   EnterProc ("EXCL", pEXCL);
  1553.   EnterProc ("LEN", pLEN);     EnterProc ("ASH", pASH);
  1554.   EnterProc ("COPY", pCOPY);   EnterProc ("SIZE", pSIZE);
  1555.   EnterProc ("ASSERT", pASSERT);
  1556.  
  1557.   (* Save hash table for names so we can restore it *)
  1558.  
  1559.   nameOrg := nameX; backupTab := nameTab;
  1560.  
  1561.   (* initialisation of labels *)
  1562.  
  1563.   NEW (VarLabel, 64);
  1564.   NEW (ConstLabel, 64);
  1565.   NEW (InitLabel, 64);
  1566.   NEW (EndLabel, 64);
  1567.   NEW (GCLabel, 64);
  1568.   NEW (PointerDesc, 16); COPY ("Kernel_0T", PointerDesc^)
  1569. END OCT.
  1570.  
  1571. (***************************************************************************
  1572.  
  1573.   $Log: OCT.mod $
  1574.   Revision 5.23  1995/06/29  19:10:08  fjc
  1575.   - Removed code that was second-guessing the garbage collector
  1576.  
  1577.   Revision 5.22  1995/06/02  18:34:21  fjc
  1578.   - Added code to generate different init code label for
  1579.     resident modules.
  1580.  
  1581.   Revision 5.21  1995/05/19  16:00:57  fjc
  1582.   - Uses OCOut for console IO.
  1583.  
  1584.   Revision 5.20  1995/05/13  23:02:36  fjc
  1585.   - Made the a2 field a LONGINT;
  1586.  
  1587.   Revision 5.19  1995/05/08  17:09:16  fjc
  1588.   - Fixed bug in exporting VarArg parameters.
  1589.  
  1590.   Revision 5.18  1995/04/23  16:59:03  fjc
  1591.   - Merging 5.26 & 5.27
  1592.  
  1593.   Revision 5.16  1995/04/02  13:39:34  fjc
  1594.   - Generates different symbol for init code under the small
  1595.     data model.
  1596.  
  1597.   Revision 5.15  1995/03/25  16:58:55  fjc
  1598.   - Name field for hidden TProc objects is now <0.
  1599.  
  1600.   Revision 5.14  1995/03/23  18:03:23  fjc
  1601.   - Fixed pragmas.
  1602.  
  1603.   Revision 5.13  1995/02/27  16:53:17  fjc
  1604.   - Removed tracing code.
  1605.  
  1606.   Revision 5.12  1995/01/26  00:17:17  fjc
  1607.   - Release 1.5
  1608.  
  1609.   Revision 5.11  1995/01/09  13:50:25  fjc
  1610.   - Added call to OCM.MakeIcon().
  1611.   - Changed console output depending on OCM.Verbose.
  1612.  
  1613.   Revision 5.10  1995/01/05  11:29:50  fjc
  1614.   - Changed to force output of symbol file if OCM.Force is TRUE.
  1615.  
  1616.   Revision 5.9  1995/01/03  21:13:22  fjc
  1617.   - Changed OCG to OCM.
  1618.   - Changed to use catalogs:
  1619.     - Uses OCM for console I/O instead of Out.
  1620.     - Gets text from OCStrings instead of hard-coding it.
  1621.  
  1622.   Revision 5.7  1994/12/16  17:05:39  fjc
  1623.   - Moved code for constructing symbol file names and
  1624.     searching for symbol files to module OCG.
  1625.   - Renamed the Symbol type as Label and renamed associated
  1626.     variables, record fields and procedures.
  1627.   - Changed the way linker labels are generated.
  1628.  
  1629.   Revision 5.6  1994/11/13  11:20:48  fjc
  1630.   - Added CC to module SYSTEM.
  1631.  
  1632.   Revision 5.5  1994/10/23  15:44:27  fjc
  1633.   - Changed all references to OberonSys.lib to module Kernel.
  1634.   - Removed obsolete SYSTEM procedures: GC, RC, ARGLEN, ARGS,
  1635.     SIZETAG, SETCLEANUP, BIND, GETNAME and NEWTAG.
  1636.   - Increased # of modules that can be imported.
  1637.   - Renamed SYSTEM.CPTR to SYSTEM.ADDRESS, CPtrTyp to AdrTyp,
  1638.     and cptrtyp to adrtyp.
  1639.   - Uses new interface to module Strings, and module
  1640.     Conversions.
  1641.   - Added ModuleInit().
  1642.  
  1643.   Revision 5.4  1994/09/25  17:37:28  fjc
  1644.   - Removed code dealing with CPOINTERS, BPOINTERS and
  1645.     LIBCALLS.
  1646.   - Added code for new system flags and procedure types.
  1647.   - Implemented new symbol-file format.
  1648.  
  1649.   Revision 5.3  1994/09/19  23:10:05  fjc
  1650.   - Re-implemented Amiga library calls
  1651.  
  1652.   Revision 5.2  1994/09/15  10:15:51  fjc
  1653.   - Replaced switches with pragmas.
  1654.  
  1655.   Revision 5.1  1994/09/03  19:29:08  fjc
  1656.   - Bumped version number
  1657.  
  1658. ***************************************************************************)
  1659.