porth.porth

include "std.porth"

macro PUTD_BUFFER_CAP 32 end
macro MEM_CAPACITY 640000 end
macro SIM_STACK_CAP 1024 end

macro OP_PUSH_INT 0 end
macro OP_PLUS     1 end
macro OP_PRINT    2 end

// struct Op {
//   type: u64,
//   operand: u64,
// }
macro Op.type    nop end
macro Op.operand 8 + end
macro sizeof(Op) 16 end

// Memory Layout
macro putd-buffer mem end
macro sim-stack-count putd-buffer PUTD_BUFFER_CAP + end
macro sim-stack sim-stack-count 8 + end
macro ops-count sim-stack SIM_STACK_CAP 8 * + end
macro ops ops-count 8 + end

macro sim-stack-push // u64 --
  if sim-stack-count @64 SIM_STACK_CAP >= do
    here eputs ": ERROR: data stack overflow in simulation mode\n" eputs 1 exit
  end
  sim-stack sim-stack-count @64 8 * + !64
  sim-stack-count inc64
end

macro sim-stack-pop // -- u64
  if sim-stack-count @64 0 = do
    here eputs ": ERROR: data stack underflow in simulation mode\n" eputs 1 exit
  end
  sim-stack-count dec64
  sim-stack sim-stack-count @64 8 * + @64
end

macro putd // u64 --
  if dup 0 = do
    "0" puts
  else
    putd-buffer PUTD_BUFFER_CAP +
    while over 0 > do
      1 - dup rot
      10 divmod
      rot swap '0' + . swap
    end

    dup
    putd-buffer PUTD_BUFFER_CAP + swap - swap puts
  end
  drop
end

macro push-op // type operand -- 
  ops-count @64 sizeof(Op) * ops +
  dup Op.operand rot swap !64
  Op.type !64
  ops-count inc64
end

macro dump-ops // --
  0 while dup ops-count @64 < do
    // ptr ptr
    dup sizeof(Op) * ops +
    "Type:    " puts dup Op.type @64 print
    "Operand: " puts Op.operand @64 print
    "----------\n" puts
    1 +
  end
  drop
end

// TODO: porth.porth does not run nasm and ld as external commands to finish off the process of compilation
macro compile-ops // --
  "BITS 64\n" puts
  "segment .text\n" puts
  "print:\n" puts
  "    mov     r9, -3689348814741910323\n" puts
  "    sub     rsp, 40\n" puts
  "    mov     BYTE [rsp+31], 10\n" puts
  "    lea     rcx, [rsp+30]\n" puts
  ".L2:\n" puts
  "    mov     rax, rdi\n" puts
  "    lea     r8, [rsp+32]\n" puts
  "    mul     r9\n" puts
  "    mov     rax, rdi\n" puts
  "    sub     r8, rcx\n" puts
  "    shr     rdx, 3\n" puts
  "    lea     rsi, [rdx+rdx*4]\n" puts
  "    add     rsi, rsi\n" puts
  "    sub     rax, rsi\n" puts
  "    add     eax, 48\n" puts
  "    mov     BYTE [rcx], al\n" puts
  "    mov     rax, rdi\n" puts
  "    mov     rdi, rdx\n" puts
  "    mov     rdx, rcx\n" puts
  "    sub     rcx, 1\n" puts
  "    cmp     rax, 9\n" puts
  "    ja      .L2\n" puts
  "    lea     rax, [rsp+32]\n" puts
  "    mov     edi, 1\n" puts
  "    sub     rdx, rax\n" puts
  "    xor     eax, eax\n" puts
  "    lea     rsi, [rsp+32+rdx]\n" puts
  "    mov     rdx, r8\n" puts
  "    mov     rax, 1\n" puts
  "    syscall\n" puts
  "    add     rsp, 40\n" puts
  "    ret\n" puts
  "global _start\n" puts
  "_start:\n" puts
  "    mov [args_ptr], rsp\n" puts

  0 while dup ops-count @64 < do
    dup sizeof(Op) * ops +

    if dup Op.type @64 OP_PUSH_INT = do
       "    ;; -- push int " puts dup Op.operand @64 putd " --\n" puts
       "    mov rax, "       puts dup Op.operand @64 putd "\n" puts
       "    push rax\n"      puts
    else if dup Op.type @64 OP_PLUS = do
       "    ;; -- plus --\n" puts
       "    pop rax\n" puts
       "    pop rbx\n" puts
       "    add rax, rbx\n" puts
       "    push rax\n" puts
    else if dup Op.type @64 OP_PRINT = do
       "    ;; -- print --\n" puts
       "    pop rdi\n" puts
       "    call print\n" puts
    else
       here eputs ": unreachable\n" eputs 1 exit
    end end end // TODO: introduce a better construction to avoid this madness

    drop

    1 +
  end
  drop

  "    mov rax, 60\n" puts
  "    mov rdi, 0\n" puts
  "    syscall\n" puts
  "segment .bss\n" puts
  "args_ptr: resq 1\n" puts
  "mem: resb " puts MEM_CAPACITY putd "\n" puts
end  

macro simulate-ops // --
  0 while dup ops-count @64 < do
    dup sizeof(Op) * ops +

    if dup Op.type @64 OP_PUSH_INT = do
       dup Op.operand @64 sim-stack-push
    else if dup Op.type @64 OP_PLUS = do
       sim-stack-pop
       sim-stack-pop
       +
       sim-stack-push
    else if dup Op.type @64 OP_PRINT = do
       sim-stack-pop print
    else
       here eputs ": unreachable\n" eputs 1 exit
    end end end // TODO: introduce a better construction to avoid this madness

    drop

    1 +
  end
  drop
end  

macro program69 // -- 
  OP_PUSH_INT 34 push-op
  OP_PUSH_INT 35 push-op
  OP_PLUS     0  push-op
  OP_PRINT    0  push-op
end

macro program123 // --
  OP_PUSH_INT 1 push-op
  OP_PRINT    0 push-op
  OP_PUSH_INT 2 push-op
  OP_PRINT    0 push-op
  OP_PUSH_INT 3 push-op
  OP_PRINT    0 push-op
end

macro usage // --
  dup "Usage: porth <SUBCOMMAND>\n" rot fputs
  dup "  SUBCOMMANDS:\n" rot fputs
  dup "    sim              Simulate the program.\n" rot fputs
  dup "    com              Compile the program\n" rot fputs
  dup "    dump             Dump the ops of the program\n" rot fputs
  dup "    help             Print this help to stdout and exit with 0 code\n" rot fputs
  drop
end

macro main // --
  if argc 2 < do
    stderr usage
    "ERROR: subcommand is not provided\n" eputs
    1 exit
  end

  program123

  // TODO: parsing file is not implemented

  1 nth_argv
  if dup "sim"c cstreq do
    simulate-ops
  else if dup "com"c cstreq do
    compile-ops
  else if dup "help"c cstreq do
    stdout usage
    0 exit
  else if dup "dump"c cstreq do
    dump-ops
  else
    stderr usage
    "ERROR: unknown subcommand `" eputs dup cstr-to-pstr eputs "`\n" eputs
    1 exit
  end end end end
  drop
end

main