org 100h

; ***************************************************************
;
; old  TASM version:     1280 bytes   ( 1082 bytes aPACK'd      )
; this FASM version:      982 bytes   (  999 aPACK,  998 w/ 624 )
;
; Tuesday, May 4, 2010  2:33pm
;
; "Ad Maiorem Gloriam Dei" && "Christus Rex"
;
; rugxulo _AT_ gmail _DOT_ com
; http://sites.google.com/site/rugxulo/
;
; (based upon works by Ryan Kusnery and Ben Olmstead)
;
; ***************************************************************

define befungecode 600h

;define magy byte [magic0-1]
;define magx byte [magic1-1]
define magy byte [my_magy]
define magx byte [my_magx]

start:
 mov dx,81h
 mov bx,dx

; mov ax,word [80h]
 mov ax,[bx-1]

 cmp ah,' '
 jnz skip1
 inc dx
skip1:
 add bl,al
 mov [bx],dh

lfn_hack:
 mov ax,7160h
 mov cx,8001h
 mov si,dx
 mov di,befungecode
 mov fs,di
 push di
 push si
 stc
 int 21h
 pop di
 pop si
 jc lfn_hack_bye
 mov cx,dx
 rep movsb
lfn_hack_bye:

check386:
 mov ax,7202h
 push ax
 popf
 pushf
 pop bx
 cmp ax,bx
 jnz writemsg

open:
 mov ax,3D00h ; open file pointed to by DX as read-only
 int 21h
 jc badfile

; mov bx,ax ; put opened file handle into BX
 xchg bx,ax
 mov cx,sp
 sub cx,befungecode+100h ; slurp as much as you can
 mov dx,fs

; mov ah,3Fh
; int 21h
 call read_it2

 jc badfile
 jcxz badfile
 xchg cx,ax ; put number of bytes read from file into CX

; mov ah,3Eh
; int 21h

 std
 mov di,befungecode+128*128
 mov si,befungecode-1
 add si,cx

 push cx
 rep movsb
 pop cx

 lea si,[di+1]
 mov di,fs

 cld
 xor bx,bx
fixitloop:
 lodsb
 cmp al,10
 jz writenl
 cmp al,' '
 jb skipstosb
do_stosb:
 stosb
skipstosb:
 loop fixitloop
 mov cx,befungecode+128*128
 sub cx,di
 mov al,' '
 rep stosb
 jmp b93_interpreter

writenl:
 mov bx,di
 xor ax,ax
 sub al,bl
 and al,7Fh
 push cx
 xchg cx,ax
 mov al,' '
 rep stosb
 pop cx
 jmp skipstosb

;needfile:
; mov dx,needfilemsg
; jmp writemsg

badfile:
; mov dx,badfilemsg
; jmp writemsg
;emptyfile:
; mov dx,emptyfilemsg
; mov al,100

writemsg:
; mov ah,9
; int 21h
 mov al,'?'
 int 29h

; call outc_nl

; mov ah,4Ch
; int 21h
;int 20h ; exit to DOS
 ret     ; also works as long as SP == 0FFFEh

; ACTUAL INTERPRETER

b93_interpreter:

 xor bx,bx
 mov si,fs
 mov [my_sp],sp

interploop:
;xor ah,ah
 xor eax,eax

 shr bx,1
 mov al,[bx+si]
 add bx,bx

magicjump:
 mov di,di ; this is later toggled into either MOV or JMPS

 sub al,33
 jb lnop
 cmp al,'A'-33 ; 65 - 33 = 32
 jae abovea

; mov di,ax ; can't use XCHG b/c jumping to lpush for digits needs AL
; add di,di
; jmp word [di+table1]
 mov di,ax
 mov dl,byte [table1+di]
 jmp adjust

abovea:
 sub al,26
 jb lnop
 cmp al,'a'-33-26 ; 97-33-26 = 38
 jae abovea2

; ignore uppercase bugfix
 cmp al,'Z'-33-26 ; Z = 90
 jbe lnop

 sub al,'['-33-26 ; 91-33-26 = ' ' = 32

;mov di,ax
 xchg di,ax

; add di,di
; jmp word [di+table2]
 mov dl,byte [table2+di]
adjust:
 xor dh,dh
 add dx,200h
 jmp dx

abovea2:
 cmp al,'g'-33-26
 jz lget
 cmp al,'p'-33-26
 jz lput
 cmp al,'v'-33-26
 jz ldn
 cmp al,'|'-33-26
 jz lvif
 cmp al,'~'-33-26
 jnz lnop

linchr:
 mov di,bx
 call pop0
 call inch
 jmp setup

strmode:
 cmp al,'"' ; double quote = 22h = 34
 jz lstr

; and eax,0FFh

;cbw
;cwde
;push eax
 jmp extend_push_jump


lget:
 call setup_getput

;mov di,si
;add di,ax
;mov al,[di]
; mov bx,si ; sadly, this won't work when AH isn't zero (e.g. beer.bef)
; xlatb

 push si
 add si,ax
 lodsb
 pop si

extend_push_jump:
 cbw
 cwde
 jmp push_jump

lnop:
; add bh,0 ; number changed later
;magic0:
; add bl,2 ; number changed later
;magic1:
 add bl,magx
 add bh,magy

;and bx,7FFFh
 and bh,7Fh

 jmp interploop

lput:
 call setup_getput

;mov dx,ax
 xchg dx,ax

 call pop1
 mov di,si
 add di,dx

;mov [di],al
 stosb

 jmp lnop

lvif:
 call pop1
 and eax,eax
 jnz lup

ldn:
 mov magy,1
up_down:
 mov magx,0
 jmp lnop

; END OF INTERPRETER LOOP

; *********************************************************

lstr:
; strmode = 1E3h (483)
; magicjump+2 = 1A3h (419)
;
; 1E3h-1A3h = 40h (64)
; 0FFh xor 40h = 0BFh (191)
; 191 << 8 = 191 * (2^8) = 191 * 256 = 48896
;
; 89h (137) xor 0EBh (235) = 62h (98)
; 48896 + 98 = 48994
;
; 89h = MOV
; 0EBh = JMPS
;
; basically, this toggles the code into either a MOV (no-op) or a JMPS

; xor word [magicjump],0B562h ; (46434)
; xor word [magicjump],(89h ^ 0EBh)+((0FFh ^ (strmode-(magicjump+2))) << 8)
 xor word [magicjump],(89h xor 0EBh)+((255 xor (strmode-(magicjump+2))) shl 8)

; mov ax,strmode-(magicjump+2)
; not ax
; shl ax,8
; add ax,98
; int3
; xor word [magicjump],ax

 jmp lnop

; *********************************************************

lpush:
 sub al,'0'-33 ; 48-33 = 0Fh = 15

; cwde
;and eax,0Fh

 jmp push_jump

ladd:
 call pop2
 add eax,edx
 jmp push_jump

lsub:
 call pop2
 sub eax,edx
 jmp push_jump

lmul:
 call pop2
 mul edx
 jmp push_jump

ldiv:
 call divide
push_jump:
 push eax
 jmp lnop

lmod:
 call divide
 push edx
 jmp lnop

lnot:
 call pop1
 test eax,eax
 lea eax,[0]
 setz al
 jmp push_jump

lgreat:
 call pop2
 cmp eax,edx
 lea eax,[0]
 setg al
 jmp push_jump

lrt:
 mov magx,2
mov_jmp:
 mov magy,0
 jmp lnop1

lup:
 mov magy,-1
 jmp up_down

lrand:
 call rand

; mov ax,255
 stc
 salc ; oops, lucky that AH is zero here (somehow)

 and cx,3
 shr cx,1
 adc al,0 ; if set, carry will stay set
 adc al,0
 shl cl,3
 shl ax,cl
 add al,al
 mov magx,al
 mov magy,ah
 jmp lnop1

lhif:
 call pop1
 and eax,eax
 jz lrt

llt:
 mov magx,-2
 jmp mov_jmp

ldup:
 call pop1
 push eax
 jmp push_jump

lswap:
 call pop2
 push edx
 jmp push_jump

lpop:
 call pop1
 jmp lnop1

loutval:
 mov di,bx
 call pop0
 call outn
setup:
 mov bx,di
 mov si,fs
 jmp lnop1

loutchr:
 mov di,bx
 call pop0
 call outc
 jmp setup

lend:
; mov ah,4Ch  ; also closes open files
 mov ax,4C00h ; returns 0 errorlevel (but wastes an extra byte, meh)
 int 21h

lbridge:
 add bl,magx
 add bh,magy
lnop1:
 jmp lnop

linval:
 mov di,bx
 call pop0
 call innu
 jmp setup

pop0:
 pop cx
 cmp sp,[my_sp]
 jnz skippush
 push eax
skippush:
 jmp cx

pop1:
 pop di
 xor eax,eax
pop_it:
 cmp sp,[my_sp]
 jz skippop
 pop eax
skippop:
 jmp di

pop2:
 pop di
 xor eax,eax
;xor edx,edx
 cdq
 cmp sp,[my_sp]
 jz skippop
 pop edx

; cmp sp,[my_sp]
; jz skippop2
; pop eax
;skippop2:
; jmp di
 jmp pop_it

rand:
 cmp word [F1],179
 jnz seed
rn:
 push si
 mov si,S1

; mov ax,[S1]  ; This random number generator is from
 lodsw
 mul word [F1] ; an article I have. It is supposedly
 div word [M1] ; the 'Elkins' algorithm, and is
 mov [S1],dx   ; supposedly fairly decent. I've seen
 mov cx,dx     ; better, but don't have any at hand at
; mov ax,[S2]  ; the moment. Note that I fixed bugs.
 lodsw
 mul word [F2]
 div word [M2] ; The article is called 'Questions &
 mov [S2],dx   ; Answers MS-DOS' and is from some
 add cx,dx     ; Microsoft CD. (MS Development
; mov ax,[S3]  ; Library?)
 lodsw
 mul word [F3]
 div word [M3]
 mov [S3],dx
 add cx,dx
 sub cx,3
 pop si
 ret

seed:
 mov word [F1],179 ; use the BIOS clock as a seed
 xor ah,ah
 int 1Ah

; mov [S1],dx
; mov [S2],cx
 mov di,S1
 xchg ax,dx
 stosw
 xchg ax,cx
 stosw

 jmp rn

inch:
 cmp byte [ib+1],0
 jnz inch_ugc
 call read_it
inch_b:
 pop ax
 xor dx,dx
 push dx
 mov dl,[ib]
 cmp dl,13
 jz inch_nl
 push dx
 jmp ax

inch_ugc:
 mov byte [ib+1],0
 jmp inch_b
inch_nl:
 pop dx
 push ax
 jmp inch

innu: ; ignore 'til we get a number
 call innu_proc

; xor eax,eax
; mov al,-'0' ; -48 or 0D0h
 lea eax,[0D0h]

 add al,[ib]
 jmp innu_rn

innu_proc:
 pop bp
 call read_it
 cmp byte [bx],'-'
 jz innu_n
 cmp byte [bx],'0'
 jb innu
 cmp byte [bx],'9'
 ja innu
 jmp bp

innu_n: ; ignore extraneous '-' too, but make sure
        ; that we don't miss significant ones

 call innu_proc

;mov eax,-1
;xor eax,eax
;dec eax
;mov al,'0'
; mov eax,0FFFFFF30h ; -0D0h
 mov ax,-0D0h
 cwde

 sub al,[ib]
 xor byte [innu_as+1],28h ; turn ADD to SUB
innu_rn:

; mov esi,10
; lea esi,[10]

innu_l:
; push eax
 push ax
 call read_it
; pop eax
 pop ax
 cmp byte [bx],13 ; read past on CR
 jz innu_l
 cmp byte [bx],'0'
 jb innu_e
 cmp byte [bx],'9'
 ja innu_e

 imul eax,eax,10
; imul esi

 sub byte [bx],'0'
innu_as:
 add eax,dword [bx] ; changed to SUB later
 jmp innu_l
innu_e:
 pop bx
 push eax
 jmp bx

outc:
; cmp sp,0FFFCh
; jae outc_zero
 pop ax
 pop ebx
 push ax
 cmp bl,10
 jz outc_nl
 mov [dee],bl
outc_p:
 mov cx,1
doswrite2:
 mov dx,dee
 jmp doswrite

;outc_zero:
; mov [dee],byte 0
; jmp outc_p

outc_nl:
; mov [dee],byte 13
; call outc_p
; mov [dee],byte 10
; jmp outc_p
 mov word [dee],0A0Dh
 mov cx,2
 jmp doswrite2

outn:
; cmp sp,0FFFCh
; jae outn_zero
 pop cx
 pop eax

; mov esi,10
 lea esi,[10]

 mov bx,dee+10
 xor dx,dx

; test eax,80000000h
; jz outn_nn
;bt eax,31
;jnc outn_nn
 test eax,eax
 jns outn_nn

 dec dx
 neg eax
outn_nn:
 push dx
outn_l:
 xor edx,edx
 div esi
 add dl,'0'
 mov [bx],dl
 dec bx
 test eax,eax
 jnz outn_l
 pop dx
 test dl,dl
 jz outn_nnn
 mov byte [bx],'-'
 dec bx
outn_nnn:
 push cx
 mov cx,dee+11
 sub cx,bx
outn_p:
 mov dx,dee+12
 sub dx,cx
doswrite:
 mov ah,40h
 mov bx,1 ; 1 = stdout
 int 21h
 ret

;outn_zero:
; mov byte [dee+10],'0'
; mov cx,2
; jmp outn_p

read_it:
 xor bx,bx ; 0 = stdin
 mov cx,1
 mov dx,ib
read_it2:
 mov ah,3Fh
 int 21h
 mov bx,dx
 ret

divide:
 pop bp
 call pop2
 mov ecx,edx
 cdq
 idiv ecx
 jmp bp

setup_getput:
 pop bp
 call pop2
 mov ah,dl
 add al,al
 shr ax,1
 jmp bp

;table1:
;dw lnot,lstr,lbridge,lpop,lmod,linval,lnop
;dw lnop,lnop,lmul,ladd,loutchr,lsub,loutval,ldiv
;dw lpush,lpush,lpush,lpush,lpush,lpush,lpush,lpush,lpush,lpush
;dw ldup,lnop,llt,lnop,lrt,lrand,lend
;table2:
;dw lnop,lswap,lnop,lup,lhif,lgreat

table1:
db lnot-200h,lstr-200h,lbridge-200h,lpop-200h,lmod-200h,linval-200h,lnop-200h
db lnop-200h,lnop-200h,lmul-200h,ladd-200h,loutchr-200h,lsub-200h,loutval-200h,ldiv-200h
db lpush-200h,lpush-200h,lpush-200h,lpush-200h,lpush-200h,lpush-200h,lpush-200h,lpush-200h,lpush-200h,lpush-200h
db ldup-200h,lnop-200h,llt-200h,lnop-200h,lrt-200h,lrand-200h,lend-200h
table2:
db lnop-200h,lswap-200h,lnop-200h,lup-200h,lhif-200h,lgreat-200h

;badfilemsg: db '?$'
;badfilemsg: db 'Bad file',13,10,'$'
;needfilemsg: db 'Need filename',13,10,'$'
;emptyfilemsg: db 'Empty file',13,10,'$'

dee: db '-1234567890 '

S1: db 'BE'
S2: db 'MC'
S3: db 'BC'
F2: dw 183
F3: dw 182
M1: dw 32771
M2: dw 32779
M3: dw 32783

my_magx: db 2
my_magy: db 0

F1: dw 0
ib: db 0,0,0,0

my_sp: rb 2


;befungecode:

; <EOF>