## vim: set sw=3 expandtab:

# ( ... get_char store_byte -- end_char )
# get_char:   ( ... -- ... char )
# store_byte: ( ... byte -- ... )
decode_base64:
   push
   push
   immed 0
   immed 0
.loop:                     # ( n bits // gc sb )
   rdup
   pop
   swap
   push
   swap
   push                    # ( gc // n bits gc sb )
   call                    # ( ch // n bits gc sb )
   dup; immed 10; sub
   jump .not_nl rel ne drop
   drop
   pop
   pop
   jump .loop              # ( n bits // gc sb )
.not_nl:                   # ( ch // n bits gc sb )
   dup; immed '='; sub
   jump .pad rel eq drop
   dup
   call decode_char       # ( ch val // n bits gc sb )
   jump .invalid rel lt
   nip                     # ( val // n bits gc sb )
   pop
   swap
   pop                     # ( n val bits // gc sb )
   or
   immed -6
   rshift                  # ( n bits' // gc sb ) [ bits' = (bits|val)<<6 ]
   push
   immed 6
   add                     # ( n' // bits' gc sb ) [ n' = n + 6 ]
   dup; immed 8; sub
   jump .store rel ge      # ( n' (n'-8) // bits' gc sb )
   drop
   pop
   jump .loop rel          # ( n' bits' // gc sb )
.store:                    # ( n' (n'-8) // bits' gc sb )
   nip
   dup                     # ( n'' (n'-8) // bits' gc sb ) [ n'' = n'-8 ]
   rdup
   pop
   swap                    # ( n'' bits' (n'-8) // bits' gc sb )
   immed 6
   add
   rshift                  # ( n'' byte // bits' gc sb )
   swap
   pop
   pop
   rdup
   pop                     # ( byte n'' bits' gc sb // sb )
   swap
   push
   swap
   push
   swap
   push                    # ( byte sb // n'' bits' gc sb )
   call                    # ( // n'' bits' gc sb )
   pop
   pop
   jump .loop              # ( n'' bits' // gc sb )
.pad:                      # ( ch // n bits gc sb )
   # reset accumulated state
   drop
   rdrop
   rdrop
   immed 0
   immed 0
   # continue until something non-base64 is received
   jump .loop              # ( n bits // gc sb )
.invalid:                  # ( ch val // n bits gc sb )
   drop
   rdrop
   rdrop
   rdrop
   rdrop
   return                  # ( ch // )

# ( val low high -- (low<=val<=high) )
in_range:
   over
   sub
   push                    # ( val low // (high-low) )
   sub
   jump .too_low rel lt
   pop                     # ( (val-low) (high-low) // )
   sub
   jump .too_high rel gt drop
   immed 1
   return
.too_low:                  # ( (val-low) // (high-low) )
   drop
   rdrop
.too_high:
   immed 0
   return

decode_char:
   dup; immed 'A'; immed 'Z'
   call in_range
   jump .uc rel ne drop

   dup; immed 'a'; immed 'z'
   call in_range
   jump .lc rel ne drop

   dup; immed '0'; immed '9'
   call in_range
   jump .digit rel ne drop

   dup; immed '+'; sub
   jump .plus rel eq drop

   dup; immed '/'; sub
   jump .slash rel eq drop

.invalid:
   immed -1
   nip return

.uc:
   immed 65 # 'A' == 65, base64['A'] == 0
   sub return

.lc:
   immed 71 # 'a' == 97, base64['a'] == 26
   sub return

.digit:
   immed 4  # '0' == 48, base64['0'] == 52
   add return

.plus:
   immed 62
   nip return

.slash:
   immed 63
   nip return