title K20TIM - Kermit (Virtual) Device Timing subttl All edit 216 except for some 207 code moved Comment " ; Make gnuEmacs font-rot mode happy The module provides basic loopback tests on various devices, currently all virtual. These are called speed tests because the results are used to validate the calculations for the efficiency rating of the line in the statistics output. Other routines concerned with timing and load average may be found here. Loopback tests could be provided for a physical line, but this would require taking the line out of service and fitting it with a loopback connector. For now, it is assumed that the baud rate is both correctly reported and used. Please read the following VERY carefully: 1) The reported speed can vary WILDLY depending on other system activity and is easily peturbed for no readily apparent reason. 2) The speed itself is only reporting how fast the monitor is shuttling data around and has no basis in any physical transport, media or reality. 3) Changing the various mode, byte sizes and record lengths of the connection can produce speed changes, but these are of little pratical use other than determining what might be the most effective connection configuration. 4) Be particularly wary of the byte size for essentially meaningless results. It's largely here for DECnet testing and to see what the pseudo-terminal device driver might be stripping. 5) While it is possible to time intervals to 100 kHz (I.E., DK10) resolution, it is fundamentally impossible to accurately correlate such intervals with the time of day. This is because Tops-20 keeps the time of day as an 18 bit fixed point fraction, which works out to a 'Time of Day' tick being approximately 329.58858646932 milliseconds. However, there is no way to tell when Tops-20 will advance this because the last system set time (TADIDT) as calculated STAD% is not available nor is the millisecond uptime counter that is used to calculate it. The problem is made worse because there is thus no public correlation between HPTIM%, either. The problem really can't be resolved without a change to Tops-20 to make TADIDT available and to store the elapsed millisecond clock that was used to do the calculation. This is not a problem for commands that display elapsed time, such as CLEAR. It is a problem for logging where using HPTIM% can occasionally produce the effect of time going backwards. " subttl Preliminaries search monsym,macsym,cmd,k20unv search dcam ; Double compare macros 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 and usage extern pars1 ; Contains address of .TIME extern pars2 ; Parsed device id extern pars3 ; OPENF% mode extern pars4 ; OPENF% byte size extern pars5 ; Buffer size (RECORD-LENGTH) remark ; Various support routines extern ascdev ; Turns a device number into ASCII text extern %%jser ; JSYS error handler extern %%smsg ; smsg macro support extern BOUTI% ;[216] BOUT% Internal extern symout ; Get symbolic name and offset of an address remark $TIME ; Is found in k20dsp and invokes the timing routines remark ; Various external variables extern crlf ; Carriage return line feed sequence remark ; Some constants msiday==^d86400000 ; Milliseconds in a day dkday==msiday*^d100 ; 100 DK10 ticks per millisecond todtic==^d262144 ; TOD ticks in a day .psect code/ronly ; Don't allow stores!! subttl TIME command parse table remark ; Common Names of devices we can test %table(timtab) ; Begin a keyword table %key2 , -1 ; Copy another device's baud %key2 , .dvdes!.dvnul ; Idiomatic for NUL: %keyf3 , .dvdes!.dvdcn, cm%inv ; Allows escape recognition %key2 , .dvdes!.dvdcn ; Means either SRV: or DCN: %keyf3 , -1, cm%inv ; When Tom gets sleepy %keyf3 , %NUL, cm%inv!cm%abr ; Prefer NUL over NRT %keyf3 , .dvdes!.dvdcn, cm%inv ; Sleepy Tom types this %nul: %keyf3 , .dvdes!.dvnul, cm%inv ; Allows escape recognition %keyf3 , %pipe, cm%inv!cm%abr ; Prefer pipe over PIP: %keyf3 , .dvdes!.dvpip, cm%inv ; Allows escape recognition %pipe: %key2 , .dvdes!.dvpip ; Idiomatic for PIP: %key2 , .dvdes!.dvpty ; Idiotmatic for PTY: %keyf3 , .dvdes!.dvpty, cm%inv ; Don't specify device number %keyf3 , %reus, cm%inv!cm%abr ; Prefer re-use over reuse %keyf3 , %reus, cm%inv!cm%abr ; Prefer re-use over reuse %reus: %keyf3 , -1, cm%inv ; Previous dumb name for copy %keyf3 , -1, cm%inv ; Ditto %keyf3 , .dvdes!.dvsrv, cm%inv ; Allows escape recognition %tbend cleans(<%nul,%pipe,%reus>) ; Pitch working symbols chgsec(code,const) ;;Chained FDB's go into CONST area timfdb: flddb. .cmkey,,timtab,,,timfd1 timfd1: flddb. .cmdev,,, retsec ;;Restore psect assumptions cleans() ;;Toss working symbol subttl TIME (device) command parsing .time: intern .time ; Invoked by top level parser saveac ; Just in case guide (virtual speed of) setob t1, t2 ; Cons up some talisman dmovem t1, pars2 ; No device nor OPENF% mode parsed dmovem t1, pars4 ; No OPENF% byte size movem t1, timdev ; Device being timed movei t1, timfdb ; Parse a device as a keyword or something real call rfield ; Try to get something ldb t4, [pointr (.cmfnp(t3),cm%fnc)] ; Get parse function taken caie t4, .cmkey ; Did a nice name? ifskp. ; Yep, that's not very difficult hrlo t2, (t2) ; Turn semantic action into a device designator camn t2, [-1] ; Wants to use a device's results elsewhere? callret .copy ; Yes, do that movei t4, .cmdev ; Otherwise, say we parsed a device endif. ; And take the device case caie t4, .cmdev ; Explicitly specified the device? ifskp. ; Yes, that's not much harder hlrz t1, t2 ; Pick up bare device designator txz t1, .dvdes ; Shut off the universal device code movem t1, pars2 ; Finally save just the device type number cain t1, .dvpty ; Pseudo-terminal? callret parpty ; Yes, maybe parse its switch modifiers cain t1, .dvpip ; Pipe device? callret parpip ; Yes, maybe parse its switch modifiers cain t1, .dvnul ; NULL (or NIL) device? callret parnul ; Yes, maybe parse its bytesize modifier caie t1, .dvsrv ; DECnet passive component? cain t1, .dvdcn ; or DECnet active component callret pardcn ; Yes, maybe parse its switch modifiers ; None of the above, so nothing special confrm ; Tie off the line ret ; And done endif. ; End case .cmdev parse item broken: remark ; Otherwise, we are deeply confused emsg() ; Begin the blat movei t1, .priou ; Continue blatting on the terminal move t2, t4 ; Loaded the parsed function movei t3, fld(^d8,no%rdx) ;Function codes are octal NOUT% ; Tell us that, it may be of use erjmpr .+1 ; Ignore error, we're trying hard enough hrroi t1, crlf ; Tie off the blat PSOUT% ret ; And go no further subttl Device secondary parse tables and function descriptor blocks remark Various switches for each device %table(nulswi) ; General device switch table %key2 ,parbyt ;Parse byte size %tbend %table(devswi) ; General device switch table %key2 ,parbyt ;Parse byte size %key2 ,parmod ; Parse mode %tbend %table(pipswi) ; Begin a special switch table for pipes %key2 ,parbyt ;Parse byte size %key2 ,parmod ; Parse mode %key2 ,parecl %tbend remark Switches applicable to potentiall all devices %table(modkey) ; N.B., Not all devices support all modes!! %keyf3 ,.GSDMP, cm%inv ;N.B., No device here supports dump mode %keyf3 , %imag, cm%abr!cm%inv %imag: %key2 , .GSIMG %keyf3 ,.GSSMB, cm%inv %key2 ,.GSNRM %key2 , .GSSMB %tbend cleans(<%imag>) ;;Clean working symbol out of MACRO tables chgsec(code,const) ;;Chained FDB's are in CONST, not code parfdb: flddb. .cmcfm,,,,,parfd1 parfd1: flddb. .cmswi,,devswi, ;; or OPENF% mode modifiers pipfdb: flddb. .cmcfm,,,,,pipfd1 pipfd1: flddb. .cmswi,,pipswi ;; or OPENF% mode and GTJFN% modifiers nilfdb: flddb. .cmcfm,,,,,nilfd1 nilfd1: flddb. .cmswi,,nulswi, ;; NIL was the original TENEX name for NUL: dcnfdb: flddb. .cmcfm,,,,,dcnfd1 dcnfd1: flddb. .cmswi,,devswi, ;; or OPENF% mode and GTJFN% modifiers retsec ;;Back to code .psect cleans() subttl Device secondary (switch) parsing parpty: movei q1, parfdb ; Handle case of pseudo terminal callret parswi ; Now parse for PTY:'s switches parpip: movei q1, pipfdb ; Handle pipe device callret parswi ; Now parse for PIP:'s switches parnul: movei q1, nilfdb ; Handle NUL: (or NIL) device callret parswi ; Now parse for NUL:'s switches pardcn: movei q1, dcnfdb ; Handle DECnet (SRV:/DCN:) device callret parswi ; Now parse for DCN:'s switch subttl Common secondary switch parsing parswi: do. ; Enter loop logical context move t1, q1 ; Load the requested parse FDB call rfield ; Go parse something ldb t4, [pointr (.cmfnp(t3),cm%fnc)] ; Get parse function taken cain t4, .cmcfm ; Confirmed? ret ; They did, we're done hrrz t1, (t2) ; Otherwise, we have a switch to do call (t1) ; So Pick up switch parsed and call it nop ; Ignore any skip/non-skip (none currently skip) loop. ; Go get some more switches until confirmed enddo. ; End loop lexical context remark Here to handle BYTESIZE, MODE and RECORD-LENGTH switches parbyt: remark Parse file byte size movei t1, [flddb. .cmnum,,^d10,] call rfield ; Get a number ifle. t2 ; Gubbish? emsg jrst cmder1 ; Complain and allow command retry. endif. caig t2,^d36 ; Being overly bullish? ifskp. ; Then it isn't a DIGITAL computer... emsg jrst cmder1 ; Complain and allow command retry. endif. movem t2, pars4 ; Store byte size for OPENF% ret ; Get more switches parmod: remark Parse file mode movei t1, [flddb. .cmkey,,modkey,] call rfield ; Get a keyword hrrz t1, (t2) ; Turn semantic action into a mode value movem t1, pars3 ; Store OPENF% mode ret ; Get more switches parecl: remark Parse RECORD-LENGTH attrbute movei t1, [flddb. .cmnum,,^d10,] call rfield ; Get a number ifle. t2 ; Gubbish? emsg jrst cmder1 ; Complain and allow command retry. endif. movem t2, pars5 ; Store monitor buffer size (RECORD-LENGTH) ret ; Get more switches subttl Copy one device's speed test over another's ; Useful because inter-fork pseudo-terminal speed is FAR slower than ; inter-job speed, resulting in efficiency percentages in the ; quadruple digit range. remark ; Common Names of device tests we can copy %table(coptab) ; Begin a keyword table %key2 , .dvdes!.dvnul ; Idiomatic for NUL: %keyf3 , .dvdes!.dvdcn, cm%inv ; Allows escape recognition %key2 , .dvdes!.dvdcn ; Means either SRV: or DCN: %keyf3 , %nul1, cm%inv!cm%abr ; Prefer NUL over NRT %keyf3 , .dvdes!.dvdcn, cm%inv ; Sleepy Tom types this %nul1: %keyf3 , .dvdes!.dvnul, cm%inv ; Allows escape recognition %keyf3 , %pip1, cm%inv!cm%abr ; Prefer pipe over PIP: %keyf3 , .dvdes!.dvpip, cm%inv ; Allows escape recognition %pip1: %key2 , .dvdes!.dvpip ; Idiomatic for PIP: %key2 , .dvdes!.dvpty ; Idiotmatic for PTY: %keyf3 , .dvdes!.dvpty, cm%inv ; Allows escape recognition %keyf3 , .dvdes!.dvsrv, cm%inv ; Allows escape recognition %tbend cleans(<%nul1,%pip1>) ; Toss working symbols chgsec(code,const) ;;Chained FDB's go into const cpffdb: flddb. .cmkey,,coptab,,,cpffd1 cpffd1: flddb. .cmdev,,, cptfdb: flddb. .cmkey,,coptab,,,cptfd1 cptfd1: flddb. .cmdev,,, retsec ;;Return to code .psect cleans() ;;Punt the working symbols subttl TIME COPY command parsing .copy: saveac ; Wants another AC guide (a previous timing test result for) remark t5, q1 ; Note aliased, assumed saved movei t1, cpffdb ; Copy-From FDB call rfield ; Try to get something ldb t4, [pointr (.cmfnp(t3),cm%fnc)] ; Get parse function taken caie t4, .cmkey ; Did an idiomatic name? ifskp. ; Yep, that's not very difficult hrlo t2, (t2) ; Turn semantic action into a device designator movei t4, .cmdev ; Say we parsed a device endif. ; And take the device case caie t4, .cmdev ; If not a device at this point, jrst broken ; ...we are deeply broken... hlrz t1, t2 ; Pick up bare device designator txz t1, .dvdes ; Shut off the universal device code move q1, t1 ; Save just the 'source' device type number guide (to another device) movei t1, cptfdb ; Copy-To FDB call rfield ; Try to get something ldb t4, [pointr (.cmfnp(t3),cm%fnc)] ; Get parse function taken caie t4, .cmkey ; Did an idomatic name? ifskp. ; Indeed; transmorgrify hrlo t2, (t2) ; Turn semantic action into a device designator movei t4, .cmdev ; Say we parsed a device endif. ; And take the device case caie t4, .cmdev ; If not a device at this point, we are jrst broken ; deeply broken... hlrz q2, t2 ; Pick up bare device designator txz q2, .dvdes ; Shut off the universal device code came q1, q2 ; Are we trying to reuse ourself? ifskp. ; Yes, don't let's be silly emsg move t1, q1 ; Load device number call ascdev ; Turn into a string PSOUT% ; Type it txmsg <'s timing test result onto itself > jrst cmder1 ; Complain and allow command retry. endif. confrm ; Tie off the line remark ; Fall through to execute the code subttl Re-use semantic action, not called since only one keyword extern pvbaud ; PTY: virtual baud rate extern pibaud ; PIP: virtual baud rate extern nlbaud ; NUL: virtual baud rate extern dnbaud ; DCN:/SRV: pair virtual baud rate $copy: remark ; Check source tests setob t3, t4 ; Assume we don't know either cain q1, .dvpty ; Pseudo-terminal? movei t3, pvbaud ; Address of test results cain q1, .dvpip ; Pipe device? movei t3, pibaud ; Address of test results cain q1, .dvnul ; NULL (or NIL) device? movei t3, nlbaud ; Address of test results caie q1, .dvsrv ; DECnet passive component? cain q1, .dvdcn ; or DECnet active component movei t3, dnbaud ; Yes, has the same test result address jumpl t3, $copys ; We don't have a test for this source remark ; Check destination tests cain q2, .dvpty ; Pseudo-terminal? movei t4, pvbaud ; Address of test results cain q2, .dvpip ; Pipe device? movei t4, pibaud ; Address of test results cain q2, .dvnul ; NULL (or NIL) device? movei t4, nlbaud ; Address of test results caie q2, .dvsrv ; DECnet passive component? cain q2, .dvdcn ; or DECnet active component movei t4, dnbaud ; Yes, has the same test result address jumpl t4, $copyd ; We don't have a test for this destination dmove t1, (t3) ; Pick up source test jumple t1, $copyn ; No test run dmovem t1, (t4) ; Overwrite destination results dmovem t1, pars4 ; Store for $SHOW remark ; Turn device numbers back into device hrlo t1, q1 ; Reposition source device number tlo t1, .dvdes ; Now a device designator move t2, q2 ; Load destination device number dmovem t1, pars2 ; Store as device designators ret ; Return into $SHOW subttl various error handlers chgsec(code,text) ;;Text .psect for strings $copym: asciz "No timing run yet for " retsec ;;Get back in code .psect $copyn: remark ; Here if no test has been run hrroi t1, $copym ; Load common preamble ESOUT% ; Begin blat move t1, q1 ; Pick up source device number call ascdev ; Convert to a string PSOUT% ; Type it hrroi t1, crlf ; Tie off the line PSOUT% setom pars2 ; Flag already blatted ret ; Return into $SHOW $copys: remark ; Here if source device is unknown movem q1, pars2 ; Load the device number ret ; Return into $SHOW $copyd: remark ; Here if destination device is unknown movem q2, pars2 ; Load the device number ret ; Return into $SHOW subttl Determine PTY Virtual Baud rate ; N.B., this code is not intended to provide a definitive answer to ; ANYTHING because Tops-20 is not a real-time system. Even a speck ; of system load can wildly peturb the results as well as whatever the ; current monitor's pseudo-terminal implementation happens to be. ; ; Also, the speed of a PTY in an intra-job context (as is done below) ; appears to be slower than the more typical inter-job example, as ; used by BATCON and Kermit's pseudo-terminal connection code. ; ; This result is therefore best viewed as a number suitable for ; checkout of the calculations performed in the efficiency code for a ; physical baud rate, if such a thing is ever seen again. dptybd: intern dptybd ; May be invoked as a test saveac ;Holds PTY particulars remark ; N.B., q4 and p1 are aliases!! setzb q1, q2 ; No PTY or terminal JFN setzb q3, q4 ; No assigned PTY or TTY device setz p2, p3 ; No fork created call comput ; Get correct byte pointer and count call ptyjfn ; Set JFN's to time a PTY: jrst epicom ; If failed, hit the epilogue callret tcommn ; Otherwise, hit the common code subttl Set up a PTY:/TTY: pair for transfer timing ; +1/ Couldn't do it ; +2/ Worked ; ; q1/ Open PTY JFN and flags ; q2/ Open TTY JFN and flags ; q3/ Assigned PTY device ; q4/ Assigned TTY device extern asipty ; Assign a pseudo-terminal extern ptynam,ttynam ; ASCII names of assigned devices extern asgflg ; Flag for assigned device extern asgdev ; Device actually assigned extern ndvchr ; Double word device characteristics extern ptytty ; PTY to TTY: line mapping extern ptyflg ; Using a pseudo-terminal extern binflg ; Device is in binary (8-bit) mode ptyjfn: remark ;Expects caller to have saved these remark ; N.B., q4 and p1 are aliases!! setzm asgflg ; Force an assignment call asipty ; Grab us a PTY ret ; or not... move q3, t2 ; Store the returned PTY designator hrli t1,.dvdes+.dvtty ; Turn returned line into a TTY designator ASND% ; Grab associated terminal, too %jserr (,r) ; Odd, just got the PTY... move q4, t1 ; Store assigned terminal's device designator remark ; PTY takes mode of TTY:, so open that first dmove t1, [ gj%sht!gj%flg ; Want GTJFN% flags returned -1,,ttynam ] ; asipty built this for us GTJFN% ; Try to get a JFN on the PTY's associated TTY %jserr (,r) move q2, t1 ; Store TTY JFN and flags tlz t1,-1 ; Whack flags so OPENF% doesn't choke movx t2, ; 8-bit bytes skipge t3, pars3 ; Load parsed OPENF% mode ifskp. ; User specified it, let's use it dpb t3, [pointr t2, of%mod] endif. skipg t4, pars4 ; Load parsed OPENF% byte size ifskp. ; User specified it, let's use it dpb t4, [pointr t2, of%bsz] endif. OPENF% ; read-only %jserr (,r) dmove t1, [ gj%sht!gj%flg ; Want GTJFN% flags returned -1,,ptynam ] ; asipty built this for us GTJFN% ; Try to get a JFN on the PTY %jserr (,r) move q1, t1 ; Store PTY JFN and flags tlz t1,-1 ; Whack flags so OPENF% doesn't choke movx t2, ; 8-bit bytes remark of%mod ; PTY itself *ONLY* supports normal mode skipg t4, pars4 ; Load parsed OPENF% byte size ifskp. ; User specified it, let's use it dpb t4, [pointr t2, of%bsz] endif. OPENF% ; normal mode (only one supported), write-only %jserr (,r) retskp ; Return success subttl Determine PIP: Virtual Baud Rate ; N.B., this code is not intended to provide a definitive answer to ; ANYTHING because Tops-20 is not a real-time system. Even a speck ; of system load can wildly peturb the results as well as whatever the ; current monitor's pipe implementation happens to be. ; ; See dptybd for more extensive commentary dpipbd: intern dpipbd ; May be invoked as a test saveac ;Holds pipe particulars remark ; N.B., q4 and p1 are aliases!! setzb q1, q2 ; No source or destination PIP: JFN setzb q3, q4 ; No assigned PIP: device setz p2, p3 ; No fork created call comput ; Get correct byte pointer and count call pipjfn ; Set JFN's to time a PIP: device jrst epicom ; If failed, hit the epilogue callret tcommn ; Worked, hit the common code subttl Set up a PIP: pair for transfer timing ; +1/ Couldn't do it ; +2/ Worked ; ; q1/ Open write PIP: JFN and flags ; q2/ Open read PIP: JFN and flags ; q3/ Zero (no assigned write device) ; q4/ Zero (assigned read device) ; N.B., Can't use ";RECORD-SIZE:500" attribute. Broken. ; Proper format is RECORD-LENGTH chgsec(code,data) ;;Needs some storage pipnam: block ^d20 ; Space to build name pip2nd: block 4 ; Space for 19 characters, plus nul retsec ;;Get out of data psect chgsec(code,text) ;;Put strings into text psect pip1st: ASCIZ /PIP:.;RECORD-LENGTH:/ ; From PIPE.MAC (N.B., NOT RECORD-SIZE!) remark 12345678901234567890 ; Four words of storage retsec ;;Back in code psect remark pars3 ; OPENF% mode remark pars4 ; OPENF% byte size remark pars5 ; Buffer size (RECORD-LENGTH) pipjfn: remark ;Expects caller to have saved these remark ; N.B., q4 and p1 are aliases!! remark q1, q2, q3, q4 ; Assumes all zero skiple t2, pars5 ; See if we have a record length ifskp. ; We don't move t3, pip1st ; Pick up first five characters (nice hack, Tom) setz t4, ; Tie off with .chnul's dmovem t3, pipnam ; Stomp into the file specification else. ; Otherwise, wants to specify it dmove t3, pip1st ; Get the first ten characters dmovem t3, pipnam ; Store them dmove t3, pip1st+2 ; Get the second ten characters dmovem t3, pipnam+2 ; Store them setzm pipnam+4 ; Tie off the string hrroi t1, ; Puts the decimal number after the colon movei t3, ^d10 ; RECORD-LENGTH number is decimal NOUT% ; Tack it on to the end %jserr (,r) endif. dmove t1,[gj%sht!gj%flg ; Want GTJFN% flags returned -1,,pipnam ] ; PIP:'s odd syntax GTJFN% ; Try to get a JFN on the pipe %jserr (,r) move q1, t1 ; Store first PIP: JFN and flags setzb t1, t2 ; Cons up ten .CHNUL's dmovem t1, pip2nd+0 ; Whack all the storage dmovem t1, pip2nd+2 ; where we'll write more odd syntax hrroi t1, pip2nd ; Point to area for JFNS% hrrz t2, q1 ; Load our odd first PIP: JFN dmove t3, [fld(.jsaof,js%dev)!fld(.jsaof,js%nam)!js%paf 0 ] ; No strange prefix (whatever that is) JFNS% ; Build first part of strange string %jserr(,r) movx t2, "." ; Load a dot idpb t2, t1 ; Punctuate the file type hrrz t2, q1 ; Load our odd first PIP: JFN movx t3, ; File type is the same as the name JFNS% ; Build second part of strange string %jserr(,r) dmove t1, [ gj%sht!gj%flg ; Want GTJFN% flags returned -1,,pip2nd ] ; PIP:'s odd syntax GTJFN% ; Try to get a JFN on the PTY %jserr (,r) move q2, t1 ; Store 2nd PIP: JFN and flags hrrz t1, q1 ; Load write JFN without flags movx t2, ; 8-bit bytes skipge t3, pars3 ; Load parsed OPENF% mode ifskp. ; User specified it, let's use it dpb t3, [pointr t2, of%mod] endif. skipg t4, pars4 ; Load parsed OPENF% byte size ifskp. ; User specified it, let's use it dpb t4, [pointr t2, of%bsz] endif. OPENF% ; N.B., source JFN is write-only %jserr (,r) hrrz t1, q2 ; Load read JFN without flags movx t2, ; 8-bit bytes skipge t3, pars3 ; Load parsed OPENF% mode ifskp. ; User specified it, let's use it dpb t3, [pointr t2, of%mod] endif. skipg t4, pars4 ; Load parsed OPENF% byte size ifskp. ; User specified it, let's use it dpb t4, [pointr t2, of%bsz] endif. OPENF% ; Normal mode, read-only %jserr (,r) retskp ; Return success subttl Determine SRV: Virtual Baud Rate ; N.B., this code is not intended to provide a definitive answer to ; ANYTHING because Tops-20 is not a real-time system. Even a speck ; of system load can wildly peturb the results as well as whatever the ; current monitor's DECnet implementation happens to be. ; ; It is not going over ANY hardware network interface; traffic is ; purely inside of Tops-20. ; ; See dptybd for more extensive commentary dsrvbd: intern dsrvbd ; May be invoked as a test saveac ;Holds DECnet particulars remark ; N.B., q4 and p1 are aliases!! setzb q1, q2 ; No DCN: or SRV: JFN setzb q3, q4 ; No assigned DCN: or SRV: device setz p2, p3 ; No fork created call comput ; Get correct byte pointer and count call srvdcn ; Set JFN's to time a DCN:-SRV: device pair jrst epicom ; If failed, hit the epilogue callret tcommn ; Worked, hit the common code subttl Acquire a JFN on a DCN:/SRV: pair remark Storage area and string components chgsec(code,text) ;;Put these in program text strings srvnam: asciz "SRV:.KERMIT-TIMING" ; Task is Kermit Timing service srvmsg: asciz "Kermit-20: Ready" dcntsk: asciz "-TASK-KERMIT-TIMING;USER:" dcndat: asciz ";DATA:" ; Gets HPTIM% ticks as ASCII retsec ;;Done with read-only text strings chgsec(code,const) ;;Read-Only pointers are constant data srvacc: point 7, srvmsg ; Acknowledgement message srvlen: ^d16 ;;And its length retsec chgsec(code,data) ;;Need some writable storage whoami: block 1 ; Currently signed in user number intern whoami ; START: in k20mit populates this tsktim: block 1 ; HPTIM% value (max 27487790694) dcname: Block ^d20 ; Space for 100 characters retsec ;;Back to generating executable code remark Code to get and open the JFN's srvdcn: remark ; First, must get SRV: JFN dmove t1, [ gj%sht!gj%flg ; Want GTJFN% flags returned -1,,srvnam ] ; GTJFN% ; Try to get a JFN on the passive component %jserr (,r) move q2, t1 ; Store SRV: JFN and flags tlz t1,-1 ; Whack flags so OPENF% doesn't choke movx t2, ; 8-bit bytes skipge t3, pars3 ; Load parsed OPENF% mode ifskp. ; User specified it, let's use it dpb t3, [pointr t2, of%mod] endif. skipg t4, pars4 ; Load parsed OPENF% byte size ifskp. ; User specified it, let's use it dpb t4, [pointr t2, of%bsz] endif. OPENF% ; normal mode, read-only %jserr (,r) call bldcnt ; Build the (hairy) DCN: task name to SRV: ret ; But falled?? dmove t1, [ gj%sht!gj%flg ; Want GTJFN% flags returned -1,,dcname ] ; GTJFN% ; Try to get a JFN on the PTY %jserr (,r) move q1, t1 ; Store DCN: JFN and flags tlz t1,-1 ; Whack flags so OPENF% doesn't choke movx t2, ; 8-bit bytes skipge t3, pars3 ; Load parsed OPENF% mode ifskp. ; User specified it, let's use it dpb t3, [pointr t2, of%mod] endif. skipg t4, pars4 ; Load parsed OPENF% byte size ifskp. ; User specified it, let's use it dpb t4, [pointr t2, of%bsz] endif. OPENF% ; normal mode, write-only %jserr (,r) hrrz t1, q2 ; Load server JFN movx t2, .mocc ; Explicitly accept the DCN: dmove t3, srvacc ; And the acknowledgement message MTOPR% ; Finish the connection negotiation %jserr (,r) retskp subttl Build cooresponding DCN: task name to SRV: ; N.B., the DCN string is a little convoluted, but it is generalized ; enough so that we could run tests between Tops-20 nodes, should we ; want to try that. extern myname ; Name of local executor bldcnt: remark Means: BuiLd DCN Text move t1, [ BYTE (7) "D", "C", "N", ":", .chnul] movem t1, dcname ; Start device portion immediately move t1, [ point 7, dcname, 27 ] ; point before the .chnul remark ; Could drop in /REMOTE:NODE here ifmn. myname ; Did we ever figure our local node name out? move t2, [ point 7,myname ] ; We did, so drop that in do. ; Enter loop context ildb t3, t2 ; Pick a byte of the node name jumpe t3, endlp. ; Unless we've done all of it idpb t3, t1 ; Append to active component device loop. ; Get some more, wee!! enddo. ; Exit loop context endif. move t2, [ point 7, dcntsk ] do. ; Append the rest of the DECnet task gibberish ildb t3, t2 ; Pick a byte of the node name jumpe t3, endlp. ; Unless we've done all of it idpb t3, t1 ; Append to active component device loop. ; Get some more, wee!! enddo. move t2, whoami ; Load my user number DIRST% ; Tack that on after %jserr (,r) move t2, [ point 7, dcndat ] do. ; Append the ;DATA: attribute ildb t3, t2 ; Pick a byte of the node name jumpe t3, endlp. ; Unless we've done all of it idpb t3, t1 ; Append to active component device loop. ; Get some more, wee!! enddo. move t4, t1 ; Save output pointer movei t1, .HPELP ; Elapsed DK10 ticks since start HPTIM% ; Grab it %jserr (,r) movem t1, tsktim ; Store as task time (for ;DATA:) move t2, t1 ; Position uptime ticks move t1, t4 ; Reload output pointer movx t3, fld(^d10,no%rdx) ; NOUT% ; Tack that on %jserr (,r) retskp ; Finally won subttl Device speed determination storage .endps code ; Get out of the code .psect .psect devtim/ronly,devorg; psect for reading and writing for timing devwrt: remark ; Where data will be written from nulwrt==:devwrt ; Ditto for special case NUL: $d$=.chnul ; Generated data starts at NUL $c$=0 ; Rotating check digit starts at zero xlist ; Don't need silly listing repeat ^d512,< ; Doing a single page byte (8) $d$,$d$+1,$d$+2,$d$+3 (4) $c$ $d$=$d$+4 ;;Step to next four ASCII characters $c$=<<$c$+1>&17> ;;Step to next check digit >;;repeat list ; Turn listing back on devwrd==.-devwrt ; Device words to write devchr==devwrd*4 ; Corresponding 8 bit character count cleans(<$d$,$c$>) ; Chuck worker symbols ; N.B., The below is a bit of a hack because the page won't exist, which ; means we can then create it and write it. Heh... devred: block ^d512 ; Where data will be read into devdat: block ^d512 ; Additional data for NUL: timing devda2: block ^d512 ; 2nd part of it .endps devtim ; End of timing .psect .psect code ; Get back into code .psect subttl Device inferior fork timing code and storage chgsec(code,data) ;;Inferior's storage devpdl: devhlt ; Return to our HALTF% block ^d19 ; Rest of inferior's stack devstg==.-devpdl ; Length of inferior's storage retsec ; Back in code segment ; Inferior code is in the AC's because I thought I was going to have a ; very restricted address space there. This is not possible because ; of the need to call the timing ending routine and catch its errors. ; ; Note, superior does a SOUTR% to force a 'push'; the inferior also ; does a SINR% because it appears to be SLIGHTLY faster. devcod=: . ; Inferior's code phase 0 ; Inferior's program point 8,devred ; ac0/ Where we're reading to .fhslf ; 1 t1/ This fork lstrx1 ; 2 t2/ "Process has not encountered any errors" - ; 3 t3/ length of data being read 0 ; 4 t4/ Stop on .chnul (ignored) devinf: RESET% ; 5 q1/ Inferior start up erjmpr devhlt ; 6 q2/ Handle any error by just stopping SETER% ; 7 q3/ Otherwise flag everything worked erjmpr devhlt ; 10 q4/ Shouldn't ever break ... devhlt: HALTF% ; 11 p2/ Completed initialization movei t1, .priin ; 12 p3/ Set by superior move t2, 0 ; 13 p4/ Load pointer SIN% ; 14 p5/ Do a counted read erjmpr devhlt ; 15 .fp/ Handle the error callret endtim ; 16 cx/ Finish the timing -^d19,,devpdl ; p/ stack (17) dephase ; Restore normal location counter subttl Timing common storage chgsec(code,data) ;;Writeable storage for data transfer timdev:: block 1 ; Device being timed devacs: block ^d16 ; Timing fork AC's chrptr: block 1 ;*** DO NOT ; Left halfword of section local pointer chrcnt: block 1 ;REORDER ** ; Character count in current byte size retsec subttl Computer character pointer and counter construction ; Note, PTYLEN is the number of words in a single page and is common ; for all devices. comput: skiple t4, pars4 ; Pick up byte size for SOUTR% ifskp. ; Was anything specifed? dmove t2,[ ; No, use defaults point 8,0 ; Using 8 bit bits - ] ; Number of characters in the single page else. ; Otherwise, need to do some coversions dmove t2,[exp -1,-^d36] ;Load double negative integer 36 div t2, t4 ; Calculate bytes per word muli t2, ptylen ; Now have total bytes we'll do in t3 movx t2, ; Set up for an ILDB at bit '36' dpb t4, [ pointr t2, sbyte ] ; Drop in the byte size endif. ; End non-standard byte size dmovem t2, chrptr ; Store pointer prototype and count ret subttl Multi-fork timing common code ; See commentary on timing PTY virtual baud rate. These numbers are ; only used to validate the granularity of regular transfers extern frclose ; Force a JFN closed extern cmprmn ; cmpse in k20ioc tcommn: remark ; Assumes these are saved remark ; N.B., q4 and p1 are aliases!! setz p2, ;[223] No inferior fork yet call parset ;[223] Set up parity, if doing parity jrst epicom ;[223] Beat it, we've got to fix our tables movx t1, ^d16 ; Transferring 16 accumulators dmove t2, [ devcod ; Source is device code devacs ] ; Destination is writable storage xblt. t1 ; Transfer so we can modify it movei t3, devacs ; Resolve address of writable AC's dmove t1, chrptr ; Load byte pointer prototype and count hllm t1, 0(t3) ; Tweak byte size and pointer movem t2, t3(t3) ; Put the correct count in remark ; N.B., cr%map makes a real gross page map, sigh. dmove t1, [ cr%map!cr%acs!cr%st!fld(devinf,cr%pcv) devacs ] ; Set AC's to have device inferior code CFORK% ; Make me a fork (poof! You're a fork) %jserr (,epicom) move p2, t1 ; store inferior handle move t1, p2 ; Load inferior's handle WFORK% ; Wait for inferior initialization completion %jserr(, epicom) GETER% ; Find out inferior's last error %jserr(, epicom) tlz t2, -1 ; Stomp silly fork handle cain t2, lstrx1 ; Everything's Archie, right? ifskp. ; It isn't, so complain movei t1, .fhslf ; Set our last error to inferior's SETER% ; So diagnostic message is more meaningful %ermsg(,epicom) endif. remark t1, .fhinf ; Still has the fork handle hrlz t2, q2 ; Load PTY's TTY JFN as inferior's primary input hrri t2, .cttrm ; But it can still write to our terminal SPJFN% ; Set it so SINR% doesn't break %jserr(, epicom) setmm devred ; Create reading page, so not creation time charge txo t1, sf%con ; Continuing inferior SFORK% ; Get it started in its read %jserr(, epicom) txz t1, sf%con ; Get a clean fork handle movei t2, devacs ; Load address of inferior AC block dmove t3, [ lstrx1 ; What indicates it isn't in SINR%, yet ^d20 ] ; Only wait 5 seconds (.25 * 20) do. ; Enter inferior fork check loop context FFORK% ; Freeze inferor (so we can read its AC's) %jserr (,epicom) RFACS% ; Read inferior's accumulators %jserr (,epicom) RFORK% ; And resume the fork %jserr (,epicom) came t3, t2(t2) ; Not in the SINR% yet? exit. ; Finally in the SINR% (or real close!!) movei t1, ^d250 ; Wait a bit for it to turn back on DISMS% ; And chill out for a bit move t1, p2 ; Reload the fork handle sojg t4, top. ; Try again (but only so long) enddo. ; Exit loop context ife. t4 ; Exhausted the count? %ermsg (,epicom) endif. ; piffle.... remark ; Loop appears to be unnecessary for inter-job... call statim ; Start timing the transfer dmove t2, chrptr ; Load pointer prototype and count hrri t2, devwrt ; Where we're writing from skipe timpar ;[223] Unless doing parity hrri t2, devdat ;[223] OK, so we're doing it with parity bits set movei p3, ^d25 ; Only wait so long for buffers to drain ; Loop is because of limited monitor buffers do. ; Enter loop context hrrz t1, q1 ; Load the source JFN (no flags) move t4, t3 ; Save a copy of remaining character count SOUTR% ; Blammo!! ifje. r ; Uh oh, investigate the failure cain t1, IOX33 ; Inferior couldn't swallow all of it at once? anskp. ; Nope; however, we can recover from this %ermsg(, epicom) endif. ; Carry on if worked or IOX33 jumpe t3, endlp. ; If done, then leave came t3, t4 ; Did it do anything, actually? loop. ; Yes, so ready to do some more call ckdtwr ; Otherwise, check device write status jrst epicom ; Something went wrong or is bad movei t1, ^d100 ; Give inferior a chance to run DISMS% ; So it can catch its breath sojg p3, top. ; And try another drop enddo. ; Exit loop context ife. p3 ; Exhausted the count? %ermsg (,epicom) endif. ; piffle.... remark ; Repeating previous code for better error messages move t1, p2 ; Load inferior's handle WFORK% ; Wait for inferior SINR% to complete %jserr(,epicom) GETER% ; Find out inferior's last error %jserr(,epicom) tlz t2, -1 ; Stomp silly fork handle cain t2, lstrx1 ; Everything's Archie, right? ifskp. ; It isn't, so complain movei t1, .fhslf ; Set our last error to inferior's SETER% ; So diagnostic message is more meaningful %ermsg(,epicom) endif. call elptim ; Compute elapsed transfer time call parchk ;[223] Check parity, if doing parity jrst epicom ;[223] Skip the rest of it remark ; Check the data made it over correctly block. ; Build a stack frame to preserve registers skipe timpar ;[223] Did we already check the parity? retskp ;[223] We did, so if made it here, everything is fine saveac ; Need to save these movn t1, chrcnt ; Load length of string sent move t4, t1 ; Strings are the same length setzb t3, q2 ; Section local string pointers move t2, chrptr ; Load correct character pointer and size hllz q1, t2 ; Both sources are equivalent here hrri t2, devwrt ; What we wrote hrri q1, devred ; What we read extend t1, cmprmn ; See if everything made it through OK ret ; Not equal, phooey! retskp ; Equal!! endbk. ; End block ifskp. ; Worked nop ; No special action, carry on else. ; Failed??? move t3, t1 ; Save source character count move q2, t2 ; Save source character pointer emsg () movei t1, .priou ; Continue blatting movn t2, chrcnt ; Load length of string sent sub t2, t3 ; Subtract remaining characters movei t3, fld(^d10,no%rdx) NOUT% ; Shows what character we croaked on erjmpr .+1 hrroi t1, crlf PSOUT% erjmpr .+1 jrst epicom endif. remark ; Finally get to do some arithmatic!! setz t1, ; Load integer high order of character count movn t2, chrcnt ; Load load order character count dmul t1, [exp 0, ^d100000*^d10 ] ; Scale to bits in microsecond time dmove t1, t3 ; Load low order double word call dfloat ; Convert to double floating point %ermsg (, epicom) dmove t3, t1 ; Save double floating bit count dmove t1, ewallt+.datus ; Load tens of nanoseconds used call dfloat ; Convert to double floating point %ermsg (, epicom) dfdv t3, t1 ; Divide bits by ticks block. ; Enter block context for another frame saveac ; Save result before the call call epicom ; Stomp everything endbk. ; Exit block context move t5, t4 ; Return virtual baud rate for some device move t4, t3 ; Return the high order, too retskp ; Return success subttl Common timing test epilogue code ; N.B., Do not change the order of resource release, below! ; ; 1) An open JFN that is in active use via an SPJFN% can not be ; closed or even force closed, the error being an arcane CLSX2, ; "File cannot be closed by this process". ; ; This is why the SPJFN% is done before any close attempts. ; (Learned that the hard way...) ; ; 2) The SPJFN% is also done before the KFORK% as a caution to the ; JFN being left in an odd way or the KFORK% failing. epicom: skipn t1, p2 ; Did we have a fork? ifskp. ; We did, chuck it movx t2, <.nulio,,.nulio> ; Truely shut it up SPJFN% ; Attempt the muzzling ifje. r ; Catch and store error move t4, t1 ; Store error for debuggers move t1, p2 ; Reload the fork handle endif. ; But carry on in either case setzb t3, t4 ; Whack JSYS error talismen KFORK% ; Try to clobber the inferior ifje. r ; Catch and store error move t4, t1 ; Store error for debuggers move t1, p2 ; Reload the fork handle again RFRKH% ; At least try to release that ifskp. ; There is no joy in mudville move t3, t1 ; Store for debuggders endif. ; End case RFRKH% failure handling endif. ; Continue and clean up storage setz p2, ; Either way, no more fork endif. skipn t1, q2 ; Did we ever have a destination JFN? ifskp. ; We did call frclose ; Force it closed (see k20sub) nop ; Failed somehow setz q2, ; Either way, no destination JFN endif. skipn t1, q1 ; Did we ever have a source JFN? ifskp. ; We did call frclose ; Force it closed (see k20sub) nop ; Failed somehow setz q1, ; Either way, no source JFN endif. seto t1, ; Removing pages dmove t2,[.fhslf,,nulpag+1 ;Whacking dirty pages from address space pm%cnt!pm%abt!fld(,pm%cnt) ] PMAP% ; Reduce our working set size ifje. r ; Should never happen... move t4, t1 ; Store error for debuggers endif. skipn t1, q4 ; Did we assign the PTY's associated terminal? ifskp. ; We did, release it RELD% ; Try to punt the TTY ifje. r ; Catch and store error move t4, t1 ; Store error for debuggers endif. ; Carry on! setz q4, ; Either way, no assigned terminal endif. skipn t1, q3 ; Did we assign a PTY? ifskp. ; We did, release it RELD% ; Try to punt the PTY ifje. r ; Catch and store error move t4, t1 ; Store error for debuggers endif. ; Continue and clean up storage setz q3, ; Either way, no assigned PTY setzm asgflg ; Clear device assignment flag setzm asgdev ; Clear stored assigned device setzm ptytty ; Clear PTY's associated TTY line number setzm ptyflg ; Clear pseudo-terminal I/O flag setzm binflg ; Clear binary I/O flag setzb t1, t2 ; Cons up a zero double word dmovem t1, ndvchr ; Whack characteristics double word dmovem t1, ttynam ; No ASCII terminal device name dmovem t1, ptynam ; No pseudo-terminal device name endif. ret ; Phew!! subttl Device lower fork checking code ; Here if the upper fork SOUTR% fails and the byte count is unchanged define errtxt (t,%t,%et) < ;;Macro to put a string in text section move t1,%t ;;Local pointer to text chgsec(code,const) ;;Put pointer to extended text in const section %t: .px7!%et ;;OWGP to extended section retsec ;;Restore .PSECT assumptions chgsec(code,etext) ;;Open non-section zero text %et: asciz |'t| ;;Deposit text and label text with generated symbol retsec ;;Restore .PSECT assumptions cleans(<%t,%et>) ;;Punt generated symbols >;;errtxt ckdtwr: saveac ; Modifies no registers remark ; First, pull fork information move t1, p2 ; Load inferior's handle GETER% ; Get its last error %jserr(, r) tlz t2, -1 ; Stomp silly fork handle move q3, t2 ; And save the last error move t1, p2 ; Load inferior's handle RFSTS% ; Return fork status %jserr(, r) tlz t2, -1 ; Stomp any flags dmove q1, t1 ; Save the inferior's status and PC ldb t4, [pointr. q1, rf%sts] caige t4, .rfmax ; Out of range? ifskp. ; Must be a new monitor movei t1, .fhslf ; Set our last error move t2, q3 ; To inferior's for better SETER% ; Diagnostic messages erjmpr .+1 ; Catch and ignore error %ermsg(,r) endif. ; But regular handler won't work cain q3, lstrx1 ; Everything's Archie, right? ifskp. ; It isn't, so complain errtxt() callret ckderr ; Return from error type out endif. ifxn. q1, rf%frz ; Did it get frozen somehow? errtxt() callret ckderr ; Return from error type out endif. ; Should never happen in the push loop ; Otherwise, load its status cain t4, .rfrun ; Running? retskp ; That's OK. I guess... cain t4, .rfio ; Doing I/O? retskp ; This is expected (what its supposed to be doing) caie t4, .rfhlt ; Halted?? ifskp. ; That might be OK, actually caie q2, devhlt+1 ; Normal halt? ifskp. ; Yes, so need to wait for buffers to drain txmsg <% Inferior timing fork normal termination, waiting on buffers > retskp ; And try again endif. ; Otherwise, a real error errtxt() callret ckderr ; Return from error type out endif. remark ; Any other status is bad errtxt () remark ckderr ; Fall through to error type out subttl Handle print out of inferior error ; Expects ckptwr register environment except t1 has an error message ckderr: ESOUT% ; First, do the blat erjmpr .+1 ; Catch and ignore error movei t1, "," ; Punctuate first part of error message PBOUT% erjmpr .+1 ; Catch and ignore error movei t1, .chspc ; And space over PBOUT% erjmpr .+1 ; Catch and ignore error move t1,rfstst(t4) ; Load appropriate status text PSOUT% ; Type it erjmpr .+1 ; Catch and ignore error caie t4, .rffpt ; Forced? ifskp. ; Then we have some more information errtxt (<, channel: >) ;Meaning, the channel number PSOUT% ; Type that erjmpr .+1 ; Catch and ignore error movei t1, .priou ; Output to our terminal ldb t2, [pointr. q1, rf%sic] ; Load forcing channel movei t3, ^d10 ; Which is in base 10 NOUT% ; Type it %ermsg(,r) endif. movei t1, "," ; Punctuate first part of error message PBOUT% erjmpr .+1 ; Catch and ignore error movei t1, .chspc ; And space over PBOUT% erjmpr .+1 ; Catch and ignore error move t1, .priou ; Going to primary output hrli t2, .fhslf ; Have to use ourself for explicit error hrr t2, q3 ; Pick up inferior handle setz t3, ; No limit to blat ERSTR% ; Blat away! erjmpr .+2 ; Ignore its strange return erjmpr .+1 ; Ignore its stranger return movei t1, "," ; Punctuate first part of error message PBOUT% erjmpr .+1 ; Catch and ignore error movei t1, .chspc ; And space over PBOUT% erjmpr .+1 ; Catch and ignore error move t1, q2 ; Load inferior's captured PC call symout ; Symbolic type out of failed location hrroi t1, crlf ; Tie off the line PSOUT% ret ; Always return +1 to superior subttl Text for fork status codes remark ; RF%STS (Process Status Code) rfstst: eascii (< Runnable>) ; .RFRUN eascii (< I/O>) ; .RFIO (Dismissed for I/O) eascii (< Halted>) ; .RFHLT eascii (< Forced>) ; .RFFPT (Forced process termination) eascii (< Waiting>) ; .RFWAT (Waiting for inferior process) eascii (< Sleep>) ; .RFSLP eascii (< Trapped>) ; .RFTRP (JSYS Trapped) eascii (< Address>) ; .RFABK (Address break freeze) eascii (< Signal>) ; .RFSIG (Signal JFN freeze) .rfmax==.rfsig+1 subttl Discover NUL: baud rate ; Written to merely check calculations code before writing other timers ; ; As above, NUL:'s virtual baud rate means very little. ; ; Unlike the above, NOTHING reads the SOUTR% because this is ; (onviously) impossible to do as the data just got dumped. The ; reason four times the data is written is to work the rate ; calculations in a different way, stressing them to look for edge ; cases ; ; Therefore, doing parity on NUL: is relatively to moderately...useless. remark pars4 ; SOUTR% byte size pbyte==maskb(0,5) ; Position of a byte in a section local pointer sbyte==maskb(6,11) ; Size of a byte in a section local pointer dnulbd: intern dnulbd ; Invoked by k20dsp setob t4, t5 ; Let's assume we can't do anything dmove t1,[.fhslf,,nulpag ; Source is NUL: page .fhslf,,nulpag+1 ] ; Destination is the second page movx t3, pm%cnt!pm%rd!fld(nulpgs,pm%rpt) ; Read only PMAP% ; Case III, process to process PMAP% %jserr (, nulepi) remark ; NUL counts are different skiple t4, pars4 ; Pick up byte size for SOUTR% ifskp. ; Was anything specifed? dmove t2,[ ; No, use defaults point 8,nulwrt ; Where we're writing from - ] ; Number of characters in the pages else. ; Otherwise, need to do some coversions dmove t2,[exp -1,-^d36] ;Load double negative integer 36 div t2, t4 ; Calculate bytes per word muli t2, nullen ; Now have total bytes we'll do in t3 movx t2, ; Set up for an ILDB at bit '36' dpb t4, [ pointr t2, sbyte ] ; Drop in the byte size hrri t2, nulwrt ; Finally drop in the address endif. ; End non-standard byte size movx t1, .nulio ; Just dumping, maybe really fast movn t4, t3 ; Save count used call statim ; Start timing the transfer SOUTR% ; Bombs away!!! %jserr (, nulepi) call endtim ; Finish the timing call elptim ; Compute elapsed transfer time setz t1, ; Zero high order of characters transferred move t2, t4 ; Load low order of characters transferred dmul t1, [exp 0, ^d100000*^d10 ] ; Scale to bits in microsecond time dmove t1, t3 ; Load low order double word call dfloat ; Convert to double floating point %ermsg (, nulepi) dmove t3, t1 ; Save double floating bit count dmove t1, ewallt+.datus ; Load tens of nanoseconds used call dfloat ; Convert to double floating point %ermsg (, nulepi) dfdv t3, t1 ; Divide bits by ticks dmove t4, t3 ; Return in the expected place call nulepi ; Call the epilogue retskp ; Return success nulepi: remark NUL test epilogue seto t1, ; Removing pages dmove t2,[.fhslf,,nulpag+1 ;Whacking dirty pages from address space pm%cnt!pm%abt!fld(nulpgs,pm%rpt) ] ; Read only PMAP% ; Reduce our working set size ifje. r ; Should never happen... move t3, t1 ; Store error for debuggers endif. ret subttl Set up for parity checking (if we're doing parity) ;[223] Begin code insertion ;N.B., Assumes we're ALWAYS doing 8 bit transfers, which is what ; Kermit would be sending over the line. However, due to the last ; four bits of the data being transferred having rotating values, ; it may be possible to get into the situation here where the byte ; parity is reported as being fine, but the word comparison can fail. extern parity, none ; If we're doing any kind of parity extern genint ; Constructed instruction if generating parity remark ; If doing parity, ALWAYS sending AND checking it chgsec(code,data) ;;Needs some writable storage timpar: 0 ; Set if was doing parity retsec ;;Back in code parset: setzm timpar ; Don't assume doing parity move t1, parity ; Load parity setting caie t1, none ; Not doing any parity? ifskp. ; Nope, nothing further to do retskp ; so get out of here else. ; Otherwise, doing some real work skipge t1, timdev ; Load timing device retskp ; Unless never got one cain t1, .dvnul ; NUL:? retskp ; Yeah, no way to read from that, so forget parity setom timpar ; Flag we're doing parity endif. remark ; OK to trash these temporaries saveac ; But needs many piggy registers movei t1, devchr ; Load number of characters move t4, t1 ; destination string is same length movei t2, devwrt ; Load address of what will be written movei q1, devdat ; Where we'll write the converted data hrli t2, (point 8,0) ; Turn source address into a section local point hll q1, t2 ; Ditto destination pointer, both being 8 bits setzb t3, q2 ; Force pointer to remain section local move q3, genint ; Load parity generation instruction setz q4, ; Unused fill character will be NUL txo t1, S ; Start significance immediately extend t1, q3 ; Finally do the conversion erjmpr r ;[267] Can die in a batch job, go figure callret chkleg ; Check generated parity against legacy parity subttl Routine to check parity we generated against legacy routines ; +1 If disagreement someplace ; +2 If complete agreement extern putc ; Does a small amount of formating chkleg: dmove t2, [ ; Will run legacy routines point 8, devwrt ; over same string point 8, devdat ] ; and compare the results move q3, t2 ; Save original string pointer movei q2, devchr ; Load number of characters do. ; Enter loop context sojl q2, endlp. ; Account for a character pair consumed ildb t1, t2 ; Pick up byte from original string call @parity ; Compute the correct parity ildb t4, t3 ; Pick up byte from MOVST generated string came t1, t4 ; The same? exit. ; They are not, give up right now loop. ; Nose through the rest enddo. ; End loop lexical context jumpl q2, RSKP ; Did them all? That's dandy!! ; Sigh... move q1, t1 ; Save legacy parity move q4, t4 ; Save MOVST generated parity movei t1, devchr ; Load original number of characters sub t1, q2 ; Calculate bad byte position move q2, t1 ; Save result adjbp t1, q3 ; Position to the correct character ldb q3, t1 ; And load the character ; Finally start complaining emsg () movei t1, .priou ; Still typing on terminal move t2, q2 ; Load byte position movei t3, ^d8 ; k20ioc table is documented in octal NOUT% ; Type it %jserr (,) txmsg (<, legacy: >) move t4, q1 ; Load what arithmatic calculated movei t1, "0" ; Let's assume it was zero txze t4, 200 ; Check and strip the parity movei t1, "1" ; It's set! PBOUT% ; Either way, type it movei t1, .priou ; Still typing on terminal move t2, t4 ; Load the value, itself movx t3, NOUT% ; Type it %jserr (,) txmsg (<, table: >) move t4, q4 ; Load what MOVST looked up movei t1, "0" ; Let's assume it was zero txze t4, 200 ; Check and strip the parity movei t1, "1" ; It's set! PBOUT% ; Either way, type it movei t1, .priou ; Still typing on terminal move t2, t4 ; Load the value, itself movx t3, NOUT% ; Type it %jserr (,) txmsg (<, character: >) setz t4, ; Let's assume bit 8 is not up move t1, q3 ; Load the character txze t1, 200 ; Zero bit 8 and skip if wasn't set seto t4, ; Was set... call putc ; Type our poor character ifn. t4 ; Did it have bit eight up? txmsg (<(M)>) ; List that as 'Mark' endif. hrroi t1, crlf PSOUT% ret subttl Check parity (if we're doing parity) ;N.B., Assumes parset has been called and will almost surly *BREAK* otherwise extern chkint ; Constructed instruction if checking parity parchk: skipn timpar ; Did we actually do any parity? retskp ; Nope, then say all is well skipge t1, timdev ; Load timing device retskp ; Unless never got one cain t1, .dvnul ; NUL:? retskp ; Yeah, no way to read from that, so forget parity remark ; OK to trash these temporaries saveac ; But needs many piggy registers movei t1, devchr ; Load number of characters move t4, t1 ; destination string is same length movei t2, devred ; Source is what the subfork read movei q1, devda2 ; destination is seperate; do not update in place hrli t2, (point 8,0) ; Turn source address into a section local point hll q1, t2 ; Ditto destination pointer, both being 8 bits setzb t3, q2 ; Force pointer to remain section local move q3, chkint ; Load parity checking instruction setz q4, ; Fill character is NUL (yet unused...) remark t1, N!M ; Shut off Negative and Mark (movei cleared them) txo t1, S ; Have to dink the foolish significance bit... extend t1, q3 ; Get down to some serious string translating nop ; Can't happen txzn t1, N ; Bump into any bad parity? retskp ; Nope, everything's fin dmove q3, t1 ; Save failing character position emsg movei t1, .priou ; Primary output dmove t2, [ devchr ; Load number of characters ^d10 ] ; Positions are in decimal sub t2, q3 ; Subtract remaining to get position NOUT% ; Type it %jserr(,) movei q2, devchr ; Load original sub q2, t4 ; Calculate amount done ifg. q2 ; Did we do anything (or gubbish)? txmsg (<, translated: ">) dmove t1, [ .priou ; Still going to primary output point 8, devda2 ] ; From beginning of translation buffer movn t3, q2 ; Counted transfer SOUT% ; and type what we did %jserr(,) txmsg (<" >) ; Shutting off font-crock mode endif. ret ; Failure return ;[223] End code insertion subttl Transfer timing routines ;[207] Begin code insertion ; Historically, Kermit timed transfers using the time of day clock ; which has approximately 1/3 of second resolution. That's probably ; fine for dial up or even local terminals where the DH11 would limit ; you to 9600 baud. The most we could get in 1988 was 19.2Kbd on a ; local Microvax connecting to CU20B. ; ; The pseudo-terminal code can do a megabaud and TCP/IP uploads to ; ckermit are clearing 500 kilobaud. A short file can get sent in FAR ; less then a time of day tick. So we read some timers here that have ; greater resolution. ; ; Although it is not currently (2023) necessary to exceed DK10 ; internal clock resolution (10 microseconds, see HPTIM%), a ; certain amount of anticipatory code has been written to do this, ; particularly in the area of extended uptimes. ; ; For example, Kermit can handle the display of terabaud speeds (see ; ranger in k20dsp). It should be noted that, with faster hosts, a ; transfer may get done in less time then the scheduling interval, so ; such times should be carefully reviewed. ; ; Another matter is such resolution with the extended uptimes ; apparently available with certain version of Tops-20. DEC and PANDA ; Tops-20 7.x can not handle a millisecond uptime which exceeds a ; signed 35 bit number. It will crash with an UP2LNG BUGHLT (see ; APRSRV) after 1 Year, 4 Weeks, 5 Days, 16 Hours, 22 Minutes, 18 ; Seconds and 367 Milliseconds. ; Given the user load on systems and the hardware technology of the ; early 1980's, this was about 5 times the maximum uptime (a little ; over two months) that was ever seen on CU20B. It is easily ; exceeded on systems with commodity hardware and one or two active ; users. ; ; The XKL (and possibly other) version(s) of Tops-20 return the uptime ; in a signed double word. The full 70 bit millisecond number will be ; reported as 37,539,161 Millennia, 7 Centuries, 2 Decades, 9 Years, 8 ; Weeks, 2 Days, 11 Hours, 35 Minutes, 3 Seconds and 423 Milliseconds. ; ; Since the current estimate of the age of the universe is 13.7 ; billion years, a thirty seven and a half billion year uptime is ; probably fine. ; ; This code handles running on an XKL monitor (which does not have ; DECnet support). ; ; In 2023, doing a get "NUL:" NUL: when connected to a pseudo- ; terminal gets an elapsed transfer time of 1.6 milliseconds, so we ; are already getting pretty close to the microsecond realm. chgsec(code,data) ;;Declare writable storage remark stdat,etdat,ewallt xlist ; Save a few trees stdat:: repeat dtilen, ; Starting time and date structure etdat: repeat dtilen, ; End time and date structure ewallt:: repeat dtilen, ; Elapsed wall time structure list ; Turn the listing back on retsec remark Set variables at the beginning of a transfer transfer statim: entry statim ; Allow global use saveac ; Don't side effect any accumulators remark ; Set up initial states of timing blocks xmovei t4, etdat ; Resolve address of end time data block call zeroit ; Go zero it out xmovei t4, ewallt ; Load address of elapsed wall time call zeroit ; Go whack that, too xmovei t4, stdat ; Resolve address of timing data block callret timwrk ; Hit the time worker and return through it zeroit: remark t4,address ; Routine to stomp a time block movx t1, dtilen-1 ; Length of remaining structure to whack move t2, t4 ; First location to whack movei t3, 1(t2) ; Cascading whackage setzm (t2) ; Stomp the first word xblt. t1 ; Stomp the rest of them ret ; Done remark Set variables at end of transfer endtim: entry endtim ; Allow global use saveac ; Don't side effect any accumulator xmovei t4, etdat ; Resolve address of timing data block remark timwrk ; fall through to the time worker ; (and return through it) subttl Time storage worker ; Call: Expects t4 to have the block address ; ; Be aware that all timing variables have gone from a single word to ; three words and resolution is stored in increasing resolution in ; order to not break any overlooked older code. ; ; The reads are done in the reverse order to keep HPTIM% as accurate ; as possible. "Accurate" may be debatable; the point of going to ; microsecond level reads was not accuracy so much as the timings had ; gone under a TOD tick (approximately 329.58858646932 milliseconds). ; ; It was subsequently discovered that some transfers are happening so ; quickly that they are approaching sub-millisecond levels (I.E., ; single digit milliseconds), bringing Kermit into the microsecond ; realm. ; ; Negative numbers will flag errors for uptime because these currently ; will not go negative. Since the time of day is actually unsigned ; (mostly), this isn't possible, so that is flagged as zero as Tops-20 ; didn't exist in 1858. ; ; Note the compatible use of the strange XKL arguments to the TIME% ; JSYS, lifted from my rewrite of OS/2 UPTIME.MAC. Documentation of ; arcane TIME% changes from Ralph Gorin of XKL. The full text is ; STAR:TOPS-20-UPTIME.TXT. ; ; Date: Sat, 07 Mar 2009 14:35:18 -0800 ; From: Ralph Gorin ; To: Thomas DeBellis ; CC: Tops-20 Wizards ; Subject: Re: Another Uptime Record ; In-Reply-To: <49B29F35.4010402@acedsl.com> ; Message-ID: <49B2F6A6.3040602@xkl.com> ; ; ... ; ; If AC 1 contains 'TODSEC' then return the uptime in seconds ; in AC 1, the residue in milliseconds in LH of AC 2 ; and the divisor to convert to seconds (the number 1) ; in the RH of AC 2. ; ; If AC 1 contains 'MSTIME' then return the uptime in milliseconds ; as a double word in AC 1 and AC 2. ; ; For other values of AC 1, the old behavior is preserved. ; ; If the uptime has exceeded 2^35 milliseonds, the program gets the ; TIMEX3 error. This is an encouragement to fix old programs. ; ; Note, the code below is not 'perfect' because it will do the wrong ; thing on an XKL monitor that is up for 1000 milliseconds in the low ; order register, no matter is what in the high order. As this will ; 'only' happen for a single millisecond once every 56 Weeks, 5 Days, ; 16 Hours, 22 Minutes, 18 Seconds and 367 Milliseconds, it is ; expected to be 'relatively' uncommon. ; ; It also assumes that the millisecond uptime is stored as a 36 bit ; unsigned number. This isn't true in 'vanilla' Tops-20; it's a 35 ; bit signed value and should never be negative. A bit of defensive ; coding for intermediate implementations. timwrk: remark t1,t2,t3 ; Previously saved and available saveac ; Will need t1-t4 for the double math move q1, t4 ; Save the address so have block of four accumulators setzb t1, t2 ; A handy pair of zeros for .HPELP ; dmove t1, [ .HPELP ; Elapsed DK10 ticks since start ; 0 ] ; A handy zero HPTIM% ; Grab it ifje. r ; Failed?? hrro t2, t1 ; Turn negative to flag error seto t1, ; Ditto low order else. ; Otherwise worked, exch t2, t1 ; so put in low order endif. ; and just use it dmovem t1, .datus(q1) ; Store amount or error (and possible flag) dmove t1, mstime ; XKL's arcane 'magic' argument (if Toad) TIME% ; Get uptime in milliseconds (maybe long) ifje. r ; Failed?? hrro t2, t1 ; Turn negative to flag error seto t1, ; Ditto low order else. ; Otherwise, some kind of success caie t2, ^d1000 ; XKL monitor? ifskp. ; No, plain old 'vanilla' move t2, t1 ; Put low order in proper place tlzn t2,(1b0) ; Test if Negative, fix low order and skip tdza t1, t1 ; Positive, zero high order and skip movei t1, ^d1 ; Negative, put sign bit in the high order endif. ; Otherwise XKL, so can stay up a lot longer!! endif. ; End TIME% result handling dmovem t1, .datms(q1) ; Store error (and possible flag) ifl. t1 ; TIME% gronked somehow? GTAD% ; Oh well, get time of day ifje. r ; Failed?? hrrzm t1, .dattd(q1) ;Store error and flag it (not 1858!!) else. ;Otherwise worked, movem t1, .dattd(q1) ; so just use it move t2, t1 ; Put low order in proper place tlzn t2,(1b0) ; Test if Negative, fix low order and skip tdza t1, t1 ; Positive, zero high order and skip movei t1, ^d1 ; Negative, put sign bit in the high order dmovem t1, .dattl(q1) ;Store signed double word result endif. ; End JSYS result handling ret ; Either way, we're done endif. call miltod ; Convert millisecond uptime to TOD ticks dmovem t3, .datmr(q1) ; Store millisecond remainder dmovem t1, .dattl(q1) ; Time of Date (TOD) as signed double ifn. t1 ; Any high order? tlo t2,(1b0) ; Yes, coerce to low order endif. movem t2, .dattd(q1) ; Time of Date (TOD) in unsigned ticks ret ; Done, finally subttl Compute Elapsed Wall Times ; Populates a block with elapsed TOD ticks, milliseconds and HPTIM% ; ticks (10 ms resolution). ; ; Note that the HPTIM% elapsed wall time will wrap at a value of 3 ; Days, 4 Hours, 21 Minutes, 17 Seconds, 906 Milliseconds and 940 ; Microseconds (76:21:17.906.940). This is the basis for the comment ; of 76 hours in the monitor. Therefore, the greatest possible ; elapsed high precision time that can be measured is the above. ; ; The value for maxhpt is gotten by running the monitor code (MTIME:: ; in APRSRV.MAC with the maximum value that RDTIME could theoretically ; return, a double word of .infin (377777,,-1). No known processor ; would do this and other uptime counters would have wrapped far ; before we got anywhere near this value. ; ; Be aware that the value for maxhpt is in HPTIM% ticks or DK10 units ; when running on the 100 kHz internal clock. Should you wish to double ; check this value (say by putting it into UPTIME), then you need to ; multiply it by 10 decimal to scale it to microseconds. That value ; will be the double word value 7::377777,,777774. ; ; If that situation is detected, then we punt and simulate with an ; appropriately scaled millisecond value. However, the maximum amount ; of DK10 time that can be held in a single word is .infin, which ; works out to 95:26:37.383.670. If that situation is hit, then we ; stop faking DK10 ticks and just pretend we don't have any more of ; them. ; ; maxmil is the value of maxhpt scaled (from DK10 ticks) to milli- ; seconds, meaning the value is divided by 100 decimal. I didn't see ; how to compute these values symbolically as there are some ; intermediate results which are double words, so I just did ; everything in DDT and documented here. ; ; Note that the order of the calculations matters here because Tops-20 ; rounds up TOD ticks, but we can't because, at a minimum, we are ; timing at millisecond resolution, which is two decimal orders of ; magnitude less than a TOD tick. The more common case of DK10 (or ; microsecond) resolution, is five orders of magnitude less. If we ; don't handle things ourselves, you can have the case where time ; appears to be going backwards in a high resolution log file. ; ; HPTIM% ticks are stored as signed doubles to allow for future code ; which can read finer times (see documentation for RDTIME instruction) maxhpt: 0 ; See MTIME in APRSRV 314631,,463146 ; N.B., DK10 units (10 us), not usecs! maxmil: 0 ; Maximum HPTIM% in milliseconds 2030,,446722 ; maxmil is maxhpt divided by 100 decimal elptim: entry elptim ; Called from K20MIT, results used in K20DSP saveac ;Don't side-effect any registers!! xmovei p4, ewallt ; Load address of elapsed wall time block xmovei p3, etdat ; Load address of ending time and date block xmovei p2, stdat ; Load address of starting time and date block movx t1, dtilen-1 ; Length of remaining structure to whack move t2, p4 ; First location to whack movei t3, 1(t2) ; Cascading whackage setom (t2) ; Set first word to ERROR value xblt. t1 ; Stomp the rest of them ; Do milliseconds in case we must fix up block. ; Enter block context for better control flow dmove t1, .datms(p3) ; Load ending milliseconds double word dmove t3, .datms(p2) ; Load starting milliseconds double word jumpl t1, R ; Negative means some kind of failure on TIME% jumpl t3, R ; Ditto dcamg t3, t1 ; We didn't get anything backwards, did we? ifskp. ; Well, that's peculiar ... exch t1, t3 ; Swap high orders exch t2, t4 ; Swap low orders endif. dsub t1, t3 ; Calculate elapsed milliseconds (should never wrap) retskp ; Success! endbk. ; End block context ifskp. ; Successful calculation block exit dmovem t1, .datms(p4) ; Store millisecond resolution call miltod ; Convert to elapsed TOD and remainder milliseconds dmovem t1, .datem(p4) ; Save elapsed TOD dmovem t3, .datmr(p4) ; Save remainder milliseconds else. ; Otherwise, some kind of odd input arguments jrst ovrflw ; Complain and punt endif. ; Done elapsed milliseconds ; Do elapsed HPTIM% ticks block. ; Enter block context for better control flow dmove t1, .datms(p4) ; Load millisecond resolution dcamg t1, maxmil ; Duration exceeds HPTIM% maximum? ifskp. ; Yes, then fake the HP ticks call ms2hp ; Convert milliseconds to equivalent DK10 units retskp ; Break out of the block endif. ; End case handling HPTIM% overflow remark ; Otherwise, can still do DK10 resolution dmove t1, .datus(p3) ; Load ending HPTIM% ticks double word dmove t3, .datus(p2) ; Load beginning HPTIM% ticks double word jumpl t1, R ; Negative means some kind of failure on HPTIM% jumpl t3, R ; Ditto dcaml t3, t1 ; Did the HPTIM% count wrap around? ifskp. ; No, so safe to subtract dsub t1, t3 ; Compute elapsed ticks retskp ; Get out of here, we're done else. ; Otherwise, calculate the wrap gap push p, p2 ; Preserve pointer to starting ticks dmove p1, maxhpt ; Load MTIME's odd wrap value dsub p1, t3 ; Calculate ticks to wrap point dadd t1, p1 ; Calculate total elapsed ticks pop p, p2 ; Restore pointer to starting ticks retskp ; As per non-wrapped case, result is in t2 endif. ; End calculating HP tick difference endbk. ; End block context ifskp. ; Successful calculation block exit dmovem t1, .datus(p4) ; Store elapsed HPTIM% ticks call etodhp ; Extract the elapsed TOD and HP ticks dmovem t1, .dateh(p4) ; Store elapsed TOD ticks, DK10 base dmovem t3, .datdk(p4) ; Store remaining DK10 ticks else. ; Otherwise, some kind of odd input arguments jrst ovrflw ; Complain and punt endif. ; Done elapsed HPTIM% ticks remark ; Calculate ending TOD dmove t1, .datms(p2) ; Load starting uptime dadd t1, .datms(p4) ; Add elapsed milliseconds dadd t1, bootrm ; Also original boot millisecond remainder call miltod ; Calculate proper elapsed TOD dmovem t3, .dattr(p4) ; Store remainder milliseconds dadd t1, bootdd ; Bring into range of current date and time dmovem t1, .dattl(p4) ; Store as unrounded ending time ifn. t1 ; Total is 36 bits, signed double? tlo t2, (1b0) ; Coerce to 36 bits unsigned single endif. ; End of date far in the future movem t2, .dattd(p4) ; Store as unrounded ending time ret ; Done, restoring dirty registers subttl Convert Milliseconds to equivalent DK10 internal clock units ; Used when HPTIM% result exceeds 95:26:37.383.670 (TOD: 1042499) ; ; Call: ; ;T1,T2/ millisecond signed double word ; ; Return: ; ;T1,T2/ Equivalent HP ticks (call value times 100 decimal) ; ; N.B., Currently does not do anything useful on overflow, +1 always ms2hp: ife. t1 ; Maybe bum the math ife. t2 ; Got called with a zero double word? ret ; Get out of here, we're done endif. endif. saveac ; Maybe somebody might be using these jfcl 17,.+1 ; Clear all flags dmul t1, [exp 0, ^d100] ; Scale milliseconds up to DK10 units block. ; Enter block context for easier control flow jfcl 17, R ; Punt if any kind of oddity jumpn t1, R ; Upper high order of 140 bit result? jumpn t2, R ; Lower high order of 140 bit result? retskp ; No to both, return 70 bit result endbk. ; End block contxt ifskp. ; In range uptime? dmove t1, t3 ; Yes, return that else. ; Wow... Big uptime callret ovrflw ; Go clip down to 'reasonable' maximum endif. ; End case HPTIM% overflow handling ret ; Done HPTIM% fixup ;[207] End code insertion subttl Extract TOD ticks from HPTIM% ticks ;[221] Begin code insertion ; Call: ; ; t1/ Elapsed HPTIM% ticks high order ; t2/ Elapsed HPTIM% ticks low order ; Return: ; ; t1/ Elapsed TOD ticks, high order ; t2/ Elapsed TOD ticks, low order ; t3/ Remaining HPTIM% ticks after TOD's are extracted, high order ; t4/ Remaining HPTIM% ticks after TOD's are extracted, low order ; ; Proportion to extract TOD X given DK10 Y is Y:DK10=X:TOD, where TOD ; is equal to 262,144 and DK10 is equal to 8,640,000,000 (that's eight ; million, six hundred and fourty thousand). Solving for X gives: ; ; X*DK10 = Y*TOD or X = (Y*TOD)/DK10 ; ; To convert input X TOD ticks to the equivalent Y DK10 ticks, the ; proportion remains the same, but we solve for Y, instead, viz: ; ; X*DK10 = Y*TOD or Y = (X*DK10)/TOD ; ; Recall that these fractions are not exact and that there are ; 32958.98438 DK10 ticks per TOD tick. This can be found by the ; following code: ; ; movx t1, <86400.> ; Numerator is seconds in a day ; movx t2, <262144.> ; Denominator is TOD tics in a day ; movx t3, <100000.> ; DK10 ticks in a second ; fdv t1, t2 ; Gets .3295898438 seconds per TOD tick ; fmp t1, t3 ; Gets 32958.98438 DK10 ticks per TOD tick ; ; Again, this kind of precision is necessary for short messages when ; doing megabaud communications, a TOD tick being wholly insufficient. ; It is unknown whether it would be sufficient for the case of short ; messages when doing gigabaud communications. Time marches on... ; ; Assumes signed 72 bit number is ALWAYS positive!! etodhp: ife. t1 ; Maybe bum the math ife. t2 ; Got called with a zero double word? setzb t3, t4 ; Yes, so zero the remainder ret ; Get out of here, we're done endif. endif. saveac ; Will need some temporary storage dmove q3, t1 ; Save the original dividend jfcl 17, .+1 ; Clear the flags dmul t1, tticdw ; Scale DK10 ticks up by TOD ticks jfcl 17, ovrflw ; Over 140 bits??? jumpn t1, ovrflw ; Over 105 bits?? jumpn t2, ovrflw ; Over 70 bits? ddiv t1, dkdayd ; Strip off remaining DK10 ticks jfcl 17, ovrflw ; Catch any odd math strangeness remark ; Remember, returning remainder; NOT ROUNDING dmove t3, t1 ; Load quotient dmul t3, dkdayd ; Scale TOD ticks by DK10 ticks jfcl 17, ovrflw ; Over 140 bits??? jumpn t3, ovrflw ; Over 105 bits?? jumpn t4, ovrflw ; Over 70 bits? ddiv t3, tticdw ; Strip off remaining TOD ticks jfcl 17, ovrflw ; Catch any odd math strangeness remark q1:q2 ; Should we round? For now, don't dcamg t3, q3 ; We didn't get anything backwards, did we? ifskp. ; That's odd; fix it exch q3, t3 ; Swap high order exch q4, t4 ; Swap low order endif. dsub q3, t3 ; Calculate remaining DK10 ticks ; remark ; This DSUB should not set flags, but does ; jfcl 17, ovrflw ; Catch any odd math strangeness ; dcamle q3,[exp 0,^d32958] ;Remainder should never exceed this ; jrst ovrflw ; But did dmove t3, q3 ; Return remaining DK10 ticks ret ; Done ;[221] End code insertion subttl Expresses a duration in DK10 units (tens of microseconds) ;[207] Begin code insertion ; t1/ Output pointer or JFN ; t2/ Pointer to time structure durtim: entry durtim ; Also called by k20dsp saveac ; Used to save a pointer move q1, t2 ; Save pointer to structure movei t2, .datus(q1) ; Resolve pointer to elapsed DK10 ticks setz t3, ;[221] Do not suppress leading seconds call ehptim ; Display elapsed HP ticks nop ;[221] Ignore +1, it isn't fatal dmove t3, .dateh(q1) ;[221] Load elapsed TOD ticks ife. t3 ;[221] No high order ife. t4 ;[221] and no low order? ret ;[221] None; suppress the whole thing endif. ;[221] endif. ;[221] ifn. t3 ; Any high order? tlo t4,(1b0) ; Yes, coerce to low order endif. ifn. t4 ; Got any TOD ticks? smsg < (TOD: > move t2, t4 ; Load elapsed TOD ticks movx t3, ;N.B., Unsigned!! NOUT% erjmps r smsg <)> ; Close off and return endif. ret ; Done, restore registers, destroy frame subttl Display elapsed HP ticks ; Call: ; ; t1/ Output pointer (or .PRIOU) ; t2/ Pointer to double word of duration in HPTIM% ticks ; [DK10 Internal 100 Khz resolution, tens of microseconds] ; t3/ Leading second suppression flag ; ; +1/ Something untoward happened ... ; +2/ Everything's Archie ; t1/ Updated, if string pointer ehptim: entry ehptim ; Also called by k20par remark t1 ; It is deadly to touch t1!! remark ; Assumes these may be smashed trvar <,hrs,mins,secs,mils,dk10,lsflag> ;[221] movem t3, lsflag ;[221] Save leading second flag dmove t3, (t2) ;[221] Load the duration (don't overwrite t2, yet) dmovem t3, dur ;[221] Save for internal debugging setzb t3, t4 ; Cons up some zeros dmovem t3, hrs ; Stomp hours and minutes dmovem t3, secs ; Stomp seconds and milliseconds setzm dk10 ; Stomp tens of microseconds dmove t2,dur ;[221] Load the duration double word ; Let's get down to some arithmatic ehpti1: block. ; Enter block context for easier control flow jfcl 17,.+1 ; Clear any flags, just in case divi t2, ^d100 ; Strip out DK10 ticks jov r ; Stop on overflow exch t3, dk10 ; Store DK10 ticks and rezero remainder jumpe t2, r ; If no more quotient, then done exch t2, t3 ; Zero in high order, quotient in low order divi t2, ^d1000 ; Strip out milliseconds jov r ; Stop on overflow exch t3, mils ; Store milliseconds and rezero quotient jumpe t2, r ; If no more quotient, then done exch t2, t3 ; Zero in high order, quotient in low order divi t2, ^d60 ; Strip out seconds jov r ; Stop on overflow exch t3, secs ; Store seconds and rezero quotient jumpe t2, r ; If no more quotient, then done exch t2, t3 ; Zero in high order, quotient in low order divi t2, ^d60 ; Strip out minutes movem t3, mins ; Store minutes movem t2, hrs ; Store hours endbk. ; Exit block context ehpti2: skipg t2, hrs ; Have any hours? ifskp. ; Yes, print as many as there are movx t3, fld(^d10,no%rdx) NOUT% erjmps r movei t2, ":" ; Puctuate hours call BOUTI% ;[216] seto t4, ; Mark hours were printed else. ; Otherwise, no hours setz t4, ; Mark no hours printed endif. ehpti3: ifn. t4 ; Previous? move t2, mins ; Yes, MUST print minutes movx t3, no%lfl!no%zro!no%ast!fld(^d2,no%col)!fld(^d10,no%rdx) ; In 2 columns else. ; Otherwise, nothing previous movx t3, fld(^d10,no%rdx) ; So no leading digits skipe t2, mins ; Have any minutes? seto t4, ; Yes, force a print endif. ifn. t4 ; Have to print minutes ifn. t2 ; Do we have a number? NOUT% ; We do, so print it erjmps r ; Catch and suppress error else. ; It's zero, so let's bum the NOUT% movei t2, "0" ; Load the zero call BOUTI% ; Type it txne t3,no%lfl ; Not fixed columns? call BOUTI% ; No, so type it twice to make "00" endif. ; End case NOUT% execution determination movei t2, ":" ; Punctuate minutes call BOUTI% ;[216] endif. ehpti4: ifn. t4 ; Columnar if did minutes movx t3, no%lfl!no%zro!no%ast!fld(^d2,no%col)!fld(^d10,no%rdx) else. ; No, so somewhat more free form movx t3, fld(^d10,no%rdx) endif. block. ;[221] Enter control block for better flow jumpn t4, RSKP ;[221] If printed minutes, MUST print seconds skipe secs ;[221] No seconds? retskp ;[221] No, if non-zero, must print them skipn lsflag ;[221] Got told to suppress the seconds retskp ;[221] No, so print them ret ;[221] Otherwise, don't endbk. ;[221] End control block context ifskp. ;[221] +1 means we must print seconds skipn t2, secs ; Load and always print seconds ifskp. ; Non-zero, so print it NOUT% erjmps r else. ; Otherwise, was zero movei t2, "0" ; So bum the NOUT% call BOUTI% ;[216] txne t3, no%lfl!no%zro!no%ast!fld(^d2,no%col) call BOUTI% ;[216] Have to print another zero if minutes endif. endif. ;[221] End case forced print of seconds ; N.B., Didn't know how or if to punctuate (tens of) microseconds, so ; broke them out seperately. It still looked funny, so I simply ; alide them until I find out what the right thing to do is. ehpti5: move t4, mils ; Load milliseconds or t4, dk10 ; Or in any dk10 total ifn. t4 ; If either is set, then display movei t2, "." ; Punctuate milliseconds call BOUTI% ;[216] skipn t2, mils ; Mils can go up to 999 ifskp. ; Have a real value, so print it movx t3, no%lfl!no%zro!no%ast!fld(^d3,no%col)!fld(^d10,no%rdx) NOUT% erjmps r ;;;; movei t2, "." ; Punctuate tens of microseconds ;;;; call BOUTI% ;[216] else. ; Otherwise, was zero ;;;; smsg <000.> ; So bum the NOUT% and the BOUT% smsg <000> ; So bum the NOUT% and the BOUT% endif. skipn t2, dk10 ; DK10 can go up to 99 ifskp. ; Have a real value, so print it movx t3, no%lfl!no%zro!no%ast!fld(^d2,no%col)!fld(^d10,no%rdx) NOUT% erjmps r ;;;; remark ; Don't fool ourselves into thinking we have true mHz ;;;; movei t2, "0" ; Show it as hundreds of microseconds ;;;; call BOUTI% ;[216] else. ; Otherwise, was zero ;;;; smsg <000> ; So bum the NOUT% and the BOUT% smsg <00> ; So bum the NOUT% and the BOUT% endif. endif. ret ; Don't forget to return!!! endtv. ; End lexical context transient variables ;[207] End code insertion subttl Initialize time variables ; Tops-20 takes the time of day and rounds it to the nearest TOD tick, ; which is .3295898438, which can easily cause messages to appear to ; have happened at the same time at high kilobaud and above speeds. ; ; Therefore, we never use GTAD% for timing because we can't tell where ; Tops-20 might have rounded. We use GTAD% precisely once to get the ; current date and time in internal format. We then use TIME% to get ; the elapsed milliseconds since system boot and subtract that from ; from the previous. ; ; Note that the math to do this is NOT rounded. The reason for this ; is to make sure that time doesn't go backwards for higher precision ; logging. ; ; N.B., HPTIM% can not be used because the current interface rounds it ; every 76 hours. chgsec(code,const) ; Monitor symbol names are constants mstime: sixbit "MSTIME" ; XKL's arcane 'magic' argument 0 ; Used to side-effect T2 retsec ; Return back to original .PSECT chgsec(code,data) ; Values go in writable storage prgsdt: block 1 ; Program start date and time (unsigned!) prgsdd: block 2 ; Same thing as a signed double word sysums: block 2 ; System uptime in milliseconds on startup bootdt: block 1 ; System boot as unsigned GTAD% word bootdd: block 2 ; Same thing as a signed double word bootrm: block 2 ; Remainder milliseconds in calculation mhptod::block 1 ;[239] ; Set if monitor has high precision time of day ehptod: block 1 ;[239] ; JSYS error when first tried ihptod: block 2 ;[239] ; High precision time of day when started retsec ; Return back to original .PSECT initim: entry initim ; Called once by START in K20MIT saveac ; Used as index and capability word GTAD% ; Get current date and time ifje. r ; Failed?? hrrzm t1, prgsdt ; Store error and flag it (not 1858!!) hrrz t1, bootdt ; Save single word format (not 1858!!) %ermsg (,) setob q1, q2 ; Flag date and time not set dmovem q1, bootdd ; Store boot date and time double word ret ; Can't go any further else. ; Otherwise worked, movem t1, prgsdt ; so just use it move t2, t1 ; Cast to signed long tlzn t2,(1b0) ; Test if Negative, fix low order and skip tdza t1, t1 ; Positive, zero high order and skip movei t1, ^d1 ; Negative, put sign bit in the high order dmovem t1, prgsdd ; Store for later inspection dmove q1, t1 ; Cache as we are soon to use it endif. dmove t1, mstime ; XKL's arcane 'magic' argument (if Toad) TIME% ; Get uptime in milliseconds (maybe long) ifje. r ; Failed?? hrro t2, t1 ; Turn negative to flag error seto t1, ; Ditto high order %ermsg (,) else. ; Otherwise, some kind of success caie t2, ^d1000 ; XKL monitor? ifskp. ; No, plain old 'vanilla' move t2, t1 ; Put low order in proper place tlzn t2,(1b0) ; Test if Negative, fix low order and skip tdza t1, t1 ; Positive, zero high order and skip movei t1, ^d1 ; Negative, put sign bit in the high order endif. ; And case casting vanilla Tops-20 to double word endif. ; End TIME% result handling dmovem t1, sysums ; Either way, store double word millisecond uptime block. ; Enter block for better control flow jumpl t1, R ; Only do this if jumpl t2, R ; current time is reasonable jumpl q1, R ; Only do this if jumpl q2, R ; uptime is reasonable call initod ; Convert uptime to elapsed TOD uptime dsub q1, t1 ; Subtract from current time of day jumpl q1, R ; Wrapped?? retskp ; Succeed with boot TOD in a signed double word endbk. ; Block exit ifskp. ; Worked move t1, q2 ; Load low order of result ifn. q1 ; Any high order? tlo t1,(1b0) ; Yes, coerce to low order endif. else. ; Something didn't work seto t1, ; And no valid time of day setob q1, q2 ; Ditto double word endif. dmovem q1, bootdd ; Store boot date and time double word movem t1, bootdt ; Save single word format dmovem t3, bootrm ; And remainder milliseconds remark ;[239] Finally see if we can do microsecond TOD movei t1,.hptod ;[239] Request high precision time of day HPTIM% ;[239] Issue the JSYS to see if it's there ifje. r ;[239] Didn't work ... movem t1, ehptod ;[239] Store the error code, but don't whine about it setzb t1, t2 ;[239] Cons up a set of double zeros movem t1, mhptod ;[239] Flag that it's not there dmovem t1, ihptod ;[239] No high precision time of day else. ;[239] Otherwise, monitor has the code and worked! dmovem t1, ihptod ;[239] Store initial high precision time of day movx t1, LSTRX1 ;[239] "Process has not encountered any errors" movem t1,ehptod ;[239] Phoney it up that this worked setom mhptod ;[239] Flag that functionality is there endif. ;[239] End case testing for JSYS support ret ; Finally done subttl Initialize Time of Day offset from current uptime ; Like miltod, but doesn't peel off a subsecond first, but rather ; Returns a remainder if not rounding ; ; Calling arguments are the same as are the return values initod: remark ; Almost impossible for this to happen, but... jumpl t1, ovrflw ; Sanity check calling arguments jumpl t2, ovrflw ife. t1 ; Maybe bum the math ife. t2 ; Got called with a zero double word? setzb t3, t4 ; Yes, so there can't be any remainder ret ; Yes, we're done endif. endif. saveac ; Intermediate double word results dmove q3, t1 ; Save calling milliseconds to extract remainder jfcl 17,.+1 ; Clear flags remark ; Calculate T = (M*262144)/86400000 dmul t1, tticdw ; Scale milliseconds up by time of day ticks jfcl 17, ovrflw ; Over 140 bits??? jumpn t1, ovrflw ; Over 105 bits?? jumpn t2, ovrflw ; Over 70 bits? ddiv t1, msidad ; Then strip off partial TOD jfcl 17, ovrflw ; Punt if any kind of funny business remark ; Don't round because extracting milliseconds remark ; Now convert TOD quotient back to ms dmove t3, t1 ; Load TOD quotient as input remark 17,ovlflw ; Flags are still clear remark ; Calculate M = (86400000*T)/262144. dmul t3, msidad ; Scale TOD ticks by milliseconds jfcl 17, ovrflw ; Over 140 bits??? jumpn t3, ovrflw ; Over 105 bits?? jumpn t4, ovrflw ; Over 70 bits? ddiv t3, tticdw ; Strip off partial milliseconds jfcl 17, ovrflw ; Punt if any kind of funny business dsub q3, t3 ; Calculate remaining milliseconds jumpl q3, ovrflw ; Sanity check arithmatic dmove t3, q3 ; Return millisecond remainder ret ; Finally done subttl Fine Grained Time of Day ; At megabaud (and even high kilobaud) speeds, messages can easily ; transfer in under the TOD resolution (a single TOD tick being ; 329.5898438 ms), so a simple subtraction of before and after GTAD%'s ; really won't work as it will seem as if no time elapsed. ; ; Kermit-20 therefore does not use GTAD% difference, but rather uptime ; (I.E., TIME% a.k.a milliseconds). Can't make DK10 ticks work for ; elapsed TOD on an unmodified Tops-20 (see above). ; ; Expects to smash t1 - t3, others preserved ; ; +1/ Unrecoverable error ; +2/ Worked fintim: entry fintim ; Used in K20PDC, but coded here saveac ;[239] Set up a pointer register ifmn. mhptod ;[239] Have we got high precision time of day? movx t1, .hptod ;[239] Yes, let's do DK10 units HPTIM% ;[239] Get the data annje. ;[239] If failed, then silently don't use it caile t1, ^d99999 ;[239] We didn't get gubbish, did we? annje. ;[239] A subsecond is never more than 99,999 DK10 ticks! dmove q2, t1 ;[239] Store TOD and DK10 subseconds movx q4, no%lfl!no%zro!no%ast!fld(^d5,no%col)!fld(^d10,no%rdx) ;[239] else. ;[239] Otherwise, don't have it, failed or gubbish call endtim ; Get current time of day into ending variables call elptim ; Calculated elapsed time in various formats movei q1, ewallt ; Pointer to elapsed time structure move q2, .dattd(q1) ;[239] Load ending signed time of day (unrounded) dmove t2, .dattr(q1) ;[239] Load remainder milliseconds, if any ife. t2 ;[239] Zero high order ... ife. t3 ;[239] ... and zero low order? setz q3, ;[239] None there, so note that else. ;[239] Otherwise, nothing to cast move q3, t3 ;[239] Can just use signed low order endif. ;[239] End case zero double word else. ;[239] Non-zero high order tlo t3, (1b0) ;[239] Cast low order to unsigned move q3, t3 ;[239] Store unsigned word endif. ;[239] End case remainder checking movx q4, no%lfl!no%zro!no%ast!fld(^d3,no%col)!fld(^d10,no%rdx) ;[239] endif. ;[239] End case ms or dk10 units? hrrz t1, p3 ; Load the logging file JFN move t2, q2 ;[239] Load some kind of time of day setz t3, ODTIM% ; Put into the log file erjmpr r ; Unless couldn't... movei t2, "." ; Otherwise, punctuate milliseconds call BOUTI% ;[216] dmove t2, q3 ;[239] Load the remainder milliseconds or DK10 units NOUT% ; Gives ".012" or ".012345" erjmps r retskp ; Done subttl Convert Milliseconds to Time of Day Ticks ; We have two fixed point fractions, one in TOD ticks in a day and the ; other in milliseconds in a day. The denominator for the former is ; 262,144 (2^18) whilst the denominator for the later is 86,400,000 ; (24*60*60*1000). ; ; If M is the number of milliseconds (input), and T is the number of ; TOD ticks (output), then the proportion is M:86400000 = T:262144. ; Solving for T yields M*262144 = T*86400000 (intermediate) or T = ; (M*262144)/86400000. ; ; To extract the remainder, we simply solve the same equation for a ; different variable, that is, the input is now TOD or T, thus we ; have T:262144 = M:86400000, or 262144*M = 86400000*T intermediate, ; or M = (86400000*T)/262144. We then subtract this new M from the ; input arguments to yield the integer remainder. ; ; Call: ; ;t1:t2/ Milliseconds as a signed double word ; ; Return: ; ;t1:t2/ Cooresponding quantity in Time of Day ticks ; as a signed double word. ;t3:t4/ Remainder milliseconds as a signed double. ; The double is used to speed downstream calculations ; by avoiding conversions. ; ; Caution! ; ; Be aware that a Time of Day tick equals 329.5898438 milliseconds. ; So, this conversion is going to cause a REDUCTION in precision ; between two and three decimal orders of magnitude (!!) ; ; Therefore, all intermediate results should be kept in milliseconds ; and not TOD ticks. ; ; We also do not round because the display is printing the milli- ; seconds and we don't want time to appear to be going backwards. ; The remainder milliseconds are returned for possible later use. chgsec(code,const) ;;Constants do not go in the code .PSECT msidad: ^d0 ; Milliseconds in a day, high order msiday ; Milliseconds in a day, low order ms1000: ^d0 ; High order milliseconds in a second ^d1000 ; Low order millisecond in a second lione: ^d0 ; Long integer one, high order ^d1 ; Long integer one, low order dkdayd: ^d0 ; DK10 ticks in a day, high order dkday ; DK10 ticks in a day, low order tticdw: ^d0 ; TOD ticks in a day as a double word, high order todtic ; TOD ticks in a day as a single word, low order tticd2: ^d0 ; Half previous, high order ; Half previous, low order clipmx: exp .infin,.infin ; Maximum if we go over 70 bits retsec ;;Restore .PSECT assumptions miltod: jumpl t1, ovrflw ; Sanity check calling arguments jumpl t2, ovrflw ife. t1 ; Maybe bum the math ife. t2 ; Got called with a zero double word? setzb t3, t4 ; Yes, so there can't be any remainder ret ; Yes, we're done endif. endif. saveac ; Intermediate double word results dmove q1, t1 ; Save calling milliseconds jfcl 17,.+1 ; Clear flags remark ; First strip off the milliseconds dmove t3, t1 ; Cast to a 140 bit intermediate quantity setzb t1, t2 ; Nothing in high 70 bits ddiv t1, ms1000 ; Strip off anything less than a second jfcl 17, ovrflw ; Shouldn't be strange ... dmove t1, q1 ; Restore original dividend dsub t1, t3 ; Subtract remainder to get to greatest second jfcl 17,.+1 ; Clear dsub's strange flags jumpl t1, ovrflw ; But double check for any funny business dmove q1, t3 ; Save remainder for return remark ; Calculate T = (M*262144)/86400000 dmul t1, tticdw ; Scale milliseconds up by time of day ticks jfcl 17, ovrflw ; Over 140 bits??? jumpn t1, ovrflw ; Over 105 bits?? jumpn t2, ovrflw ; Over 70 bits? ddiv t1, msidad ; Then strip off partial TOD jfcl 17, ovrflw ; Punt if any kind of funny business dcaml t3, tticd2 ; Should we round? dadd t1, lione ; Give us an extra tick remark t1, t2 ; Has TOD ticks dmove t3, q1 ; Return millisecond remainder ret ; Finally done ovrflw: emsg dmove t1, clipmx ; Clip down to 'reasonable' maximum ret ; Get out of here subttl Convert Time of Day Ticks to Seconds ; Do the math right. We have two fixed point fractions, one in TOD ; ticks in a day and the other in seconds in a day. The denominator ; for the former is 262,144 (2^18) whilst the denominator for the ; later is 86,400 (24*60*60). ; ; If T is the number of ticks (input) and S is the number seconds ; (output), then the proportion is T:262144 = S:86400. Solving for ; S yields S*262144=T*86400 intermediate or S=(T*86400)/262144. ; ; It will be noted that a second is a little more than three TOD ticks ; (3.034074074). So dividing by 3 will get an increasingly wrong ; answer, the longer a transfer goes. ; ; For example, consider 2,560 time of day ticks. Dividing by three ; yields a quotient of 853 seconds whereas the actual value is closer ; to 844 seconds, a difference of nine seconds. For a transfer taking ; over a day and a half, the difference is over 10,000 seconds ; ; Note intermediate double word result which is designed to handle ; dial up transfers that go on over a weekend (some did) ; ; Ticks are in t2, t1 is *** SACRED *** ; ; The below is about as fast as we can make this because the only ; math that is being done is the muli. The lsh with halfword moves ; and the or are faster than the ashc and whatever else we'd have ; to do. Div works too, but is blindingly slow. todsec: entry todsec ; Keep LINK informed of our location saveac ; Intermediate double word results muli t2,^d86400 ; Convert to base 86400 hrlz t4,t2 ; Pick up high order lsh t4,-1 ; Strip off the extra sign bit hlrz t2,t3 ; Pick up low order of quotient or t2,t4 ; Build final quotient tlz t3,-1 ; Clear out from the remainder caile t3,^d<86400/2> ; Greater than a half second? aoj t2, ; Round up a second, then ret ; All done! subttl Previous todsec attempts, both good and bad repeat 0,< ; First part works muli t2,^d86400 ; Convert to base 86400, double word result t2,t3 ashc t2,-^d18 ; Strip out TOD ticks caile t3,^d<86400/2> ; Greater than a half second? aoj t2, ; Yes, round up a tick, then ret > repeat 0,< ; This works, but is slow muli t2,^d86400 ; Convert to base 86400 div t2,[^d262144] ; Strip of TOD ticks caile t3,^d<86400/2> ; Greater than a half second? aoj t2, ; Round up a second, then ret ; All done! > repeat 0,< ; This won't work for double length results hrl t2,t2 ; 'Divide' by 2^18 hlr t2,t3 ; Pick up low order of quotient tlz t3,-1 ; Clear out from the remainder > repeat 0,< ; Won't handle over a day imuli t2,^d86400 ; Convert to base 86400 hrrz t3,t2 ; Pick up the remainder hlrz t2,t2 ; Properly position quotient caile t3,^d<86400/2> ; Greater than a half second? aoj t2, ; Round up a second, then ret ; All done! > subttl subtract two (unsigned) times of day ; Time of Day in TOD ticks is an ***UNSIGNED*** 36 bit number ; ; Therefore, a simple signed 35 bit subtract will eventually not ; work. Avoid the problem by using signed 70 bit math ; ; Returns result in t2, t1 is sacred elapst: entry elapst ; Keep LINK informed of our location saveac seto t2, ; Assume unlikely case of something wrong move t3, etdat ; Load ending TOD tlne t3, -1 ; Any kind camn t3, [-1] ; of phonkey? ret ; Bad, return talisman move p2, stdat ; Load starting TOD tlne p2, -1 ; Any kind camn p2, [-1] ; of phonkey? ret ; Bad, return talisman remark ; TOD is a 36 bit unsigned number!! setzb t2, p1 ; Zero high orders tlze t3, (1b0) ; Cast unsigned to signed long movei t2, ^d1 ; Propagate to high order tlze p2, (1b0) ; Cast unsigned to signed long movei p1, ^d1 ; Propagate to high order ; Make sure beginning is before last camn t2, p1 ; Compare high order ifskp. ; Not equal so just compare high order caml t2, p1 ; Is beginning before end? ifskp. ; Yep, swap them exch t2, p1 ; Swap high order exch t3, p2 ; Swap low order endif. else. ; Equal, so compare low order caml t3, p2 ; Is beginning before end? ifskp. ; Yep, swap them exch t2, p1 ; Swap high order exch t3, p2 ; Swap low order endif. endif. ; Finally ok to subtract dsub t2, p1 ; Do a signed subtract skipe t2 ; Signed result of 36 bits? tlo t3,(1b0) ; Cast to unsigned 36 bits move t2, t3 ; Load low order into return AC ret subttl Calculates character rate with double floating point arithmatic ; Call: ; ; t2/ Pointer to elapsed HPTIM% (DK10) ticks for transfer (double word) ; t3/ Total characters sent or received ; ; Characters are handled as if they were unsigned int's, but currently, ; they never will be. This is done for future expansion. ; ; Returns: ; ; +1 - Failed ; +2 - Success!! ; t4/ Double floating raw baud rate, high order mantissa ; t5/ Ditto, low order mantissa ; ; Maintains precision by keeping numerator and denominator in fixed ; point as long as possible with the assumption that a dmul is faster ; than a dfmp and a ddiv is WAY faster than a dfdv. ; ; Since t5 is a lexical alias for q1, assumes q1 has been saved ; by caller. DON'T BREAK THIS ASSUMPTION! ; ; The odd calling conventions are because this used to be passed an ; unsigned int which did not have enough precision for certain extreme ; cases. However, because of agressive register scheduling, only a ; single register was available, so this was changed to a pointer, ; to a long int, instead. chgsec(code,const) ;;Constants do not go in the code .PSECT dblscl: intern dblscl ; Also used in k20dsp 0 ; Scaling factor between DK10 ticks and seconds ^d100000 ; Low order of same (100000 ticks per second) retsec ;;Return to regular .PSECT assumptions chgsec(code,data) ;;Intermediate results, largely used for debugging tickpt: block 1 ; Pointer to HP tick double word (not always .datus!) dbltic: block 2 ; Double INTEGER value that tickpt points to dfltic: block 2 ; Double floating version of same dblchr: block 2 ; Double INTEGER value of unsigned characters (exact) dflchr: block 2 ; Double floating version of same retsec ;;Return to regular .PSECT assumptions dblcal: entry dblcal ; Used by k20dsp remark q1, t5 ; Recall this alias saveac ; Don't touch output pointer movem t2, tickptr ; Save pointer to calling double word DK10 count remark t3,chars ; Treated as unsigned 36; I.E., never negative setz t1, ; Form high order in t1 tlze t3, (1b0) ; Cast unsigned to signed long movei t1, ^d1 ; Propagate to high order move t2, t3 ; Position to have double word in t1::t2 dmovem t1, dblchr ; Store interim long (double) signed integer move t3, tickptr ; Load pointer to DK10 double word dmove t1, (t3) ; and then load said double word dmovem t1, dbltic ; Store long integer ticks call dfloat ; Convert to KL10 double floating point ret ; But failed for some reason dmovem t1, dfltic ; Store double floating ticks dmove t1, dblchr ; Load interim long integer characters setzb t3, t4 ; Clear low order dmul t1, dblscl ; Scale to DK10 resolution dmovem t3, dblchr ; Store final long integer characters dmove t1, t3 ; Load scaled double integer for double float call dfloat ; Convert to double floating form ret ; Failed dmovem t1, dflchr ; Store interim double floating characters dmove t4, t1 ; Position characters for return dfdv t4, dfltic ; Calculate character rate retskp ; Finally return successful result subttl Single word to double integer and double float ; Call: ; ; t2/ Unsigned 36 bit integer to be converted to long and double float ; ; Result: ; ; +1/ Failed ; +2/ ; t2/ double floating high order ; t3/ double floating low order ; t4/ long integer high order ; t5/ long integer low order singdf: entry singdf ; Called by display saveac ; Save because dfloat will trash it setz t1, ; Assume not more than 35 bits tlze t2, (1b0) ; Cast unsigned to signed long movei t1, ^d1 ; Propagate to high order dmove t4, t1 ; Now save the signed long call dfloat ; Float signed long ret ; Or not... move t3, t2 ; Reposition double floating low order move t2, t1 ; Reposition double floating high order retskp ; Succeed subttl Schedule, Class and Load storage declarations chgsec(code,data) ;;Declare non-global writable storage class: 0 ;[130] My scheduler class. skdflg: 0 ;[130] Nonzero if class scheduler on. skdblk: block .saclu+1 ; Argument block for SKED% jsys. skedx: 0 ;[194] SKED% error count lgetbe: lstrx1 ;[194] Last GETAB% error getabx: 0 ;[194] GETAB% error count lskede: lstrx1 ;[194] Last error from SKED% (none) ksajus: 0 ;[194] Kermit's (floating) job utilization retsec ;;Back into code subttl Get Scheduler Class information. gtclas: entry gtclas ; Identfy ourselves for LINK setzm class ; Assume we ain't got no class ... (boo) movei t1, .skrcv ; Read scheduler status dmove t2, [exp t3 , 2] ; Two words, starting at t3 movei t3, 2 ; Just want 2 words. SKED% ifje. r ; Catch and ignore error movem t1, lskede ; Save as last SKED% error aos skedx ; Count the error (should be only one) setzm skdflg ; Flag that the class scheduler is off ret ; Nothing else we can do endif. ; End JSYS error handling txne t4, sk%stp ; Class scheduler on? (bit means "stopped") setz t4, ; No, then whack all the bits we got back movem t4, skdflg ; And save some interesting bits jumpe t4, r ; If no scheduler, we're basically done here ;[130] Scheduler is on, get my scheduler class. GJINF% ; Get my job information move t4, t3 ; Put my job number in the right place anstkv (t2,<.saclu+1>) ; Allocate an anonymous stack variable remark ; Now fill out the argument block dmovem t3, .sacnt(t2) ; Pop them into the block setzb t3, t4 ; Cons up a pair of zeros dmovem t3, .sajcl(t2) ; Whack job class and job share dmovem t3, .sajus(t2) ; Whack job utilization and class share setzm .saclu(t2) ; Whack class utilization movx t1, .skrjp ; Function code for getting job's class info. SKED% ; Cross our fingers ifje. r ; Failed?? movem t1, lskede ; Save as last SKED% error aos skedx ; Count the error (should be only one) setob t1, .sajcl(t2) ; Set class to -1 as a talisman else. ; Otherwise, worked! move t1, .sajcl(t2) ; So get a legitimate class endif. ; End JSYS error 'recovery' movem t1, class ; Who says I ain't got no class? move t1, .sajus(t2) ; Load job utilization because it's cool movem t1, ksajus ; Save it in case somebody ever cares ret subttl LDAV -- Get the current load average. ;[130] This routine added as part of edit 130. ; ; Takes class scheduling into account. ; ; Call with ; ; t1/ 0 for 1 minute load average ; 1 for 5 minute load average ; 2 for 15 minute load average ; ; SKDFLG/ -1 if class scheduler running, ; 0 if no class scheduler or class scheduler stopped ; ; CLASS/ This job's scheduler class. ; ; Returns +1 always, with requested load average in t1. ldav: entry ldav ; Inform LINK of our location saveac ; Copy of deglitched calling argument cail t1, 0 ; Argument in range? caile t1, 2 setz t1, ; Gubbish, silently force to 0. move q1, t1 ; Save a copy of it skipe skdflg ; Class scheduler on? jrst cldav ; Yes, go get class load average ; No class scheduler or it's off, so use GETAB for system-wide load average gldav: hrlz t1, q1 ; Desired load average. add t1, [14,,.systa] ; Goes from offset 14 to 16 (see 2.3.2) GETAB ; use load avg from SYSTAT monitor table. ifje. r ;[194] Catch and ignore error movem t1, lgetbe ;[194] Save last error aos getabx ;[194] Bump GETAB error count movx t1, ; Return minimum load in case of any error. endif. ;[194] ret ; Otherwise, got some useful ; Class scheduler on, get load avg for this class from SKED%. cldav: skipge t4, class ; This job's scheduler class. jrst gldav ; We're in an odd way, fall back to GETAB anstkv (t2,<.sa15l+1>) ; Allocate an anonymous stack variable dmovem t3, .sacnt(t2) ; Store length and requested class setzb t3, t4 ; Cons up a pair of zeros dmovem t3, .sashr(t2) ; Whack returned share and use dmovem t3, .sa1ml(t2) ; Whack one and five minute load averages setzm .sa15l(t2) ; Whack 15 minute load average movei t1, .skrcs ; Function is read class parameters. SKED% ifje. r ; Catch and ignore error movem t1, lskede ; Save as last SKED% error aos skedx ; Count the error (should be only one) setzm skdflg ; Flag that the class scheduler went off jrst gldav ; Fall back to GETAB endif. ; End JSYS error handling movei t3,.sa1ml(t2) ; Resolve base of load average block add t3, q1 ; Add offset to get to the one we want move t1, (t3) ; Finally load whatever it is ret ; Done subttl Increase wait time, depending on system load (very clever) ;[128] Make this a separate routine. ; ; ADJTIM -- Adjust timeout interval based on load average (ldav). ; ; Timeout = mintim + (ldav-MINLOD)*((MAXTIM-mintim)/MAXLOD) ; ; 1) If the load is low, gives the minimum acceptable timeout, mintim. ; 2) If the load is very high, gives the maximum timeout, MAXTIM. ; ; In between, the timeout goes up linearly with given load average. ; ; MINLOD, MAXLOD, and MAXTIM are defined as global symbols. ; ; Call with: ; ; t1/ 1, 5, or 15 minute ldav, ; (floating point number as returned by ldav) ; t2/ minimum acceptable timeout (mintim), milliseconds (integer). ; ; Returns +1 always, with ; ; t2/ adjusted timeout interval, in milliseconds (integer). ; ; N.B., ; ; Will never return a number larger than MAXTIM. ; Zero means no time out and is always returned as zero adjtim: entry adjtim ; Inform LINK of our location ifle. t2 ;[212] Zero or goofy? setz t2, ;[212] Load zero (to never time out) ret ;[212] And return that endif. remark ;[212] Otherwise, have some math to do acvar ; Local storage for second argument. movem t2, mintim ; Save the minimum for later. remark (ldav-MINLOD) ;[212] Normalize load to trigger after minlod fsbrx t1, ;[194] Adjust load by subtracting the minimum. ifle. t1 ;[212] Zero or negative load? move t2, mintim ;[212] Then second term has no effect ret ;[212] So just return the number, unaltered else. ;[212] Otherwise, range check the result caxl t1, ;[194] If too big, clamp to maximum movx t1, ;[194] It was, so load the maximum endif. remark (MAXTIM-mintim) ;[212] Range check and correct timeout movx t2, maxtim ;[212] Maximum timeout, milliseconds. sub t2, mintim ; Less specified timeout interval. ifle. t2 ;[212] Efficiency hack, is this not positive? movx t2, maxtim ;[212] Clamp result to maximum ret ;[212] And done else. ;[212] Otherwise, fltr t2, t2 ;[212] float the result endif. ;[212] End term check fdvrx t2, ;[194] Divided by maximum load. fmpr t1, t2 ; Multiplied by actual (adjusted) load. fixr t2, t1 ; Fixed & rounded. add t2, mintim ; Add in requested minimum timeout. caile t2, maxtim ;[212] Larger than largest? movx t2, maxtim ;[212] Clamp to maximum ret ; Return with result in t2. endav. ;[194] End scope mintim acvar SUBTTL Tables to support integer to double floating conversion ;[206] Begin code insertion, selflessly donated from my very ; own Tops-20 Extended mode FTP Server. "Share and Enjoy" REMARK Table to see if we can do a simple shift ; When converting a single word integer to double floating point ; format, there is no case where we are ever going to have to round. ; However, in certain instances where the lower part of the word is ; clear, we can bum the combined (double accumulator) arithmetic shift ; and get by with a faster single accumulator logical shift. ; ; This is accomplished by checking to see if any bits would go from ; the lower high order word to the upper lower order word with these ; masks whose indices correspond to the amount of bits we'd need to ; shift over. chgsec(code,const) ;;Constants go into CONST area SLSHMK: 0 ; Always positive means we'll skip the first entry ^B11111111 ; 8 ; and will always be at least one ^B1111111 ; 7 ; Means we have to have entire field free ^B111111 ; 6 ^B11111 ; 5 ^B1111 ; 4 ^B111 ; 3 ^B11 ; 2 ^B1 ; 1 Z ; 0 ; Should never happen because should have ; been caught by the rounding logic REMARK Binary exponent increment ; The table cooresponds to the simple shift hack, above. In this ; case, we already have the correct magnitude and simply need to ; change it based on the amount of the shift. BXPINC: 0 ; Always positive means we'll skip the first entry FLD(^D8,EXPMSK) ; and will always be at least one bit because JFFO FLD(^D7,EXPMSK) ; is always going to count the sign. Thus, having FLD(^D6,EXPMSK) ; one bit set means we would have shifted out an FLD(^D5,EXPMSK) ; entire exponent field FLD(^D4,EXPMSK) FLD(^D3,EXPMSK) FLD(^D2,EXPMSK) FLD(^D1,EXPMSK) Z ; Should never happen because should have caught ; by the rounding decision logic REMARK Double word binary exponent ; In this case, the table contains all of the possible exponent values ; for corresponding shifts when normalizing an integer in the high ; order word. DWBEXP: 0 ; Ignore the sign bit FLD(^D<35+35+128>,EXPMSK) FLD(^D<34+35+128>,EXPMSK) FLD(^D<33+35+128>,EXPMSK) FLD(^D<32+35+128>,EXPMSK) FLD(^D<31+35+128>,EXPMSK) FLD(^D<30+35+128>,EXPMSK) FLD(^D<29+35+128>,EXPMSK) FLD(^D<28+35+128>,EXPMSK) Z ; Should be caught by non-shifting case!!! FLD(^D<26+35+128>,EXPMSK) FLD(^D<25+35+128>,EXPMSK) FLD(^D<24+35+128>,EXPMSK) FLD(^D<23+35+128>,EXPMSK) FLD(^D<22+35+128>,EXPMSK) FLD(^D<21+35+128>,EXPMSK) FLD(^D<20+35+128>,EXPMSK) FLD(^D<19+35+128>,EXPMSK) FLD(^D<18+35+128>,EXPMSK) FLD(^D<17+35+128>,EXPMSK) FLD(^D<16+35+128>,EXPMSK) FLD(^D<15+35+128>,EXPMSK) FLD(^D<14+35+128>,EXPMSK) FLD(^D<13+35+128>,EXPMSK) FLD(^D<12+35+128>,EXPMSK) FLD(^D<11+35+128>,EXPMSK) FLD(^D<10+35+128>,EXPMSK) FLD(^D<09+35+128>,EXPMSK) FLD(^D<08+35+128>,EXPMSK) FLD(^D<07+35+128>,EXPMSK) FLD(^D<06+35+128>,EXPMSK) FLD(^D<05+35+128>,EXPMSK) FLD(^D<04+35+128>,EXPMSK) FLD(^D<03+35+128>,EXPMSK) FLD(^D<02+35+128>,EXPMSK) FLD(^D<01+35+128>,EXPMSK) Z ; Indicates a zero upper word which should ; have already been accounted for REMARK Double word arithmetic shift normalization RADIX ^D10 ; N.B., negative shift is the only case where a round operation would be needed DWASHN: 0 ; Ignore the sign bit EXP -8,-7,-6,-5,-4,-3,-2,-1 ; Cases of opening up exponent field Z ; Should be caught by non-shifting case!! EXP 1, 2, 3, 4, 5, 6, 7, 8, 9 ; Cases of shifting significance towards EXP 10,11,12,13,14,15,16,17,18,19 ; the exponent field--never any rounding EXP 20,21,22,23,24,25,26 ; Should never exceed 26 shifts Z ; Indicates a zero upper word which ; should have already been accounted for RADIX ^D8 retsec ;;Restore psect assumptions SUBTTL Routine to implement double float ; The routine assumes that the exponent will always be positive (I.E., ; greater than 128 decimal, 200 octal). This is--by definition-- ; always true for integers: there will NEVER be fractions, much less ; values less than 1 other than zero (0) or a negative. ; ; It assumes that the number will be positive. If this is not the ; case, it takes the magitude of the integer and multiplies the ; eventual result by double floating negative 1. This will slow down ; the double floatation of negative numbers, but in this program we ; never produce those. ; ; It also doesn't do any rounding. However, rounding would only occur ; for values that are in excess of 4,611,686,018,427,387,903 ; (approximately 4.5 million trillion). Since the numbers in question ; are not going to be THAT large, this is not a problem in this ; program. ; ; We're just looking to keep the original number in the fraction (or ; mantissa) and hence need the additional word of dynamic range ; ; N.B., Toad doesn't have dfltr yet it has dgfltr... Why?? ; ; Call: ; ; T1/ High order double integer ; T2/ Low order double integer ; ; Return: ; ; +1 Something failed, T1 and T2 indeterminate ; +2 Success ; T1/ High order double floating point (most significant bits of mantissa) ; T2/ Low order double floating point number EXPMSK==MASKB(1,8) ; Exponent field mask DFLOAT: ENTRY DFLOAT ; Make available to the world IFE. T1 ; No high order. Might be zero ... IFE. T2 ; Any low order? RET ; No, got passed a zero, so nothing to do ENDIF. ; End case of zero low order ENDIF. ; End case of zero high order SAVEAC ; Real work! Will need some scratch storage IFGE. T1 ; Something positivishly flavored? DMOVE T3,T1 ; Yes, save a copy of the number SETZ Q2, ; flag positivity ELSE. ; Otherwise make positive and fix later REMARK DMOVN ; Don't use; floating only, will break on ints SETZB T3,T4 ; Make a big fat zero DSUB T3,T1 ; Make negative a positive in T3:T4 SETO Q2, ; Flag negativity ENDIF. ; End case of negative signed double IFE. T3 ; Not really a HUGE number after all? TXNE T4,EXPMSK ; Would we have to round???? IFSKP. ; No, maybe we can bum the FLTR ... TXNN T4,1B9 ; In the range of 67,108,864 to 134,217,727? IFSKP. ; Yes, already normalized! MOVX T1,FLD(^D<128+27>,EXPMSK) IOR T1,T4 ; Cons the exponent and mantissa ELSE. ; Otherwise, can use plain old reliable ... FLTR T1,T4 ; and float it (slowly) ENDIF. ; Either way, T1 is complete SETZ T2, ; There is no low order mantissa ELSE. ; Otherwise more than 27 bit mantissa MOVE T1,T4 ; Load the integer CALL EXPSFT ; Compute shift amount to clear field RET ; Oh dear, we're ill, beat it MOVX T1,FLD(^D<128+27>,EXPMSK) ADD T1,BXPINC(T2) ; Load maximum unrounded and calculate shift TDNE T4,SLSHMK(T2) ; Is there enough space for a single shift IFSKP. ; Yes, use logical since FASTER than a combined LSH T4,(Q1) ; Finally get the bits out of the way IOR T1,T4 ; Cons the exponent and mantissa SETZ T2, ; And nothing in the low order ELSE. ; Otherwise part of mantissa will be in low word EXCH T3,T4 ; Bum a word's worth of shifting ASHC T3,(Q1) ; Split the fraction across two words IOR T1,T3 ; Cons the exponent and high mantissa MOVE T2,T4 ; And return the low mantissa ENDIF. ; End case of combined shift decision ENDIF. ; End case of 27 bit (non-rounded) mantissa JRST DFLRET ; And return the value ENDIF. ; End case of no high order mantissa ; Some kind of large number ... IFE. T4 ; Maybe no low order mantissa? TXNE T3,EXPMSK ; Would we round the high order? IFSKP. ; No, maybe we can bum the FLTR ... TXNN T3,1B9 ; If between 2,305,843,009,213,693,952 and IFSKP. ; 4,611,685,984,067,649,536, already normalized! MOVX T1,FLD(^D<128+27+35>,EXPMSK) IOR T1,T3 ; Cons the exponent and mantissa ELSE. ; Otherwise, can use plain old reliable ... FLTR T1,T3 ; and float it (slowly) ADDX T1,FLD(^D35,EXPMSK) ; However, it is a lot larger ENDIF. ; Either way, T1 is complete SETZ T2, ; There is no low order mantissa ELSE. ; Must get some bits out of the exponent field MOVE T1,T3 ; Load the (large) integer CALL EXPSFT ; Compute shift amount to clear field RET ; Oh dear, we're ill, beat it MOVX T1,FLD(^D<128+27+35>,EXPMSK) ADD T1,BXPINC(T2) ; Load maximum unrounded and calculate shift TDNE T3,SLSHMK(T2) ; Is there enough space for a single shift IFSKP. ; Yes, use logical since FASTER than a combined LSH T3,(Q1) ; Finally get the bits out of the way IOR T1,T3 ; Cons the exponent and mantissa SETZ T2, ; And nothing in the low order ELSE. ; Otherwise part of mantissa will be in low word ASHC T3,(Q1) ; Split the fraction across two words IOR T1,T3 ; Cons the exponent and high mantissa MOVE T2,T4 ; And return the low mantissa ENDIF. ; End case of combined shift decision ENDIF. ; End case of 27 or less bit high order mantissa JRST DFLRET ; and return the value ENDIF. ; End case of no low order mantissa ; Here if more than 35 significant bits TXNE T3,EXPMSK ; If we are between 2,305,843,009,213,693,952 IFSKP. ; and 4,611,686,018,427,387,903 then the double TXNN T3,1B9 ; float will be trivial as the mantissa is already ANSKP. ; in the right place, 'normalized' so to speak MOVX T1,FLD(^D<128+27+35>,EXPMSK) IOR T1,T3 ; Cons the exponent and mantissa MOVE T2,T4 ; lower order fraction will not move, either JRST DFLRET ; and return the value ENDIF. ; End case of exactly perfect double mantissa ; Finally have to do some honest work ... SKIPE T1,T3 ; Load (and check) the high order of the mantissa JFFO T1,.+2 ; Find the first significant bit RET ; Broken JFFO, we just checked T3! SKIPG T1,DWBEXP(T2) ; Load the appropriate double word binary exponent RET ; Probably an errorneous table ... SKIPN Q1,DWASHN(T2) ; Load and check the normalization shift RET ; Probably an errorneous table ... ASHC T3,(Q1) ; Otherwise normalize the double integer IOR T1,T3 ; Cons up the exponent and high order mantissa MOVE T2,T4 ; Return the properly normalized low order REMARK DFLRET ; And hit the exit code SUBTTL Double floating integer conversion support REMARK Common exit, converts number to negative, if necessary DFLRET: CAIGE Q2,0 ; If the original was positive, then we're through DFMP T1,DFLM1 ; No, (re)negativize our result (slowly) RETSKP ; Done DFLM1: EXP <576400,,0>,0 ; -1 DFMP multiplicand is what DFIN% gave us REMARK Here to compute number of bits to shift out of exponent field ; Call: ; ; T1/ Has a number with bits in the exponent field ; ; Return: ; ; +1 Something failed, T2 and Q1 indeterminate ; +2 Success ; T2/ JFFO results (first set bit) ; Q1/ Number of bits to shift to clear the field EXPSFT: CAIG T1,0 ; Zero or negative? RET ; Gronk, got called with junk TXNN T1,EXPMSK ; But is there anything to be shifted out? RET ; No, we should never have been invoked JFFO T1,.+2 ; Now find out how many leading bits RET ; Broken JFFO ... CAXL T2,1+WID(EXPMSK) ; More bits than the exponent field? RET ; Already clear and we shouldn't be here CAIG T2,0 ; However, there better be at least the sign bit! RET ; Broken JFFO (negative number check) MOVX Q1,-<1+WID(EXPMSK)> ;Load maximum possible shift ADD Q1,T2 ; And calculate the shift RETSKP ; Done! ;[206] End code insertion. Or transfer. Or graft. Or something... subttl Calculates rate assuming input mantissas of less tnen 2^27 repeat 0,< ; Vestigial, unused ; Call: ; ; t2/ Elapsed TOD ticks for transfer ; t3/ Total characters sent or received ; ; Returns: ; ; t4/ Double floating raw baud rate, high order mantissa ; t5/ Ditto, low order mantissa ; ; N.B., assumes input arguments (t3 and elapsed TOD ticks) ; do not have more than a 27 bit mantissa. ; ; Note refactoring of mathmatical operations to maintain better ; precision, Also bums a double floating divide (see below), the ; slowest instruction going. Thanks to Professor Anne for the ; multiplicative identities. calr27: fltr t4,t3 ; Float the count setz t5, ; Whack low order dfmp t4,[exp 2621440.,0] ;Intermediate bit ticks fltr t2,t2 ; Float those, too setz t3, ; Double float, almost (see peffif, sigh) dfmp t2,[exp 86400.,0] ; Intermediate seconds dfdv t4,t2 ; Calculates bits per second ret ; Returns rate in t4,t5 >;;End repeat 0 subttl Calculates rate assuming input mantissas of less then 2^27 repeat 0,< ; See numerical analysis, above ; Call: ; ; t2/ Elapsed TOD ticks for transfer ; t3/ Total characters sent or received ; ; Returns: ; ; t4/ Double floating raw baud rate, high order mantissa ; t5/ Ditto, low order mantissa ; ; N.B., Assumes input arguments (t3 and elapsed TOD ticks) ; do not have more than a 27 bit mantissa. calr27: fltr t4,t3 ; Float the count setz t5, ; Whack low order fltr t2,t2 ; Float elapsed ticks setz t3, ; Double float, almost (see peffif, sigh) dfmp t2,[exp 86400.,0] ; Convert to characters per second dfdv t2,[exp 262144.,0] ; Strip off TOD ticks dfdv t4,t2 ; Calculates characters per second dfmp t4,[exp 10.,0] ; Convert cps to bps ret ; Returns rate in t4,t5 >;;End repeat 0 .xcmsy ; Ditch any MACSYM junk end ; Local Modes: ; Mode:MACRO ; Comment Column:32 ; Comment Start:;[239] ; Comment Begin:;[239] ; Auto Fill Mode: 0 ; End: