.
. 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  <dEcimal nUmber>
. 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 <cr><lf> .OR. <lf><cr>.  AT lEast oNe mIcro wOrd pRocessor
. hAs bEen dIscovered wHich uSes <lf><cr>.
. 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    <start>,<how many>'
          sTrng     'Dumps <how many> lines from the debug file starting'
          sTrng     'at the <start>th line.'
          sTrng     'If you omit <how many> one line will be dumped.'
          sTrng     'If you omit both <start> and <howmany> 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 <decimal number>'
          sTrng     'Result is:'
          sTrng     '  <random number seed> <-- <error probability>'
          sTrng     '  <error probability> <-- <decimal number>'
          sTrng     'Checksum error caused every <error probability>th time.'
          +0
hLpsEtlEngth.
          la,u      a0,3+$
          lmj       x11,pRipAr
          j         nExtcOmmand
          sTrng     'SET   LENGTH   <decimal number>'
          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   <octal number>'
          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  <number base>'
          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  <file type>'
          sTrng     '<file type> 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 <cr><lf>
.         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 <cr> or <lf>
          te,u      a0,012              . cHeck fOr <lf>
          tne,u     a0,015              . cHeck for <cr>
          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 <cr> oR <lf>...rEmember tHat
          sa        a0,rCvsTate
          j         0,x8
pUteLtcHr3. <cr> oR <lf> nOt...rEpeat nOt...fOllowed by <lf> oR <cr>
          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 <cr><lf>
          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 <cNtrl-A>).
.         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= <qUote>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
