home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 9 / 09.iso / l / l216 / 2.ddi / XXMODEM.PRO < prev   
Encoding:
Text File  |  1987-03-23  |  11.2 KB  |  369 lines
  1. /****************************************************************
  2.  
  3.      Turbo Prolog Toolbox
  4.      (C) Copyright 1987 Borland International.
  5.  
  6.   Transmission protocol : (A true subset of the XMODEM PROTOCOL)
  7.  
  8.  Memonics     ASCII value    Description
  9.    ACK            6        acknowledgment
  10.    NAK           21        Negative acknowledgment
  11.    SOH            1        Start of data character
  12.    EOT            4        End of transmisssion
  13.  
  14.  
  15. Packet format :
  16.        1                  2                  3-130             131
  17.    Packet No,   Complement to Packet No,   Data (128) ...,   Check sum
  18.  
  19.  
  20. Protocol:   
  21.  
  22.    TRANSMITTER                    RECEIVER
  23.    ===========                                  ========
  24.    
  25.                         Send NAK (repeat until SOH)
  26.    Send SOH
  27.    Send packet
  28.                            Everything is ok:
  29.                            Send NAK
  30.                            Everything is not ok:
  31.                            Send ACK
  32.        This will be repeated until transmission is accepted.
  33.        When all packages are transmitted the transmitter will:
  34.    Send EOT
  35.  
  36. ****************************************************************/
  37.  
  38.  
  39. project "xxmodem"
  40.  
  41. Domains
  42.   FILE = sp; dp
  43.  
  44. DATABASE
  45.   last_char(Char)
  46.   retrans_coun(Integer)
  47.  
  48. include "tdoms.pro"
  49. include "comglobs.pro"
  50. include "tpreds.pro"
  51. include "menu.pro"
  52.  
  53. Domains
  54.   Package    =    package(Char,Char,DataL)
  55.   DataL        =    Char*
  56.  
  57. Predicates
  58.   run
  59.   decide(Integer)
  60.   send_file(Char)
  61.   receive_file(Char)
  62.   reset_last_char
  63.   read_list(Integer,DataL)
  64.   mkList(Integer, DataL)
  65.   write_list(DataL)
  66.  
  67.   /* Transmission predicates */
  68.   Send_Package(Package)
  69.   send_data(Integer,DataL,Char)
  70.   reset_retransmit_counter
  71.   increment_retransmit_counter  
  72.   send_and_wait(Char,Char,Integer)
  73.   
  74.   receive_package(Char,Char,Package)
  75.   wait_trans_ready
  76.   receive_data(Integer,Char,DataL)
  77.   Rxch_RS232_delay(Integer,Char)  /* receive with a time out */
  78.   check_notEOT
  79.  
  80.   check_next_char(Char)
  81.   ignore_until_received(Char)
  82.   test_for_nak
  83.  
  84.   mess(String,Char)
  85.   assert_char(Char)
  86.   headline(Char)
  87.   opd_headline(Integer,Char,Char)
  88.  
  89.  
  90. GOAL
  91.    run.
  92.    
  93. CLAUSES
  94.    run:-
  95.       makewindow(3, 81,21," Package window ", 0,44,12,36),
  96.       makewindow(1, 42,36," Message window ", 0,0,12,44),
  97.     makewindow(2, 63,5," Transmission window ", 12,0,12,80),
  98.  
  99.     PortNo        =     1,    /* COM1 */
  100.     InputBufSize    =    256,    /* Size of input buffer */
  101.     OutputBufSize    =    256,    /* Size of output buffer */
  102.     BaudRate    =    7,    /* 9600 bits per second    */
  103.     Parity        =    0,    /* No parity        */
  104.     WordLength    =    3,    /* Eight data bits    */
  105.     StopBits    =    0,    /* One stop bits    */
  106.       Protocol    =     2,    /* Xon/Xoff can not be used */
  107.       openRs232(PortNo, InputBufSize, OutputBufSize, BaudRate, Parity,
  108.             WordLength, StopBits, Protocol),
  109.     repeat,
  110.     menu(10,20,64,23,
  111.          ["Transmit Data.TRS",
  112.             "Receive  Data.RCV",
  113.                "Quit"],
  114.               "Choose an option",0,Choice),
  115.     decide(Choice),
  116.     fail.
  117.    run:- closeRS232(1).
  118.  
  119.   /* Transmit a file using Packaging */
  120.   decide(1):-
  121.       openread(sp,"DATA.TRS"), readdevice(sp),
  122.       send_file('\001'), !, closefile(sp).
  123.   decide(1):-closefile(sp).
  124.   
  125.   /* Receive a file using Packaging */
  126.   decide(2):-
  127.       openwrite(dp,"DATA.RCV"), writedevice(dp),
  128.       receive_file('\001'), !, closefile(dp).
  129.   decide(2):-closefile(dp).
  130.   
  131.   /* Quit */
  132.   decide(3):-closeRS232(1), exit.
  133.  
  134. /*************************************************************
  135.     Transmit a file
  136. **************************************************************/
  137.   
  138.   send_file(Pno):-
  139.       read_list(0,DataL),!, char_int(PNO,V), V2=-V, char_int(CPNO,V2),
  140.       send_package(package(PNO,CPNO,DataL)),
  141.       V3 = V+1, char_int(PNO2,V3),
  142.       send_file(PNO2).
  143.  
  144.   send_file(_):-
  145.       /* read_list  (read characters from a file) failed */
  146.       /* Everything is ok - send an EOT and wait for ACK */
  147.       mess("Send EOT and wait on ACK",' '),
  148.       send_and_wait('\04','\06',5).
  149.  
  150.  
  151. /*************************************************************
  152.     Receive a file
  153. **************************************************************/
  154.   
  155.   receive_file(PNO):-
  156.       char_int(PNO,V), V2=-V, char_int(CPNO,V2),
  157.       reset_last_char,
  158.       receive_package(PNO,CPNO,package(_,_,DATAL)),!,
  159.       write_list(DATAL),
  160.       V3 = V+1, char_int(PNO2,V3),
  161.       receive_file(PNO2).
  162.  
  163.   receive_file(_).
  164.   /* received_package failed, that means a EOT has been received
  165.      or the transmission is time outed
  166.   */
  167.   
  168.   reset_last_char:-not(last_char(_)),!.
  169.   reset_last_char:-retract(last_char(_)),!.
  170.  
  171.  
  172. /*************************************************************
  173.     Support predicates for send_file and receive_file
  174.     read_list    read if it is possible 128 bytes from
  175.             file and convert it to a list.
  176.     write_list    write a list of characters to the current
  177.             output device
  178. **************************************************************/
  179.   
  180.   read_list(128,[]):-!.
  181.   read_list(I,[H|T]):-    readchar(H), !, I2=I+1, read_list(I2,T).
  182.   read_list(I,L):-I>0, Len=128-I, mkList(Len,L).
  183.   
  184.   mkList(0,[]):-!.
  185.   mkList(I,['\026'|T]):-I2 = I - 1, mkList(I2,T).
  186.  
  187.   write_list([]):-!.
  188.   write_list([H|T]):-write(H), write_list(T).
  189.  
  190.  
  191. /*************************************************************
  192.     Transmit a Package
  193. **************************************************************/
  194.  
  195.   Send_Package(package(PNO,CPNO,DataL)):-
  196.       headline(PNO),
  197.       /* wait for a NAK from the receiver */
  198.       mess("Wait for NAK ...",' '),
  199.       ignore_until_received('\021'), DelInbuf_RS232(1),
  200.       /* Send SOH */
  201.       Txch_RS232(1,'\001'),
  202.       mess("Send SOH",' '), ticks(20), DelInbuf_RS232(1),
  203.       /* Send Package number and the complements */
  204.       mess("Transmit PNO ",PNO),
  205.       Txch_RS232(1,Pno), ticks(1), test_for_nak,
  206.       mess("Transmit CPNO ",CPNO),
  207.       Txch_RS232(1,CPNO), ticks(1), test_for_nak,
  208.       mess("Transmit Data ...",' '),
  209.       send_data(0,DataL,'\0'),        /* Send data and checksum */
  210.       mess("Wait for ACK ...",' '),
  211.       check_next_char('\006'),      /* Wait for acknowledgment */
  212.       reset_retransmit_counter,!.
  213.  
  214.   Send_Package(package(PNO,CPNO,DataL)):-
  215.       /* Something is going wrong */
  216.       /* We will retransmit the same package at most 5 times */
  217.       increment_retransmit_counter,
  218.       mess("Retransmitting Package ",PNO),
  219.       DelInBuf_RS232(1), DelOutBuf_RS232(1),
  220.       Send_Package(package(PNO,CPNO,DataL)).
  221.  
  222.  
  223. /*************************************************************
  224.     Retransmission predicates used by send_Package
  225. **************************************************************/
  226.  
  227.   reset_retransmit_counter:-not(retrans_coun(_)), !.
  228.   reset_retransmit_counter:-retract(retrans_coun(_)), !.
  229.  
  230.   increment_retransmit_counter:-not(retrans_coun(_)),assert(retrans_coun(1)),!.
  231.   increment_retransmit_counter:-
  232.     retract(retrans_coun(I)), I<5, I2=I+1, !, assert(retrans_coun(I2)).
  233.   increment_retransmit_counter:-
  234.       DelInBuf_RS232(1), DelOutBuf_RS232(1),
  235.     mess("\nError transmitting package, Transmission ABORTED\n",' '),
  236.     fail.
  237.  
  238.   send_and_wait(CH1,CH2,_):-
  239.     Txch_RS232(1,CH1),Rxch_RS232_delay(10,CH),CH=CH2,!.
  240.   send_and_wait(_,CH2,_):-
  241.     DelInbuf_RS232(1), Rxch_RS232_delay(10,CH),CH=CH2.
  242.  
  243.  
  244. /*************************************************************
  245.     Receive a Package (128 characters)
  246. **************************************************************/
  247.  
  248.   receive_package(PNO,CPNO,Package):-
  249.     headline(PNO),
  250.     mess("Continue send NAK's and wait for SOH ...",' '),
  251.     wait_trans_ready,    /* send NAK until a SOH is received */
  252.     mess("Wait for package number PNO= ",PNO),
  253.     check_next_char(PNO),    /* Check for correct package number */
  254.     mess("Wait for complement number CPNO= ",CPNO),
  255.     check_next_char(CPNO),    /* and its complement            */
  256.     mess("Receive DATA ...",' '),
  257.     receive_data(0,'\0',DataL),!, /* receive data and checksum  */
  258.     /* Everything is all right - Send a acknowledgment */
  259.     mess("Data ok - send ACK",' '),
  260.     Txch_RS232(1,'\006'),
  261.     Package = package(PNO,CPNO,DataL).
  262.  
  263.   receive_package(PNO,CPNO,Package):-
  264.     /* if wait_trans_ready failed then check for receipts of EOT */
  265.     mess("Transmission error or receiption of EOT",' '),
  266.     check_notEOT,
  267.     /* Transmission of current package crashed - send a NAK */
  268.     DelInBuf_RS232(1), DelOutBuf_RS232(1),
  269.     mess("It was a transmission error while receiving package PNO= ",PNO),
  270.     mess("Send NAK because of error in transmission",' '),
  271.     Txch_RS232(1,'\021'),Ticks(10), DelInBuf_RS232(1),
  272.     receive_package(PNO,CPNO,Package). /* Try again */
  273.  
  274.   check_notEOT:-not(last_char(_)),!. /* last_char is updated by wait_trans_ready */
  275.   check_notEOT:-last_char(CH),CH<>'\004', retract(last_char(CH)),!.
  276.  
  277.   assert_char(CH):-retract(last_char(_)),assert(last_char(CH)),!.
  278.   assert_char(CH):-assert(last_char(CH)),!.
  279.  
  280.   wait_trans_ready:-
  281.     /* Send NAK until receiption of SOH */
  282.     Txch_RS232(1,'\021'), ticks(10),
  283.     /* If a character is received, it should be SOH */
  284.     Rxch_RS232(1,CH), assert_char(CH),
  285.     CH='\001',!.
  286.   wait_trans_ready:-
  287.     check_notEOT,!, wait_trans_ready.
  288.   wait_trans_ready:-
  289.     mess("EOT received - Send ACK",' '),
  290.     Txch_RS232(1,'\006'),fail. /*Send ACK after receive EOT*/
  291.  
  292.  
  293. /*************************************************************
  294.     Receive a data block (128 characters)
  295.     Fails if a character is not received in
  296.     the specified time out period.
  297.     
  298.     Data and the corresponding no in the package will be
  299.     echoed to the screen.
  300. **************************************************************/
  301.  
  302.   receive_data(128,CheckSum,[]):-!,check_next_char(CheckSum).
  303.   receive_data(I,Csum1,[CH|T]):-
  304.     Rxch_RS232_delay(50,CH),
  305.     /* Compute the checksum on the fly */
  306.     char_int(Csum1,V1), char_int(Ch,V2),
  307.     V3 = V1 + V2, char_int(Csum2,V3),
  308.     I2 = I+1, opd_headline(I2,Csum2,CH),
  309.     receive_data(I2,Csum2,T).
  310.  
  311.   /* Receive characters from COM1 with a 5 seconds time out period */
  312.   Rxch_RS232_delay(_,CH):-Rxch_RS232(1,CH),!.
  313.   Rxch_RS232_delay(I,CH):-I>0, !,I2=I-1,Ticks(5),Rxch_RS232_delay(I2,CH).
  314.  
  315.  
  316. /*************************************************************
  317.     Transmit a data block
  318.  
  319.     Fails if the receiver sends a NAK.
  320.     
  321.     Data will be echoed to the screen.
  322. **************************************************************/
  323.  
  324.   send_data(_,[],CheckSum):-!,Txch_RS232(1,CheckSum).
  325.   send_data(I,[H|T],Csum1):-
  326.       test_for_nak,
  327.       Txch_RS232(1,H),
  328.       char_int(H,V), char_int(Csum1,V1),
  329.       V2 = V+V1, char_int(Csum2,V2),
  330.       I2=I+1, opd_headline(I2,Csum2,H),
  331.       send_data(I2,T,Csum2).
  332.  
  333.   test_for_nak:-Rxch_RS232(1,CH),CH='\021',!,mess("Received NAK",' '),fail.
  334.   test_for_nak.
  335.  
  336.  
  337. /*************************************************************
  338.  
  339.     Miscellanous Predicates
  340.  
  341. **************************************************************/
  342.  
  343.   ignore_until_received(CH):-check_next_char(CH),!.
  344.   ignore_until_received(CH):-ignore_until_received(CH).
  345.  
  346.   check_next_char(CH):-Rxch_RS232(1,CH1),!,CH1=CH.
  347.   check_next_char(CH):-check_next_char(CH).
  348.  
  349.   mess(S,CH):-
  350.     writedevice(WD), writedevice(screen),
  351.     shiftwindow(W), gotowindow(1),
  352.     char_int(CH,V), write("\n",S,V),
  353.     gotowindow(W),
  354.     writedevice(WD),
  355.     readdevice(ID),readdevice(keyboard),/*readchar(_),*/ readdevice(ID).
  356.   
  357.   headline(PNO):-
  358.       writedevice(WD), writedevice(screen),
  359.       gotowindow(3), cursor(R,_), cursor(R,33),
  360.       char_int(Pno,V), write("\nPackage NO:",V," Data:"),
  361.       writedevice(WD).
  362.   
  363.   opd_headline(I,Checksum,CH):-
  364.       writedevice(WD), writedevice(screen),
  365.       gotowindow(2), write(CH),
  366.       gotowindow(3), char_int(Checksum,V),
  367.       cursor(R,C), write(I," Chksum:",V), cursor(R,C),
  368.       writedevice(WD).
  369.