path: root/awk/scheme/scheme/bin/vm.awk

#!/usr/bin/awk -f

# VM State Initialization
BEGIN {
    # Type tags
    T_NUMBER = "N"
    T_BOOLEAN = "B"
    T_SYMBOL = "S"
    T_PAIR = "P"
    T_FUNCTION = "F"
    T_NIL = "NIL"

    # VM registers
    stack_ptr = 0    # Stack pointer
    heap_ptr = 0     # Heap pointer
    pc = 0           # Program counter
    
    # Debug mode
    DEBUG = 0
}

# Debug output function
function debug(msg) {
    if (DEBUG) {
        printf("[DEBUG] %s\n", msg) > "/dev/stderr"
    }
}

# Value construction and access
function makeValue(type, val) {
    return type ":" val
}

function getType(val) {
    return substr(val, 1, index(val, ":") - 1)
}

function getValue(val) {
    return substr(val, index(val, ":") + 1)
}

# Type checking
function isNumber(val) { return getType(val) == T_NUMBER }
function isBoolean(val) { return getType(val) == T_BOOLEAN }
function isSymbol(val) { return getType(val) == T_SYMBOL }
function isPair(val) { return getType(val) == T_PAIR }
function isFunction(val) { return getType(val) == T_FUNCTION }
function isNil(val) { return getType(val) == T_NIL }

# Stack operations
function push(val) {
    stack[++stack_ptr] = val
    debug("Push: " val " (SP: " stack_ptr ")")
}

function pop() {
    if (stack_ptr < 1) error("Stack underflow")
    val = stack[stack_ptr--]
    debug("Pop: " val " (SP: " stack_ptr ")")
    return val
}

function peek() {
    if (stack_ptr < 1) error("Stack empty")
    return stack[stack_ptr]
}

# Heap operations
function allocate(val) {
    heap[++heap_ptr] = val
    refs[heap_ptr] = 1
    debug("Allocate: " val " at " heap_ptr)
    return heap_ptr
}

function getHeap(idx) {
    if (!(idx in heap)) {
        error("Invalid heap access: " idx)
        return ""
    }
    return heap[idx]
}

# Error handling
function error(msg) {
    print "Error at PC " pc ": " msg > "/dev/stderr"
    exit 1
}

# Arithmetic operations
function vm_add() {
    if (stack_ptr < 2) error("ADD requires two operands")
    val2 = pop()
    val1 = pop()
    if (!isNumber(val1) || !isNumber(val2)) 
        error("ADD requires numeric operands")
    result = getValue(val1) + getValue(val2)
    push(makeValue(T_NUMBER, result))
}

function vm_subtract() {
    if (stack_ptr < 2) error("SUB requires two operands")
    val2 = pop()
    val1 = pop()
    if (!isNumber(val1) || !isNumber(val2))
        error("SUB requires numeric operands")
    result = getValue(val1) - getValue(val2)
    push(makeValue(T_NUMBER, result))
}

function vm_multiply() {
    if (stack_ptr < 2) error("MUL requires two operands")
    val2 = pop()
    val1 = pop()
    if (!isNumber(val1) || !isNumber(val2))
        error("MUL requires numeric operands")
    result = getValue(val1) * getValue(val2)
    push(makeValue(T_NUMBER, result))
}

function vm_divide() {
    if (stack_ptr < 2) error("DIV requires two operands")
    val2 = pop()
    val1 = pop()
    if (!isNumber(val1) || !isNumber(val2))
        error("DIV requires numeric operands")
    if (getValue(val2) == 0)
        error("Division by zero")
    result = getValue(val1) / getValue(val2)
    push(makeValue(T_NUMBER, result))
}

# List operations
function vm_cons() {
    if (stack_ptr < 2) error("CONS requires two operands")
    val2 = pop()
    val1 = pop()
    pair_val = val1 "," val2
    pair_idx = allocate(pair_val)
    push(makeValue(T_PAIR, pair_idx))
}

function vm_car() {
    if (stack_ptr < 1) error("CAR requires one operand")
    val = pop()
    if (!isPair(val)) error("CAR requires pair operand")
    pair_idx = getValue(val)
    pair = getHeap(pair_idx)
    car_val = substr(pair, 1, index(pair, ",") - 1)
    push(car_val)
}

function vm_cdr() {
    if (stack_ptr < 1) error("CDR requires one operand")
    val = pop()
    if (!isPair(val)) error("CDR requires pair operand")
    pair_idx = getValue(val)
    pair = getHeap(pair_idx)
    cdr_val = substr(pair, index(pair, ",") + 1)
    push(cdr_val)
}

# Comparison operations
function vm_equal() {
    if (stack_ptr < 2) error("EQ requires two operands")
    val2 = pop()
    val1 = pop()
    result = (val1 == val2) ? "1" : "0"
    push(makeValue(T_BOOLEAN, result))
}

function vm_less_than() {
    if (stack_ptr < 2) error("LT requires two operands")
    val2 = pop()
    val1 = pop()
    if (!isNumber(val1) || !isNumber(val2))
        error("LT requires numeric operands")
    result = (getValue(val1) < getValue(val2)) ? "1" : "0"
    push(makeValue(T_BOOLEAN, result))
}

# Instruction execution
function execute(instr) {
    split(instr, parts, " ")
    op = parts[1]
    debug("Execute: " instr)
    
    if (op == "PUSH_CONST") {
        push(parts[2])
    }
    else if (op == "POP") {
        pop()
    }
    else if (op == "DUP") {
        val = peek()
        push(val)
    }
    else if (op == "SWAP") {
        if (stack_ptr < 2) error("SWAP requires two operands")
        val2 = pop()
        val1 = pop()
        push(val2)
        push(val1)
    }
    else if (op == "ADD") {
        vm_add()
    }
    else if (op == "SUB") {
        vm_subtract()
    }
    else if (op == "MUL") {
        vm_multiply()
    }
    else if (op == "DIV") {
        vm_divide()
    }
    else if (op == "CONS") {
        vm_cons()
    }
    else if (op == "CAR") {
        vm_car()
    }
    else if (op == "CDR") {
        vm_cdr()
    }
    else if (op == "EQ") {
        vm_equal()
    }
    else if (op == "LT") {
        vm_less_than()
    }
    else if (op == "PRINT") {
        if (stack_ptr < 1) error("PRINT requires one operand")
        print peek()
    }
    else if (op == "HALT") {
        if (stack_ptr > 0) {
            print peek()
        }
        exit(0)
    }
    else {
        error("Unknown instruction: " op)
    }
}

# Program loading
{
    # Store each line as an instruction
    program[NR-1] = $0
}

# Program execution
END {
    # Execute program
    while (pc < length(program)) {
        execute(program[pc++])
    }
    
    # Print final result if any and we haven't HALTed
    if (stack_ptr > 0) {
        print peek()
    }
}