diff --git a/src/cp437.bmp b/CP437.BMP similarity index 100% rename from src/cp437.bmp rename to CP437.BMP diff --git a/src/utils/bmp2font.c b/HOST/bmp2font.c similarity index 100% rename from src/utils/bmp2font.c rename to HOST/bmp2font.c diff --git a/bdos/8086.asm b/bdos/8086.asm deleted file mode 100644 index 1d7fd46..0000000 --- a/bdos/8086.asm +++ /dev/null @@ -1,234 +0,0 @@ -ORG BDOS - -%include "hdr/bios.asm" -%include "hdr/fcb.asm" -%include "hdr/bpb.asm" - -DISKBUF: EQU (BDOS-0x200) ; deblocking -DISKBPB: EQU (DISKBUF-21) ; BPB of the current driv -DISKDRV: EQU (DISKBPB-1) ; BYTE denoting drive of current fcb (1=A, ...) - -PROGBX: EQU (DISKDRV-2) - -STACK: EQU (PROGBX & 0xFFFE) ; even address, grows down - -DEFDRV: EQU 4 ; default drive when opening a FCB (1=A, ...) - -SYSCALL: - MOV [PROGBX], BX - XOR BH, BH - MOV BL, CL - ADD BX, BX - ADD BX, FUNCS - MOV BX, [BX] - PUSH BX - MOV BX, [PROGBX] -SYSRET: - RET - -FUNCS: -DW SETUP,GETC,PUTC,SYSRET -DW SYSRET,SYSRET,SYSRET,SYSRET -DW SYSRET,PUTS,GETS,STATUS -DW SYSRET,DISKRST,SETDEFDSK,FCBOPEN -DW SYSRET,SYSRET,SYSRET,SYSRET -DW SYSRET,SYSRET,SYSRET,SYSRET - -SETUP: - MOV SP, STACK - MOV BYTE [DEFDRV], 0x01 - MOV CX, DISKBUF - CALL SETDMA - - SUB SP, 0x20 - MOV BX, SP - CALL FCBOPEN - - CLI -HALT: - HLT - JMP HALT - -GETC: - CALL CONIN - TEST AL, AL - JZ GETC - PUSH DX - MOV DL, AL - CALL CONOUT - POP DX - ret - -PUTC: - JMP CONOUT - -PUTS: - PUSH SI - MOV SI, DX -PUTS_L: - MOV DL, BYTE [SI] - CMP DL, '$' - JZ PUTS_E - CALL CONOUT - INC SI - JMP PUTS_L -PUTS_E: - POP SI - RET - -; BX base ptr to buffer -; CH maximum BL -; CL minimum BL -GETS: - PUSH AX - PUSH CX - PUSH DX - PUSH BX - ; BX is base pointer - MOV BX, DX - ; CL is maximum, CH is current position - MOV CX, [BX] - XOR CH, CH - ; BX starts at actual character area - ADD BX, 2 -GETS_L: - ; Read and maybe handle control chars - CALL GETC - CMP AL, 0x0D - JE GETS_E - CMP AL, 8 - JE GETS_BS - ; Store character - PUSH BX - ADD BL, CH - ADC BH, 0 - MOV [BX], AL - POP BX - ; Loop if we arent full yet - INC CH - CMP CH, CL - JC GETS_L -GETS_E: - ; Append LF to CR - MOV DL, 0x0A - CALL PUTC - ; Write back length data - SUB BX, 2 - MOV [BX], CX - ; Restore registers - POP BX - POP DX - POP CX - POP AX - ret -GETS_BS: - TEST CH, CH - JZ GETS_L - MOV DL, 0x20 - CALL PUTC - MOV DL, 8 - CALL PUTC - DEC CL - JMP GETS_L - -STATUS: - JMP CONST - -DISKRST: - MOV BYTE [DISKDRV], 0xFF - RET - -SETDEFDSK: - MOV BYTE [DEFDRV], DL - RET - -FCBOPEN: - MOV CL, BYTE [BX] - TEST CL, CL - JNZ NODEFDRV - MOV CL, BYTE [DEFDRV] - MOV BYTE [BX], CL -NODEFDRV: - CALL LOADBPB - - MOV CX, [DISKBPB+BPB_RDE] - - CALL FATSIZE - ADD DX, WORD [DISKBPB+BPB_RSC] - CALL SETLSEC - CALL READ - - MOV AX, [DISKBUF] - - INT3 - ; TODO: search for file in rootdir - ; TODO: init cluster number - RET - -; Set logical sector number -; IN DX sector number -SETLSEC: - PUSH AX - PUSH CX - PUSH DX - XOR AX, AX - XCHG AX, DX - DIV WORD [DISKBPB+BPB_SPT] - MOV CX, AX - CALL SETTRK - MOV CX, DX - INC CX - CALL SETSEC - POP DX - POP CX - POP AX - RET - -; OUT DX number of sectors by all FATs -FATSIZE: - PUSH AX - MOV DL, BYTE [DISKBPB+BPB_FN] - MOV AL, BYTE [DISKBPB+BPB_SF] - MUL DL - XCHG AX, DX - POP AX -RET: - RET - -; IN CL drive num, 1=A, 2=B, 3=C -LOADBPB: - CMP BYTE [DISKDRV], CL - JE RET - - PUSH CX - DEC CL - CALL SELDSK - ; first track - MOV CX, 0 - CALL SETTRK - ; first sector - MOV CX, 1 - CALL SETSEC - ; into default diskbuf - MOV CX, DISKBUF - CALL SETDMA - POP CX - - CALL READ - JC DISKRST - - ; copy BPB - PUSH CX - PUSH SI - PUSH DI - MOV CX, 21 - MOV SI, DISKBUF+0x0B - MOV DI, DISKBPB - REP MOVSB - POP DI - POP SI - POP CX - - ; store drive number - MOV BYTE [DISKDRV], CL - RET diff --git a/bdos/dump.asm b/bdos/dump.asm deleted file mode 100644 index 115ff7b..0000000 --- a/bdos/dump.asm +++ /dev/null @@ -1,85 +0,0 @@ -; print a word -; in: ax -print16: - xchg ah,al - call print8 - xchg ah,al - -; print a byte -; in: al -print8: - push ax ; avoid destroying ah - push bx - xor bx, bx - aam 16 ; high nibble moved into ah, low nibble into al - add ax, 0x3030 - push ax - xchg al, ah - call .nib - pop ax - call .nib - pop bx - pop ax - ret -.nib: - cmp al, 0x3a - jl .out - add al, 0x07 -.out: - mov dl, al - call CONOUT - ret - -dump: - push ax - push cx - push dx - push bx - mov dl, 0x0A - call CONOUT - mov dl, 0x0D - call CONOUT - mov cx, 4 -.loop_line: - push cx - push bx - mov ax, bx - call print16 - mov dl, ':' - call CONOUT - mov dl, ' ' - call CONOUT - mov cx, 0x8 -.loop_bin: - mov ax, [bx] - xchg al, ah - inc bx - inc bx - call print16 - mov dl, ' ' - call CONOUT - loop .loop_bin - pop bx - mov cx, 0x10 -.loop_ascii: - mov dl, '.' - cmp byte [bx], 0x20 - jc .print - cmp byte [bx], 0x80 - jnc .print - mov dl, [bx] -.print: - inc bx - call CONOUT - loop .loop_ascii - pop cx - mov dl, 0x0A - call CONOUT - mov dl, 0x0D - call CONOUT - loop .loop_line - pop bx - pop dx - pop cx - pop ax - ret diff --git a/bios/8086.asm b/bios/8086.asm deleted file mode 100644 index 594dff9..0000000 --- a/bios/8086.asm +++ /dev/null @@ -1,218 +0,0 @@ -ORG BIOS -CPU 8086 - -DISKCX: EQU 0x8 -DISKDX: EQU 0xA -DISKBX: EQU 0xC - -JMP NEAR BOOT -JMP NEAR WBOOT -JMP NEAR CONST -JMP NEAR CONIN -JMP NEAR CONOUT -JMP NEAR LIST -JMP NEAR PUNCH -JMP NEAR READER -JMP NEAR HOME -JMP NEAR SELDSK -JMP NEAR SETTRK -JMP NEAR SETSEC -JMP NEAR SETDMA -JMP NEAR READ -JMP NEAR WRITE -JMP NEAR LISTST - -BOOT: - MOV AL, 0x86 - CALL MSG - DB "BIOS", 0 - -WBOOT: - XOR CX, CX - JMP BDOS - RET - -; CHAR I/O -CONST: - MOV AH, 1 - INT 0x16 - JZ .END - MOV AL, 0xFF - RET -.END: - XOR AL, AL - RET - -CONIN: - XOR AX, AX - INT 0x16 - TEST AL, AL - JZ CONIN - RET - -MSG: - POP SI -.LOOP: - MOV DL, BYTE [SI] - INC SI - TEST DL, DL - JZ .END - CALL CONOUT - JMP .LOOP -.END: - MOV DL, 0x20 - CALL CONOUT - CALL PRINTAL - MOV DL, 0x0A - CALL CONOUT - MOV DL, 0x0D - CALL CONOUT - PUSH SI - RET - -PRINTAL: - PUSH AX - PUSH DX - AAM 16 - MOV DL, AH - CALL PRINTNIB - MOV DL, AL - CALL PRINTNIB - POP DX - POP AX - RET - -PRINTNIB: - ADD DL, 0x30 - CMP DL, 0x3a - JL CONOUT - ADD DL, 0x07 - -CONOUT: - PUSH AX - PUSH BX - MOV AH, 0x0E - MOV AL, DL - XOR BX, BX - INT 0x10 - POP BX - POP AX - RET - -LIST: - PUSH DX - XOR AH, AH - MOV AL, DL - INT 0x17 - POP DX - RET - -LISTST: - STC - RET - -PUNCH: - STC - RET - -READER: - STC - RET - -; DISK I/O -HOME: - MOV WORD [DISKCX], 0x0001 - MOV BYTE [DISKDX+1], 0x00 - RET - -SELDSK: - MOV BYTE [DISKDX], CL - XOR BX, BX - RET - -SETTRK: - PUSH CX - PUSH DX - - MOV DX, CX - ; CH for headnum, CL for SAL - MOV CX, 0x0006 - - ; Take off LSB as head number - XOR CH, CH - RCR DX, 1 - RCL CH, 1 - MOV BYTE [DISKDX+1], CH - - ; DX is sector number now - ; Shift into format for int13 - ; DX ------9876543210 - SAL DX, CL - ; DX 9876543210------ - ROL DX, 1 - ROL DX, 1 - ; DX 76543210------98 - SAL DL, CL - ; DX 7654321098------ - AND WORD [DISKCX], 0x003F - OR WORD [DISKCX], DX - - POP DX - POP CX - RET - -SETSEC: - AND WORD [DISKCX], 0xFFC0 - OR BYTE [DISKCX], CL - RET - -SETDMA: - MOV WORD [DISKBX], CX - RET - -READ: - PUSH CX - PUSH DX - PUSH BX - - MOV AX, 0x0201 - MOV CX, [DISKCX] - MOV DX, [DISKDX] - MOV BX, [DISKBX] - INT 0x13 - XCHG AH, AL - - POP BX - POP DX - POP CX - - JC DISKERR - RET - -WRITE: - PUSH CX - PUSH DX - PUSH BX - - MOV AX, 0x0301 - MOV CX, [DISKCX] - MOV DX, [DISKDX] - MOV BX, [DISKBX] - INT 0x13 - XCHG AH, AL - - POP BX - POP DX - POP CX - - JC DISKERR - RET - -DISKERR: - PUSHF - PUSH SI - CALL MSG - DB "DISKERR", 0 - POP SI - POPF - RET diff --git a/boot/fat.asm b/boot/fat.asm deleted file mode 100644 index 71a2ab4..0000000 --- a/boot/fat.asm +++ /dev/null @@ -1,241 +0,0 @@ -; Memory layout: -%define segment 0x00100 - -%define self (0x7C00-(segment<<4)) ; 1 sector -%define fattab (self+0x200) ; variable size -%define rootdir 0x00100 ; variable size -%define prog 0x0F000 ; 4K at the end for OS - -org self - -jmp short init - -cluster_offset: - dw 0 - -times (0x0B - ($-$$)) db 0 - -fdc: -.ss: - dw 0x200 ; sector size -.sc: - db 2 ; sectors per cluster -.rsc: - dw 1 ; reserved sector count -.fn: - db 2 ; number of file allocation tables -.rde: - dw 0x70 ; number of root directory entries -.ts: - dw 720 ; total number of sectors -.mi: ; medium identifier - db 0xFD ; 5.25-inch Double sided, 40 tracks per side, 9 sectors per track (360 KB) -.sf: ; sectors per fat - dw 2 -.spt: - dw 9 ; sectors per track -.nos: - dw 2 ; number of sides (heads) -.po: - dd 0 ; partition offset (in LBA blocks) -.lrgts: - dd 0 -.drv: - db 0 ; drive number - db 0 - db 0x29 ; efdc signature -.vid: - dd 0 ; volume id -.vlabel: - db "2B" - times (54 - ($-$$)) db " " -.fstype: - db "FAT12" - times (62 - ($-$$)) db " " - -; mformat keeps writing until here -; if we place init earlier, code gets overwritten -times (62 - ($-$$)) nop - -init: - cli - jmp segment:main - -main: - ; Stack grows down from 64k - mov ax, cs - mov ss, ax - mov sp, prog - mov ds, ax - mov es, ax - - mov [fdc.drv], dl ; save drive number in fd - sti - - ; load fat table into memory - mov ax, [fdc.rsc] - mov cx, [fdc.sf] - xor dx, dx - mov bx, fattab - call load_sectors - - ; calculate length of rootdir - mov ax, [fdc.rde] - mov cl, 4 - shr ax, cl ; 32 bytes per entry - mov cx, ax - - ; load root dir - xor dx, dx - mov ax, [fdc.sf] - mul byte [fdc.fn] - add ax, [fdc.rsc] - mov bx, rootdir - call load_sectors - - ; remember where we left off - ; clusters start after rootdir - mov [cluster_offset], ax - - ; Load kernel - mov bx, prog - mov ax, kernel_name - call load_file - mov bp, 0x3332 - jc error - - mov dl, [fdc.drv] - - ; jump into kernel - jmp segment:prog - -; Load a file into memory -; IN AX pointer to 8.3 filename -; ES:BX pointer to target area -; OUT CF flag set if error -; DI file size in bytes (<64K) -load_file: - mov si, rootdir - mov cx, [fdc.rde] -.search: - push cx - push si - mov di, ax - mov cx, 11 - repe cmpsb - pop si - pop cx - je .read - add si, 0x20 - loop .search - xor di, di - stc - ret -.read: - mov ax, [si+0x1A] - mov di, [si+0x1C] - jmp read_clusters - -; Read the file given by cluster number -; into the target program area -; in ax cluster number -read_clusters: - ; read cluster into area for target file - push ax - sub ax, 2 - mul BYTE [fdc.sc] - add ax, [cluster_offset] - xor dx, dx - mov cx, [fdc.sc] - xor ch, ch - call load_sectors - pop ax - - ; calculate index in FAT - mov si, ax - shr si, 1 - add si, ax - add si, fattab - - ; load entry from FAT, truncate to 12 bit - mov dx, [si] - test ax, 1 - jz .noshift - mov cl, 4 - shr dx, 4 -.noshift: - mov ax, dx - - and ax, 0x0FFF - cmp ax, 0x0FF8 - jc read_clusters - - ret - -; Read sectors from disk -; Does not return on error -; ax and bx will be incremented, cx decremented -; in dx:ax sector number -; es:bx buffer -; cx number of sectors to read -; out dx:ax next sector to read -; es:bx next free buffer -; cx zero -load_sectors: - ; fail instantly if reading sectors > 16 bit - test dx, dx - mov bp, 0x3330 - jnz error - -.loop: - push ax - push cx - push dx - - ; add partition offset (required for HDD) - add ax, [fdc.po] - adc dx, [fdc.po+2] - - ; calculate CHS data - div word [cs:fdc.spt] ; ax:temp = (lba / spt) - inc dx ; dx:sector = (lba % spt) + 1 - mov cl, dl ; sector number - xor dx, dx - div word [cs:fdc.nos] ; ax:cylinder = (tmp / heads) - ; dx:head = (tmp % heads) - mov ch, al ; cylinder number - mov dh, dl ; head number - mov dl, [cs:fdc.drv] ; driver number - mov ax, 0x0201 ; ah=0x02 al=0x01 - int 0x13 - mov bp, 0x3331 - jc error - - pop dx - pop cx - pop ax - - ; count up for next sector - add bx, 0x0200 - inc ax - - loop .loop - ret - -error: - mov ax, bp - mov ah, 0x0e - mov bx, 7 - int 0x10 - mov al, 0x21 - int 0x10 - xor ax, ax - int 0x16 - int 0x19 - -kernel_name: - db "BDOS BIN" - -times (0x1FE - ($-$$)) db 0 - -dw 0xAA55 diff --git a/boot/mbr.asm b/boot/mbr.asm deleted file mode 100644 index c7cb2e2..0000000 --- a/boot/mbr.asm +++ /dev/null @@ -1,136 +0,0 @@ -; Memory layout: -%define self 0x00600 ; 1 sector -%define prog 0x07C00 ; 1 sector - -; FDC fields in VBR -%define spt (prog + 0x18) -%define nos (prog + 0x1A) -%define po (prog + 0x1C) - -org self -cpu 8086 - -init: - cli - - ; Stack grows down from PSP + 64k - xor ax, ax - mov ss, ax - mov sp, ax - - push dx - - ; Relocate from [prog] to [self] - mov ds, ax - mov es, ax - mov si, prog - mov di, self - mov cx, 0x100 - rep movsw - - jmp 0:main - -main: - mov bp, 0x3335 - mov si, part1 - mov cx, 4 -.loop: - test BYTE [si], 0x80 - jnz loadpart - add si, 0x10 - loop .loop - jmp error - -loadpart: - ; transfer starting address into DAP - push si - add si, 0x08 - mov di, dap.blocknum - movsw - movsw - pop si - - ; load sector - push si - mov si, dap - mov bp, 0x3336 - mov ah, 0x42 - stc - int 0x13 - jc error - pop si - - cmp BYTE [si+4], 0x01 - jne jump - -adjust: - push dx - - mov bp, 0x3337 - mov ah, 0x08 - stc - int 0x13 - jc error - - ; update sectors per track - xor ax, ax - mov al, cl - mov [spt], ax - - ; update number of sides - xor ax, ax - mov al, dh - mov [nos], ax - - ; update partition offset - push si - add si, 0x08 - mov di, po - movsw - movsw - pop si - - pop dx - -jump: - jmp 0:prog - -error: - mov ax, bp - mov ah, 0x0e - mov bx, 7 - int 0x10 - mov al, 0x21 - int 0x10 - xor ax, ax - int 0x16 - int 0x19 - -dap: -.size: - db 0 - db 0 -.count: - dw 1 -.buffer: - dw prog - dw 0 -.blocknum: - dq 0 - -times (0x1BE - ($-$$)) db 0 -part1: - db 0x80 -.chs_start: - db 0xFF, 0xFF, 0xFF -.type: - db 0x01 -.chs_end: - db 0xFF, 0xFF, 0xFF -.begin: - dd 1 -.end: - dd (FLOPPY * 2) - -times (0x1FE - ($-$$)) db 0 -dw 0xAA55 diff --git a/boot/serial.asm b/boot/serial.asm deleted file mode 100644 index b4b7e78..0000000 --- a/boot/serial.asm +++ /dev/null @@ -1,90 +0,0 @@ -org 0x7c00 - -xor ax, ax -mov ds, ax -mov es, ax -mov ss, ax -mov sp, 0x7c00 -jmp 0:start - -getc: - mov ah, 0x02 - mov dx, 0x0000 - int 0x14 - test ah, 0x80 - jnz getc - ret - -putc: - mov ah, 0x01 - mov dx, 0x0000 - int 0x14 - ret - -init_port: - mov ah, 0x00 - mov al, 0b11100011 - mov dx, 0x0000 - int 0x14 - ret - -dump: - mov si, 0x500 - mov cx, di - sub cx, si -.loop: - lodsb - call print8 - loop .loop - mov al, 0x0A - call putc - mov al, 0x0D - call putc - ret - -line_reset: - cmp di, 0x500 - je .reset - call line_process -.reset: - mov di, 0x500 - xor bp, bp - jmp mainloop - -line_process: - call dump - ret - -start: - call init_port - mov di, 0x500 - jmp line_reset - -mainloop: - call getc - cmp al, ':' - je line_reset - cmp al, 0x20 - jb line_reset - sub al, 0x30 - cmp al, 9 - jbe .noadjust - sub al, 7 -.noadjust: - test bp, bp - jnz .secondnib - mov cl, 4 - shl al, cl - mov [di], al - not bp - jmp mainloop -.secondnib: - or [di], al - inc di - not bp - jmp mainloop - -%include "print.asm" - -times 510-($-$$) db 0x00 -db 0x55,0xaa \ No newline at end of file diff --git a/com/asm86.asm b/com/asm86.asm deleted file mode 100644 index cfb0da9..0000000 --- a/com/asm86.asm +++ /dev/null @@ -1,21 +0,0 @@ -org 0x100 - -jmp start - -%include "fcbparse.asm" - -fcb_asm: - times 36 db 0 - -fcb_bin: - times 36 db 0 - -fcb_lst: - times 36 db 0 - -start: - mov si, 0x81 - mov bx, fcb_asm - mov ax, 0x1234 - call fcb_parse - ret diff --git a/com/hello.asm b/com/hello.asm deleted file mode 100644 index ff02195..0000000 --- a/com/hello.asm +++ /dev/null @@ -1,17 +0,0 @@ -org 0x0100 - -main: - mov si, hello -.loop: - lodsb - test al, al - jz .ret - mov dl, al - mov cl, 0x02 - call 5 - jmp .loop -.ret: - ret - -hello: - db "Hello!", 0x0A, 0x0D, 0 diff --git a/hdr/bios.asm b/hdr/bios.asm deleted file mode 100644 index 9a645b0..0000000 --- a/hdr/bios.asm +++ /dev/null @@ -1,17 +0,0 @@ -; Labels for BIOS entry points -BOOT: EQU (BIOS+0) -WBOOT: EQU (BIOS+3) -CONST: EQU (BIOS+6) -CONIN: EQU (BIOS+9) -CONOUT: EQU (BIOS+12) -LIST: EQU (BIOS+15) -PUNCH: EQU (BIOS+18) -READER: EQU (BIOS+21) -HOME: EQU (BIOS+24) -SELDSK: EQU (BIOS+27) -SETTRK: EQU (BIOS+30) -SETSEC: EQU (BIOS+33) -SETDMA: EQU (BIOS+36) -READ: EQU (BIOS+39) -WRITE: EQU (BIOS+42) -LISTST: EQU (BIOS+45) diff --git a/hdr/bpb.asm b/hdr/bpb.asm deleted file mode 100644 index 83c7153..0000000 --- a/hdr/bpb.asm +++ /dev/null @@ -1,12 +0,0 @@ -; BPB from first sector on FAT fs, starting 0x0B -BPB_SS: EQU 0 ; WORD sector size -BPB_SC: EQU 2 ; BYTE sectors per cluster -BPB_RSC: EQU 3 ; WORD reserved sector count -BPB_FN: EQU 5 ; BYTE number of FATs -BPB_RDE: EQU 6 ; WORD number of root directory entries -BPB_TS: EQU 8 ; WORD total number of sectors -BPB_MI: EQU 10 ; BYTE medium identifier -BPB_SF: EQU 11 ; WORD sectors per FAT -BPB_SPT: EQU 13 ; WORD sectors per track -BPB_NOS: EQU 15 ; WORD number of sides/heads -BPB_PO: EQU 17 ; DWORD partition offset diff --git a/hdr/fcb.asm b/hdr/fcb.asm deleted file mode 100644 index 8bb3852..0000000 --- a/hdr/fcb.asm +++ /dev/null @@ -1,10 +0,0 @@ -; File control block -FCB_DRV: EQU 0 ; BYTE 0=A: 1=B: 2=C: ... -FCB_NAM: EQU 1 ; 8 BYTES, space padded -FCB_EXT: EQU 9 ; 3 BYTES, space padded -FCB_TYP: EQU 12 ; BYTE FCB type -; TYP=1: regular file -FCB_BLK: EQU 13 ; current 128b block in sector -FCB_CLU: EQU 14 ; current sector -FCB_LFT: EQU 16 ; bytes left to read in current file -FCB_END: EQU 20 ; FCB length diff --git a/lib/earlymcb.asm b/lib/earlymcb.asm deleted file mode 100644 index 6a12438..0000000 --- a/lib/earlymcb.asm +++ /dev/null @@ -1,65 +0,0 @@ -%define mcb_first 0x5F - -; This alloc uses an MCB-like list always starting at a fixed offset. -; Boot components may use it to allocate space during early boot. -; The list ends with the most recently allocated arena at its end, -; contrary to how the MCBs work on DOS. - -; Memory Layout: -; 0000 Interrupt table -; 0400 BIOS data area -; 05F0 16 bytes Arena header 1 -; 0600 BX paragraphs Arena 1 -; .... 16 bytes Arena header 2 -; .... BX paragraphs Arena 2 -; ... -; .... 16 bytes Arena header n -; .... BX paragraphs Arena n -; Unmanaged memory - -; Take note that this mechanism works differently than under DOS - -; but this one is optimized for fast and small alloc. - -; Typical usecases: -; - Diskette Parameter Table (See interrupt 1Eh) -; - Partition table -; - Boot sector relocations -; - Boot sector data (FAT table, rootdir) - -; Allocate paragraphs in unmanaged memory -; IN BX requested memory in paragraphs -; OUT AX output segment -early_alloc: - push ds - push bx - push si - ; si is used as zero register - ; this allows the opcodes to use a byte as disp instead of word - xor si, si - mov ax, mcb_first -.next: - mov ds, ax - inc ax - ; DS is seg of arena header - ; AX is seg of arena - cmp BYTE [si], 0x4D - jne .here - add ax, WORD [si+3] - jmp .next -.here: - ; mark as item - mov BYTE [si], 0x4D - ; write segment length in paragraphs - mov WORD [si+3], bx - ; if allocation is higher than CS, then we are in managed memory - ; set ourself as owner then, otherwise use dummy value 8 - mov bx, cs - cmp ax, bx ; CF = CS in unmanaged memory - jnc .setup_owner - mov bx, 8 -.setup_owner: - mov WORD [si+1], bx - pop si - pop bx - pop ds - ret diff --git a/lib/fcbparse.asm b/lib/fcbparse.asm deleted file mode 100644 index eee48d7..0000000 --- a/lib/fcbparse.asm +++ /dev/null @@ -1,46 +0,0 @@ -; Parse ASCIIZ string into FCB -; IN SI ptr to filename -; BX ptr to FCB -fcb_parse: - push di - push ax - mov di, bx - xor ax, ax - stosb -.cleanout: - push di - mov cx, 0x0A - mov al, 0x20 - rep stosb - pop di -.base_loop: - call .read - cmp al, 0x2E - je .ext_start - cmp al, 0x20 - je .ret - stosb - jmp .base_loop -.ext_start: - mov di, bx - add di, 9 -.ext_loop: - call .read - cmp al, 0x20 - je .ret - stosb - jmp .ext_loop -.read: - lodsb - test al, al - jz .eret - cmp al, 0x0D - je .eret - ret -.eret: - dec si - pop ax -.ret: - pop ax - pop di - ret diff --git a/lib/fdc.asm b/lib/fdc.asm deleted file mode 100644 index dbb21e6..0000000 --- a/lib/fdc.asm +++ /dev/null @@ -1,14 +0,0 @@ -; FDC Descriptor / BIOS parameter block -fdc_ss: equ 0x0B ; WORD sector size -fdc_sc: equ 0x0D ; BYTE sectors per cluster -fdc_rsc: equ 0x0E ; WORD reserved sectors -fdc_fn: equ 0x10 ; BYTE FAT tables -fdc_rde: equ 0x11 ; WORD root directory entries -fdc_ts: equ 0x13 ; WORD total sector count - ; 0 if >65535, use lrgts then -fdc_mi: equ 0x15 ; BYTE media descriptor byte -fdc_sf: equ 0x16 ; WORD sectors per FAT -fdc_spt: equ 0x18 ; WORD sectors per track -fdc_nos: equ 0x1A ; WORD sides/heads -fdc_po: equ 0x1C ; DWORD partition offset -fdc_lrgts: equ 0x20 ; DWORD large sector count diff --git a/lib/log2.asm b/lib/log2.asm deleted file mode 100644 index b61dbd9..0000000 --- a/lib/log2.asm +++ /dev/null @@ -1,15 +0,0 @@ -; Calculate dual logarithm (int) -; IN AX number -; OUT AX dual logarithm -log2: - push cx - mov cx, 15 -.loop: - rcl ax, 1 - jc .ret - loop .loop -.ret: - cmc - mov ax, cx - pop cx - ret diff --git a/lib/nasmcomp.asm b/lib/nasmcomp.asm deleted file mode 100644 index 4fbebf8..0000000 --- a/lib/nasmcomp.asm +++ /dev/null @@ -1,124 +0,0 @@ -; Pseudo-Instruction: fill bytes until offset -%macro pad 1.nolist -times (%1 - ($-$$)) nop -%endmacro - -; REGISTERS -%define a al -%define b ch -%define c cl -%define d dh -%define e dl -%define h bh -%define l bl -%define m byte [bx] - -; REGISTER PAIRS -%define bc cx -%define de dx -%define hl bx - -; INSTRUCTIONS -; data movement -; 'mov' can stay literal -%define mvi mov -%define lxi mov -%macro lda 1 - mov al, byte [%1] -%endmacro -%macro sta 1 - mov byte [%1], al -%endmacro -%macro lhld 1 - mov bx, word [%1] -%endmacro -%macro shld 1 - mov word [%1], bx -%endmacro -%macro ldax 1 - mov al, byte [%1] -%endmacro -%macro stax 1 - mov byte [%1], al -%endmacro -%macro xchg 1 - xchg dx, bx -%endmacro -; addition -%macro add 1 - add al, %1 -%endmacro -%macro adi 1 - add al, %1 -%endmacro -%macro adc 1 - adc al, %1 -%endmacro -%macro aci 1 - adc al, %1 -%endmacro -; subtraction -%macro sub 1 - sub al, %1 -%endmacro -%macro sui 1 - sub al, %1 -%endmacro -%macro sbb 1 - sub al, %1 -%endmacro -%macro sbi 1 - sub al, %1 -%endmacro -; increment / decrement -%define inr inc -%define dcr dec -%define inx inc -%define dcx dec -; pointer arithmetic -%macro dad 1 - add bx, %1 -%endmacro -; 'daa' stays literal - -;ANA S 10100SSS ZSCPA AND register with A -;ANI # 11100110 db ZSPCA AND immediate with A -;ORA S 10110SSS ZSPCA OR register with A -;ORI # 11110110 ZSPCA OR immediate with A -;XRA S 10101SSS ZSPCA ExclusiveOR register with A -;XRI # 11101110 db ZSPCA ExclusiveOR immediate with A - -;CMP S 10111SSS ZSPCA Compare register with A -;CPI # 11111110 ZSPCA Compare immediate with A - -;RLC 00000111 C Rotate A left -;RRC 00001111 C Rotate A right -;RAL 00010111 C Rotate A left through carry -;RAR 00011111 C Rotate A right through carry -;CMA 00101111 - Compliment A -;CMC 00111111 C Compliment Carry flag -;STC 00110111 C Set Carry flag -;JMP a 11000011 lb hb - Unconditional jump -;Jccc a 11CCC010 lb hb - Conditional jump -;CALL a 11001101 lb hb - Unconditional subroutine call -;Cccc a 11CCC100 lb hb - Conditional subroutine call -;RET 11001001 - Unconditional return from subroutine -;Rccc 11CCC000 - Conditional return from subroutine -;RST n 11NNN111 - Restart (Call n*8) -;PCHL 11101001 - Jump to address in H:L -;PUSH RP 11RP0101 *2 - Push register pair on the stack -;POP RP 11RP0001 *2 *2 Pop register pair from the stack -;XTHL 11100011 - Swap H:L with top word on stack -;SPHL 11111001 - Set SP to content of H:L -;IN p 11011011 pa - Read input port into A -;OUT p 11010011 pa - Write A to output port -;EI 11111011 - Enable interrupts -;DI 11110011 - Disable interrupts -;HLT 01110110 - Halt processor -;NOP 00000000 - No operation - -%macro cnz 1 - jz %%skip - call near %1 -%%skip: -%endmacro diff --git a/lib/opcode80.asm b/lib/opcode80.asm deleted file mode 100644 index 1334f61..0000000 --- a/lib/opcode80.asm +++ /dev/null @@ -1,142 +0,0 @@ -; BYTE name length -; n BYTES name -; BYTE opcode template (variable parts zero) -; -; BYTE operand 1 -; BYTE operand 2 - -; operand types: -; 0x00 none -; 0x1n reg8, opcode |= (reg8 << n) -; 0x2n reg16, opcode |= (reg8 << n) -; 0x3n reg16b, opcode |= (reg8 << n) -; 0x7n 3-bit number, opcode |= (num << n) -; 0x80 imm8, encoded as extra byte -; 0x81 imm16, encoded as extra word - -registers: -.reg8: - db "B", 0 - db "C", 0 - db "D", 0 - db "E", 0 - db "H", 0 - db "L", 0 - db "M", 0 - db 0 -.reg16: - db "BC", 0 - db "DE", 0 - db "HL", 0 - db "SP", 0 - db 0 -.reg16b: - db "BC", 0 - db "DE", 0 - db "HL", 0 - db "AF", 0 - db 0 -.end: - db 0 - -opcodes: - ; Data movement - db 3, "MOV", 0b01000000, 0x13, 0x10 - db 3, "MVI", 0b00000110, 0x13, 0x80 - db 3, "LXI", 0b00000001, 0x24, 0x81 - db 3, "LDA", 0b00111010, 0x81, 0x00 - db 3, "STA", 0b00110010, 0x81, 0x00 - db 4, "LHLD", 0b00101010, 0x81, 0x00 - db 4, "SHLD", 0b00100010, 0x81, 0x00 - db 4, "LDAX", 0b00001010, 0x24, 0x00 - db 4, "STAX", 0b00000010, 0x24, 0x00 - db 4, "XCHG", 0b11101011, 0x00, 0x00 - - ; Addition / Subtraction - db 3, "ADD", 0b10000000, 0x10, 0x00 - db 3, "ADI", 0b11000110, 0x80, 0x00 - db 3, "ADC", 0b10001000, 0x10, 0x00 - db 3, "ACI", 0b11001110, 0x80, 0x00 - db 3, "SUB", 0b10010000, 0x10, 0x00 - db 3, "SUI", 0b11010110, 0x80, 0x00 - db 3, "SBB", 0b10011000, 0x10, 0x00 - db 3, "SBI", 0b11011110, 0x80, 0x00 - db 3, "INR", 0b00000100, 0x13, 0x00 - db 3, "DCR", 0b00000101, 0x13, 0x00 - db 3, "INX", 0b00000011, 0x24, 0x00 - db 3, "DCX", 0b00001011, 0x24, 0x00 - db 3, "DAD", 0b00001001, 0x24, 0x00 - - ; BCD - db 3, "DAA", 0b00100111, 0x00, 0x00 - - ; Bitwise operations - db 3, "ANA", 0b10100000, 0x10, 0x00 - db 3, "ANI", 0b11100110, 0x80, 0x00 - db 3, "ORA", 0b10110000, 0x10, 0x00 - db 3, "ORI", 0b11110110, 0x80, 0x00 - db 3, "XRA", 0b10101000, 0x10, 0x00 - db 3, "XRI", 0b11101110, 0x80, 0x00 - db 3, "CMP", 0b10111000, 0x10, 0x00 - db 3, "CPI", 0b11111110, 0x80, 0x00 - - ; Rotate - db 3, "RLC", 0b00000111, 0x00, 0x00 - db 3, "RRC", 0b00001111, 0x00, 0x00 - db 3, "RAL", 0b00010111, 0x00, 0x00 - db 3, "RAR", 0b00011111, 0x00, 0x00 - - ; Complement - db 3, "CMA", 0b00101111, 0x00, 0x00 - db 3, "CMC", 0b00111111, 0x00, 0x00 - db 3, "STC", 0b00110111, 0x00, 0x00 - - ; Jump - db 3, "JMP", 0b11000011, 0x81, 0x00 - db 3, "JNZ", 0b11000010, 0x81, 0x00 - db 2, "JZ", 0b11001010, 0x81, 0x00 - db 3, "JNC", 0b11010010, 0x81, 0x00 - db 2, "JC", 0b11011010, 0x81, 0x00 - db 3, "JPO", 0b11100010, 0x81, 0x00 - db 3, "JPE", 0b11101010, 0x81, 0x00 - db 2, "JP", 0b11110010, 0x81, 0x00 - db 2, "JM", 0b11111010, 0x81, 0x00 - - ; Call - db 4, "CALL", 0b11001101, 0x81, 0x00 - db 3, "CNZ", 0b11000100, 0x81, 0x00 - db 2, "CZ", 0b11001100, 0x81, 0x00 - db 3, "CNC", 0b11010100, 0x81, 0x00 - db 2, "CC", 0b11011100, 0x81, 0x00 - db 3, "CPO", 0b11100100, 0x81, 0x00 - db 3, "CPE", 0b11101100, 0x81, 0x00 - db 2, "CP", 0b11110100, 0x81, 0x00 - db 2, "CM", 0b11111100, 0x81, 0x00 - - ; Return - db 3, "RET", 0b11001001, 0x00, 0x00 - db 3, "RNZ", 0b11000000, 0x00, 0x00 - db 2, "RZ", 0b11001000, 0x00, 0x00 - db 3, "RNC", 0b11010000, 0x00, 0x00 - db 2, "RC", 0b11011000, 0x00, 0x00 - db 3, "RPO", 0b11100000, 0x00, 0x00 - db 3, "RPE", 0b11101000, 0x00, 0x00 - db 2, "RP", 0b11110000, 0x00, 0x00 - db 2, "RM", 0b11111000, 0x00, 0x00 - - db 3, "RST", 0b11000111, 0x73, 0x00 - db 4, "PCHL", 0b11101001, 0x00, 0x00 - db 4, "PUSH", 0b11000101, 0x34, 0x00 - db 3, "POP", 0b11000001, 0x34, 0x00 - db 4, "XTHL", 0b11100011, 0x00, 0x00 - db 4, "SPHL", 0b11111001, 0x00, 0x00 - - db 2, "IN", 0b11011011, 0x80, 0x00 - db 3, "OUT", 0b11010011, 0x80, 0x00 - - db 2, "EI", 0b11111011, 0x00, 0x00 - db 2, "DI", 0b11110011, 0x00, 0x00 - db 3, "HLT", 0b01110110, 0x00, 0x00 - db 3, "NOP", 0b00000000, 0x00, 0x00 - - db 0 diff --git a/lib/popcnt.asm b/lib/popcnt.asm deleted file mode 100644 index d03694a..0000000 --- a/lib/popcnt.asm +++ /dev/null @@ -1,30 +0,0 @@ -popcnt: - push bx - push cx - - mov bx, ax - and ax, 0x5555 ; 8x 01 - and bx, 0xaaaa ; 8x 10 - shr bx, 1 - add ax, bx - - mov bx, ax - and ax, 0x3333 ; 4x 0011 - and bx, 0xcccc ; 4x 1100 - mov cl, 2 - shr bx, cl - add ax, bx - - mov bx, ax - and ax, 0x0f0f ; 2x 00001111 - and bx, 0xf0f0 ; 2x 11110000 - mov cl, 4 - shr bx, cl - add ax, bx - - add al, ah - xor ah, ah - - pop cx - pop bx - ret diff --git a/lib/print.asm b/lib/print.asm deleted file mode 100644 index 85e2124..0000000 --- a/lib/print.asm +++ /dev/null @@ -1,33 +0,0 @@ -; important functions in this file: kprintf - -; print a word -; in: ax -print16: - xchg ah,al - call print8 - xchg ah,al - -; print a byte -; in: al -print8: - push ax ; avoid destroying ah - push bx - xor bx, bx - aam 16 ; high nibble moved into ah, low nibble into al - add ax, 0x3030 - push ax - xchg al, ah - call .nib - pop ax - call .nib - pop bx - pop ax - ret -.nib: - cmp al, 0x3a - jl .out - add al, 0x07 -.out: - mov ah, 0x0e - int 0x10 - ret diff --git a/lib/printf.asm b/lib/printf.asm deleted file mode 100644 index 9584c70..0000000 --- a/lib/printf.asm +++ /dev/null @@ -1,105 +0,0 @@ -printf: - cld - pop si - push bp - mov bp, sp -.loop: - mov al, [cs:si] - inc si - cmp al, 0x00 - je .end - cmp al, 0x25 - je .handle_25h -.literal: - call putc - jmp .loop -.end: - pop bp - push si - ret -.handle_25h: - mov al, [cs:si] - inc si - cmp al, 0x25 - je .literal - cmp al, 0x58 ; 'X' - je .printhex - cmp al, 0x55 ; 'U' - je .printdec - cmp al, 0x53 ; 'S' - je .printstr - mov al, 0x3F - jmp .literal -.printhex: - add bp, 2 - mov ax, [bp] - mov bx, 0x0010 - call print_number - jmp .loop -.printdec: - add bp, 2 - mov ax, [bp] - mov bx, 0x000A - call print_number - jmp .loop -.printstr: - add bp, 2 - mov ax, [bp] - call print_string - jmp .loop - -; converts a integer to ascii -; in ax input integer -; bx base -; cx minimum number of digits -; out bx garbled -; dx garbled -print_number_padded: - xor dx, dx - div bx - push dx - dec cx - jz .nopad - call print_number_padded - jmp print_number.end -.nopad: - call print_number - jmp print_number.end - -; converts a integer to ascii -; in ax input integer -; bx base -; out bx garbled -; dx garbled -print_number: - xor dx, dx - div bx ; ax = dx:ax / 10, dx = dx:ax % 10 - push dx - and ax, ax - jz .end - call print_number -.end: - pop bx - xor bh, bh - add bx, print_chars - mov al, [cs:bx] - call putc - ret - -; putc's a string -; in DS:AX null-terminated string -print_string: - push si - mov si, ax -.loop: - lodsb - cmp al, 0x00 - je .end - call putc - jmp .loop -.end: - pop si - ret - -print_chars: - db "0123456789ABCDEF" \ No newline at end of file diff --git a/rom/debug.asm b/rom/debug.asm deleted file mode 100644 index 19b139a..0000000 --- a/rom/debug.asm +++ /dev/null @@ -1,294 +0,0 @@ -cpu 8086 -org 0x0000 - -%macro push8086 0 - push ss - push es - push ds - push di - push si - push bp - push sp - push bx - push dx - push cx - push ax - - ; adjust stored SP to be value before interrupt - mov bp, sp - mov [bp+08], bp - add WORD [bp+08], 28 -%endmacro - -%macro pop8086 0 - pop ax - pop cx - pop dx - pop bx - add sp, 2 ; skip SP - pop bp - pop si - pop di - pop ds - pop es - add sp, 2 ; skip SS -%endmacro - -rom: - db 0x55, 0xAA -.sectors: - db 0x00 -.init: - jmp init - nop - -.name: - db "RDOS DEBUG", 0 - - times (0x18 - ($-$$)) db 0 -.pcir_ptr: - dw 0 - - times (0x1A - ($-$$)) db 0 -.pnp_ptr: - dw pnp - -pnp: - db "$PnP" -.version: - db 1 ; version 1 -.length: - db 2 ; 2 * 16 length - dw 0 ; offset of next header - db 0 -.checksum: - db 0 ; checksum (filled by fix-rom) - dd 0 ; device identifier - dw 0 ; manufacturer string - dw rom.name ; product name string - db 0,0,0 ; device type string - db 0x20 ; device indicator, bit for "read cacheable" set - dw 0 ; boot connection vector - dw 0 ; boot disconnect vector - dw 0 ; bootstrap entry point - dw 0 ; reserved - dw 0 - -init: - mov bx, 0 - mov dx, isr_divide_error - call hook_int - - mov bx, 1 - mov dx, isr_singlestep - call hook_int - - mov bx, 2 - mov dx, isr_nmi - call hook_int - - mov bx, 3 - mov dx, isr_breakpoint - call hook_int - - mov bx, 4 - mov dx, isr_overflow - call hook_int - - ; 5 left out - - mov bx, 6 - mov dx, isr_invalid_opcode - call hook_int - - push cs - pop ds - mov si, rom.name - push cs - push si - call printf - db "%S %X", 0x0A, 0x0D, 0 - add sp, 4 - - retf - -; Hook interrupt -hook_int: - ; bx times 4 - add bx, bx - add bx, bx - ; store offset - mov [bx], dx - ; store segment - push ax - mov ax, cs - mov [bx+2], ax - pop ax - ret - -putc: - push bx - push cx - mov ah, 0x0e - mov bx, 0x0000 - int 0x10 - pop cx - pop bx - ret - -; Names for words in debug frame -; Two characters per word, 14 words total -debug_frame_names: - ; general-purpose registers - db "AXCXDXBXSPBPSIDI" - ; extra registers - db "DSESSSIPCSFL" - -; Names for bits in debug_frame+26 (FL/Flags register) -; One character per bit, 16 bits total -debug_frame_flags: - db "++++ODIT" - db "SZ+A+P+C" - -; Print a single register from the frame -; in SI frame offset for register -debug_frame_register_print: - mov bx, debug_frame_names - mov al, [cs:bx+si] ; first name char load - call putc - mov al, [cs:bx+si+1] ; second name char load - call putc - mov al, '=' - call putc - mov ax, [ss:bp+si] ; value load - ; prepare call to print_number - push bx - push cx - mov bx, 0x0010 - mov cx, 3 - call print_number_padded - pop cx - pop bx - mov al, ' ' - call putc - ret - -debug_frame_print: - mov si, 0 - mov cx, 8 -.reg1loop: - call debug_frame_register_print - add si, 2 - loop .reg1loop - - mov dx, [ss:bp+26] - mov di, debug_frame_flags - mov cx, 0x0010 -.flag_loop: - mov al, [cs:di] - inc di - cmp al, '+' - je .next - test dx, 0x8000 - jnz .write - mov al, '-' -.write: - call putc -.next: - sal dx, 1 - loop .flag_loop - - call printf - db 0x0A, 0x0D, 0 - - mov si, 16 - mov cx, 5 -.reg2loop: - call debug_frame_register_print - add si, 2 - loop .reg2loop - - call printf - db 0x0A, 0x0D, 0 - - ret - -isr_divide_error: - push8086 - - call printf - db 0x0A, 0x0D, "INT 0 - DIVIDE ERROR", 0x0A, 0x0D, 0 - - call debug_frame_print - - jmp halt - -isr_singlestep: - push8086 - - call printf - db 0x0A, 0x0D, 0 - - call debug_frame_print - - ; wait for keypress - xor ax, ax - int 0x16 - - ; enable trace flag so we fire again after next instruction - or word [ss:bp+26], 0x0100 - - pop8086 - iret - -isr_nmi: - push8086 - - call printf - db 0x0A, 0x0D, "INT 2 - NON-MASKABLE INTERRUPT", 0x0A, 0x0D, 0 - - call debug_frame_print - - jmp halt - -isr_breakpoint: - push8086 - - call printf - db 0x0A, 0x0D, 0 - - call debug_frame_print - - pop8086 - iret - -isr_overflow: - push8086 - - call printf - db 0x0A, 0x0D, "INT 4 - OVERFLOW", 0x0A, 0x0D, 0 - - call debug_frame_print - - jmp halt - -isr_invalid_opcode: - push8086 - - call printf - db 0x0A, 0x0D, "INT 6 - INVALID OPCODE", 0x0A, 0x0D, 0 - - call debug_frame_print - - jmp halt - -halt: - call printf - db "HALTED", 0x0A, 0x0D, 0 -.loop: - hlt - jmp halt - -%include "printf.asm" - -align 512 diff --git a/src/utils/em8080.c b/src/utils/em8080.c deleted file mode 100644 index cc752dd..0000000 --- a/src/utils/em8080.c +++ /dev/null @@ -1,518 +0,0 @@ -#include -#include -#include -#include - -uint8_t mem[64*1024]; - -typedef struct flagbits { - unsigned int c : 1; - unsigned int u1 : 1; - unsigned int p : 1; - unsigned int u3 : 1; - - unsigned int a : 1; - unsigned int u5 : 1; - unsigned int z : 1; - unsigned int s : 1; -} flagbits; - -typedef struct reg { - uint8_t flags; - uint8_t a; - uint8_t c; - uint8_t b; - uint8_t e; - uint8_t d; - uint8_t l; - uint8_t h; -} reg; - -typedef struct regp { - uint16_t psw; - uint16_t bc; - uint16_t de; - uint16_t hl; -} regp; - -union regset { - struct reg reg; - struct regp regp; -} regset; - -#define A regset.reg.a -#define B regset.reg.b -#define C regset.reg.c -#define D regset.reg.d -#define E regset.reg.e -#define H regset.reg.h -#define L regset.reg.l -#define M mem[HL] - -#define BC regset.regp.bc -#define DE regset.regp.de -#define HL regset.regp.hl - -#define flags (*(struct flagbits*)®set.reg.flags) - -uint16_t IP = 0x100; -uint16_t SP = 0; -unsigned int tmp; - -// Dump registers -void dump() { - printf("\n"); - printf("A=%02X BC=%04X DE=%04X HL=%04X M=%02X SP=%04X ", A, BC, DE, HL, M, SP); - printf("%c", flags.s ? 'S' : '-'); - printf("%c", flags.z ? 'Z' : '-'); - printf("%c", flags.a ? 'A' : '-'); - printf("%c", flags.p ? 'P' : '-'); - printf("%c", flags.c ? 'C' : '-'); - - printf("\n"); - printf("IP=%04X : %02X %02X\n", IP, mem[IP], mem[IP+1]); -} - -uint8_t imm8() { - uint8_t r = *(uint8_t*)&mem[IP]; - IP++; - return r; -} - -uint16_t imm16() { - uint16_t r = *(uint16_t*)&mem[IP]; - IP+=2; - return r; -} - -void push(uint16_t v) { - SP -= 2; - *(uint16_t*)&mem[SP] = v; -} - -uint16_t pop() { - uint16_t v = *(uint16_t*)&mem[SP]; - SP += 2; - return v; -} - -void in(uint8_t port) { - -} - -void out(uint8_t port) { - -} - -int has_even_parity(uint8_t x){ - unsigned int count = 0, i, b = 1; - - for(i = 0; i < 8; i++){ - if( x & (b << i) ){count++;} - } - - if( (count % 2) ){return 0;} - return 1; -} - -void cpm_syscall(int number) { - switch(number) { - case 0: - exit(0); - break; - case 2: - printf("%c", E); - break; - case 0x0C: - H=0x02; - L=0x00; - break;; - default: - fprintf(stderr, "Fatal: Unhandled CP/M syscall C=%02Xh\n", number); - exit(1); - } -} - -void call(uint16_t v) { - switch(v) { - case 0: - exit(0); - break;; - case 5: - cpm_syscall(C); - break;; - default: - push(IP); - IP=v; - break; - } -} - -void interrupt(int number) { - call(number << 3); -} - -#define add16c(a, b) \ - tmp = a + b; \ - flags.c = (tmp >> 16) & 1 - -#define unarync(a, op) \ - tmp=a; \ - tmp op; \ - flags.p = has_even_parity(tmp & 8); \ - flags.z = !(tmp); \ - flags.s = (tmp >> 7) & 1; \ - a=tmp - -#define aritht(a, op, b) \ - tmp=a; \ - tmp=a op b; \ - flags.c = (tmp >> 8) & 1; \ - flags.p = has_even_parity(tmp & 8); \ - flags.z = !(tmp); \ - flags.s = (tmp >> 7) & 1; - -#define arith(a, op, b) \ - aritht(a, op, b); \ - a=tmp - -// Execute a single instruction -void step() { - uint8_t opcode = mem[IP]; - IP++; - switch(opcode) { - case 0x00: break;; - case 0x01: BC=imm16(); break;; - case 0x02: mem[BC]=A; break;; - case 0x03: BC++; - case 0x04: unarync(B, ++); break;; - case 0x05: unarync(B, --); break;; - case 0x06: B=imm8(); break;; - case 0x07: tmp=A; A = A << 1 | flags.c; flags.c = tmp >> 7; break;; - - case 0x09: HL=add16c(HL,BC); break;; - case 0x0a: A=mem[BC]; break;; - case 0x0b: BC--; - case 0x0c: unarync(B, ++); break;; - case 0x0d: unarync(B, --); break;; - case 0x0e: C=imm8(); break;; - - case 0x11: DE=imm16(); break;; - case 0x12: mem[DE]=A; break;; - case 0x13: DE++; - case 0x14: unarync(D, ++); break;; - case 0x15: unarync(D, --); break;; - case 0x16: D=imm8(); break;; - - case 0x19: HL=add16c(HL,DE); break;; - case 0x1a: A=mem[DE]; break;; - case 0x1b: DE--; - case 0x1c: unarync(E, ++); break;; - case 0x1d: unarync(E, --); break;; - case 0x1e: E=imm8(); break;; - - case 0x21: HL=imm16(); break;; - case 0x22: *(uint16_t*)&mem[imm16()]=HL; break;; - case 0x23: HL++; - case 0x24: unarync(H, ++); break;; - case 0x25: unarync(H, --); break;; - case 0x26: H=imm8(); break;; - - case 0x29: HL=add16c(HL,HL); break;; - case 0x2a: HL=*(uint16_t*)&mem[imm16()]; break;; - case 0x2b: HL--; - case 0x2c: unarync(L, ++); break;; - case 0x2d: unarync(L, --); break;; - case 0x2e: L=imm8(); break;; - case 0x2f: A=~A; break;; - - case 0x31: SP=imm16(); break;; - case 0x32: mem[imm16()]=A; break;; - case 0x33: SP++; - case 0x34: unarync(M, ++); break;; - case 0x35: unarync(M, --); break;; - case 0x36: M=imm8(); break;; - case 0x37: flags.c = 1; break;; - - case 0x39: HL=add16c(HL,SP); break;; - case 0x3a: A=mem[imm16()]; break;; - case 0x3b: SP--; - case 0x3c: unarync(A, ++); break;; - case 0x3d: unarync(A, --); break;; - case 0x3e: A=imm8(); break;; - case 0x3f: flags.c = !flags.c; break;; - - case 0x40: B=B; break;; - case 0x41: B=C; break;; - case 0x42: B=D; break;; - case 0x43: B=E; break;; - case 0x44: B=H; break;; - case 0x45: B=L; break;; - case 0x46: B=M; break;; - case 0x47: B=A; break;; - - case 0x48: C=B; break;; - case 0x49: C=C; break;; - case 0x4a: C=D; break;; - case 0x4b: C=E; break;; - case 0x4c: C=H; break;; - case 0x4d: C=L; break;; - case 0x4e: C=M; break;; - case 0x4f: C=A; break;; - - case 0x50: D=B; break;; - case 0x51: D=C; break;; - case 0x52: D=D; break;; - case 0x53: D=E; break;; - case 0x54: D=H; break;; - case 0x55: D=L; break;; - case 0x56: D=M; break;; - case 0x57: D=A; break;; - - case 0x58: E=B; break;; - case 0x59: E=C; break;; - case 0x5a: E=D; break;; - case 0x5b: E=E; break;; - case 0x5c: E=H; break;; - case 0x5d: E=L; break;; - case 0x5e: E=M; break;; - case 0x5f: E=A; break;; - - case 0x60: H=B; break;; - case 0x61: H=C; break;; - case 0x62: H=D; break;; - case 0x63: H=E; break;; - case 0x64: H=H; break;; - case 0x65: H=L; break;; - case 0x66: H=M; break;; - case 0x67: H=A; break;; - - case 0x68: L=B; break;; - case 0x69: L=C; break;; - case 0x6a: L=D; break;; - case 0x6b: L=E; break;; - case 0x6c: L=H; break;; - case 0x6d: L=L; break;; - case 0x6e: L=M; break;; - case 0x6f: L=A; break;; - - case 0x70: M=B; break;; - case 0x71: M=C; break;; - case 0x72: M=D; break;; - case 0x73: M=E; break;; - case 0x74: M=H; break;; - case 0x75: M=L; break;; - case 0x76: exit(0); break;; - case 0x77: M=A; break;; - - case 0x78: A=B; break;; - case 0x79: A=C; break;; - case 0x7a: A=D; break;; - case 0x7b: A=E; break;; - case 0x7c: A=H; break;; - case 0x7d: A=L; break;; - case 0x7e: A=M; break;; - case 0x7f: A=A; break;; - - case 0x80: arith(A, +, B); break;; - case 0x81: arith(A, +, C); break;; - case 0x82: arith(A, +, D); break;; - case 0x83: arith(A, +, E); break;; - case 0x84: arith(A, +, H); break;; - case 0x85: arith(A, +, L); break;; - case 0x86: arith(A, +, M); break;; - case 0x87: arith(A, +, A); break;; - - case 0x88: arith(A, +flags.c+, B); break;; - case 0x89: arith(A, +flags.c+, C); break;; - case 0x8A: arith(A, +flags.c+, D); break;; - case 0x8B: arith(A, +flags.c+, E); break;; - case 0x8C: arith(A, +flags.c+, H); break;; - case 0x8D: arith(A, +flags.c+, L); break;; - case 0x8E: arith(A, +flags.c+, M); break;; - case 0x8F: arith(A, +flags.c+, A); break;; - - case 0x90: arith(A, -, B); break;; - case 0x91: arith(A, -, C); break;; - case 0x92: arith(A, -, D); break;; - case 0x93: arith(A, -, E); break;; - case 0x94: arith(A, -, H); break;; - case 0x95: arith(A, -, L); break;; - case 0x96: arith(A, -, M); break;; - case 0x97: arith(A, -, A); break;; - - case 0x98: arith(A, -flags.c-, B); break;; - case 0x99: arith(A, -flags.c-, C); break;; - case 0x9A: arith(A, -flags.c-, D); break;; - case 0x9B: arith(A, -flags.c-, E); break;; - case 0x9C: arith(A, -flags.c-, H); break;; - case 0x9D: arith(A, -flags.c-, L); break;; - case 0x9E: arith(A, -flags.c-, M); break;; - case 0x9F: arith(A, -flags.c-, A); break;; - - case 0xA0: arith(A, &, B); break;; - case 0xA1: arith(A, &, C); break;; - case 0xA2: arith(A, &, D); break;; - case 0xA3: arith(A, &, E); break;; - case 0xA4: arith(A, &, H); break;; - case 0xA5: arith(A, &, L); break;; - case 0xA6: arith(A, &, M); break;; - case 0xA7: arith(A, &, A); break;; - - case 0xA8: arith(A, ^, B); break;; - case 0xA9: arith(A, ^, C); break;; - case 0xAA: arith(A, ^, D); break;; - case 0xAB: arith(A, ^, E); break;; - case 0xAC: arith(A, ^, H); break;; - case 0xAD: arith(A, ^, L); break;; - case 0xAE: arith(A, ^, M); break;; - case 0xAF: arith(A, ^, A); break;; - - case 0xB0: arith(A, |, B); break;; - case 0xB1: arith(A, |, C); break;; - case 0xB2: arith(A, |, D); break;; - case 0xB3: arith(A, |, E); break;; - case 0xB4: arith(A, |, H); break;; - case 0xB5: arith(A, |, L); break;; - case 0xB6: arith(A, |, M); break;; - case 0xB7: arith(A, |, A); break;; - - case 0xB8: aritht(A, -, B); break;; - case 0xB9: aritht(A, -, C); break;; - case 0xBA: aritht(A, -, D); break;; - case 0xBB: aritht(A, -, E); break;; - case 0xBC: aritht(A, -, H); break;; - case 0xBD: aritht(A, -, L); break;; - case 0xBE: aritht(A, -, M); break;; - case 0xBF: aritht(A, -, A); break;; - - case 0xC0: if (!flags.z) IP=pop(); break;; - case 0xC1: BC=pop(); break;; - case 0xC2: tmp=imm16(); if (!flags.z) IP=tmp; break;; - case 0xC3: IP=imm16(); break;; - case 0xC4: tmp=imm16(); if (!flags.z) call(tmp); break;; - case 0xC5: push(BC); break;; - case 0xC6: arith(A, +, imm8()); break;; - case 0xC7: interrupt(0); break;; - - case 0xC8: if (flags.z) IP=pop(); break;; - case 0xC9: IP=pop(); break;; - case 0xCA: tmp=imm16(); if (flags.z) IP=tmp; break;; - case 0xCC: tmp=imm16(); if (flags.z) call(tmp); break;; - case 0xCD: call(imm16()); break;; - case 0xCE: arith(A, +flags.c+, imm8()); break;; - case 0xCF: interrupt(1); break;; - - case 0xD0: if (!flags.c) IP=pop(); break;; - case 0xD1: DE=pop(); break;; - case 0xD2: tmp=imm16(); if (!flags.c) IP=tmp; break;; - case 0xD3: out(imm8()); break;; - case 0xD4: tmp=imm16(); if (!flags.c) call(tmp); break;; - case 0xD5: push(DE); break;; - case 0xD6: arith(A, -, imm8()); break;; - case 0xD7: interrupt(2); break;; - - case 0xD8: if (flags.c) IP=pop(); break;; - case 0xDA: tmp=imm16(); if (flags.c) IP=tmp; break;; - case 0xDB: in(imm8()); break;; - case 0xDC: tmp=imm16(); if (flags.c) call(tmp); break;; - case 0xDE: arith(A, -flags.c-, imm8()); break;; - case 0xDF: interrupt(3); break;; - - case 0xE0: if (!flags.p) IP=pop(); break;; - case 0xE1: HL=pop(); break;; - case 0xE2: tmp=imm16(); if (!flags.p) IP=tmp; break;; - case 0xE3: tmp=HL; HL=pop(); push(tmp); break;; - case 0xE4: tmp=imm16(); if (!flags.p) call(tmp); break;; - case 0xE5: push(HL); break;; - case 0xE6: arith(A, &, imm8()); break;; - case 0xE7: interrupt(4); break;; - - case 0xE8: if (flags.p) IP=pop(); break;; - case 0xE9: IP=HL; break;; - case 0xEA: tmp=imm16(); if (flags.p) IP=tmp; break;; - case 0xEB: tmp=HL; HL=DE; DE=tmp;; break;; - case 0xEC: tmp=imm16(); if (flags.p) call(tmp); break;; - case 0xEE: arith(A, ^, imm8()); break;; - case 0xEF: interrupt(5); break;; - - case 0xF0: if (!flags.s) IP=pop(); break;; - case 0xF1: regset.regp.psw=pop(); break;; - case 0xF2: tmp=imm16(); if (!flags.s) IP=tmp; break;; - case 0xF4: tmp=imm16(); if (!flags.s) call(tmp); break;; - case 0xF5: push(regset.regp.psw); break;; - case 0xF6: arith(A, |, imm8()); break;; - case 0xF7: interrupt(6); break;; - - case 0xF8: if (flags.s) IP=pop(); break;; - case 0xF9: SP=HL; break;; - case 0xFA: tmp=imm16(); if (flags.s) IP=tmp; break;; - case 0xFC: tmp=imm16(); if (flags.s) call(tmp); break;; - case 0xFE: aritht(A, -, imm8()); break;; - case 0xFF: interrupt(7); break;; - - default: - IP--; - dump(); - fprintf(stderr, "Invalid opcode at IP=%04X\n", IP); - exit(1); - break; - } -} - -void copy_cmdline(char* str) { - int i, c; - uint8_t *len = &mem[0x80]; - char* ptr = (char*)&mem[0x81]; - c = strlen(str); - // Clip at max length - if (c>0x7E) { - fprintf(stderr, "Command line too long, max is 126 bytes\n"); - exit(1); - } - memcpy(ptr, str, c); - ptr[c]=0x0D; - *len=c; -} - -int main(int argc, char** argv) { - memset(&mem, sizeof(mem), 0); - // Prepare default exit into int 20h - mem[0]=0x76; - push(0); - - argc--; - argv++; - - while(argc && argv[0][0]=='-') { - switch(argv[0][1]) { - default: - fprintf(stderr, "Unknown option %s\n", argv[0]); - exit(1); - break; - } - argc--; - argv++; - } - - if (argc) { - FILE* fd = fopen(argv[0], "r"); - fread(mem + IP, 1, sizeof(mem) - IP, fd); - argc--; - argv++; - } else { - fprintf(stderr, "No COM file specified\n"); - exit(1); - } - - if (argc) { - copy_cmdline(argv[0]); - } else { - copy_cmdline(""); - } - - while(1) { - dump(); - step(); - } -} diff --git a/src/utils/fix-rom.c b/src/utils/fix-rom.c deleted file mode 100644 index d1099ed..0000000 --- a/src/utils/fix-rom.c +++ /dev/null @@ -1,37 +0,0 @@ -#include -#include -#include -#include -#include -#include - -struct stat sbuf; - -int main(int argc, char** argv) { - FILE* fd = fopen(argv[1], "r+"); - fstat(fileno(fd), &sbuf); - if (sbuf.st_size & 0x1F) { - fprintf(stderr, "Filesize is not a multiple of 512 bytes\n"); - exit(1); - } - - // Fill out filesize flag - fseek(fd, 2, SEEK_SET); - fputc(sbuf.st_size >> 9, fd); - - // Calculate checksum - fseek(fd, 0, SEEK_SET); - off_t i; - uint8_t s; - for (i=0; i