home *** CD-ROM | disk | FTP | other *** search
/ Columbia Kermit / kermit.zip / ibmcs9000 / cs9000.pas next >
Pascal/Delphi Source File  |  2020-01-01  |  11KB  |  438 lines
  1. PROGRAM KERMIT;
  2. (* AN IMPLEMENTATION OF KERMIT FOR THE IBM 9000, THIS IS A BASIC SEND ONLY *)
  3. (* KERMIT DESIGNED FOR SHORT TRANSFERS OVER A NULL MODEM LINE, NO ATTEMPT AT *)
  4. (* TERMINAL EMULATION WAS ATTEMPTED. --- WARNING, THIS SOURCE CODE WAS TYPED IN *)
  5. (* BY HAND AS THE ORIGINAL SOURCE FILE WAS UNAVAILABLE, THEIR MIGHT BE TYPOS *)
  6. (* 2ND WARNING, THIS IS THE FIRST PASCAL PROGRAM I EVER WROTE *)
  7. (* 3RD WARNING, WHEN LINKING THIS PROGRAM BE SURE TO ALLOCATE LESS THEN THE *)
  8. (* DEFAULT STACK SPACE 28K IS FINE, THIS WILL ENABLE THIS PROGRAM TO RUN ON *)
  9. (* COMPUTERS WITH SMALLER RAM SIZES *)
  10.  
  11. (* AUTHOR: GLENN R. HOWES --> HOWES@BERT.CHEM.WISC.EDU *)
  12. (* DATE: MAY, 1990 *)
  13.     USES
  14.         SYSTEM_LIBRARY;
  15.  
  16.     TYPE
  17.         PACKET = STRING[82];
  18.         PKTPNT = ^PACKET;
  19.         BUFFER = PACKED ARRAY[1..512] OF CHAR;
  20.         BUFFPNT = ^BUFFER;
  21.         SMPACKET = STRING[1];
  22.     VAR
  23. (******************** GLOBAL VARIABLES ***********************)
  24.         IRFILE: TEXT; (* UNTYPED (NON-TEXT) FILE DESCRIPTOR FOR INTERNAL USE *)
  25.         IRBUFFER: BUFFER; (* READ 512 BYTES FROM FILE AT ONCE *)
  26.         IRPNT: BUFFPNT;
  27.         BLOCK: INTEGER; (* INDEX TO KEEP TRACK OF WHICH FILE BLOCK IS BEING ACCESSED *)
  28.         ENDOFBLOCK: BOOLEAN; (* FLAG TO INDICATE ALL 512 BYTES OF A BLOCK HAVE BEEN USED *)
  29.         ENDFILE: BOOLEAN; (* FLAG TO INDICATE THE END OF THE FILE HAS BEEN REACHED *)
  30.         BLOCKLENGTH: INTEGER;
  31.         IRINDEX, BUFFINDEX: INTEGER;
  32.         PACKETNUM: INTEGER; (* INDEX TO KEEP TRACK OF HOW MANY PACKETS HAVE BEEN SENT *)
  33.         FILENAME: STRING[100];
  34.         S, F, D, Z, B, Y, N, E: CHAR; (* ALL THE DIFFERENT KERMIT PACKET TYPES *)
  35.         QUIT: BOOLEAN;
  36.         GSPACKET, GRPACKET: PACKET; (* GLOBAL SEND AND RECEIVE PACKETS *)
  37.         SERIAL0: INTEGER; (* DEVICE LUN # FOR SERIAL PORT 1 *)
  38.         SERIALTEXT:FILE; (* USED IN INITIALIZANG SERIAL DRIVER *)
  39.  
  40. (******************* ENCODING ROUTINES *********************)
  41.     FUNCTION TOCHAR (X: INTEGER): CHAR;
  42.         VAR
  43.             MYCHAR: CHAR;
  44.     BEGIN
  45.         X := X + 32;
  46.         MYCHAR := CHR(X);
  47.         TOCHAR := MYCHAR;
  48.     END;
  49.     FUNCTION UNCHAR (MYCHAR: CHAR): INTEGER;
  50.         VAR
  51.             X: INTEGER;
  52.     BEGIN
  53.         X := ORD(MYCHAR);
  54.         X := X - 32;
  55.         UNCHAR := X;
  56.     END;
  57.     FUNCTION CTL (MYCHAR: CHAR): CHAR; (* THIS IS A HACK VERSION OF ORD(CHAR) X0R 64 *)
  58.         VAR
  59.             X: INTEGER;
  60.             I: INTEGER;
  61.             J: INTEGER;
  62.     BEGIN
  63.         X := ORD(MYCHAR);
  64.         I := X OR 64;
  65.         J := X AND 64;
  66.         X := I - J;
  67.         CTL := CHR(X);
  68.     END;
  69.     FUNCTION FIND_CHECK_SUM (MYPACKET: PACKET; MYLENGTH: INTEGER): CHAR;
  70.         VAR
  71.             SUM, I, RAWCHECK: INTEGER;
  72.     BEGIN
  73.         SUM := 0;
  74.         FOR I := 1 TO (MYLENGTH) DO (* SUM OF FIELD 2 THROUGH FIELD CHECK -1*)
  75.             BEGIN
  76.                 SUM := SUM + ORD(MYPACKET[I]);
  77.             END;
  78.         RAWCHECK := (SUM + ((SUM AND 192) DIV 64)) AND 63;
  79.         FIND_CHECK_SUM := TOCHAR(RAWCHECK);
  80.     END;
  81.     FUNCTION CONTROL_ENCODE (MYCHAR: CHAR): BOOLEAN;
  82.         VAR
  83.             TEMPBYTE: CHAR;
  84.             CHARINT: INTEGER;
  85.             TEMPINT: INTEGER;
  86.     BEGIN
  87.         CHARINT := ORD(MYCHAR);
  88.         TEMPINT := CHARINT AND 127;
  89.         IF ((TEMPINT < 32) OR (TEMPINT = 127)) THEN
  90.             CONTROL_ENCODE := TRUE;
  91.     END;
  92. (******************* FILE ROUTINES **********************)
  93.     FUNCTION OPEN_FILE: BOOLEAN;
  94.     BEGIN
  95. (*$I-*)
  96.         RESET(IRFILE, FILENAME);
  97. (*$I+*)
  98.         IF IORESULT = 0 THEN
  99.             OPEN_FILE := TRUE
  100.         ELSE
  101.             BEGIN
  102.                 WRITELN('BAD FILENAME, OR OTHER ERROR: TRY AGAIN');
  103.                 OPEN_FILE := FALSE;
  104.             END;
  105.     END;
  106.     PROCEDURE GET_FILE_NAME;
  107.     BEGIN
  108.         IF ARGC > 0 THEN
  109.             BEGIN
  110.                 FILENAME := ARGV[1]^;
  111.                 ARGC := 0;
  112.             END
  113.         ELSE
  114.             BEGIN
  115.                 WRITE('FILENAME (OR Q TO QUIT):');
  116.                 READLN(FILENAME);
  117.             END;
  118.     END;
  119.     PROCEDURE GET_N_CHECK_FILE;
  120.         VAR
  121.             GOODFILE: BOOLEAN;
  122.     BEGIN
  123.         GOODFILE := FALSE;
  124.         REPEAT
  125.             GET_FILE_NAME;
  126.             IF FILENAME[1] = 'Q' THEN
  127.                 BEGIN
  128.                     QUIT := TRUE;
  129.                     GOODFILE := TRUE;
  130.                 END
  131.             ELSE
  132.                 GOODFILE := OPEN_FILE;
  133.         UNTIL GOODFILE = TRUE;
  134.     END;
  135.  
  136. (********************** SERIAL  PORT INTERACTION ROUTINES **************)
  137.     PROCEDURE OPEN_SERIAL0;
  138.         VAR
  139.             CTLPACKET: ARRAY[1..15] OF INTEGER;
  140.             ERROR: INTEGER;
  141.     BEGIN
  142.         RESET(SERIALTEXT, '#SER00');
  143.         SERIAL0 := GETLUN(@SERIALTEXT);
  144.         CTLPACKET[1] := 4;
  145.         CTLPACKET[2] := $0064; (* 5 SECOND TIMEOUT *)
  146.         CTLPACKET[3] := 6;
  147.         CTLPACKET[4] := $00C8; (* 10 SECOND RECEIVE TIMEOUT *)
  148.         CTLPACKET[5] := 20;
  149.         CTLPACKET[6] := 13; (* 9600 BAUD *)
  150.         CTLPACKET[7] := 0;
  151.         SYSFUNC(SERIAL0, @CTLPACKET, ERROR);
  152.         IF ERROR <> 0 THEN
  153.             WRITELN('ERROR NUMBER ', ERROR);
  154.     END;
  155.     PROCEDURE CLOSE_SERIAL0;
  156.     BEGIN
  157.         CLOSE(SERIALTEXT);
  158.     END
  159.     PROCEDURE SEND_PACKET;
  160.         VAR
  161.             ERROR: INTEGER;
  162.             PAKSIZE: INTEGER;
  163.     BEGIN
  164.         PAKSIZE: 
  165.         UNCHAR(GSPACKET[1]) + 3;
  166.         SWRITE(SERIAL0, @GSPACKET, PAKSIZE, 0, 0, 0, ERROR);
  167.         IF ERROR <> 0 THEN
  168.             WRITELN('ERROR IN SERIAL PORT: ', ERROR);
  169.     END;
  170.     FUNCTION PACKET_RECEIVE: BOOLEAN;
  171.         VAR
  172.             ERROR: INTEGER;
  173.             TEMPC: SMPACKET;
  174.             I: INTEGER;
  175.             LENGTH: INTEGER;
  176.     BEGIN
  177.         REPEAT
  178.             SREAD(SERIAL0, @TEMPC, 1, 0, 0, 0, ERROR);
  179.             GRPACKET[0] := TEMPC[0];
  180.         UNTIL GRPACKET[0] = CHR(1); (* UNTIL WE SEE THE START OF PACKET SYMBOL *)
  181.         SREAD(SERIAL0, @TEMPC, 1, 0, 0, 0, ERROR);
  182.         GRPACKET[1] := TEMPC[0];
  183.         LENGTH := UNCHAR(TEMPC[0]) + 2;
  184.         FOR I := 2 TO LENGTH DO
  185.             BEGIN
  186.                 SREAD(SERIAL0, @TEMPC, 1, 0, 0, 0, ERROR);
  187.                 GRPACKET[I] := TEMPC[0];
  188.             END;
  189.         IF ERROR <> 0 THEN
  190.             BEGIN
  191.                 WRITELN('ERROR IN RECEIVING: ', ERROR);
  192.                 PACKET_RECEIVE := FALSE;
  193.             END
  194.         ELSE
  195.             PACKET_RECEIVE := TRUE;
  196.     END;
  197.  
  198. (****************** MAKE PACKET ROUTINES ************* *)
  199.     PROCEDURE MAKE_INIT_PACKET;
  200.     BEGIN
  201.         GSPACKET[1] := TOCHAR(9); (* LENGTH OF REMAINING PACKET *)
  202.         GSPACKET[2] := TOCHAR(0); (* THIS IS THE FIRST PACKET *)
  203.         GSPACKET[3] := S; (* THIS IS TYPE S *)
  204.         GSPACKET[4] := TOCHAR(80); (* MAX PACKET LENGTH IS 80 *)
  205.         GSPACKET[5] := TOCHAR(5); (* 5 SECOND TIMEOUT *)
  206.         GSPACKET[6] := TOCHAR(0); (* NO PADDING USED *)
  207.         GSPACKET[7] := '@'; (* PADDING SYMBOL, DOESN'T MATTER ANYWAY *)
  208.         GSPACKET[8] := TOCHAR(13); (* END OF LINE CHARACTER *)
  209.         GSPACKET[9] := '#'; (* THE CONTROL PREFIX FOR CONTROL CHARACTER ENCODING *)
  210.         GSPACKET[10] := FIND_CHECK_SUM(GSPACKET, 9);
  211.         GSPACKET[11] := CHR(13); (* END OF LINE IS A CARRIAGE RETURN *)
  212.     END;
  213.     PROCEDURE MAKE_FILE_HEADER;
  214.         VAR
  215.             STLENGTH: INTEGER;
  216.             PKLENGTH: INTEGER;
  217.             I: INTEGER;
  218.             SEQUENCE: INTEGER;
  219.     BEGIN
  220.         STLENGTH := LENGTH(FILENAME);
  221.         PKLENGTH := STLENGTH + 3;
  222.         GSPACKET[1] := TOCHAR(PKLENGTH);
  223.         GSPACKET[3] := F;
  224.         SEQUENCE := PACKETNUM MOD 64;
  225.         GSPACKET[2] := TOCHAR(SEQUENCE);
  226.         FOR I := 1 TO (STLENGTH) DO
  227.             BEGIN
  228.                 GSPACKET[(I + 3)] := FILENAME[I];
  229.             END;
  230.         GSPACKET[(PKLENGTH + 1)] := FIND_CHECK_SUM(GSPACKET, PKLENGTH);
  231.         GSPACKET[PKLENGTH + 2] := CHR(13);
  232.         WRITELN('MADE HEADER');
  233.     END;
  234.  
  235.     PROCEDURE MAKE_DATA_PACKET;
  236.         VAR
  237.             PAKSIZE: INTEGER;
  238.             TEMPCHAR: CHAR;
  239.             DONE: BOOLEAN;
  240.             SEQUENCE: INTEGER;
  241.             INDEX: INTEGER;
  242.             SUM: INTEGER;
  243.             RAWCHECK: INTEGER;
  244.     BEGIN
  245.         PAKSIZE := 5;
  246.         SEQUENCE := PACKETNUM MOD 64;
  247.         GSPACKET[2] := TOCHAR(SEQUENCE);
  248.         SUM := ORD(GSPACKET[2]);
  249.         INDEX := 4;
  250.         REPEAT
  251.             TEMPCHAR := IRBUFFER[IRINDEX];
  252.             IF CONTROL_ENCODE(TEMPCHAR) = TRUE THEN
  253.                 BEGIN
  254.                     TEMPCHAR := CTL(TEMPCHAR);
  255.                     GSPACKET[INDEX] := '#';
  256.                     INDEX := INDEX + 1;
  257.                     PAKSIZE := PAKSIZE + 1;
  258.                     SUM := SUM + 35; (* ASCII NUMBER OF '#' SIGN *)
  259.                 END
  260.             ELSE IF TEMPCHAR = '#' THEN
  261.                 BEGIN
  262.                     GSPACKET[INDEX] := '#';
  263.                     INDEX := INDEX + 1;
  264.                     PAKSIZE := PAKSIZE + 1;
  265.                     SUM := SUM + 35;
  266.                 END;
  267.             GSPACKET[INDEX] := TEMPCHAR;
  268.             INDEX := INDEX + 1;
  269.             PAKSIZE := PAKSIZE + 1;
  270.             IRINDEX := IRINDEX + 1;
  271.             SUM := SUM + ORD(TEMPCHAR);
  272.             IF IRINDEX = (BLOCKLENGTH + 1) THEN
  273.                 ENDOFBLOCK := TRUE;
  274.         UNTIL ((ENDOFBLOCK = TRUE) OR (PAKSIZE >= 80));
  275.         GSPACKET[1] := TOCHAR((INDEX - 1));
  276.         SUM := SUM + ORD(GSPACKET[1]) + ORD(D); (* ADDING THE LENGTH AND THE TYPE *)
  277.         RAWCHECK := (SUM + ((SUM AND 192) DIV 64)) AND 63;
  278.         GSPACKET[INDEX] := TOCHAR(RAWCHECK);
  279.         GSPACKET[(INDEX + 1)] := CHR(13);
  280.     END;
  281.     PROCEDURE MAKE_EOF;
  282.         VAR
  283.             SEQUENCE: INTEGER;
  284.     BEGIN
  285.         GSPACKET[3] := Z;
  286.         GSPACKET[1] := TOCHAR(3);
  287.         SEQUENCE := PACKETNUM MOD 64;
  288.         GSPACKET[2] := TOCHAR(SEQUENCE);
  289.         GSPACKET[4] := FIND_CHECK_SUM(GSPACKET, 3);
  290.         GSPACKET[5] := CHR(13);
  291.     END;
  292.     PROCEDURE MAKE_END_OF_TRANS;
  293.         VAR
  294.             SEQUENCE: INTEGER;
  295.     BEGIN
  296.         GSPACKET[3] := B;
  297.         GSPACKET[1] := TOCHAR(3);
  298.         SEQUENCE := PACKETNUM MOD 64;
  299.         GSPACKET[2] := TOCHAR(SEQUENCE);
  300.         GSPACKET[4] := FIND_CHECK_SUM(GSPACKET, 3);
  301.         GSPACKET[5] := CHR(13);
  302.     END;
  303. (********************* INITIALIZATION ROUTINES ***************)
  304.     PROCEDURE INITPACKTYPES;
  305.  
  306.     BEGIN
  307.         S := 'S';
  308.         F := 'F';
  309.         D := 'D';
  310.         Z := 'Z';
  311.         B := 'B';
  312.         Y := 'Y';
  313.         N := 'N';
  314.         E := 'E';
  315.         GRPACKET := '                       ';
  316.         GSPACKET := '                                                             ';
  317.     END;
  318. (********************** MISCELANEOUS ROUTINES *************)
  319.     PROCEDURE DISPLAY_INSTRUCTIONS;
  320.         VAR
  321.             TEMPSTRING: STRING[25];
  322.     BEGIN
  323.         WRITELN('MAKE SURE THE OTHER COMPUTER IS READY TO RECEIVE. ');
  324.         WRITELN('HIT RETURN TO PROCEED');
  325.         READLN(TEMPSTRING);
  326.     END;
  327.     PROCEDURE READ_FILE_BLOCK;
  328.         VAR
  329.             TEMPCHAR: CHR;
  330.     BEGIN
  331.         BLOCKLENGTH := 0;
  332.         REPEAT
  333.             ENDFILE := EOF(IRFILE);
  334.             IF ENDFILE = FALSE THEN
  335.                 BEGIN
  336.  
  337.                     IF EOLN(IRFILE) = FALSE THEN
  338.                         BEGIN
  339.                             BLOCKLENGTH := BLOCKLENGTH + 1;
  340.                             READ(IRFILE, TEMPCHAR);
  341.                             IRBUFFER[BLOCKLENGTH] := TEMPCHAR;
  342.                         END
  343.                     ELSE
  344.                         BEGIN
  345.                             BLOCKLENGTH := BLOCKLENGTH + 1;
  346.                             READ(IRFILE, TEMPCHAR);
  347.                             IRBUFFER[BLOCKLENGTH] := CHR(13);
  348.                         END;
  349.                 END;
  350.         UNTIL ((ENDFILE = TRUE) OR (BLOCKLENGTH = 512))
  351.     END;
  352. (************************* DECISION MAKING ROUTINES ************)
  353.     PROCEDURE RECEIVE_AND_CONFIRM;
  354.         VAR
  355.             CHECKCHAR: CHAR;
  356.             PAKLENGTH: INTEGER;
  357.             SEQUENCE: INTEGER;
  358.             SEQCHAR: CHAR;
  359.             CONFIRMED: BOOLEAN;
  360.     BEGIN
  361.         CONFIRMED := TRUE;
  362.         REPEAT
  363.             SEND_PACKET;
  364.             IF ((PACKET_RECEIVE = TRUE) AND (GRPACKET[3] = Y)) THEN
  365.                 BEGIN
  366.                     PAKLENGTH := UNCHAR(GRPACKET[1]);
  367.                     CHECKCHAR := FIND_CHECK_SUM(GRPACKET, PAKLENGTH);
  368.                     SEQUENCE := PACKETNUM MOD 64;
  369.                     SEQCHAR := TOCHAR(SEQUENCE);
  370.                     IF ((CHECKCHR <> GRPACKET[PAKLENGTH + 1]) OR (SEQCHAR <> GRPACKT[2])) THEN
  371.                         BEGIN
  372.                             CONFIRMED := FALSE;
  373.                         END
  374.                     ELSE
  375.                         CONFIRMED := TRUE;
  376.                 END
  377.             ELSE
  378.                 BEGIN
  379.                     WRITELN('FALSE');
  380.                     CONFIRMED := FALSE;
  381.                     IF GRPACKET[3] = E THEN
  382.                         WRITELN('FATAL ERROR');
  383.                 END;
  384.         UNTIL CONFIRMED = TRUE;
  385.     END;
  386.     PROCEDURE INITIATE_TRANSFER;
  387.     BEGIN
  388.         BLOCK := 0; (* WE ARE STARTING TO READ THE FILE FROM DISK *)
  389.         READ_FILE_BLOCK;
  390.         IF BLOCKLENGTH > 0 THEN
  391.             BEGIN
  392.                 MAKE_INIT_PACKET;
  393.                 RECEIVE_AND_CONFIRM;
  394.                 PACKETNUM := 1;
  395.                 MAKE_FILE_HEADER;
  396.                 RECEIVE_AND_CONFIRM;
  397.                 PACKETNUM := 2;
  398.                 IRPNT := @IRBUFFER;
  399.                 REPEAT
  400.                     ENDOFBLOCK := FALSE;
  401.                     IRINDEX := 1;
  402.                     GSPACKET[3] := D;
  403.                     REPEAT
  404.                         MAKE_DATA_PACKET;
  405.                         WRITE('.');
  406.                         RECEIVE_AND_CONFIRM;
  407.                         PACKETNUM := PAKETNUM + 1;
  408.  
  409.                     UNTIL ENDOFBLOCK = TRUE;
  410.                     WRITELN('+');
  411.                     BLOCK := BLOCK + 1;
  412.                     READ_FILE_BLOCK;
  413.                 UNTIL BLOCKLENGTH = 0; (* END OF FILE *)
  414.                 MAKE_EOF;
  415.                 WRITELN('END OF FILE SENT');
  416.                 RECEIVE_AND_CONFIRM;
  417.             END
  418.         ELSE
  419.             WRITELN('NO APPARENT FILE TO READ');
  420.     END;
  421. (******************** MAIN PROGRAM ******************)
  422. BEGIN
  423.     INITPACKTYPES;
  424.     GSPACKET[0] := CHR(1);
  425.     OPEN_SERIAL0;
  426.     QUIT := FALSE;
  427.     GET_N_CHECK_FILE;
  428.     WHILE QUIT = FALSE DO
  429.         BEGIN
  430.             DISPLAY_INSTRUCTIONS;
  431.             PACKETNUM := 0;
  432.             INITIATE_TRANSFER;
  433.             GET_N_CHECK_FILE;
  434.         END;
  435.     CLOSE_SERIAL0;
  436. END.
  437.  
  438.