Yeah, try this.  It's original IBM "BasicA", so things may have changed...

10 '  IBM Personal Computer implemntation of MODEM2 File transfer protocol
20 '           Copyright (C) 1982  By  William E. Westfield
30 '    Originally written for SRI International, Menlo Park, CA
40 '     This is the remote side of the protocol.
50 '
60 '    -{ Version 1.005 }-
70 '
80 '  This program is InterNet public, due to the help I have frequently
90 '  gotten from the network community.  It may be used for any purpose,
100 '  including comercial purposes, but it may not be resold for profit
110 '  under any circumstances.  Note that you are only entitled to get
120 '  this program free if you have direct access to a computer on the
130 ' ARPANet, UUCP, or CSNet.  Please do not give this program away
140 ' others.  All copies of this program must retain this notice.
150 '
160 ' If you BOUGHT this program, please dont share it with your
170 ' friends, though I dont mind if you tell them (ahem) how great it is.
180 ' As someone put it: "If I make a lot of money selling this program, I
190 ' will be encouraged to produce more high quality software at reasonable
200 ' prices.  If I find pirated copies floating around, I will charge more
210 ' money, protect my programs with unreasonable protection schemes,
220 ' and/or keep them to myself.
230 '
240 DEF SEG=&H3700
250 DIM MCHAR(10), MMASK(10), MSPEED(10)
260 '
270 ' set up checksum routine
280 READ L  : CHKSUM = &H10
290 FOR I%=1 TO L: READ J : POKE &HF+I%, J : NEXT I%
300 '
310 ' set up autobaud possibilities
320 READ NSPEEDS
330 FOR I= 1 TO NSPEEDS
340  READ MCHAR(I),MMASK(I),MSPEED$(I)
350 NEXT I
360 '
370 NAK$=CHR$(21) : ACK$=CHR$(6) : SOH$=CHR$(1) : RUBBOUT$=CHR$(8)+" "+CHR$(8)
380 CR$=CHR$(13)  : EF$=CHR$(4)  : NUL$=CHR$(26) : CRLF$= CR$+CHR$(10)
390 '
400 ' Wait for carrier
410 '
420 ON ERROR GOTO 440
430 OPEN "com1:4800,n,8,1" AS 1 : ON ERROR GOTO 0 : GOTO 450
440 CLOSE 1 : RESUME 420        ' keep waiting for carrier
450 PRINT time$, "Call accepted."
460 '
470 '  Do autobauding
480 '   Thanks to  Rich Wales of UCLA, from whom the algorithm comes
490 '
500 FOR I= 1 TO 5000 : IF LOC(1) > 0 THEN 540
510 '
520 NEXT I
530 PRINT time$,"AutoBaud timeout." : CLOSE 1 : GOTO 420
540 ON ERROR GOTO 560
550 CHAR = ASC(INPUT$(1,1)) : GOTO 570
560 RESUME
570 FOR I = 1 TO NSPEEDS
580  IF (CHAR AND MMASK(I)) = MCHAR(I) THEN 610
590  NEXT I
600 PRINT time$, "AutoBaud Failure." : GOTO 500
610 SPEED$=MSPEED$(I) : PRINT time$, SPEED$;" baud connection establised."
620 CLOSE 1 : OPEN "com1:"+SPEED$+",n,8,1" AS 1
630 '
640 O$="" : ON ERROR GOTO 730
650 PRINT #1,"IBM-PC XModem> ";
660 WHILE RIGHT$(O$,1) <> CR$
670  IF LOC(1) > 0 THEN N$=INPUT$(LOC(1),1) ELSE 670
680  IF ASC(N$) <> 127 THEN 700
685  if len(o$) = 0 then 710
690   PRINT #1,RUBBOUT$; : O$=LEFT$(O$,LEN(O$)-1) : GOTO 670
700  PRINT #1,N$; : O$=O$+N$
710 WEND
720 O$=LEFT$(O$,LEN(O$)-1) : GOTO 750 ' remove cr
730 PRINT CRLF$+time$,"Connection lost"
740 CLOSE 1 : RESUME 400
750 PRINT #1,CRLF$;
760 cmd$= o$ : SPAPOS= INSTR(O$," ") : IF SPAPOS = 0 THEN 810
770 CMD$= LEFT$(O$,SPAPOS-1) : F$ = MID$(O$,SPAPOS+1)
780 IF CMD$= "send" OR CMD$="SEND" THEN 1030
790 IF CMD$= "receive" OR CMD$ = "RECEIVE" THEN 1470
800 IF CMD$= "type" OR CMD$= "TYPE" THEN 840
810 IF CMD$= "bye" OR CMD$= "BYE" THEN goto 99999
811 if cmd$= "chat" or cmd$="CHAT" then goto 821
820 PRINT #1, "?huh"+CRLF$; : GOTO 640
821 ' chat mode
822 beep:print:print"USER want to talk!!!!!!":beep : print#1,"Type ^Z to exit"
823 if loc(1) <= 0 then 826 else a$=input$(loc(1),1)
824 if instr(a$,chr$(26))= 0 then 825 else print"------------": goto 640
825 print #1,a$; : print a$; : if a$=chr$(13) then print #1,chr$(10);
826 a$=inkey$ : if a$<>"" then 824 else 823
830 '
840 ' -------------- TYPE file ----------------
850 '
860 IF F$="" THEN 820
870 PRINT time$,"TYPE "+F$;
880 SOURCE$=F$
890 ON ERROR GOTO 910
900 OPEN SOURCE$ FOR INPUT AS #2 : ON ERROR GOTO 0 : GOTO 940
910 PRINT "...Not found."
920 PRINT #1,"?File not found."+CRLF$;
930 RESUME 640
940 WHILE NOT EOF(2)
950  LINE INPUT#2,O$        'get a line
960  PRINT #1,O$+CRLF$;
970  IF LOC(1) <= 0 THEN 990
980   O=asc(INPUT$(LOC(1),1)) : if o <> 19 then print #1,"...Aborted":GOTO 1000
990   while input$(1,1) <> chr$(17) : wend ' wait for ^Q
990 WEND
1000 PRINT"...Done at "+time$ : CLOSE 2
1010 GOTO 640
1020 '
1030 ' ------------- Upload file to Remote Computer ---------------
1040 '                    (SEND option)
1050 '
1060 PRINT time$,"SEND " + F$;
1061 SOURCE$=F$
1070 '
1080 ON ERROR GOTO 1130
1090 ' note that "random" access is used to permit uploading of files
1100 ' that contain ^Zs, which basic otherwise thinks means EOF...
1110 OPEN SOURCE$ AS 2 LEN=128 : ON ERROR GOTO 0
1120 GOTO 1150
1130 PRINT #1, "No such file as ";SOURCE$; ".   Try again"+CRLF$;
1140 RESUME 1070
1150 NBLKS!=INT(LOF(2)/128)
1160 ON ERROR GOTO 0
1170 IF NBLKS! <> LOF(2)/128 THEN NBLKS!=NBLKS!+1
1180 PRINT #1, "File is";NBLKS!;"blocks long."+CRLF$;
1190 CURSAVE=CSRLIN
1200 WHILE LOC(1) > 0 : O$ = INPUT$(LOC(1),1) : WEND 'flush echoing
1210 O$= INPUT$(1,1) ' wait for initial nak
1220 IF O$<>NAK$ THEN 1210
1230 FOR RECNUM=1 TO NBLKS!
1240   FIELD #2,128 AS O$ : GET #2,RECNUM  ' get a record from the file
1250   GOSUB 1300         ' send record to modem
1260 NEXT RECNUM
1270 PRINT #1,EF$
1280 CLOSE 2 : PRINT "...successful at "+time$
1290 GOTO 640
1300 ' --------- Subroutine:  Transmit Block --------------
1310 CALL CHKSUM(O$,CH%) : CNT=10
1320 O$=SOH$+CHR$(RECNUM AND &HFF)+CHR$((NOT RECNUM) AND &HFF)+O$+CHR$(CH%)
1330 '
1340 CNT=CNT-1: IF CNT=0 THEN 1430
1350 PRINT #1,O$;
1360 FOR TIME=1 TO 1000
1370  IF LOC(1) = 0 THEN 1410
1380  C$=INPUT$(1,1)            'get nak or ack
1390  IF C$=NAK$ THEN 1330
1400  IF C$=ACK$ THEN RETURN
1410 NEXT TIME
1420 GOTO 1330                  ' timeout, try again
1430 PRINT #1, "ten consecutive naks or timeouts"+CRLF$;
1440 PRINT #1, "Aborting transfer"+CRLF$;
1450 PRINT "...failed at "+time$ : CLOSE 2 : RETURN 640
1460 '
1470 '
1480 PRINT time$,O$;
1490 '                          (RECEIVE option)
1500 NBLK=1 'START WITH BLOCK 1
1510 IF F$="" THEN 640
1520 SOURCE$=F$ : DESTIN$=F$
1530 IF INSTR(1,F$," ") = 0 THEN 1570
1540 SOURCE$=LEFT$(F$,(INSTR(1,F$," ")-1))
1550 DESTIN$=RIGHT$(F$,(LEN(F$)-INSTR(1,F$," ")))
1560 GOTO 1580
1570 '
1580 IF DESTIN$<>"" THEN 1590 ELSE DESTIN$=SOURCE$
1590 ON ERROR GOTO 1610
1600 OPEN DESTIN$ FOR OUTPUT AS #2 : ON ERROR GOTO 0 : GOTO 1630
1610 PRINT #1,"Bad IBM file: ";DESTIN$;".  Try again"+CRLF$;
1620 RESUME 1570
1630 '
1640 PRINT #1,NAK$;
1650 '
1660 '
1670  GOSUB 1770
1680  IF O$=EF$ THEN 1720
1690  PRINT #2,O$;
1700  GOTO 1660
1710 '
1720 PRINT #1,ACK$;
1730 CLOSE 2
1740 PRINT #1, SOURCE$;" successfully transferred";+CRLF$;
1750 PRINT "...successful at "+time$
1760 GOTO 640
1770 ' --------- Subroutine: Receive a block ---------------
1780 CNT = 10
1790 FOR I%= 1 TO 1000
1800   IF LOC(1) = 0 THEN 1820
1810   O$=INPUT$(1,1) : GOTO 1860
1820 NEXT I%
1830 CNT=CNT-1 : IF CNT= 0 THEN 1430
1840 PRINT #1, NAK$; : GOTO 1790
1850 '
1860 IF O$ = SOH$ THEN 1880
1870 IF O$ = EF$ THEN RETURN
1880 WHILE LOC(1) < 131 : WEND : O$=INPUT$(131,1)
1890 A$=LEFT$(O$,130) : CALL CHKSUM(A$, CH%) : CH% =CH%+1
1900 IF ASC(LEFT$(O$,1)) = (NBLK AND 255) THEN 1910 ' BLOCK WE ARE EXPECTING ?
1910 IF (CH% AND &HFF) = ASC(MID$(O$,131,1)) THEN 1930
1920 GOTO 1830
1930 O$ = MID$(O$,3,128)
1940 NBLK=NBLK+1        ' EXPECT NEXT BLOCK
1950 PRINT #1,ACK$;
1960 RETURN
1970 ' machine language Checksum routine (source in CHKSUM.A86)
1980 DATA 35
1990 DATA &H55, &H8B, &HEC, &H8B, &HB6, &H08, &H00, &H8A, &H0C, &HB5
2000 DATA &H00, &H8B, &HB4, &H01, &H00, &H33, &HC0, &HE3, &H05, &H02
2010 DATA &H04, &H46, &HE2, &HFB, &H8B, &HB6, &H06, &H00, &H89, &H04
2020 DATA &H5D, &HCA, &H04, 0, 0
2030 '
2040 ' data for autobauding
2050 DATA 7
2060 '    char   mask   speed
2070 DATA &hFC,  &hFC,  "9600"
2080 DATA &h0D,  &h7F,  "4800"
2090 DATA &hE6,  &hFF,  "2400"
2100 DATA &h8C,  &hED,  "1800"
2110 DATA &h78,  &h7F,  "1200"
2120' DATA &h80,  &hFF,  "600" I get this at 300 baud
2121 DATA &h80,  &hFF,  "300"
2130 DATA &h00,  &hFF,  "300"



| call CHKSUM( a$, Result%)

.text

crc:    push    bp
        mov     bp,sp
        mov     si,8(bp)        | address of string descriptor
        mov     cl,(si)         | length of the string
        mov     ch,#0
        mov     si,1(si)        | address of string
        xor     bx,bx           | set crc to 0
        jcxz    crcend
crclp:  lodb                    | get byte
        push    cx
        mov     cl,#8           | do crc for 8 bits
bitlp:  rol     al,#1
        rcl     bx,#1           | rotate bit from character into crc
        jnb     skipit
        xor     bx,#010041
skipit: loop    bitlp
        pop     cx
        loop    lp              | computer the checksum
crcend: mov     si,6(bp)        | address of result
        mov     (si),bx         | store the checksum
        pop     bp
        .byte   0xCA,4          | (ret 4) return to basic

chksum: push    bp
        mov     bp,sp
        mov     si,8(bp)        | address of string descriptor
        mov     cl,(si)         | length of the string
        mov     ch,#0
        mov     si,1(si)        | address of string
        xor     ax,ax
        jcxz    endit
lp:     add     al,(si)
        inc     si
        loop    lp              | compute the checksum
endit:  mov     si,6(bp)        | address of result
        mov     (si),ax         | store the checksum
        pop     bp
        .byte   0xCA,4          | (ret 4) return to basic