RosettaCodeData/Task/Execute-Brain-/8086-Assembly/execute-brain-.8086
2023-07-01 13:44:08 -04:00

348 lines
10 KiB
Text

;;; MS-DOS Brainf*** interpreter/compiler
cpu 8086
putch: equ 2h ; Print character
puts: equ 9h ; Print string
open: equ 3Dh ; Open file
read: equ 3Fh ; Read from file
exit: equ 4Ch ; Exit to DOS
flags: equ 33h ; Set break flags
CMDLEN: equ 80h ; Address of length of command line argument
CMDARG: equ 81h ; Address of text of command line argument
BRK: equ 1 ; Break flag
EOFCH: equ -1 ; Written to the tape on EOF
section .text
org 100h
;;; See if there is enough memory
mov sp,stack.top ; Move stack inward to free up memory
mov ax,cs ; Get allocated memory size from DOS
dec ax ; (It is at location 3 in the MCB, which
mov es,ax ; is located one paragraph above CS.)
mov ax,[es:3]
mov bx,sp ; The amount of memory the program itself
mov cl,4 ; needs is from CS:0 up to CS:SP in bytes,
shr bx,cl ; shifted right by 4 to give paragraphs;
inc bx ; making sure to round up.
mov bp,cs ; The paragraph right after this is used
add bp,bx ; as the segment base for BF's memory.
sub ax,bx ; Free mem = allocated mem - program mem
cmp ax,128*1024/16 ; We'll require at least 128k bytes
jae mem_ok ; (for two separate code and data segments)
mov dx,err.mem ; If we don't have enough,
jmp error ; give an error message.
;;; Stop on Ctrl+C
mem_ok: mov ax,flags<<8|BRK
mov dl,1
int 21h
;;; See if a command line argument was given
mov bl,[CMDLEN] ; Get length of argument
test bl,bl ; See if it's zero
jnz arg_ok
mov dx,err.usage ; Print usage string if no argument given
jmp error
arg_ok: xor bh,bh
mov [CMDARG+bx],bh ; Terminate the argument string with a zero
mov ax,open<<8 ; Try to open the file for reading
mov dx,CMDARG+1 ; Skip first item (always 1)
int 21h
jnc fileok
mov dx,err.file ; Print file error if it fails
jmp error
fileok: mov di,ax ; Keep file handle in DI
xor si,si ; Keep pointer in SI
mov ds,bp ; Start reading into the memory past our stack
block: mov ah,read ; Read from file
mov bx,di
mov cx,0FFFEh
mov dx,si ; To the place just beyond the last read
int 21h
jnc .rdok
mov dx,err.file ; Read error
jmp error
.rdok: test ax,ax ; If zero bytes read, we're done
jz .done
add si,ax ; Move pointer past read
jnc block ; If there's still room, do another read
mov dx,err.mem ; If we overshot, then give memory error
jmp error
.done: mov [si],byte 0 ; Zero-terminate the data
;;; Filter out all non-BF characters
push ds ; Set ES to DS
pop es
xor si,si ; Source and destination pointer to beginning
xor di,di
filter: lodsb ; Get byte from source
xor bx,bx ; See if byte is BF command
.test: cmp al,[cs:bx+bfchar] ; Test against current character
je .match ; If a match, we found it
inc bx ; If not, try next possible command
cmp bx,8
jbe .test
jmp filter ; If we didn't find it, ignore this character
.match: stosb ; We found it, keep it
test al,al ; If zero, we found the end,
jnz filter ; Otherwise, do next character
;;; Compile the BF source into 8086 machine code
add bp,65536/16 ; Set ES to point to the start of the second
mov es,bp ; 64k (4k paragraphs) that we allocated earlier
xor di,di ; Start at address zero,
push di ; Store a zero on the stack as boundary marker,
mov ax,stop ; At 0000, store a far pointer to the
stosw ; cleanup routine,
mov ax,cs
stosw
mov ax,bfout ; At 0004, store a far pointer to the
stosw ; output routine,
mov ax,cs
stosw
mov ax,bfin ; At 0008, store a far pointer to the
stosw ; input routine,
mov ax,cs
stosw ; Compiled BF code starts at 000C.
xor si,si ; Start at beginning of BF source code
compil: lodsb ; Get current command
.ch: cmp di,-16 ; See if we still have 16 bytes free
jb .fch ; (Loop is 11 bytes, +5 for INT 21h/4Ch at end)
mov dx,err.mem ; If not, we're out of memory
jmp error
.fch: cmp al,'+' ; + and - change the value of the current cell
je tapval
cmp al,'-'
je tapval
cmp al,'>' ; < and > move the tape
je tapmov
cmp al,'<'
je tapmov
cmp al,',' ; I/O
jne .tsout ; Conditional jumps are limited to 128-byte
jmp chin ; displacement
.tsout: cmp al,'.'
jne .tsls
jmp chout
.tsls: cmp al,'[' ; Loops
jne .tsle
jmp loops
.tsle: cmp al,']'
jne .tsend
jmp loope
.tsend: test al,al ; Reached zero?
jnz compil ; If not, next command
jmp cdone ; If so, we're done
;;; Compile a string of +s and -s into an 8086 instruction
tapval: xor cl,cl ; Count up contiguous +s and -s modulo 256
.ch: cmp al,'+'
je .inc
cmp al,'-'
je .dec
test cl,cl ; If zero,
jz compil.ch ; it's a no-op.
mov bl,al ; Otherwise, keep next character
cmp cl,-1 ; If -1, decrement cell
mov ax,0FFEh ; DEC BYTE [BX]
je .wword
cmp cl,1 ; If 1, increment cell
mov ax,07FEh ; INC BYTE [BX]
je .wword
mov ax,0780h ; ADD BYTE [BX],
stosw
mov al,cl ; change to cell
stosb
mov al,bl ; Move next character back into AL
jmp compil.ch ; Compile next command
.inc: inc cl ; Increment cell
lodsb
jmp .ch
.dec: dec cl ; Decrement cell
lodsb
jmp .ch
.wword: stosw ; Write instruction word
mov al,bl ; Move next character back into AL
jmp compil.ch ; Compile next command
;;; Compile a string of <s and >s into an 8086 instruction
tapmov: xor cx,cx ; Count up contiguous <s and >s modulo 65536
.ch: cmp al,'>'
je .right
cmp al,'<'
je .left
test cx,cx ; Is there any net movement at all?
jnz .move ; If so, generate a move instruction
jmp compil.ch ; But otherwise it's a no-op, ignore it
.move: mov bl,al ; Otherwise, keep next character
cmp cx,4 ; If CX<4, a series of INC BX are best
mov al,43h ; INC BX
jb .wbyte
neg cx
cmp cx,4 ; If -CX<4, a series of DEC BX are best
mov al,4Bh ; DEC BX
jb .wbyte
neg cx
mov ax,0C381h ; ADD BX,
stosw
mov ax,cx ; tape movement
stosw
mov al,bl ; Move next character back into AL
jmp compil.ch ; Compile next command
.left: dec cx ; Left: decrement pointer
lodsb
jmp .ch
.right: inc cx ; Right: increment pointer
lodsb
jmp .ch
.wbyte: rep stosb ; Write AL, CX times.
mov al,bl ; Move next character back into AL
jmp compil.ch ; Compile next command
;;; Compile BF input
chin: mov al,2Eh ; CS segment override
stosb
mov ax,1EFFh ; CALL FAR PTR
stosw
mov ax,8 ; Pointer to input routine at address 8
stosw
jmp compil ; Compile next command
;;; Compile BF output
chout: mov al,2Eh ; CS segment override
stosb
mov ax,1EFFh ; CALL FAR PTR
stosw
mov ax,4 ; Pointer to output routine at address 4
stosw
jmp compil
;;; Compile start of loop
loops: cmp word [si],5D2Dh ; Are the next two characters '-]'?
je .zero ; Then just set the cell to zero
mov ax,078Ah ; Otherwise, write out a real loop
stosw ; ^- MOV AL,[BX]
mov ax,0C084h ; TEST AL,AL
stosw
mov ax,0575h ; JNZ loop-body
stosw
mov al,0B8h ; MOV AX, (simulate absolute near jmp)
stosb
xor ax,ax ; loop-end (we don't know it yet so 0)
stosw
mov ax,0E0FFh ; JMP AX
stosw
push di ; Store addr of loop body on stack
jmp compil ; Compile next command
.zero: mov ax,07C6h ; MOV BYTE [BX],
stosw
xor al,al ; 0
stosb
inc si ; Move past -]
inc si
jmp compil ; Compile next command
;;; Compile end of loop
loope: pop bx ; Retrieve address of loop body from stack
test bx,bx ; If it is zero, we've hit the top of stack
jz .ebrkt ; so the brackets aren't balanced.
mov ax,078Ah ; MOV AL,[BX]
stosw
mov ax,0C084h ; TEST AL,AL
stosw
mov ax,0574h ; JZ loop-end
stosw
mov al,0B8h ; MOV AX, (simulate absolute near jmp)
stosb
mov ax,bx ; loop-start
stosw
mov ax,0E0FFh ; JMP AX
stosw
mov [es:bx-4],di ; Store loop-end in matching loop start code
jmp compil
.ebrkt: mov dx,err.brk
jmp error
;;; Compilation is done.
cdone: mov al,2Eh ; Code to jump to cleanup routine
stosb ; ^- CS segment override
mov ax,2EFFh ; JMP FAR PTR
stosw
pop ax ; Should be zero if all loops closed
stosw
test ax,ax ; Were all loops closed?
jz .lp_ok
mov dx,err.brk ; If not, print error
jmp error
.lp_ok: mov [cs:cp],word 12 ; Make far pointer to start of BF code
mov [cs:cp+2],bp ; (which starts at ES:0C = BP:0C)
mov ax,ds ; Set both DS and ES to BF tape segment
mov es,ax ; (also the initial source segment)
xor ax,ax ; Clear the tape (set all bytes to zero)
mov cx,32768
rep stosw
xor bx,bx ; Tape begins at address 0
xor cx,cx ; No EOF and char buffer is empty
jmp far [cs:cp] ; Jump into the BF code
;;; BF program jumps here to stop the program
stop: mov ax,exit<<8|0 ; Quit to DOS with return code 0
int 21h
;;; Print error message in CS:DX and quit with errorlevel 2
error: push cs ; Set DS to CS
pop ds
mov ah,puts ; Print DS:DX
int 21h
mov ax,exit<<8|2 ; Quit to DOS
int 21h
;;; Output subroutine called by the BF program (far call)
bfout: mov ah,putch ; Prepare to write character
mov dl,[bx] ; Get character from tape
cmp dl,10 ; Is it LF?
jne .wr ; If not, just write it
mov dl,13 ; Otherwise, print CR first,
int 21h
mov dl,10 ; then LF.
.wr: int 21h ; Write character
retf
;;; Input subroutine called by the BF program (far call)
;;; Buffered input with CR/LF translation
;;; Note: this keeps state in registers!
;;; CL = chars left in buffer, CH = set if EOF seen,
;;; SI = buffer pointer, ES = BF data segment
bfin: test ch,ch ; EOF seen?
jnz .r_eof
mov ax,cs ; Set DS to our segment
mov ds,ax
.getch: test cl,cl ; Characters left in buffer?
jnz .retch ; If so, return next character
mov bp,bx ; Keep BF tape pointer
mov ah,read ; Read
xor bx,bx ; From STDIN
mov cx,255 ; Max 255 characters
mov dx,ibuf ; Into the buffer
int 21h
mov bx,bp ; Restore tape pointer
jc .ioerr ; If carry set, I/O error
test ax,ax ; If nothing returned, EOF
jz .s_eof
mov cx,ax ; Otherwise, set character count,
mov si,ibuf ; set buffer pointer back to start,
jmp .getch ; and return first character from buffer.
.s_eof: inc ch ; We've seen EOF now
.r_eof: mov al,EOFCH ; Return EOF
jmp .ret
.retch: lodsb ; Get char from buffer
dec cl ; One fewer character left
cmp al,26 ; ^Z = EOF when reading from keyboard
je .s_eof
cmp al,10 ; If it is LF, ignore it and get another
je .getch
cmp al,13 ; If it is CR, return LF instead
jne .ret
mov al,10
.ret: mov dx,es ; Set DS back to BF's data segment
mov ds,dx
mov [bx],al ; Put character on tape
retf
.ioerr: mov dx,err.io ; Print I/O error and quit
jmp error
section .data
bfchar: db '+-<>,.[]',0
err: ;;; Error messages
.usage: db 'BRAINFK PGM.B',13,10,10,9,'Run the BF program in PGM.B$'
.file: db 'Cannot read file$'
.brk: db 'Mismatched brackets$'
.mem: db 'Out of memory$'
.io: db 'I/O Error$'
section .bss
cp: resw 2 ; Far pointer to start of BF code
ibuf: resb 256 ; 255 char input buffer
stack: resw 512 ; 512 words for the stack
.top: equ $