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();