1MODULE Compiler; (* J. Templ 3.2.95 *) 2 3 IMPORT 4 SYSTEM, Heap, Platform, Configuration, 5 OPP, OPB, OPT, 6 OPV, OPC, OPM, 7 extTools, Strings, VT100; 8 9 PROCEDURE Module*(VAR done: BOOLEAN); 10 VAR ext, new: BOOLEAN; p: OPT.Node; 11 BEGIN 12 OPP.Module(p, OPM.Options); 13 IF OPM.noerr THEN 14 OPV.Init; 15 OPT.InitRecno; 16 OPV.AdrAndSize(OPT.topScope); 17 OPT.Export(ext, new); 18 IF OPM.noerr THEN 19 OPM.OpenFiles(OPT.SelfName); 20 OPM.DeleteObj(OPT.SelfName); (* Make sure old object file isn't left hanging around. *) 21 OPC.Init; 22 OPV.Module(p); 23 IF OPM.noerr THEN 24 IF (OPM.mainprog IN OPM.Options) & (OPM.modName # "SYSTEM") THEN 25 OPM.DeleteSym(OPT.SelfName); 26 OPM.LogVT100(VT100.Green); OPM.LogWStr(" Main program."); OPM.LogVT100(VT100.ResetAll); 27 ELSE 28 IF new THEN 29 OPM.LogVT100(VT100.Green); OPM.LogWStr(" New symbol file."); OPM.LogVT100(VT100.ResetAll); 30 OPM.RegisterNewSym 31 ELSIF ext THEN 32 OPM.LogWStr(" Extended symbol file."); 33 OPM.RegisterNewSym 34 END 35 END; 36 ELSE 37 OPM.DeleteSym(OPT.SelfName) 38 END 39 END 40 END; 41 OPM.CloseFiles; OPT.Close; 42 OPM.LogWLn; 43 done := OPM.noerr; 44 END Module; 45 46 47 PROCEDURE PropagateElementaryTypeSizes; 48 VAR adrinttyp: OPT.Struct; 49 BEGIN 50 OPT.sysptrtyp.size := OPM.AddressSize; 51 OPT.sysptrtyp.idfp := OPT.sysptrtyp.form; 52 OPM.FPrint(OPT.sysptrtyp.idfp, OPT.sysptrtyp.size); 53 54 OPT.adrtyp.size := OPM.AddressSize; 55 OPT.adrtyp.idfp := OPT.adrtyp.form; 56 OPM.FPrint(OPT.adrtyp.idfp, OPT.adrtyp.size); 57 58 adrinttyp := OPT.IntType(OPM.AddressSize); 59 OPT.adrtyp.strobj := adrinttyp.strobj; 60 61 OPT.sinttyp := OPT.IntType(OPM.ShortintSize); 62 OPT.inttyp := OPT.IntType(OPM.IntegerSize); 63 OPT.linttyp := OPT.IntType(OPM.LongintSize); 64 65 OPT.sintobj.typ := OPT.sinttyp; 66 OPT.intobj.typ := OPT.inttyp; 67 OPT.lintobj.typ := OPT.linttyp; 68 69 CASE OPM.SetSize OF 70 |4: OPT.settyp := OPT.set32typ 71 ELSE OPT.settyp := OPT.set64typ 72 END; 73 OPT.setobj.typ := OPT.settyp; 74 75 (* Enable or disable (non-system) BYTE type *) 76 IF OPM.Model = "C" THEN 77 OPT.cpbytetyp.strobj.name[4] := 0X (* Enable Component Pascal non-system BYTE type *) 78 ELSE 79 OPT.cpbytetyp.strobj.name[4] := '@' (* Disable Component Pascal non-system BYTE type *) 80 END 81 END PropagateElementaryTypeSizes; 82 83 84 PROCEDURE FindLocalObjectFiles(VAR objectnames: ARRAY OF CHAR); 85 VAR 86 l: OPT.Link; 87 fn: ARRAY 64 OF CHAR; 88 id: Platform.FileIdentity; 89 BEGIN 90 objectnames[0] := 0X; 91 l := OPT.Links; WHILE l # NIL DO 92 (* Tell linker to link this module as an object file if both a symbol 93 and an object file exist in the current directory. *) 94 COPY(l.name, fn); Strings.Append('.sym', fn); 95 IF Platform.IdentifyByName(fn, id) = 0 THEN 96 COPY(l.name, fn); Strings.Append(Configuration.objext, fn); 97 IF Platform.IdentifyByName(fn, id) = 0 THEN 98 Strings.Append(' ', objectnames); 99 Strings.Append(fn, objectnames) 100 ELSE 101 (* Found symbol file but no object file. *) 102 OPM.LogVT100(VT100.LightRed); 103 OPM.LogWStr("Link warning: a local symbol file is present for module "); OPM.LogWStr(l.name); 104 OPM.LogWStr(", but local object file '"); OPM.LogWStr(fn); OPM.LogWStr("' is missing."); 105 OPM.LogVT100(VT100.ResetAll); OPM.LogWLn 106 END 107 ELSE 108 (* No symbol file present in current directory. 109 Assume this referenced module is in a library. *) 110 END; 111 l := l.next 112 END 113 END FindLocalObjectFiles; 114 115 116 PROCEDURE Translate*; 117 VAR 118 done: BOOLEAN; 119 linkfiles: ARRAY 2048 OF CHAR; (* Object files to be linked into main program. *) 120 BEGIN 121 IF OPM.OpenPar() THEN 122 (* gclock(); slightly faster translation but may lead to opening "too many files" *) 123 124 LOOP 125 OPM.Init(done); (* Get next module name from command line *) 126 IF ~done THEN RETURN END ; 127 128 OPM.InitOptions; (* Get options for this module *) 129 PropagateElementaryTypeSizes; 130 131 (* Compile source to .c and .h files *) 132 Heap.GC(FALSE); 133 Module(done); 134 IF ~done THEN 135 OPM.LogWLn; OPM.LogWStr("Module compilation failed."); OPM.LogWLn; 136 Platform.Exit(1) 137 END; 138 139 (* 'assemble' (i.e. c compile) .c to object or executable. *) 140 IF ~(OPM.dontasm IN OPM.Options) THEN 141 IF OPM.dontlink IN OPM.Options THEN 142 (* If not linking, just assemble each module. *) 143 extTools.Assemble(OPM.modName) 144 ELSE 145 IF ~(OPM.mainprog IN OPM.Options) THEN 146 (* Assemble non main program and add object name to link list *) 147 extTools.Assemble(OPM.modName); 148 ELSE 149 (* Assemble and link main program *) 150 FindLocalObjectFiles(linkfiles); 151 extTools.LinkMain(OPM.modName, OPM.mainlinkstat IN OPM.Options, linkfiles) 152 END 153 END 154 END 155 END (* loop *) 156 END 157 END Translate; 158 159 PROCEDURE Trap(sig: SYSTEM.INT32); 160 BEGIN 161 Heap.FINALL(); 162 IF sig = 3 THEN 163 Platform.Exit(0) 164 ELSE 165 IF sig = 4 THEN 166 OPM.LogWStr(" --- Oberon compiler internal error"); OPM.LogWLn 167 END ; 168 Platform.Exit(2) 169 END 170 END Trap; 171 172BEGIN 173 Platform.SetInterruptHandler(Trap); 174 Platform.SetQuitHandler(Trap); 175 Platform.SetBadInstructionHandler(Trap); 176 Translate 177END Compiler. 178