home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Columbia Kermit
/
kermit.zip
/
archives
/
sperryunivac1100a.tar.gz
/
sperryunivac1100a.tar
/
univac.asm
next >
Wrap
Assembly Source File
|
1988-08-16
|
220KB
|
6,458 lines
.
. 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