home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
kermit.columbia.edu
/
kermit.columbia.edu.tar
/
kermit.columbia.edu
/
archives
/
ibmcs9000.zip
/
cs9000.pas
next >
Wrap
Pascal/Delphi Source File
|
1992-09-10
|
12KB
|
438 lines
PROGRAM KERMIT;
(* AN IMPLEMENTATION OF KERMIT FOR THE IBM 9000, THIS IS A BASIC SEND ONLY *)
(* KERMIT DESIGNED FOR SHORT TRANSFERS OVER A NULL MODEM LINE, NO ATTEMPT AT *)
(* TERMINAL EMULATION WAS ATTEMPTED. --- WARNING, THIS SOURCE CODE WAS TYPED IN *)
(* BY HAND AS THE ORIGINAL SOURCE FILE WAS UNAVAILABLE, THEIR MIGHT BE TYPOS *)
(* 2ND WARNING, THIS IS THE FIRST PASCAL PROGRAM I EVER WROTE *)
(* 3RD WARNING, WHEN LINKING THIS PROGRAM BE SURE TO ALLOCATE LESS THEN THE *)
(* DEFAULT STACK SPACE 28K IS FINE, THIS WILL ENABLE THIS PROGRAM TO RUN ON *)
(* COMPUTERS WITH SMALLER RAM SIZES *)
(* AUTHOR: GLENN R. HOWES --> HOWES@BERT.CHEM.WISC.EDU *)
(* DATE: MAY, 1990 *)
USES
SYSTEM_LIBRARY;
TYPE
PACKET = STRING[82];
PKTPNT = ^PACKET;
BUFFER = PACKED ARRAY[1..512] OF CHAR;
BUFFPNT = ^BUFFER;
SMPACKET = STRING[1];
VAR
(******************** GLOBAL VARIABLES ***********************)
IRFILE: TEXT; (* UNTYPED (NON-TEXT) FILE DESCRIPTOR FOR INTERNAL USE *)
IRBUFFER: BUFFER; (* READ 512 BYTES FROM FILE AT ONCE *)
IRPNT: BUFFPNT;
BLOCK: INTEGER; (* INDEX TO KEEP TRACK OF WHICH FILE BLOCK IS BEING ACCESSED *)
ENDOFBLOCK: BOOLEAN; (* FLAG TO INDICATE ALL 512 BYTES OF A BLOCK HAVE BEEN USED *)
ENDFILE: BOOLEAN; (* FLAG TO INDICATE THE END OF THE FILE HAS BEEN REACHED *)
BLOCKLENGTH: INTEGER;
IRINDEX, BUFFINDEX: INTEGER;
PACKETNUM: INTEGER; (* INDEX TO KEEP TRACK OF HOW MANY PACKETS HAVE BEEN SENT *)
FILENAME: STRING[100];
S, F, D, Z, B, Y, N, E: CHAR; (* ALL THE DIFFERENT KERMIT PACKET TYPES *)
QUIT: BOOLEAN;
GSPACKET, GRPACKET: PACKET; (* GLOBAL SEND AND RECEIVE PACKETS *)
SERIAL0: INTEGER; (* DEVICE LUN # FOR SERIAL PORT 1 *)
SERIALTEXT:FILE; (* USED IN INITIALIZANG SERIAL DRIVER *)
(******************* ENCODING ROUTINES *********************)
FUNCTION TOCHAR (X: INTEGER): CHAR;
VAR
MYCHAR: CHAR;
BEGIN
X := X + 32;
MYCHAR := CHR(X);
TOCHAR := MYCHAR;
END;
FUNCTION UNCHAR (MYCHAR: CHAR): INTEGER;
VAR
X: INTEGER;
BEGIN
X := ORD(MYCHAR);
X := X - 32;
UNCHAR := X;
END;
FUNCTION CTL (MYCHAR: CHAR): CHAR; (* THIS IS A HACK VERSION OF ORD(CHAR) X0R 64 *)
VAR
X: INTEGER;
I: INTEGER;
J: INTEGER;
BEGIN
X := ORD(MYCHAR);
I := X OR 64;
J := X AND 64;
X := I - J;
CTL := CHR(X);
END;
FUNCTION FIND_CHECK_SUM (MYPACKET: PACKET; MYLENGTH: INTEGER): CHAR;
VAR
SUM, I, RAWCHECK: INTEGER;
BEGIN
SUM := 0;
FOR I := 1 TO (MYLENGTH) DO (* SUM OF FIELD 2 THROUGH FIELD CHECK -1*)
BEGIN
SUM := SUM + ORD(MYPACKET[I]);
END;
RAWCHECK := (SUM + ((SUM AND 192) DIV 64)) AND 63;
FIND_CHECK_SUM := TOCHAR(RAWCHECK);
END;
FUNCTION CONTROL_ENCODE (MYCHAR: CHAR): BOOLEAN;
VAR
TEMPBYTE: CHAR;
CHARINT: INTEGER;
TEMPINT: INTEGER;
BEGIN
CHARINT := ORD(MYCHAR);
TEMPINT := CHARINT AND 127;
IF ((TEMPINT < 32) OR (TEMPINT = 127)) THEN
CONTROL_ENCODE := TRUE;
END;
(******************* FILE ROUTINES **********************)
FUNCTION OPEN_FILE: BOOLEAN;
BEGIN
(*$I-*)
RESET(IRFILE, FILENAME);
(*$I+*)
IF IORESULT = 0 THEN
OPEN_FILE := TRUE
ELSE
BEGIN
WRITELN('BAD FILENAME, OR OTHER ERROR: TRY AGAIN');
OPEN_FILE := FALSE;
END;
END;
PROCEDURE GET_FILE_NAME;
BEGIN
IF ARGC > 0 THEN
BEGIN
FILENAME := ARGV[1]^;
ARGC := 0;
END
ELSE
BEGIN
WRITE('FILENAME (OR Q TO QUIT):');
READLN(FILENAME);
END;
END;
PROCEDURE GET_N_CHECK_FILE;
VAR
GOODFILE: BOOLEAN;
BEGIN
GOODFILE := FALSE;
REPEAT
GET_FILE_NAME;
IF FILENAME[1] = 'Q' THEN
BEGIN
QUIT := TRUE;
GOODFILE := TRUE;
END
ELSE
GOODFILE := OPEN_FILE;
UNTIL GOODFILE = TRUE;
END;
(********************** SERIAL PORT INTERACTION ROUTINES **************)
PROCEDURE OPEN_SERIAL0;
VAR
CTLPACKET: ARRAY[1..15] OF INTEGER;
ERROR: INTEGER;
BEGIN
RESET(SERIALTEXT, '#SER00');
SERIAL0 := GETLUN(@SERIALTEXT);
CTLPACKET[1] := 4;
CTLPACKET[2] := $0064; (* 5 SECOND TIMEOUT *)
CTLPACKET[3] := 6;
CTLPACKET[4] := $00C8; (* 10 SECOND RECEIVE TIMEOUT *)
CTLPACKET[5] := 20;
CTLPACKET[6] := 13; (* 9600 BAUD *)
CTLPACKET[7] := 0;
SYSFUNC(SERIAL0, @CTLPACKET, ERROR);
IF ERROR <> 0 THEN
WRITELN('ERROR NUMBER ', ERROR);
END;
PROCEDURE CLOSE_SERIAL0;
BEGIN
CLOSE(SERIALTEXT);
END
PROCEDURE SEND_PACKET;
VAR
ERROR: INTEGER;
PAKSIZE: INTEGER;
BEGIN
PAKSIZE:
UNCHAR(GSPACKET[1]) + 3;
SWRITE(SERIAL0, @GSPACKET, PAKSIZE, 0, 0, 0, ERROR);
IF ERROR <> 0 THEN
WRITELN('ERROR IN SERIAL PORT: ', ERROR);
END;
FUNCTION PACKET_RECEIVE: BOOLEAN;
VAR
ERROR: INTEGER;
TEMPC: SMPACKET;
I: INTEGER;
LENGTH: INTEGER;
BEGIN
REPEAT
SREAD(SERIAL0, @TEMPC, 1, 0, 0, 0, ERROR);
GRPACKET[0] := TEMPC[0];
UNTIL GRPACKET[0] = CHR(1); (* UNTIL WE SEE THE START OF PACKET SYMBOL *)
SREAD(SERIAL0, @TEMPC, 1, 0, 0, 0, ERROR);
GRPACKET[1] := TEMPC[0];
LENGTH := UNCHAR(TEMPC[0]) + 2;
FOR I := 2 TO LENGTH DO
BEGIN
SREAD(SERIAL0, @TEMPC, 1, 0, 0, 0, ERROR);
GRPACKET[I] := TEMPC[0];
END;
IF ERROR <> 0 THEN
BEGIN
WRITELN('ERROR IN RECEIVING: ', ERROR);
PACKET_RECEIVE := FALSE;
END
ELSE
PACKET_RECEIVE := TRUE;
END;
(****************** MAKE PACKET ROUTINES ************* *)
PROCEDURE MAKE_INIT_PACKET;
BEGIN
GSPACKET[1] := TOCHAR(9); (* LENGTH OF REMAINING PACKET *)
GSPACKET[2] := TOCHAR(0); (* THIS IS THE FIRST PACKET *)
GSPACKET[3] := S; (* THIS IS TYPE S *)
GSPACKET[4] := TOCHAR(80); (* MAX PACKET LENGTH IS 80 *)
GSPACKET[5] := TOCHAR(5); (* 5 SECOND TIMEOUT *)
GSPACKET[6] := TOCHAR(0); (* NO PADDING USED *)
GSPACKET[7] := '@'; (* PADDING SYMBOL, DOESN'T MATTER ANYWAY *)
GSPACKET[8] := TOCHAR(13); (* END OF LINE CHARACTER *)
GSPACKET[9] := '#'; (* THE CONTROL PREFIX FOR CONTROL CHARACTER ENCODING *)
GSPACKET[10] := FIND_CHECK_SUM(GSPACKET, 9);
GSPACKET[11] := CHR(13); (* END OF LINE IS A CARRIAGE RETURN *)
END;
PROCEDURE MAKE_FILE_HEADER;
VAR
STLENGTH: INTEGER;
PKLENGTH: INTEGER;
I: INTEGER;
SEQUENCE: INTEGER;
BEGIN
STLENGTH := LENGTH(FILENAME);
PKLENGTH := STLENGTH + 3;
GSPACKET[1] := TOCHAR(PKLENGTH);
GSPACKET[3] := F;
SEQUENCE := PACKETNUM MOD 64;
GSPACKET[2] := TOCHAR(SEQUENCE);
FOR I := 1 TO (STLENGTH) DO
BEGIN
GSPACKET[(I + 3)] := FILENAME[I];
END;
GSPACKET[(PKLENGTH + 1)] := FIND_CHECK_SUM(GSPACKET, PKLENGTH);
GSPACKET[PKLENGTH + 2] := CHR(13);
WRITELN('MADE HEADER');
END;
PROCEDURE MAKE_DATA_PACKET;
VAR
PAKSIZE: INTEGER;
TEMPCHAR: CHAR;
DONE: BOOLEAN;
SEQUENCE: INTEGER;
INDEX: INTEGER;
SUM: INTEGER;
RAWCHECK: INTEGER;
BEGIN
PAKSIZE := 5;
SEQUENCE := PACKETNUM MOD 64;
GSPACKET[2] := TOCHAR(SEQUENCE);
SUM := ORD(GSPACKET[2]);
INDEX := 4;
REPEAT
TEMPCHAR := IRBUFFER[IRINDEX];
IF CONTROL_ENCODE(TEMPCHAR) = TRUE THEN
BEGIN
TEMPCHAR := CTL(TEMPCHAR);
GSPACKET[INDEX] := '#';
INDEX := INDEX + 1;
PAKSIZE := PAKSIZE + 1;
SUM := SUM + 35; (* ASCII NUMBER OF '#' SIGN *)
END
ELSE IF TEMPCHAR = '#' THEN
BEGIN
GSPACKET[INDEX] := '#';
INDEX := INDEX + 1;
PAKSIZE := PAKSIZE + 1;
SUM := SUM + 35;
END;
GSPACKET[INDEX] := TEMPCHAR;
INDEX := INDEX + 1;
PAKSIZE := PAKSIZE + 1;
IRINDEX := IRINDEX + 1;
SUM := SUM + ORD(TEMPCHAR);
IF IRINDEX = (BLOCKLENGTH + 1) THEN
ENDOFBLOCK := TRUE;
UNTIL ((ENDOFBLOCK = TRUE) OR (PAKSIZE >= 80));
GSPACKET[1] := TOCHAR((INDEX - 1));
SUM := SUM + ORD(GSPACKET[1]) + ORD(D); (* ADDING THE LENGTH AND THE TYPE *)
RAWCHECK := (SUM + ((SUM AND 192) DIV 64)) AND 63;
GSPACKET[INDEX] := TOCHAR(RAWCHECK);
GSPACKET[(INDEX + 1)] := CHR(13);
END;
PROCEDURE MAKE_EOF;
VAR
SEQUENCE: INTEGER;
BEGIN
GSPACKET[3] := Z;
GSPACKET[1] := TOCHAR(3);
SEQUENCE := PACKETNUM MOD 64;
GSPACKET[2] := TOCHAR(SEQUENCE);
GSPACKET[4] := FIND_CHECK_SUM(GSPACKET, 3);
GSPACKET[5] := CHR(13);
END;
PROCEDURE MAKE_END_OF_TRANS;
VAR
SEQUENCE: INTEGER;
BEGIN
GSPACKET[3] := B;
GSPACKET[1] := TOCHAR(3);
SEQUENCE := PACKETNUM MOD 64;
GSPACKET[2] := TOCHAR(SEQUENCE);
GSPACKET[4] := FIND_CHECK_SUM(GSPACKET, 3);
GSPACKET[5] := CHR(13);
END;
(********************* INITIALIZATION ROUTINES ***************)
PROCEDURE INITPACKTYPES;
BEGIN
S := 'S';
F := 'F';
D := 'D';
Z := 'Z';
B := 'B';
Y := 'Y';
N := 'N';
E := 'E';
GRPACKET := ' ';
GSPACKET := ' ';
END;
(********************** MISCELANEOUS ROUTINES *************)
PROCEDURE DISPLAY_INSTRUCTIONS;
VAR
TEMPSTRING: STRING[25];
BEGIN
WRITELN('MAKE SURE THE OTHER COMPUTER IS READY TO RECEIVE. ');
WRITELN('HIT RETURN TO PROCEED');
READLN(TEMPSTRING);
END;
PROCEDURE READ_FILE_BLOCK;
VAR
TEMPCHAR: CHR;
BEGIN
BLOCKLENGTH := 0;
REPEAT
ENDFILE := EOF(IRFILE);
IF ENDFILE = FALSE THEN
BEGIN
IF EOLN(IRFILE) = FALSE THEN
BEGIN
BLOCKLENGTH := BLOCKLENGTH + 1;
READ(IRFILE, TEMPCHAR);
IRBUFFER[BLOCKLENGTH] := TEMPCHAR;
END
ELSE
BEGIN
BLOCKLENGTH := BLOCKLENGTH + 1;
READ(IRFILE, TEMPCHAR);
IRBUFFER[BLOCKLENGTH] := CHR(13);
END;
END;
UNTIL ((ENDFILE = TRUE) OR (BLOCKLENGTH = 512))
END;
(************************* DECISION MAKING ROUTINES ************)
PROCEDURE RECEIVE_AND_CONFIRM;
VAR
CHECKCHAR: CHAR;
PAKLENGTH: INTEGER;
SEQUENCE: INTEGER;
SEQCHAR: CHAR;
CONFIRMED: BOOLEAN;
BEGIN
CONFIRMED := TRUE;
REPEAT
SEND_PACKET;
IF ((PACKET_RECEIVE = TRUE) AND (GRPACKET[3] = Y)) THEN
BEGIN
PAKLENGTH := UNCHAR(GRPACKET[1]);
CHECKCHAR := FIND_CHECK_SUM(GRPACKET, PAKLENGTH);
SEQUENCE := PACKETNUM MOD 64;
SEQCHAR := TOCHAR(SEQUENCE);
IF ((CHECKCHR <> GRPACKET[PAKLENGTH + 1]) OR (SEQCHAR <> GRPACKT[2])) THEN
BEGIN
CONFIRMED := FALSE;
END
ELSE
CONFIRMED := TRUE;
END
ELSE
BEGIN
WRITELN('FALSE');
CONFIRMED := FALSE;
IF GRPACKET[3] = E THEN
WRITELN('FATAL ERROR');
END;
UNTIL CONFIRMED = TRUE;
END;
PROCEDURE INITIATE_TRANSFER;
BEGIN
BLOCK := 0; (* WE ARE STARTING TO READ THE FILE FROM DISK *)
READ_FILE_BLOCK;
IF BLOCKLENGTH > 0 THEN
BEGIN
MAKE_INIT_PACKET;
RECEIVE_AND_CONFIRM;
PACKETNUM := 1;
MAKE_FILE_HEADER;
RECEIVE_AND_CONFIRM;
PACKETNUM := 2;
IRPNT := @IRBUFFER;
REPEAT
ENDOFBLOCK := FALSE;
IRINDEX := 1;
GSPACKET[3] := D;
REPEAT
MAKE_DATA_PACKET;
WRITE('.');
RECEIVE_AND_CONFIRM;
PACKETNUM := PAKETNUM + 1;
UNTIL ENDOFBLOCK = TRUE;
WRITELN('+');
BLOCK := BLOCK + 1;
READ_FILE_BLOCK;
UNTIL BLOCKLENGTH = 0; (* END OF FILE *)
MAKE_EOF;
WRITELN('END OF FILE SENT');
RECEIVE_AND_CONFIRM;
END
ELSE
WRITELN('NO APPARENT FILE TO READ');
END;
(******************** MAIN PROGRAM ******************)
BEGIN
INITPACKTYPES;
GSPACKET[0] := CHR(1);
OPEN_SERIAL0;
QUIT := FALSE;
GET_N_CHECK_FILE;
WHILE QUIT = FALSE DO
BEGIN
DISPLAY_INSTRUCTIONS;
PACKETNUM := 0;
INITIATE_TRANSFER;
GET_N_CHECK_FILE;
END;
CLOSE_SERIAL0;
END.