. 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.
.
.
. This is what the collection looks like:
. @use r,sys$*rlib$
. @map,i ,k.kermit1100/exe
. in k.kermit1100/asm
. in r.table$/sys74r1
. in r.fdasc$/sys74r1
. in r.sdfo/sys74r1
. in r.sir$/sys74r1
. in r.sor/sYs74r1
. in r.eru$
. in r.sdfi/sys74r1
. 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.
.
          axr$
tRue      eQu       1
fAlse     eQu       0
vAlcOl    eQu       20
mAxeLtlInsIz eQu    200                 . mAximum sIze (iN wOrds) oF a
                                        . 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 1.1 '))
          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$
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,$+3
          lmj       x11,pRipAr
          er        eXit$
          sTrng     'Goodbye...1100 KERMIT signing off.'
          +0
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'
          +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.
          la        a0,(+0102,('eof     '))
          er        aprint$
          j         exit
.
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  [command name]'
          sTrng     '  EXIT  (or QUIT)'
          sTrng     '  RECEIVE  [file name]'
          sTrng     '  SET'
          sTrng     '  SEND   [file name]'
          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,nsUchmSg
          lmj       x11,pRipAr
          j         nExtcOmmand
hElptBl.
          +hLpeRr
          sTRNG     'ERROR'
          +hLphLp
          sTrng     'HELP'
          +hLpsEt
          sTrng     'SET'
          +hLpxIt
          sTrng     'EXIT'
          +hLpdBg
          sTrng     'DEBUG'
          +hLpdUmp
          sTrng     'DUMP'
          +hLpxIt
          sTrng     'QUIT'
          +hLprCv
          sTrng     'RECEIVE'
          +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
hLpdBg.
          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.'
          +0
hLphLp.
          la,u      a0,3+$
          lmj       x11,pRipAr
          j         nExtcOmmand
          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.'
          +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     '   PARITY'
          sTrng     '   RECEIVE'
          sTrng     '   SEND'
          sTrng     '   FILENAME'
          sTrng     '   TYPE'
          sTrng     '   LENGTH'
          sTrng     '   CONTINUATION'
          +0
hLpsEttBl.
          +hLpsEtdLy
          sTrng     'DELAY'
          +hLpsEtpRT
          sTrng     'PARITY'
          +hLpsEtrCv
          sTrng     'RECEIVE'
          +hLpsEtrCv
          sTrng     'SEND'
          +hLpsEtfIl
          sTrng     'FILENAME'
          +hLpsEttYp
          sTrng     'TYPE'
          +hLpsEtlEngth
          sTrng     'LENGTH'
          +hLpsEtcOntin
          sTrng     'CONTINUATION'
          +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.
          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.'
hLpsEttYp.
          la,u      a0,3+$
          lmj       x11,pRipAr
          j         nExtcOmmand
          sTrng     'SET  TYPE  <file type>'
          sTrng     '<file type> can be ASCII, BINARY, or 8BIT.'
          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     '8BIT files are similar to ASCII files except that'
          sTrng     'the character set is made up of 8 bit characters.'
          sTrng     'Some word processor files have to be transmitted'
          sTrng     'as 8BIT files because special characters are'
          sTrng     'used to encode formatting information.'
          +0
hLpsEtfIl.
          la,u      a0,3+$
          lmj       x11,pRipAr
          j         nExtcOmmand
          sTrng     'SET FILE  filename   '
          sTrng     'Tells the 1100 what file where to look for'
          sTrng     'for elements when sending and where to'
          sTrng     'put elements when receiving.  You can specify'
          sTrng     'a file name including a qualifier if necessary.'
          +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
hLpsEtpRt.
          la,u      a0,3+$
          lmj       x11,pRipAr
          j         nExtcOmmand
          sTrng     '      SET PARITY [parity]      Default is OFF'
          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'
          +0
hLpsEtrCv.
          la,u      a0,3+$
          lmj       x11,pRipAr
          j         nExtcOmmand
          sTrng     'Legal parameters for the SET RECEIVE command are:'
          sTrng     '     END-OF-LINE [octal number]     Default=015=CR'
          sTrng     '      PACKET-LENGTH [decimal number]     Default =80'
          sTrng     '     QUOTE [octal number]     Default is 043=#'
          sTrng     '     START-OF-PACKET [octal number]     Default=01=SOH'
          sTrng     '     TIMEOUT [# seconds]     Default=10'
          sTrng     'More information is available via: (for example)'
          sTrng     '     HELP SET RECEIVE END-OF-LINE'
          +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.
          sTrng     'Tells the 1100 the size of the biggest packet'
          sTrng     'it is expected to receive.  Legal values are '
          sTrng     '10 through 94.'
          +0
hLpsEtrCvqUo.
          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.
          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.
          sTrng     'Tells the 1100 how long it should wait for an expected'
          sTrng     'packet before assuming that the packet was lost'
          sTrng     'in transit.   Ten seconds is more than enough unless'
          sTrng     'you have specified very long packets and are running'
          sTrng     ' at a very low baud rate.'
          +0
hLpsEtsNd.
          la,u      a0,3+$
          lmj       x11,pRipAr
          j         nExtcOmmand
          sTrng     'Legal parameters for the SET SEND command are:'
          sTrng     '     END-OF-LINE [octal number]     Default=015=CR'
          sTrng     '     PACKET-LENGTH [decimal number]     Default=80'
          sTrng     '     PADDING [decimal number]   Default=0'
          sTrng     '     PADCHAR [octal number]     Default=0'
          sTrng     '     QUOTE [octal number]     Default=043=#'
          sTrng     '     START-OF-PACKET [octal number     Default=01=SOH'
          sTrng     '     TIMEOUT [# seconds]     Default=10'
          sTrng     'More information is available via: (for example)'
          strng     '     HELP SET SEND END-OF-LINE'
          +0
hLpsEtsNdeol.
          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.
          sTrng     'The maximum packet size the 1100 should send.'
          sTrng     'Legal values are 10 through 94. Default is 80.'
          +0
hLpsEtsNdpAd.
          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.
          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.
          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.
          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.
          sTrng     'The maximum number of seconds the 1100 should wait for'
          sTrng     'a reply to a packet.  After this amount of time it will'
          sTrng     'be assumed that the packet was lost and the packet will'
          sTrng     'be sent again.'
          sTrng     'Legal values are 01 through 99.  The default of 10'
          sTrng     'seconds should be adequate except at very low'
          sTrng     'baud rates.'
          +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 in the specified file.  If no'
          sTrng     'file is specified then the element will go'
          sTrng     'into the default file.  If no default file has'
          sTrng     'been specified (via the SET command) then the '
          sTrng     'element will go into TPF$.  The name of the'
          sTrng     'element will be specified by the file header.'
          sTrng     '   Specify a file name in the following format:'
          sTrng     '         [[qualifier]*]file[.]'
          +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.  If no file has been  declared'
          sTrng     '(via the SET FILE command) then the'
          sTrng     'element will come from TPF$.'
          +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'
          +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.
          +sEtdLy
          sTrng     'DELAY'
          +sEtpRt
          sTrng     'PARITY'
          +sEtdBg
          sTrng     'DEBUG'
          +sEtrCv
          sTrng     'RECEIVE'
          +sEtsNd
          sTrng     'SEND'
          +sEtfIl
          sTrng     'FILENAME'
          +sEttYp
          sTrng     'TYPE'
          +sEtcOntinue
          sTrng     'CONTINUATION'
          +sEtlEngth
          sTrng     'LENGTH'
          +0
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
          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
          la,u      a2,8
          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
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
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 varilable.  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,037
          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'
          +sEtrCvsYnc
          sTrng     'SYNC'
          +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     '   SYNC'
          +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
sEtrCvsYnc.
          la,u      a0,rsYnc
          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'
          +sEtsNdsYnc
          sTrng     'SYNC'
          +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     '   SYNC'
          +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
sEtsNdsYnc.
          la,u      a0,ssYnc
          j         sEtcNtrl
/.
sHow.
          la,u      a0,sHgLblmSg
          lmj       x11,pRipAr
          la,u      a0,dElay
          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,dEbUg
          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,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
          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.
          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
sEndeLt.
          la,u      a1,tOken
          la,u      a3,0
          lmj       x11,eXtrf
          jp        a0,$+3
          lmj       x11,pRipAr
          j         nExtcOmmand
          ds        a4,eLementnAme
          sz        vErsionnAme
          sz        1+vErsionnAme
          jz        a0,sEndsTrt
          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,eXtrf           . gEt vErsion nAme
          jp        a0,3+$
          lmj       x11,pRipAr
          j         nExtcOmmand
          ds        a4,vErsionnAme
          jz        a0,sEndsTrt
          la,u      a0,3+$
          lmj       x11,pRipAr
          j         nExtcOmmand
          sTrng     'Illegal character following version name.'
          +0
sEndsTrt.
          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,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
          j         nExtcOmmand
rcMpltmSg.
          sTrng     'Receive complete...'
rfLmSg.
          sTrng     'Receive failed...'
/.
iNitialize.
          pUsh      x11,a0,a1
          tnz       tErminate
          j         4+$
          la,u      a0,1000
          er        twAit$
          j         -4+$
          la        a0,(+sEtmD1l,sEtmD1)
          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,tYpe+1
          la        a1,2,a1
          te        a1,('BINA')
          tne       a1,('8BIT')
          la        a0,(+sEtmD8l,sEtmD8)
          er        apRtcn$
          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
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+$
.
sHutdOwn.
          tnz       rDaCtive
          j         0,x11
          pUsh      x11,a0
          sx,h1     x11,tErminate
          sx,h2     x11,tErminate
          la        a0,(+cLrmDl,cLrmd)
          er        apRtcN$
          la        a0,(+mDsl,mDs)
          er        apRtcN$
          la,u      a1,1000
          er        twAit$
          tz        tErminate
          j         -3+$
          sz        rDaCtive
          pOp       a0,x11
          j         0,x11
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+$
/.
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 40 , 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 100 , 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
          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,a5
          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
          la,u      a0,3+$
          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,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
.
.
eXtrf.  eXtract fIle nAme (oR qUalifier oR eLement oR vErsion)
.         a1=iNput sTring
.         a3=iNdex iNto sTring
.
.         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
          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
          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
eXtrn1.
          tg,h2     a3,0,a1             . aNy mOre cHaracters
          j         eXtrn2              . nOpe...
          eX        4+lOads,a3
          aa,u      a3,1
          lmj       x11,eXtrnlEgal      . tEst lEgal cHaracter
          j         eXtrn3              . iLlegal
          dsc       a3,36
          tle,h1    a3,0,a2
          eX        4+sTores,a3
          aa,u      a3,1
          dsc       a3,36
          j         eXtrn1
eXtrn2.
          jnz       a3,eXtrn5
eXtrn4. nO lEgal cHaracters. mAke uP a nAme uSing tIme oF dAY.
          sz,h2     nAmeLt
          la,u      a0,nAmeLt
          la,u      a1,qUotekErmit
          lmj       x11,cOncat
          er        tdAte$
          lxi,u     a0,0
          lmj       x11,tImetOasc.
          la,u      a0,vErsioneLt
          la,u      a1,asctIm
          sz,h2     0,a0
          lmj       x11,cOncat
          j         eXtrnx
eXtrn5. sTore tHe nAme cHaracter cOunt.
          sa,h2     a4,nAmeLt
          j         eXtrnx
eXtrn3.
          te,u      a0,'.'
          tne,u     a0,'/'
          j         eXtrn6
          j         eXtrn1
eXtrn6.
          jz        a4,eXtrn1           . iF nSme sTill eMpty
          sa,h2     a4,nAmeLt
          la,u      a4,0
          la,u      a2,vErsioneLt
eXtrn7.
          tg,h2     a3,0,a1
          j         eXtrn8
          eX        4+lOads,a3
          aa,u      a3,1
          lmj       x11,eXtrnlEgal      . iS cHaracter lEgal
          j         eXtrn7              . nOpe...
          tg,h1     a4,0,a2
          j         eXtrn7              . nO rOom...sKip iT
          dsc       a3,36
          ex        4+sTores,a3
          aa,u      a3,1
          dsc       a3,36
          j         eXtrn7
eXtrn8.
          sa,h2     a4,vErsioneLt
eXtrnx.
          pOp       a4,a3,a2,a1,a0,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,u      a0,1
          sa        a0,sIrp2$           . sEcond pAss
          lmj       x11,oPnsR$
          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.
          tne,u     a0,fAlse
          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
.
          pUsh      x11,a0,a1,a2,a3,a4,a5,r1
          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
          lx        x11,rCvsTate
          j         $+1,x11
          j         bUfeMplP
          j         bUfeMpqcR
bUfeMplP.
          tg,h2     a3,0,a1
          j         bUfeMpdN
          eX        4+lOads,a3
          aa,u      a3,1
          te        a0,1+rqUote
          j         bUfeMpsTr           . gO sTore tHe cHaracter
          tg,h2     a3,0,a1
          j         bUfeMpsTr
          eX        4+lOads,a3
          aa,u      a3,1
          tne       a0,rqUote+1
          j         bUfeMpsTr           . sTore qUote cHaracter
          tne,u     a0,'M'              . tEst qUoted <cr>
          j         3+$
          lmj       x11,cTl
          j         bUfeMpsTr
bUfeMpqcR.
          lx,u      x11,1
          sx        x11,rCvsTate
          tg,h2     a3,0,a1
          j         bUfeMpdN
          eX        4+lOads,a3
          aa,u      a3,1
          tne       a0,rqUote+1
          j         4+$
          ana,u     a3,1
          la,u      a0,015
          j         bUfeMpsTr           . sTore <cr> aS dAta
          tg,h2     a3,0,a1
          j         -4+$                . sTore <cr> aS dAta
          ex        4+lOads,a3
          aa,u      a3,1
          tne,u     a0,'J'              . tEst iF qUoted <lf>
          j         4+$
          ana,u     a3,2
          la,u      a0,015              . sTore <cr> aS dAta
          j         bUfeMpsTr
. wE have fOund <cr><lf>.
. tHat mEans eNd oF lINe.!
          lmj       x11,wRteLt
          noP
          sz        rCvsTate
          j         bUfeMplP
bUfeMpsTr.
          tle       a4,a5               . iS tHere rOom fOr a cHaracter?
          j         bUfeMpsTra          . yEs...
          tnz       cOntinue+1          . iS a cOntinuation cHaracter sPecified
          j         bUfeMpsTrb          . 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         bUfeMpsTra          . pRoceed tO sTore cUrrent cHaracter
bUfeMpsTrb.
          lmj       x11,wRteLt          . wRite cUrrent lIne tO eLement
          nOp
bUfeMpsTra.
          dsc       a3,36
          ex        sTores,*a3
          dsc       a3,36
          sz        rCvsTate
          j         bUfeMplP
bUfeMpdN.
          sa        a4,eLtiNdex
          pOp       r1,a5,a4,a3,a2,a1,a0,x11
          j         0,x11
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,tYpe+1
          la        a1,2,a1
          tne       a1,('BINA')
          j         bUfiLlbIn
          la        a5,(+1,0)
          aa        a5,spAklEn+1
          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
          tg,u      a0,040
          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
          j         bUfIllsc
          eX        4+sTores,*a3
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,gEtas$
          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
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,gEtaS$
          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
/.
.
.
. ******************************************************************************
.
. 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
          lmj       x11,iNitialize
          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.
          la,u      a0,fAlse
          j         rEcsWx
rEcsWtRue.
          la,u      a0,tRue
rEcsWx.
          tz        oPeneLt
          lmj       x11,esOr$
          sz        oPenelt
          lmj       x11,sHutdOwn
          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
/.
.
.
. ******************************************************************************
.
. 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'
          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
          lmj       x11,cLosR$          . cLose tHe iNput eLement
          j         seofeRr             . eRror sHould bE rAre tHing iNdeed
          la,u      a0,'B'
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 asci
.
. ******************************************************************************
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,6
          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,rqUote+1         . cOntrol-qUote cHaracter i sEnd
          eX        9+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
          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
          sa        a0,spAklEn+1        . mAximum sEnd pAcket sIze
          tg,h2     a3,0,a1
          j         rpArx
          eX        4+lOads,a3
          aa,u      a3,1
          lmj       x11,uNcHar
          sa        a0,stImoUt+1        . 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,spAd+1           . 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,spAdcHr+1        . pAd cHaracter tO sEnd
          tg,h2     a3,0,a1
          j         rpArx
          eX        4+lOads,a3
          aa,u      a3,1
          lmj       x11,uNcHar
          sa        a0,seNdlIn+1        . eol cHaracter i mUst sEnd
          tg,h2     a3,0,a1
          j         rpArx
          eX        4+lOads,a3
          aa,u      a3,1
          sa        a0,sqUote+1         . iNcoming dAta qUote cHaracter
rpArx.
          pOp       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,rtImoUt+1
          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
          eX        lOads,*a3
          tne       a0,rsYnc+1
          j         rpAcksYnc           . fOund sYnc cHaracter
rpAcksRch.
          jGd       r1,-3+$
          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,rsYnc+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,rsYnc+1
          j         rpAcksYnc
          lmj       x11,uNcHar
          sa        a0,rpAck$nUm
          jgd       r1,2+$
          j         rpAckeRr
          eX        lOads,*a3           . pAcket tYpe
          tne       a0,rsYnc+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+$
          la,u      a0,' '
          j         2+$
          eX        lOads,*a3
          tne       a0,rsYnc+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
          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,spAd+1           . # pAd cHaracters
          la        a0,spAdcHr+1        . pAd cHaracter
          j         2+$
          eX        4+sTores,*a3
          jgd       r1,$-1
          la        a0,ssYnc+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+$
          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,sEndlIn+1        . eNd oF lIne cHaracter
          te,u      a0,015
          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.
          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
          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        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,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
          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
$(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        . rEquested so cYcle
          +0                            . nExt wRite lOcation
          'k$e$r$m$i$t$'
          ' '       . eLement nAme
          ' '
          +0
          +1,0
          ' '       . vErsion nAme
          ' '
          +5,0,1
          +0
          +0
          +0
          +0
          ascii
fIlenAme.
          sTrng     'tpf$                            '
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
rDaCtive.
          +0        . sEt nOn-zEro bY iNitialize
                    . sEt zEro bY sHutdOwn
rEadbUf.
          rEs       40
spAckbUffer.
          +100,0
          rEs       25
sTack     rEs       100
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>'
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
dElay     vAriable  'DELAY' dEcimalt,0,99,6
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','8BIT'
.
. rEceive pArameters *******
rpAklEn   vAriable  'PACKETLENGTH' dEcimalt,10,96,94
rpAd      vAriable  'PADDING' dEcimalt,0,30,0
rpAdcHr   vAriable  'PADCHAR' cNtrlt,0
rtImoUt   vAriable  'TIMEOUT' dEcimalt,5,60,5
rqUote    vAriable  'QUOTE' cHart,043
rEndlIn   vAriable  'ENDOFLINE' cNtrlt,015
rsYnc     vAriable  'SYNC' cNtrlt,01
.
. sEnd pArameters *********
spAklEn   vAriable  'PACKETLENGTH' dEcimalt,10,96,94
spAd      vAriable  'PADDING' dEcimalt,0,30,0
spAdcHr   vAriable  'PADCHAR' cNtrlt,0
stImoUt   vAriable  'TIMEOUT' dEcimalt,5,60,5
sqUote    vAriable  'QUOTE' cHart,043
seNdlIn   vAriable  'ENDOFLINE' cNtrlt,015
ssYnc     vAriable  'SYNC' cNtrlt,01
          eNd       sTart
