(defpackage #:virtual1
    (:use :cl)
  ) 


(in-package #:virtual1)

(defparameter *vmcode*
  #(
    #x54 #x04 #x55 #x01 #x20 #x54 #x05 #x55 #x01 #x20 #x01 #x00 #x05 #xab #x01 #x10
    #x7f #x01 #x15 #x81 #x01 #x20 #x01 #x00 #x04 #xab #x01 #x10 #xab #x00 #xbe #x98
    #x01 #x02 #x81 #x01 #x20 #xab #x00 #xef #xab #x00 #xbe #x98 #x01 #x02 #x81 #x01
    #x20 #x52 #x7f #x00 #x2d #x81 #x01 #x20 #xab #x00 #x4b #x8d #x00 #xab #x00 #x6a
    #x8e #x00 #x98 #x00 #x02 #x55 #x01 #x24 #x11 #x01 #x20 #x56 #x00 #x00 #x56 #x01
    #x08 #x7f #x01 #x00 #x55 #x00 #x69 #x8d #x00 #xab #x00 #xbe #x8e #x00 #x97 #x00
    #x08 #x02 #x00 #x02 #x14 #x01 #x11 #x00 #x51 #xba #x99 #x02 #xb7 #xe1 #x51 #x62
    #x8a #xed #x2a #x6a #x69 #x54 #x00 #x55 #x00 #x99 #x8d #x02 #x8d #x00 #xab #x00
    #xce #x01 #x01 #x02 #x8e #x00 #x8e #x02 #x9a #x02 #x01 #x90 #x01 #x01 #x55 #x00
    #x93 #x9b #x00 #x9c #x02 #x00 #x11 #x00 #x74 #xba #x52 #x7f #x00 #x30 #x95 #x01
    #x20 #x7f #x00 #x47 #x95 #x00 #xaa #x11 #x01 #x20 #x7f #x00 #x3a #x95 #x00 #xba
    #x7f #x00 #x41 #x95 #x01 #x20 #x96 #x00 #x37 #xba #x96 #x00 #x30 #xba #xab #x00
    #x9a #x01 #x02 #x00 #x97 #x02 #x04 #xab #x00 #x9a #x93 #x02 #x00 #xba #x56 #x02
    #x00 #x8d #x01 #x56 #x01 #x08 #x7f #x01 #x00 #x55 #x00 #xec #x90 #x00 #x01 #x8f
    #x00 #x01 #x14 #x01 #x55 #x00 #xd6 #x41 #x02 #x11 #x00 #xd6 #x8e #x01 #xba #x8d
    #x04 #x56 #x01 #x00 #x69 #x54 #x00 #x55 #x01 #x03 #xab #x00 #xce #x93 #x01 #x02
    #x11 #x00 #xf4 #x94 #x01 #x00 #x00 #x00 #x00 #x00 #x00 #x00 #xff #x8e #x04 #xba
    #x56 #x01 #x00 #x1e #x00 #x55 #x01 #x1f #x41 #x01 #x41 #x00 #x11 #x01 #x13 #xba
    #x56 #x02 #x00 #x4c #x56 #x02 #x01 #x4c #x40 #x6c #xdc #x10 #xff #x7f #x00 #x00
  ))
; (format t "len vmcode: ~D" (length *vmcode*))

(defstruct vm
  ;; Entire address space
  (memory (make-hash-table :test #'eql))

  ;; VM bytecode
  (code (make-array 256 :element-type '(unsigned-byte 8)
                          :initial-element 0))

  ;; Next free heap address
  (next-addr #x200)

  ;; Debugging
  (step 0)

  ; halt flag 
  (halt nil)

  )




(defparameter *username* "111111111111100000")
(defparameter *password* "1231-0000000000000000")

(defparameter +base+       #x230)
(defparameter +operand1+   #x00)
(defparameter +operand2+   #x08)
(defparameter +result+     #x10)
(defparameter +pc+         #x18)
(defparameter +username+   #x20)
(defparameter +password+   #x28)
(defparameter +flag+       #x30)
(defparameter +stack+      #x38)
(defparameter +stack-base+ #x300)

(defparameter *opcode-name*
  '(

    ; jumps
    (#x54 . vm-test)
    (#x55 . vm-je)
    (#x81 . vm-jne)
    (#x95 . vm-jl)
    (#x11 . vm-jmp)

    ; mov
    (#x56 . vm-mov-imm)
    (#x01 . vm-mov-mem)
    (#x02 . vm-mov-byte)
    (#x99 . vm-load-qword)

    ; stack
    (#xab . vm-call)
    (#xba . vm-ret)
    (#x8d . vm-push)
    (#x8e . vm-pop)

    ; comparison
    (#x1e . vm-check-null-byte)
    (#x7f . vm-cmp-imm)
    (#x98 . vm-cmp-reg)

    ; string
    (#x52 . vm-load-pwd-byte)
    (#x69 . vm-load-user-byte)

    ; arithmetic
    (#x41 . vm-inc)
    (#x14 . vm-dec)
    (#x93 . vm-add-reg)
    (#x96 . vm-sub-imm)

    ; bitwise
    (#x97 . vm-shl)
    (#x8f . vm-shr)
    (#x90 . vm-test-imm)
    (#x94 . vm-filter-high-bits)
    (#x9a . vm-rol)
    (#x9b . vm-not-byte)
    (#x9c . vm-xor-byte)

    ; halt
    (#x4c . vm-exit)
     ))

; (format t "length:~A~%" (length *vmcode*))
; (dump-memory *vm*)

;;; dispatch loop
(defun dispatch (vm)
  (loop

    ;; 1. Check if halted
    (when (vm-halt vm)
      ;; 2. Exit the loop and return the value at 0x240
      (return (mem-read vm #x240)))

      	;; (when (= (vm-step vm) 3105)
	;;   (format t "setting memory~%")
	;;   (set-mem vm #x10 #x0)
	;;   )

      	(when (= (vm-step vm) 1709)
	  (return))


      	;; (when (= (vm-step vm) 1897)
	;;   (return))

        ;; --- ADD THIS TO PRINT VALUE AT 0x10 ---
	;; (let ((val (mem-ref vm #x0)))
	;;   (format t "~16,'0X~%" val))



    (let* ((pc (mem-ref vm +pc+))
           (opcode (aref (vm-code vm) pc))
	   ;; (param1 (if (< (+ pc 1) (length (vm-code vm)))
	   ;; 	       (aref (vm-code vm) (+ pc 1))
	   ;; 	       :oob))
	   ;; (param2 (if (< (+ pc 2) (length (vm-code vm)))
	   ;; 	       (aref (vm-code vm) (+ pc 2))
	   ;; 	       :oob))
	   (param1 (fetch-code vm 1))
	   (param2 (fetch-code vm 2))
	   (handler (cdr (assoc opcode *opcode-name*))))




      ;; ;; trace
      (format t "[~D] PC=~4,'0X OP=~2,'0X (~A) PARAM1=~X PARAM2=~X~%"
              (vm-step vm)
              pc
              opcode
              handler
	      param1
	      param2
	      )

      ;; dispatch
      (cond
        ;; unknown opcode
        ((null handler)
         (format t "ERROR: unknown opcode 0x~2,'0X at PC=~4,'0X~%"
                 opcode
                 pc)
         (return))



        ;; known opcode but function missing
        ((not (fboundp handler))
         (format t "ERROR: opcode 0x~2,'0X (~A) is not implemented yet~%"
                 opcode
                 handler)
         (return))

        ;; execute
        (t
         (funcall handler vm)))

      (incf (vm-step vm))))
)
;;; helper funcs
(defun mem-read (vm addr)
  (gethash addr (vm-memory vm) 0))

(defun mem-write (vm addr value)
  (setf (gethash addr (vm-memory vm)) value))

(defun mem-ref (vm offset)
  (mem-read vm (+ +base+ offset)))

(defun set-mem (vm offset value)
  (mem-write vm (+ +base+ offset) value))

(defmacro inc-pc (vm n)
  `(incf (gethash (+ +base+ +pc+) (vm-memory ,vm) 0) ,n))

(defun alloc-string (vm string)
  (let ((addr (vm-next-addr vm)))
    ;; store bytes
    (loop for ch across string
          for i from 0
          do (set-mem vm (+ addr i)
                        (char-code ch)))

    ;; null terminator
    (set-mem vm (+ addr (length string)) 0)

    ;; advance heap pointer
    (incf (vm-next-addr vm) (1+ (length string)))

    addr))

;;; nil if out of bounds
;; (defmacro fetch-code (vm offset)
;;   `(let ((addr (+ (mem-ref ,vm +pc+) ,offset)))
;;      (when (< addr (length (vm-code ,vm)))
;;        (aref (vm-code ,vm) addr))))

(defun fetch-code (vm offset)
  (let* ((pc (mem-ref vm +pc+))
         (addr (+ pc offset))
         (code (vm-code vm)))
    (if (and (>= addr 0)
             (< addr (length code)))
        (aref code addr)
        (error "fetch-code OOB: PC=~X OFFSET=~X ADDR=~X"
               pc offset addr))))

(defun dump-memory (vm)
  (let* ((keys (sort (loop for k being the hash-keys of (vm-memory vm)
                           collect k)
                     #'<)))
    (when keys
      (let ((start (* 16 (floor (first keys) 16)))
            (end   (1- (* 16 (ceiling (1+ (car (last keys))) 16)))))
        (loop for base from start to end by 16 do
          ;; address
          (format t "~4,'0X: " base)

          ;; hex bytes
          (loop for i from 0 below 16
                for addr = (+ base i)
                for val = (mem-read vm addr)
                do (format t "~2,'0X " val))

          ;; ascii
          (format t "|")
          (loop for i from 0 below 16
                for addr = (+ base i)
                for val = (mem-read vm addr)
                do (write-char
                    (if (<= 32 val 126)
                        (code-char val)
                        #\.)))
          (format t "|~%"))))))


(defun make-initial-vm (user pwd)
  (let ((vm (make-vm :code *vmcode*)))
    (set-mem vm +operand1+ 0)
    (set-mem vm +operand2+ 0)
    (set-mem vm +result+ 0)
    (set-mem vm +pc+ 0)
    (set-mem vm +flag+ 0)
    (set-mem vm +stack+ +stack-base+)
    (setf (vm-halt vm) nil)
    (setf (vm-step vm) 0)

    (let ((user-addr (alloc-string vm user))
	  (pass-addr (alloc-string vm pwd)))
	;; rdi+0x20 contains pointer to username
	(set-mem vm +username+ user-addr)

	;; rdi+0x28 contains pointer to password
	(set-mem vm +password+ pass-addr))
    vm
  ))

;;; implementation

;pparam (aref (vm-code vm) (mem-ref vm (+ 1 (mem-ref vm +pc+)))))

;;; opcode 0x54

(defun vm-test (vm)
  (let* ((reg   (fetch-code vm 1))
         (value (mem-ref vm (* reg 8)))
         (flags (mem-ref vm +flag+))
         (zero-bit (if (zerop value) 1 0)))

    ;; replace bit 0 only
    (set-mem vm
             +flag+
             (logior (logand flags #xFE)
                     zero-bit))

    (inc-pc vm 2)))

;;; opcode 0x55

(defun vm-je (vm)
  (if (/= 0 (logand (mem-ref vm +flag+) 1))
      (let* ((hi (fetch-code vm 1))
             (lo (fetch-code vm 2))
             (target (logior (ash hi 8) lo)))

      ;; (when (> (vm-step vm) 1800)
      ;; 	(format t "jump taken~%")
      ;; 	)

        (set-mem vm +pc+ target))
      (inc-pc vm 3)
      )
  )

;;; opcode 0x81
(defun vm-jne (vm)
  (if (zerop (logand (mem-ref vm +flag+) 1))
      (let* ((hi (fetch-code vm 1))
             (lo (fetch-code vm 2))
             (target (logior (ash hi 8) lo)))
        (set-mem vm +pc+ target))
      (inc-pc vm 3)))

;;; opcode 0x1

(defun vm-mov-mem (vm)
  (let* ((param1 (fetch-code vm 1))
         (param2 (fetch-code vm 2))
         (offset1 (* param1 8))
         (offset2 (* param2 8)))

    ;(format t "param1=~X param2=~X offset1=~X offset2=~X~%" param1 param2 offset1 offset2)

    (set-mem vm
             offset1
             (mem-ref vm offset2)))

  (inc-pc vm 3))

;;; 0xab
(defun vm-call (vm)
  (let* ((pc (mem-ref vm +pc+))
         (return-addr (+ pc 3))
         (sp (mem-ref vm +stack+))

         (hi (fetch-code vm 1))
         (lo (fetch-code vm 2))
         (target (logior (ash hi 8) lo)))


    ;; push return address
    (decf sp 2)
    (set-mem vm +stack+ sp)
    (set-mem vm sp return-addr)

    ;; absolute jump
    (set-mem vm +pc+ target)))

;;; 0xba ret
(defun vm-ret (vm)
  (let* ((sp (mem-ref vm +stack+))
         (return-addr (mem-ref vm sp)))

    ;; pop stack
    (set-mem vm +stack+ (+ sp 2))

    ;; jump to return address
    (set-mem vm +pc+ return-addr)))


;;; 0x56
(defun vm-mov-imm (vm)
  (let* ((param1  (fetch-code vm 1))
         (imm     (fetch-code vm 2))
         (offset1 (* param1 8)))

    ;; register[param1] = imm
    (set-mem vm offset1 imm))

  (inc-pc vm 3))

;; 0x1e works
(defun vm-check-null-byte (vm)
  (let* ((param (fetch-code vm 1))
         (ptr   (mem-ref vm (* param 8))) ; pointer to string
         (byte  (mem-ref vm ptr))         ; byte at that address
         (is-zero (if (zerop byte) 1 0))
         (flag (mem-ref vm +flag+)))

    ;(format t "param=~X ptr=~X byte=~X (~C)~%" param ptr byte (code-char byte))

    (set-mem vm +flag+
             (logior (logand flag #xfe)
                     is-zero)))

  (inc-pc vm 2))

;;; 0x41
(defun vm-inc (vm)
  (let* ((param (fetch-code vm 1))
         (offset (* param 8)))

    (set-mem vm
             offset
             (1+ (mem-ref vm offset))))

  (inc-pc vm 2))

;;; 0x11
(defun vm-jmp (vm)
  (let* ((hi (fetch-code vm 1))
         (lo (fetch-code vm 2))
         (target (logior (ash hi 8) lo)))

    (set-mem vm +pc+ target)))

;;; 0x7f
;; basically compare if pwd is #x15 (21) chars
;; and user is #x12 (18) chars
;; also check if password starts with digits
(defun vm-cmp-imm (vm)
  (let* ((param (fetch-code vm 1))
         (imm   (fetch-code vm 2))
         (value (mem-ref vm (* param 8)))
         (bits 0))

    ;; bit 0 : equal
    (when (= value imm)
      (setf bits (logior bits 1)))

    ;; bit 1 : less-than
    (when (< value imm)
      (setf bits (logior bits 2)))

    ;; preserve higher flag bits
    (set-mem vm
             +flag+
             (logior (logand (mem-ref vm +flag+) #xfc)
                     bits)))

  (inc-pc vm 3))


;;; 0x52
(defun vm-load-pwd-byte (vm)
  (let* ((ptr (mem-ref vm +password+))   ; stored pointer
         (byte (mem-ref vm ptr)))       ; dereference VM memory

    ;; load into reg0
    (set-mem vm +operand1+ byte)

    ;; post-increment pointer
    (set-mem vm +password+ (1+ ptr)))

  (inc-pc vm 1))

;;; 0x69
(defun vm-load-user-byte (vm)
  (let* ((ptr (mem-ref vm +username+))
         (byte (mem-ref vm ptr)))
    ;; store character into register 0
    (set-mem vm +operand1+ byte)

    ;; advance username pointer
    (set-mem vm +username+ (1+ ptr))

;; (format t "user ptr=~X byte=~X~%" (mem-ref vm +username+) (mem-ref vm (mem-ref vm +username+)))

    )

  (inc-pc vm 1))

;;; 0x95
(defun vm-jl (vm)
  (if (/= 0 (logand (mem-ref vm +flag+) 2))
      (let* ((hi (fetch-code vm 1))
             (lo (fetch-code vm 2))
             (target (logior (ash hi 8) lo)))
        (set-mem vm +pc+ target))
      (inc-pc vm 3)))


;;; 0x96
(defun vm-sub-imm (vm)
 (let* ((param (fetch-code vm 1))
         (imm   (fetch-code vm 2))
	 (addr (* param 8))
         (value (mem-ref vm addr))
         (new-val (- value imm)))

    ;; write back ONLY byte
    (set-mem vm addr new-val)

    (inc-pc vm 3)))

;;; don't go beyond 1 byte size
(defun vm-sub-imm (vm)
  (let* ((reg (fetch-code vm 1))
         (imm (fetch-code vm 2))
         (addr (* reg 8))

         ;; force byte read
         (value (logand #xFF (mem-ref vm addr)))

         ;; byte subtraction with wrap
         (new-val (logand #xFF (- value imm))))

    ;; (format t "reg=~A imm=~A val=~X -> ~X~%"
    ;;         reg imm value new-val)

    ;; write back ONLY byte
    (set-mem vm addr new-val)

    (inc-pc vm 3)))

;;; 0x97
;; it basically shl 01 to 10 at 0x240
(defun vm-shl (vm)
  (let* ((reg (fetch-code vm 1))
         (shift (fetch-code vm 2))
         (addr (* reg 8))
         (val (mem-ref vm addr))
         (res (ash val shift)))

    ;; (format t "reg=~A shift=~A val=~X -> ~X~%" reg shift val res)

    (set-mem vm addr res)
    (inc-pc vm 3)))

(defun vm-shr(vm)
  (let* ((param (fetch-code vm 1))
         (imm   (fetch-code vm 2))
         (addr  (* param 8))
         (value (mem-ref vm addr)))

    (set-mem vm
             addr
             (ash value (- imm))))   ; negative shift = right shift

  (inc-pc vm 3))

(defun vm-shr (vm)
  (let* ((reg   (fetch-code vm 1))
         (count (fetch-code vm 2))
         (addr  (* reg 8))
         (value (logand #xffffffffffffffff
                        (mem-ref vm addr))))

    (set-mem vm
             addr
             (ash value (- count)))

    (inc-pc vm 3)))


;;; 0x4c
(defun vm-exit (vm)
  (format t "=== VM HALT at PC=~X===~%" (mem-ref vm +pc+))
  (setf (vm-halt vm) t)
  )


;;; 0x93
(defun vm-add-reg (vm)
  (let* ((param1 (fetch-code vm 1))
         (param2 (fetch-code vm 2))
         (addr1  (* param1 8))
         (addr2  (* param2 8))
         (val1   (mem-ref vm addr1))
         (val2   (mem-ref vm addr2)))

    (set-mem vm addr1 (+ val1 val2))

    (inc-pc vm 3)))

;;; 0x98
;;; so let's remember this moment, 0x98 basically compares value at 0x238 (i think it's chars we counted in username) with value 0x12 - constructed value from digit-0x30, shl and addition operation and sets flags baased on that
;;; since it's equal, it writes 1 at 0x260 and following jump is not taken to exit because it's 0x1 
(defun vm-cmp-reg (vm)
  (let* ((reg1 (fetch-code vm 1))
         (reg2 (fetch-code vm 2))
         (val1 (mem-ref vm (* reg1 8)))
         (val2 (mem-ref vm (* reg2 8)))
         (flags (mem-ref vm +flag+))
         (newflags 0))

    ;; bit 0 = equal
    (when (= val1 val2)
      (setf newflags 1))

    ;; bit 1 = less-than
    (when (< val1 val2)
      (setf newflags (logior newflags 2)))

    ;; preserve higher bits
    (set-mem vm +flag+
             (logior (logand flags #xFC)
                     newflags)))

  (inc-pc vm 3))


;;; 0x8d
(defun vm-push (vm)
  (let* ((param (fetch-code vm 1))
         (sp (mem-ref vm +stack+))
         (value (mem-ref vm (* param 8))))

    ;; stack grows downward
    (decf sp 8)
    (set-mem vm +stack+ sp)

    ;; push value
    (set-mem vm sp value)


    ;; (format t "push:~X~%" value))

    (inc-pc vm 2)))


;;; 0x90
(defun vm-test-imm (vm)
  (let* ((reg-index (fetch-code vm 1))
         (imm       (fetch-code vm 2))
         (value     (mem-ref vm (* reg-index 8)))
         (flag      (mem-ref vm +flag+))
         (is-zero   (if (zerop (logand value imm)) 1 0)))

    ;; update bit 0 only
    (set-mem vm +flag+
             (logior (logand flag #xFE)
                     is-zero))

    (inc-pc vm 3)))

;;; 0x14
(defun vm-dec (vm)
  (let* ((param (fetch-code vm 1))
         (addr  (* param 8))
         (value (mem-ref vm addr)))
    (set-mem vm addr (1- value)))

  (inc-pc vm 2))


;;; 0x8e
(defun vm-pop (vm)
  (let* ((reg (fetch-code vm 1))
         (sp  (mem-ref vm +stack+))
         (val (mem-ref vm sp)))

    ;; store into register
    (set-mem vm (* reg 8) val)

    ;; advance stack
    (set-mem vm +stack+ (+ sp 8))

    (inc-pc vm 2)))


;;; 0x94

(defun vm-filter-high-bits (vm)
  (let* ((param (fetch-code vm 1))
	 (addr (* param 8))
         (value (mem-ref vm (* param 8)))
         (filtered (logand value #xFF)))


    (set-mem vm addr filtered)

    (inc-pc vm #xA)))


;;; 0x02

;; (defun vm-mov-byte (vm)
;;   (let* ((param1 (fetch-code vm 1))
;; 	 (param2 (fetch-code vm 2))
;; 	 (addr1 (* param1 8))
;; 	 (addr2 (* param2 8))
;; 	 ;(value1 (mem-ref vm addr1))
;; 	 (value2 (mem-ref vm addr2))
;; 	 )

;;     (set-mem vm addr1 value2)
;;     (inc-pc vm 3))
;;   )

;; 64bit value
(defun vm-mov-byte (vm)
  (let* ((param1 (fetch-code vm 1))
         (param2 (fetch-code vm 2))
         (addr1 (* param1 8))
         (addr2 (* param2 8))
         (dst (mem-ref vm addr1))
         (src (mem-ref vm addr2)))
    ;; OR the source into the destination
    ;; This accumulates bytes into the QWORD
    (set-mem vm addr1 (logior dst src))
    (inc-pc vm 3)))

;;; 0x99 -- fix
(defun vm-load-qword (vm)
  (let ((addr (* (fetch-code vm 1) 8))
        (rax 0))

    ;; 8-byte immediate build
    (loop for i from 2 to 9 do
      (let ((byte (fetch-code vm i))) ;; LODSB equivalent
        (setf rax (logior (ash rax 8) byte))))

    (set-mem vm addr rax)


    (format t "qword:~X~%" rax)

    (inc-pc vm #xa)))


;;; 0x9A
;;; helper

(defun rol64 (value count)
  (let* ((count (mod count 64))
         (value (ldb (byte 64 0) value)))
    (ldb (byte 64 0)
         (logior (ash value count)
                 (ash value (- count 64))))))



; (rol64 #xAABBCC0000000000 8)

(defun vm-rol (vm)
  (let* ((dst  (* (fetch-code vm 1) 8))
         (src  (* (fetch-code vm 2) 8))
         (value (mem-ref vm dst))
         ;; MOV CL,[R9] → only low byte matters
         (count (logand (mem-ref vm src) #xFF)))

    (set-mem vm dst (rol64 value count))

    ;; (format t "rolled ~X by ~A~%" value count)

    (inc-pc vm #x3)))


;;; 0x9b
(defun vm-not-byte (vm)
  (let* ((addr (* (fetch-code vm 1) 8))
         (value (mem-ref vm addr))
         (low-byte (logand value #xFF))
         (new-low-byte (logxor low-byte #xFF))
         (new-value (logior (logand value #xFFFFFFFFFFFFFF00)
                            new-low-byte)))

    (set-mem vm addr new-value)


    (inc-pc vm #x2)))

;;; 0x9c
(defun vm-xor-byte (vm)
  (let* ((dst-addr (* (fetch-code vm 1) 8))
         (src-addr (* (fetch-code vm 2) 8))
         (dst-value (mem-ref vm dst-addr))
         (src-value (mem-ref vm src-addr))

         ;; low bytes
         (dst-byte (logand dst-value #xFF))
         (src-byte (logand src-value #xFF))

         ;; XOR result
         (new-byte (logxor dst-byte src-byte))

         ;; preserve upper 56 bits of destination
         (new-value (logior (logand dst-value #xFFFFFFFFFFFFFF00)
                            new-byte)))

    (set-mem vm dst-addr new-value)


    ;; (format t "xor:~X~%" (mem-ref vm #x10))

    (inc-pc vm #x3)))

;;; run program
(defparameter *vm*
  (make-initial-vm *username* *password*))


(dispatch *vm*)

;(dump-memory *vm*)


; (setf (vm-halt *vm*) t)
; (setf (vm-halt *vm*) nil)


;;; [1473] PC=0032 OP=7F (VM-CMP-IMM) PARAM1=0 PARAM2=2D - check for '-' as 4th char
;;; 1442 0x94 filter
;;; 1508 0x02 check char '-'
;;; 1747 0x99 load qword - magic values
;;; 1818 0x9A 
 ;;; it rols 0x6a (previously loaded with lodsb) with 0x3 => 0x55

;;; 54e04b50ebe1d22a at third 0x98 compare with 0x230 - which is 000000

;;; trace 0x98 opcode, thats where the main comparisation happen



;; (trace vm-ret  :break t)
;; (untrace vm-ret)

;; (trace dispatch)
;; (untrace dispatch)
;; (untrace vm-mov-mem)

;; (trace vm-mov-mem :break t)


;; (vm-check-null-byte *vm*)
;; (vm-inc *vm*)


;; (defparameter *param* (mem-ref *vm* (* 0 8)))
;; (zerop (mem-ref *vm* #x213))
;; (set-mem *vm* 531 61)

;; (mem-read *vm* #x443)



;; (mem-read *vm* #x20)
;; (mem-read *vm* 32)
;; (mem-ref *vm* 32)
;; (code-char (mem-read *vm* (mem-read *vm* +username+)))

;; (mem-ref *vm* +pc+)

;; (mem-ref *vm* +flag+)




;; (logand 5 1)
;; (logand #b1000 #b1011)
;; ;; => #b1001
;; (mem-ref *vm* +flag+) 
;; (aref (vm-code *vm*) #x4)

;; (defparameter hi (aref (vm-code *vm*) #x2))
;; (defparameter lo (aref (vm-code *vm*) #x3))

;; (set-mem *vm* +flag+ #x1)
;; (logior (ash hi 8) lo)

;; (logand (mem-ref *vm* (* 4 8)) 1)

;; (vm-test *vm* 4)

;; (defparameter *value* (mem-ref *vm* (* 4 8)))

;;     (set-mem *vm*
;;              +flag+
;;              (if (zerop *value*) 0 1))


;; (mem-ref *vm* (mem-ref *vm* offset1))

;; (format t "~X~%" (mem-ref *vm* #x28))

;;;;;;;;;;; rules ;;;;;;;;;;;;;;;;;;


;;; 1. password length is hardcoded to 21 as shown in step 110. Value 0x15 is loaded from optable. Allowed characters are digits and hex values A-F

;;; 2. username length is determined by first two digits of password
;;; username length = ((1st digit - 0x30) << 4)) + (2nd digit - 0x30)
;;; check step 219, 220, 229, 231, 233 (final check)
;;; example:
;;; if pwd first two digits are '12' then length of username must be 0x12
;;; if pwd first two digits are '18' then length of username must be 0x18

;;; 3. the third password digit is used to construct a byte. First nibble = third pwd digit, and second nibble = first pwd digit - big endian. Then this new byte is compared to ascii representation of first pwd digit 
;; example: if the first password digit is '1' (0x31) and the third digit is '3', the constructed byte is 0x31. Since this matches the ascii value of '1' (0x31), the check passes.
;; check step 1457, 1468, 1470

;;; 4. fourth password digit represent ascii value that contains count of all username 1 bits
;;; step: 1473 

;;; 5. fifth pwd char must be 'dash', step 1473

;; 6. the rest of chars must be valid hex num

;; 6th pwd char check starts at step 1483
;; 7th pwd char check starts at step 1495
;; 8th pwd char check starts at step 1516
;; 9th pwd char checks starts at step 1528
;; 10th pwd char check starts at step 1549
;; 11th pwd char check starts at step 1561
;; 12th pwd char check starts at step 1583
;; 13th pwd char check starts at step 1594
;; 14th pwd char check starts at step 1615
;; 15th pwd char check starts at step 1627
;; 16th pwd char check starts at step 1648
;; 17th pwd char check starts at step 1660
;; 18th pwd char check starts at step 1681
;; 19th pwd char check starts at step 1693
;; 20th pwd char check starts at step 1714
;; 21th pwd char check starts at step 1726

;; all password 8 digits are used to form little endian value in their numeric representation, not ascii, so if password 1231-1234567890120001, 1234567890120001 will be formed and pushed as signle 64 bit value in little endian

;;; 7. username checks
;;; 1747 load magic quad word values b7e151628aed2a6a
;;; 1748 load user byte and perform operations on it to 1824
;;; 1748 loads first byte of username
;;; 1749 tests if first byte 0x31 is zero and sets flags - it's not
;;; 1750 doesn't take jump
;;; 1751 pushes magic value b7e151628aed2a6a @ 0x240 to stack
;;; 1752 pushes magic value 31 @ 0x230 to stack
;;; 1753 call
;;; 1754 zeroes at 0x240 
;;; 1755 push 0 to stack
;;; 1756 sets 0x8 at 0x238 - counter per byte
;;; 1757 check if counter is zero at 0x238
;;; 1758 jump not taken
;;; 1759 test 0x31 at 0x230 with 1
;;; 1760 shl 0x31 at 0x230 to 0x18
;;; 1761 decrease counter
;;; 1762 jump not taken
;;; 1763 count digit and increase counter at 0x240
;;; 1764 jmp
;;; 1765 compare counter 0x7 with 0
;;; 1766 jump not taken
;;; 1767 test bit if it's 1 or 0 
;;; 1768 shr to 0xc
;;; 1769 decrease counter
;;; 1770 jump taken
;;; ...
;;; 1813 pop 0x3 bits counted at 0x240
;;;      set's counter to 0x0 at 0x238
;;; 1814 ret
;;; 1815 store 0x3 (count of 1 bits) from 0x240 to 0x238
;;; 1816 pop 31 from stack to 0x230
;;; 1817 pop magic values b7e151628aed2a6a at 0x240
;;; 1818 load number of bits 0x3 from 0x238 in cl and rol magic value, 3 at 0x240 - b7e151628aed2a6a (big endian representation) => 55 53 69 57 14 8B 0A BF (little endian) - sorry for not converting it
;;; 1819 test roled magic value with 1 bit - if it is not byte it othwerwise dont
;;; 1820 jump not taken
;;; 1821 not byte 0x31 => 0xce at 0x230
;;; 1822 xor byte value 55 53 69 57 14 8B 0A BF with 0xce => 9B 53 69 57 14 8B 0A BF (little endian)
;;; 1823 jump
;;;;;;;;;;;;;; 1824 - load 2nd username char
;;;...
;;; magic value, ce byte pushed on stack
;;;...
;;;  magic value 9B 53 69 57 14 8B 0A BF is roled with 0x3 (number of bits) => DD 9C 4A BB A2 58 54 F8 (little endian)
;;; not byte 0x31 => 0xce
;;; xor magic lowest byte DD 9C 4A BB A2 58 54 F8 with 0xce => 13 9C 4A BB A2 58 54 F8
;;; it goes all the way till 3106 opcode 0x98
;;; then value 54e04b50ebe1d22a is compared to 0x230 which is formed from last 8 characters of password 
;;; so value at 0x240 must be 0

;;; at the if the key is correct 0x1 value is stored at 0x240 or 0x0 if not correct

;;;;;;;;;;;;;;;;;;;;; generator


(defun is-valid-pwd()
  (= (mem-ref *vm* #x10) 1))

(is-valid-pwd)



;;; dbger: 2A D2 E1 EB 50 4B E0 54

;; ;; Execute the search
;; (format t "Found username: ~A~%" (find-username #x54e04b50ebe1d22a 18))
;; (format t "Found username: ~A~%" (find-username #xb7e151628aed2a6a 18))


;(logxor #x31 #xFF)
;(ror64  #xb7e151628aed2a6a  4)

;(dispatch (make-initial-vm "7777777777" "0A32-0000000000000000"))
;(dispatch (make-initial-vm "11111111110000000000" "2032-0000000000000000"))

;:; vm:  54E04B50EBE1D22A 54E04B50EBE1D22A

;;; run program
(defparameter *vm*
  (make-initial-vm "111111111111100000" "1231-1101111011111111"))


(dispatch *vm*)
;(dump-memory *vm*)


;; Strict 64-bit NOT
(defun lognot64 (x)
  (logand (lognot x) #xFFFFFFFFFFFFFFFF))

(defun ror64 (value count)
  "Rotate Right 64-bit safely."
  (let ((count (mod count 64)))
    (logior (ldb (byte 64 0) (ash value (- count)))
            (ldb (byte 64 0) (ash value (- 64 count))))))

(defun byte-not (b)
  (logand (lognot b) #xFF))

(defun get-length-from-prefix (d1 d2)
  (+ (ash (- (char-code d1) #x30) 4)
     (- (char-code d2) #x30)))


(defun crackhash (state ch)
  (let* ((val (char-code ch))
         (popcnt (logcount val))
         (rotated (rol64 state popcnt))
	 (param (if (oddp popcnt)
			   (byte-not val) ;; use only 8bit
			   val)))

	 (logxor rotated param)))

(defun crackhash (state ch)
  (let* ((val     (char-code ch))
         (popcnt  (logcount val))
         (rotated (rol64 state popcnt))
         (param   (if (oddp popcnt)
                      (byte-not val) ; only 8 bits
                      val))
         (result  (logxor rotated param)))

    (format t "~A pop=~D rot=~16,'0X param=~2,'0X result=~16,'0X~%" ch popcnt rotated param result)

    result))


;; (format t "~X~%" (reduce #'crackhash "111111111111100000" :initial-value #xB7E151628AED2A6A))
;; (format t "~X~%" (reduce #'crackhash "28616C495F1C7FE1C8" :initial-value #xB7E151628AED2A6A))
;; (format t "~X~%" (reduce #'crackhash "08A7C0343BF1C7EE63" :initial-value #xB7E151628AED2A6A))


;; (format t "~X~%" (reduce #'crackhash "123" :initial-value #xB7E151628AED2A6A))

;; (format t "~X~%" (reduce #'crackhash "28616C495F1C7FE1C8" :initial-value #xB7E151628AED2A6A))
;; ; 3524924924C7F0

;; (format t "~X~%" (reduce #'crackhash "AB5E71A156A4617C11F46" :initial-value #xB7E151628AED2A6A))



;; (format t "~X~%" (reduce #'crackhash "B7E151628AED2A6A" :initial-value #xB7E151628AED2A6A))

;; (rol64 #xB7E151628AED2A6A 3) ;;; => 0xBF0A8B1457695355
;; (rol64 #xBF0A8B1457695355 3) ;;; => 0xF85458A2BB4A9AAD (F85458A2BB4A9CDD)
;; (rol64 #xC2A2C515DA54E09F 3) ;;; => 0x151628AED2A704FE (151628AED2A7028E)
;; (rol64 #xC2A2C515DA54E09F 3) ;;; => 0x151628AED2A704FE (151628AED2A7028E)

;; ;;; F85458A2BB4A9AAD


;; (format t "~X~%" (crackhash #xB7E151628AED2A6A #\1))
;; (format t "~X~%" (crackhash #x76953812D43AF87B #\0))



;(dispatch (make-initial-vm "08A7C0343BF1C7EE63" "1231-0000000000000000"))
;(dispatch (make-initial-vm "0" "123-0000000000000000"))
;(dispatch (make-initial-vm "111111111111100000" "1231-0000000000000000"))
;(dispatch (make-initial-vm "111111111111100000" "1231-1234567890120001"))

(defparameter *vm*
  (make-initial-vm "111111111111100000" "1231-54E04B50EBE1D22A"))


(defparameter *vm*
  (make-initial-vm "AB5E71A156A4617C11F46" "153D-5725412856340FE9"))

(format  t "Correct: ~A~%" (dispatch *vm*))


; (dump-memory *vm*)