. . CONDITIONAL ASSEMBLY VARIABLES (MAINLY FRONT END COMPUTER DEPENDENT) . Gunnar . Set MDLFE = 1, DCPFE = 0 to get University of Wisconsin version . Gunnar MDLFE EQU 1 . front end MDL . Gunnar DCPFE EQU 0 . front end DCP . Gunnar . . qUestions, etc?? . . PAUL STEVENS . MADISON ACADEMIC COMPUTING CENTER . 1210 WEST DAYTON . UNIVERSITY OF WISCONSIN . MADISON, WISCONSIN . (608)262-9618 . . i hAve tRied tO kEep tHis pRogram fRee of sYstem dEpendencies. . a vEry dEfinite eXception eXists in sUbroutines "iNitialize" . aNd sHutdOwn. tHese sUbroutines sAve tHe cUrrent tErminal mOdes . vIa cAlls tO oUr lOcal fRont eNd pRocessor, eStablish nEw mOdes . fOr tHe fIle tRansfer iTself, aNd rEstore tHe mOdes . wHen fIle tRansfer iS cOmplete. (sEe cOmments iN tHe sUbroutines). . . i hOpe yOur lIbrary (eLement io rOutines) iS tHe sAme aS mIne. . wE sOmetimes fAll fAr bEhind tHe cUrrent sPerry lIbrary lEvel. . . . . . . iNterested pArties!!lEt mE kNow iF yOu aRe wIlling tO bE oN tHis lIst . John Watters . Seebeck Computer Center . PO Box 2511 . University Alabama 53486 . I sent copy of 1100 Kermit on 21 Oct 1983. . . . . . William H. Morrison . Federal Emergency Management Agency . Building 6 . Special Facility . P.O. Box 129 . Berryville, Virginia 22611 . I send 1100 Kermit on 26 October 1983. . He indicates he has a DCP-40 front end. . . . . . Allen Cole . University of Utah Computing Center . 3110 Merril . Engineering Building . Salt Lake City Utah . (801)581-8805 . Has developed an 1100 Kermit in higher level language. . Does not implement timeout (I think he said). . . . . . Ron Witt . Western Publishing Co. . 1220 Mound Avenue . Racine, Wisconsin 53404 . Sent him 1100 KERMIT on 15 March 1984. . . . . . Steve Rasmussen . Information Resource Coordinator . Wisconsin Dairy Herd Improvement Cooperative . Processing Center . 5301 Tokay Blvd. . Madison 53711 . 273-2820 . Sperry 1100/70 with DCP-40 Front End . Received Kermit from me on 2 April 84 . . . . . Dennis Sutherland . Rockwell International . Mail Station 124-211 . Cedar Rapids, Iowa . 52498 . (319)395-4613 . Received Kermit from Columbia... . Talked with me 3 July 84... . Had trouble reading tape. . . . . . Kenneth A. Williams . Systems Programming . Michigan Technological Univ . Houghton, Michigan . (906)487-2307 . Sent Kermit on 5 July 1984 . . . . . George Conner . (He finally gave up) . Sandia National Lababs . PO Box 5800 . Albuquerque, New Mexico 87185 . 505-844-1930 . 1100/80 with DCP 40 front end . GAndalf port contender between ttys and dcp40 . Talked to him 17 JUly 84. . He almost had things working at that time. . . . . . Captain Krebill . Chief, Systems Software . United States Military Academy . West Point, New York 10996 . (914)938-2138 . . . . . . . Jerry Veal . RCA . Indianapolis Indiana . (317)267-6350 . Soon to have Chi front end . Has KERMIT working in at least one direction. . 28 Aug 84 . . . . . Richard L. Mattis . Semiconductor Devices and circuits division . United States Department of Commerce . National Bureau of Standards . Building 225, Room B310 . Gaithersburg, Maryland 20899 . 17 September 1984 . . . . . Joe Wieclawek . Jet Propulsion Lab . IPC/141 . California Institute of Technology . 4800 Oak Grove Drive . Pasadena, California 91109 . (818)354-4321 . 26 sept 1984 . . . . . . . Department of the Army . Phillip Howell . 703-731-3531 . 703-731-3497 . 20 November 1984 . . . . . Gary Cooper . UCELL . 1930 Hiline . Dallas, Texas 75207 . (214)655-8797 . 20 November 1984 . Hadn't got things working yet . As of oct 85 things evidentally were working ok..see Jeff Langner . . . . Jeff Langner . Control Data UIS . (415)943-6828 . 1100 with DCP front end. Got it working OK . Worked with Gary Cooper (qv). . . . . John Kinsfather . Boulder, Colorado . (303)497-6404 . 27 November 1984 . Unable to get it working at first...kept . saying that 'HELP' was an illegal command and . that he should type in 'HELP' for a list of . legal commands. . Turned out that he had run the program through . a front end that upper-cased everything. So the . test for .gt. 'a' in the str$upcase routine no . longer worked. . . . John Dean . lEad sOftware aNalyst . Medtronic . 6970 Old Central Avenue . P.O. Box 1453 . Minneapolis, Minnesota 55440 . (612)574-3662 . Had trouble at first because 1100 communications . software refused to print control characters. . It could read control characters ok. . He added server mode to 1100 KERMIT and . will send TCF to me. . Eventually got it working but each packet . required about three seconds in 1100 receive . mode as shown in 1100 debug trace file. That . 3 seconds must have disappeared in SDFIO or . some such place. . . . . . Mike Darnell . (305)828-2603 . Walt Disney World . Orlando, Florida . Has 1100/63 with DCP-40 front end. . . . . . Grant Gilmour . Gulf Canada Resources Inc. . P.O. Box 130 . 401 - 9th Ave., S.W. . Calgary, Alberta . Canada T2P 2H7 . (403)233-4482 . Working on a "STANDARD" Sperry front end. ( DCP) . Mr. Gilmour sent the 1100 KERMIT changes . to implement server mode, wildcards, and improved SHOW command . Got KERMIT successfully working with DCP... . He said the "secret" was in using linefeed for handshake in place . of carriage return. . . . . . Sherwin Dubren . Quill Corporation . 100 South Schelter Road . Lincolnshire, Illinois 60069 . (312)634-4850 . Not working as of 13 Feb 1985. . WORKING WITH DCP FRONT END as of May 1985. . . . . . . . Chuck Rhode . SCHULTZ SAV-O . 2215 Union Avenue . Sheboygan, Wisconsin 53081 . (414)457-4433 . Talked to him on 18 February 1985. . He was going to order the tape from Columbia. . 1100/60 . . . . . Frank Rankin . National Climatic Data Center . Federal Building . Asheville, North Carolina . 28801 . (704)259-0373 . Got it working. I called up and . transfered a file. . DCP type front end, I believe. . . . . . Edith Creighan . Province of Prince Edward Island . Computer Services Division . P.O. Box 2000 . Charlottetown, P.E.I. . C1A 7N8 . Canada . (902)894-5533 . asked for manual 23 apr 85 . . John Ryberg . (813)577-1900 Extension 2206 . Sperry, Florida . TAlked oN 5 JUne 85...pRomised tO cAll bAck sOmeday aNd . tEll mE wHat cOnfiguration hE hAs. . . . Greg Moody . Internal Revenue Service . Washington, D.C. . (202)634-2476 . 1100/82 Running Kermit through GCS . Discovered two extra lines following END card that caused assembler to bomb. . Works. Problem with getting logged out when he doesn't want to be . logged out when using server mode and he aborts a transfer. . . . Gunnar Eklund . Gunnar . ENEA DATA . Gunnar . Box 232 . Gunnar . S-183 23 TABY . Gunnar . Sweden . Gunnar . HAs successfully used version 1.1, 1.4, and 2.2. . Gunnar . DCP front end, Telcon 3 and Telcon 4. . Gunnar . He submitted the code for conditional assembly of DCPFE stuff. . I (Paul Stevens) attempted to retrofit it into my version...hope it is close. . Gunnar's code is marked in column 72 as 'Gunnar'. . Here are his words: . I would like to show you the local changes I have made to KERMIT 2c2. . Gunnar . In fact, they are pure additions, mainly to make it work with our . Gunnar . DCP front end and network. They are perhaps of interest to other site. Gunnar . If you think so, perhaps you add them in a future release. . Gunnar . . . . Debra A. Herold . Automation Manager . A.D.S. Programming Support . A.D.S. Support Activities Division . Texas Department of Health . 1100 West 49th Street . Austin, Texas 78756 . (512)458-7111 . Have an 1100/73 with a DCP/40. Wanted a KERMIT that would . work with TIP so users wouldn't have to be allowed for DEMAND. . . . E. Trinkaus . Hochshulrechenzentrum der Philipps-Universitat . Marburg/Lahn . Hans-Meerwein-Strasse . 3350 MARBURG . West Germany . Wrote asking what to do about the illegal @@tty's that . appear in initialize and shutdown. . He has DCP-40 front end. . . . Frithjov Iverson . Trondheim University Computing Center . FI%NORUNIT.BITNET . eNd oF iNterested pArties lIsting *************************************** . . 28 dEcember 1983 - aDded sEnd aNd rEceive sTartoFpAcket cHaracters tO . tHe sHow cOmmand. . . . 20 dEcember 1983 . Installed tHe "sEt eRror" cOmmand sO tHat rAndom eRrors . cOuld bE fOrced. pUrpose iS fOr tEsting eRror rEcovery. . . . This is what the collection looks like: . @use r,sys$*rlib$ . @map,i ,k.kermit1100/exe . in k.kermit1100/asm . in r.table$/sys75r1 . in r.fdasc$/sys75r1 . in r.sdfo/sys75r1 . in r.sir$/sys75r1uw1 . in r.sor/sYs75r1 . in r.eru$ . in r.sdfi/sys75r1 . end . . Some documentation on how to use the program is assembled into the . program itself in the form of "HELP" strings. . You will find these in the first 1000 lines of the program. /. . 31 OCT 1983 . aDded bInary fIle tYpe cApability. . . . 9 nOvember 83 . cOrrection to prevent infinite loops when receiving blank image . . . 7 nOvember 83 . aDded . sEt cOntinuation <9 bIt cHaracter> . sEt lEngth . pUrpose iS tO aLlow lInes lOnger tHan wHat 1100 nOrmally aLlows. . . . 22 nOvember . aDded dIagnostic fOr nOn-pRogram fIles. . cHanged sEt fIle cOmmand tO sEt fIlename cOmmand. . . . 27 jAnuary 1984 . rEwrote sOurce iNput rOutines sO tHat iT iS nOw pOssibe . tO rEad "nOn-standard" sdf eLements. hAd tO . uSe sdfi rOutines aNd dO mY oWn cYcling aNd fIeldAta cOnversion, etc. . . . 27 jAuary 1984 . iF eLement hAs a vErsion nAme yOu mUst . mEntion iT eXplicitly oN tHe sEnd cOmmand. wE uSed tO . fInd aNy eLement wIth tHe pRoper nAme iF yOu oMitted . tHe vErsion nAme bUt wE gOt iNto tRouble wIth pEople . wHo hAd eLements wIth tHe sAme nAme, oNe wIth a vErsion . aNd oNe wIthout. . . 22 jUne 1984 . cHange hElp fOr sEt cOmmand tO bE mOre eXplicit . aBout tHe sEt fIle cOmmand . . 22jUne 1984 . mOdify mAp lAnguage fOr nEw vErsion oF rlIb . ************************** version 1.4 ************************************ . . 5 mArch 1984 . eXpand cHaracter lOad aNd sTore rEmote . tAbles tO aCcomodate mAxeLtlInsIz*4 cHaracters . . . 2 aPril 1984 . . 13 sEptember 1984 . cHanged tHe wAy cOntrol cHaracter qUoting iS hAndled. iT . tO sAy (iN tHe sEnd iNit pAcket tHat iT wAs gOing tO uSe . tHe rEceive qUote cHaracter and iT uSed tO sTore tHe cHaracter . tHe rEmote wAs gOing tO uSe (fRom tHe iNit aCk pAcket) iNto . tHe sEnd qUote cHaracter. . ************************************* vErsion 1.5 ************************* . . 10 jAnuary 1985 . fIxed uP cOntrol qUoting. iT dId nOt wOrk aT aLl fOr 8-bIt . cHaracters. . eIther tHe oLd pRotocol bOok wAs wRong, i dIdn't rEad iT, oR . i gRossly mIsunderstood wHat i rEad. i tHink iT iS rIght nOw. . ***************************************** vErsion 1.6 ****************** . . 14 jAnuary 1985 . rEarranged tHe wAy tHe pArameters sUch aS pAcket sIze aRe sEt uP. . iT uSed tO bE tHat (fOr eXample) pAcket sIze wAs sEt vIa . SET SEND PACKETSIZE 80 . bUt iF tHe rEmote sEnt a pAcket sIze iN tHe sEnd iNit pAcket tHen . wHat iT sEnt oVerrode wHatever tHe hUman bEing hAd sAid. . nOw wE rEmember wHat tHe hUman hAs sAid, rEad wHatever . tHe sEnd iNit pAcket sAys, aNd mAke sOme sOrt oF . dEcision aS tO wHat sHould bE dOne. iN tHe cAse oF . pAcket sIze, wE uSe tHe lEsser oF tHe tWo vAlues. . ******************************************* vErsion 1.7 ******************** . . THe cHanges tO pRoduce vErsion 1.8 wEre sUpplied bY GRant GIlmour . oF: . GUlf CAnada REsources INc. . P.O. BOx 130 . 401 - 9th AVenue, S.W. . CAlgary, ALberta . CAnada T2P 2H7 . (403)233-4482 . BAsically, tHey iNclude tHe eNtire sErver fAcility aNd tHe wIld . cArd cApability...nOt tO mEntion a fEw oRdinary eRror cOrrections. . I'M nOt tOo sUre hOw tHe tHing wOrked aT aLl wIth oNe oF tHe . eRrors hE fOund. . THe sElective sHow cOmmand iS aLso MR. GIlmour's. . . I cErtainly aCcept rEsponsibility fOr MR. GIlmour's cOntributions. HE . oBviously wOrked hArd tO kEep wIth tHe "sPirit" oF tHe pRogram. IT . wIll nOt bE dIfficult fOr tHe tRained eYe tO sPot tHe dIfferece . bEtween hIs cOde aNd mIne hOwever. . JANUARY, 1985 . SHOW COMMAND ENHANCED . DUMP OF THE KERMIT DEBUG IN DECIMAL OR OCTAL VIA THE SET DUMPFORMAT COMMAND . BASIC SERVER MODE ADDED . . WILDCARD SENDS AND GETS ALLOWED. SEE ALSO SET MAXWILD. . . EITHER A PERIOD OR A SLASH CAN BE USED FOR A DELIMITER WHEN SPECIFING . THE ELEMENT AND VERSION. . . . PROBLEMS . -------- . . WITH OUR STANDARD TTY HANDLER WE COULD NOT SET ANY OF THE MODES LIKE . PARITY, DUPLEX, ETC. THAT PAUL STEVENS COULD. SINCE WE WERE ONLY . INTERESTED CURRENTLY IN TRANSFERRING ASCII FILES THIS WAS OKAY. . . . GRANT GILMOUR GULF CANADA RESOURCES INC. . ************************************* VERSION 1.8 ************************* . rEvise dEfinitions oF tImeout nAmes. SEnd tImeout iS nOw hOw lOng . I wIll wAit aNd rEceive tImeout iS hOw lOng I tEll tHe oTher . fEllow tO wAit. . SEnd tImeout cAn bE cHanged bY nEgotiation oNly iF iT hAs . nOt bEen cHanged fRom iTs dEfault vAlue. PEople wEre hAving tRouble . sAying tHat 15 sEconds wEre nEcessary wHen tHeir lOcal KeRMITs . wEre oVerriding tHe 15 sEcond vAlue iN tHe SeND InIT pAcket. . 20 FEb 1985 . ******************************************** VeRSION 1.9 ***************** . . IMplemented 8 bIt qUoting. . IMplemented rEpeat cOunt pRefixing. . SEparated tHe cHannel wIdth dEfinition (SeT WiDTH) fRom tHe . fIle tYpe dEfinition (SeT TyPE BiNARY or ASCII). . . *************************************** VeRSION 2.0 *********************** . . IMplemented ReAL wIldcards sUch tHat "*" sTands fOr aNy (eVen nUll) . sTring aNd "%" sTands fOr aNy OnE (nOn-bLank) cHaracter. . A cOuple oF eRror cOrrections (aCtually tHere wEre sEveral!). . 1 MAy 1985 . . ************************ VeRSION 2.1 ************************* . . COrrected an error...vErsion 2.1 sent all images in an element . wHether oR nOt iT wAs dEleted. VEry bAd. VEry, vEry, vEry bAd. . . ******************************* vErsion 2.2 ********************** . . UPdated hElp sTrings . . . mIssed a fEw iN vErsion 2.2 . 17-jul-1985 fIxed qUite a fEw mOre hElp sTrings . 23-jUl-1985 cHanged tHe lIne tErmination sEquence wHen rEceiving tO . bE eIther .OR. . AT lEast oNe mIcro wOrd pRocessor . hAs bEen dIscovered wHich uSes . . 5-aUg-1985 fIxed rEceive sO tHat iT dOes nOt aCCept wIldcArd . cHaracters aS lEgal eLement/vErsion nAme cHaracters. To dO tHis I hAd . tO mOdify sErver sEnd tO nOt uSe pArticular sUbroutines tHat . sHould oNly hAve bEen uSed bY rEceivers. tHis aLso fIxed sOme pRoblems . wIth rEceiving fIles wIth zEro lEngth nAmes aNd sUbstitutes '$' fOr . iLlegal cHaracters iNstead oF dRopping tHem (tO cOnform tO macc mAnual). . **************************** version 2.3 ****************************** . aDded Gunnar Eklund's cOnditional aSsembly sTuff fOr DCP aNd nEtwork. . His comments . 1. Conditional assembly for DCP Telcon 4 (and perhaps also other Telcon . versions): . --@@ESC 0 and @@END ESC inserted to suppress excessive cr, lf, and . filler transmission. Some Kermits did otherwise not work well. . The speed was also increased by this change. . --An easy way to change defaults for START-OF-PACKET, RECEIVE DEFAULT . PACKET LENGTH and RECEIVE MAX PACKET LENGTH. . --@@TTY S,021 and @@TTY S,> to change solicitor to XON during packet . transmission. The old C-kermit liked this very much. . 2. Logout from server mode by a @@TERM. . 3. Repeat counts handled in file names (R and F packets, I think). This . was needed by the new C kermit. Handled by the new routine unprefixify. . 4. Conditional assembly: Delete mark set on successfully sent elements . if @XQT D option on. . 5. Delete mark partially received elements if R option is on . 6. Read file table index once more in routine SERVERSEND to make it possible . to send a file that was just received. . 7. SZ NPASSES moved. Should always be done at 'no find', else you can't send . ANYTHING any more. . Gunnar Eklund . ENEA DATA . Box 232 . S-183 23 TABY . Sweden . . FIxed a hArdcOded 800 cHaracter lImit iN tHe sdfio fct. . CHanged 800 mAx lIne sIze tO 2000. THere mUst bE sOme lImit! . . ******************************** version 2.4 **************** . COrrected tWo eRrors rEported bY Frithjoy Iversenm of Trondheim . University Computing Center, Norway. (FI%NORUNIT.BITNET) . AN eRror tHat cAused lOng ACKS. WHen rEceiving mUltiple cOpies oF tHe . sAme pAcket wE uSed tO iNclude a lIttle oF tHe dAta iTself iN tHe . sEcond aNd sUbsequent ACKs. . CHanged tHe 'ELEMENT HAS CYCLES' rEcognizer. IT uSed tO rEquire . bOth 'S' iN s3 oF tHe hEader cOntrol wOrd aNd '*SDFF*' iN tHe dAta . pArt oF tHe hEader. NOw tHe 'S' iN s3 iS sUfficient. . . CHanged tHe dEfault SEND PACKETLENGTH sO tHat tHe tRailing bLanks tHat . tHe 1100 lIkes tO sEnd wHen tHe lIne iS nOt a mUltiple oF 4 cHAracters . wIll nOt cAuse tHe pAcket tO eXceed 96 cHaracters. . *****************************************vErsion 2.5********************** axr$ tRue eQu 1 fAlse eQu 0 vAlcOl eQu 20 mAxeLtlInsIz eQu 500 . mAximum sIze (iN wOrds) oF a DELETEOPTION EQU DCPFE . Gunnar iF DCPFE . Gunnar DEFSOP EQU 02 . default start of packet ^B . Gunnar DEFRPAKLEN EQU 78 . default receive packet length . Gunnar MAXRPAKLEN EQU 80 . max receive packet length . Gunnar ESCMODE EQU 1 . 1: @@ESC o mode when sending . Gunnar . to avoid sending of not . Gunnar . needed characters. . Gunnar . 0: as earlier versions . Gunnar ELSE . Gunnar DEFSOP EQU 01 . default start of packet ^A . Gunnar DEFRPAKLEN EQU 94 . default receive packet length . Gunnar MAXRPAKLEN EQU 96 . max receive packet length . Gunnar ESCMODE EQU 0 . 1: @@ESC o mode when sending . Gunnar . to avoid sending of not . Gunnar . needed characters. . Gunnar . 0: as earlier versions . Gunnar ENDF . Gunnar . . Gunnar IF (DEFSOP<0)++(DEFSOP>=32) . Gunnar DISPLAY *'0 < DEFSOP < 040 NEEDED', DEFSOP . Gunnar ENDF . Gunnar DEFSOPHELP EQU $CB(DEFSOP,2):'=Control-':$CAS(DEFSOP+64) . Gunnar . lIne tO/fRom aN eLement p pRoc pUsh* nAme anx,u x10,p(1) uNlist i dO p(1) , s p(1,i),p(1)-i,x10 lIst eNd p pRoc pOp* nAme uNlist i dO p(1) , l p(1,i),-1+i,x10 lIst ax,u x10,p(1) eNd p pRoc sTrng* nAme +($sl(p(1,1))//4)*4,$sl(p(1,1)) uNlist $cas(p(1,1)) lIst end p pRoc vAriable* nAme q* pRoc vAl* nAme dO p(2,1)=bcdt , +dEf dO p(2,1)=dEcimalt , +p(2,4) dO p(2,1)=oCtalt , +p(2,4) dO p(2,1)=cHart , p(2,2) do p(2,1)=cNtrlt , p(2,2) eNd p pRoc cMd* nAme +p(1,1) sTrng p(1,2) eNd +p(2,1) . tYpe oF vAriable vAl . iNitial vAlue = dEfault sTrng p(1,1) . nAme of vAriable dO p(2,1)=dEcimalt , +p(2,2) . lOwlIm dO p(2,1)=oCtalt , +p(2,2) . lOwlIm dO p(2,1)=dEcimalt , +p(2,3) . hIghlIm dO p(2,1)=oCtalt , +p(2,3) . hIghlIm dO p(2,1)=dEcimalt , vAl p(2,4) . dEfault dO p(2,1)=oCtalt , vAl p(2,4) . dEfault do p(2,1)=cHart , +p(2,2) do p(2,1)=cNtrlt , +p(2,2) dEf. aLlowed sTrings...fIrst iS dEfault i dO p(3) , cMd i,p(3,i) do p(3)<>0 , +0 eNd $(1). ascii sTart. la a0,(+0102,(' KER11 ')) er apRint$ la a0,(+0102,('VER 2.5 ')) er apRint$ la a0,(+qUit,1+cMdbUf) er aread$ . dIscArd iNfOr er tsqrG$ spd a0 oR,u a0,010 lpd 0,a1 . sEt qUarter wOrd mOde fOr sUre lx,u x10,sTackeNd . iNitial sTack pOinter la,u a0,iNituSE er csf$ er opt$ . save processor options s a0,options ON DELETEOPTION . Gunnar and a0,(+1*/('Z'-'D')) . Gunnar jz a1,nextcommand . Gunnar l,u a0,deletewarn . Gunnar lmj x11,pripar . Gunnar j nextcommand . Gunnar deletewarn. . Gunnar strng 'WARNING: D option on - Kermit11 will delete all ':;. Gunnar 'files successfully sent!' . Gunnar +0 . Gunnar OFF DELETEOPTION . Gunnar nExtcOmmand. la,u a0,1+cMdbUf lmj x11,rEadcOmmand jn a0,eOf sa,h2 a0,cMdbUf . cHaracter cOunt la,u a0,cMdbUf la,u a1,0 . cHaracter iNdex la,u a2,tOken lmj x11,gEttOken jn a0,nExtcOmmand sa a1,cMdiNdex la,u a0,tOken lmj x11,sTr$uPcAse la,u a1,tOken la,u a2,cMdtBl lmj x11,cMdsRch jz a2,iLlcOmmand lx x11,0,a2 j 0,x11 . gO pRocess tHe lEgal cOmmand qUit. . LA,U A0,FREESTR+1 . ER ACSF$ . I dOn't lIke tO fRee tHe uSer's fIle uNless I kNow tHat . I aM tHe pErson wHo aSSigned iT. ELse tpf$ wIll gO aWay. . SOmeday tHis wIll bE mAde tO wOrk cOrrectly. LA A0,LOGOUTFLAG TNE,U A0,TRUE J LOGEMOUT LA,U A0,QUITMESSAG lmj x11,pRipAr er eXit$ LOGEMOUT. LA,U A0,LOGOUTMESS LMJ X11,PRIPAR ON DCPFE . Gunnar l a0,(logoutlen,logoutcmd) . Gunnar er aprtcn$ . Gunnar OFF DELETEOPTION . Gunnar . LA,U A0,LOGOUTADD . ER CSF$ ER EXIT$ logoutcmd. . Gunnar 'D,@@TERM ' . Gunnar logoutlen equ $-logoutcmd . Gunnar QUITMESSAG. STRNG 'Goodbye...1100 KERMIT signing off.' +0 LOGOUTMESS. STRNG 'Goodbye...1100 KERMIT logging off.' +0 FREESTR. STRNG '@FREE K$E$R$M$I$T$ . ' . cMdtBl. +help sTrng 'HELP' +sEt sTrng 'SET' +sHow sTrng 'SHOW' +sEnd sTrng 'SEND' +rEceive sTrng 'RECEIVE' +qUit sTrng 'QUIT' +qUit sTrng 'EXIT' +dUmp sTrng 'DUMP' +eRror sTrng 'ERROR' +SERVER STRNG 'SERVER' +0 iLlcOmmand. la,u a0,3+$ lmj x11,pripar j nExtcOmmand sTrng 'No such command exists.' sTrng 'tYpe "help" for a list of legal commands' +0 eXit. lmj x11,sHutdOwn er exit$ eof. J QUIT . nOtiMp. la,u a0,$+3 lmj x11,pRipAr j nExtcOmmand sTrng 'Command has not been implemented.' +0 /. hElp. la a1,cMdiNdex la,u a2,tOken la,u a0,cMdbUf lmj x11,gEttOken . sEE if cOmmand nAme gIven sa a1,cMdiNdex jp a0,hElpcMd la,u a0,hElppAra lmj x11,pRipAr j nExtcOmmand nsUchmSg. sTrng 'No such command exists.' hElppAra. sTrng 'Valid commands are:' strng ' HELP [topic]' sTrng ' EXIT (or QUIT)' sTrng ' RECEIVE [file name]' sTrng ' SET' sTrng ' SEND [file name]' STRNG ' SERVER' sTrng ' SHOW [parameter]' +0 hElpcMd. la,u a0,tOken lmj x11,sTr$uPcAse la,u a2,hElptBl la,u a1,tOken lmj x11,cMdsRch jz a2,hElpnsCh la a0,0,a2 j 0,a0 hElpnsCh. la,u a0,3+$ lmj x11,pRipAr j nExtcOmmand sTrng 'Legal HELP topics are:' sTrng ' HELP' sTrng ' SET' sTrng ' SEND' sTrng ' RECEIVE' STRNG ' SERVER' sTrng ' SHOW' sTrng ' EXIT' sTrng ' DUMP' sTrng ' QUIT' sTrng ' ERROR' +0 hElptBl. +hLpeRr sTRNG 'ERROR' +hLphLp sTrng 'HELP' +hLpsEt sTrng 'SET' +hLpxIt sTrng 'EXIT' +hLpdUmp sTrng 'DUMP' +hLpxIt sTrng 'QUIT' +hLprCv sTrng 'RECEIVE' +HLPSRV STRNG 'SERVER' +hLpsNd sTrng 'SEND' +hLpsHo sTrng 'SHOW' +0 hLpeRr. la,u a0,3+$ lmj x11,pRipAr j nExtcOmmand sTrng 'Print the error messages that have' sTrng 'collected during the most recent transfer.' +0 hLpdUmp. la,u a0,3+$ lmj x11,pRipAr j nExtcOmmand sTrng ' DUMP ,' sTrng 'Dumps lines from the debug file starting' sTrng 'at the th line.' sTrng 'If you omit one line will be dumped.' sTrng 'If you omit both and then one line' sTrng 'will be dumped at the previously dumped line+1.' +0 HLPSRV. LA,U A0,3+$ LMJ X11,PRIPAR J NEXTCOMMAND STRNG ' SERVER' STRNG 'Places KERMIT-11 in server mode. KERMIT-11 will' STRNG 'await all further instructions from the user' STRNG 'KERMIT on the other end of the connection.' STRNG 'After issueing the server command escape back to the' STRNG 'user KERMIT. Format for the GET command used on the' STRNG 'other KERMIT is: GET ELEMENT.VERSION. WILDCARDS ' STRNG '(I.E. GET C$.*DOC) May be used on the get command.' +0 hLphLp. la,u a0,3+$ lmj x11,pRipAr J HELPNSCH sTrng 'The HELP command prints all the legal command names' sTrng 'and their optional arguments' +0 hLpsEt. la,u a0,cMdbUf la,u a2,tOken la a1,cMdiNdex lmj x11,gEttOken . iS a pArameter sPecified? sa a1,cMdiNdex jp a0,hLpsEtpAr . jUmp iF yEs la,u a0,3+$ lmj x11,pRipAr j nExtcOmmand sTrng 'Use the SET command to modify parameters' sTrng 'for the file transfer process. The SHOW' sTrng 'command can be used to determine the' sTrng 'names and values of the various parameters.' sTrng 'Type "HELP SET parametername" for information' sTrng 'about a particular parameter.' sTrng 'The one SET command that you !MUST! use tells' sTrng 'KERMIT what file contains (or will contain) elements' sTrng 'that are transferred. Example:' sTrng ' SET FILE TROJAN*HORSE' +0 hLpsEtpAr. la,u a0,tOken lmj x11,sTr$uPcAse la,u a2,hLpsEttBl la,u a1,tOken lmj x11,cMdsRch jz a2,lStsEtpAr . tEll hIm wHat tHe lEgal nAmes aRe la a0,0,a2 j 0,a0 lStsEtpAr. lIst lEgal pArameters fOr tHe sEt cOmmand la,u a0,lStsEtpArl lmj x11,pRipAr j nExtcOmmand lStsEtpArl. sTrng 'The legal parameters that can be set are:' sTrng ' DELAY' STRNG ' MAXWILD' sTrng ' PARITY' sTrng ' RECEIVE' sTrng ' SEND' sTrng ' FILENAME' sTrng ' TYPE' sTrng ' LENGTH' sTrng ' CONTINUATION' sTrng ' ERROR' sTrng ' DUMPFORMAT' sTrng ' WIDTH' sTrng ' REPEAT' sTrng ' DEBUG' sTrng ' QUOTE8' sTrng ' ERROR' +0 hLpsEttBl. +hLpsEteRr sTrng 'ERROR' +hLpsEtdLy sTrng 'DELAY' +HLPSETWLD STRNG 'MAXWILD' +hLpsEtpRT sTrng 'PARITY' +hLpsEtrCv sTrng 'RECEIVE' +hLpsEtsNd sTrng 'SEND' +hLpsEtdMpfOr sTrng 'DUMPFORMAT' +hLpsEtfIl sTrng 'FILENAME' +hLpsEttYp sTrng 'TYPE' +hLpsEtlEngth sTrng 'LENGTH' +hLpsEtcOntin sTrng 'CONTINUATION' +hLpsEtwIdth sTrng 'WIDTH' +hLpsEtrEpeat sTrng 'REPEAT' +hLpsEtqUote8 sTrng 'QUOTE8' +hLpsEtdBg sTrng 'DEBUG' +0 hLpsEtdBg. la,u a0,3+$ lmj x11,pRipAr j nExtcOmmand sTrng ' SET DEBUG 1' sTrng 'Turns on code which writes each and every packet' sTrng '(sent or received)to the next 56 words' sTrng 'of file "kermitdebug". The file must have' sTrng 'been previously assigned.' sTrng ' SET DEBUG 0 turns debug mode off.' +0 hLpsEteRr. la,u a0,3+$ lmj x11,pRipAr j nExtcOmmand sTrng 'Set error ' sTrng 'Result is:' sTrng ' <-- ' sTrng ' <-- ' sTrng 'Checksum error caused every th time.' +0 hLpsEtlEngth. la,u a0,3+$ lmj x11,pRipAr j nExtcOmmand sTrng 'SET LENGTH ' sTrng 'Sets the maximum length of line that will be stored' sTrng 'in an 1100 element when the 1100 is receiving an' sTrng 'ASCII type file. Lines longer than this will cause a' sTrng 'new line to be started.' +0 hLpsEtcOntin. la,u a0,3+$ lmj x11,pRipAr j nExtcOmmand sTrng 'SET CONTINUATION ' sTrng 'Specifies the nine bit character that should be used to' sTrng 'indicate that a received line was longer than the maximum' sTrng 'and that it is continued on the following line.' sTrng 'A value of zero means that no continuation character' sTrng 'will be used. Since the bottom nine bits of this character' sTrng 'are used, a value of 01000 indicates that a zero character' sTrng 'should be used as the continuation character.' +0 hLpsEtdMpfOr. la,u a0,3+$ lmj x11,pRipAr j nExtcOmmand sTrng 'SET DUMPFORMAT ' sTrng 'Specifies the number base in which to print dumps' sTrng 'of packets. Legal values are ''DEC'' (decimal),' sTrng '''OCT'' (octal), and ''HEX'' (hexidecimal).' +0 hLpsEttYp. la,u a0,3+$ lmj x11,pRipAr j nExtcOmmand sTrng 'SET TYPE ' sTrng ' can be ASCII or BINARY.' sTrng 'Normal mode (and default) is ASCII which' sTrng 'is used for text files containing lines of' sTrng 'printable characters.' sTrng 'BINARY mode can be used for any file.' sTrng 'The result will be meaningless on the 1100 but' sTrng 'files sent to the 1100 in binary mode and' sTrng 'then sent back to the microcomputer in binary' sTrng 'mode should be unchanged.' sTrng 'BINARY files are not assumed to be divided' sTrng 'into separate lines.' sTrng 'In BINARY mode the packets themselves are saved' sTrng 'as lines...including the control info.' +0 hLpsEtfIl. la,u a0,3+$ lmj x11,pRipAr j nExtcOmmand sTrng 'SET FILE filename ' sTrng 'Tells the 1100 what file contains' sTrng 'elements when sending and where to' sTrng 'put elements when receiving. You can specify' sTrng 'a file name including a qualifier if necessary.' +0 hLpsEtwIdth. la,u a0,3+$ lmj x11,pRipAr j nExtcOmmand sTrng 'SET WIDTH 7 or SET WIDTH 8' sTrng 'Tells 1100 KERMIT how many bits of data are transmitted' sTrng 'in each character. If parity is used then the WIDTH' sTrng 'should be set to 7 and any characters 8 bits wide must' sTrng 'be transmitted using an 8 BIT QUOTE character. (See' sTrng 'SET QUOTE8)' IF DCPFE . Gunnar sTrng 'NOTE! Only SET WIDTH 7 works on this site, because . Gunnar sTrng 'the dumb front end computer!' . Gunnar ELSE . other front end . Gunnar sTrng 'At MACC setting WIDTH 8 causes the 1100 to do the' sTrng 'necessary @@tty commands to turn off parity and' sTrng 'set the data path to be 8 bits wide. ' sTrng 'This may not be possible at all sites.' ENDF . Gunnar +0 hLpsEtrEpeat. la,u a0,3+$ lmj x11,pRipAr j nExtcOmmand sTrng 'SET REPEAT ON or SET REPEAT OFF' sTrng 'Repeat prefixing is used to more efficiently' sTrng 'transmit a repeated character such as might' sTrng 'occur in tabular text (many blanks in succession)' sTrng 'or in binary data (many zeroes is succession).' sTrng 'Repeat is normally ON but may be disabled by' sTrng 'setting REPEAT OFF or by the the other computer' sTrng 'not agreeing to use repeat prefixing.' +0 hLpsEtqUote8. la,u a0,3+$ lmj x11,pRipAr j nExtcOmmand sTrng 'SET QUOTE8 ON or SET QUOTE8 OFF' sTrng 'In order to transfer 8 bit characters over' sTrng 'a 7 bit path it is necessary to "quote" any ' sTrng 'character with the 8th bit set. This is done' sTrng 'automatically if WIDTH is set to 7 and the other' sTrng 'computer agrees. If for some reason you want' sTrng 'this not to happen you can SET QUOTE8 OFF.' +0 hLpsEtdLy. la,u a0,3+$ lmj x11,pRipAr j nExtcOmmand sTrng ' SET DELAY [# seconds] Default is 5 seconds' sTrng 'Set the length of time the 1100 will delay before' sTrng 'beginning to send a file. This gives you time to' sTrng 'prepare your local computer to receive the file.' +0 HLPSETWLD. LA,U A0,3+$ LMJ X11,PRIPAR J NEXTCOMMAND STRNG ' SET MAXWILD [N] ' STRNG 'Set the maximum number of elements the Sperry 1100' sTrng 'KERMIT will send when wildcard characters' sTrng 'are specified.' +0 hLpsEtpRt. la,u a0,3+$ lmj x11,pRipAr j nExtcOmmand sTrng ' SET PARITY [parity] Default is SPC' sTrng 'Allows you to change the character parity on data' sTrng 'sent from the 1100. Possible values are:' sTrng ' OFF, EVEN, ODD, MARK, and SPACE.' sTrng '"OFF" means that you don''t care' IF DCPFE sTrng 'NOTE! (Only EVEN works on this site, because of' . Gunnar sTrng 'the dumb front end computer!' . Gunnar ENDF . Gunnar +0 hLpsEtrCv. la,u a0,cMdbUf la,u a2,tOken la a1,cMdiNdex lmj x11,gEttOken sa a1,cMdiNdex jp a0,hLpsEtrCvpAr la,u a0,3+$ lmj x11,pRipAr j nExtcOmmand sTrng 'Legal parameters for the SET RECEIVE command are:' sTrng ' ENDOFLINE [octal number] Default=015=CR' sTrng ' PACKETLENGTH [decimal number] Default=':; . Gunnar $CD(DEFRPAKLEN) . Gunnar sTrng ' QUOTE [octal number] Default is 043=#' sTrng ' STARTOFPACKET [octal number] Default=':;. Gunnar DEFSOPHELP . Gunnar sTrng ' TIMEOUT [# seconds] Default=10' sTrng ' PADDING [decimal number] Default=0' sTrng ' PADCHAR [octal number] Default=0' sTrng 'More information is available via: (for example)' sTrng ' HELP SET RECEIVE ENDOFLINE' +0 hLpsEtrCvpAr. la,u a0,tOken lmj x11,sTr$uPcAse la,u a2,hLpsEtrCvtBl la,u a1,tOken lmj x11,cMdsRch jz a2,lStsEtrCvpAr la a0,0,a2 j 0,a0 lStsEtrCvpAr. .lIst lEgal sEt rEceive pArameters la,u a0,3+$ lmj x11,pRipAr j nExtcOmmand sTrng 'The legal receive paramters that you can set are:' sTrng ' PACKETLENGTH' sTrng ' PADDING' sTrng ' PADCHAR' sTrng ' TIMEOUT' sTrng ' QUOTE' sTrng ' ENDOFLINE' sTrng ' STARTOFPACKET' +0 hLpsEtrCvtBl. +hLpsEtrCveol sTrng 'ENDOFLINE' +hLpsEtrCvpl sTrng 'PACKETLENGTH' +hLpsEtrCvqUo sTrng 'QUOTE' +hLpsEtrCvsop sTrng 'STARTOFPACKET' +hLpsEtrCvtIm sTrng 'TIMEOUT' +hLpsEtrCvpD sTrng 'PADDING' +hLpsEtrCvpc sTrng 'PADCHAR' +0 hLpsEtrCvpD. la,u a0,3+$ lmj x11,pRipAr j nExtcOmmand sTrng 'The number of padding characters the 1100 needs' sTrng 'between packets when receiving. The number' sTrng 'is normally zero.' +0 hLpsEtrCvpc. la,u a0,3+$ lmj x11,pRipAr j nExtcOmmand sTrng 'The octal number of the character to be used' sTrng 'as padding between packets received by the' sTrng '1100. Normally this is irrelevant since PADDING (the' sTrng 'number of pad characters) is zero.' +0 hLpsEtrCveol. la,u a0,3+$ lmj x11,pRipAr j nExtcOmmand sTrng 'Tells the 1100 "hardware" what character will be' sTrng 'at the end of each line. The 1100 program will not' sTrng 'be informed that any data has arrived until this' sTrng 'character appears in the input line.' sTrng 'Legal values are 01 through 037.' +0 hLpsEtrCvpl. la,u a0,3+$ lmj x11,pRipAr j nExtcOmmand sTrng 'Tells the 1100 the size of the biggest packet' sTrng 'it is expected to receive. Legal values are ' sTrng '10 through 96. Default is 94.' +0 hLpsEtrCvqUo. la,u a0,3+$ lmj x11,pRipAr j nExtcOmmand sTrng 'Tells the 1100 what character will be used for quoting' sTrng 'control characters. Legal values are 041 through 0176.' sTrng 'There is normally no reason not to use the default.' sTrng 'Since the quote character itself becomes a "control"' sTrng 'character, it is best if the quote character is' sTrng 'not a character that appears commonly in the text of' sTrng 'the file to be transferred.' +0 hLpsEtrCvsop. la,u a0,3+$ lmj x11,pRipAr j nExtcommand sTrng 'Tells the 1100 what character it should look' sTrng 'for as indicating' sTrng 'the first character of a valid packet.' sTrng 'Legal values are 01 through 037.' +0 hLpsEtrCvtIm. la,u a0,3+$ lmj x11,pRipAr j nExtcOmmand sTrng 'During initial file transfer negotiations the' sTrng '1100 KERMIT (KER11>) will ask your local KERMIT' sTrng 'to wait this many seconds before assuming that ' sTrng 'something has been lost. Normally (very close to' sTrng 'always) the 1100 KERMIT alone is concerned with' sTrng 'timeouts and this parameter is therefore ignored.' +0 hLpsEtsNd. la,u a0,cMdbUf la,u a2,tOken la a1,cMdiNdex lmj x11,gEttOken sa a1,cMdiNdex jp a0,hLpsEtsNdpAr la,u a0,3+$ lmj x11,pRipAr j nExtcOmmand sTrng 'Legal parameters for the SET SEND command are:' sTrng ' ENDOFLINE [octal number] Default=015=CR' sTrng ' PACKETLENGTH [decimal number] Default=94' sTrng ' PADDING [decimal number] Default=0' sTrng ' PADCHAR [octal number] Default=0' sTrng ' QUOTE [octal number] Default=043=#' sTrng ' STARTOFPACKET [octal number] Default=':; . Gunnar DEFSOPHELP . Gunnar sTrng ' TIMEOUT [# seconds] Default=10' sTrng 'More information is available via: (for example)' strng ' HELP SET SEND ENDOFLINE' +0 hLpsEtsNdpAr. la,u a0,tOken lmj x11,str$uPcAse la,u a2,hLpsEtsNdtBl la,u a1,tOken lmj x11,cMdsRch jz a2,lStsEtsNdpAr la a0,0,a2 j 0,a0 lStsEtsNdpAr. .lIst lEgal sEnd pArameters la,u a0,3+$ lmj x11,pRipAr j nExtcOmmand sTrng 'The legal send parameters that you can set are:' sTrng ' ENDOFLINE' sTrng ' PACKETLENGTH' sTrng ' PADDING' sTrng ' PADCHAR' sTRng ' QUOTE' sTrng ' STARTOFPACKET' sTrng ' TIMEOUT' +0 hLpsEtsNdtBl. +hLpsEtsNdeol sTrng 'ENDOFLINE' +hLpsEtsNdpl sTrng 'PACKETLENGTH' +hLpsEtsNdpAd sTrng 'PADCHAR' +hLpsEtsNdpnM sTrng 'PADDING' +hLpsEtsNdqUo sTrng 'QUOTE' +hLpsEtsNdsoh sTrng 'STARTOFPACKET' +hLpsEtsNdtIm sTrng 'TIMEOUT' +0 hLpsEtsNdeol. la,u a0,3+$ lmj x11,pRipAr j nExtcOmmand sTrng 'Tells the 1100 what character should be appended to' sTrng 'the end of each packet it sends. Many micro-computers' sTrng 'are able to examine each character as it is received' sTrng 'and do not need any special character to indicate' sTrng 'that a line is complete. Others may require that' sTrng 'each line be terminated with (for example) a' sTrng 'carriage return. Carriage return (015) is default.' +0 hLpsEtsNdpl. la,u a0,3+$ lmj x11,pRipAr j nExtcOmmand sTrng 'The maximum packet size the 1100 should send.' sTrng 'Legal values are 10 through 96. Default is 94.' +0 hLpsEtsNdpAd. la,u a0,3+$ lmj x11,pRipAr j nExtcOmmand sTrng 'What padding character to use to fill some time between' sTrng 'lines. Legal values are 01 through 037. No case has' sTrng 'yet been found where any padding character is needed.' +0 hLpsEtsNdpnM. la,u a0,3+$ lmj x11,pRipAr j nExtcOmmand sTrng 'The number of pad characters needed to fill time' sTrng 'between lines. Default is 0 and no case yet found' sTrng 'requires more.' +0 hLpsEtsNdqUo. la,u a0,3+$ lmj x11,pRipAr j nExtcOmmand sTrng 'The printable character (041 through 0176, default 043)' sTrng 'that should be used to quote control characters' sTrng 'sent from the 1100. Since the quote character must' sTrng 'itself be quoted it should not be a character that' sTrng 'appears too often in the file being transferred.' sTrng 'The default (#) should be OK except in very rare cases.' +0 hLpsEtsNdsoh. la,u a0,3+$ lmj x11,pRipAr j nExtcOmmand sTrng 'Tells what character the 1100 should put at the front' sTrng 'of each packet to indicate the beginning of valid data.' sTrng 'It is absolutely necessary that both computers agree' sTrng 'on what character will be used since otherwise the' sTrng 'the receiving computer will never see any valid data.' +0 hLpsETsNdtIm. la,u a0,3+$ lmj x11,pRipAr j nExtcOmmand sTrng 'The maximum number of seconds the 1100 should wait for' sTrng 'a packet or a reply to a packet. After this' sTrng 'amount of time KER11> will assume that something' sTrng 'has been lost and will repeat the latest' sTrng 'operation.' sTrng 'Legal values are 01 through 99. The default of 10' sTrng 'seconds should be adequate except at very low' sTrng 'baud rates.' sTrng 'The default value can be overridden during' sTrng 'initial negotiations with your local computer.' sTrng 'Any value except the default value is firm' sTrng 'and non-negotiable.' +0 hLpxIt. la,u a0,3+$ lmj x11,pRipAr j nExtcOmmand sTrng 'EXIT and QUIT cause this program to stop' +0 hLprCv. la,u a0,3+$ lmj x11,pRipAr j nExtcOmmand sTrng 'RECEIVE causes the 1100 to begin receiving an' sTrng 'element into the file specified on the' sTrng 'most recent SET FILE command. The name of the' sTrng 'element will be specified in the file header' sTrng 'sent by your micro ahead of the data and will' sTrng 'be the same as the name of the file on your' sTrng 'micro except that illegal characters will' sTrng 'be changed to dollar signs.' +0 hLpsNd. la,u a0,3+$ lmj x11,pRipAr j nExtcOmmand sTrng ' SEND elementname[/version]' sTrng 'SEND causes the 1100 to begin sending an element from' STRNG 'the default file. Wildcards may be used as part of' STRNG 'the ELEMENT/VERSION specification (I.E. SEND */*).' sTrng 'The character * can stand for any number' sTrng 'of characters (including zero) and the ' sTrng 'character % can stand for any single character.' STRNG 'A file must have been set via the SET FILE command' STRNG 'before the send is allowed.' +0 hLpsHo. la,u a0,3+$ lmj x11,pRipAr j nExtcOmmand sTrng 'Use the SHOW command to examine the current values' sTrng 'of file transfer parameters. You can change' sTrng 'these values by using the SET command' sTrng 'You can examine a subset of these values:' sTrng ' SHOW GLOBAL display global values' sTrng ' SHOW RECEIVE display file receive values' sTrng ' SHOW SEND display file send values' +0 /. sEt. la,u a0,cMdbUf la,u a2,tOken la a1,cMdiNdex lmj x11,gEttOken sa a1,cMdiNdex jn a0,lStsEtpar la,u a0,tOken lmj x11,sTr$uPcAse la,u a1,tOken la,u a2,sEtlIst lmj x11,cMdsRch jz a2,lStsEtpar la a0,0,a2 j 0,a0 sEtlIst. +sEteRr sTrng 'ERROR' +sEtdLy sTrng 'DELAY' +SETWLD STRNG 'MAXWILD' +sEtpRt sTrng 'PARITY' +sEtdBg sTrng 'DEBUG' +sEtrCv sTrng 'RECEIVE' +sEtsNd sTrng 'SEND' +sEtfIl sTrng 'FILENAME' +sEttYp sTrng 'TYPE' +sEtcOntinue sTrng 'CONTINUATION' +sEtlEngth sTrng 'LENGTH' +SETDUMPF STRNG 'DUMPFORMAT' +sEtwIdth sTrng 'WIDTH' +sEtrEpeat sTrng 'REPEAT' +sEtqUote8 sTrng 'QUOTE8' +0 sEteRr. la a0,eRrpRob+1 sa a0,sEed+1 la,u a0,eRrpRob j sEtdEc sEtwIdth. la,u a0,wIdth j sEtdEc sEtrEpeat. la,u a0,cMdbUf la,u a2,tOken la a1,cMdiNdex lmj x11,gEttOken sa a1,cMdiNdex jp a0,sEtrEpeata la,u a0,rEpeat j sEtbcddEf sEtrEpeata. la,u a0,rEpeat j sEtbcd sEtqUote8. la,u a0,cMdbUf la,u a2,tOken la a1,cMdiNdex lmj x11,gEttOken sa a1,cMdiNdex jp a0,sEtqUote8a la,u a0,qUote8 j sEtbcddEf sEtqUote8a. la,u a0,qUote8 j sEtbcd sEtlEngth. la,u a0,lEngth j sEtdEc sEtcOntinue. la,u a0,cOntinue j sEtoCt sEttYp. la,u a0,cMdbUf la,u a2,tOken la a1,cMdiNdex lmj x11,gEttOken sa a1,cMdiNdex jp a0,sEttYpa la,u a0,tYpe j sEtbcddEf sEttYpa. la,u a0,tYpe j sEtbcd sEtfIl. la,u a0,cMdbUf la,u a2,tOken la a1,cMdiNdex lmj x11,gEttOken sa a1,cMdiNdex jn a0,sEtfilea . LA,U A0,FREESTR+1 . FREE THE OLD KERMIT FILE . ER ACSF$ . I dOn't lIke tO fRee tHe oLd fIle...iT wOuld bE aLl rIght . iF wE kNew tHat iT wAs nOt aSsigned iNitially. SOme dAy . wE cAn fIx tHis uP bUt uNtil tHen lEt uS nOt fRee TPF$. sz,h2 fIlenAme la,u a0,fIlenAme la,u a1,tOken lmj x11,cOncat lmj x11,dOuSe j nExtcOmmand sEtfIlea. la,u a0,3+$ lmj x11,pRipAr j nExtcOmmand sTrng 'There is no default file. You must specify' sTrng 'a file name on the SET FILE command.' +0 dUmp. tz dfok j 5+$ la,u a0,dUmpfIlaSg er csf$ lxm,u a0,1 sa a0,dfok tn dfok j dUmpfIlok sz dfok la,u a0,3+$ lmj x11,pRipAr j nExtcOmmand sTrng 'No debug file is assigned.' +0 dUmpfIlok. la,u a1,1 sa a1,dUmpnUm la a1,cMdiNdex la,u a0,cMdbUf la,u a2,tOken lmj x11,gEttOken sa a1,cMdiNdex jn a0,dUmp1 la,u a0,tOken la,u a1,10 lmj x11,cVtascbIn j nExtcOmmand sa a0,dUmplIne la a1,cMdiNdex la,u a2,tOken la,u a0,cMdbUf lmj x11,gEttOken jn a0,dUmp1 la,u a0,tOken la,u a1,10 lmj x11,cVtascbIn j nExtcOmmand sa a0,dUmpnUm dump1. la a0,dUmpnUm ana,u a0,1 jn a0,nExtcOmmand sa a0,dUmpnUm la a0,dUmplIne au,u a0,1 sa a1,dUmplIne msi,u a0,2 . 2 sectors per line sa a0,5+dUmpKt la,u a0,dUmpKt er iow$ tz,s1 3,a0 j dUmpeRr la,h2 a0,55+dEbugbUff lmj x11,tImetOasc la,u a0,pRlIne la,u a1,qUoteri tz 54+dEbugbUff la,u a1,qUotero sz,h2 0,a0 lmj x11,cOncat la,u a1,asctIm lmj x11,cOncat la,u a1,10 lmj x11,tAb la,u a3,4 la,q2 a4,dEbugbUff+1 ana,u a4,036 tz 54+dEbugbUff j 5+$ la,q2 a4,dEbugbUff ana,u a4,040 la,u a3,0 aa,u a4,2 tg,u a4,120 la,u a4,120 lr r3,a4 . # bYtes tO dUmp lr,u r1,17 . # sPaces lEft oN lIne dUmp2. jgd r3,2+$ j dUmp4 jgd r1,dUmp3 la,u a0,pRlIne lmj x11,pRintsTring sz,h2 0,a0 la,u a1,10 lmj x11,tAb lr,u r1,16 dUmp3. la,u a1,dEbugbUff ex lOads,a3 aa,u a3,1 la,u a1,3 PUSH A0 LA A0,DUMPFMT+1 AA,U A0,2 LA A0,0,A0 LA,U A2,8 TNE A0,('DEC ') LA,U A2,10 tne a0,('HEX ') la,u a2,16 tne a0,('HEX ') la,u a1,2 POP A0 lmj x11,bInasc la,u a0,pRlIne la,u a1,bInascrSlt lmj x11,cOncat la,u a1,qUotersPace lmj x11,cOncat j dUmp2 dump4. la,u a0,pRlIne lmj x11,pRintsTring j dUmp1 dUmpeRr. la,u a0,3+$ lmj x11,pRipAr j nExtcOmmand sTrng 'i/o eRror rEading dEbug fIle' +0 qUotersPace. sTrng ' ' qUoteri sTrng 'I ' qUotero sTrng 'O ' . eRror. pRint cOllected eRror mEssages lmj x11,eRrpRnt j nExtcOmmand tImetOasc. a0=# sEconds sInce mIdnIght . 6 dIgit ascii sTring aVailable aT asctIm pUsh x11,a0,a1,a2,r1 dsl a0,36 di,u a0,60 pUsh a1 dsl a0,36 di,u a0,60 pUsh a1 pUsh a0 lr,u r1,2 sz,h2 asctIm tImetOascl. pOp a0 la,u a1,2 la,u a2,10 lmj x11,bInasc la,u a0,asctIm la,u a1,bInascrSlt lmj x11,cOncat jgd r1,tImetOascl pOp r1,a2,a1,a0,x11 j 0,x11 sEtdBg. sz dEbUgiopKt+5 la,u a0,dEbUg j sEtdEc sEtdLy. la,u a0,cMdbUf la,u a2,tOken la a1,cMdiNdex lmj x11,gEttOken sa a1,cMdiNdex jp a0,sEtdLya sEtdLyeR. la,u a0,3+$ sEtdLyeRr. lmj x11,pRipAr j nExtcOmmand sTrng 'You must supply an integer number of seconds' sTrng 'bEtween 1 and 99.' +0 sEtdLya. la,u a0,tOken la,u a1,10 lmj x11,cVtascbIn j sEtdLyeRr tg,u a0,1 tg,u a0,100 j sEtdLyeR sa a0,dElay+1 j nExtcOmmand SETWLD. LA,U A0,CMDBUF LA,U A2,TOKEN LA A1,CMDINDEX LMJ X11,GETTOKEN SA A1,CMDINDEX JP A0,SETWLDA SETWLDER. LA,U A0,3+$ SETWLDERR. LMJ X11,PRIPAR J NEXTCOMMAND STRNG 'You must supply an integer number of elements' STRNG 'between 1 and 99.' +0 SETWLDA. LA,U A0,TOKEN LA,U A1,10 LMJ X11,CVTASCBIN J SETWLDERR TG,U A0,1 TG,U A0,100 J SETWLDER SA A0,MAXWILD+1 J NEXTCOMMAND sEtpRt. la,u a0,cMdbUf la,u a2,tOken la a1,cMdiNdex lmj x11,gEttOken sa a1,cMdiNdex jp a0,sEtpRta la,u a0,pArity j sEtbcddEf sEtpRta. la,u a0,pArity j sEtbcd SETDUMPF. LA,U A0,CMDBUF LA,U A2,TOKEN LA A1,CMDINDEX LMJ X11,GETTOKEN SA A1,CMDINDEX JP A0,SETDUMPFA LA,U A0,DUMPFMT J SETBCDDEF SETDUMPFA. LA,U A0,DUMPFMT J SETBCD sEtbcddEf. sEt bcd vAriable (a0) tO iTs dEfault vAlue. la,h1 a1,2,a0 aa,u a1,3 ssl a1,2 aa,u a1,3,a0 sa a1,1,a0 pUsh a0 la,u a0,dEfmSg lmj x11,pRipAr pOp a0 lmj x11,pRivAr j nExtcOmmand dEfmSg. sTrng 'Variable has been set to it''s default value.' +0 sEtbCd. sEt bcd vAriable (a0) tO vAlue sPecified iN tOken. . iF iLlegal vAlue tHen pRint mEssage. la,h1 a2,2,a0 aa,u a2,3 ssl a2,2 aa,u a2,3,a0 pUsh a0 la,u a0,tOken lmj x11,sTr$uPcAse pOp a0 la,u a1,tOken lmj x11,cMdsRch jz a2,sEtbcda sa a2,1,a0 j nExtcOmmand sEtbcda. la,u a0,sEtbcdm lmj x11,pRipAr j nExtcOmmand sEtbcdm. sTrng 'Illegal value specified for a variable. Use' sTrng 'the HELP command to see what the legal values are.' +0 sEtdEc. sEt dEcimal vAriable (a0). . iF iLlegal pRint a mEssage. . iF mIssing sEt tO dEfault aNd pRint mEssage. . eXit tO nExtcOmmand la,u a3,0,a0 la,u a0,cMdbUf la,u a2,tOken la a1,cMdiNdex lmj x11,gEttOken sa a1,cMdiNdex jp a0,sEtdEca la,u a0,0,a3 lmj x11,sEtdEcdEf la,u a0,dEfmSg lmj x11,pRipAr j nExtcOmmand sEtdEca. la,u a0,tOken la,u a1,10 . dEcimal lmj x11,cVtascbIn j sEtdEciLla . eRror la,h1 a1,2,a3 aa,u a1,3 ssl a1,2 aa,u a1,0,a3 te a0,4,a1 tle a0,4,a1 tz,u 0 j sEtdEciLl tle a0,3,a1 j sEtdEciLl sa a0,1,a3 j nExtcOmmand sEtdEciLl. la,u a0,3+$ sEtdEciLla. lmj x11,pRipAr j nExtcOmmand sTrng 'Illegal value for decimal parameter' +0 sEtoCt. sEt oCtal vAriable (a0). . iF iLlegal pRint a mEssage. . iF mIssing sEt tO dEfault aNd pRint mEssage. . eXit tO nExtcOmmand la,u a3,0,a0 la,u a0,cMdbUf la,u a2,tOken la a1,cMdiNdex lmj x11,gEttOken sa a1,cMdiNdex jp a0,sEtoCTa la,u a0,0,a3 lmj x11,sEtoCTdEf la,u a0,dEfmSg lmj x11,pRipAr j nExtcOmmand sEtoCTa. la,u a0,tOken la,u a1,8 . oCtal lmj x11,cVtascbIn j sEtoCtiLla . eRror la,h1 a1,2,a3 aa,u a1,3 ssl a1,2 aa,u a1,0,a3 te a0,4,a1 tle a0,4,a1 tz,u 0 j sEtoCtiLl tle a0,3,a1 j sEtoCtiLl sa a0,1,a3 j nExtcOmmand sEtoCtiLl. la,u a0,3+$ sEtoCtiLla. lmj x11,pRipAr j nExtcOmmand sTrng 'Illegal value for octal parameter' +0 sEtoCTdEf. a0=octal vAriable. sEt iT tO iTs dEfault vAlue. pUsh a1 la,h1 a1,2,a0 aa,u a1,3 ssl a1,2 aa,u a1,0,a0 la a1,5,a1 sa a1,1,a0 pOp a1 j 0,x11 sEtcNtrl. sEt cNtrl cHaracter vAriable . iF iLlegal pRint mEssage . iF mIssing sEt tO dEfault aNd pRint mEssage . eXit tO nExtcOmmand la,u a3,0,a0 la,u a0,cMdbUf la,u a2,tOken la a1,cMdiNdex lmj x11,gEttOken sa a1,cMdiNdex jp a0,sEtcNtrla la,u a0,0,a3 lmj x11,sEtcNtrldEf la,u a0,dEfmSg lmj x11,pRipaR j nExtcOmmand sEtcNtrla. la,u a0,tOken la,u a1,8 lmj x11,cVtascbIn . j nExtcOmmand . eRror tle,u a0,040 j 3+$ te,u a0,0177 j sEtcNtrliLl sa a0,1,a3 j nExtcOmmand sEtcNtrliLl. la,u a0,3+$ lmj x11,pRipAr j nExtcOmmand sTrng 'Illegal character. Must be a' sTrng 'control character (0-037,0177)' +0 sEtcHr. sEt vAriable tO pRintable cHaracter. . iF iLlegal pRint mEssage. . iF mIssing tHe sEt tO dEfault aNd pRint mEssage. . eXit tO nExtcOmmand la,u a3,0,a0 la,u a0,cMdbUf la,u a2,tOken la a1,cMdiNdex lmj x11,gEttOken sa a1,cMdiNdex jp a0,sEtcHra la,u a0,0,a3 lmj x11,sEtcHrdEf la,u a0,dEfmSg lmj x11,pRipAr j nExtcOmmand sEtcHra. la,u a0,tOken la,u a1,8 lmj x11,cVtascbIn j nExtcOmmand . eRror tg,u a0,040 tg,u a0,0177 j sEtcHriLl sa a0,1,a3 j nExtcOmmand sEtcHriLl. la,u a0,3+$ lmj x11,pRipAr j nExtcOmmand sTrng 'Illegal character....Must be a printable' sTrng 'character (040-0176).' +0 sEtrCv. la,u a0,cMdbUf la,u a2,tOken la a1,cMdiNdex lmj x11,gEttOken sa a1,cMdiNdex jn a0,lStsEtrCv la,u a0,tOken lmj x11,sTr$uPcAse la,u a1,tOken la,u a2,sEtrCvlSt lmj x11,cMdsRch jz a2,lStsEtrCv la a0,0,a2 j 0,a0 sEtrCvlSt. +sEtrCvpAklEn sTrng 'PACKETLENGTH' +sEtrCvpAd sTrng 'PADDING' +sEtrCvpAdcHr sTrng 'PADCHAR' +sEtrCvtImoUt sTrng 'TIMEOUT' +sEtrCvqUote sTrng 'QUOTE' +sEtrCveNdlIn sTrng 'ENDOFLINE' +sEtrCvsTart sTrng 'STARTOFPACKET' +0 lStsEtrCv. la,u a0,3+$ lmj x11,pRipAr j nExtcOmmand sTrng 'The legal receive parameter names are:' sTrng ' PACKETLENGTH' sTrng ' PADDING' sTrng ' PADCHAR' sTrng ' TIMEOUT' sTrng ' QUOTE' sTrng ' ENDOFLINE' sTrng ' STARTOFPACKET' +0 sEtrCvpAklEn. la,u a0,rpAklEn j sEtdEc sEtrCvpAd. la,u a0,rpAd j sEtdEc sEtrCvpAdcHr. la,u a0,rpAdcHr j sEtcNtrl sEtrCvtImoUt. la,u a0,rtImoUt j sEtdEc sEtrCvqUote. la,u a0,rqUote j sEtcHr sEtrCveNdlIn. la,u a0,reNdlIn j sEtcNtrl sEtrCvsTart. la,u a0,rsTart j sEtcNtrl sEtsNd. la,u a0,cMdbUf la,u a2,tOken la a1,cMdiNdex lmj x11,gEttOken sa a1,cMdiNdex jn a0,lStsEtsNd la,u a0,tOken lmj x11,sTr$uPcAse la,u a1,tOken la,u a2,sEtsNdlSt lmj x11,cMdsRch jz a2,lStsEtsNd la a0,0,a2 j 0,a0 sEtsNdlSt. +sEtsNdpAklEn sTrng 'PACKETLENGTH' +sEtsNdpAd sTrng 'PADDING' +sEtsNdpAdcHr sTrng 'PADCHAR' +sEtsNdtImoUt sTrng 'TIMEOUT' +sEtsNdqUote sTrng 'QUOTE' +sEtsNdeNdlIn sTrng 'ENDOFLINE' +sEtsNdsTart sTrng 'STARTOFPACKET' +0 lStsEtsNd. la,u a0,3+$ lmj x11,pRipAr j nExtcOmmand sTrng 'The legal SEND parameter names are:' sTrng ' PACKETLENGTH' sTrng ' PADDING' sTrng ' PADCHAR' sTrng ' TIMEOUT' sTrng ' QUOTE' sTrng ' ENDOFLINE' sTrng ' STARTOFPACKET' +0 sEtsNdpAklEn. la,u a0,spAklEn j sEtdEc sEtsNdpAd. la,u a0,spAd j sEtdEc sEtsNdpAdcHr. la,u a0,spAdcHr j sEtcNtrl sEtsNdtImoUt. la,u a0,stImoUt j sEtdEc sEtsNdqUote. la,u a0,sqUote j sEtcHr sEtsNdeNdlIn. la,u a0,seNdlIn j sEtcNtrl sEtsNdsTart. la,u a0,ssTart j sEtcNtrl /. sHow. LA A1,CMDINDEX LA,U A2,TOKEN LA,U A0,CMDBUF LMJ X11,GETTOKEN . SEE IF COMMAND NAME GIVEN SA A1,CMDINDEX JN A0,SHOWNSCH SHOWCMD. LA,U A0,TOKEN LMJ X11,STR$UPCASE LA,U A2,SHOWTBL LA,U A1,TOKEN LMJ X11,CMDSRCH JZ A2,SHOWNSCH LA A0,0,A2 J 0,A0 SHOWNSCH. LA,U A0,3+$ LMJ X11,PRIPAR J NEXTCOMMAND STRNG 'LEGAL SHOW TOPICS ARE:' STRNG ' ALL - Show all parameters' STRNG ' GLOBAL - Show global parameters' STRNG ' SEND - Show send parameters' STRNG ' RECEIVE - Show receive parameters' STRNG ' The name of an individual global parameter' +0 SHOWTBL. +SHWALL STRNG 'ALL' +SHWGBL STRNG 'GLOBAL' +SHWSEND STRNG 'SEND' +SHWRCV STRNG 'RECEIVE' +SHWDBG STRNG 'DEBUG' +SHWDUMP STRNG 'DUMPFORMAT' +SHWDLY STRNG 'DELAY' +SHWWLD STRNG 'MAXWILD' +SHWPRT STRNG 'PARITY' +SHWLEN STRNG 'LENGTH' +SHWFILE STRNG 'FILE' +SHWCONT STRNG 'CONTINUATION' +SHWTYP STRNG 'TYPE' +SHWSEED STRNG 'SEED' +SHWPROB STRNG 'ERRORPROB' +0 SHWALL. la,u a0,sHgLblmSg lmj x11,pRipAr la,u a0,dElay lmj x11,pRivAr LA,U A0,MAXWILD LMJ X11,PRIVAR la,u a0,parity lmj x11,pRivAr la,u a0,tYpe lmj x11,pRivAr la,u a0,lEngth lmj x11,pRivAr la,u a0,cOntinue lmj x11,pRivAr la,u a0,wIdth lmj x11,pRivAr la,u a0,rEpeat lmj x11,pRivAr la,u a0,qUote8 lmj x11,pRivar la,u a0,dEbUg lmj x11,pRivAr LA,U A0,DUMPFMT LMJ X11,PRIVAR la,u a0,sEed lmj x11,pRivAr la,u a0,eRrpRob lmj x11,pRivAr sz,h2 pRlIne la,u a0,pRlIne la,u a1,fIlemSg. lmj x11,cOncat la,u a1,vAlcOl lmj x11,tAb la,u a1,fIlenAme lmj x11,cOncat lxi,u a0,1 lmj x11,pRintsTring la,u a0,sHsNdmSg lmj x11,pRipAr la,u a0,spAklEn lmj x11,pRivAr la,u a0,spAd lmj x11,pRivAr la,u a0,spAdcHr lmj x11,pRivAr la,u a0,stImoUt lmj x11,pRivAr la,u a0,sqUote lmj x11,pRivAr la,u a0,seNdlIn lmj x11,pRivAr la,u a0,rsTart lmj x11,pRivAr la,u a0,sHrCvmSg lmj x11,pRipAr la,u a0,rpAklEn lmj x11,pRivAr la,u a0,rpAd lmj x11,pRivAr la,u a0,rpAdcHr lmj x11,pRivar la,u a0,rtImoUt lmj x11,pRivAr la,u a0,rqUote lmj x11,pRivAr la,u a0,reNdlIn lmj x11,pRivAr la,u a0,ssTart lmj x11,pRivAr j nExtcOmmand . SHWGBL LA,U A0,SHGLBLMSG LMJ X11,PRIPAR LA,U A0,DELAY LMJ X11,PRIVAR LA,U A0,MAXWILD LMJ X11,PRIVAR LA,U A0,PARITY LMJ X11,PRIVAR LA,U A0,TYPE LMJ X11,PRIVAR LA,U A0,LENGTH LMJ X11,PRIVAR LA,U A0,CONTINUE LMJ X11,PRIVAR la,u a0,wIdth lmj x11,pRivAr la,u a0,rEpeat lmj x11,pRivAr la,u a0,qUote8 lmj x11,pRivAr LA,U A0,DEBUG LMJ X11,PRIVAR LA,U A0,DUMPFMT LMJ X11,PRIVAR LA,U A0,SEED LMJ X11,PRIVAR LA,U A0,ERRPROB LMJ X11,PRIVAR SZ,H2 PRLINE LA,U A0,PRLINE LA,U A1,FILEMSG. LMJ X11,CONCAT LA,U A1,VALCOL LMJ X11,TAB LA,U A1,FILENAME LMJ X11,CONCAT LXI,U A0,1 LMJ X11,PRINTSTRING J NEXTCOMMAND . SHWSEND LA,U A0,SHSNDMSG LMJ X11,PRIPAR LA,U A0,SPAKLEN LMJ X11,PRIVAR LA,U A0,SPAD LMJ X11,PRIVAR LA,U A0,SPADCHR LMJ X11,PRIVAR LA,U A0,STIMOUT LMJ X11,PRIVAR LA,U A0,SQUOTE LMJ X11,PRIVAR LA,U A0,SENDLIN LMJ X11,PRIVAR LA,U A0,RSTART LMJ X11,PRIVAR J NEXTCOMMAND . SHWRCV LA,U A0,SHRCVMSG LMJ X11,PRIPAR LA,U A0,RPAKLEN LMJ X11,PRIVAR LA,U A0,RPAD LMJ X11,PRIVAR LA,U A0,RPADCHR LMJ X11,PRIVAR LA,U A0,RTIMOUT LMJ X11,PRIVAR LA,U A0,RQUOTE LMJ X11,PRIVAR LA,U A0,RENDLIN LMJ X11,PRIVAR LA,U A0,SSTART LMJ X11,PRIVAR J NEXTCOMMAND . SHWDBG LA,U A0,DEBUG LMJ X11,PRIVAR J NEXTCOMMAND . SHWDUMP LA,U A0,DUMPFMT LMJ X11,PRIVAR J NEXTCOMMAND . SHWDLY LA,U A0,DELAY LMJ X11,PRIVAR J NEXTCOMMAND . SHWWLD LA,U A0,MAXWILD LMJ X11,PRIVAR J NEXTCOMMAND . SHWPRT LA,U A0,PARITY LMJ X11,PRIVAR J NEXTCOMMAND . SHWFILE. SZ,H2 PRLINE LA,U A0,PRLINE LA,U A1,FILEMSG. LMJ X11,CONCAT LA,U A1,VALCOL LMJ X11,TAB LA,U A1,FILENAME LMJ X11,CONCAT LXI,U A0,1 LMJ X11,PRINTSTRING J NEXTCOMMAND . SHWLEN LA,U A0,LENGTH LMJ X11,PRIVAR J NEXTCOMMAND . SHWCONT LA,U A0,CONTINUE LMJ X11,PRIVAR J NEXTCOMMAND . SHWTYP LA,U A0,TYPE LMJ X11,PRIVAR J NEXTCOMMAND . SHWSEED LA,U A0,SEED LMJ X11,PRIVAR J NEXTCOMMAND . SHWPROB LA,U A0,ERRPROB LMJ X11,PRIVAR J NEXTCOMMAND . fIlemSg. sTrng 'FILENAME' sHgLblmSg. sTrng 'Global Parameters' +0 sHsNdmSg. sTrng 'Send Parameters' +0 sHrCvmSg. sTrng 'Receive Parameters' +0 /. sEnd. tz,s1 fiTempKt+6 j sEndfok la,u a0,$+3 lmj x11,pRipAr j nExtcOmmand sTrng 'Sorry, but you have not specified a file name.' sTrng 'You do it with a "SET FILE" command' +0 sEndfok. la,s2 a0,fiTempKt+6 top,u a0,2 j sEndrok la,u a0,$+3 lmj x11,pRipAr j nExtcOmmand sTrng 'Sorry, but your file is read inhibited' +0 sEndrok. sz npAsses LA,U A0,BSPFCT . FILE TABLE INDEX LMJ X11,RFTI$ J 4+$ LA,U A0,BSPFCT LA A1,(BSPBUF,1792) LMJ X11,RPFET$ j sEndfeRr . DON'T ALLOW WILDCARDS la a1,cMdiNdex la,u a2,tOken la,u a0,cMdbUf lmj x11,gEttOken sa a1,cMdiNdex jp a0,sEndeLt la,u a0,3+$ lmj x11,pRipAr j nExtcOmmand sTrng 'You must specify an elementname on the send command.' +0 sEndfeRr. eRror oPening fIle iNdex la,u a0,3+$ lmj x11,pRipAr j nExtcOmmand sTrng 'Error opening file table of contents' +0 sEndeLt. fIeldAta dl a4,(' ') ascii ds a4,vErsionnAme la,u a1,tOken la,u a3,0 lmj x11,eXtrev jp a0,$+3 lmj x11,pRipAr j nExtcOmmand ds a4,eLementnAme jz a0,sEndsTrt TE,U A0,'.' tne,u a0,'/' j sEndvEr la,u a0,$+3 lmj x11,pRipAr j nExtcOmmand sTrng 'Illegal character in element/version specification.' +0 sEndvEr. lmj x11,eXtrev . gEt vErsion nAme jp a0,3+$ lmj x11,pRipAr j nExtcOmmand ds a4,vErsionnAme sEndsTrt. dl a4,eLementnAme ds a4,wIldeLt dl a4,vErsionnAme ds a4,wIldvEr LMJ X11,WILDCARDNAM . GET A FILE NAME J 4+$ . NO FIND IN THIS FILE J NEXTCOMMAND . END OF WILDCARD SEND lmj x11,dOpfs jp a0,sEndoPn la,u a0,3+$ lmj x11,pRipAr j nExtcOmmand sTrng 'There is no such symbolic element.' +0 sEndoPn. lmj x11,cLreRrmSg lmj x11,oPensOurce jn a0,nExtcOmmand la a0,dElay+1 j 3+$ la,u a1,1000 er twAit$ jgd a0,-2+$ lmj x11,iNitialize lmj x11,sEndsW la a1,a0 la,u a0,scMpltmSg te,u a1,tRue la,u a0,sfLmSg lmj x11,pRintsTring la a1,a0 la,u a0,cMpltmSg sz,h2 0,a0 lmj x11,cOncAt lmj x11,sHutdOwn j nExtcOmmand scMpltmSg. sTrng 'Send complete...' sfLmSg. sTrng 'Send failure...' /. rEceive. tz,s1 fiTempKt+6 j rEceivefok la,u a0,3+$ lmj x11,pRipAr j nExtcOmmand sTrng 'Sorry, but you have not specified a file name.' sTrng 'You do it with a "SET FILE" command.' +0 rEceivefok. la,s2 a0,fiTempKt+6 top,u a0,4 j rEceivewok la,u a0,3+$ lmj x11,pRipAr j nExtcOmmand sTrng 'Sorry, but your file is write inhibited.' +0 rEceivewok. lmj x11,cLreRrmSg LMJ X11,INITIALIZE lmj x11,rEcsW la a1,a0 la,u a0,rcMpltmSg te,u a1,tRue la,u a0,rfLmSg lmj x11,pRintsTring la a1,a0 la,u a0,cMpltmSg sz,h2 0,a0 lmj x11,cOncAt LMJ X11,SHUTDOWN j nExtcOmmand rcMpltmSg. sTrng 'Receive complete...' rfLmSg. sTrng 'Receive failed...' SERVER. TZ,S1 FITEMPKT+6 J SERVERFOK LA,U A0,3+$ LMJ X11,PRIPAR J NEXTCOMMAND STRNG 'Sorry, but you have not specified a file name.' STRNG 'You do it with a "SET FILE" command.' +0 SERVERFOK. LA,S2 A0,FITEMPKT+6 TOP,U A0,4 J SERVERWOK LA,U A0,3+$ LMJ X11,PRIPAR J NEXTCOMMAND STRNG 'Sorry, but your file is write inhibited.' +0 SERVERWOK. LA,S2 A0,FITEMPKT+6 TOP,U A0,2 J SERVERROK LA,U A0,3+$ LMJ X11,PRIPAR J NEXTCOMMAND STRNG 'Sorry, but your file is read inhibited.' +0 SERVERROK. LA,U A0,BSPFCT . FILE TABLE INDEX LMJ X11,RFTI$ J 4+$ LA,U A0,BSPFCT LA A1,(BSPBUF,1792) LMJ X11,RPFET$ j sEndfeRr LA,U A0,3+$ . GIVE THE SONG AND DANCE ABOUT BEING LMJ X11,PRIPAR . IN SERVER MODE J SERVERAOK . GET ON IT STRNG 'KERMIT-11 is now in server mode, use the escape' STRNG 'sequence to return to the user KERMIT on the other' STRNG 'end of the connection.' STRNG ' ' +0 SERVERAOK. LMJ X11,CLRERRMSG LMJ X11,INITIALIZE LMJ X11,SERVSW LA A1,A0 LA,U A0,SVCPLTMSG TE,U A1,TRUE LA,U A0,SVFLMSG LMJ X11,PRINTSTRING LMJ X11,SHUTDOWN J QUIT SVCPLTMSG. STRNG 'Leaving server mode normally...' SVFLMSG. STRNG 'Leaving server mode abnormally...' /. iNitialize. pUsh x11,a0,a1 LMJ X11,SHUTDOWN . SHUT IN DOWN tnz tErminate j 4+$ la,u a0,1000 er twAit$ j -4+$ . . sEt tHe cUrrent mOdes tO tHe vAlues sPecified vIa tHe sEt cOmmand (oR tO . tHe dEfaults iF nO sEt cOmmand uSed). iN a lIttle wHile wE wIll cArry . oN sOme nEgotiations wIth tHe rEmote aNd iN sUbroutine rpAr(rEceive . pArameters) wE mAy cHange tHese vAlues. la a0,rqUote+1 sa a0,cUrrqUote la a0,spAklEn+1 sa a0,cUrspAklEn la a0,spAd+1 sa a0,cUrspAd la a0,spAdcHr+1 sa a0,cUrspAdcHr la a0,stimoUt+1 sa a0,cUrstimoUt la a0,seNdlIn+1 sa a0,cUrseNdlIn la a0,(+sEtmD1l,sEtmD1) IF MDLFE . Gunnar er apRtcN$ . tHis fIrst pRint cOntrol pUshes . tHe cUrrent mOdes oNto a oNe dEep . sTack aNd sEts uP sOme oF tHe . rEquired nEw mOdes. wHen fIle . tRansfer iS cOmplete wE wIll . pOp tHe oRiginal mOdes oFf tHe sTack. la,u a1,500 er twAit$ la,u a0,pRlIne sz,h2 0,a0 la,u a1,sEtmD2 lmj x11,cOncAt la a1,pArity+1 aa,u a1,1 lmj x11,cOncat la,u a1,41 lmj x11,tAb la,u a0,1,a0 lxi,u a0,10 er apRtcN$ la a0,(+sEtmD7l,sEtmD7) la a1,wIdth+1 tne,u a1,8 la a0,(+sEtmD8l,sEtmD8) er apRtcn$ ENDF MDLFE . Gunnar IF DCPFE . Gunnar la a0,(+setdcpmdl,setdcpmd) . Gunnar er aprtcn$ . Gunnar ENDF DCPFE . Gunnar IF ESCMODE . Gunnar la a0,(+setescl,setesc). @@ESC O . Gunnar er aprtcn$ . Gunnar ENDF ESCMODE . Gunnar la,u a1,1000 . gIve tIme fOr @@tty tO tAke eFfect er twait$ la,u a0,rEadaCt er fOrk$ la,u a0,tImeaCt er fOrk$ pOp a1,a0,x11 sx x11,rDaCtive j 0,x11 IF MDLFE . Gunnar sEtmd1. . cKp sAves cUrrent mOdes . lmD=fDx sEts fUll dUplex . iNx=100 aLlows iNput lInes tO 100 cHaracters lOng . olG=100 aLlows oUtput lInes tO 100 cHaracters lOng . bRf sAys nOt tO pRint lOts oF gArbage iN rEsponse tO tHis cOmmand 'd,@@tty mDS=cKp,lMd=fDx,ilG=100,olG=100,bRf=oN,iNx=100' sEtmD1l eQu -sEtmD1+$ sEtmd2. sTrng 'd,@@tty bRf=oN,smD=oFf,oUp=' . sHut-uP . sCreen mOde oFf (dOnt sTop eVery 25 lInes) . oUtput pArity aS dEfined bY sEt cOmmand sEtmD7. 'd,@@tty iNw=7,oUw=7,bRf=oN' sEtmD7l eQu -sEtmD7+$ sEtmD8. 'd,@@tty iNw=8,oUw=8,bRf=oN' sEtmD8l eQu -sEtmD8+$ . . Gunnar ENDF MDLFE . Gunnar IF DCPFE . Gunnar setdcpmd 'd,@@tty w,132,s,021 ' . Gunnar . Set line width to 132. . Gunnar . Set prompt character to control-Q. . Gunnar . Ctrl-Q is recognized as TURN AROUND . Gunnar . CHARACTER by C KERMIT. The C kermit . Gunnar . does then not send until the turn . Gunnar . around character arrives -> better . Gunnar . performance (?) . Gunnar setdcpmdl equ $-setdcpmd . Gunnar ENDF DCPFE . Gunnar IF ESCMODE . Gunnar setesc 'd,@@ESC O ' . Gunnar setescl equ $-setesc . Gunnar ENDF ESCMODE . Gunnar sHutdOwn. tnz rDaCtive j 0,x11 pUsh x11,a0 sx,h1 x11,tErminate sx,h2 x11,tErminate IF MDLFE . Gunnar la a0,(+cLrmDl,cLrmd) er apRtcN$ la a0,(+mDsl,mDs) er apRtcN$ ENDF MDLFE . Gunnar IF ESCMODE . Gunnar la a0,(+clearescl,clearesc) . Gunnar er aprtcn$ . Gunnar ENDF ESCMODE . Gunnar IF MDLFE=0 . Gunnar la,u a1,1000 er twAit$ la a0,(+0104,('Press RETURN!')) . Gunnar er aprint$ . Gunnar . Why was 'Press RETURN' here? . Gunnar . bEcause the aCtivity dOing tHe er arEad$ iS sTuck . Gunnar . wAiting fOr sOme iNput. . Gunnar tz logoutflag . Gunnar j shutdownx . Gunnar ENDF MDLFE=0 . Gunnar la,u a1,1000 er twAit$ tz tErminate j -3+$ shutdownx. . Gunnar sz rDaCtive iF DCPFE . Gunnar la a0,(+clrdcpmdl,clrdcpmd) . Gunnar er aprtcn$ . Gunnar ENDF DCPFE . Gunnar pOp a0,x11 j 0,x11 IF DCPFE . Gunnar clrdcpmd 'd,@@tty s,> ' . Gunnar clrdcpmdl equ $-clrdcpmd . Gunnar ENDF DCPFE . Gunnar IF ESCMODE . Gunnar clearesc;'d,@@END ESC ' . Gunnar clearescl equ $-clearesc . Gunnar ENDF ESCMODE . Gunnar IF MDLFE . gUnnar cLrmD 'd,@@tty mDs=rSt,bRf=oN' . pOp oRiginal tty mOdes oFf oF sTack . sHut uP cLrmDl eQu -cLrmD+$ mDs 'd,@@tty mDs=pGm,bRf=oN' . sEnd vAlues oF cUrrent mOdes tO eXecuting pRogram. . wHy iS tHis hEre? . bEcause tHe aCtivity dOing tHe er arEad$ iS sTuck . wAiting fOr sOme iNput. wE lEt tHe tty hAndler . wAke iT uP iNstead oF wAiting fOr tHe rEmote uSer . tO tYpe sOmething in (aNd hAve iT dIscarded). mDsl eQu -mDs+$ ENDF MDLFE . gUnnar . Treat the case when the read string . Gunnar . was shorter than the transmitted . Gunnar . packet. This can occur when the . Gunnar . checksum is SPACE, since sperry . Gunnar . kindly removes trailing spaces from . Gunnar . the input, and then fills with spaces . Gunnar . to next word limit. Nice, isn't it? . Gunnar /. tImedrEad. . iNput . a0=nUmber oF sEconds tO wAit . rEturn . +0 iF eof ('@' cArd) eNcountered . +1 iF tImeoUt . +2 iF lOst dAta (sHould nOt hAppen) . +3 iF sOme oTher eRror (sHould nOt hAppen) . +4 iF nOrmal rEturn fRom rEad . wHen yOu aRe dOne wIth tHe dAta aT iNput yOu aRE . rEsponsible fOr dOing: . sz,h1 2+iNput . pUsh a0,a1,x11 ts iNput tz,h1 2+iNput . aNything pResent? j tImedrx . yEs sa a0,1+iNput . sEt nUmber of sEconds tO wAit tImedrq. wAit fOr sOmetHing tO hAppen c$tsq iNput ts iNput tnz,h1 2+iNput j tImedrq tImedrx. c$ts iNput la,h1 a1,2+iNput . gEt sTatus pOp x11 tep,u a1,020 . tEst iF eof j tImedrdOne ax,u x11,1 tep,u a1,010 . tEst iF tImeoUt j tImedrdOne ax,u x11,1 tep,u a1,4 . tEst iF lOst dAta j tImedrdOne ax,u x11,1 tep,u a1,2 . tEst iF uNexplained eRror j tImedrdOne ax,u x11,1 top,u a1,1 anx,u x11,1 . uNdocumented eRror tImedrdOne. pOp a1,a0 j 0,x11 tImedrEdpUr. pUrge aNy iNput tHat hAs pIled uP. pUsh a0 ts iNput la,h1 a0,iNput+2 tep,u a0,1 . iF iNput pResent sz,h1 iNput+2 . dIscard iT pOp a0 c$ts iNput j 0,x11 tImeaCt. tIme1. la,u a1,1000 . oNe sEcond er twAit$ tnz,h1 tErminate j $+3 sz,h1 tErminate er eXit$ ts iNput tz,h1 2+iNput . aNy dAta iN bUffer? j tImects . yEs...sO nO tImeoUt la a0,1+iNput . gEt tIme rEmaining jz a0,tImects . tImer nOt aCtive ana,u a0,1 sa a0,1+iNput . dEcrement tIme rEmaining jnz a0,tImects . jUmp iF nO tImeoUt la,u a0,010 or,h1 a0,2+iNput . set tImeoUt sTatus sa,h1 a1,2+iNput c$tsa iNput . aCtivate wAiting aCtivity j tIme1 . aNd lOop aRound fOrever tImects. c$ts iNput j tIme1 . . . rEadaCt. rEadwAit. tnz,h2 tErminate j $+3 sz,h2 tErminate er eXit$ la a0,(+rEadeof,rEadbuf) er arEad$ la a1,rEadbUf jp a1,3+$ jnz a1,2+$ j rEadwAit . sKip iF -0 ts iNput la,h1 a1,2+iNput top,u a1,1 . iS bUffer aLready fUll? j rEadmOve . bUffer iS eMpty la,u a0,04 or,h1 a0,2+iNput . set lOst dAta sTatus sa,h1 a1,2+iNput c$ts iNput j rEadwAit rEadmOve. la a1,(+1,rEadbUf) la a2,(+1,3+iNput) lr,u r1,0,a0 . wOrd cOunt bt a2,0,*a1 lxi,u a0,0 msi,u a0,4 . cOnvert tO cHaracter cOunt sa,h2 a0,2+iNput la,u a0,1 or,h1 a0,2+iNput . set nOrmal sTatus sa,h1 a1,2+iNput sz 1+iNput c$tsa iNput j rEadwAit rEadeof. ts iNput la,u a0,020 or,h1 a0,2+iNput . sEt eof sTatus sa,h1 a1,2+iNput sz 1+iNput c$tsa iNput j rEadwAit . iNfLush. tHrow aWay aNy qUeued iNput ts iNput sz,h1 2+iNput c$ts iNput j 0,x11 /. p pRoc lD* nAme la,q1 a0,p(1,1),a1 la,q2 a0,p(1,1),a1 la,q3 a0,p(1,1),a1 la,q4 a0,p(1,1),a1 eNd lOads. uNlist i dO mAxeLtlInsIz+1 , lD -1+i lIst p pRoc sT* nAme sa,q1 a0,p(1,1),a2 sa,q2 a0,p(1,1),a2 sa,q3 a0,p(1,1),a2 sa,q4 a0,p(1,1),a2 eNd sTores. uNlist i do mAxeLtlInsIz+1 , sT -1+i lIst gEttOken. fEtch nExt tOken fRom sTring aT (a0). . a1=iNdex oF fIrtst cHaracter . a2=sTring tO cOntain tOken . rEturns . a0 pOsitive (tErmination cHaracter) iF tOken fOund . a0 nEgative iF nO tOkens rEmain . a1 = iNdex oF nExt cHaracter pUsh x9,x11,a3,a4,a5 lx,u x9,0 . oUtpUt iNdex la,u a3,0,a1 . iNput iNdex la,u a1,0,a0 . iNput sTring aDdress sz,h2 0,a2 . # characters cOpied gEtsTrt. tg,h2 a3,0,a1 . aNy cHaracters lEft j gEtnOne . nOpe ex 4+lOads,a3 . gEt nExt cHaracter aa,u a3,1 tne,u a0,' ' j gEtsTrt te,u a0,',' j gEtgOing gEteXit. la,u a1,0,a3 . nEw iNdex sx,h2 x9,0,a2 . # characters pOp a5,a4,a3,x11,x9 j 0,x11 gEtnOne. lna,u a0,1 j gEteXit gEtgOing. gEtnExt. la,u a5,0,x9 tle,h1 a5,0,a2 eX 4+sTores,x9 ax,u x9,1 gEttEst. la,u a0,0 tg,h2 a3,0,a1 j gEteXit ex 4+lOads,a3 aa,u a3,1 te,u a0,',' tne,u a0,' ' j gEteXit j gEtnExt rEadcOmmand. . iNput a0=bUffer aDDress . rEturn a0=cHaracter cOunt (nEg = eof) sa,h2 a0,cMdpKt+010 rEadcOmmanda. la,u a0,cMdpKt er sYmb$ tz,s1 3,a0 j cMdeof la,h2 a0,3,a0 tep,u a0,020000 . tEst iF iNfOr j rEadcOmmanda la,u a0,cMdpKt la,h2 a0,011,a0 . cHaracter cOunt cMdxIt. j 0,x11 cMdeof. lna,u a0,1 j cMdxIt . . cMdsRch. sEarch lIst (a2) fOr cOmmand (a1) . rEturns a2 = mAtching eNtry (oR zEro) pUsh a3,x11,a0 la,u a3,0 cMdsRch1. aa,u a2,1 lmj x11,cOmpsTr ana,u a2,1 jnz a0,cMdsRch2 jz a3,cMdsRch3 la,u a3,0 . nO fInd...aMbiguous j cMdsRchx cMdsRch3. la,u a3,0,a2 cMdsRch2. aa,u a2,1 la,h1 a0,0,a2 aa,u a0,3 ssl a0,2 aa,u a2,1,a0 tz 0,a2 j cMdsRch1 cMdsRchx. la,u a2,0,a3 pOp a0,x11,a3 j 0,x11 . . cOmpsTr. cOmpare sTrings (a1) aNd (a2). . a0 <= rEsult . +0 iDentical eVen uNto sIze . -0 (a1) mAtches tHe fIrst pArt oF (a2) . +1 (a1) > (a2) (oR (a1) iS lOnger tHan (a2)) . -1 (a1) < (a2) pUsh x11,a1,a3,a4,a5,r1,r2,r3 la,u a3,0 . sTring cHaracter iNdex lr,h2 r1,0,a1 . (a1) cHaracter cOunt lr,h2 r2,0,a2 . cHaracter cOunt (a2) cOmpsTr0. jgd r1,cOmpsTr1 jgd r2,cOmpsTr2 la,u a0,0 j cOmpsTrx cOmpsTr2. la a0,(0777777777777) . mInus zEro j cOmpsTrx cOmpsTr1. jgd r2,cOmpsTr3 la,u a1,1 j cOmpsTrx cOmpsTr3. ex 4+lOads,a3 sa a0,r3 . sAve tHat cHaracter dsc a1,36 ex 4+lOads,a3 dsc a1,36 aa,u a3,1 tne a0,r3 j cOmpsTr0 la a1,a0 la,u a0,1 tg a1,r3 lna,u a0,1 cOmpsTrx. pop r3,r2,r1,a5,a4,a3,a1,x11 j 0,x11 . . sTr$uPcAse. cOnvert sTring aT (a0) tO uPper cAse. pUsh a1,a2,r1,a0,a3 la,u a1,0,a0 la,u a2,0,a0 lr,h2 r1,0,a0 la,u a3,4 j 8+$ ex lOads,a3 tg,u a0,'a' tg,u a0,1+'z' j 3+$ ana,u a0,040 ex sTores,a3 aa,u a3,1 jgd r1,-7+$ pOp a3,a0,r1,a2,a1 j 0,x11 . . . . pRipAr. pRint pAragraph pOinted aT bY a0 pUsh a0,x11,a1 pRipAr1. tnz 0,a0 . aT eNd oF pAragraph? j pRipArx . yEs pUsh a0 lmj x11,pRintsTring pOp x11 la,h1 a0,0,x11 aa,u a0,3 ssl a0,2 aa,u a0,1,x11 j pRipAr1 pRipArx. pOp a1,x11,a0 j 0,x11 cOncat. sTring (a0) ::= sTring (a0)+sTring (a1) pUsh x11,a0,a1,a2,a3,a5 la,u a2,0,a0 la,h2 a5,0,a1 . # cHaracters iNput lx,u x11,0 . iNput iNdex la,h2 a3,0,a2 . oUtput iNdex j 6+$ eX 4+lOads,x11 ax,u x11,1 tle,h1 a3,0,a2 eX 4+sTores,a3 aa,u a3,1 jgd a5,-5+$ sa,h2 a3,0,a2 pOp a5,a3,a2,a1,a0,x11 j 0,x11 pRivAr. a0=vAriable....pRint iTs nAme aNd vAlue pUsh x11,a1,a2,a3,r1,r2 pUsh a0 sz,h2 pRlIne la a2,0,a0 la,u a1,2,a0 la,u a0,pRlIne lmj x11,cOncat la,u a1,vAlcOl lmj x11,tAb la a0,0,x10 la a1,0,a0 j $,a1 j pRivArdEc j pRivArbcd j pRivArcNt j pRivArcHr j pRivAroCt +0 pRivArdEc. la a0,1,a0 . gEt vAlue la,u a1,1 . aT lEast 1 dIgit la,u a2,10 . dEcimal lmj x11,bInasc la,u a0,pRlIne la,u a1,bInascrSlt lmj x11,cOncat j pRivArxIt pRivAroCt. la a0,1,a0 . gEt vAlue la,u a1,1 . aT lEast 1 dIgit la,u a2,8 . oCtal lmj x11,bInasc la,u a0,pRlIne la,u a1,bInascrSlt lmj x11,cOncat pRivArxIt. lxi,u a0,1 lmj x11,pRintsTring pOp a0 pOp r2,r1,a3,a2,a1,x11 j 0,x11 pRivArbcd. la a1,1,a0 aa,u a1,1 la,u a0,pRlIne lmj x11,cOncat j pRivArxIt . . pRivArcNt pRivArcHr la a0,1,a0 la,u a1,3 la,u a2,8 lmj x11,bInasc la,u a0,pRlIne la,u a1,bInascrSlt lmj x11,cOncAt j pRivArxIt rEvsTr. rEverse tHe sTring aT (a0). pUsh x11,a0,a1,a2,a3,a4,r1 la,h2 a2,0,a0 . nUmber oF cHaracters ssl a2,1 lr r1,a2 la,h2 a3,0,a0 la,u a1,0,a0 la,u a2,0,a0 lx,u x11,0 j 9+$ ana,u a3,1 ex 4+lOads,x11 sa a0,a4 ex 4+lOads,a3 ex 4+sTores,x11 la a0,a4 ex 4+sTores,a3 ax,u x11,1 jgd r1,-8+$ pOp r1,a4,a3,a2,a1,a0,x11 j 0,x11 . . bInasc. cOnver sIgned iNteger tO ascii . a0=iNteger . a1=mInimum nUmber oF dIgits . a2=bAse . rEsulting sTring wIll bE fOund aT bInascrSlt pUsh x11,a0,a1,a2,a3,r1,r2,r3 lr,u r3,0 jp a0,3+$ lna a0,a0 lr,u r3,1 lr,u r2,0,a1 . nUmber oF dIgits nEeded lr,u r1,0,a2 . bAse la,u a3,0 la,u a2,bInascrSlt bInasc1. dsl a0,36 di a0,r1 tg,u a1,10 aa,u a1,7 aa,u a1,48 dsc a0,36 ex 4+sTores,a3 dsc a0,36 aa,u a3,1 jnz a0,bInasc1 tle a3,r2 j bInasc1 tnz r3 j 4+$ la,u a0,'-' ex 4+sTores,a3 aa,u a3,1 sa,h2 a3,0,a2 la,u a0,0,a2 lmj x11,rEvsTr pOp r3,r2,r1,a3,a2,a1,a0,x11 j 0,x11 . . cVtascbIn. cOnvert sTring (a0) to bInary iN a0. a1 iS tHe bAse. . rEturn +0 , a0=eRror mEssage aDdress . rEturn +1 , a0=bInary rEsult pUsh a1,a2,a3,a4,r1 la,u a2,0,a1 la,u a1,0,a0 la,u a3,0 lr,u r1,0 la,u a4,0 tg,h2 a3,0,a1 j cVtabx ex 4+lOads,a3 aa,u a3,1 tne,u a0,' ' j -5+$ tne,u a0,'+' j cVtabn te,u a0,'-' j cVtabm lr,u r1,1 cVtabn. tg,h2 a3,0,a1 j cVtabx ex 4+lOads,a3 aa,u a3,1 tne,u a0,' ' j cVtabn cVtabm. tg,u a0,'a' tg,u a0,'z'+1 j $+2 ana,u a0,'a'-'A' ana,u a0,'0' tg,u a0,10 ana,u a0,'A'-'0'-10 tg,u a0,0,a2 j cVtabo jn a0,cVtabo msi,u a4,0,a2 aa,u a4,0,a0 j cVtabn cVtabx. tz r1 lna a4,a4 la a0,a4 cVtabr. pOp r1,a4,a3,a2,a1 j 1,x11 cVtabo. la,u a0,cVtabmSg pOp r1,a4,a3,a2,a1 j 0,x11 cVtabmSg sTrng 'Numeric field contains non-numeric character or' sTrng 'an illegal numeric character (EG: 9 in octal field).' +0 . . dEbUggero. tnz dEbUg+1 j 0,x11 sx x11,dEbUgbUff+54 j dEbUgger dEbUggeri. tnz dEbUg+1 j 0,x11 sz dEbUgbUff+54 dEbUgger. pUsh a0,a1,r1 lxi,u a0,1 la a1,(+1,dEbUgbUff) lr,u r1,54 bt a1,0,*a0 er tdAte$ sa a0,dEbUgbUff+55 la,u a0,dEbUgiopKt er iow$ la a1,5,a0 aa,u a1,2 sa a1,5,a0 pOp r1,a1,a0 j 0,x11 . . pRintsTring. . pRint sTring lOcated aT (a0) . a0 iNcrement=sPacing cOunt . eg: . la a0,(+2,sTrnga) dOuble sPace . lmj x11,pRintsTring pUsh a0 aa,u a0,1 sa,h2 a0,4+pRsTrpKt ana,u a0,1 ssc a0,18 sa,h1 a0,6+pRsTrpKt ssc a0,18 la,h2 a0,0,a0 . cHaracter cOunt sa,h1 a0,4+pRsTrpKt la,u a0,pRsTrpKt er sYmb$ pOp a0 j 0,x11 tAb. . a0=sTring aDdress . a1=cOlumn nUmber pUsh a0,a2,a3 la,u a2,0,a0 la,u a0,' ' la,h2 a3,0,a2 ana,u a1,2 tg a1,a3 tg,h1 a3,0,a2 j 4+$ eX 4+sTores,a3 aa,u a3,1 j -5+$ aa,u a1,2 sa,h2 a3,0,a2 pOp a3,a2,a0 j 0,x11 . dOuSe. sz,s1 fiTempKt+6 . nO fIle aSsigned pUsh x11,a0,a1,a2,a3,a4,a5 la,u a1,fIlenAme la,u a3,0 lmj x11,eXtrqf jn a0,dOuSee jz a0,dOuSecKdN tne,u a0,'.' j dOuSecKeLt te,u a0,'*' j dOuSesYeRr lmj x11,eXtrqf jn a0,dOuSee jz a0,dOuSecKdn te,u a0,'.' j dOuSesYeRr dOuSecKeLt. jz a2,dOuSesYeRr lmj x11,eXtrev jnz a2,dOuSesYeRr dOuSecKdn. la,u a0,pRlIne sz,h2 0,a0 la,u a1,uSesTr lmj x11,cOncat la,u a1,fIlenAme lmj x11,cOncat la,u a1,sPs lmj x11,cOncat la,u a0,pRlIne+1 er acsf$ jp a0,dOuSeok dOuSesYeRr. la,u a0,3+$ dOuSee. lmj x11,pRipAr j dOuSeeX sTrng 'Syntax error in filename.' +0 dOuSeok. la,u a0,aSgsTr+1 er acsf$ jp a0,dOaSgok la a5,a0 la,u a0,aSgm lmj x11,pRipAr la a0,a5 lmj x11,pRifAc j dOuSeeX dOaSgok. la a0,(+11,fiTempKt) er fiTem$ tz,s1 6,a0 j dOuSetStpf la,u a0,aSgm lmj x11,pRipAr j dOuSeeX dOuSetStpf. la,u a0,tStpfpKt er iow$ tz,s1 3,a0 j dOuSerDeRr la a0,cMdbUf fieldAta te a0,('**pf**') ascii j dOuSenOtpf dOuSeeX. pOp a5,a4,a3,a2,a1,a0,x11 j 0,x11 dOuSenOtpf. la,u a0,3+$ lmj x11,pRipAr j dOuSeeX sTrng 'That file is not a program file.' sTrng 'It cannot be used to contain elements.' +0 dOuSerDeRr. la,s1 a0,3,a0 tne,u a0,5 j dOuSeeX la,u a0,3+$ lmj x11,pRipAr j dOuSeeX sTrng 'I cannot read that file.' +0 pRifAc. pRint fAcility eRror mEssage j 0,x11 aSgm. sTrng 'I cannot assign that file.' +0 uSesTr. sTrng '@use k$e$r$m$i$t$,' sPs. sTrng ' . ' aSgsTr. sTrng '@aSg,ax k$e$r$m$i$t$ . ' . . sEtdEcdEf. a0=dEcimal vAriable. sEt iT tO iTs dEfault vAlue. pUsh a1 la,h1 a1,2,a0 aa,u a1,3 ssl a1,2 aa,u a1,0,a0 la a1,5,a1 sa a1,1,a0 pOp a1 j 0,x11 sEtcHrdEf. a0=cHaracter vAriable sEtcNtrldEf. a0=cOntrol cHaracter vAriable. pUsh a1 la,h1 a1,2,a0 aa,u a1,3 ssl a1,2 aa,u a1,0,a0 la a1,3,a1 sa a1,1,a0 pOp a1 j 0,x11 . eXtrqf. eXtract fIlename oR qUalifier pUsh x11,r2 lr,u r2,0 . nO wIldcards allowed lmj x11,eXtr pOp r2,x11 j 0,x11 . eXtrev. eXtract eLement oR vErsion pUsh x11,r2 lr,u r2,1 . allow wIldcards lmj x11,eXtr pop r2,x11 j 0,x11 . extr. eXtract fIle nAme (oR qUalifier oR eLement oR vErsion) . a1=iNput sTring . a3=iNdex iNto sTring . r2=nOn-zEro iF wIldcard cHaracters ("*" aNd "%") aLlowed . . a0 sEt tO tErminating cHaracter . oR zEro iF eNd oF sTring eNcountered . oR -0,eRror mEssage iF iLlegal nAme eNcountered . a2 set tO nUmber oF cHaracters iN nAme . a4,a5 sEt tO fIeldata nAme (ljsf) . a3 sEt tO nEw sTring iNdex pUsh r1 fIeldata dl a4,(' ') ascii lr,u r1,12 eXtrflP. tg,h2 a3,0,a1 j eXtrfdN eX 4+lOads,a3 aa,u a3,1 tg,u a0,'a' tg,u a0,'z'+1 tz,u 0 ana,u a0,040 . uPper cAse la,u a2,0 tne,u a0,'-' fIeldata la,u a2,'-' ascii tne,u a0,'$' fieldata la,u a2,'$' ascii tnz r2 . aRe wIldcards aLlowed j 5+$ . nOpe tne,u a0,'*' fIeldAta la,u a2,'*' ascii tne,u a0,'%' fIeldAta la,u a2,'%' ascii tg,u a0,'A' tg,u a0,'Z'+1 tz,u 0 la,xu a2,-073 tg,u a0,'0' tg,u a0,'9'+1 tz,u 0 la,u a2,0,a0 jz a2,eXtrfiL tp a2 aa,u a2,0,a0 jgd r1,eXtrftm lna,u a0,1 lxm,u a0,$+2 j eXtrfx sTrng 'Too many characters in name...12 is maximum' +0 eXtrftm. ldsl a4,6 aa,u a5,0,a2 j eXtrflP eXtrfdN. la,u a0,0 eXtrfiL. la,u a2,12 jgd r1,2+$ j 4+$ ldsc a4,6 ana,u a2,1 j -4+$ eXtrfx. pOp r1 j 0,x11 eXtrnAme. tRy tO mAke aN eLement nAme oUt oF sTring aT (a0) pUsh x11,a0,a1,a2,a3,a4 l,h2 a1,0,a0 . no of characters . Gunnar aa,u a0,1 . Gunnar l,u a2,1+namestring . temp storage for orig string . Gunnar l,h1 a3,namestring . Gunnar lmj x11,unprefixify . Gunnar s,h2 a3,namestring . Gunnar l,u a0,namestring . Gunnar la,u a1,0,a0 . iNput sTring la,u a3,0 . iNput iNdex la,u a2,nAmeLt . eLement nAme dEstination la,u a4,0 . oUtput iNdex sz,h2 vErsioneLt . aSsume nO vErsion nAme sz,h2 nAmeLt . aSsume nO eLt nAme lmj x11,eXtrnM . gEt eLement nOp la,u a2,vErsioneLt la,u a4,0 eXtrnv. lmj x11,eXtrnM . gEt vErsion j 2+$ j eXtrnd . aLl dOne la,u a0,'$' dsc a3,36 tle,h1 a3,0,a2 ex 4+sTores,a3 aa,u a3,1 dsc a3,36 j eXtrnv eXtrnd. tz,h2 nAmeLt j eXtrnx la,u a0,nAmeLt la,u a1,qUotekErmit lmj x11,cOncat tz,h2 vErsioneLt j eXtrnx er tdAte$ lxi,u a0,0 lmj x11,tImetOasc. la,u a0,vErsioneLt la,u a1,asctIm sz,h2 0,a0 lmj x11,cOncat eXtrnx. pOp a4,a3,a2,a1,a0,x11 j 0,x11 eXtrnM. pUsh x11 eXtrnMa. tg,h2 a3,0,a1 j eXtrnM1 ex 4+lOads,a3 . gEt a0=cHaracter aa,u a3,1 lmj x11,eXtrnlEgal j eXtrnMi . iLlegal eXtrnMs. dsc a3,36 tle,u a3,0,a2 eX 4+sTores,a3 aa,u a3,1 dsc a3,36 tg,h1 a4,0,a2 la,h1 a4,0,a2 sa,h2 a4,0,a2 j eXtrnMa eXtrnMi. te,u a0,'.' tne,u a0,'/' j eXtrnM0 la,u a0,'$' j eXtrnMs eXtrnM1. pOp x11 j 1,x11 eXtrnM0. pOp x11 j 0,x11 eXtrnlEgal te,u a0,'$' tne,u a0,'-' j 1,x11 tg,u a0,'0' tg,u a0,'9'+1 tg,u a0,'A' tg,u a0,'Z'+1 tg,u a0,'a' tg,u a0,'z'+1 j 0,x11 j 1,x11 . . dOpfs. sEe iF eLement eXists aNd sEt pArtBl . a0 + aLl iS wEll . a0 - nO sUch eLement pUsh a1 lna,u a1,1 la,u a0,pfspKt er pfs$ la,u a0,0 tp a1 lna,u a0,1 pOp a1 j 0,x11 . oPensOurce. . a0 + aLl iS wEll . a0 - eRror mEssage hAs bEen pRinted pUsh x11,a1,a2,a3,a4,a5,r1,r2,r3 la a0,pfspKt+10 . fIle lOcation sa a0,fct+5 la,u a0,fct lmj x11,sdfio$ j oPnsRceRr sz,h2 sRcsTrng sz sRciNdx sz sRccHrcNt sz lInenUmber sz eLementeof la,u a0,0 oPnsRcx. pOp r3,r2,r1,a5,a4,a3,a2,a1,x11 j 0,x11 oPnsRceRr. tz a5 j oPnsRccOd la,u a0,4+$ lmj x11,pRipAr lna,u a0,1 j oPnsRcx sTrng 'Badly formatted element' +0 oPnsRccOd. sz,h2 pRlIne la a0,a5 la,u a2,8 la,u a1,2 lmj x11,bInasc la,u a0,pRlIne la,u a1,oPnsRcmSg lmj x11,cOncAt la,u a1,bInascrSlt lmj x11,cOncAt lmj x11,pRintsTring lna,u a0,1 j oPnsRcx oPnsRcmSg. sTrng 'I/O error attempting to open element. Status=' +0 . . tEstaCk. tEst iF aCk fOr tHis pAcket oR nAk fOr nExt pAcket . given . a0=pAcket tYpe . a1=pAcket nUmber . rEturn . +0 iF gOod aCk . +1 iF sOmething eLse te a1,n j $+4 te,u a0,'Y' j 1,x11 j 0,x11 te,u a0,'N' j tStaCka pUsh a2 la a2,n aa,u a2,1 lssl a2,30 ssl a2,30 te a1,a2 ax,u x11,1 pOp a2 j 0,x11 tStaCka. te,u a0,'Y' j 1,x11 pUsh x11,a1 la,u a1,1000 er twAit$ lmj x11,tImedrEdpUr . pUrge iNput pOp a1,x11 j 1,x11 asctOfd. tRanslate uP tO 12 cHaracters oF sTring (a0) . aNd pUt rEsult iN a4,a5 (ljsf). pUsh x11,a0,a1,a3,r1 la,u a3,0 la,u a1,0,a0 lr,u r1,11 asctOfdlP. tg,h2 a3,0,a1 j asctOffL eX 4+lOads,a3 aa,u a3,1 lx,u x11,0,a1 aNd,u a0,0177 la a0,a1 la,u a1,0,x11 la,h1 a0,ascfdasc$,a0 ldsl a4,6 aa a5,a0 jgd r1,asctOfdlP j asctOfdx asctOffL. ldsl a4,6 aa,u a5,5 jgd r1,-2+$ asctOfdx. pOp r1,a3,a1,a0,x11 j 0,x11 fdtOasc. aPpend tHe nOn-bLank cHaracters in a4,a5 tO sTring (a0). pUsh a0,a2,a3,a4,a5 la,u a2,0,a0 la,h2 a3,0,a2 lxi,u a3,1 fdtOasclP. la a0,a4 ldsl a4,6 aa,u a5,5 ssl a0,30 tne,u a0,5 j fdtOasctSt la,h2 a0,ascfdasc$,a0 . tRanslate to ascii tg,h1 a3,0,a2 eX 4+stores,*a3 fdtOasctSt. dte a4,(+050505050505050505050505d) j fdtOasclP sa,h2 a3,0,a2 pOp a5,a4,a3,a2,a0 j 0,x11 /. ioeRror. gIven i/o eRror cOde iN a0, pRoduce eRror mEssage aT ioeRrmSg. pUsh x11,a0,a1,a2 sz,h2 ioeRrmSg la,u a2,8 la,u a1,3 lmj x11,bInaSc la,u a0,ioeRrmSg la,u a1,ioeRrmSgsKl lmj x11,cOncat la,u a1,bInascrSlt lmj x11,cOncat pOp a2,a1,a0,x11 j 0,x11 ioeRrmsg. sTrng ' ' ioeRrmSgsKl. sTrng 'File I/O error (in octal)= ' pfeRror. a0=pRogram fIle eRror cOde pUsh x11,a0,a1,a2 sz,h2 pfeRrmSg la,u a2,8 la,u a1,3 lmj x11,bInasc la,u a0,pfeRrmSg la,u a1,pfeRrmSgsKl lmj x11,cOncAt la,u a1,bInascrSlt lmj x11,cOncat pOp a2,a1,a0,x11 j 0,x11 pfeRrmSg. sTrng ' ' pfeRrmSgsKl. sTrng 'Element file error code (octal) = ' eRrpRnt. pRint aNy oUtsTanding mEssages pUsh x11,a0 la,u a0,ioeRrmSg lmj x11,eRrpRnta la,u a0,pfeRrmSg lmj x11,eRrpRnta la,u a0,tImoUtmSg lmj x11,eRrpRnta la,u a0,bAdbInmSg lmj x11,eRrpRnta la,u a0,cMpltmSg lmj x11,eRrpRnta pOp a0,x11 j 0,x11 eRrpRnta. pUsh x11 tz,h2 0,a0 lmj x11,pRintsTring sz,h2 0,a0 pOp x11 j 0,x11 cLreRrmSg. cLear oUt aLl eRror mEssages sz,h2 ioeRrmSg sz,h2 pfeRrmSg sz,h2 tImoUtmSg sz,h2 bAdbInmSg sz,h2 cMpltmSg j 0,x11 /. . . . ****************************************************************************** . . rfIle rfIle rfIle rfIle rfIle rfIle rfIle rfIle rfIle . . rEceive fIle hEader . . ****************************************************************************** rfILe. pUsh x11,a1,a2,a3 la a0,nUmtRy aa,u a0,1 sa a0,nUmtRy tg a0,mAxtRy j rfIlea la,u a2,pAcket lmj x11,rpAck te,u a0,'S' j rfIletz la a0,oLdtRy aa,u a0,1 sa a0,oLdtRy tg a0,mAxtRy j rfIlea la a2,n la,u a3,63 jz a2,2+$ anu,u a2,1 te a1,a3 j rfIlea la,u a0,pAcket lmj x11,spAr la,u a0,'Y' la,u a2,pAcket lmj x11,spAck sz nUmtRy j rfIlest . sTay iN sAme sTate rfIletz. te,u a0,'Z' j rfIletf la a0,oLdtRy aa,u a0,1 sa a0,oLdtRy tg a0,mAxtRy j rfIlea la a2,n la,u a3,077 jz a2,2+$ anu,u a2,1 te a1,a3 j rfIlea la,u a0,'Y' la,u a2,pRlIne sz,h2 0,a2 lmj x11,spAck sz nUmtRy j rfIlest . sTay iN tHis sTate rfIletf. te,u a0,'F' j rfIletb te a1,n j rfIlea la,u a0,pAcket lmj x11,gEtfIl te,u a0,tRue j rfIlea la,u a0,'Y' la a1,n la,u a2,pRline sz,h2 0,a2 lmj x11,spAck la a0,nUmtRy sa a0,oLdtRy sz nUmtRy la a0,n aa,u a0,1 sa,s6 a0,n la,u a0,'D' j rfILex rfIletb. te,u a0,'B' j rfIletfL te a1,n j rfIlea la,u a0,'Y' la a1,n la,u a2,pRlIne sz,h2 0,a2 lmj x11,spAck la,u a0,'C' j rfIlex rfIletfL. te,u a0,fAlse j rfIlea la,u a0,'N' la,u a2,pAcket sz,h2 0,a2 la a1,n lmj x11,spAck j rfIlesT rfIlea. la,u a0,'A' j rfIlex rfIlest. la a0,sTate rfIlex. pOp a3,a2,a1,x11 j 0,x11 /. . . . ****************************************************************************** . . sfIle sfIle sFile sFile sfIle sfILe sfIle sfIle sfIle . . sEnd fIle hEader aNd rEad fIrst pAcket oF dAta fRom fIle . . ****************************************************************************** sfILe. pUsh x11,a1,a2 la,u a0,'A' la a1,nUmtRy aa,u a1,1 tg a1,mAxtRy j sfIlex sa a1,nUmtRy sz,h2 pRlIne dl a4,eLementnAme la,u a0,pRlIne lmj x11,fdtOasc la,u a1,qUoterpOint lmj x11,cOncAt dl a4,vErsionnAme lmj x11,fdtOasc la,u a2,pRlIne la,u a0,'F' la a1,n lmj x11,spAck la,u a2,rEcpKt lmj x11,rpAck lmj x11,tEstaCk j sfIley la a0,sTate j sfIlex sfIley. sz nUmtRy la a0,n aa,u a0,1 aNd,u a0,077 sa a1,n la,u a0,pAcket lmj x11,bUfIll sa a0,sIze la,u a0,'D' sfIlex. pOp a2,a1,x11 j 0,x11 qUoterpOint. sTRng '.' /. . . . ****************************************************************************** . . bUfeMp bUfeMp bUfeMp bUfeMp bUfeMp bUfeMp bUfeMp bUfeMp . . gIven a0 = a bUffer......eMpty iT iNto dIsk fILe . . ****************************************************************************** bUfeMp. . gEnerally . a1=sOurce bUffer sTart aDdress . sOurce = cOunted sTring . a2=dEstination bUffer sTart aDdress . a3=sOurce cHaracter iNdex . a4=1,dEstination cHaracter iNdex . a5=1,mAximum dEstination cHaracter iNdex . r1=rEpeat cOunt . r2=bIt 8 pRefix . pUsh x8,x9,x11,a0,a1,a2,a3,a4,a5,r1,r2 la a1,cUrrqUote . rEceive qUote cHaracter tOp,u a1,0200 aa,u a1,0200 sa a1,rqUotep128 . rqUote wIth bIt 7 sEt la a1,tYpe+1 la a1,2,a1 . gEt fIle tYpe tne a1,('BINA') j bUfeMpbIn . jUmp iF bInary fIle tYpe la,u a1,0,a0 la a3,lEngth+1 . sEt a5 tO tHe mAximum nUmber oF lxi,u a3,1 . cHaracters pEr lIne tO bE wRitten la a5,a3 . tO tHe oUtput eLement la a3,eLtiNdex lxi,u a3,1 la a4,a3 la,u a3,0 la,u a2,eLtbUffer bUfeMplP. tg,h2 a3,0,a1 j bUfeMpdN ex 4+lOads,a3 aa,u a3,1 lr,u r1,1 . rEpeat cOunt te a0,cUrrEpt . iS a0=rEpeat cHaracter j bUfempt8 tg,h2 a3,0,a1 j bUfeMpsTr . sTore rEpeat aS dAta..wHat eLse? ex 4+lOads,a3 aa,u a3,1 lmj x11,uNcHar lr r1,a0 . aCtual rEpeat cOunt tg,h2 a3,0,a1 ana,u a3,1 . gArbage iN...gArbage oUt eX 4+lOads,a3 aa,u a3,1 bUfeMpt8. tEst fOr 8 bIt pRefix cHaracter lr,u r2,0 . aSsume nO pRefix te a0,cUrqbIn . cHeck iF 8 bIt qUote j bUfeMptQ . gO cHeck fOr cOntrol qUote lr,u r2,0200 . seT 8 bIt pRefix tg,h2 a3,0,a1 ana,u a3,1 . gArnbage iN...gArbage oUt eX 4+lOads,a3 aa,u a3,1 bUfeMptq. tEst fOr cOntrol qUote te a0,cUrrqUote j bUfeMpsTr . gO sTore tHe cHaracters tg,h2 a3,0,a1 ana,u a3,1 . gArbage iN...gArbage oUt eX 4+lOads,a3 aa,u a3,1 te a0,cUrrqUote tNe a0,rqUotep128 j bUfeMpsTr te a0,cUrrEpt tne a0,cUrrEpt128 j bUfeMpsTr tne a0,cUrqbIn j bUfeMpsTr lmj x11,cTl bUfeMpsTr. sTore r1 cOpies oF cHaracter a0+r2 top a0,r2 aa a0,r2 . aDD 8 bIt pRefix j 2+$ lmj x8,pUteLtcHr jgd r1,$-1 j bUfeMplP bUfeMpdN. sa a4,eLtiNdex pOp r2,r1,a5,a4,a3,a2,a1,a0,x11,x9,x8 j 0,x11 . pUteLtcHr. . sTore tHe cHaracter iN a0...cHecking fOr eNd oF lIne . rEturn tO x8 . dEstroys x9,x11 tz rCvsTate j pUteLtcHr1 te,u a0,012 tne,u a0,015 j pUteLtcHr2 lmj x9,sToreeLtcHr j 0,x8 pUteLtcHr1. pRevious cHaracter wAs a or te,u a0,012 . cHeck fOr tne,u a0,015 . cHeck for j $+2 j pUteLtcHr3 . mAybe eNd oF lIne tne a0,rCvsTate j pUteLtcHr4 . iT iS eNd oF lIne lmj x11,wRteLt nOp sz rCvsTate j 0,x8 pUteLtcHr2. tHis iS a oR ...rEmember tHat sa a0,rCvsTate j 0,x8 pUteLtcHr3. oR nOt...rEpeat nOt...fOllowed by oR pUsh a0 la a0,rCvsTate lmj x9,sToreeLtcHr pop a0 lmj x9,sToreeLtcHr sz rCvsTate j 0,x8 pUteLtcHr4. lmj x9,sToreeLtcHr j 0,x8 sToreeLtcHr. sTore a cHaracter iNto eLement lIne bUffer...nO cHecks . x9=rEturn . dEstroys x11 tle a4,a5 . iS tHere rOom fOr a cHaracter? j sToreeLtcHra . yEs... tnz cOntinue+1 . iS a cOntinuation cHaracter sPecified j sToreeLtcHrb . nOpe . wE hAve tO rEmove tHe lAst cHaracter fRom tHe cUrrent lIne, . rEplace iT wIth tHe cOntinuation cHaracter, aNd . mOve tHe rEmoved cHaracter aLong wIth tHe cUrrent cHaracter . tO tHe nExt lIne. dsc a3,36 dsc a1,36 ana,u a3,1 . bAck uP oNe cHaracter pUsh a0 . sAve cUrrent cHaracter ex lOads,a3 . gEt lAst cHaracter oN fUll lIne dsc a1,36 pUsh a0 . sAve fIrst cHaracter fOr nExt lIne la a0,cOntinue+1 . gEt cOntinuation cHaracter eX sTores,*a3 . pUt aT eNd oF lIne tHat oVerflowed dsc a3,36 lmj x11,wRteLt . wRite lIne tO eLement nOp . eRror rEturn pOp a0 . cHar pReviously aT eNd oF lIne dsc a3,36 eX sTores,*a3 dsc a3,36 pOp a0 . cUrrent cHaracter j sToreeLtcHra . pRoceed tO sTore cUrrent cHaracter sToreeLtcHrb. lmj x11,wRteLt . wRite cUrrent lIne tO eLement nOp sToreeLtcHra. dsc a3,36 ex sTores,*a3 dsc a3,36 j 0,x9 . dOne bUfeMpbIn. bInary fIle tYpe...cOpy pAcket "aS iS"...nO tRanslation, nO qUotes. la,u a1,0,a0 . sOurce bUffer sTart aDdress la,u a2,eLtbUffer . dEstination bUffer sTart aDdress la a3,(+1,0) . dEstination cHaracter iNdex la,h2 a4,0,a1 dsl a4,36 . cOnvert cHaracter cOunt tO ascii di,u a4,10 aa,u a4,'0' aa,u a5,'0' la a0,a4 ex sTores,*a3 la a0,a5 ex sTores,*a3 la a4,a3 la,u a3,0 . sOurce cHaracter iNdex bUfeMpbInlP. tg,h2 a3,0,a1 j bUfeMpbIndN eX 4+lOads,a3 aa,u a3,1 dsc a3,36 ex sTores,*a3 dsc a3,36 j bUfeMpbInlP bUfeMpbIndN. lmj x11,wRteLt nOP j bUfeMpdN wRteLt. rEturn +1 iF ok aNd +0 iF eRror pUsh x11,a0,a1,a2,a3,a5,r1,r2,r3 dsc a3,36 and,u a3,3 jz a4,4+$ la,u a0,' ' ex sTores,*a3 j -4+$ la a0,a3 lxi,u a0,0 ssl a0,2 lxi,u a0,0,a0 lxm,u a0,eLtbUffer lmj x11,sOrasca$ j wRteLteRr la a0,8,x10 aa,u a0,1 sa a0,8,x10 wRteLteRr. wRteLtx. pOp r3,r2,r1,a5,a3,a2,a1,a0,x11 la a4,(+1,0) j 0,x11 bUfeMpeof. iNsure tHat lAst lIne iS wRitten tO fIle. tnz,h2 eLtiNdex j 0,x11 pUsh x11,a2,a3,a4 la a3,eLtiNdex la,u a2,eLtbUffer lxi,u a3,1 la a4,a3 lmj x11,wRteLt noP sa a4,eLtiNdex pOp a4,a3,a2,x11 j 0,x11 /. . . . ****************************************************************************** . . bUfIll bUfIll bUfIll bUfIll bUfIll bUfIll bUfIll bUfILL . . rEturns a0=# cHaracters (oR nEgative iF eNd-oF-fIle) . . ****************************************************************************** bUfIll. pUsh x11,a1,a2,a3,a4,a5,r1,r2,r3 la a1,sqUote+1 top,u a1,0200 aa,u a1,0200 sa a1,sqUotep128 . sqUote pLus bIt 7 sEt la a1,cUrrEpt jz a1,$+3 top,u a1,0200 aa,u a1,0200 sa a1,cUrrEpt128 la a1,tYpe+1 la a1,2,a1 tne a1,('BINA') j bUfiLlbIn la a5,(+1,0) aa a5,cUrspAklEn ana,u a5,8 lr r2,sRccHrcNt lx x11,eltiNdex la,u a1,eLtbUffer la,u a2,0,a0 lxi,u x11,1 la a3,(+1,0) bUfIllOop. jgd r2,2+$ j bUfIllmOre eX lOads,*x11 tz cUrrEpt lmj x9,bUfiLlrPt . cHeck fOr rEpeated cHaracters tep,u a0,0400 . lImit tO 8 bIts ana,u a0,0400 tz cUrqbIn j bUfiLlt8 la a4,1+wIdth te,u a4,8 top,u a0,0200 tz,u 0 ana,u a0,0200 j bUfiLlc bUfiLlt8. top,u a0,0200 j bUfiLlc la a4,a0 la a0,cUrqbIn eX 4+sTores,*a3 la a0,a4 ana,u a0,0200 bUfiLlc. tnz cNtrltYpes,a0 . cHeck iF cOntrol cHaracter j bUfIlltq la a4,a0 la a0,sqUote+1 eX 4+sTores,*a3 la a0,a4 sx x11,a4 lmj x11,cTl lx x11,a4 j bUfIllsc bUfIlltq. te a0,sqUote+1 tne a0,sqUotep128 j bUfIllqT te a0,cUrrEpt tne a0,cUrrEpt128 j bUfIllqT te a0,cUrqbIn j bUfIllsc bUfIllqT. la a4,a0 la a0,sqUote+1 eX 4+sTores,*a3 la a0,a4 bUfIllsc. eX 4+sTores,*a3 bUfiLltf. tle a3,a5 j bUfiLlOop j bUfIllxIt bUfIllmOre. tz eLementeof j bUfIllxIt la a0,lInenUmber aa,u a0,1 sa a0,lInenUmber tne,u a0,1 j bUfIllmr la a0,sqUote+1 eX 4+sTores,*a3 la,u a0,0115 eX 4+sTores,*a3 la a0,sqUote+1 eX 4+sTores,*a3 la,u a0,0112 ex 4+sTores,*a3 bUfIllmr. pUsh a2,a3,a5 bUfIllrEad. la a0,(+mAxeLtlInsIz,eLtbUffer) lmj x11,gEtascii j bUfIlleRr j bUfIlleof jn a1,bUfIllrEad ssl a1,24 tg,u a1,mAxeLtlInsIz la,u a1,mAxeLtlInsIz msi,u a1,4 lr,u r2,0,a1 lx x11,(+1,0) pOp a5,a3,a2 la,u a1,eLtbUffer j bUfIlltf bUfIlleRr. bUfIlleof. pOp a5,a3,a2 lna,u a0,1 sa a0,eLementeof bUfIllxIt. la,u a0,0,a3 . # cHaracters sa,h2 a0,0,a2 sr r2,sRccHrcNt sx x11,eltiNdex tnz a0 lna,u a0,1 . eOf sTatus bUfiLlrEt. pOp r3,r2,r1,a5,a4,a3,a2,a1,x11 j 0,x11 . bUfiLlrPt. cHeck fOr rEpeated cHaracters . x9=rEturn . dEstroys x8,a4,r1,r3 lr r3,a0 . sAve cHaracter fOr cOmpare la,u a4,1 . oNly oNe rEpetition sO fAr lr r1,r2 . tEmporary iNput cOunt lx x8,x11 . tEmporary iNput iNdex bUfiLlrPtlP. tnz r1 . aNy cHaracters lEft j bUfiLlrPtt . nO...cHeck tHreshold eX lOads,x8 te a0,r3 . sAme cHaracter aGain? j bUfIllrPtt . nO...dIfferent aa,u a4,1 . iNcrement rEpeat cOunt ax,u x8,1 . iNcrement iNdex jgd r1,$+2 . dEcrement cOunt er eRr$ . cAn't hAppen...I hOpe tle,u a4,94 . rOom fOr mOre? j bUfiLlrPtlP . kEep lOoking bUfiLlrPtt. tEst tHreshold vAlue tle,u a4,4 j bUfiLlrPtx . nOt eNough tO wOrry aBout la a0,cUrrEpt . cUrrent rEpeat pRefix eX 4+sTores,*a3 la a0,a4 lmj x11,tOcHar . eX 4+sTores,*a3 . rEpeat cOunt lr r2,r1 . nEw iNput cOunt lx x11,x8 . nEw iNput iNdex bUfiLlrPtx. aLl dOne la a0,r3 . rEstore a0=cHaracter j 0,x9 . . bUfiLlbIn. la a3,(+1,0) . dEstination cHaracter iNdex la,u a2,0,a0 . dEstination bUffer aDdress tz sRccHrcNt j bUfiLlbIna . fIrst iMage rEad bY fIle oPen bUfiLlbInrD. pUsh a2,a3,a5 bUfIllbInrDa. la a0,(+mAxeLtlInsIz,eLtbUffer) lmj x11,gEtascii j bUfiLlbIneRr j bUfiLlbIneof jn a1,bUfiLlbInrDa ssl a1,24 tg,u a1,mAxeLtlInsIz la,u a1,mAxeLtlInsIz msi,u a1,4 sa a1,sRccHrcNt bUfiLlbIna. la a1,sRccHrcNt lx x11,(+1,0) . sOurce cHaracter iNdex tle,u a1,2 . mUst bE aT lEaste 2 cHaracters j bUfiLlbInbAd . eRror iN dAta ana,u a1,1 lr,u r2,0,a1 la,u a1,eLtbUffer ex lOads,*x11 . cOnvert cHaracter cOunt tO bInary tg,u a0,'0' tg,u a0,'9'+1 j bUfiLlbInbAd ana,u a0,'0' msi,u a0,10 la,u a5,0,a0 ex lOads,*x11 tg,u a0,'0' tg,u a0,'9'+1 j bUfiLlbInbAd ana,u a0,'0' aa,u a5,0,a0 . # cHar sUpposed tO bE iN lIne tg a5,r2 j bUfiLlbInbAd . nOt eNough cHaracters lr r2,a5 pOp a5,a3,a2 bUfiLlbInlP. jgd r2,$+2 j bUfiLlbIndOn eX lOads,*x11 eX sTores+4,*a3 jgd r2,$-2 bUfiLlbIndOn. la,u a0,0,a3 . # cHaracters sa,h2 a0,0,a2 . tO sTring dEscriptor sz sRccHrcNt j bUfiLlrEt bUfiLLbIneof. pOp a5,a3,a2 sz,h2 0,a2 lna,u a0,1 . iNdicate eof sTatus sa a0,eLementeof j bUfiLlrEt bUfiLlbIneRr. j bUfiLlbIneof bUfiLlbInbAd. la,h1 a0,bAdbInmSg sa,h2 a0,bAdbInmsg j bUfiLlbIneof /. gEtascii. . uSed tO cAll gEtas$ aNd fOrced pAss tWo tO . aVoid iT's iNsisting oN cOrrection cArds. tHat dIdn't . wOrk wEll wHen tHe eLement wAs nOt "pErfectly sdff fOrmated". . sO nOw i dO iT tHe hArd wAy. . . la a0,(+mAx # wOrds,bUffer aDdress) . lmj x11,gEtascii . eRror rEturn (sdfi sTatus) . eof rEturn . nOrmal rEturn . dEstroys mInor rEgister sEt pUsh x11,a0 . gEtasciirPt. la,u a0,fct lmj x11,sdfi$ j gEtasciieRr j gEtasciieof j gEtasciinOr gEtasciieOf. pOp a0,x11 j 1,x11 . eNd oF fIle rEturn gEtasciieRr. pOp a0,x11 j 0,x11 . eRror rEturn...a5=error cOde fRom i/o gEtasciinOr. la a1,fct+10 . iMage cw jn a1,gEtasciicw . cOntrol iMage la,s3 a0,sdflAbelcw . sdf eLement lAbel te,u a0,030 . fIeldAta 's' j gEtasciincYc . nO cYcling tz,s4 fct+10 . j gEtasciirPt . dEleted iMage gEtasciincYc. la a1,lAsttYpecw . lAst cw tHat sPecifed cHaracter cOde top,u a1,1 . iS iT ascii j gEtasciifd . nope... pOp a0 pUsh a0 la a4,a0 ssl a4,18 . wOrd cOunt rEquested ssl a1,24 . aCtual wOrd cOunt tg a4,a1 sa a1,a4 . gEt tHe sMaller oF tHe tWo lr r1,a4 lxi,u a0,1 la a1,(+1,sdfibUffer) bt a0,0,*a1 . mOve the ascii iMage pop a0,x11 la,u a0,1 la a1,fct+10 j 2,x11 . nOrmal rEturn gEtasciifd. pOp a0 pUsh a0 la a2,a0 ssl a0,18 lssl a0,2 . mAx nUmber ascii cHaracters dsl a0,36 di,u a0,6 . mAx nUmber fIeldAta wOrds la a4,fct+10 ssl a4,24 tg a0,a4 la a0,a4 lxi,u a2,0 . oUtput bUffer aDdress la,u a1,sdfibUffer . iNput bUffer aDdress lmj x11,fdasc$ la a1,fct+10 lssl a1,12 . dIscard wOrd cOunt dsl a0,12 . bUild nEw cw la,u a0,1 pOp x11,x11 . dIscard oLd a0 j 2,x11 . nOrmal rEturn gEtasciicw. la,s1 a0,fct+10 te,u a0,050 j gEtasciin50 . THe fOllowing dEleted bEcause oF pRoblem rEported bY . Frithjov Iverson of Trondheim University Computing Center. . I dIdn't kNow wHat I wAs dOing wHen I fIrst iMplemented tHis...I cOuld . fInd nO dEscription oF SDF aNd hAd tO pLay iT bY eAr. Frithjov . sAys tHat a 'S' iN s3 is sUfficient. SO hEre wE gO.\ . la,s3 a0,fct+10 . tne,u a0,030 . iS iT s . la a0,sdfibUffer . te a0,(0503011131350) . check for *sdff* . sz,s3 fct+10 . clear s in label la a0,fct+10 sa a0,lAsttYpecw sa a0,sdflAbelcw j gEtasciirPt gEtasciin50. te,u a0,042 j gEtasciirPt la a0,fct+10 sa a0,lAsttYpecw j gEtasciirPt /. . . . ****************************************************************************** . . rEcsW rEcsW rEcsW rEcsW rEcsW rEcsW rEcsW rEcsW rEcsw . . sTate tAble sWitcher fOr rEceiving fIles . rEturns a0 + aLl iS wEll . a0 - iF eRror oCcurs bEfore tRansfer cOmplete . . ****************************************************************************** rEcsw. pUsh x11,r1 la,u a0,'R' . iNitial rEceive sTate sa a0,sTate sz n . iNitial pAcket nUmber sz nUmtRy . eRror rEtry cOunt rEcsWlOop. la a0,sTate lx x11,(+1,rEcsWa-1) lr,u r1,rEcsWn se,h1 a0,1,*x11 nOp lx x11,0,x11 lmj x11,0,x11 sa a0,sTate j rEcsWlOop rEcsWa. 'D',rdAta 'F',rfIle 'R',riNit 'C',rEcsWtRue 'A',rEcsWfAlse 0,rEcsWfAlse rEcsWn eQu -1-rEcsWa+$ rEcsWfAlse. push a1 . Gunnar la a0,options . Gunnar and a0,(1*/('Z'-'R')) . Gunnar jz a1,$+4 . Gunnar la a0,partbl+32 . receive failed and r-option . Gunnar or a0,(0400000,0) . so set deleted bit . Gunnar sa a1,partbl+32 . Gunnar pop a1 . Gunnar la,u a0,fAlse j rEcsWx rEcsWtRue. la,u a0,tRue rEcsWx. tz oPeneLt lmj x11,esOr$ sz oPenelt pOp r1,x11 j 0,x11 /. . . . ****************************************************************************** . . sEndsW sEndsW sEndsW sEndsW sEndsW sEndsW sEndsW sEndsW sEndsW . . sTate tAble sWitcher fOr sEnding fIles. . rEturns a0 + aLl iS wEll . a0 - iF eRror bEfore tRansfer cOmplete . . ****************************************************************************** sEndsW. pUsh x11,r1 la,u a0,'S' sa a0,sTate . iNitial sTate sz n pAcket nUmber sz nUmtRy . eRror rEtry cOunt sEndsWlOop. la a0,sTate lx x11,(+1,sEndsWa-1) lr,u r1,sEndsWn se,h1 a0,1,*x11 noP lx x11,0,x11 lmj x11,0,x11 sa a0,sTate j sEndsWlOop sEndsWa. +'D',sdAta +'F',sfIle +'Z',seof +'S',siNit +'B',sbReak +'C',sEndsWtRue +'A',sEndsWfAlse +0,sEndsWfAlse . dEfault sEndsWn eQu -1+$-sEndsWa sEndsWfAlse. lna,u a0,fAlse sEndsWx. pOp r1,x11 j 0,x11 sEndsWtRue. la,u a0,tRue j sEndsWx /. . . . ****************************************************************************** . . SERVSW SERVSW SERVSW SERVSW SERVSW SERVSW SERVSW SERVSW SERVSW . . STATE TABLE SWITCHER FOR SERVER MODE . RETURNS A0 + ALL IS WELL . A0 - IF ERROR OCCURS BEFORE TRANSFER COMPLETE . . ****************************************************************************** SERVSW. PUSH X11,R1 LA,U A0,'V' . INITIAL SERVER STATE SA A0,STATE SZ N . INITIAL PACKET NUMBER SZ NUMTRY . ERROR RETRY COUNT SERVSWLOOP. LA A0,STATE LX X11,(+1,SERVSWA-1) LR,U R1,SERVSWN SE,H1 A0,1,*X11 NOP LX X11,0,X11 LMJ X11,0,X11 J SERVSWLOOP SERVSWA. 'V',SERVEREAD . 'V' IS ARBRITARY ANY LETTER WILL DO 'R',SERVERSEND . THEY WANT TO RECEIVE A FILE 'S',sErvrEc . THEY WANT TO SEND A FILE 'G',SERVGCODE . SERVER COMMAND 'I',SERVICODE . SERVER I PACKET 'C',SERVSWCONT . COMPLETE - CONTINUE +0,SERVSWCONT . DON'T LET THEM GET AWAY SERVSWN EQU -1-SERVSWA+$ SERVSWCONT. LA,U A0,'V' . INITIAL SERVER STATE SA A0,STATE SZ N . INITIAL PACKET NUMBER SZ NUMTRY . ERROR RETRY COUNT J SERVSWLOOP . . sErvrEc. sTart rEceiving fIles pUsh x11,a0,a1,a2 la,u a0,'N' . sEnd a naK..fOrce la,u a2,pAcket . rEmote tO rEsend tHe sz,h2 0,a2 . 's' pAcket. oDd wAy la a1,n . tO dO tHings bUt iT wOrks. lmj x11,spAck pOp a2,a1,a0,x11 j rEcsW /. . . ****************************************************************************** . . SERVERSEND SERVERSEND SERVERSEND SERVERSEND SERVERSEND SERVERSEND . . ****************************************************************************** . SERVERSEND. PUSH x11,a0,A1,A2,A3,A4,A5,r1,r2,r3 sz npAsses la,u a0,bspfct lmj x11,rfti$ j 4+$ la,u a0,bspfct la a1,(bspbUf,1792) lmj x11,rpfet$ j sErverfeRR fIeldAta dl a4,(' ') ascii ds a4,vErsionnAme la,u a1,pAcket la,u a3,0 lmj x11,eXtrev jn a0,sErversNde ds a4,eLementnAme jz a0,sErversNdbEg te,u a0,'.' tne,u a0,'/' j sErversNdvEr la,u a0,2+$ j sErversNde sTrng 'Illegal character in element/version name' sErversNdvEr. lmj x11,eXtrev jn a0,sErversNde ds a4,vErsionnAme sErversNdbEg. dl a4,eLementnAme ds a4,wIldeLt dl a4,vErsionnAme ds a4,wIldvEr . LMJ X11,WILDCARDNAM . GET A FILE NAME J SERVERSNDOE . NO FIND IN THIS FILE J SERVWILDEXIT . END OF WILDCARD SEND J SERVERSTRT . GO TO IT SERVERSTRT. LMJ X11,DOPFS JP A0,SERVEROPN LA,U A0,SERVOPNERR1 J SERVERSNDE SERVOPNERR1. STRNG 'There is no such symbolic element.' SERVEROPN. LMJ X11,CLRERRMSG LMJ X11,OPENSOURCE JN A0,SERVERSNDOE LMJ X11,SENDSW TE,U A0,TRUE J SERVERSNDSE SERVWILDEXIT. POP r3,r2,r1,a5,A4,A3,A2,a1,a0,X11 LA,U A0,'C' SA A0,STATE J 0,X11 sErverfeRr. la,u a0,2+$ j sErvErsNde sTrng 'Error opening 1100 file table of contents' SERVERSNDOE. LA,U A0,SERVOPNERR2 J SERVERSNDE SERVOPNERR2. STRNG 'Cannot open the symbolic element.' SERVERSNDSE. LA,U A0,SERVOPNERR3 J SERVERSNDE SERVOPNERR3. STRNG 'Send error.' SERVERSNDE. SA A0,A2 LA,U A0,'E' LA A1,N LMJ X11,SPACK LA A0,N AA,U A0,1 SA,S6 A0,N POP r3,r2,r2,,A4,A3,A2,a1,a0,X11 LA,U A0,'C' . DO NOT ABORT THE SERVER SA A0,STATE J 0,X11 /. . . ****************************************************************************** . . SERVGCODE SERVGCODE SERVGCODE SERVGCODE SERVGCODE SERVGCODE . . ****************************************************************************** . SERVGCODE. PUSH A1,X11 LA,U A0,PACKET LA,Q1 A0,1,A0 LA A1,(' ') DSC A0,9 TE A1,('L ') J 2+$ J SRVLOGOUT TE A1,('F ') J 2+$ J SRVFINISH . LA,U A0,'E' LA A1,N LA,U A2,SERVERGERR LMJ X11,SPACK LA A0,N AA,U A0,1 SA,S6 A0,N LA,U A0,'C' SA A0,STATE POP X11,A1 J 0,X11 SERVERGERR. STRNG 'SERVER - Unknown G packet type' SRVFINISH. LA,U A0,FALSE SA A0,LOGOUTFLAG . DON'T LOG THEM OUT J SERVERGX SRVLOGOUT. LA,U A0,TRUE SA A0,LOGOUTFLAG . LOG THEM OUT SERVERGX. LA,U A0,'Y' . ACK IT LA A1,N LA,U A2,PACKET LMJ X11,SPACK LA A0,N AA,U A0,1 SA,S6 A0,N LA,U A0,TRUE POP X11,A1 . TZ OPENELT LMJ X11,ESOR$ SZ OPENELT POP R1,X11 J 0,X11 . /. . . ****************************************************************************** . . SERVICODE SERVICODE SERVICODE SERVICODE SERVICODE SERVICODE . . PROCESS THE I PACKET SENT . . ****************************************************************************** . SERVICODE. PUSH A1,A2,X11 LA,U A0,PACKET LA,U A1,0 LMJ X11,RPAR la a0,hIsqbIn . hIs 8 bIt qUote cHaracter la,u a1,'N' . aSsume nO 8 bIt qUoteing tg,u a0,33 tg,u a0,63 tg,u a0,96 tg,u a0,127 j 3+$ la a1,a0 j 6+$ te,u a0,'Y' j 4+$ la a0,wIdth+1 te,u a0,8 la,u a1,'&' . la a0,qUote8+1 la a0,2,a0 tne a0,('OFF ') la,u a1,'N' sa a1,mYqbIn tne,u a1,'N' la,u a1,0 sa a1,cUrqbIn la,u a1,'N' la a0,hIsrEpt . hIs rEpeat cHaracter tg,u a0,33 tg,u a0,63 tg,u a0,96 tg,u a0,127 j 2+$ la a1,a0 la a0,rEpeat+1 la a0,2,a0 tne a0,('OFF ') la,u a1,'N' sa a1,mYrEpt tne,u a1,'N' la,u a1,0 sa a1,cUrrEpt la,u a0,pAcket LMJ X11,SPAR LA,U A0,'Y' LA A1,N LA,U A2,PACKET LMJ X11,SPACK LA A0,NUMTRY SA A0,OLDTRY SZ NUMTRY LA A0,N AA,U A0,1 SA,S6 A0,N LA,U A0,'C' SA A0,STATE POP X11,A2,A1 J 0,X11 /. . . . ****************************************************************************** . . SERVEREAD SERVEREAD SERVEREAD SERVEREAD SERVEREAD SERVEREAD . . READ SERVER COMMANDS . . ****************************************************************************** SERVEREAD. PUSH X11,A1,A2 sErverEada. LA,U A2,PACKET LMJ X11,RPACK TNZ A0 . TEST FOR TIME OUTS J sErverEada . IGNORE THEM TE,U A0,'S' . DO THEY WANT TO SEND J 2+$ J SERVERCMD TE,U A0,'R' . DO THEY WANT TO RECEIVE J 2+$ J SERVERCMD TE,U A0,'I' . I PACKET J 2+$ J SERVERCMD TE,U A0,'G' . DO THEY WANT US TO LOGOUT J SERVERV SERVERCMD. SA A0,STATE LA A0,STATE POP A2,A1,X11 J 0,X11 SERVERV. LA,U A0,'E' LA A1,N LA,U A2,SERVERVMSG LMJ X11,SPACK LA A0,N AA,U A0,1 SA,S6 A0,N LA,U A0,'C' J SERVERCMD SERVERVMSG. STRNG 'Unimplemented server command' . . . ****************************************************************************** . . rdAta rdAta rdAta rdAta rdAta rdAta rdAta rdAta rdAta . . ****************************************************************************** rdAta. pUsh x11,a1,a2,a3,a4,a5,r1,r2,r3 la a0,nUmtRy aa,u a0,1 sa a0,nUmtRy tg a0,mAxtRy j rdAtatImoUt la,u a2,pAcket lmj x11,rpAck te,u a0,'D' j rdAtatf tne a1,n j rdAtad1 la a0,oLdtRy aa,u a0,1 sa a0,oLdtRy tg a0,mAxtRy j rdAtaa la a0,n ana,u a0,1 jp a0,2+$ la,u a0,63 te a0,a1 j rdAtaa la,u a0,'Y' sz,h2 prline . From Frithjov Iverson heim l,u a2,prline . at Trondheim University . la,u a2,6 . sa,h2 a2,pAcket . la,u a2,pAcket lmj x11,spAck sz nUmtRy j rdAtasT rdAtad1. la,u a0,pAcket lmj x11,bUfeMp sz,h2 pRlIne la,u a0,'Y' la a1,n la,u a2,pRline lmj x11,sPack la a0,nUmtRy sa a0,oLdtRy sz nUmtRy la a0,n aa,u a0,1 sa,s6 a0,n la,u a0,'D' j rdAtax rdAtatf. te,u a0,'F' j rdAtatz la a0,oLdtRy aa,u a0,1 sa a0,oLdtRy tg a0,mAxtRy j rdAtaa la a0,n ana,u a0,1 jp a0,2+$ la,u a0,63 te a0,a1 j rdAtaa sz,h2 pRlIne la,u a0,'Y' lmj x11,spAck sz nuMtRy j rdAtasT rdAtatz. te,u a0,'Z' j rdAtafL te a1,n j rdAtaa sz,h2 pRliNe la,u a2,pRlINe la a1,n la,u a0,'Y' lmj x11,spAck lmj x11,bUfeMpeof . iN cAse nO la a0,oPeneLt sz oPeneLt jz a0,3+$ lmj x11,esor$ j rdAtaa la a0,n aa,u a0,1 sa,s6 a0,n la,u a0,'F' j rdAtax rdAtafL. te,u a0,fAlse j rdAtasT la,u a0,'N' la,u a2,pAcket sz,h2 0,a2 la a1,n lmj x11,spAck j rdAtasT rdAtatImoUt. la,h1 a0,tImoUtmSg sa,h2 a0,tImoUtmSg rdAtaa. la,u a0,'A' j rdAtax rdAtasT. la a0,sTate rdAtax. pOp r3,r2,r1,a5,a4,a3,a2,a1,x11 j 0,x11 /. . . . ****************************************************************************** . . sdAta sdAta sdAta sdAta sdAta sdAta sdAta sdAta sdAta . . sEnd oNe pAcket oF dAta fRom "pAcket", rEfill, aNd rEturn nEw sTate . . ****************************************************************************** sdAta. pUsh x11,a1,a2 la a0,nUmtRy aa,u a0,1 sa a0,nUmtRy tg a0,mAxtRy j sdAtaa lmj x11,tImedrEdpUr . pUrge aNy pIled uP iNput la,u a0,'D' la a1,n la,u a2,pAcket lmj x11,spAck sa a0,sIze la,u a2,rEcpKt lmj x11,rpAck lmj x11,tEstaCk j sdAtaok sDatasT. la a0,sTate . sAme oLd sTate sdAtarT. pOp a2,a1,x11 j 0,x11 sdAtaa. la,u a0,'A' . aBort j sdAtarT sdAtaok. la,u a0,pAcket lmj x11,bUfIll sa a0,sIze sz nUmtRy la a0,n aa,u a0,1 sa,s6 a0,n tn sIze . eof???? j sdAtasT . sTay iN dAta sTate la,u a0,'Z' . eNd oF fIle sTate j sdAtarT /. . . . ****************************************************************************** . . seof seof seof seof seof seof seof seof seof seof . . sEnd eNd oF fIle aNd cLose tHe iNput fIle . . ****************************************************************************** seof. pUsh x11,a1,a2,a3,a4,a5,r1,r2,r3 la a0,nUmtRy aa,u a0,1 sa a0,nUmtRy tg a0,mAxtRy j seofeRr sz,h2 pRlIne . eMpty dAta sTring la,u a0,'Z' la a1,n la,u a2,pAcket lmj x11,spAck la,u a2,rEcpKt lmj x11,rpAck . gEt rEply lmj x11,tEstaCk j seofok la a0,sTate . sTay iN sAme sTate j seofxIt seofeRr. la,u a0,'A' . aBort j seofxIt seOfok. sz nUmtry la a0,n aa,u a0,1 sa,s6 a0,n la,u a0,fct lmj x11,sdfic$ J SEOFCHECK . CHECK FOR ANOTHER FILE SEOFDONE. la,u a0,'B' J SEOFXIT SEOFCHECK. ON DELETEOPTION . Gunnar L A0,OPTIONS . Gunnar AND A0,(1*/('Z'-'D')) . IF D-OPTION SET . Gunnar JZ A1,SEOFTESTNEXT . Gunnar L,U A0,PFSPKT . Gunnar ER PFD$ . Gunnar SEOFTESTNEXT . Gunnar OFF DELETEOPTION . Gunnar LMJ X11,WILDCARDNAM J SEOFDONE J SEOFDONE LMJ X11,DOPFS JP A0,SEOFOPN J SEOFDONE SEOFOPN. LMJ X11,CLRERRMSG LMJ X11,OPENSOURCE JN A0,SEOFDONE LA,U A0,'F' seofxIt. pOp r3,r2,r1,a5,a4,a3,a2,a1,x11 j 0,x11 /. . . . ****************************************************************************** . . sbReak sbReak sbReak sbReak sbReak sbReak sbReak sbReak . . sEnd tRansmission bReak mEssage (tYpe 'B') . . ****************************************************************************** sbReak. pUsh x11,a1,a2 sz,h2 pAcket . eMpty dAta sTring la a0,nUmtry aa,u a0,1 sa a0,nUmtry tg a0,mAxtry j sbReakeRr la,u a0,'B' la a1,n la,u a2,pAcket lmj x11,spAck la,u a2,rEcpKt lmj x11,rpAck lmj x11,tEstaCk j sbReakok la a0,sTate . sTay iN sAme sTate..tRy aGain j sbReakxIt sbReakeRr. la,u a0,'A' j sbReakxIt sbReakok. sz nUmtRy la a0,n aa,u a0,1 sa,s6 a0,n la,u a0,'C' . cOmplete sbReakxIt. pOp a2,a1,x11 j 0,x11 /. . . . . ****************************************************************************** . . tOcHar . cOnverts a nUmber tO a pRintable cHaracter bY aDding . aN ascii sPace. . . ****************************************************************************** tOcHar. aa,u a0,' ' j 0,x11 . . . . ***************************************************************************** . . uNcHar . tHe iNverse oF tOcHar. . . ****************************************************************************** uNcHar. ana,u a0,' ' j 0,x11 . . . ****************************************************************************** . . cTl . tUrns a cOntrol cHaracter iNto a pRintable cHaracter bY . tOggling tHe cOntrol bIt. (eg: A bEcomes ). . iT iS iT's oWn iNverse. . . ****************************************************************************** cTl. pUsh a1 xor,u a0,0100 la a0,a1 pOp a1 j 0,x11 /. . . . ****************************************************************************** . . spAr spAr spAr spAr spAr spAr spAr spAr spAr spAr spAr . . fIlls sTring (a0) wIth sEnd-iNit pArameters. . . ****************************************************************************** spAr. pUsh x11,a0,a2 la,u a2,0,a0 la,h1 a0,0,a2 tle,u a0,6 er aBort$ la,u a0,9 sa,h2 a0,0,a2 la a0,rpAklEn+1 . lArgest pAcket i cAn rEceive lmj x11,tOcHar eX 4+sTores la a0,rtImoUt+1 . wHen i wAnt tO bE tImed oUt lmj x11,tOcHar eX 5+sTores la a0,rpAd+1 . hOw mUch pAdding i nEed lmj x11,tOcHar eX 6+sTores la a0,rpAdcHr+1 . pAddind cHaracter i wAnt lmj x11,cTl eX 7+sTores la a0,reNdlIn+1 . eNd oF lIne cHaracter i wAnt lmj x11,tOcHar eX 8+sTores la a0,sqUote+1 . cOntrol-qUote cHaracter i sEnd eX 9+sTores la a0,mYqbIn . mY 8 bIt qUote cHaracter eX 10+sTores la,u a0,'1' . mY cHecksum tYpe eX 11+sTores la a0,mYrEpt . mY rEpeat cHaracter eX 12+sTores pOp a2,a0,x11 j 0,x11 /. . . . ****************************************************************************** . . rpAr rpAr rpAr rpAr rpAr rpAr rpAr rpAr rpAr rpAr rpAr . . gEt tHe oTher sIde's sEnd-iNit pArameters. . . iNput is: . a0=sTring aDdress . a1=cHaracter iNdex oF sTart cHaracter . . ****************************************************************************** rpAr. pUsh x11,a0,a1,a3,a4 sz hIsqbIn . hIs 8 bIt pRefix cHaracter sz hIsrEpt . hIs rEpeat cHaracter la,u a3,0 la,u a1,0,a0 tg,h2 a3,0,a1 j rpArx eX 4+lOads,a3 aa,u a3,1 lmj x11,uNcHar tg a0,spAklEn+1 la a0,spAklEn+1 sa a0,cUrspAklEn . mAximum sEnd pAcket sIze tg,h2 a3,0,a1 j rpArx eX 4+lOads,a3 aa,u a3,1 lmj x11,uNcHar lx,u x11,stImoUt la,h1 a4,2,x11 . lEngth oF nAme ssl a4,2 . nUmber oF wOrds ax x11,a4 la a4,5,x11 . gEt dEfault fOr sEnd tImeout tne a4,cUrstImoUt . oNly dEfault cAn bE cHanged . bY nEgotiations sa a0,cUrstimoUt . wHen i sHould tIme oUt tg,h2 a3,0,a1 j rpArx eX 4+lOads,a3 aa,u a3,1 lmj x11,uNcHar sa a0,cUrspAd . nUmber oF pAds tO sEnd tg,h2 a3,0,a1 j rpArx eX 4+lOads,a3 aa,u a3,1 lmj x11,cTl sa a0,cUrspAdcHr . pAd cHaracter tO sEnd tg,h2 a3,0,a1 j rpArx eX 4+lOads,a3 aa,u a3,1 lmj x11,uNcHar sa a0,cUrseNdlIn . eol cHaracter i mUst sEnd tg,h2 a3,0,a1 j rpArx eX 4+lOads,a3 aa,u a3,1 sa a0,cUrrqUote . iNcoming dAta qUote cHaracter tg,h2 a3,0,a1 j rpArx ex 4+lOads,a3 aa,u a3,1 sa a0,hIsqbIn . hIs 8 bIt pRefix tg,h2 a3,0,a1 j rpArx aa,u a3,1 . hIs cHecksum tYpe tg,h2 a3,0,a1 j rpArx ex 4+lOads,a3 aa,u a3,1 sa a0,hIsrEpt . hIs rEpeat cHaracter rpArx. pOp a4,a3,a1,a0,x11 j 0,x11 /. . . . ****************************************************************************** . . rpAck rpAck rpAck rpAck rpAck rpAck rpAck rpAck rpAck . rEceive a pAcket. . gIven a2=sTring tO rEceive tHe pAcket . rEturns . a0 sEt tO pAcket tYpe (oR zEro if rEad fAilure) . a1 sEt tO pAcket nUmber . . ****************************************************************************** rpAck. pUsh x11,a0,a1,a2,a3,a4,a5,r1,r2 rpAck$nUm eQuf 6,x10 rpAck$dAta eQuf 5,x10 rpAck$tYpe eQuf 7,x10 rpAckrEad. la a0,cUrstImoUt lmj x11,tImedrEad j rpAckeof j rpAcktImoUt j 2+$ . lOst dAta j rpAckfAil la,u a0,3+iNput lmj x11,dEbUggeri la a3,(+1,0) . lOad iNdex la,u a1,3+iNput . iNput dAta aDdress lr,h2 r1,2+iNput . # cHaracters iNput j rpAcksRch rpAckssT. eX lOads,*a3 tep,u a0,0200 ana,u a0,0200 . cLear pArity bIt tne a0,rsTart+1 j rpAcksYnc . fOund sYnc cHaracter rpAcksRch. jGd r1,rpAckssT sz,h1 2+iNput j rpAckrEad . iGnore lInes wIthout sYnc cHar rpAcksYnc. jgd r1,2+$ j rpAckeRr eX lOads,*a3 . lEngth la a5,a0 . sTart oF cHecksUm tne a0,rsTart+1 j rpAcksYnc lmj x11,uNcHar tg,u a0,96 j rpAckeRr ana,u a0,3 jn a0,rpAckeRr lr r2,a0 . nUmber oF dAta cHaracters jgd r1,2+$ j rpAckeRr eX lOads,*a3 . pAcket nUmber aa a5,a0 . cHecksUm tne a0,rsTart+1 j rpAcksYnc lmj x11,uNcHar sa a0,rpAck$nUm jgd r1,2+$ j rpAckeRr eX lOads,*a3 . pAcket tYpe tne a0,rsTart+1 j rpAcksYnc s a0,rpAck$tYpe aa a5,a0 . aDd tO cHecksUm lx x11,(+1,4) . sTores iNdex la a2,rpAck$dAta sr,h2 r2,0,a2 . lEngth oF rEceived sTring rpAckdAta. jgd r2,2+$ j rpAckdd . dAta dOne jgd r1,3+$ . Treat the case when the read . Gunnar . string was shorter than the . Gunnar . transmitted packet. This . Gunnar . can occur when the checksum . Gunnar . is SPACE, since sperry kindly . Gunnar . removes trailing spaces and . Gunnar . then fills with spaces to . Gunnar . the next word limit. . Gunnar . Nice, isn't it? . Gunnar la,u a0,' ' j 2+$ eX lOads,*a3 tne a0,rsTart+1 j rpAcksYnc aa a5,a0 . aDd tO cHecksUm eX sTores,*x11 . mOve tHe dAta j rpAckdAta rpAckdd. la a0,a5 lssl a5,28 ssl a5,34 aa a0,a5 lssl a0,30 ssl a0,30 lmj x11,tOcHar la a5,a0 jgd r1,3+$ la,u a0,' ' j 2+$ eX lOads,*a3 te a0,a5 j rpAckeRr . bAd cHecksUm lmj x11,tEsteRrpRob j rpAckeRr j rpAckxIt rpAckeof. rpAcktImoUt. rpAckfAil. rpAckeRr. la,u a0,fAlse sa a0,rpAck$tYpe rpAckxIt. sz,h1 2+iNput pOp r2,r1,a5,a4,a3,a2,a1,a0,x11 j 0,x11 /. . . . ****************************************************************************** . . spAck spAck spAck spAck spAck spAck spAck spAck spAck spAck . . sEnd a pAcket. . gIven . a0=pAcket tYpe . a1=pAcket nUmber . a2=dAta sTring . ***************************************************************************** spAck. pUsh x11,a0,a1,a2,a3,a5,r1 spAck$tYpe eQuf 5,x10 spAck$nUm eQuf 4,x10 spAck$dAta eQuf 3,x10 la,u a2,spAckbUffer la a3,(+1,0) lr r1,cUrspAd . # pAd cHaracters la a0,cUrspAdcHr . pAd cHaracter j 2+$ eX 4+sTores,*a3 jgd r1,$-1 la a0,ssTart+1 eX 4+sTores,*a3 la a1,spAck$dAta la,h2 a0,0,a1 . # dAta cHaracters aa,u a0,3 lmj x11,tOcHar la a5,a0 . cHecksUm eX 4+sTores,*a3 la a0,spAck$nUm . sEquence nUmber lmj x11,tOcHar aa a5,a0 eX 4+sTores,*a3 la a0,spAck$tYpe aa a5,a0 eX 4+sTores,*a3 lr,h2 r1,0,a1 . # dAta cHaracters lx x11,(+1,0) j 4+$ eX 4+lOads,*x11 eX 4+sTores,*a3 aa a5,a0 jgd r1,-3+$ lmj x11,tEsteRrpRob aa,u a5,1 la a0,a5 lssl a5,28 ssl a5,34 aa a0,a5 lssl a0,30 ssl a0,30 lmj x11,tOcHar ex 4+sTores,*a3 la a0,cUrseNdlIn . eNd oF lIne cHaracter IF ESCMODE=0 . Gunnar te,u a0,015 . cr appended by system if . Gunnar . not @@ESC O. Perhaps . Gunnar . better to remove the 'te' . Gunnar . instruction totally ? . Gunnar ENDF ESCMODE . Gunnar eX 4+sTores,*a3 . iF tHe eNd oF lIne cHaracter iS . a cArriage rEturn tHen tHere wIll . bE tWo oF tHem aT tHe eNd oF tHe lIne . sInce apRint$ wIll uSually add . oNe. tHis sHould dO nO hArm sInce tHe . rEceiver iS sUpposed tO wAit fOr . a sYnc cHaracter (uSually cOntrol a). . wE hAve tO pUt sOmething aT tHe eNd . sInce apRint$ dEletes tRailing bLanks. IF DCPFE . Gunnar la,u a0,04 . Add an EOT to terminate the li. Gunnar . avoid space fill to word limit. Gunnar ex 4+stores,*a3 . Gunnar ENDF DCPFE . Gunnar sa,h2 a3,0,a2 la,u a0,0,a2 lmj x11,pRintsTring lmj x11,dEbUggero pOp r1,a5,a3,a2,a1,a0,x11 j 0,x11 /. . . . ****************************************************************************** . . riNit riNit riNit riNit riNit riNit rInit riNit riNit . . iNitialize rEceive . . ****************************************************************************** riNit. pUsh x11,a1,a2 sz rCvsTate la a0,nUmtRy aa,u a0,1 sa a0,nUmtRy tg a0,mAxtRy j riNita la,u a2,pAcket lmj x11,rpAck te,u a0,'S' j riNitsT la,u a0,pAcket la,u a1,0 lmj x11,rpAr la a0,hIsqbIn . hIs 8 bIt qUote cHaracter la,u a1,'N' . aSsume nO 8 bIt qUoteing tg,u a0,33 tg,u a0,63 tg,u a0,96 tg,u a0,127 j 3+$ la a1,a0 j 6+$ te,u a0,'Y' j 4+$ la a0,wIdth+1 te,u a0,8 la,u a1,'&' . la a0,qUote8+1 la a0,2,a0 tne a0,('OFF ') la,u a1,'N' sa a1,mYqbIn tne,u a1,'N' la,u a1,0 sa a1,cUrqbIn la,u a1,'N' la a0,hIsrEpt . hIs rEpeat cHaracter tg,u a0,33 tg,u a0,63 tg,u a0,96 tg,u a0,127 j 2+$ la a1,a0 la a0,rEpeat+1 la a0,2,a0 tne a0,('OFF ') la,u a1,'N' sa a1,mYrEpt tne,u a1,'N' la,u a1,0 sa a1,cUrrEpt la,u a0,pAcket lmj x11,spAr la,u a0,'Y' la a1,n la,u a2,pAcket lmj x11,spAck la a0,nUmtRy sa a0,oLdtRy sz nUmtRy la a0,n aa,u a0,1 sa,s6 a0,n la,u a0,'F' riNitx. pOp a2,a1,x11 j 0,x11 rInita. la,u a0,'A' j riNitx riNitsT. la,u a0,'N' la,u a2,pAcket sz,h2 0,a2 la a1,n lmj x11,spAck la a0,sTate j riNitx /. . . . ****************************************************************************** . . siNit siNit siNit siNit siNit siNit siNit siNit siNit . . sEnd mY pArameters, gEt oTher sIdes's bAck . a0 rEplaced wIth nEw sTate iDentification . . ****************************************************************************** siNit. pUsh x11,a1,a2,a3 la,u a0,0 pUsh a0,a0 . lOcal vAriables siNit$lEn eQuf 0,x10 sInit$nUm eQuf 1,x10 la a0,nUmtRy aa,u a0,1 sa a0,nUmtRy tg a0,mAxtRy j sInitaB . tOo mAny tRies..aBort la,u a0,'&' la a1,wIdth+1 tne,u a1,8 la,u a0,'Y' la a1,qUote8+1 la a1,2,a1 tne a1,('OFF ') la,u a0,'N' sa a0,mYqbIn . mY 8 bIt qUote rEquest la,u a0,'~' la a1,rEpeat+1 la a1,2,a1 tne a1,('OFF ') la,u a0,' ' sa a0,mYrEpt la,u a0,pAcket la,u a1,0 lmj x11,spAr . fIll wIth iNit pArameters lmj x11,iNfLush . fLush aNy sTacked iNput la,u a0,'S' . tYpe la a1,n . pAcket nUmber la,u a2,pAcket . dAta tO sEnd lmj x11,spAck . sEnd tHe pAcket la,u a2,rEcpKt lmj x11,rpAck . a0::=tYpe . . a1::=nUm sa a1,siNit$nUm tne,u a0,'N' j siNitsTate . dOn't cHange sTate tne,u a0,'Y' j siNitY tne,u a0,0 . rEceive fAilure j siNitsTate . sTay iN cUrrent sTate siNitaB. la,u a0,'A' . dEfault iS tO aBort j siNitx siNity. aCk rEceived fOr sEnd iNit pAcket la a0,siNit$nUm te a0,n j siNitsTate . wAit fOr a gOod aCk..kEep tRying la,u a0,rEcpKt lmj x11,rpAr la a0,mYqbIn la a1,hIsqbIn te,u a0,'&' j siNitq1 te,u a1,'&' tne,u a1,'Y' tz,u 0 la,u a0,0 sa a0,cUrqbIn j siNitrpt siNitq1. te,u a0,'N' j siNitq2 la,u a0,0 sa a0,cUrqbIn j siNitrPt siNitq2. la a0,a1 tg,u a1,33 tg,u a1,63 tg,u a1,96 tg,u a1,127 la,u a0,0 sa a0,cUrqbIn siNitrPt. la a0,mYrEpt la a1,hIsrEpt tne,u a0,'~' te,u a1,'~' la,u a0,0 sa a0,cUrrEpt sz nUmtRy la a0,n aa,u a0,1 aNd,u a0,077 sa a1,n la,u a0,'F' . ok...sWitch tO sTate F j siNitx siNitsTate. la a0,sTate siNitx. pOp x11,x11 . lOcal vAriables pOp a3,a2,a1,x11 j 0,x11 /. . . . ****************************************************************************** . . gEtfIl gEtfIl gEtfIl gEtfIl gEtfIl gEtfIl gEtfIl gEtfIl . . aTtempt tO oPen aN eLement wIth nAme sOmething lIke tHe sTring (a0). . . ****************************************************************************** gEtfIl. pUsh x11,a1,a2,a3,a4,a5,r1,r2,r3 lmj x11,eXtrnAme . tRy tO cReate eLt nAme la,u a0,nAmeLt lmj x11,asctOfd ds a4,pArtBl+29 la,u a0,vErsioneLt lmj x11,asctOfd ds a4,pArtBl+33 lmj x11,ssor$ j gEtfIlbAd la,u a0,1 sa a0,oPeneLt la,u a0,tRue sz eLtiNdex j gEtfIlx gEtfIlbAd. sz sorfct$ la a0,a2 lmj x11,pfeRror la,u a0,fAlse gEtfIlx. pOp r3,r2,r1,a5,a4,a3,a2,a1,x11 j 0,x11 rAndom. rEturns a0=rAndom iNteger 1<=i<2**35 pUsh a1 la a0,sEed+1 mi a0,(+5*5*5*5*5*5*5*5*5*5*5*5*5*5*5) la a0,(+0377777777777) and a0,a1 aa,u a1,1 la a0,(+0377777777777) and a0,a1 l a0,a1 sa a1,sEed+1 pOp a1 j 0,x11 tEsteRrpRob. rEturns tO 0,x11 iF eRror sHould bE fOrced, eLse 1,x11 tnz eRrpRob+1 j 1,x11 pUsh x11,a0,a1 lmj x11,rAndom dsl a0,36 ssl a1,24 di a0,eRrpRob+1 jz a1,tEstpRobnO pOp a1,a0,x11 j 1,x11 tEstpRobnO. pOp a1,a0,x11 j 0,x11 . **********************************************************************. Gunnar . . Gunnar . Unprfixify Unprefixify Unprefixify Unprefixify Unprefixify . Gunnar . . Gunnar . gIven a bUffer.....unpack it into another buffer . Gunnar . . Gunnar . a0 = source buffer (in) . Gunnar . a1 = max source character count (in) . Gunnar . effective source character count (out) . Gunnar . a2 = dest buffer (in) . Gunnar . a3 = max dest character count (in) . Gunnar . effective dest character count (out) . Gunnar . . Gunnar . **********************************************************************. Gunnar UNPREFIXIFY. . Gunnar . gEnerally: . Gunnar . a0=current character . Gunnar . a1=sOurce bUffer sTart aDdress . Gunnar . a2=dEstination bUffer sTart aDdress . Gunnar . a3=sOurce cHaracter iNdex . Gunnar . a4=1,dEsination cHaracter iNdex . Gunnar . a5=1,mAximum dEstination cHaracter count . Gunnar . a6=max source character count . Gunnar . r1=rEpeat cOunt . Gunnar . r2=bIt 8 pRefix . Gunnar . . Gunnar pUsh x11,a4,a5,a6,a7,r1,r2 . Gunnar la a7,cUrrqUote . rEceive qUote cHaracter . Gunnar tOp,u a7,0200 . Gunnar aa,u a7,0200 . Gunnar sa a7,rqUotep128 . rqUote wIth bIt 7 sEt . Gunnar . . Gunnar la a6,a1 . max source char count . Gunnar lxi,u a3,1 . Gunnar l a5,a3 . 1,max dest char . Gunnar l a4,(1,0) . dest character index . Gunnar l,u a3,0 . source character index . Gunnar la,u a1,0,a0 . source buffer . Gunnar unprixlP. . Gunnar tg a3,a6 . Gunnar j unprixdN . Gunnar ex loads,a3 . Gunnar aa,u a3,1 . Gunnar lr,u r1,1 . rEpeat cOunt . Gunnar te a0,cUrrEpt . iS a0=rEpeat cHaracter . Gunnar j unprixt8 . Gunnar tg a3,a6 . Gunnar j unprixsTr . sTore aS dAta.wHat eLse . Gunnar ex loads,a3 . Gunnar aa,u a3,1 . Gunnar lmj x11,uNcHar . Gunnar lr r1,a0 . aCtual rEpeat cOunt . Gunnar tg a3,a6 . Gunnar ana,u a3,1 . gArbage in..gArbage oUt . Gunnar eX loads,a3 . Gunnar aa,u a3,1 . Gunnar unprixt8. tEst fOr 8 bIt pRefix cHaracter . Gunnar lr,u r2,0 . aSsume nO pRefix . Gunnar te a0,cUrqbIn . cHeck iF 8 bIt qUote . Gunnar j unprixtQ . gO cHeck cOntrol qUote . Gunnar lr,u r2,0200 . sEt 8 bIt pRefix . Gunnar tg a3,a6 . Gunnar ana,u a3,1 . gArbage iN...gArbage oUt . Gunnar eX loads,a3 . Gunnar aa,u a3,1 . Gunnar unprixtq. tEst fOr cOntrol qUote . Gunnar te a0,cUrrqUote . Gunnar j unprixsTr . gO sTore tHe cHaracter . Gunnar tg a3,a6 . Gunnar ana,u a3,1 . gArbage iN...gArbage oUt . Gunnar eX loads,a3 . Gunnar aa,u a3,1 . Gunnar te a0,cUrrqUote . Gunnar tNe a0,rqUotep128 . Gunnar j unprixsTr . Gunnar te a0,cUrrEpt . Gunnar tne a0,cUrrEpt128 . Gunnar j unprixsTr . Gunnar tne a0,cUrqbIn . Gunnar j unprixsTr . Gunnar lmj x11,cTl . Gunnar unprixsTr. sTore r1 cOpies oF cHaracter a0+r2 . Gunnar top a0,r2 . Gunnar aa a0,r2 . aDd 8 bIt pRefix . Gunnar j unprefixdec unprefixsto. . Gunnar dsc a3,36 . Gunnar ex stores,a3 . Gunnar dsc a3,36 . Gunnar aa,u a4,1 . Gunnar tg a4,a5 . Gunnar j unprefixfull . Gunnar unprefixdec. . Gunnar jgd r1,unprefixsto . Gunnar j unprixlP . Gunnar unprefixfull. . Gunnar unprixdN. . Gunnar l a1,a3 . # source chars consumed . Gunnar l a3,a4 . # dest chars produced . Gunnar lxi a3,0 . Gunnar pop r2,r1,a7,a6,a5,a4,x11 . Gunnar j 0,x11 . Gunnar . . ********************************************************************** . WILDCARDNAM - ROUTINE ATTEMPTS TO FIND AN ELEMENT/VERSION WHEN . - WILDCARDS (I.E. *) ARE USED AS PART OF THE NAME ON A . - GET FUNCTION FROM THE OTHER KERMIT. . . USAGE LMJ X11,WILDCARDNAM . + NO MATCH ANYWHERE IN FILE . + NO MATCH ON THIS CALL . + NORMAL RETURN - MATCH FOUND . . ********************************************************************** . WILDCARDNAM. PUSH x11,A0,A1,A2,A3,a4,a5 FIELDATA LA A0,BSPFCT+6 . LOAD THE PROGRAM FILE INDICATOR TE A0,('**PF**') . MAKE SURE ITS A PROGRAM FILE J NOFIND . CUL OUT IF ITS NOT TZ NPASSES . HAVE WE BEEN THROUGH BEFORE ? J DONEINITIAL . SKIP THE INITIALIZATION STUFF SZ NFINDS . ZERO THE NUMBER OF FINDS DONEINITIAL. LA A0,MAXWILD+1 . GET THE MAXIMUM OF ELEMENTS TO SEND TNE A0,NFINDS . COMPARE AGAINST NUMBER WE'VE FOUND J NOFIND WILDSRCHLOOP. LA A1,NPASSES . GET THE NUMBER OF PASSES AA,U A1,1 . UPDATE IT SA A1,NPASSES . SAVE IT la,u a0,bspfct lmj x11,etnl$ j nOfInd . aLl dOne LA,S3 A1,3,A0 . GET THE ELEMENT TYPE TLE,U A1,5 . MAKE SURE ITS < 5 TLE,U A1,1 . MAKE SURE ITS > 0 J NOTTHISONE . ITS NOT A SYMBOLIC tp 3,a0 . iS iT dEleted? NOTTHISONE. j wIldsRchlOop la,u a1,0,a0 . eLement nAme aDdress la,u a0,wIldelt . eLement pAttern lmj x11,mAtch12 j nOttHisoNe . nO mAtch la,u a1,4,a1 . vErsion nAme la,u a0,wIldvEr . vErsion pAttern lmj x11,mAtch12 j nOttHisoNe WILDCARDDONE. ana,u a1,4 dl a4,0,a1 ds a4,eLementnAme dl a4,4,a1 ds a4,vErsionnAme LA A0,NFINDS . GET THE NUMBER OF FINDS AA,U A0,1 . UPDATE IT SA A0,NFINDS . SAVE IT POP a5,a4,A3,A2,A1,A0,x11 ASCII J 2,X11 . NORMAL RETURN NOFIND. POP a5,a4,A3,A2,A1,A0,x11 ASCII SZ NPASSES . CLEAR NUMBER OF PASSES . Gunnar . Must always be cleared . Gunnar . at no find . Gunnar TNZ NFINDS . DID WE FIND ANY ? J 0,X11 J 1,X11 . mAtch12. mAtch 12 cHaracters...a0=pAttern...a1=sTring pUsh r3,x11,a2,a3,a4,r1,r2 la,u a2,0 la,u a3,0 la,u a4,0 lr,u r1,12 lr,u r2,12 lr,u r3,1 lmj x11,mAtchsTring lr,u r3,0 pOp r2,r1,a4,a3,a2,x11 ax x11,r3 pOp r3 j 0,x11 . mAtchsTring. wIldcArd sTring mAtching sUbroutine . x11=rEturn aDdress . 0,x11 iF nO mAtch . 1,x11 iF mAtch . a0=aDdress oF pAttern sTring . a1=aDdress oF sTring tO tEst fOr mAtch . a2=iNdex iNto (a0) sTring . a3=iNdex iNto (a1) sTring . a4=nOn-zEro iF "*" sHould bE iGnored iN sTring (a0) . r1=#cHaracters iN sTring (a0) . r2=#cHaracters iN sTring (a1) . pUsh x11,a2,a3,a4,a5 mTchsnpc. mAtch sTring ... nExt pAttern cHaracter tne a2,r1 . pAttern eNd? j mTchspe . yEs...pAttern eNd ex lOadfa0,a2 . get pAttern cHaracter fIeldata tne,u a5,'*' . iS iT a gEar? j mTchspcg . pAttern cHaracter = gEar tNe,u a5,' ' . iS pAttern a bLank? j mTchspcb . pAttern cHaracter = bLank tne a3,r2 . aNy cHaracters lEft iN sTring j mTchsnm . nOpe...sO nO mAtch tne,u a5,'%' j mTchspcp . pAttern cHaracter=pErcent lx x11,a5 . sAve tHe pAttern cHaracter ex lOadfa1,a3 te a5,x11 . dOes pAttern mAtch sTring j mTchsnm . nO mAtch mTchsr. rEcurse fOr nExt cHaracter la,u a4,0 . dOn't sKip gEars mTchsrsg. rEcurse aNd cOntinue sKipping gEars aa,u a2,1 aa,u a3,1 . nEw iNdexes lmj x11,mAtchsTring j mTchsnm . nO mAtch here mTchsmTch. mAde a mAtch pOp a5,a4,a3,a2,x11 j 1,x11 mTchspcp. pAttern cHaracter = pErcent eX lOadfa1,a3 . gEt nExt sTring cHaracter te,u a5,' ' j mTchsrsg . sO fAr wE hAve a mAtch mTchsnm. nO mAtch pOp a5,a4,a3,a2,x11 j 0,x11 mTchspcb. pAttern cHaracter = bLank aa,u a2,1 . lmj x11,mAtchsTring j mTchsnm . nO mAtch j mTchsmTch . mAtch mTchspcg. pAttern cHaracter = gEar aa,u a2,1 jnz a4,mTchsnpc . jUmp iF sKip gEars la,u a4,1 mTchssn. sKip n cHaracters aNd pRoceed lmj x11,mAtchsTring j 2+$ j mTchsmTch . mAde a mAtch tne a3,r2 . aNy sTring cHaracters lEft j mTchsnm . nOpe...sO nO mAtch aa,u a3,1 . yEs...sO sKip aNother j mTchssn . aNd tRy aGain mTchspe. pAttern sTring eMpty tne a3,r2 . iS sTring eMpty aLso j mTchsmTch . yes...sO wE mAde a mAtch ex lOadfa1,a3 te,u a5,' ' j mTchsnm . sTring nOt eMpty..nO mAtch aa,u a3,1 la,u a4,0 . dOn't sKip gEars lmj x11,mAtchsTring j mTchsnm . nO mAtch j mTchsmTch . mAtch ascii p pRoc lOadf* nAme la,s1 a5,p(1,1),p(1,2) la,s2 a5,p(1,1),p(1,2) la,s3 a5,p(1,1),p(1,2) la,s4 a5,p(1,1),p(1,2) la,s5 a5,p(1,1),p(1,2) la,s6 a5,p(1,1),p(1,2) eNd lOadfa0. lOad fIeldata fRom (a0) i do 2 , lOadf i-1,a0 lOadfa1. lOad fIeldat fRom (a1) i do 2 , lOadf i-1,a1 . . . hEre wE aRe gOing tO cReate a 256 wOrd tAble cOntaining a nOn-zEro eNtry . fOr eAch cHaracter tHat sHould bE cOnsidered a cOntrol cHaracter wHen . sEnding a fIle. tHis tAble wIll nOt! cOntain tHe qUote cHaracter . iTself. tHe sEnder mUst cHeck sEparately fOr tHe cUrrent qUote . cHaracter. p pRoc iFcNtrl* nAme fLag eQu 0 c eQu p(1,1) dO c<040 ,fLag eQu 1 dO c=0177 ,fLag eQu 1 dO (c>0200)**(c<0240) ,fLag eQu 1 dO c=0377 ,fLag eQu 1 +fLag eNd . uNlisted lIne iS "i dO 256 , iFcNtrl i-1 " cNtrltYpes. uNlist i dO 256 , iFcNtrl i-1 lIst $(0). dEbUgaRea rEs 8 . aT sTart oF d-bAnk. eAsy tO fInd. dEbUgbUff rEs 56 dEbUgiopKt fIeldAta 'kErmitdEbUg' +0 +w$,0,0 +56,dEbUgbUff +0 dUmpKt. 'kErmitdEbug' +0 +r$,0,0 +56,dEbugbUff +0 dUmpfIlaSg. '@asg,a kermitdebug . ' dfok +0 ascii dUmplIne +0 dUmpnUm +0 asctIm sTrng '123456' qUotekErmit. sTrng 'KERMIT' nAmeLt. nAme oF eLement bEing rEceived sTrng 'abcdefghijkl' vErsioneLt. vErsion nAme oF eLement bEing rEceived sTrng 'abcdefghjikl' eLtbUffer. bUffer fOr eLement io rEs mAxeLtlInsIz sRccHrcNt +0 . # cHar lEft iN eLtbUffer eltiNdex +0 . cUrrent iNdex iNto eLtbUffer oPeneLt +0 . nOn-zero iF eLement i/o iS oPen eLementeof +0 . rEceived eof rEturn fRom gEtas$ lInenUmber +0 . # lInes tRansmitted fIeldAta iNituSe. oRignal fIle tO uSe '@uSe k$E$r$m$i$t$,tpf$ . ' pAcket. +100,0 rEs 25 sIze +0 . sTatus fRom bUfIll wHen fIlling tRansmission dAta "pAcket" rEcpKt. +100,0 rEs 25 sTate +0 fIeldAta pArtBl*. +0504400,0 ' ' . fIle nAme fOr si ' ' ' ' . eLement nAme fOr si ' ' +0 +0 . fLag bIts, tYpe oF si ' ' . vErsion nAme oF si ' ' +0 . cYcle wOrd fOr si +0 . cOde,lEngth fOr si +0 . lOcation oF si +0 . dAte tIme oF si +0 . rEquired cYcle oF si pfspKt. 'k$E$r$m$i$t$' . iNternal fIle nAme eLementnAme. ' ' . eLement nAme oF so ' ' +0 +0 . fLag bIts,eLement tYpe oF so vErsionnAme. ' ' . vErsion nAme oF so ' ' +0 . cYle iNfo fOr so +0 . pRocessor cOde,lEngth oF so +0 . so lOcation +0 . so cReation dAte/tIme +0 . nExt wRite lOcation 'k$e$r$m$i$t$' ' ' . eLement nAme ' ' +0 +1,0 ' ' . vErsion nAme ' ' +5,0,1 +0 +0 +0 +0 fct. 'k$e$r$m$i$t$' +0 +020,0,0 +224,0 -1 +bUf1,bUf2 +8,mAxeLtlInsIz +1,sdfibUffer +1,-1 +0 lAsttYpecw +0 . lAtest sdf cOntrol wOrd tHat sPecified ascii oR fIeldAta sdflAbelcw +0 . sdf lAbel cOntrol wOrd bUf1 rEs 224 bUf2 rEs 224 sdfibUffer. rEs mAxeLtlInsIz BSPFCT 'K$E$R$M$I$T$' . BSP$ PACKET RES 32 BSPBUF RES 1792 . BSP$ BUFFER AREA NPASSES +0 . NUMBER OF PASSES ON TOC NFINDS +0 . NUMBER OF ELEMENTS FOUND . ascii fIlenAme. sTrng ' ' pRsTrpKt. s$YmbpK pRint$,w$,ascii$ 0,0,0 iNput. t$cEll 0 +1000000 . cOunt dOwn tImer +0 . h1 - sTatus . 001 = dAta pResent . 002 = uNexplained error . 004 = lOst dAta . 010 = tImeoUt . 020 = eNd oF fIle ('@' cArd) . h2 - cHaracter cOunt rEs 40 . dAta bUffer - 160 cHaracters tErminate. +0 rCvsTate +0 . +0=dAta sTate . . 1= M rEceived wIldeLt rEs 2 . eLement sPecified wIldvEr rEs 2 . vErsion sPecified LOGOUTFLAG. +0 rqUotep128. rqUote cHaracter wIth bIt 7 sEt...uSed bY bUfeMp +0 sqUotep128. sEnd qUote cHaracter wIth bIt 7 sEt...sEt aNd uSed bY bUfIll +0 hIsqbIn +0 . 8 bIt qUoting cHaracter fRom hIs iNit pAcket mYqbIn +0 . 8 bIt qUote cHaracter I wOuld lIke cUrqbIn +0 . 8 bIt qUote cHaracter aGreed tO hIsrEpt +0 . rEpeat cHaracter fRom hIs iNit pAcket mYrEpt +0 . rEpeat cHaracter I wOuld lIke cUrrEpt +0 . rEpeat cHaracter aGreed tO cUrrEpt128. +0 . cUrrEpt pLus 128 rDaCtive. +0 . sEt nOn-zEro bY iNitialize . sEt zEro bY sHutdOwn rEadbUf. rEs 40 spAckbUffer. +100,0 rEs 25 sTack rEs 300 sTackeNd equ $ bInascrSlt. sTrng ' ' pRlIne. +132,0 rEs (132+3)/4 sRciNdx +0 . iNdex iNto sRcsTrng sRcsTrng +200,0 . bUffer fOr gEtas$ aNd pUtas$ rEs 50 tImoUtmSg. sTrng 'Timeout ' bAdbInmSg. sTrng 'Element specified is not a "binary" element.' cMpltmSg. sTrng ' ' cMdbUf rEs 40 cMdpKt. s$ymbpk trEad$,w$r$,ascii$ 6,pRompt,0 120,cMdbUf fiTempKt. fieldAta 'k$E$r$m$i$t$' +0d +0d res 5 tStpfpKt. 'k$e$r$m$i$t$' +0 +r$,0,0 +28,cMdbUf +0 pRompt. ascii 'KER11>' options +0 . processor call options . Gunnar namestring. . temp storage when . Gunnar . unprefixing filename . Gunnar +100,0 . Gunnar res 25 . Gunnar tOken. sTrng '123456789012/123456789012' cMdiNdex +0 nUmtRy +0 oLdtRy +0 mAxtRy +10 n +0 dEcimalt eQu 1 . dEcimal iNteger tYpe bcdt eQu 2 . 4 ascii cHaracter tYpe cNtrlt eQu 3 . cOntrol cHaracter tYpe cHart eQu 4 . pRintable cHaracter tYpe oCtalt eQu 5 . oCtal iNteger tYpe . . ******** gLobal vAriables ****** dEbUg vAriable 'DEBUG' dEcimalt,0,1,0 DUMPFMT VARIABLE 'DUMPFORMAT' BCDT ; 'OCT','DEC','HEX' dElay vAriable 'DELAY' dEcimalt,0,99,6 MAXWILD VARIABLE 'MAXWILD' DECIMALT,1,99,25 pArity vAriable 'PARITY' bcdt ; 'SPC','EVN','ODD','MRK','OFF' lEngth vAriable 'LENGTH' dEcimalt,4,4*mAxeLtlInsIz,132 cOntinue vAriable 'CONTINUATION' oCtalt,0,01000,0 tYpe vAriable 'TYPE' bcdt 'ASCII','BINARY' rEpeat vAriable 'REPEAT' bcdt 'ON','OFF' qUote8 vAriable 'QUOTE8' bcdt 'ON','OFF' wIdth vAriable 'WIDTH' dEcimalt,7,8,7 sEed vAriable 'SEED' dEcimalt,0,1*/35-1,0 eRrpRob vAriable 'ERROR' dEcimalt,0,1*/35-1,0 . . rEceive pArameters ******* rpAklEn vAriable 'PACKETLENGTH' dEcimalt,10,MAXRPAKLEN,DEFRPAKLEN . Gunnar rpAd vAriable 'PADDING' dEcimalt,0,30,0 rpAdcHr vAriable 'PADCHAR' cNtrlt,0 rtImoUt vAriable 'TIMEOUT' dEcimalt,5,60,10 rqUote vAriable 'QUOTE' cHart,043 cUrrqUote. +0 . tHe cUrrent rEceive qUote cHaracter after negotiations rEndlIn vAriable 'ENDOFLINE' cNtrlt,015 rsTart vAriable 'STARTOFPACKET' cNtrlt,DEFSOP . Gunnar . . sEnd pArameters ********* spAklEn vAriable 'PACKETLENGTH' dEcimalt,10,91,91 cUrspAklEn. +0 . cUrrent sEnd pAcket lEngth aFter nEgotiations spAd vAriable 'PADDING' dEcimalt,0,30,0 cUrspAd. +0 . cUrrent nUmber oF pAd cHaracters aFter nEgotiations spAdcHr vAriable 'PADCHAR' cNtrlt,0 cUrspAdcHr. +0 . cUrrent sEnd pAd cHaracter aFter nEgotiations stImoUt vAriable 'TIMEOUT' dEcimalt,5,60,10 cUrstImoUt. +0 . cUrrent sEnd tImeout aFter nEgotiations sqUote vAriable 'QUOTE' cHart,043 seNdlIn vAriable 'ENDOFLINE' cNtrlt,015 cUrsEndlIn. +0 . cUrrent sEnd eol cHaracter aFter nEgotiations ssTart vAriable 'STARTOFPACKET' cNtrlt,DEFSOP . Gunnar eNd sTart