The front page

LOADING BINARY & BBCBASIC PROGRAMS FROM A PC DIRECTLY INTO THE EINSTEIN'S MEMORY

By Chris Coxall

Below are four bbcbasic listings. Three for BBCBASIC run on the einstein and one for BBCBASIX a bbcbasic which runs on the PC. It can be downloaded from "www.bbcbasic.com".

Each of listings should be able to be selected by the mouse, copied to clipboard, pasted into Notepad and saved as text files.

HARDWARE REQUIREMENTS

A null modem link between the Einstein and PC. Hardware handshaking needed.

PC SOFTWARE

Win95/98 Hyper Terminal. Settings: the com port used, bits per second 9600, 8 data bits, 0 parity, 2 stop bits and flow control Hardware.

PROGRAMS

PCKEYS

LISTING
A BBCB BASIC program for the Einstein TC01 which when run will get bbc basic keyboard input from a PC's win95/98 Hyper Terminal.
BBC basic listings saved as text files on a PC can then be loaded into the Einstein by using "SEND TEXT FILE" from theHyper Terminal's "TRANSFER" drop down menu.

REACOUT.BBC for the Einstein
LISTING

When run this program will display the directory of all files on the Einstein's current default drive. It will prompt for a file name to be typed in. Ideally a *.com or binary file. File information, a "/" , then an ascii hex dump of the file sent followed by an "=" and more file information will be sent to the PC's Terminal. By using "CAPTURE TEXT" these files can be saved on a PC. Later they can be sent back to the Einstein loaded with "SRLRUN.COM" a com file created by "SRLRUN.BBC" a bbcbasic assembly program.

SRLRUN.BBC

LISTING
A bbcbasic assembly program for the Einstein which will create "SRLRUN.COM" on the Einstein's default drive. This can be used to download back "*.com" files sent as an ascii text hex dump from the Einstein by READCOUT.COM.

SRLRUN.COM is loaded from the DOS prompt. It will just sit on the Einstein's screen until an ascii hex file created READCOUT.BBC is downloaded from a PC. It will translate the hex back into code, load it into the 'TRANSIENT PROGRAM AREA" call and run the program. No need to load it on an Einstein disc first.

SRLLOAD.COM. For loading a program into memory and not running create srlload.com by changing:

line 40 to
40 *SAVE SRLRUN.COM E900 EA34
line 1520 to
1520 .LEP JP &0000
Srlload.com will load a transferred file into the Einstein then reboot. The file can then be run by the XTAL DOS command "GO" or put on disk by the XTAL DOS command SAVE <NUMBER OF BLOCKS> <FILENAME.EXT>.

READCOUT.BBC for BBCBASIX run on the PC.

LISTING
Readcout.bbc for the PC will open a binary Z80 file for the Einstein, i.e. a CP/M 2.2 com file downloaded from the net, and send it to SRLRUN or SRLLOAD running on the Einstein.

EXAMPLE DOWNLOAD for a CP/M program that will run on the Einstein.

MBASIC.COM at "http://www.retroarchive.org/cpm/lang/lang.htm"


PCKEYS

Loading a bbcbasic listing from a text file on the PC. The Hyper Terminal can be used as keyboard input for the Einstein loaded with bbcbasic. This might be done by poking address &3a4b. It works with BBCBASIC Version 2.31 & XtalDOS 1.31 try the command below

?&3A4B=&A1 <ENTER>

Press some keys on the PC keyboard if the characters appear on the Einstein screen it has worked. Unfortunately although ok for key presses there is not any hardware handshaking and the transfer is too fast to make it suitable for downloading ascii text listings. There is no need to change baud rates. In the Hyper Terminal click the file menu, properties, the settings tab, the "ASCII setup" then change line delay to 5 milliseconds and character delay to 2 milliseconds.

Try sending PCKEYS listing from a text file to the Einstein. Type "LIST <ENTER> on the pc keyboard. If the listing looks ok on the Einstein screen. Type "RUN <ENTER> on the pc keyboard. You will have to look at the Einstein's screen or you could type *OPT 1 enter first for output to the terminal. Now go back to the Hyper Terminals ASCII setup and put line feed delay back to 0 milliseconds and character delay back to 0. Fast downloading should now be possible.

When run PCKEYS assembles a new machine code routine for hardware hand shaking above HIMEM and creates a jump from within the bbcbasic program.

Only run PCKEYS once otherwise HIMEM will keep being altered. Use "GOTO 10" for additional runs if desired. Clear PCKEYS from bbcbasic before sending basic listings files from the terminal. Programs loaded this way are put into bbcbasic as if typed on the keyboard. Old program line numbers which are not over written will be inserted into the downloaded program if the "NEW" command is not used first.

PCKEYS LISTING

 
    1 HIMEM=HIMEM-&20
   10 GOSUB 70
   20 PRINT"START  "
   30 GOSUB 80
   50 STOP
   70 BEGIN=HIMEM+1
   80 CODE=BEGIN
   90 P%=CODE
  100 [
  110 PUSH AF
  120 LD A,&27
  130 OUT (&11),A
  140 POP AF
  150 LD (&FBB2),A
  160 RST &08
  170 DEFB &A1
  180 PUSH AF
  190 LD A,&07
  200 OUT (&11),A
  210 POP AF
  221 RET
  230 ]
  240 SECOND=&3A47
  241 CODE =SECOND
  242 P%=SECOND
  250 [
 1891 .SECOND CALL BEGIN
 1892 RET
 1900 ]
 1910 RETURN
 9000 REM goto 9010 to get input from the Einstein keyboard.
 9010 SWOP=HIMEM+&B:?SWOP=&9C
 9020 STOP
 9100 REM goto 9110 to get input from PC keyboard.
 9110 SWOP=HIMEM+&B:?SWOP=&A1
 9120 STOP


READCOUT LISTING for the Einstein.

10 REM READCOUT.BBC for the Einstein.
   15 *.*.*
   20 PRINT"TYPE FILE NAME TO READ"
   30 INPUT A$:PRINT A$
   40 X=OPENIN(A$)
   50 L=EXT#X:PRINT,"LENGTH ";L
   60 PRINT"FILE NUMBER ";X
   70 *OPT 1
   80 PRINT A$,"BLOCKS ";L/256
   81 REM delete rem from next line to send bbcbasic files as hex dumps for srlrun.
   82 REM PRINT"LOAD BBC FILE AT HEX ~4000"
   90 PRINT "hex dump for comfile \"
  100 FOR I=1 TO L
  110   Y=BGET# X
  120   IF Y<&10 THEN PRINT"0";
  130   PRINT;~Y;
  140 NEXT I
  150 PRINT"="
  160 *OPT 0
  170 CLOSE# X
  180 PRINT:PRINT"FILE ";A$,"FILE NUMBER ";X,"LENGTH ";L
  190 *OPT 1
  200 PRINT:PRINT"FILE ";A$'"LENGTH ";L,"BLOCKS ";L/256
  210 *OPT 0


SRLRUN LISTING bbcbasic for the Einstein.

10 GOSUB 90
   20 PRINT" START"   
   30 GOSUB 100
   40 *SAVE SRLRUN.COM E900 EA34
   70 STOP
   90 BEGIN=&E900
  100 CODE=&E900
  110 P%=CODE
  120 [OPT 1
  130 .BEGIN LD BC,&0132; load BC the number of bytes to move.
  140 LD DE,&E912; DE the address to move to.
  150 LD HL,&0112; HL the address to move from
  160 LDIR
  170 JP LAD_ADDS; jump and run srlrun.com from its new location &E916.
  180 NOP
  190 NOP
  200 NOP
  210 RET
  220 .RN DEFW &0100; store address to download starting at.
  230 .SAFE DEFW &E8FE; fail safe to stop downloading over running SRLRUN.COM.
  240 .LAD_ADDS LD HL,(SAFE); 
  250 LD DE,(RN) ; 
  260 CALL CHK_IN ; a routine to clear serial port buffer.
  270 .CHK_START CALL RTS_ON ; handshaking allow PC to download.
  280 CALL RECEIVE ; a routine to wait for next byte from serial input.
  290 IN A,(&10) ; put serial input into A reg.
  300 LD DE,(RN) ; load DE with address to load at.
  310 CALL RTS_OFF ; set RTS on to hold flow of serial input from PC.
  320 CP 126 ; compare A to  ~" ascii 126
  330 CALL Z,LAD_START ; routine to change DN store according to next 4   hex ascii bytes from serial input.
  340 CP 92 ; compare A reg with  / 
  350 LD DE,(RN) ; load DE new start address if changed.
  360 CALL Z,LAD_PROG ; routine that converts and loads hex list into Einstein. 
  370 JR CHK_START ; loop back
  380 RET
  390 .CHK_IN PUSH AF ; routine to clear bytes not wanted for loading.
  400 CALL RTS_ON
  410 .CHKO IN A,(&10);clear buffer
  420 IN A,(&11) ; read 8521A USART register.
  430 BIT 1,A ; see if bit 1 = 0.
  440 JR NZ, CHKO ; if not jump back and clear next byte.
  450 POP AF
  460 RET
  470 .LAD_START PUSH AF ;routine to change address where code will be loaded.
  480 CALL  GT_BYTE ; download next two ascii hex bytes convert to real byte
  490 LD D,A ; real byte returned in A reg. then loaded into D reg.
  500 CALL H_PRINT ; routine convert real byte back to ascii and eco to PC terminal.
  510 CALL GT_BYTE ; get next real byte.
  520 LD E,A ; put second byte into E reg.
  530 CALL H_PRINT ; echo second byte to PC.
  540 LD (RN),DE ; store DE for new address to down load to.
  550 POP AF
  560 RET
  570 .LAD_PROG ADD A,00 ; routine to load code into Einstein.
  580 DEC A
  590 DEC A
  600 PUSH HL
  610 PUSH DE
  620 SBC HL,DE ; check to see if loading over runs.
  630 JR Z NO_START ; if so jump to abort
  640 POP DE
  650 POP HL
  660 CALL GT_BYTE; GET TWO ASCI HEX BYTES FOR REAL BYTE
  670   LD (DE),A ; returned byte in A reg. loaded at address given by DE
  680   CALL ECO ; echo loaded byte back to PC terminal.
  690   INC DE ; get next address to load next byte.
  700   JR LAD_PROG ; loop back
  710   RET
  720   .NO_START RET ; fail safe finish.
  730   .GT_BYTE PUSH HL ; the routine to download two hex ascii bytes for real byte.
  740   PUSH DE
  750   CALL RTS_ON ; set handshaking on.
  760   .BACK CALL RECEIVE ; routine to check if new byte has been received in 8251A buffer.
  770   IN A,(&10) ; returned new byte in A reg.
  780   CP 71 ; compare A to  G 
  790   JR NC,BACK ; if A greater than 71-ascii G or higher jump back get next byte.
  800   CP 48 ; compare A to  0 
  810   JR C,BACK ; if A smaller than 48 jump back and get next byte.
  820   CALL RTS_OFF ; hardware handshaking to hold down load from PC.
  830   CP 61 ; compare A reg.(next byte) to  = 
  840   JR Z,INEND ; if so program down load complete jump to end.  
  850   CP &40 ; compare A to  @  ascii character before   A 
  860   JR C,WR1 ; jump if A value less than &40-for digits 1 to 9 
  870   AND &DF
  880   SUB 07 ; standardize character code.
  890   .WR1 ADD A,A ; shift A one hex digit left
  900   ADD A,A ; so &30 becomes 00
  910   ADD A,A
  920   ADD A,A
  930   PUSH HL ; store HL
  940   LD L,00
  950   LD H,00
  960   LD H,A ; H=first hex digit * 16
  970   CALL RTS_ON ; hand shaking allows serial input
  980   .BACK2 CALL RECEIVE ; checks for new byte received.
  990   IN A,(&10) ; serial input returned in A reg.
 1000   CP 71 ; compare A to  G .
 1010   JR NC,BACK2 ; if G or Higher jump back and get next byte.
 1020   CP 48 ; compare A to  0 
 1030   JR C,BACK2 ; if not  0  and ascii characters less than 48.
 1040   CALL RTS_OFF ; hand shaking hold serial input.
 1050   CP 61 ; compare A reg. to  = .
 1060   JR Z,INEND ; if so program download complete jump to end.
 1070   CP &40 ;compare A to  @  ascii character before   A 
 1080   JR C,WR2
 1090   AND &DF
 1100   SUB 07
 1110   .WR2 AND &0F ; consider second hex digit only.
 1120   OR H ; combine with first hex digit-A reg now holds value of two ascii hex bytes.
 1130   POP HL
 1140   POP DE
 1150   POP HL
 1160   RET
 1170   .ECO PUSH DE ;routine to echo byte loaded back to PC terminal.
 1180   PUSH HL ; store HL
 1190   LD H,D:LD L,E ; put address held in DE into HL. 
 1200   PUSH AF
 1210   LD A,(HL) ; load last transferred byte into A reg.
 1220   CALL H_PRINT ; routine to serial output A reg. value.
 1230   POP AF
 1240   POP HL ; restore HL value.
 1250   POP DE
 1260   RET
 1270   .RECEIVE PUSH AF ; routine to check for new byte in 8251 USART.
 1280   .CHK IN A,(&11)
 1290   BIT 1,A ; bit 1=1 if fresh byte received.
 1300   JR Z, CHK ; if bit 1=0 go back for new byte
 1310   POP AF
 1320   RET
 1330   .RTS_ON PUSH AF ; hardware handshaking routine. 
 1340   LD A,&27 ; bits 0,1,4 and 5 set. bit 5 is request to send enabled.
 1350   OUT (&11),A ; out A to 8521A reg.
 1360   POP AF
 1370   RET
 1380   .RTS_OFF PUSH AF ; hardware handshaking routine to hold serial out put from PC.
 1390   LD A,&07 ; bits 0,1,2 set and bit 5 reset to 0
 1400   OUT (&11),A ;out A to 8521A reg.
 1410   POP AF
 1420   RET
 1430   .END2 POP HL
 1440   .INEND CALL CHK_IN
 1450   POP HL ; restore as jumped out of loop.
 1460   POP DE; restore as jumped out of loop.
 1470   POP AF; restore as jumped out of loop.
 1480   LD A,64; load A  ascii  @ 
 1490   CALL SEND; send to pc terminal to denote download complete.
 1500   LD HL,&0100 ; 
 1510   LD (RN),HL ; reset load start address
 1520   .LEP JP &0100 ; jump to run com prog.-change to hex 0000 to reboot and not run.
 1530   RET
 1540   .H_PRINT PUSH AF ; routine to turn real byte into two hex ascii bytes.
 1550   AND &F0 ; isolates first digit.
 1560   RRA ; move this
 1570   RRA ; digit to
 1580   RRA ; its proper position
 1590   RRA ; in A reg.
 1600   ADD A,&30 ; change to ascii character.
 1610   CP &3A ; is digit between A and FOR
 1620     JR C,HP_H ;
 1630     ADD A,07 ; change to correct symbol if so.
 1640     .HP_H CALL SEND ; serial output byte.
 1650     POP AF ; retrieve original value AND
 1660     AND &0F ; isolate second digit.
 1670     ADD A,&30 ; change to ascii value for character.
 1680     CP &3A ;
 1690     JR C,HP_L
 1700     ADD A,07 ; change to correct hex symbol.
 1710     .HP_L CALL SEND ; serial output AND
 1720     RET
 1730     RET
 1740     .SEND PUSH AF ; store A value
 1750     .REP IN A,(&11)) ; read 8251A usart reg.
 1760     BIT 0,A ; bit 0=1 if new byte ready to send.
 1770     JR Z  REP ; jump back if byte not ready.
 1780     POP AF ; restore A
 1790     OUT (&10),A ; serial output A
 1800     RET
 1810     ]
 1820     RETURN


READCOUT.BBC for Bbcbasix.exe run on the PC.

10 REM READCOUT.bbc for PC bbcbasix
   20 REM to open a z80 com file and serial output it in hex.
   30 REM to srlrun.com on the Einstein
   40 PRINT:PRINT
   50 *MODE COM1:9600,N,8,2
   60 *.*.*
   70 PRINT"TYPE FILE NAME TO READ"
   80 INPUT A$:PRINT A$
   90 X=OPENIN(A$)
  100 L=EXT#X:PRINT,"LENGTH ";L,"BLOCKS ";L/256
  110 PRINT"FILE NUMBER ";X
  120 *OPT 1
  130 PRINT "zilog com file to output in hex \":REM \ needed to start loading.
  140 FOR I=1 TO L
  150 Y=BGET# X
  160 *OPT 0
  170 PRINT TAB(VPOS+13,POS+22);" "; I
  171 N=GET(&03FE)
  172 BT=N AND 16
  173 IF BT =0 GOTO 171
  180 *OPT 1
  190 IF Y<&10 THEN PRINT"0";
  200 PRINT;~Y;
  210 NEXT I
  220 PRINT"="
  230 *OPT 0
  240 CLOSE# X
  250 PRINT:PRINT"FILE ";A$,"FILE NUMBER ";X,"LENGTH ";L


Copyright © 2001 Chris Coxall
Last Updated Current Date 20th. July 2001
For more information contact: [email protected]

The front page