title k20sub - Kermit-20 Semantic Action and Support Subroutines remark Moved to seperate module as part of 194 to address MCRNEC subttl Preliminaries search monsym,macsym,k20unv cmdacs ;Clean up p1-p4 definitions .xcmsy ;Ditch MACSYM nonsense sall ; Tidy listing .directive flblst ; We don't need to see all the ASCIZ bytes... subttl 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] ... remark cmd storage extern cjfnbk ; Actually in CMD.MAC extern atmbuf ; Atom buffer, in CMD.MAC extern sbk ; State Block remark file related storage extern filjfn ; Current file extern nxtjfn ; Next file in sequence extern ndxjfn ; Stepping JFN (with flags) extern strbuf ; String buffer (to build things in, Etc.) remark Terminal and other JFN's extern ttyjfn ; JFN on local terminal extern $PRIOU ;[220] Whatever we think primary output should be extern udjinf ;[220] Updates jobtab for use by this routine extern tlgjfn ; Transaction log JFN remark other stuff extern czseen ; ^Z seen (typed) extern crlf ; Carriage Return, Linefeed string extern nul4 ; Pointer to NUL: string and length extern allfld ;[252] ; Punctuated all fields for JFNS% extern scrlft ;[233] ; Set to -1 to suppress trailing CRLF in transaction log extern jobtab ; My job information extern errptr ; Error message pointer extern pktnum ;[234] ; Packet number extern spack ;[234] ; Send a packet extern spsiz ;[234] ; Sending packet size extern subbp ;[234] ; 'Subtract' two byte pointers extern %%krbf ;[234] ; Buffer to construct an error pack .psect code/ronly ;[190] Don't allow stores ; To do: Needs a double float (dfltr) ; ; Could do the fltr, then extract the exponent and use it to do ; an ashc on the double word. subttl Support routines for error handling macros. ;[234] Moved here from K20MIT.MAC ; KERMSG -- Send an error message to the KERMIT on the other side in an ; error packet. Invoked from %JSKER, with T1 pointing at the user-provided ; prefix (if any), to which the JSYS error message is appended. ; ; As part of [194], rewritten to offload most the macro expansion and ; do more of the work here. Saves some memory by not always duplicating ; the KERMIT-20: prefix ; ; Called ; ; jsp t1,%%krms ; ; t1 offsets: ; ; +0: Address of ASCII text or zero ; +1: Jump address or zero ; +2: Return address (implied) blanks: xlist ; We don't need to see all the .chspc's... repeat , list blankl==<.-blanks> ; Length of blank array krxblt: blanks ; Source block of memory %%krbf ; Destination block krxptr: point 7, %%krbf ; Pointer to (scrubbed) buffer k20ptr: point 7, k20hdr ; Point to header text ^d11 ; Length of header %%krms: entry %%krms ;[213] Declare for the world block. ; Enter block context for a stack frame saveac ;Get some registers to enjoy ourselves with move q1, t1 ; Save argument/return pointer movei t1, blankl ; Set up XBLT block dmove t2, krxblt xblt. t1 ; Scrub the buffer with blanks move t1, krxptr ; Load pointer to scrubbed buffer dmove t3,k20ptr ; Load pointer to header text remark t4,count ; Length of same move q2, t4 ; Begin length of message do. ; Enter loop lexical context ildb t2, t3 ; Pick up a byte idpb t2, t1 ; Deposit it sojg t4, top. ; Do all of them enddo. ; Fall out of loop lexical context skipg t3,0(q1) ; Load and double check string address ifskp. ; Got passed something do. ; and copy the characters over ildb t2, t3 ; Get the byte. jumpe t2, endlp. ; Exit if a null idpb t2, t1 ; Deposit the byte. aoja q2, top. ; Loop and increment tally enddo. ; Never falls out; explicit exit ; Tack on " - " dmove t2, [exp .chspc, .chdas] idpb t2, t1 ; Append the space idpb t3, t1 ; Append the dash idpb t2, t1 ; Append the space after that addi q2, ^d3 ; Account for three more characters endif. remark t1, ; Put the Tops-20 error string into the buffer. hrloi t2, .fhslf ; Say: this fork ,, last error. movn t3, spsiz ; Specify the maximum to send as a negative add t3, q2 ; number (don't overflow the buffer) hrlzs t3 ;[74] (ERSTR wants -n,,0) ifl. t3 ;[50] (don't bother if not negative). ERSTR% erjmps .+2 ; Ignore its strange return erjmps .+1 ; Ignore its stranger return move t2, t1 ; Set up to get the new length. move t1, krxptr ; Load pointer to partially filled buffer call subbp ; Subtract byte pointers. anskp. ;[40] If there is an error assume this count. remark ; Worked, so don't hit the else. else. ; Otherwise... move t3, q2 ; Don't trust ERSTR% endif. ; End case fence post checking camle t3, spsiz ;[40] Longer than we're supposed to send? move t3, spsiz ;[40] If so, truncate it. call overhd ;[276] Possibly fix up t3 move q2, t3 ; Save whatever the length is movei t1, "E" ; An error packet. move t2, pktnum ; Packet number. move t4, krxptr ; Load pointer to finished buffer call spack ; Send the error packet. nop ifme. srvflg ;[234] ; If a server, NOT safe to type move t1, krxptr ; Load pointer to finished buffer move t2, q2 ; Load final character count adjbp t2, t1 ; Go to end of character string dmove t3, [ exp .chcrt, .chlfd ] idpb t3, t2 ; Drop in a CR-LF idpb t4, t2 setz t3, ; Cons up a NUL idpb t3, t2 ; Tie off the string ESOUT% ; Finally whine about our problems endif. ;[234] ; End case local output move t1, 1(q1) ; Now handle some kind of a return endbk. ; Restore registers, tear down the stack jumpn t1, (t1) ; Go somewhere, if told to HALTF% ; Cease execution ret ; Try to return to caller if continued ; Support for kermsg. Written for maximum reduction of kermsg() macro ; ; All part of [194] %kerms: entry %kerms ; Globally available push p, p2 ; Save p2 (not aliased) move p2, t1 ; Save return and argument address movei t1, "E" ; Send an error packet to the other side. move t2, pktnum ; Packet number. dmove t3, (p2) ; Pick up count and text address call overhd ;[276] ; Don't overflow the error packet movem t4, errptr ; Save pointer to error msg for status. call spack ; Send the error packet. nop ifmn. srvflg ;[234] ; If local, safe to type hrroi t1, k20hdr ; Load start of message ESOUT% ;[187] ; Begin whining move t1, 1(p2);[202] ; Same message PSOUT% ; Type that, too hrroi t1, crlf ; Tie off the line PSOUT% endif. ;[234] ; End case local output move t1, p2 ; Restore calling t1 pop p, p2 ; Restore p2 addi t1,^d2 ; Skip past both arguments jrst (t1) ; Finally done ;[234] End move from K20MIT.MAC subttl overhd -- Returns expected overhead characters in a packet ;[276] Begin code insertion ; ; Used to support error reporting. For EXTREMELY small packets, the ; length of the error text can exceed the size of the packet. Therefore, ; we calculate the expected overhead for the packet and subtract that ; from the maximum error text we will allow. ; ; If we don't do this, then spack will dutifully detect a packet ; overflow error and then try to report that with a packet that is ; still too long and around we'll go again until we get a stack ; overflow. ; ; N.B., The routine makes the (perhaps innocent) assumption that ; NOTHING in the error packet is going to need quoting (such as ; a control character or an IAC), so we can still wind up ; crashing. Be careful! ; ; Call: ; ; t3/ Current packet length ; ; Return: ; ; t3/ Possibly side effected extern bctone ; K20MIT: Use type 1 for this packet regardless... overhd: saveac ; Don't trash any other accumulator movei t1, ^d3 ; SOH+SEQ+TYPE caile t3, ^d94 ; Long packet? addi t1, ^d1 ; Requires an extra character overhead skipe bctone ; Forcing single-character checksum (like for an error)? aosa t1 ; Yes, then always use type 1. add t1, bctu ; Otherwise add the block check length. move t2, spsiz ; Load the maximum packet size sub t2, t3 ; Subtract off the size of the current packet sub t2, t1 ; and also our expected overhead ifl. t2 ; Will we overflow the packet? sub t3, t1 ; We will, so clip it down further endif. ; Otherwise, should be safe to send ret ; Cross our fingers and hope for the best ;[276] End code insertion subttl Macro support routines ; JSERR0 synchronizes with terminal i/o in progress before typing the ; JSYS error message. ; ; JSMSG0 just types the JSYS error message. ; ; These names where changed in order to not conflict with routines of the ; same name in MACSYM (MACREL). Also removed CFIBF% and DOBE% as part of ; edit 187 as ESOUT% does this. ; ; No macro should EVER invoke these directly kserr0: tmsg < - > ; Type a dash. ksmsg0: remark ; Alternate entry movei t1,.priou hrloi t2,.fhslf ; This fork ,, last error. setz t3, ERSTR% erjmpr .+2 erjmpr .+1 ret subttl Support for wtlog ;[194] Begin Code Insertion ; Rewritten for maximum reduction of expansion wtlog() macro %wtlog: entry %wtlog ; Globally available call %wtlgf ; Set up a logging frame addi t1, ^d3 ; Skip past the three arguments jrst (t1) ; Finally done ;[233] Needs plenty registers for intersection transfers %wtlgf: saveac ;[233] txz t1, klflgs ; Don't mess up addressing move q1, t1 ;[233] Save arguments accumulator skipg t1, tlgjfn ; Is the transaction log open? ret ; Nope, so nothing to do ;;;; ;;;; cain t1, .nulio ;[193] Not really going to do anything? ;;;; ret ;[193] Fine, then don't really do anything seto t2, ; Start with time stamp, current date/time. movx t3, ot%nda ; No date in stream ODTIM% erjmps .+1 ; Catch and suppress errors movei t2, ":" BOUT% erjmps .+1 movei t2, .chspc BOUT% erjmps .+1 dmove t2, 0(t5) ; Load string pointer and length ifn. t2 ;[216] Load string and (negative) count cail t3,0 ;[216] Better be a negative number anskp. ;[216] But wasn't xsfm q3 ;[233] Get and store current processor flags move q4, bigsou ;[233] Load up inter-section transfer address movei q5, .+2 ;[233] And the inter-section return adress xjrstf q3 ;[233] and take a giant step! movei t2, .chspc BOUT% erjmps .+1 endif. skipg t3, 2(t5) ;[216] Load a JFN, maybe ifskp. ; Some kind of an address skipg t2, (t3) ; Pick up the actual JFN anskp. ; Unless not holding one caie t2, .nulio ; Dumping it? ifskp. ; That's easy! dmove t2, nul4 ; Constant string and length SOUT% erjmps .+1 else. ; Otherwise, it's a real file dmove t3, allfld ; Type the entire specification JFNS% erjmps .+1 ; Catch and suppress error endif. ; End NUL: special case movei t2, .chspc ;[233] BOUT% ;[233] erjmps .+1 ;[233] endif. ; End case JFN handling aosn scrlft ;[233] ; Wants to suppress trailing CRLF in transaction log? ret ;[233] ; Yes, so we're done hrroi t2, crlf dmove t3,[ exp -2, 0] SOUT% erjmps .+1 ret ;[194] End Code Insertion subttl Support for %jserr. ;[194] Begin Code Insertion ; Rewritten for maximum reduction of %jserr() macro ; ; N.B., If not given a label, the previous version of the macro would ; do a HALTF% allowing a continue. However, no code existed any ; longer which leveraged this functionality. It has been ; removed an replaced with returning +1 if no label is given as ; passing a +1 to the current macro will do the wrong thing k20hdr: intern k20hdr ; Used by other error routines in k20mit asciz |KERMIT-20: | ; Start of any error message %%jser: entry %%jser ; Used in other parts of Kermit Planet block. ; Enter block context (build stack frame) saveac ; Save a bunch of accumulators txz t1, klflgs ; Don't mess up addressing move p2,t1 ; Save return accumulator hrroi t1, k20hdr ; Load pointer to first part of error ESOUT% ;[187] Begin whining, compliantly erjmpr .+1 ; Catch and ignore error skipn t1, 0(p2) ; Pick up the text pointer ifskp. ; That is, if there is one PSOUT% ; Give us that bit of news... erjmpr .+1 ; Catch and ignore error call kserr0 ; Put JSYS error after dash, else. ; Otherwise, no need for the dash call ksmsg0 ; so right after "?KERMIT-20: " endif. ; End case, auxiliary message tmsg < at: > ; Say where it happened. movei t1, -3(p2) ; Calculate address of failing JSYS txz t1, klflgs ; Flags aren't part of the address call symout ; Type it symbolically hrroi t1,crlf ; And a trailing CR-LF. PSOUT% erjmpr .+1 ; Catch and ignore error move t1, 1(p2) ; Load a jump (or return) address endbk. ; Exit block context ; Tears down the stack frame jrst (t1) ; Go someplace and do something .endps code ; Get out of section zero ;[194] End Code Insertion subttl %%smsg documentation and extended section code ;[216] Begin code insertion ; ; SOUT% has a bug in certain cases when being passed OWGP's. Like other ; JSYi, OWGP's work fine for I/O. However, if you use SOUT% to move a ; string, then SOUT% will occasionally do the wrong thing. Fix by ; checking here if we have a JFN and, if so, doing the I/O. Otherwise ; we use MOVSLJ (which is faster than using SOUT% to move data, ; anyway) ; ; Read that last sentence again: incredibly, ALL of the hair with an ; inter-section call to do the MOVSLJ is FAR faster than the SOUT%! ; Read it again, it's whaaay faster. ; ; Of course, MOVSLJ has its own quirks... You would think that you ; could use a OWGP that references section zero while executing in any ; section (such as section zero). I mean it works for IPB, ADJBP, ; ILDB and IDPB, so what's the problem? MOVSLJ will *NOT* honor a ; section zero OWGP when executed in section zero! The non-section ; OWGP increments just fine and both counts decrement, but the section ; zero pointer is untouched... ; ; So we stick with local section zero pointers as the destination, ; always, hand cast to double pointers and then do an inter-section ; transfer so that the MOVSLJ will execute in a non-zero section. ; This is necessary because double word pointers are not honored by ; ANY code executing in section zero. ; ; Actually, SOUT% only works with non-section OWGP's when the output is ; the terminal. Output to the disk is garbled, but not consistently. ; So it has to do an inter-section call, too. Bug appears to be BYTBLT ; in the monitor that is not considering OWGP's from section zero. ; ; And, of course, BOUT% doesn't honor *ANY* kind of a OWGP in section ; zero. EVER... ; ; Entry: ; ; t1/ String pointer or I/O designator ; Any string pointer in t1 is expected to be a ; LOCAL string pointer in section zero space. ; t2/ ASCII OWGP to Extended Text .PSECT, always ; t3/ Negative length of string for faster SOUT%'s ; (If used) ; ; Returns: ; ; +1 always ; ; t1/ Updated, if local pointer ; t2/ Updated ; t3/ 0 ; ; Strings are NUL terminated and ready for append .psect ecode/ronly ; movslj MUST be executed in a non-zero section!!! movmsg: movslj 0,0 ; Extended opcode .chnul ; Fill character (never used) extmov: extend t1, movmsg ; Copy the data nop ; Ignore non-skip (should never happen) move q4, q5 ; Load return address xjrstf q3 ; Return back downstairs, restore flags extsou: SOUT% ; SOUT% from section 1 erjmps .+1 ; Catch and suppress error move q4, q5 ; Load return address xjrstf q3 ; Return back downstairs, restoring flags .endps ecode ; Out of extended code subttl %%smsg documentation and extended section code ; See above; arguments are expected to be suitable for a counted SOUT% .psect const ; Constant pointers go in const giant: extsec,,extmov ; 30 bit address of movslj bigsou: entry bigsou ;[233] Allows k20mit to use extsec,,extsou ; 30 bit address of SOUT% .endps const ; Close off constants .psect code ; Back in section zero code %%smsg: entry %%smsg ; World callable remark ; A minor efficiency hack came t3, [-1] ; Is this one dinky byte? ifskp. ; Then don't need all the baloney below move t3, t2 ; Get a copy of the source pointer ildb t2, t3 ; Load that single byte for BOUT% call BOUTI% ; Go put it somewhere move t2, t3 ; Restore updated source pointer setz t3, ; Stomp so looks like a return from SOUT% ret ; We're done endif. remark ; Otherwise, a multi-byte call tlne t1, -1 ; JFN will never have any flags ifskp. ; It's a JFN saveac ; Save linkage registers xsfm q3 ; Get and store the flags move q4, bigsou ; Load up inter-section transfer address movei q5, .+2 ; And the inter-section return adress xjrstf q3 ; Take a giant step ret ; Return, restoring registers endif. ; End I/O case remark ; See above; all this hair is faster than a SOUT% saveac ; Needs oinky registers movn t4, t3 ; movslj wants a positive length remark ; Cast local section zero to global long hllz q1, t1 ; Load destination pointer portion txo q1, GP%2WB ; Set the double word pointer bit hrrz q2, t1 ; Load address portion (section zero!!!) move t1, t4 ; Source length is the same remark t2, 0 ; Load source pointer (already there) setz t3, ; Single word source (OWGP) xsfm q3 ; Get and store the flags move q4, giant ; Load up inter-section transfer address movei q5, %%sms1 ; And the inter-section return adress xjrstf q3 ; Take a giant step %%sms1: remark ; Our return address call d2sgpc ; Convert double source to single nop ; Ignore error; it will never happen here move q4, t1 ; Store source single pointer remark ; Hand cast destination to section zero local hllz t1, q1 ; Pick up source pointer portion txz t1, GP%2WB ; Stomp the source double word pointer bit hrr t1, q2 ; Put in the section zero address and that's that move t2, q4 ; Load single source pointer move t4, t1 ; Load a copy of the final destination setz t3, ; Return a zero count idpb t3, t4 ; Tie off the string, allow append ret ; Phew!! Finally done subttl BOUT Internal ; Just like BOUT% except doesn't die on a OWGP to a non-zero section. ; Doing the ildb bums a JSYS, anyway, so that's not the end of the world ; ; t1/ Destination designator ; t2/ Byte to be output, right-justified BOUTI%: entry BOUTI% ; World callible tlne t1, -1 ; Writing to a JFN, per chance? ifskp. ; Yes, BOUT% is safe BOUT% ; So do it erjmps r ; Failed?? Catch and suppress error else. ; Otherwise, assume some kind of pointer idpb t2, t1 ; So just deposit it erjmps .+1 ; Failed?? Catch and suppress error push p, t1 ; Save the byte pointer push p, t2 ; Save the byte setz t2, ; Cons up a NUL idpb t2, t1 ; Tie off string, allowing append erjmpr .+1 ; Failed?? Catch and ignore error (for debugging) pop p, t2 ; Restore the byte pop p, t1 ; Restore the byte pointer endif. ; End JSYS/ilpb decision ret ;[216] End code insertion subttl Is this a JFN on NUL: or its equivalent? ; Determines whether JFN is actually NUL:, and, if so replaces it ; with .NULIO, a special pseudo-JFN that is both recognized by ; Tops-20 and used internally as a talisman. ; ; Call: ; ; t1/ Candidate JFN (or device) ; ; Returns, ; ; +1/ t1 unmodified ; +2/ t1 contains .nulio, JFN released (if JFN given) isnulj: entry isnulj ; Keep LINK informed of our location came t1, [.dvdes!.dvnul,,-1] ; Typed device directly? ifskp. ; We did, so just go with that movei t1, .nulio ; Stomp into .nulio, no flags retskp ; We're done else. ; Otherwise, have to figure it out saveac ; Don't trash anything except maybe t1 move q1, t1 ; Save the JFN with any flags endif. ; .nulio might have flags, actually hrrz t2, t1 ; Let's just look at the JFN alone jumpe t2, notnul ; Ignore any gubbish cain t2, .nulio ; Is some joker trying to get cute? jrst yesnul ; It's already NUL: ... ; Try to weed out some wise guys... cain t1, .priin ; Primary Input? jrst notnul ; It isn't the NUL: device cain t1, .priou ; Primary Output? jrst notnul ; It isn't the NUL: device cain t1, .cttrm ; Controlling terminal? jrst notnul ; It isn't the NUL: device cain t1, .sigio ; Signal JFN? jrst notnul ; It isn't the NUL: device ; First see if the argument is a device DVCHR% ; Get the characteristics of device ifje. r ; Broke on JFN with flags move t4, t1 ; Save for the curious seto q2, ; Flag failed (bogus characteristics) else. ; Otherwise, it did work move q2, t2 ; Save device characteristics word endif. ; Now see if a file hrrz t1, q1 ; Load JFN, sans flags GTSTS% ; Get JFN status ifje. r ; Failed?? seto t4, ; Say it sure isn't a JFN else. ; Worked, save the status bits move t4, t2 ; Save the status bits for the moment endif. block. ; Enter block context for better control flow camn t4, [-1] ; GTSTS% blow up? retskp ; It did, so no JFN txnn t4, gs%nam ; Is this bound to anything? retskp ; No, so no JFN endbk. ; Fall out of block context ifskp. ; Skips if no apparent JFN camn q2,[-1] ; Did DVCHR% not work, either? jrst notnul ; Didn't, so assume not NUL: ldb t3, [pointr q2, dv%typ] ; Pick up the device type caie t3, .dvnul ; Wants to just lose data? jrst notnul ; Not NUL:, so don't touch it jrst yesnul ; It is the NUL: device, but not a JFN endif. ; Looks like a live JFN hrrz t1, q1 ; Try looking at it DVCHR% ; Get the characteristics of device erjmpr notnul ; GTSTS% just told us it was good... ; Now see if a file ldb t3, [pointr t2, dv%typ] ; Pick up the device type camn q2, [-1] ; Did the first DVCHR% fail? ifskp. ; No, it worked ldb t1, [pointr t2, dv%typ] ; Pick up the device type camn t1, t3 ; Are these NOT the same? anskp. ; They are, proceed move t3, t1 ; They aren't, prefer device setz t4, ; Say not open nor bound endif. caie t3, .dvnul ; Wants to just lose data? jrst notnul ; Not NUL:, so don't touch it ; It is, so replace the JFN ifxn. t4, gs%opn ; Is this thing open? hrrz t1, q1 ; Reload JFN, sans flags setz t2, ; Let's assume this works... CLOSF% ; Politely try to close it ifje. r ; Catch and ignore JSYS error seto t2, ; Flag it didn't want to go away endif. ; End case trying a normal close jumpe t2, yesnul ; If it worked, then it's time to leave hrrz t1, q1 ; Reload JFN, sans flags txo t1, cz%abt ; In this case, try to clobber it setz t2, ; Let's assume that works... CLOSF% ; Try to close it, rudely ifje. r ; Catch and ignore JSYS error seto t2, ; I guess we must have sticky JFN syndrome endif. ; End case trying a normal close jumpe t2, yesnul ; If it worked, then it's time to leave endif. ; Otherwise, fall through and try something else ; Here if not open or we are desperate ifxn. t4, gs%nam ; Was it ever bound? hrrz t1, q1 ; Reload JFN, sans flags RLJFN% ; Just toss it erjmpr .+1 ; Retrieve and ignore the error remark yesnul ; Falls through endif. yesnul: remark ; Here if NUL; (JFN already released) movei t1, .nulio ; Load our talisman hll t1, q1 ; Load any flags, although now phoney retskp ; Won!! notnul: remark ; Here if not NUL: or some kooky error move t1, q1 ; Restore the calling argument ret ; Return +1 subttl Set up Command State Block to parse from JFN in t1. setcsb: entry setcsb skipg t1 ; Make sure there's a real JFN. movei t1, .priin ; If not, revert. hrlm t1, sbk+.cmioj ; Put the input JFN into the CSB. movei t2, .priou ; Assume JFN is primary input. caie t1, .priin ; Is it? movx t2, .nulio ; No, it's a file, so nullify COMND output. hrrm t2, sbk+.cmioj ; Put output JFN in CSB. ret subttl Initialize Fork Capability vector ; Can't just blanket enable capabilities, an ACJ might get grumpy... ; ; Adapted from SETND2 (SETNOD rewrite) ; ; Note: checking for SC%GTB is almost certainly unnecessary as it is ; unheard of for it NOT to be on and we don't even have to enable it ; as merely having it is enough. That's good because the EXEC does ; not enable it. ; ; However, the code was fun to write and you never know when you're ; going to get hit with some fascist system manager's idea of security. ; ; Note, historically, Kermit did not change the top-level fork's ; capability vector. In particular, if something 'dangerous' (like ; Wheel or Operator) was on, it was left on. This tries to follow ; that. ; Trashes t1-t4 inicap: entry inicap ; Inform Link of our location extern mycaps,capas,bigboy ;and of our necessaries saveac ;[252] Needed to propagate sc%whl/sc%opr setzb t2, t3 ; Cons up a null capability vector dmovem t2, mycaps ; Assume we have nothing and that we are nobody dmovem t2, capas ; special (also intentionally whacks BIGBOY) movei t1, .fhslf ; This fork RPCAP% ; Get our capabilities erjmpr r ; Give up right now; can't do anything more remark t2, capas ;[187] Let other code handle this move t4, t3 ; Save a copy of what's on move q1, t3 ;[252] Another copy here, too remark t2, badmsk ; t2 is ignored by EPCAP% for .fhslf tdz t3, [badmsk] ; Shut off some things that get us into trouble ; Turn on a few things txne t2, sc%dna ; Do we have DECnet access? txo t3, sc%dna ; Yes, turn it on in case ACJ desires it txne t2, sc%gtb ; Do we have GETAB%? txo t3, sc%gtb ; Yes, flag other code txne t2, sc%ctc ; Do we have ^C? txo t3, sc%ctc ; Yes, flag other code andx q1, sc%whl!sc%opr ;[252] Isolate some dangerous bits ifn. q1 ;[252] Could we hurt anybody? setom bigboy ;[252] Yep, flag that we are one of the BIG BOYS or t3, q1 ;[252] And keep them turned on endif. ;[252] dmovem t2, mycaps ; Store current capability vector camn t3, t4 ; Anything to change, actually? ret ; Nope, bum a few JSYi EPCAP% ; Diddle the capabiliy vector ifje. r ; Failed?? move t4, t1 ; Save error code for debuggers, otherwise ignore movei t1, .fhslf ; Reload fork handle endif. ; End case error handling ; See if fascist ACJ changed anything RPCAP% ; Get the resulting capability vector erjmpr r ; Sigh... movem t3, mycaps+1 ; Update final capability vector repeat 0,< ;[252] Remove now that debugging is done txmsg (Avl: ) ;[252] Showing available move t1, t2 ;[252] Load them call infcap ;[252] Show them hrroi t1, crlf ;[252] PSOUT% ;[252] txmsg (On: ) ;[252] Showing what's on move t1, t3 ;[252] Load those call infcap ;[252] Show them hrroi t1, crlf ;[252] PSOUT% ;[252] > ;repeat 0 ;[252] ret ; Finally done subttl Determine what kind of argument we have ; Call: ; ; t1/ The handle we're trying to puzzle out ; ; Return: ; ; +1, Couldn't fathom it ; +2, Figured it out ; ; t1/ Appropriate flag set argtyp: caie t1, .cttrm ; Called with controlling terminal? ifskp. ; That's easy enough movx t1, ts%ctm ; Set the controlling terminal flag retskp ; Success endif. caie t1, .priou ; Called with primary output? ifskp. ; That's easy enough movx t1, ts%pro ; Set the primary output flag retskp ; Success endif. saveac ; For calling argument and stack variable move q1, t1 ; Save the calling argument txz t1, fh%epn ; Shut off extended page number flag caie t1, .fhslf ; Called with this fork? ifskp. ; That's easy, too movx t1, ts%frk!ts%efh ;Set the fork handle flag, explicitly supplied retskp ; Success endif. ; Let's try a little harder anstkv (q2, <.rfsfl+1>) ; Allocate stack space for call movx t3, <.rfsfl+1> ; Length of RFSTS% block movem t3, .rfcnt(q2) ; Store it in block hrlzi t1, (rf%lng) ; Using long form hrr t1, q1 ; Load original argument (whatever it was) move t2, q2 ; Load pointer to block move t3, t1 ; Save a copy of JSYS argument RFSTS% ; Try to find out status erjmpr .+1 ; Side effect t1 with error code came t1, t3 ; But!! Did t1 change?? ifskp. ; No, so the call succeeded movx t1, ts%frk!ts%efh ;Set the fork handle flag, explicitly supplied retskp ; Success endif. hrrz t1, q1 ; Reload the calling argument GTSTS% ; Get the JFN's status ifje. r ; If it was a JFN... move t3, t1 ; Save error for debuggers setz t2, ; Clear gs%nam remark ; Fall out to try device else. ; Otherwise, worked ifxn. t2, gs%nam ; A bound JFN? movx t1, ts%jfn ; Yes, set the JFN flag retskp ; Success endif. ; End case a real JFN remark ; Otherwise, fall through to try device endif. move t1, q1 ; Reload the calling argument DVCHR% ; See if we got a device handle, maybe ifje. r ; Failed?? move t2, t1 ; Save error code for debuggers setz t1, ; Return no flags at all remark ; Fall out to try something else (like what??) else. ; Otherwise, worked movx t1, ts%dev ; Set the device handle flag retskp ; Success endif. ret ; Can't figure out what else to try, so fail subttl set and unset terminal for binary output ; Put TTY in binary mode for output only. Still allows normal input, ; ^C trapping, etc. ttyob: entry ttyob ; Used by k20ioc movei t1, .priou ; Get CCOC words RFCOC dmovem t2, myccoc ; Save em. dmove t2,[525252525252 ;[194] Make all characters output 525252525000] ;[194] with no translation. SFCOC movei t2, .morxo ; Get tty pause-end-of-page status. MTOPR% %jserr (,) movem t3, ttpau ; Save it. dmove t2, [ .moxof ; Set the terminal pause on command .mooff ] ; to no pause on command MTOPR% %jserr (,) ret ; Restore TTY output to condition before TTYOB was called. ttyou: entry ttyou ; Used by k20ioc movei t1, .priou ; Restore normal tty output. dmove t2, myccoc SFCOC %jserr (,) movei t2, .moxof ; Set terminal pause on command move t3, ttpau ; to what it used to be. MTOPR% %jserr (,) ret subttl Save Terminal Characteristics (see following) ; Call: ; ; t1/ JFN or device or fork handle ; t2/ Pointer to storage area ; ; Return: ; ; +1, Not a terminal device or some other significant error ; +2, Complete Success ; t3/ Interesting discovery flags ; ; Storage will contain as much terminal information as could be ; reasonably captured. ; ; Partially inspired by routines in PA1050 (PAT) which handle setting ; 'free' CRLF. Called at program startup and also when using another ; terminal line when running in 'local' mode. ; ; ; N.B., *MUST* be called after INICAP so we can see if we have SC%CTC!! ; ; To Do: Maybe check if .priou is .dvpip and don't do this? savtty: entry savtty ; Called from k20mit saveac ; Used for loop control and terminal references dmove q3, t1 ; Save calling arguments movx t3, ts%err ; Assume some kind of failure movem t3, $tsflg(q4) ; Store in block movem t1, $tsarg(q4) ; Saving calling argument movx t3, lstrx1 ; However, we don't have any errors, YET movem t3, $tserr(q4) ; So don't assume call argtyp ; Determine argument type ret ; Failed, don't know what it is orb t1, $tsflg(q4) ; Save and use the determined type move q1, t1 ; Also keep current flags in a fast place ifxn. q1, ts%pro ; Was this primary output? txo q1, ts%frk ; Yes, so turn it into a fork handle movei q3, .fhslf ; Stomp argument to this process endif. ifxn. q1, ts%frk ; Fork (or implied fork)? move t1, q3 ; Yes, load it GPJFN% ; Find out primary JFN's ifje. r ; Failed?? movem t1, $tserr(q4) ;Store the error number seto t2, ; Force .cttrm move t3, t1 ; Reposition the error else. ; Otherwise, there is no error setz t3, ; So state as much endif. ; and carry on else. ; Otherwise, not using .priou move t2, q3 ; Pretend this is .priou movx t3, lstrx1 ; And flag no error differently endif. dmovem t2, $gpjfn(q4) ; Store appropriately ifxn. q1, ts%dev ; Already had a device designator move t1, q3 ; Yes, use it else. ; Otherwise, maybe GPJFN% got something hrrz t1, t2 ; Have a look at whatever the primary is endif. DVCHR% ; Get the device characteristics ifje. r ; Failed?? movem t1, $tserr(q4) ; Store the error number move t4, t1 ; And also for failure specifics setz t1, ; Phoney up an impossible designator setob t2, t3 ; Yield impossible results else. ; Otherwise, worked setz t4, ; Therefore, flag this endif. dmovem t1, $dvchr(q4) ; Save results dmovem t3, $dvchr+2(q4) ; All of them and error (if any) jumpn t4, r ; Can't go any further if failed ; Otherwise, investigate results ldb t4,[pointr t2, dv%typ] ; Pick up the device type caie t4, .dvtty ; Ok, is this a terminal? ret ; No, the rest makes no sense caie t1, .cttrm ; Controlling terminal? ifskp. ; Yes, let's fix that up move t1, t3 ; Load the device type and line number txo t1, (.dvdes) ; Turn on the designator bit movem t1, $dvchr(q4) ; Replace saved device designator endif. move q2, t1 ; Save device in a fast place remark t1, ; Finally has terminal device RFCOC% ; Get the control word ifje. r ; Catch and ignore error movem t1, $ctcoc+2(q4) ;Save the error movem t1, $tserr(q4) ; Store the error here, too setob t2, t3 ; Fine, no control character output control move t1, q2 ; Reload designator else. ; Otherwise worked, which is good setzm $ctcoc+2(q4) ; Flag no error endif. dmovem t2, $ctcoc(q4) ; Store controlling terminal's COC's RFMOD% ; Get the JFN mode word ifje. r ; Catch and ignore error movem t1, $tserr(q4) ; Store the error number seto t2, ; Fine, no mode word move t3, t1 ; Reposition error move t1, q2 ; Reload designator else. ; Otherwise, worked txz t2, tt%osp ; Clear Control-O setz t3, ; Flag no error endif. dmovem t2, $ctmod(q4) ; Store controlling terminal's mode word and error movei q1, mtoprl ; Load MTOPR% table length do. ; Enter loop context hlrz t2, mtoprt(q1) ; Load function to perform MTOPR% ; Read the value ifje. r ; Catch and ignore error movem t1, $tserr(q4) ;Store the error number seto t3, ; Fine, no value move t4, t1 ; Save for debugger move t1, q2 ; Reload designator else. ; Otherwise, worked setz t4, ; Flag no error endif. hrrz t2, mtoprt(q1) ; Load location to store add t2, q4 ; Calculate correct address in structure dmovem t3, (t2) ; store it somewhere sojge q1, top. ; Get the next one enddo. ; Exit loop context movx t4, <0,,4> ; Load block header word movem t4, $morbm(q4) ; Initialize block remark t1, ; Still has correct designator movx t2, .morbm ; Function is to read break mask movei t3, $morbm(q4) ; Resolve address of break mask block MTOPR% ; Read the value ifje. r ; Catch and ignore error move t4, t1 ; Save for debugger movem t1, $tserr(q4) ; Store the error number setob t2, t3 ; Fine, no break mask.. dmovem t2, $morbm(q4) ; Stomp header and first break word dmovem t2, $morbm+2(q4) ;Stomp second and third break word dmovem t3, $morbm+4(q4) ;Stomp fourth break word, store error move t1, q2 ; Reload designator else. ; Otherwise, worked setzm $morbm+5(q4) ; Flag no error endif. ; Finally set large dimension flags dmove t2, $morlw(q4) ; Load the terminal width ife. t3 ; Was there any error? caig t2, ^d127 ; Exceeded seven bits? anskp. ; No, STPAR% will work movx t3, ts%lgw ; Load large width flag orm t3, $tsflg(q4) ; Record in the flags word endif. dmove t2, $morll(q4) ; Load terminal length ife. t3 ; Was there any error? caig t2, ^d127 ; Exceeded seven bits? anskp. ; No, STPAR% will work movx t3, ts%lgl ; Load large length flag orm t3, $tsflg(q4) ; Record in the flags word endif. move t4, $tsflg(q4) ; Load the current flags so far ifxn. t4, ts%efh ; Did we have an explicit fork handle? move q1, $tsarg(q4) ; Yes, let's use it else. ; Otherwise, assume job wide teriminal interrupts movei q1, .fhjob ; And use this magic handle endif. move t3, mycaps+1 ; Load ENABLED capabilities ifxn. t3, sc%ctc ; Did we have ^C? movx t3, ts%ctc ; Load that we had sc%ctc orb t3, $tsflg(q4) ; Record in the flags word and keep handy else. ; Otherwise, don't have it move t3, $tsflg(q4) ; So load what we do have endif. caie q1, .fhjob ; Are we doing job wide? ifskp. ; Yes, so let's see if that is possible txne t3, ts%ctc ; Did we have ^C? anskp. ; Yes, so STIW% on this will work movei q1, .fhslf ; No; just this fork's terminal interrupt word endif. ; End case .fhjob specified (or assumed) move t1, q1 ; Load terminal interrupt word context movem t1, $tif(q4) ; Store what we are using caie t1, .fhjob ; Entire job? ifskp. ; It is, so won't be getting differed word setz t3, ; So stomp it else. ; Otherwise, this is a specific process txo t1, rt%dim ; So get differed word, just for fun endif. RTIW% ; Finally read the terminal interrupt word ifje. r ; Catch and handle the error movem t1, $tiw+2(q4) ; Save the error movem t1, $tserr(q4) ; Store the error here, too setzb t2, t3 ; Let's say nothing is set else. ; Otherwise worked, which is good setzm $tiw+2(q4) ; Flag no error endif. dmovem t2, $tiw(q4) ; Store terminal interrupt word (and maybe diferred) move t1, $tserr(q4) ; Load last error encountered caie t1, lstrx1 ; Never had any? ret ; Fail the call movx t3, ^-ts%err ; Load failure bit complement andb t3, $tsflg(q4) ; Shut off in flag word retskp ; Complete success subttl MTOPR% index to structure offset mapping tables ; Be aware that each pointer is pointing to a double word which ; holds the value and any error. This is to keep us from restoring ; a value which was never properly read in the first place and ; really messing up a possibly already ill terminal. ; ; As these are offsets, they are added to an address, which means ; that the structure can be in any section. mtoprt: .morlw,,$morlw ; Read line width .morll,,$morll ; Read line length .mornt,,$mornt ; Receive system blat .morxo,,$morxo ; Pause end of page .mopcr,,$mopcr ; Read terminal pause and unpause .mortf,,$mortf ; Read other kinds of blat panda < .morlt,,$morlt > ;;Read TVT bits mtoprl==.-mtoprt-1 ; Calculate table length mtopst: .moslw,,$morlw ; Set line width .mosll,,$morll ; Set line length .mosnt,,$mornt ; Set system blat acceptance .moxof,,$morxo ; Set pause end of page .mopcs,,$mopcr ; Set terminal pause and unpause .mostf,,$mortf ; Set other kinds of blat panda < .moslt,,$morlt > ;;Set TVT bits mtopsl==.-mtopst-1 ; Calculate table length ifn , subttl Restore Terminal Characteristics ; Call: ; ; t1/ Takes a pointer to a storage area that was set up by SAVTTY. ; ; Restores every parameter that was successfully saved, ignores ; those that weren't. ; ; Return: ; ; +1, always ; ; t3 has last error, zero if everything restored ; ; Terminal characteristics restored or restored mostly. ; ; Trashes t1, t2, t3 and t4 ; ; See above. Do NOT change order of restore because SFMOD%/STPAR% ; will overwrite the length and width with the wrong things restty: entry restty ; Called from k20mit saveac ; Uses plenty more registers... move q1, t1 ; Save structure base seto t3, ; Assume complete junk skipe $dvchr+3(q1) ; Did we ever get a device? ret ; No, no way we can restore anything move q2, $dvchr(q1) ; Yes, use the device for everything move t1, q2 ; Load for JSYi setz q3, ; Let's assume everything works ifme. $ctcoc+2(q1) ; Did the RFCOC% work dmove t2, $ctcoc(q1) ; Yes, load controlling terminal's COC's SFCOC% ; Put them back ifje. r ; Failed?? move q3, t1 ; Remember that something failed move t1, q2 ; Reload designator endif. ; End case SFCOC% failure handling endif. ; End case SFCOC% restore decision ifme. $ctmod+1(q1) ; Did RFMOD% work? move t2, $ctmod(q1) ; Yes, load those bits SFMOD% ; Set 'program related' bits ifje. r ; Failed?? move q3, t1 ; Remember that something failed move t1, q2 ; Reload designator endif. ; End SFMOD% error handling STPAR% ; Set 'mechanical' bits ifje. r ; Failed?? move q3, t1 ; Remember that something failed move t1, q2 ; Reload designator endif. ; End STPAR% error handling endif. ; End mode word restore decision movei q4, mtopsl ; Load MTOPR% table length do. ; Enter loop context hrrz p1, mtopst(q4) ; Load pointer to stored value offset add p1, q1 ; Add in base of table dmove t3, (p1) ; Load value and error condition ife. t4 ; If no error, then try setting hlrz t2, mtopst(q4) ; Load this value's MTOPR% set index MTOPR% ; Try setting the value ifje. r ; Failed?? move q3, t1 ; Remember that something failed move t1, q2 ; Reload designator endif. ; End MTOPR% error handling endif. ; End MTOPR% restore decision sojge q4, top. ; Get the next one enddo. ; Exit loop context ifme. $morbm+5(q1) ; Did the read mask work? movx t2, .mosbm ; Function to set break mask movei t3, $morbm(q1) ; Address of four word block to load from MTOPR% ; Set the value ifje. r ; Failed?? move q3, t1 ; Remember that something failed move t1, q2 ; Reload designator endif. ; End case MTOPR% failure handling endif. ; End case break mask restore decision ifme. $tiw+2(q1) ; Were we able to get the terminal interrupt word? dmove t1, $tif(q1) ; Yes, load context and mask STIW% ; Restore somebody's terminal interrupt word ifje. r ; Failed?? move q3, t1 ; Remember that something failed move t1, q2 ; Reload designator endif. ; End case STIW% failure handling endif. ; End case STIW% decision move t3, q3 ; Has any errors ret ; Finally get out of here subttl Set Up Local Terminal for Kermit usage setty: entry setty ;[220] Invoked by k20mit call udjinf ;[220] Get and update current job information skipge t4,jobtab+.jitno ;[220] Load and check current terminal number ermsg% (,halt) ;[220] movem t4, mytty ;[184] stomp in a possible new line move t1, t4 ;[186] Pass in possible new terminal line hrli t1,.dvdes!.dvtty ;[186] Turn into a device designator movei t2, svstt ;[186] Point to saved start up terminal area call savtty ;[186] Save terminal characteristics again ermsg% (,halt) ;[186] movei t2, svstt ;[194] Point to populated structure ifme. $dvchr+3(t2) ;[194] Any error? move t3, $dvchr(t2) ;[194] None, use what DVCHR% got else. ;[194] Otherwise, have to use something movei t3, .priou ;[194] Maybe old reliable will work endif. ;[194] End case determining controlling device movem t3, $PRIOU ;[194] Store and hope for the best call lcltty ;[194] Get a JFN on local terminal %ermsg (,halt) ;[186] movem t1, ttyjfn ;[194] Store for downstream use ret subttl Acquire JFN on local terminal ; Although has a +1/+2 return, it always returns ; something, even if it is only .priou or .cttrm ; ; t1/ JFN open and ready to use ; ; To do: if a pipe, maybe change this and just use it? ; ; Also: if we are running as local, then we should close the ; ttyjfn and replace it with .sigio because we shouldn't ; be diddling the local terminal. lcltty: extern ttyjfn ; In k20mit saveac ; Copy of possible open JFN setom lcltte ; Whack the error block to detached job move t1, [lcltte,,lcltte+1] blt t1, lcltef ; The entire block skipg q1, ttyjfn ; First, is there something already available? jrst getlcl ; Evidently not; let's get a JFN move t1, q1 ; Load it for the JSYS to investigate GTSTS% ; Let's have a look see ifje. r ; Looks like it's defunct, somehow movem t1, lcltte ; Store the error move t1, q1 ; Reload the JFN (or whatever it was) setz t2, ; Whack the status endif. txc t2,gs%nam!gs%opn ; Complement the required bits txce t2,gs%nam!gs%opn ; Is it any good at and is it open? jrst getlcl ; No, then go get a JFN ifxn. t2,gs%err ; Any kind of error? hrli t1, (cz%abt) ; Abort the JFN CLOSF% ; Try to junk it ifje. r ; Failied?? movem t1, lcltte+1 ; Store the error move t1, q1 ; Reload the JFN (or whatever it was) RLJFN% ; Just try to let go of it ifje. r ; Failied?? movem t1, lcltte+2 ;Store the error endif. endif. jrst getlcl ; Go get a new JFN endif. retskp ; Otherwise, get out of here with a JFN getlcl: extern mytty ; Here to get a JFN on the local line setzm ttyjfn ; At this point, no JFN anyhow move t3, mytty ; Load my terminal number camn t3, [-1] ; Detached?? jrst lclerr ; Yes, that will never do.. txz t3, .ttdes ; Stomp in case somebody left it on dmove t1, [-1,,lclnam ; HRROI pointer to place to build name .dvdes!.dvtty,,0 ] ; Device designator prototype hrr t2, t3 ; My current attached terminal movem t2, lcldev ; Store it for later DEVST% ; Build the device string ifje. r ; Failed?? movem t1, lcltte+3 ; Save the error jrst lclerr ; And give error return else. ; Otherwise, worked dmove t2, [ exp ":", 0] ; Load final characters idpb t2, t1 ; Punctuate the device idpb t3, t1 ; Tie off the device string endif. dmove t1, [ gj%sht!gj%flg ; Want flags -1,,lclnam ] ; Point to constructed device name GTJFN% ; Try to get a handle ifje. r ; Can't on our own silly TTY?? movem t1, lcltte+4 ; Sigh ... dmove t1, [ASCIZ /TTY:/ ; Try generic case 0 ] ; Certainly null terminated dmovem t1, lclnam ; Drop that in dmove t1, [ gj%sht!gj%flg ; Want flags -1,,lclnam ] ; Point to constructed device name GTJFN% ; Try to get a handle ifje. r ; Failed?? movem t1, lcltte+5 ; Sigh ... jrst lclerr ; Go do general error exit endif. ; End failure recovery failing .. endif. ; End GTJFN% failure analysis and recovery hrrzm t1, lcljfn ; Store the JFN hllzm t1, lclflg ; And the flags tlz t1, -1 ; Don't confuse foolish OPENF% with our flags remark ; See what fld(.gsimg,of%mod) does here ; movx t2, fld(8,of%bsz)!of%wr!of%rd ; 8-bit bytes, read & write access. movx t2, fld(8,of%bsz)!fld(.gsimg,of%mod)!of%wr!of%rd OPENF% ; Finally try to open the silly thing ifje. r ; Failed?? cain t1, opnx1 ; But!! Was error "File already open"? anskp. ; That's fine, we can live with that movem t1, lcltte+6 ; Otherwise, store the error hrrz t1, lcljfn ; Load the JFN RLJFN% ; Let go of it ifje. r ; Failed?? We just got it! movem t1, lcltte+7 ; Store that on the way out endif. ; And carry on with OPENF% error jrst lclerr ; And give error return endif. ; End OPENF% failure handling call gdswrp ;[223] Call Get Device Status Wrapper hrrz t1, lcljfn ;[223] Load the JFN retskp ; Won!! lclerr: remark ; Here if something broke setzb t1, lcljfn ; No JFN setzm lclflg ; No flags ret ; Nothing further we can do... subttl Wrapper for Get Device Status ;[223] Begin code insertion ; Assumes lcljfn is set remark ; These externals are in k20net and k20ioc extern gndpar ; Get Network Device Parity extern none ; No parity being done extern even ; Doing even parity extern parpko ; Doing parity only on packets extern parrck ; Checking parity on receive gdswrp: hrrz t1, lcljfn ; Load local terminal JFN in t1 hll t1, lclflg ; and its flags call gndpar ; Get 'Network' Device Status setz t2, ; Falled, assume refuses parity, then ifxn. t2, gd%par ; 'Tolerates' parity? setom lclpar ; Yes, normalize that ifxn. t2, mo%par ; Was the thing doing parity anyway movei t3, even ; Tops-20 itself only generates even parity else. ; Otherwise, we're not doing parity movei t3, none ; so set it to 'none' endif. ; End case propagating parity else. ; Otherwise, doesn't do parity setzm lclpar ; So whack the variable movei t3, none ; And flag elsewhere to 'none' endif. movem t3, parity ; So make sure we're following local terminal parity setzm parpko ; Doing parity for terminal and packets setzm parrck ; But we're not checking it on receive ret ; Done ;[223] End code insertion subttl Restore start up terminal parameters ; Assumes correct terminal parameters to restore are the start up ones fixtty: entry fixtty ; World callable extern svstt, tiword ; Found in K20MIT movei t1, svstt ; Load pointer to start up terminal parameter block call restty ; Restore the whole kit and kaboodle ifn. t3 ; Anything not restore properly? ermsg% endif. ; End case double checking move t3, mycaps+1 ; Load enabled capabilities ifxn. t3, sc%ctc ; Do we have control-C capapbility? movx t1, .fhjob ; Yes, then can grab ^C job wide else. ; Otherwise, can only do it for our fork movei t1, .fhslf ; So make it process wide, instead endif. ; What about the inferior? move t2, tiword ; Load the terminal interrupt word STIW ; and set it %jserr (,) ret subttl Condition local terminal for use as remote ;[151] Set up TTY for linking, and open any logging file. ; ;[129] Add TT%DUM $modof==0 ;[194] Bits we want off $modof==$modof!tt%eco ;[194] Shutting off echoing $modof==$modof!tt%dam ;[194] Force binary data mode (whacks field flags) $modof==$modof!tt%dum ;[194] Force full duplex (whacks field flags) $modof==$modof!tt%lic ;[194] Do not raise lower case on input $modof==$modof!tt%wkf ;[194] Don't wakeup on formating control chars $modof==$modof!tt%wkn ;[194] Don't wakeup on non-formatting control chars $modof==$modof!tt%wkp ;[194] Don't wakeup on punctuation $modof==$modof!tt%wka ;[194] Don't wakeup on alphanumerics $modof==$modof!tt%wid ;[194] Infinite width (0) $modof==$modof!tt%len ;[194] Infinite length (0) $modof==$modof!tt%uoc ;[194] Do not indicate upper case modoff: $modof ;[194] Store in code psect .xcref $modof ;[194] Don't need in cross reference remark ;[194] Don't translate certain control characters $modon==0 ;[194] Bits we want on $modon==$modon!tt%mff ;[194] Mechanical formfeed present $modon==$modon!tt%tab ;[194] Mechanical tab present $modon==$modon!tt%lca ;[194] Lower case capabilities present $modon==$modon!tt%pgm ;[194] Assume doing ^S/^Q modon: $modon ;[194] Store in code psect .xcref $modon ;[194] Don't need in cross reference ttyini: entry ttyini ;[194] Called from main extern handsh, flow, halt ;[186] Defined in k20mit skipn t1, ttyjfn ;[186] If have a terminal JFN, use it %ermsg (,halt) ;[186] movei t4, svstt ;[186] Point to start up terminal parameter block dmove t2, $ctmod(t4) ;[186] Load controlling terminal's mode word and error ife. t3 ;[186] Don't have it? RFMOD% ;[186] See if we can get it now %jserr (,r) ;[186] setz t3, ;[186] Worked?? Oh well, that's strange, but OK dmovem t2, $ctmod(t4) ;[186] Store what SAVTTY should have done endif. ;[186] End case loading mode word andcm t2, modoff ;[194] Shut off what we don't want or t2, modon ;[194] Or in what we want on skipn handsh ;[155] Doing handshake? skipn flow ;[155] Doing flow control? txz t2, tt%pgm ; Handshake, or no flow - don't do XON/XOFF. SFMOD ; Set the bits %jserr (,r) STPAR ; ...and the other bits... %jserr (,r) movx t1, .fhjob ; Turn off ^C, ^O, ^T interrupts for whole job. move t3, mycaps+1 ;[185] Load enabled capabilities txnn t3, sc%ctc ; Can only do job wide STIW if we do... movei t1, .fhslf ;[185] We don't, so process wide RTIW %jserr (,r) movem t2, tiword movx t4, <1b<.ticcc>!1b<.ticco>!1b<.ticct>> txnn t3, sc%ctc movx t4, <1b<.ticco>!1b<.ticct>> tdz t2, t4 STIW %jserr (,r) ret subttl Force a JFN to close (or try real hard to) ; Call: ; ; t1/ JFN to get rid of ; ; +1, JFN could not be released ; t1, t2, t3 have various errors ; ; +2, JFN no longer valid ; ; This will force just about any kind of JFN to be gotten rid ; of except for the case of a file that is still mapped. extern delayf, delay ; Whether we are waiting for anything frclos: entry frclos ; Called from everywhere saveac ; Used for a copy of the JFN hrrzs q1, t1 ; Save a copy without flags setzb t2, t3 ; Let's assume everything is dandy ; Let's check a few silly cases jumpe t1, rskp ; If no JFN, then nothing to do, anyhow cain t1, .nulio ; BUT!! Never opened? retskp ; That's fine, we're done already cain t1, .priou ; How about primary output? retskp ; Don't bother closing it as it was never opened cain t1, .priin ; Somebody get mixed up? retskp ; That's OK, same deal as .priou cain t1, .cttrm ; Controlling terminal? retskp ; That won't work, either, but it's fine ; At this point, have to assume a real JFN ifmn. delayf ; Use basic delay (if we have one) skipg t2, delay ; Load and double check milliseconds anskp. ; Some kind of gubbish, don't risk it movei t1, frclo1 ; If time out, then hit the abort code call timeon ; Set the timer hrrz t1, q1 ; And reload the JFN endif. ; Either way, hit the CLOSF% CLOSF% ; Politely try to close it ifje. r ; Catch and store the error cain t1, desx1 ; Trying to close complete junk? anskp. ; Fine, pretend it's closed .. cain t1, desx3 ; No JFN anyway? anskp. ; That's fine, too; never had anything to do move t2, t1 ; Save the error for downstream processing else. ; Otherwise it worked call frclot ; Clean up any extent timers retskp ; and get out of here endif. ; End CLOSF% interpretation cain t3, clsx1 ; If error is NOT "File is not open" ifskp. ; Then try harder to close it frclo1: hrrz t1, q1 ; Reload the JFN hrli t1,(cz%abt) ; Set the abort bit, clear others CLOSF% ; Try to close it, and be rude about it ifje. r ; Catch and store error move t3, t1 ; Move error to 2nd attempt AC else. ; Otherwise, being distictly rude about it worked call frclot ; Clean up any extent timers retskp ; and give a good return endif. ; End case cz%abt analysis endif. ; End case, other than "File is not open" remark t3, clsx1 ; Might just need to release it hrrz t1, q1 ; Load the JFN RLJFN% ; So try that erjmpr frclot ; Catch error in t1, return +1 from frclot call frclot ; Clean up any extent timers retskp ; Otherwise, finally won frclot: remark ; Force close timer clean up ifmn. delayf ; Did we set a timer? skipg delay ; Did we *REALLY* set a timer? anskp. ; Nope, so that's easy call timdel ; Otherwise, whack the timer endif. ; End timer removal decisioning ret ; Returns +1, always subttl file transfer error post processing ; Come here to close a partially received file. It will be discarded ; or kept, depending on setting of ABTFIL, i.e. SET INCOMPLETE (FILE ; DISPOSTION). giveup: entry giveup ;[213] Moved from K20MIT to fix extern abtfil ;[213] Whether to discard a partial file extern local ;[213] Set if talking to a Kermit server ifmn. abtfil ;[134] Do we discard or keep? ;[194] wtlog (, filjfn) ;[233] Keep. ifmn. local ;[194] If local, safe to type txmsg <[keeping partial file]> ;[194] endif. call rdclos ; Go close as much of it as we have. ; fails through to wtlog, below anskp. ;[194] Discard it if we have some problem. ret ; Closed partial file OK. endif. ;[194] wtlog (,filjfn) ;[233] Discard. ifmn. local ;[194] If local, safe to type txmsg <[discarding]> ;[194] Say what we're up to. endif. ;[194] ifmg. filjfn ; Real file? call unmapo ; Go unmap the file nop ; Don't worry if we can't. hrrz t1, filjfn ; Clear out any junk from left half. cain t1, .nulio ;[193] Just tossing it anyway? anskp. ;[193] Yes, so nothing to ditch txo t1, cz%abt ; Discarding, so cancel the file. CLOSF% ; Close it. ifje. r ;[194] hrrz t1, filjfn ;[194] On any error, RLJFN ; at least try to release the JFN. erjmpr .+1 ;[194] Catch and ignore error endif. ;[194] End case CLOSF% recovery (we hope) endif. ;[193] End case actual JFN to close setzm filjfn ; Say we have no file. ret subttl Close the output file, update the FDB, etc... ; Return +1 on error, +2 on success. rdclos: entry rdclos ;[213] Moved from k20mit saveac ;[232] Needs a few extra registers extern ebtflg ;[213] Set if doing an 8 bit file extern tbtflg ;[232] Set if forcing a 36 bit file extern itsfil ;[213] ITS binary format file skipg filjfn ;[103] Output was to a real file? jrst rdclsz ;[103] No, skip all this. call unmapo ; First, clean out the PMAPing page. ret ; Oops, failed, pass it along... ;[232] Calculate values FIRST rdclsv: dmove q1,[exp ^d7,^d5] ;[232] Assume ASCII and its packing factor skipn itsfil ;[75] ITS binary file? skipe ebtflg ; Or eight-bit mode? dmove q1,[exp ^d8,^d4];[232] Then load that value skipe tbtflg ;[232] Forcing 36 bit mode? dmove q1,[exp ^d36,^d5];[232] Assume words and decode factor caie q1, ^d36 ;[232] Forcing 36 bit bytes? ifskp. ;[232] Yes, tweak that move t3, rchr ;[232] Load number of file bytes setz t2, ;[232] No high order!!! div t2, q2 ;[232] Compute WORDS used caie t3, 0 ;[232] Evenly divided? aosa q2, t2 ;[232] No, so bump up a word, store and skip move q2, t2 ;[232] Otherwise, just store words else. ;[232] Otherwise, no calculations needed move q2, rchr ;[232] Just load the number of file bytes endif. ;[232] End case 36 bit fix up ; Now close the file. rdclsa: hrrz t1, filjfn ;[193] Get the JFN. cain t1, .nulio ;[193] Tossing? jrst rdclsc ;[232] Skip all this fdb stuff txo t1, co%nrj ;[193] Set flag for not releasing JFN. CLOSF% ; Close it. %jsker ,r ; Return error. ; Update FDB information with correct byte size and (word) count hrli t1, .fbbyv ;[232] Set the byte size, first. hrr t1, filjfn txo, t1, cf%nud ;[232] Don't update disk yet. movx t2, fb%bsz ; Byte size field mask. dpb q1,[pointr(t3,fb%bsz)] ;[232] Put in proper place CHFDB% erjmps .+1 ; Keep going if we get an error. hrli t1, .fbsiz ; OK, now fix FDB. Set the number of bytes hrr t1, filjfn ; Move in the JFN. seto t2, ; Change all bits in the word. move t3, q2 ;[232] The number of bytes (or words) in the file. CHFDB% ;[232] This time, update the FDB erjmps .+1 ; Keep going if we get an error. ;[126] Take care of any transaction logging. rdclsc: skiple filjfn ;[193] Real file? skipg t1, tlgjfn ; Transaction log? jrst rdclsd ;[232] No, skip this. smsg (< Written: >) ; Yes, log this info. move t2, q2 ;[232] Load the byte count movei t3, ^d10 NOUT erjmps .+1 movei t2, .chspc ;[194] A space BOUT erjmps .+1 move t2, q1 ;[232] Load byte size NOUT erjmps .+1 smsg (<-bit bytes >) ; Finish closing the output file by releasing its JFN. rdclsd: skipg filjfn ;[126] ;[194] ifskp. ;[194] File was open wtlog (,filjfn) ;[233] Transaction log message. endif. ;[194] hrrz t1, filjfn ; Release the JFN. caie t1, .nulio ;[193] Nothing to release RLJFN% nop rdclsz: setzm filjfn ; Say we have no more file. retskp subttl Clean up the file mapping page for an output file. ; Returns +1 on failure, +2 on success. ; On failure, an error packet is sent, which cancels the transfer. ; ; Uses t1,t2,t3. ; ; Note that unmapping the memory page also makes it disappear. The ; next write to the page will create a fresh page with all 0's. ; ; The trick at the beginning catches the case where the page has ; already been unmapped because we just filled in the last byte. ; Since this routine is called both by the page filler (PUTCH) and by ; the file closer (RDCLOS, to catch a final partial page), we must ; worry about files that end on a page boundary. ; ; Putting an ERJMP after any instruction that references memory will ; catch "illegal memory read" errors, and will thus prevent us from ; attempting to unmap a page that has already been unmapped and still ; has not been written into. unmapo: entry unmapo ;[213] Moved from k20mit extern pagno ;[213] Present page number in file move t1, maporg ;[190] Has the page been used at all? erjmps rskp ;[213] No, done. movx t1, <.fhslf,,mappag> ; Yes, map them out, our fork,,mapping page hrlz t2, filjfn ;[193] file JFN,,... came t2,[ (.nulio) ] ;[193] Just dumping it? ifskp. ;[193] Yes, so just pitch the memory call unmapa ;[213] Unmap and abort retskp ;[193] Nothing further to do endif. ;[193] End case cleaning up a NUL: transfer remark ;[193] Otherwise, had a real file mapped ife. rchr ;[213] But!! Did we ever get any data? call unmapa ;[213] Unmap and abort retskp ;[213] That was easy enough; we're done endif. ;[213] Otherwise, non-zero file hrr t2, pagno ; ...page file page number. movx t3, pm%rd!pm%wr ; Read and write access. PMAP% ; Map it out. %jsker (,r) ; Can't - fail. remark ;[193] This isn't really necessary, but.. hrrz t1,filjfn ;[193] Load file JFN move t2, rchr ;[193] Load current character count SFPTR% ;[193] Show for nosey people on SYSDPY erjmpr .+1 ;[193] Ignore any error retskp subttl Abort an output page ; Used to punt a page instead mapping out to disk ; ; t1/ fork handle,,page number ; ; Typically .fhslf,,file mapping page ; ; Returns +1, always unmapa: remark t1, <.fhslf,,mappag> ;[213] Our expectations move t2, t1 ;[213] For Case IV, destination is process memory seto t1, ;[213] Which we will be whacking setz t3, ;[213] No flags, no count PMAP% ;[213] Kick the page into oblivion %jsker (,r) ;[193] Not promising, but ignore ret ;[213] And return subttl Save and restore terminal lengths (a.k.a., heights) and widths. ;[185] Begin code insertion ;[185] ;[185] This is necessary because linear dimensions in excess of seven ;[185] bits (127) can not be stored in the JFN mode word as saved by ;[185] SFMOD% and restored by STPAR% ;[185] ;[185] As these are stored in halfwords, this allows for a maximum of ;[185] 262,143 for either a width or a length. As this is two decimal ;[185] orders of magnitude larger than the highest resolution graphics ;[185] cards (4096 in 2006), we probably don't have to worry about ;[185] overflowing the field for the next decade or so. None the ;[185] less, the MTOPR% does return a FULL 36 bit word; so if we ever ;[185] overflow 18 bits, then we should change this code. ;[185] ;[185] Assumes: ;[185] ;[185] t1/ Valid terminal JFN (possibly .PRIOU) ;[185] t2/ Pointer to block to save length and width ;[185] ;[185] Preserves the register file and is completely silent about errors. savlnw: entry savlnw ;[183] Globally available saveac ;[185] Do not side-effect the register file! dmove t4, t1 ;[185] Preserve JFN, dimension block address ;[185] DVCHR% ;[185] What kind of device is this? erjmpr r ;[185] it's a bogus device! load t3, dv%typ, t2 ;[185] Get device type field caie t3, .dvtty ;[185] Is this a terminal? ret ;[185] No, better leave it alone move t1, t4 ;[185] Restore the JFN ;[185] Assume infinite (and therefore useless) setzb t3, (q1) ;[185] defaults for width and length movx t2, .morll ;[185] Return the terminal page length MTOPR% ;[185] Which may be over 127 ... erjmps .+2 ;[185] Must be a bogus JFN hrlm t3, (q1) ;[185] Save length dmove t2,[exp .morlw,0] ;[185] Return the terminal page width. MTOPR% ;[185] Which may be over 127 ... erjmps .+2 ;[185] Must be a bogus JFN hrrm t3, (q1) ;[185] Save length ret ;[185] Done, restore register file rstlnw: entry rstlnw ;[194] Globally available saveac ;[185] Do not side-effect the register file! dmove t4, t1 ;[185] Preserve JFN, dimension block address ;[185] DVCHR% ;[185] What kind of device is this? erjmpr r ;[185] it's a bogus device! load t3, dv%typ, t2 ;[185] Get device type field caie t3, .dvtty ;[185] Is this a terminal? ret ;[185] No, better leave it alone move t1, t4 ;[185] Restore the JFN ;[185] movx t2, .mosll ;[185] Set the terminal page length. hlrz t3, (q1) ;[185] Load old width caie t3, 0 ;[185] Ever get anything? If not, leave MTOPR% ;[185] it alone; otherwise restore it erjmps .+1 ;[185] Ignore errors, preserve JFN movx t2, .moslw ;[185] Set the terminal page width. hrrz t3, (q1) ;[185] Load old width caie t3, 0 ;[185] Ever get anything? If not, leave MTOPR% ;[185] it alone; otherwise restore it erjmps .+1 ;[185] Ignore errors, preserve JFN ret ;[185] Done, restore register file ;[185] End code insertion subttl interrupt storage (pure) extern frtrap ;[186] Is in K20NET emacro < extern sitrap ;[203] .sigio check is in K20MAC > levtab: pc1 pc2 pc3 chntab: phase 0 tmchan: 1,,tmtrap ;[194] ; Timer trap on channel 0, priority 1. ccchan: 1,,cctrap ; ^C trap on channel 1, same priority. cachan: 2,,catrap ; ^A trap on channel 2, lower priority. cxchan: 2,,cxtrap ; ^X trap on channel 3... czchan: 2,,cztrap ; ^Z trap .... 4 cmchan: 2,,cmtrap ; ^M trap .... 5 block 1 ; .ICAOV==:6, not trapping arithmetic overflow block 1 ; .ICFOV==:7, not trapping floating overflow block 1 ; ^d8, Reserved for Digital block 1 ; .ICPOV==:9, not trapping PDL overflow block 1 ; .ICEOF==:10, not trapping End-of-File block 1 ; .ICDAE==:11, not trapping, Data Error block 1 ; .ICQTA==:12, not trapping Quota/Disk Exceeded block 1 ; ^d13, Reserved for Digital block 1 ; .ICTOD==:14, not trapping Time of Day (not implemented) block 1 ; .ICILI==:15, not trapping Illegal Instruction block 1 ; .ICIRD==:16, not trapping Illegal Read block 1 ; .ICIWR==:17, not trapping Illegal Write block 1 ; .ICIEX==:18, not trapping Illegal Execute (TENEX only) emacro < sigchn: 3,,sitrap ;[203] .ICIFT==:19, multiplexed with .SIGIO >;;emacro nmacro < block 1 ; .ICIFT==:19, Inferior Fork Termination >;;nmacro block 1 ; .ICMSE==:20, not trapping machine resources exhausted block 1 ; .ICTRU==:21, not trapping to user (?) block 1 ; .ICNXP==:22, not trapping nonexistent page referenced cpchan: 2,,cptrap ; ^P trap on channel 23 frkchn: 3,,frtrap ;[186] Fork interrupt on channel 24 cychan: 3,,cytrap ;[187] ^Y trap on channel 25, level 3 dnchan: 3,,dntrap ;[218] For DECnet connection trap block ^d36-. dephase ifn <<.-^d36>-chntab>,< ;;Did we get this right? printx Channel definitions are wrong end ;;Just stop and get this fixed > intern frkchn ;[186] Used by K20NET remark bits for certain channels frkchb==:1b ;[186] Bit for fork channel timchb==:1b ;[186] Bit for TIMER% channel emacro < sigchb==:1b ;[203] Bit for macro reparse issues channel >;;emacro dnchb==:1b ;[218] Bit for DECnet connection channel extern dntrap ;[218] DECnet connection handler is in k20net ;[218] DECnet connect interrupt field (ALL OTHERS MUST BE OFF!!!) dncfld==:fld(dnchan,mo%cdn)!fld(.mocia,mo%ina)!fld(.mocia,mo%dav) ;[218] DECnet disconnect interrupt field (EVERYTHING MUST BE OFF!!!) dndfld==:fld(.mocia,mo%cdn)!fld(.mocia,mo%ina)!fld(.mocia,mo%dav) subttl timeit -- Creates a TIMER% to pop after an elapsed time ; Set a timer. Call with t1/ Address of where to go upon timout. ; ;[212] All timeouts are pre-computed to milliseconds; bums the imuli ; and allows more granular control which is good for testing ; ;[218] Can not pass .infin in t2 (with a hrloi t2, 377777, for ; example) because the math in .TIMBF (just after TIMDL2: in ; TIMER.MAC) doesn't come out correctly. Use .TIMAL, instead as ; this will remove all timers. ; ; The fact that it removes a job run time limit need not bother ; Kermit as Kermit never sets this, it is fork unique and is set ; directly by BATCON on job creation before Kermit is anywhere ; near in user memory. ; ; N.B., Note the order of the TIMER% and AIC% calls alltim: xwd .fhslf, .timal ;[218] Remove ALL timers for this fork 0 ;[219] Just in case it wants this extern adjtim, ldav ; Moved to K20TIM timeit: entry timeit ; Inform LINK of our location and necessaries extern stimou, intstk, intpc, timerx, curtim skipg stimou ;[43] Doing timeouts? ret ;[43] No, skip this. pop p, t2 ; Get the return address off the stack. movem p, intstk ; Save the stack pointer push p, t2 ; Put the return address back hrr t2, t1 ; Make interrupt PC point to time out addr. movem t2, intpc ; Save the PC. dmove t1, alltim ;[218] Remove any previous TIMER%'s, FIRST TIMER ifje. r ;[194] Catch and ignore error movem t1, ltimde ;[194] Store last timer delete error aos timerx ; Count any error. endif. ;[194] remark ;[218] THEN set the new timer setz t1, ;[130] Get 1-minute load average. call ldav ;[130] move t2, stimou ;[130] Minimum acceptable. call adjtim ;[128] Adjust based on load average. movem t2, curtim ;[131] Remember this for reporting. move t1, [ .fhslf,,.timel ] ; Our process and time from now. movx t3, tmchan ;[218] Load timer channel TIMER ifje. r ;[194] Catch and ignore error movem t1, ltimcr ;[194] Store last timer creation error aos timerx ; If we get an error, count it. else. ;[218] Otherwise, worked remark ;[218] So safe to turn on the channel dmove t1, [ .fhslf ;[218] This fork timchb ] ;[218] TIMER% channel AIC ; Turn the channel on ifje. r ;[194] Catch and ignore error movem t1, laicer ;[194] However, remember it aos aicx ;[194] and count it endif. ;[218] endif. ;[194] ret subttl timeon - Create a TIMER% to pop after an elapsed time ; Set a timer based in input parameter ; ; Call: ; ; t1/ Address of where to go upon timout. ; t2/ Time in milliseconds to wait ; ; N.B., All timeouts are pre-computed to milliseconds and these are ; not load average adjusted because that is the responsibility of ; the caller. The reason for this is, if you are waiting on a ; network interupt, then the remote system is the major source of ; delay, not the local one. ; ; Note the order of the TIMER% and AIC% calls timeon: entry timeon ; Inform LINK of our location and necessaries move t4, t2 ;[218] Let's just get the wait out of the way pop p, t2 ; Get the return address off the stack. movem p, intstk ; Save the stack pointer push p, t2 ; Put the return address back hrr t2, t1 ; Make interrupt PC point to time out addr. movem t2, intpc ; Save the PC. dmove t1, alltim ;[218] Remove any pending timers, FIRST TIMER ifje. r ;[194] Catch and ignore error movem t1, ltimde ;[194] Store last timer delete error aos timerx ; Count any error. endif. ;[194] remark ;[218] THEN set the new timer move t1, [.fhslf,,.timel] ; Our process and time from now. move t2, t4 ;[218] Load hard wall time movx t3, tmchan ;[218] Load timer channel TIMER% ifje. r ;[194] Catch and ignore error movem t1, ltimcr ;[194] Store last timer creation error aos timerx ; If we get an error, count it. else. ;[218] Otherwise, worked remark ;[218] So safe to turn on the channel dmove t1, [ .fhslf ;[218] This fork timchb ] ;[218] TIMER% channel AIC% ; Turn the channel on ifje. r ;[194] Catch and ignore error movem t1, laicer ;[194] However, remember it aos aicx ;[194] and count it endif. ;[194] endif. ;[194] ret subttl TIMOFF - Shut off TIMER channel, clear all timers ; N.B., Note order of DIC% and TIMER%!! timoff: entry timoff ;[194] Identify our location to LINK skipg stimou ;[43] Doing timeouts? ret ;[43] No, skip this. timdel: entry timdel ;[218] Force a timer delete saveac ; Yes, save these ACs. dmove t1, [ .fhslf ;[218] This fork timchb ] ;[218] TIMER% channel DIC% ;[194] Shut off before timer can pop! ifje. r ;[194] Catch and ignore error movem t1, ldicer ;[194] However, remember it aos dicx ;[194] and count it endif. ;[194] dmove t1, alltim ;[218] Whack any and all pending timers TIMER ifje. r ;[194] Catch and ignore error movem t1, ltimde ;[194] Store last timer delete error aos timerx ; Count any error. endif. ;[194] ret subttl caltcb -- Calculate TIMER% channel bit repeat 0,< ;[218] ; Returns the right bit for the timer channel based on the channel ; number (which is filled in by LINK) in t2, ready for AIC%/DIC% Replaced: skipn t2, tmcbit ; Load the TIMER channel bit call caltcb ; Unless we don't know it, yet With: dmove t1, [ .fhslf ;[218] This fork timchb ] ;[218] TIMER% channel caltcb: skipe t2, tmcbit ; Did we already do this? ret ; Yes, get out of here saveac ; Save any fork handle move t1, tmcnum ; Pick up TIMER% channel number move t2, bitnum(t1) ; Convert to a bit, quickly movem t2, tmcbit ; Save for later reuse ret ; Finally done tmcnum: tmchan ; Timer channel number thisbt==1b0 ; Start out at bit zero for channel 0 bitnum: intern bitnum ; Also used in k20net xlist ; No need to see all that blat repeat ^d36, < ;;Iterate through every possible channel thisbt ;;Drop in this channel's bit thisbt== ;;Shift over a bit position > list ; Turn listing back on >;[218] subttl TMTRAP -- Timer interrupt handler. ; N.B., Using a hrli to break out of a JSYS may not a good idea as it ; blows away all the flags which somebody might want tmtrap: entry tmtrap ; Identify our location for LINK extern ntimou ; And our additional necessaries push p, t1 ; Get a work AC. move t1, intpc ; Get the PC we want. txo t1, pc%usr ;[194] ;[132] Set user mode to escape from any jsys. movem t1, pc1 ; Restore as if we came from there. pop p, t1 move p, intstk ; Pop any junk off the stack. aos ntimou ; Count the timeout. DEBRK subttl Initialize the Priority Interrupt system. pinit: entry pinit ;[186] Called at start up dmove t1, [ .fhslf ; This fork. levtab,,chntab] ; Say where our tables are. SIR% ;[186] Set Interrupt routines %jserr(,) ;[186] Or not EIR% ; Enable the interrupt system. %jserr(,) ;[186] Or not ret subttl Enable for Control-C trapping ; Turn Control-C trap on. Sets things up so that ^C will return control ; to the instruction FOLLOWING the the call to this routine, with the ; stack fixed up appropriately, e.g. ; ; call ccon ; Turn on ^C trap ; jrst foo ; What to do if ^C is typed. ; move x, y ; Execute this after the call to CCON. ; ; Returns +2 always. ; ;[187] Rewritten to work under batch and not do so many RPCAP%'s and EPCAP%'s $ccn==2 ; Number of ^C's to get out of ^C trap. ccon: entry ccon extern ccfail ;[187] ifmge. ccfail ;[187] Ever tried this? move t3, capas ;[187] We have, so load what we got jrst ccon2 ;[187] And just go use it endif. ;[187] End case first time through skipe t3, capas ;[187] Did we ever look? jrst ccon2 ;[187] We did, use what we got movei t1, .fhslf ; Read current process capabilities. RPCAP% ;[187] Let's have a peek at what we have ifje. s ;[187] Catch and suppress error dmove t2, mycaps ;[187] Use what we first got endif. ;[187] And carry on! ifmn. ;[187] Batch frob? txz t3, sc%ctc ;[187] Say we don't have ^C turned on txz t2, sc%ctc ;[187] And that we can't get it, either aos ccfail ;[187] Flag other code to not try again movem t3, capas ;[187] Stomp the process enabled capas jrst ccon2 ;[187] Skip the rest of this cruft endif. ;[187] End batch job case ;[187] Normal timesharing job from here ifxn. t2, sc%ctc ;[187] OK, so can we turn it on? andxe. t3, sc%ctc ;[187] And is it currently *NOT* on? txo t3, sc%ctc ;[187] So try to turn it on EPCAP% ;[187] and do the request erjmps .+1 ;[187] Catch and suppress error RPCAP% ;[187] Read back; monitor may silently ignore ifje. s ;[187] Catch and suppress error dmove t2, mycaps ;[187] Use what we first got txz t3, sc%ctc ;[187] Don't chance it being on endif. ;[187] And get on with it endif. ;[187] End case possible enabling attempt movem t3, capas ; Save them. ifxe. t3, sc%ctc ;[187] Did it NOT come on?? aose ccfail ;[187] Only complain one single time anskp. ;[187] Already tried txmsg <% Kermit-20: Can't enable ^C capability--use ^G instead > ;[187] Complain and advise endif. ;[187] End case post enable analysis ccon2: movei t1, $ccn ; Initialize ^C count to this. movem t1, ccn movem p, psave ;[27] Save stack pointer. move t1, (p) ;[27] And what it points to... movem t1, psave2 ;[27] dmove t1, [ .fhslf ;[187] Now, for this fork, 1b ] ;[187] activate channel 1 (^C channel) AIC ; ... %jserr (,) ;[187] move t1, [.ticcc,,1] ;[187] Let's assume we have ^C. txnn t3, sc%ctc ;[187] Unless we don't... hrli t1,.ticcg ;[187] Something familiar, ding! hlrzm t1, ccichr ;[219] Store whatever we picked ATI %jserr (,) ;[187] retskp subttl Turn Control-C trap off ccoff: entry ccoff ;[186] extern srvflg ;[186] skipe srvflg ;[81] Being a server? ret ;[81] Yes, so don't turn off the ^C trap. ; Entry point for REALLY turning it off, even if server. ccoff2: entry ccoff2 ;[186] saveac ; Save these. setzm ccn ; Put ^C count back to 0. dmove t1, [ .fhslf ;[186] This fork. 1b ] ;[186] Deactivate channel 1. DIC %jserr (,) ;[187] remark ;[219] Take the character off the channel move t1, ccichr ;[219] Load the interrupt character we used DTI ;[219] Pull it %jserr (,) ;[187] ccoff3: move t4, capas ; Get capabilities. move t1, [rt%dim!.fhjob] ;[219] This job, both masks txnn t4, sc%ctc ;[219] But!! Could we have set job wide? move t1, [rt%dim!.fhslf] ;[219] This process, both masks RTIW% ;[187] Get the current interrupt mask %jserr (, r) ;[187] ifxn. t4, sc%ctc ;[187] Did we have ^C? txz t2, 1b<.chcnc> ; for ^C... (^C = ASCII 3 = bit 3) txz t3, 1b<.chcnc> ;[219] Differed ^C else. ;[187] No, so must be on ^G txz t2, 1b<.chbel> ;[187] for ^G... (^G = ASCII 7 = bit 7) txz t3, 1b<.chbel> ;[219] Differed ^G endif. ;[187] Finally have something to set STIW% ;[187] Finally fix up the interrupt mask %jserr (, r) ;[187] ret subttl Turn on ^A, ^X, and ^Z interrupts ;[59] ^A, ^X, and ^Z interrupt control added as part of edit 59. caxzon: entry caxzon ;[186] extern caseen, cxseen ;[186] setzm cxseen ; Say we haven't seen a ^X yet, setzm czseen ; nor a ^Z. setzm caseen ; ... skipn local ; Only do this if local! ret dmove t1, [ .fhslf ;[194] This fork. 1b!1b!1b] ;[194] Turn on the channels. AIC% move t1, [.ticca,,cachan] ; Put ^A on its channel. ATI% move t1, [.ticcx,,cxchan] ; Put ^X on its channel. ATI% move t1, [.ticcz,,czchan] ; And ^Z on its. ATI% ret subttl Turn ^M, ^P interrupts on cmpon: entry cmpon ;[186] extern cmseen ;[186] extern cpseen ;[186] dmove t1, [ .fhslf ;[194] This fork. 1b!1b ] ;[194] These channels. AIC ; Activate interrupt system. move t1, [.ticcm,,cmchan] ; Assign ^M to this channel. ATI setzm cmseen move t1, [.ticcp,,cpchan] ; Assign ^P to this one. ATI setzm cpseen ret subttl Turn ^Y interrupts on ;[211] All clrbuf enhancements cyon: entry cyon ; World callable setzm cyseen ; Haven't seen a Control-Y, yet dmove t1, [ .fhslf ; This fork and 1b ] ; this channel AIC% ; Activate interrupt channel %jserr (,r) ; Failed it move t1, [.ticcy,,cychan] ATI% ; Assign ^Y to this channel. %jserr (,r) ; Failed that retskp ; Return success ;[211] End clrbuf enhancement subttl Turn off ^A,^X,^Z interrupts caxzof: entry caxzof ;[186] setzm cxseen ; Turn off the flags setzm czseen ; ... setzm caseen ; ... skipn local ; Nothing to do if remote, the interrupts ret ; weren't on anyway. dmove t1, [ .fhslf ;[186] Turn off ^A,^X,^Z traps. 1b!1b!1b ] ;[186] Turn off these channels. DIC% ; ... movx t1, .ticca ;[219] Pull ^A DTI% movx t1, .ticcx ;[219] Pull ^X DTI% movx t1, .ticcz ;[219] Pull ^Z DTI% move t1, [rt%dim!.fhslf] ;[219] This process, both masks RTIW% ; Fix up the interrupt mask for ^A,^X,^Z txz t2, <1b<.chcna>!1b<.chcnx>!1b<.chcnz>> ;[194] txz t3, <1b<.chcna>!1b<.chcnx>!1b<.chcnz>> ;[194] STIW% ; ... %jserr (,) ret subttl Turn ^M, ^P interrupts off cmpoff: entry cmpoff ;[186] dmove t1, [ .fhslf ; Turn off ^M trap. 1b!1b ] ; Turn off channels. DIC ; ... setzm cmseen ;[219] Indicate that there will setzm cpseen ;[219] be no more of these movx t1, .ticcm ;[219] Pull ^M DTI movx t1, .ticcp ;[219] Pull ^P DTI move t1, [rt%dim!.fhslf] ;[219] This process, both masks RTIW ; Fix up the terminal interrupt mask txz t2, <1b<.chcrt>!1b<.chcnp>> ;[194] for ^M, ^P txz t3, <1b<.chcrt>!1b<.chcnp>> ;[219] Differed ^M, ^P STIW %jserr (,) ret subttl Turn ^Y interrupt off ;[211] Begin clrbuf enhancement cyoff: entry cyoff ; Make globally available (to k20par) dmove t1, [ .fhslf ; This process 1b ] ; The Control-Y channel DIC% ; Disable its interrupt channel %jserr(,) ; Or not, but carry on setzm cyseen ; Indicate that there will be no more ^Y's movx t1, .ticcy ;[219] Pull ^Y DTI% ;[219] Deactivate Terminal Interrupt move t1, [rt%dim!.fhslf] ;This process, both masks RTIW% ; Read our entire terminal interrupt word %jserr(,r) ; Or not... Go no further txz t2, 1b<.chcny> ; Turn off control-Y from immediate mask txz t3, 1b<.chcny> ; Turn off control-Y from differred mask STIW% ; Finally get the mask cleared up %jserr (,) ; Or not... ret ;[211] End clrbuf enhancement subttl Control-C trap handler cctrap: sosle ccn ; Count the ^C's. DEBRK% ; If they haven't typed enough, just resume. call timoff ; Turn off any timer. txmsg <^C > ;[186] move p, psave ;[27] Make sure stack pointer is right. move t1, psave2 ;[27] And stack top. movem t1, (p) ;[27] txo t1, pc%usr ;[187] Don't whack the other flags movem t1, pc1 ; Put this place into our PC. pop p, t1 ;[80] Don't need it on the stack any more. DEBRK% ; Resume where stack pointer points. subttl Control-A trap handler ;[61] Give brief progress report at terminal. catrap: remark ;[186] Lots of status variables in k20mit extern bctu, bytsiz, rcving, ebqflg extern rptflg, rptot, rtchr, sptot, stchr extern pagcnt, files, nnak push p, t1 ; Save all ACs we might use. push p, t2 push p, t3 skipn rcving ; Sending or receiving a file? jrst catrp1 ; No. movei t1, .priou ; Say the filename ifmg. rcving smsg (<^A Sending >) ; Yes, one... else. smsg (<^A Receiving >) ; ...or the other. endif. movei t1, .priou ; Say the filename skipg t2, filjfn ;[193] Have file JFN? ifskp. ;[193] Yeah, try to say something about it caie t2, .nulio ;[193] Dumping it? ifskp. ;[193] That's easy! dmove t2, nul4 ;[252] Always same name SOUT% ;[193] Counted SOUT% is faster erjmps .+1 ;[193] else. ;[193] Otherwise, do it for real setz t3, t4 ;[194] JFNS% erjmps .+1 ;[193] endif. ;[193] End NUL: special case endif. ;[193] End case file JFN handling txmsg <, file bytesize > ; File bytesize numout bytsiz ;[194] Sets t1 to .priou ifmge. rcving ; I/O bytesize, only if sending dxtext (t2,<, i/o bytesize >) ;[194] SOUT% ;[193] Counted SOUT% is faster erjmps .+1 ;[193] movei t2, ^d7 ;[194] skipn itsfil ;[75] skipe ebtflg movei t2, ^d8 ;[194] (!!) movei t3, ^d10 ;[194] NOUT% ;[194] erjmps .+1 ;[194] endif. ;[194] hrroi t1,crlf ;[194] PSOUT% ;[194] ifmn. itsfil ;[75] txmsg < (ITS binary)> ;[75] endif. ifmn. ebqflg ;[88] txmsg < (8th-bit prefixing)> ;[88] endif. ifmn. rptflg ;[92] txmsg < (compression)> ;[92] endif. txmsg < (block check type > ;[98] numout bctu ;[98] movei t1, ")" ;[98] PBOUT ;[98] skipg t2, filjfn ;[193] Have file JFN? ifskp. ;[193] Yeah, don't lets say something silly cain t2, .nulio ;[193] Are we dumping it? anskp. ;[193] We are, so bag this because not PMAP%ing anything txmsg < At page > ; What page we're at. move t2, pagno aos t2 movei t1, .priou ;[194] movei T3, ^d10 ;[194] NOUT% erjmps .+1 ;[253] Ignore the error so we don't skip ifmge. rcving ;[194] Out of how many txmsg < of > ; (which we know only if we're sending) numout pagcnt endif. ;[194] endif. ;[194] End case of a file that isn't NUL: catrp1: txmsg < Files: > ; Say how many files, numout files txmsg <, packets: > ; packets, ifmg. rcving ;[194] Positive means sending ... numout sptot ;[194] else. ;[194] numout rptot ;[194] endif. ;[194] txmsg <, chars: > ; characters, ifmg. rcving ;[194] Positive means sending .... move t2, stchr add t2, schr else. ;[194] Otherwise, receiving move t2, rtchr add t2, rchr endif. ;[194] movei t1, .priou ;[194] movei t3, ^d10 ;[194] NOUT% ;[194] erjmps .+1 ;[253] Catch and suppress error so we can skip txmsg < NAKs: > ; NAKS & timeouts. numout nnak txmsg <, timeouts: > numout ntimou txmsg < > ; End up with a CRLF pop p, t3 ; Restore ACs. pop p, t2 pop p, t1 DEBRK% ; Resume. subttl Control-X trap handler ;[59] cxtrap: extern source, dirch ;[186] setom cxseen ; Just set the flag & echo the character. push p, t1 push p, t2 move t1, source ;[140] What's the source of our data? cain t1, dirch ;[140] Is it a directory listing? setom czseen ;[140] If so, set C-Z flag, too. txmsg <^X// > pop p, t2 pop p, t1 DEBRK% subttl Control-Z trap handler ;[59] cztrap: setom czseen ; Just set the flag & echo the character. push p, t1 push p, t2 txmsg <^Z// > pop p, t2 pop p, t1 DEBRK subttl Control-M and -P trap handlers ;[165] cmtrap: extern cmseen, cmloc ;[186] setom cmseen ; Set ^M flag push p, t1 ; Echo CRLF push p, t2 txmsg < > move t1, cmloc ; Get place to resume. jrst cmptr2 cptrap: extern cpseen ;[186] extern cploc setom cpseen ; Set ^P flag push p, t1 ; Echo ^P push p, t2 txmsg < ^P> move t1, cploc ; Get place to resume. cmptr2: txo t1, pc%usr ;[187] Get into user mode movem t1, pc2 ; Resume at desired PC. pop p, t2 pop p, t1 DEBRK subttl Control-Y interrupt handler ;[211] All part of clrbuf changes ;[218] Not anymore!! chgsec(code,data) ; Need some storage cyseen: intern cyseen ; Global for k20par and k20net block 1 ; Needs the storage... retsec ; Back to generating code extern $clrbs ; Reported location of loop sleep (DISMS%) extern $waitj ;[218] Reported location of DECnet connection wait cytrap: push p, t1 ; Save an accumulator push p, cx ; Save for frame building hrrz t1, pc3 ; Pick up our interrupted location (no flags) block. ; Enter block context for better control flow cain t1, $clrbs ; In the buffer clear sleep? retskp ; Yes, go dink his PC cain t1, $waitj ;[218] In the DECnet connection wait? retskp ;[218] Yes, dink that PC, too endbk. ; End of block context ifskp. ;[218] A known break location!! hll t1, pc3 ; Pick up interrupted flags txo t1, pc%usr ; Get into user mode movem t1, pc3 ; Change DEBRK% action endif. ; That's all, really pop p, cx ; Restore frame pointer pop p, t1 ; Restore temporary aos cyseen ; Set ^Y flag DEBRK% ;[211] End clrbuf changes subttl String convert from eight bit to controlified 7 bit ;[209] Begin code insertion ; Like echo, except uses VASTLY less JSYS calls and CPU time. ; However, because we're doing eight bit bytes, the table driven MOVST ; approach uses vastly more memory. That's fine for modern usage, ; which has over 30 times the memory for a few hobbiest users. ; ; Parity bits are completely stripped, if you want parity, you must ; check this, beforehand. ; Define a macro to do random character substitutions define cncsub(chr1,sub1,chr2,sub2,tab,%org) < ifb ,< ;;Don't put things in bad places printx ?Must have a table to store character pair end ;;Switch to pass 2 > %org==. ;;Remember where we are .xcref %org ;;Don't want in CREF, yuck! suppress %org ;;Generate symbol value largely useless reloc tab+<<&177>_-1> ;;Gets us to the correct halfword pair xwd sub1,sub2 ;;Emit the appropriate pair reloc %org ;;Get back to where we were .xcref %org ;;Stay out of my cross reference! if2 < purge %org > ;;Don't need after pass two, either >;;cncsub chgsec(code,const) ; Put translate table in the constants psect remark ; And on to define our piggy tables remark Control Character stop table, first half %cncha==.chnul ; Control character; starts out at .CHNUL suppress %cncha ; Don't need in symbol table listing .xcref %cncha ; Nor in cross reference cnrtab: remark ; Appropriately trigger on control chars %tborg==. ; Mark beginning of table suppress %tborg ; Don't need in symbol table listing .xcref %tborg ; Nor in cross reference xlist ; Don't need to see this blat repeat ^d<<128>_-1>,< ;;Fill table with all characters, initially xwd %cncha,<%cncha+1> ;;They're fine unless marked later %cncha==%cncha+2 ;;Step to next pair .xcref %cncha ;;Keep off of cross reference >;;repeat ^d64 ;;Do all 128 characters list ; Restart the blather %eocnr==. ; Remember end of control table suppress %eocnr ; Don't need in symbol table listing .xcref %eocnr ; Nor in cross reference reloc %tborg ; Get back to the beginning of the table .xcref %tborg ; Keep off cross reference xlist ; Any control character will stop us %cncha==.chnul ; start out at .CHNUL, again .xcref %cncha ; Keep off cross reference repeat ^d16,< ;;through Control-Z xwd trmcod!%cncha,trmcod!<%cncha+1> ;;Stop on all control characters %cncha==%cncha+2 ;;Step to next pair .xcref %cncha ;;Keep off of cross reference > list ; Restart the blather remark ; Have to special case rubout cncsub("~","~",.chdel,,cnrtab) reloc %eocnr ; Get to end of first part .xcref %eocnr ; Nor in cross reference remark Control Character stop table, second half cnrt2:! remark ; Have to repeat for the eight bit part... .xcref cnrt2 ; Not used, so don't cross reference it suppress cnrt2 ; Surely not needed on the symbol table %tborg==. ; Mark beginning of table .xcref %tborg ; Nor in cross reference xlist ; Don't need to see this blat %cncha==.chnul ; Control character; starts out at .CHNUL .xcref %cncha ; Keep off listing repeat ^d<<128>_-1>,< ;;Fill table with all characters, initially xwd %cncha,<%cncha+1> ;;They're fine unless marked later %cncha==%cncha+2 ;;Step to next pair .xcref %cncha ;;Keep off of cross reference >;;repeat ^d64 ;;Do all 128 characters list ; Restart the blather %eocnr==. ; Remember end of second part of control table .xcref %eocnr ; Nor in cross reference reloc %tborg ; Get back to the beginning of the table xlist ; Save the trees!!! %cncha==.chnul ; start out at .CHNUL, again .xcref %cncha ; Keep off cross reference repeat ^d16,< ;;through Control-Z xwd trmcod!%cncha,trmcod!<%cncha+1> ;;Stop on all control characters %cncha==%cncha+2 ;;Step to next pair .xcref %cncha ;;Keep off of cross reference > list ;;Turn listing back on remark ; Have to special case rubout cncsub("~","~",.chdel,,cnrt2) reloc %eocnr ; Get to back to end of table .xcref %eocnr ; Keep temporary off the cross-reference remark Control Character substitution table, first half ; The translate table assumes that exactly a SINGLE character is ; to be translated and that this is only a control character. crsubt: remark ; Control character substitution table %tborg==. ; Mark beginning of table .xcref %tborg ; Keep off cross reference xlist ; Don't need to see this blat %cncha==.chnul ; Control character; starts out at .CHNUL repeat ^d<<128>_-1>,< ;;Fill table with all characters, initially xwd trmcod!%cncha,trmcod!<%cncha+1> ;;They're all bad! %cncha==%cncha+2 ;;Step to next pair .xcref %cncha ;;Keep off of cross reference >;;repeat ^d64 ;;Do all 128 characters list ; Restart the blather %eocnr==. ; Remember end of control table .xcref %eocnr ; Nor in cross reference reloc %tborg ; Get back to the beginning of the table .xcref %eocnr ; Keep off cross reference xwd "@","A" ; .chnul goes to ^@, .chcna goes to ^A xlist ; End of string on .CHNUL, expand others %cncha=="B" ; Rest begin from Capital B repeat ^d15,< ;;through Capital Z xwd %cncha,<%cncha+1> ;;All translate and do not stop %cncha==%cncha+2 ;;Step to next pair .xcref %cncha ;;Keep off of cross reference > list remark ; A few conventions cncsub(.chcnz,"Z",.chesc,"$",crsubt) cncsub("~",,.chdel,"?",crsubt) reloc %eocnr ; Get to end of first part .xcref %eocnr ; Nor in cross reference remark Control Character expansion table, second half crsu2:! remark ; Used for eight bits, ignores parity .xcref crsu2 ; Not used, so don't cross reference it suppress crsu2 ; Surely not needed on the symbol table %tborg==. ; Mark beginning of table .xcref %tborg ; Nor in cross reference xlist ; Don't need to see this blat %cncha==.chnul ; Control character; starts out at .CHNUL repeat ^d<<128>_-1>,< ;;Fill table with all characters, initially xwd trmcod!%cncha,trmcod!<%cncha+1> ;;They're all bad! %cncha==%cncha+2 ;;Step to next pair .xcref %cncha ;;Keep off of cross reference >;;repeat ^d64 ;;Do all 128 characters list ; Restart the blather %eocnr==. ; Remember end of control table .xcref %eocnr ; Nor in cross reference reloc %tborg ; Get back to the beginning of the table .xcref %eocnr ; Keep off cross reference xwd "@","A" ; .chnul goes to ^@, .chcna goes to ^A xlist ; End of string on .CHNUL, expand others %cncha=="B" ; Rest begin from Capital B repeat ^d15,< ;;through Capital Z xwd %cncha,<%cncha+1> ;;All translate and do not stop %cncha==%cncha+2 ;;Step to next pair .xcref %cncha ;;Keep off of cross reference > list remark ; A few conventions cncsub(.chcnz,"Z",.chesc,"$",crsu2) cncsub("~",,.chdel,"?",crsu2) reloc %eocnr ; Get to back to end of table .xcref %eocnr ; Keep temporary off the cross-reference remark After 2nd pass, purge tempories if2 < purge %cncha,%eocnr, %tborg purge cnrt2, crsu2> retsec ; Get out of the constants section remark Actual code to convert the string ; Call: ; ; t1/ length of string to convert ; t2/ point 8, somewhere ; String of eight bit characters to convert ; ; Return: ; ; +1/ Something got ill ; +2/ Success! String completely converted (or as much of it as we could) ; ; t1/ Remaining length ; How much is left of source string ; t2/ point 7, somewhere else ; Converted controlified string ; t3/ negative length ; Ready for SOUT% ; t4/ point 8, updated ; Where we stopped in the source string trnchr==^d300 ; Can handle this many characters at once chgsec(code,data) ; Need some storage for buffers, etc. trnbuf: intern trnbuf ;[221] Let k20pdc see it, too block +1 ; Space for 7 bit characters retsec ; Re-open executable code c87mov: movst 0,cnrtab ; Actual extend instruction being executed .chnul ; Fill character is end of string s8ccv7: entry s8ccv7 ; String eight controlified convert to seven ifle. t1 ; Gubbish? move t4 ,t2 ; Return whatever they gave us setzb t2, t3 ; Then say there is nothing to SOUT% ret ; Fail the call endif. saveac ; Save more piggy registers remark q2 aliases t5 ; So t5 must be saved remark t1, t2 ; Already have source length and pointer dmove t4, [ trnchr ; Load maximum length of destination point 7, trnbuf ] ; Point to destination setzb t3, q2 ; Force section local pointers txz t1, S!N!M ; Whack translation flags do. ; Enter loop context txo t1, S ; Set significance flag (start translating) extend t1, c87mov ; Move the string, testing for control chars %jserr (, r) ; Pass any machine error back up txze t1, N ; Bumped into a control character? ifskp. ; We did not; exhausted source? txz t1, S!N!M ; Clear all the flags jumple t1, endlp. ; No more source? We're done %ermsg (,r) endif. ; Otherwise, we DID hit a control character jumple t4, endlp. ; Done if no more destination txz t1, S!N!M ; Clear all the flags call cnchar ; Otherwise, process a control character ret ; Failed, just stop right now jumple t4, endlp. ; Done if no more destination space jumpg t1, top. ; Keep translating characters until no more enddo. ; Exit loop lexical context remark t1, ; Still has remaining source length move t3, t4 ; Load remaining destination subi t3, trnchr ; Calculate negative destination length move t4, t2 ; Updated source pointer is here move t2, [ point 7, trnbuf ] ; Point to destination retskp ; Successful return remark Convert control character to ASCII equivalent ; Assumes s8ccv7 register context and is intmately linked with it ; ; t1/ Remaining length of source string ; t2/ point 8, to current location in source string ; t3/ Address portion of 30 double word pointer, MUST be zero ; t4/ Remaining length of destination string ; q1/ point 7, to current location in destination string ; q2/ Address portion of 30 double word pointer, MUST be zero ; ; Note a subtle difference between this and the escchr routine, which ; is used to implement C backslash expansion and translation. In that ; case, the backslash is skipped and the character afterwards is ; translated (or converted into a number). ; ; The enclosing MOVST is now pointing AFTER the control character and ; has updated the source remaining total to account for the fact that ; it has been consumed. However, no such thing happens to the ; destination pointer and count because nothing was ever deposited. ; ; Thus some fix-up is necessary prior to excuting the MOVST below so ; that the correct character is fetched. Similarly, the source ; counter should NOT be fixed while the destination counter MUST be ; fixed. ; ; It's the kind of edge case that you really have to single step ; through to see what the machine is actually doing... ; ; For the two cases which involve an expansion, no fix up is ; necessary, because we're skipping the control character and ; depositing fixed strings. chngch: movst 0,crsubt ; Actual extend instruction being executed .chnul ; Fill character is end of string cnchar: saveac ; Some extra scratch for calculations ldb q3, t2 ; Load character that stopped us cain q3, .chcrt ; Carriage return? callret schcrt ; Hit special carriage return expansion cain q3, .chlfd ; Line feed? callret schlfd ; Hit special line feed expansion movei q3, "^" ; Load circumflex character idpb q3, q1 ; Deposit in destination sojle t4, r ; Account for it and return if full txz t1, N!M!S ; Stomp flags so math and EXTEND work move q3, t1 ; Save source length over extend move q4, t4 ; Ditto destination length seto t1, ; Have to back up the source pointer to adjbp t1, t2 ; BEFORE the offending control character move t2, t1 ; Use updated pointer as new source pointer move t1,[ S!<^d1> ] ; Only looking at a SINGLE character of source movei t4,^d1 ; Don't allow any foolish filling... extend t1, chngch ; Change this SINGLE character %jserr (, r) ; Pass error up ifxn. t1, N ; Invalid control character?? emsg ldb t1, t2 ; Pick up what didn't work PBOUT% ; Show us hrroi t1, crlf ; Load end of line PSOUT% ; Print it move t1, q3 ; Restore unaltered source length move t4, q4 ; Restore unaltered destination length ret ; Failure return endif. move t1, q3 ; Restore source count, which is already correct sosge t4, q4 ; Fix destination count for character deposited ret ; Ran out of buffer space retskp ; Won!! subttl Special Control Character logic ; Expands carriage return and line feed so we ; don't overprint or get yucky wrap arounds ; ; Both assume: ; ; cnchar working context ; ; t1/ Remaining length of source string ; t2/ point 8, to current location in source string ; t3/ Address portion of 30 double word pointer, MUST be zero ; t4/ Remaining length of destination string ; q1/ point 7, to current location in destination string ; q2/ Address portion of 30 double word pointer, MUST be zero ; ; The idea is that the user sees something like ^M ; ^J splitting lines. Repeated Control-J's are not ; as graceful, but this is just for buffer review subttl Carriage expansion ; Carriage Return puts the control character at END of expansion crtexp: byte (7) "^", "M", .chcrt, .chnul, .chnul byte (7) "^", "M", .chcrt, .chlfd, .chnul crtptr: ^d3 ; String is three bytes long point 7, crtexp ; Point to expansion text crtptl: ^d4 ; String is four bytes long point 7, crtexp+1 ; Point to text with line feed movcrt: movslj 0, 0 ; No accumulator; E1 unused .chnul ; Fill with nul's schcrt: remark q3, q4 ; Already saved by cnchar saveac ; Needs another register dmove q3, t1 ; Save current source ifg. q3 ; Any remaining input? ildb t1, t2 ; Yes, pick up the next character caie t1, .chlfd ; A line feed?? ifskp. ; It is, so will be handled by schlfd dmove t1, crtptr ; Load expansion length and pointer else. ; Otherwise, drop in a line feed, too dmove t1, crtptl ; Load expansion length and pointer endif. ; End case overwrite checking else. ; Otherwise, Carriage Return was last character dmove t1, crtptl ; So assume no line feed endif. ; End case input buffer checking sub t4, t1 ; Subtract from remaining jumple t4, r ; Fail if overflowed the beffer ; Otherwise, safe to move move q5, t4 ; Preserve the new length move t4, t1 ; Same as source, so no fill extend t1, movcrt ; Copy it all over, wee!! %jserr (,r) ;?? dmove t1, q3 ; Restore source move t4, q5 ; Restore fixed length retskp ; Return, successfully expanded subttl Line feed expansion ; Line feed expansion puts the control character BEFORE expansion lfdexp: byte (7) .chlfd, "^", "J", .chnul, .chnul lfdptr: ^d3 ; String is three bytes long point 7, lfdexp ; Point to expansion text movlfd: movslj 0, 0 ; No accumulator; E1 unused .chspc ; Fill with spaces schlfd: remark q3, q4 ; Already saved by cnchar saveac ; Needs another register dmove q3, t1 ; Save current source dmove t1, lfdptr ; Load expansion length and pointer sub t4, t1 ; Subtract from remaining jumple t4, r ; Fail if overflowed the beffer ; Otherwise, safe to move move q5, t4 ; Preserve the new length move t4, t1 ; Same as source, so no fill extend t1, movlfd ; Copy it all over, wee!! %jserr (,r) ;?? dmove t1, q3 ; Restore source move t4, q5 ; Restore fixed length retskp ; Success ;[209] End code insertion subttl String copy measurement, 9:10pm Thursday, 21 July 2022 remark Delimma: What is the fastest way to copy strings? ; A question had sometimes come up for debate as to whether the string ; instructions gave any real speed up, the concern being whether the ; set up cost of conditioning the register file and restoring it was ; worth using them. ; ; Three cases were set up, the first being a typical ildb/idpb loop ; with the second being a use of movst to move the string until a nul ; was detected. The third was a mixture; the keywords being moved ; with a loop and the macro expansions being moved with the movst. ; This was expected to be have the best performance as macro names ; (I.E., keywords) are typically not very long. ; ; 11 macros were defined, using a total of 80 characters of macro name ; space and 1365 characters of macro text space. The results are ; suprising: ; ; Case Elapsed CPU All ; 1 1.360 1.320 times ; *2 .340 .320 are in ; 3 1.020 .980 milliseconds ; ; By a considerable margin, using solely the movst won. This is why ; it is used exclusively in the macro garbage collector. Going ; forward, other cases may be identified in Kermit where it can be ; used. ; ; Older programs which use SOUT% to transfer strings would no doubt ; benefit substantially. subttl Table to move an ASCIZ string chgsec(code,const) ; Get into the constants segment %azchr==.chcnb ; Table starts at Control-B suppress %azchr ; Don't need in symbol table listing .xcref %azchr ; Nor in cross reference asztab: xwd eoscod!.chnul, .chcna ; Only stops on a NUL xlist ; Don't need to see this blat repeat ^d<<128-2>_-1>,< ;;Fill the rest of the table xwd %azchr,<%azchr+1> ;;They're all fine %azchr==%azchr+2 ;;Step to next pair .xcref %azchr ;;Keep off of cross reference >;;repeat ^d63 ;;Do the other 126 characters list ; Restart the blather if2 < purge %azchr > ; Temporary not needed after 2nd pass retsec ; Get out of the constants section, into code subttl Move an ASCIZ string ; Call: ; ; t1/ Source BP (assumed section local) ; t2/ Destination BP (assumed section local) ; ; Return: ; ; +1/ Always, but may complain ; ; t1/ Updated source pointer ; t2/ Updated destination pointer ; t3/ Length of string ; ; CAUTION: ; ; Like an ildb/idpb loop, this will overwrite all memory if you let it. ; Make CERTAIN that your strings are NUL terminated!!! movasc: intern movasc ; Also used by k20srv movst 0,asztab ; Move characters until hit a NUL .chnul ; Fill character mxascz==:MAXBUF ; A bizarre length (or ... ?) asczcp: entry asczcp ; Called by everybody remark ; Assumes can use these push p, q1 ; Piggy MOVST gorges on registers push p, q2 move q1, t2 ; Reposition destination for movst move t2, t1 ; Reposition source for movst setzb t3, q2 ; Force section local pointers movx t1, ; Limit source length, start significance movx t4, mxascz ; Limit destination length extend t1, movasc ; Move characters, doing useless translating nop ; Will never +1 because t1 and t4 are equal ibp t2 ; Account for .CHNUL in source move t1, t2 ; Return updated source pointer idpb q2, q1 ; Deposit a NUL at the end move t2, q1 ; Return updated destination pointer movx t3, ; Account for extra NUL byte sub t3, t4 ; Calculate length pop p, q2 ; Restore registers and beat it pop p, q1 ret subttl Historic MOVSTU Move string, uppercasing any lowercase letters. ;[245] Begin code removal ; Eats any leading whitespace. ; Call with t1/ source pointer ; t2/ destination pointer ; Returns with t1, t2 updated, t3/ character count, t4/ 0. repeat 0,< remark ; Replaced with an EXTEND instruction movstu: entry movstu seto t3, ; Counter, started at -1. movstx: ildb t4, t1 ; Get a character. jumpn t3, movsty ; Have we got at least one nonwhitespace? caie t4, 40 ; No, is this a blank? cain t4, 11 ; or a tab? jrst movstx ; One of those, skip it. movsty: cail t4, "a" ; Convert to upper case if necessary. caile t4, "z" skipa trz t4, 40 idpb t4, t2 ; Copy it. aos t3 ; Count it. jumpn t4, movstx ; Everything up to & including the first null. ret >;;repeat 0 ;[245] End code removal subttl Translation table for MOVST to UPPERcase ;[245] Begin table insertion chgsec(code,const) ; Translate tables go in constants area ; Just skips whitespace. Also, can handle 8 bit pointers, but doesn't ; do anything with a character past .chdel (177). %ascuh=trmcod!.chcnb ; ASCII values start at Control-B chrshs: xwd eoscod,trmcod!.chcna ; NUL is end of string, ^A is allowed remark ; Everything terminates, except space and tab xlist ; Don't need to see all this junk repeat ^d<<256-2>_-1>,< ;;Fill table with one to one translations xwd %ascuh,%ascuh+1 ;;Properly fill half words %ascuh==%ascuh+2 ;;Step to next pair >;;repeat ^d126 ;;Do entire 8 bit character set list ; Restart the blather %eotuh=. ; Remember end of table reloc chrshs+<<.chbsp>_-1> ; Get to backspace, horizontal tab pair xwd trmcod!.chbsp,.chtab ; Tab does NOT terminate (nor set 'N') reloc chrshs+<<.chspc>_-1> ; Get to space, exclamation point pair xwd .chspc,trmcod!"!" ; Space does NOT terminate (nor set 'N') reloc %eotuh ; Get back to end of table cleans(<%ascuh,%eotuh>) ; Don't need these temporary symbols remark Character table just UPPERcases characters, stopping on EOS %ascus=.chcnb ; ASCII values start at Control-B chrmut: xwd eoscod,.chcna ; NUL is end of string, ^A is allowed xlist ; Don't need to see all this junk repeat ^d<<256-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 ^d126 ;;Do remaining 126 pairs list ; Restart the blather %eotup==. ; Remember end of table remark ; Get to lower case section reloc chrmut+<<"`">_-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 back to end of table chrshe: movst 0, chrshs ; Skip white, but stop on NUL .chnul ; Fill character is end of string chrmup: movst 0, chrmut ; Translate table to UPPERcase .chnul ; Fill character is end of string cleans(<%ascus,%eotup>) ; Don't need these temporary symbols retsec ; Return to code section ;[245] End table insertion subttl Move string, UPPERcasing any lowercase letters ;[245] Begin code insertion ; Call: ; ; t1/ Source ASCII pointer ; t2/ Destination ASCII pointer ; ; Return: +1, always ; ; t1/ Updated source ASCII pointer ; t2/ Updated destination ASCII pointer ; t3/ Length of destination string, minus any initial whitespace ; t4/ Zero ; ; N.B., Munches initial horizontal white space (.chtab, .chspc) ; Stops on end of string, a .chnul movstu: entry movstu ; Used in K20MIT, checked in K20PAR saveac ; Piggy MOVST wants plenty registers movx q3, MAXBUF ; Load maximum length we'll do move q1, t2 ; Load destination pointer move t2, t1 ; Load source pointer setzb t3, q2 ; No non-section zero pointers move t1, q3 ; String length move t4, t1 ; Assume equal length strings remark ^-S ; Do NOT set 'S'--NOT translating!! extend t1, chrshe ; Use auto-magic and skip horizontal space until EOS nop ; Don't need to know about skip/non-skip ifxe. t1, N ; Didn't terminate with a non-whitespace? txz t1, S!N!M ; Nope, so stomp the flags remark N.B., It doesn't matter if t1 is non-zero, string was all whitespace move t1, t2 ; Return updated source move t2, q1 ; Return destination, which did not change setzb t3, t4 ; No length ret ; Done squeezing entire string dry endif. ; End case entire string was white space txz t1, S!N!M ; Shut off all flags aos q4, t1 ; Store character count BEFORE terminator move t3, t2 ; Make a copy of the source pointer seto t2, ; Direction is backwards adjbp t2, t3 ; Back it up by one BEFORE terminator setz t3, ; Maintain in-section local pointer txo t1, S ; Start translating extend t1, chrmup ; Use auto-magic to munch and UPPERcase! nop ; Should always skip, since no TRMCOD move t1, t2 ; Load final source pointer move t2, q1 ; Load final destination pointer move t3, q3 ; Load original length sub t3, t4 ; Subtract stopping destination length setz t4, ; Returns zero in t4 idpb t4, t2 ; Deposit NUL in destination string addi t3, ^d1 ; Account for it in length ret ; Done subttl Translation tables for Counted MOVST to UPPERcase ;[245] Begin table insertion chgsec(code,const) ; Translate tables go in constants area remark First table just skips the horizontal space ; Similar to chrmut, but does not munch NUL's, it just skips ; whitespace. Also, expects 8 bit pointers, but doesn't do anything ; with a character past .chdel (177) %ascuw=trmcod!.chnul ; ASCII values start at NUL chrsws: remark ; Everything terminates, except space and tab xlist ; Don't need to see all this junk repeat ^d<<256>_-1>,< ;;Fill table with one to one translations xwd %ascuw,%ascuw+1 ;;Properly fill half words %ascuw==%ascuw+2 ;;Step to next pair >;;repeat ^d128 ;;Do entire 8 bit character set list ; Restart the blather %eotuw=. ; Remember end of table reloc chrsws+<<.chbsp>_-1> ; Get to backspace, horizontal tab pair xwd trmcod!.chbsp,.chtab ; Tab does NOT terminate (nor set 'N') reloc chrsws+<<.chspc>_-1> ; Get to space, exclamation point pair xwd .chspc,trmcod!"!" ; Space does NOT terminate (nor set 'N') reloc %eotuw ; Get back to end of table cleans(<%ascuw,%eotuw>) ; Don't need these temporary symbols remark Second table does the UPPERcasing, but does not munch NUL's ; Only uppercases the 26 lowercase letters: a, b, c, d, e, f, g, h, i, ; j, k, l, m, n, o, p, q, r, s, t, u, v, w, x, y and z. Other ; characters are left strictly alone. %ascuc=.chnul ; ASCII values start at NUL (nothing stops it) chrcut: remark ; Table to only uppercase, not NUL's xlist ; Don't need to see all this junk repeat ^d<<256>_-1>,< ;;Fill table with one to one translations xwd %ascuc,%ascuc+1 ;;Properly fill half words %ascuc==%ascuc+2 ;;Step to next pair >;;repeat ^d128 ;;Do entire 8 bit character set list ; Restart the blather %eotuc==. ; Remember end of table remark ; Get to lower case section reloc chrcut+<<"`">_-1> ; Gets us to the corrct halfword pair xwd "`","A" ; Convert lowercase a to UPPERcase A %ascuc="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 %ascuc,%ascuc+1 ;;Properly fill half words %ascuc=%ascuc+2 ;;Step to next pair >;;repeat ^d12 ;;Do remaining 24 characters list ; Restart the blather xwd "Z",173 ; Last letter and Left brace reloc %eotuc ; Get back to end of table cleans(<%ascuc,%eotuc>) ; Don't need these temporary symbols chrcsw: movst 0,chrsws ; Translate table to skip initial white space .chnul ; Fill character is end of string chrcup: movst 0,chrcut ; Translate table to UPPERcase .chnul ; Fill character is end of string retsec ; Return to code section ;[245] End table insertion subttl Counted Move string, uppercasing any lowercase letters. ;[245] Begin code insertion ; Call: ; ; t1/ Source ASCII pointer ; t2/ Destination ASCII pointer ; t3/ Count of source string bytes (not including trailing NUL) ; ; Return: +1, always ; ; t1/ Updated source ASCII pointer ; t2/ Updated destination ASCII pointer ; t3/ Length of final string, minus any initial whitespace ; t4/ Length of source string (which can be used as an internal check) ; ; N.B., Munches initial horizontal white space (.chtab, .chspc) ; Stops when source string count goes to zero and does NOT ; squeeze out NUL's. Do not include a trailing NUL in the ; count unless you want it there! ; ; After reviewing the tables above, understand that it is a TERRIBLE ; idea to call this routine after you have put parity on a string. movsuc: entry movsuc ; Used in K20PAR (to check out K20MIT) saveac ; Piggy MOVST wants plenty registers move q3, t3 ; Preserve length of source string move q1, t2 ; Load destination pointer move t2, t1 ; Load source pointer setzb t3, q2 ; No non-section zero pointers move t1, q3 ; Load source length move t4, t1 ; Destination will never be longer remark ^-S ; Do NOT set 'S'--NOT translating!! extend t1, chrcsw ; First, skip all the whitespace nop ; May never skip since should always trmcod ifxe. t1, N ; BUT!! Wasn't it force terminate?? move t1, t2 ; Return (updated) source string pointer move t2, q1 ; Return (unmodified) destination string pointer setz t3, ; Final string has no length move t4, q3 ; Return (unchanged) original length ret ; That was easy enough endif. ; Otherwise, hit non-whitespace txz t1, S!N!M ; Shut off all flags aos q4, t1 ; Store character count BEFORE terminator move t3, t2 ; Make a copy of the source pointer seto t2, ; Direction is backwards adjbp t2, t3 ; Back it up by one BEFORE terminator setz t3, ; Maintain in-section local pointer txo t1, S ; Start translating extend t1, chrcup ; Use auto-magic to munch and uppercase! nop ; Should always skip, since no TRMCOD move t1, t2 ; Load final source pointer move q2, q3 ; Load original length sub q2, q4 ; Calculate how many we skipped move t3, q3 ; Load original length sub t3, q2 ; Calculate final length of destination string movn t2, q2 ; Load characters we skipped (but going backwards) adjbp t2, q1 ; Back up to the end of that (shrunken) string) move t4, q3 ; Source string length didn't change ret ; Done subttl Historic IAC code removed from k20mit ;[247] Begin code removal repeat 0,< ;;Copied here out of k20mit move t2, [point 8, sndpkt] ; Yes, must double any IACs. move t3, [point 8, tvtbuf] ; Copy data field to this place. spak6a: ildb t1, t2 ; Byte loop. Get one. jumpe t1, spak6b ; Done? idpb t1, t3 ; No, copy it. cain t1, iac ; IAC? idpb t1, t3 ; Yes, copy it again. jrst spak6a ; Till done. spak6b: setz t1, ; Done, make result asciz. idpb t1, t3 ; ... move q1, t3 ;[223] Save last pointer move t2, [point 8, tvtbuf] ; Point to result. >;;repeat 0 ;[247] End code removal subttl iaciac Translation tables ;[247] Begin table insertion ; Background: ; ; Telnet uses a special 8-bit character to indicate that the next byte ; in the terminal stream should be interpreted as a command. This ; character is known as the IAC character and is octal 377, hex FF and ; decimal 256. ; ; When Kermit-20 is sending binary data, it is possible that a ; legitimate 377 can be seen in the data stream. Further, a delete or ; rubout character (octal 177) sent with even parity will also occur. ; This latter case is perhaps unlikely as TVT transport does not ; support parity. ; ; In either case, the IAC must quoted (meaning doubled) in order to be ; transmitted properly. This cannot happen with a DECnet NRT ; transport as signaling is done out-of-band. ; ; Kermit-20 previously looped through each packet to determine whether ; IAC doubling was necessary. Rewriting it to use the EXTEND MOVST ; instruction is part of ongoing loop elimination and replacement, ; another example being found [245], above. chgsec(code,const) ; Translate tables go in constants area %iachr==.chnul ; 8 bit values start at NUL iactab: xlist ; Save some trees repeat ^d<256_-1>,< ;;Fill table with one to one translations xwd %iachr,%iachr+1 ;;Properly fill half words %iachr==%iachr+2 ;;Step to next pair >;;repeat ^d128 ;;Do 128 character pair list ; Turn the blather back on %eotia==. ; Mark end of table %eotio==>_-1 ; Calculate offset of IAC pair reloc iactab+%eotio ; Get there in translate table xwd 376,trmcod!iac ; Stop if we hit an IAC reloc %eotia ; Get back to end of table chriac: movst 0,iactab ; Stop on an IAC .chnul ; Fill character is end of string cleans(<%iachr,%eotia,%eotio>) ; Don't need these temporary symbols retsec ; Return to code section ;[247] End table insertion subttl iaciac Double Interprete As a Command character ;[247] Begin code insertion ; Call: ; ; t1/ Source length ; t2/ Source 8 bit pointer ; t3/ Destination 8 bit pointer ; ; Return: ; ; +1, some error ; ; T1/ -1 indicates that t2 and t3 pointed to the same string ; ; +2, Following registers updated ; ; t1/ Length of source string ; t2/ Updated ; t3/ Updated ; t4/ Length of destination string ; ; N.B., Because an IAC will be doubled, if T2 and T3 point to the same ; string, the following character will be TRASHED wth the second ; IAC. Therefore, DO NOT DO THIS. iaciac will give a fail return ; with a -1 if it detects this situation. iaciac: entry iaciac ; Called by spak in k20mit and $echo in k20par came t2, t3 ; We're not going to overwrite, are we? ifskp. ; That's not any good ... seto t1, ; Flag the problem ret ; Give error return else. ; Otherwise, let's get started saveac move p1, t1 ; Save original source length setz p2, ; Zero count of doubles endif. ; End case initial check remark t2, ; Already has proper source pointer move q1, t3 ; Set up destination pointer setzb t3, q2 ; Section local pointers move t4, t1 ; Load source length lsh t4, ^d1 ; Maximum is double the entire string of IAC's... movx q3, IAC ; Handy IAC for doubling txz t1, N!M ; Turn off status bits do. ; Enter loop lexical context txo t1, S ; Start translating immediately extend t1, chriac ; Start looking for an IAC nop ; Don't care about premature ending ifxn. t1, N ; Hit an IAC?? idpb q3, q1 ; Yes, drop it in idpb q3, q1 ; ...Twice... addi p2, ^d1 ; And count an extra character subi t4, ^d2 ; Account for two bytes used endif. ; End case of premature termination txz t1, S!N!M ; Shut off all MOVST bits for length check jumple t1, endlp. ; Break out of loop if source exhausted jumple t4, endlp. ; Break out of loop if destination exhausted loop. ; Otherwise, more to do enddo. ; End of loop lexical context move t1, p1 ; Load source length remark t2, ; Return updated source pointer move t3, q1 ; Return updated destination pointer move t4, p1 ; Load source length add t4, p2 ; Add in doubled IAC's to get destination retskp ; Finally done ;[247] End code insertion SUBTTL Various extended addressing bits ;[216] This is all lifted from the Extended Mode FTP Server I wrote --Tom REMARK Some other stuff which perhaps should have it into MACSYM? GP%2PF==MASKB(0,11) ; Double word pointer field GP%2PB==MASKB(0,5) ; Double word pointer position of byte GP%2SB==MASKB(6,11) ; Double word pointer size of byte GP%2WB==1B12 ; Double word pointer signal bit GP%2RS==MASKB(13,35) ; Double word reserved field GP%2AD==MASKB(1,35) ; Double word 30 bit address, including ; Indirect bit, index fields GP%1PF==MASKB(0,5) ; Single word pointer field GP%1AD==MASKB(6,35) ; Single word FLAT 30 bit address subttl Double word to single word routine ; T2/ Double word pointer to convert ; T3/ ; ; +1 Bogus double word P&S fields ; +2 Success, coverted single word pointer in T1 ; ; To do: What happends to the XMOVEI if the address pointer is bogus? ; (Bits 1 and 2 not [1|0] or [0|1] or non-zero data in reserved ; bits 2 through 12 in local indirect words) ; Is there a faster way to do this translation? D2SGPC: TXZN T2,GP%2WB ; First things first, check and stomp RET ; the double word pointer bit. ANDX T2,GP%2PF ; Mask off any reserved or user sillyness MOVX T1,%OWMAX-1 ; Start at the end of the table DO. ; Check to see if these are valid P&S CAMN T2,OW2DW(T1) ; fields for a one word global pointer EXIT. ; Found it! SOJGE T1,TOP. ; Get to next table entry ENDDO. ; Until checked beginning CAIGE T1,0 ; Did we find a valid entry? RET ; Nope, can't do the conversion ADDI T1,^D37 ; Offset into proper single word P&S field ROT T1,<^D35-POS(GP%1PF)> ;Position to single word P&S field, saving TXNE T1,GP%1AD ; possible field overflow. And any junk? RET ; Yes, probably a bogus table offset remark ; Resolve any local or global indirection (impossible) IOR T1,T3 ; Load the 30 bit address into the one word RETSKP ; global pointer SUBTTL One Word to Double word byte pointer translation table ; The table is copied from Page 2-85 in the User Operations section of ; the PDP-10 1982 Processor Reference Manual. Note that there is a ; documentation error for entry 40; it is listed as 28 and should be 18. chgsec(code,const) ; Pointer table is considered constant data OW2DW: ; 37 Legal P&S ; 6 Bit Pointers ; 38 Legal P&S ; 39 Legal P&S ; 40 Legal P&S ; 41 Legal P&S ; 42 Legal P&S ; 43 Legal P&S ; 44 Legal P&S ; 8 Bit Pointers ; 45 Legal P&S ; 46 Legal P&S ; 47 Legal P&S ; 48 Legal P&S ; 49 Legal P&S ; 7 Bit Pointers ; 50 Legal P&S ; 51 Legal P&S ; 52 Legal P&S ; 53 Legal P&S ; 54 Legal P&S ; 55 Legal P&S ; 9 Bit Pointers ; 56 Legal P&S ; 57 Legal P&S ; 58 Legal P&S ; 59 Legal P&S ; 60 Legal P&S ; 18 Bit Pointers ; 61 Legal P&S ; 62 Legal P&S %OWMAX==.-OW2DW ; One Word Maximum byte pointer magic number .xcref %OWMAX ; Don't need this temporary in the cross reference suppress %OWMAX ; Don't need this temporary in the symbol listing IFN <%OWMAX-<^D62-^D37+1>>, <.fatal Illegal number of one word to double word pointer fields> if2 < purge %OWMAX > ; Not needed after pass two retsec ; Restore .psect's ;[216] End code insertion subttl CRC Routines ;[66] CRC calculation ; ; This routine will calculate the CRC for a string, using the ; CRC-CCITT polynomial. ; ; The string should be the fields of the packet between but not including ; the and the block check, which is treated as a string of bits with ; the low order bit of the first character first and the high order bit of the ; last character last -- this is how the bits arrive on the transmission line. ; The bit string is divided by the polynomial ; ; x^16+x^12+x^5+1 ; ; The initial value of the CRC is 0. The result is the remainder of this ; division, used as-is (i.e. not complemented). ; ; Contributed by Nick Bush, Stevens Institute of Technology. ; ; Call with ; t1/ length of string ; t2/ 8-bit byte pointer to string ; Returns +1 always, with t1/ 16-bit CRC, t2 unchanged. ; ; AC usage: ; t1/ Accumulated CRC ; q4/ Remaining length ; q3/ Byte pointer to string ; q2/ temp ; q1/ temp crcclc: entry crcclc ; Identify our location for LINK extern parity,none ; Inform of our necessary saveac ; Save q1-q4, and t2. dmove q3,t1 ; Get arguments. setz t1, ; Initial CRC is 0. move t2, parity ;[136] Get parity. do. ;[194] Enter loop context ildb q1, q4 ; Get a character. caie t2, none ;[136] Parity = NONE? andi q1, ^o177 ;[136] No, doing parity, strip parity bit. xori q1, (t1) ; Add in with current CRC. ldb q2, [point 4,q1,31] ;Get high 4 bits. andi q1, ^o17 ; AND low 4 bits. move q1, crctb2(q1) ; Get low portion of CRC factor. xor q1, crctab(q2) ; Plus high portion. lsh t1, -^d8 ; Shift off a byte from previous CRC. xor t1, q1 ; Add in new value. sojg q3, top. ; Loop for all characters. enddo. ;[194] Fall out of loop context ret ; Done, return +1 with CRC in t1. subttl Data tables for CRC-CCITT generation chgsec(code,const) ;[208] Table goes in constants section crctab: oct 0 oct 10201 oct 20402 oct 30603 oct 41004 oct 51205 oct 61406 oct 71607 oct 102010 oct 112211 oct 122412 oct 132613 oct 143014 oct 153215 oct 163416 oct 173617 crctb2: oct 0 oct 10611 oct 21422 oct 31233 oct 43044 oct 53655 oct 62466 oct 72277 oct 106110 oct 116701 oct 127532 oct 137323 oct 145154 oct 155745 oct 164576 oct 174367 retsec ;[208] Re-open executable code subttl setgrd - set up guard pages for stacks, etc. ; Lifted from Extended Mode FTP server I wrote, EFTPSA. ; ; A guard page is a no-access page, call it 'explode-on-use'. .endps code ; End code psect .psect data ; Need some local storage myccoc: 0 ;[161] CCOC words for my tty. 0 ;[161] (two of them) ttpau: 0 ;[161] Controlling TTY's pause chars. grdpg2: 0 ; Guard page in memory grdadr: 0 ; Address of same grdhan: 0 ; File handle of guard page grdmap::0 ;[263] ; Process handle of guard page .endps data ; Done with writable storage .psect datend/ronly,112000 ; Mark the end of the data .psect datgrd: block ^d512 ; So we can drop in a guard page .endps datend ; Yet doesn't store anything .psect const ; Table of addresses goes in constants guardp: macgp1 ; Macro guard page 1 (before mapping window) macgp2 ; Second guard page is after file mapping window macgp3 ; Third guard page is after macro storage macgp4 ; Fourth guard page is after garbage collection emacro < ; Only if I've finished the macro editor ... macgp5 ; Fifth guard page is after macro editing >;;emacro datgrd ; Put a guard page here, too -1 ; Note list MUST end in -1!! .endps const ; End of constants .psect code ; Reopen code psect setgrd: entry setgrd ; Called at start up saveac ; Save some scratch registers call fepage ; Go find an illegal page ret ; But couldn't ... dmovem t1, grdpg2 ; Record as guard page double word movem t3, grdhan ; Save the file page handle, also hrrz q1, t1 ; Load the in-memory guard page hrli q1, .fhslf!fh%epn ; Convert to extended page handle in this fork movem q1, grdmap ; Save as a guard page mapping xmovei q2, guardp ; Load the address of guard page list do. ; Loop, setting up guard pages skipge t2, (q2) ; Pick up the guard page address ret ; Done, leave remark Case III: ; Mapping One Process's Pages to Another Process adr2pg t2, ; Convert address to page hrli t2, .fhslf!fh%epn ; page handle for this process move t1, q1 ; Load our base guard page handle movx t3, pm%epn ; Going into a non-zero section PMAP% ; Finally map in a bogus page erjmpr .+1 ; Catch and ignore error aoja q2, top. ; Loop for another guard page enddo. ; End of loop lexical context SUBTTL FEPAGE - Find an illegal page to map ; Original code lifted from Tops-20 Extended Mode FTP server. ; ; Creates a page in the page map that is illegal to reference in *ANY* ; way, including reading. Does this by first finding a page in our ; address space that contains a page from our executable and then ; mapping in a page that file that is known not to exist and cannot be ; created. ; ; I call it an 'Explode-on-Use' page. ; ; A guard page is created by mapping in a non-existant page that is ; past the end of our executable file. The executable file has the ; following properties: it is not extendable while mapped nor is it ; copy-on-write. Thus, a write to this file page will fail because ; the .EXE is locked. A read will fail because the page must be ; created in order to be read. Since it isn't writable to begin with, ; it can't be created. ; ; See R.E. Gorin, "Introduction to DECSYSTEM-20 Assembly Language ; Programming", page 443, footnote 3 for further details. Thanks to ; MRC for suggesting this approach. ; ; Returns: ; ; T1/ Page number of guard page ; T2/ 30 bit address of guard page ; T3/ File window handle of guard page (JFN,,Page number) ; ; Note: Maybe I ought to use XRMAP% below in case I have to shuttle ; through a lot of pages. In practice, however, I rarely have to ; process more than one page, so it didn't seem worth it and therefore ; I used a simple RMAP% instead. ; ; To do: MRC said that for certain size executable, this code won't ; work. Check for that size here and do something intelligent ; if so. Or gronk. fepage: saveac ; Needs some registers movx p4, ^d25 ; Don't look through more than this many pages xmovei p3, . ; Load current executable address adr2pg p3, ; Convert address to page which we don't ; look at because DDT is probably there fndpag: do. ; Now find a page with our JFN in it sojle p4, R ; Did this too many times? Return +1 aos t1, p3 ; Increment and load page number hrli t1,.fhslf!fh%epn ; Looking at this fork RPACS% ; Find out the access erjmpr top. ; Couldn't, go to next page txnn t2, pa%pex ; Does the page exist? loop. ; No, go look for another one txne t2, pa%prv ; Is the page private? loop. ; Yes, we need one with a JFN in it rmap% ; Get a handle on the page erjmpr top. ; Gronked, go on to next page txnn t2, pa%pex ; Sanity Check: does the page still exist? loop. ; No, go look for another one hlrz t1, t1 ; Load just the process/file designator cain t1, .fhslf ; Quick check, this isn't our own process, is it? loop. ; Yah, it is, so worthless; bum the GTSTS% GTSTS% ; Otherwise, see if we can use this? erjmpr top. ; No JFN, so just go to the next page txnn t2, gs%nam ; Is anything in there a JFN? loop. ; No, not safe to use txnn t2, gs%opn ; Is the file open? loop. ; No, won't be able to PMAP% it txne t2, gs%wrf ; Better not be for write loop. ; It is, will self-create, then txnn t2, gs%rnd ; Open for non-append access? loop. ; No, will extend then remark ; If we get here, we fall out of the loop enddo. ; End of loop context ; Otherwise, we have a safe page to use hrrzs p3, t1 ; Save a nice JFN SIZEF% ; Get the number of pages in the file erjmpr fndpag ; Can't, so keep looking hrr t1, p3 ; Load our executable JFN hrl t1, t3 ; Start REAL NEAR the end of the file FFFFP% ; Find the first unused (free) file page erjmpr fndpag ; Can't, so keep looking camn t1, [-1] ; None?? jrst fndpag ; No, continue the journey remark ; Otherwise, have a guard page from the file!! move p2, t1 ; Save as source designator remark Case I: ; Mapping File Pages to a Process hrlz t1, p3 ; JFN of executable file in the left half hrr t1, p2 ; Page number of executable file dmove t2,[.fhslf!fh%epn,,grdpag ; Fork and page handle pm%epn] ; going into any section PMAP% ; Finally map in a bogus page erjmpr fndpag ; Gronked, try the old way hrrz t4, t2 ; Load the page we mapped pg2adr t4, ; Convert to address move t1, @t4 ; The moment of truth, this should fail ifje. r ; Well, did it? remark ; All is well, return the data hrlz t3, p3 ; Load executable file JFN hrr t3, p2 ; Load the file page number of the guard page hrrz t1, t2 ; Load page number of guard page in memory move t2, t4 ; Load the address of the guard page in memory retskp ; And return success else. ; ?? jrst fndpag ; Try some more endif. subttl Break out various flags from JFN flags ;[252] Begin code insertion ; ; Used when debugging results of COMND% functions .CMINI, .CMOFI, and ; .CMFIL, GTJFN% (with GJ%FLG) and GNJFN%. Written to help debug ; directory listing logic when doing a wildarded (DSK*:) listing. ; repeat 0,< ;[252] Unnecessary now that debugging is done ; ; Call: ; ; t1/ JFN and flags ; ; From monsym.mac: ; ;Flags returned by GTJFN% and GNJFN% ; ;GTJFN% flags returned remark GJ%DEV 1B0 Asterisk was given for device remark GJ%UNT 1B1 Asterisk was given for unit remark GJ%DIR 1B2 Asterisk was given for directory remark GJ%NAM 1B3 Asterisk was given for name remark GJ%EXT 1B4 Asterisk was given for extension remark GJ%VER 1B5 Asterisk was given for generation remark GJ%UHV 1B6 Use highest generation remark GJ%NHV 1B7 Use next higher generation remark GJ%ULV 1B8 Use lowest generation remark GJ%PRO 1B9 Protection attribute (;P) given remark GJ%ACT 1B10 Account attribute (;A) given remark GJ%TFS 1B11 Temporary file attribute (;T) given remark GJ%GND 1B12 Complement of GJ%DEL on call remark GJ%NOD 1B13 Node name was given ;GNJFN% flags returned remark GN%STR 1B13 Structure changed remark GN%DIR 1B14 Directory changed remark GN%NAM 1B15 Name changed remark GN%EXT 1B16 Extension changed ;GTJFN remark GJ%GIV 1B17 Complement of G1%IIV ; Note that the bit conflict between GJ%NOD and GN%STR is ignored as ; Kermit does not use GTJFN% to parse for a node name, but rather ; COMND%'s .CMNOD function. jfnflg: entry jfnflg ; Globalize entry jumpe t1, r ; Ignore if nothing there ... skipe local ; Only if NOT local ret ; Don't junk up the remote connection... saveac hrrz q2, t1 ; Load just the new JFN hllz q1, t1 ; Looking at just the stepping flags caie q2, .nulio ; Just dumping it? ifskp. ; Yes, set up other flags movx q3, GS%NAM ; Just say that it's bound else. ; Otherwise, have a look at the JFN's health tlz t1, -1 ; Stomp any flags so GTSTS% doesn't choke GTSTS% ; Now see if we can use this. ifje. r ; Might fail... move t3, t1 ; Save the error setz q3, ; Force gs%nam off else. ; Otherwise, it worked move q3, t2 ; Save those flags endif. ; End case GTSTS% handling endif. ; End case .nulio special handling ifxe. q3, GS%NAM ; Is this a valid JFN? txmsg <(Invalid) > ; Yes, say so ret ; Nothing else to do endif. ; Otherwise, start breaking out bits ifxn. q1, GJ%DEV ; Device wildcarded? txmsg ; Yes, say so endif. ifxn. q1, GJ%UNT ; Unit wildcarded? txmsg ; Yes, say so endif. ifxn. q1, GJ%DIR ; Directory wildcarded? txmsg ; Yes, say so endif. ifxn. q1, GJ%NAM ; File name wildcarded? txmsg ; Yes, say so endif. ifxn. q1, GJ%EXT ; Extension wildcarded? txmsg ; Yes, say so endif. ifxn. q1, GJ%VER ; Version wildcarded? txmsg ; Yes, say so endif. ; Generation specification ifxn. q1, GJ%UHV ; Use highest generation? txmsg ; Yes, say so endif. ifxn. q1, GJ%NHV ; Next highest generation? txmsg ; Yes, say so endif. ifxn. q1, GJ%ULV ; Lowest generation? txmsg ; Yes, say so endif. ; Other attributes ifxn. q1, GJ%PRO ; Protection attribute given? txmsg <;P > ; Yes, say so endif. ifxn. q1, GJ%ACT ; Account attribute given? txmsg <;A > ; Yes, say so endif. ifxn. q1, GJ%TFS ; Temporary attribute given? txmsg <;T > ; Yes, say so endif. ifxE. q1, GJ%GND ; Got a deleted file? (Complement of GJ%DEL) txmsg ; Yes, say so endif. ifxE. q1, GJ%GIV ; Got an Invisible file? (complement of GN%IIN) txmsg ; Yes, say so endif. ; GNJFN%'s stepping flags ifxn. q1, GN%STR ; Structure changed? txmsg ; Yes, say so endif. ifxn. q1, GN%DIR ; Directory changed? txmsg ; Yes, say so endif. ifxn. q1, GN%NAM ; Name changed? txmsg ; Yes, say so endif. ifxn. q1, GN%EXT ; Extension changed? txmsg ; Yes, say so endif. ; GTSTS% flags ifxn. q3, GS%OPN ; Is the file open? txmsg ; Yes, say so endif. ifxn. q3, GS%WRF ; Open for write? txmsg ; Yes, say so endif. movei t1, .priou ; Always typing on terminal caie q2, .nulio ; Dumping it? ifskp. ; That's easy! dmove t2, nul4 ; Constant string and length setz t4, ; In case anybody looks ... SOUT% ; Type it erjmpr .+1 ; Catch and ignore error else. ; Otherwise, an actual JFN to type move t2, q2 ; Load the JFN dmove t3, allfld ; dev:name.typ.gen JFNS% ; Let's see what the complete file is ifje. r ; Catch the error move t4, t1 ; Save error for debuggers move t2, t1 ; Store the error hrli t2, .fhslf ; This process setz t3, ; Indefinite blating movei t1, .priou ; Type on terminal ERSTR% ; Blat erjmpr .+2 ; Ignore strange return erjmpr .+1 ; Ignore stranger return endif. ; End case JFNS% error handling endif. ; End case NUL: special casing ret ; Done > ;repeat 0 ;[252] ;[252] End code insertion subttl ASCII capability list ;[252] Begin code insertion ; ; Lifted and adapted from eftpss.mac (Extended Mode FTP server Site Specific code) ; ; N.B. Depends on three character capabilities! repeat 0,< ;[252] Unnecessary now that debugging is done remark Table of Capabilities and their abbreviations captab: asciz /ctc/ ; SC%CTC==:1B0 Control-C asciz /gtb/ ; SC%GTB==:1B1 GETAB% asciz /mmn/ ; SC%MMN==:1B2 Map monitor asciz /log/ ; SC%LOG==:1B3 Logging functions asciz /mpp/ ; SC%MPP==:1B4 Map privileged pages asciz /sdv/ ; SC%SDV==:1B5 Special devices asciz /sct/ ; SC%SCT==:1B6 Assign TTY as controlling for fork (SCTTY%) 0 ; Unknown 1B7 Capability 0 ; Unknown 1B8 Capability asciz /sup/ ; SC%SUP==:1B9 Superior access 0 ; Unknown 1B10 Capability 0 ; Unknown 1B11 Capability 0 ; Unknown 1B12 Capability 0 ; Unknown 1B13 Capability 0 ; Unknown 1B14 Capability 0 ; Unknown 1B15 Capability 0 ; Unknown 1B16 Capability asciz /frz/ ; SC%FRZ==:1B17 Freeze on terminating conditions asciz /whl/ ; SC%WHL==:1B18 Wheel asciz /opr/ ; SC%OPR==:1B19 Operator asciz /cnf/ ; SC%CNF==:1B20 Confidential Information Access asciz /mnt/ ; SC%MNT==:1B21 Maintenance asciz /ipc/ ; SC%IPC==:1B22 IPCF asciz /enq/ ; SC%ENQ==:1B23 ENQ/DEQ asciz /nwz/ ; SC%NWZ==:1B24 NET wizard (ASNSQ%, ETC.) asciz /nas/ ; SC%NAS==:1B25 Network Absolute Socket Privilege asciz /dna/ ; SC%DNA==:1B26 DECnet access allowed asciz /ana/ ; SC%ANA==:1B27 ARPAnet access allowed (Internet) asciz /sem/ ; SC%SEM==:1B28 Semi-Opr asciz /mea/ ; SC%MEA==:1B29 Mini-Exec Access Allowed ;[T198] 0 ; Unknown 1B30 Capability 0 ; Unknown 1B31 Capability 0 ; Unknown 1B32 Capability 0 ; Unknown 1B33 Capability 0 ; Unknown 1B34 Capability asciz /adm/ ; SC%ADM==:1B35 PANDA Administrator capend:! ifn , subttl Capability display code ; t1/ 36 bit capability word infcap: entry infcap ; Used in k20srv saveac skipe q1, t1 ; Save and check ifskp. ; None? txmsg <(None) > ; That's easy! ret ; All done! endif. ; Allocate some anonymous stack space anstkv (q4, <^D<<<2*80>/5>+1>>) move t1, q4 ; Load the address of the scratch stack space txo t1, .p07 ; Turn into ASCII OWGP in case non-zero section setzb t2, t3 ; Zero capability name registers setz t4, q3 ; Zero the bit holder and loop counter do. jumpe q1, endlp. ; Anything left to do? lshc t4,^d1 ; Pick off a capability bit from q1 ifxn. t4, 1b35 ; If it was set, display it if known move t3, captab(q3) ; Pick up the capability abbreviation cain t3, 0 ; Is it defined? call capcon ; No, phoney something up call depcap ; Display it endif. ; Otherwise, remember that it wasn't caige q3, ^d36 ; Are we still playing with a full DEC? aoja q3, top. ; Go get another bit enddo. setz t4, ; Cons up a NUL move t3, t1 ; Get a copy of the point idpb q1, t3 ; Terminate the string, allowing append move t1, q4 ; Load the address of the scratch stack space again txo t1, .p07 ; Turn into ASCII OWGP in case non-zero section PSOUT% ; Finally type something ret subttl Capability display support code REMARK Cons up a capability abbreviation capcon: skipge t2, q3 ; Load the current capability counter ret ; Better just not do anything caile t2, ^D35 ; Should NEVER be a capability larger than 35!! ret ; Just don't proceed idivi t2, ^d10 ; Extract the ones digit to T3 lsh t2, <1+<^d3*^d7>> ; Shift tens digit over to second byte of word lsh t3, <1+<^d2*^D7>> ; Shift ones digit over to third byte of word add t3, [asciz /u00/] ; Unknown capability base add t3, t2 ; Don't forget the one's digit! RET ; Return the ASCII capability abbreviation REMARK Special purpose routine to drop in the capability abbreviation depcap: lshc t2, ^d7 ; Shift in and deposit three bytes idpb t2, t1 lshc t2, ^d7 idpb t2, t1 lshc t2, ^D7 idpb t2, t1 movx t2, .chspc ; Space delimiter idpb t2, t1 ret > ;repeat 0 ;[252] ;[252] End code insertion subttl fndvec Find and record the symbol table vector ; The EXEC shouldn't need this for things like ^T, yet it does... ; ; We don't need to do a PDVOP% to find our program data vector ; address because we are giving it its own .PSECT and therefore ; are setting the address ourselves ; ; We can't have LINK do this because LINK won't write .JBSYM when ; doing PDV's. ; ; Adapted from SETNOD rewrite (SETND2) ; ; N.B., While the code will properly find a symbol table in any ; section, it won't work unless it is run in a non-zero section. ; Since Kermit is effectively a section zero program with some ASCII ; data being accessed via one word global pointers, the symbol table ; and the symbol table vector must also be in section zero. remark [233] 11:47am Saturday, 31 December 2022 ; The above isn't true, of course, we could use two 18 one word global ; pointers to fetch and OR two half words or jump into a non-zero ; section to get the data (see fetch and efetch, below). The problem ; is that this would have involved some non-obvious modifications to ; the below and the symbol table lookup routine which I didn't see ; the value of doing as opposed to finishing the NRT functionality. ; ; At the time, I didn't realize that although LINK isn't going to do ; what we want, there is nothing stopping us from using MACRO itself ; to deposit values in fixed locations in the 'low segement' area. ; See the end of this module for a bunch of loc statements, not all of ; which may be absolutely necessary, strictly speaking. ; ; The point was to maintain reverse compatibility with any PA1050 ; based programs or other archaic Tops-20 oddities that hadn't been ; been upgraded to PDV's (as in, just about all of them), one in ; particular being the EXEC. ; ; The EXEC was modified in edit [T255] to the EXECP.MAC module to ; handle a 'modern' symbol table vector, which could be in a non-zero ; section. ; See commentary below for new version of EXEC [T255] which can handle ; a modern symbol table vector. This gets the parts of it we want for ; later. ifndef .jbsym, <.jbsym==116> ; Low segment symbol table pointer (old style) ifndef .jbsa , <.jbsa==120> ; Program start address ifndef .jbff , <.jbff==121> ; Program first free location ifndef .jbren, <.jbren==124> ; Low segment reenter word ifndef .jbver, <.jbver==137> ; Low segment version word fndvec: entry fndvec ; Called on start up remark ; Expects full run of temporaries saveac ; But follow the rules, anyway setzm glbsym ; Clear global symbol table flag setzb t1, t2 ; Cons up some more zeros dmovem t1, symvec ; Stomp symbol vector and defined symbol table remark ; N.B., DEPENDs on 'low segment' hand crafting, below skipn q1,.jbsym ; Nothing there? ret ; Nope, that's easy! (but useless) xjrstf .+1 ; Go 'upstairs' to grab the value pc%usr ; Don't try to break out of user mode extsec,,fndve1 ; 'long jump' to extended mode operation .endps code ; Finish execution of section zero code .psect ecode ; Resuming execution in extended code section remark Caution ; The stack is ONLY valid in section zero!! fndve1: remark ; N.B., All the indirect addressing is a little slower setom @[0,,glbsym] ; Let's assume it's global (which it should be) txzn q1, 1b0 ; Just check if it's local (which it shouldn't be) ifskp. ; That's strange, but we can fix that up xhlli q1,. ; Stomp in the section number remark @[0,,glbsym] ; So it's still global (heh...) endif. ; movem q1, @[0,,symvec] ; Store as symbol table VECTOR skipn q2, @q1 ; Pull the vector length (first location) jrst fndver ; If we have one... remark ; Otherwise, there is SOMETHING in there ifl. q2 ; Old style symbol table? (shouldn't be up here..) movem q2, @[0,,kjbsym] ;That's easy; just use it xjrstf .+1 ; And go 'downstairs' to return to caller pc%usr ; Don't try to break out of user mode rskp ; Give +2 return endif. ; End case old symbol table pointer in a strange place remark ; New style symbol table vector! Grovel through it sojle q2, fndver ; But!! If nothing is in there, it's all over xmovei q1, 1(q1) ; Load address of first subtable do. ; Enter loop context dmove t1, .stdat(q1) ; Load ST%TYP and ST%LEN and .STPTR ldb t3,[pointr (t1,st%typ)] ; Load table type ldb t4,[pointr (t1,st%len)] ; Load table length caie t3, .r50d ; Is the type a defined symbol table?? ifskp. ; Yes! It is!! andg. t4 ; But!! Does it contain any symbols? movn t3, t4 ; Load negative of length hrlz t1, t3 ; Assumes table is not greater than a section hrr t1, t2 ; Now have base of subtable movem t1,@[0,,kjbsym] ;Save for symbol table routine xjrstf .+1 ; And go 'downstairs' to return to caller pc%usr ; Don't try to break out of user mode rskp ; Give +2 return endif. ; End case defined symbol table xmovei q1, .stsiz(q1) ; Load address of next subtable subi q2, .stsiz ; Account for words used in symbol block jumpg q2, top. ; Look some more, if anything left enddo. ; End of loop context remark ; If fell through, then never found symbol table ; Which is an error fndver: remark ; Here on any kind of error setzm @[0,,.jbsym] ; .jbsym is gubbish, so stop paying attention setzm @[0,,symvec] ; Stomp the symbol table vector too, it's bogus xjrstf .+1 ; And go 'downstairs' to return to caller pc%usr ; Don't try to break out of user mode r ; Give +1 return .endps ecode ; Get out of extended code SUBTTL Magical symbol table lookup routine ; For details, read "Introduction to DECSYSTEM-20 Assembly Language ; Programming", by Ralph Gorin, published by Digital Press, 1981. ; ; Called with desired symbol in T1 .psect code ; Starts out in section zero symout: entry symout ; Declare to the world saveac move q2, t1 ; Save the desired symbol setzb t3 ,q1 ; no current program name or best symbol move t4, kjbsym ; Load (fixed to old style symbol table pointer xjrstf .+1 ; Go 'upstairs' to symbolically print the value pc%usr ; Don't try to break out of user mode extsec,,symou1 ; 'long jump' to extended mode operation .endps code ; Finish execution of section zero code .psect ecode ; Resuming execution in extended code section remark Caution ; The stack is ONLY valid in section zero!! symou1: jumpe t4, plsoff ; Unless we don't have a symbol table hlre t1, t4 ; Convert halfword length to fullword sub t4, t1 ; -count,,ending address +1 ; And hit search loop do. ; Load this symbol's type ldb t1,[point 4,-2(t4),3] ifn. t1 ; program names are not relevant caile t1, ^o2 ; 0=prog name, 1=global, 2=local anskp. ; So skip this symbol move t1, -1(t4) ; Load value associated with the symbol came t1, q2 ; Is this an exact match, per chance? ifskp. ; It is, so no need for an offset move q1, t4 ; Just select it exit. ; And get out of the loop endif. caml t1, q2 ; Is the value before the value sought? anskp. ; No, so can't use (would be a negative offset) skipe t2, q1 ; Otherwise get the best one so far (if there is one) caml t1, -1(t2) ; compare to previous best move q1, t4 ; current symbol is best match so far endif. ; End case symbol selection add t4, [2000000-2] ; Add 2 in the left, sub 2 in the right jumpl t4,top. ; Loop unless control count is exhausted enddo. ifn. q1 ; Did we have anything that could help? move t2, q2 ; Yes, get desired value sub t2, -1(q1) ; Less symbol's value = offset cail t2, 200 ; Is the offset small enough to be conceptually useful? anskp. ; No, we can't count that high in our head move t1, -2(q1) ; Load RADIX50 symbol name txz t1, ; Clear the symbols' flags do. ; Build us a return address xsfm q3 ; Save processor flags xmovei q4,endlp. ; Load end of this pseudo-loop (return address) xjrstf .+1 ; Go 'downstairs' to use the stack pc%usr ; Don't try to break out of user mode 0,,sqztyo ; 'long jump' to section zero to print symbol name enddo. ; End of this strange call linkage sub q2, -1(q1) ; Value we wanted less this symbol's value jumpe q2, plsof1 ; If no offset, don't print "+0" movei t1, "+" ; Append a plus sign to the output line pbout% endif. plsoff: movei t1, .priou ; and copy numeric offset to output move t2, Q2 ; Load offset from symbol movei t3, ^d8 ; Addresses are in octal... NOUT% erjmpr plsof1 ; Catch and ignore error plsof1: xjrstf .+1 ; And go 'downstairs' to return to caller pc%usr ; Don't try to break out of user mode r ; Give +1 return .endps ecode ; Done with non-zero section execution subttl recursively convert a 32-bit quantity in T1 from squoze to ASCII .psect code ; Needs to be in section zero to use the stack remark Caution ; Called with inter-section hand crafted JSP-type linkage ; Call: ; ; t1/ SQUOZE word ; q3/ Processor flags to restore ; q4/ 30 bit return address sqztyo: push p,sqztyr ; Push inter-section return address saveac ; Save t2, just in case sqzty1: idivi t1, 50 ; divide by 50 to extract a Radix-50 'digit' push p, t2 ; save remainder, a Radix-50 character skipe t1 ; if T1 is now zero, unwind the stack call sqzty1 ; call self again, reducing t1 by an another 'digit' remark ; If we fall through, then it's type to unwind pop p, t1 ; Get characters back in reverse order adjbp t1, rdx50c ; Index to the correct character ldb t1, t1 ; convert squoze code to ASCII pbout% ; Type it ret ; Continue unwinding, finally 'returning' below sqztyr: jrst .+1 ; This pushed jrst goes to the xjrstf xjrstf q3 ; Transfer back to non-section zero caller rdx50c: point 7,.+1,6 ; Points to the first character in the string (the space) ascii " 0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ.$%" subttl fetch a word from extended address space ;[223] Begin code insertion ; Call: ; ; t1/ Extended address to fetch ; ; Return: ; ; t1/ Updated in all cases ; ; +1/ Possible error code ; +2/ Value at specified location repeat 0,< ; Actually turned out to be unnecessary ... fetch: saveac ; Save a scratch register xjrstf .+1 ; Go 'upstairs' to grab the value pc%usr ; Don't try to break out of user mode extsec,,efetch ; 'long jump' to extended mode operation .endps code ; Get out of section zero .psect ecode ; and into non-zero section efetch: move t2, @t1 ; Grab whatever we've been pointed at erjmpr fetche ; Unless it was gubbish move t1, t2 ; Return value in t1 xjrstf .+1 ; Go 'downstairs' to return to caller pc%usr ; Don't try to break out of user mode rskp ; Give +2 return fetche: remark ; Here on addressing error from move xjrstf .+1 ; Go 'downstairs' to return to caller pc%usr ; Don't try to break out of user mode r ; Give +1 return .endps ecode ; Get out of extended code .psect code ; And back into section zero code >;repeat 0 ; End removal subttl Kermit Entry Vector and Version ;[197] Moved here to support symbol table fix up, yet some still in k20mit ; Used to help LINK build version word extern $verno ; Major version number. extern $mnver ; Minor version number (minimum: 1). extern $edno ; Edit number increases independent of version. extern $who ; Who edited, 0=Columbia. ; Used to help LINK to build entry vector extern start ; Regular entry extern reen ; 'Re-enter' address ; 'Modern' Tops-20 entry vector kermit: jrst start ; Start entry. jrst reen ; Re-entry. k20ver==:FLD($who,VI%WHO)!FLD($verno,VI%MAJ)!FLD($mnver,VI%MIN)! FLD($edno,VI%EDN)!VI%DEC ;;[184] Want decimal version numbers k20ver ;[190] evlen==.-kermit ; Mark for k20mit end statement subttl Closing Code particulars xlist ; Save the trees!! lit ; Dump the literals list ; Resume listing .endps code ; Close the code .psect subttl Data storage, not in global scope .psect data ; Writable repeat 0,< ;[218] tmcbit: 0 ;[194] Time channel bit > ;[218] ccichr: 0 ;[219] Control-C Interrupt Character (we used) aicx: 0 ;[194] Count of AIC% failures laicer: lstrx1 ;[194] Last AIC% error (no error) ltimcr: lstrx1 ;[194] Last TIMER% creation (.timel) error dicx: 0 ;[194] Count of DIC% errors ldicer: lstrx1 ;[194] Last DIC% error (no error) ltimde: lstrx1 ;[194] Last .TIMBF (delete) error glbsym: 0 ;[197] If global (should never be) symvec: 0 ;[197] Address of symbol table vector kjbsym: 0 ;[197] Kermit's defined symbol table repeat 0,< ;[197] Only used for linked debugging ddtf:: 0 ;[197] Debugger present flag >;repeat 0 ;[197] lcltte: block 10 ; Last errors encounter by LCLTTY lcltef: remark ; Final location to whack lcldev: block 1 ; Device we're going to try lclnam: block 4 ; Space for constructed terminal lcljfn: block 1 ; JFN we got lclflg: block 1 ; Associated flags (which we don't use) lclpar::block 1 ;[223] Local terminal parity 'toleration' ccn: 0 ;[187] Number of ^C's typed. psave: 0 ; Stack pointer for ^C interrupt. psave2: 0 ; Stack top for ^C interrupt. tsave: 0 ;[132] Same as above, but for timer interrupts. tsave2: 0 ;[132] ... pc1: 0 ;[196] Interrupt PC storage, levels 1, pc2: 0 ; 2, pc3:: 0 ; and 3. 'plover' ; Talsiman to see if stomped .endps data subttl Misc. utility .PSECT's remark File Mapping Page .psect filepg,maporg ; File mapping window block maplen ; Reserves a page .endps ; Allows LINK time checking remark Guard pages for files and macros .psect guard/ronly,grdorg ; Declare detonate-on-use page .endps ; Nothing in it until runtime .psect guard1/ronly,macgp1 'xyzzy' ; Force a magic page... block ^d511 ; Keep LINK up to date on size .endps guard1 .psect guard2/ronly,macgp2 'plugh' ; Force another magic page... block ^d511 ; Keep LINK up to date on size .endps guard2 .psect guard3/ronly,macgp3 'plover' ; Force another magic page... block ^d511 ; Keep LINK up to date on size .endps guard3 .psect guard4/ronly,macgp4 'lumos' ; Force another magic page... block ^d511 ; Keep LINK up to date on size .endps guard4 emacro < .psect guard5/ronly,macgp5 'nox' ; Force another magic page... block ^d511 ; Keep LINK up to date on size .endps guard5 >;;emacro remark Symbol table .PSECT .text "/symseg:psect:symbol" ; Tell LINK where to put the goodies .psect symbol/ronly,symorg ; Write-Protected symbols .endps symbol ; Close out the PSECT remark Seperate patch area .PSECT, otherwise it will be read-only .text "/patchsize:0" ; Tell LINK not to allocate a patch area .psect patch,patorg ; Patch area PAT..:: block patlen ; Override LINK .endps patch ; Close out the PSECT remark Reserve pages for in-section DDT so code doesn't bump into it .psect ddt/ronly,700000 ; If DDT is in section 0 block 777777-700000+1 ; Reserve last 64 pages .endps ddt subttl PDV setup and location ; This is the Program Data Vector .PSECT. We don't write anything ; directly in there; we pass switchs to have LINK fill it in for us .text "/pvblock:psect:pdv" ; Put program PDV's in the PDV .PSECT .psect pdv/ronly,pdvorg ; Write-Protected PDV! .endps pdv ; Close out the PSECT ; Macro to resolve symbols into values for stupid LINK. ; Note, this must be last or the macro will produce X errors ; because the symbols haven't been seen yet. Maybe see ; what IF2 would do if we want to move this around. define defpdv (name,data) < .text "/pvdata:'name':#'data" >;define defpdv ; Note, although the monitor knows about the reenter address ; (the PDV offset is .PVREE), LINK doesn't. Sigh... .text '/pvdata:name:"K20MIT"' ;;Different from save name defpdv start,\kermit ; Kermit start address ; defpdv reentr,\reen ; Kermit reenter address (obsolete) ; remark ; Have to set this in LINK ; defpdv version,\k20ver ; Kermit version word SUBTTL 'Low segment' fix ups ;[227] Begin code insertion ;[T255] Build page zero by hand since EXEC can now handle a symbol ; table in a non-zero section, but LINK doesn't quite set everything ; up correctly. ; ; A multi-section program can get complicated enough so that LINK ; can't fill in values in the 'low segment' with the 'appropriate' ; values. The problem is certain programs which don't use PDV's to ; find this stuff out, the first being an enhanced GLXLIB and the ; other being the EXEC, which may not be able to tell which PDV to ; use. ; ; Therefore, we issue the /NOINITIAL /NOJOBDAT switches *first* to ; keep LINK from getting it wrong and poke the values in ourselves, ; here. See JOBDAT for additional information. kjbffl== ; Kermit's first free location is after the patch area ; N.B., This LOC/RELOC Hackery *MUST* take place in the outer-most .PSECT!!!! loc .jbsym ; Get to symbol table pointer symorg ; The EXEC can now handle a symbol table vector!! loc .jbsa ; Get to job start address xwd kjbffl,kermit ; Note, odd left half loc .jbff ; Get to first free location kjbffl ; End defined writable storage loc .jbren ; The Reenter address reen ; This is all in Kermit's entry vector, actually... loc .jbver ; Get to the version word k20ver ; Drop Kermit's version in reloc ; Get back ... someplace ... ;[227] End code insertion end evlen,,kermit ;[197] Had to get moved here, sigh... ; Local Modes: ; Mode:MACRO ; Comment Column:32 ; Comment Start:;[276] ; Comment Begin:;[276] ; Auto Fill Mode: 0 ; End: