~vdupras/collapseos

ref: 421ca5112f091f8ba3322a13e128e083e6bd1615 collapseos/arch/z80/trs80/blk.fs -rw-r--r-- 3.6 KiB
421ca511Virgil Dupras Remove one level of C< override 1 year, 7 months ago
                                                                                
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
( ----- 600 )
TRS-80 Recipe

Support code for the TRS-80 recipe. Contains drivers for the
keyboard, video and floppy. At the moment, they are thin layer
over the drivers provided by TRSDOS' SVC.

Load with "602 LOAD".

There is also the RECV program at B612.
( ----- 602 )
1 8 LOADR+
( ----- 603 )
CODE (key?) ( -- c? f )
    A 0x08 LDri, ( @KBD )
    0x28 RST,
    IFZ, PUSHA, THEN, PUSHZ,
;CODE
CODE (emit) EXX, ( protect BC )
    BC POP, ( c == @DSP arg ) chkPS,
    A 0x02 LDri, ( @DSP )
    0x28 RST,
EXX, ( unprotect BC ) ;CODE
CODE AT-XY EXX, ( protect BC )
    DE POP, H E LDrr, ( Y )
    DE POP, L E LDrr, ( X ) chkPS,
    A 0x0f LDri, ( @VDCTL ) B 3 LDri, ( setcur )
    0x28 RST,
EXX, ( unprotect BC ) ;CODE
( ----- 604 )
: LINES 24 ; : COLS 80 ;
: XYMODE 0x70 RAM+ ;
: CELL! COLS /MOD AT-XY (emit) ;
CODE BYE
    HL 0 LDdi,
    A 0x16 LDri, ( @EXIT )
    0x28 RST,
CODE @DCSTAT ( drv -- f ) EXX, ( protect BC )
    BC POP,
    chkPS,
    A 0x28 LDri, ( @DCSTAT )
    0x28 RST,
    PUSHZ,
EXX, ( unprotect BC ) ;CODE
( ----- 605 )
CODE @RDSEC ( drv cylsec addr -- f ) EXX, ( protect BC )
    HL POP,
    DE POP,
    BC POP,
    chkPS,
    A 0x31 LDri, ( @RDSEC )
    0x28 RST,
    PUSHZ,
EXX, ( unprotect BC ) ;CODE
( ----- 606 )
CODE @WRSEC ( drv cylsec addr -- f ) EXX, ( protect BC )
    HL POP,
    DE POP,
    BC POP,
    chkPS,
    A 0x35 LDri, ( @WRSEC )
    0x28 RST,
    PUSHZ,
EXX, ( unprotect BC ) ;CODE
CODE @GET ( a -- c f )
    DE POP,
    chkPS,
    A 0x03 LDri, ( @GET )
    0x28 RST,
    PUSHA, PUSHZ,
;CODE
( ----- 607 )
CODE @PUT ( c a -- f ) EXX, ( protect BC )
    DE POP,
    BC POP,
    chkPS,
    A 0x04 LDri, ( @PUT )
    0x28 RST,
    PUSHZ,
EXX, ( unprotect BC ) ;CODE
( ----- 609 )
: _err LIT" FDerr" ERR ;
: _cylsec ( sec -- cs, return sector/cylinder for given secid )
    ( 4 256b sectors per block, 10 sec per cyl, 40 cyl max )
    10 /MOD ( sec cyl )
    DUP 39 > IF _err THEN
    8 LSHIFT + ( cylsec )
;
: FD@! ( wref blk -- )
    1 @DCSTAT NOT IF _err THEN
    2 LSHIFT ( 4 * -- wr sec )
    4 0 DO ( wr sec )
        DUP I + _cylsec ( wr sec cs )
        I 8 LSHIFT BLK( + ( wr sec cs addr )
        1 ROT ROT ( wr sec drv cs addr )
        4 PICK EXECUTE NOT IF _err THEN
    LOOP 2DROP ;
( ----- 610 )
: FD@ ['] @RDSEC SWAP FD@! ;
: FD! ['] @WRSEC SWAP FD@! ;
: FD$ ['] FD@ BLK@* ! ['] FD! BLK!* ! ;

: CL$ 0x02 0xe8 PC! ( UART RST ) 0xee 0xe9 PC! ( 9600 bauds )
    0b01101100 0xea PC! ( word8 no parity RTS ) ;
: CL> BEGIN 0xea PC@ 0x40 AND UNTIL 0xeb PC! ;
: CL< BEGIN 0xea PC@ 0x80 AND UNTIL 0xeb PC@ ;
( ----- 612 )
( We process the 0x20 exception by pre-putting a mask in the
  (HL) we're going to write to. If it wasn't a 0x20, we put a
  0xff mask. If it was a 0x20, we put a 0x7f mask. )
: @GET,
    A 0x03 LDri, ( @GET )
    DE COM_DRV_ADDR LDdi,
    0x28 RST, JRNZ, L2 FWR ( maybeerror )
    A ORr,
    CZ RETc, ( Sending a straight NULL ends the comm. ) ;
: @PUT, ( @PUT that char back )
        C A LDrr,
        A 0x04 LDri, ( @PUT )
        0x28 RST, JRNZ, L3 FWR ( error )
        A C LDrr, ;
H@ ORG !
HL DEST_ADDR LDdi,                                    ( cont. )
( ----- 613 )
BEGIN,
    A 0xff LDri, (HL) A LDrr, ( default mask )
    L1 BSET ( loop2 ) @GET, @PUT,
    0x20 CPi, JRZ, L4 FWR ( escapechar )
	( not an escape char, just apply the mask and write )
    (HL) ANDr, (HL) A LDrr,
    HL INCd,
JR, AGAIN,
L4 FSET ( escapechar, adjust by setting (hl) to 0x7f )
7 (HL) RES, JR, L1 BWR ( loop2 )
L2 FSET ( maybeerror, was it an error? )
A ORr, JRZ, L1 BWR ( loop2, not an error )
L3 FSET ( error )
C A LDrr, ( error code from @GET/@PUT )
A 0x1a LDri, ( @ERROR ) 0x28 RST, RET,