title k20dsp - Kermit-20 Display Routines ; All display code was removed from k20mit and moved to this module as ; part of Edit 194 to address the issue of a very large single source ; file that unexpectedly began generating MCRNEC errors. ; ; During this time, some code was rewritten to decrease symbol table ; usage, to (hopefully) clean up control flow and provide for ; additional checking and better recovery. Speed ups were not avoided ; where possible, typically space being traded for time. However, ; this was not done at the expense of clarity, maintainability being ; of paramount concern. ; ; The code here should be differentiated from the extensive help text ; which is contained in k20hlp, which is constant, does not change ; during runtime and resides in its own .PSECT. The text here is ; dynamically generated. subttl Preliminaries search monsym,macsym,cmd,k20unv ;[194] cmdacs ;Clean up p1-p4 definitions sall ; Tidy listing .directive flblst ; We don't need to see all the ASCIZ bytes... remark common parsing external data extern pars1 ; Data from first parse. extern pars2 ; Data from second parse. extern pars3 ; Data from third parse. extern pars4 ; Data from fourth parse. extern pars5 ;[41] ... remark for file handling extern filjfn ; JFN of currently open file remark other useful routines and data extern qlog ; Quit logging extern %%jser ; Support for error macros extern %%smsg ; Support for smsg macro extern BOUTI% ;[216] BOUT% Internal extern errptr ; Pointer to error message extern getnti ; Get information about line extern ccon, ccoff ; Handle control-C, if we have it extern crlf ; Carriage return line feed extern crlflf ; As previous, but double line feed extern ttyjfn ; JFN on local terminal extern $priou ; Terminal primary output subttl Various NUL: ASCII strings and lengths .psect text ; Text goes in text psect nulnam: byte (7) "N","U","L",":", .chcrt, .chlfd, .chlfd, .chnul astnul: byte (7) "*","N","U","L",":", .chnul .endps text .psect const ; Read-only constants go in constants psecn nulptr: point 7, nulnam ; Pointer to fixed "NUL:" string -^d8 ; "NUL:" (4) + crlflf (4) nul5: point 7, astnul ; Pointer to fixed "*NUL:" ASCIZ -^d5 ; Length of same .endps const ; End of constants .psect code/ronly ; Don't allow stores subttl Clear Control-O, if set ; Preserves all registers, +1 always ; ; This is concerned about the local controlling terminal, not anything ; remote over a pseudo-terminal, network or (maybe) pipe. clrcno: entry clrcno saveac ; Just don't touch move t1, $PRIOU ; Whatever is best to choose for primary output RFMOD% ; Find out about control-O ifje. r ; Failed?? move t4, t1 ; Save error, just in case setz t2, ; Assume ^O has not been typed move t1, $PRIOU ; Reload JFN or device, just in case endif. txzn t2, tt%osp ; Is Output suppress (^O) on? ret ; No, nothing to do SFMOD% ; Otherwise, turn it off ifje. r ; Failed?? But we just read it... move t4, t1 ; Save error, just in case move t1, $PRIOU ; Reload JFN or device, just in case endif. ret ; Done subttl typnam - Type a file name ; t1/ Output JFN or designator ; t2/ JFN to render ; ; Updates t1, if string pointer ; ; +1/ If failed along the way (t1 unchanged) ; +2/ Succeeded typnam: entry typnam ;[220] saveac ; Save these anyway move q1, t1 ; Save output designator setz t4, ; No string prefix or stop character caie t2, .nulio ;[193] NUL: talisman? ifskp. ;[193] Yes, that's easy dmove t2, nulptr ;[193] Point to equivalent string SOUT% ;[193] Counted SOUT% is faster ifje. r ;[194] Failed?? move t4, t1 ;[193] Save error for debuggers move t1, q1 ;[193] Restore output designator ret ;[194] Give error return endif. ;]194] End SOUT% error handling else. ;[193] Otherwise, a real JFN setz t3, ; Default formatting JFNS% ; Type it someplace ifje. r ;[194] Failed?? move t4, t1 ;[194] Save error for debuggers move t1, q1 ;[194] Restore output designator ret ;[194] Give error return endif. ;]194] End JFN% error handling dmove t2, [ point 7, crlflf ;[194] Double linefeed -^d4 ] ;[194] Four characters total in string SOUT% ;[193] Counted SOUT% is faster ifje. r ;[194] Failed?? move t4, t1 ;[193] Save error for debuggers move t1, q1 ;[193] Restore output designator ret ;[194] Give error return endif. ;]194] End SOUT% error handling endif. ;[193] End .nulio special casing retskp ;[194] Won!! subttl Routine to type a file at the local terminal. ; Call: ; ; t1/ JFN of file to type ; t3/ Byte size ; ; Returns +1, If anything strange ; +2, Success ; ; Rewritten be a little more picky about the calling arguments and to ; use PMAP% instead of SIN%. Passing a HRROI in to a file opened in 8 ; bit mode did the wrong thing, anyway. ; ; Will also generate parity for a seven bit file, if we're asked to ; to do that. That should normally never happen as the monitor should ; be handling this. The code here is largely for testing purposes. ; ; Note: The routine checks for a byte size between 1 and 36, however ; only a byte size of 7 or 8 are properly handled, everything ; but 8 being displayed as a seven bit (I.E., ASCII) file. This ; will properly type 36 bit listings generated by PA1050 and is ; no worse then the previous (incorrect) behavior. ; ; N.B., For an eight bit file, parity must be ignored--you're on your ; own... typfil: entry typfil ;[220] saveac hrlz q1, t1 ; Save JFN, start at file page zero tlz t1, -1 ; Whack any flags left lying around cain t1, .nulio ; Asked to type NUL:? retskp ; That's easy; we're done already! ifg. t3 ; Could the byte size be reasonable? caile t3, ^d36 ; Yes, but is it actually so? anskp. ; No, it's delusional move q2, t3 ; It's fine, so save the validated file byte size else. ; Otherwise, byte size is some kind of gubbish txmsg <% KERMIT-20 can not type a file with a byte size of: > movei t1, .priou ; continue on this terminal move t2, t3 ; Load it where NOUT% wants it movei t3, ^d10 ; Base ten NOUT% ; Type the bogus byte size ifje. r ; Catch and ignore error move t4, t1 ; Store error for debugger txmsg <*ERROR*> ; About as good as we can do endif. ; End NOUT% error handling hrroi t1, crlf ; Tie off the line PSOUT% ret ; Return a failure endif. ; End byte size checking GTSTS% ; Otherwise, see if we can use the JFN at all ifje. r ; Failed?? move t4, t1 ; Store error for debugging emsg ;Begin complaining movei t1, .priou ; continue on this terminal hlrz t2, q1 ; Load JFN, which was stored prepratory to PMAP%ing movei t3, ^d8 ; JFN's are base 8 NOUT% ; Type it (or try to, anyway) ifje. r ; Catch and ignore error move t4, t1 ; Store error for debugger txmsg <*ERROR*> ; About as good as we can do endif. ; End NOUT% error handling hrroi t1, crlf ; And tie off the complaint PSOUT% ret ; And get out of here endif. ; End case JSYS error handling ifxe. t2, gs%nam ; So does anything in there smell like a JFN? move t4, t1 ; Store error for debugging emsg ;Begin complaining movei t1, .priou ; continue on this terminal hlrz t2, q1 ; Load JFN, which was stored prepratory to PMAP%ing movei t3, ^d8 ; JFN's are base 8 NOUT% ; Type it (or try to, anyway) ifje. r ; Catch and ignore error move t4, t1 ; Store error for debugger txmsg <*ERROR*> ; About as good as we can do endif. ; End NOUT% error handling hrroi t1, crlf ; And tie off the complaint PSOUT% ret ; And get out of here else. ; Otherwise, at least the JSYS worked move t4, t2 ; So save the status bits past the DVCHR% endif. ; End case initial JFN check DVCHR% ; Now let's have a look at the device ifje. r ; Failed?? move t4, t1 ; Get the error out of the way setob t2, t3 ; Assume no kind of device endif. load t3, dv%typ,t2 ; Pick up the device type cain t3, .dvnul ; Did this manage to slip through?? retskp ; Strangely, it did; silently ignore it cain t3, .dvdsk ; Not a disk? ifskp. ; Won't be mapping it, then emsg movei t1, .priou ; Carry on typing to the terminal hlrz t2, q1 ; Load the JFN (which we know is bound) setzb t3, t4 ; No special formatting or odd prefix JFNS% ; Tell us what we choked on ifje. r ; Catch and ignore error move t4, t1 ; Store error for debugger txmsg <*ERROR*> ; About as good as we can do endif. ; End NOUT% error handling hrroi t1, crlf ; And tie off the complaint PSOUT% ret ; And get out of here else. ; Ok to proceed hlrz t1, q1 ; Reload the JFN (which DVCHR% smashed) endif. SIZEF% ; Find the file size ifje. ; Failed?? move t4, t1 ; Get the error out of the way setzb t2, t3 ; Assume no kind of length hlrz t1, q1 ; Reload the JFN, just in case endif. ; Investigate SIZEF% results jumpe t2, rskp ; If no bytes, nothing to do. jumpe t3, rskp ; No pages to map? Nothing to do... dmove q3, t2 ; Save quantities as loop counters ifxe. t4, gs%opn ; Finally, is the file open? remark ; It isn't, but we can silently recover movx t2,fld(^d8,of%bsz)!of%rd ; Assume reading an 8 bit file caie q2, ^d8 ; But!! Not eight bit? movx t2,fld(^d7,of%bsz)!of%rd ; Everything else is 7 bit OPENF% ; Open it %jserr (,r) ; Punt endif. ; End case trying to recover from an unopened file call whakfp ; Whack anything left over ret ; Go no further if something failed caie q2, ^d7 ; 7 bit ASCII? ifskp. ; OK, routine type out movx t4,^d<512*<36/7>> ;Count of seven bit bytes in page hrli q2, () ;Using a seven bit pointer, then else. ; Otherwise, 8 bit ASCII movx t4,^d<512*<36/8>> ;So less bytes per page hrli q2, () ;and using an eight bit pointer endif. hrri q2, maporg ; Either way, coming from same address do. ; Finally enter loop context move t1, q1 ; Case I, load JFN and file page dmove t2, [ exp <.fhslf,,mappag>, pm%rd ] PMAP% ; Map it in, read-only %jserr (,r) ; Punt movn t3, t4 ; Let's assume the maximum camle t4, q3 ; Unless we are within the end of file movn t3, q3 ; Otherwise, just do remainder add q3, t3 ; Subtract off remaining total move t2, q2 ; Load the source pointer move t1, parity ; But! Are we putting parity on this? cain t1, none ; Anything but none means we might be doing exactly that ifskp. ; OK, some some kind of parity being done, check further hlrz t1, q2 ; Pick up the default pointer fields cain t1, () ; Not doing eight bit? anskp. ; No, can't put parity on an eight bit file skipe parpko ; Just doing parity on packets? anskp. ; Yes, so don't muck up the type out block. ; Generate the parity then saveac movni t1,^d<4*strblw*2> ; Load maximum count for combined buffers camle t1, t3 ; Overflow? (have to compare negative numbers backwards) move t3, t1 ; Clip down to maximum movei t1,strbuf ; Resolve address of string buffer hrli t1, <(point 8,0)> ;Finish building eight bit pointer call genpar ; Generate a new string with parity endbk. ; End block context endif. ; End case parity handling movei t1, .priou ; Type it on whatever primary output is SOUT% ; Counted SOUT% is efficient %jserr (,r) ; Punt jumple q3, endlp. ; Exit if done with all the characters addi q1, ^d1 ; Bump to next file page sojg q4, top. ; Do it, if any pages left enddo. ; Exit loop lexical context jrst whakfp ; Whack any pages subttl Character echoing routine. ; Need to do this because having tty open in binary mode overrides ccoc ; settings. t2 contains character to echo. ; ;[151] echo: entry echo ;[196] saveac ;[186] Must save all ACs. trz t2, 200 ; Strip any parity. move t3, t2 ; Make a copy of the character. cail t3, 40 ;[18] Check most common case first, caile t3, 126 ;[18] namely, whether it's a printable skipa ;[18] character. jrst echo2 ;[18] If so, just go print it. caig t3, 6 ; Check for control char, null thru ^F. jrst echo1 cain t3, 13 ; ^K jrst echo1 cail t3, 16 ; ^N-^Z caile t3, 32 skipa jrst echo1 cail t3, 34 ; ^\-^_ caile t3, 37 skipa jrst echo1 caie t3, 33 ;[194] ESC? ifskp. ;[194] Yes movei t2, "$" ; Echo as dollar sign jrst echo2 endif. ;[194] caie t3, 177 ;[194] DEL? ifskp. ;[194] Yes seto t3, ; So it echoes as ^? (100-1=77="?") jrst echo1 endif. ;[194] move t2, t3 ; Anything else, just type it. jrst echo2 echo1: skipg t1, ttyjfn ; Echo it on the tty. movei t1, .priou movei t2, "^" ; Print an uparrow BOUT %jserr (,) skipg t1, sesjfn ;[195] Logging? ifskp. ;[195] Yes skipn sesflg ;[195] Active? anskp. ;[195] No cain t1, .nulio ;[193] Just dumping it? anskp. ;[195] Yeah, don't even bother then BOUT ; Yes, do that. %jserr (,qlog) ; Error, print msg, close log, rtn from there. endif. ;[195] movei t2, 100(t3) ; Convert to char to uncontrollified version. echo2: skipg t1, ttyjfn ; Back to TTY. movei t1, .priou BOUT ; Print the character itself. %jserr (,) skipg t1, sesjfn ;[195] Logging? ifskp. ;[195] Yes skipn sesflg ;[195] Active? anskp. ;[195] No cain t1, .nulio ;[193] Just dumping it? anskp. ;[195] Yeah, don't even bother then BOUT ; Yes, do that. %jserr (,qlog) ; Error, print msg, close log, rtn from there. endif. ;[195] ret subttl Whack a file page, if it exists whakfp: entry whakfp ;[220] remark RPACS% ; Could have used this, but didn't ... move t1, maporg ; Did anything get left lying around? ifje. r ; No, so that's fine move t4, t1 ; But save the error for the curious retskp ; Succeed (since nothing to do) else. ; Otherwise, ditch whatever is there seto t1, ; Case IV, whacking a process page dmove t2, [ exp <.fhslf,,mappag>, 0 ] ; From our address space PMAP% ; Kick the page into oblivion %jserr (,r) endif. retskp ; And done subttl STATISTICS external variables extern nnak ; Number of NAK's seen extern ntimou ; Number of time outs extern pause ; Interpacket pause in milliseconds extern rpsiz ; Maximum receive packet size extern rtchr ; Total characters receieved extern rtot ; Received total characters extern sec ; Seconds (for figuring baud rate extern speed ; Line speed, if physical line extern spsiz ; Maximum send packet size extern statxt ; Status text extern stchr ; Total characters sent extern ewallt ;[207] Elapsed wall time block extern durtim ;[207] Prints a duration extern stot ; Sent total characters extern timerx ; Count of TIMER% JSYS errors extern ttibin ; BIN% counter extern ttildb ; ildb's over SIN%'ed data extern ttimax ; Maximum size a SIN% can do extern ttisin ; Largest SIN% we ever did subttl STATISTICS command $srvt: entry $srvt ;[194] skipa t1,[point 7, statxt] ;[216] Server statistics $stat: entry $stat ;[194] movei t1,.priou ;[189] Otherwise local smsg < Maximum number of characters in packet: > ;[189] srvnum rpsiz ;[189] smsg < received: > ;[189] srvnum spsiz ;[189] smsg < sent > ;[189] block. ;[207] Set up a stack frame for registers saveac ;[207] Holds a pointer to elapsed DK10 ticks double word movei q1,ewallt ;[207] Resolve address of elapsted wall time block dmove t2, .datus(q1) ;[207] Load the actual value or t2, t3 ;[207] Checking for non-zero either word ifn. t2 ;[207] Did this take any time, actually? smsg < Communications duration: > ;[207] It did move t2, q1 ;[207] So load pointer to the value call durtim ;[207] Print the duration smsg <, analysis: > ;[207] Close off endif. ;[207] End case elapsed DK10 ticks endbk. ;[207] Restore stack frame smsg < Sent: > ;[189] srvnum stot ;[189] smsg < Efficiency: > ;[189] move t2, stchr move t3, stot call peffif ;[189] Print Efficiency Factor smsg < Received: > ;[189] srvnum rtot ;[189] smsg < Efficiency: > ;[189] move t2, rtchr move t3, rtot call peffif ;[189] Print Efficiency Factor smsg < Total: > ;[189] move t2, rtot add t2, stot move t4, t2 ; Save the total number of chars. movei t3, ^d10 ;[194] NOUT% ;[194] erjmps .+1 ;[194] smsg < Efficiency: > ;[189] move t2, t4 ;[189] Load total of all communications chars move t3, stchr ;[189] Load file characters sent add t3, rtchr ;[189] add total receieved call peffif ;[189] One or the other will not be zero smsg < Total characters per second: > ;[189] skipg t3, t4 ;[207] Did we send anything. actually? ifskp. ;[207] Looks like it call gmkcps ;[207] Print characters per second anskp. ;[207] Unless some problem (like no time) else. ;[207] In either case, don't do any math smsg <[N/A]> ;[207] So say really can't do it endif. ;[207] End handling characters per second smsg < Effective data rate: > ;[189] skipn t3, stchr ;[189] Is the number of chars sent zero? move t3, rtchr ;[189] If so we were receiving. ifn. t3 ;[207] Was there any data? call gmkbps ;[189] Display a more readable baud rate else. ;[207] Otherwise, number makes no sense smsg <[N/A]> ;[207] So say it isn't applicable endif. skipg pvbaud ;[210] Do we have a virtual baud rate? skiple speed ;[207] or on a real terminal? call pspeef ;[207] Go print speed efficiency (maybe) ;[180]... smsg < ILDB: > ;[189] srvnum ttildb ;[189] smsg < SIN: > ;[189] srvnum ttisin ;[189] smsg < SIN Max: > ;[189] srvnum ttimax ;[189] smsg < BIN: > ;[189] srvnum ttibin ;[189] ;...[180] $stat4: skipn errptr ; Was there an error? jrst $statx ; If not, done. smsg < Canceled by error: > ;[189] move t2, errptr ;[189] setzb t3, t4 ;[189] SOUT% ;[189] ; If so output it. erjmps .+1 ;[189] hrroi t2, crlf ;[189] ;[50] SOUT% ;[189] erjmps .+1 ;[189] ;[36] Interpacket pause. $statx: smsg < Interpacket pause in effect: > srvnum pause ;[196] smsg < ms Timeouts: > ;[196] ;[54] How many timeouts and NAKs. srvnum ntimou ;[189] smsg < NAKs: > ;[189] srvnum nnak ;[189] ;[47][132] If debugging, tell most recent JSYS error. jumpe debug, $statz ;[132] Debugging? $statj: smsg < Last JSYS error: > ;[189] ; Yes, tell about last error. hrloi t2, .fhslf setz t3, ERSTR erjmps .+2 ;[189] Ignore strange error erjmps .+1 ;[189] Ignore stranger error smsg < Timer errors: > ;[189] ;[132] Also, give hints if anything is srvnum timerx ;[189] ; going wrong with timers. $statz: smsg < > ;[189] ret subttl Print Speed Efficiency (if we have some kind of baud rate) ; Rewrite of previous code for nanosecond resolution ; N.B., Code IGNORES split speed and uses only the recieve speed extern dblscl ; Double integer scaling factor chgsec(code,const) percnt: 100. ; Factor to range up to a percent 0. ; Double floating multiplier!! retsec pspeef: remark t1 ; It is DEADLY to touch t1!! remark ; Assumes these may be smashed remark t5, q1 ; These are aliased saveac ; Play it safe trvar <,,,,,> ; Naming conventions for transient variables remark dichrs ; Double Integer characters remark dfchrs ; Double floating characters remark dietic ; Double Integer elapsed ticks remark dfetic ; Double floating elapsed ticks remark disped ; Double integer speed remark dfsped ; Double floating speed setzb t2, t3 ; Let's assume we'll need to float dmovem t2, disped ; an integer dmovem t2, dfsped ; baud rate ldb t2,[POINTR(,nttype)] ;[210] Maybe remote, so find out ldb t3,[POINTR(,ntline)] ;[210] about our local line ifme. ptyflg ; Not connected to a pseudo terminal? skipe nrtflg ; Network remote? anskp. ; So do that caie t2, nw%nnt ; Not a network transport? anskp. ; No, so either a front end or PTY cain t3, nw%pt ; But!! Are we on a pseudo-terminal?? anskp. ; No, so can only be the front-end case smsg < Efficiency: > ; Begin more blat skiple t3, speed ; Load and check speed ifskp. ; Is this absurd? smsg <[SPEED ERROR]> ;Report speed error ret ; Leave, can't do anything else endif. ; end speed load and check setz t2, ; Assume hardware baud is not an unsigned int tlze t3, (1b0) ; Cast unsigned to signed long movei t2, ^d1 ; Propagate to high order dmovem t2, disped ; And store as the speed else. ; Otherwise, might have done virtual timing setz q1, ;[210] Let's assume we don't know what to load skipe ptyflg ;[210] Connected to a PTY? movei q1, pvbaud ;[210] Address of its virtual baud rate skipe nrtflg ;[210] How about an NRT? movei q1, dnbaud ;[210] Address of DECnet virtual baud rate ife. q1 ;[210] Still don't know? cain t3, nw%pt ;[210] A pseudo-terminal? movei q1, pvbaud ;[210] Address of its virtual baud rate cain t3, nw%mc ;[210] An NRT? movei q1, dnbaud ;[210] Address of DECnet virtual baud rate jumpe q1, R ;[210] If still nothing, then done endif. ;[210] Otherwise some valid address in q1 dmove t2, (q1) ;[210] Load any timing test data jumple t2, R ;[210] No test or bad test dmovem t2, dfsped ; Store precomputed virtual rate setob t2, t3 ; Cons up an impossible double integer baud rate dmovem t2, disped ; And store as the speed smsg < Pseudo-efficiency: > ; Begin pseudo-blat endif. ; End case local or remote instrumented PTY skipn t3, stchr ; Nothing sent? move t3, rtchr ; No, so this was a recieve ife. t3 ; Or did nothing happen at all? smsg <[N/A]> ; So say it isn't applicable ret ; And get out of here endif. setz t2, ; Assume characters are not unsigned int tlze t3, (1b0) ; Cast unsigned to signed long movei t2, ^d1 ; Propagate to high order dmovem t2, dichrs ; And store signed long block. ; Enter block context for better control flow dmove t2,ewallt+.datus ;Load double elapsed DK10 ticks jumpg t2, RSKP ; Non-zero high order is good jumpg t3, RSKP ; Ditto low order endbk. ; End block context ifskp. ; Positive number? dmovem t2, dietic ; Yes, so store elapsed wall time else. ; Otherwise, zero or negative smsg <[TIME ERROR]> ; Report time error ret ; Leave, can't do anything else endif. block. ; Enter block context to double float everything saveac ; Save precious T1 dmove t1, disped ; Load integer baud ifge. t1 ; Already did this? call dfloat ; Convert to double floating point ret ; Or not dmovem t1, dfsped ; Store double floating speed endif. ; Otherwise, already done dmove t1, dietic ; Load double integer elapsed ticks call dfloat ; Convert to double floating point ret ; But couldn't... dmovem t1, dfetic ; Store double floating elapsed ticks dmove t1, dichrs ; Load double integer characters dmul t1, dblscl ; Scale up by nanosecond ratio dmovem t3, dichrs ; Store scaled double integer elapsed ticks dmove t1, t3 ; Load same for double floating call dfloat ; Convert to double floating point ret ; Yet failed dmovem t1, dfchrs ; Store double floating characters retskp ; Indicate complete double floating success endbk. ; End block context, release frame ifskp. ; Worked dmove t2, dfchrs ; Load double floating characters dfmp t2, baud ; Convert to bits for baud rate else. ; Something went wrong... smsg <[DFLOAT ERROR]> ; Yes, whine about it ret ; Return, can't go any further endif. dfdv t2, dfetic ; Compute effective baud rate dfmp t2, percnt ; Scale to percentage dfdv t2, dfsped ; Divide by line rate to get efficiency call peffi0 ; Print it smsg < per cent> ;[189] ret endtv. ; End lexical context transient variables ;[207] End code insertion subttl Print real or virtual baud rate extern ntiblk ;[210] NTINF% of local line prntbd: skipe ptyflg ;[210] Connected to a PTY? jrst prntbv ;[210] Yes, show the virtual baud rate skipe nrtflg ;[210] How about an NRT? jrst prntbv ;[210] Yes, show the virtual baud rate remark pipflg ;[210] Connected via a pipe? remark prntbv ;[210] Yes, show the virtual baud rate ;[210] Load network and line type of local terminal ldb t1,[POINTR(,nttype)] ;[210] ldb t2,[POINTR(,ntline)] ;[210] caie t1, nw%nnt ;[210] Not a 'network' terminal? jrst prntnv ;[210] No see if it has a network virtual baud rate cain t2, nw%pt ;[210] But!! Are we on a pseudo-terminal?? jrst prntnv ;[210] We are, see if we did a speed test remark ;[210] Only other non-network terminal is FE: prntbs: skipg t2,speed ; If negative, we don't really know it. ifskp. ;[194] We know it txmsg < Speed: > ; Line speed. movei t1, .priou movei t3, ^d10 NOUT% erjmps .+1 txmsg < Bd> ;[210] Recognized suffix for "baud" endif. ;[194] ret ;[210] Either way, done prntnv: setz t1, ;[210] Let's assume we don't know what to load cain t2, nw%pt ;[210] A pseudo-terminal? movei t1, pvbaud ;[210] Address of its virtual baud rate cain t2, nw%mc ;[210] An NRT? movei t1, dnbaud ;[210] Address of DECnet virtual baud rate jrst prntcm ;[210] See if anything to print prntbv: setz t1, ;[210] Let's assume we don't know what to load skipe ptyflg ;[210] Connected to a PTY? movei t1, pvbaud ;[210] Address of its virtual baud rate skipe nrtflg ;[210] How about an NRT? movei t1, dnbaud ;[210] Address of DECnet virtual baud rate remark pipflg ;[210] Connected via a pipe? remark t1, pibaud ;[210] Address of its virtual baud rate prntcm: remark ;[210] Common virtual speed jumpe t1, r ;[210] Return if nobody is volunteering anything saveac ;[210] Preserve for proper return xct remark t5, q1 ;[210] Because t4:t5 pair used dmove t4, (t1) ;[210] Load virtual baud rate jumple t4, r ;[210] If nothing, then don't print anything txmsg < Pseudo Speed: > ;[210] Instrumented PTY speed movei t1, .priou ;[210] Display it on terminal callret gmkbp1 ;[210] Print the baud rate remark Test command semantic action ;[210] Begin Code Insertion extern dptybd ; Discover PTY: virtual baud rate extern dnulbd ; Discover NUL: virtual baud rate extern dpipbd ; Discover PIP: virtual baud rate extern dsrvbd ; Discover DECnet (DCN:/SRV:) virtual baud rate extern timdev ; Device being timed $time: intern $time ; Called from k20par saveac ; Just in case anybody might needit skipl t1, pars2 ; Pick up the device to test ifskp. ; Special return?? camn t1, [-1] ; Error that somebody else blatted? ret ; We're done hlrz t2, t1 ; Reposition source device type trz t2, .dvdes ; Now have a device number txmsg move t1, t2 ; Position for conversion to text call ascdev ; Do so PSOUT% ; Type the text txmsg < to > ; Where it's going move t2, pars3 ; Load destination device movem t2, pars2 ; Put where downstream wants it dmove t4, pars4 ; Load the timing results callret $time1 ; And go type something endif. movem t1, timdev ; Remember device being timed caie t1, .dvpty ; Pseudo-terminal? ifskp. ; Yep, so let's run that test setom pvbaud ; Say no PTY virtual baud rate setom pvbaud+1 ; It's a double call dptybd ; Found in k20net ifskp. ifle. t4 ; Did it work? emsg ret ; Can't do anything further endif. ; Otherwise, have a valid number else. emsg ret ; Can't do anything further endif. dmovem t4, pvbaud ; Side-effect virtual baud rate callret $time1 ; And display it endif. ; End case pseudo-terminal caie t1, .dvnul ; NUL: device? ifskp. ; OK, so let's see how fast we can dump stuff setom nlbaud ; Assume fails setom nlbaud+1 ; It's a double word call dnulbd ; Go do some nanosecond timing ifskp. ifle. t4 ; Did it work? emsg ret ; Can't do anything further endif. ; Otherwise, have a valid number else. emsg ret ; Can't do anything further endif. dmovem t4, nlbaud ; Store NUL's virtual baud rate callret $time1 ; Hit display epilogue endif. caie t1, .dvpip ; Pipe device? ifskp. ; Yep, so let's run that test setom pibaud ; Assume fails setom pibaud+1 ; It's a double word call dpipbd ; Found in k20net ifskp. ifle. t4 ; Did it work? emsg ret ; Can't do anything further endif. ; Otherwise, have a valid number else. emsg ret ; Can't do anything further endif. dmovem t4, pibaud ; Store the calculated baud rate callret $time1 ; Hit display epilogue endif. ; End case pseudo-terminal cain t1, .dvdcn ; DECnet active component? movei t1, .dvsrv ; Replace with DECnet passive component caie t1, .dvsrv ; DECnet? ifskp. ; Yep, so let's run that test setom dnbaud ; Assume no DECnet baud rate detected setom dnbaud+1 ; It's a double call dsrvbd ; Found in k20net ifskp. ifle. t4 ; Did it work? emsg ret ; Can't do anything further endif. ; Otherwise, have a valid number else. emsg ret ; Can't do anything further endif. dmovem t4, dnbaud ; Store the calculated baud rate callret $time1 ; Hit display epilogue endif. ; End case pseudo-terminal call ascdev ; Turn device number in t1 into a name ESOUT% ; Begin whining txmsg < does not have a timing routine > ; Complete whining ret ; Beat it subttl Handle unknown and known timing devices ; Call: ; ; t1/ Device number to translate ; ; Return: +1 always ; ; t1/ pointer to constructed device text ; (even if unknown device) chgsec(code,data) ; Need some writable storage devtxt: block 4 ; Space for ASCII device name retsec ; Close off writable storage chgsec(code,text) ; Emit some program text unktxt: asciz "Unknown:" ; if we have no clue dvpunc: exp ":", .chnul ; Device punctuation retsec ; Close off program text ascdev: intern ascdev ; In case K20TIM wants to directly use it saveac ; Needs some registers move q1, t1 ; Save device number call devunt ; If device has units, use that jumpn t1, r ; Was transformed ; OK, not a device with units hrloi t2, .dvdes(q1) ; Turn back into a real device movei t1, devtxt ; Writable to put ASCII device name setzb t3, t4 ; Ten .chnul's of device name (6 max) dmovem t3, 0(t1) ; Stomp area dmovem t3, 2(t1) ; Plus extra for good measure tlo t1, -1 ; Now have a Tops-20 JSYS pointer DEVST% ; Turn into a string ifje. r ; Catch error move t2, t1 ; And keep for a debugger hrroi t1, unktxt ; Say we don't know... else. ; Otherwise, have some text dmove t2, dvpunc ; Load device punctuation idpb t2, t1 ; Drop in the colon move t2, t1 ; Copy the pointer idpb t3, t2 ; Close off string, allowing append hrroi t1, devtxt ; Return pointer to constructed text endif. ret ; Finally return, something... subttl devunt Turns a device with unit numbers into generic ;Can't use chgsec here, doesn't nest define gendev(d,t,%a) < xwd d,%a ;;Create an entry for this device .endps const ;;Out of constants .psect text ;;Program text %a: asciz "'t:" ;;Emit the text, no output to DDT .endps text ;;Close of text .psect const ;;Back in constants cleans(<%a>) >;;gendev ; Build table of generic device text for unit based devices ; The first three currently exist on PANDA and can be entered to .cmdev chgsec(code,const) gentab: gendev(.dvpty,PTY) ;;Pseudo-terminal (most common) gendev(.dvtty,TTY) ;;Terminal (second most common) gendev(.dvfe,FE) ;;Front end (may get noticed) remark ;;Otherwise, do in numeric order gendev(.dvmta,MTA) ;;Physical magnetic tape gendev(.dvdta,DTA) ;;1031 had these as does MOUNTR gendev(.dvptr,PTR) ;;Paper tape reader gendev(.dvptp,PTP) ;;Paper tape punch gendev(.dvdsp,DIS) ;;Display gendev(.dvlpt,LPT) ;;Line printer gendev(.dvcdr,CDR) ;;Card reader gendev(.dvplt,PLT) ;;Plotter gendev(.dvcdp,CDP) ;;Card punch remark ; N.B., .dvats usurped by .dvnft ; gendev(.dvats,ATS) ;;Applications terminal SERVICE gendev(.dvads,ADS) ;;Aydin display 0 ; Mark end of table retsec ; Call: t1/ Device number, as per MONSYM ; Return: t1/ Maybe a pointer if a unit based device devunt: saveac ; Just in case we get careless move t3, t1 ; Move device number to someplace safer setz t1, ; Let's assume not a unit based device movei t4, gentab ; Load address of generics table do. ; Enter loop context hlrz t2, (t4) ; Load candidate device number jumpe t2, r ; If empty, none of the above camn t2, t3 ; Hit our device, yet? exit. ; Hot zing! Have a string to return aoja t4, top. ; Otherwise, next device enddo. ; Exit loop context hrro t1, (t4) ; Pick up address of text ret ; Return as a Tops-20 pointer subttl Common Display Epilogue ; T4/T5 Baud rate to display $time1: move t1, pars2 ; Load device number call ascdev ; Turn into a reasonable string PSOUT% ; Type it dmove t1, [exp .priou, .chspc] BOUT% ; And space over callret gmkbp1 ; Print the baud rate hrroi t1, crlf ; Tie off the line PSOUT% ret ; And done ;[210] End code insertion subttl SHOW VERSION extern $verno ;[194] Major version extern $mnver ;[194] Minor version extern $edno ;[194] Edit number extern $who ;[194] Who last edited $shtop: entry $shtop ;[194] ;[39] Top of SHOW command. $shver: entry $shver ;[194] txmsg movei t1, .priou ;[194] dmove t2, [ $verno ;[197] major version ^d10 ] ;[197] Using decimal versions NOUT% ;[194] erjmps .+1 ;[194] skipn t2, [$mnver] ;[197] ifskp. ;[197] minor version movei t1, "." ;[95] Use new decimal notation PBOUT ;[95] erjmps .+1 ;[194] movei t1, .priou ;[194] NOUT% ;[194] erjmps .+1 ;[194] endif. ;[194] skipn t2, [$edno] ;[197] edit ifskp. ;[197] movei t1, "(" PBOUT erjmps .+1 ;[194] movei t1, .priou ;[194] NOUT% ;[194] erjmps .+1 ;[194] movei t1, ")" PBOUT erjmps .+1 ;[194] endif. ;[194] skipn t2, [$who] ;[197] who ifskp. ;[197] movei t1, "-" PBOUT erjmps .+1 ;[194] movei t1, .priou ;[194] NOUT% ;[194] erjmps .+1 ;[194] endif. ;[194] hrroi t1, crlflf ;[194] PSOUT% ;[194] xct q1 ;[39] return or proceed... remark ;[194] May fall through .. subttl SHOW DAYTIME $shday: entry $shday ;[194] dmove t1, [ exp .priou, -1 ] ;[194] Current date and time. movx t3, ot%day!ot%fdy!ot%fmn!ot%4yr!ot%dam!ot%spa!ot%scl ODTIM% erjmpr .+1 ;[194] Catch and ignore error call moon ; Phase of the moon. hrroi t1, crlflf ;[194] PSOUT% ;[194] xct q1 ;[39] return or proceed... remark ;[194] May fall through .. subttl SHOW LINE external variable usage (all [194]) extern rosnpt ; Remote operating system name pointer extern brk ; Number of NUL's to send to simulate a break extern carier ; On a modem line, set if have carrier extern duplex ; Line duplex setting extern escape ; Escape character extern flow ; Type of flow control, if any extern handsh ; Handshake character extern local ; Set if in local mode extern mdmlin ; Set if dial-up line extern mytty ; Current logged in line (if not detached) extern nbict ; Network BIN% count extern netjfn ; Network JFN (even if we're remote...) extern nodnam ; Remote DECnet node name extern nodnum ; Remote DECnet node number (if monitor supports this) extern nrtflg ; Set if a valid Network Remote Terminal extern ptyflg ; Set if doing pseudo-terminal I/O extern ptynam ; ASCII device name extern sesflg ; Set if session logging is active extern sesjfn ; Contains session logging jfn extern ttynum ; Number of terminal being used extern tvtchk ; Set if doing TVT discovery extern tvtflg ; Set if must negotiate binary mode on TVT extern vbict ; Virtual Terminal BIN% Count extern vchrcn ; Total characters flushed virtual terminal extern inpcbf ; INPUT network Characters Buffer Flushed extern vtermf ; Set if virtual line (I.E., PTY or NRT) remark ;[223] Parity storage extern parity ; Type of parity in use extern none ;[223] No parity being enforced extern space ; Space parity routine (0, always) extern mark ; Mark parity routine (1, always) extern even ; Even parity routine extern odd ; Odd parity routine extern parpko ;[223] Non-zero if doing parity on packets, only extern parrck ;[223] Checking parity on recieve in addition to sending extern ttipar ;[223] Total parity errors for session extern genpar ;[223] Use string instructions to generate a new string extern strc ;[223] Count of characters in temporary buffer extern strptr ;[223] Appropriate pointer to same extern strbuf ;[223] Global address of string buffer remark strbf2 ;[223] Flows into this, too remark ; DECnet information (is in k20net) extern mynode ; Number of local executor (us) extern myname ; Local executor name extern ndvfxp ; If monitor has extended node verify (T79) remark Some support routines extern chklin ; Checks a line's status, physical, network, Etc. subttle SHOW LINE display $shlin: entry $shlin ;[194] Also used in command loop ifmn. nrtflg ;[186] DECnet NRT? txmsg ;[186] hrroi t1, nodnam ;[186] Point to the node PSOUT% ;[186] Type it txmsg <::> ;[186] Trailing punctuation remark ;[186] If we don't have T79, see if we can fake it ifme. ndvfxp ;[186] Does the monitor NOT have extended node verify? dmove t1, myname ;[186] Load only node name we really know about block. ;[186] Enter block context for easier decisioning came t1, nodnam ;[186] DECnet node name is maximum of six ASCII bytes ret ;[186] First 5 characters didn't match came t2, nodnam+1 ;[186] How about the last character? ret ;[186] Didn't match ... retskp ;[186] Connection is to local node! endbk. ;[186] Tear down block frame ifskp. ;[186] +2 means we knew the node inately move t3, mynode ;[186] Load number of local executor (that's us!) movem t3, nodnum ;[186] Stomp into connection data endif. ;[186] End case attempted node recognition endif. ;[186] End case monitor does not have T79 remark ;[186] N.B., requires monitor edit T79 skipg t4, nodnum ;[186] Do we know the node number? ifskp. ;[186] We do, let's type it txmsg ( [) ;[186] Appropriately open broket it movei t1, .priou ;[186] Still going to terminal movei t3, ^d10 ;[186] Node numbers are in octal ldb t2,[pointr t4,n%area] ;[186] Load DECnet Area Number ifn. t2 ;[186] If none, may be phase II ... NOUT% ;[186] Otherwise, type it erjmps .+1 ;[186] Catch and suppress error movei t2, "." ;[186] Punctuation suffix for areas BOUT% ;[186] Punctuate the node number erjmps .+1 ;[186] Catch and suppress error endif. ;[186] End case non-zero area ldb t2,[pointr t4,n%node] ;[186] Load DECnet Node Number NOUT% ;[186] Type it erjmps .+1 ;[186] Catch and suppress error movei t2, "]" ;[186] Close broket BOUT% ;[186] Trailing punctuation on DECnet node number endif. ;[186] End case known node number move t4, rosnpt ;[186] Load remote operating system name pointer camn t4, [-1] ;[186] Not our special bogon talisman? ifskp. ;[186] No, it's a valid text pointer txmsg < (> ;[186] Put it in parenthesis move t1, t4 ;[186] Load pointer to the remote os name PSOUT% ;[186] Type it movei t1, ")" ;[186] Closing parenthesis PBOUT% ;[186] Tie off the operating system name endif. ;[186] End case known remote operating system txmsg < (Network Remote Terminal, KERMIT-20 is LOCAL)> ;[186] Not using any local TTY jrst $show3 ;[186] Skip the modem control endif. ;[186] End case DECnet NRT txmsg numout ttynum, 8 came t2, ctynum ;[223] Is this the console? ifskp. ;[223] Yes, remark about that txmsg < [Console]> ;[223] A discrete indicator endif. ;[223] ifme. ptyflg ;[186] Physical line? move t4, mytty ; See whether we're local or remote... came t4, ttynum ; If it's us ifskp. ; Then we are the remote txmsg < (job's controlling terminal, KERMIT-20 is REMOTE)> else. ; Anything else means we're local txmsg < (assigned TTY line, KERMIT-20 is LOCAL)> endif. else. ;[186] Otherwise, it's a pseudo terminal txmsg (< [>) ;[186] Type opening broket hrroi t1, ptynam ;[186] Load the name of the pseudo-terminal PSOUT% ;[186] Type the punctuated device movei t1, "]" ;[186] Load closing broket PBOUT% ;[186] and type that txmsg < (pseudo-terminal loopback to > ;[186] hrroi t1, myname ;[186] Name of local node PSOUT% ;[186] Type that txmsg <::, KERMIT-20 is LOCAL)> ;[186] jrst $show3 ;[186] PTY never has modem control endif. ;[186] End case terminal check skipg t1, netjfn ;[186] Tell about modem control & carrier. move t1, ttyjfn ;[186] Unless using local terminal call chklin ifmn. mdmlin ;[194] txmsg < Line has modem control Carrier: > ifmn. carier ; Is it? txmsg ; Say it's on. else. ; Otherwise... txmsg ; No. endif. endif. ;[194] $show3: txmsg < Handshake: > ;[76] Handshake skipe t1, handsh ;[194] Any? ifskp. ;[194] Blew up the front end, anyway txmsg else. ;[194] Otherwise, type it call putc endif. ;[194] txmsg < Flow-Control: > ;[143] ifmn. flow txmsg else. txmsg endif. ifmn. local ;[194] Don't confuse them with this txmsg < Escape Character: > ;[217] Present the escape character move t1, escape call putc endif. ;[194] $show4: txmsg < Parity: > move t2, parity xmovei t1, enone ; None cain t2, space ; Space xmovei t1, espac cain t2, mark ; Mark xmovei t1, emark cain t2, odd ; Odd xmovei t1, eodd cain t2, even ; Even xmovei t1, eeven txo t1, .px7 ; Turn into a OWGP PSOUT% ; Finally type something cain t2, none ;[223] Doing any parity at all? jrst $sho4a ;[223] No, skip domains dmove t2, parpko ;[223] Load parity domains move t4, t2 ;[223] See if doing either or t4, t3 ;[223] by seeing if either were set jumpe t4, $sho4a ;[223] If zero, no domain modification move t4, t2 ;[223] See if doing both and t4, t3 ;[223] by seeing if both set movei t1, .chspc ;[223] Space over PBOUT% ;[223] movei t1, "[" ;[223] Open broket PBOUT% ;[223] ifn. t2 ;[223] Packets Only? txmsg () ;[223] endif. ;[223] ifn. t4 ;[223] Plural? movei t1, "," ;[223] Yes, wants a comma, then PBOUT% ;[223] endif. ;[223] ifn. t3 ;[223] Not just generating parity? txmsg () ;[223] endif. ;[223] movei t1, "]" ;[223] Close broket PBOUT% ;[223] skipn t4, ttipar ;[223] Any parity errors?? ifskp. ;[223] Yes, type these txmsg < Parity Errors: > ;[223] numout t4 ;[223] Type how many endif. ;[223] Done or nothing to do $sho4a: txmsg < Duplex: > ;[18] move t2, duplex caie t2, dxfull ifskp. txmsg else. txmsg endif. skipg t2,speed ; If negative, we don't really know it. ifskp. ;[194] We know it txmsg < Speed: > ; Line speed. movei t1, .priou movei t3, ^d10 NOUT% erjmps .+1 endif. ;[194] txmsg < Break Simulation: > ifmg. speed txmsg numout brk txmsg < NULs at 50 baud> else. txmsg endif. skipn vtermf ;[186] Virtual terminal? jrst $sho4e ;[186] No, then this makes no sense ifme. ptyflg ;[186] Unless loopback txmsg < NRT Connection: > ;[186] Status of connection else. txmsg < PTY Connection: > ;[186] Status of connection endif. ;[186] skipg t1,netjfn ;[186] Load line to check move t1, ttyjfn ;[186] Unless using local terminal call chklin ;[186] Check 'line' status ifmn. carier ;[186] However, is it? txmsg ;[186] Assume good news else. txmsg ;[186] It isn't, sigh... endif. ;[186] Either way, tell us call prntbd ;[210] Print some kind of baud rate maybe move t1, vbict ;[186] Ever connected? add t1, nbict ;[186] any network output ifn. t1 ;[186] Yes to either one means display something call disper ;[186] Display information concerning performance endif. remark $sho4e ;[186] Falls through $sho4e: skipg t4, sesjfn ;[195] Are we logging? ifskp. ;[195] Well, are we? ifmn. sesflg ;[195] BUT!! Are we actively logging right now? txmsg < Log: (Enabled) > ;[220] else. ;[220] Otherwise, not ACTIVELY logging txmsg < Log: (Disabled) > ;[220] endif. ;[220] move t2, t4 ;[220] Reload the logging JFN movei t1, .priou ;[220] Typing on the terminal? caie t2, .nulio ;[193] Efficiently dumping it? ifskp. ;[193] Yes, that's a constant string dmove t2, nul5 ;[193] Point to said string SOUT% ;[193] Counted SOUT% is faster %jserr (,) ;[193] ?? else. ;[193] Otherwise, a 'real' JFN movx t2, .chspc ;[193] Space over BOUT% ;[193] So columns line up %jserr (,) ;[194] ??? move t2, t4 ;[193] Restore the logging JFN setzb t3, t4 ;[193] Use default formatting, no prefix JFNS ; Say what it is. %jserr (,) ;[194] move t1, t2 ;[240] Load the file JFN RFPTR% ;[240] Get the current position in the file ifje. r ;[240] Couldn't ... move t4, t1 ;[240] Save the error for debugging heros seto t2, ;[240] Flag an error for downstream endif. ;[240] End case JSYS error handling ifg. t2 ;[240] Only display if we've written something txmsg <, > ;[240] Punctuate and space over movei t1, .priou ;[240] Still going to terminal movx t3, fld(^d10,no%rdx) ;[240] Byte count is decimal NOUT% ;[240] Type it %jserr (,) ;[240] txmsg < Bytes Written> ;[240] endif. ;[240] End case displaying file offset endif. ;[193] End .nulio special casing endif. ;[194] End case session logging JFN open $sho4f: ifme. nrtflg ;[223] Not if NRT; line number is meaningless move t1, ttynum ;[223] Load line number (FE or TTY# of PTY, if PTY) call getnti ;[223] Get network information on this line anskp. ;[223] Failed, so better skip the line characteristics remark t1, ;[223] Network Type from NTINF% remark t2, ;[223] Line Type from NTINF% move t3, ttynum ;[223] Load line number call linchr ;[186] Show some things endif. ;[223] $sho4h: remark ;put next one here... $sho4x: hrroi t1, crlflf ;[194] Double line feed PSOUT% ;[194] Tie off the blat xct q1 ;[39] return or proceed... remark ;[194] May fall through .. subttl SHOW FILE-INFO external variables extern abtfil ; Set if keeping a file, zero to discard extern autbyt ; Set if doing auto-bytesize detection extern ebtflg ; Set if forcing 8-bit mode extern tbtflg ;[223] ; Set if forcing 36-bit mode extern expung ; Set if deletes are expunging extern itsflg ; Flag for handling ITS-binary format files extern tlgjfn ; Transaction log JFN extern xfnflg ; Flag for filename conversion subttl SHOW FILE-INFO display logic $shfil: entry $shfil txmsg ifme. autbyt ;[194] Not auto-byte ifme. tbtflg ;[232] Not 36 bit ifme. ebtflg txmsg else. txmsg endif. else. ;[232] Really post-processed 7 bit mode txmsg endif. ;[232] else. txmsg endif. ;[194] txmsg < File name conversion: > ;[84] ifme. xfnflg ;[84] txmsg ;[84] else. ;[84] txmsg ;[84] endif. ;[84] txmsg < ITS-binary-format file recognition: > ;[75] ifmn. itsflg ;[75] txmsg ;[75] else. ;[75] txmsg ;[75] endif. ;[75] txmsg < Disposition for incomplete incoming files: > ;[42] ifme. abtfil ;[42] txmsg ;[42] else. ;[42] txmsg ;[42] endif. ;[42] txmsg < Deleted files are > ;[143] ifme. expung ;[194] txmsg ;[194] endif. ;[194] txmsg ;[126] skipg t2, tlgjfn ; Any transaction log? ifskp. ;[194] Yes movei t1, .priou ; Yes, a real file, setz t4, ;[193] Let's assume no prefix or stop character caie t2, .nulio ;[193] Efficiently dumping it? ifskp. ;[193] Yes, that's a constant string dmove t2, nul5 ;[193] Point to said string SOUT% ;[193] Counted SOUT% is faster %jserr (,) ;[193] ?? else. ;[193] Otherwise, a 'real' JFN setz t3, ;[194] Use default formatting JFNS ; Say what it is. %jserr (,) ;[194] move t1, t2 ;[240] Load the file JFN RFPTR% ;[240] Get the current position in the file ifje. r ;[240] Couldn't ... move t4, t1 ;[240] Save the error for debugging heros seto t2, ;[240] Flag an error for downstream endif. ;[240] End case JSYS error handling ifg. t2 ;[240] Only display if we've written something txmsg <, > ;[240] Punctuate and space over movei t1, .priou ;[240] Still going to terminal movx t3, fld(^d10,no%rdx) ;[240] Byte count is decimal NOUT% ;[240] Type it %jserr (,) ;[240] txmsg < Bytes Written> ;[240] endif. ;[240] End case displaying file offset endif. ;[193] End .nulio special casing else. ;[194] Otherwise, don't have one txmsg <(none)> endif. ;[194] hrroi t1, crlflf ;[194] PSOUT% ;[194] xct q1 ;[39] return or proceed... remark ;[194] May fall through .. subttl SHOW DEBUG extern logbsz ;[41] Log file byte size. extern logjfn ; Log file JFN extern pdcodf ;[221] If Packet Debug is also doing decoding extern mhptod ;[239] If monitor supports high precision $shdeb: entry $shdeb txmsg move t1, debtab(debug) PSOUT% caie debug, 2 ;[221] Are we debugging packets (I.E., dumping them?)? ifskp. ;[221] Indeed we are ifmn. pdcodf ;[239] Yes; are we decoding them? ifmn. mhptod ;[239] Some extra-soothing blat txmsg < [Decoding, 10 microsecond resolution]> ;[239] else. ;[239] Otherwise, monitor doesn't have HPTIM% .HPTOD txmsg < [Decoding, 1 millisecond resolution]> ;[239] endif. ;[239] End case reporting decoding granularity else. ;[239] Not decoding, so don't remark about that ifmn. mhptod ;[239] Some extra-soothing blat txmsg < [10 microsecond resolution]> ;[239] else. ;[239] Otherwise, monitor doesn't have HPTIM% .HPTOD txmsg < [1 millisecond resolution]> ;[239] endif. ;[239] End case reporting non-decoding granularity endif. ;[239] End case granularity reporting endif. ;[221] End special case debugging packets ifn. debug ;[194] Only if actually debugging something txmsg < Debugging log file: > ;[38] skipg t2, logjfn ;[198] Load debugging log file JFN (if there is one) ifskp. ;[194] There is, let's type something movei t1, .priou ; Yes, a real file, setz t4, ;[193] Let's assume no prefix or stop character caie t2, .nulio ;[193] Efficiently dumping it? ifskp. ;[193] Yes, that's a constant string dmove t2, nul5 ;[193] Point to said string SOUT% ;[193] Counted SOUT% is faster %jserr (,) ;[193] ?? else. ;[193] Otherwise, a 'real' JFN setz t3, ;[194] Use default formatting JFNS ; Say what it is. %jserr (,) ;[194] move t1, t2 ;[240] Load the file JFN RFPTR% ;[240] Get the current position in the file ifje. r ;[240] Couldn't ... move t4, t1 ;[240] Save the error for debugging heros seto t2, ;[240] Flag an error for downstream endif. ;[240] End case JSYS error handling ifg. t2 ;[240] Only display if we've written something txmsg <, > ;[240] movei t1, .priou ;[240] Still going to terminal movx t3, fld(^d10,no%rdx) ;[240] Byte count is decimal NOUT% ;[240] Type it %jserr (,) ;[240] txmsg < Bytes Written> ;[240] endif. ;[240] End case displaying file offset endif. ;[198] End .nulio special casing txmsg <, Byte Size >;[240] numout logbsz ;[41] else. ;[194] Otherwise, don't have a debugging log file txmsg < (none)> ;[38] None. endif. ;[194] End log file printing decision endif. ;[194] End case debugging hrroi t1, crlflf ;[194] PSOUT% ;[194] xct q1 ;[39] return or proceed... remark ;[194] May fall through .. subttl SHOW PACKET-INFO external variables (all [194]) extern bctr ; Block check type requested (character). extern bctu ; Block check type in use (number). extern ebq ; 8th-bit-on prefix. extern ebqflg ; 8th-bit prefixing flag. extern ebqr ; 8th-bit prefix field for Send-Init. extern reolch ; EOL character Tops-20 needs. extern rpadch ; Padding character Tops-20 wants. extern rpadn ; Number of padding characters for Tops-20. extern rptflg ; Repeat count processing flag. extern rptq ; Repeat count prefix. extern rquote ; Quote character Tops-20 wants. extern rsthdr ; Start of header character to receive. extern seolch ; EOL character micro needs. extern spadch ; Padding character micro wants. extern spadn ; Number of padding characters for micro. extern squote ; Quote character micro wants. extern ssthdr ; Start of header character to send. subttl SHOW PACKET-INFO display code ;[100] New headings, less confusing. $shpkt: entry $shpkt txmsg numout rpsiz txmsg < > numout spsiz move t1, rpadn ;[194] Load receive padding count add t1, spadn ;[194] Add sending padding count ifg. t1 ;[194] Only print characters if actually padding txmsg < characters Padding: > numout rpadn txmsg < > numout spadn txmsg < Pad Character: > move t1, rpadch call putc txmsg < > move t1, spadch call putc endif. ;[194] txmsg < End-Of-Line: > move t1, reolch call putc txmsg < > move t1, seolch call putc txmsg < Control Prefix: > move t1, rquote call putc txmsg < > move t1, squote call putc txmsg < Start-Of-Packet: > move t1, ssthdr ;[18] call putc txmsg < > move t1, rsthdr ;[18] call putc ;[100] New headings for this stuff. txmsg < Requested Used 8th-bit Prefix: > ;[88] Begin addition ifmn. ebqr ;[194] Did our user request 8th bit prefix? move t1, ebq ; Yes. call putc ; Say what it is. txmsg < > else. ;[194] Otherwise, don't have one txmsg <(none) > ; Just say we'll do it if asked. endif. ;[194] ifmn. ebqflg ;[194] Was it used during last transfer? move t1, ebq ; Looks like it, say what prefix. call putc else. ;[194] Wasn't used txmsg <(none)> ; Just say we would have done it if asked. endif. ;[194] txmsg < Repeat Prefix: > ;[92] Begin addition move t1, rptq ; What we would use to flag repeat counts. call putc txmsg < > ifmn. rptflg ;[194] Was it actually used? move t1, rptq ;[194] Show it call putc else. ;[194] Otherwise didn't use it txmsg <(none)> ; Just say we would have done it if asked. endif. ;[194] txmsg < Block Check: > ;[98] Block check type. move t1, bctr call putc txmsg < > numout bctu ;[98] hrroi t1, crlflf ;[194] Tie off the line PSOUT% xct q1 ;[39] return or proceed... remark ;[194] May fall through .. subttl SHOW TIMING-INFO external variable usage extern delay ; Milliseconds to wait before sending first packet extern delayf ; Same number as floating point seconds extern imxtry ; Maximum retries in send initiate. extern maxtry ; Maximum retries for an ordinary packet. extern rpause ; Pause before ACKing data packet. extern rpausf ; Same number as floating point extern rtimou ; Minimum timeout interval Tops-20 needs. extern spause ; Pause before sending data packet. extern spausf ; Same number as floating point extern srvtim ; Server command wait timeout interval. extern stimou ; Interval for current timer subttl SHOW TIMING-INFO numeric output flags ;[212] Begin code Insertion remark Complex flag usage set up ; Integer and floating output flags to line up columns. ; The hairy floating flags can be found in DOC:JSYS_REFERENCE.MEM, ; section 2.9.1.2, table xx, pages 2-87, 88. ; Integer flags int%f== .xcref int%f ; Don't need on cross reference suppress int%f ; Don't want in symbol table listing show. (int%f) ; Show final word ; Floating point flags flt%f==0 ; Floating output flags; no output to DDT .xcref flt%f ; No need on the cross reference suppress flt%f ; No need in symbol table listing define fltf (v,f) < ;;Define a macro to build floating flag word ifnb ,< ;;Non-blank field specified? flt%f==> ;; OR in the value in the field >;; ifnb ifb ,< ;;Blank field? flt%f==> ;;OR in the bit >;; ifb .xcref flt%f ;;Still don't need on cross reference >;; fltf fltf(.flspc,fl%sgn) ;;First character is a space fltf(.fllsp,fl%jus) ;;Right justify, leading spaces fltf(fl%one) ;;Output at least one digit fltf(fl%pnt) ;;Output the decimal point, always fltf(.flexn,fl%exp) ;;Don't output an exponent fltf(fl%ovl) ;;Output on overflow fltf(^d6,fl%fst) ;;Properly justify integral portion fltf(^d4,fl%snd) ;;Digits in second field show. (flt%f) ;;Finally show what we got ;[212] End code insertion subttl SHOW TIMING-INFO code remark Timeout in floating seconds and integral milliseconds $shtim: entry $shtim seto t4, ;[212] Let's suppose no time outs txmsg ;[212] dmove t1,rtimou ;[212] Load timeout int ms and floating seconds ifn. t1 ;[212] Prefer int (because of a parser fluke) movei t1, .priou ;[212] dmove t3, [exp flt%f,0] ;[212] Special columnar formatting, flag non-zero FLOUT% ;[212] erjmps .+1 ;[212] txmsg < > ;[212] Two spaces to send column else. ;[186] Otherwise, special case it txmsg < (none) > ;[186] Make it STAND OUT endif. ;[186] End special casing recieved dmove t1,stimou ;[212] Load timeout int ms and floating seconds ifn. t1 ;[212] Prefer int (because of a parser fluke) movei t1, .priou ;[212] dmove t3, [exp flt%f,0] ;[212] special columnar formatting, flag non-zero FLOUT ;[212] erjmps .+1 ;[212] else. ;[194] Otherwise, who knows? txmsg < (none)> ;[212] Five spaces endif. ;[194] remark ;[212] If never printed a time out, suppress ms's ife. t4 ;[212] Ever do anthing? txmsg < sec (> ;[212] Yes, so label the seconds field numout [maxtim/^d1000] ;[212] txmsg < max) > ;[212] skipg t2,rtimou ;[212] Non-zero receive timeout? ifskp. ;[212] Yes,display it txmsg < > ;[212] One tab, seven spaces to recieve field movei t1, .priou ;[194] movx t3, int%f ;[212] Special integer formatting NOUT% ;rtimou ;[186] Not rrtimo ... erjmps .+1 ;[194] else. ;[212] Otherwise, blank the field txmsg < > ;[212] 2 tabs, 7 spaces to end of recieve endif. ;[212] Done printing skipg t2,stimou ;[212] Non-zero receive timeout? ifskp. ;[212] Yes,display it txmsg < > ;[212] One tab, four spaces movei t1, .priou ;[194] movx t3, int%f ;[212] Special integer formatting NOUT% ;[186] erjmps .+1 ;[194] else. ;[212] Otherwise, no send timeout txmsg < > ;[212] Two tabs, two spaces endif. ;[212] Either should be in correct column now txmsg < ms > ;[212] Must always label non-zero milliseconds else. ;[212] Otherwise, no time outs at all, ever txmsg < > ;[212] So just tie off the line endif. ;[212] End whether ever printed anything subttl Pause in floating seconds and integral milliseconds setz t4, ;[212] Assume nothing printed txmsg < Pause: > ;[196] movx t3, ;[212] Special columnar formatting, always skipg t2, rpausf ;[212] Load and check floating component ifskp. ;[212] Non-zero, type it movei t1, .priou ;[212] This terminal FLOUT ;[36] erjmps .+1 ;[212] Catch and suppress errors seto t4, ;[212] Flag printed something else. ;[212] Otherwise, special case zero txmsg < (none)> ;[212] with plain text endif. skipg t2, spausf ;[212] Load and check floating component ifskp. ;[212] Non-zero, type it txmsg < > ;[212] Two spaces movei t1, .priou ;[36] FLOUT ;[36] erjmps .+1 ;[194] seto t4, ;[212] Flag printed something else. ;[212] Otherwise, special case zero txmsg < (none)> ;[212] with plain text endif. ifn. t4 ;[212] Printed any numbers? txmsg < sec > ;[212] Yes; one tab, seven spaces to recieve field movx t3, ;[212] Special integer formatting skipg t2, rpause ;[212] Integer millisecond recieve pause ifskp. ;[212] A real number, print it movei t1, .priou ;[212] Going to primary output NOUT% ;[212] Output it (but nicely) erjmps .+1 ;[212] Catch and suppress error txmsg < > ;[212] One tab, four spaces else. ;[212] Otherwise, suppress completely txmsg < > ;[212] Two tabs, four spaces endif. ;[212] End suppression decision skipg t2, spause ;[212] Integer millisecond send pause ifskp. ;[212] A real number, print it movei t1, .priou ;[212] Going to primary output NOUT% ;[212] Output it (but nicely) erjmps .+1 ;[212] Catch and suppress error else. ;[212] Otherwise, suppress number entirely txmsg < > ;[212] One tab, four spaces endif. ;[212] End suppression decision txmsg < ms> ;[196] endif. ;[212] subttl Delay in floating seconds and integral milliseconds txmsg < Delay before sending first packet: > ;[196] ifmn. local ;[194] Local? txmsg ;[194] Never waits for anybody else. ;[194] Remote, actually skipe t2, delayf ;[194] Do we have any delay, then? ifskp. ;[194] No, so special case that txmsg ;[194] A little different from local else. movei t1, .priou ;[194] setz t3, ;[194] Default flags FLOUT% ;[194] Type it erjmpr .+1 ;[194] came t2,[1.0] ;[212] Exactly one second? ifskp. ;[212] Yes, inflect for singular case txmsg < sec (> ;[212] Label and punctuate else. ;[212] Otherwise, use plural inflection txmsg < secs (> ;[212] Label and punctuate endif. ;[212] End grammatical analysis movei t1, .priou ;[194] move t2, delay ;[194] Load milliseconds movei t3, ^d10 ;[194] NOUT% ;[194] erjmpr .+1 ;[194] txmsg < ms)> ;[194] endif. ;[194] endif. ;[194] End delay listing subttl Retries, Pause and other Misc txmsg < Packet retries before timeout: > numout maxtry txmsg < Number of retries for init packet: > numout imxtry remark in floating seconds and integral milliseconds ifmn. srvtim ;[194] Any NAK'ing? txmsg < Server sends NAKs every > ;[212] Yes, begin the blat movei t1, .priou ;[212] Output to terminal move t2, ;[212] Pick up floating component move t4, t2 ;[212] Save a copy setz t3, ;[212] Default (non-columnar) formatting FLOUT% ;[212] Type it erjmps .+1 ;[212] Catch and suppress error came t4,[1.0] ;[212] Exactly one second? ifskp. ;[212] Yes, inflect for singular case txmsg < sec (> ;[212] Label and punctuate else. ;[212] Otherwise, use plural inflection txmsg < secs (> ;[212] Label and punctuate endif. ;[212] End grammatical analysis movei t1, .priou ;[212] NOUT% goes to terminal, too move t2, srvtim ;[212] Load milliseconds movx t3, fld(^d10,no%rdx) ;[212] Base ten, but free format NOUT% ;[212] Type equivalent milliseconds erjmps .+1 ;[212] Catch and suppress error txmsg < ms)> ;[212] Abbreviation needs no inflection else. ;[212] txmsg < Server will not NAK the communications line> endif. ;[212] remark Other misc ifme. debug ;[194] No blips if debugging. skipn local ; Or if not local. anskp. ;[194] txmsg < "." for every > ;[4] numout [blip] ;[9] txmsg < packets, "%" for each NAK.> endif. ;[194] hrroi t1, crlflf ;[194] PSOUT% ;[194] xct q1 remark ;[194] May fall through .. if2 < purge int%f,flt%f,fltf > ;[212] Don't need symbols or macro after pass 2 subttl Show INPUT parameters extern incase ; Case conversion flag for INPUT search. extern indeft ; Default timeout for INPUT search, floating seconds extern indeff ; Same value as milliseconds extern intima ; Timeout action for INPUT search. extern indefc ;[209] Default search string length in characters extern indefw ;[209] Same thing in words (for xblt) extern indefs ;[209] Expanded search string ;[160] $shinp: entry $shinp txmsg ifme. incase txmsg else. ;[209] In case set means case sensitive txmsg endif. txmsg < Default Timeout: > skipg t2, indeff ;[194] Load default value, if exists ifskp. ;[194] Doing time outs movei t1, .priou ;[194] setz t3, ;[194] Default flags FLOUT% ;[194] Type it erjmpr .+1 ;[194] txmsg < sec, > ;[194] movei t1, .priou ;[194] move t2, indeft ;[194] Load milliseconds movei t3, ^d10 ;[194] NOUT% ;[194] erjmpr .+1 ;[194] txmsg < ms> ;[194] else. ;[194] Otherwise, not timing out txmsg ;[194] endif. ;[194] txmsg < Timeout Action: > ;[209] ifme. intima ;[209] txmsg ;[209] else. ;[209] txmsg ;[209] endif. ;[209] txmsg < Default Search: > ;[209] ifme. indefw ;[209] Anything set? txmsg <*Carriage Return Line Feed*> ;[209] Nope, so point that out else. ;[209] Otherwise, something there movei t1, .chspc ;[209] Load a space PBOUT% ;[209] Line up the text movei t1, .chdbq ;[209] Load Double quote PBOUT% ;[209] Type it movei t1, .priou ;[209] Output to terminal hrroi t2, indefs ;[209] Point to default string movn t3, indefc ;[209] Load negative count of characters setz t4, ;[209] Stop on NUL, just in case SOUT% ;[209] Type it (counted SOUT% faster) ifje. r ;[209] Catch any JSYS error move t4, t1 ;[209] Save error for debuggers txmsg <*** ERROR ***> ;[209] Something obvious, I guess movei t1, .priou ;[209] Reload primary output endif. ;[209] movei t1, .chdbq ;[209] Load Double quote PBOUT% ;[209] Type it endif. ;[209] End case displaying search string hrroi t1, crlflf ;[209] Tie off the line PSOUT% ;[209] xct q1 remark ;[194] May fall through .. subttl SHOW MACRO DEFINITIONS ;[77] SHOW MACRO DEFINITIONS extern mactab ;[194] Macro table $shmac: entry $shmac hlrz t4, mactab ; Anything in macro table? ifle. t4 ;[194] If don't have any txmsg <%No macros defined > ;[203] Then say that jrst $shmax ;[194] And we're all done endif. ;[203] Otherwise, have some blat ;[203] So dump the macros movei t1,.priou ;[203] Still going to terminal move t2,t4 ;[203] Load how many used movei t3,^d10 ;[203] Humans grok base 10 NOUT% ;[203] Convert to external and display erjmpr .+1 ;[203] Catch and ignore error txmsg < macro> ;[203] Begin description movei t1,"s" ;[203] Load inflection caie t4,^d1 ;[203] Singular case? PBOUT% ;[203] No, must inflect it txmsg < used, > ;[203] Continue description movei t1,.priou ;[203] Still going to terminal hrrz t2, mactab ;[203] Load maximum number of macros sub t2,t4 ;[203] Subtract off used NOUT% ;[203] Convert to external and display erjmpr .+1 ;[203] Catch and ignore error txmsg < available. Remaining storage: > call $mchrs## ;[203] Get remaining space move t2, t1 ;[203] Load remaining characters move t4, t1 ;[203] Save a copy movei t1, .priou ;[203] This terminal movei t3, ^d10 ;[203] Base ten NOUT% ;[203] Convert to external and display erjmpr .+1 ;[203] Catch and ignore error txmsg < character> ;[203] movei t1,"s" ;[203] Load inflection caie t4,^d1 ;[203] Singular case? PBOUT% ;[203] No, must inflect it txmsg < Definitions: > ;[203] hlrz t4, mactab ;[203] Reload macro table length movei t3, 1 ;[194] Point at first entry of TBLUK% tabke ;[194] Fall through to loop context do. ;[194] Enter loop lexical context txmsg < > ;[194] Space over twice hlro t1, mactab(t3) ; Point to macro name. PSOUT ; Print it. txmsg < = > hrro t1, mactab(t3) ; Same deal for macro body. PSOUT call ifcrlf ;[194] See if it wants a CRLF aos t3 ; Bump TBLUK% index. sojg t4, top. ; Do for all macros in table. enddo. ;[194] hrroi t1, crlf ;[194] PSOUT% $shmax: ret ;[83] Last one, always want to return. remark q1 ; Last show command always returns subttl ITS Phase of Moon ;[6] (this whole routine, just for fun...) ; ; This code stolen from MOON.MAC (anybody know who wrote it?). ; Just changed OUTCHR's to PBOUT%'s via a macro. - Frank. ; ; The code is from MIT and may have been named in jest after famed MIT ; hacker David A. Moon. Also, see below. - Tom. ; ;[190] Change OUTCHR macro to not store in write-protected area ;[194] Slight rework to reduce symbol table moon: saveac <5,6> setzb 3,4 seto 2, ODCNV% erjmp r tlz 4,77 IDCNV% erjmp r ; Return upon any error. txmsg <, Moon: > ; OK so far, say what we're doing. ; AC2= Universal time adjusted for time zone. move 1,2 ; Right place. sub 1,newmn ; Sub off base new moon idiv 1,period ; Divide by the period idiv 2,perio4 ; Get fractions of a period camg 3,perio8 ; Check for phase + or - ifskp. ;[194] ; Not more than 3+ days sub 3,perio4 ; Make it next phase -n days cain 2,3 ; Is it LQ+3D+? tdza 2,2 ; It is aoj 2, ; Increment phase endif. hllz 1,table(2) ; Get SIXBIT phase skipge 3 ; 3 < 0 then minus phase output tloa 1,'-' ; - tloa 1,'+' ; + movms 3 ; Fix mag of 3 move 2,[point 6,1] ; Byte pointer movei 5,2 ; Loop 3 times do. ;[194] Enter loop context ildb 4,2 ; Get a character addi 4," " ; Make ASCII OUTCHR 4 ; Type it sojge 5,top. ;[194] ; Loop enddo. movsi 4,-4 ; Make aobjn pointer do. ;[194] Enter loop context hrrz 2,table(4) ; Get a multiplier trz 2,774000 ; Strip off ascii character imuli 3,(2) ; Get the value decoded hlrz 1,3 ; Get value tlz 3,-1 ; Zap old LH move 5,1 ; Use 5 & 6 here idivi 5,12 ; Radix 10 addi 5,60 ; Make ASCII caig 5,60 ;[194] Check for leading zero ifskp. ;[194] Not a leading zero OUTCHR 5 ; Type it. endif. ;[194] addi 6,60 ; Make ASCII OUTCHR 6 ldb 5,[point 7,table(4),24] ; Get d/h/m/s OUTCHR 5 ; Type it. OUTCHR ["."] ; Follow with a dot. aobjn 4, top. ;[194] ; Loop. enddo. ;[194] ret ; Done, return. subttl Pure data for MOON ; 12:47am Monday, 1 August 2022 ; ; This routine uses a lunar period of 29 days, 12 hours, 53 minutes ; and 19 seconds. ; ; After 43 years, 6 months, 3 days, 23 hours, 29 minutes and 12 ; seconds, it might be of interest to see how accurate this still is; ; meaning, has the period changed (I.E., increased) to the extent ; that we are accumulating a detectable difference. ; ; Wikipedia reports that a lunation, or synodic month, is the time ; period from one new moon to the next. In the J2000. 0 epoch, the ; average length of a lunation is 29.53059 days (or 29 days, 12 hours, ; 44 minutes, and 3 seconds). That is quite a difference. ; ; And it might be irrelevant. ; ; Since Earth's orbit around the Sun is elliptical and not circular, ; the speed of Earth's progression around the Sun varies during the ; year. Thus, the angular rate is faster nearer periapsis and slower ; near apoapsis. ; ; The same is also true for the Moon's orbit around the Earth. ; Because of these variations in angular rate, the actual time between ; lunations may vary from about 29.18 to about 29.93 days. The ; average duration in modern times is 29.53059 days with up to seven ; hours variation about the mean in any given year. chgsec(code,const) ;;Constants go in CONST .PSECT newmn: 125575,,34343 ; 28-jan-79 0120 est per==35,,422752 ; 29d.12h.53m.19s period: per perio4: per/4 perio8: per/10 table: byte(18)'NM '(7)"d"(11)^D1 ; New moon - days - 1 byte(18)'FQ '(7)"h"(11)^D24 ; First quarter - hours - 24 byte(18)'FM '(7)"m"(11)^D60 ; Full moon - minutes - 60 byte(18)'LQ '(7)"s"(11)^D60 ; Last quarter - seconds - 60 retsec ;;Return to previous .PSECT subttl Display line performance external variables extern nsici ; Network SIN%'s Issued extern nsimx ; Network SIN% maximum length extern nsitc ; Network SIN% total characters extern vboct ; Virtual Terminal BOUT% Count (simulated) extern vsict ; Virtual Terminal SIN% Count (number done) extern vsimx ; Virtual Terminal SIN% Maximum length extern vsitc ; Virtual Terminal total characters SIN%'ed extern vsoct ; Virtual Terminal SOUTR%'s Issued extern vsotc ; Virtual Terminal SOUTR% Total Characters extern vsomx ; Virtual Terminal SOUTR% Maximum length subttl Display information concerning line performance ; Previous code from TELNET used BIN%/BOUT% loops in two forks to ; input data from the terminal and display results asynchronously. In ; terms of computational overhead, using a BIN% and a BOUT% for each ; character is the most expensive way to do it. ; ; It's also a certain way to become unpopular on a heavily loaded ; system or otherwise adversely impact other activities. On the other ; hand, data can not be left in the buffer in the case of a real front ; end, as this will crash RSX20F. ; ; The code was rewritten to wait for a character and then determine ; after the read whether more data existed in the buffer. If this was ; the case, then the remaining data was read. This also occurs on ; output. A Virtual BOUT% in this case is a SOUTR% of one character ; to get it pushed over the network. disper: saveac ; Not called with anything, doesn't touch AC's remark ; transmission fork keep these ifmn. vbict txmsg < Terminal BIN%'s: > numout vbict ; Virtual Terminal BIN% Count endif. ifmn. vchrcn txmsg < Virtual CFIBF%'s: > numout vchrcn ; Virtual CHaRcters flushed CouNt endif. ifmn. inpcbf txmsg < Buffer CFIBF%'s: > numout inpcbf ; INPUT network Buffer characters flushed endif. ifmn. vboct txmsg < Virtual BOUT%'s: > numout vboct ; Virtual Terminal BOUT% Count (simulated) endif. ifmn. vsict txmsg < SIN%'s Issued: > numout vsict ; Virtual Terminal SIN% Count txmsg < SIN% Bytes Total: > numout vsitc ; Virtual Terminal total characters SIN%'ed txmsg < Max SIN% Length: > numout vsimx ; Maximum length SIN% ever did endif. ifmn. vsoct txmsg < SOUTR%'s Issued: > numout vsoct ; Virtual Terminal SOUTR% Count txmsg < SOUTR% Bytes: > numout vsotc ; Virtual Terminal SOUTR% Bytes Total txmsg < Max SOUTR% Len: > numout vsomx ; Virtual Terminal SOUTR% Maximum length endif. remark ; Network input fork updates these ifmn. nbict ; Did any network input? txmsg < Network BIN%'s: > numout nbict ; Network BIN% count txmsg < Network SIN%'s: > numout nsici ; Network SIN%'s Issued txmsg < Network SIN% Cnt: > numout nsitc ; Network SIN% total characters txmsg < Network SIN% Max: > numout nsimx ; Network SIN% maximum length endif. ret subttl ifcrlf -- maybe type a carriage return line feed ; Call: t1/ Updated point of PSOUT%'ed macro body ; ; [194] fixed a case of a macro not being terminated with a carriage ; return. This is unlikely, but could happen. That being the ; the case, when displaying the macros, we now have to check to ; see if we need to print a crlf. ifcrlf: entry ifcrlf ; Inform LINK of our location remark t1, t2 ; Smashes these saveac ; Holds counter and pointers!! ; Last three characters should be remark .chcrt, .chlfd, .chnul movni t2, ^d3 ; Check the end of the macro string adjbp t2, t1 ; May not have a CRLF ... ildb t3, t2 ; Pick up penultimate character ildb t4, t2 ; Pick up last character cain t3, .chcrt ; Did they tie off the line? ifskp. ; Apparently not cain t4, .chcrt ; Unless they did it backwards anskp. ; Odd, but be happy... movei t1, .chcrt ; Otherwise, do the carriage return PBOUT% endif. cain t4, .chlfd ; Did they scroll the carriage? ifskp. ; Perhaps not cain t3, .chlfd ; Unless they did it backwards anskp. ; Odd, but be happy ... movei t1, .chlfd ; Otherwise, do the line feed PBOUT% endif. ret subttl PUTC -- Print a single character, using ^X notation, DEL, etc. ; Call with t1/ character to print. ; ;[223] Modifies no registers putc: entry putc ;[194] Inform LINK of our location push p, t1 ;[223] Save the character andi t1, ^o177 ;[223] Stomp the parity caie t1, .chdel ;[194] A rubout? ifskp. ;[194] It is push p, t2 ;[194] Don't bump into anything txmsg ;[194] type this pop p, t2 ;[194] Restore in case somebody cared pop p, t1 ;[223] Restore the original character ret endif. ;[194] cail t1, .chspc ;[194] Is it a control char? ifskp. ;[194] It is push p, t1 ; Save the char. movei t1, "^" ; Get the control quote. PBOUT% pop p, t1 ori t1, ^o100 ; Turn on the non-control bit. endif. ;[194] PBOUT% pop p, t1 ;[223] Restore the original character ret subttl show a line's characteristics ; Says some interesting things about the line that is passed in t1 ; ; Such information does not effect the protocol, per se. It is rather ; used for debugging and as part of a heuristic as to what kind of ; performance could be expected. As there are a rather large number ; of other factors that can impact performance, what is displayed can ; in no way be assumed to be determinative. ; ; All part of 186, plus some 223 flavoring ;[223] Line type names chgsec(code,const) ;[223] Table goes in const psect ltname: cascii() ;[223] NW%UND Undefined cascii() ;[223] NW%FW Front end (RSX-20F) cascii() ;[223] NW%PT Pseudo-terminal cascii() ;[223] NW%MC Network Remote Terminal (MCB) Cascii() ;[223] NW%TV Telnet Virtual Terminal cascii() ;[223] NW%CH CTERM cascii() ;[223] NW%LH Local Area Terminal ltneot: remark ;[223] Mark end of table nw%mx== ;[223] Maximum type retsec ;[223] Back into code cleans() ;[223] ; Call: ; ; t1/ Network Type ; t2/ Line Type ; t3/ Line number extern lclpar ;[223] Whether local line will do parity extern opnpar ;[223] Whether open device will do parity linchr: saveac ;[223] Does not overwrite any register move q1, t3 ;[223] Save line number cail t2, 0 ;[223] Negative line type? cail t2, nw%mx ;[223] or over the maximum? setz t2, ;[223] Yes to either, reset to NW%UND dmove q2, t1 ;[223] Store network and line type ife. q3 ;[223] Undefined line type? (NW%UND) txmsg < Unknown Line: > ; So do error blat numout q1, ^d8 ; Type whatever we did get passed endif. ;[223] Try the rest of it txmsg < Controlling Type: > move t1, ltname(q3) ;[223] Pick up address of the correct string PSOUT% ;[223] And type it erjmpr .+1 move t4, lclpar ;[223] Assume we're doing the controlling terminal came q1, mytty ;[223] BUT!! Is this the controlling terminal? move t4, opnpar ;[223] Parity tolerated will be set by k20net ifn. t4 ;[223] So, does the thing do parity? txmsg < [Parity]> ;[223] Yes, somebody will generate it, if asked endif. ;[223] Otherwise, nothing to say call prntbd ;[210] Print some kind of baud rate maybe caie q3, nw%tv ;[223] A TCP Virtual Terminal (TVT)? ifskp. ;[223] Yes, then let's display those specifics txmsg < TVT Binary: > ;[129] ARPAnet TVT binary mode. ifme. tvtflg txmsg else. txmsg endif. txmsg < TVT Negotiate: > ;[182] ARPAnet TVT discovery ifme. tvtchk txmsg else. txmsg endif. endif. ;[223] End case TCP Virtual Terminal? move t1, q1 ; Load line number txo t1, .ttdes ; Turn into a terminal designator (if not already one) GTTYP% ; Odd that buffers are returned here... %jsErr (,r) move t4, t3 ; Get the buffer counts out of the way txmsg < Input Buffers: > ; Present the input buffer count movei t1, .priou ; On the terminal hlrz t2, t4 ; Load input buffer count movei t3, ^d10 ; Is in base ten NOUT% %jsErr (,) txmsg < Output Buffers: > ; Present the output buffer count movei t1, .priou ; On the terminal hrrz t2,t4 ; Load output buffer count movei t3, ^d10 ; Is in base ten NOUT% %jsErr (,) ret cleans() subttl Print Efficiency Factor ; Overhead calculations ; ; T1/ Output JFN or pointer, sacred ; T2/ Total characters in file(s) ; T3/ Total characters transferred, every single one ; ; In other words, t3 has what was necessary to communicate t2 ; ; A factor over 1, how much compression is winning you ; under 1, how much the prefixing is costing you ; ; Describe various totals kept for $stat ; ; stot - total characters sent, including everything ; stchr - total characters all files ; rtot - total characters received, every single one of them ; rtchr - total characters all files ; ; Question, do we really need DOUBLE floating point? fltr will 'only' ; lose precision for a communications or combined file character total ; that is greater than 134,217,728 (2**27). ; ; This would be a file in excess of 52,429 pages, which is over 2/3's ; of an RP06. Even if some transfers happened over weekends, it is ; doubtful that this much data could have been sent--it was more ; common to just send a magnetic tape. Besides, disk space was ; EXPENSIVE. If you could afford the platters, you could certainly ; afford the cost of a tape, the tape mount, the mount time and the ; postage. ; ; Disk space is now effectively free, most structures being double ; RP07's, having a (then) gargantuan storage capability of over a ; gigabyte of ASCII text. However, since Kermit speeds are now in ; the megabyte range, a transfer of multiple large files could ; exceed 35 bit integer precision. This is certainly possibly if ; you are using your 20 to store .jpeg's or digital audio. extern dfloat ; In k20sub (originally from eftpsa) peffif: saveac ; Don't touch other temporaries ; First handle some simple cases ifle. t2 ; Is this a zero length file (or balony?) smsg <[100% Overhead]> ;Make it stand out ret ; That was easy ... endif. ; Have a non-zero length file here? ife. t3 ; Zero length file (like NUL:)? smsg <[ZERO]> ; Make it stand out ret ; That was easy ... endif. ifl. t3 ; Impossible communications count? smsg <[ERROR]> ; Make it stand out ret ; That was easy ... endif. ; Guess we have some real work to do block. ; Set up a stack frame for easier return saveac ; Preserve some more registers remark t1,t2,t3,t4,t5 ; Can use these for this block move t5, t2 ; Save total characters in files setz t1, ; No integer high order move t2, t3 ; Load total characters communicated call dfloat ; Double float the double integer ret ; But couldn't exch t2, t5 ; Store floating low order and restore move t4, t1 ; Store floating high order setz t1, ; No integer high order call dfloat ; Double float the double integer ret ; But couldn't move t3, t2 ; Reposition low order move t2, t1 ; Reposition high order dfdv t2,t4 ; Divide extremely slowly retskp ; Win endbk. ; End block context, restore registers ret ; Passing any error up peffi0: move t4,fmcntl ; Load format control DFOUT% ; Show us a nice number erjmps .+1 ; Don't touch precious t1!! camn t4,fmcntl ; Overwritten with error? ret ; Nope, we're fine %ermsg (,r) ret ; Finally done subttl Define hairy DFOUT% control word fmcntw==0 ; Initialize format control word define blcntl (value,field,format) < ifnb , ifb , > blcntl(.fldig,fl%sgn) ;;Sign control is start with a digit blcntl(.fllsp,fl%jus) ;;Justification is leading spaces blcntl(fl%one) ;;Output at least one digit, even if zero blcntl(fl%pnt) ;;Always print a decimal point blcntl(.flexn,fl%exp) ;;No exponent (too confusing) blcntl(fl%ovl) ;;Output any overflow blcntl(-1,fl%rnd) ;;Don't do any rounding blcntl(^d4,fl%fst) ;;Allow 9,999 improvement blcntl(^d4,fl%snd) ;;Allow .0001 degradation chgsec(code,const) ;;This is a constant fmcntl: fmcntw ; Final control word retsec ;;Back to previous .PSECT if2 < purge blcntl > ;;Not needed after pass 2 subttl Calculate Giga, Mega, Kilo character rate ; Uses double floating point to print a more readable, accurate byte rate. ; ; t3/ Total characters sent or received ; ; +1 - Some odd thing happened ; +2 - The math worked, at least gmkcps: extern dblcal ; Found with other math routines in k20tim saveac ; Need some more scratch block. ;[207] Enter block context for better control flow saveac ;[207] Used for DK10 double word movei q1, ewallt ;[207] Construct pointer to elapsed wall time movei t2, .datus(q1) ;[207] Load pointer to DK10 double word dmove t3, (t2) ;[207] Load DK10 tick wall time jumpg t3, RSKP ;[207] Non-zero high order is OK jumpg t4, RSKP ;[207] Ditto low order endbk. ;[207] End block context, restore registers ret ;[207] Zero ticks?? Uh, forget it call dblcal ; Calculate double floating character rate ret ; Failed call ranger ; Put result into kilo, mega or giga range call peffi0 ; Type it call chrsfx ; Puts in the right character suffix retskp ; Worked!! subttl Calculate Giga, Mega, Kilo baud rate ; Uses double floating point to print a more readable, accurate byte rate. ; ; t3/ Total characters sent or received ; t4/ High order floating point bit rate (unranged) ; t5/ Low order, ditto baud: exp 10. ; Assume ten bits per character 0 ; Which is not valid for 110 baud gmkbps: extern dblcal ; Found with math routines in k20sub saveac ; Need some more scratch block. ;[207] Enter block context for better control flow saveac ;[207] Used for DK10 double word movei t2,.datus+ewallt;[207] Construct pointer to elapsed DK10 tick wall time dmove t3, (t2) ;[207] Load DK10 tick wall time jumpg t3, RSKP ;[207] Non-zero high order is OK jumpg t4, RSKP ;[207] Ditto low order endbk. ;[207] End block context, restore registers ret ;[207] Zero ticks?? Uh, forget it call dblcal ; Calculate double floating character rate ret ; Failed dfmp t4, baud ; Scale to baud rate gmkbp1: remark ; Common exit epilogue call ranger ; Put result into kilo, mega or giga range call peffi0 ; Type it call baudsf ; Puts in the right suffix ret subttl Put result into kilo, mega, giga or tera range ; Call: ; ; t1/ Output designator, unused, but preserved, anyway ; t4/ High order floating point bit rate (unranged) ; t5/ Low order, ditto ; ; Returns: +1, always ; ; t1/ Unmodified output designator ; t2/ High order, possibly ranged ; t3/ Low order, ditto ; t5/ Rate prefix (K, M, G, T), if any ; ; N.B., Since we are checking for less than 1,024 in the high ; order. It is unnecessary to compare the low order word, ; so we can bum a DCAM. ; ; A 'T' prefix means terabaud and is probably either wrong or ; otherwise delusional in some way. It should be doubted. kilo: 1024. ; Used for ranging (floating!!!) 0 ; Also used as double floating divisor ranger: saveac ; Let's just leave that alone caml t4,kilo ; Into kilobaud already?? ifskp. ; Nope, not even, so not much to do, then dmove t2,t4 ; Load puny hundreds of baud rate (yech) setz t5, ; Not even a prefix character, sniff ret ; Well, that was easy endif. ; Otherwise, at least in kilobaud dfdv t4,kilo ; Reduce by ten orders of binary magnitude caml t4,kilo ; Into Megabaud? ifskp. ; No, but respectable anyway (or used to be) dmove t2,t4 ; Load kilobaud rate movei t5,"K" ; Load the Kilobaud prefix ret ; Return kilo or greater, but less than mega endif. ; Otherwise, at least in megabaud dfdv t4,kilo ; Reduce by ten orders of binary magnitude caml t4,kilo ; Into Gigabaud? ifskp. ; No, but at NI/CI speeds! dmove t2,t4 ; Load Megabaud rate movei t5,"M" ; Load the Megabaud prefix ret ; Return mega or greater, but less than giga endif. ; Otherwise, at least in Gigabaud dfdv t4,kilo ; Reduce by ten orders of binary magnitude caml t4,kilo ; Into Terabaud?? ifskp. ; No, but 1000BaseT is nothing to sneeze at! dmove t2,t4 ; Load Gigabaud rate movei t5,"G" ; Load the Gigabaud prefix ret ; Return giga or greater, but less that tera endif. ; Otherwise, some kind of incredible rate remark Dude!! ; What kind of com gear are you using? dfdv t4,kilo ; Reduce by ten orders of binary magnitude dmove t2,t4 ; Load Terabaud rate movei t5,"T" ; Load Terabaud prefix ret ; Return from ...Fantasy Island... subttle Print correct character suffix ; Call: ; ; t1/ Output designator (updated, if string) ; t5/ character prefix character (if any) chrsfx: movei t2,.chspc ; Load a space call BOUTI% ;[216] Properly emit skipn t2,t5 ; Load prefix character ifskp. ; If there is one, then type it call BOUTI% ;[216] Properly emit it endif. smsg ret subttle Print correct baud suffix ; Call: ; ; t1/ Output designator (updated, if string) ; t5/ character prefix character (if any) baudsf: movei t2,.chspc ; Load a space call BOUTI% ;[216] Seperate number from text skipn t2,t5 ; Load prefix character ifskp. ; If there is one, then type it call BOUTI% ;[216] endif. smsg ; Accepted abbreviation for Baud ret subttl Determine the console's line number ;[223] Begin code insertion ; Want to know this because the CTY is not a good line to use as you ; can't control what a front end might type as well as Tops-20's own ; needs. Using it can cause messages to never get seen, being simply ; thrown away as a packet resend. ; ; It is for this reason that the PANDA access control job (ACJ) will ; not allow the CTY to be assigned (either explicitly with ASND% or ; implicitly with an OPENF%) by anything else than an enabled WHEEL or ; OPERATOR. chgsec(code,data) ; Need to store the data... ctyerr: block 1 ; Any STDEV% error ctydev: block 1 ;** DO NOT ; Console in 'device' format ctynum: block 1 ; REORDER ** ; Bare line number of console retsec ; Restore psect assumptions chgsec(code,const) ; The device name of the console is eternal ctynam: asciz /CTY/ ; Note, NO device punctuation! retsec ; Restore psect assumptions inicty: entry inicty ; Called at program start up saveac ; Let's not touch anything hrroi t1, ctynam ; Tops-20 pointer to CTY device name STDEV% ; Turn the string into a device ifje. r ; This is REALLY supposed to be defined... movem t1, ctyerr ; Store error for the curious setob t2, t3 ; Cons up a pair bogus talismen dmovem t2, ctydev ; Flag that they are useless ret ; Go no further endif. ; End STDEV% error handling remark ; Otherwise, worked!! movem t2, ctydev ; Save in device format for ASND% check txz t2, .ttdes ; Shut off terminal designator if half word hrrzm t2, ctynum ; Save just the line number movx t4, lstrx1 ; Say it worked fine movem t4, ctyerr ; Store (lack of) error for the curious ret ; Finally done ;[223] End code insertion subttl Finishing items xlist ; Save the trees!! lit ; Dump the literals list ; Resume listing .endps code ; Close the code .psect subttl Extended Text for Display .psect etext ;[209] Need to put some things in extended text remark Various types of parity enone: asciz/None/ espac: asciz/Space/ emark: asciz/Mark/ eodd: asciz/Odd/ eeven: asciz/Even/ remark Various states of debugging deboff: asciz/Off/ debsts: asciz/States/ debpks: asciz/Packets/ .endps etext ; Close out section 1 text remark Pointers to extended text which MUST be in section zero .psect const ; Constants debtab: .px7!deboff .px7!debsts .px7!debpks .endps const subttl Display Module local storage .psect data ; Writable storage pvbaud:: exp 0,0 ; PTY: virtual baud rate pibaud:: exp 0,0 ; PIP: virtual baud rate nlbaud:: exp 0,0 ; NUL: virtual baud rate dnbaud:: exp 0,0 ; DECnet virtual baud rate .endps data ; End of data psect .xcmsy ;[194] Ditch MACSYM junk end ; Local Modes: ; Mode:MACRO ; Comment Column:32 ; Comment Start:;[240] ; Comment Begin:;[240] ; Auto Fill Mode: 0 ; End: