KolibriOS/oberon-07-compiler
16
0 Fork 0
mirror of https://github.com/AntKrotov/oberon-07-compiler.git synced 2026-10-05 09:45:47 +00:00
Code Issues Packages Projects Releases Wiki Activity
Files
06ffb1a1e0ba0624f9fe476f6ffd922f324c5ec2
oberon-07-compiler/source/Compiler.ob07
T

267 lines
6.7 KiB
Plaintext
Raw Blame History

(*
BSD 2-Clause License
Copyright (c) 2018, Anton Krotov
All rights reserved.
*)
MODULE Compiler;
IMPORT mSt := STATEMENTS,
mPars := PARS,
mUtil := UTILS,
mPath := PATHS,
mCons := CONSOLE,
mErr := ERRORS,
mStr := STRINGS,
mWrit := WRITER,
mConst:= modConstante;
PROCEDURE Target_Get (pTarget: ARRAY OF CHAR): INTEGER;
(* Compare pTarget (platform) white string constante.
Return associate integer constante. *)
VAR
iRes: INTEGER;
BEGIN
IF pTarget = mConst.Target_sConsole THEN
iRes := mConst.Target_iConsole
ELSIF pTarget = mConst.Target_sGUI THEN
iRes := mConst.Target_iGUI
ELSIF pTarget = mConst.Target_sDLL THEN
iRes := mConst.Target_iDLL
ELSIF pTarget = mConst.Target_sKolibry THEN
iRes := mConst.Target_iKolibry
ELSIF pTarget = mConst.Target_sObject THEN
iRes := mConst.Target_iObject
ELSIF pTarget = mConst.Target_sWin64 THEN
iRes := mConst.Target_iWin64
ELSE
iRes := 0
END
RETURN iRes
END Target_Get;
PROCEDURE Keys_Set (VAR pStackSize, pBaseAddress, pVersion: INTEGER; VAR pPic, pReloc: BOOLEAN; VAR pChecking: SET);
(* Set keys for begin compiling. *)
VAR
param: mPars.PATH;
i, j: INTEGER;
bEnd: BOOLEAN;
value: INTEGER;
minor, major: INTEGER;
BEGIN
bEnd := FALSE;
i := 4;
REPEAT
mUtil.GetArg(i, param);
IF param = "-stk" THEN
INC(i);
mUtil.GetArg(i, param);
IF mStr.StrToInt(param, value) & (1 <= value) & (value <= 32) THEN
pStackSize := value
END;
IF param[0] = "-" THEN
DEC(i)
END
ELSIF param = "-base" THEN
INC(i);
mUtil.GetArg(i, param);
IF mStr.StrToInt(param, value) THEN
pBaseAddress := ((value DIV 64) * 64) * 1024
END;
IF param[0] = "-" THEN
DEC(i)
END
ELSIF param = "-nochk" THEN
INC(i);
mUtil.GetArg(i, param);
IF param[0] = "-" THEN
DEC(i)
ELSE
j := 0;
WHILE param[j] # 0X DO
IF param[j] = "p" THEN
EXCL(pChecking, mSt.chkPTR)
ELSIF param[j] = "t" THEN
EXCL(pChecking, mSt.chkGUARD)
ELSIF param[j] = "i" THEN
EXCL(pChecking, mSt.chkIDX)
ELSIF param[j] = "b" THEN
EXCL(pChecking, mSt.chkBYTE)
ELSIF param[j] = "c" THEN
EXCL(pChecking, mSt.chkCHR)
ELSIF param[j] = "w" THEN
EXCL(pChecking, mSt.chkWCHR)
ELSIF param[j] = "r" THEN
EXCL(pChecking, mSt.chkCHR);
EXCL(pChecking, mSt.chkWCHR);
EXCL(pChecking, mSt.chkBYTE)
ELSIF param[j] = "a" THEN
pChecking := {}
END;
INC(j)
END
END
ELSIF param = "-ver" THEN
INC(i);
mUtil.GetArg(i, param);
IF mStr.StrToVer(param, major, minor) THEN
pVersion := major * 65536 + minor
END;
IF param[0] = "-" THEN
DEC(i)
END
ELSIF param = "-pic" THEN
pPic := TRUE
ELSIF param = "-reloc" THEN
pReloc := TRUE
ELSIF param = "" THEN
bEnd := TRUE
ELSE
mErr.error3("bad parameter: ", param, "")
END;
INC(i)
UNTIL bEnd
END Keys_Set;
PROCEDURE Main;
VAR
path: mPars.PATH;
inname: mPars.PATH;
ext: mPars.PATH;
app_path: mPars.PATH;
lib_path: mPars.PATH;
modname: mPars.PATH;
outname: mPars.PATH;
param: mPars.PATH;
temp: mPars.PATH;
target: INTEGER;
time: INTEGER;
StackSize,
Version,
BaseAdr: INTEGER;
pic, reloc: BOOLEAN;
checking: SET;
BEGIN
StackSize := 1;
Version := 65536;
pic := FALSE;
reloc := FALSE;
checking := mSt.chkALL;
mPath.GetCurrentDirectory(app_path);
lib_path := app_path;
mUtil.GetArg(1, inname);
IF inname = "" THEN
mCons.String("Akron Oberon-07/16 Compiler v"); mCons.Int(mConst.Version_Major); mCons.String("."); mCons.Int2Ln(mConst.Version_Minor); mCons.Ln;
mCons.StringLn("Usage: Compiler <main module> <output> <target> [optional settings]"); mCons.Ln;
mCons.StringLn('target = "con" | "gui" | "dll" | "kos" | "obj"'); mCons.Ln;
mCons.StringLn("optional settings:"); mCons.Ln;
mCons.StringLn(" -stk <size> set size of stack in megabytes"); mCons.Ln;
mCons.StringLn(" -base <address> set base address of image in kilobytes"); mCons.Ln;
mCons.StringLn(" -pic generate position-independent code"); mCons.Ln;
mCons.StringLn(" -reloc make relocation table"); mCons.Ln;
mCons.StringLn(' -ver <major.minor> set version of program ("obj" only)'); mCons.Ln;
mCons.StringLn(' -nochk <"ptibcwra"> disable runtime checking (pointers, types, indexes,');
mCons.StringLn(' BYTE, CHR, WCHR)'); mCons.Ln;
mUtil.Exit(0)
END;
mPath.split(inname, path, modname, ext);
IF ext # mConst.FILE_EXT THEN
mErr.error3('Inputfile name extension must be "', mConst.FILE_EXT, '"')
END;
IF mPath.isRelative(path) THEN
mPath.RelPath(app_path, path, temp);
path := temp
END;
mUtil.GetArg(2, outname);
IF outname = "" THEN
mErr.error1("not enough parameters")
END;
IF mPath.isRelative(outname) THEN
mPath.RelPath(app_path, outname, temp);
outname := temp
END;
mUtil.GetArg(3, param);
IF param = "" THEN
mErr.error1("not enough parameters")
END;
target := Target_Get(param);
IF target = 0 THEN
mErr.error1("bad parameter <target>")
END;
IF target = mConst.Target_iWin64 THEN
IF mUtil.bit_depth = 32 THEN
mErr.error1("bad parameter <target>")
END;
mPars.init(64)
ELSE
mPars.init(32)
END;
mPars.program.dll := target IN {mConst.Target_iDLL, mConst.Target_iObject};
mPars.program.obj := target = mConst.Target_iObject;
mStr.append(lib_path, "lib");
mStr.append(lib_path, mUtil.slash);
IF target IN {mConst.Target_iConsole, mConst.Target_iGUI, mConst.Target_iDLL} THEN
IF target = mConst.Target_iDLL THEN
BaseAdr := 10000000H
ELSE
BaseAdr := 400000H
END;
mStr.append(lib_path, "Windows32")
ELSIF target IN {mConst.Target_iKolibry, mConst.Target_iObject} THEN
mStr.append(lib_path, "KolibriOS")
ELSIF target = mConst.Target_iWin64 THEN
mStr.append(lib_path, "Windows64")
END;
mStr.append(lib_path, mUtil.slash);
Keys_Set(StackSize, BaseAdr, Version, pic, reloc, checking);
mSt.compile(path, lib_path, modname, outname, mConst.FILE_EXT, target, Version, StackSize, BaseAdr, pic, reloc, checking);
time := mUtil.GetTickCount() - mUtil.time;
mCons.Int(time DIV 100); mCons.String("."); mCons.Int2(time MOD 100); mCons.String(" sec, ");
mCons.Int(mWrit.counter); mCons.String(" bytes"); mCons.Ln;
mUtil.Exit(0)
END Main;
BEGIN
Main
END Compiler.
Reference in new issue View Git Blame Copy Permalink