SuperBASIC function to read a line?

Anything QL Software or Programming Related.
User avatar
ql_freak
Gold Card
Posts: 353
Joined: Sun Jan 18, 2015 1:29 am

SuperBASIC function to read a line?

Post by ql_freak »

Is there a SuperBASIC function to read a line?

It should work like this:

ch=4:open#ch,"file_or_device"
s$=READLN(#ch)

In the most simple implementation

1) s$ should be set even if EOF(#ch) occures (last line does not end with a new line character).
2) if the line is longer than 32767 characters only the first 32767 characters should be returned, the Filepointer is on next character,
so that it is possible to read the rest of the line into another string
3) if EOF(#ch) is detected or an empty line (<LF><LF>) an empty string must be returned "".

A better implementation should allow for an optional second parameter, which returns "special cases" e. g.:

-5 if line is longer than 32767 (buffer full)
-10 if end of file has occured

or instead of a second parameter, the function sets ERRNUM to one of the above values.

BTW: The INPUT command has a bug (IMHO), try the following SuperBASIC program:

Code: Select all

100 REMark Test for inputtin lines from a file:
190 :
200 c=4:file$="RAM1_Test_txt"
210 :
240 rorre=FOP_OVER(#c,file$)
250 IF rorre<>0
260   PRINT"Cannot open ";file$;" for writing"
270   GO TO 32757:REMark STOP
280 END IF
320 PRINT#c,"1 Dies ist die erste Zeile"
360 PRINT#c,"2 Dies ist Zeile zwei OHNE Newline(!)";
400 CLOSE#c:REMark STOP:REMark unREM the STOP to test manually on command line (#0)
440 :
500 rorre=FOP_IN(#c,file$)
510 IF rorre<>0:PRINT"Cannot open ";file$:GO TO 32757
540 IF NOT EOF(#c)
580   REPeat loop
600     s$=""
620     INPUT#c,s$
660     IF EOF(#c)
700       PRINT s$;:EXIT loop
740     ELSE
780       PRINT s$
790     END IF
860   END REPeat loop
870 END IF
880 :
890 PRINT"---"
32700 :
32757 REMark Line numbers > 32757 may cause problem with some versions of ED
It fails in line 620 with At line 620:1 end of file

IMHO a correct INPUT should return the string from the current file pointer up to the end of file, even if the last line does not end with a Linefeed character.


http://peter-sulzer.bplaced.net
GERMAN! QL-Download page also available in English: GETLINE$() function, UNIX-like "ls" command, improved DIY-Toolkit function EDLINE$ - All with source. AND a good Python 3 Tutorial (German) for Win/UNIX :-)
User avatar
pjw
QL Wafer Drive
Posts: 1286
Joined: Fri Jul 11, 2014 8:44 am
Location: Norway
Contact:

Re: SuperBASIC function to read a line?

Post by pjw »

ql_freak wrote:Is there a SuperBASIC function to read a line?
There are QDOS traps (io.flin and io.fstr) to do this, but these have not been carried through to S*BASIC, although Im sure there are toolkits out there..
PRINT and INPUT are intended for formatted IO and that means en EOL is expected. You could try using PUT and GET instead as in:

Code: Select all

100 REMark Test for inputtin lines from a file:
110 :
120 file$="RAM1_Test_txt"
130 :
140 c = FOP_OVER(file$)
150 IF c<0
160   PRINT"Cannot open ";file$;" for writing"
170   STOP
180 END IF
190 PUT#c,"1 Dies ist die erste Zeile"
200 PUT#c,"2 Dies ist Zeile zwei OHNE Newline(!)"
210 CLOSE#c:REMark STOP:REMark unREM the STOP to test manually on command line (#0)
220 :
230 c=FOP_IN(file$)
240 IF c < 0:PRINT"Cannot open ";file$: STOP
250   REPeat loop
260     IF EOF(#c): EXIT loop
270     GET#c; s$
280     PRINT s$
290   END REPeat loop
300 :
310 CLOSE#c
320 PRINT"---"
330 :
If you are uncertain of the format of the file you are reading (ie you didnt produce it yourself) you have to resort to some hefty footwork to get around it. In SBASIC (SMSQ/E) you could resort to WHEN ERRor etc

BTW GO TO and GO SUB are deprecated in S*BASIC, so ideally you should try to avoid them ;) The highest "legal" line number is 32766, I believe


Per
dont be happy. worry
- ?
User avatar
ql_freak
Gold Card
Posts: 353
Joined: Sun Jan 18, 2015 1:29 am

Re: SuperBASIC function to read a line?

Post by ql_freak »

pjw wrote:
ql_freak wrote:Is there a SuperBASIC function to read a line?
There are QDOS traps (io.flin and io.fstr) to do this, but these have not been carried through to S*BASIC, although Im sure there are toolkits out there..
Yes I'm looking for a toolkit, which has this (IMHO important) function.
pjw wrote:PRINT and INPUT are intended for formatted IO and that means en EOL is expected.
Yes, but IMHO EOF() should be treated also as EOF, else I had to read it with INKEY$() which is horrible slow (I'm afraid it is not buffered like e. g. fgetc() in C)).
And as far as I can remember PUT and GET is unformatted I/O. So I assume, that PUT writes first a word with the string length and afterwards the chars of the string. Get reads a word and afterwards the number of chars given by the word
pjw wrote: BTW GO TO and GO SUB are deprecated in S*BASIC, so ideally you should try to avoid them ;) The highest "legal" line number is 32766, I believe
I know of course. But I also know, that there were problems in some SuperBASIC implementations/versions when using STOP. So I use the GOTO 32757 to the end of the program. 32757 cause there are versions of ED (the TK2 SuperBASIC editor) which gets a headache when there are linenumbers > 32757 (sorry, don't know the source, where I have read this).


http://peter-sulzer.bplaced.net
GERMAN! QL-Download page also available in English: GETLINE$() function, UNIX-like "ls" command, improved DIY-Toolkit function EDLINE$ - All with source. AND a good Python 3 Tutorial (German) for Win/UNIX :-)
User avatar
ql_freak
Gold Card
Posts: 353
Joined: Sun Jan 18, 2015 1:29 am

Re: SuperBASIC function to read a line?

Post by ql_freak »

I have now found a toolkit, which has an

INPUT$([#c,] length)

function (s$ = INPUT$(#c,32765): REMark #c is optional, maximum allowed length is 32765, else error)

It is from my old friend Boris Jakubith from Berlin. After you have loaded it with LRESPR you must first enter

BTool_EXT

to enable it.

Then the slightly changed program (see my first message in this thread) will run perfectly:

Code: Select all

100 REMark Test for inputtin lines from a file:
190 :
200 c=4:file$="RAM1_Test_txt"
210 :
240 rorre=FOP_OVER(#c,file$)
250 IF rorre<>0
260   PRINT"Cannot open ";file$;" for writing"
270   GO TO 32757
280 END IF
320 PRINT#c,"1 Dies ist die erste Zeile"
360 PRINT#c,"2 Dies ist Zeile zwei OHNE Newline(!)";
400 CLOSE#c:REMark STOP:REMark unREM the STOP to test manually on command line (#0)
440 :
500 rorre=FOP_IN(#c,file$)
510 IF rorre<>0:PRINT"Cannot open ";file$:GO TO 32757
540 IF NOT EOF(#c)
580   REPeat loop
600     REMark s$=""
610 REMark  S e e   n e x t   l i n e   w i t h   t h e   f u n c t i o n   INPUT$([#channel,] MaxLength).
620     s$=INPUT$(#c,32765):REMark values > 32765 result in Error out of range(!)
630 REMark If <LF> or EOF() is found before the MaxLength, the characters before are returned :-) without Error
660     IF EOF(#c)
700       PRINT s$;:EXIT loop
740     ELSE
780       PRINT s$
790     END IF
860   END REPeat loop
870 END IF
880 :
890 PRINT"---"
32700 :
32757 REMark Line numbers > 32757 may cause problem with some versions of ED
Unfortunately it defines a lot of commands/functions, with the same names as TK2. Of course you can reenable the TK2 extensions with TK2_EXT, the program runs even after TK2_EXT (as TK2 doesn't have a SuperBASIC command/function with name INPUT$). But I'm afraid Turbo Toolkit does have a function INPUT$() - and Turbo Toolkit is essential for a lot of excellent Turbo compiled programs, e. g. The Editor.


http://peter-sulzer.bplaced.net
GERMAN! QL-Download page also available in English: GETLINE$() function, UNIX-like "ls" command, improved DIY-Toolkit function EDLINE$ - All with source. AND a good Python 3 Tutorial (German) for Win/UNIX :-)
User avatar
pjw
QL Wafer Drive
Posts: 1286
Joined: Fri Jul 11, 2014 8:44 am
Location: Norway
Contact:

Re: SuperBASIC function to read a line?

Post by pjw »

pjw wrote:The highest "legal" line number is 32766, I believe
I tested JS, Minerva, and SMSQ/E: It seems S*BASIC will accept 32767 as the highest line number. Some ED implementations have a problem after 327xx, but higher line numbers can still be entered manually. AUTO only goes negative after 32767. I was assuming that since DIM a$(32767) throws an error, while DIM a$(32766) doesnt, the same limit would apply to line numbers. But it wasnt so.

Per


Per
dont be happy. worry
- ?
User avatar
mk79
QL Wafer Drive
Posts: 1349
Joined: Sun Feb 02, 2014 10:54 am
Location: Esslingen/Germany
Contact:

Re: SuperBASIC function to read a line?

Post by mk79 »

I've got a small toolkit to wrap the raw I/O calls, too: https://www.kilgus.net/smsqe/sbasic-too ... lkit-chan/. Not sure if that fits your exact needs.


User avatar
ql_freak
Gold Card
Posts: 353
Joined: Sun Jan 18, 2015 1:29 am

Re: SuperBASIC function to read a line?

Post by ql_freak »

I don't know (more) exactly what IO.FLINE (what's the name in SMS/Q?) does do.

Will it return (with timeout -1) if it encounters an EOF without an EOL?

That's my problem.


http://peter-sulzer.bplaced.net
GERMAN! QL-Download page also available in English: GETLINE$() function, UNIX-like "ls" command, improved DIY-Toolkit function EDLINE$ - All with source. AND a good Python 3 Tutorial (German) for Win/UNIX :-)
User avatar
tofro
Font of All Knowledge
Posts: 2685
Joined: Sun Feb 13, 2011 10:53 pm
Location: SW Germany

Re: SuperBASIC function to read a line?

Post by tofro »

ql_freak wrote:I don't know (more) exactly what IO.FLINE (what's the name in SMS/Q?) does do.

Will it return (with timeout -1) if it encounters an EOF without an EOL?

That's my problem.
No. It will only return with timeout if it doesn't get anything within the specified timeout.

In case it gets something and it's terminated with EOL, it will return 0. (Normal return, the string will be everything it received, including the EOL character). There might be more to read, however.

In case it gets something that is not terminated with EOL, but reaches EOF first, it will return ERR_EOF, the string will be everything it received (obviously, not including any EOL). There's nothing more to read in this case.

Tobias


ʎɐqǝ ɯoɹɟ ǝq oʇ ƃuᴉoƃ ʇou sᴉ pɹɐoqʎǝʞ ʇxǝu ʎɯ 'ɹɐǝp ɥO
User avatar
pjw
QL Wafer Drive
Posts: 1286
Joined: Fri Jul 11, 2014 8:44 am
Location: Norway
Contact:

Re: SuperBASIC function to read a line?

Post by pjw »

ql_freak wrote:I don't know (more) exactly what IO.FLINE (what's the name in SMS/Q?) does do.

Will it return (with timeout -1) if it encounters an EOF without an EOL?

That's my problem.
You could try to find the answer with this experimenter:

Code: Select all

10 ch = FOP_IN('win1_prg_eg_LoremIpsum_txt'): REMark Some file
20 buff = 128:                                REMark Buffer size
30 adr = IOBInit(buff):                       REMark Initialise code and buffer
40 :
50 CLS
60 REPeat lp
70  er = IOBFMUL%(ch, adr, buff, -1, s$)
80  BPUT#1; s$
90  IF er < 0 AND er <> -5: EXIT lp
100 END REPeat lp
110 CLOSE#ch
120 RECHP adr
130 PRINT \ er
140 :
150 DEFine FuNction IOBInit(buff)
160 LOCal adr
170 adr = ALCHP(30 + 6 + buff)
180 POKE_L adr +  0, $CCFC0028,$DCAE0030,$20766800,$43EA0006
190 POKE_L adr + 16, $20014E43,$24803541,$47000
200 POKE_W adr + 28, $4E75
210 RETurn adr
220 END DEFine IOBInit
230 :
240 DEFine FuNction IOBFLIN%(ch, adr, buff, time%, str$)
250 REMark    d1  d2    d3     d4  d5  d6   d7  a0 a1     a2
260 CALL adr, 2, buff, time%,   0,  0, ch,   0,  0, 0, adr + 30
270 :
280 str$ = PEEK$(adr + 36, PEEK_W(adr + 34))
290 RETurn PEEK_L(adr + 30)
300 END DEFine IOBFLIN%
310 :
320 :
330 rem start
340 rem         mulu #$28,d6            pointer to channel table
350 rem         add.l $30(a6),d6        bv.chbas
360 rem         move.l 0(a6,d6.l),a0    set channel id
370 :
380 rem         lea.l 6(a2),a1          -> buffer (- len)
390 rem         move.l d1,d0            iob.fmul = 3 or iob.flin = 2
400 rem         trap #3
410 :
420 rem         move.l d0,(a2)          err ret
430 rem         move.w d1,4(a2)         len = bytes fetched
440 :
450 rem         moveq #0,d0
460 rem         rts
470 :
480 rem *
490 rem return
500 rem         ds.l 0
510 :
520 rem length
530 rem         ds.w 0
540 rem *
550 rem buffer
560 :
570 rem Warning: Address register A6 should not be used in routines called
580 rem using the CALL command. However, in SMSQ/E at least, it seems ok
:
Use at own risk! ;)


Per
dont be happy. worry
- ?
User avatar
ql_freak
Gold Card
Posts: 353
Joined: Sun Jan 18, 2015 1:29 am

Re: SuperBASIC function to read a line?

Post by ql_freak »

EDIT: 2016 Jan 20:
- bugfix in getline_bin (now V 0.91, the link below is updated)
- unittest_bas has now 5 tests

OK, a first (0.x but tested) version of my GETLINE$([#channel]) function (default channel is #1) is now online:

http://peter-sulzer.bplaced.net/ql/sbex ... ne0v91.bin

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


http://peter-sulzer.bplaced.net
GERMAN! QL-Download page also available in English: GETLINE$() function, UNIX-like "ls" command, improved DIY-Toolkit function EDLINE$ - All with source. AND a good Python 3 Tutorial (German) for Win/UNIX :-)
Post Reply