From aaec6598e2afedab6693370e138526a8a8651eb3 Mon Sep 17 00:00:00 2001 From: Eval Exec Date: Wed, 23 Sep 2026 19:22:51 +0800 Subject: [PATCH] fix(ccl): execute branch and read-branch jump tables A CCL program whose first instruction is branch failed in Neomacs with "Error in CCL program at 3th code" and exited 255. GNU Emacs runs the same program and prints the selected block. Reported in #435 with (branch r0 (write "A")), which ccl.el compiles to a vector whose first real word is opcode 0x0D (CCL_Branch). (write "A") alone already worked, because CCL_WriteConstString was implemented. The driver matched raw opcode numbers and treated every unimplemented code as an invalid program. CCL_Branch was one of those codes, so a valid jump table was rejected at vector index 2. GNU's driver (src/ccl.c) indexes the following words by the register when it is in range, and uses one extra slot otherwise. Each entry is a raw relative offset from the table head. CCL_ReadBranch reads one character and then uses that same table; EOF skips the table, and a suspended read resumes on the same word. CclCommand is now a repr(u8) enum of every GNU opcode. strum::FromRepr turns the 5-bit field into a variant with a safe const match, and the driver matches that enum with no wildcard. branch and read-branch share ccl_branch_target. Opcodes that are still unimplemented stay in one explicit arm and still signal "Error in CCL program". The new tests run GNU ccl-compile vectors: r0 selects "A", an out-of-range or negative register writes nothing, a later register selects "B", and read-branch covers both blocks, the extra slot, EOF, and suspend. Verified: cargo test -p neovm-core --offline --lib emacs_core::ccl:: (31 passed). The installed Neomacs binary was not rebuilt. --- .../src/emacs_core/text/ccl/command.rs | 43 +++++ .../neovm-core/src/emacs_core/text/ccl/mod.rs | 149 +++++++++++++----- .../src/emacs_core/text/ccl/tests/mod.rs | 131 +++++++++++++++ 3 files changed, 285 insertions(+), 38 deletions(-) create mode 100644 crates/neovm-core/src/emacs_core/text/ccl/command.rs diff --git a/crates/neovm-core/src/emacs_core/text/ccl/command.rs b/crates/neovm-core/src/emacs_core/text/ccl/command.rs new file mode 100644 index 0000000000..1aa0a3098a --- /dev/null +++ b/crates/neovm-core/src/emacs_core/text/ccl/command.rs @@ -0,0 +1,43 @@ +//! CCL command field. GNU `src/ccl.c` assigns every 5-bit opcode. + +/// One CCL command. Discriminants are the GNU opcode numbers (`code & 0x1F`). +/// +/// The driver matches this enum with no wildcard, so adding a command is a +/// compile error until that command has an execution arm. [`strum::FromRepr`] +/// generates `from_repr`, a safe `const` match from those discriminants. +#[repr(u8)] +#[derive(Clone, Copy, Debug, PartialEq, Eq, strum::FromRepr)] +pub(super) enum CclCommand { + SetRegister = 0x00, + SetShortConst = 0x01, + SetConst = 0x02, + SetArray = 0x03, + Jump = 0x04, + JumpCond = 0x05, + WriteRegisterJump = 0x06, + WriteRegisterReadJump = 0x07, + WriteConstJump = 0x08, + WriteConstReadJump = 0x09, + WriteStringJump = 0x0a, + WriteArrayReadJump = 0x0b, + ReadJump = 0x0c, + Branch = 0x0d, + ReadRegister = 0x0e, + WriteExprConst = 0x0f, + ReadBranch = 0x10, + WriteRegister = 0x11, + WriteExprRegister = 0x12, + Call = 0x13, + WriteConstString = 0x14, + WriteArray = 0x15, + End = 0x16, + ExprSelfConst = 0x17, + ExprSelfReg = 0x18, + SetExprConst = 0x19, + SetExprReg = 0x1a, + JumpCondExprConst = 0x1b, + JumpCondExprReg = 0x1c, + ReadJumpCondExprConst = 0x1d, + ReadJumpCondExprReg = 0x1e, + Extension = 0x1f, +} diff --git a/crates/neovm-core/src/emacs_core/text/ccl/mod.rs b/crates/neovm-core/src/emacs_core/text/ccl/mod.rs index 95ccf6394d..8c283a8a2e 100644 --- a/crates/neovm-core/src/emacs_core/text/ccl/mod.rs +++ b/crates/neovm-core/src/emacs_core/text/ccl/mod.rs @@ -7,9 +7,15 @@ //! - `register-code-conversion-map` — stores named conversion maps and returns stable ids //! - CCL-backed coding systems and `ccl-execute-on-string` share one bounded //! bytecode machine, including resumable register/instruction state. +//! - Each 5-bit opcode decodes to [`command::CclCommand`]. The driver matches +//! that enum exhaustively; commands not yet executed still signal +//! `Error in CCL program`. //! - `ccl-execute` — validates shape and designators while the remaining //! register-only instruction set is implemented incrementally. +mod command; + +use self::command::CclCommand; use super::error::{EvalResult, Flow, signal}; use super::value::*; use crate::emacs_core::SymId; @@ -191,6 +197,31 @@ fn ccl_relative_instruction(instruction: usize, offset: i64) -> Option { usize::try_from(target).ok() } +/// GNU `CCL_Branch` (`src/ccl.c`). `table_head` is the first jump-table word. +/// `length` table entries are followed by one out-of-range entry. Each entry +/// is a raw relative offset from `table_head`, not a packed command. +fn ccl_branch_target( + words: &[i64], + table_head: usize, + length: i64, + selector: i64, + error_at: usize, +) -> Result { + let slot = if (0..length).contains(&selector) { + selector + } else { + length + }; + let slot = usize::try_from(slot).map_err(|_| invalid_ccl_program_at(error_at))?; + let entry = table_head + .checked_add(slot) + .ok_or_else(|| invalid_ccl_program_at(error_at))?; + let offset = *words + .get(entry) + .ok_or_else(|| invalid_ccl_program_at(error_at))?; + ccl_relative_instruction(table_head, offset).ok_or_else(|| invalid_ccl_program_at(error_at)) +} + struct CclExecution { output: Vec, registers: [i64; 8], @@ -238,7 +269,8 @@ fn execute_compiled_ccl_with_state( .ok() .filter(|register| *register < registers.len()) .ok_or_else(|| invalid_ccl_program_at(this_instruction))?; - let command = code & 0x1f; + let command = CclCommand::from_repr((code & 0x1f) as u8) + .ok_or_else(|| invalid_ccl_program_at(this_instruction))?; let mut read_character = |destination: &mut i64| -> Option { if let Some(value) = input.get(source) { @@ -254,39 +286,32 @@ fn execute_compiled_ccl_with_state( }; match command { - // CCL_SetRegister - 0x00 => registers[register] = registers[other_register], - // CCL_SetShortConst - 0x01 => registers[register] = field1, - // CCL_SetConst - 0x02 => { + CclCommand::SetRegister => registers[register] = registers[other_register], + CclCommand::SetShortConst => registers[register] = field1, + CclCommand::SetConst => { registers[register] = *words .get(instruction) .ok_or_else(|| invalid_ccl_program_at(this_instruction))?; instruction += 1; } - // CCL_Jump - 0x04 => { + CclCommand::Jump => { instruction = ccl_relative_instruction(instruction, field1) .ok_or_else(|| invalid_ccl_program_at(this_instruction))?; } - // CCL_JumpCond - 0x05 if registers[register] == 0 => { + CclCommand::JumpCond if registers[register] == 0 => { instruction = ccl_relative_instruction(instruction, field1) .ok_or_else(|| invalid_ccl_program_at(this_instruction))?; } - 0x05 => {} - // CCL_WriteRegisterJump - 0x06 => { + CclCommand::JumpCond => {} + CclCommand::WriteRegisterJump => { output.push(registers[register]); instruction = ccl_relative_instruction(instruction, field1) .ok_or_else(|| invalid_ccl_program_at(this_instruction))?; } - // CCL_WriteRegisterReadJump. The compiler stores a paired - // CCL_ReadJump word after this fused instruction; GNU skips it - // after a successful read, but resumes at that word when input is - // exhausted in a non-final block. - 0x07 => { + // The compiler stores a paired ReadJump word after this fused + // instruction. GNU skips it after a successful read, but resumes + // at that word when input is exhausted in a non-final block. + CclCommand::WriteRegisterReadJump => { output.push(registers[register]); instruction = instruction .checked_add(1) @@ -306,8 +331,7 @@ fn execute_compiled_ccl_with_state( } } } - // CCL_WriteConstJump - 0x08 => { + CclCommand::WriteConstJump => { output.push( *words .get(instruction) @@ -316,8 +340,7 @@ fn execute_compiled_ccl_with_state( instruction = ccl_relative_instruction(instruction, field1) .ok_or_else(|| invalid_ccl_program_at(this_instruction))?; } - // CCL_ReadJump - 0x0c => match read_character(&mut registers[register]) { + CclCommand::ReadJump => match read_character(&mut registers[register]) { Some(true) => instruction = eof_instruction, Some(false) => { instruction = ccl_relative_instruction(instruction, field1) @@ -331,9 +354,43 @@ fn execute_compiled_ccl_with_state( }); } }, - // CCL_ReadRegister. Consecutive encoded operands read into one or - // more registers; a zero field terminates the sequence. - 0x0e => { + // `instruction` already points at the jump table. GNU indexes that + // table by the register, or by `field1` when the register is + // outside `0..field1`. + CclCommand::Branch => { + instruction = ccl_branch_target( + &words, + instruction, + field1, + registers[register], + this_instruction, + )?; + } + // GNU reads one character, then falls through into CCL_Branch. + // EOF skips the table and runs the eof program. A suspended read + // resumes on this same word. + CclCommand::ReadBranch => match read_character(&mut registers[register]) { + Some(true) => instruction = eof_instruction, + Some(false) => { + instruction = ccl_branch_target( + &words, + instruction, + field1, + registers[register], + this_instruction, + )?; + } + None => { + return Ok(CclExecution { + output, + registers, + instruction: this_instruction, + }); + } + }, + // Consecutive encoded operands read into one or more registers; a + // zero field terminates the sequence. + CclCommand::ReadRegister => { let mut read_field = field1; let mut read_register = register; loop { @@ -365,8 +422,7 @@ fn execute_compiled_ccl_with_state( .ok_or_else(|| invalid_ccl_program_at(this_instruction))?; } } - // CCL_WriteRegister - 0x11 => { + CclCommand::WriteRegister => { let mut write_field = field1; let mut write_register = register; loop { @@ -385,12 +441,11 @@ fn execute_compiled_ccl_with_state( .ok_or_else(|| invalid_ccl_program_at(this_instruction))?; } } - // CCL_WriteConstString. A zero register field embeds one - // character directly in FIELD1. A nonzero field stores an ASCII - // string three octets per following word, most-significant octet - // first (the representation emitted by GNU `ccl-embed-string`). - 0x14 if register == 0 => output.push(field1), - 0x14 => { + // A zero register field embeds one character directly in FIELD1. + // A nonzero field stores an ASCII string three octets per following + // word, most-significant octet first (GNU `ccl-embed-string`). + CclCommand::WriteConstString if register == 0 => output.push(field1), + CclCommand::WriteConstString => { let length = usize::try_from(field1) .ok() .ok_or_else(|| invalid_ccl_program_at(this_instruction))?; @@ -408,16 +463,34 @@ fn execute_compiled_ccl_with_state( } instruction = end; } - // CCL_End. GNU leaves IC pointing at the End instruction so a - // completed STATUS cannot accidentally resume beyond the vector. - 0x16 => { + // GNU leaves IC pointing at the End instruction so a completed + // STATUS cannot accidentally resume beyond the vector. + CclCommand::End => { return Ok(CclExecution { output, registers, instruction: this_instruction, }); } - _ => return Err(invalid_ccl_program_at(this_instruction)), + CclCommand::SetArray + | CclCommand::WriteConstReadJump + | CclCommand::WriteStringJump + | CclCommand::WriteArrayReadJump + | CclCommand::WriteExprConst + | CclCommand::WriteExprRegister + | CclCommand::Call + | CclCommand::WriteArray + | CclCommand::ExprSelfConst + | CclCommand::ExprSelfReg + | CclCommand::SetExprConst + | CclCommand::SetExprReg + | CclCommand::JumpCondExprConst + | CclCommand::JumpCondExprReg + | CclCommand::ReadJumpCondExprConst + | CclCommand::ReadJumpCondExprReg + | CclCommand::Extension => { + return Err(invalid_ccl_program_at(this_instruction)); + } } } diff --git a/crates/neovm-core/src/emacs_core/text/ccl/tests/mod.rs b/crates/neovm-core/src/emacs_core/text/ccl/tests/mod.rs index 00973bc2e2..6ec8ae3730 100644 --- a/crates/neovm-core/src/emacs_core/text/ccl/tests/mod.rs +++ b/crates/neovm-core/src/emacs_core/text/ccl/tests/mod.rs @@ -526,6 +526,137 @@ fn ccl_execute_on_string_resumes_identity_program_from_status_instruction() { assert_eq!(status.as_vector_data().unwrap()[8], Value::fixnum(5)); } +fn execute_ccl_on_string( + words: &[i64], + registers: [i64; 8], + input: &[u8], + last_block: bool, +) -> (Vec, Vec) { + let program = Value::vector(words.iter().copied().map(Value::fixnum).collect()); + let mut status_slots = registers.map(Value::fixnum).to_vec(); + status_slots.push(Value::NIL); + let status = Value::vector(status_slots); + let output = builtin_ccl_execute_on_string_impl(vec![ + program, + status, + Value::heap_string(crate::heap_types::LispString::from_unibyte(input.to_vec())), + Value::bool_val(!last_block), + Value::T, + ]) + .expect("CCL program should execute"); + let bytes = output.as_lisp_string().unwrap().as_bytes().to_vec(); + assert!(!output.as_lisp_string().unwrap().is_multibyte()); + let status = status.as_vector_data().unwrap().to_vec(); + (bytes, status) +} + +#[test] +fn ccl_execute_on_string_runs_branch_to_the_selected_block() { + crate::test_utils::init_test_tracing(); + // GNU Emacs `ccl-compile` of (1 ((branch r0 (write "A")))), then + // `ccl-execute-on-string` with a zeroed status vector and an empty input. + // r0 is 0, so the jump table selects the block that writes "A" and leaves + // the instruction counter on the trailing End word. + let program = Value::vector( + [1, 7, 269, 2, 4, 308, 4_259_840, 22] + .into_iter() + .map(Value::fixnum) + .collect(), + ); + let status = Value::vector(vec![Value::NIL; 9]); + let output = builtin_ccl_execute_on_string_impl(vec![ + program, + status, + Value::heap_string(crate::heap_types::LispString::from_unibyte(Vec::new())), + Value::NIL, + Value::T, + ]) + .expect("branch on r0 selects the write block"); + assert_eq!(output.as_lisp_string().unwrap().as_bytes(), b"A"); + assert!(!output.as_lisp_string().unwrap().is_multibyte()); + assert_eq!( + status.as_vector_data().unwrap().as_slice(), + &[ + Value::fixnum(0), + Value::fixnum(0), + Value::fixnum(0), + Value::fixnum(0), + Value::fixnum(0), + Value::fixnum(0), + Value::fixnum(0), + Value::fixnum(0), + Value::fixnum(7), + ] + ); +} + +#[test] +fn ccl_execute_on_string_branch_uses_the_out_of_range_slot() { + crate::test_utils::init_test_tracing(); + // Same GNU program as the r0 == 0 case. Register 1 and -1 both take the + // extra jump-table slot, which lands on End and writes nothing. + let program = [1, 7, 269, 2, 4, 308, 4_259_840, 22]; + for selector in [1, -1] { + let mut registers = [0; 8]; + registers[0] = selector; + let (output, status) = execute_ccl_on_string(&program, registers, b"", true); + assert_eq!(output, b""); + assert_eq!(status[0], Value::fixnum(selector)); + assert_eq!(status[8], Value::fixnum(7)); + } +} + +#[test] +fn ccl_execute_on_string_branch_selects_a_later_register_block() { + crate::test_utils::init_test_tracing(); + // GNU `ccl-compile` of (1 ((branch r1 (write "A") (write "B")))) with r1 = 1. + let mut registers = [0; 8]; + registers[1] = 1; + let (output, status) = execute_ccl_on_string( + &[1, 11, 557, 3, 6, 8, 308, 4_259_840, 516, 308, 4_325_376, 22], + registers, + b"", + true, + ); + assert_eq!(output, b"B"); + assert_eq!(status[1], Value::fixnum(1)); + assert_eq!(status[8], Value::fixnum(11)); +} + +#[test] +fn ccl_execute_on_string_read_branch_selects_from_the_input_byte() { + crate::test_utils::init_test_tracing(); + // GNU `ccl-compile` of (1 ((read-branch r0 (write "A") (write "B")))). + // Byte 0 selects "A", byte 1 selects "B", byte 2 takes the out-of-range + // slot. An empty final block stores EOF in r0 and skips the table. An + // empty non-final block suspends on the ReadBranch word itself. + let program = [1, 11, 528, 3, 6, 8, 308, 4_259_840, 516, 308, 4_325_376, 22]; + let (zero, status) = execute_ccl_on_string(&program, [0; 8], &[0], true); + assert_eq!(zero, b"A"); + assert_eq!(status[0], Value::fixnum(0)); + assert_eq!(status[8], Value::fixnum(11)); + + let (one, status) = execute_ccl_on_string(&program, [0; 8], &[1], true); + assert_eq!(one, b"B"); + assert_eq!(status[0], Value::fixnum(1)); + assert_eq!(status[8], Value::fixnum(11)); + + let (two, status) = execute_ccl_on_string(&program, [0; 8], &[2], true); + assert_eq!(two, b""); + assert_eq!(status[0], Value::fixnum(2)); + assert_eq!(status[8], Value::fixnum(11)); + + let (eof, status) = execute_ccl_on_string(&program, [0; 8], b"", true); + assert_eq!(eof, b""); + assert_eq!(status[0], Value::fixnum(-1)); + assert_eq!(status[8], Value::fixnum(11)); + + let (suspended, status) = execute_ccl_on_string(&program, [0; 8], b"", false); + assert_eq!(suspended, b""); + assert_eq!(status[0], Value::fixnum(0)); + assert_eq!(status[8], Value::fixnum(2)); +} + #[test] fn ccl_execute_on_string_runs_packed_constant_string_in_eof_block() { crate::test_utils::init_test_tracing();