Pascal on the 99/4A

[+Vorticon]

1 minute ago, TheBF said:

Very neat!  I have been distracted lately by another hobby but I really want to make one of these too.

So you are sending at 1200 bps with TerraTerm character delay set to zero?

Sending works at 2400bps. Receive struggles above 1200bps. I did not know there was a character delay option with Teraterm. I'll check it out.

[+TheBF]

Unfortunately it has a minimum 1mS delay so it really slows things down. However it let's you use higher baud rates.

 

[+Vorticon]

1 hour ago, TheBF said:

Unfortunately it has a minimum 1mS delay so it really slows things down. However it let's you use higher baud rates.

 

I tried it with a 1 msec delay and now it can receive at 2400bps. Thanks for the tip! 

I simplified the xmodem code a bit. Here's the updated listing and attached disk image.

 

Spoiler

{$i-}
(* xmodem file transfer utility *)
(* xmodem checksum only. xmodem crc not supported *)
(* by walid maalouli *)
(* march 2024 *)

program xmodem;
label
 1;

type
 byte = 0..255;

 byteword = record
  case boolean of
   true : (value : integer);
   false : (bytes : packed array[0..1] of byte);
  end;
  
 longint = record
  case boolean of
   true : (value : integer[4]);
   false : (intval : packed array[0..1] of integer);
  end;

var
 key, d : integer;
 send, timeout : boolean;
 fname : string;
 tfile : file;

function getkey : integer; external;
procedure setrs232(base : integer); external;
procedure getbyte(var n, flag : integer); external;
procedure sendbyte(n : integer); external;

procedure sendfile;
label
 1;

var
 i, j, flag, blocksin, buffloc, packet, tdata, comcode : integer;
 stime, itime : longint;
 block : array[0..131] of integer;
 buffer : array[0..255] of byteword;

begin (* sendfile *)
 packet := 1;
 buffloc := 0;
 while (not(eof(tfile))) or ((eof(tfile)) and (buffloc < 255) and
       (buffer[buffloc].bytes[0] <> 26)) do
  begin
   if buffloc = 0 then
    begin
     fillchar(buffer, 512, chr(26)); {fill buffer with padding character}
     blocksin := blockread(tfile, buffer, 1);
     buffloc := 0;
    end;

   (* set up transmission packet *)
   tdata := 0;
   block[0] := 1; {soh}
   block[1] := packet; {transmitted packet number}
   block[2] := 255 - packet;
   j := 3;
   while j < 131 do
    begin
     block[j] := buffer[buffloc].bytes[0];
     tdata := tdata + block[j];
     block[j + 1] := buffer[buffloc].bytes[1];
     tdata := tdata + block[j + 1];
     j := j + 2;
     buffloc := succ(buffloc);
     if buffloc > 255 then
      if not(eof(tfile)) then
       buffloc := 0
      else
       buffloc := 255;
    end; 
   block[j] := tdata mod 256; {checksum}

   (* send transmission packet *)
   1:
   for i := 0 to 131 do
    sendbyte(block[i]);

   time(stime.intval[0], stime.intval[1]); {start time}
   repeat
    getbyte(comcode, flag); {wait for remote ack or nak code}
    time(itime.intval[0], itime.intval[1]); {interval time}
    if (itime.value - stime.value) > 35 then {20 second timeout}
     begin
      timeout := true;
      exit(sendfile);
     end;
   until comcode in[6, 21];

   if comcode = 21 then {resend block if nak received}
    goto 1;

   gotoxy(15, 23);
   write(packet);
   packet := succ(packet);
  end;

 sendbyte(4); {send eot code}
 time(stime.intval[0], stime.intval[1]); {start time}
 repeat
  getbyte(comcode, flag); {wait for ack code}
  time(itime.intval[0], itime.intval[1]); {interval time}
  if (itime.value - stime.value) > 35 then {20 second timeout}
   begin
    timeout := true;
    exit(sendfile);
   end;
 until comcode = 6;
end; (* sendfile *)

procedure recvfile;
label
 1;

var
 i, flag, packet, tdata, buffloc, blocksin, errcount, comcode, data : integer;
 recerr, eotcode : boolean;
 block : array[0..127] of integer;
 buffer : array[0..255] of byteword;

begin (* recvfile *)
(* receive packet *)
 recerr := false;
 eotcode := false;
 buffloc := 0;
 errcount := 0;
 1:
 sendbyte(21); {send nak code}
 getbyte(comcode, flag); {receive soh code}
 if comcode <> 1 then
  recerr := true;
 repeat
  if buffloc = 0 then
   fillchar(buffer, 512, chr(26)); {fill buffer with padding character}
  tdata := 0;
  getbyte(data, flag); {receive packet number}
  packet := data;
  getbyte(data, flag); {receive inverse packet number}
  if (255 - packet) <> data then
   recerr := true;
  for i := 0 to 127 do
   begin
    getbyte(data, flag); {receive data segment}
    block[i] := data;
    tdata := tdata + block[i];
   end;
  getbyte(data, flag); {receive checksum}
  if (tdata mod 256) <> data then
   recerr := true;
  if recerr then
   begin
    errcount := succ(errcount);
    if errcount > 10 then
     begin
      timeout := true;
      exit(recvfile);
     end
    else
     begin
      recerr := false;
      goto 1;
     end;
   end;

(* process packet *)
  i := 0;
  while i < 128 do
   begin
    buffer[buffloc].bytes[0] := block[i];
    buffer[buffloc].bytes[1] := block[i + 1];
    i := i + 2;
    buffloc := succ(buffloc);
   end;
  if buffloc > 255 then
   begin
    buffloc := 0;
    blocksin := blockwrite(tfile, buffer, 1);
   end;
  gotoxy(18, 23);
  write(packet);
  errcount := 0;
  sendbyte(6); {send ack code}
  getbyte(comcode, flag); {receive soh or eot code}
  if comcode = 4 then
   eotcode := true
  else
   if comcode <> 1 then
    begin
     timeout := true;
     exit(recvfile);
    end;
 until eotcode;
 sendbyte(6); {send ack code}
end; (* recvfile *)

begin (* xmodem *)
 1:
 page(output);
 writeln('(R)eceive file');
 writeln('(S)end file');
 writeln('(Q)uit program', chr(7));
 repeat
  key := getkey;
 until key in[81, 82, 83];
 
 case key of
  81 : exit(program);
  82 : begin
        writeln('receive mode');
        send := false;
       end;
  83 : begin
        writeln('send mode');
        send := true;
       end;
 end;

 repeat
  gotoxy(0, 5);
  writeln('enter filename:', chr(7));
  readln(fname);
  if send then
   reset(tfile, fname)
  else
   rewrite(tfile, fname);
 until ioresult = 0;

 writeln(chr(10), chr(7), '1: rs232/1  2: rs232/2');
 repeat
  key := getkey;
 until key in[49, 50];
 if key = 49 then
  begin
   setrs232(1);
   writeln('using rs232/1');
  end
 else
  begin
   setrs232(2);
   writeln('using rs232/2');
  end;

 writeln(chr(10), chr(7), 'press any key to start transfer...');
 repeat
 until getkey <> 255;

 timeout := false;
 if send then
  begin
   gotoxy(0, 23);
   write('packets sent: ');
   sendfile;
  end
 else
  begin
   gotoxy(0, 23);
   write('packets received: ');
   recvfile;
  end;

 if timeout then
  begin
   gotoxy(0, 21);
   writeln(chr(7), 'transfer error!');
   for d := 1 to 2000 do
    begin
    end;
   timeout := false;
   close(tfile);
   goto 1;
  end;
  
 gotoxy(0, 13);
 writeln('transfer complete!', chr(7));
 writeln('press any key');
 if send then
  close(tfile)
 else
  close(tfile, lock);
 repeat
 until getkey <> 255;
 goto 1;

end. (* xmodem *) 

 

 

 

 

RSUTIL.dsk

[+TheBF]

Very nice. 

For perspective on potential speed of the hardware, using assembler for the primitive that reads the character like you have, with RTS/CTS handshaking I can send at 4800 bps to Forth and it echoes each character back.

I set Teraterm to put a 100mS delay after each linefeed to give the compiler time to swallow the line. It has never missed a character at that speed. 

 

If I am just stuffing each character into a buffer, using Forth I can't quite do 9600.

It misses a character now and then, but in Assembler it seems pretty solid at 19.2Kbps 

All this is without interrupts, just polling like you are doing. 

 

All that to say, if you created an assembly language "accept_chars" thing, that just stuffs characters into a buffer and keeps track of the length you can receive at up to 19,200 bps and never miss a character. 

And then with handshaking, I think Pascal could take care of processing each block at its own time. 

 

That's all I got. 

 

 

[+Vorticon]

7 hours ago, TheBF said:

All that to say, if you created an assembly language "accept_chars" thing, that just stuffs characters into a buffer and keeps track of the length you can receive at up to 19,200 bps and never miss a character. 

And then with handshaking, I think Pascal could take care of processing each block at its own time. 

 

Brilliant idea! I tried doing that but I can't seem to get it to work with any setting, so I must be doing something wrong.

I need to make sure the assembly routine I called GETPACKET is valid. Since I am sending an array as a parameter to that routine, I am assuming that the pointer to the array passed to the routine is pointing to element 0 and that each subsequent memory word is pointing to the next element. That's probably an @apersson850 question. Here is the relevant part of the routine. Interestingly, when I tried to add it to the RS232UTIL library, I got the error TOO MANY PROCEDURES, so I had to create a separate library for it. That one is new to me...

 

	mov *r10+,r1 ;get array pointer
    li	r2,132	;size of packet
	sbz	-27	;activate cts line
chkbuf  tb	21	;check if receive buffer is empty
	jne	chkbuf
 	clr	r6
	stcr	r6,8	;get byte
	sbz	18	;reset buffer
	swpb	r6
	mov	r6,*r1+	;store byte in array
	dec	r2
 	jne	chkbuf
	sbo	-27	;inactivate cts

 

[+TheBF]

You might not need this with the xmodem protocol but what I did was make a "timed" getchar loop that waits for each character but not forever.

That way when the data stream stops the code jumps straight into code that ends the communication. Just a thought.

 

Something to consider.  You can STCR directly into the buffer using indirect auto-inc. addressing and save instructions. 

  mov *r10+,r1 ;get array pointer
    li	r2,132	;size of packet
	sbz	-27	;activate cts line
chkbuf  tb	21	;check if receive buffer is empty
	jne	chkbuf
	stcr	*r1+,8	;get byte directly into buffer, inc address
	sbz	18	;reset buffer
	dec	r2
 	jne	chkbuf
	sbo	-27	;inactivate cts

 

Here is what I am using. I realize it's quite a different looking assembler  but maybe you can find something useful. ??

The IF statements can get confusing.  When translating them to Jumps the logic is usually opposite so:   EQ IF   is really  JNE instruction. Make sense? 

Spoiler

 \ STRAIGHT a word from PolyForth to accept chars fast, no echo
\ Tested at 19.2Kbps with NEW H/W Handshake Dec 22, 2020
\ The TMS9900 is pretty slow so it is unreliable above 9600 without RTS/CTS control

MARKER /STRAIGHT

HEX
CREATE ENDTRX   \ NATIVE SUB-ROUTINE
     C320 , CARD , \ CARD @@ R12 MOV,   \ select card
     1E05 ,        \ 5 SBZ,             \ CTS LOW, clear to send
     1D07 ,        \ 7 SBO,             \ LED OFF
     0300 , 0002 , \ 2 LIMI,
     C101 ,        \ R1 TOS MOV,
     NEXT,

.( .)
HEX \  ** decimal numbers used for UART bit no.s
CODE READCOM ( addr n -- n' )
 0300 , 0000 ,  \ 0 LIMI,              \ full attention
 C236 ,         \ *SP+ W MOV,          \ addr ->W   (ie: R8)
 A108 ,         \  W TOS ADD,          \ calc last address ->TOS
 0700 ,         \     R0 SETO,         \ set timeout register >FFFF
 04C1 ,         \     R1 CLR,          \ reset char counter
                \  BEGIN,
                \ * handshake hardware ON *
 C320 , CARD ,  \   CARD @@ R12 MOV,   \ select card
 1E05 ,         \   5 SBZ,             \ CTS LOW, clear to send
 1D07 ,         \   7 SBO,             \ led ON
 A320 , UART ,  \   UART @@ R12 ADD,   \ >1300+>40 = UART CRU
 1F15 ,         \   21 TB,             \ test if char in uart
 1609 ,         \   EQ IF,
 3638 ,         \       *W+ 8 STCR,    \ char to buff & inc buff
 1D12 ,         \        18 SBO,       \ clr UART rcv buffer
                \  * handshake hardware off *
 C320 , CARD ,  \       CARD @@ R12 MOV,  \ select card
 1D05 ,         \       5 SBO,            \ CTS line HIGH. I am busy!
 1E07 ,         \       7 SBZ,            \ led OFF
 0700 ,         \       R0 SETO,      \ reset timeout to 0FFFF
 0581 ,         \       R1 INC,       \ count char
 1004 ,         \   ELSE,
 0600 ,         \       R0 DEC,       \ no char, dec TIMEDOUT
 1602 ,         \       EQ IF,        \ expired?
 0460 , ENDTRX , \           ENDTRX @@ B,
                \       ENDIF,
                \   ENDIF,
 8108 ,         \   W TOS CMP,         \ W =   end of buffer?
 16E9 ,         \ EQ UNTIL,
 0460 , ENDTRX , \ ENDTRX @@ B,
ENDCODE
.( .)
HEX
\ STRAIGHT from PolyForth. Read n chars into addr or timeout
: STRAIGHT ( addr len -- n)
       CR ." Waiting..."
       1 /STRING OVER 1- ( -- addr+1 len' addr)
       KEY SWAP C!      \ WAIT for 1st Char & store
       READCOM
       CR ." Done! "
       OPEN-TTY KEY? DROP  \ serial port gets weird after fast upload ?
;

 

 

 

[apersson850]

10 hours ago, Vorticon said:

Since I am sending an array as a parameter to that routine, I am assuming that the pointer to the array passed to the routine is pointing to element 0 and that each subsequent memory word is pointing to the next element. That's probably an @apersson850 question. Here is the relevant part of the routine.

 

	mov *r10+,r1 ;get array pointer
    li	r2,132	;size of packet
	sbz	-27	;activate cts line
chkbuf  tb	21	;check if receive buffer is empty
	jne	chkbuf
 	clr	r6
	stcr	r6,8	;get byte
	sbz	18	;reset buffer
	swpb	r6
	mov	r6,*r1+	;store byte in array
	dec	r2
 	jne	chkbuf
	sbo	-27	;inactivate cts

Well, that's not all the relevant code, since we can't see how you declared the buffer you are using.

The pointer you get will be to where the buffer starts. In an array[0..5] of integer it's to index 0, but in an array[5..10] of integer it's to item 5 in the buffer.

Also, if you declare an array[0..80] of char, then each new value is one word away (two addresses, so MOV with autoincrement will track it. It's the same as an array[0..80] of integer. But a more common text buffer is a packed array[0..80] of char, in which case the index is by byte, so a MOVB with autoincrement will make it. Note that STCR will autoincrement by one up to eight bits transferred, then by two.

If the buffer is a string[80] the pointer will point to index 0, which is the length byte, and then index by one from there. The whole string is 81 bytes long and will occupy 82 bytes in memory.

 

This is a pseudo-declaration of a string.

type
  byte = 0..255;
  string = packed record
    length: byte;
    packed array[1..size] of char;
  end;

Packing in UCSD Pascal implies that the compiler will stuff things in words as tight as it can. So a packed array of char implies two chars per word, since they are eight bits each. You can also pack bytes per the definition above, since they are also eight bits. But if you define a data type as 0..511 and pack that, nothing happens, since each item is nine bits and thus two will not fit in a word. But one item of nine bits and two more, three bits each, will pack in a word with one unused bit left over.

Booleans pack well, of course, since you get 16 in a word instead of only one if they aren't packed.

Edited March 15 by apersson850

[+Vorticon]

9 hours ago, TheBF said:

You can STCR directly into the buffer using indirect auto-inc. addressing and save instructions.

Indeed, but I still need to SWPB prior to returning

 

3 hours ago, apersson850 said:

Well, that's not all the relevant code, since we can't see how you declared the buffer you are using.

These are the relevant lines on the host side

TYPE
 INTARRAY = ARRAY[0..131] OF INTEGER;
 
VAR
 BLOCK : INTARRAY;

PROCEDURE GETPACKET(PACKET : INTARRAY); EXTERNAL;

BEGIN
...
GETPACKET(BLOCK); 
...
END.

According to what you said then, this should work fine. In that case it must be a transmission issue somewhere. I'll do some more digging.

[Gary from OPA]

I recently found my two original P-Code cards for my TI99 systems and the full binders for them with the manuals. But sadly the original floppies are gone. I guess there archives of them on WHT, but I was wondering if there was any updated setups by fellow 99ers that add like 80 column support or new features.

[+Vorticon]

3 minutes ago, Gary from OPA said:

I recently found my two original P-Code cards for my TI99 systems and the full binders for them with the manuals. But sadly the original floppies are gone. I guess there archives of them on WHT, but I was wondering if there was any updated setups by fellow 99ers that add like 80 column support or new features.

The p-system is natively 80 columns, implemented on the TI with scrolling windows. It's effective enough once you get used to it. That said, support for the F18A would have been awesome though. 

It's not trivial to expand the system because the code is spread out between the ROMs and 2 different code pools (VDP and RAM) and minor changes can easily break it. Case in point being the Editor which practically uses nearly every last byte of the VDP. 

@apersson850 did expand his system with a 4th floppy drive and a couple of RAM disks as well as a hardware RTC, but it required some high level wizardry. One gets the feeling that the p-system was forcefully squeezed into the limited TI resources using every possible trick in the book at the expense of expansion flexibility. Still quite an achievement and by far the best development environment available at the time on the TI when emulation and cross-development were not available.

[apersson850]

42 minutes ago, Vorticon said:

Indeed, but I still need to SWPB prior to returning

 

These are the relevant lines on the host side

TYPE
 INTARRAY = ARRAY[0..131] OF INTEGER;
 
VAR
 BLOCK : INTARRAY;

PROCEDURE GETPACKET(PACKET : INTARRAY); EXTERNAL;

BEGIN
...
GETPACKET(BLOCK); 
...
END.

According to what you said then, this should work fine. In that case it must be a transmission issue somewhere. I'll do some more digging.

SWPB? That kind of depends.

Your own code is storing 132 received bytes into 132 words, not using half of the space available. You clear every second byte in the buffer.

@TheBF stores 132 received bytes into 132 bytes, leaving the remaining 132 bytes empty. Storing bytes in every byte is the normal procedure. The buffer is then ususally declared as a packed array[0..131] of char. I've not checked the details of your RSUTIL thing yet, but I presume you do math with the received characters? But a buffer declaration like this one will allow you do to math with every character and still store them as bytes.

type
  byte = 0..255;
  buffer = packed array[0..131] of byte;

 

[Gary from OPA]

54 minutes ago, Vorticon said:

The p-system is natively 80 columns, implemented on the TI with scrolling windows. It's effective enough once you get used to it. That said, support for the F18A would have been awesome though. 

It's not trivial to expand the system because the code is spread out between the ROMs and 2 different code pools (VDP and RAM) and minor changes can easily break it. Case in point being the Editor which practically uses nearly every last byte of the VDP. 

@apersson850 did expand his system with a 4th floppy drive and a couple of RAM disks as well as a hardware RTC, but it required some high level wizardry. One gets the feeling that the p-system was forcefully squeezed into the limited TI resources using every possible trick in the book at the expense of expansion flexibility. Still quite an achievement and by far the best development environment available at the time on the TI when emulation and cross-development were not available.

Ok, thanks for the update. I guess something to look into redoing for f18a or v9938 support. That going to take some rewriting. Add it to my growing list of coding projects.

 

Any available on what @apersson850did to at least add Ramdisk and the clock?

Edited March 15 by Gary from OPA

[Rhodanaj]

On 3/14/2024 at 2:37 PM, Vorticon said:

@Rhodanaj is looking into the possibility of allowing Pcode Tool to insert transferred files into existing disk images.

😊 and I have the first test programma ready ☺️

I do not have a real TI anymore, so I could only test it with some files i got from @Vorticon.

I have to do some more tests with Data files, but text and code files should go without problems.

When you try this version 'V6.0 - Test' and you have any problems, please let me know.

 

When you copy a PCode file from a virtual TI disk to Windows, with p-code-tool, the program will add 24 bytes with the file info at the end.

When you transfer a file by @Vorticon's program to Windows, there is no file info with it. So when you want to get this file into a virtual TI disk, you have to tell what kind of file it is (TEXT, CODE or DATA).

p-code-tool V6.0 - Test.exe

[+Vorticon]

Works great with xmodem transferred code and text files. Thank you!

Edit: transferred data files can be added to existing disk images with the Get Binary File option of Pcode Tool.

 

As a background, the whole purpose of creating the Xmodem utility was to allow for file transfers to the PC for backup or sharing purposes and the other way around, particularly when when it's only 1 or 2 files. Prior to Xmodem, the only way to transfer files to/from the pcode system was by using Fred Kaal's HDX system and the DSK2PC utility which transfers whole disks, a rather slow process requiring modifications to the RS232 card. The problem encountered with Xmodem transfers however was that the files were not recognized by Pcode Tool properly and so could not be imported into a disk image. This issue has now been solved

 

Pcode Tool is an invaluable utility for any pcode system user, so big thanks to @Rhodanaj for all his efforts. On a side note, I can definitely relate to his space-themed avatar icon 

[+Vorticon]

23 hours ago, Gary from OPA said:

Any available on what @apersson850did to at least add Ramdisk and the clock?

I'm sure he'll chime in on this and give you all the gory details  

[+TheBF]

10 hours ago, Vorticon said:

Prior to Xmodem, the only way to transfer files to/from the pcode system was by using Fred Kaal's HDX system and the DSK2PC utility which transfers whole disks, a rather slow process requiring modifications to the RS232 card. The problem encountered with Xmodem transfers however was that the files were not recognized by Pcode Tool properly and so could not be imported into a disk image.

I have been a X BASIC program that has Assembly language support to do XMODEM called "Magic File Manipulator for  6 years or so.

It works well and transfers at 19.2Kbps but it means leaving your current environment and going to BASIC.

 

Yours is available directly from Pascal which is ideal. I need a version for the same reason so that I can remain in Forth and transfer binary files.

You are an inspiration.

[+Vorticon]

23 hours ago, apersson850 said:

SWPB? That kind of depends.

Your own code is storing 132 received bytes into 132 words, not using half of the space available. You clear every second byte in the buffer.

@TheBF stores 132 received bytes into 132 bytes, leaving the remaining 132 bytes empty. Storing bytes in every byte is the normal procedure. The buffer is then ususally declared as a packed array[0..131] of char. I've not checked the details of your RSUTIL thing yet, but I presume you do math with the received characters? But a buffer declaration like this one will allow you do to math with every character and still store them as bytes.

type
  byte = 0..255;
  buffer = packed array[0..131] of byte;

 

Since the return subroutine stack returns words, not bytes, that is the reason for declaring an array of integers. I suppose I could pack 2 bytes into a register in the assembly receive routine before returning, but that adds more instructions and delays. Then I can declare a packed array of bytes. Not sure there is value in doing that since it complicates things. 

 

[+Vorticon]

2 minutes ago, TheBF said:

You are an inspiration.

Seems to me it's the other way around! But hey I'm always up for a little confidence building 😄

[+TheBF]

Just now, Vorticon said:

Since the return subroutine stack returns words, not bytes, that is the reason for declaring an array of integers. I suppose I could pack 2 bytes into a register in the assembly receive routine before returning, but that adds more instructions and delays. Then I can declare a packed array of bytes. Not sure there is value in doing that since it complicates things. 

 

That's why you would STCR each byte directly into memory with *Rx+.

Even it was a separate buffer you should be able to transfer that Assembly buffer to a Pascal packed array no?

[apersson850]

3 minutes ago, Vorticon said:

Since the return subroutine stack returns words, not bytes, that is the reason for declaring an array of integers.

I was thinking about if you make an assembly routine that fills a buffer, whatever the size, then it would make more sense filling it bytewise, not wordwise. I was thinking to abandon the single word return thing in this case. Go from characters to "lines".

[apersson850]

On 3/15/2024 at 2:46 PM, Gary from OPA said:

Any available on what @apersson850did to at least add Ramdisk and the clock?

Sure there is, but it's not very relevant for an 80 column adaption. As said, the p-system is already 80 columns - it can just only show 40 at the same time. The immediate issue I see with doing this on a real machine is that the screen related surbroutines (like display one half of the 80 column screen on the physical 40 column screen or print a character on the simulated 80 column screen) are in ROM on the p-code card. So they are a bit tricky to change.

Edited March 17 by apersson850

[Rhodanaj]

12 hours ago, Vorticon said:

On a side note, I can definitely relate to his space-themed avatar icon 

I have been reading the Perry Rhodan magazine ( https://en.wikipedia.org/wiki/Perry_Rhodan ) since 1970. 
In order to download the classic Doctor Who episodes from a site (Sharez org) around 2005, I needed a username to register and the first thing I thought of was the name Rhodan.
With AJ behind it from my own name 'Antoon Jansen', I had a unique username for that site.... (the icon is of course an image of Perry Rhodan himself)

Edited March 16 by Rhodanaj

[+Vorticon]

1 hour ago, TheBF said:

That's why you would STCR each byte directly into memory with *Rx+.

Even it was a separate buffer you should be able to transfer that Assembly buffer to a Pascal packed array no?

 

1 hour ago, apersson850 said:

I was thinking about if you make an assembly routine that fills a buffer, whatever the size, then it would make more sense filling it bytewise, not wordwise. I was thinking to abandon the single word return thing in this case. Go from characters to "lines".

Ah I think I understand where you guys are going with this. STCR directly to *R1+, and since it's a byte move, the autoincrement will increase the target memory by one byte so that I end up having a byte oriented buffer. No need for using another register (R6) at all and no byte manipulation. Then in the host program declare a packed byte array that would receive that buffer. Saves a few instructions in the receive routine which is always good. 

I'll make the changes and do some testing later today.

[+Vorticon]

I switched the Xmodem routines from byte to packet based send and receive and there is a definite increase in baud rate, but not nearly as much at @TheBF is reporting. For send I can go as high as 9600 bps, but for receive only 2400 bps remains reliable although I have managed a couple of 4800 bps transfers. I am not setting any character or line delays in Teraterm.

Below are the assembly routines, and they are as tight as I can make them, so it's unclear to me what else I can do.

;set of routines for packet reception for xmodem
;by walid maalouli
;March 2024

        .proc xsetrs232,1
; set up the rs232 card cru base
; 1 = CRU 1300H, 2 = CRU 1500H
; usage: setrs232(n)

        .def    cruadr,pmeret,procret,pcodeon,pcodoff,uartdis
        .def    rs232on,rs232of
        mov     r12,@pmeret     ;save the pme pointer
        mov     *r10+,r1        ;get desired RS232 card number
        ci      r1,1
        jne     rs2322
        li      r12,1300h
        li      r3,40h          ;uart base address displacement
        jmp     savecru
rs2322  li      r12,1500h
        li      r3,80h          ;uart base address displacement
savecru mov     r12,@cruadr     ;save base CRU address
        mov     r3,@uartdis     ;save uart base address displacement
        mov     @pmeret,r12     ;restore the pme pointer
        b       *r11
        
cruadr  .word
pmeret  .word
procret .word
uartdis .word

pcodeon li      r12,1f00h       ;activate the pcode card
        sbo     0
        mov     @pmeret,r12     ;retrieve the pme pointer
        b       *r11
        
pcodoff mov     r12,@pmeret     ;save the pme pointer
        li      r12,1f00h       ;deactivate the pcode card
        sbz     0
        b       *r11
        
rs232on mov     @cruadr,r12     ;load rs232 cru base
        sbo     0               ;turn card on
        sbo     7               ;turn card led on
        b       *r11
        
rs232of mov     @cruadr,r12     ;load rs232 cru base
        sbz     7               ;turn card led off
        sbz     0               ;turn card off
        b       *r11
        
        .proc   getpacket,1
;get an xmodem packet
;usage: getpacket(bytearray)

        .ref    pcodeon,pcodoff,rs232on,rs232of,uartdis,procret
        mov     r11,@procret
        bl      @pcodoff
        bl      @rs232on
        mov     *r10+,r1        ;get array pointer
        a       @uartdis,r12    ;uart base cru address
        li      r2,131          ;number of bytes to get
        sbz     -27             ;activate cts line
bufchk  tb      21              ;check if receive buffer is empty
        jne     bufchk
        stcr    *r1+,8          ;store byte into array
        sbz     18              ;reset buffer cru bit 21
        dec     r2
        jne     bufchk          ;132 bytes transferred?
        sbo     -27             ;inactivate cts line
        bl      @rs232of
        bl      @pcodeon
        mov     @procret,r11
        b       *r11
        
        .proc   sendpacket,1
;send an xmodem packet
;usage: sendpacket(bytearray)
        .ref    pcodeon,pcodoff,rs232on,rs232of,uartdis,procret
        mov     r11,@procret
        bl      pcodoff
        bl      rs232on
        mov     *r10+,r1        ;get array pointer
        a       @uartdis,r12    ;set uart base address
        li      r2,132          ;number of bytes to send
notconn tb      27              ;test dsr pin. is receiver connected?
        jne     notconn
        sbo     16              ;activate rts line
waitcts tb      28              ;wait for receiver to activate cts line
        jne     waitcts
chkbuf  tb      22              ;is emission buffer empty?
        jne     chkbuf
        ldcr    *r1+,8          ;send byte from array
        dec     r2              ;are all bytes sent?
        jne     waitcts
        sbz     16              ;inactivate rts line
        bl      @rs232of
        bl      @pcodeon
        mov     @procret,r11
        b       *r11
        
        .end

 

and here's the new XMODEM program

 

Spoiler

{$i-}
(* xmodem file transfer utility *)
(* xmodem checksum only. xmodem crc not supported *)
(* by walid maalouli *)
(* march 2024 *)

program xmodem;
label
 1;

type
 byte = 0..255;

 bytearray = packed array[0..131] of byte;

 byteword = record
  case boolean of
   true : (value : integer);
   false : (bytes : packed array[0..1] of byte);
  end;
  
 longint = record
  case boolean of
   true : (value : integer[4]);
   false : (intval : packed array[0..1] of integer);
  end;

var
 key, d : integer;
 send, timeout : boolean;
 fname : string;
 tfile : file;

function getkey : integer; external;
procedure setrs232(base : integer); external;
procedure getbyte(var n, flag : integer); external;
procedure sendbyte(n : integer); external;
procedure xsetrs232(xbase : integer); external;
procedure getpacket(var packet : bytearray); external;
procedure sendpacket(var packet : bytearray); external;

procedure sendfile;
label
 1;

var
 i, j, flag, blocksin, buffloc, packet, tdata, comcode : integer;
 stime, itime : longint;
 block : bytearray;
 buffer : array[0..255] of byteword;

begin (* sendfile *)
 packet := 1;
 buffloc := 0;
 while (not(eof(tfile))) or ((eof(tfile)) and (buffloc < 255) and
       (buffer[buffloc].bytes[0] <> 26)) do
  begin
   if buffloc = 0 then
    begin
     fillchar(buffer, 512, chr(26)); {fill buffer with padding character}
     blocksin := blockread(tfile, buffer, 1);
     buffloc := 0;
    end;

   (* set up transmission packet *)
   tdata := 0;
   block[0] := 1; {soh}
   block[1] := packet; {transmitted packet number}
   block[2] := 255 - packet;
   j := 3;
   while j < 131 do
    begin
     block[j] := buffer[buffloc].bytes[0];
     tdata := tdata + block[j];
     block[j + 1] := buffer[buffloc].bytes[1];
     tdata := tdata + block[j + 1];
     j := j + 2;
     buffloc := succ(buffloc);
     if buffloc > 255 then
      if not(eof(tfile)) then
       buffloc := 0
      else
       buffloc := 255;
    end; 
   block[j] := tdata mod 256; {checksum}

   (* send transmission packet *)
   1:
   sendpacket(block);
   time(stime.intval[0], stime.intval[1]); {start time}
   repeat
    getbyte(comcode, flag); {wait for remote ack or nak code}
    time(itime.intval[0], itime.intval[1]); {interval time}
    if (itime.value - stime.value) > 35 then {20 second timeout}
     begin
      timeout := true;
      exit(sendfile);
     end;
   until comcode in[6, 21];

   if comcode = 21 then {resend block if nak received}
    goto 1;

   gotoxy(15, 23);
   write(packet);
   packet := succ(packet);
  end;

 sendbyte(4); {send eot code}
 time(stime.intval[0], stime.intval[1]); {start time}
 repeat
  getbyte(comcode, flag); {wait for ack code}
  time(itime.intval[0], itime.intval[1]); {interval time}
  if (itime.value - stime.value) > 35 then {20 second timeout}
   begin
    timeout := true;
    exit(sendfile);
   end;
 until comcode = 6;
end; (* sendfile *)

procedure recvfile;
label
 1;

var
 i, flag, packet, tdata, buffloc, blocksin, errcount, comcode : integer;
 recerr, eotcode : boolean;
 block : bytearray;
 buffer : array[0..255] of byteword;

begin (* recvfile *)
(* receive packet *)
 recerr := false;
 eotcode := false;
 buffloc := 0;
 errcount := 0;
 1:
 sendbyte(21); {send nak code}
 getbyte(comcode, flag); {check if soh code received}
 if comcode <> 1 then 
  recerr := true;
 getpacket(block); {get 131 byte packet}
 repeat
  if buffloc = 0 then
   fillchar(buffer, 512, chr(26)); {fill buffer with padding character}
  tdata := 0;
  packet := block[0]; {packet number}
  {check if inverse packet number matches}
  if (255 - packet) <> block[1] then
   recerr := true;
  for i := 2 to 129 do
   tdata := tdata + block[i];
  {check if checksum correct}
  if (tdata mod 256) <> block[130] then
   recerr := true;
  if recerr then
   begin
    errcount := succ(errcount);
    if errcount > 10 then
     begin
      timeout := true;
      exit(recvfile);
     end
    else
     begin
      recerr := false;
      goto 1;
     end;
   end;

(* process packet *)
  i := 2;
  while i < 130 do
   begin
    buffer[buffloc].bytes[0] := block[i];
    buffer[buffloc].bytes[1] := block[i + 1];
    i := i + 2;
    buffloc := succ(buffloc);
   end;
  if buffloc > 255 then
   begin
    buffloc := 0;
    blocksin := blockwrite(tfile, buffer, 1);
   end;
  gotoxy(18, 23);
  write(packet);
  errcount := 0;
  sendbyte(6); {send ack code}
  getbyte(comcode, flag); {check if soh or eot received}
  if comcode = 4 then
   eotcode := true
  else
   if comcode <> 1 then
    begin
     timeout := true;
     exit(recvfile);
    end
   else
    getpacket(block);
 until eotcode;
 sendbyte(6); {send ack code}
end; (* recvfile *)

begin (* xmodem *)
 1:
 page(output);
 writeln('(R)eceive file');
 writeln('(S)end file');
 writeln('(Q)uit program', chr(7));
 repeat
  key := getkey;
 until key in[81, 82, 83];
 
 case key of
  81 : exit(program);
  82 : begin
        writeln('receive mode');
        send := false;
       end;
  83 : begin
        writeln('send mode');
        send := true;
       end;
 end;

 repeat
  gotoxy(0, 5);
  writeln('enter filename:', chr(7));
  readln(fname);
  if send then
   reset(tfile, fname)
  else
   rewrite(tfile, fname);
 until ioresult = 0;

 writeln(chr(10), chr(7), '1: rs232/1  2: rs232/2');
 repeat
  key := getkey;
 until key in[49, 50];
 if key = 49 then
  begin
   setrs232(1);
   xsetrs232(1);
   writeln('using rs232/1');
  end
 else
  begin
   setrs232(2);
   xsetrs232(2);
   writeln('using rs232/2');
  end;

 writeln(chr(10), chr(7), 'press any key to start transfer...');
 repeat
 until getkey <> 255;

 timeout := false;
 if send then
  begin
   gotoxy(0, 23);
   write('packets sent: ');
   sendfile;
  end
 else
  begin
   gotoxy(0, 23);
   write('packets received: ');
   recvfile;
  end;

 if timeout then
  begin
   gotoxy(0, 21);
   writeln(chr(7), 'transfer error!');
   for d := 1 to 2000 do
    begin
    end;
   timeout := false;
   close(tfile);
   goto 1;
  end;
  
 gotoxy(0, 13);
 writeln('transfer complete!', chr(7));
 writeln('press any key');
 if send then
  close(tfile)
 else
  close(tfile, lock);
 repeat
 until getkey <> 255;
 goto 1;

end. (* xmodem *) 

 

Still, I'm overall pretty happy with the results and it's fast enough for most transfers and much faster than whole disk transfers.

Updated disk image attached.

RSUTIL.dsk

[+TheBF]

Nice work.

Looking at your Assembly language code the only difference I see is that you put TB 21 in an infinite loop.

I used a timed loop that jumped out only when the characters stopped coming.

 

Not sure that makes a difference.  ??

Anyway I gotta get something going here now that you have set the bar.