#lang pisemble
(require (for-syntax syntax/parse racket/stxparam racket/syntax))
(require syntax/parse/define)

(require racket/stxparam)
(require racket/file)
(require racket/string)
(require racket/match)
(require racket/math)
(require threading)
(require "periph.rkt" "stack.rkt" "struct.rkt" "expr.rkt")

(define s-frame-size 256) ; size of all saved registers
(define SYNC_INVALID_EL1t 0)
(define IRQ_INVALID_EL1t 1)
(define FIQ_INVALID_EL1t 2)
(define ERROR_INVALID_EL1t 3)

(define SYNC_INVALID_EL1h 4)
(define IRQ_INVALID_EL1h 5)
(define FIQ_INVALID_EL1h 6)
(define ERROR_INVALID_EL1h 7)

(define SYNC_INVALID_EL0_64 8)
(define IRQ_INVALID_EL0_64 9)
(define FIQ_INVALID_EL0_64 10)
(define ERROR_INVALID_EL0_64 11)

(define SYNC_INVALID_EL0_32 12)
(define IRQ_INVALID_EL0_32 13)
(define FIQ_INVALID_EL0_32 14)
(define ERROR_INVALID_EL0_32 15)

(define SYSTEM_TIMER_IRQ_0 1)
(define SYSTEM_TIMER_IRQ_1 %10)

(define SCTLR_RESERVED
  (bitwise-ior (arithmetic-shift 3 28)
               (arithmetic-shift 3 22)
               (arithmetic-shift 1 20)
               (arithmetic-shift 1 11)))
(define SCTLR_EE_LITTLE_ENDIAN          (arithmetic-shift 0 25))
(define SCTLR_EOE_LITTLE_ENDIAN         (arithmetic-shift 0 24))
(define SCTLR_I_CACHE_DISABLED          (arithmetic-shift 0 12))
(define SCTLR_D_CACHE_DISABLED          (arithmetic-shift 0 2))
(define SCTLR_I_CACHE_ENABLED           (arithmetic-shift 1 12))
(define SCTLR_D_CACHE_ENABLED           (arithmetic-shift 1 2))
(define SCTLR_MMU_DISABLED              (arithmetic-shift 0 0))
(define SCTLR_MMU_ENABLED               (arithmetic-shift 1 0))
(define SCTLR_BP_ENABLED           (arithmetic-shift 1 11))

(define SCTLR_VALUE_MMU_DISABLED  (bitwise-ior SCTLR_RESERVED SCTLR_EE_LITTLE_ENDIAN SCTLR_I_CACHE_DISABLED SCTLR_D_CACHE_DISABLED SCTLR_MMU_DISABLED))
(define SCTLR_VALUE_MMU_DISABLED2  (bitwise-ior SCTLR_RESERVED SCTLR_EE_LITTLE_ENDIAN SCTLR_I_CACHE_ENABLED SCTLR_D_CACHE_DISABLED SCTLR_MMU_DISABLED))
(define SCTLR_VALUE_MMU_ENABLED  (bitwise-ior SCTLR_RESERVED SCTLR_EE_LITTLE_ENDIAN SCTLR_I_CACHE_ENABLED SCTLR_D_CACHE_ENABLED SCTLR_MMU_ENABLED))

; ***************************************
  HCR_EL2 , Hypervisor Configuration Register ( EL2 ) , Page 2487 of AArch64 - Reference - Manual .
; ***************************************

(define HCR_RW            (arithmetic-shift 1 31))
(define HCR_VALUE     HCR_RW)

; ***************************************
  SCR_EL3 , Secure Configuration Register ( EL3 ) , Page 2648 of AArch64 - Reference - Manual .
; ***************************************

(define SCR_RESERVED          (arithmetic-shift 3 4))
(define SCR_RW        (arithmetic-shift 1 10))
(define SCR_NS        (arithmetic-shift 1 0))
(define SCR_VALUE             (bitwise-ior SCR_RESERVED SCR_RW SCR_NS))

; ***************************************
  SPSR_EL3 , Saved Program Status Register ( EL3 ) Page 389 of AArch64 - Reference - Manual .
; ***************************************

(define SPSR_MASK_ALL       (arithmetic-shift 7 6))
(define SPSR_EL1h     (arithmetic-shift 5 0))
(define SPSR_VALUE      (bitwise-ior SPSR_MASK_ALL SPSR_EL1h))

; architectural feature access control register
(define CPACR_EL1_FPEN    (bitwise-ior (arithmetic-shift 1 21) (arithmetic-shift 1 20))) ; // don't trap SIMD/FP registers
(define CPACR_EL1_ZEN     (bitwise-ior (arithmetic-shift 1 17) (arithmetic-shift 1 16))) ;  // don't trap SVE instructions
(define CPACR_EL1_VAL     (bitwise-ior CPACR_EL1_FPEN CPACR_EL1_ZEN))

(define TCR_TG1_4K     (arithmetic-shift 2 30))
(define TCR_T1SZ       (arithmetic-shift (- 64 48) 16))
(define TCR_TG0_4K     (arithmetic-shift 0 14))
(define TCR_T0SZ       (- 64 48))

(define TCR_EL1_VAL    (bitwise-ior TCR_TG1_4K TCR_T1SZ TCR_TG0_4K TCR_T0SZ))

  mmu bits
(define MT_DEVICE_nGnRnE 		$0)
(define MT_NORMAL_NC			$1)
(define MT_DEVICE_nGnRnE_FLAGS		$00)
( define MT_NORMAL_NC_FLAGS  		 $ 44 ) ; no cache
;(define MT_NORMAL_NC_FLAGS  		$A0) ; cacheable!
(define MT_NORMAL_NC_FLAGS  		$40) ; cacheable!
( define MT_NORMAL_NC_FLAGS  		 $ 40 ) ; cacheable !
( define MT_NORMAL_NC_FLAGS  		 $ 33 ) ; cacheable ! normal , outer write - trhough transient , allocate allocate
;(define MT_NORMAL_NC_FLAGS  		$ff) ; cacheable! outer write back transiert
(define MAIR_VALUE			(bitwise-ior (arithmetic-shift MT_DEVICE_nGnRnE_FLAGS (* 8 MT_DEVICE_nGnRnE)) (arithmetic-shift MT_NORMAL_NC_FLAGS (* 8 MT_NORMAL_NC))))

(define TD_VALID                   (arithmetic-shift 1 0))
(define TD_BLOCK                   (arithmetic-shift 0 1))
(define TD_TABLE                   (arithmetic-shift 1 1))
(define TD_ACCESS                  (arithmetic-shift 1 10))
( define              $ 43 )
(define MATTR_NORMAL_NC            $40)
(define MATTR_DEVICE_nGnRnE_INDEX  0)
(define MATTR_NORMAL_NC_INDEX      1)
(define TD_KERNEL_PERMS            (arithmetic-shift 1 54))
(define TD_INNER_SHARABLE          (arithmetic-shift 3 8))

(define TD_KERNEL_TABLE_FLAGS      (bitwise-ior TD_TABLE  TD_VALID))
(define TD_KERNEL_BLOCK_FLAGS      (bitwise-ior TD_ACCESS TD_INNER_SHARABLE TD_KERNEL_PERMS (arithmetic-shift MATTR_NORMAL_NC_INDEX 2) TD_BLOCK TD_VALID))
(define TD_DEVICE_BLOCK_FLAGS      (bitwise-ior TD_ACCESS TD_INNER_SHARABLE TD_KERNEL_PERMS (arithmetic-shift MATTR_DEVICE_nGnRnE_INDEX 2) TD_BLOCK TD_VALID))


(define PAGE_SHIFT 12)
(define TABLE_SHIFT 9)
(define SECTION_SHIFT (+ PAGE_SHIFT  TABLE_SHIFT))
(define PAGE_SIZE (arithmetic-shift 1 PAGE_SHIFT))
(define SECTION_SIZE (arithmetic-shift 1 SECTION_SHIFT))

(define PGD_SHIFT              (+ PAGE_SHIFT (* 3 TABLE_SHIFT)))
(define PUD_SHIFT              (+ PAGE_SHIFT (* 2 TABLE_SHIFT)))
(define PMD_SHIFT              (+ PAGE_SHIFT  TABLE_SHIFT))
(define PUD_ENTRY_MAP_SIZE     (arithmetic-shift 1 PUD_SHIFT))
(define BLOCK_SIZE $40000000)
(define-syntax (kernel-entry stx)
  (syntax-parse stx
    [(_)
     #'{
;        (PUSH x0 x1 x2 x3 x4 x5 x6 x7 x8)

        sub sp sp @s-frame-size
        stp x0 x1   [sp @(* 16 0)]
        stp x2 x3   [sp @(* 16 1)]
        stp x4 x5   [sp @(* 16 2)]
        stp x6 x7   [sp @(* 16 3)]
        stp x8 x9   [sp @(* 16 4)]
        stp x10 x11 [sp @(* 16 5)]
        stp x12 x13 [sp @(* 16 6)]
        stp x14 x15 [sp @(* 16 7)]
        stp x16 x17 [sp @(* 16 8)]
        stp x18 x19 [sp @(* 16 9)]
        stp x20 x21 [sp @(* 16 10)]
        stp x22 x23 [sp @(* 16 11)]
        stp x24 x25 [sp @(* 16 12)]
        stp x27 x27 [sp @(* 16 13)]
        stp x28 x29 [sp @(* 16 14)]
        str x30 [sp @(* 16 15)]

        }]))
(define-syntax (kernel-exit stx)
  (syntax-parse stx
    [(_)
     #'{
        ldp x0 x1   [sp @(* 16 0)]
        ldp x2 x3   [sp @(* 16 1)]
        ldp x4 x5   [sp @(* 16 2)]
        ldp x6 x7   [sp @(* 16 3)]
        ldp x8 x9   [sp @(* 16 4)]
        ldp x10 x11 [sp @(* 16 5)]
        ldp x12 x13 [sp @(* 16 6)]
        ldp x14 x15 [sp @(* 16 7)]
        ldp x16 x17 [sp @(* 16 8)]
        ldp x18 x19 [sp @(* 16 9)]
        ldp x20 x21 [sp @(* 16 10)]
        ldp x22 x23 [sp @(* 16 11)]
        ldp x24 x25 [sp @(* 16 12)]
        ldp x26 x27 [sp @(* 16 13)]
        ldp x28 x29 [sp @(* 16 14)]
        ldr x30 [sp @(* 16 15)]
        add sp sp @s-frame-size
        eret
        }]))

(define-syntax-parser inc [(_ reg:register) #'{ add reg reg @1 }])
(define-syntax-parser dec [(_ reg:register) #'{ sub reg reg @1 }])

(define-syntax (handle-invalid-entry stx)
  (syntax-parse stx
    [(_ type)
     #'{
        mov x0 @type
        mrs x1 esr_el1
        mrs x2 elr_el1
        bl show-invalid-entry-message:
        b err-hang:
        }
     ]))

(define-syntax (wait stx)
  (syntax-parse stx
    [(_ value)
     #'{ldr x2 value
        :inner
        sub x2 x2 @1
        cbnz x2 inner- }]))

(define-syntax (debug-reg stx)
  (syntax-parse stx
    [(_ r:register)
     #'{
  preserve  , it is used for passing char to send - char
        (PUSH x0) 
        (PUSH r)
  first send code indicating whether a 32 or 64 bit number will be sent
        mov w0 @(if `r.is32 2 3)
        bl send-char:
  restore r into  and send first char
        (POP x0)   
        bl  send-char:
  shift and send the remaining 3 or 7 bytes
        (for ([_ (in-range (if `r.is32 3 7))])
          { lsr x0 x0 @8
            bl send-char: })
  restore x0 original value
        (POP x0) }]
    [(_ r:register rn:register ...+)
     #'(begin (debug-reg r)
              (debug-reg rn ...))]))

(define-syntax-parser debug-str-reg
  [(_ str:string reg:register)
   #'{
      (debug-str str #f)
      (debug-reg reg)
     }])

(define-syntax (dump-all-regs stx)
  (syntax-parse stx
    [(_)
     #:with (reg ...) (for/list ([i (in-range 0 31)])
                   (datum->syntax this-syntax (string->symbol (format "X~a"i))))
     #:with (name ...) (for/list ([i (in-range 0 31)])
                   (datum->syntax this-syntax (format "X~a "i)))
     #'(begin (begin (debug-str name #f) (debug-reg reg)) ...)]))


  the vector table is layed out 0x80 bytes apart
(define-syntax (ventry stx)
  (syntax-parse stx
    [(_ vector:label-targ)
     #'{
        /= $80        
        b vector
       }]
    [(_ vector:label-targ more ...+)
     #'{
        /= $80        
        b vector
        (ventry more ...)
       }]))

(define VCORE-MBOX (+ PERIPH-BASE $00B880))

(define-syntax-parser flip-gpio0
  [(_) #'{
          (preserve [x0 x1] {
            ldr x1 flip0:                   
            ;invert value
            mov x0 @1
            eor x1 x1 x0
            ; store new value
            adr x0 flip0:
            str x1 [x0]
            ; set out or clear depending on value
            (/if (x1 eq @0)
              {
               mov x1 @1
               ldr x0 GPIOSET0:
               str w1 [x0]
              }
              {
                mov x1 @1
                ldr x0 GPIOCLEAR0:
                str w1 [x0]
              })
          })                             
          }])

(define-syntax-parser flip-gpio1
  [(_) #'{
          (preserve [x0 x1] {
            ldr x1 flip1:                   
            ;invert value
            mov x0 @1
            eor x1 x1 x0
            ; store new value
            adr x0 flip1:
            str x1 [x0]
            ; set out or clear depending on value
            (/if (x1 eq @0)
              {
               mov x1 @%10
               ldr x0 GPIOSET0:
               str w1 [x0]
              }
              {
                mov x1 @%10
                ldr x0 GPIOCLEAR0:
                str w1 [x0]
              })
          })                             
         }])

  TIMER bits
(define     TIMERBase #x40000000)
(define      timerFrequency 10000000)
(define     crystalFrequency 19200000)
(define     prescaler 
     (quotient
      (+
       (* (arithmetic-shift 1 31) timerFrequency)
       (quotient crystalFrequency 2))
      crystalFrequency))

(aarch64 "kernel8.img" ["2dgfx.obj" "textures.obj" "maps.obj"] {
     width = 320
     height = 200      

     ;mailbox offsets
     mbox-read = $0
     Mbox-poll = $10
     mbox-sender = $14
     mbox-status = $18
     mbox-config = $1c
     mbox-write = $20
     mbox-response = $80000000
     mbox-full     = $80000000
     mbox-empty    = $40000000

Mailbox channels
  request to VC from ARM

     
     ; wolf bits
     TILESHIFT = 16
     TILEGLOBAL = (arithmetic-shift 1 16)
     TILEGLOBAL/2 = (/ TILEGLOBAL 2)
     ANGLES = 360
     FINEANGLES = 3600
     ANGLEQUAD = (/ 360 4)
     VIEWHEIGHT = 160
     VIEWWIDTH = 320
     TEXTUREMASK = 4032
     TEXTUREFROMFIXEDSHIFT = 4
     MINDIST = $5800
     TEXTURESIZE = (arithmetic-shift 1 6)
     ; if cpu zero then goto main:
     mrs x0 mpidr_el1
     mov x1 @$3
     and x0 x0 x1
     cbz x0 main:
     b hang:
 
:err-hang
     b err-hang-    

:hang
     wfe
     b hang-     

:main

    ; Set stack pointer 
    ldr x1 START:
    mov sp x1

      msr      cpacr_el1 ,    Enable FP / SIMD at EL1
    ;(write-value-32 $d5181040)

    ; setup the mini-uart for debug comms
    (init-uart)
    (debug-str "uart up1" #t)

  set  0 and 1 to output
    ldr x0 GPFSEL:
    mov x1 @%001001
    str w1 [x0]

   (debug-str "done!!!" #t)
    
    ; =========== setup timer

  nop
    (load-immediate x1 TIMERBase)
    (load-immediate x0 prescaler)
    str w0 [x1 @$8]
    

    (debug-str "init irq vector" #t)    
  setup IRQ vectors
    bl irq-vector-init:
    ; switch on interrupt conteroller
  for wolf this is the SMI interrupt only at the moment
  which is triggered by the screen vsync signal
    bl enable-interrupt-controller:
  clear the SMICS flag just in case .
    ; we won't enable the interrupts just yet
    ldr x0 SMICS:
    mov x1 @0
    str w1 [x0]

    ; now we are going to ask for a frame buffer
    adr x0 MBOX-MSG:
    (debug-reg w0)
    ldrb w0 (x0 @0)
    (debug-reg w0)
    
    (debug-str "loading level.." #t)
    bl setup-game-level:
    bl scan-info-plane:

    ; calculate costable pointer into sintable
    adr x1 sintable:
    (debug-str-reg "sintable address " x1)
  here we want to do sintable+90 ( 360/4 )    
  but since they are 4 bytes each we can
  simply use 360 since we 'd have to < < 2 anway

    (load-immediate x0 ANGLES)
    add x0 x1 x0
  index 0 seems to be 65537 instead of 65536 ! ? check this
    str x0 [x1]
    (debug-str-reg "costable address " x0)
               
    adr x0 fb:
    ldr w0 [x0]

    adr x8 MBOX-MSG:
    ; send framebuffer request
    bl send-vcore-msg:
    (debug-str "bpl" #t)

    adr x0 bpl:
    ldr w0 (x0 @0)
    (debug-reg x0)

    (debug-str "fb addr" #t)
    adr x0 fb:
    ldr w0 (x0 @0)
    (debug-reg x0)

convert to gpu address
    ldr x1 CONVERT:
    and x0 x0 x1
    (debug-str-reg "fb addr converted" x0)

  X8 holds base video memory
    adr x9 VMEM:
  store memory pointer in VMEM

    (debug-str-reg "vptr is " x8)
enable mmu
    bl init-mmu:
  mrs  

    mov x1 @SCTLR_MMU_ENABLED
    orr x0 x0 x1

    mov x1 @SCTLR_I_CACHE_ENABLED
    orr x0 x0 x1

    mov x1 @SCTLR_D_CACHE_ENABLED
    orr x0 x0 x1


msr  

dsb sy
    (write-value-32 $d5033fdf) ; isb
  mmu done

    ; SPEED TEST CODE

    adr x0 textures-address:
    (debug-str-reg "speed test at " x0)
    adr x1 sizes:
  :mloop2
    ldr w2 [x1] @4
    mov x9 x2
    (debug-str-reg "KB:" x2)
    cbz w2 mpause+

    lsl w2 w2 @3

    bl timer-start:
    mov x3 @256

  :mloop1
    adr x0 textures-address:    
    mov x8 x2
  :mloop3
   [  ]  ; ca n't do this post increase yet
    ldp x4 x5 [x0 @0] 
    add x0 x0 @16
    ldp x4 x5 [x0 @0] 
    add x0 x0 @16
    ldp x4 x5 [x0 @0] 
    add x0 x0 @16
    ldp x4 x5 [x0 @0] 
    add x0 x0 @16
    ldp x4 x5 [x0 @0] 
    add x0 x0 @16
    ldp x4 x5 [x0 @0] 
    add x0 x0 @16
    ldp x4 x5 [x0 @0] 
    add x0 x0 @16
    ldp x4 x5 [x0 @0] 
    add x0 x0 @16
    (write-value-32 $f1000508)
;    sub x8 x8 @1
    b.ne mloop3-
    (write-value-32 $f1000463)
;    sub x3 x3 @1
    b.ne mloop1-

    bl timer-stop:
    udiv x0 x0 x9
    (load-immediate x10 (quotient (* 1024 256 timerFrequency) (* 1024 1024)))
    udiv x0 x10 x0
    (debug-str-reg "MBytes per second " x0)
    b mloop2-
    
    
:mpause nop 
    ; END SPEED TEST

     (debug-str "DONEDONE" #t)


  begin triggering the vsync interrupt
     bl enable-irq:

     mov x1 @0
  130 for 2d pics , 105 for textures
     mov x27 @60

     mov x1 @15
     ;     bl render-pic:
     bl update-gfx:
 :loop
     b loop-


:init-mmu

  4k granule , 4  
(load-immediate x0 $3520)
  msr  

  2 memory attributes for normal cacheable and device memory
(load-immediate x0 $FF440400)
  msr MAIR_EL3 , 

; set translation table base
adr x0 id_pgd:
   msr ttbr0_el3 , 

; Set up translation table entries in memory with looped store instructions.
  Set the level 1 translation table .
  The first entry points to level2_pagetable .
  location 0 points at level 2 which is 4096 later
(load-immediate x3 $1000)
x10 is base level2 address
mov x3 @%11
  11 at end to set flags
str x1 [x0] @8

  AttrIdx=000 Device - nGnRnE.
  The second entry is 1 GB block from 0x40000000 to 0x7FFFFFFF .
  Executable Inner and Outer Shareable .
  R / W at all ELs secure memory

  The third entry is 1 GB block from 0x80000000 to 0xBFFFFFFF .
(load-immediate x2 $80000741)
str x2 [ x0 ] @8

  The fourth entry is 1 GB block from 0xC0000000 to 0xFFFFFFFF .
(load-immediate x2 $C0000741) 
str x2 [ x0 ] @8

  Set level 2 translation table . 512 x 2 mb blocks
mov x0 x10                       ; Base address of level2_pagetable.
  Executable Inner and Outer Shareable .

  R / W at all ELs secure memory .
; AttrIdx=011 Normal Cacheable.

mov x4 @512
(load-immediate x3 $200000)
mov x1 @$c
:loop
  str x2 [x0] @8
  increase 2 mb
  the last 32 mb we mark as device memory since the periphs are here .
  32 mb is too much really but also covers the area where the vcore
  ; gives us a framebuffer
  cmp x4 @$20  
  b.ne doCache+
  @$c - from 74d to 741 which selects the other attribute
:doCache
 (write-value-32 $f1000484) ;; subs
  b.ne loop-

ret x30

(create-send-char)


:dump-regs
  (PUSH x30)
  (dump-all-regs)
  (POP x30)
  ret x30

(define-syntax-parser nibble->hex
  [(_ input:register )
   #'{ ; with an additional register we can remove this
      ; branch by using csel - debug code though so
      ; doesn't matter
      cmp input @10
      b.ge hex+
  add 48 ( 0 - 9 )
      b done+
  :hex
  add 65 ( A - F )
      :done}])

(define-syntax-parser bound-ascii
  [(_ input:register )
   #'{
     cmp input @$20
     b.ge done+
     mov input @$2E  ;; '.'
    :done}])



(subr timer-start () [x0 x1]  {
  (load-immediate x0 TIMERBase)
  ldr w0 [x0 @$1c]
  adr x1 time:
  str w0 [x1]
})  

(subr timer-stop () [x1]  {
  (load-immediate x0 TIMERBase)
  ldr w0 [x0 @$1c] ; time at end
  ldr w1 time:     ;time at start
  sub x0 x0 x1
   ( debug - str - reg " Time = "  )
  })

(define dump-template "0000000000000000 : 00 00 00 00 | 00 00 00 00 | 00 00 00 00 | 00 00 00 00 | 0000000000000000")
(subr memory-dump () [x0 x1 x2 x3 x4 x5 x6 x7 x8] {
  ; arguments 
  ; x0 will be the start address
  x1 will be the amount of rows to send ( * 4 32 bits + ascii )                                 
 ; //////
  ; we are going to write                                            
  00000000000012FF : FF FF FF FF | FF FF FF FF | FF FF FF FF | FF FF FF FF | asciiasciiascii .
  now we can skip ahead four in the output and read the first 32 bit value


  (define (write-byte) {
  top 4 bits first                    
    (nibble->hex x4)  ; convert to ascii hex
    strb w4 [x6] @1   ; modify string with result
  bottom 4 bits
    (nibble->hex x4)  ; convert to ascii hex
    strb w4 [x6] @1   ; modify string with result
    })

  (define (write-byte-raw) {
    (bound-ascii w3)
    strb w3 [x6] @1   ; modify string with result
  })
                                              
  template-len = (string-length dump-template)
  mov x8 x1 ; x8 holds row count down
  (/whilenz x8 {
  first part is to overwrite the address with the requested address
    adr x6 memory-dump-template:
    mov x3 x0           ; address to write
    mov x2 @16          ; loop counter (+1)
    mov x5 @$F          ; because we don't support and x x imm
    (/whilenz x2 {
      lsr x4 x3 @60     ; shift to byte
  mask the 4 bits
      (nibble->hex x4)  ; convert to ascii hex
      strb w4 [x6] @1   ; modify string with result
      lsl x3 x3 @4      ; shift in next nibble
      sub x2 x2 @1      ; 
    })             


    add x6 x6 @3 ; spacer

    mov x7 @4
    (/whilenz x7 {
      ldrb w3 [x0] @1
      (write-byte)
      add x6 x6 @1
      
      ldrb w3 [x0] @1
      (write-byte)
      add x6 x6 @1
      
      ldrb w3 [x0] @1
      (write-byte)
      add x6 x6 @1
      
      ldrb w3 [x0] @1
      (write-byte)
      add x6 x6 @3

      sub x7 x7 @1
    })

    ; now for the ascii version
    sub x0 x0 @16
    mov x7 @16

    (/whilenz x7 {
      ldrb w3 [x0] @1
      (write-byte-raw)    
      sub x7 x7 @1
    })
    
    adr x1 memory-dump-template:
    mov x2 @template-len
    bl send-string:
    sub x8 x8 @1
  })

})
:memory-dump-template (write-ascii dump-template)                  

/= 4
(subr disassemble-dump
      ([address x1]
       [instruction-count w2])
      [x0] {
    ; initiate disassemble send
    mov w0 @4
    bl send-char:
    ; send address         
    mov x0 x1
    bl send-char:
    (for ([_ (in-range 7)])
      { lsr x0 x0 @8
        bl send-char: })
    ; send count    
    mov x0 x2
    bl send-char:
    (for ([_ (in-range 3)])
      { lsr x0 x0 @8
        bl send-char: })
  we do 64 bits at a time
    ; send instructions
    (/whilenz instruction-count {
      ldr x0 [x1] @8
      bl send-char:
      (for ([_ (in-range 7)])
        { lsr x0 x0 @8
          bl send-char: })
      
      sub instruction-count instruction-count @1
    })
})         




/= 4
(subr send-string
      ([address x1]
       [len x2]) [x0] {
  ; initiate string send
  mov w0 @1
  bl send-char:

  (/whilenz len {
    ldrb x0 [address] @1
    bl send-char:
    sub len len @1
  })
  mov w0 @$A ; line feed
  bl  send-char:
   ;; mov w0 @$D ; cr
  ;; bl  send-char:

  ; signal string end
  mov w0 @0
  bl send-char:
})

  ( subr send - string - nullterm
;;       ([address x1]) [x0] {

;;   ; initiate string send
;;   mov w0 @1                       
;;   bl send-char:

    (   {
        [ address ] @1   ;   * address++
;;     bl send-char:
;;   })
    mov w0 @$A ; line feed
      send - char :
;;   ; signal string end
;;   mov w0 @0
;;   bl send-char:
  
;; })

; x0 = address
; x1 = count
  this trashes registers .. so push first !
  ( subr : dump - mem-64
;;       ([x1 address]
;;        [x2 remaining]) [] {
    ; first print the address like so   " $ 00000000 : "
      @(#/'$ )
;;   bl send-char                               
;; })                       

(define-syntax-parser zero-mem
  [(_ base:register size:expr)
   #'(letrec
         ([aux
           (λ (offset rem-size)
             (cond
               [(>= rem-size 8) (begin {str x0 (base @offset)} (aux (+ offset 8) (- rem-size 8)))]
               [(>= rem-size 4) (begin {str w0 (base @offset)} (aux (+ offset 4) (- rem-size 4)))]
               [(>= rem-size 2) (begin {strh w0 (base @offset)} (aux (+ offset 2) (- rem-size 2)))]
               [(>= rem-size 1) (begin {strb w0 (base @offset)} (aux (+ offset 1) (- rem-size 1)))]
               [(= rem-size 0) (void)]
               [else (error (format "FAIL ~a ~a" offset rem-size))]))])
       (begin
         {mov x0 @0}
         (aux 0 size)))])


(/struct _voffset_msg
  ([total-size 4]     ; total buffer size bytes including headers
   [request-code 4]   ; request / response code (0 = request)
   ;begin tags
   [tag-id 4]
   [request-size 4]
   [tag-request-code 4]
   [x-loc 4]         ; virtual x pos
  virtual y pos
   [end-tag 4]))

(/struct _setalpha_msg
  ([total-size 4]     ; total buffer size bytes including headers
   [request-code 4]   ; request / response code (0 = request)
   ;begin tags
   [tag-id 4]
   [request-size 4]
   [tag-request-code 4]
   [alpha-mode 4]         ; alpha mode
   [end-tag 4]))

(define-syntax-parser write-virtual-offset
  [(_ base:register y-loc:register)
note this trashes 
      (zero-mem base (sizeof/_voffset_msg))
      (_voffset_msg/total-size-set (* 8 4) base)
      (_voffset_msg/tag-id-set $48009 base)
      (_voffset_msg/request-size-set 8 base)
      (_voffset_msg/y-loc-set y-loc base)
      }])

(define-syntax-parser write-alpha-mode
  [(_ base:register a-mode:register)
note this trashes 
      (zero-mem base (sizeof/_setalpha_msg))
      (_setalpha_msg/total-size-set (* 7 4) base)
      (_setalpha_msg/tag-id-set $48007 base)
      (_setalpha_msg/request-size-set 4 base)
      (_setalpha_msg/alpha-mode-set a-mode base)
     }])

  virtual " page flip " here we tell the gpu to
; display the off-screen portion of the video memory
; that has been drawn to
; pass y value in x3
(subr page-flip ([ptr x16]) [x0 x1 x2 x16] {
  ; reserve space on stack for v-offset message
  sub sp sp @(sizeof/_voffset_msg)                                          
  (write-virtual-offset sp x3)
  mov x8 sp
  bl send-vcore-msg:
  add sp sp @(sizeof/_voffset_msg)                                          
  })

(subr set-alpha-mode () [x0 x1 x2 x16] {
  ; reserve space on stack for v-offset message
  sub sp sp @(sizeof/_setalpha_msg)
  mov x10 @2                                              
  (write-alpha-mode sp w10)
  mov x8 sp
  bl send-vcore-msg:
  add sp sp @(sizeof/_setalpha_msg)                                          
})

; pass message address in x8
(subr send-vcore-msg ()[x0 x1 x2 x3 x8]{

     mov x0 x8
     ; cache coherency
  dc civac , 
     ldr x0 VC_MBOX: 
:wait      
     ldr w1 (x0 @mbox-status)
  and with 0x8000_0000
     mov x2 @1
     lsl x2 x2 @31
     and x1 x1 x2
     cbnz x1 wait-
     ; attempt to call the mailbox interface
  upper 28 bits are the address of the message
     ; expected to be in x8
     ldr x0 VC_MBOX:
     mov x2 x8
  lower four bits specify the mailbox channel ,
     ; in this case mbox-ch-prop (8)
     mov x3 @mbox-ch-prop
  we do nt support orr reg - reg - imm yet
     ; send our message
     str w2 (x0 @mbox-write)
     ; now wait for a response 
:wait      
    ldr w1 (x0 @mbox-status)
  and with 0x4000_0000
     mov x2 @1
     lsl x2 x2 @30
     and x1 x1 x2
     cbnz x1 wait-
     ; check if mbox-read = channel
     ldr w1 (x0 @mbox-read)
 ;    (debug-reg x1)
     mov x2 @%1111
     and x1 x1 x2
     sub x1 x1 @mbox-ch-prop
     cbnz x1 wait-


     })


:enable-irq
msr daifclr @2
ret x30

:disable-irq
msr daifset @2
ret x30

:show-invalid-entry-message
(debug-str "unhandled exception" #t)
(debug-reg x0 x1 x2)
mov x1 x2
mov x2 @32
bl disassemble-dump:
ret x30

/= $800
:vectors
(ventry
sync_invalid_el1t:
irq_invalid_el1t:
fiq_invalid_el1t:
error_invalid_el1t:
sync_invalid_el1h:
el1_irq:
fiq_invalid_el1h:
error_invalid_el1h:
sync_invalid_el0_64:
irq_invalid_el0_64:
fiq_invalid_el0_64:
error_invalid_el0_64:
sync_invalid_el0_32:
irq_invalid_el0_32:
fiq_invalid_el0_32:
error_invalid_el0_32:
 )

:sync_invalid_el1t
  (handle-invalid-entry  SYNC_INVALID_EL1t)

:irq_invalid_el1t
  (handle-invalid-entry  IRQ_INVALID_EL1t)

:fiq_invalid_el1t
  (handle-invalid-entry  FIQ_INVALID_EL1t)

:error_invalid_el1t
  (handle-invalid-entry  ERROR_INVALID_EL1t)

:sync_invalid_el1h
  (handle-invalid-entry  SYNC_INVALID_EL1h)

:fiq_invalid_el1h
  (handle-invalid-entry  FIQ_INVALID_EL1h)

:error_invalid_el1h
  (handle-invalid-entry  ERROR_INVALID_EL1h)

:sync_invalid_el0_64
  (handle-invalid-entry  SYNC_INVALID_EL0_64)

:irq_invalid_el0_64
  (handle-invalid-entry  IRQ_INVALID_EL0_64)

:fiq_invalid_el0_64
  (handle-invalid-entry  FIQ_INVALID_EL0_64)

:error_invalid_el0_64
  (handle-invalid-entry  ERROR_INVALID_EL0_64)

:sync_invalid_el0_32
  (handle-invalid-entry  SYNC_INVALID_EL0_32)

:irq_invalid_el0_32
  (handle-invalid-entry  IRQ_INVALID_EL0_32)

:fiq_invalid_el0_32
  (handle-invalid-entry  FIQ_INVALID_EL0_32)

:error_invalid_el0_32
  (handle-invalid-entry  ERROR_INVALID_EL0_32)

:el1_irq
  (kernel-entry)
  bl  handle-irq:
  (kernel-exit)

:irq-vector-init
  adr x0 vectors:
msr vbar_el1 x0
   msr  
  ret x30



(subr enable-interrupt-controller () [x0 x1] {
  ; handle interrupts at el3                                            
  mrs x0 scr_el3
  ; Abort / SError     
  mov x1 @%1000
  orr x0 x0 x1
  fiq
  mov x1 @%100
  orr x0 x0 x1
  irq
  mov x1 @%10
  orr x0 x0 x1
  msr scr_el3 x0

  ldr x0 ENABLE_IRQS_2:
  SMI
  str w1 [x0]
})

; returns a pointer to the current "back buffer"
; which is the area of video memory not currently
; being displayed
(subr get-back-buffer () [x1 x2] {
    ldr x0 VMEM:
    mov x1 x0
 now has the base video memory pointer
    ; if CURRENT-PAGE is 0 then we want to send
    ; pointer + ((height / 2) * width)

    ldr x0 CURRENT-PAGE:
    cbz x0 done+
 ;   (debug-str "HERE" #t)
    ldr x2 FRAME-SIZE:
    add x1 x1 x2

  return in 
    mov x0 x1
})

; plots a single pixel 
(subr plot
      ([vptr x0] ; base video memory
       [x x1]
       [y x2]
       [colour w3]) [x0] {

  each pixel is 4 bytes
  x * = 4  
    ldr x4 ROW-SIZE:
    mul y y x4
    add vptr vptr x
    add vptr vptr y
    str colour [vptr]
    
})





; test routine that displays each texture on the screen
; this relies on the delay and image number loop
; from the gfx-update
(subr render-tex
      ([vptr x0]
       [texnum x1][iptr x1]
       [offset x3]
       [x w4]
       [y w5]
       [data w6]
       [screen-rowsize x8]
       [temp x9])
      [] {

    ldr screen-rowsize ROW-SIZE:
    ldr temp textures-address:
    ; apply offset    
    mov offset @$4000      ; texture size
    mul iptr offset texnum ; size * index
    add iptr temp iptr     ; start+offset

    ; now we are ready to copy
    mov y @64
  equiv to 
    (/whilenz y {
      mov x @64
      (/whilenz x {
  copy 4 bytes from source to dest
        ldr data [iptr] @4 
        str data [vptr] @4 
        sub x x @1
       })
      sub y y @1
      ; move down a row in video memory
      sub vptr vptr @(* 64 4)
      add vptr vptr screen-rowsize
    })
})

; test routine that displays each 2d picture on the screen
; this relies on the delay and image number loop
; from the gfx-update
(subr render-pic
      ([vptr x0]
       [picnum x1][offset x1][iptr x1]
       [header x2]
       [width w2]
       [height w3]
       [x w4]
       [y w5]
       [data w6]
       [rowsize x7]
       [screen-rowsize x8]
       [temp x9])
      [] {

    ldr screen-rowsize ROW-SIZE:
    ; lookup the pic header info
;    adr header DATA-2d-image-header:
   ldr header 2d-image-header-address:
  index * 8
    add header picnum header    ; offset
    ldr offset [header]      ; load struct
  width / height is in lower 16 bits
    mov width w1
    mov height w1
    mov temp @$FFFF
    and width width temp
    lsl rowsize width @2
    lsr height height @16
  data offset in top 32 bits , move it down
    lsr offset offset @32
    ; base image ptr
     adr temp DATA-2d - images :
    ldr temp 2d-images-address:
    ; apply offset
    add iptr offset temp
    ; now we are ready to copy

    mov y height
:y-loop
    mov x width

         :
:x-loop
  copy 4 bytes from source to dest
    ldr data (iptr @0)

    str data (vptr @0)
    add iptr iptr @4

    add vptr vptr @4
    
    sub x x @1
    cbnz x x-loop-

    sub y y @1

    ; move down a row in video memory
    sub vptr vptr rowsize
    add vptr vptr screen-rowsize

    cbnz y y-loop-
          
    })



; core render loop
; clear screen then call other rendering functions
(subr update-gfx  (
                   [temp x4] ; temporary / intermediates
                   [wtemp w5]
                   [tptr x8]
                   [vptr x9] ; video memory pointer
                   [vptr-bak x10]
                   [row-size x14]
                   ) [x0 x1 x2 x3 x4]
                    {
:loop
    ldr w0 finished-rendering:
cbnz x0 loop-
;(debug-str "render frame" #t)
    (flip-gpio1)
    bl get-back-buffer:
    mov vptr x0
    mov vptr-bak x0
    ; ===================
    ; clear screen
    
  we do 8 pixels each iteration so
  we need 320 * 200/8 = $ 1F40 iterations
      mov temp @$1F40
;;     mov x3 @0
;; :next
;;     str x3 [vptr]
      str x3 (   )
;;     str x3 (vptr @16)
;;     str x3 (vptr @24)
      add   @32

;;     sub temp temp @1
;;     cbnz temp next-
;;     mov vptr x0

    ; end clear screen
    ; ====================


    ; only once code 
  adr     :
  ldr x0 [  ]
    ;; cbz x0 done+
    mov x1 vptr-bak
     ( debug - str " debg " # t )
    (preserve [x4 x8 x9 x10 x14] {
      bl ThreeDRefresh:   ; raycaster
    })

    ; rotate player
    ldr tptr player:
    (_objstruct/angle-get wtemp tptr)    
    add wtemp wtemp @1
    (/when (wtemp ge @360) {mov wtemp @0})
    (_objstruct/angle-set wtemp tptr) 


    ; only once code
  adr     :
  ldr temp [ x0 ]
    ;; sub temp temp @1
  adr     :
    ;; str temp [x0]

    :done
    ;signal render has finished
    mov temp @1
    adr x0 finished-rendering:
    str temp [x0]
;(debug-str "done frame" #t)
    (flip-gpio1)
    b loop-
})

(define-syntax-parser FixedMul
  these should be x registers only ,  to put a check in
  trashes 
  ; DO NOT USE x0 AS TARGET!
  make sure you SIGN ENTEND into x and y first !
  ([_ target:register x:register y:register]
   #'{
      ; TODO: madd here when i implement it
      mul target x y
      (load-immediate x0 $8000)
      add target target x0
      asr target target @16 
     }))

(subr VgaClearScreen
      ([vptr x1]
       [temp x2]       
       [x x3]
       [y x4]
       [ptr x5]
       [colour w6])
      [x1] {

   adr ptr palette:
   mov temp @$1d    
   lsl temp temp @2
   add ptr ptr temp
   ldr colour [ptr]

   xsteps = (/ 320 4)
  ceiling hardcoded to palette $ 1d for now
   (/for { mov y @0 } (y lt @(/ VIEWHEIGHT 2)) (inc y) {
     (/for { mov x @0 } (x lt @xsteps) (inc x) {                                                   
         str colour [vptr]
         str colour [vptr @4]
         str colour [vptr @8]
         str colour [vptr @12]
         add vptr vptr @16
     })

   })

  floor is always $ 19
   adr ptr palette:
   mov temp @$19    
   lsl temp temp @2
   add ptr ptr temp
   ldr colour [ptr]

   (/for { } (y lt @VIEWHEIGHT) (inc y) {
     (/for { mov x @0 } (x lt @xsteps) (inc x) {
         str colour [vptr]

         str colour [vptr @4]
         str colour [vptr @8]
         str colour [vptr @12]
         add vptr vptr @16
     })
   })
})
(subr ScalePost
      ([vptr x1]

       [ywcount w2]
       [yoffs w3]
       [yw w4]
       [yd w5]
       [yendoffs w6]
       [col w7]
       [ptr x8]
       )
      [x1] {
  ; scales and draws a strip of pixels from a wall texture

;  (debug-str "enter scalepost " #t)

ywcount = yd = wallheight[postx ] > > 3 ;
  adr ptr wallheight:
  ldr w10 postx:
  lsl w10 w10 @2
  add ptr ptr w10
  ldr w10 [ptr]
   ( debug - str - reg " wallheight[postx ] " w10 )
  lsr w10 w10 @3
   ( debug - str - reg " > > 3 " w10 )
  mov ywcount w10
  mov yd w10
  (/when (yd le @0) { mov yd @100 })

yoffs = ( viewheight / 2 - ywcount ) * vbufPitch ;
  mov w10 @(/ VIEWHEIGHT 2)
  sub w10 w10 ywcount
  ldr w11 vbufPitch:
  mul yoffs w10 w11
;  (debug-str-reg "yoffs " yoffs)
  (/when (yoffs lt @0) { mov yoffs @0 })

  ; yoffs += postx
  ldr w10 postx:
  add yoffs yoffs w10
;  (debug-str-reg "yoffs " yoffs)

  yendoffs = viewheight / 2 + ywcount - 1 ;
  mov w10 @(/ VIEWHEIGHT 2)
  add w10 w10 ywcount
  sub yendoffs w10 @1
;  (debug-str-reg "yendoffs " yendoffs)
  
yw =  ;
  mov yw @(- TEXTURESIZE 1)
;  (debug-str-reg "yw " yw)
  
  ; this loops scales when the wall takes up more than the
  vertical size of the screen , do n't need it for first
  ; render (TODO)
   ;; while(yendoffs >= viewheight)
   ;;  {
   ;;      ywcount -= TEXTURESIZE/2;
   ;;      while(ywcount <= 0)
   ;;      {
   ;;          ywcount += yd;
   ;;          yw--;
   ;;      }
       yendoffs-- ;
   ;;  }
   ;;  if(yw < 0) return;

  ;col = postsource[yw]
  ldr ptr postsource:
  lsl w10 yw @2
  add ptr ptr w10
  this is the 32bit pixel data
   ( debug - str - reg " first col is " col )
  
yendoffs = yendoffs * vbufPitch + postx ;
  ldr w10 vbufPitch:
  ldr w11 postx:
  mul yendoffs yendoffs w10
  add yendoffs yendoffs w11
;  (debug-str-reg "yendoffs before loop " yendoffs)

;  (debug-str "entering loop .." #t)
  (/while (yoffs le yendoffs) {
;    (debug-str-reg "loop yoffs " yoffs)
    
    mov x20 vptr
    lsl x10 yendoffs @2
    add x20 x20 x10
    str col [x20]  ; write pixel data to video memory

    ;ywcount -= TEXTURESIZE/2
    mov x10 @(/ TEXTURESIZE 2)
    sub ywcount ywcount x10
   ( debug - str - reg " iloop ywcount " ywcount )
    (/when (ywcount le @0) {
  :top-loop

      add ywcount ywcount yd
 ;     (debug-str-reg "ywcount " ywcount)
      sub yw yw @1
;      (debug-str-reg "yw " yw)
      (/when (ywcount le @0)
             {
             ( debug - str "  1 " # t )
              b top-loop-
              })
      (/when (yw lt @0)
             {
              ( debug - str "  2 " # t )
              b local-end+
             } )
      ;col = postsource[yw]
      ldr ptr postsource:
      lsl w10 yw @2
      add ptr ptr w10
  this is the 32bit pixel data
;      (debug-str-reg "col is " col)      
    })
    ldr w10 vbufPitch:
    sub yendoffs yendoffs w10
     ( debug - str - reg " yendoffs nojw " yendoffs )
  })
:local-end                               
;  (debug-str "exit scalepost " #t)            
})

(subr HitHorizWall
      ([vptr x1]
       [wallpic w2]
       [texture w3]
       [ptr x4]
       )
      [x1] {
;  (debug-str "in hithorizwall" #t)
  ;texture = ((xintercept+texdelta)>>TEXTUREFROMFIXEDSHIFT)&TEXTUREMASK;  
  ldr w10 xintercept:
  ldr w11 texdelta:
  add w10 w10 w11
  asr w10 w10 @TEXTUREFROMFIXEDSHIFT
  mov w12 @TEXTUREMASK
  and w10 w10 w12
  mov texture w10
;  (debug-str-reg "texture " w10)

  ;if ytilestep == -1
  ldr w10 ytilestep:
  mov w11 @0
  sub w11 w11 @1 ; -1
  (/if (w10 eq w11)
       {
yintercept + = TILEGLOBAL ;
         ldr w10 yintercept:
         (load-immediate w11 TILEGLOBAL)
         add w10 w10 w11
         adr ptr yintercept:
         str w10 [ptr]
       }
       ;else 
       {
         ; texture = TEXTUREMASK-texture
         mov w11 @TEXTUREMASK
         sub texture w11 texture
       })
  
if(lastside!=-1 ) ScalePost ( ) ;
  ldr w10 lastside:
  mov w11 @0
  sub w11 w11 @1
  (/when (w10 ne w11) (preserve [x1 x2 x3 x4] { bl ScalePost: }))

  ;lastside = 0
  mov x10 @0
  adr ptr lastside:
  str w10 [ptr]

lastintercept = ytile
  ldr w10 ytile:
  adr ptr lastintercept:
  str w10 [ptr]

  ;lasttilehit = tilehit
  ldr w10 tilehit:
  adr ptr lasttilehit:
  str w10 [ptr]
  
 = texture
  adr ptr lasttexture:
  str texture [ptr]


  ;wallheight[pixx] = CalcHeight()
  (preserve [x1 x2 x3 x4] { bl CalcHeight: })
 ; (debug-str-reg "calcheight " x0)
  adr ptr wallheight:
  ldr w10 pixx:
  lsl w10 w10 @2
  add ptr ptr w10
  str w0 [ptr]
  
postx = pixx
  ldr w10 pixx:
  adr ptr postx:
  str w10 [ptr]


  ; wallpic = horizwall[tilehit ]   ;
  ldr w10 tilehit:
  lsl w10 w10 @1
  adr ptr horizwall:
  add ptr ptr w10
  ldrh wallpic [ptr]
   ( debug - str - reg " wallpix "  )

  ;postsource = PM_GetTexture(wallpic) + texture
  ; this is a bit different for us since we don't
  ; have a page manager and are not using palette indexes.

  we need to find the start of the image data for wallpic index
  then offset into it texture < < 2

  ldr ptr textures-address:
  mov w10 @$4000      ; texture size
  mul w11 w10 wallpic ; size * index
  add ptr ptr w11     ; start+offset

  ; now we are pointing at the start of image
  move along texture * 4 bytes
  lsl w10 texture @2
  add ptr ptr w10

  mov x10 ptr
  adr ptr postsource:
  str x10 [ptr]

  
  })

(subr HitVertWall
      ([vptr x1]

       [wallpic w2]
       [texture w3]
       [ptr x4]
       )
      [x1] {
;  (debug-str "in hitvertwall" #t)
  ;texture = ((yintercept+texdelta)>>TEXTUREFROMFIXEDSHIFT)&TEXTUREMASK;  
  ldr w10 yintercept:
  ldr w11 texdelta:
  add w10 w10 w11
  asr w10 w10 @TEXTUREFROMFIXEDSHIFT
  mov w12 @TEXTUREMASK
  and w10 w10 w12
  mov texture w10
;  (debug-str-reg "texture " w10)

  ;if xtilestep == -1
  ldr w10 xtilestep:
  mov w11 @0
  sub w11 w11 @1 ; -1
  (/when (w10 eq w11)
       {
         ; texture = TEXTUREMASK-texture
         mov w11 @TEXTUREMASK
         sub texture w11 texture
xintercept + = TILEGLOBAL ;
         ldr w10 xintercept:
         (load-immediate w11 TILEGLOBAL)
         add w10 w10 w11
         adr ptr xintercept:
         str w10 [ptr]             
       })
  
if(lastside!=-1 ) ScalePost ( ) ;
  ldr w10 lastside:
  mov w11 @0
  sub w11 w11 @1
  (/when (w10 ne w11) (preserve [x1 x2 x3 x4] {
                                               bl ScalePost:
                                                  }))

lastside = 1
  mov x10 @1
  adr ptr lastside:
  str w10 [ptr]

lastintercept = xtile
  ldr w10 xtile:
  adr ptr lastintercept:
  str w10 [ptr]

  ;lasttilehit = tilehit
  ldr w10 tilehit:
  adr ptr lasttilehit:
  str w10 [ptr]
  
 = texture
  adr ptr lasttexture:
  str texture [ptr]


  ;wallheight[pixx] = CalcHeight()
  (preserve [x1 x2 x3 x4] { bl CalcHeight: })
;  (debug-str-reg "calcheight " x0)
  adr ptr wallheight:
  ldr w10 pixx:
  lsl w10 w10 @2
  add ptr ptr w10
  str w0 [ptr]
  
postx = pixx
  ldr w10 pixx:
  adr ptr postx:
  str w10 [ptr]


  ; wallpic = vertwall[tilehit ]   ;
  ldr w10 tilehit:
  lsl w10 w10 @1
  adr ptr vertwall:
  add ptr ptr w10
  ldrh wallpic [ptr]
   ( debug - str - reg " wallpix "  )

  ;postsource = PM_GetTexture(wallpic) + texture
  ; this is a bit different for us since we don't
  ; have a page manager and are not using palette indexes.

  we need to find the start of the image data for wallpic index
  then offset into it texture < < 2

  ldr ptr textures-address:
  mov w10 @$4000      ; texture size
  mul w11 w10 wallpic ; size * index
  add ptr ptr w11     ; start+offset

  ; now we are pointing at the start of image
  move along texture * 4 bytes
  lsl w10 texture @2
  add ptr ptr w10

  mov x10 ptr
  adr ptr postsource:
  str x10 [ptr]

  
})

(subr CalcHeight
      ([vptr x1]

       )
      [x1] {
   ( debug - str " in  " # t )
fixed z = FixedMul(xintercept - viewx , viewcos ) - FixedMul(yintercept - viewy , viewsin ) ;
  ldr w10 xintercept:
  ldr w11 viewx:                
  ldr w12 viewcos:
;  (debug-str-reg "xintercept " w10)
   ( debug - str - reg " viewx " w11 )
   ( debug - str - reg " viewcos " w12 )
  sub w10 w10 w11
  sxtw x10 w10
  sxtw x12 w12
  (FixedMul x20 x10 x12)
   ( debug - str - reg " fixed1 " x20 )
  
  ldr w10 yintercept:
  ldr w11 viewy:                
  ldr w12 viewsin:
  sub w10 w10 w11
  sxtw x10 w10
  sxtw x12 w12
  (FixedMul x21 x10 x12)
;  (debug-str-reg "fixed2 " x21)
  ; x10 = z
  sub w10 x20 x21
 ; (debug-str-reg "z " w10)
  ; if (z < mindist) z = mindist
  mov x11 @MINDIST
  (/when (w10 lt x11) { 
    mov w10 @MINDIST
  })

  int height = heightnumberator / ( z>>8 )
  asr w10 w10 @8
  ldr w11 heightnumerator:
;  (debug-str-reg "asr z " w10)
;  (debug-str-reg "numerator " w11)
  udiv w10 w11 w10
;  (debug-str-reg "udiv " w10)
  
 ; pretty sure this code isn't used/*
    if(height <  )
 ;       min_wallheight = height;
  ;   */

  mov x0 x10 
})

(subr AsmRefresh
      ([vptr x1]

       [xstep w2]
       [ystep w3]
       [xpartial w4]
       [ypartial w5]
       [ptr x6]
       [xtemp x7]

       [local-pixx w8]
       [wtemp w9]

       )
      [x1] {
  ; NOTE: this function uses x10+ for all item temporaries, except the named ones above
  ( and our old friend  of course )
 
  ; this is the actual raycaster

;  (debug-str "enter asm referesh" #t)          
  mov xstep @0
  mov ystep @0
  mov xpartial @0
  mov ypartial @0

  ; for each X column of the screen ..
  (/for {mov local-pixx @0} (local-pixx lt  @320) (inc local-pixx) {
;    (debug-str "pixx loop" #t)
;    (debug-str-reg "LOOPINDEX " local-pixx)
    ; store global pixx (keep in sync with loop counter)
    adr ptr pixx:
    str local-pixx [ptr]
    ; perform angle calcs
    
     ]
    adr ptr pixelangle:    
    mov wtemp local-pixx
    lsl wtemp wtemp @1
    add ptr ptr wtemp 
    ldrh w0 [ptr]
    sxth w0 w0
;    (debug-str-reg "pixelangle[pixx] = " w0)
    ldr wtemp midangle:
    add w10 w0 wtemp
;    (debug-str-reg "+midangle = " w0)

    (/when (w10 lt @0)  {
       ( debug - str " angl < 0 " # t )
      mov w11 @FINEANGLES
      add w10 w10 w11
    })

    (/when (w10 ge @3600)  {
       ( debug - str " angl > = 3600 " # t )                  
      mov w11 @FINEANGLES
      sub w10 w10 w11

      })

    (/cond
     ([(w10 lt @900)
       {
;         (debug-str "angl < 900" #t)
         mov w0 @1
         adr ptr xtilestep:
         str w0 [ptr]
         ; TODO: need movn / neg
         mov w0 @0
         sub w0 w0 @1  ; -1
         adr ptr ytilestep:
         str w0 [ptr]
  xstep = finetangent[900 - 1 - angl ]
         adr ptr finetangent:
         mov w11 @899 ; w11 index
  index -= angl
;         (debug-str-reg "index " w11)
  32 bit
         add ptr ptr w11
         ldr xstep [ptr]
;         (debug-str-reg "xstep " xstep)

 = -finetangent[angl ]
  w11 = angl
         adr ptr finetangent:
         lsl w11 w11 @2
         add ptr ptr w11
         ldr ystep [ptr]
         sub ystep wzr ystep
          ( debug - str - reg " ystep "  )
         ; xpartial = xpartialup
         ldr xpartial xpartialup:
;         (debug-str-reg "xpartial " xpartial)
  ypartial = ypartialdown
         ldr ypartial ypartialdown:
;         (debug-str-reg "ypartial " ypartial)
         
       }]
      [(w10 lt @1800)
       {

          ( debug - str " angl < 1800 " # t )
         mov w0 @0
         sub w0 w0 @1  ; -1
         adr ptr xtilestep:
         str w0 [ptr]
         adr ptr ytilestep:
         str w0 [ptr]
         ; xstep = -finetangent[angl-900]
         adr ptr finetangent:
         mov w11 @900 ; w11 index
         sub w11 w10 w11 ; angle - 900
;         (debug-str-reg "index " w11)
  32 bit
         add ptr ptr w11
         ldr xstep [ptr]
         sub xstep xzr xstep
;         (debug-str-reg "xstep " xstep)

 = -finetangent[1800 - 1 - angl ]
         mov w11 @1799
         sub w11 w11 w10
         adr ptr finetangent:
         lsl w11 w11 @2
         add ptr ptr w11
         ldr ystep [ptr]
         sub ystep wzr ystep
          ( debug - str - reg " ystep "  )
         ldr xpartial xpartialdown:
;         (debug-str-reg "xpartial " xpartial)
         ldr ypartial ypartialdown:
;         (debug-str-reg "ypartial " ypartial)
         

       }]
      [(w10 lt @2700)
       {
         ( debug - str " angl < 2700 " # t )
         mov w0 @0
         sub w0 w0 @1  ; -1
         adr ptr xtilestep:
         str w0 [ptr]
         mov w0 @1
         adr ptr ytilestep:
         str w0 [ptr]
  xstep = -finetangent[2700 - 1 - angl ]
         adr ptr finetangent:
         mov w11 @2699 ; w11 index
         sub w11 w11 w10 ; 
;         (debug-str-reg "index " w11)
  32 bit
         add ptr ptr w11
         ldr xstep [ptr]
         sub xstep xzr xstep
;         (debug-str-reg "xstep " xstep)

 = finetangent[angl-1800 ]
         mov w11 @1800
         sub w11 w10 w11
         adr ptr finetangent:
         lsl w11 w11 @2
         add ptr ptr w11
         ldr ystep [ptr]
          ( debug - str - reg " ystep "  )
         ldr xpartial xpartialdown:
;         (debug-str-reg "xpartial " xpartial)
         ldr ypartial ypartialup:
;         (debug-str-reg "ypartial " ypartial)
      
        }]
      [(w10 lt @3600)
       {
         ( debug - str " angl < 3600 " # t )
   
         mov w0 @1
         adr ptr xtilestep:
         str w0 [ptr]
         adr ptr ytilestep:
         str w0 [ptr]
         ; xstep = finetangent[angl-2700]
         adr ptr finetangent:
         mov w11 @2700 ; w11 index
         sub w11 w10 w11 ; 
;         (debug-str-reg "index " w11)
  32 bit
         add ptr ptr w11
         ldr xstep [ptr]
;         (debug-str-reg "xstep " xstep)

 = finetangent[3600 - 1 - angl ]
         mov w11 @3599
         sub w11 w11 w10
         adr ptr finetangent:
         lsl w11 w11 @2
         add ptr ptr w11
         ldr ystep [ptr]
          ( debug - str - reg " ystep "  )
         ldr xpartial xpartialup:
;         (debug-str-reg "xpartial " xpartial)
         ldr ypartial ypartialup:
;         (debug-str-reg "ypartial " ypartial)
   
        }]))

yintercept = FixedMul(ystep , xpartial )  
  make sure these are in x registers first
  sign extend to 64 bits

    sxtw x10 ystep
    sxtw x11 xpartial
    (FixedMul x12 x10 x11)
    mov x0 x12
     ( debug - str - reg " fixed    w0 )
    ldr wtemp viewy:
    add w0 w0 wtemp
    adr ptr yintercept:
    str w0 [ptr]
;    (debug-str-reg "yintercept " w0)
    mov w12 w0 ; w12 = yintercept (used in a moment)
    
xtile = focaltx + xtilestep
    ldr w10 focaltx:
    ldr w11 xtilestep:
    add w10 w10 w11
    adr ptr xtile:
    str w10 [ptr]
;    (debug-str-reg "xtile " w10)
    
  xspot = ( xtile < < 6 ) + ( yintercept > > 16 )
    lsl w10 w10 @6
    lsr w12 w12 @16
    add w0 w10 w12
    adr ptr xspot:
    str w0 [ptr]
;    (debug-str-reg "xspot " w0)

    ;xintercept = FixedMul(xstep,ypartial) + viewx
    sxtw x10 xstep
    sxtw x11 ypartial
    (FixedMul x12 x10 x11)
    mov x0 x12
     ( debug - str - reg " fixed    w0 )
    ldr wtemp viewx:
    add w0 w0 wtemp
    adr ptr xintercept:
    str w0 [ptr]
;    (debug-str-reg "xintercept " w0)
    mov w12 w0 ; w12 = xintercept (used in a moment)

    ;ytile = focalty + ytilestep
    ldr w10 focalty:
;        (debug-str-reg "focalty " w10)
    ldr w11 ytilestep:
;            (debug-str-reg "ytilestep " w11)
    add w10 w10 w11
    adr ptr ytile:
    str w10 [ptr]
;    (debug-str-reg "ytile " w10)
    
  yspot = ( ( xintercept > > 16 ) < < 6 ) + ytile

    lsr w12 w12 @16
    lsl w12 w12 @6
    add w0 w10 w12
    adr ptr yspot:
    str w0 [ptr]
;    (debug-str-reg "yspot " w0)

    adr ptr texdelta:
    mov x0 @0
    str w0 [ptr]
    

    ;  special pushwall handling (TODO)
            
    ; begin raycasting loop
  :start-vert-loop

  if ytilestep = -1 & & ( yintercept>>16 < = ytile ) goto horizentry
  if ytilestep = 1 & & ( yintercept>>16 > = ytile ) goto horizentry
    ldr w10 ytilestep:
    ldr w11 yintercept:
    asr w11 w11 @16
;    (debug-str-reg "asr " w11)
    mov w12 @0
    sub w12 w12 @1 ; w12 = -1
    ldr w13 ytile:
  if ytilestep = -1 & & ( yintercept>>16 < = ytile ) goto horizentry
    (/when (/and (w10 eq w12) (w11 le w13)) {
       ( debug - str " check 1 true " # t )
      b horizentry:                                             
      })
  if ytilestep = 1 & & ( yintercept>>16 > = ytile ) goto horizentry
    (/when (/and (w10 eq @1) (w11 ge w13)) {
       ( debug - str " check 2 true " # t )
      b horizentry:                                             
    })
  :vertentry
  TODO : there 's an OOB check we do n't need right now
    ; if(xspot > maparea) break;
     ( debug - str " in vertentry " # t )
    ; tilehit = tilemap[xspot]
    adr ptr tilemap:
    ldr wtemp xspot:
    add ptr ptr wtemp
    ldrb w0 [ptr]
;    (debug-str-reg "tilehit " w0)
    adr ptr tilehit:
    str w0 [ptr]

    ;if tilehit
    (/when (w0 ne @0) {

      ;TODO: a bunch of door and pushwall stuff
;      (debug-str-reg "HIT V " w0)                 

      ;xintercept=xtile<<TILESHIFT;
      ldr w10 xtile:
      lsl w10 w10 @TILESHIFT
      adr ptr xintercept:
      str w10 [ptr]
;      (debug-str "1 " #t)
      ;ytile = (short) (yintercept >> TILESHIFT);
      ldr w10 yintercept:
      asr x10 x10 @TILESHIFT
      adr ptr ytile:
      str w10 [ptr]
       ( debug - str " 2 " # t )

      (preserve [x1 x2 x3 x4 x5 x6 x7 x8 x9] {
        bl HitVertWall:
      })        
      b loop-next+
    })                   

  :passvert  

    ;; todo spotvis update when we take on sprites
    ;xtile += xtilestep
    ldr w10 xtile:
    ldr w11 xtilestep:
    add w10 w10 w11
    adr ptr xtile:
    str w10 [ptr]

yintercept + = 
    ldr w12 yintercept:
ldr   :
    add w10 w12 ystep
    adr ptr yintercept:
    str w10 [ptr]

  xspot = ( xtile < < 6 ) + ( yintercept > > 16 )
    mov w12 w10
    ldr w10 xtile:
    lsl w10 w10 @6
    lsr w12 w12 @16
    add w0 w10 w12
    adr ptr xspot:
    str w0 [ptr]
;    (debug-str-reg "xspot v " w0)

    b start-vert-loop:

  :start-horiz-loop
  if xtilestep = -1 & & ( xintercept>>16 < = xtile ) goto vertentry
  if xtilestep = 1 & & ( xintercept>>16 > = xtile ) goto vertentry
    ldr w10 xtilestep:
    ldr w11 xintercept:
    asr w11 w11 @16
    mov w12 @0
    sub w12 w12 @1 ; w12 = -1
    ldr w13 xtile:
  if xtilestep = -1 & & ( xintercept>>16 < = xtile ) goto vertentry
    (/when (/and (w10 eq w12) (w11 le w13)) {
       ( debug - str " check 3 true " # t )
      b vertentry:                                             
      })
  if xtilestep = 1 & & ( xintercept>>16 > = xtile ) goto vertentry
    (/when (/and (w10 eq @1) (w11 ge w13)) {
       ( debug - str " check 4 true " # t )
      b vertentry:                                             
    })
  :horizentry
     ( debug - str " in horizentry " # t )
    ; tilehit = tilemap[yspot]
    adr ptr tilemap:
    ldr wtemp yspot:
    add ptr ptr wtemp
    ldrb w0 [ptr]
;    (debug-str-reg "tilehit " w0)
    adr ptr tilehit:
    str w0 [ptr]

    ;if tilehit
    (/when (w0 ne @0) {

      ;TODO: a bunch of door and pushwall stuff
;      (debug-str-reg "HIT H " w0)                 
      ;yintercept=ytile<<TILESHIFT;
      ldr w10 ytile:
      lsl w10 w10 @TILESHIFT
      adr ptr yintercept:
      str w10 [ptr]
      
      ;xtile = (short) (xintercept >> TILESHIFT);
      ldr w10 xintercept:
      asr x10 x10 @TILESHIFT
      adr ptr xtile:
      str w10 [ptr]
      (preserve [x1 x2 x3 x4 x5 x6 x7 x8 x9] {
        bl HitHorizWall:
      })        
  
  
      
      ;break
      b loop-next+
    })                   

    
  :passhoriz
    ;; todo spotvis update when we take on sprites
    ;ytile += ytilestep
    ldr w10 ytile:
;    (debug-str-reg "ytile " w10)
    ldr w11 ytilestep:
;    (debug-str-reg "ytilestep " w11)
    add w10 w10 w11
    adr ptr ytile:
    str w10 [ptr]
;    (debug-str-reg "ph ytile " w10)
    ;xintercept += xstep
    ldr w12 xintercept:
;    (debug-str-reg "xintercept " w12)
ldr w11 xstep :
;    (debug-str-reg "xstep " xstep)
    add w10 w12 xstep
    adr ptr xintercept:
    str w10 [ptr]
;    (debug-str-reg "ph xintercept " w10)
  yspot = ( ( xintercept > > 16 ) < < 6 ) + ytile
    mov w12 w10
    asr w12 w12 @16
    lsl w12 w12 @6
    ldr w10 ytile:
    add w0 w10 w12
    adr ptr yspot:
    str w0 [ptr]
 ;   (debug-str-reg "yspot h " w0)

    
    b start-horiz-loop:

  :loop-next
    ldr local-pixx pixx:
  })

   ( debug - str " exit asm referesh " # t )          
})

(subr WallRefresh
      ([vptr x1]

       [ptr x2]
       [temp x2]
       )
      [x1] {
  xpartialdown = viewx & ( TILEGLOBAL-1 )
  (load-immediate temp (- TILEGLOBAL 1))
  adr   :
  ldr w0 [ x0 ]
  ldr w0 viewx:
  and x0 x0 temp
  adr ptr xpartialdown:
  str w0 [ptr]

  ;; ; debug
  ldr w0 [ ptr ]
  ( debug - str - reg "  is " x0 )
  ;; ; end debug

  xpartialup = TILEGLOBAL - xpartialdown (  )
  (load-immediate temp TILEGLOBAL)
  sub x0 temp x0
  adr ptr xpartialup:
  str w0 [ptr]

  ;; ; debug
  ldr w0 [ ptr ]
  ;; (debug-str-reg "xpartialup is " x0)
  ;; ; end debug

  
  ypartialdown = viewy & ( TILEGLOBAL-1 )
  (load-immediate temp (- TILEGLOBAL 1))
  ldr w0 viewy:
;  (debug-str-reg "viewy is " w0)
  and x0 x0 temp
;  (debug-str-reg "result is " w0)
  adr ptr ypartialdown:
  str w0 [ptr]

  ;; ; debug
  ldr w0 [ ptr ]
  ( debug - str - reg " ypartialdown is ! "  )
  ;; ; end debug

  
  ypartialup = TILEGLOBAL - ypartialdown (  )
  (load-immediate temp TILEGLOBAL)
  sub x0 temp x0
  adr ptr ypartialup:
  str w0 [ptr]

  ;; ; debug
  ldr w0 [ ptr ]
  ;; (debug-str-reg "ypartialup is " x0)
  ;; ; end debug

  ; lastside = -1
  mov x0 @0
  sub x0 x0 @1
  adr ptr lastside:
  str w0 [ptr]
  bl AsmRefresh:
  bl ScalePost:
})

(subr ThreeDRefresh
      ([vptr x1]
       
       [ply x2]
       [temp w3]
       [temp2 w4]
       [temp3 x5]
       [ptr x5]
       [vangle w6])
      [x1]
      {

  ; first we'd clear spotvis that will detect sprite hits
  ; but we are not doing this yet     

  ; ===============
  ; CalcViewVariables

  ; player: is a pointer!
  ldr ply player:

  ; viewangle = ply->angle    
  (_objstruct/angle-get temp ply)    
  adr x0 viewangle:
  str temp [x0]
  mov vangle temp
  ;; ; debug
  ldr w0 [ x0 ]
  ;; (debug-str-reg "viewangle is " x0)
  ;; ; end debug
  
  
  ;midangle = viewangle * (FINEANGLES/ANGLES)
  (load-immediate x0 (/ FINEANGLES ANGLES))
  mul temp2 temp x0
  adr x0 midangle:
  str temp2 [x0]

  ; debug
  ldr w0 [x0]
;  (debug-str-reg "midangle is " x0)
  ; end debug
  
TODO : really need to add support for the ldr / str with
  ; offset registers optionally shifted
  
  viewsin = sintable[viewangle ]
  temp = viewangle
  adr ptr sintable:
  multiply by 4 since 32bits
  todo : this could all be 1 instruction
  ldr w0 [ptr]
  adr ptr viewsin:
  str w0 [ptr]

  ; debug
  ldr w0 [ptr]
   ( debug - str - reg " viewsin is " x0 )
  ; end debug

  
  viewy = player->x + FIxedMul(focallength , viewsin )  
  ldr temp2 focallength:
  sxtw x0 w0
  sxtw temp2 temp2
  (FixedMul temp3 x0 temp2)
   ( debug - str - reg " rresult "  )
  (_objstruct/y-get temp2 ply)
   ( debug - str - reg " player->y "  )
  sub x0 temp2 temp3
  adr ptr viewy:
  str w0 [ptr]

  ;; ; debug
  ldr w0 [ ptr ]
  ;; (debug-str-reg "viewy is " x0)
  ;; ; end debug

  focalty = viewy > > 16
  lsr w0 w0 @16
  adr ptr focalty:
  str w0 [ptr]

  ;; ; debug
  ldr w0 [ ptr ]
  ;; (debug-str-reg "focalty is " x0)
  ;; ; end debug

  ; viewcos = costable[viewangle]
  ; tmep = viewangle
  ; costable is a pointer
  ldr ptr costable:
  multiply by 4 since 32bits
  add ptr ptr temp2
  ldr w0 [ptr]
  adr ptr viewcos:
  str w0 [ptr]

  ;;   ; debug
  ldr w0 [ ptr ]
  ( debug - str - reg " viewcos is " x0 )
  ;; ; end debug

  
  viewx = player->x - FIxedMul(focallength ,  )  
  ldr temp2 focallength:
   ( debug - str - reg " focallength "  )
  sxtw x0 w0
  sxtw temp2 temp2
  (FixedMul temp3 x0 temp2)
   ( debug - str - reg " result "  )
  (_objstruct/x-get temp2 ply)
   ( debug - str - reg " player->x "  )
  sub x0 temp2 temp3
  adr ptr viewx:
  str w0 [ptr]

  ;; ; debug
  ldr w0 [ ptr ]
  ;; (debug-str-reg "viewx is " x0)
  ;; ; end debug

  
  focaltx = viewx > > 16
  lsr w0 w0 @16
  adr ptr focaltx:
  str w0 [ptr]

  ;; ; debug
  ldr w0 [ ptr ]
  ;; (debug-str-reg "focaltx is " x0)
  ;; ; end debug
  
  
  viewtx = player->x > > 16 }
  (_objstruct/x-get temp2 ply)
  lsr x0 temp2 @16
  adr ptr viewtx:
  str w0 [ptr]

  ;; ; debug
  ldr w0 [ ptr ]
  ;; (debug-str-reg "viewtx is " x0)
  ;; ; end debug

  
  viewty = player->y > > 16 }
  (_objstruct/y-get temp2 ply)
  lsr x0 temp2 @16
  adr ptr viewty:
  str w0 [ptr]

  ;; ; debug
  ldr w0 [ ptr ]
  ;; (debug-str-reg "viewty is " x0)
  ;; ; end debug

  
  ; =================

  bl VgaClearScreen:
  bl WallRefresh:
  ; ==================

   ( debug - str " finish 3d refersh " # t )
})

; old gfx code that does the slideshows
  ( subr update - gfx   (
;;                   [temp x4] ; temporary / intermediates
;;                   [tptr x8]
;;                   [vptr x9] ; video memory pointer
;;                   [row-size x14]
;;                   ) [x0 x1 x2 x3 x4]
;;                     {

;; :loop
      ldr w0 finished - rendering :
      cbnz  
;;     bl get-back-buffer:
;;     mov vptr x0

;;     ; ===================
;;     ; clear screen
    
      ; we do 8 pixels each iteration so
      ; we need 320 * 200/8 = $ 1F40 iterations
      mov temp @$1F40
;;     mov x3 @0
;; :next
;;     str x3 [vptr]
      str x3 (   )
;;     str x3 (vptr @16)
;;     str x3 (vptr @24)
      add   @32

;;     sub temp temp @1
;;     cbnz temp next-
;;     mov vptr x0

;;     ; end clear screen
;;     ; ====================
    
      ; x27 holds a delay
;;     ; this should be in memory
;;     ; since we never even push these!
      sub x27 x27 @1
      cbnz x27 skip+
      mov x27 @10
      ; x28 holds next picture to display
;;     ; also can easily be trashed!
;;     sub x28 x28 @1

;;     cbnz x28 skip+
      mov x28 @105   ; 130 for 2d pics , 105 for textures
    
;; :skip    
;;     mov x0 vptr
;;     mov x1 x28

;;     mov x1 @15
    
      ;     :   ; render 2d pics
;;     bl render-tex:   ; render 2d textures
;;     ;signal render has finished
;;     mov temp @1
      adr  finished - rendering :
;;     str temp [w0]


;;     b loop-
;;    })


; interrupt handler
; at the moment we are expecting only the
  SMICS interrupt which is the VSYNC
; here we only flip the pge if the renderer
; has actualy finished
(subr handle-irq () [] {
;(debug-str "handled interrupt" #t)
  ; ; ldr   :
  ; ;   
  ; ; str w1 (   )
  ldr x0 SMICS:  ; ack vsync
  mov x1 @0
  str w1 [x0]
  (flip-gpio0)
  ; only flip if render finished
  ldr w0 finished-rendering:
  cbz w0 quit:
;  (debug-str "flip" #t)
  ldr x1 CURRENT-PAGE:
  cbnz x1 f+
  mov x3 @height
  b done+
:f
  mov x3 @0
:done
  adr x1 CURRENT-PAGE:
  str x3 [x1]
  
  bl page-flip:
bl update - gfx :

  adr x1 finished-rendering:

  mov x2 @0
  str w2 [x1]

  
  :quit
(flip-gpio0)
})


; //////////////////////////////////////////////
  WOLFENSTEIN CODE
; //////////////////////////////////////////////
(define MAXACTORS 150)
(define MAP_HEIGHT 64)
(define MAP_WIDTH 64)
  
(/struct _objstruct
 ([statetype       8] ; *state
  [next            8] ; *next objstruct
  [prev            8] ; *prev objstruct

   , etc
  [distance        4] ; signed; if negative, wait for that door to open
  [speed           4] ; signed  
  [x               4] ; fixed point
  [y               4] ; fixed point
  [transx          4] ; fixed, in global coord
  [transy          4] ; fixed, in global coord
  
  [ticcount        2]
  [tilex           2]
  [tiley           2]
  [viewx           2]
  [viewheight      2]
  [angle           2]
  [hitpoints       2]

  [temp1           2]
  [temp2           2]
  [hidden          2]
  
activetype enum
classtype enum
  dirtype enum
  [areanumber      1]

  I 'm adding this so it is 8 byte aligned ( 72 bytes )
  ))

(subr setup-game-level
      ([raw-ptr x1]
       [lvl-ptr x2]
       [x x3]
       [y x4]
       [tile w5]
       [offset x6])

      [x1 x2 x3 x4 x5 x6] {

  ; setup the walls and actors
  x1 will point at the raw map data for level 1
  ; x2 will point at the 2d byte array tilemap          
  AREATILE = 107
  ldr raw-ptr maps-address: ; this is a linker resolved label
  each raw map section is a 16 bit word

  ; for some reason the map is stored sideways compared to the raw data
  ; so we have to calculate the index here;
  ; x is the row and y is the offset [x][y]


  (/for { mov y @0 } (y lt @MAP_HEIGHT) (inc y) {
    (/for { mov x @0 } (x lt @MAP_WIDTH) (inc x) {
      ldrh tile [raw-ptr] @2
      (/when (tile lt @AREATILE) {

  lvlptr = tilemap : + ( 64 * x ) + y
        adr lvl-ptr tilemap:
  * 64
        add lvl-ptr lvl-ptr offset
        add lvl-ptr lvl-ptr y
        strb tile [lvl-ptr] 
      })
    })                                                     
  })
  
    
})

(subr spawn-player
      ([tilex x1]
       [tiley x2]
       [dir x3]

       [temp x4]
       [ptr x5])
      [x4] {

  ; for now we assign the player to actors[0]
  ; in the future this needs to be in InitActorList
  ; and it must update the freelist etc.         
  ; for now we only have a player and it is hardcoded         
  adr ptr objlist:
  adr temp player:
  str ptr [temp]  ; player = objlist[0]

  mov temp @1

  playerobj = 1
  ac_yes = 1
  tilex = tilex
  (_objstruct/tiley-set tiley ptr)  ; tiley = tiley

  areanumber = map index ( tiley < < 6 ) + tilex  
  lsl temp tiley @6
  add temp temp tilex
  multiply by 2 here because we need words not bytes . the C code is silently doubling the index
  add temp temp temp
  ldr x0 maps-address: ; this is a linker resolved label
  add temp temp x0
  
  ldrb temp [temp]
  (_objstruct/areanumber-set temp ptr) 

  x = ( tilex < < TILESHIFT ) + ( TILEGLOBAL/2 ) ( fixed point )
  (debug-str-reg "tilexx = " tilex)
  lsl temp tilex @TILESHIFT
  (load-immediate x0 TILEGLOBAL/2)
  add temp temp x0
  (debug-str-reg "player->x = " temp)
  (_objstruct/x-set temp ptr)

  (_objstruct/x-get temp ptr)
  (debug-str-reg "* player->x = " temp)

  ; y = (tiley << TILESHIFT) + (TILEGLOBAL/2) (fixed point)
  lsl temp tiley @TILESHIFT
  (load-immediate x0 TILEGLOBAL/2)  
  add temp temp x0
  (debug-str-reg "player->y = " temp)
  (_objstruct/y-set temp ptr)  


  ; the last bits are state, angle and flags.
  ; state we don't care about for now
  angle resolves to zero for the first map so we ignore that for now
  mov temp @180
  (_objstruct/angle-set temp ptr)
  
  mov temp @4
  FL_NEVERMARK = 4
  
  ;; (debug-str "obclass" #t)
  ( _ objstruct / obclass - get temp ptr )
  ;; (debug-reg temp)

  ;; (debug-str "active" #t)
  ( _ objstruct / active - get temp ptr )
  ;; (debug-reg temp)

  ;; (debug-str "tilex" #t)
  ( _ objstruct / tilex - get temp ptr )
  ;; (debug-reg temp)

  ;; (debug-str "tiley" #t)
  ;; (_objstruct/tiley-get temp ptr)
  ;; (debug-reg temp)

  ;; (debug-str "areanumber" #t)
  ;; (_objstruct/areanumber-get temp ptr)
  ;; (debug-reg temp)

  ;; (debug-str "x" #t)
  ;; (_objstruct/x-get temp ptr)
  ;; (debug-reg temp)

  ;; (debug-str "y" #t)
  ( _ objstruct / y - get temp ptr )
  ;; (debug-reg temp)

})          
(subr scan-info-plane
      ([raw-ptr x1]
       [x x2]
       [y x3]
       [temp x4]
       [tile w5])
      [x1 x2 x3 x4] {

  scan second map data plane and spawn player , statics , guards etc
  ; for now we are only going to spawn the player        
  ldr raw-ptr maps-address: ; this is a linker resolved label          
  add 64 * 64 * 2 for start of second plane
  mov x4 @64
  lsl x4 x4 @7
  add raw-ptr raw-ptr x4

  (/for { mov y @0 } (y lt @MAP_HEIGHT) (inc y) {
    (/for { mov x @0 } (x lt @MAP_WIDTH) (inc x) {
      ldrh tile [raw-ptr] @2
      (/when (/and (tile le @22) (tile ge @19)) {
        (debug-str "FOUND PLAYER!" #t)
        (debug-reg x)
        (debug-reg y)
        ;; call spawn-player with x, y, (tile - 19)
        ;; calculate direction
        (preserve [x1 x2 x3] {
          mov x1 x
          mov x2 y
          sub x3 tile @19
          bl spawn-player:
        })
        (debug-str "PLAYER SPAWNED!" #t)
      })
    })                                                     
  })
          
})          
;; ///////////////////////////////////////////////////////
;; wolfenstein GAME STATE VARIABLES
;; ///////////////////////////////////////////////////////
/= 8
; wall locations (byte[64][64])
:tilemap (reserve (* 64 64))
/= 8
; actor locations (ptr[64][64]
:actorat (reserve (* 64 64 8))
/= 8
:objlist (reserve (* (sizeof/_objstruct) MAXACTORS))
/= 8
:player  (write-value-64 0)  ; objstruct*

/= 8
:horizwall
(write-value-16 0)
(for ([i (in-range 1 64)])
  (write-value-16 (* (- i 1) 2)))

/= 8
:vertwall
(write-value-16 0)
(for ([i (in-range 1 64)])
  (write-value-16 (+ (* (- i 1) 2) 1)))

/= 8
:wallheight
(for ([x (in-range 320)])
  (write-value-32 0))

  the following values are used for loading 64 bit addresses / values via LDR(literal )
  and they must be 64 bit aliged otherwise the CPU faults !
/= 8
  ; resolve-global-label-address will tell the linker to write the absolute
  ; address of the exported labels here, post-link.  These might be quite far away and
  ; as such out of range of the adr instruction and some jumps.
  this lets us load them with ldr .
  :2d-image-header-address (resolve-global-label-address :DATA-2d-image-header)
  :2d-images-address (resolve-global-label-address :DATA-2d-images)
  :textures-address (resolve-global-label-address :DATA-textures)
:maps-address (resolve-global-label-address :DATA-maps)

  ; end linker
  ; ///
  (periph-addresses)
  :flip0 (write-value-64 0)
  :flip1 (write-value-64 0)
  :dELAY (write-value-64 $FFFFF)
  :dELAY2 (write-value-64 200000)
  :VC_MBOX (write-value-64 VCORE-MBOX)
  :TEST (write-value-64 $123456789ABCDEF)
:START (write-value-64 $800000) ; stack location
:CONVERT (write-value-64 $3FFFFFFF)
:HCR-VALUE (write-value-64 HCR_VALUE)
:SCTLR-VALUE-MMU-DISABLED (write-value-64 SCTLR_VALUE_MMU_DISABLED2)
:SCTLR-VALUE-MMU-ENABLED (write-value-64 SCTLR_VALUE_MMU_ENABLED)
:SCR-VALUE (write-value-64 SCR_VALUE)
:SPSR-VALUE (write-value-64 SPSR_VALUE)
:CPACR_EL1_VAL (write-value-64 CPACR_EL1_VAL)
:TCR_EL1_VAL(write-value-64 TCR_EL1_VAL)
:MAIR_VALUE (write-value-64 MAIR_VALUE)
:FAKE-ISR (write-value-64 $10000)
:CURRENT-PAGE (write-value-64 0)
:FRAME-SIZE (write-value-64 (* width height 4))
:ROW-SIZE (write-value-64 (* width 4))

:VMEM (write-value-64 0)
:pointAX(write-value-64 10)
:pointAY(write-value-64 10)
:pointBX(write-value-64 100)
:pointBY(write-value-64 100)
:finished-rendering (write-value-64 0)
:frame-count (write-value-64 0)
:execute-once (write-value-64 0)
:time (write-value-64 0)
:sizes
(write-value-32 1)
(write-value-32 2)
(write-value-32 4)
(write-value-32 8)
(write-value-32 16)
(write-value-32 32)
(write-value-32 64)
(write-value-32 128)
(write-value-32 256)
(write-value-32 512)
(write-value-32 1024)
(write-value-32 2048)
(write-value-32 0)

(define-syntax-parser execute-once
  ([_ body]
   #'{
      ldr x0 execute-once:
      cbz execute-once-skip:
      mov x0 @0
      (preserve [x1] {
        adr x1 execute-once:
        str x0 [x1]                        
      })                
    :execute-once-skip  
     }))
  to communicate with the video core gpu we need an address that
  is 16 - byte algined - the lower 4 bits are not set . these are then
  ; used to specify the channel
  /= 16
  :MBOX-MSG
    (write-value-32 (* 39 4)) ; total buffer size bytes including headers
    (write-value-32 0) ; request / response code (0 = request)
    ;begin tags
    ; set physical 
      (write-value-32 $48003)
      (write-value-32 8) ; value buffer size
      (write-value-32 0) ; 0 = request
      (write-value-32 width) ; width
      (write-value-32 height); height
    ; set virt
      (write-value-32 $48004)
      (write-value-32 8) ; value buffer size
      (write-value-32 8) ; 0 = request
      (write-value-32 width) ; width
      (write-value-32 (* 2 height)); height

  set virtoff
      (write-value-32 $48009)
      (write-value-32 8) ; value buffer size
      (write-value-32 0) ; 0 = request
      (write-value-32 0) ; x
      (write-value-32 (/ height 2)); y

   ; set depth 
      (write-value-32 $48005)
      (write-value-32 4) 
      (write-value-32 4) 
  bpp

   ; set pxlorder
      (write-value-32 $48006)
      (write-value-32 4) 
      (write-value-32 4) 
  RGB


   ; set alpha
      (write-value-32 $48007)
      (write-value-32 4) 
      (write-value-32 4) 
      (write-value-32 0) ; alpha off

   ; get fb
      (write-value-32 $40001)
      (write-value-32 8) 
      (write-value-32 8) 
:fb
      (write-value-32 4096) ; FramebufferInfo.pointer
      (write-value-32 0) ; FramebufferInfo.size

   ; get pitch
      (write-value-32 $40008)
      (write-value-32 4) 
      (write-value-32 4) 
:bpl      (write-value-32 0) ; bytes per line


    (write-value-32 0) ;end tag
;;   /= 16
;;   :MBOX-VOFFSET-MSG
      ( write - value-32 ( * 8 4 ) ) ; total buffer size bytes including headers
;;     (write-value-32 0) ; request / response code (0 = request)
;;     ;begin tags
      ; set virtoff
        ( write - value-32 $ 48009 )
;;       (write-value-32 8) ; value buffer size
   :  - req
;; (write-value-32 0) ; 0 = request
;;       (write-value-32 0) ; x
     :  - y
;;       (write-value-32 0); y
;;     (write-value-32 0) ;end tag

; wolf lets you resize the viewport and thus it recalcualtes various projection bits
  our version is hardcoded at 320 * 160 ( no border ) so we can calculate the bits at compile time
/= 8
 uses a lot of global state !
:postsource (write-value-64 0) ; pointer to texture column data
:debug-flag (write-value-64 (* 360 4))
:focallength (write-value-32 $5700)
:scale (write-value-32 128)
:heightnumerator (write-value-32 223232)
:viewx (write-value-32 0)
:viewy (write-value-32 0)
:viewsin (write-value-32 0)
:viewcos (write-value-32 0)
:vbufPitch (write-value-32 320)
:xpartialup (write-value-32 0)
:xpartialdown (write-value-32 0)
:ypartialup (write-value-32 0)
:ypartialdown (write-value-32 0)
:xintercept (write-value-32 0)
:yintercept (write-value-32 0)
:pixx (write-value-32 0)
:texdelta (write-value-32 0)
:lastside (write-value-32 0)
:lasttilehit (write-value-32 0)
:lasttexture (write-value-32 0)
:lastintercept (write-value-32 0)
:postx (write-value-32 0)
  these next ones are shorts but we 'll store them as 4 bytes
:tilehit (write-value-32 0)
:viewangle (write-value-32 0)
:midangle (write-value-32 0)
:angle (write-value-32 0)
:xstep (write-value-32 0)
:ystep (write-value-32 0)
:xtile (write-value-32 0)
:ytile (write-value-32 0)
:xtilestep (write-value-32 0)
:ytilestep (write-value-32 0)
:viewtx (write-value-32 0)
:viewty (write-value-32 0)
:focaltx (write-value-32 0)
:focalty (write-value-32 0)
:xspot (write-value-32 0)
:yspot (write-value-32 0)
; end shorts

/= $1000
:id_pgd
  $ 6000
(write-value-64 $BADF00D)
(write-value-64 $BADF00D)
(define viewwidth 320)
(define halfview (/ viewwidth 2))
(define facedist (+ 0.0 #x5700 MINDIST))
(define scale 128)
(define heightnumerator 223232)
(define radtoint 572.9578)
/= 8
:pixelangle
(let ([vec (make-vector viewwidth)]
      [calcangle (λ (i)
         (define tang (/(* i #x10000) viewwidth facedist))
         (define ang (atan tang))
         (define intang  (inexact->exact (floor (* ang radtoint))))
         intang)])
  (for ([i (in-range halfview)])
    (let* ([ang (calcangle i)]
           [nang (- ang)])
      (vector-set! vec (- halfview 1 i) ang)
      (vector-set! vec (+ halfview i) nang)))
  (for ([v vec])
     (  v )
    (write-value-16 v)
    ))

(define GLOBAL1 (arithmetic-shift 1 16))
; next up is the tangent table
/= 8
:finetangent
(let ([vec (make-vector (/ FINEANGLES 4))])
  (for ([i (in-range (/ FINEANGLES 8))])
    (define tang (tan (/ (+ i 0.5) radtoint)))
    (vector-set! vec i (inexact->exact (floor (* tang GLOBAL1))))
    (vector-set! vec (- (/ FINEANGLES 4) 1 i) (inexact->exact (floor (* (/ 1 tang) GLOBAL1)))))
  (for ([v vec])
    (write-value-32 v)))

; now for sin / cos
  costable overlays sintable with a quarter phase shift
(define anglestep (/ pi 2 ANGLEQUAD))
/= 8
:costable (write-value-64 0)  ; pointer into sintable
  costable is : sintable + ( ANGLEQUAD * 4 ( since its 32bits ) ) ( or in this case , just ANGLES ! )
(let ([vec (make-vector (+ ANGLES ANGLEQUAD))])
  (define ang 0)
  (for ([i (in-range ANGLEQUAD)])
    (define value (inexact->exact (floor (* (sin ang) GLOBAL1))))
    (vector-set! vec i value)
    (vector-set! vec (+ i ANGLES) value)
    (vector-set! vec (- (/ ANGLES 2) i) value)

    (vector-set! vec (- ANGLES i) (- value))
    (vector-set! vec (+ (/ ANGLES 2) i) (- value))

    (set! ang (+ ang anglestep))
    
    )
  (vector-set! vec ANGLEQUAD 65536)
  (vector-set! vec (* 3 ANGLEQUAD) -65536)
  (for ([v vec])
    (write-value-32 v)))

/= 8
; palette (only used for backgroudn colours)
:palette
(let*
    ([lines  (file->lines "wolfpal.inc")]
     [splits  (map (λ (line) (string-split line "RGB")) lines)]
     [clean  (map (λ (line) (string-replace (string-replace line ")" "") "(" "")) (flatten splits))]
     [rgbs (map (λ (line) (string-split line ",")) clean)])
  (for ([rgb rgbs])
    (write-value (string->number (string-trim (list-ref rgb 2))))
    (write-value (string->number (string-trim (list-ref rgb 1))))
    (write-value (string->number (string-trim (list-ref rgb 0))))
    (write-value 255)))


})



 size of all saved registers
 ***************************************
 ***************************************
 ***************************************
 ***************************************
 ***************************************
 ***************************************
 architectural feature access control register
 // don't trap SIMD/FP registers
  // don't trap SVE instructions
 no cache
(define MT_NORMAL_NC_FLAGS  		$A0) ; cacheable!
 cacheable!
 cacheable !
 cacheable ! normal , outer write - trhough transient , allocate allocate
(define MT_NORMAL_NC_FLAGS  		$ff) ; cacheable! outer write back transiert
        (PUSH x0 x1 x2 x3 x4 x5 x6 x7 x8)
invert value
 store new value
 set out or clear depending on value
invert value
 store new value
 set out or clear depending on value
mailbox offsets
 wolf bits
 if cpu zero then goto main:
 Set stack pointer 
(write-value-32 $d5181040)
 setup the mini-uart for debug comms
 =========== setup timer
 switch on interrupt conteroller
 we won't enable the interrupts just yet
 now we are going to ask for a frame buffer
 calculate costable pointer into sintable
 send framebuffer request
 isb
 SPEED TEST CODE
 ca n't do this post increase yet
    sub x8 x8 @1
    sub x3 x3 @1
 END SPEED TEST
     bl render-pic:
 set translation table base
 Set up translation table entries in memory with looped store instructions.
 Base address of level2_pagetable.
 AttrIdx=011 Normal Cacheable.
 gives us a framebuffer
 subs
 with an additional register we can remove this
 branch by using csel - debug code though so
 doesn't matter
 '.'
 time at end
time at start
 arguments 
 x0 will be the start address
 //////
 we are going to write                                            
 convert to ascii hex
 modify string with result
 convert to ascii hex
 modify string with result
 modify string with result
 x8 holds row count down
 address to write
 loop counter (+1)
 because we don't support and x x imm
 shift to byte
 convert to ascii hex
 modify string with result
 shift in next nibble
 
 spacer
 now for the ascii version
 initiate disassemble send
 send address         
 send count    
 send instructions
 initiate string send
 line feed
 mov w0 @$D ; cr
 bl  send-char:
 signal string end
       ([address x1]) [x0] {
   ; initiate string send
   mov w0 @1                       
   bl send-char:
   * address++
     bl send-char:
   })
 line feed
   ; signal string end
   mov w0 @0
   bl send-char:
 })
 x0 = address
 x1 = count
       ([x1 address]
        [x2 remaining]) [] {
 first print the address like so   " $ 00000000 : "
   bl send-char                               
 })                       
 total buffer size bytes including headers
 request / response code (0 = request)
begin tags
 virtual x pos
 total buffer size bytes including headers
 request / response code (0 = request)
begin tags
 alpha mode
 display the off-screen portion of the video memory
 that has been drawn to
 pass y value in x3
 reserve space on stack for v-offset message
 reserve space on stack for v-offset message
 pass message address in x8
 cache coherency
 attempt to call the mailbox interface
 expected to be in x8
 in this case mbox-ch-prop (8)
 send our message
 now wait for a response 
 check if mbox-read = channel
    (debug-reg x1)
 handle interrupts at el3                                            
 Abort / SError     
 returns a pointer to the current "back buffer"
 which is the area of video memory not currently
 being displayed
 if CURRENT-PAGE is 0 then we want to send
 pointer + ((height / 2) * width)
   (debug-str "HERE" #t)
 plots a single pixel 
 base video memory
 test routine that displays each texture on the screen
 this relies on the delay and image number loop
 from the gfx-update
 apply offset    
 texture size
 size * index
 start+offset
 now we are ready to copy
 move down a row in video memory
 test routine that displays each 2d picture on the screen
 this relies on the delay and image number loop
 from the gfx-update
 lookup the pic header info
    adr header DATA-2d-image-header:
 offset
 load struct
 base image ptr
 apply offset
 now we are ready to copy
 move down a row in video memory
 core render loop
 clear screen then call other rendering functions
 temporary / intermediates
 video memory pointer
(debug-str "render frame" #t)
 ===================
 clear screen
     mov x3 @0
 :next
     str x3 [vptr]
     str x3 (vptr @16)
     str x3 (vptr @24)
     sub temp temp @1
     cbnz temp next-
     mov vptr x0
 end clear screen
 ====================
 only once code 
 cbz x0 done+
 raycaster
 rotate player
 only once code
 sub temp temp @1
 str temp [x0]
signal render has finished
(debug-str "done frame" #t)
 DO NOT USE x0 AS TARGET!
 TODO: madd here when i implement it
 scales and draws a strip of pixels from a wall texture
  (debug-str "enter scalepost " #t)


  (debug-str-reg "yoffs " yoffs)
 yoffs += postx
  (debug-str-reg "yoffs " yoffs)

  (debug-str-reg "yendoffs " yendoffs)

  (debug-str-reg "yw " yw)
 this loops scales when the wall takes up more than the
 render (TODO)
 while(yendoffs >= viewheight)
  {
      ywcount -= TEXTURESIZE/2;
      while(ywcount <= 0)
      {
          ywcount += yd;
          yw--;
      }

  }
  if(yw < 0) return;
col = postsource[yw]

  (debug-str-reg "yendoffs before loop " yendoffs)
  (debug-str "entering loop .." #t)
    (debug-str-reg "loop yoffs " yoffs)
 write pixel data to video memory
ywcount -= TEXTURESIZE/2
     (debug-str-reg "ywcount " ywcount)
      (debug-str-reg "yw " yw)
col = postsource[yw]
      (debug-str-reg "col is " col)      
  (debug-str "exit scalepost " #t)            
  (debug-str "in hithorizwall" #t)
texture = ((xintercept+texdelta)>>TEXTUREFROMFIXEDSHIFT)&TEXTUREMASK;  
  (debug-str-reg "texture " w10)
if ytilestep == -1
 -1

else 
 texture = TEXTUREMASK-texture

lastside = 0
lasttilehit = tilehit
wallheight[pixx] = CalcHeight()
 (debug-str-reg "calcheight " x0)
 wallpic = horizwall[tilehit ]   ;
postsource = PM_GetTexture(wallpic) + texture
 this is a bit different for us since we don't
 have a page manager and are not using palette indexes.
 texture size
 size * index
 start+offset
 now we are pointing at the start of image
  (debug-str "in hitvertwall" #t)
texture = ((yintercept+texdelta)>>TEXTUREFROMFIXEDSHIFT)&TEXTUREMASK;  
  (debug-str-reg "texture " w10)
if xtilestep == -1
 -1
 texture = TEXTUREMASK-texture


lasttilehit = tilehit
wallheight[pixx] = CalcHeight()
  (debug-str-reg "calcheight " x0)
 wallpic = vertwall[tilehit ]   ;
postsource = PM_GetTexture(wallpic) + texture
 this is a bit different for us since we don't
 have a page manager and are not using palette indexes.
 texture size
 size * index
 start+offset
 now we are pointing at the start of image

  (debug-str-reg "xintercept " w10)
  (debug-str-reg "fixed2 " x21)
 x10 = z
 (debug-str-reg "z " w10)
 if (z < mindist) z = mindist
  (debug-str-reg "asr z " w10)
  (debug-str-reg "numerator " w11)
  (debug-str-reg "udiv " w10)
 pretty sure this code isn't used/*
       min_wallheight = height;
   */
 NOTE: this function uses x10+ for all item temporaries, except the named ones above
 this is the actual raycaster
  (debug-str "enter asm referesh" #t)          
 for each X column of the screen ..
    (debug-str "pixx loop" #t)
    (debug-str-reg "LOOPINDEX " local-pixx)
 store global pixx (keep in sync with loop counter)
 perform angle calcs
    (debug-str-reg "pixelangle[pixx] = " w0)
    (debug-str-reg "+midangle = " w0)
         (debug-str "angl < 900" #t)
 TODO: need movn / neg
 -1
 w11 index
         (debug-str-reg "index " w11)
         (debug-str-reg "xstep " xstep)
 xpartial = xpartialup
         (debug-str-reg "xpartial " xpartial)
         (debug-str-reg "ypartial " ypartial)
 -1
 xstep = -finetangent[angl-900]
 w11 index
 angle - 900
         (debug-str-reg "index " w11)
         (debug-str-reg "xstep " xstep)
         (debug-str-reg "xpartial " xpartial)
         (debug-str-reg "ypartial " ypartial)
 -1
 w11 index
 
         (debug-str-reg "index " w11)
         (debug-str-reg "xstep " xstep)
         (debug-str-reg "xpartial " xpartial)
         (debug-str-reg "ypartial " ypartial)
 xstep = finetangent[angl-2700]
 w11 index
 
         (debug-str-reg "index " w11)
         (debug-str-reg "xstep " xstep)
         (debug-str-reg "xpartial " xpartial)
         (debug-str-reg "ypartial " ypartial)
    (debug-str-reg "yintercept " w0)
 w12 = yintercept (used in a moment)
    (debug-str-reg "xtile " w10)
    (debug-str-reg "xspot " w0)
xintercept = FixedMul(xstep,ypartial) + viewx
    (debug-str-reg "xintercept " w0)
 w12 = xintercept (used in a moment)
ytile = focalty + ytilestep
        (debug-str-reg "focalty " w10)
            (debug-str-reg "ytilestep " w11)
    (debug-str-reg "ytile " w10)
    (debug-str-reg "yspot " w0)
  special pushwall handling (TODO)
 begin raycasting loop
    (debug-str-reg "asr " w11)
 w12 = -1
 if(xspot > maparea) break;
 tilehit = tilemap[xspot]
    (debug-str-reg "tilehit " w0)
if tilehit
TODO: a bunch of door and pushwall stuff
      (debug-str-reg "HIT V " w0)                 
xintercept=xtile<<TILESHIFT;
      (debug-str "1 " #t)
ytile = (short) (yintercept >> TILESHIFT);
 todo spotvis update when we take on sprites
xtile += xtilestep
    (debug-str-reg "xspot v " w0)
 w12 = -1
 tilehit = tilemap[yspot]
    (debug-str-reg "tilehit " w0)
if tilehit
TODO: a bunch of door and pushwall stuff
      (debug-str-reg "HIT H " w0)                 
yintercept=ytile<<TILESHIFT;
xtile = (short) (xintercept >> TILESHIFT);
break
 todo spotvis update when we take on sprites
ytile += ytilestep
    (debug-str-reg "ytile " w10)
    (debug-str-reg "ytilestep " w11)
    (debug-str-reg "ph ytile " w10)
xintercept += xstep
    (debug-str-reg "xintercept " w12)
    (debug-str-reg "xstep " xstep)
    (debug-str-reg "ph xintercept " w10)
   (debug-str-reg "yspot h " w0)
 ; debug
 ; end debug
 ; debug
 (debug-str-reg "xpartialup is " x0)
 ; end debug
  (debug-str-reg "viewy is " w0)
  (debug-str-reg "result is " w0)
 ; debug
 ; end debug
 ; debug
 (debug-str-reg "ypartialup is " x0)
 ; end debug
 lastside = -1
 first we'd clear spotvis that will detect sprite hits
 but we are not doing this yet     
 ===============
 CalcViewVariables
 player: is a pointer!
 viewangle = ply->angle    
 ; debug
 (debug-str-reg "viewangle is " x0)
 ; end debug
midangle = viewangle * (FINEANGLES/ANGLES)
 debug
  (debug-str-reg "midangle is " x0)
 end debug
 offset registers optionally shifted
 debug
 end debug
 ; debug
 (debug-str-reg "viewy is " x0)
 ; end debug
 ; debug
 (debug-str-reg "focalty is " x0)
 ; end debug
 viewcos = costable[viewangle]
 tmep = viewangle
 costable is a pointer
   ; debug
 ; end debug
 ; debug
 (debug-str-reg "viewx is " x0)
 ; end debug
 ; debug
 (debug-str-reg "focaltx is " x0)
 ; end debug
 ; debug
 (debug-str-reg "viewtx is " x0)
 ; end debug
 ; debug
 (debug-str-reg "viewty is " x0)
 ; end debug
 =================
 ==================
 old gfx code that does the slideshows
                   [temp x4] ; temporary / intermediates
                   [tptr x8]
                   [vptr x9] ; video memory pointer
                   [row-size x14]
                   ) [x0 x1 x2 x3 x4]
                     {
 :loop
     bl get-back-buffer:
     mov vptr x0
     ; ===================
     ; clear screen
 we do 8 pixels each iteration so
 we need 320 * 200/8 = $ 1F40 iterations
     mov x3 @0
 :next
     str x3 [vptr]
     str x3 (vptr @16)
     str x3 (vptr @24)
     sub temp temp @1
     cbnz temp next-
     mov vptr x0
     ; end clear screen
     ; ====================
 x27 holds a delay
     ; this should be in memory
     ; since we never even push these!
 x28 holds next picture to display
     ; also can easily be trashed!
     sub x28 x28 @1
     cbnz x28 skip+
 130 for 2d pics , 105 for textures
 :skip    
     mov x0 vptr
     mov x1 x28
     mov x1 @15
     :   ; render 2d pics
     bl render-tex:   ; render 2d textures
     ;signal render has finished
     mov temp @1
     str temp [w0]
     b loop-
    })
 interrupt handler
 at the moment we are expecting only the
 here we only flip the pge if the renderer
 has actualy finished
(debug-str "handled interrupt" #t)
 ; ldr   :
 ;   
 ; str w1 (   )
 ack vsync
 only flip if render finished
  (debug-str "flip" #t)
 //////////////////////////////////////////////
 //////////////////////////////////////////////
 *state
 *next objstruct
 *prev objstruct
 signed; if negative, wait for that door to open
 signed  
 fixed point
 fixed point
 fixed, in global coord
 fixed, in global coord
 setup the walls and actors
 x2 will point at the 2d byte array tilemap          
 this is a linker resolved label
 for some reason the map is stored sideways compared to the raw data
 so we have to calculate the index here;
 x is the row and y is the offset [x][y]
 for now we assign the player to actors[0]
 in the future this needs to be in InitActorList
 and it must update the freelist etc.         
 for now we only have a player and it is hardcoded         
 player = objlist[0]
 tiley = tiley
 this is a linker resolved label
 y = (tiley << TILESHIFT) + (TILEGLOBAL/2) (fixed point)
 the last bits are state, angle and flags.
 state we don't care about for now
 (debug-str "obclass" #t)
 (debug-reg temp)
 (debug-str "active" #t)
 (debug-reg temp)
 (debug-str "tilex" #t)
 (debug-reg temp)
 (debug-str "tiley" #t)
 (_objstruct/tiley-get temp ptr)
 (debug-reg temp)
 (debug-str "areanumber" #t)
 (_objstruct/areanumber-get temp ptr)
 (debug-reg temp)
 (debug-str "x" #t)
 (_objstruct/x-get temp ptr)
 (debug-reg temp)
 (debug-str "y" #t)
 (debug-reg temp)
 for now we are only going to spawn the player        
 this is a linker resolved label          
 call spawn-player with x, y, (tile - 19)
 calculate direction
 ///////////////////////////////////////////////////////
 wolfenstein GAME STATE VARIABLES
 ///////////////////////////////////////////////////////
 wall locations (byte[64][64])
 actor locations (ptr[64][64]
 objstruct*
 resolve-global-label-address will tell the linker to write the absolute
 address of the exported labels here, post-link.  These might be quite far away and
 as such out of range of the adr instruction and some jumps.
 end linker
 ///
 stack location
 used to specify the channel
 total buffer size bytes including headers
 request / response code (0 = request)
begin tags
 set physical 
 value buffer size
 0 = request
 width
 height
 set virt
 value buffer size
 0 = request
 width
 height
 value buffer size
 0 = request
 x
 y
 set depth 
 set pxlorder
 set alpha
 alpha off
 get fb
 FramebufferInfo.pointer
 FramebufferInfo.size
 get pitch
 bytes per line
end tag
   /= 16
   :MBOX-VOFFSET-MSG
 total buffer size bytes including headers
     (write-value-32 0) ; request / response code (0 = request)
     ;begin tags
 set virtoff
       (write-value-32 8) ; value buffer size
 (write-value-32 0) ; 0 = request
       (write-value-32 0) ; x
       (write-value-32 0); y
     (write-value-32 0) ;end tag
 wolf lets you resize the viewport and thus it recalcualtes various projection bits
 pointer to texture column data
 end shorts
 next up is the tangent table
 now for sin / cos
 pointer into sintable
 palette (only used for backgroudn colours)
#lang pisemble
(require (for-syntax syntax/parse racket/stxparam racket/syntax))
(require syntax/parse/define)

(require racket/stxparam)
(require racket/file)
(require racket/string)
(require racket/match)
(require racket/math)
(require threading)
(require "periph.rkt" "stack.rkt" "struct.rkt" "expr.rkt")

(define SYNC_INVALID_EL1t 0)
(define IRQ_INVALID_EL1t 1)
(define FIQ_INVALID_EL1t 2)
(define ERROR_INVALID_EL1t 3)

(define SYNC_INVALID_EL1h 4)
(define IRQ_INVALID_EL1h 5)
(define FIQ_INVALID_EL1h 6)
(define ERROR_INVALID_EL1h 7)

(define SYNC_INVALID_EL0_64 8)
(define IRQ_INVALID_EL0_64 9)
(define FIQ_INVALID_EL0_64 10)
(define ERROR_INVALID_EL0_64 11)

(define SYNC_INVALID_EL0_32 12)
(define IRQ_INVALID_EL0_32 13)
(define FIQ_INVALID_EL0_32 14)
(define ERROR_INVALID_EL0_32 15)

(define SYSTEM_TIMER_IRQ_0 1)
(define SYSTEM_TIMER_IRQ_1 %10)

(define SCTLR_RESERVED
  (bitwise-ior (arithmetic-shift 3 28)
               (arithmetic-shift 3 22)
               (arithmetic-shift 1 20)
               (arithmetic-shift 1 11)))
(define SCTLR_EE_LITTLE_ENDIAN          (arithmetic-shift 0 25))
(define SCTLR_EOE_LITTLE_ENDIAN         (arithmetic-shift 0 24))
(define SCTLR_I_CACHE_DISABLED          (arithmetic-shift 0 12))
(define SCTLR_D_CACHE_DISABLED          (arithmetic-shift 0 2))
(define SCTLR_I_CACHE_ENABLED           (arithmetic-shift 1 12))
(define SCTLR_D_CACHE_ENABLED           (arithmetic-shift 1 2))
(define SCTLR_MMU_DISABLED              (arithmetic-shift 0 0))
(define SCTLR_MMU_ENABLED               (arithmetic-shift 1 0))
(define SCTLR_BP_ENABLED           (arithmetic-shift 1 11))

(define SCTLR_VALUE_MMU_DISABLED  (bitwise-ior SCTLR_RESERVED SCTLR_EE_LITTLE_ENDIAN SCTLR_I_CACHE_DISABLED SCTLR_D_CACHE_DISABLED SCTLR_MMU_DISABLED))
(define SCTLR_VALUE_MMU_DISABLED2  (bitwise-ior SCTLR_RESERVED SCTLR_EE_LITTLE_ENDIAN SCTLR_I_CACHE_ENABLED SCTLR_D_CACHE_DISABLED SCTLR_MMU_DISABLED))
(define SCTLR_VALUE_MMU_ENABLED  (bitwise-ior SCTLR_RESERVED SCTLR_EE_LITTLE_ENDIAN SCTLR_I_CACHE_ENABLED SCTLR_D_CACHE_ENABLED SCTLR_MMU_ENABLED))

  HCR_EL2 , Hypervisor Configuration Register ( EL2 ) , Page 2487 of AArch64 - Reference - Manual .

(define HCR_RW            (arithmetic-shift 1 31))
(define HCR_VALUE     HCR_RW)

  SCR_EL3 , Secure Configuration Register ( EL3 ) , Page 2648 of AArch64 - Reference - Manual .

(define SCR_RESERVED          (arithmetic-shift 3 4))
(define SCR_RW        (arithmetic-shift 1 10))
(define SCR_NS        (arithmetic-shift 1 0))
(define SCR_VALUE             (bitwise-ior SCR_RESERVED SCR_RW SCR_NS))

  SPSR_EL3 , Saved Program Status Register ( EL3 ) Page 389 of AArch64 - Reference - Manual .

(define SPSR_MASK_ALL       (arithmetic-shift 7 6))
(define SPSR_EL1h     (arithmetic-shift 5 0))
(define SPSR_VALUE      (bitwise-ior SPSR_MASK_ALL SPSR_EL1h))

(define CPACR_EL1_VAL     (bitwise-ior CPACR_EL1_FPEN CPACR_EL1_ZEN))

(define TCR_TG1_4K     (arithmetic-shift 2 30))
(define TCR_T1SZ       (arithmetic-shift (- 64 48) 16))
(define TCR_TG0_4K     (arithmetic-shift 0 14))
(define TCR_T0SZ       (- 64 48))

(define TCR_EL1_VAL    (bitwise-ior TCR_TG1_4K TCR_T1SZ TCR_TG0_4K TCR_T0SZ))

  mmu bits
(define MT_DEVICE_nGnRnE 		$0)
(define MT_NORMAL_NC			$1)
(define MT_DEVICE_nGnRnE_FLAGS		$00)
(define MAIR_VALUE			(bitwise-ior (arithmetic-shift MT_DEVICE_nGnRnE_FLAGS (* 8 MT_DEVICE_nGnRnE)) (arithmetic-shift MT_NORMAL_NC_FLAGS (* 8 MT_NORMAL_NC))))

(define TD_VALID                   (arithmetic-shift 1 0))
(define TD_BLOCK                   (arithmetic-shift 0 1))
(define TD_TABLE                   (arithmetic-shift 1 1))
(define TD_ACCESS                  (arithmetic-shift 1 10))
( define              $ 43 )
(define MATTR_NORMAL_NC            $40)
(define MATTR_DEVICE_nGnRnE_INDEX  0)
(define MATTR_NORMAL_NC_INDEX      1)
(define TD_KERNEL_PERMS            (arithmetic-shift 1 54))
(define TD_INNER_SHARABLE          (arithmetic-shift 3 8))

(define TD_KERNEL_TABLE_FLAGS      (bitwise-ior TD_TABLE  TD_VALID))
(define TD_KERNEL_BLOCK_FLAGS      (bitwise-ior TD_ACCESS TD_INNER_SHARABLE TD_KERNEL_PERMS (arithmetic-shift MATTR_NORMAL_NC_INDEX 2) TD_BLOCK TD_VALID))
(define TD_DEVICE_BLOCK_FLAGS      (bitwise-ior TD_ACCESS TD_INNER_SHARABLE TD_KERNEL_PERMS (arithmetic-shift MATTR_DEVICE_nGnRnE_INDEX 2) TD_BLOCK TD_VALID))


(define PAGE_SHIFT 12)
(define TABLE_SHIFT 9)
(define SECTION_SHIFT (+ PAGE_SHIFT  TABLE_SHIFT))
(define PAGE_SIZE (arithmetic-shift 1 PAGE_SHIFT))
(define SECTION_SIZE (arithmetic-shift 1 SECTION_SHIFT))

(define PGD_SHIFT              (+ PAGE_SHIFT (* 3 TABLE_SHIFT)))
(define PUD_SHIFT              (+ PAGE_SHIFT (* 2 TABLE_SHIFT)))
(define PMD_SHIFT              (+ PAGE_SHIFT  TABLE_SHIFT))
(define PUD_ENTRY_MAP_SIZE     (arithmetic-shift 1 PUD_SHIFT))
(define BLOCK_SIZE $40000000)
(define-syntax (kernel-entry stx)
  (syntax-parse stx
    [(_)
     #'{

        sub sp sp @s-frame-size
        stp x0 x1   [sp @(* 16 0)]
        stp x2 x3   [sp @(* 16 1)]
        stp x4 x5   [sp @(* 16 2)]
        stp x6 x7   [sp @(* 16 3)]
        stp x8 x9   [sp @(* 16 4)]
        stp x10 x11 [sp @(* 16 5)]
        stp x12 x13 [sp @(* 16 6)]
        stp x14 x15 [sp @(* 16 7)]
        stp x16 x17 [sp @(* 16 8)]
        stp x18 x19 [sp @(* 16 9)]
        stp x20 x21 [sp @(* 16 10)]
        stp x22 x23 [sp @(* 16 11)]
        stp x24 x25 [sp @(* 16 12)]
        stp x27 x27 [sp @(* 16 13)]
        stp x28 x29 [sp @(* 16 14)]
        str x30 [sp @(* 16 15)]

        }]))
(define-syntax (kernel-exit stx)
  (syntax-parse stx
    [(_)
     #'{
        ldp x0 x1   [sp @(* 16 0)]
        ldp x2 x3   [sp @(* 16 1)]
        ldp x4 x5   [sp @(* 16 2)]
        ldp x6 x7   [sp @(* 16 3)]
        ldp x8 x9   [sp @(* 16 4)]
        ldp x10 x11 [sp @(* 16 5)]
        ldp x12 x13 [sp @(* 16 6)]
        ldp x14 x15 [sp @(* 16 7)]
        ldp x16 x17 [sp @(* 16 8)]
        ldp x18 x19 [sp @(* 16 9)]
        ldp x20 x21 [sp @(* 16 10)]
        ldp x22 x23 [sp @(* 16 11)]
        ldp x24 x25 [sp @(* 16 12)]
        ldp x26 x27 [sp @(* 16 13)]
        ldp x28 x29 [sp @(* 16 14)]
        ldr x30 [sp @(* 16 15)]
        add sp sp @s-frame-size
        eret
        }]))

(define-syntax-parser inc [(_ reg:register) #'{ add reg reg @1 }])
(define-syntax-parser dec [(_ reg:register) #'{ sub reg reg @1 }])

(define-syntax (handle-invalid-entry stx)
  (syntax-parse stx
    [(_ type)
     #'{
        mov x0 @type
        mrs x1 esr_el1
        mrs x2 elr_el1
        bl show-invalid-entry-message:
        b err-hang:
        }
     ]))

(define-syntax (wait stx)
  (syntax-parse stx
    [(_ value)
     #'{ldr x2 value
        :inner
        sub x2 x2 @1
        cbnz x2 inner- }]))

(define-syntax (debug-reg stx)
  (syntax-parse stx
    [(_ r:register)
     #'{
  preserve  , it is used for passing char to send - char
        (PUSH x0) 
        (PUSH r)
  first send code indicating whether a 32 or 64 bit number will be sent
        mov w0 @(if `r.is32 2 3)
        bl send-char:
  restore r into  and send first char
        (POP x0)   
        bl  send-char:
  shift and send the remaining 3 or 7 bytes
        (for ([_ (in-range (if `r.is32 3 7))])
          { lsr x0 x0 @8
            bl send-char: })
  restore x0 original value
        (POP x0) }]
    [(_ r:register rn:register ...+)
     #'(begin (debug-reg r)
              (debug-reg rn ...))]))

(define-syntax-parser debug-str-reg
  [(_ str:string reg:register)
   #'{
      (debug-str str #f)
      (debug-reg reg)
     }])

(define-syntax (dump-all-regs stx)
  (syntax-parse stx
    [(_)
     #:with (reg ...) (for/list ([i (in-range 0 31)])
                   (datum->syntax this-syntax (string->symbol (format "X~a"i))))
     #:with (name ...) (for/list ([i (in-range 0 31)])
                   (datum->syntax this-syntax (format "X~a "i)))
     #'(begin (begin (debug-str name #f) (debug-reg reg)) ...)]))


  the vector table is layed out 0x80 bytes apart
(define-syntax (ventry stx)
  (syntax-parse stx
    [(_ vector:label-targ)
     #'{
        /= $80        
        b vector
       }]
    [(_ vector:label-targ more ...+)
     #'{
        /= $80        
        b vector
        (ventry more ...)
       }]))

(define VCORE-MBOX (+ PERIPH-BASE $00B880))

(define-syntax-parser flip-gpio0
  [(_) #'{
          (preserve [x0 x1] {
            ldr x1 flip0:                   
            mov x0 @1
            eor x1 x1 x0
            adr x0 flip0:
            str x1 [x0]
            (/if (x1 eq @0)
              {
               mov x1 @1
               ldr x0 GPIOSET0:
               str w1 [x0]
              }
              {
                mov x1 @1
                ldr x0 GPIOCLEAR0:
                str w1 [x0]
              })
          })                             
          }])

(define-syntax-parser flip-gpio1
  [(_) #'{
          (preserve [x0 x1] {
            ldr x1 flip1:                   
            mov x0 @1
            eor x1 x1 x0
            adr x0 flip1:
            str x1 [x0]
            (/if (x1 eq @0)
              {
               mov x1 @%10
               ldr x0 GPIOSET0:
               str w1 [x0]
              }
              {
                mov x1 @%10
                ldr x0 GPIOCLEAR0:
                str w1 [x0]
              })
          })                             
         }])

  TIMER bits
(define     TIMERBase #x40000000)
(define      timerFrequency 10000000)
(define     crystalFrequency 19200000)
(define     prescaler 
     (quotient
      (+
       (* (arithmetic-shift 1 31) timerFrequency)
       (quotient crystalFrequency 2))
      crystalFrequency))

(aarch64 "kernel8.img" ["2dgfx.obj" "textures.obj" "maps.obj"] {
     width = 320
     height = 200      

     mbox-read = $0
     Mbox-poll = $10
     mbox-sender = $14
     mbox-status = $18
     mbox-config = $1c
     mbox-write = $20
     mbox-response = $80000000
     mbox-full     = $80000000
     mbox-empty    = $40000000

Mailbox channels
  request to VC from ARM

     
     TILESHIFT = 16
     TILEGLOBAL = (arithmetic-shift 1 16)
     TILEGLOBAL/2 = (/ TILEGLOBAL 2)
     ANGLES = 360
     FINEANGLES = 3600
     ANGLEQUAD = (/ 360 4)
     VIEWHEIGHT = 160
     VIEWWIDTH = 320
     TEXTUREMASK = 4032
     TEXTUREFROMFIXEDSHIFT = 4
     MINDIST = $5800
     TEXTURESIZE = (arithmetic-shift 1 6)
     mrs x0 mpidr_el1
     mov x1 @$3
     and x0 x0 x1
     cbz x0 main:
     b hang:
 
:err-hang
     b err-hang-    

:hang
     wfe
     b hang-     

:main

    ldr x1 START:
    mov sp x1

      msr      cpacr_el1 ,    Enable FP / SIMD at EL1

    (init-uart)
    (debug-str "uart up1" #t)

  set  0 and 1 to output
    ldr x0 GPFSEL:
    mov x1 @%001001
    str w1 [x0]

   (debug-str "done!!!" #t)
    

  nop
    (load-immediate x1 TIMERBase)
    (load-immediate x0 prescaler)
    str w0 [x1 @$8]
    

    (debug-str "init irq vector" #t)    
  setup IRQ vectors
    bl irq-vector-init:
  for wolf this is the SMI interrupt only at the moment
  which is triggered by the screen vsync signal
    bl enable-interrupt-controller:
  clear the SMICS flag just in case .
    ldr x0 SMICS:
    mov x1 @0
    str w1 [x0]

    adr x0 MBOX-MSG:
    (debug-reg w0)
    ldrb w0 (x0 @0)
    (debug-reg w0)
    
    (debug-str "loading level.." #t)
    bl setup-game-level:
    bl scan-info-plane:

    adr x1 sintable:
    (debug-str-reg "sintable address " x1)
  here we want to do sintable+90 ( 360/4 )    
  but since they are 4 bytes each we can
  simply use 360 since we 'd have to < < 2 anway

    (load-immediate x0 ANGLES)
    add x0 x1 x0
  index 0 seems to be 65537 instead of 65536 ! ? check this
    str x0 [x1]
    (debug-str-reg "costable address " x0)
               
    adr x0 fb:
    ldr w0 [x0]

    adr x8 MBOX-MSG:
    bl send-vcore-msg:
    (debug-str "bpl" #t)

    adr x0 bpl:
    ldr w0 (x0 @0)
    (debug-reg x0)

    (debug-str "fb addr" #t)
    adr x0 fb:
    ldr w0 (x0 @0)
    (debug-reg x0)

convert to gpu address
    ldr x1 CONVERT:
    and x0 x0 x1
    (debug-str-reg "fb addr converted" x0)

  X8 holds base video memory
    adr x9 VMEM:
  store memory pointer in VMEM

    (debug-str-reg "vptr is " x8)
enable mmu
    bl init-mmu:
  mrs  

    mov x1 @SCTLR_MMU_ENABLED
    orr x0 x0 x1

    mov x1 @SCTLR_I_CACHE_ENABLED
    orr x0 x0 x1

    mov x1 @SCTLR_D_CACHE_ENABLED
    orr x0 x0 x1


msr  

dsb sy
  mmu done


    adr x0 textures-address:
    (debug-str-reg "speed test at " x0)
    adr x1 sizes:
  :mloop2
    ldr w2 [x1] @4
    mov x9 x2
    (debug-str-reg "KB:" x2)
    cbz w2 mpause+

    lsl w2 w2 @3

    bl timer-start:
    mov x3 @256

  :mloop1
    adr x0 textures-address:    
    mov x8 x2
  :mloop3
    ldp x4 x5 [x0 @0] 
    add x0 x0 @16
    ldp x4 x5 [x0 @0] 
    add x0 x0 @16
    ldp x4 x5 [x0 @0] 
    add x0 x0 @16
    ldp x4 x5 [x0 @0] 
    add x0 x0 @16
    ldp x4 x5 [x0 @0] 
    add x0 x0 @16
    ldp x4 x5 [x0 @0] 
    add x0 x0 @16
    ldp x4 x5 [x0 @0] 
    add x0 x0 @16
    ldp x4 x5 [x0 @0] 
    add x0 x0 @16
    (write-value-32 $f1000508)
    b.ne mloop3-
    (write-value-32 $f1000463)
    b.ne mloop1-

    bl timer-stop:
    udiv x0 x0 x9
    (load-immediate x10 (quotient (* 1024 256 timerFrequency) (* 1024 1024)))
    udiv x0 x10 x0
    (debug-str-reg "MBytes per second " x0)
    b mloop2-
    
    
:mpause nop 

     (debug-str "DONEDONE" #t)


  begin triggering the vsync interrupt
     bl enable-irq:

     mov x1 @0
  130 for 2d pics , 105 for textures
     mov x27 @60

     mov x1 @15
     bl update-gfx:
 :loop
     b loop-


:init-mmu

  4k granule , 4  
(load-immediate x0 $3520)
  msr  

  2 memory attributes for normal cacheable and device memory
(load-immediate x0 $FF440400)
  msr MAIR_EL3 , 

adr x0 id_pgd:
   msr ttbr0_el3 , 

  Set the level 1 translation table .
  The first entry points to level2_pagetable .
  location 0 points at level 2 which is 4096 later
(load-immediate x3 $1000)
x10 is base level2 address
mov x3 @%11
  11 at end to set flags
str x1 [x0] @8

  AttrIdx=000 Device - nGnRnE.
  The second entry is 1 GB block from 0x40000000 to 0x7FFFFFFF .
  Executable Inner and Outer Shareable .
  R / W at all ELs secure memory

  The third entry is 1 GB block from 0x80000000 to 0xBFFFFFFF .
(load-immediate x2 $80000741)
str x2 [ x0 ] @8

  The fourth entry is 1 GB block from 0xC0000000 to 0xFFFFFFFF .
(load-immediate x2 $C0000741) 
str x2 [ x0 ] @8

  Set level 2 translation table . 512 x 2 mb blocks
  Executable Inner and Outer Shareable .

  R / W at all ELs secure memory .

mov x4 @512
(load-immediate x3 $200000)
mov x1 @$c
:loop
  str x2 [x0] @8
  increase 2 mb
  the last 32 mb we mark as device memory since the periphs are here .
  32 mb is too much really but also covers the area where the vcore
  cmp x4 @$20  
  b.ne doCache+
  @$c - from 74d to 741 which selects the other attribute
:doCache
  b.ne loop-

ret x30

(create-send-char)


:dump-regs
  (PUSH x30)
  (dump-all-regs)
  (POP x30)
  ret x30

(define-syntax-parser nibble->hex
  [(_ input:register )
      cmp input @10
      b.ge hex+
  add 48 ( 0 - 9 )
      b done+
  :hex
  add 65 ( A - F )
      :done}])

(define-syntax-parser bound-ascii
  [(_ input:register )
   #'{
     cmp input @$20
     b.ge done+
    :done}])



(subr timer-start () [x0 x1]  {
  (load-immediate x0 TIMERBase)
  ldr w0 [x0 @$1c]
  adr x1 time:
  str w0 [x1]
})  

(subr timer-stop () [x1]  {
  (load-immediate x0 TIMERBase)
  sub x0 x0 x1
   ( debug - str - reg " Time = "  )
  })

(define dump-template "0000000000000000 : 00 00 00 00 | 00 00 00 00 | 00 00 00 00 | 00 00 00 00 | 0000000000000000")
(subr memory-dump () [x0 x1 x2 x3 x4 x5 x6 x7 x8] {
  x1 will be the amount of rows to send ( * 4 32 bits + ascii )                                 
  00000000000012FF : FF FF FF FF | FF FF FF FF | FF FF FF FF | FF FF FF FF | asciiasciiascii .
  now we can skip ahead four in the output and read the first 32 bit value


  (define (write-byte) {
  top 4 bits first                    
  bottom 4 bits
    })

  (define (write-byte-raw) {
    (bound-ascii w3)
  })
                                              
  template-len = (string-length dump-template)
  (/whilenz x8 {
  first part is to overwrite the address with the requested address
    adr x6 memory-dump-template:
    (/whilenz x2 {
  mask the 4 bits
    })             



    mov x7 @4
    (/whilenz x7 {
      ldrb w3 [x0] @1
      (write-byte)
      add x6 x6 @1
      
      ldrb w3 [x0] @1
      (write-byte)
      add x6 x6 @1
      
      ldrb w3 [x0] @1
      (write-byte)
      add x6 x6 @1
      
      ldrb w3 [x0] @1
      (write-byte)
      add x6 x6 @3

      sub x7 x7 @1
    })

    sub x0 x0 @16
    mov x7 @16

    (/whilenz x7 {
      ldrb w3 [x0] @1
      (write-byte-raw)    
      sub x7 x7 @1
    })
    
    adr x1 memory-dump-template:
    mov x2 @template-len
    bl send-string:
    sub x8 x8 @1
  })

})
:memory-dump-template (write-ascii dump-template)                  

/= 4
(subr disassemble-dump
      ([address x1]
       [instruction-count w2])
      [x0] {
    mov w0 @4
    bl send-char:
    mov x0 x1
    bl send-char:
    (for ([_ (in-range 7)])
      { lsr x0 x0 @8
        bl send-char: })
    mov x0 x2
    bl send-char:
    (for ([_ (in-range 3)])
      { lsr x0 x0 @8
        bl send-char: })
  we do 64 bits at a time
    (/whilenz instruction-count {
      ldr x0 [x1] @8
      bl send-char:
      (for ([_ (in-range 7)])
        { lsr x0 x0 @8
          bl send-char: })
      
      sub instruction-count instruction-count @1
    })
})         




/= 4
(subr send-string
      ([address x1]
       [len x2]) [x0] {
  mov w0 @1
  bl send-char:

  (/whilenz len {
    ldrb x0 [address] @1
    bl send-char:
    sub len len @1
  })
  bl  send-char:

  mov w0 @0
  bl send-char:
})

  ( subr send - string - nullterm


    (   {
      send - char :
  

  this trashes registers .. so push first !
  ( subr : dump - mem-64
      @(#/'$ )

(define-syntax-parser zero-mem
  [(_ base:register size:expr)
   #'(letrec
         ([aux
           (λ (offset rem-size)
             (cond
               [(>= rem-size 8) (begin {str x0 (base @offset)} (aux (+ offset 8) (- rem-size 8)))]
               [(>= rem-size 4) (begin {str w0 (base @offset)} (aux (+ offset 4) (- rem-size 4)))]
               [(>= rem-size 2) (begin {strh w0 (base @offset)} (aux (+ offset 2) (- rem-size 2)))]
               [(>= rem-size 1) (begin {strb w0 (base @offset)} (aux (+ offset 1) (- rem-size 1)))]
               [(= rem-size 0) (void)]
               [else (error (format "FAIL ~a ~a" offset rem-size))]))])
       (begin
         {mov x0 @0}
         (aux 0 size)))])


(/struct _voffset_msg
   [tag-id 4]
   [request-size 4]
   [tag-request-code 4]
  virtual y pos
   [end-tag 4]))

(/struct _setalpha_msg
   [tag-id 4]
   [request-size 4]
   [tag-request-code 4]
   [end-tag 4]))

(define-syntax-parser write-virtual-offset
  [(_ base:register y-loc:register)
note this trashes 
      (zero-mem base (sizeof/_voffset_msg))
      (_voffset_msg/total-size-set (* 8 4) base)
      (_voffset_msg/tag-id-set $48009 base)
      (_voffset_msg/request-size-set 8 base)
      (_voffset_msg/y-loc-set y-loc base)
      }])

(define-syntax-parser write-alpha-mode
  [(_ base:register a-mode:register)
note this trashes 
      (zero-mem base (sizeof/_setalpha_msg))
      (_setalpha_msg/total-size-set (* 7 4) base)
      (_setalpha_msg/tag-id-set $48007 base)
      (_setalpha_msg/request-size-set 4 base)
      (_setalpha_msg/alpha-mode-set a-mode base)
     }])

  virtual " page flip " here we tell the gpu to
(subr page-flip ([ptr x16]) [x0 x1 x2 x16] {
  sub sp sp @(sizeof/_voffset_msg)                                          
  (write-virtual-offset sp x3)
  mov x8 sp
  bl send-vcore-msg:
  add sp sp @(sizeof/_voffset_msg)                                          
  })

(subr set-alpha-mode () [x0 x1 x2 x16] {
  sub sp sp @(sizeof/_setalpha_msg)
  mov x10 @2                                              
  (write-alpha-mode sp w10)
  mov x8 sp
  bl send-vcore-msg:
  add sp sp @(sizeof/_setalpha_msg)                                          
})

(subr send-vcore-msg ()[x0 x1 x2 x3 x8]{

     mov x0 x8
  dc civac , 
     ldr x0 VC_MBOX: 
:wait      
     ldr w1 (x0 @mbox-status)
  and with 0x8000_0000
     mov x2 @1
     lsl x2 x2 @31
     and x1 x1 x2
     cbnz x1 wait-
  upper 28 bits are the address of the message
     ldr x0 VC_MBOX:
     mov x2 x8
  lower four bits specify the mailbox channel ,
     mov x3 @mbox-ch-prop
  we do nt support orr reg - reg - imm yet
     str w2 (x0 @mbox-write)
:wait      
    ldr w1 (x0 @mbox-status)
  and with 0x4000_0000
     mov x2 @1
     lsl x2 x2 @30
     and x1 x1 x2
     cbnz x1 wait-
     ldr w1 (x0 @mbox-read)
     mov x2 @%1111
     and x1 x1 x2
     sub x1 x1 @mbox-ch-prop
     cbnz x1 wait-


     })


:enable-irq
msr daifclr @2
ret x30

:disable-irq
msr daifset @2
ret x30

:show-invalid-entry-message
(debug-str "unhandled exception" #t)
(debug-reg x0 x1 x2)
mov x1 x2
mov x2 @32
bl disassemble-dump:
ret x30

/= $800
:vectors
(ventry
sync_invalid_el1t:
irq_invalid_el1t:
fiq_invalid_el1t:
error_invalid_el1t:
sync_invalid_el1h:
el1_irq:
fiq_invalid_el1h:
error_invalid_el1h:
sync_invalid_el0_64:
irq_invalid_el0_64:
fiq_invalid_el0_64:
error_invalid_el0_64:
sync_invalid_el0_32:
irq_invalid_el0_32:
fiq_invalid_el0_32:
error_invalid_el0_32:
 )

:sync_invalid_el1t
  (handle-invalid-entry  SYNC_INVALID_EL1t)

:irq_invalid_el1t
  (handle-invalid-entry  IRQ_INVALID_EL1t)

:fiq_invalid_el1t
  (handle-invalid-entry  FIQ_INVALID_EL1t)

:error_invalid_el1t
  (handle-invalid-entry  ERROR_INVALID_EL1t)

:sync_invalid_el1h
  (handle-invalid-entry  SYNC_INVALID_EL1h)

:fiq_invalid_el1h
  (handle-invalid-entry  FIQ_INVALID_EL1h)

:error_invalid_el1h
  (handle-invalid-entry  ERROR_INVALID_EL1h)

:sync_invalid_el0_64
  (handle-invalid-entry  SYNC_INVALID_EL0_64)

:irq_invalid_el0_64
  (handle-invalid-entry  IRQ_INVALID_EL0_64)

:fiq_invalid_el0_64
  (handle-invalid-entry  FIQ_INVALID_EL0_64)

:error_invalid_el0_64
  (handle-invalid-entry  ERROR_INVALID_EL0_64)

:sync_invalid_el0_32
  (handle-invalid-entry  SYNC_INVALID_EL0_32)

:irq_invalid_el0_32
  (handle-invalid-entry  IRQ_INVALID_EL0_32)

:fiq_invalid_el0_32
  (handle-invalid-entry  FIQ_INVALID_EL0_32)

:error_invalid_el0_32
  (handle-invalid-entry  ERROR_INVALID_EL0_32)

:el1_irq
  (kernel-entry)
  bl  handle-irq:
  (kernel-exit)

:irq-vector-init
  adr x0 vectors:
msr vbar_el1 x0
   msr  
  ret x30



(subr enable-interrupt-controller () [x0 x1] {
  mrs x0 scr_el3
  mov x1 @%1000
  orr x0 x0 x1
  fiq
  mov x1 @%100
  orr x0 x0 x1
  irq
  mov x1 @%10
  orr x0 x0 x1
  msr scr_el3 x0

  ldr x0 ENABLE_IRQS_2:
  SMI
  str w1 [x0]
})

(subr get-back-buffer () [x1 x2] {
    ldr x0 VMEM:
    mov x1 x0
 now has the base video memory pointer

    ldr x0 CURRENT-PAGE:
    cbz x0 done+
    ldr x2 FRAME-SIZE:
    add x1 x1 x2

  return in 
    mov x0 x1
})

(subr plot
       [x x1]
       [y x2]
       [colour w3]) [x0] {

  each pixel is 4 bytes
  x * = 4  
    ldr x4 ROW-SIZE:
    mul y y x4
    add vptr vptr x
    add vptr vptr y
    str colour [vptr]
    
})





(subr render-tex
      ([vptr x0]
       [texnum x1][iptr x1]
       [offset x3]
       [x w4]
       [y w5]
       [data w6]
       [screen-rowsize x8]
       [temp x9])
      [] {

    ldr screen-rowsize ROW-SIZE:
    ldr temp textures-address:

    mov y @64
  equiv to 
    (/whilenz y {
      mov x @64
      (/whilenz x {
  copy 4 bytes from source to dest
        ldr data [iptr] @4 
        str data [vptr] @4 
        sub x x @1
       })
      sub y y @1
      sub vptr vptr @(* 64 4)
      add vptr vptr screen-rowsize
    })
})

(subr render-pic
      ([vptr x0]
       [picnum x1][offset x1][iptr x1]
       [header x2]
       [width w2]
       [height w3]
       [x w4]
       [y w5]
       [data w6]
       [rowsize x7]
       [screen-rowsize x8]
       [temp x9])
      [] {

    ldr screen-rowsize ROW-SIZE:
   ldr header 2d-image-header-address:
  index * 8
  width / height is in lower 16 bits
    mov width w1
    mov height w1
    mov temp @$FFFF
    and width width temp
    lsl rowsize width @2
    lsr height height @16
  data offset in top 32 bits , move it down
    lsr offset offset @32
     adr temp DATA-2d - images :
    ldr temp 2d-images-address:
    add iptr offset temp

    mov y height
:y-loop
    mov x width

         :
:x-loop
  copy 4 bytes from source to dest
    ldr data (iptr @0)

    str data (vptr @0)
    add iptr iptr @4

    add vptr vptr @4
    
    sub x x @1
    cbnz x x-loop-

    sub y y @1

    sub vptr vptr rowsize
    add vptr vptr screen-rowsize

    cbnz y y-loop-
          
    })



(subr update-gfx  (
                   [wtemp w5]
                   [tptr x8]
                   [vptr-bak x10]
                   [row-size x14]
                   ) [x0 x1 x2 x3 x4]
                    {
:loop
    ldr w0 finished-rendering:
cbnz x0 loop-
    (flip-gpio1)
    bl get-back-buffer:
    mov vptr x0
    mov vptr-bak x0
    
  we do 8 pixels each iteration so
  we need 320 * 200/8 = $ 1F40 iterations
      mov temp @$1F40
      str x3 (   )
      add   @32




  adr     :
  ldr x0 [  ]
    mov x1 vptr-bak
     ( debug - str " debg " # t )
    (preserve [x4 x8 x9 x10 x14] {
    })

    ldr tptr player:
    (_objstruct/angle-get wtemp tptr)    
    add wtemp wtemp @1
    (/when (wtemp ge @360) {mov wtemp @0})
    (_objstruct/angle-set wtemp tptr) 


  adr     :
  ldr temp [ x0 ]
  adr     :

    :done
    mov temp @1
    adr x0 finished-rendering:
    str temp [x0]
    (flip-gpio1)
    b loop-
})

(define-syntax-parser FixedMul
  these should be x registers only ,  to put a check in
  trashes 
  make sure you SIGN ENTEND into x and y first !
  ([_ target:register x:register y:register]
   #'{
      mul target x y
      (load-immediate x0 $8000)
      add target target x0
      asr target target @16 
     }))

(subr VgaClearScreen
      ([vptr x1]
       [temp x2]       
       [x x3]
       [y x4]
       [ptr x5]
       [colour w6])
      [x1] {

   adr ptr palette:
   mov temp @$1d    
   lsl temp temp @2
   add ptr ptr temp
   ldr colour [ptr]

   xsteps = (/ 320 4)
  ceiling hardcoded to palette $ 1d for now
   (/for { mov y @0 } (y lt @(/ VIEWHEIGHT 2)) (inc y) {
     (/for { mov x @0 } (x lt @xsteps) (inc x) {                                                   
         str colour [vptr]
         str colour [vptr @4]
         str colour [vptr @8]
         str colour [vptr @12]
         add vptr vptr @16
     })

   })

  floor is always $ 19
   adr ptr palette:
   mov temp @$19    
   lsl temp temp @2
   add ptr ptr temp
   ldr colour [ptr]

   (/for { } (y lt @VIEWHEIGHT) (inc y) {
     (/for { mov x @0 } (x lt @xsteps) (inc x) {
         str colour [vptr]

         str colour [vptr @4]
         str colour [vptr @8]
         str colour [vptr @12]
         add vptr vptr @16
     })
   })
})
(subr ScalePost
      ([vptr x1]

       [ywcount w2]
       [yoffs w3]
       [yw w4]
       [yd w5]
       [yendoffs w6]
       [col w7]
       [ptr x8]
       )
      [x1] {


  adr ptr wallheight:
  ldr w10 postx:
  lsl w10 w10 @2
  add ptr ptr w10
  ldr w10 [ptr]
   ( debug - str - reg " wallheight[postx ] " w10 )
  lsr w10 w10 @3
   ( debug - str - reg " > > 3 " w10 )
  mov ywcount w10
  mov yd w10
  (/when (yd le @0) { mov yd @100 })

  mov w10 @(/ VIEWHEIGHT 2)
  sub w10 w10 ywcount
  ldr w11 vbufPitch:
  mul yoffs w10 w11
  (/when (yoffs lt @0) { mov yoffs @0 })

  ldr w10 postx:
  add yoffs yoffs w10

  mov w10 @(/ VIEWHEIGHT 2)
  add w10 w10 ywcount
  sub yendoffs w10 @1
  
  mov yw @(- TEXTURESIZE 1)
  
  vertical size of the screen , do n't need it for first

  ldr ptr postsource:
  lsl w10 yw @2
  add ptr ptr w10
  this is the 32bit pixel data
   ( debug - str - reg " first col is " col )
  
  ldr w10 vbufPitch:
  ldr w11 postx:
  mul yendoffs yendoffs w10
  add yendoffs yendoffs w11

  (/while (yoffs le yendoffs) {
    
    mov x20 vptr
    lsl x10 yendoffs @2
    add x20 x20 x10

    mov x10 @(/ TEXTURESIZE 2)
    sub ywcount ywcount x10
   ( debug - str - reg " iloop ywcount " ywcount )
    (/when (ywcount le @0) {
  :top-loop

      add ywcount ywcount yd
      sub yw yw @1
      (/when (ywcount le @0)
             {
             ( debug - str "  1 " # t )
              b top-loop-
              })
      (/when (yw lt @0)
             {
              ( debug - str "  2 " # t )
              b local-end+
             } )
      ldr ptr postsource:
      lsl w10 yw @2
      add ptr ptr w10
  this is the 32bit pixel data
    })
    ldr w10 vbufPitch:
    sub yendoffs yendoffs w10
     ( debug - str - reg " yendoffs nojw " yendoffs )
  })
:local-end                               
})

(subr HitHorizWall
      ([vptr x1]
       [wallpic w2]
       [texture w3]
       [ptr x4]
       )
      [x1] {
  ldr w10 xintercept:
  ldr w11 texdelta:
  add w10 w10 w11
  asr w10 w10 @TEXTUREFROMFIXEDSHIFT
  mov w12 @TEXTUREMASK
  and w10 w10 w12
  mov texture w10

  ldr w10 ytilestep:
  mov w11 @0
  (/if (w10 eq w11)
       {
         ldr w10 yintercept:
         (load-immediate w11 TILEGLOBAL)
         add w10 w10 w11
         adr ptr yintercept:
         str w10 [ptr]
       }
       {
         mov w11 @TEXTUREMASK
         sub texture w11 texture
       })
  
  ldr w10 lastside:
  mov w11 @0
  sub w11 w11 @1
  (/when (w10 ne w11) (preserve [x1 x2 x3 x4] { bl ScalePost: }))

  mov x10 @0
  adr ptr lastside:
  str w10 [ptr]

lastintercept = ytile
  ldr w10 ytile:
  adr ptr lastintercept:
  str w10 [ptr]

  ldr w10 tilehit:
  adr ptr lasttilehit:
  str w10 [ptr]
  
 = texture
  adr ptr lasttexture:
  str texture [ptr]


  (preserve [x1 x2 x3 x4] { bl CalcHeight: })
  adr ptr wallheight:
  ldr w10 pixx:
  lsl w10 w10 @2
  add ptr ptr w10
  str w0 [ptr]
  
postx = pixx
  ldr w10 pixx:
  adr ptr postx:
  str w10 [ptr]


  ldr w10 tilehit:
  lsl w10 w10 @1
  adr ptr horizwall:
  add ptr ptr w10
  ldrh wallpic [ptr]
   ( debug - str - reg " wallpix "  )


  we need to find the start of the image data for wallpic index
  then offset into it texture < < 2

  ldr ptr textures-address:

  move along texture * 4 bytes
  lsl w10 texture @2
  add ptr ptr w10

  mov x10 ptr
  adr ptr postsource:
  str x10 [ptr]

  
  })

(subr HitVertWall
      ([vptr x1]

       [wallpic w2]
       [texture w3]
       [ptr x4]
       )
      [x1] {
  ldr w10 yintercept:
  ldr w11 texdelta:
  add w10 w10 w11
  asr w10 w10 @TEXTUREFROMFIXEDSHIFT
  mov w12 @TEXTUREMASK
  and w10 w10 w12
  mov texture w10

  ldr w10 xtilestep:
  mov w11 @0
  (/when (w10 eq w11)
       {
         mov w11 @TEXTUREMASK
         sub texture w11 texture
         ldr w10 xintercept:
         (load-immediate w11 TILEGLOBAL)
         add w10 w10 w11
         adr ptr xintercept:
         str w10 [ptr]             
       })
  
  ldr w10 lastside:
  mov w11 @0
  sub w11 w11 @1
  (/when (w10 ne w11) (preserve [x1 x2 x3 x4] {
                                               bl ScalePost:
                                                  }))

lastside = 1
  mov x10 @1
  adr ptr lastside:
  str w10 [ptr]

lastintercept = xtile
  ldr w10 xtile:
  adr ptr lastintercept:
  str w10 [ptr]

  ldr w10 tilehit:
  adr ptr lasttilehit:
  str w10 [ptr]
  
 = texture
  adr ptr lasttexture:
  str texture [ptr]


  (preserve [x1 x2 x3 x4] { bl CalcHeight: })
  adr ptr wallheight:
  ldr w10 pixx:
  lsl w10 w10 @2
  add ptr ptr w10
  str w0 [ptr]
  
postx = pixx
  ldr w10 pixx:
  adr ptr postx:
  str w10 [ptr]


  ldr w10 tilehit:
  lsl w10 w10 @1
  adr ptr vertwall:
  add ptr ptr w10
  ldrh wallpic [ptr]
   ( debug - str - reg " wallpix "  )


  we need to find the start of the image data for wallpic index
  then offset into it texture < < 2

  ldr ptr textures-address:

  move along texture * 4 bytes
  lsl w10 texture @2
  add ptr ptr w10

  mov x10 ptr
  adr ptr postsource:
  str x10 [ptr]

  
})

(subr CalcHeight
      ([vptr x1]

       )
      [x1] {
   ( debug - str " in  " # t )
  ldr w10 xintercept:
  ldr w11 viewx:                
  ldr w12 viewcos:
   ( debug - str - reg " viewx " w11 )
   ( debug - str - reg " viewcos " w12 )
  sub w10 w10 w11
  sxtw x10 w10
  sxtw x12 w12
  (FixedMul x20 x10 x12)
   ( debug - str - reg " fixed1 " x20 )
  
  ldr w10 yintercept:
  ldr w11 viewy:                
  ldr w12 viewsin:
  sub w10 w10 w11
  sxtw x10 w10
  sxtw x12 w12
  (FixedMul x21 x10 x12)
  sub w10 x20 x21
  mov x11 @MINDIST
  (/when (w10 lt x11) { 
    mov w10 @MINDIST
  })

  int height = heightnumberator / ( z>>8 )
  asr w10 w10 @8
  ldr w11 heightnumerator:
  udiv w10 w11 w10
  
    if(height <  )

  mov x0 x10 
})

(subr AsmRefresh
      ([vptr x1]

       [xstep w2]
       [ystep w3]
       [xpartial w4]
       [ypartial w5]
       [ptr x6]
       [xtemp x7]

       [local-pixx w8]
       [wtemp w9]

       )
      [x1] {
  ( and our old friend  of course )
 

  mov xstep @0
  mov ystep @0
  mov xpartial @0
  mov ypartial @0

  (/for {mov local-pixx @0} (local-pixx lt  @320) (inc local-pixx) {
    adr ptr pixx:
    str local-pixx [ptr]
    
     ]
    adr ptr pixelangle:    
    mov wtemp local-pixx
    lsl wtemp wtemp @1
    add ptr ptr wtemp 
    ldrh w0 [ptr]
    sxth w0 w0
    ldr wtemp midangle:
    add w10 w0 wtemp

    (/when (w10 lt @0)  {
       ( debug - str " angl < 0 " # t )
      mov w11 @FINEANGLES
      add w10 w10 w11
    })

    (/when (w10 ge @3600)  {
       ( debug - str " angl > = 3600 " # t )                  
      mov w11 @FINEANGLES
      sub w10 w10 w11

      })

    (/cond
     ([(w10 lt @900)
       {
         mov w0 @1
         adr ptr xtilestep:
         str w0 [ptr]
         mov w0 @0
         adr ptr ytilestep:
         str w0 [ptr]
  xstep = finetangent[900 - 1 - angl ]
         adr ptr finetangent:
  index -= angl
  32 bit
         add ptr ptr w11
         ldr xstep [ptr]

 = -finetangent[angl ]
  w11 = angl
         adr ptr finetangent:
         lsl w11 w11 @2
         add ptr ptr w11
         ldr ystep [ptr]
         sub ystep wzr ystep
          ( debug - str - reg " ystep "  )
         ldr xpartial xpartialup:
  ypartial = ypartialdown
         ldr ypartial ypartialdown:
         
       }]
      [(w10 lt @1800)
       {

          ( debug - str " angl < 1800 " # t )
         mov w0 @0
         adr ptr xtilestep:
         str w0 [ptr]
         adr ptr ytilestep:
         str w0 [ptr]
         adr ptr finetangent:
  32 bit
         add ptr ptr w11
         ldr xstep [ptr]
         sub xstep xzr xstep

 = -finetangent[1800 - 1 - angl ]
         mov w11 @1799
         sub w11 w11 w10
         adr ptr finetangent:
         lsl w11 w11 @2
         add ptr ptr w11
         ldr ystep [ptr]
         sub ystep wzr ystep
          ( debug - str - reg " ystep "  )
         ldr xpartial xpartialdown:
         ldr ypartial ypartialdown:
         

       }]
      [(w10 lt @2700)
       {
         ( debug - str " angl < 2700 " # t )
         mov w0 @0
         adr ptr xtilestep:
         str w0 [ptr]
         mov w0 @1
         adr ptr ytilestep:
         str w0 [ptr]
  xstep = -finetangent[2700 - 1 - angl ]
         adr ptr finetangent:
  32 bit
         add ptr ptr w11
         ldr xstep [ptr]
         sub xstep xzr xstep

 = finetangent[angl-1800 ]
         mov w11 @1800
         sub w11 w10 w11
         adr ptr finetangent:
         lsl w11 w11 @2
         add ptr ptr w11
         ldr ystep [ptr]
          ( debug - str - reg " ystep "  )
         ldr xpartial xpartialdown:
         ldr ypartial ypartialup:
      
        }]
      [(w10 lt @3600)
       {
         ( debug - str " angl < 3600 " # t )
   
         mov w0 @1
         adr ptr xtilestep:
         str w0 [ptr]
         adr ptr ytilestep:
         str w0 [ptr]
         adr ptr finetangent:
  32 bit
         add ptr ptr w11
         ldr xstep [ptr]

 = finetangent[3600 - 1 - angl ]
         mov w11 @3599
         sub w11 w11 w10
         adr ptr finetangent:
         lsl w11 w11 @2
         add ptr ptr w11
         ldr ystep [ptr]
          ( debug - str - reg " ystep "  )
         ldr xpartial xpartialup:
         ldr ypartial ypartialup:
   
        }]))

yintercept = FixedMul(ystep , xpartial )  
  make sure these are in x registers first
  sign extend to 64 bits

    sxtw x10 ystep
    sxtw x11 xpartial
    (FixedMul x12 x10 x11)
    mov x0 x12
     ( debug - str - reg " fixed    w0 )
    ldr wtemp viewy:
    add w0 w0 wtemp
    adr ptr yintercept:
    str w0 [ptr]
    
xtile = focaltx + xtilestep
    ldr w10 focaltx:
    ldr w11 xtilestep:
    add w10 w10 w11
    adr ptr xtile:
    str w10 [ptr]
    
  xspot = ( xtile < < 6 ) + ( yintercept > > 16 )
    lsl w10 w10 @6
    lsr w12 w12 @16
    add w0 w10 w12
    adr ptr xspot:
    str w0 [ptr]

    sxtw x10 xstep
    sxtw x11 ypartial
    (FixedMul x12 x10 x11)
    mov x0 x12
     ( debug - str - reg " fixed    w0 )
    ldr wtemp viewx:
    add w0 w0 wtemp
    adr ptr xintercept:
    str w0 [ptr]

    ldr w10 focalty:
    ldr w11 ytilestep:
    add w10 w10 w11
    adr ptr ytile:
    str w10 [ptr]
    
  yspot = ( ( xintercept > > 16 ) < < 6 ) + ytile

    lsr w12 w12 @16
    lsl w12 w12 @6
    add w0 w10 w12
    adr ptr yspot:
    str w0 [ptr]

    adr ptr texdelta:
    mov x0 @0
    str w0 [ptr]
    

            
  :start-vert-loop

  if ytilestep = -1 & & ( yintercept>>16 < = ytile ) goto horizentry
  if ytilestep = 1 & & ( yintercept>>16 > = ytile ) goto horizentry
    ldr w10 ytilestep:
    ldr w11 yintercept:
    asr w11 w11 @16
    mov w12 @0
    ldr w13 ytile:
  if ytilestep = -1 & & ( yintercept>>16 < = ytile ) goto horizentry
    (/when (/and (w10 eq w12) (w11 le w13)) {
       ( debug - str " check 1 true " # t )
      b horizentry:                                             
      })
  if ytilestep = 1 & & ( yintercept>>16 > = ytile ) goto horizentry
    (/when (/and (w10 eq @1) (w11 ge w13)) {
       ( debug - str " check 2 true " # t )
      b horizentry:                                             
    })
  :vertentry
  TODO : there 's an OOB check we do n't need right now
     ( debug - str " in vertentry " # t )
    adr ptr tilemap:
    ldr wtemp xspot:
    add ptr ptr wtemp
    ldrb w0 [ptr]
    adr ptr tilehit:
    str w0 [ptr]

    (/when (w0 ne @0) {


      ldr w10 xtile:
      lsl w10 w10 @TILESHIFT
      adr ptr xintercept:
      str w10 [ptr]
      ldr w10 yintercept:
      asr x10 x10 @TILESHIFT
      adr ptr ytile:
      str w10 [ptr]
       ( debug - str " 2 " # t )

      (preserve [x1 x2 x3 x4 x5 x6 x7 x8 x9] {
        bl HitVertWall:
      })        
      b loop-next+
    })                   

  :passvert  

    ldr w10 xtile:
    ldr w11 xtilestep:
    add w10 w10 w11
    adr ptr xtile:
    str w10 [ptr]

yintercept + = 
    ldr w12 yintercept:
ldr   :
    add w10 w12 ystep
    adr ptr yintercept:
    str w10 [ptr]

  xspot = ( xtile < < 6 ) + ( yintercept > > 16 )
    mov w12 w10
    ldr w10 xtile:
    lsl w10 w10 @6
    lsr w12 w12 @16
    add w0 w10 w12
    adr ptr xspot:
    str w0 [ptr]

    b start-vert-loop:

  :start-horiz-loop
  if xtilestep = -1 & & ( xintercept>>16 < = xtile ) goto vertentry
  if xtilestep = 1 & & ( xintercept>>16 > = xtile ) goto vertentry
    ldr w10 xtilestep:
    ldr w11 xintercept:
    asr w11 w11 @16
    mov w12 @0
    ldr w13 xtile:
  if xtilestep = -1 & & ( xintercept>>16 < = xtile ) goto vertentry
    (/when (/and (w10 eq w12) (w11 le w13)) {
       ( debug - str " check 3 true " # t )
      b vertentry:                                             
      })
  if xtilestep = 1 & & ( xintercept>>16 > = xtile ) goto vertentry
    (/when (/and (w10 eq @1) (w11 ge w13)) {
       ( debug - str " check 4 true " # t )
      b vertentry:                                             
    })
  :horizentry
     ( debug - str " in horizentry " # t )
    adr ptr tilemap:
    ldr wtemp yspot:
    add ptr ptr wtemp
    ldrb w0 [ptr]
    adr ptr tilehit:
    str w0 [ptr]

    (/when (w0 ne @0) {

      ldr w10 ytile:
      lsl w10 w10 @TILESHIFT
      adr ptr yintercept:
      str w10 [ptr]
      
      ldr w10 xintercept:
      asr x10 x10 @TILESHIFT
      adr ptr xtile:
      str w10 [ptr]
      (preserve [x1 x2 x3 x4 x5 x6 x7 x8 x9] {
        bl HitHorizWall:
      })        
  
  
      
      b loop-next+
    })                   

    
  :passhoriz
    ldr w10 ytile:
    ldr w11 ytilestep:
    add w10 w10 w11
    adr ptr ytile:
    str w10 [ptr]
    ldr w12 xintercept:
ldr w11 xstep :
    add w10 w12 xstep
    adr ptr xintercept:
    str w10 [ptr]
  yspot = ( ( xintercept > > 16 ) < < 6 ) + ytile
    mov w12 w10
    asr w12 w12 @16
    lsl w12 w12 @6
    ldr w10 ytile:
    add w0 w10 w12
    adr ptr yspot:
    str w0 [ptr]

    
    b start-horiz-loop:

  :loop-next
    ldr local-pixx pixx:
  })

   ( debug - str " exit asm referesh " # t )          
})

(subr WallRefresh
      ([vptr x1]

       [ptr x2]
       [temp x2]
       )
      [x1] {
  xpartialdown = viewx & ( TILEGLOBAL-1 )
  (load-immediate temp (- TILEGLOBAL 1))
  adr   :
  ldr w0 [ x0 ]
  ldr w0 viewx:
  and x0 x0 temp
  adr ptr xpartialdown:
  str w0 [ptr]

  ldr w0 [ ptr ]
  ( debug - str - reg "  is " x0 )

  xpartialup = TILEGLOBAL - xpartialdown (  )
  (load-immediate temp TILEGLOBAL)
  sub x0 temp x0
  adr ptr xpartialup:
  str w0 [ptr]

  ldr w0 [ ptr ]

  
  ypartialdown = viewy & ( TILEGLOBAL-1 )
  (load-immediate temp (- TILEGLOBAL 1))
  ldr w0 viewy:
  and x0 x0 temp
  adr ptr ypartialdown:
  str w0 [ptr]

  ldr w0 [ ptr ]
  ( debug - str - reg " ypartialdown is ! "  )

  
  ypartialup = TILEGLOBAL - ypartialdown (  )
  (load-immediate temp TILEGLOBAL)
  sub x0 temp x0
  adr ptr ypartialup:
  str w0 [ptr]

  ldr w0 [ ptr ]

  mov x0 @0
  sub x0 x0 @1
  adr ptr lastside:
  str w0 [ptr]
  bl AsmRefresh:
  bl ScalePost:
})

(subr ThreeDRefresh
      ([vptr x1]
       
       [ply x2]
       [temp w3]
       [temp2 w4]
       [temp3 x5]
       [ptr x5]
       [vangle w6])
      [x1]
      {



  ldr ply player:

  (_objstruct/angle-get temp ply)    
  adr x0 viewangle:
  str temp [x0]
  mov vangle temp
  ldr w0 [ x0 ]
  
  
  (load-immediate x0 (/ FINEANGLES ANGLES))
  mul temp2 temp x0
  adr x0 midangle:
  str temp2 [x0]

  ldr w0 [x0]
  
TODO : really need to add support for the ldr / str with
  
  viewsin = sintable[viewangle ]
  temp = viewangle
  adr ptr sintable:
  multiply by 4 since 32bits
  todo : this could all be 1 instruction
  ldr w0 [ptr]
  adr ptr viewsin:
  str w0 [ptr]

  ldr w0 [ptr]
   ( debug - str - reg " viewsin is " x0 )

  
  viewy = player->x + FIxedMul(focallength , viewsin )  
  ldr temp2 focallength:
  sxtw x0 w0
  sxtw temp2 temp2
  (FixedMul temp3 x0 temp2)
   ( debug - str - reg " rresult "  )
  (_objstruct/y-get temp2 ply)
   ( debug - str - reg " player->y "  )
  sub x0 temp2 temp3
  adr ptr viewy:
  str w0 [ptr]

  ldr w0 [ ptr ]

  focalty = viewy > > 16
  lsr w0 w0 @16
  adr ptr focalty:
  str w0 [ptr]

  ldr w0 [ ptr ]

  ldr ptr costable:
  multiply by 4 since 32bits
  add ptr ptr temp2
  ldr w0 [ptr]
  adr ptr viewcos:
  str w0 [ptr]

  ldr w0 [ ptr ]
  ( debug - str - reg " viewcos is " x0 )

  
  viewx = player->x - FIxedMul(focallength ,  )  
  ldr temp2 focallength:
   ( debug - str - reg " focallength "  )
  sxtw x0 w0
  sxtw temp2 temp2
  (FixedMul temp3 x0 temp2)
   ( debug - str - reg " result "  )
  (_objstruct/x-get temp2 ply)
   ( debug - str - reg " player->x "  )
  sub x0 temp2 temp3
  adr ptr viewx:
  str w0 [ptr]

  ldr w0 [ ptr ]

  
  focaltx = viewx > > 16
  lsr w0 w0 @16
  adr ptr focaltx:
  str w0 [ptr]

  ldr w0 [ ptr ]
  
  
  viewtx = player->x > > 16 }
  (_objstruct/x-get temp2 ply)
  lsr x0 temp2 @16
  adr ptr viewtx:
  str w0 [ptr]

  ldr w0 [ ptr ]

  
  viewty = player->y > > 16 }
  (_objstruct/y-get temp2 ply)
  lsr x0 temp2 @16
  adr ptr viewty:
  str w0 [ptr]

  ldr w0 [ ptr ]

  

  bl VgaClearScreen:
  bl WallRefresh:

   ( debug - str " finish 3d refersh " # t )
})

  ( subr update - gfx   (

      ldr w0 finished - rendering :
      cbnz  

    
      mov temp @$1F40
      str x3 (   )
      add   @32


    
      sub x27 x27 @1
      cbnz x27 skip+
      mov x27 @10

    

    
      adr  finished - rendering :




  SMICS interrupt which is the VSYNC
(subr handle-irq () [] {
  mov x1 @0
  str w1 [x0]
  (flip-gpio0)
  ldr w0 finished-rendering:
  cbz w0 quit:
  ldr x1 CURRENT-PAGE:
  cbnz x1 f+
  mov x3 @height
  b done+
:f
  mov x3 @0
:done
  adr x1 CURRENT-PAGE:
  str x3 [x1]
  
  bl page-flip:
bl update - gfx :

  adr x1 finished-rendering:

  mov x2 @0
  str w2 [x1]

  
  :quit
(flip-gpio0)
})


  WOLFENSTEIN CODE
(define MAXACTORS 150)
(define MAP_HEIGHT 64)
(define MAP_WIDTH 64)
  
(/struct _objstruct

   , etc
  
  [ticcount        2]
  [tilex           2]
  [tiley           2]
  [viewx           2]
  [viewheight      2]
  [angle           2]
  [hitpoints       2]

  [temp1           2]
  [temp2           2]
  [hidden          2]
  
activetype enum
classtype enum
  dirtype enum
  [areanumber      1]

  I 'm adding this so it is 8 byte aligned ( 72 bytes )
  ))

(subr setup-game-level
      ([raw-ptr x1]
       [lvl-ptr x2]
       [x x3]
       [y x4]
       [tile w5]
       [offset x6])

      [x1 x2 x3 x4 x5 x6] {

  x1 will point at the raw map data for level 1
  AREATILE = 107
  each raw map section is a 16 bit word



  (/for { mov y @0 } (y lt @MAP_HEIGHT) (inc y) {
    (/for { mov x @0 } (x lt @MAP_WIDTH) (inc x) {
      ldrh tile [raw-ptr] @2
      (/when (tile lt @AREATILE) {

  lvlptr = tilemap : + ( 64 * x ) + y
        adr lvl-ptr tilemap:
  * 64
        add lvl-ptr lvl-ptr offset
        add lvl-ptr lvl-ptr y
        strb tile [lvl-ptr] 
      })
    })                                                     
  })
  
    
})

(subr spawn-player
      ([tilex x1]
       [tiley x2]
       [dir x3]

       [temp x4]
       [ptr x5])
      [x4] {

  adr ptr objlist:
  adr temp player:

  mov temp @1

  playerobj = 1
  ac_yes = 1
  tilex = tilex

  areanumber = map index ( tiley < < 6 ) + tilex  
  lsl temp tiley @6
  add temp temp tilex
  multiply by 2 here because we need words not bytes . the C code is silently doubling the index
  add temp temp temp
  add temp temp x0
  
  ldrb temp [temp]
  (_objstruct/areanumber-set temp ptr) 

  x = ( tilex < < TILESHIFT ) + ( TILEGLOBAL/2 ) ( fixed point )
  (debug-str-reg "tilexx = " tilex)
  lsl temp tilex @TILESHIFT
  (load-immediate x0 TILEGLOBAL/2)
  add temp temp x0
  (debug-str-reg "player->x = " temp)
  (_objstruct/x-set temp ptr)

  (_objstruct/x-get temp ptr)
  (debug-str-reg "* player->x = " temp)

  lsl temp tiley @TILESHIFT
  (load-immediate x0 TILEGLOBAL/2)  
  add temp temp x0
  (debug-str-reg "player->y = " temp)
  (_objstruct/y-set temp ptr)  


  angle resolves to zero for the first map so we ignore that for now
  mov temp @180
  (_objstruct/angle-set temp ptr)
  
  mov temp @4
  FL_NEVERMARK = 4
  
  ( _ objstruct / obclass - get temp ptr )

  ( _ objstruct / active - get temp ptr )

  ( _ objstruct / tilex - get temp ptr )




  ( _ objstruct / y - get temp ptr )

})          
(subr scan-info-plane
      ([raw-ptr x1]
       [x x2]
       [y x3]
       [temp x4]
       [tile w5])
      [x1 x2 x3 x4] {

  scan second map data plane and spawn player , statics , guards etc
  add 64 * 64 * 2 for start of second plane
  mov x4 @64
  lsl x4 x4 @7
  add raw-ptr raw-ptr x4

  (/for { mov y @0 } (y lt @MAP_HEIGHT) (inc y) {
    (/for { mov x @0 } (x lt @MAP_WIDTH) (inc x) {
      ldrh tile [raw-ptr] @2
      (/when (/and (tile le @22) (tile ge @19)) {
        (debug-str "FOUND PLAYER!" #t)
        (debug-reg x)
        (debug-reg y)
        (preserve [x1 x2 x3] {
          mov x1 x
          mov x2 y
          sub x3 tile @19
          bl spawn-player:
        })
        (debug-str "PLAYER SPAWNED!" #t)
      })
    })                                                     
  })
          
})          
/= 8
:tilemap (reserve (* 64 64))
/= 8
:actorat (reserve (* 64 64 8))
/= 8
:objlist (reserve (* (sizeof/_objstruct) MAXACTORS))
/= 8

/= 8
:horizwall
(write-value-16 0)
(for ([i (in-range 1 64)])
  (write-value-16 (* (- i 1) 2)))

/= 8
:vertwall
(write-value-16 0)
(for ([i (in-range 1 64)])
  (write-value-16 (+ (* (- i 1) 2) 1)))

/= 8
:wallheight
(for ([x (in-range 320)])
  (write-value-32 0))

  the following values are used for loading 64 bit addresses / values via LDR(literal )
  and they must be 64 bit aliged otherwise the CPU faults !
/= 8
  this lets us load them with ldr .
  :2d-image-header-address (resolve-global-label-address :DATA-2d-image-header)
  :2d-images-address (resolve-global-label-address :DATA-2d-images)
  :textures-address (resolve-global-label-address :DATA-textures)
:maps-address (resolve-global-label-address :DATA-maps)

  (periph-addresses)
  :flip0 (write-value-64 0)
  :flip1 (write-value-64 0)
  :dELAY (write-value-64 $FFFFF)
  :dELAY2 (write-value-64 200000)
  :VC_MBOX (write-value-64 VCORE-MBOX)
  :TEST (write-value-64 $123456789ABCDEF)
:CONVERT (write-value-64 $3FFFFFFF)
:HCR-VALUE (write-value-64 HCR_VALUE)
:SCTLR-VALUE-MMU-DISABLED (write-value-64 SCTLR_VALUE_MMU_DISABLED2)
:SCTLR-VALUE-MMU-ENABLED (write-value-64 SCTLR_VALUE_MMU_ENABLED)
:SCR-VALUE (write-value-64 SCR_VALUE)
:SPSR-VALUE (write-value-64 SPSR_VALUE)
:CPACR_EL1_VAL (write-value-64 CPACR_EL1_VAL)
:TCR_EL1_VAL(write-value-64 TCR_EL1_VAL)
:MAIR_VALUE (write-value-64 MAIR_VALUE)
:FAKE-ISR (write-value-64 $10000)
:CURRENT-PAGE (write-value-64 0)
:FRAME-SIZE (write-value-64 (* width height 4))
:ROW-SIZE (write-value-64 (* width 4))

:VMEM (write-value-64 0)
:pointAX(write-value-64 10)
:pointAY(write-value-64 10)
:pointBX(write-value-64 100)
:pointBY(write-value-64 100)
:finished-rendering (write-value-64 0)
:frame-count (write-value-64 0)
:execute-once (write-value-64 0)
:time (write-value-64 0)
:sizes
(write-value-32 1)
(write-value-32 2)
(write-value-32 4)
(write-value-32 8)
(write-value-32 16)
(write-value-32 32)
(write-value-32 64)
(write-value-32 128)
(write-value-32 256)
(write-value-32 512)
(write-value-32 1024)
(write-value-32 2048)
(write-value-32 0)

(define-syntax-parser execute-once
  ([_ body]
   #'{
      ldr x0 execute-once:
      cbz execute-once-skip:
      mov x0 @0
      (preserve [x1] {
        adr x1 execute-once:
        str x0 [x1]                        
      })                
    :execute-once-skip  
     }))
  to communicate with the video core gpu we need an address that
  is 16 - byte algined - the lower 4 bits are not set . these are then
  /= 16
  :MBOX-MSG
      (write-value-32 $48003)
      (write-value-32 $48004)

  set virtoff
      (write-value-32 $48009)

      (write-value-32 $48005)
      (write-value-32 4) 
      (write-value-32 4) 
  bpp

      (write-value-32 $48006)
      (write-value-32 4) 
      (write-value-32 4) 
  RGB


      (write-value-32 $48007)
      (write-value-32 4) 
      (write-value-32 4) 

      (write-value-32 $40001)
      (write-value-32 8) 
      (write-value-32 8) 
:fb

      (write-value-32 $40008)
      (write-value-32 4) 
      (write-value-32 4) 


        ( write - value-32 $ 48009 )
   :  - req
     :  - y

  our version is hardcoded at 320 * 160 ( no border ) so we can calculate the bits at compile time
/= 8
 uses a lot of global state !
:debug-flag (write-value-64 (* 360 4))
:focallength (write-value-32 $5700)
:scale (write-value-32 128)
:heightnumerator (write-value-32 223232)
:viewx (write-value-32 0)
:viewy (write-value-32 0)
:viewsin (write-value-32 0)
:viewcos (write-value-32 0)
:vbufPitch (write-value-32 320)
:xpartialup (write-value-32 0)
:xpartialdown (write-value-32 0)
:ypartialup (write-value-32 0)
:ypartialdown (write-value-32 0)
:xintercept (write-value-32 0)
:yintercept (write-value-32 0)
:pixx (write-value-32 0)
:texdelta (write-value-32 0)
:lastside (write-value-32 0)
:lasttilehit (write-value-32 0)
:lasttexture (write-value-32 0)
:lastintercept (write-value-32 0)
:postx (write-value-32 0)
  these next ones are shorts but we 'll store them as 4 bytes
:tilehit (write-value-32 0)
:viewangle (write-value-32 0)
:midangle (write-value-32 0)
:angle (write-value-32 0)
:xstep (write-value-32 0)
:ystep (write-value-32 0)
:xtile (write-value-32 0)
:ytile (write-value-32 0)
:xtilestep (write-value-32 0)
:ytilestep (write-value-32 0)
:viewtx (write-value-32 0)
:viewty (write-value-32 0)
:focaltx (write-value-32 0)
:focalty (write-value-32 0)
:xspot (write-value-32 0)
:yspot (write-value-32 0)

/= $1000
:id_pgd
  $ 6000
(write-value-64 $BADF00D)
(write-value-64 $BADF00D)
(define viewwidth 320)
(define halfview (/ viewwidth 2))
(define facedist (+ 0.0 #x5700 MINDIST))
(define scale 128)
(define heightnumerator 223232)
(define radtoint 572.9578)
/= 8
:pixelangle
(let ([vec (make-vector viewwidth)]
      [calcangle (λ (i)
         (define tang (/(* i #x10000) viewwidth facedist))
         (define ang (atan tang))
         (define intang  (inexact->exact (floor (* ang radtoint))))
         intang)])
  (for ([i (in-range halfview)])
    (let* ([ang (calcangle i)]
           [nang (- ang)])
      (vector-set! vec (- halfview 1 i) ang)
      (vector-set! vec (+ halfview i) nang)))
  (for ([v vec])
     (  v )
    (write-value-16 v)
    ))

(define GLOBAL1 (arithmetic-shift 1 16))
/= 8
:finetangent
(let ([vec (make-vector (/ FINEANGLES 4))])
  (for ([i (in-range (/ FINEANGLES 8))])
    (define tang (tan (/ (+ i 0.5) radtoint)))
    (vector-set! vec i (inexact->exact (floor (* tang GLOBAL1))))
    (vector-set! vec (- (/ FINEANGLES 4) 1 i) (inexact->exact (floor (* (/ 1 tang) GLOBAL1)))))
  (for ([v vec])
    (write-value-32 v)))

  costable overlays sintable with a quarter phase shift
(define anglestep (/ pi 2 ANGLEQUAD))
/= 8
  costable is : sintable + ( ANGLEQUAD * 4 ( since its 32bits ) ) ( or in this case , just ANGLES ! )
(let ([vec (make-vector (+ ANGLES ANGLEQUAD))])
  (define ang 0)
  (for ([i (in-range ANGLEQUAD)])
    (define value (inexact->exact (floor (* (sin ang) GLOBAL1))))
    (vector-set! vec i value)
    (vector-set! vec (+ i ANGLES) value)
    (vector-set! vec (- (/ ANGLES 2) i) value)

    (vector-set! vec (- ANGLES i) (- value))
    (vector-set! vec (+ (/ ANGLES 2) i) (- value))

    (set! ang (+ ang anglestep))
    
    )
  (vector-set! vec ANGLEQUAD 65536)
  (vector-set! vec (* 3 ANGLEQUAD) -65536)
  (for ([v vec])
    (write-value-32 v)))

/= 8
:palette
(let*
    ([lines  (file->lines "wolfpal.inc")]
     [splits  (map (λ (line) (string-split line "RGB")) lines)]
     [clean  (map (λ (line) (string-replace (string-replace line ")" "") "(" "")) (flatten splits))]
     [rgbs (map (λ (line) (string-split line ",")) clean)])
  (for ([rgb rgbs])
    (write-value (string->number (string-trim (list-ref rgb 2))))
    (write-value (string->number (string-trim (list-ref rgb 1))))
    (write-value (string->number (string-trim (list-ref rgb 0))))
    (write-value 255)))


})


