[comp.os.os9] OS-9 Discussions, V3 #1

os9@cbdkc1.UUCP (05/13/87)

OS-9 Discussions         Tuesday, May 12th 1987         Volume 3 : Issue 1

Today's Topics:

                               PDCom.bas for 6809

[Today's package has the single source included.  All of the comments
 I've received over this past month will be included in issue 2.  You
 should note that this is coming to you via comp.os.os9.  This last
 month had a number of changes, including the conversion to spread the
 mod groups into their logical heirarchy, cbdkc1 upgraded to a new
 version of UNIX (new to it, that is), cbdkc1 upgraded to news 2.11.8,
 and our spool directory filled up a couple times.  If you don't see
 your article included in issue 2, then do please send it to me again!
 - JDD ]
--------------------------------------------------------------------------

Date: Thu, 9 Apr 87 17:52:33 EDT
From: mnetor!lsuc!jimomura
Subject: PDCom.bas for 6809

Hi John:

     The following is a public domain terminal package written in
BASIC09 for the Color Computer (or any standard OS-9 Level I or II
based on the 6809 processor).  It supports XModem downloads and
ASCII send uploads.  The purpose of this code is essentially twofold.
First, for people who don't have an OS-9 system and want to buy one
(particularly the new CoCo3 with level II) it provides a quick way
to get online with the view to downloading something a bit better.
If typed in without comments it's actually quite short.  This is
particularly true if you just type in the download and main
terminal parts and forgo the upload portion.

     The second purpose is to provide source code for people interested
in writing better terminal packages.  The code is very strongly
assembly language oriented rather than BASIC oriented, so it's
easy to port this to C or assembly language.  We currently have
a few freely usable terminal packages for OS-9, but all seem to
have usage restrictions.  Greg Morse's Xcom9 is my current favorite,
but it is Freeware and not properly usable if you want to write
one for yourself (with a view to potential sales).  Similarly,
I am aware of a BASIC09 program for CIS users only.  This program
is influenced by Xcom9 (particularly in the command structure),

but is completely new source code.  As such the routines I've
used can be used by anybody for any purpose.

Cheers! -- Jim O.


PROCEDURE pdcom
 0000      (* Public Domain Telecom program *)
 0023      (* By Jim Omura, Toronto, Ontario, Canada *)
 004F      (* Version:  6809 BASIC09 see Version constant below *)
 0086      
 0087      (* Declare Constant and Variable types *)
 00B0      
 00B1      BASE 0
 00B3      
 00B4      TYPE registers=cc,a,b,dp:BYTE; x,y,u:INTEGER \(* Structure *)
 00E8      DIM regs:registers
 00F1      
 00F2      DIM bitstrip:BOOLEAN
 00F9      DIM blockcntr:BYTE \(* Xmodem *)
 010C      DIM blockcomp:BYTE \(* Xmodem block No. Complement *)
 0134      DIM blocklen:INTEGER \(* Xmodem block length *)
 0154      DIM blocknum:REAL \(* Disk blocks *)
 016C      
 016D      DIM callcode:BYTE
 0174      DIM cr:BYTE \(* Cursor Return *)
 018E      DIM crossflag:BOOLEAN \(* Set when Download or Upload *)
 01B6      DIM casebyte:BYTE
 01BD      DIM checksum:BYTE \(* For Xmodem *)
 01D4      DIM chrpntr:INTEGER
 01DB      DIM command:STRING[256]
 01E7      
 01E8      DIM datablock:STRING[128] \(* For Xmodem diskfile *)
 020D      DIM diskfile:BYTE \(* path number for disk file *)
 0233      DIM eolflag:BOOLEAN \(* End of line flag for Send routine *)
 0261      DIM errorcntr:BYTE \(* For Xmodem timeout *)
 0280      DIM exitflag:BOOLEAN \(* Xmodem loop *)
 0298      DIM halfduplex:BOOLEAN
 029F      DIM keyin:STRING
 02A6      DIM local_esc:STRING[1]
 02B2      
 02B3      DIM modbuf:STRING[256] \(* General IO Buffer *)
 02D6      DIM modbfoffst:INTEGER \(* Offset for pointer to capture buffer *)
 0307      DIM modbufpntr:INTEGER
 030E      DIM modparhldr:STRING[32] \(* Holds original SCF settings *)
 033B      DIM modpath:BYTE
 0342      
 0343      DIM parpntr:INTEGER \(* Pointer to SCF param. holder *)
 036C      DIM pathname:STRING[256] \(* Filename for uploads and downloads *)
 03A0      DIM schrcntr:INTEGER \(* Send Character counter *)
 03C3      DIM schrpntr:INTEGER \(* Send Character pointer *)
 03E6      DIM startime:INTEGER \(* For Xmodem timeout *)
 0405      DIM timerr:BOOLEAN \(* Timeout error for Xmodem *)
 042A      DIM timeout:INTEGER \(* For Xmodem timeout *)
 0449      DIM transdone:BOOLEAN \(* Transfer finished *)
 0467      DIM veriflag:BOOLEAN \(* For Xmodem *)
 047E      DIM version:STRING[9] \(* PDCom version number *)
 04A4      DIM xabort:BOOLEAN
 04AB      
 04AC      DIM ack,can,xeof,eot,nak,soh:BYTE \(* Xmodem protocol *)
 04DC      
 04DD      (* set constants *)
 04F0      
 04F1      cr=$0D \(* dec 13 *)
 0505      local_esc=CHR$($19) \(* Local escape is ^Y *)
 0526      
 0527      ack=$06 \can=$18 \xeof=$1A \eot=$04 \(* Xmodem protocols *)
 055D      nak=$15 \soh=$01 \(* More Xmodem protocols *)
 0588      version="00.03.01"
 0597      
 0598      (* Initialize variables *)
 05B2      
 05B3      bitstrip=TRUE
 05B9      crossflag=FALSE
 05BF      modbufpntr=ADDR(modbuf)
 05C9      modbfoffst=0
 05D0      parpntr=ADDR(modparhldr)
 05DA      halfduplex=TRUE
 05E0      
 05E1      (* ****************************************** *)
 0611      
 0612      (* device initialization *)
 062D      
 062E      OPEN #modpath,"/t2":UPDATE
 063C      
 063D      (* Set Modem path *)
 0651      regs.a=modpath
 065D      regs.b=0 \(* SS.OPT gets current driver settings *)
 0691      regs.x=parpntr
 069D      callcode=$8D \(* I$GtStt *)
 06B2      RUN syscall(callcode,regs)
 06C1      
 06C2      FOR modbfoffst=0 TO 31
 06D2        POKE modbufpntr+modbfoffst,0
 06DE      NEXT modbfoffst
 06E9      
 06EA      (* Preserve Speed, parity, bits--see PD.PAR.OPT etc.*)
 0720      FOR modbfoffst=19 TO 22
 0730        POKE modbufpntr+modbfoffst,PEEK(parpntr+modbfoffst)
 0742      NEXT modbfoffst
 074D      
 074E      regs.x=modbufpntr
 075A      callcode=$8E \(* I$SetStt *)
 0770      RUN syscall(callcode,regs)
 077F      
 0780      PRINT "PDCom v. "; version; " active--Control-Y for Menu."
 07B0      
 07B1      (* -------------------------------------------- *)
 07E3      
 07E4 100  SHELL "tmode -echo"
 07F6      
 07F7      LOOP  \(* Terminal IO and capture buffer loop *)
 0822        RUN inkey(keyin) \(* Get keyboard input *)
 0844        IF keyin<>"" THEN 
 0850          
 0851        EXITIF keyin=local_esc THEN  \(* Test for ESCape *)
 0873          GOTO 900 \(* Tmode echo and menu *)
 0890        ENDEXIT 
 0894          
 0895          PRINT #modpath,keyin; 
 08A0          IF halfduplex THEN 
 08A9            PRINT keyin; 
 08AF          ENDIF  \(* Local Echo *) 
 08C2        ENDIF 
 08C4        
 08C5        (* Check for data *)
 08D9        regs.a=modpath
 08E5        regs.b=1 \(* #SS.RDY -- Is port ready? *)
 090F        callcode=$8D \(* I$GetStt *)
 0925        RUN syscall(callcode,regs)
 0934        
 0935        regs.cc=LAND(regs.cc,1) \(* Carry Set=1 *)
 0958        
 0959        IF regs.cc=0 THEN  \(* Get a character *) 
 097E          regs.a=modpath
 098A          regs.y=1
 0995          chrpntr=modbufpntr+modbfoffst
 09A1          regs.x=chrpntr
 09AD          callcode=$89 \(* I$Read *)
 09C1          RUN syscall(callcode,regs)
 09D0          
 09D1          (* Bitstrip *)
 09DF          IF bitstrip THEN 
 09E8            POKE chrpntr,LAND(PEEK(chrpntr),$7F)
 09F6          ENDIF  \(* Bit Strip *) 
 0A08          
 0A09          (* *** Print out to screen *** *)
 0A2A          regs.a=0
 0A35          regs.x=chrpntr
 0A41          callcode=$8A \(* I$Write *)
 0A56          RUN syscall(callcode,regs)
 0A65        ENDIF  \(* End Modem input routine *)
 0A84        
 0A85      ENDLOOP 
 0A89      
 0A8A      (* ------------------------------------------- *)
 0ABB      
 0ABC 900  SHELL "tmode echo"
 0ACD      
 0ACE 1000 (* Menu Loop *)
 0AE0      PRINT "Menu:"
 0AE9      PRINT 
 0AEB      PRINT " $ -- pass to system"
 0B03      PRINT 
 0B05      PRINT " b -- bitstrip toggle"
 0B1E      PRINT " e -- local echo toggle"
 0B39      PRINT " q -- quit"
 0B47      PRINT " r -- receive a file"
 0B5F      PRINT " s -- send a file"
 0B74      PRINT " t -- terminal"
 0B86      PRINT " x -- xmodem"
 0B96      PRINT 
 0B98      
 0B99 1050 PRINT ">"; 
 0BA2      LOOP 
 0BA4        RUN inkey(keyin)
 0BAE      EXITIF keyin<>"" THEN 
 0BBA        PRINT 
 0BBC      ENDEXIT  \(* Character received. *)
 0BD9      ENDLOOP  \(* Wait for character input *)
 0BFB      
 0BFC      IF keyin="$" THEN 
 0C09        INPUT "OS9>",command
 0C15        PRINT 
 0C17        SHELL command \(* Shell doesn't need RUN *)
 0C38        PRINT 
 0C3A      ENDIF  \(* System Call *)
 0C4D      
 0C4E      keyin=CHR$(LAND(ASC(keyin),$5F)) \(* Upper Case Filter *)
 0C73      
 0C74      IF keyin="B" THEN 
 0C81        bitstrip=NOT(bitstrip)
 0C8A        IF bitstrip THEN 
 0C93          PRINT "Bitstrip enable"
 0CA6        ELSE 
 0CAA          PRINT "Bitstrip disabled"
 0CBF        ENDIF  \(* Bitstrip off *) 
 0CD4      ENDIF  \(* Bitstrip toggle *) 
 0CEC      
 0CED      IF keyin="E" THEN 
 0CFA        halfduplex=NOT(halfduplex)
 0D03        IF halfduplex THEN 
 0D0C          PRINT "Local Echo enabled"
 0D22        ELSE 
 0D26          PRINT "No Local Echo"
 0D37        ENDIF  \(* Echo Status Report *)
 0D51        
 0D52      ENDIF  \(* Local Echo Toggle *)
 0D6B      
 0D6C      IF keyin="Q" THEN 
 0D79        GOTO 9000
 0D7D      ENDIF  \(* Normal Exit *)
 0D90      
 0D91      IF keyin="R" THEN 
 0D9E        PRINT "Receive buffer not implimented yet."
 0DC5      ENDIF 
 0DC7      
 0DC8      IF keyin="S" THEN 
 0DD5        GOTO 2000 \(* ASCII upload support *)
 0DF3      ENDIF 
 0DF5      
 0DF6      IF keyin="T" THEN 
 0E03        GOTO 100 \(* returns to Main Loop *)
 0E21      ENDIF 
 0E23      
 0E24      IF keyin="X" THEN 
 0E31        GOTO 4000
 0E35      ENDIF 
 0E37      
 0E38      GOTO 1050
 0E3C      
 0E3D      (* ----------------------------------------------- *)
 0E72      
 0E73 2000 (* ASCII Upload Support *)
 0E90      
 0E91      IF crossflag THEN  \(* Only 1 path is left open for safety *)
 0EC3        CLOSE #diskfile
 0EC9        crossflag=FALSE \(* Don't set crossflag ... *)
 0EEC        (* ... because may not successfully open a file *)
 0F1E      ENDIF  \(* Files open *) 
 0F31      
 0F32      ON ERROR GOTO 2900
 0F38      INPUT "File name?: ",pathname
 0F4C      OPEN #diskfile,pathname:READ
 0F58      crossflag=TRUE
 0F5E      PRINT "Sending "; pathname
 0F6E      ON ERROR  \(* Kill error trap *)
 0F86      
 0F87      (* Initialize Local Variables *)
 0FA7      
 0FA8      blocknum=0
 0FB0      schrpntr=ADDR(datablock)
 0FBA      transdone=FALSE
 0FC0      xabort=FALSE
 0FC6      
 0FC7      LOOP  \(* Send the file *)
 0FDC        
 0FDD        (* Get a block from disk *)
 0FF8        
 0FF9        eolflag=FALSE
 0FFF        schrcntr=0
 1006        
 1007        (* READ #diskfile,datablock -- CR doesn't seem to be stored *)
 1045        regs.a=diskfile
 1051        regs.x=schrpntr
 105D        regs.y=128
 1068        callcode=$8B \(* I$ReadLn *)
 107E        RUN syscall(callcode,regs)
 108D        
 108E        blocklen=regs.y-1 \(* Cursor Return not sent *)
 10B8        
 10B9        regs.cc=LAND(regs.cc,1) \(* Carry Set *)
 10DA        
 10DB      EXITIF regs.cc=1 THEN  \(* Might be EOF or a real error *) 
 110D        transdone=TRUE
 1113      ENDEXIT 
 1117        
 1118      EXITIF xabort THEN 
 1121      ENDEXIT 
 1125        
 1126        LOOP  \(* Send Characters *)
 113D          
 113E          RUN inkey(keyin)
 1148          
 1149        EXITIF keyin=local_esc THEN  \(* Check keyboard for abort *)
 1174          xabort=TRUE
 117A          PRINT "Abort entered"
 118B        ENDEXIT 
 118F          
 1190          IF schrcntr=blocklen THEN  \(* Must put here for 0 len record *)
 11C1            eolflag=TRUE
 11C7          ENDIF  \(* End of line *)
 11DA          
 11DB        EXITIF eolflag THEN 
 11E4        ENDEXIT 
 11E8          
 11E9          IF keyin<>"" THEN 
 11F5            PRINT #modpath,keyin; 
 1200            IF halfduplex THEN 
 1209              PRINT keyin; 
 120F            ENDIF  \(* Local Echo *)
 1221          ENDIF  \(* Send Keyboard input *) 
 123D          
 123E          regs.a=modpath \(* Check for incoming data *)
 1267          regs.b=1 \(* #SS.RDY *)
 127F          callcode=$8D \(* I$GetStt *)
 1295          RUN syscall(callcode,regs)
 12A4          regs.cc=LAND(regs.cc,1) \(* Carry set *)
 12C5          
 12C6          IF regs.cc=0 THEN  \(* Get the character *)
 12EC            regs.a=modpath
 12F8            regs.y=1 \(* One character at a time *)
 1320            chrpntr=modbufpntr+modbfoffst \(* This isn't really... *)
 1346            regs.x=chrpntr \(* necessary unless we impliment ... *)
 1379            (* concurrent down & uploads. *)
 1399            callcode=$89 \(* I$Read *)
 13AD            RUN syscall(callcode,regs)
 13BC            
 13BD            POKE chrpntr,LAND(PEEK(chrpntr),$7F) \(* Bitstrip always *)
 13E0            
 13E1            regs.a=0 \(* Print character to screen *)
 140B            regs.x=chrpntr
 1417            callcode=$8A \(* I$Write *)
 142C            RUN syscall(callcode,regs)
 143B            
 143C          ELSE  \(* No Character waiting *)
 145A            
 145B            (* Get a Character from disk buffer *)
 1481            
 1482            chrpntr=schrcntr+schrpntr
 148E            
 148F            
 1490            (* Send it to modem *)
 14A6            regs.a=modpath
 14B2            regs.y=1
 14BD            regs.x=chrpntr
 14C9            callcode=$8A \(* I$Write *)
 14DE            RUN syscall(callcode,regs)
 14ED            
 14EE            IF halfduplex THEN  \(* local echo *)
 1507              (* print character locally *)
 1524              regs.a=0 \(* Standard output *)
 1544              RUN syscall(callcode,regs)
 1553            ENDIF  \(* local echo *)
 1565            
 1566            schrcntr=schrcntr+1 \(* Inc. the counter *)
 1587            
 1588          ENDIF  \(* Character waiting *)
 15A1          
 15A2        ENDLOOP  \(* Send Characters *)
 15BB        
 15BC        PRINT #modpath,CHR$(cr);  \(* Send End of Line character *)
 15E8        
 15E9        LOOP  \(* Wait for CR from receiver *) 
 160B          
 160C        EXITIF NOT(eolflag) THEN 
 1616        ENDEXIT 
 161A          
 161B        EXITIF xabort THEN 
 1624        ENDEXIT 
 1628          
 1629          regs.a=modpath \(* Check for incoming data *)
 1652          regs.b=1
 165D          callcode=$8D \(* I$GetStt *)
 1673          RUN syscall(callcode,regs)
 1682          regs.cc=LAND(regs.cc,1)
 1694          
 1695          IF regs.cc=0 THEN  \(* Characters waiting *) 
 16BD            
 16BE            regs.y=1
 16C9            chrpntr=modbufpntr+modbfoffst
 16D5            regs.x=chrpntr
 16E1            callcode=$89 \(* I$Read *)
 16F5            RUN syscall(callcode,regs)
 1704            
 1705            POKE chrpntr,LAND(PEEK(chrpntr),$7F) \(* Bitstrip *)
 1721            
 1722            IF PEEK(chrpntr)=cr THEN  \(* EOL returned *) 
 1743              eolflag=FALSE \(* Clear the EOL flag to exit loop *)
 176E              PRINT CHR$(cr); 
 1775            ELSE 
 1779              regs.a=0 \(* Print to Screen *)
 1799              regs.x=chrpntr
 17A5              callcode=$8A \(* I$Write *)
 17BA              RUN syscall(callcode,regs)
 17C9            ENDIF  \(* Characters waiting *) 
 17E4          ENDIF  \(* Modem Char. waiting *) 
 1800          
 1801          RUN inkey(keyin)
 180B          IF keyin=local_esc THEN 
 1818            xabort=TRUE
 181E            PRINT 
 1820            PRINT "Abort entered"
 1831          ELSE 
 1835            PRINT #modpath,keyin; 
 1840            IF halfduplex THEN 
 1849              PRINT keyin; 
 184F            ENDIF  \(* Local Echo *)
 1861          ENDIF  \(* Local Escape *) 
 1876          (* Put timer here *)
 188A          
 188B        ENDLOOP  \(* Wait for CR from receiver *)
 18AE        
 18AF      ENDLOOP  \(* Send the file *)
 18C6      
 18C7      CLOSE #diskfile \(* Close the file *)
 18E1      crossflag=FALSE
 18E7      
 18E8      GOTO 1000
 18EC      
 18ED      (* ----------------------------------------------- *)
 1922      
 1923 2900 (* Error Handler for 'S'end *)
 1944      
 1945      PRINT "Cannot open "; pathname
 1959      GOTO 1000
 195D      
 195E      (* ----------------------------------------------- *)
 1993      
 1994 4000 (* XModem Support Subroutine *)
 19B6      
 19B7      PRINT "Xmodem download only"
 19CF      INPUT "continue (y/n)?: ",keyin
 19E8      
 19E9      IF keyin="N" OR keyin="n" THEN 
 19FE        GOTO 1000 \(* Abort Xmodem *)
 1A14      ENDIF 
 1A16      
 1A17      (* open diskfile *)
 1A2A      
 1A2B      IF crossflag THEN  \(* Only 1 path is left open for safety *)
 1A5D        CLOSE #diskfile
 1A63        crossflag=FALSE \(* Don't set crossflag ... *)
 1A86        (* ... because may not successfully open a file *)
 1AB8      ENDIF  \(* Files open *) 
 1ACB      
 1ACC      ON ERROR GOTO 5000
 1AD2      INPUT "File name?: ",pathname
 1AE6      PRINT "Creating "; pathname
 1AF7      CREATE #diskfile,pathname:UPDATE
 1B03      ON ERROR  \(* Kill error trap *)
 1B1B      crossflag=TRUE
 1B21      
 1B22      (* Initialize Local Variables *)
 1B42      
 1B43      blockcntr=0
 1B4A      blocklen=132 \(* Only 128 databyte block supported *)
 1B78      blocknum=0
 1B80      errorcntr=0
 1B87      transdone=FALSE
 1B8D      xabort=FALSE
 1B93      
 1B94      PRINT #modpath,CHR$(nak);  \(* Signal ready to receive *)
 1BBD      
 1BBE      LOOP  \(* Receive Blocks *)
 1BD4        
 1BD5      EXITIF xabort THEN 
 1BDE        PRINT "Xmodem Aborted"
 1BF0      ENDEXIT 
 1BF4        
 1BF5      EXITIF errorcntr>9 THEN 
 1C01        xabort=TRUE
 1C07        PRINT "Too Many Errors"
 1C1A      ENDEXIT  \(* Too Many Errors *)
 1C33        
 1C34      EXITIF transdone THEN 
 1C3D        PRINT "Xmodem Transfer Successful"
 1C5B      ENDEXIT 
 1C5F        
 1C60        blockcntr=blockcntr+1 \(* First Block is 1--not 0 *)
 1C88        blocknum=blocknum+1
 1C94        modbfoffst=0 \(* Clear Data Buffer Offset Value *)
 1CBF        timerr=FALSE
 1CC5        
 1CC6        LOOP  \(* Receive a Block *)
 1CDD          
 1CDE        EXITIF xabort THEN 
 1CE7        ENDEXIT 
 1CEB          
 1CEC        EXITIF timerr THEN 
 1CF5        ENDEXIT 
 1CF9          
 1CFA        EXITIF modbfoffst>131 THEN 
 1D06          (* Regular Exit -- block received *)
 1D2A        ENDEXIT  \(* Regular Exit *) 
 1D41          
 1D42        EXITIF transdone THEN 
 1D4B          (* Regular Exit -- Transmission completed *)
 1D77        ENDEXIT  \(* Transdone at Block Receive Level *)
 1DA1          
 1DA2          startime=VAL(RIGHT$(DATE$,2)) \(* Set Start of Timeout *)
 1DC7          chrpntr=modbufpntr+modbfoffst
 1DD3          exitflag=FALSE \(* Clear Exitflag *)
 1DED          
 1DEE          LOOP  \(* Get Character *)
 1E03            
 1E04          EXITIF exitflag THEN 
 1E0D          ENDEXIT 
 1E11            
 1E12            regs.a=modpath \(* Test for Data Ready *)
 1E37            regs.b=1 \(* #SS.RDY *)
 1E4F            callcode=$8D \(* I$GetStt *)
 1E65            RUN syscall(callcode,regs)
 1E74            regs.cc=LAND(regs.cc,1) \(* carry set *)
 1E95            
 1E96            IF regs.cc=0 THEN 
 1EA5              
 1EA6              regs.a=modpath \(* Get the Character *)
 1EC9              regs.y=1
 1ED4              regs.x=chrpntr
 1EE0              callcode=$89 \(* I$Read *)
 1EF4              RUN syscall(callcode,regs)
 1F03              
 1F04              exitflag=TRUE
 1F0A              
 1F0B              IF modbfoffst=0 THEN  \(* First Character *) 
 1F2D                
 1F2E                IF PEEK(chrpntr)=eot THEN  \(* Crossload done? *)
 1F51                  PRINT #modpath,CHR$(ack); 
 1F5D                  transdone=TRUE
 1F63                ENDIF  \(* Crossload done *)
 1F79                
 1F7A                IF PEEK(chrpntr)=can THEN  \(* Crossload Abort *)
 1F9D                  PRINT "Abort Character Received"
 1FB9                  xabort=TRUE
 1FBF                ENDIF  \(* Crossload abort error *)
 1FDC                
 1FDD                IF PEEK(chrpntr)<>1 THEN  \(* Re-synch *)
 1FF8                  modbufoffst=modbufoffst-1 \(* Ignore Character *)
 201A                ENDIF  \(* Re-synch *)
 202A                
 202B              ENDIF  \(* first character *)
 2042              
 2043              modbfoffst=modbfoffst+1
 204E              
 204F            ELSE  \(* No Character ready *) 
 206C              timeout=VAL(RIGHT$(DATE$,2))
 2077              
 2078              IF startime>timeout THEN  \(* Correct for modulo wrap *)
 20A2                timeout=timeout+60
 20AD              ENDIF  \(* Correction for modulo 60 seconds per minute *)
 20E0              
 20E1              IF timeout-startime>20 THEN  \(* Timeout exceeded *)
 2107                PRINT "Timeout "; 
 2114                timerr=TRUE
 211A                exitflag=TRUE
 2120              ENDIF  \(* Timeout exceeded *) 
 2139            ENDIF  \(* Character ready condition *) 
 215B            
 215C          ENDLOOP  \(* Get Character *)
 2173          
 2174        ENDLOOP  \(* Receive a Block *)
 218D        
 218E        (* Buffer test and save *)
 21A8        
 21A9        IF transdone THEN 
 21B2          (* Skip Disk Save--no data *)
 21CF        ELSE 
 21D3          
 21D4          veriflag=TRUE \(* Initialize Verify flag *)
 21F6          
 21F7          IF xabort THEN 
 2200            veriflag=FALSE
 2206            GOTO 4050
 220A          ENDIF  \(* Xabort at disk save *)
 2225          
 2226          IF timerr THEN 
 222F            veriflag=FALSE
 2235            GOTO 4050
 2239          ENDIF  \(* Time out error *)
 224F          
 2250          IF blockcntr<>PEEK(modbufpntr+1) THEN 
 2261            veriflag=FALSE
 2267            PRINT "Blkcntr "; 
 2274          ENDIF  \(* Block number error *)
 228E          
 228F          blockcomp=255-blockcntr \(* 1's complement of Block No. *)
 22BB          
 22BC          IF blockcomp<>PEEK(modbufpntr+2) THEN 
 22CD            veriflag=FALSE
 22D3            PRINT "Blkcomp "; 
 22E0          ENDIF  \(* Block Complement error *)
 22FE          
 22FF          (* calc. Checksum *)
 2313          checksum=0
 231A          FOR chrpntr=modbufpntr+3 TO modbufpntr+130
 2332            checksum=checksum+PEEK(chrpntr)
 233F          NEXT chrpntr
 234A          
 234B          IF checksum<>PEEK(modbufpntr+131) THEN 
 235C            veriflag=FALSE
 2362            PRINT "Chksm "; 
 236D          ENDIF  \(* Checksum error *)
 2383          
 2384 4050     IF veriflag THEN  \(* Block Verified? *)
 23A5            SEEK #diskfile,(blocknum-1)*128 \(* Save the Block *)
 23CB            datablock=MID$(modbuf,4,128)
 23D8            PUT #diskfile,datablock
 23E2            PRINT "Received Block "; blocknum
 23F9            errorcntr=0 \(* Reset Error Counter *)
 2419            PRINT #modpath,CHR$(ack); 
 2425          ELSE  \(* Block not OK *)
 243B            blockcntr=blockcntr-1 \(* Must start this block over *)
 2466            blocknum=blocknum-1
 2472            errorcntr=errorcntr+1
 247D            PRINT "Error #"; errorcntr
 248C            IF xabort THEN  \(* Signal abort or repeat *)
 24B1              PRINT #modpath,CHR$(can); 
 24BD            ELSE 
 24C1              PRINT #modpath,CHR$(nak); 
 24CD            ENDIF  \(* Signal Abort or Repeat *)
 24EB          ENDIF  \(* Block verified *)
 2501          
 2502        ENDIF  \(* Transdone condition *)
 251D        
 251E      ENDLOOP  \(* Receive Blocks *)
 2536      
 2537      CLOSE #diskfile
 253D      GOTO 1000 \(* Return to Main Menu *)
 255A      
 255B      
 255C      (* ----------------------------------------------------- *)
 2597      
 2598      (* *** Error Handler *** *)
 25B3      (* for XModem file Open *)
 25CD      
 25CE 5000 PRINT "file exist"
 25DF      GOTO 1000 \(* Returns to Main Menu *)
 25FD      
 25FE      (* **************************************************** *)
 2638      
 2639      (* Normal Exit *)
 264A      
 264B      (* Close off Devices *)
 2662      
 2663 9000 CLOSE #modpath
 266C      
 266D      SHELL "tmode echo"
 267B      
 267C      END 
 267E      
 267F      (* *************************************************** *)

 
-------------------------------------
The views expressed in OS-9 Discussions are those of the individual authors
only.  Copies of digests are available by mail request.
------
Moderator:  John Daleske   cbosgd!cbdkc1!daleske    daleske@cbdkc1.ATT.COM
Submissions should go to:  cbosgd!os9               os9@cbosgd.ATT.COM
Comments to the moderator  cbosgd!os9-request       os9-request@cbosgd.ATT.COM

*********************
End of OS-9 Discussions
*********************