From 22f1c3acef362d57f351db9e8b32e3560b3eca7c Mon Sep 17 00:00:00 2001 From: Jeff Garzik Date: Sat, 10 Oct 2026 17:13:46 +0000 Subject: [PATCH 01/17] Start the Rust runtime: crate, error module, built beside the asm The runtime is to move from the two hand-written x86-64 assembly trees to one no_std Rust crate, rt/, so that it is one source for every OS and can follow the compiler to aarch64. This is its first step; nothing links it yet, and every program still runs on the assembly. - rt/ is a workspace member (and a default member, so clippy and cargo test cover it). Its unit tests run with std. - build.rs builds it with rustc for the target: a staticlib with fat LTO, emitted as the one object that makes (/rt.o, 14 KB, needing only libc). The staticlib archive itself would carry 4 MB of compiler_builtins the runtime never references. - export! defines each helper under its symbol name with the System V convention on x86-64 -- on Windows too, so that a string result comes back in rax:rdx as Cranelift's two-value return does -- and the C convention elsewhere. - sys holds the libc declarations and what differs by OS: the standard streams (glibc, macOS, UCRT) and the line ending. - error is error.s in Rust: the messages and their GW-BASIC numbers, the four trapping words generated code reads by symbol, _rt_error, _rt_error_num, _rt_fatal, _rt_err, _rt_erl, _rt_stop and _rt_end. Co-Authored-By: Claude Opus 5.5 --- Cargo.lock | 4 + Cargo.toml | 6 + build.rs | 35 ++++++ rt/Cargo.toml | 16 +++ rt/src/error.rs | 283 ++++++++++++++++++++++++++++++++++++++++++++++++ rt/src/lib.rs | 154 ++++++++++++++++++++++++++ rt/src/sys.rs | 98 +++++++++++++++++ 7 files changed, 596 insertions(+) create mode 100644 rt/Cargo.toml create mode 100644 rt/src/error.rs create mode 100644 rt/src/lib.rs create mode 100644 rt/src/sys.rs diff --git a/Cargo.lock b/Cargo.lock index a4aa0a2..ea6f6ad 100644 --- a/Cargo.lock +++ b/Cargo.lock @@ -631,3 +631,7 @@ dependencies = [ "target-lexicon", "tempfile", ] + +[[package]] +name = "xbasic64-rt" +version = "1.0.2" diff --git a/Cargo.toml b/Cargo.toml index dbc641b..41ffd57 100644 --- a/Cargo.toml +++ b/Cargo.toml @@ -13,6 +13,12 @@ keywords = ["basic", "compiler", "x86-64", "retro", "programming-language"] categories = ["compilers", "command-line-utilities", "development-tools"] rust-version = "1.96" +# The runtime library is a member, so that clippy and its unit tests cover +# it; build.rs builds the copy programs link against. +[workspace] +members = ["rt"] +default-members = [".", "rt"] + [features] default = [] diff --git a/build.rs b/build.rs index 1f0fe7c..152fe3f 100644 --- a/build.rs +++ b/build.rs @@ -8,6 +8,12 @@ //! The assembler is the one the compiler has always used for the target: //! GNU `as` for ELF, `clang -c` for COFF. So building the compiler needs it, //! as running the compiler always did. +//! +//! The Rust runtime in `rt/` is built here too, with rustc, as a `no_std` +//! staticlib for the target, emitted as the one object fat LTO makes of it +//! and the parts of `core` it uses (`$OUT_DIR/rt.o`). It is not linked into +//! programs yet: it is being ported from the assembly, which it will replace +//! in one switch. // Copyright (c) 2025-2026 Jeff Garzik // SPDX-License-Identifier: MIT @@ -22,6 +28,7 @@ use std::process::Command; fn main() { println!("cargo:rerun-if-changed=src/rtbuild.rs"); println!("cargo:rerun-if-changed=src/runtime"); + println!("cargo:rerun-if-changed=rt/src"); let os = env::var("CARGO_CFG_TARGET_OS").expect("cargo sets CARGO_CFG_TARGET_OS"); let out = PathBuf::from(env::var("OUT_DIR").expect("cargo sets OUT_DIR")); @@ -48,4 +55,32 @@ fn main() { "the runtime does not assemble:\n{}", String::from_utf8_lossy(&output.stderr) ); + + build_rt(&out); +} + +/// Build `rt/` for the target as one object: a staticlib, with fat LTO +/// merging it and what it uses of `core` into a single unit, emitted as an +/// object. The staticlib archive would also carry all of `compiler_builtins` +/// -- 4 MB the runtime does not reference. +fn build_rt(out: &std::path::Path) { + let rustc = env::var("RUSTC").unwrap_or_else(|_| "rustc".into()); + let target = env::var("TARGET").expect("cargo sets TARGET"); + let obj = out.join("rt.o"); + let output = Command::new(rustc) + .args(["--edition", "2024", "--crate-type", "staticlib"]) + .args(["--crate-name", "xbasic64_rt", "--target", &target]) + .args(["-C", "opt-level=3", "-C", "panic=abort", "-C", "lto=fat"]) + .args(["-C", "codegen-units=1", "-C", "debug-assertions=off"]) + .args(["-C", "overflow-checks=off", "--emit", "obj"]) + .arg("-o") + .arg(&obj) + .arg("rt/src/lib.rs") + .output() + .unwrap_or_else(|e| panic!("cannot run rustc for the runtime: {e}")); + assert!( + output.status.success(), + "the runtime does not build:\n{}", + String::from_utf8_lossy(&output.stderr) + ); } diff --git a/rt/Cargo.toml b/rt/Cargo.toml new file mode 100644 index 0000000..dc7e28d --- /dev/null +++ b/rt/Cargo.toml @@ -0,0 +1,16 @@ +[package] +name = "xbasic64-rt" +version = "1.0.2" +edition = "2024" +authors = ["Jeff Garzik "] +description = "The runtime library linked into every program xbasic64 compiles" +license = "MIT" +publish = false +rust-version = "1.96" + +# Built for real by the compiler's build.rs, with rustc, as a no_std +# staticlib for the target. Cargo builds it only as an rlib, so that clippy +# and the unit tests (which run with std) cover it. +[lib] +path = "src/lib.rs" +doctest = false diff --git a/rt/src/error.rs b/rt/src/error.rs new file mode 100644 index 0000000..b77297d --- /dev/null +++ b/rt/src/error.rs @@ -0,0 +1,283 @@ +//! Runtime errors: raising, trapping state, and the fatal report +//! +//! One path for every runtime check. A check passes a message -- one of the +//! statics below, NUL-terminated -- and the BASIC line, and the message +//! carries GW-BASIC's error number through `ERR_CODES`. +//! +//! When ON ERROR has armed a handler and none is running, a raised error is +//! trapped: `_err_pending` is set and the raising helper returns normally, +//! through its own epilogue; generated code tests `_err_pending` after every +//! call that can fail. Otherwise the error is reported on stderr as +//! `?message in line` and the program exits with status 1. + +// Copyright (c) 2025-2026 Jeff Garzik +// SPDX-License-Identifier: MIT + +use crate::sys; +use crate::{Word, cstr}; +use core::ffi::c_char; + +macro_rules! messages { + ($($name:ident = $text:literal;)*) => {$( + #[unsafe(no_mangle)] + pub static $name: [u8; $text.len() + 1] = cstr($text); + )*}; +} + +// Named by generated code, which passes them to `_rt_error`. +messages! { + _err_syntax = "Syntax error"; + _err_subscript = "Subscript out of range"; + _err_typemismatch = "Type mismatch"; + _err_div0 = "Division by zero"; + _err_domain = "Illegal function call"; + _err_overflow = "Overflow"; + _err_dupdef = "Duplicate definition"; + _err_memory = "Out of memory"; + _err_gosub = "GOSUB stack overflow"; + _err_noreturn = "RETURN without GOSUB"; + _err_outofdata = "Out of DATA"; + _err_badfile = "Bad file number"; + _err_badmode = "Bad file mode"; + _err_fieldovf = "FIELD overflow"; + _err_permission = "Permission denied"; + _err_notfound = "File not found"; + _err_alreadyopen = "File already open"; + _err_pastend = "Input past end of file"; + _err_badname = "Bad file name"; + _err_access = "Path/File access error"; + _err_pathnotfound = "Path not found"; + _err_unprintable = "Unprintable error"; + // RESUME's own failure. Never trapped: a handler that trapped it would be + // re-entered by its own RESUME, forever. + _err_resnoerr = "RESUME without error"; +} + +/// GW-BASIC's error numbers, so that a listing's `IF ERR = 53` means what it +/// meant in 1983. Searched by number too, for the ERROR statement -- so +/// where two messages share a number the first listed is the one ERROR n +/// raises. +static ERR_CODES: [(&[u8], u64); 21] = [ + (&_err_syntax, 2), + (&_err_noreturn, 3), + (&_err_outofdata, 4), + (&_err_domain, 5), + (&_err_overflow, 6), + (&_err_memory, 7), + (&_err_gosub, 7), + (&_err_subscript, 9), + (&_err_dupdef, 10), + (&_err_div0, 11), + (&_err_typemismatch, 13), + (&_err_fieldovf, 50), + (&_err_badfile, 52), + (&_err_notfound, 53), + (&_err_badmode, 54), + (&_err_alreadyopen, 55), + (&_err_pastend, 62), + (&_err_badname, 64), + (&_err_permission, 70), + (&_err_access, 75), + (&_err_pathnotfound, 76), +]; + +// Error-trapping state, read and written by generated code. All zero means +// "not trapping". + +/// Which ON ERROR target, numbered from 1; 0 = trapping off. +#[unsafe(no_mangle)] +pub static _err_handler: Word = Word::new(0); +/// 1 from a trapped error until its handler runs; 2 while procedures unwind +/// toward a RESUME label; 3 while they unwind to a GOSUB in main. +#[unsafe(no_mangle)] +pub static _err_pending: Word = Word::new(0); +/// Nonzero while a handler runs. +#[unsafe(no_mangle)] +pub static _err_active: Word = Word::new(0); +/// The line now running: codegen stores it per statement when trapping, +/// else before calls that can fail. +#[unsafe(no_mangle)] +pub static _err_line: Word = Word::new(0); + +/// What ERR returns. +static ERR_CODE: Word = Word::new(0); +/// What ERL returns: `_err_line` as it was when the error was trapped. The +/// handler's own statements overwrite `_err_line` the moment it runs. +static ERR_ERL: Word = Word::new(0); + +/// Raise the error `msg` on `line` (0: the line in `_err_line`). Returns only +/// when a handler traps it. +pub fn raise(msg: &'static [u8], line: i64) { + let code = ERR_CODES + .iter() + .find(|(m, _)| core::ptr::eq(m.as_ptr(), msg.as_ptr())) + .map_or(0, |&(_, n)| n); + raise_with_code(msg.as_ptr(), code, line); +} + +/// The common path, with the number ERR is to report. +fn raise_with_code(msg: *const u8, code: u64, line: i64) { + // An error already on its way to the handler wins: its helper may carry + // on to the end of what it was doing, and each step fails the same way. + if _err_pending.get() != 0 { + return; + } + // Trapped only when ON ERROR armed a handler and none is running: + // GW-BASIC does not trap an error raised inside a handler, which is also + // what stops handler -> error -> handler from looping forever. + if _err_handler.get() == 0 || _err_active.get() != 0 { + unsafe { fatal(msg, line) } + } + ERR_CODE.set(code); + ERR_ERL.set(_err_line.get()); + _err_active.set(1); + _err_pending.set(1); +} + +/// Report `msg` on stderr and exit with status 1. +/// +/// # Safety +/// `msg` must be NUL-terminated. +unsafe fn fatal(msg: *const u8, line: i64) -> ! { + // Most helpers pass no line; generated code stored the one running. + let line = if line != 0 { + line + } else { + _err_line.get() as i64 + }; + sys::flush_all(); + let msg = msg.cast::(); + unsafe { + if line != 0 { + sys::fprintf(sys::stderr(), FMT_LINE.as_ptr().cast(), msg, line); + } else { + sys::fprintf(sys::stderr(), FMT_BARE.as_ptr().cast(), msg); + } + sys::exit(1) + } +} + +#[cfg(windows)] +const FMT_LINE: &[u8] = b"?%s in %lld\r\n\0"; +#[cfg(windows)] +const FMT_BARE: &[u8] = b"?%s\r\n\0"; +#[cfg(windows)] +const FMT_STOP_LINE: &[u8] = b"Break in %lld\r\n\0"; +#[cfg(windows)] +const FMT_STOP_BARE: &[u8] = b"Break\r\n\0"; +#[cfg(not(windows))] +const FMT_LINE: &[u8] = b"?%s in %lld\n\0"; +#[cfg(not(windows))] +const FMT_BARE: &[u8] = b"?%s\n\0"; +#[cfg(not(windows))] +const FMT_STOP_LINE: &[u8] = b"Break in %lld\n\0"; +#[cfg(not(windows))] +const FMT_STOP_BARE: &[u8] = b"Break\n\0"; + +export! { + /// ERR: the number of the error that was trapped, 0 if none. + fn _rt_err() -> i32 { + ERR_CODE.get() as i32 + } + + /// ERL: the line the trapped error happened on, 0 if none. + fn _rt_erl() -> i32 { + ERR_ERL.get() as i32 + } + + /// The ERROR statement: raise GW-BASIC error number `n`. ERR is `n` + /// itself, whatever message it maps to, so `ERROR 200 ... IF ERR = 200` + /// works for an error of the program's own. + fn _rt_error_num(n: i64, line: i64) { + let msg = ERR_CODES + .iter() + .find(|&&(_, c)| c as i64 == n) + .map_or(&_err_unprintable[..], |&(m, _)| m); + raise_with_code(msg.as_ptr(), n as u64, line); + } + + /// Raise the error `msg` (one of the `_err_*` messages) on `line`, 0 + /// for the line in `_err_line`. Returns only when a handler traps it. + fn _rt_error(msg: *const u8, line: i64) { + let code = ERR_CODES + .iter() + .find(|(m, _)| core::ptr::eq(m.as_ptr(), msg)) + .map_or(0, |&(_, n)| n); + raise_with_code(msg, code, line); + } + + /// Report `msg` and exit, without consulting the handler: for the errors + /// that must never be trapped. + fn _rt_fatal(msg: *const u8, line: i64) -> ! { + unsafe { fatal(msg, line) } + } + + /// STOP: say where, and end the program normally, as END does. + /// GW-BASIC prints "Break in 20" and returns to its prompt; a compiled + /// program has no prompt. + fn _rt_stop(line: i64) -> ! { + sys::flush_all(); + unsafe { + if line != 0 { + sys::fprintf(sys::stderr(), FMT_STOP_LINE.as_ptr().cast(), line); + } else { + sys::fprintf(sys::stderr(), FMT_STOP_BARE.as_ptr().cast()); + } + _rt_end() + } + } + + /// END: terminate the program from any frame, flushing every stream. + fn _rt_end() -> ! { + unsafe { sys::exit(0) } + } +} + +#[cfg(test)] +mod tests { + use super::*; + + #[test] + fn messages_are_c_strings() { + assert_eq!(&_err_div0[..], b"Division by zero\0"); + assert_eq!(_err_memory.last(), Some(&0)); + } + + #[test] + fn a_message_carries_its_number() { + let n = |m: &[u8]| { + ERR_CODES + .iter() + .find(|(x, _)| x.as_ptr() == m.as_ptr()) + .unwrap() + .1 + }; + assert_eq!(n(&_err_subscript), 9); + assert_eq!(n(&_err_notfound), 53); + // ERROR 7 raises the first message listed with 7. + let first7 = ERR_CODES.iter().find(|&&(_, c)| c == 7).unwrap().0; + assert_eq!(first7.as_ptr(), _err_memory.as_ptr()); + } + + #[test] + fn a_trapped_error_sets_err_and_erl_once() { + _err_handler.set(1); + _err_line.set(30); + raise(&_err_div0, 0); + assert_eq!(_err_pending.get(), 1); + assert_eq!(unsafe { _rt_err() }, 11); + assert_eq!(unsafe { _rt_erl() }, 30); + // The first error wins while one is pending. + raise(&_err_overflow, 0); + assert_eq!(unsafe { _rt_err() }, 11); + unsafe { _rt_error_num(200, 0) }; + assert_eq!(unsafe { _rt_err() }, 11); + _err_pending.set(0); + _err_active.set(0); + unsafe { _rt_error_num(200, 0) }; + assert_eq!(unsafe { _rt_err() }, 200); + _err_pending.set(0); + _err_active.set(0); + _err_handler.set(0); + } +} diff --git a/rt/src/lib.rs b/rt/src/lib.rs new file mode 100644 index 0000000..8aaf9ef --- /dev/null +++ b/rt/src/lib.rs @@ -0,0 +1,154 @@ +//! The runtime library every compiled BASIC program links against +//! +//! Generated code calls the helpers here (`_rt_*`, listed with their +//! signatures in the compiler's `src/rtsig.rs`) and reads and writes the +//! error-trapping words in `error` by symbol. The program in turn defines +//! the DATA table the runtime reads. +//! +//! It is `no_std` and calls the C library through the declarations in +//! `sys`, so it is one portable source for every target: the compiler's +//! `build.rs` builds it with rustc as a staticlib for the target, and embeds +//! that. Numbers are formatted with the C library's `snprintf`, not +//! `core::fmt`, which would add tens of kilobytes to every program. +//! +//! The unit tests run with std, as an ordinary crate. + +// Copyright (c) 2025-2026 Jeff Garzik +// SPDX-License-Identifier: MIT + +#![cfg_attr(not(test), no_std)] +// The symbol names are the ABI generated code links against. +#![allow(non_upper_case_globals)] + +/// Define helpers generated code calls, by their symbol names. +/// +/// On x86-64 every helper uses the System V convention, on every OS, and +/// codegen calls it so: a string comes back as a two-word struct in +/// rax:rdx, which is what Cranelift's two-value return is, whereas the +/// Windows C convention returns it through a hidden pointer. Elsewhere it is +/// the platform's C convention, which returns two words in two registers. +/// +/// Each is `unsafe` to call: its contract is its signature in the +/// compiler's `src/rtsig.rs`, and the pointers it is given must be valid. +macro_rules! export { + ($( + $(#[$meta:meta])* + fn $name:ident($($arg:ident: $ty:ty),* $(,)?) $(-> $ret:ty)? $body:block + )*) => {$( + $(#[$meta])* + #[cfg(target_arch = "x86_64")] + #[allow(clippy::missing_safety_doc)] + #[unsafe(no_mangle)] + pub unsafe extern "sysv64" fn $name($($arg: $ty),*) $(-> $ret)? $body + + $(#[$meta])* + #[cfg(not(target_arch = "x86_64"))] + #[allow(clippy::missing_safety_doc)] + #[unsafe(no_mangle)] + pub unsafe extern "C" fn $name($($arg: $ty),*) $(-> $ret)? $body + )*}; +} + +pub mod error; +pub mod sys; + +/// A string as generated code passes it: a pointer and a length, with no +/// terminator. Returned by value it is two words in two registers. +#[repr(C)] +#[derive(Clone, Copy, Debug, PartialEq, Eq)] +pub struct Str { + pub ptr: *const u8, + pub len: usize, +} + +impl Str { + pub const EMPTY: Str = Str { + ptr: core::ptr::null(), + len: 0, + }; + + /// The bytes. A null pointer with length 0 is the empty string. + /// + /// # Safety + /// `ptr` must point at `len` readable bytes that outlive the slice. + pub unsafe fn bytes<'a>(self) -> &'a [u8] { + if self.len == 0 { + &[] + } else { + unsafe { core::slice::from_raw_parts(self.ptr, self.len) } + } + } +} + +/// A word generated code reads and writes by symbol, as a plain 8-byte +/// object in writable data. +#[repr(transparent)] +pub struct Word(core::cell::UnsafeCell); + +// The runtime is single-threaded, as every BASIC program is. +unsafe impl Sync for Word {} + +impl Word { + pub const fn new(v: u64) -> Word { + Word(core::cell::UnsafeCell::new(v)) + } + pub fn get(&self) -> u64 { + unsafe { *self.0.get() } + } + pub fn set(&self, v: u64) { + unsafe { *self.0.get() = v } + } +} + +/// Private runtime state: a value only this library touches. +#[repr(transparent)] +pub struct State(core::cell::UnsafeCell); + +unsafe impl Sync for State {} + +impl State { + pub const fn new(v: T) -> State { + State(core::cell::UnsafeCell::new(v)) + } + /// The value, to read or change. + /// + /// # Safety + /// No other reference to it may be live: the runtime is single-threaded + /// and no helper holds one across a call that could take another. + #[allow(clippy::mut_from_ref)] + pub unsafe fn get(&self) -> &mut T { + unsafe { &mut *self.0.get() } + } +} + +/// `s` with a NUL appended, as a fixed-size array: for C strings defined as +/// statics, whose length must be part of their type. +pub const fn cstr(s: &str) -> [u8; N] { + let b = s.as_bytes(); + assert!(b.len() + 1 == N); + let mut a = [0u8; N]; + let mut i = 0; + while i < b.len() { + a[i] = b[i]; + i += 1; + } + a +} + +/// A fresh buffer of `len` bytes for a string result the caller owns and +/// frees: every string a helper returns that is not a slice of another +/// comes from here, which is what rtsig's `fresh` means. Out of memory is +/// raised, and an empty string returned, when there is none. +pub fn alloc_str(len: usize) -> *mut u8 { + let p = unsafe { sys::malloc(len.max(1)) }; + if p.is_null() { + error::raise(&error::_err_memory[..], 0); + } + p +} + +#[cfg(not(test))] +#[panic_handler] +fn panic(_: &core::panic::PanicInfo) -> ! { + unsafe { sys::abort() } +} diff --git a/rt/src/sys.rs b/rt/src/sys.rs new file mode 100644 index 0000000..5186227 --- /dev/null +++ b/rt/src/sys.rs @@ -0,0 +1,98 @@ +//! The C library, and the few places where operating systems differ +//! +//! Everything the runtime needs from outside is declared here, so the rest +//! of it is one source for every target. What differs -- how to reach the +//! standard streams, where errno lives, what ends a line -- is settled here +//! too, by `cfg`. + +// Copyright (c) 2025-2026 Jeff Garzik +// SPDX-License-Identifier: MIT + +use core::ffi::{c_char, c_int, c_void}; + +/// The C library's `FILE`, only ever handled by pointer. +pub enum FILE {} + +unsafe extern "C" { + pub fn malloc(size: usize) -> *mut u8; + pub fn calloc(n: usize, size: usize) -> *mut u8; + pub fn realloc(p: *mut u8, size: usize) -> *mut u8; + pub fn free(p: *mut u8); + pub fn abort() -> !; + pub fn exit(code: c_int) -> !; + + pub fn fflush(f: *mut FILE) -> c_int; + pub fn fwrite(p: *const c_void, size: usize, n: usize, f: *mut FILE) -> usize; + pub fn fprintf(f: *mut FILE, fmt: *const c_char, ...) -> c_int; + pub fn snprintf(buf: *mut c_char, n: usize, fmt: *const c_char, ...) -> c_int; +} + +/// What ends a line of output: Windows programs have always written CRLF, +/// and the standard streams there are in binary mode so that nothing is +/// translated behind the runtime's back. +#[cfg(windows)] +pub const NEWLINE: &[u8] = b"\r\n"; +#[cfg(not(windows))] +pub const NEWLINE: &[u8] = b"\n"; + +#[cfg(all(unix, not(target_vendor = "apple")))] +mod streams { + use super::FILE; + unsafe extern "C" { + static stdout: *mut FILE; + static stderr: *mut FILE; + } + pub fn out() -> *mut FILE { + unsafe { stdout } + } + pub fn err() -> *mut FILE { + unsafe { stderr } + } +} + +#[cfg(target_vendor = "apple")] +mod streams { + use super::FILE; + unsafe extern "C" { + static __stdoutp: *mut FILE; + static __stderrp: *mut FILE; + } + pub fn out() -> *mut FILE { + unsafe { __stdoutp } + } + pub fn err() -> *mut FILE { + unsafe { __stderrp } + } +} + +#[cfg(windows)] +mod streams { + use super::FILE; + unsafe extern "C" { + fn __acrt_iob_func(index: u32) -> *mut FILE; + } + pub fn out() -> *mut FILE { + unsafe { __acrt_iob_func(1) } + } + pub fn err() -> *mut FILE { + unsafe { __acrt_iob_func(2) } + } +} + +pub use streams::{err as stderr, out as stdout}; + +/// Write `bytes` to `f`, all of them: a string's NUL bytes included. +/// +/// # Safety +/// `f` must be an open stream. +pub unsafe fn write(f: *mut FILE, bytes: &[u8]) { + if !bytes.is_empty() { + unsafe { fwrite(bytes.as_ptr().cast(), 1, bytes.len(), f) }; + } +} + +/// Flush every output stream, before the process writes to stderr or ends, +/// so that output already written is neither lost nor out of order. +pub fn flush_all() { + unsafe { fflush(core::ptr::null_mut()) }; +} From 78cfddc7c2affc09f909543f13d12e9da9d87899 Mon Sep 17 00:00:00 2001 From: Jeff Garzik Date: Sat, 10 Oct 2026 17:15:10 +0000 Subject: [PATCH 02/17] rt: the module layout, and the interfaces shared between modules One module per assembly file. num and string declare what the others call -- scan_number, fmt_double, fmt_basic and strdup -- so that they can be ported side by side; their bodies are still todo!(). Nothing links rt. Co-Authored-By: Claude Opus 5.5 --- rt/src/data.rs | 4 ++++ rt/src/file.rs | 4 ++++ rt/src/input.rs | 4 ++++ rt/src/lib.rs | 8 +++++++ rt/src/math.rs | 4 ++++ rt/src/num.rs | 55 ++++++++++++++++++++++++++++++++++++++++++++++++ rt/src/print.rs | 4 ++++ rt/src/string.rs | 17 +++++++++++++++ rt/src/using.rs | 4 ++++ 9 files changed, 104 insertions(+) create mode 100644 rt/src/data.rs create mode 100644 rt/src/file.rs create mode 100644 rt/src/input.rs create mode 100644 rt/src/math.rs create mode 100644 rt/src/num.rs create mode 100644 rt/src/print.rs create mode 100644 rt/src/string.rs create mode 100644 rt/src/using.rs diff --git a/rt/src/data.rs b/rt/src/data.rs new file mode 100644 index 0000000..e80744e --- /dev/null +++ b/rt/src/data.rs @@ -0,0 +1,4 @@ +//! DATA, READ and RESTORE, and creating an array by using it (data.s) + +// Copyright (c) 2025-2026 Jeff Garzik +// SPDX-License-Identifier: MIT diff --git a/rt/src/file.rs b/rt/src/file.rs new file mode 100644 index 0000000..a09a09d --- /dev/null +++ b/rt/src/file.rs @@ -0,0 +1,4 @@ +//! Files and the console as file 0: OPEN, PRINT #, INPUT #, RANDOM files, FIELD, GET/PUT, LOCK (file.s) + +// Copyright (c) 2025-2026 Jeff Garzik +// SPDX-License-Identifier: MIT diff --git a/rt/src/input.rs b/rt/src/input.rs new file mode 100644 index 0000000..d16d212 --- /dev/null +++ b/rt/src/input.rs @@ -0,0 +1,4 @@ +//! Console INPUT and LINE INPUT (input.s) + +// Copyright (c) 2025-2026 Jeff Garzik +// SPDX-License-Identifier: MIT diff --git a/rt/src/lib.rs b/rt/src/lib.rs index 8aaf9ef..7092afb 100644 --- a/rt/src/lib.rs +++ b/rt/src/lib.rs @@ -49,8 +49,16 @@ macro_rules! export { )*}; } +pub mod data; pub mod error; +pub mod file; +pub mod input; +pub mod math; +pub mod num; +pub mod print; +pub mod string; pub mod sys; +pub mod using; /// A string as generated code passes it: a pointer and a length, with no /// terminator. Returned by value it is two words in two registers. diff --git a/rt/src/math.rs b/rt/src/math.rs new file mode 100644 index 0000000..01b7c6c --- /dev/null +++ b/rt/src/math.rs @@ -0,0 +1,4 @@ +//! RND, RANDOMIZE, TIMER, DATE$, TIME$, BEEP, CLS, LOCATE, COLOR, POS (math.s) + +// Copyright (c) 2025-2026 Jeff Garzik +// SPDX-License-Identifier: MIT diff --git a/rt/src/num.rs b/rt/src/num.rs new file mode 100644 index 0000000..46ecb57 --- /dev/null +++ b/rt/src/num.rs @@ -0,0 +1,55 @@ +//! Numbers as text: GW-BASIC's number formatting, and its number reader +//! +//! Ported from `_rt_fmt_double` / `_rt_fmt_basic` (print.s) and +//! `_rt_scan_number` (string.s). Shared by PRINT, STR$, WRITE, PRINT USING, +//! VAL, INPUT, INPUT # and READ, so they all agree. + +// Copyright (c) 2025-2026 Jeff Garzik +// SPDX-License-Identifier: MIT + +/// What `scan_number` read. +#[derive(Clone, Copy, Debug, PartialEq)] +pub struct Scanned { + /// Bytes consumed, up to the last that belongs to the number; 0 when + /// the text does not begin with a number at all. + pub consumed: usize, + /// The value; 0 when there is no number. + pub value: f64, + /// The value is too large for a DOUBLE. + pub overflow: bool, +} + +/// Read a number the way GW-BASIC's VAL and INPUT do (`_rt_scan_number`). +pub fn scan_number(text: &[u8]) -> Scanned { + let _ = text; + todo!("port _rt_scan_number") +} + +/// A formatted number: at most `NumText::CAP` bytes, no terminator. +#[derive(Clone, Copy)] +pub struct NumText { + buf: [u8; NumText::CAP], + len: usize, +} + +impl NumText { + pub const CAP: usize = 48; + + pub fn as_bytes(&self) -> &[u8] { + &self.buf[..self.len] + } +} + +/// A number's digits as GW-BASIC writes them, without the leading blank +/// (`_rt_fmt_double`): 7 significant digits for a SINGLE, 16 for a DOUBLE. +pub fn fmt_double(x: f64, single: bool) -> NumText { + let _ = (x, single); + todo!("port _rt_fmt_double") +} + +/// `fmt_double` with the blank that stands where a minus sign would go, as +/// PRINT and STR$ write a number (`_rt_fmt_basic`). +pub fn fmt_basic(x: f64, single: bool) -> NumText { + let _ = (x, single); + todo!("port _rt_fmt_basic") +} diff --git a/rt/src/print.rs b/rt/src/print.rs new file mode 100644 index 0000000..d342f3c --- /dev/null +++ b/rt/src/print.rs @@ -0,0 +1,4 @@ +//! Console setup at program start (print.s, _rt_platform_init) + +// Copyright (c) 2025-2026 Jeff Garzik +// SPDX-License-Identifier: MIT diff --git a/rt/src/string.rs b/rt/src/string.rs new file mode 100644 index 0000000..cf34d56 --- /dev/null +++ b/rt/src/string.rs @@ -0,0 +1,17 @@ +//! String functions: LEFT$, MID$, INSTR, concatenation, conversions +//! +//! Ported from string.s. A string is a (pointer, length) pair; slices of an +//! argument are returned as they are, and every fresh result comes from +//! `crate::alloc_str`. + +// Copyright (c) 2025-2026 Jeff Garzik +// SPDX-License-Identifier: MIT + +use crate::Str; + +/// A fresh, owned copy of `s` (what `_rt_strdup` does), for helpers that +/// build a result in a scratch buffer and must not return the buffer itself. +pub fn strdup(s: &[u8]) -> Str { + let _ = s; + todo!("port _rt_strdup") +} diff --git a/rt/src/using.rs b/rt/src/using.rs new file mode 100644 index 0000000..03839a3 --- /dev/null +++ b/rt/src/using.rs @@ -0,0 +1,4 @@ +//! PRINT USING (using.s) + +// Copyright (c) 2025-2026 Jeff Garzik +// SPDX-License-Identifier: MIT From 39969ec140d37757e7afe2bc4a1b0d23f6515c9b Mon Sep 17 00:00:00 2001 From: Jeff Garzik Date: Sat, 10 Oct 2026 17:21:50 +0000 Subject: [PATCH 03/17] rt: port math.s -- RND, RANDOMIZE, TIMER, DATE$, TIME$, BEEP, CLS, LOCATE, COLOR, POS The xorshift64 generator and its splitmix64 seeding, bit for bit (unit tests hold the sequence the asm runtime prints); TIMER from one clock reading (gettimeofday, or _ftime64 on Windows) in local time; DATE$ and TIME$ through strftime, as fresh strings; the console escapes formatted with snprintf and written to the C library's stdout on every OS. sys.rs gains a marked block for the clock and struct tm. file.rs gets a marked stub of console_column / set_console_column, which the file module's own replaces. Co-Authored-By: Claude Opus 5.5 --- rt/src/file.rs | 19 +++ rt/src/math.rs | 401 +++++++++++++++++++++++++++++++++++++++++++++++++ rt/src/sys.rs | 129 ++++++++++++++++ 3 files changed, 549 insertions(+) diff --git a/rt/src/file.rs b/rt/src/file.rs index a09a09d..66d9922 100644 --- a/rt/src/file.rs +++ b/rt/src/file.rs @@ -2,3 +2,22 @@ // Copyright (c) 2025-2026 Jeff Garzik // SPDX-License-Identifier: MIT + +// ---- STUB for math.rs: replaced by the file module's own at merge -------- +// +// The console's column (what the asm keeps in `_file_col[0]`): characters +// already written on the current line, so column 1 is 0. math.rs reads it +// for POS and sets it for CLS and LOCATE. + +static CONSOLE_COLUMN: crate::State = crate::State::new(0); + +/// Characters written on the console's current line: 0 at its start. +pub fn console_column() -> i64 { + unsafe { *CONSOLE_COLUMN.get() } +} + +/// Set the console's column, as a count of characters before the cursor. +pub fn set_console_column(c: i64) { + unsafe { *CONSOLE_COLUMN.get() = c } +} +// ---- end STUB -------------------------------------------------------------- diff --git a/rt/src/math.rs b/rt/src/math.rs index 01b7c6c..d6ce052 100644 --- a/rt/src/math.rs +++ b/rt/src/math.rs @@ -1,4 +1,405 @@ //! RND, RANDOMIZE, TIMER, DATE$, TIME$, BEEP, CLS, LOCATE, COLOR, POS (math.s) +//! +//! Ported from math.s. The generator is xorshift64; the clock and local time +//! come from `sys`; the console is driven with ANSI escapes written to the +//! C library's stdout, the stream every other console write goes through. // Copyright (c) 2025-2026 Jeff Garzik // SPDX-License-Identifier: MIT + +use crate::file::{console_column, set_console_column}; +use crate::{State, Str, sys}; +use core::ffi::{c_char, c_int}; + +// `crate::file` owns the console's column (the asm's `_file_col[0]`), and +// is expected to provide: +// +// pub fn console_column() -> i64 characters already written on the +// console's current line, 0 at its start +// pub fn set_console_column(c: i64) set that count +// +// POS reads it; CLS sets it to 0, and LOCATE with a column to that column +// less one. Nothing here writes through the file module, so these escapes +// do not move it themselves. + +/// The generator's starting state; also what a seed that hashes to zero +/// becomes, since zero is xorshift's fixed point. +const SEED: u64 = 0x12345678DEADBEEF; + +/// xorshift64's state. +static RNG_STATE: State = State::new(SEED); +/// The last number RND returned, for RND(0). +static RNG_LAST: State = State::new(0.0); + +const CLS_SEQ: &[u8] = b"\x1b[2J\x1b[H"; +const LOCATE_FMT: &[u8] = b"\x1b[%d;%dH\0"; +const LOCATE_ROW_FMT: &[u8] = b"\x1b[%dd\0"; +const LOCATE_COL_FMT: &[u8] = b"\x1b[%dG\0"; +const COLOR_FMT: &[u8] = b"\x1b[%d;%d;%dm\0"; +const COLOR_FG_FMT: &[u8] = b"\x1b[%d;%dm\0"; +const COLOR_BG_FMT: &[u8] = b"\x1b[%dm\0"; +const DATE_FMT: &[u8] = b"%m-%d-%Y\0"; +const TIME_FMT: &[u8] = b"%H:%M:%S\0"; + +/// GW-BASIC colour 0-7 -> ANSI colour: black blue green cyan red magenta +/// brown white. GW-BASIC's 1 is blue and 4 red, ANSI's the other way round. +const GW_TO_ANSI: [u8; 8] = [0, 4, 2, 6, 1, 5, 3, 7]; + +/// An escape sequence, formatted in place. +struct Esc { + buf: [u8; 64], + len: usize, +} + +impl Esc { + fn new() -> Esc { + Esc { + buf: [0; 64], + len: 0, + } + } + + /// Format with `fmt` (NUL-terminated) and up to three ints. The values + /// go through `%d` as the asm passed them: as C ints, a wider one + /// truncated. + fn format(&mut self, fmt: &[u8], a: c_int, b: c_int, c: c_int) { + let n = unsafe { + sys::snprintf( + self.buf.as_mut_ptr().cast::(), + self.buf.len(), + fmt.as_ptr().cast(), + a, + b, + c, + ) + }; + self.len = (n.max(0) as usize).min(self.buf.len() - 1); + } + + fn bytes(&self) -> &[u8] { + &self.buf[..self.len] + } +} + +/// LOCATE's escape: CUP moves both coordinates, VPA only the row, CHA only +/// the column; -1 (any negative) is omitted. Neither: nothing. +fn locate_seq(row: i64, col: i64) -> Esc { + let mut e = Esc::new(); + if row >= 0 && col >= 0 { + e.format(LOCATE_FMT, row as c_int, col as c_int, 0); + } else if row >= 0 { + e.format(LOCATE_ROW_FMT, row as c_int, 0, 0); + } else if col >= 0 { + e.format(LOCATE_COL_FMT, col as c_int, 0, 0); + } + e +} + +/// COLOR's escape. The background 0-7 is ANSI 40-47 and 8-15 is 100-107; +/// the foreground 0-7 is 30-37 and 8-15 is 90-97, and 16-31 is the same +/// colour blinking, so every foreground also sets or clears blink (SGR 5 / +/// 25). A negative one is omitted, and left as it was. +fn color_seq(fg: i64, bg: i64) -> Esc { + let ansi = |c: i64, base: c_int| { + let a = GW_TO_ANSI[(c & 7) as usize] as c_int + base; + if c < 8 { a } else { a + 60 } + }; + let mut e = Esc::new(); + let bg = if bg >= 0 { ansi(bg, 40) } else { -1 }; + if fg >= 0 { + let (blink, fg) = if fg >= 16 { (5, fg - 16) } else { (25, fg) }; + let fg = ansi(fg, 30); + if bg >= 0 { + e.format(COLOR_FMT, blink, fg, bg); + } else { + e.format(COLOR_FG_FMT, blink, fg, 0); + } + } else if bg >= 0 { + e.format(COLOR_BG_FMT, bg, 0, 0); + } + e +} + +/// Write `bytes` to the console: the C library's stdout, which every other +/// console write goes through too, so they stay in order. +#[cfg(not(test))] +fn console(bytes: &[u8]) { + unsafe { sys::write(sys::stdout(), bytes) }; +} + +// Tests capture what would have been written, rather than clear the +// terminal running them. +#[cfg(test)] +std::thread_local! { + static CONSOLE: core::cell::RefCell> = const { core::cell::RefCell::new(Vec::new()) }; +} + +#[cfg(test)] +fn console(bytes: &[u8]) { + CONSOLE.with(|c| c.borrow_mut().extend_from_slice(bytes)); +} + +/// The next number from xorshift64, in [0, 1): its top 52 bits as the +/// mantissa of a double in [1, 2), less 1. +fn next() -> f64 { + let rng = unsafe { RNG_STATE.get() }; + let mut s = *rng; + s ^= s << 13; + s ^= s >> 7; + s ^= s << 17; + *rng = s; + let x = f64::from_bits((s >> 12) | 0x3FF0000000000000) - 1.0; + unsafe { *RNG_LAST.get() = x }; + x +} + +/// `fmt` applied to the local time now, as a fresh string. +fn strftime_now(fmt: &[u8]) -> Str { + let tm = sys::local_time(sys::now().0); + let mut buf = [0u8; 64]; + let n = unsafe { + sys::strftime( + buf.as_mut_ptr().cast::(), + buf.len(), + fmt.as_ptr().cast(), + &tm, + ) + }; + // Fresh: the caller may hold another such result. + let p = crate::alloc_str(n); + if p.is_null() { + return Str::EMPTY; + } + unsafe { core::ptr::copy_nonoverlapping(buf.as_ptr(), p, n) }; + Str { ptr: p, len: n } +} + +export! { + /// RND(x): GW-BASIC's argument selects the behaviour. RND(<0) reseeds + /// from that value and returns the next number, RND(0) returns the + /// previous number again, and RND(>0) -- a bare RND, and NaN -- the next. + fn _rt_rnd(x: f64) -> f64 { + if x == 0.0 { + return unsafe { *RNG_LAST.get() }; + } + if x < 0.0 { + unsafe { _rt_randomize(x) }; + } + next() + } + + /// RANDOMIZE seed. A bare RANDOMIZE is compiled as RANDOMIZE TIMER. + /// + /// The seed's bit pattern goes through a splitmix64 avalanche rather than + /// being used directly: BASIC seeds are small integers, and xorshift64 + /// started from a small state gives a visibly poor first few values. + fn _rt_randomize(seed: f64) { + let mut z = seed.to_bits().wrapping_add(0x9E3779B97F4A7C15); + z = (z ^ (z >> 30)).wrapping_mul(0xBF58476D1CE4E5B9); + z = (z ^ (z >> 27)).wrapping_mul(0x94D049BB133111EB); + z ^= z >> 31; + unsafe { *RNG_STATE.get() = if z == 0 { SEED } else { z } }; + } + + /// BEEP: ring the terminal bell. + fn _rt_beep() { + console(b"\x07"); + } + + /// DATE$: the date as MM-DD-YYYY, GW-BASIC's shape. + fn _rt_date() -> Str { + strftime_now(DATE_FMT) + } + + /// TIME$: the time as HH:MM:SS. + fn _rt_time() -> Str { + strftime_now(TIME_FMT) + } + + /// POS(n): the column the next character goes to, from 1. + fn _rt_pos() -> i32 { + (console_column() + 1) as i32 + } + + /// LOCATE row, col: move the cursor; -1 = omitted, which stays where it + /// is. A column moves the console's column too, so that a following TAB + /// or PRINT zone counts from where the cursor is; a row alone does not. + fn _rt_locate(row: i64, col: i64) { + console(locate_seq(row, col).bytes()); + if col >= 0 { + set_console_column(col - 1); + } + } + + /// COLOR foreground, background; -1 = omitted, left as it was. + fn _rt_color(fg: i64, bg: i64) { + console(color_seq(fg, bg).bytes()); + } + + /// TIMER: seconds since local midnight, with the fraction, from one + /// reading of the clock: 0 <= t < 86401 across a leap second. + fn _rt_timer() -> f64 { + let (secs, frac) = sys::now(); + let tm = sys::local_time(secs); + let s = tm.tm_hour * 3600 + tm.tm_min * 60 + tm.tm_sec; + s as f64 + frac + } + + /// CLS: clear the screen and home the cursor, and the console's column + /// with it, so that a later TAB does not count from the old column. + fn _rt_cls() { + set_console_column(0); + console(CLS_SEQ); + } +} + +#[cfg(test)] +mod tests { + use super::*; + + /// RND scaled to the integer its 52 bits are, as the asm runtime printed + /// them: `PRINT STR$(RND * 4503599627370496#)`. + fn bits(x: f64) -> u64 { + (x * 4503599627370496.0) as u64 + } + + #[test] + fn rnd_sequence_matches_the_asm() { + // The only test touching the generator, so that none race on it. + unsafe { + assert_eq!(bits(_rt_rnd(1.0)), 4215999074463851); + assert_eq!(bits(_rt_rnd(1.0)), 4463028026673686); + assert_eq!(bits(_rt_rnd(1.0)), 601748377359072); + assert_eq!(bits(_rt_rnd(0.0)), 601748377359072); + _rt_randomize(42.0); + assert_eq!(bits(_rt_rnd(1.0)), 1233981780618662); + assert_eq!(bits(_rt_rnd(1.0)), 1084824174261292); + assert_eq!(bits(_rt_rnd(1.0)), 466904231042207); + assert_eq!(bits(_rt_rnd(-7.0)), 39952231855205); + assert_eq!(bits(_rt_rnd(-7.0)), 39952231855205); + assert_eq!(bits(_rt_rnd(-0.0)), 39952231855205); + _rt_randomize(0.0); + assert_eq!(bits(_rt_rnd(1.0)), 1801078981577815); + // NaN is "next", like a positive argument. + let a = _rt_rnd(f64::NAN); + assert!((0.0..1.0).contains(&a)); + assert_ne!(_rt_rnd(f64::NAN), a); + } + } + + #[test] + fn cls_sequence() { + assert_eq!(CLS_SEQ, b"\x1b[2J\x1b[H"); + } + + #[test] + fn locate_sequences() { + assert_eq!(locate_seq(5, 10).bytes(), b"\x1b[5;10H"); + assert_eq!(locate_seq(5, -1).bytes(), b"\x1b[5d"); + assert_eq!(locate_seq(-1, 10).bytes(), b"\x1b[10G"); + assert_eq!(locate_seq(-1, -1).bytes(), b""); + assert_eq!(locate_seq(0, 0).bytes(), b"\x1b[0;0H"); + // %d of a wider value: truncated to a C int, as printf saw it. + assert_eq!(locate_seq(1 << 32 | 3, 1).bytes(), b"\x1b[3;1H"); + } + + fn written() -> Vec { + CONSOLE.with(|c| core::mem::take(&mut *c.borrow_mut())) + } + + #[test] + fn console_control_writes_and_moves_the_column() { + // The only test touching the console's column. + written(); + set_console_column(7); + unsafe { _rt_locate(-1, -1) }; + assert_eq!(unsafe { _rt_pos() }, 8); + unsafe { _rt_locate(3, -1) }; + assert_eq!(unsafe { _rt_pos() }, 8); + unsafe { _rt_locate(-1, 20) }; + assert_eq!(unsafe { _rt_pos() }, 20); + unsafe { _rt_locate(2, 5) }; + assert_eq!(unsafe { _rt_pos() }, 5); + unsafe { _rt_color(-1, -1) }; + unsafe { _rt_color(1, -1) }; + unsafe { _rt_cls() }; + assert_eq!(unsafe { _rt_pos() }, 1); + unsafe { _rt_beep() }; + assert_eq!( + written(), + b"\x1b[3d\x1b[20G\x1b[2;5H\x1b[25;34m\x1b[2J\x1b[H\x07" + ); + } + + #[test] + fn color_sequences() { + // Foreground and background, each through the hue table. + assert_eq!(color_seq(1, 4).bytes(), b"\x1b[25;34;41m"); + assert_eq!(color_seq(7, 0).bytes(), b"\x1b[25;37;40m"); + // Bright halves. + assert_eq!(color_seq(9, 12).bytes(), b"\x1b[25;94;101m"); + assert_eq!(color_seq(15, 8).bytes(), b"\x1b[25;97;100m"); + // Blinking: 16-31. + assert_eq!(color_seq(17, 2).bytes(), b"\x1b[5;34;42m"); + assert_eq!(color_seq(31, 15).bytes(), b"\x1b[5;97;107m"); + // One omitted. + assert_eq!(color_seq(14, -1).bytes(), b"\x1b[25;93m"); + assert_eq!(color_seq(20, -1).bytes(), b"\x1b[5;31m"); + assert_eq!(color_seq(-1, 3).bytes(), b"\x1b[46m"); + assert_eq!(color_seq(-1, 11).bytes(), b"\x1b[106m"); + // Neither. + assert_eq!(color_seq(-1, -1).bytes(), b""); + // Out of range, as the asm computes it: the low three bits pick the + // hue, and 8 or more is bright. + assert_eq!(color_seq(32, 16).bytes(), b"\x1b[5;90;100m"); + // Every hue. + for c in 0..8 { + let want = [0, 4, 2, 6, 1, 5, 3, 7][c as usize]; + let s = color_seq(c, c); + let want = format!("\x1b[25;{};{}m", 30 + want, 40 + want); + assert_eq!(s.bytes(), want.as_bytes()); + } + } + + #[test] + fn timer_is_seconds_since_midnight() { + let t = unsafe { _rt_timer() }; + assert!((0.0..86401.0).contains(&t), "{t}"); + let tm = sys::local_time(sys::now().0); + let s = (tm.tm_hour * 3600 + tm.tm_min * 60 + tm.tm_sec) as f64; + // Within a few seconds of the clock read again (allowing midnight). + assert!((s - t).abs() < 5.0 || (s - t).abs() > 86000.0, "{s} {t}"); + } + + fn owned(s: Str) -> Vec { + let v = unsafe { s.bytes() }.to_vec(); + unsafe { sys::free(s.ptr as *mut u8) }; + v + } + + #[test] + fn date_and_time_shapes() { + let d = owned(unsafe { _rt_date() }); + assert_eq!(d.len(), 10, "{d:?}"); + for (i, &c) in d.iter().enumerate() { + if i == 2 || i == 5 { + assert_eq!(c, b'-'); + } else { + assert!(c.is_ascii_digit()); + } + } + let t = owned(unsafe { _rt_time() }); + assert_eq!(t.len(), 8, "{t:?}"); + for (i, &c) in t.iter().enumerate() { + if i == 2 || i == 5 { + assert_eq!(c, b':'); + } else { + assert!(c.is_ascii_digit()); + } + } + let month = (d[0] - b'0') * 10 + d[1] - b'0'; + assert!((1..=12).contains(&month)); + let hour = (t[0] - b'0') * 10 + t[1] - b'0'; + assert!(hour < 24); + } +} diff --git a/rt/src/sys.rs b/rt/src/sys.rs index 5186227..a8a4e1c 100644 --- a/rt/src/sys.rs +++ b/rt/src/sys.rs @@ -96,3 +96,132 @@ pub unsafe fn write(f: *mut FILE, bytes: &[u8]) { pub fn flush_all() { unsafe { fflush(core::ptr::null_mut()) }; } + +// ---- math: the clock and local time (TIMER, DATE$, TIME$) ---------------- +// +// One reading of the clock gives whole seconds and the fraction, so the two +// cannot straddle a second: `gettimeofday` on unix, `_ftime64` on Windows +// (UCRT's `time` and `localtime_s` are inline wrappers, not exports, so the +// `_64` functions they wrap are named here). Local time goes through the C +// library on both, so TIMER, DATE$ and TIME$ all honour TZ. + +/// The C library's `struct tm`. Only the leading ints are read here; glibc +/// and Darwin add `tm_gmtoff` and `tm_zone` after them, which `strftime` +/// may read, so they are part of the layout. +#[repr(C)] +#[derive(Clone, Copy)] +pub struct Tm { + pub tm_sec: c_int, + pub tm_min: c_int, + pub tm_hour: c_int, + pub tm_mday: c_int, + pub tm_mon: c_int, + pub tm_year: c_int, + pub tm_wday: c_int, + pub tm_yday: c_int, + pub tm_isdst: c_int, + #[cfg(unix)] + pub tm_gmtoff: core::ffi::c_long, + #[cfg(unix)] + pub tm_zone: *const c_char, +} + +unsafe extern "C" { + pub fn strftime(buf: *mut c_char, max: usize, fmt: *const c_char, tm: *const Tm) -> usize; +} + +#[cfg(unix)] +mod clock { + use super::Tm; + use core::ffi::{c_int, c_void}; + + #[repr(C)] + struct Timeval { + tv_sec: i64, + // Darwin's suseconds_t is 32 bits, followed by padding. + #[cfg(target_vendor = "apple")] + tv_usec: i32, + #[cfg(not(target_vendor = "apple"))] + tv_usec: i64, + } + + unsafe extern "C" { + fn gettimeofday(tv: *mut Timeval, tz: *mut c_void) -> c_int; + fn localtime_r(t: *const i64, tm: *mut Tm) -> *mut Tm; + } + + pub fn now() -> (i64, f64) { + let mut tv = Timeval { + tv_sec: 0, + tv_usec: 0, + }; + unsafe { gettimeofday(&mut tv, core::ptr::null_mut()) }; + (tv.tv_sec, tv.tv_usec as f64 / 1000000.0) + } + + pub fn local(t: i64, tm: &mut Tm) { + unsafe { localtime_r(&t, tm) }; + } +} + +#[cfg(windows)] +mod clock { + use super::Tm; + use core::ffi::c_int; + + #[repr(C)] + struct Timeb64 { + time: i64, + millitm: u16, + timezone: i16, + dstflag: i16, + } + + unsafe extern "C" { + fn _ftime64(tb: *mut Timeb64); + fn _localtime64_s(tm: *mut Tm, t: *const i64) -> c_int; + } + + pub fn now() -> (i64, f64) { + let mut tb = Timeb64 { + time: 0, + millitm: 0, + timezone: 0, + dstflag: 0, + }; + unsafe { _ftime64(&mut tb) }; + (tb.time, tb.millitm as f64 / 1000.0) + } + + pub fn local(t: i64, tm: &mut Tm) { + unsafe { _localtime64_s(tm, &t) }; + } +} + +/// The time now: seconds since the epoch, and the fraction of the current +/// second (microseconds on unix, milliseconds on Windows). +pub fn now() -> (i64, f64) { + clock::now() +} + +/// `t`, seconds since the epoch, broken down in the local zone. +pub fn local_time(t: i64) -> Tm { + let mut tm = Tm { + tm_sec: 0, + tm_min: 0, + tm_hour: 0, + tm_mday: 0, + tm_mon: 0, + tm_year: 0, + tm_wday: 0, + tm_yday: 0, + tm_isdst: 0, + #[cfg(unix)] + tm_gmtoff: 0, + #[cfg(unix)] + tm_zone: core::ptr::null(), + }; + clock::local(t, &mut tm); + tm +} +// ---- end math ------------------------------------------------------------- From 1ef4764b388a0e097a43204a3d82c88b06223607 Mon Sep 17 00:00:00 2001 From: Jeff Garzik Date: Sat, 10 Oct 2026 17:31:36 +0000 Subject: [PATCH 04/17] rt: port number formatting, VAL, the string helpers and DATA to Rust num.rs: fmt_double/fmt_basic (print.s), scan_number and _rt_val. string.rs: every helper in string.s, slices staying slices and every fresh result from alloc_str, so a failed allocation now raises Out of memory. data.rs: READ, RESTORE and array autodim, with the program's DATA symbols replaced by a table of the tests' own under cfg(test). The code has no path that can panic: rt.o is emitted before LTO merges in core, so a failing bounds check would leave core's panic functions as undefined symbols. sys.rs gains strtod. Expected text in the tests is what the asm runtime printed. Errors that are not trapped are tested in a child process, which keeps the trapping state out of the tests running in parallel. Co-Authored-By: Claude Opus 5.5 --- rt/src/data.rs | 300 +++++++++++++++++++++++++ rt/src/num.rs | 563 ++++++++++++++++++++++++++++++++++++++++++++++- rt/src/string.rs | 541 ++++++++++++++++++++++++++++++++++++++++++++- rt/src/sys.rs | 1 + 4 files changed, 1392 insertions(+), 13 deletions(-) diff --git a/rt/src/data.rs b/rt/src/data.rs index e80744e..40c442e 100644 --- a/rt/src/data.rs +++ b/rt/src/data.rs @@ -1,4 +1,304 @@ //! DATA, READ and RESTORE, and creating an array by using it (data.s) +//! +//! The compiler collects every DATA item into `_data_table`, which the +//! program defines along with `_data_count` (its length) and `_data_ptr` +//! (the next item READ takes, from 0). An item is kept as written, because +//! GW-BASIC decides what it is when it is READ: `DATA 007` is the string +//! "007" to READ A$ and the number 7 to READ A. A quoted item is a string +//! only. // Copyright (c) 2025-2026 Jeff Garzik // SPDX-License-Identifier: MIT + +use crate::error::{self, _err_memory, _err_outofdata, _err_overflow, _err_syntax}; +use crate::num::scan_number; +use crate::{Str, sys}; +use core::ffi::{CStr, c_char}; + +/// One DATA item, as codegen's `define_data` lays it out. +#[repr(C)] +pub struct Item { + /// 1 if the item was written in quotes, else 0. + pub quoted: u64, + /// The item's text, without quotes, NUL-terminated. + pub text: *const c_char, +} + +/// The program's DATA, reached by symbol. +#[cfg(not(test))] +mod program { + use super::Item; + use crate::Word; + + unsafe extern "C" { + static _data_table: [Item; 0]; + static _data_count: u64; + static _data_ptr: Word; + } + + pub fn item(i: u64) -> *const Item { + unsafe { (&raw const _data_table).cast::().add(i as usize) } + } + pub fn count() -> u64 { + unsafe { _data_count } + } + pub fn next() -> &'static Word { + unsafe { &_data_ptr } + } +} + +/// A DATA table of the tests' own, in place of the program's. +#[cfg(test)] +mod program { + use super::Item; + use crate::{State, Word}; + + pub static TABLE: State<[Item; 8]> = State::new( + [const { + Item { + quoted: 0, + text: core::ptr::null(), + } + }; 8], + ); + pub static COUNT: Word = Word::new(0); + pub static NEXT: Word = Word::new(0); + + pub fn item(i: u64) -> *const Item { + unsafe { &TABLE.get()[i as usize] } + } + pub fn count() -> u64 { + COUNT.get() + } + pub fn next() -> &'static Word { + &NEXT + } +} + +/// The next item, and READ moves past it; `None` past the last. +fn take() -> Option<&'static Item> { + let i = program::next().get(); + if i >= program::count() { + return None; + } + program::next().set(i + 1); + Some(unsafe { &*program::item(i) }) +} + +export! { + /// READ into a numeric variable. The item's text must be a number and + /// nothing else but blanks, read as VAL reads one; anything else -- a + /// quoted item, or text that is not a number -- is GW-BASIC's Syntax + /// error, reported for the READ on `line`. An empty item is 0. Reading + /// past the last item is Out of DATA. Each error gives 0 when trapped. + fn _rt_read_number(line: i64) -> f64 { + let Some(item) = take() else { + error::raise(&_err_outofdata[..], line); + return 0.0; + }; + let msg = 'bad: { + if item.quoted != 0 { + break 'bad &_err_syntax[..]; // a string, not a number + } + let text = unsafe { CStr::from_ptr(item.text) }.to_bytes(); + if text.is_empty() { + return 0.0; + } + let s = scan_number(text); + if s.overflow { + break 'bad &_err_overflow[..]; + } + // Only blanks may follow the number. + let mut rest = text.iter().skip(s.consumed); + if s.consumed == 0 || rest.any(|&c| c != b' ' && c != b'\t') { + break 'bad &_err_syntax[..]; + } + return s.value; + }; + error::raise(msg, line); + 0.0 + } + + /// READ into a string variable: the item's text as written -- a quoted + /// item without its quotes, an unquoted one as the DATA statement + /// spelled it, so `DATA 007` reads "007". A view of the table, not a + /// copy. Past the last item, Out of DATA, and an empty string when + /// trapped. + fn _rt_read_string(line: i64) -> Str { + let Some(item) = take() else { + error::raise(&_err_outofdata[..], line); + return Str::EMPTY; + }; + let text = unsafe { CStr::from_ptr(item.text) }.to_bytes(); + Str { + ptr: text.as_ptr(), + len: text.len(), + } + } + + /// RESTORE: READ next takes item `index`. RESTORE with no line passes + /// 0, RESTORE n the index of the first item at or after line n. + fn _rt_restore(index: i64) { + program::next().set(index as u64); + } + + /// Create an array by using it, as GW-BASIC does: called when an array + /// is reached with no storage, never DIMmed or ERASEd. Every one of its + /// `dims` dimensions runs from `base` (the OPTION BASE) to 10, and the + /// `size`-byte elements start as zeros -- 0 and "" alike. + /// + /// `desc` is the descriptor: word 0 the element pointer, word 1+i + /// dimension i's element count, word 1+dims+i its lower bound. Out of + /// memory leaves the pointer null. + fn _rt_array_autodim(desc: *mut u64, dims: i64, size: i64, base: i64) { + let per = 11 - base; // elements per dimension: base..10 + let mut bytes = size; + for i in 0..dims as usize { + unsafe { + *desc.add(1 + i) = per as u64; + *desc.add(1 + dims as usize + i) = base as u64; + } + match bytes.checked_mul(per) { + Some(b) => bytes = b, + None => { + // Too large to address at all. + error::raise(&_err_memory[..], 0); + return; + } + } + } + let p = unsafe { sys::calloc(1, bytes as usize) }; + if p.is_null() { + error::raise(&_err_memory[..], 0); + return; + } + unsafe { *desc = p as u64 }; + } +} + +#[cfg(test)] +mod tests { + use super::*; + use crate::num::testing::*; + use std::sync::Mutex; + + /// The table is one, and tests run in parallel. + static LOCK: Mutex<()> = Mutex::new(()); + + /// Make `items` the DATA, and READ from the first. + fn data(items: &[(bool, &'static [u8])]) { + let t = unsafe { program::TABLE.get() }; + for (slot, &(quoted, text)) in t.iter_mut().zip(items) { + assert_eq!(text.last(), Some(&0)); + *slot = Item { + quoted: quoted as u64, + text: text.as_ptr().cast(), + }; + } + program::COUNT.set(items.len() as u64); + unsafe { _rt_restore(0) }; + } + + fn read_s() -> Vec { + unsafe { _rt_read_string(10).bytes() }.to_vec() + } + + #[test] + fn read_strings_and_numbers() { + let _g = LOCK.lock().unwrap_or_else(|e| e.into_inner()); + data(&[ + (false, b"007\0"), + (true, b"a, b\0"), + (false, b"\0"), + (false, b" 1 2 \0"), + (false, b"&HFF\0"), + (false, b"-1.5D2\t\0"), + ]); + assert_eq!(read_s(), b"007"); + assert_eq!(read_s(), b"a, b"); + assert_eq!(read_s(), b""); + assert_eq!(read_s(), b" 1 2 "); + unsafe { + _rt_restore(0); + assert_eq!(_rt_read_number(10), 7.0); + _rt_restore(2); + assert_eq!(_rt_read_number(10), 0.0); // an empty item is 0 + assert_eq!(_rt_read_number(10), 12.0); + assert_eq!(_rt_read_number(10), 255.0); + assert_eq!(_rt_read_number(10), -150.0); + // A string READ returns a view of the table's text. + _rt_restore(1); + let r = _rt_read_string(10); + assert_eq!(r.ptr, program::TABLE.get()[1].text.cast()); + } + } + + #[test] + fn read_errors() { + if in_child() { + data(&[ + (true, b"1\0"), + (false, b"1x\0"), + (false, b"abc\0"), + (false, b"1e999\0"), + (false, b"+\0"), + ]); + for _ in 0..5 { + assert_eq!(trapped(|| unsafe { _rt_read_number(10) }), (0.0, true)); + } + assert_eq!(trapped(|| unsafe { _rt_read_number(10) }), (0.0, true)); + let (r, raised) = trapped(|| unsafe { _rt_read_string(10) }); + assert!(raised && r == Str::EMPTY); + unsafe { _rt_read_number(30) }; + return; + } + expect_fatal("data::tests::read_errors", "?Out of DATA in 30\n"); + } + + #[test] + fn read_of_a_quoted_number_is_a_syntax_error() { + if in_child() { + data(&[(true, b"5\0")]); + unsafe { _rt_read_number(40) }; + return; + } + expect_fatal( + "data::tests::read_of_a_quoted_number_is_a_syntax_error", + "?Syntax error in 40\n", + ); + } + + #[test] + fn autodim_makes_base_to_10() { + let mut desc = [0u64; 7]; + unsafe { _rt_array_autodim(desc.as_mut_ptr(), 3, 8, 1) }; + assert_ne!(desc[0], 0); + assert_eq!(&desc[1..], &[10, 10, 10, 1, 1, 1]); + let p = desc[0] as *mut u8; + let all = unsafe { std::slice::from_raw_parts(p, 8 * 1000) }; + assert!(all.iter().all(|&b| b == 0)); + unsafe { sys::free(p) }; + + let mut desc = [0u64; 3]; + unsafe { _rt_array_autodim(desc.as_mut_ptr(), 1, 16, 0) }; + assert_eq!(&desc[1..], &[11, 0]); + unsafe { sys::free(desc[0] as *mut u8) }; + } + + #[test] + fn autodim_too_large_is_out_of_memory() { + if in_child() { + let mut desc = [0u64; 41]; + let ((), raised) = + trapped(|| unsafe { _rt_array_autodim(desc.as_mut_ptr(), 20, 8, 0) }); + assert!(raised); + assert_eq!(desc[0], 0); + unsafe { _rt_array_autodim(desc.as_mut_ptr(), 20, 8, 0) }; + return; + } + expect_fatal( + "data::tests::autodim_too_large_is_out_of_memory", + "?Out of memory\n", + ); + } +} diff --git a/rt/src/num.rs b/rt/src/num.rs index 46ecb57..de4b260 100644 --- a/rt/src/num.rs +++ b/rt/src/num.rs @@ -7,6 +7,10 @@ // Copyright (c) 2025-2026 Jeff Garzik // SPDX-License-Identifier: MIT +use crate::error; +use crate::sys; +use core::ffi::{c_char, c_int}; + /// What `scan_number` read. #[derive(Clone, Copy, Debug, PartialEq)] pub struct Scanned { @@ -19,13 +23,157 @@ pub struct Scanned { pub overflow: bool, } +const NONE: Scanned = Scanned { + consumed: 0, + value: 0.0, + overflow: false, +}; + /// Read a number the way GW-BASIC's VAL and INPUT do (`_rt_scan_number`). +/// +/// Shared by VAL, INPUT, INPUT # and READ, so they all accept the same text: +/// leading blanks; blanks inside the number, which are ignored ("1 2" is +/// 12); a sign; digits with at most one point; an exponent spelled E or D, +/// with an optional sign; or &H, &O, &B or a bare & followed by digits, which +/// are an INTEGER when they fit 16 bits and a LONG when they fit 32 -- two's +/// complement, as a literal. Scanning stops at the first character that +/// cannot continue the number. strtod saw the text directly once, so VAL +/// accepted "inf", "nan" and "0x1F", read past the end of a LEFT$ view, and +/// knew no D. pub fn scan_number(text: &[u8]) -> Scanned { - let _ = text; - todo!("port _rt_scan_number") + let mut i = 0; + while i < text.len() && matches!(text[i], b' ' | b'\t') { + i += 1; + } + if i == text.len() { + return NONE; + } + if text[i] == b'&' { + return scan_radix(text, i + 1); + } + + // The number, without its blanks, NUL-terminated for strtod. + let mut copy = [0u8; 128]; + let mut n = 0; + // Just past the last digit or point used. + let mut consumed = 0; + // 0 sign, 1 mantissa, 2 exponent sign, 3 exponent. + let mut stage = 0; + let mut point = false; + // 120 is the copy's room; a longer number has no more precision. + while i < text.len() && n < 120 { + let c = text[i]; + match c { + b' ' | b'\t' => {} + b'0'..=b'9' | b'.' => { + if c == b'.' { + // No point in an exponent, nor a second one. + if stage > 1 || point { + break; + } + point = true; + stage = 1; + } else { + stage = if stage < 2 { 1 } else { 3 }; + } + copy[n] = c; + n += 1; + consumed = i + 1; + } + // A sign begins the number or its exponent, and nothing else. + b'+' | b'-' if stage == 0 || stage == 2 => { + stage += 1; + copy[n] = c; + n += 1; + } + // An exponent only after some of the mantissa. + b'e' | b'E' | b'd' | b'D' if stage == 1 => { + stage = 2; + copy[n] = b'e'; // strtod's spelling + n += 1; + } + _ => break, + } + i += 1; + } + if consumed == 0 { + return NONE; + } + let start = copy.as_ptr().cast::(); + let mut end = start.cast_mut(); + let value = unsafe { sys::strtod(start, &mut end) }; + if core::ptr::eq(end, start) { + return NONE; // "+", "." and the like are no number + } + // Infinity is the only way past DOUBLE's range. + let overflow = !value.is_finite(); + Scanned { + consumed, + value: if overflow { 0.0 } else { value }, + overflow, + } +} + +/// The digits after `&`, `&H`, `&O` or `&B`, from `text[i]` on. +fn scan_radix(text: &[u8], mut i: usize) -> Scanned { + let mut radix = 8; // a bare & is octal + if i < text.len() { + match text[i] | 32 { + b'h' => (radix, i) = (16, i + 1), + b'o' => i += 1, + b'b' => (radix, i) = (2, i + 1), + _ => {} + } + } + let mut value: u64 = 0; + let mut overflow = false; // it no longer fits 32 bits + let mut consumed = 0; + while i < text.len() { + let c = text[i]; + let d = if c.is_ascii_digit() { + c - b'0' + } else { + // 'a' -> 10; anything below 'a' wraps to a value past any radix. + let d = (c | 32).wrapping_sub(87); + if d < 10 { + break; + } + d + }; + if u64::from(d) >= radix { + break; // not a digit of this radix + } + value = value * radix + u64::from(d); + if value >> 32 != 0 { + // Keep it bounded; the overflow is recorded. + overflow = true; + value &= 0xFFFF_FFFF; + } + i += 1; + consumed = i; + } + if consumed == 0 { + return NONE; + } + let value = if overflow { + 0.0 + } else if value <= 0xFFFF { + f64::from(value as u16 as i16) // an INTEGER, two's complement + } else { + f64::from(value as u32 as i32) // a LONG, two's complement + }; + Scanned { + consumed, + value, + overflow, + } } /// A formatted number: at most `NumText::CAP` bytes, no terminator. +/// +/// Built without a path that could panic: the runtime object carries no +/// part of `core`'s panic machinery, so a bounds check that could fail would +/// be an undefined symbol at link time. #[derive(Clone, Copy)] pub struct NumText { buf: [u8; NumText::CAP], @@ -35,21 +183,422 @@ pub struct NumText { impl NumText { pub const CAP: usize = 48; + const EMPTY: NumText = NumText { + buf: [0; NumText::CAP], + len: 0, + }; + pub fn as_bytes(&self) -> &[u8] { - &self.buf[..self.len] + self.buf.get(..self.len).unwrap_or(&[]) + } + + /// Append `c`; no number is long enough to fill the buffer. Not inlined: + /// the loops calling it are unrolled into kilobytes otherwise. + #[inline(never)] + fn push(&mut self, c: u8) { + if let Some(b) = self.buf.get_mut(self.len) { + *b = c; + self.len += 1; + } + } + + fn extend<'a>(&mut self, bytes: impl IntoIterator) { + for &c in bytes { + self.push(c); + } } } +const FMT_SCI: &[u8] = b"%.*e\0"; + /// A number's digits as GW-BASIC writes them, without the leading blank /// (`_rt_fmt_double`): 7 significant digits for a SINGLE, 16 for a DOUBLE. +/// +/// GW-BASIC's rule, which QuickBASIC documents: a value is rounded to the +/// type's significant digits, P, and written in fixed point when that shows +/// it in at most P digits, otherwise with an exponent. So a SINGLE's 1.1E-6 +/// prints .0000011 and 1.1E-7 prints 1.1E-07; 1234567 prints in full and +/// 12345678 as 1.234568E+07. Trailing zeros are dropped, a value below one +/// has no leading zero, and the exponent is spelled E for a SINGLE and D for +/// a DOUBLE, with at least two digits. A SINGLE arrives widened to double. pub fn fmt_double(x: f64, single: bool) -> NumText { - let _ = (x, single); - todo!("port _rt_fmt_double") + let p: usize = if single { 7 } else { 16 }; + let mut out = NumText::EMPTY; + // Zero, of either sign, is 0. + if x == 0.0 { + out.push(b'0'); + return out; + } + + // "[-]d.ddd...e[+-]xx": P significant digits, rounded by the C library. + let mut sci = [0u8; 64]; + unsafe { + sys::snprintf( + sci.as_mut_ptr().cast(), + sci.len(), + FMT_SCI.as_ptr().cast(), + (p - 1) as c_int, + x, + ) + }; + // The text after any sign, from `at(0)` on. Indexes are masked to the + // buffer, which the C library's text never fills, so none can panic. + let mut start = 0; + if sci[0] == b'-' { + out.push(b'-'); + start = 1; + } + let at = |i: usize| sci[(start + i) & 63]; + if !at(0).is_ascii_digit() { + // inf or nan: as the C library wrote it. + let mut i = 0; + while at(i) != 0 && i < 63 { + out.push(at(i)); + i += 1; + } + return out; + } + + // The P digits, without the point. + let mut digits = [0u8; 16]; + digits[0] = at(0); + for i in 1..p { + digits[i & 15] = at(i + 1); + } + // The decimal exponent X, so the value is d.ddd * 10^X. + let mut x: i32 = 0; + let mut i = p + 3; + while at(i) != 0 && i < 63 { + x = x * 10 + i32::from(at(i).wrapping_sub(b'0')); + i += 1; + } + if at(p + 2) == b'-' { + x = -x; + } + // n = how many of them are significant: trailing zeros are not. + let mut n = p; + while n > 1 && digits[(n - 1) & 15] == b'0' { + n -= 1; + } + let (pi, ni) = (p as i32, n as i32); + let put = |out: &mut NumText, from: usize, to: usize| { + for i in from..to { + out.push(digits[i & 15]); + } + }; + + // Fixed point when it shows the value in at most P digits, as GW-BASIC + // and QuickBASIC do: X+1 integer digits for X >= 0, or for X < 0 the + // -X-1 zeros after the point and then the n digits. + if (0..pi).contains(&x) { + // Past n the digits are the trailing zeros, which these need. + let int = x as usize + 1; + put(&mut out, 0, int); + if int < n { + out.push(b'.'); + put(&mut out, int, n); + } + } else if x < 0 && -x - 1 + ni <= pi { + out.push(b'.'); // no leading zero, as .5 + for _ in 0..-x - 1 { + out.push(b'0'); + } + put(&mut out, 0, n); + } else { + // d[.ddd]E+xx, D for a DOUBLE. + out.push(digits[0]); + if n > 1 { + out.push(b'.'); + put(&mut out, 1, n); + } + out.push(if single { b'E' } else { b'D' }); + out.push(if x < 0 { b'-' } else { b'+' }); + let mut e = x.unsigned_abs(); + if e >= 100 { + // Two digits at least, three if needed. + out.push(b'0' + (e / 100) as u8); + e %= 100; + } + out.push(b'0' + (e / 10) as u8); + out.push(b'0' + (e % 10) as u8); + } + out } /// `fmt_double` with the blank that stands where a minus sign would go, as /// PRINT and STR$ write a number (`_rt_fmt_basic`). +/// +/// GW-BASIC puts one there for every non-negative number, which is why +/// `PRINT 1; 2` reads " 1 2 " and why STR$(5) is " 5" -- the +/// `MID$(STR$(N), 2)` idiom exists to strip exactly this blank. Not folded +/// into `fmt_double`, because WRITE and PRINT USING render numbers through +/// that and must not gain the blank. pub fn fmt_basic(x: f64, single: bool) -> NumText { - let _ = (x, single); - todo!("port _rt_fmt_basic") + let t = fmt_double(x, single); + if t.buf[0] == b'-' { + return t; // '-' already occupies the sign position + } + let mut out = NumText::EMPTY; + out.push(b' '); + out.extend(t.as_bytes()); + out +} + +export! { + /// VAL: the number a string begins with, read by `scan_number`. Text + /// that does not begin with a number is 0, and one too large for a + /// DOUBLE is Overflow rather than infinity. + fn _rt_val(ptr: *const u8, len: i64) -> f64 { + let s = scan_number(unsafe { crate::string::arg(ptr, len) }); + if s.overflow { + error::raise(&error::_err_overflow[..], 0); // returns only when trapped + } + s.value + } +} + +#[cfg(test)] +pub(crate) mod testing { + //! Errors that are not trapped end the process, so a test of one runs + //! itself again in a child process, which only that test runs in. That + //! also keeps the trapping state the child arms away from tests running + //! in parallel in this one. + + /// Whether this is the child process `expect_fatal` started. + pub fn in_child() -> bool { + std::env::var_os("XBASIC64_RT_CHILD").is_some() + } + + /// Run the test `name` (its full path) in a child process, and require + /// that it end with the fatal report `msg`. + pub fn expect_fatal(name: &str, msg: &str) { + let out = std::process::Command::new(std::env::current_exe().unwrap()) + .args([name, "--exact", "--nocapture", "--test-threads=1"]) + .env("XBASIC64_RT_CHILD", "1") + .output() + .unwrap(); + let err = String::from_utf8_lossy(&out.stderr); + assert_eq!(out.status.code(), Some(1), "{name}: {err}"); + assert!(err.contains(msg), "{name}: wanted {msg:?}, got {err:?}"); + } + + /// Run `f` with ON ERROR armed, and return its result and whether it + /// raised an error; trapping is off again afterwards. + pub fn trapped(f: impl FnOnce() -> T) -> (T, bool) { + use crate::error::{_err_active, _err_handler, _err_pending}; + assert!(in_child(), "trapping state is shared by every test thread"); + _err_handler.set(1); + let r = f(); + let raised = _err_pending.get() != 0; + _err_pending.set(0); + _err_active.set(0); + _err_handler.set(0); + (r, raised) + } +} + +#[cfg(test)] +#[allow(clippy::approx_constant)] // 3.14159 is a value to print +mod tests { + use super::testing::*; + use super::*; + + fn single(x: f32) -> String { + String::from_utf8(fmt_basic(f64::from(x), true).as_bytes().to_vec()).unwrap() + } + fn double(x: f64) -> String { + String::from_utf8(fmt_basic(x, false).as_bytes().to_vec()).unwrap() + } + + // The expected text is what STR$ printed through the assembly runtime. + #[test] + fn singles_as_the_asm_wrote_them() { + let cases: &[(f32, &str)] = &[ + (1.1E-6, " .0000011"), + (1.1E-7, " 1.1E-07"), + (1234567.0, " 1234567"), + (12345678.0, " 1.234568E+07"), + (-1.5, "-1.5"), + (0.0, " 0"), + (-0.0, " 0"), + (0.1 + 0.2, " .3"), + (3.14159, " 3.14159"), + (1E+38, " 1E+38"), + (1.5E-38, " 1.5E-38"), + (100.0, " 100"), + (-0.001, "-.001"), + (1.0 / 3.0, " .3333333"), + (2.0 / 3.0, " .6666667"), + (1E-10, " 1E-10"), + (123456.7, " 123456.7"), + (9999999.0, " 9999999"), + (99999999.0, " 1E+08"), + (-12345678.0, "-1.234568E+07"), + (0.5, " .5"), + (1000000.0, " 1000000"), + (10000000.0, " 1E+07"), + (0.000001, " .000001"), + (0.0000001, " .0000001"), + (-1.1E-7, "-1.1E-07"), + (1.234567E-5, " 1.234567E-05"), + ]; + for &(x, want) in cases { + assert_eq!(single(x), want, "{x:e}"); + } + } + + #[test] + fn doubles_as_the_asm_wrote_them() { + let cases: &[(f64, &str)] = &[ + (1.1E-6, " .0000011"), + (1.1E-7, " .00000011"), + (1234567.0, " 1234567"), + (12345678.0, " 12345678"), + (-1.5, "-1.5"), + (0.0, " 0"), + (0.1 + 0.2, " .3"), + (3.14159, " 3.14159"), + (1E+300, " 1D+300"), + (1E-300, " 1D-300"), + (1.5E-100, " 1.5D-100"), + (1234567890123456.0, " 1234567890123456"), + (12345678901234567.0, " 1.234567890123457D+16"), + (1E+16, " 1D+16"), + (1E+15, " 1000000000000000"), + (1.0 / 3.0, " .3333333333333333"), + (-2.0 / 3.0, "-.6666666666666666"), + (4.9E-324, " 4.940656458412465D-324"), + (f64::MAX, " 1.797693134862316D+308"), + (123.456, " 123.456"), + (1E+100, " 1D+100"), + (1E-16, " .0000000000000001"), + (1E-17, " 1D-17"), + (1.5E-16, " 1.5D-16"), + (-1E+16, "-1D+16"), + (9999999999999999.0, " 1D+16"), + (0.1, " .1"), + (1E+22, " 1D+22"), + (2.5E-5, " .000025"), + (-0.00000000123, "-.00000000123"), + ]; + for &(x, want) in cases { + assert_eq!(double(x), want, "{x:e}"); + } + } + + #[test] + fn fmt_double_has_no_blank() { + assert_eq!(fmt_double(5.0, false).as_bytes(), b"5"); + assert_eq!(fmt_double(-5.0, true).as_bytes(), b"-5"); + assert_eq!(fmt_double(0.0, true).as_bytes(), b"0"); + assert_eq!(fmt_double(1E-7, false).as_bytes(), b".0000001"); + } + + #[test] + fn infinity_and_nan_as_the_c_library_spells_them() { + assert_eq!(fmt_double(f64::INFINITY, false).as_bytes(), b"inf"); + assert_eq!(fmt_basic(f64::NEG_INFINITY, true).as_bytes(), b"-inf"); + assert_eq!(fmt_basic(f64::NAN, false).as_bytes(), b" nan"); + } + + fn val(s: &str) -> f64 { + unsafe { _rt_val(s.as_ptr(), s.len() as i64) } + } + + // The expected values are what VAL returned through the assembly runtime. + #[test] + fn val_as_the_asm_read_it() { + let cases: &[(&str, f64)] = &[ + ("1 2", 12.0), + (" -3.5e2x", -350.0), + ("1d3", 1000.0), + ("1D-2", 0.01), + ("&H1F", 31.0), + ("&HFFFF", -1.0), + ("&H10000", 65536.0), + ("&HFFFFFFFF", -1.0), + ("&h7fffffff", 2147483647.0), + ("&H80000000", -2147483648.0), + ("&O17", 15.0), + ("&17", 15.0), + ("&B101", 5.0), + ("&b2", 0.0), + ("&H", 0.0), + ("&", 0.0), + ("abc", 0.0), + ("", 0.0), + ("+", 0.0), + (".", 0.0), + ("-.5", -0.5), + ("1e", 1.0), + ("1e+", 1.0), + ("12abc", 12.0), + ("1.2.3", 1.2), + (" + 4 5 . 5", 45.5), + ("1-2", 1.0), + ("0x1F", 0.0), + ("inf", 0.0), + ("&HG", 0.0), + ("--1", 0.0), + ("1E5E3", 100000.0), + ("1,000", 1.0), + (".5.5", 0.5), + ("e5", 0.0), + ("1 e 2", 100.0), + ("&H 1F", 0.0), + ]; + for &(s, want) in cases { + assert_eq!(val(s), want, "VAL({s:?})"); + } + } + + #[test] + fn scan_reports_what_it_consumed() { + let s = |t: &str| scan_number(t.as_bytes()); + assert_eq!(s(" 12 ").consumed, 4); + assert_eq!(s("1 2,3").consumed, 3); + // The exponent's letter and sign count only once a digit follows. + assert_eq!(s("1e+").consumed, 1); + assert_eq!(s("1e+5x").consumed, 4); + assert_eq!(s("-.5").consumed, 3); + assert_eq!(s("&H1Fz").consumed, 4); + assert_eq!(s("&Hz"), NONE); + assert_eq!(s(" "), NONE); + assert_eq!(s("x1"), NONE); + // Only the text given is read: a view stops where its length says. + assert_eq!(scan_number(&b"123"[..2]).value, 12.0); + } + + #[test] + fn scan_reports_overflow() { + let s = scan_number(b"1e999"); + assert!(s.overflow); + assert_eq!((s.consumed, s.value), (5, 0.0)); + let s = scan_number(b"&HFFFFFFFFF,"); + assert!(s.overflow); + assert_eq!((s.consumed, s.value), (11, 0.0)); + assert!(!scan_number(b"1.7976931348623157D308").overflow); + // Too small is 0, not an overflow. + let s = scan_number(b"1e-999"); + assert!(!s.overflow && s.value == 0.0 && s.consumed == 6); + } + + #[test] + fn scan_keeps_120_characters() { + let long = "1".repeat(200); + let s = scan_number(long.as_bytes()); + assert_eq!(s.consumed, 120); + assert_eq!(s.value, long[..120].parse::().unwrap()); + } + + #[test] + fn val_overflow_is_an_error() { + if in_child() { + assert_eq!(trapped(|| val("1e999")), (0.0, true)); + assert_eq!(trapped(|| val("&H100000000")), (0.0, true)); + val("1D400"); + return; + } + expect_fatal("num::tests::val_overflow_is_an_error", "?Overflow\n"); + } } diff --git a/rt/src/string.rs b/rt/src/string.rs index cf34d56..1717121 100644 --- a/rt/src/string.rs +++ b/rt/src/string.rs @@ -1,17 +1,546 @@ //! String functions: LEFT$, MID$, INSTR, concatenation, conversions //! -//! Ported from string.s. A string is a (pointer, length) pair; slices of an -//! argument are returned as they are, and every fresh result comes from -//! `crate::alloc_str`. +//! Ported from string.s. A string is a (pointer, length) pair, not +//! NUL-terminated, which lets LEFT$, RIGHT$, MID$, LTRIM$ and RTRIM$ return +//! a view into their argument without copying: BASIC strings are never +//! mutated in place except by MID$ assignment, which writes only bytes the +//! target owns. Every other result is fresh, from `crate::alloc_str`, and +//! the caller owns and frees it. +//! +//! A conversion that formats into a scratch buffer (STR$, CHR$, HEX$, OCT$) +//! returns a copy of it, never the buffer: nothing copies a result until it +//! is assigned, so STR$(A) + STR$(B) would otherwise see the first half +//! overwritten by the second. // Copyright (c) 2025-2026 Jeff Garzik // SPDX-License-Identifier: MIT -use crate::Str; +use crate::error; +use crate::num::fmt_basic; +use crate::{Str, alloc_str, sys}; +use core::ffi::c_longlong; + +/// A string argument as the bytes it names. +/// +/// # Safety +/// `ptr` must point at `len` readable bytes that outlive the slice, unless +/// `len` is 0. +pub(crate) unsafe fn arg<'a>(ptr: *const u8, len: i64) -> &'a [u8] { + unsafe { + Str { + ptr, + len: len as usize, + } + .bytes() + } +} + +/// A fresh string of `len` bytes, each `fill`, for the caller to fill in +/// further: `None` when there is no memory, which has then been raised. One +/// byte more is allocated and set to NUL, for safety, as the asm did. +fn fresh(len: usize, fill: u8) -> Option<&'static mut [u8]> { + let p = alloc_str(len.wrapping_add(1)); + if p.is_null() { + return None; + } + unsafe { + p.write_bytes(fill, len); + *p.add(len) = 0; + Some(core::slice::from_raw_parts_mut(p, len)) + } +} + +/// The string a `fresh` buffer holds; the empty string if there was none. +fn owned(s: Option<&'static mut [u8]>) -> Str { + s.map_or(Str::EMPTY, |s| Str { + ptr: s.as_ptr(), + len: s.len(), + }) +} + +/// `len` bytes from `ptr + from`: a view of an argument, as a result. Even +/// an empty one points into the argument, as the asm's did. +fn view(ptr: *const u8, from: usize, len: usize) -> Str { + Str { + ptr: ptr.wrapping_add(from), + len, + } +} /// A fresh, owned copy of `s` (what `_rt_strdup` does), for helpers that /// build a result in a scratch buffer and must not return the buffer itself. pub fn strdup(s: &[u8]) -> Str { - let _ = s; - todo!("port _rt_strdup") + let mut d = fresh(s.len(), 0); + if let Some(d) = d.as_deref_mut() { + d.copy_from_slice(s); + } + owned(d) +} + +/// `s` with ASCII letters mapped by `f`, as a fresh copy: the source may be +/// a literal shared with other uses, so it is never changed in place. +fn map_case(s: &[u8], f: fn(&u8) -> u8) -> Str { + let mut d = fresh(s.len(), 0); + if let Some(d) = d.as_deref_mut() { + for (d, c) in d.iter_mut().zip(s) { + *d = f(c); + } + } + owned(d) +} + +/// HEX$ / OCT$: `n` through the C library's `fmt`. +fn radix(n: i64, fmt: &[u8]) -> Str { + let mut buf = [0u8; 32]; + let len = unsafe { + sys::snprintf( + buf.as_mut_ptr().cast(), + buf.len(), + fmt.as_ptr().cast(), + n as c_longlong, + ) + }; + strdup(buf.get(..len as usize).unwrap_or(&[])) +} + +/// A count clamped to a length, compared unsigned as the asm did: a +/// negative count is the whole length. +fn clamp(n: i64, len: usize) -> usize { + (n as u64).min(len as u64) as usize +} + +export! { + /// STR$: exactly the text PRINT writes for a DOUBLE, sign blank + /// included, so that VAL(STR$(X)) is X to the digits PRINT shows. + fn _rt_str(x: f64) -> Str { + strdup(fmt_basic(x, false).as_bytes()) + } + + /// STR$ of a SINGLE, at a SINGLE's 7 digits as PRINT writes it: + /// rendered as a DOUBLE, 3.14159! would be "3.141590118408203". + fn _rt_str_single(x: f64) -> Str { + strdup(fmt_basic(x, true).as_bytes()) + } + + /// CHR$: the one-character string whose code is `code`'s low byte. + fn _rt_chr(code: i64) -> Str { + strdup(&[code as u8]) + } + + /// LEFT$: the first `n` characters, or all of them; a view. + fn _rt_left(ptr: *const u8, len: i64, n: i64) -> Str { + view(ptr, 0, clamp(n, len as usize)) + } + + /// RIGHT$: the last `n` characters, or all of them; a view. + fn _rt_right(ptr: *const u8, len: i64, n: i64) -> Str { + let n = clamp(n, len as usize); + view(ptr, len as usize - n, n) + } + + /// MID$: `count` characters from the 1-based `start`, or the rest when + /// `count` is negative or runs past the end; a view. A start past the + /// end, or below 1, is the empty string. + fn _rt_mid(ptr: *const u8, len: i64, start: i64, count: i64) -> Str { + let from = start.wrapping_sub(1) as u64; + if from >= len as u64 { + return view(ptr, 0, 0); + } + let rest = len as usize - from as usize; + let n = if count < 0 { rest } else { clamp(count, rest) }; + view(ptr, from as usize, n) + } + + /// INSTR: the 1-based position of `needle` in `hay` at or after + /// `start`, 0 if it is not there. An empty needle is found at `start` + /// itself, unless that is past the end. A start below 1 is Illegal + /// function call, and then "not found" when a handler traps it. + fn _rt_instr(hay: *const u8, hay_len: i64, needle: *const u8, needle_len: i64, start: i64) -> i64 { + if start < 1 { + error::raise(&error::_err_domain[..], 0); + return 0; + } + let (hay, needle) = unsafe { (arg(hay, hay_len), arg(needle, needle_len)) }; + let from = (start - 1) as usize; + if from >= hay.len() { + return 0; + } + if needle.is_empty() { + return start; + } + hay[from..] + .windows(needle.len()) + .position(|w| w == needle) + .map_or(0, |i| (from + i + 1) as i64) + } + + /// `+` on strings: a fresh string holding both. + fn _rt_strcat(a: *const u8, a_len: i64, b: *const u8, b_len: i64) -> Str { + let (a, b) = unsafe { (arg(a, a_len), arg(b, b_len)) }; + let mut d = fresh(a.len() + b.len(), 0); + if let Some(d) = d.as_deref_mut() { + let p = d.as_mut_ptr(); + unsafe { + p.copy_from_nonoverlapping(a.as_ptr(), a.len()); + p.add(a.len()).copy_from_nonoverlapping(b.as_ptr(), b.len()); + } + } + owned(d) + } + + /// Compare two strings by unsigned byte value, then by length when one + /// is a prefix of the other, so "ab" < "abc". Negative, zero or + /// positive as `a` is below, equal to or above `b`: the difference of + /// the first differing bytes, else -1, 0 or 1. An empty string's pointer + /// is never read, so an unassigned (NULL, 0) string compares correctly. + fn _rt_strcmp(a: *const u8, a_len: i64, b: *const u8, b_len: i64) -> i32 { + let (a, b) = unsafe { (arg(a, a_len), arg(b, b_len)) }; + match a.iter().zip(b).find(|(x, y)| x != y) { + Some((&x, &y)) => i32::from(x) - i32::from(y), + None => a.len().cmp(&b.len()) as i32, + } + } + + /// SPACE$: `n` blanks; none for a negative `n`. + fn _rt_space(n: i64) -> Str { + owned(fresh(n.max(0) as usize, b' ')) + } + + /// Fit a string to a declared width, for STRING * n: padded with blanks + /// on the right, or cut. Fresh rather than a view, because the result is + /// stored and the source may be a temporary. + fn _rt_fixed(ptr: *const u8, len: i64, width: i64) -> Str { + let s = unsafe { arg(ptr, len) }; + let width = width.max(0) as usize; + let mut d = fresh(width, b' '); + if let Some(d) = d.as_deref_mut() { + let n = clamp(width as i64, s.len()); + d[..n].copy_from_slice(&s[..n]); + } + owned(d) + } + + /// STRING$(n, c): `n` copies of the character `code`; none for a + /// negative `n`. Codegen checks the code, and that a string argument is + /// not empty, and passes its first character's code. + fn _rt_string_n(n: i64, code: i64) -> Str { + owned(fresh(n.max(0) as usize, code as u8)) + } + + /// LTRIM$: without its leading blanks; a view. + fn _rt_ltrim(ptr: *const u8, len: i64) -> Str { + let s = unsafe { arg(ptr, len) }; + let n = s.iter().take_while(|&&c| c == b' ').count(); + view(ptr, n, s.len() - n) + } + + /// RTRIM$: without its trailing blanks; a view. + fn _rt_rtrim(ptr: *const u8, len: i64) -> Str { + let s = unsafe { arg(ptr, len) }; + let n = s.iter().rev().take_while(|&&c| c == b' ').count(); + Str { ptr, len: s.len() - n } + } + + /// UCASE$: ASCII letters only, as GW-BASIC. + fn _rt_ucase(ptr: *const u8, len: i64) -> Str { + map_case(unsafe { arg(ptr, len) }, u8::to_ascii_uppercase) + } + + /// LCASE$: ASCII letters only. + fn _rt_lcase(ptr: *const u8, len: i64) -> Str { + map_case(unsafe { arg(ptr, len) }, u8::to_ascii_lowercase) + } + + /// HEX$: `n` in upper-case hexadecimal, all 64 bits. Codegen has + /// already cut a negative INTEGER or LONG to its own width, so HEX$(-1%) + /// is FFFF. + fn _rt_hex(n: i64) -> Str { + radix(n, b"%llX\0") + } + + /// OCT$: `n` in octal, all 64 bits, as HEX$. + fn _rt_oct(n: i64) -> Str { + radix(n, b"%llo\0") + } + + /// A fresh copy of a string. String assignment copies, so that changing + /// one variable cannot be seen through another -- or through the shared + /// literal a string constant points at, which MID$(A$, 1, 1) = "J" + /// after A$ = "HELLO" would otherwise rewrite for every use of "HELLO". + fn _rt_strdup(ptr: *const u8, len: i64) -> Str { + strdup(unsafe { arg(ptr, len) }) + } + + /// MID$(s, start [, count]) = value: overwrite the target's bytes in + /// place, from the 1-based `start`, with at most `count` characters of + /// the source and never past the target's end, whose length never + /// changes. A start below 1 writes nothing. Copied a byte at a time, + /// forward, so a source overlapping the target reads what was written. + fn _rt_mid_assign(dst: *mut u8, dst_len: i64, start: i64, count: i64, src: *const u8, src_len: i64) { + let count = clamp(count, src_len as usize); + if start < 1 { + return; + } + let from = (start - 1) as usize; + for i in 0..count { + let at = from.wrapping_add(i); + if at >= dst_len as usize { + break; + } + unsafe { *dst.add(at) = *src.add(i) }; + } + } +} + +#[cfg(test)] +#[allow(clippy::approx_constant)] // 3.14159 is a value to print +mod tests { + use super::*; + use crate::num::testing::*; + + fn s(r: Str) -> Vec { + unsafe { r.bytes() }.to_vec() + } + + /// `r` was allocated for the caller, who frees it. + fn freed(r: Str) -> Vec { + let v = s(r); + assert!(!r.ptr.is_null()); + unsafe { sys::free(r.ptr.cast_mut()) }; + v + } + + /// `r` is a view of `of`. + fn inside(r: Str, of: &[u8]) -> Vec { + let range = of.as_ptr_range(); + assert!(range.start <= r.ptr && r.ptr.wrapping_add(r.len) <= range.end); + s(r) + } + + macro_rules! a { + ($s:expr) => { + ($s.as_ptr(), $s.len() as i64) + }; + } + + #[test] + fn conversions_are_fresh_copies() { + unsafe { + assert_eq!(freed(_rt_str(5.0)), b" 5"); + assert_eq!(freed(_rt_str(-0.1 - 0.2)), b"-.3"); + assert_eq!(freed(_rt_str(12345678.0)), b" 12345678"); + assert_eq!(freed(_rt_str_single(12345678.0)), b" 1.234568E+07"); + assert_eq!(freed(_rt_str_single(f64::from(3.14159f32))), b" 3.14159"); + assert_eq!(freed(_rt_chr(65)), b"A"); + assert_eq!(freed(_rt_chr(0)), b"\0"); + assert_eq!(freed(_rt_chr(0x1FF)), b"\xFF"); + // Two results are two buffers. + let (x, y) = (_rt_chr(1), _rt_chr(2)); + assert_ne!(x.ptr, y.ptr); + assert_eq!((freed(x), freed(y)), (vec![1], vec![2])); + } + } + + #[test] + fn hex_and_oct() { + unsafe { + assert_eq!(freed(_rt_hex(255)), b"FF"); + assert_eq!(freed(_rt_hex(0)), b"0"); + // What codegen passes for HEX$(-1%), and a raw negative. + assert_eq!(freed(_rt_hex(0xFFFF)), b"FFFF"); + assert_eq!(freed(_rt_hex(-1)), b"FFFFFFFFFFFFFFFF"); + assert_eq!(freed(_rt_oct(8)), b"10"); + assert_eq!(freed(_rt_oct(0xFFFF)), b"177777"); + assert_eq!(freed(_rt_oct(-1)), b"1777777777777777777777"); + } + } + + #[test] + fn left_and_right_are_views() { + let h = b"HELLO"; + unsafe { + let (p, l) = a!(h); + assert_eq!(inside(_rt_left(p, l, 2), h), b"HE"); + assert_eq!(inside(_rt_left(p, l, 9), h), b"HELLO"); + assert_eq!(inside(_rt_left(p, l, 0), h), b""); + assert_eq!(inside(_rt_left(p, l, -1), h), b"HELLO"); + assert_eq!(inside(_rt_right(p, l, 2), h), b"LO"); + assert_eq!(inside(_rt_right(p, l, 9), h), b"HELLO"); + assert_eq!(inside(_rt_right(p, l, 0), h), b""); + assert_eq!(_rt_left(core::ptr::null(), 0, 3), Str::EMPTY); + // An empty view still points into its argument. + assert_eq!(_rt_left(p, l, 0).ptr, p); + assert_eq!(_rt_right(p, l, 0).ptr, p.add(5)); + assert_eq!(_rt_mid(p, l, 9, 1).ptr, p); + } + } + + // As MID$ printed through the assembly runtime. + #[test] + fn mid_is_a_view() { + let h = b"HELLO WORLD"; + unsafe { + let (p, l) = a!(h); + assert_eq!(inside(_rt_mid(p, l, 20, -1), h), b""); + assert_eq!(inside(_rt_mid(p, l, 12, -1), h), b""); + assert_eq!(inside(_rt_mid(p, l, 11, -1), h), b"D"); + assert_eq!(inside(_rt_mid(p, l, 7, -1), h), b"WORLD"); + assert_eq!(inside(_rt_mid(p, l, 3, 2), h), b"LL"); + assert_eq!(inside(_rt_mid(p, l, 10, 50), h), b"LD"); + assert_eq!(inside(_rt_mid(p, l, 1, 0), h), b""); + assert_eq!(inside(_rt_mid(p, l, 0, 3), h), b""); + assert_eq!(inside(_rt_mid(p, l, -5, 3), h), b""); + } + } + + // As INSTR printed through the assembly runtime: 5 5 0 1 3 0. + #[test] + fn instr_finds_from_start() { + let h = b"HELLO WORLD"; + let f = |n: &[u8], start| unsafe { + let (p, l) = a!(h); + _rt_instr(p, l, n.as_ptr(), n.len() as i64, start) + }; + assert_eq!(f(b"O", 1), 5); + assert_eq!(f(b"O", 5), 5); + assert_eq!(f(b"O", 6), 8); + assert_eq!(f(b"O", 20), 0); + assert_eq!(f(b"", 1), 1); + assert_eq!(f(b"", 3), 3); + assert_eq!(f(b"", 11), 11); + assert_eq!(f(b"", 12), 0); + assert_eq!(f(b"WORLD", 1), 7); + assert_eq!(f(b"WORLDS", 1), 0); + assert_eq!(f(b"LD", 10), 10); + assert_eq!(f(b"HELLO WORLD!", 1), 0); + assert_eq!( + unsafe { _rt_instr(core::ptr::null(), 0, b"".as_ptr(), 0, 1) }, + 0 + ); + } + + #[test] + fn instr_start_below_one_is_illegal() { + if in_child() { + let f = |start| unsafe { _rt_instr(b"ab".as_ptr(), 2, b"a".as_ptr(), 1, start) }; + assert_eq!(trapped(|| f(0)), (0, true)); + assert_eq!(trapped(|| f(-1)), (0, true)); + assert_eq!(trapped(|| f(1)), (1, false)); + f(0); + return; + } + expect_fatal( + "string::tests::instr_start_below_one_is_illegal", + "?Illegal function call\n", + ); + } + + #[test] + fn strcat_and_strcmp() { + unsafe { + let (p, l) = a!(b"ab"); + let (q, m) = a!(b"cde"); + assert_eq!(freed(_rt_strcat(p, l, q, m)), b"abcde"); + assert_eq!(freed(_rt_strcat(core::ptr::null(), 0, q, m)), b"cde"); + let e = _rt_strcat(core::ptr::null(), 0, core::ptr::null(), 0); + assert_eq!(freed(e), b""); + + let c = |x: &[u8], y: &[u8]| { + _rt_strcmp(x.as_ptr(), x.len() as i64, y.as_ptr(), y.len() as i64) + }; + assert!(c(b"abc", b"abd") < 0); + assert_eq!(c(b"abc", b"abd"), -1); + assert_eq!(c(b"b", b"abc"), 1); + assert_eq!(c(b"ab", b"abc"), -1); + assert_eq!(c(b"abc", b"ab"), 1); + assert_eq!(c(b"", b""), 0); + assert_eq!(c(b"abc", b"abc"), 0); + // Unsigned bytes, and their difference. + assert_eq!(c(b"\xFF", b"a"), 0xFF - 0x61); + assert_eq!(c(b"A", b"a"), -32); + assert_eq!(_rt_strcmp(core::ptr::null(), 0, core::ptr::null(), 0), 0); + } + } + + #[test] + fn space_fixed_and_string_n() { + unsafe { + assert_eq!(freed(_rt_space(3)), b" "); + assert_eq!(freed(_rt_space(0)), b""); + assert_eq!(freed(_rt_space(-4)), b""); + let (p, l) = a!(b"abc"); + assert_eq!(freed(_rt_fixed(p, l, 5)), b"abc "); + assert_eq!(freed(_rt_fixed(p, l, 2)), b"ab"); + assert_eq!(freed(_rt_fixed(p, l, 3)), b"abc"); + assert_eq!(freed(_rt_fixed(p, l, -1)), b""); + assert_eq!(freed(_rt_fixed(core::ptr::null(), 0, 2)), b" "); + assert_eq!(freed(_rt_string_n(3, 120)), b"xxx"); + assert_eq!(freed(_rt_string_n(2, 65)), b"AA"); + assert_eq!(freed(_rt_string_n(-2, 65)), b""); + assert_eq!(freed(_rt_string_n(1, 0)), b"\0"); + } + } + + #[test] + fn trims_are_views() { + let l = |x: &[u8]| unsafe { inside(_rt_ltrim(x.as_ptr(), x.len() as i64), x) }; + let r = |x: &[u8]| unsafe { inside(_rt_rtrim(x.as_ptr(), x.len() as i64), x) }; + assert_eq!(l(b" "), b""); + assert_eq!(r(b" "), b""); + assert_eq!(l(b" a "), b"a "); + assert_eq!(r(b" a "), b" a"); + // Blanks only: a tab is kept. + assert_eq!(l(b"\ta"), b"\ta"); + assert_eq!(r(b"a\t"), b"a\t"); + assert_eq!(unsafe { _rt_ltrim(core::ptr::null(), 0) }.len, 0); + assert_eq!(unsafe { _rt_rtrim(core::ptr::null(), 0) }.len, 0); + } + + #[test] + fn case_is_ascii_and_fresh() { + unsafe { + let src = b"aBz{AbZ@\xE9"; + let (p, l) = a!(src); + assert_eq!(freed(_rt_ucase(p, l)), b"ABZ{ABZ@\xE9"); + assert_eq!(freed(_rt_lcase(p, l)), b"abz{abz@\xE9"); + assert_eq!(src, b"aBz{AbZ@\xE9"); + assert_eq!(freed(_rt_ucase(core::ptr::null(), 0)), b""); + let (p, l) = a!(b"x\0y"); + assert_eq!(freed(_rt_strdup(p, l)), b"x\0y"); + assert_ne!(_rt_strdup(p, l).ptr, p); + } + } + + #[test] + fn mid_assign_overwrites_in_place() { + let run = |start, count, src: &[u8]| { + let mut t = *b"HELLO WORLD"; + unsafe { + _rt_mid_assign( + t.as_mut_ptr(), + 11, + start, + count, + src.as_ptr(), + src.len() as i64, + ) + }; + t + }; + // As the assembly runtime printed it. + assert_eq!(&run(10, 5, b"XYZ"), b"HELLO WORXY"); + assert_eq!(&run(1, i64::MAX, b"ab"), b"abLLO WORLD"); + assert_eq!(&run(1, 1, b"ab"), b"aELLO WORLD"); + assert_eq!(&run(1, -1, b"ab"), b"abLLO WORLD"); + assert_eq!(&run(11, 9, b"xyz"), b"HELLO WORLx"); + assert_eq!(&run(12, 9, b"xyz"), b"HELLO WORLD"); + assert_eq!(&run(0, 9, b"xyz"), b"HELLO WORLD"); + assert_eq!(&run(-3, 9, b"xyz"), b"HELLO WORLD"); + assert_eq!(&run(3, 9, b""), b"HELLO WORLD"); + // A source overlapping the target is read as it is written. + let mut t = *b"abcdef"; + let p = t.as_mut_ptr(); + unsafe { _rt_mid_assign(p, 6, 2, 9, p, 6) }; + assert_eq!(&t, b"aaaaaa"); + } } diff --git a/rt/src/sys.rs b/rt/src/sys.rs index 5186227..3b29924 100644 --- a/rt/src/sys.rs +++ b/rt/src/sys.rs @@ -25,6 +25,7 @@ unsafe extern "C" { pub fn fwrite(p: *const c_void, size: usize, n: usize, f: *mut FILE) -> usize; pub fn fprintf(f: *mut FILE, fmt: *const c_char, ...) -> c_int; pub fn snprintf(buf: *mut c_char, n: usize, fmt: *const c_char, ...) -> c_int; + pub fn strtod(s: *const c_char, end: *mut *mut c_char) -> f64; } /// What ends a line of output: Windows programs have always written CRLF, From ac4e30ea4c4251546510448b19d49d0d3636dbd9 Mon Sep 17 00:00:00 2001 From: Jeff Garzik Date: Sat, 10 Oct 2026 17:34:13 +0000 Subject: [PATCH 05/17] build.rs: keep core in rt.o, by taking the LTO member of the staticlib --emit obj writes the crate's object without the parts of core fat LTO would merge into it, so any bounds check left core's panic functions as undefined symbols. rustc now builds the staticlib, whose first member is that merged object, and build.rs keeps only it -- read straight from the ar archive (GNU, BSD and COFF long names), so no ar tool is needed -- and drops the rest, compiler_builtins. rt.o: 12.7 KB of text; it needs only the C library and the program's _data_* symbols. Co-Authored-By: Claude Opus 5.5 --- build.rs | 82 +++++++++++++++++++++++++++++++++++++++++++++++++++----- 1 file changed, 75 insertions(+), 7 deletions(-) diff --git a/build.rs b/build.rs index 152fe3f..0280494 100644 --- a/build.rs +++ b/build.rs @@ -59,22 +59,26 @@ fn main() { build_rt(&out); } -/// Build `rt/` for the target as one object: a staticlib, with fat LTO -/// merging it and what it uses of `core` into a single unit, emitted as an -/// object. The staticlib archive would also carry all of `compiler_builtins` -/// -- 4 MB the runtime does not reference. +/// Build `rt/` for the target as one object, `$OUT_DIR/rt.o`. +/// +/// rustc builds a staticlib, with fat LTO merging the crate and every part +/// of `core` it uses -- its panic paths included -- into one object, the +/// archive's first member. The rest of the archive is `compiler_builtins`, +/// 4 MB the runtime does not reference, so only that member is kept. +/// (`--emit obj` would give the crate's object without `core` merged in, +/// leaving a bounds check's panic an undefined symbol.) fn build_rt(out: &std::path::Path) { let rustc = env::var("RUSTC").unwrap_or_else(|_| "rustc".into()); let target = env::var("TARGET").expect("cargo sets TARGET"); - let obj = out.join("rt.o"); + let lib = out.join("rt.a"); let output = Command::new(rustc) .args(["--edition", "2024", "--crate-type", "staticlib"]) .args(["--crate-name", "xbasic64_rt", "--target", &target]) .args(["-C", "opt-level=3", "-C", "panic=abort", "-C", "lto=fat"]) .args(["-C", "codegen-units=1", "-C", "debug-assertions=off"]) - .args(["-C", "overflow-checks=off", "--emit", "obj"]) + .args(["-C", "overflow-checks=off"]) .arg("-o") - .arg(&obj) + .arg(&lib) .arg("rt/src/lib.rs") .output() .unwrap_or_else(|e| panic!("cannot run rustc for the runtime: {e}")); @@ -83,4 +87,68 @@ fn build_rt(out: &std::path::Path) { "the runtime does not build:\n{}", String::from_utf8_lossy(&output.stderr) ); + let archive = std::fs::read(&lib).expect("rustc wrote the staticlib"); + let ours: Vec<(String, &[u8])> = archive_members(&archive) + .into_iter() + .filter(|(name, _)| name.contains("xbasic64_rt")) + .collect(); + assert!( + ours.len() == 1, + "expected one LTO object for the runtime in its staticlib, found {:?}", + ours.iter().map(|(n, _)| n).collect::>() + ); + std::fs::write(out.join("rt.o"), ours[0].1).expect("OUT_DIR is writable"); +} + +/// The members of a Unix `ar` archive -- the format rustc writes a +/// staticlib in on every target, `.lib` included -- by name: GNU and COFF +/// long names (`/N` into the `//` table) and BSD ones (`#1/N`) resolved, the +/// symbol tables skipped. +fn archive_members(a: &[u8]) -> Vec<(String, &[u8])> { + assert!(a.starts_with(b"!\n"), "not an ar archive"); + let field = |h: &[u8], at: usize, len: usize| { + String::from_utf8_lossy(&h[at..at + len]) + .trim_end() + .to_string() + }; + let mut members = Vec::new(); + let mut long_names: &[u8] = &[]; + let mut at = 8; + while at + 60 <= a.len() { + let header = &a[at..at + 60]; + let name = field(header, 0, 16); + let size: usize = field(header, 48, 10).parse().expect("an ar member size"); + let mut data = &a[at + 60..at + 60 + size]; + at += 60 + size + (size & 1); + let name = if name == "/" || name == "__.SYMDEF" || name.starts_with("__.SYMDEF ") { + continue; + } else if name == "//" { + long_names = data; + continue; + } else if let Some(n) = name.strip_prefix("#1/") { + let n: usize = n.parse().expect("a BSD long-name length"); + let full = String::from_utf8_lossy(&data[..n]); + let full = full.trim_end_matches('\0').to_string(); + data = &data[n..]; + full + } else if let Some(off) = name.strip_prefix('/') { + // `/N` is a long name; anything else (`//`) is + // another table. + let Ok(off) = off.parse::() else { + continue; + }; + let rest = &long_names[off..]; + let end = rest + .iter() + .position(|&c| c == b'\n' || c == 0) + .unwrap_or(rest.len()); + String::from_utf8_lossy(&rest[..end]) + .trim_end_matches('/') + .to_string() + } else { + name.trim_end_matches('/').to_string() + }; + members.push((name, data)); + } + members } From 60120d7009979b49ba07e271398fa058151ef098 Mon Sep 17 00:00:00 2001 From: Jeff Garzik Date: Sat, 10 Oct 2026 17:34:59 +0000 Subject: [PATCH 06/17] rt: port files, console input, PRINT USING and platform init to Rust file.s, input.s and using.s become file.rs, input.rs and using.rs, and print.s's _rt_platform_init becomes print.rs's, one source for every target. Every file, and the console as file 0, is a C stdio stream in binary mode; sys.rs gains the OS differences in one marked block: stdin, errno, 64-bit seek, record locking, the directory check (the fstat system call on Linux, so old glibc still links), and why an OPEN failed. Nothing links it yet; unit tests cover the field readers, the INPUT line parser, the USING format parser and renderer, and file round trips. Co-Authored-By: Claude Opus 5.5 --- rt/src/file.rs | 1270 +++++++++++++++++++++++++++++++++++++++++++++++ rt/src/input.rs | 343 ++++++++++++- rt/src/print.rs | 36 ++ rt/src/sys.rs | 407 +++++++++++++++ rt/src/using.rs | 514 ++++++++++++++++++- 5 files changed, 2568 insertions(+), 2 deletions(-) diff --git a/rt/src/file.rs b/rt/src/file.rs index a09a09d..2bd9090 100644 --- a/rt/src/file.rs +++ b/rt/src/file.rs @@ -1,4 +1,1274 @@ //! Files and the console as file 0: OPEN, PRINT #, INPUT #, RANDOM files, FIELD, GET/PUT, LOCK (file.s) +//! +//! BASIC refers to a file by number, 1 to 15; the console is number 0, so +//! PRINT and PRINT # are the same helpers with a different number, and +//! neither can drift from the other. Every file is a C stdio stream, opened +//! in binary mode, on every OS; the console is the C library's stdout, the +//! same `FILE*` math.rs writes its escapes to, so all console output stays +//! in order. +//! +//! A failed OPEN raises GW-BASIC's error for the cause (53, 64, 70, 75, 76). +//! How each number was opened is recorded, so PRINT # to a file opened FOR +//! INPUT, or INPUT # from one opened for writing, is "Bad file mode" (54) +//! rather than a write the C library quietly refuses. +//! +//! The helpers that report a bad file number, a bad mode or the end of a +//! file are not given the line, so they pass 0, and the error reports the +//! one generated code stored in `_err_line` before the call. When a handler +//! traps an error, the helper returns at once with a harmless result. // Copyright (c) 2025-2026 Jeff Garzik // SPDX-License-Identifier: MIT + +use crate::error::{self, raise}; +use crate::sys::{self, FILE}; +use crate::{State, Str, num}; +use core::ffi::c_char; +use core::ptr; + +/// File numbers 0 (the console) to 15. +const FILES: usize = 16; + +// How a number was opened. +const INPUT: i64 = 0; +const OUTPUT: i64 = 1; +const APPEND: i64 = 2; +const RANDOM: i64 = 3; + +/// PRINT lays a line out in zones this wide; a comma moves to the next one. +const PRINT_ZONE: i64 = 14; + +/// Longest INPUT # field kept. +const MAX_FIELD_LEN: usize = 1023; + +/// Longest line LINE INPUT # returns at once: what fgets(buf, 1023) took. +const MAX_LINE_LEN: usize = 1022; + +/// Largest record GW-BASIC allows. +const MAX_RECLEN: i64 = 32767; + +/// Longest file name passed to the C library, its NUL included. Longer +/// names are "Bad file name", which is what Linux says of them (PATH_MAX). +const NAME_CAP: usize = 4096; + +/// Everything known about each file number. +/// +/// A file opened FOR RANDOM carries three things beyond its stream: a record +/// length, a record buffer of that length, and a cursor saying how much of +/// the buffer FIELD has handed out so far. +/// +/// FIELD does not copy anything. It hands each variable the (pointer, +/// length) pair naming its slice of that buffer, and a BASIC string is +/// exactly such a pair, so the variable *is* a window onto the buffer. GET +/// overwrites the buffer and every field variable sees the new record at +/// once; LSET and RSET write through the window, so PUT emits what they +/// wrote. This is why LSET exists at all: plain assignment would allocate a +/// fresh string and the variable would quietly stop tracking the record. +struct Files { + /// The stream; null when not open. Slot 0 is unused: the console is + /// always open, as `sys::stdout()`. + stream: [*mut FILE; FILES], + /// How each number was opened. + mode: [i64; FILES], + /// WIDTH: the line length output wraps at; 0 = no limit. + width: [i64; FILES], + /// Characters already on the current output line, so that TAB(n) knows + /// how far to advance. Reset by a newline. + col: [i64; FILES], + /// The record buffer (malloc'd), null unless opened FOR RANDOM. + recbuf: [*mut u8; FILES], + reclen: [i64; FILES], + /// The last record read or written, 1-based; 0 = none. + recnum: [i64; FILES], + /// Bytes of the buffer FIELD has assigned so far. + fieldoff: [i64; FILES], +} + +static TABLE: State = State::new(Files { + stream: [ptr::null_mut(); FILES], + mode: { + let mut m = [INPUT; FILES]; + m[0] = OUTPUT; // the console is written to + m + }, + width: [0; FILES], + col: [0; FILES], + recbuf: [ptr::null_mut(); FILES], + reclen: [0; FILES], + recnum: [0; FILES], + fieldoff: [0; FILES], +}); + +/// The table, for one statement's use: no reference is held across a call. +fn files() -> &'static mut Files { + unsafe { TABLE.get() } +} + +/// INPUT #'s field and LINE INPUT #'s line, valid until the next read. +static FIELD_BUF: State<[u8; MAX_FIELD_LEN + 1]> = State::new([0; MAX_FIELD_LEN + 1]); + +/// A file name with its NUL, for the C library. +static NAME_BUF: State<[u8; NAME_CAP]> = State::new([0; NAME_CAP]); + +/// The slot for file number `n`, if there is one. Codegen checks the range +/// (but not under `--unsafe`), so one outside it is a number never opened. +fn slot(n: i64) -> Option { + if (0..FILES as i64).contains(&n) { + Some(n as usize) + } else { + None + } +} + +/// The stream for file number `n`; null when it is not open. +fn stream(n: i64) -> *mut FILE { + match slot(n) { + Some(0) => sys::stdout(), + Some(i) => files().stream[i], + None => ptr::null_mut(), + } +} + +fn mode(n: i64) -> i64 { + slot(n).map_or(INPUT, |i| files().mode[i]) +} + +fn col(n: i64) -> i64 { + slot(n).map_or(0, |i| files().col[i]) +} + +fn set_col(n: i64, c: i64) { + if let Some(i) = slot(n) { + files().col[i] = c; + } +} + +fn width(n: i64) -> i64 { + slot(n).map_or(0, |i| files().width[i]) +} + +/// The console's column, for POS: characters already written on its +/// current line, so column 1 is 0. +pub fn console_column() -> i64 { + files().col[0] +} + +/// Set the console's column, for CLS (0) and LOCATE (the column less 1), +/// so that a following TAB or PRINT zone counts from where the cursor is. +pub fn set_console_column(c: i64) { + files().col[0] = c; +} + +/// Write `bytes` to the console, as PRINT does: the column follows them. +pub fn con_string(bytes: &[u8]) { + print_bytes(0, bytes); +} + +/// Is file `n` open, and open for writing? Raises the error when not: +/// PRINT # to a file opened FOR INPUT used to be a write libc quietly +/// refused. +fn writable(n: i64) -> bool { + if stream(n).is_null() { + raise(&error::_err_badfile[..], 0); + false + } else if !matches!(mode(n), OUTPUT | APPEND) { + raise(&error::_err_badmode[..], 0); + false + } else { + true + } +} + +/// Is file `n` open for reading sequentially? The same, for INPUT # and +/// LINE INPUT #. +fn readable(n: i64) -> bool { + if stream(n).is_null() { + raise(&error::_err_badfile[..], 0); + false + } else if mode(n) != INPUT { + raise(&error::_err_badmode[..], 0); + false + } else { + true + } +} + +/// PRINT # of a string's bytes, all of them, NULs included. +/// +/// Under a WIDTH, the text is cut where the line ends and continued on the +/// next, as GW-BASIC wraps it. The break is taken lazily, just before a +/// character that would not fit, so text that exactly fills a line is +/// followed by one newline, not two. +fn print_bytes(n: i64, mut s: &[u8]) { + // An unassigned string is (NULL, 0): writing nothing is correct. + if s.is_empty() || !writable(n) { + return; + } + while !s.is_empty() { + let mut take = s.len(); + let w = width(n); + if w != 0 { + let mut room = w - col(n); + if room <= 0 { + newline(n); // none left: start the next line + room = width(n); + } + take = take.min(room as usize); + } + unsafe { sys::write(stream(n), &s[..take]) }; + set_col(n, col(n) + take as i64); + s = &s[take..]; + } +} + +/// End the line on file `n`. +fn newline(n: i64) { + if writable(n) { + unsafe { sys::write(stream(n), sys::NEWLINE) }; + set_col(n, 0); + } +} + +/// One character on file `n`. Under a WIDTH, a full line wraps before it. +fn print_char(n: i64, c: u8) { + if !writable(n) { + return; + } + let w = width(n); + if w != 0 && col(n) as u64 >= w as u64 { + newline(n); + } + unsafe { sys::write(stream(n), &[c]) }; + set_col(n, col(n) + 1); +} + +/// SPC(count). +fn spc(n: i64, count: i64) { + for _ in 0..count.max(0) { + print_char(n, b' '); + } +} + +/// TAB(column). Columns are 1-based, as in GW-BASIC. If the sink is already +/// at or past the column, a newline is written first and the tab applies to +/// the new line. +fn tab(n: i64, column: i64) { + let target = column.max(1) - 1; // characters before it + if target < col(n) { + newline(n); + } + spc(n, target - col(n)); +} + +/// Where PRINT's comma goes from column `col`, under width `width` (0 = no +/// limit): `Some(c)` to TAB(c), or `None` for the next line, because a zone +/// that would not fit whole on the line means the next line, as in +/// GW-BASIC. +fn zone_target(col: i64, width: i64) -> Option { + let next = (col as u64 / PRINT_ZONE as u64 + 1) as i64 * PRINT_ZONE; // 0-based + if width != 0 && (next + PRINT_ZONE) as u64 > width as u64 { + None + } else { + Some(next + 1) + } +} + +/// PRINT of a number's text, as `num` formatted it, with PRINT's blank +/// after it. Under a WIDTH, a number that does not fit on the rest of the +/// line starts the next one, as in GW-BASIC, rather than being split. +fn print_number(n: i64, text: num::NumText) { + let t = text.as_bytes(); + let k = t.len().min(num::NumText::CAP); + let mut buf = [b' '; num::NumText::CAP + 1]; + buf[..k].copy_from_slice(&t[..k]); + let s = &buf[..k + 1]; + let (w, c) = (width(n), col(n)); + if w != 0 && c != 0 && (c + s.len() as i64) as u64 > w as u64 { + newline(n); + } + print_bytes(n, s); +} + +/// The next byte of file `n`, or -1 at its end or when it is not open. +fn getc(n: i64) -> i32 { + let f = stream(n); + if f.is_null() { + -1 + } else { + unsafe { sys::fgetc(f) } + } +} + +/// Push `c` back onto file `n`, to be read next. +fn ungetc(n: i64, c: i32) { + unsafe { sys::ungetc(c, stream(n)) }; +} + +/// Read one INPUT # field into FIELD_BUF; `numeric` for a numeric item. +/// +/// INPUT # reads comma-delimited fields, not whole lines. Leading blanks +/// and line breaks are skipped. A field either is quoted, in which case it +/// runs to the closing quote and everything up to the next delimiter is +/// discarded, or runs to the next comma, newline or end of file with +/// trailing blanks trimmed. The delimiter is consumed. +/// +/// An unquoted field read for a number also ends at a blank, as GW-BASIC's +/// INPUT # does: `PRINT #1, 1; 2; 3` writes " 1 2 3 " on one line, and +/// that is three numbers. The blanks after such a number are separators, +/// and so is a comma or line break that follows them, so " 1 , 2" is still +/// two numbers; anything else is the start of the next field, and is put +/// back. +fn read_field(n: i64, numeric: bool) -> &'static [u8] { + let buf = unsafe { FIELD_BUF.get() }; + let mut len = 0usize; + if readable(n) { + len = read_field_into(n, numeric, buf).min(MAX_FIELD_LEN); + } + buf[len] = 0; + &buf[..len] +} + +fn read_field_into(n: i64, numeric: bool, buf: &mut [u8; MAX_FIELD_LEN + 1]) -> usize { + let mut len = 0usize; + // Skip leading blanks, tabs and line breaks. + let mut c = loop { + match getc(n) { + -1 => { + // No field left before the end of the file: GW-BASIC's + // "Input past end of file" (62), so that a loop that forgot + // EOF() does not read zeros forever. + raise(&error::_err_pastend[..], 0); + return 0; + } + 0x20 | 9 | 13 | 10 => continue, + c => break c, + } + }; + // A comma here ends an empty field: "10,,20" is three fields, the + // middle one 0 or "". + if c == b',' as i32 { + return 0; + } + if c == b'"' as i32 { + loop { + match getc(n) { + -1 => return len, + 0x22 => break, + c => { + if len < MAX_FIELD_LEN { + buf[len] = c as u8; + len += 1; + } + } + } + } + // Discard whatever separates the closing quote from the delimiter. + loop { + match getc(n) { + -1 | 0x2c | 10 => return len, + _ => {} + } + } + } + // Unquoted: this character and everything up to the delimiter. + loop { + if len < MAX_FIELD_LEN { + buf[len] = c as u8; + len += 1; + } + loop { + c = getc(n); + match c { + -1 | 0x2c | 10 => { + // Trailing blanks are separators rather than data. + while len > 0 && matches!(buf.get(len - 1), Some(b' ' | b'\t')) { + len -= 1; + } + return len; + } + 13 if !numeric => continue, + 0x20 | 9 if numeric => return number_end(n, len, false), + 13 if numeric => return number_end(n, len, true), + _ => break, + } + } + } +} + +/// A number read by INPUT # has ended at a blank (`cr`: at a CR). More +/// blanks, then a comma or a line break, all belong to its delimiter; the +/// LF of a CRLF goes with the CR, since left behind it would be an empty +/// line to a LINE INPUT # that follows. Anything else starts the next +/// field, and is put back. +fn number_end(n: i64, len: usize, mut cr: bool) -> usize { + if !cr { + loop { + match getc(n) { + 0x20 | 9 => continue, + -1 | 0x2c | 10 => return len, + 13 => { + cr = true; + break; + } + c => { + ungetc(n, c); + return len; + } + } + } + } + debug_assert!(cr); + match getc(n) { + -1 | 10 => {} + c => ungetc(n, c), + } + len +} + +/// LINE INPUT #: the next line of file `n` into FIELD_BUF, without its +/// newline, and without the CR before it in a file written with CRLF: +/// dropping only the LF handed every such line back with a stray CR. A line +/// longer than MAX_LINE_LEN comes back in pieces. +fn line_input(n: i64) -> &'static [u8] { + let buf = unsafe { FIELD_BUF.get() }; + let mut len = 0usize; + if readable(n) { + let mut read_any = false; + let mut saw_lf = false; + while len < MAX_LINE_LEN { + let c = getc(n); + if c < 0 { + break; + } + read_any = true; + if c == 10 { + saw_lf = true; + break; + } + buf[len] = c as u8; + len += 1; + } + if !read_any { + // A read past the end is GW-BASIC's "Input past end of file", + // so a loop missing its EOF() test says what is wrong. + raise(&error::_err_pastend[..], 0); + } else if saw_lf && len > 0 && buf.get(len - 1) == Some(&b'\r') { + len -= 1; + } + } + let len = len.min(MAX_LINE_LEN); + buf[len] = 0; + &buf[..len] +} + +/// `bytes` with a NUL, in NAME_BUF; None when too long to name a file. +fn c_name(bytes: &[u8]) -> Option<*const c_char> { + let buf = unsafe { NAME_BUF.get() }; + if bytes.len() >= NAME_CAP { + return None; + } + buf[..bytes.len()].copy_from_slice(bytes); + buf[bytes.len()] = 0; + Some(buf.as_ptr().cast()) +} + +/// The error for an OPEN in `mode` that failed for `why`. A missing file is +/// "File not found" when it was to be read; when it was to be created, what +/// is missing is the directory. +fn open_error(why: sys::OpenFailure, mode: i64) -> &'static [u8] { + use sys::OpenFailure::*; + match why { + NotFound if mode == INPUT => &error::_err_notfound, + NotFound | PathNotFound => &error::_err_pathnotfound, + Denied => &error::_err_permission, + BadName => &error::_err_badname, + Other => &error::_err_access, + } +} + +/// The checks every OPEN makes first, and the name for the C library: a +/// number still open must be CLOSEd first, and "" names no file. None when +/// an error was raised. +fn open_name(name: Str, n: i64) -> Option<*const c_char> { + let Some(i) = slot(n) else { + raise(&error::_err_badfile[..], 0); + return None; + }; + if i == 0 || !files().stream[i].is_null() { + raise(&error::_err_alreadyopen[..], 0); + return None; + } + let name = c_name(unsafe { name.bytes() }).filter(|_| name.len != 0); + if name.is_none() { + raise(&error::_err_badname[..], 0); + } + name +} + +/// Record a stream just opened on number `n`. A new file has no WIDTH, +/// starts at column 1, and is not a random one, whatever the last file on +/// this number left behind. +fn bind(n: usize, f: *mut FILE, mode: i64) { + let n = n % FILES; // what `slot` checked, said so that indexing cannot panic + let t = files(); + t.stream[n] = f; + t.mode[n] = mode; + t.width[n] = 0; + t.col[n] = 0; + let old = t.recbuf[n]; + // Cleared before anything can fail, so the slot never holds a pointer + // already freed: GET tests it for null to decide "Bad file mode". + t.recbuf[n] = ptr::null_mut(); + if !old.is_null() { + unsafe { sys::free(old) }; + } +} + +/// Seek file `n` to record `rec` (0 = the one after the last) for GET or +/// PUT: its stream, record length and buffer, or None when an error was +/// raised. +fn random_prepare(n: i64, rec: i64, line: i64) -> Option<(*mut FILE, usize, *mut u8)> { + let f = stream(n); + if f.is_null() { + raise(&error::_err_badfile[..], line); + return None; + } + let i = slot(n)?; + let t = files(); + let buf = t.recbuf[i]; + if buf.is_null() { + raise(&error::_err_badmode[..], line); + return None; + } + let reclen = t.reclen[i]; + let rec = if rec > 0 { rec } else { t.recnum[i] + 1 }; + t.recnum[i] = rec; + // Records are 1-based, so record n starts at (n-1) * reclen. + unsafe { sys::seek(f, (rec - 1).wrapping_mul(reclen), sys::SEEK_SET) }; + Some((f, reclen as usize, buf)) +} + +/// The byte range LOCK covers, as (start, length); a length of 0 is the +/// whole file. A first record of 0, or a file with no records, is the whole +/// file; otherwise records first..last, at least one. +fn lock_range(first: i64, last: i64, reclen: i64) -> (i64, i64) { + if first <= 0 || reclen == 0 { + return (0, 0); + } + let count = (last - first + 1).max(1); + ((first - 1) * reclen, count * reclen) +} + +/// LOCK or UNLOCK. +fn lock(n: i64, first: i64, last: i64, line: i64, on: bool) { + let f = stream(n); + if f.is_null() { + raise(&error::_err_badfile[..], line); + return; + } + let reclen = slot(n).map_or(0, |i| files().reclen[i]); + let (start, len) = lock_range(first, last, reclen); + if !unsafe { sys::lock(f, start, len, on) } { + raise(&error::_err_permission[..], line); + } +} + +/// The first `width` bytes of `s`, low byte first, as a number's bits; None +/// when `s` is too short. CVI and the rest read MK*$'s bytes back so. +fn gather(s: &[u8], width: usize) -> Option { + let bytes = s.get(..width)?; + Some( + bytes + .iter() + .enumerate() + .fold(0, |v, (i, &b)| v | (b as u64) << (8 * i)), + ) +} + +/// CVI/CVL/CVS/CVD's common part: the bits of the value in the string. +/// +/// The string must be at least as wide as the type being read. Zero-padding +/// a short one instead would be worse than useless: two characters read as +/// a DOUBLE do not give 0, they give a denormal near 1e-319, which is a +/// plausible number no program would ever notice was wrong. GW-BASIC calls +/// this an illegal function call, and so does this. +fn cv(p: *const u8, len: i64, line: i64, width: usize) -> Option { + let s = Str { + ptr: p, + len: len as usize, + }; + let bits = if (len as u64) < width as u64 { + None + } else if p.is_null() { + Some(0) + } else { + gather(unsafe { s.bytes() }, width) + }; + if bits.is_none() { + raise(&error::_err_domain[..], line); + } + bits +} + +fn str_of(s: &'static [u8]) -> Str { + Str { + ptr: s.as_ptr(), + len: s.len(), + } +} + +export! { + /// OPEN name FOR INPUT/OUTPUT/APPEND AS #n; `mode` 0, 1 or 2. + fn _rt_file_open(name: *const u8, len: i64, mode: i64, n: i64) { + let Some(cname) = open_name(Str { ptr: name, len: len as usize }, n) else { + return; + }; + let how: &[u8] = match mode { + INPUT => b"rb\0", + OUTPUT => b"wb\0", + _ => b"ab\0", + }; + let f = unsafe { sys::open(cname, how.as_ptr().cast()) }; + // A failed open used to be stored anyway, so the program carried on + // with a NULL handle. + if f.is_null() { + raise(open_error(unsafe { sys::open_failure(cname) }, mode), 0); + return; + } + // A directory opens for reading on unix -- only the first read + // fails -- so OPEN "." FOR INPUT used to succeed and INPUT # said + // "Input past end of file", naming the wrong problem. It is + // "Path/File access error" (75), as opening one for writing already + // is: those modes fail in fopen itself, so only INPUT is checked. + if mode == INPUT && unsafe { sys::is_directory(f) } { + unsafe { sys::fclose(f) }; + raise(&error::_err_access[..], 0); + return; + } + bind(n as usize, f, mode); + } + + /// OPEN name FOR RANDOM AS #n LEN = reclen. + /// + /// Four arguments, not five: there is no mode, because reaching this + /// entry point *is* the mode, and Win64 passes only four in registers. + fn _rt_file_open_random(name: *const u8, len: i64, n: i64, reclen: i64) { + // A record length outside 1..MAX_RECLEN is an Illegal function + // call, as in GW-BASIC, refused before anything is created. A + // missing LEN clause is not 0 here: codegen passes the default, 128. + if !(1..=MAX_RECLEN).contains(&reclen) { + raise(&error::_err_domain[..], 0); + return; + } + let Some(cname) = open_name(Str { ptr: name, len: len as usize }, n) else { + return; + }; + // A random file is read *and* written, so it is opened for update. + // "r+b" fails when the file does not exist yet, in which case it is + // created. + let mut f = unsafe { sys::open(cname, c"r+b".as_ptr()) }; + if f.is_null() { + f = unsafe { sys::open(cname, c"w+b".as_ptr()) }; + } + if f.is_null() { + raise(open_error(unsafe { sys::open_failure(cname) }, RANDOM), 0); + return; + } + let i = n as usize % FILES; // what `slot` checked + bind(i, f, RANDOM); + files().reclen[i] = reclen; + let buf = unsafe { sys::malloc(reclen as usize) }; + if buf.is_null() { + raise(&error::_err_memory[..], 0); + return; + } + // A fresh buffer reads as blanks, so a field never written holds + // spaces rather than whatever the allocator handed back. + unsafe { ptr::write_bytes(buf, b' ', reclen as usize) }; + let t = files(); + t.recbuf[i] = buf; + t.recnum[i] = 0; + t.fieldoff[i] = 0; + } + + /// CLOSE #n. The console is never closed. + fn _rt_file_close(n: i64) { + if let Some(i @ 1..) = slot(n) { + let f = files().stream[i]; + if !f.is_null() { + unsafe { + sys::fflush(f); + sys::fclose(f); + } + files().stream[i] = ptr::null_mut(); + } + } + } + + /// CLOSE: every open file. + fn _rt_file_close_all() { + for n in 1..FILES as i64 { + unsafe { _rt_file_close(n) }; + } + } + + /// PRINT # of a string. + fn _rt_file_print_string(n: i64, p: *const u8, len: i64) { + print_bytes(n, unsafe { Str { ptr: p, len: len as usize }.bytes() }); + } + + /// WRITE # of a DOUBLE: its digits, without PRINT's blanks. + fn _rt_file_print_float(n: i64, x: f64) { + print_bytes(n, num::fmt_double(x, false).as_bytes()); + } + + /// WRITE # of a SINGLE, which has only 7 significant digits to show. + fn _rt_file_print_single(n: i64, x: f64) { + print_bytes(n, num::fmt_double(x, true).as_bytes()); + } + + /// PRINT a DOUBLE: a blank where the sign would go, and a blank after. + fn _rt_print_number(n: i64, x: f64) { + print_number(n, num::fmt_basic(x, false)); + } + + /// PRINT a SINGLE, whose shorter digits are the reason PRINT keeps two + /// entry points at all. + fn _rt_print_number_single(n: i64, x: f64) { + print_number(n, num::fmt_basic(x, true)); + } + + /// PRINT's comma: move to the start of the next 14-column print zone, + /// padding with blanks, or to the next line past the last one. + fn _rt_print_zone(n: i64) { + match zone_target(col(n), width(n)) { + Some(c) => tab(n, c), + None => newline(n), + } + } + + /// SPC(count). + fn _rt_file_print_spc(n: i64, count: i64) { + spc(n, count); + } + + /// TAB(column). + fn _rt_file_print_tab(n: i64, column: i64) { + tab(n, column); + } + + /// One character, by its code. + fn _rt_file_print_char(n: i64, c: i64) { + print_char(n, c as u8); + } + + /// End the line: at the end of a PRINT # not ended by ; or ,. + fn _rt_file_print_newline(n: i64) { + newline(n); + } + + /// WIDTH [#n,] w: wrap output to file n at w columns. 255 means no + /// limit, as in GW-BASIC, and is what every file starts with. The range + /// 1-255 is checked by the caller. + fn _rt_width(n: i64, w: i64) { + if stream(n).is_null() { + raise(&error::_err_badfile[..], 0); + return; + } + files().width[n as usize] = if w == 255 { 0 } else { w }; + } + + /// INPUT # of a string: the next field, valid until the next read. + fn _rt_file_input_string(n: i64) -> Str { + str_of(read_field(n, false)) + } + + /// INPUT # of a number: the next field, read as VAL reads a string. + /// Text that is not a number is 0, and one too large for a DOUBLE is + /// Overflow. + fn _rt_file_input_number(n: i64) -> f64 { + let s = num::scan_number(read_field(n, true)); + if s.overflow { + raise(&error::_err_overflow[..], 0); + return 0.0; + } + s.value + } + + /// LINE INPUT #: the next whole line, valid until the next read. + fn _rt_file_line_input(n: i64) -> Str { + str_of(line_input(n)) + } + + /// EOF(n): -1 when the file has been read to its end (or is not open), + /// else 0. It peeks one character and pushes it back, since feof() + /// reports the end only after a read has already failed, which would + /// make EOF() lag by one line. + fn _rt_file_eof(n: i64) -> i32 { + match getc(n) { + -1 => -1, + c => { + ungetc(n, c); + 0 + } + } + } + + /// LOC(n): for a random file the last record read or written; for a + /// sequential one the position in 128-byte blocks, as GW-BASIC counts. + fn _rt_file_loc(n: i64) -> f64 { + let Some(i) = slot(n) else { return 0.0 }; + if !files().recbuf[i].is_null() { + return files().recnum[i] as f64; + } + let f = stream(n); + if f.is_null() { + return 0.0; + } + match unsafe { sys::tell(f) } { + pos if pos < 0 => 0.0, + pos => (pos / 128) as f64, + } + } + + /// LOF(n): the file's length in bytes; 0 when it is not open. + fn _rt_file_lof(n: i64) -> f64 { + let f = stream(n); + if f.is_null() { + return 0.0; + } + unsafe { + let pos = sys::tell(f); + sys::seek(f, 0, sys::SEEK_END); + let end = sys::tell(f); + sys::seek(f, pos, sys::SEEK_SET); + end as f64 + } + } + + /// Start a fresh FIELD statement. + fn _rt_field_reset(n: i64) { + if let Some(i) = slot(n) { + files().fieldoff[i] = 0; + } + } + + /// FIELD's next variable: the next `w` bytes of the record buffer. The + /// fields of one record must fit inside it. + fn _rt_field_next(n: i64, w: i64) -> Str { + let buf = slot(n).map_or(ptr::null_mut(), |i| files().recbuf[i]); + if buf.is_null() { + // FIELD on a file not opened FOR RANDOM has no buffer to carve. + raise(&error::_err_badmode[..], 0); + return Str::EMPTY; + } + let i = n as usize; + let w = w.max(0); // a negative width is empty, not a step back + let off = files().fieldoff[i]; + if off + w > files().reclen[i] { + raise(&error::_err_fieldovf[..], 0); + return Str::EMPTY; + } + files().fieldoff[i] = off + w; + Str { + ptr: unsafe { buf.add(off as usize) }, + len: w as usize, + } + } + + /// LSET: copy left-justified into a fixed-width field. The destination + /// keeps its address and width; only the bytes change. A short source + /// is padded with spaces, a long one cut on the right. + fn _rt_lset(dst: *mut u8, dlen: i64, src: *const u8, slen: i64) { + if dlen <= 0 { + return; + } + let k = (slen as u64).min(dlen as u64) as usize; + unsafe { + if k > 0 { + ptr::copy(src, dst, k); + } + ptr::write_bytes(dst.add(k), b' ', dlen as usize - k); + } + } + + /// RSET: the same, right-justified. + fn _rt_rset(dst: *mut u8, dlen: i64, src: *const u8, slen: i64) { + if dlen <= 0 { + return; + } + let k = (slen as u64).min(dlen as u64) as usize; + let pad = dlen as usize - k; + unsafe { + ptr::write_bytes(dst, b' ', pad); + if k > 0 { + ptr::copy(src, dst.add(pad), k); + } + } + } + + /// GET #n[, rec]: read one record into the buffer. A record reaching + /// past the end of the file is padded with NULs, so a field read from + /// beyond the data is empty rather than holding the previous record. + fn _rt_file_get(n: i64, rec: i64, line: i64) { + if let Some((f, reclen, buf)) = random_prepare(n, rec, line) { + unsafe { + let got = sys::fread(buf.cast(), 1, reclen, f); + ptr::write_bytes(buf.add(got), 0, reclen - got); + } + } + } + + /// PUT #n[, rec]: write the buffer as one record, flushed so that LOF + /// and a reader on another handle see it now. + fn _rt_file_put(n: i64, rec: i64, line: i64) { + if let Some((f, reclen, buf)) = random_prepare(n, rec, line) { + unsafe { + sys::fwrite(buf.cast(), 1, reclen, f); + sys::fflush(f); + } + } + } + + /// LOCK #n[, first [TO last]]: records first..last, or with 0 the whole + /// file. + fn _rt_lock(n: i64, first: i64, last: i64, line: i64) { + lock(n, first, last, line, true); + } + + /// UNLOCK, with LOCK's arguments. + fn _rt_unlock(n: i64, first: i64, last: i64, line: i64) { + lock(n, first, last, line, false); + } + + /// MKI$/MKL$/MKS$/MKD$: a number's bytes, as a fresh string. The value + /// arrives as raw bits so one helper serves all four widths: the caller + /// has already coerced it to the type whose width it passes. + fn _rt_mk(bits: i64, width: i64) -> Str { + let bytes = bits.to_le_bytes(); + crate::string::strdup(&bytes[..(width.clamp(0, 8) as usize)]) + } + + /// CVI: MKI$'s bytes back as an INTEGER. + fn _rt_cvi(p: *const u8, len: i64, line: i64) -> f64 { + cv(p, len, line, 2).map_or(0.0, |b| b as u16 as i16 as f64) + } + + /// CVL: MKL$'s bytes back as a LONG. + fn _rt_cvl(p: *const u8, len: i64, line: i64) -> f64 { + cv(p, len, line, 4).map_or(0.0, |b| b as u32 as i32 as f64) + } + + /// CVS: MKS$'s bytes back as a SINGLE. + fn _rt_cvs(p: *const u8, len: i64, line: i64) -> f64 { + cv(p, len, line, 4).map_or(0.0, |b| f32::from_bits(b as u32) as f64) + } + + /// CVD: MKD$'s bytes back as a DOUBLE. + fn _rt_cvd(p: *const u8, len: i64, line: i64) -> f64 { + cv(p, len, line, 8).map_or(0.0, f64::from_bits) + } +} + +#[cfg(test)] +mod tests { + use super::*; + use std::sync::Mutex; + + /// The file table is shared, and tests run on threads. + static SERIAL: Mutex<()> = Mutex::new(()); + + fn serial() -> std::sync::MutexGuard<'static, ()> { + SERIAL.lock().unwrap_or_else(|e| e.into_inner()) + } + + fn temp(name: &str) -> String { + let dir = std::env::temp_dir().join(format!("xbrt-file-{}", std::process::id())); + std::fs::create_dir_all(&dir).unwrap(); + dir.join(name).to_str().unwrap().to_string() + } + + fn open(name: &str, mode: i64, n: i64) { + unsafe { _rt_file_open(name.as_ptr(), name.len() as i64, mode, n) }; + assert!(!stream(n).is_null(), "{name} did not open"); + } + + fn put(n: i64, s: &str) { + unsafe { _rt_file_print_string(n, s.as_ptr(), s.len() as i64) }; + } + + fn text(s: Str) -> String { + String::from_utf8(unsafe { s.bytes() }.to_vec()).unwrap() + } + + #[test] + fn open_errors_map_to_gw_basic_numbers() { + use sys::OpenFailure::*; + assert_eq!( + open_error(NotFound, INPUT).as_ptr(), + error::_err_notfound.as_ptr() + ); + assert_eq!( + open_error(NotFound, OUTPUT).as_ptr(), + error::_err_pathnotfound.as_ptr() + ); + assert_eq!( + open_error(NotFound, RANDOM).as_ptr(), + error::_err_pathnotfound.as_ptr() + ); + assert_eq!( + open_error(PathNotFound, INPUT).as_ptr(), + error::_err_pathnotfound.as_ptr() + ); + assert_eq!( + open_error(Denied, APPEND).as_ptr(), + error::_err_permission.as_ptr() + ); + assert_eq!( + open_error(BadName, INPUT).as_ptr(), + error::_err_badname.as_ptr() + ); + assert_eq!( + open_error(Other, INPUT).as_ptr(), + error::_err_access.as_ptr() + ); + } + + #[cfg(unix)] + #[test] + fn errno_says_why_an_open_failed() { + let _g = serial(); + let missing = c"/nonexistent-xbrt/dir/file"; + assert!(unsafe { sys::open(missing.as_ptr(), c"rb".as_ptr()) }.is_null()); + assert_eq!( + unsafe { sys::open_failure(missing.as_ptr()) }, + sys::OpenFailure::NotFound + ); + let notdir = c"/dev/null/x"; + assert!(unsafe { sys::open(notdir.as_ptr(), c"rb".as_ptr()) }.is_null()); + assert_eq!( + unsafe { sys::open_failure(notdir.as_ptr()) }, + sys::OpenFailure::PathNotFound + ); + let long = std::ffi::CString::new("x".repeat(5000)).unwrap(); + assert!(unsafe { sys::open(long.as_ptr(), c"rb".as_ptr()) }.is_null()); + assert_eq!( + unsafe { sys::open_failure(long.as_ptr()) }, + sys::OpenFailure::BadName + ); + } + + #[cfg(unix)] + #[test] + fn a_directory_is_told_apart() { + let f = unsafe { sys::open(c".".as_ptr(), c"rb".as_ptr()) }; + assert!(!f.is_null()); + assert!(unsafe { sys::is_directory(f) }); + unsafe { sys::fclose(f) }; + let f = unsafe { sys::open(c"Cargo.toml".as_ptr(), c"rb".as_ptr()) }; + assert!(!f.is_null()); + assert!(!unsafe { sys::is_directory(f) }); + unsafe { sys::fclose(f) }; + } + + #[test] + fn print_zones_and_tabs() { + assert_eq!(zone_target(0, 0), Some(15)); + assert_eq!(zone_target(13, 0), Some(15)); + assert_eq!(zone_target(14, 0), Some(29)); + assert_eq!(zone_target(70, 0), Some(85)); + // A zone that would not fit whole under a WIDTH: the next line. + assert_eq!(zone_target(14, 42), Some(29)); + assert_eq!(zone_target(14, 41), None); + assert_eq!(zone_target(0, 28), Some(15)); + assert_eq!(zone_target(0, 27), None); + assert_eq!(zone_target(0, 13), None); + } + + #[test] + fn sequential_round_trip() { + let _g = serial(); + let path = temp("seq.txt"); + open(&path, OUTPUT, 1); + put(1, "abc"); + assert_eq!(col(1), 3); + unsafe { _rt_print_zone(1) }; + assert_eq!(col(1), 14); + put(1, "x"); + unsafe { _rt_file_print_tab(1, 20) }; + assert_eq!(col(1), 19); + unsafe { _rt_file_print_char(1, b',' as i64) }; + unsafe { _rt_file_print_char(1, b'"' as i64) }; + put(1, "q, r"); + unsafe { _rt_file_print_char(1, b'"' as i64) }; + put(1, ",tail "); + unsafe { _rt_file_print_newline(1) }; + assert_eq!(col(1), 0); + put(1, "10,,20\r\n"); + put(1, "a\0b\r\n"); + put(1, "last"); + unsafe { _rt_file_close(1) }; + assert!(stream(1).is_null()); + assert_eq!( + std::fs::read(&path).unwrap(), + b"abc x ,\"q, r\",tail \n10,,20\r\na\0b\r\nlast" + ); + + open(&path, INPUT, 2); + assert_eq!(unsafe { _rt_file_lof(2) }, 51.0); + assert_eq!(unsafe { _rt_file_eof(2) }, 0); + let field = || text(unsafe { _rt_file_input_string(2) }); + assert_eq!(field(), "abc x"); + assert_eq!(field(), "q, r"); + assert_eq!(field(), "tail"); + assert_eq!(field(), "10"); + assert_eq!(field(), ""); + assert_eq!(field(), "20"); + // LINE INPUT keeps NULs, and drops the CR of a CRLF. + assert_eq!(unsafe { _rt_file_line_input(2).bytes() }, b"a\0b"); + assert_eq!(unsafe { _rt_file_eof(2) }, 0); + assert_eq!(text(unsafe { _rt_file_line_input(2) }), "last"); + assert_eq!(unsafe { _rt_file_eof(2) }, -1); + assert_eq!(unsafe { _rt_file_loc(2) }, 0.0); + unsafe { _rt_file_close_all() }; + assert!(stream(2).is_null()); + } + + #[test] + fn numeric_fields_end_at_a_blank() { + let _g = serial(); + let path = temp("nums.txt"); + std::fs::write(&path, " 1 2 3 \n 4 , 5\r\nx 6 y\r\nnext\n").unwrap(); + open(&path, INPUT, 3); + let num = || { + std::str::from_utf8(read_field(3, true)) + .unwrap() + .to_string() + }; + assert_eq!(num(), "1"); + assert_eq!(num(), "2"); + assert_eq!(num(), "3"); + assert_eq!(num(), "4"); + assert_eq!(num(), "5"); + assert_eq!(num(), "x"); + assert_eq!(num(), "6"); + assert_eq!(num(), "y"); + // The CR's LF went with it: no empty line before "next". + assert_eq!(text(unsafe { _rt_file_line_input(3) }), "next"); + unsafe { _rt_file_close(3) }; + } + + #[test] + fn width_wraps_lines() { + let _g = serial(); + let path = temp("width.txt"); + open(&path, OUTPUT, 4); + unsafe { _rt_width(4, 5) }; + put(4, "abcdefghijkl"); + unsafe { _rt_file_print_newline(4) }; + put(4, "abcde"); + unsafe { _rt_file_print_newline(4) }; + put(4, "abc"); + unsafe { _rt_file_print_spc(4, 4) }; + unsafe { _rt_width(4, 255) }; + put(4, "abcdefgh"); + unsafe { _rt_file_close(4) }; + let nl = std::str::from_utf8(sys::NEWLINE).unwrap(); + let want = ["abcde", "fghij", "kl", "abcde", "abc ", " abcdefgh"].join(nl); + assert_eq!(std::fs::read_to_string(&path).unwrap(), want); + } + + #[test] + fn random_files() { + let _g = serial(); + let path = temp("random.dat"); + let _ = std::fs::remove_file(&path); + unsafe { _rt_file_open_random(path.as_ptr(), path.len() as i64, 5, 8) }; + assert!(!stream(5).is_null()); + unsafe { _rt_field_reset(5) }; + let a = unsafe { _rt_field_next(5, 3) }; + let b = unsafe { _rt_field_next(5, 5) }; + assert_eq!(unsafe { b.ptr.offset_from(a.ptr) }, 3); + assert_eq!(unsafe { a.bytes() }, b" "); + let set = |f: Str, s: &[u8], right: bool| unsafe { + let args = (f.ptr as *mut u8, f.len as i64, s.as_ptr(), s.len() as i64); + if right { + _rt_rset(args.0, args.1, args.2, args.3) + } else { + _rt_lset(args.0, args.1, args.2, args.3) + } + }; + set(a, b"x", false); + set(b, b"yz", true); + unsafe { _rt_file_put(5, 2, 0) }; + set(a, b"toolong", false); + set(b, b"", true); + unsafe { _rt_file_put(5, 0, 0) }; + assert_eq!(unsafe { _rt_file_loc(5) }, 3.0); + assert_eq!(unsafe { _rt_file_lof(5) }, 24.0); + unsafe { _rt_file_get(5, 2, 0) }; + assert_eq!(unsafe { a.bytes() }, b"x "); + assert_eq!(unsafe { b.bytes() }, b" yz"); + unsafe { _rt_file_get(5, 0, 0) }; + assert_eq!(unsafe { a.bytes() }, b"too"); + assert_eq!(unsafe { b.bytes() }, b" "); + // Record 1 was never written: the gap reads as NULs. + unsafe { _rt_file_get(5, 1, 0) }; + assert_eq!(unsafe { a.bytes() }, b"\0\0\0"); + // Past the end of the file: NULs too. + unsafe { _rt_file_get(5, 9, 0) }; + assert_eq!(unsafe { b.bytes() }, b"\0\0\0\0\0"); + assert_eq!(unsafe { _rt_file_loc(5) }, 9.0); + unsafe { _rt_lock(5, 1, 2, 0) }; + unsafe { _rt_unlock(5, 1, 2, 0) }; + unsafe { _rt_lock(5, 0, 0, 0) }; + unsafe { _rt_unlock(5, 0, 0, 0) }; + unsafe { _rt_file_close(5) }; + // Reopened sequentially, the number is not a random file any more. + open(&path, INPUT, 5); + assert!(files().recbuf[5].is_null()); + unsafe { _rt_file_close(5) }; + } + + #[test] + fn lset_and_rset() { + let mut buf = *b"XXXXXX"; + let p = buf.as_mut_ptr(); + unsafe { _rt_lset(p, 4, b"ab".as_ptr(), 2) }; + assert_eq!(&buf, b"ab XX"); + unsafe { _rt_rset(p, 4, b"ab".as_ptr(), 2) }; + assert_eq!(&buf, b" abXX"); + unsafe { _rt_rset(p, 4, b"abcdef".as_ptr(), 6) }; + assert_eq!(&buf, b"abcdXX"); + unsafe { _rt_lset(p, 4, ptr::null(), 0) }; + assert_eq!(&buf, b" XX"); + unsafe { _rt_lset(p, 0, b"zz".as_ptr(), 2) }; + assert_eq!(&buf, b" XX"); + } + + #[test] + fn lock_ranges() { + assert_eq!(lock_range(0, 0, 10), (0, 0)); + assert_eq!(lock_range(3, 0, 0), (0, 0)); + assert_eq!(lock_range(3, 5, 10), (20, 30)); + assert_eq!(lock_range(3, 1, 10), (20, 10)); + } + + #[test] + fn mk_and_cv_round_trip() { + let mk = |bits: i64, w: usize| bits.to_le_bytes()[..w].to_vec(); + let cvi = |s: &[u8]| unsafe { _rt_cvi(s.as_ptr(), s.len() as i64, 0) }; + let cvl = |s: &[u8]| unsafe { _rt_cvl(s.as_ptr(), s.len() as i64, 0) }; + let cvs = |s: &[u8]| unsafe { _rt_cvs(s.as_ptr(), s.len() as i64, 0) }; + let cvd = |s: &[u8]| unsafe { _rt_cvd(s.as_ptr(), s.len() as i64, 0) }; + assert_eq!(cvi(&mk(-2, 2)), -2.0); + assert_eq!(cvi(&mk(32767, 2)), 32767.0); + assert_eq!(cvi(b"AB"), 0x4241 as f64); + assert_eq!(cvl(&mk(-100000, 4)), -100000.0); + assert_eq!(cvs(&mk(1.5f32.to_bits() as i64, 4)), 1.5); + assert_eq!(cvd(&mk(0.1f64.to_bits() as i64, 8)), 0.1); + // Longer strings read their first bytes. + assert_eq!(cvi(b"\x01\x00zzz"), 1.0); + assert_eq!(gather(b"a", 2), None); + } +} diff --git a/rt/src/input.rs b/rt/src/input.rs index d16d212..776a0c3 100644 --- a/rt/src/input.rs +++ b/rt/src/input.rs @@ -1,4 +1,345 @@ -//! Console INPUT and LINE INPUT (input.s) +//! Console input: INPUT and LINE INPUT (input.s) +//! +//! INPUT reads a whole line and splits it on commas, as GW-BASIC and +//! QuickBASIC do: a field may be quoted, which lets it hold a comma; an +//! unquoted one has its surrounding blanks dropped. Every field is checked +//! against the variable it is for before any is stored: a number must be one +//! and nothing else (read by `num::scan_number`, as VAL reads one) and must +//! fit the variable's type; a quoted field is a string only. A line that +//! fails any of that, or has too few fields, prints "?Redo from start" and +//! asks again -- prompt and all. More fields than variables print "?Extra +//! ignored". At the end of the input every variable reads as empty, rather +//! than the statement waiting forever. // Copyright (c) 2025-2026 Jeff Garzik // SPDX-License-Identifier: MIT + +use crate::file::{con_string, set_console_column}; +use crate::{State, Str, num, sys}; + +/// Sema refuses an INPUT with more variables. +const MAX_INPUT_FIELDS: usize = 64; + +/// Longest line kept; the rest of a longer one is dropped. +const MAX_LINE: usize = 1023; + +/// The line read, and the fields INPUT found in it. +struct Input { + line: [u8; MAX_LINE + 1], + /// Where each field starts in `line`, and its length. + start: [usize; MAX_INPUT_FIELDS], + len: [usize; MAX_INPUT_FIELDS], + /// A numeric field's value. + value: [f64; MAX_INPUT_FIELDS], +} + +static INPUT: State = State::new(Input { + line: [0; MAX_LINE + 1], + start: [0; MAX_INPUT_FIELDS], + len: [0; MAX_INPUT_FIELDS], + value: [0.0; MAX_INPUT_FIELDS], +}); + +fn input() -> &'static mut Input { + unsafe { INPUT.get() } +} + +/// Read one line from stdin into `Input::line`: its length, and whether the +/// input had already ended so that nothing was read. +/// +/// A byte at a time, so a line is all that is taken. The newline is +/// consumed and not kept, as is any CR. A line longer than the buffer keeps +/// its first MAX_LINE characters. Output is flushed first, so a prompt is +/// on the screen before the program waits; and the console's column is 0 +/// afterwards, since the newline the user typed put the cursor there. +fn read_line() -> (usize, bool) { + unsafe { sys::fflush(sys::stdout()) }; + let line = &mut input().line; + let (mut len, mut any) = (0, false); + loop { + let c = unsafe { sys::fgetc(sys::stdin()) }; + if c < 0 { + break; + } + any = true; + match c { + 10 => break, + 13 => {} // a CR before the newline is not text + _ if len < MAX_LINE => { + line[len] = c as u8; + len += 1; + } + _ => {} // past the buffer: dropped + } + } + let len = len.min(MAX_LINE); + line[len] = 0; + set_console_column(0); + (len, !any) +} + +/// `x` converted to an integer as the CPU's cvtsd2si does: rounded to +/// nearest, ties to even, and i64::MIN when out of range or NaN. +fn round_to_i64(x: f64) -> i64 { + const TWO52: f64 = 4503599627370496.0; + const TWO63: f64 = 9223372036854775808.0; + if x.is_nan() || x.abs() >= TWO63 { + i64::MIN + } else if x.abs() < TWO52 { + // Adding 2^52 leaves no bits for a fraction, so the addition rounds + // as the FPU does: to nearest, ties to even. + let r = (x.abs() + TWO52) - TWO52; + (if x < 0.0 { -r } else { r }) as i64 + } else { + x as i64 // already a whole number + } +} + +/// Does `x` fit a variable of type `ty` ('I', 'L', 'S', else DOUBLE), +/// rounded as an assignment rounds? +fn fits(x: f64, ty: u8) -> bool { + match ty { + b'I' => { + let r = round_to_i64(x); + r as i16 as i64 == r + } + b'L' => { + let r = round_to_i64(x); + r as i32 as i64 == r + } + b'S' => !(x as f32).is_infinite(), + _ => true, + } +} + +/// What reading one line for an INPUT statement came to. +#[derive(Debug, PartialEq)] +enum Parsed { + /// Every variable has its field. + Done, + /// Every variable has its field and the line goes on. + Extra, + /// The line does not do: ask again. + Redo, +} + +/// Split `line` into fields for variables of `types`, checking each, into +/// `start`, `len` and `value`. +/// +/// Nothing here may panic -- the runtime has no panic machinery to call -- +/// so bytes are read through `get` wherever the bound is not plain. +fn parse( + line: &[u8], + types: &[u8], + start: &mut [usize; MAX_INPUT_FIELDS], + flen: &mut [usize; MAX_INPUT_FIELDS], + value: &mut [f64; MAX_INPUT_FIELDS], +) -> Parsed { + let n = line.len(); + let mut i = 0; // where in the line + let mut k = 0; // which field + loop { + let (Some(&ty), true) = (types.get(k), k < MAX_INPUT_FIELDS) else { + return Parsed::Extra; // never: k < types.len() <= the maximum + }; + // Leading blanks are not part of a field. + while i < n && matches!(line[i], b' ' | b'\t') { + i += 1; + } + let quoted = i < n && line[i] == b'"'; + if quoted { + // A quoted field runs to the closing quote (or the end of the + // line); only blanks may follow it. + i += 1; + start[k] = i; + while i < n && line[i] != b'"' { + i += 1; + } + flen[k] = i - start[k]; + if i < n { + i += 1; + while i < n && line[i] != b',' { + if !matches!(line[i], b' ' | b'\t') { + return Parsed::Redo; // text after a quoted field + } + i += 1; + } + } + } else { + // An unquoted field runs to the next comma, less trailing blanks. + start[k] = i; + while i < n && line[i] != b',' { + i += 1; + } + let mut end = i; + while end > start[k] && matches!(line.get(end - 1), Some(b' ' | b'\t')) { + end -= 1; + } + flen[k] = end - start[k]; + } + if ty != b'$' { + if quoted { + return Parsed::Redo; // a quoted field is not a number + } + let field = line.get(start[k]..start[k] + flen[k]).unwrap_or(&[]); + value[k] = if field.is_empty() { + 0.0 // an empty field is 0 + } else { + let s = num::scan_number(field); + // Too large for a DOUBLE, not a number, not only one, or + // too large for the variable. + if s.overflow || s.consumed != field.len() || !fits(s.value, ty) { + return Parsed::Redo; + } + s.value + }; + } + k += 1; + if i >= n { + return if k < types.len() { + Parsed::Redo // too few fields + } else { + Parsed::Done + }; + } + i += 1; // past the comma + if k >= types.len() { + return Parsed::Extra; + } + } +} + +/// Write `msg` on a line of its own. +fn say(msg: &[u8]) { + con_string(msg); + unsafe { crate::file::_rt_file_print_newline(0) }; +} + +export! { + /// LINE INPUT: one whole line, as typed, valid until the next read; + /// empty at the end of the input. + fn _rt_input_string() -> Str { + let (len, _) = read_line(); + Str { + ptr: input().line.as_ptr(), + len, + } + } + + /// INPUT: read and check one line for a whole statement. Then + /// `_rt_input_field_num` and `_rt_input_field_str` hand out the values. + /// + /// `prompt` already includes the "? " when the statement asks for one; + /// `types` holds one character per variable: '$' string, 'I' INTEGER, + /// 'L' LONG, 'S' SINGLE, 'D' DOUBLE. + fn _rt_input_line(prompt: *const u8, prompt_len: i64, types: *const u8, count: i64) { + let prompt = unsafe { Str { ptr: prompt, len: prompt_len as usize }.bytes() }; + let count = (count.max(0) as usize).min(MAX_INPUT_FIELDS); + let types = unsafe { Str { ptr: types, len: count }.bytes() }; + loop { + con_string(prompt); + let (len, ended) = read_line(); + let inp = input(); + if ended { + // Nothing more to read: every variable gets an empty value. + inp.len[..count].fill(0); + inp.value[..count].fill(0.0); + return; + } + let line = inp.line.get(..len).unwrap_or(&[]); + match parse(line, types, &mut inp.start, &mut inp.len, &mut inp.value) { + Parsed::Done => return, + Parsed::Extra => { + say(b"?Extra ignored"); + return; + } + Parsed::Redo => say(b"?Redo from start"), + } + } + } + + /// The value INPUT read for numeric variable `k`. + fn _rt_input_field_num(k: i64) -> f64 { + input().value.get(k as usize).copied().unwrap_or(0.0) + } + + /// The text INPUT read for string variable `k`: a copy, since the line + /// buffer is reused by the next read. + fn _rt_input_field_str(k: i64) -> Str { + let inp = input(); + let k = k as usize; + let (Some(&start), Some(&len)) = (inp.start.get(k), inp.len.get(k)) else { + return Str::EMPTY; + }; + match inp.line.get(start..start + len) { + Some(s) if !s.is_empty() => crate::string::strdup(s), + _ => Str::EMPTY, + } + } +} + +#[cfg(test)] +mod tests { + use super::*; + + fn run(line: &str, types: &str) -> (Parsed, Vec) { + let (mut s, mut l, mut v) = ([0; 64], [0; 64], [0.0; 64]); + let p = parse(line.as_bytes(), types.as_bytes(), &mut s, &mut l, &mut v); + let fields = (0..types.len()) + .map(|k| line.get(s[k]..s[k] + l[k]).unwrap_or("").to_string()) + .collect(); + (p, fields) + } + + #[test] + fn strings_split_on_commas() { + assert_eq!( + run("a, b ,c", "$$$"), + (Parsed::Done, vec!["a".into(), "b".into(), "c".into()]) + ); + assert_eq!( + run(" \"x, y\" , z", "$$"), + (Parsed::Done, vec!["x, y".into(), "z".into()]) + ); + assert_eq!(run("\"open", "$"), (Parsed::Done, vec!["open".into()])); + assert_eq!(run("a,b,c", "$$").0, Parsed::Extra); + assert_eq!(run("a", "$$").0, Parsed::Redo); + assert_eq!(run("\"a\"b", "$").0, Parsed::Redo); + assert_eq!(run("", "$"), (Parsed::Done, vec!["".into()])); + assert_eq!(run("a,", "$$"), (Parsed::Done, vec!["a".into(), "".into()])); + } + + #[test] + fn a_quoted_field_is_no_number() { + assert_eq!(run("\"1\"", "D").0, Parsed::Redo); + } + + #[test] + fn empty_numeric_fields_are_zero() { + // Reaches no number reader: every field is empty. + let (mut s, mut l, mut v) = ([0; 64], [0; 64], [9.0; 64]); + assert_eq!(parse(b" , ", b"DI", &mut s, &mut l, &mut v), Parsed::Done); + assert_eq!(&v[..2], &[0.0, 0.0]); + } + + #[test] + fn values_must_fit_their_type() { + assert!(fits(32767.0, b'I')); + assert!(fits(32767.4, b'I')); + assert!(!fits(32767.5, b'I')); + assert!(fits(-32768.5, b'I')); // ties to even: -32768 + assert!(!fits(-32769.0, b'I')); + assert!(fits(2147483647.0, b'L')); + assert!(!fits(2147483648.0, b'L')); + assert!(!fits(1e300, b'L')); + assert!(fits(3e38, b'S')); + assert!(!fits(4e38, b'S')); + assert!(fits(1e300, b'D')); + assert_eq!(round_to_i64(2.5), 2); + assert_eq!(round_to_i64(3.5), 4); + assert_eq!(round_to_i64(-2.5), -2); + assert_eq!(round_to_i64(f64::NAN), i64::MIN); + assert_eq!(round_to_i64(1e19), i64::MIN); + assert_eq!(round_to_i64(-9007199254740993.0), -9007199254740992); + } +} diff --git a/rt/src/print.rs b/rt/src/print.rs index d342f3c..7e97d89 100644 --- a/rt/src/print.rs +++ b/rt/src/print.rs @@ -1,4 +1,40 @@ //! Console setup at program start (print.s, _rt_platform_init) +//! +//! The printing itself is in file.rs: the console is file 0, the C +//! library's stdout, so PRINT and PRINT # are the same helpers with a +//! different number. // Copyright (c) 2025-2026 Jeff Garzik // SPDX-License-Identifier: MIT + +export! { + /// Prepare the console, before the program's first statement. + /// + /// Nothing to do on unix: stdout is open, and file 0 reaches it. + /// + /// On Windows the standard streams go into binary mode, since the + /// runtime writes CRLF itself and a text-mode stream would make each a + /// CR CR LF; stdin too, so that INPUT sees the bytes typed or piped, as + /// it did reading the handle directly. And VT processing is turned on, + /// so that the escape sequences CLS, LOCATE and COLOR write are acted on + /// rather than printed literally. That is best effort: a failure means + /// stdout is not a console -- redirected to a file, say -- and the + /// escapes are then just bytes in the file, which is what any terminal + /// program does. + fn _rt_platform_init() { + #[cfg(windows)] + { + use crate::sys; + unsafe { + sys::binary_mode(0); + sys::binary_mode(1); + sys::binary_mode(2); + let h = sys::GetStdHandle(sys::STD_OUTPUT_HANDLE); + let mut mode = 0u32; + if sys::GetConsoleMode(h, &mut mode) != 0 { + sys::SetConsoleMode(h, mode | sys::ENABLE_VIRTUAL_TERMINAL_PROCESSING); + } + } + } + } +} diff --git a/rt/src/sys.rs b/rt/src/sys.rs index 5186227..4f699c2 100644 --- a/rt/src/sys.rs +++ b/rt/src/sys.rs @@ -96,3 +96,410 @@ pub unsafe fn write(f: *mut FILE, bytes: &[u8]) { pub fn flush_all() { unsafe { fflush(core::ptr::null_mut()) }; } + +// --------------------------------------------------------------------------- +// Files, console input and console setup (file.rs, input.rs, print.rs) +// +// Every file is a C stdio stream on every OS, opened in binary mode: the +// runtime writes CRLF itself where Windows wants it. What differs -- the +// standard input stream, errno, 64-bit seeking, record locking, telling a +// directory from a file, and why an open failed -- is settled below. +// --------------------------------------------------------------------------- + +unsafe extern "C" { + pub fn fclose(f: *mut FILE) -> c_int; + pub fn fread(p: *mut c_void, size: usize, n: usize, f: *mut FILE) -> usize; + pub fn fgetc(f: *mut FILE) -> c_int; + pub fn ungetc(c: c_int, f: *mut FILE) -> c_int; +} + +pub const SEEK_SET: c_int = 0; +pub const SEEK_END: c_int = 2; + +#[cfg(all(unix, not(target_vendor = "apple")))] +mod stdin_stream { + use super::FILE; + unsafe extern "C" { + static stdin: *mut FILE; + } + pub fn get() -> *mut FILE { + unsafe { stdin } + } +} + +#[cfg(target_vendor = "apple")] +mod stdin_stream { + use super::FILE; + unsafe extern "C" { + static __stdinp: *mut FILE; + } + pub fn get() -> *mut FILE { + unsafe { __stdinp } + } +} + +#[cfg(windows)] +mod stdin_stream { + use super::FILE; + unsafe extern "C" { + fn __acrt_iob_func(index: u32) -> *mut FILE; + } + pub fn get() -> *mut FILE { + unsafe { __acrt_iob_func(0) } + } +} + +pub use stdin_stream::get as stdin; + +/// Why an OPEN failed, as far as the runtime tells causes apart: each is +/// one of GW-BASIC's error numbers. +#[derive(Clone, Copy, Debug, PartialEq, Eq)] +pub enum OpenFailure { + /// The file does not exist (53, or 76 when it was to be created). + NotFound, + /// A directory on the way to it does not exist (76). + PathNotFound, + /// It exists, and may not be opened so (70). + Denied, + /// The name cannot name a file (64). + BadName, + /// Anything else, a directory included (75). + Other, +} + +#[cfg(unix)] +mod unix { + use super::{FILE, OpenFailure}; + use core::ffi::{c_char, c_int}; + + unsafe extern "C" { + fn fopen(name: *const c_char, mode: *const c_char) -> *mut FILE; + fn fileno(f: *mut FILE) -> c_int; + fn fseeko(f: *mut FILE, off: i64, whence: c_int) -> c_int; + fn ftello(f: *mut FILE) -> i64; + fn fcntl(fd: c_int, cmd: c_int, ...) -> c_int; + } + + #[cfg(not(target_vendor = "apple"))] + unsafe extern "C" { + fn __errno_location() -> *mut c_int; + fn syscall(n: core::ffi::c_long, ...) -> core::ffi::c_long; + } + #[cfg(target_vendor = "apple")] + unsafe extern "C" { + fn __error() -> *mut c_int; + fn fstat(fd: c_int, buf: *mut core::ffi::c_void) -> c_int; + } + + pub fn errno() -> c_int { + #[cfg(not(target_vendor = "apple"))] + let p = unsafe { __errno_location() }; + #[cfg(target_vendor = "apple")] + let p = unsafe { __error() }; + unsafe { *p } + } + + /// fseek with a 64-bit offset. + /// + /// # Safety + /// `f` must be an open stream. + pub unsafe fn seek(f: *mut FILE, off: i64, whence: c_int) -> c_int { + unsafe { fseeko(f, off, whence) } + } + + /// ftell with a 64-bit result. + /// + /// # Safety + /// `f` must be an open stream. + pub unsafe fn tell(f: *mut FILE) -> i64 { + unsafe { ftello(f) } + } + + /// fopen. + /// + /// # Safety + /// Both must be NUL-terminated. + pub unsafe fn open(name: *const c_char, mode: *const c_char) -> *mut FILE { + unsafe { fopen(name, mode) } + } + + // errno values. Linux's are the same on every architecture it runs + // these programs on; macOS differs only in ENAMETOOLONG. + const EPERM: c_int = 1; + const ENOENT: c_int = 2; + const EACCES: c_int = 13; + const ENOTDIR: c_int = 20; + const EINVAL: c_int = 22; + const ETXTBSY: c_int = 26; + const EROFS: c_int = 30; + #[cfg(not(target_vendor = "apple"))] + const ENAMETOOLONG: c_int = 36; + #[cfg(target_vendor = "apple")] + const ENAMETOOLONG: c_int = 63; + + /// Why the open of `_name` just made failed, from errno. + /// + /// # Safety + /// `_name` must be NUL-terminated, as for `windows::open_failure`. + pub unsafe fn open_failure(_name: *const c_char) -> OpenFailure { + match errno() { + ENOENT => OpenFailure::NotFound, + ENOTDIR => OpenFailure::PathNotFound, + EACCES | EPERM | EROFS | ETXTBSY => OpenFailure::Denied, + ENAMETOOLONG | EINVAL => OpenFailure::BadName, + _ => OpenFailure::Other, + } + } + + /// Is the open stream `f` a directory? One opens for reading on unix, + /// and only the first read fails, with EISDIR. + /// + /// fstat, but not glibc's `fstat` or `stat`: glibc exports those + /// symbols only from 2.33 (before, they were inline wrappers around + /// `__fxstat`), so a program linked against either would not start on + /// an older system. The system call has always been there, so on Linux + /// it is made directly, as the assembly runtime made it, and `st_mode` + /// read from the kernel's `struct stat` for the architecture. macOS's + /// libSystem has always exported `fstat`. When fstat fails nothing is + /// known, and the file is taken not to be a directory. + /// + /// # Safety + /// `f` must be an open stream. + pub unsafe fn is_directory(f: *mut FILE) -> bool { + const S_IFMT: u32 = 0o170000; + const S_IFDIR: u32 = 0o040000; + // Larger than any architecture's struct stat, and 8-byte aligned. + let mut buf = [0u64; 32]; + let fd = unsafe { fileno(f) }; + // SYS_fstat, and st_mode, a u32 at offset 24. + #[cfg(all(not(target_vendor = "apple"), target_arch = "x86_64"))] + let (ok, mode) = ( + unsafe { syscall(5, fd, buf.as_mut_ptr()) } == 0, + buf[3] as u32, + ); + // SYS_fstat, and st_mode, a u32 at offset 16. + #[cfg(all(not(target_vendor = "apple"), target_arch = "aarch64"))] + let (ok, mode) = ( + unsafe { syscall(80, fd, buf.as_mut_ptr()) } == 0, + buf[2] as u32, + ); + // st_mode is a u16 at offset 4, after a 32-bit st_dev. + #[cfg(target_vendor = "apple")] + let (ok, mode) = ( + unsafe { fstat(fd, buf.as_mut_ptr().cast()) } == 0, + (buf[0] >> 32) as u16 as u32, + ); + ok && mode & S_IFMT == S_IFDIR + } + + /// `struct flock`, whose layout is the OS's. + #[cfg(not(target_vendor = "apple"))] + #[repr(C)] + struct Flock { + l_type: i16, + l_whence: i16, + l_start: i64, + l_len: i64, + l_pid: i32, + } + #[cfg(target_vendor = "apple")] + #[repr(C)] + struct Flock { + l_start: i64, + l_len: i64, + l_pid: i32, + l_type: i16, + l_whence: i16, + } + #[cfg(not(target_vendor = "apple"))] + const F_SETLK: c_int = 6; + #[cfg(not(target_vendor = "apple"))] + const F_WRLCK: i16 = 1; + #[cfg(target_vendor = "apple")] + const F_SETLK: c_int = 8; + #[cfg(target_vendor = "apple")] + const F_WRLCK: i16 = 3; + const F_UNLCK: i16 = 2; + + /// LOCK (`lock`) or UNLOCK `len` bytes of `f` from `start`, a `len` of + /// 0 being the whole file. False when refused. + /// + /// POSIX advisory locks through fcntl(F_SETLK). "Advisory" is the + /// honest word: they hold against other processes that also lock, + /// which is exactly what GW-BASIC's LOCK was for, and do nothing + /// against a process that simply writes. + /// + /// # Safety + /// `f` must be an open stream. + pub unsafe fn lock(f: *mut FILE, start: i64, len: i64, lock: bool) -> bool { + let fl = Flock { + l_type: if lock { F_WRLCK } else { F_UNLCK }, + l_whence: 0, // SEEK_SET + l_start: start, + l_len: len, + l_pid: 0, + }; + unsafe { fcntl(fileno(f), F_SETLK, &fl as *const Flock) >= 0 } + } +} + +#[cfg(windows)] +mod windows { + use super::{FILE, OpenFailure}; + use core::ffi::{c_char, c_int}; + + unsafe extern "C" { + fn _fsopen(name: *const c_char, mode: *const c_char, share: c_int) -> *mut FILE; + fn _errno() -> *mut c_int; + fn __doserrno() -> *mut u32; + fn _fileno(f: *mut FILE) -> c_int; + fn _get_osfhandle(fd: c_int) -> isize; + fn _setmode(fd: c_int, mode: c_int) -> c_int; + fn _fseeki64(f: *mut FILE, off: i64, whence: c_int) -> c_int; + fn _ftelli64(f: *mut FILE) -> i64; + } + + /// OVERLAPPED, which carries LockFileEx's byte offset. + #[repr(C)] + struct Overlapped { + internal: usize, + internal_high: usize, + offset: u32, + offset_high: u32, + event: isize, + } + + unsafe extern "system" { + fn GetFileAttributesA(name: *const c_char) -> u32; + fn LockFileEx( + h: isize, + flags: u32, + reserved: u32, + lo: u32, + hi: u32, + ov: *mut Overlapped, + ) -> i32; + fn UnlockFileEx(h: isize, reserved: u32, lo: u32, hi: u32, ov: *mut Overlapped) -> i32; + pub fn GetStdHandle(which: u32) -> isize; + pub fn GetConsoleMode(h: isize, mode: *mut u32) -> i32; + pub fn SetConsoleMode(h: isize, mode: u32) -> i32; + } + + pub const STD_OUTPUT_HANDLE: u32 = -11i32 as u32; + pub const ENABLE_VIRTUAL_TERMINAL_PROCESSING: u32 = 4; + + pub fn errno() -> c_int { + unsafe { *_errno() } + } + + /// fseek with a 64-bit offset. + /// + /// # Safety + /// `f` must be an open stream. + pub unsafe fn seek(f: *mut FILE, off: i64, whence: c_int) -> c_int { + unsafe { _fseeki64(f, off, whence) } + } + + /// ftell with a 64-bit result. + /// + /// # Safety + /// `f` must be an open stream. + pub unsafe fn tell(f: *mut FILE) -> i64 { + unsafe { _ftelli64(f) } + } + + /// fopen, sharing the file with readers only (`_SH_DENYWR`), as the + /// assembly runtime's CreateFileA did with FILE_SHARE_READ: a second + /// writer is refused, which is "Permission denied". + /// + /// # Safety + /// Both must be NUL-terminated. + pub unsafe fn open(name: *const c_char, mode: *const c_char) -> *mut FILE { + const _SH_DENYWR: c_int = 0x20; + unsafe { _fsopen(name, mode, _SH_DENYWR) } + } + + /// Why the open just made failed. errno alone cannot say: the CRT maps + /// a missing directory and a bad name to ENOENT, as it does a missing + /// file. So this reads `_doserrno`, the Win32 error the CRT set errno + /// from, and maps it as the assembly runtime mapped GetLastError. + /// + /// # Safety + /// `name` must be NUL-terminated: a directory is told apart by name. + pub unsafe fn open_failure(name: *const c_char) -> OpenFailure { + match unsafe { *__doserrno() } { + 2 => OpenFailure::NotFound, // ERROR_FILE_NOT_FOUND + 3 => OpenFailure::PathNotFound, // ERROR_PATH_NOT_FOUND + 5 => { + // ERROR_ACCESS_DENIED is also what opening a directory + // gives, and a directory is not a file to be denied: it is + // "Path/File access error", as on unix. + let attrs = unsafe { GetFileAttributesA(name) }; + if attrs != u32::MAX && attrs & 0x10 != 0 { + OpenFailure::Other // FILE_ATTRIBUTE_DIRECTORY + } else { + OpenFailure::Denied + } + } + 32 | 19 => OpenFailure::Denied, // sharing violation, write protect + 123 | 161 | 206 => OpenFailure::BadName, // invalid, bad path, too long + _ => OpenFailure::Other, + } + } + + /// Windows refuses to open a directory at all, so an open stream never + /// is one. + /// + /// # Safety + /// None needed; `unsafe` to match unix. + pub unsafe fn is_directory(_f: *mut FILE) -> bool { + false + } + + /// LOCK or UNLOCK through LockFileEx/UnlockFileEx on the stream's + /// handle. Win32 needs a length, so a `len` of 0, the whole file, is + /// the largest range there is. LOCKFILE_FAIL_IMMEDIATELY makes a held + /// lock an error rather than a wait, which is what GW-BASIC programs + /// expect. + /// + /// # Safety + /// `f` must be an open stream. + pub unsafe fn lock(f: *mut FILE, start: i64, len: i64, lock: bool) -> bool { + let len = if len == 0 { i64::MAX } else { len } as u64; + let mut ov = Overlapped { + internal: 0, + internal_high: 0, + offset: start as u32, + offset_high: (start as u64 >> 32) as u32, + event: 0, + }; + let h = unsafe { _get_osfhandle(_fileno(f)) }; + let (lo, hi) = (len as u32, (len >> 32) as u32); + let ok = if lock { + // LOCKFILE_EXCLUSIVE_LOCK | LOCKFILE_FAIL_IMMEDIATELY + unsafe { LockFileEx(h, 3, 0, lo, hi, &mut ov) } + } else { + unsafe { UnlockFileEx(h, 0, lo, hi, &mut ov) } + }; + ok != 0 + } + + /// Put file descriptor `fd` in binary mode, so nothing is translated. + /// + /// # Safety + /// None beyond the CRT's own checks. + pub unsafe fn binary_mode(fd: c_int) { + const _O_BINARY: c_int = 0x8000; + unsafe { _setmode(fd, _O_BINARY) }; + } +} + +#[cfg(unix)] +pub use unix::{errno, is_directory, lock, open, open_failure, seek, tell}; +#[cfg(windows)] +pub use windows::{ + ENABLE_VIRTUAL_TERMINAL_PROCESSING, GetConsoleMode, GetStdHandle, STD_OUTPUT_HANDLE, + SetConsoleMode, binary_mode, +}; +#[cfg(windows)] +pub use windows::{errno, is_directory, lock, open, open_failure, seek, tell}; diff --git a/rt/src/using.rs b/rt/src/using.rs index 03839a3..d4ecb8a 100644 --- a/rt/src/using.rs +++ b/rt/src/using.rs @@ -1,4 +1,516 @@ -//! PRINT USING (using.s) +//! PRINT USING, interpreted at run time (using.s) +//! +//! The format is read here as the statement runs, so it may be any string +//! expression and the output may go to a file. `_rt_using_start` names the +//! file and the format; then each value goes through `_rt_using_num` or +//! `_rt_using_str`, which print the literal text up to the next field and +//! the value in it; `_rt_using_end` prints the text after the last field +//! used, up to the next one. A format that runs out before the values does +//! what GW-BASIC does: it starts again from the beginning. A format with no +//! field at all is Illegal function call, and a value of the wrong kind for +//! its field is Type mismatch. // Copyright (c) 2025-2026 Jeff Garzik // SPDX-License-Identifier: MIT + +use crate::error::{self, raise}; +use crate::file::{_rt_file_print_char, _rt_file_print_string}; +use crate::{State, Str, sys}; + +// The flags a numeric field carries. +/// Group the integer part in thousands. +const COMMA: u32 = 1; +/// Prefix a currency sign, floated against the digits. +const DOLLAR: u32 = 2; +/// Fill with '*' rather than spaces. +const STAR: u32 = 4; +/// Place the sign after the number. +const TRAIL_SIGN: u32 = 8; +/// Always show a sign, '+' for positives. +const FORCE_SIGN: u32 = 16; +/// Render in exponential form. +const EXP: u32 = 32; + +/// The widest field, and the most digits after the point. Buffer sizes +/// follow from them: a double's widest %f rendering is a sign, 309 integer +/// digits, a point and MAX_DECIMALS fractional digits -- 351 characters. +const MAX_WIDTH: usize = 255; +const MAX_DECIMALS: usize = 40; + +/// A field found in the format. +#[derive(Clone, Copy, Debug, PartialEq)] +enum Field { + /// A number: width, digits after the point, flags. + Num(usize, usize, u32), + /// A string: width, 0 for the whole string. + Str(usize), +} + +/// The statement running. +struct Using { + /// Where the output goes. + file: i64, + fmt: Str, + /// How far through the format. + pos: usize, + /// A field was taken since the format began. + found: bool, +} + +static USING: State = State::new(Using { + file: 0, + fmt: Str::EMPTY, + pos: 0, + found: false, +}); + +/// What the format holds at `i`: a field and the position after it, or +/// None when the character there is text. +/// +/// The fields are GW-BASIC's, as LANGREF lists them: `!`, `&` and `\ \` +/// for a string; for a number, digit positions `#` with an optional `.`, +/// `,` among the digits, a leading `+`, `**`, `$$` or `**$`, a trailing +/// `^^^^`, and a trailing `+` or `-`. +fn field_at(f: &[u8], i: usize) -> Option<(Field, usize)> { + let len = f.len(); + match f[i] { + b'!' => return Some((Field::Str(1), i + 1)), + b'&' => return Some((Field::Str(0), i + 1)), + b'\\' => { + // Spaces, then '\'. + let mut j = i + 1; + while j < len && f[j] == b' ' { + j += 1; + } + if j >= len || f[j] != b'\\' { + return None; + } + return Some((Field::Str((j - i + 1).min(MAX_WIDTH)), j + 1)); + } + b'#' | b'+' | b'$' | b'*' => {} + _ => return None, + } + let (mut j, mut flags, mut width) = (i, 0u32, 0usize); + if f[j] == b'+' { + flags |= FORCE_SIGN; // a leading '+' + width += 1; + j += 1; + } + if j + 1 < len { + if f[j] == b'*' && f[j + 1] == b'*' { + flags |= STAR; // '**', and '**$' + width += 2; + j += 2; + if j < len && f[j] == b'$' { + flags |= DOLLAR; + width += 1; + j += 1; + } + } else if f[j] == b'$' && f[j + 1] == b'$' { + flags |= DOLLAR; // '$$': a sign and a digit + width += 2; + j += 2; + } + } + let (mut digits, mut comma) = (0usize, false); + while j < len { + match f[j] { + b'#' => { + digits += 1; + width += 1; + } + b',' => { + flags |= COMMA; + comma = true; + } + _ => break, + } + j += 1; + } + // A comma takes no position itself; the field grows by the separators + // its digits will need. + if comma && digits > 0 { + width += (digits - 1) / 3; + } + if digits == 0 && width == 0 { + return None; // nothing here formed a field + } + let mut decimals = 0; + if j < len && f[j] == b'.' { + let k = f.iter().skip(j + 1).take_while(|&&c| c == b'#').count(); + // A point with no digits is not part of the field. + if k > 0 { + decimals = k.min(MAX_DECIMALS); + width += decimals + 1; + j += k + 1; + } + } + if digits == 0 && decimals == 0 { + return None; // a field needs a digit somewhere + } + if f.get(j..j + 4) == Some(b"^^^^") { + flags |= EXP; + width += 4; + j += 4; + } + if j < len && (f[j] == b'-' || f[j] == b'+') { + if f[j] == b'+' { + flags |= FORCE_SIGN; + } + flags |= TRAIL_SIGN; + width += 1; + j += 1; + } + Some((Field::Num(width.min(MAX_WIDTH), decimals, flags), j)) +} + +/// Print literal text up to the next field and take the field; with +/// `stop`, at the end of the statement, stop before a field instead, and at +/// the end of the format instead of starting it again. `_` makes the next +/// character literal, and anything that is not a field is printed as it +/// is. None when there is no field to take. +fn next(stop: bool) -> Option { + let u = unsafe { USING.get() }; + let (file, fmt) = (u.file, unsafe { u.fmt.bytes() }); + let mut i = u.pos; + let result = loop { + if i >= fmt.len() { + if stop { + break None; // the statement's end: done + } + if !u.found { + // A whole pass found nothing to fill. + raise(&error::_err_domain[..], 0); + break None; + } + u.found = false; + i = 0; // use the format again from its start + continue; + } + let c = fmt[i]; + if c == b'_' && i + 1 < fmt.len() { + unsafe { _rt_file_print_char(file, fmt[i + 1] as i64) }; + i += 2; + continue; + } + match field_at(fmt, i) { + Some((field, after)) => { + if stop { + break None; + } + i = after; + u.found = true; + break Some(field); + } + None => { + unsafe { _rt_file_print_char(file, c as i64) }; + i += 1; + } + } + }; + u.pos = i; + result +} + +/// A layout buffer written front to back. The buffers are sized so that +/// nothing is ever dropped, but a write past the end would be dropped +/// rather than panic: the runtime has no panic machinery to call. +struct Out<'a> { + buf: &'a mut [u8], + len: usize, +} + +impl Out<'_> { + fn push(&mut self, c: u8) { + if let Some(b) = self.buf.get_mut(self.len) { + *b = c; + self.len += 1; + } + } + + fn extend(&mut self, s: &[u8]) { + for &c in s { + self.push(c); + } + } +} + +/// `raw` with a ',' before every third digit of its integer part, which +/// ends at the '.' or 'E', after any leading sign. +fn group(raw: &[u8], out: &mut Out) { + let int_end = raw + .iter() + .position(|&c| c == b'.' || c == b'E') + .unwrap_or(raw.len()); + let first = usize::from(matches!(raw.first(), Some(b'-' | b'+'))); + for (i, &c) in raw.iter().enumerate() { + if i < int_end && i > first && (int_end - i) % 3 == 0 { + out.push(b','); + } + out.push(c); + } +} + +/// One numeric field's text, `width` wide unless it does not fit: then it +/// is printed in full, preceded by '%', which is what GW-BASIC does rather +/// than truncating. Its length in `out`. +fn render_num(width: usize, decimals: usize, flags: u32, value: f64, out: &mut [u8]) -> usize { + let decimals = decimals.min(MAX_DECIMALS); + let width = width.min(MAX_WIDTH); + let mut value = value; + // A trailing sign, or a forced sign placed here, means the number is + // formatted without one. + let mut sign = 0u8; + if flags & (TRAIL_SIGN | FORCE_SIGN) != 0 { + // NaN is unordered, so it takes the minus sign, as ucomisd did. + if value >= 0.0 { + if flags & FORCE_SIGN != 0 { + sign = b'+'; + } + } else { + sign = b'-'; + value = -value; + } + } + let mut raw = [0u8; 512]; + let fmt: &[u8] = if flags & EXP != 0 { + b"%.*E\0" + } else { + b"%.*f\0" + }; + let n = unsafe { + sys::snprintf( + raw.as_mut_ptr().cast(), + raw.len(), + fmt.as_ptr().cast(), + decimals as core::ffi::c_int, + value, + ) + }; + let raw = &raw[..(n.max(0) as usize).min(511)]; + // The number, with its commas. + let mut work = [0u8; 1024]; + let mut body = Out { + buf: &mut work, + len: 0, + }; + if flags & COMMA != 0 { + group(raw, &mut body); + } else { + body.extend(raw); + } + let body_len = body.len; + let lead = sign != 0 && flags & TRAIL_SIGN == 0; + let dollar = flags & DOLLAR != 0; + let trail = flags & TRAIL_SIGN != 0; + let len = usize::from(lead) + usize::from(dollar) + body_len + usize::from(trail); + let mut o = Out { buf: out, len: 0 }; + // Padded on the left to the field width, or marked as too wide. + if len < width { + let fill = if flags & STAR != 0 { b'*' } else { b' ' }; + for _ in len..width { + o.push(fill); + } + } else if len > width { + o.push(b'%'); + } + if lead { + o.push(sign); + } + if dollar { + o.push(b'$'); + } + o.extend(work.get(..body_len).unwrap_or(&[])); + // A trailing sign is a column of its own, and a positive number leaves + // it blank, as GW-BASIC and QuickBASIC do, so the digits line up. + if trail { + o.push(if sign != 0 { sign } else { b' ' }); + } + o.len +} + +/// One string field's text: `width` wide, padded on the right or cut, as +/// GW-BASIC does. Its length in `out`. (A width of 0, the whole string, +/// needs no layout.) +fn render_str(s: &[u8], width: usize, out: &mut [u8]) -> usize { + let width = width.min(MAX_WIDTH); + let mut o = Out { buf: out, len: 0 }; + o.extend(s.get(..width).unwrap_or(s)); + for _ in o.len..width { + o.push(b' '); + } + o.len +} + +/// The layout buffer. +static OUT: State<[u8; 2048]> = State::new([0; 2048]); + +/// Write to the statement's file. +fn emit(bytes: &[u8]) { + let file = unsafe { USING.get() }.file; + unsafe { _rt_file_print_string(file, bytes.as_ptr(), bytes.len() as i64) }; +} + +export! { + /// Begin a PRINT USING statement on file `file` (0 = the console). + fn _rt_using_start(file: i64, fmt: *const u8, len: i64) { + let u = unsafe { USING.get() }; + u.file = file; + u.fmt = Str { ptr: fmt, len: len as usize }; + u.pos = 0; + u.found = false; + } + + /// PRINT USING of a number. + fn _rt_using_num(x: f64) { + match next(false) { + Some(Field::Num(w, d, f)) => { + let out = unsafe { OUT.get() }; + let n = render_num(w, d, f, x, out); + emit(out.get(..n).unwrap_or(&[])); + } + Some(Field::Str(_)) => raise(&error::_err_typemismatch[..], 0), + None => {} // an error was raised and trapped + } + } + + /// PRINT USING of a string. + fn _rt_using_str(p: *const u8, len: i64) { + match next(false) { + Some(Field::Str(0)) => emit(unsafe { Str { ptr: p, len: len as usize }.bytes() }), + Some(Field::Str(w)) => { + let s = unsafe { Str { ptr: p, len: len as usize }.bytes() }; + let out = unsafe { OUT.get() }; + let n = render_str(s, w, out); + emit(out.get(..n).unwrap_or(&[])); + } + Some(Field::Num(..)) => raise(&error::_err_typemismatch[..], 0), + None => {} + } + } + + /// Finish a PRINT USING statement: the text after the last field used, + /// up to the next one. + fn _rt_using_end() { + next(true); + } +} + +#[cfg(test)] +mod tests { + use super::*; + + fn fields(f: &str) -> Vec> { + (0..f.len()).map(|i| field_at(f.as_bytes(), i)).collect() + } + + #[test] + fn string_fields() { + assert_eq!(field_at(b"!", 0), Some((Field::Str(1), 1))); + assert_eq!(field_at(b"&x", 0), Some((Field::Str(0), 1))); + assert_eq!(field_at(b"\\ \\x", 0), Some((Field::Str(4), 4))); + assert_eq!(field_at(b"\\\\", 0), Some((Field::Str(2), 2))); + assert_eq!(field_at(b"\\ x\\", 0), None); + assert_eq!(field_at(b"\\ ", 0), None); + } + + #[test] + fn numeric_fields() { + let num = |s: &str| field_at(s.as_bytes(), 0); + assert_eq!(num("###"), Some((Field::Num(3, 0, 0), 3))); + assert_eq!(num("##.##"), Some((Field::Num(5, 2, 0), 5))); + assert_eq!(num(".##"), None); // a '.' does not start a field + assert_eq!(num("#.x"), Some((Field::Num(1, 0, 0), 1))); + assert_eq!(num("+#.#"), Some((Field::Num(4, 1, FORCE_SIGN), 4))); + assert_eq!(num("**#.##"), Some((Field::Num(6, 2, STAR), 6))); + assert_eq!(num("**$##"), Some((Field::Num(5, 0, STAR | DOLLAR), 5))); + assert_eq!(num("$$##.##"), Some((Field::Num(7, 2, DOLLAR), 7))); + assert_eq!(num("#,###.##"), Some((Field::Num(8, 2, COMMA), 8))); + assert_eq!(num("#######,"), Some((Field::Num(9, 0, COMMA), 8))); + assert_eq!(num("##.##^^^^"), Some((Field::Num(9, 2, EXP), 9))); + assert_eq!(num("##.##^^^"), Some((Field::Num(5, 2, 0), 5))); + assert_eq!(num("###-"), Some((Field::Num(4, 0, TRAIL_SIGN), 4))); + assert_eq!( + num("###+"), + Some((Field::Num(4, 0, TRAIL_SIGN | FORCE_SIGN), 4)) + ); + assert_eq!(num("$x"), None); + assert_eq!(num("**"), None); + assert_eq!(num("+"), None); + assert_eq!(num("*"), None); + // '$$' with no '#': the dollars form the width, but no digit. + assert_eq!(num("$$"), None); + assert_eq!(num("$$.#"), Some((Field::Num(4, 1, DOLLAR), 4))); + let wide = "#".repeat(300); + assert_eq!(num(&wide), Some((Field::Num(255, 0, 0), 300))); + let deep = format!("#.{}", "#".repeat(50)); + assert_eq!(num(&deep), Some((Field::Num(42, 40, 0), 52))); + assert_eq!(fields("a#")[0], None); + } + + fn num(w: usize, d: usize, f: u32, x: f64) -> String { + let mut out = [0; 2048]; + let n = render_num(w, d, f, x, &mut out); + String::from_utf8(out[..n].to_vec()).unwrap() + } + + #[test] + fn numbers_render_as_gw_basic() { + assert_eq!(num(5, 2, 0, 3.14163), " 3.14"); + assert_eq!(num(5, 2, 0, -3.14163), "-3.14"); + assert_eq!(num(3, 0, 0, 12345.0), "%12345"); + assert_eq!(num(5, 0, 0, 12345.0), "12345"); + assert_eq!(num(8, 2, COMMA, 1234.5), "1,234.50"); + assert_eq!(num(12, 0, COMMA, -1234567.0), " -1,234,567"); + assert_eq!(num(6, 2, STAR, 1.5), "**1.50"); + assert_eq!(num(7, 2, DOLLAR, 1.5), " $1.50"); + assert_eq!(num(4, 0, TRAIL_SIGN, 5.0), " 5 "); + assert_eq!(num(4, 0, TRAIL_SIGN, -5.0), " 5-"); + assert_eq!(num(4, 0, TRAIL_SIGN | FORCE_SIGN, 5.0), " 5+"); + assert_eq!(num(4, 1, FORCE_SIGN, 1.25), "+1.2"); + assert_eq!(num(4, 1, FORCE_SIGN, -1.0), "-1.0"); + assert_eq!(num(9, 2, EXP, 1234.5), " 1.23E+03"); + // The widest DOUBLE fits the buffers. + assert_eq!(num(5, 40, 0, f64::MAX).len(), 351); + } + + #[test] + fn strings_render_as_gw_basic() { + let s = |s: &[u8], w| { + let mut out = [0; 2048]; + let n = render_str(s, w, &mut out); + out[..n].to_vec() + }; + assert_eq!(s(b"hello", 2), b"he"); + assert_eq!(s(b"hi", 4), b"hi "); + assert_eq!(s(b"x", 300).len(), 255); + } + + /// Whole statements, to a file, as the asm runtime printed them. + #[test] + fn statements_reuse_the_format() { + let dir = std::env::temp_dir().join(format!("xbrt-using-{}", std::process::id())); + std::fs::create_dir_all(&dir).unwrap(); + let path = dir.join("using.txt"); + let name = path.to_str().unwrap(); + unsafe { crate::file::_rt_file_open(name.as_ptr(), name.len() as i64, 1, 6) }; + let start = |f: &str| unsafe { _rt_using_start(6, f.as_ptr(), f.len() as i64) }; + let st = |s: &str| unsafe { _rt_using_str(s.as_ptr(), s.len() as i64) }; + start("a_#b ## c"); + unsafe { _rt_using_num(1.0) }; + unsafe { _rt_using_num(2.0) }; + unsafe { _rt_using_end() }; + unsafe { crate::file::_rt_file_print_newline(6) }; + start("\\ \\|!|&|"); + st("hello"); + st("xyz"); + st("abc"); + unsafe { _rt_using_end() }; + unsafe { crate::file::_rt_file_close(6) }; + let nl = std::str::from_utf8(sys::NEWLINE).unwrap(); + assert_eq!( + std::fs::read_to_string(&path).unwrap(), + format!("a#b 1 ca#b 2 c{nl}hell|x|abc|") + ); + } +} From 2b26a55cc084e213672dbf34c4282d33e8e1b448 Mon Sep 17 00:00:00 2001 From: Jeff Garzik Date: Sat, 10 Oct 2026 17:37:51 +0000 Subject: [PATCH 07/17] rt: declare the allocator as the C library does; link UCRT's stdio on Windows Two CI failures in the runtime crate's own build: - Linux: newer Rust's suspicious_runtime_symbol_definitions lint wants malloc, calloc, realloc and free declared with *mut c_void, the signatures std itself relies on. Callers cast. - Windows: UCRT's snprintf and fprintf are inline functions in its headers, so the unit-test binary did not link. The extern block now names legacy_stdio_definitions, which compiled programs already link. Also notes, in build.rs and rt/Cargo.toml, that the runtime's edition is stated in both and must change together (review feedback). Co-Authored-By: Claude Opus 5.5 --- build.rs | 2 ++ rt/Cargo.toml | 2 ++ rt/src/data.rs | 6 +++--- rt/src/lib.rs | 2 +- rt/src/math.rs | 2 +- rt/src/string.rs | 2 +- rt/src/sys.rs | 12 ++++++++---- 7 files changed, 18 insertions(+), 10 deletions(-) diff --git a/build.rs b/build.rs index 0280494..7db4acd 100644 --- a/build.rs +++ b/build.rs @@ -71,6 +71,8 @@ fn build_rt(out: &std::path::Path) { let rustc = env::var("RUSTC").unwrap_or_else(|_| "rustc".into()); let target = env::var("TARGET").expect("cargo sets TARGET"); let lib = out.join("rt.a"); + // rustc is run directly, so rt/Cargo.toml is not read: the edition here + // must be the one declared there, which clippy and the unit tests use. let output = Command::new(rustc) .args(["--edition", "2024", "--crate-type", "staticlib"]) .args(["--crate-name", "xbasic64_rt", "--target", &target]) diff --git a/rt/Cargo.toml b/rt/Cargo.toml index dc7e28d..7d12483 100644 --- a/rt/Cargo.toml +++ b/rt/Cargo.toml @@ -1,6 +1,8 @@ [package] name = "xbasic64-rt" version = "1.0.2" +# Also passed to rustc by the compiler's build.rs, which does not read this +# file: change both together. edition = "2024" authors = ["Jeff Garzik "] description = "The runtime library linked into every program xbasic64 compiles" diff --git a/rt/src/data.rs b/rt/src/data.rs index 40c442e..a34d225 100644 --- a/rt/src/data.rs +++ b/rt/src/data.rs @@ -167,7 +167,7 @@ export! { } } } - let p = unsafe { sys::calloc(1, bytes as usize) }; + let p = unsafe { sys::calloc(1, bytes as usize) }.cast::(); if p.is_null() { error::raise(&_err_memory[..], 0); return; @@ -277,12 +277,12 @@ mod tests { let p = desc[0] as *mut u8; let all = unsafe { std::slice::from_raw_parts(p, 8 * 1000) }; assert!(all.iter().all(|&b| b == 0)); - unsafe { sys::free(p) }; + unsafe { sys::free(p.cast()) }; let mut desc = [0u64; 3]; unsafe { _rt_array_autodim(desc.as_mut_ptr(), 1, 16, 0) }; assert_eq!(&desc[1..], &[11, 0]); - unsafe { sys::free(desc[0] as *mut u8) }; + unsafe { sys::free(desc[0] as *mut core::ffi::c_void) }; } #[test] diff --git a/rt/src/lib.rs b/rt/src/lib.rs index 7092afb..2ef177b 100644 --- a/rt/src/lib.rs +++ b/rt/src/lib.rs @@ -148,7 +148,7 @@ pub const fn cstr(s: &str) -> [u8; N] { /// comes from here, which is what rtsig's `fresh` means. Out of memory is /// raised, and an empty string returned, when there is none. pub fn alloc_str(len: usize) -> *mut u8 { - let p = unsafe { sys::malloc(len.max(1)) }; + let p = unsafe { sys::malloc(len.max(1)) }.cast::(); if p.is_null() { error::raise(&error::_err_memory[..], 0); } diff --git a/rt/src/math.rs b/rt/src/math.rs index d6ce052..16a4886 100644 --- a/rt/src/math.rs +++ b/rt/src/math.rs @@ -373,7 +373,7 @@ mod tests { fn owned(s: Str) -> Vec { let v = unsafe { s.bytes() }.to_vec(); - unsafe { sys::free(s.ptr as *mut u8) }; + unsafe { sys::free(s.ptr.cast_mut().cast()) }; v } diff --git a/rt/src/string.rs b/rt/src/string.rs index 1717121..b88bac9 100644 --- a/rt/src/string.rs +++ b/rt/src/string.rs @@ -306,7 +306,7 @@ mod tests { fn freed(r: Str) -> Vec { let v = s(r); assert!(!r.ptr.is_null()); - unsafe { sys::free(r.ptr.cast_mut()) }; + unsafe { sys::free(r.ptr.cast_mut().cast()) }; v } diff --git a/rt/src/sys.rs b/rt/src/sys.rs index 7834ec9..8495a03 100644 --- a/rt/src/sys.rs +++ b/rt/src/sys.rs @@ -13,11 +13,15 @@ use core::ffi::{c_char, c_int, c_void}; /// The C library's `FILE`, only ever handled by pointer. pub enum FILE {} +// UCRT's printf family are inline functions in its headers; their exported +// definitions are in legacy_stdio_definitions.lib, which programs link and +// so must the runtime's unit tests. +#[cfg_attr(windows, link(name = "legacy_stdio_definitions"))] unsafe extern "C" { - pub fn malloc(size: usize) -> *mut u8; - pub fn calloc(n: usize, size: usize) -> *mut u8; - pub fn realloc(p: *mut u8, size: usize) -> *mut u8; - pub fn free(p: *mut u8); + pub fn malloc(size: usize) -> *mut c_void; + pub fn calloc(n: usize, size: usize) -> *mut c_void; + pub fn realloc(p: *mut c_void, size: usize) -> *mut c_void; + pub fn free(p: *mut c_void); pub fn abort() -> !; pub fn exit(code: c_int) -> !; From d51c7948cc89fecb2cb71132b9372220830af55e Mon Sep 17 00:00:00 2001 From: Jeff Garzik Date: Sat, 10 Oct 2026 17:46:00 +0000 Subject: [PATCH 08/17] rt: FIELD overflow on a huge width; keep record buffers alive for FIELD windows _rt_field_next tested `off + w > reclen`. A width near 2^63 wrapped the sum negative, passed, and handed out a window of length ~2^63 at the buffer, with the next field's offset far below it: LSET through either wrote out of bounds. It now compares w against the room left. The assembly runtime had the same flaw. A FIELD variable is a non-owned window onto its number's record buffer, and outlives the OPEN that made it. Re-OPENing the number (sequential or RANDOM) freed the buffer, as the assembly runtime also did, so a later LSET wrote freed memory and PRINT read it -- glibc aborted the unit test with a corrupted tcache. Each number's buffer is now MAX_RECLEN bytes, allocated on its first OPEN FOR RANDOM and never freed or moved; later OPENs FOR RANDOM reuse it, and the number's mode alone says whether it is a random file. At most 15 such buffers exist. LOCK's range and GET/PUT's next record now wrap explicitly, as the assembly's imul and inc did, rather than relying on release overflow semantics. Co-Authored-By: Claude Opus 5.5 --- rt/src/file.rs | 144 ++++++++++++++++++++++++++++++++++++++++--------- 1 file changed, 118 insertions(+), 26 deletions(-) diff --git a/rt/src/file.rs b/rt/src/file.rs index c4a3ae1..6def8b0 100644 --- a/rt/src/file.rs +++ b/rt/src/file.rs @@ -64,6 +64,16 @@ const NAME_CAP: usize = 4096; /// once; LSET and RSET write through the window, so PUT emits what they /// wrote. This is why LSET exists at all: plain assignment would allocate a /// fresh string and the variable would quietly stop tracking the record. +/// +/// A window outlives the OPEN that made it: nothing stops a program using a +/// FIELD variable after CLOSE, or after the number is opened again. So a +/// number's record buffer, once allocated, is never freed nor moved. It is +/// MAX_RECLEN bytes, enough for any record, and every later OPEN FOR RANDOM +/// of the number reuses it; an old window then shows the new file's record +/// (GW-BASIC calls such a variable undefined), but always names memory the +/// program may read and write. Freeing it on a re-OPEN, as the assembly +/// runtime did, left LSET writing freed memory. That is at most 15 buffers, +/// each allocated only when its number is first opened FOR RANDOM. struct Files { /// The stream; null when not open. Slot 0 is unused: the console is /// always open, as `sys::stdout()`. @@ -75,7 +85,9 @@ struct Files { /// Characters already on the current output line, so that TAB(n) knows /// how far to advance. Reset by a newline. col: [i64; FILES], - /// The record buffer (malloc'd), null unless opened FOR RANDOM. + /// The record buffer: MAX_RECLEN bytes, malloc'd by the first OPEN FOR + /// RANDOM of the number and never freed (see above). The number is a + /// random file only while `mode` says so too: `random_buf`. recbuf: [*mut u8; FILES], reclen: [i64; FILES], /// The last record read or written, 1-based; 0 = none. @@ -143,6 +155,15 @@ fn set_col(n: i64, c: i64) { } } +/// The record buffer of file number `n`, if it was last opened FOR RANDOM +/// (and the buffer could be allocated); null when it was not. +fn random_buf(n: i64) -> *mut u8 { + match slot(n) { + Some(i) if files().mode[i] == RANDOM => files().recbuf[i], + _ => ptr::null_mut(), + } +} + fn width(n: i64) -> i64 { slot(n).map_or(0, |i| files().width[i]) } @@ -505,9 +526,10 @@ fn open_name(name: Str, n: i64) -> Option<*const c_char> { name } -/// Record a stream just opened on number `n`. A new file has no WIDTH, -/// starts at column 1, and is not a random one, whatever the last file on -/// this number left behind. +/// Record a stream just opened on number `n`. A new file has no WIDTH and +/// starts at column 1, whatever the last file on this number left behind; +/// its `mode` alone says whether it is a random one. The record buffer is +/// kept, not freed: FIELD variables may still point into it. fn bind(n: usize, f: *mut FILE, mode: i64) { let n = n % FILES; // what `slot` checked, said so that indexing cannot panic let t = files(); @@ -515,13 +537,6 @@ fn bind(n: usize, f: *mut FILE, mode: i64) { t.mode[n] = mode; t.width[n] = 0; t.col[n] = 0; - let old = t.recbuf[n]; - // Cleared before anything can fail, so the slot never holds a pointer - // already freed: GET tests it for null to decide "Bad file mode". - t.recbuf[n] = ptr::null_mut(); - if !old.is_null() { - unsafe { sys::free(old.cast()) }; - } } /// Seek file `n` to record `rec` (0 = the one after the last) for GET or @@ -534,14 +549,18 @@ fn random_prepare(n: i64, rec: i64, line: i64) -> Option<(*mut FILE, usize, *mut return None; } let i = slot(n)?; - let t = files(); - let buf = t.recbuf[i]; + let buf = random_buf(n); if buf.is_null() { raise(&error::_err_badmode[..], line); return None; } + let t = files(); let reclen = t.reclen[i]; - let rec = if rec > 0 { rec } else { t.recnum[i] + 1 }; + let rec = if rec > 0 { + rec + } else { + t.recnum[i].wrapping_add(1) + }; t.recnum[i] = rec; // Records are 1-based, so record n starts at (n-1) * reclen. unsafe { sys::seek(f, (rec - 1).wrapping_mul(reclen), sys::SEEK_SET) }; @@ -677,16 +696,20 @@ export! { let i = n as usize % FILES; // what `slot` checked bind(i, f, RANDOM); files().reclen[i] = reclen; - let buf = unsafe { sys::malloc(reclen as usize) }.cast::(); + // The number's buffer from an earlier OPEN, or its first one. + let mut buf = files().recbuf[i]; if buf.is_null() { - raise(&error::_err_memory[..], 0); - return; + buf = unsafe { sys::malloc(MAX_RECLEN as usize) }.cast::(); + if buf.is_null() { + raise(&error::_err_memory[..], 0); + return; + } + files().recbuf[i] = buf; } - // A fresh buffer reads as blanks, so a field never written holds - // spaces rather than whatever the allocator handed back. + // A new record reads as blanks, so a field never written holds + // spaces rather than whatever the allocator or the last file left. unsafe { ptr::write_bytes(buf, b' ', reclen as usize) }; let t = files(); - t.recbuf[i] = buf; t.recnum[i] = 0; t.fieldoff[i] = 0; } @@ -818,7 +841,7 @@ export! { /// sequential one the position in 128-byte blocks, as GW-BASIC counts. fn _rt_file_loc(n: i64) -> f64 { let Some(i) = slot(n) else { return 0.0 }; - if !files().recbuf[i].is_null() { + if !random_buf(n).is_null() { return files().recnum[i] as f64; } let f = stream(n); @@ -856,16 +879,19 @@ export! { /// FIELD's next variable: the next `w` bytes of the record buffer. The /// fields of one record must fit inside it. fn _rt_field_next(n: i64, w: i64) -> Str { - let buf = slot(n).map_or(ptr::null_mut(), |i| files().recbuf[i]); + let buf = random_buf(n); if buf.is_null() { // FIELD on a file not opened FOR RANDOM has no buffer to carve. raise(&error::_err_badmode[..], 0); return Str::EMPTY; } - let i = n as usize; + let i = n as usize % FILES; // what `random_buf` checked let w = w.max(0); // a negative width is empty, not a step back - let off = files().fieldoff[i]; - if off + w > files().reclen[i] { + let off = files().fieldoff[i]; // 0..=reclen + // Compared as room left, not as `off + w`: a width near 2^63 wrapped + // that sum negative, which passed, and handed out a window reaching + // far past the buffer. The assembly runtime had the same flaw. + if w > files().reclen[i] - off { raise(&error::_err_fieldovf[..], 0); return Str::EMPTY; } @@ -1226,10 +1252,76 @@ mod tests { unsafe { _rt_file_close(5) }; // Reopened sequentially, the number is not a random file any more. open(&path, INPUT, 5); - assert!(files().recbuf[5].is_null()); + assert!(random_buf(5).is_null()); unsafe { _rt_file_close(5) }; } + /// A FIELD width so large that the offset plus it overflows is a FIELD + /// overflow, not a window reaching past the buffer: `off + w` wrapped + /// negative and passed the `> reclen` test, handing out a string of + /// length 2^63-1 at the buffer, and the next field an offset below it. + #[test] + fn a_huge_field_width_is_field_overflow() { + use crate::num::testing::*; + if in_child() { + let path = temp("hugefield.dat"); + unsafe { _rt_file_open_random(path.as_ptr(), path.len() as i64, 6, 8) }; + unsafe { _rt_field_reset(6) }; + let a = unsafe { _rt_field_next(6, 3) }; + assert_eq!(a.len, 3); + for w in [i64::MAX, i64::MAX - 2, i64::MAX - 3] { + let (s, raised) = trapped(|| unsafe { _rt_field_next(6, w) }); + assert!(raised, "width {w} was not refused"); + assert_eq!(s, Str::EMPTY); + assert_eq!(files().fieldoff[6], 3); + } + // What fits still fits, from where the last good field ended. + let b = unsafe { _rt_field_next(6, 5) }; + assert_eq!(unsafe { b.ptr.offset_from(a.ptr) }, 3); + unsafe { _rt_field_next(6, i64::MAX) }; + return; + } + expect_fatal( + "file::tests::a_huge_field_width_is_field_overflow", + "?FIELD overflow\n", + ); + } + + /// A FIELD variable is a window onto its file's record buffer, and + /// outlives the OPEN that made it: a re-OPEN of the number, sequential or + /// RANDOM, freed the buffer, and LSET then wrote freed memory and PRINT + /// read it. Valgrind or ASan sees that; the asserts below see that the + /// window still names the number's buffer. + #[test] + fn a_field_window_outlives_its_file() { + let _g = serial(); + let path = temp("window.dat"); + let _ = std::fs::remove_file(&path); + unsafe { _rt_file_open_random(path.as_ptr(), path.len() as i64, 7, 4) }; + unsafe { _rt_field_reset(7) }; + let a = unsafe { _rt_field_next(7, 4) }; + unsafe { _rt_lset(a.ptr as *mut u8, 4, b"ab".as_ptr(), 2) }; + unsafe { _rt_file_put(7, 1, 0) }; + unsafe { _rt_file_close(7) }; + // Reopened sequentially: not a random file, but the window must + // still be memory the program may write. + open(&path, INPUT, 7); + unsafe { _rt_lset(a.ptr as *mut u8, 4, b"cd".as_ptr(), 2) }; + assert_eq!(unsafe { a.bytes() }, b"cd "); + unsafe { _rt_file_close(7) }; + // Reopened FOR RANDOM, with a longer record: the old window is still + // valid memory, and reads the new (blank) record buffer. + unsafe { _rt_file_open_random(path.as_ptr(), path.len() as i64, 7, 64) }; + assert_eq!(unsafe { a.bytes() }, b" "); + unsafe { _rt_file_get(7, 1, 0) }; + assert_eq!(unsafe { a.bytes() }, b"ab "); + unsafe { _rt_lset(a.ptr as *mut u8, 4, b"ef".as_ptr(), 2) }; + unsafe { _rt_file_close(7) }; + open(&path, OUTPUT, 7); + unsafe { _rt_file_close(7) }; + assert_eq!(unsafe { a.bytes() }, b"ef "); + } + #[test] fn lset_and_rset() { let mut buf = *b"XXXXXX"; From 3f5a7527ab89d7bfd27fb5deb06f66b8b09cdade Mon Sep 17 00:00:00 2001 From: Jeff Garzik Date: Sat, 10 Oct 2026 17:48:27 +0000 Subject: [PATCH 09/17] Link the Rust runtime; delete the assembly runtime Every program now links rt/ -- one no_std Rust source over the C library -- instead of the two hand-written x86-64 assembly trees, which are gone (src/runtime/, src/rtbuild.rs: about 11,400 lines). - build.rs builds only rt/; building the compiler no longer needs an assembler (GNU as, or clang on Windows). - Codegen calls runtime helpers with the System V convention on x86-64, Windows included (RT_CALL_CONV), as export! defines them: a string result comes back in rax:rdx, as Cranelift returns two values, where the Windows C convention would use a hidden pointer. Elsewhere both use the platform's C convention. - Every fresh helper is now fallible: alloc_str raises Out of memory, a trappable error, where the asm never checked. - The asm-structure tests (tests/runtime, the fall-through test, the assembles-both test) are gone. rtsig's tests now read a call graph from rt/src: fallible must be exactly "reaches raise_with_code" and fresh exactly "reaches alloc_str", for every helper. A unit test checks rt.o needs nothing but the C library and the program's _data_* symbols. Checked against the assembly runtime (78cfddc's build): 646 of 649 examples and corpus programs give identical stdout, stderr and exit codes; the 3 others use RND seeded by TIMER, as always. Valgrind: 649 programs, 0 errors. Deliberate differences: a string's NUL bytes are written (glibc fprintf %.*s stopped at one); Out of memory is raised; Windows stdout is now CRT-buffered (flushed before input, stderr and exit). Measured, ASM -> Rust runtime (best of 3; text+data+bss): strings, 3M iterations 0.35s -> 0.35s 4118+1650+9768 -> 7255+2312+112 PRINT numbers, 2M lines 0.71s -> 0.78s 3416+1626+9720 -> 5805+2224+56 file write+INPUT #, 500k 0.24s -> 0.20s 6350+1706+9752 -> 12624+2320+5216 PRINT "hi" executable 21680 -> 17696 bytes on disk Co-Authored-By: Claude Opus 5.5 --- CLAUDE.md | 68 +- README.md | 10 +- build.rs | 50 +- src/codegen/mod.rs | 13 + src/main.rs | 17 +- src/rtbuild.rs | 159 -- src/rtsig.rs | 289 ++-- src/runtime.rs | 198 +-- src/runtime/sysv/data.s | 217 --- src/runtime/sysv/data_defs.s | 49 - src/runtime/sysv/error.s | 332 ---- src/runtime/sysv/file.s | 2122 ------------------------- src/runtime/sysv/input.s | 370 ----- src/runtime/sysv/math.s | 412 ----- src/runtime/sysv/print.s | 327 ---- src/runtime/sysv/string.s | 1004 ------------ src/runtime/sysv/using.s | 772 --------- src/runtime/win64-native/data.s | 194 --- src/runtime/win64-native/data_defs.s | 38 - src/runtime/win64-native/error.s | 343 ---- src/runtime/win64-native/file.s | 2172 -------------------------- src/runtime/win64-native/input.s | 410 ----- src/runtime/win64-native/math.s | 475 ------ src/runtime/win64-native/print.s | 384 ----- src/runtime/win64-native/string.s | 997 ------------ src/runtime/win64-native/using.s | 769 --------- tests/codegen/mod.rs | 56 - tests/integration.rs | 1 - tests/runtime/mod.rs | 375 ----- 29 files changed, 250 insertions(+), 12373 deletions(-) delete mode 100644 src/rtbuild.rs delete mode 100644 src/runtime/sysv/data.s delete mode 100644 src/runtime/sysv/data_defs.s delete mode 100644 src/runtime/sysv/error.s delete mode 100644 src/runtime/sysv/file.s delete mode 100644 src/runtime/sysv/input.s delete mode 100644 src/runtime/sysv/math.s delete mode 100644 src/runtime/sysv/print.s delete mode 100644 src/runtime/sysv/string.s delete mode 100644 src/runtime/sysv/using.s delete mode 100644 src/runtime/win64-native/data.s delete mode 100644 src/runtime/win64-native/data_defs.s delete mode 100644 src/runtime/win64-native/error.s delete mode 100644 src/runtime/win64-native/file.s delete mode 100644 src/runtime/win64-native/input.s delete mode 100644 src/runtime/win64-native/math.s delete mode 100644 src/runtime/win64-native/print.s delete mode 100644 src/runtime/win64-native/string.s delete mode 100644 src/runtime/win64-native/using.s delete mode 100644 tests/runtime/mod.rs diff --git a/CLAUDE.md b/CLAUDE.md index a7e888f..13ea7d4 100644 --- a/CLAUDE.md +++ b/CLAUDE.md @@ -48,23 +48,38 @@ Source → Lexer → Parser → Sema → CodeGen → Object → Executable (array descriptors read once per loop), `strings.rs` (string ownership), `expr.rs`, `builtins.rs`, `stmt.rs`, `calls.rs` (procedures and by-reference calls), `io.rs`, `trap.rs` (ON ERROR) -- **rtbuild.rs** - The hand-written x86-64 runtime library's trees - (`runtime/sysv`, `runtime/win64-native`: I/O, strings, math, using libc) and - how they become one assembly unit. Shared by `build.rs`, which assembles the - target's tree into `$OUT_DIR/runtime.o`, and by the crate's tests -- **runtime.rs** - The prebuilt runtime object, embedded; `main.rs` writes it - beside the program's object and links the two. Generated code reaches the - runtime's state and messages, and the runtime the program's `_data_*`, only - through `.globl` symbols +- **runtime.rs** - The prebuilt runtime object (from `rt/`), embedded; + `main.rs` writes it beside the program's object and links the two. + Generated code reaches the runtime's state and messages, and the runtime + the program's `_data_*`, only through exported symbols - **rtsig.rs** - Signature of every runtime helper generated code calls, whether it can raise an error, and whether its string result is fresh. Every call goes through `FnGen::call`, which builds the call from it; tests - derive `fallible` from the assembly's control flow and check that every - `fresh` helper reaches `malloc` + read a call graph from `rt/src` and check that `fallible` is exactly "can + reach `raise_with_code`" and `fresh` exactly "can reach `alloc_str`" - **main.rs** - CLI driver: reads source, runs the pipeline, writes the object and the runtime's, and links them with `cc` (or `link.exe`) -- **build.rs** - Assembles the runtime when the compiler is built, so building - needs the target's assembler too +- **build.rs** - Builds the runtime (`rt/`) with rustc for the target when the + compiler is built: a `no_std` staticlib with fat LTO, of which only the + crate's one merged object is kept (`$OUT_DIR/rt.o`; the rest of the + archive is `compiler_builtins`). It reads the `ar` format itself + +### The runtime (`rt/`) + +A `no_std` Rust crate, one source for every target, calling the C library +through `rt/src/sys.rs`, where everything OS-specific lives (the standard +streams, errno, 64-bit seeks, locking, the clock). One module per area: +`error` (messages, trapping state, `_rt_error`), `num` (number formatting and +reading), `string`, `data`, `file` (files and the console as file 0), `input`, +`using`, `math`, `print`. Helpers are defined with `export!` under the names +and signatures `rtsig.rs` lists. Its unit tests run with std (`cargo test` +covers the workspace). In the runtime: + +- **No `core::fmt`** outside tests: it adds tens of KB to every program. + Numbers are formatted with the C library's `snprintf`, as the asm runtime + did, so output is unchanged +- **Every string result that is fresh comes from `alloc_str`**, which raises + Out of memory; so every fresh helper is also fallible ### Test Structure (`tests/`) @@ -82,8 +97,6 @@ Integration tests organized by feature area: - `codegen/` - Assertions on the Cranelift IR the compiler generates (through `common::compile_to_clif()`), and behavioural tests of code paths with special cases: constant divisors, scalars in SSA values, huge functions -- `runtime/` - Structural checks on the two assembly runtimes: the same - `.globl` names, no `.equ` length constants, and the like - Feature modules: `arithmetic/`, `arrays/`, `control/`, `data/`, `errors/`, `file_io/`, `input/`, `math/`, `print/`, `procedures/`, `strings/`, `types/`, `variables/` ### Key Design Decisions @@ -126,20 +139,6 @@ Integration tests organized by feature area: reached through `Loc`; a scalar in an SSA value is a `Place::Var` - **Runtime checks on by default**: subscripts, division by zero, overflow and the rest; `--unsafe` removes them, and is refused with ON ERROR -- **Two runtimes in lockstep**: `src/runtime/sysv/` and `src/runtime/win64-native/` export - the same `.globl` names; a new helper must be added to both -- **Two assemblers, not just two runtimes**: `build.rs` assembles the runtime - with GNU `as` on Linux and `clang -c` on Windows, so the Win64 tree is the one built by the - assembler no test here runs. They disagree about `.equ len, . - label`: GNU - `as` folds it to an immediate, and an assembler that cannot prove the symbol - absolute assembles `mov reg, len` as a *load from that address* instead. - `CLS` did that on every Windows run. Bracket data with an `_end` label and - subtract at run time -- **A runtime helper should take at most four arguments**: Win64 passes only - four in registers, so a fifth is on the stack, where the hand-written Win64 - helper must find it above the shadow space. Cranelift places it correctly, - but `_rt_instr` and `_rt_mid_assign` show what the runtime side costs; fold an - argument away where possible (see `_rt_file_open_random`) - **Unsupported GW-BASIC names are refused, not ignored**: an unrecognised name is otherwise just a new variable, so `UNSUPPORTED` in `sema.rs` names the keywords this compiler does not provide and why @@ -149,7 +148,7 @@ Integration tests organized by feature area: - **Strings are owned and freed** (`codegen/strings.rs`): bit 63 of a string slot's length word marks bytes the slot owns, which assignment frees; a FIELD window owns nothing. A helper's result is a temporary to free only if - `rtsig` marks it `fresh` -- which a test checks reaches `malloc` -- so a new + `rtsig` marks it `fresh` -- which a test checks reaches `alloc_str` -- so a new helper that allocates must say so, and one that returns a slice or a static buffer must not. The runtime allocates every string with `malloc`, never `HeapAlloc`, since generated code frees with `free` @@ -170,10 +169,13 @@ Integration tests organized by feature area: on `_err_resume_label`. By-reference parameters are real references, so the handler sees what a procedure wrote. Only programs with ON ERROR pay for any of this -- **Every helper follows its platform's standard ABI**: a double goes where the - ABI puts it -- by position on Win64, so `(file, value)` passes the value in - xmm1 there. `rtsig.rs` lists one signature that serves both ABIs, and codegen - builds each call's Cranelift signature from it +- **Runtime helpers use System V on x86-64, on every OS**: a string result + is two words returned in rax:rdx, as Cranelift returns two values, where + the Windows C convention would return it through a hidden pointer. So + `export!` defines each helper `extern "sysv64"` on x86-64 and codegen calls + it with `CallConv::SystemV` (`RT_CALL_CONV`); elsewhere both use the + platform's C convention, which returns two words in two registers. + `rtsig.rs` lists one signature, and codegen builds each call from it ## Language Reference diff --git a/README.md b/README.md index 64b65da..cb89210 100644 --- a/README.md +++ b/README.md @@ -94,20 +94,18 @@ Source → Lexer → Parser → Semantic Analysis → Code Generator → Object 4. **Code Generator** - Lowers the AST to Cranelift IR; Cranelift does instruction selection and register allocation and writes the object file -The runtime library provides I/O, string operations, and math functions as hand-written x86-64 assembly using libc for portability. It is assembled once, when the compiler is built, and linked beside each program. +The runtime library (I/O, strings, number formatting, math) is a `no_std` Rust crate in `rt/` that calls the C library. It is built once, when the compiler is built, and linked beside each program. Key design choices: - No IR of its own: the AST is lowered directly to Cranelift's -- Each platform's standard ABI, for libc interoperability +- A portable `no_std` Rust runtime over the C library - GW-BASIC type semantics (division always returns Double) ## Requirements - Rust 1.96 or later -- Linux: the system assembler (`as`) to build the compiler, which assembles - its runtime library; the C compiler/linker (`cc`) with libc to link programs -- Windows: Clang to build the compiler (it assembles the runtime), and the MSVC - linker (`link.exe`) to link programs +- Linux: the C compiler/linker (`cc`) with libc, to link programs +- Windows: the MSVC linker (`link.exe`) and its C runtime, to link programs ## Platforms diff --git a/build.rs b/build.rs index 7db4acd..173568f 100644 --- a/build.rs +++ b/build.rs @@ -1,61 +1,21 @@ -//! Assemble the runtime library once, when the compiler is built +//! Build the runtime library once, when the compiler is built //! -//! It used to be appended to every program's assembly and assembled again on -//! every compile. Now it is assembled here for the target, into -//! `$OUT_DIR/runtime.o`, which the compiler embeds and links beside each +//! The runtime is the Rust crate in `rt/`, `no_std`, one source for every +//! target. It is built here with rustc for the target, as a staticlib, and +//! the one object fat LTO makes of it and the parts of `core` it uses is +//! kept as `$OUT_DIR/rt.o`, which the compiler embeds and links beside each //! program's own object. -//! -//! The assembler is the one the compiler has always used for the target: -//! GNU `as` for ELF, `clang -c` for COFF. So building the compiler needs it, -//! as running the compiler always did. -//! -//! The Rust runtime in `rt/` is built here too, with rustc, as a `no_std` -//! staticlib for the target, emitted as the one object fat LTO makes of it -//! and the parts of `core` it uses (`$OUT_DIR/rt.o`). It is not linked into -//! programs yet: it is being ported from the assembly, which it will replace -//! in one switch. // Copyright (c) 2025-2026 Jeff Garzik // SPDX-License-Identifier: MIT -#[path = "src/rtbuild.rs"] -mod rtbuild; - use std::env; use std::path::PathBuf; use std::process::Command; fn main() { - println!("cargo:rerun-if-changed=src/rtbuild.rs"); - println!("cargo:rerun-if-changed=src/runtime"); println!("cargo:rerun-if-changed=rt/src"); - - let os = env::var("CARGO_CFG_TARGET_OS").expect("cargo sets CARGO_CFG_TARGET_OS"); let out = PathBuf::from(env::var("OUT_DIR").expect("cargo sets OUT_DIR")); - let asm = out.join("runtime.s"); - let obj = out.join("runtime.o"); - - std::fs::write(&asm, rtbuild::emit(rtbuild::for_target(&os))).expect("OUT_DIR is writable"); - - let mut cmd = if os == "windows" { - let mut c = Command::new("clang"); - c.arg("-c"); - c - } else { - Command::new("as") - }; - let output = cmd - .arg("-o") - .arg(&obj) - .arg(&asm) - .output() - .unwrap_or_else(|e| panic!("cannot run the assembler for the runtime: {e}")); - assert!( - output.status.success(), - "the runtime does not assemble:\n{}", - String::from_utf8_lossy(&output.stderr) - ); - build_rt(&out); } diff --git a/src/codegen/mod.rs b/src/codegen/mod.rs index 2a105fa..b11ab35 100644 --- a/src/codegen/mod.rs +++ b/src/codegen/mod.rs @@ -298,6 +298,18 @@ pub struct CodeGen { for_slots: HashMap, } +/// The convention runtime helpers are called with, where it is not the +/// platform's: on x86-64 the runtime (`rt/`, `export!`) uses System V on +/// every OS, Windows included, because a string result is two words returned +/// in rax:rdx -- as Cranelift returns two values -- where the Windows C +/// convention would return it through a hidden pointer. Elsewhere the C +/// convention already returns two words in two registers. +const RT_CALL_CONV: Option = if cfg!(target_arch = "x86_64") { + Some(CallConv::SystemV) +} else { + None +}; + /// Lower `program` to an object file. pub fn generate( program: &Program, @@ -653,6 +665,7 @@ impl CodeGen { } let mut sig = Signature::new(self.call_conv); if name.starts_with("_rt_") { + sig.call_conv = RT_CALL_CONV.unwrap_or(self.call_conv); let h = rtsig::lookup(name); sig.params .extend(h.params.iter().map(|t| AbiParam::new(rt_type(*t)))); diff --git a/src/main.rs b/src/main.rs index eb3bb95..37f1fa3 100644 --- a/src/main.rs +++ b/src/main.rs @@ -10,8 +10,6 @@ mod codegen; mod lexer; mod parser; -#[cfg(test)] -mod rtbuild; mod rtsig; mod runtime; mod sema; @@ -197,7 +195,7 @@ fn main() { eprintln!("Error writing the object file: {}", e); std::process::exit(1); } - // The runtime, assembled when the compiler was built. + // The runtime, built when the compiler was built. if let Err(e) = fs::write(&rt_file, runtime::OBJECT) { eprintln!("Error writing the runtime object: {}", e); std::process::exit(1); @@ -215,8 +213,8 @@ fn main() { &obj_file, &rt_file, "/SUBSYSTEM:CONSOLE", - // Discard the runtime helpers this program never calls. Each is - // emitted into a COMDAT section of its own for exactly this; + // Discard the runtime helpers this program never calls. rustc + // emits each into a COMDAT section of its own; // /OPT:REF is the default for a non-/DEBUG link, but the whole // point is lost if that ever stops being true. "/OPT:REF", @@ -227,11 +225,10 @@ fn main() { ]) .output(); - // --gc-sections drops the runtime helpers this program never calls. The - // runtime emits each into a section of its own for exactly this; without - // that the flag has nothing to work with, since a linker discards - // unreferenced sections, never unreferenced labels. All 69 helpers used to - // be linked into every program: `PRINT "hi"` calls three of them. + // --gc-sections drops the runtime helpers this program never calls: + // rustc emits each function into a section of its own, which is what the + // flag works with, since a linker discards unreferenced sections, never + // unreferenced labels. `PRINT "hi"` calls three of the 85 helpers. #[cfg(not(windows))] let cc_output = Command::new("cc") .args([ diff --git a/src/rtbuild.rs b/src/rtbuild.rs deleted file mode 100644 index 10462bf..0000000 --- a/src/rtbuild.rs +++ /dev/null @@ -1,159 +0,0 @@ -//! The runtime library's sources, and how they become one assembly unit -//! -//! Shared by `build.rs`, which assembles the unit for the target into -//! `runtime.o` once, when the compiler is built, and by the compiler's own -//! tests, which check both trees. The compiler itself never sees this text: it -//! embeds the object (`runtime::OBJECT`) and links it beside each program's. -//! -//! Runtime is split into separate assembly files for maintainability: -//! - data_defs.s: Data section definitions (format strings, buffers) -//! - print.s: Print functions -//! - input.s: Input functions -//! - string.s: String manipulation functions -//! - math.s: Math and utility functions -//! - data.s: DATA/READ support functions -//! - file.s: File I/O functions (OPEN, CLOSE, PRINT#, INPUT#) -//! - error.s: Runtime error reporting -//! - using.s: PRINT USING field output -//! -//! Platform-specific runtimes: -//! - sysv/: System V AMD64 ABI (Linux) -//! - win64-native/: Windows x64 ABI - -// Copyright (c) 2025-2026 Jeff Garzik -// SPDX-License-Identifier: MIT - -/// One runtime tree's sources, in the order they are concatenated. -#[derive(Clone, Copy)] -pub struct Runtime { - pub data_defs: &'static str, - pub parts: [&'static str; 8], - /// Appended after the last part. Object-format specific, so it is a - /// property of the tree rather than something [`emit`] decides. - pub trailer: &'static str, - /// Directive putting one helper in a section of its own, with `{}` where - /// its name goes. Empty leaves the whole runtime in one `.text`. - /// - /// A linker discards an unreferenced *section*, never an unreferenced - /// label, so this is what lets a program drop the helpers it never calls. - /// Object-format specific, and the flags are not the same spelling on - /// COFF, which is why it lives here rather than in [`emit`]. - pub function_section: &'static str, -} - -pub const SYSV: Runtime = Runtime { - data_defs: include_str!("runtime/sysv/data_defs.s"), - parts: [ - include_str!("runtime/sysv/print.s"), - include_str!("runtime/sysv/input.s"), - include_str!("runtime/sysv/string.s"), - include_str!("runtime/sysv/math.s"), - include_str!("runtime/sysv/data.s"), - include_str!("runtime/sysv/file.s"), - include_str!("runtime/sysv/error.s"), - include_str!("runtime/sysv/using.s"), - ], - // Without this note GNU ld cannot tell whether the object needs an - // executable stack, assumes it does, and warns on every single compile -- - // and the program it links really does get a writable, executable stack. - // This runtime never runs code from the stack, so say so. - trailer: ".section .note.GNU-stack,\"\",@progbits\n", - function_section: ".section .text.{},\"ax\",@progbits\n", -}; - -pub const WIN64: Runtime = Runtime { - data_defs: include_str!("runtime/win64-native/data_defs.s"), - parts: [ - include_str!("runtime/win64-native/print.s"), - include_str!("runtime/win64-native/input.s"), - include_str!("runtime/win64-native/string.s"), - include_str!("runtime/win64-native/math.s"), - include_str!("runtime/win64-native/data.s"), - include_str!("runtime/win64-native/file.s"), - include_str!("runtime/win64-native/error.s"), - include_str!("runtime/win64-native/using.s"), - ], - // COFF has no equivalent note, and clang rejects the ELF spelling. - trailer: "", - // COFF's spelling of the same idea. The section name repeats -- COMDAT - // sections are told apart by their symbol, not their name -- and the - // fourth field names that symbol. `discard` is IMAGE_COMDAT_SELECT_ANY: - // there is only ever one definition here, so the selection rule does not - // matter, and the tolerant one is the better bet for something that - // cannot be assembled on a Linux host. link.exe discards unreferenced - // COMDATs under /OPT:REF, which main.rs passes explicitly. - function_section: ".section .text,\"xr\",discard,{}\n", -}; - -/// The tree for a target, by Cargo's `CARGO_CFG_TARGET_OS` spelling. Chosen -/// by the target rather than by `cfg`, which in a build script describes -/// the machine building the compiler. -pub fn for_target(os: &str) -> &'static Runtime { - if os == "windows" { &WIN64 } else { &SYSV } -} - -/// Put each `_rt_*` helper in `part` into a section of its own. -/// -/// Done here rather than by hand in the sources so that a helper added later -/// is covered without anyone remembering to, and so the two trees cannot -/// drift apart on it. -/// -/// Only exported entry points are split, for COFF's sake: a COMDAT section is -/// identified by a symbol, and that symbol has to be external. The three -/// helpers that are not `.globl` -- `_rt_case_convert` and, on Win64, -/// `_rt_init_input` -- therefore ride in the section of whichever helper -/// precedes them, which costs nothing: a jump into one keeps that section, -/// and `_rt_ucase` and `_rt_lcase` both jump to `_rt_case_convert`. -/// -/// This is only sound because no helper falls through into the next one: -/// sections are not laid out in source order, so a fall-through would land -/// somewhere else entirely. `_rt_lcase` used to, and now jumps explicitly. -fn split_helpers(part: &str, template: &str) -> String { - let exported: Vec<&str> = part - .lines() - .filter_map(|l| l.strip_prefix(".globl ")) - .map(str::trim) - .collect(); - - // Emitted ahead of the `.globl`, not between it and the label, because - // that is the order LLVM itself writes a COFF COMDAT in and there is no - // way to check the alternative from here. Every `.globl _rt_x` in both - // trees is immediately followed by `_rt_x:`, which a test enforces. - let mut output = String::with_capacity(part.len() + part.len() / 8); - for line in part.lines() { - if let Some(name) = line.strip_prefix(".globl ").map(str::trim) - && exported.contains(&name) - && name.starts_with("_rt_") - { - output.push_str(&template.replace("{}", name)); - } - output.push_str(line); - output.push('\n'); - } - output -} - -/// Concatenate one runtime tree into a single assembly unit. -pub fn emit(rt: &Runtime) -> String { - let mut output = String::new(); - - output.push_str("# BASIC Runtime Library\n"); - output.push_str("# Uses libc for cross-platform compatibility\n"); - output.push_str(".intel_syntax noprefix\n\n"); - - output.push_str(rt.data_defs); - output.push_str("\n.text\n\n"); - - for part in rt.parts { - if rt.function_section.is_empty() { - output.push_str(part); - } else { - output.push_str(&split_helpers(part, rt.function_section)); - } - output.push('\n'); - } - - output.push_str(rt.trailer); - - output -} diff --git a/src/rtsig.rs b/src/rtsig.rs index 55075a5..943fad2 100644 --- a/src/rtsig.rs +++ b/src/rtsig.rs @@ -99,7 +99,7 @@ pub static HELPERS: &[RtHelper] = &[ h("_rt_input_string", &[], STR), fallible(h("_rt_input_line", &[I64, I64, I64, I64], &[])), h("_rt_input_field_num", &[I64], &[F64]), - fresh(h("_rt_input_field_str", &[I64], STR)), + fallible(fresh(h("_rt_input_field_str", &[I64], STR))), h("_rt_cls", &[], &[]), h("_rt_beep", &[], &[]), h("_rt_pos", &[], &[I32]), @@ -153,7 +153,7 @@ pub static HELPERS: &[RtHelper] = &[ fallible(h("_rt_lock", &[I64, I64, I64, I64], &[])), fallible(h("_rt_unlock", &[I64, I64, I64, I64], &[])), // (value bits, width) - fresh(h("_rt_mk", &[I64, I64], STR)), + fallible(fresh(h("_rt_mk", &[I64, I64], STR))), // (pointer, length, line) fallible(h("_rt_cvi", &[I64, I64, I64], &[F64])), fallible(h("_rt_cvl", &[I64, I64, I64], &[F64])), @@ -166,28 +166,28 @@ pub static HELPERS: &[RtHelper] = &[ fallible(h("_rt_array_autodim", &[I64, I64, I64, I64], &[])), // Strings fallible(h("_rt_val", STR, &[F64])), - fresh(h("_rt_str", &[F64], STR)), - fresh(h("_rt_str_single", &[F64], STR)), - fresh(h("_rt_chr", &[I64], STR)), - fresh(h("_rt_space", &[I64], STR)), - fresh(h("_rt_hex", &[I64], STR)), - fresh(h("_rt_oct", &[I64], STR)), + fallible(fresh(h("_rt_str", &[F64], STR))), + fallible(fresh(h("_rt_str_single", &[F64], STR))), + fallible(fresh(h("_rt_chr", &[I64], STR))), + fallible(fresh(h("_rt_space", &[I64], STR))), + fallible(fresh(h("_rt_hex", &[I64], STR))), + fallible(fresh(h("_rt_oct", &[I64], STR))), // (count, character code) - fresh(h("_rt_string_n", &[I64, I64], STR)), + fallible(fresh(h("_rt_string_n", &[I64, I64], STR))), h("_rt_ltrim", STR, STR), h("_rt_rtrim", STR, STR), - fresh(h("_rt_ucase", STR, STR)), - fresh(h("_rt_lcase", STR, STR)), - fresh(h("_rt_strdup", STR, STR)), + fallible(fresh(h("_rt_ucase", STR, STR))), + fallible(fresh(h("_rt_lcase", STR, STR))), + fallible(fresh(h("_rt_strdup", STR, STR))), // (pointer, length, width) - fresh(h("_rt_fixed", &[I64, I64, I64], STR)), + fallible(fresh(h("_rt_fixed", &[I64, I64, I64], STR))), // (pointer, length, count) h("_rt_left", &[I64, I64, I64], STR), h("_rt_right", &[I64, I64, I64], STR), // (pointer, length, start, count) h("_rt_mid", &[I64, I64, I64, I64], STR), // (left pointer, left length, right pointer, right length) - fresh(h("_rt_strcat", &[I64, I64, I64, I64], STR)), + fallible(fresh(h("_rt_strcat", &[I64, I64, I64, I64], STR))), h("_rt_strcmp", &[I64, I64, I64, I64], &[I32]), // (haystack pointer, haystack length, needle pointer, needle length, start) fallible(h("_rt_instr", &[I64, I64, I64, I64, I64], &[I64])), @@ -197,8 +197,8 @@ pub static HELPERS: &[RtHelper] = &[ h("_rt_rnd", &[F64], &[F64]), h("_rt_randomize", &[F64], &[]), h("_rt_timer", &[], &[F64]), - fresh(h("_rt_date", &[], STR)), - fresh(h("_rt_time", &[], STR)), + fallible(fresh(h("_rt_date", &[], STR))), + fallible(fresh(h("_rt_time", &[], STR))), ]; /// The helper called `name`. @@ -218,71 +218,122 @@ mod tests { use super::*; use std::collections::{BTreeMap, BTreeSet}; - /// Labels and the labels each can transfer control to, for one tree. + /// The runtime's sources, `rt/src/*.rs`, by module name. + const RT_SOURCES: [(&str, &str); 11] = [ + ("data", include_str!("../rt/src/data.rs")), + ("error", include_str!("../rt/src/error.rs")), + ("file", include_str!("../rt/src/file.rs")), + ("input", include_str!("../rt/src/input.rs")), + ("crate", include_str!("../rt/src/lib.rs")), + ("math", include_str!("../rt/src/math.rs")), + ("num", include_str!("../rt/src/num.rs")), + ("print", include_str!("../rt/src/print.rs")), + ("string", include_str!("../rt/src/string.rs")), + ("sys", include_str!("../rt/src/sys.rs")), + ("using", include_str!("../rt/src/using.rs")), + ]; + + /// A function: its file's module, and its name. + type Func = (&'static str, String); + + /// Each function in the runtime, and the functions its body may call -- + /// a call graph read from the text. /// - /// Deliberately crude, and conservative in the right direction: every - /// jump or call to a label is an edge, and so is falling off the end of - /// one label into the next unless the last instruction was a `jmp` or - /// `ret`. It can only over-report what reaches a label. - fn control_flow(source: &str) -> (BTreeMap>, BTreeSet) { - let is_label = |s: &str| { - !s.is_empty() - && s.bytes() - .all(|b| b.is_ascii_alphanumeric() || b == b'_' || b == b'.') - }; - let mut edges: BTreeMap> = BTreeMap::new(); - let mut exported = BTreeSet::new(); - let mut current: Option = None; - let mut ended = false; - for raw in source.lines() { - let line = raw.split('#').next().unwrap().trim(); - if line.is_empty() { - continue; - } - if let Some(name) = line.strip_prefix(".globl ") { - exported.insert(name.trim().to_string()); - continue; + /// Deliberately crude, and conservative in the right direction: a name + /// mentioned in a body is a call. `m::f` is `f` in `m.rs` when there is + /// such a file; a bare `f` (or one under some other path) is `f` in the + /// same file if it has one, else every `f`; and functions of one name in + /// one file are merged. It can only over-report what a function reaches. + fn call_graph() -> BTreeMap> { + let ident = |c: char| c.is_ascii_alphanumeric() || c == '_'; + // (module, name) -> the (qualifier, name) pairs its body mentions. + let mut mentions: BTreeMap> = BTreeMap::new(); + for (module, source) in RT_SOURCES { + // Comments and character literals hold braces that are not code. + let code: String = source + .lines() + .map(|l| l.split("//").next().unwrap()) + .collect::>() + .join("\n") + .replace("'{'", "' '") + .replace("'}'", "' '"); + let mut rest = code.as_str(); + while let Some(at) = rest.find("fn ") { + let after = &rest[at + 3..]; + let name: String = after.chars().take_while(|c| ident(*c)).collect(); + let word_start = !rest[..at].chars().last().is_some_and(ident); + let Some(open) = after.find('{') else { break }; + // A declaration (`fn f();` in an extern block) has no body. + if name.is_empty() || !word_start || after[..open].contains(';') { + rest = &rest[at + 3..]; + continue; + } + let mut depth = 0; + let mut close = open; + for (i, c) in after[open..].char_indices() { + match c { + '{' => depth += 1, + '}' => { + depth -= 1; + if depth == 0 { + close = open + i; + break; + } + } + _ => {} + } + } + let body = &after[open..close]; + let entry = mentions.entry((module, name)).or_default(); + let mut prev = ""; + let mut words = body.split_inclusive(|c: char| !ident(c)).peekable(); + while let Some(w) = words.next() { + let word = w.trim_end_matches(|c: char| !ident(c)); + if !word.is_empty() { + entry.push((prev.to_string(), word.to_string())); + } + // `a::b`: remember `a` as `b`'s qualifier. + prev = if w.ends_with(':') && words.peek().is_some_and(|n| n == &":") { + word + } else { + "" + }; + } + rest = &after[open + 1..]; } - // A label, alone or followed by data on the same line - // (`_mode: .asciz "r+b"`). Data is never executed, so nothing - // falls through a data label. - if let Some((label, rest)) = line.split_once(':') - && is_label(label) - { - if let Some(prev) = ¤t - && !ended + } + let defined: BTreeSet = mentions.keys().cloned().collect(); + let modules: BTreeSet<&str> = RT_SOURCES.iter().map(|(m, _)| *m).collect(); + let mut graph = BTreeMap::new(); + for (func, words) in &mentions { + let mut callees = BTreeSet::new(); + for (qualifier, name) in words { + let in_module = |m: &'static str| defined.get(&(m, name.clone())).cloned(); + if let Some(m) = modules.get(qualifier.as_str()) + && let Some(f) = in_module(m) { - edges.get_mut(prev).unwrap().insert(label.to_string()); + callees.insert(f); + } else if let Some(f) = in_module(func.0) { + callees.insert(f); + } else { + callees.extend(defined.iter().filter(|(_, n)| n == name).cloned()); } - current = Some(label.to_string()); - edges.entry(label.to_string()).or_default(); - ended = !rest.trim().is_empty(); - continue; - } - let Some(cur) = ¤t else { continue }; - if line.starts_with('.') { - continue; // a directive, not an instruction - } - let mut words = line.split_whitespace(); - let op = words.next().unwrap(); - let arg = words.next().unwrap_or(""); - if (op.starts_with('j') || op == "call") && is_label(arg) { - edges.get_mut(cur).unwrap().insert(arg.to_string()); } - ended = op == "jmp" || op == "ret"; + graph.insert(func.clone(), callees); } - (edges, exported) + graph } - fn reaches_error(edges: &BTreeMap>, from: &str) -> bool { + /// Whether the helper `from` reaches a function named in `targets`. + fn reaches(graph: &BTreeMap>, from: &str, targets: &[&str]) -> bool { let mut seen = BTreeSet::new(); - let mut work = vec![from.to_string()]; - while let Some(label) = work.pop() { - if label == "_rt_error" || label == "_rt_error_num" { + let mut work: Vec = graph.keys().filter(|(_, n)| n == from).cloned().collect(); + while let Some(func) = work.pop() { + if targets.contains(&func.1.as_str()) { return true; } - if seen.insert(label.clone()) - && let Some(next) = edges.get(&label) + if seen.insert(func.clone()) + && let Some(next) = graph.get(&func) { work.extend(next.iter().cloned()); } @@ -290,81 +341,60 @@ mod tests { false } - /// Every helper that says its string result is fresh allocates, in both - /// trees: generated code frees such a result, and freeing a slice or a - /// static buffer instead would corrupt the heap. + /// Every helper that says its string result is fresh allocates it, and + /// every one that does not, does not: generated code frees a fresh + /// result, and freeing a slice or a static buffer would corrupt the heap, + /// while not freeing a fresh one leaks it. `alloc_str` is the only + /// allocator of returned strings. #[test] - fn test_fresh_helpers_allocate() { - for (tree, source) in crate::runtime::tree_sources() { - let (edges, _) = control_flow(&source); - for helper in HELPERS.iter().filter(|h| h.fresh) { - let mut seen = BTreeSet::new(); - let mut work = vec![helper.name.to_string()]; - let mut found = false; - while let Some(label) = work.pop() { - if label == "malloc" { - found = true; - break; - } - if seen.insert(label.clone()) - && let Some(next) = edges.get(&label) - { - work.extend(next.iter().cloned()); - } - } - assert!( - found, - "{} is marked fresh but never calls malloc in the {tree} runtime", - helper.name - ); - assert_eq!( - helper.rets, STR, - "{} is fresh, so returns a string", - helper.name - ); - } + fn test_fresh_matches_the_runtime() { + let graph = call_graph(); + for helper in HELPERS.iter().filter(|h| h.rets == STR) { + assert_eq!( + helper.fresh, + reaches(&graph, helper.name, &["alloc_str"]), + "{}: fresh is {}", + helper.name, + helper.fresh + ); + } + for helper in HELPERS.iter().filter(|h| h.fresh) { + assert_eq!( + helper.rets, STR, + "{} is fresh, so returns a string", + helper.name + ); } } - /// Every helper in the table is exported by both runtime trees. + /// Every helper in the table is a function of the runtime. #[test] - fn test_every_helper_exists_in_both_trees() { - for (tree, source) in crate::runtime::tree_sources() { - let (_, exported) = control_flow(&source); - for helper in HELPERS { - assert!( - exported.contains(helper.name), - "{} is in rtsig.rs but not exported by the {tree} runtime", - helper.name - ); - } + fn test_every_helper_is_in_the_runtime() { + let graph = call_graph(); + for helper in HELPERS { + assert!( + graph.keys().any(|(_, n)| n == helper.name), + "{} is in rtsig.rs but not defined in rt/src", + helper.name + ); } } - /// `fallible` says exactly whether a helper can reach `_rt_error` in - /// either tree. + /// `fallible` says exactly whether a helper can raise an error a + /// handler may trap. #[test] - fn test_fallible_matches_the_assembly() { - let trees: Vec<_> = crate::runtime::tree_sources() - .into_iter() - .map(|(tree, source)| (tree, control_flow(&source).0)) - .collect(); + fn test_fallible_matches_the_runtime() { + let graph = call_graph(); for helper in HELPERS { if helper.name == "_rt_error" || helper.name == "_rt_fatal" { continue; } - let reaching: Vec<&str> = trees - .iter() - .filter(|(_, edges)| reaches_error(edges, helper.name)) - .map(|(tree, _)| *tree) - .collect(); assert_eq!( helper.fallible, - !reaching.is_empty(), - "{}: fallible is {} but _rt_error is reachable in {:?}", + reaches(&graph, helper.name, &["raise_with_code"]), + "{}: fallible is {}", helper.name, - helper.fallible, - reaching + helper.fallible ); } } @@ -383,6 +413,7 @@ mod tests { include_str!("codegen/io.rs"), include_str!("codegen/stmt.rs"), include_str!("codegen/storage.rs"), + include_str!("codegen/strings.rs"), include_str!("codegen/trap.rs"), ] { let mut rest = source; diff --git a/src/runtime.rs b/src/runtime.rs index 52614f0..d7a0150 100644 --- a/src/runtime.rs +++ b/src/runtime.rs @@ -1,189 +1,43 @@ //! The runtime library, as an object file built with the compiler //! -//! `build.rs` assembles the target's runtime tree (see `rtbuild.rs`) once; -//! the compiler writes this object out beside each program's own and links +//! `build.rs` builds the Rust runtime in `rt/` for the target once, into one +//! object; the compiler writes it out beside each program's own and links //! the two. Helpers a program never calls are dropped at link time: each is //! in a section of its own. // Copyright (c) 2025-2026 Jeff Garzik // SPDX-License-Identifier: MIT -/// The assembled runtime for the target this compiler was built for. -pub const OBJECT: &[u8] = include_bytes!(concat!(env!("OUT_DIR"), "/runtime.o")); - -#[cfg(test)] -use crate::rtbuild::{Runtime, SYSV, WIN64, emit, for_target}; - -/// The helper name on a line that is exactly a `_rt_*` label definition. -/// -/// Used to pair a `.globl` with the label that must follow it, which is an -/// invariant `split_helpers` depends on and only a test checks. -#[cfg(test)] -fn helper_label(line: &str) -> Option<&str> { - let name = line.strip_prefix("_rt_")?.strip_suffix(':')?; - // A label and nothing else: `_rt_foo:` yes, `_rt_foo: .quad 0` no. - if name.is_empty() || !name.bytes().all(|b| b.is_ascii_alphanumeric() || b == b'_') { - return None; - } - Some(&line[..line.len() - 1]) -} - -/// Both runtime trees, each as one unsplit assembly text, by tree name. -#[cfg(test)] -pub(crate) fn tree_sources() -> [(&'static str, String); 2] { - let whole = |rt: &Runtime| { - emit(&Runtime { - function_section: "", - ..*rt - }) - }; - [ - ("sysv", whole(for_target("linux"))), - ("win64-native", whole(for_target("windows"))), - ] -} +/// The runtime for the target this compiler was built for. +pub const OBJECT: &[u8] = include_bytes!(concat!(env!("OUT_DIR"), "/rt.o")); #[cfg(test)] mod tests { use super::*; use std::process::Command; - /// Every exported helper's `.globl` is immediately followed by its label. - /// - /// `split_helpers` puts the section directive ahead of the `.globl`, so a - /// `.globl` that drifted away from its label would open a section around - /// the wrong code -- and on ELF, where the flags are accepted, it would do - /// so silently. - #[test] - fn test_globl_precedes_its_label() { - for rt in [&SYSV, &WIN64] { - for part in rt.parts { - let lines: Vec<&str> = part.lines().collect(); - for (i, line) in lines.iter().enumerate() { - let Some(name) = line.strip_prefix(".globl ").map(str::trim) else { - continue; - }; - if !name.starts_with("_rt_") { - continue; - } - let next = lines.get(i + 1).copied().unwrap_or(""); - assert_eq!( - helper_label(next), - Some(name), - "`.globl {}` must be followed by its label, not {:?}", - name, - next - ); - } - } - } - } - - /// Each runtime helper is emitted into a section of its own. - /// - /// A linker discards an unreferenced *section*, never an unreferenced - /// label, so this is what lets the linker drop the helpers a program does - /// not call. Without it all 69 went into every binary. - /// - /// Counted against the exported helpers, not against every label: a COMDAT - /// section is identified by a symbol and that symbol has to be external, - /// so the handful of helpers that are not `.globl` deliberately ride in - /// the section of whichever helper precedes them. - /// - /// The two object formats spell the directive differently -- ELF names the - /// section after the helper, COFF repeats `.text` and names the helper as - /// the COMDAT symbol -- so the match is on what they have in common. - #[test] - fn test_runtime_helpers_get_their_own_sections() { - for rt in [&SYSV, &WIN64] { - let asm = emit(rt); - let exported = asm.lines().filter(|l| l.starts_with(".globl _rt_")).count(); - let sections = asm - .lines() - .filter(|l| l.starts_with(".section .text") && l.contains("_rt_")) - .count(); - assert!( - exported > 50, - "expected the whole runtime, saw {} exported helpers", - exported - ); - assert_eq!( - sections, exported, - "every exported helper needs a section of its own" - ); - } - } - - /// Both runtimes must assemble, including the one this host cannot run. - /// - /// Only one tree is ever reachable from a compiled program, so a mistake in - /// the other -- a duplicated `.L` label, a typo'd branch target, an operand - /// form the assembler rejects -- stays invisible until the other platform's - /// CI runs. That is exactly how a block of code duplicated into a second - /// function, defining its labels twice, reached Windows and failed every - /// single compile there. - /// - /// The files of a tree are concatenated into one assembly unit, so this - /// assembles the whole tree rather than each file alone: `.L` labels are - /// not file-local the way they look. - /// - /// This is a Unix-host check, which is where it is worth having: GNU `as` - /// assembles every variant, so the Linux job catches a Win64 mistake before - /// Windows CI ever sees it. The reverse is not needed -- a System V - /// mistake fails the Linux job outright -- and Windows CI builds its own - /// tree in build.rs. - /// - /// What it does *not* cover, since GNU `as` targets ELF: the Win64 tree's - /// per-function section directives, whose flags and COMDAT selector are - /// COFF spellings that this assembler rejects outright. They are stripped - /// here so the hand-written code underneath still gets checked, which is - /// what this test was ever for. Only Windows CI can say whether the - /// directive itself is right. + /// The runtime needs nothing but the C library and the program's DATA + /// table. In particular no part of `core` is left undefined -- a panic + /// path the build did not merge in -- since a program could not link. #[test] - #[cfg_attr(windows, ignore = "GNU as assembles every tree; Windows uses clang")] - fn test_both_runtimes_assemble() { - // Every tree the compiler can emit, with the section directives taken - // off: this host's assembler has no opinion worth hearing about them. - let variants = [ - ( - "sysv", - Runtime { - function_section: "", - ..SYSV - }, - ), - ( - "win64-native", - Runtime { - function_section: "", - ..WIN64 - }, - ), - ]; - - for (name, rt) in &variants { - let dir = std::env::temp_dir().join(format!("xbasic64-asm-{name}")); - std::fs::create_dir_all(&dir).expect("writable temp directory"); - let asm = dir.join("runtime.s"); - let obj = dir.join("runtime.o"); - - std::fs::write(&asm, emit(rt)).expect("writable assembly file"); - - let output = Command::new("as") - .arg("-o") - .arg(&obj) - .arg(&asm) - .output() - .expect("GNU as, which the compiler itself requires"); - - assert!( - output.status.success(), - "the {} runtime does not assemble:\n{}", - name, - String::from_utf8_lossy(&output.stderr) - ); - - let _ = std::fs::remove_dir_all(&dir); - } + #[cfg(target_os = "linux")] + fn test_runtime_needs_only_libc_and_the_program() { + let dir = std::env::temp_dir().join(format!("xbasic64-rt-{}", std::process::id())); + std::fs::create_dir_all(&dir).unwrap(); + let obj = dir.join("rt.o"); + std::fs::write(&obj, OBJECT).unwrap(); + let out = match Command::new("nm").arg("-u").arg(&obj).output() { + Ok(out) => out, + Err(_) => return, // no nm here: nothing to check with + }; + let _ = std::fs::remove_dir_all(&dir); + let text = String::from_utf8_lossy(&out.stdout); + let foreign: Vec<&str> = text + .lines() + .filter_map(|l| l.split_whitespace().last()) + .filter(|s| s.starts_with("_R") || s.starts_with("_ZN") || s.contains("core")) + .collect(); + assert!(foreign.is_empty(), "rt.o needs Rust symbols: {foreign:?}"); + assert!(text.contains("_data_table"), "{text}"); } } diff --git a/src/runtime/sysv/data.s b/src/runtime/sysv/data.s deleted file mode 100644 index 7949b6f..0000000 --- a/src/runtime/sysv/data.s +++ /dev/null @@ -1,217 +0,0 @@ -# BASIC Runtime: DATA/READ/RESTORE Support -# -# DATA Statement Overview: -# DATA statements define constant values that READ takes in order. The -# compiler collects every item into _data_table in the .data section. -# -# Data Table Format: -# Each entry is 16 bytes: -# -# Offset Size Content -# ------ ---- ------- -# 0 8 1 if the item was written in quotes, else 0 -# 8 8 pointer to the item's text, NUL-terminated -# -# An item is kept as written, because GW-BASIC decides what it is when it is -# READ: `DATA 007` is the string "007" to READ A$ and the number 7 to READ A. -# A quoted item is a string only. The table used to tag items as integer, -# float or string at compile time, so READ A$ of 007 gave " 7". -# -# Global State: -# _data_table = Array of 16-byte entries (generated by compiler) -# _data_count = Number of entries in table -# _data_ptr = Current read position (0-based index) - -# _rt_read_number - READ into a numeric variable -# -# The item's text must be a number and nothing else, read as VAL reads one -# (_rt_scan_number). Anything else -- a quoted item, or text that is not a -# number -- is GW-BASIC's "Syntax error" (2), reported for the READ; an empty -# item is 0. This used to strtod a string item, so DATA "abc" read as 0. -# -# Arguments: -# rdi = BASIC line number, for the diagnostic -# -# Returns: -# xmm0 = value as double; 0 when there is nothing to read -# -# Side effect: Advances _data_ptr to next entry -# -# Reading past the last item raises Out of DATA (error 4). -.globl _rt_read_number -_rt_read_number: - push rbp - mov rbp, rsp - push rbx - push r12 - push r13 - push r14 - mov r12, rdi # line number - mov rax, QWORD PTR [rip + _data_ptr] - cmp rax, QWORD PTR [rip + _data_count] - jae .Lread_num_none - inc QWORD PTR [rip + _data_ptr] - shl rax, 4 - lea rcx, [rip + _data_table] - add rcx, rax # the entry - cmp QWORD PTR [rcx], 0 - jne .Lread_num_syntax # quoted: a string, not a number - mov rbx, QWORD PTR [rcx + 8] # its text - mov rdi, rbx - call strlen - mov r13, rax # its length - test r13, r13 - jz .Lread_num_zero # an empty item is 0 - mov rdi, rbx - mov rsi, r13 - call _rt_scan_number - test edx, edx - jnz .Lread_num_overflow - test rax, rax - jz .Lread_num_syntax - # Only blanks may follow the number. -.Lread_num_rest: - cmp rax, r13 - jae .Lread_num_done - movzx ecx, BYTE PTR [rbx + rax] - cmp ecx, 32 - je .Lread_num_blank - cmp ecx, 9 - jne .Lread_num_syntax -.Lread_num_blank: - inc rax - jmp .Lread_num_rest - -.Lread_num_none: - lea rdi, [rip + _err_outofdata] - jmp .Lread_num_raise -.Lread_num_syntax: - lea rdi, [rip + _err_syntax] - jmp .Lread_num_raise -.Lread_num_overflow: - lea rdi, [rip + _err_overflow] -.Lread_num_raise: - mov rsi, r12 # line - call _rt_error # returns only when trapped -.Lread_num_zero: - xorpd xmm0, xmm0 -.Lread_num_done: - pop r14 - pop r13 - pop r12 - pop rbx - leave - ret - -# _rt_read_string - READ into a string variable -# -# The item's text, as written: a quoted item without its quotes, an unquoted -# one as the DATA statement spelled it, so `DATA 007` reads as "007". -# -# Arguments: -# rdi = BASIC line number, for the diagnostic -# -# Returns: -# rax = pointer to string data -# rdx = string length; an empty string when there is nothing to read -# -# Side effect: Advances _data_ptr to next entry -.globl _rt_read_string -_rt_read_string: - push rbp - mov rbp, rsp - push rbx - sub rsp, 8 - mov rax, QWORD PTR [rip + _data_ptr] - cmp rax, QWORD PTR [rip + _data_count] - jae .Lread_str_none - inc QWORD PTR [rip + _data_ptr] - shl rax, 4 - lea rcx, [rip + _data_table] - mov rbx, QWORD PTR [rcx + rax + 8] # the text - mov rdi, rbx - call strlen # DATA text is NUL-terminated - mov rdx, rax - mov rax, rbx - add rsp, 8 - pop rbx - leave - ret -.Lread_str_none: - mov rsi, rdi # line - lea rdi, [rip + _err_outofdata] - call _rt_error # returns only when trapped - xor eax, eax - xor edx, edx - add rsp, 8 - pop rbx - leave - ret - -# _rt_restore - Reset DATA pointer (RESTORE statement) -# -# Arguments: -# rdi = new position (0-based index into data table); RESTORE with no -# argument passes 0, RESTORE n the index of the first item at or -# after line n -# -# Returns: nothing -.globl _rt_restore -_rt_restore: - mov QWORD PTR [rip + _data_ptr], rdi - ret - -# _rt_array_autodim - Create an array by using it, as GW-BASIC does -# -# Called when an array is reached with no storage: never DIMmed, or ERASEd. -# Every dimension runs from the OPTION BASE to 10, and the elements start as -# zeros -- 0 and "" alike. A use of an array before its DIM used to be the -# error "Array used before DIM". -# -# Arguments: -# rdi = the descriptor: word 0 the element pointer, word 1+i dimension i's -# element count, word 1+n+i its lower bound -# rsi = n, the number of dimensions -# rdx = element size in bytes -# rcx = the OPTION BASE -# Returns: nothing (Out of memory leaves the pointer null) -.globl _rt_array_autodim -_rt_array_autodim: - push rbp - mov rbp, rsp - push rbx - push r12 - mov rbx, rdi # descriptor - mov r12, rdx # running size: element size * the counts - mov eax, 11 - sub rax, rcx # elements per dimension: base..10 - xor r8d, r8d # dimension -.Lautodim_dim: - cmp r8, rsi - jae .Lautodim_alloc - mov QWORD PTR [rbx + 8 + r8*8], rax - lea r9, [rsi + r8] - mov QWORD PTR [rbx + 8 + r9*8], rcx - imul r12, rax - jo .Lautodim_nomem # too large to address at all - inc r8 - jmp .Lautodim_dim -.Lautodim_alloc: - mov edi, 1 - mov rsi, r12 - call calloc - test rax, rax - jz .Lautodim_nomem - mov QWORD PTR [rbx], rax - pop r12 - pop rbx - leave - ret -.Lautodim_nomem: - lea rdi, [rip + _err_memory] - xor esi, esi - call _rt_error # returns only when trapped - pop r12 - pop rbx - leave - ret diff --git a/src/runtime/sysv/data_defs.s b/src/runtime/sysv/data_defs.s deleted file mode 100644 index 6f2555b..0000000 --- a/src/runtime/sysv/data_defs.s +++ /dev/null @@ -1,49 +0,0 @@ -# Runtime data section definitions -.data -_fmt_str: .asciz "%.*s" -_fmt_int: .asciz "%ld" -_fmt_float: .asciz "%g" -# _rt_fmt_double's request: P significant digits in exponent form. -_fmt_sci: .asciz "%.*e" -_fmt_s: .asciz "%s" -_fmt_char: .asciz "%c" -_fmt_newline: .asciz "\n" -_fmt_input: .asciz "%lf" -_fmt_input_str: .asciz "%1023[^\n]" -_fmt_hex: .asciz "%llX" -_fmt_oct: .asciz "%llo" -_rng_state: .quad 0x12345678DEADBEEF -_rng_last: .quad 0 # last value RND returned, for RND(0) -_cls_seq: .asciz "\033[2J\033[H" -_locate_fmt: .asciz "\033[%d;%dH" -_locate_row_fmt: .asciz "\033[%dd" -_locate_col_fmt: .asciz "\033[%dG" -_date_fmt: .asciz "%m-%d-%Y" -_time_fmt: .asciz "%H:%M:%S" -_color_fmt: .asciz "\033[%d;%d;%dm" -_color_fg_fmt: .asciz "\033[%d;%dm" -_color_bg_fmt: .asciz "\033[%dm" -# GW-BASIC colour 0-7 -> ANSI colour: black blue green cyan red magenta brown white -_gw_to_ansi: .byte 0, 4, 2, 6, 1, 5, 3, 7 -_redo_msg: .asciz "?Redo from start\n" - -# Scratch buffers. These start as zeros, so they belong in .bss: in .data -# every one of these bytes is a zero stored in the executable itself, which -# came to 7.5K of the image across the whole runtime. -# -# Safe to leave .bss active at the end of this file, and only here: runtime.rs -# concatenates data_defs.s and then emits .text unconditionally before the -# first code-bearing part. Every other runtime file must restore .text itself. -.bss -.p2align 3 -_num_buf: .skip 64 -_fmt_scratch: .skip 64 # _rt_fmt_double's printf output, before reshaping -_fmt_digits: .skip 32 # ... and its significant digits -_scan_buf: .skip 128 # _rt_scan_number's copy of a number, for strtod -# Current output column per file number, so TAB(n) knows how far to advance. -# Updated by the print helpers and reset by a newline. Slot 0 is the console, -# which is file handle 0. Indexed as quadwords, hence the alignment above. -_file_col: .skip 128 -_input_buf: .skip 1024 -_chr_buf: .skip 2 -_str_buf: .skip 64 diff --git a/src/runtime/sysv/error.s b/src/runtime/sysv/error.s deleted file mode 100644 index a57dd2e..0000000 --- a/src/runtime/sysv/error.s +++ /dev/null @@ -1,332 +0,0 @@ -# BASIC Runtime: Error Reporting -# -# One abort path for every runtime check. The message text is passed in and the -# BASIC line number is a register argument, so only a handful of message -# constants are ever needed no matter how many check sites exist. -# -# Messages are NUL-terminated and measured here rather than having their length -# passed in. A check site lives in the program's own .text, which the assembler -# sees before this file, so `mov reg, _msg_len` there is a *forward* reference: -# GAS cannot yet know the symbol is absolute and assembles a memory load from -# that address instead of an immediate. Measuring here sidesteps the ordering -# entirely. -# -# Diagnostics go to stderr, so a program's real output on stdout stays clean -# and a test can still check partial output followed by an abort. - -.data -# Named by generated code, which is a separate object: the program's -# checks pass these messages to _rt_error, and its trapping code reads -# and writes the state below. -.globl _err_fmt_line -.globl _err_fmt_bare -.globl _err_syntax -.globl _err_subscript -.globl _err_typemismatch -.globl _err_div0 -.globl _err_domain -.globl _err_overflow -.globl _err_dupdef -.globl _err_memory -.globl _err_gosub -.globl _err_noreturn -.globl _err_outofdata -.globl _err_badfile -.globl _err_badmode -.globl _err_fieldovf -.globl _err_permission -.globl _err_notfound -.globl _err_alreadyopen -.globl _err_pastend -.globl _err_badname -.globl _err_access -.globl _err_pathnotfound -.globl _err_unprintable -.globl _err_resnoerr -.globl _err_handler -.globl _err_pending -.globl _err_active -.globl _err_line - -_err_fmt_line: .asciz "?%s in %ld\n" -_err_fmt_bare: .asciz "?%s\n" -_stop_fmt_line: .asciz "Break in %ld\n" -_stop_fmt_bare: .asciz "Break\n" - -_err_syntax: .asciz "Syntax error" -_err_subscript: .asciz "Subscript out of range" -_err_typemismatch: .asciz "Type mismatch" -_err_div0: .asciz "Division by zero" -_err_domain: .asciz "Illegal function call" -_err_overflow: .asciz "Overflow" -_err_dupdef: .asciz "Duplicate definition" -_err_memory: .asciz "Out of memory" -_err_gosub: .asciz "GOSUB stack overflow" -_err_noreturn: .asciz "RETURN without GOSUB" -_err_outofdata: .asciz "Out of DATA" -_err_badfile: .asciz "Bad file number" -_err_badmode: .asciz "Bad file mode" -_err_fieldovf: .asciz "FIELD overflow" -_err_permission: .asciz "Permission denied" -_err_notfound: .asciz "File not found" -_err_alreadyopen: .asciz "File already open" -_err_pastend: .asciz "Input past end of file" -_err_badname: .asciz "Bad file name" -_err_access: .asciz "Path/File access error" -_err_pathnotfound: .asciz "Path not found" - -_err_unprintable: .asciz "Unprintable error" -# RESUME's own failures. Never trapped -- a handler that trapped them would be -# re-entered by its own RESUME, forever. -_err_resnoerr: .asciz "RESUME without error" - -# GW-BASIC's own error numbers, so that a listing's `IF ERR = 53` means what it -# meant in 1983. Pairs of (message, number), terminated by a zero message. -# -# A table rather than a third argument to _rt_error: that argument would have to -# be threaded through thirteen call sites in this tree alone, plus every -# trampoline codegen emits, and a helper here may take only four arguments -# because Win64 passes only four in registers. Errors are not a hot path, so a -# linear scan on the way to exit costs nothing. -# -# Searched by number as well as by message, for the ERROR statement -- so where -# two messages share a number the first one listed is the one ERROR n raises. -.p2align 3 -_err_codes: - .quad _err_syntax, 2 - .quad _err_noreturn, 3 - .quad _err_outofdata, 4 - .quad _err_domain, 5 - .quad _err_overflow, 6 - .quad _err_memory, 7 - .quad _err_gosub, 7 - .quad _err_subscript, 9 - .quad _err_dupdef, 10 - .quad _err_div0, 11 - .quad _err_typemismatch, 13 - .quad _err_fieldovf, 50 - .quad _err_badfile, 52 - .quad _err_notfound, 53 - .quad _err_badmode, 54 - .quad _err_alreadyopen, 55 - .quad _err_pastend, 62 - .quad _err_badname, 64 - .quad _err_permission, 70 - .quad _err_access, 75 - .quad _err_pathnotfound, 76 - .quad 0, 0 - - -# Error-trapping state. Always defined, never conditional: _rt_error is -# assembled into every program and its preamble reads these, so a program with -# no ON ERROR would otherwise fail to link. Zero means "not trapping", which is -# what .bss gives for free. -.bss -.p2align 3 -_err_handler: .skip 8 # which ON ERROR target, numbered from 1; 0 = trapping off -_err_pending: .skip 8 # 1 from a trapped error until its handler runs; - # 2 while procedures unwind toward a RESUME label -_err_active: .skip 8 # nonzero while a handler runs -_err_code: .skip 8 # what ERR returns -_err_line: .skip 8 # the line now running: codegen stores it per statement - # when trapping, else before each call that can fail -_err_erl: .skip 8 # what ERL returns: _err_line as it was when trapped - -.text - -# _rt_err - ERR: the number of the error that was trapped -# -# Arguments: none Returns: eax = error number, 0 if none has been trapped -.globl _rt_err -_rt_err: - mov rax, QWORD PTR [rip + _err_code] - ret - -# _rt_erl - ERL: the line the trapped error happened on -# -# Arguments: none Returns: eax = line number, 0 if none has been trapped -.globl _rt_erl -_rt_erl: - mov rax, QWORD PTR [rip + _err_erl] - ret - -# _rt_error_num - Raise the error with GW-BASIC number `n` (ERROR statement) -# -# Arguments: -# rdi = error number -# rsi = BASIC line number, or 0 when unknown -# -# Returns: only when a handler traps the error, as _rt_error does. -# -# ERR is n itself, not the number the message maps back to: every number the -# table does not list shares "Unprintable error", so looking the message up -# made ERR 0 for all of them, and `ERROR 200 ... IF ERR = 200` -- the GW-BASIC -# way to raise an error of a program's own -- failed silently. -.globl _rt_error_num -_rt_error_num: - mov rdx, rdi # ERR, whatever the message - lea rax, [rip + _err_codes] -.Lnum_scan: - mov rcx, QWORD PTR [rax] # message, or 0 at the end - test rcx, rcx - jz .Lnum_unknown - cmp QWORD PTR [rax + 8], rdx - je .Lnum_found - add rax, 16 - jmp .Lnum_scan -.Lnum_found: - mov rdi, rcx - jmp .Lerror_raise -.Lnum_unknown: - lea rdi, [rip + _err_unprintable] - jmp .Lerror_raise - - -# _rt_error - Report a runtime error and terminate -# Arguments: -# rdi = message pointer (NUL-terminated) -# rsi = BASIC line number, or 0 for the one in _err_line -# -# Returns: only when a handler traps the error, with _err_pending set. -# Otherwise never (exit code 1). -.globl _rt_error -_rt_error: - # ERR is the number this message carries. Unknown text reports 0 rather - # than inventing a code. - lea rcx, [rip + _err_codes] -.Ltrap_scan: - mov rdx, QWORD PTR [rcx] - test rdx, rdx - jz .Ltrap_scan_done # rdx = 0: not listed - cmp rdx, rdi - je .Ltrap_found - add rcx, 16 - jmp .Ltrap_scan -.Ltrap_found: - mov rdx, QWORD PTR [rcx + 8] -.Ltrap_scan_done: - -# The common path, with rdx = the number ERR is to report. -.Lerror_raise: - # An error already on its way to the handler wins. Its helper may carry on - # to the end of what it was doing -- printing the rest of a number to the - # same unopened file, say -- and each step fails the same way; the first - # failure is the one the handler hears about. - cmp QWORD PTR [rip + _err_pending], 0 - jne .Ltrap_return - - # Trapping only when ON ERROR armed one and no handler is already running: - # GW-BASIC does not trap an error raised inside a handler, which is also - # what stops handler -> error -> handler from looping forever. - mov rax, QWORD PTR [rip + _err_handler] - test rax, rax - jz _rt_fatal - cmp QWORD PTR [rip + _err_active], 0 - jne _rt_fatal - - mov QWORD PTR [rip + _err_code], rdx - # Snapshot the line as well. The handler is ordinary module-level code, so - # its own statements overwrite _err_line the moment it starts running -- - # measured: a handler on line 100 reported ERL 100 for an error on line 30. - mov rdx, QWORD PTR [rip + _err_line] - mov QWORD PTR [rip + _err_erl], rdx - - mov QWORD PTR [rip + _err_active], 1 - - # Return to whoever raised it. Generated code tests _err_pending after - # every call that can fail; the statement's fault block then calls the - # handler, on top of whatever faulted, and RESUMEs from what it returns. - # A runtime helper that called this returns first, through its own - # epilogue. Nothing is abandoned, so there is no register state to - # restore. - mov QWORD PTR [rip + _err_pending], 1 -.Ltrap_return: - ret - -# _rt_fatal - Report and exit, without consulting the handler -# -# Today's whole behaviour, and still what happens when nothing is trapping. -# Called directly for the errors that must never be trapped: a handler -# re-entered by its own failing RESUME would never stop. -# -# Arguments: the same as _rt_error. -# Returns: never (exit code 1) -.globl _rt_fatal -_rt_fatal: - push rbp - mov rbp, rsp - push rbx - push r12 # two pushes keep rsp 16-byte aligned for the calls - - # Hold the arguments in callee-saved registers: the fflush below would - # otherwise clobber them, since rcx/rdx/rsi/rdi are all caller-saved. - mov rbx, rdi # message - mov r12, rsi # line number - - # Most helpers are given no line and pass 0, so "?File not found" used to - # print with none. Generated code stores the line in _err_line before - # every call that can fail, so that is the line this error happened on. - test r12, r12 - jnz .Lerr_have_line - mov r12, QWORD PTR [rip + _err_line] -.Lerr_have_line: - - # Flush stdout first, so output written before the error is not lost when - # the process exits. - xor edi, edi - call fflush - - mov rdi, QWORD PTR [rip + stderr] - mov rdx, rbx # message -> 3rd arg - test r12, r12 - jz .Lerr_bare - lea rsi, [rip + _err_fmt_line] - mov rcx, r12 # line -> 4th arg - xor eax, eax - call fprintf - jmp .Lerr_exit -.Lerr_bare: - lea rsi, [rip + _err_fmt_bare] - xor eax, eax - call fprintf - -.Lerr_exit: - mov edi, 1 - call exit - ud2 # exit does not return - -# _rt_stop - STOP: say where, and end the program -# -# GW-BASIC prints "Break in 20" and returns to its prompt; a compiled program -# has no prompt, so it ends -- normally, as END does. The message goes to -# stderr, after stdout is flushed, so the program's own output is untouched. -# STOP used to be a silent END. -# -# Arguments: rdi = BASIC line number, or 0 when unknown -# Returns: never (exit code 0) -.globl _rt_stop -_rt_stop: - push rbp - mov rbp, rsp - push rbx - sub rsp, 8 # keeps rsp 16-byte aligned for the calls - mov rbx, rdi # line number - xor edi, edi - call fflush - mov rdi, QWORD PTR [rip + stderr] - test rbx, rbx - jz .Lstop_bare - lea rsi, [rip + _stop_fmt_line] - mov rdx, rbx - xor eax, eax - call fprintf - jmp .Lstop_end -.Lstop_bare: - lea rsi, [rip + _stop_fmt_bare] - xor eax, eax - call fprintf -.Lstop_end: - add rsp, 8 - pop rbx - leave - jmp _rt_end diff --git a/src/runtime/sysv/file.s b/src/runtime/sysv/file.s deleted file mode 100644 index 9a7c77f..0000000 --- a/src/runtime/sysv/file.s +++ /dev/null @@ -1,2122 +0,0 @@ -# BASIC Runtime: File I/O Functions -# -# File input/output functions implementing BASIC's OPEN, CLOSE, PRINT#, INPUT# -# statements. Uses libc file operations (fopen, fclose, fprintf, fscanf, fgets). -# -# BASIC File I/O Model: -# Files are referenced by number (1-15). The OPEN statement associates a -# filename with a file number, and subsequent I/O uses that number: -# -# OPEN "data.txt" FOR OUTPUT AS #1 -# PRINT #1, "Hello" -# CLOSE #1 -# -# File Handle Table: -# _file_handles is an array of 16 FILE* pointers (128 bytes). -# Index 0 is unused (BASIC file numbers start at 1). -# Handles 1-15 are available for user files. -# -# File Modes: -# 0 = INPUT - read existing file (fopen "r") -# 1 = OUTPUT - create/truncate file (fopen "w") -# 2 = APPEND - append to file (fopen "a") -# -# String Handling: -# BASIC strings are (ptr, len) pairs but libc expects null-terminated strings. -# For filenames, we copy to _file_name_buf and null-terminate. -# For string output, we use fprintf with "%.*s" (precision = length). -# For string input, fgets reads into _file_input_buf. -# -# Error Handling: -# A failed OPEN raises GW-BASIC's error for the cause (53, 64, 70, 75, 76). -# _file_mode records how each number was opened, so PRINT # to a file -# opened FOR INPUT, or INPUT # from one opened for writing, is "Bad file -# mode" (54) rather than a write libc quietly refuses. - -# Data Section: File handle table and buffers -.data -# Mode strings for fopen() -_mode_read: .asciz "r" # FOR INPUT -_mode_write: .asciz "w" # FOR OUTPUT -_mode_append: .asciz "a" # FOR APPEND - -# Format strings for fprintf/fscanf (same as console I/O) -_file_fmt_str: .asciz "%.*s" # String with precision (ptr, len) -_file_fmt_int: .asciz "%ld" # Long integer -_file_fmt_float: .asciz "%g" # Floating point (compact) -_file_fmt_char: .asciz "%c" # Single character -_file_fmt_newline: .asciz "\n" # Newline -_file_fmt_input: .asciz "%lf" # Read double - -# Longest INPUT # field kept, leaving room for the NUL in _file_input_buf. -.equ MAX_FIELD_LEN, 1023 - -# Zero-filled scratch, so .bss rather than .data -- see data_defs.s. The -# .text below restores the section for the code that follows; a .bss left -# open at the end of this file would swallow the next runtime part. -.bss -# The handle table is indexed as quadwords (`[rcx + rbx*8]`), so it needs -# stated alignment: in .data it inherited whatever offset the preceding -# strings happened to leave, which is not something to rely on. -.p2align 3 -# File handle table: FILE* pointers indexed by BASIC file number (1-15) -# Index 0 unused, indices 1-15 for BASIC files #1-#15 -_file_handles: .skip 128 # 16 * 8 bytes = 16 FILE* pointers -# How each number was opened: 0 INPUT, 1 OUTPUT, 2 APPEND, 3 RANDOM. -_file_mode: .skip 128 -# WIDTH: the line length output wraps at, per file number; 0 = no limit. -_file_width: .skip 128 - -# Temp buffer for null-terminated filename (BASIC strings aren't null-terminated) -_file_name_buf: .skip 1024 - -# Buffer for string input from files -_file_input_buf: .skip 1024 - -.text - -# _rt_file_open - Open a file (OPEN statement) -# Associates a filename with a file number for subsequent I/O. -# -# Arguments: -# rdi = filename pointer (BASIC string, not null-terminated) -# rsi = filename length -# rdx = mode: 0=INPUT, 1=OUTPUT, 2=APPEND -# rcx = file number (1-15) -# -# Returns: nothing (FILE* stored in _file_handles[file_number]) -# -# Implementation: -# 1. Copy filename to _file_name_buf and null-terminate -# 2. Select mode string based on mode argument -# 3. Call fopen(filename, mode) -# 4. Store resulting FILE* in handle table -.globl _rt_file_open -_rt_file_open: - push rbp - mov rbp, rsp - push rbx - push r12 - push r13 - push r14 - - # Save arguments in callee-saved registers - mov r12, rdi # filename ptr - mov r13, rsi # filename len - mov r14d, edx # mode (0/1/2) - mov ebx, ecx # file number - - # A number that is still open must be CLOSEd first. Rebinding it used to - # succeed silently, leaking the old FILE* and losing whatever was buffered - # in it. - lea rax, [rip + _file_handles] - mov rax, [rax + rbx*8] - test rax, rax - jz .Lopen_free - call .Lopen_already - jmp .Lopen_done -.Lopen_free: - test r13, r13 - jnz .Lopen_named - call .Lopen_badname # "" names no file - jmp .Lopen_done -.Lopen_named: - - # Copy filename to buffer and null-terminate - # memcpy(_file_name_buf, filename_ptr, filename_len) - lea rdi, [rip + _file_name_buf] - mov rsi, r12 - mov rdx, r13 - call memcpy - # Null-terminate - lea rax, [rip + _file_name_buf] - mov BYTE PTR [rax + r13], 0 - - # Select mode string based on mode argument - cmp r14d, 0 - je .Lmode_read - cmp r14d, 1 - je .Lmode_write - # else: append - lea rsi, [rip + _mode_append] - jmp .Ldo_fopen -.Lmode_read: - lea rsi, [rip + _mode_read] - jmp .Ldo_fopen -.Lmode_write: - lea rsi, [rip + _mode_write] - -.Ldo_fopen: - # fopen(filename, mode) - lea rdi, [rip + _file_name_buf] - call fopen # returns FILE* in rax (or NULL on error) - - # A failed open used to be stored anyway, so the program carried on with a - # NULL handle: OPEN of a missing file "succeeded", EOF() answered -1, and - # every later use was a crash or silence. - test rax, rax - jnz .Lopen_ok - mov edi, r14d - call .Lopen_failed - jmp .Lopen_done -.Lopen_ok: - - # A directory opens for reading -- only the first read fails, with - # EISDIR -- so OPEN "." FOR INPUT used to succeed, EOF() answered -1 at - # once, and INPUT # said "Input past end of file", naming the wrong - # problem. It is "Path/File access error" (75), as opening one for writing - # already is: those modes fail in fopen itself, so only INPUT is checked. - test r14d, r14d - jnz .Lopen_store - mov r12, rax # the FILE*; the name is not needed any more - sub rsp, 144 # struct stat, which is 144 bytes on x86-64 Linux - mov rdi, rax - call fileno - # fstat(fd, buf), through syscall(2): glibc exports an fstat symbol only - # from 2.33, and linking against one would fail on every older system. - # 5 is SYS_fstat on x86-64 Linux. - mov esi, eax - mov edi, 5 - mov rdx, rsp - call syscall - mov ecx, DWORD PTR [rsp + 24] # st_mode - add rsp, 144 - test eax, eax - jnz .Lopen_not_dir # fstat failed: nothing is known, so carry on - and ecx, 0xF000 # S_IFMT - cmp ecx, 0x4000 # S_IFDIR - jne .Lopen_not_dir - mov rdi, r12 - call fclose - lea rdi, [rip + _err_access] - xor esi, esi - call _rt_error # returns only when trapped - jmp .Lopen_done -.Lopen_not_dir: - mov rax, r12 -.Lopen_store: - - # Store FILE* in handle table: _file_handles[file_number] = rax - lea rcx, [rip + _file_handles] - mov [rcx + rbx*8], rax - lea rcx, [rip + _file_mode] - mov [rcx + rbx*8], r14 - lea rcx, [rip + _file_width] - mov QWORD PTR [rcx + rbx*8], 0 # a new file has no WIDTH - - # A record buffer left by an earlier OPEN ... FOR RANDOM on this number - # would make GET and PUT think this file is a random one. - lea rcx, [rip + _file_recbuf] - mov rdi, [rcx + rbx*8] - test rdi, rdi - jz .Lopen_no_recbuf - mov QWORD PTR [rcx + rbx*8], 0 - call free -.Lopen_no_recbuf: - - # A new file starts at column 1, whatever the last one on this number - # left behind. - lea rcx, [rip + _file_col] - mov QWORD PTR [rcx + rbx*8], 0 - -.Lopen_done: - pop r14 - pop r13 - pop r12 - pop rbx - leave - ret - -# _rt_file_close - Close a file (CLOSE statement) -# Closes the file associated with a file number and clears its handle. -# -# Arguments: -# rdi = file number (1-15) -# -# Returns: nothing -.globl _rt_file_close -_rt_file_close: - push rbp - mov rbp, rsp - push rbx - sub rsp, 8 # Alignment - - mov ebx, edi # save file number - - # Get FILE* from handle table - lea rax, [rip + _file_handles] - mov rdi, [rax + rbx*8] # rdi = FILE* - test rdi, rdi # Check for NULL (already closed or never opened) - jz .Lclose_done - - # Flush before close - call fflush - - # Close file - lea rax, [rip + _file_handles] - mov rdi, [rax + rbx*8] # rdi = FILE* - call fclose - - # Clear handle from table - lea rax, [rip + _file_handles] - mov QWORD PTR [rax + rbx*8], 0 - -.Lclose_done: - add rsp, 8 - pop rbx - leave - ret - -# _rt_file_print_string - Write string to file (PRINT# with string) -# Arguments: -# rdi = file number -# rsi = string pointer -# rdx = string length -# -# Returns: nothing -# -# Under a WIDTH, the text is cut where the line ends and continued on the next, -# as GW-BASIC wraps it. The break is taken lazily, just before a character that -# would not fit, so text that exactly fills a line is followed by one newline, -# not two. -.globl _rt_file_print_string -_rt_file_print_string: - push rbp - mov rbp, rsp - push rbx - push r12 - push r13 - push r14 - - # An unassigned string is (NULL, 0); writing nothing is correct and avoids - # passing NULL to fprintf. - test rdx, rdx - jz .Lfile_print_str_done - - mov ebx, edi # file number - mov r12, rdx # characters still to write - mov r13, rsi # where they start - - lea rax, [rip + _file_handles] - cmp QWORD PTR [rax + rbx*8], 0 - jne .Lfile_print_str_open - call .Lfile_not_open # a number nobody OPENed is NULL here - jmp .Lfile_print_str_done -.Lfile_print_str_open: - call .Lfile_check_writable - jc .Lfile_print_str_done - -.Lfile_print_str_chunk: - mov r14, r12 # this piece: all of what is left ... - lea rax, [rip + _file_width] - mov rcx, QWORD PTR [rax + rbx*8] - test rcx, rcx - jz .Lfile_print_str_write - lea rax, [rip + _file_col] - sub rcx, QWORD PTR [rax + rbx*8] # ... or the room left on the line - jg .Lfile_print_str_room - mov edi, ebx - call _rt_file_print_newline # none: start the next line - lea rax, [rip + _file_width] - mov rcx, QWORD PTR [rax + rbx*8] -.Lfile_print_str_room: - cmp r14, rcx - jbe .Lfile_print_str_write - mov r14, rcx -.Lfile_print_str_write: - # fprintf(file, "%.*s", len, ptr) - lea rax, [rip + _file_handles] - mov rdi, QWORD PTR [rax + rbx*8] - lea rsi, [rip + _file_fmt_str] - mov rdx, r14 - mov rcx, r13 - xor eax, eax # no vector args - call fprintf - - lea rax, [rip + _file_col] - add QWORD PTR [rax + rbx*8], r14 - add r13, r14 - sub r12, r14 - jnz .Lfile_print_str_chunk - -.Lfile_print_str_done: - pop r14 - pop r13 - pop r12 - pop rbx - leave - ret - -# _rt_file_print_float - Write number to file (PRINT# with number) -# Prints whole numbers as integers for clean output. -# -# Arguments: -# rdi = file number -# xmm0 = value to write (double) -# -# Returns: nothing -.globl _rt_file_print_float -_rt_file_print_float: - push rbp - mov rbp, rsp - push rbx - sub rsp, 8 - - mov ebx, edi # save file number - - # Format through the shared helper, so every sink renders a number the - # same way. - xor edi, edi # a DOUBLE - call _rt_fmt_double - jmp .Lfile_num_emit - -# _rt_file_print_single - Write a SINGLE -# A SINGLE carries only ~7 significant digits, so it uses a table starting at a -# shorter format and compares at 32-bit precision. Otherwise 3.14159! would -# print as 3.1415901184082: at 15 digits even a float's value round-trips. -# -# Shares the emit tail below with _rt_file_print_float, whose prologue is -# identical. -# -# Arguments: -# rdi = file number -# xmm0 = value, already widened to double -# -# Returns: nothing -.globl _rt_file_print_single -_rt_file_print_single: - push rbp - mov rbp, rsp - push rbx - sub rsp, 8 - - mov ebx, edi # save file number - - mov edi, 1 # a SINGLE - call _rt_fmt_double - -.Lfile_num_emit: - # rax = length of the text _rt_fmt_double left in _num_buf. - mov rdx, rax - lea rsi, [rip + _num_buf] - mov edi, ebx - call _rt_file_print_string - - add rsp, 8 - pop rbx - leave - ret - -# _rt_print_number - PRINT a DOUBLE, with the spacing PRINT gives a number -# -# A blank where the sign would go, and a blank after. WRITE renders numbers -# through _rt_file_print_float instead, because WRITE pads nothing. -# -# Arguments: rdi = file number, xmm0 = value -# Returns: nothing -.globl _rt_print_number -_rt_print_number: - push rbp - mov rbp, rsp - push rbx - sub rsp, 8 - - mov ebx, edi - xor edi, edi # a DOUBLE - call _rt_fmt_basic - jmp .Lprint_num_emit - -# _rt_print_number_single - The same for a SINGLE, whose shorter digit table -# is the reason PRINT keeps two entry points at all. -# -# Arguments: rdi = file number, xmm0 = value already widened to double -# Returns: nothing -.globl _rt_print_number_single -_rt_print_number_single: - push rbp - mov rbp, rsp - push rbx - sub rsp, 8 - - mov ebx, edi - mov edi, 1 # a SINGLE - call _rt_fmt_basic - -.Lprint_num_emit: - lea rsi, [rip + _num_buf] - mov BYTE PTR [rsi + rax], 32 # the trailing blank - inc rax - mov QWORD PTR [rbp - 16], rax # the length, across the call below - - # Under a WIDTH, a number that does not fit on the rest of the line starts - # the next one, as in GW-BASIC, rather than being split. - lea rcx, [rip + _file_width] - mov rcx, QWORD PTR [rcx + rbx*8] - test rcx, rcx - jz .Lprint_num_write - lea rdx, [rip + _file_col] - mov rdx, QWORD PTR [rdx + rbx*8] - test rdx, rdx - jz .Lprint_num_write # already at the start of a line - add rdx, rax - cmp rdx, rcx - jbe .Lprint_num_write - mov edi, ebx - call _rt_file_print_newline -.Lprint_num_write: - lea rsi, [rip + _num_buf] - mov rdx, QWORD PTR [rbp - 16] - mov edi, ebx - call _rt_file_print_string - - add rsp, 8 - pop rbx - leave - ret - -# PRINT lays a line out in zones this wide; a comma moves to the next one. -.equ PRINT_ZONE, 14 - -# _rt_print_zone - PRINT's comma: move to the start of the next print zone -# -# GW-BASIC lays a line out in 14-column zones and a comma moves to the next -# one, padding with blanks. This used to emit a literal tab, which is whatever -# width the terminal says and lines nothing up. -# -# Built on _rt_file_print_tab, which already pads to a column and starts a new -# line when the cursor is past it -- which is also what a comma does past the -# last zone. -# -# Arguments: rdi = file number -# Returns: nothing -.globl _rt_print_zone -_rt_print_zone: - push rbp - mov rbp, rsp - push rbx - sub rsp, 8 - - mov ebx, edi - lea rax, [rip + _file_col] - mov rax, QWORD PTR [rax + rbx*8] # characters already on this line - xor edx, edx - mov rcx, PRINT_ZONE - div rcx - inc rax - imul rax, rax, PRINT_ZONE # first column of the next zone, 0-based - - # Under a WIDTH, a zone that would not fit whole on the line means the - # next line, as in GW-BASIC. - lea rcx, [rip + _file_width] - mov rcx, QWORD PTR [rcx + rbx*8] - test rcx, rcx - jz .Lprint_zone_fits - lea rdx, [rax + PRINT_ZONE] - cmp rdx, rcx - jbe .Lprint_zone_fits - mov edi, ebx - call _rt_file_print_newline - jmp .Lprint_zone_done -.Lprint_zone_fits: - inc rax # _rt_file_print_tab counts from 1 - mov rsi, rax - mov edi, ebx - call _rt_file_print_tab - -.Lprint_zone_done: - add rsp, 8 - pop rbx - leave - ret - -# _rt_con_string - Write a string to the console -# The console is file handle 0. This exists for the runtime's own messages and -# for PRINT USING, which has no file form; generated code passes a handle like -# any other caller. -# -# Arguments: -# rdi = string pointer -# rsi = string length -# -# Returns: nothing -.globl _rt_con_string -_rt_con_string: - mov rdx, rsi # length -> 3rd arg - mov rsi, rdi # pointer -> 2nd arg - xor edi, edi # console -> 1st arg - jmp _rt_file_print_string - -# _rt_file_print_spc - SPC(n): write n spaces -# Arguments: -# rdi = file number -# rsi = count -# -# Returns: nothing -.globl _rt_file_print_spc -_rt_file_print_spc: - push rbp - mov rbp, rsp - push rbx - push r12 - - mov ebx, edi # file number - mov r12, rsi # count remaining -.Lfile_spc_loop: - cmp r12, 0 - jle .Lfile_spc_done - mov edi, ebx - mov esi, ' ' - call _rt_file_print_char - dec r12 - jmp .Lfile_spc_loop -.Lfile_spc_done: - pop r12 - pop rbx - leave - ret - -# _rt_file_print_tab - TAB(n): advance to column n -# Columns are 1-based, as in GW-BASIC. If the sink is already at or past the -# requested column, a newline is written first and the tab applies to the new -# line. -# -# Arguments: -# rdi = file number -# rsi = target column -# -# Returns: nothing -.globl _rt_file_print_tab -_rt_file_print_tab: - push rbp - mov rbp, rsp - push rbx - push r12 - - mov ebx, edi # file number - mov r12, rsi # target column - cmp r12, 1 - jge .Lfile_tab_have_target - mov r12, 1 -.Lfile_tab_have_target: - dec r12 # 1-based column -> count of characters before it - - lea rax, [rip + _file_col] - cmp r12, QWORD PTR [rax + rbx*8] - jge .Lfile_tab_pad - mov edi, ebx - call _rt_file_print_newline - -.Lfile_tab_pad: - lea rax, [rip + _file_col] - mov rsi, r12 - sub rsi, QWORD PTR [rax + rbx*8] - mov edi, ebx - call _rt_file_print_spc - - pop r12 - pop rbx - leave - ret - -# _rt_file_print_char - Write single character to file -# Arguments: -# rdi = file number -# rsi = character code -# -# Returns: nothing -.globl _rt_file_print_char -_rt_file_print_char: - push rbp - mov rbp, rsp - push rbx - push r12 - - mov ebx, edi # save file number - mov r12d, esi # save char - - lea rax, [rip + _file_handles] - mov rdi, [rax + rbx*8] # FILE* - test rdi, rdi - jnz .Lfile_char_open - call .Lfile_not_open # a number nobody OPENed is NULL here - jmp .Lfile_char_done -.Lfile_char_open: - call .Lfile_check_writable - jc .Lfile_char_done - - # Under a WIDTH, a full line wraps before the character, as in - # _rt_file_print_string. - lea rax, [rip + _file_width] - mov rcx, QWORD PTR [rax + rbx*8] - test rcx, rcx - jz .Lfile_char_write - lea rax, [rip + _file_col] - cmp QWORD PTR [rax + rbx*8], rcx - jb .Lfile_char_write - mov edi, ebx - call _rt_file_print_newline -.Lfile_char_write: - lea rax, [rip + _file_handles] - mov rdi, QWORD PTR [rax + rbx*8] - lea rsi, [rip + _file_fmt_char] - mov rdx, r12 # char - xor eax, eax - call fprintf - - lea rax, [rip + _file_col] - inc QWORD PTR [rax + rbx*8] - -.Lfile_char_done: - pop r12 - pop rbx - leave - ret - -# _rt_file_print_newline - Write newline to file -# Called at end of PRINT# statement unless suppressed with ; or , -# -# Arguments: -# rdi = file number -# -# Returns: nothing -.globl _rt_file_print_newline -_rt_file_print_newline: - push rbp - mov rbp, rsp - push rbx - sub rsp, 8 # align stack - - mov ebx, edi # save file number - - # Use fputc('\n', file) - simpler than fprintf - lea rax, [rip + _file_handles] - mov rsi, [rax + rbx*8] # FILE* → rsi (2nd arg) - test rsi, rsi - jnz .Lfile_newline_open - call .Lfile_not_open # a number nobody OPENed is NULL here - jmp .Lfile_newline_done -.Lfile_newline_open: - call .Lfile_check_writable - jc .Lfile_newline_done - mov edi, 10 # '\n' → edi (1st arg) - call fputc - - lea rax, [rip + _file_col] - mov QWORD PTR [rax + rbx*8], 0 - -.Lfile_newline_done: - add rsp, 8 - pop rbx - leave - ret - - -# _rt_file_getc - Read one byte -# Arguments: rdi = file number -# Returns: eax = the byte, or -1 at end of file or on a file that is not open -.globl _rt_file_getc -_rt_file_getc: - push rbp - mov rbp, rsp - - lea rax, [rip + _file_handles] - mov rdi, [rax + rdi*8] - test rdi, rdi - jz .Lfile_getc_eof - call fgetc - leave - ret -.Lfile_getc_eof: - mov eax, -1 - leave - ret - -# _rt_file_read_field - Read one INPUT # field -# INPUT # reads comma-delimited fields, not whole lines. Reading a line per -# variable made `INPUT #1, A, B` on "10,20" yield 10 twice, and reading through -# fscanf("%lf") was worse: it stopped at the comma without consuming it, so -# every later read failed on the same character. -# -# Leading blanks and line breaks are skipped. A field either is quoted, in -# which case it runs to the closing quote and everything up to the next -# delimiter is discarded, or runs to the next comma, newline or end of file -# with trailing blanks trimmed. The delimiter is consumed. -# -# An unquoted field read for a number also ends at a blank, as GW-BASIC's -# INPUT # does: `PRINT #1, 1; 2; 3` writes " 1 2 3 " on one line, and that is -# three numbers. Running to the comma, with the blanks inside left for -# _rt_scan_number to skip as VAL does, read it as 123 and the next INPUT # -# found nothing left. The blanks after such a number are separators, and so is -# a comma or line break that follows them, so " 1 , 2" is still two numbers; -# anything else is the start of the next field, and is put back. -# -# Arguments: -# rdi = file number -# esi = 1 for a numeric item, 0 for a string -# -# Returns: -# rax = pointer to the field (in _file_input_buf), rdx = its length -# -# Note: uses a static buffer, so the result is valid only until the next read. -.globl _rt_file_read_field -_rt_file_read_field: - push rbp - mov rbp, rsp - push rbx - push r12 - push r13 - push r14 - - mov ebx, edi # file number, reloaded before every read - xor r12d, r12d # length written so far - mov r14d, esi # numeric item - - # INPUT # needs a file that is open, and open for reading. _rt_file_getc - # answers end-of-file for one that is not, so this read an empty field. - lea rax, [rip + _file_handles] - cmp QWORD PTR [rax + rbx*8], 0 - jne .Lfield_open - call .Lfile_not_open - jmp .Lfield_done -.Lfield_open: - call .Lfile_check_readable - jc .Lfield_done - - # Skip leading blanks, tabs and line breaks. -.Lfield_skip: - mov edi, ebx - call _rt_file_getc - cmp eax, -1 - je .Lfield_past_end - cmp eax, ' ' - je .Lfield_skip - cmp eax, 9 # tab - je .Lfield_skip - cmp eax, 13 # CR - je .Lfield_skip - cmp eax, 10 # LF - je .Lfield_skip - - # A comma here ends an empty field: "10,,20" is three fields, the - # middle one 0 or "". Taken as the field's first character, it ran the - # rest of the line into this field and left the next one nothing. - cmp eax, ',' - je .Lfield_done - cmp eax, '"' - je .Lfield_quoted - - # Unquoted: this character and everything up to the delimiter. - mov r13d, eax -.Lfield_plain_store: - cmp r12d, MAX_FIELD_LEN - jge .Lfield_plain_next - lea rax, [rip + _file_input_buf] - mov BYTE PTR [rax + r12], r13b - inc r12d -.Lfield_plain_next: - mov edi, ebx - call _rt_file_getc - cmp eax, -1 - je .Lfield_trim - cmp eax, ',' - je .Lfield_trim - cmp eax, 10 - je .Lfield_trim - test r14d, r14d - jnz .Lfield_num_char - cmp eax, 13 - je .Lfield_plain_next - mov r13d, eax - jmp .Lfield_plain_store - -.Lfield_num_char: - cmp eax, ' ' - je .Lfield_num_blanks - cmp eax, 9 # tab - je .Lfield_num_blanks - cmp eax, 13 - je .Lfield_num_cr - mov r13d, eax - jmp .Lfield_plain_store - -.Lfield_num_blanks: - # The number has ended at a blank. More blanks, then a comma or a line - # break, all belong to this field's delimiter. - mov edi, ebx - call _rt_file_getc - cmp eax, ' ' - je .Lfield_num_blanks - cmp eax, 9 - je .Lfield_num_blanks - cmp eax, -1 - je .Lfield_done - cmp eax, ',' - je .Lfield_done - cmp eax, 10 - je .Lfield_done - cmp eax, 13 - je .Lfield_num_cr - jmp .Lfield_unread - -.Lfield_num_cr: - # A CR ends the number, and the LF of a CRLF goes with it: left behind, it - # would be an empty line to a LINE INPUT # that follows. - mov edi, ebx - call _rt_file_getc - cmp eax, -1 - je .Lfield_done - cmp eax, 10 - je .Lfield_done - -.Lfield_unread: - # Not a separator: the next field starts here. - mov edi, eax - lea rax, [rip + _file_handles] - mov rsi, [rax + rbx*8] - call ungetc - jmp .Lfield_done - -.Lfield_trim: - # Drop trailing blanks, which are separators rather than data. - test r12d, r12d - jz .Lfield_done - lea rax, [rip + _file_input_buf] - movzx ecx, BYTE PTR [rax + r12 - 1] - cmp ecx, ' ' - je .Lfield_trim_one - cmp ecx, 9 - jne .Lfield_done -.Lfield_trim_one: - dec r12d - jmp .Lfield_trim - -.Lfield_quoted: - mov edi, ebx - call _rt_file_getc - cmp eax, -1 - je .Lfield_done - cmp eax, '"' - je .Lfield_after_quote - cmp r12d, MAX_FIELD_LEN - jge .Lfield_quoted - mov r13d, eax - lea rax, [rip + _file_input_buf] - mov BYTE PTR [rax + r12], r13b - inc r12d - jmp .Lfield_quoted - -.Lfield_after_quote: - # Discard whatever separates the closing quote from the delimiter. - mov edi, ebx - call _rt_file_getc - cmp eax, -1 - je .Lfield_done - cmp eax, ',' - je .Lfield_done - cmp eax, 10 - je .Lfield_done - jmp .Lfield_after_quote - -.Lfield_past_end: - # No field left before the end of the file: GW-BASIC's "Input past end - # of file" (62). This used to read an empty field, so a loop that forgot - # EOF() read zeros forever. - call .Lfile_past_end -.Lfield_done: - lea rax, [rip + _file_input_buf] - mov BYTE PTR [rax + r12], 0 - mov rdx, r12 - - pop r14 - pop r13 - pop r12 - pop rbx - leave - ret - -# _rt_file_input_number - INPUT #: read one numeric field -# -# The field is read as VAL reads a string (_rt_scan_number): text that is not -# a number is 0, and one too large for a DOUBLE is Overflow. It used to go to -# strtod, which took "inf", "nan" and "0x1F" and knew no D or &H. -# -# Arguments: -# rdi = file number -# -# Returns: -# xmm0 = value read -.globl _rt_file_input_number -_rt_file_input_number: - push rbp - mov rbp, rsp - - mov esi, 1 # a number ends at a blank - call _rt_file_read_field - mov rdi, rax - mov rsi, rdx - call _rt_scan_number - test edx, edx - jz .Lfile_input_number_done - lea rdi, [rip + _err_overflow] - xor esi, esi - call _rt_error # returns only when trapped - xorpd xmm0, xmm0 -.Lfile_input_number_done: - leave - ret - -# _rt_file_input_string - INPUT #: read one string field -# Arguments: rdi = file number -# Returns: rax = pointer, rdx = length -.globl _rt_file_input_string -_rt_file_input_string: - xor esi, esi # a string runs to its comma - jmp _rt_file_read_field - -# _rt_file_line_input - LINE INPUT #: read a whole line -# Reads a line from file, stripping the trailing newline. -# -# Arguments: -# rdi = file number -# -# Returns: -# rax = pointer to string data (_file_input_buf) -# rdx = string length -# -# Note: Uses static buffer - result only valid until next file string read. -.globl _rt_file_line_input -_rt_file_line_input: - push rbp - mov rbp, rsp - push rbx - sub rsp, 8 # align stack - - mov ebx, edi # save file number - - # fgets(buffer, size, file) - lea rdi, [rip + _file_input_buf] # buffer - mov rsi, 1023 # max chars (leave room for null) - lea rax, [rip + _file_handles] - mov rdx, [rax + rbx*8] # FILE* - test rdx, rdx - jnz .Lline_input_open - call .Lfile_not_open # a number nobody OPENed is NULL here - jmp .Lfile_input_string_empty -.Lline_input_open: - call .Lfile_check_readable - jc .Lfile_input_string_empty - lea rdi, [rip + _file_input_buf] # the check clobbered the arguments - mov rsi, 1023 - lea rax, [rip + _file_handles] - mov rdx, [rax + rbx*8] - call fgets - - # A read past the end used to answer with an empty string, so a loop - # missing its EOF() test ran on quietly forever instead of saying what was - # wrong. GW-BASIC calls this "Input past end of file". - test rax, rax - jnz .Lline_input_read - call .Lfile_past_end - jmp .Lfile_input_string_empty -.Lline_input_read: - - # Calculate length using strlen - lea rdi, [rip + _file_input_buf] - call strlen - mov rdx, rax # length → rdx - - # Strip the trailing newline, and the CR before it in a file written on a - # platform that uses CRLF. Dropping only the LF handed every line back with - # a stray CR, which then showed up in every comparison and every LEN. - test rdx, rdx - jz .Lfile_input_string_done - lea rax, [rip + _file_input_buf] - mov cl, BYTE PTR [rax + rdx - 1] # last character - cmp cl, 10 # newline? - jne .Lfile_input_string_done - dec rdx # reduce length - mov BYTE PTR [rax + rdx], 0 # remove newline - - test rdx, rdx - jz .Lfile_input_string_done - mov cl, BYTE PTR [rax + rdx - 1] - cmp cl, 13 # carriage return? - jne .Lfile_input_string_done - dec rdx - mov BYTE PTR [rax + rdx], 0 - -.Lfile_input_string_done: - lea rax, [rip + _file_input_buf] - add rsp, 8 - pop rbx - leave - ret - -.Lfile_input_string_empty: - # EOF or error - return empty string - lea rax, [rip + _file_input_buf] - mov BYTE PTR [rax], 0 # empty string - xor edx, edx # length = 0 - add rsp, 8 - pop rbx - leave - ret - -# _rt_file_close_all - Close every open file (bare CLOSE) -# Arguments: none -# Returns: nothing -.globl _rt_file_close_all -_rt_file_close_all: - push rbp - mov rbp, rsp - push rbx - sub rsp, 8 - - mov ebx, 1 # BASIC file numbers start at 1 -.Lclose_all_loop: - cmp ebx, 15 - jg .Lclose_all_done - lea rax, [rip + _file_handles] - mov rdi, [rax + rbx*8] - test rdi, rdi - jz .Lclose_all_next - call fflush - lea rax, [rip + _file_handles] - mov rdi, [rax + rbx*8] - call fclose - lea rax, [rip + _file_handles] - mov QWORD PTR [rax + rbx*8], 0 -.Lclose_all_next: - inc ebx - jmp .Lclose_all_loop -.Lclose_all_done: - add rsp, 8 - pop rbx - leave - ret - -# _rt_file_eof - EOF(n): has the file been read to the end? -# Peeks one character and pushes it back, since feof() only reports end-of-file -# after a read has already failed, which would make EOF() lag by one line. -# -# Arguments: -# rdi = file number -# -# Returns: -# eax = -1 at end of file, 0 otherwise (BASIC's true/false, as a LONG) -.globl _rt_file_eof -_rt_file_eof: - push rbp - mov rbp, rsp - push rbx - sub rsp, 8 - - mov ebx, edi - lea rax, [rip + _file_handles] - mov rdi, [rax + rbx*8] - test rdi, rdi - jz .Leof_true # never opened: treat as at end - - call fgetc - cmp eax, -1 - je .Leof_true - - # Push the character back so the next read still sees it. - mov edi, eax - lea rax, [rip + _file_handles] - mov rsi, [rax + rbx*8] - call ungetc - xor eax, eax # 0 = false - jmp .Leof_done - -.Leof_true: - mov eax, -1 # BASIC true - -.Leof_done: - add rsp, 8 - pop rbx - leave - ret - -# --------------------------------------------------------------------------- -# Random-access files -# -# A file opened FOR RANDOM carries three things beyond its handle: a record -# length, a record buffer of that length, and a cursor saying how much of the -# buffer FIELD has handed out so far. -# -# FIELD does not copy anything. It hands each variable the (pointer, length) -# pair naming its slice of that buffer, and a BASIC string is exactly such a -# pair, so the variable *is* a window onto the buffer. GET overwrites the -# buffer and every field variable sees the new record at once; LSET and RSET -# write through the window, so PUT emits what they wrote. This is why LSET -# exists at all: plain assignment would allocate a fresh string and the -# variable would quietly stop tracking the record. -# -# Strings are never freed in this runtime, so a variable outliving its file is -# a dangling read at worst, never a double free. -.data -_mode_update: .asciz "r+b" # open an existing file for reading and writing -_mode_create: .asciz "w+b" # ... or create it when it does not exist - -# Largest record GW-BASIC allows. -.equ MAX_RECLEN, 32767 - -.bss -# All four tables are indexed as quadwords, and each is a multiple of 8, so -# aligning the first aligns them all. -.p2align 3 -_file_recbuf: .skip 128 # record buffer per file number (malloc'd) -_file_reclen: .skip 128 # record length per file number -_file_recnum: .skip 128 # last record read or written, 1-based; 0 = none -_file_fieldoff: .skip 128 # bytes of the buffer FIELD has assigned so far - -# MKI$/MKL$/MKS$/MKD$ assemble their bytes here, then return a heap copy; the -# buffer itself is never handed out. Written a quadword at a time, so it is -# aligned deliberately rather than by accident of what precedes it. -.p2align 3 -_mk_buf: .skip 16 - -.text - -# _rt_file_open_random - OPEN ... FOR RANDOM AS #n LEN = r -# -# Four arguments, not five: there is no mode byte, because reaching this entry -# point *is* the mode. Win64 passes only four arguments in registers, and the -# Win64 twin of this function has to match, so the mode was the one to drop. -# -# Arguments: -# rdi = filename pointer, rsi = filename length -# rdx = file number, rcx = record length, 1 to 32767 -# -# Returns: nothing -.globl _rt_file_open_random -_rt_file_open_random: - push rbp - mov rbp, rsp - push rbx - push r12 - push r13 - push r14 - - mov r12, rdi # filename ptr - mov r13, rsi # filename len - mov ebx, edx # file number - mov r14, rcx # record length - - # A record length outside 1..MAX_RECLEN is an Illegal function call, as in - # GW-BASIC, refused before anything is created. It used to be fixed up - # silently -- 40000 cut to 32767, 0 or less made 128 -- so a program that - # computed its length wrongly ran on with records it never asked for. A - # missing LEN clause is not 0 here: codegen passes the default, 128. - cmp r14, 1 - jl .Lrandom_badlen - cmp r14, MAX_RECLEN - jg .Lrandom_badlen - - # The same refusals as a sequential OPEN. This one stored a NULL handle - # for a file it could not open, and silently replaced an open one. - lea rax, [rip + _file_handles] - cmp QWORD PTR [rax + rbx*8], 0 - je .Lrandom_free - call .Lopen_already - jmp .Lrandom_open_done -.Lrandom_free: - test r13, r13 - jnz .Lrandom_named - call .Lopen_badname - jmp .Lrandom_open_done -.Lrandom_named: - - # Null-terminate the filename in the shared buffer. - lea rdi, [rip + _file_name_buf] - mov rsi, r12 - mov rdx, r13 - call memcpy - lea rax, [rip + _file_name_buf] - mov BYTE PTR [rax + r13], 0 - - # A random file is read *and* written, so it is opened for update. "r+b" - # fails when the file does not exist yet, in which case it is created. - lea rdi, [rip + _file_name_buf] - lea rsi, [rip + _mode_update] - call fopen - test rax, rax - jnz .Lrandom_have_handle - lea rdi, [rip + _file_name_buf] - lea rsi, [rip + _mode_create] - call fopen - test rax, rax - jnz .Lrandom_have_handle - mov edi, 3 # RANDOM - call .Lopen_failed - jmp .Lrandom_open_done - -.Lrandom_have_handle: - lea rcx, [rip + _file_handles] - mov [rcx + rbx*8], rax - lea rcx, [rip + _file_mode] - mov QWORD PTR [rcx + rbx*8], 3 - lea rcx, [rip + _file_width] - mov QWORD PTR [rcx + rbx*8], 0 - - lea rcx, [rip + _file_col] - mov QWORD PTR [rcx + rbx*8], 0 - - lea rcx, [rip + _file_reclen] - mov [rcx + rbx*8], r14 - - # Release the buffer a previous OPEN on this number left behind. - lea rax, [rip + _file_recbuf] - mov rdi, [rax + rbx*8] - test rdi, rdi - jz .Lrandom_alloc - call free - # Clear the slot before the allocation below can fail. A trapped - # `Out of memory` would otherwise leave the table holding the pointer just - # freed, and _rt_random_prepare tests that slot for NULL to decide "Bad - # file mode" -- so a dangling pointer passes and GET reads freed memory. - lea rax, [rip + _file_recbuf] - mov QWORD PTR [rax + rbx*8], 0 - -.Lrandom_alloc: - mov rdi, r14 - call malloc - test rax, rax - jz .Lrandom_nomem - lea rcx, [rip + _file_recbuf] - mov [rcx + rbx*8], rax - - # A fresh buffer reads as blanks, so a field never written still holds - # spaces rather than whatever the allocator handed back. - mov rdi, rax - mov esi, ' ' - mov rdx, r14 - call memset - - lea rax, [rip + _file_recnum] - mov QWORD PTR [rax + rbx*8], 0 - lea rax, [rip + _file_fieldoff] - mov QWORD PTR [rax + rbx*8], 0 - -.Lrandom_open_done: - pop r14 - pop r13 - pop r12 - pop rbx - leave - ret - -# Each error tail below belongs to one helper. _rt_error returns only when a -# handler traps the error, and then the tail leaves through that helper's own -# epilogue with a harmless result. -.Lrandom_nomem: - lea rdi, [rip + _err_memory] - xor esi, esi - call _rt_error - jmp .Lrandom_open_done - -.Lrandom_badlen: - lea rdi, [rip + _err_domain] - xor esi, esi - call _rt_error - jmp .Lrandom_open_done - -# _rt_field_reset - Start a fresh FIELD statement -# Arguments: rdi = file number -.globl _rt_field_reset -_rt_field_reset: - lea rax, [rip + _file_fieldoff] - mov QWORD PTR [rax + rdi*8], 0 - ret - -# _rt_field_next - Carve the next slice out of the record buffer -# Arguments: -# rdi = file number, rsi = width in bytes -# -# Returns: rax = pointer into the record buffer, rdx = width -.globl _rt_field_next -_rt_field_next: - push rbp - mov rbp, rsp - - # FIELD on a file that was not opened FOR RANDOM has no buffer to carve. - lea rax, [rip + _file_recbuf] - mov r8, [rax + rdi*8] - test r8, r8 - jz .Lfield_badmode - - # A negative width is nonsense; treat it as empty rather than walking back. - test rsi, rsi - jns .Lfield_width_ok - xor esi, esi -.Lfield_width_ok: - - lea rax, [rip + _file_fieldoff] - mov r9, [rax + rdi*8] # bytes already assigned - lea rax, [rip + _file_reclen] - mov r10, [rax + rdi*8] - - # The fields of one record must fit inside it. - mov rcx, r9 - add rcx, rsi - cmp rcx, r10 - jg .Lfield_overflow - - lea rax, [rip + _file_fieldoff] - mov [rax + rdi*8], rcx - - mov rax, r8 - add rax, r9 # buffer + offset - mov rdx, rsi - leave - ret - -.Lfield_badmode: - lea rdi, [rip + _err_badmode] - xor esi, esi - call _rt_error - jmp .Lfield_failed - -.Lfield_overflow: - lea rdi, [rip + _err_fieldovf] - xor esi, esi - call _rt_error -.Lfield_failed: - xor eax, eax # an empty field - xor edx, edx - leave - ret - -# _rt_lset - LSET: copy left-justified into a fixed-width field -# The destination keeps its address and width; only the bytes change. A short -# source is padded with spaces, a long one is truncated on the right. -# -# Arguments: -# rdi = destination pointer, rsi = destination length -# rdx = source pointer, rcx = source length -.globl _rt_lset -_rt_lset: - push rbp - mov rbp, rsp - push rbx - push r12 - push r13 - sub rsp, 8 - - mov rbx, rdi # dest ptr - mov r12, rsi # dest len - mov r13, rcx # source len - - test r12, r12 - jle .Llset_done - - # n = min(source length, destination width) - cmp r13, r12 - cmova r13, r12 - test r13, r13 - jle .Llset_pad - - mov rdi, rbx - mov rsi, rdx - mov rdx, r13 - call memcpy - -.Llset_pad: - # Blank out whatever the source did not fill. - mov rdi, rbx - add rdi, r13 - mov esi, ' ' - mov rdx, r12 - sub rdx, r13 - test rdx, rdx - jle .Llset_done - call memset - -.Llset_done: - add rsp, 8 - pop r13 - pop r12 - pop rbx - leave - ret - -# _rt_rset - RSET: the same, right-justified -# Arguments: as _rt_lset -.globl _rt_rset -_rt_rset: - push rbp - mov rbp, rsp - push rbx - push r12 - push r13 - push r14 - - mov rbx, rdi # dest ptr - mov r12, rsi # dest len - mov r14, rdx # source ptr - mov r13, rcx # source len - - test r12, r12 - jle .Lrset_done - - cmp r13, r12 - cmova r13, r12 - test r13, r13 - jl .Lrset_blank - - # Pad on the left, then place the text against the right edge. - mov rdi, rbx - mov esi, ' ' - mov rdx, r12 - sub rdx, r13 - test rdx, rdx - jle .Lrset_copy - call memset - -.Lrset_copy: - test r13, r13 - jle .Lrset_done - mov rdi, rbx - add rdi, r12 - sub rdi, r13 # dest + width - n - mov rsi, r14 - mov rdx, r13 - call memcpy - jmp .Lrset_done - -.Lrset_blank: - mov rdi, rbx - mov esi, ' ' - mov rdx, r12 - call memset - -.Lrset_done: - pop r14 - pop r13 - pop r12 - pop rbx - leave - ret - -# _rt_random_prepare - Shared GET/PUT setup: validate and seek -# Arguments: -# rdi = file number, rsi = record number (0 = the one after the last) -# rdx = BASIC line number -# -# Returns: rax = FILE*, rbx = file number, r12 = record length, r13 = buffer -# Clobbers the callee-saved registers it returns in; both callers save them. -# -# Reached by `call`, so it keeps its own frame: without one, rsp would still be -# 8 (mod 16) at the fseek below, which is exactly the misalignment that faults -# a `movaps` spill inside the CRT. -.globl _rt_random_prepare -_rt_random_prepare: - push rbp - mov rbp, rsp - - mov ebx, edi - mov r14, rdx # line number, for the error paths - - lea rax, [rip + _file_handles] - mov r15, [rax + rbx*8] - test r15, r15 - jz .Lrandom_badfile - - lea rax, [rip + _file_recbuf] - mov r13, [rax + rbx*8] - test r13, r13 - jz .Lrandom_badmode - - lea rax, [rip + _file_reclen] - mov r12, [rax + rbx*8] - - # No record number means the one after the last one touched. - test rsi, rsi - jg .Lrandom_have_rec - lea rax, [rip + _file_recnum] - mov rsi, [rax + rbx*8] - inc rsi -.Lrandom_have_rec: - - lea rax, [rip + _file_recnum] - mov [rax + rbx*8], rsi - - # Records are 1-based, so record n starts at (n-1) * reclen. - dec rsi - mov rax, rsi - imul rax, r12 - mov rdi, r15 - mov rsi, rax - xor edx, edx # SEEK_SET - call fseek - - mov rax, r15 - leave - ret - -.Lrandom_badfile: - lea rdi, [rip + _err_badfile] - mov rsi, r14 - call _rt_error - jmp .Lrandom_failed - -.Lrandom_badmode: - lea rdi, [rip + _err_badmode] - mov rsi, r14 - call _rt_error -.Lrandom_failed: - xor eax, eax # no FILE*: the caller does nothing more - leave - ret - -# _rt_file_get - GET #n[, rec]: read one record into the buffer -# A record reaching past the end of the file is padded with NULs, so a field -# read from beyond the data is empty rather than holding the previous record. -# -# Arguments: -# rdi = file number, rsi = record number (0 = next), rdx = BASIC line -.globl _rt_file_get -_rt_file_get: - push rbp - mov rbp, rsp - push rbx - push r12 - push r13 - push r14 - push r15 - sub rsp, 8 - - call _rt_random_prepare - test rax, rax - jz .Lget_done # a trapped error: no record to read - - # fread(buffer, 1, reclen, file) - mov rdi, r13 - mov rsi, 1 - mov rdx, r12 - mov rcx, r15 - call fread - - # Zero whatever the file was too short to supply. - mov rdx, r12 - sub rdx, rax - jle .Lget_done - mov rdi, r13 - add rdi, rax - xor esi, esi - call memset - -.Lget_done: - add rsp, 8 - pop r15 - pop r14 - pop r13 - pop r12 - pop rbx - leave - ret - -# _rt_file_put - PUT #n[, rec]: write the buffer as one record -# Arguments: as _rt_file_get -.globl _rt_file_put -_rt_file_put: - push rbp - mov rbp, rsp - push rbx - push r12 - push r13 - push r14 - push r15 - sub rsp, 8 - - call _rt_random_prepare - test rax, rax - jz .Lput_done # a trapped error: no record to write - - # fwrite(buffer, 1, reclen, file) - mov rdi, r13 - mov rsi, 1 - mov rdx, r12 - mov rcx, r15 - call fwrite - - # Flush so that LOF and a reader on another handle see the record now. - mov rdi, r15 - call fflush - -.Lput_done: - add rsp, 8 - pop r15 - pop r14 - pop r13 - pop r12 - pop rbx - leave - ret - -# _rt_file_loc - LOC(n): where the file is positioned -# For a random file this is the last record read or written. For a sequential -# one GW-BASIC counts 128-byte blocks, which is what this reports. -# -# Arguments: rdi = file number -# Returns: xmm0 = the position -.globl _rt_file_loc -_rt_file_loc: - push rbp - mov rbp, rsp - push rbx - sub rsp, 8 - - mov ebx, edi - - lea rax, [rip + _file_recbuf] - mov rax, [rax + rbx*8] - test rax, rax - jz .Lloc_sequential - - lea rax, [rip + _file_recnum] - mov rax, [rax + rbx*8] - cvtsi2sd xmm0, rax - jmp .Lloc_done - -.Lloc_sequential: - lea rax, [rip + _file_handles] - mov rdi, [rax + rbx*8] - test rdi, rdi - jz .Lloc_zero - call ftell - # GW-BASIC reports sequential position in 128-byte blocks. - mov rcx, 128 - xor edx, edx - test rax, rax - js .Lloc_zero - div rcx - cvtsi2sd xmm0, rax - jmp .Lloc_done - -.Lloc_zero: - xorpd xmm0, xmm0 - -.Lloc_done: - add rsp, 8 - pop rbx - leave - ret - -# _rt_lock / _rt_unlock - LOCK and UNLOCK: advisory record locking -# -# POSIX advisory locks through fcntl(F_SETLK). "Advisory" is the honest word: -# they hold against other processes that also lock, which is exactly what -# GW-BASIC's LOCK was for, and they do nothing against a process that simply -# writes. -# -# Arguments: -# rdi = file number, rsi = first record, rdx = last record -# rcx = BASIC line number -# A first record of 0 means the whole file. -.equ F_SETLK, 6 -.equ F_RDLCK, 0 -.equ F_WRLCK, 1 -.equ F_UNLCK, 2 - -.globl _rt_lock -_rt_lock: - mov r8d, F_WRLCK - jmp .Ldo_lock - -.globl _rt_unlock -_rt_unlock: - mov r8d, F_UNLCK - -.Ldo_lock: - push rbp - mov rbp, rsp - push rbx - push r12 - push r13 - push r14 - sub rsp, 48 # struct flock is 32 bytes; 48 keeps rsp - # 16-byte aligned for the calls below - - mov ebx, edi - mov r13, rcx # BASIC line - mov r14d, r8d # lock type - - lea rax, [rip + _file_handles] - mov rdi, [rax + rbx*8] - test rdi, rdi - jz .Llock_badfile - call fileno - mov r12d, eax # file descriptor - - # Build struct flock in the scratch space just reserved. Addressing it from - # rsp keeps it clear of the saved registers sitting below rbp. - mov rcx, rsp - mov WORD PTR [rcx], r14w # l_type - mov WORD PTR [rcx + 2], 0 # l_whence = SEEK_SET - mov DWORD PTR [rcx + 4], 0 # padding - mov QWORD PTR [rcx + 24], 0 # l_pid - - # A first record of 0 locks the whole file, which fcntl spells as - # start 0, length 0. - test rsi, rsi - jle .Llock_whole - - lea rax, [rip + _file_reclen] - mov r8, [rax + rbx*8] - test r8, r8 - jz .Llock_whole # sequential: no records to address - - # Byte range [ (first-1)*reclen, (last-first+1)*reclen ) - mov rax, rsi - dec rax - imul rax, r8 - mov QWORD PTR [rcx + 8], rax # l_start - - sub rdx, rsi - inc rdx - test rdx, rdx - jg .Llock_have_count - mov rdx, 1 -.Llock_have_count: - imul rdx, r8 - mov QWORD PTR [rcx + 16], rdx # l_len - jmp .Llock_call - -.Llock_whole: - mov QWORD PTR [rcx + 8], 0 - mov QWORD PTR [rcx + 16], 0 - -.Llock_call: - mov edi, r12d - mov esi, F_SETLK - mov rdx, rcx - xor eax, eax - call fcntl - test eax, eax - js .Llock_denied - -.Llock_done: - add rsp, 48 - pop r14 - pop r13 - pop r12 - pop rbx - leave - ret - -.Llock_denied: - lea rdi, [rip + _err_permission] - mov rsi, r13 - call _rt_error - jmp .Llock_done - -.Llock_badfile: - lea rdi, [rip + _err_badfile] - mov rsi, r13 - call _rt_error - jmp .Llock_done - -# _rt_mk - MKI$/MKL$/MKS$/MKD$: a number's bytes, as a string -# The value arrives as raw bits so one helper serves all four widths: the -# caller has already coerced it to the type whose width it passes. -# -# Arguments: -# rdi = the value's bits, rsi = width in bytes (2, 4 or 8) -# -# Returns: rax = pointer to a fresh heap copy of the bytes, rdx = width -# (_mk_buf is scratch and never leaves the runtime, so that two MK*$ calls in -# one expression cannot alias each other.) -.globl _rt_mk -_rt_mk: - lea rax, [rip + _mk_buf] - mov QWORD PTR [rax], rdi # little-endian, so a short width just - # takes the low bytes - mov rdi, rax - jmp _rt_strdup # rsi already holds the width - -# _rt_cvi / _rt_cvl / _rt_cvs / _rt_cvd - read MK*$ bytes back as a number -# -# The string must be at least as wide as the type being read. Zero-padding a -# short one instead would be worse than useless: two characters read as a -# DOUBLE do not give 0, they give a denormal near 1e-319, which is a plausible -# number no program would ever notice was wrong. GW-BASIC calls this an illegal -# function call, and so does this. -# -# Arguments: rdi = string pointer, rsi = string length, rdx = BASIC line -# Returns: xmm0 = the value -.globl _rt_cvi -_rt_cvi: - push rbp - mov rbp, rsp - cmp rsi, 2 - jb .Lcv_short - mov edx, 2 - call .Lcv_gather - movsx rax, ax # INTEGER is signed 16-bit - cvtsi2sd xmm0, rax - leave - ret - -.globl _rt_cvl -_rt_cvl: - push rbp - mov rbp, rsp - cmp rsi, 4 - jb .Lcv_short - mov edx, 4 - call .Lcv_gather - movsxd rax, eax # LONG is signed 32-bit - cvtsi2sd xmm0, rax - leave - ret - -.globl _rt_cvs -_rt_cvs: - push rbp - mov rbp, rsp - cmp rsi, 4 - jb .Lcv_short - mov edx, 4 - call .Lcv_gather - movd xmm0, eax - cvtss2sd xmm0, xmm0 - leave - ret - -.globl _rt_cvd -_rt_cvd: - push rbp - mov rbp, rsp - cmp rsi, 8 - jb .Lcv_short - mov edx, 8 - call .Lcv_gather - movq xmm0, rax - leave - ret - -# Reached before rdx is reused as the width, so it still holds the line number. -.Lcv_short: - lea rdi, [rip + _err_domain] - mov rsi, rdx - call _rt_error - xorps xmm0, xmm0 # 0 when a handler traps it - leave - ret - -# Gather rdx bytes of the string at rdi into rax, low byte first. -.Lcv_gather: - xor eax, eax - test rdi, rdi - jz .Lcv_gather_done - test rdx, rdx - jle .Lcv_gather_done - xor ecx, ecx -.Lcv_gather_loop: - movzx r8d, BYTE PTR [rdi + rcx] - mov r9d, ecx - shl r9d, 3 # bit position = index * 8 - mov r10, r8 - mov r11, rcx - mov rcx, r9 - shl r10, cl - mov rcx, r11 - or rax, r10 - inc rcx - cmp rcx, rdx - jl .Lcv_gather_loop -.Lcv_gather_done: - ret - -# _rt_file_lof - LOF(n): length of the file in bytes -# Arguments: -# rdi = file number -# -# Returns: -# xmm0 = length in bytes, or 0.0 when the file is not open -.globl _rt_file_lof -_rt_file_lof: - push rbp - mov rbp, rsp - push rbx - push r12 - sub rsp, 16 # one local, and keeps rsp 16-byte aligned - mov ebx, edi - - lea rax, [rip + _file_handles] - mov rdi, [rax + rbx*8] - test rdi, rdi - jz .Llof_zero - - # Remember the position, seek to the end, read it, then restore. - call ftell - mov r12, rax # saved position - - lea rax, [rip + _file_handles] - mov rdi, [rax + rbx*8] - xor esi, esi - mov edx, 2 # SEEK_END - call fseek - - lea rax, [rip + _file_handles] - mov rdi, [rax + rbx*8] - call ftell - mov QWORD PTR [rbp - 24], rax # length; pushing it here would misalign - # rsp for the fseek below - - lea rax, [rip + _file_handles] - mov rdi, [rax + rbx*8] - mov rsi, r12 - xor edx, edx # SEEK_SET - call fseek - - mov rax, QWORD PTR [rbp - 24] - cvtsi2sd xmm0, rax - jmp .Llof_done - -.Llof_zero: - xorpd xmm0, xmm0 - -.Llof_done: - add rsp, 16 - pop r12 - pop rbx - leave - ret - -# Shared tail for a file number that was never OPENed. -# -# PRINT # and LINE INPUT # used to load the NULL handle and hand it straight to -# fprintf/fgets, so `PRINT #3, "x"` on an unopened number died with SIGSEGV -- -# no message, exit 139. _rt_file_getc and _rt_file_eof already guarded; these -# did not. These helpers are not given the line, so they pass 0 and -# _rt_error reports the one generated code stored in _err_line before the -# call. -# -# These four are reached by `call`, from inside helpers with different frames, -# and tail-call _rt_error: when a handler traps the error, _rt_error returns -# straight to the call site, which leaves through its own helper's epilogue. -.Lfile_not_open: - lea rdi, [rip + _err_badfile] - xor esi, esi - jmp _rt_error - -# The line number is not passed to _rt_file_open either, so the OPEN errors -# pass 0 as well and report _err_line's. -.Lopen_already: - lea rdi, [rip + _err_alreadyopen] - xor esi, esi - jmp _rt_error - -.Lfile_past_end: - lea rdi, [rip + _err_pastend] - xor esi, esi - jmp _rt_error - -.Lopen_badname: - lea rdi, [rip + _err_badname] - xor esi, esi - jmp _rt_error - -# OPEN failed: say why, from errno. Called with edi = the mode (0 INPUT, 1 -# OUTPUT, 2 APPEND, 3 RANDOM). A missing file is "File not found" when it was -# to be read; when it was to be created, what is missing is the directory. -.Lopen_failed: - push rbx # aligns rsp for the call - mov ebx, edi - call __errno_location - mov eax, DWORD PTR [rax] - lea rdi, [rip + _err_access] # 75, for anything not named below - cmp eax, 2 # ENOENT - jne .Lopen_err_notdir - lea rdi, [rip + _err_notfound] - test ebx, ebx - jz .Lopen_err_go - lea rdi, [rip + _err_pathnotfound] - jmp .Lopen_err_go -.Lopen_err_notdir: - cmp eax, 20 # ENOTDIR - jne .Lopen_err_perm - lea rdi, [rip + _err_pathnotfound] - jmp .Lopen_err_go -.Lopen_err_perm: - lea rdi, [rip + _err_permission] - cmp eax, 13 # EACCES - je .Lopen_err_go - cmp eax, 1 # EPERM - je .Lopen_err_go - cmp eax, 30 # EROFS - je .Lopen_err_go - cmp eax, 26 # ETXTBSY - je .Lopen_err_go - lea rdi, [rip + _err_badname] - cmp eax, 36 # ENAMETOOLONG - je .Lopen_err_go - cmp eax, 22 # EINVAL - je .Lopen_err_go - lea rdi, [rip + _err_access] -.Lopen_err_go: - pop rbx - xor esi, esi - jmp _rt_error - -# Is the file open for writing? Called with rbx = file number, from a helper -# whose stack is aligned. Carry set (and the error raised) when it is not. -# PRINT # to a file opened FOR INPUT used to be a write libc quietly refused. -.Lfile_check_writable: - lea rax, [rip + _file_mode] - mov rax, [rax + rbx*8] - cmp rax, 1 # OUTPUT - je .Lfile_mode_ok - cmp rax, 2 # APPEND - je .Lfile_mode_ok -.Lfile_mode_bad: - sub rsp, 8 # aligns rsp for the call - lea rdi, [rip + _err_badmode] - xor esi, esi - call _rt_error - add rsp, 8 - stc - ret -.Lfile_mode_ok: - clc - ret - -# Is the file open for reading sequentially? The same, for INPUT # and -# LINE INPUT #. -.Lfile_check_readable: - lea rax, [rip + _file_mode] - cmp QWORD PTR [rax + rbx*8], 0 # INPUT - jne .Lfile_mode_bad - clc - ret - -# _rt_width - WIDTH [#n,] w: wrap output to file n at w columns -# -# 255 means no limit, as in GW-BASIC, and is also what every file starts with. -# The range 1-255 is checked by the caller. -# -# Arguments: rdi = file number (0 = the console), rsi = width -# Returns: nothing -.globl _rt_width -_rt_width: - push rbp - mov rbp, rsp - lea rax, [rip + _file_handles] - cmp QWORD PTR [rax + rdi*8], 0 - jne .Lwidth_open - sub rsp, 16 # aligns rsp for the call - call .Lfile_not_open - leave - ret -.Lwidth_open: - cmp rsi, 255 - jne .Lwidth_set - xor esi, esi # 255: no limit -.Lwidth_set: - lea rax, [rip + _file_width] - mov QWORD PTR [rax + rdi*8], rsi - leave - ret diff --git a/src/runtime/sysv/input.s b/src/runtime/sysv/input.s deleted file mode 100644 index eb03028..0000000 --- a/src/runtime/sysv/input.s +++ /dev/null @@ -1,370 +0,0 @@ -# BASIC Runtime: Console Input (INPUT, LINE INPUT) -# -# INPUT reads a whole line and splits it on commas, as GW-BASIC and QuickBASIC -# do: a field may be quoted, which lets it hold a comma; an unquoted one has -# its surrounding blanks dropped. Every field is checked against the variable -# it is for before any is stored: a number must be one and nothing else (read -# by _rt_scan_number, as VAL reads one) and must fit the variable's type; a -# quoted field is a string only. A line that fails any of that, or has too few -# fields, prints "?Redo from start" and asks again -- prompt and all. More -# fields than variables print "?Extra ignored". At the end of the input every -# variable reads as empty, rather than the statement waiting forever. -# -# This replaced a reader per variable: scanf("%lf") for a number, which left -# what followed the number for the next INPUT, and the whole raw line for a -# string, so `INPUT A$, B$` read two lines and a comma meant nothing. - -# String Return Convention: -# Strings are returned as (pointer, length) pairs: -# - rax = pointer to string data -# - rdx = length in bytes - -.equ MAX_INPUT_FIELDS, 64 # sema refuses an INPUT with more variables - -.data -_in_redo: .asciz "?Redo from start" -_in_extra: .asciz "?Extra ignored" - -.bss -.p2align 3 -_input_fptr: .skip 8 * MAX_INPUT_FIELDS # where each field starts -_input_flen: .skip 8 * MAX_INPUT_FIELDS # and its length -_input_vals: .skip 8 * MAX_INPUT_FIELDS # a numeric field's value - -.text - -# _rt_con_read_line - Read one line from stdin into _input_buf -# -# The newline is consumed and not kept, as is a CR before it. A line longer -# than the buffer keeps its first 1023 characters. The console's column is 0 -# afterwards: the newline the user typed put the cursor there. -# -# Arguments: none -# Returns: -# rax = length (the text is also NUL-terminated) -# edx = 1 when the input had ended and nothing was read, else 0 -.globl _rt_con_read_line -_rt_con_read_line: - push rbp - mov rbp, rsp - push rbx - push r12 - xor ebx, ebx # length - xor r12d, r12d # 1 once anything, even a newline, was read -.Lrl_loop: - call getchar - cmp eax, -1 - je .Lrl_end_input - mov r12d, 1 - cmp eax, 10 - je .Lrl_done - cmp eax, 13 - je .Lrl_loop # a CR before the newline is not text - cmp rbx, 1023 - jae .Lrl_loop # past the buffer: dropped - lea rcx, [rip + _input_buf] - mov BYTE PTR [rcx + rbx], al - inc rbx - jmp .Lrl_loop -.Lrl_end_input: - xor edx, edx - test r12d, r12d - jnz .Lrl_finish # a last line without a newline still counts - mov edx, 1 - jmp .Lrl_finish -.Lrl_done: - xor edx, edx -.Lrl_finish: - lea rcx, [rip + _input_buf] - mov BYTE PTR [rcx + rbx], 0 - lea rcx, [rip + _file_col] - mov QWORD PTR [rcx], 0 - mov rax, rbx - pop r12 - pop rbx - leave - ret - -# _rt_input_string - LINE INPUT: one whole line, as typed -# -# Arguments: none -# Returns: -# rax = pointer to the line (in _input_buf, valid until the next read) -# rdx = its length; 0 at the end of the input -.globl _rt_input_string -_rt_input_string: - push rbp - mov rbp, rsp - call _rt_con_read_line - mov rdx, rax - lea rax, [rip + _input_buf] - leave - ret - -# _rt_input_line - INPUT: read and check one line for a whole statement -# -# Afterwards _rt_input_field_num and _rt_input_field_str hand out the values. -# -# Arguments: -# rdi = prompt pointer, rsi = prompt length (0 for none), already including -# the "? " when the statement asks for one -# rdx = the variables' types, one character each: '$' string, 'I' INTEGER, -# 'L' LONG, 'S' SINGLE, 'D' DOUBLE -# rcx = how many variables there are -# Returns: nothing -.globl _rt_input_line -_rt_input_line: - push rbp - mov rbp, rsp - push rbx - push r12 - push r13 - push r14 - push r15 - sub rsp, 40 # [rbp-48] prompt, [rbp-56] its length, - # [rbp-64] line length, [rbp-72] field quoted, - # [rbp-80] field length - mov QWORD PTR [rbp - 48], rdi - mov QWORD PTR [rbp - 56], rsi - mov r12, rdx # types - mov r13, rcx # how many - -.Lin_ask: - mov rdx, QWORD PTR [rbp - 56] - test rdx, rdx - jz .Lin_read - xor edi, edi # the console - mov rsi, QWORD PTR [rbp - 48] - call _rt_file_print_string -.Lin_read: - call _rt_con_read_line - mov QWORD PTR [rbp - 64], rax - test edx, edx - jnz .Lin_end_input - xor r14d, r14d # which field - xor r15d, r15d # where in the line - lea rbx, [rip + _input_buf] - -.Lin_field: - # Leading blanks are not part of a field. - cmp r15, QWORD PTR [rbp - 64] - jae .Lin_unquoted - movzx eax, BYTE PTR [rbx + r15] - cmp al, 32 - je .Lin_skip - cmp al, 9 - je .Lin_skip - cmp al, 34 # '"' - jne .Lin_unquoted - - # A quoted field runs to the closing quote; only blanks may follow it. - inc r15 - lea rax, [rbx + r15] - lea rcx, [rip + _input_fptr] - mov QWORD PTR [rcx + r14*8], rax - mov rcx, r15 # where it starts -.Lin_quoted: - cmp r15, QWORD PTR [rbp - 64] - jae .Lin_quoted_end # no closing quote: the rest of the line - cmp BYTE PTR [rbx + r15], 34 - je .Lin_quoted_end - inc r15 - jmp .Lin_quoted -.Lin_quoted_end: - mov rax, r15 - sub rax, rcx - lea rcx, [rip + _input_flen] - mov QWORD PTR [rcx + r14*8], rax - cmp r15, QWORD PTR [rbp - 64] - jae .Lin_quoted_flag - inc r15 # past the closing quote -.Lin_quoted_after: - cmp r15, QWORD PTR [rbp - 64] - jae .Lin_quoted_flag - movzx eax, BYTE PTR [rbx + r15] - cmp al, 44 # ',' - je .Lin_quoted_flag - cmp al, 32 - je .Lin_quoted_blank - cmp al, 9 - jne .Lin_redo # text after a quoted field -.Lin_quoted_blank: - inc r15 - jmp .Lin_quoted_after -.Lin_quoted_flag: - mov QWORD PTR [rbp - 72], 1 - jmp .Lin_check -.Lin_skip: - inc r15 - jmp .Lin_field - -.Lin_unquoted: - # An unquoted field runs to the next comma, less its trailing blanks. - mov QWORD PTR [rbp - 72], 0 - lea rax, [rbx + r15] - lea rcx, [rip + _input_fptr] - mov QWORD PTR [rcx + r14*8], rax - mov rcx, r15 -.Lin_unq_scan: - cmp r15, QWORD PTR [rbp - 64] - jae .Lin_unq_end - cmp BYTE PTR [rbx + r15], 44 - je .Lin_unq_end - inc r15 - jmp .Lin_unq_scan -.Lin_unq_end: - mov rdx, r15 -.Lin_trim: - cmp rdx, rcx - jbe .Lin_trimmed - movzx eax, BYTE PTR [rbx + rdx - 1] - cmp al, 32 - je .Lin_trim_one - cmp al, 9 - jne .Lin_trimmed -.Lin_trim_one: - dec rdx - jmp .Lin_trim -.Lin_trimmed: - sub rdx, rcx - lea rax, [rip + _input_flen] - mov QWORD PTR [rax + r14*8], rdx - -.Lin_check: - movzx eax, BYTE PTR [r12 + r14] - cmp al, 36 # '$': any text will do - je .Lin_next - cmp QWORD PTR [rbp - 72], 0 - jne .Lin_redo # a quoted field is not a number - lea rax, [rip + _input_flen] - mov rsi, QWORD PTR [rax + r14*8] - test rsi, rsi - jz .Lin_zero # an empty field is 0 - mov QWORD PTR [rbp - 80], rsi - lea rax, [rip + _input_fptr] - mov rdi, QWORD PTR [rax + r14*8] - call _rt_scan_number - test edx, edx - jnz .Lin_redo # too large for a DOUBLE - cmp rax, QWORD PTR [rbp - 80] - jne .Lin_redo # not a number, or not only one - # It must fit the variable, rounded as an assignment rounds. - movzx eax, BYTE PTR [r12 + r14] - cmp al, 73 # 'I' - je .Lin_fit_integer - cmp al, 76 # 'L' - je .Lin_fit_long - cmp al, 83 # 'S' - je .Lin_fit_single - jmp .Lin_store -.Lin_fit_integer: - cvtsd2si rax, xmm0 - movsx rcx, ax - cmp rcx, rax - jne .Lin_redo - jmp .Lin_store -.Lin_fit_long: - cvtsd2si rax, xmm0 - movsxd rcx, eax - cmp rcx, rax - jne .Lin_redo - jmp .Lin_store -.Lin_fit_single: - cvtsd2ss xmm1, xmm0 - movd eax, xmm1 - shr eax, 23 - and eax, 0xFF - cmp eax, 0xFF - je .Lin_redo - jmp .Lin_store -.Lin_zero: - xorpd xmm0, xmm0 -.Lin_store: - lea rax, [rip + _input_vals] - movsd QWORD PTR [rax + r14*8], xmm0 - -.Lin_next: - inc r14 - cmp r15, QWORD PTR [rbp - 64] - jae .Lin_at_end - inc r15 # past the comma - cmp r14, r13 - jb .Lin_field - # Every variable has its value and the line goes on. - lea rdi, [rip + _in_extra] - call .Lin_say - jmp .Lin_done -.Lin_at_end: - cmp r14, r13 - jb .Lin_redo # too few fields - jmp .Lin_done - -.Lin_redo: - lea rdi, [rip + _in_redo] - call .Lin_say - jmp .Lin_ask - -.Lin_end_input: - # Nothing more to read: every variable gets an empty value. - xor r14d, r14d -.Lin_empty: - cmp r14, r13 - jae .Lin_done - lea rax, [rip + _input_flen] - mov QWORD PTR [rax + r14*8], 0 - lea rax, [rip + _input_vals] - mov QWORD PTR [rax + r14*8], 0 - inc r14 - jmp .Lin_empty - -.Lin_done: - add rsp, 40 - pop r15 - pop r14 - pop r13 - pop r12 - pop rbx - leave - ret - -# Write the message at rdi on a line of its own. Reached by `call` from -# _rt_input_line's aligned body. -.Lin_say: - push rbx - mov rbx, rdi - call strlen - mov rdx, rax - mov rsi, rbx - xor edi, edi - call _rt_file_print_string - xor edi, edi - call _rt_file_print_newline - pop rbx - ret - -# _rt_input_field_num - The value INPUT read for numeric variable `k` -# Arguments: rdi = k Returns: xmm0 = the value -.globl _rt_input_field_num -_rt_input_field_num: - lea rax, [rip + _input_vals] - movsd xmm0, QWORD PTR [rax + rdi*8] - ret - -# _rt_input_field_str - The text INPUT read for string variable `k` -# -# A copy, since the line buffer is reused by the next read. -# -# Arguments: rdi = k Returns: rax = pointer, rdx = length -.globl _rt_input_field_str -_rt_input_field_str: - lea rax, [rip + _input_flen] - mov rsi, QWORD PTR [rax + rdi*8] - test rsi, rsi - jz .Lin_field_empty - lea rax, [rip + _input_fptr] - mov rdi, QWORD PTR [rax + rdi*8] - jmp _rt_strdup -.Lin_field_empty: - xor eax, eax - xor edx, edx - ret diff --git a/src/runtime/sysv/math.s b/src/runtime/sysv/math.s deleted file mode 100644 index cd6d4a2..0000000 --- a/src/runtime/sysv/math.s +++ /dev/null @@ -1,412 +0,0 @@ -# BASIC Runtime: Math and Utility Functions -# -# Miscellaneous functions that don't fit in other categories. -# -# Note: Most math functions (SIN, COS, SQR, etc.) are implemented inline in -# codegen.rs using x87 FPU or SSE instructions. This file contains only the -# functions that require more complex logic or libc calls. -# -# Global state (from data_defs.s): -# _rng_state = 8 bytes for random number generator state -# _cls_seq = ANSI escape sequence for clear screen - -# _rt_rnd - Generate random number (RND function) -# Returns a pseudo-random number in the range [0, 1). -# -# Arguments: -# xmm0 = the argument, as GW-BASIC reads it: RND(0) repeats the last -# number, RND(<0) reseeds from the value first, RND(>0) is the next -# -# Returns: -# xmm0 = random double in [0, 1) -# -# Algorithm: Xorshift64 -# A fast, high-quality PRNG with 64-bit state. Period is 2^64 - 1. -# -# state ^= state << 13 -# state ^= state >> 7 -# state ^= state << 17 -# -# Conversion to [0,1): -# IEEE 754 double has 52-bit mantissa. We take 52 bits of state, -# set exponent to 1023 (representing 1.xxx in binary), then subtract 1.0. -# This gives a uniformly distributed value in [0, 1). -# -# Bit layout: [sign=0][exp=1023][mantissa=random52bits] = 1.xxxxx -# Subtract 1.0 to get 0.xxxxx -.globl _rt_rnd -_rt_rnd: - push rbp - mov rbp, rsp - # GW-BASIC's argument selects the behaviour: - # RND(<0) reseeds from that value and returns the next number - # RND(0) returns the previous number again - # RND(>0), and a bare RND, return the next number - # The argument used to be ignored entirely, so RND(0) advanced like any - # other call and RND(-1) -- the idiom for a repeatable run -- did nothing. - xorpd xmm1, xmm1 - ucomisd xmm0, xmm1 - jp .Lrnd_next # NaN: treat as "next" - je .Lrnd_repeat - jb .Lrnd_reseed - jmp .Lrnd_next - -.Lrnd_reseed: - call _rt_randomize # consumes xmm0, leaves the state seeded - jmp .Lrnd_next - -.Lrnd_repeat: - movsd xmm0, QWORD PTR [rip + _rng_last] - leave - ret - -.Lrnd_next: - # Load current state - mov rax, QWORD PTR [rip + _rng_state] - # Xorshift64 algorithm - mov rcx, rax - shl rcx, 13 - xor rax, rcx # state ^= state << 13 - mov rcx, rax - shr rcx, 7 - xor rax, rcx # state ^= state >> 7 - mov rcx, rax - shl rcx, 17 - xor rax, rcx # state ^= state << 17 - # Save new state - mov QWORD PTR [rip + _rng_state], rax - # Convert to double in [0, 1) - shr rax, 12 # Keep top 52 bits (discard low 12) - mov rcx, 0x3FF0000000000000 # IEEE 754: exponent=1023, mantissa=0 (value=1.0) - or rax, rcx # Combine: exponent=1023, mantissa=random (value in [1,2)) - movq xmm0, rax # Move to SSE register - # Subtract 1.0 to get [0, 1) - mov rcx, 0x3FF0000000000000 - movq xmm1, rcx - subsd xmm0, xmm1 # result = [1,2) - 1.0 = [0,1) - # Remember it, so that RND(0) can hand back the same number. - movsd QWORD PTR [rip + _rng_last], xmm0 - leave - ret - -# _rt_randomize - RANDOMIZE: set the generator's seed -# -# The state was a fixed constant with no way to change it, so every run of every -# program produced the same numbers -- a dice game rolled the same dice every -# time it was played. -# -# The seed's bit pattern is passed through a splitmix64 avalanche rather than -# used directly: BASIC seeds are small integers, and xorshift64 started from a -# small state produces a visibly poor first few values. Zero is replaced, -# because it is xorshift's fixed point and would return 0 forever. -# -# Arguments: xmm0 = seed -# Returns: nothing -.globl _rt_randomize -_rt_randomize: - push rbp - mov rbp, rsp - movq rax, xmm0 - mov rcx, 0x9E3779B97F4A7C15 - add rax, rcx - mov rcx, rax - shr rcx, 30 - xor rax, rcx - mov rcx, 0xBF58476D1CE4E5B9 - imul rax, rcx - mov rcx, rax - shr rcx, 27 - xor rax, rcx - mov rcx, 0x94D049BB133111EB - imul rax, rcx - mov rcx, rax - shr rcx, 31 - xor rax, rcx - test rax, rax - jnz .Lrandomize_store - mov rax, 0x12345678DEADBEEF # xorshift64 must never hold zero -.Lrandomize_store: - mov QWORD PTR [rip + _rng_state], rax - leave - ret - -# _rt_beep - BEEP: ring the terminal bell -# -# Arguments: none Returns: nothing -.globl _rt_beep -_rt_beep: - push rbp - mov rbp, rsp - mov edi, 7 # BEL - call putchar - leave - ret - -# _rt_date - DATE$: the date as MM-DD-YYYY, GW-BASIC's shape -# -# Arguments: none -# Returns: rax = pointer, rdx = length -.globl _rt_date -_rt_date: - push rbp - mov rbp, rsp - sub rsp, 16 - lea rdi, [rsp] - call time - lea rdi, [rsp] - call localtime - mov rcx, rax # struct tm * - lea rdi, [rip + _num_buf] - mov rsi, 64 - lea rdx, [rip + _date_fmt] - call strftime - lea rdi, [rip + _num_buf] - mov rsi, rax - leave - jmp _rt_strdup # the caller may hold another such result - -# _rt_time - TIME$: the time as HH:MM:SS -# -# Arguments: none -# Returns: rax = pointer, rdx = length -.globl _rt_time -_rt_time: - push rbp - mov rbp, rsp - sub rsp, 16 - lea rdi, [rsp] - call time - lea rdi, [rsp] - call localtime - mov rcx, rax # struct tm * - lea rdi, [rip + _num_buf] - mov rsi, 64 - lea rdx, [rip + _time_fmt] - call strftime - lea rdi, [rip + _num_buf] - mov rsi, rax - leave - jmp _rt_strdup # the caller may hold another such result - -# _rt_pos - POS(n): the column the next character will be written to -# -# The tracker counts characters already on the line, and BASIC columns start at -# one, so this is that count plus one. -# -# Arguments: none -# Returns: eax = column (1-based) -.globl _rt_pos -_rt_pos: - push rbp - mov rbp, rsp - lea rax, [rip + _file_col] - mov rax, QWORD PTR [rax] - inc rax - leave - ret - -# _rt_locate - LOCATE row, col: move the cursor -# -# Written as an ANSI escape, the same way _rt_cls clears the screen. The column -# tracker is updated to match, so that a following TAB or PRINT zone counts from -# where the cursor actually is. -# -# Either coordinate may be omitted, and an omitted one stays where it is, as in -# GW-BASIC: CUP moves both, VPA only the row, CHA only the column. An omitted -# row used to mean row 1. -# -# Arguments: rdi = row (1-based), rsi = column (1-based); -1 = omitted -# Returns: nothing -.globl _rt_locate -_rt_locate: - push rbp - mov rbp, rsp - push rbx - sub rsp, 8 # keep rsp 16-byte aligned across the call - - mov rbx, rsi # remember the column - test rdi, rdi - js .Llocate_col_only - test rsi, rsi - js .Llocate_row_only - mov rdx, rsi - mov rsi, rdi - lea rdi, [rip + _locate_fmt] - xor eax, eax - call printf - jmp .Llocate_track -.Llocate_row_only: - mov rsi, rdi - lea rdi, [rip + _locate_row_fmt] - xor eax, eax - call printf - jmp .Llocate_done # the column has not moved -.Llocate_col_only: - test rsi, rsi - js .Llocate_done # neither: nothing moves - lea rdi, [rip + _locate_col_fmt] - xor eax, eax - call printf - -.Llocate_track: - # The tracker counts characters before the cursor, so column 1 is 0. - dec rbx - lea rax, [rip + _file_col] - mov QWORD PTR [rax], rbx -.Llocate_done: - add rsp, 8 - pop rbx - leave - ret - -# _rt_color - COLOR foreground, background -# -# GW-BASIC numbers 0-15 with 8-15 as the bright half; ANSI splits that into two -# ranges, 30-37 and 90-97 for the foreground and 40-47 and 100-107 for the -# background. The eight hues are in a different order: GW-BASIC's 1 is blue and -# 4 red, ANSI's the other way round, so COLOR 1 used to print red. A foreground -# of 16-31 is the same colour blinking, so every -# foreground also sets or clears blink (SGR 5 / 25). -# -# Either may be omitted, and an omitted one is left as it was. An omitted -# background used to mean black. -# -# Arguments: rdi = foreground 0-31, rsi = background 0-15; -1 = omitted -# Returns: nothing -.globl _rt_color -_rt_color: - push rbp - mov rbp, rsp - push rbx - push r12 - - # Background: 0-7 -> 40-47, 8-15 -> 100-107; -1 stays negative - mov r12, rsi - test r12, r12 - js .Lcolor_bg_done - lea rcx, [rip + _gw_to_ansi] - mov rax, r12 - and eax, 7 - movzx eax, BYTE PTR [rcx + rax] - cmp r12, 8 - lea r12, [rax + 40] - jl .Lcolor_bg_done - add r12, 100 - 40 -.Lcolor_bg_done: - - mov rbx, rdi - test rbx, rbx - js .Lcolor_bg_only - - # Foreground: 16-31 blink; then 0-7 -> 30-37, 8-15 -> 90-97 - mov esi, 25 # blink off - cmp rbx, 16 - jl .Lcolor_steady - mov esi, 5 # blink on - sub rbx, 16 -.Lcolor_steady: - lea rcx, [rip + _gw_to_ansi] - mov rax, rbx - and eax, 7 - movzx eax, BYTE PTR [rcx + rax] - cmp rbx, 8 - lea rbx, [rax + 30] - jl .Lcolor_fg_done - add rbx, 90 - 30 -.Lcolor_fg_done: - mov rdx, rbx - test r12, r12 - js .Lcolor_fg_only - mov rcx, r12 - lea rdi, [rip + _color_fmt] - xor eax, eax - call printf - jmp .Lcolor_done -.Lcolor_fg_only: - lea rdi, [rip + _color_fg_fmt] - xor eax, eax - call printf - jmp .Lcolor_done - -.Lcolor_bg_only: - test r12, r12 - js .Lcolor_done # neither: nothing changes - mov rsi, r12 - lea rdi, [rip + _color_bg_fmt] - xor eax, eax - call printf - -.Lcolor_done: - pop r12 - pop rbx - leave - ret - -# _rt_timer - TIMER: seconds since local midnight -# GW-BASIC's TIMER counts fractional seconds since midnight, so this uses -# gettimeofday rather than time(): whole seconds alone made a program that -# times a short loop always read zero. -# -# Midnight is local, the clock TIME$ reads. This used to count from midnight -# UTC, so anywhere but Greenwich TIMER and TIME$ disagreed by hours. The whole -# seconds and the fraction come from the one gettimeofday reading, so they -# cannot straddle a second. -# -# Arguments: none -# -# Returns: -# xmm0 = seconds since midnight (double, 0 <= t < 86401 across a leap second) -.globl _rt_timer -_rt_timer: - push rbp - mov rbp, rsp - sub rsp, 32 # struct timeval, and keeps rsp 16-byte aligned - - mov rdi, rsp # &tv - xor esi, esi # timezone = NULL - call gettimeofday - - mov rdi, rsp # &tv.tv_sec is a time_t * - call localtime # struct tm *: tm_sec, tm_min, tm_hour are ints - mov ecx, DWORD PTR [rax + 8] - imul ecx, ecx, 3600 - mov edx, DWORD PTR [rax + 4] - imul edx, edx, 60 - add ecx, edx - add ecx, DWORD PTR [rax] - cvtsi2sd xmm0, ecx - - # ... plus tv_usec / 1000000 - cvtsi2sd xmm1, QWORD PTR [rsp + 8] - mov rax, 0x412E848000000000 # 1000000.0 - movq xmm2, rax - divsd xmm1, xmm2 - addsd xmm0, xmm1 - - leave - ret - -# _rt_cls - Clear screen (CLS statement) -# Clears the terminal screen and moves cursor to home position. -# Uses ANSI escape sequences, which work on most modern terminals. -# -# Arguments: none -# Returns: nothing -# -# Escape sequence: ESC[2J ESC[H -# ESC[2J = clear entire screen -# ESC[H = move cursor to home (top-left) -.globl _rt_cls -_rt_cls: - push rbp - mov rbp, rsp - # Home the column tracker too. The cursor is at column 1 after this, and a - # later TAB that believed the old column emitted a newline to reach a - # column it had already passed. - lea rax, [rip + _file_col] - mov QWORD PTR [rax], 0 - lea rdi, [rip + _cls_seq] # ANSI escape sequence - xor eax, eax # no vector args - call printf - leave - ret diff --git a/src/runtime/sysv/print.s b/src/runtime/sysv/print.s deleted file mode 100644 index 0471c2f..0000000 --- a/src/runtime/sysv/print.s +++ /dev/null @@ -1,327 +0,0 @@ -# BASIC Runtime: Print Functions -# -# Number formatting and program termination. The printing itself lives in -# file.s: the console is file handle 0, so PRINT and PRINT # are the same -# helpers with a different handle, and neither can drift from the other. -# -# All functions follow System V AMD64 ABI: -# - Callee-saved: rbx, rbp, r12-r15 -# - Caller-saved: rax, rcx, rdx, rsi, rdi, r8-r11, xmm0-xmm15 -# - Return values: rax (int), xmm0 (float) - -# _rt_platform_init - Prepare the console for output -# The console is file handle 0, so every print helper reaches it the same way -# it reaches an OPENed file. Seeding the slot is all that takes here; Windows -# has to ask the OS for its handles instead. -# -# stdout is external *data*, reached through the GOT: a direct PC-relative -# load would resolve only because the driver passes -no-pie, letting ld -# synthesize a copy relocation, and that coupling is not worth one saved -# instruction. -# -# Arguments: none Returns: nothing -.globl _rt_platform_init -_rt_platform_init: - mov rax, QWORD PTR [rip + stdout@GOTPCREL] - mov rax, QWORD PTR [rax] - mov QWORD PTR [rip + _file_handles], rax - mov QWORD PTR [rip + _file_mode], 1 # the console is written to - ret - -# _rt_fmt_double - Format a number into _num_buf -# Shared by console and file output so both render numbers identically. -# -# GW-BASIC's rule, which QuickBASIC documents: a value is rounded to the -# type's significant digits -- 7 for a SINGLE, 16 for a DOUBLE -- and written -# in fixed point when that shows it in at most that many digits, otherwise -# with an exponent. So a SINGLE's 1.1E-6 prints .0000011 and 1.1E-7 prints -# 1.1E-07; 1234567 prints in full and 12345678 as 1.234568E+07. Trailing zeros -# are dropped, a value below one has no leading zero, and the exponent is -# spelled E for a SINGLE and D for a DOUBLE, with at least two digits. -# -# This used to print the shortest decimal that read back unchanged, so a -# DOUBLE showed 17 digits (.1 + .2 printed .30000000000000004), a SINGLE up to -# 9, and any whole number below 2^63 in full whatever its type. -# -# Arguments: -# xmm0 = value (a SINGLE arrives already widened to double) -# edi = nonzero for a SINGLE -# -# Returns: -# rax = length of the text in _num_buf -.globl _rt_fmt_double -_rt_fmt_double: - push rbp - mov rbp, rsp - push rbx - push r12 - push r13 - push r14 # rsp is 16-byte aligned for the call below - mov r12d, edi # nonzero for a SINGLE - mov r13d, 16 # significant digits, P - test r12d, r12d - jz .Lfd_digits - mov r13d, 7 -.Lfd_digits: - - # Zero, of either sign, is 0. - xorpd xmm1, xmm1 - ucomisd xmm0, xmm1 - jp .Lfd_nonzero - jne .Lfd_nonzero - lea rcx, [rip + _num_buf] - mov WORD PTR [rcx], 48 # "0", NUL - mov eax, 1 - jmp .Lfd_ret -.Lfd_nonzero: - # sprintf(_fmt_scratch, "%.*e", P - 1, value) - lea rdi, [rip + _fmt_scratch] - lea rsi, [rip + _fmt_sci] - lea edx, [r13 - 1] - mov eax, 1 # one vector register argument - call sprintf - lea rbx, [rip + _fmt_scratch] # read cursor - - # The text is "[-]d.ddd...e[+-]xx": P significant digits, already rounded - # by printf. From here on no call is made, and only registers volatile in - # both ABIs are used (plus rbx, r12-r14, saved above), so this body is - # identical in both trees. - lea r14, [rip + _num_buf] # write cursor - cmp BYTE PTR [rbx], 45 # '-' - jne .Lfd_unsigned - mov BYTE PTR [r14], 45 - inc rbx - inc r14 -.Lfd_unsigned: - movzx eax, BYTE PTR [rbx] - sub eax, 48 - cmp eax, 9 - ja .Lfd_raw # inf or nan: as the C library wrote it - - # The P digits, without the point. - lea r8, [rip + _fmt_digits] - mov al, BYTE PTR [rbx] - mov BYTE PTR [r8], al - mov ecx, 1 - lea r9, [rbx + 2] # past the leading digit and the point -.Lfd_gather: - cmp ecx, r13d - jge .Lfd_gathered - mov al, BYTE PTR [r9] - mov BYTE PTR [r8 + rcx], al - inc r9 - inc ecx - jmp .Lfd_gather -.Lfd_gathered: - # The decimal exponent X, so the value is d.ddd * 10^X. - inc r9 # past 'e' - mov r10b, BYTE PTR [r9] # its sign - inc r9 - xor edx, edx -.Lfd_expdig: - movzx eax, BYTE PTR [r9] - test eax, eax - jz .Lfd_expdone - sub eax, 48 - imul edx, edx, 10 - add edx, eax - inc r9 - jmp .Lfd_expdig -.Lfd_expdone: - cmp r10b, 45 # '-' - jne .Lfd_exppos - neg edx -.Lfd_exppos: - - # n = how many of them are significant: trailing zeros are not. - mov ecx, r13d -.Lfd_trim: - cmp ecx, 1 - jle .Lfd_trimmed - cmp BYTE PTR [r8 + rcx - 1], 48 - jne .Lfd_trimmed - dec ecx - jmp .Lfd_trim -.Lfd_trimmed: - # Fixed point when it shows the value in at most P digits, as GW-BASIC - # and QuickBASIC do: X+1 integer digits for X >= 0, or for X < 0 the - # -X-1 zeros after the point and then the n digits. - test edx, edx - js .Lfd_small - cmp edx, r13d - jge .Lfd_sci - - xor r11d, r11d # X >= 0: the integer part ... -.Lfd_int: - cmp r11d, edx - jg .Lfd_intdone - mov al, 48 # a digit past n is a zero - cmp r11d, ecx - jge .Lfd_intput - mov al, BYTE PTR [r8 + r11] -.Lfd_intput: - mov BYTE PTR [r14], al - inc r14 - inc r11d - jmp .Lfd_int -.Lfd_intdone: - cmp r11d, ecx # ... and a fraction, if any is left - jge .Lfd_end - mov BYTE PTR [r14], 46 # '.' - inc r14 -.Lfd_frac: - cmp r11d, ecx - jge .Lfd_end - mov al, BYTE PTR [r8 + r11] - mov BYTE PTR [r14], al - inc r14 - inc r11d - jmp .Lfd_frac - -.Lfd_small: # X < 0: no leading zero, as .5 - mov eax, edx - neg eax - dec eax # zeros between the point and n - lea r10d, [rax + rcx] - cmp r10d, r13d - jg .Lfd_sci - mov BYTE PTR [r14], 46 # '.' - inc r14 -.Lfd_lead: - test eax, eax - jz .Lfd_leaddone - mov BYTE PTR [r14], 48 - inc r14 - dec eax - jmp .Lfd_lead -.Lfd_leaddone: - xor r11d, r11d - jmp .Lfd_frac - -.Lfd_sci: # d[.ddd]E+xx, D for a DOUBLE - mov al, BYTE PTR [r8] - mov BYTE PTR [r14], al - inc r14 - cmp ecx, 1 - jle .Lfd_sciexp - mov BYTE PTR [r14], 46 - inc r14 - mov r11d, 1 -.Lfd_scifrac: - cmp r11d, ecx - jge .Lfd_sciexp - mov al, BYTE PTR [r8 + r11] - mov BYTE PTR [r14], al - inc r14 - inc r11d - jmp .Lfd_scifrac -.Lfd_sciexp: - mov al, 68 # 'D' - test r12d, r12d - jz .Lfd_letter - mov al, 69 # 'E' -.Lfd_letter: - mov BYTE PTR [r14], al - inc r14 - mov al, 43 # '+' - test edx, edx - jns .Lfd_expsign - mov al, 45 # '-' - neg edx -.Lfd_expsign: - mov BYTE PTR [r14], al - inc r14 - mov r10d, 10 - cmp edx, 100 # two digits at least, three if needed - jl .Lfd_twodigits - mov eax, edx - xor edx, edx - mov r10d, 100 - div r10d - add al, 48 - mov BYTE PTR [r14], al - inc r14 - mov r10d, 10 -.Lfd_twodigits: - mov eax, edx - xor edx, edx - div r10d - add al, 48 - mov BYTE PTR [r14], al - add dl, 48 - mov BYTE PTR [r14 + 1], dl - add r14, 2 - jmp .Lfd_end - -.Lfd_raw: - mov al, BYTE PTR [rbx] - test al, al - jz .Lfd_end - mov BYTE PTR [r14], al - inc rbx - inc r14 - jmp .Lfd_raw - -.Lfd_end: - mov BYTE PTR [r14], 0 - lea rax, [rip + _num_buf] - sub r14, rax - mov rax, r14 # the length - -.Lfd_ret: - pop r14 - pop r13 - pop r12 - pop rbx - pop rbp - ret - -# _rt_fmt_basic - Render a number the way BASIC writes it -# -# _rt_fmt_double gives the digits; this adds the blank that stands where a -# minus sign would go. GW-BASIC puts one there for every non-negative number, -# which is why `PRINT 1; 2` reads " 1 2 " and why STR$(5) is " 5" -- the -# `MID$(STR$(N), 2)` idiom exists to strip exactly this blank. -# -# Not folded into _rt_fmt_double, because WRITE and PRINT USING render numbers -# through that and must not gain the blank. -# -# Arguments: the same as _rt_fmt_double -# Returns: rax = length of the text in _num_buf -.globl _rt_fmt_basic -_rt_fmt_basic: - push rbp - mov rbp, rsp - call _rt_fmt_double - lea rcx, [rip + _num_buf] - cmp BYTE PTR [rcx], 45 # '-' already occupies the sign position - je .Lfb_done - # Shift right by one, the NUL at [rax] included, and blank the vacancy. - mov rdx, rax -.Lfb_shift: - mov r9b, BYTE PTR [rcx + rdx] - mov BYTE PTR [rcx + rdx + 1], r9b - dec rdx - jns .Lfb_shift - mov BYTE PTR [rcx], 32 # ' ' - inc rax -.Lfb_done: - leave - ret - -# _rt_end - Terminate the program normally (END / STOP) -# Valid from any frame, including inside a SUB or FUNCTION. Emitting a plain -# `leave; ret` for END only terminates when it appears in main; inside a -# procedure it merely returns to the caller and execution continues. -# -# Uses exit() rather than _exit() so stdio buffers -- printf output and any -# FILE* opened by file.s -- are flushed. -# -# Arguments: none -# Returns: never -.globl _rt_end -_rt_end: - push rbp - mov rbp, rsp - xor edi, edi # exit code 0 - call exit diff --git a/src/runtime/sysv/string.s b/src/runtime/sysv/string.s deleted file mode 100644 index 2f6d902..0000000 --- a/src/runtime/sysv/string.s +++ /dev/null @@ -1,1004 +0,0 @@ -# BASIC Runtime: String Functions -# -# String manipulation functions implementing BASIC's string operations. -# -# String Representation: -# BASIC strings are (pointer, length) pairs. They are NOT null-terminated -# internally, which allows efficient substring operations (LEFT$, MID$, RIGHT$) -# that return pointers into the original string without copying. -# -# String Return Convention: -# - rax = pointer to string data -# - rdx = length in bytes -# -# Memory Management: -# - Substring functions (LEFT$, MID$, RIGHT$) return pointers into the original -# string - no allocation needed -# - String concatenation (_rt_strcat) allocates new memory via malloc -# - Conversion functions (STR$, CHR$, HEX$, OCT$) format into a scratch -# buffer and return a heap copy of it -# -# Scratch Buffers (from data_defs.s): -# _str_buf = 64 bytes - working space for HEX$() and OCT$() -# _chr_buf = 2 bytes - working space for CHR$(): character + null -# -# Important: those buffers never leave the runtime. A conversion function that -# returned one directly would alias itself, because nothing copies the result -# until it is assigned -- so STR$(A) + STR$(B) evaluated both halves before -# either was copied, and the first was already overwritten. They end in -# _rt_strdup for that reason, and the buffer is reused freely. - -# _rt_val - VAL: the number a string begins with -# -# The text is read by _rt_scan_number, so VAL accepts what GW-BASIC's does: -# blanks are skipped ("1 2" is 12), &H and &O work, and a D exponent too. Text -# that does not begin with a number is 0, and one too large for a DOUBLE is -# Overflow rather than infinity. -# -# Arguments: -# rdi = pointer to string -# rsi = length -# -# Returns: -# xmm0 = the value -.globl _rt_val -_rt_val: - push rbp - mov rbp, rsp - call _rt_scan_number - test edx, edx - jnz .Lval_overflow - leave - ret -.Lval_overflow: - lea rdi, [rip + _err_overflow] - xor esi, esi - call _rt_error # returns only when trapped - xorpd xmm0, xmm0 - leave - ret - -# _rt_scan_number - Read a number the way GW-BASIC's VAL and INPUT do -# -# Shared by VAL, INPUT, INPUT # and READ, so they all accept the same text: -# leading blanks; blanks inside the number, which are ignored ("1 2" is 12); -# a sign; digits with at most one point; an exponent spelled E or D, with an -# optional sign; or &H, &O, &B or a bare & followed by digits, which are an -# INTEGER when they fit 16 bits and a LONG when they fit 32 -- two's -# complement, as a literal. Scanning stops at the first character that cannot -# continue the number. strtod saw the text directly before, so VAL accepted -# "inf", "nan" and "0x1F", read past the end of a LEFT$ view, and knew no D. -# -# Arguments: -# rdi = pointer, rsi = length -# -# Returns: -# xmm0 = the value, 0 when there is no number -# rax = characters consumed, up to the last that belongs to the number; -# 0 when there is no number at all -# edx = 1 when the value is too large for a DOUBLE, else 0 -.globl _rt_scan_number -_rt_scan_number: - push rbp - mov rbp, rsp - push rbx - push r12 - push r13 - push r14 - push r15 - sub rsp, 8 # endptr slot; 16-byte aligned - mov r12, rdi # the text - mov r13, rsi # its length - xor ebx, ebx # index into the text - xor r15d, r15d # consumed: just past the last character used - xor r14d, r14d # length of the copy in _scan_buf - xor r8d, r8d # stage: 0 sign, 1 mantissa, 2 exponent sign, 3 exponent - xor r9d, r9d # a point has been seen - -.Lsn_lead: - cmp rbx, r13 - jae .Lsn_none - movzx eax, BYTE PTR [r12 + rbx] - cmp al, 32 - je .Lsn_lead_next - cmp al, 9 - je .Lsn_lead_next - cmp al, 38 # '&' - je .Lsn_radix - lea r10, [rip + _scan_buf] - jmp .Lsn_loop -.Lsn_lead_next: - inc rbx - jmp .Lsn_lead - -.Lsn_loop: - cmp rbx, r13 - jae .Lsn_convert - cmp r14, 120 # the copy's room; a longer number has no more precision - jae .Lsn_convert - movzx eax, BYTE PTR [r12 + rbx] - cmp al, 32 # blanks inside a number are skipped - je .Lsn_next - cmp al, 9 - je .Lsn_next - cmp al, 48 - jb .Lsn_not_digit - cmp al, 57 - ja .Lsn_not_digit - # A digit: in the mantissa, or the exponent once it has begun. - cmp r8d, 2 - jb .Lsn_mant_digit - mov r8d, 3 - jmp .Lsn_take -.Lsn_mant_digit: - mov r8d, 1 - jmp .Lsn_take -.Lsn_not_digit: - cmp al, 43 # '+' - je .Lsn_sign - cmp al, 45 # '-' - je .Lsn_sign - cmp al, 46 # '.' - je .Lsn_point - or al, 32 # fold case for the exponent letters - cmp al, 101 # 'e' - je .Lsn_exp - cmp al, 100 # 'd' - je .Lsn_exp - jmp .Lsn_convert -.Lsn_sign: - cmp r8d, 0 # a sign begins the number ... - je .Lsn_sign_ok - cmp r8d, 2 # ... or its exponent, and nothing else - jne .Lsn_convert -.Lsn_sign_ok: - inc r8d - mov BYTE PTR [r10 + r14], al - inc r14 - jmp .Lsn_next -.Lsn_point: - cmp r8d, 1 - ja .Lsn_convert # no point in an exponent - test r9d, r9d - jnz .Lsn_convert # nor a second one - mov r9d, 1 - mov r8d, 1 - jmp .Lsn_take -.Lsn_exp: - cmp r8d, 1 # only after some of the mantissa - jne .Lsn_convert - mov r8d, 2 - mov al, 101 # strtod's spelling - mov BYTE PTR [r10 + r14], al - inc r14 - jmp .Lsn_next -.Lsn_take: - mov BYTE PTR [r10 + r14], al - inc r14 - lea r15, [rbx + 1] -.Lsn_next: - inc rbx - jmp .Lsn_loop - -.Lsn_convert: - mov BYTE PTR [r10 + r14], 0 - test r15, r15 - jz .Lsn_none - lea rdi, [rip + _scan_buf] - mov rsi, rsp # &endptr - call strtod - mov rcx, QWORD PTR [rsp] - lea rax, [rip + _scan_buf] - cmp rcx, rax - je .Lsn_none # "+", "." and the like are no number - # Infinity is the only way past DOUBLE's range. - movq rax, xmm0 - shr rax, 52 - and eax, 0x7FF - xor edx, edx - cmp eax, 0x7FF - jne .Lsn_done - mov edx, 1 - xorpd xmm0, xmm0 - jmp .Lsn_done - -.Lsn_radix: - inc rbx # past '&' - mov ecx, 8 # a bare & is octal - cmp rbx, r13 - jae .Lsn_radix_digits - movzx eax, BYTE PTR [r12 + rbx] - or al, 32 - cmp al, 104 # 'h' - jne .Lsn_radix_o - mov ecx, 16 - inc rbx - jmp .Lsn_radix_digits -.Lsn_radix_o: - cmp al, 111 # 'o' - jne .Lsn_radix_b - inc rbx - jmp .Lsn_radix_digits -.Lsn_radix_b: - cmp al, 98 # 'b' - jne .Lsn_radix_digits - mov ecx, 2 - inc rbx -.Lsn_radix_digits: - xor r10d, r10d # the value - xor r11d, r11d # 1 once it no longer fits 32 bits -.Lsn_radix_loop: - cmp rbx, r13 - jae .Lsn_radix_end - movzx eax, BYTE PTR [r12 + rbx] - sub eax, 48 - cmp eax, 9 - jbe .Lsn_radix_have # 0-9 - movzx eax, BYTE PTR [r12 + rbx] - or al, 32 - sub eax, 87 # 'a' -> 10 - cmp eax, 10 - jb .Lsn_radix_end -.Lsn_radix_have: - cmp eax, ecx - jae .Lsn_radix_end # not a digit of this radix - imul r10, rcx - add r10, rax - mov rax, r10 - shr rax, 32 - jz .Lsn_radix_fits - mov r11d, 1 - and r10d, r10d # keep it bounded; the overflow is recorded -.Lsn_radix_fits: - inc rbx - lea r15, [rbx] - jmp .Lsn_radix_loop -.Lsn_radix_end: - test r15, r15 - jz .Lsn_none - mov edx, r11d - test edx, edx - jnz .Lsn_radix_zero - cmp r10, 0xFFFF - ja .Lsn_radix_long - movsx eax, r10w # up to 16 bits: an INTEGER, two's complement - cvtsi2sd xmm0, eax - jmp .Lsn_done -.Lsn_radix_long: - cvtsi2sd xmm0, r10d # up to 32: a LONG, two's complement - jmp .Lsn_done -.Lsn_radix_zero: - xorpd xmm0, xmm0 - jmp .Lsn_done - -.Lsn_none: - xorpd xmm0, xmm0 - xor r15d, r15d - xor edx, edx -.Lsn_done: - mov rax, r15 - add rsp, 8 - pop r15 - pop r14 - pop r13 - pop r12 - pop rbx - pop rbp - ret - -# _rt_str - Convert number to string (STR$ function) -# -# Renders exactly what PRINT would render, by going through the same helper. -# This used to be its own sprintf("%g"), which stops at six significant digits: -# STR$(123456789.125) came back as "1.23457e+08" and VAL(STR$(X)) was not X. -# GW-BASIC's STR$ is defined as the text PRINT produces, and now so is this. -# -# Arguments: -# xmm0 = number to convert (double) -# -# Returns: -# rax = pointer to a fresh heap copy of the text -# rdx = length of string -.globl _rt_str -_rt_str: - push rbp - mov rbp, rsp - xor edi, edi # a DOUBLE - call _rt_fmt_basic # includes the sign position's blank - lea rdi, [rip + _num_buf] - mov rsi, rax # length - leave - jmp _rt_strdup # the caller may hold another such result - -# _rt_str_single - STR$ of a SINGLE -# -# A SINGLE carries only ~7 significant digits, so it uses the shorter table for -# the same reason PRINT does: rendered at full double precision, 3.14159! would -# come back as "3.141590118408203". -# -# Arguments: xmm0 = value, already widened to double -# Returns: rax = pointer to a fresh heap copy, rdx = length -.globl _rt_str_single -_rt_str_single: - push rbp - mov rbp, rsp - mov edi, 1 # a SINGLE - call _rt_fmt_basic - lea rdi, [rip + _num_buf] - mov rsi, rax - leave - jmp _rt_strdup - -# _rt_chr - Convert ASCII code to single character (CHR$ function) -# Creates a 1-character string from an ASCII code. -# -# Arguments: -# rdi = ASCII code (0-255) -# -# Returns: -# rax = pointer to a fresh heap copy of the character -# rdx = 1 (length) -.globl _rt_chr -_rt_chr: - push rbp - mov rbp, rsp - lea rax, [rip + _chr_buf] - mov BYTE PTR [rax], dil # store character (low byte of rdi) - mov BYTE PTR [rax + 1], 0 # null terminate (for safety) - mov rdi, rax - mov esi, 1 # length = 1 - leave - jmp _rt_strdup - -# _rt_left - Extract leftmost characters (LEFT$ function) -# Returns the first N characters of a string. If N > string length, returns -# the entire string. This is a zero-copy operation - returns pointer into -# original string. -# -# Arguments: -# rdi = source string pointer -# rsi = source string length -# rdx = number of characters to extract -# -# Returns: -# rax = pointer to start of result (same as input pointer) -# rdx = result length (min of requested count and source length) -.globl _rt_left -_rt_left: - mov rax, rdi # result ptr = source ptr - cmp rdx, rsi # if count > length - cmova rdx, rsi # count = length - ret # return (ptr, count) - -# _rt_right - Extract rightmost characters (RIGHT$ function) -# Returns the last N characters of a string. Zero-copy operation. -# -# Arguments: -# rdi = source string pointer -# rsi = source string length -# rdx = number of characters to extract -# -# Returns: -# rax = pointer to start of result (ptr + len - count) -# rdx = result length -.globl _rt_right -_rt_right: - cmp rdx, rsi # if count > length - cmova rdx, rsi # count = length - mov rax, rdi # start with source ptr - add rax, rsi # point to end - sub rax, rdx # back up by count - ret # rdx already has the count - -# _rt_mid - Extract substring (MID$ function) -# Returns a substring starting at position START for COUNT characters. -# Positions are 1-based (BASIC convention). Zero-copy operation. -# -# Arguments: -# rdi = source string pointer -# rsi = source string length -# rdx = start position (1-based) -# rcx = count (-1 means "rest of string") -# -# Returns: -# rax = pointer to start of result -# rdx = result length -# -# Edge cases: -# - start > length: returns empty string -# - count > remaining: returns rest of string -# - count < 0: returns rest of string from start position -.globl _rt_mid -_rt_mid: - dec rdx # Convert to 0-based index - cmp rdx, rsi # If start >= length - jae .Lmid_empty # return empty string - mov rax, rdi - add rax, rdx # result ptr = src + start - sub rsi, rdx # remaining = length - start - cmp rcx, 0 # If count < 0 (means "rest") - jl .Lmid_rest - cmp rcx, rsi # If count > remaining - cmova rcx, rsi # count = remaining - mov rdx, rcx # result length = count - ret -.Lmid_rest: - mov rdx, rsi # result length = remaining - ret -.Lmid_empty: - mov rax, rdi # point to original (arbitrary, length is 0) - xor rdx, rdx # length = 0 - ret - -# _rt_instr - Find substring position (INSTR function) -# Searches for needle in haystack, optionally starting at a given position. -# Returns 1-based position of first match, or 0 if not found. -# -# Arguments: -# rdi = haystack pointer -# rsi = haystack length -# rdx = needle pointer -# rcx = needle length -# r8 = start position (1-based) -# -# Returns: -# rax = position (1-based) or 0 if not found -# -# Algorithm: -# 1. Adjust haystack pointer and length based on start position -# 2. At each position, use memcmp to check for match -# 3. If match found, return 1-based position -# 4. If no more room for needle, return 0 -# -# Register usage (callee-saved registers for surviving memcmp calls): -# rbx = current position (0-based) -# r12 = current haystack pointer -# r13 = remaining haystack length -# r14 = needle pointer -# r15 = needle length -.globl _rt_instr -_rt_instr: - push rbp - mov rbp, rsp - # Save callee-saved registers (memcmp will clobber caller-saved ones) - push rbx - push r12 - push r13 - push r14 - push r15 - sub rsp, 8 # Align stack for calls (6 pushes = 48 bytes, need +8 for 16-byte alignment) - # Move arguments to callee-saved registers - mov r12, rdi # haystack ptr - mov r13, rsi # haystack len - mov r14, rdx # needle ptr - mov r15, rcx # needle len - mov rbx, r8 # start position (1-based) - # A start below 1 would move the search pointer backwards out of the - # buffer; GW-BASIC calls that an illegal argument. - cmp rbx, 1 - jl .Linstr_badstart - # Adjust for start position - dec rbx # convert to 0-based - # A start past the end finds nothing. Without this the `sub` below drove - # the remaining length negative -- enormous, unsigned -- so the "room for - # the needle" test passed and memcmp read past the end of the string. - cmp rbx, r13 - jae .Linstr_not_found - add r12, rbx # advance haystack ptr - sub r13, rbx # reduce remaining length - # Special case: empty needle matches at current position - test r15, r15 - jz .Linstr_at_start -.Linstr_loop: - # Check if enough room for needle - cmp r13, r15 - jb .Linstr_not_found # not enough chars remaining - # Compare: memcmp(haystack_pos, needle, needle_len) - mov rdi, r12 # current position in haystack - mov rsi, r14 # needle - mov rdx, r15 # needle length - call memcmp - test eax, eax - jz .Linstr_found # memcmp returns 0 if equal - # Not found at this position, advance - inc r12 # next position - dec r13 # one less char remaining - inc rbx # increment position counter - jmp .Linstr_loop -.Linstr_found: - mov rax, rbx - add rax, 1 # convert to 1-based - jmp .Linstr_done -.Linstr_at_start: - # Empty needle: return current position - mov rax, rbx - add rax, 1 # convert to 1-based - jmp .Linstr_done -.Linstr_not_found: - xor rax, rax # return 0 - jmp .Linstr_done -.Linstr_badstart: - lea rdi, [rip + _err_domain] - xor esi, esi - call _rt_error - xor eax, eax # "not found" when a handler traps it - jmp .Linstr_done -.Linstr_done: - # Restore stack and callee-saved registers - add rsp, 8 # Restore stack alignment - pop r15 - pop r14 - pop r13 - pop r12 - pop rbx - leave - ret - -# _rt_strcat - Concatenate two strings (+ operator) -# Creates a new string by concatenating left and right strings. -# Allocates new memory for the result using malloc. -# -# Arguments: -# rdi = left string pointer -# rsi = left string length -# rdx = right string pointer -# rcx = right string length -# -# Returns: -# rax = pointer to new string (malloc'd) -# rdx = total length -# -# Memory: Caller is responsible for eventually freeing the result. -# In practice, BASIC programs don't free strings (simple memory model). -# -# Register usage: -# r12 = left ptr (saved) -# r13 = left len -# r14 = right ptr -# r15 = right len -.globl _rt_strcat -_rt_strcat: - push rbp - mov rbp, rsp - push r12 - push r13 - push r14 - push r15 - sub rsp, 16 # Allocate aligned space for temp storage - - # Save arguments in callee-saved registers - mov r12, rdi # left ptr - mov r13, rsi # left len - mov r14, rdx # right ptr - mov r15, rcx # right len - - # Allocate memory: malloc(left_len + right_len + 1) - # +1 for null terminator (for safety, though we track length) - lea rdi, [rsi + rcx + 1] - call malloc # returns ptr in rax - - # Copy left string: memcpy(result, left, left_len) - mov QWORD PTR [rsp], rax # save result ptr (aligned) - mov rdi, rax # dest = malloc result - mov rsi, r12 # src = left ptr - mov rdx, r13 # len = left len - call memcpy - - # Copy right string: memcpy(result + left_len, right, right_len) - mov rdi, QWORD PTR [rsp] # restore result ptr - add rdi, r13 # dest = result + left_len - mov rsi, r14 # src = right ptr - mov rdx, r15 # len = right len - call memcpy - - # Null terminate (for safety) - mov rax, QWORD PTR [rsp] # restore result ptr - lea rcx, [r13 + r15] # total length - mov BYTE PTR [rax + rcx], 0 - - # Return: rax = ptr (already set), rdx = total length - mov rdx, rcx - - add rsp, 16 # Deallocate temp storage - pop r15 - pop r14 - pop r13 - pop r12 - leave - ret - -# _rt_strcmp - Compare two BASIC strings -# BASIC strings are (ptr, len) pairs and are not null-terminated, so libc strcmp -# cannot be used. Compares lexicographically by unsigned byte value, then by -# length when one string is a prefix of the other -- so "ab" < "abc". -# -# Arguments: -# rdi = left pointer, rsi = left length -# rdx = right pointer, rcx = right length -# -# Returns: -# eax < 0 if left < right, 0 if equal, > 0 if left > right (like memcmp) -# -# A length of 0 is valid and means the empty string; the pointer is then never -# dereferenced, so an unassigned (NULL, 0) string compares correctly. -.globl _rt_strcmp -_rt_strcmp: - push rbp - mov rbp, rsp - - # r8 = number of bytes to compare = min(left_len, right_len) - mov r8, rsi - cmp r8, rcx - jbe .Lstrcmp_have_min - mov r8, rcx -.Lstrcmp_have_min: - - xor r9, r9 # r9 = byte index - jmp .Lstrcmp_check -.Lstrcmp_loop: - movzx eax, BYTE PTR [rdi + r9] - movzx r10d, BYTE PTR [rdx + r9] - cmp eax, r10d - jne .Lstrcmp_differ - inc r9 -.Lstrcmp_check: - cmp r9, r8 - jb .Lstrcmp_loop - - # Common prefix is equal: the shorter string sorts first. - xor eax, eax - cmp rsi, rcx - je .Lstrcmp_done # same length -> equal - jb .Lstrcmp_shorter - mov eax, 1 # left is longer -> greater - jmp .Lstrcmp_done -.Lstrcmp_shorter: - mov eax, -1 - jmp .Lstrcmp_done - -.Lstrcmp_differ: - # eax and r10d hold the differing bytes; return their difference. - sub eax, r10d - -.Lstrcmp_done: - leave - ret - -# Additional string functions -# -# These were all reachable only through the old "unknown $-suffixed call must -# be an array" heuristic, so every one of them aborted the compiler. -# -# Functions that shorten a string (LTRIM$, RTRIM$) return an interior pointer -# into the original rather than allocating, which is sound because BASIC -# strings are (ptr, len) pairs and are never mutated in place. - -# _rt_space - SPACE$(n): a string of n spaces -# Arguments: rdi = count -# Returns: rax = pointer, rdx = length -.globl _rt_space -_rt_space: - push rbp - mov rbp, rsp - push rbx - sub rsp, 8 - - mov rbx, rdi - cmp rbx, 0 - jge .Lspace_ok - xor rbx, rbx # a negative count yields the empty string -.Lspace_ok: - lea rdi, [rbx + 1] - call malloc - - # memset returns its destination, so the pointer needs no saving -- and - # saving it with a bare push would leave rsp misaligned for the call. - mov rdi, rax # dest - mov esi, ' ' # fill byte - mov rdx, rbx # count - call memset - mov rdx, rbx - - add rsp, 8 - pop rbx - leave - ret - -# _rt_fixed - Fit a string to a declared width, for STRING * n -# -# A fixed-length string always holds exactly its declared number of characters: -# a shorter value is padded with spaces on the right, a longer one is truncated. -# Assignment used to store the source verbatim, so `STRING * 5` held whatever it -# was given and the declared width meant nothing. -# -# A fresh buffer rather than an interior pointer, because the result is stored -# and the source may be a temporary. -# -# Arguments: rdi = source pointer, rsi = source length, rdx = width -# Returns: rax = pointer, rdx = width -.globl _rt_fixed -_rt_fixed: - push rbp - mov rbp, rsp - push rbx - push r12 - push r13 - push r14 - - mov r12, rdi # source pointer - mov r13, rsi # source length - mov rbx, rdx # width - cmp rbx, 0 - jge .Lfixed_ok - xor rbx, rbx # a non-positive width yields the empty string -.Lfixed_ok: - # Copy at most `width` bytes. - mov r14, r13 - cmp r14, rbx - jbe .Lfixed_have_n - mov r14, rbx -.Lfixed_have_n: - - lea rdi, [rbx + 1] # room for the NUL the string helpers expect - call malloc - - # Space-fill the whole width first, then overwrite the prefix; memset - # returns its destination, so the pointer survives without a save. - mov rdi, rax - mov esi, ' ' - mov rdx, rbx - call memset - - # memcpy(dest, src, min(len, width)). rax still holds the buffer. - mov rdi, rax - mov rsi, r12 - mov rdx, r14 - mov r13, rax # keep the buffer across the call; a push here - call memcpy # would leave rsp misaligned - mov rax, r13 - - mov rdx, rbx # the result is always `width` long - - pop r14 - pop r13 - pop r12 - pop rbx - leave - ret - -# _rt_string_n - STRING$(n, ch): a string of n copies of one character -# Arguments: rdi = count, rsi = character code -# Returns: rax = pointer, rdx = length -.globl _rt_string_n -_rt_string_n: - push rbp - mov rbp, rsp - push rbx - push r12 - - mov rbx, rdi - mov r12, rsi - cmp rbx, 0 - jge .Lstringn_ok - xor rbx, rbx -.Lstringn_ok: - lea rdi, [rbx + 1] - call malloc - - # memset returns its destination; see _rt_space. - mov rdi, rax - mov esi, r12d - mov rdx, rbx - call memset - mov rdx, rbx - - pop r12 - pop rbx - leave - ret - -# _rt_ltrim - LTRIM$(s): drop leading spaces -# Arguments: rdi = pointer, rsi = length -# Returns: rax = pointer, rdx = length (an interior view, not a copy) -.globl _rt_ltrim -_rt_ltrim: - xor rcx, rcx -.Lltrim_loop: - cmp rcx, rsi - jae .Lltrim_done - cmp BYTE PTR [rdi + rcx], ' ' - jne .Lltrim_done - inc rcx - jmp .Lltrim_loop -.Lltrim_done: - lea rax, [rdi + rcx] - mov rdx, rsi - sub rdx, rcx - ret - -# _rt_rtrim - RTRIM$(s): drop trailing spaces -# Arguments: rdi = pointer, rsi = length -# Returns: rax = pointer, rdx = length -.globl _rt_rtrim -_rt_rtrim: - mov rdx, rsi -.Lrtrim_loop: - test rdx, rdx - jz .Lrtrim_done - cmp BYTE PTR [rdi + rdx - 1], ' ' - jne .Lrtrim_done - dec rdx - jmp .Lrtrim_loop -.Lrtrim_done: - mov rax, rdi - ret - -# _rt_ucase / _rt_lcase - UCASE$(s) / LCASE$(s) -# These must copy: the source may be a .data literal shared with other uses. -# -# Arguments: rdi = pointer, rsi = length -# Returns: rax = pointer, rdx = length -.globl _rt_ucase -_rt_ucase: - mov r8b, 1 # r8b != 0 selects upper-casing - jmp _rt_case_convert - -.globl _rt_lcase -_rt_lcase: - xor r8b, r8b - # An explicit jump, not a fall-through: each helper is emitted into its - # own section so the linker can discard the ones a program never calls, - # and sections are not laid out in source order. - jmp _rt_case_convert - -_rt_case_convert: - push rbp - mov rbp, rsp - push rbx - push r12 - push r13 - sub rsp, 8 - - mov rbx, rdi # source - mov r12, rsi # length - mov r13d, r8d # direction - - lea rdi, [r12 + 1] - call malloc - - xor rcx, rcx -.Lcase_loop: - cmp rcx, r12 - jae .Lcase_done - mov dl, BYTE PTR [rbx + rcx] - test r13b, r13b - jz .Lcase_lower - cmp dl, 'a' - jb .Lcase_store - cmp dl, 'z' - ja .Lcase_store - sub dl, 32 - jmp .Lcase_store -.Lcase_lower: - cmp dl, 'A' - jb .Lcase_store - cmp dl, 'Z' - ja .Lcase_store - add dl, 32 -.Lcase_store: - mov BYTE PTR [rax + rcx], dl - inc rcx - jmp .Lcase_loop -.Lcase_done: - mov rdx, r12 - - add rsp, 8 - pop r13 - pop r12 - pop rbx - leave - ret - -# _rt_hex / _rt_oct - HEX$(n) / OCT$(n) -# Arguments: rdi = value (already truncated to an integer) -# Returns: rax = pointer to a fresh heap copy, rdx = length -.globl _rt_hex -_rt_hex: - push rbp - mov rbp, rsp - sub rsp, 16 - mov rdx, rdi - lea rdi, [rip + _str_buf] - lea rsi, [rip + _fmt_hex] - xor eax, eax - call sprintf - lea rdi, [rip + _str_buf] - mov rsi, rax - leave - jmp _rt_strdup - -.globl _rt_oct -_rt_oct: - push rbp - mov rbp, rsp - sub rsp, 16 - mov rdx, rdi - lea rdi, [rip + _str_buf] - lea rsi, [rip + _fmt_oct] - xor eax, eax - call sprintf - lea rdi, [rip + _str_buf] - mov rsi, rax - leave - jmp _rt_strdup - -# _rt_strdup - Copy a string onto the heap -# String assignment copies, so that mutating one variable cannot be seen -# through another -- or, worse, through the shared .data literal a string -# constant points at. Without this, MID$(A$,1,1) = "J" after A$ = "HELLO" -# would rewrite the literal for every other use of "HELLO" in the program. -# -# Arguments: rdi = pointer, rsi = length -# Returns: rax = pointer, rdx = length -.globl _rt_strdup -_rt_strdup: - push rbp - mov rbp, rsp - push rbx - push r12 - - mov rbx, rdi - mov r12, rsi - - lea rdi, [r12 + 1] - call malloc - - # memcpy returns its destination; see _rt_space. - mov rdi, rax - mov rsi, rbx - mov rdx, r12 - call memcpy - mov rdx, r12 - - pop r12 - pop rbx - leave - ret - -# _rt_mid_assign - MID$(s, start [, len]) = value -# Overwrites characters of the target in place. The target's length never -# changes: at most `len` characters are replaced, and never past the end. -# Positions are 1-based. -# -# Arguments: -# rdi = target pointer, rsi = target length -# rdx = start (1-based), rcx = maximum characters to replace -# r8 = source pointer, r9 = source length -# -# Returns: nothing -.globl _rt_mid_assign -_rt_mid_assign: - # Clamp the count to the source length. - cmp rcx, r9 - jbe .Lmid_have_count - mov rcx, r9 -.Lmid_have_count: - - # Convert the 1-based start to an index; a start below 1 writes nothing. - cmp rdx, 1 - jl .Lmid_done - dec rdx - - xor r10, r10 # characters copied -.Lmid_loop: - cmp r10, rcx - jae .Lmid_done - lea r11, [rdx + r10] - cmp r11, rsi # stop at the end of the target - jae .Lmid_done - mov al, BYTE PTR [r8 + r10] - mov BYTE PTR [rdi + r11], al - inc r10 - jmp .Lmid_loop -.Lmid_done: - ret diff --git a/src/runtime/sysv/using.s b/src/runtime/sysv/using.s deleted file mode 100644 index 29b61b8..0000000 --- a/src/runtime/sysv/using.s +++ /dev/null @@ -1,772 +0,0 @@ -# BASIC Runtime: PRINT USING field output -# -# _rt_print_using_num and _rt_print_using_str render one field each; the -# format itself is read at run time by _rt_using_next, below. -# -# Flag bits, as _rt_using_next sets them for _rt_print_using_num: -# 1 COMMA group the integer part in thousands -# 2 DOLLAR prefix a currency sign, floated against the digits -# 4 STAR fill with '*' rather than spaces -# 8 TRAILING_SIGN place the sign after the number -# 16 FORCE_SIGN always show a sign, '+' for positives -# 32 EXPONENTIAL render in exponential form - -.equ USING_COMMA, 1 -.equ USING_DOLLAR, 2 -.equ USING_STAR, 4 -.equ USING_TRAIL_SIGN, 8 -.equ USING_FORCE_SIGN, 16 -.equ USING_EXP, 32 - -.data -_using_fmt_f: .asciz "%.*f" -_using_fmt_e: .asciz "%.*E" -# Buffer sizes are proved, not guessed. A double's widest %f rendering is a -# sign, 309 integer digits, a point and USING_MAX_DEC fractional digits -- 351 -# characters -- so 512 bytes cannot be overrun at any clamped precision. -# Comma grouping adds at most one separator per three integer digits, and the -# decorations add a sign, a currency symbol and an overflow marker. -.equ USING_MAX_WIDTH, 255 # must match using::MAX_WIDTH -.equ USING_MAX_DEC, 40 # must match using::MAX_DECIMALS - -# 3.5K of zeros, which is why these are .bss -- see data_defs.s. -.bss -.p2align 3 -_using_raw: .skip 512 # sprintf target -_using_work: .skip 1024 # after comma insertion -_using_out: .skip 2048 # after sign/currency, padded to the width - -.text - -# _rt_print_using_num - Render one numeric field -# Arguments, in order (width, decimals, flags, value): -# rdi = field width in characters -# rsi = digits after the decimal point -# rdx = flags -# xmm0 = value, the first float argument -# -# Returns: nothing -# -# A value too wide for its field is printed in full, preceded by '%', which is -# what GW-BASIC does rather than truncating. -.globl _rt_print_using_num -_rt_print_using_num: - push rbp - mov rbp, rsp - push rbx - push r12 - push r13 - push r14 - push r15 - sub rsp, 24 # keeps rsp 16-byte aligned - - mov r12, rdi # width - mov r13, rsi # decimals - mov r14, rdx # flags - movsd QWORD PTR [rbp - 56], xmm0 # value - - # Clamp both to what the buffers below are sized for. The compiler already - # clamps them, so this only guards against a hand-written or future caller; - # without it a value such as 1D300 in a "##.##" field ran sprintf past the - # end of _using_raw and destroyed everything after it in .data. - cmp r13, USING_MAX_DEC - jbe .Luse_num_dec_ok - mov r13, USING_MAX_DEC -.Luse_num_dec_ok: - cmp r12, USING_MAX_WIDTH - jbe .Luse_num_width_ok - mov r12, USING_MAX_WIDTH -.Luse_num_width_ok: - - # A trailing sign, or a forced sign we place ourselves, means the number - # itself is formatted without one. - xor r15d, r15d # r15b = sign character, 0 = none - mov rax, r14 - and rax, USING_TRAIL_SIGN | USING_FORCE_SIGN - test rax, rax - jz .Luse_num_format - - # Decide the sign character and format the magnitude. - xorpd xmm1, xmm1 - movsd xmm0, QWORD PTR [rbp - 56] - ucomisd xmm0, xmm1 - jae .Luse_num_positive - mov r15d, '-' - # value = -value - mov rax, 0x8000000000000000 - movq xmm1, rax - xorpd xmm0, xmm1 - movsd QWORD PTR [rbp - 56], xmm0 - jmp .Luse_num_format -.Luse_num_positive: - test r14, USING_FORCE_SIGN - jz .Luse_num_format - mov r15d, '+' - -.Luse_num_format: - # sprintf(_using_raw, "%.*f" or "%.*E", decimals, value) - lea rdi, [rip + _using_raw] - lea rsi, [rip + _using_fmt_f] - test r14, USING_EXP - jz .Luse_num_have_fmt - lea rsi, [rip + _using_fmt_e] -.Luse_num_have_fmt: - mov edx, r13d # precision - movsd xmm0, QWORD PTR [rbp - 56] - mov eax, 1 - call sprintf - mov rbx, rax # rbx = length of the raw text - - # Copy into the work buffer, inserting commas in the integer part when - # asked. Working right-to-left makes the grouping trivial. - lea rdi, [rip + _using_work] - lea rsi, [rip + _using_raw] - test r14, USING_COMMA - jnz .Luse_num_commas - # Plain copy. - xor rcx, rcx -.Luse_num_copy: - cmp rcx, rbx - jae .Luse_num_copied - mov al, BYTE PTR [rsi + rcx] - mov BYTE PTR [rdi + rcx], al - inc rcx - jmp .Luse_num_copy -.Luse_num_copied: - mov r8, rbx # r8 = work length - jmp .Luse_num_decorate - -.Luse_num_commas: - # Locate the end of the integer part: the '.' or 'E', else the whole text. - xor rcx, rcx -.Luse_num_find_dot: - cmp rcx, rbx - jae .Luse_num_dot_found - mov al, BYTE PTR [rsi + rcx] - cmp al, '.' - je .Luse_num_dot_found - cmp al, 'E' - je .Luse_num_dot_found - inc rcx - jmp .Luse_num_find_dot -.Luse_num_dot_found: - mov r9, rcx # r9 = one past the last integer digit - - # Skip any leading sign so it is not counted as a digit. - xor rcx, rcx - cmp rbx, 0 - je .Luse_num_no_sign_skip - mov al, BYTE PTR [rsi] - cmp al, '-' - je .Luse_num_skip_one - cmp al, '+' - jne .Luse_num_no_sign_skip -.Luse_num_skip_one: - mov rcx, 1 -.Luse_num_no_sign_skip: - mov r10, rcx # r10 = index of the first integer digit - - # Single left-to-right pass: a separator goes before digit i whenever the - # number of digits remaining, (r9 - i), is a positive multiple of 3. - xor r8, r8 # output length - xor rcx, rcx -.Luse_num_ins: - cmp rcx, rbx - jae .Luse_num_ins_done - cmp rcx, r9 - jae .Luse_num_ins_copy # past the integer part: copy verbatim - cmp rcx, r10 - jbe .Luse_num_ins_copy # first digit (or sign) never gets a separator - mov rdx, r9 - sub rdx, rcx # digits remaining before the decimal point - mov rax, rdx - xor rdx, rdx - mov r11, 3 - div r11 # rdx = (r9 - rcx) mod 3 - test rdx, rdx - jnz .Luse_num_ins_copy - lea rdx, [rip + _using_work] - mov BYTE PTR [rdx + r8], ',' - inc r8 -.Luse_num_ins_copy: - lea rdx, [rip + _using_work] - mov al, BYTE PTR [rsi + rcx] - mov BYTE PTR [rdx + r8], al - inc r8 - inc rcx - jmp .Luse_num_ins -.Luse_num_ins_done: - -.Luse_num_decorate: - # r8 = length in _using_work. Prepend '$' and/or the leading sign. - lea rdi, [rip + _using_out] - xor r9, r9 # output length - - test r15b, r15b - jz .Luse_num_no_lead_sign - test r14, USING_TRAIL_SIGN - jnz .Luse_num_no_lead_sign - mov BYTE PTR [rdi + r9], r15b - inc r9 -.Luse_num_no_lead_sign: - - test r14, USING_DOLLAR - jz .Luse_num_no_dollar - mov BYTE PTR [rdi + r9], '$' - inc r9 -.Luse_num_no_dollar: - - lea rsi, [rip + _using_work] - xor rcx, rcx -.Luse_num_body: - cmp rcx, r8 - jae .Luse_num_body_done - mov al, BYTE PTR [rsi + rcx] - mov BYTE PTR [rdi + r9], al - inc r9 - inc rcx - jmp .Luse_num_body -.Luse_num_body_done: - - # A trailing sign is a column of its own, and a positive number leaves it - # blank, as GW-BASIC and QuickBASIC do: "###-" prints 5 as " 5 " beside - # -5's " 5-", so the digits line up. Writing nothing there padded the - # positive on the left instead, one column out of line. - test r14, USING_TRAIL_SIGN - jz .Luse_num_no_trail - mov al, r15b - test al, al - jnz .Luse_num_trail_char - mov al, ' ' -.Luse_num_trail_char: - mov BYTE PTR [rdi + r9], al - inc r9 -.Luse_num_no_trail: - - # Pad on the left to the field width, or mark an overflow with '%'. - cmp r9, r12 - jae .Luse_num_overflow - - mov rcx, r12 - sub rcx, r9 # pad count - mov al, ' ' - test r14, USING_STAR - jz .Luse_num_pad_char - mov al, '*' -.Luse_num_pad_char: - # Shift the text right by rcx, then fill the gap. x86 addressing has no - # three-register form, so the shifted destination base is precomputed. - lea r8, [rdi + rcx] - mov rdx, r9 -.Luse_num_shift: - cmp rdx, 0 - jle .Luse_num_shift_done - dec rdx - mov r11b, BYTE PTR [rdi + rdx] - mov BYTE PTR [r8 + rdx], r11b - jmp .Luse_num_shift -.Luse_num_shift_done: - xor rdx, rdx -.Luse_num_fill: - cmp rdx, rcx - jae .Luse_num_fill_done - mov BYTE PTR [rdi + rdx], al - inc rdx - jmp .Luse_num_fill -.Luse_num_fill_done: - mov r9, r12 - jmp .Luse_num_write - -.Luse_num_overflow: - je .Luse_num_write # exactly the width: no marker needed - # Too wide: shift right by one and write '%' in front. - mov rdx, r9 -.Luse_num_ovf_shift: - cmp rdx, 0 - jle .Luse_num_ovf_done - dec rdx - mov r11b, BYTE PTR [rdi + rdx] - mov BYTE PTR [rdi + rdx + 1], r11b - jmp .Luse_num_ovf_shift -.Luse_num_ovf_done: - mov BYTE PTR [rdi], '%' - inc r9 - -.Luse_num_write: - lea rdi, [rip + _using_out] - mov rsi, r9 - call .Luse_out - - add rsp, 24 - pop r15 - pop r14 - pop r13 - pop r12 - pop rbx - pop rbp - ret - -# _rt_print_using_str - Render one string field -# Arguments: -# rdi = string pointer -# rsi = string length -# rdx = field width, or 0 for "the whole string" -# -# A string shorter than the field is padded on the right with spaces; a longer -# one is truncated, as GW-BASIC does. -.globl _rt_print_using_str -_rt_print_using_str: - push rbp - mov rbp, rsp - push rbx - push r12 - push r13 - sub rsp, 8 - - mov rbx, rdi # ptr - mov r12, rsi # len - mov r13, rdx # width - - # Clamp to the buffer's capacity, as in _rt_print_using_num. - cmp r13, USING_MAX_WIDTH - jbe .Luse_str_width_ok - mov r13, USING_MAX_WIDTH -.Luse_str_width_ok: - - test r13, r13 - jz .Luse_str_whole # width 0: print the string as-is - - # Copy up to `width` characters, then pad with spaces. - lea rdi, [rip + _using_out] - xor rcx, rcx -.Luse_str_copy: - cmp rcx, r13 - jae .Luse_str_copied - cmp rcx, r12 - jae .Luse_str_pad - mov al, BYTE PTR [rbx + rcx] - mov BYTE PTR [rdi + rcx], al - inc rcx - jmp .Luse_str_copy -.Luse_str_pad: - mov BYTE PTR [rdi + rcx], ' ' - inc rcx - jmp .Luse_str_copy -.Luse_str_copied: - lea rdi, [rip + _using_out] - mov rsi, r13 - call .Luse_out - jmp .Luse_str_done - -.Luse_str_whole: - mov rdi, rbx - mov rsi, r12 - call .Luse_out - -.Luse_str_done: - add rsp, 8 - pop r13 - pop r12 - pop rbx - pop rbp - ret - -# --------------------------------------------------------------------------- -# PRINT USING, interpreted at run time -# -# The format is read here as the statement runs, so it may be any string -# expression and the output may go to a file. It used to be parsed when -# compiling, which allowed only a literal and only the console; one reading -# here, for every format, also means there is no second parser to disagree -# with this one. -# -# _rt_using_start names the file and the format; then each value goes through -# _rt_using_num or _rt_using_str, which print the literal text up to the next -# field and the value in it; _rt_using_end prints the text after the last -# field used, up to the next one. A format runs out before the values does -# what GW-BASIC does: it starts again from the beginning. A format with no -# field at all is Illegal function call, and a value of the wrong kind for its -# field is Type mismatch. -# --------------------------------------------------------------------------- - -.bss -.p2align 3 -_using_file: .skip 8 # where the output goes -_using_fmt: .skip 8 # the format -_using_len: .skip 8 -_using_pos: .skip 8 # how far through it -_using_found: .skip 8 # a field was taken since the format began -_using_fw: .skip 8 # the field just found: width, -_using_fd: .skip 8 # digits after the point, -_using_ff: .skip 8 # and flags, as _rt_print_using_num takes them - -.text - -# Write what _rt_print_using_num and _rt_print_using_str laid out to the file -# the statement names. Reached by `call`; returns from _rt_file_print_string. -# rdi = pointer, rsi = length -.Luse_out: - mov rdx, rsi - mov rsi, rdi - mov rdi, QWORD PTR [rip + _using_file] - jmp _rt_file_print_string - -# _rt_using_start - Begin a PRINT USING statement -# -# Arguments: rdi = file number (0 = the console), rsi = format pointer, -# rdx = format length -# Returns: nothing -.globl _rt_using_start -_rt_using_start: - mov QWORD PTR [rip + _using_file], rdi - mov QWORD PTR [rip + _using_fmt], rsi - mov QWORD PTR [rip + _using_len], rdx - mov QWORD PTR [rip + _using_pos], 0 - mov QWORD PTR [rip + _using_found], 0 - ret - -# _rt_using_next - Print literal text up to the next field, and take the field -# -# The fields are GW-BASIC's, as LANGREF lists them: `!`, `&` and `\ \` for a -# string; for a number, digit positions `#` with an optional `.`, `,` among -# the digits, a leading `+`, `**`, `$$` or `**$`, a trailing `^^^^`, and a -# trailing `+` or `-`. `_` makes the next character literal, and anything that -# is not a field is printed as it is. -# -# Arguments: edi = 1 at the end of the statement: stop before a field instead -# of taking it, and at the end of the format instead of starting it -# again -# Returns: rax = 1 a numeric field, 2 a string field, 0 neither; the field's -# width, digits and flags are in _using_fw, _using_fd, _using_ff -.globl _rt_using_next -_rt_using_next: - push rbp - mov rbp, rsp - push rbx - push r12 - push r13 - push r14 - push r15 - sub rsp, 8 - mov r14d, edi # stop mode - mov rbx, QWORD PTR [rip + _using_fmt] - mov r12, QWORD PTR [rip + _using_len] - mov r13, QWORD PTR [rip + _using_pos] - -.Lun_loop: - cmp r13, r12 - jb .Lun_char - test r14d, r14d - jnz .Lun_none # the statement's end: done - cmp QWORD PTR [rip + _using_found], 0 - je .Lun_no_field # a whole pass found nothing to fill - mov QWORD PTR [rip + _using_found], 0 - xor r13d, r13d # use the format again from its start - jmp .Lun_loop - -.Lun_char: - movzx eax, BYTE PTR [rbx + r13] - cmp al, 95 # '_' makes the next character literal - jne .Lun_bang - lea rcx, [r13 + 1] - cmp rcx, r12 - jae .Lun_literal - movzx eax, BYTE PTR [rbx + r13 + 1] - add r13, 2 - jmp .Lun_emit -.Lun_bang: - cmp al, 33 # '!': one character - jne .Lun_amp - mov r9d, 1 - lea r15, [r13 + 1] - jmp .Lun_string -.Lun_amp: - cmp al, 38 # '&': the whole string - jne .Lun_backslash - xor r9d, r9d - lea r15, [r13 + 1] - jmp .Lun_string -.Lun_backslash: - cmp al, 92 # '\': spaces, then '\' - jne .Lun_numeric_start - lea r15, [r13 + 1] -.Lun_bs_scan: - cmp r15, r12 - jae .Lun_literal - movzx ecx, BYTE PTR [rbx + r15] - cmp ecx, 32 - jne .Lun_bs_end - inc r15 - jmp .Lun_bs_scan -.Lun_bs_end: - cmp ecx, 92 - jne .Lun_literal - mov r9, r15 - sub r9, r13 - inc r9 # the two backslashes and the gap - inc r15 - cmp r9, USING_MAX_WIDTH - jbe .Lun_string - mov r9d, USING_MAX_WIDTH - jmp .Lun_string - -.Lun_numeric_start: - cmp al, 35 # '#' - je .Lun_numeric - cmp al, 43 # '+' - je .Lun_numeric - cmp al, 36 # '$' - je .Lun_numeric - cmp al, 42 # '*' - jne .Lun_literal -.Lun_numeric: - mov r15, r13 # i - xor r8d, r8d # flags - xor r9d, r9d # width - cmp BYTE PTR [rbx + r15], 43 - jne .Lun_n_fill - or r8d, USING_FORCE_SIGN # a leading '+' - inc r9 - inc r15 -.Lun_n_fill: - lea rcx, [r15 + 1] - cmp rcx, r12 - jae .Lun_n_digits - cmp BYTE PTR [rbx + r15], 42 - jne .Lun_n_dollar - cmp BYTE PTR [rbx + r15 + 1], 42 - jne .Lun_n_dollar - or r8d, USING_STAR # '**', and '**$' - add r9, 2 - add r15, 2 - cmp r15, r12 - jae .Lun_n_digits - cmp BYTE PTR [rbx + r15], 36 - jne .Lun_n_digits - or r8d, USING_DOLLAR - inc r9 - inc r15 - jmp .Lun_n_digits -.Lun_n_dollar: - cmp BYTE PTR [rbx + r15], 36 - jne .Lun_n_digits - cmp BYTE PTR [rbx + r15 + 1], 36 - jne .Lun_n_digits - or r8d, USING_DOLLAR # '$$': a sign and a digit - add r9, 2 - add r15, 2 -.Lun_n_digits: - xor r10d, r10d # digit positions before the point - xor edx, edx # 1 when there is a ',' -.Lun_n_digit: - cmp r15, r12 - jae .Lun_n_digits_end - movzx eax, BYTE PTR [rbx + r15] - cmp al, 35 - jne .Lun_n_comma - inc r10 - inc r9 - inc r15 - jmp .Lun_n_digit -.Lun_n_comma: - cmp al, 44 - jne .Lun_n_digits_end - or r8d, USING_COMMA - mov edx, 1 - inc r15 - jmp .Lun_n_digit -.Lun_n_digits_end: - # A comma takes no position itself; the field grows by the separators - # its digits will need. - test edx, edx - jz .Lun_n_grouped - mov rax, r10 - test rax, rax - jz .Lun_n_grouped - dec rax - xor edx, edx - mov ecx, 3 - div rcx - add r9, rax -.Lun_n_grouped: - test r10, r10 - jnz .Lun_n_point - test r9, r9 - jz .Lun_n_fail # nothing here formed a field -.Lun_n_point: - xor r11d, r11d # digits after the point - cmp r15, r12 - jae .Lun_n_exp - cmp BYTE PTR [rbx + r15], 46 - jne .Lun_n_exp - lea rcx, [r15 + 1] - xor eax, eax -.Lun_n_frac: - cmp rcx, r12 - jae .Lun_n_frac_end - cmp BYTE PTR [rbx + rcx], 35 - jne .Lun_n_frac_end - inc eax - inc rcx - jmp .Lun_n_frac -.Lun_n_frac_end: - test eax, eax - jz .Lun_n_exp # a point with no digits is not part of it - mov r11d, eax - cmp r11, USING_MAX_DEC - jbe .Lun_n_frac_ok - mov r11d, USING_MAX_DEC -.Lun_n_frac_ok: - lea r9, [r9 + r11 + 1] # the point and its digits - mov r15, rcx -.Lun_n_exp: - test r10, r10 - jnz .Lun_n_exp_test - test r11, r11 - jz .Lun_n_fail # a field needs a digit somewhere -.Lun_n_exp_test: - lea rcx, [r15 + 3] - cmp rcx, r12 - jae .Lun_n_sign - cmp DWORD PTR [rbx + r15], 0x5E5E5E5E # "^^^^" - jne .Lun_n_sign - or r8d, USING_EXP - add r9, 4 - add r15, 4 -.Lun_n_sign: - cmp r15, r12 - jae .Lun_n_done - movzx eax, BYTE PTR [rbx + r15] - cmp al, 45 # a trailing '-' - je .Lun_n_trail - cmp al, 43 # or '+' - jne .Lun_n_done - or r8d, USING_FORCE_SIGN -.Lun_n_trail: - or r8d, USING_TRAIL_SIGN - inc r9 - inc r15 -.Lun_n_done: - cmp r9, USING_MAX_WIDTH - jbe .Lun_n_store - mov r9d, USING_MAX_WIDTH -.Lun_n_store: - test r14d, r14d - jnz .Lun_none - mov QWORD PTR [rip + _using_fw], r9 - mov QWORD PTR [rip + _using_fd], r11 - mov QWORD PTR [rip + _using_ff], r8 - mov r13, r15 - mov QWORD PTR [rip + _using_found], 1 - mov eax, 1 - jmp .Lun_ret -.Lun_n_fail: # not a field after all: the character is text -.Lun_literal: - movzx eax, BYTE PTR [rbx + r13] - inc r13 -.Lun_emit: - mov rdi, QWORD PTR [rip + _using_file] - mov esi, eax - call _rt_file_print_char - jmp .Lun_loop - -.Lun_string: # r9 = width (0 = the whole string), r15 = past it - test r14d, r14d - jnz .Lun_none - mov QWORD PTR [rip + _using_fw], r9 - mov r13, r15 - mov QWORD PTR [rip + _using_found], 1 - mov eax, 2 - jmp .Lun_ret - -.Lun_no_field: - lea rdi, [rip + _err_domain] - xor rsi, rsi - call _rt_error # returns only when trapped -.Lun_none: - xor eax, eax -.Lun_ret: - mov QWORD PTR [rip + _using_pos], r13 - add rsp, 8 - pop r15 - pop r14 - pop r13 - pop r12 - pop rbx - pop rbp - ret - -# _rt_using_num - PRINT USING: a numeric value -# -# Arguments: xmm0 = the value -# Returns: nothing -.globl _rt_using_num -_rt_using_num: - push rbp - mov rbp, rsp - sub rsp, 16 - movsd QWORD PTR [rbp - 8], xmm0 - xor edi, edi - call _rt_using_next - cmp eax, 1 - je .Luse_num_render - test eax, eax - jz .Luse_num_done # an error was raised and trapped - lea rdi, [rip + _err_typemismatch] - xor rsi, rsi - call _rt_error # a string field: returns only when trapped - jmp .Luse_num_done -.Luse_num_render: - mov rdi, QWORD PTR [rip + _using_fw] - mov rsi, QWORD PTR [rip + _using_fd] - mov rdx, QWORD PTR [rip + _using_ff] - movsd xmm0, QWORD PTR [rbp - 8] - call _rt_print_using_num -.Luse_num_done: - leave - ret - -# _rt_using_str - PRINT USING: a string value -# -# Arguments: rdi = pointer, rsi = length -# Returns: nothing -.globl _rt_using_str -_rt_using_str: - push rbp - mov rbp, rsp - sub rsp, 16 - mov QWORD PTR [rbp - 8], rdi - mov QWORD PTR [rbp - 16], rsi - xor edi, edi - call _rt_using_next - cmp eax, 2 - je .Luse_str_render - test eax, eax - jz .Luse_str_value_done # an error was raised and trapped - lea rdi, [rip + _err_typemismatch] - xor rsi, rsi - call _rt_error # a numeric field: returns only when trapped - jmp .Luse_str_value_done -.Luse_str_render: - mov rdi, QWORD PTR [rbp - 8] - mov rsi, QWORD PTR [rbp - 16] - mov rdx, QWORD PTR [rip + _using_fw] - call _rt_print_using_str -.Luse_str_value_done: - leave - ret - -# _rt_using_end - Finish a PRINT USING statement: the text after the last -# field used, up to the next one -# -# Arguments: none -# Returns: nothing -.globl _rt_using_end -_rt_using_end: - push rbp - mov rbp, rsp - sub rsp, 0 - mov edi, 1 - call _rt_using_next - leave - ret diff --git a/src/runtime/win64-native/data.s b/src/runtime/win64-native/data.s deleted file mode 100644 index 3d5669c..0000000 --- a/src/runtime/win64-native/data.s +++ /dev/null @@ -1,194 +0,0 @@ -# BASIC Runtime: DATA/READ/RESTORE Support (Win64 Native) -# -# The table holds each item as written; see the System V tree. -# -# Data Table Format: 16-byte entries of -# 0 quoted flag (1 if the item was written in quotes) -# 8 pointer to the item's text, NUL-terminated -# -# Global State: -# _data_table = Array of 16-byte entries (generated by compiler) -# _data_count = Number of entries in table -# _data_ptr = Current read position (0-based index) -# -# Win64 Calling Convention: -# - Args: rcx, rdx, r8, r9 -# - Callee-saved: rbx, rbp, rdi, rsi, r12-r15 -# - Shadow space: 32 bytes - -# _rt_read_number - READ into a numeric variable -# -# The item's text must be a number and nothing else; see the System V twin. -# -# Arguments: -# rcx = BASIC line number, for the diagnostic -# -# Returns: -# xmm0 = value as double; 0 when there is nothing to read -.globl _rt_read_number -_rt_read_number: - push rbp - mov rbp, rsp - push rbx - push r12 - push r13 - push r14 - sub rsp, 32 # shadow space; 16-byte aligned - mov r12, rcx # line number - mov rax, QWORD PTR [rip + _data_ptr] - cmp rax, QWORD PTR [rip + _data_count] - jae .Lread_num_none - inc QWORD PTR [rip + _data_ptr] - shl rax, 4 - lea rcx, [rip + _data_table] - add rcx, rax # the entry - cmp QWORD PTR [rcx], 0 - jne .Lread_num_syntax # quoted: a string, not a number - mov rbx, QWORD PTR [rcx + 8] # its text - mov rcx, rbx - call lstrlenA - mov r13, rax # its length - test r13, r13 - jz .Lread_num_zero # an empty item is 0 - mov rcx, rbx - mov rdx, r13 - call _rt_scan_number - test edx, edx - jnz .Lread_num_overflow - test rax, rax - jz .Lread_num_syntax - # Only blanks may follow the number. -.Lread_num_rest: - cmp rax, r13 - jae .Lread_num_done - movzx ecx, BYTE PTR [rbx + rax] - cmp ecx, 32 - je .Lread_num_blank - cmp ecx, 9 - jne .Lread_num_syntax -.Lread_num_blank: - inc rax - jmp .Lread_num_rest - -.Lread_num_none: - lea rcx, [rip + _err_outofdata] - jmp .Lread_num_raise -.Lread_num_syntax: - lea rcx, [rip + _err_syntax] - jmp .Lread_num_raise -.Lread_num_overflow: - lea rcx, [rip + _err_overflow] -.Lread_num_raise: - mov rdx, r12 # line - call _rt_error # returns only when trapped -.Lread_num_zero: - xorpd xmm0, xmm0 -.Lread_num_done: - add rsp, 32 - pop r14 - pop r13 - pop r12 - pop rbx - leave - ret - -# _rt_read_string - READ into a string variable: the item's text as written -# -# Arguments: -# rcx = BASIC line number, for the diagnostic -# -# Returns: -# rax = pointer to string data -# rdx = string length; an empty string when there is nothing to read -.globl _rt_read_string -_rt_read_string: - push rbp - mov rbp, rsp - push rbx - sub rsp, 40 # shadow space; 16-byte aligned - mov rax, QWORD PTR [rip + _data_ptr] - cmp rax, QWORD PTR [rip + _data_count] - jae .Lread_str_none - inc QWORD PTR [rip + _data_ptr] - shl rax, 4 - lea rcx, [rip + _data_table] - mov rbx, QWORD PTR [rcx + rax + 8] # the text - mov rcx, rbx - call lstrlenA # DATA text is NUL-terminated - mov rdx, rax - mov rax, rbx - add rsp, 40 - pop rbx - leave - ret -.Lread_str_none: - mov rdx, rcx # line - lea rcx, [rip + _err_outofdata] - call _rt_error # returns only when trapped - xor eax, eax - xor edx, edx - add rsp, 40 - pop rbx - leave - ret - -# _rt_restore - Reset DATA pointer (RESTORE statement) -# Arguments: -# rcx = new position (0-based index into data table) -# Returns: nothing -.globl _rt_restore -_rt_restore: - mov QWORD PTR [rip + _data_ptr], rcx - ret - -# _rt_array_autodim - Create an array by using it, as GW-BASIC does -# -# See the System V twin. -# -# Arguments: -# rcx = the descriptor, r8 = element size, r9 = the OPTION BASE, -# rdx = the number of dimensions -# Returns: nothing (Out of memory leaves the pointer null) -.globl _rt_array_autodim -_rt_array_autodim: - push rbp - mov rbp, rsp - push rbx - push r12 - sub rsp, 32 # shadow space; 16-byte aligned - mov rbx, rcx # descriptor - mov r12, r8 # running size: element size * the counts - mov eax, 11 - sub rax, r9 # elements per dimension: base..10 - xor r10d, r10d # dimension -.Lautodim_dim: - cmp r10, rdx - jae .Lautodim_alloc - mov QWORD PTR [rbx + 8 + r10*8], rax - lea r11, [rdx + r10] - mov QWORD PTR [rbx + 8 + r11*8], r9 - imul r12, rax - jo .Lautodim_nomem # too large to address at all - inc r10 - jmp .Lautodim_dim -.Lautodim_alloc: - mov ecx, 1 - mov rdx, r12 - call calloc - test rax, rax - jz .Lautodim_nomem - mov QWORD PTR [rbx], rax - add rsp, 32 - pop r12 - pop rbx - leave - ret -.Lautodim_nomem: - lea rcx, [rip + _err_memory] - xor edx, edx - call _rt_error # returns only when trapped - add rsp, 32 - pop r12 - pop rbx - leave - ret diff --git a/src/runtime/win64-native/data_defs.s b/src/runtime/win64-native/data_defs.s deleted file mode 100644 index ecc2b71..0000000 --- a/src/runtime/win64-native/data_defs.s +++ /dev/null @@ -1,38 +0,0 @@ -# Runtime data section definitions (Win64 Native) -# -# Shared data definitions used across runtime modules. -# Format strings are for UCRT sprintf, not console output. -# -# Note: Console I/O uses Win32 WriteFile/ReadFile directly, -# but we still use sprintf for number-to-string formatting. - -.data - -# Format strings for sprintf (number formatting) -_fmt_int: .asciz "%lld" -_fmt_float: .asciz "%g" -# _rt_fmt_double's request: P significant digits in exponent form. -_fmt_sci: .asciz "%.*e" -_redo_msg: .ascii "?Redo from start\r\n" -# Bracketed rather than measured by the assembler; see _cls_seq in math.s. -_redo_msg_end: - -# Error messages -# Lengths are computed by the assembler (. - label), never hand-counted: a -# hand-counted value here was wrong by one, making WriteFile emit a stray byte. - -# Scratch buffers. These start as zeros, so they belong in .bss: in .data -# every one of these bytes is a zero stored in the executable itself, which -# came to 8K of the image across the whole runtime. -# -# Safe to leave .bss active at the end of this file, and only here: runtime.rs -# concatenates data_defs.s and then emits .text unconditionally before the -# first code-bearing part. Every other runtime file must restore .text itself. -.bss -.p2align 3 -_num_buf: .skip 64 -_fmt_scratch: .skip 64 # _rt_fmt_double's printf output, before reshaping -_fmt_digits: .skip 32 # ... and its significant digits -_scan_buf: .skip 128 # _rt_scan_number's copy of a number, for strtod -_console_mode: .skip 4 # GetConsoleMode's output, for the VT enable - diff --git a/src/runtime/win64-native/error.s b/src/runtime/win64-native/error.s deleted file mode 100644 index 885bd31..0000000 --- a/src/runtime/win64-native/error.s +++ /dev/null @@ -1,343 +0,0 @@ -# BASIC Runtime: Error Reporting (Win64 Native) -# -# One abort path for every runtime check. The message text is passed in and the -# BASIC line number is a register argument, so only a handful of message -# constants are ever needed no matter how many check sites exist. -# -# Messages are NUL-terminated and measured here rather than having their length -# passed in. A check site lives in the program's own .text, which the assembler -# sees before this file, so `mov reg, _msg_len` there is a *forward* reference: -# GAS cannot yet know the symbol is absolute and assembles a memory load from -# that address instead of an immediate. Measuring here sidesteps the ordering -# entirely. -# -# Diagnostics go to the standard error handle, so a program's real output stays -# clean and a test can still check partial output followed by an abort. - -.equ STD_ERROR_HANDLE, -12 - -.data -# Named by generated code, which is a separate object: the program's -# checks pass these messages to _rt_error, and its trapping code reads -# and writes the state below. -.globl _err_fmt_line -.globl _err_fmt_bare -.globl _err_syntax -.globl _err_subscript -.globl _err_typemismatch -.globl _err_div0 -.globl _err_domain -.globl _err_overflow -.globl _err_dupdef -.globl _err_memory -.globl _err_gosub -.globl _err_noreturn -.globl _err_outofdata -.globl _err_badfile -.globl _err_badmode -.globl _err_fieldovf -.globl _err_permission -.globl _err_notfound -.globl _err_alreadyopen -.globl _err_pastend -.globl _err_badname -.globl _err_access -.globl _err_pathnotfound -.globl _err_unprintable -.globl _err_resnoerr -.globl _err_handler -.globl _err_pending -.globl _err_active -.globl _err_line - -_err_fmt_line: .asciz "?%s in %lld\r\n" -_err_fmt_bare: .asciz "?%s\r\n" -_stop_fmt_line: .asciz "Break in %lld\r\n" -_stop_fmt_bare: .asciz "Break\r\n" - -_err_syntax: .asciz "Syntax error" -_err_subscript: .asciz "Subscript out of range" -_err_typemismatch: .asciz "Type mismatch" -_err_div0: .asciz "Division by zero" -_err_domain: .asciz "Illegal function call" -_err_overflow: .asciz "Overflow" -_err_dupdef: .asciz "Duplicate definition" -_err_memory: .asciz "Out of memory" -_err_gosub: .asciz "GOSUB stack overflow" -_err_noreturn: .asciz "RETURN without GOSUB" -_err_outofdata: .asciz "Out of DATA" -_err_badfile: .asciz "Bad file number" -_err_badmode: .asciz "Bad file mode" -_err_fieldovf: .asciz "FIELD overflow" -_err_permission: .asciz "Permission denied" -_err_notfound: .asciz "File not found" -_err_alreadyopen: .asciz "File already open" -_err_pastend: .asciz "Input past end of file" -_err_badname: .asciz "Bad file name" -_err_access: .asciz "Path/File access error" -_err_pathnotfound: .asciz "Path not found" - -_err_unprintable: .asciz "Unprintable error" -# RESUME's own failures. Never trapped -- a handler that trapped them would be -# re-entered by its own RESUME, forever. -_err_resnoerr: .asciz "RESUME without error" - -# GW-BASIC's own error numbers, so that a listing's `IF ERR = 53` means what it -# meant in 1983. Pairs of (message, number), terminated by a zero message. -# -# A table rather than a third argument to _rt_error: that argument would have to -# be threaded through thirteen call sites in this tree alone, plus every -# trampoline codegen emits, and a helper here may take only four arguments -# because Win64 passes only four in registers. Errors are not a hot path, so a -# linear scan on the way to exit costs nothing. -# -# Searched by number as well as by message, for the ERROR statement -- so where -# two messages share a number the first one listed is the one ERROR n raises. -.p2align 3 -_err_codes: - .quad _err_syntax, 2 - .quad _err_noreturn, 3 - .quad _err_outofdata, 4 - .quad _err_domain, 5 - .quad _err_overflow, 6 - .quad _err_memory, 7 - .quad _err_gosub, 7 - .quad _err_subscript, 9 - .quad _err_dupdef, 10 - .quad _err_div0, 11 - .quad _err_typemismatch, 13 - .quad _err_fieldovf, 50 - .quad _err_badfile, 52 - .quad _err_notfound, 53 - .quad _err_badmode, 54 - .quad _err_alreadyopen, 55 - .quad _err_pastend, 62 - .quad _err_badname, 64 - .quad _err_permission, 70 - .quad _err_access, 75 - .quad _err_pathnotfound, 76 - .quad 0, 0 - -# Zero-filled scratch, so .bss rather than .data -- see data_defs.s. The -# .text below restores the section for the code that follows. -.bss -.p2align 3 -_err_buf: .skip 128 -_err_bytes_written: .skip 8 - - -# Error-trapping state. Always defined, never conditional: _rt_error is -# assembled into every program and its preamble reads these, so a program with -# no ON ERROR would otherwise fail to link. Zero means "not trapping", which is -# what .bss gives for free. -.bss -.p2align 3 -_err_handler: .skip 8 # which ON ERROR target, numbered from 1; 0 = trapping off -_err_pending: .skip 8 # 1 from a trapped error until its handler runs; - # 2 while procedures unwind toward a RESUME label -_err_active: .skip 8 # nonzero while a handler runs -_err_code: .skip 8 # what ERR returns -_err_line: .skip 8 # the line now running: codegen stores it per statement - # when trapping, else before each call that can fail -_err_erl: .skip 8 # what ERL returns: _err_line as it was when trapped - -.text - -# _rt_err - ERR: the number of the error that was trapped -# -# Arguments: none Returns: eax = error number, 0 if none has been trapped -.globl _rt_err -_rt_err: - mov rax, QWORD PTR [rip + _err_code] - ret - -# _rt_erl - ERL: the line the trapped error happened on -# -# Arguments: none Returns: eax = line number, 0 if none has been trapped -.globl _rt_erl -_rt_erl: - mov rax, QWORD PTR [rip + _err_erl] - ret - -# _rt_error_num - Raise the error with GW-BASIC number `n` (ERROR statement) -# -# Arguments (Win64): -# rcx = error number -# rdx = BASIC line number, or 0 when unknown -# -# Returns: only when a handler traps the error, as _rt_error does. -# -# ERR is n itself, not the number the message maps back to; see the System V -# twin. -.globl _rt_error_num -_rt_error_num: - mov r9, rcx # ERR, whatever the message - lea rax, [rip + _err_codes] -.Lnum_scan: - mov r8, QWORD PTR [rax] # message, or 0 at the end - test r8, r8 - jz .Lnum_unknown - cmp QWORD PTR [rax + 8], r9 - je .Lnum_found - add rax, 16 - jmp .Lnum_scan -.Lnum_found: - mov rcx, r8 - jmp .Lerror_raise -.Lnum_unknown: - lea rcx, [rip + _err_unprintable] - jmp .Lerror_raise - -# _rt_error - Report a runtime error and terminate -# Arguments (Win64): -# rcx = message pointer (NUL-terminated) -# rdx = BASIC line number, or 0 for the one in _err_line -# -# Returns: only when a handler traps the error, with _err_pending set. -# Otherwise never (exit code 1). -.globl _rt_error -_rt_error: - # ERR is the number this message carries. Unknown text reports 0 rather - # than inventing a code. - lea r8, [rip + _err_codes] -.Ltrap_scan: - mov r9, QWORD PTR [r8] - test r9, r9 - jz .Ltrap_scan_done # r9 = 0: not listed - cmp r9, rcx - je .Ltrap_found - add r8, 16 - jmp .Ltrap_scan -.Ltrap_found: - mov r9, QWORD PTR [r8 + 8] -.Ltrap_scan_done: - -# The common path, with r9 = the number ERR is to report. -.Lerror_raise: - # An error already on its way to the handler wins. Its helper may carry on - # to the end of what it was doing -- printing the rest of a number to the - # same unopened file, say -- and each step fails the same way; the first - # failure is the one the handler hears about. - cmp QWORD PTR [rip + _err_pending], 0 - jne .Ltrap_return - - # Trapping only when ON ERROR armed one and no handler is already running: - # GW-BASIC does not trap an error raised inside a handler, which is also - # what stops handler -> error -> handler from looping forever. - # - # Ahead of the sprintf below, which would otherwise scribble _err_buf on - # the way to a handler that never wanted it. - mov rax, QWORD PTR [rip + _err_handler] - test rax, rax - jz _rt_fatal - cmp QWORD PTR [rip + _err_active], 0 - jne _rt_fatal - - mov QWORD PTR [rip + _err_code], r9 - # Snapshot the line as well. The handler is ordinary module-level code, so - # its own statements overwrite _err_line the moment it starts running -- - # measured: a handler on line 100 reported ERL 100 for an error on line 30. - mov r9, QWORD PTR [rip + _err_line] - mov QWORD PTR [rip + _err_erl], r9 - - mov QWORD PTR [rip + _err_active], 1 - - # Return to whoever raised it. Generated code tests _err_pending after - # every call that can fail; the statement's fault block then calls the - # handler, on top of whatever faulted, and RESUMEs from what it returns. - # A runtime helper that called this returns first, through its own - # epilogue. Nothing is abandoned, so there is no register state to - # restore. - mov QWORD PTR [rip + _err_pending], 1 -.Ltrap_return: - ret - -# _rt_fatal - Report and exit, without consulting the handler -# -# Today's whole behaviour, and still what happens when nothing is trapping. -# Called directly for the errors that must never be trapped: a handler -# re-entered by its own failing RESUME would never stop. -# -# Arguments: the same as _rt_error. -# Returns: never (exit code 1) -.globl _rt_fatal -_rt_fatal: - push rbp - mov rbp, rsp - push rbx - push rsi - sub rsp, 48 # shadow space, keeps rsp 16-byte aligned - - mov rbx, rcx # message - mov rsi, rdx # line number - - # A helper given no line passes 0; _err_line holds it. See the System V - # twin. - test rsi, rsi - jnz .Lerr_have_line - mov rsi, QWORD PTR [rip + _err_line] -.Lerr_have_line: - - # sprintf(_err_buf, fmt, message [, line]) - lea rcx, [rip + _err_buf] - test rsi, rsi - jz .Lerr_bare - lea rdx, [rip + _err_fmt_line] - mov r8, rbx - mov r9, rsi - call sprintf - jmp .Lerr_write -.Lerr_bare: - lea rdx, [rip + _err_fmt_bare] - mov r8, rbx - call sprintf - -.Lerr_write: - mov rbx, rax # length from sprintf - mov ecx, STD_ERROR_HANDLE - call GetStdHandle - mov rcx, rax # handle - lea rdx, [rip + _err_buf] - mov r8, rbx # length - lea r9, [rip + _err_bytes_written] - mov QWORD PTR [rsp + 32], 0 - call WriteFile - - mov ecx, 1 - call ExitProcess - ud2 # exit does not return - -# _rt_stop - STOP: say where, and end the program -# -# See the System V twin. Console output here is written straight through, so -# there is nothing to flush first. -# -# Arguments: rcx = BASIC line number, or 0 when unknown -# Returns: never (exit code 0) -.globl _rt_stop -_rt_stop: - push rbp - mov rbp, rsp - push rbx - sub rsp, 40 # shadow space + the 5th WriteFile argument - lea rdx, [rip + _stop_fmt_bare] - test rcx, rcx - jz .Lstop_fmt - lea rdx, [rip + _stop_fmt_line] -.Lstop_fmt: - mov r8, rcx # the line, if the format wants it - lea rcx, [rip + _err_buf] - call sprintf - mov rbx, rax # length - mov ecx, STD_ERROR_HANDLE - call GetStdHandle - mov rcx, rax - lea rdx, [rip + _err_buf] - mov r8, rbx - lea r9, [rip + _err_bytes_written] - mov QWORD PTR [rsp + 32], 0 - call WriteFile - add rsp, 40 - pop rbx - leave - jmp _rt_end diff --git a/src/runtime/win64-native/file.s b/src/runtime/win64-native/file.s deleted file mode 100644 index afd27c4..0000000 --- a/src/runtime/win64-native/file.s +++ /dev/null @@ -1,2172 +0,0 @@ -# BASIC Runtime: File I/O Functions (Win64 Native - Pure Win32 API) -# -# File input/output functions using Win32 API instead of libc stdio. -# Uses CreateFileA, CloseHandle, WriteFile, ReadFile. -# -# File Handle Table: -# _file_handles is an array of 16 HANDLE values (128 bytes). -# Index 0 is unused (BASIC file numbers start at 1). -# Handles 1-15 are available for user files. -# -# Win64 ABI: -# - Args: rcx, rdx, r8, r9 (then stack) -# - Callee-saved: rbx, rbp, rdi, rsi, r12-r15 -# - 32-byte shadow space required before calls - -# Win32 API Constants -.equ GENERIC_READ, 0x80000000 -.equ GENERIC_WRITE, 0x40000000 -.equ FILE_SHARE_READ, 1 -.equ CREATE_ALWAYS, 2 -.equ OPEN_EXISTING, 3 -.equ OPEN_ALWAYS, 4 -.equ FILE_ATTRIBUTE_NORMAL, 0x80 -.equ INVALID_HANDLE_VALUE, -1 -.equ FILE_END, 2 - -# ASCII character codes -.equ CHAR_LF, 10 -.equ CHAR_CR, 13 - -# BASIC file modes (from codegen) -.equ MODE_INPUT, 0 -.equ MODE_OUTPUT, 1 -.equ MODE_APPEND, 2 - -# Buffer size constants -.equ INPUT_BUF_SIZE, 1024 -.equ MAX_NUM_INPUT_LEN, 254 # INPUT_BUF_SIZE - 2 (null + safety) -.equ MAX_STR_INPUT_LEN, 1022 # INPUT_BUF_SIZE - 2 (null + safety) - -# I/O size constants -.equ SINGLE_BYTE, 1 -.equ CRLF_LEN, 2 - -.data -_file_fmt_int: .asciz "%lld" -_file_fmt_float: .asciz "%g" -_file_newline: .ascii "\r\n" - -# Zero-filled scratch, so .bss rather than .data -- see data_defs.s. The -# .text below restores the section for the code that follows; a .bss left -# open at the end of this file would swallow the next runtime part. -.bss -# The handle table and the column table are both indexed as quadwords, so -# they need stated alignment: in .data they inherited whatever offset the -# preceding strings happened to leave, which is not something to rely on. -.p2align 3 -_file_handles: .skip 128 # 16 * 8 bytes = 16 HANDLEs -# How each number was opened: 0 INPUT, 1 OUTPUT, 2 APPEND, 3 RANDOM. -_file_mode: .skip 128 -# WIDTH: the line length output wraps at, per file number; 0 = no limit. -_file_width: .skip 128 -# Current output column per file number, so TAB(n) knows how far to advance. -# Updated by the print helpers and reset by a newline. Slot 0 is the console, -# which is file handle 0. -_file_col: .skip 128 -_file_name_buf: .skip 1024 # Buffer for null-terminated filename -_file_output_buf: .skip 256 # Buffer for formatted output -_file_bytes_written: .skip 8 # For WriteFile output -_file_bytes_read: .skip 8 # For ReadFile output -_file_input_buf: .skip 1024 # Buffer for file input -_file_getc_buf: .skip 8 # One byte at a time, for _rt_file_getc - -.text - -# _rt_file_open - Open a file (OPEN statement) -# Arguments: -# rcx = filename pointer (BASIC string, not null-terminated) -# rdx = filename length -# r8 = mode: 0=INPUT, 1=OUTPUT, 2=APPEND -# r9 = file number (1-15) -# -# Returns: nothing -.globl _rt_file_open -_rt_file_open: - push rbp - mov rbp, rsp - push rbx - push r12 - push r13 - push r14 - push rdi - push rsi - sub rsp, 80 # Shadow space + stack args (must be 0 mod 16) - - # Save arguments - mov rdi, rcx # filename ptr - mov rsi, rdx # filename len - mov r14d, r8d # mode (0/1/2) - mov ebx, r9d # file number - - # A number that is still open must be CLOSEd first. Rebinding it used to - # succeed silently, leaking the old handle. - lea rax, [rip + _file_handles] - mov rax, [rax + rbx*8] - test rax, rax - jz .Lopen_free - call .Lopen_already - jmp .Lfile_open_done -.Lopen_free: - test rsi, rsi - jnz .Lopen_named - call .Lopen_badname # "" names no file - jmp .Lfile_open_done -.Lopen_named: - - # Copy filename and null-terminate - lea rcx, [rip + _file_name_buf] - mov rdx, rdi # src - mov r8, rsi # len - call memcpy - lea rax, [rip + _file_name_buf] - mov BYTE PTR [rax + rsi], 0 - - # Determine access and creation mode based on mode argument - # r12 = dwDesiredAccess, r13 = dwCreationDisposition - cmp r14d, MODE_INPUT - je .Lfile_mode_read - cmp r14d, MODE_OUTPUT - je .Lfile_mode_write - # else: append - mov r12d, GENERIC_WRITE - mov r13d, OPEN_ALWAYS - jmp .Ldo_create_file - -.Lfile_mode_read: - mov r12d, GENERIC_READ - mov r13d, OPEN_EXISTING - jmp .Ldo_create_file - -.Lfile_mode_write: - mov r12d, GENERIC_WRITE - mov r13d, CREATE_ALWAYS - -.Ldo_create_file: - # CreateFileA(lpFileName, dwDesiredAccess, dwShareMode, - # lpSecurityAttributes, dwCreationDisposition, - # dwFlagsAndAttributes, hTemplateFile) - lea rcx, [rip + _file_name_buf] # lpFileName - mov edx, r12d # dwDesiredAccess - mov r8d, FILE_SHARE_READ # dwShareMode - xor r9d, r9d # lpSecurityAttributes = NULL - mov DWORD PTR [rsp + 32], r13d # dwCreationDisposition - mov DWORD PTR [rsp + 40], FILE_ATTRIBUTE_NORMAL - mov QWORD PTR [rsp + 48], 0 # hTemplateFile = NULL - call CreateFileA - - # A failed open used to be stored anyway, so the program carried on with - # INVALID_HANDLE_VALUE. Note this is -1 rather than NULL, so the NULL - # guards elsewhere would not have caught it. - cmp rax, INVALID_HANDLE_VALUE - jne .Lopen_ok - mov ecx, r14d - call .Lopen_failed - jmp .Lfile_open_done -.Lopen_ok: - - # Store HANDLE in handle table - lea rcx, [rip + _file_handles] - mov [rcx + rbx*8], rax - lea rcx, [rip + _file_mode] - mov [rcx + rbx*8], r14 - lea rcx, [rip + _file_width] - mov QWORD PTR [rcx + rbx*8], 0 # a new file has no WIDTH - mov r12, rax # the handle, for the seek below - - # A record buffer left by an earlier OPEN ... FOR RANDOM on this number - # would make GET and PUT think this file is a random one. - lea rax, [rip + _file_recbuf] - mov rcx, [rax + rbx*8] - test rcx, rcx - jz .Lopen_no_recbuf - mov QWORD PTR [rax + rbx*8], 0 - call free -.Lopen_no_recbuf: - mov rax, r12 - - # A new file starts at column 1, whatever the last one on this number - # left behind. - lea rcx, [rip + _file_col] - mov QWORD PTR [rcx + rbx*8], 0 - - # If APPEND mode, seek to end - cmp r14d, MODE_APPEND - jne .Lfile_open_done - - # SetFilePointer(hFile, 0, NULL, FILE_END) - mov rcx, rax # hFile - xor edx, edx # lDistanceToMove = 0 - xor r8d, r8d # lpDistanceToMoveHigh = NULL - mov r9d, FILE_END # dwMoveMethod - call SetFilePointer - -.Lfile_open_done: - add rsp, 80 - pop rsi - pop rdi - pop r14 - pop r13 - pop r12 - pop rbx - leave - ret - -# _rt_file_close - Close a file (CLOSE statement) -# Arguments: -# rcx = file number (1-15) -# -# Returns: nothing -.globl _rt_file_close -_rt_file_close: - push rbp - mov rbp, rsp - push rbx - sub rsp, 40 # Shadow space + alignment - - mov ebx, ecx # save file number - - # Get HANDLE from table - lea rax, [rip + _file_handles] - mov rcx, [rax + rbx*8] - - # Check for NULL/INVALID - test rcx, rcx - jz .Lfile_close_done - cmp rcx, INVALID_HANDLE_VALUE - je .Lfile_close_done - - # CloseHandle(hFile) - call CloseHandle - - # Clear handle from table - lea rax, [rip + _file_handles] - mov QWORD PTR [rax + rbx*8], 0 - -.Lfile_close_done: - add rsp, 40 - pop rbx - leave - ret - -# _rt_file_print_string - Write string to file -# Arguments: -# rcx = file number -# rdx = string pointer -# r8 = string length -# -# Returns: nothing -# -# Under a WIDTH, the text is cut where the line ends and continued on the next; -# see the System V twin. -.globl _rt_file_print_string -_rt_file_print_string: - push rbp - mov rbp, rsp - push rbx - push rdi - push rsi - push r12 - sub rsp, 48 # Shadow space + stack arg, 16-byte aligned - - # An unassigned string is (NULL, 0); writing nothing is correct and avoids - # handing WriteFile a NULL buffer. - test r8, r8 - jz .Lfile_print_str_done - - mov ebx, ecx # file number - mov rdi, rdx # where the text left to write starts - mov rsi, r8 # how much is left - - lea rax, [rip + _file_handles] - cmp QWORD PTR [rax + rbx*8], 0 - jne .Lfile_print_str_open - call .Lfile_not_open # a number nobody OPENed is NULL here - jmp .Lfile_print_str_done -.Lfile_print_str_open: - call .Lfile_check_writable - jc .Lfile_print_str_done - -.Lfile_print_str_chunk: - mov r12, rsi # this piece: all of what is left ... - lea rax, [rip + _file_width] - mov rcx, QWORD PTR [rax + rbx*8] - test rcx, rcx - jz .Lfile_print_str_write - lea rax, [rip + _file_col] - sub rcx, QWORD PTR [rax + rbx*8] # ... or the room left on the line - jg .Lfile_print_str_room - mov ecx, ebx - call _rt_file_print_newline # none: start the next line - lea rax, [rip + _file_width] - mov rcx, QWORD PTR [rax + rbx*8] -.Lfile_print_str_room: - cmp r12, rcx - jbe .Lfile_print_str_write - mov r12, rcx -.Lfile_print_str_write: - # WriteFile(hFile, lpBuffer, nNumberOfBytesToWrite, lpNumberOfBytesWritten, lpOverlapped) - lea rax, [rip + _file_handles] - mov rcx, QWORD PTR [rax + rbx*8] - mov rdx, rdi - mov r8, r12 - lea r9, [rip + _file_bytes_written] - mov QWORD PTR [rsp + 32], 0 # lpOverlapped = NULL - call WriteFile - - lea rax, [rip + _file_col] - add QWORD PTR [rax + rbx*8], r12 - add rdi, r12 - sub rsi, r12 - jnz .Lfile_print_str_chunk - -.Lfile_print_str_done: - add rsp, 48 - pop r12 - pop rsi - pop rdi - pop rbx - leave - ret - -# _rt_file_print_float - Write number to file -# Arguments: -# rcx = file number -# xmm1 = value to write (double), the second argument by position -# -# Returns: nothing -.globl _rt_file_print_float -_rt_file_print_float: - movaps xmm0, xmm1 # the formatter takes the value in xmm0 - push rbp - mov rbp, rsp - push rbx - push r12 - sub rsp, 48 # Shadow space + alignment - - mov ebx, ecx # save file number - - # Format through the shared helper, so every sink renders a number the - # same way. - xor ecx, ecx # a DOUBLE - call _rt_fmt_double - jmp .Lfile_num_emit - -# _rt_file_print_single - Write a SINGLE -# A SINGLE carries only ~7 significant digits, so it uses a table starting at a -# shorter format and compares at 32-bit precision. Otherwise 3.14159! would -# print as 3.1415901184082: at 15 digits even a float's value round-trips. -# -# Shares the emit tail below with _rt_file_print_float, whose prologue is -# identical. -# -# Arguments: -# rcx = file number -# xmm1 = value, already widened to double -# -# Returns: nothing -.globl _rt_file_print_single -_rt_file_print_single: - movaps xmm0, xmm1 - push rbp - mov rbp, rsp - push rbx - push r12 - sub rsp, 48 # Shadow space + alignment - - mov ebx, ecx # save file number - - mov ecx, 1 # a SINGLE - call _rt_fmt_double - -.Lfile_num_emit: - # rax = length of the text _rt_fmt_double left in _num_buf. - mov r8, rax - lea rdx, [rip + _num_buf] - mov ecx, ebx - call _rt_file_print_string - - add rsp, 48 - pop r12 - pop rbx - leave - ret - -# _rt_print_number - PRINT a DOUBLE, with the spacing PRINT gives a number -# -# A blank where the sign would go, and a blank after. WRITE renders numbers -# through _rt_file_print_float instead, because WRITE pads nothing. -# -# Arguments: rcx = file number, xmm1 = value -# Returns: nothing -.globl _rt_print_number -_rt_print_number: - movaps xmm0, xmm1 - push rbp - mov rbp, rsp - push rbx - push r12 - sub rsp, 48 # Shadow space + alignment - - mov ebx, ecx # save file number - xor ecx, ecx # a DOUBLE - call _rt_fmt_basic - jmp .Lprint_num_emit - -# _rt_print_number_single - The same for a SINGLE, whose shorter digit table -# is the reason PRINT keeps two entry points at all. -# -# Arguments: rcx = file number, xmm1 = value already widened to double -# Returns: nothing -.globl _rt_print_number_single -_rt_print_number_single: - movaps xmm0, xmm1 - push rbp - mov rbp, rsp - push rbx - push r12 - sub rsp, 48 # Shadow space + alignment - - mov ebx, ecx # save file number - mov ecx, 1 # a SINGLE - call _rt_fmt_basic - -.Lprint_num_emit: - lea rdx, [rip + _num_buf] - mov BYTE PTR [rdx + rax], 32 # the trailing blank - inc rax - mov r12, rax # the length, across the call below - - # Under a WIDTH, a number that does not fit on the rest of the line starts - # the next one, as in GW-BASIC, rather than being split. - lea rcx, [rip + _file_width] - mov rcx, QWORD PTR [rcx + rbx*8] - test rcx, rcx - jz .Lprint_num_write - lea rdx, [rip + _file_col] - mov rdx, QWORD PTR [rdx + rbx*8] - test rdx, rdx - jz .Lprint_num_write # already at the start of a line - add rdx, rax - cmp rdx, rcx - jbe .Lprint_num_write - mov ecx, ebx - call _rt_file_print_newline -.Lprint_num_write: - lea rdx, [rip + _num_buf] - mov r8, r12 - mov ecx, ebx - call _rt_file_print_string - - add rsp, 48 - pop r12 - pop rbx - leave - ret - -# PRINT lays a line out in zones this wide; a comma moves to the next one. -.equ PRINT_ZONE, 14 - -# _rt_print_zone - PRINT's comma: move to the start of the next print zone -# -# GW-BASIC lays a line out in 14-column zones and a comma moves to the next -# one, padding with blanks. This used to emit a literal tab, which is whatever -# width the terminal says and lines nothing up. -# -# Built on _rt_file_print_tab, which already pads to a column and starts a new -# line when the cursor is past it -- which is also what a comma does past the -# last zone. -# -# Arguments: rcx = file number -# Returns: nothing -.globl _rt_print_zone -_rt_print_zone: - push rbp - mov rbp, rsp - push rbx - sub rsp, 40 # shadow space + alignment - - mov ebx, ecx - lea rax, [rip + _file_col] - mov rax, QWORD PTR [rax + rbx*8] # characters already on this line - xor edx, edx - mov r8, PRINT_ZONE - div r8 - inc rax - imul rax, rax, PRINT_ZONE # first column of the next zone, 0-based - - # Under a WIDTH, a zone that would not fit whole on the line means the - # next line, as in GW-BASIC. - lea rcx, [rip + _file_width] - mov rcx, QWORD PTR [rcx + rbx*8] - test rcx, rcx - jz .Lprint_zone_fits - lea rdx, [rax + PRINT_ZONE] - cmp rdx, rcx - jbe .Lprint_zone_fits - mov ecx, ebx - call _rt_file_print_newline - jmp .Lprint_zone_done -.Lprint_zone_fits: - inc rax # _rt_file_print_tab counts from 1 - mov rdx, rax - mov ecx, ebx - call _rt_file_print_tab - -.Lprint_zone_done: - add rsp, 40 - pop rbx - leave - ret - -# _rt_con_string - Write a string to the console -# The console is file handle 0. This exists for the runtime's own messages and -# for PRINT USING, which has no file form; generated code passes a handle like -# any other caller. -# -# Arguments: -# rcx = string pointer -# rdx = string length -# -# Returns: nothing -.globl _rt_con_string -_rt_con_string: - mov r8, rdx # length -> 3rd arg - mov rdx, rcx # pointer -> 2nd arg - xor ecx, ecx # console -> 1st arg - jmp _rt_file_print_string - -# _rt_file_print_spc - SPC(n): write n spaces -# Arguments: -# rcx = file number -# rdx = count -# -# Returns: nothing -.globl _rt_file_print_spc -_rt_file_print_spc: - push rbp - mov rbp, rsp - push rbx - push r12 - sub rsp, 32 # Shadow space - - mov ebx, ecx # file number - mov r12, rdx # count remaining -.Lfile_spc_loop: - cmp r12, 0 - jle .Lfile_spc_done - mov ecx, ebx - mov edx, ' ' - call _rt_file_print_char - dec r12 - jmp .Lfile_spc_loop -.Lfile_spc_done: - add rsp, 32 - pop r12 - pop rbx - leave - ret - -# _rt_file_print_tab - TAB(n): advance to column n -# Columns are 1-based, as in GW-BASIC. If the sink is already at or past the -# requested column, a newline is written first and the tab applies to the new -# line. -# -# Arguments: -# rcx = file number -# rdx = target column -# -# Returns: nothing -.globl _rt_file_print_tab -_rt_file_print_tab: - push rbp - mov rbp, rsp - push rbx - push r12 - sub rsp, 32 # Shadow space - - mov ebx, ecx # file number - mov r12, rdx # target column - cmp r12, 1 - jge .Lfile_tab_have_target - mov r12, 1 -.Lfile_tab_have_target: - dec r12 # 1-based column -> count of characters before it - - lea rax, [rip + _file_col] - cmp r12, QWORD PTR [rax + rbx*8] - jge .Lfile_tab_pad - mov ecx, ebx - call _rt_file_print_newline - -.Lfile_tab_pad: - lea rax, [rip + _file_col] - mov rdx, r12 - sub rdx, QWORD PTR [rax + rbx*8] - mov ecx, ebx - call _rt_file_print_spc - - add rsp, 32 - pop r12 - pop rbx - leave - ret - -# _rt_file_print_char - Write single character to file -# Arguments: -# rcx = file number -# rdx = character code -# -# Returns: nothing -.globl _rt_file_print_char -_rt_file_print_char: - push rbp - mov rbp, rsp - push rbx - sub rsp, 40 # Shadow space + stack arg - - mov ebx, ecx # save file number - - # Store char in buffer - lea rax, [rip + _file_output_buf] - mov [rax], dl - - # Get HANDLE - lea rax, [rip + _file_handles] - mov rcx, [rax + rbx*8] # hFile - test rcx, rcx - jnz .Lfile_char_open - call .Lfile_not_open # a number nobody OPENed is NULL here - jmp .Lfile_char_done -.Lfile_char_open: - call .Lfile_check_writable - jc .Lfile_char_done - - # Under a WIDTH, a full line wraps before the character, as in - # _rt_file_print_string. - lea rax, [rip + _file_width] - mov rdx, QWORD PTR [rax + rbx*8] - test rdx, rdx - jz .Lfile_char_write - lea rax, [rip + _file_col] - cmp QWORD PTR [rax + rbx*8], rdx - jb .Lfile_char_write - mov ecx, ebx - call _rt_file_print_newline -.Lfile_char_write: - lea rax, [rip + _file_handles] - mov rcx, QWORD PTR [rax + rbx*8] - - # WriteFile(hFile, buffer, 1, &bytesWritten, NULL) - lea rdx, [rip + _file_output_buf] - mov r8, SINGLE_BYTE - lea r9, [rip + _file_bytes_written] - mov QWORD PTR [rsp + 32], 0 - call WriteFile - - lea rax, [rip + _file_col] - inc QWORD PTR [rax + rbx*8] - -.Lfile_char_done: - add rsp, 40 - pop rbx - leave - ret - -# _rt_file_print_newline - Write CRLF newline to file -# Arguments: -# rcx = file number -# -# Returns: nothing -.globl _rt_file_print_newline -_rt_file_print_newline: - push rbp - mov rbp, rsp - push rbx - sub rsp, 40 # Shadow space + stack arg - - mov ebx, ecx # save file number - - # Get HANDLE - lea rax, [rip + _file_handles] - mov rcx, [rax + rbx*8] # hFile - test rcx, rcx - jnz .Lfile_newline_open - call .Lfile_not_open # a number nobody OPENed is NULL here - jmp .Lfile_newline_done -.Lfile_newline_open: - call .Lfile_check_writable - jc .Lfile_newline_done - - # WriteFile(hFile, "\r\n", CRLF_LEN, &bytesWritten, NULL) - lea rdx, [rip + _file_newline] - mov r8, CRLF_LEN - lea r9, [rip + _file_bytes_written] - mov QWORD PTR [rsp + 32], 0 - call WriteFile - - lea rax, [rip + _file_col] - mov QWORD PTR [rax + rbx*8], 0 - -.Lfile_newline_done: - add rsp, 40 - pop rbx - leave - ret - -# _rt_file_getc - Read one byte -# Arguments: rcx = file number -# Returns: eax = the byte, or -1 at end of file or on a file that is not open -.globl _rt_file_getc -_rt_file_getc: - push rbp - mov rbp, rsp - sub rsp, 48 # shadow space + the 5th argument - - lea rax, [rip + _file_handles] - mov rcx, [rax + rcx*8] - test rcx, rcx - jz .Lfile_getc_eof - lea rdx, [rip + _file_getc_buf] - mov r8, SINGLE_BYTE - lea r9, [rip + _file_bytes_read] - mov QWORD PTR [rsp + 32], 0 - call ReadFile - - lea rax, [rip + _file_bytes_read] - mov rax, [rax] - test rax, rax - jz .Lfile_getc_eof - lea rax, [rip + _file_getc_buf] - movzx eax, BYTE PTR [rax] - jmp .Lfile_getc_done -.Lfile_getc_eof: - mov eax, -1 -.Lfile_getc_done: - add rsp, 48 - leave - ret - -# _rt_file_read_field - Read one INPUT # field -# INPUT # reads comma-delimited fields, not whole lines. Reading a line per -# variable made `INPUT #1, A, B` on "10,20" yield 10 twice, and left the second -# line unread. -# -# Leading blanks and line breaks are skipped. A field either is quoted, in -# which case it runs to the closing quote and everything up to the next -# delimiter is discarded, or runs to the next comma, newline or end of file -# with trailing blanks trimmed. The delimiter is consumed. -# -# An unquoted field read for a number also ends at a blank, as GW-BASIC's -# INPUT # does; see the System V twin. Putting back the character that starts -# the next field is a step back of one byte: reads here go straight to the -# handle a byte at a time, so there is no buffer to push it into. -# -# Arguments: -# rcx = file number -# edx = 1 for a numeric item, 0 for a string -# -# Returns: -# rax = pointer to the field (in _file_input_buf), rdx = its length -# -# Note: uses a static buffer, so the result is valid only until the next read. -.globl _rt_file_read_field -_rt_file_read_field: - push rbp - mov rbp, rsp - push rbx - push rsi - push r12 - push r13 - sub rsp, 32 # shadow space; four pushes keep it aligned - - mov ebx, ecx # file number, reloaded before every read - xor r12d, r12d # length written so far - mov r13d, edx # numeric item - - # INPUT # needs a file that is open, and open for reading. _rt_file_getc - # answers end-of-file for one that is not, so this read an empty field. - lea rax, [rip + _file_handles] - cmp QWORD PTR [rax + rbx*8], 0 - jne .Lfield_open - call .Lfile_not_open - jmp .Lfield_done -.Lfield_open: - call .Lfile_check_readable - jc .Lfield_done - -.Lfield_skip: - mov ecx, ebx - call _rt_file_getc - cmp eax, -1 - je .Lfield_past_end - cmp eax, ' ' - je .Lfield_skip - cmp eax, 9 # tab - je .Lfield_skip - cmp eax, CHAR_CR - je .Lfield_skip - cmp eax, CHAR_LF - je .Lfield_skip - - # A comma here ends an empty field: "10,,20" is three fields, the - # middle one 0 or "". Taken as the field's first character, it ran the - # rest of the line into this field and left the next one nothing. - cmp eax, ',' - je .Lfield_done - cmp eax, '"' - je .Lfield_quoted - - mov esi, eax -.Lfield_plain_store: - cmp r12d, MAX_STR_INPUT_LEN - jge .Lfield_plain_next - lea rax, [rip + _file_input_buf] - mov BYTE PTR [rax + r12], sil - inc r12d -.Lfield_plain_next: - mov ecx, ebx - call _rt_file_getc - cmp eax, -1 - je .Lfield_trim - cmp eax, ',' - je .Lfield_trim - cmp eax, CHAR_LF - je .Lfield_trim - test r13d, r13d - jnz .Lfield_num_char - cmp eax, CHAR_CR - je .Lfield_plain_next - mov esi, eax - jmp .Lfield_plain_store - -.Lfield_num_char: - cmp eax, ' ' - je .Lfield_num_blanks - cmp eax, 9 # tab - je .Lfield_num_blanks - cmp eax, CHAR_CR - je .Lfield_num_cr - mov esi, eax - jmp .Lfield_plain_store - -.Lfield_num_blanks: - # The number has ended at a blank. More blanks, then a comma or a line - # break, all belong to this field's delimiter. - mov ecx, ebx - call _rt_file_getc - cmp eax, ' ' - je .Lfield_num_blanks - cmp eax, 9 - je .Lfield_num_blanks - cmp eax, -1 - je .Lfield_done - cmp eax, ',' - je .Lfield_done - cmp eax, CHAR_LF - je .Lfield_done - cmp eax, CHAR_CR - je .Lfield_num_cr - jmp .Lfield_unread - -.Lfield_num_cr: - # A CR ends the number, and the LF of a CRLF goes with it: left behind, it - # would be an empty line to a LINE INPUT # that follows. - mov ecx, ebx - call _rt_file_getc - cmp eax, -1 - je .Lfield_done - cmp eax, CHAR_LF - je .Lfield_done - -.Lfield_unread: - # Not a separator: the next field starts here, so step back over it. - # SetFilePointer(h, -1, NULL, FILE_CURRENT) - lea rax, [rip + _file_handles] - mov rcx, [rax + rbx*8] - mov edx, -1 - xor r8d, r8d - mov r9d, 1 # FILE_CURRENT - call SetFilePointer - jmp .Lfield_done - -.Lfield_trim: - # Drop trailing blanks, which are separators rather than data. - test r12d, r12d - jz .Lfield_done - lea rax, [rip + _file_input_buf] - movzx ecx, BYTE PTR [rax + r12 - 1] - cmp ecx, ' ' - je .Lfield_trim_one - cmp ecx, 9 - jne .Lfield_done -.Lfield_trim_one: - dec r12d - jmp .Lfield_trim - -.Lfield_quoted: - mov ecx, ebx - call _rt_file_getc - cmp eax, -1 - je .Lfield_done - cmp eax, '"' - je .Lfield_after_quote - cmp r12d, MAX_STR_INPUT_LEN - jge .Lfield_quoted - mov esi, eax - lea rax, [rip + _file_input_buf] - mov BYTE PTR [rax + r12], sil - inc r12d - jmp .Lfield_quoted - -.Lfield_after_quote: - # Discard whatever separates the closing quote from the delimiter. - mov ecx, ebx - call _rt_file_getc - cmp eax, -1 - je .Lfield_done - cmp eax, ',' - je .Lfield_done - cmp eax, CHAR_LF - je .Lfield_done - jmp .Lfield_after_quote - -.Lfield_past_end: - # No field left before the end of the file: "Input past end of file". - call .Lfile_past_end -.Lfield_done: - lea rax, [rip + _file_input_buf] - mov BYTE PTR [rax + r12], 0 - mov rdx, r12 - - add rsp, 32 - pop r13 - pop r12 - pop rsi - pop rbx - leave - ret - -# _rt_file_input_number - INPUT #: read one numeric field -# -# Read as VAL reads a string; see the System V twin. -# -# Arguments: -# rcx = file number -# -# Returns: -# xmm0 = value read -.globl _rt_file_input_number -_rt_file_input_number: - push rbp - mov rbp, rsp - sub rsp, 32 # shadow space - - mov edx, 1 # a number ends at a blank - call _rt_file_read_field - mov rcx, rax - call _rt_scan_number # rdx is the field's length already - test edx, edx - jz .Lfile_input_number_done - lea rcx, [rip + _err_overflow] - xor edx, edx - call _rt_error # returns only when trapped - xorpd xmm0, xmm0 -.Lfile_input_number_done: - add rsp, 32 - leave - ret - -# _rt_file_input_string - INPUT #: read one string field -# Arguments: rcx = file number -# Returns: rax = pointer, rdx = length -.globl _rt_file_input_string -_rt_file_input_string: - xor edx, edx # a string runs to its comma - jmp _rt_file_read_field - -# _rt_file_line_input - LINE INPUT #: read a whole line -# Arguments: -# rcx = file number -# -# Returns: -# rax = pointer to string data (_file_input_buf) -# rdx = string length -.globl _rt_file_line_input -_rt_file_line_input: - push rbp - mov rbp, rsp - push rbx - push r12 - sub rsp, 48 # Shadow space + stack arg (must be 0 mod 16) - - mov ebx, ecx # save file number - - # Clear buffer - lea rax, [rip + _file_input_buf] - mov BYTE PTR [rax], 0 - - # An unopened number is caught in the loop below; a file opened for - # writing is caught here. - lea rax, [rip + _file_handles] - cmp QWORD PTR [rax + rbx*8], 0 - je .Lline_input_mode_ok - call .Lfile_check_readable - jnc .Lline_input_mode_ok - xor r12d, r12d # an empty line when a handler traps it - jmp .Lfile_input_str_done -.Lline_input_mode_ok: - - # Read one character at a time until newline or EOF - xor r12d, r12d # r12 = position in buffer - -.Lfile_input_str_loop: - # Check buffer overflow - cmp r12d, MAX_STR_INPUT_LEN - jge .Lfile_input_str_done - - # ReadFile(hFile, &buffer[pos], 1, &bytesRead, NULL) - lea rax, [rip + _file_handles] - mov rcx, [rax + rbx*8] # hFile - test rcx, rcx - jnz .Lline_input_open - call .Lfile_not_open # a number nobody OPENed is NULL here - xor r12d, r12d # an empty line when a handler traps it - jmp .Lfile_input_str_done -.Lline_input_open: - lea rdx, [rip + _file_input_buf] - add rdx, r12 # &buffer[pos] - mov r8, SINGLE_BYTE - lea r9, [rip + _file_bytes_read] - mov QWORD PTR [rsp + 32], 0 - call ReadFile - - # Check if we read anything - lea rax, [rip + _file_bytes_read] - mov rax, [rax] - test rax, rax - jnz .Lfile_input_str_have - # Nothing read. If nothing was read on this call at all, the file was - # already at its end and this read is one too many -- GW-BASIC calls that - # "Input past end of file". A partial last line without a trailing newline - # is not: that has characters in the buffer already. - test r12d, r12d - jnz .Lfile_input_str_done - call .Lfile_past_end # nothing read: r12 is already 0, an empty line - jmp .Lfile_input_str_done -.Lfile_input_str_have: - - # Check if it's a newline - lea rax, [rip + _file_input_buf] - mov cl, BYTE PTR [rax + r12] - cmp cl, CHAR_LF - je .Lfile_input_str_done - cmp cl, CHAR_CR # CR - skip it - je .Lfile_input_str_loop - - inc r12d # next position - jmp .Lfile_input_str_loop - -.Lfile_input_str_done: - # Null-terminate - lea rax, [rip + _file_input_buf] - mov BYTE PTR [rax + r12], 0 - mov rdx, r12 # length - - add rsp, 48 - pop r12 - pop rbx - leave - ret - - -# _rt_file_close_all - Close every open file (bare CLOSE) -# Arguments: none -# Returns: nothing -.globl _rt_file_close_all -_rt_file_close_all: - push rbp - mov rbp, rsp - push rbx - sub rsp, 40 - - mov ebx, 1 # BASIC file numbers start at 1 -.Lclose_all_loop: - cmp ebx, 15 - jg .Lclose_all_done - lea rax, [rip + _file_handles] - mov rcx, [rax + rbx*8] - test rcx, rcx - jz .Lclose_all_next - call CloseHandle - lea rax, [rip + _file_handles] - mov QWORD PTR [rax + rbx*8], 0 -.Lclose_all_next: - inc ebx - jmp .Lclose_all_loop -.Lclose_all_done: - add rsp, 40 - pop rbx - leave - ret - -# _rt_file_eof - EOF(n): has the file been read to the end? -# Compares the current position against the file size, which needs no -# pushback and so keeps the next read unaffected. -# -# Arguments: -# rcx = file number -# -# Returns: -# eax = -1 at end of file, 0 otherwise (BASIC's true/false, as a LONG) -.globl _rt_file_eof -_rt_file_eof: - push rbp - mov rbp, rsp - push rbx - push rsi - sub rsp, 48 # two pushes plus the return address, so 48 realigns - - mov ebx, ecx - lea rax, [rip + _file_handles] - mov rcx, [rax + rbx*8] - test rcx, rcx - jz .Leof_true # never opened: treat as at end - - # Current position: SetFilePointer(h, 0, NULL, FILE_CURRENT) - xor edx, edx - xor r8, r8 - mov r9d, 1 # FILE_CURRENT - call SetFilePointer - mov rsi, rax # position - - lea rax, [rip + _file_handles] - mov rcx, [rax + rbx*8] - xor edx, edx - call GetFileSize - - cmp rsi, rax - jb .Leof_false -.Leof_true: - mov eax, -1 - jmp .Leof_done -.Leof_false: - xor eax, eax -.Leof_done: - add rsp, 48 - pop rsi - pop rbx - leave - ret - -# --------------------------------------------------------------------------- -# Random-access files -# -# The model matches the System V tree exactly, and the comment there is the -# one worth reading: a file opened FOR RANDOM carries a record length, a -# record buffer, and a cursor recording how much of that buffer FIELD has -# handed out. FIELD binds each variable to a (pointer, length) pair naming its -# slice, so the variable is a window onto the buffer rather than a copy of it. -# -# Only the mechanics differ here: Win32 handles instead of FILE*, ReadFile and -# WriteFile instead of fread and fwrite, and LockFileEx instead of fcntl. -.equ MAX_RECLEN, 32767 -.equ FILE_BEGIN, 0 -.equ FILE_CURRENT, 1 -.equ LOCKFILE_FAIL_IMMEDIATELY, 1 -.equ LOCKFILE_EXCLUSIVE_LOCK, 2 - -# Zero-filled scratch, so .bss rather than .data -- see data_defs.s. -.bss -# All four tables are indexed as quadwords, and each is a multiple of 8, so -# aligning the first aligns them all. -.p2align 3 -_file_recbuf: .skip 128 # record buffer per file number (malloc'd) -_file_reclen: .skip 128 # record length per file number -_file_recnum: .skip 128 # last record read or written, 1-based; 0 = none -_file_fieldoff: .skip 128 # bytes of the buffer FIELD has assigned so far - -# MKI$/MKL$/MKS$/MKD$ assemble their bytes here, then return a heap copy; the -# buffer itself is never handed out. Written a quadword at a time, so it is -# aligned deliberately rather than by accident of what precedes it. -.p2align 3 -_mk_buf: .skip 16 - -# Scratch for the file-pointer position SetFilePointerEx reports back. -_file_pos: .skip 8 - -.text - -# _rt_file_open_random - OPEN ... FOR RANDOM AS #n LEN = r -# -# Four arguments, not five: Win64 passes only four in registers, and a fifth -# would have to be read back off the caller's stack. There is no mode byte -# because reaching this entry point *is* the mode. -# -# Arguments: -# rcx = filename pointer, rdx = filename length -# r8 = file number, r9 = record length, 1 to 32767 -.globl _rt_file_open_random -_rt_file_open_random: - push rbp - mov rbp, rsp - push rbx - push r12 - push r13 - push r14 - push rdi - push rsi - sub rsp, 64 # shadow space plus CreateFileA's stack arguments - - mov rdi, rcx # filename ptr - mov rsi, rdx # filename len - mov ebx, r8d # file number - mov r14, r9 # record length - - # A record length outside 1..MAX_RECLEN is an Illegal function call, - # refused before anything is created; see the System V twin. - cmp r14, 1 - jl .Lwrandom_badlen - cmp r14, MAX_RECLEN - jg .Lwrandom_badlen - - # The same refusals as a sequential OPEN. This one stored - # INVALID_HANDLE_VALUE for a file it could not open, and silently - # replaced an open one. - lea rax, [rip + _file_handles] - cmp QWORD PTR [rax + rbx*8], 0 - je .Lwrandom_free - call .Lopen_already - jmp .Lwrandom_open_done -.Lwrandom_free: - test rsi, rsi - jnz .Lwrandom_named - call .Lopen_badname - jmp .Lwrandom_open_done -.Lwrandom_named: - - # Null-terminate the filename in the shared buffer. - lea rcx, [rip + _file_name_buf] - mov rdx, rdi - mov r8, rsi - call memcpy - lea rax, [rip + _file_name_buf] - mov BYTE PTR [rax + rsi], 0 - - # A random file is read and written, and is created when absent, which is - # exactly OPEN_ALWAYS with both access bits. - lea rcx, [rip + _file_name_buf] - mov edx, GENERIC_READ - or edx, GENERIC_WRITE - mov r8d, FILE_SHARE_READ - xor r9d, r9d - mov DWORD PTR [rsp + 32], OPEN_ALWAYS - mov DWORD PTR [rsp + 40], FILE_ATTRIBUTE_NORMAL - mov QWORD PTR [rsp + 48], 0 - call CreateFileA - cmp rax, INVALID_HANDLE_VALUE - jne .Lwrandom_have_handle - mov ecx, 3 # RANDOM - call .Lopen_failed - jmp .Lwrandom_open_done -.Lwrandom_have_handle: - - lea rcx, [rip + _file_handles] - mov [rcx + rbx*8], rax - lea rcx, [rip + _file_mode] - mov QWORD PTR [rcx + rbx*8], 3 - lea rcx, [rip + _file_width] - mov QWORD PTR [rcx + rbx*8], 0 - - lea rcx, [rip + _file_col] - mov QWORD PTR [rcx + rbx*8], 0 - - lea rcx, [rip + _file_reclen] - mov [rcx + rbx*8], r14 - - # Release the buffer a previous OPEN on this number left behind. - lea rax, [rip + _file_recbuf] - mov rcx, [rax + rbx*8] - test rcx, rcx - jz .Lwrandom_alloc - call free - # Clear the slot before the allocation below can fail. A trapped - # `Out of memory` would otherwise leave the table holding the pointer just - # freed, and _rt_random_prepare tests that slot for NULL to decide "Bad - # file mode" -- so a dangling pointer passes and GET reads freed memory. - lea rax, [rip + _file_recbuf] - mov QWORD PTR [rax + rbx*8], 0 - -.Lwrandom_alloc: - mov rcx, r14 - call malloc - test rax, rax - jz .Lwrandom_nomem - lea rcx, [rip + _file_recbuf] - mov [rcx + rbx*8], rax - - # A fresh buffer reads as blanks, not as whatever the allocator returned. - mov rcx, rax - mov edx, ' ' - mov r8, r14 - call memset - - lea rax, [rip + _file_recnum] - mov QWORD PTR [rax + rbx*8], 0 - lea rax, [rip + _file_fieldoff] - mov QWORD PTR [rax + rbx*8], 0 - -.Lwrandom_open_done: - add rsp, 64 - pop rsi - pop rdi - pop r14 - pop r13 - pop r12 - pop rbx - leave - ret - -# Each error tail below belongs to one helper. _rt_error returns only when a -# handler traps the error, and then the tail leaves through that helper's own -# epilogue with a harmless result. -.Lwrandom_nomem: - lea rcx, [rip + _err_memory] - xor edx, edx - call _rt_error - jmp .Lwrandom_open_done - -.Lwrandom_badlen: - lea rcx, [rip + _err_domain] - xor edx, edx - call _rt_error - jmp .Lwrandom_open_done - -# _rt_field_reset - Start a fresh FIELD statement -# Arguments: rcx = file number -.globl _rt_field_reset -_rt_field_reset: - lea rax, [rip + _file_fieldoff] - mov QWORD PTR [rax + rcx*8], 0 - ret - -# _rt_field_next - Carve the next slice out of the record buffer -# Arguments: rcx = file number, rdx = width in bytes -# Returns: rax = pointer into the record buffer, rdx = width -.globl _rt_field_next -_rt_field_next: - push rbp - mov rbp, rsp - sub rsp, 32 # shadow space for the error paths - - lea rax, [rip + _file_recbuf] - mov r8, [rax + rcx*8] - test r8, r8 - jz .Lwfield_badmode - - test rdx, rdx - jns .Lwfield_width_ok - xor edx, edx -.Lwfield_width_ok: - - lea rax, [rip + _file_fieldoff] - mov r9, [rax + rcx*8] - lea rax, [rip + _file_reclen] - mov r10, [rax + rcx*8] - - mov r11, r9 - add r11, rdx - cmp r11, r10 - jg .Lwfield_overflow - - lea rax, [rip + _file_fieldoff] - mov [rax + rcx*8], r11 - - mov rax, r8 - add rax, r9 - add rsp, 32 - leave - ret - -.Lwfield_badmode: - lea rcx, [rip + _err_badmode] - xor edx, edx - call _rt_error - jmp .Lwfield_failed - -.Lwfield_overflow: - lea rcx, [rip + _err_fieldovf] - xor edx, edx - call _rt_error -.Lwfield_failed: - xor eax, eax # an empty field - xor edx, edx - leave - ret - -# _rt_lset - LSET: copy left-justified into a fixed-width field -# Arguments: -# rcx = destination pointer, rdx = destination length -# r8 = source pointer, r9 = source length -.globl _rt_lset -_rt_lset: - push rbp - mov rbp, rsp - push rbx - push rdi - push rsi - sub rsp, 40 - - mov rbx, rcx # dest ptr - mov rdi, rdx # dest len - mov rsi, r9 # source len - - test rdi, rdi - jle .Lwlset_done - - # n = min(source length, destination width) - cmp rsi, rdi - cmova rsi, rdi - test rsi, rsi - jle .Lwlset_pad - - mov rcx, rbx - mov rdx, r8 - mov r8, rsi - call memcpy - -.Lwlset_pad: - mov rcx, rbx - add rcx, rsi - mov edx, ' ' - mov r8, rdi - sub r8, rsi - test r8, r8 - jle .Lwlset_done - call memset - -.Lwlset_done: - add rsp, 40 - pop rsi - pop rdi - pop rbx - leave - ret - -# _rt_rset - RSET: the same, right-justified -# Arguments: as _rt_lset -.globl _rt_rset -_rt_rset: - push rbp - mov rbp, rsp - push rbx - push rdi - push rsi - push r12 - sub rsp, 32 - - mov rbx, rcx # dest ptr - mov rdi, rdx # dest len - mov r12, r8 # source ptr - mov rsi, r9 # source len - - test rdi, rdi - jle .Lwrset_done - - cmp rsi, rdi - cmova rsi, rdi - test rsi, rsi - jl .Lwrset_blank - - # Pad on the left, then place the text against the right edge. - mov rcx, rbx - mov edx, ' ' - mov r8, rdi - sub r8, rsi - test r8, r8 - jle .Lwrset_copy - call memset - -.Lwrset_copy: - test rsi, rsi - jle .Lwrset_done - mov rcx, rbx - add rcx, rdi - sub rcx, rsi - mov rdx, r12 - mov r8, rsi - call memcpy - jmp .Lwrset_done - -.Lwrset_blank: - mov rcx, rbx - mov edx, ' ' - mov r8, rdi - call memset - -.Lwrset_done: - add rsp, 32 - pop r12 - pop rsi - pop rdi - pop rbx - leave - ret - -# _rt_random_prepare - Shared GET/PUT setup: validate and seek -# Arguments: -# rcx = file number, rdx = record number (0 = the one after the last) -# r8 = BASIC line number -# -# Returns: rax = HANDLE, rbx = file number, r12 = record length, -# r13 = buffer, r15 = HANDLE -# Clobbers the callee-saved registers it returns in; both callers save them. -.globl _rt_random_prepare -_rt_random_prepare: - push rbp - mov rbp, rsp - sub rsp, 32 # shadow space - - mov ebx, ecx - mov r14, r8 # line number, for the error paths - - lea rax, [rip + _file_handles] - mov r15, [rax + rbx*8] - test r15, r15 - jz .Lwrandom_badfile - cmp r15, INVALID_HANDLE_VALUE - je .Lwrandom_badfile - - lea rax, [rip + _file_recbuf] - mov r13, [rax + rbx*8] - test r13, r13 - jz .Lwrandom_badmode - - lea rax, [rip + _file_reclen] - mov r12, [rax + rbx*8] - - # No record number means the one after the last one touched. - test rdx, rdx - jg .Lwrandom_have_rec - lea rax, [rip + _file_recnum] - mov rdx, [rax + rbx*8] - inc rdx -.Lwrandom_have_rec: - - lea rax, [rip + _file_recnum] - mov [rax + rbx*8], rdx - - # Records are 1-based, so record n starts at (n-1) * reclen. - dec rdx - mov rax, rdx - imul rax, r12 - mov rcx, r15 - mov rdx, rax - xor r8d, r8d # lpNewFilePointer = NULL - mov r9d, FILE_BEGIN - call SetFilePointerEx - - mov rax, r15 - add rsp, 32 - leave - ret - -.Lwrandom_badfile: - lea rcx, [rip + _err_badfile] - mov rdx, r14 - call _rt_error - jmp .Lwrandom_failed - -.Lwrandom_badmode: - lea rcx, [rip + _err_badmode] - mov rdx, r14 - call _rt_error -.Lwrandom_failed: - xor eax, eax # no handle: the caller does nothing more - leave - ret - -# _rt_file_get - GET #n[, rec]: read one record into the buffer -# A record reaching past the end of the file is padded with NULs. -# -# Arguments: rcx = file number, rdx = record number (0 = next), r8 = BASIC line -.globl _rt_file_get -_rt_file_get: - push rbp - mov rbp, rsp - push rbx - push r12 - push r13 - push r14 - push r15 - push rdi - push rsi - sub rsp, 40 - - call _rt_random_prepare - test rax, rax - jz .Lwget_done # a trapped error: no record to read - - # ReadFile(hFile, buffer, reclen, &bytesRead, NULL) - mov rcx, r15 - mov rdx, r13 - mov r8, r12 - lea r9, [rip + _file_bytes_read] - mov QWORD PTR [rsp + 32], 0 - call ReadFile - - # Zero whatever the file was too short to supply. - lea rax, [rip + _file_bytes_read] - mov rax, [rax] - mov r8, r12 - sub r8, rax - jle .Lwget_done - mov rcx, r13 - add rcx, rax - xor edx, edx - call memset - -.Lwget_done: - add rsp, 40 - pop rsi - pop rdi - pop r15 - pop r14 - pop r13 - pop r12 - pop rbx - leave - ret - -# _rt_file_put - PUT #n[, rec]: write the buffer as one record -# Arguments: as _rt_file_get -.globl _rt_file_put -_rt_file_put: - push rbp - mov rbp, rsp - push rbx - push r12 - push r13 - push r14 - push r15 - push rdi - push rsi - sub rsp, 40 - - call _rt_random_prepare - test rax, rax - jz .Lwput_done # a trapped error: no record to write - - # WriteFile(hFile, buffer, reclen, &bytesWritten, NULL) - mov rcx, r15 - mov rdx, r13 - mov r8, r12 - lea r9, [rip + _file_bytes_written] - mov QWORD PTR [rsp + 32], 0 - call WriteFile - - # Flush so LOF and a second handle see the record now. - mov rcx, r15 - call FlushFileBuffers - -.Lwput_done: - add rsp, 40 - pop rsi - pop rdi - pop r15 - pop r14 - pop r13 - pop r12 - pop rbx - leave - ret - -# _rt_file_loc - LOC(n): where the file is positioned -# For a random file this is the last record read or written; for a sequential -# one GW-BASIC counts 128-byte blocks, which is what this reports. -# -# Arguments: rcx = file number -# Returns: xmm0 = the position -.globl _rt_file_loc -_rt_file_loc: - push rbp - mov rbp, rsp - push rbx - sub rsp, 56 - - mov ebx, ecx - - lea rax, [rip + _file_recbuf] - mov rax, [rax + rbx*8] - test rax, rax - jz .Lwloc_sequential - - lea rax, [rip + _file_recnum] - mov rax, [rax + rbx*8] - cvtsi2sd xmm0, rax - jmp .Lwloc_done - -.Lwloc_sequential: - lea rax, [rip + _file_handles] - mov rcx, [rax + rbx*8] - test rcx, rcx - jz .Lwloc_zero - cmp rcx, INVALID_HANDLE_VALUE - je .Lwloc_zero - - # SetFilePointerEx(h, 0, &pos, FILE_CURRENT) reads the position without - # moving it. - xor edx, edx - lea r8, [rip + _file_pos] - mov r9d, FILE_CURRENT - call SetFilePointerEx - test eax, eax - jz .Lwloc_zero - - lea rax, [rip + _file_pos] - mov rax, [rax] - test rax, rax - js .Lwloc_zero - # GW-BASIC reports sequential position in 128-byte blocks. - mov rcx, 128 - xor edx, edx - div rcx - cvtsi2sd xmm0, rax - jmp .Lwloc_done - -.Lwloc_zero: - xorpd xmm0, xmm0 - -.Lwloc_done: - add rsp, 56 - pop rbx - leave - ret - -# _rt_lock / _rt_unlock - LOCK and UNLOCK: advisory record locking -# -# LockFileEx takes the byte range through an OVERLAPPED, built on the stack. -# LOCKFILE_FAIL_IMMEDIATELY makes a held lock an error rather than a wait, -# which is the behaviour GW-BASIC programs expect. -# -# Arguments: -# rcx = file number, rdx = first record, r8 = last record, r9 = BASIC line -# A first record of 0 means the whole file. -.globl _rt_lock -_rt_lock: - mov eax, 1 - jmp .Lwdo_lock - -.globl _rt_unlock -_rt_unlock: - xor eax, eax - -.Lwdo_lock: - push rbp - mov rbp, rsp - push rbx - push r12 - push r13 - push r14 - push rdi - push rsi - sub rsp, 80 # [rsp, rsp+48) call area, [rsp+48, rsp+80) OVERLAPPED - - mov ebx, ecx - mov r13, r9 # BASIC line - mov r14d, eax # 1 = lock, 0 = unlock - mov rdi, rdx # first record - mov rsi, r8 # last record - - lea rax, [rip + _file_handles] - mov r12, [rax + rbx*8] - test r12, r12 - jz .Lwlock_badfile - cmp r12, INVALID_HANDLE_VALUE - je .Lwlock_badfile - - # Zero the OVERLAPPED, then fill in the offset. - lea rcx, [rsp + 48] - xor edx, edx - mov r8, 32 - call memset - - # A first record of 0, or a sequential file, locks everything. - test rdi, rdi - jle .Lwlock_whole - lea rax, [rip + _file_reclen] - mov r9, [rax + rbx*8] - test r9, r9 - jz .Lwlock_whole - - # Byte range [ (first-1)*reclen, (last-first+1)*reclen ) - mov rax, rdi - dec rax - imul rax, r9 - mov QWORD PTR [rsp + 48 + 16], rax # Offset / OffsetHigh - - sub rsi, rdi - inc rsi - test rsi, rsi - jg .Lwlock_have_count - mov rsi, 1 -.Lwlock_have_count: - imul rsi, r9 - jmp .Lwlock_call - -.Lwlock_whole: - mov QWORD PTR [rsp + 48 + 16], 0 - # Win32 needs a length, so "the whole file" is the largest range there is. - mov rsi, 0x7FFFFFFFFFFFFFFF - -.Lwlock_call: - # rsi = byte count; split into the low and high halves both calls take. - mov r10, rsi - shr r10, 32 - mov r11d, esi - - test r14d, r14d - jz .Lwlock_do_unlock - - # LockFileEx(h, flags, 0, countLow, countHigh, &overlapped) - mov rcx, r12 - mov edx, LOCKFILE_EXCLUSIVE_LOCK - or edx, LOCKFILE_FAIL_IMMEDIATELY - xor r8d, r8d - mov r9d, r11d - mov DWORD PTR [rsp + 32], r10d - lea rax, [rsp + 48] - mov QWORD PTR [rsp + 40], rax - call LockFileEx - jmp .Lwlock_check - -.Lwlock_do_unlock: - # UnlockFileEx(h, 0, countLow, countHigh, &overlapped) - mov rcx, r12 - xor edx, edx - mov r8d, r11d - mov r9d, r10d - lea rax, [rsp + 48] - mov QWORD PTR [rsp + 32], rax - call UnlockFileEx - -.Lwlock_check: - test eax, eax - jz .Lwlock_denied - -.Lwlock_done: - add rsp, 80 - pop rsi - pop rdi - pop r14 - pop r13 - pop r12 - pop rbx - leave - ret - -.Lwlock_denied: - lea rcx, [rip + _err_permission] - mov rdx, r13 - call _rt_error - jmp .Lwlock_done - -.Lwlock_badfile: - lea rcx, [rip + _err_badfile] - mov rdx, r13 - call _rt_error - jmp .Lwlock_done - -# _rt_mk - MKI$/MKL$/MKS$/MKD$: a number's bytes, as a string -# Arguments: rcx = the value's bits, rdx = width in bytes (2, 4 or 8) -# Returns: rax = pointer to a fresh heap copy of the bytes, rdx = width -# (_mk_buf is scratch and never leaves the runtime.) -.globl _rt_mk -_rt_mk: - lea rax, [rip + _mk_buf] - mov QWORD PTR [rax], rcx # little-endian, so a short width just - # takes the low bytes - mov rcx, rax - jmp _rt_strdup # rdx already holds the width - -# _rt_cvi / _rt_cvl / _rt_cvs / _rt_cvd - read MK*$ bytes back as a number -# -# The string must be at least as wide as the type being read; see the System V -# tree for why a short one is an error rather than a zero. -# -# Arguments: rcx = string pointer, rdx = string length, r8 = BASIC line -# Returns: xmm0 = the value -.globl _rt_cvi -_rt_cvi: - push rbp - mov rbp, rsp - sub rsp, 32 - cmp rdx, 2 - jb .Lwcv_short - mov r9d, 2 - call .Lwcv_gather - movsx rax, ax # INTEGER is signed 16-bit - cvtsi2sd xmm0, rax - add rsp, 32 - leave - ret - -.globl _rt_cvl -_rt_cvl: - push rbp - mov rbp, rsp - sub rsp, 32 - cmp rdx, 4 - jb .Lwcv_short - mov r9d, 4 - call .Lwcv_gather - movsxd rax, eax # LONG is signed 32-bit - cvtsi2sd xmm0, rax - add rsp, 32 - leave - ret - -.globl _rt_cvs -_rt_cvs: - push rbp - mov rbp, rsp - sub rsp, 32 - cmp rdx, 4 - jb .Lwcv_short - mov r9d, 4 - call .Lwcv_gather - movd xmm0, eax - cvtss2sd xmm0, xmm0 - add rsp, 32 - leave - ret - -.globl _rt_cvd -_rt_cvd: - push rbp - mov rbp, rsp - sub rsp, 32 - cmp rdx, 8 - jb .Lwcv_short - mov r9d, 8 - call .Lwcv_gather - movq xmm0, rax - add rsp, 32 - leave - ret - -# r8 still holds the line number: the width goes in r9 precisely so it does not -# have to be disturbed. -.Lwcv_short: - lea rcx, [rip + _err_domain] - mov rdx, r8 - call _rt_error - xorps xmm0, xmm0 # 0 when a handler traps it - leave - ret - -# Gather r9 bytes of the string at rcx into rax, low byte first. -.Lwcv_gather: - xor eax, eax - test rcx, rcx - jz .Lwcv_gather_done - test r9, r9 - jle .Lwcv_gather_done - xor r8d, r8d -.Lwcv_gather_loop: - movzx r10d, BYTE PTR [rcx + r8] - mov r11, r8 - shl r11, 3 # bit position = index * 8 - push rcx - mov rcx, r11 - shl r10, cl - pop rcx - or rax, r10 - inc r8 - cmp r8, r9 - jl .Lwcv_gather_loop -.Lwcv_gather_done: - ret - -# _rt_file_lof - LOF(n): length of the file in bytes -# Arguments: -# rcx = file number -# -# Returns: -# xmm0 = length in bytes, or 0.0 when the file is not open -.globl _rt_file_lof -_rt_file_lof: - push rbp - mov rbp, rsp - push rbx - sub rsp, 40 - - mov ebx, ecx - lea rax, [rip + _file_handles] - mov rcx, [rax + rbx*8] - test rcx, rcx - jz .Llof_zero - - xor edx, edx - call GetFileSize - cvtsi2sd xmm0, rax - jmp .Llof_done - -.Llof_zero: - xorpd xmm0, xmm0 - -.Llof_done: - add rsp, 40 - pop rbx - leave - ret - -# Shared tail for a file number that was never OPENed. -# -# PRINT # and LINE INPUT # used to hand the NULL handle straight to WriteFile -# and ReadFile. The System V build died with SIGSEGV on the same programs; -# _rt_file_getc and _rt_file_eof already guarded and these did not. These -# helpers are not given the line, so they pass 0 and _rt_error reports the -# one generated code stored in _err_line before the call. -# -# These four are reached by `call`, from inside helpers with different frames, -# and tail-call _rt_error: when a handler traps the error, _rt_error returns -# straight to the call site, which leaves through its own helper's epilogue. -.Lfile_not_open: - lea rcx, [rip + _err_badfile] - xor edx, edx - jmp _rt_error - -# The line number is not passed to _rt_file_open either, so the OPEN errors -# pass 0 as well and report _err_line's. -.Lopen_badname: - lea rcx, [rip + _err_badname] - xor edx, edx - jmp _rt_error - -# OPEN failed: say why, from GetLastError. Called with ecx = the mode (0 INPUT, -# 1 OUTPUT, 2 APPEND, 3 RANDOM). A missing file is "File not found" when it -# was to be read; when it was to be created, what is missing is the directory. -.Lopen_failed: - push rbx - sub rsp, 32 # shadow space; rsp is now 16-byte aligned - mov ebx, ecx - call GetLastError - add rsp, 32 - lea rcx, [rip + _err_access] # 75, for anything not named below - cmp eax, 2 # ERROR_FILE_NOT_FOUND - jne .Lopen_err_path - lea rcx, [rip + _err_notfound] - test ebx, ebx - jz .Lopen_err_go - lea rcx, [rip + _err_pathnotfound] - jmp .Lopen_err_go -.Lopen_err_path: - cmp eax, 3 # ERROR_PATH_NOT_FOUND - jne .Lopen_err_perm - lea rcx, [rip + _err_pathnotfound] - jmp .Lopen_err_go -.Lopen_err_perm: - cmp eax, 5 # ERROR_ACCESS_DENIED - jne .Lopen_err_perm_other - # CreateFile refuses a directory with access denied, but a directory is - # not a file to be denied: it is "Path/File access error" (75), which is - # what the System V tree reports for one in every mode. - sub rsp, 32 # shadow space - lea rcx, [rip + _file_name_buf] - call GetFileAttributesA - add rsp, 32 - lea rcx, [rip + _err_permission] - cmp eax, -1 # INVALID_FILE_ATTRIBUTES - je .Lopen_err_go - test eax, 0x10 # FILE_ATTRIBUTE_DIRECTORY - jz .Lopen_err_go - lea rcx, [rip + _err_access] - jmp .Lopen_err_go -.Lopen_err_perm_other: - lea rcx, [rip + _err_permission] - cmp eax, 32 # ERROR_SHARING_VIOLATION - je .Lopen_err_go - cmp eax, 19 # ERROR_WRITE_PROTECT - je .Lopen_err_go - lea rcx, [rip + _err_badname] - cmp eax, 123 # ERROR_INVALID_NAME - je .Lopen_err_go - cmp eax, 161 # ERROR_BAD_PATHNAME - je .Lopen_err_go - cmp eax, 206 # ERROR_FILENAME_EXCED_RANGE - je .Lopen_err_go - lea rcx, [rip + _err_access] -.Lopen_err_go: - pop rbx - xor edx, edx - jmp _rt_error - -# Is the file open for writing? Called with rbx = file number, from a helper -# whose stack is aligned. Carry set (and the error raised) when it is not; -# rcx, rdx, r8 and r9 survive when it is. PRINT # to a file opened FOR INPUT -# used to be a WriteFile the OS quietly refused. -.Lfile_check_writable: - lea rax, [rip + _file_mode] - mov rax, [rax + rbx*8] - cmp rax, 1 # OUTPUT - je .Lfile_mode_ok - cmp rax, 2 # APPEND - je .Lfile_mode_ok -.Lfile_mode_bad: - sub rsp, 40 # shadow space; rsp is now 16-byte aligned - lea rcx, [rip + _err_badmode] - xor edx, edx - call _rt_error - add rsp, 40 - stc - ret -.Lfile_mode_ok: - clc - ret - -# Is the file open for reading sequentially? The same, for INPUT # and -# LINE INPUT #. -.Lfile_check_readable: - lea rax, [rip + _file_mode] - cmp QWORD PTR [rax + rbx*8], 0 # INPUT - jne .Lfile_mode_bad - clc - ret - -.Lopen_already: - lea rcx, [rip + _err_alreadyopen] - xor edx, edx - jmp _rt_error - -.Lfile_past_end: - lea rcx, [rip + _err_pastend] - xor edx, edx - jmp _rt_error - -# _rt_width - WIDTH [#n,] w: wrap output to file n at w columns -# -# 255 means no limit, as in GW-BASIC. The range 1-255 is checked by the caller. -# -# Arguments: rcx = file number (0 = the console), rdx = width -# Returns: nothing -.globl _rt_width -_rt_width: - push rbp - mov rbp, rsp - lea rax, [rip + _file_handles] - cmp QWORD PTR [rax + rcx*8], 0 - jne .Lwidth_open - sub rsp, 48 # shadow space; aligns rsp for the call - call .Lfile_not_open - leave - ret -.Lwidth_open: - cmp rdx, 255 - jne .Lwidth_set - xor edx, edx # 255: no limit -.Lwidth_set: - lea rax, [rip + _file_width] - mov QWORD PTR [rax + rcx*8], rdx - leave - ret diff --git a/src/runtime/win64-native/input.s b/src/runtime/win64-native/input.s deleted file mode 100644 index 7505992..0000000 --- a/src/runtime/win64-native/input.s +++ /dev/null @@ -1,410 +0,0 @@ -# BASIC Runtime: Console Input (INPUT, LINE INPUT) - Win64 Native -# -# INPUT reads a whole line and splits it on commas, as GW-BASIC and QuickBASIC -# do: a field may be quoted, which lets it hold a comma; an unquoted one has -# its surrounding blanks dropped. Every field is checked against the variable -# it is for before any is stored: a number must be one and nothing else (read -# by _rt_scan_number, as VAL reads one) and must fit the variable's type; a -# quoted field is a string only. A line that fails any of that, or has too few -# fields, prints "?Redo from start" and asks again -- prompt and all. More -# fields than variables print "?Extra ignored". At the end of the input every -# variable reads as empty, rather than the statement waiting forever. -# -# This replaced a reader per variable: scanf("%lf") for a number, which left -# what followed the number for the next INPUT, and the whole raw line for a -# string, so `INPUT A$, B$` read two lines and a comma meant nothing. - -# -# Win64 ABI: -# - Integer args: rcx, rdx, r8, r9 (then stack) -# - 32-byte shadow space required before every call -# - Callee-saved: rbx, rbp, rdi, rsi, r12-r15 - -# Win32 API Constants -.equ STD_INPUT_HANDLE, -10 -.equ MAX_INPUT_FIELDS, 64 # sema refuses an INPUT with more variables - -.data -_in_redo: .asciz "?Redo from start" -_in_extra: .asciz "?Extra ignored" - -# All zero-filled, so .bss rather than .data -- see data_defs.s. The .text -# below restores the section for the code that follows. -.bss -.p2align 3 -_stdin_handle: .skip 8 -_bytes_read: .skip 8 # For ReadFile output parameter -_input_fptr: .skip 8 * MAX_INPUT_FIELDS # where each field starts -_input_flen: .skip 8 * MAX_INPUT_FIELDS # and its length -_input_vals: .skip 8 * MAX_INPUT_FIELDS # a numeric field's value -_input_buf: .skip 1024 # the line read -_rl_char: .skip 8 # one byte from ReadFile - -.text - -# _rt_init_input - Initialize stdin handle (call once at startup) -# Internal: _rt_platform_init calls this; it is not a codegen entry point. -_rt_init_input: - push rbp - mov rbp, rsp - sub rsp, 32 - - # GetStdHandle(STD_INPUT_HANDLE) - mov ecx, STD_INPUT_HANDLE - call GetStdHandle - lea rcx, [rip + _stdin_handle] - mov [rcx], rax - - leave - ret - -# _rt_con_read_line - Read one line from stdin into _input_buf -# -# A byte at a time, so a line is all that is taken: reading the most ReadFile -# would give took every line a pipe had ready, and the next INPUT found none. -# The newline is consumed and not kept, as is a CR before it. A line longer -# than the buffer keeps its first 1023 characters. The console's column is 0 -# afterwards. -# -# Arguments: none -# Returns: -# rax = length (the text is also NUL-terminated) -# edx = 1 when the input had ended and nothing was read, else 0 -.globl _rt_con_read_line -_rt_con_read_line: - push rbp - mov rbp, rsp - push rbx - push r12 - sub rsp, 48 # shadow space + the 5th ReadFile argument - xor ebx, ebx # length - xor r12d, r12d # 1 once anything, even a newline, was read -.Lrl_loop: - mov rcx, QWORD PTR [rip + _stdin_handle] - lea rdx, [rip + _rl_char] - mov r8d, 1 - lea r9, [rip + _bytes_read] - mov QWORD PTR [rsp + 32], 0 - call ReadFile - test eax, eax - jz .Lrl_end_input # a broken pipe is the end of the input too - cmp DWORD PTR [rip + _bytes_read], 0 - je .Lrl_end_input - movzx eax, BYTE PTR [rip + _rl_char] - mov r12d, 1 - cmp eax, 10 - je .Lrl_done - cmp eax, 13 - je .Lrl_loop # a CR before the newline is not text - cmp rbx, 1023 - jae .Lrl_loop # past the buffer: dropped - lea rcx, [rip + _input_buf] - mov BYTE PTR [rcx + rbx], al - inc rbx - jmp .Lrl_loop -.Lrl_end_input: - xor edx, edx - test r12d, r12d - jnz .Lrl_finish # a last line without a newline still counts - mov edx, 1 - jmp .Lrl_finish -.Lrl_done: - xor edx, edx -.Lrl_finish: - lea rcx, [rip + _input_buf] - mov BYTE PTR [rcx + rbx], 0 - lea rcx, [rip + _file_col] - mov QWORD PTR [rcx], 0 - mov rax, rbx - add rsp, 48 - pop r12 - pop rbx - leave - ret - -# _rt_input_string - LINE INPUT: one whole line, as typed -# -# Arguments: none -# Returns: -# rax = pointer to the line (in _input_buf, valid until the next read) -# rdx = its length; 0 at the end of the input -.globl _rt_input_string -_rt_input_string: - push rbp - mov rbp, rsp - sub rsp, 32 # shadow space - call _rt_con_read_line - mov rdx, rax - lea rax, [rip + _input_buf] - leave - ret - -# _rt_input_line - INPUT: read and check one line for a whole statement -# -# Afterwards _rt_input_field_num and _rt_input_field_str hand out the values. -# -# Arguments: -# rcx = prompt pointer, rdx = prompt length (0 for none), already including -# the "? " when the statement asks for one -# r8 = the variables' types, one character each: '$' string, 'I' INTEGER, -# 'L' LONG, 'S' SINGLE, 'D' DOUBLE -# r9 = how many variables there are -# Returns: nothing -.globl _rt_input_line -_rt_input_line: - push rbp - mov rbp, rsp - push rbx - push r12 - push r13 - push r14 - push r15 - sub rsp, 88 # [rbp-48] prompt, [rbp-56] its length, - # [rbp-64] line length, [rbp-72] field quoted, - # [rbp-80] field length; shadow space below - mov QWORD PTR [rbp - 48], rcx - mov QWORD PTR [rbp - 56], rdx - mov r12, r8 # types - mov r13, r9 # how many - -.Lin_ask: - mov r8, QWORD PTR [rbp - 56] - test r8, r8 - jz .Lin_read - xor ecx, ecx # the console - mov rdx, QWORD PTR [rbp - 48] - call _rt_file_print_string -.Lin_read: - call _rt_con_read_line - mov QWORD PTR [rbp - 64], rax - test edx, edx - jnz .Lin_end_input - xor r14d, r14d # which field - xor r15d, r15d # where in the line - lea rbx, [rip + _input_buf] - -.Lin_field: - # Leading blanks are not part of a field. - cmp r15, QWORD PTR [rbp - 64] - jae .Lin_unquoted - movzx eax, BYTE PTR [rbx + r15] - cmp al, 32 - je .Lin_skip - cmp al, 9 - je .Lin_skip - cmp al, 34 # '"' - jne .Lin_unquoted - - # A quoted field runs to the closing quote; only blanks may follow it. - inc r15 - lea rax, [rbx + r15] - lea rcx, [rip + _input_fptr] - mov QWORD PTR [rcx + r14*8], rax - mov rcx, r15 # where it starts -.Lin_quoted: - cmp r15, QWORD PTR [rbp - 64] - jae .Lin_quoted_end # no closing quote: the rest of the line - cmp BYTE PTR [rbx + r15], 34 - je .Lin_quoted_end - inc r15 - jmp .Lin_quoted -.Lin_quoted_end: - mov rax, r15 - sub rax, rcx - lea rcx, [rip + _input_flen] - mov QWORD PTR [rcx + r14*8], rax - cmp r15, QWORD PTR [rbp - 64] - jae .Lin_quoted_flag - inc r15 # past the closing quote -.Lin_quoted_after: - cmp r15, QWORD PTR [rbp - 64] - jae .Lin_quoted_flag - movzx eax, BYTE PTR [rbx + r15] - cmp al, 44 # ',' - je .Lin_quoted_flag - cmp al, 32 - je .Lin_quoted_blank - cmp al, 9 - jne .Lin_redo # text after a quoted field -.Lin_quoted_blank: - inc r15 - jmp .Lin_quoted_after -.Lin_quoted_flag: - mov QWORD PTR [rbp - 72], 1 - jmp .Lin_check -.Lin_skip: - inc r15 - jmp .Lin_field - -.Lin_unquoted: - # An unquoted field runs to the next comma, less its trailing blanks. - mov QWORD PTR [rbp - 72], 0 - lea rax, [rbx + r15] - lea rcx, [rip + _input_fptr] - mov QWORD PTR [rcx + r14*8], rax - mov rcx, r15 -.Lin_unq_scan: - cmp r15, QWORD PTR [rbp - 64] - jae .Lin_unq_end - cmp BYTE PTR [rbx + r15], 44 - je .Lin_unq_end - inc r15 - jmp .Lin_unq_scan -.Lin_unq_end: - mov rdx, r15 -.Lin_trim: - cmp rdx, rcx - jbe .Lin_trimmed - movzx eax, BYTE PTR [rbx + rdx - 1] - cmp al, 32 - je .Lin_trim_one - cmp al, 9 - jne .Lin_trimmed -.Lin_trim_one: - dec rdx - jmp .Lin_trim -.Lin_trimmed: - sub rdx, rcx - lea rax, [rip + _input_flen] - mov QWORD PTR [rax + r14*8], rdx - -.Lin_check: - movzx eax, BYTE PTR [r12 + r14] - cmp al, 36 # '$': any text will do - je .Lin_next - cmp QWORD PTR [rbp - 72], 0 - jne .Lin_redo # a quoted field is not a number - lea rax, [rip + _input_flen] - mov rdx, QWORD PTR [rax + r14*8] - test rdx, rdx - jz .Lin_zero # an empty field is 0 - mov QWORD PTR [rbp - 80], rdx - lea rax, [rip + _input_fptr] - mov rcx, QWORD PTR [rax + r14*8] - call _rt_scan_number - test edx, edx - jnz .Lin_redo # too large for a DOUBLE - cmp rax, QWORD PTR [rbp - 80] - jne .Lin_redo # not a number, or not only one - # It must fit the variable, rounded as an assignment rounds. - movzx eax, BYTE PTR [r12 + r14] - cmp al, 73 # 'I' - je .Lin_fit_integer - cmp al, 76 # 'L' - je .Lin_fit_long - cmp al, 83 # 'S' - je .Lin_fit_single - jmp .Lin_store -.Lin_fit_integer: - cvtsd2si rax, xmm0 - movsx rcx, ax - cmp rcx, rax - jne .Lin_redo - jmp .Lin_store -.Lin_fit_long: - cvtsd2si rax, xmm0 - movsxd rcx, eax - cmp rcx, rax - jne .Lin_redo - jmp .Lin_store -.Lin_fit_single: - cvtsd2ss xmm1, xmm0 - movd eax, xmm1 - shr eax, 23 - and eax, 0xFF - cmp eax, 0xFF - je .Lin_redo - jmp .Lin_store -.Lin_zero: - xorpd xmm0, xmm0 -.Lin_store: - lea rax, [rip + _input_vals] - movsd QWORD PTR [rax + r14*8], xmm0 - -.Lin_next: - inc r14 - cmp r15, QWORD PTR [rbp - 64] - jae .Lin_at_end - inc r15 # past the comma - cmp r14, r13 - jb .Lin_field - # Every variable has its value and the line goes on. - lea rcx, [rip + _in_extra] - call .Lin_say - jmp .Lin_done -.Lin_at_end: - cmp r14, r13 - jb .Lin_redo # too few fields - jmp .Lin_done - -.Lin_redo: - lea rcx, [rip + _in_redo] - call .Lin_say - jmp .Lin_ask - -.Lin_end_input: - # Nothing more to read: every variable gets an empty value. - xor r14d, r14d -.Lin_empty: - cmp r14, r13 - jae .Lin_done - lea rax, [rip + _input_flen] - mov QWORD PTR [rax + r14*8], 0 - lea rax, [rip + _input_vals] - mov QWORD PTR [rax + r14*8], 0 - inc r14 - jmp .Lin_empty - -.Lin_done: - add rsp, 88 - pop r15 - pop r14 - pop r13 - pop r12 - pop rbx - leave - ret - -# Write the message at rcx on a line of its own. Reached by `call` from -# _rt_input_line's aligned body. -.Lin_say: - push rbx - sub rsp, 32 # shadow space; rsp is 16-byte aligned - mov rbx, rcx - call lstrlenA - mov r8, rax - mov rdx, rbx - xor ecx, ecx - call _rt_file_print_string - xor ecx, ecx - call _rt_file_print_newline - add rsp, 32 - pop rbx - ret - -# _rt_input_field_num - The value INPUT read for numeric variable `k` -# Arguments: rcx = k Returns: xmm0 = the value -.globl _rt_input_field_num -_rt_input_field_num: - lea rax, [rip + _input_vals] - movsd xmm0, QWORD PTR [rax + rcx*8] - ret - -# _rt_input_field_str - The text INPUT read for string variable `k` -# -# A copy, since the line buffer is reused by the next read. -# -# Arguments: rcx = k Returns: rax = pointer, rdx = length -.globl _rt_input_field_str -_rt_input_field_str: - lea rax, [rip + _input_flen] - mov rdx, QWORD PTR [rax + rcx*8] - test rdx, rdx - jz .Lin_field_empty - lea rax, [rip + _input_fptr] - mov rcx, QWORD PTR [rax + rcx*8] - jmp _rt_strdup -.Lin_field_empty: - xor eax, eax - xor edx, edx - ret diff --git a/src/runtime/win64-native/math.s b/src/runtime/win64-native/math.s deleted file mode 100644 index 2bc4f0d..0000000 --- a/src/runtime/win64-native/math.s +++ /dev/null @@ -1,475 +0,0 @@ -# BASIC Runtime: Math and Utility Functions (Win64 Native - Pure Win32 API) -# -# Miscellaneous functions. Uses Win32 API instead of libc. -# -# Note: Most math functions (SIN, COS, SQR, etc.) are implemented inline in -# codegen.rs using x87 FPU or SSE instructions. -# -# Win64 ABI: -# - Args: rcx, rdx, r8, r9 -# - 32-byte shadow space required before calls - -# Win32 API Constants -.equ STD_OUTPUT_HANDLE, -11 - -.data -_rng_state: .quad 0x12345678DEADBEEF -_rng_last: .quad 0 # last value RND returned, for RND(0) -_cls_seq: .ascii "\033[2J\033[H" -# The length is bracketed by labels and subtracted at run time rather than -# computed by the assembler, because this tree has two assemblers: GNU as -# builds it nowhere, and clang builds it on Windows, where `.equ len, . - lbl` -# did not reach WriteFile as 7. Two instructions buy an answer that does not -# depend on which one ran. -_cls_seq_end: -_locate_fmt: .asciz "\033[%d;%dH" -_locate_row_fmt: .asciz "\033[%dd" -_locate_col_fmt: .asciz "\033[%dG" -_date_fmt: .asciz "%m-%d-%Y" -_time_fmt: .asciz "%H:%M:%S" -_color_fmt: .asciz "\033[%d;%d;%dm" -_color_fg_fmt: .asciz "\033[%d;%dm" -_color_bg_fmt: .asciz "\033[%dm" -# GW-BASIC colour 0-7 -> ANSI colour: black blue green cyan red magenta brown white -_gw_to_ansi: .byte 0, 4, 2, 6, 1, 5, 3, 7 -_esc_buf: .skip 32 - -# Zero-filled scratch, so .bss rather than .data -- see data_defs.s. The -# .text below restores the section for the code that follows. -.bss -.p2align 3 -_cls_bytes_written: .skip 8 - -.text - -# _rt_rnd - Generate random number (RND function) -# Returns a pseudo-random number in the range [0, 1). -# -# Arguments: -# xmm0 = the argument, as GW-BASIC reads it: RND(0) repeats the last -# number, RND(<0) reseeds from the value first, RND(>0) is the next -# -# Returns: -# xmm0 = random double in [0, 1) -# -# Algorithm: Xorshift64 -.globl _rt_rnd -_rt_rnd: - push rbp - mov rbp, rsp - - # GW-BASIC's argument selects the behaviour: - # RND(<0) reseeds from that value and returns the next number - # RND(0) returns the previous number again - # RND(>0), and a bare RND, return the next number - # The argument used to be ignored entirely, so RND(0) advanced like any - # other call and RND(-1) -- the idiom for a repeatable run -- did nothing. - xorpd xmm1, xmm1 - ucomisd xmm0, xmm1 - jp .Lrnd_next # NaN: treat as "next" - je .Lrnd_repeat - jb .Lrnd_reseed - jmp .Lrnd_next - -.Lrnd_reseed: - sub rsp, 32 # shadow space for the call - call _rt_randomize # consumes xmm0, leaves the state seeded - add rsp, 32 - jmp .Lrnd_next - -.Lrnd_repeat: - movsd xmm0, QWORD PTR [rip + _rng_last] - leave - ret - -.Lrnd_next: - # Load current state - mov rax, QWORD PTR [rip + _rng_state] - - # Xorshift64 algorithm - mov rcx, rax - shl rcx, 13 - xor rax, rcx # state ^= state << 13 - - mov rcx, rax - shr rcx, 7 - xor rax, rcx # state ^= state >> 7 - - mov rcx, rax - shl rcx, 17 - xor rax, rcx # state ^= state << 17 - - # Save new state - mov QWORD PTR [rip + _rng_state], rax - - # Convert to double in [0, 1) - shr rax, 12 # Keep top 52 bits - mov rcx, 0x3FF0000000000000 # IEEE 754: exponent=1023 (value=1.0) - or rax, rcx # Combine: value in [1,2) - movq xmm0, rax - - # Subtract 1.0 to get [0, 1) - mov rcx, 0x3FF0000000000000 - movq xmm1, rcx - subsd xmm0, xmm1 - - # Remember it, so that RND(0) can hand back the same number. - movsd QWORD PTR [rip + _rng_last], xmm0 - - leave - ret - -# _rt_beep - BEEP: ring the terminal bell -# -# Arguments: none Returns: nothing -.globl _rt_beep -_rt_beep: - push rbp - mov rbp, rsp - sub rsp, 32 - mov ecx, 7 # BEL - call putchar - add rsp, 32 - leave - ret - -# _rt_date - DATE$: the date as MM-DD-YYYY, GW-BASIC's shape -# -# Arguments: none -# Returns: rax = pointer, rdx = length -.globl _rt_date -_rt_date: - push rbp - mov rbp, rsp - sub rsp, 48 # shadow space + a time_t - lea rcx, [rsp + 32] - call time - lea rcx, [rsp + 32] - call localtime - mov r9, rax # struct tm * - lea rcx, [rip + _num_buf] - mov rdx, 64 - lea r8, [rip + _date_fmt] - call strftime - lea rcx, [rip + _num_buf] - mov rdx, rax - add rsp, 48 - leave - jmp _rt_strdup # the caller may hold another such result - -# _rt_time - TIME$: the time as HH:MM:SS -# -# Arguments: none -# Returns: rax = pointer, rdx = length -.globl _rt_time -_rt_time: - push rbp - mov rbp, rsp - sub rsp, 48 # shadow space + a time_t - lea rcx, [rsp + 32] - call time - lea rcx, [rsp + 32] - call localtime - mov r9, rax # struct tm * - lea rcx, [rip + _num_buf] - mov rdx, 64 - lea r8, [rip + _time_fmt] - call strftime - lea rcx, [rip + _num_buf] - mov rdx, rax - add rsp, 48 - leave - jmp _rt_strdup # the caller may hold another such result - -# _rt_pos - POS(n): the column the next character will be written to -# -# The tracker counts characters already on the line, and BASIC columns start at -# one, so this is that count plus one. -# -# Arguments: none -# Returns: eax = column (1-based) -.globl _rt_pos -_rt_pos: - push rbp - mov rbp, rsp - lea rax, [rip + _file_col] - mov rax, QWORD PTR [rax] - inc rax - leave - ret - -# _rt_locate - LOCATE row, col: move the cursor -# -# Written as an ANSI escape, the same way _rt_cls clears the screen. The column -# tracker is updated to match, so that a following TAB or PRINT zone counts from -# where the cursor actually is. An omitted coordinate stays where it is: CUP -# moves both, VPA only the row, CHA only the column. -# -# Arguments: rcx = row (1-based), rdx = column (1-based); -1 = omitted -# Returns: nothing -.globl _rt_locate -_rt_locate: - push rbp - mov rbp, rsp - push rbx - push r12 - sub rsp, 48 # shadow space + the 5th WriteFile argument - - mov r12, rdx # column, kept for the tracker; -1 = unmoved - test rcx, rcx - js .Lwlocate_col_only - test rdx, rdx - js .Lwlocate_row_only - mov r8, rcx # row - mov r9, rdx # col - lea rcx, [rip + _esc_buf] - lea rdx, [rip + _locate_fmt] - call sprintf - jmp .Lwlocate_write -.Lwlocate_row_only: - mov r8, rcx - lea rcx, [rip + _esc_buf] - lea rdx, [rip + _locate_row_fmt] - call sprintf - jmp .Lwlocate_write -.Lwlocate_col_only: - test rdx, rdx - js .Lwlocate_done # neither: nothing moves - mov r8, rdx - lea rcx, [rip + _esc_buf] - lea rdx, [rip + _locate_col_fmt] - call sprintf -.Lwlocate_write: - mov rbx, rax # length written - mov ecx, STD_OUTPUT_HANDLE - call GetStdHandle - mov rcx, rax - lea rdx, [rip + _esc_buf] - mov r8, rbx - lea r9, [rip + _cls_bytes_written] - mov QWORD PTR [rsp + 32], 0 - call WriteFile - - # The tracker counts characters before the cursor, so column 1 is 0. - test r12, r12 - js .Lwlocate_done - dec r12 - lea rax, [rip + _file_col] - mov QWORD PTR [rax], r12 -.Lwlocate_done: - add rsp, 48 - pop r12 - pop rbx - leave - ret - -# _rt_color - COLOR foreground, background -# -# GW-BASIC numbers 0-15 with 8-15 as the bright half; ANSI splits that into two -# ranges, 30-37 and 90-97 for the foreground and 40-47 and 100-107 for the -# background. The eight hues are in a different order (GW-BASIC's 1 is blue, -# ANSI's red), so they go through _gw_to_ansi. A foreground of 16-31 is the same -# colour blinking, so every foreground also sets or clears blink (SGR 5 / 25). -# An omitted one is left as it was. -# -# Arguments: rcx = foreground 0-31, rdx = background 0-15; -1 = omitted -# Returns: nothing -.globl _rt_color -_rt_color: - push rbp - mov rbp, rsp - push rbx - push r12 - sub rsp, 48 # shadow space + a 5th argument - - # Background: 0-7 -> 40-47, 8-15 -> 100-107; -1 stays negative - mov r10, rcx # foreground, out of the way of the table - mov r12, rdx - lea r11, [rip + _gw_to_ansi] - test r12, r12 - js .Lwcolor_bg_done - mov rax, r12 - and eax, 7 - movzx eax, BYTE PTR [r11 + rax] - cmp r12, 8 - lea r12, [rax + 40] - jl .Lwcolor_bg_done - add r12, 100 - 40 -.Lwcolor_bg_done: - - mov rax, r10 - test rax, rax - js .Lwcolor_bg_only - - # Foreground: 16-31 blink; then 0-7 -> 30-37, 8-15 -> 90-97 - mov r8d, 25 # blink off - cmp rax, 16 - jl .Lwcolor_steady - mov r8d, 5 # blink on - sub rax, 16 -.Lwcolor_steady: - mov r10, rax - and eax, 7 - movzx eax, BYTE PTR [r11 + rax] - add eax, 30 - cmp r10, 8 - jl .Lwcolor_fg_done - add eax, 90 - 30 -.Lwcolor_fg_done: - mov r9, rax - lea rcx, [rip + _esc_buf] - test r12, r12 - js .Lwcolor_fg_only - mov QWORD PTR [rsp + 32], r12 - lea rdx, [rip + _color_fmt] - call sprintf - jmp .Lwcolor_write -.Lwcolor_fg_only: - lea rdx, [rip + _color_fg_fmt] - call sprintf - jmp .Lwcolor_write - -.Lwcolor_bg_only: - test r12, r12 - js .Lwcolor_done # neither: nothing changes - mov r8, r12 - lea rcx, [rip + _esc_buf] - lea rdx, [rip + _color_bg_fmt] - call sprintf -.Lwcolor_write: - mov rbx, rax # length written - mov ecx, STD_OUTPUT_HANDLE - call GetStdHandle - mov rcx, rax - lea rdx, [rip + _esc_buf] - mov r8, rbx - lea r9, [rip + _cls_bytes_written] - mov QWORD PTR [rsp + 32], 0 - call WriteFile - -.Lwcolor_done: - add rsp, 48 - pop r12 - pop rbx - leave - ret - -# _rt_randomize - RANDOMIZE: set the generator's seed -# -# The state was a fixed constant with no way to change it, so every run of every -# program produced the same numbers -- a dice game rolled the same dice every -# time it was played. -# -# The seed's bit pattern is passed through a splitmix64 avalanche rather than -# used directly: BASIC seeds are small integers, and xorshift64 started from a -# small state produces a visibly poor first few values. Zero is replaced, -# because it is xorshift's fixed point and would return 0 forever. -# -# Arguments: xmm0 = seed -# Returns: nothing -.globl _rt_randomize -_rt_randomize: - push rbp - mov rbp, rsp - movq rax, xmm0 - mov rcx, 0x9E3779B97F4A7C15 - add rax, rcx - mov rcx, rax - shr rcx, 30 - xor rax, rcx - mov rcx, 0xBF58476D1CE4E5B9 - imul rax, rcx - mov rcx, rax - shr rcx, 27 - xor rax, rcx - mov rcx, 0x94D049BB133111EB - imul rax, rcx - mov rcx, rax - shr rcx, 31 - xor rax, rcx - test rax, rax - jnz .Lrandomize_store - mov rax, 0x12345678DEADBEEF # xorshift64 must never hold zero -.Lrandomize_store: - mov QWORD PTR [rip + _rng_state], rax - leave - ret - -# _rt_timer - TIMER: seconds since local midnight -# This used to return GetTickCount64() / 1000, which is seconds since the -# machine booted -- not what LANGREF documents, not what the System V runtime -# returns, and not what any BASIC program expects. A CI runner three minutes -# old reported 208.437 where the time of day was wanted. -# -# Midnight is local, the clock TIME$ reads -- and through the same CRT, so both -# honour TZ. GetSystemTime (UTC) and GetLocalTime (the system zone, ignoring -# TZ) would each disagree with TIME$ somewhere. _ftime64 gives the seconds and -# the milliseconds from one reading, so they cannot straddle a second: -# struct __timeb64 is { __time64_t time; unsigned short millitm; ... }. -# -# Arguments: none -# -# Returns: -# xmm0 = seconds since midnight (double, 0 <= t < 86401 across a leap second) -.globl _rt_timer -_rt_timer: - push rbp - mov rbp, rsp - sub rsp, 48 # shadow space, then a 16-byte __timeb64 above it - - lea rcx, [rsp + 32] - call _ftime64 - - lea rcx, [rsp + 32] # &tb.time is a 64-bit time_t * - call localtime # struct tm *: tm_sec, tm_min, tm_hour are ints - mov ecx, DWORD PTR [rax + 8] - imul ecx, ecx, 3600 - mov edx, DWORD PTR [rax + 4] - imul edx, edx, 60 - add ecx, edx - add ecx, DWORD PTR [rax] - cvtsi2sd xmm0, ecx - - movzx ecx, WORD PTR [rsp + 32 + 8] - cvtsi2sd xmm1, ecx - mov rax, 0x408F400000000000 # 1000.0 - movq xmm2, rax - divsd xmm1, xmm2 - addsd xmm0, xmm1 - - leave - ret - -# _rt_cls - Clear screen (CLS statement) -# Uses ANSI escape sequences via console output. -# -# Arguments: none -# Returns: nothing -.globl _rt_cls -_rt_cls: - push rbp - mov rbp, rsp - sub rsp, 48 # Shadow space + stack arg - - # Home the column tracker too. The cursor is at column 1 after this, and a - # later TAB that believed the old column emitted a newline to reach a - # column it had already passed. - lea rax, [rip + _file_col] - mov QWORD PTR [rax], 0 - - # Get stdout handle - mov ecx, STD_OUTPUT_HANDLE - call GetStdHandle - - # WriteFile(handle, cls_seq, cls_seq_len, &bytesWritten, NULL) - mov rcx, rax # handle - lea rdx, [rip + _cls_seq] - lea r8, [rip + _cls_seq_end] - sub r8, rdx # length, from the data's own labels - lea r9, [rip + _cls_bytes_written] - mov QWORD PTR [rsp + 32], 0 - call WriteFile - - leave - ret - diff --git a/src/runtime/win64-native/print.s b/src/runtime/win64-native/print.s deleted file mode 100644 index d35f31b..0000000 --- a/src/runtime/win64-native/print.s +++ /dev/null @@ -1,384 +0,0 @@ -# BASIC Runtime: Print Functions (Win64 Native - Pure Win32 API) -# -# Output functions using Win32 API (WriteFile) instead of libc printf. -# Uses UCRT sprintf for number formatting. -# -# Win64 ABI: -# - Integer args: rcx, rdx, r8, r9 (then stack) -# - 32-byte shadow space required before every call -# - Callee-saved: rbx, rbp, rdi, rsi, r12-r15 -# - -# Win32 API Constants -.equ STD_OUTPUT_HANDLE, -11 -.equ ENABLE_VIRTUAL_TERMINAL_PROCESSING, 4 - -# I/O size constants -.equ SINGLE_BYTE, 1 -.equ CRLF_LEN, 2 - - -.data -_newline_str: .ascii "\r\n" # Windows uses CRLF - -# Zero-filled scratch, so .bss rather than .data -- see data_defs.s. The -# .text below restores the section for the code that follows; a .bss left -# open at the end of this file would swallow the next runtime part. -.bss -.p2align 3 -_print_buffer: .skip 64 # Buffer for number formatting -_bytes_written: .skip 8 # For WriteFile output parameter - -.text - -# _rt_platform_init - Acquire the console handles (call once at startup) -# The console is file handle 0, so every print helper reaches it the same way -# it reaches an OPENed file. Windows has to ask the OS for the handle first; -# System V finds its standard output stream already open. -# -# Arguments: none Returns: nothing -.globl _rt_platform_init -_rt_platform_init: - push rbp - mov rbp, rsp - sub rsp, 32 - - # GetStdHandle(STD_OUTPUT_HANDLE) -> _file_handles[0] - mov ecx, STD_OUTPUT_HANDLE - call GetStdHandle - lea rcx, [rip + _file_handles] - mov [rcx], rax - lea rcx, [rip + _file_mode] - mov QWORD PTR [rcx], 1 # the console is written to - - # Turn on VT processing, so the escape sequences CLS, LOCATE and COLOR - # write are acted on rather than printed literally. CLS has emitted them - # since it was written and simply assumed this was already set; on a - # console where it is not, it printed "^[[2J^[[H" and cleared nothing. - # - # Best effort: a failure here means the handle is not a console -- output - # redirected to a file, say -- and the escapes are then just bytes in the - # file, which is what any terminal program does. - mov rcx, [rcx] # the handle just stored - lea rdx, [rip + _console_mode] - call GetConsoleMode - test eax, eax - jz .Lplatform_no_console - lea rax, [rip + _console_mode] - mov ecx, DWORD PTR [rax] - or ecx, ENABLE_VIRTUAL_TERMINAL_PROCESSING - mov edx, ecx - lea rcx, [rip + _file_handles] - mov rcx, [rcx] - call SetConsoleMode -.Lplatform_no_console: - - call _rt_init_input - - leave - ret - - -# _rt_fmt_double - Format a number into _num_buf -# Shared by console and file output so both render numbers identically. -# -# GW-BASIC's rule, which QuickBASIC documents: a value is rounded to the -# type's significant digits -- 7 for a SINGLE, 16 for a DOUBLE -- and written -# in fixed point when that shows it in at most that many digits, otherwise -# with an exponent. So a SINGLE's 1.1E-6 prints .0000011 and 1.1E-7 prints -# 1.1E-07; 1234567 prints in full and 12345678 as 1.234568E+07. Trailing zeros -# are dropped, a value below one has no leading zero, and the exponent is -# spelled E for a SINGLE and D for a DOUBLE, with at least two digits. -# -# This used to print the shortest decimal that read back unchanged, so a -# DOUBLE showed 17 digits (.1 + .2 printed .30000000000000004), a SINGLE up to -# 9, and any whole number below 2^63 in full whatever its type. -# -# Arguments: -# xmm0 = value (a SINGLE arrives already widened to double) -# ecx = nonzero for a SINGLE -# -# Returns: -# rax = length of the text in _num_buf -.globl _rt_fmt_double -_rt_fmt_double: - push rbp - mov rbp, rsp - push rbx - push r12 - push r13 - push r14 - sub rsp, 32 # shadow space; rsp is 16-byte aligned - mov r12d, ecx # nonzero for a SINGLE - mov r13d, 16 # significant digits, P - test r12d, r12d - jz .Lfd_digits - mov r13d, 7 -.Lfd_digits: - - # Zero, of either sign, is 0. - xorpd xmm1, xmm1 - ucomisd xmm0, xmm1 - jp .Lfd_nonzero - jne .Lfd_nonzero - lea rcx, [rip + _num_buf] - mov WORD PTR [rcx], 48 # "0", NUL - mov eax, 1 - jmp .Lfd_ret -.Lfd_nonzero: - # sprintf(_fmt_scratch, "%.*e", P - 1, value): a variadic double goes in - # its integer register as well as its vector one. - lea rcx, [rip + _fmt_scratch] - lea rdx, [rip + _fmt_sci] - lea r8d, [r13 - 1] - movq r9, xmm0 - movapd xmm3, xmm0 - call sprintf - lea rbx, [rip + _fmt_scratch] # read cursor - - # The text is "[-]d.ddd...e[+-]xx": P significant digits, already rounded - # by printf. From here on no call is made, and only registers volatile in - # both ABIs are used (plus rbx, r12-r14, saved above), so this body is - # identical in both trees. - lea r14, [rip + _num_buf] # write cursor - cmp BYTE PTR [rbx], 45 # '-' - jne .Lfd_unsigned - mov BYTE PTR [r14], 45 - inc rbx - inc r14 -.Lfd_unsigned: - movzx eax, BYTE PTR [rbx] - sub eax, 48 - cmp eax, 9 - ja .Lfd_raw # inf or nan: as the C library wrote it - - # The P digits, without the point. - lea r8, [rip + _fmt_digits] - mov al, BYTE PTR [rbx] - mov BYTE PTR [r8], al - mov ecx, 1 - lea r9, [rbx + 2] # past the leading digit and the point -.Lfd_gather: - cmp ecx, r13d - jge .Lfd_gathered - mov al, BYTE PTR [r9] - mov BYTE PTR [r8 + rcx], al - inc r9 - inc ecx - jmp .Lfd_gather -.Lfd_gathered: - # The decimal exponent X, so the value is d.ddd * 10^X. - inc r9 # past 'e' - mov r10b, BYTE PTR [r9] # its sign - inc r9 - xor edx, edx -.Lfd_expdig: - movzx eax, BYTE PTR [r9] - test eax, eax - jz .Lfd_expdone - sub eax, 48 - imul edx, edx, 10 - add edx, eax - inc r9 - jmp .Lfd_expdig -.Lfd_expdone: - cmp r10b, 45 # '-' - jne .Lfd_exppos - neg edx -.Lfd_exppos: - - # n = how many of them are significant: trailing zeros are not. - mov ecx, r13d -.Lfd_trim: - cmp ecx, 1 - jle .Lfd_trimmed - cmp BYTE PTR [r8 + rcx - 1], 48 - jne .Lfd_trimmed - dec ecx - jmp .Lfd_trim -.Lfd_trimmed: - # Fixed point when it shows the value in at most P digits, as GW-BASIC - # and QuickBASIC do: X+1 integer digits for X >= 0, or for X < 0 the - # -X-1 zeros after the point and then the n digits. - test edx, edx - js .Lfd_small - cmp edx, r13d - jge .Lfd_sci - - xor r11d, r11d # X >= 0: the integer part ... -.Lfd_int: - cmp r11d, edx - jg .Lfd_intdone - mov al, 48 # a digit past n is a zero - cmp r11d, ecx - jge .Lfd_intput - mov al, BYTE PTR [r8 + r11] -.Lfd_intput: - mov BYTE PTR [r14], al - inc r14 - inc r11d - jmp .Lfd_int -.Lfd_intdone: - cmp r11d, ecx # ... and a fraction, if any is left - jge .Lfd_end - mov BYTE PTR [r14], 46 # '.' - inc r14 -.Lfd_frac: - cmp r11d, ecx - jge .Lfd_end - mov al, BYTE PTR [r8 + r11] - mov BYTE PTR [r14], al - inc r14 - inc r11d - jmp .Lfd_frac - -.Lfd_small: # X < 0: no leading zero, as .5 - mov eax, edx - neg eax - dec eax # zeros between the point and n - lea r10d, [rax + rcx] - cmp r10d, r13d - jg .Lfd_sci - mov BYTE PTR [r14], 46 # '.' - inc r14 -.Lfd_lead: - test eax, eax - jz .Lfd_leaddone - mov BYTE PTR [r14], 48 - inc r14 - dec eax - jmp .Lfd_lead -.Lfd_leaddone: - xor r11d, r11d - jmp .Lfd_frac - -.Lfd_sci: # d[.ddd]E+xx, D for a DOUBLE - mov al, BYTE PTR [r8] - mov BYTE PTR [r14], al - inc r14 - cmp ecx, 1 - jle .Lfd_sciexp - mov BYTE PTR [r14], 46 - inc r14 - mov r11d, 1 -.Lfd_scifrac: - cmp r11d, ecx - jge .Lfd_sciexp - mov al, BYTE PTR [r8 + r11] - mov BYTE PTR [r14], al - inc r14 - inc r11d - jmp .Lfd_scifrac -.Lfd_sciexp: - mov al, 68 # 'D' - test r12d, r12d - jz .Lfd_letter - mov al, 69 # 'E' -.Lfd_letter: - mov BYTE PTR [r14], al - inc r14 - mov al, 43 # '+' - test edx, edx - jns .Lfd_expsign - mov al, 45 # '-' - neg edx -.Lfd_expsign: - mov BYTE PTR [r14], al - inc r14 - mov r10d, 10 - cmp edx, 100 # two digits at least, three if needed - jl .Lfd_twodigits - mov eax, edx - xor edx, edx - mov r10d, 100 - div r10d - add al, 48 - mov BYTE PTR [r14], al - inc r14 - mov r10d, 10 -.Lfd_twodigits: - mov eax, edx - xor edx, edx - div r10d - add al, 48 - mov BYTE PTR [r14], al - add dl, 48 - mov BYTE PTR [r14 + 1], dl - add r14, 2 - jmp .Lfd_end - -.Lfd_raw: - mov al, BYTE PTR [rbx] - test al, al - jz .Lfd_end - mov BYTE PTR [r14], al - inc rbx - inc r14 - jmp .Lfd_raw - -.Lfd_end: - mov BYTE PTR [r14], 0 - lea rax, [rip + _num_buf] - sub r14, rax - mov rax, r14 # the length - -.Lfd_ret: - add rsp, 32 - pop r14 - pop r13 - pop r12 - pop rbx - pop rbp - ret - -# _rt_fmt_basic - Render a number the way BASIC writes it -# -# _rt_fmt_double gives the digits; this adds the blank that stands where a -# minus sign would go. GW-BASIC puts one there for every non-negative number, -# which is why `PRINT 1; 2` reads " 1 2 " and why STR$(5) is " 5" -- the -# `MID$(STR$(N), 2)` idiom exists to strip exactly this blank. -# -# Not folded into _rt_fmt_double, because WRITE and PRINT USING render numbers -# through that and must not gain the blank. -# -# Arguments: the same as _rt_fmt_double -# Returns: rax = length of the text in _num_buf -.globl _rt_fmt_basic -_rt_fmt_basic: - push rbp - mov rbp, rsp - sub rsp, 32 # shadow space - call _rt_fmt_double - lea rcx, [rip + _num_buf] - cmp BYTE PTR [rcx], 45 # '-' already occupies the sign position - je .Lfb_done - # Shift right by one, the NUL at [rax] included, and blank the vacancy. - mov rdx, rax -.Lfb_shift: - mov r9b, BYTE PTR [rcx + rdx] - mov BYTE PTR [rcx + rdx + 1], r9b - dec rdx - jns .Lfb_shift - mov BYTE PTR [rcx], 32 # ' ' - inc rax -.Lfb_done: - leave - ret - -# _rt_end - Terminate the program normally (END / STOP) -# Valid from any frame, including inside a SUB or FUNCTION. Emitting a plain -# `leave; ret` for END only terminates when it appears in main; inside a -# procedure it merely returns to the caller and execution continues. -# -# ExitProcess is safe here because this runtime writes console and file output -# with WriteFile rather than through CRT buffering. -# -# Arguments: none -# Returns: never -.globl _rt_end -_rt_end: - push rbp - mov rbp, rsp - sub rsp, 32 # Shadow space - xor ecx, ecx # exit code 0 - call ExitProcess diff --git a/src/runtime/win64-native/string.s b/src/runtime/win64-native/string.s deleted file mode 100644 index cf2cc41..0000000 --- a/src/runtime/win64-native/string.s +++ /dev/null @@ -1,997 +0,0 @@ -# BASIC Runtime: String Functions (Win64 Native - Pure Win32 API) -# -# String manipulation functions. Every string they allocate comes from -# malloc, since generated code frees the strings it owns with free. -# Keeps UCRT functions: strtod, sprintf, memcpy, memcmp -# -# String Representation: -# BASIC strings are (pointer, length) pairs. They are NOT null-terminated -# internally. -# -# String Return Convention: -# - rax = pointer to string data -# - rdx = length in bytes -# -# Memory Management: -# - Substring functions return pointers into original string (no allocation) -# - String concatenation allocates with malloc -# - Conversion functions (STR$, CHR$, HEX$, OCT$) format into a scratch -# buffer and return a heap copy of it, so that two of them in one -# expression cannot alias; see the System V tree for the failure -# -# Win64 ABI: -# - Args: rcx, rdx, r8, r9 (then stack) -# - Callee-saved: rbx, rbp, rdi, rsi, r12-r15 -# - 32-byte shadow space required before calls - -# String length constants -.equ CHR_RESULT_LEN, 1 # CHR$() always returns 1 character - -.data -_fmt_hex: .asciz "%llX" -_fmt_oct: .asciz "%llo" - -# Zero-filled scratch, so .bss rather than .data -- see data_defs.s. The -# .text below restores the section for the code that follows. -.bss -.p2align 3 -_str_buf: .skip 64 # Scratch for HEX$()/OCT$(); never returned -_chr_buf: .skip 2 # Scratch for CHR$(); never returned - -.text - -# _rt_val - VAL: the number a string begins with -# -# See the System V twin. -# -# Arguments: -# rcx = pointer to string -# rdx = length -# -# Returns: -# xmm0 = the value -.globl _rt_val -_rt_val: - push rbp - mov rbp, rsp - sub rsp, 32 # shadow space - call _rt_scan_number - test edx, edx - jnz .Lval_overflow - leave - ret -.Lval_overflow: - lea rcx, [rip + _err_overflow] - xor edx, edx - call _rt_error # returns only when trapped - xorpd xmm0, xmm0 - leave - ret - -# _rt_scan_number - Read a number the way GW-BASIC's VAL and INPUT do -# -# Shared by VAL, INPUT, INPUT # and READ, so they all accept the same text: -# leading blanks; blanks inside the number, which are ignored ("1 2" is 12); -# a sign; digits with at most one point; an exponent spelled E or D, with an -# optional sign; or &H, &O, &B or a bare & followed by digits, which are an -# INTEGER when they fit 16 bits and a LONG when they fit 32 -- two's -# complement, as a literal. Scanning stops at the first character that cannot -# continue the number. strtod saw the text directly before, so VAL accepted -# "inf", "nan" and "0x1F", read past the end of a LEFT$ view, and knew no D. -# -# Arguments: -# rcx = pointer, rdx = length -# -# Returns: -# xmm0 = the value, 0 when there is no number -# rax = characters consumed, up to the last that belongs to the number; -# 0 when there is no number at all -# edx = 1 when the value is too large for a DOUBLE, else 0 -.globl _rt_scan_number -_rt_scan_number: - push rbp - mov rbp, rsp - push rbx - push r12 - push r13 - push r14 - push r15 - sub rsp, 56 # shadow space + endptr slot; 16-byte aligned - mov r12, rcx # the text - mov r13, rdx # its length - xor ebx, ebx # index into the text - xor r15d, r15d # consumed: just past the last character used - xor r14d, r14d # length of the copy in _scan_buf - xor r8d, r8d # stage: 0 sign, 1 mantissa, 2 exponent sign, 3 exponent - xor r9d, r9d # a point has been seen - -.Lsn_lead: - cmp rbx, r13 - jae .Lsn_none - movzx eax, BYTE PTR [r12 + rbx] - cmp al, 32 - je .Lsn_lead_next - cmp al, 9 - je .Lsn_lead_next - cmp al, 38 # '&' - je .Lsn_radix - lea r10, [rip + _scan_buf] - jmp .Lsn_loop -.Lsn_lead_next: - inc rbx - jmp .Lsn_lead - -.Lsn_loop: - cmp rbx, r13 - jae .Lsn_convert - cmp r14, 120 # the copy's room; a longer number has no more precision - jae .Lsn_convert - movzx eax, BYTE PTR [r12 + rbx] - cmp al, 32 # blanks inside a number are skipped - je .Lsn_next - cmp al, 9 - je .Lsn_next - cmp al, 48 - jb .Lsn_not_digit - cmp al, 57 - ja .Lsn_not_digit - # A digit: in the mantissa, or the exponent once it has begun. - cmp r8d, 2 - jb .Lsn_mant_digit - mov r8d, 3 - jmp .Lsn_take -.Lsn_mant_digit: - mov r8d, 1 - jmp .Lsn_take -.Lsn_not_digit: - cmp al, 43 # '+' - je .Lsn_sign - cmp al, 45 # '-' - je .Lsn_sign - cmp al, 46 # '.' - je .Lsn_point - or al, 32 # fold case for the exponent letters - cmp al, 101 # 'e' - je .Lsn_exp - cmp al, 100 # 'd' - je .Lsn_exp - jmp .Lsn_convert -.Lsn_sign: - cmp r8d, 0 # a sign begins the number ... - je .Lsn_sign_ok - cmp r8d, 2 # ... or its exponent, and nothing else - jne .Lsn_convert -.Lsn_sign_ok: - inc r8d - mov BYTE PTR [r10 + r14], al - inc r14 - jmp .Lsn_next -.Lsn_point: - cmp r8d, 1 - ja .Lsn_convert # no point in an exponent - test r9d, r9d - jnz .Lsn_convert # nor a second one - mov r9d, 1 - mov r8d, 1 - jmp .Lsn_take -.Lsn_exp: - cmp r8d, 1 # only after some of the mantissa - jne .Lsn_convert - mov r8d, 2 - mov al, 101 # strtod's spelling - mov BYTE PTR [r10 + r14], al - inc r14 - jmp .Lsn_next -.Lsn_take: - mov BYTE PTR [r10 + r14], al - inc r14 - lea r15, [rbx + 1] -.Lsn_next: - inc rbx - jmp .Lsn_loop - -.Lsn_convert: - mov BYTE PTR [r10 + r14], 0 - test r15, r15 - jz .Lsn_none - lea rcx, [rip + _scan_buf] - lea rdx, [rsp + 40] # &endptr - call strtod - mov rcx, QWORD PTR [rsp + 40] - lea rax, [rip + _scan_buf] - cmp rcx, rax - je .Lsn_none # "+", "." and the like are no number - # Infinity is the only way past DOUBLE's range. - movq rax, xmm0 - shr rax, 52 - and eax, 0x7FF - xor edx, edx - cmp eax, 0x7FF - jne .Lsn_done - mov edx, 1 - xorpd xmm0, xmm0 - jmp .Lsn_done - -.Lsn_radix: - inc rbx # past '&' - mov ecx, 8 # a bare & is octal - cmp rbx, r13 - jae .Lsn_radix_digits - movzx eax, BYTE PTR [r12 + rbx] - or al, 32 - cmp al, 104 # 'h' - jne .Lsn_radix_o - mov ecx, 16 - inc rbx - jmp .Lsn_radix_digits -.Lsn_radix_o: - cmp al, 111 # 'o' - jne .Lsn_radix_b - inc rbx - jmp .Lsn_radix_digits -.Lsn_radix_b: - cmp al, 98 # 'b' - jne .Lsn_radix_digits - mov ecx, 2 - inc rbx -.Lsn_radix_digits: - xor r10d, r10d # the value - xor r11d, r11d # 1 once it no longer fits 32 bits -.Lsn_radix_loop: - cmp rbx, r13 - jae .Lsn_radix_end - movzx eax, BYTE PTR [r12 + rbx] - sub eax, 48 - cmp eax, 9 - jbe .Lsn_radix_have # 0-9 - movzx eax, BYTE PTR [r12 + rbx] - or al, 32 - sub eax, 87 # 'a' -> 10 - cmp eax, 10 - jb .Lsn_radix_end -.Lsn_radix_have: - cmp eax, ecx - jae .Lsn_radix_end # not a digit of this radix - imul r10, rcx - add r10, rax - mov rax, r10 - shr rax, 32 - jz .Lsn_radix_fits - mov r11d, 1 - and r10d, r10d # keep it bounded; the overflow is recorded -.Lsn_radix_fits: - inc rbx - lea r15, [rbx] - jmp .Lsn_radix_loop -.Lsn_radix_end: - test r15, r15 - jz .Lsn_none - mov edx, r11d - test edx, edx - jnz .Lsn_radix_zero - cmp r10, 0xFFFF - ja .Lsn_radix_long - movsx eax, r10w # up to 16 bits: an INTEGER, two's complement - cvtsi2sd xmm0, eax - jmp .Lsn_done -.Lsn_radix_long: - cvtsi2sd xmm0, r10d # up to 32: a LONG, two's complement - jmp .Lsn_done -.Lsn_radix_zero: - xorpd xmm0, xmm0 - jmp .Lsn_done - -.Lsn_none: - xorpd xmm0, xmm0 - xor r15d, r15d - xor edx, edx -.Lsn_done: - mov rax, r15 - add rsp, 56 - pop r15 - pop r14 - pop r13 - pop r12 - pop rbx - pop rbp - ret - -# _rt_str - Convert number to string (STR$ function) -# -# Renders exactly what PRINT would render, by going through the same helper; -# see the System V tree for why the old sprintf("%g") was wrong. -# -# Arguments: -# xmm0 = number to convert (double) -# -# Returns: -# rax = pointer to a fresh heap copy of the text -# rdx = length of string -.globl _rt_str -_rt_str: - push rbp - mov rbp, rsp - sub rsp, 32 # shadow space - xor ecx, ecx # a DOUBLE - call _rt_fmt_basic # includes the sign position's blank - lea rcx, [rip + _num_buf] - mov rdx, rax # length - add rsp, 32 - leave - jmp _rt_strdup # the caller may hold another such result - -# _rt_str_single - STR$ of a SINGLE -# -# A SINGLE carries only ~7 significant digits, so it uses the shorter table for -# the same reason PRINT does. -# -# Arguments: xmm0 = value, already widened to double -# Returns: rax = pointer to a fresh heap copy, rdx = length -.globl _rt_str_single -_rt_str_single: - push rbp - mov rbp, rsp - sub rsp, 32 # shadow space - mov ecx, 1 # a SINGLE - call _rt_fmt_basic - lea rcx, [rip + _num_buf] - mov rdx, rax - add rsp, 32 - leave - jmp _rt_strdup - -# _rt_chr - Convert ASCII code to single character (CHR$ function) -# Arguments: -# rcx = ASCII code (0-255) -# -# Returns: -# rax = pointer to a fresh heap copy of the character -# rdx = 1 (length) -.globl _rt_chr -_rt_chr: - push rbp - mov rbp, rsp - lea rax, [rip + _chr_buf] - mov BYTE PTR [rax], cl # read cl before rcx becomes the buffer - mov BYTE PTR [rax + 1], 0 - mov rcx, rax - mov rdx, CHR_RESULT_LEN - leave - jmp _rt_strdup # the caller may hold another such result - -# _rt_left - Extract leftmost characters (LEFT$ function) -# Arguments: -# rcx = source string pointer -# rdx = source string length -# r8 = number of characters to extract -# -# Returns: -# rax = pointer to start of result -# rdx = result length -.globl _rt_left -_rt_left: - mov rax, rcx - cmp r8, rdx - cmova r8, rdx - mov rdx, r8 - ret - -# _rt_right - Extract rightmost characters (RIGHT$ function) -# Arguments: -# rcx = source string pointer -# rdx = source string length -# r8 = number of characters to extract -# -# Returns: -# rax = pointer to start of result -# rdx = result length -.globl _rt_right -_rt_right: - cmp r8, rdx - cmova r8, rdx - mov rax, rcx - add rax, rdx - sub rax, r8 - mov rdx, r8 - ret - -# _rt_mid - Extract substring (MID$ function) -# Arguments: -# rcx = source string pointer -# rdx = source string length -# r8 = start position (1-based) -# r9 = count (-1 means "rest of string") -# -# Returns: -# rax = pointer to start of result -# rdx = result length -.globl _rt_mid -_rt_mid: - dec r8 # Convert to 0-based index - cmp r8, rdx # If start >= length - jae .Lmid_empty - mov rax, rcx - add rax, r8 # result ptr = src + start - sub rdx, r8 # remaining = length - start - cmp r9, 0 # If count < 0 (means "rest") - jl .Lmid_rest - cmp r9, rdx - cmova r9, rdx - mov rdx, r9 - ret -.Lmid_rest: - ret -.Lmid_empty: - mov rax, rcx - xor rdx, rdx - ret - -# _rt_instr - Find substring position (INSTR function) -# Arguments: -# rcx = haystack pointer -# rdx = haystack length -# r8 = needle pointer -# r9 = needle length -# [rsp+40] = start position (1-based) -# -# Returns: -# rax = position (1-based) or 0 if not found -.globl _rt_instr -_rt_instr: - push rbp - mov rbp, rsp - push rbx - push r12 - push r13 - push r14 - push r15 - push rdi - push rsi - sub rsp, 40 # Shadow space + alignment - - # Get 5th argument from stack - mov rdi, QWORD PTR [rbp + 48] - - # Move arguments to callee-saved registers - mov r12, rcx # haystack ptr - mov r13, rdx # haystack len - mov r14, r8 # needle ptr - mov r15, r9 # needle len - mov rbx, rdi # start position (1-based) - - # A start below 1 would move the search pointer backwards out of the - # buffer; GW-BASIC calls that an illegal argument. - cmp rbx, 1 - jl .Linstr_badstart - - # Adjust for start position - dec rbx # convert to 0-based - # A start past the end finds nothing. Without this the `sub` below drove - # the remaining length negative -- enormous, unsigned -- so the "room for - # the needle" test passed and memcmp read past the end of the string. - cmp rbx, r13 - jae .Linstr_not_found - add r12, rbx # advance haystack ptr - sub r13, rbx # reduce remaining length - - # Special case: empty needle - test r15, r15 - jz .Linstr_at_start - -.Linstr_loop: - cmp r13, r15 - jb .Linstr_not_found - - # memcmp(haystack_pos, needle, needle_len) - mov rcx, r12 - mov rdx, r14 - mov r8, r15 - call memcmp - test eax, eax - jz .Linstr_found - - inc r12 - dec r13 - inc rbx - jmp .Linstr_loop - -.Linstr_found: - mov rax, rbx - add rax, 1 - jmp .Linstr_done - -.Linstr_at_start: - mov rax, rbx - add rax, 1 - jmp .Linstr_done - -.Linstr_not_found: - xor rax, rax - jmp .Linstr_done -.Linstr_badstart: - lea rcx, [rip + _err_domain] - xor edx, edx - call _rt_error - xor eax, eax # "not found" when a handler traps it - jmp .Linstr_done - -.Linstr_done: - add rsp, 40 - pop rsi - pop rdi - pop r15 - pop r14 - pop r13 - pop r12 - pop rbx - leave - ret - -# _rt_strcat - Concatenate two strings (+ operator) -# Arguments: -# rcx = left string pointer -# rdx = left string length -# r8 = right string pointer -# r9 = right string length -# -# Returns: -# rax = pointer to new string -# rdx = total length -.globl _rt_strcat -_rt_strcat: - push rbp - mov rbp, rsp - push r12 - push r13 - push r14 - push r15 - push rdi - push rsi - sub rsp, 48 # Shadow space (must be 0 mod 16) - - # Save arguments - mov r12, rcx # left ptr - mov r13, rdx # left len - mov r14, r8 # right ptr - mov r15, r9 # right len - - # malloc(left_len + right_len + 1). malloc rather than HeapAlloc, - # because generated code frees the result with free. - lea rcx, [r13 + r15 + 1] - call malloc - - mov rdi, rax # save result ptr - - # memcpy(result, left, left_len) - mov rcx, rax - mov rdx, r12 - mov r8, r13 - call memcpy - - # memcpy(result + left_len, right, right_len) - lea rcx, [rdi + r13] - mov rdx, r14 - mov r8, r15 - call memcpy - - # Null terminate - lea rax, [r13 + r15] - mov BYTE PTR [rdi + rax], 0 - - # Return - mov rdx, rax # total length - mov rax, rdi # result pointer - - add rsp, 48 - pop rsi - pop rdi - pop r15 - pop r14 - pop r13 - pop r12 - leave - ret - - -# _rt_strcmp - Compare two BASIC strings -# BASIC strings are (ptr, len) pairs and are not null-terminated, so CRT strcmp -# cannot be used. Compares lexicographically by unsigned byte value, then by -# length when one string is a prefix of the other -- so "ab" < "abc". -# -# Arguments (Win64): -# rcx = left pointer, rdx = left length -# r8 = right pointer, r9 = right length -# -# Returns: -# eax < 0 if left < right, 0 if equal, > 0 if left > right (like memcmp) -# -# A length of 0 is valid and means the empty string; the pointer is then never -# dereferenced, so an unassigned (NULL, 0) string compares correctly. -.globl _rt_strcmp -_rt_strcmp: - push rbp - mov rbp, rsp - - # r10 = number of bytes to compare = min(left_len, right_len) - mov r10, rdx - cmp r10, r9 - jbe .Lstrcmp_have_min - mov r10, r9 -.Lstrcmp_have_min: - - xor r11, r11 # r11 = byte index - jmp .Lstrcmp_check -.Lstrcmp_loop: - movzx eax, BYTE PTR [rcx + r11] - cmp al, BYTE PTR [r8 + r11] - jne .Lstrcmp_differ - inc r11 -.Lstrcmp_check: - cmp r11, r10 - jb .Lstrcmp_loop - - # Common prefix is equal: the shorter string sorts first. - xor eax, eax - cmp rdx, r9 - je .Lstrcmp_done # same length -> equal - jb .Lstrcmp_shorter - mov eax, 1 # left is longer -> greater - jmp .Lstrcmp_done -.Lstrcmp_shorter: - mov eax, -1 - jmp .Lstrcmp_done - -.Lstrcmp_differ: - movzx eax, BYTE PTR [rcx + r11] - movzx r10d, BYTE PTR [r8 + r11] - sub eax, r10d - -.Lstrcmp_done: - leave - ret - -# Additional string functions -# -# These were all reachable only through the old "unknown $-suffixed call must -# be an array" heuristic, so every one of them aborted the compiler. -# -# Functions that shorten a string (LTRIM$, RTRIM$) return an interior pointer -# into the original rather than allocating, which is sound because BASIC -# strings are (ptr, len) pairs and are never mutated in place. - -# _rt_space - SPACE$(n): a string of n spaces -# Arguments: rcx = count Returns: rax = pointer, rdx = length -.globl _rt_space -_rt_space: - push rbp - mov rbp, rsp - push rbx - sub rsp, 40 - - mov rbx, rcx - cmp rbx, 0 - jge .Lspace_ok - xor rbx, rbx # a negative count yields the empty string -.Lspace_ok: - lea rcx, [rbx + 1] - call malloc - - # memset returns its destination, so the pointer needs no saving -- and - # saving it with a bare push would leave rsp misaligned for the call. - mov rcx, rax # dest - mov rdx, ' ' # fill byte - mov r8, rbx # count - sub rsp, 32 - call memset - add rsp, 32 - mov rdx, rbx - - add rsp, 40 - pop rbx - leave - ret - -# _rt_fixed - Fit a string to a declared width, for STRING * n -# -# A fixed-length string always holds exactly its declared number of characters: -# a shorter value is padded with spaces on the right, a longer one is truncated. -# Assignment used to store the source verbatim, so `STRING * 5` held whatever it -# was given and the declared width meant nothing. -# -# Arguments: rcx = source pointer, rdx = source length, r8 = width -# Returns: rax = pointer, rdx = width -.globl _rt_fixed -_rt_fixed: - push rbp - mov rbp, rsp - push rbx - push r12 - push r13 - push r14 - sub rsp, 32 # shadow space only: the four pushes above already - # leave rsp aligned, unlike the two in _rt_space - - mov r12, rcx # source pointer - mov r13, rdx # source length - mov rbx, r8 # width - cmp rbx, 0 - jge .Lfixed_ok - xor rbx, rbx # a non-positive width yields the empty string -.Lfixed_ok: - # Copy at most `width` bytes. - mov r14, r13 - cmp r14, rbx - jbe .Lfixed_have_n - mov r14, rbx -.Lfixed_have_n: - - lea rcx, [rbx + 1] # room for the NUL the string helpers expect - call malloc - - # Space-fill the whole width first, then overwrite the prefix; memset - # returns its destination, so the pointer survives without a save. - mov rcx, rax - mov rdx, ' ' - mov r8, rbx - call memset - - # memcpy(dest, src, min(len, width)). rax still holds the buffer. - mov rcx, rax - mov rdx, r12 - mov r8, r14 - mov r13, rax # keep the buffer across the call - call memcpy - mov rax, r13 - - mov rdx, rbx # the result is always `width` long - - add rsp, 32 - pop r14 - pop r13 - pop r12 - pop rbx - leave - ret - -# _rt_string_n - STRING$(n, ch): a string of n copies of one character -# Arguments: rcx = count, rdx = character code -# Returns: rax = pointer, rdx = length -.globl _rt_string_n -_rt_string_n: - push rbp - mov rbp, rsp - push rbx - push r12 - sub rsp, 32 - - mov rbx, rcx - mov r12, rdx - cmp rbx, 0 - jge .Lstringn_ok - xor rbx, rbx -.Lstringn_ok: - lea rcx, [rbx + 1] - call malloc - - # memset returns its destination; see _rt_space. - mov rcx, rax - mov rdx, r12 - mov r8, rbx - sub rsp, 32 - call memset - add rsp, 32 - mov rdx, rbx - - add rsp, 32 - pop r12 - pop rbx - leave - ret - -# _rt_ltrim - LTRIM$(s): drop leading spaces -# Arguments: rcx = pointer, rdx = length -# Returns: rax = pointer, rdx = length (an interior view, not a copy) -.globl _rt_ltrim -_rt_ltrim: - xor r8, r8 -.Lltrim_loop: - cmp r8, rdx - jae .Lltrim_done - cmp BYTE PTR [rcx + r8], ' ' - jne .Lltrim_done - inc r8 - jmp .Lltrim_loop -.Lltrim_done: - lea rax, [rcx + r8] - sub rdx, r8 - ret - -# _rt_rtrim - RTRIM$(s): drop trailing spaces -# Arguments: rcx = pointer, rdx = length -# Returns: rax = pointer, rdx = length -.globl _rt_rtrim -_rt_rtrim: -.Lrtrim_loop: - test rdx, rdx - jz .Lrtrim_done - cmp BYTE PTR [rcx + rdx - 1], ' ' - jne .Lrtrim_done - dec rdx - jmp .Lrtrim_loop -.Lrtrim_done: - mov rax, rcx - ret - -# _rt_ucase / _rt_lcase - UCASE$(s) / LCASE$(s) -# These must copy: the source may be a .data literal shared with other uses. -# -# Arguments: rcx = pointer, rdx = length -# Returns: rax = pointer, rdx = length -.globl _rt_ucase -_rt_ucase: - mov r9b, 1 # r9b != 0 selects upper-casing - jmp _rt_case_convert - -.globl _rt_lcase -_rt_lcase: - xor r9b, r9b - # An explicit jump, not a fall-through: see the System V tree. - jmp _rt_case_convert - -_rt_case_convert: - push rbp - mov rbp, rsp - push rbx - push r12 - push r13 - sub rsp, 40 - - mov rbx, rcx # source - mov r12, rdx # length - mov r13d, r9d # direction - - lea rcx, [r12 + 1] - call malloc - - xor rcx, rcx -.Lcase_loop: - cmp rcx, r12 - jae .Lcase_done - mov dl, BYTE PTR [rbx + rcx] - test r13b, r13b - jz .Lcase_lower - cmp dl, 'a' - jb .Lcase_store - cmp dl, 'z' - ja .Lcase_store - sub dl, 32 - jmp .Lcase_store -.Lcase_lower: - cmp dl, 'A' - jb .Lcase_store - cmp dl, 'Z' - ja .Lcase_store - add dl, 32 -.Lcase_store: - mov BYTE PTR [rax + rcx], dl - inc rcx - jmp .Lcase_loop -.Lcase_done: - mov rdx, r12 - - add rsp, 40 - pop r13 - pop r12 - pop rbx - leave - ret - -# _rt_hex / _rt_oct - HEX$(n) / OCT$(n) -# Arguments: rcx = value (already truncated to an integer) -# Returns: rax = pointer to a fresh heap copy, rdx = length -.globl _rt_hex -_rt_hex: - push rbp - mov rbp, rsp - sub rsp, 48 # shadow space; 48 realigns after push rbp - mov r8, rcx - lea rcx, [rip + _str_buf] - lea rdx, [rip + _fmt_hex] - call sprintf - lea rcx, [rip + _str_buf] - mov rdx, rax - add rsp, 48 - leave - jmp _rt_strdup - -.globl _rt_oct -_rt_oct: - push rbp - mov rbp, rsp - sub rsp, 48 # shadow space; 48 realigns after push rbp - mov r8, rcx - lea rcx, [rip + _str_buf] - lea rdx, [rip + _fmt_oct] - call sprintf - lea rcx, [rip + _str_buf] - mov rdx, rax - add rsp, 48 - leave - jmp _rt_strdup - -# _rt_strdup - Copy a string onto the heap -# String assignment copies, so that mutating one variable cannot be seen -# through another -- or, worse, through the shared .data literal a string -# constant points at. -# -# Arguments: rcx = pointer, rdx = length -# Returns: rax = pointer, rdx = length -.globl _rt_strdup -_rt_strdup: - push rbp - mov rbp, rsp - push rbx - push r12 - sub rsp, 32 - - mov rbx, rcx - mov r12, rdx - - lea rcx, [r12 + 1] - call malloc - - # memcpy returns its destination; see _rt_space. - mov rcx, rax - sub rsp, 32 - mov rdx, rbx - mov r8, r12 - call memcpy - add rsp, 32 - mov rdx, r12 - - add rsp, 32 - pop r12 - pop rbx - leave - ret - -# _rt_mid_assign - MID$(s, start [, len]) = value -# Overwrites characters of the target in place. The target's length never -# changes. Positions are 1-based. -# -# Arguments (Win64): -# rcx = target pointer, rdx = target length -# r8 = start (1-based), r9 = maximum characters to replace -# [rsp+40] = source pointer, [rsp+48] = source length -# -# Returns: nothing -.globl _rt_mid_assign -_rt_mid_assign: - mov r10, QWORD PTR [rsp + 40] # source pointer - mov r11, QWORD PTR [rsp + 48] # source length - - cmp r9, r11 - jbe .Lmid_have_count - mov r9, r11 -.Lmid_have_count: - - cmp r8, 1 - jl .Lmid_done - dec r8 - - push rbx - xor rbx, rbx # characters copied -.Lmid_loop: - cmp rbx, r9 - jae .Lmid_pop_done - lea rax, [r8 + rbx] - cmp rax, rdx - jae .Lmid_pop_done - mov r11b, BYTE PTR [r10 + rbx] - mov BYTE PTR [rcx + rax], r11b - inc rbx - jmp .Lmid_loop -.Lmid_pop_done: - pop rbx -.Lmid_done: - ret diff --git a/src/runtime/win64-native/using.s b/src/runtime/win64-native/using.s deleted file mode 100644 index 737095e..0000000 --- a/src/runtime/win64-native/using.s +++ /dev/null @@ -1,769 +0,0 @@ -# BASIC Runtime: PRINT USING field output (Win64 Native) -# -# _rt_print_using_num and _rt_print_using_str render one field each; the -# format itself is read at run time by _rt_using_next, below. -# -# Flag bits, as _rt_using_next sets them for _rt_print_using_num: -# 1 COMMA group the integer part in thousands -# 2 DOLLAR prefix a currency sign, floated against the digits -# 4 STAR fill with '*' rather than spaces -# 8 TRAILING_SIGN place the sign after the number -# 16 FORCE_SIGN always show a sign, '+' for positives -# 32 EXPONENTIAL render in exponential form - -.equ USING_COMMA, 1 -.equ USING_DOLLAR, 2 -.equ USING_STAR, 4 -.equ USING_TRAIL_SIGN, 8 -.equ USING_FORCE_SIGN, 16 -.equ USING_EXP, 32 - -.data -_using_fmt_f: .asciz "%.*f" -_using_fmt_e: .asciz "%.*E" -# Buffer sizes are proved, not guessed. A double's widest %f rendering is a -# sign, 309 integer digits, a point and USING_MAX_DEC fractional digits -- 351 -# characters -- so 512 bytes cannot be overrun at any clamped precision. -# Comma grouping adds at most one separator per three integer digits, and the -# decorations add a sign, a currency symbol and an overflow marker. -.equ USING_MAX_WIDTH, 255 # must match using::MAX_WIDTH -.equ USING_MAX_DEC, 40 # must match using::MAX_DECIMALS - -# 3.5K of zeros, which is why these are .bss -- see data_defs.s. -.bss -.p2align 3 -_using_raw: .skip 512 # sprintf target -_using_work: .skip 1024 # after comma insertion -_using_out: .skip 2048 # after sign/currency, padded to the width - -.text - -# _rt_print_using_num - Render one numeric field -# Arguments (Win64), the value last so that both ABIs can name it: -# rcx = field width in characters -# rdx = digits after the decimal point -# r8 = flags -# xmm3 = value, the fourth argument by position -# -# A value too wide for its field is printed in full, preceded by '%', which is -# what GW-BASIC does rather than truncating. -.globl _rt_print_using_num -_rt_print_using_num: - movaps xmm0, xmm3 # the body works on the value in xmm0 - push rbp - mov rbp, rsp - push rbx - push rsi - push rdi - push r12 - push r13 - push r14 - push r15 - sub rsp, 56 # shadow space + locals, keeps rsp aligned - - mov r12, rcx # width - mov r13, rdx # decimals - mov r14, r8 # flags - movsd QWORD PTR [rbp - 72], xmm0 - - # Clamp both to what the buffers below are sized for. The compiler already - # clamps them, so this only guards against a hand-written or future caller; - # without it a value such as 1D300 in a "##.##" field ran sprintf past the - # end of _using_raw and destroyed everything after it in .data. - cmp r13, USING_MAX_DEC - jbe .Luse_num_dec_ok - mov r13, USING_MAX_DEC -.Luse_num_dec_ok: - cmp r12, USING_MAX_WIDTH - jbe .Luse_num_width_ok - mov r12, USING_MAX_WIDTH -.Luse_num_width_ok: - - xor r15d, r15d # sign character, 0 = none - mov rax, r14 - and rax, USING_TRAIL_SIGN | USING_FORCE_SIGN - test rax, rax - jz .Luse_num_format - - xorpd xmm1, xmm1 - movsd xmm0, QWORD PTR [rbp - 72] - ucomisd xmm0, xmm1 - jae .Luse_num_positive - mov r15d, '-' - mov rax, 0x8000000000000000 - movq xmm1, rax - xorpd xmm0, xmm1 - movsd QWORD PTR [rbp - 72], xmm0 - jmp .Luse_num_format -.Luse_num_positive: - test r14, USING_FORCE_SIGN - jz .Luse_num_format - mov r15d, '+' - -.Luse_num_format: - # sprintf(_using_raw, fmt, decimals, value) - lea rcx, [rip + _using_raw] - lea rdx, [rip + _using_fmt_f] - test r14, USING_EXP - jz .Luse_num_have_fmt - lea rdx, [rip + _using_fmt_e] -.Luse_num_have_fmt: - mov r8, r13 # precision - movsd xmm3, QWORD PTR [rbp - 72] - movq r9, xmm3 # 4th vararg goes in both xmm3 and r9 - call sprintf - mov rbx, rax # length of the raw text - - lea rsi, [rip + _using_raw] - lea rdi, [rip + _using_work] - test r14, USING_COMMA - jnz .Luse_num_commas - xor rcx, rcx -.Luse_num_copy: - cmp rcx, rbx - jae .Luse_num_copied - mov al, BYTE PTR [rsi + rcx] - mov BYTE PTR [rdi + rcx], al - inc rcx - jmp .Luse_num_copy -.Luse_num_copied: - mov r8, rbx - jmp .Luse_num_decorate - -.Luse_num_commas: - # Locate the end of the integer part: the '.' or 'E', else the whole text. - xor rcx, rcx -.Luse_num_find_dot: - cmp rcx, rbx - jae .Luse_num_dot_found - mov al, BYTE PTR [rsi + rcx] - cmp al, '.' - je .Luse_num_dot_found - cmp al, 'E' - je .Luse_num_dot_found - inc rcx - jmp .Luse_num_find_dot -.Luse_num_dot_found: - mov r9, rcx # r9 = one past the last integer digit - - # Skip any leading sign so it is not counted as a digit. - xor rcx, rcx - cmp rbx, 0 - je .Luse_num_no_sign_skip - mov al, BYTE PTR [rsi] - cmp al, '-' - je .Luse_num_skip_one - cmp al, '+' - jne .Luse_num_no_sign_skip -.Luse_num_skip_one: - mov rcx, 1 -.Luse_num_no_sign_skip: - mov r10, rcx # r10 = index of the first integer digit - - # Single left-to-right pass: a separator goes before digit i whenever the - # number of digits remaining, (r9 - i), is a positive multiple of 3. - xor r8, r8 # output length - xor rcx, rcx -.Luse_num_ins: - cmp rcx, rbx - jae .Luse_num_ins_done - cmp rcx, r9 - jae .Luse_num_ins_copy # past the integer part: copy verbatim - cmp rcx, r10 - jbe .Luse_num_ins_copy # first digit (or sign) never gets a separator - mov rdx, r9 - sub rdx, rcx # digits remaining before the decimal point - mov rax, rdx - xor rdx, rdx - mov r11, 3 - div r11 # rdx = (r9 - rcx) mod 3 - test rdx, rdx - jnz .Luse_num_ins_copy - lea rdx, [rip + _using_work] - mov BYTE PTR [rdx + r8], ',' - inc r8 -.Luse_num_ins_copy: - lea rdx, [rip + _using_work] - mov al, BYTE PTR [rsi + rcx] - mov BYTE PTR [rdx + r8], al - inc r8 - inc rcx - jmp .Luse_num_ins -.Luse_num_ins_done: - -.Luse_num_decorate: - # r8 = length in _using_work. Prepend '$' and/or the leading sign. - lea rdi, [rip + _using_out] - xor r9, r9 # output length - - test r15b, r15b - jz .Luse_num_no_lead_sign - test r14, USING_TRAIL_SIGN - jnz .Luse_num_no_lead_sign - mov BYTE PTR [rdi + r9], r15b - inc r9 -.Luse_num_no_lead_sign: - - test r14, USING_DOLLAR - jz .Luse_num_no_dollar - mov BYTE PTR [rdi + r9], '$' - inc r9 -.Luse_num_no_dollar: - - lea rsi, [rip + _using_work] - xor rcx, rcx -.Luse_num_body: - cmp rcx, r8 - jae .Luse_num_body_done - mov al, BYTE PTR [rsi + rcx] - mov BYTE PTR [rdi + r9], al - inc r9 - inc rcx - jmp .Luse_num_body -.Luse_num_body_done: - - # A trailing sign is a column of its own, and a positive number leaves it - # blank, as GW-BASIC and QuickBASIC do: "###-" prints 5 as " 5 " beside - # -5's " 5-", so the digits line up. Writing nothing there padded the - # positive on the left instead, one column out of line. - test r14, USING_TRAIL_SIGN - jz .Luse_num_no_trail - mov al, r15b - test al, al - jnz .Luse_num_trail_char - mov al, ' ' -.Luse_num_trail_char: - mov BYTE PTR [rdi + r9], al - inc r9 -.Luse_num_no_trail: - - # Pad on the left to the field width, or mark an overflow with '%'. - cmp r9, r12 - jae .Luse_num_overflow - - mov rcx, r12 - sub rcx, r9 # pad count - mov al, ' ' - test r14, USING_STAR - jz .Luse_num_pad_char - mov al, '*' -.Luse_num_pad_char: - # Shift the text right by rcx, then fill the gap. x86 addressing has no - # three-register form, so the shifted destination base is precomputed. - lea r8, [rdi + rcx] - mov rdx, r9 -.Luse_num_shift: - cmp rdx, 0 - jle .Luse_num_shift_done - dec rdx - mov r11b, BYTE PTR [rdi + rdx] - mov BYTE PTR [r8 + rdx], r11b - jmp .Luse_num_shift -.Luse_num_shift_done: - xor rdx, rdx -.Luse_num_fill: - cmp rdx, rcx - jae .Luse_num_fill_done - mov BYTE PTR [rdi + rdx], al - inc rdx - jmp .Luse_num_fill -.Luse_num_fill_done: - mov r9, r12 - jmp .Luse_num_write - -.Luse_num_overflow: - je .Luse_num_write # exactly the width: no marker needed - # Too wide: shift right by one and write '%' in front. - mov rdx, r9 -.Luse_num_ovf_shift: - cmp rdx, 0 - jle .Luse_num_ovf_done - dec rdx - mov r11b, BYTE PTR [rdi + rdx] - mov BYTE PTR [rdi + rdx + 1], r11b - jmp .Luse_num_ovf_shift -.Luse_num_ovf_done: - mov BYTE PTR [rdi], '%' - inc r9 - -.Luse_num_write: - lea rcx, [rip + _using_out] - mov rdx, r9 - call .Luse_out - - add rsp, 56 - pop r15 - pop r14 - pop r13 - pop r12 - pop rdi - pop rsi - pop rbx - pop rbp - ret - -# _rt_print_using_str - Render one string field -# Arguments (Win64): -# rcx = string pointer -# rdx = string length -# r8 = field width, or 0 for "the whole string" -# -# A string shorter than the field is padded on the right with spaces; a longer -# one is truncated, as GW-BASIC does. -.globl _rt_print_using_str -_rt_print_using_str: - push rbp - mov rbp, rsp - push rbx - push r12 - push r13 - sub rsp, 40 - - mov rbx, rcx # ptr - mov r12, rdx # len - mov r13, r8 # width - - # Clamp to the buffer's capacity, as in _rt_print_using_num. - cmp r13, USING_MAX_WIDTH - jbe .Luse_str_width_ok - mov r13, USING_MAX_WIDTH -.Luse_str_width_ok: - - test r13, r13 - jz .Luse_str_whole - - # r8, not rdi: rdi is callee-saved on Win64 and volatile on System V, so - # scratching it here is invisible on the tree this is not compiled into. - lea r8, [rip + _using_out] - xor rcx, rcx -.Luse_str_copy: - cmp rcx, r13 - jae .Luse_str_copied - cmp rcx, r12 - jae .Luse_str_pad - mov al, BYTE PTR [rbx + rcx] - mov BYTE PTR [r8 + rcx], al - inc rcx - jmp .Luse_str_copy -.Luse_str_pad: - mov BYTE PTR [r8 + rcx], ' ' - inc rcx - jmp .Luse_str_copy -.Luse_str_copied: - lea rcx, [rip + _using_out] - mov rdx, r13 - call .Luse_out - jmp .Luse_str_done - -.Luse_str_whole: - mov rcx, rbx - mov rdx, r12 - call .Luse_out - -.Luse_str_done: - add rsp, 40 - pop r13 - pop r12 - pop rbx - pop rbp - ret - -# --------------------------------------------------------------------------- -# PRINT USING, interpreted at run time -# -# The format is read here as the statement runs, so it may be any string -# expression and the output may go to a file. It used to be parsed when -# compiling, which allowed only a literal and only the console; one reading -# here, for every format, also means there is no second parser to disagree -# with this one. -# -# _rt_using_start names the file and the format; then each value goes through -# _rt_using_num or _rt_using_str, which print the literal text up to the next -# field and the value in it; _rt_using_end prints the text after the last -# field used, up to the next one. A format runs out before the values does -# what GW-BASIC does: it starts again from the beginning. A format with no -# field at all is Illegal function call, and a value of the wrong kind for its -# field is Type mismatch. -# --------------------------------------------------------------------------- - -.bss -.p2align 3 -_using_file: .skip 8 # where the output goes -_using_fmt: .skip 8 # the format -_using_len: .skip 8 -_using_pos: .skip 8 # how far through it -_using_found: .skip 8 # a field was taken since the format began -_using_fw: .skip 8 # the field just found: width, -_using_fd: .skip 8 # digits after the point, -_using_ff: .skip 8 # and flags, as _rt_print_using_num takes them - -.text - -# Write what _rt_print_using_num and _rt_print_using_str laid out to the file -# the statement names. Reached by `call`; returns from _rt_file_print_string. -# rcx = pointer, rdx = length -.Luse_out: - mov r8, rdx - mov rdx, rcx - mov rcx, QWORD PTR [rip + _using_file] - jmp _rt_file_print_string - -# _rt_using_start - Begin a PRINT USING statement -# -# Arguments: rcx = file number (0 = the console), rdx = format pointer, -# r8 = format length -# Returns: nothing -.globl _rt_using_start -_rt_using_start: - mov QWORD PTR [rip + _using_file], rcx - mov QWORD PTR [rip + _using_fmt], rdx - mov QWORD PTR [rip + _using_len], r8 - mov QWORD PTR [rip + _using_pos], 0 - mov QWORD PTR [rip + _using_found], 0 - ret - -# _rt_using_next - Print literal text up to the next field, and take the field -# -# The fields are GW-BASIC's, as LANGREF lists them: `!`, `&` and `\ \` for a -# string; for a number, digit positions `#` with an optional `.`, `,` among -# the digits, a leading `+`, `**`, `$$` or `**$`, a trailing `^^^^`, and a -# trailing `+` or `-`. `_` makes the next character literal, and anything that -# is not a field is printed as it is. -# -# Arguments: ecx = 1 at the end of the statement: stop before a field instead -# of taking it, and at the end of the format instead of starting it -# again -# Returns: rax = 1 a numeric field, 2 a string field, 0 neither; the field's -# width, digits and flags are in _using_fw, _using_fd, _using_ff -.globl _rt_using_next -_rt_using_next: - push rbp - mov rbp, rsp - push rbx - push r12 - push r13 - push r14 - push r15 - sub rsp, 40 - mov r14d, ecx # stop mode - mov rbx, QWORD PTR [rip + _using_fmt] - mov r12, QWORD PTR [rip + _using_len] - mov r13, QWORD PTR [rip + _using_pos] - -.Lun_loop: - cmp r13, r12 - jb .Lun_char - test r14d, r14d - jnz .Lun_none # the statement's end: done - cmp QWORD PTR [rip + _using_found], 0 - je .Lun_no_field # a whole pass found nothing to fill - mov QWORD PTR [rip + _using_found], 0 - xor r13d, r13d # use the format again from its start - jmp .Lun_loop - -.Lun_char: - movzx eax, BYTE PTR [rbx + r13] - cmp al, 95 # '_' makes the next character literal - jne .Lun_bang - lea rcx, [r13 + 1] - cmp rcx, r12 - jae .Lun_literal - movzx eax, BYTE PTR [rbx + r13 + 1] - add r13, 2 - jmp .Lun_emit -.Lun_bang: - cmp al, 33 # '!': one character - jne .Lun_amp - mov r9d, 1 - lea r15, [r13 + 1] - jmp .Lun_string -.Lun_amp: - cmp al, 38 # '&': the whole string - jne .Lun_backslash - xor r9d, r9d - lea r15, [r13 + 1] - jmp .Lun_string -.Lun_backslash: - cmp al, 92 # '\': spaces, then '\' - jne .Lun_numeric_start - lea r15, [r13 + 1] -.Lun_bs_scan: - cmp r15, r12 - jae .Lun_literal - movzx ecx, BYTE PTR [rbx + r15] - cmp ecx, 32 - jne .Lun_bs_end - inc r15 - jmp .Lun_bs_scan -.Lun_bs_end: - cmp ecx, 92 - jne .Lun_literal - mov r9, r15 - sub r9, r13 - inc r9 # the two backslashes and the gap - inc r15 - cmp r9, USING_MAX_WIDTH - jbe .Lun_string - mov r9d, USING_MAX_WIDTH - jmp .Lun_string - -.Lun_numeric_start: - cmp al, 35 # '#' - je .Lun_numeric - cmp al, 43 # '+' - je .Lun_numeric - cmp al, 36 # '$' - je .Lun_numeric - cmp al, 42 # '*' - jne .Lun_literal -.Lun_numeric: - mov r15, r13 # i - xor r8d, r8d # flags - xor r9d, r9d # width - cmp BYTE PTR [rbx + r15], 43 - jne .Lun_n_fill - or r8d, USING_FORCE_SIGN # a leading '+' - inc r9 - inc r15 -.Lun_n_fill: - lea rcx, [r15 + 1] - cmp rcx, r12 - jae .Lun_n_digits - cmp BYTE PTR [rbx + r15], 42 - jne .Lun_n_dollar - cmp BYTE PTR [rbx + r15 + 1], 42 - jne .Lun_n_dollar - or r8d, USING_STAR # '**', and '**$' - add r9, 2 - add r15, 2 - cmp r15, r12 - jae .Lun_n_digits - cmp BYTE PTR [rbx + r15], 36 - jne .Lun_n_digits - or r8d, USING_DOLLAR - inc r9 - inc r15 - jmp .Lun_n_digits -.Lun_n_dollar: - cmp BYTE PTR [rbx + r15], 36 - jne .Lun_n_digits - cmp BYTE PTR [rbx + r15 + 1], 36 - jne .Lun_n_digits - or r8d, USING_DOLLAR # '$$': a sign and a digit - add r9, 2 - add r15, 2 -.Lun_n_digits: - xor r10d, r10d # digit positions before the point - xor edx, edx # 1 when there is a ',' -.Lun_n_digit: - cmp r15, r12 - jae .Lun_n_digits_end - movzx eax, BYTE PTR [rbx + r15] - cmp al, 35 - jne .Lun_n_comma - inc r10 - inc r9 - inc r15 - jmp .Lun_n_digit -.Lun_n_comma: - cmp al, 44 - jne .Lun_n_digits_end - or r8d, USING_COMMA - mov edx, 1 - inc r15 - jmp .Lun_n_digit -.Lun_n_digits_end: - # A comma takes no position itself; the field grows by the separators - # its digits will need. - test edx, edx - jz .Lun_n_grouped - mov rax, r10 - test rax, rax - jz .Lun_n_grouped - dec rax - xor edx, edx - mov ecx, 3 - div rcx - add r9, rax -.Lun_n_grouped: - test r10, r10 - jnz .Lun_n_point - test r9, r9 - jz .Lun_n_fail # nothing here formed a field -.Lun_n_point: - xor r11d, r11d # digits after the point - cmp r15, r12 - jae .Lun_n_exp - cmp BYTE PTR [rbx + r15], 46 - jne .Lun_n_exp - lea rcx, [r15 + 1] - xor eax, eax -.Lun_n_frac: - cmp rcx, r12 - jae .Lun_n_frac_end - cmp BYTE PTR [rbx + rcx], 35 - jne .Lun_n_frac_end - inc eax - inc rcx - jmp .Lun_n_frac -.Lun_n_frac_end: - test eax, eax - jz .Lun_n_exp # a point with no digits is not part of it - mov r11d, eax - cmp r11, USING_MAX_DEC - jbe .Lun_n_frac_ok - mov r11d, USING_MAX_DEC -.Lun_n_frac_ok: - lea r9, [r9 + r11 + 1] # the point and its digits - mov r15, rcx -.Lun_n_exp: - test r10, r10 - jnz .Lun_n_exp_test - test r11, r11 - jz .Lun_n_fail # a field needs a digit somewhere -.Lun_n_exp_test: - lea rcx, [r15 + 3] - cmp rcx, r12 - jae .Lun_n_sign - cmp DWORD PTR [rbx + r15], 0x5E5E5E5E # "^^^^" - jne .Lun_n_sign - or r8d, USING_EXP - add r9, 4 - add r15, 4 -.Lun_n_sign: - cmp r15, r12 - jae .Lun_n_done - movzx eax, BYTE PTR [rbx + r15] - cmp al, 45 # a trailing '-' - je .Lun_n_trail - cmp al, 43 # or '+' - jne .Lun_n_done - or r8d, USING_FORCE_SIGN -.Lun_n_trail: - or r8d, USING_TRAIL_SIGN - inc r9 - inc r15 -.Lun_n_done: - cmp r9, USING_MAX_WIDTH - jbe .Lun_n_store - mov r9d, USING_MAX_WIDTH -.Lun_n_store: - test r14d, r14d - jnz .Lun_none - mov QWORD PTR [rip + _using_fw], r9 - mov QWORD PTR [rip + _using_fd], r11 - mov QWORD PTR [rip + _using_ff], r8 - mov r13, r15 - mov QWORD PTR [rip + _using_found], 1 - mov eax, 1 - jmp .Lun_ret -.Lun_n_fail: # not a field after all: the character is text -.Lun_literal: - movzx eax, BYTE PTR [rbx + r13] - inc r13 -.Lun_emit: - mov rcx, QWORD PTR [rip + _using_file] - mov edx, eax - call _rt_file_print_char - jmp .Lun_loop - -.Lun_string: # r9 = width (0 = the whole string), r15 = past it - test r14d, r14d - jnz .Lun_none - mov QWORD PTR [rip + _using_fw], r9 - mov r13, r15 - mov QWORD PTR [rip + _using_found], 1 - mov eax, 2 - jmp .Lun_ret - -.Lun_no_field: - lea rcx, [rip + _err_domain] - xor rdx, rdx - call _rt_error # returns only when trapped -.Lun_none: - xor eax, eax -.Lun_ret: - mov QWORD PTR [rip + _using_pos], r13 - add rsp, 40 - pop r15 - pop r14 - pop r13 - pop r12 - pop rbx - pop rbp - ret - -# _rt_using_num - PRINT USING: a numeric value -# -# Arguments: xmm0 = the value -# Returns: nothing -.globl _rt_using_num -_rt_using_num: - push rbp - mov rbp, rsp - sub rsp, 48 - movsd QWORD PTR [rbp - 8], xmm0 - xor ecx, ecx - call _rt_using_next - cmp eax, 1 - je .Luse_num_render - test eax, eax - jz .Luse_num_done # an error was raised and trapped - lea rcx, [rip + _err_typemismatch] - xor rdx, rdx - call _rt_error # a string field: returns only when trapped - jmp .Luse_num_done -.Luse_num_render: - mov rcx, QWORD PTR [rip + _using_fw] - mov rdx, QWORD PTR [rip + _using_fd] - mov r8, QWORD PTR [rip + _using_ff] - movsd xmm3, QWORD PTR [rbp - 8] # the 4th argument's register - call _rt_print_using_num -.Luse_num_done: - leave - ret - -# _rt_using_str - PRINT USING: a string value -# -# Arguments: rcx = pointer, rdx = length -# Returns: nothing -.globl _rt_using_str -_rt_using_str: - push rbp - mov rbp, rsp - sub rsp, 48 - mov QWORD PTR [rbp - 8], rcx - mov QWORD PTR [rbp - 16], rdx - xor ecx, ecx - call _rt_using_next - cmp eax, 2 - je .Luse_str_render - test eax, eax - jz .Luse_str_value_done # an error was raised and trapped - lea rcx, [rip + _err_typemismatch] - xor rdx, rdx - call _rt_error # a numeric field: returns only when trapped - jmp .Luse_str_value_done -.Luse_str_render: - mov rcx, QWORD PTR [rbp - 8] - mov rdx, QWORD PTR [rbp - 16] - mov r8, QWORD PTR [rip + _using_fw] - call _rt_print_using_str -.Luse_str_value_done: - leave - ret - -# _rt_using_end - Finish a PRINT USING statement: the text after the last -# field used, up to the next one -# -# Arguments: none -# Returns: nothing -.globl _rt_using_end -_rt_using_end: - push rbp - mov rbp, rsp - sub rsp, 32 - mov ecx, 1 - call _rt_using_next - leave - ret diff --git a/tests/codegen/mod.rs b/tests/codegen/mod.rs index 129f0f0..fbb1056 100644 --- a/tests/codegen/mod.rs +++ b/tests/codegen/mod.rs @@ -387,62 +387,6 @@ PRINT Y assert!(run.stderr.contains("Overflow"), "stderr {}", run.stderr); } -/// No runtime helper may fall through into the next one. -/// -/// Sections are not laid out in source order, so a helper that ran off its -/// end into its neighbour would land somewhere else entirely once each is -/// sectioned separately. `_rt_lcase` used to do this, into `_rt_case_convert`. -#[test] -fn test_no_runtime_helper_falls_through() { - for tree in ["sysv", "win64-native"] { - for file in [ - "print.s", "input.s", "string.s", "math.s", "data.s", "file.s", "error.s", "using.s", - ] { - // Anchored at the manifest rather than the working directory, - // which a test runner is free to set wherever it likes. - let path = std::path::Path::new(env!("CARGO_MANIFEST_DIR")) - .join("src/runtime") - .join(tree) - .join(file); - let text = std::fs::read_to_string(&path) - .unwrap_or_else(|e| panic!("{}: {}", path.display(), e)); - let mut previous: Option = None; - for line in text.lines() { - let t = line.trim(); - if t.starts_with("_rt_") - && t.ends_with(':') - && let Some(prev) = &previous - { - let op = prev.split_whitespace().next().unwrap_or(""); - // `_rt_error` never returns, so reaching a label after - // a call to it is not a fall-through. - let terminal = matches!(op, "ret" | "jmp" | "ud2" | "hlt") - || prev.starts_with("call _rt_error"); - assert!( - terminal, - "{} falls into {} from `{}`", - path.display(), - t, - prev - ); - } - // Track the last thing that is an instruction: not a comment, - // not a directive, and not a label -- including the - // `name: .skip 1024` form, whose first token ends in a colon - // but whose line does not. - let first = t.split_whitespace().next().unwrap_or(""); - if !t.is_empty() - && !t.starts_with('#') - && !t.starts_with('.') - && !first.ends_with(':') - { - previous = Some(t.to_string()); - } - } - } - } -} - /// Several accumulators in one loop all accumulate. #[test] fn test_accumulator_promotion_has_a_limit() { diff --git a/tests/integration.rs b/tests/integration.rs index d0a3205..f10612c 100644 --- a/tests/integration.rs +++ b/tests/integration.rs @@ -18,7 +18,6 @@ mod math; mod megatest; mod print; mod procedures; -mod runtime; mod strings; mod types; mod variables; diff --git a/tests/runtime/mod.rs b/tests/runtime/mod.rs deleted file mode 100644 index 2ffc288..0000000 --- a/tests/runtime/mod.rs +++ /dev/null @@ -1,375 +0,0 @@ -//! Structural checks on the two assembly runtimes. -//! -//! `runtime/sysv/` and `runtime/win64-native/` are parallel hand-written -//! implementations that codegen calls by the same names, chosen with a `cfg` -//! at compile time. Only one of them can be exercised by running programs on -//! any given host, so the other is checked structurally here: a helper added -//! to one and forgotten in the other would otherwise surface as a link error -//! on the platform CI builds but nobody develops on. - -// Copyright (c) 2025-2026 Jeff Garzik -// SPDX-License-Identifier: MIT - -use std::collections::BTreeSet; - -/// Every `.s` file in one runtime tree, as (path, text). -fn runtime_sources(dir: &str) -> Vec<(String, String)> { - let mut files = Vec::new(); - let entries = std::fs::read_dir(dir).unwrap_or_else(|e| panic!("cannot read {dir}: {e}")); - for entry in entries { - let path = entry.expect("readable directory entry").path(); - if path.extension().is_none_or(|e| e != "s") { - continue; - } - let text = std::fs::read_to_string(&path).expect("readable .s file"); - files.push((path.display().to_string(), text)); - } - files.sort(); - assert!(!files.is_empty(), "no .s files found in {dir}"); - files -} - -/// Every `.globl` symbol exported by one runtime tree. -fn exported_symbols(dir: &str) -> BTreeSet { - let mut names = BTreeSet::new(); - let entries = std::fs::read_dir(dir).unwrap_or_else(|e| panic!("cannot read {dir}: {e}")); - for entry in entries { - let path = entry.expect("readable directory entry").path(); - if path.extension().is_none_or(|e| e != "s") { - continue; - } - let text = std::fs::read_to_string(&path).expect("readable .s file"); - for line in text.lines() { - if let Some(sym) = line.trim().strip_prefix(".globl ") { - names.insert(sym.trim().to_string()); - } - } - } - names -} - -/// Helpers that legitimately exist on only one platform. -/// -/// Empty, and worth keeping that way: both trees now answer to the same -/// `_rt_platform_init`, each doing whatever its platform needs behind it. -/// Every name listed here is a divergence this test agrees not to notice. -const WIN64_ONLY: &[&str] = &[]; - -#[test] -fn test_runtimes_export_the_same_helpers() { - let sysv = exported_symbols("src/runtime/sysv"); - let win64 = exported_symbols("src/runtime/win64-native"); - - assert!( - sysv.len() > 20, - "only found {} symbols in the sysv runtime; the scan is probably broken", - sysv.len() - ); - - let missing_in_win64: Vec<&String> = sysv.difference(&win64).collect(); - assert!( - missing_in_win64.is_empty(), - "these helpers exist in the System V runtime but not the Win64 one: {missing_in_win64:?}" - ); - - let extra_in_win64: Vec<&String> = win64 - .difference(&sysv) - .filter(|s| !WIN64_ONLY.contains(&s.as_str())) - .collect(); - assert!( - extra_in_win64.is_empty(), - "these helpers exist in the Win64 runtime but not the System V one: {extra_in_win64:?}" - ); -} - -/// A message length must not be an assembler constant. -/// -/// `.equ len, . - label` reads as the safe way to avoid hand-counting, and it -/// is -- under GNU as, which folds it to an immediate. This tree is assembled -/// by GNU as on Linux and by clang on Windows, and where an assembler cannot -/// prove the symbol absolute it assembles `mov reg, len` as a *memory load -/// from that address* instead. `error.s` says so at the top: it hit this with -/// forward references and now measures its messages at run time. -/// -/// `_cls_seq_len` was the same shape, so every `CLS` on Windows loaded from -/// address 7 and died with an access violation, while Linux ran it as the -/// immediate the source appears to say. Nothing else was wrong with the -/// helper, which is why it took a table of exit codes to find. -/// -/// Bracket the data with labels and subtract at run time instead. Two -/// instructions, and the same answer whichever assembler ran. -#[test] -fn test_message_lengths_are_not_assembler_constants() { - let mut problems = Vec::new(); - - for dir in ["src/runtime/sysv", "src/runtime/win64-native"] { - for (path, text) in runtime_sources(dir) { - for (i, line) in text.lines().enumerate() { - let trimmed = line.split('#').next().unwrap_or("").trim(); - // Both spellings of an assembler constant: `.equ N, v` and - // `N = v`. Only checking `.equ` let one through before. - let (name, value) = match trimmed.strip_prefix(".equ ") { - Some(rest) => match rest.split_once(',') { - Some((n, v)) => (n.trim(), v.trim()), - None => continue, - }, - None => match trimmed.split_once('=') { - Some((lhs, rhs)) if !lhs.trim().contains(char::is_whitespace) => { - (lhs.trim(), rhs.trim()) - } - _ => continue, - }, - }; - // A plain number is fine: it is absolute to any assembler. - // Anything naming a label is not. - let symbolic = value - .split(|c: char| !(c.is_alphanumeric() || c == '_' || c == '.')) - .any(|t| { - !t.is_empty() && !t.chars().all(|c| c.is_ascii_hexdigit() || c == 'x') - }); - if symbolic || value.contains(". -") { - problems.push(format!( - "{path}:{}: `{trimmed}` measures {name} with the assembler. Bracket the \ - data with a `_end` label and subtract at run time: an assembler that \ - cannot prove this absolute turns `mov reg, {name}` into a memory load.", - i + 1 - )); - } - } - } - } - - assert!( - problems.is_empty(), - "{} assembler-computed length(s):\n{}", - problems.len(), - problems.join("\n") - ); -} - -/// An `_end` label must sit directly after the data it bounds. -/// -/// It is the run-time replacement for `. - label`, and it inherits the same -/// hazard: anything inserted between the data and the label is measured as -/// part of the message. Four format strings once were, and `CLS` wrote 75 -/// bytes where it meant to write 7. -#[test] -fn test_end_labels_bound_their_own_data() { - for dir in ["src/runtime/sysv", "src/runtime/win64-native"] { - for (path, text) in runtime_sources(dir) { - let lines: Vec<&str> = text - .lines() - .map(|l| l.split('#').next().unwrap_or("").trim()) - .collect(); - for (i, line) in lines.iter().enumerate() { - let Some(label) = line.strip_suffix(':') else { - continue; - }; - let Some(measured) = label.strip_suffix("_end") else { - continue; - }; - // Only labels that bound something. `.Lfile_past_end` is a - // branch target, and `_rt_end` is a helper whose name happens - // to split this way -- neither has a `_x:` data line to sit - // after. - let bounds_data = lines - .iter() - .any(|l| l.starts_with(&format!("{measured}: ."))); - if !bounds_data { - continue; - } - let previous = lines[..i].iter().rev().find(|l| !l.is_empty()); - assert!( - previous.is_some_and(|p| p.starts_with(&format!("{measured}:"))), - "{path}:{}: {label} must sit directly after {measured}'s data, but {:?} \ - intervenes -- everything between them is measured as part of the message", - i + 1, - previous.copied().unwrap_or("") - ); - } - } - } -} - -/// Both ABIs require `rsp` to be 16-byte aligned immediately before a `call`. -/// -/// This is not a performance nicety: the CRT spills SSE registers with -/// `movaps`, which faults outright on a misaligned address. A wrong prologue -/// reserve in `_rt_fmt_double` -- on the path of every numeric PRINT -- crashed -/// most of the Windows test suite with STATUS_ACCESS_VIOLATION, and the same -/// class of defect sat latent in the System V tree. -/// -/// On entry `rsp` is 8 (mod 16), because the caller's `call` pushed a return -/// address -- for a local label some helper `call`s as well as for a function. -/// Walking each function linearly is sound because none of them -/// changes `rsp` inside a branch that rejoins at a different depth; a -/// `lea rsp, ...` restores a frame, after which the model stops trusting -/// itself rather than reporting a guess. -#[test] -fn test_runtime_calls_are_stack_aligned() { - let mut problems = Vec::new(); - - for dir in ["src/runtime/sysv", "src/runtime/win64-native"] { - for (path, text) in runtime_sources(dir) { - let mut func = String::new(); - let mut offset: i64 = 8; - let mut unknown = false; - // Local labels some helper reaches by `call`: shared tails such as - // `.Lopen_failed` are entered with a return address pushed, like a - // function, whatever the code above them left rsp at. - let called: std::collections::HashSet<&str> = text - .lines() - .filter_map(|l| l.split('#').next()?.trim().strip_prefix("call .L")) - .map(|t| t.trim()) - .collect(); - - for (i, raw) in text.lines().enumerate() { - let line = raw.split('#').next().unwrap_or("").trim(); - if line.is_empty() { - continue; - } - - if let Some(sym) = line.strip_prefix(".globl ") { - func = sym.trim().to_string(); - continue; - } - // A top-level label reopening the current function resets the - // model; a local `.L` label is inside one and does not. - if let Some(name) = line.strip_suffix(':') { - let entered_by_call = name - .strip_prefix(".L") - .is_some_and(|local| called.contains(local)); - if name == func || entered_by_call { - offset = 8; - unknown = false; - } - continue; - } - - if line.starts_with("lea rsp,") { - unknown = true; - } else if line.starts_with("push ") || line.starts_with("pop ") { - offset = (offset + 8) % 16; - } else if let Some(n) = line.strip_prefix("sub rsp, ") { - offset = - (offset - n.trim().parse::().expect("literal reserve")).rem_euclid(16); - } else if let Some(n) = line.strip_prefix("add rsp, ") { - offset = (offset + n.trim().parse::().expect("literal release")) % 16; - } else if let Some(target) = line.strip_prefix("call ") - && !unknown - && offset != 0 - { - problems.push(format!( - "{}:{}: in {}: call {} with rsp % 16 == {} (want 0)", - path, - i + 1, - func, - target.trim(), - offset - )); - } - } - } - } - - assert!( - problems.is_empty(), - "{} misaligned call site(s):\n{}", - problems.len(), - problems.join("\n") - ); -} - -/// A helper must preserve the registers its own ABI calls callee-saved. -/// -/// The lists differ, and that is the whole hazard: `rdi` and `rsi` are -/// callee-saved on Win64 and scratch on System V, so a Win64 helper that uses -/// one as a temporary is wrong in a way no Linux run can show. `_rt_print_using_str` -/// did exactly that, and only survived because the code that calls it happens -/// not to keep anything in `rdi`. -/// -/// Deliberately crude: any `push` of a register anywhere in the helper counts -/// as saving it, and only writes through a named destination are seen. That is -/// enough for hand-written assembly of this shape, and a false negative is -/// better here than a test nobody trusts. -#[test] -fn test_helpers_preserve_callee_saved_registers() { - // `rbp` is excluded: every helper frames with it and restores it via - // `leave`, which this scan would have to model separately to no purpose. - const SYSV_SAVED: &[&str] = &["rbx", "r12", "r13", "r14", "r15"]; - const WIN64_SAVED: &[&str] = &[ - "rbx", "rdi", "rsi", "r12", "r13", "r14", "r15", "xmm6", "xmm7", "xmm8", "xmm9", "xmm10", - "xmm11", "xmm12", "xmm13", "xmm14", "xmm15", - ]; - - // A helper listed here has a private convention its own comment states. - // - // `_rt_random_prepare` returns four values in callee-saved registers: it is - // reached only from GET and PUT, which save them for it. - const PRIVATE_CONVENTION: &[&str] = &["_rt_random_prepare"]; - - let mut problems = Vec::new(); - - for (dir, saved) in [ - ("src/runtime/sysv", SYSV_SAVED), - ("src/runtime/win64-native", WIN64_SAVED), - ] { - for (path, text) in runtime_sources(dir) { - let mut helper = String::new(); - let mut pushed: BTreeSet = BTreeSet::new(); - let mut used: Vec<(usize, String)> = Vec::new(); - - let mut flush = |helper: &str, pushed: &BTreeSet, used: &[(usize, String)]| { - if PRIVATE_CONVENTION.contains(&helper) { - return; - } - for (line, reg) in used { - if !pushed.contains(reg) { - problems.push(format!( - "{path}:{line}: {helper} writes {reg}, which is callee-saved here, \ - without pushing it" - )); - } - } - }; - - for (i, raw) in text.lines().enumerate() { - let line = raw.split('#').next().unwrap_or("").trim(); - if let Some(name) = line.strip_prefix(".globl ") { - flush(&helper, &pushed, &used); - helper = name.trim().to_string(); - pushed.clear(); - used.clear(); - continue; - } - if let Some(reg) = line.strip_prefix("push ") { - pushed.insert(reg.trim().to_string()); - continue; - } - // ` , ...` -- the destination is what gets written. - let Some((_, rest)) = line.split_once(' ') else { - continue; - }; - let dest = rest.split(',').next().unwrap_or("").trim(); - // 32-bit writes clear the upper half, so they count too. - let full = match dest { - "edi" => "rdi", - "esi" => "rsi", - "ebx" => "rbx", - other => other, - }; - if saved.contains(&full) { - used.push((i + 1, full.to_string())); - } - } - flush(&helper, &pushed, &used); - } - } - - assert!( - problems.is_empty(), - "{} clobbered callee-saved register(s):\n{}", - problems.len(), - problems.join("\n") - ); -} From 0fd16982e38ee04e544a70a202c4f755db67e7d5 Mon Sep 17 00:00:00 2001 From: Jeff Garzik Date: Sat, 10 Oct 2026 17:50:02 +0000 Subject: [PATCH 10/17] Test FIELD's widest width and a FIELD variable outliving its file End-to-end versions of the two record-buffer fixes, now that programs link the Rust runtime. A FIELD variable used after its number is closed and reopened wrote freed memory (valgrind: invalid writes) before d51c794; the width test pins FIELD overflow at the largest LONG. Co-Authored-By: Claude Opus 5.5 --- tests/file_io/mod.rs | 56 ++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 56 insertions(+) diff --git a/tests/file_io/mod.rs b/tests/file_io/mod.rs index b691930..599f82e 100644 --- a/tests/file_io/mod.rs +++ b/tests/file_io/mod.rs @@ -1076,3 +1076,59 @@ PRINT "["; X$; "]["; Y$; "]["; Z$; "]" vec!["10 0 20", "[ab][][cd]"] ); } + +/// The widest FIELD width a program can pass, the largest LONG, is FIELD +/// overflow (error 50), not a window past the record buffer. (A width past +/// LONG is Overflow before it reaches the runtime, whose own check cannot +/// wrap either: see rt's `a_huge_field_width_is_field_overflow`.) +#[test] +fn test_field_width_that_wraps_is_overflow() { + let (out, _tmp) = compile_and_run_with_files( + r#" +ON ERROR GOTO H +OPEN "r.dat" FOR RANDOM AS #1 LEN = 16 +FIELD #1, 3 AS A$, 2147483647 AS B$ +PRINT "no" +END +H: +PRINT ERR +END +"#, + |_| Ok(()), + ) + .unwrap(); + assert_eq!(crate::common::lines(&out), vec!["50"]); +} + +/// A FIELD variable still names its window after its file is closed and +/// the number opened again: QuickBASIC leaves its value undefined, but +/// using it must not touch freed memory. The record buffer outlives the +/// file, and a fresh OPEN reuses it. +#[test] +fn test_field_variable_after_its_file_is_reopened() { + let (out, _tmp) = compile_and_run_with_files( + r#" +OPEN "r.dat" FOR RANDOM AS #1 LEN = 8 +FIELD #1, 8 AS F$ +LSET F$ = "abc" +PUT #1, 1 +CLOSE #1 +FOR I = 1 TO 50 + OPEN "s.txt" FOR OUTPUT AS #1 + PRINT #1, "x" + CLOSE #1 + OPEN "r.dat" FOR RANDOM AS #1 LEN = 8 + LSET F$ = "zz" + CLOSE #1 +NEXT +OPEN "r.dat" FOR RANDOM AS #1 LEN = 8 +FIELD #1, 8 AS G$ +GET #1, 1 +PRINT "["; G$; "]" +CLOSE #1 +"#, + |_| Ok(()), + ) + .unwrap(); + assert_eq!(crate::common::lines(&out), vec!["[abc ]"]); +} From 6bc81226d6292b1e780f7bafcb76b33f8572aeeb Mon Sep 17 00:00:00 2001 From: Jeff Garzik Date: Sat, 10 Oct 2026 18:00:36 +0000 Subject: [PATCH 11/17] Compile for aarch64: Linux and macOS arm64 With the runtime in portable Rust, the compiler itself was all that tied programs to x86-64. - Cranelift's arm64 backend is built in beside x86; the compiler targets its host, as before. has_sse41 is set only on x86-64 (an aarch64 ISA rejects it, so every compile failed). - macOS links with cc ... -Wl,-dead_strip: executables are always PIE there, which colocated references already are (adrp+add, bl through ld64's stubs); no -no-pie, no --gc-sections, no -lm. - CI gains ubuntu-24.04-arm and macos-latest jobs, the same steps as Linux. - The two ulimit -v memory tests run on Linux only; macOS ignores the limit. The runtime's nm test likewise, as a module. - Docs: README platforms, CLAUDE.md (targets, how to check aarch64 under qemu), the CLI's description; DEF SEG and VARSEG no longer say x86-64. Checked on aarch64 Linux under qemu-user (aarch64-linux-gnu-gcc to link): cargo test passes in full (126 + 589 + 57), and the aarch64 compiler's programs match the x86-64 compiler's on 646 of 649 examples and corpus programs, the 3 others being RND/TIMER as always. macOS is checked by clippy only here, and by its CI job. Co-Authored-By: Claude Opus 5.5 --- .github/workflows/TestingCI.yml | 62 ++++++++++++++++++++++++++++++++- CLAUDE.md | 13 +++++-- Cargo.toml | 6 ++-- README.md | 10 +++--- src/codegen/mod.rs | 6 +++- src/main.rs | 20 ++++++++--- src/parser.rs | 2 +- src/runtime.rs | 4 +-- src/sema.rs | 2 +- tests/strings/mod.rs | 6 ++-- 10 files changed, 108 insertions(+), 23 deletions(-) diff --git a/.github/workflows/TestingCI.yml b/.github/workflows/TestingCI.yml index 0c99e74..18ddc62 100644 --- a/.github/workflows/TestingCI.yml +++ b/.github/workflows/TestingCI.yml @@ -23,7 +23,67 @@ jobs: - name: Run clippy run: cargo clippy --release --all-targets -- -D warnings # The examples are the only programs compiled and run end to end through - # the real driver -- shelling out to the assembler and linker -- rather + # the real driver -- shelling out to the linker -- rather + # than through the test harness. + - name: Compile and run the examples + shell: bash + run: | + set -euo pipefail + for f in examples/*.bas; do + echo "== $f" + ./target/release/xbasic64 "$f" -o /tmp/example + /tmp/example /dev/null + done + + linux-aarch64: + runs-on: ubuntu-24.04-arm + steps: + - uses: actions/checkout@v4 + - uses: dtolnay/rust-toolchain@stable + with: + components: rustfmt, clippy + - name: Fetch + run: cargo fetch + - name: Build + run: cargo build --release --verbose + - name: Run tests + run: cargo test --release --verbose + - name: Run fmt check + run: cargo fmt --all -- --check + - name: Run clippy + run: cargo clippy --release --all-targets -- -D warnings + # The examples are the only programs compiled and run end to end through + # the real driver -- shelling out to the linker -- rather + # than through the test harness. + - name: Compile and run the examples + shell: bash + run: | + set -euo pipefail + for f in examples/*.bas; do + echo "== $f" + ./target/release/xbasic64 "$f" -o /tmp/example + /tmp/example /dev/null + done + + macos-arm64: + runs-on: macos-latest + steps: + - uses: actions/checkout@v4 + - uses: dtolnay/rust-toolchain@stable + with: + components: rustfmt, clippy + - name: Fetch + run: cargo fetch + - name: Build + run: cargo build --release --verbose + - name: Run tests + run: cargo test --release --verbose + - name: Run fmt check + run: cargo fmt --all -- --check + - name: Run clippy + run: cargo clippy --release --all-targets -- -D warnings + # The examples are the only programs compiled and run end to end through + # the real driver -- shelling out to the linker -- rather # than through the test harness. - name: Compile and run the examples shell: bash diff --git a/CLAUDE.md b/CLAUDE.md index 13ea7d4..555788e 100644 --- a/CLAUDE.md +++ b/CLAUDE.md @@ -27,7 +27,8 @@ cargo run -- -S program.bas # Cranelift IR to .clif instead (no o ## Architecture -xbasic64 is a BASIC-to-x86_64 native code compiler. The AST is lowered straight +xbasic64 is a BASIC native code compiler for x86-64 (Linux, Windows) and +aarch64 (Linux, macOS). The AST is lowered straight to Cranelift IR, and Cranelift writes the object file: ``` @@ -124,8 +125,14 @@ Integration tests organized by feature area: the backtracking one is superlinear with SSA values live across it; that code runs about 2x slower - **Every reference is colocated**: functions and data, the runtime's and libc's - included, are reached with `call rel32` and RIP-relative addresses; on Linux - the link is `-no-pie` + included, are reached PC-relative (`call rel32` and RIP-relative on x86-64, + `bl` and adrp+add on aarch64); on Linux the link is `-no-pie`, and macOS, + where executables are always PIE, needs nothing more +- **Native only, two ISAs**: Cranelift's `x86` and `arm64` backends are built + in, and the compiler targets the host it was built for. aarch64 Linux can be + checked on an x86-64 host under qemu-user: cross-build with + `aarch64-linux-gnu-gcc` as the linker, and put a `cc` that is that compiler + first in PATH for the compiler's own link step - **GW-BASIC semantics**: Division (`/`) always returns Double; integer division uses `\` - **Default type is Double**: Unsuffixed numeric variables are `#` (Double), not Single - **Boolean -1/0**: Comparisons return -1 (true) or 0 (false) for bitwise compatibility diff --git a/Cargo.toml b/Cargo.toml index 41ffd57..ac3412c 100644 --- a/Cargo.toml +++ b/Cargo.toml @@ -3,13 +3,13 @@ name = "xbasic64" version = "1.0.2" edition = "2024" authors = ["Jeff Garzik "] -description = "A BASIC-to-x86_64 native code compiler targeting 1980s-era BASIC dialects" +description = "A BASIC native code compiler (x86-64, aarch64) targeting 1980s-era BASIC dialects" license = "MIT" repository = "https://github.com/jgarzik/xbasic64" homepage = "https://github.com/jgarzik/xbasic64" documentation = "https://docs.rs/xbasic64" readme = "README.md" -keywords = ["basic", "compiler", "x86-64", "retro", "programming-language"] +keywords = ["basic", "compiler", "x86-64", "aarch64", "retro"] categories = ["compilers", "command-line-utilities", "development-tools"] rust-version = "1.96" @@ -25,7 +25,7 @@ default = [] [dependencies] clap = { version = "4", features = ["derive"] } # Pinned exactly: Cranelift's API changes between minor releases. -cranelift-codegen = { version = "=0.136.2", default-features = false, features = ["std", "x86", "unwind"] } +cranelift-codegen = { version = "=0.136.2", default-features = false, features = ["std", "x86", "arm64", "unwind"] } cranelift-frontend = "=0.136.2" cranelift-module = "=0.136.2" cranelift-object = "=0.136.2" diff --git a/README.md b/README.md index cb89210..a2662f6 100644 --- a/README.md +++ b/README.md @@ -1,10 +1,10 @@ # xbasic64 -A BASIC-to-x86_64 native code compiler. +A BASIC native code compiler for x86-64 and aarch64. ## Overview -xbasic64 compiles 1980s-era BASIC dialects (Tandy Color BASIC, GW-BASIC, QuickBASIC) directly to native x86-64 executables. No interpreter, no bytecode—just fast native binaries. +xbasic64 compiles 1980s-era BASIC dialects (Tandy Color BASIC, GW-BASIC, QuickBASIC) directly to native x86-64 and aarch64 executables. No interpreter, no bytecode—just fast native binaries. **Why xbasic64?** @@ -104,13 +104,15 @@ Key design choices: ## Requirements - Rust 1.96 or later -- Linux: the C compiler/linker (`cc`) with libc, to link programs +- Linux and macOS: the C compiler/linker (`cc`) with the C library, to link + programs - Windows: the MSVC linker (`link.exe`) and its C runtime, to link programs ## Platforms -- Linux (x86-64) +- Linux (x86-64, aarch64) - Windows (x86-64) +- macOS (arm64) ## License diff --git a/src/codegen/mod.rs b/src/codegen/mod.rs index b11ab35..822490c 100644 --- a/src/codegen/mod.rs +++ b/src/codegen/mod.rs @@ -439,7 +439,11 @@ fn make_isa(huge: bool) -> Result { } let mut isa = cranelift_codegen::isa::lookup(target_lexicon::Triple::host()) .map_err(|e| e.to_string())?; - isa.set("has_sse41", "true").map_err(|e| e.to_string())?; + // x86-64's baseline has no SSE4.1, whose roundsd `nearest`, `floor` and + // `trunc` use instead of a libcall. aarch64 has its equivalents always. + if cfg!(target_arch = "x86_64") { + isa.set("has_sse41", "true").map_err(|e| e.to_string())?; + } isa.finish(settings::Flags::new(flags)) .map_err(|e| e.to_string()) } diff --git a/src/main.rs b/src/main.rs index 37f1fa3..7f19cbe 100644 --- a/src/main.rs +++ b/src/main.rs @@ -1,6 +1,6 @@ -//! BASIC-to-x86_64 Compiler +//! BASIC native-code compiler //! -//! Compiles 1980s-era BASIC programs to x86-64 executables. +//! Compiles 1980s-era BASIC programs to native executables (x86-64, aarch64). //! Code generation is Cranelift, which writes the object file; the program is //! linked with `cc` on Linux and MSVC `link.exe` on Windows. @@ -19,10 +19,10 @@ use std::fs; use std::path::Path; use std::process::Command; -/// BASIC-to-x86_64 compiler +/// BASIC native-code compiler #[derive(Parser)] #[command(name = "xbasic64")] -#[command(about = "Compiles 1980s-era BASIC programs to x86-64 executables")] +#[command(about = "Compiles 1980s-era BASIC programs to native executables")] struct Args { /// Input BASIC source file input: String, @@ -229,7 +229,7 @@ fn main() { // rustc emits each function into a section of its own, which is what the // flag works with, since a linker discards unreferenced sections, never // unreferenced labels. `PRINT "hi"` calls three of the 85 helpers. - #[cfg(not(windows))] + #[cfg(all(unix, not(target_os = "macos")))] let cc_output = Command::new("cc") .args([ "-o", @@ -242,6 +242,16 @@ fn main() { ]) .output(); + // macOS: executables are always position independent there, so no + // -no-pie; the code is still fine, since a colocated reference is + // PC-relative (adrp+add, bl, which ld64 routes through a stub to reach + // libSystem). Apple's linker spells --gc-sections -dead_strip, and the + // math library is part of libSystem. + #[cfg(target_os = "macos")] + let cc_output = Command::new("cc") + .args(["-o", &exe_file, &obj_file, &rt_file, "-Wl,-dead_strip"]) + .output(); + match cc_output { Ok(out) if out.status.success() => { // A successful link can still have something to say. diff --git a/src/parser.rs b/src/parser.rs index 0cbe787..2d4d168 100644 --- a/src/parser.rs +++ b/src/parser.rs @@ -1928,7 +1928,7 @@ impl Parser { }; if name.eq_ignore_ascii_case("SEG") { return err( - "DEF SEG is not supported: it selects an 8086 segment, and segmented addressing does not exist on x86-64", + "DEF SEG is not supported: it selects an 8086 segment, and a flat 64-bit address space has no segments", ); } if !name.to_uppercase().starts_with("FN") { diff --git a/src/runtime.rs b/src/runtime.rs index d7a0150..c9b58f9 100644 --- a/src/runtime.rs +++ b/src/runtime.rs @@ -11,7 +11,8 @@ /// The runtime for the target this compiler was built for. pub const OBJECT: &[u8] = include_bytes!(concat!(env!("OUT_DIR"), "/rt.o")); -#[cfg(test)] +// nm is how the object is inspected, and Linux is where it is sure to be. +#[cfg(all(test, target_os = "linux"))] mod tests { use super::*; use std::process::Command; @@ -20,7 +21,6 @@ mod tests { /// table. In particular no part of `core` is left undefined -- a panic /// path the build did not merge in -- since a program could not link. #[test] - #[cfg(target_os = "linux")] fn test_runtime_needs_only_libc_and_the_program() { let dir = std::env::temp_dir().join(format!("xbasic64-rt-{}", std::process::id())); std::fs::create_dir_all(&dir).unwrap(); diff --git a/src/sema.rs b/src/sema.rs index b259155..d95383f 100644 --- a/src/sema.rs +++ b/src/sema.rs @@ -162,7 +162,7 @@ const UNSUPPORTED: &[(&str, &str)] = &[ "VARPTR$", "direct memory access has no meaning in a 64-bit hosted program", ), - ("VARSEG", "segmented addressing does not exist on x86-64"), + ("VARSEG", "a flat 64-bit address space has no segments"), ("USR", "USR calls 8086 machine code; use a SUB instead"), ("INP", "port I/O is not available to a user-mode program"), ("OUT", "port I/O is not available to a user-mode program"), diff --git a/tests/strings/mod.rs b/tests/strings/mod.rs index faa25eb..b6469b1 100644 --- a/tests/strings/mod.rs +++ b/tests/strings/mod.rs @@ -562,7 +562,8 @@ fn test_val_overflow_is_an_error() { /// must still finish. The cases are each place a string can be dropped: /// reassignment, a temporary, a FUNCTION result, a BYVAL copy, a local /// array, REDIM, a record field and record copy, and a SELECT selector. -#[cfg(unix)] +// `ulimit -v` limits the address space on Linux; macOS does not enforce it. +#[cfg(target_os = "linux")] #[test] fn test_string_churn_runs_in_bounded_memory() { let src = r#" @@ -629,7 +630,8 @@ PRINT LEN(A$); LEN(B$); LEN(C$); LEN(S$(3)) /// with about 60 KB of them live, once while the arguments are evaluated /// and once when the call itself is left by a RESUME to a label; leaking /// them is over 2 GB, against a 256 MB address-space limit. -#[cfg(unix)] +// `ulimit -v` limits the address space on Linux; macOS does not enforce it. +#[cfg(target_os = "linux")] #[test] fn test_error_path_frees_temporaries() { let src = r#" From 4ad016614078b20f6d34eed13563d166a9ce0514 Mon Sep 17 00:00:00 2001 From: Jeff Garzik Date: Sat, 10 Oct 2026 18:02:31 +0000 Subject: [PATCH 12/17] rt tests: leave no directories in /tmp The file and PRINT USING unit tests made /tmp/xbrt-file- and /tmp/xbrt-using- and never removed them, one more per test run. They now use tempfile directories, dropped at the end of each test; a test run in a child process, which may exit on a fatal error without unwinding, uses a directory its parent made and removes. Co-Authored-By: Claude Opus 5.5 --- Cargo.lock | 3 +++ rt/Cargo.toml | 3 +++ rt/src/file.rs | 28 ++++++++++++++++++---------- rt/src/num.rs | 8 ++++++++ rt/src/using.rs | 5 ++--- 5 files changed, 34 insertions(+), 13 deletions(-) diff --git a/Cargo.lock b/Cargo.lock index ea6f6ad..b848322 100644 --- a/Cargo.lock +++ b/Cargo.lock @@ -635,3 +635,6 @@ dependencies = [ [[package]] name = "xbasic64-rt" version = "1.0.2" +dependencies = [ + "tempfile", +] diff --git a/rt/Cargo.toml b/rt/Cargo.toml index 7d12483..f64725c 100644 --- a/rt/Cargo.toml +++ b/rt/Cargo.toml @@ -16,3 +16,6 @@ rust-version = "1.96" [lib] path = "src/lib.rs" doctest = false + +[dev-dependencies] +tempfile = "3" diff --git a/rt/src/file.rs b/rt/src/file.rs index 6def8b0..023f47f 100644 --- a/rt/src/file.rs +++ b/rt/src/file.rs @@ -1008,10 +1008,18 @@ mod tests { SERIAL.lock().unwrap_or_else(|e| e.into_inner()) } - fn temp(name: &str) -> String { - let dir = std::env::temp_dir().join(format!("xbrt-file-{}", std::process::id())); - std::fs::create_dir_all(&dir).unwrap(); - dir.join(name).to_str().unwrap().to_string() + /// A path for `name` in a fresh directory, removed when the guard is + /// dropped. A test running in a child process uses the directory its + /// parent made instead, and the parent removes it: the child may end + /// with a fatal error, which exits without dropping anything. + fn temp(name: &str) -> (Option, String) { + if let Some(dir) = std::env::var_os(crate::num::testing::TMP_VAR) { + let path = std::path::Path::new(&dir).join(name); + return (None, path.to_str().unwrap().to_string()); + } + let dir = tempfile::tempdir().unwrap(); + let path = dir.path().join(name).to_str().unwrap().to_string(); + (Some(dir), path) } fn open(name: &str, mode: i64, n: i64) { @@ -1114,7 +1122,7 @@ mod tests { #[test] fn sequential_round_trip() { let _g = serial(); - let path = temp("seq.txt"); + let (_dir, path) = temp("seq.txt"); open(&path, OUTPUT, 1); put(1, "abc"); assert_eq!(col(1), 3); @@ -1163,7 +1171,7 @@ mod tests { #[test] fn numeric_fields_end_at_a_blank() { let _g = serial(); - let path = temp("nums.txt"); + let (_dir, path) = temp("nums.txt"); std::fs::write(&path, " 1 2 3 \n 4 , 5\r\nx 6 y\r\nnext\n").unwrap(); open(&path, INPUT, 3); let num = || { @@ -1187,7 +1195,7 @@ mod tests { #[test] fn width_wraps_lines() { let _g = serial(); - let path = temp("width.txt"); + let (_dir, path) = temp("width.txt"); open(&path, OUTPUT, 4); unsafe { _rt_width(4, 5) }; put(4, "abcdefghijkl"); @@ -1207,7 +1215,7 @@ mod tests { #[test] fn random_files() { let _g = serial(); - let path = temp("random.dat"); + let (_dir, path) = temp("random.dat"); let _ = std::fs::remove_file(&path); unsafe { _rt_file_open_random(path.as_ptr(), path.len() as i64, 5, 8) }; assert!(!stream(5).is_null()); @@ -1264,7 +1272,7 @@ mod tests { fn a_huge_field_width_is_field_overflow() { use crate::num::testing::*; if in_child() { - let path = temp("hugefield.dat"); + let (_dir, path) = temp("hugefield.dat"); unsafe { _rt_file_open_random(path.as_ptr(), path.len() as i64, 6, 8) }; unsafe { _rt_field_reset(6) }; let a = unsafe { _rt_field_next(6, 3) }; @@ -1295,7 +1303,7 @@ mod tests { #[test] fn a_field_window_outlives_its_file() { let _g = serial(); - let path = temp("window.dat"); + let (_dir, path) = temp("window.dat"); let _ = std::fs::remove_file(&path); unsafe { _rt_file_open_random(path.as_ptr(), path.len() as i64, 7, 4) }; unsafe { _rt_field_reset(7) }; diff --git a/rt/src/num.rs b/rt/src/num.rs index de4b260..5e2f33f 100644 --- a/rt/src/num.rs +++ b/rt/src/num.rs @@ -365,6 +365,10 @@ pub(crate) mod testing { //! in parallel in this one. /// Whether this is the child process `expect_fatal` started. + /// Where a child process's test keeps its files: the parent's + /// directory, which the parent removes. + pub const TMP_VAR: &str = "XBASIC64_RT_TMP"; + pub fn in_child() -> bool { std::env::var_os("XBASIC64_RT_CHILD").is_some() } @@ -372,9 +376,13 @@ pub(crate) mod testing { /// Run the test `name` (its full path) in a child process, and require /// that it end with the fatal report `msg`. pub fn expect_fatal(name: &str, msg: &str) { + // The child's scratch directory, removed here: the child exits + // without unwinding. + let tmp = tempfile::tempdir().unwrap(); let out = std::process::Command::new(std::env::current_exe().unwrap()) .args([name, "--exact", "--nocapture", "--test-threads=1"]) .env("XBASIC64_RT_CHILD", "1") + .env(TMP_VAR, tmp.path()) .output() .unwrap(); let err = String::from_utf8_lossy(&out.stderr); diff --git a/rt/src/using.rs b/rt/src/using.rs index d4ecb8a..41eff84 100644 --- a/rt/src/using.rs +++ b/rt/src/using.rs @@ -489,9 +489,8 @@ mod tests { /// Whole statements, to a file, as the asm runtime printed them. #[test] fn statements_reuse_the_format() { - let dir = std::env::temp_dir().join(format!("xbrt-using-{}", std::process::id())); - std::fs::create_dir_all(&dir).unwrap(); - let path = dir.join("using.txt"); + let dir = tempfile::tempdir().unwrap(); + let path = dir.path().join("using.txt"); let name = path.to_str().unwrap(); unsafe { crate::file::_rt_file_open(name.as_ptr(), name.len() as i64, 1, 6) }; let start = |f: &str| unsafe { _rt_using_start(6, f.as_ptr(), f.len() as i64) }; From 45b2e8db0a7504034b9fec9cf32fd107d2a7e9dc Mon Sep 17 00:00:00 2001 From: Jeff Garzik Date: Sat, 10 Oct 2026 18:43:48 +0000 Subject: [PATCH 13/17] rt tests: run on Windows -- CRLF, and name an unexpected fatal error Windows CI died inside the runtime's unit-test binary: a fatal error ("?Permission denied in 30") exited the whole process, naming no test. Running the tests under Wine (windows-gnu) showed the rest: - A test that expects a fatal error compared the child's stderr with LF; Windows writes CRLF, and the child's stderr, not yet in binary mode as a program's is, made it CR CR LF. expect_fatal now normalizes line ends. - sequential_round_trip expected an LF from PRINT #'s newline, and a LOF of 51; both now follow sys::NEWLINE. - Under cfg(test), a fatal error outside a child process now panics with its message, so the harness names the test. Whatever raised Permission denied on Windows will say where on the next run. - The error test clears _err_line, which it left at 30 for every later test's report. Co-Authored-By: Claude Opus 5.5 --- rt/src/error.rs | 9 +++++++++ rt/src/file.rs | 9 +++++++-- rt/src/num.rs | 7 ++++++- 3 files changed, 22 insertions(+), 3 deletions(-) diff --git a/rt/src/error.rs b/rt/src/error.rs index b77297d..cb1001b 100644 --- a/rt/src/error.rs +++ b/rt/src/error.rs @@ -145,6 +145,14 @@ unsafe fn fatal(msg: *const u8, line: i64) -> ! { } else { _err_line.get() as i64 }; + // In the unit tests, an error nothing expected would exit the whole test + // binary without naming the test; a panic names it. A test expecting + // the exit runs in a child process (`num::testing::expect_fatal`). + #[cfg(test)] + if !crate::num::testing::in_child() { + let text = unsafe { core::ffi::CStr::from_ptr(msg.cast()) }; + panic!("unexpected fatal error: {text:?} in {line}"); + } sys::flush_all(); let msg = msg.cast::(); unsafe { @@ -279,5 +287,6 @@ mod tests { _err_pending.set(0); _err_active.set(0); _err_handler.set(0); + _err_line.set(0); } } diff --git a/rt/src/file.rs b/rt/src/file.rs index 023f47f..38bfd7e 100644 --- a/rt/src/file.rs +++ b/rt/src/file.rs @@ -1145,11 +1145,16 @@ mod tests { assert!(stream(1).is_null()); assert_eq!( std::fs::read(&path).unwrap(), - b"abc x ,\"q, r\",tail \n10,,20\r\na\0b\r\nlast" + [ + &b"abc x ,\"q, r\",tail "[..], + sys::NEWLINE, + b"10,,20\r\na\0b\r\nlast" + ] + .concat() ); open(&path, INPUT, 2); - assert_eq!(unsafe { _rt_file_lof(2) }, 51.0); + assert_eq!(unsafe { _rt_file_lof(2) }, 50.0 + sys::NEWLINE.len() as f64); assert_eq!(unsafe { _rt_file_eof(2) }, 0); let field = || text(unsafe { _rt_file_input_string(2) }); assert_eq!(field(), "abc x"); diff --git a/rt/src/num.rs b/rt/src/num.rs index 5e2f33f..ccde497 100644 --- a/rt/src/num.rs +++ b/rt/src/num.rs @@ -385,7 +385,12 @@ pub(crate) mod testing { .env(TMP_VAR, tmp.path()) .output() .unwrap(); - let err = String::from_utf8_lossy(&out.stderr); + // A program puts stderr in binary mode at startup and writes CRLF + // itself on Windows; this child's stderr is still in text mode, so + // that comes out as CR CR LF. Either way it is one line end. + let err = String::from_utf8_lossy(&out.stderr) + .replace("\r\r\n", "\n") + .replace("\r\n", "\n"); assert_eq!(out.status.code(), Some(1), "{name}: {err}"); assert!(err.contains(msg), "{name}: wanted {msg:?}, got {err:?}"); } From ad3d2eefefe05e01c4d055cc3d7491ed1ffc9fec Mon Sep 17 00:00:00 2001 From: Jeff Garzik Date: Sat, 10 Oct 2026 19:35:54 +0000 Subject: [PATCH 14/17] runtime test: remove its temp directory even when nm is missing It returned early, before removing the directory, on a host without nm; a tempfile guard removes it on every path. Co-Authored-By: Claude Opus 5.5 --- src/runtime.rs | 6 ++---- 1 file changed, 2 insertions(+), 4 deletions(-) diff --git a/src/runtime.rs b/src/runtime.rs index c9b58f9..51cc188 100644 --- a/src/runtime.rs +++ b/src/runtime.rs @@ -22,15 +22,13 @@ mod tests { /// path the build did not merge in -- since a program could not link. #[test] fn test_runtime_needs_only_libc_and_the_program() { - let dir = std::env::temp_dir().join(format!("xbasic64-rt-{}", std::process::id())); - std::fs::create_dir_all(&dir).unwrap(); - let obj = dir.join("rt.o"); + let dir = tempfile::tempdir().unwrap(); + let obj = dir.path().join("rt.o"); std::fs::write(&obj, OBJECT).unwrap(); let out = match Command::new("nm").arg("-u").arg(&obj).output() { Ok(out) => out, Err(_) => return, // no nm here: nothing to check with }; - let _ = std::fs::remove_dir_all(&dir); let text = String::from_utf8_lossy(&out.stdout); let foreign: Vec<&str> = text .lines() From fa5273bac709ec206685585e1fa7765339403395 Mon Sep 17 00:00:00 2001 From: Jeff Garzik Date: Sat, 10 Oct 2026 19:42:43 +0000 Subject: [PATCH 15/17] rt: fix long numbers, -$ in PRINT USING, closed random files - scan_number kept at most 120 characters, so VAL of a 130-digit number lost its magnitude. Significant digits now go to strtod as an integer and an exponent: leading zeros take no room, digits past 800 only move the point (with one sticky digit, so rounding is still exact), and the exponent is parsed and saturated here. consumed is unchanged; ordinary numbers round exactly as before. - PRINT USING put a negative number's sign after the $ of a $$ or **$ field ($-12.50); it goes before, as GW-BASIC writes -$12.50. - A RANDOM file that was CLOSEd kept its mode, so FIELD carved the old buffer and LOC reported the old record. random_buf now needs the stream open: FIELD on a closed number is Bad file number (52). - OPEN FOR RANDOM allocates the record buffer before opening the file, so Out of memory no longer leaves #n open and unusable. - x86-64 macOS links fstat$INODE64, whose struct stat is_directory reads. - strftime_now uses string::strdup; error.rs shares code_of. Co-Authored-By: Claude Opus 5.5 --- rt/src/error.rs | 19 ++-- rt/src/file.rs | 78 ++++++++++++---- rt/src/math.rs | 7 +- rt/src/num.rs | 208 +++++++++++++++++++++++++++++++++++-------- rt/src/sys.rs | 4 + rt/src/using.rs | 12 ++- tests/file_io/mod.rs | 22 +++++ tests/print/mod.rs | 17 ++++ tests/strings/mod.rs | 11 +++ 9 files changed, 310 insertions(+), 68 deletions(-) diff --git a/rt/src/error.rs b/rt/src/error.rs index cb1001b..e03b7d2 100644 --- a/rt/src/error.rs +++ b/rt/src/error.rs @@ -108,11 +108,16 @@ static ERR_ERL: Word = Word::new(0); /// Raise the error `msg` on `line` (0: the line in `_err_line`). Returns only /// when a handler traps it. pub fn raise(msg: &'static [u8], line: i64) { - let code = ERR_CODES + raise_with_code(msg.as_ptr(), code_of(msg.as_ptr()), line); +} + +/// The number of the `_err_*` message at `msg`, found by its address; 0 +/// for any other. +fn code_of(msg: *const u8) -> u64 { + ERR_CODES .iter() - .find(|(m, _)| core::ptr::eq(m.as_ptr(), msg.as_ptr())) - .map_or(0, |&(_, n)| n); - raise_with_code(msg.as_ptr(), code, line); + .find(|(m, _)| core::ptr::eq(m.as_ptr(), msg)) + .map_or(0, |&(_, n)| n) } /// The common path, with the number ERR is to report. @@ -207,11 +212,7 @@ export! { /// Raise the error `msg` (one of the `_err_*` messages) on `line`, 0 /// for the line in `_err_line`. Returns only when a handler traps it. fn _rt_error(msg: *const u8, line: i64) { - let code = ERR_CODES - .iter() - .find(|(m, _)| core::ptr::eq(m.as_ptr(), msg)) - .map_or(0, |&(_, n)| n); - raise_with_code(msg, code, line); + raise_with_code(msg, code_of(msg), line); } /// Report `msg` and exit, without consulting the handler: for the errors diff --git a/rt/src/file.rs b/rt/src/file.rs index 38bfd7e..97affa0 100644 --- a/rt/src/file.rs +++ b/rt/src/file.rs @@ -155,11 +155,12 @@ fn set_col(n: i64, c: i64) { } } -/// The record buffer of file number `n`, if it was last opened FOR RANDOM -/// (and the buffer could be allocated); null when it was not. +/// The record buffer of file number `n`, if it is open FOR RANDOM; null when +/// it is not. CLOSE leaves `mode` and the buffer as they were, so the stream +/// is what says the number is still open. fn random_buf(n: i64) -> *mut u8 { match slot(n) { - Some(i) if files().mode[i] == RANDOM => files().recbuf[i], + Some(i) if files().mode[i] == RANDOM && !files().stream[i].is_null() => files().recbuf[i], _ => ptr::null_mut(), } } @@ -682,6 +683,19 @@ export! { let Some(cname) = open_name(Str { ptr: name, len: len as usize }, n) else { return; }; + let i = n as usize % FILES; // what `slot` checked + // The number's buffer from an earlier OPEN, or its first one, + // allocated before the file is opened: binding the file first left + // it open, and unusable, when there was no memory for one. + let mut buf = files().recbuf[i]; + if buf.is_null() { + buf = unsafe { sys::malloc(MAX_RECLEN as usize) }.cast::(); + if buf.is_null() { + raise(&error::_err_memory[..], 0); + return; + } + files().recbuf[i] = buf; + } // A random file is read *and* written, so it is opened for update. // "r+b" fails when the file does not exist yet, in which case it is // created. @@ -693,19 +707,8 @@ export! { raise(open_error(unsafe { sys::open_failure(cname) }, RANDOM), 0); return; } - let i = n as usize % FILES; // what `slot` checked bind(i, f, RANDOM); files().reclen[i] = reclen; - // The number's buffer from an earlier OPEN, or its first one. - let mut buf = files().recbuf[i]; - if buf.is_null() { - buf = unsafe { sys::malloc(MAX_RECLEN as usize) }.cast::(); - if buf.is_null() { - raise(&error::_err_memory[..], 0); - return; - } - files().recbuf[i] = buf; - } // A new record reads as blanks, so a field never written holds // spaces rather than whatever the allocator or the last file left. unsafe { ptr::write_bytes(buf, b' ', reclen as usize) }; @@ -881,8 +884,13 @@ export! { fn _rt_field_next(n: i64, w: i64) -> Str { let buf = random_buf(n); if buf.is_null() { - // FIELD on a file not opened FOR RANDOM has no buffer to carve. - raise(&error::_err_badmode[..], 0); + // FIELD on a number not open is Bad file number; on a file not + // opened FOR RANDOM, which has no buffer to carve, Bad file mode. + if stream(n).is_null() { + raise(&error::_err_badfile[..], 0); + } else { + raise(&error::_err_badmode[..], 0); + } return Str::EMPTY; } let i = n as usize % FILES; // what `random_buf` checked @@ -1300,6 +1308,44 @@ mod tests { ); } + /// A number opened FOR RANDOM and then closed keeps its mode and buffer, + /// but is no random file: FIELD, GET and PUT are Bad file number (52), + /// and LOC and LOF are 0, as for any number not open. FIELD used to + /// carve the old buffer, and LOC report the old record. + #[test] + fn a_closed_random_file_is_not_open() { + use crate::error::_rt_err; + use crate::num::testing::*; + if in_child() { + let (_dir, path) = temp("closed.dat"); + unsafe { _rt_file_open_random(path.as_ptr(), path.len() as i64, 8, 8) }; + unsafe { _rt_file_put(8, 3, 0) }; + assert_eq!(unsafe { _rt_file_loc(8) }, 3.0); + unsafe { _rt_file_close(8) }; + assert!(random_buf(8).is_null()); + let bad_file = |raised: bool| raised && unsafe { _rt_err() } == 52; + unsafe { _rt_field_reset(8) }; + let (s, raised) = trapped(|| unsafe { _rt_field_next(8, 4) }); + assert!(bad_file(raised)); + assert_eq!(s, Str::EMPTY); + assert!(bad_file(trapped(|| unsafe { _rt_file_get(8, 1, 0) }).1)); + assert!(bad_file(trapped(|| unsafe { _rt_file_put(8, 1, 0) }).1)); + assert_eq!(trapped(|| unsafe { _rt_file_loc(8) }), (0.0, false)); + assert_eq!(trapped(|| unsafe { _rt_file_lof(8) }), (0.0, false)); + // Open, but not FOR RANDOM: Bad file mode. + open(&path, INPUT, 8); + let (_, raised) = trapped(|| unsafe { _rt_field_next(8, 4) }); + assert!(raised && unsafe { _rt_err() } == 54); + unsafe { _rt_file_close(8) }; + unsafe { _rt_field_next(8, 4) }; + return; + } + expect_fatal( + "file::tests::a_closed_random_file_is_not_open", + "?Bad file number\n", + ); + } + /// A FIELD variable is a window onto its file's record buffer, and /// outlives the OPEN that made it: a re-OPEN of the number, sequential or /// RANDOM, freed the buffer, and LSET then wrote freed memory and PRINT diff --git a/rt/src/math.rs b/rt/src/math.rs index 16a4886..d35c9b2 100644 --- a/rt/src/math.rs +++ b/rt/src/math.rs @@ -166,12 +166,7 @@ fn strftime_now(fmt: &[u8]) -> Str { ) }; // Fresh: the caller may hold another such result. - let p = crate::alloc_str(n); - if p.is_null() { - return Str::EMPTY; - } - unsafe { core::ptr::copy_nonoverlapping(buf.as_ptr(), p, n) }; - Str { ptr: p, len: n } + crate::string::strdup(buf.get(..n).unwrap_or(&[])) } export! { diff --git a/rt/src/num.rs b/rt/src/num.rs index ccde497..313c348 100644 --- a/rt/src/num.rs +++ b/rt/src/num.rs @@ -52,59 +52,74 @@ pub fn scan_number(text: &[u8]) -> Scanned { return scan_radix(text, i + 1); } - // The number, without its blanks, NUL-terminated for strtod. - let mut copy = [0u8; 128]; - let mut n = 0; + // The mantissa's significant digits, for strtod. + let mut digits = Decimal::EMPTY; + let mut negative = false; // Just past the last digit or point used. let mut consumed = 0; // 0 sign, 1 mantissa, 2 exponent sign, 3 exponent. let mut stage = 0; let mut point = false; - // 120 is the copy's room; a longer number has no more precision. - while i < text.len() && n < 120 { + // A digit of the mantissa was read, zero or not. + let mut mantissa = false; + // Places to move the kept digits' point by: plus the integer digits past + // the room, less the fraction digits kept or skipped as leading zeros. + let mut places: i64 = 0; + // The exponent as written, saturated far past any DOUBLE's. + let mut exponent: i64 = 0; + let mut exponent_negative = false; + while i < text.len() { let c = text[i]; match c { b' ' | b'\t' => {} - b'0'..=b'9' | b'.' => { - if c == b'.' { - // No point in an exponent, nor a second one. - if stage > 1 || point { - break; - } - point = true; - stage = 1; - } else { - stage = if stage < 2 { 1 } else { 3 }; + b'.' => { + // No point in an exponent, nor a second one. + if stage > 1 || point { + break; + } + point = true; + stage = 1; + consumed = i + 1; + } + b'0'..=b'9' if stage < 2 => { + stage = 1; + mantissa = true; + match (digits.push(c), point) { + (true, true) => places -= 1, + (false, false) => places += 1, // only a place now + _ => {} } - copy[n] = c; - n += 1; + consumed = i + 1; + } + b'0'..=b'9' => { + stage = 3; + exponent = (exponent * 10 + i64::from(c - b'0')).min(EXPONENT_MAX); consumed = i + 1; } // A sign begins the number or its exponent, and nothing else. b'+' | b'-' if stage == 0 || stage == 2 => { + if stage == 0 { + negative = c == b'-'; + } else { + exponent_negative = c == b'-'; + } stage += 1; - copy[n] = c; - n += 1; } // An exponent only after some of the mantissa. - b'e' | b'E' | b'd' | b'D' if stage == 1 => { - stage = 2; - copy[n] = b'e'; // strtod's spelling - n += 1; - } + b'e' | b'E' | b'd' | b'D' if stage == 1 => stage = 2, _ => break, } i += 1; } - if consumed == 0 { - return NONE; - } - let start = copy.as_ptr().cast::(); - let mut end = start.cast_mut(); - let value = unsafe { sys::strtod(start, &mut end) }; - if core::ptr::eq(end, start) { + if !mantissa { return NONE; // "+", "." and the like are no number } + let exponent = if exponent_negative { + -exponent + } else { + exponent + }; + let value = digits.value(negative, exponent + places); // Infinity is the only way past DOUBLE's range. let overflow = !value.is_finite(); Scanned { @@ -114,6 +129,104 @@ pub fn scan_number(text: &[u8]) -> Scanned { } } +/// An exponent far past any DOUBLE's, with room to add a number's length. +const EXPONENT_MAX: i64 = 1 << 40; + +/// A number's significant digits, given to strtod as an integer and an +/// exponent, so that a number of any length keeps its magnitude. +/// +/// 800 digits are enough for strtod to round exactly as it would with all of +/// them: no DOUBLE, nor any point halfway between two, has more than 767 +/// significant digits, and the digits past the 800th, when any is not 0, are +/// stood for by one sticky 1. So the value is what strtod gives the whole +/// number. +struct Decimal { + /// Sign, digits, sticky digit, 'e', exponent, NUL. + buf: [u8; Decimal::CAP], + /// Digits kept, from `buf[1]` on. + len: usize, + /// A digit past the room was not 0. + sticky: bool, +} + +impl Decimal { + const DIGITS: usize = 800; + const CAP: usize = Decimal::DIGITS + 32; + + const EMPTY: Decimal = Decimal { + buf: [0; Decimal::CAP], + len: 0, + sticky: false, + }; + + /// Keep digit `c`: false once there is no room for it. Leading zeros + /// are not kept, and take none. + fn push(&mut self, c: u8) -> bool { + if self.len == 0 && c == b'0' { + return true; + } + if self.len < Decimal::DIGITS + && let Some(b) = self.buf.get_mut(1 + self.len) + { + *b = c; + self.len += 1; + return true; + } + self.sticky |= c != b'0'; + false + } + + fn put(&mut self, at: &mut usize, c: u8) { + if let Some(b) = self.buf.get_mut(*at) { + *b = c; + *at += 1; + } + } + + /// The digits kept, read as an integer, times ten to `exponent`. + fn value(mut self, negative: bool, exponent: i64) -> f64 { + if let Some(b) = self.buf.get_mut(0) { + *b = if negative { b'-' } else { b'+' }; + } + let mut at = 1 + self.len; + if self.len == 0 { + self.put(&mut at, b'0'); // "-0" is -0, as strtod read it before + } else { + // Past 100000 either way, 800 digits are infinity or 0 alike. + let exponent = exponent.clamp(-100_000, 100_000) - i64::from(self.sticky); + if self.sticky { + self.put(&mut at, b'1'); + } + self.put(&mut at, b'e'); + if exponent < 0 { + self.put(&mut at, b'-'); + } + // The exponent's digits, least significant first. + let mut e = exponent.unsigned_abs(); + let mut text = [0u8; 20]; + let mut n = 0; + loop { + if let Some(t) = text.get_mut(n) { + *t = b'0' + (e % 10) as u8; + n += 1; + } + e /= 10; + if e == 0 { + break; + } + } + while n > 0 { + n -= 1; + let c = text.get(n).copied().unwrap_or(b'0'); + self.put(&mut at, c); + } + } + self.put(&mut at, 0); + let start = self.buf.as_ptr().cast::(); + unsafe { sys::strtod(start, core::ptr::null_mut()) } + } +} + /// The digits after `&`, `&H`, `&O` or `&B`, from `text[i]` on. fn scan_radix(text: &[u8], mut i: usize) -> Scanned { let mut radix = 8; // a bare & is octal @@ -597,11 +710,36 @@ mod tests { } #[test] - fn scan_keeps_120_characters() { + fn scan_reads_a_number_of_any_length() { + let s = |t: &str| scan_number(t.as_bytes()); let long = "1".repeat(200); - let s = scan_number(long.as_bytes()); - assert_eq!(s.consumed, 120); - assert_eq!(s.value, long[..120].parse::().unwrap()); + assert_eq!(s(&long).consumed, 200); + assert_eq!(s(&long).value, long.parse::().unwrap()); + // Digits past the room still count as places. + let big = format!("1{}", "0".repeat(129)); + assert_eq!(s(&big).value, 1e129); + assert_eq!(s(&format!("{big}.5x")).consumed, 132); + let huge = format!("0.{}9", "1".repeat(2000)); + assert_eq!(s(&huge).value, huge.parse::().unwrap()); + assert!(s(&"9".repeat(400)).overflow); + // Leading zeros take no room, before the point or after it. + let small = format!("0.{}5", "0".repeat(200)); + assert_eq!(s(&small).value, 5e-201); + assert_eq!(s(&small).consumed, small.len()); + assert_eq!(s(&format!("{}1.5", "0".repeat(1000))).value, 1.5); + assert_eq!(s(&format!("-.{}1e990", "0".repeat(1000))).value, -1e-11); + // The fraction past the room still rounds: exactly halfway + // between two DOUBLEs rounds to even, a hair above it rounds up. + let half = "9007199254740993"; // 2^53 + 1 + assert_eq!(s(half).value, 9007199254740992.0); + let above = format!("{half}.{}1", "0".repeat(1000)); + assert_eq!(s(&above).value, 9007199254740994.0); + // Exponents and signs as before. + assert_eq!(s(&format!("{}e-129", big)).value, 1.0); + assert_eq!(s(&format!("0.{}1e201", "0".repeat(199))).value, 10.0); + assert_eq!(s("-0").value.to_bits(), (-0.0f64).to_bits()); + assert!(s("1e99999999999999999999").overflow); + assert_eq!(s("1e-99999999999999999999").value, 0.0); } #[test] diff --git a/rt/src/sys.rs b/rt/src/sys.rs index eefc373..8a345a8 100644 --- a/rt/src/sys.rs +++ b/rt/src/sys.rs @@ -322,6 +322,10 @@ mod unix { #[cfg(target_vendor = "apple")] unsafe extern "C" { fn __error() -> *mut c_int; + // The 64-bit-inode `struct stat`, which `is_directory` reads. It is + // arm64's only one, but x86-64's plain `fstat` fills the legacy + // layout, with a 32-bit st_ino before st_mode. + #[cfg_attr(target_arch = "x86_64", link_name = "fstat$INODE64")] fn fstat(fd: c_int, buf: *mut core::ffi::c_void) -> c_int; } diff --git a/rt/src/using.rs b/rt/src/using.rs index 41eff84..a89c696 100644 --- a/rt/src/using.rs +++ b/rt/src/using.rs @@ -258,10 +258,11 @@ fn render_num(width: usize, decimals: usize, flags: u32, value: f64, out: &mut [ let decimals = decimals.min(MAX_DECIMALS); let width = width.min(MAX_WIDTH); let mut value = value; - // A trailing sign, or a forced sign placed here, means the number is + // A trailing sign, a forced sign placed here, or a minus that goes before + // the dollar sign ("-$12.50", as GW-BASIC writes it) means the number is // formatted without one. let mut sign = 0u8; - if flags & (TRAIL_SIGN | FORCE_SIGN) != 0 { + if flags & (TRAIL_SIGN | FORCE_SIGN | DOLLAR) != 0 { // NaN is unordered, so it takes the minus sign, as ucomisd did. if value >= 0.0 { if flags & FORCE_SIGN != 0 { @@ -464,6 +465,13 @@ mod tests { assert_eq!(num(12, 0, COMMA, -1234567.0), " -1,234,567"); assert_eq!(num(6, 2, STAR, 1.5), "**1.50"); assert_eq!(num(7, 2, DOLLAR, 1.5), " $1.50"); + // The sign goes before the dollar sign, and counts in the width. + assert_eq!(num(8, 2, DOLLAR, -12.5), " -$12.50"); + assert_eq!(num(9, 2, STAR | DOLLAR, -12.5), "**-$12.50"); + assert_eq!(num(5, 2, DOLLAR, -12.5), "%-$12.50"); + assert_eq!(num(10, 2, DOLLAR | COMMA, -1234.5), "-$1,234.50"); + assert_eq!(num(8, 2, DOLLAR | FORCE_SIGN, 12.5), " +$12.50"); + assert_eq!(num(8, 2, DOLLAR | TRAIL_SIGN, -12.5), " $12.50-"); assert_eq!(num(4, 0, TRAIL_SIGN, 5.0), " 5 "); assert_eq!(num(4, 0, TRAIL_SIGN, -5.0), " 5-"); assert_eq!(num(4, 0, TRAIL_SIGN | FORCE_SIGN, 5.0), " 5+"); diff --git a/tests/file_io/mod.rs b/tests/file_io/mod.rs index 599f82e..59223cb 100644 --- a/tests/file_io/mod.rs +++ b/tests/file_io/mod.rs @@ -1132,3 +1132,25 @@ CLOSE #1 .unwrap(); assert_eq!(crate::common::lines(&out), vec!["[abc ]"]); } + +/// FIELD on a number that was opened FOR RANDOM and then closed is Bad file +/// number (error 52): the record buffer outlives the file, the file does not. +#[test] +fn test_field_on_a_closed_random_file() { + let (out, _tmp) = compile_and_run_with_files( + r#" +ON ERROR GOTO H +OPEN "r.dat" FOR RANDOM AS #1 LEN = 8 +CLOSE #1 +FIELD #1, 4 AS F$ +PRINT "no" +END +H: +PRINT ERR +END +"#, + |_| Ok(()), + ) + .unwrap(); + assert_eq!(crate::common::lines(&out), vec!["52"]); +} diff --git a/tests/print/mod.rs b/tests/print/mod.rs index 0f11111..07f155a 100644 --- a/tests/print/mod.rs +++ b/tests/print/mod.rs @@ -658,3 +658,20 @@ fn test_legacy_print_forms() { let out = compile_and_run("? \"a\"\"b\"\n?1+1\nPRINT \"open\nPRINT \"next\"\n").unwrap(); assert_eq!(crate::common::lines(&out), &["ab", "2", "open", "next"]); } + +/// A negative number in a `$$` or `**$` field has its sign before the +/// dollar sign, as GW-BASIC writes it: -$12.50, not $-12.50. +#[test] +fn test_print_using_negative_currency() { + let out = compile_and_run( + "PRINT USING \"$$###.##\"; -12.5\nPRINT USING \"**$###.##\"; -12.5\nPRINT USING \"$$###.##\"; 12.5\n", + ) + .unwrap(); + let lines = crate::common::lines(&out); + assert_eq!(lines[0], "-$12.50"); + assert!( + lines[1].ends_with("-$12.50") && lines[1].starts_with('*'), + "{lines:?}" + ); + assert_eq!(lines[2], "$12.50"); +} diff --git a/tests/strings/mod.rs b/tests/strings/mod.rs index b6469b1..aa5fa4a 100644 --- a/tests/strings/mod.rs +++ b/tests/strings/mod.rs @@ -748,3 +748,14 @@ PRINT REC$(3) ] ); } + +/// A number longer than any buffer keeps its magnitude: the digits past +/// what can matter still count as places. +#[test] +fn test_val_of_a_very_long_number() { + let out = compile_and_run( + "A$ = \"1\" + STRING$(129, \"0\")\nPRINT VAL(A$)\nPRINT VAL(\"0.\" + STRING$(200, \"0\") + \"5\")\n", + ) + .unwrap(); + assert_eq!(crate::common::lines(&out), vec!["1D+129", "5D-201"]); +} From 54ca2c36943a2fc8747ef82ee11f52af0524ba75 Mon Sep 17 00:00:00 2001 From: Jeff Garzik Date: Sat, 10 Oct 2026 19:46:43 +0000 Subject: [PATCH 16/17] rt: format numbers without per-digit calls or copies; print whole numbers without snprintf Number printing had become 7-12% slower than the asm runtime: every digit went through a non-inlined NumText::push, fmt_basic copied the text again to prepend its blank, and print_number a third time to append PRINT's. - fmt_double writes through a local cursor, runs of digits and zeros as one slice copy each (per-byte loops unrolled into kilobytes) - NumText is buf[start..end]; fmt_double leaves the byte before the text free, so fmt_basic only stores the blank, and print_number appends its blank in place (with_trailing_blank) - A whole number below 10^P (P = 7 SINGLE, 16 DOUBLE) prints exactly its integer's digits, so it is converted directly, skipping snprintf("%.*e"). Integer variables reach PRINT and STR$ as doubles, so this is their path too. A test checks it against the snprintf path near zero and both limits, plus explicit boundary strings (-0, 1E15, 1E16, 9999999/1E7 SINGLE, .5, 16777216 SINGLE) Best of 5, 2M iterations, output to /dev/null, output byte-identical: master(asm) before after PRINT I&/3 0.33 0.38 0.24 A$ = STR$(I&/3) 0.32 0.37 0.24 PRINT I&; I&*1.5#; I&/3 0.94 1.05 0.46 PRINT I& 0.30 0.30 0.03 PRINT X! (SINGLE) 0.25 0.25 0.22 PRINT (I&+.5#)/3 (never whole) 0.34 0.38 0.34 rt.o text 30139 -> 30098; a PRINT I& program's text 5569 -> 6028. Co-Authored-By: Claude Opus 5.5 --- rt/src/file.rs | 7 +- rt/src/num.rs | 258 ++++++++++++++++++++++++++++++++++++++----------- 2 files changed, 203 insertions(+), 62 deletions(-) diff --git a/rt/src/file.rs b/rt/src/file.rs index 38bfd7e..bf4c093 100644 --- a/rt/src/file.rs +++ b/rt/src/file.rs @@ -298,11 +298,8 @@ fn zone_target(col: i64, width: i64) -> Option { /// after it. Under a WIDTH, a number that does not fit on the rest of the /// line starts the next one, as in GW-BASIC, rather than being split. fn print_number(n: i64, text: num::NumText) { - let t = text.as_bytes(); - let k = t.len().min(num::NumText::CAP); - let mut buf = [b' '; num::NumText::CAP + 1]; - buf[..k].copy_from_slice(&t[..k]); - let s = &buf[..k + 1]; + let text = text.with_trailing_blank(); + let s = text.as_bytes(); let (w, c) = (width(n), col(n)); if w != 0 && c != 0 && (c + s.len() as i64) as u64 > w as u64 { newline(n); diff --git a/rt/src/num.rs b/rt/src/num.rs index ccde497..13bfcb7 100644 --- a/rt/src/num.rs +++ b/rt/src/num.rs @@ -169,48 +169,114 @@ fn scan_radix(text: &[u8], mut i: usize) -> Scanned { } } -/// A formatted number: at most `NumText::CAP` bytes, no terminator. +/// A formatted number: the bytes `buf[start..end]`, no terminator. /// -/// Built without a path that could panic: the runtime object carries no -/// part of `core`'s panic machinery, so a bounds check that could fail would -/// be an undefined symbol at link time. +/// `fmt_double` always leaves a byte free before `start`, so `fmt_basic` +/// adds its blank there, and room after `end` for PRINT's blank, rather +/// than either copying the text. Built without a path that could panic: +/// the runtime object carries no part of `core`'s panic machinery, so a +/// bounds check that could fail would be an undefined symbol at link time. +/// Every index is masked to the buffer instead; no number comes near it. #[derive(Clone, Copy)] pub struct NumText { buf: [u8; NumText::CAP], - len: usize, + start: usize, + end: usize, } impl NumText { - pub const CAP: usize = 48; - - const EMPTY: NumText = NumText { - buf: [0; NumText::CAP], - len: 0, - }; + /// A power of two, for the masks. The longest text is about 25 bytes. + pub const CAP: usize = 64; + const MASK: usize = NumText::CAP - 1; pub fn as_bytes(&self) -> &[u8] { - self.buf.get(..self.len).unwrap_or(&[]) + self.buf.get(self.start..self.end).unwrap_or(&[]) } - /// Append `c`; no number is long enough to fill the buffer. Not inlined: - /// the loops calling it are unrolled into kilobytes otherwise. - #[inline(never)] - fn push(&mut self, c: u8) { - if let Some(b) = self.buf.get_mut(self.len) { - *b = c; - self.len += 1; + /// The text with a blank after it, as PRINT writes a number. + pub fn with_trailing_blank(mut self) -> NumText { + self.buf[self.end & NumText::MASK] = b' '; + self.end += 1; + self + } +} + +/// Writes a `NumText` front to back through a local cursor, so a digit is a +/// store, not a call. +struct Cursor { + buf: [u8; NumText::CAP], + k: usize, +} + +impl Cursor { + /// Text starts at byte 1: byte 0 is `fmt_basic`'s. + fn new() -> Cursor { + Cursor { + buf: [0; NumText::CAP], + k: 1, } } - fn extend<'a>(&mut self, bytes: impl IntoIterator) { - for &c in bytes { - self.push(c); + #[inline(always)] + fn put(&mut self, c: u8) { + self.buf[self.k & NumText::MASK] = c; + self.k += 1; + } + + /// Append `src` in one copy: per-byte loops unroll into kilobytes. + fn copy(&mut self, src: &[u8]) { + if let Some(d) = self.buf.get_mut(self.k..self.k + src.len()) { + d.copy_from_slice(src); + self.k += src.len(); + } + } + + fn done(self) -> NumText { + NumText { + buf: self.buf, + start: 1, + end: self.k, } } } const FMT_SCI: &[u8] = b"%.*e\0"; +/// A whole number of at most `p` digits, as `fmt_double` writes it, without +/// the C library: such a value prints in full, every digit exact, so its +/// text is just its integer's. `None` for any other value. +fn fmt_whole(x: f64, single: bool) -> Option { + // 10^P: past it the value has more digits than the type shows. + let limit = if single { 1E7 } else { 1E16 }; + // NaN fails both comparisons; -0.0 never gets here. + if !(x > -limit && x < limit) { + return None; + } + let i = x as i64; // exact within the limit, so the test is exact + if i as f64 != x { + return None; // a fraction + } + // Written back to front, ending at 24: 16 digits and a sign fit, and + // byte `start - 1` stays free for `fmt_basic`. + let mut buf = [0u8; NumText::CAP]; + let end = 24; + let mut k = end; + let mut u = i.unsigned_abs(); + loop { + k -= 1; + buf[k & NumText::MASK] = b'0' + (u % 10) as u8; + u /= 10; + if u == 0 { + break; + } + } + if i < 0 { + k -= 1; + buf[k & NumText::MASK] = b'-'; + } + Some(NumText { buf, start: k, end }) +} + /// A number's digits as GW-BASIC writes them, without the leading blank /// (`_rt_fmt_double`): 7 significant digits for a SINGLE, 16 for a DOUBLE. /// @@ -222,14 +288,23 @@ const FMT_SCI: &[u8] = b"%.*e\0"; /// has no leading zero, and the exponent is spelled E for a SINGLE and D for /// a DOUBLE, with at least two digits. A SINGLE arrives widened to double. pub fn fmt_double(x: f64, single: bool) -> NumText { - let p: usize = if single { 7 } else { 16 }; - let mut out = NumText::EMPTY; // Zero, of either sign, is 0. if x == 0.0 { - out.push(b'0'); - return out; + let mut out = Cursor::new(); + out.put(b'0'); + return out.done(); + } + // Whole numbers, every integer variable's among them, need no snprintf. + match fmt_whole(x, single) { + Some(t) => t, + None => fmt_sci(x, single), } +} +/// `fmt_double` of a nonzero value, through the C library's rounding. +fn fmt_sci(x: f64, single: bool) -> NumText { + let p: usize = if single { 7 } else { 16 }; + let mut out = Cursor::new(); // "[-]d.ddd...e[+-]xx": P significant digits, rounded by the C library. let mut sci = [0u8; 64]; unsafe { @@ -245,7 +320,7 @@ pub fn fmt_double(x: f64, single: bool) -> NumText { // buffer, which the C library's text never fills, so none can panic. let mut start = 0; if sci[0] == b'-' { - out.push(b'-'); + out.put(b'-'); start = 1; } let at = |i: usize| sci[(start + i) & 63]; @@ -253,17 +328,18 @@ pub fn fmt_double(x: f64, single: bool) -> NumText { // inf or nan: as the C library wrote it. let mut i = 0; while at(i) != 0 && i < 63 { - out.push(at(i)); + out.put(at(i)); i += 1; } - return out; + return out.done(); } // The P digits, without the point. let mut digits = [0u8; 16]; digits[0] = at(0); - for i in 1..p { - digits[i & 15] = at(i + 1); + // Both are P-1 long: the copy cannot fail. + if let (Some(d), Some(s)) = (digits.get_mut(1..p), sci.get(start + 2..start + 1 + p)) { + d.copy_from_slice(s); } // The decimal exponent X, so the value is d.ddd * 10^X. let mut x: i32 = 0; @@ -281,10 +357,8 @@ pub fn fmt_double(x: f64, single: bool) -> NumText { n -= 1; } let (pi, ni) = (p as i32, n as i32); - let put = |out: &mut NumText, from: usize, to: usize| { - for i in from..to { - out.push(digits[i & 15]); - } + let put = |out: &mut Cursor, from: usize, to: usize| { + out.copy(digits.get(from..to).unwrap_or(&[])); }; // Fixed point when it shows the value in at most P digits, as GW-BASIC @@ -295,34 +369,34 @@ pub fn fmt_double(x: f64, single: bool) -> NumText { let int = x as usize + 1; put(&mut out, 0, int); if int < n { - out.push(b'.'); + out.put(b'.'); put(&mut out, int, n); } } else if x < 0 && -x - 1 + ni <= pi { - out.push(b'.'); // no leading zero, as .5 - for _ in 0..-x - 1 { - out.push(b'0'); - } + out.put(b'.'); // no leading zero, as .5 + // At most P-1 zeros, by the test above. + const ZEROS: [u8; 16] = [b'0'; 16]; + out.copy(ZEROS.get(..(-x - 1) as usize).unwrap_or(&[])); put(&mut out, 0, n); } else { // d[.ddd]E+xx, D for a DOUBLE. - out.push(digits[0]); + out.put(digits[0]); if n > 1 { - out.push(b'.'); + out.put(b'.'); put(&mut out, 1, n); } - out.push(if single { b'E' } else { b'D' }); - out.push(if x < 0 { b'-' } else { b'+' }); + out.put(if single { b'E' } else { b'D' }); + out.put(if x < 0 { b'-' } else { b'+' }); let mut e = x.unsigned_abs(); if e >= 100 { // Two digits at least, three if needed. - out.push(b'0' + (e / 100) as u8); + out.put(b'0' + (e / 100) as u8); e %= 100; } - out.push(b'0' + (e / 10) as u8); - out.push(b'0' + (e % 10) as u8); + out.put(b'0' + (e / 10) as u8); + out.put(b'0' + (e % 10) as u8); } - out + out.done() } /// `fmt_double` with the blank that stands where a minus sign would go, as @@ -332,16 +406,16 @@ pub fn fmt_double(x: f64, single: bool) -> NumText { /// `PRINT 1; 2` reads " 1 2 " and why STR$(5) is " 5" -- the /// `MID$(STR$(N), 2)` idiom exists to strip exactly this blank. Not folded /// into `fmt_double`, because WRITE and PRINT USING render numbers through -/// that and must not gain the blank. +/// that and must not gain the blank. `fmt_double` leaves the byte before +/// its text free for it. pub fn fmt_basic(x: f64, single: bool) -> NumText { - let t = fmt_double(x, single); - if t.buf[0] == b'-' { - return t; // '-' already occupies the sign position - } - let mut out = NumText::EMPTY; - out.push(b' '); - out.extend(t.as_bytes()); - out + let mut t = fmt_double(x, single); + if t.buf[t.start & NumText::MASK] != b'-' { + // '-' already occupies the sign position; anything else gets a blank. + t.start = t.start.wrapping_sub(1); + t.buf[t.start & NumText::MASK] = b' '; + } + t } export! { @@ -499,6 +573,76 @@ mod tests { } } + #[test] + fn whole_numbers_print_as_the_c_library_rounds_them() { + // The fast path's boundaries, and either side of each. + let cases: &[(f64, bool, &str)] = &[ + (-0.0, false, " 0"), + (-0.0, true, " 0"), + (1.0, false, " 1"), + (-1.0, true, "-1"), + (0.5, false, " .5"), + (-0.5, true, "-.5"), + (1.5, true, " 1.5"), + (9999999.0, true, " 9999999"), + (-9999999.0, true, "-9999999"), + (10000000.0, true, " 1E+07"), + (-10000000.0, true, "-1E+07"), + (9999999.5, true, " 1E+07"), + (9999999.4, true, " 9999999"), + (16777216.0, true, " 1.677722E+07"), + (10000000.0, false, " 10000000"), + (999999999999999.0, false, " 999999999999999"), + (1E15, false, " 1000000000000000"), + (-1E15, false, "-1000000000000000"), + (1E15 + 1.0, false, " 1000000000000001"), + (9999999999999998.0, false, " 9999999999999998"), + (-9999999999999998.0, false, "-9999999999999998"), + (1E16, false, " 1D+16"), + (1E16 + 2.0, false, " 1D+16"), + (-1E16, false, "-1D+16"), + (4503599627370497.0, false, " 4503599627370497"), + (2147483647.0, false, " 2147483647"), + (-2147483648.0, false, "-2147483648"), + (32767.0, true, " 32767"), + (-32768.0, true, "-32768"), + (1E300, false, " 1D+300"), + ]; + for &(x, single, want) in cases { + let got = fmt_basic(x, single); + assert_eq!(got.as_bytes(), want.as_bytes(), "{x:e} single={single}"); + assert_eq!( + got.with_trailing_blank().as_bytes(), + format!("{want} ").as_bytes() + ); + } + // The fast path agrees with the C library's for every whole number + // it takes, near zero and near each limit. + for (limit, single) in [(1E7, true), (1E16, false)] { + for k in 0..2000 { + // Past 2^53 a DOUBLE holds only the even integers. + for x in [k as f64, limit - 2.0 - k as f64 * 2.0] { + for x in [x, -x] { + if x == 0.0 { + continue; + } + let fast = fmt_whole(x, single).expect("whole and in range"); + assert_eq!( + fast.as_bytes(), + fmt_sci(x, single).as_bytes(), + "{x:e} single={single}" + ); + } + } + } + assert!(fmt_whole(limit, single).is_none()); + assert!(fmt_whole(-limit, single).is_none()); + } + assert!(fmt_whole(0.5, false).is_none()); + assert!(fmt_whole(f64::NAN, false).is_none()); + assert!(fmt_whole(f64::INFINITY, true).is_none()); + } + #[test] fn fmt_double_has_no_blank() { assert_eq!(fmt_double(5.0, false).as_bytes(), b"5"); From ac81dd934dce4488b7f3a07b7d59f43ff2b7cf6b Mon Sep 17 00:00:00 2001 From: Jeff Garzik Date: Sat, 10 Oct 2026 20:00:23 +0000 Subject: [PATCH 17/17] rt: keep 767 digits of a long number, so UCRT sees the sticky digit scan_number kept 800 significant digits and stood for any nonzero digit past them with one sticky 1, as the 801st. UCRT's strtod reads only 768 significant digits, so on Windows it never saw the sticky digit: a number a hair above a halfway point between two DOUBLEs (2^53+1 followed by a nonzero digit 1000 places on) rounded to even, down, and the rt test scan_reads_a_number_of_any_length failed there. 767 digits are still exact -- no DOUBLE, nor any halfway point, has more than 767 significant digits -- and the sticky digit is now the 768th. Co-Authored-By: Claude Opus 5.5 --- rt/src/num.rs | 12 +++++++----- 1 file changed, 7 insertions(+), 5 deletions(-) diff --git a/rt/src/num.rs b/rt/src/num.rs index 1b538cc..59aa158 100644 --- a/rt/src/num.rs +++ b/rt/src/num.rs @@ -135,11 +135,13 @@ const EXPONENT_MAX: i64 = 1 << 40; /// A number's significant digits, given to strtod as an integer and an /// exponent, so that a number of any length keeps its magnitude. /// -/// 800 digits are enough for strtod to round exactly as it would with all of +/// 767 digits are enough for strtod to round exactly as it would with all of /// them: no DOUBLE, nor any point halfway between two, has more than 767 -/// significant digits, and the digits past the 800th, when any is not 0, are +/// significant digits, and the digits past the 767th, when any is not 0, are /// stood for by one sticky 1. So the value is what strtod gives the whole -/// number. +/// number. No more than that: UCRT's strtod reads only 768 significant +/// digits, so a sticky digit any later is ignored there, and a number just +/// past a halfway point rounded to even. struct Decimal { /// Sign, digits, sticky digit, 'e', exponent, NUL. buf: [u8; Decimal::CAP], @@ -150,7 +152,7 @@ struct Decimal { } impl Decimal { - const DIGITS: usize = 800; + const DIGITS: usize = 767; const CAP: usize = Decimal::DIGITS + 32; const EMPTY: Decimal = Decimal { @@ -192,7 +194,7 @@ impl Decimal { if self.len == 0 { self.put(&mut at, b'0'); // "-0" is -0, as strtod read it before } else { - // Past 100000 either way, 800 digits are infinity or 0 alike. + // Past 100000 either way, 767 digits are infinity or 0 alike. let exponent = exponent.clamp(-100_000, 100_000) - i64::from(self.sticky); if self.sticky { self.put(&mut at, b'1');