Title K20IOC Kermit Input/Output statement Control search monsym,macsym,cmd,k20unv ;[194] cmdacs ; Clean up p1-p4 definitions cmdunv ;[248] ; Externalize storage and constants 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 pars9 ;[265] ; If TRANSMIT is clipping maximum length line extern pars10 ;[266] ; If TRANSMIT is pausing between lines remark pars11 ;[273] ; Not defined as pars10 is a double extern pars12 ;[273] ; Whether matching case extern buffer ; Used for foreign file names and string conversion 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 ttipar ;[258] ; Count of parity errors 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 unarpa ; Turn network binary off (if on a TVT) extern vtermf ; Virtual terminal flag (NRT, PTY, PIP eventually) extern ptytty ;[265] ; This PTY's associated terminal line 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 extern tvtflg ;[271] ; Whether on a Telnet Virtual Terminal extern iaciac ;[247] ; Handle IAC doubling on a TVT in binary mode extern tvtbuf ;[247] ; Buffer where IAC doubling is done 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 Timing Routines ;[267] These are in a completely new module, k20tim extern statim ;[267] Start timing transfer extern endtim ;[267] End timing transfer extern elptim ;[267] Compute elapsed time extern gmkcps ;[267] Calculate Giga, Mega, Kilo character rate 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 extern datbuf ;[257] ; Gigantic buffer for 8 bit read extern asczcp ;[248] ; Move a NUL terminated string and return its length 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:" extern grdmap ;[263] Handle of guard page extern spsiz ;[265] Maximum we will force down the pipe .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 intern castab ;[273] Used in .setca in K20PAR chgsec(code,const) ;;FDB's go in const .psect incfdb: flddb. .cmcfm,,,,,incfd1 incfd1: flddb. .cmkey,,castab,,, retsec ;;Get back into code .psect .sinca: saveac ;[209] Need to remember function code guide ; SET INPUT CASE movei t1, incfdb ;[274] Assume a normal parse skipe definf ;[274] Not in a define, are we? movei t1, incfd1 ;[274] We are, so don't parse a confirm 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. .cmcfm,,,,,indfd1 indfd1: flddb. .cmflt,,,,, retsec ;;Get back into code .psect .sindt: saveac ;[209] Need to remember function code guide movei t1, indfdb ; Various alteratives skipe definf ;[274] Not in a define, are we? movei t1, indfd1 ;[274] We are, so don't parse for a confirm 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: saveac ;[273] Needs these saved move q4, incase ;[273] Load case matching movem q4, pars12 ;[273] Pretend we parsed it 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. .cmcfm,,,,,intfd1 intfd1: flddb. .cmkey,,itatab,,, retsec .sinta: saveac ;[209] Need to remember function code guide movei t1, intfdb ;[209] Load parse fdb address skipe definf ;[274] Not in a DEFINE, are we? movei t1, intfd1 ;[274] We are, so don't parse for a confirm 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 %maxsw==3 ;[265] We parsed the 'maximum' (length) switch %tpasw==4 ;[266] We parsed the 'pause' switch %tcasw==5 ;[273] We parsed the 'case' 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 inpsw1: flddb. .cmswi,,inpswi,,,inpfdb ;[274] inpfdb: flddb. .cmflt,,^d10,,,txtfdb inpfd1: flddb. .cmflt,,^d10,,,txtfd1 ;[274] txtfdb: flddb. .cmcfm,,,,,txtfd1 txtfd1: flddb. .cmqst,,,,,txtfd2 txtfd2: flddb. .cmtxt,,,,, retsec ;;Return to code .psect .input: entry .input ; Invoked from K20PAR saveac ;[273] Used for control flow and linkages remark buffer ;[209] Preserve buffer across calls!!! move q4, incase ;[273] Load INPUT case matching movem q4, pars12 ;[273] Pretend we parsed it guide ;[273] Only prompt once .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 skipe definf ;[274] BUT! Not in a DEFINE? movei t1, inpsw1 ;[274] No, we are, so don't parse for the confirm!! 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 skipe definf ;[274] BUT! Not in a DEFINE? movei t1, txtfd1 ;[274] No, we are, so don't parse for the confirm!! 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 move t1, q4 ;[273] Pass in case observance 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? anskp. ;[262] 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. call doarpa ;[262] Also tweak TVT's binary mode if TVT endif. ;[262] Otherwise, MTOPR%'s will blow up callret netins ;[262] Dispatch to Network Input Matcher repeat 0,< ;[262] $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? Changed to ALWAYS ; call netins, so this is not vestigial and probably will no longer ; work. $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] block. ;[257] Enter block context for better control flow move t1, parity ;[257] Load the parity cain t1, none ;[257] Doing anything? retskp ;[257] No, so let's say good parity skipn parrck ;[257] Are we checking on receive? retskp ;[257] Nope, so nothing to and everything is fine move t1, t2 ;[257] Load the character up for parity routines call @parity ;[257] and generate parity for it came t1, t2 ;[257] Are they the same?? ret ;[257] No, bad parity retskp ;[257] Yes, GOOD parity endbk. ;[257] End of block context ifskp. ;[257] Good parity ifme. pars8 ;[229] Only if not /SILENT move t1, t2 ;[257] Load the character for echoing andi t1, ^o177 ;[257] Strip any parity; Tops-20 will generate PBOUT endif. ; pars8 ;[229] else. ;[257] Otherwise, bad parity aos ttipar ;[257] Count a bad character ifme. paract ;[258] Is the parity action to abort? %ermsg (,$inpux) ;[257] Complain, else. ;[258] Otherwise, action is proceed, so carry on move t2,parsub ;[258] Load substitution character and use that, instead andi t1, ^o177 ;[257] Stomp any parity for comparisons endif. ;[257] End case maybe doing parity endif. ;[258] End case bad parity action decision 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 cain t1, .nulio ;[264] Just dumping it? anskp. ;[264] Yes, so bum the itty bitty BOUT% BOUT ; Yes, record the character in the log. erjmpr .+1 ;[195] Catch and ignore error endif. ;[195] ifme. pars12 ;[273] ;[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. >;REPEAT 0 ;[262] subttl 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. call unarpa ;[209] 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% block. ;[257] Enter block context for better control flow saveac ;[257] Save the JFN while we check context move t1, parity ;[257] Load the parity cain t1, none ;[257] Doing anything? retskp ;[257] No, so let's say good parity skipn parrck ;[257] Are we checking on receive? retskp ;[257] Nope, so nothing to and everything is fine move t1, t2 ;[257] Load the character up for parity routines call @parity ;[257] and generate parity for it came t1, t2 ;[257] Are they the same?? ret ;[257] No, bad parity retskp ;[257] Yes, GOOD parity endbk. ;[257] End of block context ifskp. ;[257] Good parity addi q1, ^d1 ; Count a character to do idpb t2, q2 ; Drop into the (7 bit) output buffer else. ;[257] Otherwise, bad parity aos ttipar ;[257] Count a bad character ifme. paract ;[258] Is parity action abort? %ermsg (,loopio) ;[257] Complain, else. ;[258] Otherwise, action is proceed, so carry on addi q1, ^d1 ;[258] Count a character to do move t2,parsub ;[258] Load substitution character idpb t2, q2 ;[258] Drop into the (7 bit) output buffer endif. ;[258] End case bad parity action decision endif. ;[257] End case maybe doing parity 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 block. ;[257] Enter block context for better control flow move t1, parity ;[257] Load the parity cain t1, none ;[257] Doing anything? ret ;[257] No, so that's fine skipn parrck ;[257] Are we checking on receive? ret ;[257] Nope, so nothing to do and everything is fine retskp ;[257] Otherwise, doing parity endbk. ;[257] End control block ifskp. ;[257] If doing parity, must do an eight bit read move t2,[point 8,datbuf] ;[257] So load a pointer to a different area else. ;[257] No parity, so a seven bit read will suffice move t2, q2 ; Keep reading into the buffer endif. ;[257] End control block return handling move t1, q3 ; Reload the JFN move t4, t3 ;[257] Save a copy of negative length in ignored t4 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. block. ;[257] Enter block context for better control flow saveac ;[257] Save registers for movslj move t1, parity ;[257] Load the parity cain t1, none ;[257] Doing anything? retskp ;[257] No, so let's say good parity skipn parrck ;[257] Are we checking on receive? retskp ;[257] Nope, so nothing to and everything is fine move t2,[point 8,datbuf] ;[257] Reload pointer to 8 bit input area move t3, t4 ;[257] Load original length call chkpaa ;[257] Check the parity (always) ret ;[257] Bad, propagate non-skip return movns t1, t4 ;[257] Using positive equal lengths move q1, q2 ;[257] Destination (seven bit) pointer setzb t3, q2 ;[257] Section local pointers extend t1, movsup ;[257] Convert from 7 to 8 bit nop ;[257] It will never not skip retskp ;[257] Give good return endbk. ;[257] End of block context ifskp. ;[257] Good parity movn t2,t4 ;[257] Turn into a positive adjbp t2, q2 ;[257] Fix up the correct location move q2, t2 ; Keep track of where we are in the buffer else. ;[257] Otherwise, bad parity aos ttipar ;[257] Count a bad parity detected call inpclr ;[258] Flush the buffer dmove q1, inpcnt ;[258] Reseed the loop registers %ermsg (,loopio) ;[257] Complain, endif. ;[257] End case maybe doing parity endif. ;ifg. t1 ; End SIN% 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 ifg. t4 ; Anything to print? call netprn ; Print what we've seen and what will get tossed endif. ; End case of match being first character 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. pars12 ;[273] ; 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 skipn sesflg ;[264] Is logging active? anskp. ;[264] No, so don't log it cain t1, .nulio ;[264] Just dumping it? anskp. ;[264] Yes, so bum the itty bitty BOUT% 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 skipn sesflg ;[264] Is logging active? anskp. ;[264] No, so don't log it cain t1, .nulio ;[264] Just dumping it? anskp. ;[264] Yes, so don't bother 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: jumple 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 skipn sesflg ;[264] Is logging active? ret ;[264] No, so don't log it cain t1, .nulio ;[264] Just dumping it? ret ;[264] Yes, so don't bother 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: ; ; t1/ Whether observing case or not ; 0, Ignore case ; ~0, Observe case ; atmbuf/ 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 ;[273] Needs some more registers move q4, t1 ;[273] Save case observance flag 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 move t1, t2 ;[248] ; Source and destination are the same call asczcp ;[248] ; Count what is in the atom buffer sosg t3 ;[248] ; Don't count the stupid NUL setz t3, ;[248] ; Normalize if went negative ifg. t3 ;[248] ; Anything to do, actually? dmove t1, q1 ;[248] ; Reload destination and source remark t3, ;[248] ; Was set by asczcp, above ife. q4 ;[273] Case INsensitive compare? movei t4, chrtup ;[273] Yes, so use that table else. ;[273] Otherwise case SENSITIVE movei t4, chrtab ;[273] Different table, somewhat more efficient endif. ;[273] End translation table determination 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 ife. q4 ;[273] Case INsensitive compare? movei t2, btrnsu ;[273] Uppercasing base table with no stop characters else. ;[273] Otherwise, case sensitive matching movei t2, btrnst ; No, so use exact matching table, then endif. ;[273] End case determining matching table movei t3, sertab ;[273] Destination in writable storage to be modified 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 jumpn q4, RSKP ;[273] If case sensitive, we're done remark ;[273] Otherwise, must mark BOTH cases 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 entry 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 thirty five 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 dmove t2,[ point 7, atmbuf ;[248] Point to atom buffer ^d1 ] ;[248] And its single byte dmovem t2, pars3 ;[248] Pass over to semantic action ret ;[248] Done endif. ;[248] End case defaulting input ;[208] Otherwise, the atom buffer is valid confrm ;[208] But must be confirmed dmove t1, [ ;[248] Overwritting the atom buffer in place point 7, atmbuf ;[248] So the source is the atom buffer and point 7, atmbuf ] ;[248] the destination is the atom buffer call asczcp ;[248] Move the string on top of itself, returning count move t2,[point 7,atmbuf];[248] Load address of string to possibly expand sosge t3 ;[248] Don't count the NUL at the end!! setz t3, ;[248] Stomp if went negative dmovem t2, pars3 ;[248] Store for semantic action ret ;[248] Now go do something useful with it subttl OUTPUT command execution remark pars3 ;[248] Pointer to buffer with characters parsed remark pars4 ;[248] Length of buffer $outpu: entry $output ;[209] Invoked by k20par saveac ;[247] Save registers for piggy MOVST remark ;[209] Expand any C escape characters move t1, [point 8,strbuf] ;[248] Destination buffer is eight bit dmove t2, pars3 ;[248] Load source buffer point and length jumpe t3, R ;[248] If nothing to do, then don't do anything movei t4, chrtab ;[209] Respect case on expansion move p2, t1 ;[248] Save output buffer pointer call cescxp ;[209] Expand string into output buffer %ermsg (,r) ;[209] Don't go any further move p1, t3 ;[247] 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, p2 ;[247] Point to converted string movn t3, p1 ;[247] Counted string (gives length of record) setz t4, ;[186] Just in case still NUL terminated (isn't) skipn parpko ;[223] Don't do this if doing packets only call putpar ;[223] Otherwise, maybe put some parity on it ifmn. tvtflg ;[271] On a TVT? block. ;[247] Yes, let's see if we need any quoting saveac ;[247] Save output designator, want an accumulator move q3, [point 8, tvtbuf] ;[247] Special buffer for IAC doubling move t1, p1 ;[247] Positive length move t3, q3 ;[247] Load output area call iaciac ;[247] Go double any IAC's %ermsg (,r) ;;[247] move p1, t4 ;[247] Store updated length move p2, q3 ;[247] New output buffer retskp ;[247] Won! endbk. ;[247] End of block context ifskp. ;[247] Success move t2, p2 ;[247] Pass in to SOUTR% movn t3, p1 ;[247] New length setz t4, ;[247] Just in case still NUL terminated (isn't) else. ;[247] Otherwise, failed somehow ret ;[247] So get out of here endif. ;[247] End case iaciac return handling endif. ;[247] End TVT-binary handling SOUTR% ;[186] Push it over the network. %jserr (,) ;[186] Couldn't ... aos vsoct ;[204] Count a SOUTR% done addm p1, vsotc ;[204] Update tally of SOUTR% bytes camle p1, vsomx ;[204] Length than or equal to the maximum seen? movem p1, vsomx ;[204] Nope, we have a new maximum! ifmn. duplex ;[247] Half duplex connection? movei t1, .priou ; Yes, do it ourselves. move t2, p2 ;[247] Point to final string movn t3, p1 ;[247] Counted string (faster) setz t4, ;[186] Just in case (still NUL terminated) SOUT% erjmpr .+1 ;[195] remark ;[248] Only 'echo' in session log if half duplex 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, p2 ;[247] Otherwise, point again. movn t3, p1 ;[247] Counted string (faster) setz t4, ;[186] Just in case (still NUL terminated) SOUT erjmpr .+1 ;[195] endif. ;[195] endif. ;[247] End case half-duplex ret ; Done. ;[209] End code replacement subttl TRANSMIT [file] parsing tables ;[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 , %tcasw ;[273] Case switch %key2 , %eofsw ;[229] The EOF switch parses a restricted token set %key2 , %maxsw ;[265] Maximum length %key2 , %tpasw ;[266] Pause after SOUT(R)% %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: intern tranft ;[265] Used in K20PAR 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>, maxfdb::flddb. .cmnum,,^d10,,<110>, ;;[265] trnswd: remark ;[266] Transmit switch dispatch teofsw ; %eofsw==0 ;[266] We parsed the EOF switch tsilsw ; %silsw==1 ;[266] We parsed the 'silent' switch ttimsw ; %timsw==2 ;[266] We parsed the 'timeout' switch tmaxsw ; %maxsw==3 ;[265] We parsed the 'maximum' (length) switch ttpasw ; %tpasw==4 ;[266] We parsed the 'pause' switch tcsasw ; %tcasw==5 ;[273] We parsed the 'case' switch %tlast==.-trnswd ;[273] Last switch retsec ;;[229] Back to where-ever we started from remark ;;[229] Punt temporary symbols cleans() remark ;[265] Global values, which can be overridden extern teofch ;[266] Transmit EOF character (defaults to none) extern tsilen ;[266] Whether to allow blat from parsing extern tmaxln ;[266] Maximum line we'll try to force extern timeou ;[266] If timing out the SIN(R)%/SOUT(R)% extern tpause ;[266] Amount to pause, assuming nothing extern tobser ;[273] Whether observing case extern tsetsd ;[275] Default settings source extern tdefpl ;[272] Length of default prompt, if using one extern tdefpp ;[272] Pointer to default string extern tdefps ;[272] Location of default string ;[266] Document hairy parse variable usage. Be aware that some of these are ; shared with INPUT's parsing and semantic action. remark pars1 ;[266] Linkage between parsing and semantic remark pars2 ;[266] JFN of file to transmit remark pars3 ;[266] Set if .cmcfm and using default search string remark pars4 ;[266] Integer timeout in milliseconds remark pars5 ;[273] Integer timeout, floating point seconds remark pars6 ;[266] Set to not override $INPUT's interrupt handling remark pars7 ;[266] EOF character to use (if any) remark pars8 ;[266] If doing SILENT matching remark pars9 ;[266] Maximum length of line to transmit remark pars10 ;[266] Milliseconds to pause, integer remark pars11 ;[273] Not defined as pars10 is a double remark pars12 ;[273] Whether observing case subttl TRANSMIT /silent switch parsing extern stxfdb ;[266] Defined in K20PAR ;[266] This is a little 'clever' in that if it doesn't get one of the ; keywords, it doesn't fail the parse but rather assumes that "on" ; was typed. Even though "on" is the default in the function ; descriptor, it won't be defaulted unless the user types an ; escape or a ^F. Similar games like this are played when defining ; macros tsilsw: guide () ;[266] movei t1, stxfdb ;[266] Load "on" or "off" fdb call rflde ;[266] Try to get one of them ifskp. ;[266] They picked (or defaulted) one hrrz t2, (t2) ;[266] Get the value for the keyword (0 or 1). else. ;[266] Otherwise, failed the parse seto t2, ;[266] Assume they wanted it "on" endif. ;[266] Either way, carry on movem t2, pars8 ;[266] Override SET TRANSMIT DEFAULT retskp ;[266] Done subttl Next TRANSMIT /case switch parsing chgsec(code,const) ;;FDB's go in const .psect casfdb: flddb. .cmkey,,castab,,, retsec ;;Get back into code .psect tcsasw: guide movei t1, casfdb ;[273] Almost the same as SET INPUT CASE ... call rfield ;[273] Parse a keyword or default hrrz t1, (t2) ;[273] Get the value for the keyword (0 or 1). movem t2, pars12 ;[273] Override any default retskp ;[273] Return for next switch subttl TRANSMIT /EOF switch parsing teofsw: movei t1, tranft ;[266] Look for an EOF token call rfield ;[266] Ask them to type one of them tlz t3, -1 ;[266] Isolate fdb we actually used move t2, .cmdat(t3) ;[266] Pick up the byte pointer to the character ildb t1, t2 ;[266] Load the token character (only one) cain t1, "$" ;[266] Our goofy escape synonym? movei t1, .chesc ;[266] Yes, transmogrify it call @parity ;[266] And put parity on it (if doing parity) movem t1, pars7 ;[266] Save EOF character retskp ;[266] Return for next switch subttl TRANSMIT /timeout switch parsing ttimsw: movei t1, timfdb ;[266] Look for a time out number (floating) call rfield ;[266] Ask them to type one it ifl. t2 ;[266] Is the number in the right range? emsg ;[266] Must be superluminal... jrst cmder1 ;[266] Yet allow reparse endif. ;[266] End initial sanity checking call chksec ;[266] Ensure number is in correct range ifskp. ;[266] Check and convert OK? retskp ;[266] Yes, pars4 and pars5 are set, return endif. ;[266] End case checking and conversion remark ;[266] Otherwise, couldn't swallow something emsg ;[266] jrst cmder1 ;[266] Yet allow reparse subttl TRANSMIT /maximum-length switch parsing tmaxsw: movei t1, maxfdb ;[265] Look for an integer count of characters call rfield ;[265] Ask them to type one it ife. t2 ;[265] Typed a zero? movei t2, strbl8 ;[265] Load maximum buffer can hold movem t2, pars9 ;[265] Return as an imagined parsed value retskp ;[265] Return success from parse block endif. ;[265] Make life easier... ifl. t2 ;[265] Is the number delusional? emsg ;[265] jrst cmder1 ;[265] Yet allow reparse endif. ;[265] End initial sanity checking cail t2, strbl8 ;[265] Larger than largest we can spew? ifskp. ;[265] Nope, let's use it movem t2, pars9 ;[265] Return as parsed value retskp ;[265] And break out of the parse block endif. ;[266] End case acceptable range check remark ;[265] Otherwise, grouse at him emsg ;[265] jrst cmder1 ;[265] Yet allow reparse subttl TRANSMIT /pause switch parsing ttpasw: movei t1, trapau## ;[265] Look for a pause number (floating) call rfield ;[265] Ask them to type one it ifl. t2 ;[265] Is the number in the right range? emsg ;[265] Must be imaginary.. jrst cmder1 ;[265] Yet allow reparse endif. ;[265] End initial sanity checking push p, pars4 ;[266] Save possible time out, integer push p, pars5 ;[266] Save possible time out, floating call chksec ;[265] Ensure number is in correct range ifskp. ;[265] Check and convert OK? Then side-effect variables dmove t1, pars4 ;[266] Load where chksec stored stuff dmovem t1, pars10 ;[266] Save it for semantic action pop p, pars5 ;[266] Restore possible time out, floating pop p, pars4 ;[266] Restore possible time out, integer retskp ;[265] And get out of the parse block. endif. ;[265] End case checking and conversion remark ;[265] Otherwise, couldn't swallow something emsg ;[265] jrst cmder1 ;[265] Yet allow reparse subttl TRANSMIT/CAPTURE default values set up remark pars1 ;[266] Linkage between parsing and semantic remark pars2 ;[266] JFN of file to transmit remark pars3 ;[266] Set if .cmcfm and using default search string remark pars4 ;[266] Integer timeout in milliseconds remark pars5 ;[273] Integer timeout, floating point seconds remark pars6 ;[266] Set to not override $INPUT's interrupt handling remark pars7 ;[266] EOF character to use (if any) remark pars8 ;[266] If doing SILENT matching remark pars9 ;[266] Maximum length of line to transmit remark pars10 ;[266] Milliseconds to pause, integer remark pars11 ;[273] Not defined as pars10 is a double remark pars12 ;[273] Whether observing case trcapd: ifme. tsetsd ;[275] Are parse defaults coming from SET INPUT? setzb t3, t4 ;[275] SET INPUT has no EOF or SILENT dmovem t3, pars7 ;[275] Store as if never parsed movei t1, strbl8 ;[275] SET INPUT has no Maximum line width, so movem t1, pars9 ;[275] use maximum possible and store as if parsed dmove t1, indeft ;[275] Timeout default is SET INPUT DEFAULT-TIMEOUT dmovem t1, pars4 ;[275] Store as if parsed dmovem t3, pars10 ;[275] SET INPUT has NO PAUSE move t1, incase ;[275] Case default is SET INPUT CASE movem t1, pars12 ;[275] Store as if parsed else. ;[275] No, they're coming from SET TRANSMIT dmove t1, teofch ;[266] Transmit EOF character remark t2, tsilen ;[266] Whether to allow blat from parsing dmovem t1, pars7 ;[266] Store as if parsed move t1, tmaxln ;[266] Maximum line length we'll try to force movem t1, pars9 ;[265] Store as if parsed dmove t1, timeou ;[266] Timeout, Integer Milliseconds, floating seconds dmovem t1, pars4 ;[266] Override floating, which we don't use dmove t1, tpause ;[266] Amount to pause, integer and floating dmovem t1, pars10 ;[266] Store as default parse value move t1, tobser ;[273] Whether we are observing case movem t1, pars12 ;[273] Store as default endif. ;[275] End parse default source checking ret ;[275] All done and ready to parse ... something subttl TRANSMIT command parsing chgsec(code,const) ;;Chained FDB's go in const trdfdb: remark ;[272] fdb to use when defaulting search string fld(.cmqst,cm%fnc)!cm%hpp!cm%dpp!fld(txtfd2,cm%lst) ;[272] .cmfnp Z ;[272] .cmdat cascii () ;[272] .cmhlp point 7,tdefps ;[272] .cmdef !! retsec ;;Return to code .psect ;[266] Document hairy parse variable usage. Be aware that some of these are ; shared with INPUT's parsing and semantic action. .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 call trcapd ;[275] Set up the parse/command defaults movei q5, tranfs ;[229] Doing a full complement of switches .tran0: guide .tran1: remark ;[229] Here when looping on switches move 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? ifskp. ;[266] Yes, let's handle that hrrz q3, (q2) ;[229] Pick up the switch value caig q3, %tlast ;[266] Out of range? call @trnswd(q3) ;[266] No, so call the switch's parser 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. ;[266] End switch secondary parsing 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 ; No, 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 move q4, pars12 ;[273] Load whether observing case skiple t1, tdefpl ;[272] Load length of default prompt ifskp. ;[272] Not using one call .inpu1 ;[272] So go get something (or nothing) else. ;[272] Otherwise, set up to use default if wanted guide ;[272] Guide us to type the next thing setzb t1, t2 ;[272] Cons up some NUL dmovem t1, atmbuf ;[272] Give the atom buffer a good scrub a dub movei t1, trdfdb ;[272] Parse using our nifty default, if wanted call rfield ;[272] Get an input string ldb q1, [pointr (.cmfnp(t3),cm%fnc)] ;[272] Get the function code call .inpu2 ;[272] Hook in a little later in the parse chain endif. ;[272] End case default prompt determination 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 remark confirm ;[272] .inpu1/2 does this for us 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 .endps code ;[263] Get out of code .psect subttl File I/O for Transmit, quasi-hidden data area .psect edata,edaorg ;[263] Extended data remark Used for moby map of the file remark ;[263] Do not reorder any of these! Append only! fjfn: block 1 ;[263] File JFN f1st:! remark ;[263] First location to whack fsizef: block 2 ;[265] Results of SIZEF%, possibly tweaked fsizeb: block 1 ;[263] File size in bytes (remaining bytes this section) fsizep: block 1 ;[263] File size in pages (remaining pages this section) fbytes: block 1 ;[263] File byte size fbytew: block 1 ;[263] Bytes per word fsizec: block 1 ;[263] Bytes done so far fsmapw: block 1 ;[263] SMAP% window fpmapw: block 1 ;[263] PMAP% window fbytep: block 2 ;[263] Mapped file byte pointer (global) fmsecf: block 1 ;[263] Set if we have another section to do frpage: block 1 ;[263] Remaining pages, if multi-section file fpagfb: block 1 ;[265] Final page fragment, in characters eacs: block 4 ;[263] Accumulators, when squawking flasta:! remark ;[263] Last address to whack fwhack==flasta-f1st-1 ;[263] Calculate amount to whack .endps edata ;[263] End of extended data ;[263] Write-protected code, phew! define eemsg (t,%t,%et) < move t1, %t ;;Load Tops-20 pointer to string ESOUT% ;;Blat at the user chgsec(ecode,econst) ;;Open the extended constants .psect %t: .px7!%et ;;Point to text in extended section retsec ;;Close out section extended constants .psect chgsec(ecode,etext) ;;Open the extend text .psect %et: asciz \'t\ ;;Emit the text of the message with no CRLF retsec ;;Back to regular extended code cleans(<%t,%et>) ;;Clean up generated symbols >;;End of emsg subttl File I/O for Transmit, maps the file in ;Call: ; ; t1/ JFN ; ; Return: ; ; Results of SIZEF% .psect ecode/RONLY,ecdorg emapfi: tlz t1, -1 ;[263] Stomp the flags movem t1, fjfn ;[263] Save the file JFN ;[265] N.B., f1st is *AFTER* fjfn!!! movx t2,fwhack ;[263] Load count of items to whack xmovei t3, f1st ;[263] First location to stomp xmovei t4, ^o1(t3) ;[263] Cascading zeros setzm (t3) ;[263] Stomp the first location xblt. t2 ;[263] Stomp the rest of them ;[265] Nice source of infinite NUL's and EOF's? cain t1, .nulio ;[209] Don't need to open .nulio jrst emapr2 ;[263] Return success (NUL: always works) SIZEF% ;[229] Find out how large the file is ifje. r ;[229] Failed?? move t4, t1 ;[229] Save error for debuggers eemsg ;[263] Squawk jsp q5, esquawk ;[263] Include the last Tops-20 error jrst emapr1 ;[263] Fail the call else. ;[229] Otherwise, worked!!!! dmovem t2, fsizeb ;[229] So store results in file size double word dmovem t2, fsizef ;[265] Also as original to return to caller endif. ;[229] End case SIZEF% JSYS results 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 eemsg ;[263] Squawk jsp q5, esquawk ;[263] Include the last Tops-20 error movei t3, ^d7 ;[229] Ignore it and pretend ASCII movem t3, fbytes ;[263] Imagine the file byte size ... move t1, fjfn ;[229] Reload JFN for OPENF% attempt else. ;[229] Otherwise, worked ldb t3,[ pointr(t4,fb%bsz) ] ;[229] Extract byte size from packed field movem t3, fbytes ;[263] Store the file byte size ... endif. ;[229] End case GTFDB% JSYS handling ;[265] Use byte size to determine OPENF% mode 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 eemsg ;[263] Squawk and continue jsp q5, esquawk ;[263] Include the last Tops-20 error jrst emapr1 ;[263] Give failure return endif. ;[263] End OPENF% error handling remark ;[265] Determine bytes per word movx t2, ^d5 ;[263] Let's assume ASCII and five characters per word cain t3, ^d8 ;[263] Not eight bit, is it? movx t2, ^d4 ;[263] Only four characters per word movem t2, fbytew ;[263] Store bytes per word remark ;[265] Determine if we have to fix up Tops-10 output ifg. t3 ;[263] If we have a positive byte size caie t1, ^d36 ;[263] PA1050 output? anskp. ;[263] No, we're done move t2, fsizeb ;[263] Load the file byte count imuli t2, ^d5 ;[263] Five seven bit bytes per word movem t2, fsizeb ;[263] Update the byte count movem t2, fsizef ;[265] Also also original endif. ;[263] End case PA1050 fixup remark ;[265] Calculate internal fragmentation of final page dmove t1, fsizef ;[265] Load original byte count and pages ash t2, ^d9 ;[265] Turn page count into word count imul t2, fbytew ;[265] By bytes per word, gets total bytes sub t2, t1 ;[265] Remainder is internal fragmentation in bytes movem t2, fpagfb ;[265] Save remaining avaiable bytes remark ;[265] Construct the appropriate 30 bit byte pointer dmove t1, [ 1b12 ;[263] Flag a two word global byte pointer smporg ] ;[263] Load address of mapped file section caie t3, ^d8 ;[263] Is this an eight bit file? ifskp. ;[263] Yes, so that might be fine, maybe ... iorx t1, ;[263] Change into an eight bit pointer else. ;[263] All else is ASCII iorx t1, ;[263] Handy (but arcane) macsym generated symbol endif. ;[263] dmovem t1, fbytep ;[263] Set the mapped file one word global pointer remark ;[265] Sanity check file size skipg t1, fsizep ;[263] Does the file have any pages? jrst emapr2 ;[263] No, so don't map anything cail t1, ^d512 ;[263] Less than a section? jrst smp1st ;[263] No, map the file's first section setz t1, ;[263] A zero means creating a section dmove t2, [ ;[263] Doing a moby map! .fhslf,,smpsec ;[263] This process, SMAP section sm%rd!^d1 ] ;[263] Read-Only, a single section SMAP% ;[263] Case III: Creating a section ifje. r ;[263] Failed?? move t4, t1 ;[263] Save error code for debugging eemsg ;[263] Squawk jsp q5, esquawk ;[263] Include the last Tops-20 error jrst emapr1 ;[263] Take plus 1 return else. ;[263] Otherwise, worked movem t1, fsmapw ;[263] Set the SMAP% window endif. ;[263] End case SMAP% handling remark ;[263] Next, map the entire file hrlz t1, fjfn ;[263] Mapping from file page zero movem t1, fpmapw ;[263] Set the PMAP% file window movx t2,smporg ;[263] Load smap origin address lsh t2,-^d9 ;[263] Turn into a page number hrli t2,.fhslf!fh%epn ;[263] Flag extended page number move t3, fsizep ;[263] Load the page count caie t3, ^d1 ;[263] A single page? txo t3, pm%cnt ;[263] Flag that a count exists txo t3, pm%rd!pm%epn ;[263] Extended page number, write protected PMAP% ;[263] Map the file, but don't preload ifje. r ;[263] Failed, get rid of everything and leave move t4, t1 ;[263] Save error code for debugging eemsg ;[263] Squawk jsp q5, esquawk ;[263] Include the last Tops-20 error seto t1, ;[263] -1 to release storage dmove t2, [ ;[263] Doing a moby unmap! .fhslf,,smpsec ;[263] This process, SMAP section 0,,^d1 ] ;[263] No access, a single section SMAP% ;[263] Case IV: Deleting Process Sections erjmpr .+1 ;[263] Catch and ignore error jrst emapr1 ;[263] Take plus 1 return endif. ;[263] End case PMAP% error handling remark ;[263] Finally, guard the rest of the section move t2, fsizep ;[263] Load file size in pages as first page to do movei t4, ^d512 ;[263] Load maximum pages per section sub t4, t2 ;[263] Calculate remaining pages to guard jumple t4, emapr2 ;[263] Leave if nothing left in section to guard move t1, @[0,,grdmap] ;[263] Pre-calculated process mapping window addx t2,smppag ;[263] Load starting page number hll t2,t1 ;[263] It's going into this self-same process movx t3,pm%rd!pm%epn ;[263] No actual access, extended page do. ;[263] Now protect ourself from ourself PMAP% ;[263] Map the Explode-on-Use page erjmpr endlp. ;[263] Get out of here on an error addi t2, ^d1 ;[263] Next page in memory sojg t4, top. ;[263] Do the rest of them enddo. ;[263] Falls out when done emapr2: dmove t2, fsizef ;[263] Return SIZEF% results hrrz q2, p ;[263] Load in-section address of stack aos @q2 ;[263] Bump that return address emapr1: remark ;[263] Here to return to section zero caller xsfm q3 ;[263] Get and store the flags movei q4, mapret ;[263] Load up inter-section transfer address xjrstf q3 ;[263] Take a GIANT step downstairs subttl Here to (s)map the first section of a multi-section file ; Context: ; ; T1/ Pages in file ; T3/ File byte size smp1st: remark ;[265] Hlrz is fastest multiply by 512*512 on the PDP-10! hrlz t2, fbytew ;[263] Now calculate characters in the entire section exch t2, fsizeb ;[263] Exchange with larger figure sub t2, fsizeb ;[263] Calculate remaining bytes, assuming entire pages remark ;[265] Which we won't use movx t4, ^d512 ;[263] Pages per section exch t4, fsizep ;[263] Swap with larger figure sub t4, fsizep ;[263] Calculate remaining pages ifg. t4 ;[263] Will there be any? setom fmsecf ;[263] Yes, set multi-section flag movem t4, frpage ;[263] Store remaining pages else. ;[265] Otherwise this is the only section setzm fmsecf ;[263] So clear multi-section flag setzm frpage ;[263] Clamp remaining pages to zero endif. ;[263] remark ;[263] Case I: Mapping File Sections to a process hrlz t1, fjfn ;[263] Load the file JFN, first section dmove t2, [ .fhslf,,smpsec ;[263] This process, SMAP%'ing section sm%rd!^d1 ] ;[263] Write protected, a single section SMAP% ;[263] Take a giant gulp of the file ifje. r ;[263] That's not good... move t4, t1 ;[263] Save error code for debugging eemsg ;[263] Squawk jsp q5, esquawk ;[263] Include the last Tops-20 error jrst emapr1 ;[263] Return failure endif. ;[263] End case SMAP% error handling movem t1, fsmapw ;[263] Set the SMAP% file window movem t1, fpmapw ;[263] Set the PMAP% file window jrst emapr2 ;[263] Return good subttl Here to (s)map the next section of a multi-section file ; Linkage here is accumulator based because section 1 has no stack ; ; Calling environment: ; ; t1,t2,t3,t4/ Available and do not need to be preserved ; q1,q2/ Ditto ; q3/ Destination pointer ; q4/ Remaining space in destination ; q5/ Return address ; ; Returns with everything magically ready to go or drops dead smpnxt: skipn fmsecf ;[263] Multi-section flag set? jrst (q5) ;[263] Nope, impossible there is anything to do move t1, fbytep+1 ;[263] Load address portion of the byte pointer move t4, t1 ;[263] Save a copy for later trc t1, 777000 ;[263] Flip the page number bits trce t1, 777000 ;[263] Flip them again and skip if all zero jrst (q5) ;[263] Something set, so not into the last page trz t1, 777000 ;[263] Put us back into page zero movem t1, fbytep+1 ;[263] Store address portion of the byte pointer move t1, t4 ;[263] Restore the address portion of global byte pointer lsh t1, -^d9 ;[263] Convert address to a page number hrli t1, .fhslf!fh%epn ;[263] This process, extended page number RMAP% ;[263] Get the file page that is in there ifje. r ;[263] Failed?? move t4, t1 ;[263] Save error code for debugging eemsg ;[263] Squawk jsp q5, esquawk ;[263] Include the last Tops-20 error jrst emapr1 ;[263] Take plus 1 return endif. ;[263] came t1, [-1] ;[263] Doesn't exist?? ifskp. ;[263] No, that can't be right eemsg ;[263] Squawk jrst emapr1 ;[263] Take plus 1 return endif. ;[263] Should exist ifxe. t2, rm%pex ;[263] Does the page exist? eemsg ;[263] Squawk jrst emapr1 ;[263] Take plus 1 return endif. ;[263] And have had the existence bit turned on came t1, @[0,,grdmap] ;[263] Is this the guard page?? ifskp. ;[263] It is, we can't read from that eemsg ;[263] Squawk jrst emapr1 ;[263] Take plus 1 return endif. ;[263] Should have been a file page movem t1, fpmapw ;[263] Use as the base PMAP% file window ifmn. fsmapw ;[263] Was the last file map a section map? seto t1, ;[263] -1 to release storage dmove t2, [ ;[263] Doing a moby unmap! .fhslf,,smpsec ;[263] This process, SMAP section 0,,^d1 ] ;[263] No access, a single section SMAP% ;[263] Case IV: Deleting Process Sections ifje. r ;[263] Failed?? move t4, t1 ;[263] Save error code for debugging eemsg ;[263] Squawk jsp q5, esquawk ;[263] Include the last Tops-20 error jrst emapr1 ;[263] Take plus 1 return endif. ;[263] End case section removal error handling setz t1, ;[263] Zero to create a private section txo t3, sm%rd ;[263] Read-only access (which is ignored when private) SMAP% ;[263] Case III: Creating a section ifje. r ;[263] Failed?? move t4, t1 ;[263] Save error code for debugging eemsg jsp q5, esquawk ;[263] Include the last Tops-20 error jrst emapr1 ;[263] Take plus 1 return endif. ;[263] End case private section creation error handling setzm fsmapw ;[263] Can no longer do file section mapping move t1, fpmapw ;[263] Have to map the page back in from the file hllz t2, t4 ;[263] Load the section as base page address lsh t2, -^d9 ;[263] Convert address to a page number hrli t2,.fhslf!fh%epn ;[263] This process, extended page number movx t3, pm%rd!pm%epn ;[263] Read-only, extended page number PMAP% ;[263] Case I: Mapping File Pages to a Process ifje. r ;[263] Failed?? move t4, t1 ;[263] Save error code for debugging eemsg jsp q5, esquawk ;[263] Include the last Tops-20 error jrst emapr1 ;[263] Take plus 1 return endif. ;[263] End case private section creation error handling else. ;[263] Otherwise, this is a private section move t1, t4 ;[263] So the last page is now the first lsh t1, -^d9 ;[263] Convert address to a page number hrli t1,.fhslf!fh%epn ;[263] This process, extended page number move t2, t1 ;[263] Prototype the destination trz t2, 777 ;[263] It's going into page zero of the same section movx t3, pm%rd!pm%epn ;[263] Read-only, extended page number PMAP% ;[263] Case III Mapping One Fork's Pages to Another Fork ifje. r ;[263] Failed?? move t4, t1 ;[263] Save error code for debugging eemsg jsp q5, esquawk ;[263] Include the last Tops-20 error jrst emapr1 ;[263] Take plus 1 return endif. ;[263] End case private section creation error handling seto t1, ;[263] -1 to unmap pages addi t2, ^d1 ;[263] Starting from next page after this (last) one txz t3, pm%rd ;[263] Shut off any access txo t3, pm%cnt ;[263] Turn on the repetition count flag hrri t3, ^d511 ;[263] Punting the rest of the pages from the section PMAP% ;[263] Case IV Unmapping Pages In a Process ifje. r ;[263] Failed?? move t4, t1 ;[263] Save error code for debugging eemsg jsp q5, esquawk ;[263] Include the last Tops-20 error jrst emapr1 ;[263] Take plus 1 return endif. ;[263] End case private section creation error handling endif. ;[263] End case diddling the page map Comment " At this point, we have the last page in the section now mapped as the current first page in the section and the address portion of the two word global byte pointer has been reset to the bottom of the page. The section mapping window (fsmapw) has been reset to be forever private because we can not no longer map from a section boundary. The page mapping window (fpmapw has been set to have the correct page in the file. We must then map as much of the file as will fit in the remaining 511 pages of the section, and set up any guard pages if we are in the last section of the file. All that remains after that is to update the counters to see if we will need to map in another section. " move t1, fpmapw ;[263] Load the base PMAP% file window addi t1, ^d1 ;[263] Getting the next file page addi t2, ^d1 ;[265] And putting it in the next memory page move t3, frpage ;[263] Load remaining pages caile t3, ^d511 ;[263] Will the rest of them fit? movei t3, ^d511 ;[263] No, clip down to the maximum that will fit subm t3, frpage ;[263] Account for them ifmle. frpage ;[263] Anything left? setzm fmsecf ;[263] No, clear the multi-section flag else. ;[263] Wow, what a whopper of a file! setom fmsecf ;[263] Yes, set the multi-section flag endif. ;[263] Because will need another section move q1, t3 ;[263] Save the total to map caie t3, ^d1 ;[263] Only have one dinky page to do? txo t3, pm%cnt ;[263] No, light the counter bit (makes PMAP% slower...) txo t3, pm%rd!pm%epn ;[263] Read-only, extended page number PMAP% ;[263] Take a giant gulp of the file ifje. r ;[263] That's not good... move t4, t1 ;[263] Save error code for debugging eemsg ;[263] Squawk jsp q5, esquawk ;[263] Include the last Tops-20 error jrst emapr1 ;[263] Return failure endif. ;[263] End case SMAP% error handling movei t4, ^d512 ;[263] Maximum pages in a section sub t4, q1 ;[263] Subtract what we mapped in subi t4, ^d1 ;[263] Account for the previously mapped page ifg. t4 ;[263] Anything to guard? movei t1, ^d512 ;[263] Maximum pages in a section, again sub t1, t4 ;[263] Gets the starting page number trz t2, 777 ;[263] Stomp whatever page number is in there or t2, t1 ;[263] Starting at the end of the mapped pages move t1, @[0,,grdmap] ;[263] Load the handle for the guard page hll t2,t1 ;[263] It's going into this self-same process movx t3,pm%rd!pm%epn ;[263] No actual access, extended page do. ;[263] Get down to some serious guarding PMAP% ;[263] Map the Explode-on-Use page erjmpr endlp. ;[263] Get out of here on an error addi t2, ^d1 ;[263] Next page in memory sojg t4, top. ;[263] Do the rest of them enddo. ;[263] Falls out when done or on (silent) error move t4, q1 ;[263] Load count just mapped from file addi t4, ^d1 ;[263] Accounting for our current page else. ;[263] Otherwise not guarding anything move t4, ^d512 ;[263] And have a straight section to do endif. ;[263] End case guarding the remainder of the section movem t4, fsizep ;[263] Update this section's page tally remark Finally update the byte count caie t4, ^d1 ;[265] Are we on the last page? ifskp. ;[265] It was, so can handle what specially setzm fpagfb ;[265] No fragmentation, it's the last page jrst (q5) ;[265] Return with the last few bytes endif. ;[265] End case partial last page is the last page ;[265] Must calculate what we have done, first page move q1, fbytew ;[263] Load bytes per word ash q1, ^d9 ;[265] Fastest multiply by 512 on PDP-10! sub q1, fsizeb ;[265] Subtract off what we have left to swallow remark q1, ;[265] q1 now has what has been consumed in this page ifme. fmsecf ;[265] If last section, will not have a full last page move q2, fpagfb ;[265] Will need to subtract internal fragmentation else. ;[265] Otherwise, doing another section setz q2, ;[265] So will not have a partial last page endif. ;[265] End case multiple section decision remark t4, ^d512 ;[263] 512 words per page ash t4, ^d9 ;[265] Fastest multiply by 512 on PDP-10! imul t4, fbytew ;[263] Multiplied by bytes per word remark t4, ;[265] t4 now has maximum we could consume sub t4, q1 ;[265] Subtract off the front sub t4, q2 ;[265] Subtract off the end (if any) remark t4, ;[265] Now has remaining bytes to consume movem t4, fsizeb ;[265] Store remaining bytes to do, this section jrst (q5) ;[263] Return with another magilla to do subttl Extended Squawk has odd linkage ; t4/ Captured Tops-20 error ; q5/ Accumulator that the calling jsp used esquaw: dmovem t1, eacs ;[263] Save accumulators dmovem t3, eacs+2 ;[263] all four of them movei t1, "," ;[263] A little punctuation PBOUT% movei t1, .chspc ;[263] And space over PBOUT% movei t1, .priou ;[263] Still typing to terminal hrlzi t2, .fhslf ;[263] This process hrr t2, t4 ;[263] This (captured) error setz t3, ;[263] All the error text there is ERSTR% ;[263] Blat away! erjmpr .+2 ;[263] Ignore this strange error erjmpr .+1 ;[263] Ignore this stranger error movei t1, .chcrt ;[263] Tie off PBOUT% movei t1, .chlfd ;[263] the line PBOUT% dmove t1, eacs ;[263] Restore accumulators dmove t3, eacs+2 ;[263] all four of them jrst (q5) ;[263] Return to caller .endps ecode ;[263] Get out of extended code subttl Wrapper to call section mapper in extended code ; Expects T1 to have something very much like a JFN .psect code ;[263] In section zero code emap30: extsec,,emapfi ;[263] 30 bit address of extended code mapsec: saveac ;[263] Save plenty registers xsfm q3 ;[263] Get and store the flags move q4, emap30 ;[263] Load up inter-section transfer address xjrstf q3 ;[263] Take a GIANT step upstairs mapret: remark ;[263] Return linkage from extended code ret ;[263] Return +1 or +2 .endps code ;[263] End of section zero code subttl TRANSMIT translation table for file .psect econst/RONLY,ecnorg ;[263] Put this in extended section %lfdc==.chcnb ;[263] ASCII values proceed from Control-B .xcref %lfdc ;[263] Keep off the cross reference suppress %lfdc ;[263] Don't show in symbol table listing lfdtbl: xlist ;[263] Don't need to see all this xwd eoscod!.chnul,.chcna ;[263] NUL is considered end of file repeat ^d4,< ;[263] Do ^B through ^I xwd %lfdc,%lfdc+1 ;[263] Each gets its own halfword %lfdc==%lfdc+2 ;[263] Step to next pair .xcref %lfdc ;[263] And stay off the cross reference!!! >;repeat ^d4 ;[263] Deposit these 8 characters xwd eoscod!.chlfd,.chvtb ;[263] Linefeed is considered end of read xwd .chffd,eoscod!.chcrt ;[263] Carriage Return is considered end of read %lfdc==%lfdc+2+2 ;[263] Account for this pair repeat ^d<64-1-4-1-1>,< ;[263] Do ^L through DEL xwd %lfdc,%lfdc+1 ;[263] Each gets its own halfword %lfdc==%lfdc+2 ;[263] Step to next pair .xcref %lfdc ;[263] And stay off the cross reference!!! >;repeat ^d57 (pairs) ;[263] Deposit these remaining 114 characters list ;[263] Turn the listing back on cleans(%lfdc) ;[263] Toss temporary symbol .endps econst ;[263] End of extend constants subttl Translate Extended SIN% terminating on Line Feed .psect ecode ;[263] Write-protected code, phew! ; Calling environment, something like SIN% ; ;** t1/ JFN (Ignored) ; t2/ Had better be a one word global pointer!! ; t3/ Size of said buffer ;** t4/ Character to stop on (Ignored) remark t2 & t3 ;[263] Are expected to have been checked remark q1,q2,q3,q4,q5 ;[263] Are available esinmt: movst lfdtbl ;[263] Move String Translated, using above table .chnul ;[263] Fill character is NUL terminator esinlf: dmove q3, t2 ;[263] Save original pointer and remaining space jsp q5, smpnxt ;[263] See if we need to get the next section of the file skiple t1, fsizeb ;[263] Load remaining bytes in file ifskp. ;[263] Emptied the file... remark ;[265] Don't need a SFPTR% -1,last SFPTR% already set EOF move q5, t2 ;[265] Save the pointer dmove t1, [ ;[263] Phoney up a Tops-20 error exp .fhslf, IOX4] ;[263] This process, "End of file reached" SETER% ;[263] Pretend we got a SIN% error, with a nice message ifje. r ;[265] Failed?? move t2, t1 ;[263] Some other strange problem, so go with that endif. ;[265] End really unlikely error move t1, t2 ;[263] Put the error as if we did an ERJMPR/ERCALR move t2, q5 ;[265] Restore the pointer jrst esinr1 ;[263] Take the error return endif. ;[263] End case 'JSYS' error handling dmove t2, fbytep ;[263] Load double word source global pointer move t4, q4 ;[263] Load maximum size of destination buffer move q1, q3 ;[263] Destination of data setz q2, ;[263] Assume destination is a one word global pointer txz t1, N!M ;[263] Shut off Number and Magnitude txo t1, S ;[263] Start translating immediately extend t1, esinmt ;[263] Go slurp the data around erjmpr esinre ;[263] Failed?? move q5, t1 ;[263] Load the final count txz q5, S!N!M ;[263] Shut off Significance, Number and Magnitude movem q5, fsizeb ;[263] Update remaining bytes in file dmovem t2, fbytep ;[263] Update input byte pointer ldb q5, t2 ;[263] Pick up the stop byte ifg. t4 ;[263] Do we have space for another byte? subi t4, ^d1 ;[263] Yes, account for it idpb q5, q1 ;[263] Store it endif. ;[263] Save that caie q5, .chcrt ;[265] Did we stop on a carriage return? ifskp. ;[265] We did, see if followed by a line feed andg. t4 ;[265] Any more output space? txz t1, S!N!M ;[263] Shut off Significance, Number and Magnitude andg. t1 ;[265] Any more input data? ildb q5, t2 ;[265] Yes, pick up the byte after the carriage return caie q5, .chlfd ;[265] Was it a line feed? anskp. ;[265] No, nothing further to do idpb q5, q1 ;[263] Store it subi t4, ^d1 ;[263] Account for another character output subi t1, ^d1 ;[265] Account for another character input movem t1, fsizeb ;[263] Update remaining bytes in file dmovem t2, fbytep ;[263] Update input byte pointer endif. ;[265] End case checking for CRLF sequence ifg. t4 ;[263] Do we have space for another byte? setz t1, ;[263] Yes, cons up a zero, but don't count it idpb t1, q1 ;[263] Store it, pointer will be discarded endif. ;[263] So this will allow an append move t3, t4 ;[263] Return remaining space in buffer sub q4, t4 ;[263] Calculate bytes done move t2, q4 ;[263] Load the count done addb t2, fsizec ;[263] Update the character tally move t1, fjfn ;[263] Load the file's JFN SFPTR% ;[263] Inform Tops-20 of the location for the nosey erjmpr esinr1 ;[263] Some odd error, return it move t2, q4 ;[263] Load count done adjbp t2, q3 ;[263] Advance the one word global pointer move t4, q5 ;[263] Return the character esinr2: hrrz q2, p ;[263] Load in-section address of stack aos @q2 ;[263] Bump that return address esinr1: remark ;[263] Here to return to section zero caller xsfm q3 ;[263] Get and store the flags movei q4, sinret ;[263] Load up inter-section transfer address xjrstf q3 ;[263] Take a GIANT step downstairs esinre: eemsg ;[263] Squawk jsp q5,esquawk ;[263] And also the last Tops-20 error jrst esinr1 ;[263] Give +1 return .endps ecode ;[263] Done with extended code .psect code ;[263] Return to section zero code subttl Translate SIN% terminating on Line Feed (Wrapper) ; SIN% terminating on linefeed. Similar to a SIN%, except that it ; does not produce End of File I/O errors. Other errors are possible, ; such as mapping a file with a bad page or bumping into a guard page, ; but these situations are not expected to be very likely. ; ; Actually does very little other than setting up linkages for an ; extended call. ; ; Arguments are as per SIN%, ; ; t1/ JFN (ignored, except for .NULIO special casing) ; t2/ Pointer to where to put the data ; t3/ Positive maximum size of area ; t4/ Character to stop on (ignored) ; ; Return: ; ; +1, If failed for some reason ; +2, Got some data ; ; t1/ Trashed ; t2/ Updated to point to last character ; t3/ Updated with characters read ; t4/ Last character read ; ; If there is space in the buffer, then a NUL will be put after the ; data, but will not be counted. This will allow a PSOUT% to a terminal ; and ease $0T when DDT'ing. esin30: extsec,,esinlf ;[263] Transfer Extended SIN% Line Feed 30 Bit Address sinlfd: caie t1, .nulio ;[263] Reading from NUL:?? ifskp. ;[263] Yes, we couldn't have mapped that! push p, t2 ;[265] Save the pointer dmove t1, [ ;[263] Phoney up a Tops-20 error .fhslf ;[263] This process IOX4 ] ;[263] "End of file reached" SETER% ;[263] NUL: is always at end of file ... ifje. r ;[265] Some other problem? Go with that pop p, t2 ;[265] Restore the pointer else. ;[265] Otherwise, worked move t1, t2 ;[263] Load the last error as if we triggered it pop p, t2 ;[265] Restore the pointer endif. ;[263] End case SETER% handling seto t4, ;[263] Indicate end of file here, too ret ;[263] Return +1 (failed) endif. ;[265] End case NUL: read move t1, t2 ;[263] Let's load the pointer idpb t4, t1 ;[263] Can we write it? erjmpr r ;[263] No, go pass the error back remark ;[263] Unlike SIN%, byte count must always be positive ifle. t3 ;[263] Some bogus count? dmove t1, [ ;[263] Phoney up a Tops-20 error .fhslf ;[263] This process GJFX51 ] ;[263] "Byte count too small" SETER% ;[263] Not quite a SIN% error, but nice message ifje. r ;[265] Some other problem? Go with that pop p, t2 ;[265] Restore the pointer else. ;[265] Otherwise, worked move t1, t2 ;[263] Put the error as if we did an ERJMPR/ERCALR pop p, t2 ;[265] Restore the pointer endif. ;[263] End case SETER% handling ret ;[263] Return +1 (failed) endif. ;[263] End case sanity check of bffer length saveac ;[263] Otherwise, save plenty registers xsfm q3 ;[263] Get and store the flags move q4, esin30 ;[263] Load up inter-section transfer address xjrstf q3 ;[263] Take a GIANT step upstairs sinret: remark ;[263] Here on return from extended section ret ;[263] Done subttl TRANSMIT command execution. ;[266] Document hairy parse variable usage. Be aware that some of these are ; shared with INPUT's parsing and semantic action. remark pars1 ;[266] Linkage between parsing and semantic remark pars2 ;[266] JFN of file to transmit remark pars3 ;[266] Set if .cmcfm and using default search string remark pars4 ;[266] Integer timeout in milliseconds remark pars5 ;[273] Whether observing case in matching remark pars6 ;[266] Set to not override $INPUT's interrupt handling remark pars7 ;[266] EOF character to use (if any) remark pars8 ;[266] If doing SILENT matching remark pars9 ;[266] Maximum length of line to transmit remark pars10 ;[266] Milliseconds to pause, if TRANSMIT is pausing $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 call mapsec ;[263] Map the file into a seperate section ifskp. ;[263] Worked! dmovem t2, zsizeb ;[263] Store SIZEF% results in section zero else. ;[263] Didn't... setzm filjfn ;[263] Stomp JFN global storage hrrz t1, pars2 ;[263] Reload the JFN call frclos ;[263] Force it closed nop ;[263] Ignore error and carry on ret ;[263] And return; we can't do anything else endif. ;[263] End handling failure return from mapsec 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 course, 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 call statim ;[267] Start timing ;... ; 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 move t2, [.p08!strbf2] ;[263] Where to put the line move t3, pars9 ;[265] Load maximum we will allow movx t4, .chlfd ;[209] But, preferably terminate on linefeed. call sinlfd ;[263] Go fetch a line of the file's text ifskp. ;[263] Worked, do something clever ifg. t3 ;[209] Did we hit the linefeed? move q4, pars9 ;[263] Yes, so need to do post calculations sub q4, t3 ;[209] Calculate amount done else. ;[209] Otherwise, don't need to do any math move q4, pars9 ;[263] Put in maximum length endif. ;[209] else. ;[263] Failed somehow hrrz t2,t1 ; Erase fork handle from left half. caie t2, iox4 ; Was error EOF? %ermsg (,$tranx) ; No, give message. call endtim ;[267] Finished timing call tranot ;[229] Notify us of transmit completion jrst $tranx ; But either way, we are done endif. ;[194] ; 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 ifmn. tvtflg ;[247] On a TVT? block. ;[247] Yes, let's see if we need any quoting saveac ;[247] Save output designator, want an accumulator move q3, [point 8, tvtbuf] ;[247] Special buffer for IAC doubling move t1, q4 ;[247] Positive length move t3, q3 ;[247] Load output area call iaciac ;[247] Go double any IAC's %ermsg (,r) ;;[247] move q4, t4 ;[247] Store updated length move t2, q3 ;[247] New output buffer endbk. ;[247] End of block context ifskp. ;[247] Success movn t3, q4 ;[247] New length setz t4, ;[247] Just in case still NUL terminated (isn't) else. ;[247] Otherwise, failed somehow %ermsg (,r) endif. ;[247] End case iaciac return handling endif. ;[247] End TVT-binary handling ;[265] N.B., there is a maximum size line beyond which you get an IOX33 ; For PTY's, it appears to be about 120 characters. 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) 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. ;[186] ;[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: ifmn. strc ;[266] But!! Are we doing any recognition, anyway? 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 endif. ;[266] End case looking for remote response skiple t1, pars10 ;[266] Pausing after the send? DISMS% ;[266] We are, so wait whatever 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 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. call unarpa ;[229] And shut off TVT binary 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 seto t1, ;[263] -1 to release storage dmove t2, [ ;[263] Doing a moby unmap! .fhslf,,smpsec ;[263] This process, SMAP section 0,,^d1 ] ;[263] No access, a single section SMAP% ;[263] Case IV: Deleting Process Sections ifje. r ;[263] Failed?? move t4, t1 ;[263] Save error code for debugging %ermsg (,) ;[263] Squawk and continue endif. ;[263] End case SMAP% JSYS error handling hrrz t1, filjfn ;[263] Load the JFN again call frclos ;[263] Force the JFN to close nop ;[263] 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: call elptim ;[267] Compute elapsed time 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, zsizeb ;[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 movei t1, .priou ;[267] Carry on the terminal move t3, t2 ;[267] Wants total it in t3 call gmkcps ;[267] Show rate nop ;[267] Ignore +1 else. ;[229] Otherwise, nothing there hrrz 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 ;[266] Document hairy parse variable usage. Be aware that some of these are ; shared with INPUT's parsing and semantic action. remark pars1 ;[266] Linkage between parsing and semantic remark pars2 ;[266] JFN of file to transmit remark pars3 ;[266] Set if .cmcfm and using default search string remark pars4 ;[266] Integer timeout in milliseconds remark pars5 ;[273] Integer timeout, floating point seconds remark pars6 ;[266] Set to not override $INPUT's interrupt handling remark pars7 ;[266] EOF character to use (if any) remark pars8 ;[266] If doing SILENT matching remark pars9 ;[266] Maximum length of line to transmit remark pars10 ;[266] Milliseconds to pause, integer remark pars11 ;[273] Not defined as pars10 is a double remark pars12 ;[273] Whether observing case .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 call trcapd ;[275] Set up the parse/command defaults 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 skipg t1, filjfn ;[266] Load and check the file JFN ifskp. ; Something, there, maybe use it cain t1, .nulio ; But!! Only going to toss the data? anskp. ;[266] Yes, no need to engage in this foolishness andg. p4 ; Also don't bother if 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 remark t2, 177 ;[266] Do NOT stomp the checked parity! 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 aos ttipar ; Count a detected parity error ifme. paract ;[266] Is the parity action to abort? emsg ret ; And give an error return endif. ;[266] Otherwise, substitute and carry on move t2, parsub ;[266] Load Parity substitution character andi t2, 177 ;[266] Strip off parity; it's converted idpb t2, p3 ;[266] Append substituted character addi p4, ^d1 ;[266] we're going to use and count it 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 remark ttipar ;;chkpar counts detected parity errors 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: intern chrtup ;[273] 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 %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 is ; commonly called with a 7 bit pointer, it will accept 8 bit pointers ; PROVIDED that the parity bit has been removed. It will FAIL if it ; detects 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 ;[248] 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 setz p3, ;[248] Count of characters munched 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 may not have exhausted source txz t1, S!N!M ; Clear all the flags move q4, t2 ; Keep stopping source pointer jumpe t1, endlp. ;[248] If source is exhausted, we're done 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 jumple t1, endlp. ;[248] Done if no more source jumple t4, endlp. ;[248] Done if no more destination addi p3, ^d1 ;[248] Account for a backslash skipped 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, p3 ;[248] ; Calculate what we finally produced move t4, t1 ;[248] ; Save final source count: move t1, q1 ;[248] ; Restore updated destination BEFORE terminating it idpb q2, q1 ;[248] ; Tie off destination ; Stopped before the end of the string? ifg. t4 ;[248] ; 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",.chdel) ;;[246] Obliterate escsub("P",,"Q",.chdbq) escsub("R",.chcrt,"S",) escsub("T",.chtab,"U",.chnul) ;;[246] NUL 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",.chdel) ;;[246] Obliterate escsub("p",,"q",.chdbq) escsub("r",.chcrt,"s",) escsub("t",.chtab,"u",.chnul) ;;[246] NUL 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) ; p3/ Count of characters skipped in source (like backslash and octal digits) ;[248] ; ; Return: ; ; +1/ Failed somehow ; +2/ Escape character substituted or expanded ; ; t1 through q2 updates as appropriate. ; p3 updated if doing something like a \002 ;[248] ; ; 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 ;[248] 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 else. ;[248] ; Otherwise, valid translation txz t1, N!M!S ;[248] ; Stomp flags so math works move p1, t1 ;[248] ; Save source count endif. ;[248] ; End case handling an invalid escape character 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. remark ; Here if we hit a digit 0 through 9 move t1, q3 ; Original remaining source bytes is fine move p1, q3 ;[248] ; Save for later calculations 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 sub p1, t1 ;[248] ; Calculate digits consumed add p3, p1 ;[248] ; Add those into running total ; Range check result caile t3, .chdel ; It's not too big, is it? %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 ; q3/ Preserved ; q4/ 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 move q4, t1 ;[259] ; Make a copy caile q4, ^d12 ;[259] ; Do not allow over a 36 bit number movei q4, ^d12 ;[259] ; Clamp to 36 bits txo t1, S ; Start translating immediately move t4, q4 ;[259] ; Load maximum destination length move q1, [point 3, q3 ] ; N.B., 3 bit bytes!! setzb t3, q2 ;[248] ; Maintain section local pointers 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? txz t1, N!M!S ;[259] Shut off the flags ifn. t1 ;[259] Error is only valid if remaining string %ermsg (,r) endif. endif. exch t4, q3 ; Position left-justified result in adjacent AC move q2, q4 ; 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 proceed from 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 > ;[209] End code insertion 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 subttl Set Parity /substitution (character) tables ;[258] Begin Table Insertion, all [258] define sschrs (c) < ;;Define macro to populate a single character table xlist ;;Don't need to see this in the listing irpc c,< ;;Go through all the characters %key2 <'c>,<"'c"> ;;Emit character and its ASCII equivalent >;;irpc ;;End of argument expansion list ;;Turn the listing back on >;;eschrs ;;End of macro definition remark this is all maybe kind of glitzy, but looks nice on a "?" %table(subupl) ;;Upper case letter table sschrs (ABCDEFGHIJKLMNOPQRSTUVWXYZ) ;;UPPERCASE letters!! %tbend ;;End of upper case table %table(sublol) ;;Lower case letter table sschrs (abcdefghijklmnopqrstuvwxyz) ;;lowercase letters %tbend ;;End of lower case letter table %table(subdig) ;;Digit table sschrs (0123456789) ;;Digits %tbend ;;End of lower case letter table extern esctkn ; Control character table in K20PAR %table(subcla) ;;Preliminary character classes %key2 , esctkn ;;Parsing hairy control table %key2 , digfdb ;;ASCII digit %key2 , grmfdb ;;Other odds and ends %key2 , lolfdb ;;lowercase ASCII letters %key2 , uppfdb ;;Uppercase ASCII letters %tbend ;;end of preliminary character %table(gsntab) ;;Grammatical symbol name table %key2 , "," ;;Breaks Kermit's macro expansion %keyf3 , %dele, ;;Keep dash hidden %keyf3 , .chdas, cm%inv ;;Common slang for hyphen %dele:! %key2 , .chdel ;;'Official' name %keyf3 , %excl, ;;Escape shows American idiom %keyf3 , "!", cm%inv ;;British idiom %excl:! %key2 , "!" ;;COMND% swallows as comment character %keyf3 , %hyph, ;;Keep horizontal tab good and invisible %keyf3 , .chtab, cm%inv ;;ASCII idiom %hyph:! %key2 , .chhyp ;;COMND% swallows as line continuation %key2 , "?" ;;COMND% uses to display alternatives %keyf3 , .chdel, cm%inv ;;Common alternative name for delete %key2 , .chsem ;;COMND% swallows as comment character %key2 , .chspc ;;COMND% chews white space and tabs %key2 , .chtab ;;Here just in case forgot Control-I %tbend ;;End of named symbols .xcref %dele, %excl, %hyph ;;Keep symbols off cross reference suppress %dele, %excl, %hyph ;; and off the symbol table listing if2 < purge %dele, %excl, %hyph > ;;Not needed after pass two chgsec(code,const) ;;FDB's are not in code, they're in const define pchupa ; Up arrow tchupa:! byte (7) .chupa,.chnul ; Done this way so we can reuse it digfdb: flddb. .cmkey,,subdig,,, lolfdb: flddb. .cmkey,,sublol,,, uppfdb: flddb. .cmkey,,subupl,,, remark Tokens that MACRO can choke on define pchdbq ; double quote tchdbq:! byte (7) .chdbq,.chnul ; token macro uses this define pchsnq ; single quote tchsnq:! byte (7) .chsnq,.chnul ; MACRO uses this as a paste character define pchlpa ; Left parenthesis tchlpa:! byte (7) .chlpa,.chnul ; MACRO gets confused with swap half words define pchrpa ; Right parenthesis tchrpa:! byte (7) .chrpa,.chnul ; MACRO gets confused with arguments closure define pchlpt ; Left pointy bracket tchlpt:! byte (7) .chlpt,.chnul ; MACRO gets confused with arguments list open define pchrpt ; Right pointy bracket tchrpt:! byte (7) .chrpt,.chnul ; MACRO gets confused with arguments list closure remark Our gigantic token table, pheh... grmfdb: flddb. .cmkey,,gsntab,,,gtkT ;;First, keywords for what COMND% can't do remark And then the tokens, COMND% tested to handle all of the below gtkT:! intern gtkT ;[258] Replaces q01 through q30 in K20PAR flddb. .cmtok,cm%sdh,pchdbq,,,gtk0 gtk0:! flddb. .cmtok,,token(<#>),,,gtk1 gtk1:! flddb. .cmtok,,token(<$>),,,gtk2 gtk2:! flddb. .cmtok,,token(<%>),,,gtk3 gtk3:! flddb. .cmtok,,token(<&>),,,gtk4 gtk4:! flddb. .cmtok,,pchsnq,,,gtk5 gtk5:! flddb. .cmtok,,pchlpa,,,gtk6 gtk6:! flddb. .cmtok,,pchrpa,,,gtk7 gtk7:! flddb. .cmtok,,token(<*>),,,gtk8 gtk8:! flddb. .cmtok,,token(<+>),,,gtk9 gtk9:! flddb. .cmtok,,token(<.>),,,gtkA gtkA:! flddb. .cmtok,,token(),,,gtkB gtkB:! flddb. .cmtok,,token(<:>),,,gtkC gtkC:! flddb. .cmtok,,pchlpt,,,gtkD gtkD:! flddb. .cmtok,,token(<=>),,,gtkE gtkE:! flddb. .cmtok,,pchrpt,,,gtkF gtkF:! flddb. .cmtok,,token(<@>),,,gtkG gtkG:! flddb. .cmtok,,token(<[>),,,gtkH gtkH:! flddb. .cmtok,,token(<\>),,,gtkI gtkI:! flddb. .cmtok,,token(<]>),,,gtkJ gtkJ:! flddb. .cmtok,,pchupa,,,gtkK gtkK:! flddb. .cmtok,,token(<_>),,,gtkL gtkL:! flddb. .cmtok,,token(<`>),,,gtkM gtkM:! flddb. .cmtok,,token(<{>),,,gtkN gtkN:! flddb. .cmtok,,token(<|>),,,gtkO gtkO:! flddb. .cmtok,,token(<}>),,,gtkP gtkP:! flddb. .cmtok,,token(<~>),,, ;;Keep silly symbols off the cross reference and symbol table listings tokcln(,<.xcref>,<123456789ABCDEFGHIJKLMN>) tokcln(,,<123456789ABCDEFGHIJKLMN>) if2 < remark ;;Don't need at all after second pass tokcln(,,<123456789ABCDEFGHIJKLMN>) >;if2 remark /SUBSTITUTE switch's Top-level parse table subfdb: flddb. .cmqst,,,,<"~">,subfd0 subfd0: flddb. .cmtok,,pchupa,,,subfd1 subfd1: flddb. .cmkey,,subdig,,,subfd2 subfd2: flddb. .cmkey,,subupl,,,subfd3 subfd3: flddb. .cmkey,,subcla,,,subfd4 subfd4: flddb. .cmkey,,gsntab,,,gtkT define clnc (b,c) < ;;Clean up a bunch of symbols by character remark 'b is the base, 'c is the character suffix irpc c,< .xcref 'b'c ;;Don't want symbol in cross reference .noddt 'b'c ;;Don't need symbol in DDT suppress 'b'c ;;Don't want symbol in symbol table listing if2 < purge 'b'c > ;;After second pass, don't need symbol at all >;;irpc >;;clnc clnc (subfd,<01234>) ;;Clean up working symbols remark ; Other constants atmbps: point 7, atmbuf ; Atom buffer pointers, never modified point 7, atmbuf ; Used to overwrite in place retsec ;;Back to where-ever we started from ;[258] End Table Insertion subttl SET PARITY character substition parsing ;[258] Begin Code Insertion subcal==<<(call 0,0)>&<0,,-1>> ; Keep XWD from choking subchr: saveac ; Just in case anybody is paying attention dmove t1, [ subfdb ; Load address of our initial absurdity cm%xif ] ; Load the no indirection flag orm t2, sbk+.cmflg ; And dink the COMND% state block call rflde ; Try to get one of them ifskp. ; Worked!! movx t4, cm%xif ; Load indirection flag again andcam t4, sbk+.cmflg ; And restore the COMND% state block ldb t4, [pointr (.cmfnp(t3),cm%fnc)] ; Get function code. else. ; Otherwise, failed the parse movx t4, cm%xif ; Load indirection flag again andcam t4, sbk+.cmflg ; and restore the COMND% state block ret ; Hand error off to unsuspecting caller ... endif. ; End handling COMND% returns caie t4, .cmqst ; Quoted the character? ifskp. ; Yep, try to do something useful dmove t1, atmbps ; Load atom buffer pointers call asczcp ; Move the string on top of itself, returning count sojle t3, R ; Don't count the trailing NUL, ignore empty string dmove t1, atmbps ; Load atom buffer pointers again remark t3, ; Will be expanding (I.E., shrinking) in place movei t4, chrtab ; Not doing upper casing call cescxp ; Expand any C-escape-sequences %ermsg (,r) ; Failed?? ifle. t3 ; Might be shorter, but not empty %ermsg (,r) ; Failed?? endif. ; End post c-expansion sanity check ldb t1,[point 7, atmbuf, 6] ; Pick up first character in atom buffer movem t1, pars7 ; Store for semantic action ret ; Done with this case endif. ; End case .cmqst (quoted string) caie t4, .cmtok ; Did we type a token? ifskp. ; Yes, maybe do a tiny hack to convert into a keyword tlz t3, -1 ; Isolate fdb we actually used move t2, .cmdat(t3) ; Pick up the byte pointer to the character ildb t1, t2 ; Load the token character (there will be only one) cain t1, "^" ; Wasn't control character caret? ifskp. ; No, it was the actual character; nothing else to parse movem t1, pars7 ; Hand the character off to semantic action ret ; Done endif. ; Otherwise, turn it into a keyword and parse some more movei t4, .cmkey ; Poof! You're a keyword movei t2, [esctkn] ; Address of fdb for control characters endif. ; End case uparrow transmorgrification caie t4, .cmkey ; A keyword? ifskp. ; That's easy enough, even if this part is prolix hrrz t1, (t2) ; Load the next fdb to parse movei t2, 177 ; Set up a character detection mask andca t2, t1 ; Whack those ife. t2 ; Was the parsed item not an address? movem t1, pars7 ; Wasn't, so hand the character off semantic action ret ; Done! endif. ; End of block skip return processing movx t2, cm%xif ; Load the no indirection flag (.cmtok of @) orm t2, sbk+.cmflg ; And dink the COMND% state block call rflde ; Try to get one of secondary items ifskp. ; Worked!! movx t4, cm%xif ; Load indirection flag again andcam t4, sbk+.cmflg ; And restore the COMND% state block ldb t4, [pointr (.cmfnp(t3),cm%fnc)] ; Get function code. else. ; Otherwise, failed the parse movx t4, cm%xif ; Load indirection flag again andcam t4, sbk+.cmflg ; And restore the COMND% state block ret ; Hand error off to unsuspecting caller ... endif. ; End handling COMND% returns ldb t4, [pointr (.cmfnp(t3),cm%fnc)] ; Get what was parsed caie t4, .cmkey ; A keyword? anskp. ; No, handle that as unchained hrrz t1, (t2) ; Load the corresponding character movem t1, pars7 ; Hand off to semantic action ret ; Done endif. ; End case .cmkey caie t4, .cmtok ; Some kind of token? ifskp. ; Yes, we can just pick that right up tlz t3, -1 ; Isolate fdb we actually used move t2, .cmdat(t3) ; Pick up the byte pointer to the character ildb t1, t2 ; Load the token character (there will be only one) movem t1, pars7 ; Hand off to semantic action ret ; Done endif. ; End case .cmtok remark ; If none of the above, then a table error emsg ; Begin whining movei t1, .priou ; Still going to terminal move t2, t4 ; Load the bad parse value movei t3, ^d8 ; It will be octal NOUT% ; Type it erjmpr .+1 ; Catch and ignore error hrroi t1, crlf ; Tie off PSOUT% ; the line ret ; Return failure and go no further ;[258] 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 .xcref %odd ;[223] Keep symbol off cross reference suppress %odd ;[223] and off the symbol table listing if2 < purge %odd > ;[223] Not needed after pass 2 ;[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 Parse variables usage usage is all part of 258 rework remark Parse Variable Comment ; ====== ===== ======== ================ remark pars3 Parity Offset into the single character table (schrpr) remark pars4 parpko Set if doing parity on packets, only remark pars5 parrck Set if checking parity on recieve in addition to sending remark pars6 paract Action on bad parity, 0 = abort, non-0, count & proceed remark pars7 parsub Character to substitute when NOT aborting remark pars8 ttipar Count of parity errors detected remark ; These are the parity switches %table(parswi) remark Switch Name Instruction Variable Documented? %key3 (, <(setzm 0,0)>, pars6) %Yes ;;[258] %keyf4 (, <(setzm 0,0)>, pars4, %No ) %key3 (, <(setom 0,0)>, pars5) %Yes %key3 (, <(setom 0,0)>, pars6) %Yes ;;[258] %keyf4 (, <(setzm 0,0)>, pars4, %No ) %key3 (, <(setzm 0,0)>, pars5) %Yes %key3 (, <(setom 0,0)>, pars4) %Yes %keyf4 (, <(setom 0,0)>, pars5, %No ) %keyf4 (, <(setom 0,0)>, pars6, %No ) ;;[258] %keyf3 , %rese, ;;Prefer visible reset-error-count %keyf3 , %rese, ;;over INVISIBLE receive-check %keyf4 (, <(setom 0,0)>, pars5, %No ) %rese:! %key3 (, <(setzm 0,0)>, pars8) %Yes %key3 (,, subchr) %Yes ;;[258] %key3 (, <(setzm 0,0)>, pars4) %Yes %tbend cleans(<%Yes,%No,%rese>) ;;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: intern stpart ;[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,,,spwfdd ;;[260] 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 remark ;[258] Don't reset parameters unless explicitly told to move t1, parity ;[258] Load current parity routine's address setz q1, ;[258] Let's assume there is none cain t1, space ;[258] Always clearing bit 8? movei q1, .parsp ;[258] Yes, phoney up its parse table offset cain t1, mark ;[258] Always setting bit 8? movei q1, .parmk ;[258] Yes, phoney up its parse table offset cain t1, even ;[258] Even parity? movei q1, .parev ;[258] Yes, phoney up its parse table offset cain t1, odd ;[258] Odd parity? movei q1, .parod ;[258] Yes, phoney up its parse table offset movem q1, pars3 ;[258] Store as the parsed value dmove t2, parpko ;[258] Load whether doing parity on packets only dmovem t2, pars4 ;[258] and whether we're checking it and store dmove t2, paract ;[258] Load current parity action and substitution dmovem t2, pars6 ;[258] characters to use as defaults move t1, ttipar ;[258] Propagate parity error counter movem t1, pars8 ;[258] unless we explicitly clear it 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 rflde ;[260] Try to parse something ifskp. ;[260] Worked!! ldb t3, [pointr (.cmfnp(t3),cm%fnc)] ;[260] Get what was parsed else. ;[260] Otherwise, failed the parse skipn definf ;[260] In DEFINE? jrst cmderr ;[260] No, so a definite parse error; allow retry ret ;[260] Otherwise, return into DEFINE & see if that chokes endif. ;[260] End parse result handling caie t3, .cmcfm ;[223] Parsed a confirm? ifskp. ;[223] We did setzm pars3 ;[258] Shut off parity, leave other stuff alone ret ;[223] Nothing further to do; comand is confirmed endif. ;[223] End requesting default values saveac ;[223] Needs a few more registers caie t3, .cmkey ;[258] Did we skip the parity type keyword? ifskp. ;[258] No, so get that parse value hrrz t2, (t2) ; Get the value for the keyword. dmove q1, t2 ;[223] Save value and parse type endif. ;[258] Done case of parity keyword caie t3, .cmswi ;[258] Did we directly type a switch? ifskp. ;[258] We did, and skipped the keyword hrrz t1, (t2) ;[258] Address of switch's instruction and address pair xct (t1) ;[258] Execute it to side-effect something erjmpr cmderr ;[258] Failed?? endif. ;[258] End case directly typed a switch, firs 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) ;[258] Address of switch's instruction and address pair xct (t1) ;[258] Execute it to side-effect something erjmpr cmderr ;[258] Failed?? 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 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 ;** DO NOT ;[223] Constructed instruction to generate parity chkint:: Z ; REORDER ** ;[223] Constructed instruction to check parity parpko:: Z ;** DO NOT ;[223] Doing parity on packets, only parrck:: Z ; REORDER ** ;[223] Checking parity on recieve in addition to sending paract:: Z ;** DO NOT ;[258] Parity Action, 0 is abort, else count & proceed parsub:: "~" ; REORDER ** ;[258] Parity substitution character parbla: -1 ;[258] Parity blatting par2nd: Z ;[258] Used when forcing a 2nd parse 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 move t1, pars8 ;[258] Pick up progated (or zeroed) error count movem t1, ttipar ;[258] Set to previous value or zero 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 move t1, pars7 ;[258] Load substitution character call (q2) ;[258] Compute possible parity move t2, t1 ;[258] Reposition move t1, pars6 ;[258] Load parity action dmovem t1, paract ;[258] Store parity acttion and substitution ;[258] character in global variables call parchr ;[223] Recompute parity on other 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. setom parbla ;[261] Reset the parity blatting count ret ;[261] If none, then nothing further to do, so leave endif. ;[261] End case shutting off parity remark ;[261] Otherwise, not NONE setom ebqr ;[194] So request 8th-bit prefixing. movei t2, dqbin ;[89] Use the default prefix. movem t2, ebq ;[89] aose parbla ;[261] Have we seen this message? ret ;[261] Yes, just shut up and get on with it remark ;[261] May have some kind of blatting to do ifmn. netjfn ;[223] Network connection? ifme. opnpar ;[223] Yes, does line 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. > 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: ssthdr ; Sending start of header character spadch ; Sending padding character seolchseolch ; Sending End of Line character handsh ; Handshake character parsub ; Substitution character if proceeding on parity error pcharl==.-pchars ; Number of entries in the table retsec ; Return to code psect ; Call: ; ; q1/ Contains the address of the single character parity generating routine 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 putpaa: entry putpaa ;[256] ; PUT PArity ALWAYS saveac ; Preserve required 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 ; Also 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 ; Otherwise, go hog wild on registers saveac 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 k20mit 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 ; Otherwise, preserve eight registers ... chkpaa: remark ;[257] ; Internal entry when know we're doing parity saveac skipn q3, chkint ; Load and double check extended string instruction retskp ; Very odd! We checked above, but ignore it move q4,parsub ;[258] ; Fill character will be the same as subsitution move q1, t2 ; String will be updated in place (I.E., overwritten) movn t1, t3 ; Source length move t4, t1 ; destination is the same length setzb t3, q2 ; Section local pointers txz t1, N!M ; Shut off Negative and Mark txo t1, S ; Have to dink the foolish significance bit... do. ;[258] ; Enter loop lexical context (in case proceeding) extend t1, q3 ; Get down to some serious string translating nop ; Can't happen txzn t1, N ; Bump into any bad parity? retskp ; Nope, we're done aos ttipar ;[258] ; Count a parity error skipn paract ;[258] ; Are we just giving up? ret ;[258] ; Yes, we are, so signal bad parity idpb q4, q1 ;[258] ; Replace bad character with substitute sojg t4, top. ;[258] ; If not at end, go do some more enddo. ;[258] ; Otherwise, fall out of the loop retskp ;[258] ; Always true 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 parity in ; ; Returns +1, always padbuf: entry padbuf ; Called from k20mit saveac ; Wants some scratch dmove q1, t1 ; Save length and character dmove q3, t3 ; Save parity and buffer address move p1, tvtflg ;[247] ; If might need to do IAC doubling move t1, t2 ; Load padding character call @q3 ; Calculate parity move p2, t1 ;[247] ; Save character with 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 ifn. p1 ;[247] ; TVT Binary? caie p2, IAC ;[247] ; Yes, is it an IAC? anskp. ;[247] ; No, it isn't, so nothing to double lsh q1, ^d1 ;[247] ; Otherwise, double it endif. ;[247] ; End case using IAC as padding character 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) move t1, q1 ;[247] ; Return possibly updated length 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 zsizeb: block 2 ;[263] Results of SIZEF% from section one .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 remark Vestigial Code Removed when finished debugging 265 repeat 0,< movei t1, .fhslf ;[265] This process GETER% ;[265] Get the last error erjmpr .+1 ;[265] Catch and ignore error hrrz q5, t1 ;[265] Save the error move t1, [point 8, strbf2] ;[265] Point to the output buffer ESOUT% ;[265] Type it as an error erjmpr .+1 ;[265] Catch and ignore error txmsg <, > ;[265] Space over movei t1, .priou ;[265] Still typing to terminal hrlzi t2, .fhslf ;[265] This process hrr t2, q5 ;[265] This (captured) error setz t3, ;[265] All the error text there is ERSTR% ;[265] Blat away! erjmpr .+2 ;[265] Ignore this strange error erjmpr .+1 ;[265] Ignore this stranger error hrroi t1, crlf ;[265] Tie off PSOUT% ;[265] the line erjmpr .+1 ;[265] Catch and ignore error movei t1, .priou ;[265] Still typing to terminal move t2, q4 ;[265] The original number movei t3, ^d10 ;[265] A decimal number NOUT% ;[265] Type remainder bytes to do erjmpr .+1 ;[265] Catch and ignore error txmsg <, > ;[265] Space over movei t1, .priou ;[265] Still typing to terminal movn t2, q3 ;[265] Have this be a positive number NOUT% ;[265] Type remainder bytes to do erjmpr .+1 ;[265] Catch and ignore error txmsg <, > ;[265] Space over move t1, q2 ;[265] Load (possibly) updated pointer PSOUT% ;[265] Type that hrroi t1, crlf ;[265] Tie off PSOUT% ;[265] the line do. ;[265] loop context, may have to do this more than once aos vsoct ;[209] Count a SOUTR% done SOUTR% ;[186] ifje. s ;[265] Catch and suppress error block. ;[265] Enter block context for debugging ;;;; skipn ptyflg ;[265] Is this a pseudo-terminal? ;;;; ret ;[265] No, can't recover for now saveac ;[265] Save some accumulators dmove q1, t1 ;[265] Save the calling registers move q3, t3 ;[265] Leave q4 alone movei t1,.fhslf ;[265] This process GETER% ;[265] Get the last error erjmpr .+1 ;[265] Catch and ignore error hrrz q5, t1 ;[265] Save the error ;;;; caie q5, iox33 ;[265] "TTY input buffer full"? ;;;; ret ;[265] No, something else, bomb hrrz t1, ptytty ;[265] Load this PTY's associated terminal line txo t1, .ttdes ;[265] Force alternate form of terminal designator DIBE% ;[265] Dismiss until that input is swallowed %jserr (,r);[265] Or not retskp ;[265] Otherwise, ready for more input endbk. ;[265] Leave block context ifskp. ;[265] Was able to recover loop. ;[265] Try it again else. ;[265] Otherwise, give up %ermsg (,$tranx) ;[265] endif. ;[265] End case SOUTR% recovery > ; Local Modes: ; Mode:MACRO ; Comment Column:32 ; Comment Start:;[275] ; Comment Begin:;[275] ; Auto Fill Mode: 0 ; End: