home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Columbia Kermit
/
kermit.zip
/
d
/
usyskerm.alg
< prev
next >
Wrap
Text File
|
2020-01-01
|
452KB
|
5,579 lines
$PAGE % 599 BURR P59911A/KERMIT ALGOL SOURCE 041090 041090TA 00001000
$ SET ASCII 00002000
BEGIN 00004000
00005000
DEFINE VERS = "UNISYS KERMIT VERSION 3/21/90 " 00006000
"(Modified for General Mills Inc.)"#; 00007000
00008000
% ***************************************************************** 00009000
% HEWLETT PACKARD HP3000 00009100
% 00010000
% Version 1.0 : Ed Eldridge 00011000
% Polaris, Inc. 00012000
% 1400 Wilson Blvd 00013000
% suite 1100 00014000
% Arlington, Virginia 22209 00015000
% (703) 527-7333 00016000
% 00017000
% Version 2.0 : Tony Appelget 00018000
% General Mills, Inc. 00019000
% P.O. Box 1113 00020000
% Minneapolis, MN 55440 00021000
% (612) 540-7703 00022000
% 00023000
% BURROUGHS B6800 00024000
% 00024100
% Version 0.0 : Tony Appelget 00024200
% General Mills, Inc. 00024300
% P.O. Box 1113 00024400
% Minneapolis, MN 55440 00024500
% (612) 540-7703 00024600
% 00024601
% * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00024602
% 00024603
% I have left General Mills, and will no longer be able 00024604
% to maintain the Unisys Kermits unless, by chance or good 00024605
% fortune, I wind up in another Unisys shop. I will be 00024606
% available to answer questions on a call-at-your-own risk 00024607
% basis. My home phone is (612) 559-3764. 00024608
% Tony Appelget 00024609
% 13 July 1994 00024610
% 00024611
% * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00024612
% 00024700
% First Burroughs inplementation Tony Appelget May 1986 00024800
% 00024900
% Translated from the HP SPL Kermit. Due to popular demand, this 00025000
% version of Kermit has been rushed into production. Due to unpop- 00025100
% ular demand it is going into production in an uncomplete state 00025200
% (no paperwork was done for the project). It can move files but 00025300
% much remains to be done. 00025400
% 00025500
% 1. Many HP options are meaningless in a Burroughs environment and 00025600
% should be removed. 00025700
% 2. Server mode doesn't work due to directory search differences. 00025800
% 3. File validation doesn't work. It hasn't even been thought of 00025900
% due to different file structuring. 00026000
% 4. Maintainability of the command scanner can be improved by using00026100
% numbered CASE statements in the input scanner. This should be 00026200
% implemented BEFORE attempting to remove the HP options in order00026300
% to maintain some semblence of sanity in the programmer. 00026400
% 5. Transfer speed is deplorable. I have done what I could but it 00026500
% didn't seem to make much difference. I suspect the Datagram 00026600
% may not be doing the times any good at all. 00026700
% 00026800
% Patch history 00026900
% 00027000
% Undocumented changes November 1986 Tony Appelget 00027100
% BUFEMP will log non-printable chars received. We have been 00027200
% getting sync chars in the data on the new A10. We also now 00027300
% log interrupts (?HI) in case anyone is interested. 00027400
% 00027500
% SSR 91-489 January 1987 Tony Appelget (V1.0) 00027600
% Communications between this Kermit and PC Kermit V2.3 tended to 00027700
% experience a large number of retries and eventual abort of a file 00027800
% transmission. The problem did not occur with PC Kermit V2.29. 00027900
% The problem was caused by a timeout occurring in the PC Kermit due00028000
% to the dismal performance of this Kermit. Consequently, the sync 00028100
% was lost between the two Kermits. I patched procedure SDATA to 00028200
% to discard ACK packets for the data packet preceding the current 00028300
% packet. 00028400
% 00028500
% While I had my fingers in the soup, I also fixed the following: 00028600
% 1. Replaced `most all references to filename.OPEN with booleans 00028700
% in an attempt to get rid of the reputation of being a resource 00028800
% hog. 00028900
% 2. Reworked procedure SPACK to cut down on number of character-by-00029000
% character moves. I appear to have achieved a 30-35% improvement00029100
% of that one procedure, but that was a small part of the total. 00029200
% 3. Attempted to do the same in procedure BUFILL with questionable 00029300
% results. 00029400
% 4. Changed the CASE statments in HELP and CMDINT to numbered CASES00029500
% to aid future maintainability. The eventual goal is to get rid00029600
% of the HP-specific parameters, and implement some of the 00029700
% features that were disabled in the hurry of a controversial 00029800
% implementation. 00029900
% 5. Lower-case user keyins are now handled properly. 00030000
% 6. Replaced all references to HP and B6800 to Burroughs or 00030100
% similar throughout the program. 00030200
% 7. Eliminated some global variables that had meaning only in an 00030300
% HP3000 environment. Commented out a number of procedures and 00030400
% references to them for the same reason. Much remains to be 00030500
% done along this line. It's mostly cosmetic, though. 00030600
% 8. Eliminated all references (I hope) to file LNUM. In particular00030700
% eliminated extranous open and close for every file moved. 00030800
% 9. Changed the compile date to display the date compiled rather 00030900
% than the current date. 00031000
% 10. Changed all 3-bit octal string references to 4-bit hex 00031100
% references. Octal is dumb, dumb, dumb on any 8-bit machine! 00031200
% 11. Assorted cleanup in comments, defines, etc; more than I can 00031300
% remember here. I really should do fixing using a patch file. 00031400
% 12. * * NOTE * * It has just occurred to me that SET RECEIVE BINARY00031500
% ON and SET SEND BINARY ON may not behave in a manner which may 00031600
% be intended or desired. One might assume that they would yield00031700
% a bit-wise copy of the file on the destination as it existed on00031800
% the source machine. It does not. EBCDIC is still translated 00031900
% to ASCII and vice-versa. Certain other actions, such as 00032000
% trailing blank inclusion/exclusion, inclusion/exclusion of 00032100
% CR/LF, etc are affected. Do we want to leave things as they 00032200
% are or change things so that we do the bit-wise transmission? 00032300
% 00032400
% UNSCHEDULED MODS FEB 87 TONY APPELGET 00032500
% 1. Added capability to generate and check 3-byte CRC 00032600
% block checking in anticipation of being able to handle 00032700
% long packets. This Kermit will always attempt to use 00032800
% the 3-byte CRC unless negotiated down to 1-byte simple 00032900
% checksum by the other end. Capability to handle 2-byte 00033000
% checksum will be deferred forever or until necessary, 00033100
% whichever comes first. 00033200
% 00033300
% 2. Fixed another bug that a casual user might never 00033400
% encounter. If a file had been sent, received, or 00033500
% typed in non-server mode, and then the user attempted 00033600
% to upload a file in server mode, the previously speci- 00033700
% fied title, not the currently specified title, was 00033800
% used to store the file. 00033900
% 00034000
% 3. Improved efficiency of procedure CTL somewhat. I suspect 00034100
% you will hardly notice the difference. 00034200
% 00034300
% 4. Put a delay in procecedure TYPESW to slow down the writing 00034400
% to the terminal so that a ?HI could be seen by the program. 00034500
% Otherwise, countless writes were stacked up for the terminal 00034600
% and the effect of the ?HI was not seen for a long time. The 00034700
% speed of the output does not seem to be appreciably affected.00034800
% 00034900
% UNSCHEDULED FIX APRIL 7, 88 TONY APPELGET 00035000
% If a send initialize failed to connect with the other end 00035100
% of the circuit, any subsequent attempt to send a file failed 00035200
% immediately. This patch resets the error count to zero. 00035300
% 00035400
% SSR 91-557 4 MAY 88 TONY APPELGET 00035500
% SENDSW always seemed to complain about a SEND failure 00035600
% regardless of the success or failure of a file trans- 00035700
% mission. State was never being set to 'send complete 00035800
% state' ("C"). Fixed it. 00035900
% 00036000
% UNSCHEDULED FIX 8 SEPT 88 TONY APPELGET 00036100
% An attempt to communicate with a Kermit that did not 00036200
% specify any block check as part of SINIT caused this 00036300
% Kermit to use its default 3-byte CRC block check, causing 00036400
% the other Kermit to go bonkers over all packets. This 00036500
% fix causes this Kermit to default to 1-byte block check 00036600
% when the other Kermit does not specify any block check. 00036700
00036800
% *************************************************************** 00036900
% 00037000
% GENERAL UPGRADE APRIL - 89 TONY APPELGET 00037100
% 00037200
% Bring program up to snuff with newer releases of PC and 00037300
% IBM Kermits. 00037400
% 00037500
% 1. Add QUIT as synonym for EXIT. 00037600
% 00037700
% 2. Changed 3-byte CRC calculation from table-lookup 00037800
% to strictly computational. (Purloined from PC mod 00037900
% MSSCOM.ASM.) 00038000
% 00038100
% ************************************************************* 00038200
% 00038300
% MORE UPGRADING SUMMER 89 - SPRING 90 TONY APPELGET 00038400
% (SSR 91-622) 00038410
% 00038500
% Added long packet capability. The protocol, as near as I 00038600
% can tell, was straight from the 'Kermit Protocol Manual'. 00038700
% It must be OK, because it talks to PC Kermit 2.31 just fine. 00038800
% Max packet size defined as 2000 bytes. All testing was done 00038900
% against PC Kermit 2.31, which allowed only 1000 byte packets. 00039000
% Therefore, the possibility exists that an attempt to push 00039100
% the 2000 byte limit might cause a seg array or two when it 00039200
% is first tried. Compatability with old, short packet Kermits 00039300
% appears to be OK. The speed increase was disappointing. 00039400
% Transmission speeds only appear to be about double the short 00039500
% packet speeds. I had expected more, since I got 6 to 7 times 00039600
% the speed going to long packets on IBM. C'est la vit. 00039700
% 00039800
% While messing around, I discovered the send-init packets are 00039900
% supposed to always start at packet number zero. Most PC 00040000
% Kermits didn't seem to care, but I encountered one that did. 00040100
% Fixed the problem. 00040200
% 00040300
% For what it is worth, I resequenced this patch history. 00040400
% 00040500
% ***************************************************************** 00111000
00112000
DEFINE DBUF_WORDSIZE = 300#, 00113000
DBUF_BYTESIZE = DBUF_WORDSIZE*6#, 00114000
LBUF_WORDSIZE = 340#, 00115000
LBUF_BYTESIZE = LBUF_WORDSIZE*6#, 00116000
MAX_RCV_SIZE = 94#, 00117000
MAX_LONGPACK_SIZE=2047#, 00117100
00118000
CR = 47"0D"#, 00119000
LF = 47"0A"#, 00120000
XON = 47"11"#, % DC1#, 00121000
EOT = 47"04"#, 00122000
SP = 47"20"#, 00123000
HTAB= 47"09"#, 00124000
A_DEL = 47"7F"#; 00125000
00126000
% Configurable Parameters 00127000
00128000
DEFINE P_Q_8 = 7"&"#, % Prefered 8 Bit Quote 00129000
P_RPT_CHR = 7"~"#; % Prefered Repeat Prefix 00130000
00130100
DEFINE LONGP_F = 1:0:1#, 00130200
WINDOWS_F = 2:0:1#, 00130300
ATTRS_F = 3:0:1#; 00130400
00130500
00131000
BOOLEAN USE_DC1 ,% = TRUE, 00132000
QUOTE_8 ,% = FALSE, 00133000
USE_REPEAT ,% = FALSE, 00134000
EXP_TABS ,% = FALSE, 00135000
IMAGE ;% = FALSE; 00136000
00137000
INTEGER PAUSE_CNT ,% = 0, 00138000
YOUR_PAD ,% = 0, 00139000
YOUR_PAD_COUNT ,% = 0, 00140000
MAX_SND_SIZE ,% = MAX_RCV_SIZE, 00141000
MAX_SND_DATA ,% = MAX_RCV_SIZE, 00142000
LONGPACK_SIZE, 00142100
YOUR_EOL ,% = CR, 00143000
MY_EOL ,% = CR, 00144000
MY_Q_CTL ,% = %43, 00145000
YOUR_Q_CTL ,% = %43, 00146000
Q_8 ,% = P_Q_8, 00147000
RPT_CHR ,% = P_RPT_CHR, 00148000
MY_TO ,% = 10, 00149000
YOUR_TO ,% = 10, 00150000
MAXTRY ; % = 10; 00151000
00151100
REAL MY_CAPS, 00151200
YOUR_CAPS; 00151300
00151400
DEFINE LOWBYTE = [7:48]#; 00151500
00151600
00152000
DEFINE % FOR USER INPUT SCANNER 00153000
% FIRST WORD OF USER COMMAND STUFF 00154000
NULLV = 0#, 00155000
TAKEV = 1#, TAKESZ = 4#, TAKESZSZ = 7#, 00156000
SENDV = 2#, SENDSZ = 4#, SENDSZSZ = 7#, 00157000
RECEIVEV = 3#, RECEIVESZ = 7#, RECEIVESZSZ = 10#, 00158000
SERVEV = 4#, SERVESZ = 6#, SERVESZSZ = 9#, 00159000
SETV = 5#, SETSZ = 3#, SETSZSZ = 6#, 00160000
EXITV = 6#, EXITSZ = 4#, EXITSZSZ = 7#, 00161000
QUITV = 6#, QUITSZ = 4#, QUITSZSZ = 7#, 00161100
DIRV = 7#, DIRSZ = 3#, DIRSZSZ = 6#, 00162000
SPACEV = 8#, SPACESZ = 5#, SPACESZSZ = 8#, 00163000
DELETEV = 9#, DELETESZ = 6#, DELETESZSZ = 9#, 00164000
TYPEV = 10#, TYPESZ = 4#, TYPESZSZ = 7#, 00165000
VERIFYV = 11#, VERIFYSZ = 6#, VERIFYSZSZ = 9#, 00166000
STATUSV = 11#, STATUSSZ = 6#, STATUSSZSZ = 9#, 00167000
% SECOND WORD OF USER COMMAND STUFF 00168000
DEBUGV = 20#, DEBUGSZ = 5#, DEBUGSZSZ = 8#, 00169000
DELAYV = 21#, DELAYSZ = 5#, DELAYSZSZ = 8#, 00170000
LINEV = 22#, LINESZ = 4#, LINESZSZ = 7#, 00171000
SENDV_1 = 23#, 00172000
SPEEDV = 24#, SPEEDSZ = 5#, SPEEDSZSZ = 8#, 00173000
HANDSHAKEV = 25#, HANDSHAKESZ = 9#, HANDSHAKESZSZ = 12#, 00174000
RECEIVEV_1 = 26#, 00175000
LOGV = 27#, LOGSZ = 3#, LOGSZSZ = 6#, 00176000
SOHV = 28#, SOHSZ = 3#, SOHSZSZ = 6#, 00177000
% THIRD WORD OF USER COMMAND STUFF 00178000
PAUSEV = 30#, PAUSESZ = 5#, PAUSESZSZ = 8#, 00179000
BINARYV = 31#, BINARYSZ = 6#, BINARYSZSZ = 9#, 00180000
DEVICEV = 32#, DEVICESZ = 6#, DEVICESZSZ = 9#, 00181000
FCODEV = 33#, FCODESZ = 5#, FCODESZSZ = 8#, 00182000
RECLENV = 34#, RECLENSZ = 6#, RECLENSZSZ = 9#, 00183000
BLOCKFV = 35#, BLOCKFSZ = 6#, BLOCKFSZSZ = 9#, 00184000
FIXRECV = 36#, FIXRECSZ = 6#, FIXRECSZSZ = 9#, 00185000
MAXRECV = 37#, MAXRECSZ = 6#, MAXRECSZSZ = 9#, 00186000
MAXEXTV = 38#, MAXEXTSZ = 6#, MAXEXTSZSZ = 9#, 00187000
SAVESPV = 39#, SAVESPSZ = 6#, SAVESPSZSZ = 9#, 00188000
PROGV = 40#, PROGSZ = 4#, PROGSZSZ = 7#, 00189000
BIN128V = 41#, BIN128SZ = 6#, BIN128SZSZ = 9#, 00190000
TEXTV = 42#, TEXTSZ = 4#, TEXTSZSZ = 7#, 00191000
TXT80V = 43#, TXT80SZ = 5#, TXT80SZSZ = 8#, 00192000
EXPTABV = 44#, EXPTABSZ = 6#, EXPTABSZSZ = 9#, 00193000
AUTOV = 50#, AUTOSZ = 4#, AUTOSZSZ = 7#, 00194000
% FOURTH WORD OF USER COMMAND STUFF 00195000
ONV = 51#, ONSZ = 2#, ONSZSZ = 5#, 00196000
OFFV = 52#, OFFSZ = 3#, OFFSZSZ = 6#, 00197000
NONEV = 53#, NONESZ = 4#, NONESZSZ = 7#, 00198000
XONV = 54#, XONSZ = 3#, XONSZSZ = 6#, 00199000
XON2V = 55#, XON2SZ = 4#, XON2SZSZ = 7#, 00200000
YESV = 56#, YESSZ = 3#, YESSZSZ = 6#, 00201000
% QUESTION MARK ANYWHERE FOR HELP 00202000
QMARKV = 60#, QMARKSZ = 1#, QMARKSZSZ = 4#, 00203000
NUMBERV = 61#, 00204000
NOMORE = NUTTIN#; 00205000
VALUE ARRAY RESWDS 00206000
( TAKESZSZ, TAKESZ, 70"TAKE", TAKEV, 00207000
SERVESZSZ, SERVESZ, 70"SERVER", SERVEV, 00208000
SENDSZSZ, SENDSZ, 70"SEND", SENDV, 00209000
RECEIVESZSZ, RECEIVESZ, 70"RECEIVE", RECEIVEV, 00210000
SETSZSZ, SETSZ, 70"SET", SETV, 00211000
EXITSZSZ, EXITSZ, 70"EXIT", EXITV, 00212000
QUITSZSZ, QUITSZ, 70"QUIT", EXITV, 00212100
DIRSZSZ, DIRSZ, 70"DIR", DIRV, 00213000
SPACESZSZ, SPACESZ, 70"SPACE", SPACEV, 00214000
DELETESZSZ, DELETESZ, 70"DELETE", DELETEV, 00215000
TYPESZSZ, TYPESZ, 70"TYPE", TYPEV, 00216000
VERIFYSZSZ, VERIFYSZ, 70"VERIFY", VERIFYV, 00217000
STATUSSZSZ, STATUSSZ, 70"STATUS", STATUSV, 00218000
00219000
DEBUGSZSZ, DEBUGSZ, 70"DEBUG", DEBUGV, 00220000
LOGSZSZ, LOGSZ, 70"LOG", LOGV, 00221000
HANDSHAKESZSZ, HANDSHAKESZ, 70"HANDSHAKE", HANDSHAKEV, 00222000
LINESZSZ, LINESZ, 70"LINE", LINEV, 00223000
SPEEDSZSZ, SPEEDSZ, 70"SPEED", SPEEDV, 00224000
DELAYSZSZ, DELAYSZ, 70"DELAY", DELAYV, 00225000
SOHSZSZ, SOHSZ, 70"SOH", SOHV, 00226000
SENDSZSZ, SENDSZ, 70"SEND", SENDV_1, 00227000
RECEIVESZSZ, RECEIVESZ, 70"RECEIVE", RECEIVEV_1, 00228000
00229000
PAUSESZSZ, PAUSESZ, 70"PAUSE", PAUSEV, 00230000
BINARYSZSZ, BINARYSZ, 70"BINARY", BINARYV, 00231000
DEVICESZSZ, DEVICESZ, 70"DEVICE", DEVICEV, 00232000
FCODESZSZ, FCODESZ, 70"FCODE", FCODEV, 00233000
RECLENSZSZ, RECLENSZ, 70"RECLEN", RECLENV, 00234000
BLOCKFSZSZ, BLOCKFSZ, 70"BLOCKF", BLOCKFV, 00235000
FIXRECSZSZ, FIXRECSZ, 70"FIXREC", FIXRECV, 00236000
MAXRECSZSZ, MAXRECSZ, 70"MAXREC", MAXRECV, 00237000
MAXEXTSZSZ, MAXEXTSZ, 70"MAXEXT", MAXEXTV, 00238000
SAVESPSZSZ, SAVESPSZ, 70"SAVESP", SAVESPV, 00239000
PROGSZSZ, PROGSZ, 70"PROG", PROGV, 00240000
BIN128SZSZ, BIN128SZ, 70"BIN128", BIN128V, 00241000
TEXTSZSZ, TEXTSZ, 70"TEXT", TEXTV, 00242000
TXT80SZSZ, TXT80SZ, 70"TXT80", TXT80V, 00243000
EXPTABSZSZ, EXPTABSZ, 70"EXPTAB", EXPTABV, 00244000
AUTOSZSZ, AUTOSZ, 70"AUTO", AUTOV, 00245000
00246000
ONSZSZ, ONSZ, 70"ON", ONV, 00247000
OFFSZSZ, OFFSZ, 70"OFF", OFFV, 00248000
NONESZSZ, NONESZ, 70"NONE", NONEV, 00249000
XONSZSZ, XONSZ, 70"XON", XONV, 00250000
XON2SZSZ, XON2SZ, 70"XON2", XON2V, 00251000
YESSZSZ, YESSZ, 70"YES", YESV, 00252000
QMARKSZSZ, QMARKSZ, 70"?", QMARKV, 00253000
0, 0, 0, 0 ); 00254000
% ***************************************************************** 00255000
% 00256000
% Parameters that are changed via the SET command 00257000
% 00258000
% ***************************************************************** 00259000
00260000
BOOLEAN RCV_BINARY , % = FALSE, % Binary if TRUE 00261000
RCV_FIXREC , % = TRUE, % Fixed records if TRUE 00262000
RCV_SAVESP ; % = TRUE; % Release unused space 00263000
00264000
INTEGER RCV_FCODE , % = 0, % File code 00265000
RCV_RECLEN , % = -80, % Record Length 00266000
RCV_BLOCKF , % = 16, % Blocking Factor 00267000
RCV_MAXEXT ; % = 32; % Max Extents 00268000
00269000
INTEGER RCV_MAXREC ; % = 5000d; % Max Records 00270000
00271000
EBCDIC ARRAY RCV_DEV[ 0:255 ]; 00272000
% "DISC "; 00273000
00274000
INTEGER SND_BINARY ; % = 0; % SEND Mode, % 0 = Auto 00275000
% 1 = Binary 00276000
% 2 = ASCII 00277000
00277100
INTEGER SND_RECLEN; % Maxrecsize 00277200
00278000
INTEGER % HNDSHK , % = 1, % Handshake, % 0 = None 00279000
% 1 = XON 00280000
% 2 = XON2 00281000
DEBUG_MODE ; % = 0, % Debug Mode 00282000
% TSPEED , % = 0, % Line Speed (CPS) 00283000
% LDEV_LINE ; % = 0; % Line LDEV 00284000
00285000
REAL SOH, % 4"01", % Begin-packet character 00286000
MY_BLK_CK, % "3", 00286100
YOUR_BLK_CK; % "3" 00286200
00287000
INTEGER ARRAY MIN_SIZE[0:69]; % Used by input scanner to 00288000
% ensure unique abbreviated 00289000
% keywords 00290000
00291000
% ***************************************************************** 00292000
00293000
00294000
% Buffers and etc. 00295000
00296000
FILE % LNUM , % Line File 00297000
DNUM , % Disc file 00298000
CINUM , % CI Input 00299000
CONUM , % CI Output 00300000
VNUM , % Validation file 00301000
TNUM , % Temp file 00301100
TAKENUM, % TAKE File Number 00302000
LOGNUM ;% = 0; % Log Output 00303000
BOOLEAN DNUM_OPEN, % Data file open 00303100
VNUM_OPEN, % Validation file open 00303200
TNUM_OPEN, % Temp file open 00303300
TAKENUM_OPEN, % Take file open 00303400
LOGNUM_OPEN; % Log file open 00303500
00304000
BOOLEAN ARRAY W_DBUF[0:DBUF_WORDSIZE], 00305000
W_LBUF[0:LBUF_WORDSIZE]; 00306000
00307000
ASCII ARRAY DBUF[0] = W_DBUF, 00308000
LBUF[0] = W_LBUF; 00309000
00310000
INTEGER DBUFCNT, % Disc buffer ASCII count 00311000
DBUF_RMAX, % Receive Max Buf size 00312000
DBUFINX; % Disc buffer index 00313000
00313900
REAL LBUFCNT; % Line buffer count 00314000
00314100
00315000
ASCII ARRAY PDATA[0:MAX_LONGPACK_SIZE]; % Outgoing pkt data 00316000
INTEGER PDATACNT; 00317000
00318000
ASCII ARRAY RP_DATA[0:MAX_LONGPACK_SIZE]; % Rcv (data) buf 00319000
REAL RP; % Response type 00320000
INTEGER RP_LEN, % Length of response data 00321000
RP_NUM; % Packet number of response 00322000
00323000
ASCII ARRAY PBUF[0:150]; % Utility buffer 00325000
INTEGER PLEN; 00326000
00327000
ASCII ARRAY L_FNAME[0:37], % Local file name 00328000
R_FNAME[0:37], % Remote file name 00329000
LOGNAME[0:35]; % Current log file name 00330000
00331000
INTEGER L_FNAME_LEN, % Length of Name 00332000
R_FNAME_LEN, % Length of Name 00333000
LOGNAME_LEN; % Length of log file name 00334000
00334100
EBCDIC ARRAY TTL[0:95]; % Titles can't be in ASCII 00334200
00334300
00335000
ASCII ARRAY IB[0:79]; % Input Buffer 00337000
REAL ILEN; % Length of Current IB 00338000
00339000
% Misc 00340000
00341000
REAL STATE, % Current state 00342000
Q8_IND; % Receive Q8 flag 00343000
00344000
INTEGER N, % Current packet number 00345000
NUMTRY, % Current "try" number 00346000
OLDTRY; % Previous "try" number 00347000
00348000
ASCII ARRAY KT_NAME[0:31]; % Temp file name 00349000
00350000
INTEGER KTN_LEN; % Length of KT_NAME 00351000
00352000
BOOLEAN HAVE_KTEMP, % True IF temp file exists 00353000
DBUF_WRITTEN, % Prevent LF from forcing 00354000
% disc write after write 00355000
% from full buffer 00356000
BLASTED ;% True if ?HI entered 00357000
VALUE ARRAY VALID_TITLE_W( 00358000
17973, 14649, 22092, 18756, 12118, 16716, 00359000
18756, 16724, 17710, 20565, 16928, 0); 00360000
ASCII ARRAY VALID_TITLE[0] = VALID_TITLE_W; 00361000
% ASCII ARRAY MYSELF[0:7]; 00362000
00363000
INTEGER ERROR, % For COMMAND int 00364000
PARM; % ditto 00365000
00365100
POINTER PTEMP; % General purpose - mostly for OFFSETs 00365200
00365300
TRUTHSET LETTERS(7"ABCDEFGHIJKLMNOPQRSTUVWXYZ"), 00365400
NUMBERS(7"01234567890"); 00365500
00365600
TRANSLATETABLE LOWER_TO_UPPER( 00365700
ASCII TO ASCII, 00365800
7"abcdefghijklmnopqrstuvwxyz" TO 00365900
7"ABCDEFGHIJKLMNOPQRSTUVWXYZ" ); 00365910
00365920
00366000
DEFINE E_ST = IF LOGNUM_OPEN THEN 00367000
BEGIN 00368000
REPLACE PBUF BY " " FOR 108; % Clean out trash 00369000
REPLACE PBUF BY #, 00369100
E_EN = ; 00369200
WRITE(LOGNUM, 108, PBUF); 00369300
END#, 00369400
00369500
M_ST = REPLACE PTEMP:PBUF BY #, 00370000
M_EN = ; PLEN:=OFFSET(PTEMP); 00371000
WRITE(CONUM, PLEN, PBUF) #, 00372000
00372100
FOUR_ASCII_DIGITS(VAL, PTR) = 00372200
REPLACE PTR BY VAL FOR 4 DIGITS; 00372300
REPLACE PTR:PTR BY 00372400
REAL( BOOLEAN(REAL(PTR, 4)) AND 00372500
BOOLEAN(4"3F3F3F3F") ).[31:48] FOR 4#, 00372600
00372700
FLUSH_DBUF = BEGIN 00373000
WRITE(DNUM, RCV_RECLEN, DBUF); 00374000
DBUFINX := 0; 00375000
REPLACE DBUF BY " " FOR RCV_RECLEN; 00375100
END #, 00376000
KTEMP_NAME = 8"KMTTEMP" #, 00377000
RPACK_PACK = 1#, 00377100
SPACK_PACK = 2#; 00377200
00378000
%DEFINE IN = 0#, 00379000
% OUT = 1#, 00380000
% IO = 2#; 00381000
00382000
00383000
00395000
INTEGER I_DELAY; % = 10; % Initial Pause Duration 00396000
00397000
% **************************************************************** 00398000
00399000
$ PAGE 00422000
00424000
REAL PROCEDURE TOCHAR(CHR); 00425000
VALUE CHR ; 00426000
INTEGER CHR ; 00427000
BEGIN 00428000
TOCHAR := CHR + SP; 00429000
END; 00430000
00431000
% **************************************************************** 00432000
00433000
INTEGER PROCEDURE UNCHAR(CHR); 00434000
VALUE CHR ; 00435000
REAL CHR; 00436000
BEGIN 00437000
UNCHAR := CHR - SP; 00438000
END; 00439000
00440000
% **************************************************************** 00441000
00442000
REAL PROCEDURE CTL(CHR); 00443000
VALUE CHR ; 00444000
REAL CHR ; 00445000
BEGIN 00446000
% CTL := INTEGER(BOOLEAN(CHR) xor %100); 00447000
CTL := REAL( NOT(BOOLEAN(CHR) EQV BOOLEAN(4"40")) ); 00447100
END; 00448000
00449000
% **************************************************************** 00450000
00451000
INTEGER PROCEDURE NPNO(PNO); 00452000
VALUE PNO ; 00453000
INTEGER PNO ; 00454000
BEGIN 00455000
NPNO := (PNO + 1) MOD 64; 00456000
END; 00457000
00458000
% ***************************************************************** 00459000
00460000
INTEGER PROCEDURE PPNO(PNO); 00461000
VALUE PNO ; 00462000
INTEGER PNO ; 00463000
BEGIN 00464000
IF PNO = 0 THEN 00465000
PPNO := 63 00466000
ELSE 00467000
PPNO := PNO - 1; 00468000
END; 00469000
00470000
% ***************************************************************** 00471000
00472000
INTERRUPT BLAST; % For ?HI 00473000
BEGIN 00474000
BLASTED := TRUE; 00475000
E_ST "* * * * INTERRUPTED * * * *" E_EN; 00475100
END; 00476000
00477000
% ***************************************************************** 00485000
$ PAGE 00485010
$ BEGINSEGMENT % All send, receive, and packet handling in one seg 00485012
REAL PROCEDURE CALCULATE_CRC(PKT, OFFSET, LEN); 00485020
VALUE OFFSET, LEN; 00485030
INTEGER OFFSET, LEN; 00485040
ASCII ARRAY PKT[0]; 00485050
BEGIN 00485060
00485070
% Copied from the IBM-PC CRC calulator in module MSSCOM.ASM 00485080
% and modified for better efficiency in this environment. AX 00485090
% and BX were the original PC registers and the nomenclature 00485100
% was retained for want of better identifiers. 00485110
00485120
BOOLEAN AX, DX; 00485130
DEFINE AH = AX.[15:8]#, 00485140
AL = AX.[7:8]#, 00485150
DH = DX.[15:8]#, 00485160
DL = DX.[7:8]#; 00485161
00485162
INTEGER I, LAST; 00485163
00485164
DEFINE XOR(U, V) = NOT( (U) EQV (V) )#; 00485165
DX:=BOOLEAN(0); 00485166
00485170
LAST:=(I:=OFFSET)+LEN-1; 00485175
DO BEGIN 00485180
AH := BOOLEAN(REAL(PKT[I], 1)); 00485185
DL := XOR(DL, AH); 00485190
AH := XOR((FALSE & (DL)[11:7:8]), DL); %(DL & LSL(4)) XOR DL; 00485195
AL := FALSE; 00485200
DX := DH OR AX; 00485205
AX := FALSE & AX[11:15:16]; %AX:=AX & LSR(4) 00485210
DL := XOR(DL, AH); 00485220
DX := XOR(DX, AX.[15:15] ); %DX XOR (AX & LSR(1)); 00485230
END 00485235
UNTIL ( I := I+1 ) > LAST; 00485240
00485245
CALCULATE_CRC := REAL(DX.[15:16]); 00485250
00485260
IF DEBUG_MODE > 0 AND LOGNUM_OPEN THEN 00485261
BEGIN 00485262
REPLACE PBUF BY 00485263
"CALC_CRC:", 00485264
TOCHAR(REAL(DX.[15:4])).LOWBYTE FOR 1, 00485265
TOCHAR(REAL(DX.[11:6])).LOWBYTE FOR 1, 00485266
TOCHAR(REAL(DX.[5:6])).LOWBYTE FOR 1, 00485267
":::", PKT[LAST-2] FOR 6, ":::", " " FOR 82; 00485268
WRITE(LOGNUM, 108, PBUF); 00485269
END; 00485270
00485271
END; 00485272
00485280
%**************************************************************** 00485290
00485300
% ************************************************************** 00485350
00485360
$ PAGE 00485370
00485380
PROCEDURE WRITE_LOG(PACKET, LEN, WHO); 00485400
VALUE LEN, WHO; 00485410
INTEGER LEN, WHO; 00485420
ASCII ARRAY PACKET[0]; 00485430
BEGIN 00485440
REAL HH, 00485450
MM, 00485460
SS, 00485470
TT, 00485480
NOW; 00485490
00485492
DEFINE ASCII_IZE(T) = 00485500
(40"3030" & (T DIV 10)[43:3:4] 00485510
& (T MOD 10)[35:3:4])#; 00485520
POINTER PB; 00485550
00485560
INTEGER PB_L; % So we don't clobber PLEN 00485570
00485580
REPLACE PBUF BY " " FOR 80; 00485582
IF WHO = RPACK_PACK THEN 00485590
REPLACE PB:PBUF BY "RPACK: " 00485600
ELSE 00485610
IF WHO = SPACK_PACK THEN 00485620
REPLACE PB:PBUF BY "SPACK: " 00485630
ELSE 00485640
REPLACE PB:PBUF BY "?????? "; 00485650
00485670
NOW := TIME(11)*2.4@-6; 00485680
00485690
TT := ENTIER( (NOW-(NOW:=ENTIER(NOW)))*100 ); 00485700
SS := NOW MOD 60; 00485710
MM := (NOW:=NOW DIV 60) MOD 60; 00485720
HH := NOW DIV 60; 00485730
REPLACE PB:PB BY ASCII_IZE(HH) FOR 2, ":"; 00485740
REPLACE PB:PB BY ASCII_IZE(MM) FOR 2, ":"; 00485750
REPLACE PB:PB BY ASCII_IZE(SS) FOR 2, "."; 00485760
REPLACE PB:PB BY ASCII_IZE(TT) FOR 2, " ("; 00485762
FOUR_ASCII_DIGITS(LEN, PB); 00485766
REPLACE PB BY ")", " " FOR (80-OFFSET(PB)); 00485774
WRITE(LOGNUM, 80, PBUF); 00485780
00485790
REPLACE PBUF BY " " FOR 7; 00485800
PB := PACKET; 00485810
00485820
WHILE LEN > 72 DO 00485830
BEGIN 00485840
REPLACE PBUF[7] BY PB:PB FOR 72; 00485850
WRITE(LOGNUM, 79, PBUF); 00485870
LEN := LEN-72; 00485880
END; 00485890
00485900
IF LEN > 0 THEN 00485910
BEGIN 00485920
REPLACE PBUF[7] BY PB FOR LEN, " " FOR (72-LEN); 00485930
WRITE(LOGNUM, 79, PBUF); 00485940
END; 00485950
00485960
END; 00485970
% ***************************************************************** 00485980
00485990
$ PAGE 00581000
PROCEDURE SPACK(TYP,NUM,LEN,DATA); 00583000
VALUE TYP,NUM,LEN ; 00584000
REAL TYP ; 00585000
INTEGER NUM,LEN ; 00586000
ASCII ARRAY DATA[0]; 00587000
BEGIN 00588000
00589000
BOOLEAN R_ERROR; 00590000
REAL CHKSUM; 00590100
00591000
INTEGER IX, 00592000
OX; 00593000
00595000
REAL P_INT; 00596000
00597000
% ----------------------------------------------------------- 00598000
00599000
DEFINE XCK(CHR) = 00600000
BEGIN 00603000
CHKSUM := CHKSUM + CHR; 00604000
REPLACE LBUF[OX:=OX+1] BY CHR.LOWBYTE FOR 1; 00605000
END#; 00607000
00608000
% ----------------------------------------------------------- 00609000
PROCEDURE REGULAR_PACK; 00609100
BEGIN 00610000
E_ST "REGULAR SIZE PACKETS" E_EN; 00610001
REPLACE LBUF[0] BY SOH.LOWBYTE; % Start with SOH 00611000
IF (STATE = "S") OR % Then length 00612000
(STATE = "R") OR 00612010
(YOUR_BLK_CK = "1") THEN 00612100
XCK(TOCHAR(LEN+3)) 00612200
ELSE 00612300
XCK(TOCHAR(LEN+5)); 00612400
XCK(TOCHAR(NUM)); % Block number 00613000
XCK(TYP); % Block type 00614000
00615000
IF LEN NEQ 0 THEN % Data if needed 00616000
FOR IX := 0 STEP 1 UNTIL LEN -1 DO 00617000
XCK(REAL(DATA[IX], 1)); 00618000
00619000
IF STATE = "S" OR 00620100
STATE = "R" OR 00620200
YOUR_BLK_CK = "1" THEN 00620300
BEGIN % Kermit primative checksum 00620400
CHKSUM := (CHKSUM.[7:2] + CHKSUM.[5:6]).[5:6]; 00620500
REPLACE LBUF[OX:=OX+1] BY TOCHAR(CHKSUM).LOWBYTE FOR 1; 00620600
E_ST " ONE-BYTE CK=", TOCHAR(CHKSUM).LOWBYTE FOR 1, 00620601
"...", LBUF[OX-3] FOR 4, "..." E_EN; 00620602
END 00620800
ELSE 00620900
BEGIN % Fancy 3-byte CRC 00621000
CHKSUM := CALCULATE_CRC(LBUF, 1, OX); 00621100
REPLACE LBUF[OX:=OX+1] BY 00621200
TOCHAR(CHKSUM.[15:4]).LOWBYTE FOR 1, % First byte 00621300
TOCHAR(CHKSUM.[11:6]).LOWBYTE FOR 1, % Second byte 00621400
TOCHAR(CHKSUM.[5:6]).LOWBYTE FOR 1; % Third byte 00621500
OX := OX+2; 00621600
E_ST " THREE-BYTE CRC, ", LBUF[OX-5] FOR 6 E_EN; 00621601
END; 00621610
END; 00621700
% ------------------------------------------------------------- 00621800
PROCEDURE LONG_PACK; 00621900
BEGIN 00622000
E_ST "LONG PACKS...WHY???" E_EN; 00622001
REPLACE LBUF[0] BY SOH.LOWBYTE FOR 1; 00622100
XCK(TOCHAR(0)); % Length=0 says this is long data packet 00622200
XCK(TOCHAR(NUM)); % Packet number 00622300
XCK(TYP); % Should be "D" only 00622400
IX := LEN + (YOUR_BLK_CK-"0"); 00622500
XCK(TOCHAR(IX DIV 95)); % Length, most significant part 00622600
XCK(TOCHAR(IX MOD 95)); % Length, least significant part 00622700
IX := TOCHAR( (CHKSUM.[7:2]+CHKSUM.[5:6]).[5:6] );% HDR BCC 00622800
XCK( IX ); 00622810
IF YOUR_BLK_CK = "1" THEN 00622900
BEGIN 00623000
FOR IX := 0 STEP 1 UNTIL LEN-1 DO 00623100
XCK(REAL(DATA[IX], 1)); 00623200
CHKSUM := (CHKSUM.[7:2]+CHKSUM.[5:6]).[5:6]; 00623300
REPLACE LBUF[OX:=OX+1] BY TOCHAR(CHKSUM).LOWBYTE FOR 1; 00623400
END 00623500
ELSE 00623600
BEGIN % Fancy 3-byte CRC 00623700
REPLACE LBUF[OX:=OX+1] BY DATA FOR LEN; 00623800
OX := OX+LEN; 00623900
CHKSUM := CALCULATE_CRC(LBUF, 1, OX-1); 00624000
REPLACE LBUF[OX] BY 00624100
TOCHAR(CHKSUM.[15:4]).LOWBYTE FOR 1, % First byte 00624200
TOCHAR(CHKSUM.[11:6]).LOWBYTE FOR 1, % Second byte 00624300
TOCHAR(CHKSUM.[5:6]).LOWBYTE FOR 1; % Third byte 00624400
OX := OX+2; 00624410
END; 00624420
00624500
END; 00624700
00624800
% ----------------------------------------------------------- 00624900
00625000
IF LOGNUM_OPEN THEN BEGIN 00625010
REPLACE PTEMP:PBUF BY "SPACK LEN="; 00625020
FOUR_ASCII_DIGITS(LEN, PTEMP); 00625030
REPLACE PTEMP:PTEMP BY " TYPE=", TYP.[7:48] FOR 1, " " FOR 10; 00625040
PLEN:=OFFSET(PTEMP); 00625050
WRITE(LOGNUM, PLEN, PBUF) ; 00625060
END; 00625070
IF (LEN > MAX_SND_DATA) AND (TYP = "D") THEN 00625100
LONG_PACK 00625200
ELSE 00625300
REGULAR_PACK; 00625400
00625500
IF LBUF[OX]=" " THEN % Unisys has troubles with trailing blank 00625510
REPLACE LBUF[OX:=*+1] BY 4"7F" FOR 1; 00625520
IF DEBUG_MODE > 0 AND LOGNUM_OPEN THEN 00625600
BEGIN 00625700
WRITE_LOG(LBUF, OX+1, SPACK_PACK); 00628000
END; 00629000
00630000
REPLACE LBUF[OX:=OX+1] BY YOUR_EOL.LOWBYTE FOR 1; % Set end of lin00631000
OX := OX + 1; 00632000
00633000
IF PAUSE_CNT NEQ 0 THEN 00634000
BEGIN 00635000
P_INT := PAUSE_CNT/10; 00636000
WHEN(P_INT); % Pause for turnaround 00637000
END; 00638000
00639000
WRITE(CONUM, OX+2, LBUF); % Write the block 00640000
00641000
END; 00642000
00643000
% **************************************************************** 00644000
$ PAGE 00645000
BOOLEAN PROCEDURE RPACK(TYP,LEN,NUM,DATA); 00646000
REAL TYP ; 00647000
INTEGER LEN,NUM ; 00648000
ASCII ARRAY DATA[0]; 00649000
BEGIN 00650000
00651000
INTEGER IX, % General Index 00652000
PLEN, % Packet length 00655000
CHK_TYPE; 00655100
00656000
BOOLEAN R_ERROR, % Error Flag 00657000
DONE; % Done Flag 00657100
00657200
REAL CCHKSUM, % Calculated checksum 00657300
RCHKSUM; % Received checksum 00658000
00659000
POINTER PACKET; 00660000
00661000
LABEL XIT; % Fast get-away 00661100
00661200
% ----------------------------------------------------------- 00662000
00663000
REPLACE LBUF BY 0 FOR SIZE(W_LBUF) WORDS; 00664000
REPLACE LBUF BY 0 FOR (LBUF_BYTESIZE -1); 00665000
00666000
IF STATE = "S" OR 00667000
STATE = "R" OR 00667100
YOUR_BLK_CK = "1" THEN 00667200
CHK_TYPE := 1 00667300
ELSE 00667400
CHK_TYPE := 3; 00667500
00668000
LBUFCNT := REAL(READ(CINUM[TIMELIMIT MY_TO], LBUF_BYTESIZE, LBUF));00669000
00670000
IF BOOLEAN(LBUFCNT) THEN 00671000
BEGIN % Timeout 00672000
R_ERROR := TRUE; 00673000
00674000
E_ST "RPACK - Timeout" E_EN; 00675000
END 00676000
ELSE 00677000
BEGIN % Have a packet 00678000
00679000
LBUFCNT:=LBUFCNT.[47:20]; % How much was read 00679100
IF DEBUG_MODE > 0 AND LOGNUM_OPEN THEN 00680000
BEGIN 00681000
REPLACE PBUF BY " " FOR 108; % Keeps trash out of log 00681100
WRITE_LOG(LBUF, LBUFCNT, RPACK_PACK); 00684000
END; 00685000
00686000
IX := 0; 00687000
WHILE NOT (DONE OR R_ERROR) DO 00688000
BEGIN % Look for SOH 00689000
IF REAL(LBUF[IX], 1) = SOH THEN 00690000
BEGIN 00691000
DONE := TRUE; 00692000
END 00693000
ELSE 00694000
BEGIN 00695000
IX := IX + 1; 00696000
IF IX > (LBUFCNT - 4) THEN 00697000
BEGIN % SOH not found 00698000
R_ERROR := TRUE; 00699000
E_ST "RPACK - SOH not found" E_EN; 00700000
END; % No SOH 00701000
END; % Not SOH 00702000
END; % while 00703000
END; % Have a packet 00704000
00705000
00706000
IF R_ERROR THEN 00707000
BEGIN 00707100
RPACK := FALSE; 00707200
GO TO XIT;; 00707300
END; 00707400
00708000
% Something in the buffer that starts with SOH. 00709000
% Let's see if everything else looks good. 00710000
00711000
PACKET := LBUF[IX]; % address packet 00712000
00713000
PLEN := UNCHAR(REAL(PACKET, 2).[7:8]); 00714000
IF PLEN > 0 THEN 00714100
BEGIN % Regular packets 00714200
IF DEBUG_MODE>0 AND LOGNUM_OPEN THEN BEGIN 00714209
REPLACE PTEMP:PBUF BY "LBUFCNT="; 00714210
FOUR_ASCII_DIGITS(LBUFCNT, PTEMP); 00714212
REPLACE PTEMP:PTEMP BY " PLEN="; 00714230
FOUR_ASCII_DIGITS(PLEN, PTEMP); 00714240
REPLACE PTEMP:PTEMP BY " LONGPACK_SIZE="; 00714250
FOUR_ASCII_DIGITS(LONGPACK_SIZE, PTEMP); 00714260
WRITE(LOGNUM, OFFSET(PTEMP), PBUF); 00714270
END; 00714280
PLEN := PLEN+2; 00714300
IF (IX + PLEN > LBUFCNT) OR 00715000
(PLEN > MAX_RCV_SIZE + 2) OR 00716000
(PLEN < 5) THEN 00717000
BEGIN % Length is not reasonable 00718000
R_ERROR := TRUE; 00719000
E_ST "RPACK - Invalid length" E_EN; 00720000
END 00721000
ELSE 00722000
BEGIN % Length is reasonable 00724000
IF PACKET+3 = "N" THEN % NAKS get special handling 00725000
CHK_TYPE := PLEN-4; 00725010
00725020
IF CHK_TYPE = 1 THEN 00725100
BEGIN % Kermit primative checksum 00725400
CCHKSUM := 0; 00725500
THRU PLEN-2 DO 00725600
CCHKSUM := *+REAL( LBUF[IX:=*+1], 1); 00725700
00725800
CCHKSUM := (CCHKSUM.[7:2] + CCHKSUM.[5:6]).[5:6]; 00725810
CCHKSUM := TOCHAR(CCHKSUM); 00725900
00726000
RCHKSUM := REAL( LBUF[IX+1], 1 ); 00726100
END 00726200
ELSE 00726300
BEGIN 00726400
CCHKSUM := CALCULATE_CRC(LBUF, IX+1, PLEN-4); 00726500
00726600
RCHKSUM := UNCHAR(REAL(PACKET+(PLEN-1), 1)) % (10:100726700
& UNCHAR(REAL(PACKET+(PLEN-2), 1))[11:6] 00726800
& UNCHAR(REAL(PACKET+(PLEN-3), 1))[15:4]; 00726900
00726910
PLEN := PLEN-2; 00726920
END; 00727000
00733000
IF CCHKSUM NEQ RCHKSUM THEN 00734000
BEGIN % Bad checksum 00735000
R_ERROR := TRUE; 00736000
E_ST "RPACK - CHKSUM Error" E_EN; 00737000
END; 00738000
END; 00739000
END 00739010
ELSE 00739020
BEGIN % Long packets 00739030
PLEN:=95*UNCHAR(REAL(PACKET+4, 1))+UNCHAR(REAL(PACKET+5, 1)); 00739040
IF DEBUG_MODE>0 AND LOGNUM_OPEN THEN BEGIN 00739051
REPLACE PTEMP:PBUF BY "LBUFCNT="; 00739052
FOUR_ASCII_DIGITS(LBUFCNT, PTEMP); 00739053
REPLACE PTEMP:PTEMP BY " PLEN="; 00739055
FOUR_ASCII_DIGITS(PLEN, PTEMP); 00739056
REPLACE PTEMP:PTEMP BY " LONGPACK_SIZE="; 00739059
FOUR_ASCII_DIGITS(LONGPACK_SIZE, PTEMP); 00739060
WRITE(LOGNUM, OFFSET(PTEMP), PBUF); 00739061
END; 00739062
IF (PLEN > LBUFCNT) OR 00739063
(PLEN > LONGPACK_SIZE+10) THEN 00739070
BEGIN 00739080
R_ERROR := TRUE; 00739090
E_ST "RPACK - Invalid longpack length" E_EN; 00739100
END 00739110
ELSE 00739120
BEGIN 00739130
IF PACKET+3 NEQ "D" THEN 00739140
BEGIN 00739150
R_ERROR := TRUE; 00739160
E_ST "RPACK - Longpack not data" E_EN; 00739170
END 00739180
ELSE 00739190
BEGIN % Calculate header checksum 00739200
CCHKSUM := 0; 00739210
FOR IX := 1 STEP 1 UNTIL 5 DO 00739220
CCHKSUM := CCHKSUM + REAL(PACKET+IX, 1); 00739230
00739240
IX := IX-6; % Restore to SOH 00739242
IF (CCHKSUM.[7:2]+CCHKSUM.[5:6]).[5:6] 00739250
NEQ UNCHAR(REAL(PACKET+6, 1)) THEN 00739260
BEGIN 00739270
R_ERROR := TRUE; 00739280
E_ST "RPACK - Header checksum error" E_EN; 00739290
END 00739300
ELSE 00739310
BEGIN 00739320
IF YOUR_BLK_CK = "1" THEN 00739330
BEGIN 00739340
FOR IX := 6 STEP 1 UNTIL PLEN-2+7 DO 00739350
CCHKSUM:=CCHKSUM+REAL(PACKET+IX, 1); 00739360
CCHKSUM := 00739362
(CCHKSUM.[7:2]+CCHKSUM.[5:6]).[5:6]; 00739364
00739370
RCHKSUM := 00739380
UNCHAR( REAL(PACKET+(PLEN-1+7), 1) ); 00739382
END 00739390
ELSE 00739400
BEGIN 00739410
CCHKSUM := 00739420
CALCULATE_CRC(LBUF, IX+1, PLEN-4+7); 00739430
00739440
RCHKSUM := REAL(LBUF[IX+7+PLEN-3], 3); 00739450
E_ST "RECVD X-SUM=", 00739452
RCHKSUM.[23:48] FOR 3, 00739454
":::" E_EN; 00739456
RCHKSUM := UNCHAR(RCHKSUM.[7:8]) 00739460
& UNCHAR(RCHKSUM.[15:8])[11:5:6] 00739470
& UNCHAR(RCHKSUM.[23:8])[15:3:4];00739480
00739490
% PLEN := PLEN-2; 00739500
END; 00739510
00739520
IF CCHKSUM NEQ RCHKSUM THEN 00739530
BEGIN 00739540
R_ERROR := TRUE; 00739550
E_ST 00739560
"RPACK - Longpack checksum error" 00739570
E_EN; 00739580
END; 00739590
END; 00739600
END; 00739610
END; 00739620
END; 00740000
00741000
IF NOT R_ERROR THEN 00742000
BEGIN % Packet OK, return the needed info 00743000
TYP := REAL(PACKET+3, 1); 00744000
NUM := UNCHAR(REAL(PACKET+2, 1)); 00745000
IF UNCHAR( REAL(PACKET+1, 1) ) NEQ 0 THEN 00746000
REPLACE DATA BY PACKET+4 FOR (LEN:=PLEN-5) 00747000
ELSE 00748000
REPLACE DATA BY PACKET+7 FOR (LEN:=PLEN-(YOUR_BLK_CK-"0")); 00748100
RPACK := TRUE; 00749000
END 00750000
ELSE 00751000
RPACK := FALSE; 00752000
XIT: 00752100
00752200
END; 00753000
$ PAGE 00754000
PROCEDURE BUFILL(DATA,CNT,STAT); 00755000
ASCII ARRAY DATA[0] ; 00756000
INTEGER CNT,STAT ; 00757000
BEGIN 00758000
00759000
BOOLEAN DONE; 00760000
00761000
REAL T, 00762000
T7, 00763000
INCLEN, 00764000
RPT_CNT, 00765000
IX, 00766000
CLEFT, 00767000
BUF_MAX; 00767100
00768000
BOOLEAN TRY_REPEAT; 00769000
00770000
POINTER INC_P; 00770100
00770200
OWN ASCII ARRAY INCBUF[0:5]; % Intermediate Char Buf 00771000
00772000
% ----------------------------------------------------------- 00773000
00774000
DEFINE GETCHAR(CHR) = 00775000
BEGIN 00777000
% Extract a char from the buffer and do not increment 00778000
% the index. True is returned if EOF or some error 00779000
% condition occurs (STAT is set accordingly). 00780000
% 00781000
% If the buffer index (DBUFINX) is equal to the count 00782000
% (DBUFCNT) the buffer is empty. If in binary mode, 00783000
% we simply get another record. Otherwise (ASCII) 00784000
% we return EOL. In this case DBUFINX will equal 00785000
% DBUFCNT + 1 the next time thru. 00786000
00787000
DONE := FALSE; 00788000
00789000
IF DBUFINX >= DBUFCNT THEN 00790000
BEGIN % No data in buffer 00791000
IF IMAGE OR (DBUFINX > DBUFCNT) THEN 00792000
BEGIN % Fill up the buffer 00793000
DBUFCNT := REAL(READ(DNUM, SND_RECLEN, DBUF)); 00794000
IF BOOLEAN(DBUFCNT) AND NOT BOOLEAN(DBUFCNT.[9:1]) 00795000
THEN BEGIN % Read error 00796000
STAT := -1; 00797000
E_ST "BUFILL - Disc read error" E_EN; 00798000
DONE := TRUE; 00799000
END 00800000
ELSE 00801000
IF BOOLEAN(DBUFCNT.[9:1]) THEN 00802000
BEGIN % End of file 00803000
DONE := TRUE; 00804000
IF CNT = 0 THEN STAT := 1; 00805000
DBUFCNT := 0; 00805100
END 00806000
ELSE 00807000
BEGIN % Read went OK 00808000
00809000
DBUFINX := (DBUFCNT := SND_RECLEN) - 1; 00809100
IF NOT IMAGE THEN 00810000
BEGIN % Suppress trailing blanks 00811000
WHILE DBUFINX > 0 AND 00813000
DBUF[DBUFINX] = " " DO 00814000
BEGIN 00815000
DBUFINX := DBUFINX - 1; 00816000
END; 00817000
DBUFCNT := DBUFINX + 1; 00818000
END; 00819000
00820000
DBUFINX := 0; 00821000
% +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 00822000
% 00823000
% WARNING: Zero length binary records will not be handled 00824000
% properly. 00825000
% 00826000
% +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 00827000
IF DBUFCNT > 0 THEN 00828000
CHR := REAL(DBUF[0], 1) 00829000
ELSE 00830000
CHR := CR; 00831000
END; 00832000
END 00833000
ELSE 00834000
BEGIN % Return EOL 00835000
CHR := CR; 00836000
END; 00837000
END % No data in buffer 00838000
ELSE 00839000
BEGIN 00840000
CHR := REAL(DBUF[DBUFINX], 1); 00841000
END; 00842000
END; 00843000
#; 00843100
00844000
% ----------------------------------------------------------- 00845000
00846000
DEFINE PUTCHR(CHR) = 00847000
BEGIN 00850000
REPLACE INC_P:INC_P BY CHR.LOWBYTE FOR 1; 00851000
% INCLEN := INCLEN + 1; 00852000
END 00853000
#; 00853100
00854000
% ----------------------------------------------------------- 00855000
00855100
DEFINE PUT_Q_CHR(CHR) = 00855200
BEGIN 00855300
REPLACE INC_P:INC_P BY (MY_Q_CTL & CHR [15:8]).[15:48] FOR 2; 00855400
% INCLEN := INCLEN + 2; 00855500
END 00855600
#; 00855700
00855800
% ------------------------------------------------------------ 00855900
00856000
CNT := 0; 00857000
STAT := 0; 00858000
IF LONGPACK_SIZE > MAX_SND_DATA THEN 00858600
BUF_MAX := LONGPACK_SIZE 00858700
ELSE 00858800
BUF_MAX := MAX_SND_DATA; 00858900
CLEFT := BUF_MAX; % Compute room 00859000
WHILE NOT DONE DO 00860000
BEGIN 00861000
GETCHAR(T); 00862000
IF NOT DONE THEN 00863000
BEGIN 00864000
% Transfer the character to an intermediate buffer 00865000
% (INCBUF). If a multi-character sequence is 00866000
% generated, it is placed in INCBUF in reverse 00867000
% order. The sequence is re-inverted later. 00868000
00869000
T7 := T.[6:7]; % Get low seven bits 00870000
00871000
INCLEN := 0; 00872000
INC_P := INCBUF; 00872100
TRY_REPEAT := USE_REPEAT; 00873000
IF (T7 = CR) AND (NOT IMAGE) THEN 00874000
BEGIN % Generate END-of-line sequence 00875000
TRY_REPEAT := FALSE; 00876000
PUT_Q_CHR(CTL(LF)); 00877000
% PUTCHR(MY_Q_CTL); 00878000
PUT_Q_CHR(CTL(CR)); 00879000
% PUTCHR(MY_Q_CTL); 00880000
END 00881000
ELSE 00882000
BEGIN 00883000
IF T7 < SP OR T7 = A_DEL THEN 00884000
BEGIN % Control char 00885000
IF QUOTE_8 THEN 00886000
PUT_Q_CHR(CTL(T7)) 00887000
ELSE 00888000
PUT_Q_CHR(CTL(T)); 00889000
% PUTCHR(MY_Q_CTL); 00890000
END 00891000
ELSE 00892000
IF (T7 = MY_Q_CTL) OR 00893000
(QUOTE_8 AND T7 = Q_8) OR 00894000
(USE_REPEAT AND T7 = RPT_CHR) THEN 00895000
BEGIN % Quote a not-control char 00896000
IF QUOTE_8 THEN 00897000
PUT_Q_CHR(T7) 00898000
ELSE 00899000
PUT_Q_CHR(T); 00900000
% PUTCHR(MY_Q_CTL); 00901000
END 00902000
ELSE 00903000
BEGIN % Regular char 00904000
IF QUOTE_8 THEN 00905000
PUTCHR(T7) 00906000
ELSE 00907000
PUTCHR(T); 00908000
END; 00909000
00910000
IF QUOTE_8 AND (T NEQ T7) THEN 00911000
PUTCHR(Q_8); 00912000
END; 00913000
00914000
% The single char sequence has been generated. 00915000
% Continue if it will fit in the buffer. 00916000
00917000
IF (INCLEN:=OFFSET(INC_P)) > CLEFT THEN 00918000
BEGIN % It won't fit 00919000
DONE := TRUE; 00920000
END 00921000
ELSE 00922000
BEGIN % Accepted 00923000
DBUFINX := DBUFINX +1; 00924000
IF TRY_REPEAT AND (CLEFT - INCLEN >= 2) THEN 00925000
BEGIN 00926000
00927000
% OK, now we do repeat processing. 00928000
% Count the adjacent occurences. 00929000
00930000
IX := DBUFINX; 00931000
WHILE (IX < DBUFCNT) AND 00932000
(REAL(DBUF[IX], 1) = T) DO 00933000
BEGIN 00934000
IX := IX +1; 00935000
END; 00936000
00937000
RPT_CNT := IX - DBUFINX + 1; 00938000
IF RPT_CNT > 94 THEN 00939000
RPT_CNT := 94; 00940000
00941000
% Use the repeat count only if it 00942000
% saves space in the buffer. 00943000
00944000
IF (INCLEN +2) < (INCLEN * RPT_CNT) THEN 00945000
BEGIN % Use repeat 00946000
PUTCHR(TOCHAR(RPT_CNT)); 00947000
PUTCHR(RPT_CHR); 00948000
DBUFINX := DBUFINX + RPT_CNT - 1; 00949000
INCLEN := INCLEN + 2; 00949100
END; 00950000
END; 00951000
00952000
% Transfer to the buffer 00953000
00954000
WHILE INCLEN > 0 DO 00955000
BEGIN 00956000
REPLACE DATA[CNT] BY INCBUF[INCLEN:=*-1] FOR 1;00958000
CNT := CNT + 1; 00959000
END; 00960000
00961000
CLEFT := BUF_MAX - CNT; 00962000
IF CLEFT <= 0 THEN DONE := TRUE; 00963000
END; 00964000
END; 00965000
END; 00966000
END; 00967000
$ PAGE 00968000
PROCEDURE BUFEMP(DATA,CNT); 00969000
ASCII ARRAY DATA[0] ; 00970000
INTEGER CNT ; 00971000
BEGIN 00972000
00973000
INTEGER I, 00974000
RPT_CNT, 00975000
T, 00976000
T_HI, 00977000
T7; 00978000
00979000
% ---------------------------------------------------------------- 00980000
00980100
DEFINE HEXIFY(X) = 00980200
(X + (IF X<10 THEN 7"0" ELSE 7"A")) 00980300
#; 00980400
00980500
% ---------------------------------------------------------------- 00980600
00981000
DEFINE NCHAR = 00982000
BEGIN 00983000
IF (T7:=(T:=REAL(DATA[I], 1)).[6:7]) < 7" " THEN 00984000
IF LOGNUM_OPEN THEN 00984100
BEGIN 00984200
REPLACE PTEMP:PBUF BY 00984300
7"BUFEMP - nonprintable char = HEX ", 00984400
HEXIFY(T.[7:4]).LOWBYTE FOR 1, 00984500
HEXIFY(T.[3:4]).LOWBYTE FOR 1; 00984700
REPLACE PTEMP BY " " FOR 108-OFFSET(PTEMP); 00984900
WRITE(LOGNUM, 108, PBUF); 00985000
END; 00985100
I := I + 1; 00986000
END; 00987000
#; 00987100
00988000
% ---------------------------------------------------------------- 00989000
00990000
00990200
WHILE I < CNT DO 00991000
BEGIN 00992000
T_HI := 0; % Hold high bit here IF quote 8 00993000
00994000
RPT_CNT := 1; 00995000
00996000
NCHAR; 00997000
IF USE_REPEAT AND (T7 = RPT_CHR) THEN 00998000
BEGIN % Process repeat 00999000
NCHAR; 01000000
RPT_CNT := UNCHAR(T7); 01001000
NCHAR; 01002000
END; 01003000
01004000
IF QUOTE_8 AND (T7 = Q_8) THEN 01005000
BEGIN 01006000
T_HI := 128; 01007000
NCHAR; 01008000
END; 01009000
01010000
IF T7 = YOUR_Q_CTL THEN 01011000
BEGIN 01012000
NCHAR; 01013000
IF T7 >= 4"3F" AND T7 <= 4"5F" THEN 01014000
T := CTL(T); 01015000
T7 := T.[6:7]; 01016000
END; 01017000
01018000
IF QUOTE_8 THEN 01019000
T := T_HI + T7; % Got the real character 01020000
01021000
IF (NOT IMAGE) AND T7 = CR THEN 01022000
RPT_CNT := 0; % Throw away CR 01023000
01024000
IF EXP_TABS AND T7=HTAB THEN 01025000
BEGIN 01026000
RPT_CNT:=8*RPT_CNT - (DBUFINX MOD 8); 01027000
T:=" "; 01028000
END; 01029000
01030000
% Transfer to disc buffer 01031000
01032000
WHILE RPT_CNT > 0 DO 01033000
BEGIN 01034000
RPT_CNT := RPT_CNT - 1; 01035000
IF (NOT IMAGE) AND (T7 = LF) THEN 01036000
BEGIN 01037000
IF DBUF_WRITTEN THEN 01038000
BEGIN 01039000
DBUF_WRITTEN := FALSE; 01040000
IF DBUFINX > 0 THEN 01041000
FLUSH_DBUF; 01042000
END 01043000
ELSE 01044000
FLUSH_DBUF; 01045000
END 01046000
ELSE 01047000
BEGIN 01048000
REPLACE DBUF[DBUFINX] BY T.LOWBYTE FOR 1; 01049000
IF DBUFINX:=*+1 >= RCV_RECLEN THEN 01051000
BEGIN 01052000
FLUSH_DBUF; 01053000
DBUF_WRITTEN := TRUE; 01054000
END; 01055000
END; 01056000
END; 01057000
END; 01058000
END; 01059000
$ PAGE 01060000
BOOLEAN PROCEDURE CBUFXLT(IDATA,ICNT,ODATA,OCNT,OMAX); 01062000
VALUE ICNT, OMAX ; 01063000
ASCII ARRAY IDATA[0], ODATA[0] ; 01064000
INTEGER ICNT, OCNT,OMAX ; 01065000
BEGIN 01066000
01067000
INTEGER I, 01068000
RPT_CNT, 01069000
T, 01070000
T_HI, 01071000
T7; 01072000
01073000
% ---------------------------------------------------------------- 01074000
01075000
DEFINE NCHAR = 01076000
BEGIN 01077000
T := REAL(IDATA[I], 1); 01078000
T7 := T.[6:7]; 01079000
I := I + 1; 01080000
END; 01081000
#; 01081100
01082000
% ---------------------------------------------------------------- 01083000
01084000
OCNT := 0; 01085000
CBUFXLT := TRUE; 01086000
01087000
WHILE I < ICNT DO 01088000
BEGIN 01089000
T_HI := 0; % Hold high bit here IF quote 8 01090000
01091000
RPT_CNT := 1; 01092000
01093000
NCHAR; 01094000
IF USE_REPEAT AND (T7 = RPT_CHR) THEN 01095000
BEGIN % Process repeat 01096000
NCHAR; 01097000
RPT_CNT := UNCHAR(T7); 01098000
NCHAR; 01099000
END; 01100000
01101000
IF QUOTE_8 AND (T7 = Q_8) THEN 01102000
BEGIN 01103000
T_HI := 128; 01104000
NCHAR; 01105000
END; 01106000
01107000
IF T7 = YOUR_Q_CTL THEN 01108000
BEGIN 01109000
NCHAR; 01110000
IF T7 >= 4"3F" AND T7 <= 4"5F" THEN 01111000
T := CTL(T); 01112000
T7 := T.[6:7]; 01113000
END; 01114000
01115000
IF QUOTE_8 THEN 01116000
T := T_HI + T7; % Got the real character 01117000
01118000
01119000
% Transfer to output buffer 01120000
01121000
WHILE RPT_CNT > 0 DO 01122000
BEGIN 01123000
RPT_CNT := RPT_CNT - 1; 01124000
REPLACE ODATA[OCNT] BY T.LOWBYTE FOR 1; 01125000
IF OCNT:=*+1 >= OMAX THEN 01127000
BEGIN 01128000
I := 0; 01129000
CBUFXLT := FALSE; 01130000
END; 01131000
END; 01132000
END; 01133000
END; 01134000
$ PAGE 01135000
BOOLEAN PROCEDURE UNQFNAME(FNAME,LEN); 01137000
VALUE LEN ; 01138000
INTEGER LEN ; 01139000
ASCII ARRAY FNAME[0] ; 01140000
BEGIN 01141000
% 01142000
% ASCII ARRAY BA_TEMP(0:37); 01143000
% 01144000
% INTEGER I_ERR, 01145000
% I_PARM; 01146000
% 01147000
% % ---------------------------------------------------------- 01148000
% 01149000
% MOVE BA_TEMP := "listf "; 01150000
% MOVE BA_TEMP(6) := FNAME,(LEN); 01151000
% MOVE BA_TEMP(6+LEN) := ";$NULL"; 01152000
% BA_TEMP(12 + LEN) := %15; 01153000
% COMMAND(BA_TEMP,I_ERR,I_PARM); 01154000
% IF I_ERR = 907 THEN 01155000
UNQFNAME := TRUE 01156000
% ELSE 01157000
% UNQFNAME := FALSE; 01158000
END; 01159000
01160000
$ PAGE 01161000
01163000
BOOLEAN PROCEDURE MAKE_U_FNAME(FNAME,LEN); % Disabled. Used for HP only.01164000
ASCII ARRAY FNAME[0] ; 01165000
INTEGER LEN ; 01166000
BEGIN 01167000
01168000
INTEGER FIX, % From Index 01169000
TIX, % To Index 01170000
ITEMP, % Scratch 01171000
BLEN; % Base Length 01172000
01173000
BOOLEAN ALPH, % Char Alpha 01174000
NUM, % Char is Num 01175000
DONE; % Loop Flag 01176000
01177000
% ---------------------------------------------------------- 01178000
01179000
FIX := 0; 01180000
TIX := 0; 01181000
01182000
WHILE FIX < LEN DO 01183000
BEGIN 01184000
ITEMP := REAL(FNAME[FIX], 1); 01185000
01186000
IF ITEMP >= 4"61" AND % a - z 01187000
ITEMP <= 4"7A" THEN ITEMP := ITEMP - 4"20"; % Upshift 01188000
01189000
ALPH := FALSE; 01190000
NUM := FALSE; 01191000
01192000
IF ITEMP >= 7"A" AND % A - Z 01193000
ITEMP <= 7"Z" THEN ALPH := TRUE 01194000
ELSE 01195000
IF ITEMP >= 7"0" AND % 0 - 9 01196000
ITEMP <= 7"9" THEN NUM := TRUE; 01197000
01198000
IF (ALPH AND (TIX = 0)) OR 01199000
((ALPH OR NUM) AND (TIX > 0)) THEN 01200000
BEGIN 01201000
REPLACE FNAME[TIX] BY ITEMP.LOWBYTE FOR 1; 01202000
TIX := TIX + 1; 01203000
END; 01204000
01205000
FIX := FIX + 1; 01206000
END; 01207000
01208000
LEN := TIX; 01209000
01210000
% ------------------------------------------------ 01211000
% File name now in native format. Adjust length. 01212000
% ------------------------------------------------ 01213000
01214000
IF LEN > 8 THEN LEN := 8 % Truncate 01215000
ELSE 01216000
IF LEN = 0 THEN 01217000
BEGIN % Nothing left, use default 01218000
REPLACE FNAME BY "KMT"; 01219000
LEN := 3; 01220000
END; 01221000
01222000
% ---------------------------------------- 01223000
% File name is now OK , check uniqueness 01224000
% ---------------------------------------- 01225000
01226000
IF UNQFNAME(FNAME,LEN) THEN 01227000
BEGIN % OK, we_re done 01228000
MAKE_U_FNAME := TRUE; 01229000
END 01230000
ELSE 01231000
BEGIN 01232000
% ---------------------------------------------- 01233000
% Append two numeric chars (00-99) to the name. 01234000
% ----------------------------------------------- 01235000
01236000
BLEN := IF LEN > 12 THEN 12 ELSE LEN; 01237000
ITEMP := 1; 01238000
DONE := FALSE; 01239000
WHILE (ITEMP < 99) AND NOT DONE DO 01240000
BEGIN 01241000
REPLACE FNAME[BLEN] BY ITEMP FOR 2 DIGITS; % *PROBLEM* 01242000
LEN := BLEN + 2; 01244000
IF UNQFNAME(FNAME,LEN) THEN 01245000
DONE := TRUE 01246000
ELSE 01247000
ITEMP := ITEMP + 1; 01248000
END; 01249000
01250000
MAKE_U_FNAME := NOT DONE; 01251000
END; 01252000
END; 01253000
$ PAGE 01254000
PROCEDURE P_EPACK(DATA,LEN); 01256000
VALUE LEN ; 01257000
INTEGER LEN ; 01258000
ASCII ARRAY DATA[0] ; 01259000
BEGIN 01260000
01261000
DEFINE SEGMENTATION = NUTTIN#; 01262000
IF LOGNUM_OPEN THEN 01266000
WRITE(LOGNUM, LEN, DATA); 01267000
END; 01268000
$ PAGE 01269000
% **************************************************************** 01271000
01272000
REAL PROCEDURE SBREAK; 01274000
BEGIN 01275000
01276000
SBREAK := STATE; % Default is no change 01277000
NUMTRY := NUMTRY + 1; 01278000
IF NUMTRY > MAXTRY THEN 01279000
BEGIN 01280000
E_ST "SBREAK - Max retrys exceeded " E_EN; 01281000
SBREAK := "A"; 01282000
END 01283000
ELSE 01284000
BEGIN 01285000
SPACK("B",N,0,RP_DATA); 01286000
IF RPACK(RP,RP_LEN,RP_NUM,RP_DATA) THEN 01287000
BEGIN 01288000
IF RP = "Y" THEN 01289000
BEGIN 01290000
IF RP_NUM = N THEN 01291000
BEGIN 01292000
NUMTRY := 0; 01293000
N := NPNO(N); 01294000
SBREAK := "C"; 01295000
END; 01296000
END 01297000
ELSE 01298000
IF RP = "E" THEN 01299000
BEGIN 01300000
E_ST "SBREAK - E packet recieved" E_EN; 01301000
P_EPACK(RP_DATA,RP_LEN); 01302000
SBREAK := "A"; 01303000
END 01304000
ELSE 01305000
IF RP NEQ "N" THEN 01306000
BEGIN 01307000
E_ST "SBREAK - Unknown packet type" E_EN; 01308000
SBREAK := "A"; 01309000
END; 01310000
END; 01311000
END; 01312000
END; 01313000
$ PAGE 01313100
BOOLEAN PROCEDURE SENDSW(SFNAME,SFNLEN); 01314000
VALUE SFNLEN ; 01315000
ASCII ARRAY SFNAME[0] ; 01316000
INTEGER SFNLEN ; 01317000
BEGIN 01318000
01319000
BOOLEAN DONE, 01320000
FOPT; 01321000
01322000
INTEGER BFSTAT, 01323000
TEMP; 01323100
01324000
01325000
$ PAGE 01326000
PROCEDURE SPAR(DATA,LEN); 01327000
ASCII ARRAY DATA[0] ; 01328000
INTEGER LEN ; 01329000
BEGIN 01330000
REPLACE DATA BY 01330100
TOCHAR(MAX_RCV_SIZE).LOWBYTE FOR 1, % Biggest to send me 01331000
TOCHAR(MY_TO).LOWBYTE FOR 1, % When to time me out 01332000
TOCHAR(0).LOWBYTE FOR 1, % How many pads I need 01333000
CTL(0).LOWBYTE FOR 1, % Pad char to use for me 01334000
TOCHAR(CR).LOWBYTE FOR 1, % End-of-line char for me01335000
MY_Q_CTL.LOWBYTE FOR 1, % Control quote I send 01336000
P_Q_8 FOR 1, % Prefered 8 bit quote 01337000
MY_BLK_CK.LOWBYTE FOR 1, % 3-char CRC default 01338000
P_RPT_CHR FOR 1, % Preferred repeat prefix 01339000
TOCHAR(MY_CAPS).LOWBYTE FOR 1, % Extended capabilities 01339100
TOCHAR(0).LOWBYTE FOR 1, % Windowing (none here) 01339200
TOCHAR(LONGPACK_SIZE DIV 95).LOWBYTE FOR 1, % MAXL1 01339300
TOCHAR(LONGPACK_SIZE MOD 95).LOWBYTE FOR 1; % MAXL2 01339400
LEN := 13; 01340000
END; 01341000
01342000
% ----------------------------------------------------------- 01343000
01344000
$ PAGE 01345000
PROCEDURE RPAR(DATA,LEN); 01346000
VALUE LEN ; 01347000
INTEGER LEN ; 01348000
ASCII ARRAY DATA[0] ; 01349000
BEGIN 01350000
MAX_SND_SIZE := UNCHAR(REAL(DATA[0], 1)); % Max send size 01351000
% MAX_SND_DATA := MAX_SND_SIZE -3; % Max send data size 01352000
YOUR_TO := UNCHAR(REAL(DATA[1], 1)); % When I time you out 01353000
YOUR_PAD_COUNT := UNCHAR(REAL(DATA[2], 1));% Number of pads to send01354000
YOUR_PAD := CTL(REAL(DATA[3], 1)); % Your Pad char 01355000
YOUR_EOL := UNCHAR(REAL(DATA[4], 1)); % Your END-of-line 01356000
YOUR_Q_CTL := INTEGER(REAL(DATA[5], 1)); % Your control quote 01357000
01358000
QUOTE_8 := FALSE; 01359000
IF LEN > 6 THEN 01360000
BEGIN 01361000
IF REAL(DATA[6], 1)="Y" OR REAL(DATA[6], 1)=P_Q_8 THEN 01362000
BEGIN 01363000
Q_8 := P_Q_8; 01364000
QUOTE_8 := TRUE; 01365000
END; 01366000
END; 01367000
01368000
IF LEN > 7 THEN 01368100
YOUR_BLK_CK := REAL(DATA[7], 1) 01368200
ELSE 01368300
YOUR_BLK_CK := "1"; % No block check -> one-byte check 01368400
01369000
IF LEN > 8 AND REAL(DATA[8], 1) = P_RPT_CHR THEN 01370000
BEGIN 01371000
RPT_CHR := P_RPT_CHR; 01372000
USE_REPEAT := TRUE; % OK for repeat prefix 01373000
END 01374000
ELSE 01375000
BEGIN 01376000
USE_REPEAT := FALSE; % No repeat processing 01377000
END; 01378000
01378200
IF LEN >= 12 THEN 01378400
BEGIN % Other side agrees to long packets, maybe 01378420
YOUR_CAPS := 01378440
REAL(BOOLEAN(UNCHAR(REAL(DATA[9],1))) AND BOOLEAN(MY_CAPS));01378441
% Windowing, DATA(10), is unsupported in this prog 01378460
TEMP := 95*UNCHAR(REAL(DATA[11],1))+UNCHAR(REAL(DATA[12],1)); 01378480
IF TEMP > MAX_SND_SIZE THEN 01378500
BEGIN 01378510
IF TEMP < MAX_LONGPACK_SIZE THEN 01378520
LONGPACK_SIZE := TEMP-5-(YOUR_BLK_CK-"0") 01378530
ELSE 01378540
LONGPACK_SIZE := MAX_LONGPACK_SIZE; 01378550
END 01378560
ELSE 01378570
LONGPACK_SIZE := 0; % Long packets disallowed 01378580
END 01378590
ELSE 01378600
LONGPACK_SIZE := 0; 01378610
END; 01379000
$ PAGE 01380000
REAL PROCEDURE SINIT; 01381000
BEGIN 01382000
01383000
% ----------------------------------------------------------- 01384000
01385000
SINIT := STATE; % Default to return current state 01386000
NUMTRY := NUMTRY + 1; 01387000
IF NUMTRY > MAXTRY THEN 01388000
BEGIN 01389000
E_ST "SINIT - Max retrys exceeded" E_EN; 01390000
SINIT := "A"; % Abort 01391000
END 01392000
ELSE 01393000
BEGIN 01394000
SPAR(RP_DATA,RP_LEN); % Set up SI data 01395000
N := 0; % Always start SINIT at zero 01395100
SPACK("S",N,RP_LEN,RP_DATA); % And send it 01396000
01397000
IF RPACK(RP,RP_LEN,RP_NUM,RP_DATA) THEN 01398000
BEGIN 01399000
IF RP = "Y" THEN 01400000
BEGIN 01401000
IF RP_NUM = N THEN 01402000
BEGIN % Positive response 01403000
RPAR(RP_DATA,RP_LEN); % Get parameters 01404000
IF YOUR_BLK_CK NEQ "1" AND 01405000
YOUR_BLK_CK NEQ "3" THEN 01405100
BEGIN % Whatever that was, I can't do it 01405200
MY_BLK_CK := "1"; % Lets try again 01405300
N := 0; 01405400
SINIT := "S"; 01405500
END 01405600
ELSE 01405700
BEGIN % OK, let_s try it your way 01405800
MY_BLK_CK := YOUR_BLK_CK; 01405900
MAX_SND_DATA := MAX_SND_SIZE - 01406000
3-(YOUR_BLK_CK-"0"); 01406100
NUMTRY := 0; 01406200
N := NPNO(N); 01406300
SINIT:= "F"; 01406400
END; 01406500
END; 01408000
END 01409000
ELSE 01410000
IF RP = "E" THEN 01411000
BEGIN % Error packet 01412000
E_ST "SINIT - E packet recieved" E_EN; 01413000
P_EPACK(RP_DATA,RP_LEN); 01414000
SINIT := "A"; 01415000
END; 01416000
END; 01417000
END; 01418000
END; 01419000
$ PAGE 01420000
REAL PROCEDURE SFILE; 01421000
BEGIN 01422000
01423000
01424000
% ----------------------------------------------------------- 01425000
01426000
SFILE := STATE; % Default to current state 01427000
NUMTRY := NUMTRY + 1; 01428000
IF NUMTRY > MAXTRY THEN 01429000
BEGIN 01430000
E_ST "SFILE - Max retrys exceeded" E_EN; 01431000
SFILE := "A"; % Abort 01432000
END 01433000
ELSE 01434000
BEGIN 01435000
IF SFNLEN = 0 THEN 01436000
SPACK("X",N,0,SFNAME) % Header only 01437000
ELSE 01438000
SPACK("F",N,SFNLEN,SFNAME); % Normal file 01439000
01440000
IF RPACK(RP,RP_LEN,RP_NUM,RP_DATA) THEN 01441000
BEGIN 01442000
IF RP = "Y" THEN 01443000
BEGIN 01444000
IF RP_NUM = N THEN 01445000
BEGIN 01446000
DBUFCNT := 0; % Set disc buf empty 01447000
DBUFINX := 1; % Index=get next 01448000
01449000
BUFILL(PDATA,PDATACNT,BFSTAT); 01450000
IF BFSTAT = 0 THEN 01451000
BEGIN 01452000
NUMTRY := 0; 01453000
N := NPNO(N); 01454000
SFILE := "D"; 01455000
END 01456000
ELSE 01457000
BEGIN 01458000
E_ST "SFILE - BUFILL error" E_EN; 01459000
SFILE := "A"; 01460000
END; 01461000
END; 01462000
END 01463000
ELSE 01464000
IF RP = "E" THEN 01465000
BEGIN 01466000
P_EPACK(RP_DATA,RP_LEN); 01467000
SFILE := "A"; 01468000
END 01469000
ELSE 01470000
IF RP NEQ "N" THEN 01471000
BEGIN 01472000
SFILE := "A"; 01473000
E_ST "SFILE - Unknown packet type" E_EN; 01474000
END; 01475000
END; 01476000
END; 01477000
END; 01478000
% **************************************************************** 01479000
$ PAGE 01480000
REAL PROCEDURE SDATA; 01481000
BEGIN 01482000
LABEL RESYNC; % A sign of laziness and disorganization 01482100
% and expedience. 01482200
01483000
SDATA := STATE; % Default is return current state 01484000
01485000
NUMTRY := NUMTRY + 1; 01486000
IF NUMTRY > MAXTRY THEN 01487000
BEGIN 01488000
SDATA := "A"; 01489000
E_ST "SDATA - Retry count exceeded" E_EN; 01490000
END 01491000
ELSE 01492000
BEGIN 01493000
SPACK("D",N,PDATACNT,PDATA); 01494000
RESYNC: 01494900
IF RPACK(RP,RP_LEN,RP_NUM,RP_DATA) THEN 01495000
BEGIN 01496000
IF RP = "Y" THEN 01497000
BEGIN 01498000
IF RP_NUM = N THEN 01499000
BEGIN 01500000
NUMTRY := 0; 01501000
N := NPNO(N); 01502000
BUFILL(PDATA,PDATACNT,BFSTAT); 01503000
IF BFSTAT NEQ 0 THEN 01504000
BEGIN 01505000
SDATA := "Z"; 01506000
CLOSE(DNUM); 01507000
DNUM_OPEN:=FALSE; 01508000
END; 01509000
END 01510000
ELSE 01510100
IF RP_NUM = PPNO(N) THEN % ACK for previous packet01510200
BEGIN 01510300
E_ST "SDATA - prev ACK seen " E_EN; 01510400
GO TO RESYNC; % Sorry about this 01510600
END; 01510700
END 01511000
ELSE 01512000
IF RP = "E" THEN 01513000
BEGIN 01514000
E_ST "SDATA - E packet recieved" E_EN; 01515000
P_EPACK(RP_DATA,RP_LEN); 01516000
SDATA := "A"; 01517000
END 01518000
ELSE 01519000
IF RP NEQ "N" THEN 01520000
BEGIN 01521000
SDATA := "A"; 01522000
E_ST "SDATA - Unknown Packet Type" E_EN; 01523000
END 01524000
ELSE 01524100
E_ST "SDATA - NAK seen" E_EN; 01524200
END; 01525000
END; 01526000
END; 01527000
$ PAGE 01528000
REAL PROCEDURE SEOF; 01529000
BEGIN 01530000
01531000
SEOF := STATE; 01532000
NUMTRY := NUMTRY + 1; 01533000
IF NUMTRY > MAXTRY THEN 01534000
BEGIN 01535000
E_ST "SEOF - Max retrys exceeded" E_EN; 01536000
SEOF := "A"; 01537000
END 01538000
ELSE 01539000
BEGIN 01540000
SPACK("Z",N,0,RP_DATA); 01541000
IF RPACK(RP,RP_LEN,RP_NUM,RP_DATA) THEN 01542000
BEGIN 01543000
IF RP = "Y" THEN 01544000
BEGIN 01545000
IF RP_NUM = N THEN 01546000
BEGIN 01547000
NUMTRY := 0; 01548000
N := NPNO(N); 01549000
SEOF := "B"; 01550000
END; 01551000
END 01552000
ELSE 01553000
IF RP = "E" THEN 01554000
BEGIN 01555000
E_ST "SEOF - E packet recieved" E_EN; 01556000
P_EPACK(RP_DATA,RP_LEN); 01557000
SEOF := "A"; 01558000
END 01559000
ELSE 01560000
IF RP NEQ "N" THEN 01561000
BEGIN 01562000
SEOF := "A"; 01563000
E_ST "SEOF - Unknown packet type" E_EN; 01564000
END; 01565000
END; 01566000
END; 01567000
END; 01568000
01569000
$ PAGE 01570000
01571000
% **************************************************************** 01572000
01573000
01574000
NUMTRY := 0; 01574100
IF SFNLEN <= 0 THEN 01575000
BEGIN 01576000
STATE := "S"; % Normal file send 01577000
SFNLEN := -SFNLEN; % Make positive again 01578000
END 01579000
ELSE 01580000
STATE := "F"; % Sending text, skip SI 01581000
01582000
IF SND_BINARY = 1 THEN 01583000
BEGIN % Always binary 01584000
IMAGE := TRUE; 01585000
END 01586000
ELSE 01587000
IF SND_BINARY = 2 THEN 01588000
BEGIN % Always ASCII 01589000
IMAGE := FALSE; 01590000
END 01591000
ELSE 01592000
BEGIN % Auto, check file 01593000
% FGETINFO(DNUM,,FOPT); 01594000
% IF (FOPT AND %4) NEQ 0 THEN 01595000
% IMAGE := FALSE 01596000
% ELSE 01597000
IMAGE := TRUE; 01598000
END; 01599000
01600000
SND_RECLEN := DNUM.MAXRECSIZE 01600100
* (IF DNUM.FRAMESIZE = 48 THEN 6 ELSE 1); 01600200
01600300
WHILE NOT (DONE OR BLASTED) DO 01601000
BEGIN 01602000
IF STATE = "S" THEN STATE := SINIT 01603000
ELSE 01604000
IF STATE = "F" THEN STATE := SFILE 01605000
ELSE 01606000
IF STATE = "D" THEN STATE := SDATA 01607000
ELSE 01608000
IF STATE = "Z" THEN STATE := SEOF 01609000
ELSE 01610000
IF STATE="B" THEN 01611000
BEGIN 01611100
STATE := "C"; 01611200
DONE := TRUE; 01611300
END 01611400
ELSE 01612000
BEGIN 01613000
DONE := TRUE; 01614000
END; 01615000
END; 01616000
01617000
IF DNUM_OPEN THEN 01618000
BEGIN 01619000
CLOSE(DNUM); 01620000
DNUM_OPEN:=FALSE; 01621000
END; 01622000
IF STATE = "C" THEN 01623000
SENDSW := TRUE 01624000
ELSE 01625000
SENDSW := FALSE; 01626000
END; 01627000
$ PAGE 01628000
PROCEDURE R_RPAR(DATA,LEN); 01630000
VALUE LEN ; 01631000
INTEGER LEN ; 01632000
ASCII ARRAY DATA[0] ; 01633000
BEGIN 01634000
INTEGER TEMP; 01634100
IF DEBUG_MODE>0 AND LOGNUM_OPEN THEN BEGIN 01634110
REPLACE PBUF BY "R_PAR:", " " FOR 50; 01634130
REPLACE PTEMP:PBUF[8] BY DATA FOR LEN, " L="; 01634140
FOUR_ASCII_DIGITS(LEN, PTEMP); 01634150
WRITE(LOGNUM, 33, PBUF); 01634160
END; 01634170
01634200
MAX_SND_SIZE := UNCHAR(REAL(DATA[0], 1)); % Max send size 01635000
MAX_SND_DATA := MAX_SND_SIZE -3; % Max send data size 01636000
YOUR_TO := UNCHAR(REAL(DATA[1], 1)); % When I time you out 01637000
YOUR_PAD_COUNT := UNCHAR(REAL(DATA[2], 1));% Number of pads to send01638000
YOUR_PAD := CTL(REAL(DATA[3], 1)); % Your Pad char 01639000
YOUR_EOL := UNCHAR(REAL(DATA[4], 1)); % Your end-of-line 01640000
YOUR_Q_CTL := INTEGER(REAL(DATA[5], 1)); % Your control quote 01641000
IF LEN > 6 AND REAL(DATA[6], 1) = "Y" THEN 01642000
BEGIN % I specify the quote 01643000
Q8_IND := "Y"; 01644000
QUOTE_8 := TRUE; 01645000
END 01646000
ELSE 01647000
IF LEN > 6 AND REAL(DATA[6], 1) NEQ "N" THEN 01648000
BEGIN % Quote specified for me 01649000
Q_8 := REAL(DATA[6], 1); 01650000
Q8_IND := " "; 01651000
QUOTE_8 := TRUE; 01652000
END 01653000
ELSE 01654000
BEGIN % No 8 bit quoting 01655000
QUOTE_8 := FALSE; 01656000
END; 01657000
01657100
IF LEN > 7 THEN 01657200
BEGIN 01657300
YOUR_BLK_CK := REAL(DATA[7], 1); 01657400
IF YOUR_BLK_CK = "1" OR 01657500
YOUR_BLK_CK = "3" THEN 01657600
MY_BLK_CK := YOUR_BLK_CK % Will do it your way 01657700
ELSE 01657800
MY_BLK_CK := YOUR_BLK_CK := "1"; % The old way 01657900
END 01658000
ELSE 01658100
MY_BLK_CK := YOUR_BLK_CK := "1"; % No blk ck -> one-byte ck 01658200
01658300
IF LEN > 8 AND REAL(DATA[8], 1) NEQ " " THEN 01659000
BEGIN 01660000
RPT_CHR := REAL(DATA[8], 1); 01661000
USE_REPEAT := TRUE; 01662000
END 01663000
ELSE 01664000
BEGIN 01665000
USE_REPEAT := FALSE; 01666000
END; 01667000
IF LEN > 12 THEN % Extended packet stuff 01667100
BEGIN 01667200
YOUR_CAPS := 01667300
REAL(BOOLEAN(UNCHAR(REAL(DATA[9],1))) AND BOOLEAN(MY_CAPS));01667310
01667400
% Windowing, DATA(10), is unsupported herein 01667500
01667600
TEMP := UNCHAR(REAL(DATA[11],1))*95+UNCHAR(REAL(DATA[12],1)); 01667700
IF DEBUG_MODE>0 AND LOGNUM_OPEN THEN BEGIN 01667710
REPLACE PBUF BY "R_PAR:", " " FOR 50; 01667720
REPLACE PTEMP:PBUF[8] BY DATA[11] FOR 2, " TEMP="; 01667730
FOUR_ASCII_DIGITS(TEMP, PTEMP); 01667740
WRITE(LOGNUM, 50, PBUF); 01667750
END; 01667760
IF TEMP > MAX_LONGPACK_SIZE THEN 01667800
TEMP := MAX_LONGPACK_SIZE; 01667900
LONGPACK_SIZE := TEMP-7-(YOUR_BLK_CK-"1"); 01668000
END 01668100
ELSE 01668200
LONGPACK_SIZE := MAX_SND_SIZE-6; 01668300
END; 01668400
01669000
$ PAGE 01670000
01672000
PROCEDURE R_SPAR(DATA,LEN); 01673000
ASCII ARRAY DATA[0] ; 01674000
INTEGER LEN ; 01675000
BEGIN 01676000
REPLACE DATA[0] BY 01676900
TOCHAR(MAX_RCV_SIZE % Biggest to send me 01677000
+ 1 - (MY_BLK_CK-"0")).LOWBYTE FOR 1, 01677100
TOCHAR(MY_TO).LOWBYTE FOR 1, % When to time me out 01678000
TOCHAR(0).LOWBYTE FOR 1, % How many pads I need 01679000
CTL(0).LOWBYTE FOR 1, % Pad char to use for me01680000
TOCHAR(CR).LOWBYTE FOR 1, % EOL char for me 01681000
MY_Q_CTL.LOWBYTE FOR 1; % Control quote I send 01682000
IF QUOTE_8 THEN 01683000
BEGIN 01684000
IF Q8_IND = "Y" THEN 01685000
BEGIN % I specify the char 01686000
Q_8 := P_Q_8; 01687000
REPLACE DATA[6] BY P_Q_8; 01688000
END 01689000
ELSE 01690000
BEGIN % Already specIFied 01691000
REPLACE DATA[6] BY "Y"; 01692000
END; 01693000
END 01694000
ELSE 01695000
BEGIN 01696000
REPLACE DATA[6] BY "N"; % No 8 bit quoting 01697000
END; 01698000
01699000
REPLACE DATA[7] BY MY_BLK_CK.LOWBYTE FOR 1; 01700000
01701000
IF USE_REPEAT THEN 01702000
REPLACE DATA[8] BY RPT_CHR.LOWBYTE FOR 1 01703000
ELSE 01704000
REPLACE DATA[8] BY " "; 01705000
01706000
REPLACE DATA[9] BY 01706100
TOCHAR(YOUR_CAPS).LOWBYTE FOR 1, % We negotiated this 01706200
TOCHAR(0).LOWBYTE FOR 1, % We don't do windows 01706300
TOCHAR(LONGPACK_SIZE DIV 95).LOWBYTE FOR 1, % MAXL1 01706400
TOCHAR(LONGPACK_SIZE MOD 95).LOWBYTE FOR 1; % MAXL2 01706500
01706600
01706700
LEN := 13; 01706800
IF DEBUG_MODE>0 AND LOGNUM_OPEN THEN BEGIN 01706810
REPLACE PTEMP:PBUF BY "R_SPAR: LONGPACK_SIZE="; 01706820
FOUR_ASCII_DIGITS(LONGPACK_SIZE, PTEMP); 01706830
REPLACE PTEMP BY " " FOR 50; 01706840
WRITE(LOGNUM, 60, PBUF); 01706850
END; 01706860
END; 01707000
01708000
$ PAGE 01709000
BOOLEAN PROCEDURE RECSW(SERVE); 01711000
VALUE SERVE ; 01712000
BOOLEAN SERVE ; 01713000
BEGIN 01714000
01715000
BOOLEAN DONE; 01716000
01717000
INTEGER FOPT, % File Options (calculated) 01718000
FN_LEN; % File Name Length 01719000
01720000
DEFINE FN_MAX = 35#; % Max File Name Length 01721000
01722000
ASCII ARRAY FNAME[0:FN_MAX]; 01723000
01724000
% ----------------------------------------------------------- 01725000
01726000
$ PAGE 01727000
REAL PROCEDURE RINIT; 01728000
BEGIN 01729000
01730000
% ---------------------------------------------------------- 01731000
01732000
RINIT := STATE; 01733000
NUMTRY := NUMTRY + 1; 01734000
IF NUMTRY > MAXTRY THEN 01735000
BEGIN 01736000
E_ST "RINIT - Retry count exceeded" E_EN; 01737000
RINIT := "A"; 01738000
END 01739000
ELSE 01740000
BEGIN 01741000
IF RPACK(RP,RP_LEN,RP_NUM,RP_DATA) THEN 01742000
BEGIN 01743000
IF RP = "S" THEN 01744000
BEGIN 01745000
R_RPAR(RP_DATA,RP_LEN); % Read the others 01746000
R_SPAR(RP_DATA,RP_LEN); % Generate ours 01747000
SPACK("Y",N,RP_LEN,RP_DATA); % Send it 01748000
01749000
OLDTRY := NUMTRY; % Save trys 01750000
NUMTRY := 0; 01751000
N := NPNO(RP_NUM); % Syncronize 01752000
RINIT := "F"; % Switch to F mode 01753000
END 01754000
ELSE 01755000
IF RP = "E" THEN 01756000
BEGIN 01757000
E_ST "RINIT - E packet recieved" E_EN; 01758000
P_EPACK(RP_DATA,RP_LEN); 01759000
RINIT := "A"; 01760000
END 01761000
ELSE 01762000
BEGIN 01763000
E_ST "RINIT - Unexpected packet type" E_EN; 01764000
RINIT := "A"; 01765000
END; 01766000
END 01767000
ELSE 01768000
BEGIN 01769000
SPACK("N",N,0,RP_DATA); 01770000
END; 01771000
END; 01772000
END; 01773000
01774000
% **************************************************************** 01775000
01776000
$ PAGE 01777000
REAL PROCEDURE RFILE; 01778000
BEGIN 01779000
01780000
01781000
RFILE := STATE; 01782000
NUMTRY := NUMTRY + 1; 01783000
IF NUMTRY > MAXTRY THEN 01784000
BEGIN 01785000
E_ST "RFILE - Retry count exceeded" E_EN; 01786000
RFILE := "A"; 01787000
END 01788000
ELSE 01789000
BEGIN 01790000
IF RPACK(RP,RP_LEN,RP_NUM,RP_DATA) THEN 01791000
BEGIN % Got a packet 01792000
IF RP = "S" THEN 01793000
BEGIN % Still in SI, perhaps ACK lost 01794000
OLDTRY := OLDTRY + 1; 01795000
IF OLDTRY > MAXTRY THEN 01796000
BEGIN 01797000
E_ST "RFILE - Pretry (S) exceeded" E_EN; 01798000
RFILE := "A"; 01799000
END 01800000
ELSE 01801000
IF RP_NUM NEQ PPNO(N) THEN 01802000
BEGIN % Number must match 01803000
E_ST "RFILE - N mismatch on S packet" E_EN; 01804000
RFILE := "A"; 01805000
END 01806000
ELSE 01807000
BEGIN % OK, re-ACK the packet 01808000
R_SPAR(RP_DATA,RP_LEN); 01809000
SPACK("Y",RP_NUM,RP_LEN,RP_DATA); 01810000
NUMTRY := 0; 01811000
END; 01812000
END 01813000
ELSE 01814000
IF RP = "Z" THEN 01815000
BEGIN % End of file, previous packet (?) 01816000
OLDTRY := OLDTRY + 1; 01817000
IF OLDTRY > MAXTRY THEN 01818000
BEGIN 01819000
E_ST "RFILE - Pretry (Z) exceeded" E_EN; 01820000
RFILE := "A"; 01821000
END 01822000
ELSE 01823000
IF RP_NUM NEQ PPNO(N) THEN 01824000
BEGIN % N must match 01825000
E_ST "RFILE - N mismatch on Z packet" E_EN; 01826000
RFILE := "A"; 01827000
END 01828000
ELSE 01829000
BEGIN % OK, re-ACK the packet 01830000
SPACK("Y",RP_NUM,0,RP_DATA); 01831000
NUMTRY := 0; 01832000
END; 01833000
END 01834000
ELSE 01835000
IF RP = "F" THEN 01836000
BEGIN % File header (what we expect) 01837000
IF RP_NUM NEQ N THEN 01838000
BEGIN % Oops 01839000
E_ST "RFILE - N mismatch" E_EN; 01840000
RFILE := "A"; 01841000
END 01842000
ELSE 01843000
BEGIN % OK, Open the file 01844000
01845000
IF L_FNAME_LEN NEQ 0 THEN 01846000
BEGIN 01847000
REPLACE FNAME BY L_FNAME FOR L_FNAME_LEN; 01848000
FN_LEN := L_FNAME_LEN; 01849000
END 01850000
ELSE 01851000
BEGIN 01852000
CBUFXLT(RP_DATA,RP_LEN, 01853000
FNAME,FN_LEN,FN_MAX); 01854000
01855000
IF NOT UNQFNAME(FNAME,FN_LEN) THEN 01856000
BEGIN 01857000
MAKE_U_FNAME(FNAME,FN_LEN); 01858000
END; 01859000
END; 01860000
01861000
REPLACE FNAME[FN_LEN] BY "."; 01862000
01863000
IF RCV_BINARY THEN 01864000
BEGIN % Binary mode 01865000
IMAGE := TRUE; 01866000
FOPT := 0; 01867000
END 01868000
ELSE 01869000
BEGIN % ASCII mode 01870000
IMAGE := FALSE; 01871000
FOPT := 4; 01872000
END; 01873000
01874000
IF NOT RCV_FIXREC THEN 01875000
FOPT := FOPT + 4"40"; % set variable 01876000
01877000
IF RCV_RECLEN < 0 THEN 01878000
DBUF_RMAX := -RCV_RECLEN 01879000
ELSE 01880000
DBUF_RMAX := RCV_RECLEN * 2; 01881000
01882000
% IF NOT VALID_FILE(FNAME, FN_LEN, IN) THEN 01883000
% BEGIN 01884000
% E_ST "RFILE - file security error" E_EN; 01885000
% RFILE := "A"; 01886000
% DNUM := 0; 01887000
% END 01888000
% ELSE 01889000
BEGIN 01890000
REPLACE TTL BY FNAME FOR FN_LEN+1 01890100
WITH ASCIITOEBCDIC; 01890200
DNUM(TITLE=TTL, 01891000
MAXRECSIZE=RCV_RECLEN, 01892000
UNITS=CHARACTERS, 01893000
BLOCKSIZE=RCV_BLOCKF*RCV_RECLEN, 01894000
KIND=DISK, 01895000
NEWFILE, 01896000
AREAS=RCV_MAXEXT, 01897000
AREASIZE=RCV_MAXREC/RCV_MAXEXT, 01898000
FILEKIND=RCV_FCODE, 01899000
INTMODE=ASCII, EXTMODE=EBCDIC); 01899100
IF DNUM.ATTERR THEN 01899200
BEGIN % Can't open file 01900000
E_ST "RFILE - Can't open file" E_EN; 01901000
RFILE := "A"; 01902000
END 01903000
ELSE 01904000
BEGIN % OK 01905000
DNUM.OPEN:=TRUE; 01905800
DNUM_OPEN:=TRUE; 01905900
SPACK("Y",N,RP_LEN,RP_DATA); 01906000
OLDTRY := NUMTRY; 01907000
NUMTRY := 0; 01908000
N := NPNO(N); 01909000
RFILE := "D"; 01910000
DBUFCNT := 0; 01911000
DBUFINX := 0; 01912000
END; 01913000
END; 01914000
END; 01915000
END 01916000
ELSE 01917000
IF RP = "B" THEN 01918000
BEGIN % Break transmission 01919000
IF RP_NUM NEQ N THEN 01920000
BEGIN % Oops 01921000
E_ST "RFILE - (B) N mismatch" E_EN; 01922000
RFILE := "A"; 01923000
END 01924000
ELSE 01925000
BEGIN 01926000
SPACK("Y",N,0,RP_DATA); 01927000
RFILE := "C"; 01928000
END; 01929000
END 01930000
ELSE 01931000
IF RP = "E" THEN 01932000
BEGIN 01933000
E_ST "RFILE - E packet recieved" E_EN; 01934000
P_EPACK(RP_DATA,RP_LEN); 01935000
RFILE := "A"; 01936000
END 01937000
ELSE 01938000
BEGIN 01939000
E_ST "RFILE - Unknown packet type" E_EN; 01940000
RFILE := "A"; 01941000
END; 01942000
END % Got a packet 01943000
ELSE 01944000
BEGIN 01945000
SPACK("N",N,0,RP_DATA); % No (readable) packet 01946000
END; 01947000
END; 01948000
END; 01949000
01950000
% ***************************************************************** 01951000
01952000
$ PAGE 01953000
REAL PROCEDURE RDATA; 01954000
BEGIN 01955000
01956000
RDATA := STATE; 01957000
NUMTRY := NUMTRY + 1; 01958000
IF NUMTRY > MAXTRY THEN 01959000
BEGIN 01960000
E_ST "RDATA - Retry count exceeded" E_EN; 01961000
RDATA := "A"; 01962000
END 01963000
ELSE 01964000
BEGIN 01965000
IF RPACK(RP,RP_LEN,RP_NUM,RP_DATA) THEN 01966000
BEGIN 01967000
IF RP = "D" THEN 01968000
BEGIN % Good, what we expect 01969000
IF RP_NUM NEQ N THEN 01970000
BEGIN % Oops, not this packet 01971000
OLDTRY := OLDTRY + 1; 01972000
IF OLDTRY > MAXTRY THEN 01973000
BEGIN 01974000
E_ST "RDATA - Pretry exceeded" E_EN; 01975000
RDATA := "A"; 01976000
END 01977000
ELSE 01978000
IF RP_NUM = PPNO(N) THEN 01979000
BEGIN % Already have this one 01980000
SPACK("Y",RP_NUM,0,RP_DATA); % Re-ACK 01981000
NUMTRY := 0; 01982000
END 01983000
ELSE 01984000
BEGIN 01985000
E_ST "RDATA - N (D) mismatch" E_EN; 01986000
RDATA := "A"; 01987000
END; 01988000
END % Wrong packet 01989000
ELSE 01990000
BEGIN % Got the one we want 01991000
BUFEMP(RP_DATA,RP_LEN); % Process 01992000
SPACK("Y",N,0,RP_DATA); % AND ACK 01993000
OLDTRY := NUMTRY; 01994000
NUMTRY := 0; 01995000
N := NPNO(N); 01996000
END; 01997000
END % RP = "D" 01998000
ELSE 01999000
IF RP = "F" THEN 02000000
BEGIN % File header 02001000
OLDTRY := OLDTRY + 1; 02002000
IF OLDTRY > MAXTRY THEN 02003000
BEGIN 02004000
E_ST "RDATA - Pretry (F) exceeded" E_EN; 02005000
RDATA := "A"; 02006000
END 02007000
ELSE 02008000
IF RP_NUM NEQ PPNO(N) THEN 02009000
BEGIN % Oops 02010000
E_ST "RDATA - N (F) mismatch" E_EN; 02011000
RDATA := "A"; 02012000
END 02013000
ELSE 02014000
BEGIN % OK 02015000
SPACK("Y",RP_NUM,0,RP_DATA); % ReACK 02016000
NUMTRY := 0; 02017000
END; 02018000
END % RP = "F" 02019000
ELSE 02020000
IF RP = "Z" THEN 02021000
BEGIN % End of File 02022000
IF RP_NUM NEQ N THEN 02023000
BEGIN 02024000
E_ST "RDATA - N (Z) mismatch" E_EN; 02025000
RDATA := "A"; 02026000
END 02027000
ELSE 02028000
BEGIN 02029000
IF DBUFINX > 0 THEN 02030000
FLUSH_DBUF; 02031000
02032000
IF RCV_SAVESP THEN 02033000
LOCK(DNUM, CRUNCH) 02034000
ELSE 02035000
LOCK(DNUM); 02036000
02037000
DNUM_OPEN:=FALSE; 02038000
SPACK("Y",N,0,RP_DATA); % ACK 02039000
L_FNAME_LEN := 0; 02040000
N := NPNO(N); 02041000
RDATA := "F"; 02042000
END; 02043000
END % RP = "Z" 02044000
ELSE 02045000
IF RP = "E" THEN 02046000
BEGIN 02047000
E_ST "RDATA - E packet recieved" E_EN; 02048000
P_EPACK(RP_DATA,RP_LEN); 02049000
RDATA := "A"; 02050000
END 02051000
ELSE 02052000
BEGIN 02053000
E_ST "RDATA - Unknown packet type" E_EN; 02054000
RDATA := "A"; 02055000
END; 02056000
END % Got packet 02057000
ELSE 02058000
BEGIN 02059000
SPACK("N",N,0,RP_DATA); % NAK 02060000
END; 02061000
END; 02062000
END; 02063000
$ PAGE 02064000
% ***************************************************************** 02065000
02066000
IF NOT SERVE THEN 02067000
BEGIN 02068000
STATE := "R"; 02069000
N := 0; 02070000
NUMTRY := 0; 02071000
END 02072000
ELSE 02073000
BEGIN 02074000
STATE := "F"; 02075000
END; 02076000
02077000
WHILE NOT (DONE OR BLASTED) DO 02078000
BEGIN 02079000
IF STATE = "R" THEN STATE := RINIT 02080000
ELSE 02081000
IF STATE = "F" THEN STATE := RFILE 02082000
ELSE 02083000
IF STATE = "D" THEN STATE := RDATA 02084000
ELSE 02085000
IF STATE = "C" THEN 02086000
BEGIN 02087000
DONE := TRUE; 02088000
RECSW := TRUE; 02089000
END 02090000
ELSE 02091000
IF STATE = "A" THEN 02092000
BEGIN 02093000
DONE := TRUE; 02094000
RECSW := FALSE; 02095000
END; 02096000
END; 02097000
02098000
IF DNUM.OPEN THEN 02099000
BEGIN 02100000
CLOSE(DNUM); 02101000
DNUM_OPEN:=FALSE; 02102000
END; 02103000
END; 02104000
% **************************************************************** 02105000
$ ENDSEGMENT % End all send, receive, and packet handling. 02106000
$ PAGE 02107000
BOOLEAN PROCEDURE TYPESW; 02108000
BEGIN 02109000
BOOLEAN DONE; 02110000
LABEL XIT; 02110100
02111000
% IF VALID_FILE(L_FNAME, L_FNAME_LEN, OUT) THEN 02112000
% ELSE 02113000
% BEGIN 02114000
% M_ST ("Kermit file security error - ", 02115000
% "see your account manager") M_EN; 02116000
% TYPESW := FALSE; 02117000
% return; 02118000
% END; 02119000
02120000
REPLACE TTL BY L_FNAME FOR L_FNAME_LEN+1 WITH ASCIITOEBCDIC; 02120100
DNUM(KIND = DISK, TITLE = TTL, 02121000
INTMODE = ASCII, DEPENDENTSPECS = TRUE, 02121100
NEWFILE = FALSE); 02121200
IF NOT DNUM.PRESENT THEN 02122000
BEGIN 02123000
M_ST "File open failure" M_EN; 02124000
TYPESW := FALSE; 02125000
GO TO XIT; 02126000
END; 02127000
02127100
SND_RECLEN := DNUM.MAXRECSIZE 02127200
* (IF DNUM.FRAMESIZE=48 THEN 6 ELSE 1); 02127300
02128000
WHILE NOT(DONE OR BLASTED) DO 02129000
BEGIN 02130000
DBUFCNT:=REAL(READ(DNUM, SND_RECLEN, DBUF)); 02131000
IF BOOLEAN(DBUFCNT) AND NOT BOOLEAN(DBUFCNT.[9:1]) THEN 02132000
BEGIN % Read error 02133000
M_ST "TYPESW - read error" M_EN; 02134000
TYPESW := FALSE; 02135000
DONE := TRUE; 02136000
END 02137000
ELSE 02138000
IF BOOLEAN(DBUFCNT.[9:1]) THEN 02139000
BEGIN % EOF 02140000
TYPESW := DONE := TRUE; 02141000
END 02142000
ELSE 02143000
WRITE(CONUM, SND_RECLEN, DBUF); 02144000
WHEN(0.40); % So we can see ?HI. Machine is slower than this! 02144100
END; 02145000
CLOSE(DNUM); 02146000
DNUM_OPEN:=FALSE; 02147000
IF BLASTED THEN 02148000
TYPESW := FALSE; 02149000
XIT: 02149100
END; 02150000
02151000
% ***************************************************************** 02152000
02153000
$ PAGE 02154000
%BOOLEAN PROCEDURE OPEN_LINE; 02156000
%BEGIN 02157000
% 02158000
% BOOLEAN R_ERROR, 02159000
% TEMP; 02160000
% 02161000
% INTEGER DEV_L; 02162000
% 02163000
% ASCII ARRAY A_DEV[0:11]; 02164000
% 02165000
% % ************************************************************ 02166000
% 02167000
% IF NOT LNUM.OPEN THEN 02168000
% BEGIN % Line NOT open 02169000
% IF LDEV_LINE = 0 THEN 02170000
% BEGIN 02171000
% E_ST "Line not specified or defaultable" E_EN; 02172000
% R_ERROR := TRUE; 02173000
% END 02174000
% ELSE 02175000
% BEGIN 02176000
% MOVE PBUF := "SETMSG OFF",2; 02177000
% PLEN := TOS - @PBUF; 02178000
% PBUF(PLEN) := CR; 02179000
% COMMAND(PBUF,PLEN,DEV_L); 02180000
% 02181000
% DEV_L := ASCII(LDEV_LINE,10,A_DEV); 02182000
% A_DEV(DEV_L) := " "; 02183000
% LNUM(KIND=REMOTE, 02184000
% MAXRECSIZE=128, UNITS=CHARACTERS, 02184100
% FILETYPE=3); % Variable 02184200
% IF LNUM.ATTERR THEN 02185000
% BEGIN 02186000
% E_ST "FOPEN error on communications port" E_EN; 02187000
% R_ERROR := TRUE; 02188000
% END 02189000
% ELSE 02190000
% BEGIN % Set up the line 02191000
% LNUM.OPEN:=TRUE; 02191100
% IF HNDSHK = 0 THEN 02192000
% TTYPE := 18 02193000
% ELSE 02194000
% TTYPE := 13; 02195000
% 02196000
% FCONTROL(LNUM,13,ORGL_ECHO); 02197000
% 02198000
% FCONTROL(LNUM,39,ORGL_TTYPE); 02199000
% FCONTROL(LNUM,38,TTYPE); 02200000
% 02201000
% IF TSPEED NEQ 0 THEN 02202000
% BEGIN 02203000
% ORGL_TISPEED := TSPEED; 02204000
% FCONTROL(LNUM,10,ORGL_TISPEED); 02205000
% ORGL_TOSPEED := TSPEED; 02206000
% FCONTROL(LNUM,11,ORGL_TOSPEED); 02207000
% END; 02208000
% 02209000
% FSETMODE(LNUM,4); % Inhibit LF 02210000
% 02211000
% IF HNDSHK = 2 THEN 02212000
% BEGIN % Set XON as termination char 02213000
% TEMP := XON; 02214000
% FCONTROL(LNUM,25,TEMP); 02215000
% END; 02216000
% 02217000
% 02218000
% IF (LDEV_CI = LDEV_LINE) AND 02219000
% (LOGNUM = CONUM) THEN LOGNUM := 0; 02220000
% END; 02221000
% END; 02222000
% END; 02223000
% 02224000
% OPEN_LINE := NOT R_ERROR; 02225000
%END; 02226000
% 02227000
$ PAGE 02228000
%PROCEDURE SHUT_LINE; 02230000
%BEGIN 02231000
% 02232000
% BOOLEAN TEMP; 02233000
% 02234000
% % ************************************************************ 02235000
% 02236000
% IF LNUM.OPEN THEN 02237000
% BEGIN % Line is open 02238000
% FSETMODE(LNUM,0); % Turn on linefeed 02239000
% 02240000
% IF ORGL_TTYPE NEQ TTYPE THEN 02241000
% FCONTROL(LNUM,38,ORGL_TTYPE); 02242000
% 02243000
% IF TSPEED NEQ 0 THEN 02244000
% BEGIN 02245000
% IF ORGL_TISPEED NEQ TSPEED THEN 02246000
% BEGIN 02247000
% TEMP := ORGL_TISPEED; 02248000
% FCONTROL(LNUM,10,TEMP); 02249000
% END; 02250000
% IF ORGL_TOSPEED NEQ TSPEED THEN 02251000
% BEGIN 02252000
% TEMP := ORGL_TOSPEED; 02253000
% FCONTROL(LNUM,11,TEMP); 02254000
% END; 02255000
% END; 02256000
% 02257000
% IF ORGL_ECHO = 0 THEN 02258000
% FCONTROL(LNUM,12,TEMP); 02259000
% 02260000
% IF HNDSHK = 2 THEN 02261000
% BEGIN 02262000
% TEMP := 0; 02263000
% FCONTROL(LNUM,25,TEMP); 02264000
% END; 02265000
% 02266000
% 02267000
% CLOSE(LNUM); 02268000
% 02270000
% IF LOGNUM = 0 THEN LOGNUM := CONUM; 02271000
% 02272000
% MOVE PBUF := "SETMSG ON",2; 02273000
% PLEN := TOS - @PBUF; 02274000
% PBUF(PLEN) := CR; 02275000
% COMMAND(PBUF,PLEN,TEMP); 02276000
% END; 02277000
%END; 02278000
% 02279000
$ PAGE 02280000
%PROCEDURE KILL_KTEMP; 02282000
%BEGIN 02283000
%INTEGER X; % Temp variable 02285000
% 02286000
% ASCII ARRAY TBUF[0:79]; 02287000
% 02288000
% MOVE TBUF := "RESET ",2; 02289000
% MOVE * := KTEMP_NAME,2; 02290000
% X := TOS - @TBUF; 02291000
% TBUF(X) := CR; 02292000
% COMMAND(TBUF,TNUM,X); % Reset file equate 02293000
% 02294000
% MOVE TBUF := KTEMP_NAME,2; 02295000
% X := TOS - @TBUF; 02296000
% TBUF(X) := " "; 02297000
% 02298000
% TNUM := FOPEN(TBUF,7,4); % Try to open it 02299000
% IF TNUM.OPEN THEN 02300000
% CLOSE(TNUM, PURGE); % Kill it 02301000
% HAVE_KTEMP := FALSE; 02302000
%END; 02303000
% 02304000
$ PAGE 02305000
%PROCEDURE GET_KTEMP; 02307000
%BEGIN 02308000
%INTEGER X; % Temp variable 02310000
% 02311000
% ASCII ARRAY TBUF[0:79]; 02312000
% 02313000
% KILL_KTEMP; % Delete any old one 02314000
% TNUM(KIND=DISK, 02315000
% TITLE=KTEMP_NAME, 02315100
% MAXRECSIZE=80, UNITS=CHARACTERS, 02315200
% BLOCKSIZE=720, % Blocked 9 02315300
% NEWFILE, 02315310
% AREAS=20, AREASIZE=180); % Nothing magical about size 02315400
% TNUM.OPEN:=TRUE; 02315500
% IF TNUM.OPEN THEN 02315600
% HAVE_KTEMP:=TRUE; 02315700
% IF TNUM.OPEN THEN 02316000
% BEGIN 02317000
% FCLOSE(TNUM,2,0); % Save as temporary 02318000
% IF = THEN 02319000
% BEGIN 02320000
% MOVE TBUF := "FILE ",2; 02321000
% MOVE * := KTEMP_NAME,2; 02322000
% MOVE * := ",OLDTEMP",2; 02323000
% X := TOS - @TBUF; 02324000
% TBUF(X) := CR; 02325000
% COMMAND(TBUF,X,TNUM); 02326000
% IF X = 0 THEN 02327000
% HAVE_KTEMP := TRUE; 02328000
% END; 02329000
% END; 02330000
%END; 02331000
$ PAGE 02332000
PROCEDURE HOST_COMMAND(CMD,CMD_LEN,LONG_REPLY); 02334000
VALUE CMD_LEN,LONG_REPLY ; 02335000
ASCII ARRAY CMD[0] ; 02336000
INTEGER CMD_LEN ; 02337000
BOOLEAN LONG_REPLY ; 02338000
BEGIN 02339000
02340000
ASCII ARRAY CMD_BUF[0:79]; 02341000
02342000
BOOLEAN CMD_ERR; 02343000
02344000
INTEGER CI_ERNO, 02345000
CI_PARM; 02346000
02347000
% ------------------------------------------------------------ 02348000
CMD_ERR:=TRUE; %%%%%%%%%% EVERYTHING IS ILLEGAL FOR THE MOMENT 02348100
02349000
% MOVE CMD_BUF := CMD,(CMD_LEN); 02350000
% IF LONG_REPLY THEN 02351000
% BEGIN 02352000
% GET_KTEMP; 02353000
% IF NOT HAVE_KTEMP THEN 02354000
% BEGIN 02355000
% MOVE CMD_BUF := "Unable to allocate temp file",2; 02356000
% CMD_LEN := TOS - @CMD_BUF; 02357000
% SPACK("E",N,CMD_LEN,CMD_BUF); 02358000
% CMD_ERR := TRUE; 02359000
% END; 02360000
% END; 02361000
% 02362000
% IF NOT CMD_ERR THEN 02363000
% BEGIN 02364000
% CMD_BUF(CMD_LEN) := CR; 02365000
% COMMAND(CMD_BUF,CI_ERNO,CI_PARM); % Issue the command 02366000
% IF CI_ERNO NEQ 0 THEN 02367000
% BEGIN % Command Interpreter error 02368000
% MOVE CMD_BUF := "Command Error, CIERROR = ",2; 02369000
% CMD_LEN := TOS - @CMD_BUF; 02370000
% CMD_LEN := CMD_LEN + ASCII(CI_ERNO,10,CMD_BUF(CMD_LEN));02371000
% SPACK("E",N,CMD_LEN,CMD_BUF); 02372000
% CMD_ERR := TRUE; 02373000
% END 02374000
% ELSE 02375000
% BEGIN % Command OK 02376000
% IF LONG_REPLY THEN 02377000
% BEGIN 02378000
% DNUM := FOPEN(KT_NAME,6,0); 02379000
% IF DNUM = 0 THEN 02380000
% BEGIN % Temp file open error 02381000
% MOVE CMD_BUF := "Temp file open failure",2; 02382000
% CMD_LEN := TOS - @CMD_BUF; 02383000
% SPACK("E",N,CMD_LEN,CMD_BUF); 02384000
%INTEGER CMD_ERR := TRUE; 02385000
% END 02386000
% ELSE 02387000
% BEGIN 02388000
% SENDSW(CMD_BUF,0); 02389000
% STATE := SBREAK; 02390000
% END; 02391000
% END 02392000
% ELSE 02393000
% BEGIN % Short reply 02394000
% SPACK("Y",N,0,CMD_BUF); 02395000
% END; 02396000
% END; 02397000
% END; 02398000
END; 02399000
$ PAGE 02400000
PROCEDURE KERMIT_COMMAND(KCMD,KCMD_LEN); 02402000
VALUE KCMD_LEN ; 02403000
ASCII ARRAY KCMD[0] ; 02404000
INTEGER KCMD_LEN ; 02405000
BEGIN 02406000
02407000
ASCII ARRAY KC_BUF[0:79]; 02408000
02408100
POINTER PTEMP; 02408200
02409000
INTEGER KC_LEN, 02410000
X; 02411000
02412000
% ------------------------------------------------------------ 02413000
02414000
% _ST "KERMIT COMMAND KCMD=(", 2; 02415000
% LEN:=(PLEN:=TOS-@PBUF)+ASCII(KCMD_LEN,10,PBUF(PLEN)); 02416000
% OVE PBUF(PLEN):=")", 2; MOVE *:=KCMD,(KCMD_LEN) E_EN; 02417000
% IF (KCMD = "D") AND (KCMD_LEN > 0) THEN 02418000
% BEGIN % Directory Command 02419000
% MOVE KC_BUF := "LISTF ",2; 02420000
% KC_LEN := TOS - @KC_BUF; 02421000
% 02422000
% IF KCMD_LEN > 2 THEN 02423000
% BEGIN % Check for filespec 02424000
% X := UNCHAR(KCMD(1)); 02425000
% IF (X > 0) AND (X <= (KCMD_LEN -2)) THEN 02426000
% BEGIN % Use filespec 02427000
% MOVE KC_BUF(KC_LEN) := KCMD(2),(X); 02428000
% KC_LEN := KC_LEN + X; 02429000
% END; 02430000
% END; 02431000
% 02432000
% MOVE KC_BUF(KC_LEN) := ",2",2; 02433000
% MOVE * := ";*",2; 02434000
% MOVE * := KTEMP_NAME,2; 02435000
% KC_LEN := TOS - @KC_BUF; 02436000
% HOST_COMMAND(KC_BUF,KC_LEN,TRUE); 02437000
% END 02438000
% 02439000
% ELSE 02440000
% IF (KCMD = "U") AND (KCMD_LEN > 0) THEN 02441000
% BEGIN % File space usage 02442000
% MOVE KC_BUF := "REPORT ",2; 02443000
% KC_LEN := TOS - @KC_BUF; 02444000
% 02445000
% IF KCMD_LEN > 2 THEN 02446000
% BEGIN % Check for groupspec 02447000
% X := UNCHAR(KCMD(1)); 02448000
% IF (X > 0) AND (X <= (KCMD_LEN -2)) THEN 02449000
% BEGIN % Use groupspec 02450000
% MOVE KC_BUF(KC_LEN) := KCMD(2),(X); 02451000
% KC_LEN := KC_LEN + X; 02452000
% END; 02453000
% END; 02454000
% 02455000
% MOVE KC_BUF(KC_LEN) := ",*",2; 02456000
% MOVE * := KTEMP_NAME,2; 02457000
% KC_LEN := TOS - @KC_BUF; 02458000
% 02459000
% HOST_COMMAND(KC_BUF,KC_LEN,TRUE); 02460000
% END 02461000
% 02462000
% ELSE 02463000
% IF (KCMD = "E") AND (KCMD_LEN > 0) THEN 02464000
% BEGIN % Erase (delete) command 02465000
% MOVE KC_BUF := "PURGE ",2; 02466000
% KC_LEN := TOS - @KC_BUF; 02467000
% 02468000
% IF KCMD_LEN > 2 THEN 02469000
% BEGIN 02470000
% X := UNCHAR(KCMD(1)); 02471000
% END 02472000
% ELSE 02473000
% BEGIN 02474000
% X := 0; 02475000
% END; 02476000
% 02477000
% IF (X < 1) OR (X > (KCMD_LEN-2)) 02478000
% OR NOT VALID_FILE(KCMD(2), X, IN) THEN 02479000
% BEGIN 02480000
% MOVE KC_BUF := "Filespec missing or invalid",2; 02481000
% KC_LEN := TOS - @KC_BUF; 02482000
% SPACK("E",N,KC_LEN,KC_BUF); 02483000
% END 02484000
% ELSE 02485000
% BEGIN 02486000
% MOVE KC_BUF(KC_LEN) := KCMD(2),(X); 02487000
% KC_LEN := KC_LEN + X; 02488000
% HOST_COMMAND(KC_BUF,KC_LEN,FALSE); 02489000
% END; 02490000
% END 02491000
% 02492000
% ELSE 02493000
% IF (KCMD = "T") AND (KCMD_LEN > 0) THEN 02494000
% BEGIN % Type Command 02495000
% IF KCMD_LEN > 1 THEN 02496000
% BEGIN 02497000
% X := UNCHAR(KCMD(1)); 02498000
% END 02499000
% ELSE 02500000
% BEGIN 02501000
% X := 0; 02502000
% END; 02503000
% 02504000
% IF (X < 1) OR (X > (KCMD_LEN -2)) THEN 02505000
% BEGIN 02506000
% MOVE KC_BUF := "Filespec missing or invalid",2; 02507000
% KC_LEN := TOS - @KC_BUF; 02508000
% SPACK("E",N,KC_LEN,KC_BUF); 02509000
% END 02510000
% ELSE 02511000
% BEGIN 02512000
% MOVE KC_BUF := KCMD(2),(X); 02513000
% KC_BUF(X) := " "; 02514000
% 02515000
% IF NOT VALID_FILE(KC_BUF, X, OUT) THEN 02516000
% BEGIN 02517000
% MOVE KC_BUF := ("Kermit file security error -", 02518000
% " see your account manager"),2; 02519000
% KC_LEN := TOS - @KC_BUF; 02520000
% SPACK("E",N,KC_LEN,KC_BUF); 02521000
% END 02522000
% ELSE 02523000
% BEGIN 02524000
% DNUM := FOPEN(KC_BUF,5,0); 02525000
% IF DNUM = 0 THEN 02526000
% BEGIN 02527000
% MOVE KC_BUF := "File open error",2; 02528000
% KC_LEN := TOS - @KC_BUF; 02529000
% SPACK("E",N,KC_LEN,KC_BUF); 02530000
% END 02531000
% ELSE 02532000
% BEGIN 02533000
% SENDSW(KC_BUF,0); 02534000
% STATE := SBREAK; 02535000
% END; 02536000
% END; 02537000
% END; 02538000
% END 02539000
% 02540000
% ELSE 02541000
BEGIN 02542000
REPLACE PTEMP:KC_BUF BY "Unimplementented Server Command"; 02543000
KC_LEN:=OFFSET(PTEMP); 02544000
SPACK("E",N,KC_LEN,KC_BUF); 02545000
END; 02546000
END; 02547000
$ PAGE 02548000
PROCEDURE SERVER; 02550000
BEGIN 02551000
02552000
DEFINE CB_MAX = 79#; % Max command size -1 02553000
02554000
ASCII ARRAY CBUF[0:CB_MAX]; % Command Buffer 02555000
02556000
BOOLEAN DONE, 02557000
SEARCHED; 02558000
02559000
INTEGER CB_CNT, % Command size 02560000
KT_NUM; % Temp file number 02561000
% ************************************************************ 02562000
BOOLEAN PROCEDURE DIRSEARCH; 02563000
BEGIN 02564000
DIRSEARCH:=FALSE; % Prepare for the worst 02565000
% IF NOT SEARCHED THEN 02566000
% BEGIN 02567000
% GET_KTEMP; 02568000
% IF NOT HAVE_KTEMP THEN 02569000
% BEGIN 02570000
% MOVE PBUF:="Unable to allocate temp file", 2; 02571000
% PLEN:=TOS-@PBUF; 02572000
% SPACK("E", N, PLEN, PBUF); 02573000
% return; 02574000
% END; 02575000
% MOVE PBUF:="LISTF ", 2; 02576000
% MOVE *:=CBUF, (CB_CNT), 2; 02577000
% MOVE *:=("; *", KTEMP_NAME, CR); 02578000
% COMMAND(PBUF, ERROR, PARM); 02579000
% IF ERROR NEQ 0 THEN 02580000
% BEGIN 02581000
% MOVE PBUF:="Directory search failed. Error=", 2; 02582000
% PLEN:=(PLEN:=TOS-@PBUF) + 02583000
% ASCII(ERROR, 10, PBUF(PLEN)); 02584000
% SPACK("E", N, PLEN, PBUF); 02585000
% return; 02586000
% END; 02587000
% 02588000
% KT_NUM:=FOPEN(KT_NAME, 6, 0); 02589000
% IF KT_NUM = 0 THEN 02590000
% BEGIN 02591000
% MOVE PBUF:="Temp file open failure", 2; 02592000
% PLEN:=TOS-@PBUF; 02593000
% SPACK("E", N, PLEN, PBUF); 02594000
% return; 02595000
% END; 02596000
% 02597000
% FREAD(KT_NUM, PBUF_W, -80); % Hopefully skip over junk 02598000
% FREAD(KT_NUM, PBUF_W, -80); 02599000
% FREAD(KT_NUM, PBUF_W, -80); 02600000
% SEARCHED:=TRUE; 02601000
% END; 02602000
% 02603000
% MOVE PBUF:=20(" "); 02604000
% IF FREAD(KT_NUM, PBUF_W, -80) <= 1 OR PBUF(0) = special THEN 02605000
% BEGIN 02606000
% SEARCHED:=FALSE; 02607000
% FCLOSE(KT_NUM, 4, 0); % Purge 02608000
% KT_NUM:=0; 02609000
% KILL_KTEMP; 02610000
% STATE := SBREAK; 02611000
% return; 02612000
% END; 02613000
% 02614000
% % If we survived all of that, we will return one file name 02615000
% % which could be denied by the file validator 02616000
% 02617000
% MOVE L_FNAME:=PBUF(0) WHILE an, 1; 02618000
% CB_CNT:=RP_LEN:=TOS-@L_FNAME; 02619000
% IF SEARCHED.(0:1) THEN 02620000
% BEGIN 02621000
% SEARCHED.(0:1):=FALSE; 02622000
% RP_LEN:=-RP_LEN; 02623000
% END; 02624000
% DIRSEARCH:=TRUE; 02625000
END; 02626000
02627000
02628000
02629000
% Set default conditions 02630000
02631000
MAX_SND_SIZE := 80; 02632000
MAX_SND_DATA := 77; 02633000
YOUR_PAD_COUNT := 0; 02634000
YOUR_PAD := 0; 02635000
YOUR_EOL := CR; 02636000
YOUR_Q_CTL := 7"#"; 02637000
QUOTE_8 := FALSE; 02638000
USE_REPEAT := FALSE; 02639000
02640000
WHILE NOT (DONE OR BLASTED) DO 02641000
BEGIN 02642000
N := 0; 02643000
NUMTRY := 0; 02644000
STATE := "S"; 02644100
02645000
IF RPACK(RP,RP_LEN,RP_NUM,RP_DATA) AND (RP_NUM = 0) THEN 02646000
BEGIN 02647000
IF RP = "I" THEN 02648000
BEGIN % Exchange Parameters 02649000
R_RPAR(RP_DATA,RP_LEN); 02650000
R_SPAR(RP_DATA,RP_LEN); 02651000
SPACK("Y",N,RP_LEN,RP_DATA); 02652000
OLDTRY := NUMTRY; 02653000
NUMTRY := 0; 02654000
N := NPNO(RP_NUM); 02655000
END 02656000
ELSE 02657000
IF RP = "S" THEN 02658000
BEGIN % Other side is sending 02659000
R_RPAR(RP_DATA,RP_LEN); 02660000
R_SPAR(RP_DATA,RP_LEN); 02661000
SPACK("Y",N,RP_LEN,RP_DATA); 02662000
OLDTRY := NUMTRY; 02663000
NUMTRY := 0; 02664000
N := NPNO(RP_NUM); 02665000
RECSW(TRUE); 02666000
END 02667000
ELSE 02668000
IF RP = "R" THEN 02669000
BEGIN % Other side wants us to send 02670000
02671000
CBUFXLT(RP_DATA,RP_LEN,CBUF,CB_CNT,CB_MAX); 02672000
WHILE DIRSEARCH DO 02673000
BEGIN 02674000
REPLACE L_FNAME[CB_CNT] BY "."; 02675000
% IF NOT VALID_FILE(L_FNAME, CB_CNT, OUT) THEN 02676000
% BEGIN 02677000
% MOVE RP_DATA := ("Kermit file security ", 02678000
% "error - see your account ", 02679000
% "manager"); 02680000
% SPACK("E",N,53,RP_DATA); 02681000
% END 02682000
% ELSE 02683000
BEGIN 02684000
REPLACE TTL BY L_FNAME FOR L_FNAME_LEN 02684800
WITH ASCIITOEBCDIC, 8"."; 02684900
DNUM(KIND = DISK, TITLE = TTL, 02685000
INTMODE = ASCII, DEPENDENTSPECS = TRUE, 02685100
NEWFILE = FALSE); 02685200
IF NOT DNUM.OPEN THEN %????????????????????????02686000
BEGIN % File open error 02687000
REPLACE RP_DATA BY "File open error"; 02688000
SPACK("E",N,15,RP_DATA); 02689000
END 02690000
ELSE 02691000
BEGIN 02692000
SENDSW(L_FNAME,RP_LEN); 02693000
END; 02694000
END; 02695000
END; 02696000
END 02697000
ELSE 02698000
IF RP = "G" THEN 02699000
BEGIN % KERMIT Command 02700000
IF (RP_DATA = "F") AND (RP_LEN = 1) THEN 02701000
BEGIN 02702000
SPACK("Y",N,0,RP_DATA); 02703000
DONE := TRUE; 02704000
END 02705000
ELSE 02706000
BEGIN 02707000
IF CBUFXLT(RP_DATA,RP_LEN, 02708000
CBUF,CB_CNT,CB_MAX) THEN 02709000
BEGIN 02710000
KERMIT_COMMAND(CBUF,CB_CNT); 02711000
END 02712000
ELSE 02713000
BEGIN 02714000
REPLACE CBUF BY "Command too big"; 02715000
SPACK("E",N,15,CBUF); 02717000
END; 02718000
END; 02719000
END 02720000
ELSE 02721000
BEGIN 02722000
SPACK("N",N,0,RP_DATA); 02723000
END; 02724000
END 02725000
ELSE 02726000
BEGIN 02727000
SPACK("N",N,0,RP_DATA); 02728000
END; 02729000
END; 02730000
END; 02731000
02732000
$ PAGE 02733000
PROCEDURE VERIFY; 02735000
BEGIN 02736000
POINTER P; 02737000
02737100
REAL HEX_N; % Temp for SAYNUM 02737200
02737300
INTEGER I; 02737400
02737500
DEFINE SAY = BEGIN 02738000
REPLACE P:P BY#, % Better than M_ST 02739000
ENDSAY = ; % Better than M_EN 02740000
END#, 02742000
SPIT = BEGIN 02745000
PLEN:=OFFSET(P); 02746000
WRITE(CONUM, PLEN, PBUF); 02747000
REPLACE P:=PBUF BY " " FOR 80; 02749000
END#, 02750000
MIDLINE = P:=PBUF[30]#; 02751000
%------------------------------------------------------------------ 02751100
PROCEDURE SAYBOOL(TRUTH); 02752000
VALUE TRUTH; 02753000
BOOLEAN TRUTH; 02754000
BEGIN 02755000
CASE REAL(TRUTH.[0:1]) OF % Who says we must use IF statement02756000
BEGIN 02757000
SAY "FALSE" ENDSAY; 02758000
SAY "TRUE" ENDSAY; 02759000
END; 02760000
END; 02761000
%------------------------------------------------------------------ 02761010
PROCEDURE SAYNUM(N); % REPLACE FOR n DIGITS gives EBCDIC 02761100
VALUE N ; % output which doesn't do this ASCII 02761200
INTEGER N ; % program any good at all 02761300
BEGIN 02761400
HEX_N := SCALERIGHTF(N, 12); % 12 digits of hex 02761500
REPLACE P BY 7"0"; % Need this for N=0 02761600
FOR I:=((FIRSTONE(HEX_N)+3) DIV 4)*4 -1 % Readability ... 02761700
STEP -4 02761710
UNTIL 3 02761720
DO REPLACE P:P BY (HEX_N.[I:4]+7"0").LOWBYTE FOR 1; 02761800
END; 02761900
%------------------------------------------------------------------ 02761910
02762000
P:=PBUF; 02763000
SAY " " FOR 80 ENDSAY; 02764000
SPIT; 02765000
SAY "RECEIVE parameters" ENDSAY; 02766000
MIDLINE; 02767000
SAY "Other parameters" ENDSAY; 02768000
SPIT; 02769000
02770000
SAY " BINARY: " ENDSAY; 02771000
SAYBOOL(RCV_BINARY); 02772000
MIDLINE; 02773000
SAY " SEND BINARY: " ENDSAY; 02774000
CASE SND_BINARY OF 02775000
BEGIN 02776000
SAY "Auto" ENDSAY; 02777000
SAY "Binary" ENDSAY; 02778000
SAY "ASCII" ENDSAY; 02779000
END; 02780000
SPIT; 02781000
02782000
SAY " FIXREC: " ENDSAY; 02783000
SAYBOOL(RCV_FIXREC); 02784000
MIDLINE; 02785000
SAY " SEND PAUSE: " ENDSAY; 02786000
SAYNUM(PAUSE_CNT); 02787000
SPIT; 02788000
02789000
SAY " SAVESP: " ENDSAY; 02790000
SAYBOOL(RCV_SAVESP); 02791000
MIDLINE; 02792000
SAY " DELAY: " ENDSAY; 02793000
SAYNUM(I_DELAY); 02794000
SPIT; 02795000
02796000
SAY " FCODE: " ENDSAY; 02797000
SAY "DATA" ENDSAY; 02798000
% MIDLINE; 02799000
% SAY " HANDSHAKE: " ENDSAY; 02800000
% CASE HNDSHK OF 02801000
% BEGIN 02802000
% SAY "None" ENDSAY; 02803000
% SAY "XON" ENDSAY; 02804000
% SAY "XON2" ENDSAY; 02805000
% END; 02806000
SPIT; 02807000
02808000
SAY " RECLEN: " ENDSAY; 02809000
SAYNUM(RCV_RECLEN); 02810000
MIDLINE; 02811000
SAY " DEBUG: " ENDSAY; 02812000
SAYNUM(DEBUG_MODE); 02813000
SPIT; 02814000
02815000
SAY " BLOCKF: " ENDSAY; 02816000
SAYNUM(RCV_BLOCKF); 02817000
MIDLINE; 02818000
SAY " LOG: " ENDSAY; 02819000
IF LOGNUM_OPEN THEN 02820000
BEGIN 02821000
SAY "TRUE (" ENDSAY; 02822000
SAY LOGNAME FOR LOGNAME_LEN ENDSAY; 02823000
SAY ")" ENDSAY; 02824000
END 02825000
ELSE 02826000
SAY "FALSE" ENDSAY; 02827000
02828000
SPIT; 02829000
SAY " MAXEXT: " ENDSAY; 02830000
SAYNUM(RCV_MAXEXT); 02831000
%MIDLINE; 02832000
%SAY " LINE LDEV: " ENDSAY; 02833000
%SAYNUM(LDEV_LINE); 02834000
SPIT; 02835000
02836000
SAY " MAXREC: " ENDSAY; 02837000
SAYNUM(RCV_MAXREC); 02838000
%MIDLINE; 02839000
%SAY " LINE SPEED: " ENDSAY; 02840000
%SAYNUM(TSPEED); 02841000
SPIT; 02842000
02843000
SAY " DEVICE: " ENDSAY; 02844000
SAY "DISK " ENDSAY; 02845000
MIDLINE; 02846000
SAY " SOH: " ENDSAY; 02847000
SAYNUM(SOH); 02848000
SPIT; 02849000
02850000
SAY " EXPTAB: " ENDSAY; 02851000
SAYBOOL(EXP_TABS); 02852000
SPIT; 02853000
02854000
END; 02855000
02856000
02857000
$ PAGE 02858000
BOOLEAN PROCEDURE KINIT; 02860000
BEGIN 02861000
02862000
BOOLEAN R_ERROR; 02863000
02864000
INTEGER J_MODE, 02865000
J_LDEV, 02866000
DUM, 02867000
F_LDEV; 02868000
02869000
POINTER PTEMP; 02869100
02869200
REAL DATE; 02869300
02869400
DEFINE NUMCONV(N) = ((N).[3:4] + 47"30").LOWBYTE FOR 1#; 02869500
02869600
% ------------------------------------------------------------ 02870000
02872000
CINUM(KIND=REMOTE, MYUSE=IN, FILETYPE=3, 02872800
MAXRECSIZE=LBUF_BYTESIZE, UNITS=CHARACTERS); 02872900
CINUM.OPEN:=TRUE; 02873000
CONUM(KIND=REMOTE, MYUSE=OUT, 02873800
MAXRECSIZE=LBUF_BYTESIZE, UNITS=CHARACTERS); 02873900
CONUM.OPEN:=TRUE; 02874000
02875000
02877000
IF (CINUM.OPEN) AND (CONUM.OPEN) THEN 02878000
BEGIN 02879000
M_ST VERS M_EN; % Output current version # 02880000
DATE := COMPILETIME(15); % Unfortunately, its EBCDIC 02881100
M_ST 7" " FOR 16, 7"(Compiled ", 02881200
NUMCONV(DATE.[47:8]), NUMCONV(DATE.[39:8]), 7"/", 02881300
NUMCONV(DATE.[31:8]), NUMCONV(DATE.[23:8]), 7"/", 02881400
NUMCONV(DATE.[15:8]), NUMCONV(DATE.[7:8]), 7")", 4"00" 02881500
M_EN; 02881600
M_ST "Works best with PC Kermit 2.31 or newer." M_EN; 02881610
M_ST 47"0D0A""Type ?HI to abort a command" M_EN; 02881700
M_ST " " M_EN; 02881900
02882000
ATTACH BLAST TO MYSELF.EXCEPTIONEVENT; 02883000
ENABLE BLAST; 02883100
02884000
% REPLACE PTEMP:KT_NAME BY KTEMP_NAME; 02885000
% KTN_LEN:=OFFSET(PTEMP); 02886000
% REPLACE KT_NAME[KTN_LEN] BY "."; 02887000
% 02888000
% LDEV_CI := 0; 02889000
% LDEV_LINE := 0; 02890000
% 02891000
% WHO(J_MODE,,,MYSELF,,,,J_LDEV); 02892000
% IF J_MODE.(12:2) = 1 THEN 02893000
% BEGIN % Session 02894000
% LDEV_LINE := J_LDEV; % Default COM to session dev 02895000
% FGETINFO(CINUM,,,,,,F_LDEV); % Get CI ldev 02896000
% IF F_LDEV = J_LDEV THEN 02897000
% BEGIN % Command input uses session device 02898000
% LDEV_CI := J_LDEV; 02899000
% END 02900000
% ELSE 02901000
% BEGIN 02902000
% FGETINFO(CONUM,,,,,,F_LDEV); % Get CO ldev 02903000
% IF F_LDEV = J_LDEV THEN 02904000
% LDEV_CI := J_LDEV; % CO uses session ldev 02905000
% END; 02906000
% END; 02907000
REPLACE MIN_SIZE BY REAL(NOT FALSE).[38:39] 02907800
FOR SIZE(MIN_SIZE) WORDS; 02907900
MIN_SIZE[DELETEV] :=2; MIN_SIZE[DIRV] :=2; 02908000
MIN_SIZE[EXITV] :=1; MIN_SIZE[NULLV] :=1; 02909000
MIN_SIZE[RECEIVEV] :=1; MIN_SIZE[SENDV] :=3; 02910000
MIN_SIZE[SERVEV] :=3; MIN_SIZE[SETV] :=3; 02911000
MIN_SIZE[SPACEV] :=2; MIN_SIZE[STATUSV] :=2; 02912000
MIN_SIZE[TAKEV] :=2; MIN_SIZE[TYPEV] :=2; 02913000
MIN_SIZE[VERIFYV] :=1; 02914000
02915000
MIN_SIZE[DEBUGV] :=3; MIN_SIZE[DELAYV] :=3; 02916000
MIN_SIZE[HANDSHAKEV]:=1; MIN_SIZE[LINEV] :=2; 02917000
MIN_SIZE[LOGV] :=2; MIN_SIZE[SENDV_1] :=3; 02918000
MIN_SIZE[SPEEDV] :=2; MIN_SIZE[SOHV] :=2; 02919000
MIN_SIZE[RECEIVEV_1]:=1; 02920000
02921000
MIN_SIZE[AUTOV] :=1; MIN_SIZE[BIN128V] :=4; 02922000
MIN_SIZE[BINARYV] :=4; MIN_SIZE[BLOCKFV] :=2; 02923000
MIN_SIZE[DEVICEV] :=1; MIN_SIZE[FIXRECV] :=2; 02924000
MIN_SIZE[FCODEV] :=2; MIN_SIZE[MAXRECV] :=4; 02925000
MIN_SIZE[MAXEXTV] :=4; MIN_SIZE[PAUSEV] :=2; 02926000
MIN_SIZE[PROGV] :=2; MIN_SIZE[RECLENV] :=1; 02927000
MIN_SIZE[SAVESPV] :=1; MIN_SIZE[TEXTV] :=2; 02928000
MIN_SIZE[TXT80V] :=2; MIN_SIZE[EXPTABV] :=1; 02929000
02930000
MIN_SIZE[NONEV] :=1; MIN_SIZE[OFFV] :=2; 02931000
MIN_SIZE[ONV] :=2; MIN_SIZE[XONV] :=3; 02932000
MIN_SIZE[XON2V] :=4; MIN_SIZE[YESV] :=1; 02933000
02933010
YOUR_EOL :=CR; MY_EOL :=CR; 02933020
MY_Q_CTL :=7"#"; YOUR_Q_CTL :=7"#"; 02933030
Q_8 :=P_Q_8; RPT_CHR :=P_RPT_CHR; 02933040
MY_TO :=10; YOUR_TO :=10; 02933050
MAXTRY :=10; RCV_FIXREC :=TRUE; 02933060
RCV_SAVESP :=TRUE; RCV_FCODE :=192; 02933070
RCV_RECLEN :=80; RCV_BLOCKF :=18; 02933080
RCV_MAXEXT :=15; RCV_MAXREC :=5400; 02933090
SOH :=2; %HNDSHK :=1; 02933100
I_DELAY :=10; USE_DC1 :=TRUE; 02933110
SND_BINARY :=2; 02933112
MY_BLK_CK :="3"; YOUR_BLK_CK :="1"; 02933114
MAX_SND_SIZE :=MAX_RCV_SIZE; 02933120
MAX_SND_DATA :=MAX_RCV_SIZE; 02933130
02933140
MY_CAPS := 0 & 02933200
1 [LONGP_F] & 02933300
0 [WINDOWS_F] & 02933400
0 [ATTRS_F]; 02933500
02934000
END 02935000
ELSE 02936000
BEGIN 02937000
R_ERROR := TRUE; 02938000
END; 02939000
02940000
IF MYSELF.TASKVALUE > 0 THEN 02941000
BEGIN 02942000
REPLACE PBUF BY 8"F599KM", 02943000
MYSELF.TASKVALUE FOR 2 DIGITS, 02944000
8"."; 02945000
TAKENUM(KIND=DISK, TITLE=PBUF, 02946000
INTMODE=ASCII, DEPENDENTSPECS=TRUE); 02946100
IF NOT TAKENUM.PRESENT THEN 02947000
BEGIN 02948000
REPLACE PTEMP:PBUF[PLEN] BY "take file open error", 2; 02949000
PLEN:=OFFSET(PTEMP); 02950000
WRITE(CONUM, PLEN, PBUF); 02951000
END 02952000
ELSE 02952100
TAKENUM_OPEN:=TRUE; 02952200
END; 02953000
02953100
02954000
KINIT := NOT R_ERROR; 02955000
02956000
END; 02957000
$ PAGE 02958000
PROCEDURE HELP(ITEM, LEVEL, RCVCASE); 02960000
VALUE ITEM, LEVEL, RCVCASE; 02961000
INTEGER ITEM, LEVEL, RCVCASE; 02964000
02967000
BEGIN 02969000
DEFINE SEGMENTATION = NUTTIN#; 02970000
02971000
% ----------------------------------------------------------- 02972000
02973000
M_ST " " M_EN; 02974000
CASE ITEM OF 02975000
BEGIN 02976000
02977000
0: % COMMANDS IN GENERAL 02978000
BEGIN 02979000
02980000
M_ST "Commands:" M_EN; 02981000
M_ST " " M_EN; 02982000
M_ST " TAKE" M_EN; 02983000
M_ST " SERVE" M_EN; 02984000
M_ST " SEND" M_EN; 02985000
M_ST " RECEIVE" M_EN; 02986000
M_ST " SET" M_EN; 02987000
M_ST " STATUS" M_EN; 02988000
M_ST " DIR" M_EN; 02989000
M_ST " SPACE" M_EN; 02990000
M_ST " DELETE" M_EN; 02991000
M_ST " TYPE" M_EN; 02992000
M_ST " EXIT" M_EN; 02993000
END; 02994000
02995000
(TAKEV): 02996000
02997000
BEGIN 02998000
M_ST "Syntax: TAKE filespec" M_EN; 02999000
M_ST " " M_EN; 03000000
M_ST 03001000
"The TAKE command causes subsequent commands to be" 03002000
M_EN; 03003000
M_ST 03004000
"taken from the specified file until EOF is reached." 03005000
M_EN; 03006000
M_ST 03007000
"If a subsequent TAKE is encountered within the original"03008000
M_EN; 03009000
M_ST 03010000
"TAKE file, the first file is closed and execution" 03011000
M_EN; 03012000
M_ST 03013000
"continues with the second. This means that if a" 03014000
M_EN; 03015000
M_ST 03016000
"TAKE appears within a TAKE file, commands that follow" 03017000
M_EN; 03018000
M_ST 03019000
"it (in the original TAKE file) will be ignored." 03020000
M_EN; 03021000
END; 03022000
03023000
(SENDV): 03024000
03025000
BEGIN 03026000
M_ST "Syntax: SEND filespec1 [filespec2]" M_EN; 03027000
M_ST " " M_EN; 03028000
M_ST 03029000
"This command causes a file (indicated by filespec1) " 03030000
M_EN; 03031000
M_ST 03032000
"to be sent from the Burroughs to the local KERMIT. " 03033000
M_EN; 03034000
M_ST 03035000
"Wildcard characters are not permitted. If filespec2 " 03036000
M_EN; 03037000
M_ST 03038000
"is specified, the file will be sent with that name." 03039000
M_EN; 03040000
END; 03041000
03042000
(RECEIVEV): 03043000
03044000
BEGIN 03045000
M_ST "Syntax: RECEIVE filespec" M_EN; 03046000
M_ST " " M_EN; 03047000
M_ST 03048000
"The RECEIVE command causes Burroughs KERMIT to enter " 03049000
M_EN; 03050000
M_ST 03051000
"receive mode and wait for the local kermit to start " 03052000
M_EN; 03053000
M_ST 03054000
"sending a file. If filespec is not specified, a file " 03055000
M_EN; 03056000
M_ST 03057000
"title will be requested." 03058000
M_EN; 03059000
END; 03060000
03061000
(SERVEV): 03062000
03063000
BEGIN 03064000
M_ST "Syntax: SERVE" M_EN; 03065000
M_ST " " M_EN; 03066000
M_ST 03067000
"The SERVE command causes HP 3000 KERMIT to go into" 03068000
M_EN; 03069000
M_ST 03070000
"server mode. Once in server mode, the only way back" 03071000
M_EN; 03072000
M_ST 03073000
"to command mode is the Control-Y trap." 03074000
M_EN; 03075000
M_ST " " M_EN; 03076000
M_ST 03077000
"In addition to the standard KERMIT transactions for" 03078000
M_EN; 03079000
M_ST 03080000
"file transfer, the following server functions are" 03081000
M_EN; 03082000
M_ST 03083000
"supported:" 03084000
M_EN; 03085000
M_ST " " M_EN; 03086000
M_ST 03087000
"FUNCTION PROBABLE SYNTAX" 03088000
M_EN; 03089000
M_ST 03090000
" (If available on local KERMIT)" 03091000
M_EN; 03092000
M_ST 03093000
"------------------- -------------------------------" 03094000
M_EN; 03095000
M_ST " " M_EN; 03096000
M_ST 03097000
"Finish Processing FINISH" 03098000
M_EN; 03099000
M_ST 03100000
"Type a file REMOTE TYPE filespec" 03101000
M_EN; 03102000
M_ST 03103000
"Directory Listing REMOTE DIRECTORY [filespec]" 03104000
M_EN; 03105000
M_ST 03106000
"File Space Listing REMOTE SPACE [filespec]" 03107000
M_EN; 03108000
M_ST 03109000
"Delete a file REMOTE DELETE filespec" 03110000
M_EN; 03111000
M_ST " " M_EN; 03112000
M_ST 03113000
"Wildcard file specification may be used only for the" 03114000
M_EN; 03115000
M_ST 03116000
"DIRECTORY and SPACE transactions. Wildcard specifi-" 03117000
M_EN; 03118000
M_ST 03119000
"cations are in the native HP 3000 format. To produce" 03120000
M_EN; 03121000
M_ST 03122000
"a DIRECTORY listing of all files starting with FOO use:"03123000
M_EN; 03124000
M_ST " " M_EN; 03125000
M_ST 03126000
" REMOTE DIRECTORY FOO@" 03127000
M_EN; 03128000
END; 03129000
03130000
SETV: 03131000
03132000
BEGIN 03133000
CASE LEVEL OF 03134000
BEGIN 03135000
03136000
0: % SET COMMANDS IN GENERAL 03137000
03138000
BEGIN 03139000
M_ST "SET items:" M_EN; 03140000
M_ST " " M_EN; 03141000
M_ST " SET DEBUG" M_EN; 03142000
M_ST " SET DELAY" M_EN; 03143000
M_ST " SET LINE" M_EN; 03144000
M_ST " SET SEND" M_EN; 03145000
M_ST " SET SPEED" M_EN; 03146000
M_ST " SET HANDSHAKE" M_EN; 03147000
M_ST " SET RECEIVE" M_EN; 03148000
M_ST " SET LOG" M_EN; 03149000
M_ST " SET SOH" M_EN; 03150000
M_ST " " M_EN; 03151000
M_ST "type 'SET item ?'for explanation" M_EN; 03152000
END; 03153000
03154000
DEBUGV: % SET DEBUG 03155000
03156000
BEGIN 03157000
M_ST 03158000
"Syntax: SET DEBUG number" 03159000
M_EN; 03160000
M_ST " " M_EN; 03161000
M_ST 03162000
"This sets the debug level to the indicated" 03163000
M_EN; 03164000
M_ST 03165000
"number. Currently, only one level exists." 03166000
M_EN; 03167000
M_ST 03168000
"This level is enabled by setting the number to" 03169000
M_EN; 03170000
M_ST 03171000
"any non-negative, non-zero number. If DEBUG is" 03172000
M_EN; 03173000
M_ST 03174000
"enabled, packets sent and received are written" 03175000
M_EN; 03176000
M_ST 03177000
"to the LOG file. The LOG file defaults to the" 03178000
M_EN; 03179000
M_ST 03180000
"job/session output file. LOG output to the " 03181000
M_EN; 03182000
M_ST 03183000
"job/session output file is disabled when commu-" 03184000
M_EN; 03185000
M_ST 03186000
"nications are taking place unless the communica-" 03187000
M_EN; 03188000
M_ST 03189000
"tions line has been re-designated via the SET" 03190000
M_EN; 03191000
M_ST 03192000
"LINE command." 03193000
M_EN; 03194000
END; 03195000
03196000
DELAYV: % SET DELAY 03197000
03198000
BEGIN 03199000
M_ST "Syntax: SET DELAY number" M_EN; 03200000
M_ST " " M_EN; 03201000
M_ST 03202000
"Causes a pause for the indicated number of" 03203000
M_EN; 03204000
M_ST 03205000
"seconds prior to starting a SEND command. This" 03206000
M_EN; 03207000
M_ST 03208000
"is to allow the user to escape back to the local" 03209000
M_EN; 03210000
M_ST 03211000
"KERMIT and enter a RECEIVE command." 03212000
M_EN; 03213000
END; 03214000
03215000
LINEV: % SET LINE 03216000
03217000
BEGIN 03218000
M_ST "Syntax: SET LINE ldev" M_EN; 03219000
M_ST " " M_EN; 03220000
M_ST 03221000
"This causes the indicated ldev (logical device" 03222000
M_EN; 03223000
M_ST 03224000
"number) to be used for communications purposes." 03225000
M_EN; 03226000
END; 03227000
03228000
SENDV_1: % SET SEND 03229000
03230000
BEGIN 03231000
M_ST " { PAUSE number }" M_EN; 03232000
M_ST " { }" M_EN; 03233000
M_ST "Syntax: SET SEND { { ON } }" M_EN; 03234000
M_ST " { BINARY{ OFF } }" M_EN; 03235000
M_ST " { { AUTO } }" M_EN; 03236000
M_ST " " M_EN; 03237000
M_ST 03238000
"This parameter is used to alter the default" 03239000
M_EN; 03240000
M_ST 03241000
"conditions relating to how files are sent." 03242000
M_EN; 03243000
END; 03244000
03245000
SPEEDV: % SET SPEED 03246000
03247000
BEGIN 03248000
M_ST "Syntax: SET SPEED speed" M_EN; 03249000
M_ST " " M_EN; 03250000
M_ST 03251000
"Sets the communications speed to the indicated" 03252000
M_EN; 03253000
M_ST 03254000
"number of characters per second. Supported" 03255000
M_EN; 03256000
M_ST 03257000
"speeds are: 30, 60, 120, 480, 960." 03258000
M_EN; 03259000
END; 03260000
03261000
HANDSHAKEV: % SET HANDSHAKE 03262000
03263000
BEGIN 03264000
M_ST "Syntax: SET HANDSHAKE option" M_EN; 03265000
M_ST " " M_EN; 03266000
M_ST 03267000
"This specifies any handshaking that is to be" 03268000
M_EN; 03269000
M_ST 03270000
"done on the communications line. Options are:" 03271000
M_EN; 03272000
M_ST " " M_EN; 03273000
M_ST 03274000
"XON Generate an XON character prior to each" 03275000
M_EN; 03276000
M_ST 03277000
"read. This is the default mode and is needed" 03278000
M_EN; 03279000
M_ST 03280000
"in most cases since the HP will lose any" 03281000
M_EN; 03282000
M_ST 03283000
"characters that are transmitted when no read is" 03284000
M_EN; 03285000
M_ST 03286000
"active. The local KERMIT must be capable of" 03287000
M_EN; 03288000
M_ST 03289000
"waiting for an XON character before issuing a" 03290000
M_EN; 03291000
M_ST 03292000
"a write to the communications line." 03293000
M_EN; 03294000
M_ST " " M_EN; 03295000
M_ST 03296000
"NONE Generate no special characters prior to a" 03297000
M_EN; 03298000
M_ST 03299000
"read." 03300000
M_EN; 03301000
M_ST " " M_EN; 03302000
M_ST 03303000
"XON2 Same as XON except in both directions." 03304000
M_EN; 03305000
M_ST 03306000
"This sets the read termination character to XON" 03307000
M_EN; 03308000
M_ST 03309000
"in an attempt to synchronize with another KERMIT" 03310000
M_EN; 03311000
M_ST 03312000
"having similar limitations." 03313000
M_EN; 03314000
END; 03315000
03316000
RECEIVEV_1: % SET RECEIVE 03317000
03318000
CASE RCVCASE OF 03319000
BEGIN 03320000
03321000
0: % General stuff 03322000
03323000
BEGIN 03324000
M_ST 03325000
"The SET RECEIVE parameter is used to alter the" 03326000
M_EN; 03327000
M_ST 03328000
"default conditions regarding file reception." 03329000
M_EN; 03330000
M_ST 03331000
"The various options are:" 03332000
M_EN; 03333000
M_ST " " M_EN; 03334000
M_ST " SET RECEIVE DEVICE" M_EN; 03335000
M_ST " SET RECEIVE FCODE" M_EN; 03336000
M_ST " SET RECEIVE BINARY" M_EN; 03337000
M_ST " SET RECEIVE RECLEN" M_EN; 03338000
M_ST " SET RECEIVE FIXREC" M_EN; 03339000
M_ST " SET RECEIVE BLOCKF" M_EN; 03340000
M_ST " SET RECEIVE MAXREC" M_EN; 03341000
M_ST " SET RECEIVE MAXEXT" M_EN; 03342000
M_ST " SET RECEIVE SAVESP" M_EN; 03343000
M_ST " SET RECEIVE PROG" M_EN; 03344000
M_ST " SET RECEIVE TEXT" M_EN; 03345000
M_ST " SET RECEIVE TXT80" M_EN; 03346000
M_ST " SET RECEIVE BIN128" M_EN; 03347000
M_ST " SET RECEIVE EXPTAB" M_EN; 03348000
END; 03349000
03350000
BINARYV: % SET RECEIVE BINARY 03351000
03352000
BEGIN 03353000
M_ST 03354000
"Syntax: SET RECEIVE BINARY { ON }" 03355000
M_EN; 03356000
M_ST 03357000
" { OFF }" 03358000
M_EN; 03359000
M_ST " " M_EN; 03360000
M_ST 03361000
"BINARY tells how to store received files on the" 03362000
M_EN; 03363000
M_ST 03364000
"Burroughs." 03365000
M_EN; 03366000
M_ST " ON Store files as binary." M_EN; 03367000
M_ST " OFF Store files as ASCII." M_EN; 03368000
END; 03369000
03370000
DEVICEV: % SET RECEIVE DEVICE 03371000
03372000
BEGIN 03373000
M_ST 03374000
"Syntax: SET RECEIVE DEVICE [ dev ] " 03375000
M_EN; 03376000
M_ST " " M_EN; 03377000
M_ST 03378000
"DEVICE specifies the device class for received" 03379000
M_EN; 03380000
M_ST 03381000
"files. Default is DISK. This command can be" 03382000
M_EN; 03383000
M_ST 03384000
"used to send files directly to the system line" 03385000
M_EN; 03386000
M_ST "printer." M_EN; 03387000
M_ST " " M_EN; 03388000
END; 03389000
03390000
FCODEV: % SET RECEIVE FCODE 03391000
03392000
BEGIN 03393000
M_ST 03394000
"Syntax: SET RECEIVE FCODE n" 03395000
M_EN; 03396000
M_ST " " M_EN; 03397000
M_ST 03398000
"FCODE specifies the file code for received files."03399000
M_EN; 03400000
END; 03401000
03402000
RECLENV: % SET RECEIVE RECLEN 03403000
03404000
BEGIN 03405000
M_ST 03406000
"Syntax: SET RECEIVE RECLEN n" 03407000
M_EN; 03408000
M_ST " " M_EN; 03409000
M_ST 03410000
"RECLEN specifies the maximum record length (n)" 03411000
M_EN; 03412000
M_ST 03413000
"for a received file. The units of n is " 03414000
M_EN; 03415000
M_ST 03416000
"characters." 03417000
M_EN; 03418000
END; 03422000
03423000
BLOCKFV: % SET RECEIVE BLOCKF 03424000
03425000
BEGIN 03426000
M_ST 03427000
"Syntax: SET RECEIVE BLOCKF n" 03428000
M_EN; 03429000
M_ST " " M_EN; 03430000
M_ST 03431000
"BLOCKF specifies the blocking factor for received"03432000
M_EN; 03433000
M_ST 03434000
"files. If n is 0, the file will be unblocked, " 03435000
M_EN; 03436000
M_ST 03437000
"possibly causing wasted disk space." 03438000
M_EN; 03439000
END; 03440000
03441000
FIXRECV: % SET RECEIVE FIXREC 03442000
03443000
BEGIN 03444000
M_ST 03445000
"Syntax: SET RECEIVE FIXREC { ON }" 03446000
M_EN; 03447000
M_ST 03448000
" { OFF }" 03449000
M_EN; 03450000
M_ST " " M_EN; 03451000
M_ST 03452000
"FIXREC is used to identify fixed or variable" 03453000
M_EN; 03454000
M_ST 03455000
"length records. Options are:" 03456000
M_EN; 03457000
M_ST " ON Use fixed length records." M_EN; 03458000
M_ST " OFF Use variable length records."M_EN;03459000
END; 03460000
03461000
MAXRECV: % SET RECEIVE MAXREC 03462000
03463000
BEGIN 03464000
M_ST 03465000
"Syntax: SET RECEIVE MAXREC n" 03466000
M_EN; 03467000
M_ST " " M_EN; 03468000
M_ST 03469000
"MAXREC specifies the maximum number of records" 03470000
M_EN; 03471000
M_ST 03472000
"that can be stored in a received file." 03473000
M_EN; 03474000
END; 03475000
03476000
MAXEXTV: % SET RECEIVE MAXEXT 03477000
03478000
BEGIN 03479000
M_ST 03480000
"Syntax: SET RECEIVE MAXEXT n" 03481000
M_EN; 03482000
M_ST " " M_EN; 03483000
M_ST 03484000
"MAXEXT specifies the maximum number of extents" 03485000
M_EN; 03486000
M_ST 03487000
"for a received file. This number (n) must be in" 03488000
M_EN; 03489000
M_ST 03490000
"the range 1 ... 32." 03491000
M_EN; 03492000
END; 03493000
03494000
SAVESPV: % SET RECEIVE SAVESP 03495000
03496000
BEGIN 03497000
M_ST 03498000
"Syntax: SET RECEIVE SAVESP { ON }" 03499000
M_EN; 03500000
M_ST 03501000
" { OFF }" 03502000
M_EN; 03503000
M_ST " " M_EN; 03504000
M_ST 03505000
"SAVESP specifies if unused file space at the end" 03506000
M_EN; 03507000
M_ST 03508000
"of the file is to be returned to the operating" 03509000
M_EN; 03510000
M_ST 03511000
"system. Options are:" 03512000
M_EN; 03513000
M_ST " ON Return unused apace" M_EN; 03514000
M_ST " OFF Do not return unused space"M_EN; 03515000
END; 03516000
03517000
PROGV:% SET RECEIVE PROG 03518000
03519000
BEGIN 03520000
M_ST 03521000
"Syntax: SET RECEIVE PROG" 03522000
M_EN; 03523000
M_ST " " M_EN; 03524000
M_ST 03525000
"PROG will set all of the other parameters needed" 03526000
M_EN; 03527000
M_ST 03528000
"to receive an HP 3000 program (executable) file." 03529000
M_EN; 03530000
M_ST 03531000
"It is equivalent to:" 03532000
M_EN; 03533000
M_ST " SET RECEIVE BINARY ON" M_EN; 03534000
M_ST " SET RECEIVE FIXREC ON" M_EN; 03535000
M_ST " SET RECEIVE FCODE 1029" M_EN; 03536000
M_ST " SET RECEIVE RECLEN 128" M_EN; 03537000
M_ST " SET RECEIVE BLOCKF 1" M_EN; 03538000
M_ST " SET RECEIVE MAXEXT 1" M_EN; 03539000
END; 03540000
03541000
BIN128V: % SET RECEIVE BIN128 03542000
03543000
BEGIN 03544000
M_ST 03545000
"Syntax: SET RECEIVE BIN128" 03546000
M_EN; 03547000
M_ST " " M_EN; 03548000
M_ST 03549000
"BIN128 sets up the needed parameters for recei-" 03550000
M_EN; 03551000
M_ST 03552000
"ving a binary file in the normal HP repre-" 03553000
M_EN; 03554000
M_ST 03555000
"sentation. It is equivalent to:" 03556000
M_EN; 03557000
M_ST " SET RECEIVE BINARY ON" M_EN; 03558000
M_ST " SET RECEIVE FIXREC OFF" M_EN; 03559000
M_ST " SET RECEIVE FCODE 0" M_EN; 03560000
M_ST " SET RECEIVE RECLEN 128" M_EN; 03561000
M_ST " SET RECEIVE BLOCKF 0" M_EN; 03562000
END; 03563000
03564000
TEXTV: % SET RECEIVE TEXT 03565000
03566000
BEGIN 03567000
M_ST 03568000
"Syntax: SET RECEIVE TEXT" 03569000
M_EN; 03570000
M_ST " " M_EN; 03571000
M_ST 03572000
"TEXT sets up the needed parameters for receiving" 03573000
M_EN; 03574000
M_ST 03575000
"generic text files. It is equivalent to:" 03576000
M_EN; 03577000
M_ST " SET RECEIVE BINARY OFF" M_EN; 03578000
M_ST " SET RECEIVE FIXREC OFF" M_EN; 03579000
M_ST " SET RECEIVE FCODE 0" M_EN; 03580000
M_ST " SET RECEIVE RECLEN -254" M_EN; 03581000
M_ST " SET RECEIVE BLOCKF 0" M_EN; 03582000
END; 03583000
03584000
TXT80V: % SET RECEIVE TXT80 03585000
03586000
BEGIN 03587000
M_ST 03588000
"Syntax: SET RECEIVE TXT80" 03589000
M_EN; 03590000
M_ST " " M_EN; 03591000
M_ST 03592000
"TXT80 sets up the needed parameters for recei-" 03593000
M_EN; 03594000
M_ST 03595000
"ving 80 character text files in the manner that" 03596000
M_EN; 03597000
M_ST 03598000
"is most convenient for the typical text editor." 03599000
M_EN; 03600000
M_ST " SET RECEIVE BINARY OFF" M_EN; 03604000
M_ST " SET RECEIVE FIXREC ON" M_EN; 03605000
M_ST " SET RECEIVE FCODE DATA" M_EN; 03606000
M_ST " SET RECEIVE RECLEN 80" M_EN; 03607000
M_ST " SET RECEIVE BLOCKF 18" M_EN; 03608000
END; 03609000
03610000
EXPTABV: % SET RECEIVE EXPTAB 03611000
03612000
BEGIN 03613000
M_ST 03614000
"Syntax: SET RECEIVE EXPTAB { ON }" 03615000
M_EN; 03616000
M_ST 03617000
" { OFF }" 03618000
M_EN; 03619000
M_ST " " M_EN; 03620000
M_ST 03621000
"EXPTAB expands horizontal tabs found in the" 03622000
M_EN; 03623000
M_ST 03624000
"data. Tab stops are assumed to be at columns" 03625000
M_EN; 03626000
M_ST 03627000
"1, 9, 17, 25, etc." 03628000
M_EN; 03629000
END; 03630000
03631000
END; % CASE SET RECEIVE 03632000
03633000
LOGV: % SET LOG 03634000
03635000
BEGIN 03636000
M_ST 03637000
"Syntax: SET LOG [ filespec ]" 03638000
M_EN; 03639000
M_ST " " M_EN; 03640000
M_ST 03641000
"This command sets the LOG file to the indicated" 03642000
M_EN; 03643000
M_ST 03644000
"filespec. Error and DEBUG messages (if enabled)" 03645000
M_EN; 03646000
M_ST 03647000
"are written to the LOG file (see SET DEBUG)." 03648000
M_EN; 03649000
M_ST 03650000
"If filespec is not specified, the current LOG" 03651000
M_EN; 03652000
M_ST 03653000
"file, if open, is closed." 03654000
M_EN; 03655000
END; 03656000
03657000
SOHV: % SET SOH 03658000
03659000
BEGIN 03660000
M_ST "Syntax: SET SOH [%]n" M_EN; 03661000
M_ST " " M_EN; 03662000
M_ST 03663000
"This option sets the VALUE of the start-of-header"03664000
M_EN; 03665000
M_ST 03666000
"character used to BEGIN each packet. If the %-" 03667000
M_EN; 03668000
M_ST 03669000
"sign is used, n is assumed to be octal. Other-" 03670000
M_EN; 03671000
M_ST 03672000
"wise n is assumed to be decimal. Default VALUE" 03673000
M_EN; 03674000
M_ST 03675000
"for SOH is 2 (STX)." 03676000
M_EN; 03677000
END; 03678000
END; 03679000
END; % SET (LEVEL) CASE 03680000
03681000
EXITV: % EXIT 03682000
03683000
BEGIN 03684000
M_ST "Syntax: {EXIT}" M_EN; 03685000
M_ST " {QUIT}" M_EN; 03685100
M_ST " " M_EN; 03686000
M_ST 03687000
"This command causes the KERMIT process to" 03688000
M_EN; 03689000
M_ST 03690000
"terminate in an orderly manner." 03691000
M_EN; 03692000
END; 03693000
03694000
DIRV: % DIR 03695000
03696000
BEGIN 03697000
M_ST "Syntax: DIR [ filespec ]" M_EN; 03698000
M_ST " " M_EN; 03699000
M_ST 03700000
"This command searches the disc directory for the" 03701000
M_EN; 03702000
M_ST 03703000
"indicated filespec, if any. Wildcard characters" 03704000
M_EN; 03705000
M_ST 03706000
"may be used." 03707000
M_EN; 03708000
END; 03709000
03710000
SPACEV: % SPACE 03711000
03712000
BEGIN 03713000
M_ST "Syntax: SPACE [ groupspec ]" M_EN; 03714000
M_ST " " M_EN; 03715000
M_ST 03716000
"This command reports the amount of in-use and" 03717000
M_EN; 03718000
M_ST 03719000
"available disc for the user's account and group." 03720000
M_EN; 03721000
M_ST 03722000
"(Groupspec may not be valid if the logon user does" 03723000
M_EN; 03724000
M_ST 03725000
"not have account manager capability.)" 03726000
M_EN; 03727000
END; 03728000
03729000
DELETEV: % DELETE 03730000
03731000
BEGIN 03732000
M_ST "Syntax: DELETE filespec" M_EN; 03733000
M_ST " " M_EN; 03734000
M_ST 03735000
"This command causes the indicated filespec to be" 03736000
M_EN; 03737000
M_ST 03738000
"removed from disc." 03739000
M_EN; 03740000
END; 03741000
03742000
TYPEV: % TYPE 03743000
03744000
03745000
BEGIN 03746000
M_ST "Syntax: TYPE filespec" M_EN; 03747000
M_ST " " M_EN; 03748000
M_ST "TYPE lists a file on your terminal." M_EN; 03749000
END; 03750000
03751000
STATUSV: % STATUS 03752000
03753000
BEGIN 03754000
M_ST "Syntax: { STATUS }" M_EN; 03755000
M_ST " { VERIFY }" M_EN; 03756000
M_ST " " M_EN; 03757000
M_ST 03758000
"STATUS provides a listing of the current file and" 03759000
M_EN; 03760000
M_ST 03761000
"transmission attributes." 03762000
M_EN; 03763000
END; 03764000
03765000
END; % ITEM CASE 03766000
M_ST " " M_EN; 03767000
REPLACE IB[ILEN-1] BY " "; % Hopefully wipe out question mark 03768000
WRITE(CONUM[STOP], ILEN, IB); 03769000
END; 03770000
$ PAGE 03771000
INTEGER PROCEDURE SEARCH(TARGET, LENGTH, DICT, DEFN, START); 03774000
VALUE LENGTH, START; 03775000
INTEGER LENGTH, START; 03776000
ASCII ARRAY TARGET[0]; 03777000
ARRAY DICT[0]; 03777100
INTEGER DEFN; 03778000
BEGIN 03779000
03780000
INTEGER I; 03781000
03782000
DEFINE NEXTPLACE = I + (DICT[I]-4) DIV 6 + 4#, 03783000
DEFNPLACE = NEXTPLACE-1#, 03783100
SIZEPLACE = I+1#, 03783200
DICTPLACE = I+2#; 03783300
03783400
03783410
LABEL XIT; 03783420
03783430
DEFN:=0; % Prepare for the worst 03783460
03783470
WHILE DICT[DEFNPLACE] < START 03783500
DO I:=NEXTPLACE; 03783600
03783700
WHILE DICT[I] NEQ 0 DO 03783800
BEGIN 03783900
IF LENGTH LEQ DICT[SIZEPLACE] THEN 03784000
IF TARGET = POINTER( DICT[DICTPLACE] ) FOR LENGTH THEN 03784100
IF LENGTH GEQ MIN_SIZE[DICT[DEFNPLACE]]THEN 03784200
BEGIN 03784300
SEARCH:=1; 03784400
DEFN := DICT[DEFNPLACE]; 03784500
GO TO XIT; 03784600
END; 03784700
I:=NEXTPLACE 03784800
END; 03784900
XIT: 03785000
03785300
END; 03802000
03803000
% ---------------------------------------------------------------- 03804000
03805000
PROCEDURE CMDINT; % Serious work starts here 03806000
BEGIN 03810000
03811000
ASCII ARRAY CPARM[0:79]; % Current Parameter 03812000
03813000
POINTER IB_PTR; % Moves along input line 03815000
03816000
INTEGER CPLEN, % Length of CPARM 03817000
CPVAL, % Numeric VALUE found 03818000
ITEM, % Index of CPARM word 03819000
IBX, % Index to IB 03820000
IBYTE, % Current Character 03821000
X; % Temp Variable 03822000
03823000
03825000
BOOLEAN DONE, % Done Flag 03826000
XFROK; % Xfer OK flag 03827000
03828000
REAL P_INT; % PAUSE Interval 03829000
03830000
LABEL TAKE_EXIT, 03831000
SEND_EXIT, 03832000
RECEIVE_EXIT, 03833000
SERVE_EXIT, 03834000
SET_EXIT, 03835000
EXIT_EXIT, 03835100
DIR_EXIT, 03835200
SPACE_EXIT, 03835300
DELETE_EXIT, 03835400
VERIFY_EXIT; 03835600
03836000
% ----------------------------------------------------------- 03837000
03838000
PROCEDURE SCANIT(START); 03839000
VALUE START; 03840000
INTEGER START; 03841000
BEGIN 03842000
03842100
INTEGER BASE; 03842200
03842300
03842700
LABEL XIT; 03842800
03842900
ITEM:=NULLV; % Default return 03843000
CPLEN:=0; 03844000
SCAN IB_PTR:IB_PTR FOR ILEN:ILEN WHILE = " "; % Skip blanks 03845000
IF ILEN = 0 THEN % End of input 03846000
GO TO XIT; 03847000
03851000
IF IB_PTR IN LETTERS THEN 03853000
BEGIN 03854000
DO BEGIN 03855000
REPLACE CPARM[CPLEN] BY IB_PTR:IB_PTR 03856000
FOR X:ILEN UNTIL = " "; 03857000
CPLEN := CPLEN +(READLOCK(X, ILEN)-X); 03857100
% IF IB_PTR = "/" THEN 03858000
% BEGIN 03859000
% REPLACE CPARM[CPLEN] BY IB_PTR:IB_PTR FOR 1; 03860000
% CPLEN := CPLEN+1; 03861000
% ILEN := ILEN-1; 03862000
% END; 03863000
END 03866000
UNTIL NOT IB_PTR IN ALPHA7 OR ILEN=0; 03867000
SEARCH(CPARM, CPLEN, RESWDS, ITEM, START); 03868000
GO TO XIT; 03870000
END; 03871000
03872000
IF IB_PTR IN NUMBERS OR IB_PTR="%" THEN 03873000
BEGIN % It looks numeric. Will know for sure later. 03875000
IF IB_PTR = "%" THEN 03876000
BEGIN 03877000
BASE := 8; 03878000
IB_PTR := IB_PTR+1; % Pointer skips are expensive 03879000
ILEN := ILEN-1; 03880000
END 03881000
ELSE 03882000
BASE:=10; 03883000
CPVAL := 0; 03884000
WHILE IB_PTR IN NUMBERS AND ILEN > 0 DO 03885000
BEGIN 03886000
CPVAL := BASE*CPVAL + INTEGER(IB_PTR:IB_PTR, 1); 03887000
ILEN := ILEN-1; 03888000
CPLEN := CPLEN+1; 03888100
END; 03889000
ITEM := NUMBERV; 03890000
GO TO XIT; 03891000
END; 03895000
03896000
IF IB_PTR = "?" THEN 03897000
BEGIN 03898000
ITEM:=QMARKV; 03899000
IB_PTR := IB_PTR+1; % Another pointer skip 03900000
GO TO XIT; 03901000
END; 03902000
03903000
% At this point the item found is not alphanumeric, 03904000
% numeric (including optional minus sign), or question 03905000
% mark. Pass it back for the command processor to work 03906000
% with. 03907000
03908000
SCAN IB_PTR FOR CPLEN:ILEN WHILE > " "; 03909000
REPLACE CPARM BY IB_PTR:IB_PTR FOR ILEN-CPLEN; 03910000
CPLEN := READLOCK(CPLEN, ILEN) - CPLEN; 03911000
XIT: 03916000
03917000
END; 03918000
03919000
%----------------------------------------------------------------- 03920000
PROCEDURE READ_USER(PROMPT); 03921000
VALUE PROMPT; 03922000
BOOLEAN PROMPT; 03923000
BEGIN 03924000
IBX := 0; % Index to zero 03925000
% IF ICLEN NEQ 0 THEN 03926000
% BEGIN 03927000
% MOVE IB := ICMD,(ICLEN); 03928000
% ILEN := ICLEN; 03929000
% ICLEN := 0; 03930000
% END 03931000
% ELSE 03932000
BEGIN % Not initial command 03933000
03934000
IF BLASTED THEN 03935000
BEGIN 03936000
M_ST " " M_EN; 03937000
M_ST "<INTERRUPTED>" M_EN; 03938000
M_ST " " M_EN; 03939000
IF TAKENUM_OPEN THEN 03940000
BEGIN 03941000
CLOSE(TAKENUM); 03942000
TAKENUM_OPEN:=FALSE; 03943000
END; 03944000
03945000
BLASTED := FALSE; 03946000
END; 03947000
03948000
IF TAKENUM_OPEN THEN 03949000
BEGIN % Read TAKE file 03950000
ILEN := REAL(READ(TAKENUM, 72, IB)); 03951000
IF BOOLEAN(ILEN) THEN 03952000
BEGIN % End of file 03953000
CLOSE(TAKENUM); 03954000
TAKENUM_OPEN:=FALSE; 03955000
% END 03956000
% ELSE 03957000
% IF < THEN 03958000
% BEGIN 03959000
% M_ST "Read error on TAKE file" M_EN; 03960000
% FCLOSE(TAKENUM,0,0); 03961000
% TAKENUM := 0; 03962000
END 03963000
ELSE 03963100
ILEN := 72; 03963200
END; 03964000
03965000
IF NOT TAKENUM_OPEN THEN 03966000
DO BEGIN 03967000
IF PROMPT THEN 03968000
BEGIN 03969000
REPLACE PBUF BY "KERMIT-A>"; 03970000
WRITE(CONUM[STOP], 9, PBUF); 03971000
END; 03972000
ILEN := REAL(READ(CINUM[TIMELIMIT 0], 80, IB)); 03973000
IF BOOLEAN(ILEN) THEN 03974000
BEGIN 03975000
REPLACE IB BY "EXIT"; 03976000
ILEN := 4; 03977000
END 03978000
ELSE 03978100
ILEN:=ILEN.[47:20]; 03978200
END 03979000
UNTIL ILEN > 0 OR NOT PROMPT; 03980000
END; 03981000
IB_PTR := IB; 03983000
REPLACE IB_PTR BY 03983100
IB_PTR FOR ILEN WITH LOWER_TO_UPPER, % Upshift as reqd 03983200
7"^"; % Mysterious stopper03983300
END; 03984000
03985000
% ----------------------------------------------------------- 03986000
03987000
WHILE NOT DONE DO 03988000
BEGIN 03989000
READ_USER(TRUE); 03990000
SCANIT(NULLV); 03991000
03992000
CASE ITEM OF 03994000
BEGIN 03995000
TAKEV: 03996000
BEGIN 03997000
SCANIT(QMARKV); 03998000
WHILE ITEM = QMARKV DO 03999000
BEGIN 04000000
HELP(TAKEV, 0, 0); 04001000
READ_USER(FALSE); 04002000
SCANIT(QMARKV); 04003000
IF BLASTED THEN 04004000
GO TO TAKE_EXIT; 04005000
END; 04006000
IF ITEM NEQ NULLV THEN % No reserved words allowed 04007000
BEGIN 04008000
M_ST "Cannot use reserved word for filespec." M_EN; 04009000
GO TO TAKE_EXIT; 04010000
END; 04011000
REPLACE CPARM[CPLEN] BY "."; 04012000
REPLACE TTL BY CPARM FOR CPLEN+1 WITH ASCIITOEBCDIC; 04012100
IF TAKENUM.OPEN THEN 04013000
BEGIN 04014000
CLOSE(TAKENUM); 04015000
TAKENUM_OPEN:=FALSE; 04016000
END; 04017000
TAKENUM(KIND=DISK, TITLE=TTL, 04018000
DEPENDENTSPECS=TRUE, INTMODE=ASCII); 04018100
IF NOT (TAKENUM_OPEN := TAKENUM.PRESENT) THEN 04019000
BEGIN 04020000
M_ST "take error" M_EN; 04021000
END; 04022000
TAKE_EXIT: 04023000
END; 04024000
04025000
SENDV: 04026000
04027000
BEGIN 04028000
SCANIT(QMARKV); % get local file name 04029000
WHILE ITEM = QMARKV DO 04030000
BEGIN 04031000
HELP(SENDV, 0, 0); 04032000
READ_USER(FALSE); 04033000
SCANIT(QMARKV); 04034000
IF BLASTED THEN 04035000
GO TO SEND_EXIT; 04036000
END; 04037000
WHILE CPLEN = 0 04038000
DO BEGIN 04039000
REPLACE PBUF BY "Burroughs file name?"; 04040000
WRITE(CONUM[STOP], 20, PBUF); 04041000
READ_USER(FALSE); 04042000
SCANIT(QMARKV); 04043000
IF BLASTED THEN 04044000
GO TO SEND_EXIT; 04045000
END; 04046000
REPLACE L_FNAME BY CPARM FOR CPLEN, 04047000
"."; 04048000
L_FNAME_LEN := CPLEN; 04049000
04050000
% IF NOT VALID_FILE(L_FNAME, L_FNAME_LEN, OUT) THEN 04051000
% BEGIN 04052000
% M_ST ("Kermit file security error - ", 04053000
% "see your account manager") M_EN; 04054000
% DNUM := 0; 04055000
% GO TO SEND_EXIT; 04056000
% END; 04057000
REPLACE TTL BY L_FNAME FOR L_FNAME_LEN+1 04057100
WITH ASCIITOEBCDIC; 04057200
DNUM(KIND=DISK, INTMODE=ASCII, 04058000
TITLE=TTL, NEWFILE=FALSE, 04058100
DEPENDENTSPECS=TRUE); 04058200
IF NOT (DNUM_OPEN := DNUM.PRESENT) THEN 04059000
BEGIN 04060000
M_ST "File open error" M_EN; 04061000
END 04062000
ELSE 04063000
BEGIN 04064000
SCANIT(QMARKV); 04065000
IF CPLEN NEQ 0 THEN 04066000
BEGIN 04067000
REPLACE R_FNAME BY CPARM FOR CPLEN, "."; 04068000
END; 04069000
R_FNAME_LEN := CPLEN; 04070000
04071000
% IF NOT OPEN_LINE THEN 04072000
% BEGIN 04073000
% M_ST "Line open failure" M_EN; 04074000
% END 04075000
% ELSE 04076000
BEGIN 04077000
M_ST 04078000
"Escape back to your local KERMIT ", 04079000
"and enter the RECEIVE command" 04080000
M_EN; 04081000
04082000
IF I_DELAY > 0 THEN 04083000
BEGIN 04084000
P_INT := I_DELAY; 04085000
WAIT((P_INT)); 04086000
END; 04087000
04088000
IF R_FNAME_LEN NEQ 0 THEN 04089000
XFROK := SENDSW(R_FNAME, 04090000
-R_FNAME_LEN) 04091000
ELSE 04092000
XFROK := SENDSW(L_FNAME, 04093000
-L_FNAME_LEN); 04094000
04095000
STATE := SBREAK; 04096000
% IF LDEV_CI = LDEV_LINE THEN 04097000
% SHUT_LINE; % Echo on, etc. 04098000
04099000
IF NOT XFROK THEN 04100000
BEGIN 04101000
M_ST "SEND failure" M_EN; 04102000
END 04103000
ELSE 04104000
BEGIN 04105000
M_ST "SEND completed" M_EN; 04106000
END; 04107000
END; 04108000
END; 04109000
SEND_EXIT: 04110000
04110100
L_FNAME_LEN := 0; 04110200
04110300
END; 04111000
04112000
RECEIVEV: 04113000
04114000
BEGIN 04115000
SCANIT(QMARKV); 04116000
WHILE ITEM = QMARKV DO 04117000
BEGIN 04118000
HELP(RECEIVEV, 0, 0); 04119000
READ_USER(FALSE); 04120000
SCANIT(QMARKV); 04121000
IF BLASTED THEN 04122000
GO TO RECEIVE_EXIT; 04123000
END; 04124000
WHILE CPLEN = 0 04125000
DO BEGIN 04126000
REPLACE PBUF BY "Burroughs file name?"; 04127000
WRITE(CONUM[STOP], 20, PBUF); 04128000
READ_USER(FALSE); 04129000
SCANIT(QMARKV); 04130000
IF BLASTED THEN 04131000
GO TO RECEIVE_EXIT; 04132000
END; 04133000
REPLACE L_FNAME BY CPARM FOR CPLEN, "."; 04134000
L_FNAME_LEN := CPLEN; 04135000
% IF VALID_FILE(L_FNAME, L_FNAME_LEN, IN) THEN 04136000
% % Its ok. No action necessary. 04137000
% ELSE 04138000
% BEGIN 04139000
% M_ST ("Kermit file security error - ", 04140000
% "see your account manager") M_EN; 04141000
% GO TO RECEIVE_EXIT; 04142000
% END; 04143000
% 04144000
REPLACE TTL BY L_FNAME FOR L_FNAME_LEN+1 04144800
WITH ASCIITOEBCDIC; 04144900
DNUM(KIND=PACK, FILENAME=TTL, NEWFILE=FALSE); 04145000
04146000
IF NOT DNUM.RESIDENT THEN % OK. Its not there already 04149000
ELSE 04150000
BEGIN 04151000
REPLACE PTEMP:PBUF BY 04152000
"File is already present. OK to remove? (Y/N)"; 04153000
PLEN:=OFFSET(PTEMP); 04154000
WRITE(CONUM[STOP], PLEN, PBUF); 04155000
READ_USER(FALSE); 04156000
SCANIT(ONV); 04157000
IF ITEM = YESV THEN 04158000
BEGIN 04159000
REMOVEFILE(TTL); 04160000
END 04161000
ELSE 04165000
BEGIN 04166000
M_ST "RECEIVE attempt abandoned" M_EN; 04167000
GO TO RECEIVE_EXIT; 04168000
END; 04169000
END; 04170000
04171000
04172000
% IF NOT OPEN_LINE THEN 04173000
% BEGIN 04174000
% M_ST "Line open error" M_EN; 04175000
% END 04176000
% ELSE 04177000
BEGIN 04178000
M_ST 04179000
"Escape back to your local KERMIT ", 04180000
"and enter the SEND command" 04181000
M_EN; 04182000
REPLACE DBUF BY " " FOR RCV_RECLEN; % Initial scrub 04182100
04183000
XFROK := RECSW(FALSE); 04184000
04185000
% IF LDEV_CI = LDEV_LINE THEN 04186000
% SHUT_LINE; % Echo on, etc. 04187000
04188000
IF NOT XFROK THEN 04189000
BEGIN 04190000
M_ST "RECEIVE error" M_EN; 04191000
END 04192000
ELSE 04193000
BEGIN 04194000
M_ST "RECEIVE complete" M_EN; 04195000
END; 04196000
END; 04197000
RECEIVE_EXIT: 04198000
04198100
L_FNAME_LEN := 0; 04198200
04198300
END; 04199000
04200000
SERVEV: 04201000
04202000
BEGIN 04203000
M_ST "SERVER mode is not yet implemented" M_EN; 04203100
GO TO SERVE_EXIT; 04203200
SCANIT(QMARKV); 04204000
IF ITEM = QMARKV THEN 04205000
BEGIN 04206000
HELP(SERVEV, 0, 0); 04207000
READ_USER(FALSE); 04208000
IF BLASTED THEN 04209000
GO TO SERVE_EXIT; 04210000
END; 04211000
% IF NOT OPEN_LINE THEN 04212000
% BEGIN 04213000
% M_ST "Line open failure" M_EN; 04214000
% END 04215000
% ELSE 04216000
BEGIN 04217000
M_ST 04218000
"Entering SERVER mode - ", 04219000
"escape back to your local KERMIT" 04220000
M_EN; 04221000
SERVER; 04222000
04223000
% IF LDEV_CI = LDEV_LINE THEN SHUT_LINE; 04224000
04225000
% DONE := NOT BLASTED; 04226000
END; 04227000
SERVE_EXIT: 04228000
END; 04229000
04230000
SETV: 04231000
04232000
BEGIN 04233000
SCANIT(DEBUGV); 04234000
IF ITEM = QMARKV THEN 04235000
BEGIN 04236000
HELP(SETV, 0, 0); 04237000
READ_USER(FALSE); 04238000
SCANIT(DEBUGV); 04239000
IF BLASTED THEN 04240000
GO TO SET_EXIT; 04241000
END; 04242000
IF NOT (DEBUGV <= ITEM AND ITEM <= SOHV) THEN 04243000
BEGIN 04244000
M_ST "set error" M_EN 04245000
END 04246000
ELSE 04247000
CASE ITEM OF 04248000
BEGIN 04249000
04250000
DEBUGV: % SET DEBUG 04251000
04252000
BEGIN 04253000
SCANIT(QMARKV); 04254000
WHILE ITEM = QMARKV DO 04255000
BEGIN 04256000
HELP(SETV, DEBUGV, 0); 04257000
READ_USER(FALSE); 04258000
SCANIT(QMARKV); 04259000
IF BLASTED THEN 04260000
GO TO SET_EXIT; 04261000
END; 04262000
IF ITEM = NUMBERV THEN 04263000
DEBUG_MODE:=CPVAL 04264000
ELSE 04265000
BEGIN 04266000
M_ST "set debug error" M_EN; 04267000
END; 04268000
END; 04269000
04270000
DELAYV: % SET DELAY 04271000
04272000
BEGIN 04273000
SCANIT(QMARKV); 04274000
WHILE ITEM = QMARKV DO 04275000
BEGIN 04276000
HELP(SETV, DELAYV, 0); 04277000
READ_USER(FALSE); 04278000
SCANIT(QMARKV); 04279000
IF BLASTED THEN 04280000
GO TO SET_EXIT; 04281000
END; 04282000
IF CPLEN = 0 THEN 04283000
BEGIN 04284000
I_DELAY := 0; 04285000
END 04286000
ELSE 04287000
BEGIN 04288000
IF ITEM = NUMBERV THEN 04289000
I_DELAY:=CPVAL 04290000
ELSE 04291000
BEGIN 04292000
M_ST "set delay error" M_EN; 04293000
END; 04294000
END; 04295000
END; 04296000
04297000
LINEV: % SET LINE 04298000
04299000
BEGIN 04300000
M_ST "SET LINE is not implemented" M_EN; 04300100
GO TO SET_EXIT; 04300200
% SCANIT(QMARKV); 04301000
% WHILE ITEM = QMARKV DO 04302000
% BEGIN 04303000
% HELP(SETV, LINEV, 0); 04304000
% READ_USER(FALSE); 04305000
% SCANIT(QMARKV); 04306000
% IF BLASTED THEN 04307000
% GO TO SET_EXIT; 04308000
% END; 04309000
% IF CPLEN = 0 THEN 04310000
% BEGIN 04311000
% LDEV_LINE := 0; 04312000
%% SHUT_LINE; 04313000
% END 04314000
% ELSE 04315000
% BEGIN 04316000
% IF ITEM NEQ NUMBERV THEN 04317000
% BEGIN 04318000
% M_ST "set line error" M_EN; 04319000
% END 04320000
% ELSE 04321000
% BEGIN 04322000
% LDEV_LINE:=CPVAL; 04323000
%% SHUT_LINE; 04324000
% END; 04325000
% END; 04326000
END; 04327000
04328000
SENDV_1: % SET SEND 04329000
04330000
BEGIN 04331000
SCANIT(PAUSEV); 04332000
WHILE ITEM = QMARKV DO 04333000
BEGIN 04334000
HELP(SETV, SENDV_1, 0); 04335000
READ_USER(FALSE); 04336000
SCANIT(PAUSEV); 04337000
IF BLASTED THEN 04338000
GO TO SET_EXIT; 04339000
END; 04340000
IF ITEM = PAUSEV THEN 04341000
BEGIN 04342000
SCANIT(QMARKV); 04343000
IF ITEM NEQ NUMBERV THEN 04344000
BEGIN 04345000
M_ST "send pause error" M_EN; 04346000
END 04347000
ELSE 04348000
PAUSE_CNT:=CPVAL; 04349000
END 04350000
04351000
ELSE 04352000
IF ITEM = BINARYV THEN 04353000
BEGIN 04354000
SCANIT(AUTOV); % POTENTIAL TROUBLE 04355000
IF (AUTOV <= ITEM AND ITEM <= OFFV) THEN 04356000
SND_BINARY:=ITEM-AUTOV 04357000
ELSE 04358000
BEGIN 04359000
M_ST "set send binary error" M_EN; 04360000
END; 04361000
END 04362000
ELSE 04363000
BEGIN 04364000
M_ST "set send error" M_EN; 04365000
END 04366000
END; 04367000
04368000
SPEEDV: % SET SPEED 04369000
04370000
BEGIN 04371000
M_ST "SET SPEED is not implemented" M_EN; 04371100
GO TO SET_EXIT; 04371200
% SCANIT(QMARKV); 04372000
% WHILE ITEM = QMARKV DO 04373000
% BEGIN 04374000
% HELP(SETV, SPEEDV, 0); 04375000
% READ_USER(FALSE); 04376000
% SCANIT(QMARKV); 04377000
% IF BLASTED THEN 04378000
% GO TO SET_EXIT; 04379000
% END; 04380000
% X := CPVAL; 04381000
% IF (X NEQ 30) AND (X NEQ 60) AND (X NEQ 120) AND 04382000
% (X NEQ 240) AND (X NEQ 480) AND (X NEQ 960) THEN04383000
% BEGIN 04384000
% M_ST 04385000
% 04386000
% "Invalid SPEED, use 30,60,120,240,480,960" 04387000
% 04388000
% M_EN; 04389000
% END 04390000
% ELSE 04391000
% TSPEED := X; 04392000
END; 04393000
04394000
HANDSHAKEV: % SET HANDSHAKE 04395000
04396000
BEGIN 04397000
M_ST "SET HANDSHAKE is not implemented" M_EN; 04397100
GO TO SET_EXIT; 04397200
% SCANIT(ONV); 04398000
% WHILE ITEM = QMARKV DO 04399000
% BEGIN 04400000
% HELP(SETV, HANDSHAKEV, 0); 04401000
% READ_USER(FALSE); 04402000
% SCANIT(ONV); 04403000
% IF BLASTED THEN 04404000
% GO TO SET_EXIT; 04405000
% END; 04406000
% IF (NONEV <= ITEM AND ITEM <= XON2V) THEN 04407000
% HNDSHK:=ITEM-NONEV 04408000
% ELSE 04409000
% BEGIN 04410000
% M_ST "set handshake error" M_EN; 04411000
% END; 04412000
END; 04413000
04414000
RECEIVEV_1: % SET RECEIVE 04415000
04416000
BEGIN 04417000
SCANIT(PAUSEV); 04418000
WHILE ITEM = QMARKV DO 04419000
BEGIN 04420000
HELP(SETV, RECEIVEV_1, 0); 04421000
READ_USER(FALSE); 04422000
SCANIT(PAUSEV); 04423000
IF BLASTED THEN 04424000
GO TO SET_EXIT; 04425000
END; 04426000
IF NOT (BINARYV <= ITEM AND ITEM <= EXPTABV) THEN 04427000
BEGIN 04428000
M_ST "set receive error" M_EN; 04429000
END 04430000
ELSE 04431000
CASE ITEM OF 04432000
BEGIN 04433000
04434000
BINARYV: % SET RECEIVE BINARY 04435000
04436000
BEGIN 04437000
SCANIT(ONV); 04438000
WHILE ITEM = QMARKV DO 04439000
BEGIN 04440000
HELP(SETV, RECEIVEV_1, BINARYV); 04441000
READ_USER(FALSE); 04442000
SCANIT(ONV); 04443000
IF BLASTED THEN 04444000
GO TO SET_EXIT; 04445000
END; 04446000
IF ITEM = ONV OR ITEM = OFFV THEN 04447000
RCV_BINARY:=(ITEM=ONV) 04448000
ELSE 04449000
BEGIN 04450000
M_ST "set receive binary error" M_EN; 04451000
END; 04452000
END; 04453000
04454000
DEVICEV: % SET RECEIVE DEVICE 04455000
04456000
BEGIN 04457000
M_ST "SET RECEIVE DEVICE " 04457100
"is not implemented" M_EN; 04457200
GO TO SET_EXIT; 04457300
SCANIT(QMARKV); 04458000
WHILE ITEM = QMARKV DO 04459000
BEGIN 04460000
HELP(SETV, RECEIVEV_1, DEVICEV); 04461000
READ_USER(FALSE); 04462000
SCANIT(QMARKV); 04463000
IF BLASTED THEN 04464000
GO TO SET_EXIT; 04465000
END; 04466000
IF CPLEN NEQ 0 THEN 04467000
BEGIN 04468000
REPLACE RCV_DEV BY CPARM FOR CPLEN, 04469000
CR; 04470000
END 04471000
ELSE 04472000
REPLACE RCV_DEV BY "DISL", CR; 04473000
END; 04474000
04475000
FCODEV: % SET RECEIVE FCODE 04476000
04477000
BEGIN 04478000
M_ST "SET RECEIVE FCODE " 04478100
"is not implemented" M_EN; 04478200
GO TO SET_EXIT; 04478300
SCANIT(QMARKV); 04479000
WHILE ITEM = QMARKV DO 04480000
BEGIN 04481000
HELP(SETV, RECEIVEV_1, FCODEV); 04482000
READ_USER(FALSE); 04483000
SCANIT(QMARKV); 04484000
IF BLASTED THEN 04485000
GO TO SET_EXIT; 04486000
END; 04487000
IF ITEM NEQ NUMBERV THEN 04488000
BEGIN 04489000
M_ST "set receive fcode error" M_EN; 04490000
END 04491000
ELSE 04492000
BEGIN 04493000
RCV_FCODE := CPVAL; 04494000
END; 04495000
END; 04496000
04497000
RECLENV: % SET RECEIVE RECLEN 04498000
04499000
BEGIN 04500000
SCANIT(QMARKV); 04501000
WHILE ITEM = QMARKV DO 04502000
BEGIN 04503000
HELP(SETV, RECEIVEV_1, RECLENV); 04504000
READ_USER(FALSE); 04505000
SCANIT(QMARKV); 04506000
IF BLASTED THEN 04507000
GO TO SET_EXIT; 04508000
END; 04509000
IF ITEM NEQ NUMBERV THEN 04510000
BEGIN 04511000
M_ST "set receive reclen error" M_EN; 04512000
END 04513000
ELSE 04514000
IF CPVAL NEQ 0 THEN 04515000
BEGIN 04516000
RCV_RECLEN := CPVAL; 04517000
END 04518000
ELSE 04519000
RCV_RECLEN := -254; 04520000
END; 04521000
04522000
BLOCKFV: % SET RECEIVE BLOCKF 04523000
04524000
BEGIN 04525000
SCANIT(QMARKV); 04526000
WHILE ITEM = QMARKV DO 04527000
BEGIN 04528000
HELP(SETV, RECEIVEV_1, BLOCKFV); 04529000
READ_USER(FALSE); 04530000
SCANIT(QMARKV); 04531000
IF BLASTED THEN 04532000
GO TO SET_EXIT; 04533000
END; 04534000
IF ITEM NEQ NUMBERV THEN 04535000
BEGIN 04536000
M_ST "set receive blockf error" M_EN; 04537000
END 04538000
ELSE 04539000
BEGIN 04540000
RCV_BLOCKF := CPVAL; 04541000
END; 04542000
END; 04543000
04544000
FIXRECV: % SET RECEIVE FIXREC 04545000
04546000
BEGIN 04547000
SCANIT(ONV); 04548000
WHILE ITEM = QMARKV DO 04549000
BEGIN 04550000
HELP(SETV, RECEIVEV_1, FIXRECV); 04551000
READ_USER(FALSE); 04552000
SCANIT(QMARKV); 04553000
IF BLASTED THEN 04554000
GO TO SET_EXIT; 04555000
END; 04556000
IF ITEM = OFFV THEN 04556100
BEGIN 04556200
M_ST "Variable-length records are not " 04556300
"implemented " M_EN; 04556400
GO TO SET_EXIT; 04556500
END; 04556600
IF ITEM = ONV OR ITEM = OFFV THEN 04557000
RCV_FIXREC:=(ITEM=ONV) 04558000
ELSE 04559000
BEGIN 04560000
M_ST "set receive fixrec error" M_EN; 04561000
END; 04562000
END; 04563000
04564000
MAXRECV: % SET RECEIVE MAXREC 04565000
04566000
BEGIN 04567000
SCANIT(QMARKV); 04568000
WHILE ITEM = QMARKV DO 04569000
BEGIN 04570000
HELP(SETV, RECEIVEV_1, MAXRECV); 04571000
READ_USER(FALSE); 04572000
SCANIT(QMARKV); 04573000
IF BLASTED THEN 04574000
GO TO SET_EXIT; 04575000
END; 04576000
RCV_MAXREC := CPVAL; 04577000
END; 04586000
04587000
MAXEXTV: % SET RECEIVE MAXEXT 04588000
04589000
BEGIN 04590000
SCANIT(QMARKV); 04591000
WHILE ITEM = QMARKV DO 04592000
BEGIN 04593000
HELP(SETV, RECEIVEV_1, MAXEXTV); 04594000
READ_USER(FALSE); 04595000
SCANIT(QMARKV); 04596000
IF BLASTED THEN 04597000
GO TO SET_EXIT; 04598000
END; 04599000
IF ITEM NEQ NUMBERV THEN 04600000
BEGIN 04601000
M_ST "set receive maxext error" M_EN; 04602000
END 04603000
ELSE 04604000
BEGIN 04605000
RCV_MAXEXT := CPVAL; 04606000
END 04607000
END; 04608000
04609000
SAVESPV: % SET RECEIVE SAVESP 04610000
04611000
BEGIN 04612000
SCANIT(ONV); 04613000
WHILE ITEM = QMARKV DO 04614000
BEGIN 04615000
HELP(SETV, RECEIVEV_1, SAVESPV); 04616000
READ_USER(FALSE); 04617000
SCANIT(ONV); 04618000
IF BLASTED THEN 04619000
GO TO SET_EXIT; 04620000
END; 04621000
IF ITEM = ONV OR ITEM = OFFV THEN 04622000
RCV_SAVESP:=(ITEM=ONV) 04623000
ELSE 04624000
BEGIN 04625000
M_ST "set receive savesp error" M_EN; 04626000
END; 04627000
END; 04628000
04629000
PROGV: % SET RECEIVE PROG 04630000
04631000
BEGIN 04632000
M_ST "SET RECEIVE PROG " 04632100
"is not implemented" M_EN; 04632200
GO TO SET_EXIT; 04632300
SCANIT(QMARKV); 04633000
WHILE ITEM = QMARKV DO 04634000
IF ITEM = QMARKV THEN 04635000
BEGIN 04636000
HELP(SETV, RECEIVEV_1, PROGV); 04637000
READ_USER(FALSE); 04638000
SCANIT(QMARKV); 04639000
IF BLASTED THEN 04640000
GO TO SET_EXIT; 04641000
END; 04642000
RCV_BINARY := TRUE; 04643000
RCV_FIXREC := TRUE; 04644000
RCV_FCODE := 1029; 04645000
RCV_RECLEN := 128; 04646000
RCV_BLOCKF := 1; 04647000
RCV_MAXEXT := 1; 04648000
END; 04649000
04650000
BIN128V: % SET RECEIVE BIN128 04651000
04652000
BEGIN 04653000
M_ST "SET RECEIVE BIN128 " 04653100
"is not implemented" M_EN; 04653200
GO TO SET_EXIT; 04653300
SCANIT(QMARKV); 04654000
WHILE ITEM = QMARKV DO 04655000
IF ITEM = QMARKV THEN 04656000
BEGIN 04657000
HELP(SETV, RECEIVEV_1, BIN128V); 04658000
READ_USER(FALSE); 04659000
SCANIT(QMARKV); 04660000
IF BLASTED THEN 04661000
GO TO SET_EXIT; 04662000
END; 04663000
RCV_BINARY := TRUE; 04664000
RCV_FIXREC := FALSE; 04665000
RCV_FCODE := 0; 04666000
RCV_RECLEN := 128; 04667000
RCV_BLOCKF := 0; 04668000
END; 04669000
04670000
TEXTV: % SET RECEIVE TEXT 04671000
04672000
BEGIN 04673000
M_ST "SET RECEIVE TEXT " 04673100
"is not implemented" M_EN; 04673200
GO TO SET_EXIT; 04673300
SCANIT(QMARKV); 04674000
WHILE ITEM = QMARKV DO 04675000
IF ITEM = QMARKV THEN 04676000
BEGIN 04677000
HELP(SETV, RECEIVEV_1, TEXTV); 04678000
READ_USER(FALSE); 04679000
SCANIT(QMARKV); 04680000
IF BLASTED THEN 04681000
GO TO SET_EXIT; 04682000
END; 04683000
RCV_BINARY := FALSE; 04684000
RCV_FIXREC := FALSE; 04685000
RCV_FCODE := 0; 04686000
RCV_RECLEN := -254; 04687000
RCV_BLOCKF := 0; 04688000
END; 04689000
04690000
TXT80V: % SET RECEIVE TXT80 04691000
04692000
BEGIN 04693000
SCANIT(QMARKV); 04694000
WHILE ITEM = QMARKV DO 04695000
BEGIN 04696000
HELP(SETV, RECEIVEV_1, TXT80V); 04697000
READ_USER(FALSE); 04698000
SCANIT(QMARKV); 04699000
IF BLASTED THEN 04700000
GO TO SET_EXIT; 04701000
END; 04702000
RCV_BINARY := FALSE; 04703000
RCV_FIXREC := TRUE; 04704000
RCV_FCODE := 192; 04705000
RCV_RECLEN := 80; 04706000
RCV_BLOCKF := 18; 04707000
END; 04708000
04709000
EXPTABV: % SET RECEIVE EXPTAB 04710000
04711000
BEGIN 04712000
SCANIT(ONV); 04713000
WHILE ITEM = QMARKV DO 04714000
BEGIN 04715000
HELP(SETV, RECEIVEV_1, EXPTABV); 04716000
READ_USER(FALSE); 04717000
SCANIT(ONV); 04718000
IF BLASTED THEN 04719000
GO TO SET_EXIT; 04720000
END; 04721000
IF ITEM = ONV OR ITEM = OFFV THEN 04722000
EXP_TABS:=(ITEM=ONV) 04723000
ELSE 04724000
BEGIN 04725000
M_ST "set receive exptab error" M_EN; 04726000
END; 04727000
END; 04728000
04729000
END; % SET RECEIVE cases 04730000
END; 04731000
04732000
LOGV: % SET LOG 04733000
04734000
BEGIN 04735000
SCANIT(QMARKV); 04736000
WHILE ITEM = QMARKV DO 04737000
BEGIN 04738000
HELP(SETV, LOGV, 0); 04739000
READ_USER(FALSE); 04740000
SCANIT(QMARKV); 04741000
IF BLASTED THEN 04742000
GO TO SET_EXIT; 04743000
END; 04744000
IF LOGNUM_OPEN THEN 04745000
BEGIN 04746000
LOCK(LOGNUM); 04747000
LOGNUM_OPEN:=FALSE; 04748000
END; 04749000
04750000
% SCANIT; Was done above 04751000
IF CPLEN = 0 THEN 04752000
BEGIN 04753000
% Take no action 04754000
END 04755000
ELSE 04756000
BEGIN 04757000
REPLACE LOGNAME BY CPARM FOR (LOGNAME_LEN:=CPLEN); 04758000
REPLACE TTL BY CPARM FOR CPLEN 04759000
WITH ASCIITOEBCDIC, 8"."; 04760000
LOGNUM(KIND=DISK, TITLE=TTL, 04761000
MAXRECSIZE=90, FRAMESIZE=8, 04762000
BLOCKSIZE=1080, 04763000
AREAS=10, AREASIZE=900, FLEXIBLE, 04764000
INTMODE=ASCII, EXTMODE=EBCDIC); 04765000
IF LOGNUM.RESIDENT THEN 04765100
BEGIN 04765200
REPLACE PTEMP:PBUF BY 04766000
"File is already present. " 04767000
"OK to remove? (Y/N) "; 04768000
WRITE(CONUM[STOP], OFFSET(PTEMP), PBUF); 04770000
READ_USER(FALSE); 04771000
SCANIT(ONV); 04772000
IF ITEM=YESV THEN 04773000
BEGIN 04774000
REMOVEFILE(TTL); 04775000
END 04780000
ELSE 04781000
BEGIN 04782000
M_ST "SET LOG attempt abandoned" M_EN; 04783000
GO TO SET_EXIT; 04784000
END; 04785000
END; 04786000
LOGNUM.NEWFILE:=TRUE; 04788000
IF LOGNUM.ATTERR THEN 04789000
BEGIN 04790000
M_ST "File open error" M_EN; 04791000
END 04792000
ELSE 04792100
BEGIN 04792200
LOGNUM.OPEN:=TRUE; 04792300
LOGNUM_OPEN:=TRUE; 04792400
END; 04792500
END; 04793000
END; 04794000
04795000
SOHV: % SET SOH 04796000
04797000
BEGIN 04798000
SCANIT(QMARKV); 04799000
WHILE ITEM = QMARKV DO 04800000
BEGIN 04801000
HELP(SETV, SOHV, 0); 04802000
READ_USER(FALSE); 04803000
SCANIT(QMARKV); 04804000
IF BLASTED THEN 04805000
GO TO SET_EXIT; 04806000
END; 04807000
IF ITEM = NUMBERV THEN 04808000
SOH:=CPVAL 04809000
ELSE 04810000
BEGIN 04811000
M_ST "set soh error" M_EN; 04812000
END; 04813000
END; 04814000
END; % SET cases 04815000
04816000
SET_EXIT: 04817000
END; 04818000
04819000
EXITV: 04820000
04821000
BEGIN 04822000
SCANIT(QMARKV); 04823000
WHILE ITEM = QMARKV DO 04824000
BEGIN 04825000
HELP(EXITV, 0, 0); 04826000
READ_USER(FALSE); 04827000
SCANIT(QMARKV); 04828000
IF BLASTED THEN 04829000
GO TO EXIT_EXIT; 04830000
END; 04831000
DONE := TRUE; 04832000
EXIT_EXIT: 04833000
END; 04834000
04835000
DIRV: 04836000
04837000
BEGIN 04838000
M_ST "DIR is not implemented" M_EN; GO TO DIR_EXIT; 04838100
SCANIT(QMARKV); 04839000
WHILE ITEM = QMARKV DO 04840000
BEGIN 04841000
HELP(DIRV, 0, 0); 04842000
READ_USER(FALSE); 04843000
SCANIT(QMARKV); 04844000
IF BLASTED THEN 04845000
GO TO DIR_EXIT; 04846000
END; 04847000
% BEGIN 04848000
% MOVE PBUF := "LISTF ", 2; 04849000
% MOVE * := CPARM, (CPLEN), 2; 04850000
% MOVE * := (", 2", CR); 04851000
% COMMAND(PBUF, ERROR, PARM); 04852000
% IF ERROR > 0 THEN 04853000
% BEGIN 04854000
% MOVE PBUF := "CIerror ", 2; 04855000
% PLEN := TOS-@PBUF; 04856000
% PLEN := PLEN+ASCII(ERROR, 10, PBUF(PLEN)); 04857000
% FWRITE(CONUM, PBUF_W, -PLEN, 0); 04858000
% END; 04859000
% END; 04860000
DIR_EXIT: 04861000
END; 04862000
04863000
SPACEV: 04864000
04865000
BEGIN 04866000
M_ST "SPACE is not implemented" M_EN; GO TO SPACE_EXIT; 04866100
SCANIT(QMARKV); 04867000
WHILE ITEM = QMARKV DO 04868000
BEGIN 04869000
HELP(SPACEV, 0, 0); 04870000
READ_USER(FALSE); 04871000
SCANIT(QMARKV); 04872000
IF BLASTED THEN 04873000
GO TO SPACE_EXIT; 04874000
END; 04875000
% BEGIN 04876000
% MOVE PBUF := "REPORT ", 2; 04877000
% MOVE * := CPARM, (CPLEN), 2; 04878000
% MOVE * := CR; 04879000
% COMMAND(PBUF, ERROR, PARM); 04880000
% IF ERROR > 0 THEN 04881000
% BEGIN 04882000
% MOVE PBUF := "CIerror ", 2; 04883000
% PLEN := TOS-@PBUF; 04884000
% PLEN := PLEN+ASCII(ERROR, 10, PBUF(PLEN)); 04885000
% FWRITE(CONUM, PBUF_W, -PLEN, 0); 04886000
% END 04887000
% ELSE 04888000
% BEGIN 04889000
% M_ST " " M_EN; % Cosmetic output 04890000
% END; 04891000
% END; 04892000
SPACE_EXIT: 04893000
END; 04894000
04895000
DELETEV: 04896000
04897000
BEGIN 04898000
M_ST "DELETE is not implemented" M_EN; 04898100
GO TO DELETE_EXIT; 04898200
SCANIT(QMARKV); 04899000
WHILE ITEM = QMARKV DO 04900000
BEGIN 04901000
HELP(DELETEV, 0, 0); 04902000
READ_USER(FALSE); 04903000
SCANIT(QMARKV); 04904000
IF BLASTED THEN 04905000
GO TO DELETE_EXIT; 04906000
END; 04907000
% IF VALID_FILE(CPARM, CPLEN, IN) THEN 04908000
% BEGIN 04909000
% MOVE PBUF := "PURGE ", 2; 04910000
% MOVE * := CPARM, (CPLEN), 2; 04911000
% MOVE * := CR; 04912000
% COMMAND(PBUF, ERROR, PARM); 04913000
% IF ERROR > 0 THEN 04914000
% BEGIN 04915000
% MOVE PBUF := "CIerror ", 2; 04916000
% PLEN := TOS-@PBUF; 04917000
% PLEN := PLEN+ASCII(ERROR, 10, PBUF(PLEN)); 04918000
% FWRITE(CONUM, PBUF_W, -PLEN, 0); 04919000
% END; 04920000
% END 04921000
% ELSE 04922000
% BEGIN 04923000
% M_ST "Filespec missing or invalid" M_EN; 04924000
% END; 04925000
DELETE_EXIT: 04926000
END; 04927000
04928000
TYPEV: 04929000
04930000
BEGIN 04931000
SCANIT(QMARKV); % get local file name 04932000
WHILE ITEM = QMARKV DO 04933000
BEGIN 04934000
HELP(TYPEV, 0, 0); 04935000
READ_USER(FALSE); 04936000
SCANIT(QMARKV); 04937000
IF BLASTED THEN 04938000
GO TO SEND_EXIT; 04939000
END; 04940000
WHILE CPLEN = 0 04941000
DO BEGIN 04942000
REPLACE PBUF BY "Burroughs file name?"; 04943000
WRITE(CONUM[STOP], 16, PBUF); 04944000
READ_USER(FALSE); 04945000
SCANIT(QMARKV); 04946000
IF BLASTED THEN 04947000
GO TO SEND_EXIT; 04948000
END; 04949000
REPLACE L_FNAME BY CPARM FOR CPLEN, 04950000
"."; 04951000
L_FNAME_LEN := CPLEN; 04952000
04953000
M_ST " " M_EN; 04954000
IF TYPESW THEN 04955000
BEGIN 04956000
M_ST " " M_EN; 04957000
M_ST "TYPE completed" M_EN; 04958000
END 04959000
ELSE 04960000
BEGIN 04961000
M_ST " " M_EN; 04962000
M_ST "TYPE failure" M_EN; 04963000
END; 04964000
04964100
L_FNAME_LEN := 0; 04964200
04964300
END; 04965000
04966000
STATUSV: 04967000
04968000
BEGIN 04969000
SCANIT(QMARKV); 04970000
WHILE ITEM = QMARKV DO 04971000
BEGIN 04972000
HELP(VERIFYV, 0, 0); 04973000
READ_USER(FALSE); 04974000
SCANIT(QMARKV); 04975000
IF BLASTED THEN 04976000
GO TO VERIFY_EXIT; 04977000
END; 04978000
VERIFY; 04979000
VERIFY_EXIT: 04980000
END; 04981000
04982000
ELSE: 04984000
IF ITEM = QMARKV THEN 04985000
HELP(NULLV, 0, 0) 04986000
04987000
ELSE 04988000
BEGIN 04989000
M_ST "command error" M_EN; 04990000
END; 04991000
END % CASE 04991100
END; 04992000
END; 04993000
04994000
% ***************************************************************** 04995000
04996000
$ PAGE 04997000
% * * * * * * * * * * * * * OUTER BLOCK * ** * * * * * * * * * * * * *04998000
IF NOT KINIT THEN 04999000
BEGIN 05000000
MYSELF.STATUS:=-1; 05001000
END 05002000
ELSE 05003000
BEGIN 05004000
CMDINT; % COMMAND main loop 05005000
% SHUT_LINE; 05006000
% IF HAVE_KTEMP THEN KILL_KTEMP; 05007000
IF LOGNUM_OPEN THEN 05008000
LOCK(LOGNUM); 05009000
END; 05010000
END. 05011000
