util.ha (8580B)
1 // SPDX-License-Identifier: GPL-3.0-only 2 // (c) Hare authors <https://harelang.org> 3 4 use crypto::sha256; 5 use fmt; 6 use hare::ast; 7 use hare::module; 8 use hare::unparse; 9 use hash; 10 use io; 11 use memio; 12 use os; 13 use os::exec; 14 use path; 15 use shlex; 16 use strings; 17 18 // for use as a scratch buffer 19 let buf = path::buffer { ... }; 20 21 export fn get_version(harec: str) ([]u8 | error) = { 22 let cmd = match (exec::cmd(harec, "-v")) { 23 case let c: exec::command => 24 yield c; 25 case exec::nocmd => 26 fmt::fatalf("Error: Command not found: {}", harec); 27 case let e: exec::error => 28 return e; 29 }; 30 let pipe = exec::pipe(); 31 exec::addfile(&cmd, os::stdout_file, pipe.1); 32 let proc = exec::start(&cmd)?; 33 io::close(pipe.1)?; 34 const version = io::drain(pipe.0)?; 35 let status = exec::wait(&proc)?; 36 io::close(pipe.0)?; 37 match (exec::check(&status)) { 38 case void => 39 return version; 40 case let status: !exec::exit_status => 41 fmt::fatal(harec, "-v", exec::exitstr(status)); 42 }; 43 }; 44 45 fn get_deps(ctx: *context, t: *task) []str = { 46 let mod = ctx.mods[t.idx]; 47 switch (t.kind) { 48 case stage::TD => abort(); 49 case stage::SSA => 50 let deps = strings::dupall(mod.srcs.ha); 51 for (let (dep_idx, _) .. mod.deps) { 52 append(deps, get_cache(ctx, dep_idx, stage::TD)!); 53 }; 54 return deps; 55 case stage::S => 56 return alloc([get_cache(ctx, t.idx, stage::SSA)!]...); 57 case stage::O => 58 let deps = strings::dupall(mod.srcs.s); 59 append(deps, get_cache(ctx, t.idx, stage::S)!); 60 return deps; 61 case stage::BIN => 62 let deps: []str = []; 63 for (let i = 0z; i < len(ctx.mods); i += 1) { 64 let srcs = &ctx.mods[i].srcs; 65 for (let j = 0z; j < len(srcs.sc); j += 1) { 66 append(deps, strings::dup(srcs.sc[j])); 67 }; 68 append(deps, get_cache(ctx, i, stage::O)!); 69 for (let o .. srcs.o) { 70 append(deps, strings::dup(o)); 71 }; 72 }; 73 return deps; 74 }; 75 }; 76 77 // returns the arguments that don't depend on the result of the hash. these will 78 // be used to create the hash. see [[get_args]] for the arguments that depend 79 // on the result of the hash 80 fn get_flags(ctx: *context, t: *task) ([]str | error) = { 81 let flags: []str = strings::dupall(ctx.platform.default_flags[t.kind]); 82 83 let flags_env = switch (t.kind) { 84 case stage::TD => abort(); 85 case stage::SSA => 86 yield "HARECFLAGS"; 87 case stage::S => 88 yield "QBEFLAGS"; 89 case stage::O => 90 yield "ASFLAGS"; 91 case stage::BIN => 92 yield if (ctx.libc) "LDFLAGS" else "LDLINKFLAGS"; 93 }; 94 match (shlex::split(os::tryenv(flags_env, ""))) { 95 case let s: []str => 96 append(flags, s...); 97 case shlex::syntaxerr => 98 fmt::errorfln("warning: invalid shell syntax in ${}; ignoring", 99 flags_env)?; 100 }; 101 102 switch (t.kind) { 103 case stage::TD => abort(); 104 case stage::SSA => void; // below 105 case stage::S => 106 append(flags, strings::dup("-t")); 107 append(flags, strings::dup(ctx.arch.qbe_name)); 108 return flags; 109 case stage::O => 110 return flags; 111 case stage::BIN => 112 for (let libdir .. ctx.libdirs) { 113 append(flags, strings::dup("-L")); 114 append(flags, strings::dup(libdir)); 115 }; 116 if (ctx.libc) { 117 append(flags, strings::dup("-Wl,--gc-sections")); 118 } else { 119 append(flags, strings::dup("--gc-sections")); 120 append(flags, strings::dup("-z")); 121 append(flags, strings::dup("noexecstack")); 122 }; 123 return flags; 124 }; 125 126 append(flags, strings::dup("-a")); 127 append(flags, strings::dup(ctx.arch.name)); 128 129 let mod = ctx.mods[t.idx]; 130 if (len(ctx.ns) != 0 && t.idx == ctx.top) { 131 append(flags, strings::dup("-N")); 132 append(flags, unparse::identstr(ctx.ns)); 133 } else if (len(mod.ns) != 0 || ctx.libc) { 134 append(flags, strings::dup("-N")); 135 append(flags, unparse::identstr(mod.ns)); 136 }; 137 if (ctx.freestanding) { 138 append(flags, strings::dup("-m")); 139 append(flags, ""); 140 } else if (ctx.libc) { 141 append(flags, strings::dup("-m.main")); 142 }; 143 append(flags, strings::dup("-M")); 144 path::set(&buf, mod.path)?; 145 for (let i = 0z; i < len(mod.ns); i += 1) { 146 path::pop(&buf); 147 }; 148 append(flags, strings::concat(path::string(&buf), "/")); 149 150 path::set(&buf, mod.path)?; 151 let test = ctx.test && t.idx == ctx.top; 152 test ||= path::trimprefix(&buf, os::getcwd()) is str && ctx.submods; 153 if (test) { 154 append(flags, strings::dup("-T")); 155 }; 156 157 for (let define .. ctx.defines) { 158 let ident = define.ident; 159 let ns = ident[..len(ident) - 1]; 160 if (!ast::ident_eq(ns, mod.ns)) { 161 continue; 162 }; 163 let buf = memio::dynamic(); 164 memio::concat(&buf, "-D", ident[len(ident) - 1])!; 165 match (define._type) { 166 case null => void; 167 case let t: *ast::_type => 168 memio::concat(&buf, ":")!; 169 unparse::_type(&buf, &unparse::syn_nowrap, t)!; 170 }; 171 memio::concat(&buf, "=")!; 172 unparse::expr(&buf, &unparse::syn_nowrap, define.init)!; 173 append(flags, memio::string(&buf)!); 174 }; 175 176 return flags; 177 }; 178 179 fn get_hash( 180 ctx: *context, 181 deps: []str, 182 flags: []str, 183 t: *task, 184 ) [sha256::SZ]u8 = { 185 let h = sha256::sha256(); 186 187 hash::write(&h, strings::toutf8(ctx.cmds[t.kind])); 188 for (let flag .. flags) { 189 hash::write(&h, strings::toutf8(flag)); 190 }; 191 192 switch (t.kind) { 193 case stage::TD => abort(); 194 case stage::SSA => 195 hash::write(&h, strings::toutf8(ctx.arch.name)); 196 hash::write(&h, [0]); 197 hash::write(&h, ctx.version); 198 hash::write(&h, [0]); 199 for (let dep .. ctx.mods[t.idx].deps) { 200 let ns = unparse::identstr(dep.1); 201 defer free(ns); 202 let var = strings::concat("HARE_TD_", ns); 203 defer free(var); 204 let path = match (os::getenv(var)) { 205 case void => 206 continue; 207 case let path: str => 208 yield path; 209 }; 210 hash::write(&h, strings::toutf8(var)); 211 hash::write(&h, strings::toutf8("=")); 212 hash::write(&h, strings::toutf8(path)); 213 hash::write(&h, [0]); 214 }; 215 case stage::S => 216 hash::write(&h, strings::toutf8(ctx.arch.qbe_name)); 217 hash::write(&h, [0]); 218 case stage::O => void; 219 case stage::BIN => 220 for (let lib .. ctx.libs) { 221 hash::write(&h, strings::toutf8(lib)); 222 hash::write(&h, [0]); 223 }; 224 }; 225 226 for (let dep .. deps) { 227 hash::write(&h, strings::toutf8(dep)); 228 hash::write(&h, [0]); 229 }; 230 231 let prefix: [sha256::SZ]u8 = [0...]; 232 hash::sum(&h, prefix); 233 return prefix; 234 }; 235 236 // returns the value of flags plus the arguments that depend on the result of 237 // the hash. see [[get_flags]] for the arguments that don't depend on the hash 238 fn get_args(ctx: *context, tmp: str, flags: []str, t: *task) []str = { 239 let args = strings::dupall(flags); 240 append(args, strings::dup("-o")); 241 append(args, strings::dup(tmp)); 242 243 // TODO: https://todo.sr.ht/~sircmpwn/hare/837 244 let srcs: []str = switch (t.kind) { 245 case stage::TD => abort(); 246 case stage::SSA => 247 let td = get_cache(ctx, t.idx, stage::SSA)!; 248 defer free(td); 249 append(args, strings::dup("-t")); 250 append(args, strings::concat(td, ".td.tmp")); 251 yield ctx.mods[t.idx].srcs.ha; 252 case stage::S => 253 append(args, get_cache(ctx, t.idx, stage::SSA)!); 254 yield []; 255 case stage::O => 256 append(args, get_cache(ctx, t.idx, stage::S)!); 257 yield ctx.mods[t.idx].srcs.s; 258 case stage::BIN => 259 for (let i = 0z; i < len(ctx.mods); i += 1) { 260 let srcs = ctx.mods[i].srcs; 261 for (let sc .. srcs.sc) { 262 append(args, strings::dup("-T")); 263 append(args, strings::dup(sc)); 264 }; 265 append(args, get_cache(ctx, i, stage::O)!); 266 for (let o .. srcs.o) { 267 append(args, strings::dup(o)); 268 }; 269 }; 270 // XXX: when dynamically linking on Linux, we have to disable 271 // gc-sections again after enabling it in get_flags(); it looks 272 // like leaving this enabled gets us SIGILL in libc (musl). this 273 // is not broken on other platforms such as OpenBSD 274 if (ctx.libc) { 275 append(args, strings::dup("-Wl,--no-gc-sections")); 276 }; 277 for (let lib .. ctx.libs) { 278 append(args, strings::dup("-l")); 279 append(args, strings::dup(lib)); 280 }; 281 yield []; 282 }; 283 for (let src .. srcs) { 284 append(args, strings::dup(src)); 285 }; 286 return args; 287 }; 288 289 fn write_args(ctx: *context, out: str, args: []str, t: *task) (void | error) = { 290 let txt = os::create(out, 0o644)?; 291 defer io::close(txt)!; 292 if (t.kind == stage::SSA) { 293 for (let (_, ident) .. ctx.mods[t.idx].deps) { 294 let ns = unparse::identstr(ident); 295 defer free(ns); 296 let var = strings::concat("HARE_TD_", ns); 297 defer free(var); 298 fmt::fprintfln(txt, "# {}={}", var, os::tryenv(var, ""))?; 299 }; 300 }; 301 fmt::fprint(txt, ctx.cmds[t.kind])?; 302 for (let arg .. args) { 303 fmt::fprint(txt, " ")?; 304 shlex::quote(txt, arg)?; 305 }; 306 fmt::fprintln(txt)?; 307 }; 308 309 // XXX: somewhat questionable, related to the hare::module context hackery, can 310 // probably only be improved with language changes 311 fn unwrap_module_error(err: module::error) module::error = { 312 let unwrapped = err; 313 for (true) match (unwrapped) { 314 case let e: module::errcontext => 315 unwrapped = *e.1; 316 case => 317 break; 318 }; 319 return unwrapped; 320 };