.186
locals @@
code segment
     assume cs:code,ds:code,es:nothing
;     org 00100h
begin:
     push cs
     pop ds

     push offset logo
     call strout
     call check_params
     or ax,ax
     jnz get_mem
     push offset no_param_str
     call init_error
get_mem: 
     add ax,00081h
     mov bx,ax                     ;add NULL-teminator
     mov byte ptr [bx],NULL        ;to the end of .BAS file name  
     call get_file_size
     or ax,ax
     jnz check_size
     push offset find_err_str
     call init_error
check_size:     
     call check_file_size
     or ax,ax
     jnz store_size
     push offset size_err_str
     call init_error
store_size:     
     mov file_size,ax
     mov sp,offset loc_stk         ;set local stack
     call malloc                   ;try to allocate file_size bytes
     or ax,ax
     jnz init_es
     push offset mem_err_str
     call init_error     
init_es:     
     mov es,ax                     ;value in ES must not be changed !!!          
     call load_program
     or ax,ax
     jnz run_basic
     push 001h                     ;error message is already displayed
     call exit_program             ;inside load_program
run_basic:
     call scan_labels
do:     
     call get_token
     cmp al,UNDEF
     jne check_variable
     push SYNTAX
     call serror     
check_variable:     
     cmp al,VARIABLE
     jne check_label
     call putback
;     call assignment
     jmp do
check_label:  
     cmp al,LAB
     jne exec_command
     call get_token
     jmp do   
exec_command:     
     mov al,tok
     cbw
     shl ax,001h
     mov bx,ax
     call word ptr jmp_table[bx]     
     jmp do 
;-----------------------------------------------------------------------------     
;INITIALIZATION SUBROUTINES

check_params proc pascal near
;             mov al,ds:[00080h]
             mov al,par_count
             cbw
             ret   
check_params endp

malloc proc pascal near
       uses bx
              
       mov ah,04Ah
       mov bx,IMAGE_PAR
       int 021h
       jc @@fail
       mov bx,file_size
       test bl,00Fh
       jz @@convert
       or bl,00Fh
       inc bx
@@convert:
       shr bx,004h
       add bx,PSP_SIZE shr 004h
       mov ah,048h
       int 021h  
       jnc @@exit
@@fail:
       xor ax,ax 
@@exit:       
       ret
malloc endp

init_error proc pascal near
           arg @@str:WORD
           
           push @@str
           call strout
           push 001h
           call exit_program          
           ret
init_error endp

get_file_size proc pascal near
              uses cx,dx

              mov ah,4Eh
              xor cx,cx
              mov dx,offset par+1;NAME_OFFS
              int 021h
              jc @@fail
              mov ax,0001h
              jmp @@exit
@@fail:
              xor ax,ax  
@@exit:                       
              ret
get_file_size endp
                  
check_file_size proc pascal near
                mov ax,ds:[0009Ch]
                or ax,ax
                jnz @@wrong_size
                mov ax,ds:[0009Ah]
                cmp ax,PROG_SIZE
                jb @@exit     
@@wrong_size:     
                xor ax,ax       
@@exit:
                mov ax,0B5h
                ret
check_file_size endp

open_file proc pascal near
          uses dx          
          
          mov ax,03D00h  ;read-only mode
          mov dx,offset par+1;NAME_OFFS
          int 021h
          jnc @@exit
          xor ax,ax
@@exit:          
          ret
open_file endp

read_file proc pascal near
          uses bx,cx,dx,ds
          
          mov ah,03Fh
          mov bx,handle
          mov cx,file_size
          mov dx,START_ADDR
          push es
          pop ds
          int 021h
          jnc @@exit
          xor ax,ax
@@exit:          
          ret
read_file endp

close_file proc pascal near
           uses bx
           
           mov ah,03Eh
           mov bx,handle
           int 021h
           jc @@fail
           mov ax,00001h
           jmp @@exit
@@fail:
           xor ax,ax
@@exit:        
           ret
close_file endp

load_program proc pascal near             
             uses bx

             call open_file
             or ax,ax
             jnz @@store_handle
             push offset open_err_str
             call strout
             jmp @@exit
@@store_handle:             
             mov handle,ax        
             call read_file
             or ax,ax
             jnz @@file_close             
             push offset read_err_str
             call strout             
             jmp @@exit
@@file_close:
             call close_file
             or ax,ax
             jnz @@fix_tail
             push offset close_err_str
             call strout
             jmp @@exit
@@fix_tail:             
             mov bx,file_size
             add bx,START_ADDR
             mov al,es:[bx-001h]
             cmp al,01Ah
             jne @@mark_tail
             mov byte ptr es:[bx-001h],NULL
             jmp @@ok
@@mark_tail:         
             mov byte ptr es:[bx],NULL
@@ok:
             mov ax,00001h                        
@@exit:             
             ret
load_program endp
;-----------------------------------------------------------------------------
;TOKEN ANALYSIS

get_token proc pascal near
          uses si,di

          mov token_type,UNDEF
          mov tok,UNDEF
          mov si,offset token
          mov di,_ip
          cmp byte ptr es:[di],NULL
          jne @@skip_white
;--------------------------------
          mov tok,_FINISHED
          mov token_type,DELIMITER
          jmp @@exit
;--------------------------------          
@@skip_white:       
          push es:[di]
          call iswhite          
          or ax,ax
          jz @@check_eol
          inc di
          jmp @@skip_white
@@check_eol:          
          cmp es:[di],CR 
          jne @@check_delim
;-------------------------------
          mov ax,es:[di]
          mov [si],ax
          add di,00002h
          add si,00002h
          mov tok,_EOL
          mov token_type,DELIMITER
          jmp @@update_ip
;-------------------------------
@@check_delim:          
          push offset syntax_delim 
          push es:[di]
          push SYNTAX_DELIM_LEN
          call strchr
          or ax,ax
          jz @@check_quote
;-------------------------------
          mov al,es:[di]
          mov [si],al
          inc di
          inc si
          mov token_type,DELIMITER
          jmp @@update_ip
;-------------------------------
@@check_quote:          
          cmp byte ptr es:[di],'"'
          jne @@check_digit
;-------------------------------
          inc di
@@while:
          cmp byte ptr es:[di],'"'
          je @@end_while
          cmp es:[di],CR
          je @@end_while
          mov al,es:[di]
          mov [si],al
          inc si
          inc di
          jmp @@while
@@end_while:         
          cmp byte ptr es:[di],'"'
          je @@found_quote
          push MISS_QUOTE 
          call serror
@@found_quote:          
          inc di
          mov token_type,QUOTE
          jmp @@update_ip          
;-------------------------------
@@check_digit:          
          push es:[di]
          call isdigit
          or ax,ax
          jz @@check_alpha
;-------------------------------
@@copy_digit:
          push es:[di]
          call isdelim
          or ax,ax
          jnz @@end_digit
          mov al,es:[di]
          mov [si],al
          inc si
          inc di
          jmp @@copy_digit
@@end_digit:          
          mov token_type,NUMBER
          jmp @@update_ip
;-------------------------------          
@@check_alpha:
          push es:[di]
          call isalpha
          or ax,ax
          jz @@exit
@@copy_alpha:          
          push es:[di]
          call isdelim
          or ax,ax
          jnz @@end_alpha
          mov al,es:[di]
          mov [si],al
          inc si
          inc di
          jmp @@copy_alpha
@@end_alpha:          
          mov byte ptr [si],NULL
          push offset token
          call look_up
          mov tok,al
          or al,al
          jz @@check_label
          mov token_type,COMMAND
          jmp @@update_ip
@@check_label:          
          cmp es:[di],COLON
          jne @@set_variable
          mov token_type,LAB
          jmp @@update_ip
@@set_variable:
          mov token_type,VARIABLE          
@@update_ip:
          mov _ip,di
@@exit:
          mov byte ptr [si],NULL
          mov al,token_type
          ret      
get_token endp

isdelim proc pascal near
        arg @@char:BYTE
        
        mov al,@@char
        push offset syntax_delim
        push ax
        push SYNTAX_DELIM_LEN
        call strchr
        or ax,ax
        jnz @@exit
        mov al,@@char
        cmp al,'"'
        je @@exit
        cmp al,TAB
        je @@exit
        cmp al,CR
        je @@exit
        cmp al,SPACE
        je @@exit
        or al,al
        jz @@exit        
@@fail:
        xor ax,ax
        ret
@@exit:
        mov ax,00001h
        ret
isdelim endp

look_up proc pascal near     
        arg @@str:WORD
        uses di
        
        push @@str
        call strlwr
        mov di,offset cmd_table
@@check_next:      
        cmp byte ptr [di],NULL          ;end of command's table?
        je @@fail
        push di
        push @@str
        call strcmp
        or ax,ax
        jz @@seek_next                  ;strings are not match
        mov al,[di].tkn
        jmp @@exit        
@@seek_next:        
        add di,size oper
        jmp @@check_next      
@@fail:
        xor ax,ax
@@exit:        
        ret
look_up endp

get_next_label proc pascal near
               arg @@str:WORD
               uses di
               
               mov di,offset label_table
@@check_next:
               cmp byte ptr [di],NULL
               jne @@check_dup
               mov ax,di
               jmp @@exit
@@check_dup:
               push di
               push @@str
               call strcmp
               or ax,ax
               jz @@calc_next
               mov ax,-00002h
               jmp @@exit
@@calc_next:
               add di,size label_struct
               cmp di,(offset label_table)+NUM_LAB*size label_struct
               jb @@check_next
               mov ax,-00001h 
@@exit:
               ret
get_next_label endp

scan_labels proc pascal near
            local @@temp:WORD
            uses ax,bx
            
            mov ax,_ip
            mov @@temp,ax
@@do:       
            call get_token
            cmp al,LAB
            jne @@check_eol
            push offset token
            call get_next_label
            cmp ax,-00001h
            jne @@check_dup_lab
            push LAB_TAB_FULL
            call serror
@@check_dup_lab:
            cmp ax,-00002h
            jne @@check_len
            push DUP_LAB
            call serror
@@check_len:
            push ax
            push offset token
            call strlen
            cmp ax,LAB_LEN-001h
            pop ax
            jbe @@check_res
            call putback
            push LONG_LAB
            call serror
@@check_res:
            push ax
            push offset token
            call look_up
            or al,al
            pop ax
            jz @@save_label
            call putback
            push RESERVED_WORD
            call serror
@@save_label:
            push offset token
            mov bx,ax
            push bx
            call strcpy
            call get_token
            mov ax,_ip
            mov [bx].p,ax
@@check_eol:    
            cmp tok,_EOL
            je @@do
            call find_eol
            cmp tok,_FINISHED
            jne @@do
            mov ax,@@temp
            mov _ip,ax
            ret
scan_labels endp

find_eol proc pascal near
         uses di
         
         mov di,_ip
@@next_sym:         
         cmp es:[di],LF
         jne @@check_null
         inc di 
         jmp @@update_ip
@@check_null:         
         cmp byte ptr es:[di],NULL
         je @@update_ip
         inc di
         jmp @@next_sym
@@update_ip:         
         mov _ip,di
         ret
find_eol endp

putback proc pascal near
        uses ax  

        push offset token
        call strlen
        sub _ip,ax
        ret
putback endp

find_var_index proc pascal near
               arg @@str:WORD
               uses di
               
               mov di,@@str
               push [di]
               call isalpha
               or ax,ax
               jnz @@check_len
               push NOT_VAR
               call serror
@@check_len:
               cmp byte ptr [di+001h],NULL
               jz @@exit
               call putback
               push SYNTAX
               call serror
@@exit:
               mov al,[di]
               or al,020h
               sub al,'a'
               cbw
               shl ax,001h
               ret
find_var_index endp

find_var proc pascal near
         arg @@str:WORD
         uses di
         
         push @@str
         call find_var_index
         mov di,ax
         mov ax,offset variables[di]
         ret
find_var endp

assignment proc pascal near
           uses ax,bx
           local @@var:RES_TYPE
           
           call get_token
           push offset token
           call find_var_index
           mov @@var,ax
           call get_token
           cmp token,_ASSIGN
           je @@enable_assign
           call putback
           push EQUAL_EXP
           call serror
@@enable_assign:           
           call eval_expr
           mov bx,@@var
           mov variables[bx],ax
           ret
assignment endp
;-----------------------------------------------------------------------------
;INTERPRETER SUBROUTINES

include print.inc
include return.inc
include gosub.inc
include input.inc
include eval.inc
include goto.inc
include for.inc
include next.inc
include if.inc
include end.inc
include cls.inc
include rem.inc
include eol.inc
include finish.inc
include beep.inc

serror proc pascal near
       arg @@err_code:WORD
       uses bx,di
       
       mov bx,@@err_code
       shl bx,00001h
       push err_table[bx]
       call strout
       xor bx,bx
       mov di,START_ADDR-001h
@@scan_lines:
       inc di
       cmp di,_ip       
       je @@out_line
       cmp [di],CR
       jne @@scan_lines
       inc bx       
       jmp @@scan_lines
@@out_line:
       push offset on_line_str
       call strout
       push bx
       push offset str_buf
       call itoa
       push offset str_buf
       call strout
@@next_sym:       
       cmp di,START_ADDR
       jb @@out_error
       cmp [di],LF
       je @@out_error
       dec di
       jmp @@next_sym
@@out_error:
       inc di
       cmp [di],LF
       je @@new_line
       cmp byte ptr [di],NULL
       je @@new_line
       push [di]
       call charout
       jmp @@out_error
@@new_line:
       call newline
       push 001h
       call exit_program
       ret
serror endp
;-----------------------------------------------------------------------------
;SECTION OF CONSTANTS

STK_SIZE     equ 00400h                                                                  
PSP_SIZE     equ 00100h
START_ADDR   equ 00Fh         ;not 0 - to avoid object with address ????:0                                                                                                                             
PROG_SIZE    equ 0FFFFh-START_ADDR
NAME_OFFS    equ 00082h

MAX_CMD_LEN  equ 014h
NUM_LAB      equ 032h
LAB_LEN      equ 015h
FOR_NEST     equ 019h
SUB_NEST     equ 019h
STR_BUF_LEN  equ 00Ah
UNDEF        equ <byte ptr 000h>
DELIMITER    equ <byte ptr 001h>
VARIABLE     equ <byte ptr 002h>
NUMBER       equ <byte ptr 003h>
COMMAND      equ <byte ptr 004h>
STRING       equ <byte ptr 005h>
QUOTE        equ <byte ptr 006h>
LAB          equ <byte ptr 008h>
;-----------------------------------------------------------------------------
;EXECUTABLE TOKENS

_PRINT       equ <byte ptr 001h>
_INPUT       equ <byte ptr 002h>
_IF          equ <byte ptr 003h> 
_FOR         equ <byte ptr 004h>
_NEXT        equ <byte ptr 005h>
_GOTO        equ <byte ptr 006h>
_GOSUB       equ <byte ptr 007h>
_RETURN      equ <byte ptr 008h>
_END         equ <byte ptr 009h>
_CLS         equ <byte ptr 00Ah>
_REM         equ <byte ptr 00Bh>
_EOL         equ <byte ptr 00Ch>
_FINISHED    equ <byte ptr 00Dh>
_BEEP        equ <byte ptr 00Eh>
;-----------------------------------------------------------------------------
;NON-EXECUTABLE TOKENS

_THEN        equ <byte ptr 00Fh> 
_TO          equ <byte ptr 010h>
_LE          equ <byte ptr 011h>
_GE          equ <byte ptr 012h>
_NE          equ <byte ptr 013h>
;-----------------------------------------------------------------------------
include macro.inc
include auxil.inc
;-----------------------------------------------------------------------------
;SECTION OF VARIABLES

_ip           dw START_ADDR
p_buf         dw START_ADDR
handle        dw 00000h
file_size     dw 00000h
ftos          dw 00000h
gtos          dw 00000h
token_type    db UNDEF
tok           db UNDEF
token         db 050h dup(000h)
syntax_delim  db ':;,<>+-*/=()'
SYNTAX_DELIM_LEN equ $-syntax_delim              
on_line_str   db ' on line ',NULL
question_str  db '? ',NULL
str_buf       db STR_BUF_LEN,000h,STR_BUF_LEN dup(000h)

;SEQUENCE OF FOLLOWING ITEMS MUST STRICTLY MATCH
;TO VALUES OF CORRESPONDING MACROS (IN RISING ORDER)
jmp_table     dw NULL
              dw exec_print
              dw exec_input
              dw exec_if
              dw exec_for
              dw exec_next
              dw exec_goto
              dw exec_gosub
              dw exec_return
              dw exec_end
              dw exec_cls
              dw exec_rem
              dw exec_eol
              dw exec_finished
              dw exec_beep
              
par_count     db PAR_LEN-1
par           db ' a.bas',NULL
PAR_LEN       equ $-par

oper struc
     cmd db MAX_CMD_LEN dup(000h)
     tkn db 000h
oper ends

cmd_table     oper <'print',_PRINT>
              oper <'input',_INPUT>
              oper <'if',_IF>
              oper <'then',_THEN>
              oper <'goto',_GOTO>
              oper <'for',_FOR>
              oper <'next',_NEXT>
              oper <'to',_TO>
              oper <'gosub',_GOSUB>
              oper <'return',_RETURN>
              oper <'end',_END>
              oper <'cls',_CLS>
              oper <'rem',_REM>
              oper <'beep',_BEEP>
              oper <NULL>

label_struct struc
                  db LAB_LEN dup(000h) ;name
             p    dw 000h
label_struct ends
              
label_table   label_struct NUM_LAB dup(<>)              

for_struct struc
           var    dw 00000h
           target dw 00000h
           loc    dw 00000h
           next   dw 00000h
for_struct ends
              
fstack        for_struct FOR_NEST dup(<>)              
variables     dw 01Ah dup(00000h)  
gstack        dw SUB_NEST dup(00000h)
              
no_param_str  db "MBASIC: Отсутствует имя .BAS-файла!",CR,LF,007h,NULL
mem_err_str   db "MBASIC: Ошибка инициализации памяти!",CR,LF,007h,NULL   
open_err_str  db "MBASIC: Ошибка открытия .BAS-файла!",CR,LF,007h,NULL
read_err_str  db "MBASIC: Ошибка чтения .BAS-файла!",CR,LF,007h,NULL
size_err_str  db "MBASIC: .BAS-файл имеет недопустимый размер!",CR,LF,007h,NULL
find_err_str  db "MBASIC: Не могу найти .BAS-файл!",CR,LF,007h,NULL
close_err_str db "MBASIC: Ошибка закрытия .BAS-файла!",CR,LF,007h,NULL
;-----------------------------------------------------------------------------
;ERROR CODES & MESSAGES

SYNTAX          equ 000h
UNBAL_PARENS    equ 001h
NO_EXP          equ 002h
EQUAL_EXP       equ 003h
NOT_VAR         equ 004h
LAB_TAB_FULL    equ 005h
DUP_LAB         equ 006h
UNDEF_LAB       equ 007h
THEN_EXP        equ 008h
TO_EXP          equ 009h
TOO_MNY_FOR     equ 00Ah
NEXT_WO_FOR     equ 00Bh
TOO_MNY_GOSUB   equ 00Ch
RET_WO_GOSUB    equ 00Dh
MISS_QUOTE      equ 00Eh
FOR_WO_NEXT     equ 00Fh
RESERVED_WORD   equ 010h
LONG_LAB        equ 011h
GOTO_WO_LAB     equ 012h
DIV_BY_ZERO     equ 013h
INVALID_NUMBER  equ 014h
NUMBER_TOO_LONG equ 015h

syntax_err_str    db CR,LF,'Syntax error',NULL
unbal_parens_str  db CR,LF,') expected',NULL
no_exp_str        db CR,LF,'No expression',NULL
equal_exp_str     db CR,LF,'= expected',NULL
not_var_str       db CR,LF,'Not variable',NULL
lab_tab_full_str  db CR,LF,'Label''s table is full',NULL
dup_lab_str       db CR,LF,'Duplicate label',NULL
undef_lab_str     db CR,LF,'Undefinite label',NULL
then_exp_str      db CR,LF,'THEN expected',NULL
to_exp_str        db CR,LF,'TO expected',NULL
too_mny_for_str   db CR,LF,'Too many nested FOR',NULL
next_wo_for_str   db CR,LF,'NEXT without FOR',NULL
too_mny_gosub_str db CR,LF,'Too many nested GOSUB',NULL
ret_wo_gosub_str  db CR,LF,'RETURN without GOSUB',NULL
miss_quote_str    db CR,LF,'" expected',NULL
for_wo_next_str   db CR,LF,'FOR without NEXT',NULL
reserved_word_str db CR,LF,'Reserved word used as identifier',NULL
long_lab_str      db CR,LF,'Label is too long',NULL
goto_wo_label_str db CR,LF,'GOTO without label',NULL
div_by_zero_str   db CR,LF,'Division by zero',NULL
inval_num_str     db CR,LF,'Invalid numeric format',NULL
num_too_long_str  db CR,LF,'Number is too long',NULL

err_table         dw syntax_err_str
                  dw unbal_parens_str
                  dw no_exp_str
                  dw equal_exp_str
                  dw not_var_str
                  dw lab_tab_full_str
                  dw dup_lab_str
                  dw undef_lab_str
                  dw then_exp_str
                  dw to_exp_str
                  dw too_mny_for_str
                  dw next_wo_for_str
                  dw too_mny_gosub_str
                  dw ret_wo_gosub_str
                  dw miss_quote_str
                  dw for_wo_next_str
                  dw reserved_word_str
                  dw long_lab_str
                  dw goto_wo_label_str
                  dw div_by_zero_str
                  dw inval_num_str
                  dw num_too_long_str
;-----------------------------------------------------------------------------
logo          db CR,LF
              db "┌───────────────────────────────────┐",CR,LF
              db "│ Минимальный  BASIC-интерпретатор. │",CR,LF
              db "│ Автор: Тамело Андрей (??.??.2001) │",CR,LF
              db "╞═══════════════════════════════════╡",CR,LF
              db "│  Формат: mbasic[.com] <filename>  │",CR,LF
              db "└───────────────────────────────────┘",CR,LF,NULL
;-----------------------------------------------------------------------------             
;LOCAL STACK
              db STK_SIZE dup(000h)
loc_stk:             
;-----------------------------------------------------------------------------
;THIS SECTION MUST BE LAST

IMAGE_PAR     equ ((($-begin+PSP_SIZE) or 00Fh)+001h) shr 004h     
;-----------------------------------------------------------------------------
code ends
end begin