BITS 16
org 0x7C00
cli
xor ax, ax
mov ds, ax
mov es, ax
mov ss, ax
mov sp, 0x8000
sti
mov ax, 3
int 0x10
mov bp, loading
mov ax, 0x1301
mov bx, 7
mov cx, 12
mov dx, 0x0102
int 0x10
mov bl, 2
mov ah, 2
mov dx, 0x0201
int 0x10
mov ah, 9
mov al, '.'
mov cx, 14
int 0x10
mov di, 0x0050
mov ax, 19
mov cx, 14
call read
mov di, 0x0210
mov ax, 1
mov cx, 9
call read
mov dx, 224
mov bx, 0x0500
search:
    cld
    mov si, filename
    mov cx, 11
    mov di, bx
    repe cmpsb
    je found
    add bx, 32
    dec dx
    jz error
    jmp search
read:
	pusha
	mov bl, 18
	div bl
	mov cl, ah
	inc cl
	xor ah, ah
	mov bl, 2
	div bl
	mov ch, al
	mov dh, ah
	mov ax, cx
	mov cx, 10
	.retry:
	    push es
	    push cx
	    mov cx, ax
	    push cx
	    xor ax, ax
	    push dx
	    int 0x13
	    jc .failed
	    pop dx
	    pop cx
	    xor bx, bx
	    mov es, di
	    mov ax, 0x0201
	    int 0x13
	    jnc .success
	.failed:
	    pop dx
	    pop ax
	    pop cx
	    pop es
	    loop .retry
	    mov bp, failure
        mov ax, 0x1301
        mov bx, 4
        mov cx, 11
        mov dx, 0x0401
        int 0x10
        mov ah, 0
        int 0x16
        int 0x19
	.success:
	    pop cx
	    pop es
	    popa
	    add di, 32
	    inc ax
	    loop read
	    ret
found:
	mov bp, [bx+26]
	mov di, 0x0800
	.block:
	    xor cx, cx
	    mov cl, 1
	    mov si, bp
	.contig:
	    mov ax, 3
	    mul si
	    shr ax, 1
	    mov bx, ax
	    mov ax, word [(0x2100+bx)]
	    jc .odd
	    and ax, 0x0FFF
	    jmp .next
	.odd:
	    shr ax, 4
	.next:
	    inc si
	    cmp ax, si
	    jne .pass
	    inc cl
	    adc ch, 0
	    jmp .contig
	.pass:
	    xchg bp, ax
	    dec ax
	    dec ax
	    mov dx, 1
	    mul dx
	    add ax, 33
	    call read
	    cmp bp, 0x0FF8
	    jb .block
.386
model flat
	extrn strlen:proc
	extrn isalnum:proc
	extrn isxdigit:proc
.code
node.left  equ 0
node.right equ 4
node.type  equ 8
TYPE_S  equ 0
TYPE_K  equ 1
TYPE_I  equ 2
TYPE_BI equ 3
section '.text' code readable executable writeable
    proc _start
        invoke HeapCreate, 0, 0, 0
        mov DWORD [asmh], eax
        invoke GetModuleHandleA, 0
        invoke CreateDialogParamA, eax, 1, 0, DialogProc, 0
        mov DWORD [hDlg], eax
        invoke ShowWindow, eax, SW_SHOW
    .message_loop:
        invoke GetMessage, msg, 0, 0, 0
        test eax, eax
        je .quit
        inc eax
        jne .isdlg
        push 1
        jmp .die
    .isdlg:
        invoke IsDialogMessageA, hDlg, msg
        test eax, eax
        jne .message_loop
        invoke TranslateMessage, msg
        invoke DispatchMessage, msg
        jmp .message_loop
    .quit:
        push 0
    .die:
        call [ExitProcess]
    endp
    proc DialogProc
        push ebp
        mov ebp, esp
        sub esp, 16
        mov edx, DWORD [ebp+12]
        mov eax, DWORD [ebp+8]
        mov ecx, DWORD [ebp+16]
        cmp edx, WM_CLOSE
        je .close_handler
        cmp edx, WM_COMMAND
        je .command_handler
        cmp edx, WM_DESTROY
        jne .no_op
        invoke PostQuitMessage, 0
        jmp .c_exit
    .close_handler:
        invoke DestroyWindow, eax
    .c_exit:
        xor ebx, ebx
        inc ebx
        jmp .die
    .command_handler:
        cmp cx, 2
        jne .not_quit
        invoke DestroyWindow, eax
    .no_op:
        xor ebx, ebx
        jmp .die
    .not_quit:
        xor ebx, ebx
        dec cx
        jne .die
        invoke GetDlgItem, eax, 3
        mov DWORD [wnd], eax
        invoke GetWindowTextLengthA, eax
        mov ecx, esp
        lea edx, [eax+1]
        add eax, 17
        and eax, 0xFFFFFFF0
        sub ecx, eax
        mov esp, ecx
        mov BYTE [esp], 0
        mov DWORD [ebp-12], ecx
        invoke GetWindowTextA, DWORD [wnd], ecx, edx
        mov ecx, DWORD [ebp-12]
        call eval
        invoke SetWindowText, DWORD [wnd], eax
    .die:
        lea esp, [ebp-8]
        mov eax, ebx
        pop ebx
        pop esi
        pop ebp
        ret 16
    endp
    proc str_size
        push esi ebx
        xor esi, esi
        mov ebx, eax
    .loop:
        cmp DWORD [ebx+node.type], TYPE_BI
        jne .quit
        mov eax, DWORD [ebx+node.left]
        call str_size
        mov ebx, DWORD [ebx+node.right]
        lea esi, [esi+eax+2]
        jmp .loop
    .quit:
        lea eax, [esi+1]
        pop ebx esi
        ret
    endp
    proc stringify
        push ebx
        mov ebx, eax
        mov edx, DWORD [eax+node.type]
        mov eax, DWORD [buf]
        inc eax
        mov DWORD [buf], eax
        dec eax
        cmp edx, TYPE_BI
        jne .combinator
        mov BYTE [eax], '('
        mov eax, DWORD [ebx+node.left]
        call stringify
        mov eax, DWORD [ebx+node.right]
        call stringify
        mov eax, DWORD [buf]
        mov BYTE [eax], ')'
        inc eax
        mov DWORD [buf], eax
        dec eax
        jmp .stop
    .combinator:
        mov dl, BYTE [ski+edx]
        mov BYTE [eax], dl
    .stop:
        pop ebx
        ret
    endp
    proc free
        invoke HeapFree, DWORD [asmh], 0, eax
        ret
    endp
    proc free_tree
        push ebx
        mov ebx, eax
        cmp DWORD [eax+node.type], TYPE_BI
        jne .no_children
        mov eax, DWORD [eax+node.left]
        call free_tree
        mov eax, DWORD [ebx+node.right]
        call free_tree
    .no_children:
        mov eax, ebx
        pop ebx
        jmp free
    endp
    proc alloc_node
        push ebx
        mov ebx, eax
        invoke HeapAlloc, DWORD [asmh], HEAP_ZERO_MEMORY, 4 + 4 + 4
        mov DWORD [eax+node.type], ebx
        pop ebx
        ret
    endp
    proc read_node
        push ebx
        mov eax, DWORD [code]
        inc eax
        mov DWORD [code], eax
        dec eax
        mov al, BYTE [eax]
        cmp al, 'K'
        je  .read_k
        jg  .maybe_s
        cmp al, '('
        je  .read_bitree
        cmp al, 'I'
        jne .parse_error
        push TYPE_I
        pop eax
        jmp .build_node
    .maybe_s:
        cmp al, 'S'
        jne .parse_error
        xor eax, eax
        jmp .build_node
    .read_bitree:
        push TYPE_BI
        pop eax
        call alloc_node
        mov ebx, eax
        call read_node
        mov DWORD [ebx+node.left], eax
        test eax, eax
        je .nullify
        call read_node
        mov DWORD [ebx+node.right], eax
        test eax, eax
        je .nullify
        inc DWORD [code]
        jmp .die
    .read_k:
        xor eax, eax
        inc eax
    .build_node:
        pop ebx
        jmp alloc_node
    .parse_error:
        invoke MessageBoxA, 0, msge, 0, MB_OK
    .nullify:
        xor ebx, ebx
    .die:
        mov eax, ebx
        pop ebx
        ret
    endp
    proc dup_tree
        push esi ebx
        mov ebx, eax
        mov eax, DWORD [eax+node.type]
        call alloc_node
        cmp DWORD [ebx+node.type], TYPE_BI
        jne .shallow
        mov esi, eax
        mov eax, DWORD [ebx+node.left]
        call dup_tree
        mov DWORD [esi+node.left], eax
        mov eax, DWORD [ebx+node.right]
        call dup_tree
        mov DWORD [esi+node.right], eax
        mov eax, esi
    .shallow:
        pop ebx esi
        ret
    endp
    proc eval_step
        push edi esi ebx
        mov ebx, eax
        mov eax, DWORD [eax+node.left]
        test eax, eax
        je .no_left
        cmp DWORD [eax+node.type], TYPE_I
        jne .not_inode
        mov esi, DWORD [ebx+node.right]
        jmp .clean
    .not_inode:
        mov edx, DWORD [eax+node.left]
        test edx, edx
        je .no_left
        cmp DWORD [edx+node.type], TYPE_K
        jne .not_knode
        mov esi, DWORD [eax+node.right]
        mov eax, DWORD [ebx+node.right]
        call free_tree
        mov eax, DWORD [ebx+node.left]
        mov eax, DWORD [eax+node.left]
    .clean:
        call free_tree
        mov eax, ebx
        call free
    .yield_saved:
        mov ebx, esi
        jmp .done
        cmp DWORD [ebx+node.type], TYPE_BI
        jne .done
        call eval_step
        mov DWORD [ebx+node.left], eax
        mov eax, DWORD [ebx+node.right]
        call eval_step
        mov DWORD [ebx+node.right], eax
    .done:
        mov eax, ebx
        pop ebx esi edi
        ret
    endp
    eval:
        push esi ebx
        mov ebx, ecx
        mov DWORD [code], ecx
        call read_node
        test eax, eax
        je .read_fail
        call eval_step
        mov esi, eax
        call str_size
        inc eax
        invoke HeapAlloc, DWORD [asmh], 0, eax
        mov DWORD [buf], eax
        mov ebx, eax
        mov eax, esi
        call stringify
        mov eax, DWORD [buf]
        mov BYTE [eax], 0
        mov eax, esi
        call free_tree
    .read_fail:
        mov eax, ebx
        pop ebx esi
        ret
wnd:  dd 0
msg   MSG
hDlg: dd 0
asmh: dd 0
buf:  dd 0
code: dd 0
ski:  db 'SKI', 0
msge: db '?', 0
section '.rsrc' resource data readable
directory RT_DIALOG, dialogs
resource dialogs, 1, LANG_ENGLISH+SUBLANG_DEFAULT, demo
dialog demo,'SKI calculus',70,70,330,20,WS_CAPTION+WS_POPUP+WS_SYSMENU+DS_MODALFRAME
    dialogitem 'STATIC', '&Code: ', 4, 4, 5, 21, 9, WS_VISIBLE+WS_CHILD+WS_GROUP
    dialogitem 'BUTTON', '&Quit', 2, 269, 4, 50, 11, BS_PUSHBUTTON+WS_CHILD+WS_VISIBLE+WS_GROUP
    dialogitem 'BUTTON', '&Evaluate', 1, 218, 4, 50, 11, BS_DEFPUSHBUTTON+WS_CHILD+WS_VISIBLE+WS_GROUP
    dialogitem 'EDIT', '', 3, 28, 3, 187, 14, ES_LEFT+WS_CHILD+WS_VISIBLE+WS_BORDER+WS_GROUP+ES_AUTOHSCROLL
enddialog
section '.idata' import data readable writable
library kernel32, 'KERNEL32.DLL', \
        user32, 'USER32.DLL'
include 'api\kernel32.inc'
include 'api\user32.inc'
	jae	out_of_memory
	push	eax esi
	clc
	call	near dword [esp+8]
	pop	ebx eax
	dec	eax
	jz	data_defined
	mov	esi,ebx
	jmp	duplicate_single_data_value
      duplicate_zero_times:
	cmp	byte [esi],91h
	jne	skip_single_data_value
	inc	esi
      skip_data_value:
	call	skip_symbol
	jc	invalid_argument
	cmp	byte [esi],92h
	jne	skip_data_value
	inc	esi
	jmp	data_defined
	cmp	al,'('
	jne	invalid_operand
	mov	al,[value_type]
	push	eax
	cmp	byte [esi],'.'
	je	invalid_value
	call	get_dword_value
	call	mark_relocation
	stos	dword [edi]
	pop	eax
	mov	[value_type],al
	pop	eax
	call	mark_relocation
	stos	word [edi]
	ret
data_qwords:
	call	define_data
	jc	instruction_assembled
	lods	byte [esi]
	cmp	al,'('
	je	get_qword
	cmp	al,'?'
	jne	invalid_argument
	mov	ecx,1000
	mul	ecx
	mov	ebx,eax
	mov	eax,dword [buffer+4]
	div	ecx
        OR      AL,AL
        JZ      CURRISROOT
        JMP     SHORT SETDIRLP
CURRISROOT:
        MOV     WORD PTR [THISDPB+2],DS
        PUSH    CS
        POP     DS
ASSUME  DS:DG
        MOV     WORD PTR [THISDPB],BX
        MOV     AX,(GET_INTERRUPT_VECTOR SHL 8) OR 23H
        INT     21H
        MOV     WORD PTR [CONTCH],BX
        MOV     WORD PTR [CONTCH+2],ES
        MOV     AX,(SET_INTERRUPT_VECTOR SHL 8) OR 23H
        MOV     DX,OFFSET DG:INT_23
        INT     21H
        MOV     AX,(GET_INTERRUPT_VECTOR SHL 8) OR 24H
        INT     21H
        MOV     WORD PTR [HARDCH],BX
        MOV     WORD PTR [HARDCH+2],ES
        MOV     AX,(SET_INTERRUPT_VECTOR SHL 8) OR 24H
        MOV     DX,OFFSET DG:INT_24
        INT     21H
        PUSH    CS
        POP     ES
        MOV     DX,OFFSET DG:ROOTSTR
        MOV     AH,CHDIR
        INT     21H
        MOV     DX,OFFSET DG:BADCD
        JC      CERROR2J
        MOV     DX,OFFSET DG:FAT
        MOV     AH,SET_DMA
        INT     21H
        MOV     DX,OFFSET DG:VOLID
        MOV     AH,DIR_SEARCH_FIRST
        INT     21H
        CMP     AL,-1
        JZ      NOTVOLID
        CALL    PRINTID
NOTVOLID:
        LDS     BX,[THISDPB]
ASSUME  DS:NOTHING
        MOV     AX,[BX.dpb_sector_size]
        MOV     [SSIZE],AX
        MOV     AL,[BX.dpb_cluster_mask]
        INC     AL
        MOV     [CSIZE],AL
        MOV     AX,[BX.dpb_max_cluster]
        MOV     [MCLUS],AX
        DEC     AX
        MOV     [DSIZE],AX
        MOV     AL,[BX.dpb_FAT_size]
        XOR     AH,AH
        MOV     CX,AX
        MUL     [SSIZE]
        ADD     [FATMAP],AX
        MOV     AX,[FATMAP]
        ADD     AX,[MCLUS]
        ADD     AX,2
        MOV     [SECBUF],AX
        ADD     AX,[SSIZE]
        ADD     AX,20
        MOV     [STACKLIM],AX
        MOV     DI,CX
        MOV     CL,[BX.dpb_FAT_count]
        MOV     DX,[BX.dpb_first_FAT]
        PUSH    CS
        POP     DS
ASSUME  DS:DG
        MOV     BX,OFFSET DG:FAT
        MOV     AL,[ALLDRV]
        DEC     AL
        MOV     AH,'1'