. 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 . 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 ,' sTrng 'Dumps lines from the debug file starting' sTrng 'at the th line.' sTrng 'If you omit one line will be dumped.' sTrng 'If you omit both and then one line' sTrng 'will be dumped at the previously dumped line+1.' +0 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 ' 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 ' 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 ' sTrng ' 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 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 aS dAta tg,h2 a3,0,a1 j -4+$ . sTore aS dAta ex 4+lOads,a3 aa,u a3,1 tne,u a0,'J' . tEst iF qUoted j 4+$ ana,u a3,2 la,u a0,015 . sTore aS dAta j bUfeMpsTr . wE have fOund . . 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 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 ). . 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= 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