$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 "" 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