1
0
mirror of https://github.com/hsoft/collapseos.git synced 2024-11-26 04:38:05 +11:00

Compare commits

...

11 Commits

Author SHA1 Message Date
Virgil Dupras
69daf49920 doc: fix mis-wording 2019-11-05 17:59:29 -05:00
Virgil Dupras
6396eb4a9e tricks: add endianness notes 2019-11-04 16:49:53 -05:00
Virgil Dupras
9344c4b961 doc: minor improvements 2019-11-04 14:45:10 -05:00
Virgil Dupras
3ef964e74d acia: make GetC blocking 2019-11-04 14:44:43 -05:00
Virgil Dupras
f395297874 Improve python tools' shebang
Most OS don't have python3 in /usr/bin/python...
2019-11-04 14:43:27 -05:00
Virgil Dupras
41338a4b23 stdio: add "Accepted characters" comment section
ref #64
2019-11-04 10:12:17 -05:00
Virgil Dupras
27149338e4 stdio: fix typo 2019-11-04 10:04:09 -05:00
Virgil Dupras
2a55bfd375 stdio: remove a layer of indirection in GetC/PutC
We use zasm's ability to use labels in .equ directive.

We didn't do it before because for a while, we were in between scas
and zasm (scas was used in automated tests) so we needed to use the
lowest common denominator: zasm doesn't have macros and scas can't
use labels in .equ directives.

This forced us to add this layer of indirection. But now that we are
completely cut from scas' dependency, we can use this nice zasm's
ability.
2019-11-04 09:55:12 -05:00
Virgil Dupras
2a513e6f57 stdio: make stdioGetC and stdioReadline blocking
ref #64.

Also, fix a bug in the shell where it would write outside the buffer's
bounds when given a completely filled buffer without a space character
in it.
2019-11-03 20:32:27 -05:00
Virgil Dupras
16bf8e28c0 Remove SHELL_LOOPHOOK
It was a bad idea and having sms/pad interact directly with sms/vdp
is much simpler.

ref #64
2019-11-03 19:13:01 -05:00
Virgil Dupras
20c0ba3dd0 Clarify recipes structure
Drop the "{pre,post}-collapse" thing and specify that the rc2014 recipes
are canonical.
2019-11-03 16:09:11 -05:00
23 changed files with 201 additions and 276 deletions

View File

@ -1,5 +1,5 @@
This file describe tricks that are used throughout the code and might need This file describe tricks and conventions that are used throughout the code and
explanation. might need explanation.
or a: Equivalent to "cp 0", but results in a shorter opcode. or a: Equivalent to "cp 0", but results in a shorter opcode.
@ -13,3 +13,15 @@ Reset for failure. "xor a" (destroys A) and "cp a" (preserves A) are used to
ensure Z is set. To ensure that it is reset, it's a bit more complicated and ensure Z is set. To ensure that it is reset, it's a bit more complicated and
"unsetZ" routine exists for that, although that in certain circumstances, "unsetZ" routine exists for that, although that in certain circumstances,
"inc a \ dec a" or "or a" can work. "inc a \ dec a" or "or a" can work.
z80 is little endian in its 16-bit loading operations. For example, "ld hl, (0)"
will load the contents of memory address 0 in L and memory address 1 in H. This
little-endianess is followed by Collapse OS in most situations. When it's not,
it's specified in comments.
This get a bit awkward with regards to 32-bit. There are no "native" z80 32-bit
operations, so z80 doesn't mandate an alignment. In Collapse OS, 32-bit numbers
are stored as "big endian pair of little endian 16-bit numbers". For example,
if "ld dehl, (0)" existed and if the first 4 bytes of memory were 0x01, 0x02,
0x03 and 0x04, then DE (being the "high" word) would be 0x0201 and HL would be
0x0403.

View File

@ -7,47 +7,43 @@ look like:
; The RAM module is selected on A15, so it has the range 0x8000-0xffff ; The RAM module is selected on A15, so it has the range 0x8000-0xffff
.equ RAMSTART 0x8000 .equ RAMSTART 0x8000
.equ RAMEND 0xffff .equ RAMEND 0xffff
.equ ACIA_CTL 0x80 ; Control and status. RS off. .equ ACIA_CTL 0x80 ; Control and status. RS off.
.equ ACIA_IO 0x81 ; Transmit. RS on. .equ ACIA_IO 0x81 ; Transmit. RS on.
jr init jp init
; interrupt hook ; interrupt hook
.fill 0x38-$ .fill 0x38-$
jp aciaInt jp aciaInt
.inc "err.h"
.inc "core.asm"
.inc "parse.asm"
.equ ACIA_RAMSTART RAMSTART
.inc "acia.asm"
.equ STDIO_RAMSTART ACIA_RAMEND
.equ STDIO_GETC aciaGetC
.equ STDIO_PUTC aciaPutC
.inc "stdio.asm"
.equ SHELL_RAMSTART STDIO_RAMEND
.equ SHELL_EXTRA_CMD_COUNT 0
.inc "shell.asm"
init: init:
di di
; setup stack ; setup stack
ld hl, RAMEND ld hl, RAMEND
ld sp, hl ld sp, hl
im 1 im 1
call aciaInit
xor a call aciaInit
ld de, BLOCKDEV_SEL call shellInit
call blkSel
call stdioInit
call shellInit
ei ei
jp shellLoop jp shellLoop
#include "core.asm"
.equ ACIA_RAMSTART RAMSTART
#include "acia.asm"
.equ BLOCKDEV_RAMSTART ACIA_RAMEND
.equ BLOCKDEV_COUNT 1
#include "blockdev.asm"
; List of devices
.dw aciaGetC, aciaPutC, 0, 0
.equ STDIO_RAMSTART BLOCKDEV_RAMEND
#include "stdio.asm"
.equ SHELL_RAMSTART STDIO_RAMEND
.equ SHELL_EXTRA_CMD_COUNT 0
#include "shell.asm"
Once this is written, building it is easy: Once this is written, building it is easy:

View File

@ -98,17 +98,17 @@ aciaInt:
reti reti
; *** BLOCKDEV *** ; *** STDIO ***
; These function below follow the blockdev API. ; These function below follow the stdio API.
aciaGetC: aciaGetC:
push de push de
.loop:
ld a, (ACIA_BUFWRIDX) ld a, (ACIA_BUFWRIDX)
ld e, a ld e, a
ld a, (ACIA_BUFRDIDX) ld a, (ACIA_BUFRDIDX)
cp e cp e
jr z, .nothingToRead ; equal? nothing to read. jr z, .loop ; equal? nothing to read. loop
; Alrighty, buffer not empty. let's read. ; Alrighty, buffer not empty. let's read.
ld de, ACIA_BUF ld de, ACIA_BUF
@ -120,12 +120,6 @@ aciaGetC:
; And finally, fetch the value. ; And finally, fetch the value.
ld a, (de) ld a, (de)
cp a ; ensure Z
jr .end
.nothingToRead:
call unsetZ
.end:
pop de pop de
ret ret

View File

@ -35,6 +35,10 @@
; number of entries in shellCmdTbl ; number of entries in shellCmdTbl
.equ SHELL_CMD_COUNT 6+SHELL_EXTRA_CMD_COUNT .equ SHELL_CMD_COUNT 6+SHELL_EXTRA_CMD_COUNT
; maximum length for shell commands. Should be confortably below stdio's
; readline buffer length.
.equ SHELL_MAX_CMD_LEN 0x10
; *** VARIABLES *** ; *** VARIABLES ***
; Memory address that the shell is currently "pointing at" for peek, load, call ; Memory address that the shell is currently "pointing at" for peek, load, call
; operations. Set with mptr. ; operations. Set with mptr.
@ -42,14 +46,12 @@
; Places where we store arguments specifiers and where resulting values are ; Places where we store arguments specifiers and where resulting values are
; written to after parsing. ; written to after parsing.
.equ SHELL_CMD_ARGS SHELL_MEM_PTR+2 .equ SHELL_CMD_ARGS @+2
; Pointer to a hook to call when a cmd name isn't found ; Pointer to a hook to call when a cmd name isn't found
.equ SHELL_CMDHOOK SHELL_CMD_ARGS+PARSE_ARG_MAXCOUNT .equ SHELL_CMDHOOK @+PARSE_ARG_MAXCOUNT
; Pointer to a routine to call at each shell loop iteration .equ SHELL_RAMEND @+2
.equ SHELL_LOOPHOOK SHELL_CMDHOOK+2
.equ SHELL_RAMEND SHELL_LOOPHOOK+2
; *** CODE *** ; *** CODE ***
shellInit: shellInit:
@ -58,7 +60,6 @@ shellInit:
ld (SHELL_MEM_PTR+1), a ld (SHELL_MEM_PTR+1), a
ld hl, noop ld hl, noop
ld (SHELL_CMDHOOK), hl ld (SHELL_CMDHOOK), hl
ld (SHELL_LOOPHOOK), hl
; print welcome ; print welcome
ld hl, .welcome ld hl, .welcome
@ -70,15 +71,8 @@ shellInit:
; Inifite loop that processes input. Because it's infinite, you should jump ; Inifite loop that processes input. Because it's infinite, you should jump
; to it rather than call it. Saves two precious bytes in the stack. ; to it rather than call it. Saves two precious bytes in the stack.
shellLoop: shellLoop:
; First, call the loop hook call stdioReadLine
ld ix, (SHELL_LOOPHOOK)
call callIX
; Then, let's wait until something is typed.
call stdioReadC
jr nz, shellLoop ; not done? loop
; We're done. Process line.
call printcrlf call printcrlf
call stdioGetLine
call shellParse call shellParse
ld hl, .prompt ld hl, .prompt
call printstr call printstr
@ -92,7 +86,7 @@ shellParse:
; first thing: is command empty? ; first thing: is command empty?
ld a, (hl) ld a, (hl)
or a or a
ret z ; empty, nthing to do ret z ; empty, nothing to do
push af push af
push bc push bc
@ -110,6 +104,13 @@ shellParse:
; no arg, (HL) is zero to facilitate processing later, add a second ; no arg, (HL) is zero to facilitate processing later, add a second
; null next to that one to indicate unambiguously that we have no args. ; null next to that one to indicate unambiguously that we have no args.
inc hl inc hl
; Oh wait, before we proceed, is our cmd length within limits? cmd len
; is currently in A from findchar
cp SHELL_MAX_CMD_LEN
jr c, .hasArgs ; within limits
; outside limits
ld a, SHELL_ERR_UNKNOWN_CMD
jr .error
.hasArgs: .hasArgs:
xor a xor a
ld (hl), a ld (hl), a

View File

@ -11,6 +11,9 @@
; The space character is the first among special chars. ; The space character is the first among special chars.
; * C confirms letter selection ; * C confirms letter selection
; ;
; This module is currently hard-wired to sms/vdp, that is, it calls vdp's
; routines during padGetC to update character selection.
;
; *** Consts *** ; *** Consts ***
; ;
.equ PAD_CTLPORT 0x3f .equ PAD_CTLPORT 0x3f
@ -29,21 +32,18 @@
; ;
; Button status of last padUpdateSel call. Used for debouncing. ; Button status of last padUpdateSel call. Used for debouncing.
.equ PAD_SELSTAT PAD_RAMSTART .equ PAD_SELSTAT PAD_RAMSTART
; Button status of last padGetC call.
.equ PAD_GETCSTAT PAD_SELSTAT+1
; Current selected character ; Current selected character
.equ PAD_SELCHR PAD_GETCSTAT+1 .equ PAD_SELCHR @+1
; When non-zero, will be the next char returned in GetC. So far, only used for ; When non-zero, will be the next char returned in GetC. So far, only used for
; LF that is feeded when Start is pressed. ; LF that is feeded when Start is pressed.
.equ PAD_NEXTCHR PAD_SELCHR+1 .equ PAD_NEXTCHR @+1
.equ PAD_RAMEND PAD_NEXTCHR+1 .equ PAD_RAMEND @+1
; *** Code *** ; *** Code ***
padInit: padInit:
ld a, 0xff ld a, 0xff
ld (PAD_SELSTAT), a ld (PAD_SELSTAT), a
ld (PAD_GETCSTAT), a
xor a xor a
ld (PAD_NEXTCHR), a ld (PAD_NEXTCHR), a
ld a, 'a' ld a, 'a'
@ -78,14 +78,14 @@ padStatus:
ret ret
; From a pad status in A, update current char selection and return it. ; From a pad status in A, update current char selection and return it.
; Returns the same Z as padStatus: set if unchanged, unset if changed ; Sets Z if current selection was unchanged, unset if changed.
padUpdateSel: padUpdateSel:
call padStatus call padStatus
push hl push hl ; --> lvl 1
ld hl, PAD_SELSTAT ld hl, PAD_SELSTAT
cp (hl) cp (hl)
ld (hl), a ld (hl), a
pop hl pop hl ; <-- lvl 1
jr z, .nothing ; nothing changed jr z, .nothing ; nothing changed
bit PAD_UP, a bit PAD_UP, a
jr z, .up jr z, .up
@ -156,45 +156,51 @@ padUpdateSel:
ld (PAD_SELCHR), a ld (PAD_SELCHR), a
jp unsetZ jp unsetZ
.nothing: .nothing:
cp a ; ensure Z ; Z already set
ld a, (PAD_SELCHR) ld a, (PAD_SELCHR)
ret ret
; Repeatedly poll the pad for input and returns the resulting "input char".
; This routine takes a long time to return because it waits until C, B or Start
; was pressed. Until this is done, this routine takes care of updating the
; "current selection" directly in the VDP.
padGetC: padGetC:
ld a, (PAD_NEXTCHR) ld a, (PAD_NEXTCHR)
or a or a
jr nz, .nextchr jr nz, .nextchr
call padStatus call padUpdateSel
push hl jp z, padGetC ; nothing changed, loop
ld hl, PAD_GETCSTAT ; pad status was changed, let's see if an action button was pressed
cp (hl) ld a, (PAD_SELSTAT)
ld (hl), a
pop hl
jp z, unsetZ ; nothing changed
bit PAD_BUTC, a bit PAD_BUTC, a
jr z, .advance jr z, .advance
bit PAD_BUTA, a bit PAD_BUTA, a
jr z, .backspace jr z, .backspace
bit PAD_START, a bit PAD_START, a
jr z, .return jr z, .return
jp unsetZ ; no action button pressed, but because our pad status changed, update
; VDP before looping.
ld a, (PAD_SELCHR)
call vdpConv
call vdpSpitC
jp padGetC
.return: .return:
ld a, ASCII_LF ld a, ASCII_LF
ld (PAD_NEXTCHR), a ld (PAD_NEXTCHR), a
; continue to .advance ; continue to .advance
.advance: .advance:
ld a, (PAD_SELCHR) ld a, (PAD_SELCHR)
cp a ; Z was already set from previous BIT instruction
ret ret
.backspace: .backspace:
ld a, ASCII_BS ld a, ASCII_BS
cp a ; Z was already set from previous BIT instruction
ret ret
.nextchr: .nextchr:
; We have a "next char", return it and clear it. ; We have a "next char", return it and clear it.
cp a ; ensure Z cp a ; ensure Z
push af ex af, af'
xor a xor a
ld (PAD_NEXTCHR), a ld (PAD_NEXTCHR), a
pop af ex af, af'
ret ret

View File

@ -21,11 +21,8 @@
; Row of cursor ; Row of cursor
.equ VDP_ROW VDP_RAMSTART .equ VDP_ROW VDP_RAMSTART
; Line of cursor ; Line of cursor
.equ VDP_LINE VDP_ROW+1 .equ VDP_LINE @+1
; Returns, in A, the currently selected char in a "pad char selection" scheme. .equ VDP_RAMEND @+1
.equ VDP_CHRSELHOOK VDP_LINE+1
.equ VDP_LASTSEL VDP_CHRSELHOOK+2
.equ VDP_RAMEND VDP_LASTSEL+1
; *** Code *** ; *** Code ***
@ -33,9 +30,6 @@ vdpInit:
xor a xor a
ld (VDP_ROW), a ld (VDP_ROW), a
ld (VDP_LINE), a ld (VDP_LINE), a
ld (VDP_LASTSEL), a
ld hl, noop
ld (VDP_CHRSELHOOK), hl
ld hl, vdpInitData ld hl, vdpInitData
ld b, vdpInitDataEnd-vdpInitData ld b, vdpInitDataEnd-vdpInitData
@ -121,12 +115,6 @@ vdpSpitC:
ret ret
vdpPutC: vdpPutC:
; First, let's invalidate last sel
ex af, af'
xor a
ld (VDP_LASTSEL), a
ex af, af'
; Then, let's place our cursor. We need to first send our LSB, whose ; Then, let's place our cursor. We need to first send our LSB, whose
; 6 low bits contain our row*2 (each tile is 2 bytes wide) and high ; 6 low bits contain our row*2 (each tile is 2 bytes wide) and high
; 2 bits are the two low bits of our line ; 2 bits are the two low bits of our line
@ -267,26 +255,6 @@ vdpConv:
ld a, 0x5e ld a, 0x5e
ret ret
; During the shell loop, updates the currently selected char, if appropriate
vdpShellLoopHook:
push af
push ix
push hl
xor a
ld ix, (VDP_CHRSELHOOK)
call callIX
ld hl, VDP_LASTSEL
cp (hl)
jr z, .noChange
; selection changed
call vdpConv
call vdpSpitC
.noChange:
pop hl
pop ix
pop af
ret
vdpPaletteData: vdpPaletteData:
.db 0x00,0x3f .db 0x00,0x3f
vdpPaletteDataEnd: vdpPaletteDataEnd:

View File

@ -4,6 +4,26 @@
; in", that is, the console through which the user is connected in a decoupled ; in", that is, the console through which the user is connected in a decoupled
; manner. ; manner.
; ;
; Those GetC/PutC routines are hooked through defines and have this API:
;
; GetC: Blocks until a character is read from the device and return that
; character in A.
;
; PutC: Write character specified in A onto the device.
;
; *** Accepted characters ***
;
; For now, we're in muddy waters in this regard. We try to stay close to ASCII.
; Anything over 0x7f is undefined. Both CR and LF are interpreted as "line end".
; Both BS and DEL mean "delete previous character".
;
; When outputting, newlines are marked by CR and LF. Outputting a character
; deletion is made through BS then space then BS.
;
; *** Defines ***
; STDIO_GETC: address of a GetC routine
; STDIO_PUTC: address of a PutC routine
;
; *** Consts *** ; *** Consts ***
; Size of the readline buffer. If a typed line reaches this size, the line is ; Size of the readline buffer. If a typed line reaches this size, the line is
; flushed immediately (same as pressing return). ; flushed immediately (same as pressing return).
@ -12,34 +32,19 @@
; *** Variables *** ; *** Variables ***
; Used to store formatted hex values just before printing it. ; Used to store formatted hex values just before printing it.
.equ STDIO_HEX_FMT STDIO_RAMSTART .equ STDIO_HEX_FMT STDIO_RAMSTART
.equ STDIO_GETC STDIO_HEX_FMT+2
.equ STDIO_PUTC STDIO_GETC+2
; Line buffer. We read types chars into this buffer until return is pressed ; Line buffer. We read types chars into this buffer until return is pressed
; This buffer is null-terminated and we don't keep an index around: we look ; This buffer is null-terminated.
; for the null-termination every time we write to it. Simpler that way. .equ STDIO_BUF @+2
.equ STDIO_BUF STDIO_PUTC+2
; Index where the next char will go in stdioGetC. ; Index where the next char will go in stdioGetC.
.equ STDIO_BUFIDX STDIO_BUF+STDIO_BUFSIZE .equ STDIO_RAMEND @+STDIO_BUFSIZE
.equ STDIO_RAMEND STDIO_BUFIDX+1
; Sets GetC to the routine where HL points to and PutC to DE.
stdioInit:
ld (STDIO_GETC), hl
ld (STDIO_PUTC), de
xor a
ld (STDIO_BUF), a
ld (STDIO_BUFIDX), a
ret
stdioGetC: stdioGetC:
ld ix, (STDIO_GETC) jp STDIO_GETC
jp (ix)
stdioPutC: stdioPutC:
ld ix, (STDIO_PUTC) jp STDIO_PUTC
jp (ix)
; print null-terminated string pointed to by HL ; print null-terminated string pointed to by HL
printstr: printstr:
@ -50,7 +55,7 @@ printstr:
ld a, (hl) ; load character to send ld a, (hl) ; load character to send
or a ; is it zero? or a ; is it zero?
jr z, .end ; if yes, we're finished jr z, .end ; if yes, we're finished
call stdioPutC call STDIO_PUTC
inc hl inc hl
jr .loop jr .loop
@ -65,7 +70,7 @@ printnstr:
push hl push hl
.loop: .loop:
ld a, (hl) ; load character to send ld a, (hl) ; load character to send
call stdioPutC call STDIO_PUTC
inc hl inc hl
djnz .loop djnz .loop
@ -77,9 +82,9 @@ printnstr:
printcrlf: printcrlf:
push af push af
ld a, ASCII_CR ld a, ASCII_CR
call stdioPutC call STDIO_PUTC
ld a, ASCII_LF ld a, ASCII_LF
call stdioPutC call STDIO_PUTC
pop af pop af
ret ret
@ -105,21 +110,19 @@ printHexPair:
pop af pop af
ret ret
; Call stdioGetC and put the result in the buffer. Sets Z according to whether ; Repeatedly calls stdioGetC until a whole line was read, that is, when CR or
; the buffer is "complete", that is, whether CR or LF have been pressed or if ; LF is read or if the buffer is full. Sets HL to the beginning of the read
; the the buffer is full. Z is set if the line is "complete", unset if not. ; line, which is null-terminated.
; The next call to stdioReadC after a completed line will start a new line.
; ;
; This routine also takes care of echoing received characters back to the TTY. ; This routine also takes care of echoing received characters back to the TTY.
; ; It also manages backspaces properly.
; This routine doesn't wait after a typed char. If nothing is typed, we return stdioReadLine:
; immediately with Z flag unset. push bc
; ld hl, STDIO_BUF
; Note that this routine doesn't bother returning the typed character. ld b, STDIO_BUFSIZE-1
stdioReadC: .loop:
; Let's wait until something is typed. ; Let's wait until something is typed.
call stdioGetC call STDIO_GETC
ret nz ; nothing typed? nothing to do
; got it. Now, is it a CR or LF? ; got it. Now, is it a CR or LF?
cp ASCII_CR cp ASCII_CR
jr z, .complete ; char is CR? buffer complete! jr z, .complete ; char is CR? buffer complete!
@ -131,86 +134,37 @@ stdioReadC:
jr z, .delchr jr z, .delchr
; Echo the received character right away so that we see what we type ; Echo the received character right away so that we see what we type
call stdioPutC call STDIO_PUTC
; Ok, gotta add it do the buffer ; Ok, gotta add it do the buffer
; save char for later
ex af, af'
ld a, (STDIO_BUFIDX)
push hl ; --> lvl 1
ld hl, STDIO_BUF
; make HL point to dest spot
call addHL
; Write our char down
ex af, af'
ld (hl), a ld (hl), a
; follow up with a null char
inc hl inc hl
xor a djnz .loop
ld (hl), a ; buffer overflow, complete line
pop hl ; <-- lvl 1
; inc idx, which still is in AF'
ex af, af'
inc a
cp STDIO_BUFSIZE-1 ; -1 is because we always want to keep our
; last char at zero.
jr z, .complete ; end of buffer reached? buffer is full.
; not complete. save idx back
ld (STDIO_BUFIDX), a
; Z already unset
ret
.complete: .complete:
; The line in our buffer is complete. ; The line in our buffer is complete.
; But before we do that, let's take care of a special case: the empty ; Let's null-terminate it and return.
; line. If we didn't add any character since the last "complete", then xor a
; our buffer's content is the content from the last time. Let's set this ld (hl), a
; to an empty string. ld hl, STDIO_BUF
ld a, (STDIO_BUFIDX) pop bc
or a
jr nz, .completeSkip
ld (STDIO_BUF), a
.completeSkip:
xor a ; sets Z
ld (STDIO_BUFIDX), a
ret ret
.delchr: .delchr:
ld a, (STDIO_BUFIDX) ; Deleting is a tricky business. We have to decrease HL and increase B
or a ; so that everything stays consistent. We also have to make sure that
jp z, unsetZ ; buf empty? nothing to do ; We don't do buffer underflows.
; buffer not empty, let's go back one char and set a null char there. ld a, b
dec a cp STDIO_BUFSIZE-1
ld (STDIO_BUFIDX), a jr z, .loop ; beginning of line, nothing to delete
push hl ;<| dec hl
ld hl, STDIO_BUF ; | inc b
; make HL point to dest spot |
call addHL ; |
xor a ; |
ld (hl), a ; |
pop hl ;<|
; Char deleted in buffer, now send BS + space + BS for the terminal ; Char deleted in buffer, now send BS + space + BS for the terminal
; to clear its previous char ; to clear its previous char
ld a, ASCII_BS ld a, ASCII_BS
call stdioPutC call STDIO_PUTC
ld a, ' ' ld a, ' '
call stdioPutC call STDIO_PUTC
ld a, ASCII_BS ld a, ASCII_BS
call stdioPutC call STDIO_PUTC
jp unsetZ jr .loop
; Make HL point to the line buffer. It is always null terminated.
stdioGetLine:
ld hl, STDIO_BUF
ret
; Repeatedly call stdioReadC until Z is set, then make HL point to the read
; buffer.
stdioReadLine:
call stdioReadC
jr nz, stdioReadLine
ld hl, STDIO_BUF
ret

View File

@ -22,16 +22,30 @@ for.
## Structure ## Structure
Each top folder represent an architecture. In that top folder, there's a Each top folder represents an architecture. In that top folder, there's a
`README.md` file presenting the architecture as well as instructions to `README.md` file presenting the architecture as well as instructions to
minimally get Collapse OS running on it. Then, in the same folder, there are minimally get Collapse OS running on it. Then, in the same folder, there are
auxiliary recipes for nice stuff built around that architecture. auxiliary recipes for nice stuff built around that architecture.
The structure of those recipes follow a regular pattern: pre-collapse recipe Installation procedures are centered around using a modern system to install
and post-collapse recipe. That is, instructions to achieve the desired outcome Collapse OS. These are the most useful instructions to have under both
from a "modern" system, and then, instructions to achieve the same thing from a pre-collapse and post-collapse conditions because even after the collapse,
system running Collapse OS. we'll interact mostly with modern technology for many years.
Initially, those recipes will only be possible in a "modern" system, but as There are, however, recipes to write to different storage media, thus making
tooling improve, we should be able to have recipes that we can consider Collapse OS fully reproducible. For example, you can use `rc2014/eeprom` to
complete. write arbitrary data to a `AT28` EEPROM.
The `rc2014` architecture is considered the "canonical" one. That means that
if a recipe is considered architecture independent, it's the `rc2014` recipe
folder that's going to contain it.
For example, `rc2014/eeprom` can be considered architecture independent because
it's much more about the `AT28` than about a specific z80 architecture. You can
adapt it to any supported architecture with minimal hassle. Therefore, it's
not going to be copied in every architecture recipe folder.
`rc2014` installation recipe also contains more "newbie-friendly" instructions
than other installation recipes, which take this knowledge for granted. It is
therefore recommended to have a look at it even if you're not planning on using
a RC2014.

View File

@ -28,11 +28,9 @@ are other recipes related to the RC2014:
* [Assembling binaries](zasm/README.md) * [Assembling binaries](zasm/README.md)
* [Interfacing a PS/2 keyboard](ps2/README.md) * [Interfacing a PS/2 keyboard](ps2/README.md)
## Goal ## Recipe
Have the shell running and accessible through the Serial I/O. The goal is to have the shell running and accessible through the Serial I/O.
## Pre-collapse
You'll need specialized tools to write data to the AT28 EEPROM. There seems to You'll need specialized tools to write data to the AT28 EEPROM. There seems to
be many devices around made to write in flash and EEPROM modules, but being in be many devices around made to write in flash and EEPROM modules, but being in
@ -77,7 +75,9 @@ is decoupled from the ACIA and can get its IO from anything. See
We only have the shell to build, so it's rather straightforward: We only have the shell to build, so it's rather straightforward:
zasm < glue.asm > rom.bin ../../tools/zasm.sh ../../kernel < glue.asm > os.bin
Running `make` will also work.
### Write to the ROM ### Write to the ROM
@ -100,10 +100,6 @@ identify the tty bound to it (in my case, `/dev/ttyUSB0`). Then:
Press the reset button on the RC2014 and you should see the Collapse OS prompt! Press the reset button on the RC2014 and you should see the Collapse OS prompt!
## Post-collapse
TODO
[rc2014]: https://rc2014.co.uk [rc2014]: https://rc2014.co.uk
[romwrite]: https://github.com/hsoft/romwrite [romwrite]: https://github.com/hsoft/romwrite
[zasm]: ../../tools/emul [zasm]: ../../tools/emul

View File

@ -27,7 +27,7 @@ If you're tempted by the idea of hacking your existing RC2014 ROM module by
wiring `WR` and write directly to the range `0x0000-0x1fff` while running it, wiring `WR` and write directly to the range `0x0000-0x1fff` while running it,
be aware that it's not that easy. I was also tempted by this idea, tried it, be aware that it's not that easy. I was also tempted by this idea, tried it,
but on bootup, it seems that some random `WR` triggers happen and it corrupts but on bootup, it seems that some random `WR` triggers happen and it corrupts
the EEPROM contents. Theoretically, we could go around that my putting the AT28 the EEPROM contents. Theoretically, we could go around that by putting the AT28
in write protection mode, but I preferred building my own module. in write protection mode, but I preferred building my own module.
I don't think you need a schematic. It's really simple. I don't think you need a schematic. It's really simple.

View File

@ -27,6 +27,8 @@ jp aciaInt
.dw mmapGetB, mmapPutB .dw mmapGetB, mmapPutB
.equ STDIO_RAMSTART BLOCKDEV_RAMEND .equ STDIO_RAMSTART BLOCKDEV_RAMEND
.equ STDIO_GETC aciaGetC
.equ STDIO_PUTC aciaPutC
.inc "stdio.asm" .inc "stdio.asm"
.equ AT28W_RAMSTART STDIO_RAMEND .equ AT28W_RAMSTART STDIO_RAMEND
@ -49,9 +51,6 @@ init:
im 1 im 1
call aciaInit call aciaInit
ld hl, aciaGetC
ld de, aciaPutC
call stdioInit
call shellInit call shellInit
xor a xor a

View File

@ -18,6 +18,8 @@ jp aciaInt
.inc "acia.asm" .inc "acia.asm"
.equ STDIO_RAMSTART ACIA_RAMEND .equ STDIO_RAMSTART ACIA_RAMEND
.equ STDIO_GETC aciaGetC
.equ STDIO_PUTC aciaPutC
.inc "stdio.asm" .inc "stdio.asm"
.equ SHELL_RAMSTART STDIO_RAMEND .equ SHELL_RAMSTART STDIO_RAMEND
@ -32,9 +34,6 @@ init:
im 1 im 1
call aciaInit call aciaInit
ld hl, aciaGetC
ld de, aciaPutC
call stdioInit
call shellInit call shellInit
ei ei
jp shellLoop jp shellLoop

View File

@ -16,6 +16,8 @@ jp init
.inc "kbd.asm" .inc "kbd.asm"
.equ STDIO_RAMSTART KBD_RAMEND .equ STDIO_RAMSTART KBD_RAMEND
.equ STDIO_GETC kbdGetC
.equ STDIO_PUTC aciaPutC
.inc "stdio.asm" .inc "stdio.asm"
.equ SHELL_RAMSTART STDIO_RAMEND .equ SHELL_RAMSTART STDIO_RAMEND
@ -30,9 +32,6 @@ init:
call aciaInit call aciaInit
call kbdInit call kbdInit
ld hl, kbdGetC
ld de, aciaPutC
call stdioInit
call shellInit call shellInit
jp shellLoop jp shellLoop

View File

@ -34,6 +34,8 @@ jp aciaInt
.equ STDIO_RAMSTART BLOCKDEV_RAMEND .equ STDIO_RAMSTART BLOCKDEV_RAMEND
.equ STDIO_GETC aciaGetC
.equ STDIO_PUTC aciaPutC
.inc "stdio.asm" .inc "stdio.asm"
.equ FS_RAMSTART STDIO_RAMEND .equ FS_RAMSTART STDIO_RAMEND
@ -66,9 +68,6 @@ init:
ld sp, hl ld sp, hl
im 1 im 1
call aciaInit call aciaInit
ld hl, aciaGetC
ld de, aciaPutC
call stdioInit
call fsInit call fsInit
call shellInit call shellInit
ld hl, pgmShellHook ld hl, pgmShellHook

View File

@ -65,6 +65,8 @@ jp aciaInt
.inc "mmap.asm" .inc "mmap.asm"
.equ STDIO_RAMSTART BLOCKDEV_RAMEND .equ STDIO_RAMSTART BLOCKDEV_RAMEND
.equ STDIO_GETC aciaGetC
.equ STDIO_PUTC aciaPutC
.inc "stdio.asm" .inc "stdio.asm"
.equ FS_RAMSTART STDIO_RAMEND .equ FS_RAMSTART STDIO_RAMEND
@ -99,9 +101,6 @@ init:
ld sp, hl ld sp, hl
im 1 im 1
call aciaInit call aciaInit
ld hl, aciaGetC
ld de, aciaPutC
call stdioInit
call fsInit call fsInit
call shellInit call shellInit
ld hl, pgmShellHook ld hl, pgmShellHook

View File

@ -19,6 +19,8 @@
.inc "sms/vdp.asm" .inc "sms/vdp.asm"
.equ STDIO_RAMSTART VDP_RAMEND .equ STDIO_RAMSTART VDP_RAMEND
.equ STDIO_GETC padGetC
.equ STDIO_PUTC vdpPutC
.inc "stdio.asm" .inc "stdio.asm"
.equ SHELL_RAMSTART STDIO_RAMEND .equ SHELL_RAMSTART STDIO_RAMEND
@ -33,15 +35,7 @@ init:
call padInit call padInit
call vdpInit call vdpInit
ld hl, padUpdateSel
ld (VDP_CHRSELHOOK), hl
ld hl, padGetC
ld de, vdpPutC
call stdioInit
call shellInit call shellInit
ld hl, vdpShellLoopHook
ld (SHELL_LOOPHOOK), hl
jp shellLoop jp shellLoop
.fill 0x7ff0-$ .fill 0x7ff0-$

View File

@ -21,6 +21,8 @@
.inc "sms/vdp.asm" .inc "sms/vdp.asm"
.equ STDIO_RAMSTART VDP_RAMEND .equ STDIO_RAMSTART VDP_RAMEND
.equ STDIO_GETC kbdGetC
.equ STDIO_PUTC vdpPutC
.inc "stdio.asm" .inc "stdio.asm"
.equ SHELL_RAMSTART STDIO_RAMEND .equ SHELL_RAMSTART STDIO_RAMEND
@ -45,10 +47,6 @@ init:
call kbdInit call kbdInit
call vdpInit call vdpInit
ld hl, kbdGetC
ld de, vdpPutC
call stdioInit
call shellInit call shellInit
jp shellLoop jp shellLoop

View File

@ -52,6 +52,8 @@
.inc "sms/vdp.asm" .inc "sms/vdp.asm"
.equ STDIO_RAMSTART VDP_RAMEND .equ STDIO_RAMSTART VDP_RAMEND
.equ STDIO_GETC kbdGetC
.equ STDIO_PUTC vdpPutC
.inc "stdio.asm" .inc "stdio.asm"
.equ MMAP_START 0xd700 .equ MMAP_START 0xd700
@ -104,9 +106,6 @@ init:
ld a, 'S' ld a, 'S'
ld (hl), a ld (hl), a
ld hl, kbdGetC
ld de, vdpPutC
call stdioInit
call fsInit call fsInit
xor a xor a
ld de, BLOCKDEV_SEL ld de, BLOCKDEV_SEL

View File

@ -1,4 +1,4 @@
#!/usr/bin/python #!/usr/bin/env python3
# Read specified number of bytes in specified blkdev ID and spit it to stdout. # Read specified number of bytes in specified blkdev ID and spit it to stdout.
# The proper blkdev has to be selected and placed already. # The proper blkdev has to be selected and placed already.

View File

@ -58,6 +58,8 @@
.inc "mmap.asm" .inc "mmap.asm"
.equ STDIO_RAMSTART BLOCKDEV_RAMEND .equ STDIO_RAMSTART BLOCKDEV_RAMEND
.equ STDIO_GETC emulGetC
.equ STDIO_PUTC emulPutC
.inc "stdio.asm" .inc "stdio.asm"
.equ FS_RAMSTART STDIO_RAMEND .equ FS_RAMSTART STDIO_RAMEND
@ -84,9 +86,6 @@ init:
; setup stack ; setup stack
ld hl, KERNEL_RAMEND ld hl, KERNEL_RAMEND
ld sp, hl ld sp, hl
ld hl, emulGetC
ld de, emulPutC
call stdioInit
call fsInit call fsInit
ld a, 0 ; select fsdev ld a, 0 ; select fsdev
ld de, BLOCKDEV_SEL ld de, BLOCKDEV_SEL

View File

@ -45,6 +45,8 @@ jp printstr
.dw fsdevGetB, fsdevPutB .dw fsdevGetB, fsdevPutB
.equ STDIO_RAMSTART BLOCKDEV_RAMEND .equ STDIO_RAMSTART BLOCKDEV_RAMEND
.equ STDIO_GETC noop
.equ STDIO_PUTC stderrPutC
.inc "stdio.asm" .inc "stdio.asm"
.equ FS_RAMSTART STDIO_RAMEND .equ FS_RAMSTART STDIO_RAMEND
@ -55,9 +57,6 @@ init:
di di
ld hl, 0xffff ld hl, 0xffff
ld sp, hl ld sp, hl
ld hl, unsetZ
ld de, stderrPutC
call stdioInit
ld a, 2 ; select fsdev ld a, 2 ; select fsdev
ld de, BLOCKDEV_SEL ld de, BLOCKDEV_SEL
call blkSel call blkSel

View File

@ -1,4 +1,4 @@
#!/usr/bin/python #!/usr/bin/env python3
# Read specified number of bytes at specified memory address and dump it to # Read specified number of bytes at specified memory address and dump it to
# stdout. # stdout.

View File

@ -1,4 +1,4 @@
#!/usr/bin/python #!/usr/bin/env python3
# Push specified file to specified device and verify that the contents is # Push specified file to specified device and verify that the contents is
# correct by sending a "peek" command afterwards and check the output. Errors # correct by sending a "peek" command afterwards and check the output. Errors