diff --git a/apps/zasm/const.asm b/apps/zasm/const.asm index e9d2fdd..d405473 100644 --- a/apps/zasm/const.asm +++ b/apps/zasm/const.asm @@ -1,24 +1,25 @@ ; *** Errors *** +; We start error at 0x10 to avoid overlapping with shell errors ; Unknown instruction or directive -.equ ERR_UNKNOWN 0x01 +.equ ERR_UNKNOWN 0x11 ; Bad argument: Doesn't match any constant argspec or, if an expression, ; contains references to undefined symbols. -.equ ERR_BAD_ARG 0x02 +.equ ERR_BAD_ARG 0x12 ; Code is badly formatted (comma without a following arg, unclosed quote, etc.) -.equ ERR_BAD_FMT 0x03 +.equ ERR_BAD_FMT 0x13 ; Value specified doesn't fit in its destination byte or word -.equ ERR_OVFL 0x04 +.equ ERR_OVFL 0x14 -.equ ERR_FILENOTFOUND 0x05 +.equ ERR_FILENOTFOUND 0x15 ; Duplicate symbol -.equ ERR_DUPSYM 0x06 +.equ ERR_DUPSYM 0x16 ; Out of memory -.equ ERR_OOM 0x07 +.equ ERR_OOM 0x17 ; *** Other *** .equ ZASM_DEBUG_PORT 42 diff --git a/apps/zasm/glue.asm b/apps/zasm/glue.asm index ca939bb..e095221 100644 --- a/apps/zasm/glue.asm +++ b/apps/zasm/glue.asm @@ -38,7 +38,12 @@ ; fsTell ; cpHLDE ; parseArgs +; _blkGetC +; _blkPutC +; _blkSeek +; _blkTell ; FS_HANDLE_SIZE +; BLOCKDEV_SIZE ; *** Variables *** diff --git a/apps/zasm/io.asm b/apps/zasm/io.asm index 27fe600..5be3b73 100644 --- a/apps/zasm/io.asm +++ b/apps/zasm/io.asm @@ -40,16 +40,10 @@ ; flag and continue on the general IN stream. ; *** Variables *** -.equ IO_IN_GETC IO_RAMSTART -.equ IO_IN_PUTC IO_IN_GETC+2 -.equ IO_IN_SEEK IO_IN_PUTC+2 -.equ IO_IN_TELL IO_IN_SEEK+2 -.equ IO_OUT_GETC IO_IN_TELL+2 -.equ IO_OUT_PUTC IO_OUT_GETC+2 -.equ IO_OUT_SEEK IO_OUT_PUTC+2 -.equ IO_OUT_TELL IO_OUT_SEEK+2 +.equ IO_IN_BLK IO_RAMSTART +.equ IO_OUT_BLK IO_IN_BLK+BLOCKDEV_SIZE ; Save pos for ioSavePos and ioRecallPos -.equ IO_SAVED_POS IO_OUT_TELL+2 +.equ IO_SAVED_POS IO_OUT_BLK+BLOCKDEV_SIZE ; File handle for included source .equ IO_INCLUDE_HDL IO_SAVED_POS+2 ; see ioPutBack below @@ -108,8 +102,8 @@ ioGetC: ; continue on to "normal" reading. We don't want to return our zero .normalmode: ; normal mode, read from IN stream - ld ix, (IO_IN_GETC) - call _callIX + ld ix, IO_IN_BLK + call _blkGetC cp 0x0a ; newline ret nz ; not newline? return ; inc current lineno @@ -132,7 +126,7 @@ _callIX: ret ; Put back non-zero character A into the "ioGetC stack". The next ioGetC call, -; instead of reading from IO_IN_GETC, will return that character. That's the +; instead of reading from IO_IN_BLK, will return that character. That's the ; easiest way I found to handle the readWord/gotoNextLine problem. ioPutBack: ld (IO_PUTBACK_BUF), a @@ -148,8 +142,8 @@ ioPutC: call zasmIsFirstPass jr z, .skip pop af - ld ix, (IO_OUT_PUTC) - jp (ix) + ld ix, IO_OUT_BLK + jp _blkPutC .skip: pop af ret @@ -184,8 +178,8 @@ _ioSeek: ld a, 0 ; don't alter flags jr nz, .include ; normal mode, seek in IN stream - ld ix, (IO_IN_SEEK) - jp (ix) + ld ix, IO_IN_BLK + jp _blkSeek .include: ; We're in "include mode", seek in FS ld ix, IO_INCLUDE_HDL @@ -195,8 +189,8 @@ _ioTell: call ioInInclude jp nz, .include ; normal mode, seek in IN stream - ld ix, (IO_IN_TELL) - jp (ix) + ld ix, IO_IN_BLK + jp _blkTell .include: ; We're in "include mode", tell from FS ld ix, IO_INCLUDE_HDL diff --git a/apps/zasm/main.asm b/apps/zasm/main.asm index 2f32cf0..d98aba5 100644 --- a/apps/zasm/main.asm +++ b/apps/zasm/main.asm @@ -38,10 +38,10 @@ zasmMain: ; HL now points to parsed args ; Init I/O ld a, (ZASM_RAMSTART) ; blkdev in ID - ld de, IO_IN_GETC + ld de, IO_IN_BLK call blkSel ld a, (ZASM_RAMSTART+1) ; blkdev out ID - ld de, IO_OUT_GETC + ld de, IO_OUT_BLK call blkSel ; Init modules diff --git a/kernel/blockdev.asm b/kernel/blockdev.asm index e278c9f..700d17f 100644 --- a/kernel/blockdev.asm +++ b/kernel/blockdev.asm @@ -6,39 +6,27 @@ ; then the glue code assigns a blockdev ID to that device. It then becomes easy ; to access arbitrary devices in a convenient manner. ; -; This part exposes a new "bsel" command to select the currently active block -; device. +; This module exposes a seek/tell/getc/putc API that is then re-routed to +; underlying drivers. There will eventually be more than one driver type, but +; for now we sit on only one type of driver: random access driver. ; -; *** Blockdev routines *** +; *** Random access drivers *** ; -; There are 4 blockdev routines that can be defined by would-be block devices -; and they follow these specifications: +; Random access drivers are expected to supply two routines: GetC and PutC. ; ; GetC: -; Reads one character from selected device and returns its value in A. +; Reads one character at address specified in DE/HL and returns its value in A. ; Sets Z according to whether read was successful: Set if successful, unset ; if not. ; -; A successful GetC should advance the "pointer" of the device (if there is one) -; by one byte so that a subsequent GetC will read the next char. Unsuccessful -; reads generally mean that we reached EOF. -; +; Unsuccessful reads generally mean that requested addr is out of bounds (we +; reached EOF). ; ; PutC: -; Writes character in A in current position in the selected device. Sets Z -; according to whether the operation was successful. +; Writes character in A at address specified in DE/HL. Sets Z according to +; whether the operation was successful. ; -; A successful PutC should advance the "pointer" of the device (if there is one) -; by one byte so that the next PutC places the next char next to this one. -; Unsuccessful writes generally mean that we reached EOF. -; -; Seek: -; Place device "pointer" at position dictated by HL (low 16 bits) and DE (high -; 16 bits). -; -; Tell: -; Return the position of the "pointer" in HL (low 16 bits) and DE (high 16 -; bits). +; Unsuccessful writes generally mean that we're out of bounds for writing. ; ; All routines are expected to preserve unused registers. @@ -47,20 +35,18 @@ ; BLOCKDEV_COUNT: The number of devices we manage. ; *** CONSTS *** -.equ BLOCKDEV_ERR_OUT_OF_BOUNDS 0x03 - .equ BLOCKDEV_SEEK_ABSOLUTE 0 .equ BLOCKDEV_SEEK_FORWARD 1 .equ BLOCKDEV_SEEK_BACKWARD 2 .equ BLOCKDEV_SEEK_BEGINNING 3 .equ BLOCKDEV_SEEK_END 4 +.equ BLOCKDEV_SIZE 8 ; *** VARIABLES *** ; Pointer to the selected block device. A block device is a 8 bytes block of -; memory with pointers to GetC, PutC, Seek and Tell routines, in that order. -; 0 means unsupported. +; memory with pointers to GetC, PutC, and a 32-bit counter, in that order. .equ BLOCKDEV_SEL BLOCKDEV_RAMSTART -.equ BLOCKDEV_RAMEND BLOCKDEV_SEL+8 +.equ BLOCKDEV_RAMEND BLOCKDEV_SEL+BLOCKDEV_SIZE ; *** CODE *** ; Select block index specified in A and place them in routine pointers at (DE). @@ -73,62 +59,94 @@ blkSel: ld hl, blkDevTbl or a ; cp 0 jr z, .afterloop ; index is zero? don't loop - push bc - ld b, a -.loop: - ld a, 8 - call addHL - djnz .loop - pop bc + push bc ; <| + ld b, a ; | +.loop: ; | + ld a, 4 ; | + call addHL ; | + djnz .loop ; | + pop bc ; <| .afterloop: - push hl - call intoHL - call writeHLinDE - inc de - inc de - pop hl - inc hl - inc hl - push hl - call intoHL - call writeHLinDE - inc de - inc de - pop hl - inc hl - inc hl - push hl - call intoHL - call writeHLinDE - inc de - inc de - pop hl + ; Write GETC + push hl ; <| + call intoHL ; | + call writeHLinDE ; | + inc de ; | + inc de ; | + pop hl ; <| inc hl inc hl + ; Write PUTC call intoHL call writeHLinDE + inc de + inc de + ; Initialize pos + xor a + ld (de), a + inc de + ld (de), a + inc de + ld (de), a + inc de + ld (de), a pop hl pop de pop af ret +_blkInc: + ret nz ; don't advance when in error condition + push af + push hl + ld a, BLOCKDEV_SEEK_FORWARD + ld hl, 1 + call _blkSeek + pop hl + pop af + ret + ; Reads one character from selected device and returns its value in A. ; Sets Z according to whether read was successful: Set if successful, unset ; if not. blkGetC: - ld ix, (BLOCKDEV_SEL) - jp (ix) + ld ix, BLOCKDEV_SEL +_blkGetC: + push hl + push de + call _blkTell + call callIXI + pop de + pop hl + jr _blkInc ; advance and return + +; Writes character in A in current position in the selected device. Sets Z +; according to whether the operation was successful. +blkPutC: + ld ix, BLOCKDEV_SEL +_blkPutC: + push ix + push hl + push de + call _blkTell + inc ix ; make IX point to PutC + inc ix + call callIXI + pop de + pop hl + pop ix + jr _blkInc ; advance and return ; Reads B chars from blkGetC and copy them in (HL). ; Sets Z if successful, unset Z if there was an error. blkRead: - ld ix, (BLOCKDEV_SEL) + ld ix, BLOCKDEV_SEL _blkRead: push hl push bc .loop: - call callIX + call _blkGetC jr nz, .end ; Z already unset ld (hl), a inc hl @@ -139,26 +157,16 @@ _blkRead: pop hl ret -; Writes character in A in current position in the selected device. Sets Z -; according to whether the operation was successful. -blkPutC: - ld ix, (BLOCKDEV_SEL+2) - jp (ix) - ; Writes B chars to blkPutC from (HL). ; Sets Z if successful, unset Z if there was an error. blkWrite: - ld ix, (BLOCKDEV_SEL) + ld ix, BLOCKDEV_SEL _blkWrite: - push ix push hl push bc - ; make IX point to PutC - inc ix - inc ix .loop: ld a, (hl) - call callIX + call _blkPutC jr nz, .end ; Z already unset inc hl djnz .loop @@ -166,7 +174,6 @@ _blkWrite: .end: pop bc pop hl - pop ix ret ; Seeks the block device in one of 5 modes, which is the A argument: @@ -186,12 +193,8 @@ _blkWrite: ; If the device is "growable", it's possible that seeking to end when calling ; PutC doesn't necessarily result in a failure. blkSeek: - ld ix, (BLOCKDEV_SEL+4) - ld iy, (BLOCKDEV_SEL+6) + ld ix, BLOCKDEV_SEL _blkSeek: - ; we preserve DE so that it's possible to call blkSeek in mode != 0 - ; while not discarding our current DE value. - push de cp BLOCKDEV_SEEK_FORWARD jr z, .forward cp BLOCKDEV_SEEK_BACKWARD @@ -201,43 +204,70 @@ _blkSeek: cp BLOCKDEV_SEEK_END jr z, .end ; all other modes are considered absolute - jr .seek ; for absolute mode, HL and DE are already - ; correct + ld (ix+4), e + ld (ix+5), d + ld (ix+6), l + ld (ix+7), h + ret .forward: - push bc - push hl - ; We want to be able to plug our own TELL function, which is why we - ; don't call blkTell directly here. - ; Calling TELL - ld de, 0 ; in case out Tell routine doesn't return DE - call callIY ; HL/DE now have our curpos - pop bc ; pop HL into BC - add hl, bc - pop bc ; pop orig BC back - jr nc, .seek ; no carry? let's seek. - ; carry, adjust DE - inc de - jr .seek + push bc ; <-| + push hl ; <|| + ld l, (ix+6) ; || low byte + ld h, (ix+7) ; || + pop bc ; <|| + add hl, bc ; | + pop bc ; <-| + ld (ix+6), l + ld (ix+7), h + ret nc ; no carry? no need to adjust high byte + ; carry, adjust high byte + inc (ix+4) + ret nz + inc (ix+5) + ret .backward: - ; TODO - subtraction are more complicated... - jr .seek + and a ; clear carry + push bc ; <-| + push hl ; <|| + ld l, (ix+6) ; || low byte + ld h, (ix+7) ; || + pop bc ; <|| + sbc hl, bc ; | + pop bc ; <-| + ld (ix+6), l + ld (ix+7), h + ret nc ; no carry? no need to adjust high byte + ld a, 0xff + dec (ix+4) + cp (ix+4) + ret nz + ; we decremented from 0 + dec (ix+5) + ret .beginning: - ld hl, 0 - ld de, 0 - jr .seek + xor a + ld (ix+4), a + ld (ix+5), a + ld (ix+6), a + ld (ix+7), a + ret .end: - ld hl, 0xffff - ld de, 0xffff -.seek: - call callIX - pop de + ld a, 0xff + ld (ix+4), a + ld (ix+5), a + ld (ix+6), a + ld (ix+7), a ret ; Returns the current position of the selected device in HL (low) and DE (high). blkTell: - ld de, 0 ; in case device ignores DE. - ld ix, (BLOCKDEV_SEL+6) - jp (ix) + ld ix, BLOCKDEV_SEL +_blkTell: + ld e, (ix+4) + ld d, (ix+5) + ld l, (ix+6) + ld h, (ix+7) + ret ; This label is at the end of the file on purpose: the glue file should include ; a list of device routine table entries just after the include. Each line diff --git a/kernel/core.asm b/kernel/core.asm index b82a421..e3e257b 100644 --- a/kernel/core.asm +++ b/kernel/core.asm @@ -47,6 +47,14 @@ intoHL: pop de ret +intoIX: + push de + push ix \ pop de + call intoDE + push de \ pop ix + pop de + ret + ; add the value of A into HL addHL: push af @@ -94,6 +102,15 @@ writeHLinDE: pop af ret +; Call the method (IX) is a pointer to. In other words, call intoIX before +; callIX +callIXI: + push ix + call intoIX + call callIX + pop ix + ret + ; jump to the location pointed to by IX. This allows us to call IX instead of ; just jumping it. We use IX because we seldom use this for arguments. callIX: diff --git a/kernel/err.h b/kernel/err.h index d8ce244..cd1816f 100644 --- a/kernel/err.h +++ b/kernel/err.h @@ -6,6 +6,9 @@ ; Arguments for the command weren't properly formatted .equ SHELL_ERR_BAD_ARGS 0x02 +.equ BLOCKDEV_ERR_OUT_OF_BOUNDS 0x03 +.equ BLOCKDEV_ERR_UNSUPPORTED 0x04 + ; IO routines (GetC, PutC) returned an error in a load/save command .equ SHELL_ERR_IO_ERROR 0x05 diff --git a/kernel/fs.asm b/kernel/fs.asm index 64269a9..8f722e9 100644 --- a/kernel/fs.asm +++ b/kernel/fs.asm @@ -93,23 +93,16 @@ .equ FS_ERR_NOT_FOUND 0x6 ; *** VARIABLES *** -; A copy of BLOCKDEV routines when the FS was mounted. 0 if no FS is mounted. -.equ FS_GETC FS_RAMSTART -.equ FS_PUTC FS_GETC+2 -.equ FS_SEEK FS_PUTC+2 -.equ FS_TELL FS_SEEK+2 +; A copy of BLOCKDEV_SEL when the FS was mounted. 0 if no FS is mounted. +.equ FS_BLK FS_RAMSTART ; Offset at which our FS start on mounted device ; This pointer is 32 bits. 32 bits pointers are a bit awkward: first two bytes ; are high bytes *low byte first*, and then the low two bytes, same order. ; When loaded in HL/DE, the four bytes are loaded in this order: E, D, L, H -.equ FS_START FS_TELL+2 -; Offset at which we are currently pointing to with regards to our routines -; below, which all assume this offset as a context. This offset is not relative -; to FS_START. It can be used directly with fsblkSeek. 32 bits. -.equ FS_PTR FS_START+4 -; This variable below contain the metadata of the last block FS_PTR was moved +.equ FS_START FS_BLK+BLOCKDEV_SIZE +; This variable below contain the metadata of the last block we moved ; to. We read this data in memory to avoid constant seek+read operations. -.equ FS_META FS_PTR+4 +.equ FS_META FS_START+4 .equ FS_HANDLES FS_META+FS_METASIZE .equ FS_RAMEND FS_HANDLES+FS_HANDLE_COUNT*FS_HANDLE_SIZE @@ -121,21 +114,27 @@ P_FS_MAGIC: fsInit: xor a - ld hl, FS_GETC - ld b, FS_RAMEND-FS_GETC + ld hl, FS_BLK + ld b, FS_RAMEND-FS_BLK call fill ret ; *** Navigation *** -; Resets FS_PTR to the beginning. Errors out if no FS is mounted. +; Seek to the beginning. Errors out if no FS is mounted. ; Sets Z if success, unset if error fsBegin: + call fsIsOn + ret nz push hl - ld hl, (FS_START) - ld (FS_PTR), hl + push de + push af + ld de, (FS_START) ld hl, (FS_START+2) - ld (FS_PTR+2), hl + ld a, BLOCKDEV_SEEK_ABSOLUTE + call fsblkSeek + pop af + pop de pop hl call fsReadMeta jp fsIsValid ; sets Z, returns @@ -147,25 +146,20 @@ fsNext: push bc push hl ld a, (FS_META+FS_META_ALLOC_OFFSET) - cp 0 + or a ; cp 0 jr z, .error ; if our block allocates 0 blocks, this is the ; end of the line. - call fsPlace ld b, a ; we will seek A times .loop: ld a, BLOCKDEV_SEEK_FORWARD ld hl, FS_BLOCKSIZE call fsblkSeek djnz .loop - ; Good, were here. We're going to read meta from our current position. - call fsblkTell ; --> HL, --> DE - ld (FS_PTR), de - ld (FS_PTR+2), hl call fsReadMeta jr nz, .createChainEnd call fsIsValid jr nz, .createChainEnd - ; We're good! We have a valid FS block and FS_PTR is already updated. + ; We're good! We have a valid FS block. ; Meta is already read. Nothing to do! cp a ; ensure Z jr .end @@ -183,10 +177,9 @@ fsNext: pop bc ret -; Reads metadata at current FS_PTR and place it in FS_META. -; Returns Z according to whether the fsblkRead operation succeeded. +; Reads metadata at current fsblk and place it in FS_META. +; Returns Z according to whether the operation succeeded. fsReadMeta: - call fsPlace push bc push hl ld b, FS_METASIZE @@ -194,12 +187,13 @@ fsReadMeta: call fsblkRead ; Sets Z pop hl pop bc - ret + ret nz + ; Only rewind on success + jr _fsRewindAfterMeta -; Writes metadata in FS_META at current FS_PTR. +; Writes metadata in FS_META at current fsblk. ; Returns Z according to whether the fsblkWrite operation succeeded. fsWriteMeta: - call fsPlace push bc push hl ld b, FS_METASIZE @@ -207,6 +201,19 @@ fsWriteMeta: call fsblkWrite ; Sets Z pop hl pop bc + ret nz + ; Only rewind on success + jr _fsRewindAfterMeta + +_fsRewindAfterMeta: + ; return back to before the read op + push af + push hl + ld a, BLOCKDEV_SEEK_BACKWARD + ld hl, FS_METASIZE + call fsblkSeek + pop hl + pop af ret ; Initializes FS_META with "CFS" followed by zeroes @@ -229,20 +236,6 @@ fsInitMeta: pop af ret -; Make sure that our underlying blockdev is correctly placed. -fsPlace: - push af - push hl - push de - xor a - ld de, (FS_PTR) - ld hl, (FS_PTR+2) - call fsblkSeek - pop de - pop hl - pop af - ret - ; Create a new file with A blocks allocated to it and with its new name at ; (HL). ; Before doing so, enumerate all blocks in search of a deleted file with @@ -250,7 +243,7 @@ fsPlace: ; if the allocated space asked is exactly the same, or of it isn't, split the ; free space in 2 and create a new deleted metadata block next to the newly ; created block. -; Places FS_PTR to the newly allocated block. You have to write the new +; Places fsblk to the newly allocated block. You have to write the new ; filename yourself. fsAlloc: push bc @@ -272,8 +265,6 @@ fsAlloc: ; TODO: handle case where C < A (block splitting) jr .loop1 .found: - call fsPlace ; Make sure that our block device points to - ; the beginning of our FS block ; We've reached last block. Two situations are possible at this point: ; 1 - the block is the "end of line" block ; 2 - the block is a deleted block that we we're re-using. @@ -287,11 +278,7 @@ fsAlloc: ld de, FS_META+FS_META_FNAME_OFFSET ld bc, FS_MAX_NAME_SIZE ldir - ; Good, FS_META ready. Now, let's update FS_PTR because it hasn't been - ; changed yet. - call fsblkTell - ld (FS_PTR), de - ld (FS_PTR+2), hl + ; Good, FS_META ready. ; Ok, now we can write our metadata call fsWriteMeta .end: @@ -299,7 +286,7 @@ fsAlloc: pop bc ret -; Place FS_PTR to the filename with the name in (HL). +; Place fsblk to the filename with the name in (HL). ; Sets Z on success, unset when not found. fsFindFN: push de @@ -348,47 +335,43 @@ fsIsDeleted: fsblkGetC: push ix - ld ix, (FS_GETC) - call callIX + ld ix, FS_BLK + call _blkGetC pop ix ret fsblkRead: push ix - ld ix, (FS_GETC) + ld ix, FS_BLK call _blkRead pop ix ret fsblkPutC: push ix - ld ix, (FS_PUTC) - call callIX + ld ix, FS_BLK + call _blkPutC pop ix ret fsblkWrite: push ix - ld ix, (FS_GETC) ; we have to point to blkdev's beginning + ld ix, FS_BLK call _blkWrite pop ix ret fsblkSeek: push ix - push iy - ld ix, (FS_SEEK) - ld iy, (FS_TELL) + ld ix, FS_BLK call _blkSeek - pop iy pop ix ret fsblkTell: push ix - ld de, 0 - ld ix, (FS_TELL) - call callIX + ld ix, FS_BLK + call _blkTell pop ix ret @@ -399,13 +382,13 @@ fsOpen: push hl push af ; Starting pos - ld a, (FS_PTR) + ld a, (FS_BLK+4) ld (ix), a - ld a, (FS_PTR+1) + ld a, (FS_BLK+5) ld (ix+1), a - ld a, (FS_PTR+2) + ld a, (FS_BLK+6) ld (ix+2), a - ld a, (FS_PTR+3) + ld a, (FS_BLK+7) ld (ix+3), a ; Current pos ld hl, FS_METASIZE @@ -516,7 +499,7 @@ fsTell: ; Mount the fs subsystem upon the currently selected blockdev at current offset. ; Verify is block is valid and error out if its not, mounting nothing. -; Upon mounting, copy currently selected device in FS_GETC/PUTC/SEEK/TELL. +; Upon mounting, copy currently selected device in FS_BLK. fsOn: push hl push de @@ -524,14 +507,12 @@ fsOn: ; We have to set blkdev routines early before knowing whether the ; mounting succeeds because methods like fsReadMeta uses fsblk* methods. ld hl, BLOCKDEV_SEL - ld de, FS_GETC - ld bc, 8 ; we have 8 bytes to copy + ld de, FS_BLK + ld bc, BLOCKDEV_SIZE ldir ; copy! call fsblkTell ld (FS_START), de ld (FS_START+2), hl - ld (FS_PTR), de - ld (FS_PTR+2), hl call fsReadMeta jr nz, .error call fsIsValid @@ -542,8 +523,8 @@ fsOn: .error: ; couldn't mount. Let's reset our variables. xor a - ld b, FS_META-FS_GETC ; reset routine pointers and FS ptrs - ld hl, FS_GETC + ld b, FS_META-FS_BLK ; reset routine pointers and FS ptrs + ld hl, FS_BLK call fill ld a, FS_ERR_NO_FS @@ -555,10 +536,10 @@ fsOn: ; Sets Z according to whether we have a filesystem mounted. fsIsOn: - ; check whether (FS_GETC) is zero + ; check whether (FS_BLK) is zero push hl push de - ld hl, (FS_GETC) + ld hl, (FS_BLK) ld de, 0 call cpHLDE jr nz, .mounted diff --git a/kernel/fs_cmds.asm b/kernel/fs_cmds.asm index a3c025f..0eb3840 100644 --- a/kernel/fs_cmds.asm +++ b/kernel/fs_cmds.asm @@ -6,6 +6,8 @@ fsOnCmd: ; Lists filenames in currently active FS flsCmd: .db "fls", 0, 0, 0, 0 + call fsIsOn + jr nz, .error call fsBegin jr nz, .error .loop: diff --git a/kernel/mmap.asm b/kernel/mmap.asm index fd2d776..9669ce9 100644 --- a/kernel/mmap.asm +++ b/kernel/mmap.asm @@ -5,29 +5,9 @@ ; *** DEFINES *** ; MMAP_START: Memory address where the mmap begins -; *** VARIABLES *** -.equ MMAP_PTR MMAP_RAMSTART -.equ MMAP_RAMEND MMAP_PTR+2 - -; *** CODE *** - -mmapInit: - xor a - ld (MMAP_PTR), a - ld (MMAP_PTR+1), a - ret - -; Increase mem pointer by one -_mmapForward: - ld hl, (MMAP_PTR) - inc hl - ld (MMAP_PTR), hl - ret - ; Returns absolute addr of memory pointer in HL. _mmapAddr: push de - ld hl, (MMAP_PTR) ld de, MMAP_START add hl, de jr nc, .end @@ -43,7 +23,6 @@ mmapGetC: push hl call _mmapAddr ld a, (hl) - call _mmapForward cp a ; ensure Z pop hl ret @@ -52,16 +31,6 @@ mmapPutC: push hl call _mmapAddr ld (hl), a - call _mmapForward cp a ; ensure Z pop hl ret - -mmapSeek: - ld (MMAP_PTR), hl - ret - -mmapTell: - ld hl, (MMAP_PTR) - ret - diff --git a/kernel/sdc.asm b/kernel/sdc.asm index 3f54ac6..e63b88c 100644 --- a/kernel/sdc.asm +++ b/kernel/sdc.asm @@ -25,12 +25,9 @@ .equ SDC_BLKSIZE 512 ; *** Variables *** -; Where the block dev current points to. This is a byte index. Higher 7 bits -; indicate a sector number, lower 9 bits are an offset in the current SDC_BUF. -.equ SDC_PTR SDC_RAMSTART ; Whenever we read a sector, we read a whole block at once and we store it ; in memory. That's where it goes. -.equ SDC_BUF SDC_PTR+2 +.equ SDC_BUF SDC_RAMSTART ; Sector number currently in SDC_BUF. 0xff, it's initial value, means "no ; sector. .equ SDC_BUFSEC SDC_BUF+SDC_BLKSIZE @@ -221,8 +218,6 @@ sdcInitialize: jr nz, .error ; Success! out of idle mode! ; initialize variables - ld hl, 0 - ld (SDC_PTR), hl ld a, 0xff ld (SDC_BUFSEC), a xor a @@ -378,24 +373,24 @@ sdcWriteBlk: pop bc ret -; Ensures that (SDC_BUFSEC) is in sync with (SDC_PTR), that is, that the current -; buffer in memory corresponds to where SDC_PTR points to. If it doesn't, loads -; the sector that (SDC_PTR) points to in (SDC_BUF) and update (SDC_BUFSEC). +; Ensures that (SDC_BUFSEC) is in sync with HL, that is, that the current +; buffer in memory corresponds to where HL points to. If it doesn't, loads +; the sector that HL points to in (SDC_BUF) and update (SDC_BUFSEC). ; If the (SDC_BUFDIRTY) flag is set, we write the content of the in-memory ; buffer to the SD card before we read a new sector. ; Returns Z on success, not-Z on error (with the error code from either ; sdcReadBlk or sdcWriteBlk) sdcSync: - ; SDC_PTR points to the character we're supposed to read or right now, + ; HL points to the character we're supposed to read or right now, ; but we first have to check whether we need to load a new sector in - ; memory. To do this, we compare the high 7 bits of (SDC_PTR) with + ; memory. To do this, we compare the high 7 bits of HL with ; (SDC_BUFSEC). If they're different, we need to load a new block. push hl ld a, (SDC_BUFSEC) - ld h, a - ld a, (SDC_PTR+1) ; high byte has bufsec in its high 7 bits + ld l, a + ld a, h srl a - cp h + cp l pop hl ret z ; equal? nothing to do ; We have to read a new sector, but first, let's write the current one @@ -403,7 +398,7 @@ sdcSync: call sdcWriteBlk ret nz ; error ; Let's read our new sector - ld a, (SDC_PTR+1) + ld a, h srl a jp sdcReadBlk ; returns @@ -422,12 +417,15 @@ sdcFlushCmd: ; *** blkdev routines *** -; Make HL point to (SDC_PTR) in current buffer +; Make HL point to its proper place in SDC_BUF. +; HL currently is an offset to read in the SD card. Load the proper sector in +; memory and make HL point to the correct data in the memory buffer. _sdcPlaceBuf: call sdcSync ret nz ; error - ld a, (SDC_PTR+1) ; high byte + ld a, h ; high byte and 0x01 ; is first bit set? + ld a, l ; doesn't change flags jr nz, .highbuf ; first bit set? we're in the "highbuf" zone. ; lowbuf zone ; Read byte from memory at proper offset in lowbuf (first 0x100 bytes) @@ -438,10 +436,9 @@ _sdcPlaceBuf: ld hl, SDC_BUF+0x100 .read: ; HL is now placed either on the lower or higher half of SDC_BUF and - ; all we need is to increase HL by the number in SDC_PTR's LSB (little - ; endian, remember). - ld a, (SDC_PTR) ; LSB - call addHL ; returns + ; all we need is to increase HL by the number in A which is the lower + ; half of our former HL value. + call addHL xor a ; ensure Z ret @@ -452,12 +449,6 @@ sdcGetC: ; This is it! ld a, (hl) - - ; before we return A, we need to increase (SDC_PTR) - ld hl, (SDC_PTR) - inc hl - ld (SDC_PTR), hl - cp a ; ensure Z jr .end .error: @@ -477,12 +468,6 @@ sdcPutC: pop af ld (hl), a - - ; we need to increase (SDC_PTR) - ld hl, (SDC_PTR) - inc hl - ld (SDC_PTR), hl - ld a, 1 ld (SDC_BUFDIRTY), a xor a ; ensure Z @@ -493,12 +478,3 @@ sdcPutC: .end: pop hl ret - -sdcSeek: - ld (SDC_PTR), hl - ret - -sdcTell: - ld hl, (SDC_PTR) - ret - diff --git a/recipes/rc2014/sdcard/glue.asm b/recipes/rc2014/sdcard/glue.asm index db034cc..f290829 100644 --- a/recipes/rc2014/sdcard/glue.asm +++ b/recipes/rc2014/sdcard/glue.asm @@ -29,10 +29,9 @@ jp aciaInt .equ BLOCKDEV_COUNT 2 #include "blockdev.asm" ; List of devices -.dw sdcGetC, sdcPutC, sdcSeek, sdcTell -.dw blk2GetC, blk2PutC, blk2Seek, blk2Tell +.dw sdcGetC, sdcPutC +.dw blk2GetC, blk2PutC -#include "blockdev_cmds.asm" .equ STDIO_RAMSTART BLOCKDEV_RAMEND #include "stdio.asm" @@ -40,7 +39,6 @@ jp aciaInt .equ FS_RAMSTART STDIO_RAMEND .equ FS_HANDLE_COUNT 1 #include "fs.asm" -#include "fs_cmds.asm" .equ SHELL_RAMSTART FS_RAMEND .equ SHELL_EXTRA_CMD_COUNT 11 @@ -49,9 +47,13 @@ jp aciaInt .dw blkBselCmd, blkSeekCmd, blkLoadCmd, blkSaveCmd .dw fsOnCmd, flsCmd, fnewCmd, fdelCmd, fopnCmd +#include "blockdev_cmds.asm" +#include "fs_cmds.asm" + +.equ PGM_RAMSTART SHELL_RAMEND #include "pgm.asm" -.equ SDC_RAMSTART SHELL_RAMEND +.equ SDC_RAMSTART PGM_RAMEND .equ SDC_PORT_CSHIGH 6 .equ SDC_PORT_CSLOW 5 .equ SDC_PORT_SPI 4 @@ -87,11 +89,3 @@ blk2GetC: blk2PutC: ld ix, FS_HANDLES jp fsPutC - -blk2Seek: - ld ix, FS_HANDLES - jp fsSeek - -blk2Tell: - ld ix, FS_HANDLES - jp fsTell diff --git a/recipes/rc2014/zasm/cfsin/user.h b/recipes/rc2014/zasm/cfsin/user.h index e4989e8..b120a87 100644 --- a/recipes/rc2014/zasm/cfsin/user.h +++ b/recipes/rc2014/zasm/cfsin/user.h @@ -1,6 +1,7 @@ .equ USER_CODE 0x8600 .equ USER_RAMSTART USER_CODE+0x1800 .equ FS_HANDLE_SIZE 8 +.equ BLOCKDEV_SIZE 8 ; *** JUMP TABLE *** .equ strncmp 0x03 @@ -24,3 +25,7 @@ .equ cpHLDE 0x3b .equ parseArgs 0x3e .equ printstr 0x41 +.equ _blkGetC 0x44 +.equ _blkPutC 0x47 +.equ _blkSeek 0x4a +.equ _blkTell 0x4d diff --git a/recipes/rc2014/zasm/glue.asm b/recipes/rc2014/zasm/glue.asm index d3ac9e3..8066541 100644 --- a/recipes/rc2014/zasm/glue.asm +++ b/recipes/rc2014/zasm/glue.asm @@ -37,6 +37,10 @@ jp aciaInt jp cpHLDE jp parseArgs jp printstr + jp _blkGetC + jp _blkPutC + jp _blkSeek + jp _blkTell #include "err.h" #include "core.asm" @@ -47,23 +51,20 @@ jp aciaInt .equ BLOCKDEV_COUNT 3 #include "blockdev.asm" ; List of devices -.dw sdcGetC, sdcPutC, sdcSeek, sdcTell -.dw mmapGetC, mmapPutC, mmapSeek, mmapTell -.dw blk2GetC, blk2PutC, blk2Seek, blk2Tell +.dw sdcGetC, sdcPutC +.dw mmapGetC, mmapPutC +.dw blk2GetC, blk2PutC -#include "blockdev_cmds.asm" -.equ MMAP_RAMSTART BLOCKDEV_RAMEND .equ MMAP_START 0xe000 #include "mmap.asm" -.equ STDIO_RAMSTART MMAP_RAMEND +.equ STDIO_RAMSTART BLOCKDEV_RAMEND #include "stdio.asm" .equ FS_RAMSTART STDIO_RAMEND .equ FS_HANDLE_COUNT 1 #include "fs.asm" -#include "fs_cmds.asm" .equ SHELL_RAMSTART FS_RAMEND .equ SHELL_EXTRA_CMD_COUNT 11 @@ -72,6 +73,9 @@ jp aciaInt .dw blkBselCmd, blkSeekCmd, blkLoadCmd, blkSaveCmd .dw fsOnCmd, flsCmd, fnewCmd, fdelCmd, fopnCmd +#include "fs_cmds.asm" +#include "blockdev_cmds.asm" + .equ PGM_RAMSTART SHELL_RAMEND #include "pgm.asm" @@ -93,7 +97,6 @@ init: ld hl, aciaGetC ld de, aciaPutC call stdioInit - call mmapInit call shellInit ld hl, pgmShellHook ld (SHELL_CMDHOOK), hl @@ -114,11 +117,3 @@ blk2GetC: blk2PutC: ld ix, FS_HANDLES jp fsPutC - -blk2Seek: - ld ix, FS_HANDLES - jp fsSeek - -blk2Tell: - ld ix, FS_HANDLES - jp fsTell diff --git a/recipes/rc2014/zasm/user.h b/recipes/rc2014/zasm/user.h index e4989e8..b120a87 100644 --- a/recipes/rc2014/zasm/user.h +++ b/recipes/rc2014/zasm/user.h @@ -1,6 +1,7 @@ .equ USER_CODE 0x8600 .equ USER_RAMSTART USER_CODE+0x1800 .equ FS_HANDLE_SIZE 8 +.equ BLOCKDEV_SIZE 8 ; *** JUMP TABLE *** .equ strncmp 0x03 @@ -24,3 +25,7 @@ .equ cpHLDE 0x3b .equ parseArgs 0x3e .equ printstr 0x41 +.equ _blkGetC 0x44 +.equ _blkPutC 0x47 +.equ _blkSeek 0x4a +.equ _blkTell 0x4d diff --git a/tools/emul/shell/shell.c b/tools/emul/shell/shell.c index c8b1a4b..301454c 100644 --- a/tools/emul/shell/shell.c +++ b/tools/emul/shell/shell.c @@ -19,10 +19,8 @@ * I/O Ports: * * 0 - stdin / stdout - * 1 - Filesystem blockdev data read/write. Reading and writing to it advances - * the pointer. - * 2 - Filesystem blockdev seek / tell. Low byte - * 3 - Filesystem blockdev seek / tell. High byte + * 1 - Filesystem blockdev data read/write. Reads and write data to the address + * previously selected through port 2 */ //#define DEBUG @@ -32,15 +30,20 @@ #define RAMSTART 0x4000 #define STDIO_PORT 0x00 #define FS_DATA_PORT 0x01 -#define FS_SEEKL_PORT 0x02 -#define FS_SEEKH_PORT 0x03 -#define FS_SEEKE_PORT 0x04 +// Controls what address (24bit) the data port returns. To select an address, +// this port has to be written to 3 times, starting with the MSB. +// Reading this port returns an out-of-bounds indicator. 0 means addr is within +// bounds, non zero means either that we're in the middle of an addr-setting +// operation or that the address is not within bounds. +#define FS_ADDR_PORT 0x02 static Z80Context cpu; static uint8_t mem[0xffff] = {0}; static uint8_t fsdev[MAX_FSDEV_SIZE] = {0}; static uint32_t fsdev_size = 0; static uint32_t fsdev_ptr = 0; +// 0 = idle, 1 = received MSB (of 24bit addr), 2 = received middle addr +static int fsdev_addr_lvl = 0; static int running; static uint8_t io_read(int unused, uint16_t addr) @@ -53,11 +56,15 @@ static uint8_t io_read(int unused, uint16_t addr) } return c; } else if (addr == FS_DATA_PORT) { + if (fsdev_addr_lvl != 0) { + fprintf(stderr, "Reading FSDEV in the middle of an addr op (%d)\n", fsdev_ptr); + return 0; + } if (fsdev_ptr < fsdev_size) { #ifdef DEBUG fprintf(stderr, "Reading FSDEV at offset %d\n", fsdev_ptr); #endif - return fsdev[fsdev_ptr++]; + return fsdev[fsdev_ptr]; } else { // don't warn when ==, we're not out of bounds, just at the edge. if (fsdev_ptr > fsdev_size) { @@ -65,12 +72,14 @@ static uint8_t io_read(int unused, uint16_t addr) } return 0; } - } else if (addr == FS_SEEKL_PORT) { - return fsdev_ptr & 0xff; - } else if (addr == FS_SEEKH_PORT) { - return (fsdev_ptr >> 8) & 0xff; - } else if (addr == FS_SEEKE_PORT) { - return (fsdev_ptr >> 16) & 0xff; + } else if (addr == FS_ADDR_PORT) { + if (fsdev_addr_lvl != 0) { + return fsdev_addr_lvl; + } else if (fsdev_ptr >= fsdev_size) { + return 1; + } else { + return 0; + } } else { fprintf(stderr, "Out of bounds I/O read: %d\n", addr); return 0; @@ -87,23 +96,30 @@ static void io_write(int unused, uint16_t addr, uint8_t val) putchar(val); } } else if (addr == FS_DATA_PORT) { + if (fsdev_addr_lvl != 0) { + fprintf(stderr, "Writing to FSDEV in the middle of an addr op (%d)\n", fsdev_ptr); + return; + } if (fsdev_ptr < fsdev_size) { - fsdev[fsdev_ptr++] = val; + fsdev[fsdev_ptr] = val; } else if ((fsdev_ptr == fsdev_size) && (fsdev_ptr < MAX_FSDEV_SIZE)) { // We're at the end of fsdev, grow it - fsdev[fsdev_ptr++] = val; + fsdev[fsdev_ptr] = val; fsdev_size++; } else { fprintf(stderr, "Out of bounds FSDEV write at %d\n", fsdev_ptr); } - } else if (addr == FS_SEEKL_PORT) { - fsdev_ptr = (fsdev_ptr & 0xffff00) | val; - } else if (addr == FS_SEEKH_PORT) { - fsdev_ptr = (fsdev_ptr & 0xff00ff) | (val << 8); - } else if (addr == FS_SEEKE_PORT) { - fsdev_ptr = (fsdev_ptr & 0x00ffff) | (val << 16); - } else { - fprintf(stderr, "Out of bounds I/O write: %d / %d (0x%x)\n", addr, val, val); + } else if (addr == FS_ADDR_PORT) { + if (fsdev_addr_lvl == 0) { + fsdev_ptr = val << 16; + fsdev_addr_lvl = 1; + } else if (fsdev_addr_lvl == 1) { + fsdev_ptr |= val << 8; + fsdev_addr_lvl = 2; + } else { + fsdev_ptr |= val; + fsdev_addr_lvl = 0; + } } } diff --git a/tools/emul/shell/shell_.asm b/tools/emul/shell/shell_.asm index cab0228..305f973 100644 --- a/tools/emul/shell/shell_.asm +++ b/tools/emul/shell/shell_.asm @@ -6,9 +6,7 @@ .equ USERCODE KERNEL_RAMEND .equ STDIO_PORT 0x00 .equ FS_DATA_PORT 0x01 -.equ FS_SEEKL_PORT 0x02 -.equ FS_SEEKH_PORT 0x03 -.equ FS_SEEKE_PORT 0x04 +.equ FS_ADDR_PORT 0x02 jp init @@ -33,6 +31,10 @@ jp cpHLDE jp parseArgs jp printstr + jp _blkGetC + jp _blkPutC + jp _blkSeek + jp _blkTell #include "core.asm" #include "err.h" @@ -42,17 +44,16 @@ .equ BLOCKDEV_COUNT 4 #include "blockdev.asm" ; List of devices -.dw fsdevGetC, fsdevPutC, fsdevSeek, fsdevTell -.dw stdoutGetC, stdoutPutC, stdoutSeek, stdoutTell -.dw stdinGetC, stdinPutC, stdinSeek, stdinTell -.dw mmapGetC, mmapPutC, mmapSeek, mmapTell +.dw fsdevGetC, fsdevPutC +.dw stdoutGetC, stdoutPutC +.dw stdinGetC, stdinPutC +.dw mmapGetC, mmapPutC -.equ MMAP_RAMSTART BLOCKDEV_RAMEND .equ MMAP_START 0xe000 #include "mmap.asm" -.equ STDIO_RAMSTART MMAP_RAMEND +.equ STDIO_RAMSTART BLOCKDEV_RAMEND #include "stdio.asm" .equ FS_RAMSTART STDIO_RAMEND @@ -82,7 +83,6 @@ init: ld hl, emulGetC ld de, emulPutC call stdioInit - call mmapInit call fsInit ld a, 0 ; select fsdev ld de, BLOCKDEV_SEL @@ -104,35 +104,36 @@ emulPutC: ret fsdevGetC: + ld a, e + out (FS_ADDR_PORT), a + ld a, h + out (FS_ADDR_PORT), a + ld a, l + out (FS_ADDR_PORT), a + in a, (FS_ADDR_PORT) + or a + ret nz in a, (FS_DATA_PORT) cp a ; ensure Z ret fsdevPutC: + push af + ld a, e + out (FS_ADDR_PORT), a + ld a, h + out (FS_ADDR_PORT), a + ld a, l + out (FS_ADDR_PORT), a + in a, (FS_ADDR_PORT) + or a + jr nz, .error + pop af out (FS_DATA_PORT), a ret - -fsdevSeek: - push af - ld a, l - out (FS_SEEKL_PORT), a - ld a, h - out (FS_SEEKH_PORT), a - ld a, e - out (FS_SEEKE_PORT), a +.error: pop af - ret - -fsdevTell: - push af - in a, (FS_SEEKL_PORT) - ld l, a - in a, (FS_SEEKH_PORT) - ld h, a - in a, (FS_SEEKE_PORT) - ld e, a - pop af - ret + jp unsetZ ; returns .equ STDOUT_HANDLE FS_HANDLES @@ -144,14 +145,6 @@ stdoutPutC: ld ix, STDOUT_HANDLE jp fsPutC -stdoutSeek: - ld ix, STDOUT_HANDLE - jp fsSeek - -stdoutTell: - ld ix, STDOUT_HANDLE - jp fsTell - .equ STDIN_HANDLE FS_HANDLES+FS_HANDLE_SIZE stdinGetC: @@ -162,11 +155,3 @@ stdinPutC: ld ix, STDIN_HANDLE jp fsPutC -stdinSeek: - ld ix, STDIN_HANDLE - jp fsSeek - -stdinTell: - ld ix, STDIN_HANDLE - jp fsTell - diff --git a/tools/emul/shell/user.h b/tools/emul/shell/user.h index 14e388a..bebd1f2 100644 --- a/tools/emul/shell/user.h +++ b/tools/emul/shell/user.h @@ -1,6 +1,7 @@ .equ USER_CODE 0x4200 .equ USER_RAMSTART USER_CODE+0x1800 .equ FS_HANDLE_SIZE 8 +.equ BLOCKDEV_SIZE 8 ; *** JUMP TABLE *** .equ strncmp 0x03 @@ -23,3 +24,7 @@ .equ cpHLDE 0x36 .equ parseArgs 0x39 .equ printstr 0x3c +.equ _blkGetC 0x3f +.equ _blkPutC 0x42 +.equ _blkSeek 0x45 +.equ _blkTell 0x48 diff --git a/tools/emul/zasm/glue.asm b/tools/emul/zasm/glue.asm index 111e9d0..f33934d 100644 --- a/tools/emul/zasm/glue.asm +++ b/tools/emul/zasm/glue.asm @@ -28,6 +28,10 @@ jp fsSeek jp fsTell jp cpHLDE jp parseArgs +jp _blkGetC +jp _blkPutC +jp _blkSeek +jp _blkTell #include "core.asm" #include "err.h" @@ -36,9 +40,9 @@ jp parseArgs .equ BLOCKDEV_COUNT 3 #include "blockdev.asm" ; List of devices -.dw emulGetC, 0, emulSeek, emulTell -.dw 0, emulPutC, 0, 0 -.dw fsdevGetC, fsdevPutC, fsdevSeek, fsdevTell +.dw emulGetC, unsetZ +.dw unsetZ, emulPutC +.dw fsdevGetC, fsdevPutC .equ FS_RAMSTART BLOCKDEV_RAMEND .equ FS_HANDLE_COUNT 0 @@ -62,6 +66,12 @@ init: ; *** I/O *** emulGetC: + ; the STDIN_SEEK port works by poking it twice. First poke is for high + ; byte, second poke is for low one. + ld a, h + out (STDIN_SEEK), a + ld a, l + out (STDIN_SEEK), a in a, (STDIO_PORT) or a ; cp 0 jr z, .eof @@ -75,33 +85,21 @@ emulPutC: out (STDIO_PORT), a ret -emulSeek: - ; the STDIN_SEEK port works by poking it twice. First poke is for high - ; byte, second poke is for low one. - ld a, h - out (STDIN_SEEK), a - ld a, l - out (STDIN_SEEK), a - ret - -emulTell: - ; same principle as STDIN_SEEK - in a, (STDIN_SEEK) - ld h, a - in a, (STDIN_SEEK) - ld l, a - ret - fsdevGetC: + ld a, e + out (FS_SEEK_PORT), a + ld a, h + out (FS_SEEK_PORT), a + ld a, l + out (FS_SEEK_PORT), a + in a, (FS_SEEK_PORT) + or a + ret nz in a, (FS_DATA_PORT) cp a ; ensure Z ret fsdevPutC: - out (FS_DATA_PORT), a - ret - -fsdevSeek: push af ld a, e out (FS_SEEK_PORT), a @@ -109,17 +107,13 @@ fsdevSeek: out (FS_SEEK_PORT), a ld a, l out (FS_SEEK_PORT), a + in a, (FS_SEEK_PORT) + or a + jr nz, .error pop af + out (FS_DATA_PORT), a ret - -fsdevTell: - push af - in a, (FS_SEEK_PORT) - ld e, a - in a, (FS_SEEK_PORT) - ld h, a - in a, (FS_SEEK_PORT) - ld l, a +.error: pop af - ret + jp unsetZ ; returns diff --git a/tools/emul/zasm/user.h b/tools/emul/zasm/user.h index 14126f6..cb720bb 100644 --- a/tools/emul/zasm/user.h +++ b/tools/emul/zasm/user.h @@ -1,6 +1,7 @@ .equ USER_CODE 0x4800 .equ USER_RAMSTART 0x6000 .equ FS_HANDLE_SIZE 8 +.equ BLOCKDEV_SIZE 8 ; *** JUMP TABLE *** .equ strncmp 0x03 @@ -22,3 +23,7 @@ .equ fsTell 0x33 .equ cpHLDE 0x36 .equ parseArgs 0x39 +.equ _blkGetC 0x3c +.equ _blkPutC 0x3f +.equ _blkSeek 0x42 +.equ _blkTell 0x45 diff --git a/tools/emul/zasm/zasm.c b/tools/emul/zasm/zasm.c index bf6add6..b44ca24 100644 --- a/tools/emul/zasm/zasm.c +++ b/tools/emul/zasm/zasm.c @@ -81,18 +81,12 @@ static uint8_t io_read(int unused, uint16_t addr) return 0; } } else if (addr == FS_SEEK_PORT) { - if (fsdev_seek_tell_cnt == 0) { -#ifdef DEBUG - fprintf(stderr, "FS tell %d\n", fsdev_ptr); -#endif - fsdev_seek_tell_cnt = 1; - return fsdev_ptr >> 16; - } else if (fsdev_seek_tell_cnt == 1) { - fsdev_seek_tell_cnt = 2; - return (fsdev_ptr >> 8) & 0xff; + if (fsdev_seek_tell_cnt != 0) { + return fsdev_seek_tell_cnt; + } else if (fsdev_ptr >= fsdev_size) { + return 1; } else { - fsdev_seek_tell_cnt = 0; - return fsdev_ptr & 0xff; + return 0; } } else { fprintf(stderr, "Out of bounds I/O read: %d\n", addr); diff --git a/tools/tests/unit/test_core.asm b/tools/tests/unit/test_core.asm index 9724853..aea98ff 100644 --- a/tools/tests/unit/test_core.asm +++ b/tools/tests/unit/test_core.asm @@ -8,6 +8,28 @@ test: ld hl, 0xffff ld sp, hl + ; *** Just little z80 flags memo. + and a ; clear carry + ld hl, 100 + ld de, 101 + sbc hl, de + jp nc, fail ; carry is set + call nexttest + + and a ; clear carry + ld hl, 101 + ld de, 100 + sbc hl, de + jp c, fail ; carry is reset + call nexttest + + ld a, 1 + dec a + jp m, fail ; positive + dec a + jp p, fail ; negative + call nexttest + ; *** subHL *** ld hl, 0x123 ld a, 0x25 diff --git a/tools/tests/zasm/errtests.sh b/tools/tests/zasm/errtests.sh index 89ad1fa..70a6a90 100755 --- a/tools/tests/zasm/errtests.sh +++ b/tools/tests/zasm/errtests.sh @@ -26,34 +26,34 @@ chkoom() { done ${ZASM} <<< "$s" > /dev/null local res=$? - if [[ $res == 7 ]]; then + if [[ $res == 23 ]]; then echo "Good!" else - echo "$res != 7" + echo "$res != 23" exit 1 fi } -chkerr "foo" 1 -chkerr "ld a, foo" 2 -chkerr "ld a, hl" 2 -chkerr ".db foo" 2 -chkerr ".dw foo" 2 -chkerr ".equ foo bar" 2 -chkerr ".org foo" 2 -chkerr ".fill foo" 2 -chkerr "ld a," 3 -chkerr "ld a, 'A" 3 -chkerr ".db 0x42," 3 -chkerr ".dw 0x4242," 3 -chkerr ".equ" 3 -chkerr ".equ foo" 3 -chkerr ".org" 3 -chkerr ".fill" 3 -chkerr "#inc" 3 -chkerr "#inc foo" 3 -chkerr "ld a, 0x100" 4 -chkerr ".db 0x100" 4 -chkerr "#inc \"doesnotexist\"" 5 -chkerr ".equ foo 42 \\ .equ foo 42" 6 +chkerr "foo" 17 +chkerr "ld a, foo" 18 +chkerr "ld a, hl" 18 +chkerr ".db foo" 18 +chkerr ".dw foo" 18 +chkerr ".equ foo bar" 18 +chkerr ".org foo" 18 +chkerr ".fill foo" 18 +chkerr "ld a," 19 +chkerr "ld a, 'A" 19 +chkerr ".db 0x42," 19 +chkerr ".dw 0x4242," 19 +chkerr ".equ" 19 +chkerr ".equ foo" 19 +chkerr ".org" 19 +chkerr ".fill" 19 +chkerr "#inc" 19 +chkerr "#inc foo" 19 +chkerr "ld a, 0x100" 20 +chkerr ".db 0x100" 20 +chkerr "#inc \"doesnotexist\"" 21 +chkerr ".equ foo 42 \\ .equ foo 42" 22 chkoom diff --git a/tools/tests/zasm/test7.asm b/tools/tests/zasm/test7.asm index a405205..45eb6e5 100644 --- a/tools/tests/zasm/test7.asm +++ b/tools/tests/zasm/test7.asm @@ -1,6 +1,7 @@ .equ USER_CODE 0x4800 .equ USER_RAMSTART 0x5800 .equ FS_HANDLE_SIZE 8 +.equ BLOCKDEV_SIZE 8 ; *** JUMP TABLE *** .equ strncmp 0x03 @@ -22,6 +23,10 @@ .equ fsTell 0x33 .equ cpHLDE 0x36 .equ parseArgs 0x39 +.equ _blkGetC 0x3c +.equ _blkPutC 0x3f +.equ _blkSeek 0x42 +.equ _blkTell 0x45 #include "err.h" #include "zasm/const.asm"