OK, a first (0.x but tested) version of my GETLINE$([#channel]) function (default channel is #1) is now online:
I would be pleased, if you test it. I have only tested it on QPC2. I'm especially interested, if it is compatible with the compilers (IMHO it should work even with Turbo) and if it runs on real QLs, especially unexpanded QLs. And for all 68k-Assembler experts: Would be nice if you will have a look at the source code (it is over commented, that's just for me, it wasn't so easy to restart in 68K Assembler after 20 years or so). I'm afraid there is a "fault": I use longword copy but doesn't test if the source is on a longword boundary before.
Can the 68020 copy longwords efficiently with move.l on non longword aligned adress, or does it then (internally) copy two words one after another?
It is the simple version. I reserve 32772 bytes on the S*BASIC stack. Fetch a line with IO.FLINE at BV.RIP-32772 and copy the fetched string so, that the last word of the string is at old BV.RIP-2, and then return the string as the function result.
This is not an optimum for unexpanded QLs, in the worst case more than 64 KBytes are required (for a line with 32766 - S*BASIC does not support strings with 32767 chars - characters): 32772 bytes on the S*BASIC stack plus the memory required for storing the string in a S*BASIC variable. Cause the space on the S*BASIC stack is only required temporarily, it is not so bad on expanded QLs. After GETLINE$() you should have a S*BASIC stack with a free capacity of 32772 bytes.
Here is the source with USAGE description and example (and below that a SuperBASIC unit test program):
Code: Select all
* SuperBASIC/SBASIC function string$ = GETLINE$([#channel]) - default channel: #1
* Version 0.91 - 2017 Jan 20
*
* Copyright (c) 2016/2017, Peter Sulzer, Fuerth (Germany) - ALL RIGHTS RESERVED
* Published under the GNU General Public License version 1 or newer see:
* https://www.gnu.org/licenses/
*
* To create the binary (I use the GST Macro Assembler, QUANTA edition) use:
* PROG_USE'DRVn_QmacDirectory_':DATA_USE'DRVn_GetlineSourceDirectory_'
* EX'qmac';'getline -nolink':REMark assuming source name is getline_asm
*
* Usage:
* LRESPR'getline_bin':REMark Initialize the GETLINE$() function for S*BASIC
* then you should use it (e.g. for copying a file) with:
* 100 OPEN_IN#4,'RAM1_test'
* 110 OPEN_OVER#5,'RAM1_testBak'
* 120 IF NOT EOF(#4)
* 130 REPeat loop
* 140 a$=GETLINE$(#4)
* 150 IF EOF(#4)
* 160 PRINT#5,a$;:EXIT loop
* 170 ELSE
* 180 PRINT#5,a$
* 190 END IF
* 200 END REPeat loop
* 210 END IF
* 220 CLOSE#4:CLOSE#5
*
* I.e. the GETLINE$() function reads until it finds a newline (LF, chr$(10))
* or EOF(). The trailing newline (LF) is stripped, except it is the last
* char of the file. This is because else the user has no chance to detect,
* if the last char was an LF or not. If you use GETLINE$() when the channel
* is already at EOF() S*BASIC stops with "end of file" error. I.e. you MUST
* ALWAYS test on EOF() BEFORE using GETLINE$()!
*
* Note: Maximum string length in SuperBASIC/SBASIC is only 32766 chars. So
* GETLINE$() returns at most 32766 chars. (Seems to be a bug in S*BASIC)
*
* WARNING (for users of unexpanded QLs):
* GETLINE$ needs at least 32772 bytes (on the SuperBASIC/SBASIC stack) plus
* the memory for storing the result in a S*BASIC variable, i.e. in the
* worst case more than 64 KByte. But the S*BASIC stack is only temporarily
* required. I. e. after GETLINE$() the S*BASIC stack has a free capacity of
* at least 32772 bytes. Normally the S*BASIC stack is only lessend (released)
* after a NEW or (eventually - don't know) a CLEAR command.
* Definitions:
MT.INF equ 0
IO.PEND equ 0 Check for pending input (test for EOF)
IO.FLINE equ 2
SV.JBPNT equ $64
SV.CHBAS equ $78
BP.INIT equ $110 Initialise SuperBASIC/SBASIC PROCedures and FuNctions
BV.CHBAS equ $30
BV.CHP equ $34
BV.RIP equ $58
CA.GTINT equ $112
BV.CHRIX equ $11a Vector: Allocate space on the S*BASIC stack
CH.LENCH equ $28 Length of a S*BASIC channel table entry
* Error messages:
ERR.NC equ -1 Not complete
ERR.OM equ -3 Out of memory
ERR.BO equ -5 Buffer full (Buffer overflow)
ERR.NO equ -6 Channel not found
ERR.EF equ -10 End of file
ERR.BP equ -15 Bad parameter
JB_RELA6 equ $16
CH_DRIVR equ 4 Pointer to device driver in channel def. block
* constants
LF equ 10 Linefeed
CONchan equ 1 d7=CONchan if channel is a CON channel
STRMAX equ $8004 Max. length of a QDOS string (32767)
* + padding byte + 1 longword (for speeding
* up copying to function return string)
* N O T E : At least in SuperBASIC/SBASIC the maximum string length
* seems to be limited to 32766. This seems to be a bug.
SECTION CODE
* Initialise SuperBASIC/SBASIC Extensions:
LEA PROC_DEF,A1
MOVE.W BP.INIT,A2 Note: In SMS(/Q) BP.INIT has a different name
jmp (A2)
PROC_DEF
DC.W 0 No of PROCedures (None!)
DC.W 0 END of definitition of PROCedures
DC.W 2 2 because Name of GETLINE$ is longer than 7 chars!
DC.W GETLINE-* FuNction GETLINE$(channel_number)
DC.B 8 Name of GETLINE$ is 8 characters long
DC.B 'GETLINE$',0 The characters (8) of GETLINE$ plus padding byte
DC.W 0 END of definitions of FuNctions
GETLINE
* S*BASIC FuNction GETLINE$([#channel])
bsr getChan get channel ID, bit 0 of d7 set if a CON channel
bne retBasic oops, channel does not exist, bad para, ...
* If it is a CON channel, we must not test for EOF (there is no EOF in
* a console channel), so branch to CONchan2:
cmp.w #CONchan,d7 Is it a con channel?
beq.s CONchan1 yes, so we must not test for EOF
moveq #IO.PEND,d0 are there any chars
moveq #-1,d3 (Timeout: wait forever)
trap #3 to read from channel?
tst.l d0
bne retBasic no (EOF). NOTE: user must checK for EOF
CONchan1
move.l #STRMAX,d1 reserve memory for string on...
resStack move.w BV.CHRIX,a2 ...the S*BASIC stack
jsr (a2) do it
tst.l d0
bne retBasic oops, couldn't get STRMAX bytes (out of memory?)
move.l BV.RIP(a6),a1 get S*BASIC stackpointer (a1 is relative to a6!)
move.l a1,a4 save it (will hold last char of returned string)
suba.l #STRMAX,a1 get base of memory for the chars of the
* string (the S*BASIC stack grows downwards)
move.l a1,a5 and save it
moveq #IO.FLINE,d0 prepare fetch a line of bytes (chars)
moveq #-1,d3 timeout: Wait forever
* N O T E : Super/SBASIC seems to have a bug, max string length seems to
* be 32766 (NOT 32767), so below we must subtract 6 instead of 5:
move.w #STRMAX-6,d2 length of buffer for the chars of the string
trap #4 make next trap#3 S*BASIC compatible
trap #3 fetch line
cmp.l ERR.NC,d0 oops, not complete (error cause we wait forever)
beq retBasic
cmp.l ERR.NO,d0 oops, channel not open
beq clrRelA6 so we must clear JB_RELA6 (set by trap #4)
* Error buffer overflow and end of file are no errors
move.l d1,d6 save string length (no. of fetched bytes)
* NOTE: We must again test for EOF for the case where the last char is a LF, BUT
* NOT if it is a CON channel, than (for CON channel) branch to CONchan2
clr.l d0 assume no error (needed for CON channels)
cmp.w #CONchan,d7 is it a CON channel?
beq.s CONchan2 yes, so we must not test for EOF
moveq #IO.PEND,d0 we must again test for EOF
moveq #-1,d3 wait forever
trap #3
CONchan2
move.l d6,d1 restore no. of bytes fetched
move.l a5,a1 restore base of our buffer
lea (a1,d6.w),a5 get pointer to last char+1 of returned string
* HINT: The (eventually error) result of previous Trap #3 is still in register d0
cmp.l #ERR.EF,d0 if EOF...
beq.s retStrOK ...return string as fetched by IO.FLINE
* if after reading the bytes EOF occures, we return the string as is, even if
* the last char is a LF (which normally is stripped), cause else the user has
* no chance to detect, if the last char read is a LF
cmpi.b #LF,-1(a5,a6.l) is last char a newline (LF)?
bne.s retStrOK no
subq.w #1,d6 ELSE strip the trailing LF fetched by IO.FLINE
subq.l #1,a5 and adjust pointer to last char+1
retStrOK
move.l d6,d1 save actual string length - we need d1 later!
cmpi.w #0,d1 empty string?
beq.s setLen (trivial)
* lea (a1,d6.w),a5 get pointer to last char+1 of returned string
btst #0,d1 if stringlength is...
beq.s evenlen ...even then a5 is also OK (points to even address)
addq.l #1,a5 but if it is odd, we must add a padding byte
* now we must copy the string, so that its last char is in word at -2(a4). As
* our buffer is one longword (4 bytes) longer than the maximum chars allowed
* for a QDOS string we can use long words for copying, which is much faster.
evenlen
* ENTRY:
* d1,d6: string length of fetched string
* d7 1 if it is a CON channel (currently other value 0 if no CON channel)
* a4 (a4,a6.l) S*BASIC (arithmetic) stack
* a5 (a5,a6.l) last char+1 of the fetched string (must be copied to
* (a4,a6.l) to make return string for GETLINE$()
cmp.w #2,d6 stringlength > 2?
bgt.s slenGt2 OK, a little bit more complicated...
subq.l #2,a5 a5 points now to start of fetched string
subq.l #2,a4 and now a4 to start of return string
move.w (a5,a6.l),(a4,a6.l) copy the word containing the char(s)
bra.s setLen and set string length of return string
slenGt2 cmp.w #4,d6 stringlength > 4
bgt.s slenGt4 OK, even more complicated...
subq.l #4,a5 a5 points now to start of fetched string
subq.l #4,a4 and now a4 to start of return string
move.l (a5,a6.l),(a4,a6.l) copy longword containing the chars
bra.s setLen and set string length of return string
slenGt4
* Here starts the complicated stuff:
* We have now a string which is at least 5 chars (1 longword + x byte(s)) long(!)
* This means we can copy longwords (much faster than copying only bytes or words.
* But please see "NOTE 1)" at the end of this file(!)
* NOTE: d1 should still hold the stringlength of the fetched string(!)
btst #0,d6 is stringlength odd
beq.s lenEven no
addq.w #1,d6 ELSE we need a padding byte
lenEven btst #1,d6 is stringlength divisible by 4?
beq.s copyLong no, then we must only copy longwords
subq.w #2,d6 ELSE we must first
subq.l #2,a5 copy
subq.l #2,a4 a
move.w (a5,a6.l),(a4,a6.l) word
copyLong
lsr.w #2,d6 d6=d6/4 (= no. of longwords to copy)
subq.w #1,d6 but dbf-loop instruction tests for -1 (NOT 0)(!)
loopLong subq.l #4,a5 a5=next longword of source we must copy
subq.l #4,a4 a4=next longword of destination, to where we
move.l (a5,a6.l),(a4,a6.l) must copy the longword
dbf.w d6,loopLong are there more longwords to copy, then do
setLen
subq.l #2,a4 make room for the length word
move.w d1,(a4,a6.l) set the length/make a QDOS string and
move.l a4,a1 both ( (a6,a1.l) and BV.RIP(a6) must point to TOS
move.l a1,BV.RIP(a6) let the S*BASIC stack point to it (return string)
moveq #1,d4 signal that we return a string
clr.l d0 d0=0, i.e. no error
retBasic
rts back to SuperBASIC/SBASIC
clrRelA6
move.l d0,d6 save error return value
moveq.l #MT.INF,d0 get SV.BASE; as a0 holds an...
trap #1 ...invalid channel id, it must not be saved
adda.l #SV.JBPNT,a0 get job control block of...
move.l (a0),a0 our (this) job
bclr.b #7,JB_RELA6(a0) and clear the relative to A6-Bit
move.l d6,d0 restore error return value
rts
getChan
* Get QDOS channel from S*BASIC channel:
* return a0: channel id; d7=1 if a CON channel (console channel)
moveq #1,d6 default is #1
cmpa.l a3,a5 any parameters?
beq.s chanLook ... no
btst #7,1(a6,a3.l) hast 1st parameter a hash?
beq.s errBp no (Bad parameter)
move.l a5,-(a7) save top parameter pointer
move.l a3,a5 temporary set
addq.l #8,a5 ... top to 8 bytes above first parameter
move.l a5,-(a7) when parameter fetched, it's new first para
move.w CA.GTINT,a2
jsr (a2) get S*BASIC channel number
move.l (a7)+,a3 restore "new" first parameter(doesn't alter
move.l (a7)+,a5 restore last parameter condition codes)
bne.s chanExit no integer (channel number) could be fetched
move.w 0(a6,a1.l),d6 replace default #1 with result from CA.GTINT
cmp.l a3,a5 if there are more parameters
bne.s errBp return with Bad parameter
addq.l #2,a1 reset the S*BASIC..
move.l a1,BV.RIP(a6) ... stack to its value on entry to getChan
chanLook
* code similar to "The Sinclair QDOS companion" page 127
move.l BV.CHBAS(a6),a0 start of S*BASIC channel table
mulu #CH.LENCH,d6 make a pointer to an entry...
add.l d6,a0 ...in the S*BASIC channel table
cmp.l BV.CHP(a6),a0 is it within the table?
bge.s errNo no
move.l 0(a6,a0.l),d6 get channel id
blt.s errNo but entry in S*BASIC channel table is closed
* Now look if channel is a CON channel (console channel)
* WARNING: This is simply done by comparing it with channel 0, which on
* QDOS should never be closed. If channel 0 will be closed, THIS
* DOES NOT WORK(!):
moveq #MT.INF,d0
trap #1
moveq #0,d7 Default: No CON channel (IMPORTANT!)
move.l SV.CHBAS(a0),a0 let a0 point to base of channel table
move.l (a0),a4 a4=channel definition block of channel 0
move.l CH_DRIVR(a4),d5 d5=driver of channel 0
move.w d6,d4 no in channel table (longword = 4 bytes) to
asl.w #2,d4 to offset to our channel definition block in d4
move.l (a0,d4.w),a4 a4=channel definition block of our channel
move.l CH_DRIVR(a4),d4 d4=driver of our channel
cmp.l d5,d4 is our channel a CON channel
bne.s setChId no
moveq #CONchan,d7 store that it's a CON channel in d7
setChId move.l d6,a0 channel id must be in a0
moveq #0,d0 no error
rts
errNo
moveq #ERR.NO,d0 channel not open
chanExit rts
errBp moveq #ERR.BP,d0
rts
END This signals to QMAC that this is the end
* Anything after the END directive (which doesn't produce any code) is ignored
* NOTE 1):
* Well albeit we know, that we have now more than one longword, which must be
* copied, it's IMHO not sure, that our hardware really copies longwords for
* an instruction like:
*
* move.l (a5,a6.l),(a4,a6.l)
*
* This is because we don't know before the IO.FLINE-call to QDOS (SMS/Q) how
* many bytes were fetched.
*
* Assume the current stack pointer (the word below will hold the last char
* of the return string) points to a long word boundary and a5 (the base of
* our buffer, i. e. the start of the string fetched with IO.FLINE) also
* points to a long word boundary, but the stringlength fetched is not
* a multiple of 4... Then we have no chance, that both (a4 and a5) point
* to a long word boundary. As we don't know before, how long the string
* will be (we stop at the first LF (or EOF) which we detect), we have
* absolutely no chance to align source (a5) and destination (a4) to longword
* boundaries.
*
* Albeit it seems the 68020 (this is absolutely no problem on
* 68000 and 68008 with 16 or 8 bit databus) supports move.l even if source
* and destination are not both on a longword boundary, I'm afraid, in this
* case the copying would be much more slowly, than if both point to a longword
* boundary.
*
* But because we don't know before, how long the fetched string wll
* be, we have no chance, to align both to longword boundary. This is because
* we must copy the string from the end, as the S*BASIC stack grows downwards
* and AFAIK the S*BASIC stack is NOT long word aligned (an int takes just one
* word). If it would be longword aligned, this function could be speeded
* up. But even better would be, the S*BASIC stack wouldn't grow downwards,
* but upwards. In this case the copying of the returned string wouldn't be
* necessary, and our function (GETLINE$()) would be much faster.
A unit test program for GETLINE$(). Now renumbered with step size 1. This is because you MUST NOT CHANGE ANYTHING INSIDE THE EXISTING UNIT TESTS, you may of course add your own unittests at the end. When you will do any changes at getline_asm, the first thing you should do is running unnittest_bas. All tests (currently 5) must pass(!):
Code: Select all
100 REMark Unit tests for GETLINE$() FuNction
101 REMark N O T E : Max Super/SBASIC string length is only 32766 NOT 32767 (bug?)
102 c%=1:REMark Listing channel
103 file$="RAM1_test":ch=4
104 i%=0
105 maxFileSize=HEX("7fffffbf"):REMark Largest value for setting file pointer with PUT#ch\filepointer
106 s64$='AaBbCcDdEeFfGgHhIiJjKkLlMmNnOoPpQqRrSsTtUuVvWwXxYyZz0123456789--':REMark len=64
107 :
108 PRINT#c%,'Unit Tests for GETLINE$() Function'
109 OPEN_OVER#ch,file$
110 tst$="Hello, world!":PRINT#ch,tst$
111 CLOSE#ch
112 OPEN_IN#ch,file$
113 a$="x"
114 REMark Next (evt. commented) line should give an error, if file is empty:
115 REMark PRINT#c%,'Test passed if Error "end of file"':a$=GETLINE$(#ch)
116 IF NOT EOF(#ch):a$=GETLINE$(#ch)
117 CLOSE#4
118 REMark N O T E : If the last char of file is a LF, it will not be stripped. Normally (not at EOF()) the trailing LF is stripped.
119 i%=i%+1
120 IF a$=tst$&CHR$(10)
121 PRINT#c%,"Test ";i%;" passed"
122 ELSE
123 PRINT#c%,"Expected:"\'"';tst$&CHR$(10);'" but got:'\'"';a$;'"'
124 END IF
125 DELETE file$:OPEN_NEW#ch,file$
126 FOR i=1TO 511
127 PRINT#ch,s64$;
128 END FOR i
129 PRINT#ch,s64$(1TO 62);
130 CLOSE#ch:REMark Now we have a file with 32766 chars without an LF in it
131 OPEN_IN#ch,file$
132 a$=GETLINE$(#ch)
133 tstart$=a$(1TO 64)
134 tend$=a$(LEN(a$)-61TO)
135 i%=i%+1
136 IF tstart$=s64$ AND tend$=s64$(1TO 62) AND LEN(a$)=32766
137 PRINT#c%,"Test ";i%;" passed"
138 ELSE
139 PRINT#c%,"Test ";i%;" (reading file with"\"32766 bytes without LF) failed"
140 END IF
141 CLOSE#ch
142 flength=FLEN(\file$)
143 OPEN#ch,file$:PUT#ch\maxFileSize:REMark Open for appending
144 test$="Now we have a file with 32826 characters without a LF in it!":PRINT#ch,test$;
145 CLOSE#ch
146 OPEN_IN#ch,file$
147 a$=GETLINE$(#ch):b$=GETLINE$(#ch)
148 tstart$=a$(1TO 64)
149 tend$=a$(LEN(a$)-61TO)
150 i%=i%+1
151 IF tstart$=s64$ AND tend$=s64$(1TO 62) AND LEN(a$)=32766AND b$=test$
152 PRINT#c%,"Test ";i%;" passed"
153 ELSE
154 PRINT#c%,"Test ";i%;" (reading file with"\"32826 bytes without LF) failed"
155 END IF
156 CLOSE#ch
157 DELETE file$:OPEN_NEW#ch,file$
158 PRINT#ch,"This is a test"
159 REMark 12345678901234 + LF(because after GETLINE$(#ch) we are at EOF)
160 CLOSE#ch:OPEN_IN#ch,file$
161 a$=GETLINE$(#ch)
162 CLOSE#ch
163 i%=i%+1
164 IF a$="This is a test"&CHR$(10)
165 PRINT#c%,"Test ";i%;" passed"
166 ELSE
167 PRINT#c%,"Test ";i%;" reading with LF as last char failed"
168 END IF
169 DELETE file$:OPEN_NEW#ch,file$
170 test$="Hello"&CHR$(10)&"QDOS-"&CHR$(10)&"world"
171 PRINT#ch,test$;
172 a$="":b$=""
173 PRINT#ch,a$;
174 CLOSE#ch:OPEN_IN#ch,file$
175 IF NOT EOF(#4)
176 REPeat loop
177 b$=GETLINE$(#ch)
178 IF EOF(#ch)
179 a$=a$&b$:EXIT loop
180 ELSE
181 a$=a$&b$&CHR$(10)
182 END IF
183 END REPeat loop
184 END IF
185 CLOSE#ch
186 i%=i%+1
187 IF a$=test$
188 PRINT#c%,"Test ";i%;" passed"
189 ELSE
190 PRINT#c%,"Test ";i%;" for file with multiple lines failed"
191 END IF