360 lines
9.7 KiB
Text
360 lines
9.7 KiB
Text
;;; CP/M Brainfuck compiler/interpreter, with a few optimizations
|
|
getch: equ 1 ; Read character from console
|
|
putch: equ 2 ; Print character to console
|
|
puts: equ 9 ; Print string to console
|
|
fopen: equ 15 ; Open file
|
|
fread: equ 20 ; Read from file
|
|
dmaoff: equ 26 ; Set DMA address
|
|
fcb: equ 5Ch ; FCB for first command line argument
|
|
EOFCH: equ -1 ; Value stored on the tape on EOF
|
|
org 100h
|
|
jmp start
|
|
;;; Print the character on the tape, saving HL (tape location),
|
|
;;; and including CR/LF translation.
|
|
bfout: push h ; Keep tape location
|
|
mov a,m ; What are we printing?
|
|
cpi 10 ; Newline?
|
|
jnz outch ; If not, just print the character.
|
|
mvi e,13 ; Otherwise, print a carriage return first.
|
|
mvi c,putch
|
|
call 5
|
|
pop h ; Then get the tape back
|
|
push h
|
|
outch: mov e,m ; Print the character in A.
|
|
mvi c,putch
|
|
call 5
|
|
pop h ; Restore tape location.
|
|
ret
|
|
;;; Read a character and store it on the tape, including CR/LF
|
|
;;; translation; ^Z is EOF.
|
|
bfin: push h ; Keep tape location
|
|
lda bfeoff ; Have we seen EOF yet?
|
|
ana a
|
|
jnz bfeof ; If so, return EOF.
|
|
mvi c,getch ; Otherwise, read character
|
|
call 5
|
|
cpi 26 ; Was it EOF?
|
|
jz bfeof ; Then handle EOF.
|
|
cpi 13 ; Was it CR? (Pressing 'Enter' only gives CR.)
|
|
jnz bfin_s ; If not, just store the character.
|
|
mvi c,putch ; Otherwise, output a LF (only CR is echoed as well)
|
|
mvi e,10
|
|
call 5
|
|
mvi a,10 ; And then store a LF instead of the CR.
|
|
bfin_s: pop h ; Restore tape location
|
|
mov m,a ; Store the character
|
|
ret
|
|
bfeof: sta bfeoff ; Set the EOF flag (A is nonzero here)
|
|
pop h ; Restore tape location
|
|
mvi m,EOFCH ; Store EOF return value.
|
|
ret
|
|
bfeoff: db 0 ; EOF flag, EOF seen if nonzero.
|
|
;;; Print mismatched brackets error
|
|
brkerr: lxi d,ebrk
|
|
;;; Print error message under DE and quit
|
|
err: mvi c,puts ; Print string
|
|
call 5
|
|
rst 0 ; Then quit
|
|
;;; Error messages.
|
|
efile: db 'Cannot read file.$'
|
|
ebrk: db 'Mismatched brackets.$'
|
|
;;; BF characters
|
|
bfchr: db '+-<>,.[]',26
|
|
;;; Main program
|
|
start: lhld 6 ; Set stack pointer to highest available address
|
|
sphl
|
|
mvi c,fopen ; Try to open the file given on the command line
|
|
lxi d,fcb
|
|
call 5
|
|
inr a ; A=FF on error,
|
|
lxi d,efile ; so if we couldn't open the file, say so, and stop
|
|
jz err
|
|
;;; Read file into memory in its entirety
|
|
lxi d,pgm ; Start of input
|
|
block: mvi c,dmaoff
|
|
push d ; Keep current address on stack
|
|
call 5 ; Set DMA to location of current block
|
|
mvi c,fread ; Read 128-byte block to that address
|
|
lxi d,fcb
|
|
call 5
|
|
dcr a ; A=1 = end of file
|
|
jz fdone
|
|
inr a ; Otherwise, A<>0 = error
|
|
lxi d,efile
|
|
jnz err
|
|
pop h ; Retrieve DMA address
|
|
lxi d,128 ; Add 128 (advance to next block)
|
|
dad d
|
|
xchg ; Put in DE
|
|
jmp block ; Go get next block.
|
|
fdone: pop h ; When done, find next address
|
|
mvi m,26 ; Write EOF, so file always ends with EOF.
|
|
;;; Filter out all the non-BF characters
|
|
lxi h,pgm ; Output pointer
|
|
push h ; On stack
|
|
lxi b,pgm ; Input pointer
|
|
filter: ldax b ; Get current character
|
|
inx b ; Look at next char next time
|
|
lxi h,bfchr ; Test against 9 brainfuck characters (8 + EOF)
|
|
mvi e,9
|
|
filchk: cmp m ; Is it a match?
|
|
jz filfnd ; Then we found it
|
|
inx h
|
|
dcr e
|
|
jnz filchk
|
|
jmp filter ; Otherwise, try next character
|
|
filfnd: pop h ; Get pointer from stack
|
|
mov m,a ; Store current character
|
|
inx h ; Move pointer
|
|
push h ; Store pointer back on stack
|
|
cpi 26 ; Reached the end?
|
|
jnz filter ; If not, keep going.
|
|
;;; Move the program as high up into memory as possible.
|
|
lxi h,-1024 ; Keep 1K stack space (allowing 512 levels of nested
|
|
dad sp ; loops)
|
|
pop d ; Source pointer in DE (destination in HL)
|
|
move: ldax d ; Copy backwards
|
|
dcx d
|
|
mov m,a
|
|
dcx h
|
|
ana a ; Until zero is reached
|
|
jnz move
|
|
inx h ; Move pointer to byte after zero
|
|
inx h
|
|
;;; Compile the Brainfuck code into 8080 machine code
|
|
lxi b,0 ; Push zero on stack (as boundary marker)
|
|
push b
|
|
lxi d,pgm ; DE = start of binary area (HL at start of source)
|
|
compil: mov a,m ; Get source byte
|
|
cpi '+' ; Plus or minus - change the tape value
|
|
jz tapval
|
|
cpi '-'
|
|
jz tapval
|
|
cpi '<' ; Left or right - move the tape
|
|
jz tapmov
|
|
cpi '>'
|
|
jz tapmov
|
|
cpi '.' ; Input and output
|
|
jz chout
|
|
cpi ','
|
|
jz chin
|
|
cpi '[' ; Start of loop
|
|
jz loops
|
|
cpi ']' ; End of loop
|
|
jz loope
|
|
cpi 26 ; EOF?
|
|
jz cdone
|
|
inx h ; Anything else is ignored
|
|
jmp compil
|
|
;;; Write code for '+' or '-' (change cell value)
|
|
tapval: mvi c,0 ; C = change in value necessary
|
|
tapv_s: mov a,m ; Get current byte
|
|
cpi '+' ; If plus,
|
|
jz tapinc ; Then we need to increment
|
|
cpi '-' ; If minus,
|
|
jz tapdec ; Then we need to decrement
|
|
;;; The effect of the last instructions should be to
|
|
;;; change the cell at the tape head by C.
|
|
;;; If -3 <= B <= 3, INR M/DCR M are most efficient.
|
|
;;; Otherwise, MVI A,NN / ADD M / MOV M,A is most efficient.
|
|
mov a,c
|
|
ana a ; Zero?
|
|
jz compil ; Then we do nothing.
|
|
cpi 4 ; Larger than 3?
|
|
jc tapinr ; If not, 'INR M' * C
|
|
cpi -3 ; Smaller than -3?
|
|
jnc tapdcr ; Then, 'DCR M' * -C
|
|
xchg ; Otherwise, use an ADD instruction
|
|
mvi m,3Eh ; 'MVI A,'
|
|
inx h
|
|
mov m,c ; C (all math is mod 256)
|
|
inx h
|
|
mvi m,86h ; 'ADD M'
|
|
inx h
|
|
mvi m,77h ; 'MOV M,A'
|
|
inx h
|
|
xchg
|
|
jmp compil
|
|
tapinc: inr c ; '+' means one more
|
|
inx h ; Check next byte
|
|
jmp tapv_s
|
|
tapdec: dcr c ; '-' means one less
|
|
inx h ; Check next byte
|
|
jmp tapv_s
|
|
tapinr: mvi a,34h ; INR M (increment cell)
|
|
jmp wrbyte
|
|
tapdcr: mvi a,35h ; DCR M (decrement cell)
|
|
jmp wrnegc
|
|
;;; Write code for '<' or '>' (move tape head)
|
|
tapmov: lxi b,0 ; BC = change in value necessary
|
|
tapm_s: mov a,m ; Get current byte
|
|
cpi '>' ; If right,
|
|
jz taprgt ; Then we need to move the tape right
|
|
cpi '<' ; If left,
|
|
jz taplft ; Then we need to move the tape left
|
|
;;; Move the tape by BC.
|
|
;;; If -4 <= BC <= 4, INX H/DCX H are most efficient.
|
|
;;; Otherwise, LXI B,NNNN / DAD B is most efficient.
|
|
mov a,b ; Is the displacement zero?
|
|
ora c
|
|
jz compil ; Then do nothing
|
|
mov a,b ; Otherwise, is the high byte 0?
|
|
ana a
|
|
jnz tbchi ; If not, it might be FF, but
|
|
mov a,c ; if so, is low byte <= 4?
|
|
cpi 5
|
|
jc tapinx ; Then we need to write 'INX H' C times
|
|
xra a ; Otherwise, do it the long way
|
|
tbchi: inr a ; Is the high byte FF?
|
|
jnz tapwbc ; If not, we'll have to do it the long way
|
|
mov a,c ; But if so, is low byte >= -4?
|
|
cpi -4
|
|
jnc tapdcx ; Then we can write 'DCX H' -C times
|
|
tapwbc: xchg ; Otherwise, use a DAD instruction
|
|
mvi m,1h ; 'LXI B,'
|
|
inx h
|
|
mov m,c ; Low byte
|
|
inx h
|
|
mov m,b ; High byte
|
|
inx h
|
|
mvi m,9h ; 'DAD B'
|
|
inx h
|
|
xchg
|
|
jmp compil
|
|
taprgt: inx b ; '>' is one to the right
|
|
inx h ; Check next byte
|
|
jmp tapm_s
|
|
taplft: dcx b ; '<' is one to the left
|
|
inx h ; Check next byte
|
|
jmp tapm_s
|
|
tapinx: mvi a,23h ; INX H (move tape right)
|
|
jmp wrbyte
|
|
tapdcx: mvi a,2Bh ; DCX H (move tape left)
|
|
jmp wrnegc
|
|
;;; Write the byte in A, -C times, to [DE++]
|
|
wrnegc: mov b,a ; Keep A
|
|
mov a,c ; Negate C
|
|
cma
|
|
inr a
|
|
mov c,a
|
|
mov a,b
|
|
;;; Write the byte in A, C times, to [DE++]
|
|
wrbyte: stax d
|
|
inx d
|
|
dcr c
|
|
jnz wrbyte
|
|
jmp compil
|
|
;;; Write code to print the current tape value
|
|
chout: inx h ; We know the cmd is '.', so skip it
|
|
lxi b,bfout ; Call the output routine
|
|
jmp wrcall
|
|
;;; Write code to read a character and store it on the tape
|
|
chin: inx h ; We know the cmd is ',', so skip it
|
|
lxi b,bfin
|
|
;;; Write code to CALL the routine with address BC
|
|
wrcall: xchg
|
|
mvi m,0CDh ; CALL
|
|
inx h
|
|
mov m,c ; Low byte
|
|
inx h
|
|
mov m,b ; High byte
|
|
inx h
|
|
xchg
|
|
jmp compil
|
|
;;; Write code to start a loop
|
|
loops: inx h ; We know the first cmd is '['
|
|
mov b,h ; Check for '-]'
|
|
mov c,l
|
|
ldax b
|
|
cpi '-'
|
|
jnz loopsw ; If not '-', it's a real loop
|
|
inx b
|
|
ldax b
|
|
cpi ']'
|
|
jz lzero ; If ']', we just need to set the cell to 0
|
|
;;; Code for loop: MOV A,M / ANA A / JZ cmd-past-loop
|
|
loopsw: xchg ; Destination pointer in HL
|
|
mvi m,7Eh ; MOV A,M
|
|
inx h
|
|
mvi m,0A7h ; ANA A
|
|
inx h
|
|
mvi m,0CAh ; JZ
|
|
inx h
|
|
inx h ; Advance past where the destination will go
|
|
inx h ; (End of loop will fill it in)
|
|
push h ; Store the address to jump back to on the stack
|
|
xchg
|
|
jmp compil
|
|
;;; Code to set a cell to zero in one go: MVI M,0
|
|
lzero: inx h ; Move past '-]'
|
|
inx h
|
|
xchg ; Destination pointer in HL
|
|
mvi m,36h ; MVI M,
|
|
inx h
|
|
mvi m,0 ; 0
|
|
inx h
|
|
xchg
|
|
jmp compil
|
|
;;; Write code to end a loop: MOV A,M / ANA A / JNZ loop-start
|
|
loope: inx h ; We know the first cmd is ']'
|
|
xchg ; Destination pointer in HL
|
|
mvi m,7Eh ; MOV A,M
|
|
inx h
|
|
mvi m,0A7h ; ANA A
|
|
inx h
|
|
mvi m,0C2h ; JNZ
|
|
inx h
|
|
pop b ; Get loop-start from the stack
|
|
mov a,b ; If it is 0, we've hit the sentinel, which means
|
|
ora c ; mismatched brackets
|
|
jz brkerr
|
|
mov m,c ; Store loop-start, low byte first,
|
|
inx h
|
|
mov m,b ; then high byte.
|
|
inx h
|
|
dcx b ; The two bytes before loop-start must be filled in
|
|
mov a,h ; with the address of the cmd past the loop, high
|
|
stax b ; byte last,
|
|
dcx b
|
|
mov a,l ; then low byte
|
|
stax b
|
|
xchg
|
|
jmp compil
|
|
;;; Done: finish the code with a RST 0 to end the program
|
|
cdone: xchg
|
|
mvi m,0C7h
|
|
pop b ; If the brackets are all matched, there should be
|
|
mov a,b ; a zero on the stack.
|
|
ora c
|
|
jnz brkerr
|
|
;;; Initialize the tape. The fastest way to fill up memory on the
|
|
;;; 8080 is to push values to the stack, so we will fill it up
|
|
;;; with zeroes, and position the tape there.
|
|
;;; HL contains the top of the program.
|
|
lxi d,32 ; The Brainfuck program doesn't use the stack, so
|
|
dad d ; reserving 16 levels for CP/M is more than enough.
|
|
mov a,l ; Complement the value (almost negation, but low bit
|
|
cma ; doesn't really matter here)
|
|
mov l,a
|
|
mov a,h
|
|
cma
|
|
mov h,a
|
|
dad sp ; Add the current stack pointer, giving bytes to fill
|
|
ana a ; Zero carry
|
|
mov a,h ; Divide value by two (we push words)
|
|
rar
|
|
mov h,a
|
|
mov a,l
|
|
rar
|
|
mov l,a
|
|
lxi d,0
|
|
ztape: push d ; Zero out the tape (on the stack)
|
|
dcx h
|
|
mov a,h
|
|
ora l
|
|
jnz ztape
|
|
dad sp ; HL is now 0, add SP to get tape bottom
|
|
;;; The compiled program is stored after this point, so we just
|
|
;;; fall through into it.
|
|
nop ; No-op (sentinel value)
|
|
pgm: equ $ ; Compiled BF program stored here.
|