Title K20IOC Kermit Input/Output statement Control search monsym,macsym,cmd,k20unv ;[194] cmdacs ;Clean up p1-p4 definitions sall ; tidy listing, please .directive flblst ; We don't need to see all the ASCIZ bytes... ;N.B., although this module is new with a large amount of rewrites, ; some attempt has been made to keep old edit numbers for cross- ; reference purposes. subttl External routines and storage remark common parsing external data extern pars1 ; Data from first parse. extern pars2 ; Data from second parse. extern pars3 ; Data from third parse. extern pars4 ; Data from fourth parse. extern pars5 ;[41] ... extern pars6 ;[209] If $INPUT is not getting driven by .INPUT extern pars7 ;[229] If TRANSMIT is sending some kind of EOF extern pars8 ;[229] If $INPUT matching should not type anything extern buffer ; Used for foreign file names and string conversion remark cmd storage used extern sbk ; Command State Block (CSB) extern atmbuf ; Atom buffer extern atmbln ; Length of atom buffer (in words) remark Linkages with the main and other parsers extern chksec ; k20par: See if we got a silly floating point value extern definf ; k20mac: Set if we are defining a macro remark Various JFN's and related control storage extern netjfn ; Network JFN, if not a remote Kermit extern ttyjfn ; User's terminal JFN, if remote Kermit extern takjfn ; JFN of current TAKE file extern popjfn ; Routine to switch between takjfn's extern sesjfn ; JFN for session logging file extern sesflg ; Control flag for active usage of same extern filjfn ; Current open file extern cjfnbk ; COMND%'s GTJFN% block extern isnulj ; Determine if this JFN is on NUL: extern frclos ; Force a JFN to close (or release it) remark Handshke, Parity and Duplex Handling extern handsh ; Handshake character (if any) extern parity ; Points to whatever parity (routine) we're using extern duplex ; Who is doing the echoing remote host or us remark User and Network terminal handling extern chklin ; Check line (or NRT or PTY) status extern carier ; Line carrier (or good NRT or PTY JFN) extern doarpa ; Set up for network binary (if on a TVT) extern vtermf ; Virtual terminal flag (NRT, PTY, PIP eventually) extern ttyob ; Put local terminal in binary mode extern ttyou ; Put local terminal back in user mode extern dobits ; Set terminal line for transparent I/O extern unbits ; Undo effects of dobits remark Various performance counters for the interested extern nbict ; Network BIN% count extern nsici ; Network SIN%'s count (total issued) extern nsimx ; Network SIN% maximum length extern nsitc ; Network SIN%'s total characters read extern vsoct ; Virtual Terminal SOUTR%'s Issued extern vsotc ; Virtual Terminal SOUTR% Total Characters extern vsomx ; Virtual Terminal SOUTR% Maximum length remark Terminal and TIMER% interrupt handling extern ccon ; Turn ^C handling on extern ccoff2 ; FORCE ^C handling off extern cmpon ; Turn ^M and ^P handling on extern cmpoff ; Turn ^M and ^P handling off extern cmseen ; ^M seen extern cmloc ; Location transfer execution to on ^M extern cpseen ; ^P seen extern cploc ; Location transfer execution to on ^P repeat 0,< extern intpc ; PC to restore on timer interrupt. extern intstk ; Stack pointer to restore on timer interrupt. extern timchb ; TIMER% interrupt chanel bit > extern timeon ;[209] Set up a TIMER% extern timdel ;[209] Delete any pending TIMER%'s remark Buffer and Strings extern strc ; Counter for, and... extern strptr ; pointer into the... extern strbuf ; Gigantic string buffer (1,000 words!!) extern strbf2 ; Another one remark Networking Linkages and variables extern clrest ;[209] Return estimate of available data extern clrbuf ;[209] Clear monitor buffers extern local ;[209] Non-zero if a local Kermit remark Other random useful things extern %%jser ; JSYS error handler (for %jserr macro) extern errptr ; Pointer to error text (for ermsg% macro) extern crlf ; byte (7) .chcrt, .chlfd, .chnul extern jobtab ; Result of GETJI%; used to determine batchness extern nul4 ; Negative counted pointer to "NUL:" .psect code/ronly ; Pure code, pure heaven subttl SET INPUT command initial parsing %table(sintab) %key3 , .sinca, incase %key3 , .sindt, indeft %key3 , .sinse, indefs ;[209] %key3 , .sinta, intima %tbend ; SET INPUT parsing, like SET SEND/RECEIVE -- an extra level of parsing. chgsec(code,const) ;;FDB's go in const .psect tinfdb: flddb. .cmkey,,sintab retsec ;;Return to code .psect .setin: entry .setin ;[209] Invoked from k20par movei t1, tinfdb ;[209] call rfield ; Parse a keyword. hrrz t2, (t2) ; Get the command routine addresses. movem t2, pars3 ; Save into pars3. hlrz t1, (t2) ; Get the next level routine. call (t1) ; Call it. ret subttl SET INPUT CASE parsing %table(castab) ; Case table. %key2 , 0 %key2 , 1 %keyf3 , 1, cm%inv ;[212] Tom gets sleepy... %tbend chgsec(code,const) ;;FDB's go in const .psect incfdb: flddb. .cmkey,,castab,,,incfd1 incfd1: flddb. .cmcfm,,, retsec ;;Get back into code .psect cleans() ;;Clean out temporary symbols .sinca: saveac ;[209] Need to remember function code guide ; SET INPUT CASE movei t1, incfdb call rfield ;[209] Parse a keyword or default ldb q1, [pointr (.cmfnp(t3),cm%fnc)] ;[209] Pick up function code caie q1, .cmcfm ;[209] Want's default? ifskp. ;[209] That's easy, give him the default setz t2, ;[209] This is the parse value for "ignore" else. ;[209] Otherwise, handle the keyword hrrz t2, (t2) ; Get the value for the keyword (0 or 1). endif. ;[209] movem t2, pars4 ; Save into pars4. cain q1, .cmcfm ;[209] Was default requested? ret ;[209] It was, so don't reconfirm a confirmation skipn definf ; In DEFINE? confrm ; No, get confirmation. ret subttl SET INPUT DEFAULT-TIMEOUT parsing ; N.B., When chksec succeeds, it succeeds completely, putting the ; calculated millisecond value in pars4 and the floating point ; seconds in pars5. Both are displayed by SHOW INPUT because the ; floating point is easier to read, the milliseconds perhaps being ; of interest to debuggers, mathematicians and the curious. chgsec(code,const) ;;Chained FDB's go in const .psect indfdb: flddb. .cmflt,,,,,indfd1 indfd1: flddb. .cmcfm,,,,, retsec ;;Get back into code .psect cleans() ;;Keep listing tidy .sindt: saveac ;[209] Need to remember function code guide movei t1, indfdb ; Various alteratives call rfield ; Try to get one of them ldb q1, [pointr (.cmfnp(t3),cm%fnc)] ;[209] Pick up function code caie q1, .cmcfm ;[209] Want's default? ifskp. ;[209] That's easy, give him the default movx t2, <10.> ;[209] Ten seconds in floating point else. ;[209] Otherwise, better sanity check it ifl. t2 ;[209] Is the number deeply silly?? emsg ;[209] jrst cmder1 ;[209] However, allow reparse endif. ;[209] End non-default initial check endif. ;[209] Either way, t2 has a floating point value remark ;[212] When chksec works, it works completely call chksec ;[196] Ensure number is in correct range ifskp. ;[196] Check and convert OK? cain q1, .cmcfm ;[209] It did. Was default requested? ret ;[209] It was, so don't reconfirm a confirmation skipn definf ; In DEFINE? confrm ; No, get confirmation. ret ;[212] Either way, we're done else. ;[196] Otherwise, couldn't swallow something emsg ;[196] jrst cmder1 ;[196] Allow reparse endif. ;[196] End case checking and conversion subttl SET INPUT SEARCH-DEFAULT parsing ;[209] Begin code insertion ; Calls the string parsing portion (.INPU1) to get the string and ; build the appropriate storage. Then hijacks the rest of the parse ; to get our semantic action routine called instead of having a value ; be set. ; ; Because of the design of the main parser to allow macro definitions ; and to be compliant with that paradigm, this involves an extra level ; of indirection, as seen below $sinsi: $sinse ; Indirect call .sinse: call .inpu1 ; Parse just as if it were typed to INPUT hllz t1, @pars2 ; Load invoking keyword (SET INPUT) hrri t1, $sinsi ; Load indirected address of our semantic action movem t1, pars2 ; and take over the rest of the parse ret ; Return below $sinse: saveac ; Needs some registers skiple q1, strc ; Did it get any characters? ifskp. ; No, so go with old reliable setzm indefw ; Flag no default (nothing for xblt.) ret ; Done endif. move t2, q1 ; Load character count setz t1, ; Cast positive word to signed long divi t1, ^d5 ; Convert to word count, five characters per word ifn. t2 ; Any remainder? aos q2, t1 ; Round up a word and store else. ; Otherwise, it fit exactly move q2, t1 ; So no need to round endif. remark t1, ; Still has word count hrrz t2, strptr ; Load whatever address the string pointer points to movei t3, indefs ; And storing it in our defaulting buffer xblt. t1 ; Tuck away for when needed dmovem q1, indefc ; Store character and word count ret ; Finally done ;[209] End code insertion subttl SET INPUT TIMEOUT-ACTION parsing %table(itatab) ; INPUT timeout action table %keyf3 , 0, cm%inv ;[186] Tom gets sleepy... %key2 , 0 %key2 , 1 %keyf3 , 1, cm%inv ;[186] Tom gets sleepy... %tbend chgsec(code,const) ;;FDB's go in const psect intfdb: flddb. .cmkey,,itatab,,,intfd1 intfd1: flddb. .cmcfm,,,,, retsec cleans() .sinta: saveac ;[209] Need to remember function code guide movei t1, intfdb ;[209] Load parse fdb address call rfield ;[209] And see what he wants ldb q1, [pointr (.cmfnp(t3),cm%fnc)] ;[209] Pick up function code caie q1, .cmcfm ;[209] Want's default? ifskp. ;[209] That's easy, give him the default setz t2, ;[209] This is the parse value for "proceed" else. ;[209] Otherwise, handle the keyword hrrz t2, (t2) ; Get the value for the keyword (0 or 1). endif. ;[209] Either way, have something in t2 movem t2, pars4 ; Save into pars4. cain q1, .cmcfm ;[209] Was default requested? ret ;[209] It was, so don't reconfirm a confirmation skipn definf ; In DEFINE? confrm ; No, get confirmation. ret subttl INPUT command parsing ; The previous approach relied on defaulting a value to skip a field ; which limited the operation of question mark and escape recognition. ; The parsing logic now offers to directly go to textual input so that ; this option shows up in the question mark menu. ; ; It makes either learning the command or being reminded about it a ; more pleasing if not easier experience. It also cuts COMND% ; overhead down by a JSYS, which is probably not detectable in all but ; the most extreme of circumstances. ; ; This all works because we don't need to default the parse to know ; what the default values are. ; ; INPUT and OUTPUT were all revisited because making Kermit Batch ; compliant forced far greater usage for testing purposes. remark Switch values for INPUT and TRANSMIT %eofsw==0 ;[229] We parsed the EOF switch %silsw==1 ;[229] We parsed the 'silent' switch %timsw==2 ;[229] We parsed the 'timeout' switch ;[229] %table puts stuff in the correct .psect %table (inpswi) ;[229] The INPUT switch table %key2 , %silsw ;[229] Tells $input to shut up about matches %tbend ;[229] End of table chgsec(code,const) ;;Chained FDB's go in const inpswf: flddb. .cmswi,,inpswi,,,inpfdb inpfdb: flddb. .cmflt,,^d10,,,txtfdb txtfdb: flddb. .cmcfm,,,,,txtfd1 txtfd1: flddb. .cmqst,,,,,txtfd2 txtfd2: flddb. .cmtxt,,,,, retsec ;;Return to code .psect cleans() ;;Clean up the symbol table .input: entry .input ; Invoked from K20PAR saveac ;[212] Used for control flow remark buffer ;[209] Preserve buffer across calls!!! guide .inpu0: setzb t1, t2 ;[209] Cons up some .chnuls dmovem t1, atmbuf ;[209] Give the atom buffer a good scrub a dub movei t1, inpswf ;[212] Pointer to full menu call rfield ;[190] Finally parse something ldb q1, [pointr (.cmfnp(t3),cm%fnc)] ;[212] Get function code. caie q1, .cmswi ;[229] Did we get a switch? ifskp. ;[229] We did, handle it block. ;[229] Enter block for better control flow hrrz q3, (t2) ;[229] Pick up the switch value caie q3, %silsw ;[229] Parsed the 'silent' switch? ifskp. ;[229] We did, so that should be easy enough setom pars8 ;[229] Just flag it in the parse block retskp ;[229] Return for next switch endif. ;[229] End 'silent' switch case ret ;[229] Otherwise, some kind of bogus switch endbk. ;[229] End Block context ifskp. ;[229] Successful switch parse jrst .inpu0 ;[229] Go see if more switches (or device or file) else. ;[229] Otherwise, some kind of error emsg ;[229] This is an internal programming error jrst cmder1 ;[229] However, allow reparse endif. ;[229] End of switch block processing endif. ;[229] End of .cmswi case caie q1, .cmcfm ;[209] Confirmation? ifskp. ;[209] Yes, let's default everything dmove t1, indeft ;[209] Load default millisecond and floating values dmovem t1, pars4 ;[209] Store them as if they were parsed jrst .inpu2 ;[209] Go handle it as if we parsed this as a string endif. ;[209] Either way, must 'recompile' the search caie q1, .cmflt ;[212] Parsed a floating number? ifskp. ;[212] Yes, check it ifl. t2 ;[212] Is the number in the right range? emsg ;[212] Yah silly!! jrst cmder1 ;[212] Allow reparse else. call chksec ;[212] Ensure number is in correct range ifskp. ;[212] Check and convert OK? Then side-effect variables jrst .inpu1 ;[212] Yes, then carry on to parse a string to find else. ;[212] Otherwise, couldn't swallow something emsg ;[212] jrst cmder1 ;[212] Allow reparse endif. ;[212] End case checking and conversion endif. ;[212] End case special messaging check remark ;[212] Falls out to parse txtfdb else. ;[212] Else never got a number dmove t1, indeft ;[212] Load default millisecond and floating values dmovem t1, pars4 ;[212] Store them as if they were parsed jrst .inpu2 ;[212] Go handle the string we parsed endif. ;[212] End case parsed a floating nuber (or not) ;[208] Originally shut off indirection, but since quoted strings allow us ; to put in an at-sign (@) as well as escape sequences, this was ; removed to allow backward compatibility with any take files which ; rely on this. .inpu1: guide ;[190] Guide us to type the next thing setzb t1, t2 ;[209] Cons up some .chnuls dmovem t1, atmbuf ;[209] Give the atom buffer a good scrub a dub movei t1, txtfdb ;[209] Parse some kind of input text call rfield ;[209] Get an input string ldb q1, [pointr (.cmfnp(t3),cm%fnc)] ;[212] Get function code again .inpu2: remark ;[209] Here if .cmcfm was only thing typed caie q1, .cmcfm ;[209] Confirmation? ifskp. ;[209] Yes, let's default the search skiple t1, indefw ;[209] But!! Do we have a default string? ifskp. ;[209] No, so use wired default movx t1, < byte (7) .chcrt, .chlfd > ;[209] Which fits in 18 bits movem t1, atmbuf ;[209] Store NUL terminated bare CR-LF sequence else. ;[209] Otherwise, have a default, so drop that in dmove t2, [ indefs ;[209] Load address of default expanded string atmbuf] ;[209] Load address of match string buffer xblt. t1 ;[209] Stomp into place endif. ;[209] End case hardwired default movem q1, pars3 ;[209] Let any caller know what we're doing endif. ;[209] Continue with atom buffer properly conditioned setzb t1, t2 ;[209] Cons up some NUL's dmovem t1, strbuf ;[209] Get string match buffer into a known state move t2,[point 7,atmbuf] ;[209] Let's see what's in the atom buffer ildb t1, t2 ;[209] Get the first byte ifn. t1 ;[209] Only if not .CHNUL call bsrchs ;[209] Build a search string from it jrst cmder1 ;[209] Failed, allow reparse skipn strbuf ;[209] Did anything go in there?? anskp. ;[209] Nope, maybe was a "\0" or some such else. ;[209] Otherwise, some bad thing setzm strc ;[209] We surely have no characters to match endif. ;[209] Otherwise, not searching (sigh) setzm pars6 ;[209] Say we're handling the control-C cain q1, .cmcfm ;[209] Have we confirmed our selection? ifskp. ;[209] Don't reconfirm, that's confusing skipe definf ;[209] BUT!! Are we defining a macro? anskp. ;[209] We are, let .define confirm for us confrm ;[209] Tie off the line endif. ;[209] ret subttl INPUT command semantic action ;N.B., Note the reordering of the timing JSYi in the routine. The ; purpose is to prevent us from getting caught with some stray ; TIMER% interrupt. So we clear timers BEFORE activating the timer ; channel and disable the channel BEFORE clearing any timers. $input: entry $input ;[194] skipg t2, pars4 ;[212] Integer milliseconds ifskp. ;[212] Wants time outs, so set them skipe pars6 ;[229] Did we already do this? anskp. ;[229] Yes, so don't stomp TRANSMIT movei t1, looptm ;[209] Go to loop time out exit call timeon ;[209] Set the timer for it endif. ;[212] ; Condition line, set up Control-C trap $inp4a: ifme. pars6 ;[209] Are we handling the ^C? call ccon ; Turn on ^C trap. jrst $inpuy ; If ^C typed, go to this place. endif. ;[209] End case possible ^C override ifme. vtermf ;[194] Calls only make sense for terminals skipe pars6 ;[209] Is somebody else doing this? jrst $inpu5 ;[209] Yes, so leave the terminal alone call dobits ; Condition the line for i/o. ret ; Pass along any failure. call ttyob ; Put TTY in binary mode for output only. remark ;[209] Fall through to legacy code else. ;[209] Otherwise, use enhanced network I/O callret netins ;[209] Dispatch to Network Input Matcher endif. ;[186] Otherwise, MTOPR%'s will blow up $inpu5: move t4, [point 7, strbuf] ; Point to the search string. $inpu6: skipn strc ; Is there a search string? jrst $inpu7 ; No, just go forever. ildb t3, t4 ; Get a character from search string. jumpe t3, $inpux ; If no more, then success. ;... ;...$INPUT, cont'd ; Get & echo a character, compare with current position in search string. ;[204] Maybe rethink this BIN% loop, it's got a high JSYS overhead ; In other words, when should we call netins? $inpu7: skipg t1, netjfn ;[186] Now get a character from the line. move t1, ttyjfn ;[186] Not network, using local setz t2, BIN ifje. r ;[186] Failed?? caie t1, IOX4 ;[186] Unexpected end of file? %ermsg (,$inpux) ;[186] Something else, so just drop dead jrst $inpu9 ;[186] Handle like a time out endif. ;[186] andi t2, ^o177 ; Strip any parity. ifme. pars8 ;[229] Only if not /SILENT move t1, t2 ; Echo the character. PBOUT endif. ;[229] skipg t1, sesjfn ;[195] Session logging? ifskp. ;[195] Some kind of JFN skipn sesflg ;[195] Is logging active? anskp. ;[195] No, so don't log it BOUT ; Yes, record the character in the log. erjmpr .+1 ;[195] Catch and ignore error endif. ;[195] ifme. incase ;[194] Case-INsensitive compare? cail t2, "a" ; No, is this a lower case letter? caile t2, "z" anskp. ;[194] Not lower case txz t2, 40 ; Yes, convert to upper. endif. ;[194] camn t2, t3 ; Compare OK? jrst $inpu6 ; Yes, get next from string and comm line. jrst $inpu5 ; No, rewind search string, get next from line. ; Come here upon input timeout. $inpu9: ifme. intima ;[187] Proceeding? txmsg < %KERMIT-20: INPUT timed out looking for "> ;[187] else. ;[187] Otherwise an error, so not proceeding emsg ;[187] ;" endif. ;[187] Error message if quitting (for batch) hrroi t1, strbuf ; Tell what string we couldn't find. PSOUT ifme. intima ;[187] Proceeding? txmsg <", proceeding... > ;" ;[187] Say what we're doing, proceeding jrst $inpux ; Proceeding, just exit from the INPUT command. endif. ;[187] remark ;[187] Otherwise, not going any further txmsg <", quitting > ;" ;[187] ... quitting. skipg t2, takjfn ;[209] Quitting, are we in a file? ifskp. ;[209] We are, so blat and close it movei t1, .priou ;[209] No matter what, all output to terminal tlz t2, -1 ;[209] Shut off any GTJFN% flags caie t2, .nulio ;[209] Just testing? ifskp. ;[209] Yes, so special case that dmove t2, nul4 ;[209] Load counted special string setz t4, ;[209] Just in case SOUT% ;[209] Write the NUL: device name erjmpr .+1 ;[209] Catch and quietly ignore error else. ;[209] Otherwise, a bona fide JFN setzb t3, t4 ;[209] No flags and no prefix (whatever that is) JFNS% ;[209] Type the actual file name erjmpr .+1 ;[209] Catch and quietly ignore error endif. ;[209] End typing some kind of file name endif. hrroi t1,crlf ;[209] Tie off the line PSOUT% $inpuy: call popjfn ; Pop the TAKE file JFN from the TAKE stack. ; Exit thru here, turning off timer, restore line to previous condition. $inpux: ifme. pars6 ;[209] Am I handling the ^C? call ccoff2 ; Turn off ^C trap. ifme. vtermf ;[186] Calls only make sense if not virtual call unbits ; Restore the line call ttyou ; Restore controlling tty output. endif. ;[186] Otherwise, MTOPR%'s will break endif. ;[209] End case possible ^C override skipg pars4 ;[212] Integer millisecond sleep? ifskp. ;[212] Yes, shut off the timers, etc call timdel ;[209] Whack any future timers endif. ;[212] End case positive intervale skipe pars6 ;[209] Repeated internal call from $TRANS? ret ;[209] We're done $inpcl: remark ;[209] Have to clean up post $input setzb t1, t2 ;[209] Cons up a double word of zeros dmovem t1, strc ;[209] No string, so no length remark strptr ;[209] Not pointing anywhere dmovem t1, strbuf ;[209] Stomp a bit of the search buffer and dmovem t1, strbf2 ;[209] also a bit of the translation buffer remark buffer ;[209] Preserve buffer across calls ret subttl Network Input Searcher ;[209] Begin Code Addition ; Expects bsrchs to have been called for a search structure ; inpcnt and inpptr to have been kept up to date from last call netins: saveac dmove q1, inpcnt ; Load current place in input buffer skipg q3, netjfn ; Assume network (which can be a physical line) move q3, ttyjfn ; Not network, so using login terminal tlz q3, -1 ; Either way, no flags do. ; Enter loop context caige q1, strblc ; First of all, can we swallow anything else? ifskp. ; Nope, try to drain a little off caig q1,0 ; BUT!! Nothing read? anskp. ; Then go read something move q4, q1 ; Save current length call matchs ; See if we can match anything skipa ; Didn't... exit. ; Did!!!!! cail q1, q4 ; Was this helpful in any way? jrst loopov ; No, we're wedged and can't go any futher.. endif. block. ; Kind of clunky, but needed for control flow do. ; Enter inner loop jumpe q1, R ; If nothing read, break out camge q1, strc ; Do we have enough to match? ret ; No, then get out of loop and block context call matchs ; See if we can match anything loop. ; Nope, see if we can try again retskp ; We did, so pass that on enddo. ; Exit loop lexical context endbk. ; Exit Block Context ifskp. ; Handle +2 from inner loop exit. ; Exit out main loop success!! endif. move t1, q3 ; Load JFN to read from BIN% ; Wait for something from somebody %jserr (,loopio) ;[186] No, die. aos nbict ;[204] Count a network BIN% addi q1, ^d1 ; Count a character to do idpb t2, q2 ; Drop into the output buffer call clrest ; Find out how much, if anything, remains jrst loopio ; Already complained, so break loop context movei t3, strblc ; Load maximum buffer length sub t3, q1 ; Subtract off what is already in there sub t3, t1 ; Next, subtract how much we could use caige t3, 0 ; Not enough buffer space? add t1, t3 ; 'Subtract' off the excess (add negative) ifg. t1 ; OK, is there anything for us to read? add q1, t1 ; Accumulate in total camle t1, nsimx ; Smaller than biggest? movem t1, nsimx ; Nope, we have a new winner addm t1, nsitc ; Update Network SIN% total characters read aos nsici ; Update Network SIN%'s Issued movn t3, t1 ; Load exact amount to read move t1, q3 ; Reload the JFN move t2, q2 ; Keep reading into the buffer SIN% ; Get that data! ifje. r ; Failed?? move q2, t2 ; Update what we did read add q1, t3 ; 'Subtract' from used (t3 is negative) addm t3, nsitc ; Correct Network SIN% total characters NOT read %ermsg (,loopio) ; No, go drop dead endif. move q2, t2 ; Keep track of where we are in the buffer endif. ; End data read camge q1, strc ; Do we have enough to match? loop. ; No, get some more goodies call matchs ; See if we can match the search string loop. ; Didn't match exit. ; We did, so we're done enddo. ; Exit loop context dmovem q1, inpcnt ; Store updated buffer count and position jrst $inpux ; Success!!! subttl Various loop error handlers loopio: remark ; Here for an I/O error dmovem q1, inpcnt ; Store updated buffer count and position jrst $inpuy ; Pop any take JFN's, disable ^C, timers, Etc. looptm: remark ; Here for assumed timer errors dmovem q1, inpcnt ; Store updated buffer count and position jrst $inpu9 remark Common Buffer overflow handler loopov: remark ;[209] Here for buffer buffer full dmovem q1, inpcnt ; Store updated buffer count and position ermsg%(,$inpux) ;[209] Gronk on buffer overflow subttl Match String Overview and String Instructions ; The purpose of the routine below is to change the former search ; search paradigm from a byte at a time comparison to support a ; buffered approach while also benefiting from the use of string ; instructions. ; ; It is not the overhead of a ildb/idpb loop that is being saved so ; much as the JSYS overhead. For every character, both a BIN% and a ; BOUT% were needed, which involves the maximum context switching ; overhead with all that implies. ; ; Here, the maximum JSYi that will be executed for any read and print ; will be 4 of them: BIN%, SIBE%, SIN% and SOUT% (both counted for ; speed). This means that if you read more than two characters, you ; are going to win. ; ; This code is driven by the main loop in netins, which reads as much ; input as it can get until the threshold of the length of the search ; string is hit. At that point, this routine is invoked to see if ; there is a match. ; ; Simply put, the code uses a MOVST to trigger on the first character ; of the string. If the character is never hit, then the search ; criteria are not met and we return +1. In this case, we have ; effectedly searched through the entire contents of the buffer and ; need merely print and reset it via the ntriger exit. If the ; character is hit, then a CMPSE instruction is used to determine if ; the rest of the string matches. ; ; Whatever does not match is printed and removed from the network ; buffer. This operation is known here as a 'pull up' and is done ; with a MOVSLJ. ; ; Some of the extra code here is to handle caseless compares. Because ; the string compare instructions are case sensitive, we have to ; uppercase everythingt we compare first. ; ; However, the bulk of the code is to handle buffer management and, in ; particular, all the edge cases: single character search strings, a ; single character the buffer, matching on the last character, but ; still having remaining characters to compare, Etc. remark ; Various Extended Instructions m1stch: movst 0, sertab ; Use constructed trigger table .chnul ; No fill, acually movsup: movslj 0,0 ; Move string left justified (fastest) .chnul ; Fill character (never used in this case) cmprmn: intern cmprmn ; Also used in k20tim to double check parity cmpse 0,0 ; Compare and skip if equal .chnul ; Fill character 1 .chnul ; Fill character 2 str2bp: point 7, strbf2 ; Handy place to dump translated data subttl Match String Routine ; Entry ; ; q1/ Count of characters in network buffer ; q2/ Pointer into network buffer ; ; Exit: ; ; +1/ Didn't find the search string ; +2/ Successfully found the first instance of it (there may be others) ; ; In both cases, return with: ; ; q1/ Updated count of characters in network buffer ; q2/ Updated pointer to the end network buffer ; ; These are are either directly returned by matchs or indirectly by ; ntrigr. ; ; Note, we always have to back the source pointer up before the match ; character so that we can match the entire string. If we've skipped ; the match character and just compare the suffix string (like we used ; to do...) and it is the last thing in the buffer, then we will do ; the wrong thing after we come back from refilling the buffer (like ; we did in an earlier version...) ; ; To do: Possibly some of the exit code is really replicated. Maybe ; see what could be reasonably combined. On the other hand, it ; finally works... ; ; If doing an exact match, could bum the second MOVST which is just ; then a MOVSLJ. Would need to fix up the linkages. And it ; finally works... matchs: ifle. q1 ; First of all, is there anything to do? ermsg% (,r) ; Program logic error else. ; Otherwise, do we have enough to chew on? camge q1, strc ; Enough to match our search string? ermsg% (,r) ; Another bogon endif. ; OK, so let's try to do something useful saveac dmove q3, q1 ; Save current network buffer length and position movn t2, q3 ; Load negative count of buffer contents adjbp t2, q4 ; Back source up to beginning of network data move q5, t2 ; Save beginning of network data for later ifme. strc ; But!! Anything to search for?? setz t1, ; Fine, say we looked through all of it call ntrigr ; Go ditch all of it retskp ; Return success; matching everying ... endif. move t1, q3 ; Length we'll look at; total contents move t4, t1 ; Force equal lengths so no filling occurs move p4, t1 ; Save this length for later move q1, str2bp ; Destination is the translation buffer setzb t3, q2 ; Force section local pointers txz t1, S!N!M ; No need to translate until we hit the match extend t1, m1stch ; Trigger on MOVST termination code nop ; Ignore any skip (which should never happen) dmove p2, t1 ; Save remaining characters and position txnn t1, N ; Did we find anything? callret ntrigr ; No, go blat, reset the network buffer and return remark ; Hit trigger, was this the only thing we needed to find? txz t1, S!N!M ; Stomp any flags txz p2, S!N!M ; in the copy, too move t4, strc ; Load match length caie t4, ^d1 ; Search string was only one dinky character? ifskp. ; Yep, we're done move p4, q3 ; Load original length sub p4, p2 ; Compute consumed characters ifme. pars8 ;[229] Only if not /SILENT movei t1, .priou ; Typing on the terminal move t2, q5 ; Source is where we started movn t3, p4 ; How much we'll type ifl. t3 ; Don't print if we computed gubbish SOUT% ; Counted SOUT% to terminal %jserr (,) endif. endif. ;[229] dmove t1, p2 ; Source is where MOVST stopped ife. t1 ; Was this at the END of the buffer? setz q1, ; Yes, so just zero out the count move q2, q5 ; and reset to the beginning of the buffer retskp ; About as easy as it gets endif. ; Otherwise, pull the string up move t4, t1 ; Force no filling to occur move q1, q5 ; Goes to top of buffer setzb t3, q2 ; Just in case extend t1, movsup ; Move the string up nop ; Ignore +1 (which should never happen) move q2, q1 ; Ending destination is where we can now append move q1, p2 ; And load characters remaining in buffer retskp ; Return success endif. ; Otherwise, do the non-single character case remark ; First, fix up the pointers to match the string seto p3, ; Back up before the skip character adjbp p3, t2 ; So we can match the entire string aos p2, t1 ; Account for an inconsumed character (preserves flags) remark p4, ; Still has original length from above move p5, str2bp ; Always reset the destination pointer remark ; Calculate match position move t4, q3 ; Load original length sub t4, t1 ; Calculate total done remark ; Handle case of match being first character caig t4,0 ; Anything to print? ifskp. ; Yes, wasn't the first character call netprn ; Print what we've seen and what will get tossed endif. remark ; What we've printed is no longer relevant, chuck it camn q3, p2 ; But!! Did we not match at the first character?? ifskp. ; We did not, so do the pull up dmove t1, p2 ; Source is the last thing we've looked at move t4, t1 ; Force no use of fill characters move q1, q5 ; Destination is top of buffer setzb t3, q2 ; Force section local pointers extend t1, movsup ; Move the string up nop ; Ignore +1 (which should never happen) move q3, p2 ; Update reduced number of characters in network buffer move q4, q1 ; New append is ending destination of MOVSLJ remark p2, ; Unchanged, same number of characters move p3, q5 ; But we can start looking at the top of the buffer endif. ; End case of non-1st character in buffer move t1, strc ; Load length of match string camg t1, q3 ; Is there enough space to do the compare? ifskp. ; Nope, so must get some more network data dmove q1, q3 ; Return updated pointers ret ; Return +1, no match endif. remark t1, ; Already has source comparsion base length move q5, t1 ; No more pull up, so q5 is free move t2, p3 ; Where to start translating from move t4, t1 ; Transferring or translating equal lengths move q1, p5 ; Where to translate to (in translation buffer) setzb t3, q2 ; Force local pointers remark ; A small optmization ifme. incase ; Case insensitive? txo t1, S ; Immediately start translating extend t1, trnbas ; Move the remaining characters nop ; Ignore non-skip else. ; Otherwise, case sensitive extend t1, movsup ; So just copy them and do nothing further nop ; Ignore non-skip (which should never happen) endif. remark ; Set up for the string compare move t1, q5 ; Load source length move t2, strptr ; Load pointer to search string move t4, t1 ; substrings are same length move q1, p5 ; Where we wrote the (translated) network data remark t3, q2 ; These are still zero, forcing local pointers seto f, ; Let's assume a match extend t1, cmprmn ; Finally, let's compare something!! setz f, ; Not the same... ife. f ; Didn't match? move t1, trgchr ; Load the original trigger character and ifme. pars8 ;[229] Not if /SILENT PBOUT% ; print only that because we're skipping it endif. ;[229] skipg t1, sesjfn ; Session logging? ifskp. ; Yes, so let's put it in there, too move t2, trgchr ; Load the original trigger character again BOUT% ; And put it into the log erjmpr .+1 ; Catch and ignore error endif. ; End case session logging sos t1, p2 ; Account for consumed match character move t4, t1 ; Prevent any filling move q1, p3 ; Destination is where we started translating from movei t2, ^d1 ; Source is one character after that so we adjbp t2, q1 ; Overwrite the match character remark t3, q2 ; These are still zero, forcing local pointers extend t1, movsup ; Shift them all up a byte nop ; Ignore non-skip (which should never happen) move q2, q1 ; Last destination address is where we can append move q1, p2 ; New total ret ; Return non-match, boo... endif. ; Otherwise, matched!!! remark ; Must print the rest of the compared string ifme. pars8 ;[229] Only if not /SILENT movei t1, .priou ; User's terminal move t2, p3 ; Where the match started movn t3, q5 ; Rest of search string length SOUT% ; Counted SOUT% is faster %jserr (,) ; Odd but carry on endif. ;[229] skipg t1, sesjfn ; Session logging? ifskp. ; Yes, so let's put it in there, too move t2, p3 ; Where the match started movn t3, q5 ; Rest of search string length SOUT% ; Counted SOUT% is faster erjmpr .+1 ; Catch and ignore error endif. ; End case session logging remark ; Is this really correct? sub p2, q5 ; Account for characters consumed ifle. p2 ; Nothing left? setz q1, ; No characters in buffer move q2, p3 ; Start from where compared because that's gone now retskp ; Return success!!!!! endif. remark ; What we've done is no longer relevant for pull up move t1, p2 ; New length includes consumed characters move t2, q5 ; What we've consumed adjbp t2, p3 ; Source is post transfer move t4, t1 ; Same length move q1, p3 ; Destination is pretransfer setzb t3, q2 ; Force section local pointers extend t1, movsup ; Move the string up nop ; Ignore +1 (which should never happen) move q2, q1 ; Return new append position move q1, p2 ; Return existing characters retskp ; Return success!!!!! subttl No trigger character seen ; Entry: matchs register context ; ; AC block from movst ; ; t1/ Remaining characters in network input buffer ; t2/ Pointer to where the first character match happened in the input buffer ; *** OR *** where we ended (for a .CHNUL, for example) ; t3/ Zero, section local pointers ; t4/ Remaing characters in translation buffer ; q1/ Pointer to where we stopped in the translation buffer ; q2/ Zero, section local pointers ; ; N.B. Since we never hit the trigger character, t1 and t4 WILL be equal ; on entry because we stopped consuming source and storing in the ; destination translation area. ; ; Set by matchs at the time of calling ; ; q3/ Original buffer length of network data ; q4/ Original pointer to end of network data buffer ; q5/ Pointer to beginning of network data buffer ; p1/ Aliased from q5, don't use! ; p2/ Remaining source length ; p3/ Updated pointer, which was based on q5 ; p4/ [Not in use, yet] ; p5/ [Not in use, yet] ; ; Exit: ; ; q1/ Updated count of characters in buffer ; q2/ Updated pointer into buffer ntrigr: remark ; Here if extend never hit the trigger character remark ; Assumes saved by matchs remark ; also saved by matchs txz t1, S!N!M ; Shut off any flags from MOVST move t4, q3 ; Load original length sub t4, t1 ; Calculate total data done ifle. t4 ; Did we actually do anything or get anything odd? dmove q1, q3 ; Restore original buffer position ermsg% (<1st character MOVST doesn't appear to have done anything>,r) endif. ; End sanity check call netprn ; Print outstanding network data came t4, q3 ; Looked though everything? ifskp. ; We did, so reset count and pointer setz q1, ; Nothing left to look at move q2, q5 ; Load reset pointer ret ; And done, +1 endif. ; Otherwise, have to 'pull up' the data txz p2, S!N!M ; Don't want any flags from now on dmove t1, p2 ; Source is where we stopped in the buffer move t4, t1 ; Destination length is the same as source length move q1, q5 ; It's going to the top of the buffer setzb t3, q2 ; Force section local pointers extend t1, movsup ; Pull the rest of the string up nop ; Ignore non-skip return (should never happen) move q2, q1 ; Append position is wherever MOVSLJ left it move q1, p2 ; New length is whatever we didn't look at ret ; Returns +1 subttl Network Print ; Entry: ; ; q5/ Pointer to start printing from ; t4/ Count of characters to print ; ; Returns: ; ; +1, always, no registers modified netprn: jumpe t4, r ; If nothing to do, don't do anything saveac ; Don't step on a single thing ifme. pars8 ;[229] Only if not /SILENT movn t3, t4 ; Load negative count of data move t2, q5 ; And the beginning of it movei t1, .priou ; Our happy terminal SOUT% ; Blat how much we've done so far %jserr (,) ; Odd but carry on endif. ;[229] skipg t1, sesjfn ; Session logging? ret ; No, we're done remark ; Yes, so let's put it in there, too move t2, q5 ; And the beginning of it movn t3, t4 ; Load negative count of data SOUT% ; Counted SOUT% is faster erjmpr .+1 ; Catch and ignore error ret subttl Clear Buffered Network Data ; Returns number cleared inpclr: entry inpclr ; Used by k20net saveac ; Used by inpbfc dmove q1, inpcnt ; Set calling context call inpbfc ; Check buffer constency ret ; Bad, don't touch addm q1, inpcbf ; Otherwise, count is good, add to tally dmove t1, inpini ; Load INPUT initialization data dmovem t1, inpcnt ; Whack the buffer move t1, q1 ; Return what we cleared ret subttl INPUT buffer checking and error handling remark ; Input buffer check ; Call ; ; q1/ Current inpcnt, count of characters in buffer ; q2 Current inpptr, append pointer ; ; +1, Something bad ; +2, Good ; t1/ Start of text ; ; Register usage ; ; q3/ Earliest possible byte pointer ; q4/ Last possible byte pointer ; q5/ Beginning of current text in buffer bufbeg: point 7, inpbuf ; Assembled beginning of buffer inpbfc: entry inpbfc ; Called from k20par saveac ; Some internal storage remark ; Leave these alone!! move t1, bufbeg ; Load assembler beginning move t2,t1 ; Save a copy ibp t1 ; Bump into the first word seto q3, ; Back up by one adjbp q3, t1 ; Puts it into previous word movx q4, strblc ; Load maximum count adjbp q4, t2 ; Puts past last word remark ; First, check the length caige q1, 0 ; Bogus count?? ermsg% (,inpbfa) caile q1, strblc ; Absurdly large? ermsg% (,inpbfa) remark ; Check append pointer hrrz t3, q2 ; Load current buffer append address hrrz t4, q3 ; And the earliest possible address camle t3, t4 ; Before or at last? ifskp. ; Yes, could be bad camn q2, q3 ; Unless on exact address anskp. ; That's fine ermsg% (,inpbtc) endif. hrrz t4, q4 ; Load last possible address camge t3, t4 ; After or at last? ifskp. ; Yes, could be bad camn q2, q4 ; Unless on exact address anskp. ; That's fine ermsg% (,inpbtc) endif. ifg. q1 ; But!! Is there anything to do? remark ; Calculate and check start of text movn q5, q1 ; Load negative current buffer length adjbp q5, q2 ; Calculates beginning of input area hrrz t3, q5 ; Load address of start of text hrrz t4, q3 ; And the earliest possible address camle t3, t4 ; Before or at last? ifskp. ; Yes, could be bad camn q5, q3 ; Unless on exact address anskp. ; That's fine ermsg% (,inpbtc) endif. hrrz t4, q4 ; Load last possible address camge t3, t4 ; After or at last? ifskp. ; Yes, could be bad camn q2, q4 ; Unless on exact address anskp. ; That's fine ermsg% (,inpbtc) endif. else. ; Otherwise, nothing to compute or check move q5, q3 ; Current append IS the start of text endif. remark ; Everything looks, good but can we get anything? move t2, q5 ; Load the start of buffer pointer ildb t4, t2 ; Pick up the first character %jserr (,inpbtc) move t1, q5 ; Return current input position retskp ; Finally return success remark Error handler inpbtc: addm q1, inpcbf ; Otherwise, count is good, add to tally inpbfa: setz q1, ; Whack the buffer; nothing in there move q2, bufbeg ; and point to the beginning ret ; Return the bad news subttl Debug Print, call with a JSP CX ; Was used to catch all the edge cases when doing buffered reads repeat 0,< ; But it's debugged now. I hope... debprn: push p, t1 push p, t2 push p, t3 txmsg < Entry: > call prnbuf pop p, t3 pop p, t2 pop p, t1 call (cx) ;;No arguments to skip ifskp. push p, t1 push p, t2 push p, t3 txmsg < retskp: > call prnbuf pop p, t3 pop p, t2 pop p, t1 aos (p) else. push p, t1 push p, t2 push p, t3 txmsg < ret: > call prnbuf pop p, t3 pop p, t2 pop p, t1 endif. ret remark The symbol being displayed is what the buffer pointer is prnbuf: movei t1, .priou move t2, q1 movei t3, ^d10 NOUT% erjmpr .+1 txmsg <, > hrrz t1, q2 push p, cx call symout## pop p, cx ifg. q1 caile q1, strblc anskp. txmsg <,' '> movei t1, .priou movn t2, q1 adjbp t2, q2 movn t3, q1 SOUT% erjmpr .+1 txmsg <' > else. ifn. q1 txmsg <, *** absurd length *** > else. txmsg < > endif. endif. ret >;repeat 0 subttl Builds a Search String ; Call: ; ; Something in the atom buffer to search for. Does the following, ; in order, ; ; 1) Translates C escape sequences to the indicated character ; 2) Builds search MOVST table ; ; Returns +1, If error ; +2. Success!! ; ; strbuf/ Converted 7-bit ASCIZ string ; strptr/ 7 bit pointer to the above ; strc/ Length of converted string ; sertab/ MOVST table to stop on first letter of search string ; ; Unlike getss, will not allow string buffer to be overwritten bsrchs: saveac ; Needs some temporaries dmove t1, [ ; Set up for expansion point 7,strbuf ; Destination is string buffer point 7,atmbuf] ; Source is the typed in string dmove q1, t1 ; Save destination and source pointers movem t1, strptr ; Save destination pointer for later ildb t3, q2 ; And pick up the first source character ifn. t3 ; Anything to do, actually? dmove t3, [ strblc ; Load string's length in characters chrtup ] ; Assume (common) case insensitive compare skipe incase ; But!! Case-INsensitive compare? movei t4, chrtab ; Ok, so case sensitive, then call cescxp ; Expand any escape characters %ermsg (,r) ; pass +1 up movem t3, strc ; Store the length of the target string else. ; Otherwise, nothing in there setzm strc ; So zero the string counter setzb t2, t3 ; And scrub a dub dmovem t2, strbuf ; the destination buffer retskp ; Nothing else to do endif. ; End case something to do ildb q3, q1 ; Pick up first expanded character jumpe q3, RSKP ; Can't match on NUL ; Otherwise, build a search translation table movx t1, sertln ; Length of search table in words dmove t2, [ btrnsu ; Uppercasing base table with no stop characters sertab ] ; Destination in writable storage to be modified skipe incase ; But!! Case-INsensitive compare? movei t2, btrnst ; No, so use exact matching table, then hrrz t4, t2 ; Pick up address of base table hrli t4, (movst 0,0) ; Build instruction movem t4, trnbas ; Store as instructon to do setzm trnbas+1 ; Fill character is .chnul xblt. t1 ; Drop into place movem q3, trgchr ; Might be the right character move t1, q3 ; Load the character call mrktab ; Mark the table to stop on this character skipe incase ; But!! Case-INsensitive compare? retskp ; No, so case sensitive and we're done move t1, q3 ; Otherwise, load the character again cail t1, "a" ; Is this a lower case letter? caile t1, "z" jrst bsrch1 ; No, see if UPPER case txz t1, 40 ; Yes, convert to UPPER case movem t1, trgchr ; And save as the trigger character jrst bsrch2 ; Now go poke the table bsrch1: cail t1, "A" ; No, is this an UPPER case letter? caile t1, "Z" ; If neither UPPER or lower, retskp ; we're done txo t1, 40 ; Yes, convert to lower case remark bsrch2 ; Falls through to tweak the table again bsrch2: call mrktab ; Mark the table to stop on this character retskp ; Return success subttl Given a character Mark a translate Table to stop on it ; Call: ; ; t1/ Character to stop on ; ; Returns: +1, always ; ; Search table (sertab) with appropriate character pair updated ; ; To do, the indexed xct is extremely cute, but probably not really ; fast. Probably could just have done an txnn/ifskp./else./endif. ; and maybe even bummed the lsh. Even with all the extra jrst's, ; it would probably be faster. ; ; Vanity, vanity, vanity... mrktab: saveac ; Don't touch the temporaries lshc t1, ^d<-1> ; Divide by two, shifting odd bit into bit zero lsh t2, ^d<-35> ; Shift remainder into bit zero move t3, sertab(t1) ; Load character pair xct [tlo t3,TRMCOD ; Even, pick up left half tro t3,TRMCOD](t2) ; Odd, pick up right half movem t3, sertab(t1) ; Store back into table ret ; Done ;[209] End code insertion subttl OUTPUT command parsing ;[208] Originally shut off indirection, but since quoted strings allow ; us to put in an at-sign (@) as well as escape sequences, this was ; removed to allow backward compatibility with any take files which ; rely on this. chgsec(code,const) ;;Chained FDB's go in const outfdb: flddb. .cmcfm,,,,,outfd1 outfd1: flddb. .cmqst,,,,,outfd2 outfd2: flddb. .cmtxt,,,,, ;[208] retsec ;;Return to code psect cleans() ;;Clean up working symbols .outpu: entry .output ; Invoked by k20par guide (string) ; Parse OUTPUT command. movei t1, outfdb ;[208] Load pointer to chained fdb's call rfield ;[208] Parse for something ldb t3, [pointr (.cmfnp(t3),cm%fnc)] ;[208] Get what was parsed caie t3, .cmcfm ;[208] Parsed a confirm? ifskp. ;[208] We did, so fix up the atom buffer movx t1, ;[208] Load a carriage return movem t1, atmbuf ;[208] Stomp the atom buffer else. ;[208] Otherwise, the atom buffer is valid confrm ;[208] But must be confirmed endif. ;[208] End parse check ret subttl OUTPUT command execution $outpu: entry $output ;[209] Invoked by k20par saveac ;[223] Save registers for piggy MOVST remark ;[209] Expand the C escape characters dmove t1, [ ;[209] Set up for expansion point 8,strbuf ;[209] Destination buffer is eight bit point 7,atmbuf] ;[209] Source is atom buffer in seven bit dmove t3, [ atmbln*5 ;[209] Source is as large as atom buffer chrtab ] ;[209] Respect case on expansion call cescxp ;[209] Expand string into output buffer %ermsg (,r) ;[209] Don't go any further move q5, t3 ;[223] Save length of destination $outp4: skipg t1, netjfn ;[186] Comm line designator. move t1, ttyjfn ;[186] Not remote, using local call chklin ; Whatever it is, check it ifme. carier ; No carrier? %ermsg (,r) endif. move t2, [point 8, strbuf] ; Point to converted string movn t3, q5 ;[186] Counted string (gives length of record) setz t4, ;[186] Just in case (still NUL terminated) skipn parpko ;[223] Don't do this if doing packets only call putpar ;[223] Otherwise, maybe put some parity on it SOUTR% ;[186] Push it over the network. %jserr (,) aos vsoct ;[204] Count a SOUTR% done addm q5, vsotc ;[204] Update tally of SOUTR% bytes camle q5, vsomx ;[204] Length than or equal to the maximum seen? movem q5, vsomx ;[204] Nope, we have a new maximum! skipn duplex ; Half duplex connection? ret ; No, host will echo. movei t1, .priou ; Yes, do it ourselves. move t2, [point 8, strbuf] ; Point to string again. movn t3, q5 ;[186] Counted string (faster) setz t4, ;[186] Just in case (still NUL terminated) SOUT% erjmpr .+1 ;[195] skipg t1, sesjfn ;[195] Session logging? ifskp. ;[195] A JFN exists skipn sesflg ;[195] Is logging active? anskp. ;[195] No, so don't bother cain t1, .nulio ;[193] Just dumping it? anskp. ;[193] If so, we're done move t2, [point 8, strbuf] ; Yes, point again. movn t3, q5 ;[186] Counted string (faster) setz t4, ;[186] Just in case (still NUL terminated) setzb t3, t4 SOUT erjmpr .+1 ;[195] endif. ;[195] ret ; Done. ;[209] End code replacement subttl TRANSMIT [file] parsing [165] ;[209] Begin code replacement ; ; Moved here from k20mit and rewritten to be able drive buffered I/O. ; ; Tries for a device first as this is more efficient for NUL: and ; catches more errors earlier and more easily. Can sometimes make ; recognition not work intuitively by picking a bogus device over ; a non-existant file. ; ; Default command filespec fields for .CMFIL. These are only given ; so that we may get the flags returned by GTJFN% (which are currently ; unused) chgsec(code,const) ;;GTJFN defaults are not in code, they're in const trnbk: gj%flg!gj%old!fld(.gjdef,.rhalf) ; .GJGEN .priin,,.priou ; .GJSRC (ignored if COMND%) 0 ; .GJDEV (do not default the device) 0 ; .GJDIR (do not default the directory) 0 ; .GJNAM (do not default the name) 0 ; .GJEXT (do not default the extension) 0 ; .GJPRO (use system default protection) 0 ; .GJACT (use job's current account) trnbkl==<.-trnbk> ; Length of this GTJFN argument block. retsec ;;[229] Back to where-ever we started from ;[229] %table puts stuff in the correct .psect %table (trnswi) ;[229] The translate switch table %key2 , %eofsw ;[229] The EOF switch parses a restricted token set %key2 , %silsw ;[229] Tells $input to shut up about matches %key2 , %timsw ;[229] In case we don't want to wait forever ... %tbend ;[229] End of table remark Lifted from k20par ;N.B., have to use literals here or flddb. will choke. Maybe rewrite ; this to special case .cmtok, like fldtk.? define token (c) < ;;[217] Define token ;;[217] All these literals, yuck... >;;token ;;[217] chgsec(code,const) ;;Chained FDB's are not in code, they're in const tranft: flddb. .cmtok,,token(<>),,,tranf1 tranf1: flddb. .cmtok,,token(<>),,,tranf2 tranf2: flddb. .cmtok,,token(<$>),,,tranf3 tranf3: flddb. .cmtok,cm%sdh,token(<>),,, tranfs: flddb. .cmswi,,trnswi,,,tranfd ;[229] Maybe get a transmit switch tranfd: flddb. .cmfil,,,,,tranf4 tranf4: flddb. .cmdev,cm%sdh,,,, ;[229] Catch bare device timfdb: flddb. .cmflt,,^d10,,<10>, retsec ;;[229] Back to where-ever we started from remark ;;[229] Punt temporary symbols cleans() .trans: entry .trans ; Invoked from k20par saveac ; Protect some registers movx t1, cz%ncl!.fhslf ; Release non-open JFN's on reparse CLZFF% erjmpr .+1 ; Catch and ignore errors move t1, [trnbk,,cjfnbk] ; Insert our file parsing defaults. blt t1, cjfnbk+trnbkl movei q5, tranfs ;[229] Doing a full complement of switches .tran0: guide .tran1: remark ;[229] Here when looping on switches movei t1, q5 ;[229] Look for switch, device or file call rfield ;[229] Ask them to type something move q2, t2 ;[229] Save whatever parsed data we got ldb q1, [pointr (.cmfnp(t3),cm%fnc)] ;[229] Pick up function code caie q1, .cmswi ;[229] Did we get a switch? jrst .tran2 ;[229] No, just go handle the device or file block. ;[229] Enter block for better control flow hrrz q3, (q2) ;[229] Pick up the switch value caie q3, %eofsw ;[229] Parsed the EOF switch? ifskp. ;[229] We did, so pick up its argument movei t1, tranft ;[229] Look for an EOF token call rfield ;[229] Ask them to type one of them tlz t3, -1 ;[229] Isolate fdb we actually used move t2, .cmdat(t3) ;[229] Pick up the byte pointer to the character ildb t1, t2 ;[229] Load the token character (only one) cain t1, "$" ;[229] Our goofy escape synonym? movei t1, .chesc ;[229] Yes, transmogrify it call @parity ;[229] And put parity on it (if doing parity) movem t1, pars7 ;[229] Save EOF character retskp ;[229] Return for next switch endif. ;[229] End EOF switch case caie q3, %silsw ;[229] Parsed the 'silent' switch? ifskp. ;[229] We did, so that should be easy enough setom pars8 ;[229] Just flag it in the parse block retskp ;[229] Return for next switch endif. ;[229] End 'silent' switch case caie q3, %timsw ;[229] Wants a timeout? ifskp. ;[229] Give him a time out movei t1, timfdb ;[229] Look for a time out number (floating) call rfield ;[229] Ask them to type one it ifl. t2 ;[229] Is the number in the right range? emsg ;[229] Must be superluminal... jrst cmder1 ;[229] Yet allow reparse endif. ;[229] End initial sanity checking call chksec ;[229] Ensure number is in correct range ifskp. ;[229] Check and convert OK? Then side-effect variables retskp ;[229] And get out of the parse block. else. ;[229] Otherwise, couldn't swallow something emsg ;[229] jrst cmder1 ;[229] Yet allow reparse endif. ;[229] End case checking and conversion endif. ;[229] End case timeout switch ret ;[229] Otherwise, some kind of bogus switch endbk. ;[229] End Block context ifskp. ;[229] Successful switch parse jrst .tran1 ;[229] Go see if more switches (or device or file) else. ;[229] Otherwise, some kind of error emsg ;[229] An internal programming error.. jrst cmder1 ;[229] However, allow reparse endif. ;[229] End of switch block processing .tran2: move t1, q2 ;[229] Load parsed data for DVCHR% caie q1, .cmdev ; Typed a bare device? tlz t1, -1 ; Shut off flags so DVCHR% doesn't choke DVCHR% ; and find out about it %jserr (,r) ldb q3, [pointr t2, dv%typ] ; Pick up the device type caie q1, .cmdev ; Typed a bare device? ifskp. ; Yes, see what it is caie q3, .dvnul ; NUL:? ifskp. ; Yes, we can simulate that movx q2, ;Use special designator and flags jrst .tran3 ;[229] Done with this special case endif. ; Any other device is NOT VALID caie q3, .dvdsk ; Bare device? ifskp. ; Yes, but needs a file name emsg ; First part of blat move t2, q2 ; Load whatever we parsed movei t1, .priou ; Output to the terminal DEVST% ; Write the device name into the AC's %jserr (,cmder1) sxtext (t1,<: structure needs a file specification>) PSOUT% ; Finish the informative blat jrst cmder1 ; Allow reparse endif. ; Any other device is NOT VALID jrst .trane ; Otherwise, handle as a general parse error endif. ; End case .cmdev remark .cmfil ; Everything else is a file caie q3, .dvnul ; A JFN on NUL:?? ifskp. ; Yes, let's fix that up move t1, q2 ; Load parsed JFN call isnulj ; Convert it to a special JFN, releasing original ermsg% (,cmder1) ; Allow ^H move q2, t1 ; Store the JFN and original parse flags jrst .tran3 ; Done with this second special NUL: (JFN) case endif. caie q3, .dvdsk ; Was this a structure? jrst .trane ; No, any other device is NOT VALID .tran3: remark ;[229] Otherwise, parse is OK so far setzb t1, t2 ; Cons up a couple of nice .chnul's dmovem t1, atmbuf ; Stomp the atom buffer call .inpu1 ; Get the search string caie q1, .cmcfm ; Defaulted search? ifskp. ; Yes, maybe fix up for TRANSMIT defaults skiple indefw ; Had we set a default search string? anskp. ; We did, so we're done remark ; Otherwise, supply another appropriate default. skipn t1, handsh ; Handshaking? movei t1, .chlfd ; No, then use linefeed. rot t1, -^d7 ; Turn into an ASCIZ word movem t1, strbuf ; Stomp the string buffer movei t2, ^d1 ; Single character long move t3, [point 7, strbuf] ; Pointer to buffer dmovem t2, strc ; Stomp into search string parameters endif. ; Carry on movem q2, pars2 ; Store the JFN and flags setom pars6 ;[209] Override the ^C handling ret ; Done with the parse remark Here for common parse errors .trane: emsg ; Begin whining movei t1, .priou ; Output to terminal, always remark ; N.B., JFNS% will choke on a device caie q1, .cmdev ; Device? ifskp. ; Yes, use DEVST% move t2, q2 ; Load whatever we parsed DEVST% ; Write the device name into the AC's %jserr (,cmder1) else. ; Otherwise, DEVST% will choke on the JFN hrrz t2, q2 ; Load just the JFN dmove t3, [ ; Just want the device name, no punctuation fld(.jsaof,js%dev) 0 ] ; No odd prefix, whatever that is JFNS% ; Convert to something readable %jserr (,cmder1) endif. ; Either way, error should be more informative txmsg <: device is not valid for TRANSMIT or CAPTURE> hrroi t1, crlf ; Newline PSOUT% ; Tie off the blat erjmpr .+1 ; Catch and ignore that error, too caie q1, .cmfil ; Had we parsed a file, actually? ifskp. ; Yes, then have a little clean up to do hrrz t1, q2 ; Load our poor JFN, sans flags RLJFN% ; Toss it; can't use it erjmpr cmder1 ; Ignore error and beat it endif. jrst cmder1 ; Allow ^H subttl TRANSMIT command execution. ; To do: Instead of repeated SIN%'s, how about a moby-PMAP% and MOVST? $trans: entry $trans ; Called by k20par extern mycaps ;[223] Expose capability vector saveac ;[209] Needs much registers hrrz t1, pars2 ;[209] First make sure we can open the file. movem t1, filjfn ;[209] Store in case we need to release caie t1, .nulio ;[209] Don't need to open .nulio ifskp. ;[229] But give it some fake data setzb t1, t2 ;[229] It will have a zero bytes and pages dmovem t1, fsized ;[229] Store in file size double word else. ;[209] Otherwise must open it SIZEF% ;[229] Find out how large the file is ifje. r ;[229] Failed?? move t4, t1 ;[229] Save error for debuggers %ermsg (,) ;[229] setzb t2, t3 ;[229] Cons up a set of zeros dmovem t2, fsized ;[229] Store in file size double word move t1, filjfn ;[229] Reload the JFN and hope for the best else. ;[229] Otherwise, worked!!!! dmovem t2, fsized ;[229] So store results in file size double word endif. ;[229] End case JSYS handling dmove t2, [1,,.fbbyv ;[229] Let's have a look at the byte size t4 ] ;[229] Tuck it into t4 GTFDB% ;[229] Try to pull from file descriptor block ifje. r ;[229] Failed?? move t4, t1 ;[229] Save the error for debuggers movei t3, ^d7 ;[229] Ignore it and pretend ASCII hrrz t1, pars2 ;[229] Reload JFN for OPENF% attempt else. ;[229] Otherwise, worked ldb t3,[ pointr(t4,fb%bsz) ] ;[229] Extract byte size from packed field endif. ;[229] End case JSYS handling movx t2, fld(7,of%bsz)!of%rd ; Assume 7-bit (also handles 36 bit PA1050) cain t3, ^d8 ;[229] Is our assumption incorrect? movx t2, fld(8,of%bsz)!of%rd ;[223] Fine, it's eight bit OPENF% ifje. r ;[209] Failed?? move t4, t1 ;[209] Save error code for debugging %ermsg (,) ;[209] Squawk and continue setzm filjfn ;[209] Stomp JFN global storage hrrz t1, pars2 ;[209] Reload the JFN call frclos ;[209] Force it closed nop ;[209] Ignore error and carry on ret ;[209] And return; we can't do anything else endif. ;[209] End case OPENF% JSYS error handling endif. ;[209] End case .nulio OPENF% decision remark ;[209] .trans gets and decodes a prompt (search) string $tran1: setz q5, ;[209] Assume not in a batch job that needs fixup skipn strc ;[209] Of couse, don't bother if no search string... jrst $tran2 ;[209] There won't be anything to fix up skipe pars8 ;[229] Nor if we were told to shut up jrst $tran2 ;[229] User typed a /SILENT skipn ;[209] Now then, are we a batch job? jrst $tran2 ;[209] No, so we don't care about BATCON confusion ;[209] Otherwise, REALLY long lines are bad ... dmove t1, strc ;[209] Load the search string count and pointer block. ;[209] Enter block context for better control flow cain t1, ^d1 ;[209] A single character?? retskp ;[209] Whatever it is, it needs to get tied off ;[209] A tiny hack: ibp is faster than adjbp caie t1, ^d3 ;[209] Is it EXACTLY three characters in length? ifskp. ;[209] It is, so handle this more efficiently ibp t2 ;[209] Positions us to the first byte subi t1, ^d1 ;[209] So ildb in case two works right endif. ;[209] Fall through to case two caie t1, ^d2 ;[209] A two character sequence, then? ifskp. ;[209] Yes, let's see if that's OK ildb t3, t2 ;[209] Let's get the first character caie t3, .chcrt ;[209] Carriage return? retskp ;[209] Nope, then batch output needs a ildb t3, t2 ;[209] Let's get the second character caie t3, .chlfd ;[209] And was that a linefeed? retskp ;[209] Nope, then batch output needs a ret ;[209] ! Batch log will be tidy endif. ;[209] End case, a search string of two characters ;[209] Note: ldb, ildb is faster than ildb, ildb subi t1, ^d1 ;[209] Going to look at the last two characters (!!) adjbp t1, t2 ;[209] Position right on the penultimate ldb t3, t1 ;[209] Let's get the penultimate character caie t3, .chcrt ;[209] Carriage return? retskp ;[209] Nope, then batch output needs a ildb t3, t1 ;[209] Let's get the final character caie t3, .chlfd ;[209] And was that a linefeed? retskp ;[209] Nope, then batch output needs a ret ;[209] Final two are ! Batch log will be tidy endbk. ;[209] End block context ifskp. ;[209] Skip return means needs a seto q5, ;[209] So flag that for down stream endif. ;[209] End block skip stanza $tran2: call clrbuf ;[229] Clear out any crud before searching jrst $tranx ;[229] If failed, just stop doing this skipg t2, pars4 ;[229] Integer milliseconds ifskp. ;[229] Wants time outs, so set them movei t1, $trant ;[229] Where to go die on a time out call timeon ;[229] Set the timer for it endif. ;[229] call ccon ; Turn on ^C trap jrst $tranx ; Where to go upon ^C. ifme. vtermf ;[186] Calls only make sense if not virtual call doarpa ;[186] If on a TVT, set up to allow binary call dobits ; Condition the line. jrst $tranx call ttyob ; Let controlling tty output binary. endif. ;[186] Otherwise, MTOPR%'s might break! movei t1, $tran3 ; Where to go if ^M typed (send next) movem t1, cmloc ; ... movei t1, $tran4 ; Where to go if ^P typed (resend previous) movem t1, cploc ; ... call cmpon ; Enable interrupts on ^M, ^P. txmsg < [KERMIT-20: Transmitting > ; Tell user we're starting. movei t1, .priou move t2, filjfn setzb t3, t4 ;[209] No screwy prefix... JFNS erjmpr .+1 txmsg < If stuck, type: Carriage Return to send next line, ^P to resend current line, > ;[187] dmove t3, [ byte (7) .chspc, "^", "C", "^", "C" byte (7) .chspc, .chnul ] ;[187] Assume default move t2, mycaps+1 ;[187] Load enabled capabilities txnn t2, sc%ctc ;[187] Is Control-C turned on?? dmove t3, [ byte (7) .chspc, "^", "G", "^", "G" byte (7) .chspc, .chnul ] ;[187] Wasn't... hrroi t1, t3 ;[187] Point to proper text PSOUT% ;[187] Tell them what to type txmsg ;... ; Get a line from the file. $tran3: ifmn. cmseen ;[194] ^M typed? txmsg < Sending next...] > ; Yes, type msg setzm cmseen ; and unset flag. endif. ;[194] move t1, filjfn ; Input file pointer remark t2, *MAGIC* ;[229] N.B., Below converts 7 to 8 bit! move t2, [point 8, strbf2] ; Where to put the line dmove t3, [ strblc ;[209] Maximum characters to read, .chlfd ] ;[209] but preferably terminate on linefeed. SIN ifje. r. ;[194] Catch last error in t1 hrrz t2,t1 ; Erase fork handle from left half. caie t2, iox4 ; Was error EOF? %ermsg (,$tranx) ; No, give message. call tranot ;[229] Notify us of transmit completion jrst $tranx ; But either way, we are done endif. ;[194] ifg. t3 ;[209] Did we hit the linefeed? movei q4, strblc ;[209] Yes, so need to do post calculations sub q4, t3 ;[209] Calculate amount done else. ;[209] Otherwise, don't need to do any math movei q4, strblc ;[209] Put in maximum length endif. ;[209] ; N.B., This code appears to assume a particular kind of Tops-20 ; formatted text file in other words, the STANDARD kind that is ; used on *ALL* DEC operating systems and in many cases on DOS, ; OS/2 and Windows. That is, a series of variable length lines ; terminated by a carriage return and a line feed. ; ; However, if you have a Unix or Multics ; format file with bare linefeed, then this code does the wrong ; thing because it will strip them all out, giving one big long ; line. It may also do the wrong thing for consecutive linefeeds. ; This is very old behavior. ; ; If this is in fact a bug or misfeature, then the fix is ; straightforward in concept (yet not in implementation). We'd ; need to PMAP% the file and then use a MOVST to trigger on a ; carriage return and check after it for a linefeed. If the ; linefeed existed, then we'd strip it, otherwise, this would be a ; case of overprinting, which still might work right. Bare ; linefeed's would be left alone. ; ; Leave alone for now until better understand the reason for ; swallowing trailing linefeeds. ; ; Changed to shorten the string length because we don't send NUL ; terminated strings, but rather counted ones. repeat 0, < ;[229] Previous vestigial code ldb t1, t2 ;[209] Pick up the last character caie t1, .chlfd ;[209] Was it a LF? ibp t2 ;[209] No, so don't overwrite it. setz t1, ;[209] Deposit a null, overwriting call @parity ;[223] Put parity on this last dinky character dpb t1, t2 ; last char if it was a LF. > ;[229] ldb t1, t2 ;[229] Pick up the final character caie t1, .chlfd ;[229] Was it a linefeed? ifskp. ;[229] It is, so don't send it sojle q4, $tran3 ;[229] Decrement the count and skip if nothing left endif. ;[229] Still, positive, so something to do ; TRANSMIT, cont'd... Echo the string if necessary. $tran4: ifmn. cpseen ;[194] ^P typed? txmsg < - Resending... > ; Yes, type msg setzm cpseen ; and unset flag. endif. ;[194] $tran5: remark ;[223] Tack on desired parity, in place (if desired) move t1, parity ;[223] Pick up the parity cain t1, none ;[223] Doing any parity anyway? ifskp. ;[223] We are, so do some parity already ... move t2, [point 8, strbf2] ; Point to the string. movn t3, q4 ;[223] Load negative for SOUTR% call putpar ;[223] Stomp some parity into it endif. ;[223] End case handling parity skipn duplex ; Half duplex? jrst $tran6 ;[223] No. move t1, [point 8, strbf2] ; Point to the string. PSOUT ; Yes, display it at the tty. movei t1, .chlfd ; Also need to add linefeed. call @parity ; And any necessary parity PBOUT $tran6: remark ;[223] Finally send the string skipg t1, netjfn ;[186] ... out the communication line. move t1, ttyjfn ;[186] using local terminal move t2, [point 8, strbf2] movn t3, q4 ;[223] Load count ifme. vtermf ;[186] Not a virtual terminal? SOUT ;[186] Isn't, so olde reliable is fine %jserr (,$tranx) else. ;[186] Otherwise, have to get out and push aos vsoct ;[209] Count a SOUTR% done SOUTR% ;[186] %jserr (,$tranx) ;[186] endif. ;[186] ifmn. vtermf ;[209] Only update virtual terminal totals addm q4, vsotc ;[204] Update tally of SOUTR% bytes camle q4, vsomx ;[204] Length than or equal to the maximum seen? movem q4, vsomx ;[204] Nope, we have a new maximum! endif. ;[209] ;[209] Now look for the prompt. Note that everything is echo'ed because ; this is what Kermit-20 has always done. However, since CAPTURE doesn't ; echo anything (for performance purposes), all we should see here is ; the prompt. Or an error... $tran7: skipn strc ;[229] But!! Are we doing any recognition, anyway? jrst $tran3 ;[229] No, so just go on blatting call $input ;[209] Let $INPUT drive the bus now ifn. q5 ;[209] Batch log needs to get tied off? hrroi t1, crlf ;[209] Yes, so load that PSOUT% ;[209] and type it endif. ;[209] End batch log line tie off jrst $tran3 ;[209] Returns on the prompt ; Done, call terminal restore routines in reverse order. $tranx: call cmpoff ; ^M, ^P interrupts off. call ccoff2 ; ^C trap off. skipn t1, pars7 ;[229] Did we have an EOF character? ifskp. ;[229] We did, let's get it sent rot t1, -^d8 ;[229] Turn into an 8 bit ASCIZ string (heh) move q1, t1 ;[229] And get it out of SOUTR%'s way movei t1, .chcrt ;[229] Load a carriage return call @parity ;[229] Put parity on that (if doing parity) rot t1, -^d16 ;[229] Turn into 2nd byte of 8 bit ASCIZ string or q1, t1 ;[229] 'append' it (heh) skipg t1, netjfn ;[229] Will go out the network move t1, ttyjfn ;[229] or using the local terminal dmove t2, [ ;[229] Set up for SOUTR% point 8, q1 ;[229] Output string is in q1 -2 ] ;[229] Just two dinky characters setz t4, ;[229] Should be ignored, but just in case ifme. vtermf ;[229] Going to a real terminal? SOUT% ;[229] Yes, so counted SOUT% will be fine %jserr (,) ;[229] Complain and carry on call ttyou ; Restore controlling tty. call unbits ; Put line back to previous state. else. ;[229] Otherwise, needs a 'push' SOUTR% ;[229] Counted string is faster %jserr (,) ;[229] Complain and carry on endif. ;[229] End case appropriate output selection endif. ;[229] End case sending the EOF call clrbuf ; Flush any junk they may have typed nop ;[186] Ignore any complaints ifme. vtermf ;[186] Calls only make sense if not virtual call ttyou ; Restore controlling tty. call unbits ; Put line back to previous state. endif. ;[186] Otherwise, MTOPR%'s might break! skipg t1, filjfn ;[193] Close the file. ifskp. ;[193] If there was any cain t1, .nulio ;[193] Unless special NUL: anskp. ;[193] Which needs no releasing tlz t1, -1 ;[193] Turn off any bogus flags call frclos ;[209] Force the JFN to close nop ;[209] Ignore any errors endif. ;[193] End case closing a real JFN setzm filjfn ; Zero the JFN holder. call $inpcl ;[229] Clean up $input's buffer ret $trant: remark ;[229] Here on a time out skiple t4, strc ;[229] No search string, then? ifskp. ;[229] Nope, just generic complaint emsg ;[229] Suitably vague.. else. ;[229] Otherwise, provide a more helpful message emsg ;[229] Begin whining dmove t1, [ .priou ;[229] continue typing on terminal point 7,strbuf ] ;[229] Point to search string movn t3, t4 ;[229] Load exact count to do SOUT% ;[229] Counted SOUT% is faster %jsErr (,) ;[229] Can't win ... endif. ;[229] End case no prompt hrroi t1, crlf ;[229] Have to tie off the line PSOUT% ;[229] jrst $tranx ;[229] Go shut everything down subttl Notify of transmission completion ;N.B., The byte count isn't what we actually sent; it's what the ; file should show up as. tranot: txmsg < [KERMIT-20: Transmit of > ;[229] Begin to tell us about it move t2, filjfn ;[229] Let's get ready to print the file name caie t2, .nulio ;[229] Just dumping it? ifskp. ;[229] Yes, so bum the JFNS% txmsg ;[229] (which won't work, anyway) else. ;[229] Otherwise, have a real file (I hope) movei t1, .priou ;[229] Continue to display on the terminal setzb t3, t4 ;[229] No special formatting or goofy prefix JFNS% ;[229] Let's see the file name %jsErr (,) ;[229] endif. ;[229] End case displaying the file name txmsg < complete> ;[229] Prepare to blat the file length skipg t2, fsized ;[229] Load the size of the file in bytes ifskp. ;[229] Actually had some data txmsg <, > ;[229] Punctuate for some data movei t1, .priou ;[229] Continue to display on the terminal movei t3, ^d10 ;[229] File sizes are always base 10 NOUT% ;[229] Finally type our length %jsErr (,) ;[229] txmsg < characters> ;[229] However, we clipped a lot of linefeeds else. ;[229] Otherwise, nothing there move t1, filjfn ;[229] But!! Do we actually care? cain t1, .nulio ;[229] Just dumping stuff? anskp. ;[229] Yes, so NUL: really only has one size... txmsg <(empty file)> ;[229] Nothing there... endif. ;[229] End case txmsg <] > ;[229] Finish reassuring user ret ;[229] Finally done subttl CAPTURE Parsing logic ;[229] Begin code insertion ;[229] %table puts stuff in the correct .psect %table (capswi) ; The capture switch table %key2 , %eofsw ; The EOF switch parses a restricted token set %key2 , %timsw ; In case we don't want to wait forever ... %tbend ; End of table captfs: flddb. .cmswi,,capswi,,,tranfd ; Maybe get a capture switch ; Default command filespec fields for .CMFIL. These are only given ; so that we may get the flags returned by GTJFN% (which are currently ; unused) chgsec(code,const) ;;GTJFN defaults are not in code, they're in const capbk: gj%flg!gj%fou!gj%new!fld(.gjnhg,.rhalf) ; .GJGEN .priin,,.priou ; .GJSRC (ignored if COMND%) 0 ; .GJDEV (do not default the device) 0 ; .GJDIR (do not default the directory) 0 ; .GJNAM (do not default the name) 0 ; .GJEXT (do not default the extension) 0 ; .GJPRO (use system default protection) 0 ; .GJACT (use job's current account) capbkl==<.-capbk> ; Length of this GTJFN argument block. retsec ;;Back to where-ever we started from .captu: entry .captu ; Linkage is from k20par saveac ; Protect some registers movx t1, cz%ncl!.fhslf ; Release non-open JFN's on reparse CLZFF% erjmpr .+1 ; Catch and ignore errors move t1, [capbk,,cjfnbk] ;Insert our file parsing blt t1, cjfnbk+capbkl ; defaults into the parse block movei q5, captfs ; Load our initial parse file descriptor block callret .tran0 ; The rest of it parses exactly like TRANSMIT ;[230] End code insertion subttl CAPTURE semantic action ;[230] Begin code insertion capmxl==<-2> ;;Maximum we can store, minus at end remark ; Various linkages extern inilin ; Routine to condition line for capture extern rrslin ; Routine to decondition line extern ttipar ; Count of parity errors detected extern movchr ; Location of a movslj instruction $captu: entry $captu ; Linkage is from k20par saveac ; Protect a bunch of registers skipg q3, netjfn ; Assuming getting a character from the network move q3, ttyjfn ; No network, so using local terminal move q4, pars7 ; Load EOF character (if any, which will have parity) move p3, q4 ; Make a 7 bit copy andi p3, ^o177 ; by stripping off any parity movei t1, .chcrt ; Load expected end of line call @parity ; Put parity on it (if doing parity) move p2, t1 ; and keep the result in p2 ; Now set up to write the prompt easily skipn t4, strc ; Load the prompt length ifskp. ; If not zero, see about using it camn q3, ttyjfn ; Not going to the terminal? ifskp. ; No, so will be doing a SOUTR% camle t4, vsomx ; Length less than or equal to the maximum seen? movem t4, vsomx ; Nope, we have a new SOUTR% maximum! endif. ; End case SOUTR% max update move t1, parity ; Load the parity caie t1, none ; But!! Not doing any parity? ifskp. ; No, so just 'expand' the byte width move t1, t4 ; The strings are the same length setzb t3, q2 ; Both are section zero local move t2, [point 7, strbuf] ; Source is 7 bit move q1, [point 8, strbf2] ; Destination is 8 bit extend t1, movchr ; Do the byte width expansion nop ; Ignore any odd non-skip else. ; Otherwise, have to do some real parity movn t3, t4 ; genpar wants a negative count (like SOUT%) dmove t1, [ exp , ] call genpar ; Rewrite the string as 8 bit (7 + 1 bit parity) endif. ; End 7 to 8 bit conversion, possibly with parity endif. ; End case network prompt length check hrrz t1, pars2 ; Let's get the output file opened movem t1, filjfn ; Store JFN (sans flags) cain t1, .nulio ; Opening .nulio does work, but it's a waste of time ifskp. ; A real file, so let's get this thing open movx t2, fld(7,of%bsz)!of%wr ; 7-bit bytes, write-only (I.E., no append) OPENF% ; Try to create the file ifje. r ; Failed?? move t4, t1 ; Save error code for debugging %ermsg (,) ; Squawk and continue setzm filjfn ; Stomp JFN global storage hrrz t1, pars2 ; Reload the JFN call frclos ; Force it closed nop ; Ignore error and carry on ret ; And return; we can't do anything else endif. ; End case OPENF% JSYS error handling endif. ; End case skipping an OPENF% of .nulio call caphrl ; Display the capture herald call ccon ; Turn on ^C trap jrst $capux ; Where to go upon ^C. call inilin ; Initialize the line for transfer do. ; Enter loop context call getcrt ; Get a carriage return terminated line of text jrst $capux ; On error, close the file and restore the line call eofovr ; Overwrite any EOF at the end of the string move t1, filjfn ; Load the file JFN cain t1, .nulio ; But!! Only going to toss it? ifskp. ; No, so do the write andg. p4 ; Unless we have nothing to write move t2,[point 7,strbuf] ;Source is the repacked string movn t3, p4 ; Load negative length because ... SOUT% ; Counted SOUT%'s are faster %jserr (,$capux) ; Complain and stop doing this endif. ; End case writing the file (or tossing the data) jumpl q4, endlp. ; Break out of loop if allready hit EOF character jumpe t4, top. ; Don't print the prompt unless told to skipn q1, strc ; No search string, then? loop. ; No such luck, go get some more data move t1, q3 ; Load whatever transfer JFN we're using move t2,[point 8,strbf2] ;Point to search string movn t3, q1 ; Load exact count to do came t1, ttyjfn ; Going to the terminal? ifskp. ; Yes, that's easy enough SOUT% ; Boom, done %jserr (,$capux) ; or not... else. ; Otherwise, needs a poke to be on its way SOUTR% ; Write the network %jserr (,$capux) ; or not... addm q1, vsotc ; Update tally of SOUTR% bytes endif. ; End case writing the terminal loop. ; Either way, go get some more goodies enddo. ; Exit loop lexical context $capux: call rrslin ; Turn ^C trap off, close file, clear buffer hrroi t1, crlf ;[229] Tie off line PSOUT% ;[229] So INPUT in Batch works ret ; Done subttl Display herald for capture command ; Call: ; ; strc/ Indicates we have a prompt string ; filjfn/ Wherever we're writing the captured data ; q4/ EOF character (if we have one) ; ; N.B., If we bum all the SOUT%'s with a movslj, it will have to get ; executed in section or the text will need to be in section zero caphrl: movei t1, .priou ; Output is always the terminal dxtext (t2,< [KERMIT-20: Capturing to >) ;Tell user we're starting. SOUT% ; Counted SOUT% is faster %jsErr (,) ; Whine and continue move t2, filjfn ; Load the JFN caie t2, .nulio ; But!! Just tossing it? ifskp. ; Yes, can't JFNS% because it chokes on a device dxtext (t2,) ; Easy enough to 'translate' (heh) SOUT% ; Counted SOUT% is faster %jsErr (,) ; What? Eh? else. ; Otherwise, assume a bona fide JFN setzb t3, t4 ; Standard formatting, no goofball prefix... JFNS% ; Type it %jsErr (,) ; Whine & continue endif. ; End case output device special casing ifn. q4 ; Do we have an EOF character? dxtext (t2,<, EOF: >) ; We do, so load the herald SOUT% ; Counted SOUT is faster %jsErr (,) ; Whine and continue move t2, q4 ; Load the EOF character andi t2, ^o177 ; Stomp any parity caie t2, .chesc ; The escape character? ifskp. ; It is movei t2, "$" ; Replace it with our talisman else. ; Otherwise, it is a control character movei t3, <"A"-.chcna>(t2) ; Turn into ASCII and get out of the way movei t2, "^" ; Need the pointy up arrow BOUT% ; Type it %jsErr (,) ; Blat move t2, t3 ; Restore the character endif. ; End case tweaking the EOF character for printing BOUT% ; Finally print whatever we made up %jsErr (,) ; Blat and continue endif. ; End case printing EOF character ifmn. strc ; Do we have a prompt string? dxtext (t2,<, prompt: >) ;we do, so type it SOUT% ; Counted SOUT% is faster %jsErr (,) ; Whine and continue move t2, [point 8, strbf2] ; Note, parity was put on the prompt movn t3, strc ; Load negative length because ... SOUT% ; a counted SOUT% is faster %jsErr (,); Whine and continue endif. ; End case prompting dxtext (t2,<, type: >) ; Note trailing space !! SOUT% ; Counted SOUT% is faster %jsErr (,); Whine and continue dxtext (t2,<^C^C>) ; Assume default move t4, mycaps+1 ; Load enabled capabilities txnn t4, sc%ctc ; Is Control-C on?? dxtext (t2,<^G^G>) ; Wasn't ... SOUT% ; Counted SOUT% is faster %jsErr (,) ; Whine and continue dxtext (t2,< to finish] >) ; Note initial leading space !! SOUT% ; Counted SOUT% is faster %jsErr (,) ; Whine and continue ret ; Finally done subttl Get a carriage return terminated line of text ; Call: ; ; q3/ JFN we're reading from, typically netjfn ; p2/ EOF character without parity ; q4/ EOF character, if doing EOF ; ; Return: ; ; +1/ Any kind of error ; +2/ Hit either carriage return or an EOF ; ; t4/ 0 if didn't hit a carriage return ; -1 if we did (a linefeed will be appended!!) ; q1/ Points to last character in seven bit stream ; q4/ -1 if hit the EOF character ; p2/ Preserved, always ; p4/ Total characters that have been buffered up getcrt: saveac ; Used as scratch setzb p4, p5 ; Assume won't buffer anything or hit a CR move p3,[point 8,strbuf] ;Will be reading into the string buffer ; Loop reads until EOF, CR or buffer full do. ; Enter loop context cail p4, capmxl ; Would the read overflow the buffer? exit. ; Then don't read another thing move t1, q3 ; Load the input JFN BIN% ; Wait for a byte %jsErr (,r) ; Whine and return came t1, ttyjfn ; Was this the local terminal? aos nbict ; No, so count a network BIN%, then move t1, t2 ; Check the parity on this poor character call @parity ; Calculate the parity (if any) came t1, t2 ; Is the parity the same?? ifskp. ; That's dandy, let's use it idpb t2, p3 ; Append the single byte we got addi p4, ^d1 ; and count it ifn. q4 ; Doing EOF?? came t2, q4 ; We are. Is this the EOF? anskp. ; Isn't, so just carry on seto q4, ; Flag hit EOF exit. ; Exit the loop endif. ; End case possible EOF checking came t2, p2 ; Was the character a carriage return? ifskp. ; It was, so check and return this line seto p5, ; Flag hit carriage return exit. ; Get out of the loop endif. ; End case checking for carriage return else. ; Not, so a parity error emsg aos ttipar ; Count a detected parity error ret ; And give an error return endif. ; End case checking parity call clrest ; Find out how much, if anything, remains ret ; Failed somehow, just give up jumpe t1, top. ; If nothing to read, go wait for something remark ; Otherwise, get the rest of the goodies move t2, t1 ; Save a working copy add t2, p4 ; Calculate what would be the final total caig t2, capmxl ; Would this read overflow the buffer? ifskp. ; It would, so clip down to maximum subi t2, capmxl ; Calculate the overflow sub t1, t2 ; And reduce the read by that amount endif. ; End case buffer overflow check move p1, t1 ; Save final maximum move t1, q3 ; Load whatever transfer JFN we're using move t2, p3 ; Load current position in buffer dmove t3, p1 ; Load maximum we'll read and terminator SIN% ; And grab whatever else is waiting for us %jsErr (,r) ; Whine and return move p3, t2 ; Update current position in buffer sub p1, t3 ; Subtract negative to get total characters transferred camn q3, ttyjfn ; Not using the local terminal? ifskp. ; No, so updates some more variables aos nsici ; Update Network SIN%'s Issued camle p1, nsimx ; Smaller than biggest? movem p1, nsimx ; Nope, we have a new winner addm p1, nsitc ; Update Network SIN% total characters read endif. ; End case network tally updates add p4, p1 ; Compute total characters in strbuf ldb t1, t2 ; Pick up the last eight bit character came t1, p2 ; Was it a carriage return?? loop. ; Wasn't, so go get some more data seto p5, ; Otherwise, it was, so flag and fall out of the loop enddo. ; End loop lexical context remark ; Check parity and repack the string move t2,[point 8,strbuf] ;Point to network input buffer movn t3, p4 ; Pretend doing a SOUT% remark ; If no parity, chkpar will return +2 call chkpar ; Check the parity ifskp. ; Everything is fine, so convert to 7 bit move t1, p4 ; Source length is the total characters gotten move t2,[point 8,strbuf] ;Which comes from the network data setzb t3, q2 ; Pointers are section zero local move t4, p4 ; Output string is same length move q1,[point 7,strbuf] ;Destination is same with smaller byte size extend t1, movchr ; Repack the string in place (which is safe) nop ; Ignore any odd non-skip else. ; Otherwise, badness emsg aos ttipar ; Count a detected parity error ret ; And fail the call endif. ; End parity check ife. p5 ; If no CR, fix up the last pointer seto t2, ; movchr points PAST the last character adjbp t2, q1 ; So back up the 7 bit pointer by one move q1, t2 ; And pass that back else. ; Otherwise, we hit the carriage return!! movei t1, .chlfd ; So will need a line feed idpb t1, q1 ; Append it addi p4, ^d1 ; and acCOUNT for it (Boo...) endif. ; End case carriage return fix up move t4, p5 ; Pass back the carriage return flag retskp ; Return success subttl Check for and Overwrite EOF at the end of the string ; Assumes that the EOF is always within three characters of the last ; character, including that character. This is based on how the EOF ; logic sends the character in TRANSMIT and how the CAPTURE logic will ; append a linefeed to any carriage return it finds. In other words, ; the sequence we check for is . However, if we bump ; into the EOF before we've checked everything, that's fine, too. ; ; Call: ; ; q1/ Points to the last character in the seven bit stream ; q4/ EOF character with parity (if we're doing any parity) ; p3/ EOF character without parity (whether or not we're doing parity) ; p4/ Length of string we're just about to write ; ; Return: ; ; +1, always ; ; q1/ Unchanged, string will have EOF character stripped if q4 was -1 ; q4/ Set to -1, if found the EOF character ; p3/ Unchanged ; p4/ Length will be less, depending on where we found the EOF ; ; All other registers are preserved ; ; N.B., EVERYTHING after the EOF is tossed, including the EOF!! eofovr: jumpe p3, r ; If not checking EOF, we have nothing to do jumple p4, r ; Don't bother if funny length, either ; First do the trivial edge cases ifl. q4 ; So, did somebody else already flag this? subi p4, ^d1 ; They did, so don't write the EOF to the file ret ; After shortening length, we're done endif. ; End trivial case of somebody already told us ; Next trivial case? Is it at the end? ldb t1, q1 ; Get the last character came t1, p3 ; EOF already? ifskp. ; That was easy, just reduce the length seto q4, ; Flag we hit EOF subi p4, ^d1 ; We're not writing EOF to the file ret ; and return; we're done endif. ; End case checking last character ; Final trivial case, a single character string cain p4, ^d1 ; Just this one dinky character? ret ; Fine, we didn't hit the EOF ... ; Otherwise, this is about to get harder saveac movei q3, ^d3 ; Will assume sequence is camle q3, p4 ; BUT!! Do we have enough characters? move q3, p4 ; No, so clip it down to remaining sojle q3, R ; Account for character we just checked (in t1) ; Also double checks our arithmatic, above seto q2, ; Back up the pointer adjbp q2, q1 ; Now pointing at penultimate character ldb t2, q2 ; and load that character came t2, p3 ; Hit the EOF? ifskp. ; We did seto q4, ; Flag we hit EOF subi p4, ^d2 ; We punted two characters from the string ret ; and return; we're done else. ; We didn't hit the EOF cain q3, ^d1 ; Was it a two character string, then? ret ; Then we're done, no EOF found endif. ; End case checking penultimate character sojle q3, R ; Account for this second character we just checked ; Checking last character, so can reuse q3 seto q3, ; Back up the pointer one more adjbp q3, q2 ; Now pointing at the antipenultimate character ldb t3, q3 ; and load that character came t3, p3 ; Hit the EOF finally?? ret ; Nope, so wasn't in this string seto q4, ; It's the EOF! So flag we found it subi p4, ^d3 ; Punting three characters from the string ret ; and return; we're done ;[230] End code insertion subttl Translation table for MOVST to not uppercase ;[209] Begin code and table insertion ; Inspired by my rewrite of SETNOD, SETND2 (ND2SUB.MAC) chgsec(code,const) ;;Put tables in the constants .psect %ascii=.chcnb ; ASCII values start at Control-B remark Character table simply moves characters until a backslash is hit chrtab: intern chrtab ; Also used by k20par xwd eoscod,.chcna ; NUL is end of string, ^A is allowed xlist ; Don't need to see all this junk repeat ^d<<128-2>_-1>,< ;;Fill table with one to one translations xwd %ascii,%ascii+1 ;;Properly fill half words %ascii==%ascii+2 ;;Step to next pair >;;repeat ^d63 ;;Do remaining 126 characters list ; Restart the blather %eochr=. ; Remember end of table reloc chrtab+<<"\">_-1> ; Gets us to the corrct halfword pair xwd >,135 ;Stop on a backslash, emit a right brocket reloc %eochr ; Get to end of table %ascii=eoscod!200!.chnul ; Anything we translate with bit 8 is bad xlist ; Don't need to see all this junk repeat ^d<<128>_-1>,< ;;Fill table with one to one translations xwd %ascii,%ascii+1 ;;Properly fill half words %ascii==%ascii+2 ;;Step to next pair >;;repeat ^d64 ;;Do remaining 126 characters cleans(<%ascii,%eochr>) ;;Don't polute the symbol table subttl Translation table for MOVST to UPPERcase %ascus=.chcnb ; ASCII values start at Control-B remark Character table UPPERcases characters until a backslash is hit chrtup: xwd eoscod,.chcna ; NUL is end of string, ^A is allowed xlist ; Don't need to see all this junk repeat ^d<<128-2>_-1>,< ;;Fill table with one to one translations xwd %ascus,%ascus+1 ;;Properly fill half words %ascus==%ascus+2 ;;Step to next pair >;;repeat ^d63 ;;Do remaining 126 characters list ; Restart the blather %eotup=. ; Remember end of table reloc chrtup+<<"\">_-1> ; Gets us to the corrct halfword pair xwd >,135 ;Stop on a backslash, emit a right brocket reloc chrtup+<<"`">_-1> ; Gets us to the corrct halfword pair xwd "`","A" ; Convert lowercase a to UPPERcase A %ascus="B" ; Starting at lowercase b xlist ; Don't need to see all this junk repeat ^d<<26-2>_-1>,< ;;Fill table with UPPERcase replacement xwd %ascus,%ascus+1 ;;Properly fill half words %ascus=%ascus+2 ;;Step to next pair >;;repeat ^d12 ;;Do remaining 24 characters list ; Restart the blather xwd "Z",173 ; Last letter and Left brace reloc %eotup ; Get to end of table remark For eight bit data, everything stops us %ascus=eoscod!200!.chnul ; Anything we translate with bit 8 is bad xlist ; Don't need to see all this junk repeat ^d<<128>_-1>,< ;;Fill table with one to one translations xwd %ascus,%ascus+1 ;;Properly fill half words %ascus==%ascus+2 ;;Step to next pair >;;repeat ^d64 ;;Do remaining 126 characters list ; Restart the blather retsec ; Re-open executable code cleans(<%ascus,%eotup>) ; Don't polute the symbol table subttl cescxp C Escape Expansion ; Given a source and destination pointer, copies the string from the ; source to the destination, triggering C escape expansion where ; appropriate. The source string MUST be NUL terminated ; ; If case is being ignored, then the string is UPPERcased as it is ; copied to facilitate later usage of string comparison instructions. ; ; Returns updated pointers and length. The destination buffer can ; never fill before the input buffer empties because any expansion ; involves converting two or more characters to a single character. ; ; Parity MUST be stripped before calling this routine. Although it ; will accept 8 bit pointers, it expects that the parity bit has been ; removed and will fail if finds a character with bit 8 set. ; ; Assumes section local pointers, do not use OWGP as the wrong ; thing will be returned. chrmov: movst 0,chrtab ; Moves string without UPPERcasing .chnul ; Fill character is end of string chrmup: movst 0,chrtup ; Translate table to UPPERcase .chnul ; Fill character is end of string ; Call: ; ; t1/ Destination string pointer ; t2/ Source string pointer ; t3/ Maximum length of destination ; t4/ Translation table to use (whether matching case or not) ; ; Returns: ; ; +1/ Something bad happened or did nothing ; +2/ Good return ; ; t1/ Updated destination string pointer ; t2/ Updated source string pointer ; t3/ Length we translated cescxp: entry cescxp ; Also used by k20par saveac ; Save registers for piggy MOVST hrrz p1, t4 ; Save requested table hrli p1, (movst 0,) ; Load correct extended instruction opcode setz p2, ; .chnul is the fill character move q1, t1 ; Position destination for MOVST move t1, t3 ; Set source length move t4, t3 ; Same as destination (so no fill) move q3, t3 ; Save (original) length for later setzb t3, q2 ; Force local pointers txz t1, N!M ; Clear translation flags do. ; Enter loop context txo t1,S ; Set significance flag (start translating) extend t1, p1 ; Move the string, testing for end and %jserr (, r) ; Pass any machine error back up txze t1, N ; Bumped into a backslash? ifskp. ; We did not and haven't exhausted source txz t1, S!N!M ; Clear all the flags move q4, t2 ; Keep stopping source pointer aoja t1, endlp. ; Account that .chnul was not consumed endif. ; and we are done with the string move txz t1, S!N!M ; Clear all the flags jumpe t1, endlp. ; Done if no more source jumpe t4, endlp. ; Done if no more destination call escchr ; Otherwise, process an escape character ret ; Failed, just stop right now jumpg t1, top. ; Keep moving characters until no more enddo. ; End loop context remark t2, ; Still has source move t3, q3 ; Load original length sub t3, t4 ; Calculate what we finally produced move t1, q1 ; Restore updated destination BEFORE terminating it idpb q2, q1 ; Tie off destination camn t3, q3 ; Stopped before the end of the string? ifskp. ; Uh oh... Stopped early. What did that? ldb t4, q4 ; Load source character that stopped us lshc t4, ^d<-1> ; Divide by two, shifting odd bit into bit zero lsh q1, ^d<-35> ; Shift into bit zero xct [ hlrz q2,chrtab(t4) ; Even, pick up left half hrrz q2,chrtab(t4) ](q1) ; Even, pick up right half txzn q2, eoscod ; Had to be an end of string anskp. ; But wasn't, so we're done txze q2, 200 ; Any parity? ret ; Yes, so that's bad; return +1 endif. ; End eigth bit checking jumple t3, R ; Nothing to do if nothing read retskp ; Return +2 subttl Escape table for escape character substitution ; The translate table assumes that exactly a SINGLE character is to be ; translated, unless a number is being given. The logic coupled with ; it is as follows: ; ; 1) If the character count is zero, then a single character ; substitution was possible and we are done. ; ; 2) Any character that does not have a valid escape mapping will ; terminate with the N bit set (note TRMCOD opcode). ; ; 3) Any character that requires further processing will terminate ; processing (EOSCOD), but the count will not be zero. These ; characters are currenly upper and lower X and decimal digits. chgsec(code,const) ;;Put table in the constants .psect %escha=0 ; Starts out at .CHNUL esctab: remark ; Appropriately trigger on escape values xlist ; Don't need to see all this junk repeat ^d<<128>_-1>,< ;;Fill table with all error characters xwd trmcod!%escha,trmcod!<%escha+1> %escha=%escha+2 ;;Step to next pair >;;repeat ^d64 ;;Do all 128 characters list ; Restart the blather %eoesc=. ; Remember end of table reloc esctab+<<"0">_-1> ; Gets us to the correct halfword pair xlist ; Save the trees!!! %escha="0" ;Handle numbers repeat ^d4,< ;;Only digits 0 through 7!!!! xwd eoscod!%escha,eoscod!<%escha+1> %escha==%escha+2 ;;Step to next pair > remark 8,9 ; Are not valid Octal list ; Restart the blather define escsub(chr1,sub1,chr2,sub2) < reloc esctab+<<&177>_-1> ;;Gets us to the correct halfword pair xwd sub1,sub2 ;;Emit the appropriate pair >;;escsub escsub(".",<".">,"/",) ;;Tops-10 monitor prompt escsub("@",<"@">,"A",.chbel) ;;I kept fat fingering \@ ... escsub("B",.chbsp,"C",.chcnc) escsub("D",.chcnd,"E",.chesc) escsub("F",.chffd,"G",); escsub("N",.chlfd,"O",) escsub("P",,"Q",.chdbq) escsub("R",.chcrt,"S",) escsub("T",.chtab,"U",) escsub("V",.chvtb,"W",) escsub("Z",.chcnz,"[",) ;;Left brocket escsub("`",,"a",.chbel) escsub("b",.chbsp,"c",.chcnc) escsub("d",.chcnd,"e",.chesc) escsub("f",.chffd,"g",); escsub("n",.chlfd,"o",) escsub("p",,"q",.chdbq) escsub("r",.chcrt,"s",) escsub("t",.chtab,"u",) escsub("v",.chvtb,"w",) escsub("z",.chcnz,173,) ;;Left curly brace escsub(.chdbq,.chdbq,"#",) ;;Double quote escsub("&",,"'","'") escsub(76,,"?","?") ;;Left pointy bracket escsub("\","\","]",) ;;Right broket reloc %eoesc ; Get to back to end of table retsec ;;Re-open executable code cleans(<%escha,%eoesc>) ;;Don't polute the symbol table subttl Handle escape character substitution and expansion ; See esctab commentary above for this routine's logic summary. In ; this routine's case, the MOVST is not being used for the efficiency ; of moving a string but rather for the 'relative' ease of using a ; table driven approach. However, this would still probably be more ; efficient than a worst case skip chain. ; ; Call: ; ; t1/ Remaining bytes in source string ; t2/ Section local pointer to source ; t3/ 0 (and must be zero) ; t4/ Remaining bytes in destination string ; q1/ Section local pointer to destination ; q2/ 0 (and must be zero) ; ; Return: ; ; +1/ Failed somehow ; +2/ Escape character substituted or expanded ; ; t1 through q2 updates as appropriate. ; ; Be aware of the following: ; ; While the routine is fairly defensively coded, it makes an ; assumption that the destination string is always at least as long as ; the source. If this is the case, then the destination storage space ; can NEVER be overflowed because the minimal substitution will remove ; two characters from the source while depositing a single character ; in the destination. escmov: movst 0,esctab ; Actual extend instruction being executed .chnul ; Fill character is end of string (never used) escchr: entry escchr ; Used in k20par saveac ; EXTEND needs SO many registers... txz t1, N!M!S ; Stomp flags so math and EXTEND work skipg q3, t1 ; Save and check remaining source count %ermsg (,r) move q4, t4 ; Save current remaining destination count move t1,[S!<^d1>] ; Only looking at a SINGLE character of source movei t4,^d1 ; Destination will be always be one character extend t1, escmov ; Try to expand the escape %jserr (, r) ; Pass any machine error back up ifxn. t1, N ; Invalid escape character?? emsg ldb t1, t2 ; Pick up what didn't work PBOUT% ; Show us hrroi t1, crlf ; Load end of line PSOUT% ; Print it ret ; Return failure endif. ife. t4 ; Was this a simple substitution? sosge t1, q3 ; Yes, account for source byte consumed %ermsg (,r) sosge t4, q4 ; Account for destination byte consumed %ermsg (,r) retskp ; Return success endif. move t1, q3 ; Original remaining source bytes is fine seto t3, ; But must back up the source pointer adjbp t3, t2 ; because it did not translate the byte move t2, t3 ; Overwrite current setz t3, ; Keep source pointer section local move t4, q4 ; Restore original remaining destination bytes call cvtoct ; Convert ASCII octal digits to binary ret ; Pass the error up ; Range check result caile t3, .chdel ; Over 7 bits? %ermsg (,r) idpb t3, q1 ; Deposit in output buffer setz t3, ; Keep source string section local sosge t4 ; Account for destination byte consumed %ermsg (,r) retskp ; Worked! subttl ASCII Octal to Binary Octal Conversion table chgsec(code,const) ;;Put the table in the constants .psect %octal=0 ; ASCII values start at .chnul octtab: xlist ; Save the trees!!! repeat ^d<<128>_-1>,< ;;Fill table with ending characters xwd eoscod!%octal,eoscod!<%octal+1> %octal=%octal+2 ;;Step to next character pair >;;repeat ^d64 ;;Do all 128 characters list ; Safe to look now, phew!!!! %eooct==. ; Remember the end of octal table reloc octtab+<<"0">_-1> ; Gets us to the corrct halfword pair %octal=0 ; Starting octal digit VALUE repeat ^d4,< ; Only doing 4 pairs of digits 0 through 7 xwd %octal,%octal+1 ; Emit the octal value for the ASCII digit %octal==%octal+2 ;;Step to next character pair > remark 8,9 ;;Fail on decimal digits!!!! xwd trmcod!<"8">,trmcod!<"9"> reloc %eooct ; Get back to the end of octtab table retsec ;;Restore code psect cleans(<%octal,%eooct>) ;;Don't polute the symbol table subttl Octal Conversion ; The purpose of the function is to bum a NIN%. This done for two ; reasons: ; ; 1) It's faster (no JSYS overhead) ; 2) It keeps counters straight. ; ; Done only in the context of a previous movst (see escchr, ; above), so has an odd register file to contend with. ; ; Although a 36 bit word will hold twelve 3 bit octal digits, we limit ; it to eleven digits so we don't wind up having to deal with any ; goofy numbers that look negative. ; ; However, the limit here is 12. This allows us to determine the ; difference between a number that is too long and a character that ; terminated the translation. ; ; The conversion code is trivial, we don't even use a cvtdbo (which is ; the wrong base, anyway), but rather take a seven bit ASCII digit, ; subtract ASCII zero ("0") from it and then deposit it in a register. ; This is all done with a single MOVST. ; ; Upon termination, that binary octal number is left-normalized and ; need merely be right-normalized with a lshc. ; ; Call: ; ; t1/ Remaining bytes in source string ; t2/ Section local pointer to source ; t3/ 0 (and must be zero) ; t4/ Remaining bytes in destination string ; q1/ Section local pointer to destination ; q2/ 0 (and must be zero) ; ; Return: ; ; +1 Some kind of failure ; +2 ; t1/ Updated with bytes consumed ; t2/ Updated pointer past digits consumed ; t3/ Binary form of octal number ; t4/ Preserved ; q1/ Preserved ; q2/ Preserved ; ; N.B., Caller *MUST* rezero t3!!! octmov: movst 0,octtab ; Actual extend instruction being executed .chnul ; Fill character is end of string (never used) cvtoct: saveac ; Preserve what we'll stomp txz t1, N!M ; Clear the number flags txo t1, S ; Start translating immediately dmove t4,[ ^d12 ; Maximum of eleven octal digits (see above) point 3, q3 ] ; N.B., 3 bit bytes!! setz q3, ; Give the destination a clean slate extend t1, octmov ; Convert Octal digits %jserr (,r) ifxn. t1, N ; Invalid digit?? emsg ldb t1, t2 ; Pick up what didn't work PBOUT% ; Show us hrroi t1, crlf ; Load end of line PSOUT% ; Print it ret ; Return failure endif. ifle. t4 ; Exhausted destination string? %ermsg (,r) endif. exch t4, q3 ; Position left-justified result in adjacent AC movei q2, ^d12 ; Load original (slightly bogus) limit sub q2, q3 ; Calculate log base 8 of final number (heh) ifl. q2 ; Complete gubbish? %ermsg (,r) endif. ife. q2 ; Never did anything?? %ermsg (,r) endif. ; Very puzzling imuli q2, ^d3 ; Three bits per octal digit lshc t3, (q2) ; Shift the bits into the right place txz t1, S!N!M ; Clear the flags some more addi t1,^d1 ; Account for character we stopped on seto q2, ; But are now at, so back up the point adjbp q2, t2 ; so that an ildb works and the consequent exch q2, t2 ; Say this is the real pointer retskp ; And return with the correct register file subttl Translation table for first character to search for ; Translate tables cannot be in extended text (non-zero section) ; because we need to use them to transfer a few characters for match ; purposes. ; ; N.B., a NUL character stops the search, but does NOT set the 'N' ; bit! ntrigr has to account for this because data that comes back ; from Tops-10 can have NUL's in it. Might be padding. chgsec(code,const) ;;Put table in constants area %asc1c=.chcnb ; ASCII values start at Control-B remark Base translate table passes all 7 bit data btrnst: xwd eoscod!.chnul,.chcna ;;NUL terminates xlist ; Don't need to see all this junk repeat ^d<<128-2>_-1>,< ;;Fill table with one to one translations xwd %asc1c,%asc1c+1 ;;Properly fill half words %asc1c=%asc1c+2 ;;Step to next pair >;;repeat ^d63 ;;Do remaining 126 characters list ; Restart the blather remark For eight bit data, everything stops us %asc1c=eoscod!200!.chnul ; Anything we translate with bit 8 is bad xlist ; Don't need to see all this junk repeat ^d<<128>_-1>,< ;;Fill table with one to one translations xwd %asc1c,%asc1c+1 ;;Properly fill half words %asc1c==%asc1c+2 ;;Step to next pair >;;repeat ^d64 ;;Do remaining 126 characters list ; Restart the blather sertln==.-btrnst ; Calculate search table length ; After second pass, not needed at all cleans(<%asc1c>) ;;Don't polute the symbol table subttl Caseless Translation table for first character to search for ; N.B., a NUL character stops the search, but does NOT set the 'N' ; bit! ntrigr has to account for this because data that comes back ; from Tops-10 can have NUL's in it. %asc1u=.chcnb ; ASCII values start at Control-B remark Base translate table passes all 7 bit data, uppercasing along the way btrnsu: xwd eoscod!.chnul,.chcna ;;NUL terminates xlist ; Don't need to see all this junk repeat ^d<<128-2>_-1>,< ;;Fill table with one to one translations xwd %asc1u,%asc1u+1 ;;Properly fill half words %asc1u=%asc1u+2 ;;Step to next pair >;;repeat ^d63 ;;Do remaining 126 characters list ; Restart the blather %eotsu=. ; Remember end of table reloc btrnsu+<<"`">_-1> ; Gets us to the corrct halfword pair xwd "`","A" ; Convert lowercase a to UPPERcase A %asc1u="B" ; Starting at lowercase b xlist ; Don't need to see all this junk repeat ^d<<26-2>_-1>,< ;;Fill table with UPPERcase replacement xwd %asc1u,%asc1u+1 ;;Properly fill half words %asc1u=%asc1u+2 ;;Step to next pair >;;repeat ^d12 ;;Do remaining 24 characters list ; Restart the blather xwd "Z",173 ; Last letter and Left brace reloc %eotsu ; Get back to end of table remark For eight bit data, everything stops us %asc1u==eoscod!200!.chnul ; Anything we translate with bit 8 is bad .xcref %asc1u ; Keep off cross reference xlist ; Don't need to see all this junk repeat ^d<<128>_-1>,< ;;Fill table with one to one translations xwd %asc1u,%asc1u+1 ;;Properly fill half words %asc1u==%asc1u+2 ;;Step to next pair .xcref %asc1u ;;Keep off of cross reference >;;repeat ^d64 ;;Do remaining 126 characters list ; Restart the blather cleans(<%asc1u,%eotsu>) ;;Punt working symbols subttl Macro to build a parity generating and checking tables ; Inspired by PARBIT remote macro in TTYSRV (see CHITAB). buildp is ; a more generalized approach to handle both checking and generating ; any kind of a parity table, suitable for string instructions. ; ; To generate various parities: ; ; Mark buildp(200,200) ;;Sets both odd and even, always ; Space buildp(0,0) ;;N.B., can be optimized with movslj for 7 bit ; Even buildp(200,0) ;;Only emit even parity bit ; Odd buildp(0,200) ;;Only emit odd parity bit ; ; To double check the table, set the parity you want and run a timing test define buildp(evn,odp) < ;;Builds a parity table xlist ;; Save us the blat, please ... odp!.chnul,,evn!.chcna ;; 0 ^@,, 1 ^A NULL,, evn!.chcnb,,odp!.chcnc ;; 2 ^B,, 3 ^C evn!.chcnd,,odp!.chcne ;; 4 ^D,, 5 ^E odp!.chcnf,,evn!.chbel ;; 6 ^F,, 7 ^G ,,Bell evn!.chbsp,,odp!.chtab ;; 10 ^H,, 11 ^I Backspace,,Tab odp!.chlfd,,evn!.chvtb ;; 12 ^J,, 13 ^K Line-Feed,,Vertical Tab odp!.chffd,,evn!.chcrt ;; 14 ^L,, 15 ^M Form Feed,,Carriage Return evn!.chcnn,,odp!.chcno ;; 16 ^N,, 17 ^O evn!.chcnp,,odp!.chcnq ;; 20 ^P,, 21 ^Q odp!.chcnr,,evn!.chcns ;; 22 ^R,, 23 ^S odp!.chcnt,,evn!.chcnu ;; 24 ^T,, 25 ^U evn!.chcnv,,odp!.chcnw ;; 26 ^V,, 27 ^W odp!.chcnx,,evn!.chcny ;; 30 ^X,, 31 ^Y evn!.chcnz,,odp!.chesc ;; 32 ^Z,, 33 ^[ ,,Escape Control evn!.chcbs,,odp!.chcrb ;; 34 ^\,, 35 ^] Control Backslash,,Right Bracket odp!.chccf,,evn!.chcun ;; 36 ^^,, 37 ^_ Control Cicumflex,,Underline evn!.chspc,,odp!"!" ;; 40 ,, 41 ! Space,, odp!.chdbq,,evn!"#" ;; 42 " ,, 43 # Double quote,, odp!"$",,evn!"%" ;; 44 $ ,, 45 % evn!"&",,odp!"'" ;; 46 & ,, 47 ' odp!"(",,evn!")" ;; 50 ( ,, 51 ) evn!"*",,odp!"+" ;; 52 * ,, 53 + evn!",",,odp!"-" ;; 54 , ,, 55 - Comma,,Dash (Minus Sign) odp!".",,evn!"/" ;; 56 . ,, 57 / Dot,,Forward Slash odp!"0",,evn!"1" ;; 60 0 ,, 61 1 evn!"2",,odp!"3" ;; 62 2 ,, 63 3 evn!"4",,odp!"5" ;; 64 4 ,, 65 5 odp!"6",,evn!"7" ;; 66 6 ,, 67 7 evn!"8",,odp!"9" ;; 70 8 ,, 71 9 odp!":",,evn!";" ;; 72 : ,, 73 ; Colen,, Semicolen odp!.chlpt,,evn!"=" ;; 74 ,, 75 = Left pointy,, evn!.chrpt,,odp!"?" ;; 76 ,, 77 ? ,,Right pointy evn!"@",,odp!"A" ;; 100 @ ,,101 A odp!"B",,evn!"C" ;; 102 B ,,103 C odp!"D",,evn!"E" ;; 104 D ,,105 E evn!"F",,odp!"G" ;; 106 F ,,107 G odp!"H",,evn!"I" ;; 110 H ,,111 I evn!"J",,odp!"K" ;; 112 J ,,113 K evn!"L",,odp!"M" ;; 114 L ,,115 M odp!"N",,evn!"O" ;; 116 N ,,117 O odp!"P",,evn!"Q" ;; 120 P ,,121 Q evn!"R",,odp!"S" ;; 122 R ,,123 S evn!"T",,odp!"U" ;; 124 T ,,125 U odp!"V",,evn!"W" ;; 126 V ,,127 W evn!"X",,odp!"Y" ;; 130 X ,,131 Y odp!"Z",,evn!"[" ;; 132 Z ,,133 [ ,,Open Broket odp!"\",,evn!"]" ;; 134 \ ,,135 ] Backslash,,Close Broket evn!"^",,odp!"_" ;; 136 ^ ,,137 _ Up arrow,,Underline odp!"`",,evn!"a" ;; 140 ` ,,141 a Backtic (accent grave) evn!"b",,odp!"c" ;; 142 b ,,143 c evn!"d",,odp!"e" ;; 144 d ,,145 e odp!"f",,evn!"g" ;; 146 f ,,147 g evn!"h",,odp!"i" ;; 150 h ,,151 i odp!"j",,evn!"k" ;; 152 j ,,153 k odp!"l",,evn!"m" ;; 154 l ,,155 m evn!"n",,odp!"o" ;; 156 n ,,157 o evn!"p",,odp!"q" ;; 160 p ,,161 q odp!"r",,evn!"s" ;; 162 r ,,163 s odp!"t",,evn!"u" ;; 164 t ,,165 u evn!"v",,odp!"w" ;; 166 v ,,167 w odp!"x",,evn!"y" ;; 170 x ,,171 y evn!"z",,odp!"{" ;; 172 z ,,173 { Open Curly Brace evn!"|",,odp!"}" ;; 174 | ,,175 } Vertical Bar,,Close Curley Brace odp!"~",,evn!.chdel ;; 176 ~ ,,177 $? HZ2000 Lead in (!),,Rubout list ;; Turn the blat back on >;;buildp define badpar (b,%b,%c) < ;;Generates a table with bad parity ifb ,<%b=0> ;;If no bit specified, default to zero ifnb ,<%b=b> ;;Otherwise, use the bit %c=trmcod!%b!.chnul ;;Starts out with NUL character, which fails xlist ; Don't need to see all this junk repeat ^d<<128>_-1>,< ;;Fill table with one to one translations xwd %c,%c+1 ;;Properly fill half words, failing every single one %c=%c+2 ;;Step to next pair >;;repeat ^d64 ;;Do remaining 126 characters list ; Restart the blather cleans(<%b,%c>) ;;Punt working symbols > subttl String based parity generating and checking tables ;[223] Begin table insertions (still in const .psect) remark Seven to Eight bit parity generating tables ; N.B., as with single character routines, bit 8 is disregarded ; when generating parity spar7t: buildp(0,0) ; Space parity simply always clears bit 8 buildp(0,0) ; Clear it for anything with bit 8 up mpar7t: buildp(200,200) ; Mark parity simply always sets bit 8 buildp(200,200) ; Set it for anthing with bit 8 up epar7t: buildp(200,0) ; Build even parity generating table buildp(200,0) ; Ignore bit 8 and process as if it were zero opar7t: buildp(0,200) ; Build odd parity generating table buildp(0,200) ; Ignore bit 8 and process as if it were zero subttl Eight to Seven bit parity checking tables spar8t: buildp(0,0) ; For space, the 1st 128 do not have bit 8 set, so fine badpar(200) ; However, any with bit 8 up are BAD mpar8t: badpar(0) ; For mark, the 1st 128 do not have bit 8 set, so BAD buildp(0,0) ; 2nd 128 have bit 8 up, so fine; strip off the parity epar8t: buildp(trmcod,0) ; Anything with even parity should NOT be in lower 128 buildp(0,trmcod) ; Otherwise, odd parity should not be in upper 128 opar8t: buildp(0,trmcod) ; Any odd parity set should not be in lower 128 buildp(trmcod,0) ; Likewise, even parity should not be in upper 128 retsec ; Back into code .psect ;[223] End table insertions subttl Parity routines, used for a single byte and checking ; All accept a character in t1, returning the same character with proper ; parity in t1. +1 always because nothing fails. Supposedly... none: remark ; Default, don't touch the eighth bit. entry none ret mark: remark ; Mark, bit 8 is always 1. entry mark ori t1, ^o200 ; Turn on the parity bit. ret space: remark ; Space, opposite of mark, bit 8 is always zero. entry space andi t1, ^o177 ; Turn off the parity bit. ret even: remark ; Even, the total number of one bits should be even. entry even saveac andi t1, ^o177 ; Start off with bit 8 = 0. move t2, t1 jrst evnodd odd: remark ; Odd, the total number of one bits should be odd. entry odd saveac andi t1, ^o177 ; Turn off the parity bit. movei t2, ^o200(t1) ; Start off with bit 8 = 1. evnodd: remark ; The actual worker subroutine lsh t2, -4 ; Get high order 4 bits of character xori t2, (t1) ; Fold into 4 bits. trce t2, 14 ; Left two bits both 0 or 1? trnn t2, 14 ; or both 1? xori t1, 200 ; Yes, set parity trce t2, 3 ; Right two bits both 0? trnn t2, 3 ; or both 1? xori t1, 200 ; Yes, set parity. ret ;[209] End code insertion subttl SET PARITY parsing tables ;[223] This code moved from k20par and updated %table(partab) ;[223] Values are all table offsets, below %key2 , .parev ;[223] %key2 , .parmk ;[223] %key2 , .parno ;[223] %keyf3 , %odd, ;[223] Abbreviate documented name %odd: %key2 , .parod ;[223] %keyf3 , .parmk, cm%inv ;[223] A common nickname for 'mark' %key2 , .parsp ;[223] %keyf3 , .parsp, cm%inv ;[223] A common nickname for 'space' %tbend ;[223] Begin Switch table insertion comment " The plethora of invisible entries are a result of my being purely unable to come up with what I thought would be a good keyword, picking something to get on with it, becoming dissatisified or otherwise annoyed with that particular choice and then trying something else until things finally 'looked right', both in a printed switch list and in the help text. Of course, then I would remember the old names and ... " ; Define some mnemonic symbols to help us not to be confused... define %Yes <;;> ;;There should only be four (4) documented entries %No==cm%inv ;;Means not documented in k20hlp.mac remark ; These are the parity switches %table(parswi) remark AC Value Documented? %keyf4 (, q3, 0, %No ) %key3 (, q4, -1) %Yes %keyf4 (, q3, 0, %No ) %key3 (, q4, 0) %Yes %key3 (, q3, -1) %Yes %keyf4 (, q4, -1, %No ) %keyf4 (, q4, -1, %No ) %key3 (, q3, 0) %Yes %tbend cleans(<%Yes,%No>) ;;Clean up worker symbols ;[223] End switch table insertion chgsec(code,const) ;;[223] FDB's are not in code, they're in const schrpr: remark ;[223] Single character parity routines none ;[223] Don't do parity space ;[223] Bit 8 is always clear mark ;[223] Bit 8 is always set even ;[223] Even parity odd ;[223] Odd parity stpart: remark ;[223] String based parity tables Z ;[223] None means do nothing spar7t,,spar8t ;[223] Space parity generating and checking mpar7t,,mpar8t ;[223] Mark parity generating and checking epar7t,,epar8t ;[223] Even parity generating and checking opar7t,,opar8t ;[223] Odd parity generating and checking spafdb: flddb. .cmcfm,,,,,spafdd spafdd: flddb. .cmkey,,partab,,,, ;;[223] If in a define spwfdb: flddb. .cmcfm,,,,,spwfdd spwfdd: flddb. .cmswi,,parswi,,,, ;;[223] If in a define retsec ;;Back to where-ever we started from subttl SET PARITY parsing .setpa: entry .setpa ;[223] Invoked from k20par guide movei t1, spafdb ;[223] Assume not defining a macro skipe definf ;[223] But!! Are we in a define? movei t1, spafdd ;[223] Indeed; don't parse a confirm call rfield ; Parse a keyword. ldb t3, [pointr (.cmfnp(t3),cm%fnc)] ;[223] Get what was parsed caie t3, .cmcfm ;[223] Parsed a confirm? ifskp. ;[223] We did, setzb t2, t3 ;[223] so load default values movem t2, pars3 ;[223] Offset zero is 'none' dmovem t2, pars4 ;[223] Parity on all I/O, sent--not checked ret ;[223] Nothing further to do; comand is confirmed endif. ;[223] End requesting default values saveac ;[223] Needs a few more registers hrrz t2, (t2) ; Get the value for the keyword. dmove q1, t2 ;[223] Save value and parse type setzb q3, q4 ;[223] Assume parity on all I/O, sent--not checked do. ;[223] Enter loop context movei t1, spwfdb ;[223] Assume we can confirm skipe definf ;[223] But!! Are we in a define? movei t1, spwfdd ;[223] We are; wait on the confirm call rflde ;[223] Try to parse something ifskp. ;[223] Worked!! ldb q2, [pointr (.cmfnp(t3),cm%fnc)] ;[223] Get function code. cain q2, .cmcfm ;[223] Finally finished typing switches? exit. ;[223] Yes, break out of the loop hrrz t1, (t2) ;[223] Get the value pair for the switch hlrz t2, (t1) ;[223] Pick up the address hrre t3, (t1) ;[223] Sign extend the value movem t3, (t2) ;[223] Side effect something else. ;[223] Otherwise, failed the parse skipn definf ;[223] In DEFINE? jrst cmderr ;[223] No, so a definite parse error; allow retry ret ;[223] Return into DEFINE and see if that chokes endif. ;[223] End parse result handling loop. ;[223] Get another switch enddo. ;[223] End loop lexical context movem q1, pars3 ;[223] Store parity actions dmovem q3, pars4 ;[223] Store where to apply parity ret ;[223] Whether or not in a define, can return subttl SET PARITY semantic action extern nrtflg ;[223] Tops-20/Tops-10 DECnet NRT? extern ptyflg ;[223] Talking to ourselves? extern lclpar ;[223] Whether local line will do parity extern opnpar ;[223] Whether open device will do parity extern parity ;[194] Parity routine we'll use extern ebq ;[194] Eight bit quoting character extern ebqr ;[194] We'll request eight bit quoting chgsec(code,data) ;[223] Need writable storage genint:: Z ;[223] Constructed instruction to generate parity chkint:: Z ;[223] Constructed instruction to check parity parpko:: Z ;[223] Doing parity on packets, only parrck:: Z ;[223] Checking parity on recieve in addition to sending retsec ;[223] Get back into code psect $setpa: entry $setpa ;[223] Invoked from k20par extern ttfork ;[223] Parity change forces a fork-reset saveac ;[223] Needs a register dmove t1, pars4 ;[223] Pick up parity domain parse results dmovem t1, parpko ;[223] Store in global variables move q1, pars3 ;[223] What did they say? move q2, schrpr(q1) ;[223] Pick up single character parity routine hlrz t2, stpart(q1) ;[223] Load string based parity generation routine ifn. t2 ;[223] Do we have anything? hrrz t3, stpart(q1) ;[223] Yes, load string based parity checking routine hrli t2, (movst 0,0) ;[223] Drop in the hrli t3, (movst 0,0) ;[223] extended opcodes else. ;[223] Otherwise, this is 'none', which is special cased setz t3, ;[223] Nothing in t3 endif. ;[223] End case extended instruction construction dmovem t2, genint ;[223] Store both extended string instructions movem q2, parity ;[223] Store single character routines call parchr ;[223] Recompute parity on important characters skipn t1, ttfork ;[223] Are we doing interactive communications? ifskp. ;[223] We are, must reset to use new parity KFORK% ;[223] Whack the communications fork %jsErr (,) ;[223] setzm ttfork ;[223] And force a recreate endif. ;[223] End case resetting comunications fork caie q2, none ;[194] Was the parity NONE? ifskp. ;[194] Yes, it was movei t1, "Y" ;[194] Just say we will do 8th-bit movem t1, ebq ;[95] prefixing if requested. setzm ebqr ;[95] But we won't request it ourselves. else. ;[194] Otherwise, not NONE setom ebqr ;[194] So request 8th-bit prefixing. movei t2, dqbin ;[89] Use the default prefix. movem t2, ebq ;[89] ifmn. netjfn ;[223] Network connection? ifme. opnpar ;[223] Yes, does it NOT do parity? ifmn. nrtflg ;[223] DECnet connection? txmsg <%Network connection> ;[223] Yes, say as such else. ;[223] Otherwise, it's something else ifmn. ptyflg ;[223] PTY? txmsg <%Pseudo-terminal> ;[223] else. ;[223] Otherwise, physical line txmsg <%Terminal line> ;[223] endif. ;[223] End PTY decision endif. ;[223] End NRT decision txmsg < does not support parity > ;[223] Remind terminal-and-packets ill-advised endif. ;[223] End case parity on network device else. ;[223] Otherwise, using control terminal ifme. lclpar ;[223] Will local line will do parity? txmsg <%Control terminal line does not support parity > ;[223] Remind terminal-and-packets ill-advised endif. ;[223] endif. ;[223] End case checking device parity toleration txmsg <%Will request 8th-bit prefixing. If the other KERMIT doesn't agree, binary files cannot be sent correctly. > endif. ;[194] End case doing SOME kind of parity ret ;[223] End code move subttl If parity changes, side effect certain characters ;[223] Begin code insertion ; Parity had been computed on all characters in a sending packet ; except where a character might be outside of the packet proper. One ; such character would be padding, which is simply emitted before the ; packet itself is sent. ; ; Now the entire message is built including the padding, start-of- ; header and end-of-line characters and then putpar is called to apply ; parity in a single extended instruction. ; ; There are certain situations where the characters are looked for ; individually, so this code applies parity to all of them whenever ; parity changes. If the characters themselves change, then the ; routines doing the changes apply current parity. ; ; Note that we don't tweak the received characters because the chkpar ; routine is called before we ever get to checking them. Since it ; strips parity, we don't need to worry about it; when receiving... remark ; Document what we'll be tweaking extern ssthdr ; Sending start of header character remark rsthdr ; Receiving start of header character extern spadch ; Sending padding character remark rpadch ; Receiving padding character extern seolch ; Sending End of Line character remark reolch ; Receiving End of Line character extern handsh ; Handshake character chgsec(code,const) ; Table of addresses is constant data pchars: exp ssthdr,spadch,seolch,handsh pcharl==.-pchars ; Number of entries in the table retsec ; Return to code psect parchr: saveac ; Used as a counter movx q1, ; Load maximum offset do. ; Enter loop context move t1, @pchars(q1) ; Load the character andi t1, ^o177 ; Stomp any previous parity call (q2) ; Apply the appropriate parity movem t1, @pchars(q1) ; Store the proper character sojge q1, top. ; Do the next character until done enddo. ; End of loop lexical context ret ; Done fixing up everything cleans () ; Clean up working symbol ;[223] End code insertion subttl Put parity on an eight bit stream ;[223] Begin code insertion ; The algorythm is actually straightforward; the routine is passed a ; pointer to a buffer that is almost ready to send, meaning we are the ; last operation directly before the SOUT%/SOUTR%. The buffer is ; assumed to contain 7 bit ASCII characters in 8 bit bytes, thus ; giving the routine a place to put the parity. ; ; It checks whether parity is being done and, if so, loads the single ; instruction that will perform the operation. This is a MOVST which ; has been constructed with the appropriate translate table. ; ; Again, although the byte pointer being passed is eight bits, the ; string is treated as a series of seven bit bytes in 8 bit fields ; where the current setting of the eigth bit is discarded. The string ; is overwritten in place with the correct parity, at which point, it ; will be completely ready to be sent. ; ; Once the MOVST is started, the whole process is effectively a series ; of table lookups with no computations involved at all. ; ; The routine is faster than calling the single character conversion ; routines, even for the shortest possible Kermit packet of three ; characters. In other words, even with all the register pushing and ; popping, it still always wins. ; ; Depending on your view, the amount of memory taken up by the ; translation tables is not flagrant: a single kiloword and it is ; shared. ; ; Call: (Expected to be just before SOUT%/SOUTR%) ; ; t2/ Pointer to eight bit data to overwrite ; t3/ Negative length of data to do ; ; Return: ; ; +1, always; appropriate parity, if parity is being done (I.E., not 'none') putpar: entry putpar ; Used by packet routines in k20mit jumpge t3, R ; Zero or gubbish? Just leave it alone... move cx, parity ; Load current parity setting cain cx, none ; Not doing anything? ret ; No, so don't do anything saveac ; Otherwise, set up eight registers ... movn t1, t3 ; Source length move t4, t1 ; destination is the same length move q1, t2 ; String will be updated in place (I.E., overwritten) setzb t3, q2 ; Section local pointers skipn q3, genint ; Load and double check extended string instruction ret ; Very odd! We checked above, but ignore it setz q4, ; Fill character is NUL (yet unused...) txz t1, N!M ; Shut off Negative and Mark txo t1, S ; Have to dink the foolish significance bit... extend t1, q3 ; Get down to some serious string translating nop ; Can't happen ret ; Done subttl Generate parity on a seven bit stream ; Like the above, except creates a new eight stream from a seven bit ; stream instead of overwriting the eight bit stream in place. ; ; t1/ Pointer to eight bit destination data ; t2/ Pointer to seven bit source data ; t3/ Negative length of data to do ; ; If parity is being done, then t2 will be updated to the original ; value of t1, otherwise it is unchanged. t1 is always trashed, ; everything else is preserved. ; ; N.B., The above is fine and everything ...but... ; THE BYTE WIDTHS ARE *NOT* CHECKED!!!! genpar: entry genpar ; Used by k20dsp and k20net jumpge t3, R ; Zero or gubbish? Just leave it alone... move cx, parity ; Load current parity setting cain cx, none ; Not doing any parity? ret ; No, so don't do anything saveac ; Otherwise, go hog wild on registers move q5, t1 ; Save original destination move q1, t1 ; and put it where movst wants to use it movn t1, t3 ; Source length is positive move t4, t1 ; destination is the same length setzb t3, q2 ; Section local pointers skipn q3, genint ; Load and double check extended string instruction ret ; Very odd! We checked above, but ignore it setz q4, ; Fill character is NUL (yet unused...) txz t1, N!M ; Shut off Negative and Mark txo t1, S ; Have to dink the foolish significance bit... extend t1, q3 ; Get down to some serious string translating nop ; Can't happen move t2, q5 ; Return new source for SOUT%/SOUTR% ret ; Done subttl Check Parity ; Call: ; ; t2/ Pointer to eight bit data ; t3/ Negative length of data to do ; ; Return: ; ; +1, Bad parity, if parity is not none ; +2, Good parity or none or zero length ; ; The routine is faster than calling single character conversion ; routines for the shortest possible Kermit packet of three ; characters. In other words, even with all the register pushing and ; popping, it still always wins. chkpar: entry chkpar ; Used by k10mit jumpge t3, RSKP ; Zero or gubbish? Just leave it alone... move cx, parity ; Load current parity setting cain cx, none ; Not doing anything? retskp ; No, so don't do anything saveac ; Otherwise, set up eight registers ... movn t1, t3 ; Source length move t4, t1 ; destination is the same length move q1, t2 ; String will be updated in place (I.E., overwritten) setzb t3, q2 ; Section local pointers skipn q3, chkint ; Load and double check extended string instruction retskp ; Very odd! We checked above, but ignore it setz q4, ; Fill character is NUL (yet unused...) txz t1, N!M ; Shut off Negative and Mark txo t1, S ; Have to dink the foolish significance bit... extend t1, q3 ; Get down to some serious string translating nop ; Can't happen txnn t1, N ; Bump into any bad parity? retskp ; Nope, we're done ret ; Otherwise, bad parity subttl padbuf - Generate a buffer of padding characters with correct parity ; Call: ; ; t1/ Number of padding characters ; t2/ 7 bit padding character ; t3/ Parity to form ; t4/ Address of buffer to put the padding with proper padding in ; ; Returns +1, always padbuf: entry padbuf ; Called from k10mit saveac ; Wants some scratch dmove q1, t1 ; Save length and character dmove q3, t3 ; Save parity and buffer address move t1, t2 ; Load padding character call @q3 ; Calculate parity move q2, t1 ; Make a copy repeat ^d3, < ; Construct the next four characters lsh q2, ^d8 ; Shift over an eight bit character or q2, t1 ; Or in the padding character > lsh q2, ^d4 ; Left justify to make 8 bit ASCIZ movem q2,(q4) ; Stomp first word of buffer move t1, q1 ; Load original length idivi t1, ^d4 ; Four 8 bit characters per word caie t2, 0 ; No remainder? addi t1, ^d1 ; Round up a word subi t1, ^d1 ; Already did first word jumple t1, R ; Four characters or less? ; Otherwise, fill out the rest of the buffer move t2, q4 ; Starting address in buffer movei t3, 1(t2) ; Next address to fill out the rest of the necessary xblt. t1 ; words in the buffer (but not the whole buffer) ret ; Done ;[223] End code insertion subttl Close out Code section xlist ; Save the trees!!!!! lit ; Explicitly dump the literals list .endps code ; End of code .psect subttl Local storage .psect data ;Write-able area intima:: defita ;[160] Timeout action for INPUT search. incase:: defics ;[160] Case conversion flag for INPUT search. indeft:: defito ; ** DO NOT ;[194] Default timeout for INPUT search (milliseconds) indeff:: defitf ; REORDER ** ;[212] Same value as floating point seconds indefc:: 0 ;[209] Default search string length in characters indefw:: 0 ;[209] Same length in words indefs:: block strblw ;[209] Storage for default search string (if set) trgchr: block 1 ;[209] The 'trigger' character trnbas: block 2 ;[209] Translation base table we used sertab: block sertln ;[209] Search table ;[209] Handles register spill from searching routines ornetc: block 1 ; ** DO NOT ;[209] Original network count ornetp: block 1 ; REORDER ** ;[209] Original network pointer (end of buffer) ;[209] Next two variables are for cross INPUT calls with left over data inpcbf:: 0 ;[209] Number of characters we flushed inpcnt:: 0 ;** DO NOT REORDER** ;[209] Number of characters in buffer inpptr: point 7, inpbuf ;[209] Current position in buffer inpbuf:: block strblw ;[209] Area to read data into fsized: block 2 ;[229] File size double word .endps data ; Close out storage area .psect text ;[209] Read-only storage inpini: intern inpini ;[209] Used by buffer clearing routines 0 ;[209] Nothing in INPUT command buffer point 7, inpbuf ;[209] So pointing at beginning .endps text ;[209] Close out section zero text .xcmsy ;[194] Ditch MACSYM junk end ; Local Modes: ; Mode:MACRO ; Comment Column:32 ; Comment Start:;[229] ; Comment Begin:;[229] ; Auto Fill Mode: 0 ; End: