K20UNV - Kermit-20 Universal Symbols and Macros MACRO %53B(1254)-4 19:41 30-Mar-24 Page 1 K20UNV MAC 14-Dec-23 11:59 Kermit program definitions 1 Universal K20UNV - Kermit-20 Universal Symbols and Macros 2 3 search monsym ; Wants things for NTINF% 4 search macsym ; Needs FLD, MASK, Etc. 5 search cmd ; Also cmd 6 remark Can't do the .nobin; confuses COMPIL (I.E., the EXEC) 7 ; .directive .nobin ; Doesn't need a .REL file 8 9 ; Moved symbols and macros here from main module as part of 194 10 11 subttl Kermit program definitions 12 13 000310 pdlsiz==^d200 ; Stack size, be generous. 14 000024 takel==^d20 ;[78] TAKE command JFN stack size. 15 16 ; N.B., Be careful about the aliases done here and Kermit's regular 17 ; register usage. Also, be VERY aware that p5 aliases ac15, 18 ; which macsym uses as the frame pointer for Bliss subroutine calls 19 ; asubr's and transient variables. Stack vars and block. context 20 ; are uneffected 21 22 define cmdacs < ;;Have to clean up cmd accumulator polution 23 if1 < ifdef p1, ;;CMD should be compiled seperately 24 ifdef p2, 25 ifdef p3, 26 ifdef p4, 27 ifdef p5, 28 >;;if1 29 p1==q5 ;;p1 aliases q5 and state 30 p2==p1+1 ;;p2 alias rchr 31 p3==p2+1 ;;p3 alias schr 32 p4==p3+1 ;;p4 alias debug 33 p5==p4+1 ;;p5 alias FP!!! 34 ifndef cx, ;;Occasional control linkage 35 >;;cmdacs 36 37 ; Don't let values confuse DDT (or me) 38 000000 f==0 ; AC definitions: flag AC (not used), 39 000004 t4==+1>+1>+1 ; temporary AC's, (Contiguous) 40 000010 q4==+1>+1>+1 ; and preserved AC's. (Contiguous) 41 000005 t5==q1 ;[186] Alias a temporary for double arithmatic 42 43 000011 state==q4+1 ; State of the automaton. 44 000011 q5==state ;[211] Can also CAREFULLY use 45 ;[211] q5 aliases state AND p1 46 cmdacs ^ ;;Clean up for our definitions 47 000012 rchr==state+1 ; Total file characters received. 48 000013 schr==rchr+1 ; Total file characters sent. 49 000014 debug==schr+1 ;[22] Debugging (0=none, 1=states, 2=packets) 50 51 000001 SOH==^o001 ; ASCII Start of header character. 52 000021 XON==^o021 ; XON is defined to be Control-Q (ASCII DC1). 53 024000 MAXBUF==^d10240 ; Packet buffer size [179] 54 000136 MAXPKT==^d94 ; Packet buffer size [179] 55 022000 IOBUF==^d9216 ; Communications i/o buffer [180] [216] (9K) K20UNV - Kermit-20 Universal Symbols and Macros MACRO %53B(1254)-4 19:41 30-Mar-24 Page 1-1 K20UNV MAC 14-Dec-23 11:59 Kermit program definitions 56 ;[216] Enough for 9,000 character packet 57 000140 maxpkt=="~"-" "+2 ; Maximum size of a packet. 58 000005 dmxtry==5 ; Default number of retries on a packet. 59 000020 dimxtr==20 ; Default number of retries send initiate. 60 000120 drpsiz==^d80 ; Default receive packet size. 61 000120 dspsiz==^d80 ; Default send packet size. 62 000012 spmin==^d10 ;[47] Minimum size packet we want to send. 63 021450 spmax==^d9000 ;[47] Maximum ... 64 017500 dstim==^d<8*1000> ;[212] ms ; Default send time out interval. 65 204400 000000 dstimf==8.0 ;[212] fl ; Same value as floating seconds 66 031310 drtim==^d<13*1000> ;[212] ms ;[128] Default receive time out interval. 67 204640 000000 drtimf==13.0 ;[212] fl ; Same value as floating seconds 68 072460 dsrvtm==^d<30*1000> ;[212] ms ;[20] Def timout when awaiting server commands. 69 205740 000000 dsrvtf==30.0 ;[212] fl ; Same value as floating seconds 70 000000 drpaus==0 ;[212] ms ;[36] Default pause before ACKing packets. 71 000000 drpauf==0.0 ;[212] fl ;[35] Default pause before ACKing packets. 72 000000 dspaus==0 ;[212] ms ;[36] Default pause before sending packets. 73 000000 dspauf==0.0 ;[212] fl ;[36] Default pause before sending packets. 74 000000 dspad==^o0 ; Default send padding char. 75 000000 drpad==^d0 ; Default receive padding char. 76 000000 drpadn==^d0 ; Default number of receive padding chars. 77 000000 dspadn==^d0 ; Default number of send padding chars. 78 002000 dpadmx==^d1024 ;[223] Maximum number of padding chars we'll do 79 000015 dseol==.chcrt ; Default send EOL char. 80 000015 dreol==.chcrt ; Default receive EOL char. 81 000043 dsquot=="#" ; Default outbound control prefix. 82 000043 drquot=="#" ; Default incoming control prefix. 83 000046 dqbin=="&" ; Default 8th-bit prefix. 84 000176 drept=="~" ; Default repeat count prefix. 85 011610 ddelay==^d5000 ;[212] ms ; Default delay before the first packet, msecs. 86 203500 000000 ddelaf==5.0 ;[212] fl ;[194] Same as floating seconds (must give character) 87 000000 dxfull==0 ;[18] Full duplex. 88 000001 dxhalf==1 ;[18] Half duplex. 89 000034 defesc==34 ; Default CONNECT escape character is ^\. 90 777777 777777 defits==-1 ;[75] Handle ITS binary files by default. 91 000000 defics==0 ;[160] Default case search for INPUT commands. 92 000000 defita==0 ;[160] Default timeout action for INPUTs. 93 011610 defito==^d<5*1000> ;[212] ms ;[160] Default timeout interval for INPUTs. 94 203500 000000 defitf==5.0 ;[212] fl ;[194] Same value as floating point (as character) 95 267460 maxtim=^d<94*1000> ;[212] ms ;[2] Maximum timeout interval to set, secs. 96 203400 000000 minlod=4.0 ;[2] Minimum ldav to consider for timeout. 97 206620 000000 maxlod=50.0 ;[2] Maximum ldav to consider for timeout. 98 000005 blip=^d5 ;[4] Every this many packets, print a blip. 99 K20UNV - Kermit-20 Universal Symbols and Macros MACRO %53B(1254)-4 19:41 30-Mar-24 Page 2 K20UNV MAC 14-Dec-23 11:59 Definitions for Macro table remediation 100 subttl Definitions for Macro table remediation 101 102 ; All part of 203. There are the beginnings of a macro editor, but 103 ; for this release, development was stopped after the storage issues 104 ; were fixed. 105 ; 106 ; The design of the macro editor is largely complete, but the 107 ; implementation of SET commands that have third (and fourth) level 108 ; selections is not. Briefly, everything parses, but to split things 109 ; up, you have to handle the guide words, which may not be 110 ; straightforward. 111 ; 112 ; The code is currently off. Define the symbol EDTMAC to cause it to 113 ; be part of the executable. And understand that you will have some 114 ; coding to do. 115 ; 116 ; EDTMAC==:1 ; Assemble (incomplete) macro editor 117 118 define emacro (stuff) < ;;If have macro editor code 119 ifdef EDTMAC, < 120 'stuff 121 >> 122 123 define nmacro (stuff) < ;;If DON'T have macro editor code 124 ifndef EDTMAC, < 125 'stuff 126 >> 127 K20UNV - Kermit-20 Universal Symbols and Macros MACRO %53B(1254)-4 19:41 30-Mar-24 Page 3 K20UNV MAC 14-Dec-23 11:59 FATAL Assembly errors 128 subttl FATAL Assembly errors 129 130 ; Fatal assembly error macro. It would have been nice if MACRO had 131 ; something like an .ERROR statement. Like ...MASM... 132 133 define .fatal (message) < 134 pass2 135 printx ?'message 136 end 137 >;;define .fatal 138 K20UNV - Kermit-20 Universal Symbols and Macros MACRO %53B(1254)-4 19:41 30-Mar-24 Page 4 K20UNV MAC 14-Dec-23 11:59 Handy macros for address conversion 139 SUBTTL Handy macros for address conversion 140 141 ; Lifted from Extended Mode FTP Server rewrite 142 143 144 REMARK Convert between 30 bit addresses and 21 bit page numbers 145 146 000011 pgshft==:^D9 ; Shift for page/address conversion 147 148 define pg2adr (r,a) < ;; 21 bit page number 149 ifb ,<.fatal No register specified> 150 ifnb ,<.fatal 'a can only cast values in registers> 151 ifg r-^o16,<.fatal register 'r is out of bounds> 152 lsh r,pgshft ;; Convert page to address 153 > 154 155 define adr2pg (r,a) < ;; 30 bit address 156 ifb ,<.fatal No register specified> 157 ifnb ,<.fatal 'addr can only convert values in registers> 158 ifg r-^o16,<.fatal Register 'r is out of bounds> 159 lsh r,-pgshft ;; Convert address to page 160 > 161 162 REMARK Convert between 21 bit page numbers and 12 bit section numbers 163 164 000011 secsft==:^D9 ; Shift for section/page conversion 165 166 define sec2pg (r,a) < ;; 12 bit section number 167 ifb ,<.fatal No register specified> 168 ifnb ,<.fatal 'a Can only cast values in registers> 169 ifg r-^o16,<.fatal Register 'r is out of bounds> 170 lsh r,secsft ;; Convert section to page 171 > 172 173 define pg2sec (r,a) < ;; 21 bit page number 174 ifb ,<.fatal No register specified> 175 ifnb ,<.fatal 'a Can only convert values in registers> 176 ifg r-^o16,<.fatal Register 'r is out of bounds> 177 lsh r,-secsft ;; Convert page to section 178 > 179 180 REMARK Convert between 30 bit addresses and 12 bit section numbers 181 182 define sc2adr (r,a) < ;; 12 bit sction number 183 ifb ,<.fatal No register specified> 184 ifnb ,<.fatal 'a Can only cast values in registers> 185 ifg r-^o16,<.fatal Register 'r is out of bounds> 186 hrlz r,r ;; Convert section number to address 187 > 188 189 define adr2sc (r,a) < ;; 30 bit address 190 ifb ,<.fatal No register specified> 191 ifnb ,<.fatal 'a Can only convert values in registers> 192 ifg r-^o16,<.fatal Register 'r is out of bounds> 193 hlrz r,r ;; Convert address to section number K20UNV - Kermit-20 Universal Symbols and Macros MACRO %53B(1254)-4 19:41 30-Mar-24 Page 4-1 K20UNV MAC 14-Dec-23 11:59 Handy macros for address conversion 194 > K20UNV - Kermit-20 Universal Symbols and Macros MACRO %53B(1254)-4 19:41 30-Mar-24 Page 5 K20UNV MAC 14-Dec-23 11:59 Clean symbol artifacts up 195 subttl Clean symbol artifacts up 196 197 define cleans(s) < ;;Clean up symbols we won't need 198 irp s,< ;;Do all this for each and every symbol 199 ifdef s,< ;;Nothing to clean up if not defined 200 .xcref s ;;Don't want symbol in cross reference 201 .ifn s,macro,< ;;If not a macro, do some other clean up 202 .noddt s ;;Don't need symbol in DDT 203 suppress s ;;Don't want symbol in symbol table listing 204 >;;.ifn 205 if2 < purge s > ;;After second pass, don't need symbol 206 >;;ifdef 207 >;;irp 208 >;;cleans 209 K20UNV - Kermit-20 Universal Symbols and Macros MACRO %53B(1254)-4 19:41 30-Mar-24 Page 6 K20UNV MAC 14-Dec-23 11:59 .PSECT switching 210 subttl .PSECT switching 211 212 ; Cuts down on typing because we aggressively use .PSECT's 213 ; 214 ; N.B., Does not nest like ifskp./else./endif. do. 215 216 define chgsec(f,t) < ;;From and To .PSECT's 217 .endps 'f ;;Get out of the From .PSECT 218 .psect 't ;;Get into To .PSECT 219 define retsec < ;;Define remote macro to put things back 220 .endps 't ;;Done with To .PSECT 221 .psect 'f ;;Get back into From .PSECT 222 >;;retsec 223 >;;chgsec 224 225 K20UNV - Kermit-20 Universal Symbols and Macros MACRO %53B(1254)-4 19:41 30-Mar-24 Page 7 K20UNV MAC 14-Dec-23 11:59 Parity Types (actually table offsets) 226 subttl Parity Types (actually table offsets) 227 228 000000 .parno==0 ; None 229 000001 .parsp==1 ; Space, bit 8 is zero, always 230 000002 .parmk==2 ; Mark, bit 8 is one, always 231 000003 .parev==3 ; Even parity 232 000004 .parod==4 ; Odd parity 233 K20UNV - Kermit-20 Universal Symbols and Macros MACRO %53B(1254)-4 19:41 30-Mar-24 Page 8 K20UNV MAC 14-Dec-23 11:59 Various MACRO sizings 234 subttl Various MACRO sizings 235 236 ; The total macro table size is driven off the number of macros we can 237 ; handle in the TBLUK% table and its associated string storage. We 238 ; make some assumptions here that may or may not actually be true. 239 ; These are, 240 ; 241 ; 1) A macro name (which is really 'only' a TBLUK% keyword) is 242 ; rarely going over 10 characters (or two PDP-10 words) *AND* 243 ; 244 ; 2) Its expansion is rarely over 90 characters (or 18 words). 245 ; 246 ; If the numbers turn out to be wrong, they are easily changed. 247 ; The MACROS .PSECT is then sized from the lengths calculated here. 248 ; 249 ; However, the number of macros was simply picked by what would fit 250 ; in seven pages of memory. 251 252 000252 macmax==^d170 ;[203] ;[77] Maximum number of macros. 253 000524 mnblen==^d2*macmax ;[203] ;[77] Macro name buffer length in words (10 chars) 254 005764 mtblen==^d18*macmax ;[203] ;[77] Macro text buffer length in words (90 chars) 255 256 000000 macslp==0 ;[203] ; Initially no slop 257 258 define adslop (n) < ;;[203] ; Add n to slop 259 macslp==macslp+n ;;[203] ; Accumulate the extra words of slop 260 .xcref macslp ;;[203] ; Still don't need this 261 >;;adslop 262 263 adslop(1)^ ;;[203] ; mactab TBLUK% header word 264 adslop(1)^ ;;[203] ; mactbx end of mactab 265 adslop(1)^ ;;[203] ; macbp 266 adslop(1)^ ;;[203] ; ibmkey 267 adslop(11)^ ;;[203] ; ibmmac (macro body) [octal] 268 adslop(1)^ ;;[203] ; macx 269 270 007000 mactmp==macslp+macmax+mnblen+mtblen ;[203] Minimum length in words 271 000007 macpgs== ;[203] Minimum number of pages 272 ifn , ;[203] Round up if not on a page boundar 273 000007 gcpgs==macpgs ;[203] Garbage collection is same size 274 emacro < edpgs==macpgs > ^;[203] As is the macro editing area 275 007000 maclen==macpgs*1000 ;[203] Now have length in words 276 277 cleans()^ ;[203] Don't need temporary after second pass 278 279 000003 defbrk==3 ; Default number of breaks. 280 000100 maxnul==100 ; Maximum number of nulls. 281 282 000050 maxnam==^d40 ; Maximum characters in a system name 283 000011 syslen==<+1> ; Number of words in name block 284 285 000031 MXPKTW==<+1> ; Maximum packet size in words 286 001000 strblw==1000 ;[209] String buffer length in words 287 005000 strblc==1000*5 ;[209] Same value in characters 288 K20UNV - Kermit-20 Universal Symbols and Macros MACRO %53B(1254)-4 19:41 30-Mar-24 Page 8-1 K20UNV MAC 14-Dec-23 11:59 Various MACRO sizings 289 ifl ,<.fatal Maximum password will exceed packet length> 290 K20UNV - Kermit-20 Universal Symbols and Macros MACRO %53B(1254)-4 19:41 30-Mar-24 Page 9 K20UNV MAC 14-Dec-23 11:59 Various MACRO sizings 291 remark Various maximums for files and directories 292 293 ; Assume following would only include the ;t attribute 294 ; device:name.type.generation;attributes 295 296 000210 mxfilc==^d<6+1+1+39+1+39+1+39+1+6+1+1> ; Maximum Tops-20 file path in characters 297 000034 mxfilw==+1 ; Same thing in words 298 299 000061 dirmxc==^d<6+1+1+39+1+1> ; Maximum Tops-20 directory characters (+ .chnul) 300 000012 dirmxw==<+1> ; Same constant in words 301 302 000047 mxpwlc==^d39 ; Maximum size password Tops-20 will allow 303 000010 mxpwlw==^d<+1> ; Maximum storage required 304 305 ; These MUST match CMDSTG, which does not declare the symbols 306 ; so that MACRO can use them to allocate static storage, sigh... 307 308 000740 fdrmxc==<^d80*6> ; Foreign Directory Maximum size in characters 309 000141 fdrmxw==+1 ; Same size in words, plus slop 310 311 000740 fpwmxc==fdrmxc ; Foreign maximum password size in characters 312 000141 fpwmxw==fdrmxw ; Size size in words, plus slop 313 314 ; Some characters that would be nice in MACSYM ... 315 316 000074 .chlpt==74 ; Left pointy bracket 317 000076 .chrpt==76 ; Right pointy bracket 318 000042 .chdbq==42 ; Double quote 319 000050 .chlpa==50 ; Left parenthesis 320 000051 .chrpa==51 ; Right parenthesis 321 K20UNV - Kermit-20 Universal Symbols and Macros MACRO %53B(1254)-4 19:41 30-Mar-24 Page 10 K20UNV MAC 14-Dec-23 11:59 Tops-20 Monitor Definitions and extensions 322 subttl Tops-20 Monitor Definitions and extensions 323 324 ;[129] ARPA definitions (may not be in MONSYM) 325 326 ifndef STAT%, ; So this will assemble 327 ifndef TCP%NT, ; without symbols from BBN TCP monitor. 328 329 ;TELNET negotiation options if not running a PANDA monitor 330 331 000377 iac==377 ; arpanet telnet IAC 332 000373 will==373 ; telnet will ,hsfdb2 9181 000337'02 000000000000# 9182 000340'02 44 07 0 00 002170' 9183 000341'02 44 07 0 00 002173' 9184 000342'02 000006 000000 hsfdb2: flddb. .cmkey,,sethlp,, 9185 000343'02 000000000000# 9186 000344'02 44 07 0 00 002175' 9187 000345'02 44 07 0 00 002173' 9188 9189 cleans() 9190 9191 ;[214] Begin table and linkage definitions 9192 9193 ; Commands which require additional sub-commands or more granular help 9194 ; can be dealt with by: 9195 ; 9196 ; 1) Creating an additional entry in the sub-help (subhlp) table 9197 ; with the hclip macro. 9198 ; 2) Creating function descriptor block with pointers to the 9199 ; default help and to individual help text keyword (or switch) 9200 ; tables. 9201 ; 3) The parse tables for individual help are then created in 9202 ; k20hlp. 9203 ; 4) Wonderfully informative help text is written. 9204 ; [That's the goal, anyway] 9205 ; 9206 ; The block. statement with the nested do. functions conceptually as a 9207 ; kind of a cross between a switch statement and a skip chain yet 9208 ; effectively executes as a skip chain. The efficiency of this linear 9209 ; approach may need to be revisited if we create a lot of multi-level 9210 ; help (Tops-10 Kermit does this) 9211 9212 000346'02 010004 000351' $hdefi: flddb. .cmcfm,,,,,$hdef1 9213 000347'02 000000 000000 9214 000350'02 44 07 0 00 002200' 9215 000351'02 003004 000000 $hdef1: flddb. .cmswi,,defhlp##,,, 9216 000352'02 000000000000# 9217 000353'02 44 07 0 00 002206' 9218 9219 000354'02 010004 000357' $hclea: flddb. .cmcfm,,,,,$hcle1 9220 000355'02 000000 000000 9221 000356'02 44 07 0 00 002212' 9222 000357'02 003004 000000 $hcle1: flddb. .cmswi,,clrhlp##,,, 9223 000360'02 000000000000# 9224 000361'02 44 07 0 00 002220' 9225 9226 000362'02 010004 000365' $hloca: flddb. .cmcfm,,,,,$hloc1 9227 000363'02 000000 000000 9228 000364'02 44 07 0 00 002224' 9229 000365'02 000004 000000 $hloc1: flddb. .cmkey,,lclhlp##,,, k20par - Kermit-20 Parsing and Semantic Action Routines MACRO %53B(1254)-4 19:41 30-Mar-24 Page 27-1 K20PAR MAC 29-Mar-24 20:39 HELP command parsing 9230 000366'02 000000000000# 9231 000367'02 44 07 0 00 002232' 9232 9233 000370'02 010004 000373' $hremo: flddb. .cmcfm,,,,,$hrem1 9234 000371'02 000000 000000 9235 000372'02 44 07 0 00 002236' 9236 000373'02 000004 000000 $hrem1: flddb. .cmkey,,remhlp##,,, 9237 000374'02 000000000000# 9238 000375'02 44 07 0 00 002244' 9239 9240 000376'02 010004 000401' $htime: flddb. .cmcfm,,,,,$htim1 9241 000377'02 000000 000000 9242 000400'02 44 07 0 00 002250' 9243 000401'02 003004 000000 $htim1: flddb. .cmswi,,timhlp##,,, 9244 000402'02 000000000000# 9245 000403'02 44 07 0 00 002256' 9246 9247 cleans(<$hdef1,$hcle1,$hloc1,$hrem1,$htim1>) 9248 9249 ; N.B., Although most help text resides in section one, the TBLUK% 9250 ; table only stores 18 bit addresses. Therefore, we must clip the 9251 ; section number or LINK will remind us that it is doing it for us. 9252 ; 9253 ; Such action may or may not be desired. In our case, it is 9254 ; exactly what we want, so we clip the address here to keep from 9255 ; constantly seeing LINK's advisory messages. 9256 9257 define hclip (hbase,%hb,%fb) < ;;All 214, used to add secondary help 9258 extern hbase ;;All should be found in k20hlp, section 1 9259 %hb==<<'hbase>&.rhalf> ;;Clip down to 18 bits (we know the section) 9260 %fb==<<$'hbase>&.rhalf> ;;Clip down to 18 bits (we know the section) 9261 xwd %hb,%fb ;;Make a table entry 9262 cleans(<%hb,%fb>) ;;Clean up generated symbols 9263 > 9264 000404'02 000000# 000000# subhlp: hclip (hdefin) ;;Sub-help for DEFINE command 9265 000405'02 000000# 000000# hclip (hclear) ;;Sub-help for CLEAR command 9266 000406'02 000000# 000000# hclip (hlocal) ;;Sub-help for LOCAL command 9267 000407'02 000000# 000000# hclip (hremot) ;;Sub-help for REMOTE command 9268 000410'02 000000# 000000# hclip (htime) ;;Sub-help for TIME command 9269 000005 subcnt==.-subhlp ; Number of items in sub-help table 9270 9271 000411'02 000002 000000 hlpfdb: flddb. .cmkey,,hlptab,, 9272 000412'02 000000000000# 9273 000413'02 000000 000000 9274 000414'02 44 07 0 00 002261' 9275 retsec ;;Back in code 9276 9277 ;[214] End table and linkage definitions 9278 9279 001504'01 200 16 0 00 000000# .help: guide ;[18] HELP 9280 001505'01 260 17 0 00 001440* 9281 000415'02 000000000000# 9282 000536'04 141 142 157 165 164 9283 001506'01 201 01 0 00 000000# movei t1, hlpfdb 9284 001507'01 260 17 0 00 001424* call rfield ;[67] k20par - Kermit-20 Parsing and Semantic Action Routines MACRO %53B(1254)-4 19:41 30-Mar-24 Page 27-2 K20PAR MAC 29-Mar-24 20:39 HELP command parsing 9285 001510'01 200 02 0 02 000000 move t2, (t2) ; Get help text address. 9286 001511'01 202 02 0 00 001501* movem t2, pars3 9287 001512'01 402 00 0 00 001056* setzm pars4 ;[214] Let's assume it isn't a macro 9288 001513'01 553 00 0 00 000002 hrrzs t2 ;[67] 9289 001514'01 201 04 0 00 000004 movx t4, subcnt-1 ;[214] Load count of sub-help tables 9290 ;[214] Used as an index, actually 9291 remark ;[214] Note, SET must be last because of macros 9292 001515'01 415 16 0 00 001554' block. ;[214] Enter block context for better control 9293 001516'01 261 17 0 00 000016 9294 001517'01 do. ;[214] Enter loop context 9295 001517'01 554 03 0 04 000000# hlrz t3, subhlp(t4) ;[214] Load sub-help table in section offset 9296 001520'01 312 02 0 00 000003 came t2, t3 ;[214] Secondary help we know about? 9297 001521'01 254 00 0 00 001535' ifskp. ;[214] Yes, handle that 9298 001522'01 200 16 0 00 000000# guide ;[214] Tell them they can ask about sub-commands 9299 001523'01 260 17 0 00 001505* 9300 000416'02 000000000000# 9301 000540'04 151 164 145 155 000 9302 001524'01 550 01 0 04 000000# hrrz t1, subhlp(t4) ;[214] Load secondary help fdb 9303 001525'01 260 17 0 00 001507* call rfield ;[214] Maybe get item they want help for 9304 001526'01 135 01 0 00 005304' ldb t1, [pointr (.cmfnp(t3),cm%fnc)] ;[214] Get function code. 9305 001527'01 302 01 0 00 000010 caie t1, .cmcfm ;[214] Wanted general help? 9306 001530'01 254 00 0 00 001533' ifskp. ;[214] They did 9307 001531'01 554 02 0 04 000000# hlrz t2, subhlp(t4) ;[214] So load the general help again 9308 001532'01 254 00 0 00 000034* retskp ;[214] Signal completely done with parse 9309 001533'01 endif. ;[214] End case general REMOTE help 9310 001533'01 550 02 0 02 000000 hrrz t2, (t2) ;[214] Get switch help text address. 9311 001534'01 263 17 0 00 000000 ret ;[214] Break out of the block, non-skip 9312 001535'01 endif. ;[214] End case REMOTE picked 9313 001535'01 365 04 0 00 001517' sojge t4, top. ;[214] Try next sub-help 9314 001536'01 enddo. ;[214] End loop logical context 9315 9316 remark ;[214] If none of the above, do SET last 9317 001536'01 302 02 0 00 000000* caie t2, hset ;[214] Do they want help for SET? 9318 001537'01 254 00 0 00 001553' ifskp. ;[214] They did 9319 001540'01 200 16 0 00 000000# guide ;[67] Yes, give guide word. 9320 001541'01 260 17 0 00 001523* 9321 000417'02 000000000000# 9322 000541'04 160 141 162 141 155 9323 001542'01 201 01 0 00 000000# movei t1, hsfdb1 ;[77] Parse from macro or SET keyword table. 9324 001543'01 260 17 0 00 001525* call rfield ;[67] Get SET option they want help for. 9325 001544'01 553 00 0 00 000003 hrrzs t3 ;[77] Which function descriptor block was used? 9326 001545'01 302 03 0 00 000000# caie t3, hsfdb1 ;[77] The macro table? 9327 001546'01 254 00 0 00 001551' ifskp. ;[214] Yes, let semantic action know 9328 001547'01 476 00 0 00 001512* setom pars4 ;[214] More of a flag than a parse product 9329 001550'01 254 00 0 00 001552' else. ;[214] Otherwise, it was a SET option 9330 001551'01 200 02 0 02 000000 move t2, (t2) ;[67] Yes, don't do indirection 9331 001552'01 endif. ;[214] End case macro name or keywork 9332 001552'01 263 17 0 00 000000 ret ;[214] Break out of the block. 9333 001553'01 endif. ;[214] End case of set 9334 001553'01 263 17 0 00 000000 endbk. ;[214] End of block frame 9335 001554'01 254 00 0 00 001556' ifskp. ;[214] +2 means completely done 9336 remark ;[214] so DON'T confirm 9337 001555'01 254 00 0 00 001557' else. ;[214] Otherwise it must be confirmed first 9338 001556'01 260 17 0 00 001442* confrm ;[67] 9339 001557'01 endif. k20par - Kermit-20 Parsing and Semantic Action Routines MACRO %53B(1254)-4 19:41 30-Mar-24 Page 27-3 K20PAR MAC 29-Mar-24 20:39 HELP command parsing 9340 9341 001557'01 202 02 0 00 001511* movem t2, pars3 ;[67] SET... 9342 001560'01 263 17 0 00 000000 ret 9343 k20par - Kermit-20 Parsing and Semantic Action Routines MACRO %53B(1254)-4 19:41 30-Mar-24 Page 28 K20PAR MAC 29-Mar-24 20:39 HELP command semantic action 9344 subttl HELP command semantic action 9345 9346 remark The below is out of date, see [214], above 9347 9348 ; N.B., DEPENDs on help text not having the same in-section address 9349 ; as the macro table. In a single section program, this is, of course, 9350 ; impossble. However, the help text is now in section one, so it can't 9351 ; occupy the same set of in-section (18 bit) addresses. This is a form 9352 ; aliasing and is addressed by judicious .PSECT layout. 9353 9354 remark Display a macro, if that is what they want help on 9355 9356 ;[214] extern mactbx ;[203] Moved to K20MAC 9357 9358 001561'01 550 03 0 00 001557* $help: hrrz t3, pars3 ;[77] Special case for help about macro. 9359 001562'01 336 00 0 00 001547* skipn pars4 ;[214] Is it macro keyword? 9360 001563'01 254 00 0 00 001602' jrst $help2 ;[214] Nope, just type the text 9361 repeat 0,< ;[214] Remove address decisioning 9362 cail t3, mactab+1 9363 caile t3, mactbx 9364 jrst $help2 9365 >;;repeat 0 ;[214] End address decisioning removal 9366 txmsg < 9367 001564'01 200 01 0 00 000000# "> 9368 001565'01 104 00 0 00 000076 9369 001566'01 320 12 0 00 001567' 9370 000420'02 000000000000# 9371 000543'04 015 012 042 000 000 9372 001567'01 564 01 0 03 000000 hlro t1, (t3) 9373 001570'01 104 00 0 00 000076 PSOUT 9374 txmsg <" is a SET macro defined to be: 9375 001571'01 200 01 0 00 000000# > 9376 001572'01 104 00 0 00 000076 9377 001573'01 320 12 0 00 001574' 9378 000421'02 000000000000# 9379 000544'04 042 040 151 163 040 9380 9381 001574'01 560 01 0 03 000000 hrro t1, (t3) 9382 001575'01 104 00 0 00 000076 PSOUT 9383 txmsg < 9384 001576'01 200 01 0 00 000000# > 9385 001577'01 104 00 0 00 000076 9386 001600'01 320 12 0 00 001601' 9387 000422'02 000000000000# 9388 000554'04 015 012 000 000 000 9389 001601'01 263 17 0 00 000000 ret 9390 k20par - Kermit-20 Parsing and Semantic Action Routines MACRO %53B(1254)-4 19:41 30-Mar-24 Page 29 K20PAR MAC 29-Mar-24 20:39 HELP command semantic action 9391 remark Otherwise, display the help text 9392 9393 ; N.B., The comparison code is actually a kind of a kludge because it 9394 ; uses 18 bit addresses. Since hset is in section 0 in the TEXT 9395 ; .PSECT, whereas ALL other help text is in section one, how can we 9396 ; handle possible inter-section address clash? 9397 ; 9398 ; The answer is to keep the data in completely different parts of 9399 ; the respective sections so that there is no possibility of clash. 9400 ; 9401 ; 1) hset is VERY high in section zero's address space, past what 9402 ; would be called the "high segment" in Tops-10; something after 9403 ; page 500. 9404 ; 9405 ; 2) The HELP .PSECT starts in section one, page 1, which gives us 9406 ; some 510 pages for help text which may be enough to help Frank 9407 ; write another book. 9408 9409 ; Define 30 bit address section portion of ASCII pointer (also used in k20mit) 9410 610001 000000 hlpntr==:<.P07!>> ;;Forces LINK polish fix-up 9411 9412 001602'01 550 01 0 00 001561* $help2: hrrz t1, pars3 ;[194] Load in-section portion of address 9413 001603'01 302 01 0 00 001536* caie t1, hset## ;[194] They want help for SET? 9414 001604'01 254 00 0 00 001607' ifskp. ;[194] Yes, this is here we use in section 0 9415 001605'01 661 01 0 00 777777 tlo t1, -1 ;[194] So let Tops-20 handle it 9416 001606'01 254 00 0 00 001610' else. ;[194] Otherwise, it's an inter-section reference 9417 001607'01 661 01 0 00 610001 txo t1, hlpntr ;[194] Turn into a one word global pointer 9418 001610'01 endif. ;[194] PSOUT% should be happy with either 9419 9420 001610'01 104 00 0 00 000076 PSOUT 9421 001611'01 561 01 0 00 001013* hrroi t1, crlf 9422 001612'01 104 00 0 00 000076 PSOUT 9423 001613'01 263 17 0 00 000000 ret 9424 9425 k20par - Kermit-20 Parsing and Semantic Action Routines MACRO %53B(1254)-4 19:41 30-Mar-24 Page 30 K20PAR MAC 29-Mar-24 20:39 LOG command tables 9426 subttl LOG command tables 9427 9428 000423'02 000000 000000 %table(logtab) 9429 000424'02 000000# 000002 %key2 ,2 ;[143] 9430 000454'03 144 145 142 165 147 9431 000425'02 000000# 000001 %key2 ,1 9432 000456'03 163 145 163 163 151 9433 000426'02 000000# 000000 %key2 ,0 9434 000460'03 164 162 141 156 163 9435 000423'02 000003 000003 %tbend 9436 9437 000427'02 000000 000000 %table(dbstab) ;[41] (this table) 9438 000430'02 000000# 000007 %key2 <7>,7 9439 000463'03 067 000 000 000 000 9440 000431'02 000000# 000010 %key2 <8>,8 9441 000464'03 070 000 000 000 000 9442 000427'02 000002 000002 %tbend 9443 9444 ;[222] Default command filespec fields for .CMFIL: 9445 9446 chgsec(code,const) ;;Table is not in code, it's in const 9447 000432'02 600020 777777 logbk: gj%fou!gj%new!gj%flg!fld(-1,.rhalf) ;[222] Must NOT be an existing file!! 9448 000433'02 000000 000000 0 ;[222] ; .gjsrc: Leave JFN's alone 9449 000434'02 000000 000000 0 ;[222] ; .gjdev: Use default for device 9450 000435'02 000000 000000 0 ;[222] ; .gjdir: Use default for directory 9451 000436'02 000000 000000 0 ;[222] ; .gjnam: Will be filled in 9452 000437'02 000000000000# cascii () ;[222] ; .gjext: Default extension is .LOG 9453 000555'04 114 117 107 000 000 9454 000440'02 000000000000# 0 ;[222] ; .gjpro: Use system or directory default protection 9455 000441'02 000000 000000 0 ;[222] ; .gjact: Use job default account 9456 000010 logbkl==<.-logbk> ;[222] ; Length of this GTJFN argument block. 9457 9458 000442'02 000000000000# lognam: cascii () ;[222] Default transaction log 9459 000556'04 124 122 101 116 123 9460 000443'02 000000000000# cascii () ;[222] Default session log 9461 000561'04 123 105 123 123 111 9462 000444'02 000000000000# cascii () ;[222] & default debugging log 9463 000563'04 104 105 102 125 107 9464 retsec ;;Back to where-ever we started from 9465 k20par - Kermit-20 Parsing and Semantic Action Routines MACRO %53B(1254)-4 19:41 30-Mar-24 Page 31 K20PAR MAC 29-Mar-24 20:39 LOG command parsing 9466 subttl LOG command parsing 9467 9468 chgsec(code,const) ;;Chained FDB's are not in code, they're in const 9469 000445'02 000002 000000 logfdb: flddb. .cmkey,,logtab,, ; Parse what kind of log. 9470 000446'02 000000 000423' 9471 000447'02 000000 000000 9472 000450'02 44 07 0 00 002263' 9473 000451'02 006000 000000 lgfidb: flddb. .cmfil 9474 000452'02 000000 000000 9475 000453'02 000006 000000 lgbzfd: flddb. .cmkey,,dbstab,,7 ;[41] 9476 000454'02 000000 000427' 9477 000455'02 44 07 0 00 002265' 9478 000456'02 44 07 0 00 002272' 9479 retsec ;;Back to where-ever we started from 9480 9481 001614'01 200 16 0 00 000000# .log: guide ; Give guide word 9482 001615'01 260 17 0 00 001541* 9483 000457'02 000000000000# 9484 000565'04 167 150 141 164 000 9485 001616'01 201 01 0 00 000000# movei t1, logfdb 9486 001617'01 260 17 0 00 001543* call rfield 9487 001620'01 550 02 0 02 000000 hrrz t2, (t2) 9488 001621'01 202 02 0 00 001454* movem t2, pars2 9489 9490 001622'01 332 01 0 00 001602* skipe t1, pars3 ; Release any piled up JFNs from reparsing 9491 001623'01 104 00 0 00 000023 RLJFN 9492 001624'01 320 12 0 00 001625' erjmpr .+1 ; Catch and ignore any error 9493 001625'01 402 00 0 00 001622* setzm pars3 ;[194] Either way, no JFN parsed 9494 9495 001626'01 200 16 0 00 000000# guide ; Guide 9496 001627'01 260 17 0 00 001615* 9497 000460'02 000000000000# 9498 000566'04 164 157 040 146 151 9499 001630'01 201 01 0 00 000010 movx t1, logbkl ;[222] Space for GTJFN% block 9500 dmove t2, [ logbk ;[222] Source is our default GTJFN% block 9501 001631'01 120 02 0 00 005425' cjfnbk ] ;[222] Destination is COMND% GTJFN block 9502 001632'01 123 01 0 00 005421' xblt. t1 ;[222] Pop it into place 9503 9504 001633'01 200 02 0 00 001621* move t2, pars2 ;[222] Load the log table type 9505 001634'01 200 01 0 02 000000# move t1, lognam(t2) ;[222] Pick up the pointer for that 9506 001635'01 202 01 0 00 000000# movem t1, cjfnbk+.gjnam ;[222] Store as the default filename 9507 001636'01 201 01 0 00 000000# movei t1, lgfidb ;[222] Parse general file properly defaulted 9508 001637'01 260 17 0 00 001617* call rfield ; Parse log filespec. 9509 9510 001640'01 550 01 0 00 000002 hrrz t1, t2 ;[222] Load the JFN we got 9511 001641'01 260 17 0 00 001477* call isnulj ;[222] Is it NUL:? 9512 001642'01 600 00 0 00 000000 nop ;[222] No, but that's fine 9513 001643'01 552 01 0 00 001625* hrrzm t1, pars3 ;[222] Stash JFN here 9514 001644'01 200 02 0 00 001633* move t2, pars2 ;[143] Debugging log? 9515 001645'01 306 02 0 00 000002 cain t2, 2 ;[194] If not debugging 9516 001646'01 254 00 0 00 001651' ifskp. ;[194] Then nothing further to parse 9517 001647'01 260 17 0 00 001556* confrm ;[143] No, get confirmation 9518 001650'01 263 17 0 00 000000 ret ;[143] and return. 9519 001651'01 endif. ;[194] 9520 k20par - Kermit-20 Parsing and Semantic Action Routines MACRO %53B(1254)-4 19:41 30-Mar-24 Page 31-1 K20PAR MAC 29-Mar-24 20:39 LOG command parsing 9521 001651'01 200 16 0 00 000000# guide ;[41] Yes, parse the file byte size. 9522 001652'01 260 17 0 00 001627* 9523 000461'02 000000000000# 9524 000570'04 167 151 164 150 040 9525 001653'01 201 01 0 00 000000# movei t1, lgbzfd 9526 001654'01 260 17 0 00 001637* call rfield ;[41] Parse it. Defaults to 7. 9527 001655'01 550 02 0 02 000000 hrrz t2, (t2) ;[41] Get result. 9528 001656'01 202 02 0 00 001562* movem t2, pars4 ;[41] Save it. 9529 001657'01 200 16 0 00 000000# guide ;[41] Comforting guide... 9530 001660'01 260 17 0 00 001652* 9531 000462'02 000000000000# 9532 000574'04 142 151 164 163 000 9533 001661'01 260 17 0 00 001647* confrm 9534 001662'01 263 17 0 00 000000 ret 9535 k20par - Kermit-20 Parsing and Semantic Action Routines MACRO %53B(1254)-4 19:41 30-Mar-24 Page 32 K20PAR MAC 29-Mar-24 20:39 Open the desired log. 9536 subttl Open the desired log. 9537 9538 extern logbsz ;[194] Log file byte size 9539 extern frclos ;[194] Force close 9540 9541 001663'01 logdsp: remark ;[194] Log open dispatch table 9542 001663'01 000000 001702' $logt ;[194] Open transaction log 9543 001664'01 000000 001761' $logs ;[194] Open Session log 9544 001665'01 000000 002032' $logd ;[194] Open debugging log 9545 000003 logmax==.-logdsp ;[194] Maximum log file type 9546 9547 001666'01 331 01 0 00 001644* $log: skipl t1, pars2 ; What kind of log? 9548 001667'01 254 00 0 00 001673' ifskp. ;[194] The bad kind ... 9549 001670'01 200 01 0 00 000000# emsg ;[194] 9550 001671'01 104 00 0 00 000313 9551 000463'02 000000000000# 9552 000575'04 116 145 147 141 164 9553 001672'01 263 17 0 00 000000 ret ;[194] Go no further 9554 001673'01 endif. ;[194] 9555 001673'01 305 01 0 00 000003 caige t1, logmax ;[194] Out of range? 9556 001674'01 254 00 0 00 001700' ifskp. ;[194] Yeah, probably out of date 9557 001675'01 200 01 0 00 000000# emsg ;[194] 9558 001676'01 104 00 0 00 000313 9559 000464'02 000000000000# 9560 000607'04 114 157 147 147 151 9561 001677'01 263 17 0 00 000000 ret ;[194] Go no further 9562 001700'01 endif. ;[194] 9563 9564 remark ;[194] Otherwise, safe to dispatch 9565 001700'01 265 16 0 00 005321' saveac ;[198] Save q1 for everybody to play with 9566 001701'01 254 00 1 01 001663' jrst @logdsp(t1) ; Dispatch 9567 k20par - Kermit-20 Parsing and Semantic Action Routines MACRO %53B(1254)-4 19:41 30-Mar-24 Page 33 K20PAR MAC 29-Mar-24 20:39 Open transaction log semantic action 9568 subttl Open transaction log semantic action 9569 9570 ;[126] Begin code addition 9571 9572 001702'01 265 16 0 00 005321' $logt: saveac ;[221] Stores final JFN we're going to try 9573 001703'01 337 01 0 00 001352* skipg t1, tlgjfn ;[195] Already had a transaction log open? 9574 001704'01 254 00 0 00 001714' ifskp. ;[195] We did 9575 001705'01 402 00 0 00 001703* setzm tlgjfn ; In case of failure. 9576 001706'01 260 17 0 00 000755* call frclos ;[194] Force close 9577 001707'01 334 01 0 00 000000# ermsg% (, r) 9578 001710'01 254 00 0 00 001714' 9579 001711'01 202 01 0 00 000000* 9580 001712'01 104 00 0 00 000313 9581 001713'01 254 00 0 00 001464* 9582 000465'02 000000000000# 9583 000616'04 113 105 122 115 111 9584 9585 001714'01 endif. ;[195] 9586 9587 001714'01 260 17 0 00 002224' call nulogj ;[198] Go figure out the logging JFN 9588 001715'01 263 17 0 00 000000 ret ;[198] Failed; we've already whined about it 9589 001716'01 200 05 0 00 000001 move q1, t1 ;[221] Store whatever we're going to use 9590 001717'01 321 03 0 00 001745' ifxe. t3, gs%opn ;[198] Not open? 9591 001720'01 306 01 0 00 377777 cain t1, .nulio ;[221] Special JFN? 9592 001721'01 254 00 0 00 001745' anskp. ;[221] Doesn't need to be opened 9593 001722'01 200 03 0 00 000002 move t3, t2 ;[222] Otherwise, store the OPENF% bits 9594 001723'01 104 00 0 00 000021 OPENF ;[198] and try to open it 9595 001724'01 320 12 0 00 001726' ifje. r ;[198] Failed?? 9596 001725'01 254 00 0 00 001745' 9597 001726'01 302 01 0 00 600120 caie t1, opnx1 ; Already open? 9598 001727'01 254 00 0 00 001732' ifskp. ;[195] Yes, that's odd, but OK... 9599 001730'01 200 01 0 00 000005 move t1, q1 ;[194] Restore the JFN and carry on 9600 001731'01 254 00 0 00 001745' else. ;[194] Otherwise, a worse error 9601 001732'01 302 01 0 00 600130 caie t1, opnx9 ;[222] Invalid simulaneous access??? 9602 001733'01 254 00 0 00 001737' ifskp. ;[222] Yep, gj%new!gj%new didn't work 9603 001734'01 260 17 0 00 002106' call nxthgh ;[222] Get and open the next highest JFN 9604 001735'01 254 00 0 00 001737' anskp. ;[222] But couldn't 9605 remark ;[222] Otherwise, falls out to movem 9606 001736'01 254 00 0 00 001745' else. ;[222] Otherwise, so other kind of error 9607 001737'01 200 04 0 00 000001 move t4, t1 ;[194] Save error for a debugger 9608 001740'01 334 00 0 00 000000 %ermsg (,$loge) ;[221] 9609 001741'01 254 00 0 00 001745' 9610 001742'01 265 01 0 00 001462* 9611 001743'01 000000000000# 9612 001744'01 254 00 0 00 002217' 9613 000631'04 125 156 141 142 154 9614 001745'01 endif. ;[222] End attempted opnx9 recovery 9615 001745'01 endif. ;[194] End OPENF% error recovery 9616 001745'01 endif. ;[194] End OPENF% error analysis 9617 001745'01 endif. ;[194] End case opening the transaction log 9618 9619 001745'01 202 01 0 00 001705* movem t1, tlgjfn ; Save the jfn. 9620 001746'01 120 02 0 00 000000# smsg () 9621 001747'01 260 17 0 00 001161* 9622 000466'02 000000000000# k20par - Kermit-20 Parsing and Semantic Action Routines MACRO %53B(1254)-4 19:41 30-Mar-24 Page 33-1 K20PAR MAC 29-Mar-24 20:39 Open transaction log semantic action 9623 000467'02 777777 777740 9624 000640'04 113 105 122 115 111 9625 dmove t2, [ -1 ; Write header in log file. 9626 001750'01 120 02 0 00 005427' ot%ntm!ot%day!ot%fdy!ot%fmn!ot%4yr] 9627 001751'01 104 00 0 00 000220 ODTIM 9628 001752'01 120 02 0 00 005431' dmove t2, [exp <-1,,crlflf>, -^d4 ] 9629 001753'01 104 00 0 00 000053 SOUT ;[194] Counted tie off 9630 001754'01 265 01 0 00 001346* wtlog (, tlgjfn) 9631 001755'01 000000000000# 9632 001756'01 777777 777764 9633 001757'01 000000000000# 9634 000647'04 117 160 145 156 145 9635 001760'01 263 17 0 00 000000 ret 9636 9637 ;[126] End of addition. 9638 k20par - Kermit-20 Parsing and Semantic Action Routines MACRO %53B(1254)-4 19:41 30-Mar-24 Page 34 K20PAR MAC 29-Mar-24 20:39 Open session log semantic action 9639 subttl Open session log semantic action 9640 9641 ;[194] If log is opened again without being closed beforehand, then 9642 ; JFN's can wind up being lost. 9643 9644 001761'01 265 16 0 00 005321' $logs: saveac ;[221] Needs an accumulator 9645 001762'01 337 01 0 00 001403* skipg t1, sesjfn ;[195] Already had a session log open? 9646 001763'01 254 00 0 00 001775' ifskp. ;[195] We did 9647 001764'01 402 00 0 00 001762* setzm sesjfn ; In case of failure. 9648 001765'01 402 00 0 00 001404* setzm sesflg ;[198] Stomp session flag, too 9649 001766'01 260 17 0 00 001706* call frclos ;[194] Force close 9650 001767'01 334 01 0 00 000000# ermsg% (, r) 9651 001770'01 254 00 0 00 001774' 9652 001771'01 202 01 0 00 001711* 9653 001772'01 104 00 0 00 000313 9654 001773'01 254 00 0 00 001713* 9655 000470'02 000000000000# 9656 000652'04 113 105 122 115 111 9657 9658 001774'01 254 00 0 00 001776' else. ;[198] Otherwise, decondition further logic 9659 001775'01 402 00 0 00 001765* setzm sesflg ;[198] Stomp session flag 9660 001776'01 endif. ;[195] 9661 9662 001776'01 260 17 0 00 002224' call nulogj ;[198] Go figure out the logging JFN 9663 001777'01 263 17 0 00 000000 ret ;[198] Failed; we've already whined about it 9664 002000'01 200 05 0 00 000001 move q1, t1 ;[221] Save whatever we're going to use 9665 002001'01 321 03 0 00 002027' ifxe. t3, gs%opn ;[198] Not open? 9666 002002'01 306 01 0 00 377777 cain t1, .nulio ;[221] Special JFN? 9667 002003'01 254 00 0 00 002027' anskp. ;[221] Doesn't need to be opened 9668 002004'01 200 03 0 00 000002 move t3, t2 ;[222] Otherwise, store the OPENF% bits 9669 002005'01 104 00 0 00 000021 OPENF ; Open now, avoid being stomped by CLZFFs. 9670 002006'01 320 12 0 00 002010' ifje. r ;[198] Failed?? 9671 002007'01 254 00 0 00 002027' 9672 002010'01 302 01 0 00 600120 caie t1, opnx1 ; Already open? 9673 002011'01 254 00 0 00 002014' ifskp. ;[195] Yes, that's odd, but OK... 9674 002012'01 200 01 0 00 000005 move t1, q1 ;[194] Restore the JFN and carry on 9675 002013'01 254 00 0 00 002027' else. ;[194] Otherwise, a worse error 9676 002014'01 302 01 0 00 600130 caie t1, opnx9 ;[222] Invalid simulaneous access??? 9677 002015'01 254 00 0 00 002021' ifskp. ;[222] Yep, gj%new!gj%new didn't work 9678 002016'01 260 17 0 00 002106' call nxthgh ;[222] Get and open the next highest JFN 9679 002017'01 254 00 0 00 002021' anskp. ;[222] But couldn't 9680 remark ;[222] Otherwise, falls out to movem 9681 002020'01 254 00 0 00 002027' else. ;[222] Otherwise, so other kind of error 9682 002021'01 200 04 0 00 000001 move t4, t1 ;[194] Save error for a debugger 9683 002022'01 334 00 0 00 000000 %ermsg (,$loge) ;[221] 9684 002023'01 254 00 0 00 002027' 9685 002024'01 265 01 0 00 001742* 9686 002025'01 000000000000# 9687 002026'01 254 00 0 00 002217' 9688 000664'04 125 156 141 142 154 9689 002027'01 endif. ;[222] End opnx9 recovery 9690 002027'01 endif. ;[194] End OPENF% error recovery 9691 002027'01 endif. ;[194] End OPENF% error analysis 9692 002027'01 endif. ;[198] End case opening the session log 9693 k20par - Kermit-20 Parsing and Semantic Action Routines MACRO %53B(1254)-4 19:41 30-Mar-24 Page 34-1 K20PAR MAC 29-Mar-24 20:39 Open session log semantic action 9694 remark ;[195] Otherwise, everything is dandy 9695 002027'01 552 01 0 00 001764* hrrzm t1, sesjfn ;[195] Save the open JFN. 9696 002030'01 476 00 0 00 001775* setom sesflg ;[195] Flag session logging is active 9697 002031'01 263 17 0 00 000000 ret 9698 k20par - Kermit-20 Parsing and Semantic Action Routines MACRO %53B(1254)-4 19:41 30-Mar-24 Page 35 K20PAR MAC 29-Mar-24 20:39 Open debugging log semantic action 9699 subttl Open debugging log semantic action 9700 9701 002032'01 265 16 0 00 005321' $logd: saveac ;[221] Accumulator for JFN 9702 002033'01 337 01 0 00 001323* skipg t1, logjfn ;[195] Already had a debugging log open? 9703 002034'01 254 00 0 00 002044' ifskp. ;[195] We did 9704 002035'01 402 00 0 00 002033* setzm logjfn ; In case of failure. 9705 002036'01 260 17 0 00 001766* call frclos ;[194] Force close 9706 002037'01 334 01 0 00 000000# ermsg% (, r) 9707 002040'01 254 00 0 00 002044' 9708 002041'01 202 01 0 00 001771* 9709 002042'01 104 00 0 00 000313 9710 002043'01 254 00 0 00 001773* 9711 000471'02 000000000000# 9712 000672'04 113 105 122 115 111 9713 9714 002044'01 endif. ;[195] 9715 9716 002044'01 260 17 0 00 002224' call nulogj ;[198] Go figure out the logging JFN 9717 002045'01 263 17 0 00 000000 ret ;[198] Failed; we've already whined about it 9718 002046'01 200 05 0 00 000001 move q1, t1 ;[221] Save the accumulator 9719 002047'01 200 04 0 00 001656* move t4, pars4 ;[198] ;[41] Load the bytesize we wanted. 9720 002050'01 202 04 0 00 000000* movem t4, logbsz ;[41] Save bytesize for SHOW command. 9721 002051'01 321 03 0 00 002102' ifxe. t3, gs%opn ;[198] Not open? 9722 002052'01 302 04 0 00 000010 caie t4, ^d8 ;[41] 8-bit requested? 9723 002053'01 254 00 0 00 002055' ifskp. ;[198] Whoops, better fix the mode word 9724 002054'01 137 04 0 00 005433' dpb t4,[pointr (t2,of%bsz)];[198] Overwrite the 7... 9725 002055'01 endif. ;[198] End case byte size fix up 9726 002055'01 306 01 0 00 377777 cain t1, .nulio ;[221] Special JFN? 9727 002056'01 254 00 0 00 002102' anskp. ;[221] Doesn't need to be opened 9728 002057'01 200 03 0 00 000002 move t3, t2 ;[222] Otherwise, store the OPENF% bits 9729 002060'01 104 00 0 00 000021 OPENF% ;[38] 9730 002061'01 320 12 0 00 002063' ifje. r ;[198] Failed?? 9731 002062'01 254 00 0 00 002102' 9732 002063'01 302 01 0 00 600120 caie t1, opnx1 ; Already open? 9733 002064'01 254 00 0 00 002067' ifskp. ;[195] Yes, that's odd, but OK... 9734 002065'01 200 01 0 00 000005 move t1, q1 ;[194] Restore the JFN and carry on 9735 002066'01 254 00 0 00 002102' else. ;[194] Otherwise, a worse error 9736 002067'01 302 01 0 00 600130 caie t1, opnx9 ;[222] Invalid simulaneous access??? 9737 002070'01 254 00 0 00 002074' ifskp. ;[222] Yep, gj%new!gj%new didn't work 9738 002071'01 260 17 0 00 002106' call nxthgh ;[222] Get and open the next highest JFN 9739 002072'01 254 00 0 00 002074' anskp. ;[222] But couldn't 9740 remark ;[222] Otherwise, falls out to movem 9741 002073'01 254 00 0 00 002102' else. ;[222] Otherwise, so other kind of error 9742 002074'01 200 04 0 00 000001 move t4, t1 ;[194] Save error for a debugger 9743 002075'01 334 00 0 00 000000 %ermsg (,$loge) ;[221] 9744 002076'01 254 00 0 00 002102' 9745 002077'01 265 01 0 00 002024* 9746 002100'01 000000000000# 9747 002101'01 254 00 0 00 002217' 9748 000705'04 125 156 141 142 154 9749 002102'01 endif. ;[222] End opnx9 error recovery 9750 002102'01 endif. ;[194] End OPENF% error recovery 9751 002102'01 endif. ;[194] End OPENF% error analysis 9752 002102'01 endif. ;[198] End case opening the session log 9753 k20par - Kermit-20 Parsing and Semantic Action Routines MACRO %53B(1254)-4 19:41 30-Mar-24 Page 35-1 K20PAR MAC 29-Mar-24 20:39 Open debugging log semantic action 9754 remark ;[195] Otherwise, everything is dandy 9755 002102'01 202 01 0 00 002035* movem t1, logjfn ;[38] Opened OK, save it. 9756 002103'01 336 00 0 00 000014 skipn debug ;[41] Was debugging asked for? 9757 002104'01 201 14 0 00 000001 movei debug, 1 ;[41] Not yet, so set default debugging. 9758 002105'01 263 17 0 00 000000 ret 9759 k20par - Kermit-20 Parsing and Semantic Action Routines MACRO %53B(1254)-4 19:41 30-Mar-24 Page 36 K20PAR MAC 29-Mar-24 20:39 Get next higher generation 9760 subttl Get next higher generation 9761 9762 ; gj%new!gj%fou will only work for a file which has been saved at 9763 ; least once. Otherwise, the file does not exist on disk yet and 9764 ; GTJFN% can return the JFN of a file that is actually already open 9765 ; (in another job). 9766 9767 ; Call: 9768 ; 9769 ; q1/ JFN that failed open with opnx9 9770 ; t3/ Failing OPENF%'s bits 9771 ; 9772 ; Return: 9773 ; 9774 ; +1/ Failed, q1 unchanged 9775 ; +2/ Worked, q1 has an OPEN JFN 9776 9777 ; Fields for file with no generation number 9778 9779 100000 000000 fnogen==fld(.jsaof, js%dev) ;[222] Always want device 9780 110000 000000 fnogen==fnogen!fld(.jsaof, js%dir) ;[222] Full directory 9781 111000 000000 fnogen==fnogen!fld(.jsaof, js%nam) ;[222] File Name 9782 111100 000000 fnogen==fnogen!fld(.jsaof, js%typ) ;[222] File Type (or Extension) 9783 111100 000001 fnogen==fnogen!js%paf ;[222] Punctuate all fields 9784 9785 002106'01 265 16 0 00 005343' nxthgh: saveac ;[222] Needs some control variables 9786 002107'01 200 06 0 00 000003 move q2, t3 ;[222] Save the OPENF% bits 9787 002110'01 561 01 0 00 001021* hrroi t1, atmbuf ;[222] Get a place to do JFNS% 9788 002111'01 550 02 0 00 000005 hrrz t2, q1 ;[222] Load the JFN 9789 dmove t3, [ fld(.jsaof, js%gen) ;[222] Just want the (bad) generation number 9790 002112'01 120 03 0 00 005434' 0 ] ;[222] No goofy prefix, whatever that is 9791 002113'01 104 00 0 00 000030 JFNS% ;[222] Get just that 9792 002114'01 320 12 0 00 002116' %jsErr (,r) 9793 002115'01 254 00 0 00 002121' 9794 002116'01 265 01 0 00 002077* 9795 002117'01 000000000000# 9796 002120'01 254 00 0 00 002043* 9797 000713'04 112 106 116 123 045 9798 002121'01 561 01 0 00 002110* hrroi t1, atmbuf ;[222] Point at the atom buffer again 9799 002122'01 201 03 0 00 000012 movei t3, ^d10 ;[222] Generations are in base 10 9800 002123'01 104 00 0 00 000225 NIN% ;[222] Convert to internal binary format 9801 002124'01 320 12 0 00 002126' %jsErr (,r) 9802 002125'01 254 00 0 00 002131' 9803 002126'01 265 01 0 00 002116* 9804 002127'01 000000000000# 9805 002130'01 254 00 0 00 002120* 9806 000730'04 116 111 116 045 040 9807 002131'01 350 07 0 00 000002 aos q3, t2 ;[222] Calculate and save the next highest 9808 002132'01 561 01 0 00 002121* hrroi t1, atmbuf ;[222] Get a place to do another JFNS% 9809 002133'01 550 02 0 00 000005 hrrz t2, q1 ;[222] Load the JFN again 9810 dmove t3, [ fnogen ;[222] Do everything EXCEPT the generation 9811 002134'01 120 03 0 00 005436' 0 ] ;[222] No goofy prefix, whatever that is 9812 002135'01 104 00 0 00 000030 JFNS% ;[222] Get just that 9813 002136'01 320 12 0 00 002140' %jsErr (<2nd JFNS% failure recovering from invalid simultaneous access>,r) 9814 002137'01 254 00 0 00 002143' k20par - Kermit-20 Parsing and Semantic Action Routines MACRO %53B(1254)-4 19:41 30-Mar-24 Page 36-1 K20PAR MAC 29-Mar-24 20:39 Get next higher generation 9815 002140'01 265 01 0 00 002126* 9816 002141'01 000000000000# 9817 002142'01 254 00 0 00 002130* 9818 000745'04 062 156 144 040 112 9819 002143'01 201 03 0 00 000056 movei t3, "." ;[222] Punctuation for generation number to come 9820 002144'01 136 03 0 00 000001 idpb t3, t1 ;[222] Append it 9821 002145'01 200 10 0 00 000001 move q4, t1 ;[222] Save where to append the generation 9822 002146'01 201 04 0 00 000036 movei t4, ^d30 ;[222] Only try 30 generations 9823 9824 002147'01 do. ;[222] Enter loop context 9825 002147'01 200 01 0 00 000010 move t1, q4 ;[222] Where to append the current generation 9826 002150'01 200 02 0 00 000007 move t2, q3 ;[222] Load current highest generation 9827 002151'01 201 03 0 00 000012 movei t3, ^d10 ;[222] Output in base 10 9828 002152'01 104 00 0 00 000224 NOUT% ;[222] Convert to internal binary format 9829 002153'01 320 12 0 00 002155' %jsErr (,r) 9830 002154'01 254 00 0 00 002160' 9831 002155'01 265 01 0 00 002140* 9832 002156'01 000000000000# 9833 002157'01 254 00 0 00 002142* 9834 000762'04 116 117 125 124 045 9835 dmove t1, [ ;[222] May no catch existing files, but... 9836 gj%new!gj%flg ;[222] New file, return flags 9837 002160'01 120 01 0 00 005440' -1,,atmbuf ] ;[222] Point to what we just built 9838 002161'01 104 00 0 00 000020 GTJFN% ;[222] Get a JFN on the next highest generation 9839 002162'01 320 12 0 00 002164' %jsErr (,r) 9840 002163'01 254 00 0 00 002167' 9841 002164'01 265 01 0 00 002155* 9842 002165'01 000000000000# 9843 002166'01 254 00 0 00 002157* 9844 000777'04 107 124 112 106 116 9845 002167'01 510 03 0 00 000001 hllz t3, t1 ;[222] Grab the flags 9846 002170'01 621 01 0 00 777777 tlz t1, -1 ;[222] Stomp them 9847 002171'01 250 01 0 00 000005 exch t1, q1 ;[222] Use as current JFN 9848 002172'01 104 00 0 00 000023 RLJFN% ;[222] Toss the one that didn't work 9849 002173'01 320 12 0 00 002175' %jsErr (,r) 9850 002174'01 254 00 0 00 002200' 9851 002175'01 265 01 0 00 002164* 9852 002176'01 000000000000# 9853 002177'01 254 00 0 00 002166* 9854 001014'04 122 114 112 106 116 9855 002200'01 550 01 0 00 000005 hrrz t1, q1 ;[222] Load the new JFN 9856 002201'01 200 02 0 00 000006 move t2, q2 ;[222] Load original OPENF% bits 9857 002202'01 104 00 0 00 000021 OPENF% ;[222] And try it again 9858 002203'01 320 12 0 00 002205' ifje. r ;[222] But failed 9859 002204'01 254 00 0 00 002216' 9860 002205'01 302 01 0 00 600130 caie t1, opnx9 ;[222] Bumped into another one? 9861 002206'01 334 00 0 00 000000 %ermsg (,r) 9862 002207'01 254 00 0 00 002213' 9863 002210'01 265 01 0 00 002175* 9864 002211'01 000000000000# 9865 002212'01 254 00 0 00 002177* 9866 001031'04 117 120 105 116 106 9867 002213'01 363 04 0 00 002212* sojle t4, r ;[222] Only do this so many times 9868 002214'01 344 07 0 00 002147' aoja q3, top. ;[222] Otherwise, try another generation 9869 002215'01 254 00 0 00 002217' else. ;[222] Otherwise, worked k20par - Kermit-20 Parsing and Semantic Action Routines MACRO %53B(1254)-4 19:41 30-Mar-24 Page 36-2 K20PAR MAC 29-Mar-24 20:39 Get next higher generation 9870 002216'01 254 00 0 00 001532* retskp ;[222] Return success 9871 002217'01 endif. ;[222] End OPENF% analysis 9872 002217'01 enddo. ;[222] End loop context 9873 k20par - Kermit-20 Parsing and Semantic Action Routines MACRO %53B(1254)-4 19:41 30-Mar-24 Page 37 K20PAR MAC 29-Mar-24 20:39 Handle log file open errors 9874 subttl Handle log file open errors 9875 9876 ; Assumes Q1 has a JFN 9877 9878 002217'01 550 01 0 00 000005 $loge: hrrz t1, q1 ;[221] Load the JFN 9879 002220'01 322 01 0 00 002213* jumpe t1, R ;[222] Don't try to release gubbish 9880 002221'01 260 17 0 00 002036* call frclos ;[221] Force it closed or release it 9881 002222'01 600 00 0 00 000000 nop ;[221] Ignore error return when trying to recover 9882 002223'01 263 17 0 00 000000 ret ;[221] Done 9883 k20par - Kermit-20 Parsing and Semantic Action Routines MACRO %53B(1254)-4 19:41 30-Mar-24 Page 38 K20PAR MAC 29-Mar-24 20:39 Set up a log file JFN, special casing NUL: 9884 subttl Set up a log file JFN, special casing NUL: 9885 9886 ; Call: 9887 ; 9888 ; pars3/ Some kind of JFN, which is very carefully checked 9889 ; 9890 ; +1 Failed 9891 ; +2 t1/ JFN ready to be opened or .nulio 9892 ; t2/ OPENF% bits, basically of%wr and maybe of%app 9893 ; Assumes 7 bit mode, which would need to be overriden 9894 ; t3/ Results of GTSTS% (which are simulated for .nulio) 9895 ; pars3/ Updated in case of .nulio 9896 9897 002224'01 265 16 0 00 005367' nulogj: saveac ;[198] Saves a copy of the JFN 9898 9899 002225'01 415 16 0 00 002235' block. ;[194] Enter block context for better control flow 9900 002226'01 261 17 0 00 000016 9901 002227'01 337 05 0 00 001643* skipg q1, pars3 ;[194] Load and check the parsed JFN 9902 002230'01 263 17 0 00 000000 ret ;[194] It was junk... 9903 002231'01 621 05 0 00 777777 tlz q1, -1 ;[194] Shut off any flags 9904 002232'01 322 05 0 00 002220* jumpe q1, r ;[194] Zero is junk, too 9905 002233'01 254 00 0 00 002216* retskp ;[194] Otherwise, passes lexical checks 9906 002234'01 263 17 0 00 000000 endbk. ;[194] Exit block. context 9907 002235'01 254 00 0 00 002240' ifskp. ;[194] Passed? 9908 002236'01 200 01 0 00 000005 move t1, q1 ;[194] Yes, do some further checking 9909 002237'01 254 00 0 00 002245' else. ;[194] Otherwise, something wasn't right 9910 002240'01 334 01 0 00 000000# ermsg% (, r) 9911 002241'01 254 00 0 00 002245' 9912 002242'01 202 01 0 00 002041* 9913 002243'01 104 00 0 00 000313 9914 002244'01 254 00 0 00 002232* 9915 000472'02 000000000000# 9916 001045'04 113 105 122 115 111 9917 9918 002245'01 endif. ;[194] End sanity check 9919 9920 remark t1, q1 ;[194] t1 is loaded at this point 9921 002245'01 260 17 0 00 001641* call isnulj ;[194] Allow them to log to NUL: quickly 9922 002246'01 254 00 0 00 002253' ifskp. ;[194] It's NUL: 9923 002247'01 553 05 0 00 000001 hrrzs q1, t1 ;[194] Clear 'flags' and cache JFN 9924 002250'01 202 01 0 00 002227* movem t1, pars3 ;[194] Store .nulio as parse item 9925 002251'01 205 06 0 00 501200 movx q2, ;[198] Pretend some likley bits 9926 002252'01 254 00 0 00 002331' else. ;[194] Otherwise, a real file 9927 002253'01 104 00 0 00 000024 GTSTS% ;[198] Let's have a look at the file 9928 002254'01 320 12 0 00 002256' %jserr (,r) ;[198] 9929 002255'01 254 00 0 00 002261' 9930 002256'01 265 01 0 00 002210* 9931 002257'01 000000000000# 9932 002260'01 254 00 0 00 002244* 9933 001056'04 125 156 141 142 154 9934 002261'01 200 06 0 00 000002 move q2, t2 ;[198] Save the status 9935 002262'01 603 02 0 00 000200 ifxe. t2, gs%nam ;[198] Some kind of gubbish? 9936 002263'01 254 00 0 00 002271' 9937 002264'01 334 01 0 00 000000# ermsg% (, r) ;[198] 9938 002265'01 254 00 0 00 002271' k20par - Kermit-20 Parsing and Semantic Action Routines MACRO %53B(1254)-4 19:41 30-Mar-24 Page 38-1 K20PAR MAC 29-Mar-24 20:39 Set up a log file JFN, special casing NUL: 9939 002266'01 202 01 0 00 002242* 9940 002267'01 104 00 0 00 000313 9941 002270'01 254 00 0 00 002260* 9942 000473'02 000000000000# 9943 001065'04 113 105 122 115 111 9944 9945 002271'01 endif. ;[198] 9946 002271'01 607 02 0 00 000400 ifxn. t2, gs%err ;[198] Some kind of error? 9947 002272'01 254 00 0 00 002300' 9948 002273'01 334 01 0 00 000000# ermsg% (, r) ;[198] 9949 002274'01 254 00 0 00 002300' 9950 002275'01 202 01 0 00 002266* 9951 002276'01 104 00 0 00 000313 9952 002277'01 254 00 0 00 002270* 9953 000474'02 000000000000# 9954 001076'04 113 105 122 115 111 9955 9956 002300'01 endif. ;[198] 9957 002300'01 603 02 0 00 400000 txne t2, gs%opn ;[198] Is it already open? 9958 002301'01 254 00 0 00 002331' anskp. ;[198] It is, so we're done 9959 002302'01 104 00 0 00 000117 DVCHR% ;[198] Let's find out about the device 9960 002303'01 320 12 0 00 002305' %jserr (,r) ;[198] 9961 002304'01 254 00 0 00 002310' 9962 002305'01 265 01 0 00 002256* 9963 002306'01 000000000000# 9964 002307'01 254 00 0 00 002277* 9965 001112'04 117 160 145 156 040 9966 002310'01 135 03 0 00 005442' ldb t3,[pointr t2, dv%typ] ;[198] Pick up the device type 9967 002311'01 302 03 0 00 000000 caie t3, .dvdsk ;[198] Is this a disk? 9968 002312'01 254 00 0 00 002327' ifskp. ;[198] Yes, safe to query the fdb (I hope) 9969 002313'01 200 01 0 00 000005 move t1, q1 ;[198] Load the JFN 9970 dmove t2, [1,,.fbctl ;[198] Get the file descriptor control word 9971 002314'01 120 02 0 00 005443' t4 ] ;[198] Put it in t4 9972 002315'01 104 00 0 00 000063 GTFDB% ;[198] Pull it from the file descriptor block. 9973 002316'01 320 12 0 00 002320' ifje. r ;[198] Sigh... 9974 002317'01 254 00 0 00 002323' 9975 002320'01 200 03 0 00 000001 move t3, t1 ;[198] Save the error for debuggers 9976 002321'01 474 02 0 00 000000 seto t2, ;[198] Assume not appending 9977 002322'01 200 01 0 00 000005 move t1, q1 ;[198] Reload the JFN 9978 002323'01 endif. ;[198] 9979 002323'01 603 02 0 00 100000 txne t2, fb%nex ;[198] Doesn't exist yet? 9980 002324'01 254 00 0 00 002327' anskp. ;[198] Then it is silly to try to append 9981 remark fb%nxf!fb%wnc ;[198] Not closed in some way; try not to overwrite 9982 remark t1, q1 ;[198] t1 is still loaded (or reloaded) at this point 9983 002325'01 200 02 0 00 005445' movx t2, of%wr!of%app!fld(7,of%bsz) ;[198] Write/append access, 7-bit bytes. 9984 002326'01 254 00 0 00 002331' else. ;[198] Otherwise, assume not appending 9985 002327'01 200 01 0 00 000005 move t1, q1 ;[198] Reload load the JFN 9986 002330'01 200 02 0 00 005446' movx t2, of%wr!fld(7,of%bsz) ;[198] Write access, 7-bit bytes. 9987 002331'01 endif. ;[198] 9988 002331'01 endif. ;[198] End .nulio special casing 9989 002331'01 200 03 0 00 000006 move t3, q2 ;[198] Return GTSTS% 9990 9991 002332'01 254 00 0 00 002233* retskp ;[198] Succeeded at something, anyway... 9992 k20par - Kermit-20 Parsing and Semantic Action Routines MACRO %53B(1254)-4 19:41 30-Mar-24 Page 39 K20PAR MAC 29-Mar-24 20:39 PAUSE command 9993 subttl PAUSE command 9994 9995 chgsec(code,const) ;;FDB's are not in code, they're in const 9996 000475'02 015006 000000 paufdb: flddb. .cmflt,,^d10,,<1> 9997 000476'02 000000 000012 9998 000477'02 44 07 0 00 002273' 9999 000500'02 44 07 0 00 002047' 10000 retsec ;;Back to where-ever we started from 10001 10002 002333'01 200 16 0 00 000000# .pause: guide (seconds) 10003 002334'01 260 17 0 00 001660* 10004 000501'02 000000000000# 10005 001123'04 163 145 143 157 156 10006 002335'01 201 01 0 00 000000# movei t1, paufdb 10007 002336'01 260 17 0 00 001654* call rfield ;[194] Parse for the floating number 10008 10009 002337'01 325 02 0 00 002343' ifl. t2 ;[194] Is the number in the right range? 10010 002340'01 200 01 0 00 000000# emsg ;[187] 10011 002341'01 104 00 0 00 000313 10012 000502'02 000000000000# 10013 001125'04 116 145 147 141 164 10014 002342'01 254 00 0 00 000230* jrst cmder1 ;[194] Allow reparse 10015 002343'01 endif. ;[194] 10016 10017 remark ;[212] When chksec works, it works completely 10018 002343'01 260 17 0 00 000000' call chksec ;[196] Ensure number is in correct range 10019 002344'01 254 00 0 00 002351' ifskp. ;[196] Check and convert OK? 10020 002345'01 336 00 0 00 000000* skipn definf ;[212] Yes; in a DEFINE command? 10021 002346'01 260 17 0 00 001661* confrm ;[212] No, confirm the line 10022 002347'01 263 17 0 00 000000 ret ;[212] And done 10023 002350'01 254 00 0 00 002354' else. ;[196] Otherwise, couldn't swallow something 10024 002351'01 200 01 0 00 000000# emsg ;[196] 10025 002352'01 104 00 0 00 000313 10026 000503'02 000000000000# 10027 001134'04 120 141 165 163 145 10028 002353'01 254 00 0 00 002342* jrst cmder1 ;[196] Allow reparse 10029 002354'01 endif. ;[196] End case checking and conversion 10030 10031 remark Pause semantic action 10032 10033 002354'01 337 01 0 00 002047* $pause: skipg t1, pars4 ;[196] Load the milliseconds 10034 002355'01 263 17 0 00 000000 ret ;[196] Unless there weren't any 10035 002356'01 104 00 0 00 000167 DISMS ; Sleep. 10036 002357'01 320 12 0 00 002360' erjmpr .+1 ;[194] Catch and ignore error 10037 002360'01 263 17 0 00 000000 ret 10038 k20par - Kermit-20 Parsing and Semantic Action Routines MACRO %53B(1254)-4 19:41 30-Mar-24 Page 40 K20PAR MAC 29-Mar-24 20:39 PROMPT command 10039 subttl PROMPT command 10040 10041 ; Parse the rest of the PROMPT command. 10042 10043 002361'01 260 17 0 00 002346* .promp: confrm ; Confirm. 10044 002362'01 263 17 0 00 000000 ret 10045 10046 remark PROMPT command execution. 10047 10048 002363'01 402 00 0 00 001314* $promp: setzm f$exit ; Reset exit flag. 10049 002364'01 263 17 0 00 000000 ret 10050 k20par - Kermit-20 Parsing and Semantic Action Routines MACRO %53B(1254)-4 19:41 30-Mar-24 Page 41 K20PAR MAC 29-Mar-24 20:39 PUSH command 10051 subttl PUSH command 10052 10053 002365'01 260 17 0 00 002361* .push: confrm 10054 002366'01 263 17 0 00 000000 ret 10055 k20par - Kermit-20 Parsing and Semantic Action Routines MACRO %53B(1254)-4 19:41 30-Mar-24 Page 42 K20PAR MAC 29-Mar-24 20:39 RECEIVE command 10056 subttl RECEIVE command 10057 10058 chgsec(code,const) ;;Chained FDB's are not in code, they're in const 10059 000504'02 005005 000507' recfdb: flddb. .cmofi,cm%sdh,,,,recfd1 ;[231] 10060 000505'02 000000 000000 10061 000506'02 44 07 0 00 002301' 10062 000507'02 010005 000000 recfd1: flddb. .cmcfm,cm%sdh,, 10063 000510'02 000000 000000 10064 000511'02 44 07 0 00 002310' 10065 000512'02 010000 000000 reccfm: flddb. .cmcfm 10066 000513'02 000000 000000 10067 retsec ;;Back to where-ever we started from 10068 cleans() 10069 10070 ; Parse a filespec or just confirmation. 10071 10072 002367'01 200 16 0 00 000000# .recv: guide ; First, issue guide word. 10073 002370'01 260 17 0 00 002334* 10074 000514'02 000000000000# 10075 001141'04 151 156 164 157 040 10076 002371'01 201 01 0 00 000000# movei t1, recfdb 10077 002372'01 260 17 0 00 002336* call rfield ; Parse a file spec or a confirm. 10078 002373'01 135 03 0 00 005304' ldb t3, [pointr (.cmfnp(t3),cm%fnc)] ; Get function code. 10079 002374'01 302 03 0 00 000005 caie t3, .cmofi ; Is it an input file spec? 10080 002375'01 263 17 0 00 000000 ret ; If not it must be a confirm, so done. 10081 10082 002376'01 202 02 0 00 001445* movem t2, filjfn ; Filespec, so save the JFN, 10083 002377'01 201 01 0 00 000000# movei t1, reccfm ; and parse the confirmation. 10084 002400'01 260 17 0 00 000000* call rflde 10085 002401'01 254 00 0 00 002410' ifskp. ;[193] Confirmed! 10086 002402'01 550 01 0 00 002376* hrrz t1, filjfn ;[193] Load output file JFN 10087 002403'01 260 17 0 00 002245* call isnulj ;[193] Is it NUL:? 10088 002404'01 263 17 0 00 000000 ret ;[193] No, we're done 10089 002405'01 202 01 0 00 002402* movem t1, filjfn ;[193] Stomp in as JFN 10090 002406'01 200 02 0 00 000001 move t2, t1 ;[193] And also for anyone who wants it, downstream 10091 002407'01 263 17 0 00 000000 ret ;[193] Finally get out of here 10092 002410'01 endif. ;[193] End case .CMCFM 10093 10094 ; Parse error handler. 10095 10096 002410'01 337 01 0 00 002405* skipg t1, filjfn ; Release any JFN. 10097 002411'01 254 00 0 00 002416' ifskp. ;[193] Have...something 10098 002412'01 306 01 0 00 377777 cain t1, .nulio ;[193] Special NUL:? 10099 002413'01 254 00 0 00 002416' anskp. ;[193] Yes, that does not need releasing 10100 002414'01 104 00 0 00 000023 RLJFN% 10101 002415'01 320 12 0 00 002416' erjmpr .+1 ;[193] Retrieve and ignore any errors. 10102 002416'01 endif. ;[193] End case releasing a JFN 10103 002416'01 402 00 0 00 002410* setzm filjfn ; Zero the JFN to indicate we don't have one. 10104 002417'01 200 01 0 00 000000# emsg ;[187] Issue our own parse message 10105 002420'01 104 00 0 00 000313 10106 000515'02 000000000000# 10107 001143'04 116 157 164 040 143 10108 002421'01 254 00 0 00 002353* jrst cmder1 ; and get back inside CMD to clean up. 10109 k20par - Kermit-20 Parsing and Semantic Action Routines MACRO %53B(1254)-4 19:41 30-Mar-24 Page 43 K20PAR MAC 29-Mar-24 20:39 SHOW command parser 10110 subttl SHOW command parser 10111 10112 remark SHOW keyword table 10113 10114 ; All display routines moved to k20dsp 10115 10116 000516'02 000000 000000 %table(shotab) ;[39] (this whole keyword table) 10117 000517'02 000000# 000000 %key2 ,0 10118 000465'03 141 154 154 000 000 10119 000520'02 000000# 000000* %key2 ,$shday## ;[194] 10120 000466'03 144 141 171 164 151 10121 000521'02 000000# 000000* %key2 ,$shdeb## ;[194] 10122 000470'03 144 145 142 165 147 10123 000522'02 000000# 000000* %key2 ,$shfil## ;[194] 10124 000472'03 146 151 154 145 055 10125 000523'02 000000# 000000* %key2 ,$shinp## ;[160] ;[194] 10126 000474'03 151 156 160 165 164 10127 000524'02 000000# 000000* %key2 ,$shlin## ;[194] 10128 000477'03 154 151 156 145 000 10129 000525'02 000000# 000000* %key2 ,$shmac## ;[77] ;[194] 10130 000500'03 155 141 143 162 157 10131 000526'02 000000# 000000* %key2 ,$shpkt## ;[194] 10132 000502'03 160 141 143 153 145 10133 000527'02 000000# 000000* %keyf3 ,$stat##, cm%inv ;[186] Tom gets sleepy... 10134 000505'03 002000 000001 10135 000506'03 163 164 141 164 151 10136 000530'02 000000# 000000* %key2 ,$shtim## ;[194] 10137 000511'03 164 151 155 151 156 10138 000531'02 000000# 000000* %key2 ,$shver## ;[194] 10139 000514'03 166 145 162 163 151 10140 000516'02 000013 000013 %tbend 10141 10142 remark SHOW command parser 10143 10144 chgsec(code,const) ;;Chained FDB's are not in code, they're in const 10145 000532'02 000004 000535' shomac: flddb. .cmkey,,mactab,,,shofdb 10146 000533'02 000000000000# 10147 000534'02 44 07 0 00 002317' 10148 000535'02 000006 000541' shofdb: flddb. .cmkey,,shotab,,,shcnfm 10149 000536'02 000000 000516' 10150 000537'02 44 07 0 00 002321' 10151 000540'02 44 07 0 00 002324' 10152 000541'02 010004 000000 shcnfm: flddb. .cmcfm,,, ;[201] Macros and allow confirm 10153 000542'02 000000 000000 10154 000543'02 44 07 0 00 002325' 10155 retsec ;;Back to where-ever we started from 10156 cleans() 10157 10158 002422'01 554 04 0 00 000000* .show: hlrz t4, mactab ;[201] Load count of items (macros) in table 10159 002423'01 326 04 0 00 002430' ife. t4 ;[201] No macros defined? 10160 002424'01 200 16 0 00 000000# guide ; SHOW command 10161 002425'01 260 17 0 00 002370* 10162 000544'02 000000000000# 10163 001146'04 160 141 162 141 155 10164 002426'01 201 01 0 00 000000# movei t1, shofdb ;[201] Just show parameter table k20par - Kermit-20 Parsing and Semantic Action Routines MACRO %53B(1254)-4 19:41 30-Mar-24 Page 43-1 K20PAR MAC 29-Mar-24 20:39 SHOW command parser 10165 002427'01 254 00 0 00 002433' else. ;[201] Otherwise, could select a macro 10166 002430'01 200 16 0 00 000000# guide ;[201] 10167 002431'01 260 17 0 00 002425* 10168 000545'02 000000000000# 10169 001151'04 160 141 162 141 155 10170 002432'01 201 01 0 00 000000# movei t1, shomac ;[201] Either macro or parameter 10171 002433'01 endif. ;[201] 10172 002433'01 260 17 0 00 002372* call rfield ;[201] Try to parse something 10173 002434'01 135 04 0 00 005304' ldb t4, [pointr (.cmfnp(t3),cm%fnc)] ;[201] Get function code. 10174 002435'01 302 04 0 00 000010 caie t4, .cmcfm ;[201] Was this a confirm? 10175 002436'01 254 00 0 00 002443' ifskp. ;[201] It was, so 10176 002437'01 400 02 0 00 000000 setz t2, ;[201] Load talisman for all 10177 002440'01 124 02 0 00 001666* dmovem t2, pars2 ;[201] Save tweaked parse results 10178 002441'01 202 04 0 00 002354* movem t4, pars4 ;[201] Also the function code 10179 002442'01 254 00 0 00 002446' else. ;[201] No, so tie off the line 10180 002443'01 124 02 0 00 002440* dmovem t2, pars2 ;[201] Save raw parse results 10181 002444'01 202 04 0 00 002441* movem t4, pars4 ;[201] Also the function code 10182 002445'01 260 17 0 00 002365* confrm ;[201] Does not modify t1, t2, t3, t4 10183 002446'01 endif. ;[201] End case line not confirmed 10184 10185 002446'01 263 17 0 00 000000 ret 10186 k20par - Kermit-20 Parsing and Semantic Action Routines MACRO %53B(1254)-4 19:41 30-Mar-24 Page 44 K20PAR MAC 29-Mar-24 20:39 SHOW command semantic action driver 10187 subttl SHOW command semantic action driver 10188 10189 002447'01 474 01 0 00 000000 $show: seto t1, ;[201] Assume showing macros 10190 002450'01 120 02 0 00 002443* dmove t2, pars2 ;[201] Load raw (or tweaked) results 10191 002451'01 200 04 0 00 002444* move t4, pars4 ;[201] and the function code 10192 10193 002452'01 302 04 0 00 000010 caie t4, .cmcfm ;[201] Just a confirm? 10194 002453'01 254 00 0 00 002456' ifskp. ;[201] Yes, phony that up 10195 002454'01 403 01 0 00 000002 setzb t1, t2 ;[201] Say a keyword from parameter table 10196 002455'01 254 00 0 00 002463' else. ;[201] No, let's look a little further 10197 002456'01 621 03 0 00 777777 tlz t3, -1 ;[201] Stomp given address 10198 002457'01 302 03 0 00 000000# caie t3, shofdb ;[201] Wanted to show a parameter? 10199 002460'01 254 00 0 00 002463' anskp. ;[201] No, a macro 10200 002461'01 550 02 0 02 000000 hrrz t2, (t2) ;[201] Pick up the key table entry data 10201 002462'01 400 01 0 00 000000 setz t1, ;[201] Flag that it is a parameter 10202 002463'01 endif. ;[201] End case keyword table decode 10203 10204 002463'01 326 01 0 00 002473' ife. t1 ;[201] Was this a parameter? 10205 002464'01 326 02 0 00 002467' ife. t2 ;[201] All (or confirm)? 10206 002465'01 515 05 0 00 600000 hrlzi q1,() ;[201] Never return from each one 10207 002466'01 254 00 0 00 000000* callret $shtop## ;[201] Start from the top and do all 10208 002467'01 endif. ;[201] End case All or Confirm 10209 002467'01 200 05 0 00 005316' move q1, [ret] ;[201] A single item, so return after it 10210 002470'01 561 01 0 00 001611* hrroi t1, crlf ;[39] Single SHOW item. 10211 002471'01 104 00 0 00 000076 PSOUT% ;[201] Emit blank line, 10212 002472'01 254 00 0 02 000000 jrst (t2) ;[39] then go show the requested stuff. 10213 002473'01 endif. ;[201] 10214 10215 002473'01 200 01 0 00 000000# txmsg < > ;[201] Space over twice 10216 002474'01 104 00 0 00 000076 10217 002475'01 320 12 0 00 002476' 10218 000546'02 000000000000# 10219 001155'04 040 040 000 000 000 10220 002476'01 564 01 0 02 000000 hlro t1, (t2) ;[201] Point to macro name. 10221 002477'01 104 00 0 00 000076 PSOUT% ;[201] Print it. 10222 002500'01 200 01 0 00 000000# txmsg < = > ;[201] Show equivalence 10223 002501'01 104 00 0 00 000076 10224 002502'01 320 12 0 00 002503' 10225 000547'02 000000000000# 10226 001156'04 040 075 040 000 000 10227 002503'01 560 01 0 02 000000 hrro t1, (t2) ;[201] Point to body of macro 10228 002504'01 104 00 0 00 000076 PSOUT% ;[201] Print that 10229 002505'01 260 17 0 00 000000* call ifcrlf ;[201] Maybe do a CRLF 10230 10231 002506'01 263 17 0 00 000000 ret ;[201] Finally done 10232 k20par - Kermit-20 Parsing and Semantic Action Routines MACRO %53B(1254)-4 19:41 30-Mar-24 Page 45 K20PAR MAC 29-Mar-24 20:39 TAKE command parsing 10233 subttl TAKE command parsing 10234 10235 ; Default command filespec fields for .CMFIL: 10236 10237 chgsec(code,const) ;;FDB's are not in code, they're in const 10238 000550'02 100000 000000 defbk: gj%old ; Must be existing file. 10239 repeat 4,<0> ; Normal defaults for dev:name. 10240 000551'02 000000 000000 10241 000552'02 000000 000000 10242 000553'02 000000 000000 10243 000554'02 000000 000000 10244 000555'02 000000000000# cascii () ; Default extension is .CMD. 10245 001157'04 103 115 104 000 000 10246 000556'02 000000000000# 0 ; Default protection, 10247 000557'02 000000 000000 0 ; and account. 10248 000010 defbkl==<.-defbk> ; Length of this GTJFN argument block. 10249 10250 000560'02 006000 000000 takfdb: flddb. .cmfil 10251 000561'02 000000 000000 10252 retsec ;;Back to where-ever we started from 10253 10254 002507'01 200 01 0 00 005447' .take: movx t1, cz%ncl!.fhslf ; Release non-open jfn's. 10255 002510'01 104 00 0 00 000034 CLZFF 10256 002511'01 200 16 0 00 000000# guide 10257 002512'01 260 17 0 00 002431* 10258 000562'02 000000000000# 10259 001160'04 143 157 155 155 141 10260 002513'01 200 01 0 00 005450' move t1, [defbk,,cjfnbk] ; Insert our file parsing defaults. 10261 002514'01 251 01 0 00 000000# blt t1, cjfnbk+defbkl 10262 002515'01 201 01 0 00 000000# movei t1, takfdb 10263 002516'01 260 17 0 00 001474* call cfield 10264 002517'01 202 02 0 00 002450* movem t2, pars2 ; Here's the JFN just parsed. 10265 002520'01 263 17 0 00 000000 ret 10266 k20par - Kermit-20 Parsing and Semantic Action Routines MACRO %53B(1254)-4 19:41 30-Mar-24 Page 46 K20PAR MAC 29-Mar-24 20:39 TAKE command semantic action 10267 subttl TAKE command semantic action 10268 10269 ; added as edit 78. 10270 10271 002521'01 200 01 0 00 000075* $take: move t1, takdep ; How deep are we? 10272 002522'01 307 01 0 00 000024 caig t1, takel ;[194] Too deep? 10273 002523'01 254 00 0 00 002527' ifskp. ;[194] Indeed 10274 002524'01 200 01 0 00 000000# emsg ;[187] 10275 002525'01 104 00 0 00 000313 10276 000563'02 000000000000# 10277 001164'04 124 101 113 105 040 10278 002526'01 263 17 0 00 000000 ret ;[194] don't do it. 10279 002527'01 endif. ;[194] 10280 002527'01 200 01 0 00 000103* move t1, takjfn ; There's room, get current TAKE file jfn. 10281 002530'01 200 02 0 00 000000* move t2, takep ; Push it on the stack 10282 002531'01 261 02 0 00 000001 push t2, t1 ; ... 10283 002532'01 202 02 0 00 002530* movem t2, takep ; ... 10284 002533'01 350 00 0 00 002521* aos takdep ; Remember what level we're on. 10285 10286 002534'01 200 01 0 00 002517* move t1, pars2 ; Get JFN that was parsed 10287 002535'01 202 01 0 00 002527* movem t1, takjfn ; ... 10288 002536'01 200 02 0 00 005451' movx t2, fld(7,of%bsz)!of%rd ; 7-bit i/o, read access. 10289 002537'01 104 00 0 00 000021 OPENF 10290 002540'01 320 12 0 00 002542' %jserr (,$takex) 10291 002541'01 254 00 0 00 002545' 10292 002542'01 265 01 0 00 002305* 10293 002543'01 000000 000000 10294 002544'01 254 00 0 00 002546' 10295 002545'01 254 00 0 00 000000* callret setcsb ; Opened OK, go set up command state block. 10296 10297 ; Error opening command file. 10298 10299 002546'01 260 17 0 00 002560' $takex: call popjfn ; Remove offending JFN from TAKE stack. 10300 002547'01 604 00 0 00 000000 ifnsk. ;[194] 10301 002550'01 254 00 0 00 002554' 10302 002551'01 200 01 0 00 000000# emsg ;[187] 10303 002552'01 104 00 0 00 000313 10304 000564'02 000000000000# 10305 001173'04 124 101 113 105 040 10306 002553'01 263 17 0 00 000000 ret 10307 002554'01 endif. ;[194] 10308 10309 002554'01 200 01 0 00 005447' movx t1, cz%ncl!.fhslf ; Release extraneous JFNs. 10310 002555'01 104 00 0 00 000034 CLZFF 10311 002556'01 320 16 0 00 002557' erjmp .+1 10312 002557'01 263 17 0 00 000000 ret 10313 k20par - Kermit-20 Parsing and Semantic Action Routines MACRO %53B(1254)-4 19:41 30-Mar-24 Page 47 K20PAR MAC 29-Mar-24 20:39 POPJFN 10314 subttl POPJFN 10315 10316 ; Routine to pop a command file JFN off the JFN stack. 10317 ; 10318 ; Enter with current command file jfn in TAKJFN. 10319 ; 10320 ; Returns: 10321 ; +1 if stack empty, 10322 ; +2 otherwise, with popped jfn in TAKJFN. 10323 10324 002560'01 popjfn: entry popjfn ; Also found in K20IOC 10325 002560'01 337 00 0 00 002533* skipg takdep ; Back at top level? 10326 002561'01 263 17 0 00 000000 ret ; Yes, return silently. 10327 10328 ; Close current command file. 10329 10330 002562'01 337 01 0 00 002535* skipg t1, takjfn ;[209] Load the JFN (if there is one) 10331 002563'01 254 00 0 00 002576' ifskp. ;[209] There is, so let's get on with it 10332 002564'01 402 00 0 00 002562* setzm takjfn ;[209] Stomp it, no matter what 10333 002565'01 621 01 0 00 777777 tlz t1, -1 ;[209] Whack any flags 10334 002566'01 306 01 0 00 377777 cain t1, .nulio ;[209] This kind of confusion?? 10335 002567'01 254 00 0 00 002576' anskp. ;[209] Actually, yes, so don't bother 10336 002570'01 104 00 0 00 000022 CLOSF ;[209] Real enough; close it 10337 002571'01 320 12 0 00 002573' %jserr (,) ; Just print message on error. 10338 002572'01 254 00 0 00 002576' 10339 002573'01 265 01 0 00 002542* 10340 002574'01 000000 000000 10341 002575'01 254 00 0 00 002576' 10342 002576'01 endif. ;[209] Either way, carry on 10343 10344 ; Return to previous one. 10345 10346 002576'01 200 02 0 00 002532* move t2, takep ; Get the TAKE stack pointer 10347 002577'01 262 02 0 00 000001 pop t2, t1 ; and the previous TAKE file JFN, 10348 002600'01 202 02 0 00 002576* movem t2, takep ; restore them, 10349 002601'01 202 01 0 00 002564* movem t1, takjfn ; ... 10350 002602'01 260 17 0 00 002545* call setcsb ; and also restore the command state block. 10351 002603'01 370 00 0 00 002560* sos takdep ; Decrement the depth indicator 10352 002604'01 254 00 0 00 002332* retskp ; Return successfully. 10353 10354 k20par - Kermit-20 Parsing and Semantic Action Routines MACRO %53B(1254)-4 19:41 30-Mar-24 Page 48 K20PAR MAC 29-Mar-24 20:39 Process initialization file. 10355 subttl Process initialization file. 10356 10357 ;[79] INIFIL added 10358 ; 10359 ;[85] Returns +1 if there was no init file, +2 if there was. 10360 ; 10361 ;[220] Rewritten to not assume PS: is the login structure 10362 ; Also unrolled the loop (prior to maybe redoing with movslj) 10363 10364 remark 1 2 3 4 5 10365 002605'01 456132 246622 kerini: byte (7) "K","E","R","M","I" 10366 002606'01 521351 147222 byte (7) "T",".","I","N","I" 10367 10368 002607'01 inifil: entry inifil ;[220] Invoked by k20mit 10369 002607'01 265 16 0 00 005321' saveac ;[220] Needs an index variable 10370 002610'01 265 16 0 00 000000* anstkv (q1,dirmxw) ;[220] Allocate space for login directory 10371 002611'01 000000 000012 10372 002612'01 415 05 0 17 777765 10373 10374 002613'01 560 01 0 00 000005 hrro t1, q1 ;[220] Build Tops-20 pointer to stack 10375 002614'01 200 02 0 00 000000# move t2, .jilno+jobtab ;[220] Job's logged in directory number 10376 002615'01 104 00 0 00 000041 DIRST% ;[220] Build the entire directory 10377 002616'01 320 12 0 00 002620' %jserr (,r) ;[220] Punt 10378 002617'01 254 00 0 00 002623' 10379 002620'01 265 01 0 00 002573* 10380 002621'01 000000000000# 10381 002622'01 254 00 0 00 002307* 10382 001201'04 125 156 141 142 154 10383 10384 002623'01 120 03 0 00 002605' dmove t3, kerini ;[220] Load file name 10385 repeat ^d5,< ;;[220] Do the first word 10386 lshc t2, ^d7 ;;[220] Load a character in t2 10387 idpb t2, t1 ;;[220] Append to directory specification 10388 > ;;[220] End of first word 10389 002624'01 246 02 0 00 000007 10390 002625'01 136 02 0 00 000001 10391 002626'01 246 02 0 00 000007 10392 002627'01 136 02 0 00 000001 10393 002630'01 246 02 0 00 000007 10394 002631'01 136 02 0 00 000001 10395 002632'01 246 02 0 00 000007 10396 002633'01 136 02 0 00 000001 10397 002634'01 246 02 0 00 000007 10398 002635'01 136 02 0 00 000001 10399 10400 repeat ^d5,< ;;[220] Do the second word 10401 lshc t3, ^d7 ;;[220] Load a character in t3 10402 idpb t3, t1 ;;[220] Append to directory specification 10403 > ;;[220] End of first word 10404 002636'01 246 03 0 00 000007 10405 002637'01 136 03 0 00 000001 10406 002640'01 246 03 0 00 000007 10407 002641'01 136 03 0 00 000001 10408 002642'01 246 03 0 00 000007 10409 002643'01 136 03 0 00 000001 k20par - Kermit-20 Parsing and Semantic Action Routines MACRO %53B(1254)-4 19:41 30-Mar-24 Page 48-1 K20PAR MAC 29-Mar-24 20:39 Process initialization file. 10410 002644'01 246 03 0 00 000007 10411 002645'01 136 03 0 00 000001 10412 002646'01 246 03 0 00 000007 10413 002647'01 136 03 0 00 000001 10414 10415 002650'01 400 03 0 00 000000 setz t3, ;[220] Cons up a zero 10416 002651'01 136 03 0 00 000001 idpb t3, t1 ;[220] Tie off the file specification 10417 10418 002652'01 205 01 0 00 100001 movx t1, gj%old!gj%sht ;[220] Existing file, only 10419 002653'01 560 02 0 00 000005 hrro t2, q1 ;[220] Build Tops-20 pointer to completed specification 10420 002654'01 104 00 0 00 000020 GTJFN% ;[220] Get JFN on it. 10421 002655'01 320 12 0 00 002622* erjmpr r ;[220] If we can't, return silently. 10422 002656'01 552 01 0 00 002534* hrrzm t1, pars2 ; Got one, pretend we parsed it. 10423 002657'01 476 00 0 00 000000* setom iniflg ;[83] Flag that we're doing init file. 10424 002660'01 260 17 0 00 002521' call $take ; Go TAKE the file. 10425 002661'01 254 00 0 00 002604* retskp ;[85] 10426 k20par - Kermit-20 Parsing and Semantic Action Routines MACRO %53B(1254)-4 19:41 30-Mar-24 Page 49 K20PAR MAC 29-Mar-24 20:39 SEND command 10427 subttl SEND command 10428 10429 chgsec(code,const) ;;Chained FDB's are not in code, they're in const 10430 000565'02 006004 000000 sndfdb: flddb. .cmfil,,,,, 10431 000566'02 000000 000000 10432 000567'02 44 07 0 00 002332' 10433 000570'02 010004 000573' sasfdb: flddb. .cmcfm,,,,,sasfd1 10434 000571'02 000000 000000 10435 000572'02 44 07 0 00 002341' 10436 000573'02 021004 000576' sasfd1: flddb. .cmqst,,,,,sasfd2 10437 000574'02 000000 000000 10438 000575'02 44 07 0 00 002346' 10439 000576'02 017004 000000 sasfd2: flddb. .cmtxt,,, 10440 000577'02 000000 000000 10441 000600'02 44 07 0 00 002346' 10442 000601'02 010004 000604' saifdb: flddb. .cmcfm,,,,,saifd1 10443 000602'02 000000 000000 10444 000603'02 44 07 0 00 002360' 10445 000604'02 006004 000000 saifd1: flddb. .cmfil,,, 10446 000605'02 000000 000000 10447 000606'02 44 07 0 00 002364' 10448 000607'02 010000 000000 sndcfm: flddb. .cmcfm 10449 000610'02 000000 000000 10450 retsec ;;Back to where-ever we started from 10451 cleans() 10452 10453 002662'01 200 16 0 00 000000# .send: guide ; Issue guide words. 10454 002663'01 260 17 0 00 002512* 10455 000611'02 000000000000# 10456 001211'04 146 162 157 155 040 10457 002664'01 200 02 0 00 000000# move t2, cjfnbk+.gjgen ; Get the JFN flag bits. 10458 002665'01 661 02 0 00 100100 txo t2, gj%ifg!gj%old ; Old file(s), allow wild cards. 10459 002666'01 620 02 0 00 777777 trz t2, -1 ;[172] Default to most recent generation only. 10460 002667'01 202 02 0 00 000000# movem t2, cjfnbk+.gjgen ; Return the JFN flag bits. 10461 002670'01 402 00 0 00 000000# setzm cjfnbk+.gjext ;[172] No default extension. 10462 10463 002671'01 201 01 0 00 000000# movei t1, sndfdb 10464 002672'01 260 17 0 00 002433* call rfield ; Parse a file spec or a confirm. 10465 002673'01 200 01 0 00 000002 move t1, t2 ;[193] Position the JFN 10466 002674'01 260 17 0 00 002403* call isnulj ;[193] Find out if it's NUL: 10467 002675'01 600 00 0 00 000000 nop ;[193] No, it isn't, but we don't care 10468 002676'01 202 01 0 00 002656* movem t1, pars2 ;[193] 10469 10470 002677'01 603 01 0 00 770000 ifxe. t1, gj%wld ;[193] Any wildcards in it? 10471 002700'01 254 00 0 00 002705' 10472 002701'01 200 16 0 00 000000# guide ;[96] No, then let them choose a new name. 10473 002702'01 260 17 0 00 002663* 10474 000612'02 000000000000# 10475 001214'04 141 163 000 000 000 10476 002703'01 201 01 0 00 000000# movei t1, sasfdb 10477 002704'01 254 00 0 00 002710' else. ;[194] Otherwise, something was wildcarded 10478 002705'01 200 16 0 00 000000# guide ; prompt for initial. 10479 002706'01 260 17 0 00 002702* 10480 000613'02 000000000000# 10481 001215'04 151 156 151 164 151 k20par - Kermit-20 Parsing and Semantic Action Routines MACRO %53B(1254)-4 19:41 30-Mar-24 Page 49-1 K20PAR MAC 29-Mar-24 20:39 SEND command 10482 002707'01 201 01 0 00 000000# movei t1, saifdb 10483 002710'01 endif. ;[194] 10484 10485 002710'01 260 17 0 00 002400* call rflde ; Parse the field. 10486 002711'01 254 00 0 00 002745' jrst .sende ;[63] Handle errors explicitly. 10487 002712'01 135 03 0 00 005304' ldb t3, [pointr (.cmfnp(t3),cm%fnc)] ; Get function code. 10488 002713'01 306 03 0 00 000021 cain t3, .cmqst ;[208] Quoted string? 10489 002714'01 201 03 0 00 000017 movei t3, .cmtxt ;[208] Pretend it's text (because it is) 10490 002715'01 202 03 0 00 002250* movem t3, pars3 ;[96] Save it for execution. 10491 10492 002716'01 306 03 0 00 000010 cain t3, .cmcfm ; Confirmation? 10493 002717'01 263 17 0 00 000000 ret ; Yes, just return. 10494 10495 002720'01 302 03 0 00 000006 caie t3, .cmfil ;[96] File? 10496 002721'01 254 00 0 00 002733' ifskp. ;[194] Yes 10497 002722'01 200 01 0 00 000002 move t1, t2 ;[193] Position the JFN 10498 002723'01 260 17 0 00 002674* call isnulj ;[193] Find out if it's NUL: 10499 002724'01 334 00 0 00 000000 skipa ;[193] No, it isn't, but we don't care 10500 002725'01 200 02 0 00 000001 move t2, t1 ;[193] Reposition so stored properly 10501 002726'01 542 02 0 00 002676* hrrm t2, pars2 ;[117] Initial filespec - substitute it. 10502 002727'01 201 01 0 00 000000# movei t1, sndcfm ; Get command confirmation. 10503 002730'01 260 17 0 00 002710* call rflde 10504 002731'01 254 00 0 00 002745' jrst .sende ;[194] Didn't confirm, parse error 10505 002732'01 263 17 0 00 000000 ret 10506 002733'01 endif. ;[194] 10507 10508 ;[96] If they gave an alternate name, copy it out of the atom buffer. 10509 10510 002733'01 302 03 0 00 000017 caie t3, .cmtxt ; Text? 10511 002734'01 254 00 0 00 002745' jrst .sende ; No, error. 10512 ; Copy the string out of the atom buffer. 10513 dmove t1, [point 7, atmbuf 10514 002735'01 120 01 0 00 005452' point 7, buffer] 10515 002736'01 402 00 0 00 001467* setzm buffer 10516 002737'01 260 17 0 00 000000* call movstu 10517 002740'01 326 03 0 00 002743' ife. t3 ;[194] If nothing, act like we parsed a confirm. 10518 002741'01 201 03 0 00 000010 movei t3, .cmcfm 10519 002742'01 202 03 0 00 002715* movem t3, pars3 10520 002743'01 endif. ;[194] 10521 002743'01 260 17 0 00 002445* confrm ;[208] And tie off the line 10522 002744'01 263 17 0 00 000000 ret 10523 10524 002745'01 333 01 0 00 002416* .sende: skiple t1, filjfn ;[194] Error - get the JFN. 10525 002746'01 104 00 0 00 000023 RLJFN% ; Release it. 10526 002747'01 320 12 0 00 002750' erjmpr .+1 ;[194] Catch and ignore any errors. 10527 002750'01 402 00 0 00 002745* setzm filjfn ; Nullify the JFN. 10528 002751'01 200 01 0 00 000000# emsg 10529 002752'01 104 00 0 00 000313 10530 000614'02 000000000000# 10531 001217'04 116 157 164 040 143 10532 002753'01 254 00 0 00 002421* jrst cmder1 10533 k20par - Kermit-20 Parsing and Semantic Action Routines MACRO %53B(1254)-4 19:41 30-Mar-24 Page 50 K20PAR MAC 29-Mar-24 20:39 SERVER command 10534 subttl SERVER command 10535 10536 002754'01 260 17 0 00 002743* .serve: confrm ; Confirm. 10537 002755'01 263 17 0 00 000000 ret 10538 10539 remark Execute the SERVER command. 10540 10541 ;[144] Remove test for remote mode operation. KERMIT-20 works fine as 10542 ; a server over an assigned line, although the messages may look a bit 10543 ; strange. 10544 10545 002756'01 $serve: extern getcom 10546 002756'01 260 17 0 00 000000* call getcom ; Go serve. 10547 ;[137] setzm f$exit ;[110] Return to command mode if they ^C out. 10548 002757'01 263 17 0 00 000000 ret 10549 k20par - Kermit-20 Parsing and Semantic Action Routines MACRO %53B(1254)-4 19:41 30-Mar-24 Page 51 K20PAR MAC 29-Mar-24 20:39 CONNECT command, kind of like SET LINE 10550 subttl CONNECT command, kind of like SET LINE 10551 10552 remark CONNECT Parsing tables and function descriptor blocks 10553 10554 ;N.B., Remove abbreviation if we ever do pipes 10555 10556 000615'02 000000 000000 %table(pseutb) ;[186] 10557 000616'02 000000# 000617' %keyf3

, %pseud, 10558 000516'03 002000 000005 10559 000517'03 160 000 000 000 000 10560 ; %key2 , .dvpip ;[186] Loopback to same job (subfork) 10561 000617'02 000000# 000013 %pseud: %key2 , .dvpty ;[186] Loopback to another job 10562 000520'03 160 163 145 165 144 10563 000620'02 000000# 000013 %keyf3 , .dvpty, cm%inv ;[186] another way of saying pseudo 10564 000524'03 002000 000001 10565 000525'03 160 164 171 000 000 10566 000615'02 000003 000003 %tbend ;[186] 10567 10568 cleans(<%pseud>) ;;Clean up working symbol 10569 10570 000621'02 000000 000000 %table(mantab) ;[205] 10571 000622'02 000000# 000015 %key2 ,.dvnul ;[205] Close open connection (if open) 10572 000526'03 143 154 157 163 145 10573 000623'02 000000# 777774 %key2 ,.fhinf ;[205] Clobber terminal fork 10574 000530'03 153 151 154 154 000 10575 000621'02 000002 000002 %tbend ;[205] 10576 10577 000624'02 000000 000000 %table(conswi) ;[205] 10578 000625'02 000000# 000000# %key2 ,swifrk ;[236] Wants Tops-20 to handle NRT 10579 000531'03 146 157 162 153 154 10580 000626'02 000000# 000000# %key2 ,swista ;[205] Don't create (or resume) transfer fork 10581 000533'03 163 164 141 171 000 10582 000627'02 000000# 000632' %keyf3 , %tim, ;[218] 10583 000534'03 002000 000005 10584 000535'03 164 000 000 000 000 10585 000630'02 000000# 000632' %keyf3 , %tim, ;[218] 10586 000536'03 002000 000005 10587 000537'03 164 151 000 000 000 10588 000631'02 000000# 000632' %keyf3 , %tim, ;[218] 10589 000540'03 002000 000005 10590 000541'03 164 151 155 000 000 10591 000632'02 000000# 000000# %tim: %key2 ,switim ;[218] Override default timeout 10592 000542'03 164 151 155 145 157 10593 000633'02 000000# 000000# %keyf3 ,switim, cm%inv ;[218] Another way I mistype this 10594 000544'03 002000 000001 10595 000545'03 164 151 155 157 165 10596 000624'02 000007 000007 %tbend ;[205] 10597 10598 cleans(<%tim>) ;;Clean up working symbol 10599 10600 chgsec(code,const) ;;Chained FDB's are not in code, they're in const 10601 000634'02 001004 000637' confdb: flddb. .cmnum,,^d8,,,confd1 10602 000635'02 000000 000010 10603 000636'02 44 07 0 00 002373' 10604 000637'02 000004 000642' confd1: flddb. .cmkey,,pseutb,,,confd2 k20par - Kermit-20 Parsing and Semantic Action Routines MACRO %53B(1254)-4 19:41 30-Mar-24 Page 51-1 K20PAR MAC 29-Mar-24 20:39 CONNECT command, kind of like SET LINE 10605 000640'02 000000 000615' 10606 000641'02 44 07 0 00 002403' 10607 000642'02 000004 000645' confd2: flddb. .cmkey,,mantab,,,confd3 10608 000643'02 000000 000621' 10609 000644'02 44 07 0 00 002412' 10610 000645'02 026044 000650' confd3: flddb. .cmnod,cm%nsf,,,,confd4 10611 000646'02 000000 000000 10612 000647'02 44 07 0 00 002420' 10613 000650'02 010004 000000 confd4: flddb. .cmcfm,,, 10614 000651'02 000000 000000 10615 000652'02 44 07 0 00 002425' 10616 000653'02 003000 000655' cswfdb: flddb. .cmswi,,conswi,,,cswfd1 10617 000654'02 000000 000624' 10618 000655'02 010004 000000 cswfd1: flddb. .cmcfm,,, ;[218] 10619 000656'02 000000 000000 10620 000657'02 44 07 0 00 002435' 10621 000660'02 013005 000663' scmfdb: flddb. .cmcma,cm%sdh,,,,scmfd1 10622 000661'02 000000 000000 10623 000662'02 44 07 0 00 002443' 10624 000663'02 010000 000000 scmfd1: flddb. .cmcfm 10625 000664'02 000000 000000 10626 retsec ;;Back to where-ever we started from 10627 cleans() 10628 k20par - Kermit-20 Parsing and Semantic Action Routines MACRO %53B(1254)-4 19:41 30-Mar-24 Page 52 K20PAR MAC 29-Mar-24 20:39 CONNECT command parsing Switch 10629 SUBTTL CONNECT command parsing Switch 10630 10631 002760'01 swista: REMARK ;[205] Parse for /STAY 10632 002760'01 476 00 0 00 001152* setom pars5 ;[205] Flag connection to stay at Kermit command level 10633 002761'01 263 17 0 00 000000 ret ;[205] That's easy enough 10634 10635 10636 002762'01 swifrk: REMARK ;[236] Parse for /FORKLESS 10637 002762'01 476 00 0 00 001252* setom pars7 ;[236] Flag that we're doing .MOSNH 10638 002763'01 263 17 0 00 000000 ret ;[236] Go parse something else worthwhile 10639 10640 10641 002764'01 switim: REMARK ;[218] Parse for /TIMEOUT 10642 002764'01 265 16 0 00 005454' saveac ;[218] Needs some registers 10643 002765'01 120 05 0 00 002451* dmove q1, pars4 ;[218] Save whatever might already be parsed 10644 002766'01 200 07 0 00 002345* move q3, definf ;[218] Save the define context 10645 002767'01 476 00 0 00 002766* setom definf ;[218] Stomp, so it doesn't parse a confirm 10646 002770'01 260 17 0 00 005126' call .setim ;[218] Parse a floating point time 10647 002771'01 200 01 0 00 002765* move t1, pars4 ;[218] Load computed milliseconds 10648 002772'01 202 01 0 00 001215* movem t1, pars6 ;[218] Hand it off to waitcn 10649 002773'01 124 05 0 00 002771* dmovem q1, pars4 ;[218] Store what might allready be parsed 10650 002774'01 202 07 0 00 002767* movem q3, definf ;[218] Restore whatever the define context was 10651 002775'01 263 17 0 00 000000 ret ;[218] Return, restoring parsing context 10652 k20par - Kermit-20 Parsing and Semantic Action Routines MACRO %53B(1254)-4 19:41 30-Mar-24 Page 53 K20PAR MAC 29-Mar-24 20:39 CONNECT command parsing Switch 10653 REMARK CONNECT command main parsing 10654 10655 002776'01 476 00 0 00 002742* .conne: setom pars3 ;[186] Let's assume parsing fails 10656 002777'01 476 00 0 00 002773* setom pars4 ;[186] Fails completely, actually 10657 003000'01 402 00 0 00 002760* setzm pars5 ;[205] Assume will connect immediately 10658 003001'01 402 00 0 00 002772* setzm pars6 ;[218] Assume not overriding timeout 10659 003002'01 402 00 0 00 002762* setzm pars7 ;[236] Assume not using MTOPR%'s .MOSNH 10660 10661 003003'01 200 16 0 00 000000# guide 10662 003004'01 260 17 0 00 002706* 10663 000665'02 000000000000# 10664 001222'04 164 157 040 164 164 10665 remark ;[205] Don't reorder the flddb.'s! 10666 003005'01 201 01 0 00 000000# movei t1, confdb 10667 003006'01 260 17 0 00 002672* call rfield ;[205] Parse a tty number (or something...) 10668 003007'01 135 04 0 00 005304' ldb t4, [pointr (.cmfnp(t3),cm%fnc)] ; Get function code. 10669 10670 003010'01 265 16 0 00 005367' .conn1: saveac ;[205] Needs another temporary 10671 003011'01 265 16 0 00 002610* anstkv (q2,^d4) ;[205] Copy of node name, if parsed 10672 003012'01 000000 000004 10673 003013'01 415 06 0 17 777773 10674 10675 003014'01 306 04 0 00 000000 cain t4, .cmkey ;[186] Any kind of keyword has a device type 10676 003015'01 550 05 0 02 000000 hrrz t5, (t2) ;[186] Get the requested device type 10677 003016'01 306 04 0 00 000026 cain t4, .cmnod ;[186] Parsed a node? 10678 003017'01 201 05 0 00 000022 movei t5, .dvdcn ;[186] Force DECnet client 10679 003020'01 306 04 0 00 000001 cain t4, .cmnum ;[186] Is it a number? 10680 003021'01 200 05 0 00 000002 move t5, t2 ;[186] Put in the terminal line number 10681 10682 003022'01 302 04 0 00 000010 caie t4, .cmcfm ;[186] Just gave us a confirm? 10683 003023'01 254 00 0 00 003026' ifskp. ;[186] That's fine, means reconnect 10684 003024'01 124 04 0 00 002776* dmovem t4, pars3 ;[186] Store parse type and device type or unit 10685 003025'01 263 17 0 00 000000 ret ;[186] Done with parse 10686 003026'01 endif. 10687 003026'01 332 00 0 00 002774* skipe definf ;[205] Not in a DEFINE? 10688 003027'01 254 00 0 00 003053' jrst .conn2 ;[205] No, we are; so go get cute with that 10689 ;[205] Store 20 characters of atom buffer 10690 003030'01 120 01 0 00 002132* dmove t1, atmbuf ;[205] Load first ten characters of the atom buffer 10691 003031'01 124 01 0 06 000000 dmovem t1, 0(q2) ;[205] Tuck them away 10692 003032'01 120 01 0 00 000000# dmove t1, atmbuf+2 ;[205] Next ten characters of the atom buffer 10693 003033'01 124 01 0 06 000002 dmovem t1, 2(q2) ;[205] Tuck those away 10694 10695 003034'01 do. ;[218] Enter loop context to parse switches 10696 003034'01 201 01 0 00 000000# movei t1, cswfdb 10697 003035'01 260 17 0 00 003006* call rfield ;[218] Parse something 10698 003036'01 135 03 0 00 005304' ldb t3, [pointr (.cmfnp(t3),cm%fnc)] ; Get function code. 10699 003037'01 306 03 0 00 000010 cain t3, .cmcfm ;[218] Finally confirmed? 10700 003040'01 254 00 0 00 003044' exit. ;[218] Yes, break out of the loop 10701 003041'01 550 01 0 02 000000 hrrz t1, (t2) ;[236] Pick up the switch parsing routine 10702 003042'01 260 17 0 01 000000 call (t1) ;[236] Go parse some more 10703 003043'01 254 00 0 00 003034' loop. ;[218] And go around for more switchs 10704 003044'01 enddo. ;[218] End of loop lexical context 10705 10706 003044'01 120 01 0 06 000000 dmove t1, 0(q2) ;[205] Load ten characters of the saved atom buffer 10707 003045'01 124 01 0 00 003030* dmovem t1, atmbuf ;[205] And put them back k20par - Kermit-20 Parsing and Semantic Action Routines MACRO %53B(1254)-4 19:41 30-Mar-24 Page 53-1 K20PAR MAC 29-Mar-24 20:39 CONNECT command parsing Switch 10708 003046'01 120 01 0 06 000002 dmove t1, 2(q2) ;[205] Next ten characters of the saved atom buffer 10709 003047'01 124 01 0 00 000000# dmovem t1, atmbuf+2 ;[205] And put those back 10710 003050'01 402 00 0 00 000000# setzm atmbuf+5 ;[205] Make sure string is tied off 10711 10712 003051'01 124 04 0 00 003024* dmovem t4, pars3 ;[186] Store parse type and device type or unit 10713 003052'01 263 17 0 00 000000 ret 10714 10715 003053'01 .conn2: remark ;[205] Handle /stay in a define 10716 003053'01 124 04 0 00 003051* dmovem t4, pars3 ;[186] Store parse type and device type or unit 10717 003054'01 263 17 0 00 000000 ret 10718 k20par - Kermit-20 Parsing and Semantic Action Routines MACRO %53B(1254)-4 19:41 30-Mar-24 Page 54 K20PAR MAC 29-Mar-24 20:39 SET keyword table 10719 subttl SET keyword table 10720 10721 000666'02 000000 000000 %table(settab,G) ;[203] Also used by K20MAC 10722 000667'02 000000# 000000# %key3 , .setbc, $setbc ;[98] 10723 000547'03 142 154 157 143 153 10724 000552'03 000000# 000000# 10725 000670'02 000000# 000000# %key3 , .setbr, $setbr 10726 000553'03 142 162 145 141 153 10727 000555'03 000000# 000000# 10728 000671'02 000000# 000000# %key3 , .setdb, $setdb 10729 000556'03 144 145 142 165 147 10730 000560'03 000000# 000000# 10731 000672'02 000000# 000000# %key3 , .setdl, $setdl ;[194] 10732 000561'03 144 145 154 141 171 10733 000563'03 000000# 000000# 10734 000673'02 000000# 000000# %key3 , .setdu, $setdu ;[194] 10735 000564'03 144 165 160 154 145 10736 000566'03 000000# 000000# 10737 000674'02 000000# 000000# %key3 , .setes, $setes ;[194] 10738 000567'03 145 163 143 141 160 10739 000571'03 000000# 000000# 10740 000675'02 000000# 000000# %key3 , .setex, $setex ;[143] ;[194] 10741 000572'03 145 170 160 165 156 10742 000574'03 000000# 000000# 10743 000676'02 000000# 000000# %key3 , .setfi, $setfi ;[194] 10744 000575'03 146 151 154 145 000 10745 000576'03 000000# 000000# 10746 000677'02 000000# 000000# %key3 , .setfl, $setfl ;[143] ;[194] 10747 000577'03 146 154 157 167 055 10748 000602'03 000000# 000000# 10749 000700'02 000000# 000000# %key3 , .setha, $setha ;[76] 10750 000603'03 150 141 156 144 163 10751 000605'03 000000# 000000# 10752 000701'02 000000# 000000# %key3 , .seths, $setln## ;[194] 10753 000606'03 150 157 163 164 000 10754 000607'03 000000# 000000* 10755 000702'02 000000# 000000# %key3 , .setab, $setab ;[194] 10756 000610'03 151 156 143 157 155 10757 000613'03 000000# 000000# 10758 000703'02 000000# 000000# %key3 , .setin##, $setrs ;[160] ;[194] 10759 000614'03 151 156 160 165 164 10760 000616'03 000000* 000000# 10761 000704'02 000000# 000000# %key3 , .setit, $setit ;[194] 10762 000617'03 111 124 123 055 142 10763 000622'03 000000# 000000# 10764 000705'02 000000# 000000# %key3 , .setln, $setln## ;[186] ;[194] 10765 000623'03 154 151 156 145 000 10766 000624'03 000000# 000607* 10767 000706'02 000000# 000000# %key3 , .setpa##, $setpa## ;[194] 10768 000625'03 160 141 162 151 164 10769 000627'03 000000* 000000* 10770 000707'02 000000# 000000# %key3 , .setpr, $setpr ;[194] 10771 000630'03 160 162 157 155 160 10772 000632'03 000000# 000000# 10773 000710'02 000000# 000000# %key3 , .setrc, $setrs ;[194] k20par - Kermit-20 Parsing and Semantic Action Routines MACRO %53B(1254)-4 19:41 30-Mar-24 Page 54-1 K20PAR MAC 29-Mar-24 20:39 SET keyword table 10774 000633'03 162 145 143 145 151 10775 000635'03 000000# 000000# 10776 000711'02 000000# 000000# %key3 , .setre, $setre ;[194] 10777 000636'03 162 145 164 162 171 10778 000640'03 000000# 000000# 10779 000712'02 000000# 000713' %keyf3 , %snd3, 10780 000641'03 002000 000005 10781 000642'03 163 145 000 000 000 10782 000713'02 000000# 000000# %snd3: %key3 , .setsn, $setrs ;[194] 10783 000643'03 163 145 156 144 000 10784 000644'03 000000# 000000# 10785 000714'02 000000# 000000# %keyf4 , .setim, $setst, cm%inv ;[212] Tops-10 has it here 10786 000645'03 002000 000001 10787 000646'03 163 145 162 166 145 10788 000651'03 000000# 000000# 10789 000715'02 000000# 000000# %key3 , .setxp, $setsp ;[194] 10790 000652'03 163 160 145 145 144 10791 000654'03 000000# 000000# 10792 000716'02 000000# 000000# %keyf4 , .setim, $setst, cm%inv ;[212] keep typing this.. 10793 000655'03 002000 000001 10794 000656'03 163 162 166 055 164 10795 000661'03 000000# 000000# 10796 000717'02 000000# 000000# %key3 , .setta, $setta ;[129] ;[194] 10797 000662'03 124 126 124 055 102 10798 000665'03 000000# 000000# 10799 000666'02 000031 000031 %tbend 10800 10801 cleans(<%snd3>) ;;Clean up generated symbol 10802 k20par - Kermit-20 Parsing and Semantic Action Routines MACRO %53B(1254)-4 19:41 30-Mar-24 Page 55 K20PAR MAC 29-Mar-24 20:39 SET command 10803 subttl SET command 10804 10805 ;[77] Parse SET command. (This routine rewritten for edit 77.) 10806 10807 extern mactab ;[203] Macro table is in K20MAC 10808 10809 chgsec(code,const) ;;Chained FDB's are not in code, they're in const 10810 000720'02 000004 000723' sfdb1: flddb. .cmkey,,mactab,,,sfdb2 10811 000721'02 000000000000# 10812 000722'02 44 07 0 00 002170' 10813 000723'02 000000 000000 sfdb2: flddb. .cmkey,,settab 10814 000724'02 000000 000666' 10815 retsec ;;Back to where-ever we started from 10816 10817 003055'01 554 02 0 00 002422* .set: hlrz t2, mactab ; Anything in macro table? 10818 003056'01 322 02 0 00 003065' ifn. t2 ;[194] If so, include them too. 10819 003057'01 332 00 0 00 003026* skipe definf ; Unless we're defining a macro. 10820 003060'01 254 00 0 00 003065' anskp. ;[194] Don't allow recursive definitions! 10821 003061'01 332 00 0 00 000000# skipe mdone ;[203] Not expanding the macro? 10822 003062'01 254 00 0 00 003065' anskp. ;[203] No, we are; so only do keywords 10823 003063'01 201 01 0 00 000000# movei t1, sfdb1 ; Macro table is searched first. 10824 003064'01 254 00 0 00 003066' else. ;[194] No macros or defining one 10825 003065'01 201 01 0 00 000000# movei t1, sfdb2 ; Normal SET command table. 10826 003066'01 endif. ;[194] 10827 003066'01 260 17 0 00 003035* call rfield ; Parse a keyword. 10828 10829 003067'01 .set2: entry .set2 ;[203] Linkage from K20MAC 10830 003067'01 553 00 0 00 000003 hrrzs t3 ; See which function descriptor block was used. 10831 003070'01 302 03 0 00 000000# caie t3, sfdb1 ;[194] The macro table? 10832 003071'01 254 00 0 00 003101' ifskp. ;[194] Indeed 10833 003072'01 550 01 0 02 000000 hrrz t1, (t2) ;[194] Yes, get the data. 10834 003073'01 505 01 0 00 440700 hrli t1, (point 7,) ; This will be a pointer to the macro text. 10835 003074'01 202 01 0 00 002726* movem t1, pars2 ; Save it. 10836 003075'01 260 17 0 00 002754* confrm ; Get confirmation. 10837 003076'01 476 00 0 00 000000# setom macrof ; Set the macro flag. 10838 003077'01 263 17 0 00 000000 ret ; No more to do. 10839 003100'01 254 00 0 00 003102' else. ;[194] Not from macro table 10840 003101'01 402 00 0 00 000000# setzm macrof ; Assume regular SET keyword was parsed. 10841 003102'01 endif. ;[194] End case parsing a macro name 10842 10843 003102'01 550 02 0 02 000000 hrrz t2, (t2) ; Get the command routine addresses. 10844 003103'01 202 02 0 00 003074* movem t2, pars2 ; Save into pars2. 10845 003104'01 554 01 0 02 000000 hlrz t1, (t2) ; Get the next level routine. 10846 003105'01 260 17 0 01 000000 call (t1) ; Call it. 10847 10848 ; If doing a DEFINE, loop through SET commands until CR typed. 10849 10850 003106'01 336 00 0 00 003057* skipn definf ; Doing DEFINE? If so, allow comma here. 10851 003107'01 263 17 0 00 000000 ret 10852 003110'01 201 01 0 00 000000# movei t1, scmfdb 10853 003111'01 260 17 0 00 003066* call rfield 10854 003112'01 135 03 0 00 005304' ldb t3, [pointr (.cmfnp(t3),cm%fnc)] ; Get function code. 10855 003113'01 306 03 0 00 000013 cain t3, .cmcma ; Comma? 10856 003114'01 254 00 0 00 003055' jrst .set ; Yes, go back & get another SET parameter. 10857 003115'01 263 17 0 00 000000 ret ; Confirmation, done. k20par - Kermit-20 Parsing and Semantic Action Routines MACRO %53B(1254)-4 19:41 30-Mar-24 Page 55-1 K20PAR MAC 29-Mar-24 20:39 SET command 10858 k20par - Kermit-20 Parsing and Semantic Action Routines MACRO %53B(1254)-4 19:41 30-Mar-24 Page 56 K20PAR MAC 29-Mar-24 20:39 SET command action routines. 10859 subttl SET command action routines. 10860 10861 ; SET ... command dispatcher. 10862 10863 003116'01 $set: entry $set ;[194] Maybe move this? 10864 003116'01 332 00 0 00 000000# ifme. macrof ;[203] If no macro used, just do the set 10865 003117'01 254 00 0 00 003124' 10866 003120'01 200 02 0 00 003103* move t2, pars2 ; Get back data value. 10867 003121'01 550 01 0 02 000000 hrrz t1, (t2) ; Get evaluation routine. 10868 003122'01 260 17 0 01 000000 call (t1) ; Call it. 10869 003123'01 263 17 0 00 000000 ret 10870 003124'01 endif. ;[203] 10871 10872 003124'01 200 01 0 00 003120* $set2: move t1, pars2 ; Pointer to macro text (SET operands) 10873 003125'01 202 01 0 00 000000# movem t1, macxp 10874 ;* PSOUT ; echo it for debugging... 10875 003126'01 476 00 0 00 000000# setom mdone ; Say macro not done yet. 10876 10877 ; Loop to copy one set command into the command buffer. 10878 10879 003127'01 201 01 0 00 000745 $set3: movei t1,cmdbln*5 ;[192] Max characters in command buffer 10880 003130'01 202 01 0 00 000000# movem t1,sbk+.cmcnt ;[192] Say it's completely empty 10881 003131'01 402 00 0 00 000000# setzm sbk+.cminc ;[192] No unparsed characters yet 10882 003132'01 200 01 0 00 005466' move t1, [ascii/set /] ; Fake a SET command (don't nul terminate) 10883 003133'01 202 01 0 00 000000* movem t1, cmdbuf 10884 003134'01 201 02 0 00 000004 movei t2, ^d4 ;[192] Characters in "SET " 10885 003135'01 272 02 0 00 000000# addm t2, sbk+.cminc ;[192] Bump count of UNparsed characters 10886 003136'01 211 02 0 00 000004 movni t2, ^d4 ;[192] Characters in "SET " 10887 003137'01 272 02 0 00 000000# addm t2, sbk+.cmcnt ;[192] Reduce remaining space 10888 003140'01 200 02 0 00 005467' move t2, [point 7, cmdbuf, 27] ; Copy them to after "set " 10889 003141'01 202 02 0 00 000000# movem t2, sbk+.cmptr 10890 10891 ; Loop for each character. 10892 10893 ; To do: why are we putting a line feed back into the buffer? 10894 10895 003142'01 $set4: do. ;[203] Enter loop context 10896 003142'01 134 01 0 00 000000# ildb t1, macxp ; Get a character from the macro text 10897 003143'01 306 01 0 00 000015 cain t1, .chcrt ;[192] A carriage return? 10898 003144'01 201 01 0 00 000054 movei t1, "," ;[192] Hi! Guess what, now you're a comma! 10899 003145'01 306 01 0 00 000012 cain t1, .chlfd ;[192] A line feed? 10900 003146'01 254 00 0 00 003142' loop. ;[192] Silently swallow it 10901 003147'01 322 01 0 00 003171' jumpe t1, endlp. ;[192] If null, done. 10902 003150'01 302 01 0 00 000054 caie t1, "," ;[194] A comma? 10903 003151'01 254 00 0 00 003165' ifskp. ;[194] It is 10904 003152'01 201 01 0 00 000015 movei t1, .chcrt ;[194] Substitute a carriage return. 10905 003153'01 136 01 0 00 000002 idpb t1, t2 ;[203] Drop into command buffer 10906 003154'01 350 00 0 00 000000# aos sbk+.cminc ;[203] Account for character in there 10907 003155'01 370 00 0 00 000000# sos sbk+.cmcnt ;[203] Subtract from remaining 10908 003156'01 201 01 0 00 000012 movei t1, .chlfd ; And a linefeed... 10909 003157'01 136 01 0 00 000002 idpb t1, t2 ;[203] Drop that into command buffer, too 10910 003160'01 350 00 0 00 000000# aos sbk+.cminc ;[203] Account for character in there 10911 003161'01 370 00 0 00 000000# sos sbk+.cmcnt ;[203] Subtract from remaining 10912 003162'01 400 01 0 00 000000 setz t1, ; And a null... 10913 003163'01 136 01 0 00 000002 idpb t1, t2 ;[203] Tie off the line k20par - Kermit-20 Parsing and Semantic Action Routines MACRO %53B(1254)-4 19:41 30-Mar-24 Page 56-1 K20PAR MAC 29-Mar-24 20:39 SET command action routines. 10914 003164'01 254 00 0 00 003203' jrst $set6 ; Go execute this part of the macro 10915 003165'01 endif. ;[194] 10916 003165'01 136 01 0 00 000002 idpb t1, t2 ; Not a comma, copy the character. 10917 003166'01 350 00 0 00 000000# aos sbk+.cminc ;[192] Account for it in the CSB 10918 003167'01 370 00 0 00 000000# sos sbk+.cmcnt ;[192] and decrement remaining count 10919 003170'01 254 00 0 00 003142' loop. ;[203] And copy some more, wee!! 10920 003171'01 enddo. ;[203] Exit loop lexical context 10921 10922 ; Get here at end of null-terminated macro body. 10923 10924 003171'01 $set5: remark ;[192] Fix the CSB back up 10925 003171'01 200 01 0 00 005470' move t1, [point 7, cmdbuf] ;[192] Point to beginning of command buffer 10926 003172'01 202 01 0 00 000000# movem t1, sbk+.cmptr ;[192] Stomp that in; nothing to parse 10927 003173'01 201 01 0 00 000745 movei t1,cmdbln*5 ;[192] Max characters in command buffer 10928 003174'01 202 01 0 00 000000# movem t1,sbk+.cmcnt ;[192] Say it's completely empty 10929 003175'01 402 00 0 00 000000# setzm sbk+.cminc ;[192] No unparsed characters yet 10930 003176'01 403 01 0 00 000002 setzb t1, t2 ;[192] Cons up ten .CHNUL's 10931 003177'01 124 01 0 00 003133* dmovem t1, cmdbuf ;[192] Scrub the atom buffer an itty bit 10932 003200'01 502 01 0 00 000000* hllm t1, sbk ;[192] Zero the CSB flags. 10933 003201'01 402 00 0 00 000000# setzm mdone ;[192] Flag that we're done interpreting the macro. 10934 003202'01 263 17 0 00 000000 ret ;[192] Get out of here 10935 10936 003203'01 402 00 0 00 000000* $set6: setzm pars1 ;[203] Expanding a macro doesn't hit parse: in 10937 003204'01 200 01 0 00 005471' move t1, [pars1,,pars2] ;[203] the main parsing loop, so we must clean 10938 003205'01 251 01 0 00 000000* blt t1, parsx ;[203] out the previous parse values here 10939 10940 ;* hrroi t1, cmdbuf ; Echo the command. 10941 ;* PSOUT ; ... 10942 10943 003206'01 553 00 0 00 003200* hrrzs sbk ;[203] Zero the CSB flags. 10944 003207'01 260 17 0 00 003055' call .set ; Go parse the string. 10945 003210'01 260 17 0 00 003116' call $set ; Go execute what was parsed. 10946 003211'01 332 00 0 00 000000# skipe mdone ;[203] No more? 10947 003212'01 254 00 0 00 003127' jrst $set3 ;[203] Nope, go do the rest of them. 10948 003213'01 263 17 0 00 000000 ret ; Otherwise, all done 10949 k20par - Kermit-20 Parsing and Semantic Action Routines MACRO %53B(1254)-4 19:41 30-Mar-24 Page 57 K20PAR MAC 29-Mar-24 20:39 SET BLOCK-CHECK command 10950 subttl SET BLOCK-CHECK command 10951 10952 ;[98] (This command added as part of edit 98) 10953 10954 000725'02 000000 000000 %table(bctab) 10955 000726'02 000000# 000061 %key2 <1-character-checksum>, "1" 10956 000666'03 061 055 143 150 141 10957 000727'02 000000# 000062 %key2 <2-character-checksum>, "2" 10958 000673'03 062 055 143 150 141 10959 000730'02 000000# 000063 %key2 <3-character-crc>, "3" 10960 000700'03 063 055 143 150 141 10961 000725'02 000003 000003 %tbend 10962 10963 chgsec(code,const) ;;FDB's are not in code, they're in const 10964 000731'02 000002 000000 sbcfdb: flddb. .cmkey,,bctab,,<1> 10965 000732'02 000000 000725' 10966 000733'02 000000 000000 10967 000734'02 44 07 0 00 002047' 10968 retsec ;;Back to where-ever we started from 10969 10970 003214'01 200 16 0 00 000000# .setbc: guide ; Issue guide words 10971 003215'01 260 17 0 00 003004* 10972 000735'02 000000000000# 10973 001227'04 164 171 160 145 040 10974 003216'01 201 01 0 00 000000# movei t1, sbcfdb 10975 003217'01 260 17 0 00 003111* call rfield ; Parse keyword, default is "1". 10976 003220'01 550 02 0 02 000000 hrrz t2, (t2) ; Save the value we parsed. 10977 003221'01 202 02 0 00 003053* movem t2, pars3 10978 003222'01 336 00 0 00 003106* skipn definf ; In a DEFINE command? 10979 003223'01 260 17 0 00 003075* confrm ; No, make them type a carriage return. 10980 003224'01 263 17 0 00 000000 ret 10981 10982 remark SET BLOCK-CHECK command execution. 10983 10984 003225'01 $setbc: extern bctr ; Our necessary 10985 003225'01 200 01 0 00 003221* move t1, pars3 ; Get what was parsed. 10986 003226'01 202 01 0 00 000000* movem t1, bctr ; Save it as "block check type requested". 10987 003227'01 263 17 0 00 000000 ret 10988 k20par - Kermit-20 Parsing and Semantic Action Routines MACRO %53B(1254)-4 19:41 30-Mar-24 Page 58 K20PAR MAC 29-Mar-24 20:39 SET BREAK command 10989 subttl SET BREAK command 10990 10991 chgsec(code,const) ;;FDB's are not in code, they're in const 10992 000736'02 001004 000000 sbrfdb: flddb. .cmnum,,^d10, 10993 000737'02 000000 000012 10994 000740'02 44 07 0 00 002452' 10995 retsec ;;Back to where-ever we started from 10996 10997 003230'01 200 16 0 00 000000# .setbr: guide (nulls) 10998 003231'01 260 17 0 00 003215* 10999 000741'02 000000000000# 11000 001231'04 156 165 154 154 163 11001 003232'01 201 01 0 00 000000# movei t1, sbrfdb 11002 003233'01 260 17 0 00 003217* call rfield 11003 11004 003234'01 325 02 0 00 003240' ifl. t2 ;[194] Negative nulls are silly 11005 003235'01 200 01 0 00 000000# emsg ;[194] 11006 003236'01 104 00 0 00 000313 11007 000742'02 000000000000# 11008 001233'04 101 040 156 145 147 11009 003237'01 254 00 0 00 002753* jrst cmder1 ;[194] 11010 003240'01 endif. ;[194] 11011 11012 003240'01 307 02 0 00 000100 caig t2, maxnul ;[194] 11013 003241'01 254 00 0 00 003252' ifskp. ;[194] Exceeded maximum 11014 003242'01 200 01 0 00 000000# emsg ;[194] 11015 003243'01 104 00 0 00 000313 11016 000743'02 000000000000# 11017 001243'04 124 157 157 040 155 11018 003244'01 201 01 0 00 000101 numout [maxnul] ;[194] 11019 003245'01 200 02 0 00 005472' 11020 003246'01 201 03 0 00 000012 11021 003247'01 104 00 0 00 000224 11022 003250'01 320 14 0 00 003251' 11023 003251'01 254 00 0 00 003237* jrst cmder1 ;[194] 11024 003252'01 endif. ;[194] 11025 11026 003252'01 202 02 0 00 003225* movem t2, pars3 11027 003253'01 336 00 0 00 003222* skipn definf ;[77] In DEFINE? 11028 003254'01 260 17 0 00 003223* confrm ;[77] No, get confirmation. 11029 003255'01 263 17 0 00 000000 ret 11030 11031 remark SET BREAK command execution. 11032 11033 003256'01 $setbr: extern brk ; Our necessary 11034 003256'01 200 02 0 00 003252* move t2, pars3 ; Execute SET BREAK. 11035 003257'01 202 02 0 00 000000* movem t2, brk 11036 003260'01 263 17 0 00 000000 ret 11037 k20par - Kermit-20 Parsing and Semantic Action Routines MACRO %53B(1254)-4 19:41 30-Mar-24 Page 59 K20PAR MAC 29-Mar-24 20:39 SET DEBUG command 11038 subttl SET DEBUG command 11039 11040 000744'02 000000 000000 %table(dbgswi) ;[221] 11041 000745'02 000000# 000000 %key2 , 0 ;[221] If setting decode flag 11042 000704'03 144 145 143 157 144 11043 000744'02 000001 000001 %tbend ;[221] 11044 11045 000746'02 000000 000000 %table(dbgtab) 11046 000747'02 000000# 000000 %key2 , 0 11047 000706'03 157 146 146 000 000 11048 000750'02 000000# 000002 %key2 , 2 ;[22] 11049 000707'03 160 141 143 153 145 11050 000751'02 000000# 000001 %key2 , 1 ;[22] 11051 000711'03 163 164 141 164 145 11052 000746'02 000003 000003 %tbend 11053 11054 chgsec(code,const) ;;Chained FDB's are not in code, they're in const 11055 000752'02 000002 000000 sdbfdb: flddb. .cmkey,,dbgtab,,states 11056 000753'02 000000 000746' 11057 000754'02 000000 000000 11058 000755'02 44 07 0 00 002464' 11059 000756'02 003004 000761' sdbswi: flddb. .cmswi,,dbgswi,,,sdbsw1 11060 000757'02 000000 000744' 11061 000760'02 44 07 0 00 002466' 11062 000761'02 010000 000000 sdbsw1: flddb. .cmcfm ;[221] Parse either the switch or a confirm 11063 000762'02 000000 000000 11064 sdbswo: flddb. .cmswi,,dbgswi,,, ;;[221] 11067 000764'02 000000 000744' 11068 000765'02 44 07 0 00 002474' 11069 retsec ;;Back to where-ever we started from 11070 cleans() 11071 11072 003261'01 200 16 0 00 000000# .setdb: guide ;[217] 11421 003523'01 104 00 0 00 000313 11422 001106'02 000000000000# 11423 001306'04 101 040 156 145 147 11424 003524'01 263 17 0 00 000000 ret ;[217] Failure return 11425 003525'01 endif. ;[217] 11426 11427 003525'01 305 06 0 00 000200 caige q2, 200 ;[217] Absurdly large? 11428 003526'01 254 00 0 00 003532' ifskp. ;[217] Give that a special squawk 11429 003527'01 200 01 0 00 000000# emsg ;[217] 11430 003530'01 104 00 0 00 000313 11431 001107'02 000000000000# 11432 001321'04 101 040 156 165 155 11433 003531'01 263 17 0 00 000000 ret ;[217] Failure return 11434 003532'01 endif. ;[217] 11435 11436 003532'01 306 06 0 00 000177 cain q2, 177 ;[194] But! Maybe a rubout? 11437 003533'01 254 00 0 00 003325* retskp ;[217] It is, this is fine 11438 11439 003534'01 302 06 0 00 000003 caie q2, .chcnc ;[217] ^C? 11440 003535'01 254 00 0 00 003541' ifskp. ;[217] That is never a good idea 11441 003536'01 200 01 0 00 000000# emsg ;[217] 11442 003537'01 104 00 0 00 000313 11443 001110'02 000000000000# 11444 001335'04 115 141 171 040 156 11445 003540'01 263 17 0 00 000000 ret ;[217] Failure return 11446 003541'01 endif. ;[217] 11447 11448 003541'01 336 04 0 00 000000* skipn t4, handsh ;[217] Are we doing handshaking? 11449 003542'01 254 00 0 00 003556' ifskp. ;[217] We are, so check if this conflicts 11450 003543'01 312 06 0 00 000004 came q2, t4 ;[217] Same thing? 11451 003544'01 254 00 0 00 003556' anskp. ;[217] Nope, but still need to check further 11452 003545'01 200 01 0 00 000000# emsg ;[217] k20par - Kermit-20 Parsing and Semantic Action Routines MACRO %53B(1254)-4 19:41 30-Mar-24 Page 63-2 K20PAR MAC 29-Mar-24 20:39 SET ESCAPE command 11453 003546'01 104 00 0 00 000313 11454 001111'02 000000000000# 11455 001347'04 115 141 171 040 156 11456 003547'01 200 01 0 00 000006 move t1, q2 ;[217] Load the control character 11457 003550'01 271 01 0 00 000100 addi t1, "@" ;[217] Bring into printable range 11458 003551'01 104 00 0 00 000074 PBOUT% ;[217] and type it 11459 003552'01 200 01 0 00 000000# txmsg < as an escape character because this is the handshake character> 11460 003553'01 104 00 0 00 000076 11461 003554'01 320 12 0 00 003555' 11462 001112'02 000000000000# 11463 001354'04 040 141 163 040 141 11464 003555'01 263 17 0 00 000000 ret ;[217] Failure return 11465 003556'01 endif. ;[217] 11466 11467 003556'01 302 06 0 00 000007 caie q2, .chbel ;[217] ^G? 11468 003557'01 254 00 0 00 003573' ifskp. ;[217] That is never a good idea 11469 003560'01 200 01 0 00 000000* move t1, capas ;[217] Pick up our capabilities 11470 003561'01 603 01 0 00 400000 txne t1, sc%ctc ;[217] Do we have ^C? 11471 003562'01 254 00 0 00 003533* retskp ;[217] Yes, this is fine 11472 003563'01 336 00 0 00 000000# ifmn. ;[217] Are we a batch frob? 11473 003564'01 254 00 0 00 003570' 11474 003565'01 200 01 0 00 000000# emsg ;[217] 11475 003566'01 104 00 0 00 000313 11476 001113'02 000000000000# 11477 001371'04 115 141 171 040 156 11478 003567'01 254 00 0 00 003572' else. ;[217] Otherwise, slightly different message 11479 emsg 11481 003571'01 104 00 0 00 000313 11482 001114'02 000000000000# 11483 001405'04 115 141 171 040 156 11484 003572'01 endif. ;[217] Either way, it's bad... 11485 003572'01 263 17 0 00 000000 ret ;[217] Failure return 11486 003573'01 endif. ;[217] 11487 11488 003573'01 302 06 0 00 000023 caie q2, .chcns ;[217] ^S? 11489 003574'01 254 00 0 00 003602' ifskp. ;[217] Not not be available 11490 003575'01 336 00 0 00 000000* skipn flow ;[217] Are we running XON-XOFF? 11491 003576'01 254 00 0 00 003562* retskp ;[217] Nope, so that's fine 11492 emsg 11494 003600'01 104 00 0 00 000313 11495 001115'02 000000000000# 11496 001424'04 115 141 171 040 156 11497 003601'01 263 17 0 00 000000 ret ;[217] Failure return 11498 003602'01 endif. ;[217] 11499 11500 003602'01 302 06 0 00 000021 caie q2, .chcnq ;[217] ^Q? 11501 003603'01 254 00 0 00 003611' ifskp. ;[217] Not not be available 11502 003604'01 336 00 0 00 003575* skipn flow ;[217] Are we running XON-XOFF? 11503 003605'01 254 00 0 00 003576* retskp ;[217] Nope, so that's fine 11504 emsg 11506 003607'01 104 00 0 00 000313 11507 001116'02 000000000000# k20par - Kermit-20 Parsing and Semantic Action Routines MACRO %53B(1254)-4 19:41 30-Mar-24 Page 63-3 K20PAR MAC 29-Mar-24 20:39 SET ESCAPE command 11508 001444'04 115 141 171 040 156 11509 003610'01 263 17 0 00 000000 ret ;[217] Failure return 11510 003611'01 endif. ;[217] 11511 11512 003611'01 307 06 0 00 000037 caig q2, .chcun ;[217] Past Control-_ (underscore)? 11513 003612'01 254 00 0 00 003605* retskp ;[217] No, so it's passed all the checks 11514 11515 003613'01 200 01 0 00 000000# emsg <"> ;[217] Begin the blat 11516 003614'01 104 00 0 00 000313 11517 001117'02 000000000000# 11518 001464'04 042 000 000 000 000 11519 003615'01 200 01 0 00 000006 move t1, q2 ;[217] Load the proposed control 11520 003616'01 104 00 0 00 000074 PBOUT% ;[217] character and type it 11521 003617'01 200 01 0 00 000000# txmsg <" is not in ASCII control range, 0-37 or 177> 11522 003620'01 104 00 0 00 000076 11523 003621'01 320 12 0 00 003622' 11524 001120'02 000000000000# 11525 001465'04 042 040 151 163 040 11526 003622'01 263 17 0 00 000000 ret ;[217] Failure return 11527 003623'01 263 17 0 00 000000 endbk. ;[217] End block context 11528 003624'01 254 00 0 00 003631' ifskp. ;[217] Passed +2 means passed muster 11529 003625'01 202 06 0 00 003431* movem q2, pars3 ;[217] So let's use it 11530 003626'01 306 10 0 00 000010 cain q4, .cmcfm ;[217] Original intent was to default everything? 11531 003627'01 263 17 0 00 000000 ret ;[217] It was, so don't confirm the confirm. 11532 003630'01 254 00 0 00 003632' else. ;[217] Otherwise, we've complained 11533 003631'01 254 00 0 00 003411* jrst cmder1 ;[217] Allow ^H 11534 003632'01 endif. ;[217] Otherwise, fall through 11535 11536 003632'01 336 00 0 00 003450* skipn definf ;[77] In DEFINE? 11537 003633'01 260 17 0 00 003427* confrm ;[77] No, get confirmation. 11538 003634'01 263 17 0 00 000000 ret 11539 k20par - Kermit-20 Parsing and Semantic Action Routines MACRO %53B(1254)-4 19:41 30-Mar-24 Page 64 K20PAR MAC 29-Mar-24 20:39 SET ESCAPE command 11540 remark SET ESCAPE comand semantic action 11541 11542 003635'01 $setes: extern escape ; Our necessary 11543 003635'01 200 01 0 00 003625* move t1, pars3 ;[16] ESCAPE. Get what we parsed. 11544 003636'01 202 01 0 00 000000* movem t1, escape 11545 003637'01 263 17 0 00 000000 ret 11546 k20par - Kermit-20 Parsing and Semantic Action Routines MACRO %53B(1254)-4 19:41 30-Mar-24 Page 65 K20PAR MAC 29-Mar-24 20:39 SET EXPUNGE command 11547 subttl SET EXPUNGE command 11548 11549 001121'02 000000 000000 %table(offon) ; Table for parsing ON or OFF. 11550 001122'02 000000# 000000 %key2 , 0 11551 000747'03 157 146 146 000 000 11552 001123'02 000000# 000001 %key2 , 1 11553 000750'03 157 156 000 000 000 11554 001121'02 000002 000002 %tbend 11555 11556 chgsec(code,const) ;;FDB's are not in code, they're in const 11557 001124'02 000002 000000 sexfdb: flddb. .cmkey,,offon,,on 11558 001125'02 000000 001121' 11559 001126'02 000000 000000 11560 001127'02 44 07 0 00 002264' 11561 retsec ;;Back to where-ever we started from 11562 11563 003640'01 200 16 0 00 000000# .setex: guide 11564 003641'01 260 17 0 00 003436* 11565 001130'02 000000000000# 11566 001476'04 144 145 154 145 164 11567 003642'01 201 01 0 00 000000# movei t1, sexfdb ; Yet consistent naming, sigh... 11568 003643'01 260 17 0 00 003423* call rfield ; Parse a keyword. 11569 003644'01 550 02 0 02 000000 hrrz t2, (t2) ; Get the value for the keyword (0 or 1). 11570 003645'01 202 02 0 00 003635* movem t2, pars3 ; Save into pars3. 11571 003646'01 336 00 0 00 003632* skipn definf ;[77] In DEFINE? 11572 003647'01 260 17 0 00 003633* confrm ;[77] No, get confirmation. 11573 003650'01 263 17 0 00 000000 ret 11574 11575 remark SET EXPUNGE semantic action 11576 11577 003651'01 $setex: extern expung ; Our necessary 11578 003651'01 200 01 0 00 003645* move t1, pars3 ;[143] SET EXPUNGE 11579 003652'01 202 01 0 00 000000* movem t1, expung 11580 003653'01 263 17 0 00 000000 ret 11581 k20par - Kermit-20 Parsing and Semantic Action Routines MACRO %53B(1254)-4 19:41 30-Mar-24 Page 66 K20PAR MAC 29-Mar-24 20:39 SET FILE parse tables 11582 subttl SET FILE parse tables 11583 11584 001131'02 000000 000000 %table(sfitab) ; Table of file parameters to SET. 11585 001132'02 000000# 000000 %key2 ,0 11586 000751'03 142 171 164 145 163 11587 001133'02 000000# 000001 %key2 ,1 11588 000753'03 156 141 155 151 156 11589 001131'02 000002 000002 %tbend 11590 11591 001134'02 000000 000000 %table(sfbtab) ; file bytesize keyword table. 11592 001135'02 000000# 000002 %key2 <36-bit>, 2 ;[232] 11593 000755'03 063 066 055 142 151 11594 001136'02 000000# 000000 %key2 <7-bit>, 0 11595 000757'03 067 055 142 151 164 11596 001137'02 000000# 000001 %key2 <8-bit>, 1 11597 000761'03 070 055 142 151 164 11598 001140'02 000000# 000003 %key2 , 3 ;[232] 11599 000763'03 141 165 164 157 000 11600 001141'02 000000# 000001 %key2 , 1 11601 000764'03 145 151 147 150 164 11602 001142'02 000000# 000000 %key2 , 0 11603 000766'03 163 145 166 145 156 11604 001143'02 000000# 000002 %key2 , 2 ;[232] 11605 000770'03 164 150 151 162 164 11606 001134'02 000007 000007 %tbend 11607 11608 001144'02 000000 000000 %table(fntab) ;[194] ; file name translation keywords. 11609 001145'02 000000# 000001 %key2 ,1 ;[194] 11610 000773'03 156 157 162 155 141 11611 001146'02 000000# 000000 %key2 ,0 ;[194] 11612 000776'03 165 156 164 162 141 11613 001144'02 000002 000002 %tbend ;[194] 11614 k20par - Kermit-20 Parsing and Semantic Action Routines MACRO %53B(1254)-4 19:41 30-Mar-24 Page 67 K20PAR MAC 29-Mar-24 20:39 SET FILE command 11615 subttl SET FILE command 11616 11617 ; The following ruse using chained FDB's allows the old-style command to 11618 ; be parsed most of the time, like "SET FILE 8". 11619 11620 chgsec(code,const) ;;Chained FDB's are not in code, they're in const 11621 001147'02 000002 001153' sfifd1: flddb. .cmkey,,sfitab,,,sfifd2 11622 001150'02 000000 001131' 11623 001151'02 000000 000000 11624 001152'02 44 07 0 00 002707' 11625 001153'02 000006 000000 sfifd2: flddb. .cmkey,,sfbtab,, 11626 001154'02 000000 001134' 11627 001155'02 44 07 0 00 002711' 11628 001156'02 44 07 0 00 002716' 11629 001157'02 000002 000000 sftfd3: flddb. .cmkey,,fntab,, ;[84] 11630 001160'02 000000 001144' 11631 001161'02 000000 000000 11632 001162'02 44 07 0 00 002717' 11633 retsec ;;Back to where-ever we started from 11634 11635 003654'01 200 16 0 00 000000# .setfi: guide ;[84] SET FILE 11636 003655'01 260 17 0 00 003641* 11637 001163'02 000000000000# 11638 001504'04 160 141 162 141 155 11639 003656'01 201 01 0 00 000000# movei t1, sfifd1 11640 003657'01 260 17 0 00 003643* call rfield 11641 003660'01 550 02 0 02 000000 hrrz t2, (t2) 11642 003661'01 553 00 0 00 000003 hrrzs t3 ;[84] Which function descriptor block was used? 11643 003662'01 402 00 0 00 003651* setzm pars3 ;[84] Assume they specified a bytesize. 11644 003663'01 306 03 0 00 000000# cain t3, sfifd2 ;[84] They specified a bytesize? 11645 003664'01 254 00 0 00 003675' ifskp. ;[194] Nope, parse for it 11646 003665'01 202 02 0 00 003662* movem t2, pars3 11647 003666'01 200 16 0 00 000000# guide 11648 003667'01 260 17 0 00 003655* 11649 001164'02 000000000000# 11650 001506'04 164 157 000 000 000 11651 003670'01 201 01 0 00 000000# movei t1, sfifd2 ;[194] Let's assume didn't specify the bytesize, yet 11652 003671'01 332 00 0 00 003665* skipe pars3 ;[84] But!! Did they? 11653 003672'01 201 01 0 00 000000# movei t1,sftfd3 ;[194] They did, so parse the filename translation 11654 003673'01 260 17 0 00 003657* call rfield ; Parse a keyword. 11655 003674'01 550 02 0 02 000000 hrrz t2, (t2) ; Get the value for the keyword (0 or 1). 11656 003675'01 endif. ;[196] Otherwise, so don't parse it again. 11657 11658 003675'01 202 02 0 00 003412* movem t2, pars4 ;[84] Save here. 11659 003676'01 336 00 0 00 003646* skipn definf ;[77] In DEFINE? 11660 003677'01 260 17 0 00 003647* confrm ;[77] No, get confirmation. 11661 003700'01 263 17 0 00 000000 ret 11662 11663 remark SET FILE semantic action 11664 11665 003701'01 336 01 0 00 003671* $setfi: skipn t1, pars3 ;[84] Which file parameter are we setting? 11666 003702'01 254 00 0 00 003713' jrst $setf8 ;[84] Bytesize, go do that. 11667 remark $setfn ;[194] Beware! Falls through to $setfn 11668 k20par - Kermit-20 Parsing and Semantic Action Routines MACRO %53B(1254)-4 19:41 30-Mar-24 Page 68 K20PAR MAC 29-Mar-24 20:39 FILE NAMING semantic action 11669 subttl FILE NAMING semantic action 11670 11671 003703'01 $setfn: remark $setfn ; Called by... NOBODY!! (see above) 11672 extern xfnflg ; and of our necessary 11673 003703'01 376 00 0 00 000001 sosn t1 ;[194] Do we have to get a little fancier? 11674 003704'01 254 00 0 00 003710' ifskp. ;[194] Yep, looks like it 11675 003705'01 200 01 0 00 000000# emsg ;[187] if more file parameters 11676 003706'01 104 00 0 00 000313 11677 001165'02 000000000000# 11678 001507'04 111 155 160 157 163 11679 003707'01 263 17 0 00 000000 ret ;[84] are added... 11680 003710'01 endif. ;[194] 11681 003710'01 200 01 0 00 003675* move t1, pars4 ;[84] OK, get the value. 11682 003711'01 202 01 0 00 000000* movem t1, xfnflg ;[84] Save it. 11683 003712'01 263 17 0 00 000000 ret ;[84] Done. 11684 k20par - Kermit-20 Parsing and Semantic Action Routines MACRO %53B(1254)-4 19:41 30-Mar-24 Page 69 K20PAR MAC 29-Mar-24 20:39 FILE BYTESIZE semantic action 11685 subttl FILE BYTESIZE semantic action 11686 11687 003713'01 $setf8: remark $setf8 ; Jumped to by $setfi 11688 extern autbyt, ebtflg, tbtflg ; Our necessaries 11689 003713'01 200 01 0 00 003710* move t1, pars4 ; BYTESIZE... Get the value of the flag. 11690 003714'01 254 00 1 01 003715' jrst @fbytet(t1) ;[232] Go set the variables appropriately 11691 11692 003715'01 000000 003721' fbytet: fbyte7 ;[232] Seven bit files 11693 003716'01 000000 003725' fbyte8 ;[232] Eight bit files 11694 003717'01 000000 003731' fbyt36 ;[232] Thirty-six bit files 11695 003720'01 000000 003736' fbytea ;[232] Auto-byte (only 7 or 8 for now) 11696 11697 003721'01 fbyte7: remark ;[232] Here to force 7 bit 11698 003721'01 402 00 0 00 000000* setzm autbyt ;[232] Never autobyting 11699 003722'01 402 00 0 00 000000* setzm ebtflg ;[232] Clear eight bit flag 11700 003723'01 402 00 0 00 000000* setzm tbtflg ;[232] Clear 36 bit flag 11701 003724'01 263 17 0 00 000000 ret ;[232] Done 11702 11703 003725'01 fbyte8: remark ;[232] Here to force 8 bit files 11704 003725'01 402 00 0 00 003721* setzm autbyt ;[232] Never autobyting 11705 003726'01 476 00 0 00 003722* setom ebtflg ;[232] Set eight bit flag 11706 003727'01 402 00 0 00 003723* setzm tbtflg ;[232] Clear 36 bit flag 11707 003730'01 263 17 0 00 000000 ret ;[232] Done 11708 11709 003731'01 fbyt36: remark ;[232] Here if forceing thirty-six bit files 11710 003731'01 402 00 0 00 000000* setzm itsflg ;[232] Clear ITS Binary 11711 003732'01 402 00 0 00 003725* setzm autbyt ;[232] Never autobyting 11712 003733'01 402 00 0 00 003726* setzm ebtflg ;[232] Clear eight bit flag 11713 003734'01 476 00 0 00 003727* setom tbtflg ;[232] Set 36 bit flag 11714 003735'01 263 17 0 00 000000 ret ;[232] Done 11715 11716 003736'01 fbytea: remark ;[232] Here for 7/8 bit auto-byte 11717 003736'01 476 00 0 00 003732* setom autbyt ;[194] If so, say so, 11718 003737'01 402 00 0 00 003733* setzm ebtflg ; and say this not so. 11719 003740'01 402 00 0 00 003734* setzm tbtflg ;[232] If autobyte, then never 36 bit 11720 003741'01 263 17 0 00 000000 ret ;[232] Done 11721 k20par - Kermit-20 Parsing and Semantic Action Routines MACRO %53B(1254)-4 19:41 30-Mar-24 Page 70 K20PAR MAC 29-Mar-24 20:39 SET FLOW-CONTROL command 11722 subttl SET FLOW-CONTROL command 11723 11724 001166'02 000000 000000 %table(flotab) ; Flow-Control keywords 11725 001167'02 000000# 000000 %key2 , 0 11726 001001'03 156 157 156 145 000 11727 001170'02 000000# 000000 %keyf3 , 0, cm%inv 11728 001002'03 002000 000001 11729 001003'03 157 146 146 000 000 11730 001171'02 000000# 000001 %keyf3 , 1, cm%inv 11731 001004'03 002000 000001 11732 001005'03 157 156 000 000 000 11733 001172'02 000000# 000001 %key2 , 1 11734 001006'03 130 117 116 055 130 11735 001166'02 000004 000004 %tbend 11736 11737 chgsec(code,const) ;;FDB's are not in code, they're in const 11738 001173'02 000002 000000 sflfdb: flddb. .cmkey,,flotab,,XON-XOFF 11739 001174'02 000000 001166' 11740 001175'02 000000 000000 11741 001176'02 44 07 0 00 002722' 11742 retsec ;;Back to where-ever we started from 11743 11744 003742'01 201 01 0 00 000000# .setfl: movei t1, sflfdb 11745 003743'01 260 17 0 00 003673* call rfield ; Parse a keyword. 11746 003744'01 550 02 0 02 000000 hrrz t2, (t2) ; Get the value for the keyword (0 or 1). 11747 003745'01 202 02 0 00 003701* movem t2, pars3 ; Save into pars3. 11748 003746'01 336 00 0 00 003676* skipn definf ; In DEFINE? 11749 003747'01 260 17 0 00 003677* confrm ; No, get confirmation. 11750 003750'01 263 17 0 00 000000 ret 11751 11752 remark SET FLOW-CONTROL semantic action 11753 11754 003751'01 $setfl: extern handsh, flow ; And of our necessaries 11755 003751'01 332 01 0 00 003745* skipe t1, pars3 ; Get flow control option. 11756 003752'01 402 00 0 00 003541* setzm handsh ; If nonzero, turn off handshake. 11757 003753'01 202 01 0 00 003604* movem t1, flow 11758 003754'01 263 17 0 00 000000 ret 11759 k20par - Kermit-20 Parsing and Semantic Action Routines MACRO %53B(1254)-4 19:41 30-Mar-24 Page 71 K20PAR MAC 29-Mar-24 20:39 SET HANDSHAKE command 11760 subttl SET HANDSHAKE command 11761 11762 ;[217] Although little used and probably rarely necessary, make entering 11763 ; a character here as 'easy' as it is for changing the escape character. 11764 11765 001177'02 000000 000000 %table(hshtab) ; Handshake keywords (recommended) 11766 001200'02 000000# 000007 %key2 , .chbel ;[217] ^G 11767 001010'03 142 145 154 154 000 11768 001201'02 000000# 000015 %key2 , .chcrt ;[217] ^M or carriage return 11769 001011'03 103 122 000 000 000 11770 001202'02 000000# 000033 %key2 , .chesc ;[217] Escape or "altmode" 11771 001012'03 105 123 103 000 000 11772 001203'02 000000# 000012 %key2 , .chlfd ;[217] ^J or line-feed 11773 001013'03 114 106 000 000 000 11774 001204'02 000000# 000000 %key2 , .chnul ;[217] Special cased 11775 001014'03 156 157 156 145 000 11776 001205'02 000000# 000023 %key2 , .chcns ;[217] ^S 11777 001015'03 130 117 106 106 000 11778 001206'02 000000# 000021 %key2 , .chcnq ;[217] ^Q 11779 001016'03 130 117 116 000 000 11780 001177'02 000007 000007 %tbend 11781 11782 chgsec(code,const) ;;FDB's are not in code, they're in const 11783 001207'02 013001 001211' hndfdm: flddb. .cmcma,cm%sdh,,,,hndfdb ;[217] Used when unwinding a macro 11784 001210'02 000000 000000 11785 001211'02 010004 001214' hndfdb: flddb. .cmcfm,,,,,hndfd1 11786 001212'02 000000 000000 11787 001213'02 44 07 0 00 002724' 11788 001214'02 000004 001217' hndfd1: flddb. .cmkey,,hshtab,,,hndfd2 11789 001215'02 000000 001177' 11790 001216'02 44 07 0 00 002733' 11791 001217'02 001004 001222' hndfd2: flddb. .cmnum,,^d8,,,hndfd3 11792 001220'02 000000 000010 11793 001221'02 44 07 0 00 002533' 11794 001222'02 023004 000000 hndfd3: flddb. .cmtok,,token(<^>),,, 11795 001223'02 440700 002546' 11796 001224'02 44 07 0 00 002547' 11797 retsec ;;Back to where-ever we started from 11798 11799 cleans() 11800 11801 003755'01 265 16 0 00 005305' .setha: saveac ;[217] Needs registers 11802 003756'01 200 16 0 00 000000# guide ;[217] 11803 003757'01 260 17 0 00 003667* 11804 001225'02 000000000000# 11805 001514'04 143 150 141 162 141 11806 11807 003760'01 201 01 0 00 000000# movei t1, hndfdb ;[217] Parse a couple of alternatives 11808 003761'01 332 00 0 00 000000# skipe mdone ;[217] Unwinding a macro? 11809 003762'01 201 01 0 00 000000# movei t1, hndfdm ;[217] Yes, allow a comma to squeak through 11810 11811 003763'01 260 17 0 00 003470* call rflde ;[217] Try to get one of them 11812 003764'01 254 00 0 00 003771' ifskp. ;[217] Worked!! 11813 003765'01 120 06 0 00 000002 dmove q2, t2 ;[217] Save partial parse results 11814 003766'01 135 05 0 00 005473' ldb q1, [pointr (.cmfnp(q3),cm%fnc)] ;[217] Get function code. k20par - Kermit-20 Parsing and Semantic Action Routines MACRO %53B(1254)-4 19:41 30-Mar-24 Page 71-1 K20PAR MAC 29-Mar-24 20:39 SET HANDSHAKE command 11815 003767'01 200 10 0 00 000005 move q4, q1 ;[217] Save for downstream 11816 003770'01 254 00 0 00 003774' else. ;[217] Otherwise, failed the parse 11817 003771'01 336 00 0 00 003746* skipn definf ;[217] In DEFINE? 11818 003772'01 254 00 0 00 003501* jrst cmderr ;[217] No, then a definite parse error; allow retry 11819 003773'01 263 17 0 00 000000 ret ;[217] Return into DEFINE and see if that chokes 11820 003774'01 endif. ;[217] End handling COMND% returns 11821 11822 003774'01 302 05 0 00 000013 caie q1, .cmcma ;[217] Parsed a comma? 11823 003775'01 254 00 0 00 004000' ifskp. ;[217] We did, so must be unwinding a macro 11824 003776'01 201 05 0 00 000010 movei q1, .cmcfm ;[217] Turn it into a confirm and carry on 11825 003777'01 200 10 0 00 000005 move q4, q1 ;[217] Stomp into downstream, too 11826 004000'01 endif. 11827 11828 004000'01 302 05 0 00 000010 caie q1, .cmcfm ;[217] A confirm is very special cased 11829 004001'01 254 00 0 00 004005' ifskp. ;[217] It was, so default it 11830 004002'01 201 02 0 00 000023 movei t2, .chcns ;[217] Replace parse value with ^S 11831 004003'01 202 02 0 00 003751* movem t2, pars3 ;[217] Save where $setha wants to find it 11832 004004'01 263 17 0 00 000000 ret ;[217] Done, nothing left to parse 11833 004005'01 endif. ;[217] 11834 11835 004005'01 302 05 0 00 000000 caie q1, .cmkey ;[217] Common mnemonic? 11836 004006'01 254 00 0 00 004011' ifskp. ;[217] It was, so translate it by getting 11837 004007'01 550 02 0 06 000000 hrrz t2, (q2) ;[217] the keyword's associated value. 11838 004010'01 254 00 0 00 004041' jrst .seth1 ;[217] Make sure nothing bad leaked through 11839 004011'01 endif. ;[217] 11840 11841 004011'01 306 05 0 00 000001 cain q1, .cmnum ;[217] Number? 11842 004012'01 254 00 0 00 004041' jrst .seth1 ;[217] Must range check user specified value 11843 11844 remark q1, .cmtok ;[217] Otherwise, must have been a token 11845 dmove t1, [ esctkn ;[217] Possible mnemonics 11846 004013'01 120 01 0 00 005477' cm%xif ] ;[217] Load the no indirection flag 11847 004014'01 436 02 0 00 000000# orm t2, sbk+.cmflg ;[217] And dink the COMND% state block 11848 004015'01 260 17 0 00 003763* call rflde ;[217] Try to get one of them 11849 004016'01 254 00 0 00 004024' ifskp. ;[217] Worked!! 11850 004017'01 135 05 0 00 005304' ldb q1, [pointr (.cmfnp(t3),cm%fnc)] ;[217] Get function code. 11851 004020'01 120 06 0 00 000002 dmove q2, t2 ;[217] Save parse data and fdb selection 11852 remark q4, ;[217] But don't touch original parse 11853 004021'01 205 04 0 00 002000 movx t4, cm%xif ;[217] Load indirection flag again 11854 004022'01 412 04 0 00 000000# andcam t4, sbk+.cmflg ;[217] And restore the COMND% state block 11855 004023'01 254 00 0 00 004027' else. ;[217] Otherwise, failed the parse 11856 004024'01 205 04 0 00 002000 movx t4, cm%xif ;[217] Load indirection flag again 11857 004025'01 412 04 0 00 000000# andcam t4, sbk+.cmflg ;[217] restore the COMND% state block 11858 004026'01 254 00 0 00 003772* jrst cmderr ;[217] And handle the parse error, allowing reparse 11859 004027'01 endif. ;[217] End handling COMND% returns 11860 11861 004027'01 302 05 0 00 000000 caie q1, .cmkey ;[217] Was this relatively easy? 11862 004030'01 254 00 0 00 004033' ifskp. ;[217] Yep, let's grab and convert the character 11863 004031'01 550 02 0 06 000000 hrrz t2, (q2) ;[217] Pick up what would be the jump address 11864 004032'01 254 00 0 00 004041' jrst .seth1 ;[217] Make sure nothing bad leaked through 11865 004033'01 endif. 11866 11867 remark q1, .cmtok ;[217] A token is somewhat more difficult 11868 004033'01 621 07 0 00 777777 tlz q3, -1 ;[217] Isolate fdb we actually used 11869 004034'01 200 06 0 07 000001 move q2, .cmdat(q3) ;[217] Pick up the byte pointer to the character k20par - Kermit-20 Parsing and Semantic Action Routines MACRO %53B(1254)-4 19:41 30-Mar-24 Page 71-2 K20PAR MAC 29-Mar-24 20:39 SET HANDSHAKE command 11870 004035'01 134 02 0 00 000006 ildb t2, q2 ;[217] Load the token character (only one) 11871 004036'01 275 02 0 00 000100 subi t2, "@" ;[217] Bring down to control character range 11872 004037'01 316 02 0 00 005476' camn t2, [-21] ;[217] Was this our rubout hack? 11873 004040'01 201 02 0 00 000177 movei t2, 177 ;[217] Stomp in the correct value 11874 remark .seth1 ;[217] Make sure nothing bad leaked through 11875 11876 004041'01 .seth1: remark ;[217] Expects character to check in t2 11877 004041'01 325 02 0 00 004045' ifl. t2 ;[217] True gubbish? 11878 004042'01 200 01 0 00 000000# emsg ;[217] 11879 004043'01 104 00 0 00 000313 11880 001226'02 000000000000# 11881 001522'04 101 040 156 145 147 11882 004044'01 254 00 0 00 003631* jrst cmder1 ;[217] Failure, but allow reparse 11883 004045'01 endif. ;[217] 11884 11885 004045'01 305 02 0 00 000200 caige t2, 200 ;[217] Absurdly large? 11886 004046'01 254 00 0 00 004052' ifskp. ;[217] Give that a special squawk 11887 004047'01 200 01 0 00 000000# emsg <7 bit ASCII is not defined for values of octal 200 or above> ;[217] 11888 004050'01 104 00 0 00 000313 11889 001227'02 000000000000# 11890 001537'04 067 040 142 151 164 11891 004051'01 254 00 0 00 004044* jrst cmder1 ;[217] Failure, but allow reparse 11892 004052'01 endif. ;[217] 11893 11894 004052'01 307 02 0 00 000037 caig t2, 37 ; Control character? 11895 004053'01 254 00 0 00 004067' ifskp. ; Isn't 11896 004054'01 306 02 0 00 000177 cain t2, 177 ; Rubout? 11897 004055'01 254 00 0 00 004067' anskp. ; It is, so that's fine 11898 004056'01 200 04 0 00 000002 move t4, t2 ;[217] Isn't so let's start complaining 11899 004057'01 200 01 0 00 000000# emsg <"> ;" ;[217] Begin with a double quote 11900 004060'01 104 00 0 00 000313 11901 001230'02 000000000000# 11902 001553'04 042 000 000 000 000 11903 004061'01 200 01 0 00 000004 move t1, t4 ;[217] Load the poor character 11904 004062'01 104 00 0 00 000074 PBOUT% ;[217] Display what is wrong 11905 004063'01 200 01 0 00 000000# txmsg <" is not in ASCII control range, 0-37 or 177> ;[187] " Font crock 11906 004064'01 104 00 0 00 000076 11907 004065'01 320 12 0 00 004066' 11908 001231'02 000000000000# 11909 001554'04 042 040 151 163 040 11910 004066'01 254 00 0 00 004051* jrst cmder1 ;[194] 11911 004067'01 endif. ;[194] 11912 11913 004067'01 202 02 0 00 004003* .seth2: movem t2, pars3 ; Save into pars3. 11914 004070'01 306 10 0 00 000010 cain q4, .cmcfm ;[217] Original intent was to default everything? 11915 004071'01 263 17 0 00 000000 ret ;[217] Yes, do not confirm the confirmation 11916 004072'01 336 00 0 00 003771* skipn definf ;[77] In DEFINE? 11917 004073'01 260 17 0 00 003747* confrm ;[77] No, get confirmation. 11918 004074'01 263 17 0 00 000000 ret 11919 11920 11921 remark SET HANDSHAKE semantic action 11922 11923 004075'01 $setha: remark flow, handsh ; Necessaries defined above 11924 004075'01 332 01 0 00 004067* skipe t1, pars3 ;[143] Get the handshake option. k20par - Kermit-20 Parsing and Semantic Action Routines MACRO %53B(1254)-4 19:41 30-Mar-24 Page 71-3 K20PAR MAC 29-Mar-24 20:39 SET HANDSHAKE command 11925 004076'01 402 00 0 00 003753* setzm flow ;[143] If nonzero, turn off flow control. 11926 004077'01 260 17 1 00 001067* call @parity ;[223] Compute any parity 11927 004100'01 202 01 0 00 003752* movem t1, handsh ; Save it. 11928 004101'01 263 17 0 00 000000 ret ; Done. 11929 k20par - Kermit-20 Parsing and Semantic Action Routines MACRO %53B(1254)-4 19:41 30-Mar-24 Page 72 K20PAR MAC 29-Mar-24 20:39 SET HOST command 11930 subttl SET HOST command 11931 11932 ;[186] SET HOST is basically a restricted form of SET LINE with no .CMNUM 11933 11934 chgsec(code,const) ;;Chained FDB's are not in code, they're in const 11935 001232'02 000004 001235' shsfdb: flddb. .cmkey,,pseutb,,,shsfd1 11936 001233'02 000000 000615' 11937 001234'02 44 07 0 00 002743' 11938 001235'02 026044 001240' shsfd1: flddb. .cmnod,cm%nsf,,,,shsfd2 11939 001236'02 000000 000000 11940 001237'02 44 07 0 00 002746' 11941 001240'02 010005 000000 shsfd2: flddb. .cmcfm,cm%sdh,,,, ;[186] 11942 001241'02 000000 000000 11943 001242'02 44 07 0 00 002760' 11944 retsec ;;Back to where-ever we started from 11945 cleans() 11946 11947 004102'01 200 16 0 00 000000# .seths: guide ;[186] 11948 004103'01 260 17 0 00 003757* 11949 001243'02 000000000000# 11950 001565'04 154 157 143 141 154 11951 004104'01 403 01 0 00 000002 setzb t1,t2 ;[186] Cons up 10 .CHNUL's 11952 004105'01 124 01 0 00 003045* dmovem t1,atmbuf ;[186] Scrub a bit of the atom buffer 11953 004106'01 201 01 0 00 000000# movei t1, shsfdb ;[186] Allow NRT and pseudo-terminal 11954 004107'01 260 17 0 00 003743* call rfield ; Parse a keyword or node (NO CONFIRM!) ;[186] 11955 004110'01 135 04 0 00 005304' ldb t4, [pointr (.cmfnp(t3),cm%fnc)] ;[186] Get function code. 11956 004111'01 254 00 0 00 004121' callret .setl1 ;[186] Same parsing semantics 11957 k20par - Kermit-20 Parsing and Semantic Action Routines MACRO %53B(1254)-4 19:41 30-Mar-24 Page 73 K20PAR MAC 29-Mar-24 20:39 SET LINE command 11958 subttl SET LINE command 11959 11960 chgsec(code,const) ;;Chained FDB's are not in code, they're in const 11961 001244'02 001004 001247' slnfdb: flddb. .cmnum,,^d8,,,slnfd1 11962 001245'02 000000 000010 11963 001246'02 44 07 0 00 002766' 11964 001247'02 000004 001252' slnfd1: flddb. .cmkey,,pseutb,,,slnfd2 11965 001250'02 000000 000615' 11966 001251'02 44 07 0 00 002743' 11967 001252'02 026044 001255' slnfd2: flddb. .cmnod,cm%nsf,,,,slnfd3 11968 001253'02 000000 000000 11969 001254'02 44 07 0 00 002746' 11970 001255'02 010005 000000 slnfd3: flddb. .cmcfm,cm%sdh,,,, 11971 001256'02 000000 000000 11972 001257'02 44 07 0 00 002774' 11973 retsec ;;Back to where-ever we started from 11974 cleans() 11975 11976 004112'01 200 16 0 00 000000# .setln: guide 11977 004113'01 260 17 0 00 004103* 11978 001260'02 000000000000# 11979 001574'04 164 157 040 160 150 11980 004114'01 403 01 0 00 000002 setzb t1,t2 ;[186] Cons up 10 .CHNUL's 11981 004115'01 124 01 0 00 004105* dmovem t1,atmbuf ;[186] Scrub a bit of the atom buffer 11982 004116'01 201 01 0 00 000000# movei t1, slnfdb ;[186] Allow NRT and pseudo-terminal 11983 004117'01 260 17 0 00 004107* call rfield ; Parse a tty number. 11984 004120'01 135 04 0 00 005304' ldb t4, [pointr (.cmfnp(t3),cm%fnc)] ; Get function code. 11985 11986 004121'01 306 04 0 00 000000 .setl1: cain t4, .cmkey ;[186] Parsed a keyword 11987 004122'01 254 00 0 00 003010' callret .conn1 ;[186] Handle as in CONNECT 11988 004123'01 306 04 0 00 000026 cain t4, .cmnod ;[186] Is it a DECnet node? 11989 004124'01 254 00 0 00 003010' callret .conn1 ;[186] Handle as in CONNECT 11990 004125'01 306 04 0 00 000001 cain t4, .cmnum ; Is it a TTY number? 11991 004126'01 254 00 0 00 003010' callret .conn1 ;[186] Handle as in CONNECT 11992 004127'01 302 04 0 00 000010 caie t4, .cmcfm ;[186] Confirmed? 11993 004130'01 254 00 0 00 004134' ifskp. ;[186] Break the connection 11994 dmove t1, [ .cmcfm ;[186] Pass that special situation back 11995 004131'01 120 01 0 00 005501' .dvnul ] ;[186] And that the keyword was "close" 11996 004132'01 124 01 0 00 004075* dmovem t1, pars3 ;[186] Side effect the parse variables 11997 004133'01 263 17 0 00 000000 ret ;[186] Done 11998 004134'01 endif. ;[186] 11999 12000 004134'01 334 01 0 00 000000# ermsg% (,r) ;[186] 12001 004135'01 254 00 0 00 004141' 12002 004136'01 202 01 0 00 002275* 12003 004137'01 104 00 0 00 000313 12004 004140'01 254 00 0 00 002655* 12005 001261'02 000000000000# 12006 001606'04 113 105 122 115 111 12007 12008 k20par - Kermit-20 Parsing and Semantic Action Routines MACRO %53B(1254)-4 19:41 30-Mar-24 Page 74 K20PAR MAC 29-Mar-24 20:39 SET INCOMPLETE command 12009 subttl SET INCOMPLETE command 12010 12011 001262'02 000000 000000 %table(inctab) ;[194] 12012 001263'02 000000# 000000 %key2 , 0 ;[194] 12013 001017'03 144 151 163 143 141 12014 001264'02 000000# 000001 %key2 , 1 ;[194] 12015 001021'03 153 145 145 160 000 12016 001262'02 000002 000002 %tbend ;[194] 12017 12018 chgsec(code,const) ;;FDB's are not in code, they're in const 12019 001265'02 000002 000000 stbfdb: flddb. .cmkey,,inctab,,,, ;[194] 12020 001266'02 000000 001262' 12021 001267'02 000000 000000 12022 001270'02 44 07 0 00 003000' 12023 retsec ;;Back to where-ever we started from 12024 12025 004141'01 200 16 0 00 000000# .setab: guide ;[42] SET INCOMPLETE (file disposition) 12026 004142'01 260 17 0 00 004113* 12027 001271'02 000000000000# 12028 001617'04 146 151 154 145 040 12029 004143'01 201 01 0 00 000000# movei t1, stbfdb ;[194] 12030 004144'01 260 17 0 00 004117* call rfield ; Parse & confirm. 12031 004145'01 550 02 0 02 000000 hrrz t2, (t2) 12032 004146'01 202 02 0 00 004132* movem t2, pars3 12033 004147'01 336 00 0 00 004072* skipn definf ;[77] In DEFINE? 12034 004150'01 260 17 0 00 004073* confrm ;[77] No, get confirmation. 12035 004151'01 263 17 0 00 000000 ret 12036 12037 remark SET INCOMPLETE semantic action 12038 12039 004152'01 $setab: extern abtfil ; Our necessary 12040 004152'01 200 01 0 00 004146* move t1, pars3 ; Just save what we parsed. 12041 004153'01 202 01 0 00 000000* movem t1, abtfil 12042 004154'01 263 17 0 00 000000 ret 12043 k20par - Kermit-20 Parsing and Semantic Action Routines MACRO %53B(1254)-4 19:41 30-Mar-24 Page 75 K20PAR MAC 29-Mar-24 20:39 SET SEND/RECEIVE command dispatcher. 12044 subttl SET SEND/RECEIVE command dispatcher. 12045 12046 004155'01 550 01 1 00 004152* $setrs: hrrz t1, @pars3 ;[223] ; SEND/RECEIVE. Address of variable to set. 12047 004156'01 200 02 0 00 003713* move t2, pars4 ; The value that was parsed. 12048 004157'01 336 03 0 00 003000* skipn t3, pars5 ;[196] Do we have a tertiary (double) value? 12049 004160'01 254 00 0 00 004165' ifskp. ;[196] Yes 12050 004161'01 316 03 0 00 005301' camn t3, [ .infin ] ;[212] Our talsiman for zero? 12051 004162'01 400 03 0 00 000000 setz t3, ;[212] Stomp appropriately 12052 004163'01 124 02 0 01 000000 dmovem t2, (t1) ;[196] Save a double value 12053 004164'01 254 00 0 00 004166' else. ;[196] No, it's a single value 12054 004165'01 202 02 0 01 000000 movem t2, (t1) ; Save the value. 12055 004166'01 endif. ;[196] 12056 004166'01 263 17 0 00 000000 ret 12057 k20par - Kermit-20 Parsing and Semantic Action Routines MACRO %53B(1254)-4 19:41 30-Mar-24 Page 76 K20PAR MAC 29-Mar-24 20:39 SET ITS-BINARY command 12058 subttl SET ITS-BINARY command 12059 12060 chgsec(code,const) ;;FDB's are not in code, they're in const 12061 001272'02 000002 000000 sitfdb: flddb. .cmkey,,offon,,on 12062 001273'02 000000 001121' 12063 001274'02 000000 000000 12064 001275'02 44 07 0 00 002264' 12065 retsec ;;Back to where-ever we started from 12066 12067 004167'01 200 16 0 00 000000# .setit: guide ; Issue guide word. 12068 004170'01 260 17 0 00 004142* 12069 001276'02 000000000000# 12070 001623'04 146 157 162 155 141 12071 004171'01 201 01 0 00 000000# movei t1, sitfdb 12072 004172'01 260 17 0 00 004144* call rfield ; Parse a keyword. 12073 004173'01 550 02 0 02 000000 hrrz t2, (t2) ; Get the value for the keyword (0 or 1). 12074 004174'01 202 02 0 00 004155* movem t2, pars3 ; Save into pars3. 12075 004175'01 336 00 0 00 004147* skipn definf ;[77] In DEFINE? 12076 004176'01 260 17 0 00 004150* confrm ;[77] No, get confirmation. 12077 004177'01 263 17 0 00 000000 ret 12078 12079 remark SET ITS-BINARY semantic action 12080 12081 004200'01 $setit: extern itsflg ; and of our necessary 12082 004200'01 200 01 0 00 004174* move t1, pars3 ; Just save the value in the ITS flag. 12083 004201'01 202 01 0 00 003731* movem t1, itsflg 12084 004202'01 476 00 0 00 003736* setom autbyt ;[232] Force auto-byte 12085 004203'01 402 00 0 00 003740* setzm tbtflg ;[232] Clear 36 bit byte size 12086 004204'01 402 00 0 00 003737* setzm ebtflg ;[232] Clear 8 bit byte size 12087 004205'01 263 17 0 00 000000 ret 12088 k20par - Kermit-20 Parsing and Semantic Action Routines MACRO %53B(1254)-4 19:41 30-Mar-24 Page 77 K20PAR MAC 29-Mar-24 20:39 Storage for SET PROMPT prompt processing 12089 subttl Storage for SET PROMPT prompt processing 12090 12091 chgsec(code,data) ;[248] Writable storage is in DATA .PSECT 12092 12093 000003'05 prompx: intern prompx ;[248] Only used by K20MIT, actually 12094 000003'05 block atmbln ;[248] Allow a foolishly long prompt 12095 000144'05 block 1 ;[248] And space for the right pointy bracket 12096 000145' %eoprm==. ;[248] Save end or prompt location 12097 000003'05 reloc prompx ;[248] Get back to the beginning 12098 ;[248] to overwrite with default 12099 000003'05 113 145 162 155 151 asciz/Kermit-20>/ ; Program prompt text (replacable) 12100 000145'05 reloc %eoprm ;[248] Back to allocating regular storage 12101 000142 %prmln==%eoprm-prompx ;[248] Save length of area in words 12102 12103 000145'05 tpromp: block %prmln ;[248] Temporary staging area for parsed prompt 12104 12105 cleans(<%eoprm,%prmln>) ;[248] Clean up working symbols 12106 retsec ;[248] Back to code 12107 12108 k20par - Kermit-20 Parsing and Semantic Action Routines MACRO %53B(1254)-4 19:41 30-Mar-24 Page 78 K20PAR MAC 29-Mar-24 20:39 SET prompt command 12109 subttl SET prompt command 12110 12111 ; Originally [137], but greatly rewritten here. Also allows prompt 12112 ; to be part of DEFINE. The advantage is that you can have the macro 12113 ; set the prompt to be the name of the macro, which can help you recall 12114 ; what parameters you have in effect. 12115 ; 12116 ; Added C-escape-sequence expansion to actually count the string in 12117 ; the atom buffer. Added character counting and limits to eliminate 12118 ; the dreaded Charlie C. Kim effect, an early indication of the necessity 12119 ; of the Kermit protocol. 12120 12121 ; N.B., Note how argument is passed in .CMDEF, this is a MACRO limitation 12122 12123 chgsec(code,const) ;;FDB's are not in code, they're in const 12124 001277'02 021006 001303' kprmpt: fld(.cmqst,cm%fnc)!cm%hpp!cm%dpp!kprmp1 ;[190] .cmfnp 12125 001300'02 000000 000000 0 ;[190] .cmdat (none) 12126 001301'02 000000000000# cascii () ;[190] .cmhlp 12127 001625'04 113 105 122 115 111 12128 001302'02 000000000000# cascii ("Kermit-20>") ;[190] .cmdef 12129 001633'04 042 113 145 162 155 12130 001303'02 017004 000000 kprmp1: fld(.cmtxt,cm%fnc)!cm%hpp ;[190] .cmfnp 12131 001304'02 000000 000000 0 ;[190] .cmdat (none) 12132 001305'02 000000000000# cascii () ;[190] .cmhlp 12133 001636'04 113 105 122 115 111 12134 retsec ;;Restore psects 12135 12136 004206'01 200 16 0 00 000000# .setpr: guide ; Parse the rest of the SET PROMPT command. 12137 004207'01 260 17 0 00 004170* 12138 001306'02 000000000000# 12139 001644'04 164 157 000 000 000 12140 004210'01 403 01 0 00 000002 setzb t1, t2 ;[190] Cons up some .chnul 12141 004211'01 124 01 0 00 004115* dmovem t1, atmbuf ;[190] Give the atom buffer a scrub a dub 12142 004212'01 336 00 0 00 000432* ifmn. vtermf ;[186] If virtual terminal, then use local name 12143 004213'01 254 00 0 00 004227' 12144 004214'01 265 16 0 00 005367' saveac ;[248] Dynamic FDB needs an extra AC 12145 004215'01 265 16 0 00 003011* anstkv (q1,^d4) ;[190] Build the fdb on the fly 12146 004216'01 000000 000004 12147 004217'01 415 05 0 17 777773 12148 004220'01 120 01 0 00 000000# dmove t1, kprmpt ;[190] Load fdb and default (none) 12149 004221'01 124 01 0 05 000000 dmovem t1, .cmfnp(q1) ;[190] Store both in dynamic block 12150 004222'01 200 01 0 00 000000# move t1,kprmpt+.cmhlp ;[190] Load the help text pointer 12151 004223'01 561 02 0 00 000000* hrroi t2, myprom ;[190] But default prompt is our node name 12152 004224'01 124 01 0 05 000002 dmovem t1, .cmhlp(q1) ;[190] Store both in dynamic block 12153 004225'01 200 01 0 00 000005 move t1, q1 ;[190] Load pointer to new fdb 12154 004226'01 254 00 0 00 004231' else. ;[190] Otherwise use vanilla default 12155 004227'01 265 16 0 00 005503' saveac ;[248] And will only need one register 12156 004230'01 201 01 0 00 000000# movei t1, kprmpt ;[190] Original prompt 12157 004231'01 endif. ;[190] End dynamic fdb build 12158 move q2, [ ;[248] Load temporary prompt working area 12159 004231'01 200 06 0 00 005511' point 7, tpromp ] ;[248] For later work by semantic action 12160 12161 004232'01 260 17 0 00 004172* call rfield ;[190] Parse for some kind of string 12162 move t1, [ ;[248] Copy and count the parsed string 12163 004233'01 200 01 0 00 005377' point 7, atmbuf ] ;[248] From the atom buffer k20par - Kermit-20 Parsing and Semantic Action Routines MACRO %53B(1254)-4 19:41 30-Mar-24 Page 78-1 K20PAR MAC 29-Mar-24 20:39 SET prompt command 12164 004234'01 200 02 0 00 000006 move t2, q2 ;[248] into temporary prompt 12165 004235'01 260 17 0 00 001035* call asczcp ;[248] Move the string on top of itself, returning count 12166 004236'01 373 00 0 00 000003 sosle t3 ;[248] Don't count the NUL at the end!! 12167 004237'01 254 00 0 00 004242' ifskp. ;[248] Didn't get anything, so fix that up 12168 004240'01 402 00 0 00 000000# setzm tpromp ;[248] No temporary prompt 12169 004241'01 400 03 0 00 000000 setz t3, ;[248] Clamp to zero length 12170 004242'01 endif. ;[248] End case post count fix up 12171 12172 004242'01 200 04 0 00 000006 move t4, q2 ;[248] Load pointer to string to expand 12173 004243'01 124 03 0 00 004200* dmovem t3, pars3 ;[248] Pass into semantic action 12174 004244'01 336 00 0 00 004175* skipn definf ;[77] In DEFINE? 12175 004245'01 260 17 0 00 004176* confrm ;[77] No, get confirmation. 12176 12177 004246'01 263 17 0 00 000000 ret 12178 k20par - Kermit-20 Parsing and Semantic Action Routines MACRO %53B(1254)-4 19:41 30-Mar-24 Page 79 K20PAR MAC 29-Mar-24 20:39 Execute the SET PROMPT command. 12179 subttl Execute the SET PROMPT command. 12180 12181 ; Rewritten for [194], [203] and [248] 12182 12183 chgsec(code,const) ;[248] String constants go in CONST .PSECT 12184 001307'02 000000 000003 defkpr: ^d3 ;[248] Two words of text plus trailing NUL 12185 001310'02 000000 001311' defkpt ;[248] Address of prompt text 12186 001311'02 113 145 162 155 151 defkpt: asciz "Kermit-20>" ;[248] Default Kermit prompt text 12187 12188 ; Quickly copies the expanded, length checked string that 12189 ; .setpr built in the temporary prompt holding area. 12190 12191 001314'02 016 00 0 00 000000 movprm: movslj 0,0 ;[203] Move string left justified (fastest) 12192 001315'02 000000 000000 .chnul ;[203] No fill, actually 12193 retsec ;[248] Back into code 12194 12195 extern chrtab, cescxp ;[203] C-escape-sequence expansion 12196 12197 004247'01 265 16 0 00 005305' $setpr: saveac ;[248] Don't let piggy movslj trash these 12198 004250'01 120 07 0 00 004243* dmove q3, pars3 ;[248] Load parsed string 12199 12200 004251'01 333 03 0 00 000007 skiple t3, q3 ;[248] Load and test length 12201 004252'01 254 00 0 00 004257' ifskp. ;[248] Zero length or gubbish? 12202 004253'01 120 01 0 00 000000# dmove t1, defkpr ;[248] Fine, ignore it 12203 004254'01 201 03 0 00 000000# movei t3, prompx ;[248] Putting default into prompt 12204 004255'01 123 01 0 00 005421' xblt. t1 ;[248] Drop it in 12205 004256'01 263 17 0 00 000000 ret ;[248] We're done 12206 004257'01 endif. ;[248] End case of no prompt or gubbish 12207 12208 004257'01 200 01 0 00 000010 move t1, q4 ;[248] Source string 12209 004260'01 200 02 0 00 000010 move t2, q4 ;[248] Will be expanding (I.E., shrinking) in place 12210 remark t3, q3 ;[248] Loaded and checked by skiple, above 12211 004261'01 201 04 0 00 001072* movei t4, chrtab ;[248] Not doing upper casing 12212 12213 004262'01 260 17 0 00 001073* call cescxp ;[203] Expand any C-escape-sequences 12214 004263'01 334 00 0 00 000000 %ermsg (,r) ;[248] Failed?? 12215 004264'01 254 00 0 00 004270' 12216 004265'01 265 01 0 00 002620* 12217 004266'01 000000000000# 12218 004267'01 254 00 0 00 004140* 12219 001645'04 123 145 164 040 120 12220 004270'01 337 01 0 00 000003 skipg t1, t3 ;[248] Load and check updated length 12221 004271'01 334 00 0 00 000000 %ermsg (,r) ;[248] Failed?? 12222 004272'01 254 00 0 00 004276' 12223 004273'01 265 01 0 00 004265* 12224 004274'01 000000000000# 12225 004275'01 254 00 0 00 004267* 12226 001654'04 123 145 164 040 120 12227 12228 004276'01 200 02 0 00 000010 move t2, q4 ;[248] Load source 12229 004277'01 403 03 0 00 000006 setzb t3, q2 ;[203] Section local pointers 12230 004300'01 200 04 0 00 000001 move t4, t1 ;[203] Equal lengths; no filling 12231 004301'01 200 05 0 00 005512' move q1,[point 7, prompx] ;[203] What dpromp will use 12232 004302'01 123 01 0 00 000000# extend t1, movprm ;[203] Copy the string over, wee!! 12233 004303'01 600 00 0 00 000000 nop ;[203] Ignore +1 which should never happen k20par - Kermit-20 Parsing and Semantic Action Routines MACRO %53B(1254)-4 19:41 30-Mar-24 Page 79-1 K20PAR MAC 29-Mar-24 20:39 Execute the SET PROMPT command. 12234 004304'01 136 03 0 00 000005 idpb t3, q1 ;[248] Tie off the prompt 12235 004305'01 263 17 0 00 000000 ret ;[203] That's it, really 12236 k20par - Kermit-20 Parsing and Semantic Action Routines MACRO %53B(1254)-4 19:41 30-Mar-24 Page 80 K20PAR MAC 29-Mar-24 20:39 SET RETRY command 12237 subttl SET RETRY command 12238 12239 001316'02 000000 000000 %table(retrtb) ;[194] 12240 001317'02 000000# 000000 %key2 ,0 ;[194] 12241 001022'03 151 156 151 164 151 12242 001320'02 000000# 000001 %key2 ,1 ;[194] 12243 001026'03 160 141 143 153 145 12244 001316'02 000002 000002 %tbend ;[194] 12245 12246 chgsec(code,const) ;;FDB's are not in code, they're in const 12247 001321'02 000002 000000 srefdb: flddb. .cmkey,,retrtb,,,, ;[194] 12248 001322'02 000000 001316' 12249 001323'02 000000 000000 12250 001324'02 44 07 0 00 003002' 12251 001325'02 001006 000000 srifdb: flddb. .cmnum,,^d10,,5,, 12252 001326'02 000000 000012 12253 001327'02 44 07 0 00 003004' 12254 001330'02 44 07 0 00 002017' 12255 001331'02 001006 000000 srpfdb: flddb. .cmnum,,^d10,,16 12256 001332'02 000000 000012 12257 001333'02 44 07 0 00 003017' 12258 001334'02 44 07 0 00 003031' 12259 retsec ;;Back to where-ever we started from 12260 12261 004306'01 200 16 0 00 000000# .setre: guide ;[37] SET RETRY 12262 004307'01 260 17 0 00 004207* 12263 001335'02 000000000000# 12264 001663'04 155 141 170 151 155 12265 004310'01 201 01 0 00 000000# movei t1, srefdb ;[194] 12266 004311'01 260 17 0 00 004232* call rfield 12267 004312'01 550 02 0 02 000000 hrrz t2, (t2) ; Get the keyword index 12268 004313'01 202 02 0 00 004250* movem t2, pars3 12269 004314'01 200 16 0 00 000000# guide ; Prompt for the value 12270 004315'01 260 17 0 00 004307* 12271 001336'02 000000000000# 12272 001666'04 164 157 000 000 000 12273 004316'01 201 01 0 00 000000# movei t1, srifdb ;[194] Let's assume it was initial-connection 12274 004317'01 332 00 0 00 004313* skipe pars3 ;[194] But!! Was it? 12275 004320'01 201 01 0 00 000000# movei t1, srpfdb ;[194] No, doing it for packets 12276 004321'01 260 17 0 00 004311* call rfield 12277 004322'01 202 02 0 00 004156* movem t2, pars4 12278 12279 004323'01 325 02 0 00 004343' ifl. t2 ;[194] Negative counts are silly 12280 004324'01 200 01 0 00 000000# emsg ;[187] 12281 004325'01 104 00 0 00 000313 12282 001337'02 000000000000# 12283 001667'04 101 040 156 145 147 12284 004326'01 336 00 0 00 004317* ifmn. pars3 ;[194] Set if packets 12285 004327'01 254 00 0 00 004334' 12286 004330'01 200 01 0 00 000000# txmsg ;[194] 12287 004331'01 104 00 0 00 000076 12288 004332'01 320 12 0 00 004333' 12289 001340'02 000000000000# 12290 001675'04 160 141 143 153 145 12291 004333'01 254 00 0 00 004337' else. ;[187] k20par - Kermit-20 Parsing and Semantic Action Routines MACRO %53B(1254)-4 19:41 30-Mar-24 Page 80-1 K20PAR MAC 29-Mar-24 20:39 SET RETRY command 12292 004334'01 200 01 0 00 000000# txmsg ;[194] 12293 004335'01 104 00 0 00 000076 12294 004336'01 320 12 0 00 004337' 12295 001341'02 000000000000# 12296 001700'04 151 156 151 164 151 12297 004337'01 endif. ;[187] 12298 004337'01 200 01 0 00 000000# txmsg < is illogical> ;[194] Go tell 'em, Spock-o 12299 004340'01 104 00 0 00 000076 12300 004341'01 320 12 0 00 004342' 12301 001342'02 000000000000# 12302 001706'04 040 151 163 040 151 12303 004342'01 254 00 0 00 004066* jrst cmder1 ;[194] 12304 004343'01 endif. ;[194] 12305 12306 004343'01 336 00 0 00 004244* skipn definf ;[77] In DEFINE? 12307 004344'01 260 17 0 00 004245* confrm ;[77] No, get confirmation. 12308 004345'01 263 17 0 00 000000 ret 12309 12310 remark SET RETRY semantic action 12311 12312 004346'01 $setre: extern imxtry, maxtry ; Our necessaries 12313 004346'01 120 01 0 00 004326* dmove t1, pars3 ;[37] SET RETRY 12314 remark t2, pars4 ;[194] 12315 004347'01 202 02 1 01 005513' movem t2, @[exp imxtry, maxtry](t1) 12316 004350'01 263 17 0 00 000000 ret 12317 k20par - Kermit-20 Parsing and Semantic Action Routines MACRO %53B(1254)-4 19:41 30-Mar-24 Page 81 K20PAR MAC 29-Mar-24 20:39 SET SPEED (BAUD RATE) 12318 subttl SET SPEED (BAUD RATE) 12319 12320 001343'02 000000 000000 %table(baudtb) ;Table of DH11 supported speeds 12321 001344'02 000000# 000156 %key2 <110>,^d110 12322 001030'03 061 061 060 000 000 12323 001345'02 000000# 002260 %key2 <1200>,^d1200 12324 001031'03 061 062 060 060 000 12325 001346'02 000000# 000226 %key2 <150>,^d150 12326 001032'03 061 065 060 000 000 12327 001347'02 000000# 003410 %key2 <1800>,^d1800 12328 001033'03 061 070 060 060 000 12329 001350'02 000000# 003720 %key2 <2000>,^d2000 12330 001034'03 062 060 060 060 000 12331 001351'02 000000# 004540 %key2 <2400>,^d2400 12332 001035'03 062 064 060 060 000 12333 001352'02 000000# 000454 %key2 <300>,^d300 12334 001036'03 063 060 060 000 000 12335 001353'02 000000# 007020 %key2 <3600>,^d3600 12336 001037'03 063 066 060 060 000 12337 001354'02 000000# 011300 %key2 <4800>,^d4800 12338 001040'03 064 070 060 060 000 12339 001355'02 000000# 001130 %key2 <600>,^d600 12340 001041'03 066 060 060 000 000 12341 001356'02 000000# 016040 %key2 <7200>,^d7200 12342 001042'03 067 062 060 060 000 12343 001357'02 000000# 022600 %key2 <9600>,^d9600 12344 001043'03 071 066 060 060 000 12345 001343'02 000014 000014 %tbend 12346 12347 chgsec(code,const) ;;FDB's are not in code, they're in const 12348 001360'02 000000 000000 sxpfdb: flddb. .cmkey,,baudtb 12349 001361'02 000000 001343' 12350 retsec ;;Back to where-ever we started from 12351 12352 004351'01 200 16 0 00 000000# .setxp: guide 12353 004352'01 260 17 0 00 004315* 12354 001362'02 000000000000# 12355 001711'04 164 157 000 000 000 12356 004353'01 201 01 0 00 000000# movei t1, sxpfdb 12357 004354'01 260 17 0 00 004321* call rfield 12358 004355'01 550 02 0 02 000000 hrrz t2, (t2) ; Get the value for the keyword (0 or 1). 12359 004356'01 202 02 0 00 004346* movem t2, pars3 ; Save into pars3. 12360 004357'01 336 00 0 00 004343* skipn definf ;[77] In DEFINE? 12361 004360'01 260 17 0 00 004344* confrm ;[77] No, get confirmation. 12362 004361'01 263 17 0 00 000000 ret 12363 12364 remark SET SPEED semantic action 12365 12366 004362'01 $setsp: extern netjfn, vtermf ;[194] Our necessaries 12367 extern speed, setspd ;[194] These, too 12368 extern ttyjfn ;[186] 12369 12370 004362'01 336 00 0 00 004212* ifmn. vtermf ;[186] SET SPEED is senseless if virtual 12371 004363'01 254 00 0 00 004373' 12372 004364'01 476 00 0 00 000000* setom speed ;[186] These have no speed k20par - Kermit-20 Parsing and Semantic Action Routines MACRO %53B(1254)-4 19:41 30-Mar-24 Page 81-1 K20PAR MAC 29-Mar-24 20:39 SET SPEED (BAUD RATE) 12373 004365'01 476 00 0 00 000000* setom setspd ;[186] Kind of set the speed... 12374 004366'01 334 00 0 00 000000 %ermsg (,r) 12375 004367'01 254 00 0 00 004373' 12376 004370'01 265 01 0 00 004273* 12377 004371'01 000000000000# 12378 004372'01 254 00 0 00 004275* 12379 001712'04 103 141 156 040 156 12380 004373'01 endif. ;[186] End case non-physical terminal 12381 12382 004373'01 200 03 0 00 004356* move t3, pars3 ; Get the speed that was parsed. 12383 004374'01 202 03 0 00 004364* movem t3, speed ; Record it. 12384 004375'01 337 01 0 00 000000* skipg t1, netjfn ;[186] Get the output terminal JFN. 12385 004376'01 200 01 0 00 001137* move t1, ttyjfn ;[186] Unless using local terminal 12386 004377'01 201 02 0 00 000026 movx t2, .mospd ; Speed to set. 12387 004400'01 504 03 0 00 004374* hrl t3, speed ; Input and output speeds the same. 12388 004401'01 104 00 0 00 000077 MTOPR ; Attempt to set it. 12389 004402'01 320 12 0 00 004404' %jserr (,r) 12390 004403'01 254 00 0 00 004407' 12391 004404'01 265 01 0 00 004370* 12392 004405'01 000000 000000 12393 004406'01 254 00 0 00 004372* 12394 004407'01 476 00 0 00 004365* setom setspd ;[161] Flag that speed was explicitly set. 12395 004410'01 263 17 0 00 000000 ret 12396 k20par - Kermit-20 Parsing and Semantic Action Routines MACRO %53B(1254)-4 19:41 30-Mar-24 Page 82 K20PAR MAC 29-Mar-24 20:39 SET SERVER-TIMEOUT semantic action 12397 subttl SET SERVER-TIMEOUT semantic action 12398 12399 ; Command is at a higher level because this is where Kermit-10 puts it 12400 ; and I keep mixing the two up. 12401 ; 12402 ; Further, it seems counter-intuitive to put server-timeout in as a 12403 ; receive option when what is actually happening is that the server is 12404 ; *sending* and not recieving. 12405 ; 12406 ; None the less, this way to do it is invisible and the other is 12407 ; visible because that's the way it's always been. 12408 ; 12409 ; Parse is handled by common .setim. 12410 12411 004411'01 120 01 0 00 004322* $setst: dmove t1, pars4 ;[217] Load milliseconds and floating seconds 12412 004412'01 124 01 0 00 000000* dmovem t1, srvtim## ;[217] Store them 12413 004413'01 263 17 0 00 000000 ret ;[217] That's it, really 12414 12415 k20par - Kermit-20 Parsing and Semantic Action Routines MACRO %53B(1254)-4 19:41 30-Mar-24 Page 83 K20PAR MAC 29-Mar-24 20:39 SET TVT-BINARY command 12416 subttl SET TVT-BINARY command 12417 12418 001363'02 000000 000000 %table(tvtkey) ;[182] Table for parsing TVT keywords 12419 001364'02 000000# 000000# %key3 , 0, 1 ;[182] Figure it out for me 12420 001044'03 141 165 164 157 155 12421 001046'03 000000 000001 12422 001365'02 000000# 000000# %key3 , 0, 0 ;[182] Override to never negotiate 12423 001047'03 157 146 146 000 000 12424 001050'03 000000 000000 12425 001366'02 000000# 000000# %key3 , 1, 0 ;[182] Override to ALWAYS negotiate 12426 001051'03 157 156 000 000 000 12427 001052'03 000001 000000 12428 001363'02 000003 000003 %tbend ;[182] Which will break on LAT, CTERM, etc.. 12429 12430 chgsec(code,const) ;;FDB's are not in code, they're in const 12431 001367'02 000002 000000 stafdb: flddb. .cmkey,,tvtkey,,automatic ;[194] 12432 001370'02 000000 001363' 12433 001371'02 000000 000000 12434 001372'02 44 07 0 00 003032' 12435 retsec ;;Back to where-ever we started from 12436 12437 004414'01 200 16 0 00 000000# .setta: guide 12438 004415'01 260 17 0 00 004352* 12439 001373'02 000000000000# 12440 001724'04 156 145 147 157 164 12441 004416'01 201 01 0 00 000000# movei t1, stafdb ;[182] 12442 004417'01 260 17 0 00 004354* call rfield ; Parse a keyword. 12443 004420'01 550 02 0 02 000000 hrrz t2, (t2) ; Get the value for the keyword (0 or 1). 12444 004421'01 202 02 0 00 004373* movem t2, pars3 ; Save into pars3. 12445 004422'01 336 00 0 00 004357* skipn definf ;[77] In DEFINE? 12446 004423'01 260 17 0 00 004360* confrm ;[77] No, get confirmation. 12447 004424'01 263 17 0 00 000000 ret 12448 12449 remark SET TVT-BINARY semantic action 12450 12451 ; Request binary-mode negotion with ARPAnet TAC. 12452 ; 12453 ;[129] This command added as part of edit 129. 12454 ;[182] Help message updated for automatic mode 12455 12456 004425'01 $setta: extern tvtflg, tvtchk ;[194] Our necessaries 12457 extern chktvt ;[194] Ditto 12458 12459 004425'01 200 01 0 00 004421* move t1, pars3 ; Get the value that was parsed. 12460 004426'01 200 02 0 01 000000 move t2,(t1) ;[182] De-reference to get values 12461 004427'01 550 03 0 00 000002 hrrz t3,t2 ;[182] Right halfword is automatic mode 12462 004430'01 554 02 0 00 000002 hlrz t2,t2 ;[182] Left halfword is the TVT-Binary mode 12463 004431'01 326 03 0 00 004434' ife. t3 ;[194] Setting automatic mode? 12464 004432'01 124 02 0 00 001042* dmovem t2,tvtflg ;[182] No, override both TVT line 12465 004433'01 263 17 0 00 000000 ret ;[182] and turn off line discovery 12466 004434'01 endif. ;[194] 12467 12468 004434'01 250 03 0 00 000000* exch t3, tvtchk ;[182] Update TVT checking mode, get old mode 12469 004435'01 326 03 0 00 004406* jumpn t3,R ;[182] Wants automatic and it was already set? 12470 004436'01 332 00 0 00 004362* skipe vtermf ;[186] Virtual terminal? k20par - Kermit-20 Parsing and Semantic Action Routines MACRO %53B(1254)-4 19:41 30-Mar-24 Page 83-1 K20PAR MAC 29-Mar-24 20:39 SET TVT-BINARY command 12471 004437'01 263 17 0 00 000000 ret ;[186] NRT and PTY don't do TVT 12472 004440'01 260 17 0 00 000000* call chktvt ;[182] Went from override to automatic, check 12473 004441'01 263 17 0 00 000000 ret ; Done. 12474 k20par - Kermit-20 Parsing and Semantic Action Routines MACRO %53B(1254)-4 19:41 30-Mar-24 Page 84 K20PAR MAC 29-Mar-24 20:39 SET RECEIVE parameters 12475 subttl SET RECEIVE parameters 12476 12477 001374'02 000000 000000 %table(srtabl) 12478 001375'02 000000# 000000# %key3 , .seteo, reolch## 12479 001053'03 145 156 144 055 157 12480 001056'03 000000# 000000* 12481 001376'02 000000# 000000# %key3 , .setpk, rpsiz## 12482 001057'03 160 141 143 153 145 12483 001062'03 000000# 000000* 12484 001377'02 000000# 000000# %key3 , .setpc, rpadch## 12485 001063'03 160 141 144 143 150 12486 001065'03 000000# 000000* 12487 001400'02 000000# 000000# %key3 , .setpd, rpadn## 12488 001066'03 160 141 144 144 151 12489 001070'03 000000# 000000* 12490 001401'02 000000# 000000# %key3 , .srpau, rpause## ;[36] 12491 001071'03 160 141 165 163 145 12492 001073'03 000000# 000000* 12493 001402'02 000000# 000000# %key3 , .setqu, rquote## 12494 001074'03 161 165 157 164 145 12495 001076'03 000000# 000000* 12496 001403'02 000000# 000000# %key3 , .setim, srvtim## ;[137] 12497 001077'03 163 145 162 166 145 12498 001102'03 000000# 000000* 12499 001404'02 000000# 000000# %keyf4 , .setim, srvtim##, cm%inv ;[212] keep typing this.. 12500 001103'03 002000 000001 12501 001104'03 163 162 166 055 164 12502 001107'03 000000# 001102* 12503 001405'02 000000# 000000# %key3 , .setsp, rsthdr## ;[18] 12504 001110'03 163 164 141 162 164 12505 001114'03 000000# 000000* 12506 001406'02 000000# 000000# %key3 , .setim, rtimou## 12507 001115'03 164 151 155 145 157 12508 001117'03 000000# 000000* 12509 001374'02 000012 000012 %tbend 12510 12511 chgsec(code,const) ;;FDB's are not in code, they're in const 12512 001407'02 000000 000000 srcfdb: flddb. .cmkey,,srtabl,,, 12513 001410'02 000000 001374' 12514 retsec ;;Back to where-ever we started from 12515 12516 004442'01 201 01 0 00 000000# .setrc: movei t1, srcfdb ; SET RECEIVE ... 12517 004443'01 260 17 0 00 004417* call rfield ; Parse a keyword. 12518 004444'01 550 02 0 02 000000 hrrz t2, (t2) ; Get the command routine addresses. 12519 004445'01 202 02 0 00 004425* movem t2, pars3 ; Save into pars3. 12520 004446'01 554 01 0 02 000000 hlrz t1, (t2) ; Get the next level routine. 12521 004447'01 260 17 0 01 000000 call (t1) ; Call it. 12522 004450'01 263 17 0 00 000000 ret 12523 k20par - Kermit-20 Parsing and Semantic Action Routines MACRO %53B(1254)-4 19:41 30-Mar-24 Page 85 K20PAR MAC 29-Mar-24 20:39 SET SEND parameters 12524 subttl SET SEND parameters 12525 12526 001411'02 000000 000000 %table(sstabl) 12527 001412'02 000000# 000000# %key3 , .seteo, seolch## 12528 001120'03 145 156 144 055 157 12529 001123'03 000000# 000000* 12530 001413'02 000000# 000000# %key3 , .setpk, spsiz## 12531 001124'03 160 141 143 153 145 12532 001127'03 000000# 000000* 12533 001414'02 000000# 000000# %key3 , .setpc, spadch## 12534 001130'03 160 141 144 143 150 12535 001132'03 000000# 000000* 12536 001415'02 000000# 000000# %key3 , .setpd, spadn## 12537 001133'03 160 141 144 144 151 12538 001135'03 000000# 000000* 12539 001416'02 000000# 000000# %key3 , .sspau, spause## ;[35] 12540 001136'03 160 141 165 163 145 12541 001140'03 000000# 000000* 12542 001417'02 000000# 000000# %key3 , .setqu, squote## 12543 001141'03 161 165 157 164 145 12544 001143'03 000000# 000000* 12545 001420'02 000000# 000000# %key3 , .setsp, ssthdr## ;[18] 12546 001144'03 163 164 141 162 164 12547 001150'03 000000# 000000* 12548 001421'02 000000# 000000# %key3 , .setim, stimou## 12549 001151'03 164 151 155 145 157 12550 001153'03 000000# 000000* 12551 001411'02 000010 000010 %tbend 12552 12553 chgsec(code,const) ;;FDB's are not in code, they're in const 12554 001422'02 000000 000000 ssnfdb: flddb. .cmkey,,sstabl,,, 12555 001423'02 000000 001411' 12556 retsec ;;Back to where-ever we started from 12557 12558 004451'01 201 01 0 00 000000# .setsn: movei t1, ssnfdb ; SET SEND ... 12559 004452'01 260 17 0 00 004443* call rfield ; Parse a keyword. 12560 004453'01 550 02 0 02 000000 hrrz t2, (t2) ; Get the command routine addresses. 12561 004454'01 202 02 0 00 004445* movem t2, pars3 ; Save into pars3. 12562 004455'01 554 01 0 02 000000 hlrz t1, (t2) ; Get the next level routine. 12563 004456'01 260 17 0 01 000000 call (t1) ; Call it. 12564 004457'01 263 17 0 00 000000 ret 12565 k20par - Kermit-20 Parsing and Semantic Action Routines MACRO %53B(1254)-4 19:41 30-Mar-24 Page 86 K20PAR MAC 29-Mar-24 20:39 SET SEND/RECEIVE END-OF-LINE secondary parsing 12566 subttl SET SEND/RECEIVE END-OF-LINE secondary parsing 12567 12568 chgsec(code,const) ;;Chained FDB's are not in code, they're in const 12569 001424'02 013001 001426' eolfdm: flddb. .cmcma,cm%sdh,,,,eolfdb ;[217] Used when unwinding a macro 12570 001425'02 000000 000000 12571 001426'02 010004 001431' eolfdb: flddb. .cmcfm,,,,,eolfd1 12572 001427'02 000000 000000 12573 001430'02 44 07 0 00 003034' 12574 001431'02 001004 001434' eolfd1: flddb. .cmnum,,^d8,,,eolfd2 12575 001432'02 000000 000010 12576 001433'02 44 07 0 00 002533' 12577 001434'02 023004 000000 eolfd2: flddb. .cmtok,,token(<^>),,, 12578 001435'02 440700 002546' 12579 001436'02 44 07 0 00 002547' 12580 retsec ;;Back to where-ever we started from 12581 cleans() 12582 12583 004460'01 265 16 0 00 005305' .seteo: saveac ;[217] Needs registers 12584 004461'01 200 16 0 00 000000# guide 12585 004462'01 260 17 0 00 004415* 12586 001437'02 000000000000# 12587 001727'04 164 157 000 000 000 12588 004463'01 201 01 0 00 000000# movei t1, eolfdb ;[217] Point to enhanced parse list 12589 004464'01 332 00 0 00 000000# skipe mdone ;[217] Unwinding a macro? 12590 004465'01 201 01 0 00 000000# movei t1, eolfdm ;[217] Yes, allow a comma to squeak through 12591 12592 004466'01 260 17 0 00 004015* call rflde ;[217] Try to get one of them 12593 004467'01 254 00 0 00 004474' ifskp. ;[217] Worked!! 12594 004470'01 120 06 0 00 000002 dmove q2, t2 ;[217] Save some of the parse results 12595 004471'01 135 05 0 00 005473' ldb q1, [pointr (.cmfnp(q3),cm%fnc)] ;[217] Get function code. 12596 004472'01 200 10 0 00 000005 move q4, q1 ;[217] Save original parse 12597 004473'01 254 00 0 00 004477' else. ;[217] Otherwise, failed the parse 12598 004474'01 336 00 0 00 004422* skipn definf ;[217] In DEFINE? 12599 004475'01 254 00 0 00 004026* jrst cmderr ;[217] No, then a definite parse error; allow retry 12600 004476'01 263 17 0 00 000000 ret ;[217] Return into DEFINE and see if that chokes 12601 004477'01 endif. ;[217] End handling COMND% returns 12602 12603 004477'01 302 05 0 00 000013 caie q1, .cmcma ;[217] Parsed a comma? 12604 004500'01 254 00 0 00 004503' ifskp. ;[217] We did, so must be unwinding a macro 12605 004501'01 201 05 0 00 000010 movei q1, .cmcfm ;[217] Turn it into a confirm and carry on 12606 004502'01 200 10 0 00 000005 move q4, q1 ;[217] Stomp it in as a confirm 12607 004503'01 endif. 12608 12609 004503'01 302 05 0 00 000010 caie q1, .cmcfm ;[217] A confirm is very special cased 12610 004504'01 254 00 0 00 004511' ifskp. ;[217] It was, so default it 12611 004505'01 201 01 0 00 000015 movei t1, .chcrt ;[217] Replace parse value with carriage return 12612 004506'01 260 17 1 00 004077* call @parity ;[223] Put any necessary parity on it 12613 004507'01 202 01 0 00 004411* movem t1, pars4 ;[217] Save the EOL char we parsed. 12614 004510'01 263 17 0 00 000000 ret ;[217] Done, nothing left to parse 12615 004511'01 endif. ;[217] 12616 12617 004511'01 306 05 0 00 000001 cain q1, .cmnum ;[217] Number? 12618 004512'01 254 00 0 00 004544' jrst .sete1 ;[217] Yes, this must be checked 12619 12620 remark q1, .cmtok ;[217] Otherwise, must have been a token k20par - Kermit-20 Parsing and Semantic Action Routines MACRO %53B(1254)-4 19:41 30-Mar-24 Page 86-1 K20PAR MAC 29-Mar-24 20:39 SET SEND/RECEIVE END-OF-LINE secondary parsing 12621 dmove t1, [ esctkn ;[217] Possible mnemonics 12622 004513'01 120 01 0 00 005515' cm%xif ] ;[217] Load the no indirection flag 12623 004514'01 436 02 0 00 000000# orm t2, sbk+.cmflg ;[217] And dink the COMND% state block 12624 004515'01 260 17 0 00 004466* call rflde ;[217] Try to get one of them 12625 004516'01 254 00 0 00 004524' ifskp. ;[217] Worked!! 12626 004517'01 135 05 0 00 005304' ldb q1, [pointr (.cmfnp(t3),cm%fnc)] ;[217] Get function code. 12627 004520'01 120 06 0 00 000002 dmove q2, t2 ;[217] Save parse data and fdb selection 12628 remark q4, ;[217] Leave original parse item alone 12629 004521'01 205 04 0 00 002000 movx t4, cm%xif ;[217] Load indirection flag again 12630 004522'01 412 04 0 00 000000# andcam t4, sbk+.cmflg ;[217] And restore the COMND% state block 12631 004523'01 254 00 0 00 004527' else. ;[217] Otherwise, failed the parse 12632 004524'01 205 04 0 00 002000 movx t4, cm%xif ;[217] Load indirection flag again 12633 004525'01 412 04 0 00 000000# andcam t4, sbk+.cmflg ;[217] restore the COMND% state block 12634 004526'01 254 00 0 00 004475* jrst cmderr ;[217] And handle the parse error, allowing reparse 12635 004527'01 endif. ;[217] End handling COMND% returns 12636 12637 004527'01 302 05 0 00 000000 caie q1, .cmkey ;[217] Was this relatively easy? 12638 004530'01 254 00 0 00 004533' ifskp. ;[217] Yep, let's grab and convert the character 12639 004531'01 550 02 0 06 000000 hrrz t2, (q2) ;[217] Pick up what would be the jump address 12640 004532'01 254 00 0 00 004544' jrst .sete1 ;[217] Make sure a valid choice 12641 004533'01 endif. 12642 12643 remark q1, .cmtok ;[217] A token is somewhat more difficult 12644 004533'01 621 07 0 00 777777 tlz q3, -1 ;[217] Isolate fdb we actually used 12645 004534'01 200 06 0 07 000001 move q2, .cmdat(q3) ;[217] Pick up the byte pointer to the character 12646 004535'01 134 02 0 00 000006 ildb t2, q2 ;[217] Load the token character (only one) 12647 004536'01 275 02 0 00 000100 subi t2, "@" ;[217] Bring down to control character range 12648 004537'01 312 02 0 00 005476' came t2, [-21] ;[217] Typed a rubout? 12649 004540'01 254 00 0 00 004544' ifskp. ;[217] Not valid as EOL 12650 004541'01 200 01 0 00 000000# emsg ;[217] Whine 12651 004542'01 104 00 0 00 000313 12652 001440'02 000000000000# 12653 001730'04 115 141 171 040 156 12654 004543'01 254 00 0 00 004342* jrst cmder1 ;[217] Allow a retry 12655 004544'01 endif. ;[217] Otherwise, no need to check hardwired values 12656 remark .sete1 ;[217] Double check for other funnyness 12657 12658 004544'01 325 02 0 00 004550' .sete1: ifl. t2 ;[194] A negative ASCII character value is silly 12659 004545'01 200 01 0 00 000000# emsg ;[217] So whine about it 12660 004546'01 104 00 0 00 000313 12661 001441'02 000000000000# 12662 001742'04 116 145 147 141 164 12663 004547'01 254 00 0 00 004543* jrst cmder1 ;[217] Allow retry (^H) 12664 004550'01 endif. ;[217] 12665 12666 004550'01 305 02 0 00 000200 caige t2, 200 ;[217] Out of ASCII range? 12667 004551'01 254 00 0 00 004555' ifskp. ;[217] Yep, can't handle that, either 12668 004552'01 200 01 0 00 000000# emsg ;[217] Complain 12669 004553'01 104 00 0 00 000313 12670 001442'02 000000000000# 12671 001750'04 101 116 123 111 040 12672 004554'01 254 00 0 00 004547* jrst cmder1 ;[217] Allow retry (^H) 12673 004555'01 endif. ;[217] 12674 12675 004555'01 303 02 0 00 000037 caile t2, .chcun ;[194] Is the number in the right range? (^o37) k20par - Kermit-20 Parsing and Semantic Action Routines MACRO %53B(1254)-4 19:41 30-Mar-24 Page 86-2 K20PAR MAC 29-Mar-24 20:39 SET SEND/RECEIVE END-OF-LINE secondary parsing 12676 004556'01 254 00 0 00 004567' jrst seteor ;[194] No, give error message 12677 12678 004557'01 .sete2: remark ;[217] Here when we don't need to check (or just did) 12679 004557'01 200 01 0 00 000002 move t1, t2 ;[223] Load the character 12680 004560'01 260 17 1 00 004506* call @parity ;[223] Put any necessary parity on it 12681 004561'01 202 01 0 00 004507* movem t1, pars4 ;[223] Save the EOL char we parsed. 12682 remark ;[217] These two instructions are unnecessary, but... 12683 004562'01 306 10 0 00 000010 cain q4, .cmcfm ;[217] Wanted default? 12684 004563'01 263 17 0 00 000000 ret ;[217] Yes, don't confirm the confirmation 12685 004564'01 336 00 0 00 004474* skipn definf ;[77] In DEFINE? 12686 004565'01 260 17 0 00 004423* confrm ;[77] No, get confirmation. 12687 004566'01 263 17 0 00 000000 ret 12688 12689 004567'01 200 04 0 00 000002 seteor: move t4, t2 ;[217] Let's tuck that poor character out of the way 12690 004570'01 200 01 0 00 000000# emsg <"> ;" ;[217] Fire up the complaint department 12691 004571'01 104 00 0 00 000313 12692 001443'02 000000000000# 12693 001763'04 042 000 000 000 000 12694 004572'01 200 01 0 00 000004 move t1, t4 ;[217] Let's expose the bad character 12695 004573'01 260 17 0 00 000000* call putc ;[217] Print it 12696 004574'01 200 01 0 00 000000# txmsg <" is an invalid EOL character> ;[217] " Font crock 12697 004575'01 104 00 0 00 000076 12698 004576'01 320 12 0 00 004577' 12699 001444'02 000000000000# 12700 001764'04 042 040 151 163 040 12701 004577'01 254 00 0 00 004554* jrst cmder1 ;[194] Allow command retry 12702 k20par - Kermit-20 Parsing and Semantic Action Routines MACRO %53B(1254)-4 19:41 30-Mar-24 Page 87 K20PAR MAC 29-Mar-24 20:39 SET SEND/RECEIVE PACKET-LENGTH secondary parsing 12703 subttl SET SEND/RECEIVE PACKET-LENGTH secondary parsing 12704 12705 chgsec(code,const) ;;FDB's are not in code, they're in const 12706 001445'02 001005 000000 spkfdb: flddb. .cmnum,cm%sdh,^d10,,, ;[194] 12707 001446'02 000000 000012 12708 001447'02 44 07 0 00 003045' 12709 retsec ;;Back to where-ever we started from 12710 12711 004600'01 200 16 0 00 000000# .setpk: guide 12712 004601'01 260 17 0 00 004462* 12713 001450'02 000000000000# 12714 001772'04 164 157 000 000 000 12715 004602'01 201 01 0 00 000000# movei t1, spkfdb ;[194] 12716 004603'01 260 17 0 00 004452* call rfield ; Parse the packet size. 12717 004604'01 307 02 0 00 000012 caig t2, ^d10 ;[194] Is the number in the right range? 12718 004605'01 254 00 0 00 004614' jrst setpke ;[194] Too small 12719 004606'01 303 02 0 00 021450 caile t2, ^d9000 ;[179] (was ^d94) 12720 004607'01 254 00 0 00 004614' jrst setpke ;[194] Too big 12721 004610'01 202 02 0 00 004561* movem t2, pars4 ; Save the packet size. 12722 004611'01 336 00 0 00 004564* skipn definf ;[77] In DEFINE? 12723 004612'01 260 17 0 00 004565* confrm ;[77] No, get confirmation. 12724 004613'01 263 17 0 00 000000 ret 12725 12726 004614'01 200 01 0 00 000000# setpke: emsg ;[187] 12727 004615'01 104 00 0 00 000313 12728 001451'02 000000000000# 12729 001773'04 111 154 154 145 147 12730 remark ;Maybe type the bad size? 12731 004616'01 254 00 0 00 004577* jrst cmder1 12732 k20par - Kermit-20 Parsing and Semantic Action Routines MACRO %53B(1254)-4 19:41 30-Mar-24 Page 88 K20PAR MAC 29-Mar-24 20:39 SET SEND/RECEIVE PADCHAR secondary parsing 12733 subttl SET SEND/RECEIVE PADCHAR secondary parsing 12734 12735 chgsec(code,const) ;;Chained FDB's are not in code, they're in const 12736 001452'02 013001 001454' pdcfdm: flddb. .cmcma,cm%sdh,,,,pdcfdb ;[217] Used when unwinding a macro 12737 001453'02 000000 000000 12738 001454'02 010004 001457' pdcfdb: flddb. .cmcfm,,,,,pdcfd1 12739 001455'02 000000 000000 12740 001456'02 44 07 0 00 003054' 12741 001457'02 001004 001462' pdcfd1: flddb. .cmnum,,^d8,,,pdcfd2 12742 001460'02 000000 000010 12743 001461'02 44 07 0 00 003065' 12744 001462'02 023004 000000 pdcfd2: flddb. .cmtok,,token(<^>),,, 12745 001463'02 440700 002546' 12746 001464'02 44 07 0 00 002547' 12747 retsec 12748 cleans() 12749 12750 004617'01 265 16 0 00 005305' .setpc: saveac ;[217] Needs registers 12751 004620'01 200 16 0 00 000000# guide 12752 004621'01 260 17 0 00 004601* 12753 001465'02 000000000000# 12754 001777'04 164 157 000 000 000 12755 004622'01 201 01 0 00 000000# movei t1, pdcfdb ;[217] Point to enhanced parse list 12756 004623'01 332 00 0 00 000000# skipe mdone ;[217] Unwinding a macro? 12757 004624'01 201 01 0 00 000000# movei t1, pdcfdm ;[217] Yes, allow a comma to squeak through 12758 12759 004625'01 260 17 0 00 004515* call rflde ;[217] Try to get something 12760 004626'01 254 00 0 00 004633' ifskp. ;[217] Worked!! 12761 004627'01 120 06 0 00 000002 dmove q2, t2 ;[217] Partially save the parse results 12762 004630'01 135 05 0 00 005473' ldb q1, [pointr (.cmfnp(q3),cm%fnc)] ;[217] Get function code. 12763 004631'01 200 10 0 00 000005 move q4, q1 ;[217] Save a copy for downstream 12764 004632'01 254 00 0 00 004636' else. ;[217] Otherwise, failed the parse 12765 004633'01 336 00 0 00 004611* skipn definf ;[217] In DEFINE? 12766 004634'01 254 00 0 00 004526* jrst cmderr ;[217] No, then a definite parse error; allow retry 12767 004635'01 263 17 0 00 000000 ret ;[217] Return into DEFINE and see if that chokes 12768 004636'01 endif. ;[217] End handling COMND% returns 12769 12770 004636'01 302 05 0 00 000013 caie q1, .cmcma ;[217] Parsed a comma? 12771 004637'01 254 00 0 00 004642' ifskp. ;[217] We did, so must be unwinding a macro 12772 004640'01 201 05 0 00 000010 movei q1, .cmcfm ;[217] Turn it into a confirm and carry on 12773 004641'01 200 10 0 00 000005 move q4, q1 ;[217] Stomp for downstream 12774 004642'01 endif. 12775 12776 004642'01 302 05 0 00 000010 caie q1, .cmcfm ;[217] A confirm is very special cased 12777 004643'01 254 00 0 00 004650' ifskp. ;[217] It was, so default it 12778 004644'01 201 01 0 00 000000 movei t1, .chnul ;[217] Replace parse value with NUL (ASCII 0) 12779 004645'01 260 17 1 00 004560* call @parity ;[223] Apply any necessary parity 12780 004646'01 202 01 0 00 004610* movem t1, pars4 ;[217] Save the EOL char we parsed. 12781 004647'01 263 17 0 00 000000 ret ;[217] Done, nothing left to parse 12782 004650'01 endif. ;[217] 12783 12784 004650'01 306 05 0 00 000001 cain q1, .cmnum ;[217] Number? 12785 004651'01 254 00 0 00 004700' jrst .setp1 ;[217] Yes, this must be checked 12786 12787 remark q1, .cmtok ;[217] Otherwise, must have been a token k20par - Kermit-20 Parsing and Semantic Action Routines MACRO %53B(1254)-4 19:41 30-Mar-24 Page 88-1 K20PAR MAC 29-Mar-24 20:39 SET SEND/RECEIVE PADCHAR secondary parsing 12788 dmove t1, [ esctkn ;[217] Possible mnemonics 12789 004652'01 120 01 0 00 005517' cm%xif ] ;[217] Load the no indirection flag 12790 004653'01 436 02 0 00 000000# orm t2, sbk+.cmflg ;[217] And dink the COMND% state block 12791 004654'01 260 17 0 00 004625* call rflde ;[217] Try to get one of them 12792 004655'01 254 00 0 00 004663' ifskp. ;[217] Worked!! 12793 004656'01 135 05 0 00 005304' ldb q1, [pointr (.cmfnp(t3),cm%fnc)] ;[217] Get function code. 12794 004657'01 120 06 0 00 000002 dmove q2, t2 ;[217] Save parse data and fdb selection 12795 remark q4, ;[217] Don't touch!! 12796 004660'01 205 04 0 00 002000 movx t4, cm%xif ;[217] Load indirection flag again 12797 004661'01 412 04 0 00 000000# andcam t4, sbk+.cmflg ;[217] And restore the COMND% state block 12798 004662'01 254 00 0 00 004666' else. ;[217] Otherwise, failed the parse 12799 004663'01 205 04 0 00 002000 movx t4, cm%xif ;[217] Load indirection flag again 12800 004664'01 412 04 0 00 000000# andcam t4, sbk+.cmflg ;[217] restore the COMND% state block 12801 004665'01 254 00 0 00 004634* jrst cmderr ;[217] And handle the parse error, allowing reparse 12802 004666'01 endif. ;[217] End handling COMND% returns 12803 12804 004666'01 302 05 0 00 000000 caie q1, .cmkey ;[217] Was this relatively easy? 12805 004667'01 254 00 0 00 004672' ifskp. ;[217] Yep, let's grab and convert the character 12806 004670'01 550 02 0 06 000000 hrrz t2, (q2) ;[217] Pick up what would be the jump address 12807 004671'01 254 00 0 00 004700' jrst .setp1 ;[217] No need to check, these are all fine 12808 004672'01 endif. 12809 12810 remark q1, .cmtok ;[217] A token is somewhat more difficult 12811 004672'01 621 07 0 00 777777 tlz q3, -1 ;[217] Isolate fdb we actually used 12812 004673'01 200 06 0 07 000001 move q2, .cmdat(q3) ;[217] Pick up the byte pointer to the character 12813 004674'01 134 02 0 00 000006 ildb t2, q2 ;[217] Load the token character (only one) 12814 004675'01 275 02 0 00 000100 subi t2, "@" ;[217] Bring down to control character range 12815 004676'01 316 02 0 00 005476' camn t2, [-21] ;[217] Was this our rubout hack? 12816 004677'01 201 02 0 00 000177 movei t2, 177 ;[217] Stomp in the correct value 12817 remark .setp1 ;[217] Falls through to check 12818 12819 004700'01 325 02 0 00 004704' .setp1: ifl. t2 ;[194] A negative ASCII character value is silly 12820 004701'01 200 01 0 00 000000# emsg ;[217] So whine about it 12821 004702'01 104 00 0 00 000313 12822 001466'02 000000000000# 12823 002000'04 116 145 147 141 164 12824 004703'01 254 00 0 00 004616* jrst cmder1 ;[217] Allow retry (^H) 12825 004704'01 endif. ;[217] 12826 12827 004704'01 305 02 0 00 000200 caige t2, 200 ;[217] Out of ASCII range? 12828 004705'01 254 00 0 00 004711' ifskp. ;[217] Yep, can't handle that, either 12829 004706'01 200 01 0 00 000000# emsg ;[217] Complain 12830 004707'01 104 00 0 00 000313 12831 001467'02 000000000000# 12832 002006'04 101 116 123 111 040 12833 004710'01 254 00 0 00 004703* jrst cmder1 ;[217] Allow retry (^H) 12834 004711'01 endif. ;[217] 12835 12836 004711'01 307 02 0 00 000037 caig t2, .chcun ; ...37 octal? 12837 004712'01 254 00 0 00 004716' ifskp. ;[194] Out of control character range 12838 004713'01 306 02 0 00 000177 cain t2, .chdel ;[149] But!! Is it a DEL? 12839 004714'01 254 00 0 00 004716' anskp. ;[194] It is, so that's fine 12840 004715'01 254 00 0 00 004726' jrst setpce ;[194] Otherwise, give error message 12841 004716'01 endif. ;[194] 12842 k20par - Kermit-20 Parsing and Semantic Action Routines MACRO %53B(1254)-4 19:41 30-Mar-24 Page 88-2 K20PAR MAC 29-Mar-24 20:39 SET SEND/RECEIVE PADCHAR secondary parsing 12843 004716'01 200 01 0 00 000002 .setp2: move t1, t2 ;[223] Load the character 12844 004717'01 260 17 1 00 004645* call @parity ;[223] Compute any parity 12845 004720'01 202 01 0 00 004646* movem t1, pars4 ;[223] Save the padding char 12846 004721'01 306 10 0 00 000010 cain q4, .cmcfm ;[217] Did we already take all defaults? 12847 004722'01 263 17 0 00 000000 ret ;[217] Yes, don't confirm the confirmation 12848 004723'01 336 00 0 00 004633* skipn definf ;[77] In DEFINE? 12849 004724'01 260 17 0 00 004612* confrm ;[77] No, get confirmation. 12850 004725'01 263 17 0 00 000000 ret ; Yes, OK. 12851 12852 004726'01 200 04 0 00 000002 setpce: move t4, t2 ;[217] Save the poor character 12853 004727'01 200 01 0 00 000000# emsg <"> ;" ;[217] Begin whining 12854 004730'01 104 00 0 00 000313 12855 001470'02 000000000000# 12856 002021'04 042 000 000 000 000 12857 004731'01 200 01 0 00 000004 move t1, t4 ;[217] Load the failing character 12858 004732'01 260 17 0 00 004573* call putc ;[217] Expose it to the world 12859 004733'01 200 01 0 00 000000# txmsg <" is not a valid padding character> ;[217] "Font crock 12860 004734'01 104 00 0 00 000076 12861 004735'01 320 12 0 00 004736' 12862 001471'02 000000000000# 12863 002022'04 042 040 151 163 040 12864 004736'01 254 00 0 00 004710* jrst cmder1 ;[194] and allow command retry. 12865 k20par - Kermit-20 Parsing and Semantic Action Routines MACRO %53B(1254)-4 19:41 30-Mar-24 Page 89 K20PAR MAC 29-Mar-24 20:39 SET SEND/RECEIVE PADDING secondary parsing 12866 subttl SET SEND/RECEIVE PADDING secondary parsing 12867 12868 chgsec(code,const) ;;FDB's are not in code, they're in const 12869 001472'02 001006 000000 spdfdb: flddb. .cmnum,,^d10,,<0>, 12870 001473'02 000000 000012 12871 001474'02 44 07 0 00 003076' 12872 001475'02 44 07 0 00 003106' 12873 retsec ;;Back to where-ever we started from 12874 12875 004737'01 200 16 0 00 000000# .setpd: guide 12876 004740'01 260 17 0 00 004621* 12877 001476'02 000000000000# 12878 002031'04 164 157 000 000 000 12879 004741'01 201 01 0 00 000000# movei t1, spdfdb 12880 004742'01 260 17 0 00 004603* call rfield ; Parse the number of padding chars. 12881 004743'01 325 02 0 00 004747' ifl. t2 ;[194] Negative padding is silly 12882 004744'01 200 01 0 00 000000# emsg ;[194] 12883 004745'01 104 00 0 00 000313 12884 001477'02 000000000000# 12885 002032'04 101 040 156 145 147 12886 004746'01 254 00 0 00 004736* jrst cmder1 ;[194] 12887 004747'01 endif. ;[194] 12888 004747'01 307 02 0 00 002000 caig t2, dpadmx ;[194] Rediculously large? 12889 004750'01 254 00 0 00 004754' ifskp. ;[194] Yep, we could go days before sending 12890 004751'01 200 01 0 00 000000# emsg 12891 004752'01 104 00 0 00 000313 12892 001500'02 000000000000# 12893 002042'04 115 141 170 151 155 12894 004753'01 254 00 0 00 004746* jrst cmder1 ;[194] Allow reparse 12895 004754'01 endif. ;[194] 12896 004754'01 202 02 0 00 004720* movem t2, pars4 ; Save the number. 12897 004755'01 336 00 0 00 004723* skipn definf ;[77] In DEFINE? 12898 004756'01 260 17 0 00 004724* confrm ;[77] No, get confirmation. 12899 004757'01 263 17 0 00 000000 ret 12900 k20par - Kermit-20 Parsing and Semantic Action Routines MACRO %53B(1254)-4 19:41 30-Mar-24 Page 90 K20PAR MAC 29-Mar-24 20:39 SET SEND/RECEIVE pause secondary parsing 12901 subttl SET SEND/RECEIVE pause secondary parsing 12902 12903 ;[196] Do the calculation from floating (fractional) seconds to 12904 ; integer milliseconds ONCE, here. Doing it every single packet is a 12905 ; pretty gauche use of the processor as it does have other things to 12906 ; do... 12907 12908 chgsec(code,const) ;;FDB's are not in code, they're in const 12909 001501'02 015006 000000 fsrpau: flddb. .cmflt,,,,<0> 12910 001502'02 000000 000000 12911 001503'02 44 07 0 00 003107' 12912 001504'02 44 07 0 00 003106' 12913 001505'02 015006 000000 fsspau: flddb. .cmflt,,,,<0> 12914 001506'02 000000 000000 12915 001507'02 44 07 0 00 003120' 12916 001510'02 44 07 0 00 003106' 12917 retsec ;;Back to where-ever we started from 12918 12919 004760'01 334 01 0 00 005521' .srpau: skipa t1, [fsrpau] ;[196] Address of receive pause fdb 12920 004761'01 201 01 0 00 000000# .sspau: movei t1, fsspau ;[196] Address of send pause fdb 12921 004762'01 200 16 0 00 000000# guide ;[194] 12922 004763'01 260 17 0 00 004740* 12923 001511'02 000000000000# 12924 002051'04 142 145 164 167 145 12925 004764'01 260 17 0 00 004742* call rfield ;[36] pause parsing common code. 12926 004765'01 200 16 0 00 000000# guide 12927 004766'01 260 17 0 00 004763* 12928 001512'02 000000000000# 12929 002055'04 163 145 143 157 156 12930 12931 004767'01 325 02 0 00 004773' ifl. t2 ;[194] Is the number in the right range? 12932 004770'01 200 01 0 00 000000# emsg ;[187] 12933 004771'01 104 00 0 00 000313 12934 001513'02 000000000000# 12935 002057'04 116 145 147 141 164 12936 004772'01 254 00 0 00 004753* jrst cmder1 ;[194] Allow reparse 12937 004773'01 endif. ;[194] 12938 12939 remark ;[212] When chksec works, it works completely 12940 004773'01 260 17 0 00 000000' call chksec ;[196] Ensure number is in correct range 12941 004774'01 254 00 0 00 004776' ifskp. ;[196] Check and convert OK? 12942 remark ;[196] Yes, must confirm later, maybe 12943 004775'01 254 00 0 00 005001' else. ;[196] Otherwise, couldn't swallow something 12944 004776'01 200 01 0 00 000000# emsg ;[187] 12945 004777'01 104 00 0 00 000313 12946 001514'02 000000000000# 12947 002066'04 111 156 164 145 162 12948 005000'01 254 00 0 00 004772* jrst cmder1 ;[194] Allow reparse 12949 005001'01 endif. ;[212] End range check 12950 12951 005001'01 337 01 0 00 004754* skipg t1, pars4 ;[212] Load non-zero milliseconds 12952 005002'01 254 00 0 00 005010' ifskp. ;[212] Let's range check that 12953 005003'01 307 01 0 00 267460 caig t1, maxtim ;[212] Over 94 seconds? 12954 005004'01 254 00 0 00 005010' anskp. ;[212] Nope, safe to use 12955 005005'01 200 01 0 00 000000# emsg ;[212] k20par - Kermit-20 Parsing and Semantic Action Routines MACRO %53B(1254)-4 19:41 30-Mar-24 Page 90-1 K20PAR MAC 29-Mar-24 20:39 SET SEND/RECEIVE pause secondary parsing 12956 005006'01 104 00 0 00 000313 12957 001515'02 000000000000# 12958 002077'04 120 141 165 163 145 12959 005007'01 254 00 0 00 005000* jrst cmder1 ;[212] Out 12960 005010'01 endif. 12961 12962 005010'01 336 00 0 00 004755* skipn definf ;[77] In DEFINE? 12963 005011'01 260 17 0 00 004756* confrm ;[77] No, get confirmation. 12964 005012'01 263 17 0 00 000000 ret 12965 k20par - Kermit-20 Parsing and Semantic Action Routines MACRO %53B(1254)-4 19:41 30-Mar-24 Page 91 K20PAR MAC 29-Mar-24 20:39 SET SEND/RECEIVE QUOTE character tables and token definitions 12966 subttl SET SEND/RECEIVE QUOTE character tables and token definitions 12967 12968 define qchrs (c) < ;;[217] Define macro to populate the table 12969 xlist ;;[217] Don't need to see this in the listing 12970 irpc c,< ;;[217] Go through all the characters 12971 %key2 <'c>,<"'c"> ;;[217] Emit character and its ASCII code 12972 >;;irpc ;;[217] End of argument expansion 12973 list ;;[217] Turn the listing back on 12974 >;;qchrs ;;[217] End of macro definition 12975 12976 001516'02 000000 000000 %table(qchtb) ;;[217] Printable character table 12977 qchrs (0123456789) ;;[217] 'Easy' printable numerals 12978 qchrs (ABCDEFGHIJKLMNOPQRSTUVWXYZ) ;;[217] 'Easy' printable characters 12979 001516'02 000044 000044 %tbend ;[217] End of 'easy' table 12980 12981 ;N.B., a number of characters simply do NOT work as tokens 12982 12983 001563'02 000000 000000 %table() ;;[217] Token mnemonics 12984 001564'02 000000# 777700 %key2 ,<-"@"> ;[217] Kind of chokes on this sometimes 12985 001220'03 141 164 055 163 151 12986 001565'02 000000# 777724 %key2 ,<-","> ;[217] Clashes with define 12987 001222'03 143 157 155 155 141 12988 001566'02 000000# 777723 %key2 ,<-"-"> ;[217] Parsed as line continuation, always 12989 001224'03 144 141 163 150 000 12990 001567'02 000000# 777737 %key2 ,<-"!"> ;[217] Parsed as comment, always... 12991 001225'03 145 170 143 154 141 12992 001570'02 000000# 777723 %keyf3 ,<-"-">,cm%inv ;[217] Parsed as line continuation, always 12993 001231'03 002000 000001 12994 001232'03 155 151 156 165 163 12995 001571'02 000000# 777701 %key2 ,<-"?"> ;[217] Parsed as choices display, always... 12996 001235'03 161 165 145 163 164 12997 001572'02 000000# 777705 %key2 ,<-";"> ;[217] Parsed as comment, always... 12998 001240'03 163 145 155 151 143 12999 001563'02 000007 000007 %tbend ;[217] End of mnemonic table 13000 13001 chgsec(code,const) ;;Chained FDB's are not in code, they're in const 13002 001573'02 013001 001575' qoufdm: flddb. .cmcma,cm%sdh,,,,qoufdb ;[217] Used when unwinding a macro 13003 001574'02 000000 000000 13004 001575'02 qoufdb: remark ;[217] First parse the 'easy' stuff... 13005 001575'02 010004 001600' flddb. .cmcfm,,,,,qf1 13006 001576'02 000000 000000 13007 001577'02 44 07 0 00 003131' 13008 001600'02 001004 001603' qf1: flddb. .cmnum,,^d8,,,qf2 13009 001601'02 000000 000010 13010 001602'02 44 07 0 00 003143' 13011 001603'02 000004 001606' qf2: flddb. .cmkey,,qchtb,,,qf3 13012 001604'02 000000 001516' 13013 001605'02 44 07 0 00 003156' 13014 001606'02 000004 001611' qf3: flddb. .cmkey,,toktab,,,q01 13015 001607'02 000000 001563' 13016 001610'02 44 07 0 00 003163' 13017 cleans() 13018 13019 ; N.B., have to use literals here for tokens or flddb. will choke. 13020 ; Maybe rewrite this to special case .cmtok, like fldtk.? k20par - Kermit-20 Parsing and Semantic Action Routines MACRO %53B(1254)-4 19:41 30-Mar-24 Page 91-1 K20PAR MAC 29-Mar-24 20:39 SET SEND/RECEIVE QUOTE character tables and token definitions 13021 ; 13022 ; Also can't do a point 7,xx,6 for a token because COMND% won't work with that... 13023 13024 001611'02 023004 001614' q01: flddb. .cmtok,,,,,q02 13025 001612'02 44 07 0 00 003175' 13026 001613'02 44 07 0 00 003176' 13027 001614'02 023004 001617' q02: flddb. .cmtok,,token(<#>),,,q03 13028 001615'02 440700 003205' 13029 001616'02 44 07 0 00 003206' 13030 001617'02 023004 001622' q03: flddb. .cmtok,,token(<$>),,,q04 13031 001620'02 440700 003214' 13032 001621'02 44 07 0 00 003215' 13033 001622'02 023004 001625' q04: flddb. .cmtok,,token(<%>),,,q05 13034 001623'02 440700 003224' 13035 001624'02 44 07 0 00 003225' 13036 001625'02 023004 001630' q05: flddb. .cmtok,,token(<&>),,,q06 13037 001626'02 440700 003234' 13038 001627'02 44 07 0 00 003235' 13039 001630'02 023004 001633' q06: flddb. .cmtok,,,,,q07 13040 001631'02 44 07 0 00 003243' 13041 001632'02 44 07 0 00 003244' 13042 001633'02 023004 001636' q07: flddb. .cmtok,,,,,q08 13043 001634'02 44 07 0 00 003253' 13044 001635'02 44 07 0 00 003254' 13045 001636'02 023004 001641' q08: flddb. .cmtok,,,,,q09 13046 001637'02 44 07 0 00 003263' 13047 001640'02 44 07 0 00 003264' 13048 001641'02 023004 001644' q09: flddb. .cmtok,,token(<*>),,,q10 13049 001642'02 440700 003274' 13050 001643'02 44 07 0 00 003275' 13051 001644'02 023004 001647' q10: flddb. .cmtok,,token(<+>),,,q13 13052 001645'02 440700 003303' 13053 001646'02 44 07 0 00 003304' 13054 001647'02 023004 001652' q13: flddb. .cmtok,,token(<.>),,,q14 13055 001650'02 440700 002167' 13056 001651'02 44 07 0 00 003312' 13057 001652'02 023004 001655' q14: flddb. .cmtok,,token(),,,q15 13058 001653'02 440700 002674' 13059 001654'02 44 07 0 00 003320' 13060 001655'02 023004 001660' q15: flddb. .cmtok,,token(<:>),,,q17 13061 001656'02 440700 003327' 13062 001657'02 44 07 0 00 003330' 13063 001660'02 023004 001663' q17: fld(.cmtok,cm%fnc)!cm%hpp!q18 13064 001661'02 44 07 0 00 003335' point 7, [asciz /),,,q19 13067 001664'02 440700 003346' 13068 001665'02 44 07 0 00 003347' 13069 001666'02 023004 001671' q19: fld(.cmtok,cm%fnc)!cm%hpp!q21 13070 001667'02 44 07 0 00 003356' point 7, [asciz />/] 13071 001670'02 44 07 0 00 003357' point 7, [asciz /to specify a right angle bracket, type/] 13072 001671'02 023004 001674' q21: flddb. .cmtok,,token(<[>),,,q22 13073 001672'02 440700 002610' 13074 001673'02 44 07 0 00 003367' 13075 001674'02 023004 001677' q22: flddb. .cmtok,,token(<\>),,,q23 k20par - Kermit-20 Parsing and Semantic Action Routines MACRO %53B(1254)-4 19:41 30-Mar-24 Page 91-2 K20PAR MAC 29-Mar-24 20:39 SET SEND/RECEIVE QUOTE character tables and token definitions 13076 001675'02 440700 002621' 13077 001676'02 44 07 0 00 003376' 13078 001677'02 023004 001702' q23: flddb. .cmtok,,token(<]>),,,q24 13079 001700'02 440700 002634' 13080 001701'02 44 07 0 00 003404' 13081 001702'02 023004 001705' q24: flddb. .cmtok,,token(<^>),,,q25 13082 001703'02 440700 002546' 13083 001704'02 44 07 0 00 003413' 13084 001705'02 023004 001710' q25: flddb. .cmtok,,token(<_>),,,q26 13085 001706'02 440700 002661' 13086 001707'02 44 07 0 00 003420' 13087 001710'02 023004 001713' q26: flddb. .cmtok,,token(<`>),,,q27 13088 001711'02 440700 003427' 13089 001712'02 44 07 0 00 003430' 13090 001713'02 023004 001716' q27: flddb. .cmtok,,token(<{>),,,q28 13091 001714'02 440700 003436' 13092 001715'02 44 07 0 00 003437' 13093 001716'02 023004 001721' q28: flddb. .cmtok,,token(<|>),,,q29 13094 001717'02 440700 003447' 13095 001720'02 44 07 0 00 003450' 13096 001721'02 023004 001724' q29: flddb. .cmtok,,token(<}>),,,q30 13097 001722'02 440700 003457' 13098 001723'02 44 07 0 00 003460' 13099 001724'02 023004 000000 q30: flddb. .cmtok,,token(<~>),,, 13100 001725'02 440700 003470' 13101 001726'02 44 07 0 00 003471' 13102 13103 define qcln (p,b,n) < ;;[217] Clean up massive token usage 13104 xlist ;;[217] We don't need to see the blat 13105 irpc n,< ;;[217] Go through all the numeric suffix's 13106 'p q'b'n ;;[217] pseudo-op and its symbol 13107 >;;irpc ;;[217] End of argument expansion 13108 list ;;[217] Reenable the blat 13109 >;;qcln ;;[217] End of macro definition 13110 13111 define qkey (k) < 13112 xlist ;;[217] Save the trees!!! 13113 irp k,< 13114 qcln(<'k>,0,<123456789>) 13115 qcln(<'k>,1,<0345789>) 13116 qcln(<'k>,2,<123456789>) 13117 qcln(<'k>,3,<0>) 13118 >;;irp 13119 list ;;[217] Turn listing back on 13120 >;;qkey 13121 13122 ;[217] Keep useless symbols away from DDT and off the 13123 ;[217] cross-reference and symbol table listings 13124 13125 qkey(<.noddt,.xcref,suppress>) 13126 13127 ;[217] If second pass, don't need them at all nor the worker macros 13128 13129 if2 < qkey() ;;[217] Ditch all those useless labels 13130 purge qchrs ;;[217] Ditch the macro for quote characters k20par - Kermit-20 Parsing and Semantic Action Routines MACRO %53B(1254)-4 19:41 30-Mar-24 Page 91-3 K20PAR MAC 29-Mar-24 20:39 SET SEND/RECEIVE QUOTE character tables and token definitions 13131 purge qkey ;;[217] Get rid of the driver to punt symbols 13132 purge qcln ;;[217] Ditch the remote macro with the symbol list 13133 >;if2 13134 13135 001727'02 35 07 0 00 000000* qchrpt: point 7, atmbuf, 6 ;[217] Character in atom buffer 13136 retsec ;[217] Finally back in code 13137 k20par - Kermit-20 Parsing and Semantic Action Routines MACRO %53B(1254)-4 19:41 30-Mar-24 Page 92 K20PAR MAC 29-Mar-24 20:39 SET SEND/RECEIVE QUOTE secondary parsing 13138 subttl SET SEND/RECEIVE QUOTE secondary parsing 13139 13140 005013'01 265 16 0 00 005305' .setqu: saveac ;[217] Wants some registers 13141 005014'01 200 16 0 00 000000# guide 13142 005015'01 260 17 0 00 004766* 13143 001730'02 000000000000# 13144 002106'04 164 157 000 000 000 13145 dmove t1, [ qoufdb ;[217] Point to our parsing extravaganza 13146 005016'01 120 01 0 00 005522' cm%xif ] ;[217] Load the no indirection flag 13147 005017'01 436 02 0 00 000000# orm t2, sbk+.cmflg ;[217] And dink the COMND% state block 13148 005020'01 332 00 0 00 000000# skipe mdone ;[217] Unwinding a macro? 13149 005021'01 201 01 0 00 000000# movei t1, qoufdm ;[217] If unwinding a macro, allow a comma 13150 13151 005022'01 260 17 0 00 004654* call rflde ;[217] Try to get one of them 13152 005023'01 254 00 0 00 005032' ifskp. ;[217] Worked!! 13153 005024'01 120 06 0 00 000002 dmove q2, t2 ;[217] Save some of the parse results 13154 005025'01 135 05 0 00 005473' ldb q1, [pointr (.cmfnp(q3),cm%fnc)] ;[217] Pick up the function code 13155 005026'01 200 10 0 00 000005 move q4, q1 ;[217] Save a copy for downstream 13156 005027'01 205 04 0 00 002000 movx t4, cm%xif ;[217] Load indirection flag again 13157 005030'01 412 04 0 00 000000# andcam t4, sbk+.cmflg ;[217] And restore the COMND% state block 13158 005031'01 254 00 0 00 005035' else. ;[217] Otherwise, failed the parse 13159 005032'01 205 04 0 00 002000 movx t4, cm%xif ;[217] Load indirection flag again 13160 005033'01 412 04 0 00 000000# andcam t4, sbk+.cmflg ;[217] restore the COMND% state block 13161 005034'01 254 00 0 00 004665* jrst cmderr ;[217] And handle the parse error, allowing reparse 13162 005035'01 endif. ;[217] End handling COMND% returns 13163 13164 005035'01 302 05 0 00 000013 caie q1, .cmcma ;[217] A comma? (must be unwinding) 13165 005036'01 254 00 0 00 005041' ifskp. ;[217] Yes, so handle it like a default 13166 005037'01 201 05 0 00 000010 movei q1, .cmcfm ;[217] Just turn it into a confirm 13167 005040'01 200 10 0 00 000005 move q4, q1 ;[217] Update downstream's copy 13168 005041'01 endif. ;[217] and let the confirm code handle it 13169 13170 005041'01 302 05 0 00 000010 caie q1, .cmcfm ;[217] Wants the default? 13171 005042'01 254 00 0 00 005046' ifskp. ;[217] Yes, that's easy 13172 005043'01 201 02 0 00 000043 movei t2, "#" ;[217] Default quote character 13173 005044'01 202 02 0 00 005001* movem t2, pars4 ;[217] Pass to semantic action 13174 005045'01 263 17 0 00 000000 ret ;[217] Done, no need to parse further 13175 005046'01 endif. ;[217] End case .cmcfm 13176 13177 005046'01 302 05 0 00 000000 caie q1, .cmkey ;[217] A keyword? 13178 005047'01 254 00 0 00 005056' ifskp. ;[217] It is, let's investigate 13179 005050'01 570 04 0 06 000000 hrre t4,(q2) ;[217] Pick up the dispatch address 13180 005051'01 325 04 0 00 005054' ifl. t4 ;[217] Negative? 13181 005052'01 210 02 0 00 000004 movn t2, t4 ;[217] It's one of our mnemonics 13182 005053'01 254 00 0 00 005055' else. ;[217] Otherwise, go grab the 13183 005054'01 135 02 0 00 000000# ldb t2, qchrpt ;[217] character from the atom buffer 13184 005055'01 endif. ;[217] Either way, have something 13185 005055'01 254 00 0 00 005072' jrst .setq1 ;[217] so go check it 13186 005056'01 endif. ;[217] End case .cmkey 13187 13188 005056'01 302 05 0 00 000023 caie q1, .cmtok ;[217] Something from the long list of tokens? 13189 005057'01 254 00 0 00 005064' ifskp. ;[217] Yes, hairy, but doable 13190 005060'01 621 07 0 00 777777 tlz q3, -1 ;[217] Isolate fdb we actually used 13191 005061'01 200 04 0 07 000001 move t4, .cmdat(q3) ;[217] Pick up the byte pointer to the character 13192 005062'01 134 02 0 00 000004 ildb t2, t4 ;[217] Load the token character (only one) k20par - Kermit-20 Parsing and Semantic Action Routines MACRO %53B(1254)-4 19:41 30-Mar-24 Page 92-1 K20PAR MAC 29-Mar-24 20:39 SET SEND/RECEIVE QUOTE secondary parsing 13193 005063'01 254 00 0 00 005072' jrst .setq1 ;[217] Go check it 13194 005064'01 endif. ;[217] End case .cmtok 13195 13196 005064'01 302 05 0 00 000001 caie q1, .cmnum ;[217] Specified it as an octal number? 13197 005065'01 254 00 0 00 005067' ifskp. ;[217] He did 13198 005066'01 254 00 0 00 005072' jrst .setq1 ;[217] So let's check it 13199 005067'01 endif. ;[217] End case .cmnum 13200 13201 005067'01 200 01 0 00 000000# emsg ;[217] OK, we're confused... 13202 005070'01 104 00 0 00 000313 13203 001731'02 000000000000# 13204 002107'04 123 105 124 040 121 13205 005071'01 254 00 0 00 005007* jrst cmder1 ;[217] Allow a reparse 13206 13207 005072'01 307 02 0 00 000040 .setq1: caig t2, .chspc ;[21] Printable? 13208 005073'01 254 00 0 00 005104' jrst setque ;[194] No (N.B., does not allow space) 13209 005074'01 303 02 0 00 000176 caile t2, "~" ;[21] Past squiggle? 13210 005075'01 254 00 0 00 005104' jrst setque ;[194] Yes, then can't use it 13211 005076'01 202 02 0 00 005044* movem t2, pars4 ;[21] OK, stash it. 13212 005077'01 306 10 0 00 000010 cain q4, .cmcfm ;[217] Defaulted everything? 13213 005100'01 263 17 0 00 000000 ret ;[217] Yes, don't reconfirm the confirm 13214 005101'01 336 00 0 00 005010* skipn definf ;[77] In DEFINE? 13215 005102'01 260 17 0 00 005011* confrm ;[77] No, get confirmation. 13216 005103'01 263 17 0 00 000000 ret 13217 13218 005104'01 200 04 0 00 000002 setque: move t4, t2 ;[217] Get the poor character out of the way 13219 005105'01 325 04 0 00 005111' ifl. t4 ;[194] A negative ASCII character value is silly 13220 005106'01 200 01 0 00 000000# emsg ;[217] So whine about it 13221 005107'01 104 00 0 00 000313 13222 001732'02 000000000000# 13223 002116'04 116 145 147 141 164 13224 005110'01 254 00 0 00 005071* jrst cmder1 ;[217] Allow retry (^H) 13225 005111'01 endif. ;[217] 13226 13227 005111'01 305 04 0 00 000200 caige t4, 200 ;[217] Out of ASCII range? 13228 005112'01 254 00 0 00 005116' ifskp. ;[217] Yep, can't handle that, either 13229 005113'01 200 01 0 00 000000# emsg ;[217] Complain 13230 005114'01 104 00 0 00 000313 13231 001733'02 000000000000# 13232 002124'04 101 116 123 111 040 13233 005115'01 254 00 0 00 005110* jrst cmder1 ;[217] Allow retry (^H) 13234 005116'01 endif. ;[217] 13235 13236 remark ;[217] Otherwise, handle general case 13237 005116'01 200 01 0 00 000000# emsg ;" 13238 005117'01 104 00 0 00 000313 13239 001734'02 000000000000# 13240 002137'04 101 040 161 165 157 13241 005120'01 200 01 0 00 000004 move t1, t4 ;[217] Load the poor character 13242 005121'01 260 17 0 00 004732* call putc ;[217] Print it 13243 005122'01 200 01 0 00 000000# txmsg <" is not.> ;[217] " Font crock mode 13244 005123'01 104 00 0 00 000076 13245 005124'01 320 12 0 00 005125' 13246 001735'02 000000000000# 13247 002155'04 042 040 151 163 040 k20par - Kermit-20 Parsing and Semantic Action Routines MACRO %53B(1254)-4 19:41 30-Mar-24 Page 92-2 K20PAR MAC 29-Mar-24 20:39 SET SEND/RECEIVE QUOTE secondary parsing 13248 005125'01 254 00 0 00 005115* jrst cmder1 ;[194] and allow command retry. 13249 k20par - Kermit-20 Parsing and Semantic Action Routines MACRO %53B(1254)-4 19:41 30-Mar-24 Page 93 K20PAR MAC 29-Mar-24 20:39 SET SEND/RECEIVE TIMEOUT secondary parsing 13250 subttl SET SEND/RECEIVE TIMEOUT secondary parsing 13251 13252 chgsec(code,const) ;;FDB's are not in code, they're in const 13253 001736'02 015004 000000 stifdb: flddb. .cmflt,,^d10, 13254 001737'02 000000 000012 13255 001740'02 44 07 0 00 003476' 13256 retsec ;;Back to where-ever we started from 13257 13258 005126'01 200 16 0 00 000000# .setim: guide 13259 005127'01 260 17 0 00 005015* 13260 001741'02 000000000000# 13261 002157'04 164 157 000 000 000 13262 005130'01 201 01 0 00 000000# movei t1, stifdb ;[212] 13263 005131'01 260 17 0 00 004764* call rfield ; Parse the number. 13264 005132'01 200 16 0 00 000000# guide 13265 005133'01 260 17 0 00 005127* 13266 001742'02 000000000000# 13267 002160'04 163 145 143 157 156 13268 13269 005134'01 325 02 0 00 005140' ifl. t2 ;[212] Is the number in the right range? 13270 005135'01 200 01 0 00 000000# emsg ;[212] 13271 005136'01 104 00 0 00 000313 13272 001743'02 000000000000# 13273 002162'04 116 145 147 141 164 13274 005137'01 254 00 0 00 005125* jrst cmder1 ;[212] allow reparse 13275 005140'01 endif. ;[212] 13276 13277 remark ;[212] When chksec works, it works completely 13278 005140'01 260 17 0 00 000000' call chksec ;[212] Ensure number is in correct range 13279 005141'01 254 00 0 00 005143' ifskp. ;[196] Check and convert OK? 13280 remark ;[196] Yes, must confirm later, maybe 13281 005142'01 254 00 0 00 005146' else. ;[196] Otherwise, couldn't swallow something 13282 005143'01 200 01 0 00 000000# emsg ; Macro definition 13556 000003'01 260 17 0 00 000000* 13557 000007'02 000000000000# 13558 000000'04 141 040 123 105 124 13559 movei t1, [ 13560 flddb. .cmswi,,tabswi,,,[ 13561 flddb. .cmkey,,mactab,,,[ 13562 flddb. .cmqst,,,,,[ 13563 flddb. .cmfld,,,,, 13564 000004'01 201 01 0 00 002435' ]]]] 13565 13566 000005'01 260 17 0 00 000000* call rfield ; Get the macro name 13567 000006'01 135 05 0 00 002440' ldb q1, [pointr (.cmfnp(t3),cm%fnc)] ; Get function code. 13568 000007'01 306 05 0 00 000003 cain q1, .cmswi ; Table function? 13569 000010'01 254 00 0 00 000555' callret tablem ; Hand off to table maintenance 13570 13571 ; If this is an existing macro, there is no need to reinsert it 13572 13573 000011'01 302 05 0 00 000000 caie q1, .cmkey ; A keyword (I.E., existing macro?) 13574 000012'01 254 00 0 00 000020' ifskp. ; It is, so just use it 13575 000013'01 202 02 0 00 000000# movem t2, tbent ; Save the table entry 13576 000014'01 554 01 0 02 000000 hlrz t1, (t2) ; Pull the address of the keyword 13577 000015'01 505 01 0 00 440700 hrli t1, (point 7,0) ; Turn into a local pointer 13578 000016'01 202 01 0 00 000000# movem t1, onamp ; This is the beginning of the string 13579 000017'01 254 00 0 00 000044' jrst .defi5 ; Skip accumulating the cruft 13580 000020'01 endif. 13581 k20mac - Kermit-20 DEFINE macro Implementation MACRO %53B(1254)-4 19:41 30-Mar-24 Page 2-1 K20MAC MAC 30-Jun-23 17:21 DEFINE command parsing 13582 ; Doesn't appear to be existing, so let's take a snapshot of the atom buffer 13583 13584 dmove t1, [ point 7,atmbuf ; Source is the atom buffer 13585 000020'01 120 01 0 00 002441' point 7,namatm ] ; Destination is a snapshot of it 13586 000021'01 202 02 0 00 000000# movem t2, onamp ; Beginning of candidate name stirng 13587 000022'01 260 17 0 00 000000* call asczcp ; Copy the ASCIZ string over 13588 000023'01 202 03 0 00 000000* movem t3, namlen ; Save the length of what we copied 13589 13590 ; BUT!! They might have put the keyword in double quotes, so check 13591 13592 000024'01 201 01 0 00 000000# movei t1, mactab ; Load the address of the keyword table 13593 000025'01 200 02 0 00 000000# move t2, onamp ; Pointer to proposed macro name 13594 000026'01 104 00 0 00 000537 TBLUK% ; Go have a look 13595 000027'01 320 12 0 00 000031' %jserr (,cmder1) ; Flame out, allow reparse 13596 000030'01 254 00 0 00 000034' 13597 000031'01 265 01 0 00 000000* 13598 000032'01 000000 000000 13599 000033'01 254 00 0 00 000000* 13600 13601 000034'01 607 02 0 00 040000 ifxn. t2, tl%exm ; So does it make anything EXACTLY? 13602 000035'01 254 00 0 00 000044' 13603 000036'01 202 01 0 00 000000# movem t1, tbent ; Save the table entry 13604 000037'01 554 04 0 01 000000 hlrz t4, (t1) ; Pick up the keyword address 13605 000040'01 505 04 0 00 440700 hrli t4, (point 7,0) ; Turn into a local pointer 13606 000041'01 202 04 0 00 000000# movem t4, onamp ; This is the beginning of the string 13607 000042'01 201 05 0 00 000000 movei q1, .cmkey ; Say we matched a keyword 13608 000043'01 254 00 0 00 000044' jrst .defi5 ; and skip accumulating cruft 13609 000044'01 endif. 13610 13611 ; Let them type CR here to undefine the macro, or else jump into the SET 13612 ; command parser to let them define a new macro, or redefine an old one. 13613 13614 000044'01 302 05 0 00 000000 .defi5: caie q1, .cmkey ; Exists? 13615 000045'01 254 00 0 00 000051' ifskp. ; Yes, so different guidance 13616 000046'01 200 16 0 00 000000# guide ; 13617 000047'01 260 17 0 00 000003* 13618 000010'02 000000000000# 13619 000004'04 164 157 040 165 156 13620 000050'01 254 00 0 00 000053' else. ; Otherwise, doing it from scratch 13621 000051'01 200 16 0 00 000000# guide ; Prompt with guide words. 13622 000052'01 260 17 0 00 000047* 13623 000011'02 000000000000# 13624 000011'04 164 157 040 123 105 13625 000053'01 endif. ; 13626 13627 000053'01 200 01 0 00 000000# move t1, sbk+.cmptr ; Get current pointer from comnd state block. 13628 000054'01 202 01 0 00 000000# movem t1, macptr ; Save it as pointer to macro body. 13629 13630 000055'01 476 00 0 00 000000# .defi6: setom definf ; Flag that we're doing a DEFINE. 13631 000056'01 201 01 0 00 002443' movei t1, [flddb. .cmkey,,settab,,,] ; Assume defining 13632 000057'01 306 05 0 00 000000 cain q1, .cmkey 13633 movei t1, [flddb. .cmcfm,,,,,[ 13634 flddb. .cmswi,,defswi,,,[ 13635 000060'01 201 01 0 00 002463' flddb. .cmkey,,settab,,,]]] ; 13636 000061'01 260 17 0 00 000005* call rfield ; Parse a keyword or a CR. k20mac - Kermit-20 DEFINE macro Implementation MACRO %53B(1254)-4 19:41 30-Mar-24 Page 2-2 K20MAC MAC 30-Jun-23 17:21 DEFINE command parsing 13637 000062'01 135 03 0 00 002440' ldb t3, [pointr (.cmfnp(t3),cm%fnc)] ; Get function code. 13638 000063'01 476 00 0 00 000000# setom undeff ; Assume we're undefining? 13639 000064'01 302 03 0 00 000003 caie t3, .cmswi ; Only uses switches to undefine 13640 000065'01 254 00 0 00 000070' ifskp. ; But must confirm the switch 13641 000066'01 550 01 0 02 000000 hrrz t1, (t2) ; Pick up secondary parse 13642 000067'01 254 00 0 01 000000 jrst (t1) ; And go there 13643 000070'01 endif. 13644 13645 000070'01 306 03 0 00 000010 cain t3, .cmcfm ; Parsed a CR? (if so, then undefing) 13646 000071'01 263 17 0 00 000000 ret ; Yes, so done. 13647 13648 000072'01 402 00 0 00 000000# setzm undeff ; No, we're defining after all. 13649 000073'01 254 00 0 00 000000* callret .set2 ; Go parse SET commands. 13650 k20mac - Kermit-20 DEFINE macro Implementation MACRO %53B(1254)-4 19:41 30-Mar-24 Page 3 K20MAC MAC 30-Jun-23 17:21 DEFINE command execution 13651 subttl DEFINE command execution 13652 13653 000074'01 $defin: entry $defin ; Invoked by K20PAR 13654 000074'01 265 16 0 00 002466' saveac ; Needs some extra registers 13655 000075'01 402 00 0 00 000000# setzm definf ; Clear define flag 13656 000076'01 332 00 0 00 000000# skipe undeff ; Define or Undefine? 13657 000077'01 254 00 0 00 000241' jrst $defi7 ; Undefine, go do that. 13658 13659 ;[82] remark Uncomment to Echo back what was typed... 13660 ;[82] move t1, onamp ; Name 13661 ;[82] PSOUT 13662 ;[82] txmsg < = > 13663 ;[82] move t1, macptr ; Text 13664 ;[82] PSOUT 13665 13666 000100'01 200 01 0 00 000000# move t1, macptr ; Load pointer to accumulated text 13667 000101'01 200 02 0 00 002500' move t2, [point 7,expatm] ; And a pointer to the macro text expansion buffer 13668 000102'01 260 17 0 00 000022* call asczcp ; Copy the ASCIZ string over 13669 000103'01 202 03 0 00 000000* movem t3, explen ; Save the length of what we copied 13670 13671 ; Here to figure out if we have enough room before we try the insert. 13672 ; Assumes all initial pointers started out on word boundaries 13673 13674 ; First, we'll do the name, checking to ensure that we are reusing an 13675 ; existing keyword, if it exists 13676 13677 000104'01 550 05 0 00 000000# hrrz q1, onamp ; Load the macro name pointer 13678 000105'01 305 05 0 00 000000# caige q1, mactab ; Could be in the macro table? 13679 000106'01 254 00 0 00 000113' ifskp. ; Yes, let's check a little further 13680 000107'01 301 05 0 00 000000# cail q1, macx ; But not off the end? 13681 000110'01 254 00 0 00 000113' anskp. ; Was outside, so must insert 13682 000111'01 400 05 0 00 000000 setz q1, ; So no words here because reusing 13683 000112'01 254 00 0 00 000123' else. ; Not an existing keyword 13684 000113'01 200 05 0 00 000023* move q1, namlen ; Load length of macro name candidate 13685 000114'01 200 02 0 00 002442' move t2, [point 7,namatm] ; Load pointer to same 13686 000115'01 133 05 0 00 000002 adjbp q1, t2 ; Calculate the ending pointer 13687 000116'01 302 05 0 00 440700 caie q1, 440700 ; On a word boundary? 13688 000117'01 271 05 0 00 000001 addi q1, ^d1 ; No, round up a word 13689 000120'01 621 05 0 00 777777 tlz q1, -1 ; Shut off the pointer part 13690 000121'01 621 02 0 00 777777 tlz t2, -1 ; in both pointers 13691 000122'01 274 05 0 00 000002 sub q1, t2 ; Now have required words 13692 000123'01 endif. ; Either way, something useful in t1 13693 13694 ; Now the body or expansion, which is somewhat more straightforward 13695 13696 000123'01 200 06 0 00 000103* move q2, explen ; Load length of macro expansion text 13697 000124'01 200 02 0 00 002500' move t2, [point 7,expatm] ; Load pointer to same 13698 000125'01 133 06 0 00 000002 adjbp q2, t2 ; Calculate the ending pointer 13699 000126'01 302 06 0 00 440700 caie q2, 440700 ; On a word boundary? 13700 000127'01 271 06 0 00 000001 addi q2, ^d1 ; No, round up a word 13701 000130'01 621 06 0 00 777777 tlz q2, -1 ; Shut off the pointer part 13702 000131'01 621 02 0 00 777777 tlz t2, -1 ; in both pointers 13703 000132'01 274 06 0 00 000002 sub q2, t2 ; Now have required words 13704 13705 ; Now see if we would go off the end k20mac - Kermit-20 DEFINE macro Implementation MACRO %53B(1254)-4 19:41 30-Mar-24 Page 3-1 K20MAC MAC 30-Jun-23 17:21 DEFINE command execution 13706 13707 000133'01 200 01 0 00 000000# $defad: move t1, macbp ; Load the current top of macro text 13708 000134'01 621 01 0 00 777777 tlz t1, -1 ; Shut off pointer (assumes always a word boundary) 13709 000135'01 270 01 0 00 000005 add t1, q1 ; Add in name length in words (if any) 13710 000136'01 270 01 0 00 000006 add t1, q2 ; Add in macro body length in words 13711 000137'01 301 01 0 00 000000# cail t1, macx ; But not off the end? 13712 000140'01 334 00 0 00 000000 %ermsg (,r) 13713 000141'01 254 00 0 00 000145' 13714 000142'01 265 01 0 00 000031* 13715 000143'01 000000000000# 13716 000144'01 254 00 0 00 000000* 13717 000013'04 115 141 143 162 157 13718 13719 ; What about the TBLUK% table? Is that full? 13720 13721 000145'01 550 01 0 00 000000# hrrz t1, mactab ; Load maximum possible entries 13722 000146'01 554 02 0 00 000000# hlrz t2, mactab ; Load current entry count 13723 000147'01 274 01 0 00 000002 sub t1, t2 ; See if any room 13724 000150'01 327 01 0 00 000157' ifle. t1 ; Nothing left or phonkey? 13725 000151'01 323 05 0 00 000157' andg. q1 ; And we're adding a keyword? 13726 000152'01 334 00 0 00 000000 %ermsg (,r) 13727 000153'01 254 00 0 00 000157' 13728 000154'01 265 01 0 00 000142* 13729 000155'01 000000000000# 13730 000156'01 254 00 0 00 000144* 13731 000024'04 115 141 170 151 155 13732 000157'01 endif. 13733 13734 ; OK, let's copy everything over (maybe) 13735 13736 000157'01 326 05 0 00 000163' ife. q1 ; Reusing a keyword? 13737 000160'01 550 07 0 00 000000# hrrz q3, onamp ; Yes, get its address 13738 000161'01 550 03 0 00 000000# hrrz t3, macbp ; Macro text goes directly in 13739 000162'01 254 00 0 00 000170' else. ; Otherwise, copy it in and use that 13740 000163'01 550 07 0 00 000000# hrrz q3, macbp ; Use word address of keyword location 13741 000164'01 200 01 0 00 000005 move t1, q1 ; Number of words to copy 13742 000165'01 201 02 0 00 000000* movei t2, namatm ; Source is the name that was in the atom buff 13743 000166'01 200 03 0 00 000007 move t3, q3 ; Destination in macro storage 13744 000167'01 123 01 0 00 002501' xblt. t1 ; And transfer it over 13745 000170'01 endif. 13746 13747 000170'01 200 01 0 00 000006 move t1, q2 ; Load length of expansion 13748 000171'01 201 02 0 00 000000* movei t2, expatm ; Source is expansion or body text we got 13749 000172'01 200 10 0 00 000003 move q4, t3 ; Begin storing where we left off 13750 000173'01 123 01 0 00 002501' xblt. t1 ; And pop that over 13751 000174'01 505 03 0 00 440700 hrli t3, (point 7,0) ; Turn into a pointer on a WORD boundaru 13752 000175'01 202 03 0 00 000000# movem t3, macbp ; And store as new top of storage 13753 13754 ; Finally either tweak the table or add the entry 13755 13756 000176'01 326 05 0 00 000227' ife. q1 ; Existing keyword? 13757 000177'01 332 01 0 00 000000# skipe t1, tbent ; Do we already have it? 13758 000200'01 254 00 0 00 000225' ifskp. ; No, go get find it 13759 000201'01 201 01 0 00 000000# movei t1, mactab ; Yes, let's find the entry 13760 000202'01 561 02 0 07 000000 hrroi t2, (q3) ; Pointer to keyword that was matched k20mac - Kermit-20 DEFINE macro Implementation MACRO %53B(1254)-4 19:41 30-Mar-24 Page 3-2 K20MAC MAC 30-Jun-23 17:21 DEFINE command execution 13761 000203'01 104 00 0 00 000537 TBLUK% ; See if it's in there (better be!) 13762 000204'01 320 12 0 00 000206' %jserr (,r) 13763 000205'01 254 00 0 00 000211' 13764 000206'01 265 01 0 00 000154* 13765 000207'01 000000000000# 13766 000210'01 254 00 0 00 000156* 13767 000035'04 123 145 141 162 143 13768 000211'01 603 02 0 00 040000 ifxe. t2, tl%exm ; Not there? 13769 000212'01 254 00 0 00 000225' 13770 000213'01 200 01 0 00 000000# emsg ;" font crock mode 13771 000214'01 104 00 0 00 000313 13772 000012'02 000000000000# 13773 000044'04 103 157 165 154 144 13774 000215'01 561 01 0 00 000000* hrroi t1, atmbuf ; Point at what we were looking for 13775 000216'01 104 00 0 00 000076 PSOUT% ; Type what we got told was in there 13776 000217'01 200 01 0 00 000000# txmsg <"> ;" font crock mode 13777 000220'01 104 00 0 00 000076 13778 000221'01 320 12 0 00 000222' 13779 000013'02 000000000000# 13780 000054'04 042 000 000 000 000 13781 000222'01 561 01 0 00 000000* hrroi t1, crlf ; Tie off the line 13782 000223'01 104 00 0 00 000076 PSOUT% 13783 000224'01 263 17 0 00 000000 ret ; Nothing further we can do, so leave 13784 000225'01 endif. ; End case looking for the macro name 13785 000225'01 endif. ; End case already have the table offset 13786 000225'01 542 10 0 01 000000 hrrm q4, (t1) ; Stomp in address of new body 13787 000226'01 263 17 0 00 000000 ret ; That's it, really 13788 000227'01 endif. ; End case replacing macro body 13789 13790 ; Otherwise, add

to macro keyword table. 13791 13792 000227'01 201 01 0 00 000000# movei t1, mactab ; Stick it in the macro table. 13793 000230'01 514 02 0 00 000007 hrlz t2, q3 ; Address of keyword,, 13794 000231'01 540 02 0 00 000010 hrr t2, q4 ; argument (address of body) 13795 000232'01 104 00 0 00 000536 TBADD% ; Inserting it should always work 13796 000233'01 320 12 0 00 000235' %jserr (,r) ; Must have missed a case, above 13797 000234'01 254 00 0 00 000240' 13798 000235'01 265 01 0 00 000206* 13799 000236'01 000000000000# 13800 000237'01 254 00 0 00 000210* 13801 000055'04 105 162 162 157 162 13802 000240'01 263 17 0 00 000000 ret 13803 k20mac - Kermit-20 DEFINE macro Implementation MACRO %53B(1254)-4 19:41 30-Mar-24 Page 4 K20MAC MAC 30-Jun-23 17:21 /UNDEFINE processing 13804 subttl /UNDEFINE processing 13805 13806 ; Come here directly to undefine an existing macro. 13807 ; First look it up. We should ALWAYS find it because we don't come 13808 ; here unless we had a keyword match in the first place. 13809 13810 000241'01 332 02 0 00 000000# $defi7: skipe t2, tbent ; Do we already have the keyword? 13811 000242'01 254 00 0 00 000267' ifskp. ; No, go get it 13812 000243'01 201 01 0 00 000000# movei t1, mactab ; Yes, look up its address in the kwd table. 13813 000244'01 200 02 0 00 000000# move t2, onamp ; Pointer to macro name. 13814 000245'01 104 00 0 00 000537 TBLUK% ; See if it's in there (should be) 13815 000246'01 320 12 0 00 000250' %jserr (,r) 13816 000247'01 254 00 0 00 000253' 13817 000250'01 265 01 0 00 000235* 13818 000251'01 000000000000# 13819 000252'01 254 00 0 00 000237* 13820 000062'04 103 157 165 154 144 13821 000253'01 603 02 0 00 040000 ifxe. t2, tl%exm ;[194] Found an exact match? 13822 000254'01 254 00 0 00 000266' 13823 000255'01 200 01 0 00 000000# txmsg <% "> ;[194] ;" No, warn. 13824 000256'01 104 00 0 00 000076 13825 000257'01 320 12 0 00 000260' 13826 000014'02 000000000000# 13827 000074'04 045 040 042 000 000 13828 000260'01 200 01 0 00 000000# move t1, onamp 13829 000261'01 104 00 0 00 000076 PSOUT 13830 000262'01 200 01 0 00 000000# txmsg < " not found in SET macro table> ;[194] ;" Font crock 13831 000263'01 104 00 0 00 000076 13832 000264'01 320 12 0 00 000265' 13833 000015'02 000000000000# 13834 000075'04 040 042 040 156 157 13835 000265'01 263 17 0 00 000000 ret 13836 000266'01 endif. ;[194] 13837 000266'01 200 02 0 00 000001 move t2, t1 ; The address we just got. 13838 000267'01 endif. ; End case didn't already have entry 13839 13840 ; Using the table index just obtained, delete the entry. 13841 13842 000267'01 201 01 0 00 000000# movei t1, mactab 13843 remark t2, ; Either already had it or found it 13844 000270'01 104 00 0 00 000535 TBDEL% ; Delete the old entry. 13845 000271'01 320 12 0 00 000273' %jserr (,r) 13846 000272'01 254 00 0 00 000276' 13847 000273'01 265 01 0 00 000250* 13848 000274'01 000000000000# 13849 000275'01 254 00 0 00 000252* 13850 000104'04 103 157 165 154 144 13851 000276'01 263 17 0 00 000000 ret 13852 k20mac - Kermit-20 DEFINE macro Implementation MACRO %53B(1254)-4 19:41 30-Mar-24 Page 5 K20MAC MAC 30-Jun-23 17:21 /UNDEFINE parsing 13853 subttl /UNDEFINE parsing 13854 13855 000277'01 260 17 0 00 000000* .undef: confrm ; Confirm the line 13856 000300'01 263 17 0 00 000000 ret ; Done 13857 13858 remark The reason there is no $UNDEF 13859 13860 ; Since the macro has no body, the default action is to remove it. Thus, 13861 ; /UNDEFINE doesn't really do anything other than function as a kind of 13862 ; 'syntactic sugar'. 13863 k20mac - Kermit-20 DEFINE macro Implementation MACRO %53B(1254)-4 19:41 30-Mar-24 Page 6 K20MAC MAC 30-Jun-23 17:21 /DUPLICATE parsing 13864 subttl /DUPLICATE parsing 13865 13866 000301'01 200 16 0 00 000000# .dupli: guide ; Macro definition 13867 000302'01 260 17 0 00 000052* 13868 000016'02 000000000000# 13869 000116'04 164 157 040 141 040 13870 movei t1, [ 13871 flddb. .cmqst,,,,,[ 13872 flddb. .cmfld,,,,, 13873 000303'01 201 01 0 00 002526' ]] 13874 13875 000304'01 260 17 0 00 000061* call rfield ; Get the macro name 13876 dmove t1, [ mactab ; Load the address of the keyword table 13877 000305'01 120 01 0 00 002531' point 7, atmbuf ] ; And a pointer to the atom buffer 13878 000306'01 104 00 0 00 000537 TBLUK% ; See if it's in there (shouldn't be) 13879 000307'01 320 12 0 00 000311' %jserr (,cmder1) ; Fail, allow a ^H 13880 000310'01 254 00 0 00 000314' 13881 000311'01 265 01 0 00 000273* 13882 000312'01 000000 000000 13883 000313'01 254 00 0 00 000033* 13884 13885 000314'01 607 02 0 00 040000 ifxn. t2, tl%exm ; Found an exact match? 13886 000315'01 254 00 0 00 000326' 13887 000316'01 200 01 0 00 000000# emsg ;" font crock mode 13888 000317'01 104 00 0 00 000313 13889 000017'02 000000000000# 13890 000123'04 124 150 145 040 162 13891 000320'01 561 01 0 00 000215* hrroi t1, atmbuf ; Point to the atom buffer 13892 000321'01 104 00 0 00 000076 PSOUT% ; Type the new name which won't work 13893 000322'01 200 01 0 00 000000# txmsg <" already exists> ;" font crock mode 13894 000323'01 104 00 0 00 000076 13895 000324'01 320 12 0 00 000325' 13896 000020'02 000000000000# 13897 000132'04 042 040 141 154 162 13898 000325'01 254 00 0 00 000313* jrst cmder1 ; Allow ^H 13899 000326'01 endif. 13900 13901 dmove t1, [point 7, atmbuf ; Load pointer to new keyword 13902 000326'01 120 01 0 00 002441' point 7, namatm] ; And a pointer to the macro name buffer 13903 000327'01 260 17 0 00 000102* call asczcp ; Copy the ASCIZ string over 13904 000330'01 202 03 0 00 000113* movem t3, namlen ; Save the length of what we copied 13905 13906 000331'01 260 17 0 00 000277* confrm ; Tie off the line 13907 13908 000332'01 201 01 0 00 002533' movei t1, [.dupli,,$dupli] ;Load our own semantic action 13909 000333'01 202 01 0 00 000000* movem t1, pars1 ; Stomp top-level parse, we're taking it from here 13910 000334'01 263 17 0 00 000000 ret ; Return into /DUPLICATE semantic action 13911 k20mac - Kermit-20 DEFINE macro Implementation MACRO %53B(1254)-4 19:41 30-Mar-24 Page 7 K20MAC MAC 30-Jun-23 17:21 /DUPLICATE semantic action 13912 subttl /DUPLICATE semantic action 13913 13914 000335'01 265 16 0 00 002466' $dupli: saveac ; MUST have same register usage as $defin!! 13915 000336'01 332 10 0 00 000000# skipe q4, tbent ; Already have the table address? 13916 000337'01 254 00 0 00 000366' ifskp. ; No, go find it 13917 000340'01 201 01 0 00 000000# movei t1, mactab ; Load the address of the keyword table 13918 000341'01 200 02 0 00 000000# move t2, onamp ; And the keyword text pointer 13919 000342'01 104 00 0 00 000537 TBLUK% ; See if it's in there (should be) 13920 000343'01 320 12 0 00 000345' %jserr (,r) 13921 000344'01 254 00 0 00 000350' 13922 000345'01 265 01 0 00 000311* 13923 000346'01 000000000000# 13924 000347'01 254 00 0 00 000275* 13925 000136'04 105 162 162 157 162 13926 000350'01 603 02 0 00 040000 ifxe. t2, tl%exm ; Found an exact match? 13927 000351'01 254 00 0 00 000365' 13928 000352'01 200 01 0 00 000000# emsg ;" No, bomb 13929 000353'01 104 00 0 00 000313 13930 000021'02 000000000000# 13931 000147'04 103 157 165 154 144 13932 000354'01 561 01 0 00 000165* hrroi t1, namatm ; Point at what we should have found 13933 000355'01 104 00 0 00 000076 PSOUT% ; Type it 13934 000356'01 200 01 0 00 000000# txmsg <" macro in order to duplicate it> 13935 000357'01 104 00 0 00 000076 13936 000360'01 320 12 0 00 000361' 13937 000022'02 000000000000# 13938 000154'04 042 040 155 141 143 13939 000361'01 561 01 0 00 000222* hrroi t1, crlf ; Tie off the line 13940 000362'01 104 00 0 00 000076 PSOUT% 13941 000363'01 263 17 0 00 000000 ret ; Get out of here 13942 000364'01 254 00 0 00 000366' else. ; Otherwise, found something 13943 000365'01 200 10 0 00 000001 move q4, t1 ; Save the table entry 13944 000366'01 endif. ; End case looking for the keyword 13945 000366'01 endif. ; End case already had it 13946 13947 ; Now the calculate the size in words of the new keyword 13948 13949 000366'01 200 05 0 00 000330* move q1, namlen ; Load length of macro expansion text 13950 000367'01 200 02 0 00 002442' move t2, [point 7,namatm] ; Load pointer to same 13951 000370'01 133 05 0 00 000002 adjbp q1, t2 ; Calculate the ending pointer 13952 000371'01 302 05 0 00 440700 caie q1, 440700 ; On a word boundary? 13953 000372'01 271 05 0 00 000001 addi q1, ^d1 ; No, round up a word 13954 000373'01 621 05 0 00 777777 tlz q1, -1 ; Shut off the pointer part 13955 000374'01 621 02 0 00 777777 tlz t2, -1 ; in both pointers 13956 000375'01 274 05 0 00 000002 sub q1, t2 ; Now have required words 13957 13958 ; Take a copy of the expansion text for the macro 13959 13960 000376'01 550 01 0 10 000000 hrrz t1, (q4) ; Get address of text 13961 000377'01 505 01 0 00 440700 hrli t1, (point 7,0) ; Now have our source 13962 000400'01 200 02 0 00 002500' move t2, [ point 7, expatm ] ; Put it in as new expansion 13963 000401'01 260 17 0 00 000327* call asczcp ; Copy the ASCIZ string over 13964 000402'01 202 03 0 00 000123* movem t3, explen ; And store the length 13965 13966 ; And figure out how long that was in words k20mac - Kermit-20 DEFINE macro Implementation MACRO %53B(1254)-4 19:41 30-Mar-24 Page 7-1 K20MAC MAC 30-Jun-23 17:21 /DUPLICATE semantic action 13967 13968 000403'01 200 06 0 00 000003 move q2, t3 ; Put the length where $defad wants it 13969 000404'01 200 02 0 00 002500' move t2, [ point 7, expatm ] ; Point to base of expansion 13970 000405'01 133 06 0 00 000002 adjbp q2, t2 ; Calculate the ending pointer 13971 000406'01 302 06 0 00 440700 caie q2, 440700 ; On a word boundary? 13972 000407'01 271 06 0 00 000001 addi q2, ^d1 ; No, round up a word 13973 000410'01 621 06 0 00 777777 tlz q2, -1 ; Shut off the pointer part 13974 000411'01 621 02 0 00 777777 tlz t2, -1 ; in both pointers 13975 000412'01 274 06 0 00 000002 sub q2, t2 ; Now have required words 13976 13977 ; Join $defad at the point of adding something 13978 13979 000413'01 254 00 0 00 000133' callret $defad ; And just add every 13980 000414'01 263 17 0 00 000000 ret 13981 k20mac - Kermit-20 DEFINE macro Implementation MACRO %53B(1254)-4 19:41 30-Mar-24 Page 8 K20MAC MAC 30-Jun-23 17:21 /REMOVE parsing 13982 subttl /REMOVE parsing 13983 13984 emacro < 13985 13986 .mremo: remark need to parse for the set parameter here 13987 confrm ; Tie off the line 13988 13989 movei t1, [.mremo,,$mremo] ;Load our own semantic action 13990 movem t1, pars1 ; Stomp top-level parse, we're taking it from here 13991 ret ; Return into /RENAME semantic action 13992 13993 >;;emacro 13994 k20mac - Kermit-20 DEFINE macro Implementation MACRO %53B(1254)-4 19:41 30-Mar-24 Page 9 K20MAC MAC 30-Jun-23 17:21 /REMOVE semantic action 13995 subttl /REMOVE semantic action 13996 13997 emacro < 13998 13999 $mremo: saveac ; Needs a lot of registers 14000 14001 skipe q4, tbent ; Already have the table address? 14002 ifskp. ; No, go find it 14003 movei t1, mactab ; Load the address of the keyword table 14004 move t2, onamp ; And the keyword text pointer 14005 TBLUK% ; See if it's in there (should be) 14006 %jserr (,r) 14007 ifxe. t2, tl%exm ; Found an exact match? 14008 emsg ;" No, bomb 14009 hrroi t1, namatm ; Point at what we should have found 14010 PSOUT% ; Type it 14011 txmsg <" macro in order to remove from it> 14012 hrroi t1, crlf ; Tie off the line 14013 PSOUT% 14014 ret ; Get out of here 14015 else. ; Otherwise, found something 14016 move q4, t1 ; Save the table entry 14017 endif. ; End case looking for the keyword 14018 endif. ; End case already had it 14019 14020 remark ; Toss anything in the macro editor 14021 seto t1, ; Case IV, deleting process memory 14022 dmove t2, [ .fhslf,,medpg ; This process, page number of medit psect 14023 pm%cnt!fld(edpgs,pm%rpt) ] ; Number of pages to toss 14024 PMAP% ; Trim our working set 14025 %jserr (,) ; Odd... but continue 14026 14027 remark ; Set up editing table prototype 14028 xmovei t3, medorg ; Load base of .psect 14029 dmove t1, [ 0,,MACMAX ; TBLUK% table has no entries now 14030 0 ] ; Stomp the 2nd location, just in case 14031 dmovem t1, (t3) ; Now have an empty table 14032 xmovei q3, MACMAX+1(t3) ; Now have top of macro text editing area 14033 dmove t1, q3 ; Load information for splitter 14034 call csplit ; Split the text into keyword names and data 14035 >;;emacro 14036 k20mac - Kermit-20 DEFINE macro Implementation MACRO %53B(1254)-4 19:41 30-Mar-24 Page 10 K20MAC MAC 30-Jun-23 17:21 Takes a pointer to macro text and splits it up with COMND% 14037 subttl Takes a pointer to macro text and splits it up with COMND% 14038 14039 ; t1/ Top of editing area to stash things 14040 ; t2/ TBLUK% entry of existing macro 14041 14042 ;N.B., assumes editing area is zeroed!! 14043 14044 emacro < 14045 14046 csplit: saveac 14047 move q3, t1 ; Save top of macro insertion 14048 hrli q4, (point 7,0) ; Build a section local pointer 14049 hrr q4, (t2) ; Get address of macro text 14050 14051 do. ; Enter loop context 14052 call splini ; Initialize for parsing from string 14053 move q2, t2 ; Put the CMDBUF pointer in a safe place 14054 call prepar ; Prepare to parse 14055 jumpe t1,endlp. ; Done at end of string 14056 move q1, t1 ; Save it 14057 call dopair ; Do a set pair 14058 cain q1, .chlfd ; Line Feed? 14059 exit. ; Yes, last command in text 14060 loop. ; Next pair 14061 enddo. ; Exit loop lexical context 14062 14063 call splfix ; Fix the CSB up 14064 ret ; Done 14065 14066 >;;emacro 14067 k20mac - Kermit-20 DEFINE macro Implementation MACRO %53B(1254)-4 19:41 30-Mar-24 Page 11 K20MAC MAC 30-Jun-23 17:21 Do a SET paramater-value pair 14068 subttl Do a SET paramater-value pair 14069 14070 ; N.B., might not just be a pair, could be secondary parsing 14071 ; 14072 ; Maybe put the .sigio stuff in when debugging? Gives real nasty 14073 ; error because we can't trap it. 14074 14075 emacro < 14076 14077 ccrlf: point 7, crlf 14078 -^d2 14079 14080 dopair: saveac ; Needs to save a few things 14081 14082 move q1, sbk+.cmioj ; Load current input and output JFN pair 14083 hrli t1, .sigio ; Set to blow up on a read 14084 hrr t1, q1 ; Let it blat if it wants to 14085 movem t1, sbk+.cmioj ; Set up our trick wire 14086 14087 movei t1, [ flddb. .cmkey,,settab ] 14088 call rflde ; Parse just the SET keyword 14089 %ermsg (,r) ; Leave 14090 ldb t4, [pointr (.cmfnp(t3),cm%fnc)] ; Get function code. 14091 move q2, t2 ; Keep selected item safe 14092 14093 hlro t1,(q2) ; Show parameter name (keyword 14094 psout% 14095 call csbinf ; Maybe type out interesting CSB stuff 14096 hrrz t4, (q2) ; Get parser and action for parameter valud 14097 hlrz t1, (t4) ; This is the parser portion 14098 14099 setom definf ; Fake we're defining 14100 call (t1) ; Parse the rest of something 14101 setzm definf ; Out of phoney define 14102 14103 move t1, q1 ; Load saved in and out JFN pair 14104 movem t1, sbk+.cmioj ; Restore to the SBK 14105 14106 hrroi t1, atmbuf ; Point to what we parsed 14107 PSOUT% 14108 call csbinf 14109 14110 hrroi t1, crlf 14111 psout 14112 ret 14113 14114 >;;emacro 14115 k20mac - Kermit-20 DEFINE macro Implementation MACRO %53B(1254)-4 19:41 30-Mar-24 Page 12 K20MAC MAC 30-Jun-23 17:21 Display Useful CSB Information 14116 subttl Display Useful CSB Information 14117 14118 emacro < 14119 14120 csbinf: skipg t4, sbk+.cminc ; Anything left to parse? 14121 ifskp. ; It appears so 14122 cain t4, ^d1 ; One dinky character? 14123 anskp. ; Yep; don't let's bother with that 14124 movei t1, .priou ; Going to terminal 14125 movei t2, .chtab ; Space over 14126 BOUT% ; Do it 14127 erjmps .+1 ; Catch and suppress error 14128 move t2, t4 14129 movei t3, ^d10 14130 NOUT% 14131 erjmps .+1 ; Catch and suppress error 14132 movei t2, "," ; Quote it to be sure 14133 BOUT% ; Do it 14134 movei t2, "'" ; Quote it to be sure 14135 BOUT% ; Do it 14136 erjmps .+1 ; Catch and suppress error 14137 move t2, sbk+.cmptr ; Point to rest of text 14138 movn t3, t4 ; Counted SOUT% 14139 SOUT% ; See what's left 14140 erjmpr .+1 ; Catch and ignore error 14141 movei t2, "'" ; Quote it to be sure 14142 BOUT% ; Do it 14143 erjmps .+1 ; Catch and suppress error 14144 movei t2, .chtab ; Space over 14145 BOUT% ; Do it 14146 erjmps .+1 ; Catch and suppress error 14147 else. ; Otherwise, just tab over 14148 movei t1, .chtab ; Space over 14149 PBOUT% 14150 PBOUT% 14151 endif. 14152 ret 14153 >;;emacro 14154 k20mac - Kermit-20 DEFINE macro Implementation MACRO %53B(1254)-4 19:41 30-Mar-24 Page 13 K20MAC MAC 30-Jun-23 17:21 .SIGIO Input handler 14155 subttl .SIGIO Input handler 14156 14157 emacro < 14158 ; N.B., This code doesn't work. It will *NEVER* work unless a 14159 ; significant change is made to Tops-20. 14160 ; 14161 ; .SIGIO is unfortunately hard wired to be multiplexed on channel 14162 ; 19 (along with address break), which is Inferior Fork Termination 14163 ; (.ICIFT). Tops-20 very reasonably does not allow a fork to catch 14164 ; its own termination. 14165 ; 14166 ; I would have thought a more obvious approach would have been to 14167 ; implement .SIGIO in a similar fashion to the .TICTI/.TICTO 14168 ; terminal codes (interrupt on type-in/output detected), the 14169 ; difference being that if you didn't handle .SIGIO, it's goes 14170 ; 'upstairs' like other panic channels. 14171 ; 14172 ; For debugging, using .SIGIO still helps because if you mess up 14173 ; the pointers in the CSB, then the fork will terminate and you can 14174 ; investigate with DDT instead of going into a terminal wait. 14175 14176 repeat 0,< ; See above, can't use this, ever 14177 extern pc3 ; Globalized in K20SUB 14178 14179 sitrap: intern sitrap ; K20SUB needs the address in CHNTAB 14180 14181 aos sintn ; Count a signal just because ... 14182 push p, t1 ; Save an accumulator 14183 push p, t2 ; And another one 14184 push p, t3 ; One more!!! 14185 14186 move t1, pc3 ; Pick up our interrupted location 14187 ifxe. t1, pc%usr ; We are only breaking out of a JSYS 14188 hrrz t2, t1 ; PC is where the JSYS will return 14189 subi t2, ^d1 ; So fix it to look at the JSYS 14190 hllz t3, (t2) ; Isolate the left half word 14191 txz t3, 777 ; Want just the opcode 14192 came t3, [ COMND% ] ; Trying to parse something? 14193 anskp. ; Nope, we're done 14194 txo t1, pc%usr ; Force user mode 14195 movem t1, pc3 ; Change DEBRK% action 14196 movx t1, cm%nop ; Force a parse failure 14197 else. ; Otherwise, leave everything alone 14198 setz t1, ; And no flag fix up 14199 endif. 14200 14201 sitepi: pop p, t3 ; Signal trap epilogue 14202 pop p, t2 ; Restores ac2 and ac3 immediately 14203 orm t1, (p) ; Or in any flags before restore 14204 pop p, t1 ; Restore modified or unmodified 14205 14206 DEBRK% ; Done 14207 >;;End Repeat 0 14208 >;;emacro 14209 k20mac - Kermit-20 DEFINE macro Implementation MACRO %53B(1254)-4 19:41 30-Mar-24 Page 14 K20MAC MAC 30-Jun-23 17:21 Turn .sigio interrupts on and off 14210 subttl Turn .sigio interrupts on and off 14211 14212 emacro < 14213 repeat 0,< ; See above, will never work 14214 extern sigchb ; Defined in K20SUB 14215 14216 dosigh: .fhslf ; This process 14217 sigchb ; .SIGIO channel bit 14218 14219 tsigon: dmove t1, dosigh ; Turn on the signal I/O handler 14220 AIC% ; Enable to catch it 14221 %jserr (,) ; Odd, but carry on 14222 ret 14223 14224 sigoff: dmove t1, dosigh ; Turn off the signal I/O handler 14225 DIC% ; Enable to catch it 14226 %jserr (,) ; Odd, but carry on 14227 ret 14228 >;;End Repeat 0 14229 >;;emacro 14230 k20mac - Kermit-20 DEFINE macro Implementation MACRO %53B(1254)-4 19:41 30-Mar-24 Page 15 K20MAC MAC 30-Jun-23 17:21 COMND% Command State Block Initialization/Fix Up 14231 subttl COMND% Command State Block Initialization/Fix Up 14232 14233 emacro < 14234 splini: remark ; Split initialization 14235 remark ; Tweak the csb to parse from string 14236 dmove t2,[point 7,cmdbuf ;Point to beginning of command buffer 14237 cmdbln*5 ] ; Max characters in command buffer 14238 dmovem t2, sbk+.cmptr ; Stomp both in; beginning of parse 14239 setzm sbk+.cminc ; No unparsed characters, yet... 14240 ret 14241 14242 splfix: remark ; Done parsing, fix the CSB back up 14243 dmove t1,[point 7,cmdbuf ;Point to beginning of command buffer 14244 cmdbln*5 ] ; Max characters in command buffer 14245 dmovem t1, sbk+.cmptr ; Stomp both in; nothing left to parse 14246 setzm sbk+.cminc ; No unparsed characters anymore 14247 setzb t1, t2 ; Cons up ten .CHNUL's 14248 dmovem t1, cmdbuf ; Scrub the command buffer an itty bit 14249 hllm t1, sbk ; Zero the CSB flags. 14250 ret 14251 14252 >;;emacro 14253 k20mac - Kermit-20 DEFINE macro Implementation MACRO %53B(1254)-4 19:41 30-Mar-24 Page 16 K20MAC MAC 30-Jun-23 17:21 Prepare CSB and CMDBUF to parse from string 14254 subttl Prepare CSB and CMDBUF to parse from string 14255 14256 ; Expects 14257 ; 14258 ; q4/ Pointer to macro text 14259 ; q2/ Pointer to command buffer 14260 ; 14261 ; Returns: 14262 ; 14263 ; t1/ Terminating character 14264 ; 14265 ; CMDBUF filled 14266 ; CSB conditioned 14267 14268 emacro < 14269 14270 prepar: do. ; Enter loop context 14271 ildb t1, q4 ; Get a character from the macro text 14272 jumpe t1, endlp. ; Exit routine on end of string 14273 cain t1, .chcrt ; A carriage return? 14274 movei t1, .chlfd ; Turn into what COMND% wants ... 14275 idpb t1, q2 ; Copy the character into the command buffer 14276 aos sbk+.cminc ; Account for character to be parsed 14277 sos sbk+.cmcnt ; Account for character storage used 14278 cain t1, .chlfd ; A line feed? 14279 exit. ; Last command on line 14280 cain t1, "," ; Hit a comma? 14281 exit. ; Yes, SET pair seperator 14282 loop. ; Process next character 14283 enddo. ; End loop lexical context 14284 14285 ret ; And done 14286 >;;emacro 14287 k20mac - Kermit-20 DEFINE macro Implementation MACRO %53B(1254)-4 19:41 30-Mar-24 Page 17 K20MAC MAC 30-Jun-23 17:21 msplit - Takes a macro text and splits it up 14288 subttl msplit - Takes a macro text and splits it up 14289 14290 ; t1/ Top of editing area to stash things 14291 ; t2/ TBLUK% entry of existing macro 14292 ; 14293 ; First attempt, abandoned for using COMND% based approach 14294 ; 14295 ;N.B., assumes editing area is zeroed!! 14296 14297 emacro < 14298 repeat 0,< 14299 msplit: saveac 14300 move q3, t1 ; Save top of macro insertion 14301 hrli q4, (point 7,0) ; Build a section local pointer 14302 hrr q4, (t2) ; Get address of macro text 14303 14304 do. ; Enter main loop context 14305 move q1, q3 ; This will be a SET keyword 14306 hrrz t2, q1 ; Pointer starts there 14307 hrli t2, (point 7,0) ; Build a section local pointer 14308 setz t3, ; No beginning of keyword, yet 14309 do. ; Enter keyword identification loop 14310 ildb t1, q4 ; Pick up a byte of keyword 14311 block. ; Enter block context for easier control flow 14312 jumpe t1, rskp ; End of string? That's odd 14313 cain t1, .chspc ; Space? 14314 retskp ; End of keyword 14315 cain t1, .chtab ; Tab? 14316 retskp ; End of keyword 14317 cain t1, .chlpa ; Left parenthesis? 14318 retskp ; COMND% will break on that 14319 ret ; None of the above 14320 endbk. ; Exit block context 14321 ifskp. ; Hit a break character 14322 jumpn t3, endlp. ; If started significance, this a break, so leave 14323 loop. ; Nope, swallow it and get another 14324 else. ; Otherwise, signicant 14325 idpb t1, t2 ; Deposit in keyword area 14326 aoja t3, top. ; Flag start of significance 14327 endif. 14328 enddo. ; End keyword indentification loop 14329 ife. t1 ; Should not hit end of string after keyword 14330 move t1, q3 ; Load updated top of text area 14331 ret ; And stop 14332 endif. 14333 caie t2, 440700 ; On a word boundary? 14334 addi t2, ^d1 ; No, round up a word 14335 hrrz q2, t2 ; This will be the SET parameter 14336 move q3, q2 ; Also new top of storage 14337 setzb t3, t4 ; Haven't seen any characters, yet 14338 do. ; Enter value identification loop 14339 ildb t1, q4 ; Pick up a byte of keyword 14340 block. ; Enter block context for easier control flow 14341 cain t1, .chspc ; Space? 14342 retskp ; Reset value length counter k20mac - Kermit-20 DEFINE macro Implementation MACRO %53B(1254)-4 19:41 30-Mar-24 Page 17-1 K20MAC MAC 30-Jun-23 17:21 msplit - Takes a macro text and splits it up 14343 cain t1, .chtab ; Tab? 14344 retskp ; Reset value length counter 14345 cain t1, .chrpa ; Right parenthesis? 14346 retskp ; Reset value length counter 14347 ife. t1 ; .chnul?? 14348 seto t4, ; Flag end of keyword value 14349 ret ; But count it 14350 endif. 14351 caie t1, "," ; Value terminator? 14352 ifskp. ; Yes, we have the value for this keyword 14353 seto t4, ; Flag end of keyword value 14354 ret ; But count it 14355 endif. 14356 ret ; Some other character, count it 14357 endbk. ; End block context 14358 ifskp. ; +2 means hit a seperator character 14359 setz t3, ; Reset the counter 14360 loop. ; And get another character 14361 else. ; Otherwise, count towards a keyword 14362 jumpn t4, endlp. ; Break loop on end of keyword value 14363 aoja t3, top. ; Count the character and loop 14364 endif. ; End of block exit handling 14365 enddo. ; End search loop 14366 ife. t3 ; Never found a value? 14367 addi q3, ^d1 ; Leave a word of .chnul's 14368 else. ; Otherwise have to play with pointers 14369 move t1, q2 ; Destination is top of storage 14370 hrli t1,(point 7,0) ; Turn into a word based pointer 14371 movn t2, t3 ; Load negatve keyword length 14372 subi t2, ^d1 ; Don't copy the comma or .chnul 14373 adjbp t2, q4 ; Back up to beginning of keyword 14374 do. ; And copy the keyword over 14375 ildb t4, t2 ; Pick up a byte from macro text 14376 idpb t4, t1 ; And put into edit area 14377 sojg t3, top. ; Do all of them 14378 enddo. 14379 caie t1, 440700 ; Ended on a word boundary? 14380 addi t1, ^d1 ; No, round up a word 14381 hrrz q3, t1 ; Set new top of storage 14382 endif. 14383 14384 movei t1, medorg ; Address of keyword table 14385 hrlz t2, q1 ; Load address of keyword text 14386 hrr t2, q2 ; Identified value 14387 TBADD% ; Cross our fingers and insert 14388 %jserr (,) ;Carry on 14389 ldb t1, q4 ; Load stopping character 14390 jumpe t1, endlp. ; End of macro text, done 14391 loop. ; Look for next keyword value pair 14392 enddo. ; End of split loop 14393 14394 move t1, q3 ; Load updated top of text area 14395 ret 14396 >;;repeat 0 14397 >;;emacro k20mac - Kermit-20 DEFINE macro Implementation MACRO %53B(1254)-4 19:41 30-Mar-24 Page 17-2 K20MAC MAC 30-Jun-23 17:21 msplit - Takes a macro text and splits it up 14398 k20mac - Kermit-20 DEFINE macro Implementation MACRO %53B(1254)-4 19:41 30-Mar-24 Page 18 K20MAC MAC 30-Jun-23 17:21 /RENAME parsing 14399 subttl /RENAME parsing 14400 14401 000415'01 200 16 0 00 000000# .renam: guide ; Macro definition 14402 000416'01 260 17 0 00 000302* 14403 000023'02 000000000000# 14404 000163'04 164 157 040 141 040 14405 movei t1, [ 14406 flddb. .cmqst,,,,,[ 14407 flddb. .cmfld,,,,, 14408 000417'01 201 01 0 00 002526' ]] 14409 14410 000420'01 260 17 0 00 000304* call rfield ; Get the new name for the macro 14411 14412 dmove t1, [ mactab ; Load the address of the keyword table 14413 000421'01 120 01 0 00 002534' point 7, atmbuf ] ; And a pointer to the atom buffer 14414 000422'01 104 00 0 00 000537 TBLUK% ; See if it's in there (shouldn't be) 14415 000423'01 320 12 0 00 000425' %jserr (,cmder1) ; Fail, allow a ^H 14416 000424'01 254 00 0 00 000430' 14417 000425'01 265 01 0 00 000345* 14418 000426'01 000000 000000 14419 000427'01 254 00 0 00 000325* 14420 14421 000430'01 607 02 0 00 040000 ifxn. t2, tl%exm ; Found an exact match? 14422 000431'01 254 00 0 00 000442' 14423 000432'01 200 01 0 00 000000# emsg ;" font crock mode 14424 000433'01 104 00 0 00 000313 14425 000024'02 000000000000# 14426 000170'04 124 150 145 040 162 14427 000434'01 561 01 0 00 000320* hrroi t1, atmbuf ; Point to the atom buffer 14428 000435'01 104 00 0 00 000076 PSOUT% ; Type the new name which won't work 14429 000436'01 200 01 0 00 000000# txmsg <" already exists> ;" font crock mode 14430 000437'01 104 00 0 00 000076 14431 000440'01 320 12 0 00 000441' 14432 000025'02 000000000000# 14433 000177'04 042 040 141 154 162 14434 000441'01 254 00 0 00 000427* jrst cmder1 ; Allow ^H 14435 000442'01 endif. 14436 14437 dmove t1, [point 7, atmbuf ; Load pointer to new keyword 14438 000442'01 120 01 0 00 002441' point 7, namatm] ; And a pointer to the macro name buffer 14439 000443'01 260 17 0 00 000401* call asczcp ; Copy the ASCIZ string over 14440 000444'01 202 03 0 00 000366* movem t3, namlen ; Save the length of what we copied 14441 14442 000445'01 260 17 0 00 000331* confrm ; Tie off the line 14443 14444 000446'01 201 01 0 00 002536' movei t1, [.renam,,$renam] ;Load our own semantic action 14445 000447'01 202 01 0 00 000333* movem t1, pars1 ; Stomp top-level parse, we're taking it from here 14446 000450'01 263 17 0 00 000000 ret ; Return into /RENAME semantic action 14447 k20mac - Kermit-20 DEFINE macro Implementation MACRO %53B(1254)-4 19:41 30-Mar-24 Page 19 K20MAC MAC 30-Jun-23 17:21 /RENAME semantic action 14448 subttl /RENAME semantic action 14449 14450 000451'01 265 16 0 00 002466' $renam: saveac ; Doesn't link with $define 14451 000452'01 332 10 0 00 000000# skipe q4, tbent ; Do we already have the keyword address? 14452 000453'01 254 00 0 00 000502' ifskp. ; Nope, go get it 14453 000454'01 201 01 0 00 000000# movei t1, mactab ; Load the address of the keyword table 14454 000455'01 200 02 0 00 000000# move t2, onamp ; And the keyword text pointer we started with 14455 000456'01 104 00 0 00 000537 TBLUK% ; See if it's in there (it betterbe) 14456 000457'01 320 12 0 00 000461' %jserr (,r) 14457 000460'01 254 00 0 00 000464' 14458 000461'01 265 01 0 00 000425* 14459 000462'01 000000000000# 14460 000463'01 254 00 0 00 000347* 14461 000203'04 105 162 162 157 162 14462 000464'01 603 02 0 00 040000 ifxe. t2, tl%exm ; Found an exact match? 14463 000465'01 254 00 0 00 000501' 14464 000466'01 200 01 0 00 000000# emsg ;" No, bomb 14465 000467'01 104 00 0 00 000313 14466 000026'02 000000000000# 14467 000213'04 103 157 165 154 144 14468 000470'01 561 01 0 00 000354* hrroi t1, namatm ; Point at what we should have found 14469 000471'01 104 00 0 00 000076 PSOUT% ; Type it 14470 000472'01 200 01 0 00 000000# txmsg <" macro in order to duplicate it> 14471 000473'01 104 00 0 00 000076 14472 000474'01 320 12 0 00 000475' 14473 000027'02 000000000000# 14474 000220'04 042 040 155 141 143 14475 000475'01 561 01 0 00 000361* hrroi t1, crlf ; Tie off the line 14476 000476'01 104 00 0 00 000076 PSOUT% 14477 000477'01 263 17 0 00 000000 ret ; Get out of here 14478 000500'01 254 00 0 00 000502' else. ; Otherwise, have something 14479 000501'01 200 10 0 00 000001 move q4, t1 ; Save the table entry 14480 000502'01 endif. ; End case looking for macro name 14481 000502'01 endif. ; End case already had the keyword address 14482 14483 ; Calculate the size of the new macro name in words 14484 14485 000502'01 200 05 0 00 000444* move q1, namlen ; Load length of macro name in characters 14486 000503'01 200 02 0 00 002442' move t2, [point 7,namatm] ; Load pointer to same 14487 000504'01 133 05 0 00 000002 adjbp q1, t2 ; Calculate the ending pointer 14488 000505'01 302 05 0 00 440700 caie q1, 440700 ; On a word boundary? 14489 000506'01 271 05 0 00 000001 addi q1, ^d1 ; No, round up a word 14490 000507'01 621 05 0 00 777777 tlz q1, -1 ; Shut off the pointer part 14491 000510'01 621 02 0 00 777777 tlz t2, -1 ; in both pointers 14492 000511'01 274 05 0 00 000002 sub q1, t2 ; Now have required words to transfer new name 14493 14494 ; But!! Would putting it in the table take us over the end? 14495 14496 000512'01 200 01 0 00 000000# move t1, macbp ; Load the current top of macro text 14497 000513'01 621 01 0 00 777777 tlz t1, -1 ; Shut off pointer (its always a word boundary) 14498 000514'01 270 01 0 00 000005 add t1, q1 ; Add in the new name's length in words 14499 000515'01 301 01 0 00 000000# cail t1, macx ; Not off the end, I hope? 14500 000516'01 334 00 0 00 000000 %ermsg (,r) 14501 000517'01 254 00 0 00 000523' 14502 000520'01 265 01 0 00 000461* k20mac - Kermit-20 DEFINE macro Implementation MACRO %53B(1254)-4 19:41 30-Mar-24 Page 19-1 K20MAC MAC 30-Jun-23 17:21 /RENAME semantic action 14503 000521'01 000000000000# 14504 000522'01 254 00 0 00 000463* 14505 000227'04 115 141 143 162 157 14506 14507 ; Ok, so safe to pop the name into the macro table 14508 14509 000523'01 550 07 0 00 000000# hrrz q3, macbp ; Use word address of keyword location 14510 000524'01 200 01 0 00 000005 move t1, q1 ; Number of words to copy 14511 000525'01 201 02 0 00 000470* movei t2, namatm ; Source is the name that was in the atom buffer 14512 000526'01 200 03 0 00 000007 move t3, q3 ; Destination is in macro storage 14513 000527'01 123 01 0 00 002501' xblt. t1 ; And transfer it over 14514 000530'01 505 03 0 00 440700 hrli t3, (point 7,0) ; Turn final address into a word aligned pointer 14515 000531'01 202 03 0 00 000000# movem t3, macbp ; Set new top of macro storage 14516 14517 ; Now build the TBLUK% table entry to insert 14518 14519 000532'01 514 06 0 00 000007 hrlz q2, q3 ; Keyword is what we just copied in 14520 000533'01 540 06 0 10 000000 hrr q2, (q4) ; But the macro text remains the same 14521 14522 ; First, remove the old keyword so we don't have to check the table entry count 14523 14524 000534'01 201 01 0 00 000000# movei t1, mactab ; Load the address of the macro table 14525 000535'01 200 02 0 00 000010 move t2, q4 ; And the address of the keyword entry 14526 000536'01 104 00 0 00 000535 TBDEL% ; Remove (should always work since just found it) 14527 000537'01 320 12 0 00 000541' %jserr (,r) ;?? 14528 000540'01 254 00 0 00 000544' 14529 000541'01 265 01 0 00 000520* 14530 000542'01 000000000000# 14531 000543'01 254 00 0 00 000522* 14532 000240'04 122 145 156 141 155 14533 14534 ; Finally insert ours; should work because previously checked 14535 14536 000544'01 201 01 0 00 000000# movei t1, mactab ; Load the address of the macro table 14537 000545'01 200 02 0 00 000006 move t2, q2 ; And our new keyword entry 14538 000546'01 104 00 0 00 000536 TBADD% ; Enter it in the TBLUK% table 14539 000547'01 320 12 0 00 000551' %jserr (,r) 14540 000550'01 254 00 0 00 000554' 14541 000551'01 265 01 0 00 000541* 14542 000552'01 000000000000# 14543 000553'01 254 00 0 00 000543* 14544 000251'04 122 145 156 141 155 14545 14546 000554'01 263 17 0 00 000000 ret 14547 k20mac - Kermit-20 DEFINE macro Implementation MACRO %53B(1254)-4 19:41 30-Mar-24 Page 20 K20MAC MAC 30-Jun-23 17:21 DEFINE macro table maintenance functions 14548 subttl DEFINE macro table maintenance functions 14549 14550 ; Begin code insertion 14551 14552 000030'02 000000 000000 %table(tabswi) ; Table maintenance switches 14553 000031'02 000000# 000000# %key3 , .mcomp, $mcomp ; Garbage collect 14554 000015'03 143 157 155 160 141 14555 000017'03 000000# 000000# 14556 000032'02 000000# 000000# %key3 , .mdump, $mdump ; Write a macros in binary format 14557 000020'03 144 165 155 160 000 14558 000021'03 000000# 000000# 14559 000033'02 000000# 000000# %keyf4 , .mrese, $mrese, cm%inv ; (sleepy Tom...) 14560 000022'03 002000 000001 14561 000023'03 151 156 164 151 141 14562 000025'03 000000# 000000# 14563 000034'02 000000# 000000# %key3 , .mmap, $mmap ; Directly use macros from binary file 14564 000026'03 155 141 160 000 000 14565 000027'03 000000# 000000# 14566 000035'02 000000# 000000# %key3 , .mrese, $mrese ; Whack everything 14567 000030'03 162 145 163 145 164 14568 000032'03 000000# 000000# 14569 000036'02 000000# 000000# %key3 , .msave, $msave ; Save macros in ASCII format 14570 000033'03 163 141 166 145 000 14571 000034'03 000000# 000000# 14572 000037'02 000000# 000000# %key3 , .msumm, $msumm ; Summary of table usage 14573 000035'03 163 165 155 155 141 14574 000037'03 000000# 000000# 14575 000030'02 000007 000007 %tbend 14576 14577 000555'01 550 04 0 02 000000 tablem: hrrz t4, (t2) ; Get the command routine addresses. 14578 000556'01 202 04 0 00 000447* movem t4, pars1 ; Stomp top-level parse, we're taking it from here 14579 000557'01 554 01 0 04 000000 hlrz t1, (t4) ; Get the syntax routine 14580 000560'01 254 00 0 01 000000 callret (t1) ; Call it and carry on 14581 k20mac - Kermit-20 DEFINE macro Implementation MACRO %53B(1254)-4 19:41 30-Mar-24 Page 21 K20MAC MAC 30-Jun-23 17:21 Parse the /DUMP switch 14582 subttl Parse the /DUMP switch 14583 14584 ; Tries for a device first as this is more efficient for NUL: and 14585 ; catches more errors earlier and more easily. 14586 14587 ; Default command filespec fields for .CMFIL: 14588 14589 000561'01 600020 777777 dmpbk: gj%flg!gj%fou!gj%new!fld(.gjnhg,.rhalf) ; .GJGEN 14590 000562'01 000100 000101 .priin,,.priou ; .GJSRC (ignored if COMND%) 14591 000563'01 000000 000000 0 ; .GJDEV (do not default the device) 14592 000564'01 000000 000000 0 ; .GJDIR (do not default the directory) 14593 000565'01 000000 000000 0 ; .GJNAM (do not default the name) 14594 000566'01 000000000000# eascii () ; .GJEXT (default extension is .BIN) 14595 000261'04 102 111 116 000 000 14596 000567'01 000000000000# 0 ; .GJPRO (use system default protection) 14597 000570'01 000000 000000 0 ; .GJACT (use job's current account) 14598 000010 dmpbkl==<.-dmpbk> ; Length of this GTJFN argument block. 14599 14600 000571'01 265 16 0 00 002466' .mdump: saveac ; Protect some registers 14601 000572'01 200 01 0 00 002537' movx t1, cz%ncl!.fhslf ; Release non-open JFN's on reparse 14602 000573'01 104 00 0 00 000034 CLZFF% 14603 000574'01 320 12 0 00 000575' erjmpr .+1 ; Catch and ignore errors 14604 000575'01 200 16 0 00 000000# guide 14605 000576'01 260 17 0 00 000416* 14606 000040'02 000000000000# 14607 000262'04 155 141 143 162 157 14608 000577'01 200 01 0 00 002540' move t1, [dmpbk,,cjfnbk] ; Insert our file parsing defaults. 14609 000600'01 251 01 0 00 000000# blt t1, cjfnbk+dmpbkl 14610 14611 movei t1, [ ; Catch bare device 14612 flddb. .cmfil,,,,,[ 14613 000601'01 201 01 0 00 002551' flddb. .cmdev,cm%sdh,,,,]] 14614 000602'01 260 17 0 00 000420* call rfield ; Ask them to supply the file 14615 000603'01 135 05 0 00 002440' ldb q1, [pointr (.cmfnp(t3),cm%fnc)] ; Get function code. 14616 000604'01 200 06 0 00 000002 move q2, t2 ; Save parsed data (device or JFN) 14617 14618 000605'01 200 01 0 00 000006 move t1, q2 ; Load parse item for DVCHR% 14619 000606'01 302 05 0 00 000016 caie q1, .cmdev ; Typed a bare device? 14620 000607'01 621 01 0 00 777777 tlz t1, -1 ; Shut off flags so DVCHR% doesn't choke 14621 000610'01 104 00 0 00 000117 DVCHR% ; and find out about it 14622 000611'01 320 12 0 00 000613' %jserr (,r) 14623 000612'01 254 00 0 00 000616' 14624 000613'01 265 01 0 00 000551* 14625 000614'01 000000000000# 14626 000615'01 254 00 0 00 000553* 14627 000267'04 125 156 141 142 154 14628 000616'01 135 07 0 00 002554' ldb q3, [pointr t2, dv%typ] ; Pick up the device type 14629 14630 000617'01 302 05 0 00 000016 caie q1, .cmdev ; Typed a bare device? 14631 000620'01 254 00 0 00 000647' ifskp. ; Yes, see what it is 14632 000621'01 302 07 0 00 000015 caie q3, .dvnul ; NUL:? 14633 000622'01 254 00 0 00 000627' ifskp. ; Yes, we can simulate that 14634 000623'01 260 17 0 00 000445* confrm ; Confirm the selection 14635 000624'01 200 01 0 00 002555' movx t1, ;Use special designator and flags 14636 000625'01 202 01 0 00 000000* movem t1, pars2 ; Store the JFN and (phoney) flags k20mac - Kermit-20 DEFINE macro Implementation MACRO %53B(1254)-4 19:41 30-Mar-24 Page 21-1 K20MAC MAC 30-Jun-23 17:21 Parse the /DUMP switch 14637 000626'01 263 17 0 00 000000 ret ; Done with this special case 14638 000627'01 endif. ; Any other device is NOT VALID 14639 14640 000627'01 302 07 0 00 000000 caie q3, .dvdsk ; Bare device? 14641 000630'01 254 00 0 00 000646' ifskp. ; Yes, but needs a file name 14642 000631'01 200 01 0 00 000000# emsg ; First part of blat 14643 000632'01 104 00 0 00 000313 14644 000041'02 000000000000# 14645 000302'04 124 150 145 040 000 14646 000633'01 200 02 0 00 000006 move t2, q2 ; Load whatever we parsed 14647 000634'01 201 01 0 00 000101 movei t1, .priou ; Output to the terminal 14648 000635'01 104 00 0 00 000121 DEVST% ; Write the device name into the AC's 14649 000636'01 320 12 0 00 000640' %jserr (,cmder1) 14650 000637'01 254 00 0 00 000643' 14651 000640'01 265 01 0 00 000613* 14652 000641'01 000000000000# 14653 000642'01 254 00 0 00 000441* 14654 000303'04 125 156 141 142 154 14655 000643'01 200 01 0 00 000000# sxtext (t1,<: structure needs a file specification>) 14656 000042'02 000000000000# 14657 000314'04 072 040 163 164 162 14658 000644'01 104 00 0 00 000076 PSOUT% ; Finish the informative blat 14659 000645'01 254 00 0 00 000642* jrst cmder1 ; Allow reparse 14660 000646'01 endif. ; Any other device is NOT VALID 14661 14662 000646'01 254 00 0 00 000670' jrst .mdmpe ; Otherwise, handle as a general parse error 14663 000647'01 endif. ; End case .cmdev 14664 14665 remark .cmfil ; Everything else is a file 14666 14667 000647'01 302 07 0 00 000015 caie q3, .dvnul ; A JFN on NUL:?? 14668 000650'01 254 00 0 00 000663' ifskp. ; Yes, we can simulate that 14669 000651'01 260 17 0 00 000623* confrm ; Confirm the selection 14670 000652'01 200 01 0 00 000006 move t1, q2 ; Load parsed JFN 14671 000653'01 260 17 0 00 000000* call isnulj ; Convert it to a special JFN, releasing original 14672 000654'01 334 01 0 00 000000# ermsg% (,cmder1) ; Allow ^H 14673 000655'01 254 00 0 00 000661' 14674 000656'01 202 01 0 00 000000* 14675 000657'01 104 00 0 00 000313 14676 000660'01 254 00 0 00 000645* 14677 000043'02 000000000000# 14678 000324'04 113 105 122 115 111 14679 14680 000661'01 202 01 0 00 000625* movem t1, pars2 ; Store the JFN and original parse flags 14681 000662'01 263 17 0 00 000000 ret ; Done with this second special NUL: case 14682 000663'01 endif. 14683 14684 000663'01 302 07 0 00 000000 caie q3, .dvdsk ; Was this a structure? 14685 000664'01 254 00 0 00 000670' jrst .mdmpe ; No, any other device is NOT VALID 14686 14687 000665'01 260 17 0 00 000651* confrm ; Otherwise, fine; confirm selection 14688 000666'01 202 06 0 00 000661* movem q2, pars2 ; Store the JFN and flags 14689 000667'01 263 17 0 00 000000 ret ; Done with the parse 14690 k20mac - Kermit-20 DEFINE macro Implementation MACRO %53B(1254)-4 19:41 30-Mar-24 Page 22 K20MAC MAC 30-Jun-23 17:21 Parse the /DUMP switch 14691 remark Here for common parse errors 14692 14693 000670'01 200 01 0 00 000000# .mdmpe: emsg ; Begin whining 14694 000671'01 104 00 0 00 000313 14695 000044'02 000000000000# 14696 000336'04 124 150 145 040 000 14697 000672'01 201 01 0 00 000101 movei t1, .priou ; Output to terminal, always 14698 000673'01 302 05 0 00 000016 caie q1, .cmdev ; Device? 14699 000674'01 254 00 0 00 000705' ifskp. ; Yes, use DEVST% 14700 000675'01 200 02 0 00 000006 move t2, q2 ; Load whatever we parsed 14701 000676'01 104 00 0 00 000121 DEVST% ; Write the device name into the AC's 14702 000677'01 320 12 0 00 000701' %jserr (,cmder1) 14703 000700'01 254 00 0 00 000704' 14704 000701'01 265 01 0 00 000640* 14705 000702'01 000000000000# 14706 000703'01 254 00 0 00 000660* 14707 000337'04 125 156 141 142 154 14708 000704'01 254 00 0 00 000715' else. ; Otherwise, DEVST% will choke on the JFN 14709 000705'01 550 02 0 00 000006 hrrz t2, q2 ; Load just the JFN 14710 dmove t3, [ ; Just want the device name, no punctuation 14711 fld(.jsaof,js%dev) 14712 000706'01 120 03 0 00 002556' 0 ] ; No odd prefix, whatever that is 14713 000707'01 104 00 0 00 000030 JFNS% ; Convert to something readable 14714 000710'01 320 12 0 00 000712' %jserr (,cmder1) 14715 000711'01 254 00 0 00 000715' 14716 000712'01 265 01 0 00 000701* 14717 000713'01 000000000000# 14718 000714'01 254 00 0 00 000703* 14719 000347'04 125 156 141 142 154 14720 000715'01 endif. ; Either way, error should be more informative 14721 14722 000715'01 200 01 0 00 000000# txmsg <: device does not have binary dumping capabilities> 14723 000716'01 104 00 0 00 000076 14724 000717'01 320 12 0 00 000720' 14725 000045'02 000000000000# 14726 000361'04 072 040 144 145 166 14727 000720'01 561 01 0 00 000475* hrroi t1, crlf ; Newline 14728 000721'01 104 00 0 00 000076 PSOUT% ; Tie off the blat 14729 000722'01 320 12 0 00 000723' erjmpr .+1 ; Catch and ignore that error, too 14730 14731 000723'01 302 05 0 00 000006 caie q1, .cmfil ; Had we parsed a file, actually? 14732 000724'01 254 00 0 00 000730' ifskp. ; Yes, then have a little clean up to do 14733 000725'01 550 01 0 00 000006 hrrz t1, q2 ; Load our poor JFN, sans flags 14734 000726'01 104 00 0 00 000023 RLJFN% ; Toss it; can't use it 14735 000727'01 320 12 0 00 000714* erjmpr cmder1 ; Ignore error and beat it 14736 000730'01 endif. 14737 14738 000730'01 254 00 0 00 000727* jrst cmder1 ; Allow ^H 14739 k20mac - Kermit-20 DEFINE macro Implementation MACRO %53B(1254)-4 19:41 30-Mar-24 Page 23 K20MAC MAC 30-Jun-23 17:21 Execute the /DUMP switch 14740 subttl Execute the /DUMP switch 14741 14742 000731'01 265 16 0 00 002466' $mdump: saveac ; Wants a few accumulators 14743 14744 000732'01 200 05 0 00 000666* move q1, pars2 ; Load the JFN and flags 14745 000733'01 550 01 0 00 000005 hrrz t1, q1 ; Look at just the JFN 14746 000734'01 306 01 0 00 377777 cain t1, .nulio ; Special cased? 14747 000735'01 254 00 0 00 000745' ifskp. ; No, have to really open the file 14748 000736'01 200 02 0 00 002560' movx t2, 14749 000737'01 104 00 0 00 000021 OPENF% ; Try to create the file 14750 000740'01 320 12 0 00 000742' %jserr (,$mdmpe) 14751 000741'01 254 00 0 00 000745' 14752 000742'01 265 01 0 00 000712* 14753 000743'01 000000000000# 14754 000744'01 254 00 0 00 001060' 14755 000374'04 125 156 141 142 154 14756 000745'01 endif. ; End case file not on NUL: 14757 k20mac - Kermit-20 DEFINE macro Implementation MACRO %53B(1254)-4 19:41 30-Mar-24 Page 24 K20MAC MAC 30-Jun-23 17:21 Set up to dump the macros into binary file 14758 subttl Set up to dump the macros into binary file 14759 14760 ; N.B., Although the mapping direction seems non-intuitive here, 14761 ; what's actually happening is that we are reserving space in the 14762 ; output file to populate as we will. If we don't touch a page, it 14763 ; won't exist in the file, effectively showing up as a 'hole'. 14764 14765 remark PMAP% Case IV: deleting process memory 14766 000745'01 474 01 0 00 000000 seto t1, ; Don't want anything in gc .psect 14767 dmove t2, [ .fhslf,,gcpag ; This process, page number of gc psect 14768 000746'01 120 02 0 00 002561' pm%cnt!fld(gcpgs,pm%rpt) ] ; Number of pages to toss 14769 000747'01 104 00 0 00 000056 PMAP% ; Kick them all into oblivion 14770 000750'01 320 12 0 00 000752' %jserr (,$mdmpe) 14771 000751'01 254 00 0 00 000755' 14772 000752'01 265 01 0 00 000742* 14773 000753'01 000000000000# 14774 000754'01 254 00 0 00 001060' 14775 000404'04 125 156 141 142 154 14776 14777 remark PMAP% Case I: Mapping File Pages to a Process 14778 000755'01 514 01 0 00 000005 hrlz t1, q1 ; 'Input' file, page zero 14779 000756'01 316 01 0 00 002563' camn t1, [.nulio,,0] ; NUL:? 14780 000757'01 254 00 0 00 000767' ifskp. ; No, do the page map for real 14781 dmove t2, [ .fhslf,,gcpag ; This process, page number of gc psect 14782 000760'01 120 02 0 00 002564' pm%wr!pm%cnt!fld(gcpgs,pm%rpt) ] ; Number of pages to reserve 14783 000761'01 104 00 0 00 000056 PMAP% ; And get ready to drop data into them 14784 000762'01 320 12 0 00 000764' %jserr (,$mdmpe) 14785 000763'01 254 00 0 00 000767' 14786 000764'01 265 01 0 00 000752* 14787 000765'01 000000000000# 14788 000766'01 254 00 0 00 001060' 14789 000416'04 125 156 141 142 154 14790 000767'01 endif. ; End setting up a real file 14791 14792 remark ; Set up loop context 14793 remark q1, ; Has JFN and flags 14794 000767'01 201 06 0 00 000007 movx q2, gcpgs ; Load pages in table psect 14795 14796 dmove q3, [ macorg ; Source is the macros .psect 14797 000770'01 120 07 0 00 002566' gcorg ] ; Destination is garbage collection .psect 14798 k20mac - Kermit-20 DEFINE macro Implementation MACRO %53B(1254)-4 19:41 30-Mar-24 Page 25 K20MAC MAC 30-Jun-23 17:21 Loop to map out pages appropriately 14799 subttl Loop to map out pages appropriately 14800 14801 000771'01 do. ; Enter loop context 14802 000771'01 200 01 0 00 000007 move t1, q3 ; Load current macros address 14803 000772'01 242 01 0 00 777767 lsh t1, -^d9 ; Turn into a page number 14804 000773'01 505 01 0 00 400000 hrli t1, .fhslf ; This process 14805 000774'01 104 00 0 00 000057 RPACS% ; Find out what's in there 14806 000775'01 320 12 0 00 000777' ifje. r ; Catch and ignore error 14807 000776'01 254 00 0 00 001000' 14808 000777'01 400 02 0 00 000000 setz t2, ; Assume the page doesn't exist 14809 001000'01 endif. 14810 001000'01 607 02 0 00 010000 ifxn. t2, pa%pex ; Does the page exist? 14811 001001'01 254 00 0 00 001007' 14812 001002'01 607 02 0 00 100000 andxn. t2, pa%rd ; *AND* ... Can we read it? 14813 001003'01 254 00 0 00 001007' 14814 001004'01 201 01 0 00 001000 movei t1, ^d512 ; Yep, load the eternal page size 14815 001005'01 120 02 0 00 000007 dmove t2, q3 ; Load source and destination address 14816 001006'01 123 01 0 00 002501' xblt. t1 ; And put into the macros psect 14817 001007'01 endif. 14818 001007'01 363 06 0 00 001012' sojle q2, endlp. ; Exit when nothing left to do 14819 001010'01 114 07 0 00 002570' dadd q3, [exp ^d512,^d512 ] ; Step to next set of addresses 14820 001011'01 254 00 0 00 000771' loop. 14821 001012'01 enddo. ; Exit loop lexical context 14822 14823 remark ; Loop exit post processing 14824 14825 remark PMAP% Case IV: deleting process memory (but not really) 14826 001012'01 474 01 0 00 000000 seto t1, ; Don't want anything in gc .psect 14827 dmove t2, [ .fhslf,,gcpag ; This process, page number of gc psect 14828 001013'01 120 02 0 00 002561' pm%cnt!fld(gcpgs,pm%rpt) ] ; Number of pages to remove 14829 001014'01 104 00 0 00 000056 PMAP% ; Kick them all over to DDMP 14830 001015'01 320 12 0 00 001017' %jserr (,$mdmpe) 14831 001016'01 254 00 0 00 001022' 14832 001017'01 265 01 0 00 000764* 14833 001020'01 000000000000# 14834 001021'01 254 00 0 00 001060' 14835 000427'04 125 156 141 142 154 14836 k20mac - Kermit-20 DEFINE macro Implementation MACRO %53B(1254)-4 19:41 30-Mar-24 Page 26 K20MAC MAC 30-Jun-23 17:21 Loop to map out pages appropriately 14837 remark Binary file Epilogue 14838 14839 001022'01 550 01 0 00 000005 hrrz t1, q1 ; Load the file JFN 14840 001023'01 306 01 0 00 377777 cain t1, .nulio ; NUL:? 14841 001024'01 254 00 0 00 001054' ifskp. ; No, a real file 14842 001025'01 661 01 0 00 400000 txo t1, co%nrj ; Keep the JFN 14843 001026'01 104 00 0 00 000022 CLOSF% ; Close the file, mostly 14844 001027'01 320 12 0 00 001031' %jsErr (, $mdmpe) 14845 001030'01 254 00 0 00 001034' 14846 001031'01 265 01 0 00 001017* 14847 001032'01 000000000000# 14848 001033'01 254 00 0 00 001060' 14849 000437'04 125 156 141 142 154 14850 001034'01 505 01 0 00 000012 hrli t1, .fbsiz ; Set the number of macros as bytes 14851 001035'01 474 02 0 00 000000 seto t2, ; Changing all the bits in the word 14852 001036'01 554 03 0 00 000000# hlrz t3, mactab ; Load current macro count 14853 001037'01 104 00 0 00 000064 CHFDB% ; Set that for the curious 14854 001040'01 320 12 0 00 001042' %jsErr (,) 14855 001041'01 254 00 0 00 001045' 14856 001042'01 265 01 0 00 001031* 14857 001043'01 000000000000# 14858 001044'01 254 00 0 00 001045' 14859 000446'04 125 156 141 142 154 14860 001045'01 550 01 0 00 000005 hrrz t1, q1 ; Load the JFN one last time 14861 001046'01 104 00 0 00 000023 RLJFN% ; And toss it 14862 001047'01 320 12 0 00 001051' %jsErr (,) 14863 001050'01 254 00 0 00 001054' 14864 001051'01 265 01 0 00 001042* 14865 001052'01 000000000000# 14866 001053'01 254 00 0 00 001054' 14867 000460'04 125 156 141 142 154 14868 001054'01 endif. ; End case not NUL: 14869 14870 001054'01 200 01 0 00 000000# txmsg 14871 001055'01 104 00 0 00 000076 14872 001056'01 320 12 0 00 001057' 14873 000046'02 000000000000# 14874 000471'04 127 162 157 164 145 14875 001057'01 254 00 0 00 002070' callret $msumm ; Give us some summary information 14876 remark ret ; $msumm returns for us 14877 k20mac - Kermit-20 DEFINE macro Implementation MACRO %53B(1254)-4 19:41 30-Mar-24 Page 27 K20MAC MAC 30-Jun-23 17:21 Error handling 14878 subttl Error handling 14879 14880 001060'01 $mdmpe: remark ; Here to handle errors 14881 001060'01 474 01 0 00 000000 seto t1, ; Case IV, deleting process memory 14882 dmove t2, [ .fhslf,,gcpag ; This process, page number of gc psect 14883 001061'01 120 02 0 00 002561' pm%cnt!fld(gcpgs,pm%rpt) ] ; Number of pages to toss 14884 001062'01 104 00 0 00 000056 PMAP% ; Trim our working set 14885 001063'01 320 12 0 00 001065' %jserr (,) 14886 001064'01 254 00 0 00 001070' 14887 001065'01 265 01 0 00 001051* 14888 001066'01 000000000000# 14889 001067'01 254 00 0 00 001070' 14890 000473'04 102 151 156 141 162 14891 14892 001070'01 332 01 0 00 000005 skipe t1, q1 ; Didn't have a JFN? 14893 001071'01 260 17 0 00 000000* call frclos ; We did, go get rid of it 14894 001072'01 600 00 0 00 000000 nop ; Ignore any goofy error 14895 001073'01 263 17 0 00 000000 ret ; Done 14896 k20mac - Kermit-20 DEFINE macro Implementation MACRO %53B(1254)-4 19:41 30-Mar-24 Page 28 K20MAC MAC 30-Jun-23 17:21 Parse the /MAP switch 14897 subttl Parse the /MAP switch 14898 14899 ; Tries for a device first as this is more efficient for NUL: and 14900 ; catches more errors earlier and more easily. 14901 14902 ; Default command filespec fields for .CMFIL: 14903 14904 001074'01 100020 000000 mapbk: gj%flg!gj%old ; Must be existing file. 14905 repeat 4,<0> ; Normal defaults for dev:name. 14906 001075'01 000000 000000 14907 001076'01 000000 000000 14908 001077'01 000000 000000 14909 001100'01 000000 000000 14910 001101'01 000000000000# eascii () ; Default extension is .BIN. 14911 000505'04 102 111 116 000 000 14912 001102'01 000000000000# 0 ; Default protection, 14913 001103'01 000000 000000 0 ; and account. 14914 000010 mapbkl==<.-mapbk> ; Length of this GTJFN argument block. 14915 14916 001104'01 265 16 0 00 002466' .mmap: saveac ; Protect some registers 14917 001105'01 200 01 0 00 002537' movx t1, cz%ncl!.fhslf ; Release non-open JFN's on reparse 14918 001106'01 104 00 0 00 000034 CLZFF% 14919 001107'01 320 12 0 00 001110' erjmpr .+1 ; Catch and ignore errors 14920 001110'01 200 16 0 00 000000# guide 14921 001111'01 260 17 0 00 000576* 14922 000047'02 000000000000# 14923 000506'04 142 151 156 141 162 14924 001112'01 200 01 0 00 002572' move t1, [mapbk,,cjfnbk] ; Insert our file parsing defaults. 14925 001113'01 251 01 0 00 000000# blt t1, cjfnbk+mapbkl 14926 14927 movei t1, [ ; Catch bare device 14928 flddb. .cmfil,,,,,[ 14929 001114'01 201 01 0 00 002602' flddb. .cmdev,cm%sdh,,,,]] 14930 001115'01 260 17 0 00 000602* call rfield ; Ask them to supply the file 14931 001116'01 135 05 0 00 002440' ldb q1, [pointr (.cmfnp(t3),cm%fnc)] ; Get function code. 14932 001117'01 200 06 0 00 000002 move q2, t2 ; Save parsed data (device or JFN) 14933 14934 001120'01 200 01 0 00 000006 move t1, q2 ; Load parse item for DVCHR% 14935 001121'01 302 05 0 00 000016 caie q1, .cmdev ; Typed a bare device? 14936 001122'01 621 01 0 00 777777 tlz t1, -1 ; Shut off flags so DVCHR% doesn't choke 14937 001123'01 104 00 0 00 000117 DVCHR% ; and find out about it 14938 001124'01 320 12 0 00 001126' %jserr (,r) 14939 001125'01 254 00 0 00 001131' 14940 001126'01 265 01 0 00 001065* 14941 001127'01 000000000000# 14942 001130'01 254 00 0 00 000615* 14943 000512'04 125 156 141 142 154 14944 001131'01 135 07 0 00 002554' ldb q3, [pointr t2, dv%typ] ; Pick up the device type 14945 14946 001132'01 302 05 0 00 000016 caie q1, .cmdev ; Typed a bare device? 14947 001133'01 254 00 0 00 001162' ifskp. ; Yes, see what it is 14948 001134'01 302 07 0 00 000015 caie q3, .dvnul ; NUL:? 14949 001135'01 254 00 0 00 001142' ifskp. ; Yes, we can simulate that 14950 001136'01 260 17 0 00 000665* confrm ; Confirm the selection 14951 001137'01 200 01 0 00 002555' movx t1, ;Use special designator and flags k20mac - Kermit-20 DEFINE macro Implementation MACRO %53B(1254)-4 19:41 30-Mar-24 Page 28-1 K20MAC MAC 30-Jun-23 17:21 Parse the /MAP switch 14952 001140'01 202 01 0 00 000732* movem t1, pars2 ; Store the JFN and (phoney) flags 14953 001141'01 263 17 0 00 000000 ret ; Done with this special case 14954 001142'01 endif. ; Any other device is NOT VALID 14955 14956 001142'01 302 07 0 00 000000 caie q3, .dvdsk ; Bare device? 14957 001143'01 254 00 0 00 001161' ifskp. ; Yes, but needs a file name 14958 001144'01 200 01 0 00 000000# emsg ; First part of blat 14959 001145'01 104 00 0 00 000313 14960 000050'02 000000000000# 14961 000525'04 124 150 145 040 000 14962 001146'01 200 02 0 00 000006 move t2, q2 ; Load whatever we parsed 14963 001147'01 201 01 0 00 000101 movei t1, .priou ; Output to terminal 14964 001150'01 104 00 0 00 000121 DEVST% ; Write the device name into the AC's 14965 001151'01 320 12 0 00 001153' %jserr (,cmder1) 14966 001152'01 254 00 0 00 001156' 14967 001153'01 265 01 0 00 001126* 14968 001154'01 000000000000# 14969 001155'01 254 00 0 00 000730* 14970 000526'04 125 156 141 142 154 14971 001156'01 200 01 0 00 000000# emsg <: structure needs a file specification> 14972 001157'01 104 00 0 00 000313 14973 000051'02 000000000000# 14974 000537'04 072 040 163 164 162 14975 001160'01 254 00 0 00 001155* jrst cmder1 ; Allow reparse 14976 001161'01 endif. ; Any other device is NOT VALID 14977 14978 001161'01 254 00 0 00 001203' jrst .mmape ; Handle as a general parse error 14979 001162'01 endif. ; End case .cmdev 14980 14981 remark .cmfil ; Everything else is a file 14982 14983 001162'01 302 07 0 00 000015 caie q3, .dvnul ; A JFN on NUL:?? 14984 001163'01 254 00 0 00 001176' ifskp. ; Yes, we can simulate that 14985 001164'01 260 17 0 00 001136* confrm ; Confirm the selection 14986 001165'01 200 01 0 00 000006 move t1, q2 ; Load parsed JFN 14987 001166'01 260 17 0 00 000653* call isnulj ; Convert it to a special JFN, releasing original 14988 001167'01 334 01 0 00 000000# ermsg% (,cmder1) ; Allow ^H 14989 001170'01 254 00 0 00 001174' 14990 001171'01 202 01 0 00 000656* 14991 001172'01 104 00 0 00 000313 14992 001173'01 254 00 0 00 001160* 14993 000052'02 000000000000# 14994 000547'04 113 105 122 115 111 14995 14996 001174'01 202 01 0 00 001140* movem t1, pars2 ; Store the JFN and original parse flags 14997 001175'01 263 17 0 00 000000 ret ; Done with this second special NUL: case 14998 001176'01 endif. 14999 15000 001176'01 302 07 0 00 000000 caie q3, .dvdsk ; Was this a structure? 15001 001177'01 254 00 0 00 001203' jrst .mmape ; No, any other device is NOT VALID 15002 15003 001200'01 260 17 0 00 001164* confrm ; Otherwise, fine; confirm selection 15004 001201'01 202 06 0 00 001174* movem q2, pars2 ; Store the JFN and flags 15005 001202'01 263 17 0 00 000000 ret ; Done with the parse 15006 k20mac - Kermit-20 DEFINE macro Implementation MACRO %53B(1254)-4 19:41 30-Mar-24 Page 29 K20MAC MAC 30-Jun-23 17:21 Parse the /MAP switch 15007 remark Here for common parse errors 15008 15009 001203'01 200 01 0 00 000000# .mmape: emsg ; Begin whining 15010 001204'01 104 00 0 00 000313 15011 000053'02 000000000000# 15012 000561'04 124 150 145 040 000 15013 15014 001205'01 201 01 0 00 000101 movei t1, .priou ; Output to terminal, always 15015 001206'01 302 05 0 00 000016 caie q1, .cmdev ; Device? 15016 001207'01 254 00 0 00 001220' ifskp. ; Yes, use DEVST% 15017 001210'01 200 02 0 00 000006 move t2, q2 ; Load whatever we parsed 15018 001211'01 104 00 0 00 000121 DEVST% ; Write the device name into the AC's 15019 001212'01 320 12 0 00 001214' %jserr (,cmder1) 15020 001213'01 254 00 0 00 001217' 15021 001214'01 265 01 0 00 001153* 15022 001215'01 000000000000# 15023 001216'01 254 00 0 00 001173* 15024 000562'04 125 156 141 142 154 15025 001217'01 254 00 0 00 001230' else. ; Otherwise, DEVST% will choke on the JFN 15026 001220'01 550 02 0 00 000006 hrrz t2, q2 ; Load just the JFN 15027 dmove t3, [ ; Just want the device name, no punctuation 15028 fld(.jsaof,js%dev) 15029 001221'01 120 03 0 00 002556' 0 ] ; No odd prefix, whatever that is 15030 001222'01 104 00 0 00 000030 JFNS% ; Convert to something readable 15031 001223'01 320 12 0 00 001225' %jserr (,cmder1) 15032 001224'01 254 00 0 00 001230' 15033 001225'01 265 01 0 00 001214* 15034 001226'01 000000000000# 15035 001227'01 254 00 0 00 001216* 15036 000572'04 125 156 141 142 154 15037 001230'01 endif. ; Either way, error should be more informative 15038 15039 001230'01 200 01 0 00 000000# txmsg <: device does not have binary mapping capabilities> 15040 001231'01 104 00 0 00 000076 15041 001232'01 320 12 0 00 001233' 15042 000054'02 000000000000# 15043 000604'04 072 040 144 145 166 15044 001233'01 561 01 0 00 000720* hrroi t1, crlf ; Newline 15045 001234'01 104 00 0 00 000076 PSOUT% ; Tie off the blat 15046 001235'01 320 12 0 00 001236' erjmpr .+1 ; Catch and ignore that error, too 15047 15048 001236'01 302 05 0 00 000006 caie q1, .cmfil ; Had we parsed a file, actually? 15049 001237'01 254 00 0 00 001243' ifskp. ; Yes, then have a little clean up to do 15050 001240'01 550 01 0 00 000006 hrrz t1, q2 ; Load our poor JFN, sans flags 15051 001241'01 104 00 0 00 000023 RLJFN% ; Toss it; can't use it 15052 001242'01 320 12 0 00 001227* erjmpr cmder1 ; Ignore error and beat it 15053 001243'01 endif. 15054 15055 001243'01 254 00 0 00 001242* jrst cmder1 ; Allow ^H 15056 k20mac - Kermit-20 DEFINE macro Implementation MACRO %53B(1254)-4 19:41 30-Mar-24 Page 30 K20MAC MAC 30-Jun-23 17:21 Execute the /MAP switch 15057 subttl Execute the /MAP switch 15058 15059 001244'01 265 16 0 00 002466' $mmap: saveac ; Wants a few accumulators 15060 001245'01 403 05 0 00 000006 setzb q1, q2 ; Zero local JFN and input file size (pages) 15061 15062 001246'01 200 05 0 00 001201* move q1, pars2 ; Load the JFN and flags 15063 001247'01 550 01 0 00 000005 hrrz t1, q1 ; Look at just the JFN 15064 001250'01 306 01 0 00 377777 cain t1, .nulio ; Special cased? 15065 001251'01 254 00 0 00 001405' jrst $mmapn ; Yes, go do it 15066 k20mac - Kermit-20 DEFINE macro Implementation MACRO %53B(1254)-4 19:41 30-Mar-24 Page 31 K20MAC MAC 30-Jun-23 17:21 Set up and check to map a real binary file 15067 subttl Set up and check to map a real binary file 15068 15069 001252'01 104 00 0 00 000036 SIZEF% ; Find out about the file 15070 001253'01 320 12 0 00 001255' %jserr (,r) ; Go no further 15071 001254'01 254 00 0 00 001260' 15072 001255'01 265 01 0 00 001225* 15073 001256'01 000000000000# 15074 001257'01 254 00 0 00 001130* 15075 000617'04 102 151 156 141 162 15076 001260'01 322 02 0 00 001405' jumpe t2, $mmapn ; No macros written? Assume empty, then 15077 001261'01 322 03 0 00 001405' jumpe t3, $mmapn ; Empty file? Treat as NUL: case 15078 15079 001262'01 303 02 0 00 000252 caile t2, macmax ; Too many macros? 15080 001263'01 334 00 0 00 000000 %ermsg (,$mmape) 15081 001264'01 254 00 0 00 001270' 15082 001265'01 265 01 0 00 001255* 15083 001266'01 000000000000# 15084 001267'01 254 00 0 00 001401' 15085 000630'04 124 157 157 040 155 15086 001270'01 303 03 0 00 000007 caile t3, macpgs ; Too large? 15087 001271'01 334 00 0 00 000000 %ermsg (,$mmape) 15088 001272'01 254 00 0 00 001276' 15089 001273'01 265 01 0 00 001265* 15090 001274'01 000000000000# 15091 001275'01 254 00 0 00 001401' 15092 000641'04 102 151 156 141 162 15093 001276'01 200 06 0 00 000003 move q2, t3 ; Save binary file size (in pages) 15094 ; Read-Only, force open even if PMAP%'ed 15095 001277'01 200 02 0 00 002605' movx t2, 15096 001300'01 104 00 0 00 000021 OPENF% ; Try to open the file 15097 001301'01 320 12 0 00 001303' %jserr (,$mmape) 15098 001302'01 254 00 0 00 001306' 15099 001303'01 265 01 0 00 001273* 15100 001304'01 000000000000# 15101 001305'01 254 00 0 00 001401' 15102 000650'04 125 156 141 142 154 15103 15104 remark PMAP% Case IV, deleting process memory 15105 001306'01 474 01 0 00 000000 seto t1, ; Don't want anything in gc .psect 15106 dmove t2, [ .fhslf,,gcpag ; This process, page number of gc psect 15107 001307'01 120 02 0 00 002561' pm%cnt!fld(gcpgs,pm%rpt) ] ; Number of pages to toss 15108 001310'01 104 00 0 00 000056 PMAP% ; Kick them all into oblivion 15109 001311'01 320 12 0 00 001313' %jserr (,$mmape) 15110 001312'01 254 00 0 00 001316' 15111 001313'01 265 01 0 00 001303* 15112 001314'01 000000000000# 15113 001315'01 254 00 0 00 001401' 15114 000660'04 125 156 141 142 154 15115 15116 remark PMAP% Case IV, deleting process memory 15117 001316'01 474 01 0 00 000000 seto t1, ; Don't want anything in macros .psect 15118 dmove t2, [ .fhslf,,macpag ; This process, page number of macros psect 15119 001317'01 120 02 0 00 002606' pm%cnt!fld(macpgs,pm%rpt) ] ; Number of pages to toss 15120 001320'01 104 00 0 00 000056 PMAP% ; Kick them all into oblivion 15121 001321'01 320 12 0 00 001323' %jserr (,$mmapi) k20mac - Kermit-20 DEFINE macro Implementation MACRO %53B(1254)-4 19:41 30-Mar-24 Page 31-1 K20MAC MAC 30-Jun-23 17:21 Set up and check to map a real binary file 15122 001322'01 254 00 0 00 001326' 15123 001323'01 265 01 0 00 001313* 15124 001324'01 000000000000# 15125 001325'01 254 00 0 00 001410' 15126 000671'04 125 156 141 142 154 15127 15128 remark PMAP% Case I: Mapping File Pages to a Process 15129 001326'01 514 01 0 00 000005 hrlz t1, q1 ; File JFN, starting from page zero 15130 001327'01 200 02 0 00 002561' movx t2, <.fhslf,, gcpag> ; Put them into the *garbage collection* area 15131 001330'01 200 03 0 00 000006 move t3, q2 ; Get page count 15132 001331'01 302 03 0 00 000001 caie t3, ^d1 ; Only a single page? 15133 001332'01 661 03 0 00 400000 txo t3, pm%cnt ; No, turn on repeat (slower, even for 1 page) 15134 001333'01 661 03 0 00 110000 txo t3, pm%rd!pm%pld ; Get them all in fast 15135 001334'01 104 00 0 00 000056 PMAP% ; And do the I/O 15136 001335'01 320 12 0 00 001337' %jserr (,$mmapi) 15137 001336'01 254 00 0 00 001342' 15138 001337'01 265 01 0 00 001323* 15139 001340'01 000000000000# 15140 001341'01 254 00 0 00 001410' 15141 000704'04 125 156 141 142 154 15142 k20mac - Kermit-20 DEFINE macro Implementation MACRO %53B(1254)-4 19:41 30-Mar-24 Page 32 K20MAC MAC 30-Jun-23 17:21 Loop to copy pages appropriately 15143 subttl Loop to copy pages appropriately 15144 15145 ; Do we have to check the file page if there's nothing there or the memory? 15146 15147 001342'01 200 04 0 00 000006 move t4, q2 ; Load size as a count 15148 dmove q3, [ gcorg ; Source is garbage collection .psect 15149 001343'01 120 07 0 00 002610' macorg ] ; Destination is the macros .psect 15150 15151 001344'01 do. ; Enter loop context 15152 001344'01 200 01 0 00 000007 move t1, q3 ; Load current gc address 15153 001345'01 242 01 0 00 777767 lsh t1, -^d9 ; Turn into a page number 15154 001346'01 505 01 0 00 400000 hrli t1, .fhslf ; This process 15155 001347'01 104 00 0 00 000057 RPACS% ; Find out what's in there 15156 001350'01 320 12 0 00 001352' ifje. r ; Catch and ignore error 15157 001351'01 254 00 0 00 001353' 15158 001352'01 400 02 0 00 000000 setz t2, ; Assume the page doesn't exist 15159 001353'01 endif. 15160 001353'01 607 02 0 00 010000 ifxn. t2, pa%pex ; Does the page exist? 15161 001354'01 254 00 0 00 001362' 15162 001355'01 607 02 0 00 100000 andxn. t2, pa%rd ; *AND* ... Can we read it? 15163 001356'01 254 00 0 00 001362' 15164 001357'01 201 01 0 00 001000 movei t1, ^d512 ; Yep, load the eternal page size 15165 001360'01 120 02 0 00 000007 dmove t2, q3 ; Load source and destination address 15166 001361'01 123 01 0 00 002501' xblt. t1 ; And put into the macros psect 15167 001362'01 endif. 15168 001362'01 363 04 0 00 001365' sojle t4, endlp. ; Exit when nothing left to do 15169 001363'01 114 07 0 00 002570' dadd q3, [exp ^d512,^d512 ] ; Step to next set of addresses 15170 001364'01 254 00 0 00 001344' loop. ; And go around again 15171 001365'01 enddo. ; Exit loop lexical context 15172 k20mac - Kermit-20 DEFINE macro Implementation MACRO %53B(1254)-4 19:41 30-Mar-24 Page 33 K20MAC MAC 30-Jun-23 17:21 Loop to copy pages appropriately 15173 remark Binary input file Epilogue 15174 15175 remark Toss the file pages we mapped into the garbage collector 15176 dmove t1, [ -1 ; Case IV, deleting process memory 15177 001365'01 120 01 0 00 002612' .fhslf,,gcpag ] ; This process, page number of gc psect 15178 001366'01 200 03 0 00 000006 move t3, q2 ; Get page count 15179 001367'01 302 03 0 00 000001 caie t3, ^d1 ; Only a single page? 15180 001370'01 661 03 0 00 400000 txo t3, pm%cnt ; No, turn on repeat (slower, even for 1 page) 15181 001371'01 104 00 0 00 000056 PMAP% ; Get rid of them so we can close the file 15182 001372'01 320 12 0 00 001374' %jserr (,) ; Odd... but carry on 15183 001373'01 254 00 0 00 001377' 15184 001374'01 265 01 0 00 001337* 15185 001375'01 000000000000# 15186 001376'01 254 00 0 00 001377' 15187 000716'04 102 151 156 141 162 15188 001377'01 336 00 0 00 000000* skipn iniflg## ;[237] Don't blat if starting up 15189 001400'01 260 17 0 00 002070' call $msumm ; Give us some summary information 15190 15191 remark $mmape ; Falls through to close the JFN 15192 k20mac - Kermit-20 DEFINE macro Implementation MACRO %53B(1254)-4 19:41 30-Mar-24 Page 34 K20MAC MAC 30-Jun-23 17:21 Error handling, NUL: mapping special case and Initialization 15193 subttl Error handling, NUL: mapping special case and Initialization 15194 15195 001401'01 $mmape: remark ; Here if some other error 15196 001401'01 332 01 0 00 000005 skipe t1, q1 ; Didn't have a JFN? 15197 001402'01 260 17 0 00 001071* call frclos ; We did, go get rid of it 15198 001403'01 600 00 0 00 000000 nop ; Ignore any goofy error 15199 001404'01 263 17 0 00 000000 ret ; But leave the current macro table alone 15200 15201 001405'01 260 17 0 00 001410' $mmapn: call $mmapi ; Whack everything (types summary) 15202 001406'01 260 17 0 00 001401' call $mmape ; Toss any JFN's 15203 001407'01 263 17 0 00 000000 ret ; That was easy enough 15204 15205 001410'01 $mmapi: remark ; Here to initialize for mapping 15206 001410'01 260 17 0 00 001424' call $mrese ; Whack the macros .psect 15207 remark ; Toss anything in garbage collector 15208 001411'01 474 01 0 00 000000 seto t1, ; Case IV, deleting process memory 15209 dmove t2, [ .fhslf,,gcpag ; This process, page number of gc psect 15210 001412'01 120 02 0 00 002561' pm%cnt!fld(gcpgs,pm%rpt) ] ; Number of pages to toss 15211 001413'01 104 00 0 00 000056 PMAP% ; Trim our working set 15212 001414'01 320 12 0 00 001416' %jserr (,) ; Odd... but continue 15213 001415'01 254 00 0 00 001421' 15214 001416'01 265 01 0 00 001374* 15215 001417'01 000000000000# 15216 001420'01 254 00 0 00 001421' 15217 000725'04 102 151 156 141 162 15218 001421'01 263 17 0 00 000000 ret ; Done 15219 k20mac - Kermit-20 DEFINE macro Implementation MACRO %53B(1254)-4 19:41 30-Mar-24 Page 35 K20MAC MAC 30-Jun-23 17:21 Here to whack all the macros 15220 subttl Here to whack all the macros 15221 15222 remark parse the rest of /RESET 15223 15224 001422'01 260 17 0 00 001200* .mrese: confrm ; Just confirm 15225 001423'01 263 17 0 00 000000 ret ; Then return so we can get on with it 15226 15227 k20mac - Kermit-20 DEFINE macro Implementation MACRO %53B(1254)-4 19:41 30-Mar-24 Page 36 K20MAC MAC 30-Jun-23 17:21 Execute the /RESET 15228 subttl Execute the /RESET 15229 15230 001424'01 474 01 0 00 000000 $mrese: seto t1, ; Case IV, deleting process memory 15231 dmove t2, [ .fhslf,,macpag ; This process, page number of macros psect 15232 001425'01 120 02 0 00 002606' pm%cnt!fld(macpgs,pm%rpt) ] ; Number of pages to toss 15233 001426'01 104 00 0 00 000056 PMAP% ; Kick them all into oblivion 15234 001427'01 320 12 0 00 001431' ifje. r ; Failed?? 15235 001430'01 254 00 0 00 001444' 15236 001431'01 200 04 0 00 000001 move t4, t1 ; Save the error code 15237 001432'01 201 01 0 00 006777 movx t1, maclen-1 ; Whack the buffer the old fashioned way 15238 001433'01 402 00 0 00 011000 setzm macorg ; Stomp the first location to zero 15239 dmove t2, [ macorg ; Then transfering the first word 15240 001434'01 120 02 0 00 002614' macorg+1 ] ;To the second 15241 001435'01 123 01 0 00 002501' xblt. t1 ; It's turtles all the way down! 15242 001436'01 600 00 0 00 000000 nop ; Ignore the error, we're trying hard enough 15243 001437'01 334 00 0 00 000000 %ermsg (,) 15244 001440'01 254 00 0 00 001444' 15245 001441'01 265 01 0 00 001416* 15246 001442'01 000000000000# 15247 001443'01 254 00 0 00 001444' 15248 000737'04 103 157 165 154 144 15249 001444'01 endif. ; Not promising, but carry on 15250 15251 001444'01 402 00 0 00 000000# setzm onamp ; No previous pointer 15252 dmove t1, [ 0,,MACMAX ; TBLUK% table has no entries now 15253 001445'01 120 01 0 00 002616' 0 ] ; Stomp the 2nd location, just in case 15254 001446'01 124 01 0 00 000000# dmovem t1, mactab ; Now have an empty table 15255 001447'01 200 01 0 00 002620' move t1,[point 7, macbuf] ; Point to beginning of macro storage 15256 001450'01 202 01 0 00 000000# movem t1, macbp ; Stomp into the new table 15257 emacro < 15258 remark ; Toss anything in the macro editor 15259 seto t1, ; Case IV, deleting process memory 15260 dmove t2, [ .fhslf,,medpg ; This process, page number of medit psect 15261 pm%cnt!fld(edpgs,pm%rpt) ] ; Number of pages to toss 15262 PMAP% ; Trim our working set 15263 %jserr (,) ; Odd... but continue 15264 >;; emacro 15265 remark $msumm ; They can do a /summary 15266 ; if they want to know 15267 001451'01 263 17 0 00 000000 ret 15268 k20mac - Kermit-20 DEFINE macro Implementation MACRO %53B(1254)-4 19:41 30-Mar-24 Page 37 K20MAC MAC 30-Jun-23 17:21 Parse the /SAVE switch 15269 subttl Parse the /SAVE switch 15270 15271 ; Tries for a device first as this is more efficient for NUL: and 15272 ; catches more errors earlier and more easily. 15273 15274 ; Default command filespec fields for .CMFIL: 15275 15276 001452'01 600020 777777 savbk: gj%flg!gj%fou!gj%new!fld(.gjnhg,.rhalf) ; .GJGEN 15277 001453'01 000100 000101 .priin,,.priou ; .GJSRC (ignored if COMND%) 15278 001454'01 000000 000000 0 ; .GJDEV (do not default the device) 15279 001455'01 000000 000000 0 ; .GJDIR (do not default the directory) 15280 001456'01 000000 000000 0 ; .GJNAM (do not default the name) 15281 001457'01 000000000000# eascii () ; .GJEXT (default extension is .CMD) 15282 000750'04 103 115 104 000 000 15283 001460'01 000000000000# 0 ; .GJPRO (use system default protection) 15284 001461'01 000000 000000 0 ; .GJACT (use job's current account) 15285 000010 savbkl==<.-savbk> ; Length of this GTJFN argument block. 15286 15287 001462'01 265 16 0 00 002466' .msave: saveac ; Protect some registers 15288 001463'01 200 01 0 00 002537' movx t1, cz%ncl!.fhslf ; Release non-open JFN's on reparse 15289 001464'01 104 00 0 00 000034 CLZFF% 15290 001465'01 320 12 0 00 001466' erjmpr .+1 ; Catch and ignore errors 15291 001466'01 200 16 0 00 000000# guide 15292 001467'01 260 17 0 00 001111* 15293 000055'02 000000000000# 15294 000751'04 155 141 143 162 157 15295 001470'01 200 01 0 00 002621' move t1, [savbk,,cjfnbk] ; Insert our file parsing defaults. 15296 001471'01 251 01 0 00 000000# blt t1, cjfnbk+savbkl 15297 15298 movei t1, [ ; Catch bare device 15299 flddb. .cmfil,,,,,[ 15300 001472'01 201 01 0 00 002627' flddb. .cmdev,cm%sdh,,,,]] 15301 001473'01 260 17 0 00 001115* call rfield ; Ask them to supply the file 15302 001474'01 135 05 0 00 002440' ldb q1, [pointr (.cmfnp(t3),cm%fnc)] ; Get function code. 15303 001475'01 200 06 0 00 000002 move q2, t2 ; Save parsed data (device or JFN) 15304 15305 001476'01 200 01 0 00 000006 move t1, q2 ; Load parse item for DVCHR% 15306 001477'01 302 05 0 00 000016 caie q1, .cmdev ; Typed a bare device? 15307 001500'01 621 01 0 00 777777 tlz t1, -1 ; Shut off flags so DVCHR% doesn't choke 15308 001501'01 104 00 0 00 000117 DVCHR% ; and find out about it 15309 001502'01 320 12 0 00 001504' %jserr (,r) 15310 001503'01 254 00 0 00 001507' 15311 001504'01 265 01 0 00 001441* 15312 001505'01 000000000000# 15313 001506'01 254 00 0 00 001257* 15314 000756'04 125 156 141 142 154 15315 001507'01 200 10 0 00 000001 move q4, t1 ; Store the device designator 15316 001510'01 135 07 0 00 002554' ldb q3, [pointr t2, dv%typ] ; Pick up the device type 15317 15318 001511'01 302 05 0 00 000016 caie q1, .cmdev ; Typed a bare device? 15319 001512'01 254 00 0 00 001567' ifskp. ; Yes, see what it is 15320 001513'01 302 07 0 00 000012 caie q3, .dvtty ; A terminal? 15321 001514'01 254 00 0 00 001542' ifskp. ; Yes, maybe show the user what we'd write 15322 001515'01 550 01 0 00 000010 hrrz t1, q4 ; Load the terminal number 15323 001516'01 316 01 0 00 000000* camn t1, mytty ; Not mine? k20mac - Kermit-20 DEFINE macro Implementation MACRO %53B(1254)-4 19:41 30-Mar-24 Page 37-1 K20MAC MAC 30-Jun-23 17:21 Parse the /SAVE switch 15324 001517'01 254 00 0 00 001536' ifskp. ; Nope, disallow it 15325 001520'01 200 01 0 00 000000# emsg 15326 001521'01 104 00 0 00 000313 15327 000056'02 000000000000# 15328 000771'04 131 157 165 040 141 15329 001522'01 201 01 0 00 000101 movei t1, .priou ; Text is coming out on the terminal 15330 001523'01 200 02 0 00 000006 move t2, q2 ; Load the device designator 15331 001524'01 104 00 0 00 000121 DEVST% ; Convert device to string 15332 001525'01 320 12 0 00 001527' %jserr (,r) 15333 001526'01 254 00 0 00 001532' 15334 001527'01 265 01 0 00 001504* 15335 001530'01 000000000000# 15336 001531'01 254 00 0 00 001506* 15337 000776'04 125 156 141 142 154 15338 001532'01 200 01 0 00 000000# txmsg <:> 15339 001533'01 104 00 0 00 000076 15340 001534'01 320 12 0 00 001535' 15341 000057'02 000000000000# 15342 001007'04 072 000 000 000 000 15343 001535'01 254 00 0 00 001243* jrst cmder1 ; Allow ^H 15344 001536'01 endif. 15345 001536'01 260 17 0 00 001422* confrm ; Confirm the selection 15346 001537'01 200 01 0 00 002632' movx t1, ;Use special designator and flags 15347 001540'01 202 01 0 00 001246* movem t1, pars2 ; Store the JFN and (phoney) flags 15348 001541'01 263 17 0 00 000000 ret ; Done with this special case 15349 001542'01 endif. ; Any other device is NOT VALID 15350 15351 001542'01 302 07 0 00 000015 caie q3, .dvnul ; NUL:? 15352 001543'01 254 00 0 00 001550' ifskp. ; Yes, we can simulate that 15353 001544'01 260 17 0 00 001536* confrm ; Confirm the selection 15354 001545'01 200 01 0 00 002555' movx t1, ;Use special designator and flags 15355 001546'01 202 01 0 00 001540* movem t1, pars2 ; Store the JFN and (phoney) flags 15356 001547'01 263 17 0 00 000000 ret ; Done with this special case 15357 001550'01 endif. ; Any other device is NOT VALID 15358 15359 001550'01 302 07 0 00 000000 caie q3, .dvdsk ; Bare device? 15360 001551'01 254 00 0 00 001566' ifskp. ; Yes, but needs a file name 15361 001552'01 200 01 0 00 000000# emsg ; First part of blat 15362 001553'01 104 00 0 00 000313 15363 000060'02 000000000000# 15364 001010'04 124 150 145 040 000 15365 001554'01 200 02 0 00 000006 move t2, q2 ; Load whatever we parsed 15366 001555'01 201 01 0 00 000101 movei t1, .priou ; Output to the terminal 15367 001556'01 104 00 0 00 000121 DEVST% ; Write the device name into the AC's 15368 001557'01 320 12 0 00 001561' %jserr (,cmder1) 15369 001560'01 254 00 0 00 001564' 15370 001561'01 265 01 0 00 001527* 15371 001562'01 000000000000# 15372 001563'01 254 00 0 00 001535* 15373 001011'04 125 156 141 142 154 15374 001564'01 200 01 0 00 000000# sxtext (t1,<: structure needs a file specification>) 15375 000061'02 000000000000# 15376 001022'04 072 040 163 164 162 15377 001565'01 254 00 0 00 001563* jrst cmder1 ; Allow reparse 15378 001566'01 endif. ; Any other device is NOT VALID k20mac - Kermit-20 DEFINE macro Implementation MACRO %53B(1254)-4 19:41 30-Mar-24 Page 37-2 K20MAC MAC 30-Jun-23 17:21 Parse the /SAVE switch 15379 15380 001566'01 254 00 0 00 001647' jrst .msve ; Otherwise, handle as a general parse error 15381 001567'01 endif. ; End case .cmdev 15382 15383 remark .cmfil ; Everything else is a file 15384 15385 001567'01 302 07 0 00 000012 caie q3, .dvtty ; A JFN on a terminal? 15386 001570'01 254 00 0 00 001626' ifskp. ; Yes, maybe show the user what we'd write 15387 001571'01 550 01 0 00 000010 hrrz t1, q4 ; Load the terminal number 15388 001572'01 312 01 0 00 001516* came t1, mytty ; Mine? 15389 001573'01 254 00 0 00 001600' ifskp. ; Yep 15390 001574'01 550 01 0 00 000006 hrrz t1, q2 ; Load the JFN 15391 001575'01 104 00 0 00 000023 RLJFN% ; Punt it, we won't be using it 15392 001576'01 320 12 0 00 001577' erjmpr .+1 ; Just strange... 15393 001577'01 254 00 0 00 001622' else. ; Nope, disallow it 15394 001600'01 200 01 0 00 000000# emsg 15395 001601'01 104 00 0 00 000313 15396 000062'02 000000000000# 15397 001032'04 131 157 165 040 141 15398 001602'01 201 01 0 00 000101 movei t1, .priou ; Text is coming out on the terminal 15399 001603'01 550 02 0 00 000006 hrrz t2, q2 ; Load just the JFN 15400 dmove t3, [ ; DEVST% will choke on a JFN... 15401 fld(.jsaof,js%dev) ;Just want the device name, no punctuation 15402 001604'01 120 03 0 00 002556' 0 ] ; No odd prefix, whatever that is 15403 001605'01 104 00 0 00 000030 JFNS% ; Convert to something readable 15404 001606'01 320 12 0 00 001610' %jserr (,cmder1) 15405 001607'01 254 00 0 00 001613' 15406 001610'01 265 01 0 00 001561* 15407 001611'01 000000000000# 15408 001612'01 254 00 0 00 001565* 15409 001037'04 125 156 141 142 154 15410 001613'01 200 01 0 00 000000# txmsg <:> 15411 001614'01 104 00 0 00 000076 15412 001615'01 320 12 0 00 001616' 15413 000063'02 000000000000# 15414 001051'04 072 000 000 000 000 15415 001616'01 550 01 0 00 000006 hrrz t1, q2 ; Load the JFN 15416 001617'01 104 00 0 00 000023 RLJFN% ; Chuck it, we can't use it 15417 001620'01 320 12 0 00 001621' erjmpr .+1 ; Just strange... 15418 001621'01 254 00 0 00 001612* jrst cmder1 ; Allow ^H 15419 001622'01 endif. 15420 15421 001622'01 260 17 0 00 001544* confrm ; Confirm the selection 15422 001623'01 200 01 0 00 002632' movx t1, ;Use special designator and flags 15423 001624'01 202 01 0 00 001546* movem t1, pars2 ; Store the JFN and (phoney) flags 15424 001625'01 263 17 0 00 000000 ret ; Done with this special case 15425 001626'01 endif. ; Any other terminal is NOT valid 15426 15427 001626'01 302 07 0 00 000015 caie q3, .dvnul ; A JFN on NUL:?? 15428 001627'01 254 00 0 00 001642' ifskp. ; Yes, we can simulate that 15429 001630'01 260 17 0 00 001622* confrm ; Confirm the selection 15430 001631'01 200 01 0 00 000006 move t1, q2 ; Load parsed JFN 15431 001632'01 260 17 0 00 001166* call isnulj ; Convert it to a special JFN, releasing original 15432 001633'01 334 01 0 00 000000# ermsg% (,cmder1) ; Allow ^H 15433 001634'01 254 00 0 00 001640' k20mac - Kermit-20 DEFINE macro Implementation MACRO %53B(1254)-4 19:41 30-Mar-24 Page 37-3 K20MAC MAC 30-Jun-23 17:21 Parse the /SAVE switch 15434 001635'01 202 01 0 00 001171* 15435 001636'01 104 00 0 00 000313 15436 001637'01 254 00 0 00 001621* 15437 000064'02 000000000000# 15438 001052'04 113 105 122 115 111 15439 15440 001640'01 202 01 0 00 001624* movem t1, pars2 ; Store the JFN and original parse flags 15441 001641'01 263 17 0 00 000000 ret ; Done with this second special NUL: case 15442 001642'01 endif. 15443 15444 001642'01 302 07 0 00 000000 caie q3, .dvdsk ; Was this a structure? 15445 001643'01 254 00 0 00 001647' jrst .msve ; No, any other device is NOT VALID 15446 15447 001644'01 260 17 0 00 001630* confrm ; Otherwise, fine; confirm selection 15448 001645'01 202 06 0 00 001640* movem q2, pars2 ; Store the JFN and flags 15449 001646'01 263 17 0 00 000000 ret ; Done with the parse 15450 k20mac - Kermit-20 DEFINE macro Implementation MACRO %53B(1254)-4 19:41 30-Mar-24 Page 38 K20MAC MAC 30-Jun-23 17:21 Parse the /SAVE switch 15451 remark Here for common parse errors 15452 15453 001647'01 200 01 0 00 000000# .msve: emsg ; Begin whining 15454 001650'01 104 00 0 00 000313 15455 000065'02 000000000000# 15456 001064'04 124 150 145 040 000 15457 15458 001651'01 201 01 0 00 000101 movei t1, .priou ; Output to terminal, always 15459 001652'01 302 05 0 00 000016 caie q1, .cmdev ; Device? 15460 001653'01 254 00 0 00 001664' ifskp. ; Yes, use DEVST% 15461 001654'01 200 02 0 00 000006 move t2, q2 ; Load whatever we parsed 15462 001655'01 104 00 0 00 000121 DEVST% ; Write the device name into the AC's 15463 001656'01 320 12 0 00 001660' %jserr (,cmder1) 15464 001657'01 254 00 0 00 001663' 15465 001660'01 265 01 0 00 001610* 15466 001661'01 000000000000# 15467 001662'01 254 00 0 00 001637* 15468 001065'04 125 156 141 142 154 15469 001663'01 254 00 0 00 001674' else. ; Otherwise, DEVST% will choke on the JFN 15470 001664'01 550 02 0 00 000006 hrrz t2, q2 ; Load just the JFN 15471 dmove t3, [ ; Just want the device name, no punctuation 15472 fld(.jsaof,js%dev) 15473 001665'01 120 03 0 00 002556' 0 ] ; No odd prefix, whatever that is 15474 001666'01 104 00 0 00 000030 JFNS% ; Convert to something readable 15475 001667'01 320 12 0 00 001671' %jserr (,cmder1) 15476 001670'01 254 00 0 00 001674' 15477 001671'01 265 01 0 00 001660* 15478 001672'01 000000000000# 15479 001673'01 254 00 0 00 001662* 15480 001075'04 125 156 141 142 154 15481 001674'01 endif. ; Either way, error should be more informative 15482 15483 001674'01 200 01 0 00 000000# txmsg <: device is not valid for saving macros> 15484 001675'01 104 00 0 00 000076 15485 001676'01 320 12 0 00 001677' 15486 000066'02 000000000000# 15487 001107'04 072 040 144 145 166 15488 001677'01 561 01 0 00 001233* hrroi t1, crlf ; Newline 15489 001700'01 104 00 0 00 000076 PSOUT% ; Tie off the blat 15490 001701'01 320 12 0 00 001702' erjmpr .+1 ; Catch and ignore that error, too 15491 15492 001702'01 302 05 0 00 000006 caie q1, .cmfil ; Had we parsed a file, actually? 15493 001703'01 254 00 0 00 001707' ifskp. ; Yes, then have a little clean up to do 15494 001704'01 550 01 0 00 000006 hrrz t1, q2 ; Load our poor JFN, sans flags 15495 001705'01 104 00 0 00 000023 RLJFN% ; Toss it; can't use it 15496 001706'01 320 12 0 00 001673* erjmpr cmder1 ; Ignore error and beat it 15497 001707'01 endif. 15498 15499 001707'01 254 00 0 00 001706* jrst cmder1 ; Allow ^H 15500 k20mac - Kermit-20 DEFINE macro Implementation MACRO %53B(1254)-4 19:41 30-Mar-24 Page 39 K20MAC MAC 30-Jun-23 17:21 Execute the /SAVE switch 15501 subttl Execute the /SAVE switch 15502 15503 ; Not that fast. If you want fast, use /DUMP 15504 15505 001710'01 265 16 0 00 002466' $msave: saveac ; Wants a few accumulators 15506 15507 001711'01 554 06 0 00 000000# hlrz q2, mactab ; Load the macro count 15508 001712'01 326 06 0 00 001717' ife. q2 ; BUT!! Anything to save, really? 15509 txmsg <% No macros to save 15510 001713'01 200 01 0 00 000000# > ; Give a mild scolding 15511 001714'01 104 00 0 00 000076 15512 001715'01 320 12 0 00 001716' 15513 000067'02 000000000000# 15514 001117'04 045 040 116 157 040 15515 15516 001716'01 254 00 0 00 002062' jrst $msve ; And go flush the JFN 15517 001717'01 endif. 15518 15519 001717'01 200 05 0 00 001645* move q1, pars2 ; Load the JFN and flags 15520 001720'01 550 01 0 00 000005 hrrz t1, q1 ; Look at just the JFN 15521 001721'01 306 01 0 00 377777 cain t1, .nulio ; Special cased? 15522 001722'01 254 00 0 00 001734' ifskp. ; No, we're going to have to open it 15523 001723'01 306 01 0 00 000101 cain t1, .priou ; Unless it is primary output 15524 001724'01 254 00 0 00 001734' anskp. ; It is, don't bother 15525 001725'01 200 02 0 00 002633' movx t2, 15526 001726'01 104 00 0 00 000021 OPENF% ; Try to create the file 15527 001727'01 320 12 0 00 001731' %jserr (,$msve) 15528 001730'01 254 00 0 00 001734' 15529 001731'01 265 01 0 00 001671* 15530 001732'01 000000000000# 15531 001733'01 254 00 0 00 002062' 15532 001124'04 125 156 141 142 154 15533 001734'01 endif. 15534 15535 remark t1, ; Either way, t1 has something SOUT% can use 15536 001734'01 400 04 0 00 000000 setz t4, ; For uncounted SOUT%, always stop on a NUL 15537 001735'01 201 07 0 00 000000# movei q3, mactab+1 ; Start at the beginning of the table 15538 15539 001736'01 do. ; Enter loop context 15540 001736'01 120 02 0 00 000000# dxtext (t2,) ; Issue the command (NOTE TRAILING SPACE!!) 15541 000070'02 000000000000# 15542 000071'02 777777 777771 15543 001132'04 144 145 146 151 156 15544 001737'01 104 00 0 00 000053 SOUT% ; Start out with that 15545 001740'01 320 12 0 00 001742' %jserr (,$msve) 15546 001741'01 254 00 0 00 001745' 15547 001742'01 265 01 0 00 001731* 15548 001743'01 000000000000# 15549 001744'01 254 00 0 00 002062' 15550 001134'04 125 156 141 142 154 15551 001745'01 554 02 0 07 000000 hlrz t2, (q3) ; Address of macro name 15552 001746'01 505 02 0 00 440700 hrli t2, (point 7,0) ; Turn into a section local pointer 15553 001747'01 400 03 0 00 000000 setz t3, ; Uncounted, stop on a NUL 15554 001750'01 104 00 0 00 000053 SOUT% ; Write that 15555 001751'01 320 12 0 00 001753' %jserr (,$msve) k20mac - Kermit-20 DEFINE macro Implementation MACRO %53B(1254)-4 19:41 30-Mar-24 Page 39-1 K20MAC MAC 30-Jun-23 17:21 Execute the /SAVE switch 15556 001752'01 254 00 0 00 001756' 15557 001753'01 265 01 0 00 001742* 15558 001754'01 000000000000# 15559 001755'01 254 00 0 00 002062' 15560 001143'04 125 156 141 142 154 15561 001756'01 201 02 0 00 000040 movei t2, .chspc ; Seperate macro name and body 15562 001757'01 104 00 0 00 000051 BOUT% ; Emit the space 15563 001760'01 550 02 0 07 000000 hrrz t2, (q3) ; Address of macro body 15564 001761'01 505 02 0 00 440700 hrli t2, (point 7,0) ; Turn into a section local pointer 15565 001762'01 400 03 0 00 000000 setz t3, ; Uncounted, stop on a NUL 15566 001763'01 104 00 0 00 000053 SOUT% ; Write that 15567 001764'01 320 12 0 00 001766' %jserr (,$msve) 15568 001765'01 254 00 0 00 001771' 15569 001766'01 265 01 0 00 001753* 15570 001767'01 000000000000# 15571 001770'01 254 00 0 00 002062' 15572 001151'04 125 156 141 142 154 15573 remark ; All have CRLF 15574 001771'01 363 06 0 00 001773' sojle q2, endlp. ; At end? Then stop 15575 001772'01 344 07 0 00 001736' aoja q3, top. ; Otherwise, do next table entry 15576 001773'01 enddo. ; End loop lexical context 15577 15578 001773'01 306 01 0 00 377777 cain t1, .nulio ; Not writing to NUL:? 15579 001774'01 254 00 0 00 002015' ifskp. ; Nope, then we should have a byte count 15580 001775'01 306 01 0 00 000101 cain t1, .priou ; Unless it's primary output 15581 001776'01 254 00 0 00 002015' anskp. ; That won't have one, either 15582 001777'01 104 00 0 00 000043 RFPTR% ; See how much we've written 15583 002000'01 320 12 0 00 002002' %jsErr (, $msve) 15584 002001'01 254 00 0 00 002005' 15585 002002'01 265 01 0 00 001766* 15586 002003'01 000000000000# 15587 002004'01 254 00 0 00 002062' 15588 001157'04 125 156 141 142 154 15589 002005'01 200 07 0 00 000002 move q3, t2 ; Save the (non-negative) byte count 15590 002006'01 104 00 0 00 000022 CLOSF% ; Completely close the (disk) file 15591 002007'01 320 12 0 00 002011' %jsErr (, $msve) 15592 002010'01 254 00 0 00 002014' 15593 002011'01 265 01 0 00 002002* 15594 002012'01 000000000000# 15595 002013'01 254 00 0 00 002062' 15596 001166'04 125 156 141 142 154 15597 002014'01 254 00 0 00 002016' else. ; Neither NUL: nor TTY: will have byte counts 15598 002015'01 474 07 0 00 000000 seto q3, ; Flag that 15599 002016'01 endif. 15600 15601 002016'01 200 01 0 00 000000# txmsg 15602 002017'01 104 00 0 00 000076 15603 002020'01 320 12 0 00 002021' 15604 000072'02 000000000000# 15605 001174'04 127 162 157 164 145 15606 002021'01 201 01 0 00 000101 movei t1, .priou ; Typing to terminal 15607 002022'01 554 02 0 00 000000# hlrz t2, mactab ; Number of macros 15608 002023'01 201 03 0 00 000012 movei t3, ^d10 ; All numbers are in base ten 15609 002024'01 200 04 0 00 000002 move t4, t2 ; Save the count 15610 002025'01 104 00 0 00 000224 NOUT% k20mac - Kermit-20 DEFINE macro Implementation MACRO %53B(1254)-4 19:41 30-Mar-24 Page 39-2 K20MAC MAC 30-Jun-23 17:21 Execute the /SAVE switch 15611 002026'01 320 14 0 00 000001 erjmps +1 ; Catch and suppress error 15612 002027'01 200 01 0 00 000000# txmsg < macro> ; Assume singular 15613 002030'01 104 00 0 00 000076 15614 002031'01 320 12 0 00 002032' 15615 000073'02 000000000000# 15616 001176'04 040 155 141 143 162 15617 002032'01 306 04 0 00 000001 cain t4, ^d1 ; BUT! Non-plural or zero? 15618 002033'01 254 00 0 00 002037' ifskp. ; Nope, have to inflect because we're grammatical 15619 002034'01 201 01 0 00 000163 movei t1, "s" ; Pluralizer 15620 002035'01 104 00 0 00 000074 PBOUT% ; Properly inflect 15621 002036'01 320 14 0 00 000001 erjmps +1 ; Catch and suppress error 15622 002037'01 endif. 15623 15624 002037'01 321 07 0 00 002057' ifge. q3 ; Could we count the data? 15625 002040'01 200 01 0 00 000000# txmsg <, > ; Yes, so type it 15626 002041'01 104 00 0 00 000076 15627 002042'01 320 12 0 00 002043' 15628 000074'02 000000000000# 15629 001200'04 054 040 000 000 000 15630 002043'01 201 01 0 00 000101 movei t1, .priou ; Typing to terminal 15631 002044'01 200 02 0 00 000007 move t2, q3 ; Number of characters written 15632 002045'01 104 00 0 00 000224 NOUT% 15633 002046'01 320 14 0 00 000001 erjmps +1 ; Catch and suppress error 15634 002047'01 200 01 0 00 000000# txmsg < character> ; Assume singular 15635 002050'01 104 00 0 00 000076 15636 002051'01 320 12 0 00 002052' 15637 000075'02 000000000000# 15638 001201'04 040 143 150 141 162 15639 002052'01 306 04 0 00 000001 cain t4, ^d1 ; BUT! Non-plural or zero? 15640 002053'01 254 00 0 00 002057' ifskp. ; Nope, have to inflect because we're grammatical 15641 002054'01 201 01 0 00 000163 movei t1, "s" ; Pluralizer 15642 002055'01 104 00 0 00 000074 PBOUT% ; Properly inflect 15643 002056'01 320 14 0 00 000001 erjmps +1 ; Catch and suppress error 15644 002057'01 endif. 15645 002057'01 endif. 15646 15647 002057'01 561 01 0 00 001677* hrroi t1, crlf ; Tie off the line 15648 002060'01 104 00 0 00 000076 PSOUT% 15649 15650 002061'01 263 17 0 00 000000 ret ; Finally done 15651 k20mac - Kermit-20 DEFINE macro Implementation MACRO %53B(1254)-4 19:41 30-Mar-24 Page 40 K20MAC MAC 30-Jun-23 17:21 Error handling 15652 subttl Error handling 15653 15654 002062'01 $msve: remark ; Here to handle errors 15655 002062'01 332 01 0 00 000005 skipe t1, q1 ; Didn't have a JFN? 15656 002063'01 260 17 0 00 001402* call frclos ; We did, go get rid of it 15657 002064'01 600 00 0 00 000000 nop ; Ignore any goofy error 15658 002065'01 263 17 0 00 000000 ret ; Done 15659 k20mac - Kermit-20 DEFINE macro Implementation MACRO %53B(1254)-4 19:41 30-Mar-24 Page 41 K20MAC MAC 30-Jun-23 17:21 Provide summary information 15660 subttl Provide summary information 15661 15662 002066'01 260 17 0 00 001644* .msumm: confrm ; Tie off the line 15663 002067'01 263 17 0 00 000000 ret 15664 15665 002070'01 200 01 0 00 000000# $msumm: txmsg 15666 002071'01 104 00 0 00 000076 15667 002072'01 320 12 0 00 002073' 15668 000076'02 000000000000# 15669 001204'04 115 141 143 162 157 15670 002073'01 201 01 0 00 000101 movei t1, .priou ; This terminal 15671 002074'01 554 02 0 00 000000# hlrz t2, mactab ; Load macro keyword table entries 15672 002075'01 200 04 0 00 000002 move t4, t2 ; Tuck that away for later 15673 002076'01 201 03 0 00 000012 movei t3, ^d10 ; It's in base ten 15674 002077'01 104 00 0 00 000224 NOUT% ; Type it 15675 002100'01 320 12 0 00 002102' %jserr (,) ; Dubious, but carry on 15676 002101'01 254 00 0 00 002105' 15677 002102'01 265 01 0 00 002011* 15678 002103'01 000000 000000 15679 002104'01 254 00 0 00 002105' 15680 002105'01 200 01 0 00 000000# txmsg < used, > 15681 002106'01 104 00 0 00 000076 15682 002107'01 320 12 0 00 002110' 15683 000077'02 000000000000# 15684 001206'04 040 165 163 145 144 15685 002110'01 201 01 0 00 000101 movei t1, .priou ; This terminal 15686 002111'01 550 02 0 00 000000# hrrz t2, mactab ; Load maximum macro keyword table entries 15687 002112'01 274 02 0 00 000004 sub t2, t4 ; Yields remaining 15688 002113'01 104 00 0 00 000224 NOUT% ; Type that 15689 002114'01 320 12 0 00 002116' %jserr (,) ; Sigh... Carry on 15690 002115'01 254 00 0 00 002121' 15691 002116'01 265 01 0 00 002102* 15692 002117'01 000000 000000 15693 002120'01 254 00 0 00 002121' 15694 txmsg < remaining. 15695 002121'01 200 01 0 00 000000# Available storage: > 15696 002122'01 104 00 0 00 000076 15697 002123'01 320 12 0 00 002124' 15698 000100'02 000000000000# 15699 001210'04 040 162 145 155 141 15700 15701 002124'01 260 17 0 00 002144' call $mchrs ; Get us some other table numbers 15702 002125'01 200 02 0 00 000001 move t2, t1 ; Load total storage 15703 002126'01 200 04 0 00 000001 move t4, t1 ; Save a copy 15704 002127'01 201 01 0 00 000101 movei t1, .priou ; This terminal 15705 002130'01 201 03 0 00 000012 movei t3, ^d10 ; Base ten 15706 002131'01 104 00 0 00 000224 NOUT% ; Convert to external and display 15707 002132'01 320 12 0 00 002133' erjmpr .+1 ; Catch and ignore error 15708 002133'01 200 01 0 00 000000# txmsg < character> ; Assume (rare) singular case) 15709 002134'01 104 00 0 00 000076 15710 002135'01 320 12 0 00 002136' 15711 000101'02 000000000000# 15712 001217'04 040 143 150 141 162 15713 002136'01 201 01 0 00 000163 movei t1,"s" ;[203] Load inflection 15714 002137'01 302 04 0 00 000001 caie t4,^d1 ;[203] Singular case? k20mac - Kermit-20 DEFINE macro Implementation MACRO %53B(1254)-4 19:41 30-Mar-24 Page 41-1 K20MAC MAC 30-Jun-23 17:21 Provide summary information 15715 002140'01 104 00 0 00 000074 PBOUT% ;[203] No, must inflect it 15716 15717 002141'01 561 01 0 00 002057* hrroi t1, crlf 15718 002142'01 104 00 0 00 000076 PSOUT% 15719 002143'01 263 17 0 00 000000 ret 15720 k20mac - Kermit-20 DEFINE macro Implementation MACRO %53B(1254)-4 19:41 30-Mar-24 Page 42 K20MAC MAC 30-Jun-23 17:21 Provide some table information to caller 15721 subttl Provide some table information to caller 15722 15723 ; Returns: 15724 ; 15725 ; t1/ characters available in macro table 15726 15727 002144'01 $mchrs: entry $mchrs ; Called by k20dsp 15728 002144'01 265 16 0 00 002634' saveac ; Be extra tidy 15729 15730 002145'01 201 01 0 00 000000# movei t1, macx ; Load end of macro table 15731 002146'01 200 02 0 00 000000# move t2, macbp ; Load end of macro expansions 15732 002147'01 554 03 0 00 000002 hlrz t3, t2 ; Load the byte pointer 15733 002150'01 302 03 0 00 440700 caie t3, 440700 ; On a word boundary? 15734 002151'01 271 02 0 00 000001 addi t2,^d1 ; No, round up a word 15735 002152'01 621 02 0 00 777777 tlz t2, -1 ; Shut off the byte pointer 15736 002153'01 274 01 0 00 000002 sub t1, t2 ; Calculate remaining words 15737 002154'01 221 01 0 00 000005 imuli t1, ^d5 ; Have total characters 15738 002155'01 263 17 0 00 000000 ret 15739 k20mac - Kermit-20 DEFINE macro Implementation MACRO %53B(1254)-4 19:41 30-Mar-24 Page 43 K20MAC MAC 30-Jun-23 17:21 Garbage collection 15740 subttl Garbage collection 15741 15742 remark Parsing 15743 15744 002156'01 260 17 0 00 002066* .mcomp: confrm ; Tie off the line 15745 002157'01 263 17 0 00 000000 ret ; Then get going on processing 15746 15747 remark Semantic action 15748 15749 extern ehptim ; Display elapsed processor ticks 15750 15751 002160'01 $mcomp: remark ; Garbage collection prologue 15752 002160'01 265 16 0 00 002466' saveac ; Will need some registers for control 15753 002161'01 200 01 0 00 000000# txmsg ; Set up for some blat 15754 002162'01 104 00 0 00 000076 15755 002163'01 320 12 0 00 002164' 15756 000102'02 000000000000# 15757 001222'04 102 145 146 157 162 15758 002164'01 260 17 0 00 002070' call $msumm ; Display macro table usage 15759 15760 002165'01 260 17 0 00 000000* call statim ; Record start time garbage collection run 15761 002166'01 201 01 0 00 000001 movx t1, .hprnt ; Request current CPU time used 15762 002167'01 104 00 0 00 000501 HPTIM% ; by this process 15763 002170'01 320 12 0 00 002172' %jserr (,r) ; Fail and don't do anything more 15764 002171'01 254 00 0 00 002175' 15765 002172'01 265 01 0 00 002116* 15766 002173'01 000000 000000 15767 002174'01 254 00 0 00 001531* 15768 002175'01 200 10 0 00 000001 move q4, t1 ; Store that 15769 k20mac - Kermit-20 DEFINE macro Implementation MACRO %53B(1254)-4 19:41 30-Mar-24 Page 44 K20MAC MAC 30-Jun-23 17:21 Garbage collection 15770 remark Set up loop context 15771 15772 remark ; First copy current macro .psect to the GC 15773 002176'01 554 05 0 00 000000# hlrz q1, mactab ; Save count of current entries 15774 002177'01 326 05 0 00 002204' ife. q1 ; Wait a second, is there anything to do? 15775 txmsg <% No macros, nothing to compact 15776 002200'01 200 01 0 00 000000# > ; Some minor scolding blat 15777 002201'01 104 00 0 00 000076 15778 002202'01 320 12 0 00 002203' 15779 000103'02 000000000000# 15780 001224'04 045 040 116 157 040 15781 15782 002203'01 263 17 0 00 000000 ret ; That all, we're done 15783 002204'01 endif. 15784 15785 002204'01 201 01 0 00 007000 movx t1, maclen ; Length of both .psect's 15786 dmove t2, [ macorg ; Source is first word of macro psect 15787 002205'01 120 02 0 00 002566' gcorg ] ; Destination is first word of gc psect 15788 002206'01 123 01 0 00 002501' xblt. t1 ; Copy entire macros psect to gc psect 15789 002207'01 600 00 0 00 000000 nop ; Ignore any skip nonsense 15790 002210'01 260 17 0 00 001424' call $mrese ; Now completely destroy the macros psect 15791 15792 002211'01 201 01 0 00 000001 movei t1, ^d1 ; Account for the header word 15793 002212'01 270 01 0 00 000005 add t1, q1 ; Only put back the TBLUK% entries 15794 dmove t2, [ gcorg ; Source is first word of gc psect (previous mactab 15795 002213'01 120 02 0 00 002610' macorg ] ; Destination is first word of macro psect 15796 002214'01 123 01 0 00 002501' xblt. t1 ; Only copy the in use part of the table 15797 002215'01 600 00 0 00 000000 nop ; Ignore any skip nonsense 15798 15799 002216'01 201 06 0 00 011001 movei q2, macorg+1 ; First slot in macro table 15800 dmove t1, [ gcorg ; Load first address of garbage collection 15801 002217'01 120 01 0 00 002610' macorg ] ; End first slot of macro table 15802 002220'01 317 01 0 00 000002 camg t1, t2 ; macros should be before garbage collection 15803 002221'01 250 01 0 00 000002 exch 1, t2 ; But they're not (??) 15804 002222'01 274 01 0 00 000002 sub t1, t2 ; Calculate address offset between tables 15805 002223'01 200 07 0 00 000001 move q3, t1 ; Store that 15806 k20mac - Kermit-20 DEFINE macro Implementation MACRO %53B(1254)-4 19:41 30-Mar-24 Page 45 K20MAC MAC 30-Jun-23 17:21 Garbage collection 15807 remark Get down to some serious byte banging 15808 15809 ; The garbage collection algorythm is trivial. We've copyed the entire 15810 ; macros psect to the gc psect, stomped the macros psect and then only 15811 ; copied the used entries in the keyword table back. 15812 ; 15813 ; Here, using the keyword table as a basis, we copy over each keyword 15814 ; and text that is pointed to by an entry and fix the pointers 15815 ; accordingly. Anything that doesn't get copied is orphaned data and 15816 ; is no longer necessary. Once this is done, we toss the gc psect. 15817 15818 002224'01 do. ; Enter loop 15819 002224'01 260 17 0 00 002321' call mkeycp ; Copy the keyword (macro name) 15820 002225'01 260 17 0 00 002336' call mtxtcp ; Copy the text of the macro over 15821 002226'01 271 06 0 00 000001 addi q2, ^d1 ; Step to next slot in macro table 15822 002227'01 367 05 0 00 002224' sojg q1, top. ; And do the remaining 15823 002230'01 enddo. ; End loop lexical context 15824 k20mac - Kermit-20 DEFINE macro Implementation MACRO %53B(1254)-4 19:41 30-Mar-24 Page 46 K20MAC MAC 30-Jun-23 17:21 Garbage collection 15825 remark Compact epilogue, displays more data 15826 15827 002230'01 201 01 0 00 000001 movx t1, .hprnt ; Request current CPU time 15828 002231'01 104 00 0 00 000501 HPTIM% ; now that we're done 15829 002232'01 320 12 0 00 002234' %jserr (,r) ; Fail and don't do anything more 15830 002233'01 254 00 0 00 002237' 15831 002234'01 265 01 0 00 002172* 15832 002235'01 000000 000000 15833 002236'01 254 00 0 00 002174* 15834 002237'01 315 01 0 00 000010 camge t1, q4 ; Did it wrap around 15835 002240'01 250 01 0 00 000010 exch t1, q4 ; It did, fix that 15836 002241'01 276 01 0 00 000010 subm t1, q4 ; Get and store the difference in HP ticks 15837 15838 002242'01 260 17 0 00 000000* call endtim ; Take a snapshot from right now 15839 002243'01 260 17 0 00 000000* call elptim ; Calculates elapsed time 15840 15841 002244'01 200 01 0 00 000000# txmsg ; Give interesting post blat 15842 002245'01 104 00 0 00 000076 15843 002246'01 320 12 0 00 002247' 15844 000104'02 000000000000# 15845 001233'04 101 146 164 145 162 15846 002247'01 260 17 0 00 002070' call $msumm ; Display macro table usage 15847 15848 002250'01 201 02 0 00 000000* movei t2, ewallt ; Load pointer to elapsed wall time 15849 002251'01 120 03 0 02 000017 dmove t3, .datus(t2) ; Load elapsed HPTIM% double word 15850 002252'01 434 03 0 00 000004 or t3, t4 ; Will print if either high or low order 15851 002253'01 322 03 0 00 002264' ifn. t3 ; Did this take any time, actually? 15852 002254'01 200 07 0 00 000003 move q3, t3 ; It did, so save as a talisman 15853 002255'01 200 01 0 00 000000# txmsg ; Seperate from characters cleared 15854 002256'01 104 00 0 00 000076 15855 002257'01 320 12 0 00 002260' 15856 000105'02 000000000000# 15857 001235'04 105 154 141 160 163 15858 002260'01 201 01 0 00 000101 movei t1, .priou ; Going to terminal 15859 002261'01 260 17 0 00 000000* call durtim ; Nicely print the duration 15860 002262'01 600 00 0 00 000000 nop ; Ignore any goofy return 15861 002263'01 254 00 0 00 002265' else. ; Else did nothing 15862 002264'01 400 07 0 00 000000 setz q3, ; So flag this 15863 002265'01 endif. ; End case positive elapsed time 15864 15865 ; Note a small hack for ehptim: it now takes a pointer to a signed 15866 ; double word instead a signed single word. It happens that we have 15867 ; the value in q4, that q3 is free, that there will never be any high 15868 ; order and that ehptim does not modify either one. Thus, we pass 15869 ; it a pointer to that double word accumulator pair and everything 15870 ; works fine. For the moment... Until something changes... 15871 15872 002265'01 323 10 0 00 002306' ifg. q4 ; Any CPU time taken? 15873 002266'01 322 07 0 00 002272' ifn. q3 ; Displayed any elapsed time? 15874 002267'01 200 01 0 00 000000# txmsg <, > ; Yes, space over 15875 002270'01 104 00 0 00 000076 15876 002271'01 320 12 0 00 002272' 15877 000106'02 000000000000# 15878 001237'04 054 040 000 000 000 15879 002272'01 endif. k20mac - Kermit-20 DEFINE macro Implementation MACRO %53B(1254)-4 19:41 30-Mar-24 Page 46-1 K20MAC MAC 30-Jun-23 17:21 Garbage collection 15880 002272'01 200 01 0 00 000000# txmsg ; Introduce processor blat 15881 002273'01 104 00 0 00 000076 15882 002274'01 320 12 0 00 002275' 15883 000107'02 000000000000# 15884 001240'04 103 120 125 072 040 15885 002275'01 201 01 0 00 000101 movei t1, .priou ; Going to terminal 15886 002276'01 201 02 0 00 000000# movei t2, mecpu ; Load pointer to macro elapsed CPU 15887 remark .datet ;[221] Don't touch!! This should ALWAYS be zero 15888 002277'01 400 07 0 00 000000 setz q3, ;[221] Clear double word of HP ticks (q3 untouched) 15889 002300'01 124 07 0 02 000017 dmovem q3, .datus(t2) ;[221] Store elapsed DK10 15890 002301'01 201 10 0 02 000017 movei q4, .datus(t2) ;[221] Now point to it 15891 002302'01 250 02 0 00 000010 exch t2, q4 ;[221] Pass in pointer to DK10 ticks, actually 15892 002303'01 400 03 0 00 000000 setz t3, ;[221] Don't suppress leading seconds 15893 002304'01 260 17 0 00 000000* call ehptim ; Display elapsed HP ticks 15894 002305'01 600 00 0 00 000000 nop ;[221] Ignore non-fatal +1 15895 002306'01 endif. ; End CPU display 15896 15897 002306'01 561 01 0 00 002141* hrroi t1, crlf ; Tie off the line 15898 002307'01 104 00 0 00 000076 PSOUT% 15899 15900 remark ; Now that we're done, don't need the gc psect 15901 002310'01 474 01 0 00 000000 seto t1, ; Case IV, deleting process memory 15902 dmove t2, [ .fhslf,,gcpag ; This process, page number of gc psect 15903 002311'01 120 02 0 00 002561' pm%cnt!fld(gcpgs,pm%rpt) ] ; Number of pages to toss 15904 002312'01 104 00 0 00 000056 PMAP% ; Trim our working set 15905 002313'01 320 12 0 00 002315' %jserr (,) ; Odd... but continue 15906 002314'01 254 00 0 00 002320' 15907 002315'01 265 01 0 00 002234* 15908 002316'01 000000000000# 15909 002317'01 254 00 0 00 002320' 15910 001242'04 120 157 163 164 040 15911 15912 002320'01 263 17 0 00 000000 ret ; Don't forget to finally return 15913 15914 chgsec(code,data) ;;Some temporary storage 15915 000000'05 mecpu: XList ; Save a few trees 15916 List ; Turn the listing back on 15917 15918 retsec ;;Restore .PSECT assumptions 15919 15920 k20mac - Kermit-20 DEFINE macro Implementation MACRO %53B(1254)-4 19:41 30-Mar-24 Page 47 K20MAC MAC 30-Jun-23 17:21 String copy measurement, 9:10pm Thursday, 21 July 1920 15921 subttl String copy measurement, 9:10pm Thursday, 21 July 1920 15922 15923 ; A question had sometimes come up for debate as to whether the string 15924 ; instructions gave any real speed up, the concern being whether the 15925 ; set up cost of conditioning the register file and restoring it was 15926 ; worth using them. 15927 ; 15928 ; Three cases were set up, the first being a typical ildb/idpb loop 15929 ; with the second being a use of movst to move the string until a nul 15930 ; was detected. The third was a mixture; the keywords being moved 15931 ; with a loop and the macro expansions being moved with the movst. 15932 ; This was expected to be have the best performance as macro names 15933 ; (I.E., keywords) are typically not very long. 15934 ; 15935 ; 11 macros were defined, using a total of 80 characters of macro name 15936 ; space and 1365 characters of macro text space. The results are 15937 ; suprising: 15938 ; 15939 ; Case Elapsed CPU All 15940 ; 1 1.360 1.320 times 15941 ; *2 .340 .320 are in 15942 ; 3 1.020 .980 milliseconds 15943 ; 15944 ; By a considerable margin, using solely the movst won. This is why 15945 ; it is used exclusively, below. Going forward, other cases may be 15946 ; identified in Kermit where it can be used. 15947 15948 extern asczcp ; Extended instruction to move ASCIZ 15949 k20mac - Kermit-20 DEFINE macro Implementation MACRO %53B(1254)-4 19:41 30-Mar-24 Page 48 K20MAC MAC 30-Jun-23 17:21 Routine to copy keyword (macro name) data 15950 subttl Routine to copy keyword (macro name) data 15951 15952 ; Expects: 15953 ; 15954 ; q2/ Address of current keyword entry 15955 ; q3/ Word offset between tables 15956 ; 15957 ; Returns: 15958 ; 15959 ; +1, always 15960 15961 002321'01 mkeycp: remark ; Copy the keyword (macro name) 15962 002321'01 554 01 0 06 000000 hlrz t1, (q2) ; Pick up keyword address 15963 002322'01 270 01 0 00 000007 add t1, q3 ; add in offset 15964 002323'01 505 01 0 00 440700 hrli t1, (point 7,0) ; Now have a source pointer 15965 002324'01 200 02 0 00 000000# move t2, macbp ; Point to our (scrubbed) macro table 15966 002325'01 506 02 0 06 000000 hrlm t2, (q2) ; Stomp in as the new keyword address 15967 002326'01 260 17 0 00 000443* call asczcp ; Copy the ASCIZ string 15968 002327'01 554 04 0 00 000002 hlrz t4, t2 ; Load the destination pointer portion 15969 002330'01 306 04 0 00 440700 cain t4, 440700 ; On a word boundary? (1 in 5 chance) 15970 002331'01 254 00 0 00 002334' ifskp. ; Nope, fix 15971 002332'01 271 02 0 00 000001 addi t2, ^d1 ; Round up a word 15972 002333'01 505 02 0 00 440700 hrli t2, 440700 ; Stomp in the right magic 15973 002334'01 endif. ; Ready for any future usage 15974 002334'01 202 02 0 00 000000# movem t2, macbp ; Point to our (scrubbed) macro table 15975 002335'01 263 17 0 00 000000 ret ; All is well, return 15976 k20mac - Kermit-20 DEFINE macro Implementation MACRO %53B(1254)-4 19:41 30-Mar-24 Page 49 K20MAC MAC 30-Jun-23 17:21 Routine to copy macro text (macro expansion) data 15977 subttl Routine to copy macro text (macro expansion) data 15978 15979 ; Expects: 15980 ; 15981 ; q2/ Address of current keyword entry 15982 ; q3/ Word offset between tables 15983 ; 15984 ; Returns: 15985 ; 15986 ; +1, Always 15987 15988 extern asczcp ; Extended instruction to move ASCIZ 15989 15990 002336'01 mtxtcp: remark ; Copy the text of the macro over 15991 002336'01 550 01 0 06 000000 hrrz t1, (q2) ; Pick up expansion address 15992 002337'01 270 01 0 00 000007 add t1, q3 ; add in offset 15993 002340'01 505 01 0 00 440700 hrli t1, (point 7,0) ; Now have a source pointer 15994 002341'01 200 02 0 00 000000# move t2, macbp ; Point to our (scrubbed) macro text table 15995 002342'01 542 02 0 06 000000 hrrm t2, (q2) ; Stomp in as the new text address 15996 002343'01 260 17 0 00 002326* call asczcp ; Maybe will even save some cpu time 15997 002344'01 554 04 0 00 000002 hlrz t4, t2 ; Load the destination pointer portion 15998 002345'01 306 04 0 00 440700 cain t4, 440700 ; On a word boundary? (1 in 5 chance) 15999 002346'01 254 00 0 00 002351' ifskp. ; Nope, fix 16000 002347'01 271 02 0 00 000001 addi t2, ^d1 ; Round up a word 16001 002350'01 505 02 0 00 440700 hrli t2, 440700 ; Stomp in the right magic 16002 002351'01 endif. ; Ready for any future usage 16003 002351'01 202 02 0 00 000000# movem t2, macbp ; And update global storage 16004 002352'01 263 17 0 00 000000 ret ; All is well, return 16005 16006 .endps code 16007 k20mac - Kermit-20 DEFINE macro Implementation MACRO %53B(1254)-4 19:41 30-Mar-24 Page 50 K20MAC MAC 30-Jun-23 17:21 Additional writable storage areas 16008 subttl Additional writable storage areas 16009 16010 .psect data 16011 000021'05 000000 000000 onamp: 0 ;[77] Previous NAMP. 16012 000022'05 000000 000000 tbent: 0 ; TBLUK% entry of existing keyword 16013 000023'05 000000 000000 sintn: 0 ; Number of signal I/O traps we've seen 16014 16015 extern namlen,namatm,explen,expatm 16016 16017 remark definf,undeff ; Must be whacked on every parse 16018 000024'05 000000 000000 definf:: 0 ;[77] DEFINE flag nonzero if parsing DEFINE. 16019 000025'05 000000 000000 undeff:: 0 ;[77] UNDEFF flag nonzero if DEFINE x . 16020 000026'05 000000 000000 macptr:: 0 ;[77] Pointer to start of macro text in CSB. 16021 16022 .endps data 16023 k20mac - Kermit-20 DEFINE macro Implementation MACRO %53B(1254)-4 19:41 30-Mar-24 Page 51 K20MAC MAC 30-Jun-23 17:21 Macros storage areas 16024 subttl Macros storage areas 16025 16026 ;N.B, Do NOT put anything into this .PSECT without updating the 16027 ; calculations for maclen in k20unv!!! 16028 16029 .psect macros,macorg ; Storage for macros 16030 16031 ; The TBLUK% table, with one predefined macro for Columbia's IBM 16032 ; system. Users can remove this definition by typing "define ibm", or 16033 ; they can replace it. KERMIT-20 maintainers can remove it for their 16034 ; site by replacing the contents of MACTAB (first word) with 16035 ; 0,,MACMAX, or can change it to be anything they like. 16036 ; 16037 ; Kept for historical reasons and for any take files that depend on it. 16038 ; 16039 ; Be aware that the calculations for .psect size account for the IBM 16040 ; keyword and the cooresponding macro body. If you do change this to 16041 ; be something else, then take a look at calculations in k20unv that are 16042 ; driven off of macmax. 16043 ; 16044 ; You need only change the slop calculations that are done with adslop. 16045 ; 16046 ; mactab MUST be the first location in the .psect!! Garbage collection 16047 ; depends on this. 16048 16049 000000'06 mactab: intern mactab ;[194] 16050 000000'06 000001 000252 1,,macmax ;[77] Macro keyword TBLUK format table. 16051 000001'06 000255' 000256' ibmkey,,ibmmac ; Where is my 3276?? 16052 000002'06 block macmax-1 ;[77] Macro keyword table. 16053 000253'06 mactbx: block 1 ;[214] ; Tiny bit of slop 16054 16055 ; This pointer has to be in here so that /MAP restores them. No 16056 ; TBADD% should ever overwrite it because the maximum count (in the 16057 ; right halfword of TBLUK% table) can not be exceeded. 16058 16059 000254'06 44 07 0 00 000267' macbp: point 7, m1stf ; First free location in macro (expansion) table 16060 16061 ; Both macro names and bodies are allocated out of the same block of 16062 ; storage, which allows for more flexible management, Note that the 16063 ; macro buffer MUST be the last item in the .PSECT in order to get the 16064 ; benefit of guard page two, which follows. 16065 16066 000255'06 macbuf: remark ; Here are the macros 16067 000255'06 111 102 115 000 000 ibmkey:! asciz /IBM/ ; Macro name 16068 000256'06 160 141 162 151 164 ibmmac:! asciz/parity mark, duplex half, handshake xon 16069 / ; Yummy half duplex!! 16070 000267'06 m1stf:! .xcref m1stf ; Don't need this in the cross reference 16071 suppress m1stf ; Nor in the symbol table listing 16072 000267'06 block mnblen ; Space for the names 16073 001013'06 block mtblen ; Space for the expansions 16074 006777'06 macx: block 1 ;[77] End of macro text buffer, with padding. 16075 16076 if2 < purge m1stf > ; Not needed after second pass 16077 .endps macros 16078 k20mac - Kermit-20 DEFINE macro Implementation MACRO %53B(1254)-4 19:41 30-Mar-24 Page 51-1 K20MAC MAC 30-Jun-23 17:21 Macros storage areas 16079 .psect gc,gcorg ; psect for garbage collections 16080 000000'07 block maclen ; same size as for macros 16081 .endps gc 16082 16083 emacro < 16084 .psect medit,medorg ; psect for macro editing 16085 block maclen ; same size as for macros 16086 .endps medit ; Probably far too large 16087 >;;emacro 16088 k20mac - Kermit-20 DEFINE macro Implementation MACRO %53B(1254)-4 19:41 30-Mar-24 Page 52 K20MAC MAC 30-Jun-23 17:21 History and Motivation 16089 subttl History and Motivation 16090 16091 ; The is all part of edit 203 16092 16093 ;PS:KERMIT.MAC.288, 27-Oct-83 18:55:44, Frank 16094 ;[77] Add DEFINE command for SET macros. Remove hardwired SET IBM. 16095 16096 ; The DEFINE command for SET macros is quite old, having been added by 16097 ; Frank da Cruz as part of edit 77 on 27-Oct-83. It predates the 16098 ; availability of extended sections and read-only .psects (perhaps 16099 ; even .psects themselves) 16100 ; 16101 ; It's fine for what it does, meaning loading up a bunch of macros 16102 ; from a KERMIT.INI file, and clearly functioned fine for years, if 16103 ; not decades. 16104 ; 16105 ; However, during the DECnet NRT work, it became increasingly 16106 ; aggressively used, which revealed some limitations: 16107 ; 16108 ; DEFINE assumed that you are always creating a macro and thus copies 16109 ; whatever is in the atom buffer into the name table. This means 16110 ; that, in addition to not freeing up any name or macro space, 16111 ; undefining a macro would actually use *more* name space. 16112 ; 16113 ; Because this copy happened during the parse and not after the 16114 ; command had been confirmed, if the user started defining a macro, 16115 ; changed his mind and typed a ^U, space in the name table would still 16116 ; be usurped for each and every reparse. 16117 ; 16118 ; Thus, during the process of either learning the DEFINE command or 16119 ; trying different parameters, the user could run out of space without 16120 ; actually having accomplished anything. There was no remedy to this 16121 ; except to exit and run a fresh copy of Kermit. 16122 ; 16123 ; The out of space check was not reliable. First, it checked to see 16124 ; if the macro name and text space was already full at the beginning 16125 ; of the parse. These checks simply looked to see if the macro name 16126 ; and table space had started to go past the marked end of tables. 16127 ; Overwrites were prevented by having a certain amount of slop for the 16128 ; definition to expand into. 16129 ; 16130 ; However, once the check was passed, Kermit did no further checking, 16131 ; meaning the user could blithly continue typing, overwriting whatever 16132 ; happened to be after the tables. This, coupled with the reparse 16133 ; phenomena previously described could produce some pretty quirky 16134 ; behavior, if not downright crashes. 16135 ; 16136 ; Another non-critical limitation was that there was was no way to 16137 ; make modifications to a macro once it was defined. Any change meant 16138 ; that you had to basically type the whole macro in again. 16139 ; 16140 ; As a practical matter, while SET macros could be read in via the 16141 ; execution of a TAKE file, there was no way to write them out. 16142 ; 16143 ; Fixing the problems above and adding the extra functionality proved k20mac - Kermit-20 DEFINE macro Implementation MACRO %53B(1254)-4 19:41 30-Mar-24 Page 52-1 K20MAC MAC 30-Jun-23 17:21 History and Motivation 16144 ; so massive an addition that all the code got moved into this 16145 ; seperate module. 16146 ; 16147 ; That being said, the original logic is largely kept, the bulk of the 16148 ; code being extra functionality. k20mac - Kermit-20 DEFINE macro Implementation MACRO %53B(1254)-4 19:41 30-Mar-24 Page 53 K20MAC MAC 30-Jun-23 17:21 History and Motivation 16149 16150 subttl Random Notes 16151 16152 ; Using a quoted strings allows an easy define of a name that is 16153 ; similar to an existing name by not selecting from the keyword table. 16154 ; 16155 ; Better, it allows for consistent use of escape recognition when 16156 ; specifying the SET commands. 16157 16158 .xcmsy ;[194] Ditch MACSYM junk 16159 16160 end NO ERRORS DETECTED PROGRAM BREAK IS 000000 PSECT 1 BREAK IS 002664 FOR CODE PSECT 2 BREAK IS 000110 FOR CONST PSECT 3 BREAK IS 000040 FOR TEXT PSECT 4 BREAK IS 001252 FOR ETEXT PSECT 5 BREAK IS 000027 FOR DATA PSECT 6 BREAK IS 007000 FOR MACROS PSECT 7 BREAK IS 007000 FOR GC CPU TIME USED 00:00.925 107P CORE USED k20mac - Kermit-20 DEFINE macro Implementation MACRO %53B(1254)-4 19:41 30-Mar-24 Page S-1 K20MAC MAC 30-Jun-23 17:21 SYMBOL TABLE ATMBUF 000000 ext MACORG 011000 spd T2 000002 spd BOUT% 104000 000051 int MACPAG 000011 spd T3 000003 spd CALL 260740 000000 MACPGS 000007 spd T4 000004 spd CALLRE 254000 000000 spd MACROS 000000 ext TBADD% 104000 000536 int CFMRTN 000000 ext MNBLEN 000524 spd TBDEL% 104000 000535 int CHFDB% 104000 000064 int MTBLEN 005764 spd TBLUK% 104000 000537 int CJFNBK 000000 ext MYTTY 000000 ext TEXT 000000 ext CLOSF% 104000 000022 int NOIRTN 000000 ext TL%EXM 040000 000000 sin CLZFF% 104000 000034 int NOP 600000 000000 sin %%JSER 000000 ext CM%ABR 000004 sin NOUT% 104000 000224 int ..MSK 777777 777777 spd CM%FNC 777000 000000 sin OF%BSZ 770000 000000 sin .CHSPC 000040 sin CM%FW 002000 000000 sin OF%MOD 007400 000000 sin .CMCFM 000010 sin CM%HPP 000004 000000 sin OF%RD 200000 sin .CMDEV 000016 sin CM%INV 000001 sin OF%RDU 010000 sin .CMFIL 000006 sin CM%SDH 000001 000000 sin OF%WR 100000 sin .CMFLD 000007 sin CMDBLN 000000 ext OPENF% 104000 000021 int .CMFNP 000000 sin CMDBUF 000000 ext P 000017 .CMKEY 000000 sin CMDER1 000000 ext P1 000011 spd .CMPTR 000004 sin CO%NRJ 400000 000000 sin P2 000012 spd .CMQST 000021 sin CODE 000000 ext P3 000013 spd .CMSWI 000003 sin CONST 000000 ext P4 000014 spd .DATUS 000017 spd CRLF 000000 ext P5 000015 spd .DVDSK 000000 sin CX 000016 PA%PEX 010000 000000 sin .DVNUL 000015 sin CZ%NCL 040000 000000 sin PA%RD 100000 000000 sin .DVTTY 000012 sin DATA 000000 ext PARS1 000000 ext .FBSIZ 000012 sin DEVST% 104000 000121 int PARS2 000000 ext .FHSLF 400000 sin DTILEN 000021 spd PARS3 000000 ext .FP 000015 spd DURTIM 000000 ext PARS4 000000 ext .FPAC 000005 spd DV%TYP 000777 000000 sin PARS5 000000 ext .GJNHG 777777 sin DVCHR% 104000 000117 int PBOUT% 104000 000074 int .GSNRM 000000 sin ELPTIM 000000 ext PM%CNT 400000 000000 sin .HPRNT 000001 sin ENDTIM 000000 ext PM%PLD 010000 000000 sin .JSAOF 000001 sin ERJMPR 320500 000000 int PM%RD 100000 000000 sin .NULIO 377777 sin ERJMPS 320600 000000 int PM%RPT 777777 sin .PRIIN 000100 sin ERRPTR 000000 ext PM%WR 040000 000000 sin .PRIOU 000101 sin ESOUT% 104000 000313 int PMAP% 104000 000056 int .PX7 610001 000000 spd ETEXT 000000 ext PSOUT 104000 000076 int .RHALF 777777 sin EWALLT 000000 ext PSOUT% 104000 000076 int .SAC 000016 FRCLOS 000000 ext Q1 000005 spd .SAV1 000000 ext GC 000000 ext Q2 000006 spd .SAV2 000000 ext GCORG 021000 spd Q3 000007 spd .SAV3 000000 ext GCPAG 000021 spd Q4 000010 spd .SET2 000000 ext GCPGS 000007 spd Q5 000011 spd GJ%FLG 000020 000000 sin R 000000 ext GJ%FOU 400000 000000 sin RET 263740 000000 GJ%GIV 000001 000000 sin RFIELD 000000 ext GJ%GND 000040 000000 sin RFPTR% 104000 000043 int GJ%NEW 200000 000000 sin RLJFN% 104000 000023 int GJ%OLD 100000 000000 sin RPACS% 104000 000057 int HPTIM% 104000 000501 int SBK 000000 ext ISNULJ 000000 ext SETTAB 000000 ext JFNS% 104000 000030 int SIZEF% 104000 000036 int JS%DEV 700000 000000 sin SOUT% 104000 000053 int MACLEN 007000 spd STATIM 000000 ext MACMAX 000252 spd T1 000001 spd k20mac - Kermit-20 DEFINE macro Implementation MACRO %53B(1254)-4 19:41 30-Mar-24 Page S-2 K20MAC MAC 30-Jun-23 17:21 SYMBOL TABLE FOR PSECT CODE ASCZCP 002343' ext ..0020 000020' spd ..0745 001550' spd ATMBUF 002535' ext ..0025 000044' spd ..0753 001566' spd CFMRTN 002156' ext ..0037 000051' spd ..0770 001626' spd CJFNBK 002621' ext ..0040 000053' spd ..0776 001600' spd CMDER1 001707' ext ..0051 000070' spd ..0777 001622' spd CRLF 002306' ext ..0057 000113' spd ..1013 001642' spd DMPBK 000561' ..0060 000123' spd ..1026 001664' spd DMPBKL 000010 spd ..0063 000157' spd ..1027 001674' spd DURTIM 002261' ext ..0073 000163' spd ..1044 001707' spd EHPTIM 002304' ext ..0100 000170' spd ..1046 001717' spd ELPTIM 002243' ext ..0101 000227' spd ..1062 001734' spd ENDTIM 002242' ext ..0113 000225' spd ..1074 001736' spd ERRPTR 001635' ext ..0120 000225' spd ..1075 001773' spd EWALLT 002250' ext ..0141 000267' spd ..1116 002015' spd EXPATM 002500' ext ..0146 000266' spd ..1117 002016' spd EXPLEN 000402' ext ..0170 000326' spd ..1136 002037' spd FRCLOS 002063' ext ..0206 000366' spd ..1140 002057' spd INIFLG 001377' ext ..0213 000365' spd ..1156 002057' spd ISNULJ 001632' ext ..0220 000366' spd ..1203 002204' spd MAPBK 001074' ..0232 000442' spd ..1220 002224' spd MAPBKL 000010 spd ..0250 000502' spd ..1221 002230' spd MKEYCP 002321' ..0255 000501' spd ..1227 002264' spd MTXTCP 002336' ..0262 000502' spd ..1234 002265' spd MYTTY 001572' ext ..0332 000647' spd ..1237 002306' spd NAMATM 002442' ext ..0340 000627' spd ..1245 002272' spd NAMLEN 000502' ext ..0346 000646' spd ..1266 002334' spd NOIRTN 001467' ext ..0363 000663' spd ..1274 002351' spd PARS1 000556' ext ..0376 000705' spd ..IFT 100000 000001 spd PARS2 001717' ext ..0377 000715' spd ..JX1 100000 000000 spd R 002236' ext ..0414 000730' spd ..MX1 000001 spd RFIELD 001473' ext ..0422 000745' spd ..MX2 000001 spd SAVBK 001452' ..0436 000767' spd ..TX1 400000 000000 spd SAVBKL 000010 spd ..0450 000771' spd ..TX2 000001 spd SBK 000000 ext ..0451 001012' spd ..XX 006004 002541' spd SETTAB 000000 ext ..0456 000777' spd .DEFI5 000044' STATIM 002165' ext ..0457 001000' spd .DEFI6 000055' TABLEM 000555' ..0461 001007' spd .DEFIN 000000' ent $DEFAD 000133' ..0476 001054' spd .DUPLI 000301' $DEFI7 000241' ..0530 001162' spd .MCOMP 002156' $DEFIN 000074' ent ..0536 001142' spd .MDMPE 000670' $DUPLI 000335' ..0544 001161' spd .MDUMP 000571' $MCHRS 002144' ent ..0561 001176' spd .MMAP 001104' $MCOMP 002160' ..0574 001220' spd .MMAPE 001203' $MDMPE 001060' ..0575 001230' spd .MRESE 001422' $MDUMP 000731' ..0612 001243' spd .MSAVE 001462' $MMAP 001244' ..0644 001344' spd .MSUMM 002066' $MMAPE 001401' ..0645 001365' spd .MSVE 001647' $MMAPI 001410' ..0652 001352' spd .RENAM 000415' $MMAPN 001405' ..0653 001353' spd .SET2 000073' ext $MRESE 001424' ..0655 001362' spd .UNDEF 000277' $MSAVE 001710' ..0675 001431' spd $MSUMM 002070' ..0676 001444' spd $MSVE 002062' ..0714 001567' spd $RENAM 000451' ..0722 001542' spd %%JSER 002315' ext ..0730 001536' spd k20mac - Kermit-20 DEFINE macro Implementation MACRO %53B(1254)-4 19:41 30-Mar-24 Page S-3 K20MAC MAC 30-Jun-23 17:21 SYMBOL TABLE FOR PSECT CONST DEFSWI 000000' TABSWI 000030' %DUPL 000004' spd k20mac - Kermit-20 DEFINE macro Implementation MACRO %53B(1254)-4 19:41 30-Mar-24 Page S-4 K20MAC MAC 30-Jun-23 17:21 SYMBOL TABLE FOR PSECT DATA DEFINF 000024' int EXPATM 000000 ext EXPLEN 000000 ext MACPTR 000026' int MECPU 000000' NAMATM 000000 ext NAMLEN 000000 ext ONAMP 000021' SINTN 000023' TBENT 000022' UNDEFF 000025' int k20mac - Kermit-20 DEFINE macro Implementation MACRO %53B(1254)-4 19:41 30-Mar-24 Page S-5 K20MAC MAC 30-Jun-23 17:21 SYMBOL TABLE FOR PSECT MACROS IBMKEY 000255' spd IBMMAC 000256' spd MACBP 000254' MACBUF 000255' MACTAB 000000' int MACTBX 000253' MACX 006777' K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 19:41 30-Mar-24 Page 1 K20IOC MAC 7-Jan-24 19:31 16161 Title K20IOC Kermit Input/Output statement Control 16162 16163 search monsym,macsym,cmd,k20unv ;[194] 16164 cmdacs ^ ; Clean up p1-p4 definitions 16165 cmdunv ^ ;[248] ; Externalize storage and constants 16166 16167 sall ; tidy listing, please 16168 .directive flblst ; We don't need to see all the ASCIZ bytes... 16169 16170 ;N.B., although this module is new with a large amount of rewrites, 16171 ; some attempt has been made to keep old edit numbers for cross- 16172 ; reference purposes. 16173 K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 19:41 30-Mar-24 Page 2 K20IOC MAC 7-Jan-24 19:31 External routines and storage 16174 subttl External routines and storage 16175 16176 remark common parsing external data 16177 16178 extern pars1 ; Data from first parse. 16179 extern pars2 ; Data from second parse. 16180 extern pars3 ; Data from third parse. 16181 extern pars4 ; Data from fourth parse. 16182 extern pars5 ;[41] ... 16183 extern pars6 ;[209] ; If $INPUT is not getting driven by .INPUT 16184 extern pars7 ;[229] ; If TRANSMIT is sending some kind of EOF 16185 extern pars8 ;[229] ; If $INPUT matching should not type anything 16186 extern buffer ; Used for foreign file names and string conversion 16187 16188 remark Linkages with the main and other parsers 16189 16190 extern chksec ; k20par: See if we got a silly floating point value 16191 extern definf ; k20mac: Set if we are defining a macro 16192 16193 remark Various JFN's and related control storage 16194 16195 extern netjfn ; Network JFN, if not a remote Kermit 16196 extern ttyjfn ; User's terminal JFN, if remote Kermit 16197 extern takjfn ; JFN of current TAKE file 16198 extern popjfn ; Routine to switch between takjfn's 16199 extern sesjfn ; JFN for session logging file 16200 extern sesflg ; Control flag for active usage of same 16201 extern filjfn ; Current open file 16202 extern cjfnbk ; COMND%'s GTJFN% block 16203 extern isnulj ; Determine if this JFN is on NUL: 16204 extern frclos ; Force a JFN to close (or release it) 16205 16206 remark Handshke, Parity and Duplex Handling 16207 16208 extern handsh ; Handshake character (if any) 16209 extern parity ; Points to whatever parity (routine) we're using 16210 extern duplex ; Who is doing the echoing remote host or us 16211 16212 remark User and Network terminal handling 16213 16214 extern chklin ; Check line (or NRT or PTY) status 16215 extern carier ; Line carrier (or good NRT or PTY JFN) 16216 extern doarpa ; Set up for network binary (if on a TVT) 16217 extern vtermf ; Virtual terminal flag (NRT, PTY, PIP eventually) 16218 extern ttyob ; Put local terminal in binary mode 16219 extern ttyou ; Put local terminal back in user mode 16220 extern dobits ; Set terminal line for transparent I/O 16221 extern unbits ; Undo effects of dobits 16222 16223 extern tvtflg ;[247] ; Whether doing binary on a TVT 16224 extern iaciac ;[247] ; Handle IAC doubling on a TVT in binary mode 16225 extern tvtbuf ;[247] ; Buffer where IAC doubling is done 16226 16227 remark Various performance counters for the interested 16228 K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 19:41 30-Mar-24 Page 2-1 K20IOC MAC 7-Jan-24 19:31 External routines and storage 16229 extern nbict ; Network BIN% count 16230 extern nsici ; Network SIN%'s count (total issued) 16231 extern nsimx ; Network SIN% maximum length 16232 extern nsitc ; Network SIN%'s total characters read 16233 16234 extern vsoct ; Virtual Terminal SOUTR%'s Issued 16235 extern vsotc ; Virtual Terminal SOUTR% Total Characters 16236 extern vsomx ; Virtual Terminal SOUTR% Maximum length 16237 16238 remark Terminal and TIMER% interrupt handling 16239 16240 extern ccon ; Turn ^C handling on 16241 extern ccoff2 ; FORCE ^C handling off 16242 extern cmpon ; Turn ^M and ^P handling on 16243 extern cmpoff ; Turn ^M and ^P handling off 16244 extern cmseen ; ^M seen 16245 extern cmloc ; Location transfer execution to on ^M 16246 extern cpseen ; ^P seen 16247 extern cploc ; Location transfer execution to on ^P 16248 repeat 0,< 16249 extern intpc ; PC to restore on timer interrupt. 16250 extern intstk ; Stack pointer to restore on timer interrupt. 16251 extern timchb ; TIMER% interrupt chanel bit 16252 > 16253 extern timeon ;[209] Set up a TIMER% 16254 extern timdel ;[209] Delete any pending TIMER%'s 16255 16256 remark Buffer and Strings 16257 16258 extern strc ; Counter for, and... 16259 extern strptr ; pointer into the... 16260 extern strbuf ; Gigantic string buffer (1,000 words!!) 16261 extern strbf2 ; Another one 16262 extern asczcp ;[248] ; Move a NUL terminated string and return its length 16263 16264 remark Networking Linkages and variables 16265 16266 extern clrest ;[209] Return estimate of available data 16267 extern clrbuf ;[209] Clear monitor buffers 16268 extern local ;[209] Non-zero if a local Kermit 16269 16270 remark Other random useful things 16271 16272 extern %%jser ; JSYS error handler (for %jserr macro) 16273 extern errptr ; Pointer to error text (for ermsg% macro) 16274 extern crlf ; byte (7) .chcrt, .chlfd, .chnul 16275 extern jobtab ; Result of GETJI%; used to determine batchness 16276 extern nul4 ; Negative counted pointer to "NUL:" 16277 16278 .psect code/ronly ; Pure code, pure heaven 16279 K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 19:41 30-Mar-24 Page 3 K20IOC MAC 7-Jan-24 19:31 SET INPUT command initial parsing 16280 subttl SET INPUT command initial parsing 16281 16282 000000'02 000000 000000 %table(sintab) 16283 000001'02 000000# 000000# %key3 , .sinca, incase 16284 000000'03 143 141 163 145 000 16285 000001'03 000000# 000000# 16286 000002'02 000000# 000000# %key3 , .sindt, indeft 16287 000002'03 144 145 146 141 165 16288 000006'03 000000# 000000# 16289 000003'02 000000# 000000# %key3 , .sinse, indefs ;[209] 16290 000007'03 163 145 141 162 143 16291 000012'03 000000# 000000# 16292 000004'02 000000# 000000# %key3 , .sinta, intima 16293 000013'03 164 151 155 145 157 16294 000016'03 000000# 000000# 16295 000000'02 000004 000004 %tbend 16296 16297 ; SET INPUT parsing, like SET SEND/RECEIVE -- an extra level of parsing. 16298 16299 chgsec(code,const) ;;FDB's go in const .psect 16300 000005'02 000000 000000 tinfdb: flddb. .cmkey,,sintab 16301 000006'02 000000 000000' 16302 retsec ;;Return to code .psect 16303 16304 000000'01 .setin: entry .setin ;[209] Invoked from k20par 16305 000000'01 201 01 0 00 000000# movei t1, tinfdb ;[209] 16306 000001'01 260 17 0 00 000000* call rfield ; Parse a keyword. 16307 000002'01 550 02 0 02 000000 hrrz t2, (t2) ; Get the command routine addresses. 16308 000003'01 202 02 0 00 000000* movem t2, pars3 ; Save into pars3. 16309 000004'01 554 01 0 02 000000 hlrz t1, (t2) ; Get the next level routine. 16310 000005'01 260 17 0 01 000000 call (t1) ; Call it. 16311 000006'01 263 17 0 00 000000 ret 16312 16313 K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 19:41 30-Mar-24 Page 4 K20IOC MAC 7-Jan-24 19:31 SET INPUT CASE parsing 16314 subttl SET INPUT CASE parsing 16315 16316 000007'02 000000 000000 %table(castab) ; Case table. 16317 000010'02 000000# 000000 %key2 , 0 16318 000017'03 151 147 156 157 162 16319 000011'02 000000# 000001 %key2 , 1 16320 000021'03 157 142 163 145 162 16321 000012'02 000000# 000001 %keyf3 , 1, cm%inv ;[212] Tom gets sleepy... 16322 000023'03 002000 000001 16323 000024'03 162 145 163 160 145 16324 000007'02 000003 000003 %tbend 16325 16326 chgsec(code,const) ;;FDB's go in const .psect 16327 000013'02 000000 000015' incfdb: flddb. .cmkey,,castab,,,incfd1 16328 000014'02 000000 000007' 16329 000015'02 010004 000000 incfd1: flddb. .cmcfm,,, 16330 000016'02 000000 000000 16331 000017'02 44 07 0 00 003535' 16332 retsec ;;Get back into code .psect 16333 cleans() ;;Clean out temporary symbols 16334 16335 000007'01 265 16 0 00 004003' .sinca: saveac ;[209] Need to remember function code 16336 000010'01 200 16 0 00 000000# guide ; SET INPUT CASE 16337 000011'01 260 17 0 00 000000* 16338 000020'02 000000000000# 16339 000000'04 146 157 162 040 155 16340 000012'01 201 01 0 00 000000# movei t1, incfdb 16341 000013'01 260 17 0 00 000001* call rfield ;[209] Parse a keyword or default 16342 16343 000014'01 135 05 0 00 004011' ldb q1, [pointr (.cmfnp(t3),cm%fnc)] ;[209] Pick up function code 16344 000015'01 302 05 0 00 000010 caie q1, .cmcfm ;[209] Want's default? 16345 000016'01 254 00 0 00 000021' ifskp. ;[209] That's easy, give him the default 16346 000017'01 400 02 0 00 000000 setz t2, ;[209] This is the parse value for "ignore" 16347 000020'01 254 00 0 00 000022' else. ;[209] Otherwise, handle the keyword 16348 000021'01 550 02 0 02 000000 hrrz t2, (t2) ; Get the value for the keyword (0 or 1). 16349 000022'01 endif. ;[209] 16350 000022'01 202 02 0 00 000000* movem t2, pars4 ; Save into pars4. 16351 16352 000023'01 306 05 0 00 000010 cain q1, .cmcfm ;[209] Was default requested? 16353 000024'01 263 17 0 00 000000 ret ;[209] It was, so don't reconfirm a confirmation 16354 000025'01 336 00 0 00 000000* skipn definf ; In DEFINE? 16355 000026'01 260 17 0 00 000000* confrm ; No, get confirmation. 16356 000027'01 263 17 0 00 000000 ret 16357 16358 K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 19:41 30-Mar-24 Page 5 K20IOC MAC 7-Jan-24 19:31 SET INPUT DEFAULT-TIMEOUT parsing 16359 subttl SET INPUT DEFAULT-TIMEOUT parsing 16360 16361 ; N.B., When chksec succeeds, it succeeds completely, putting the 16362 ; calculated millisecond value in pars4 and the floating point 16363 ; seconds in pars5. Both are displayed by SHOW INPUT because the 16364 ; floating point is easier to read, the milliseconds perhaps being 16365 ; of interest to debuggers, mathematicians and the curious. 16366 16367 chgsec(code,const) ;;Chained FDB's go in const .psect 16368 000021'02 015004 000024' indfdb: flddb. .cmflt,,,,,indfd1 16369 000022'02 000000 000000 16370 000023'02 44 07 0 00 003544' 16371 000024'02 010004 000000 indfd1: flddb. .cmcfm,,,,, 16372 000025'02 000000 000000 16373 000026'02 44 07 0 00 003553' 16374 retsec ;;Get back into code .psect 16375 cleans() ;;Keep listing tidy 16376 16377 000030'01 265 16 0 00 004003' .sindt: saveac ;[209] Need to remember function code 16378 000031'01 200 16 0 00 000000# guide 16379 000032'01 260 17 0 00 000011* 16380 000027'02 000000000000# 16381 000003'04 146 157 162 040 111 16382 000033'01 201 01 0 00 000000# movei t1, indfdb ; Various alteratives 16383 000034'01 260 17 0 00 000013* call rfield ; Try to get one of them 16384 16385 000035'01 135 05 0 00 004011' ldb q1, [pointr (.cmfnp(t3),cm%fnc)] ;[209] Pick up function code 16386 000036'01 302 05 0 00 000010 caie q1, .cmcfm ;[209] Want's default? 16387 000037'01 254 00 0 00 000042' ifskp. ;[209] That's easy, give him the default 16388 000040'01 205 02 0 00 204500 movx t2, <10.> ;[209] Ten seconds in floating point 16389 000041'01 254 00 0 00 000046' else. ;[209] Otherwise, better sanity check it 16390 000042'01 325 02 0 00 000046' ifl. t2 ;[209] Is the number deeply silly?? 16391 000043'01 200 01 0 00 000000# emsg ;[209] 16392 000044'01 104 00 0 00 000313 16393 000030'02 000000000000# 16394 000007'04 101 040 156 145 147 16395 000045'01 254 00 0 00 000000* jrst cmder1 ;[209] However, allow reparse 16396 000046'01 endif. ;[209] End non-default initial check 16397 000046'01 endif. ;[209] Either way, t2 has a floating point value 16398 16399 remark ;[212] When chksec works, it works completely 16400 000046'01 260 17 0 00 000000* call chksec ;[196] Ensure number is in correct range 16401 000047'01 254 00 0 00 000056' ifskp. ;[196] Check and convert OK? 16402 000050'01 306 05 0 00 000010 cain q1, .cmcfm ;[209] It did. Was default requested? 16403 000051'01 263 17 0 00 000000 ret ;[209] It was, so don't reconfirm a confirmation 16404 000052'01 336 00 0 00 000025* skipn definf ; In DEFINE? 16405 000053'01 260 17 0 00 000026* confrm ; No, get confirmation. 16406 000054'01 263 17 0 00 000000 ret ;[212] Either way, we're done 16407 000055'01 254 00 0 00 000061' else. ;[196] Otherwise, couldn't swallow something 16408 000056'01 200 01 0 00 000000# emsg ;[196] 16409 000057'01 104 00 0 00 000313 16410 000031'02 000000000000# 16411 000020'04 111 156 160 165 164 16412 000060'01 254 00 0 00 000045* jrst cmder1 ;[196] Allow reparse 16413 000061'01 endif. ;[196] End case checking and conversion K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 19:41 30-Mar-24 Page 5-1 K20IOC MAC 7-Jan-24 19:31 SET INPUT DEFAULT-TIMEOUT parsing 16414 16415 K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 19:41 30-Mar-24 Page 6 K20IOC MAC 7-Jan-24 19:31 SET INPUT SEARCH-DEFAULT parsing 16416 subttl SET INPUT SEARCH-DEFAULT parsing 16417 16418 ;[209] Begin code insertion 16419 16420 ; Calls the string parsing portion (.INPU1) to get the string and 16421 ; build the appropriate storage. Then hijacks the rest of the parse 16422 ; to get our semantic action routine called instead of having a value 16423 ; be set. 16424 ; 16425 ; Because of the design of the main parser to allow macro definitions 16426 ; and to be compliant with that paradigm, this involves an extra level 16427 ; of indirection, as seen below 16428 16429 000061'01 000000 000067' $sinsi: $sinse ; Indirect call 16430 16431 000062'01 260 17 0 00 000211' .sinse: call .inpu1 ; Parse just as if it were typed to INPUT 16432 000063'01 510 01 1 00 000000* hllz t1, @pars2 ; Load invoking keyword (SET INPUT) 16433 000064'01 541 01 0 00 000061' hrri t1, $sinsi ; Load indirected address of our semantic action 16434 000065'01 202 01 0 00 000063* movem t1, pars2 ; and take over the rest of the parse 16435 000066'01 263 17 0 00 000000 ret ; Return below 16436 16437 000067'01 265 16 0 00 004012' $sinse: saveac ; Needs some registers 16438 000070'01 333 05 0 00 000000* skiple q1, strc ; Did it get any characters? 16439 000071'01 254 00 0 00 000074' ifskp. ; No, so go with old reliable 16440 000072'01 402 00 0 00 000000# setzm indefw ; Flag no default (nothing for xblt.) 16441 000073'01 263 17 0 00 000000 ret ; Done 16442 000074'01 endif. 16443 16444 000074'01 200 02 0 00 000005 move t2, q1 ; Load character count 16445 000075'01 400 01 0 00 000000 setz t1, ; Cast positive word to signed long 16446 000076'01 235 01 0 00 000005 divi t1, ^d5 ; Convert to word count, five characters per word 16447 000077'01 322 02 0 00 000102' ifn. t2 ; Any remainder? 16448 000100'01 350 06 0 00 000001 aos q2, t1 ; Round up a word and store 16449 000101'01 254 00 0 00 000103' else. ; Otherwise, it fit exactly 16450 000102'01 200 06 0 00 000001 move q2, t1 ; So no need to round 16451 000103'01 endif. 16452 16453 remark t1, ; Still has word count 16454 000103'01 550 02 0 00 000000* hrrz t2, strptr ; Load whatever address the string pointer points to 16455 000104'01 201 03 0 00 000000# movei t3, indefs ; And storing it in our defaulting buffer 16456 000105'01 123 01 0 00 004022' xblt. t1 ; Tuck away for when needed 16457 16458 000106'01 124 05 0 00 000000# dmovem q1, indefc ; Store character and word count 16459 000107'01 263 17 0 00 000000 ret ; Finally done 16460 16461 ;[209] End code insertion 16462 K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 19:41 30-Mar-24 Page 7 K20IOC MAC 7-Jan-24 19:31 SET INPUT TIMEOUT-ACTION parsing 16463 subttl SET INPUT TIMEOUT-ACTION parsing 16464 16465 000032'02 000000 000000 %table(itatab) ; INPUT timeout action table 16466 000033'02 000000# 000000 %keyf3 , 0, cm%inv ;[186] Tom gets sleepy... 16467 000026'03 002000 000001 16468 000027'03 143 157 156 164 151 16469 000034'02 000000# 000000 %key2 , 0 16470 000031'03 160 162 157 143 145 16471 000035'02 000000# 000001 %key2 , 1 16472 000033'03 161 165 151 164 000 16473 000036'02 000000# 000001 %keyf3 , 1, cm%inv ;[186] Tom gets sleepy... 16474 000034'03 002000 000001 16475 000035'03 163 164 157 160 000 16476 000032'02 000004 000004 %tbend 16477 16478 chgsec(code,const) ;;FDB's go in const psect 16479 000037'02 000000 000041' intfdb: flddb. .cmkey,,itatab,,,intfd1 16480 000040'02 000000 000032' 16481 000041'02 010004 000000 intfd1: flddb. .cmcfm,,,,, 16482 000042'02 000000 000000 16483 000043'02 44 07 0 00 003563' 16484 retsec 16485 cleans() 16486 16487 000110'01 265 16 0 00 004003' .sinta: saveac ;[209] Need to remember function code 16488 000111'01 200 16 0 00 000000# guide 16489 000112'01 260 17 0 00 000032* 16490 000044'02 000000000000# 16491 000027'04 146 157 162 040 143 16492 000113'01 201 01 0 00 000000# movei t1, intfdb ;[209] Load parse fdb address 16493 000114'01 260 17 0 00 000034* call rfield ;[209] And see what he wants 16494 16495 000115'01 135 05 0 00 004011' ldb q1, [pointr (.cmfnp(t3),cm%fnc)] ;[209] Pick up function code 16496 000116'01 302 05 0 00 000010 caie q1, .cmcfm ;[209] Want's default? 16497 000117'01 254 00 0 00 000122' ifskp. ;[209] That's easy, give him the default 16498 000120'01 400 02 0 00 000000 setz t2, ;[209] This is the parse value for "proceed" 16499 000121'01 254 00 0 00 000123' else. ;[209] Otherwise, handle the keyword 16500 000122'01 550 02 0 02 000000 hrrz t2, (t2) ; Get the value for the keyword (0 or 1). 16501 000123'01 endif. ;[209] Either way, have something in t2 16502 16503 000123'01 202 02 0 00 000022* movem t2, pars4 ; Save into pars4. 16504 16505 000124'01 306 05 0 00 000010 cain q1, .cmcfm ;[209] Was default requested? 16506 000125'01 263 17 0 00 000000 ret ;[209] It was, so don't reconfirm a confirmation 16507 000126'01 336 00 0 00 000052* skipn definf ; In DEFINE? 16508 000127'01 260 17 0 00 000053* confrm ; No, get confirmation. 16509 000130'01 263 17 0 00 000000 ret 16510 16511 K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 19:41 30-Mar-24 Page 8 K20IOC MAC 7-Jan-24 19:31 INPUT command parsing 16512 subttl INPUT command parsing 16513 16514 ; The previous approach relied on defaulting a value to skip a field 16515 ; which limited the operation of question mark and escape recognition. 16516 ; The parsing logic now offers to directly go to textual input so that 16517 ; this option shows up in the question mark menu. 16518 ; 16519 ; It makes either learning the command or being reminded about it a 16520 ; more pleasing if not easier experience. It also cuts COMND% 16521 ; overhead down by a JSYS, which is probably not detectable in all but 16522 ; the most extreme of circumstances. 16523 ; 16524 ; This all works because we don't need to default the parse to know 16525 ; what the default values are. 16526 ; 16527 ; INPUT and OUTPUT were all revisited because making Kermit Batch 16528 ; compliant forced far greater usage for testing purposes. 16529 16530 remark Switch values for INPUT and TRANSMIT 16531 16532 000000 %eofsw==0 ;[229] We parsed the EOF switch 16533 000001 %silsw==1 ;[229] We parsed the 'silent' switch 16534 000002 %timsw==2 ;[229] We parsed the 'timeout' switch 16535 16536 ;[229] %table puts stuff in the correct .psect 16537 16538 000045'02 000000 000000 %table (inpswi) ;[229] The INPUT switch table 16539 000046'02 000000# 000001 %key2 , %silsw ;[229] Tells $input to shut up about matches 16540 000036'03 163 151 154 145 156 16541 000045'02 000001 000001 %tbend ;[229] End of table 16542 16543 chgsec(code,const) ;;Chained FDB's go in const 16544 000047'02 003000 000051' inpswf: flddb. .cmswi,,inpswi,,,inpfdb 16545 000050'02 000000 000045' 16546 000051'02 015004 000054' inpfdb: flddb. .cmflt,,^d10,,,txtfdb 16547 000052'02 000000 000012 16548 000053'02 44 07 0 00 003573' 16549 000054'02 010004 000057' txtfdb: flddb. .cmcfm,,,,,txtfd1 16550 000055'02 000000 000000 16551 000056'02 44 07 0 00 003603' 16552 000057'02 021004 000062' txtfd1: flddb. .cmqst,,,,,txtfd2 16553 000060'02 000000 000000 16554 000061'02 44 07 0 00 003611' 16555 000062'02 017004 000000 txtfd2: flddb. .cmtxt,,,,, 16556 000063'02 000000 000000 16557 000064'02 44 07 0 00 003621' 16558 retsec ;;Return to code .psect 16559 cleans() ;;Clean up the symbol table 16560 16561 000131'01 .input: entry .input ; Invoked from K20PAR 16562 000131'01 265 16 0 00 004003' saveac ;[212] Used for control flow 16563 remark buffer ;[209] Preserve buffer across calls!!! 16564 16565 000132'01 200 16 0 00 000000# guide 16566 000133'01 260 17 0 00 000112* K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 19:41 30-Mar-24 Page 8-1 K20IOC MAC 7-Jan-24 19:31 INPUT command parsing 16567 000065'02 000000000000# 16568 000033'04 164 151 155 145 157 16569 16570 000134'01 403 01 0 00 000002 .inpu0: setzb t1, t2 ;[209] Cons up some .chnuls 16571 000135'01 124 01 0 00 000000* dmovem t1, atmbuf ;[209] Give the atom buffer a good scrub a dub 16572 000136'01 201 01 0 00 000000# movei t1, inpswf ;[212] Pointer to full menu 16573 000137'01 260 17 0 00 000114* call rfield ;[190] Finally parse something 16574 000140'01 135 05 0 00 004011' ldb q1, [pointr (.cmfnp(t3),cm%fnc)] ;[212] Get function code. 16575 16576 000141'01 302 05 0 00 000003 caie q1, .cmswi ;[229] Did we get a switch? 16577 000142'01 254 00 0 00 000162' ifskp. ;[229] We did, handle it 16578 000143'01 415 16 0 00 000154' block. ;[229] Enter block for better control flow 16579 000144'01 261 17 0 00 000016 16580 000145'01 550 07 0 02 000000 hrrz q3, (t2) ;[229] Pick up the switch value 16581 000146'01 302 07 0 00 000001 caie q3, %silsw ;[229] Parsed the 'silent' switch? 16582 000147'01 254 00 0 00 000152' ifskp. ;[229] We did, so that should be easy enough 16583 000150'01 476 00 0 00 000000* setom pars8 ;[229] Just flag it in the parse block 16584 000151'01 254 00 0 00 000000* retskp ;[229] Return for next switch 16585 000152'01 endif. ;[229] End 'silent' switch case 16586 000152'01 263 17 0 00 000000 ret ;[229] Otherwise, some kind of bogus switch 16587 000153'01 263 17 0 00 000000 endbk. ;[229] End Block context 16588 000154'01 254 00 0 00 000157' ifskp. ;[229] Successful switch parse 16589 000155'01 254 00 0 00 000134' jrst .inpu0 ;[229] Go see if more switches (or device or file) 16590 000156'01 254 00 0 00 000162' else. ;[229] Otherwise, some kind of error 16591 000157'01 200 01 0 00 000000# emsg ;[229] This is an internal programming error 16592 000160'01 104 00 0 00 000313 16593 000066'02 000000000000# 16594 000035'04 125 156 153 156 157 16595 000161'01 254 00 0 00 000060* jrst cmder1 ;[229] However, allow reparse 16596 000162'01 endif. ;[229] End of switch block processing 16597 000162'01 endif. ;[229] End of .cmswi case 16598 16599 000162'01 302 05 0 00 000010 caie q1, .cmcfm ;[209] Confirmation? 16600 000163'01 254 00 0 00 000167' ifskp. ;[209] Yes, let's default everything 16601 000164'01 120 01 0 00 000000# dmove t1, indeft ;[209] Load default millisecond and floating values 16602 000165'01 124 01 0 00 000123* dmovem t1, pars4 ;[209] Store them as if they were parsed 16603 000166'01 254 00 0 00 000220' jrst .inpu2 ;[209] Go handle it as if we parsed this as a string 16604 000167'01 endif. ;[209] Either way, must 'recompile' the search 16605 16606 000167'01 302 05 0 00 000015 caie q1, .cmflt ;[212] Parsed a floating number? 16607 000170'01 254 00 0 00 000206' ifskp. ;[212] Yes, check it 16608 000171'01 325 02 0 00 000176' ifl. t2 ;[212] Is the number in the right range? 16609 000172'01 200 01 0 00 000000# emsg ;[212] Yah silly!! 16610 000173'01 104 00 0 00 000313 16611 000067'02 000000000000# 16612 000042'04 101 040 156 145 147 16613 000174'01 254 00 0 00 000161* jrst cmder1 ;[212] Allow reparse 16614 000175'01 254 00 0 00 000205' else. 16615 000176'01 260 17 0 00 000046* call chksec ;[212] Ensure number is in correct range 16616 000177'01 254 00 0 00 000202' ifskp. ;[212] Check and convert OK? Then side-effect variables 16617 000200'01 254 00 0 00 000211' jrst .inpu1 ;[212] Yes, then carry on to parse a string to find 16618 000201'01 254 00 0 00 000205' else. ;[212] Otherwise, couldn't swallow something 16619 000202'01 200 01 0 00 000000# emsg ;[212] 16620 000203'01 104 00 0 00 000313 16621 000070'02 000000000000# K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 19:41 30-Mar-24 Page 8-2 K20IOC MAC 7-Jan-24 19:31 INPUT command parsing 16622 000052'04 111 156 160 165 164 16623 000204'01 254 00 0 00 000174* jrst cmder1 ;[212] Allow reparse 16624 000205'01 endif. ;[212] End case checking and conversion 16625 000205'01 endif. ;[212] End case special messaging check 16626 remark ;[212] Falls out to parse txtfdb 16627 000205'01 254 00 0 00 000211' else. ;[212] Else never got a number 16628 000206'01 120 01 0 00 000000# dmove t1, indeft ;[212] Load default millisecond and floating values 16629 000207'01 124 01 0 00 000165* dmovem t1, pars4 ;[212] Store them as if they were parsed 16630 000210'01 254 00 0 00 000220' jrst .inpu2 ;[212] Go handle the string we parsed 16631 000211'01 endif. ;[212] End case parsed a floating nuber (or not) 16632 16633 ;[208] Originally shut off indirection, but since quoted strings allow us 16634 ; to put in an at-sign (@) as well as escape sequences, this was 16635 ; removed to allow backward compatibility with any take files which 16636 ; rely on this. 16637 16638 000211'01 200 16 0 00 000000# .inpu1: guide ;[190] Guide us to type the next thing 16639 000212'01 260 17 0 00 000133* 16640 000071'02 000000000000# 16641 000061'04 163 164 162 151 156 16642 000213'01 403 01 0 00 000002 setzb t1, t2 ;[209] Cons up some .chnuls 16643 000214'01 124 01 0 00 000135* dmovem t1, atmbuf ;[209] Give the atom buffer a good scrub a dub 16644 000215'01 201 01 0 00 000000# movei t1, txtfdb ;[209] Parse some kind of input text 16645 000216'01 260 17 0 00 000137* call rfield ;[209] Get an input string 16646 000217'01 135 05 0 00 004011' ldb q1, [pointr (.cmfnp(t3),cm%fnc)] ;[212] Get function code again 16647 16648 000220'01 .inpu2: remark ;[209] Here if .cmcfm was only thing typed 16649 000220'01 302 05 0 00 000010 caie q1, .cmcfm ;[209] Confirmation? 16650 000221'01 254 00 0 00 000232' ifskp. ;[209] Yes, let's default the search 16651 000222'01 333 01 0 00 000000# skiple t1, indefw ;[209] But!! Do we have a default string? 16652 000223'01 254 00 0 00 000227' ifskp. ;[209] No, so use wired default 16653 000224'01 205 01 0 00 064240 movx t1, < byte (7) .chcrt, .chlfd > ;[209] Which fits in 18 bits 16654 000225'01 202 01 0 00 000214* movem t1, atmbuf ;[209] Store NUL terminated bare CR-LF sequence 16655 000226'01 254 00 0 00 000231' else. ;[209] Otherwise, have a default, so drop that in 16656 dmove t2, [ indefs ;[209] Load address of default expanded string 16657 000227'01 120 02 0 00 004023' atmbuf] ;[209] Load address of match string buffer 16658 000230'01 123 01 0 00 004022' xblt. t1 ;[209] Stomp into place 16659 000231'01 endif. ;[209] End case hardwired default 16660 000231'01 202 05 0 00 000003* movem q1, pars3 ;[209] Let any caller know what we're doing 16661 000232'01 endif. ;[209] Continue with atom buffer properly conditioned 16662 16663 000232'01 403 01 0 00 000002 setzb t1, t2 ;[209] Cons up some NUL's 16664 000233'01 124 01 0 00 000000* dmovem t1, strbuf ;[209] Get string match buffer into a known state 16665 000234'01 200 02 0 00 004025' move t2,[point 7,atmbuf] ;[209] Let's see what's in the atom buffer 16666 000235'01 134 01 0 00 000002 ildb t1, t2 ;[209] Get the first byte 16667 000236'01 322 01 0 00 000244' ifn. t1 ;[209] Only if not .CHNUL 16668 000237'01 260 17 0 00 001236' call bsrchs ;[209] Build a search string from it 16669 000240'01 254 00 0 00 000204* jrst cmder1 ;[209] Failed, allow reparse 16670 000241'01 336 00 0 00 000233* skipn strbuf ;[209] Did anything go in there?? 16671 000242'01 254 00 0 00 000244' anskp. ;[209] Nope, maybe was a "\0" or some such 16672 000243'01 254 00 0 00 000245' else. ;[209] Otherwise, some bad thing 16673 000244'01 402 00 0 00 000070* setzm strc ;[209] We surely have no characters to match 16674 000245'01 endif. ;[209] Otherwise, not searching (sigh) 16675 000245'01 402 00 0 00 000000* setzm pars6 ;[209] Say we're handling the control-C 16676 000246'01 306 05 0 00 000010 cain q1, .cmcfm ;[209] Have we confirmed our selection? K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 19:41 30-Mar-24 Page 8-3 K20IOC MAC 7-Jan-24 19:31 INPUT command parsing 16677 000247'01 254 00 0 00 000253' ifskp. ;[209] Don't reconfirm, that's confusing 16678 000250'01 332 00 0 00 000126* skipe definf ;[209] BUT!! Are we defining a macro? 16679 000251'01 254 00 0 00 000253' anskp. ;[209] We are, let .define confirm for us 16680 000252'01 260 17 0 00 000127* confrm ;[209] Tie off the line 16681 000253'01 endif. ;[209] 16682 000253'01 263 17 0 00 000000 ret 16683 K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 19:41 30-Mar-24 Page 9 K20IOC MAC 7-Jan-24 19:31 INPUT command semantic action 16684 subttl INPUT command semantic action 16685 16686 ;N.B., Note the reordering of the timing JSYi in the routine. The 16687 ; purpose is to prevent us from getting caught with some stray 16688 ; TIMER% interrupt. So we clear timers BEFORE activating the timer 16689 ; channel and disable the channel BEFORE clearing any timers. 16690 16691 000254'01 $input: entry $input ;[194] 16692 16693 000254'01 337 02 0 00 000207* skipg t2, pars4 ;[212] Integer milliseconds 16694 000255'01 254 00 0 00 000262' ifskp. ;[212] Wants time outs, so set them 16695 000256'01 332 00 0 00 000245* skipe pars6 ;[229] Did we already do this? 16696 000257'01 254 00 0 00 000262' anskp. ;[229] Yes, so don't stomp TRANSMIT 16697 000260'01 201 01 0 00 000543' movei t1, looptm ;[209] Go to loop time out exit 16698 000261'01 260 17 0 00 000000* call timeon ;[209] Set the timer for it 16699 000262'01 endif. ;[212] 16700 16701 ; Condition line, set up Control-C trap 16702 16703 000262'01 332 00 0 00 000256* $inp4a: ifme. pars6 ;[209] Are we handling the ^C? 16704 000263'01 254 00 0 00 000266' 16705 000264'01 260 17 0 00 000000* call ccon ; Turn on ^C trap. 16706 000265'01 254 00 0 00 000410' jrst $inpuy ; If ^C typed, go to this place. 16707 000266'01 endif. ;[209] End case possible ^C override 16708 000266'01 332 00 0 00 000000* ifme. vtermf ;[194] Calls only make sense for terminals 16709 000267'01 254 00 0 00 000276' 16710 000270'01 332 00 0 00 000262* skipe pars6 ;[209] Is somebody else doing this? 16711 000271'01 254 00 0 00 000277' jrst $inpu5 ;[209] Yes, so leave the terminal alone 16712 000272'01 260 17 0 00 000000* call dobits ; Condition the line for i/o. 16713 000273'01 263 17 0 00 000000 ret ; Pass along any failure. 16714 000274'01 260 17 0 00 000000* call ttyob ; Put TTY in binary mode for output only. 16715 remark ;[209] Fall through to legacy code 16716 000275'01 254 00 0 00 000277' else. ;[209] Otherwise, use enhanced network I/O 16717 000276'01 254 00 0 00 000432' callret netins ;[209] Dispatch to Network Input Matcher 16718 000277'01 endif. ;[186] Otherwise, MTOPR%'s will blow up 16719 16720 000277'01 200 04 0 00 004026' $inpu5: move t4, [point 7, strbuf] ; Point to the search string. 16721 16722 000300'01 336 00 0 00 000244* $inpu6: skipn strc ; Is there a search string? 16723 000301'01 254 00 0 00 000304' jrst $inpu7 ; No, just go forever. 16724 000302'01 134 03 0 00 000004 ildb t3, t4 ; Get a character from search string. 16725 000303'01 322 03 0 00 000411' jumpe t3, $inpux ; If no more, then success. 16726 ;... K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 19:41 30-Mar-24 Page 10 K20IOC MAC 7-Jan-24 19:31 INPUT command semantic action 16727 16728 ;...$INPUT, cont'd 16729 16730 ; Get & echo a character, compare with current position in search string. 16731 16732 ;[204] Maybe rethink this BIN% loop, it's got a high JSYS overhead 16733 ; In other words, when should we call netins? 16734 16735 000304'01 337 01 0 00 000000* $inpu7: skipg t1, netjfn ;[186] Now get a character from the line. 16736 000305'01 200 01 0 00 000000* move t1, ttyjfn ;[186] Not network, using local 16737 000306'01 400 02 0 00 000000 setz t2, 16738 000307'01 104 00 0 00 000050 BIN 16739 000310'01 320 12 0 00 000312' ifje. r ;[186] Failed?? 16740 000311'01 254 00 0 00 000321' 16741 000312'01 302 01 0 00 600220 caie t1, IOX4 ;[186] Unexpected end of file? 16742 000313'01 334 00 0 00 000000 %ermsg (,$inpux) ;[186] Something else, so just drop dead 16743 000314'01 254 00 0 00 000320' 16744 000315'01 265 01 0 00 000000* 16745 000316'01 000000 000000 16746 000317'01 254 00 0 00 000411' 16747 000320'01 254 00 0 00 000345' jrst $inpu9 ;[186] Handle like a time out 16748 000321'01 endif. ;[186] 16749 000321'01 405 02 0 00 000177 andi t2, ^o177 ; Strip any parity. 16750 000322'01 332 00 0 00 000150* ifme. pars8 ;[229] Only if not /SILENT 16751 000323'01 254 00 0 00 000326' 16752 000324'01 200 01 0 00 000002 move t1, t2 ; Echo the character. 16753 000325'01 104 00 0 00 000074 PBOUT 16754 000326'01 endif. ;[229] 16755 16756 000326'01 337 01 0 00 000000* skipg t1, sesjfn ;[195] Session logging? 16757 000327'01 254 00 0 00 000334' ifskp. ;[195] Some kind of JFN 16758 000330'01 336 00 0 00 000000* skipn sesflg ;[195] Is logging active? 16759 000331'01 254 00 0 00 000334' anskp. ;[195] No, so don't log it 16760 000332'01 104 00 0 00 000051 BOUT ; Yes, record the character in the log. 16761 000333'01 320 12 0 00 000334' erjmpr .+1 ;[195] Catch and ignore error 16762 000334'01 endif. ;[195] 16763 16764 000334'01 332 00 0 00 000000# ifme. incase ;[194] Case-INsensitive compare? 16765 000335'01 254 00 0 00 000342' 16766 000336'01 301 02 0 00 000141 cail t2, "a" ; No, is this a lower case letter? 16767 000337'01 303 02 0 00 000172 caile t2, "z" 16768 000340'01 254 00 0 00 000342' anskp. ;[194] Not lower case 16769 000341'01 620 02 0 00 000040 txz t2, 40 ; Yes, convert to upper. 16770 000342'01 endif. ;[194] 16771 16772 000342'01 316 02 0 00 000003 camn t2, t3 ; Compare OK? 16773 000343'01 254 00 0 00 000300' jrst $inpu6 ; Yes, get next from string and comm line. 16774 000344'01 254 00 0 00 000277' jrst $inpu5 ; No, rewind search string, get next from line. 16775 16776 ; Come here upon input timeout. 16777 16778 000345'01 332 00 0 00 000000# $inpu9: ifme. intima ;[187] Proceeding? 16779 000346'01 254 00 0 00 000353' 16780 txmsg < 16781 000347'01 200 01 0 00 000000# %KERMIT-20: INPUT timed out looking for "> ;[187] K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 19:41 30-Mar-24 Page 10-1 K20IOC MAC 7-Jan-24 19:31 INPUT command semantic action 16782 000350'01 104 00 0 00 000076 16783 000351'01 320 12 0 00 000352' 16784 000072'02 000000000000# 16785 000065'04 015 012 045 113 105 16786 000352'01 254 00 0 00 000355' else. ;[187] Otherwise an error, so not proceeding 16787 000353'01 200 01 0 00 000000# emsg ;[187] ;" 16788 000354'01 104 00 0 00 000313 16789 000073'02 000000000000# 16790 000076'04 113 105 122 115 111 16791 000355'01 endif. ;[187] Error message if quitting (for batch) 16792 16793 000355'01 561 01 0 00 000241* hrroi t1, strbuf ; Tell what string we couldn't find. 16794 000356'01 104 00 0 00 000076 PSOUT 16795 16796 000357'01 332 00 0 00 000000# ifme. intima ;[187] Proceeding? 16797 000360'01 254 00 0 00 000365' 16798 txmsg <", proceeding... 16799 000361'01 200 01 0 00 000000# > ;" ;[187] Say what we're doing, proceeding 16800 000362'01 104 00 0 00 000076 16801 000363'01 320 12 0 00 000364' 16802 000074'02 000000000000# 16803 000107'04 042 054 040 160 162 16804 16805 000364'01 254 00 0 00 000411' jrst $inpux ; Proceeding, just exit from the INPUT command. 16806 000365'01 endif. ;[187] 16807 16808 remark ;[187] Otherwise, not going any further 16809 000365'01 200 01 0 00 000000# txmsg <", quitting > ;" ;[187] ... quitting. 16810 000366'01 104 00 0 00 000076 16811 000367'01 320 12 0 00 000370' 16812 000075'02 000000000000# 16813 000113'04 042 054 040 161 165 16814 16815 000370'01 337 02 0 00 000000* skipg t2, takjfn ;[209] Quitting, are we in a file? 16816 000371'01 254 00 0 00 000406' ifskp. ;[209] We are, so blat and close it 16817 000372'01 201 01 0 00 000101 movei t1, .priou ;[209] No matter what, all output to terminal 16818 000373'01 621 02 0 00 777777 tlz t2, -1 ;[209] Shut off any GTJFN% flags 16819 000374'01 302 02 0 00 377777 caie t2, .nulio ;[209] Just testing? 16820 000375'01 254 00 0 00 000403' ifskp. ;[209] Yes, so special case that 16821 000376'01 120 02 0 00 000000* dmove t2, nul4 ;[209] Load counted special string 16822 000377'01 400 04 0 00 000000 setz t4, ;[209] Just in case 16823 000400'01 104 00 0 00 000053 SOUT% ;[209] Write the NUL: device name 16824 000401'01 320 12 0 00 000402' erjmpr .+1 ;[209] Catch and quietly ignore error 16825 000402'01 254 00 0 00 000406' else. ;[209] Otherwise, a bona fide JFN 16826 000403'01 403 03 0 00 000004 setzb t3, t4 ;[209] No flags and no prefix (whatever that is) 16827 000404'01 104 00 0 00 000030 JFNS% ;[209] Type the actual file name 16828 000405'01 320 12 0 00 000406' erjmpr .+1 ;[209] Catch and quietly ignore error 16829 000406'01 endif. ;[209] End typing some kind of file name 16830 000406'01 endif. 16831 16832 000406'01 561 01 0 00 000000* hrroi t1,crlf ;[209] Tie off the line 16833 000407'01 104 00 0 00 000076 PSOUT% 16834 16835 000410'01 260 17 0 00 000000* $inpuy: call popjfn ; Pop the TAKE file JFN from the TAKE stack. 16836 K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 19:41 30-Mar-24 Page 10-2 K20IOC MAC 7-Jan-24 19:31 INPUT command semantic action 16837 ; Exit thru here, turning off timer, restore line to previous condition. 16838 16839 000411'01 332 00 0 00 000270* $inpux: ifme. pars6 ;[209] Am I handling the ^C? 16840 000412'01 254 00 0 00 000420' 16841 000413'01 260 17 0 00 000000* call ccoff2 ; Turn off ^C trap. 16842 000414'01 332 00 0 00 000266* ifme. vtermf ;[186] Calls only make sense if not virtual 16843 000415'01 254 00 0 00 000420' 16844 000416'01 260 17 0 00 000000* call unbits ; Restore the line 16845 000417'01 260 17 0 00 000000* call ttyou ; Restore controlling tty output. 16846 000420'01 endif. ;[186] Otherwise, MTOPR%'s will break 16847 000420'01 endif. ;[209] End case possible ^C override 16848 16849 000420'01 337 00 0 00 000254* skipg pars4 ;[212] Integer millisecond sleep? 16850 000421'01 254 00 0 00 000423' ifskp. ;[212] Yes, shut off the timers, etc 16851 000422'01 260 17 0 00 000000* call timdel ;[209] Whack any future timers 16852 000423'01 endif. ;[212] End case positive intervale 16853 16854 000423'01 332 00 0 00 000411* skipe pars6 ;[209] Repeated internal call from $TRANS? 16855 000424'01 263 17 0 00 000000 ret ;[209] We're done 16856 16857 000425'01 $inpcl: remark ;[209] Have to clean up post $input 16858 000425'01 403 01 0 00 000002 setzb t1, t2 ;[209] Cons up a double word of zeros 16859 000426'01 124 01 0 00 000300* dmovem t1, strc ;[209] No string, so no length 16860 remark strptr ;[209] Not pointing anywhere 16861 000427'01 124 01 0 00 000355* dmovem t1, strbuf ;[209] Stomp a bit of the search buffer and 16862 000430'01 124 01 0 00 000000* dmovem t1, strbf2 ;[209] also a bit of the translation buffer 16863 remark buffer ;[209] Preserve buffer across calls 16864 16865 000431'01 263 17 0 00 000000 ret 16866 16867 K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 19:41 30-Mar-24 Page 11 K20IOC MAC 7-Jan-24 19:31 Network Input Searcher 16868 subttl Network Input Searcher 16869 16870 ;[209] Begin Code Addition 16871 16872 ; Expects bsrchs to have been called for a search structure 16873 ; inpcnt and inpptr to have been kept up to date from last call 16874 16875 000432'01 265 16 0 00 004027' netins: saveac 16876 16877 000433'01 120 05 0 00 000000# dmove q1, inpcnt ; Load current place in input buffer 16878 000434'01 337 07 0 00 000304* skipg q3, netjfn ; Assume network (which can be a physical line) 16879 000435'01 200 07 0 00 000305* move q3, ttyjfn ; Not network, so using login terminal 16880 000436'01 621 07 0 00 777777 tlz q3, -1 ; Either way, no flags 16881 16882 000437'01 do. ; Enter loop context 16883 000437'01 305 05 0 00 005000 caige q1, strblc ; First of all, can we swallow anything else? 16884 000440'01 254 00 0 00 000451' ifskp. ; Nope, try to drain a little off 16885 000441'01 307 05 0 00 000000 caig q1,0 ; BUT!! Nothing read? 16886 000442'01 254 00 0 00 000451' anskp. ; Then go read something 16887 000443'01 200 10 0 00 000005 move q4, q1 ; Save current length 16888 000444'01 260 17 0 00 000563' call matchs ; See if we can match anything 16889 000445'01 334 00 0 00 000000 skipa ; Didn't... 16890 000446'01 254 00 0 00 000537' exit. ; Did!!!!! 16891 000447'01 301 05 0 00 000010 cail q1, q4 ; Was this helpful in any way? 16892 000450'01 254 00 0 00 000545' jrst loopov ; No, we're wedged and can't go any futher.. 16893 000451'01 endif. 16894 000451'01 415 16 0 00 000462' block. ; Kind of clunky, but needed for control flow 16895 000452'01 261 17 0 00 000016 16896 000453'01 do. ; Enter inner loop 16897 000453'01 322 05 0 00 000000* jumpe q1, R ; If nothing read, break out 16898 000454'01 315 05 0 00 000426* camge q1, strc ; Do we have enough to match? 16899 000455'01 263 17 0 00 000000 ret ; No, then get out of loop and block context 16900 000456'01 260 17 0 00 000563' call matchs ; See if we can match anything 16901 000457'01 254 00 0 00 000453' loop. ; Nope, see if we can try again 16902 000460'01 254 00 0 00 000151* retskp ; We did, so pass that on 16903 000461'01 enddo. ; Exit loop lexical context 16904 000461'01 263 17 0 00 000000 endbk. ; Exit Block Context 16905 000462'01 254 00 0 00 000464' ifskp. ; Handle +2 from inner loop 16906 000463'01 254 00 0 00 000537' exit. ; Exit out main loop success!! 16907 000464'01 endif. 16908 000464'01 200 01 0 00 000007 move t1, q3 ; Load JFN to read from 16909 000465'01 104 00 0 00 000050 BIN% ; Wait for something from somebody 16910 000466'01 320 12 0 00 000470' %jserr (,loopio) ;[186] No, die. 16911 000467'01 254 00 0 00 000473' 16912 000470'01 265 01 0 00 000315* 16913 000471'01 000000000000# 16914 000472'01 254 00 0 00 000541' 16915 000116'04 103 157 165 154 144 16916 000473'01 350 00 0 00 000000* aos nbict ;[204] Count a network BIN% 16917 000474'01 271 05 0 00 000001 addi q1, ^d1 ; Count a character to do 16918 000475'01 136 02 0 00 000006 idpb t2, q2 ; Drop into the output buffer 16919 000476'01 260 17 0 00 000000* call clrest ; Find out how much, if anything, remains 16920 000477'01 254 00 0 00 000541' jrst loopio ; Already complained, so break loop context 16921 000500'01 201 03 0 00 005000 movei t3, strblc ; Load maximum buffer length 16922 000501'01 274 03 0 00 000005 sub t3, q1 ; Subtract off what is already in there K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 19:41 30-Mar-24 Page 11-1 K20IOC MAC 7-Jan-24 19:31 Network Input Searcher 16923 000502'01 274 03 0 00 000001 sub t3, t1 ; Next, subtract how much we could use 16924 000503'01 305 03 0 00 000000 caige t3, 0 ; Not enough buffer space? 16925 000504'01 270 01 0 00 000003 add t1, t3 ; 'Subtract' off the excess (add negative) 16926 000505'01 323 01 0 00 000532' ifg. t1 ; OK, is there anything for us to read? 16927 000506'01 270 05 0 00 000001 add q1, t1 ; Accumulate in total 16928 000507'01 313 01 0 00 000000* camle t1, nsimx ; Smaller than biggest? 16929 000510'01 202 01 0 00 000507* movem t1, nsimx ; Nope, we have a new winner 16930 000511'01 272 01 0 00 000000* addm t1, nsitc ; Update Network SIN% total characters read 16931 000512'01 350 00 0 00 000000* aos nsici ; Update Network SIN%'s Issued 16932 000513'01 210 03 0 00 000001 movn t3, t1 ; Load exact amount to read 16933 000514'01 200 01 0 00 000007 move t1, q3 ; Reload the JFN 16934 000515'01 200 02 0 00 000006 move t2, q2 ; Keep reading into the buffer 16935 000516'01 104 00 0 00 000052 SIN% ; Get that data! 16936 000517'01 320 12 0 00 000521' ifje. r ; Failed?? 16937 000520'01 254 00 0 00 000531' 16938 000521'01 200 06 0 00 000002 move q2, t2 ; Update what we did read 16939 000522'01 270 05 0 00 000003 add q1, t3 ; 'Subtract' from used (t3 is negative) 16940 000523'01 272 03 0 00 000511* addm t3, nsitc ; Correct Network SIN% total characters NOT read 16941 000524'01 334 00 0 00 000000 %ermsg (,loopio) ; No, go drop dead 16942 000525'01 254 00 0 00 000531' 16943 000526'01 265 01 0 00 000470* 16944 000527'01 000000000000# 16945 000530'01 254 00 0 00 000541' 16946 000125'04 103 157 165 154 144 16947 000531'01 endif. 16948 000531'01 200 06 0 00 000002 move q2, t2 ; Keep track of where we are in the buffer 16949 000532'01 endif. ; End data read 16950 000532'01 315 05 0 00 000454* camge q1, strc ; Do we have enough to match? 16951 000533'01 254 00 0 00 000437' loop. ; No, get some more goodies 16952 000534'01 260 17 0 00 000563' call matchs ; See if we can match the search string 16953 000535'01 254 00 0 00 000437' loop. ; Didn't match 16954 000536'01 254 00 0 00 000537' exit. ; We did, so we're done 16955 000537'01 enddo. ; Exit loop context 16956 16957 000537'01 124 05 0 00 000000# dmovem q1, inpcnt ; Store updated buffer count and position 16958 000540'01 254 00 0 00 000411' jrst $inpux ; Success!!! 16959 K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 19:41 30-Mar-24 Page 12 K20IOC MAC 7-Jan-24 19:31 Various loop error handlers 16960 subttl Various loop error handlers 16961 16962 000541'01 loopio: remark ; Here for an I/O error 16963 000541'01 124 05 0 00 000000# dmovem q1, inpcnt ; Store updated buffer count and position 16964 000542'01 254 00 0 00 000410' jrst $inpuy ; Pop any take JFN's, disable ^C, timers, Etc. 16965 16966 000543'01 looptm: remark ; Here for assumed timer errors 16967 000543'01 124 05 0 00 000000# dmovem q1, inpcnt ; Store updated buffer count and position 16968 000544'01 254 00 0 00 000345' jrst $inpu9 16969 16970 16971 remark Common Buffer overflow handler 16972 16973 000545'01 loopov: remark ;[209] Here for buffer buffer full 16974 000545'01 124 05 0 00 000000# dmovem q1, inpcnt ; Store updated buffer count and position 16975 000546'01 334 01 0 00 000000# ermsg%(,$inpux) ;[209] Gronk on buffer overflow 16976 000547'01 254 00 0 00 000553' 16977 000550'01 202 01 0 00 000000* 16978 000551'01 104 00 0 00 000313 16979 000552'01 254 00 0 00 000411' 16980 000076'02 000000000000# 16981 000133'04 113 105 122 115 111 16982 16983 K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 19:41 30-Mar-24 Page 13 K20IOC MAC 7-Jan-24 19:31 Match String Overview and String Instructions 16984 subttl Match String Overview and String Instructions 16985 16986 ; The purpose of the routine below is to change the former search 16987 ; search paradigm from a byte at a time comparison to support a 16988 ; buffered approach while also benefiting from the use of string 16989 ; instructions. 16990 ; 16991 ; It is not the overhead of a ildb/idpb loop that is being saved so 16992 ; much as the JSYS overhead. For every character, both a BIN% and a 16993 ; BOUT% were needed, which involves the maximum context switching 16994 ; overhead with all that implies. 16995 ; 16996 ; Here, the maximum JSYi that will be executed for any read and print 16997 ; will be 4 of them: BIN%, SIBE%, SIN% and SOUT% (both counted for 16998 ; speed). This means that if you read more than two characters, you 16999 ; are going to win. 17000 ; 17001 ; This code is driven by the main loop in netins, which reads as much 17002 ; input as it can get until the threshold of the length of the search 17003 ; string is hit. At that point, this routine is invoked to see if 17004 ; there is a match. 17005 ; 17006 ; Simply put, the code uses a MOVST to trigger on the first character 17007 ; of the string. If the character is never hit, then the search 17008 ; criteria are not met and we return +1. In this case, we have 17009 ; effectedly searched through the entire contents of the buffer and 17010 ; need merely print and reset it via the ntriger exit. If the 17011 ; character is hit, then a CMPSE instruction is used to determine if 17012 ; the rest of the string matches. 17013 ; 17014 ; Whatever does not match is printed and removed from the network 17015 ; buffer. This operation is known here as a 'pull up' and is done 17016 ; with a MOVSLJ. 17017 ; 17018 ; Some of the extra code here is to handle caseless compares. Because 17019 ; the string compare instructions are case sensitive, we have to 17020 ; uppercase everythingt we compare first. 17021 ; 17022 ; However, the bulk of the code is to handle buffer management and, in 17023 ; particular, all the edge cases: single character search strings, a 17024 ; single character the buffer, matching on the last character, but 17025 ; still having remaining characters to compare, Etc. 17026 17027 remark ; Various Extended Instructions 17028 17029 000553'01 015 00 0 00 000000# m1stch: movst 0, sertab ; Use constructed trigger table 17030 000554'01 000000 000000 .chnul ; No fill, acually 17031 17032 000555'01 016 00 0 00 000000 movsup: movslj 0,0 ; Move string left justified (fastest) 17033 000556'01 000000 000000 .chnul ; Fill character (never used in this case) 17034 17035 000557'01 cmprmn: intern cmprmn ; Also used in k20tim to double check parity 17036 000557'01 002 00 0 00 000000 cmpse 0,0 ; Compare and skip if equal 17037 000560'01 000000 000000 .chnul ; Fill character 1 17038 000561'01 000000 000000 .chnul ; Fill character 2 K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 19:41 30-Mar-24 Page 13-1 K20IOC MAC 7-Jan-24 19:31 Match String Overview and String Instructions 17039 17040 000562'01 44 07 0 00 000430* str2bp: point 7, strbf2 ; Handy place to dump translated data 17041 K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 19:41 30-Mar-24 Page 14 K20IOC MAC 7-Jan-24 19:31 Match String Routine 17042 subttl Match String Routine 17043 17044 ; Entry 17045 ; 17046 ; q1/ Count of characters in network buffer 17047 ; q2/ Pointer into network buffer 17048 ; 17049 ; Exit: 17050 ; 17051 ; +1/ Didn't find the search string 17052 ; +2/ Successfully found the first instance of it (there may be others) 17053 ; 17054 ; In both cases, return with: 17055 ; 17056 ; q1/ Updated count of characters in network buffer 17057 ; q2/ Updated pointer to the end network buffer 17058 ; 17059 ; These are are either directly returned by matchs or indirectly by 17060 ; ntrigr. 17061 ; 17062 ; Note, we always have to back the source pointer up before the match 17063 ; character so that we can match the entire string. If we've skipped 17064 ; the match character and just compare the suffix string (like we used 17065 ; to do...) and it is the last thing in the buffer, then we will do 17066 ; the wrong thing after we come back from refilling the buffer (like 17067 ; we did in an earlier version...) 17068 ; 17069 ; To do: Possibly some of the exit code is really replicated. Maybe 17070 ; see what could be reasonably combined. On the other hand, it 17071 ; finally works... 17072 ; 17073 ; If doing an exact match, could bum the second MOVST which is just 17074 ; then a MOVSLJ. Would need to fix up the linkages. And it 17075 ; finally works... 17076 17077 000563'01 327 05 0 00 000572' matchs: ifle. q1 ; First of all, is there anything to do? 17078 000564'01 334 01 0 00 000000# ermsg% (,r) ; Program logic error 17079 000565'01 254 00 0 00 000571' 17080 000566'01 202 01 0 00 000550* 17081 000567'01 104 00 0 00 000313 17082 000570'01 254 00 0 00 000453* 17083 000077'02 000000000000# 17084 000142'04 113 105 122 115 111 17085 17086 000571'01 254 00 0 00 000600' else. ; Otherwise, do we have enough to chew on? 17087 000572'01 315 05 0 00 000532* camge q1, strc ; Enough to match our search string? 17088 000573'01 334 01 0 00 000000# ermsg% (,r) ; Another bogon 17089 000574'01 254 00 0 00 000600' 17090 000575'01 202 01 0 00 000566* 17091 000576'01 104 00 0 00 000313 17092 000577'01 254 00 0 00 000570* 17093 000100'02 000000000000# 17094 000155'04 113 105 122 115 111 17095 17096 000600'01 endif. ; OK, so let's try to do something useful K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 19:41 30-Mar-24 Page 14-1 K20IOC MAC 7-Jan-24 19:31 Match String Routine 17097 17098 000600'01 265 16 0 00 004041' saveac 17099 000601'01 120 07 0 00 000005 dmove q3, q1 ; Save current network buffer length and position 17100 17101 000602'01 210 02 0 00 000007 movn t2, q3 ; Load negative count of buffer contents 17102 000603'01 133 02 0 00 000010 adjbp t2, q4 ; Back source up to beginning of network data 17103 000604'01 200 11 0 00 000002 move q5, t2 ; Save beginning of network data for later 17104 000605'01 332 00 0 00 000572* ifme. strc ; But!! Anything to search for?? 17105 000606'01 254 00 0 00 000612' 17106 000607'01 400 01 0 00 000000 setz t1, ; Fine, say we looked through all of it 17107 000610'01 260 17 0 00 001026' call ntrigr ; Go ditch all of it 17108 000611'01 254 00 0 00 000460* retskp ; Return success; matching everying ... 17109 000612'01 endif. 17110 17111 000612'01 200 01 0 00 000007 move t1, q3 ; Length we'll look at; total contents 17112 000613'01 200 04 0 00 000001 move t4, t1 ; Force equal lengths so no filling occurs 17113 000614'01 200 14 0 00 000001 move p4, t1 ; Save this length for later 17114 000615'01 200 05 0 00 000562' move q1, str2bp ; Destination is the translation buffer 17115 000616'01 403 03 0 00 000006 setzb t3, q2 ; Force section local pointers 17116 000617'01 621 01 0 00 700000 txz t1, S!N!M ; No need to translate until we hit the match 17117 000620'01 123 01 0 00 000553' extend t1, m1stch ; Trigger on MOVST termination code 17118 000621'01 600 00 0 00 000000 nop ; Ignore any skip (which should never happen) 17119 000622'01 120 12 0 00 000001 dmove p2, t1 ; Save remaining characters and position 17120 000623'01 607 01 0 00 200000 txnn t1, N ; Did we find anything? 17121 000624'01 254 00 0 00 001026' callret ntrigr ; No, go blat, reset the network buffer and return 17122 17123 remark ; Hit trigger, was this the only thing we needed to find? 17124 000625'01 621 01 0 00 700000 txz t1, S!N!M ; Stomp any flags 17125 000626'01 621 12 0 00 700000 txz p2, S!N!M ; in the copy, too 17126 000627'01 200 04 0 00 000605* move t4, strc ; Load match length 17127 000630'01 302 04 0 00 000001 caie t4, ^d1 ; Search string was only one dinky character? 17128 000631'01 254 00 0 00 000665' ifskp. ; Yep, we're done 17129 000632'01 200 14 0 00 000007 move p4, q3 ; Load original length 17130 000633'01 274 14 0 00 000012 sub p4, p2 ; Compute consumed characters 17131 000634'01 332 00 0 00 000322* ifme. pars8 ;[229] Only if not /SILENT 17132 000635'01 254 00 0 00 000650' 17133 000636'01 201 01 0 00 000101 movei t1, .priou ; Typing on the terminal 17134 000637'01 200 02 0 00 000011 move t2, q5 ; Source is where we started 17135 000640'01 210 03 0 00 000014 movn t3, p4 ; How much we'll type 17136 000641'01 325 03 0 00 000650' ifl. t3 ; Don't print if we computed gubbish 17137 000642'01 104 00 0 00 000053 SOUT% ; Counted SOUT% to terminal 17138 000643'01 320 12 0 00 000645' %jserr (,) 17139 000644'01 254 00 0 00 000650' 17140 000645'01 265 01 0 00 000526* 17141 000646'01 000000000000# 17142 000647'01 254 00 0 00 000650' 17143 000172'04 120 162 151 156 164 17144 000650'01 endif. 17145 000650'01 endif. ;[229] 17146 000650'01 120 01 0 00 000012 dmove t1, p2 ; Source is where MOVST stopped 17147 000651'01 326 01 0 00 000655' ife. t1 ; Was this at the END of the buffer? 17148 000652'01 400 05 0 00 000000 setz q1, ; Yes, so just zero out the count 17149 000653'01 200 06 0 00 000011 move q2, q5 ; and reset to the beginning of the buffer 17150 000654'01 254 00 0 00 000611* retskp ; About as easy as it gets 17151 000655'01 endif. ; Otherwise, pull the string up K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 19:41 30-Mar-24 Page 14-2 K20IOC MAC 7-Jan-24 19:31 Match String Routine 17152 000655'01 200 04 0 00 000001 move t4, t1 ; Force no filling to occur 17153 000656'01 200 05 0 00 000011 move q1, q5 ; Goes to top of buffer 17154 000657'01 403 03 0 00 000006 setzb t3, q2 ; Just in case 17155 000660'01 123 01 0 00 000555' extend t1, movsup ; Move the string up 17156 000661'01 600 00 0 00 000000 nop ; Ignore +1 (which should never happen) 17157 000662'01 200 06 0 00 000005 move q2, q1 ; Ending destination is where we can now append 17158 000663'01 200 05 0 00 000012 move q1, p2 ; And load characters remaining in buffer 17159 000664'01 254 00 0 00 000654* retskp ; Return success 17160 000665'01 endif. ; Otherwise, do the non-single character case 17161 17162 remark ; First, fix up the pointers to match the string 17163 000665'01 474 13 0 00 000000 seto p3, ; Back up before the skip character 17164 000666'01 133 13 0 00 000002 adjbp p3, t2 ; So we can match the entire string 17165 000667'01 350 12 0 00 000001 aos p2, t1 ; Account for an inconsumed character (preserves flags) 17166 remark p4, ; Still has original length from above 17167 000670'01 200 15 0 00 000562' move p5, str2bp ; Always reset the destination pointer 17168 17169 remark ; Calculate match position 17170 000671'01 200 04 0 00 000007 move t4, q3 ; Load original length 17171 000672'01 274 04 0 00 000001 sub t4, t1 ; Calculate total done 17172 17173 000673'01 323 04 0 00 000675' ifg. t4 ; Anything to print? 17174 000674'01 260 17 0 00 001060' call netprn ; Print what we've seen and what will get tossed 17175 000675'01 endif. ; End case of match being first character 17176 17177 remark ; What we've printed is no longer relevant, chuck it 17178 000675'01 316 07 0 00 000012 camn q3, p2 ; But!! Did we not match at the first character?? 17179 000676'01 254 00 0 00 000710' ifskp. ; We did not, so do the pull up 17180 000677'01 120 01 0 00 000012 dmove t1, p2 ; Source is the last thing we've looked at 17181 000700'01 200 04 0 00 000001 move t4, t1 ; Force no use of fill characters 17182 000701'01 200 05 0 00 000011 move q1, q5 ; Destination is top of buffer 17183 000702'01 403 03 0 00 000006 setzb t3, q2 ; Force section local pointers 17184 000703'01 123 01 0 00 000555' extend t1, movsup ; Move the string up 17185 000704'01 600 00 0 00 000000 nop ; Ignore +1 (which should never happen) 17186 000705'01 200 07 0 00 000012 move q3, p2 ; Update reduced number of characters in network buffer 17187 000706'01 200 10 0 00 000005 move q4, q1 ; New append is ending destination of MOVSLJ 17188 remark p2, ; Unchanged, same number of characters 17189 000707'01 200 13 0 00 000011 move p3, q5 ; But we can start looking at the top of the buffer 17190 000710'01 endif. ; End case of non-1st character in buffer 17191 17192 000710'01 200 01 0 00 000627* move t1, strc ; Load length of match string 17193 000711'01 317 01 0 00 000007 camg t1, q3 ; Is there enough space to do the compare? 17194 000712'01 254 00 0 00 000715' ifskp. ; Nope, so must get some more network data 17195 000713'01 120 05 0 00 000007 dmove q1, q3 ; Return updated pointers 17196 000714'01 263 17 0 00 000000 ret ; Return +1, no match 17197 000715'01 endif. 17198 17199 remark t1, ; Already has source comparsion base length 17200 000715'01 200 11 0 00 000001 move q5, t1 ; No more pull up, so q5 is free 17201 000716'01 200 02 0 00 000013 move t2, p3 ; Where to start translating from 17202 000717'01 200 04 0 00 000001 move t4, t1 ; Transferring or translating equal lengths 17203 000720'01 200 05 0 00 000015 move q1, p5 ; Where to translate to (in translation buffer) 17204 000721'01 403 03 0 00 000006 setzb t3, q2 ; Force local pointers 17205 17206 remark ; A small optmization K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 19:41 30-Mar-24 Page 14-3 K20IOC MAC 7-Jan-24 19:31 Match String Routine 17207 000722'01 332 00 0 00 000000# ifme. incase ; Case insensitive? 17208 000723'01 254 00 0 00 000730' 17209 000724'01 661 01 0 00 400000 txo t1, S ; Immediately start translating 17210 000725'01 123 01 0 00 000000# extend t1, trnbas ; Move the remaining characters 17211 000726'01 600 00 0 00 000000 nop ; Ignore non-skip 17212 000727'01 254 00 0 00 000732' else. ; Otherwise, case sensitive 17213 000730'01 123 01 0 00 000555' extend t1, movsup ; So just copy them and do nothing further 17214 000731'01 600 00 0 00 000000 nop ; Ignore non-skip (which should never happen) 17215 000732'01 endif. 17216 17217 remark ; Set up for the string compare 17218 000732'01 200 01 0 00 000011 move t1, q5 ; Load source length 17219 000733'01 200 02 0 00 000103* move t2, strptr ; Load pointer to search string 17220 000734'01 200 04 0 00 000001 move t4, t1 ; substrings are same length 17221 000735'01 200 05 0 00 000015 move q1, p5 ; Where we wrote the (translated) network data 17222 remark t3, q2 ; These are still zero, forcing local pointers 17223 000736'01 474 00 0 00 000000 seto f, ; Let's assume a match 17224 000737'01 123 01 0 00 000557' extend t1, cmprmn ; Finally, let's compare something!! 17225 000740'01 400 00 0 00 000000 setz f, ; Not the same... 17226 17227 000741'01 326 00 0 00 000765' ife. f ; Didn't match? 17228 000742'01 200 01 0 00 000000# move t1, trgchr ; Load the original trigger character and 17229 000743'01 332 00 0 00 000634* ifme. pars8 ;[229] Not if /SILENT 17230 000744'01 254 00 0 00 000746' 17231 000745'01 104 00 0 00 000074 PBOUT% ; print only that because we're skipping it 17232 000746'01 endif. ;[229] 17233 000746'01 337 01 0 00 000326* skipg t1, sesjfn ; Session logging? 17234 000747'01 254 00 0 00 000753' ifskp. ; Yes, so let's put it in there, too 17235 000750'01 200 02 0 00 000000# move t2, trgchr ; Load the original trigger character again 17236 000751'01 104 00 0 00 000051 BOUT% ; And put it into the log 17237 000752'01 320 12 0 00 000753' erjmpr .+1 ; Catch and ignore error 17238 000753'01 endif. ; End case session logging 17239 000753'01 370 01 0 00 000012 sos t1, p2 ; Account for consumed match character 17240 000754'01 200 04 0 00 000001 move t4, t1 ; Prevent any filling 17241 000755'01 200 05 0 00 000013 move q1, p3 ; Destination is where we started translating from 17242 000756'01 201 02 0 00 000001 movei t2, ^d1 ; Source is one character after that so we 17243 000757'01 133 02 0 00 000005 adjbp t2, q1 ; Overwrite the match character 17244 remark t3, q2 ; These are still zero, forcing local pointers 17245 000760'01 123 01 0 00 000555' extend t1, movsup ; Shift them all up a byte 17246 000761'01 600 00 0 00 000000 nop ; Ignore non-skip (which should never happen) 17247 000762'01 200 06 0 00 000005 move q2, q1 ; Last destination address is where we can append 17248 000763'01 200 05 0 00 000012 move q1, p2 ; New total 17249 000764'01 263 17 0 00 000000 ret ; Return non-match, boo... 17250 000765'01 endif. 17251 ; Otherwise, matched!!! 17252 remark ; Must print the rest of the compared string 17253 000765'01 332 00 0 00 000743* ifme. pars8 ;[229] Only if not /SILENT 17254 000766'01 254 00 0 00 001000' 17255 000767'01 201 01 0 00 000101 movei t1, .priou ; User's terminal 17256 000770'01 200 02 0 00 000013 move t2, p3 ; Where the match started 17257 000771'01 210 03 0 00 000011 movn t3, q5 ; Rest of search string length 17258 000772'01 104 00 0 00 000053 SOUT% ; Counted SOUT% is faster 17259 000773'01 320 12 0 00 000775' %jserr (,) ; Odd but carry on 17260 000774'01 254 00 0 00 001000' 17261 000775'01 265 01 0 00 000645* K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 19:41 30-Mar-24 Page 14-4 K20IOC MAC 7-Jan-24 19:31 Match String Routine 17262 000776'01 000000000000# 17263 000777'01 254 00 0 00 001000' 17264 000205'04 125 156 141 142 154 17265 001000'01 endif. ;[229] 17266 17267 001000'01 337 01 0 00 000746* skipg t1, sesjfn ; Session logging? 17268 001001'01 254 00 0 00 001006' ifskp. ; Yes, so let's put it in there, too 17269 001002'01 200 02 0 00 000013 move t2, p3 ; Where the match started 17270 001003'01 210 03 0 00 000011 movn t3, q5 ; Rest of search string length 17271 001004'01 104 00 0 00 000053 SOUT% ; Counted SOUT% is faster 17272 001005'01 320 12 0 00 001006' erjmpr .+1 ; Catch and ignore error 17273 001006'01 endif. ; End case session logging 17274 17275 remark ; Is this really correct? 17276 001006'01 274 12 0 00 000011 sub p2, q5 ; Account for characters consumed 17277 001007'01 327 12 0 00 001013' ifle. p2 ; Nothing left? 17278 001010'01 400 05 0 00 000000 setz q1, ; No characters in buffer 17279 001011'01 200 06 0 00 000013 move q2, p3 ; Start from where compared because that's gone now 17280 001012'01 254 00 0 00 000664* retskp ; Return success!!!!! 17281 001013'01 endif. 17282 17283 remark ; What we've done is no longer relevant for pull up 17284 001013'01 200 01 0 00 000012 move t1, p2 ; New length includes consumed characters 17285 001014'01 200 02 0 00 000011 move t2, q5 ; What we've consumed 17286 001015'01 133 02 0 00 000013 adjbp t2, p3 ; Source is post transfer 17287 001016'01 200 04 0 00 000001 move t4, t1 ; Same length 17288 001017'01 200 05 0 00 000013 move q1, p3 ; Destination is pretransfer 17289 001020'01 403 03 0 00 000006 setzb t3, q2 ; Force section local pointers 17290 001021'01 123 01 0 00 000555' extend t1, movsup ; Move the string up 17291 001022'01 600 00 0 00 000000 nop ; Ignore +1 (which should never happen) 17292 001023'01 200 06 0 00 000005 move q2, q1 ; Return new append position 17293 001024'01 200 05 0 00 000012 move q1, p2 ; Return existing characters 17294 17295 001025'01 254 00 0 00 001012* retskp ; Return success!!!!! 17296 K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 19:41 30-Mar-24 Page 15 K20IOC MAC 7-Jan-24 19:31 No trigger character seen 17297 subttl No trigger character seen 17298 17299 ; Entry: matchs register context 17300 ; 17301 ; AC block from movst 17302 ; 17303 ; t1/ Remaining characters in network input buffer 17304 ; t2/ Pointer to where the first character match happened in the input buffer 17305 ; *** OR *** where we ended (for a .CHNUL, for example) 17306 ; t3/ Zero, section local pointers 17307 ; t4/ Remaing characters in translation buffer 17308 ; q1/ Pointer to where we stopped in the translation buffer 17309 ; q2/ Zero, section local pointers 17310 ; 17311 ; N.B. Since we never hit the trigger character, t1 and t4 WILL be equal 17312 ; on entry because we stopped consuming source and storing in the 17313 ; destination translation area. 17314 ; 17315 ; Set by matchs at the time of calling 17316 ; 17317 ; q3/ Original buffer length of network data 17318 ; q4/ Original pointer to end of network data buffer 17319 ; q5/ Pointer to beginning of network data buffer 17320 ; p1/ Aliased from q5, don't use! 17321 ; p2/ Remaining source length 17322 ; p3/ Updated pointer, which was based on q5 17323 ; p4/ [Not in use, yet] 17324 ; p5/ [Not in use, yet] 17325 ; 17326 ; Exit: 17327 ; 17328 ; q1/ Updated count of characters in buffer 17329 ; q2/ Updated pointer into buffer 17330 17331 001026'01 ntrigr: remark ; Here if extend never hit the trigger character 17332 remark ; Assumes saved by matchs 17333 remark ; also saved by matchs 17334 17335 001026'01 621 01 0 00 700000 txz t1, S!N!M ; Shut off any flags from MOVST 17336 001027'01 200 04 0 00 000007 move t4, q3 ; Load original length 17337 001030'01 274 04 0 00 000001 sub t4, t1 ; Calculate total data done 17338 001031'01 327 04 0 00 001040' ifle. t4 ; Did we actually do anything or get anything odd? 17339 001032'01 120 05 0 00 000007 dmove q1, q3 ; Restore original buffer position 17340 001033'01 334 01 0 00 000000# ermsg% (<1st character MOVST doesn't appear to have done anything>,r) 17341 001034'01 254 00 0 00 001040' 17342 001035'01 202 01 0 00 000575* 17343 001036'01 104 00 0 00 000313 17344 001037'01 254 00 0 00 000577* 17345 000101'02 000000000000# 17346 000215'04 113 105 122 115 111 17347 17348 001040'01 endif. ; End sanity check 17349 17350 001040'01 260 17 0 00 001060' call netprn ; Print outstanding network data 17351 K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 19:41 30-Mar-24 Page 15-1 K20IOC MAC 7-Jan-24 19:31 No trigger character seen 17352 001041'01 312 04 0 00 000007 came t4, q3 ; Looked though everything? 17353 001042'01 254 00 0 00 001046' ifskp. ; We did, so reset count and pointer 17354 001043'01 400 05 0 00 000000 setz q1, ; Nothing left to look at 17355 001044'01 200 06 0 00 000011 move q2, q5 ; Load reset pointer 17356 001045'01 263 17 0 00 000000 ret ; And done, +1 17357 001046'01 endif. 17358 ; Otherwise, have to 'pull up' the data 17359 001046'01 621 12 0 00 700000 txz p2, S!N!M ; Don't want any flags from now on 17360 001047'01 120 01 0 00 000012 dmove t1, p2 ; Source is where we stopped in the buffer 17361 001050'01 200 04 0 00 000001 move t4, t1 ; Destination length is the same as source length 17362 001051'01 200 05 0 00 000011 move q1, q5 ; It's going to the top of the buffer 17363 001052'01 403 03 0 00 000006 setzb t3, q2 ; Force section local pointers 17364 001053'01 123 01 0 00 000555' extend t1, movsup ; Pull the rest of the string up 17365 001054'01 600 00 0 00 000000 nop ; Ignore non-skip return (should never happen) 17366 001055'01 200 06 0 00 000005 move q2, q1 ; Append position is wherever MOVSLJ left it 17367 001056'01 200 05 0 00 000012 move q1, p2 ; New length is whatever we didn't look at 17368 001057'01 263 17 0 00 000000 ret ; Returns +1 17369 K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 19:41 30-Mar-24 Page 16 K20IOC MAC 7-Jan-24 19:31 Network Print 17370 subttl Network Print 17371 17372 ; Entry: 17373 ; 17374 ; q5/ Pointer to start printing from 17375 ; t4/ Count of characters to print 17376 ; 17377 ; Returns: 17378 ; 17379 ; +1, always, no registers modified 17380 17381 001060'01 323 04 0 00 001037* netprn: jumple t4, r ; If nothing to do, don't do anything 17382 001061'01 265 16 0 00 004057' saveac ; Don't step on a single thing 17383 001062'01 332 00 0 00 000765* ifme. pars8 ;[229] Only if not /SILENT 17384 001063'01 254 00 0 00 001075' 17385 001064'01 210 03 0 00 000004 movn t3, t4 ; Load negative count of data 17386 001065'01 200 02 0 00 000011 move t2, q5 ; And the beginning of it 17387 001066'01 201 01 0 00 000101 movei t1, .priou ; Our happy terminal 17388 001067'01 104 00 0 00 000053 SOUT% ; Blat how much we've done so far 17389 001070'01 320 12 0 00 001072' %jserr (,) ; Odd but carry on 17390 001071'01 254 00 0 00 001075' 17391 001072'01 265 01 0 00 000775* 17392 001073'01 000000000000# 17393 001074'01 254 00 0 00 001075' 17394 000233'04 125 156 141 142 154 17395 001075'01 endif. ;[229] 17396 17397 001075'01 337 01 0 00 001000* skipg t1, sesjfn ; Session logging? 17398 001076'01 263 17 0 00 000000 ret ; No, we're done 17399 17400 remark ; Yes, so let's put it in there, too 17401 001077'01 200 02 0 00 000011 move t2, q5 ; And the beginning of it 17402 001100'01 210 03 0 00 000004 movn t3, t4 ; Load negative count of data 17403 001101'01 104 00 0 00 000053 SOUT% ; Counted SOUT% is faster 17404 001102'01 320 12 0 00 001103' erjmpr .+1 ; Catch and ignore error 17405 17406 001103'01 263 17 0 00 000000 ret 17407 K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 19:41 30-Mar-24 Page 17 K20IOC MAC 7-Jan-24 19:31 Clear Buffered Network Data 17408 subttl Clear Buffered Network Data 17409 17410 ; Returns number cleared 17411 17412 001104'01 inpclr: entry inpclr ; Used by k20net 17413 001104'01 265 16 0 00 004012' saveac ; Used by inpbfc 17414 17415 001105'01 120 05 0 00 000000# dmove q1, inpcnt ; Set calling context 17416 001106'01 260 17 0 00 001116' call inpbfc ; Check buffer constency 17417 001107'01 263 17 0 00 000000 ret ; Bad, don't touch 17418 001110'01 272 05 0 00 000000# addm q1, inpcbf ; Otherwise, count is good, add to tally 17419 001111'01 120 01 0 00 000000# dmove t1, inpini ; Load INPUT initialization data 17420 001112'01 124 01 0 00 000000# dmovem t1, inpcnt ; Whack the buffer 17421 001113'01 200 01 0 00 000005 move t1, q1 ; Return what we cleared 17422 001114'01 263 17 0 00 000000 ret 17423 K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 19:41 30-Mar-24 Page 18 K20IOC MAC 7-Jan-24 19:31 INPUT buffer checking and error handling 17424 subttl INPUT buffer checking and error handling 17425 17426 remark ; Input buffer check 17427 17428 ; Call 17429 ; 17430 ; q1/ Current inpcnt, count of characters in buffer 17431 ; q2 Current inpptr, append pointer 17432 ; 17433 ; +1, Something bad 17434 ; +2, Good 17435 ; t1/ Start of text 17436 ; 17437 ; Register usage 17438 ; 17439 ; q3/ Earliest possible byte pointer 17440 ; q4/ Last possible byte pointer 17441 ; q5/ Beginning of current text in buffer 17442 17443 001115'01 44 07 0 00 000000# bufbeg: point 7, inpbuf ; Assembled beginning of buffer 17444 17445 001116'01 inpbfc: entry inpbfc ; Called from k20par 17446 001116'01 265 16 0 00 004071' saveac ; Some internal storage 17447 remark ; Leave these alone!! 17448 001117'01 200 01 0 00 001115' move t1, bufbeg ; Load assembler beginning 17449 001120'01 200 02 0 00 000001 move t2,t1 ; Save a copy 17450 17451 001121'01 133 00 0 00 000001 ibp t1 ; Bump into the first word 17452 001122'01 474 07 0 00 000000 seto q3, ; Back up by one 17453 001123'01 133 07 0 00 000001 adjbp q3, t1 ; Puts it into previous word 17454 001124'01 201 10 0 00 005000 movx q4, strblc ; Load maximum count 17455 001125'01 133 10 0 00 000002 adjbp q4, t2 ; Puts past last word 17456 17457 remark ; First, check the length 17458 001126'01 305 05 0 00 000000 caige q1, 0 ; Bogus count?? 17459 001127'01 334 01 0 00 000000# ermsg% (,inpbfa) 17460 001130'01 254 00 0 00 001134' 17461 001131'01 202 01 0 00 001035* 17462 001132'01 104 00 0 00 000313 17463 001133'01 254 00 0 00 001233' 17464 000102'02 000000000000# 17465 000243'04 113 105 122 115 111 17466 17467 001134'01 303 05 0 00 005000 caile q1, strblc ; Absurdly large? 17468 001135'01 334 01 0 00 000000# ermsg% (,inpbfa) 17469 001136'01 254 00 0 00 001142' 17470 001137'01 202 01 0 00 001131* 17471 001140'01 104 00 0 00 000313 17472 001141'01 254 00 0 00 001233' 17473 000103'02 000000000000# 17474 000253'04 113 105 122 115 111 17475 17476 17477 remark ; Check append pointer 17478 001142'01 550 03 0 00 000006 hrrz t3, q2 ; Load current buffer append address K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 19:41 30-Mar-24 Page 18-1 K20IOC MAC 7-Jan-24 19:31 INPUT buffer checking and error handling 17479 001143'01 550 04 0 00 000007 hrrz t4, q3 ; And the earliest possible address 17480 001144'01 313 03 0 00 000004 camle t3, t4 ; Before or at last? 17481 001145'01 254 00 0 00 001155' ifskp. ; Yes, could be bad 17482 001146'01 316 06 0 00 000007 camn q2, q3 ; Unless on exact address 17483 001147'01 254 00 0 00 001155' anskp. ; That's fine 17484 001150'01 334 01 0 00 000000# ermsg% (,inpbtc) 17485 001151'01 254 00 0 00 001155' 17486 001152'01 202 01 0 00 001137* 17487 001153'01 104 00 0 00 000313 17488 001154'01 254 00 0 00 001232' 17489 000104'02 000000000000# 17490 000263'04 113 105 122 115 111 17491 17492 001155'01 endif. 17493 17494 001155'01 550 04 0 00 000010 hrrz t4, q4 ; Load last possible address 17495 001156'01 315 03 0 00 000004 camge t3, t4 ; After or at last? 17496 001157'01 254 00 0 00 001167' ifskp. ; Yes, could be bad 17497 001160'01 316 06 0 00 000010 camn q2, q4 ; Unless on exact address 17498 001161'01 254 00 0 00 001167' anskp. ; That's fine 17499 001162'01 334 01 0 00 000000# ermsg% (,inpbtc) 17500 001163'01 254 00 0 00 001167' 17501 001164'01 202 01 0 00 001152* 17502 001165'01 104 00 0 00 000313 17503 001166'01 254 00 0 00 001232' 17504 000105'02 000000000000# 17505 000300'04 113 105 122 115 111 17506 17507 001167'01 endif. 17508 17509 001167'01 323 05 0 00 001220' ifg. q1 ; But!! Is there anything to do? 17510 remark ; Calculate and check start of text 17511 001170'01 210 11 0 00 000005 movn q5, q1 ; Load negative current buffer length 17512 001171'01 133 11 0 00 000006 adjbp q5, q2 ; Calculates beginning of input area 17513 17514 001172'01 550 03 0 00 000011 hrrz t3, q5 ; Load address of start of text 17515 001173'01 550 04 0 00 000007 hrrz t4, q3 ; And the earliest possible address 17516 001174'01 313 03 0 00 000004 camle t3, t4 ; Before or at last? 17517 001175'01 254 00 0 00 001205' ifskp. ; Yes, could be bad 17518 001176'01 316 11 0 00 000007 camn q5, q3 ; Unless on exact address 17519 001177'01 254 00 0 00 001205' anskp. ; That's fine 17520 001200'01 334 01 0 00 000000# ermsg% (,inpbtc) 17521 001201'01 254 00 0 00 001205' 17522 001202'01 202 01 0 00 001164* 17523 001203'01 104 00 0 00 000313 17524 001204'01 254 00 0 00 001232' 17525 000106'02 000000000000# 17526 000313'04 113 105 122 115 111 17527 17528 001205'01 endif. 17529 17530 001205'01 550 04 0 00 000010 hrrz t4, q4 ; Load last possible address 17531 001206'01 315 03 0 00 000004 camge t3, t4 ; After or at last? 17532 001207'01 254 00 0 00 001217' ifskp. ; Yes, could be bad 17533 001210'01 316 06 0 00 000010 camn q2, q4 ; Unless on exact address K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 19:41 30-Mar-24 Page 18-2 K20IOC MAC 7-Jan-24 19:31 INPUT buffer checking and error handling 17534 001211'01 254 00 0 00 001217' anskp. ; That's fine 17535 001212'01 334 01 0 00 000000# ermsg% (,inpbtc) 17536 001213'01 254 00 0 00 001217' 17537 001214'01 202 01 0 00 001202* 17538 001215'01 104 00 0 00 000313 17539 001216'01 254 00 0 00 001232' 17540 000107'02 000000000000# 17541 000330'04 113 105 122 115 111 17542 17543 001217'01 endif. 17544 001217'01 254 00 0 00 001221' else. ; Otherwise, nothing to compute or check 17545 001220'01 200 11 0 00 000007 move q5, q3 ; Current append IS the start of text 17546 001221'01 endif. 17547 17548 remark ; Everything looks, good but can we get anything? 17549 001221'01 200 02 0 00 000011 move t2, q5 ; Load the start of buffer pointer 17550 001222'01 134 04 0 00 000002 ildb t4, t2 ; Pick up the first character 17551 001223'01 320 12 0 00 001225' %jserr (,inpbtc) 17552 001224'01 254 00 0 00 001230' 17553 001225'01 265 01 0 00 001072* 17554 001226'01 000000000000# 17555 001227'01 254 00 0 00 001232' 17556 000343'04 102 165 146 146 145 17557 17558 001230'01 200 01 0 00 000011 move t1, q5 ; Return current input position 17559 001231'01 254 00 0 00 001025* retskp ; Finally return success 17560 17561 17562 remark Error handler 17563 17564 001232'01 272 05 0 00 000000# inpbtc: addm q1, inpcbf ; Otherwise, count is good, add to tally 17565 001233'01 400 05 0 00 000000 inpbfa: setz q1, ; Whack the buffer; nothing in there 17566 001234'01 200 06 0 00 001115' move q2, bufbeg ; and point to the beginning 17567 001235'01 263 17 0 00 000000 ret ; Return the bad news 17568 K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 19:41 30-Mar-24 Page 19 K20IOC MAC 7-Jan-24 19:31 Debug Print, call with a JSP CX 17569 subttl Debug Print, call with a JSP CX 17570 17571 ; Was used to catch all the edge cases when doing buffered reads 17572 17573 repeat 0,< ; But it's debugged now. I hope... 17574 17575 debprn: push p, t1 17576 push p, t2 17577 push p, t3 17578 txmsg < 17579 Entry: > 17580 call prnbuf 17581 pop p, t3 17582 pop p, t2 17583 pop p, t1 17584 call (cx) ;;No arguments to skip 17585 ifskp. 17586 push p, t1 17587 push p, t2 17588 push p, t3 17589 txmsg < 17590 retskp: > 17591 call prnbuf 17592 pop p, t3 17593 pop p, t2 17594 pop p, t1 17595 aos (p) 17596 else. 17597 push p, t1 17598 push p, t2 17599 push p, t3 17600 txmsg < 17601 ret: > 17602 call prnbuf 17603 pop p, t3 17604 pop p, t2 17605 pop p, t1 17606 endif. 17607 ret 17608 K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 19:41 30-Mar-24 Page 20 K20IOC MAC 7-Jan-24 19:31 Debug Print, call with a JSP CX 17609 remark The symbol being displayed is what the buffer pointer is 17610 17611 prnbuf: movei t1, .priou 17612 move t2, q1 17613 movei t3, ^d10 17614 NOUT% 17615 erjmpr .+1 17616 txmsg <, > 17617 hrrz t1, q2 17618 push p, cx 17619 call symout## 17620 pop p, cx 17621 ifg. q1 17622 caile q1, strblc 17623 anskp. 17624 txmsg <,' 17625 '> 17626 movei t1, .priou 17627 movn t2, q1 17628 adjbp t2, q2 17629 movn t3, q1 17630 SOUT% 17631 erjmpr .+1 17632 txmsg <' 17633 17634 > 17635 else. 17636 ifn. q1 17637 txmsg <, *** absurd length *** 17638 17639 > 17640 else. 17641 txmsg < 17642 17643 > 17644 endif. 17645 endif. 17646 ret 17647 >;repeat 0 K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 19:41 30-Mar-24 Page 21 K20IOC MAC 7-Jan-24 19:31 Builds a Search String 17648 subttl Builds a Search String 17649 17650 ; Call: 17651 ; 17652 ; Something in the atom buffer to search for. Does the following, 17653 ; in order, 17654 ; 17655 ; 1) Translates C escape sequences to the indicated character 17656 ; 2) Builds search MOVST table 17657 ; 17658 ; Returns +1, If error 17659 ; +2. Success!! 17660 ; 17661 ; strbuf/ Converted 7-bit ASCIZ string 17662 ; strptr/ 7 bit pointer to the above 17663 ; strc/ Length of converted string 17664 ; sertab/ MOVST table to stop on first letter of search string 17665 ; 17666 ; Unlike getss, will not allow string buffer to be overwritten 17667 17668 001236'01 265 16 0 00 004103' bsrchs: saveac ; Needs some temporaries 17669 dmove t1, [ ; Set up for expansion 17670 point 7,strbuf ; Destination is string buffer 17671 001237'01 120 01 0 00 004115' point 7,atmbuf] ; Source is the typed in string 17672 001240'01 120 05 0 00 000001 dmove q1, t1 ; Save destination and source pointers 17673 001241'01 202 01 0 00 000733* movem t1, strptr ; Save destination pointer for later 17674 17675 001242'01 200 01 0 00 000002 move t1, t2 ;[248] ; Source and destination are the same 17676 001243'01 260 17 0 00 000000* call asczcp ;[248] ; Count what is in the atom buffer 17677 001244'01 377 00 0 00 000003 sosg t3 ;[248] ; Don't count the stupid NUL 17678 001245'01 400 03 0 00 000000 setz t3, ;[248] ; Normalize if went negative 17679 17680 001246'01 323 03 0 00 001263' ifg. t3 ;[248] ; Anything to do, actually? 17681 001247'01 120 01 0 00 000005 dmove t1, q1 ;[248] ; Reload destination and source 17682 remark t3, ;[248] ; Was set by asczcp, above 17683 001250'01 201 04 0 00 000000# movei t4, chrtup ;[248] Assume (common) case insensitive compare 17684 001251'01 332 00 0 00 000000# skipe incase ; But!! Case-INsensitive compare? 17685 001252'01 201 04 0 00 000000# movei t4, chrtab ; Ok, so case sensitive, then 17686 001253'01 260 17 0 00 003200' call cescxp ; Expand any escape characters 17687 001254'01 334 00 0 00 000000 %ermsg (,r) ; pass +1 up 17688 001255'01 254 00 0 00 001261' 17689 001256'01 265 01 0 00 001225* 17690 001257'01 000000000000# 17691 001260'01 254 00 0 00 001060* 17692 000351'04 105 162 162 157 162 17693 001261'01 202 03 0 00 000710* movem t3, strc ; Store the length of the target string 17694 001262'01 254 00 0 00 001267' else. ; Otherwise, nothing in there 17695 001263'01 402 00 0 00 001261* setzm strc ; So zero the string counter 17696 001264'01 403 02 0 00 000003 setzb t2, t3 ; And scrub a dub 17697 001265'01 124 02 0 00 000427* dmovem t2, strbuf ; the destination buffer 17698 001266'01 254 00 0 00 001231* retskp ; Nothing else to do 17699 001267'01 endif. ; End case something to do 17700 17701 001267'01 134 07 0 00 000005 ildb q3, q1 ; Pick up first expanded character 17702 001270'01 322 07 0 00 001266* jumpe q3, RSKP ; Can't match on NUL K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 19:41 30-Mar-24 Page 21-1 K20IOC MAC 7-Jan-24 19:31 Builds a Search String 17703 ; Otherwise, build a search translation table 17704 001271'01 201 01 0 00 000200 movx t1, sertln ; Length of search table in words 17705 dmove t2, [ btrnsu ; Uppercasing base table with no stop characters 17706 001272'01 120 02 0 00 004117' sertab ] ; Destination in writable storage to be modified 17707 001273'01 332 00 0 00 000000# skipe incase ; But!! Case-INsensitive compare? 17708 001274'01 201 02 0 00 000000# movei t2, btrnst ; No, so use exact matching table, then 17709 17710 001275'01 550 04 0 00 000002 hrrz t4, t2 ; Pick up address of base table 17711 001276'01 505 04 0 00 015000 hrli t4, (movst 0,0) ; Build instruction 17712 001277'01 202 04 0 00 000000# movem t4, trnbas ; Store as instructon to do 17713 001300'01 402 00 0 00 000000# setzm trnbas+1 ; Fill character is .chnul 17714 001301'01 123 01 0 00 004022' xblt. t1 ; Drop into place 17715 17716 001302'01 202 07 0 00 000000# movem q3, trgchr ; Might be the right character 17717 001303'01 200 01 0 00 000007 move t1, q3 ; Load the character 17718 001304'01 260 17 0 00 001324' call mrktab ; Mark the table to stop on this character 17719 001305'01 332 00 0 00 000000# skipe incase ; But!! Case-INsensitive compare? 17720 001306'01 254 00 0 00 001270* retskp ; No, so case sensitive and we're done 17721 17722 001307'01 200 01 0 00 000007 move t1, q3 ; Otherwise, load the character again 17723 001310'01 301 01 0 00 000141 cail t1, "a" ; Is this a lower case letter? 17724 001311'01 303 01 0 00 000172 caile t1, "z" 17725 001312'01 254 00 0 00 001316' jrst bsrch1 ; No, see if UPPER case 17726 001313'01 620 01 0 00 000040 txz t1, 40 ; Yes, convert to UPPER case 17727 001314'01 202 01 0 00 000000# movem t1, trgchr ; And save as the trigger character 17728 001315'01 254 00 0 00 001322' jrst bsrch2 ; Now go poke the table 17729 17730 001316'01 301 01 0 00 000101 bsrch1: cail t1, "A" ; No, is this an UPPER case letter? 17731 001317'01 303 01 0 00 000132 caile t1, "Z" ; If neither UPPER or lower, 17732 001320'01 254 00 0 00 001306* retskp ; we're done 17733 001321'01 660 01 0 00 000040 txo t1, 40 ; Yes, convert to lower case 17734 remark bsrch2 ; Falls through to tweak the table again 17735 17736 001322'01 260 17 0 00 001324' bsrch2: call mrktab ; Mark the table to stop on this character 17737 001323'01 254 00 0 00 001320* retskp ; Return success 17738 17739 K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 19:41 30-Mar-24 Page 22 K20IOC MAC 7-Jan-24 19:31 Given a character Mark a translate Table to stop on it 17740 subttl Given a character Mark a translate Table to stop on it 17741 17742 ; Call: 17743 ; 17744 ; t1/ Character to stop on 17745 ; 17746 ; Returns: +1, always 17747 ; 17748 ; Search table (sertab) with appropriate character pair updated 17749 ; 17750 ; To do, the indexed xct is extremely cute, but probably not really 17751 ; fast. Probably could just have done an txnn/ifskp./else./endif. 17752 ; and maybe even bummed the lsh. Even with all the extra jrst's, 17753 ; it would probably be faster. 17754 ; 17755 ; Vanity, vanity, vanity... 17756 17757 001324'01 265 16 0 00 004057' mrktab: saveac ; Don't touch the temporaries 17758 001325'01 246 01 0 00 777777 lshc t1, ^d<-1> ; Divide by two, shifting odd bit into bit zero 17759 001326'01 242 02 0 00 777735 lsh t2, ^d<-35> ; Shift remainder into bit zero 17760 001327'01 200 03 0 01 000000# move t3, sertab(t1) ; Load character pair 17761 xct [tlo t3,TRMCOD ; Even, pick up left half 17762 001330'01 256 00 0 02 004121' tro t3,TRMCOD](t2) ; Odd, pick up right half 17763 001331'01 202 03 0 01 000000# movem t3, sertab(t1) ; Store back into table 17764 001332'01 263 17 0 00 000000 ret ; Done 17765 17766 ;[209] End code insertion 17767 K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 19:41 30-Mar-24 Page 23 K20IOC MAC 7-Jan-24 19:31 OUTPUT command parsing 17768 subttl OUTPUT command parsing 17769 17770 ;[208] Originally shut off indirection, but since quoted strings allow 17771 ; us to put in an at-sign (@) as well as escape sequences, this was 17772 ; removed to allow backward compatibility with any take files which 17773 ; rely on this. 17774 17775 chgsec(code,const) ;;Chained FDB's go in const 17776 000110'02 010004 000113' outfdb: flddb. .cmcfm,,,,,outfd1 17777 000111'02 000000 000000 17778 000112'02 44 07 0 00 003631' 17779 000113'02 021004 000116' outfd1: flddb. .cmqst,,,,,outfd2 17780 000114'02 000000 000000 17781 000115'02 44 07 0 00 003640' 17782 000116'02 017004 000000 outfd2: flddb. .cmtxt,,,,, ;[208] 17783 000117'02 000000 000000 17784 000120'02 44 07 0 00 003647' 17785 retsec ;;Return to code psect 17786 cleans() ;;Clean up working symbols 17787 17788 17789 001333'01 .outpu: entry .output ; Invoked by k20par 17790 001333'01 200 16 0 00 000000# guide (string) ; Parse OUTPUT command. 17791 001334'01 260 17 0 00 000212* 17792 000121'02 000000000000# 17793 000360'04 163 164 162 151 156 17794 001335'01 201 01 0 00 000000# movei t1, outfdb ;[208] Load pointer to chained fdb's 17795 001336'01 260 17 0 00 000216* call rfield ;[208] Parse for something 17796 001337'01 135 03 0 00 004011' ldb t3, [pointr (.cmfnp(t3),cm%fnc)] ;[208] Get what was parsed 17797 17798 001340'01 302 03 0 00 000010 caie t3, .cmcfm ;[208] Parsed a confirm? 17799 001341'01 254 00 0 00 001347' ifskp. ;[208] We did, so fix up the atom buffer 17800 001342'01 205 01 0 00 064000 movx t1, ;[208] Load a carriage return 17801 001343'01 202 01 0 00 000225* movem t1, atmbuf ;[208] Stomp the atom buffer 17802 dmove t2,[ point 7, atmbuf ;[248] Point to atom buffer 17803 001344'01 120 02 0 00 004123' ^d1 ] ;[248] And its single byte 17804 001345'01 124 02 0 00 000231* dmovem t2, pars3 ;[248] Pass over to semantic action 17805 001346'01 263 17 0 00 000000 ret ;[248] Done 17806 001347'01 endif. ;[248] End case defaulting input 17807 ;[208] Otherwise, the atom buffer is valid 17808 001347'01 260 17 0 00 000252* confrm ;[208] But must be confirmed 17809 17810 dmove t1, [ ;[248] Overwritting the atom buffer in place 17811 point 7, atmbuf ;[248] So the source is the atom buffer and 17812 001350'01 120 01 0 00 004125' point 7, atmbuf ] ;[248] the destination is the atom buffer 17813 001351'01 260 17 0 00 001243* call asczcp ;[248] Move the string on top of itself, returning count 17814 001352'01 200 02 0 00 004025' move t2,[point 7,atmbuf];[248] Load address of string to possibly expand 17815 001353'01 375 00 0 00 000003 sosge t3 ;[248] Don't count the NUL at the end!! 17816 001354'01 400 03 0 00 000000 setz t3, ;[248] Stomp if went negative 17817 001355'01 124 02 0 00 001345* dmovem t2, pars3 ;[248] Store for semantic action 17818 001356'01 263 17 0 00 000000 ret ;[248] Now go do something useful with it 17819 K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 19:41 30-Mar-24 Page 24 K20IOC MAC 7-Jan-24 19:31 OUTPUT command execution 17820 subttl OUTPUT command execution 17821 17822 remark pars3 ;[248] Pointer to buffer with characters parsed 17823 remark pars4 ;[248] Length of buffer 17824 17825 001357'01 $outpu: entry $output ;[209] Invoked by k20par 17826 001357'01 265 16 0 00 004127' saveac ;[247] Save registers for piggy MOVST 17827 17828 remark ;[209] Expand any C escape characters 17829 001360'01 200 01 0 00 004143' move t1, [point 8,strbuf] ;[248] Destination buffer is eight bit 17830 001361'01 120 02 0 00 001355* dmove t2, pars3 ;[248] Load source buffer point and length 17831 001362'01 322 03 0 00 001260* jumpe t3, R ;[248] If nothing to do, then don't do anything 17832 001363'01 201 04 0 00 000000# movei t4, chrtab ;[209] Respect case on expansion 17833 001364'01 200 12 0 00 000001 move p2, t1 ;[248] Save output buffer pointer 17834 001365'01 260 17 0 00 003200' call cescxp ;[209] Expand string into output buffer 17835 001366'01 334 00 0 00 000000 %ermsg (,r) ;[209] Don't go any further 17836 001367'01 254 00 0 00 001373' 17837 001370'01 265 01 0 00 001256* 17838 001371'01 000000000000# 17839 001372'01 254 00 0 00 001362* 17840 000362'04 105 162 162 157 162 17841 001373'01 200 11 0 00 000003 move p1, t3 ;[247] Save length of destination 17842 17843 001374'01 337 01 0 00 000434* $outp4: skipg t1, netjfn ;[186] Comm line designator. 17844 001375'01 200 01 0 00 000435* move t1, ttyjfn ;[186] Not remote, using local 17845 001376'01 260 17 0 00 000000* call chklin ; Whatever it is, check it 17846 001377'01 332 00 0 00 000000* ifme. carier ; No carrier? 17847 001400'01 254 00 0 00 001406' 17848 001401'01 334 00 0 00 000000 %ermsg (,r) 17849 001402'01 254 00 0 00 001406' 17850 001403'01 265 01 0 00 001370* 17851 001404'01 000000000000# 17852 001405'01 254 00 0 00 001372* 17853 000371'04 125 156 141 142 154 17854 001406'01 endif. 17855 001406'01 200 02 0 00 000012 move t2, p2 ;[247] Point to converted string 17856 001407'01 210 03 0 00 000011 movn t3, p1 ;[247] Counted string (gives length of record) 17857 001410'01 400 04 0 00 000000 setz t4, ;[186] Just in case still NUL terminated (isn't) 17858 001411'01 336 00 0 00 000000# skipn parpko ;[223] Don't do this if doing packets only 17859 001412'01 260 17 0 00 003655' call putpar ;[223] Otherwise, maybe put some parity on it 17860 001413'01 336 00 0 00 000000* ifmn. tvtflg ;[247] TVT-Binary? 17861 001414'01 254 00 0 00 001443' 17862 001415'01 415 16 0 00 001435' block. ;[247] Yes, let's see if we need any quoting 17863 001416'01 261 17 0 00 000016 17864 001417'01 265 16 0 00 004144' saveac ;[247] Save output designator, want an accumulator 17865 001420'01 200 07 0 00 004154' move q3, [point 8, tvtbuf] ;[247] Special buffer for IAC doubling 17866 001421'01 200 01 0 00 000011 move t1, p1 ;[247] Positive length 17867 001422'01 200 03 0 00 000007 move t3, q3 ;[247] Load output area 17868 001423'01 260 17 0 00 000000* call iaciac ;[247] Go double any IAC's 17869 001424'01 334 00 0 00 000000 %ermsg (,r) ;;[247] 17870 001425'01 254 00 0 00 001431' 17871 001426'01 265 01 0 00 001403* 17872 001427'01 000000000000# 17873 001430'01 254 00 0 00 001405* 17874 000402'04 117 125 124 120 125 K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 19:41 30-Mar-24 Page 24-1 K20IOC MAC 7-Jan-24 19:31 OUTPUT command execution 17875 001431'01 200 11 0 00 000004 move p1, t4 ;[247] Store updated length 17876 001432'01 200 12 0 00 000007 move p2, q3 ;[247] New output buffer 17877 001433'01 254 00 0 00 001323* retskp ;[247] Won! 17878 001434'01 263 17 0 00 000000 endbk. ;[247] End of block context 17879 001435'01 254 00 0 00 001442' ifskp. ;[247] Success 17880 001436'01 200 02 0 00 000012 move t2, p2 ;[247] Pass in to SOUTR% 17881 001437'01 210 03 0 00 000011 movn t3, p1 ;[247] New length 17882 001440'01 400 04 0 00 000000 setz t4, ;[247] Just in case still NUL terminated (isn't) 17883 001441'01 254 00 0 00 001443' else. ;[247] Otherwise, failed somehow 17884 001442'01 263 17 0 00 000000 ret ;[247] So get out of here 17885 001443'01 endif. ;[247] End case iaciac return handling 17886 001443'01 endif. ;[247] End TVT-binary handling 17887 001443'01 104 00 0 00 000532 SOUTR% ;[186] Push it over the network. 17888 001444'01 320 12 0 00 001446' %jserr (,) ;[186] Couldn't ... 17889 001445'01 254 00 0 00 001451' 17890 001446'01 265 01 0 00 001426* 17891 001447'01 000000000000# 17892 001450'01 254 00 0 00 001451' 17893 000410'04 103 141 156 047 164 17894 17895 001451'01 350 00 0 00 000000* aos vsoct ;[204] Count a SOUTR% done 17896 001452'01 272 11 0 00 000000* addm p1, vsotc ;[204] Update tally of SOUTR% bytes 17897 001453'01 313 11 0 00 000000* camle p1, vsomx ;[204] Length than or equal to the maximum seen? 17898 001454'01 202 11 0 00 001453* movem p1, vsomx ;[204] Nope, we have a new maximum! 17899 17900 001455'01 336 00 0 00 000000* ifmn. duplex ;[247] Half duplex connection? 17901 001456'01 254 00 0 00 001500' 17902 001457'01 201 01 0 00 000101 movei t1, .priou ; Yes, do it ourselves. 17903 001460'01 200 02 0 00 000012 move t2, p2 ;[247] Point to final string 17904 001461'01 210 03 0 00 000011 movn t3, p1 ;[247] Counted string (faster) 17905 001462'01 400 04 0 00 000000 setz t4, ;[186] Just in case (still NUL terminated) 17906 001463'01 104 00 0 00 000053 SOUT% 17907 001464'01 320 12 0 00 001465' erjmpr .+1 ;[195] 17908 remark ;[248] Only 'echo' in session log if half duplex 17909 001465'01 337 01 0 00 001075* skipg t1, sesjfn ;[195] Session logging? 17910 001466'01 254 00 0 00 001500' ifskp. ;[195] A JFN exists 17911 001467'01 336 00 0 00 000330* skipn sesflg ;[195] Is logging active? 17912 001470'01 254 00 0 00 001500' anskp. ;[195] No, so don't bother 17913 001471'01 306 01 0 00 377777 cain t1, .nulio ;[193] Just dumping it? 17914 001472'01 254 00 0 00 001500' anskp. ;[193] If so, we're done 17915 001473'01 200 02 0 00 000012 move t2, p2 ;[247] Otherwise, point again. 17916 001474'01 210 03 0 00 000011 movn t3, p1 ;[247] Counted string (faster) 17917 001475'01 400 04 0 00 000000 setz t4, ;[186] Just in case (still NUL terminated) 17918 001476'01 104 00 0 00 000053 SOUT 17919 001477'01 320 12 0 00 001500' erjmpr .+1 ;[195] 17920 001500'01 endif. ;[195] 17921 001500'01 endif. ;[247] End case half-duplex 17922 17923 001500'01 263 17 0 00 000000 ret ; Done. 17924 17925 ;[209] End code replacement 17926 K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 19:41 30-Mar-24 Page 25 K20IOC MAC 7-Jan-24 19:31 TRANSMIT [file] parsing [165] 17927 subttl TRANSMIT [file] parsing [165] 17928 17929 ;[209] Begin code replacement 17930 ; 17931 ; Moved here from k20mit and rewritten to be able drive buffered I/O. 17932 ; 17933 ; Tries for a device first as this is more efficient for NUL: and 17934 ; catches more errors earlier and more easily. Can sometimes make 17935 ; recognition not work intuitively by picking a bogus device over 17936 ; a non-existant file. 17937 ; 17938 ; Default command filespec fields for .CMFIL. These are only given 17939 ; so that we may get the flags returned by GTJFN% (which are currently 17940 ; unused) 17941 17942 chgsec(code,const) ;;GTJFN defaults are not in code, they're in const 17943 17944 000122'02 100020 000000 trnbk: gj%flg!gj%old!fld(.gjdef,.rhalf) ; .GJGEN 17945 000123'02 000100 000101 .priin,,.priou ; .GJSRC (ignored if COMND%) 17946 000124'02 000000 000000 0 ; .GJDEV (do not default the device) 17947 000125'02 000000 000000 0 ; .GJDIR (do not default the directory) 17948 000126'02 000000 000000 0 ; .GJNAM (do not default the name) 17949 000127'02 000000 000000 0 ; .GJEXT (do not default the extension) 17950 000130'02 000000 000000 0 ; .GJPRO (use system default protection) 17951 000131'02 000000 000000 0 ; .GJACT (use job's current account) 17952 000010 trnbkl==<.-trnbk> ; Length of this GTJFN argument block. 17953 retsec ;;[229] Back to where-ever we started from 17954 17955 ;[229] %table puts stuff in the correct .psect 17956 17957 000132'02 000000 000000 %table (trnswi) ;[229] The translate switch table 17958 000133'02 000000# 000000 %key2 , %eofsw ;[229] The EOF switch parses a restricted token set 17959 000040'03 105 117 106 000 000 17960 000134'02 000000# 000001 %key2 , %silsw ;[229] Tells $input to shut up about matches 17961 000041'03 163 151 154 145 156 17962 000135'02 000000# 000002 %key2 , %timsw ;[229] In case we don't want to wait forever ... 17963 000043'03 164 151 155 145 157 17964 000132'02 000003 000003 %tbend ;[229] End of table 17965 17966 remark Lifted from k20par 17967 17968 ;N.B., have to use literals here or flddb. will choke. Maybe rewrite 17969 ; this to special case .cmtok, like fldtk.? 17970 17971 define token (c) < ;;[217] Define token 17972 ;;[217] All these literals, yuck... 17973 >;;token ;;[217] 17974 17975 chgsec(code,const) ;;Chained FDB's are not in code, they're in const 17976 000136'02 023004 000141' tranft: flddb. .cmtok,,token(<>),,,tranf1 17977 000137'02 440700 003653' 17978 000140'02 44 07 0 00 003654' 17979 000141'02 023004 000144' tranf1: flddb. .cmtok,,token(<>),,,tranf2 17980 000142'02 440700 003665' 17981 000143'02 44 07 0 00 003666' K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 19:41 30-Mar-24 Page 25-1 K20IOC MAC 7-Jan-24 19:31 TRANSMIT [file] parsing [165] 17982 000144'02 023004 000147' tranf2: flddb. .cmtok,,token(<$>),,,tranf3 17983 000145'02 440700 003674' 17984 000146'02 44 07 0 00 003675' 17985 000147'02 023005 000000 tranf3: flddb. .cmtok,cm%sdh,token(<>),,, 17986 000150'02 440700 003706' 17987 000151'02 44 07 0 00 003707' 17988 17989 000152'02 003000 000154' tranfs: flddb. .cmswi,,trnswi,,,tranfd ;[229] Maybe get a transmit switch 17990 000153'02 000000 000132' 17991 000154'02 006000 000156' tranfd: flddb. .cmfil,,,,,tranf4 17992 000155'02 000000 000000 17993 000156'02 016001 000000 tranf4: flddb. .cmdev,cm%sdh,,,, ;[229] Catch bare device 17994 000157'02 000000 000000 17995 17996 000160'02 015006 000000 timfdb: flddb. .cmflt,,^d10,,<10>, 17997 000161'02 000000 000012 17998 000162'02 44 07 0 00 003573' 17999 000163'02 44 07 0 00 003720' 18000 retsec ;;[229] Back to where-ever we started from 18001 remark ;;[229] Punt temporary symbols 18002 cleans() 18003 18004 001501'01 .trans: entry .trans ; Invoked from k20par 18005 001501'01 265 16 0 00 004155' saveac ; Protect some registers 18006 18007 001502'01 200 01 0 00 004171' movx t1, cz%ncl!.fhslf ; Release non-open JFN's on reparse 18008 001503'01 104 00 0 00 000034 CLZFF% 18009 001504'01 320 12 0 00 001505' erjmpr .+1 ; Catch and ignore errors 18010 18011 001505'01 200 01 0 00 004172' move t1, [trnbk,,cjfnbk] ; Insert our file parsing defaults. 18012 001506'01 251 01 0 00 000000# blt t1, cjfnbk+trnbkl 18013 18014 001507'01 201 11 0 00 000000# movei q5, tranfs ;[229] Doing a full complement of switches 18015 18016 001510'01 200 16 0 00 000000# .tran0: guide 18017 001511'01 260 17 0 00 001334* 18018 000164'02 000000000000# 18019 000415'04 146 151 154 145 040 18020 001512'01 .tran1: remark ;[229] Here when looping on switches 18021 001512'01 201 01 0 00 000011 movei t1, q5 ;[229] Look for switch, device or file 18022 001513'01 260 17 0 00 001336* call rfield ;[229] Ask them to type something 18023 001514'01 200 06 0 00 000002 move q2, t2 ;[229] Save whatever parsed data we got 18024 001515'01 135 05 0 00 004011' ldb q1, [pointr (.cmfnp(t3),cm%fnc)] ;[229] Pick up function code 18025 001516'01 302 05 0 00 000003 caie q1, .cmswi ;[229] Did we get a switch? 18026 001517'01 254 00 0 00 001572' jrst .tran2 ;[229] No, just go handle the device or file 18027 001520'01 415 16 0 00 001564' block. ;[229] Enter block for better control flow 18028 001521'01 261 17 0 00 000016 18029 001522'01 550 07 0 06 000000 hrrz q3, (q2) ;[229] Pick up the switch value 18030 001523'01 302 07 0 00 000000 caie q3, %eofsw ;[229] Parsed the EOF switch? 18031 001524'01 254 00 0 00 001537' ifskp. ;[229] We did, so pick up its argument 18032 001525'01 201 01 0 00 000000# movei t1, tranft ;[229] Look for an EOF token 18033 001526'01 260 17 0 00 001513* call rfield ;[229] Ask them to type one of them 18034 001527'01 621 03 0 00 777777 tlz t3, -1 ;[229] Isolate fdb we actually used 18035 001530'01 200 02 0 03 000001 move t2, .cmdat(t3) ;[229] Pick up the byte pointer to the character 18036 001531'01 134 01 0 00 000002 ildb t1, t2 ;[229] Load the token character (only one) K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 19:41 30-Mar-24 Page 25-2 K20IOC MAC 7-Jan-24 19:31 TRANSMIT [file] parsing [165] 18037 001532'01 306 01 0 00 000044 cain t1, "$" ;[229] Our goofy escape synonym? 18038 001533'01 201 01 0 00 000033 movei t1, .chesc ;[229] Yes, transmogrify it 18039 001534'01 260 17 1 00 000000* call @parity ;[229] And put parity on it (if doing parity) 18040 001535'01 202 01 0 00 000000* movem t1, pars7 ;[229] Save EOF character 18041 001536'01 254 00 0 00 001433* retskp ;[229] Return for next switch 18042 001537'01 endif. ;[229] End EOF switch case 18043 001537'01 302 07 0 00 000001 caie q3, %silsw ;[229] Parsed the 'silent' switch? 18044 001540'01 254 00 0 00 001543' ifskp. ;[229] We did, so that should be easy enough 18045 001541'01 476 00 0 00 001062* setom pars8 ;[229] Just flag it in the parse block 18046 001542'01 254 00 0 00 001536* retskp ;[229] Return for next switch 18047 001543'01 endif. ;[229] End 'silent' switch case 18048 001543'01 302 07 0 00 000002 caie q3, %timsw ;[229] Wants a timeout? 18049 001544'01 254 00 0 00 001562' ifskp. ;[229] Give him a time out 18050 001545'01 201 01 0 00 000000# movei t1, timfdb ;[229] Look for a time out number (floating) 18051 001546'01 260 17 0 00 001526* call rfield ;[229] Ask them to type one it 18052 001547'01 325 02 0 00 001553' ifl. t2 ;[229] Is the number in the right range? 18053 001550'01 200 01 0 00 000000# emsg ;[229] Must be superluminal... 18054 001551'01 104 00 0 00 000313 18055 000165'02 000000000000# 18056 000422'04 101 040 156 145 147 18057 001552'01 254 00 0 00 000240* jrst cmder1 ;[229] Yet allow reparse 18058 001553'01 endif. ;[229] End initial sanity checking 18059 001553'01 260 17 0 00 000176* call chksec ;[229] Ensure number is in correct range 18060 001554'01 254 00 0 00 001557' ifskp. ;[229] Check and convert OK? Then side-effect variables 18061 001555'01 254 00 0 00 001542* retskp ;[229] And get out of the parse block. 18062 001556'01 254 00 0 00 001562' else. ;[229] Otherwise, couldn't swallow something 18063 001557'01 200 01 0 00 000000# emsg ;[229] 18064 001560'01 104 00 0 00 000313 18065 000166'02 000000000000# 18066 000431'04 123 160 145 143 151 18067 001561'01 254 00 0 00 001552* jrst cmder1 ;[229] Yet allow reparse 18068 001562'01 endif. ;[229] End case checking and conversion 18069 001562'01 endif. ;[229] End case timeout switch 18070 001562'01 263 17 0 00 000000 ret ;[229] Otherwise, some kind of bogus switch 18071 001563'01 263 17 0 00 000000 endbk. ;[229] End Block context 18072 001564'01 254 00 0 00 001567' ifskp. ;[229] Successful switch parse 18073 001565'01 254 00 0 00 001512' jrst .tran1 ;[229] Go see if more switches (or device or file) 18074 001566'01 254 00 0 00 001572' else. ;[229] Otherwise, some kind of error 18075 001567'01 200 01 0 00 000000# emsg ;[229] An internal programming error.. 18076 001570'01 104 00 0 00 000313 18077 000167'02 000000000000# 18078 000442'04 125 156 153 156 157 18079 001571'01 254 00 0 00 001561* jrst cmder1 ;[229] However, allow reparse 18080 001572'01 endif. ;[229] End of switch block processing 18081 18082 001572'01 200 01 0 00 000006 .tran2: move t1, q2 ;[229] Load parsed data for DVCHR% 18083 001573'01 302 05 0 00 000016 caie q1, .cmdev ; Typed a bare device? 18084 001574'01 621 01 0 00 777777 tlz t1, -1 ; Shut off flags so DVCHR% doesn't choke 18085 001575'01 104 00 0 00 000117 DVCHR% ; and find out about it 18086 001576'01 320 12 0 00 001600' %jserr (,r) 18087 001577'01 254 00 0 00 001603' 18088 001600'01 265 01 0 00 001446* 18089 001601'01 000000000000# 18090 001602'01 254 00 0 00 001430* 18091 000451'04 125 156 141 142 154 K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 19:41 30-Mar-24 Page 25-3 K20IOC MAC 7-Jan-24 19:31 TRANSMIT [file] parsing [165] 18092 001603'01 135 07 0 00 004173' ldb q3, [pointr t2, dv%typ] ; Pick up the device type 18093 18094 001604'01 302 05 0 00 000016 caie q1, .cmdev ; Typed a bare device? 18095 001605'01 254 00 0 00 001632' ifskp. ; Yes, see what it is 18096 001606'01 302 07 0 00 000015 caie q3, .dvnul ; NUL:? 18097 001607'01 254 00 0 00 001612' ifskp. ; Yes, we can simulate that 18098 001610'01 200 06 0 00 004174' movx q2, ;Use special designator and flags 18099 001611'01 254 00 0 00 001647' jrst .tran3 ;[229] Done with this special case 18100 001612'01 endif. ; Any other device is NOT VALID 18101 18102 001612'01 302 07 0 00 000000 caie q3, .dvdsk ; Bare device? 18103 001613'01 254 00 0 00 001631' ifskp. ; Yes, but needs a file name 18104 001614'01 200 01 0 00 000000# emsg ; First part of blat 18105 001615'01 104 00 0 00 000313 18106 000170'02 000000000000# 18107 000464'04 124 150 145 040 000 18108 001616'01 200 02 0 00 000006 move t2, q2 ; Load whatever we parsed 18109 001617'01 201 01 0 00 000101 movei t1, .priou ; Output to the terminal 18110 001620'01 104 00 0 00 000121 DEVST% ; Write the device name into the AC's 18111 001621'01 320 12 0 00 001623' %jserr (,cmder1) 18112 001622'01 254 00 0 00 001626' 18113 001623'01 265 01 0 00 001600* 18114 001624'01 000000000000# 18115 001625'01 254 00 0 00 001571* 18116 000465'04 125 156 141 142 154 18117 001626'01 200 01 0 00 000000# sxtext (t1,<: structure needs a file specification>) 18118 000171'02 000000000000# 18119 000476'04 072 040 163 164 162 18120 001627'01 104 00 0 00 000076 PSOUT% ; Finish the informative blat 18121 001630'01 254 00 0 00 001625* jrst cmder1 ; Allow reparse 18122 001631'01 endif. ; Any other device is NOT VALID 18123 18124 001631'01 254 00 0 00 001670' jrst .trane ; Otherwise, handle as a general parse error 18125 001632'01 endif. ; End case .cmdev 18126 18127 remark .cmfil ; Everything else is a file 18128 18129 001632'01 302 07 0 00 000015 caie q3, .dvnul ; A JFN on NUL:?? 18130 001633'01 254 00 0 00 001645' ifskp. ; Yes, let's fix that up 18131 001634'01 200 01 0 00 000006 move t1, q2 ; Load parsed JFN 18132 001635'01 260 17 0 00 000000* call isnulj ; Convert it to a special JFN, releasing original 18133 001636'01 334 01 0 00 000000# ermsg% (,cmder1) ; Allow ^H 18134 001637'01 254 00 0 00 001643' 18135 001640'01 202 01 0 00 001214* 18136 001641'01 104 00 0 00 000313 18137 001642'01 254 00 0 00 001630* 18138 000172'02 000000000000# 18139 000506'04 113 105 122 115 111 18140 18141 001643'01 200 06 0 00 000001 move q2, t1 ; Store the JFN and original parse flags 18142 001644'01 254 00 0 00 001647' jrst .tran3 ; Done with this second special NUL: (JFN) case 18143 001645'01 endif. 18144 18145 001645'01 302 07 0 00 000000 caie q3, .dvdsk ; Was this a structure? 18146 001646'01 254 00 0 00 001670' jrst .trane ; No, any other device is NOT VALID K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 19:41 30-Mar-24 Page 25-4 K20IOC MAC 7-Jan-24 19:31 TRANSMIT [file] parsing [165] 18147 18148 18149 001647'01 .tran3: remark ;[229] Otherwise, parse is OK so far 18150 001647'01 403 01 0 00 000002 setzb t1, t2 ; Cons up a couple of nice .chnul's 18151 001650'01 124 01 0 00 001343* dmovem t1, atmbuf ; Stomp the atom buffer 18152 18153 001651'01 260 17 0 00 000211' call .inpu1 ; Get the search string 18154 001652'01 302 05 0 00 000010 caie q1, .cmcfm ; Defaulted search? 18155 001653'01 254 00 0 00 001665' ifskp. ; Yes, maybe fix up for TRANSMIT defaults 18156 001654'01 333 00 0 00 000000# skiple indefw ; Had we set a default search string? 18157 001655'01 254 00 0 00 001665' anskp. ; We did, so we're done 18158 remark ; Otherwise, supply another appropriate default. 18159 001656'01 336 01 0 00 000000* skipn t1, handsh ; Handshaking? 18160 001657'01 201 01 0 00 000012 movei t1, .chlfd ; No, then use linefeed. 18161 001660'01 241 01 0 00 777771 rot t1, -^d7 ; Turn into an ASCIZ word 18162 001661'01 202 01 0 00 001265* movem t1, strbuf ; Stomp the string buffer 18163 001662'01 201 02 0 00 000001 movei t2, ^d1 ; Single character long 18164 001663'01 200 03 0 00 004026' move t3, [point 7, strbuf] ; Pointer to buffer 18165 001664'01 124 02 0 00 001263* dmovem t2, strc ; Stomp into search string parameters 18166 001665'01 endif. ; Carry on 18167 18168 001665'01 202 06 0 00 000065* movem q2, pars2 ; Store the JFN and flags 18169 001666'01 476 00 0 00 000423* setom pars6 ;[209] Override the ^C handling 18170 18171 001667'01 263 17 0 00 000000 ret ; Done with the parse 18172 K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 19:41 30-Mar-24 Page 26 K20IOC MAC 7-Jan-24 19:31 TRANSMIT [file] parsing [165] 18173 remark Here for common parse errors 18174 18175 001670'01 200 01 0 00 000000# .trane: emsg ; Begin whining 18176 001671'01 104 00 0 00 000313 18177 000173'02 000000000000# 18178 000520'04 124 150 145 040 000 18179 001672'01 201 01 0 00 000101 movei t1, .priou ; Output to terminal, always 18180 18181 remark ; N.B., JFNS% will choke on a device 18182 001673'01 302 05 0 00 000016 caie q1, .cmdev ; Device? 18183 001674'01 254 00 0 00 001705' ifskp. ; Yes, use DEVST% 18184 001675'01 200 02 0 00 000006 move t2, q2 ; Load whatever we parsed 18185 001676'01 104 00 0 00 000121 DEVST% ; Write the device name into the AC's 18186 001677'01 320 12 0 00 001701' %jserr (,cmder1) 18187 001700'01 254 00 0 00 001704' 18188 001701'01 265 01 0 00 001623* 18189 001702'01 000000000000# 18190 001703'01 254 00 0 00 001642* 18191 000521'04 125 156 141 142 154 18192 001704'01 254 00 0 00 001715' else. ; Otherwise, DEVST% will choke on the JFN 18193 001705'01 550 02 0 00 000006 hrrz t2, q2 ; Load just the JFN 18194 dmove t3, [ ; Just want the device name, no punctuation 18195 fld(.jsaof,js%dev) 18196 001706'01 120 03 0 00 004175' 0 ] ; No odd prefix, whatever that is 18197 001707'01 104 00 0 00 000030 JFNS% ; Convert to something readable 18198 001710'01 320 12 0 00 001712' %jserr (,cmder1) 18199 001711'01 254 00 0 00 001715' 18200 001712'01 265 01 0 00 001701* 18201 001713'01 000000000000# 18202 001714'01 254 00 0 00 001703* 18203 000531'04 125 156 141 142 154 18204 001715'01 endif. ; Either way, error should be more informative 18205 18206 001715'01 200 01 0 00 000000# txmsg <: device is not valid for TRANSMIT or CAPTURE> 18207 001716'01 104 00 0 00 000076 18208 001717'01 320 12 0 00 001720' 18209 000174'02 000000000000# 18210 000543'04 072 040 144 145 166 18211 001720'01 561 01 0 00 000406* hrroi t1, crlf ; Newline 18212 001721'01 104 00 0 00 000076 PSOUT% ; Tie off the blat 18213 001722'01 320 12 0 00 001723' erjmpr .+1 ; Catch and ignore that error, too 18214 18215 001723'01 302 05 0 00 000006 caie q1, .cmfil ; Had we parsed a file, actually? 18216 001724'01 254 00 0 00 001730' ifskp. ; Yes, then have a little clean up to do 18217 001725'01 550 01 0 00 000006 hrrz t1, q2 ; Load our poor JFN, sans flags 18218 001726'01 104 00 0 00 000023 RLJFN% ; Toss it; can't use it 18219 001727'01 320 12 0 00 001714* erjmpr cmder1 ; Ignore error and beat it 18220 001730'01 endif. 18221 18222 001730'01 254 00 0 00 001727* jrst cmder1 ; Allow ^H 18223 K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 19:41 30-Mar-24 Page 27 K20IOC MAC 7-Jan-24 19:31 TRANSMIT command execution. 18224 subttl TRANSMIT command execution. 18225 18226 ; To do: Instead of repeated SIN%'s, how about a moby-PMAP% and MOVST? 18227 18228 001731'01 $trans: entry $trans ; Called by k20par 18229 extern mycaps ;[223] Expose capability vector 18230 001731'01 265 16 0 00 004155' saveac ;[209] Needs much registers 18231 18232 001732'01 550 01 0 00 001665* hrrz t1, pars2 ;[209] First make sure we can open the file. 18233 001733'01 202 01 0 00 000000* movem t1, filjfn ;[209] Store in case we need to release 18234 001734'01 302 01 0 00 377777 caie t1, .nulio ;[209] Don't need to open .nulio 18235 001735'01 254 00 0 00 001741' ifskp. ;[229] But give it some fake data 18236 001736'01 403 01 0 00 000002 setzb t1, t2 ;[229] It will have a zero bytes and pages 18237 001737'01 124 01 0 00 000000# dmovem t1, fsized ;[229] Store in file size double word 18238 001740'01 254 00 0 00 002011' else. ;[209] Otherwise must open it 18239 001741'01 104 00 0 00 000036 SIZEF% ;[229] Find out how large the file is 18240 001742'01 320 12 0 00 001744' ifje. r ;[229] Failed?? 18241 001743'01 254 00 0 00 001756' 18242 001744'01 200 04 0 00 000001 move t4, t1 ;[229] Save error for debuggers 18243 001745'01 334 00 0 00 000000 %ermsg (,) ;[229] 18244 001746'01 254 00 0 00 001752' 18245 001747'01 265 01 0 00 001712* 18246 001750'01 000000000000# 18247 001751'01 254 00 0 00 001752' 18248 000555'04 125 156 141 142 154 18249 001752'01 403 02 0 00 000003 setzb t2, t3 ;[229] Cons up a set of zeros 18250 001753'01 124 02 0 00 000000# dmovem t2, fsized ;[229] Store in file size double word 18251 001754'01 200 01 0 00 001733* move t1, filjfn ;[229] Reload the JFN and hope for the best 18252 001755'01 254 00 0 00 001757' else. ;[229] Otherwise, worked!!!! 18253 001756'01 124 02 0 00 000000# dmovem t2, fsized ;[229] So store results in file size double word 18254 001757'01 endif. ;[229] End case JSYS handling 18255 dmove t2, [1,,.fbbyv ;[229] Let's have a look at the byte size 18256 001757'01 120 02 0 00 004177' t4 ] ;[229] Tuck it into t4 18257 001760'01 104 00 0 00 000063 GTFDB% ;[229] Try to pull from file descriptor block 18258 001761'01 320 12 0 00 001763' ifje. r ;[229] Failed?? 18259 001762'01 254 00 0 00 001767' 18260 001763'01 200 04 0 00 000001 move t4, t1 ;[229] Save the error for debuggers 18261 001764'01 201 03 0 00 000007 movei t3, ^d7 ;[229] Ignore it and pretend ASCII 18262 001765'01 550 01 0 00 001732* hrrz t1, pars2 ;[229] Reload JFN for OPENF% attempt 18263 001766'01 254 00 0 00 001770' else. ;[229] Otherwise, worked 18264 001767'01 135 03 0 00 004201' ldb t3,[ pointr(t4,fb%bsz) ] ;[229] Extract byte size from packed field 18265 001770'01 endif. ;[229] End case JSYS handling 18266 001770'01 200 02 0 00 004202' movx t2, fld(7,of%bsz)!of%rd ; Assume 7-bit (also handles 36 bit PA1050) 18267 001771'01 306 03 0 00 000010 cain t3, ^d8 ;[229] Is our assumption incorrect? 18268 001772'01 200 02 0 00 004203' movx t2, fld(8,of%bsz)!of%rd ;[223] Fine, it's eight bit 18269 001773'01 104 00 0 00 000021 OPENF% 18270 001774'01 320 12 0 00 001776' ifje. r ;[209] Failed?? 18271 001775'01 254 00 0 00 002011' 18272 001776'01 200 04 0 00 000001 move t4, t1 ;[209] Save error code for debugging 18273 001777'01 334 00 0 00 000000 %ermsg (,) ;[209] Squawk and continue 18274 002000'01 254 00 0 00 002004' 18275 002001'01 265 01 0 00 001747* 18276 002002'01 000000000000# 18277 002003'01 254 00 0 00 002004' 18278 000567'04 125 156 141 142 154 K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 19:41 30-Mar-24 Page 27-1 K20IOC MAC 7-Jan-24 19:31 TRANSMIT command execution. 18279 002004'01 402 00 0 00 001754* setzm filjfn ;[209] Stomp JFN global storage 18280 002005'01 550 01 0 00 001765* hrrz t1, pars2 ;[209] Reload the JFN 18281 002006'01 260 17 0 00 000000* call frclos ;[209] Force it closed 18282 002007'01 600 00 0 00 000000 nop ;[209] Ignore error and carry on 18283 002010'01 263 17 0 00 000000 ret ;[209] And return; we can't do anything else 18284 002011'01 endif. ;[209] End case OPENF% JSYS error handling 18285 002011'01 endif. ;[209] End case .nulio OPENF% decision 18286 18287 remark ;[209] .trans gets and decodes a prompt (search) string 18288 18289 002011'01 400 11 0 00 000000 $tran1: setz q5, ;[209] Assume not in a batch job that needs fixup 18290 002012'01 336 00 0 00 001664* skipn strc ;[209] Of couse, don't bother if no search string... 18291 002013'01 254 00 0 00 002056' jrst $tran2 ;[209] There won't be anything to fix up 18292 002014'01 332 00 0 00 001541* skipe pars8 ;[229] Nor if we were told to shut up 18293 002015'01 254 00 0 00 002056' jrst $tran2 ;[229] User typed a /SILENT 18294 002016'01 336 00 0 00 000000# skipn ;[209] Now then, are we a batch job? 18295 002017'01 254 00 0 00 002056' jrst $tran2 ;[209] No, so we don't care about BATCON confusion 18296 ;[209] Otherwise, REALLY long lines are bad ... 18297 002020'01 120 01 0 00 002012* dmove t1, strc ;[209] Load the search string count and pointer 18298 002021'01 415 16 0 00 002054' block. ;[209] Enter block context for better control flow 18299 002022'01 261 17 0 00 000016 18300 002023'01 306 01 0 00 000001 cain t1, ^d1 ;[209] A single character?? 18301 002024'01 254 00 0 00 001555* retskp ;[209] Whatever it is, it needs to get tied off 18302 ;[209] A tiny hack: ibp is faster than adjbp 18303 002025'01 302 01 0 00 000003 caie t1, ^d3 ;[209] Is it EXACTLY three characters in length? 18304 002026'01 254 00 0 00 002031' ifskp. ;[209] It is, so handle this more efficiently 18305 002027'01 133 00 0 00 000002 ibp t2 ;[209] Positions us to the first byte 18306 002030'01 275 01 0 00 000001 subi t1, ^d1 ;[209] So ildb in case two works right 18307 002031'01 endif. ;[209] Fall through to case two 18308 18309 002031'01 302 01 0 00 000002 caie t1, ^d2 ;[209] A two character sequence, then? 18310 002032'01 254 00 0 00 002042' ifskp. ;[209] Yes, let's see if that's OK 18311 002033'01 134 03 0 00 000002 ildb t3, t2 ;[209] Let's get the first character 18312 002034'01 302 03 0 00 000015 caie t3, .chcrt ;[209] Carriage return? 18313 002035'01 254 00 0 00 002024* retskp ;[209] Nope, then batch output needs a 18314 002036'01 134 03 0 00 000002 ildb t3, t2 ;[209] Let's get the second character 18315 002037'01 302 03 0 00 000012 caie t3, .chlfd ;[209] And was that a linefeed? 18316 002040'01 254 00 0 00 002035* retskp ;[209] Nope, then batch output needs a 18317 002041'01 263 17 0 00 000000 ret ;[209] ! Batch log will be tidy 18318 002042'01 endif. ;[209] End case, a search string of two characters 18319 ;[209] Note: ldb, ildb is faster than ildb, ildb 18320 002042'01 275 01 0 00 000001 subi t1, ^d1 ;[209] Going to look at the last two characters (!!) 18321 002043'01 133 01 0 00 000002 adjbp t1, t2 ;[209] Position right on the penultimate 18322 002044'01 135 03 0 00 000001 ldb t3, t1 ;[209] Let's get the penultimate character 18323 002045'01 302 03 0 00 000015 caie t3, .chcrt ;[209] Carriage return? 18324 002046'01 254 00 0 00 002040* retskp ;[209] Nope, then batch output needs a 18325 002047'01 134 03 0 00 000001 ildb t3, t1 ;[209] Let's get the final character 18326 002050'01 302 03 0 00 000012 caie t3, .chlfd ;[209] And was that a linefeed? 18327 002051'01 254 00 0 00 002046* retskp ;[209] Nope, then batch output needs a 18328 002052'01 263 17 0 00 000000 ret ;[209] Final two are ! Batch log will be tidy 18329 002053'01 263 17 0 00 000000 endbk. ;[209] End block context 18330 002054'01 254 00 0 00 002056' ifskp. ;[209] Skip return means needs a 18331 002055'01 474 11 0 00 000000 seto q5, ;[209] So flag that for down stream 18332 002056'01 endif. ;[209] End block skip stanza 18333 K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 19:41 30-Mar-24 Page 27-2 K20IOC MAC 7-Jan-24 19:31 TRANSMIT command execution. 18334 002056'01 260 17 0 00 000000* $tran2: call clrbuf ;[229] Clear out any crud before searching 18335 002057'01 254 00 0 00 002300' jrst $tranx ;[229] If failed, just stop doing this 18336 002060'01 337 02 0 00 000420* skipg t2, pars4 ;[229] Integer milliseconds 18337 002061'01 254 00 0 00 002064' ifskp. ;[229] Wants time outs, so set them 18338 002062'01 201 01 0 00 002357' movei t1, $trant ;[229] Where to go die on a time out 18339 002063'01 260 17 0 00 000261* call timeon ;[229] Set the timer for it 18340 002064'01 endif. ;[229] 18341 002064'01 260 17 0 00 000264* call ccon ; Turn on ^C trap 18342 002065'01 254 00 0 00 002300' jrst $tranx ; Where to go upon ^C. 18343 002066'01 332 00 0 00 000414* ifme. vtermf ;[186] Calls only make sense if not virtual 18344 002067'01 254 00 0 00 002074' 18345 002070'01 260 17 0 00 000000* call doarpa ;[186] If on a TVT, set up to allow binary 18346 002071'01 260 17 0 00 000272* call dobits ; Condition the line. 18347 002072'01 254 00 0 00 002300' jrst $tranx 18348 002073'01 260 17 0 00 000274* call ttyob ; Let controlling tty output binary. 18349 002074'01 endif. ;[186] Otherwise, MTOPR%'s might break! 18350 002074'01 201 01 0 00 002125' movei t1, $tran3 ; Where to go if ^M typed (send next) 18351 002075'01 202 01 0 00 000000* movem t1, cmloc ; ... 18352 002076'01 201 01 0 00 002163' movei t1, $tran4 ; Where to go if ^P typed (resend previous) 18353 002077'01 202 01 0 00 000000* movem t1, cploc ; ... 18354 002100'01 260 17 0 00 000000* call cmpon ; Enable interrupts on ^M, ^P. 18355 txmsg < 18356 002101'01 200 01 0 00 000000# [KERMIT-20: Transmitting > ; Tell user we're starting. 18357 002102'01 104 00 0 00 000076 18358 002103'01 320 12 0 00 002104' 18359 000175'02 000000000000# 18360 000575'04 015 012 133 113 105 18361 002104'01 201 01 0 00 000101 movei t1, .priou 18362 002105'01 200 02 0 00 002004* move t2, filjfn 18363 002106'01 403 03 0 00 000004 setzb t3, t4 ;[209] No screwy prefix... 18364 002107'01 104 00 0 00 000030 JFNS 18365 002110'01 320 12 0 00 002111' erjmpr .+1 18366 txmsg < 18367 If stuck, type: 18368 Carriage Return to send next line, 18369 ^P to resend current line, 18370 002111'01 200 01 0 00 000000# > ;[187] 18371 002112'01 104 00 0 00 000076 18372 002113'01 320 12 0 00 002114' 18373 000176'02 000000000000# 18374 000603'04 015 012 040 111 146 18375 18376 18377 18378 dmove t3, [ byte (7) .chspc, "^", "C", "^", "C" 18379 002114'01 120 03 0 00 004204' byte (7) .chspc, .chnul ] ;[187] Assume default 18380 002115'01 200 02 0 00 000000# move t2, mycaps+1 ;[187] Load enabled capabilities 18381 002116'01 607 02 0 00 400000 txnn t2, sc%ctc ;[187] Is Control-C turned on?? 18382 dmove t3, [ byte (7) .chspc, "^", "G", "^", "G" 18383 002117'01 120 03 0 00 004206' byte (7) .chspc, .chnul ] ;[187] Wasn't... 18384 002120'01 561 01 0 00 000003 hrroi t1, t3 ;[187] Point to proper text 18385 002121'01 104 00 0 00 000076 PSOUT% ;[187] Tell them what to type 18386 txmsg 18388 002123'01 104 00 0 00 000076 K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 19:41 30-Mar-24 Page 27-3 K20IOC MAC 7-Jan-24 19:31 TRANSMIT command execution. 18389 002124'01 320 12 0 00 002125' 18390 000177'02 000000000000# 18391 000625'04 164 157 040 143 141 18392 18393 ;... K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 19:41 30-Mar-24 Page 28 K20IOC MAC 7-Jan-24 19:31 TRANSMIT command execution. 18394 18395 ; Get a line from the file. 18396 18397 002125'01 336 00 0 00 000000* $tran3: ifmn. cmseen ;[194] ^M typed? 18398 002126'01 254 00 0 00 002133' 18399 txmsg < Sending next...] 18400 002127'01 200 01 0 00 000000# > ; Yes, type msg 18401 002130'01 104 00 0 00 000076 18402 002131'01 320 12 0 00 002132' 18403 000200'02 000000000000# 18404 000633'04 040 123 145 156 144 18405 18406 002132'01 402 00 0 00 002125* setzm cmseen ; and unset flag. 18407 002133'01 endif. ;[194] 18408 18409 002133'01 200 01 0 00 002105* move t1, filjfn ; Input file pointer 18410 remark t2, *MAGIC* ;[229] N.B., Below converts 7 to 8 bit! 18411 002134'01 200 02 0 00 004210' move t2, [point 8, strbf2] ; Where to put the line 18412 dmove t3, [ strblc ;[209] Maximum characters to read, 18413 002135'01 120 03 0 00 004211' .chlfd ] ;[209] but preferably terminate on linefeed. 18414 002136'01 104 00 0 00 000052 SIN 18415 002137'01 320 12 0 00 002141' ifje. r. ;[194] Catch last error in t1 18416 002140'01 254 00 0 00 002152' 18417 002141'01 550 02 0 00 000001 hrrz t2,t1 ; Erase fork handle from left half. 18418 002142'01 302 02 0 00 600220 caie t2, iox4 ; Was error EOF? 18419 002143'01 334 00 0 00 000000 %ermsg (,$tranx) ; No, give message. 18420 002144'01 254 00 0 00 002150' 18421 002145'01 265 01 0 00 002001* 18422 002146'01 000000 000000 18423 002147'01 254 00 0 00 002300' 18424 002150'01 260 17 0 00 002401' call tranot ;[229] Notify us of transmit completion 18425 002151'01 254 00 0 00 002300' jrst $tranx ; But either way, we are done 18426 002152'01 endif. ;[194] 18427 18428 002152'01 323 03 0 00 002156' ifg. t3 ;[209] Did we hit the linefeed? 18429 002153'01 201 10 0 00 005000 movei q4, strblc ;[209] Yes, so need to do post calculations 18430 002154'01 274 10 0 00 000003 sub q4, t3 ;[209] Calculate amount done 18431 002155'01 254 00 0 00 002157' else. ;[209] Otherwise, don't need to do any math 18432 002156'01 201 10 0 00 005000 movei q4, strblc ;[209] Put in maximum length 18433 002157'01 endif. ;[209] 18434 18435 ; N.B., This code appears to assume a particular kind of Tops-20 18436 ; formatted text file in other words, the STANDARD kind that is 18437 ; used on *ALL* DEC operating systems and in many cases on DOS, 18438 ; OS/2 and Windows. That is, a series of variable length lines 18439 ; terminated by a carriage return and a line feed. 18440 ; 18441 ; However, if you have a Unix or Multics 18442 ; format file with bare linefeed, then this code does the wrong 18443 ; thing because it will strip them all out, giving one big long 18444 ; line. It may also do the wrong thing for consecutive linefeeds. 18445 ; This is very old behavior. 18446 ; 18447 ; If this is in fact a bug or misfeature, then the fix is 18448 ; straightforward in concept (yet not in implementation). We'd K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 19:41 30-Mar-24 Page 28-1 K20IOC MAC 7-Jan-24 19:31 TRANSMIT command execution. 18449 ; need to PMAP% the file and then use a MOVST to trigger on a 18450 ; carriage return and check after it for a linefeed. If the 18451 ; linefeed existed, then we'd strip it, otherwise, this would be a 18452 ; case of overprinting, which still might work right. Bare 18453 ; linefeed's would be left alone. 18454 ; 18455 ; Leave alone for now until better understand the reason for 18456 ; swallowing trailing linefeeds. 18457 ; 18458 ; Changed to shorten the string length because we don't send NUL 18459 ; terminated strings, but rather counted ones. 18460 18461 repeat 0, < ;[229] Previous vestigial code 18462 ldb t1, t2 ;[209] Pick up the last character 18463 caie t1, .chlfd ;[209] Was it a LF? 18464 ibp t2 ;[209] No, so don't overwrite it. 18465 setz t1, ;[209] Deposit a null, overwriting 18466 call @parity ;[223] Put parity on this last dinky character 18467 dpb t1, t2 ; last char if it was a LF. 18468 > ;[229] 18469 18470 002157'01 135 01 0 00 000002 ldb t1, t2 ;[229] Pick up the final character 18471 002160'01 302 01 0 00 000012 caie t1, .chlfd ;[229] Was it a linefeed? 18472 002161'01 254 00 0 00 002163' ifskp. ;[229] It is, so don't send it 18473 002162'01 363 10 0 00 002125' sojle q4, $tran3 ;[229] Decrement the count and skip if nothing left 18474 002163'01 endif. ;[229] Still, positive, so something to do K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 19:41 30-Mar-24 Page 29 K20IOC MAC 7-Jan-24 19:31 TRANSMIT command execution. 18475 18476 ; TRANSMIT, cont'd... Echo the string if necessary. 18477 18478 002163'01 336 00 0 00 000000* $tran4: ifmn. cpseen ;[194] ^P typed? 18479 002164'01 254 00 0 00 002171' 18480 txmsg < - Resending... 18481 002165'01 200 01 0 00 000000# > ; Yes, type msg 18482 002166'01 104 00 0 00 000076 18483 002167'01 320 12 0 00 002170' 18484 000201'02 000000000000# 18485 000637'04 040 055 040 122 145 18486 18487 002170'01 402 00 0 00 002163* setzm cpseen ; and unset flag. 18488 002171'01 endif. ;[194] 18489 18490 002171'01 $tran5: remark ;[223] Tack on desired parity, in place (if desired) 18491 002171'01 200 01 0 00 001534* move t1, parity ;[223] Pick up the parity 18492 002172'01 306 01 0 00 003452' cain t1, none ;[223] Doing any parity anyway? 18493 002173'01 254 00 0 00 002177' ifskp. ;[223] We are, so do some parity already ... 18494 002174'01 200 02 0 00 004210' move t2, [point 8, strbf2] ; Point to the string. 18495 002175'01 210 03 0 00 000010 movn t3, q4 ;[223] Load negative for SOUTR% 18496 002176'01 260 17 0 00 003655' call putpar ;[223] Stomp some parity into it 18497 002177'01 endif. ;[223] End case handling parity 18498 18499 002177'01 336 00 0 00 001455* skipn duplex ; Half duplex? 18500 002200'01 254 00 0 00 002206' jrst $tran6 ;[223] No. 18501 002201'01 200 01 0 00 004210' move t1, [point 8, strbf2] ; Point to the string. 18502 002202'01 104 00 0 00 000076 PSOUT ; Yes, display it at the tty. 18503 002203'01 201 01 0 00 000012 movei t1, .chlfd ; Also need to add linefeed. 18504 002204'01 260 17 1 00 002171* call @parity ; And any necessary parity 18505 002205'01 104 00 0 00 000074 PBOUT 18506 18507 002206'01 $tran6: remark ;[223] Finally send the string 18508 002206'01 337 01 0 00 001374* skipg t1, netjfn ;[186] ... out the communication line. 18509 002207'01 200 01 0 00 001375* move t1, ttyjfn ;[186] using local terminal 18510 002210'01 200 02 0 00 004210' move t2, [point 8, strbf2] 18511 002211'01 210 03 0 00 000010 movn t3, q4 ;[223] Load count 18512 18513 002212'01 336 00 0 00 001413* ifmn. tvtflg ;[247] TVT-Binary? 18514 002213'01 254 00 0 00 002244' 18515 002214'01 415 16 0 00 002233' block. ;[247] Yes, let's see if we need any quoting 18516 002215'01 261 17 0 00 000016 18517 002216'01 265 16 0 00 004144' saveac ;[247] Save output designator, want an accumulator 18518 002217'01 200 07 0 00 004154' move q3, [point 8, tvtbuf] ;[247] Special buffer for IAC doubling 18519 002220'01 200 01 0 00 000010 move t1, q4 ;[247] Positive length 18520 002221'01 200 03 0 00 000007 move t3, q3 ;[247] Load output area 18521 002222'01 260 17 0 00 001423* call iaciac ;[247] Go double any IAC's 18522 002223'01 334 00 0 00 000000 %ermsg (,r) ;;[247] 18523 002224'01 254 00 0 00 002230' 18524 002225'01 265 01 0 00 002145* 18525 002226'01 000000000000# 18526 002227'01 254 00 0 00 001602* 18527 000643'04 117 125 124 120 125 18528 002230'01 200 10 0 00 000004 move q4, t4 ;[247] Store updated length 18529 002231'01 200 02 0 00 000007 move t2, q3 ;[247] New output buffer K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 19:41 30-Mar-24 Page 29-1 K20IOC MAC 7-Jan-24 19:31 TRANSMIT command execution. 18530 002232'01 263 17 0 00 000000 endbk. ;[247] End of block context 18531 002233'01 254 00 0 00 002237' ifskp. ;[247] Success 18532 002234'01 210 03 0 00 000010 movn t3, q4 ;[247] New length 18533 002235'01 400 04 0 00 000000 setz t4, ;[247] Just in case still NUL terminated (isn't) 18534 002236'01 254 00 0 00 002244' else. ;[247] Otherwise, failed somehow 18535 002237'01 334 00 0 00 000000 %ermsg (,r) 18536 002240'01 254 00 0 00 002244' 18537 002241'01 265 01 0 00 002225* 18538 002242'01 000000000000# 18539 002243'01 254 00 0 00 002227* 18540 000651'04 125 156 141 142 154 18541 002244'01 endif. ;[247] End case iaciac return handling 18542 002244'01 endif. ;[247] End TVT-binary handling 18543 18544 002244'01 332 00 0 00 002066* ifme. vtermf ;[186] Not a virtual terminal? 18545 002245'01 254 00 0 00 002255' 18546 002246'01 104 00 0 00 000053 SOUT ;[186] Isn't, so olde reliable is fine 18547 002247'01 320 12 0 00 002251' %jserr (,$tranx) 18548 002250'01 254 00 0 00 002254' 18549 002251'01 265 01 0 00 002241* 18550 002252'01 000000 000000 18551 002253'01 254 00 0 00 002300' 18552 002254'01 254 00 0 00 002264' else. ;[186] Otherwise, have to get out and push 18553 002255'01 350 00 0 00 001451* aos vsoct ;[209] Count a SOUTR% done 18554 002256'01 104 00 0 00 000532 SOUTR% ;[186] 18555 002257'01 320 12 0 00 002261' %jserr (,$tranx) ;[186] 18556 002260'01 254 00 0 00 002264' 18557 002261'01 265 01 0 00 002251* 18558 002262'01 000000 000000 18559 002263'01 254 00 0 00 002300' 18560 002264'01 endif. ;[186] 18561 18562 002264'01 336 00 0 00 002244* ifmn. vtermf ;[209] Only update virtual terminal totals 18563 002265'01 254 00 0 00 002271' 18564 002266'01 272 10 0 00 001452* addm q4, vsotc ;[204] Update tally of SOUTR% bytes 18565 002267'01 313 10 0 00 001454* camle q4, vsomx ;[204] Length than or equal to the maximum seen? 18566 002270'01 202 10 0 00 002267* movem q4, vsomx ;[204] Nope, we have a new maximum! 18567 002271'01 endif. ;[209] 18568 18569 ;[209] Now look for the prompt. Note that everything is echo'ed because 18570 ; this is what Kermit-20 has always done. However, since CAPTURE doesn't 18571 ; echo anything (for performance purposes), all we should see here is 18572 ; the prompt. Or an error... 18573 18574 002271'01 336 00 0 00 002020* $tran7: skipn strc ;[229] But!! Are we doing any recognition, anyway? 18575 002272'01 254 00 0 00 002125' jrst $tran3 ;[229] No, so just go on blatting 18576 002273'01 260 17 0 00 000254' call $input ;[209] Let $INPUT drive the bus now 18577 002274'01 322 11 0 00 002277' ifn. q5 ;[209] Batch log needs to get tied off? 18578 002275'01 561 01 0 00 001720* hrroi t1, crlf ;[209] Yes, so load that 18579 002276'01 104 00 0 00 000076 PSOUT% ;[209] and type it 18580 002277'01 endif. ;[209] End batch log line tie off 18581 002277'01 254 00 0 00 002125' jrst $tran3 ;[209] Returns on the prompt 18582 18583 ; Done, call terminal restore routines in reverse order. 18584 K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 19:41 30-Mar-24 Page 29-2 K20IOC MAC 7-Jan-24 19:31 TRANSMIT command execution. 18585 002300'01 260 17 0 00 000000* $tranx: call cmpoff ; ^M, ^P interrupts off. 18586 002301'01 260 17 0 00 000413* call ccoff2 ; ^C trap off. 18587 002302'01 336 01 0 00 001535* skipn t1, pars7 ;[229] Did we have an EOF character? 18588 002303'01 254 00 0 00 002337' ifskp. ;[229] We did, let's get it sent 18589 002304'01 241 01 0 00 777770 rot t1, -^d8 ;[229] Turn into an 8 bit ASCIZ string (heh) 18590 002305'01 200 05 0 00 000001 move q1, t1 ;[229] And get it out of SOUTR%'s way 18591 002306'01 201 01 0 00 000015 movei t1, .chcrt ;[229] Load a carriage return 18592 002307'01 260 17 1 00 002204* call @parity ;[229] Put parity on that (if doing parity) 18593 002310'01 241 01 0 00 777760 rot t1, -^d16 ;[229] Turn into 2nd byte of 8 bit ASCIZ string 18594 002311'01 434 05 0 00 000001 or q1, t1 ;[229] 'append' it (heh) 18595 002312'01 337 01 0 00 002206* skipg t1, netjfn ;[229] Will go out the network 18596 002313'01 200 01 0 00 002207* move t1, ttyjfn ;[229] or using the local terminal 18597 dmove t2, [ ;[229] Set up for SOUTR% 18598 point 8, q1 ;[229] Output string is in q1 18599 002314'01 120 02 0 00 004213' -2 ] ;[229] Just two dinky characters 18600 002315'01 400 04 0 00 000000 setz t4, ;[229] Should be ignored, but just in case 18601 002316'01 332 00 0 00 002264* ifme. vtermf ;[229] Going to a real terminal? 18602 002317'01 254 00 0 00 002331' 18603 002320'01 104 00 0 00 000053 SOUT% ;[229] Yes, so counted SOUT% will be fine 18604 002321'01 320 12 0 00 002323' %jserr (,) ;[229] Complain and carry on 18605 002322'01 254 00 0 00 002326' 18606 002323'01 265 01 0 00 002261* 18607 002324'01 000000 000000 18608 002325'01 254 00 0 00 002326' 18609 002326'01 260 17 0 00 000417* call ttyou ; Restore controlling tty. 18610 002327'01 260 17 0 00 000416* call unbits ; Put line back to previous state. 18611 002330'01 254 00 0 00 002337' else. ;[229] Otherwise, needs a 'push' 18612 002331'01 104 00 0 00 000532 SOUTR% ;[229] Counted string is faster 18613 002332'01 320 12 0 00 002334' %jserr (,) ;[229] Complain and carry on 18614 002333'01 254 00 0 00 002337' 18615 002334'01 265 01 0 00 002323* 18616 002335'01 000000 000000 18617 002336'01 254 00 0 00 002337' 18618 002337'01 endif. ;[229] End case appropriate output selection 18619 002337'01 endif. ;[229] End case sending the EOF 18620 18621 002337'01 260 17 0 00 002056* call clrbuf ; Flush any junk they may have typed 18622 002340'01 600 00 0 00 000000 nop ;[186] Ignore any complaints 18623 002341'01 332 00 0 00 002316* ifme. vtermf ;[186] Calls only make sense if not virtual 18624 002342'01 254 00 0 00 002345' 18625 002343'01 260 17 0 00 002326* call ttyou ; Restore controlling tty. 18626 002344'01 260 17 0 00 002327* call unbits ; Put line back to previous state. 18627 002345'01 endif. ;[186] Otherwise, MTOPR%'s might break! 18628 18629 002345'01 337 01 0 00 002133* skipg t1, filjfn ;[193] Close the file. 18630 002346'01 254 00 0 00 002354' ifskp. ;[193] If there was any 18631 002347'01 306 01 0 00 377777 cain t1, .nulio ;[193] Unless special NUL: 18632 002350'01 254 00 0 00 002354' anskp. ;[193] Which needs no releasing 18633 002351'01 621 01 0 00 777777 tlz t1, -1 ;[193] Turn off any bogus flags 18634 002352'01 260 17 0 00 002006* call frclos ;[209] Force the JFN to close 18635 002353'01 600 00 0 00 000000 nop ;[209] Ignore any errors 18636 002354'01 endif. ;[193] End case closing a real JFN 18637 002354'01 402 00 0 00 002345* setzm filjfn ; Zero the JFN holder. 18638 002355'01 260 17 0 00 000425' call $inpcl ;[229] Clean up $input's buffer 18639 002356'01 263 17 0 00 000000 ret K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 19:41 30-Mar-24 Page 29-3 K20IOC MAC 7-Jan-24 19:31 TRANSMIT command execution. 18640 18641 002357'01 $trant: remark ;[229] Here on a time out 18642 002357'01 333 04 0 00 002271* skiple t4, strc ;[229] No search string, then? 18643 002360'01 254 00 0 00 002364' ifskp. ;[229] Nope, just generic complaint 18644 002361'01 200 01 0 00 000000# emsg ;[229] Suitably vague.. 18645 002362'01 104 00 0 00 000313 18646 000202'02 000000000000# 18647 000662'04 124 162 141 156 163 18648 002363'01 254 00 0 00 002376' else. ;[229] Otherwise, provide a more helpful message 18649 002364'01 200 01 0 00 000000# emsg ;[229] Begin whining 18650 002365'01 104 00 0 00 000313 18651 000203'02 000000000000# 18652 000666'04 124 162 141 156 163 18653 dmove t1, [ .priou ;[229] continue typing on terminal 18654 002366'01 120 01 0 00 004215' point 7,strbuf ] ;[229] Point to search string 18655 002367'01 210 03 0 00 000004 movn t3, t4 ;[229] Load exact count to do 18656 002370'01 104 00 0 00 000053 SOUT% ;[229] Counted SOUT% is faster 18657 002371'01 320 12 0 00 002373' %jsErr (,) ;[229] Can't win ... 18658 002372'01 254 00 0 00 002376' 18659 002373'01 265 01 0 00 002334* 18660 002374'01 000000 000000 18661 002375'01 254 00 0 00 002376' 18662 002376'01 endif. ;[229] End case no prompt 18663 18664 002376'01 561 01 0 00 002275* hrroi t1, crlf ;[229] Have to tie off the line 18665 002377'01 104 00 0 00 000076 PSOUT% ;[229] 18666 002400'01 254 00 0 00 002300' jrst $tranx ;[229] Go shut everything down 18667 K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 19:41 30-Mar-24 Page 30 K20IOC MAC 7-Jan-24 19:31 Notify of transmission completion 18668 subttl Notify of transmission completion 18669 18670 ;N.B., The byte count isn't what we actually sent; it's what the 18671 ; file should show up as. 18672 18673 tranot: txmsg < 18674 002401'01 200 01 0 00 000000# [KERMIT-20: Transmit of > ;[229] Begin to tell us about it 18675 002402'01 104 00 0 00 000076 18676 002403'01 320 12 0 00 002404' 18677 000204'02 000000000000# 18678 000675'04 015 012 133 113 105 18679 18680 002404'01 200 02 0 00 002354* move t2, filjfn ;[229] Let's get ready to print the file name 18681 002405'01 302 02 0 00 377777 caie t2, .nulio ;[229] Just dumping it? 18682 002406'01 254 00 0 00 002413' ifskp. ;[229] Yes, so bum the JFNS% 18683 002407'01 200 01 0 00 000000# txmsg ;[229] (which won't work, anyway) 18684 002410'01 104 00 0 00 000076 18685 002411'01 320 12 0 00 002412' 18686 000205'02 000000000000# 18687 000703'04 116 125 114 072 000 18688 002412'01 254 00 0 00 002423' else. ;[229] Otherwise, have a real file (I hope) 18689 002413'01 201 01 0 00 000101 movei t1, .priou ;[229] Continue to display on the terminal 18690 002414'01 403 03 0 00 000004 setzb t3, t4 ;[229] No special formatting or goofy prefix 18691 002415'01 104 00 0 00 000030 JFNS% ;[229] Let's see the file name 18692 002416'01 320 12 0 00 002420' %jsErr (,) ;[229] 18693 002417'01 254 00 0 00 002423' 18694 002420'01 265 01 0 00 002373* 18695 002421'01 000000000000# 18696 002422'01 254 00 0 00 002423' 18697 000704'04 103 157 165 154 144 18698 002423'01 endif. ;[229] End case displaying the file name 18699 18700 002423'01 200 01 0 00 000000# txmsg < complete> ;[229] Prepare to blat the file length 18701 002424'01 104 00 0 00 000076 18702 002425'01 320 12 0 00 002426' 18703 000206'02 000000000000# 18704 000714'04 040 143 157 155 160 18705 002426'01 337 02 0 00 000000# skipg t2, fsized ;[229] Load the size of the file in bytes 18706 002427'01 254 00 0 00 002447' ifskp. ;[229] Actually had some data 18707 002430'01 200 01 0 00 000000# txmsg <, > ;[229] Punctuate for some data 18708 002431'01 104 00 0 00 000076 18709 002432'01 320 12 0 00 002433' 18710 000207'02 000000000000# 18711 000716'04 054 040 000 000 000 18712 002433'01 201 01 0 00 000101 movei t1, .priou ;[229] Continue to display on the terminal 18713 002434'01 201 03 0 00 000012 movei t3, ^d10 ;[229] File sizes are always base 10 18714 002435'01 104 00 0 00 000224 NOUT% ;[229] Finally type our length 18715 002436'01 320 12 0 00 002440' %jsErr (,) ;[229] 18716 002437'01 254 00 0 00 002443' 18717 002440'01 265 01 0 00 002420* 18718 002441'01 000000000000# 18719 002442'01 254 00 0 00 002443' 18720 000717'04 103 157 165 154 144 18721 002443'01 200 01 0 00 000000# txmsg < characters> ;[229] However, we clipped a lot of linefeeds 18722 002444'01 104 00 0 00 000076 K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 19:41 30-Mar-24 Page 30-1 K20IOC MAC 7-Jan-24 19:31 Notify of transmission completion 18723 002445'01 320 12 0 00 002446' 18724 000210'02 000000000000# 18725 000727'04 040 143 150 141 162 18726 002446'01 254 00 0 00 002455' else. ;[229] Otherwise, nothing there 18727 002447'01 200 01 0 00 002404* move t1, filjfn ;[229] But!! Do we actually care? 18728 002450'01 306 01 0 00 377777 cain t1, .nulio ;[229] Just dumping stuff? 18729 002451'01 254 00 0 00 002455' anskp. ;[229] Yes, so NUL: really only has one size... 18730 002452'01 200 01 0 00 000000# txmsg <(empty file)> ;[229] Nothing there... 18731 002453'01 104 00 0 00 000076 18732 002454'01 320 12 0 00 002455' 18733 000211'02 000000000000# 18734 000732'04 050 145 155 160 164 18735 002455'01 endif. ;[229] End case 18736 18737 txmsg <] 18738 002455'01 200 01 0 00 000000# > ;[229] Finish reassuring user 18739 002456'01 104 00 0 00 000076 18740 002457'01 320 12 0 00 002460' 18741 000212'02 000000000000# 18742 000735'04 135 015 012 000 000 18743 002460'01 263 17 0 00 000000 ret ;[229] Finally done 18744 K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 19:41 30-Mar-24 Page 31 K20IOC MAC 7-Jan-24 19:31 CAPTURE Parsing logic 18745 subttl CAPTURE Parsing logic 18746 18747 ;[229] Begin code insertion 18748 18749 ;[229] %table puts stuff in the correct .psect 18750 18751 000213'02 000000 000000 %table (capswi) ; The capture switch table 18752 000214'02 000000# 000000 %key2 , %eofsw ; The EOF switch parses a restricted token set 18753 000045'03 105 117 106 000 000 18754 000215'02 000000# 000002 %key2 , %timsw ; In case we don't want to wait forever ... 18755 000046'03 164 151 155 145 157 18756 000213'02 000002 000002 %tbend ; End of table 18757 18758 002461'01 000000000000# captfs: flddb. .cmswi,,capswi,,,tranfd ; Maybe get a capture switch 18759 002462'01 000000000000# 18760 18761 ; Default command filespec fields for .CMFIL. These are only given 18762 ; so that we may get the flags returned by GTJFN% (which are currently 18763 ; unused) 18764 18765 chgsec(code,const) ;;GTJFN defaults are not in code, they're in const 18766 18767 000216'02 600020 777777 capbk: gj%flg!gj%fou!gj%new!fld(.gjnhg,.rhalf) ; .GJGEN 18768 000217'02 000100 000101 .priin,,.priou ; .GJSRC (ignored if COMND%) 18769 000220'02 000000 000000 0 ; .GJDEV (do not default the device) 18770 000221'02 000000 000000 0 ; .GJDIR (do not default the directory) 18771 000222'02 000000 000000 0 ; .GJNAM (do not default the name) 18772 000223'02 000000 000000 0 ; .GJEXT (do not default the extension) 18773 000224'02 000000 000000 0 ; .GJPRO (use system default protection) 18774 000225'02 000000 000000 0 ; .GJACT (use job's current account) 18775 000010 capbkl==<.-capbk> ; Length of this GTJFN argument block. 18776 retsec ;;Back to where-ever we started from 18777 18778 002463'01 .captu: entry .captu ; Linkage is from k20par 18779 002463'01 265 16 0 00 004155' saveac ; Protect some registers 18780 18781 002464'01 200 01 0 00 004171' movx t1, cz%ncl!.fhslf ; Release non-open JFN's on reparse 18782 002465'01 104 00 0 00 000034 CLZFF% 18783 002466'01 320 12 0 00 002467' erjmpr .+1 ; Catch and ignore errors 18784 18785 002467'01 200 01 0 00 004217' move t1, [capbk,,cjfnbk] ;Insert our file parsing 18786 002470'01 251 01 0 00 000000# blt t1, cjfnbk+capbkl ; defaults into the parse block 18787 18788 002471'01 201 11 0 00 002461' movei q5, captfs ; Load our initial parse file descriptor block 18789 002472'01 254 00 0 00 001510' callret .tran0 ; The rest of it parses exactly like TRANSMIT 18790 18791 ;[230] End code insertion 18792 K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 19:41 30-Mar-24 Page 32 K20IOC MAC 7-Jan-24 19:31 CAPTURE semantic action 18793 subttl CAPTURE semantic action 18794 18795 ;[230] Begin code insertion 18796 18797 003776 capmxl==<-2> ;;Maximum we can store, minus at end 18798 18799 remark ; Various linkages 18800 extern inilin ; Routine to condition line for capture 18801 extern rrslin ; Routine to decondition line 18802 extern ttipar ; Count of parity errors detected 18803 extern movchr ; Location of a movslj instruction 18804 18805 002473'01 $captu: entry $captu ; Linkage is from k20par 18806 002473'01 265 16 0 00 004220' saveac ; Protect a bunch of registers 18807 18808 002474'01 337 07 0 00 002312* skipg q3, netjfn ; Assuming getting a character from the network 18809 002475'01 200 07 0 00 002313* move q3, ttyjfn ; No network, so using local terminal 18810 002476'01 200 10 0 00 002302* move q4, pars7 ; Load EOF character (if any, which will have parity) 18811 002477'01 200 13 0 00 000010 move p3, q4 ; Make a 7 bit copy 18812 002500'01 405 13 0 00 000177 andi p3, ^o177 ; by stripping off any parity 18813 002501'01 201 01 0 00 000015 movei t1, .chcrt ; Load expected end of line 18814 002502'01 260 17 1 00 002307* call @parity ; Put parity on it (if doing parity) 18815 002503'01 200 12 0 00 000001 move p2, t1 ; and keep the result in p2 18816 ; Now set up to write the prompt easily 18817 002504'01 336 04 0 00 002357* skipn t4, strc ; Load the prompt length 18818 002505'01 254 00 0 00 002527' ifskp. ; If not zero, see about using it 18819 002506'01 316 07 0 00 002475* camn q3, ttyjfn ; Not going to the terminal? 18820 002507'01 254 00 0 00 002512' ifskp. ; No, so will be doing a SOUTR% 18821 002510'01 313 04 0 00 002270* camle t4, vsomx ; Length less than or equal to the maximum seen? 18822 002511'01 202 04 0 00 002510* movem t4, vsomx ; Nope, we have a new SOUTR% maximum! 18823 002512'01 endif. ; End case SOUTR% max update 18824 002512'01 200 01 0 00 002502* move t1, parity ; Load the parity 18825 002513'01 302 01 0 00 003452' caie t1, none ; But!! Not doing any parity? 18826 002514'01 254 00 0 00 002524' ifskp. ; No, so just 'expand' the byte width 18827 002515'01 200 01 0 00 000004 move t1, t4 ; The strings are the same length 18828 002516'01 403 03 0 00 000006 setzb t3, q2 ; Both are section zero local 18829 002517'01 200 02 0 00 004026' move t2, [point 7, strbuf] ; Source is 7 bit 18830 002520'01 200 05 0 00 004210' move q1, [point 8, strbf2] ; Destination is 8 bit 18831 002521'01 123 01 0 00 000000* extend t1, movchr ; Do the byte width expansion 18832 002522'01 600 00 0 00 000000 nop ; Ignore any odd non-skip 18833 002523'01 254 00 0 00 002527' else. ; Otherwise, have to do some real parity 18834 002524'01 210 03 0 00 000004 movn t3, t4 ; genpar wants a negative count (like SOUT%) 18835 002525'01 120 01 0 00 004236' dmove t1, [ exp , ] 18836 002526'01 260 17 0 00 003676' call genpar ; Rewrite the string as 8 bit (7 + 1 bit parity) 18837 002527'01 endif. ; End 7 to 8 bit conversion, possibly with parity 18838 002527'01 endif. ; End case network prompt length check 18839 18840 002527'01 550 01 0 00 002005* hrrz t1, pars2 ; Let's get the output file opened 18841 002530'01 202 01 0 00 002447* movem t1, filjfn ; Store JFN (sans flags) 18842 002531'01 306 01 0 00 377777 cain t1, .nulio ; Opening .nulio does work, but it's a waste of time 18843 002532'01 254 00 0 00 002552' ifskp. ; A real file, so let's get this thing open 18844 002533'01 200 02 0 00 004240' movx t2, fld(7,of%bsz)!of%wr ; 7-bit bytes, write-only (I.E., no append) 18845 002534'01 104 00 0 00 000021 OPENF% ; Try to create the file 18846 002535'01 320 12 0 00 002537' ifje. r ; Failed?? 18847 002536'01 254 00 0 00 002552' K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 19:41 30-Mar-24 Page 32-1 K20IOC MAC 7-Jan-24 19:31 CAPTURE semantic action 18848 002537'01 200 04 0 00 000001 move t4, t1 ; Save error code for debugging 18849 002540'01 334 00 0 00 000000 %ermsg (,) ; Squawk and continue 18850 002541'01 254 00 0 00 002545' 18851 002542'01 265 01 0 00 002440* 18852 002543'01 000000000000# 18853 002544'01 254 00 0 00 002545' 18854 000736'04 125 156 141 142 154 18855 002545'01 402 00 0 00 002530* setzm filjfn ; Stomp JFN global storage 18856 002546'01 550 01 0 00 002527* hrrz t1, pars2 ; Reload the JFN 18857 002547'01 260 17 0 00 002352* call frclos ; Force it closed 18858 002550'01 600 00 0 00 000000 nop ; Ignore error and carry on 18859 002551'01 263 17 0 00 000000 ret ; And return; we can't do anything else 18860 002552'01 endif. ; End case OPENF% JSYS error handling 18861 002552'01 endif. ; End case skipping an OPENF% of .nulio 18862 18863 002552'01 260 17 0 00 002631' call caphrl ; Display the capture herald 18864 002553'01 260 17 0 00 002064* call ccon ; Turn on ^C trap 18865 002554'01 254 00 0 00 002625' jrst $capux ; Where to go upon ^C. 18866 002555'01 260 17 0 00 000000* call inilin ; Initialize the line for transfer 18867 18868 002556'01 do. ; Enter loop context 18869 002556'01 260 17 0 00 002772' call getcrt ; Get a carriage return terminated line of text 18870 002557'01 254 00 0 00 002625' jrst $capux ; On error, close the file and restore the line 18871 002560'01 260 17 0 00 003126' call eofovr ; Overwrite any EOF at the end of the string 18872 002561'01 200 01 0 00 002545* move t1, filjfn ; Load the file JFN 18873 002562'01 306 01 0 00 377777 cain t1, .nulio ; But!! Only going to toss it? 18874 002563'01 254 00 0 00 002575' ifskp. ; No, so do the write 18875 002564'01 323 14 0 00 002575' andg. p4 ; Unless we have nothing to write 18876 002565'01 200 02 0 00 004026' move t2,[point 7,strbuf] ;Source is the repacked string 18877 002566'01 210 03 0 00 000014 movn t3, p4 ; Load negative length because ... 18878 002567'01 104 00 0 00 000053 SOUT% ; Counted SOUT%'s are faster 18879 002570'01 320 12 0 00 002572' %jserr (,$capux) ; Complain and stop doing this 18880 002571'01 254 00 0 00 002575' 18881 002572'01 265 01 0 00 002542* 18882 002573'01 000000 000000 18883 002574'01 254 00 0 00 002625' 18884 002575'01 endif. ; End case writing the file (or tossing the data) 18885 002575'01 321 10 0 00 002625' jumpl q4, endlp. ; Break out of loop if allready hit EOF character 18886 002576'01 322 04 0 00 002556' jumpe t4, top. ; Don't print the prompt unless told to 18887 002577'01 336 05 0 00 002504* skipn q1, strc ; No search string, then? 18888 002600'01 254 00 0 00 002556' loop. ; No such luck, go get some more data 18889 002601'01 200 01 0 00 000007 move t1, q3 ; Load whatever transfer JFN we're using 18890 002602'01 200 02 0 00 004210' move t2,[point 8,strbf2] ;Point to search string 18891 002603'01 210 03 0 00 000005 movn t3, q1 ; Load exact count to do 18892 002604'01 312 01 0 00 002506* came t1, ttyjfn ; Going to the terminal? 18893 002605'01 254 00 0 00 002615' ifskp. ; Yes, that's easy enough 18894 002606'01 104 00 0 00 000053 SOUT% ; Boom, done 18895 002607'01 320 12 0 00 002611' %jserr (,$capux) ; or not... 18896 002610'01 254 00 0 00 002614' 18897 002611'01 265 01 0 00 002572* 18898 002612'01 000000 000000 18899 002613'01 254 00 0 00 002625' 18900 002614'01 254 00 0 00 002624' else. ; Otherwise, needs a poke to be on its way 18901 002615'01 104 00 0 00 000532 SOUTR% ; Write the network 18902 002616'01 320 12 0 00 002620' %jserr (,$capux) ; or not... K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 19:41 30-Mar-24 Page 32-2 K20IOC MAC 7-Jan-24 19:31 CAPTURE semantic action 18903 002617'01 254 00 0 00 002623' 18904 002620'01 265 01 0 00 002611* 18905 002621'01 000000 000000 18906 002622'01 254 00 0 00 002625' 18907 002623'01 272 05 0 00 002266* addm q1, vsotc ; Update tally of SOUTR% bytes 18908 002624'01 endif. ; End case writing the terminal 18909 002624'01 254 00 0 00 002556' loop. ; Either way, go get some more goodies 18910 002625'01 enddo. ; Exit loop lexical context 18911 18912 002625'01 260 17 0 00 000000* $capux: call rrslin ; Turn ^C trap off, close file, clear buffer 18913 002626'01 561 01 0 00 002376* hrroi t1, crlf ;[229] Tie off line 18914 002627'01 104 00 0 00 000076 PSOUT% ;[229] So INPUT in Batch works 18915 002630'01 263 17 0 00 000000 ret ; Done 18916 K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 19:41 30-Mar-24 Page 33 K20IOC MAC 7-Jan-24 19:31 Display herald for capture command 18917 subttl Display herald for capture command 18918 18919 ; Call: 18920 ; 18921 ; strc/ Indicates we have a prompt string 18922 ; filjfn/ Wherever we're writing the captured data 18923 ; q4/ EOF character (if we have one) 18924 ; 18925 ; N.B., If we bum all the SOUT%'s with a movslj, it will have to get 18926 ; executed in section or the text will need to be in section zero 18927 18928 002631'01 201 01 0 00 000101 caphrl: movei t1, .priou ; Output is always the terminal 18929 dxtext (t2,< 18930 002632'01 120 02 0 00 000000# [KERMIT-20: Capturing to >) ;Tell user we're starting. 18931 000226'02 000000000000# 18932 000227'02 777777 777745 18933 000744'04 015 012 133 113 105 18934 002633'01 104 00 0 00 000053 SOUT% ; Counted SOUT% is faster 18935 002634'01 320 12 0 00 002636' %jsErr (,) ; Whine and continue 18936 002635'01 254 00 0 00 002641' 18937 002636'01 265 01 0 00 002620* 18938 002637'01 000000000000# 18939 002640'01 254 00 0 00 002641' 18940 000752'04 125 156 141 142 154 18941 002641'01 200 02 0 00 002561* move t2, filjfn ; Load the JFN 18942 002642'01 302 02 0 00 377777 caie t2, .nulio ; But!! Just tossing it? 18943 002643'01 254 00 0 00 002654' ifskp. ; Yes, can't JFNS% because it chokes on a device 18944 002644'01 120 02 0 00 000000# dxtext (t2,) ; Easy enough to 'translate' (heh) 18945 000230'02 000000000000# 18946 000231'02 777777 777774 18947 000762'04 116 125 114 072 000 18948 002645'01 104 00 0 00 000053 SOUT% ; Counted SOUT% is faster 18949 002646'01 320 12 0 00 002650' %jsErr (,) ; What? Eh? 18950 002647'01 254 00 0 00 002653' 18951 002650'01 265 01 0 00 002636* 18952 002651'01 000000000000# 18953 002652'01 254 00 0 00 002653' 18954 000763'04 125 156 141 142 154 18955 002653'01 254 00 0 00 002663' else. ; Otherwise, assume a bona fide JFN 18956 002654'01 403 03 0 00 000004 setzb t3, t4 ; Standard formatting, no goofball prefix... 18957 002655'01 104 00 0 00 000030 JFNS% ; Type it 18958 002656'01 320 12 0 00 002660' %jsErr (,) ; Whine & continue 18959 002657'01 254 00 0 00 002663' 18960 002660'01 265 01 0 00 002650* 18961 002661'01 000000000000# 18962 002662'01 254 00 0 00 002663' 18963 000772'04 125 156 141 142 154 18964 002663'01 endif. ; End case output device special casing 18965 18966 002663'01 322 10 0 00 002720' ifn. q4 ; Do we have an EOF character? 18967 002664'01 120 02 0 00 000000# dxtext (t2,<, EOF: >) ; We do, so load the herald 18968 000232'02 000000000000# 18969 000233'02 777777 777771 18970 001003'04 054 040 105 117 106 18971 002665'01 104 00 0 00 000053 SOUT% ; Counted SOUT is faster K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 19:41 30-Mar-24 Page 33-1 K20IOC MAC 7-Jan-24 19:31 Display herald for capture command 18972 002666'01 320 12 0 00 002670' %jsErr (,) ; Whine and continue 18973 002667'01 254 00 0 00 002673' 18974 002670'01 265 01 0 00 002660* 18975 002671'01 000000000000# 18976 002672'01 254 00 0 00 002673' 18977 001005'04 125 156 141 142 154 18978 002673'01 200 02 0 00 000010 move t2, q4 ; Load the EOF character 18979 002674'01 405 02 0 00 000177 andi t2, ^o177 ; Stomp any parity 18980 002675'01 302 02 0 00 000033 caie t2, .chesc ; The escape character? 18981 002676'01 254 00 0 00 002701' ifskp. ; It is 18982 002677'01 201 02 0 00 000044 movei t2, "$" ; Replace it with our talisman 18983 002700'01 254 00 0 00 002712' else. ; Otherwise, it is a control character 18984 002701'01 201 03 0 02 000100 movei t3, <"A"-.chcna>(t2) ; Turn into ASCII and get out of the way 18985 002702'01 201 02 0 00 000136 movei t2, "^" ; Need the pointy up arrow 18986 002703'01 104 00 0 00 000051 BOUT% ; Type it 18987 002704'01 320 12 0 00 002706' %jsErr (,) ; Blat 18988 002705'01 254 00 0 00 002711' 18989 002706'01 265 01 0 00 002670* 18990 002707'01 000000000000# 18991 002710'01 254 00 0 00 002711' 18992 001013'04 125 156 141 142 154 18993 002711'01 200 02 0 00 000003 move t2, t3 ; Restore the character 18994 002712'01 endif. ; End case tweaking the EOF character for printing 18995 002712'01 104 00 0 00 000051 BOUT% ; Finally print whatever we made up 18996 002713'01 320 12 0 00 002715' %jsErr (,) ; Blat and continue 18997 002714'01 254 00 0 00 002720' 18998 002715'01 265 01 0 00 002706* 18999 002716'01 000000000000# 19000 002717'01 254 00 0 00 002720' 19001 001024'04 125 156 141 142 154 19002 002720'01 endif. ; End case printing EOF character 19003 19004 002720'01 336 00 0 00 002577* ifmn. strc ; Do we have a prompt string? 19005 002721'01 254 00 0 00 002741' 19006 002722'01 120 02 0 00 000000# dxtext (t2,<, prompt: >) ;we do, so type it 19007 000234'02 000000000000# 19008 000235'02 777777 777766 19009 001032'04 054 040 160 162 157 19010 002723'01 104 00 0 00 000053 SOUT% ; Counted SOUT% is faster 19011 002724'01 320 12 0 00 002726' %jsErr (,) ; Whine and continue 19012 002725'01 254 00 0 00 002731' 19013 002726'01 265 01 0 00 002715* 19014 002727'01 000000000000# 19015 002730'01 254 00 0 00 002731' 19016 001035'04 125 156 141 142 154 19017 002731'01 200 02 0 00 004210' move t2, [point 8, strbf2] ; Note, parity was put on the prompt 19018 002732'01 210 03 0 00 002720* movn t3, strc ; Load negative length because ... 19019 002733'01 104 00 0 00 000053 SOUT% ; a counted SOUT% is faster 19020 002734'01 320 12 0 00 002736' %jsErr (,); Whine and continue 19021 002735'01 254 00 0 00 002741' 19022 002736'01 265 01 0 00 002726* 19023 002737'01 000000000000# 19024 002740'01 254 00 0 00 002741' 19025 001045'04 125 156 141 142 154 19026 002741'01 endif. ; End case prompting K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 19:41 30-Mar-24 Page 33-2 K20IOC MAC 7-Jan-24 19:31 Display herald for capture command 19027 19028 002741'01 120 02 0 00 000000# dxtext (t2,<, type: >) ; Note trailing space !! 19029 000236'02 000000000000# 19030 000237'02 777777 777770 19031 001055'04 054 040 164 171 160 19032 002742'01 104 00 0 00 000053 SOUT% ; Counted SOUT% is faster 19033 002743'01 320 12 0 00 002745' %jsErr (,); Whine and continue 19034 002744'01 254 00 0 00 002750' 19035 002745'01 265 01 0 00 002736* 19036 002746'01 000000000000# 19037 002747'01 254 00 0 00 002750' 19038 001057'04 125 156 141 142 154 19039 002750'01 120 02 0 00 000000# dxtext (t2,<^C^C>) ; Assume default 19040 000240'02 000000000000# 19041 000241'02 777777 777774 19042 001065'04 136 103 136 103 000 19043 002751'01 200 04 0 00 000000# move t4, mycaps+1 ; Load enabled capabilities 19044 002752'01 607 04 0 00 400000 txnn t4, sc%ctc ; Is Control-C on?? 19045 002753'01 120 02 0 00 000000# dxtext (t2,<^G^G>) ; Wasn't ... 19046 000242'02 000000000000# 19047 000243'02 777777 777774 19048 001066'04 136 107 136 107 000 19049 002754'01 104 00 0 00 000053 SOUT% ; Counted SOUT% is faster 19050 002755'01 320 12 0 00 002757' %jsErr (,) ; Whine and continue 19051 002756'01 254 00 0 00 002762' 19052 002757'01 265 01 0 00 002745* 19053 002760'01 000000000000# 19054 002761'01 254 00 0 00 002762' 19055 001067'04 125 156 141 142 154 19056 19057 dxtext (t2,< to finish] 19058 002762'01 120 02 0 00 000000# >) ; Note initial leading space !! 19059 000244'02 000000000000# 19060 000245'02 777777 777763 19061 001100'04 040 164 157 040 146 19062 19063 002763'01 104 00 0 00 000053 SOUT% ; Counted SOUT% is faster 19064 002764'01 320 12 0 00 002766' %jsErr (,) ; Whine and continue 19065 002765'01 254 00 0 00 002771' 19066 002766'01 265 01 0 00 002757* 19067 002767'01 000000000000# 19068 002770'01 254 00 0 00 002771' 19069 001103'04 125 156 141 142 154 19070 19071 002771'01 263 17 0 00 000000 ret ; Finally done 19072 K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 19:41 30-Mar-24 Page 34 K20IOC MAC 7-Jan-24 19:31 Get a carriage return terminated line of text 19073 subttl Get a carriage return terminated line of text 19074 19075 ; Call: 19076 ; 19077 ; q3/ JFN we're reading from, typically netjfn 19078 ; p2/ EOF character without parity 19079 ; q4/ EOF character, if doing EOF 19080 ; 19081 ; Return: 19082 ; 19083 ; +1/ Any kind of error 19084 ; +2/ Hit either carriage return or an EOF 19085 ; 19086 ; t4/ 0 if didn't hit a carriage return 19087 ; -1 if we did (a linefeed will be appended!!) 19088 ; q1/ Points to last character in seven bit stream 19089 ; q4/ -1 if hit the EOF character 19090 ; p2/ Preserved, always 19091 ; p4/ Total characters that have been buffered up 19092 19093 002772'01 265 16 0 00 004241' getcrt: saveac ; Used as scratch 19094 002773'01 403 14 0 00 000015 setzb p4, p5 ; Assume won't buffer anything or hit a CR 19095 002774'01 200 13 0 00 004143' move p3,[point 8,strbuf] ;Will be reading into the string buffer 19096 ; Loop reads until EOF, CR or buffer full 19097 002775'01 do. ; Enter loop context 19098 002775'01 301 14 0 00 003776 cail p4, capmxl ; Would the read overflow the buffer? 19099 002776'01 254 00 0 00 003074' exit. ; Then don't read another thing 19100 002777'01 200 01 0 00 000007 move t1, q3 ; Load the input JFN 19101 003000'01 104 00 0 00 000050 BIN% ; Wait for a byte 19102 003001'01 320 12 0 00 003003' %jsErr (,r) ; Whine and return 19103 003002'01 254 00 0 00 003006' 19104 003003'01 265 01 0 00 002766* 19105 003004'01 000000000000# 19106 003005'01 254 00 0 00 002243* 19107 001113'04 105 162 162 157 162 19108 003006'01 312 01 0 00 002604* came t1, ttyjfn ; Was this the local terminal? 19109 003007'01 350 00 0 00 000473* aos nbict ; No, so count a network BIN%, then 19110 003010'01 200 01 0 00 000002 move t1, t2 ; Check the parity on this poor character 19111 003011'01 260 17 1 00 002512* call @parity ; Calculate the parity (if any) 19112 003012'01 312 01 0 00 000002 came t1, t2 ; Is the parity the same?? 19113 003013'01 254 00 0 00 003030' ifskp. ; That's dandy, let's use it 19114 003014'01 136 02 0 00 000013 idpb t2, p3 ; Append the single byte we got 19115 003015'01 271 14 0 00 000001 addi p4, ^d1 ; and count it 19116 003016'01 322 10 0 00 003023' ifn. q4 ; Doing EOF?? 19117 003017'01 312 02 0 00 000010 came t2, q4 ; We are. Is this the EOF? 19118 003020'01 254 00 0 00 003023' anskp. ; Isn't, so just carry on 19119 003021'01 474 10 0 00 000000 seto q4, ; Flag hit EOF 19120 003022'01 254 00 0 00 003074' exit. ; Exit the loop 19121 003023'01 endif. ; End case possible EOF checking 19122 003023'01 312 02 0 00 000012 came t2, p2 ; Was the character a carriage return? 19123 003024'01 254 00 0 00 003027' ifskp. ; It was, so check and return this line 19124 003025'01 474 15 0 00 000000 seto p5, ; Flag hit carriage return 19125 003026'01 254 00 0 00 003074' exit. ; Get out of the loop 19126 003027'01 endif. ; End case checking for carriage return 19127 003027'01 254 00 0 00 003034' else. ; Not, so a parity error K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 19:41 30-Mar-24 Page 34-1 K20IOC MAC 7-Jan-24 19:31 Get a carriage return terminated line of text 19128 003030'01 200 01 0 00 000000# emsg 19129 003031'01 104 00 0 00 000313 19130 000246'02 000000000000# 19131 001121'04 102 141 144 040 160 19132 003032'01 350 00 0 00 000000* aos ttipar ; Count a detected parity error 19133 003033'01 263 17 0 00 000000 ret ; And give an error return 19134 003034'01 endif. ; End case checking parity 19135 003034'01 260 17 0 00 000476* call clrest ; Find out how much, if anything, remains 19136 003035'01 263 17 0 00 000000 ret ; Failed somehow, just give up 19137 003036'01 322 01 0 00 002775' jumpe t1, top. ; If nothing to read, go wait for something 19138 remark ; Otherwise, get the rest of the goodies 19139 003037'01 200 02 0 00 000001 move t2, t1 ; Save a working copy 19140 003040'01 270 02 0 00 000014 add t2, p4 ; Calculate what would be the final total 19141 003041'01 307 02 0 00 003776 caig t2, capmxl ; Would this read overflow the buffer? 19142 003042'01 254 00 0 00 003045' ifskp. ; It would, so clip down to maximum 19143 003043'01 275 02 0 00 003776 subi t2, capmxl ; Calculate the overflow 19144 003044'01 274 01 0 00 000002 sub t1, t2 ; And reduce the read by that amount 19145 003045'01 endif. ; End case buffer overflow check 19146 003045'01 200 11 0 00 000001 move p1, t1 ; Save final maximum 19147 003046'01 200 01 0 00 000007 move t1, q3 ; Load whatever transfer JFN we're using 19148 003047'01 200 02 0 00 000013 move t2, p3 ; Load current position in buffer 19149 003050'01 120 03 0 00 000011 dmove t3, p1 ; Load maximum we'll read and terminator 19150 003051'01 104 00 0 00 000052 SIN% ; And grab whatever else is waiting for us 19151 003052'01 320 12 0 00 003054' %jsErr (,r) ; Whine and return 19152 003053'01 254 00 0 00 003057' 19153 003054'01 265 01 0 00 003003* 19154 003055'01 000000000000# 19155 003056'01 254 00 0 00 003005* 19156 001132'04 105 162 162 157 162 19157 003057'01 200 13 0 00 000002 move p3, t2 ; Update current position in buffer 19158 003060'01 274 11 0 00 000003 sub p1, t3 ; Subtract negative to get total characters transferred 19159 003061'01 316 07 0 00 003006* camn q3, ttyjfn ; Not using the local terminal? 19160 003062'01 254 00 0 00 003067' ifskp. ; No, so updates some more variables 19161 003063'01 350 00 0 00 000512* aos nsici ; Update Network SIN%'s Issued 19162 003064'01 313 11 0 00 000510* camle p1, nsimx ; Smaller than biggest? 19163 003065'01 202 11 0 00 003064* movem p1, nsimx ; Nope, we have a new winner 19164 003066'01 272 11 0 00 000523* addm p1, nsitc ; Update Network SIN% total characters read 19165 003067'01 endif. ; End case network tally updates 19166 003067'01 270 14 0 00 000011 add p4, p1 ; Compute total characters in strbuf 19167 003070'01 135 01 0 00 000002 ldb t1, t2 ; Pick up the last eight bit character 19168 003071'01 312 01 0 00 000012 came t1, p2 ; Was it a carriage return?? 19169 003072'01 254 00 0 00 002775' loop. ; Wasn't, so go get some more data 19170 003073'01 474 15 0 00 000000 seto p5, ; Otherwise, it was, so flag and fall out of the loop 19171 003074'01 enddo. ; End loop lexical context 19172 19173 remark ; Check parity and repack the string 19174 003074'01 200 02 0 00 004143' move t2,[point 8,strbuf] ;Point to network input buffer 19175 003075'01 210 03 0 00 000014 movn t3, p4 ; Pretend doing a SOUT% 19176 remark ; If no parity, chkpar will return +2 19177 003076'01 260 17 0 00 003721' call chkpar ; Check the parity 19178 003077'01 254 00 0 00 003110' ifskp. ; Everything is fine, so convert to 7 bit 19179 003100'01 200 01 0 00 000014 move t1, p4 ; Source length is the total characters gotten 19180 003101'01 200 02 0 00 004143' move t2,[point 8,strbuf] ;Which comes from the network data 19181 003102'01 403 03 0 00 000006 setzb t3, q2 ; Pointers are section zero local 19182 003103'01 200 04 0 00 000014 move t4, p4 ; Output string is same length K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 19:41 30-Mar-24 Page 34-2 K20IOC MAC 7-Jan-24 19:31 Get a carriage return terminated line of text 19183 003104'01 200 05 0 00 004026' move q1,[point 7,strbuf] ;Destination is same with smaller byte size 19184 003105'01 123 01 0 00 002521* extend t1, movchr ; Repack the string in place (which is safe) 19185 003106'01 600 00 0 00 000000 nop ; Ignore any odd non-skip 19186 003107'01 254 00 0 00 003114' else. ; Otherwise, badness 19187 003110'01 200 01 0 00 000000# emsg 19188 003111'01 104 00 0 00 000313 19189 000247'02 000000000000# 19190 001141'04 102 141 144 040 160 19191 003112'01 350 00 0 00 003032* aos ttipar ; Count a detected parity error 19192 003113'01 263 17 0 00 000000 ret ; And fail the call 19193 003114'01 endif. ; End parity check 19194 19195 003114'01 326 15 0 00 003121' ife. p5 ; If no CR, fix up the last pointer 19196 003115'01 474 02 0 00 000000 seto t2, ; movchr points PAST the last character 19197 003116'01 133 02 0 00 000005 adjbp t2, q1 ; So back up the 7 bit pointer by one 19198 003117'01 200 05 0 00 000002 move q1, t2 ; And pass that back 19199 003120'01 254 00 0 00 003124' else. ; Otherwise, we hit the carriage return!! 19200 003121'01 201 01 0 00 000012 movei t1, .chlfd ; So will need a line feed 19201 003122'01 136 01 0 00 000005 idpb t1, q1 ; Append it 19202 003123'01 271 14 0 00 000001 addi p4, ^d1 ; and acCOUNT for it (Boo...) 19203 003124'01 endif. ; End case carriage return fix up 19204 19205 003124'01 200 04 0 00 000015 move t4, p5 ; Pass back the carriage return flag 19206 003125'01 254 00 0 00 002051* retskp ; Return success 19207 K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 19:41 30-Mar-24 Page 35 K20IOC MAC 7-Jan-24 19:31 Check for and Overwrite EOF at the end of the string 19208 subttl Check for and Overwrite EOF at the end of the string 19209 19210 ; Assumes that the EOF is always within three characters of the last 19211 ; character, including that character. This is based on how the EOF 19212 ; logic sends the character in TRANSMIT and how the CAPTURE logic will 19213 ; append a linefeed to any carriage return it finds. In other words, 19214 ; the sequence we check for is . However, if we bump 19215 ; into the EOF before we've checked everything, that's fine, too. 19216 ; 19217 ; Call: 19218 ; 19219 ; q1/ Points to the last character in the seven bit stream 19220 ; q4/ EOF character with parity (if we're doing any parity) 19221 ; p3/ EOF character without parity (whether or not we're doing parity) 19222 ; p4/ Length of string we're just about to write 19223 ; 19224 ; Return: 19225 ; 19226 ; +1, always 19227 ; 19228 ; q1/ Unchanged, string will have EOF character stripped if q4 was -1 19229 ; q4/ Set to -1, if found the EOF character 19230 ; p3/ Unchanged 19231 ; p4/ Length will be less, depending on where we found the EOF 19232 ; 19233 ; All other registers are preserved 19234 ; 19235 ; N.B., EVERYTHING after the EOF is tossed, including the EOF!! 19236 19237 003126'01 322 13 0 00 003056* eofovr: jumpe p3, r ; If not checking EOF, we have nothing to do 19238 003127'01 323 14 0 00 003126* jumple p4, r ; Don't bother if funny length, either 19239 ; First do the trivial edge cases 19240 003130'01 325 10 0 00 003133' ifl. q4 ; So, did somebody else already flag this? 19241 003131'01 275 14 0 00 000001 subi p4, ^d1 ; They did, so don't write the EOF to the file 19242 003132'01 263 17 0 00 000000 ret ; After shortening length, we're done 19243 003133'01 endif. ; End trivial case of somebody already told us 19244 ; Next trivial case? Is it at the end? 19245 003133'01 135 01 0 00 000005 ldb t1, q1 ; Get the last character 19246 003134'01 312 01 0 00 000013 came t1, p3 ; EOF already? 19247 003135'01 254 00 0 00 003141' ifskp. ; That was easy, just reduce the length 19248 003136'01 474 10 0 00 000000 seto q4, ; Flag we hit EOF 19249 003137'01 275 14 0 00 000001 subi p4, ^d1 ; We're not writing EOF to the file 19250 003140'01 263 17 0 00 000000 ret ; and return; we're done 19251 003141'01 endif. ; End case checking last character 19252 ; Final trivial case, a single character string 19253 003141'01 306 14 0 00 000001 cain p4, ^d1 ; Just this one dinky character? 19254 003142'01 263 17 0 00 000000 ret ; Fine, we didn't hit the EOF ... 19255 ; Otherwise, this is about to get harder 19256 003143'01 265 16 0 00 004253' saveac 19257 003144'01 201 07 0 00 000003 movei q3, ^d3 ; Will assume sequence is 19258 003145'01 313 07 0 00 000014 camle q3, p4 ; BUT!! Do we have enough characters? 19259 003146'01 200 07 0 00 000014 move q3, p4 ; No, so clip it down to remaining 19260 003147'01 363 07 0 00 003127* sojle q3, R ; Account for character we just checked (in t1) 19261 ; Also double checks our arithmatic, above 19262 003150'01 474 06 0 00 000000 seto q2, ; Back up the pointer K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 19:41 30-Mar-24 Page 35-1 K20IOC MAC 7-Jan-24 19:31 Check for and Overwrite EOF at the end of the string 19263 003151'01 133 06 0 00 000005 adjbp q2, q1 ; Now pointing at penultimate character 19264 003152'01 135 02 0 00 000006 ldb t2, q2 ; and load that character 19265 003153'01 312 02 0 00 000013 came t2, p3 ; Hit the EOF? 19266 003154'01 254 00 0 00 003161' ifskp. ; We did 19267 003155'01 474 10 0 00 000000 seto q4, ; Flag we hit EOF 19268 003156'01 275 14 0 00 000002 subi p4, ^d2 ; We punted two characters from the string 19269 003157'01 263 17 0 00 000000 ret ; and return; we're done 19270 003160'01 254 00 0 00 003163' else. ; We didn't hit the EOF 19271 003161'01 306 07 0 00 000001 cain q3, ^d1 ; Was it a two character string, then? 19272 003162'01 263 17 0 00 000000 ret ; Then we're done, no EOF found 19273 003163'01 endif. ; End case checking penultimate character 19274 003163'01 363 07 0 00 003147* sojle q3, R ; Account for this second character we just checked 19275 ; Checking last character, so can reuse q3 19276 003164'01 474 07 0 00 000000 seto q3, ; Back up the pointer one more 19277 003165'01 133 07 0 00 000006 adjbp q3, q2 ; Now pointing at the antipenultimate character 19278 003166'01 135 03 0 00 000007 ldb t3, q3 ; and load that character 19279 003167'01 312 03 0 00 000013 came t3, p3 ; Hit the EOF finally?? 19280 003170'01 263 17 0 00 000000 ret ; Nope, so wasn't in this string 19281 003171'01 474 10 0 00 000000 seto q4, ; It's the EOF! So flag we found it 19282 003172'01 275 14 0 00 000003 subi p4, ^d3 ; Punting three characters from the string 19283 003173'01 263 17 0 00 000000 ret ; and return; we're done 19284 19285 ;[230] End code insertion 19286 K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 19:41 30-Mar-24 Page 36 K20IOC MAC 7-Jan-24 19:31 Translation table for MOVST to not uppercase 19287 subttl Translation table for MOVST to not uppercase 19288 19289 ;[209] Begin code and table insertion 19290 19291 ; Inspired by my rewrite of SETNOD, SETND2 (ND2SUB.MAC) 19292 19293 chgsec(code,const) ;;Put tables in the constants .psect 19294 19295 000002 %ascii=.chcnb ; ASCII values start at Control-B 19296 19297 remark Character table simply moves characters until a backslash is hit 19298 19299 000250'02 chrtab: intern chrtab ; Also used by k20par 19300 000250'02 100000 000001 xwd eoscod,.chcna ; NUL is end of string, ^A is allowed 19301 xlist ; Don't need to see all this junk 19302 list ; Restart the blather 19303 19304 000350' %eochr=. ; Remember end of table 19305 000326'02 reloc chrtab+<<"\">_-1> ; Gets us to the corrct halfword pair 19306 000326'02 500134 000135 xwd >,135 ;Stop on a backslash, emit a right brocket 19307 000350'02 reloc %eochr ; Get to end of table 19308 19309 100200 %ascii=eoscod!200!.chnul ; Anything we translate with bit 8 is bad 19310 xlist ; Don't need to see all this junk 19311 list ; Restart the blather 19312 19313 000550' %eotup=. ; Remember end of table 19314 000526'02 reloc chrtup+<<"\">_-1> ; Gets us to the corrct halfword pair 19315 000526'02 500134 000135 xwd >,135 ;Stop on a backslash, emit a right brocket 19316 000530'02 reloc chrtup+<<"`">_-1> ; Gets us to the corrct halfword pair 19317 000530'02 000140 000101 xwd "`","A" ; Convert lowercase a to UPPERcase A 19318 000102 %ascus="B" ; Starting at lowercase b 19319 xlist ; Don't need to see all this junk 19320 list ; Restart the blather 19321 000545'02 000132 000173 xwd "Z",173 ; Last letter and Left brace 19322 19323 000550'02 reloc %eotup ; Get to end of table 19324 19325 remark For eight bit data, everything stops us 19326 19327 100200 %ascus=eoscod!200!.chnul ; Anything we translate with bit 8 is bad 19328 xlist ; Don't need to see all this junk 19329 list ; Restart the blather 19330 retsec ; Re-open executable code 19331 19332 cleans(<%ascus,%eotup>) ; Don't polute the symbol table 19333 19334 K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 19:41 30-Mar-24 Page 38 K20IOC MAC 7-Jan-24 19:31 cescxp C Escape Expansion 19335 subttl cescxp C Escape Expansion 19336 19337 ; Given a source and destination pointer, copies the string from the 19338 ; source to the destination, triggering C escape expansion where 19339 ; appropriate. The source string MUST be NUL terminated 19340 ; 19341 ; If case is being ignored, then the string is UPPERcased as it is 19342 ; copied to facilitate later usage of string comparison instructions. 19343 ; 19344 ; Returns updated pointers and length. The destination buffer can 19345 ; never fill before the input buffer empties because any expansion 19346 ; involves converting two or more characters to a single character. 19347 ; 19348 19349 ; Parity MUST be stripped before calling this routine. Although it is 19350 ; commonly called with a 7 bit pointer, it will accept 8 bit pointers 19351 ; PROVIDED that the parity bit has been removed. It will FAIL if it 19352 ; detects a character with bit 8 set. 19353 ; 19354 ; Assumes section local pointers, do not use OWGP as the wrong 19355 ; thing will be returned. 19356 19357 003174'01 015 00 0 00 000000# chrmov: movst 0,chrtab ; Moves string without UPPERcasing 19358 003175'01 000000 000000 .chnul ; Fill character is end of string 19359 19360 003176'01 015 00 0 00 000000# chrmup: movst 0,chrtup ; Translate table to UPPERcase 19361 003177'01 000000 000000 .chnul ; Fill character is end of string 19362 19363 ; Call: 19364 ; 19365 ; t1/ Destination string pointer 19366 ; t2/ Source string pointer 19367 ; t3/ Maximum length of destination 19368 ; t4/ Translation table to use (whether matching case or not) 19369 ; 19370 ; Returns: 19371 ; 19372 ; +1/ Something bad happened or did nothing 19373 ; +2/ Good return 19374 ; 19375 ; t1/ Updated destination string pointer 19376 ; t2/ Updated source string pointer 19377 ; t3/ Length we translated 19378 19379 003200'01 cescxp: entry cescxp ; Also used by k20par 19380 003200'01 265 16 0 00 004271' saveac ;[248] Save registers for piggy MOVST 19381 003201'01 550 11 0 00 000004 hrrz p1, t4 ; Save requested table 19382 003202'01 505 11 0 00 015000 hrli p1, (movst 0,) ; Load correct extended instruction opcode 19383 003203'01 400 12 0 00 000000 setz p2, ; .chnul is the fill character 19384 003204'01 200 05 0 00 000001 move q1, t1 ; Position destination for MOVST 19385 003205'01 200 01 0 00 000003 move t1, t3 ; Set source length 19386 003206'01 200 04 0 00 000003 move t4, t3 ; Same as destination (so no fill) 19387 003207'01 200 07 0 00 000003 move q3, t3 ; Save (original) length for later 19388 003210'01 403 03 0 00 000006 setzb t3, q2 ; Force local pointers 19389 003211'01 400 13 0 00 000000 setz p3, ;[248] Count of characters munched K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 19:41 30-Mar-24 Page 38-1 K20IOC MAC 7-Jan-24 19:31 cescxp C Escape Expansion 19390 003212'01 621 01 0 00 300000 txz t1, N!M ; Clear translation flags 19391 19392 003213'01 do. ; Enter loop context 19393 003213'01 661 01 0 00 400000 txo t1,S ; Set significance flag (start translating) 19394 003214'01 123 01 0 00 000011 extend t1, p1 ; Move the string, testing for end and 19395 003215'01 320 12 0 00 003217' %jserr (, r) ; Pass any machine error back up 19396 003216'01 254 00 0 00 003222' 19397 003217'01 265 01 0 00 003054* 19398 003220'01 000000000000# 19399 003221'01 254 00 0 00 003163* 19400 001153'04 115 117 126 123 124 19401 003222'01 623 01 0 00 200000 txze t1, N ; Bumped into a backslash? 19402 003223'01 254 00 0 00 003230' ifskp. ; We did not and may not have exhausted source 19403 003224'01 621 01 0 00 700000 txz t1, S!N!M ; Clear all the flags 19404 003225'01 200 10 0 00 000002 move q4, t2 ; Keep stopping source pointer 19405 003226'01 322 01 0 00 003237' jumpe t1, endlp. ;[248] If source is exhausted, we're done 19406 003227'01 344 01 0 00 003237' aoja t1, endlp. ; Account that .chnul was not consumed 19407 003230'01 endif. ; and we are done with the string move 19408 003230'01 621 01 0 00 700000 txz t1, S!N!M ; Clear all the flags 19409 003231'01 323 01 0 00 003237' jumple t1, endlp. ;[248] Done if no more source 19410 003232'01 323 04 0 00 003237' jumple t4, endlp. ;[248] Done if no more destination 19411 003233'01 271 13 0 00 000001 addi p3, ^d1 ;[248] Account for a backslash skipped 19412 003234'01 260 17 0 00 003261' call escchr ; Otherwise, process an escape character 19413 003235'01 263 17 0 00 000000 ret ; Failed, just stop right now 19414 003236'01 327 01 0 00 003213' jumpg t1, top. ; Keep moving characters until no more 19415 003237'01 enddo. ; End loop context 19416 19417 remark t2, ; Still has source 19418 003237'01 200 03 0 00 000007 move t3, q3 ; Load original length 19419 003240'01 274 03 0 00 000013 sub t3, p3 ;[248] ; Calculate what we finally produced 19420 003241'01 200 04 0 00 000001 move t4, t1 ;[248] ; Save final source count: 19421 003242'01 200 01 0 00 000005 move t1, q1 ;[248] ; Restore updated destination BEFORE terminating it 19422 003243'01 136 06 0 00 000005 idpb q2, q1 ;[248] ; Tie off destination 19423 ; Stopped before the end of the string? 19424 003244'01 323 04 0 00 003255' ifg. t4 ;[248] ; Uh oh... Stopped early. What did that? 19425 003245'01 135 04 0 00 000010 ldb t4, q4 ; Load source character that stopped us 19426 003246'01 246 04 0 00 777777 lshc t4, ^d<-1> ; Divide by two, shifting odd bit into bit zero 19427 003247'01 242 05 0 00 777735 lsh q1, ^d<-35> ; Shift into bit zero 19428 xct [ hlrz q2,chrtab(t4) ; Even, pick up left half 19429 003250'01 256 00 0 05 004307' hrrz q2,chrtab(t4) ](q1) ; Even, pick up right half 19430 003251'01 626 06 0 00 100000 txzn q2, eoscod ; Had to be an end of string 19431 003252'01 254 00 0 00 003255' anskp. ; But wasn't, so we're done 19432 003253'01 622 06 0 00 000200 txze q2, 200 ; Any parity? 19433 003254'01 263 17 0 00 000000 ret ; Yes, so that's bad; return +1 19434 003255'01 endif. ; End eigth bit checking 19435 003255'01 323 03 0 00 003221* jumple t3, R ; Nothing to do if nothing read 19436 003256'01 254 00 0 00 003125* retskp ; Return +2 19437 K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 19:41 30-Mar-24 Page 39 K20IOC MAC 7-Jan-24 19:31 Escape table for escape character substitution 19438 subttl Escape table for escape character substitution 19439 19440 ; The translate table assumes that exactly a SINGLE character is to be 19441 ; translated, unless a number is being given. The logic coupled with 19442 ; it is as follows: 19443 ; 19444 ; 1) If the character count is zero, then a single character 19445 ; substitution was possible and we are done. 19446 ; 19447 ; 2) Any character that does not have a valid escape mapping will 19448 ; terminate with the N bit set (note TRMCOD opcode). 19449 ; 19450 ; 3) Any character that requires further processing will terminate 19451 ; processing (EOSCOD), but the count will not be zero. These 19452 ; characters are currenly upper and lower X and decimal digits. 19453 19454 chgsec(code,const) ;;Put table in the constants .psect 19455 19456 000000 %escha=0 ; Starts out at .CHNUL 19457 19458 000650'02 esctab: remark ; Appropriately trigger on escape values 19459 xlist ; Don't need to see all this junk 19460 list ; Restart the blather 19461 19462 000750' %eoesc=. ; Remember end of table 19463 19464 000700'02 reloc esctab+<<"0">_-1> ; Gets us to the correct halfword pair 19465 xlist ; Save the trees!!! 19466 list ; Restart the blather 19467 19468 define escsub(chr1,sub1,chr2,sub2) < 19469 reloc esctab+<<&177>_-1> ;;Gets us to the correct halfword pair 19470 xwd sub1,sub2 ;;Emit the appropriate pair 19471 >;;escsub 19472 19473 000677'02 000056 500057 escsub(".",<".">,"/",) ;;Tops-10 monitor prompt 19474 000710'02 000100 000007 escsub("@",<"@">,"A",.chbel) ;;I kept fat fingering \@ ... 19475 000711'02 000010 000003 escsub("B",.chbsp,"C",.chcnc) 19476 000712'02 000004 000033 escsub("D",.chcnd,"E",.chesc) 19477 000713'02 000014 500107 escsub("F",.chffd,"G",); 19478 19479 000717'02 000012 000177 escsub("N",.chlfd,"O",.chdel) ;;[246] Obliterate 19480 000720'02 500120 000042 escsub("P",,"Q",.chdbq) 19481 000721'02 000015 500123 escsub("R",.chcrt,"S",) 19482 000722'02 000011 000000 escsub("T",.chtab,"U",.chnul) ;;[246] NUL 19483 000723'02 000013 500127 escsub("V",.chvtb,"W",) 19484 000725'02 000032 500133 escsub("Z",.chcnz,"[",) ;;Left brocket 19485 19486 000730'02 500140 000007 escsub("`",,"a",.chbel) 19487 000731'02 000010 000003 escsub("b",.chbsp,"c",.chcnc) 19488 000732'02 000004 000033 escsub("d",.chcnd,"e",.chesc) 19489 000733'02 000014 500147 escsub("f",.chffd,"g",); 19490 19491 000737'02 000012 000177 escsub("n",.chlfd,"o",.chdel) ;;[246] Obliterate 19492 000740'02 500160 000042 escsub("p",,"q",.chdbq) K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 19:41 30-Mar-24 Page 39-1 K20IOC MAC 7-Jan-24 19:31 Escape table for escape character substitution 19493 000741'02 000015 500163 escsub("r",.chcrt,"s",) 19494 000742'02 000011 000000 escsub("t",.chtab,"u",.chnul) ;;[246] NUL 19495 000743'02 000013 500167 escsub("v",.chvtb,"w",) 19496 000745'02 000032 500173 escsub("z",.chcnz,173,) ;;Left curly brace 19497 19498 000671'02 000042 500043 escsub(.chdbq,.chdbq,"#",) ;;Double quote 19499 000673'02 500046 000047 escsub("&",,"'","'") 19500 000707'02 500076 000077 escsub(76,,"?","?") ;;Left pointy bracket 19501 000726'02 000134 500135 escsub("\","\","]",) ;;Right broket 19502 19503 000750'02 reloc %eoesc ; Get to back to end of table 19504 retsec ;;Re-open executable code 19505 19506 cleans(<%escha,%eoesc>) ;;Don't polute the symbol table 19507 19508 K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 19:41 30-Mar-24 Page 40 K20IOC MAC 7-Jan-24 19:31 Handle escape character substitution and expansion 19509 subttl Handle escape character substitution and expansion 19510 19511 ; See esctab commentary above for this routine's logic summary. In 19512 ; this routine's case, the MOVST is not being used for the efficiency 19513 ; of moving a string but rather for the 'relative' ease of using a 19514 ; table driven approach. However, this would still probably be more 19515 ; efficient than a worst case skip chain. 19516 ; 19517 ; Call: 19518 ; 19519 ; t1/ Remaining bytes in source string 19520 ; t2/ Section local pointer to source 19521 ; t3/ 0 (and must be zero) 19522 ; t4/ Remaining bytes in destination string 19523 ; q1/ Section local pointer to destination 19524 ; q2/ 0 (and must be zero) 19525 ; p3/ Count of characters skipped in source (like backslash and octal digits) ;[248] 19526 ; 19527 ; Return: 19528 ; 19529 ; +1/ Failed somehow 19530 ; +2/ Escape character substituted or expanded 19531 ; 19532 ; t1 through q2 updates as appropriate. 19533 ; p3 updated if doing something like a \002 ;[248] 19534 ; 19535 ; Be aware of the following: 19536 ; 19537 ; While the routine is fairly defensively coded, it makes an 19538 ; assumption that the destination string is always at least as long as 19539 ; the source. If this is the case, then the destination storage space 19540 ; can NEVER be overflowed because the minimal substitution will remove 19541 ; two characters from the source while depositing a single character 19542 ; in the destination. 19543 19544 003257'01 015 00 0 00 000000# escmov: movst 0,esctab ; Actual extend instruction being executed 19545 003260'01 000000 000000 .chnul ; Fill character is end of string (never used) 19546 19547 003261'01 escchr: entry escchr ; Used in k20par 19548 003261'01 265 16 0 00 004071' saveac ;[248] Extend needs SO many registers... 19549 003262'01 621 01 0 00 700000 txz t1, N!M!S ; Stomp flags so math and EXTEND work 19550 003263'01 337 07 0 00 000001 skipg q3, t1 ; Save and check remaining source count 19551 003264'01 334 00 0 00 000000 %ermsg (,r) 19552 003265'01 254 00 0 00 003271' 19553 003266'01 265 01 0 00 003217* 19554 003267'01 000000000000# 19555 003270'01 254 00 0 00 003255* 19556 001156'04 105 163 143 141 160 19557 003271'01 200 10 0 00 000004 move q4, t4 ; Save current remaining destination count 19558 19559 003272'01 200 01 0 00 004311' move t1,[S!<^d1>] ; Only looking at a SINGLE character of source 19560 003273'01 201 04 0 00 000001 movei t4,^d1 ; Destination will be always be one character 19561 003274'01 123 01 0 00 003257' extend t1, escmov ; Try to expand the escape 19562 003275'01 320 12 0 00 003277' %jserr (, r) ; Pass any machine error back up 19563 003276'01 254 00 0 00 003302' K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 19:41 30-Mar-24 Page 40-1 K20IOC MAC 7-Jan-24 19:31 Handle escape character substitution and expansion 19564 003277'01 265 01 0 00 003266* 19565 003300'01 000000000000# 19566 003301'01 254 00 0 00 003270* 19567 001167'04 105 163 143 141 160 19568 19569 003302'01 607 01 0 00 200000 ifxn. t1, N ; Invalid escape character?? 19570 003303'01 254 00 0 00 003314' 19571 003304'01 200 01 0 00 000000# emsg 19572 003305'01 104 00 0 00 000313 19573 000750'02 000000000000# 19574 001173'04 111 154 154 145 147 19575 003306'01 135 01 0 00 000002 ldb t1, t2 ; Pick up what didn't work 19576 003307'01 104 00 0 00 000074 PBOUT% ; Show us 19577 003310'01 561 01 0 00 002626* hrroi t1, crlf ; Load end of line 19578 003311'01 104 00 0 00 000076 PSOUT% ; Print it 19579 003312'01 263 17 0 00 000000 ret ; Return failure 19580 003313'01 254 00 0 00 003316' else. ;[248] ; Otherwise, valid translation 19581 003314'01 621 01 0 00 700000 txz t1, N!M!S ;[248] ; Stomp flags so math works 19582 003315'01 200 11 0 00 000001 move p1, t1 ;[248] ; Save source count 19583 003316'01 endif. ;[248] ; End case handling an invalid escape character 19584 19585 003316'01 326 04 0 00 003334' ife. t4 ; Was this a simple substitution? 19586 003317'01 375 01 0 00 000007 sosge t1, q3 ; Yes, account for source byte consumed 19587 003320'01 334 00 0 00 000000 %ermsg (,r) 19588 003321'01 254 00 0 00 003325' 19589 003322'01 265 01 0 00 003277* 19590 003323'01 000000000000# 19591 003324'01 254 00 0 00 003301* 19592 001201'04 105 163 143 141 160 19593 003325'01 375 04 0 00 000010 sosge t4, q4 ; Account for destination byte consumed 19594 003326'01 334 00 0 00 000000 %ermsg (,r) 19595 003327'01 254 00 0 00 003333' 19596 003330'01 265 01 0 00 003322* 19597 003331'01 000000000000# 19598 003332'01 254 00 0 00 003324* 19599 001212'04 105 163 143 141 160 19600 003333'01 254 00 0 00 003256* retskp ; Return success 19601 003334'01 endif. 19602 19603 remark ; Here if we hit a digit 0 through 9 19604 003334'01 200 01 0 00 000007 move t1, q3 ; Original remaining source bytes is fine 19605 003335'01 200 11 0 00 000007 move p1, q3 ;[248] ; Save for later calculations 19606 003336'01 474 03 0 00 000000 seto t3, ; But must back up the source pointer 19607 003337'01 133 03 0 00 000002 adjbp t3, t2 ; because it did not translate the byte 19608 003340'01 200 02 0 00 000003 move t2, t3 ; Overwrite current 19609 003341'01 400 03 0 00 000000 setz t3, ; Keep source pointer section local 19610 003342'01 200 04 0 00 000010 move t4, q4 ; Restore original remaining destination bytes 19611 003343'01 260 17 0 00 003370' call cvtoct ; Convert ASCII octal digits to binary 19612 003344'01 263 17 0 00 000000 ret ; Pass the error up 19613 003345'01 274 11 0 00 000001 sub p1, t1 ;[248] ; Calculate digits consumed 19614 003346'01 270 13 0 00 000011 add p3, p1 ;[248] ; Add those into running total 19615 ; Range check result 19616 003347'01 303 03 0 00 000177 caile t3, .chdel ; Over 7 bits? 19617 003350'01 334 00 0 00 000000 %ermsg (,r) 19618 003351'01 254 00 0 00 003355' K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 19:41 30-Mar-24 Page 40-2 K20IOC MAC 7-Jan-24 19:31 Handle escape character substitution and expansion 19619 003352'01 265 01 0 00 003330* 19620 003353'01 000000000000# 19621 003354'01 254 00 0 00 003332* 19622 001224'04 123 160 145 143 151 19623 003355'01 136 03 0 00 000005 idpb t3, q1 ; Deposit in output buffer 19624 003356'01 400 03 0 00 000000 setz t3, ; Keep source string section local 19625 003357'01 375 00 0 00 000004 sosge t4 ; Account for destination byte consumed 19626 003360'01 334 00 0 00 000000 %ermsg (,r) 19627 003361'01 254 00 0 00 003365' 19628 003362'01 265 01 0 00 003352* 19629 003363'01 000000000000# 19630 003364'01 254 00 0 00 003354* 19631 001235'04 105 163 143 141 160 19632 003365'01 254 00 0 00 003333* retskp ; Worked! 19633 K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 19:41 30-Mar-24 Page 41 K20IOC MAC 7-Jan-24 19:31 ASCII Octal to Binary Octal Conversion table 19634 subttl ASCII Octal to Binary Octal Conversion table 19635 19636 chgsec(code,const) ;;Put the table in the constants .psect 19637 19638 000000 %octal=0 ; ASCII values start at .chnul 19639 19640 000751'02 octtab: xlist ; Save the trees!!! 19641 list ; Safe to look now, phew!!!! 19642 19643 001051' %eooct==. ; Remember the end of octal table 19644 19645 001001'02 reloc octtab+<<"0">_-1> ; Gets us to the corrct halfword pair 19646 000000 %octal=0 ; Starting octal digit VALUE 19647 19648 repeat ^d4,< ; Only doing 4 pairs of digits 0 through 7 19649 xwd %octal,%octal+1 ; Emit the octal value for the ASCII digit 19650 %octal==%octal+2 ;;Step to next character pair 19651 > 19652 001001'02 000000 000001 19653 001002'02 000002 000003 19654 001003'02 000004 000005 19655 001004'02 000006 000007 19656 19657 remark 8,9 ;;Fail on decimal digits!!!! 19658 001005'02 500070 500071 xwd trmcod!<"8">,trmcod!<"9"> 19659 19660 001051'02 reloc %eooct ; Get back to the end of octtab table 19661 retsec ;;Restore code psect 19662 cleans(<%octal,%eooct>) ;;Don't polute the symbol table 19663 K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 19:41 30-Mar-24 Page 42 K20IOC MAC 7-Jan-24 19:31 Octal Conversion 19664 subttl Octal Conversion 19665 19666 ; The purpose of the function is to bum a NIN%. This done for two 19667 ; reasons: 19668 ; 19669 ; 1) It's faster (no JSYS overhead) 19670 ; 2) It keeps counters straight. 19671 ; 19672 ; Done only in the context of a previous movst (see escchr, 19673 ; above), so has an odd register file to contend with. 19674 ; 19675 ; Although a 36 bit word will hold twelve 3 bit octal digits, we limit 19676 ; it to eleven digits so we don't wind up having to deal with any 19677 ; goofy numbers that look negative. 19678 ; 19679 ; However, the limit here is 12. This allows us to determine the 19680 ; difference between a number that is too long and a character that 19681 ; terminated the translation. 19682 ; 19683 ; The conversion code is trivial, we don't even use a cvtdbo (which is 19684 ; the wrong base, anyway), but rather take a seven bit ASCII digit, 19685 ; subtract ASCII zero ("0") from it and then deposit it in a register. 19686 ; This is all done with a single MOVST. 19687 ; 19688 ; Upon termination, that binary octal number is left-normalized and 19689 ; need merely be right-normalized with a lshc. 19690 ; 19691 ; Call: 19692 ; 19693 ; t1/ Remaining bytes in source string 19694 ; t2/ Section local pointer to source 19695 ; t3/ 0 (and must be zero) 19696 ; t4/ Remaining bytes in destination string 19697 ; q1/ Section local pointer to destination 19698 ; q2/ 0 (and must be zero) 19699 ; 19700 ; Return: 19701 ; 19702 ; +1 Some kind of failure 19703 ; +2 19704 ; t1/ Updated with bytes consumed 19705 ; t2/ Updated pointer past digits consumed 19706 ; t3/ Binary form of octal number 19707 ; t4/ Preserved 19708 ; q1/ Preserved 19709 ; q2/ Preserved 19710 ; 19711 ; N.B., Caller *MUST* rezero t3!!! 19712 19713 003366'01 015 00 0 00 000000# octmov: movst 0,octtab ; Actual extend instruction being executed 19714 003367'01 000000 000000 .chnul ; Fill character is end of string (never used) 19715 19716 003370'01 265 16 0 00 004312' cvtoct: saveac ; Preserve what we'll stomp 19717 003371'01 621 01 0 00 300000 txz t1, N!M ; Clear the number flags 19718 003372'01 661 01 0 00 400000 txo t1, S ; Start translating immediately K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 19:41 30-Mar-24 Page 42-1 K20IOC MAC 7-Jan-24 19:31 Octal Conversion 19719 dmove t4,[ ^d12 ; Maximum of eleven octal digits (see above) 19720 003373'01 120 04 0 00 004324' point 3, q3 ] ; N.B., 3 bit bytes!! 19721 003374'01 403 03 0 00 000006 setzb t3, q2 ;[248] ; Maintain section local pointers 19722 003375'01 400 07 0 00 000000 setz q3, ; Give the destination a clean slate 19723 003376'01 123 01 0 00 003366' extend t1, octmov ; Convert Octal digits 19724 003377'01 320 12 0 00 003401' %jserr (,r) 19725 003400'01 254 00 0 00 003404' 19726 003401'01 265 01 0 00 003362* 19727 003402'01 000000000000# 19728 003403'01 254 00 0 00 003364* 19729 001246'04 106 141 151 154 145 19730 19731 003404'01 607 01 0 00 200000 ifxn. t1, N ; Invalid digit?? 19732 003405'01 254 00 0 00 003415' 19733 003406'01 200 01 0 00 000000# emsg 19734 003407'01 104 00 0 00 000313 19735 001051'02 000000000000# 19736 001255'04 111 154 154 145 147 19737 003410'01 135 01 0 00 000002 ldb t1, t2 ; Pick up what didn't work 19738 003411'01 104 00 0 00 000074 PBOUT% ; Show us 19739 003412'01 561 01 0 00 003310* hrroi t1, crlf ; Load end of line 19740 003413'01 104 00 0 00 000076 PSOUT% ; Print it 19741 003414'01 263 17 0 00 000000 ret ; Return failure 19742 003415'01 endif. 19743 19744 003415'01 327 04 0 00 003423' ifle. t4 ; Exhausted destination string? 19745 003416'01 334 00 0 00 000000 %ermsg (,r) 19746 003417'01 254 00 0 00 003423' 19747 003420'01 265 01 0 00 003401* 19748 003421'01 000000000000# 19749 003422'01 254 00 0 00 003403* 19750 001265'04 123 160 145 143 151 19751 003423'01 endif. 19752 19753 003423'01 250 04 0 00 000007 exch t4, q3 ; Position left-justified result in adjacent AC 19754 003424'01 201 06 0 00 000014 movei q2, ^d12 ; Load original (slightly bogus) limit 19755 003425'01 274 06 0 00 000007 sub q2, q3 ; Calculate log base 8 of final number (heh) 19756 003426'01 325 06 0 00 003434' ifl. q2 ; Complete gubbish? 19757 003427'01 334 00 0 00 000000 %ermsg (,r) 19758 003430'01 254 00 0 00 003434' 19759 003431'01 265 01 0 00 003420* 19760 003432'01 000000000000# 19761 003433'01 254 00 0 00 003422* 19762 001300'04 117 143 164 141 154 19763 003434'01 endif. 19764 003434'01 326 06 0 00 003442' ife. q2 ; Never did anything?? 19765 003435'01 334 00 0 00 000000 %ermsg (,r) 19766 003436'01 254 00 0 00 003442' 19767 003437'01 265 01 0 00 003431* 19768 003440'01 000000000000# 19769 003441'01 254 00 0 00 003433* 19770 001310'04 117 143 164 141 154 19771 003442'01 endif. ; Very puzzling 19772 19773 003442'01 221 06 0 00 000003 imuli q2, ^d3 ; Three bits per octal digit K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 19:41 30-Mar-24 Page 42-2 K20IOC MAC 7-Jan-24 19:31 Octal Conversion 19774 003443'01 246 03 0 06 000000 lshc t3, (q2) ; Shift the bits into the right place 19775 19776 003444'01 621 01 0 00 700000 txz t1, S!N!M ; Clear the flags some more 19777 003445'01 271 01 0 00 000001 addi t1,^d1 ; Account for character we stopped on 19778 003446'01 474 06 0 00 000000 seto q2, ; But are now at, so back up the point 19779 003447'01 133 06 0 00 000002 adjbp q2, t2 ; so that an ildb works and the consequent 19780 003450'01 250 06 0 00 000002 exch q2, t2 ; Say this is the real pointer 19781 003451'01 254 00 0 00 003365* retskp ; And return with the correct register file 19782 19783 K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 19:41 30-Mar-24 Page 43 K20IOC MAC 7-Jan-24 19:31 Translation table for first character to search for 19784 subttl Translation table for first character to search for 19785 19786 ; Translate tables cannot be in extended text (non-zero section) 19787 ; because we need to use them to transfer a few characters for match 19788 ; purposes. 19789 ; 19790 ; N.B., a NUL character stops the search, but does NOT set the 'N' 19791 ; bit! ntrigr has to account for this because data that comes back 19792 ; from Tops-10 can have NUL's in it. Might be padding. 19793 19794 chgsec(code,const) ;;Put table in constants area 19795 19796 000002 %asc1c=.chcnb ; ASCII values start at Control-B 19797 19798 remark Base translate table passes all 7 bit data 19799 19800 001052'02 100000 000001 btrnst: xwd eoscod!.chnul,.chcna ;;NUL terminates 19801 xlist ; Don't need to see all this junk 19802 list ; Restart the blather 19803 19804 remark For eight bit data, everything stops us 19805 19806 100200 %asc1c=eoscod!200!.chnul ; Anything we translate with bit 8 is bad 19807 19808 xlist ; Don't need to see all this junk 19809 list ; Restart the blather 19810 000200 sertln==.-btrnst ; Calculate search table length 19811 ; After second pass, not needed at all 19812 cleans(<%asc1c>) ;;Don't polute the symbol table 19813 K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 19:41 30-Mar-24 Page 44 K20IOC MAC 7-Jan-24 19:31 Caseless Translation table for first character to search for 19814 subttl Caseless Translation table for first character to search for 19815 19816 ; N.B., a NUL character stops the search, but does NOT set the 'N' 19817 ; bit! ntrigr has to account for this because data that comes back 19818 ; from Tops-10 can have NUL's in it. 19819 19820 000002 %asc1u=.chcnb ; ASCII values start at Control-B 19821 19822 remark Base translate table passes all 7 bit data, uppercasing along the way 19823 19824 001252'02 100000 000001 btrnsu: xwd eoscod!.chnul,.chcna ;;NUL terminates 19825 xlist ; Don't need to see all this junk 19826 list ; Restart the blather 19827 19828 001352' %eotsu=. ; Remember end of table 19829 19830 001332'02 reloc btrnsu+<<"`">_-1> ; Gets us to the corrct halfword pair 19831 001332'02 000140 000101 xwd "`","A" ; Convert lowercase a to UPPERcase A 19832 19833 000102 %asc1u="B" ; Starting at lowercase b 19834 xlist ; Don't need to see all this junk 19835 list ; Restart the blather 19836 19837 001347'02 000132 000173 xwd "Z",173 ; Last letter and Left brace 19838 19839 001352'02 reloc %eotsu ; Get back to end of table 19840 19841 remark For eight bit data, everything stops us 19842 19843 100200 %asc1u==eoscod!200!.chnul ; Anything we translate with bit 8 is bad 19844 .xcref %asc1u ; Keep off cross reference 19845 19846 xlist ; Don't need to see all this junk 19847 list ; Restart the blather 19848 19849 cleans(<%asc1u,%eotsu>) ;;Punt working symbols 19850 K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 19:41 30-Mar-24 Page 45 K20IOC MAC 7-Jan-24 19:31 Macro to build a parity generating and checking tables 19851 subttl Macro to build a parity generating and checking tables 19852 19853 ; Inspired by PARBIT remote macro in TTYSRV (see CHITAB). buildp is 19854 ; a more generalized approach to handle both checking and generating 19855 ; any kind of a parity table, suitable for string instructions. 19856 ; 19857 ; To generate various parities: 19858 ; 19859 ; Mark buildp(200,200) ;;Sets both odd and even, always 19860 ; Space buildp(0,0) ;;N.B., can be optimized with movslj for 7 bit 19861 ; Even buildp(200,0) ;;Only emit even parity bit 19862 ; Odd buildp(0,200) ;;Only emit odd parity bit 19863 ; 19864 ; To double check the table, set the parity you want and run a timing test 19865 19866 define buildp(evn,odp) < ;;Builds a parity table 19867 xlist ;; Save us the blat, please ... 19868 odp!.chnul,,evn!.chcna ;; 0 ^@,, 1 ^A NULL,, 19869 evn!.chcnb,,odp!.chcnc ;; 2 ^B,, 3 ^C 19870 evn!.chcnd,,odp!.chcne ;; 4 ^D,, 5 ^E 19871 odp!.chcnf,,evn!.chbel ;; 6 ^F,, 7 ^G ,,Bell 19872 evn!.chbsp,,odp!.chtab ;; 10 ^H,, 11 ^I Backspace,,Tab 19873 odp!.chlfd,,evn!.chvtb ;; 12 ^J,, 13 ^K Line-Feed,,Vertical Tab 19874 odp!.chffd,,evn!.chcrt ;; 14 ^L,, 15 ^M Form Feed,,Carriage Return 19875 evn!.chcnn,,odp!.chcno ;; 16 ^N,, 17 ^O 19876 evn!.chcnp,,odp!.chcnq ;; 20 ^P,, 21 ^Q 19877 odp!.chcnr,,evn!.chcns ;; 22 ^R,, 23 ^S 19878 odp!.chcnt,,evn!.chcnu ;; 24 ^T,, 25 ^U 19879 evn!.chcnv,,odp!.chcnw ;; 26 ^V,, 27 ^W 19880 odp!.chcnx,,evn!.chcny ;; 30 ^X,, 31 ^Y 19881 evn!.chcnz,,odp!.chesc ;; 32 ^Z,, 33 ^[ ,,Escape Control 19882 evn!.chcbs,,odp!.chcrb ;; 34 ^\,, 35 ^] Control Backslash,,Right Bracket 19883 odp!.chccf,,evn!.chcun ;; 36 ^^,, 37 ^_ Control Cicumflex,,Underline 19884 evn!.chspc,,odp!"!" ;; 40 ,, 41 ! Space,, 19885 odp!.chdbq,,evn!"#" ;; 42 " ,, 43 # Double quote,, 19886 odp!"$",,evn!"%" ;; 44 $ ,, 45 % 19887 evn!"&",,odp!"'" ;; 46 & ,, 47 ' 19888 odp!"(",,evn!")" ;; 50 ( ,, 51 ) 19889 evn!"*",,odp!"+" ;; 52 * ,, 53 + 19890 evn!",",,odp!"-" ;; 54 , ,, 55 - Comma,,Dash (Minus Sign) 19891 odp!".",,evn!"/" ;; 56 . ,, 57 / Dot,,Forward Slash 19892 odp!"0",,evn!"1" ;; 60 0 ,, 61 1 19893 evn!"2",,odp!"3" ;; 62 2 ,, 63 3 19894 evn!"4",,odp!"5" ;; 64 4 ,, 65 5 19895 odp!"6",,evn!"7" ;; 66 6 ,, 67 7 19896 evn!"8",,odp!"9" ;; 70 8 ,, 71 9 19897 odp!":",,evn!";" ;; 72 : ,, 73 ; Colen,, Semicolen 19898 odp!.chlpt,,evn!"=" ;; 74 ,, 75 = Left pointy,, 19899 evn!.chrpt,,odp!"?" ;; 76 ,, 77 ? ,,Right pointy 19900 evn!"@",,odp!"A" ;; 100 @ ,,101 A 19901 odp!"B",,evn!"C" ;; 102 B ,,103 C 19902 odp!"D",,evn!"E" ;; 104 D ,,105 E 19903 evn!"F",,odp!"G" ;; 106 F ,,107 G 19904 odp!"H",,evn!"I" ;; 110 H ,,111 I 19905 evn!"J",,odp!"K" ;; 112 J ,,113 K K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 19:41 30-Mar-24 Page 45-1 K20IOC MAC 7-Jan-24 19:31 Macro to build a parity generating and checking tables 19906 evn!"L",,odp!"M" ;; 114 L ,,115 M 19907 odp!"N",,evn!"O" ;; 116 N ,,117 O 19908 odp!"P",,evn!"Q" ;; 120 P ,,121 Q 19909 evn!"R",,odp!"S" ;; 122 R ,,123 S 19910 evn!"T",,odp!"U" ;; 124 T ,,125 U 19911 odp!"V",,evn!"W" ;; 126 V ,,127 W 19912 evn!"X",,odp!"Y" ;; 130 X ,,131 Y 19913 odp!"Z",,evn!"[" ;; 132 Z ,,133 [ ,,Open Broket 19914 odp!"\",,evn!"]" ;; 134 \ ,,135 ] Backslash,,Close Broket 19915 evn!"^",,odp!"_" ;; 136 ^ ,,137 _ Up arrow,,Underline 19916 odp!"`",,evn!"a" ;; 140 ` ,,141 a Backtic (accent grave) 19917 evn!"b",,odp!"c" ;; 142 b ,,143 c 19918 evn!"d",,odp!"e" ;; 144 d ,,145 e 19919 odp!"f",,evn!"g" ;; 146 f ,,147 g 19920 evn!"h",,odp!"i" ;; 150 h ,,151 i 19921 odp!"j",,evn!"k" ;; 152 j ,,153 k 19922 odp!"l",,evn!"m" ;; 154 l ,,155 m 19923 evn!"n",,odp!"o" ;; 156 n ,,157 o 19924 evn!"p",,odp!"q" ;; 160 p ,,161 q 19925 odp!"r",,evn!"s" ;; 162 r ,,163 s 19926 odp!"t",,evn!"u" ;; 164 t ,,165 u 19927 evn!"v",,odp!"w" ;; 166 v ,,167 w 19928 odp!"x",,evn!"y" ;; 170 x ,,171 y 19929 evn!"z",,odp!"{" ;; 172 z ,,173 { Open Curly Brace 19930 evn!"|",,odp!"}" ;; 174 | ,,175 } Vertical Bar,,Close Curley Brace 19931 odp!"~",,evn!.chdel ;; 176 ~ ,,177 $? HZ2000 Lead in (!),,Rubout 19932 list ;; Turn the blat back on 19933 >;;buildp 19934 19935 define badpar (b,%b,%c) < ;;Generates a table with bad parity 19936 ifb ,<%b=0> ;;If no bit specified, default to zero 19937 ifnb ,<%b=b> ;;Otherwise, use the bit 19938 %c=trmcod!%b!.chnul ;;Starts out with NUL character, which fails 19939 xlist ; Don't need to see all this junk 19940 repeat ^d<<128>_-1>,< ;;Fill table with one to one translations 19941 xwd %c,%c+1 ;;Properly fill half words, failing every single one 19942 %c=%c+2 ;;Step to next pair 19943 >;;repeat ^d64 ;;Do remaining 126 characters 19944 list ; Restart the blather 19945 cleans(<%b,%c>) ;;Punt working symbols 19946 > K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 19:41 30-Mar-24 Page 46 K20IOC MAC 7-Jan-24 19:31 String based parity generating and checking tables 19947 subttl String based parity generating and checking tables 19948 19949 ;[223] Begin table insertions (still in const .psect) 19950 19951 remark Seven to Eight bit parity generating tables 19952 19953 ; N.B., as with single character routines, bit 8 is disregarded 19954 ; when generating parity 19955 19956 001452'02 spar7t: buildp(0,0) ; Space parity simply always clears bit 8 19957 buildp(0,0) ; Clear it for anything with bit 8 up 19958 001652'02 mpar7t: buildp(200,200) ; Mark parity simply always sets bit 8 19959 buildp(200,200) ; Set it for anthing with bit 8 up 19960 002052'02 epar7t: buildp(200,0) ; Build even parity generating table 19961 buildp(200,0) ; Ignore bit 8 and process as if it were zero 19962 002252'02 opar7t: buildp(0,200) ; Build odd parity generating table 19963 buildp(0,200) ; Ignore bit 8 and process as if it were zero 19964 19965 subttl Eight to Seven bit parity checking tables 19966 19967 002452'02 spar8t: buildp(0,0) ; For space, the 1st 128 do not have bit 8 set, so fine 19968 badpar(200) ; However, any with bit 8 up are BAD 19969 002652'02 mpar8t: badpar(0) ; For mark, the 1st 128 do not have bit 8 set, so BAD 19970 buildp(0,0) ; 2nd 128 have bit 8 up, so fine; strip off the parity 19971 003052'02 epar8t: buildp(trmcod,0) ; Anything with even parity should NOT be in lower 128 19972 buildp(0,trmcod) ; Otherwise, odd parity should not be in upper 128 19973 003252'02 opar8t: buildp(0,trmcod) ; Any odd parity set should not be in lower 128 19974 buildp(trmcod,0) ; Likewise, even parity should not be in upper 128 19975 19976 retsec ; Back into code .psect 19977 19978 ;[223] End table insertions 19979 19980 K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 19:41 30-Mar-24 Page 47 K20IOC MAC 7-Jan-24 19:31 Parity routines, used for a single byte and checking 19981 subttl Parity routines, used for a single byte and checking 19982 19983 ; All accept a character in t1, returning the same character with proper 19984 ; parity in t1. +1 always because nothing fails. Supposedly... 19985 19986 003452'01 none: remark ; Default, don't touch the eighth bit. 19987 entry none 19988 003452'01 263 17 0 00 000000 ret 19989 19990 003453'01 mark: remark ; Mark, bit 8 is always 1. 19991 entry mark 19992 003453'01 435 01 0 00 000200 ori t1, ^o200 ; Turn on the parity bit. 19993 003454'01 263 17 0 00 000000 ret 19994 19995 003455'01 space: remark ; Space, opposite of mark, bit 8 is always zero. 19996 entry space 19997 003455'01 405 01 0 00 000177 andi t1, ^o177 ; Turn off the parity bit. 19998 003456'01 263 17 0 00 000000 ret 19999 20000 003457'01 even: remark ; Even, the total number of one bits should be even. 20001 entry even 20002 003457'01 265 16 0 00 004326' saveac 20003 003460'01 405 01 0 00 000177 andi t1, ^o177 ; Start off with bit 8 = 0. 20004 003461'01 200 02 0 00 000001 move t2, t1 20005 003462'01 254 00 0 00 003466' jrst evnodd 20006 20007 003463'01 odd: remark ; Odd, the total number of one bits should be odd. 20008 entry odd 20009 003463'01 265 16 0 00 004326' saveac 20010 003464'01 405 01 0 00 000177 andi t1, ^o177 ; Turn off the parity bit. 20011 003465'01 201 02 0 01 000200 movei t2, ^o200(t1) ; Start off with bit 8 = 1. 20012 20013 003466'01 evnodd: remark ; The actual worker subroutine 20014 003466'01 242 02 0 00 777774 lsh t2, -4 ; Get high order 4 bits of character 20015 003467'01 431 02 0 01 000000 xori t2, (t1) ; Fold into 4 bits. 20016 003470'01 642 02 0 00 000014 trce t2, 14 ; Left two bits both 0 or 1? 20017 003471'01 606 02 0 00 000014 trnn t2, 14 ; or both 1? 20018 003472'01 431 01 0 00 000200 xori t1, 200 ; Yes, set parity 20019 003473'01 642 02 0 00 000003 trce t2, 3 ; Right two bits both 0? 20020 003474'01 606 02 0 00 000003 trnn t2, 3 ; or both 1? 20021 003475'01 431 01 0 00 000200 xori t1, 200 ; Yes, set parity. 20022 003476'01 263 17 0 00 000000 ret 20023 20024 ;[209] End code insertion 20025 20026 K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 19:41 30-Mar-24 Page 48 K20IOC MAC 7-Jan-24 19:31 SET PARITY parsing tables 20027 subttl SET PARITY parsing tables 20028 20029 ;[223] This code moved from k20par and updated 20030 20031 003452'02 000000 000000 %table(partab) ;[223] Values are all table offsets, below 20032 003453'02 000000# 000003 %key2 , .parev ;[223] 20033 000050'03 145 166 145 156 000 20034 003454'02 000000# 000002 %key2 , .parmk ;[223] 20035 000051'03 155 141 162 153 000 20036 003455'02 000000# 000000 %key2 , .parno ;[223] 20037 000052'03 156 157 156 145 000 20038 003456'02 000000# 003457' %keyf3 , %odd, ;[223] Abbreviate documented name 20039 000053'03 002000 000005 20040 000054'03 157 000 000 000 000 20041 003457'02 000000# 000004 %odd: %key2 , .parod ;[223] 20042 000055'03 157 144 144 000 000 20043 003460'02 000000# 000002 %keyf3 , .parmk, cm%inv ;[223] A common nickname for 'mark' 20044 000056'03 002000 000001 20045 000057'03 157 156 145 000 000 20046 003461'02 000000# 000001 %key2 , .parsp ;[223] 20047 000060'03 163 160 141 143 145 20048 003462'02 000000# 000001 %keyf3 , .parsp, cm%inv ;[223] A common nickname for 'space' 20049 000062'03 002000 000001 20050 000063'03 172 145 162 157 000 20051 003452'02 000010 000010 %tbend 20052 20053 ;[223] Begin Switch table insertion 20054 20055 comment " The plethora of invisible entries are a result of my being 20056 purely unable to come up with what I thought would be a good 20057 keyword, picking something to get on with it, becoming 20058 dissatisified or otherwise annoyed with that particular 20059 choice and then trying something else until things finally 20060 'looked right', both in a printed switch list and in the 20061 help text. Of course, then I would remember the old names 20062 and ... 20063 " 20064 20065 ; Define some mnemonic symbols to help us not to be confused... 20066 20067 define %Yes <;;> ;;There should only be four (4) documented entries 20068 000001 %No==cm%inv ;;Means not documented in k20hlp.mac 20069 20070 remark ; These are the parity switches 20071 20072 003463'02 000000 000000 %table(parswi) 20073 remark AC Value Documented? 20074 003464'02 000000# 000000# %keyf4 (, q3, 0, %No ) 20075 000064'03 002000 000001 20076 000065'03 141 154 154 055 143 20077 000070'03 000007 000000 20078 003465'02 000000# 000000# %key3 (, q4, -1) 20079 000071'03 143 150 145 143 153 20080 000075'03 000010 777777 20081 %Yes K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 19:41 30-Mar-24 Page 48-1 K20IOC MAC 7-Jan-24 19:31 SET PARITY parsing tables 20082 003466'02 000000# 000000# %keyf4 (, q3, 0, %No ) 20083 000076'03 002000 000001 20084 000077'03 145 166 145 162 171 20085 000102'03 000007 000000 20086 003467'02 000000# 000000# %key3 (, q4, 0) 20087 000103'03 147 145 156 145 162 20088 000106'03 000010 000000 20089 %Yes 20090 003470'02 000000# 000000# %key3 (, q3, -1) 20091 000107'03 160 141 143 153 145 20092 000112'03 000007 777777 20093 %Yes 20094 003471'02 000000# 000000# %keyf4 (, q4, -1, %No ) 20095 000113'03 002000 000001 20096 000114'03 160 141 162 151 164 20097 000120'03 000010 777777 20098 003472'02 000000# 000000# %keyf4 (, q4, -1, %No ) 20099 000121'03 002000 000001 20100 000122'03 162 145 143 145 151 20101 000125'03 000010 777777 20102 003473'02 000000# 000000# %key3 (, q3, 0) 20103 000126'03 164 145 162 155 151 20104 000133'03 000007 000000 20105 %Yes 20106 003463'02 000010 000010 %tbend 20107 20108 cleans(<%Yes,%No>) ;;Clean up worker symbols 20109 20110 ;[223] End switch table insertion 20111 20112 chgsec(code,const) ;;[223] FDB's are not in code, they're in const 20113 20114 003474'02 schrpr: remark ;[223] Single character parity routines 20115 003474'02 000000000000# none ;[223] Don't do parity 20116 003475'02 000000000000# space ;[223] Bit 8 is always clear 20117 003476'02 000000000000# mark ;[223] Bit 8 is always set 20118 003477'02 000000000000# even ;[223] Even parity 20119 003500'02 000000000000# odd ;[223] Odd parity 20120 20121 003501'02 stpart: remark ;[223] String based parity tables 20122 003501'02 000 00 0 00 000000 Z ;[223] None means do nothing 20123 003502'02 001452' 002452' spar7t,,spar8t ;[223] Space parity generating and checking 20124 003503'02 001652' 002652' mpar7t,,mpar8t ;[223] Mark parity generating and checking 20125 003504'02 002052' 003052' epar7t,,epar8t ;[223] Even parity generating and checking 20126 003505'02 002252' 003252' opar7t,,opar8t ;[223] Odd parity generating and checking 20127 20128 003506'02 010004 003511' spafdb: flddb. .cmcfm,,,,,spafdd 20129 003507'02 000000 000000 20130 003510'02 44 07 0 00 003721' 20131 003511'02 000000 000000 spafdd: flddb. .cmkey,,partab,,,, ;;[223] If in a define 20132 003512'02 000000 003452' 20133 20134 003513'02 010004 003516' spwfdb: flddb. .cmcfm,,,,,spwfdd 20135 003514'02 000000 000000 20136 003515'02 44 07 0 00 003732' K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 19:41 30-Mar-24 Page 48-2 K20IOC MAC 7-Jan-24 19:31 SET PARITY parsing tables 20137 003516'02 003002 000000 spwfdd: flddb. .cmswi,,parswi,,,, ;;[223] If in a define 20138 003517'02 000000 003463' 20139 003520'02 000000 000000 20140 003521'02 44 07 0 00 003737' 20141 20142 retsec ;;Back to where-ever we started from 20143 20144 K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 19:41 30-Mar-24 Page 49 K20IOC MAC 7-Jan-24 19:31 SET PARITY parsing 20145 subttl SET PARITY parsing 20146 20147 003477'01 .setpa: entry .setpa ;[223] Invoked from k20par 20148 003477'01 200 16 0 00 000000# guide 20149 003500'01 260 17 0 00 001511* 20150 003522'02 000000000000# 20151 001321'04 164 157 000 000 000 20152 003501'01 201 01 0 00 000000# movei t1, spafdb ;[223] Assume not defining a macro 20153 003502'01 332 00 0 00 000250* skipe definf ;[223] But!! Are we in a define? 20154 003503'01 201 01 0 00 000000# movei t1, spafdd ;[223] Indeed; don't parse a confirm 20155 003504'01 260 17 0 00 001546* call rfield ; Parse a keyword. 20156 003505'01 135 03 0 00 004011' ldb t3, [pointr (.cmfnp(t3),cm%fnc)] ;[223] Get what was parsed 20157 20158 003506'01 302 03 0 00 000010 caie t3, .cmcfm ;[223] Parsed a confirm? 20159 003507'01 254 00 0 00 003514' ifskp. ;[223] We did, 20160 003510'01 403 02 0 00 000003 setzb t2, t3 ;[223] so load default values 20161 003511'01 202 02 0 00 001361* movem t2, pars3 ;[223] Offset zero is 'none' 20162 003512'01 124 02 0 00 002060* dmovem t2, pars4 ;[223] Parity on all I/O, sent--not checked 20163 003513'01 263 17 0 00 000000 ret ;[223] Nothing further to do; comand is confirmed 20164 003514'01 endif. ;[223] End requesting default values 20165 20166 003514'01 265 16 0 00 004027' saveac ;[223] Needs a few more registers 20167 003515'01 550 02 0 02 000000 hrrz t2, (t2) ; Get the value for the keyword. 20168 003516'01 120 05 0 00 000002 dmove q1, t2 ;[223] Save value and parse type 20169 003517'01 403 07 0 00 000010 setzb q3, q4 ;[223] Assume parity on all I/O, sent--not checked 20170 20171 003520'01 do. ;[223] Enter loop context 20172 003520'01 201 01 0 00 000000# movei t1, spwfdb ;[223] Assume we can confirm 20173 003521'01 332 00 0 00 003502* skipe definf ;[223] But!! Are we in a define? 20174 003522'01 201 01 0 00 000000# movei t1, spwfdd ;[223] We are; wait on the confirm 20175 003523'01 260 17 0 00 000000* call rflde ;[223] Try to parse something 20176 003524'01 254 00 0 00 003535' ifskp. ;[223] Worked!! 20177 003525'01 135 06 0 00 004011' ldb q2, [pointr (.cmfnp(t3),cm%fnc)] ;[223] Get function code. 20178 003526'01 306 06 0 00 000010 cain q2, .cmcfm ;[223] Finally finished typing switches? 20179 003527'01 254 00 0 00 003541' exit. ;[223] Yes, break out of the loop 20180 003530'01 550 01 0 02 000000 hrrz t1, (t2) ;[223] Get the value pair for the switch 20181 003531'01 554 02 0 01 000000 hlrz t2, (t1) ;[223] Pick up the address 20182 003532'01 570 03 0 01 000000 hrre t3, (t1) ;[223] Sign extend the value 20183 003533'01 202 03 0 02 000000 movem t3, (t2) ;[223] Side effect something 20184 003534'01 254 00 0 00 003540' else. ;[223] Otherwise, failed the parse 20185 003535'01 336 00 0 00 003521* skipn definf ;[223] In DEFINE? 20186 003536'01 254 00 0 00 000000* jrst cmderr ;[223] No, so a definite parse error; allow retry 20187 003537'01 263 17 0 00 000000 ret ;[223] Return into DEFINE and see if that chokes 20188 003540'01 endif. ;[223] End parse result handling 20189 003540'01 254 00 0 00 003520' loop. ;[223] Get another switch 20190 003541'01 enddo. ;[223] End loop lexical context 20191 20192 003541'01 202 05 0 00 003511* movem q1, pars3 ;[223] Store parity actions 20193 003542'01 124 07 0 00 003512* dmovem q3, pars4 ;[223] Store where to apply parity 20194 003543'01 263 17 0 00 000000 ret ;[223] Whether or not in a define, can return 20195 20196 K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 19:41 30-Mar-24 Page 50 K20IOC MAC 7-Jan-24 19:31 SET PARITY semantic action 20197 subttl SET PARITY semantic action 20198 20199 extern nrtflg ;[223] Tops-20/Tops-10 DECnet NRT? 20200 extern ptyflg ;[223] Talking to ourselves? 20201 extern lclpar ;[223] Whether local line will do parity 20202 extern opnpar ;[223] Whether open device will do parity 20203 extern parity ;[194] Parity routine we'll use 20204 extern ebq ;[194] Eight bit quoting character 20205 extern ebqr ;[194] We'll request eight bit quoting 20206 20207 chgsec(code,data) ;[223] Need writable storage 20208 000000'05 000 00 0 00 000000 genint:: Z ;[223] Constructed instruction to generate parity 20209 000001'05 000 00 0 00 000000 chkint:: Z ;[223] Constructed instruction to check parity 20210 000002'05 000 00 0 00 000000 parpko:: Z ;[223] Doing parity on packets, only 20211 000003'05 000 00 0 00 000000 parrck:: Z ;[223] Checking parity on recieve in addition to sending 20212 retsec ;[223] Get back into code psect 20213 20214 003544'01 $setpa: entry $setpa ;[223] Invoked from k20par 20215 extern ttfork ;[223] Parity change forces a fork-reset 20216 003544'01 265 16 0 00 004012' saveac ;[223] Needs a register 20217 20218 003545'01 120 01 0 00 003542* dmove t1, pars4 ;[223] Pick up parity domain parse results 20219 003546'01 124 01 0 00 000000# dmovem t1, parpko ;[223] Store in global variables 20220 20221 003547'01 200 05 0 00 003541* move q1, pars3 ;[223] What did they say? 20222 003550'01 200 06 0 05 000000# move q2, schrpr(q1) ;[223] Pick up single character parity routine 20223 003551'01 554 02 0 05 000000# hlrz t2, stpart(q1) ;[223] Load string based parity generation routine 20224 003552'01 322 02 0 00 003557' ifn. t2 ;[223] Do we have anything? 20225 003553'01 550 03 0 05 000000# hrrz t3, stpart(q1) ;[223] Yes, load string based parity checking routine 20226 003554'01 505 02 0 00 015000 hrli t2, (movst 0,0) ;[223] Drop in the 20227 003555'01 505 03 0 00 015000 hrli t3, (movst 0,0) ;[223] extended opcodes 20228 003556'01 254 00 0 00 003560' else. ;[223] Otherwise, this is 'none', which is special cased 20229 003557'01 400 03 0 00 000000 setz t3, ;[223] Nothing in t3 20230 003560'01 endif. ;[223] End case extended instruction construction 20231 003560'01 124 02 0 00 000000# dmovem t2, genint ;[223] Store both extended string instructions 20232 003561'01 202 06 0 00 003011* movem q2, parity ;[223] Store single character routines 20233 20234 003562'01 260 17 0 00 003645' call parchr ;[223] Recompute parity on important characters 20235 003563'01 336 01 0 00 000000* skipn t1, ttfork ;[223] Are we doing interactive communications? 20236 003564'01 254 00 0 00 003574' ifskp. ;[223] We are, must reset to use new parity 20237 003565'01 104 00 0 00 000153 KFORK% ;[223] Whack the communications fork 20238 003566'01 320 12 0 00 003570' %jsErr (,) ;[223] 20239 003567'01 254 00 0 00 003573' 20240 003570'01 265 01 0 00 003437* 20241 003571'01 000000000000# 20242 003572'01 254 00 0 00 003573' 20243 001322'04 125 156 141 142 154 20244 003573'01 402 00 0 00 003563* setzm ttfork ;[223] And force a recreate 20245 003574'01 endif. ;[223] End case resetting comunications fork 20246 20247 003574'01 302 06 0 00 003452' caie q2, none ;[194] Was the parity NONE? 20248 003575'01 254 00 0 00 003602' ifskp. ;[194] Yes, it was 20249 003576'01 201 01 0 00 000131 movei t1, "Y" ;[194] Just say we will do 8th-bit 20250 003577'01 202 01 0 00 000000* movem t1, ebq ;[95] prefixing if requested. 20251 003600'01 402 00 0 00 000000* setzm ebqr ;[95] But we won't request it ourselves. K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 19:41 30-Mar-24 Page 50-1 K20IOC MAC 7-Jan-24 19:31 SET PARITY semantic action 20252 003601'01 254 00 0 00 003644' else. ;[194] Otherwise, not NONE 20253 003602'01 476 00 0 00 003600* setom ebqr ;[194] So request 8th-bit prefixing. 20254 003603'01 201 02 0 00 000046 movei t2, dqbin ;[89] Use the default prefix. 20255 003604'01 202 02 0 00 003577* movem t2, ebq ;[89] 20256 003605'01 336 00 0 00 002474* ifmn. netjfn ;[223] Network connection? 20257 003606'01 254 00 0 00 003634' 20258 003607'01 332 00 0 00 000000* ifme. opnpar ;[223] Yes, does it NOT do parity? 20259 003610'01 254 00 0 00 003633' 20260 003611'01 336 00 0 00 000000* ifmn. nrtflg ;[223] DECnet connection? 20261 003612'01 254 00 0 00 003617' 20262 003613'01 200 01 0 00 000000# txmsg <%Network connection> ;[223] Yes, say as such 20263 003614'01 104 00 0 00 000076 20264 003615'01 320 12 0 00 003616' 20265 003523'02 000000000000# 20266 001335'04 045 116 145 164 167 20267 003616'01 254 00 0 00 003630' else. ;[223] Otherwise, it's something else 20268 003617'01 336 00 0 00 000000* ifmn. ptyflg ;[223] PTY? 20269 003620'01 254 00 0 00 003625' 20270 003621'01 200 01 0 00 000000# txmsg <%Pseudo-terminal> ;[223] 20271 003622'01 104 00 0 00 000076 20272 003623'01 320 12 0 00 003624' 20273 003524'02 000000000000# 20274 001341'04 045 120 163 145 165 20275 003624'01 254 00 0 00 003630' else. ;[223] Otherwise, physical line 20276 003625'01 200 01 0 00 000000# txmsg <%Terminal line> ;[223] 20277 003626'01 104 00 0 00 000076 20278 003627'01 320 12 0 00 003630' 20279 003525'02 000000000000# 20280 001345'04 045 124 145 162 155 20281 003630'01 endif. ;[223] End PTY decision 20282 003630'01 endif. ;[223] End NRT decision 20283 txmsg < does not support parity 20284 003630'01 200 01 0 00 000000# > ;[223] Remind terminal-and-packets ill-advised 20285 003631'01 104 00 0 00 000076 20286 003632'01 320 12 0 00 003633' 20287 003526'02 000000000000# 20288 001350'04 040 144 157 145 163 20289 20290 003633'01 endif. ;[223] End case parity on network device 20291 003633'01 254 00 0 00 003641' else. ;[223] Otherwise, using control terminal 20292 003634'01 332 00 0 00 000000* ifme. lclpar ;[223] Will local line will do parity? 20293 003635'01 254 00 0 00 003641' 20294 txmsg <%Control terminal line does not support parity 20295 003636'01 200 01 0 00 000000# > ;[223] Remind terminal-and-packets ill-advised 20296 003637'01 104 00 0 00 000076 20297 003640'01 320 12 0 00 003641' 20298 003527'02 000000000000# 20299 001356'04 045 103 157 156 164 20300 20301 003641'01 endif. ;[223] 20302 003641'01 endif. ;[223] End case checking device parity toleration 20303 txmsg <%Will request 8th-bit prefixing. 20304 If the other KERMIT doesn't agree, binary files cannot be sent correctly. 20305 003641'01 200 01 0 00 000000# > 20306 003642'01 104 00 0 00 000076 K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 19:41 30-Mar-24 Page 50-2 K20IOC MAC 7-Jan-24 19:31 SET PARITY semantic action 20307 003643'01 320 12 0 00 003644' 20308 003530'02 000000000000# 20309 001370'04 045 127 151 154 154 20310 20311 20312 003644'01 endif. ;[194] End case doing SOME kind of parity 20313 20314 003644'01 263 17 0 00 000000 ret 20315 20316 ;[223] End code move 20317 K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 19:41 30-Mar-24 Page 51 K20IOC MAC 7-Jan-24 19:31 If parity changes, side effect certain characters 20318 subttl If parity changes, side effect certain characters 20319 20320 ;[223] Begin code insertion 20321 20322 ; Parity had been computed on all characters in a sending packet 20323 ; except where a character might be outside of the packet proper. One 20324 ; such character would be padding, which is simply emitted before the 20325 ; packet itself is sent. 20326 ; 20327 ; Now the entire message is built including the padding, start-of- 20328 ; header and end-of-line characters and then putpar is called to apply 20329 ; parity in a single extended instruction. 20330 ; 20331 ; There are certain situations where the characters are looked for 20332 ; individually, so this code applies parity to all of them whenever 20333 ; parity changes. If the characters themselves change, then the 20334 ; routines doing the changes apply current parity. 20335 ; 20336 ; Note that we don't tweak the received characters because the chkpar 20337 ; routine is called before we ever get to checking them. Since it 20338 ; strips parity, we don't need to worry about it; when receiving... 20339 20340 remark ; Document what we'll be tweaking 20341 extern ssthdr ; Sending start of header character 20342 remark rsthdr ; Receiving start of header character 20343 extern spadch ; Sending padding character 20344 remark rpadch ; Receiving padding character 20345 extern seolch ; Sending End of Line character 20346 remark reolch ; Receiving End of Line character 20347 extern handsh ; Handshake character 20348 20349 chgsec(code,const) ; Table of addresses is constant data 20350 003531'02 000000000000# pchars: exp ssthdr,spadch,seolch,handsh 20351 000004 pcharl==.-pchars ; Number of entries in the table 20352 retsec ; Return to code psect 20353 20354 003645'01 265 16 0 00 004003' parchr: saveac ; Used as a counter 20355 003646'01 201 05 0 00 000003 movx q1, ; Load maximum offset 20356 20357 003647'01 do. ; Enter loop context 20358 003647'01 200 01 1 05 000000# move t1, @pchars(q1) ; Load the character 20359 003650'01 405 01 0 00 000177 andi t1, ^o177 ; Stomp any previous parity 20360 003651'01 260 17 0 06 000000 call (q2) ; Apply the appropriate parity 20361 003652'01 202 01 1 05 000000# movem t1, @pchars(q1) ; Store the proper character 20362 003653'01 365 05 0 00 003647' sojge q1, top. ; Do the next character until done 20363 003654'01 enddo. ; End of loop lexical context 20364 20365 003654'01 263 17 0 00 000000 ret ; Done fixing up everything 20366 20367 cleans () ; Clean up working symbol 20368 20369 ;[223] End code insertion 20370 K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 19:41 30-Mar-24 Page 52 K20IOC MAC 7-Jan-24 19:31 Put parity on an eight bit stream 20371 subttl Put parity on an eight bit stream 20372 20373 ;[223] Begin code insertion 20374 20375 ; The algorythm is actually straightforward; the routine is passed a 20376 ; pointer to a buffer that is almost ready to send, meaning we are the 20377 ; last operation directly before the SOUT%/SOUTR%. The buffer is 20378 ; assumed to contain 7 bit ASCII characters in 8 bit bytes, thus 20379 ; giving the routine a place to put the parity. 20380 ; 20381 ; It checks whether parity is being done and, if so, loads the single 20382 ; instruction that will perform the operation. This is a MOVST which 20383 ; has been constructed with the appropriate translate table. 20384 ; 20385 ; Again, although the byte pointer being passed is eight bits, the 20386 ; string is treated as a series of seven bit bytes in 8 bit fields 20387 ; where the current setting of the eigth bit is discarded. The string 20388 ; is overwritten in place with the correct parity, at which point, it 20389 ; will be completely ready to be sent. 20390 ; 20391 ; Once the MOVST is started, the whole process is effectively a series 20392 ; of table lookups with no computations involved at all. 20393 ; 20394 ; The routine is faster than calling the single character conversion 20395 ; routines, even for the shortest possible Kermit packet of three 20396 ; characters. In other words, even with all the register pushing and 20397 ; popping, it still always wins. 20398 ; 20399 ; Depending on your view, the amount of memory taken up by the 20400 ; translation tables is not flagrant: a single kiloword and it is 20401 ; shared. 20402 ; 20403 ; Call: (Expected to be just before SOUT%/SOUTR%) 20404 ; 20405 ; t2/ Pointer to eight bit data to overwrite 20406 ; t3/ Negative length of data to do 20407 ; 20408 ; Return: 20409 ; 20410 ; +1, always; appropriate parity, if parity is being done (I.E., not 'none') 20411 20412 003655'01 putpar: entry putpar ; Used by packet routines in k20mit 20413 003655'01 325 03 0 00 003441* jumpge t3, R ; Zero or gubbish? Just leave it alone... 20414 003656'01 200 16 0 00 003561* move cx, parity ; Load current parity setting 20415 003657'01 306 16 0 00 003452' cain cx, none ; Not doing anything? 20416 003660'01 263 17 0 00 000000 ret ; No, so don't do anything 20417 20418 003661'01 265 16 0 00 004334' saveac ; Otherwise, set up eight registers ... 20419 003662'01 210 01 0 00 000003 movn t1, t3 ; Source length 20420 003663'01 200 04 0 00 000001 move t4, t1 ; destination is the same length 20421 003664'01 200 05 0 00 000002 move q1, t2 ; String will be updated in place (I.E., overwritten) 20422 003665'01 403 03 0 00 000006 setzb t3, q2 ; Section local pointers 20423 003666'01 336 07 0 00 000000# skipn q3, genint ; Load and double check extended string instruction 20424 003667'01 263 17 0 00 000000 ret ; Very odd! We checked above, but ignore it 20425 003670'01 400 10 0 00 000000 setz q4, ; Fill character is NUL (yet unused...) K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 19:41 30-Mar-24 Page 52-1 K20IOC MAC 7-Jan-24 19:31 Put parity on an eight bit stream 20426 003671'01 621 01 0 00 300000 txz t1, N!M ; Shut off Negative and Mark 20427 003672'01 661 01 0 00 400000 txo t1, S ; Have to dink the foolish significance bit... 20428 003673'01 123 01 0 00 000007 extend t1, q3 ; Get down to some serious string translating 20429 003674'01 600 00 0 00 000000 nop ; Can't happen 20430 003675'01 263 17 0 00 000000 ret ; Done 20431 20432 K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 19:41 30-Mar-24 Page 53 K20IOC MAC 7-Jan-24 19:31 Generate parity on a seven bit stream 20433 subttl Generate parity on a seven bit stream 20434 20435 ; Like the above, except creates a new eight stream from a seven bit 20436 ; stream instead of overwriting the eight bit stream in place. 20437 ; 20438 ; t1/ Pointer to eight bit destination data 20439 ; t2/ Pointer to seven bit source data 20440 ; t3/ Negative length of data to do 20441 ; 20442 ; If parity is being done, then t2 will be updated to the original 20443 ; value of t1, otherwise it is unchanged. t1 is always trashed, 20444 ; everything else is preserved. 20445 ; 20446 ; N.B., The above is fine and everything ...but... 20447 ; THE BYTE WIDTHS ARE *NOT* CHECKED!!!! 20448 20449 003676'01 genpar: entry genpar ; Used by k20dsp and k20net 20450 003676'01 325 03 0 00 003655* jumpge t3, R ; Zero or gubbish? Just leave it alone... 20451 003677'01 200 16 0 00 003656* move cx, parity ; Load current parity setting 20452 003700'01 306 16 0 00 003452' cain cx, none ; Not doing any parity? 20453 003701'01 263 17 0 00 000000 ret ; No, so don't do anything 20454 20455 003702'01 265 16 0 00 004352' saveac ; Otherwise, go hog wild on registers 20456 003703'01 200 11 0 00 000001 move q5, t1 ; Save original destination 20457 003704'01 200 05 0 00 000001 move q1, t1 ; and put it where movst wants to use it 20458 003705'01 210 01 0 00 000003 movn t1, t3 ; Source length is positive 20459 003706'01 200 04 0 00 000001 move t4, t1 ; destination is the same length 20460 003707'01 403 03 0 00 000006 setzb t3, q2 ; Section local pointers 20461 003710'01 336 07 0 00 000000# skipn q3, genint ; Load and double check extended string instruction 20462 003711'01 263 17 0 00 000000 ret ; Very odd! We checked above, but ignore it 20463 003712'01 400 10 0 00 000000 setz q4, ; Fill character is NUL (yet unused...) 20464 003713'01 621 01 0 00 300000 txz t1, N!M ; Shut off Negative and Mark 20465 003714'01 661 01 0 00 400000 txo t1, S ; Have to dink the foolish significance bit... 20466 003715'01 123 01 0 00 000007 extend t1, q3 ; Get down to some serious string translating 20467 003716'01 600 00 0 00 000000 nop ; Can't happen 20468 003717'01 200 02 0 00 000011 move t2, q5 ; Return new source for SOUT%/SOUTR% 20469 003720'01 263 17 0 00 000000 ret ; Done 20470 K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 19:41 30-Mar-24 Page 54 K20IOC MAC 7-Jan-24 19:31 Check Parity 20471 subttl Check Parity 20472 20473 ; Call: 20474 ; 20475 ; t2/ Pointer to eight bit data 20476 ; t3/ Negative length of data to do 20477 ; 20478 ; Return: 20479 ; 20480 ; +1, Bad parity, if parity is not none 20481 ; +2, Good parity or none or zero length 20482 ; 20483 ; The routine is faster than calling single character conversion 20484 ; routines for the shortest possible Kermit packet of three 20485 ; characters. In other words, even with all the register pushing and 20486 ; popping, it still always wins. 20487 20488 003721'01 chkpar: entry chkpar ; Used by k20mit 20489 003721'01 325 03 0 00 003451* jumpge t3, RSKP ; Zero or gubbish? Just leave it alone... 20490 003722'01 200 16 0 00 003677* move cx, parity ; Load current parity setting 20491 003723'01 306 16 0 00 003452' cain cx, none ; Not doing anything? 20492 003724'01 254 00 0 00 003721* retskp ; No, so don't do anything 20493 20494 003725'01 265 16 0 00 004334' saveac ; Otherwise, set up eight registers ... 20495 003726'01 210 01 0 00 000003 movn t1, t3 ; Source length 20496 003727'01 200 04 0 00 000001 move t4, t1 ; destination is the same length 20497 003730'01 200 05 0 00 000002 move q1, t2 ; String will be updated in place (I.E., overwritten) 20498 003731'01 403 03 0 00 000006 setzb t3, q2 ; Section local pointers 20499 003732'01 336 07 0 00 000000# skipn q3, chkint ; Load and double check extended string instruction 20500 003733'01 254 00 0 00 003724* retskp ; Very odd! We checked above, but ignore it 20501 003734'01 400 10 0 00 000000 setz q4, ; Fill character is NUL (yet unused...) 20502 003735'01 621 01 0 00 300000 txz t1, N!M ; Shut off Negative and Mark 20503 003736'01 661 01 0 00 400000 txo t1, S ; Have to dink the foolish significance bit... 20504 003737'01 123 01 0 00 000007 extend t1, q3 ; Get down to some serious string translating 20505 003740'01 600 00 0 00 000000 nop ; Can't happen 20506 003741'01 607 01 0 00 200000 txnn t1, N ; Bump into any bad parity? 20507 003742'01 254 00 0 00 003733* retskp ; Nope, we're done 20508 003743'01 263 17 0 00 000000 ret ; Otherwise, bad parity 20509 K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 19:41 30-Mar-24 Page 55 K20IOC MAC 7-Jan-24 19:31 padbuf - Generate a buffer of padding characters with correct parity 20510 subttl padbuf - Generate a buffer of padding characters with correct parity 20511 20512 ; Call: 20513 ; 20514 ; t1/ Number of padding characters 20515 ; t2/ 7 bit padding character 20516 ; t3/ Parity to form 20517 ; t4/ Address of buffer to put the padding with proper parity in 20518 ; 20519 ; Returns +1, always 20520 20521 003744'01 padbuf: entry padbuf ; Called from k20mit 20522 003744'01 265 16 0 00 004127' saveac ; Wants some scratch 20523 20524 003745'01 120 05 0 00 000001 dmove q1, t1 ; Save length and character 20525 003746'01 120 07 0 00 000003 dmove q3, t3 ; Save parity and buffer address 20526 003747'01 200 11 0 00 002212* move p1, tvtflg ;[247] ; If might need to do IAC doubling 20527 20528 003750'01 200 01 0 00 000002 move t1, t2 ; Load padding character 20529 003751'01 260 17 1 00 000007 call @q3 ; Calculate parity 20530 003752'01 200 12 0 00 000001 move p2, t1 ;[247] ; Save character with parity 20531 20532 003753'01 200 06 0 00 000001 move q2, t1 ; Make a copy 20533 repeat ^d3, < ; Construct the next four characters 20534 lsh q2, ^d8 ; Shift over an eight bit character 20535 or q2, t1 ; Or in the padding character 20536 > 20537 003754'01 242 06 0 00 000010 20538 003755'01 434 06 0 00 000001 20539 003756'01 242 06 0 00 000010 20540 003757'01 434 06 0 00 000001 20541 003760'01 242 06 0 00 000010 20542 003761'01 434 06 0 00 000001 20543 20544 003762'01 242 06 0 00 000004 lsh q2, ^d4 ; Left justify to make 8 bit ASCIZ 20545 003763'01 202 06 0 10 000000 movem q2,(q4) ; Stomp first word of buffer 20546 20547 003764'01 322 11 0 00 003770' ifn. p1 ;[247] ; TVT Binary? 20548 003765'01 302 12 0 00 000377 caie p2, IAC ;[247] ; Yes, is it an IAC? 20549 003766'01 254 00 0 00 003770' anskp. ;[247] ; No, it isn't, so nothing to double 20550 003767'01 242 05 0 00 000001 lsh q1, ^d1 ;[247] ; Otherwise, double it 20551 003770'01 endif. ;[247] ; End case using IAC as padding character 20552 20553 003770'01 200 01 0 00 000005 move t1, q1 ; Load original length 20554 003771'01 231 01 0 00 000004 idivi t1, ^d4 ; Four 8 bit characters per word 20555 003772'01 302 02 0 00 000000 caie t2, 0 ; No remainder? 20556 003773'01 271 01 0 00 000001 addi t1, ^d1 ; Round up a word 20557 003774'01 275 01 0 00 000001 subi t1, ^d1 ; Already did first word 20558 003775'01 323 01 0 00 003676* jumple t1, R ; Four characters or less? 20559 ; Otherwise, fill out the rest of the buffer 20560 003776'01 200 02 0 00 000010 move t2, q4 ; Starting address in buffer 20561 003777'01 201 03 0 02 000001 movei t3, 1(t2) ; Next address to fill out the rest of the necessary 20562 004000'01 123 01 0 00 004022' xblt. t1 ; words in the buffer (but not the whole buffer) 20563 004001'01 200 01 0 00 000005 move t1, q1 ;[247] ; Return possibly updated length 20564 004002'01 263 17 0 00 000000 ret ; Done K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 19:41 30-Mar-24 Page 55-1 K20IOC MAC 7-Jan-24 19:31 padbuf - Generate a buffer of padding characters with correct parity 20565 20566 ;[223] End code insertion 20567 20568 K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 19:41 30-Mar-24 Page 56 K20IOC MAC 7-Jan-24 19:31 Close out Code section 20569 subttl Close out Code section 20570 20571 xlist ; Save the trees!!!!! 20572 list 20573 20574 .endps code ; End of code .psect 20575 K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 19:41 30-Mar-24 Page 57 K20IOC MAC 7-Jan-24 19:31 Local storage 20576 subttl Local storage 20577 20578 .psect data ;Write-able area 20579 20580 000004'05 000000 000000 intima:: defita ;[160] Timeout action for INPUT search. 20581 000005'05 000000 000000 incase:: defics ;[160] Case conversion flag for INPUT search. 20582 000006'05 000000 011610 indeft:: defito ; ** DO NOT ;[194] Default timeout for INPUT search (milliseconds) 20583 000007'05 203500 000000 indeff:: defitf ; REORDER ** ;[212] Same value as floating point seconds 20584 20585 000010'05 000000 000000 indefc:: 0 ;[209] Default search string length in characters 20586 000011'05 000000 000000 indefw:: 0 ;[209] Same length in words 20587 000012'05 indefs:: block strblw ;[209] Storage for default search string (if set) 20588 20589 001012'05 trgchr: block 1 ;[209] The 'trigger' character 20590 001013'05 trnbas: block 2 ;[209] Translation base table we used 20591 001015'05 sertab: block sertln ;[209] Search table 20592 20593 ;[209] Handles register spill from searching routines 20594 20595 001215'05 ornetc: block 1 ; ** DO NOT ;[209] Original network count 20596 001216'05 ornetp: block 1 ; REORDER ** ;[209] Original network pointer (end of buffer) 20597 20598 ;[209] Next two variables are for cross INPUT calls with left over data 20599 20600 001217'05 000000 000000 inpcbf:: 0 ;[209] Number of characters we flushed 20601 001220'05 000000 000000 inpcnt:: 0 ;** DO NOT REORDER** ;[209] Number of characters in buffer 20602 001221'05 44 07 0 00 001222' inpptr: point 7, inpbuf ;[209] Current position in buffer 20603 001222'05 inpbuf:: block strblw ;[209] Area to read data into 20604 20605 002222'05 fsized: block 2 ;[229] File size double word 20606 20607 .endps data ; Close out storage area 20608 20609 .psect text ;[209] Read-only storage 20610 000134'03 inpini: intern inpini ;[209] Used by buffer clearing routines 20611 000134'03 000000 000000 0 ;[209] Nothing in INPUT command buffer 20612 000135'03 44 07 0 00 000000# point 7, inpbuf ;[209] So pointing at beginning 20613 .endps text ;[209] Close out section zero text 20614 20615 20616 .xcmsy ;[194] Ditch MACSYM junk 20617 20618 end NO ERRORS DETECTED PROGRAM BREAK IS 000000 PSECT 1 BREAK IS 004371 FOR CODE PSECT 2 BREAK IS 003745 FOR CONST PSECT 3 BREAK IS 000136 FOR TEXT PSECT 4 BREAK IS 001417 FOR ETEXT PSECT 5 BREAK IS 002224 FOR DATA CPU TIME USED 00:01.983 131P CORE USED K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 19:41 30-Mar-24 Page S-1 K20IOC MAC 7-Jan-24 19:31 SYMBOL TABLE ASCZCP 000000 ext DOBITS 000000 ext P5 000015 spd TTYOU 000000 ext ATMBLN 000141 spd DQBIN 000046 spd PARITY 000000 ext TVTBUF 000000 ext ATMBUF 000000 ext DUPLEX 000000 ext PARS1 000000 ext TVTFLG 000000 ext BIN 104000 000050 int DV%TYP 000777 000000 sin PARS2 000000 ext UNBITS 000000 ext BIN% 104000 000050 int DVCHR% 104000 000117 int PARS3 000000 ext VSOCT 000000 ext BOUT 104000 000051 int EOSCOD 100000 spd PARS4 000000 ext VSOMX 000000 ext BOUT% 104000 000051 int ERJMPR 320500 000000 int PARS5 000000 ext VSOTC 000000 ext BUFFER 000000 ext ERRPTR 000000 ext PARS6 000000 ext VTERMF 000000 ext CALL 260740 000000 ESOUT% 104000 000313 int PARS7 000000 ext XMOVEI 415000 000000 int CALLRE 254000 000000 spd ETEXT 000000 ext PARS8 000000 ext %%JSER 000000 ext CARIER 000000 ext F 000000 spd PBOUT 104000 000074 int ..MSK 777777 777777 spd CCOFF2 000000 ext FB%BSZ 007700 000000 sin PBOUT% 104000 000074 int .A16 000016 spd CCON 000000 ext FILJFN 000000 ext POPJFN 000000 ext .CHBEL 000007 sin CFMRTN 000000 ext FRCLOS 000000 ext PSOUT 104000 000076 int .CHBSP 000010 sin CHKLIN 000000 ext GJ%FLG 000020 000000 sin PSOUT% 104000 000076 int .CHCBS 000034 sin CHKSEC 000000 ext GJ%FOU 400000 000000 sin Q1 000005 spd .CHCCF 000036 sin CJFNBK 000000 ext GJ%GIV 000001 000000 sin Q2 000006 spd .CHCNA 000001 sin CJFNLN 000020 spd GJ%GND 000040 000000 sin Q3 000007 spd .CHCNB 000002 sin CLRBUF 000000 ext GJ%NEW 200000 000000 sin Q4 000010 spd .CHCNC 000003 sin CLREST 000000 ext GJ%OLD 100000 000000 sin Q5 000011 spd .CHCND 000004 sin CLZFF% 104000 000034 int GJ%UHV 004000 000000 sin R 000000 ext .CHCNE 000005 sin CM%ABR 000004 sin GTFDB% 104000 000063 int REPARA 000000 ext .CHCNF 000006 sin CM%DPP 000002 000000 sin HANDSH 000000 ext RET 263740 000000 .CHCNN 000016 sin CM%FNC 777000 000000 sin IAC 000377 spd RFIELD 000000 ext .CHCNO 000017 sin CM%FW 002000 000000 sin IACIAC 000000 ext RFLDE 000000 ext .CHCNP 000020 sin CM%HPP 000004 000000 sin IOX4 600220 int RLJFN% 104000 000023 int .CHCNQ 000021 sin CM%INV 000001 sin ISNULJ 000000 ext RSKP 000000 ext .CHCNR 000022 sin CM%SDH 000001 000000 sin JFNS 104000 000030 int S 400000 000000 spd .CHCNS 000023 sin CMDACS 000000 ext JFNS% 104000 000030 int SBK 000000 ext .CHCNT 000024 sin CMDBLN 000141 spd JOBTAB 000000 ext SC%CTC 400000 000000 sin .CHCNU 000025 sin CMDBUF 000000 ext JS%DEV 700000 000000 sin SESFLG 000000 ext .CHCNV 000026 sin CMDER1 000000 ext KFORK% 104000 000153 int SESJFN 000000 ext .CHCNW 000027 sin CMDERR 000000 ext LOCAL 000000 ext SIN 104000 000052 int .CHCNX 000030 sin CMDFRM 000000 ext M 100000 000000 spd SIN% 104000 000052 int .CHCNY 000031 sin CMDPDL 000000 ext MOVSLJ 016000 000000 SIZEF% 104000 000036 int .CHCNZ 000032 sin CMDPLN 000200 spd MOVST 015000 000000 SOUT 104000 000053 int .CHCRB 000035 sin CMLOC 000000 ext N 200000 000000 spd SOUT% 104000 000053 int .CHCRT 000015 sin CMPOFF 000000 ext NBICT 000000 ext SOUTR% 104000 000532 int .CHCUN 000037 sin CMPON 000000 ext NETJFN 000000 ext STRBF2 000000 ext .CHDBQ 000042 spd CMSEEN 000000 ext NOIRTN 000000 ext STRBLC 005000 spd .CHDEL 000177 sin CODE 000000 ext NOP 600000 000000 sin STRBLW 001000 spd .CHESC 000033 sin CONST 000000 ext NOUT% 104000 000224 int STRBUF 000000 ext .CHFFD 000014 sin CPLOC 000000 ext NSICI 000000 ext STRC 000000 ext .CHLFD 000012 sin CPSEEN 000000 ext NSIMX 000000 ext STRPTR 000000 ext .CHLPT 000074 spd CRLF 000000 ext NSITC 000000 ext T1 000001 spd .CHNUL 000000 sin CX 000016 NUL4 000000 ext T2 000002 spd .CHRPT 000076 spd CZ%NCL 040000 000000 sin OF%BSZ 770000 000000 sin T3 000003 spd .CHSPC 000040 sin DATA 000000 ext OF%RD 200000 sin T4 000004 spd .CHTAB 000011 sin DEFICS 000000 spd OF%WR 100000 sin TAKJFN 000000 ext .CHVTB 000013 sin DEFINF 000000 ext OPENF% 104000 000021 int TEXT 000000 ext .CMCFM 000010 sin DEFITA 000000 spd P 000017 TIMDEL 000000 ext .CMDAT 000001 sin DEFITF 203500 000000 spd P1 000011 spd TIMEON 000000 ext .CMDEV 000016 sin DEFITO 011610 spd P2 000012 spd TRMCOD 500000 spd .CMFIL 000006 sin DEVST% 104000 000121 int P3 000013 spd TTYJFN 000000 ext .CMFLT 000015 sin DOARPA 000000 ext P4 000014 spd TTYOB 000000 ext .CMFNP 000000 sin K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 19:41 30-Mar-24 Page S-2 K20IOC MAC 7-Jan-24 19:31 SYMBOL TABLE .CMKEY 000000 sin .CMQST 000021 sin .CMSWI 000003 sin .CMTOK 000023 sin .CMTXT 000017 sin .DVDSK 000000 sin .DVNUL 000015 sin .FBBYV 000011 sin .FHSLF 400000 sin .FP 000015 spd .FPAC 000005 spd .GJDEF 000000 sin .GJNHG 777777 sin .JIBAT 000011 sin .JSAOF 000001 sin .NULIO 377777 sin .PAREV 000003 spd .PARMK 000002 spd .PARNO 000000 spd .PAROD 000004 spd .PARSP 000001 spd .PRIIN 000100 sin .PRIOU 000101 sin .PX7 610001 000000 spd .RHALF 777777 sin .SAC 000016 .SAV1 000000 ext .SAV2 000000 ext .SAV3 000000 ext K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 19:41 30-Mar-24 Page S-3 K20IOC MAC 7-Jan-24 19:31 SYMBOL TABLE FOR PSECT CODE ASCZCP 001351' ext INPCLR 001104' ent STRC 002732' ext ..0066 000074' spd ATMBUF 004126' ext ISNULJ 001635' ext STRPTR 001241' ext ..0070 000102' spd BSRCH1 001316' JOBTAB 000000 ext TAKJFN 000370' ext ..0075 000103' spd BSRCH2 001322' LCLPAR 003634' ext TIMDEL 000422' ext ..0113 000122' spd BSRCHS 001236' LOOPIO 000541' TIMEON 002063' ext ..0114 000123' spd BUFBEG 001115' LOOPOV 000545' TRANOT 002401' ..0127 000162' spd CAPHRL 002631' LOOPTM 000543' TTFORK 003573' ext ..0132 000154' spd CAPMXL 003776 spd M1STCH 000553' TTIPAR 003112' ext ..0137 000152' spd CAPTFS 002461' MARK 003453' ent TTYJFN 003061' ext ..0145 000157' spd CARIER 001377' ext MATCHS 000563' TTYOB 002073' ext ..0146 000162' spd CCOFF2 002301' ext MOVCHR 003105' ext TTYOU 002343' ext ..0155 000167' spd CCON 002553' ext MOVSUP 000555' TVTBUF 004154' ext ..0163 000206' spd CESCXP 003200' ent MRKTAB 001324' TVTFLG 003747' ext ..0164 000211' spd CFMRTN 001347' ext MYCAPS 000000 ext UNBITS 002344' ext ..0165 000176' spd CHKLIN 001376' ext NBICT 003007' ext VSOCT 002255' ext ..0172 000205' spd CHKPAR 003721' ent NETINS 000432' VSOMX 002511' ext ..0201 000202' spd CHKSEC 001553' ext NETJFN 003605' ext VSOTC 002623' ext ..0202 000205' spd CHRMOV 003174' NETPRN 001060' VTERMF 002341' ext ..0213 000232' spd CHRMUP 003176' NOIRTN 003500' ext $CAPTU 002473' ent ..0221 000227' spd CJFNBK 004217' ext NONE 003452' ent $CAPUX 002625' ..0222 000231' spd CLRBUF 002337' ext NRTFLG 003611' ext $INP4A 000262' ..0223 000244' spd CLREST 003034' ext NSICI 003063' ext $INPCL 000425' ..0230 000245' spd CMDER1 001730' ext NSIMX 003065' ext $INPU5 000277' ..0235 000253' spd CMDERR 003536' ext NSITC 003066' ext $INPU6 000300' ..0243 000262' spd CMLOC 002075' ext NTRIGR 001026' $INPU7 000304' ..0245 000266' spd CMPOFF 002300' ext NUL4 000376' ext $INPU9 000345' ..0253 000276' spd CMPON 002100' ext OCTMOV 003366' $INPUT 000254' ent ..0260 000277' spd CMPRMN 000557' int ODD 003463' ent $INPUX 000411' ..0265 000312' spd CMSEEN 002132' ext OPNPAR 003607' ext $INPUY 000410' ..0266 000321' spd CPLOC 002077' ext PADBUF 003744' ent $OUTP4 001374' ..0272 000326' spd CPSEEN 002170' ext PARCHR 003645' $OUTPU 001357' ent ..0304 000334' spd CRLF 003412' ext PARITY 003722' ext $SETPA 003544' ent ..0306 000342' spd CVTOCT 003370' PARS2 002546' ext $SINSE 000067' ..0314 000353' spd DEFINF 003535' ext PARS3 003547' ext $SINSI 000061' ..0321 000355' spd DOARPA 002070' ext PARS4 003545' ext $TRAN1 002011' ..0326 000365' spd DOBITS 002071' ext PARS6 001666' ext $TRAN2 002056' ..0344 000406' spd DUPLEX 002177' ext PARS7 002476' ext $TRAN3 002125' ..0352 000403' spd EBQ 003604' ext PARS8 002014' ext $TRAN4 002163' ..0353 000406' spd EBQR 003602' ext POPJFN 000410' ext $TRAN5 002171' ..0354 000420' spd EOFOVR 003126' PTYFLG 003617' ext $TRAN6 002206' ..0362 000420' spd ERRPTR 001640' ext PUTPAR 003655' ent $TRAN7 002271' ..0374 000423' spd ESCCHR 003261' ent R 003775' ext $TRANS 001731' ent ..0403 000437' spd ESCMOV 003257' RFIELD 003504' ext $TRANT 002357' ..0404 000537' spd EVEN 003457' ent RFLDE 003523' ext $TRANX 002300' ..0411 000451' spd EVNODD 003466' RRSLIN 002625' ext %%JSER 003570' ext ..0414 000462' spd FILJFN 002641' ext RSKP 003742' ext %EOFSW 000000 spd ..0422 000453' spd FRCLOS 002547' ext SEOLCH 000000 ext %SILSW 000001 spd ..0423 000461' spd GENPAR 003676' ent SESFLG 001467' ext %TIMSW 000002 spd ..0430 000464' spd GETCRT 002772' SESJFN 001465' ext ..0030 000021' spd ..0435 000532' spd HANDSH 001656' ext SPACE 003455' ent ..0031 000022' spd ..0447 000521' spd IACIAC 002222' ext SPADCH 000000 ext ..0040 000042' spd ..0450 000531' spd INILIN 002555' ext SSTHDR 000000 ext ..0041 000046' spd ..0457 000572' spd INPBFA 001233' STR2BP 000562' ..0042 000046' spd ..0464 000600' spd INPBFC 001116' ent STRBF2 004210' ext ..0056 000056' spd ..0473 000612' spd INPBTC 001232' STRBUF 004216' ext ..0057 000061' spd ..0505 000665' spd K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 19:41 30-Mar-24 Page S-4 K20IOC MAC 7-Jan-24 19:31 SYMBOL TABLE FOR PSECT CODE ..0507 000650' spd ..1247 001763' spd ..1750 002741' spd .CAPTU 002463' ent ..0515 000650' spd ..1250 001767' spd ..2021 002775' spd .INPU0 000134' ..0526 000655' spd ..1251 001770' spd ..2022 003074' spd .INPU1 000211' ..0534 000675' spd ..1256 001776' spd ..2032 003030' spd .INPU2 000220' ..0546 000710' spd ..1257 002011' spd ..2033 003034' spd .INPUT 000131' ent ..0554 000715' spd ..1264 002054' spd ..2034 003023' spd .OUTPU 001333' ent ..0556 000730' spd ..1271 002031' spd ..2046 003027' spd .SETIN 000000' ent ..0563 000732' spd ..1277 002042' spd ..2056 003045' spd .SETPA 003477' ent ..0564 000765' spd ..1305 002056' spd ..2067 003067' spd .SINCA 000007' ..0572 000746' spd ..1313 002064' spd ..2075 003110' spd .SINDT 000030' ..0604 000753' spd ..1315 002074' spd ..2076 003114' spd .SINSE 000062' ..0606 001000' spd ..1331 002133' spd ..2101 003121' spd .SINTA 000110' ..0623 001006' spd ..1345 002141' spd ..2106 003124' spd .TRAN0 001510' ..0625 001013' spd ..1346 002152' spd ..2107 003133' spd .TRAN1 001512' ..0633 001040' spd ..1352 002156' spd ..2121 003141' spd .TRAN2 001572' ..0650 001046' spd ..1357 002157' spd ..2127 003161' spd .TRAN3 001647' ..0652 001075' spd ..1364 002163' spd ..2130 003163' spd .TRANE 001670' ..0675 001155' spd ..1366 002171' spd ..2136 003213' spd .TRANS 001501' ent ..0706 001167' spd ..1402 002177' spd ..2137 003237' spd ..0713 001220' spd ..1404 002244' spd ..2147 003230' spd ..0720 001221' spd ..1413 002233' spd ..2151 003255' spd ..0725 001205' spd ..1422 002237' spd ..2164 003314' spd ..0736 001217' spd ..1423 002244' spd ..2171 003316' spd ..0746 001263' spd ..1426 002255' spd ..2174 003334' spd ..0753 001267' spd ..1433 002264' spd ..2215 003415' spd ..0764 001347' spd ..1442 002271' spd ..2225 003423' spd ..0770 001406' spd ..1450 002277' spd ..2235 003434' spd ..1000 001443' spd ..1462 002337' spd ..2245 003442' spd ..1007 001435' spd ..1464 002331' spd ..2325 003514' spd ..1016 001442' spd ..1471 002337' spd ..2334 003520' spd ..1017 001443' spd ..1500 002345' spd ..2335 003541' spd ..1023 001500' spd ..1512 002354' spd ..2342 003535' spd ..1035 001500' spd ..1520 002364' spd ..2343 003540' spd ..1050 001564' spd ..1521 002376' spd ..2344 003557' spd ..1055 001537' spd ..1537 002413' spd ..2351 003560' spd ..1063 001543' spd ..1540 002423' spd ..2356 003574' spd ..1071 001562' spd ..1554 002447' spd ..2367 003602' spd ..1073 001553' spd ..1555 002455' spd ..2370 003644' spd ..1107 001557' spd ..1602 002527' spd ..2371 003634' spd ..1110 001562' spd ..1610 002512' spd ..2376 003641' spd ..1117 001567' spd ..1616 002524' spd ..2377 003633' spd ..1120 001572' spd ..1617 002527' spd ..2405 003617' spd ..1132 001632' spd ..1624 002552' spd ..2412 003630' spd ..1140 001612' spd ..1632 002537' spd ..2415 003625' spd ..1146 001631' spd ..1633 002552' spd ..2422 003630' spd ..1163 001645' spd ..1644 002556' spd ..2431 003641' spd ..1174 001665' spd ..1645 002625' spd ..2450 003647' spd ..1204 001705' spd ..1652 002575' spd ..2451 003654' spd ..1205 001715' spd ..1663 002615' spd ..2452 003770' spd ..1222 001730' spd ..1664 002624' spd ..IFT 200000 000001 spd ..1230 001741' spd ..1705 002654' spd ..JX1 200000 000000 spd ..1231 002011' spd ..1706 002663' spd ..MX1 000003 spd ..1236 001744' spd ..1720 002720' spd ..MX2 000001 spd ..1237 001756' spd ..1740 002701' spd ..TX1 200000 000000 spd ..1240 001757' spd ..1741 002712' spd ..TX2 000001 spd K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 19:41 30-Mar-24 Page S-5 K20IOC MAC 7-Jan-24 19:31 SYMBOL TABLE FOR PSECT CONST BTRNST 001052' BTRNSU 001252' CAPBK 000216' CAPBKL 000010 spd CAPSWI 000213' CASTAB 000007' CHRTAB 000250' int CHRTUP 000450' EPAR7T 002052' EPAR8T 003052' ESCTAB 000650' HANDSH 000000 ext INCFDB 000013' INDFDB 000021' INPFDB 000051' INPSWF 000047' INPSWI 000045' INTFDB 000037' ITATAB 000032' MPAR7T 001652' MPAR8T 002652' OCTTAB 000751' OPAR7T 002252' OPAR8T 003252' OUTFDB 000110' PARSWI 003463' PARTAB 003452' PCHARS 003531' SCHRPR 003474' SEOLCH 000000 ext SERTLN 000200 spd SINTAB 000000' SPADCH 000000 ext SPAFDB 003506' SPAFDD 003511' SPAR7T 001452' SPAR8T 002452' SPWFDB 003513' SPWFDD 003516' SSTHDR 000000 ext STPART 003501' TIMFDB 000160' TINFDB 000005' TRANFD 000154' TRANFS 000152' TRANFT 000136' TRNBK 000122' TRNBKL 000010 spd TRNSWI 000132' TXTFDB 000054' %ODD 003457' ..XX 003002 000000 spd K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 19:41 30-Mar-24 Page S-6 K20IOC MAC 7-Jan-24 19:31 SYMBOL TABLE FOR PSECT TEXT INPINI 000134' int K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 19:41 30-Mar-24 Page S-7 K20IOC MAC 7-Jan-24 19:31 SYMBOL TABLE FOR PSECT DATA CHKINT 000001' int FSIZED 002222' GENINT 000000' int INCASE 000005' int INDEFC 000010' int INDEFF 000007' int INDEFS 000012' int INDEFT 000006' int INDEFW 000011' int INPBUF 001222' int INPCBF 001217' int INPCNT 001220' int INPPTR 001221' INTIMA 000004' int ORNETC 001215' ORNETP 001216' PARPKO 000002' int PARRCK 000003' int SERTAB 001015' TRGCHR 001012' TRNBAS 001013' k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 1 K20DSP MAC 9-Nov-23 18:22 Preliminaries 20619 title k20dsp - Kermit-20 Display Routines 20620 20621 ; All display code was removed from k20mit and moved to this module as 20622 ; part of Edit 194 to address the issue of a very large single source 20623 ; file that unexpectedly began generating MCRNEC errors. 20624 ; 20625 ; During this time, some code was rewritten to decrease symbol table 20626 ; usage, to (hopefully) clean up control flow and provide for 20627 ; additional checking and better recovery. Speed ups were not avoided 20628 ; where possible, typically space being traded for time. However, 20629 ; this was not done at the expense of clarity, maintainability being 20630 ; of paramount concern. 20631 ; 20632 ; The code here should be differentiated from the extensive help text 20633 ; which is contained in k20hlp, which is constant, does not change 20634 ; during runtime and resides in its own .PSECT. The text here is 20635 ; dynamically generated. 20636 20637 subttl Preliminaries 20638 20639 search monsym,macsym,cmd,k20unv ;[194] 20640 cmdacs ^ ;Clean up p1-p4 definitions 20641 20642 sall ; Tidy listing 20643 .directive flblst ; We don't need to see all the ASCIZ bytes... 20644 20645 remark common parsing external data 20646 20647 extern pars1 ; Data from first parse. 20648 extern pars2 ; Data from second parse. 20649 extern pars3 ; Data from third parse. 20650 extern pars4 ; Data from fourth parse. 20651 extern pars5 ;[41] ... 20652 20653 remark for file handling 20654 20655 extern filjfn ; JFN of currently open file 20656 20657 remark other useful routines and data 20658 20659 extern qlog ; Quit logging 20660 extern %%jser ; Support for error macros 20661 extern %%smsg ; Support for smsg macro 20662 extern BOUTI% ;[216] BOUT% Internal 20663 extern errptr ; Pointer to error message 20664 extern getnti ; Get information about line 20665 extern ccon, ccoff ; Handle control-C, if we have it 20666 extern crlf ; Carriage return line feed 20667 extern crlflf ; As previous, but double line feed 20668 extern ttyjfn ; JFN on local terminal 20669 extern $priou ; Terminal primary output 20670 k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 2 K20DSP MAC 9-Nov-23 18:22 Various NUL: ASCII strings and lengths 20671 subttl Various NUL: ASCII strings and lengths 20672 20673 .psect text ; Text goes in text psect 20674 000000'01 472531 435032 nulnam: byte (7) "N","U","L",":", .chcrt, .chlfd, .chlfd, .chnul 20675 000002'01 252352 546164 astnul: byte (7) "*","N","U","L",":", .chnul 20676 .endps text 20677 20678 .psect const ; Read-only constants go in constants psecn 20679 000000'02 44 07 0 00 000000# nulptr: point 7, nulnam ; Pointer to fixed "NUL:" string 20680 000001'02 777777 777770 -^d8 ; "NUL:" (4) + crlflf (4) 20681 000002'02 44 07 0 00 000000# nul5: point 7, astnul ; Pointer to fixed "*NUL:" ASCIZ 20682 000003'02 777777 777773 -^d5 ; Length of same 20683 .endps const ; End of constants 20684 20685 .psect code/ronly ; Don't allow stores 20686 k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 3 K20DSP MAC 9-Nov-23 18:22 Clear Control-O, if set 20687 subttl Clear Control-O, if set 20688 20689 ; Preserves all registers, +1 always 20690 ; 20691 ; This is concerned about the local controlling terminal, not anything 20692 ; remote over a pseudo-terminal, network or (maybe) pipe. 20693 20694 000000'03 clrcno: entry clrcno 20695 000000'03 265 16 0 00 004357' saveac ; Just don't touch 20696 20697 000001'03 200 01 0 00 000000* move t1, $PRIOU ; Whatever is best to choose for primary output 20698 000002'03 104 00 0 00 000107 RFMOD% ; Find out about control-O 20699 000003'03 320 12 0 00 000005' ifje. r ; Failed?? 20700 000004'03 254 00 0 00 000010' 20701 000005'03 200 04 0 00 000001 move t4, t1 ; Save error, just in case 20702 000006'03 400 02 0 00 000000 setz t2, ; Assume ^O has not been typed 20703 000007'03 200 01 0 00 000001* move t1, $PRIOU ; Reload JFN or device, just in case 20704 000010'03 endif. 20705 20706 000010'03 627 02 0 00 400000 txzn t2, tt%osp ; Is Output suppress (^O) on? 20707 000011'03 263 17 0 00 000000 ret ; No, nothing to do 20708 000012'03 104 00 0 00 000110 SFMOD% ; Otherwise, turn it off 20709 000013'03 320 12 0 00 000015' ifje. r ; Failed?? But we just read it... 20710 000014'03 254 00 0 00 000017' 20711 000015'03 200 04 0 00 000001 move t4, t1 ; Save error, just in case 20712 000016'03 200 01 0 00 000007* move t1, $PRIOU ; Reload JFN or device, just in case 20713 000017'03 endif. 20714 20715 000017'03 263 17 0 00 000000 ret ; Done 20716 k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 4 K20DSP MAC 9-Nov-23 18:22 typnam - Type a file name 20717 subttl typnam - Type a file name 20718 20719 ; t1/ Output JFN or designator 20720 ; t2/ JFN to render 20721 ; 20722 ; Updates t1, if string pointer 20723 ; 20724 ; +1/ If failed along the way (t1 unchanged) 20725 ; +2/ Succeeded 20726 20727 000020'03 typnam: entry typnam ;[220] 20728 000020'03 265 16 0 00 004371' saveac ; Save these anyway 20729 000021'03 200 05 0 00 000001 move q1, t1 ; Save output designator 20730 000022'03 400 04 0 00 000000 setz t4, ; No string prefix or stop character 20731 20732 000023'03 302 02 0 00 377777 caie t2, .nulio ;[193] NUL: talisman? 20733 000024'03 254 00 0 00 000035' ifskp. ;[193] Yes, that's easy 20734 000025'03 120 02 0 00 000000# dmove t2, nulptr ;[193] Point to equivalent string 20735 000026'03 104 00 0 00 000053 SOUT% ;[193] Counted SOUT% is faster 20736 000027'03 320 12 0 00 000031' ifje. r ;[194] Failed?? 20737 000030'03 254 00 0 00 000034' 20738 000031'03 200 04 0 00 000001 move t4, t1 ;[193] Save error for debuggers 20739 000032'03 200 01 0 00 000005 move t1, q1 ;[193] Restore output designator 20740 000033'03 263 17 0 00 000000 ret ;[194] Give error return 20741 000034'03 endif. ;]194] End SOUT% error handling 20742 000034'03 254 00 0 00 000053' else. ;[193] Otherwise, a real JFN 20743 000035'03 400 03 0 00 000000 setz t3, ; Default formatting 20744 000036'03 104 00 0 00 000030 JFNS% ; Type it someplace 20745 000037'03 320 12 0 00 000041' ifje. r ;[194] Failed?? 20746 000040'03 254 00 0 00 000044' 20747 000041'03 200 04 0 00 000001 move t4, t1 ;[194] Save error for debuggers 20748 000042'03 200 01 0 00 000005 move t1, q1 ;[194] Restore output designator 20749 000043'03 263 17 0 00 000000 ret ;[194] Give error return 20750 000044'03 endif. ;]194] End JFN% error handling 20751 dmove t2, [ point 7, crlflf ;[194] Double linefeed 20752 000044'03 120 02 0 00 004403' -^d4 ] ;[194] Four characters total in string 20753 000045'03 104 00 0 00 000053 SOUT% ;[193] Counted SOUT% is faster 20754 000046'03 320 12 0 00 000050' ifje. r ;[194] Failed?? 20755 000047'03 254 00 0 00 000053' 20756 000050'03 200 04 0 00 000001 move t4, t1 ;[193] Save error for debuggers 20757 000051'03 200 01 0 00 000005 move t1, q1 ;[193] Restore output designator 20758 000052'03 263 17 0 00 000000 ret ;[194] Give error return 20759 000053'03 endif. ;]194] End SOUT% error handling 20760 000053'03 endif. ;[193] End .nulio special casing 20761 20762 000053'03 254 00 0 00 000000* retskp ;[194] Won!! 20763 k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 5 K20DSP MAC 9-Nov-23 18:22 Routine to type a file at the local terminal. 20764 subttl Routine to type a file at the local terminal. 20765 20766 ; Call: 20767 ; 20768 ; t1/ JFN of file to type 20769 ; t3/ Byte size 20770 ; 20771 ; Returns +1, If anything strange 20772 ; +2, Success 20773 ; 20774 ; Rewritten be a little more picky about the calling arguments and to 20775 ; use PMAP% instead of SIN%. Passing a HRROI in to a file opened in 8 20776 ; bit mode did the wrong thing, anyway. 20777 ; 20778 ; Will also generate parity for a seven bit file, if we're asked to 20779 ; to do that. That should normally never happen as the monitor should 20780 ; be handling this. The code here is largely for testing purposes. 20781 ; 20782 ; Note: The routine checks for a byte size between 1 and 36, however 20783 ; only a byte size of 7 or 8 are properly handled, everything 20784 ; but 8 being displayed as a seven bit (I.E., ASCII) file. This 20785 ; will properly type 36 bit listings generated by PA1050 and is 20786 ; no worse then the previous (incorrect) behavior. 20787 ; 20788 ; N.B., For an eight bit file, parity must be ignored--you're on your 20789 ; own... 20790 20791 000054'03 typfil: entry typfil ;[220] 20792 000054'03 265 16 0 00 004405' saveac 20793 20794 000055'03 514 05 0 00 000001 hrlz q1, t1 ; Save JFN, start at file page zero 20795 000056'03 621 01 0 00 777777 tlz t1, -1 ; Whack any flags left lying around 20796 000057'03 306 01 0 00 377777 cain t1, .nulio ; Asked to type NUL:? 20797 000060'03 254 00 0 00 000053* retskp ; That's easy; we're done already! 20798 20799 000061'03 323 03 0 00 000066' ifg. t3 ; Could the byte size be reasonable? 20800 000062'03 303 03 0 00 000044 caile t3, ^d36 ; Yes, but is it actually so? 20801 000063'03 254 00 0 00 000066' anskp. ; No, it's delusional 20802 000064'03 200 06 0 00 000003 move q2, t3 ; It's fine, so save the validated file byte size 20803 000065'03 254 00 0 00 000106' else. ; Otherwise, byte size is some kind of gubbish 20804 000066'03 200 01 0 00 000000# txmsg <% KERMIT-20 can not type a file with a byte size of: > 20805 000067'03 104 00 0 00 000076 20806 000070'03 320 12 0 00 000071' 20807 000004'02 000000000000# 20808 000000'04 045 040 113 105 122 20809 000071'03 201 01 0 00 000101 movei t1, .priou ; continue on this terminal 20810 000072'03 200 02 0 00 000003 move t2, t3 ; Load it where NOUT% wants it 20811 000073'03 201 03 0 00 000012 movei t3, ^d10 ; Base ten 20812 000074'03 104 00 0 00 000224 NOUT% ; Type the bogus byte size 20813 000075'03 320 12 0 00 000077' ifje. r ; Catch and ignore error 20814 000076'03 254 00 0 00 000103' 20815 000077'03 200 04 0 00 000001 move t4, t1 ; Store error for debugger 20816 000100'03 200 01 0 00 000000# txmsg <*ERROR*> ; About as good as we can do 20817 000101'03 104 00 0 00 000076 20818 000102'03 320 12 0 00 000103' k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 5-1 K20DSP MAC 9-Nov-23 18:22 Routine to type a file at the local terminal. 20819 000005'02 000000000000# 20820 000013'04 052 105 122 122 117 20821 000103'03 endif. ; End NOUT% error handling 20822 000103'03 561 01 0 00 000000* hrroi t1, crlf ; Tie off the line 20823 000104'03 104 00 0 00 000076 PSOUT% 20824 000105'03 263 17 0 00 000000 ret ; Return a failure 20825 000106'03 endif. ; End byte size checking 20826 20827 000106'03 104 00 0 00 000024 GTSTS% ; Otherwise, see if we can use the JFN at all 20828 000107'03 320 12 0 00 000111' ifje. r ; Failed?? 20829 000110'03 254 00 0 00 000131' 20830 000111'03 200 04 0 00 000001 move t4, t1 ; Store error for debugging 20831 000112'03 200 01 0 00 000000# emsg ;Begin complaining 20832 000113'03 104 00 0 00 000313 20833 000006'02 000000000000# 20834 000015'04 103 141 156 047 164 20835 000114'03 201 01 0 00 000101 movei t1, .priou ; continue on this terminal 20836 000115'03 554 02 0 00 000005 hlrz t2, q1 ; Load JFN, which was stored prepratory to PMAP%ing 20837 000116'03 201 03 0 00 000010 movei t3, ^d8 ; JFN's are base 8 20838 000117'03 104 00 0 00 000224 NOUT% ; Type it (or try to, anyway) 20839 000120'03 320 12 0 00 000122' ifje. r ; Catch and ignore error 20840 000121'03 254 00 0 00 000126' 20841 000122'03 200 04 0 00 000001 move t4, t1 ; Store error for debugger 20842 000123'03 200 01 0 00 000000# txmsg <*ERROR*> ; About as good as we can do 20843 000124'03 104 00 0 00 000076 20844 000125'03 320 12 0 00 000126' 20845 000007'02 000000000000# 20846 000022'04 052 105 122 122 117 20847 000126'03 endif. ; End NOUT% error handling 20848 000126'03 561 01 0 00 000103* hrroi t1, crlf ; And tie off the complaint 20849 000127'03 104 00 0 00 000076 PSOUT% 20850 000130'03 263 17 0 00 000000 ret ; And get out of here 20851 000131'03 endif. ; End case JSYS error handling 20852 20853 000131'03 603 02 0 00 000200 ifxe. t2, gs%nam ; So does anything in there smell like a JFN? 20854 000132'03 254 00 0 00 000154' 20855 000133'03 200 04 0 00 000001 move t4, t1 ; Store error for debugging 20856 000134'03 200 01 0 00 000000# emsg ;Begin complaining 20857 000135'03 104 00 0 00 000313 20858 000010'02 000000000000# 20859 000024'04 103 141 156 047 164 20860 000136'03 201 01 0 00 000101 movei t1, .priou ; continue on this terminal 20861 000137'03 554 02 0 00 000005 hlrz t2, q1 ; Load JFN, which was stored prepratory to PMAP%ing 20862 000140'03 201 03 0 00 000010 movei t3, ^d8 ; JFN's are base 8 20863 000141'03 104 00 0 00 000224 NOUT% ; Type it (or try to, anyway) 20864 000142'03 320 12 0 00 000144' ifje. r ; Catch and ignore error 20865 000143'03 254 00 0 00 000150' 20866 000144'03 200 04 0 00 000001 move t4, t1 ; Store error for debugger 20867 000145'03 200 01 0 00 000000# txmsg <*ERROR*> ; About as good as we can do 20868 000146'03 104 00 0 00 000076 20869 000147'03 320 12 0 00 000150' 20870 000011'02 000000000000# 20871 000031'04 052 105 122 122 117 20872 000150'03 endif. ; End NOUT% error handling 20873 000150'03 561 01 0 00 000126* hrroi t1, crlf ; And tie off the complaint k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 5-2 K20DSP MAC 9-Nov-23 18:22 Routine to type a file at the local terminal. 20874 000151'03 104 00 0 00 000076 PSOUT% 20875 000152'03 263 17 0 00 000000 ret ; And get out of here 20876 000153'03 254 00 0 00 000155' else. ; Otherwise, at least the JSYS worked 20877 000154'03 200 04 0 00 000002 move t4, t2 ; So save the status bits past the DVCHR% 20878 000155'03 endif. ; End case initial JFN check 20879 20880 000155'03 104 00 0 00 000117 DVCHR% ; Now let's have a look at the device 20881 000156'03 320 12 0 00 000160' ifje. r ; Failed?? 20882 000157'03 254 00 0 00 000162' 20883 000160'03 200 04 0 00 000001 move t4, t1 ; Get the error out of the way 20884 000161'03 477 02 0 00 000003 setob t2, t3 ; Assume no kind of device 20885 000162'03 endif. 20886 20887 000162'03 135 03 0 00 004423' load t3, dv%typ,t2 ; Pick up the device type 20888 000163'03 306 03 0 00 000015 cain t3, .dvnul ; Did this manage to slip through?? 20889 000164'03 254 00 0 00 000060* retskp ; Strangely, it did; silently ignore it 20890 20891 000165'03 306 03 0 00 000000 cain t3, .dvdsk ; Not a disk? 20892 000166'03 254 00 0 00 000207' ifskp. ; Won't be mapping it, then 20893 000167'03 200 01 0 00 000000# emsg 20894 000170'03 104 00 0 00 000313 20895 000012'02 000000000000# 20896 000033'04 103 141 156 047 164 20897 000171'03 201 01 0 00 000101 movei t1, .priou ; Carry on typing to the terminal 20898 000172'03 554 02 0 00 000005 hlrz t2, q1 ; Load the JFN (which we know is bound) 20899 000173'03 403 03 0 00 000004 setzb t3, t4 ; No special formatting or odd prefix 20900 000174'03 104 00 0 00 000030 JFNS% ; Tell us what we choked on 20901 000175'03 320 12 0 00 000177' ifje. r ; Catch and ignore error 20902 000176'03 254 00 0 00 000203' 20903 000177'03 200 04 0 00 000001 move t4, t1 ; Store error for debugger 20904 000200'03 200 01 0 00 000000# txmsg <*ERROR*> ; About as good as we can do 20905 000201'03 104 00 0 00 000076 20906 000202'03 320 12 0 00 000203' 20907 000013'02 000000000000# 20908 000041'04 052 105 122 122 117 20909 000203'03 endif. ; End NOUT% error handling 20910 000203'03 561 01 0 00 000150* hrroi t1, crlf ; And tie off the complaint 20911 000204'03 104 00 0 00 000076 PSOUT% 20912 000205'03 263 17 0 00 000000 ret ; And get out of here 20913 000206'03 254 00 0 00 000210' else. ; Ok to proceed 20914 000207'03 554 01 0 00 000005 hlrz t1, q1 ; Reload the JFN (which DVCHR% smashed) 20915 000210'03 endif. 20916 20917 000210'03 104 00 0 00 000036 SIZEF% ; Find the file size 20918 000211'03 320 16 0 00 000213' ifje. ; Failed?? 20919 000212'03 254 00 0 00 000216' 20920 000213'03 200 04 0 00 000001 move t4, t1 ; Get the error out of the way 20921 000214'03 403 02 0 00 000003 setzb t2, t3 ; Assume no kind of length 20922 000215'03 554 01 0 00 000005 hlrz t1, q1 ; Reload the JFN, just in case 20923 000216'03 endif. 20924 ; Investigate SIZEF% results 20925 000216'03 322 02 0 00 000164* jumpe t2, rskp ; If no bytes, nothing to do. 20926 000217'03 322 03 0 00 000216* jumpe t3, rskp ; No pages to map? Nothing to do... 20927 000220'03 120 07 0 00 000002 dmove q3, t2 ; Save quantities as loop counters 20928 k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 5-3 K20DSP MAC 9-Nov-23 18:22 Routine to type a file at the local terminal. 20929 000221'03 321 04 0 00 000233' ifxe. t4, gs%opn ; Finally, is the file open? 20930 remark ; It isn't, but we can silently recover 20931 000222'03 200 02 0 00 004424' movx t2,fld(^d8,of%bsz)!of%rd ; Assume reading an 8 bit file 20932 000223'03 302 06 0 00 000010 caie q2, ^d8 ; But!! Not eight bit? 20933 000224'03 200 02 0 00 004425' movx t2,fld(^d7,of%bsz)!of%rd ; Everything else is 7 bit 20934 000225'03 104 00 0 00 000021 OPENF% ; Open it 20935 000226'03 320 12 0 00 000230' %jserr (,r) ; Punt 20936 000227'03 254 00 0 00 000233' 20937 000230'03 265 01 0 00 000000* 20938 000231'03 000000000000# 20939 000232'03 254 00 0 00 000000* 20940 000043'04 125 156 141 142 154 20941 000233'03 endif. ; End case trying to recover from an unopened file 20942 20943 000233'03 260 17 0 00 000427' call whakfp ; Whack anything left over 20944 000234'03 263 17 0 00 000000 ret ; Go no further if something failed 20945 000235'03 302 06 0 00 000007 caie q2, ^d7 ; 7 bit ASCII? 20946 000236'03 254 00 0 00 000242' ifskp. ; OK, routine type out 20947 000237'03 201 04 0 00 005000 movx t4,^d<512*<36/7>> ;Count of seven bit bytes in page 20948 000240'03 505 06 0 00 440700 hrli q2, () ;Using a seven bit pointer, then 20949 000241'03 254 00 0 00 000244' else. ; Otherwise, 8 bit ASCII 20950 000242'03 201 04 0 00 004000 movx t4,^d<512*<36/8>> ;So less bytes per page 20951 000243'03 505 06 0 00 441000 hrli q2, () ;and using an eight bit pointer 20952 000244'03 endif. 20953 000244'03 541 06 0 00 007000 hrri q2, maporg ; Either way, coming from same address 20954 20955 000245'03 do. ; Finally enter loop context 20956 000245'03 200 01 0 00 000005 move t1, q1 ; Case I, load JFN and file page 20957 000246'03 120 02 0 00 004426' dmove t2, [ exp <.fhslf,,mappag>, pm%rd ] 20958 000247'03 104 00 0 00 000056 PMAP% ; Map it in, read-only 20959 000250'03 320 12 0 00 000252' %jserr (,r) ; Punt 20960 000251'03 254 00 0 00 000255' 20961 000252'03 265 01 0 00 000230* 20962 000253'03 000000000000# 20963 000254'03 254 00 0 00 000232* 20964 000050'04 125 156 141 142 154 20965 000255'03 210 03 0 00 000004 movn t3, t4 ; Let's assume the maximum 20966 000256'03 313 04 0 00 000007 camle t4, q3 ; Unless we are within the end of file 20967 000257'03 210 03 0 00 000007 movn t3, q3 ; Otherwise, just do remainder 20968 000260'03 270 07 0 00 000003 add q3, t3 ; Subtract off remaining total 20969 000261'03 200 02 0 00 000006 move t2, q2 ; Load the source pointer 20970 000262'03 200 01 0 00 000000* move t1, parity ; But! Are we putting parity on this? 20971 000263'03 306 01 0 00 000000* cain t1, none ; Anything but none means we might be doing exactly that 20972 000264'03 254 00 0 00 000304' ifskp. ; OK, some some kind of parity being done, check further 20973 000265'03 554 01 0 00 000006 hlrz t1, q2 ; Pick up the default pointer fields 20974 000266'03 306 01 0 00 441000 cain t1, () ; Not doing eight bit? 20975 000267'03 254 00 0 00 000304' anskp. ; No, can't put parity on an eight bit file 20976 000270'03 332 00 0 00 000000* skipe parpko ; Just doing parity on packets? 20977 000271'03 254 00 0 00 000304' anskp. ; Yes, so don't muck up the type out 20978 000272'03 415 16 0 00 000304' block. ; Generate the parity then 20979 000273'03 261 17 0 00 000016 20980 000274'03 265 16 0 00 004430' saveac 20981 000275'03 211 01 0 00 010000 movni t1,^d<4*strblw*2> ; Load maximum count for combined buffers 20982 000276'03 313 01 0 00 000003 camle t1, t3 ; Overflow? (have to compare negative numbers backwards) 20983 000277'03 200 03 0 00 000001 move t3, t1 ; Clip down to maximum k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 5-4 K20DSP MAC 9-Nov-23 18:22 Routine to type a file at the local terminal. 20984 000300'03 201 01 0 00 000000* movei t1,strbuf ; Resolve address of string buffer 20985 000301'03 505 01 0 00 441000 hrli t1, <(point 8,0)> ;Finish building eight bit pointer 20986 000302'03 260 17 0 00 000000* call genpar ; Generate a new string with parity 20987 000303'03 263 17 0 00 000000 endbk. ; End block context 20988 000304'03 endif. ; End case parity handling 20989 000304'03 201 01 0 00 000101 movei t1, .priou ; Type it on whatever primary output is 20990 000305'03 104 00 0 00 000053 SOUT% ; Counted SOUT% is efficient 20991 000306'03 320 12 0 00 000310' %jserr (,r) ; Punt 20992 000307'03 254 00 0 00 000313' 20993 000310'03 265 01 0 00 000252* 20994 000311'03 000000000000# 20995 000312'03 254 00 0 00 000254* 20996 000055'04 125 156 141 142 154 20997 000313'03 323 07 0 00 000316' jumple q3, endlp. ; Exit if done with all the characters 20998 000314'03 271 05 0 00 000001 addi q1, ^d1 ; Bump to next file page 20999 000315'03 367 10 0 00 000245' sojg q4, top. ; Do it, if any pages left 21000 000316'03 enddo. ; Exit loop lexical context 21001 21002 000316'03 254 00 0 00 000427' jrst whakfp ; Whack any pages 21003 k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 6 K20DSP MAC 9-Nov-23 18:22 Character echoing routine. 21004 subttl Character echoing routine. 21005 21006 ; Need to do this because having tty open in binary mode overrides ccoc 21007 ; settings. t2 contains character to echo. 21008 ; 21009 ;[151] 21010 21011 000317'03 echo: entry echo ;[196] 21012 000317'03 265 16 0 00 004357' saveac ;[186] Must save all ACs. 21013 21014 000320'03 620 02 0 00 000200 trz t2, 200 ; Strip any parity. 21015 000321'03 200 03 0 00 000002 move t3, t2 ; Make a copy of the character. 21016 21017 000322'03 301 03 0 00 000040 cail t3, 40 ;[18] Check most common case first, 21018 000323'03 303 03 0 00 000126 caile t3, 126 ;[18] namely, whether it's a printable 21019 000324'03 334 00 0 00 000000 skipa ;[18] character. 21020 000325'03 254 00 0 00 000402' jrst echo2 ;[18] If so, just go print it. 21021 21022 000326'03 307 03 0 00 000006 caig t3, 6 ; Check for control char, null thru ^F. 21023 000327'03 254 00 0 00 000354' jrst echo1 21024 000330'03 306 03 0 00 000013 cain t3, 13 ; ^K 21025 000331'03 254 00 0 00 000354' jrst echo1 21026 000332'03 301 03 0 00 000016 cail t3, 16 ; ^N-^Z 21027 000333'03 303 03 0 00 000032 caile t3, 32 21028 000334'03 334 00 0 00 000000 skipa 21029 000335'03 254 00 0 00 000354' jrst echo1 21030 000336'03 301 03 0 00 000034 cail t3, 34 ; ^\-^_ 21031 000337'03 303 03 0 00 000037 caile t3, 37 21032 000340'03 334 00 0 00 000000 skipa 21033 000341'03 254 00 0 00 000354' jrst echo1 21034 000342'03 302 03 0 00 000033 caie t3, 33 ;[194] ESC? 21035 000343'03 254 00 0 00 000346' ifskp. ;[194] Yes 21036 000344'03 201 02 0 00 000044 movei t2, "$" ; Echo as dollar sign 21037 000345'03 254 00 0 00 000402' jrst echo2 21038 000346'03 endif. ;[194] 21039 000346'03 302 03 0 00 000177 caie t3, 177 ;[194] DEL? 21040 000347'03 254 00 0 00 000352' ifskp. ;[194] Yes 21041 000350'03 474 03 0 00 000000 seto t3, ; So it echoes as ^? (100-1=77="?") 21042 000351'03 254 00 0 00 000354' jrst echo1 21043 000352'03 endif. ;[194] 21044 000352'03 200 02 0 00 000003 move t2, t3 ; Anything else, just type it. 21045 000353'03 254 00 0 00 000402' jrst echo2 21046 21047 000354'03 337 01 0 00 000000* echo1: skipg t1, ttyjfn ; Echo it on the tty. 21048 000355'03 201 01 0 00 000101 movei t1, .priou 21049 000356'03 201 02 0 00 000136 movei t2, "^" ; Print an uparrow 21050 000357'03 104 00 0 00 000051 BOUT 21051 000360'03 320 12 0 00 000362' %jserr (,) 21052 000361'03 254 00 0 00 000365' 21053 000362'03 265 01 0 00 000310* 21054 000363'03 000000 000000 21055 000364'03 254 00 0 00 000365' 21056 21057 000365'03 337 01 0 00 000000* skipg t1, sesjfn ;[195] Logging? 21058 000366'03 254 00 0 00 000401' ifskp. ;[195] Yes k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 6-1 K20DSP MAC 9-Nov-23 18:22 Character echoing routine. 21059 000367'03 336 00 0 00 000000* skipn sesflg ;[195] Active? 21060 000370'03 254 00 0 00 000401' anskp. ;[195] No 21061 000371'03 306 01 0 00 377777 cain t1, .nulio ;[193] Just dumping it? 21062 000372'03 254 00 0 00 000401' anskp. ;[195] Yeah, don't even bother then 21063 000373'03 104 00 0 00 000051 BOUT ; Yes, do that. 21064 000374'03 320 12 0 00 000376' %jserr (,qlog) ; Error, print msg, close log, rtn from there. 21065 000375'03 254 00 0 00 000401' 21066 000376'03 265 01 0 00 000362* 21067 000377'03 000000 000000 21068 000400'03 254 00 0 00 000000* 21069 000401'03 endif. ;[195] 21070 21071 000401'03 201 02 0 03 000100 movei t2, 100(t3) ; Convert to char to uncontrollified version. 21072 000402'03 337 01 0 00 000354* echo2: skipg t1, ttyjfn ; Back to TTY. 21073 000403'03 201 01 0 00 000101 movei t1, .priou 21074 000404'03 104 00 0 00 000051 BOUT ; Print the character itself. 21075 000405'03 320 12 0 00 000407' %jserr (,) 21076 000406'03 254 00 0 00 000412' 21077 000407'03 265 01 0 00 000376* 21078 000410'03 000000 000000 21079 000411'03 254 00 0 00 000412' 21080 21081 000412'03 337 01 0 00 000365* skipg t1, sesjfn ;[195] Logging? 21082 000413'03 254 00 0 00 000426' ifskp. ;[195] Yes 21083 000414'03 336 00 0 00 000367* skipn sesflg ;[195] Active? 21084 000415'03 254 00 0 00 000426' anskp. ;[195] No 21085 000416'03 306 01 0 00 377777 cain t1, .nulio ;[193] Just dumping it? 21086 000417'03 254 00 0 00 000426' anskp. ;[195] Yeah, don't even bother then 21087 000420'03 104 00 0 00 000051 BOUT ; Yes, do that. 21088 000421'03 320 12 0 00 000423' %jserr (,qlog) ; Error, print msg, close log, rtn from there. 21089 000422'03 254 00 0 00 000426' 21090 000423'03 265 01 0 00 000407* 21091 000424'03 000000 000000 21092 000425'03 254 00 0 00 000400* 21093 000426'03 endif. ;[195] 21094 21095 000426'03 263 17 0 00 000000 ret 21096 21097 k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 7 K20DSP MAC 9-Nov-23 18:22 Whack a file page, if it exists 21098 subttl Whack a file page, if it exists 21099 21100 000427'03 whakfp: entry whakfp ;[220] 21101 remark RPACS% ; Could have used this, but didn't ... 21102 000427'03 200 01 0 00 007000 move t1, maporg ; Did anything get left lying around? 21103 000430'03 320 12 0 00 000432' ifje. r ; No, so that's fine 21104 000431'03 254 00 0 00 000435' 21105 000432'03 200 04 0 00 000001 move t4, t1 ; But save the error for the curious 21106 000433'03 254 00 0 00 000217* retskp ; Succeed (since nothing to do) 21107 000434'03 254 00 0 00 000445' else. ; Otherwise, ditch whatever is there 21108 000435'03 474 01 0 00 000000 seto t1, ; Case IV, whacking a process page 21109 000436'03 120 02 0 00 004444' dmove t2, [ exp <.fhslf,,mappag>, 0 ] ; From our address space 21110 000437'03 104 00 0 00 000056 PMAP% ; Kick the page into oblivion 21111 000440'03 320 12 0 00 000442' %jserr (,r) 21112 000441'03 254 00 0 00 000445' 21113 000442'03 265 01 0 00 000423* 21114 000443'03 000000000000# 21115 000444'03 254 00 0 00 000312* 21116 000062'04 125 156 141 142 154 21117 000445'03 endif. 21118 21119 000445'03 254 00 0 00 000433* retskp ; And done 21120 k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 8 K20DSP MAC 9-Nov-23 18:22 STATISTICS external variables 21121 subttl STATISTICS external variables 21122 21123 extern nnak ; Number of NAK's seen 21124 extern ntimou ; Number of time outs 21125 extern pause ; Interpacket pause in milliseconds 21126 extern rpsiz ; Maximum receive packet size 21127 extern rtchr ; Total characters receieved 21128 extern rtot ; Received total characters 21129 extern sec ; Seconds (for figuring baud rate 21130 extern speed ; Line speed, if physical line 21131 extern spsiz ; Maximum send packet size 21132 extern statxt ; Status text 21133 extern stchr ; Total characters sent 21134 extern ewallt ;[207] Elapsed wall time block 21135 extern durtim ;[207] Prints a duration 21136 extern stot ; Sent total characters 21137 extern timerx ; Count of TIMER% JSYS errors 21138 extern ttibin ; BIN% counter 21139 extern ttildb ; ildb's over SIN%'ed data 21140 extern ttimax ; Maximum size a SIN% can do 21141 extern ttisin ; Largest SIN% we ever did 21142 k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 9 K20DSP MAC 9-Nov-23 18:22 STATISTICS command 21143 subttl STATISTICS command 21144 21145 000446'03 $srvt: entry $srvt ;[194] 21146 000446'03 334 01 0 00 004446' skipa t1,[point 7, statxt] ;[216] Server statistics 21147 000447'03 $stat: entry $stat ;[194] 21148 000447'03 201 01 0 00 000101 movei t1,.priou ;[189] Otherwise local 21149 smsg < 21150 000450'03 120 02 0 00 000000# Maximum number of characters in packet: > ;[189] 21151 000451'03 260 17 0 00 000000* 21152 000014'02 000000000000# 21153 000015'02 777777 777724 21154 000072'04 015 012 040 115 141 21155 000452'03 200 02 0 00 000000* srvnum rpsiz ;[189] 21156 000453'03 201 03 0 00 000012 21157 000454'03 104 00 0 00 000224 21158 000455'03 320 14 0 00 000456' 21159 000456'03 120 02 0 00 000000# smsg < received: > ;[189] 21160 000457'03 260 17 0 00 000451* 21161 000016'02 000000000000# 21162 000017'02 777777 777765 21163 000103'04 040 162 145 143 145 21164 000460'03 200 02 0 00 000000* srvnum spsiz ;[189] 21165 000461'03 201 03 0 00 000012 21166 000462'03 104 00 0 00 000224 21167 000463'03 320 14 0 00 000464' 21168 smsg < sent 21169 000464'03 120 02 0 00 000000# > ;[189] 21170 000465'03 260 17 0 00 000457* 21171 000020'02 000000000000# 21172 000021'02 777777 777771 21173 000106'04 040 163 145 156 164 21174 21175 000466'03 415 16 0 00 000504' block. ;[207] Set up a stack frame for registers 21176 000467'03 261 17 0 00 000016 21177 000470'03 265 16 0 00 004447' saveac ;[207] Holds a pointer to elapsed DK10 ticks double word 21178 000471'03 201 05 0 00 000000* movei q1,ewallt ;[207] Resolve address of elapsted wall time block 21179 000472'03 120 02 0 05 000017 dmove t2, .datus(q1) ;[207] Load the actual value 21180 000473'03 434 02 0 00 000003 or t2, t3 ;[207] Checking for non-zero either word 21181 000474'03 322 02 0 00 000503' ifn. t2 ;[207] Did this take any time, actually? 21182 000475'03 120 02 0 00 000000# smsg < Communications duration: > ;[207] It did 21183 000476'03 260 17 0 00 000465* 21184 000022'02 000000000000# 21185 000023'02 777777 777746 21186 000110'04 040 103 157 155 155 21187 000477'03 200 02 0 00 000005 move t2, q1 ;[207] So load pointer to the value 21188 000500'03 260 17 0 00 000000* call durtim ;[207] Print the duration 21189 smsg <, analysis: 21190 000501'03 120 02 0 00 000000# > ;[207] Close off 21191 000502'03 260 17 0 00 000476* 21192 000024'02 000000000000# 21193 000025'02 777777 777763 21194 000116'04 054 040 141 156 141 21195 21196 000503'03 endif. ;[207] End case elapsed DK10 ticks 21197 000503'03 263 17 0 00 000000 endbk. ;[207] Restore stack frame k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 9-1 K20DSP MAC 9-Nov-23 18:22 STATISTICS command 21198 21199 smsg < 21200 000504'03 120 02 0 00 000000# Sent: > ;[189] 21201 000505'03 260 17 0 00 000502* 21202 000026'02 000000000000# 21203 000027'02 777777 777762 21204 000121'04 015 012 011 123 145 21205 000506'03 200 02 0 00 000000* srvnum stot ;[189] 21206 000507'03 201 03 0 00 000012 21207 000510'03 104 00 0 00 000224 21208 000511'03 320 14 0 00 000512' 21209 21210 000512'03 120 02 0 00 000000# smsg < Efficiency: > ;[189] 21211 000513'03 260 17 0 00 000505* 21212 000030'02 000000000000# 21213 000031'02 777777 777757 21214 000124'04 040 040 040 040 011 21215 000514'03 200 02 0 00 000000* move t2, stchr 21216 000515'03 200 03 0 00 000506* move t3, stot 21217 000516'03 260 17 0 00 004143' call peffif ;[189] Print Efficiency Factor 21218 smsg < 21219 000517'03 120 02 0 00 000000# Received: > ;[189] 21220 000520'03 260 17 0 00 000513* 21221 000032'02 000000000000# 21222 000033'02 777777 777762 21223 000130'04 015 012 011 122 145 21224 000521'03 200 02 0 00 000000* srvnum rtot ;[189] 21225 000522'03 201 03 0 00 000012 21226 000523'03 104 00 0 00 000224 21227 000524'03 320 14 0 00 000525' 21228 000525'03 120 02 0 00 000000# smsg < Efficiency: > ;[189] 21229 000526'03 260 17 0 00 000520* 21230 000034'02 000000000000# 21231 000035'02 777777 777757 21232 000133'04 040 040 040 040 011 21233 000527'03 200 02 0 00 000000* move t2, rtchr 21234 000530'03 200 03 0 00 000521* move t3, rtot 21235 000531'03 260 17 0 00 004143' call peffif ;[189] Print Efficiency Factor 21236 21237 smsg < 21238 000532'03 120 02 0 00 000000# Total: > ;[189] 21239 000533'03 260 17 0 00 000526* 21240 000036'02 000000000000# 21241 000037'02 777777 777762 21242 000137'04 015 012 011 124 157 21243 000534'03 200 02 0 00 000530* move t2, rtot 21244 000535'03 270 02 0 00 000515* add t2, stot 21245 000536'03 200 04 0 00 000002 move t4, t2 ; Save the total number of chars. 21246 000537'03 201 03 0 00 000012 movei t3, ^d10 ;[194] 21247 000540'03 104 00 0 00 000224 NOUT% ;[194] 21248 000541'03 320 14 0 00 000542' erjmps .+1 ;[194] 21249 21250 000542'03 120 02 0 00 000000# smsg < Efficiency: > ;[189] 21251 000543'03 260 17 0 00 000533* 21252 000040'02 000000000000# k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 9-2 K20DSP MAC 9-Nov-23 18:22 STATISTICS command 21253 000041'02 777777 777757 21254 000142'04 040 040 040 040 011 21255 000544'03 200 02 0 00 000004 move t2, t4 ;[189] Load total of all communications chars 21256 000545'03 200 03 0 00 000514* move t3, stchr ;[189] Load file characters sent 21257 000546'03 270 03 0 00 000527* add t3, rtchr ;[189] add total receieved 21258 000547'03 260 17 0 00 004143' call peffif ;[189] One or the other will not be zero 21259 21260 smsg < 21261 21262 000550'03 120 02 0 00 000000# Total characters per second: > ;[189] 21263 000551'03 260 17 0 00 000543* 21264 000042'02 000000000000# 21265 000043'02 777777 777736 21266 000146'04 015 012 015 012 040 21267 21268 000552'03 337 03 0 00 000004 skipg t3, t4 ;[207] Did we send anything. actually? 21269 000553'03 254 00 0 00 000557' ifskp. ;[207] Looks like it 21270 000554'03 260 17 0 00 004216' call gmkcps ;[207] Print characters per second 21271 000555'03 254 00 0 00 000557' anskp. ;[207] Unless some problem (like no time) 21272 000556'03 254 00 0 00 000561' else. ;[207] In either case, don't do any math 21273 000557'03 120 02 0 00 000000# smsg <[N/A]> ;[207] So say really can't do it 21274 000560'03 260 17 0 00 000551* 21275 000044'02 000000000000# 21276 000045'02 777777 777773 21277 000155'04 133 116 057 101 135 21278 000561'03 endif. ;[207] End handling characters per second 21279 21280 smsg < 21281 000561'03 120 02 0 00 000000# Effective data rate: > ;[189] 21282 000562'03 260 17 0 00 000560* 21283 000046'02 000000000000# 21284 000047'02 777777 777747 21285 000157'04 015 012 040 105 146 21286 000563'03 336 03 0 00 000545* skipn t3, stchr ;[189] Is the number of chars sent zero? 21287 000564'03 200 03 0 00 000546* move t3, rtchr ;[189] If so we were receiving. 21288 000565'03 322 03 0 00 000570' ifn. t3 ;[207] Was there any data? 21289 000566'03 260 17 0 00 004241' call gmkbps ;[189] Display a more readable baud rate 21290 000567'03 254 00 0 00 000572' else. ;[207] Otherwise, number makes no sense 21291 000570'03 120 02 0 00 000000# smsg <[N/A]> ;[207] So say it isn't applicable 21292 000571'03 260 17 0 00 000562* 21293 000050'02 000000000000# 21294 000051'02 777777 777773 21295 000165'04 133 116 057 101 135 21296 000572'03 endif. 21297 21298 000572'03 337 00 0 00 000000# skipg pvbaud ;[210] Do we have a virtual baud rate? 21299 000573'03 333 00 0 00 000000* skiple speed ;[207] or on a real terminal? 21300 000574'03 260 17 0 00 000703' call pspeef ;[207] Go print speed efficiency (maybe) 21301 ;[180]... 21302 smsg < 21303 000575'03 120 02 0 00 000000# ILDB: > ;[189] 21304 000576'03 260 17 0 00 000571* 21305 000052'02 000000000000# 21306 000053'02 777777 777767 21307 000167'04 015 012 040 111 114 k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 9-3 K20DSP MAC 9-Nov-23 18:22 STATISTICS command 21308 000577'03 200 02 0 00 000000* srvnum ttildb ;[189] 21309 000600'03 201 03 0 00 000012 21310 000601'03 104 00 0 00 000224 21311 000602'03 320 14 0 00 000603' 21312 000603'03 120 02 0 00 000000# smsg < SIN: > ;[189] 21313 000604'03 260 17 0 00 000576* 21314 000054'02 000000000000# 21315 000055'02 777777 777770 21316 000171'04 040 040 123 111 116 21317 000605'03 200 02 0 00 000000* srvnum ttisin ;[189] 21318 000606'03 201 03 0 00 000012 21319 000607'03 104 00 0 00 000224 21320 000610'03 320 14 0 00 000611' 21321 000611'03 120 02 0 00 000000# smsg < SIN Max: > ;[189] 21322 000612'03 260 17 0 00 000604* 21323 000056'02 000000000000# 21324 000057'02 777777 777764 21325 000173'04 040 040 123 111 116 21326 000613'03 200 02 0 00 000000* srvnum ttimax ;[189] 21327 000614'03 201 03 0 00 000012 21328 000615'03 104 00 0 00 000224 21329 000616'03 320 14 0 00 000617' 21330 000617'03 120 02 0 00 000000# smsg < BIN: > ;[189] 21331 000620'03 260 17 0 00 000612* 21332 000060'02 000000000000# 21333 000061'02 777777 777770 21334 000176'04 040 040 102 111 116 21335 000621'03 200 02 0 00 000000* srvnum ttibin ;[189] 21336 000622'03 201 03 0 00 000012 21337 000623'03 104 00 0 00 000224 21338 000624'03 320 14 0 00 000625' 21339 ;...[180] 21340 21341 000625'03 336 00 0 00 000000* $stat4: skipn errptr ; Was there an error? 21342 000626'03 254 00 0 00 000640' jrst $statx ; If not, done. 21343 smsg < 21344 000627'03 120 02 0 00 000000# Canceled by error: > ;[189] 21345 000630'03 260 17 0 00 000620* 21346 000062'02 000000000000# 21347 000063'02 777777 777751 21348 000200'04 015 012 040 103 141 21349 000631'03 200 02 0 00 000625* move t2, errptr ;[189] 21350 000632'03 403 03 0 00 000004 setzb t3, t4 ;[189] 21351 000633'03 104 00 0 00 000053 SOUT% ;[189] ; If so output it. 21352 000634'03 320 14 0 00 000635' erjmps .+1 ;[189] 21353 000635'03 561 02 0 00 000203* hrroi t2, crlf ;[189] ;[50] 21354 000636'03 104 00 0 00 000053 SOUT% ;[189] 21355 000637'03 320 14 0 00 000640' erjmps .+1 ;[189] 21356 21357 ;[36] Interpacket pause. 21358 21359 $statx: smsg < 21360 000640'03 120 02 0 00 000000# Interpacket pause in effect: > 21361 000641'03 260 17 0 00 000630* 21362 000064'02 000000000000# k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 9-4 K20DSP MAC 9-Nov-23 18:22 STATISTICS command 21363 000065'02 777777 777740 21364 000205'04 015 012 040 111 156 21365 000642'03 200 02 0 00 000000* srvnum pause ;[196] 21366 000643'03 201 03 0 00 000012 21367 000644'03 104 00 0 00 000224 21368 000645'03 320 14 0 00 000646' 21369 smsg < ms 21370 21371 000646'03 120 02 0 00 000000# Timeouts: > ;[196] ;[54] How many timeouts and NAKs. 21372 000647'03 260 17 0 00 000641* 21373 000066'02 000000000000# 21374 000067'02 777777 777756 21375 000214'04 040 155 163 015 012 21376 21377 000650'03 200 02 0 00 000000* srvnum ntimou ;[189] 21378 000651'03 201 03 0 00 000012 21379 000652'03 104 00 0 00 000224 21380 000653'03 320 14 0 00 000654' 21381 smsg < 21382 000654'03 120 02 0 00 000000# NAKs: > ;[189] 21383 000655'03 260 17 0 00 000647* 21384 000070'02 000000000000# 21385 000071'02 777777 777764 21386 000220'04 015 012 040 116 101 21387 000656'03 200 02 0 00 000000* srvnum nnak ;[189] 21388 000657'03 201 03 0 00 000012 21389 000660'03 104 00 0 00 000224 21390 000661'03 320 14 0 00 000662' 21391 21392 ;[47][132] If debugging, tell most recent JSYS error. 21393 21394 000662'03 322 14 0 00 000700' jumpe debug, $statz ;[132] Debugging? 21395 $statj: smsg < 21396 000663'03 120 02 0 00 000000# Last JSYS error: > ;[189] ; Yes, tell about last error. 21397 000664'03 260 17 0 00 000655* 21398 000072'02 000000000000# 21399 000073'02 777777 777754 21400 000223'04 015 012 040 114 141 21401 000665'03 525 02 0 00 400000 hrloi t2, .fhslf 21402 000666'03 400 03 0 00 000000 setz t3, 21403 000667'03 104 00 0 00 000011 ERSTR 21404 000670'03 320 14 0 00 000672' erjmps .+2 ;[189] Ignore strange error 21405 000671'03 320 14 0 00 000672' erjmps .+1 ;[189] Ignore stranger error 21406 smsg < 21407 000672'03 120 02 0 00 000000# Timer errors: > ;[189] ;[132] Also, give hints if anything is 21408 000673'03 260 17 0 00 000664* 21409 000074'02 000000000000# 21410 000075'02 777777 777754 21411 000230'04 015 012 040 124 151 21412 000674'03 200 02 0 00 000000* srvnum timerx ;[189] ; going wrong with timers. 21413 000675'03 201 03 0 00 000012 21414 000676'03 104 00 0 00 000224 21415 000677'03 320 14 0 00 000700' 21416 21417 $statz: smsg < k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 9-5 K20DSP MAC 9-Nov-23 18:22 STATISTICS command 21418 21419 000700'03 120 02 0 00 000000# > ;[189] 21420 000701'03 260 17 0 00 000673* 21421 000076'02 000000000000# 21422 000077'02 777777 777774 21423 000235'04 015 012 015 012 000 21424 000702'03 263 17 0 00 000000 ret 21425 k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 10 K20DSP MAC 9-Nov-23 18:22 Print Speed Efficiency (if we have some kind of baud rate) 21426 subttl Print Speed Efficiency (if we have some kind of baud rate) 21427 21428 ; Rewrite of previous code for nanosecond resolution 21429 21430 ; N.B., Code IGNORES split speed and uses only the recieve speed 21431 21432 extern dblscl ; Double integer scaling factor 21433 21434 chgsec(code,const) 21435 000100'02 207620 000000 percnt: 100. ; Factor to range up to a percent 21436 000101'02 000000 000000 0. ; Double floating multiplier!! 21437 retsec 21438 21439 000703'03 pspeef: remark t1 ; It is DEADLY to touch t1!! 21440 remark ; Assumes these may be smashed 21441 remark t5, q1 ; These are aliased 21442 000703'03 265 16 0 00 004447' saveac ; Play it safe 21443 000704'03 265 16 0 00 000000* trvar <,,,,,> 21444 000705'03 000000 000014 21445 ; Naming conventions for transient variables 21446 remark dichrs ; Double Integer characters 21447 remark dfchrs ; Double floating characters 21448 remark dietic ; Double Integer elapsed ticks 21449 remark dfetic ; Double floating elapsed ticks 21450 remark disped ; Double integer speed 21451 remark dfsped ; Double floating speed 21452 21453 000706'03 403 02 0 00 000003 setzb t2, t3 ; Let's assume we'll need to float 21454 000707'03 124 02 0 15 000011 dmovem t2, disped ; an integer 21455 000710'03 124 02 0 15 000013 dmovem t2, dfsped ; baud rate 21456 21457 000711'03 135 02 0 00 004455' ldb t2,[POINTR(,nttype)] ;[210] Maybe remote, so find out 21458 000712'03 135 03 0 00 004456' ldb t3,[POINTR(,ntline)] ;[210] about our local line 21459 000713'03 332 00 0 00 000000* ifme. ptyflg ; Not connected to a pseudo terminal? 21460 000714'03 254 00 0 00 000737' 21461 000715'03 332 00 0 00 000000* skipe nrtflg ; Network remote? 21462 000716'03 254 00 0 00 000737' anskp. ; So do that 21463 000717'03 302 02 0 00 000000 caie t2, nw%nnt ; Not a network transport? 21464 000720'03 254 00 0 00 000737' anskp. ; No, so either a front end or PTY 21465 000721'03 306 03 0 00 000002 cain t3, nw%pt ; But!! Are we on a pseudo-terminal?? 21466 000722'03 254 00 0 00 000737' anskp. ; No, so can only be the front-end case 21467 smsg < 21468 000723'03 120 02 0 00 000000# Efficiency: > ; Begin more blat 21469 000724'03 260 17 0 00 000701* 21470 000102'02 000000000000# 21471 000103'02 777777 777757 21472 000236'04 015 012 040 105 146 21473 000725'03 333 03 0 00 000573* skiple t3, speed ; Load and check speed 21474 000726'03 254 00 0 00 000732' ifskp. ; Is this absurd? 21475 000727'03 120 02 0 00 000000# smsg <[SPEED ERROR]> ;Report speed error 21476 000730'03 260 17 0 00 000724* 21477 000104'02 000000000000# 21478 000105'02 777777 777763 21479 000242'04 133 123 120 105 105 21480 000731'03 263 17 0 00 000000 ret ; Leave, can't do anything else k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 10-1 K20DSP MAC 9-Nov-23 18:22 Print Speed Efficiency (if we have some kind of baud rate) 21481 000732'03 endif. ; end speed load and check 21482 000732'03 400 02 0 00 000000 setz t2, ; Assume hardware baud is not an unsigned int 21483 000733'03 623 03 0 00 400000 tlze t3, (1b0) ; Cast unsigned to signed long 21484 000734'03 201 02 0 00 000001 movei t2, ^d1 ; Propagate to high order 21485 000735'03 124 02 0 15 000011 dmovem t2, disped ; And store as the speed 21486 000736'03 254 00 0 00 000761' else. ; Otherwise, might have done virtual timing 21487 000737'03 400 05 0 00 000000 setz q1, ;[210] Let's assume we don't know what to load 21488 000740'03 332 00 0 00 000713* skipe ptyflg ;[210] Connected to a PTY? 21489 000741'03 201 05 0 00 000000# movei q1, pvbaud ;[210] Address of its virtual baud rate 21490 000742'03 332 00 0 00 000715* skipe nrtflg ;[210] How about an NRT? 21491 000743'03 201 05 0 00 000000# movei q1, dnbaud ;[210] Address of DECnet virtual baud rate 21492 000744'03 326 05 0 00 000752' ife. q1 ;[210] Still don't know? 21493 000745'03 306 03 0 00 000002 cain t3, nw%pt ;[210] A pseudo-terminal? 21494 000746'03 201 05 0 00 000000# movei q1, pvbaud ;[210] Address of its virtual baud rate 21495 000747'03 306 03 0 00 000003 cain t3, nw%mc ;[210] An NRT? 21496 000750'03 201 05 0 00 000000# movei q1, dnbaud ;[210] Address of DECnet virtual baud rate 21497 000751'03 322 05 0 00 000444* jumpe q1, R ;[210] If still nothing, then done 21498 000752'03 endif. ;[210] Otherwise some valid address in q1 21499 000752'03 120 02 0 05 000000 dmove t2, (q1) ;[210] Load any timing test data 21500 000753'03 323 02 0 00 000751* jumple t2, R ;[210] No test or bad test 21501 000754'03 124 02 0 15 000013 dmovem t2, dfsped ; Store precomputed virtual rate 21502 000755'03 477 02 0 00 000003 setob t2, t3 ; Cons up an impossible double integer baud rate 21503 000756'03 124 02 0 15 000011 dmovem t2, disped ; And store as the speed 21504 smsg < 21505 000757'03 120 02 0 00 000000# Pseudo-efficiency: > ; Begin pseudo-blat 21506 000760'03 260 17 0 00 000730* 21507 000106'02 000000000000# 21508 000107'02 777777 777751 21509 000245'04 015 012 040 120 163 21510 000761'03 endif. ; End case local or remote instrumented PTY 21511 21512 000761'03 336 03 0 00 000563* skipn t3, stchr ; Nothing sent? 21513 000762'03 200 03 0 00 000564* move t3, rtchr ; No, so this was a recieve 21514 000763'03 326 03 0 00 000767' ife. t3 ; Or did nothing happen at all? 21515 000764'03 120 02 0 00 000000# smsg <[N/A]> ; So say it isn't applicable 21516 000765'03 260 17 0 00 000760* 21517 000110'02 000000000000# 21518 000111'02 777777 777773 21519 000252'04 133 116 057 101 135 21520 000766'03 263 17 0 00 000000 ret ; And get out of here 21521 000767'03 endif. 21522 21523 000767'03 400 02 0 00 000000 setz t2, ; Assume characters are not unsigned int 21524 000770'03 623 03 0 00 400000 tlze t3, (1b0) ; Cast unsigned to signed long 21525 000771'03 201 02 0 00 000001 movei t2, ^d1 ; Propagate to high order 21526 000772'03 124 02 0 15 000001 dmovem t2, dichrs ; And store signed long 21527 21528 000773'03 415 16 0 00 001001' block. ; Enter block context for better control flow 21529 000774'03 261 17 0 00 000016 21530 000775'03 120 02 0 00 000000# dmove t2,ewallt+.datus ;Load double elapsed DK10 ticks 21531 000776'03 327 02 0 00 000445* jumpg t2, RSKP ; Non-zero high order is good 21532 000777'03 327 03 0 00 000776* jumpg t3, RSKP ; Ditto low order 21533 001000'03 263 17 0 00 000000 endbk. ; End block context 21534 001001'03 254 00 0 00 001004' ifskp. ; Positive number? 21535 001002'03 124 02 0 15 000005 dmovem t2, dietic ; Yes, so store elapsed wall time k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 10-2 K20DSP MAC 9-Nov-23 18:22 Print Speed Efficiency (if we have some kind of baud rate) 21536 001003'03 254 00 0 00 001007' else. ; Otherwise, zero or negative 21537 001004'03 120 02 0 00 000000# smsg <[TIME ERROR]> ; Report time error 21538 001005'03 260 17 0 00 000765* 21539 000112'02 000000000000# 21540 000113'02 777777 777764 21541 000254'04 133 124 111 115 105 21542 001006'03 263 17 0 00 000000 ret ; Leave, can't do anything else 21543 001007'03 endif. 21544 21545 001007'03 415 16 0 00 001034' block. ; Enter block context to double float everything 21546 001010'03 261 17 0 00 000016 21547 001011'03 265 16 0 00 004457' saveac ; Save precious T1 21548 001012'03 120 01 0 15 000011 dmove t1, disped ; Load integer baud 21549 001013'03 321 01 0 00 001017' ifge. t1 ; Already did this? 21550 001014'03 260 17 0 00 000000* call dfloat ; Convert to double floating point 21551 001015'03 263 17 0 00 000000 ret ; Or not 21552 001016'03 124 01 0 15 000013 dmovem t1, dfsped ; Store double floating speed 21553 001017'03 endif. ; Otherwise, already done 21554 21555 001017'03 120 01 0 15 000005 dmove t1, dietic ; Load double integer elapsed ticks 21556 001020'03 260 17 0 00 001014* call dfloat ; Convert to double floating point 21557 001021'03 263 17 0 00 000000 ret ; But couldn't... 21558 001022'03 124 01 0 15 000007 dmovem t1, dfetic ; Store double floating elapsed ticks 21559 001023'03 120 01 0 15 000001 dmove t1, dichrs ; Load double integer characters 21560 001024'03 116 01 0 00 000000* dmul t1, dblscl ; Scale up by nanosecond ratio 21561 001025'03 124 03 0 15 000001 dmovem t3, dichrs ; Store scaled double integer elapsed ticks 21562 21563 001026'03 120 01 0 00 000003 dmove t1, t3 ; Load same for double floating 21564 001027'03 260 17 0 00 001020* call dfloat ; Convert to double floating point 21565 001030'03 263 17 0 00 000000 ret ; Yet failed 21566 001031'03 124 01 0 15 000003 dmovem t1, dfchrs ; Store double floating characters 21567 001032'03 254 00 0 00 000777* retskp ; Indicate complete double floating success 21568 001033'03 263 17 0 00 000000 endbk. ; End block context, release frame 21569 001034'03 254 00 0 00 001040' ifskp. ; Worked 21570 001035'03 120 02 0 15 000003 dmove t2, dfchrs ; Load double floating characters 21571 001036'03 112 02 0 00 004237' dfmp t2, baud ; Convert to bits for baud rate 21572 001037'03 254 00 0 00 001043' else. ; Something went wrong... 21573 001040'03 120 02 0 00 000000# smsg <[DFLOAT ERROR]> ; Yes, whine about it 21574 001041'03 260 17 0 00 001005* 21575 000114'02 000000000000# 21576 000115'02 777777 777762 21577 000257'04 133 104 106 114 117 21578 001042'03 263 17 0 00 000000 ret ; Return, can't go any further 21579 001043'03 endif. 21580 21581 001043'03 113 02 0 15 000007 dfdv t2, dfetic ; Compute effective baud rate 21582 001044'03 112 02 0 00 000000# dfmp t2, percnt ; Scale to percentage 21583 001045'03 113 02 0 15 000013 dfdv t2, dfsped ; Divide by line rate to get efficiency 21584 001046'03 260 17 0 00 004203' call peffi0 ; Print it 21585 001047'03 120 02 0 00 000000# smsg < per cent> ;[189] 21586 001050'03 260 17 0 00 001041* 21587 000116'02 000000000000# 21588 000117'02 777777 777767 21589 000262'04 040 160 145 162 040 21590 001051'03 263 17 0 00 000000 ret k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 10-3 K20DSP MAC 9-Nov-23 18:22 Print Speed Efficiency (if we have some kind of baud rate) 21591 21592 endtv. ; End lexical context transient variables 21593 21594 ;[207] End code insertion 21595 k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 11 K20DSP MAC 9-Nov-23 18:22 Print real or virtual baud rate 21596 subttl Print real or virtual baud rate 21597 21598 extern ntiblk ;[210] NTINF% of local line 21599 21600 001052'03 332 00 0 00 000740* prntbd: skipe ptyflg ;[210] Connected to a PTY? 21601 001053'03 254 00 0 00 001107' jrst prntbv ;[210] Yes, show the virtual baud rate 21602 001054'03 332 00 0 00 000742* skipe nrtflg ;[210] How about an NRT? 21603 001055'03 254 00 0 00 001107' jrst prntbv ;[210] Yes, show the virtual baud rate 21604 remark pipflg ;[210] Connected via a pipe? 21605 remark prntbv ;[210] Yes, show the virtual baud rate 21606 ;[210] Load network and line type of local terminal 21607 001056'03 135 01 0 00 004465' ldb t1,[POINTR(,nttype)] ;[210] 21608 001057'03 135 02 0 00 004466' ldb t2,[POINTR(,ntline)] ;[210] 21609 001060'03 302 01 0 00 000000 caie t1, nw%nnt ;[210] Not a 'network' terminal? 21610 001061'03 254 00 0 00 001101' jrst prntnv ;[210] No see if it has a network virtual baud rate 21611 001062'03 306 02 0 00 000002 cain t2, nw%pt ;[210] But!! Are we on a pseudo-terminal?? 21612 001063'03 254 00 0 00 001101' jrst prntnv ;[210] We are, see if we did a speed test 21613 remark ;[210] Only other non-network terminal is FE: 21614 21615 001064'03 337 02 0 00 000725* prntbs: skipg t2,speed ; If negative, we don't really know it. 21616 001065'03 254 00 0 00 001100' ifskp. ;[194] We know it 21617 txmsg < 21618 001066'03 200 01 0 00 000000# Speed: > ; Line speed. 21619 001067'03 104 00 0 00 000076 21620 001070'03 320 12 0 00 001071' 21621 000120'02 000000000000# 21622 000264'04 015 012 040 040 123 21623 001071'03 201 01 0 00 000101 movei t1, .priou 21624 001072'03 201 03 0 00 000012 movei t3, ^d10 21625 001073'03 104 00 0 00 000224 NOUT% 21626 001074'03 320 14 0 00 001075' erjmps .+1 21627 001075'03 200 01 0 00 000000# txmsg < Bd> ;[210] Recognized suffix for "baud" 21628 001076'03 104 00 0 00 000076 21629 001077'03 320 12 0 00 001100' 21630 000121'02 000000000000# 21631 000270'04 040 102 144 000 000 21632 001100'03 endif. ;[194] 21633 001100'03 263 17 0 00 000000 ret ;[210] Either way, done 21634 21635 001101'03 400 01 0 00 000000 prntnv: setz t1, ;[210] Let's assume we don't know what to load 21636 001102'03 306 02 0 00 000002 cain t2, nw%pt ;[210] A pseudo-terminal? 21637 001103'03 201 01 0 00 000000# movei t1, pvbaud ;[210] Address of its virtual baud rate 21638 001104'03 306 02 0 00 000003 cain t2, nw%mc ;[210] An NRT? 21639 001105'03 201 01 0 00 000000# movei t1, dnbaud ;[210] Address of DECnet virtual baud rate 21640 001106'03 254 00 0 00 001114' jrst prntcm ;[210] See if anything to print 21641 21642 001107'03 400 01 0 00 000000 prntbv: setz t1, ;[210] Let's assume we don't know what to load 21643 001110'03 332 00 0 00 001052* skipe ptyflg ;[210] Connected to a PTY? 21644 001111'03 201 01 0 00 000000# movei t1, pvbaud ;[210] Address of its virtual baud rate 21645 001112'03 332 00 0 00 001054* skipe nrtflg ;[210] How about an NRT? 21646 001113'03 201 01 0 00 000000# movei t1, dnbaud ;[210] Address of DECnet virtual baud rate 21647 remark pipflg ;[210] Connected via a pipe? 21648 remark t1, pibaud ;[210] Address of its virtual baud rate 21649 21650 001114'03 prntcm: remark ;[210] Common virtual speed k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 11-1 K20DSP MAC 9-Nov-23 18:22 Print real or virtual baud rate 21651 001114'03 322 01 0 00 000753* jumpe t1, r ;[210] Return if nobody is volunteering anything 21652 001115'03 265 16 0 00 004447' saveac ;[210] Preserve for proper return xct 21653 remark t5, q1 ;[210] Because t4:t5 pair used 21654 001116'03 120 04 0 01 000000 dmove t4, (t1) ;[210] Load virtual baud rate 21655 001117'03 323 04 0 00 001114* jumple t4, r ;[210] If nothing, then don't print anything 21656 txmsg < 21657 001120'03 200 01 0 00 000000# Pseudo Speed: > ;[210] Instrumented PTY speed 21658 001121'03 104 00 0 00 000076 21659 001122'03 320 12 0 00 001123' 21660 000122'02 000000000000# 21661 000271'04 015 012 040 040 120 21662 001123'03 201 01 0 00 000101 movei t1, .priou ;[210] Display it on terminal 21663 001124'03 254 00 0 00 004256' callret gmkbp1 ;[210] Print the baud rate 21664 k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 12 K20DSP MAC 9-Nov-23 18:22 Print real or virtual baud rate 21665 remark Test command semantic action 21666 21667 ;[210] Begin Code Insertion 21668 21669 extern dptybd ; Discover PTY: virtual baud rate 21670 extern dnulbd ; Discover NUL: virtual baud rate 21671 extern dpipbd ; Discover PIP: virtual baud rate 21672 extern dsrvbd ; Discover DECnet (DCN:/SRV:) virtual baud rate 21673 extern timdev ; Device being timed 21674 21675 001125'03 $time: intern $time ; Called from k20par 21676 001125'03 265 16 0 00 004447' saveac ; Just in case anybody might needit 21677 001126'03 331 01 0 00 000000* skipl t1, pars2 ; Pick up the device to test 21678 001127'03 254 00 0 00 001151' ifskp. ; Special return?? 21679 001130'03 316 01 0 00 004467' camn t1, [-1] ; Error that somebody else blatted? 21680 001131'03 263 17 0 00 000000 ret ; We're done 21681 001132'03 554 02 0 00 000001 hlrz t2, t1 ; Reposition source device type 21682 001133'03 620 02 0 00 600000 trz t2, .dvdes ; Now have a device number 21683 001134'03 200 01 0 00 000000# txmsg 21684 001135'03 104 00 0 00 000076 21685 001136'03 320 12 0 00 001137' 21686 000123'02 000000000000# 21687 000276'04 103 157 160 151 145 21688 001137'03 200 01 0 00 000002 move t1, t2 ; Position for conversion to text 21689 001140'03 260 17 0 00 001262' call ascdev ; Do so 21690 001141'03 104 00 0 00 000076 PSOUT% ; Type the text 21691 001142'03 200 01 0 00 000000# txmsg < to > ; Where it's going 21692 001143'03 104 00 0 00 000076 21693 001144'03 320 12 0 00 001145' 21694 000124'02 000000000000# 21695 000304'04 040 164 157 040 000 21696 001145'03 200 02 0 00 000000* move t2, pars3 ; Load destination device 21697 001146'03 202 02 0 00 001126* movem t2, pars2 ; Put where downstream wants it 21698 001147'03 120 04 0 00 000000* dmove t4, pars4 ; Load the timing results 21699 001150'03 254 00 0 00 001323' callret $time1 ; And go type something 21700 001151'03 endif. 21701 21702 001151'03 202 01 0 00 000000* movem t1, timdev ; Remember device being timed 21703 001152'03 302 01 0 00 000013 caie t1, .dvpty ; Pseudo-terminal? 21704 001153'03 254 00 0 00 001172' ifskp. ; Yep, so let's run that test 21705 001154'03 476 00 0 00 000000# setom pvbaud ; Say no PTY virtual baud rate 21706 001155'03 476 00 0 00 000000# setom pvbaud+1 ; It's a double 21707 001156'03 260 17 0 00 000000* call dptybd ; Found in k20net 21708 001157'03 254 00 0 00 001165' ifskp. 21709 001160'03 327 04 0 00 001164' ifle. t4 ; Did it work? 21710 001161'03 200 01 0 00 000000# emsg 21711 001162'03 104 00 0 00 000313 21712 000125'02 000000000000# 21713 000305'04 120 163 145 165 144 21714 001163'03 263 17 0 00 000000 ret ; Can't do anything further 21715 001164'03 endif. ; Otherwise, have a valid number 21716 001164'03 254 00 0 00 001170' else. 21717 001165'03 200 01 0 00 000000# emsg 21718 001166'03 104 00 0 00 000313 21719 000126'02 000000000000# k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 12-1 K20DSP MAC 9-Nov-23 18:22 Print real or virtual baud rate 21720 000316'04 120 163 145 165 144 21721 001167'03 263 17 0 00 000000 ret ; Can't do anything further 21722 001170'03 endif. 21723 21724 001170'03 124 04 0 00 000000# dmovem t4, pvbaud ; Side-effect virtual baud rate 21725 001171'03 254 00 0 00 001323' callret $time1 ; And display it 21726 001172'03 endif. ; End case pseudo-terminal 21727 21728 001172'03 302 01 0 00 000015 caie t1, .dvnul ; NUL: device? 21729 001173'03 254 00 0 00 001212' ifskp. ; OK, so let's see how fast we can dump stuff 21730 001174'03 476 00 0 00 000000# setom nlbaud ; Assume fails 21731 001175'03 476 00 0 00 000000# setom nlbaud+1 ; It's a double word 21732 001176'03 260 17 0 00 000000* call dnulbd ; Go do some nanosecond timing 21733 001177'03 254 00 0 00 001205' ifskp. 21734 001200'03 327 04 0 00 001204' ifle. t4 ; Did it work? 21735 001201'03 200 01 0 00 000000# emsg 21736 001202'03 104 00 0 00 000313 21737 000127'02 000000000000# 21738 000327'04 104 141 164 141 040 21739 001203'03 263 17 0 00 000000 ret ; Can't do anything further 21740 001204'03 endif. ; Otherwise, have a valid number 21741 001204'03 254 00 0 00 001210' else. 21742 001205'03 200 01 0 00 000000# emsg 21743 001206'03 104 00 0 00 000313 21744 000130'02 000000000000# 21745 000337'04 104 141 164 141 040 21746 001207'03 263 17 0 00 000000 ret ; Can't do anything further 21747 001210'03 endif. 21748 21749 001210'03 124 04 0 00 000000# dmovem t4, nlbaud ; Store NUL's virtual baud rate 21750 001211'03 254 00 0 00 001323' callret $time1 ; Hit display epilogue 21751 001212'03 endif. 21752 21753 001212'03 302 01 0 00 000403 caie t1, .dvpip ; Pipe device? 21754 001213'03 254 00 0 00 001232' ifskp. ; Yep, so let's run that test 21755 001214'03 476 00 0 00 000000# setom pibaud ; Assume fails 21756 001215'03 476 00 0 00 000000# setom pibaud+1 ; It's a double word 21757 001216'03 260 17 0 00 000000* call dpipbd ; Found in k20net 21758 001217'03 254 00 0 00 001225' ifskp. 21759 001220'03 327 04 0 00 001224' ifle. t4 ; Did it work? 21760 001221'03 200 01 0 00 000000# emsg 21761 001222'03 104 00 0 00 000313 21762 000131'02 000000000000# 21763 000347'04 120 151 160 145 040 21764 001223'03 263 17 0 00 000000 ret ; Can't do anything further 21765 001224'03 endif. ; Otherwise, have a valid number 21766 001224'03 254 00 0 00 001230' else. 21767 001225'03 200 01 0 00 000000# emsg 21768 001226'03 104 00 0 00 000313 21769 000132'02 000000000000# 21770 000356'04 120 151 160 145 040 21771 001227'03 263 17 0 00 000000 ret ; Can't do anything further 21772 001230'03 endif. 21773 21774 001230'03 124 04 0 00 000000# dmovem t4, pibaud ; Store the calculated baud rate k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 12-2 K20DSP MAC 9-Nov-23 18:22 Print real or virtual baud rate 21775 001231'03 254 00 0 00 001323' callret $time1 ; Hit display epilogue 21776 001232'03 endif. ; End case pseudo-terminal 21777 21778 001232'03 306 01 0 00 000022 cain t1, .dvdcn ; DECnet active component? 21779 001233'03 201 01 0 00 000023 movei t1, .dvsrv ; Replace with DECnet passive component 21780 21781 001234'03 302 01 0 00 000023 caie t1, .dvsrv ; DECnet? 21782 001235'03 254 00 0 00 001254' ifskp. ; Yep, so let's run that test 21783 001236'03 476 00 0 00 000000# setom dnbaud ; Assume no DECnet baud rate detected 21784 001237'03 476 00 0 00 000000# setom dnbaud+1 ; It's a double 21785 001240'03 260 17 0 00 000000* call dsrvbd ; Found in k20net 21786 001241'03 254 00 0 00 001247' ifskp. 21787 001242'03 327 04 0 00 001246' ifle. t4 ; Did it work? 21788 001243'03 200 01 0 00 000000# emsg 21789 001244'03 104 00 0 00 000313 21790 000133'02 000000000000# 21791 000365'04 104 105 103 156 145 21792 001245'03 263 17 0 00 000000 ret ; Can't do anything further 21793 001246'03 endif. ; Otherwise, have a valid number 21794 001246'03 254 00 0 00 001252' else. 21795 001247'03 200 01 0 00 000000# emsg 21796 001250'03 104 00 0 00 000313 21797 000134'02 000000000000# 21798 000375'04 104 105 103 156 145 21799 001251'03 263 17 0 00 000000 ret ; Can't do anything further 21800 001252'03 endif. 21801 21802 001252'03 124 04 0 00 000000# dmovem t4, dnbaud ; Store the calculated baud rate 21803 001253'03 254 00 0 00 001323' callret $time1 ; Hit display epilogue 21804 001254'03 endif. ; End case pseudo-terminal 21805 21806 001254'03 260 17 0 00 001262' call ascdev ; Turn device number in t1 into a name 21807 001255'03 104 00 0 00 000313 ESOUT% ; Begin whining 21808 txmsg < does not have a timing routine 21809 001256'03 200 01 0 00 000000# > ; Complete whining 21810 001257'03 104 00 0 00 000076 21811 001260'03 320 12 0 00 001261' 21812 000135'02 000000000000# 21813 000404'04 040 144 157 145 163 21814 21815 001261'03 263 17 0 00 000000 ret ; Beat it 21816 k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 13 K20DSP MAC 9-Nov-23 18:22 Handle unknown and known timing devices 21817 subttl Handle unknown and known timing devices 21818 21819 ; Call: 21820 ; 21821 ; t1/ Device number to translate 21822 ; 21823 ; Return: +1 always 21824 ; 21825 ; t1/ pointer to constructed device text 21826 ; (even if unknown device) 21827 21828 chgsec(code,data) ; Need some writable storage 21829 000000'05 devtxt: block 4 ; Space for ASCII device name 21830 retsec ; Close off writable storage 21831 21832 chgsec(code,text) ; Emit some program text 21833 000004'01 125 156 153 156 157 unktxt: asciz "Unknown:" ; if we have no clue 21834 000006'01 000000 000072 dvpunc: exp ":", .chnul ; Device punctuation 21835 retsec ; Close off program text 21836 21837 001262'03 ascdev: intern ascdev ; In case K20TIM wants to directly use it 21838 001262'03 265 16 0 00 004470' saveac ; Needs some registers 21839 001263'03 200 05 0 00 000001 move q1, t1 ; Save device number 21840 21841 001264'03 260 17 0 00 001310' call devunt ; If device has units, use that 21842 001265'03 326 01 0 00 001117* jumpn t1, r ; Was transformed 21843 ; OK, not a device with units 21844 001266'03 525 02 0 05 600000 hrloi t2, .dvdes(q1) ; Turn back into a real device 21845 001267'03 201 01 0 00 000000# movei t1, devtxt ; Writable to put ASCII device name 21846 001270'03 403 03 0 00 000004 setzb t3, t4 ; Ten .chnul's of device name (6 max) 21847 001271'03 124 03 0 01 000000 dmovem t3, 0(t1) ; Stomp area 21848 001272'03 124 03 0 01 000002 dmovem t3, 2(t1) ; Plus extra for good measure 21849 001273'03 661 01 0 00 777777 tlo t1, -1 ; Now have a Tops-20 JSYS pointer 21850 21851 001274'03 104 00 0 00 000121 DEVST% ; Turn into a string 21852 001275'03 320 12 0 00 001277' ifje. r ; Catch error 21853 001276'03 254 00 0 00 001302' 21854 001277'03 200 02 0 00 000001 move t2, t1 ; And keep for a debugger 21855 001300'03 561 01 0 00 000000# hrroi t1, unktxt ; Say we don't know... 21856 001301'03 254 00 0 00 001307' else. ; Otherwise, have some text 21857 001302'03 120 02 0 00 000000# dmove t2, dvpunc ; Load device punctuation 21858 001303'03 136 02 0 00 000001 idpb t2, t1 ; Drop in the colon 21859 001304'03 200 02 0 00 000001 move t2, t1 ; Copy the pointer 21860 001305'03 136 03 0 00 000002 idpb t3, t2 ; Close off string, allowing append 21861 001306'03 561 01 0 00 000000# hrroi t1, devtxt ; Return pointer to constructed text 21862 001307'03 endif. 21863 21864 001307'03 263 17 0 00 000000 ret ; Finally return, something... 21865 k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 14 K20DSP MAC 9-Nov-23 18:22 devunt Turns a device with unit numbers into generic 21866 subttl devunt Turns a device with unit numbers into generic 21867 21868 ;Can't use chgsec here, doesn't nest 21869 21870 define gendev(d,t,%a) < 21871 xwd d,%a ;;Create an entry for this device 21872 .endps const ;;Out of constants 21873 .psect text ;;Program text 21874 %a: asciz "'t:" ;;Emit the text, no output to DDT 21875 .endps text ;;Close of text 21876 .psect const ;;Back in constants 21877 cleans(<%a>) 21878 >;;gendev 21879 21880 ; Build table of generic device text for unit based devices 21881 21882 ; The first three currently exist on PANDA and can be entered to .cmdev 21883 21884 chgsec(code,const) 21885 000136'02 000013 000000# gentab: gendev(.dvpty,PTY) ;;Pseudo-terminal (most common) 21886 000010'01 120 124 131 072 000 21887 000137'02 000012 000000# gendev(.dvtty,TTY) ;;Terminal (second most common) 21888 000011'01 124 124 131 072 000 21889 000140'02 000011 000000# gendev(.dvfe,FE) ;;Front end (may get noticed) 21890 000012'01 106 105 072 000 000 21891 remark ;;Otherwise, do in numeric order 21892 000141'02 000002 000000# gendev(.dvmta,MTA) ;;Physical magnetic tape 21893 000013'01 115 124 101 072 000 21894 000142'02 000003 000000# gendev(.dvdta,DTA) ;;1031 had these as does MOUNTR 21895 000014'01 104 124 101 072 000 21896 000143'02 000004 000000# gendev(.dvptr,PTR) ;;Paper tape reader 21897 000015'01 120 124 122 072 000 21898 000144'02 000005 000000# gendev(.dvptp,PTP) ;;Paper tape punch 21899 000016'01 120 124 120 072 000 21900 000145'02 000006 000000# gendev(.dvdsp,DIS) ;;Display 21901 000017'01 104 111 123 072 000 21902 000146'02 000007 000000# gendev(.dvlpt,LPT) ;;Line printer 21903 000020'01 114 120 124 072 000 21904 000147'02 000010 000000# gendev(.dvcdr,CDR) ;;Card reader 21905 000021'01 103 104 122 072 000 21906 000150'02 000017 000000# gendev(.dvplt,PLT) ;;Plotter 21907 000022'01 120 114 124 072 000 21908 000151'02 000021 000000# gendev(.dvcdp,CDP) ;;Card punch 21909 000023'01 103 104 120 072 000 21910 remark ; N.B., .dvats usurped by .dvnft 21911 ; gendev(.dvats,ATS) ;;Applications terminal SERVICE 21912 000152'02 000025 000000# gendev(.dvads,ADS) ;;Aydin display 21913 000024'01 101 104 123 072 000 21914 000153'02 000000000000# 0 ; Mark end of table 21915 retsec 21916 21917 ; Call: t1/ Device number, as per MONSYM 21918 ; Return: t1/ Maybe a pointer if a unit based device 21919 21920 001310'03 265 16 0 00 004502' devunt: saveac ; Just in case we get careless k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 14-1 K20DSP MAC 9-Nov-23 18:22 devunt Turns a device with unit numbers into generic 21921 001311'03 200 03 0 00 000001 move t3, t1 ; Move device number to someplace safer 21922 001312'03 400 01 0 00 000000 setz t1, ; Let's assume not a unit based device 21923 001313'03 201 04 0 00 000000# movei t4, gentab ; Load address of generics table 21924 21925 001314'03 do. ; Enter loop context 21926 001314'03 554 02 0 04 000000 hlrz t2, (t4) ; Load candidate device number 21927 001315'03 322 02 0 00 001265* jumpe t2, r ; If empty, none of the above 21928 001316'03 316 02 0 00 000003 camn t2, t3 ; Hit our device, yet? 21929 001317'03 254 00 0 00 001321' exit. ; Hot zing! Have a string to return 21930 001320'03 344 04 0 00 001314' aoja t4, top. ; Otherwise, next device 21931 001321'03 enddo. ; Exit loop context 21932 21933 001321'03 560 01 0 04 000000 hrro t1, (t4) ; Pick up address of text 21934 001322'03 263 17 0 00 000000 ret ; Return as a Tops-20 pointer 21935 k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 15 K20DSP MAC 9-Nov-23 18:22 Common Display Epilogue 21936 subttl Common Display Epilogue 21937 21938 ; T4/T5 Baud rate to display 21939 21940 001323'03 200 01 0 00 001146* $time1: move t1, pars2 ; Load device number 21941 001324'03 260 17 0 00 001262' call ascdev ; Turn into a reasonable string 21942 001325'03 104 00 0 00 000076 PSOUT% ; Type it 21943 001326'03 120 01 0 00 004514' dmove t1, [exp .priou, .chspc] 21944 001327'03 104 00 0 00 000051 BOUT% ; And space over 21945 21946 001330'03 254 00 0 00 004256' callret gmkbp1 ; Print the baud rate 21947 001331'03 561 01 0 00 000635* hrroi t1, crlf ; Tie off the line 21948 001332'03 104 00 0 00 000076 PSOUT% 21949 001333'03 263 17 0 00 000000 ret ; And done 21950 21951 ;[210] End code insertion 21952 k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 16 K20DSP MAC 9-Nov-23 18:22 SHOW VERSION 21953 subttl SHOW VERSION 21954 21955 extern $verno ;[194] Major version 21956 extern $mnver ;[194] Minor version 21957 extern $edno ;[194] Edit number 21958 extern $who ;[194] Who last edited 21959 21960 001334'03 $shtop: entry $shtop ;[194] ;[39] Top of SHOW command. 21961 001334'03 $shver: entry $shver ;[194] 21962 001334'03 200 01 0 00 000000# txmsg 21963 001335'03 104 00 0 00 000076 21964 001336'03 320 12 0 00 001337' 21965 000154'02 000000000000# 21966 000413'04 124 117 120 123 055 21967 21968 001337'03 201 01 0 00 000101 movei t1, .priou ;[194] 21969 dmove t2, [ $verno ;[197] major version 21970 001340'03 120 02 0 00 004516' ^d10 ] ;[197] Using decimal versions 21971 001341'03 104 00 0 00 000224 NOUT% ;[194] 21972 001342'03 320 14 0 00 001343' erjmps .+1 ;[194] 21973 21974 001343'03 336 02 0 00 004520' skipn t2, [$mnver] ;[197] 21975 001344'03 254 00 0 00 001353' ifskp. ;[197] minor version 21976 001345'03 201 01 0 00 000056 movei t1, "." ;[95] Use new decimal notation 21977 001346'03 104 00 0 00 000074 PBOUT ;[95] 21978 001347'03 320 14 0 00 001350' erjmps .+1 ;[194] 21979 001350'03 201 01 0 00 000101 movei t1, .priou ;[194] 21980 001351'03 104 00 0 00 000224 NOUT% ;[194] 21981 001352'03 320 14 0 00 001353' erjmps .+1 ;[194] 21982 001353'03 endif. ;[194] 21983 21984 001353'03 336 02 0 00 004521' skipn t2, [$edno] ;[197] edit 21985 001354'03 254 00 0 00 001366' ifskp. ;[197] 21986 001355'03 201 01 0 00 000050 movei t1, "(" 21987 001356'03 104 00 0 00 000074 PBOUT 21988 001357'03 320 14 0 00 001360' erjmps .+1 ;[194] 21989 001360'03 201 01 0 00 000101 movei t1, .priou ;[194] 21990 001361'03 104 00 0 00 000224 NOUT% ;[194] 21991 001362'03 320 14 0 00 001363' erjmps .+1 ;[194] 21992 001363'03 201 01 0 00 000051 movei t1, ")" 21993 001364'03 104 00 0 00 000074 PBOUT 21994 001365'03 320 14 0 00 001366' erjmps .+1 ;[194] 21995 001366'03 endif. ;[194] 21996 21997 001366'03 336 02 0 00 004522' skipn t2, [$who] ;[197] who 21998 001367'03 254 00 0 00 001376' ifskp. ;[197] 21999 001370'03 201 01 0 00 000055 movei t1, "-" 22000 001371'03 104 00 0 00 000074 PBOUT 22001 001372'03 320 14 0 00 001373' erjmps .+1 ;[194] 22002 001373'03 201 01 0 00 000101 movei t1, .priou ;[194] 22003 001374'03 104 00 0 00 000224 NOUT% ;[194] 22004 001375'03 320 14 0 00 001376' erjmps .+1 ;[194] 22005 001376'03 endif. ;[194] 22006 22007 001376'03 561 01 0 00 000000* hrroi t1, crlflf ;[194] k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 16-1 K20DSP MAC 9-Nov-23 18:22 SHOW VERSION 22008 001377'03 104 00 0 00 000076 PSOUT% ;[194] 22009 001400'03 256 00 0 00 000005 xct q1 ;[39] return or proceed... 22010 remark ;[194] May fall through .. 22011 k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 17 K20DSP MAC 9-Nov-23 18:22 SHOW DAYTIME 22012 subttl SHOW DAYTIME 22013 22014 001401'03 $shday: entry $shday ;[194] 22015 001401'03 120 01 0 00 004523' dmove t1, [ exp .priou, -1 ] ;[194] Current date and time. 22016 001402'03 205 03 0 00 336001 movx t3, ot%day!ot%fdy!ot%fmn!ot%4yr!ot%dam!ot%spa!ot%scl 22017 001403'03 104 00 0 00 000220 ODTIM% 22018 001404'03 320 12 0 00 001405' erjmpr .+1 ;[194] Catch and ignore error 22019 001405'03 260 17 0 00 003434' call moon ; Phase of the moon. 22020 22021 001406'03 561 01 0 00 001376* hrroi t1, crlflf ;[194] 22022 001407'03 104 00 0 00 000076 PSOUT% ;[194] 22023 001410'03 256 00 0 00 000005 xct q1 ;[39] return or proceed... 22024 remark ;[194] May fall through .. 22025 k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 18 K20DSP MAC 9-Nov-23 18:22 SHOW LINE external variable usage (all [194]) 22026 subttl SHOW LINE external variable usage (all [194]) 22027 22028 extern rosnpt ; Remote operating system name pointer 22029 extern brk ; Number of NUL's to send to simulate a break 22030 extern carier ; On a modem line, set if have carrier 22031 extern duplex ; Line duplex setting 22032 extern escape ; Escape character 22033 extern flow ; Type of flow control, if any 22034 extern handsh ; Handshake character 22035 extern local ; Set if in local mode 22036 extern mdmlin ; Set if dial-up line 22037 extern mytty ; Current logged in line (if not detached) 22038 extern nbict ; Network BIN% count 22039 extern netjfn ; Network JFN (even if we're remote...) 22040 extern nodnam ; Remote DECnet node name 22041 extern nodnum ; Remote DECnet node number (if monitor supports this) 22042 extern nrtflg ; Set if a valid Network Remote Terminal 22043 extern ptyflg ; Set if doing pseudo-terminal I/O 22044 extern ptynam ; ASCII device name 22045 extern sesflg ; Set if session logging is active 22046 extern sesjfn ; Contains session logging jfn 22047 extern ttynum ; Number of terminal being used 22048 extern tvtchk ; Set if doing TVT discovery 22049 extern tvtflg ; Set if must negotiate binary mode on TVT 22050 extern vbict ; Virtual Terminal BIN% Count 22051 extern vchrcn ; Total characters flushed virtual terminal 22052 extern inpcbf ; INPUT network Characters Buffer Flushed 22053 extern vtermf ; Set if virtual line (I.E., PTY or NRT) 22054 22055 remark ;[223] Parity storage 22056 extern parity ; Type of parity in use 22057 extern none ;[223] No parity being enforced 22058 extern space ; Space parity routine (0, always) 22059 extern mark ; Mark parity routine (1, always) 22060 extern even ; Even parity routine 22061 extern odd ; Odd parity routine 22062 extern parpko ;[223] Non-zero if doing parity on packets, only 22063 extern parrck ;[223] Checking parity on recieve in addition to sending 22064 extern ttipar ;[223] Total parity errors for session 22065 extern genpar ;[223] Use string instructions to generate a new string 22066 extern strc ;[223] Count of characters in temporary buffer 22067 extern strptr ;[223] Appropriate pointer to same 22068 extern strbuf ;[223] Global address of string buffer 22069 remark strbf2 ;[223] Flows into this, too 22070 22071 remark ; DECnet information (is in k20net) 22072 extern mynode ; Number of local executor (us) 22073 extern myname ; Local executor name 22074 extern ndvfxp ; If monitor has extended node verify (T79) 22075 22076 remark Some support routines 22077 22078 extern chklin ; Checks a line's status, physical, network, Etc. 22079 k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 19 K20DSP MAC 9-Nov-23 18:22 SHOW LINE display 22080 subttle SHOW LINE display 22081 22082 001411'03 $shlin: entry $shlin ;[194] Also used in command loop 22083 001411'03 336 00 0 00 001112* ifmn. nrtflg ;[186] DECnet NRT? 22084 001412'03 254 00 0 00 001502' 22085 001413'03 200 01 0 00 000000# txmsg ;[186] 22086 001414'03 104 00 0 00 000076 22087 001415'03 320 12 0 00 001416' 22088 000155'02 000000000000# 22089 000420'04 122 145 155 157 164 22090 001416'03 561 01 0 00 000000* hrroi t1, nodnam ;[186] Point to the node 22091 001417'03 104 00 0 00 000076 PSOUT% ;[186] Type it 22092 001420'03 200 01 0 00 000000# txmsg <::> ;[186] Trailing punctuation 22093 001421'03 104 00 0 00 000076 22094 001422'03 320 12 0 00 001423' 22095 000156'02 000000000000# 22096 000427'04 072 072 000 000 000 22097 22098 remark ;[186] If we don't have T79, see if we can fake it 22099 001423'03 332 00 0 00 000000* ifme. ndvfxp ;[186] Does the monitor NOT have extended node verify? 22100 001424'03 254 00 0 00 001441' 22101 001425'03 120 01 0 00 000000* dmove t1, myname ;[186] Load only node name we really know about 22102 001426'03 415 16 0 00 001436' block. ;[186] Enter block context for easier decisioning 22103 001427'03 261 17 0 00 000016 22104 001430'03 312 01 0 00 001416* came t1, nodnam ;[186] DECnet node name is maximum of six ASCII bytes 22105 001431'03 263 17 0 00 000000 ret ;[186] First 5 characters didn't match 22106 001432'03 312 02 0 00 000000# came t2, nodnam+1 ;[186] How about the last character? 22107 001433'03 263 17 0 00 000000 ret ;[186] Didn't match ... 22108 001434'03 254 00 0 00 001032* retskp ;[186] Connection is to local node! 22109 001435'03 263 17 0 00 000000 endbk. ;[186] Tear down block frame 22110 001436'03 254 00 0 00 001441' ifskp. ;[186] +2 means we knew the node inately 22111 001437'03 200 03 0 00 000000* move t3, mynode ;[186] Load number of local executor (that's us!) 22112 001440'03 202 03 0 00 000000* movem t3, nodnum ;[186] Stomp into connection data 22113 001441'03 endif. ;[186] End case attempted node recognition 22114 001441'03 endif. ;[186] End case monitor does not have T79 22115 22116 remark ;[186] N.B., requires monitor edit T79 22117 001441'03 337 04 0 00 001440* skipg t4, nodnum ;[186] Do we know the node number? 22118 001442'03 254 00 0 00 001464' ifskp. ;[186] We do, let's type it 22119 001443'03 200 01 0 00 000000# txmsg ( [) ;[186] Appropriately open broket it 22120 001444'03 104 00 0 00 000076 22121 001445'03 320 12 0 00 001446' 22122 000157'02 000000000000# 22123 000430'04 040 133 000 000 000 22124 001446'03 201 01 0 00 000101 movei t1, .priou ;[186] Still going to terminal 22125 001447'03 201 03 0 00 000012 movei t3, ^d10 ;[186] Node numbers are in octal 22126 001450'03 135 02 0 00 004525' ldb t2,[pointr t4,n%area] ;[186] Load DECnet Area Number 22127 001451'03 322 02 0 00 001457' ifn. t2 ;[186] If none, may be phase II ... 22128 001452'03 104 00 0 00 000224 NOUT% ;[186] Otherwise, type it 22129 001453'03 320 14 0 00 001454' erjmps .+1 ;[186] Catch and suppress error 22130 001454'03 201 02 0 00 000056 movei t2, "." ;[186] Punctuation suffix for areas 22131 001455'03 104 00 0 00 000051 BOUT% ;[186] Punctuate the node number 22132 001456'03 320 14 0 00 001457' erjmps .+1 ;[186] Catch and suppress error 22133 001457'03 endif. ;[186] End case non-zero area 22134 001457'03 135 02 0 00 004526' ldb t2,[pointr t4,n%node] ;[186] Load DECnet Node Number k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 19-1 K20DSP MAC 9-Nov-23 18:22 SHOW LINE display 22135 001460'03 104 00 0 00 000224 NOUT% ;[186] Type it 22136 001461'03 320 14 0 00 001462' erjmps .+1 ;[186] Catch and suppress error 22137 001462'03 201 02 0 00 000135 movei t2, "]" ;[186] Close broket 22138 001463'03 104 00 0 00 000051 BOUT% ;[186] Trailing punctuation on DECnet node number 22139 001464'03 endif. ;[186] End case known node number 22140 22141 001464'03 200 04 0 00 000000* move t4, rosnpt ;[186] Load remote operating system name pointer 22142 001465'03 316 04 0 00 004467' camn t4, [-1] ;[186] Not our special bogon talisman? 22143 001466'03 254 00 0 00 001476' ifskp. ;[186] No, it's a valid text pointer 22144 001467'03 200 01 0 00 000000# txmsg < (> ;[186] Put it in parenthesis 22145 001470'03 104 00 0 00 000076 22146 001471'03 320 12 0 00 001472' 22147 000160'02 000000000000# 22148 000431'04 040 050 000 000 000 22149 001472'03 200 01 0 00 000004 move t1, t4 ;[186] Load pointer to the remote os name 22150 001473'03 104 00 0 00 000076 PSOUT% ;[186] Type it 22151 001474'03 201 01 0 00 000051 movei t1, ")" ;[186] Closing parenthesis 22152 001475'03 104 00 0 00 000074 PBOUT% ;[186] Tie off the operating system name 22153 001476'03 endif. ;[186] End case known remote operating system 22154 22155 txmsg < 22156 001476'03 200 01 0 00 000000# (Network Remote Terminal, KERMIT-20 is LOCAL)> ;[186] Not using any local TTY 22157 001477'03 104 00 0 00 000076 22158 001500'03 320 12 0 00 001501' 22159 000161'02 000000000000# 22160 000432'04 015 012 040 050 116 22161 001501'03 254 00 0 00 001575' jrst $show3 ;[186] Skip the modem control 22162 001502'03 endif. ;[186] End case DECnet NRT 22163 22164 001502'03 200 01 0 00 000000# txmsg 22165 001503'03 104 00 0 00 000076 22166 001504'03 320 12 0 00 001505' 22167 000162'02 000000000000# 22168 000444'04 124 124 131 040 146 22169 001505'03 201 01 0 00 000101 numout ttynum, 8 22170 001506'03 200 02 0 00 000000* 22171 001507'03 201 03 0 00 000010 22172 001510'03 104 00 0 00 000224 22173 001511'03 320 14 0 00 001512' 22174 001512'03 312 02 0 00 000000# came t2, ctynum ;[223] Is this the console? 22175 001513'03 254 00 0 00 001517' ifskp. ;[223] Yes, remark about that 22176 001514'03 200 01 0 00 000000# txmsg < [Console]> ;[223] A discrete indicator 22177 001515'03 104 00 0 00 000076 22178 001516'03 320 12 0 00 001517' 22179 000163'02 000000000000# 22180 000451'04 040 133 103 157 156 22181 001517'03 endif. ;[223] 22182 22183 001517'03 332 00 0 00 001110* ifme. ptyflg ;[186] Physical line? 22184 001520'03 254 00 0 00 001534' 22185 001521'03 200 04 0 00 000000* move t4, mytty ; See whether we're local or remote... 22186 001522'03 312 04 0 00 001506* came t4, ttynum ; If it's us 22187 001523'03 254 00 0 00 001530' ifskp. ; Then we are the remote 22188 txmsg < 22189 001524'03 200 01 0 00 000000# (job's controlling terminal, KERMIT-20 is REMOTE)> k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 19-2 K20DSP MAC 9-Nov-23 18:22 SHOW LINE display 22190 001525'03 104 00 0 00 000076 22191 001526'03 320 12 0 00 001527' 22192 000164'02 000000000000# 22193 000454'04 015 012 040 050 152 22194 001527'03 254 00 0 00 001533' else. ; Anything else means we're local 22195 txmsg < 22196 001530'03 200 01 0 00 000000# (assigned TTY line, KERMIT-20 is LOCAL)> 22197 001531'03 104 00 0 00 000076 22198 001532'03 320 12 0 00 001533' 22199 000165'02 000000000000# 22200 000467'04 015 012 040 050 141 22201 001533'03 endif. 22202 001533'03 254 00 0 00 001554' else. ;[186] Otherwise, it's a pseudo terminal 22203 001534'03 200 01 0 00 000000# txmsg (< [>) ;[186] Type opening broket 22204 001535'03 104 00 0 00 000076 22205 001536'03 320 12 0 00 001537' 22206 000166'02 000000000000# 22207 000500'04 040 133 000 000 000 22208 001537'03 561 01 0 00 000000* hrroi t1, ptynam ;[186] Load the name of the pseudo-terminal 22209 001540'03 104 00 0 00 000076 PSOUT% ;[186] Type the punctuated device 22210 001541'03 201 01 0 00 000135 movei t1, "]" ;[186] Load closing broket 22211 001542'03 104 00 0 00 000074 PBOUT% ;[186] and type that 22212 txmsg < 22213 001543'03 200 01 0 00 000000# (pseudo-terminal loopback to > ;[186] 22214 001544'03 104 00 0 00 000076 22215 001545'03 320 12 0 00 001546' 22216 000167'02 000000000000# 22217 000501'04 015 012 040 050 160 22218 001546'03 561 01 0 00 001425* hrroi t1, myname ;[186] Name of local node 22219 001547'03 104 00 0 00 000076 PSOUT% ;[186] Type that 22220 001550'03 200 01 0 00 000000# txmsg <::, KERMIT-20 is LOCAL)> ;[186] 22221 001551'03 104 00 0 00 000076 22222 001552'03 320 12 0 00 001553' 22223 000170'02 000000000000# 22224 000510'04 072 072 054 040 113 22225 001553'03 254 00 0 00 001575' jrst $show3 ;[186] PTY never has modem control 22226 001554'03 endif. ;[186] End case terminal check 22227 22228 001554'03 337 01 0 00 000000* skipg t1, netjfn ;[186] Tell about modem control & carrier. 22229 001555'03 200 01 0 00 000402* move t1, ttyjfn ;[186] Unless using local terminal 22230 001556'03 260 17 0 00 000000* call chklin 22231 001557'03 336 00 0 00 000000* ifmn. mdmlin ;[194] 22232 001560'03 254 00 0 00 001575' 22233 txmsg < 22234 Line has modem control 22235 001561'03 200 01 0 00 000000# Carrier: > 22236 001562'03 104 00 0 00 000076 22237 001563'03 320 12 0 00 001564' 22238 000171'02 000000000000# 22239 000515'04 015 012 040 040 114 22240 22241 001564'03 336 00 0 00 000000* ifmn. carier ; Is it? 22242 001565'03 254 00 0 00 001572' 22243 001566'03 200 01 0 00 000000# txmsg ; Say it's on. 22244 001567'03 104 00 0 00 000076 k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 19-3 K20DSP MAC 9-Nov-23 18:22 SHOW LINE display 22245 001570'03 320 12 0 00 001571' 22246 000172'02 000000000000# 22247 000526'04 117 156 000 000 000 22248 001571'03 254 00 0 00 001575' else. ; Otherwise... 22249 001572'03 200 01 0 00 000000# txmsg ; No. 22250 001573'03 104 00 0 00 000076 22251 001574'03 320 12 0 00 001575' 22252 000173'02 000000000000# 22253 000527'04 117 146 146 000 000 22254 001575'03 endif. 22255 001575'03 endif. ;[194] 22256 22257 $show3: txmsg < 22258 001575'03 200 01 0 00 000000# Handshake: > ;[76] Handshake 22259 001576'03 104 00 0 00 000076 22260 001577'03 320 12 0 00 001600' 22261 000174'02 000000000000# 22262 000530'04 015 012 040 040 110 22263 001600'03 332 01 0 00 000000* skipe t1, handsh ;[194] Any? 22264 001601'03 254 00 0 00 001606' ifskp. ;[194] Blew up the front end, anyway 22265 001602'03 200 01 0 00 000000# txmsg 22266 001603'03 104 00 0 00 000076 22267 001604'03 320 12 0 00 001605' 22268 000175'02 000000000000# 22269 000534'04 116 157 156 145 000 22270 001605'03 254 00 0 00 001607' else. ;[194] Otherwise, type it 22271 001606'03 260 17 0 00 003765' call putc 22272 001607'03 endif. ;[194] 22273 22274 txmsg < 22275 001607'03 200 01 0 00 000000# Flow-Control: > ;[143] 22276 001610'03 104 00 0 00 000076 22277 001611'03 320 12 0 00 001612' 22278 000176'02 000000000000# 22279 000535'04 015 012 040 040 106 22280 001612'03 336 00 0 00 000000* ifmn. flow 22281 001613'03 254 00 0 00 001620' 22282 001614'03 200 01 0 00 000000# txmsg 22283 001615'03 104 00 0 00 000076 22284 001616'03 320 12 0 00 001617' 22285 000177'02 000000000000# 22286 000542'04 130 117 116 055 130 22287 001617'03 254 00 0 00 001623' else. 22288 001620'03 200 01 0 00 000000# txmsg 22289 001621'03 104 00 0 00 000076 22290 001622'03 320 12 0 00 001623' 22291 000200'02 000000000000# 22292 000544'04 116 157 156 145 000 22293 001623'03 endif. 22294 22295 001623'03 336 00 0 00 000000* ifmn. local ;[194] Don't confuse them with this 22296 001624'03 254 00 0 00 001632' 22297 txmsg < 22298 001625'03 200 01 0 00 000000# Escape Character: > ;[217] Present the escape character 22299 001626'03 104 00 0 00 000076 k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 19-4 K20DSP MAC 9-Nov-23 18:22 SHOW LINE display 22300 001627'03 320 12 0 00 001630' 22301 000201'02 000000000000# 22302 000545'04 015 012 040 040 105 22303 001630'03 200 01 0 00 000000* move t1, escape 22304 001631'03 260 17 0 00 003765' call putc 22305 001632'03 endif. ;[194] 22306 22307 22308 $show4: txmsg < 22309 001632'03 200 01 0 00 000000# Parity: > 22310 001633'03 104 00 0 00 000076 22311 001634'03 320 12 0 00 001635' 22312 000202'02 000000000000# 22313 000552'04 015 012 040 040 120 22314 001635'03 200 02 0 00 000262* move t2, parity 22315 001636'03 415 01 0 00 000000# xmovei t1, enone ; None 22316 001637'03 306 02 0 00 000000* cain t2, space ; Space 22317 001640'03 415 01 0 00 000000# xmovei t1, espac 22318 001641'03 306 02 0 00 000000* cain t2, mark ; Mark 22319 001642'03 415 01 0 00 000000# xmovei t1, emark 22320 001643'03 306 02 0 00 000000* cain t2, odd ; Odd 22321 001644'03 415 01 0 00 000000# xmovei t1, eodd 22322 001645'03 306 02 0 00 000000* cain t2, even ; Even 22323 001646'03 415 01 0 00 000000# xmovei t1, eeven 22324 001647'03 661 01 0 00 610001 txo t1, .px7 ; Turn into a OWGP 22325 001650'03 104 00 0 00 000076 PSOUT% ; Finally type something 22326 22327 001651'03 306 02 0 00 000263* cain t2, none ;[223] Doing any parity at all? 22328 001652'03 254 00 0 00 001714' jrst $sho4a ;[223] No, skip domains 22329 001653'03 120 02 0 00 000270* dmove t2, parpko ;[223] Load parity domains 22330 001654'03 200 04 0 00 000002 move t4, t2 ;[223] See if doing either 22331 001655'03 434 04 0 00 000003 or t4, t3 ;[223] by seeing if either were set 22332 001656'03 322 04 0 00 001714' jumpe t4, $sho4a ;[223] If zero, no domain modification 22333 22334 001657'03 200 04 0 00 000002 move t4, t2 ;[223] See if doing both 22335 001660'03 404 04 0 00 000003 and t4, t3 ;[223] by seeing if both set 22336 001661'03 201 01 0 00 000040 movei t1, .chspc ;[223] Space over 22337 001662'03 104 00 0 00 000074 PBOUT% ;[223] 22338 001663'03 201 01 0 00 000133 movei t1, "[" ;[223] Open broket 22339 001664'03 104 00 0 00 000074 PBOUT% ;[223] 22340 001665'03 322 02 0 00 001671' ifn. t2 ;[223] Packets Only? 22341 001666'03 200 01 0 00 000000# txmsg () ;[223] 22342 001667'03 104 00 0 00 000076 22343 001670'03 320 12 0 00 001671' 22344 000203'02 000000000000# 22345 000556'04 120 141 143 153 145 22346 001671'03 endif. ;[223] 22347 001671'03 322 04 0 00 001674' ifn. t4 ;[223] Plural? 22348 001672'03 201 01 0 00 000054 movei t1, "," ;[223] Yes, wants a comma, then 22349 001673'03 104 00 0 00 000074 PBOUT% ;[223] 22350 001674'03 endif. ;[223] 22351 001674'03 322 03 0 00 001700' ifn. t3 ;[223] Not just generating parity? 22352 001675'03 200 01 0 00 000000# txmsg () ;[223] 22353 001676'03 104 00 0 00 000076 22354 001677'03 320 12 0 00 001700' k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 19-5 K20DSP MAC 9-Nov-23 18:22 SHOW LINE display 22355 000204'02 000000000000# 22356 000561'04 122 145 143 145 151 22357 001700'03 endif. ;[223] 22358 001700'03 201 01 0 00 000135 movei t1, "]" ;[223] Close broket 22359 001701'03 104 00 0 00 000074 PBOUT% ;[223] 22360 001702'03 336 04 0 00 000000* skipn t4, ttipar ;[223] Any parity errors?? 22361 001703'03 254 00 0 00 001714' ifskp. ;[223] Yes, type these 22362 txmsg < 22363 001704'03 200 01 0 00 000000# Parity Errors: > ;[223] 22364 001705'03 104 00 0 00 000076 22365 001706'03 320 12 0 00 001707' 22366 000205'02 000000000000# 22367 000565'04 015 012 040 040 120 22368 001707'03 201 01 0 00 000101 numout t4 ;[223] Type how many 22369 001710'03 200 02 0 00 000004 22370 001711'03 201 03 0 00 000012 22371 001712'03 104 00 0 00 000224 22372 001713'03 320 14 0 00 001714' 22373 001714'03 endif. ;[223] Done or nothing to do 22374 22375 $sho4a: txmsg < 22376 001714'03 200 01 0 00 000000# Duplex: > ;[18] 22377 001715'03 104 00 0 00 000076 22378 001716'03 320 12 0 00 001717' 22379 000206'02 000000000000# 22380 000572'04 015 012 040 040 104 22381 001717'03 200 02 0 00 000000* move t2, duplex 22382 001720'03 302 02 0 00 000000 caie t2, dxfull 22383 001721'03 254 00 0 00 001726' ifskp. 22384 001722'03 200 01 0 00 000000# txmsg 22385 001723'03 104 00 0 00 000076 22386 001724'03 320 12 0 00 001725' 22387 000207'02 000000000000# 22388 000576'04 106 165 154 154 000 22389 001725'03 254 00 0 00 001731' else. 22390 001726'03 200 01 0 00 000000# txmsg 22391 001727'03 104 00 0 00 000076 22392 001730'03 320 12 0 00 001731' 22393 000210'02 000000000000# 22394 000577'04 110 141 154 146 000 22395 001731'03 endif. 22396 22397 001731'03 337 02 0 00 001064* skipg t2,speed ; If negative, we don't really know it. 22398 001732'03 254 00 0 00 001742' ifskp. ;[194] We know it 22399 txmsg < 22400 001733'03 200 01 0 00 000000# Speed: > ; Line speed. 22401 001734'03 104 00 0 00 000076 22402 001735'03 320 12 0 00 001736' 22403 000211'02 000000000000# 22404 000600'04 015 012 040 040 123 22405 001736'03 201 01 0 00 000101 movei t1, .priou 22406 001737'03 201 03 0 00 000012 movei t3, ^d10 22407 001740'03 104 00 0 00 000224 NOUT% 22408 001741'03 320 14 0 00 001742' erjmps .+1 22409 001742'03 endif. ;[194] k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 19-6 K20DSP MAC 9-Nov-23 18:22 SHOW LINE display 22410 22411 txmsg < 22412 001742'03 200 01 0 00 000000# Break Simulation: > 22413 001743'03 104 00 0 00 000076 22414 001744'03 320 12 0 00 001745' 22415 000212'02 000000000000# 22416 000604'04 015 012 040 040 102 22417 001745'03 337 00 0 00 001731* ifmg. speed 22418 001746'03 254 00 0 00 001763' 22419 001747'03 200 01 0 00 000000# txmsg 22420 001750'03 104 00 0 00 000076 22421 001751'03 320 12 0 00 001752' 22422 000213'02 000000000000# 22423 000611'04 105 156 141 142 154 22424 001752'03 201 01 0 00 000101 numout brk 22425 001753'03 200 02 0 00 000000* 22426 001754'03 201 03 0 00 000012 22427 001755'03 104 00 0 00 000224 22428 001756'03 320 14 0 00 001757' 22429 001757'03 200 01 0 00 000000# txmsg < NULs at 50 baud> 22430 001760'03 104 00 0 00 000076 22431 001761'03 320 12 0 00 001762' 22432 000214'02 000000000000# 22433 000613'04 040 116 125 114 163 22434 001762'03 254 00 0 00 001766' else. 22435 001763'03 200 01 0 00 000000# txmsg 22436 001764'03 104 00 0 00 000076 22437 001765'03 320 12 0 00 001766' 22438 000215'02 000000000000# 22439 000617'04 104 151 163 141 142 22440 001766'03 endif. 22441 22442 001766'03 336 00 0 00 000000* skipn vtermf ;[186] Virtual terminal? 22443 001767'03 254 00 0 00 002022' jrst $sho4e ;[186] No, then this makes no sense 22444 22445 001770'03 332 00 0 00 001517* ifme. ptyflg ;[186] Unless loopback 22446 001771'03 254 00 0 00 001776' 22447 txmsg < 22448 001772'03 200 01 0 00 000000# NRT Connection: > ;[186] Status of connection 22449 001773'03 104 00 0 00 000076 22450 001774'03 320 12 0 00 001775' 22451 000216'02 000000000000# 22452 000621'04 015 012 040 040 116 22453 001775'03 254 00 0 00 002001' else. 22454 txmsg < 22455 001776'03 200 01 0 00 000000# PTY Connection: > ;[186] Status of connection 22456 001777'03 104 00 0 00 000076 22457 002000'03 320 12 0 00 002001' 22458 000217'02 000000000000# 22459 000626'04 015 012 040 040 120 22460 002001'03 endif. ;[186] 22461 22462 002001'03 337 01 0 00 001554* skipg t1,netjfn ;[186] Load line to check 22463 002002'03 200 01 0 00 001555* move t1, ttyjfn ;[186] Unless using local terminal 22464 002003'03 260 17 0 00 001556* call chklin ;[186] Check 'line' status k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 19-7 K20DSP MAC 9-Nov-23 18:22 SHOW LINE display 22465 002004'03 336 00 0 00 001564* ifmn. carier ;[186] However, is it? 22466 002005'03 254 00 0 00 002012' 22467 002006'03 200 01 0 00 000000# txmsg ;[186] Assume good news 22468 002007'03 104 00 0 00 000076 22469 002010'03 320 12 0 00 002011' 22470 000220'02 000000000000# 22471 000633'04 117 156 154 151 156 22472 002011'03 254 00 0 00 002015' else. 22473 002012'03 200 01 0 00 000000# txmsg ;[186] It isn't, sigh... 22474 002013'03 104 00 0 00 000076 22475 002014'03 320 12 0 00 002015' 22476 000221'02 000000000000# 22477 000635'04 104 162 157 160 160 22478 002015'03 endif. ;[186] Either way, tell us 22479 22480 002015'03 260 17 0 00 001052' call prntbd ;[210] Print some kind of baud rate maybe 22481 22482 002016'03 200 01 0 00 000000* move t1, vbict ;[186] Ever connected? 22483 002017'03 270 01 0 00 000000* add t1, nbict ;[186] any network output 22484 002020'03 322 01 0 00 002022' ifn. t1 ;[186] Yes to either one means display something 22485 002021'03 260 17 0 00 003543' call disper ;[186] Display information concerning performance 22486 002022'03 endif. 22487 22488 remark $sho4e ;[186] Falls through 22489 22490 002022'03 337 04 0 00 000412* $sho4e: skipg t4, sesjfn ;[195] Are we logging? 22491 002023'03 254 00 0 00 002115' ifskp. ;[195] Well, are we? 22492 002024'03 336 00 0 00 000414* ifmn. sesflg ;[195] BUT!! Are we actively logging right now? 22493 002025'03 254 00 0 00 002032' 22494 txmsg < 22495 002026'03 200 01 0 00 000000# Log: (Enabled) > ;[220] 22496 002027'03 104 00 0 00 000076 22497 002030'03 320 12 0 00 002031' 22498 000222'02 000000000000# 22499 000637'04 015 012 040 040 114 22500 002031'03 254 00 0 00 002035' else. ;[220] Otherwise, not ACTIVELY logging 22501 txmsg < 22502 002032'03 200 01 0 00 000000# Log: (Disabled) > ;[220] 22503 002033'03 104 00 0 00 000076 22504 002034'03 320 12 0 00 002035' 22505 000223'02 000000000000# 22506 000644'04 015 012 040 040 114 22507 002035'03 endif. ;[220] 22508 002035'03 200 02 0 00 000004 move t2, t4 ;[220] Reload the logging JFN 22509 002036'03 201 01 0 00 000101 movei t1, .priou ;[220] Typing on the terminal? 22510 002037'03 302 02 0 00 377777 caie t2, .nulio ;[193] Efficiently dumping it? 22511 002040'03 254 00 0 00 002051' ifskp. ;[193] Yes, that's a constant string 22512 002041'03 120 02 0 00 000000# dmove t2, nul5 ;[193] Point to said string 22513 002042'03 104 00 0 00 000053 SOUT% ;[193] Counted SOUT% is faster 22514 002043'03 320 12 0 00 002045' %jserr (,) ;[193] ?? 22515 002044'03 254 00 0 00 002050' 22516 002045'03 265 01 0 00 000442* 22517 002046'03 000000000000# 22518 002047'03 254 00 0 00 002050' 22519 000651'04 125 156 141 142 154 k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 19-8 K20DSP MAC 9-Nov-23 18:22 SHOW LINE display 22520 002050'03 254 00 0 00 002115' else. ;[193] Otherwise, a 'real' JFN 22521 002051'03 201 02 0 00 000040 movx t2, .chspc ;[193] Space over 22522 002052'03 104 00 0 00 000051 BOUT% ;[193] So columns line up 22523 002053'03 320 12 0 00 002055' %jserr (,) ;[194] ??? 22524 002054'03 254 00 0 00 002060' 22525 002055'03 265 01 0 00 002045* 22526 002056'03 000000000000# 22527 002057'03 254 00 0 00 002060' 22528 000657'04 125 156 141 142 154 22529 002060'03 200 02 0 00 000004 move t2, t4 ;[193] Restore the logging JFN 22530 002061'03 403 03 0 00 000004 setzb t3, t4 ;[193] Use default formatting, no prefix 22531 002062'03 104 00 0 00 000030 JFNS ; Say what it is. 22532 002063'03 320 12 0 00 002065' %jserr (,) ;[194] 22533 002064'03 254 00 0 00 002070' 22534 002065'03 265 01 0 00 002055* 22535 002066'03 000000000000# 22536 002067'03 254 00 0 00 002070' 22537 000666'04 125 156 141 142 154 22538 002070'03 200 01 0 00 000002 move t1, t2 ;[240] Load the file JFN 22539 002071'03 104 00 0 00 000043 RFPTR% ;[240] Get the current position in the file 22540 002072'03 320 12 0 00 002074' ifje. r ;[240] Couldn't ... 22541 002073'03 254 00 0 00 002076' 22542 002074'03 200 04 0 00 000001 move t4, t1 ;[240] Save the error for debugging heros 22543 002075'03 474 02 0 00 000000 seto t2, ;[240] Flag an error for downstream 22544 002076'03 endif. ;[240] End case JSYS error handling 22545 002076'03 323 02 0 00 002115' ifg. t2 ;[240] Only display if we've written something 22546 002077'03 200 01 0 00 000000# txmsg <, > ;[240] Punctuate and space over 22547 002100'03 104 00 0 00 000076 22548 002101'03 320 12 0 00 002102' 22549 000224'02 000000000000# 22550 000675'04 054 040 000 000 000 22551 002102'03 201 01 0 00 000101 movei t1, .priou ;[240] Still going to terminal 22552 002103'03 201 03 0 00 000012 movx t3, fld(^d10,no%rdx) ;[240] Byte count is decimal 22553 002104'03 104 00 0 00 000224 NOUT% ;[240] Type it 22554 002105'03 320 12 0 00 002107' %jserr (,) ;[240] 22555 002106'03 254 00 0 00 002112' 22556 002107'03 265 01 0 00 002065* 22557 002110'03 000000000000# 22558 002111'03 254 00 0 00 002112' 22559 000676'04 125 156 141 142 154 22560 002112'03 200 01 0 00 000000# txmsg < Bytes Written> ;[240] 22561 002113'03 104 00 0 00 000076 22562 002114'03 320 12 0 00 002115' 22563 000225'02 000000000000# 22564 000707'04 040 102 171 164 145 22565 002115'03 endif. ;[240] End case displaying file offset 22566 002115'03 endif. ;[193] End .nulio special casing 22567 002115'03 endif. ;[194] End case session logging JFN open 22568 22569 002115'03 332 00 0 00 001411* $sho4f: ifme. nrtflg ;[223] Not if NRT; line number is meaningless 22570 002116'03 254 00 0 00 002124' 22571 002117'03 200 01 0 00 001522* move t1, ttynum ;[223] Load line number (FE or TTY# of PTY, if PTY) 22572 002120'03 260 17 0 00 000000* call getnti ;[223] Get network information on this line 22573 002121'03 254 00 0 00 002124' anskp. ;[223] Failed, so better skip the line characteristics 22574 remark t1, ;[223] Network Type from NTINF% k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 19-9 K20DSP MAC 9-Nov-23 18:22 SHOW LINE display 22575 remark t2, ;[223] Line Type from NTINF% 22576 002122'03 200 03 0 00 002117* move t3, ttynum ;[223] Load line number 22577 002123'03 260 17 0 00 004012' call linchr ;[186] Show some things 22578 002124'03 endif. ;[223] 22579 22580 002124'03 $sho4h: remark ;put next one here... 22581 22582 002124'03 561 01 0 00 001406* $sho4x: hrroi t1, crlflf ;[194] Double line feed 22583 002125'03 104 00 0 00 000076 PSOUT% ;[194] Tie off the blat 22584 002126'03 256 00 0 00 000005 xct q1 ;[39] return or proceed... 22585 remark ;[194] May fall through .. 22586 k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 20 K20DSP MAC 9-Nov-23 18:22 SHOW FILE-INFO external variables 22587 subttl SHOW FILE-INFO external variables 22588 22589 extern abtfil ; Set if keeping a file, zero to discard 22590 extern autbyt ; Set if doing auto-bytesize detection 22591 extern ebtflg ; Set if forcing 8-bit mode 22592 extern tbtflg ;[223] ; Set if forcing 36-bit mode 22593 extern expung ; Set if deletes are expunging 22594 extern itsflg ; Flag for handling ITS-binary format files 22595 extern tlgjfn ; Transaction log JFN 22596 extern xfnflg ; Flag for filename conversion 22597 k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 21 K20DSP MAC 9-Nov-23 18:22 SHOW FILE-INFO display logic 22598 subttl SHOW FILE-INFO display logic 22599 22600 002127'03 $shfil: entry $shfil 22601 22602 002127'03 200 01 0 00 000000# txmsg 22603 002130'03 104 00 0 00 000076 22604 002131'03 320 12 0 00 002132' 22605 000226'02 000000000000# 22606 000712'04 102 171 164 145 040 22607 002132'03 332 00 0 00 000000* ifme. autbyt ;[194] Not auto-byte 22608 002133'03 254 00 0 00 002154' 22609 002134'03 332 00 0 00 000000* ifme. tbtflg ;[232] Not 36 bit 22610 002135'03 254 00 0 00 002150' 22611 002136'03 332 00 0 00 000000* ifme. ebtflg 22612 002137'03 254 00 0 00 002144' 22613 002140'03 200 01 0 00 000000# txmsg 22614 002141'03 104 00 0 00 000076 22615 002142'03 320 12 0 00 002143' 22616 000227'02 000000000000# 22617 000717'04 123 145 166 145 156 22618 002143'03 254 00 0 00 002147' else. 22619 002144'03 200 01 0 00 000000# txmsg 22620 002145'03 104 00 0 00 000076 22621 002146'03 320 12 0 00 002147' 22622 000230'02 000000000000# 22623 000721'04 105 151 147 150 164 22624 002147'03 endif. 22625 002147'03 254 00 0 00 002153' else. ;[232] Really post-processed 7 bit mode 22626 002150'03 200 01 0 00 000000# txmsg 22627 002151'03 104 00 0 00 000076 22628 002152'03 320 12 0 00 002153' 22629 000231'02 000000000000# 22630 000723'04 124 150 151 162 164 22631 002153'03 endif. ;[232] 22632 002153'03 254 00 0 00 002157' else. 22633 002154'03 200 01 0 00 000000# txmsg 22634 002155'03 104 00 0 00 000076 22635 002156'03 320 12 0 00 002157' 22636 000232'02 000000000000# 22637 000730'04 101 165 164 157 000 22638 002157'03 endif. ;[194] 22639 txmsg < 22640 002157'03 200 01 0 00 000000# File name conversion: > ;[84] 22641 002160'03 104 00 0 00 000076 22642 002161'03 320 12 0 00 002162' 22643 000233'02 000000000000# 22644 000731'04 015 012 040 040 106 22645 002162'03 332 00 0 00 000000* ifme. xfnflg ;[84] 22646 002163'03 254 00 0 00 002170' 22647 002164'03 200 01 0 00 000000# txmsg ;[84] 22648 002165'03 104 00 0 00 000076 22649 002166'03 320 12 0 00 002167' 22650 000234'02 000000000000# 22651 000737'04 117 146 146 000 000 22652 002167'03 254 00 0 00 002173' else. ;[84] k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 21-1 K20DSP MAC 9-Nov-23 18:22 SHOW FILE-INFO display logic 22653 002170'03 200 01 0 00 000000# txmsg ;[84] 22654 002171'03 104 00 0 00 000076 22655 002172'03 320 12 0 00 002173' 22656 000235'02 000000000000# 22657 000740'04 117 156 000 000 000 22658 002173'03 endif. ;[84] 22659 txmsg < 22660 002173'03 200 01 0 00 000000# ITS-binary-format file recognition: > ;[75] 22661 002174'03 104 00 0 00 000076 22662 002175'03 320 12 0 00 002176' 22663 000236'02 000000000000# 22664 000741'04 015 012 040 040 111 22665 002176'03 336 00 0 00 000000* ifmn. itsflg ;[75] 22666 002177'03 254 00 0 00 002204' 22667 002200'03 200 01 0 00 000000# txmsg ;[75] 22668 002201'03 104 00 0 00 000076 22669 002202'03 320 12 0 00 002203' 22670 000237'02 000000000000# 22671 000752'04 145 156 141 142 154 22672 002203'03 254 00 0 00 002207' else. ;[75] 22673 002204'03 200 01 0 00 000000# txmsg ;[75] 22674 002205'03 104 00 0 00 000076 22675 002206'03 320 12 0 00 002207' 22676 000240'02 000000000000# 22677 000754'04 144 151 163 141 142 22678 002207'03 endif. ;[75] 22679 txmsg < 22680 002207'03 200 01 0 00 000000# Disposition for incomplete incoming files: > ;[42] 22681 002210'03 104 00 0 00 000076 22682 002211'03 320 12 0 00 002212' 22683 000241'02 000000000000# 22684 000756'04 015 012 040 040 104 22685 002212'03 332 00 0 00 000000* ifme. abtfil ;[42] 22686 002213'03 254 00 0 00 002220' 22687 002214'03 200 01 0 00 000000# txmsg ;[42] 22688 002215'03 104 00 0 00 000076 22689 002216'03 320 12 0 00 002217' 22690 000242'02 000000000000# 22691 000770'04 104 151 163 143 141 22692 002217'03 254 00 0 00 002223' else. ;[42] 22693 002220'03 200 01 0 00 000000# txmsg ;[42] 22694 002221'03 104 00 0 00 000076 22695 002222'03 320 12 0 00 002223' 22696 000243'02 000000000000# 22697 000772'04 113 145 145 160 040 22698 002223'03 endif. ;[42] 22699 txmsg < 22700 002223'03 200 01 0 00 000000# Deleted files are > ;[143] 22701 002224'03 104 00 0 00 000076 22702 002225'03 320 12 0 00 002226' 22703 000244'02 000000000000# 22704 001000'04 015 012 040 040 104 22705 002226'03 332 00 0 00 000000* ifme. expung ;[194] 22706 002227'03 254 00 0 00 002233' 22707 002230'03 200 01 0 00 000000# txmsg ;[194] k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 21-2 K20DSP MAC 9-Nov-23 18:22 SHOW FILE-INFO display logic 22708 002231'03 104 00 0 00 000076 22709 002232'03 320 12 0 00 002233' 22710 000245'02 000000000000# 22711 001005'04 116 117 124 040 000 22712 002233'03 endif. ;[194] 22713 txmsg ;[126] 22715 002234'03 104 00 0 00 000076 22716 002235'03 320 12 0 00 002236' 22717 000246'02 000000000000# 22718 001006'04 145 170 160 165 156 22719 22720 22721 002236'03 337 02 0 00 000000* skipg t2, tlgjfn ; Any transaction log? 22722 002237'03 254 00 0 00 002311' ifskp. ;[194] Yes 22723 002240'03 201 01 0 00 000101 movei t1, .priou ; Yes, a real file, 22724 002241'03 400 04 0 00 000000 setz t4, ;[193] Let's assume no prefix or stop character 22725 002242'03 302 02 0 00 377777 caie t2, .nulio ;[193] Efficiently dumping it? 22726 002243'03 254 00 0 00 002254' ifskp. ;[193] Yes, that's a constant string 22727 002244'03 120 02 0 00 000000# dmove t2, nul5 ;[193] Point to said string 22728 002245'03 104 00 0 00 000053 SOUT% ;[193] Counted SOUT% is faster 22729 002246'03 320 12 0 00 002250' %jserr (,) ;[193] ?? 22730 002247'03 254 00 0 00 002253' 22731 002250'03 265 01 0 00 002107* 22732 002251'03 000000000000# 22733 002252'03 254 00 0 00 002253' 22734 001020'04 125 156 141 142 154 22735 002253'03 254 00 0 00 002310' else. ;[193] Otherwise, a 'real' JFN 22736 002254'03 400 03 0 00 000000 setz t3, ;[194] Use default formatting 22737 002255'03 104 00 0 00 000030 JFNS ; Say what it is. 22738 002256'03 320 12 0 00 002260' %jserr (,) ;[194] 22739 002257'03 254 00 0 00 002263' 22740 002260'03 265 01 0 00 002250* 22741 002261'03 000000000000# 22742 002262'03 254 00 0 00 002263' 22743 001026'04 125 156 141 142 154 22744 002263'03 200 01 0 00 000002 move t1, t2 ;[240] Load the file JFN 22745 002264'03 104 00 0 00 000043 RFPTR% ;[240] Get the current position in the file 22746 002265'03 320 12 0 00 002267' ifje. r ;[240] Couldn't ... 22747 002266'03 254 00 0 00 002271' 22748 002267'03 200 04 0 00 000001 move t4, t1 ;[240] Save the error for debugging heros 22749 002270'03 474 02 0 00 000000 seto t2, ;[240] Flag an error for downstream 22750 002271'03 endif. ;[240] End case JSYS error handling 22751 002271'03 323 02 0 00 002310' ifg. t2 ;[240] Only display if we've written something 22752 002272'03 200 01 0 00 000000# txmsg <, > ;[240] Punctuate and space over 22753 002273'03 104 00 0 00 000076 22754 002274'03 320 12 0 00 002275' 22755 000247'02 000000000000# 22756 001036'04 054 040 000 000 000 22757 002275'03 201 01 0 00 000101 movei t1, .priou ;[240] Still going to terminal 22758 002276'03 201 03 0 00 000012 movx t3, fld(^d10,no%rdx) ;[240] Byte count is decimal 22759 002277'03 104 00 0 00 000224 NOUT% ;[240] Type it 22760 002300'03 320 12 0 00 002302' %jserr (,) ;[240] 22761 002301'03 254 00 0 00 002305' 22762 002302'03 265 01 0 00 002260* k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 21-3 K20DSP MAC 9-Nov-23 18:22 SHOW FILE-INFO display logic 22763 002303'03 000000000000# 22764 002304'03 254 00 0 00 002305' 22765 001037'04 125 156 141 142 154 22766 002305'03 200 01 0 00 000000# txmsg < Bytes Written> ;[240] 22767 002306'03 104 00 0 00 000076 22768 002307'03 320 12 0 00 002310' 22769 000250'02 000000000000# 22770 001050'04 040 102 171 164 145 22771 002310'03 endif. ;[240] End case displaying file offset 22772 002310'03 endif. ;[193] End .nulio special casing 22773 002310'03 254 00 0 00 002314' else. ;[194] Otherwise, don't have one 22774 002311'03 200 01 0 00 000000# txmsg <(none)> 22775 002312'03 104 00 0 00 000076 22776 002313'03 320 12 0 00 002314' 22777 000251'02 000000000000# 22778 001053'04 050 156 157 156 145 22779 002314'03 endif. ;[194] 22780 22781 002314'03 561 01 0 00 002124* hrroi t1, crlflf ;[194] 22782 002315'03 104 00 0 00 000076 PSOUT% ;[194] 22783 002316'03 256 00 0 00 000005 xct q1 ;[39] return or proceed... 22784 remark ;[194] May fall through .. 22785 k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 22 K20DSP MAC 9-Nov-23 18:22 SHOW DEBUG 22786 subttl SHOW DEBUG 22787 22788 extern logbsz ;[41] Log file byte size. 22789 extern logjfn ; Log file JFN 22790 extern pdcodf ;[221] If Packet Debug is also doing decoding 22791 extern mhptod ;[239] If monitor supports high precision 22792 22793 002317'03 $shdeb: entry $shdeb 22794 002317'03 200 01 0 00 000000# txmsg 22795 002320'03 104 00 0 00 000076 22796 002321'03 320 12 0 00 002322' 22797 000252'02 000000000000# 22798 001055'04 104 145 142 165 147 22799 002322'03 200 01 0 14 000000# move t1, debtab(debug) 22800 002323'03 104 00 0 00 000076 PSOUT% 22801 22802 002324'03 302 14 0 00 000002 caie debug, 2 ;[221] Are we debugging packets (I.E., dumping them?)? 22803 002325'03 254 00 0 00 002353' ifskp. ;[221] Indeed we are 22804 002326'03 336 00 0 00 000000* ifmn. pdcodf ;[239] Yes; are we decoding them? 22805 002327'03 254 00 0 00 002342' 22806 002330'03 336 00 0 00 000000* ifmn. mhptod ;[239] Some extra-soothing blat 22807 002331'03 254 00 0 00 002336' 22808 002332'03 200 01 0 00 000000# txmsg < [Decoding, 10 microsecond resolution]> ;[239] 22809 002333'03 104 00 0 00 000076 22810 002334'03 320 12 0 00 002335' 22811 000253'02 000000000000# 22812 001060'04 040 133 104 145 143 22813 002335'03 254 00 0 00 002341' else. ;[239] Otherwise, monitor doesn't have HPTIM% .HPTOD 22814 002336'03 200 01 0 00 000000# txmsg < [Decoding, 1 millisecond resolution]> ;[239] 22815 002337'03 104 00 0 00 000076 22816 002340'03 320 12 0 00 002341' 22817 000254'02 000000000000# 22818 001070'04 040 133 104 145 143 22819 002341'03 endif. ;[239] End case reporting decoding granularity 22820 002341'03 254 00 0 00 002353' else. ;[239] Not decoding, so don't remark about that 22821 002342'03 336 00 0 00 002330* ifmn. mhptod ;[239] Some extra-soothing blat 22822 002343'03 254 00 0 00 002350' 22823 002344'03 200 01 0 00 000000# txmsg < [10 microsecond resolution]> ;[239] 22824 002345'03 104 00 0 00 000076 22825 002346'03 320 12 0 00 002347' 22826 000255'02 000000000000# 22827 001100'04 040 133 061 060 040 22828 002347'03 254 00 0 00 002353' else. ;[239] Otherwise, monitor doesn't have HPTIM% .HPTOD 22829 002350'03 200 01 0 00 000000# txmsg < [1 millisecond resolution]> ;[239] 22830 002351'03 104 00 0 00 000076 22831 002352'03 320 12 0 00 002353' 22832 000256'02 000000000000# 22833 001106'04 040 133 061 040 155 22834 002353'03 endif. ;[239] End case reporting non-decoding granularity 22835 002353'03 endif. ;[239] End case granularity reporting 22836 002353'03 endif. ;[221] End special case debugging packets 22837 22838 002353'03 322 14 0 00 002445' ifn. debug ;[194] Only if actually debugging something 22839 txmsg < 22840 002354'03 200 01 0 00 000000# Debugging log file: > ;[38] k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 22-1 K20DSP MAC 9-Nov-23 18:22 SHOW DEBUG 22841 002355'03 104 00 0 00 000076 22842 002356'03 320 12 0 00 002357' 22843 000257'02 000000000000# 22844 001114'04 015 012 040 040 104 22845 002357'03 337 02 0 00 000000* skipg t2, logjfn ;[198] Load debugging log file JFN (if there is one) 22846 002360'03 254 00 0 00 002442' ifskp. ;[194] There is, let's type something 22847 002361'03 201 01 0 00 000101 movei t1, .priou ; Yes, a real file, 22848 002362'03 400 04 0 00 000000 setz t4, ;[193] Let's assume no prefix or stop character 22849 002363'03 302 02 0 00 377777 caie t2, .nulio ;[193] Efficiently dumping it? 22850 002364'03 254 00 0 00 002375' ifskp. ;[193] Yes, that's a constant string 22851 002365'03 120 02 0 00 000000# dmove t2, nul5 ;[193] Point to said string 22852 002366'03 104 00 0 00 000053 SOUT% ;[193] Counted SOUT% is faster 22853 002367'03 320 12 0 00 002371' %jserr (,) ;[193] ?? 22854 002370'03 254 00 0 00 002374' 22855 002371'03 265 01 0 00 002302* 22856 002372'03 000000000000# 22857 002373'03 254 00 0 00 002374' 22858 001121'04 125 156 141 142 154 22859 002374'03 254 00 0 00 002431' else. ;[193] Otherwise, a 'real' JFN 22860 002375'03 400 03 0 00 000000 setz t3, ;[194] Use default formatting 22861 002376'03 104 00 0 00 000030 JFNS ; Say what it is. 22862 002377'03 320 12 0 00 002401' %jserr (,) ;[194] 22863 002400'03 254 00 0 00 002404' 22864 002401'03 265 01 0 00 002371* 22865 002402'03 000000000000# 22866 002403'03 254 00 0 00 002404' 22867 001127'04 125 156 141 142 154 22868 002404'03 200 01 0 00 000002 move t1, t2 ;[240] Load the file JFN 22869 002405'03 104 00 0 00 000043 RFPTR% ;[240] Get the current position in the file 22870 002406'03 320 12 0 00 002410' ifje. r ;[240] Couldn't ... 22871 002407'03 254 00 0 00 002412' 22872 002410'03 200 04 0 00 000001 move t4, t1 ;[240] Save the error for debugging heros 22873 002411'03 474 02 0 00 000000 seto t2, ;[240] Flag an error for downstream 22874 002412'03 endif. ;[240] End case JSYS error handling 22875 002412'03 323 02 0 00 002431' ifg. t2 ;[240] Only display if we've written something 22876 002413'03 200 01 0 00 000000# txmsg <, > ;[240] 22877 002414'03 104 00 0 00 000076 22878 002415'03 320 12 0 00 002416' 22879 000260'02 000000000000# 22880 001136'04 054 040 000 000 000 22881 002416'03 201 01 0 00 000101 movei t1, .priou ;[240] Still going to terminal 22882 002417'03 201 03 0 00 000012 movx t3, fld(^d10,no%rdx) ;[240] Byte count is decimal 22883 002420'03 104 00 0 00 000224 NOUT% ;[240] Type it 22884 002421'03 320 12 0 00 002423' %jserr (,) ;[240] 22885 002422'03 254 00 0 00 002426' 22886 002423'03 265 01 0 00 002401* 22887 002424'03 000000000000# 22888 002425'03 254 00 0 00 002426' 22889 001137'04 125 156 141 142 154 22890 002426'03 200 01 0 00 000000# txmsg < Bytes Written> ;[240] 22891 002427'03 104 00 0 00 000076 22892 002430'03 320 12 0 00 002431' 22893 000261'02 000000000000# 22894 001150'04 040 102 171 164 145 22895 002431'03 endif. ;[240] End case displaying file offset k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 22-2 K20DSP MAC 9-Nov-23 18:22 SHOW DEBUG 22896 002431'03 endif. ;[198] End .nulio special casing 22897 002431'03 200 01 0 00 000000# txmsg <, Byte Size >;[240] 22898 002432'03 104 00 0 00 000076 22899 002433'03 320 12 0 00 002434' 22900 000262'02 000000000000# 22901 001153'04 054 040 102 171 164 22902 002434'03 201 01 0 00 000101 numout logbsz ;[41] 22903 002435'03 200 02 0 00 000000* 22904 002436'03 201 03 0 00 000012 22905 002437'03 104 00 0 00 000224 22906 002440'03 320 14 0 00 002441' 22907 002441'03 254 00 0 00 002445' else. ;[194] Otherwise, don't have a debugging log file 22908 002442'03 200 01 0 00 000000# txmsg < (none)> ;[38] None. 22909 002443'03 104 00 0 00 000076 22910 002444'03 320 12 0 00 002445' 22911 000263'02 000000000000# 22912 001156'04 040 050 156 157 156 22913 002445'03 endif. ;[194] End log file printing decision 22914 002445'03 endif. ;[194] End case debugging 22915 22916 002445'03 561 01 0 00 002314* hrroi t1, crlflf ;[194] 22917 002446'03 104 00 0 00 000076 PSOUT% ;[194] 22918 002447'03 256 00 0 00 000005 xct q1 ;[39] return or proceed... 22919 remark ;[194] May fall through .. 22920 k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 23 K20DSP MAC 9-Nov-23 18:22 SHOW PACKET-INFO external variables (all [194]) 22921 subttl SHOW PACKET-INFO external variables (all [194]) 22922 22923 extern bctr ; Block check type requested (character). 22924 extern bctu ; Block check type in use (number). 22925 extern ebq ; 8th-bit-on prefix. 22926 extern ebqflg ; 8th-bit prefixing flag. 22927 extern ebqr ; 8th-bit prefix field for Send-Init. 22928 extern reolch ; EOL character Tops-20 needs. 22929 extern rpadch ; Padding character Tops-20 wants. 22930 extern rpadn ; Number of padding characters for Tops-20. 22931 extern rptflg ; Repeat count processing flag. 22932 extern rptq ; Repeat count prefix. 22933 extern rquote ; Quote character Tops-20 wants. 22934 extern rsthdr ; Start of header character to receive. 22935 extern seolch ; EOL character micro needs. 22936 extern spadch ; Padding character micro wants. 22937 extern spadn ; Number of padding characters for micro. 22938 extern squote ; Quote character micro wants. 22939 extern ssthdr ; Start of header character to send. 22940 k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 24 K20DSP MAC 9-Nov-23 18:22 SHOW PACKET-INFO display code 22941 subttl SHOW PACKET-INFO display code 22942 22943 ;[100] New headings, less confusing. 22944 22945 002450'03 $shpkt: entry $shpkt 22946 txmsg 22950 002451'03 104 00 0 00 000076 22951 002452'03 320 12 0 00 002453' 22952 000264'02 000000000000# 22953 001160'04 120 141 143 153 145 22954 22955 22956 22957 002453'03 201 01 0 00 000101 numout rpsiz 22958 002454'03 200 02 0 00 000452* 22959 002455'03 201 03 0 00 000012 22960 002456'03 104 00 0 00 000224 22961 002457'03 320 14 0 00 002460' 22962 002460'03 200 01 0 00 000000# txmsg < > 22963 002461'03 104 00 0 00 000076 22964 002462'03 320 12 0 00 002463' 22965 000265'02 000000000000# 22966 001176'04 011 011 000 000 000 22967 002463'03 201 01 0 00 000101 numout spsiz 22968 002464'03 200 02 0 00 000460* 22969 002465'03 201 03 0 00 000012 22970 002466'03 104 00 0 00 000224 22971 002467'03 320 14 0 00 002470' 22972 22973 002470'03 200 01 0 00 000000* move t1, rpadn ;[194] Load receive padding count 22974 002471'03 270 01 0 00 000000* add t1, spadn ;[194] Add sending padding count 22975 002472'03 323 01 0 00 002525' ifg. t1 ;[194] Only print characters if actually padding 22976 txmsg < characters 22977 002473'03 200 01 0 00 000000# Padding: > 22978 002474'03 104 00 0 00 000076 22979 002475'03 320 12 0 00 002476' 22980 000266'02 000000000000# 22981 001177'04 040 143 150 141 162 22982 22983 002476'03 201 01 0 00 000101 numout rpadn 22984 002477'03 200 02 0 00 002470* 22985 002500'03 201 03 0 00 000012 22986 002501'03 104 00 0 00 000224 22987 002502'03 320 14 0 00 002503' 22988 002503'03 200 01 0 00 000000# txmsg < > 22989 002504'03 104 00 0 00 000076 22990 002505'03 320 12 0 00 002506' 22991 000267'02 000000000000# 22992 001205'04 011 011 000 000 000 22993 002506'03 201 01 0 00 000101 numout spadn 22994 002507'03 200 02 0 00 002471* 22995 002510'03 201 03 0 00 000012 k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 24-1 K20DSP MAC 9-Nov-23 18:22 SHOW PACKET-INFO display code 22996 002511'03 104 00 0 00 000224 22997 002512'03 320 14 0 00 002513' 22998 txmsg < 22999 002513'03 200 01 0 00 000000# Pad Character: > 23000 002514'03 104 00 0 00 000076 23001 002515'03 320 12 0 00 002516' 23002 000270'02 000000000000# 23003 001206'04 015 012 040 040 120 23004 002516'03 200 01 0 00 000000* move t1, rpadch 23005 002517'03 260 17 0 00 003765' call putc 23006 002520'03 200 01 0 00 000000# txmsg < > 23007 002521'03 104 00 0 00 000076 23008 002522'03 320 12 0 00 002523' 23009 000271'02 000000000000# 23010 001213'04 011 011 000 000 000 23011 002523'03 200 01 0 00 000000* move t1, spadch 23012 002524'03 260 17 0 00 003765' call putc 23013 002525'03 endif. ;[194] 23014 23015 txmsg < 23016 002525'03 200 01 0 00 000000# End-Of-Line: > 23017 002526'03 104 00 0 00 000076 23018 002527'03 320 12 0 00 002530' 23019 000272'02 000000000000# 23020 001214'04 015 012 040 040 105 23021 002530'03 200 01 0 00 000000* move t1, reolch 23022 002531'03 260 17 0 00 003765' call putc 23023 002532'03 200 01 0 00 000000# txmsg < > 23024 002533'03 104 00 0 00 000076 23025 002534'03 320 12 0 00 002535' 23026 000273'02 000000000000# 23027 001221'04 011 011 000 000 000 23028 002535'03 200 01 0 00 000000* move t1, seolch 23029 002536'03 260 17 0 00 003765' call putc 23030 txmsg < 23031 002537'03 200 01 0 00 000000# Control Prefix: > 23032 002540'03 104 00 0 00 000076 23033 002541'03 320 12 0 00 002542' 23034 000274'02 000000000000# 23035 001222'04 015 012 040 040 103 23036 002542'03 200 01 0 00 000000* move t1, rquote 23037 002543'03 260 17 0 00 003765' call putc 23038 002544'03 200 01 0 00 000000# txmsg < > 23039 002545'03 104 00 0 00 000076 23040 002546'03 320 12 0 00 002547' 23041 000275'02 000000000000# 23042 001227'04 011 011 000 000 000 23043 002547'03 200 01 0 00 000000* move t1, squote 23044 002550'03 260 17 0 00 003765' call putc 23045 23046 txmsg < 23047 002551'03 200 01 0 00 000000# Start-Of-Packet: > 23048 002552'03 104 00 0 00 000076 23049 002553'03 320 12 0 00 002554' 23050 000276'02 000000000000# k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 24-2 K20DSP MAC 9-Nov-23 18:22 SHOW PACKET-INFO display code 23051 001230'04 015 012 040 040 123 23052 002554'03 200 01 0 00 000000* move t1, ssthdr ;[18] 23053 002555'03 260 17 0 00 003765' call putc 23054 002556'03 200 01 0 00 000000# txmsg < > 23055 002557'03 104 00 0 00 000076 23056 002560'03 320 12 0 00 002561' 23057 000277'02 000000000000# 23058 001235'04 011 011 000 000 000 23059 002561'03 200 01 0 00 000000* move t1, rsthdr ;[18] 23060 002562'03 260 17 0 00 003765' call putc 23061 23062 ;[100] New headings for this stuff. 23063 23064 txmsg < 23065 23066 Requested Used 23067 002563'03 200 01 0 00 000000# 8th-bit Prefix: > ;[88] Begin addition 23068 002564'03 104 00 0 00 000076 23069 002565'03 320 12 0 00 002566' 23070 000300'02 000000000000# 23071 001236'04 015 012 015 012 011 23072 23073 23074 002566'03 336 00 0 00 000000* ifmn. ebqr ;[194] Did our user request 8th bit prefix? 23075 002567'03 254 00 0 00 002576' 23076 002570'03 200 01 0 00 000000* move t1, ebq ; Yes. 23077 002571'03 260 17 0 00 003765' call putc ; Say what it is. 23078 002572'03 200 01 0 00 000000# txmsg < > 23079 002573'03 104 00 0 00 000076 23080 002574'03 320 12 0 00 002575' 23081 000301'02 000000000000# 23082 001251'04 011 011 000 000 000 23083 002575'03 254 00 0 00 002601' else. ;[194] Otherwise, don't have one 23084 002576'03 200 01 0 00 000000# txmsg <(none) > ; Just say we'll do it if asked. 23085 002577'03 104 00 0 00 000076 23086 002600'03 320 12 0 00 002601' 23087 000302'02 000000000000# 23088 001252'04 050 156 157 156 145 23089 002601'03 endif. ;[194] 23090 23091 002601'03 336 00 0 00 000000* ifmn. ebqflg ;[194] Was it used during last transfer? 23092 002602'03 254 00 0 00 002606' 23093 002603'03 200 01 0 00 002570* move t1, ebq ; Looks like it, say what prefix. 23094 002604'03 260 17 0 00 003765' call putc 23095 002605'03 254 00 0 00 002611' else. ;[194] Wasn't used 23096 002606'03 200 01 0 00 000000# txmsg <(none)> ; Just say we would have done it if asked. 23097 002607'03 104 00 0 00 000076 23098 002610'03 320 12 0 00 002611' 23099 000303'02 000000000000# 23100 001254'04 050 156 157 156 145 23101 002611'03 endif. ;[194] 23102 23103 txmsg < 23104 002611'03 200 01 0 00 000000# Repeat Prefix: > ;[92] Begin addition 23105 002612'03 104 00 0 00 000076 k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 24-3 K20DSP MAC 9-Nov-23 18:22 SHOW PACKET-INFO display code 23106 002613'03 320 12 0 00 002614' 23107 000304'02 000000000000# 23108 001256'04 015 012 040 040 122 23109 002614'03 200 01 0 00 000000* move t1, rptq ; What we would use to flag repeat counts. 23110 002615'03 260 17 0 00 003765' call putc 23111 002616'03 200 01 0 00 000000# txmsg < > 23112 002617'03 104 00 0 00 000076 23113 002620'03 320 12 0 00 002621' 23114 000305'02 000000000000# 23115 001263'04 011 011 000 000 000 23116 23117 002621'03 336 00 0 00 000000* ifmn. rptflg ;[194] Was it actually used? 23118 002622'03 254 00 0 00 002626' 23119 002623'03 200 01 0 00 002614* move t1, rptq ;[194] Show it 23120 002624'03 260 17 0 00 003765' call putc 23121 002625'03 254 00 0 00 002631' else. ;[194] Otherwise didn't use it 23122 002626'03 200 01 0 00 000000# txmsg <(none)> ; Just say we would have done it if asked. 23123 002627'03 104 00 0 00 000076 23124 002630'03 320 12 0 00 002631' 23125 000306'02 000000000000# 23126 001264'04 050 156 157 156 145 23127 002631'03 endif. ;[194] 23128 23129 txmsg < 23130 002631'03 200 01 0 00 000000# Block Check: > ;[98] Block check type. 23131 002632'03 104 00 0 00 000076 23132 002633'03 320 12 0 00 002634' 23133 000307'02 000000000000# 23134 001266'04 015 012 040 040 102 23135 002634'03 200 01 0 00 000000* move t1, bctr 23136 002635'03 260 17 0 00 003765' call putc 23137 002636'03 200 01 0 00 000000# txmsg < > 23138 002637'03 104 00 0 00 000076 23139 002640'03 320 12 0 00 002641' 23140 000310'02 000000000000# 23141 001273'04 011 011 000 000 000 23142 002641'03 201 01 0 00 000101 numout bctu ;[98] 23143 002642'03 200 02 0 00 000000* 23144 002643'03 201 03 0 00 000012 23145 002644'03 104 00 0 00 000224 23146 002645'03 320 14 0 00 002646' 23147 23148 002646'03 561 01 0 00 002445* hrroi t1, crlflf ;[194] Tie off the line 23149 002647'03 104 00 0 00 000076 PSOUT% 23150 002650'03 256 00 0 00 000005 xct q1 ;[39] return or proceed... 23151 remark ;[194] May fall through .. 23152 k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 25 K20DSP MAC 9-Nov-23 18:22 SHOW TIMING-INFO external variable usage 23153 subttl SHOW TIMING-INFO external variable usage 23154 23155 extern delay ; Milliseconds to wait before sending first packet 23156 extern delayf ; Same number as floating point seconds 23157 extern imxtry ; Maximum retries in send initiate. 23158 extern maxtry ; Maximum retries for an ordinary packet. 23159 extern rpause ; Pause before ACKing data packet. 23160 extern rpausf ; Same number as floating point 23161 extern rtimou ; Minimum timeout interval Tops-20 needs. 23162 extern spause ; Pause before sending data packet. 23163 extern spausf ; Same number as floating point 23164 extern srvtim ; Server command wait timeout interval. 23165 extern stimou ; Interval for current timer 23166 k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 26 K20DSP MAC 9-Nov-23 18:22 SHOW TIMING-INFO numeric output flags 23167 subttl SHOW TIMING-INFO numeric output flags 23168 23169 ;[212] Begin code Insertion 23170 23171 remark Complex flag usage set up 23172 23173 ; Integer and floating output flags to line up columns. 23174 ; The hairy floating flags can be found in DOC:JSYS_REFERENCE.MEM, 23175 ; section 2.9.1.2, table xx, pages 2-87, 88. 23176 23177 ; Integer flags 23178 120006 000012 int%f== 23179 .xcref int%f ; Don't need on cross reference 23180 suppress int%f ; Don't want in symbol table listing 23181 120006 000012 show. (int%f) ; Show final word 23182 23183 ; Floating point flags 23184 000000 flt%f==0 ; Floating output flags; no output to DDT 23185 .xcref flt%f ; No need on the cross reference 23186 suppress flt%f ; No need in symbol table listing 23187 23188 define fltf (v,f) < ;;Define a macro to build floating flag word 23189 ifnb ,< ;;Non-blank field specified? 23190 flt%f==> ;; OR in the value in the field 23191 >;; ifnb 23192 ifb ,< ;;Blank field? 23193 flt%f==> ;;OR in the bit 23194 >;; ifb 23195 .xcref flt%f ;;Still don't need on cross reference 23196 >;; fltf 23197 23198 fltf(.flspc,fl%sgn) ;;First character is a space 23199 fltf(.fllsp,fl%jus) ;;Right justify, leading spaces 23200 fltf(fl%one) ;;Output at least one digit 23201 fltf(fl%pnt) ;;Output the decimal point, always 23202 fltf(.flexn,fl%exp) ;;Don't output an exponent 23203 fltf(fl%ovl) ;;Output on overflow 23204 fltf(^d6,fl%fst) ;;Properly justify integral portion 23205 fltf(^d4,fl%snd) ;;Digits in second field 23206 23207 224100 060400 show. (flt%f) ;;Finally show what we got 23208 23209 ;[212] End code insertion 23210 k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 27 K20DSP MAC 9-Nov-23 18:22 SHOW TIMING-INFO code 23211 subttl SHOW TIMING-INFO code 23212 23213 remark Timeout in floating seconds and integral milliseconds 23214 23215 002651'03 $shtim: entry $shtim 23216 002651'03 474 04 0 00 000000 seto t4, ;[212] Let's suppose no time outs 23217 txmsg ;[212] 23221 002653'03 104 00 0 00 000076 23222 002654'03 320 12 0 00 002655' 23223 000311'02 000000000000# 23224 001274'04 124 151 155 151 156 23225 23226 23227 23228 002655'03 120 01 0 00 000000* dmove t1,rtimou ;[212] Load timeout int ms and floating seconds 23229 002656'03 322 01 0 00 002667' ifn. t1 ;[212] Prefer int (because of a parser fluke) 23230 002657'03 201 01 0 00 000101 movei t1, .priou ;[212] 23231 002660'03 120 03 0 00 004527' dmove t3, [exp flt%f,0] ;[212] Special columnar formatting, flag non-zero 23232 002661'03 104 00 0 00 000233 FLOUT% ;[212] 23233 002662'03 320 14 0 00 002663' erjmps .+1 ;[212] 23234 002663'03 200 01 0 00 000000# txmsg < > ;[212] Two spaces to send column 23235 002664'03 104 00 0 00 000076 23236 002665'03 320 12 0 00 002666' 23237 000312'02 000000000000# 23238 001310'04 040 040 000 000 000 23239 002666'03 254 00 0 00 002672' else. ;[186] Otherwise, special case it 23240 002667'03 200 01 0 00 000000# txmsg < (none) > ;[186] Make it STAND OUT 23241 002670'03 104 00 0 00 000076 23242 002671'03 320 12 0 00 002672' 23243 000313'02 000000000000# 23244 001311'04 040 040 040 040 040 23245 002672'03 endif. ;[186] End special casing recieved 23246 23247 23248 002672'03 120 01 0 00 000000* dmove t1,stimou ;[212] Load timeout int ms and floating seconds 23249 002673'03 322 01 0 00 002701' ifn. t1 ;[212] Prefer int (because of a parser fluke) 23250 002674'03 201 01 0 00 000101 movei t1, .priou ;[212] 23251 002675'03 120 03 0 00 004527' dmove t3, [exp flt%f,0] ;[212] special columnar formatting, flag non-zero 23252 002676'03 104 00 0 00 000233 FLOUT ;[212] 23253 002677'03 320 14 0 00 002700' erjmps .+1 ;[212] 23254 002700'03 254 00 0 00 002704' else. ;[194] Otherwise, who knows? 23255 002701'03 200 01 0 00 000000# txmsg < (none)> ;[212] Five spaces 23256 002702'03 104 00 0 00 000076 23257 002703'03 320 12 0 00 002704' 23258 000314'02 000000000000# 23259 001314'04 040 040 040 040 040 23260 002704'03 endif. ;[194] 23261 23262 remark ;[212] If never printed a time out, suppress ms's 23263 002704'03 326 04 0 00 002756' ife. t4 ;[212] Ever do anthing? 23264 002705'03 200 01 0 00 000000# txmsg < sec (> ;[212] Yes, so label the seconds field 23265 002706'03 104 00 0 00 000076 k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 27-1 K20DSP MAC 9-Nov-23 18:22 SHOW TIMING-INFO code 23266 002707'03 320 12 0 00 002710' 23267 000315'02 000000000000# 23268 001317'04 040 163 145 143 040 23269 002710'03 201 01 0 00 000101 numout [maxtim/^d1000] ;[212] 23270 002711'03 200 02 0 00 004531' 23271 002712'03 201 03 0 00 000012 23272 002713'03 104 00 0 00 000224 23273 002714'03 320 14 0 00 002715' 23274 txmsg < max) 23275 002715'03 200 01 0 00 000000# > ;[212] 23276 002716'03 104 00 0 00 000076 23277 002717'03 320 12 0 00 002720' 23278 000316'02 000000000000# 23279 001321'04 040 155 141 170 051 23280 23281 002720'03 337 02 0 00 002655* skipg t2,rtimou ;[212] Non-zero receive timeout? 23282 002721'03 254 00 0 00 002732' ifskp. ;[212] Yes,display it 23283 002722'03 200 01 0 00 000000# txmsg < > ;[212] One tab, seven spaces to recieve field 23284 002723'03 104 00 0 00 000076 23285 002724'03 320 12 0 00 002725' 23286 000317'02 000000000000# 23287 001323'04 011 040 040 040 040 23288 002725'03 201 01 0 00 000101 movei t1, .priou ;[194] 23289 002726'03 200 03 0 00 004532' movx t3, int%f ;[212] Special integer formatting 23290 002727'03 104 00 0 00 000224 NOUT% ;rtimou ;[186] Not rrtimo ... 23291 002730'03 320 14 0 00 002731' erjmps .+1 ;[194] 23292 002731'03 254 00 0 00 002735' else. ;[212] Otherwise, blank the field 23293 002732'03 200 01 0 00 000000# txmsg < > ;[212] 2 tabs, 7 spaces to end of recieve 23294 002733'03 104 00 0 00 000076 23295 002734'03 320 12 0 00 002735' 23296 000320'02 000000000000# 23297 001325'04 011 011 040 040 040 23298 002735'03 endif. ;[212] Done printing 23299 23300 002735'03 337 02 0 00 002672* skipg t2,stimou ;[212] Non-zero receive timeout? 23301 002736'03 254 00 0 00 002747' ifskp. ;[212] Yes,display it 23302 002737'03 200 01 0 00 000000# txmsg < > ;[212] One tab, four spaces 23303 002740'03 104 00 0 00 000076 23304 002741'03 320 12 0 00 002742' 23305 000321'02 000000000000# 23306 001327'04 011 040 040 040 040 23307 002742'03 201 01 0 00 000101 movei t1, .priou ;[194] 23308 002743'03 200 03 0 00 004532' movx t3, int%f ;[212] Special integer formatting 23309 002744'03 104 00 0 00 000224 NOUT% ;[186] 23310 002745'03 320 14 0 00 002746' erjmps .+1 ;[194] 23311 002746'03 254 00 0 00 002752' else. ;[212] Otherwise, no send timeout 23312 002747'03 200 01 0 00 000000# txmsg < > ;[212] Two tabs, two spaces 23313 002750'03 104 00 0 00 000076 23314 002751'03 320 12 0 00 002752' 23315 000322'02 000000000000# 23316 001331'04 011 011 040 040 000 23317 002752'03 endif. ;[212] Either should be in correct column now 23318 txmsg < ms 23319 002752'03 200 01 0 00 000000# > ;[212] Must always label non-zero milliseconds 23320 002753'03 104 00 0 00 000076 k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 27-2 K20DSP MAC 9-Nov-23 18:22 SHOW TIMING-INFO code 23321 002754'03 320 12 0 00 002755' 23322 000323'02 000000000000# 23323 001332'04 040 155 163 015 012 23324 002755'03 254 00 0 00 002761' else. ;[212] Otherwise, no time outs at all, ever 23325 txmsg < 23326 002756'03 200 01 0 00 000000# > ;[212] So just tie off the line 23327 002757'03 104 00 0 00 000076 23328 002760'03 320 12 0 00 002761' 23329 000324'02 000000000000# 23330 001334'04 015 012 000 000 000 23331 002761'03 endif. ;[212] End whether ever printed anything 23332 k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 28 K20DSP MAC 9-Nov-23 18:22 Pause in floating seconds and integral milliseconds 23333 subttl Pause in floating seconds and integral milliseconds 23334 23335 002761'03 400 04 0 00 000000 setz t4, ;[212] Assume nothing printed 23336 txmsg < 23337 002762'03 200 01 0 00 000000# Pause: > ;[196] 23338 002763'03 104 00 0 00 000076 23339 002764'03 320 12 0 00 002765' 23340 000325'02 000000000000# 23341 001335'04 015 012 040 040 120 23342 002765'03 200 03 0 00 004527' movx t3, ;[212] Special columnar formatting, always 23343 23344 002766'03 337 02 0 00 000000* skipg t2, rpausf ;[212] Load and check floating component 23345 002767'03 254 00 0 00 002775' ifskp. ;[212] Non-zero, type it 23346 002770'03 201 01 0 00 000101 movei t1, .priou ;[212] This terminal 23347 002771'03 104 00 0 00 000233 FLOUT ;[36] 23348 002772'03 320 14 0 00 002773' erjmps .+1 ;[212] Catch and suppress errors 23349 002773'03 474 04 0 00 000000 seto t4, ;[212] Flag printed something 23350 002774'03 254 00 0 00 003000' else. ;[212] Otherwise, special case zero 23351 002775'03 200 01 0 00 000000# txmsg < (none)> ;[212] with plain text 23352 002776'03 104 00 0 00 000076 23353 002777'03 320 12 0 00 003000' 23354 000326'02 000000000000# 23355 001340'04 040 040 040 040 040 23356 003000'03 endif. 23357 23358 003000'03 337 02 0 00 000000* skipg t2, spausf ;[212] Load and check floating component 23359 003001'03 254 00 0 00 003012' ifskp. ;[212] Non-zero, type it 23360 003002'03 200 01 0 00 000000# txmsg < > ;[212] Two spaces 23361 003003'03 104 00 0 00 000076 23362 003004'03 320 12 0 00 003005' 23363 000327'02 000000000000# 23364 001343'04 040 040 000 000 000 23365 003005'03 201 01 0 00 000101 movei t1, .priou ;[36] 23366 003006'03 104 00 0 00 000233 FLOUT ;[36] 23367 003007'03 320 14 0 00 003010' erjmps .+1 ;[194] 23368 003010'03 474 04 0 00 000000 seto t4, ;[212] Flag printed something 23369 003011'03 254 00 0 00 003015' else. ;[212] Otherwise, special case zero 23370 003012'03 200 01 0 00 000000# txmsg < (none)> ;[212] with plain text 23371 003013'03 104 00 0 00 000076 23372 003014'03 320 12 0 00 003015' 23373 000330'02 000000000000# 23374 001344'04 040 040 040 040 040 23375 003015'03 endif. 23376 23377 003015'03 322 04 0 00 003052' ifn. t4 ;[212] Printed any numbers? 23378 txmsg < sec 23379 003016'03 200 01 0 00 000000# > ;[212] Yes; one tab, seven spaces to recieve field 23380 003017'03 104 00 0 00 000076 23381 003020'03 320 12 0 00 003021' 23382 000331'02 000000000000# 23383 001347'04 040 163 145 143 015 23384 23385 003021'03 200 03 0 00 004532' movx t3, ;[212] Special integer formatting 23386 23387 003022'03 337 02 0 00 000000* skipg t2, rpause ;[212] Integer millisecond recieve pause k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 28-1 K20DSP MAC 9-Nov-23 18:22 Pause in floating seconds and integral milliseconds 23388 003023'03 254 00 0 00 003033' ifskp. ;[212] A real number, print it 23389 003024'03 201 01 0 00 000101 movei t1, .priou ;[212] Going to primary output 23390 003025'03 104 00 0 00 000224 NOUT% ;[212] Output it (but nicely) 23391 003026'03 320 14 0 00 003027' erjmps .+1 ;[212] Catch and suppress error 23392 003027'03 200 01 0 00 000000# txmsg < > ;[212] One tab, four spaces 23393 003030'03 104 00 0 00 000076 23394 003031'03 320 12 0 00 003032' 23395 000332'02 000000000000# 23396 001352'04 011 040 040 040 040 23397 003032'03 254 00 0 00 003036' else. ;[212] Otherwise, suppress completely 23398 003033'03 200 01 0 00 000000# txmsg < > ;[212] Two tabs, four spaces 23399 003034'03 104 00 0 00 000076 23400 003035'03 320 12 0 00 003036' 23401 000333'02 000000000000# 23402 001354'04 011 011 040 040 040 23403 003036'03 endif. ;[212] End suppression decision 23404 23405 003036'03 337 02 0 00 000000* skipg t2, spause ;[212] Integer millisecond send pause 23406 003037'03 254 00 0 00 003044' ifskp. ;[212] A real number, print it 23407 003040'03 201 01 0 00 000101 movei t1, .priou ;[212] Going to primary output 23408 003041'03 104 00 0 00 000224 NOUT% ;[212] Output it (but nicely) 23409 003042'03 320 14 0 00 003043' erjmps .+1 ;[212] Catch and suppress error 23410 003043'03 254 00 0 00 003047' else. ;[212] Otherwise, suppress number entirely 23411 003044'03 200 01 0 00 000000# txmsg < > ;[212] One tab, four spaces 23412 003045'03 104 00 0 00 000076 23413 003046'03 320 12 0 00 003047' 23414 000334'02 000000000000# 23415 001356'04 011 040 040 000 000 23416 003047'03 endif. ;[212] End suppression decision 23417 23418 003047'03 200 01 0 00 000000# txmsg < ms> ;[196] 23419 003050'03 104 00 0 00 000076 23420 003051'03 320 12 0 00 003052' 23421 000335'02 000000000000# 23422 001357'04 040 155 163 000 000 23423 003052'03 endif. ;[212] 23424 k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 29 K20DSP MAC 9-Nov-23 18:22 Delay in floating seconds and integral milliseconds 23425 subttl Delay in floating seconds and integral milliseconds 23426 23427 txmsg < 23428 23429 003052'03 200 01 0 00 000000# Delay before sending first packet: > ;[196] 23430 003053'03 104 00 0 00 000076 23431 003054'03 320 12 0 00 003055' 23432 000336'02 000000000000# 23433 001360'04 015 012 015 012 040 23434 23435 003055'03 336 00 0 00 001623* ifmn. local ;[194] Local? 23436 003056'03 254 00 0 00 003063' 23437 003057'03 200 01 0 00 000000# txmsg ;[194] Never waits for anybody 23438 003060'03 104 00 0 00 000076 23439 003061'03 320 12 0 00 003062' 23440 000337'02 000000000000# 23441 001371'04 116 157 156 145 000 23442 003062'03 254 00 0 00 003116' else. ;[194] Remote, actually 23443 003063'03 332 02 0 00 000000* skipe t2, delayf ;[194] Do we have any delay, then? 23444 003064'03 254 00 0 00 003071' ifskp. ;[194] No, so special case that 23445 003065'03 200 01 0 00 000000# txmsg ;[194] A little different from local 23446 003066'03 104 00 0 00 000076 23447 003067'03 320 12 0 00 003070' 23448 000340'02 000000000000# 23449 001372'04 132 145 162 157 040 23450 003070'03 254 00 0 00 003116' else. 23451 003071'03 201 01 0 00 000101 movei t1, .priou ;[194] 23452 003072'03 400 03 0 00 000000 setz t3, ;[194] Default flags 23453 003073'03 104 00 0 00 000233 FLOUT% ;[194] Type it 23454 003074'03 320 12 0 00 003075' erjmpr .+1 ;[194] 23455 003075'03 312 02 0 00 004533' came t2,[1.0] ;[212] Exactly one second? 23456 003076'03 254 00 0 00 003103' ifskp. ;[212] Yes, inflect for singular case 23457 003077'03 200 01 0 00 000000# txmsg < sec (> ;[212] Label and punctuate 23458 003100'03 104 00 0 00 000076 23459 003101'03 320 12 0 00 003102' 23460 000341'02 000000000000# 23461 001375'04 040 163 145 143 040 23462 003102'03 254 00 0 00 003106' else. ;[212] Otherwise, use plural inflection 23463 003103'03 200 01 0 00 000000# txmsg < secs (> ;[212] Label and punctuate 23464 003104'03 104 00 0 00 000076 23465 003105'03 320 12 0 00 003106' 23466 000342'02 000000000000# 23467 001377'04 040 163 145 143 163 23468 003106'03 endif. ;[212] End grammatical analysis 23469 003106'03 201 01 0 00 000101 movei t1, .priou ;[194] 23470 003107'03 200 02 0 00 000000* move t2, delay ;[194] Load milliseconds 23471 003110'03 201 03 0 00 000012 movei t3, ^d10 ;[194] 23472 003111'03 104 00 0 00 000224 NOUT% ;[194] 23473 003112'03 320 12 0 00 003113' erjmpr .+1 ;[194] 23474 003113'03 200 01 0 00 000000# txmsg < ms)> ;[194] 23475 003114'03 104 00 0 00 000076 23476 003115'03 320 12 0 00 003116' 23477 000343'02 000000000000# 23478 001401'04 040 155 163 051 000 23479 003116'03 endif. ;[194] k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 29-1 K20DSP MAC 9-Nov-23 18:22 Delay in floating seconds and integral milliseconds 23480 003116'03 endif. ;[194] End delay listing 23481 k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 30 K20DSP MAC 9-Nov-23 18:22 Retries, Pause and other Misc 23482 subttl Retries, Pause and other Misc 23483 23484 txmsg < 23485 003116'03 200 01 0 00 000000# Packet retries before timeout: > 23486 003117'03 104 00 0 00 000076 23487 003120'03 320 12 0 00 003121' 23488 000344'02 000000000000# 23489 001402'04 015 012 040 040 120 23490 003121'03 201 01 0 00 000101 numout maxtry 23491 003122'03 200 02 0 00 000000* 23492 003123'03 201 03 0 00 000012 23493 003124'03 104 00 0 00 000224 23494 003125'03 320 14 0 00 003126' 23495 23496 txmsg < 23497 003126'03 200 01 0 00 000000# Number of retries for init packet: > 23498 003127'03 104 00 0 00 000076 23499 003130'03 320 12 0 00 003131' 23500 000345'02 000000000000# 23501 001413'04 015 012 040 040 116 23502 003131'03 201 01 0 00 000101 numout imxtry 23503 003132'03 200 02 0 00 000000* 23504 003133'03 201 03 0 00 000012 23505 003134'03 104 00 0 00 000224 23506 003135'03 320 14 0 00 003136' 23507 23508 remark in floating seconds and integral milliseconds 23509 23510 003136'03 336 00 0 00 000000* ifmn. srvtim ;[194] Any NAK'ing? 23511 003137'03 254 00 0 00 003173' 23512 txmsg < 23513 003140'03 200 01 0 00 000000# Server sends NAKs every > ;[212] Yes, begin the blat 23514 003141'03 104 00 0 00 000076 23515 003142'03 320 12 0 00 003143' 23516 000346'02 000000000000# 23517 001424'04 015 012 040 040 123 23518 003143'03 201 01 0 00 000101 movei t1, .priou ;[212] Output to terminal 23519 003144'03 200 02 0 00 000000# move t2, ;[212] Pick up floating component 23520 003145'03 200 04 0 00 000002 move t4, t2 ;[212] Save a copy 23521 003146'03 400 03 0 00 000000 setz t3, ;[212] Default (non-columnar) formatting 23522 003147'03 104 00 0 00 000233 FLOUT% ;[212] Type it 23523 003150'03 320 14 0 00 003151' erjmps .+1 ;[212] Catch and suppress error 23524 003151'03 312 04 0 00 004533' came t4,[1.0] ;[212] Exactly one second? 23525 003152'03 254 00 0 00 003157' ifskp. ;[212] Yes, inflect for singular case 23526 003153'03 200 01 0 00 000000# txmsg < sec (> ;[212] Label and punctuate 23527 003154'03 104 00 0 00 000076 23528 003155'03 320 12 0 00 003156' 23529 000347'02 000000000000# 23530 001432'04 040 163 145 143 040 23531 003156'03 254 00 0 00 003162' else. ;[212] Otherwise, use plural inflection 23532 003157'03 200 01 0 00 000000# txmsg < secs (> ;[212] Label and punctuate 23533 003160'03 104 00 0 00 000076 23534 003161'03 320 12 0 00 003162' 23535 000350'02 000000000000# 23536 001434'04 040 163 145 143 163 k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 30-1 K20DSP MAC 9-Nov-23 18:22 Retries, Pause and other Misc 23537 003162'03 endif. ;[212] End grammatical analysis 23538 003162'03 201 01 0 00 000101 movei t1, .priou ;[212] NOUT% goes to terminal, too 23539 003163'03 200 02 0 00 003136* move t2, srvtim ;[212] Load milliseconds 23540 003164'03 201 03 0 00 000012 movx t3, fld(^d10,no%rdx) ;[212] Base ten, but free format 23541 003165'03 104 00 0 00 000224 NOUT% ;[212] Type equivalent milliseconds 23542 003166'03 320 14 0 00 003167' erjmps .+1 ;[212] Catch and suppress error 23543 003167'03 200 01 0 00 000000# txmsg < ms)> ;[212] Abbreviation needs no inflection 23544 003170'03 104 00 0 00 000076 23545 003171'03 320 12 0 00 003172' 23546 000351'02 000000000000# 23547 001436'04 040 155 163 051 000 23548 003172'03 254 00 0 00 003176' else. ;[212] 23549 txmsg < 23550 003173'03 200 01 0 00 000000# Server will not NAK the communications line> 23551 003174'03 104 00 0 00 000076 23552 003175'03 320 12 0 00 003176' 23553 000352'02 000000000000# 23554 001437'04 015 012 040 040 123 23555 003176'03 endif. ;[212] 23556 23557 remark Other misc 23558 23559 003176'03 332 00 0 00 000014 ifme. debug ;[194] No blips if debugging. 23560 003177'03 254 00 0 00 003215' 23561 003200'03 336 00 0 00 003055* skipn local ; Or if not local. 23562 003201'03 254 00 0 00 003215' anskp. ;[194] 23563 txmsg < 23564 23565 003202'03 200 01 0 00 000000# "." for every > ;[4] 23566 003203'03 104 00 0 00 000076 23567 003204'03 320 12 0 00 003205' 23568 000353'02 000000000000# 23569 001451'04 015 012 015 012 040 23570 003205'03 201 01 0 00 000101 numout [blip] ;[9] 23571 003206'03 200 02 0 00 004534' 23572 003207'03 201 03 0 00 000012 23573 003210'03 104 00 0 00 000224 23574 003211'03 320 14 0 00 003212' 23575 003212'03 200 01 0 00 000000# txmsg < packets, "%" for each NAK.> 23576 003213'03 104 00 0 00 000076 23577 003214'03 320 12 0 00 003215' 23578 000354'02 000000000000# 23579 001456'04 040 160 141 143 153 23580 003215'03 endif. ;[194] 23581 23582 003215'03 561 01 0 00 002646* hrroi t1, crlflf ;[194] 23583 003216'03 104 00 0 00 000076 PSOUT% ;[194] 23584 003217'03 256 00 0 00 000005 xct q1 23585 remark ;[194] May fall through .. 23586 23587 if2 < purge int%f,flt%f,fltf > ;[212] Don't need symbols or macro after pass 2 23588 k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 31 K20DSP MAC 9-Nov-23 18:22 Show INPUT parameters 23589 subttl Show INPUT parameters 23590 23591 extern incase ; Case conversion flag for INPUT search. 23592 extern indeft ; Default timeout for INPUT search, floating seconds 23593 extern indeff ; Same value as milliseconds 23594 extern intima ; Timeout action for INPUT search. 23595 23596 extern indefc ;[209] Default search string length in characters 23597 extern indefw ;[209] Same thing in words (for xblt) 23598 extern indefs ;[209] Expanded search string 23599 23600 ;[160] 23601 23602 003220'03 $shinp: entry $shinp 23603 txmsg 23606 003221'03 104 00 0 00 000076 23607 003222'03 320 12 0 00 003223' 23608 000355'02 000000000000# 23609 001464'04 120 141 162 141 155 23610 23611 003223'03 332 00 0 00 000000* ifme. incase 23612 003224'03 254 00 0 00 003231' 23613 003225'03 200 01 0 00 000000# txmsg 23614 003226'03 104 00 0 00 000076 23615 003227'03 320 12 0 00 003230' 23616 000356'02 000000000000# 23617 001477'04 111 147 156 157 162 23618 003230'03 254 00 0 00 003234' else. ;[209] In case set means case sensitive 23619 003231'03 200 01 0 00 000000# txmsg 23620 003232'03 104 00 0 00 000076 23621 003233'03 320 12 0 00 003234' 23622 000357'02 000000000000# 23623 001503'04 117 142 163 145 162 23624 003234'03 endif. 23625 23626 txmsg < 23627 003234'03 200 01 0 00 000000# Default Timeout: > 23628 003235'03 104 00 0 00 000076 23629 003236'03 320 12 0 00 003237' 23630 000360'02 000000000000# 23631 001510'04 015 012 040 040 104 23632 003237'03 337 02 0 00 000000* skipg t2, indeff ;[194] Load default value, if exists 23633 003240'03 254 00 0 00 003261' ifskp. ;[194] Doing time outs 23634 003241'03 201 01 0 00 000101 movei t1, .priou ;[194] 23635 003242'03 400 03 0 00 000000 setz t3, ;[194] Default flags 23636 003243'03 104 00 0 00 000233 FLOUT% ;[194] Type it 23637 003244'03 320 12 0 00 003245' erjmpr .+1 ;[194] 23638 003245'03 200 01 0 00 000000# txmsg < sec, > ;[194] 23639 003246'03 104 00 0 00 000076 23640 003247'03 320 12 0 00 003250' 23641 000361'02 000000000000# 23642 001515'04 040 163 145 143 054 23643 003250'03 201 01 0 00 000101 movei t1, .priou ;[194] k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 31-1 K20DSP MAC 9-Nov-23 18:22 Show INPUT parameters 23644 003251'03 200 02 0 00 000000* move t2, indeft ;[194] Load milliseconds 23645 003252'03 201 03 0 00 000012 movei t3, ^d10 ;[194] 23646 003253'03 104 00 0 00 000224 NOUT% ;[194] 23647 003254'03 320 12 0 00 003255' erjmpr .+1 ;[194] 23648 003255'03 200 01 0 00 000000# txmsg < ms> ;[194] 23649 003256'03 104 00 0 00 000076 23650 003257'03 320 12 0 00 003260' 23651 000362'02 000000000000# 23652 001517'04 040 155 163 000 000 23653 003260'03 254 00 0 00 003264' else. ;[194] Otherwise, not timing out 23654 003261'03 200 01 0 00 000000# txmsg ;[194] 23655 003262'03 104 00 0 00 000076 23656 003263'03 320 12 0 00 003264' 23657 000363'02 000000000000# 23658 001520'04 111 156 146 151 156 23659 003264'03 endif. ;[194] 23660 23661 txmsg < 23662 003264'03 200 01 0 00 000000# Timeout Action: > ;[209] 23663 003265'03 104 00 0 00 000076 23664 003266'03 320 12 0 00 003267' 23665 000364'02 000000000000# 23666 001522'04 015 012 040 040 124 23667 003267'03 332 00 0 00 000000* ifme. intima ;[209] 23668 003270'03 254 00 0 00 003275' 23669 003271'03 200 01 0 00 000000# txmsg ;[209] 23670 003272'03 104 00 0 00 000076 23671 003273'03 320 12 0 00 003274' 23672 000365'02 000000000000# 23673 001527'04 120 162 157 143 145 23674 003274'03 254 00 0 00 003300' else. ;[209] 23675 003275'03 200 01 0 00 000000# txmsg ;[209] 23676 003276'03 104 00 0 00 000076 23677 003277'03 320 12 0 00 003300' 23678 000366'02 000000000000# 23679 001535'04 121 165 151 164 040 23680 003300'03 endif. ;[209] 23681 23682 txmsg < 23683 003300'03 200 01 0 00 000000# Default Search: > ;[209] 23684 003301'03 104 00 0 00 000076 23685 003302'03 320 12 0 00 003303' 23686 000367'02 000000000000# 23687 001542'04 015 012 040 040 104 23688 23689 003303'03 332 00 0 00 000000* ifme. indefw ;[209] Anything set? 23690 003304'03 254 00 0 00 003311' 23691 003305'03 200 01 0 00 000000# txmsg <*Carriage Return Line Feed*> ;[209] Nope, so point that out 23692 003306'03 104 00 0 00 000076 23693 003307'03 320 12 0 00 003310' 23694 000370'02 000000000000# 23695 001547'04 052 103 141 162 162 23696 003310'03 254 00 0 00 003333' else. ;[209] Otherwise, something there 23697 003311'03 201 01 0 00 000040 movei t1, .chspc ;[209] Load a space 23698 003312'03 104 00 0 00 000074 PBOUT% ;[209] Line up the text k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 31-2 K20DSP MAC 9-Nov-23 18:22 Show INPUT parameters 23699 003313'03 201 01 0 00 000042 movei t1, .chdbq ;[209] Load Double quote 23700 003314'03 104 00 0 00 000074 PBOUT% ;[209] Type it 23701 003315'03 201 01 0 00 000101 movei t1, .priou ;[209] Output to terminal 23702 003316'03 561 02 0 00 000000* hrroi t2, indefs ;[209] Point to default string 23703 003317'03 210 03 0 00 000000* movn t3, indefc ;[209] Load negative count of characters 23704 003320'03 400 04 0 00 000000 setz t4, ;[209] Stop on NUL, just in case 23705 003321'03 104 00 0 00 000053 SOUT% ;[209] Type it (counted SOUT% faster) 23706 003322'03 320 12 0 00 003324' ifje. r ;[209] Catch any JSYS error 23707 003323'03 254 00 0 00 003331' 23708 003324'03 200 04 0 00 000001 move t4, t1 ;[209] Save error for debuggers 23709 003325'03 200 01 0 00 000000# txmsg <*** ERROR ***> ;[209] Something obvious, I guess 23710 003326'03 104 00 0 00 000076 23711 003327'03 320 12 0 00 003330' 23712 000371'02 000000000000# 23713 001555'04 052 052 052 040 105 23714 003330'03 201 01 0 00 000101 movei t1, .priou ;[209] Reload primary output 23715 003331'03 endif. ;[209] 23716 003331'03 201 01 0 00 000042 movei t1, .chdbq ;[209] Load Double quote 23717 003332'03 104 00 0 00 000074 PBOUT% ;[209] Type it 23718 003333'03 endif. ;[209] End case displaying search string 23719 23720 003333'03 561 01 0 00 003215* hrroi t1, crlflf ;[209] Tie off the line 23721 003334'03 104 00 0 00 000076 PSOUT% ;[209] 23722 23723 003335'03 256 00 0 00 000005 xct q1 23724 remark ;[194] May fall through .. 23725 k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 32 K20DSP MAC 9-Nov-23 18:22 SHOW MACRO DEFINITIONS 23726 subttl SHOW MACRO DEFINITIONS 23727 23728 ;[77] SHOW MACRO DEFINITIONS 23729 23730 extern mactab ;[194] Macro table 23731 23732 003336'03 $shmac: entry $shmac 23733 003336'03 554 04 0 00 000000* hlrz t4, mactab ; Anything in macro table? 23734 003337'03 327 04 0 00 003344' ifle. t4 ;[194] If don't have any 23735 txmsg <%No macros defined 23736 003340'03 200 01 0 00 000000# > ;[203] Then say that 23737 003341'03 104 00 0 00 000076 23738 003342'03 320 12 0 00 003343' 23739 000372'02 000000000000# 23740 001560'04 045 116 157 040 155 23741 23742 003343'03 254 00 0 00 003433' jrst $shmax ;[194] And we're all done 23743 003344'03 endif. ;[203] Otherwise, have some blat 23744 ;[203] So dump the macros 23745 003344'03 201 01 0 00 000101 movei t1,.priou ;[203] Still going to terminal 23746 003345'03 200 02 0 00 000004 move t2,t4 ;[203] Load how many used 23747 003346'03 201 03 0 00 000012 movei t3,^d10 ;[203] Humans grok base 10 23748 003347'03 104 00 0 00 000224 NOUT% ;[203] Convert to external and display 23749 003350'03 320 12 0 00 003351' erjmpr .+1 ;[203] Catch and ignore error 23750 003351'03 200 01 0 00 000000# txmsg < macro> ;[203] Begin description 23751 003352'03 104 00 0 00 000076 23752 003353'03 320 12 0 00 003354' 23753 000373'02 000000000000# 23754 001565'04 040 155 141 143 162 23755 003354'03 201 01 0 00 000163 movei t1,"s" ;[203] Load inflection 23756 003355'03 302 04 0 00 000001 caie t4,^d1 ;[203] Singular case? 23757 003356'03 104 00 0 00 000074 PBOUT% ;[203] No, must inflect it 23758 003357'03 200 01 0 00 000000# txmsg < used, > ;[203] Continue description 23759 003360'03 104 00 0 00 000076 23760 003361'03 320 12 0 00 003362' 23761 000374'02 000000000000# 23762 001567'04 040 165 163 145 144 23763 23764 003362'03 201 01 0 00 000101 movei t1,.priou ;[203] Still going to terminal 23765 003363'03 550 02 0 00 003336* hrrz t2, mactab ;[203] Load maximum number of macros 23766 003364'03 274 02 0 00 000004 sub t2,t4 ;[203] Subtract off used 23767 003365'03 104 00 0 00 000224 NOUT% ;[203] Convert to external and display 23768 003366'03 320 12 0 00 003367' erjmpr .+1 ;[203] Catch and ignore error 23769 003367'03 200 01 0 00 000000# txmsg < available. Remaining storage: > 23770 003370'03 104 00 0 00 000076 23771 003371'03 320 12 0 00 003372' 23772 000375'02 000000000000# 23773 001571'04 040 141 166 141 151 23774 003372'03 260 17 0 00 000000* call $mchrs## ;[203] Get remaining space 23775 003373'03 200 02 0 00 000001 move t2, t1 ;[203] Load remaining characters 23776 003374'03 200 04 0 00 000001 move t4, t1 ;[203] Save a copy 23777 003375'03 201 01 0 00 000101 movei t1, .priou ;[203] This terminal 23778 003376'03 201 03 0 00 000012 movei t3, ^d10 ;[203] Base ten 23779 003377'03 104 00 0 00 000224 NOUT% ;[203] Convert to external and display 23780 003400'03 320 12 0 00 003401' erjmpr .+1 ;[203] Catch and ignore error k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 32-1 K20DSP MAC 9-Nov-23 18:22 SHOW MACRO DEFINITIONS 23781 003401'03 200 01 0 00 000000# txmsg < character> ;[203] 23782 003402'03 104 00 0 00 000076 23783 003403'03 320 12 0 00 003404' 23784 000376'02 000000000000# 23785 001600'04 040 143 150 141 162 23786 003404'03 201 01 0 00 000163 movei t1,"s" ;[203] Load inflection 23787 003405'03 302 04 0 00 000001 caie t4,^d1 ;[203] Singular case? 23788 003406'03 104 00 0 00 000074 PBOUT% ;[203] No, must inflect it 23789 txmsg < 23790 23791 Definitions: 23792 23793 003407'03 200 01 0 00 000000# > ;[203] 23794 003410'03 104 00 0 00 000076 23795 003411'03 320 12 0 00 003412' 23796 000377'02 000000000000# 23797 001603'04 015 012 015 012 104 23798 23799 003412'03 554 04 0 00 003363* hlrz t4, mactab ;[203] Reload macro table length 23800 003413'03 201 03 0 00 000001 movei t3, 1 ;[194] Point at first entry of TBLUK% tabke 23801 ;[194] Fall through to loop context 23802 003414'03 do. ;[194] Enter loop lexical context 23803 003414'03 200 01 0 00 000000# txmsg < > ;[194] Space over twice 23804 003415'03 104 00 0 00 000076 23805 003416'03 320 12 0 00 003417' 23806 000400'02 000000000000# 23807 001610'04 040 040 000 000 000 23808 003417'03 564 01 0 03 003412* hlro t1, mactab(t3) ; Point to macro name. 23809 003420'03 104 00 0 00 000076 PSOUT ; Print it. 23810 003421'03 200 01 0 00 000000# txmsg < = > 23811 003422'03 104 00 0 00 000076 23812 003423'03 320 12 0 00 003424' 23813 000401'02 000000000000# 23814 001611'04 040 075 040 000 000 23815 003424'03 560 01 0 03 003417* hrro t1, mactab(t3) ; Same deal for macro body. 23816 003425'03 104 00 0 00 000076 PSOUT 23817 003426'03 260 17 0 00 003743' call ifcrlf ;[194] See if it wants a CRLF 23818 003427'03 350 00 0 00 000003 aos t3 ; Bump TBLUK% index. 23819 003430'03 367 04 0 00 003414' sojg t4, top. ; Do for all macros in table. 23820 003431'03 enddo. ;[194] 23821 23822 003431'03 561 01 0 00 001331* hrroi t1, crlf ;[194] 23823 003432'03 104 00 0 00 000076 PSOUT% 23824 23825 003433'03 263 17 0 00 000000 $shmax: ret ;[83] Last one, always want to return. 23826 remark q1 ; Last show command always returns 23827 k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 33 K20DSP MAC 9-Nov-23 18:22 ITS Phase of Moon 23828 subttl ITS Phase of Moon 23829 23830 ;[6] (this whole routine, just for fun...) 23831 ; 23832 ; This code stolen from MOON.MAC (anybody know who wrote it?). 23833 ; Just changed OUTCHR's to PBOUT%'s via a macro. - Frank. 23834 ; 23835 ; The code is from MIT and may have been named in jest after famed MIT 23836 ; hacker David A. Moon. Also, see below. - Tom. 23837 ; 23838 ;[190] Change OUTCHR macro to not store in write-protected area 23839 ;[194] Slight rework to reduce symbol table 23840 23841 003434'03 265 16 0 00 004535' moon: saveac <5,6> 23842 003435'03 403 03 0 00 000004 setzb 3,4 23843 003436'03 474 02 0 00 000000 seto 2, 23844 003437'03 104 00 0 00 000222 ODCNV% 23845 003440'03 320 16 0 00 001315* erjmp r 23846 003441'03 621 04 0 00 000077 tlz 4,77 23847 003442'03 104 00 0 00 000223 IDCNV% 23848 003443'03 320 16 0 00 003440* erjmp r ; Return upon any error. 23849 003444'03 200 01 0 00 000000# txmsg <, Moon: > ; OK so far, say what we're doing. 23850 003445'03 104 00 0 00 000076 23851 003446'03 320 12 0 00 003447' 23852 000402'02 000000000000# 23853 001612'04 054 040 115 157 157 23854 23855 ; AC2= Universal time adjusted for time zone. 23856 23857 003447'03 200 01 0 00 000002 move 1,2 ; Right place. 23858 003450'03 274 01 0 00 000000# sub 1,newmn ; Sub off base new moon 23859 003451'03 230 01 0 00 000000# idiv 1,period ; Divide by the period 23860 003452'03 230 02 0 00 000000# idiv 2,perio4 ; Get fractions of a period 23861 003453'03 317 03 0 00 000000# camg 3,perio8 ; Check for phase + or - 23862 003454'03 254 00 0 00 003461' ifskp. ;[194] ; Not more than 3+ days 23863 003455'03 274 03 0 00 000000# sub 3,perio4 ; Make it next phase -n days 23864 003456'03 306 02 0 00 000003 cain 2,3 ; Is it LQ+3D+? 23865 003457'03 634 02 0 00 000002 tdza 2,2 ; It is 23866 003460'03 340 02 0 00 000000 aoj 2, ; Increment phase 23867 003461'03 endif. 23868 23869 003461'03 510 01 0 02 000000# hllz 1,table(2) ; Get SIXBIT phase 23870 003462'03 335 00 0 00 000003 skipge 3 ; 3 < 0 then minus phase output 23871 003463'03 665 01 0 00 000015 tloa 1,'-' ; - 23872 003464'03 665 01 0 00 000013 tloa 1,'+' ; + 23873 003465'03 217 00 0 00 000003 movms 3 ; Fix mag of 3 23874 003466'03 200 02 0 00 004545' move 2,[point 6,1] ; Byte pointer 23875 003467'03 201 05 0 00 000002 movei 5,2 ; Loop 3 times 23876 23877 003470'03 do. ;[194] Enter loop context 23878 003470'03 134 04 0 00 000002 ildb 4,2 ; Get a character 23879 003471'03 271 04 0 00 000040 addi 4," " ; Make ASCII 23880 003472'03 261 17 0 00 000001 OUTCHR 4 ; Type it 23881 003473'03 200 01 0 00 000004 23882 003474'03 104 00 0 00 000074 k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 33-1 K20DSP MAC 9-Nov-23 18:22 ITS Phase of Moon 23883 003475'03 320 12 0 00 003476' 23884 003476'03 262 17 0 00 000001 23885 003477'03 365 05 0 00 003470' sojge 5,top. ;[194] ; Loop 23886 003500'03 enddo. 23887 23888 003500'03 205 04 0 00 777774 movsi 4,-4 ; Make aobjn pointer 23889 23890 003501'03 do. ;[194] Enter loop context 23891 003501'03 550 02 0 04 000000# hrrz 2,table(4) ; Get a multiplier 23892 003502'03 620 02 0 00 774000 trz 2,774000 ; Strip off ascii character 23893 003503'03 221 03 0 02 000000 imuli 3,(2) ; Get the value decoded 23894 003504'03 554 01 0 00 000003 hlrz 1,3 ; Get value 23895 003505'03 621 03 0 00 777777 tlz 3,-1 ; Zap old LH 23896 003506'03 200 05 0 00 000001 move 5,1 ; Use 5 & 6 here 23897 003507'03 231 05 0 00 000012 idivi 5,12 ; Radix 10 23898 003510'03 271 05 0 00 000060 addi 5,60 ; Make ASCII 23899 003511'03 307 05 0 00 000060 caig 5,60 ;[194] Check for leading zero 23900 003512'03 254 00 0 00 003520' ifskp. ;[194] Not a leading zero 23901 003513'03 261 17 0 00 000001 OUTCHR 5 ; Type it. 23902 003514'03 200 01 0 00 000005 23903 003515'03 104 00 0 00 000074 23904 003516'03 320 12 0 00 003517' 23905 003517'03 262 17 0 00 000001 23906 003520'03 endif. ;[194] 23907 003520'03 271 06 0 00 000060 addi 6,60 ; Make ASCII 23908 003521'03 261 17 0 00 000001 OUTCHR 6 23909 003522'03 200 01 0 00 000006 23910 003523'03 104 00 0 00 000074 23911 003524'03 320 12 0 00 003525' 23912 003525'03 262 17 0 00 000001 23913 003526'03 135 05 0 00 004546' ldb 5,[point 7,table(4),24] ; Get d/h/m/s 23914 003527'03 261 17 0 00 000001 OUTCHR 5 ; Type it. 23915 003530'03 200 01 0 00 000005 23916 003531'03 104 00 0 00 000074 23917 003532'03 320 12 0 00 003533' 23918 003533'03 262 17 0 00 000001 23919 003534'03 261 17 0 00 000001 OUTCHR ["."] ; Follow with a dot. 23920 003535'03 200 01 0 00 004547' 23921 003536'03 104 00 0 00 000074 23922 003537'03 320 12 0 00 003540' 23923 003540'03 262 17 0 00 000001 23924 003541'03 253 04 0 00 003501' aobjn 4, top. ;[194] ; Loop. 23925 003542'03 enddo. ;[194] 23926 23927 003542'03 263 17 0 00 000000 ret ; Done, return. 23928 k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 34 K20DSP MAC 9-Nov-23 18:22 Pure data for MOON 23929 subttl Pure data for MOON 23930 23931 ; 12:47am Monday, 1 August 2022 23932 ; 23933 ; This routine uses a lunar period of 29 days, 12 hours, 53 minutes 23934 ; and 19 seconds. 23935 ; 23936 ; After 43 years, 6 months, 3 days, 23 hours, 29 minutes and 12 23937 ; seconds, it might be of interest to see how accurate this still is; 23938 ; meaning, has the period changed (I.E., increased) to the extent 23939 ; that we are accumulating a detectable difference. 23940 ; 23941 ; Wikipedia reports that a lunation, or synodic month, is the time 23942 ; period from one new moon to the next. In the J2000. 0 epoch, the 23943 ; average length of a lunation is 29.53059 days (or 29 days, 12 hours, 23944 ; 44 minutes, and 3 seconds). That is quite a difference. 23945 ; 23946 ; And it might be irrelevant. 23947 ; 23948 ; Since Earth's orbit around the Sun is elliptical and not circular, 23949 ; the speed of Earth's progression around the Sun varies during the 23950 ; year. Thus, the angular rate is faster nearer periapsis and slower 23951 ; near apoapsis. 23952 ; 23953 ; The same is also true for the Moon's orbit around the Earth. 23954 ; Because of these variations in angular rate, the actual time between 23955 ; lunations may vary from about 29.18 to about 29.93 days. The 23956 ; average duration in modern times is 29.53059 days with up to seven 23957 ; hours variation about the mean in any given year. 23958 23959 chgsec(code,const) ;;Constants go in CONST .PSECT 23960 23961 000403'02 125575 034343 newmn: 125575,,34343 ; 28-jan-79 0120 est 23962 000035 422752 per==35,,422752 ; 29d.12h.53m.19s 23963 000404'02 000035 422752 period: per 23964 000405'02 000007 304572 perio4: per/4 23965 000406'02 000003 542275 perio8: per/10 23966 23967 000407'02 565500 144 0001 table: byte(18)'NM '(7)"d"(11)^D1 ; New moon - days - 1 23968 000410'02 466100 150 0030 byte(18)'FQ '(7)"h"(11)^D24 ; First quarter - hours - 24 23969 000411'02 465500 155 0074 byte(18)'FM '(7)"m"(11)^D60 ; Full moon - minutes - 60 23970 000412'02 546100 163 0074 byte(18)'LQ '(7)"s"(11)^D60 ; Last quarter - seconds - 60 23971 23972 retsec ;;Return to previous .PSECT 23973 k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 35 K20DSP MAC 9-Nov-23 18:22 Display line performance external variables 23974 subttl Display line performance external variables 23975 23976 extern nsici ; Network SIN%'s Issued 23977 extern nsimx ; Network SIN% maximum length 23978 extern nsitc ; Network SIN% total characters 23979 extern vboct ; Virtual Terminal BOUT% Count (simulated) 23980 extern vsict ; Virtual Terminal SIN% Count (number done) 23981 extern vsimx ; Virtual Terminal SIN% Maximum length 23982 extern vsitc ; Virtual Terminal total characters SIN%'ed 23983 extern vsoct ; Virtual Terminal SOUTR%'s Issued 23984 extern vsotc ; Virtual Terminal SOUTR% Total Characters 23985 extern vsomx ; Virtual Terminal SOUTR% Maximum length 23986 k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 36 K20DSP MAC 9-Nov-23 18:22 Display information concerning line performance 23987 subttl Display information concerning line performance 23988 23989 ; Previous code from TELNET used BIN%/BOUT% loops in two forks to 23990 ; input data from the terminal and display results asynchronously. In 23991 ; terms of computational overhead, using a BIN% and a BOUT% for each 23992 ; character is the most expensive way to do it. 23993 ; 23994 ; It's also a certain way to become unpopular on a heavily loaded 23995 ; system or otherwise adversely impact other activities. On the other 23996 ; hand, data can not be left in the buffer in the case of a real front 23997 ; end, as this will crash RSX20F. 23998 ; 23999 ; The code was rewritten to wait for a character and then determine 24000 ; after the read whether more data existed in the buffer. If this was 24001 ; the case, then the remaining data was read. This also occurs on 24002 ; output. A Virtual BOUT% in this case is a SOUTR% of one character 24003 ; to get it pushed over the network. 24004 24005 003543'03 265 16 0 00 004357' disper: saveac ; Not called with anything, doesn't touch AC's 24006 24007 remark ; transmission fork keep these 24008 003544'03 336 00 0 00 002016* ifmn. vbict 24009 003545'03 254 00 0 00 003556' 24010 txmsg < 24011 003546'03 200 01 0 00 000000# Terminal BIN%'s: > 24012 003547'03 104 00 0 00 000076 24013 003550'03 320 12 0 00 003551' 24014 000413'02 000000000000# 24015 001614'04 015 012 040 040 124 24016 003551'03 201 01 0 00 000101 numout vbict ; Virtual Terminal BIN% Count 24017 003552'03 200 02 0 00 003544* 24018 003553'03 201 03 0 00 000012 24019 003554'03 104 00 0 00 000224 24020 003555'03 320 14 0 00 003556' 24021 003556'03 endif. 24022 003556'03 336 00 0 00 000000* ifmn. vchrcn 24023 003557'03 254 00 0 00 003570' 24024 txmsg < 24025 003560'03 200 01 0 00 000000# Virtual CFIBF%'s: > 24026 003561'03 104 00 0 00 000076 24027 003562'03 320 12 0 00 003563' 24028 000414'02 000000000000# 24029 001621'04 015 012 040 040 126 24030 003563'03 201 01 0 00 000101 numout vchrcn ; Virtual CHaRcters flushed CouNt 24031 003564'03 200 02 0 00 003556* 24032 003565'03 201 03 0 00 000012 24033 003566'03 104 00 0 00 000224 24034 003567'03 320 14 0 00 003570' 24035 003570'03 endif. 24036 003570'03 336 00 0 00 000000* ifmn. inpcbf 24037 003571'03 254 00 0 00 003602' 24038 txmsg < 24039 003572'03 200 01 0 00 000000# Buffer CFIBF%'s: > 24040 003573'03 104 00 0 00 000076 24041 003574'03 320 12 0 00 003575' k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 36-1 K20DSP MAC 9-Nov-23 18:22 Display information concerning line performance 24042 000415'02 000000000000# 24043 001626'04 015 012 040 040 040 24044 003575'03 201 01 0 00 000101 numout inpcbf ; INPUT network Buffer characters flushed 24045 003576'03 200 02 0 00 003570* 24046 003577'03 201 03 0 00 000012 24047 003600'03 104 00 0 00 000224 24048 003601'03 320 14 0 00 003602' 24049 003602'03 endif. 24050 003602'03 336 00 0 00 000000* ifmn. vboct 24051 003603'03 254 00 0 00 003614' 24052 txmsg < 24053 003604'03 200 01 0 00 000000# Virtual BOUT%'s: > 24054 003605'03 104 00 0 00 000076 24055 003606'03 320 12 0 00 003607' 24056 000416'02 000000000000# 24057 001633'04 015 012 040 040 126 24058 003607'03 201 01 0 00 000101 numout vboct ; Virtual Terminal BOUT% Count (simulated) 24059 003610'03 200 02 0 00 003602* 24060 003611'03 201 03 0 00 000012 24061 003612'03 104 00 0 00 000224 24062 003613'03 320 14 0 00 003614' 24063 003614'03 endif. 24064 003614'03 336 00 0 00 000000* ifmn. vsict 24065 003615'03 254 00 0 00 003646' 24066 txmsg < 24067 003616'03 200 01 0 00 000000# SIN%'s Issued: > 24068 003617'03 104 00 0 00 000076 24069 003620'03 320 12 0 00 003621' 24070 000417'02 000000000000# 24071 001640'04 015 012 040 040 123 24072 003621'03 201 01 0 00 000101 numout vsict ; Virtual Terminal SIN% Count 24073 003622'03 200 02 0 00 003614* 24074 003623'03 201 03 0 00 000012 24075 003624'03 104 00 0 00 000224 24076 003625'03 320 14 0 00 003626' 24077 txmsg < 24078 003626'03 200 01 0 00 000000# SIN% Bytes Total: > 24079 003627'03 104 00 0 00 000076 24080 003630'03 320 12 0 00 003631' 24081 000420'02 000000000000# 24082 001645'04 015 012 040 040 123 24083 003631'03 201 01 0 00 000101 numout vsitc ; Virtual Terminal total characters SIN%'ed 24084 003632'03 200 02 0 00 000000* 24085 003633'03 201 03 0 00 000012 24086 003634'03 104 00 0 00 000224 24087 003635'03 320 14 0 00 003636' 24088 txmsg < 24089 003636'03 200 01 0 00 000000# Max SIN% Length: > 24090 003637'03 104 00 0 00 000076 24091 003640'03 320 12 0 00 003641' 24092 000421'02 000000000000# 24093 001652'04 015 012 040 040 115 24094 003641'03 201 01 0 00 000101 numout vsimx ; Maximum length SIN% ever did 24095 003642'03 200 02 0 00 000000* 24096 003643'03 201 03 0 00 000012 k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 36-2 K20DSP MAC 9-Nov-23 18:22 Display information concerning line performance 24097 003644'03 104 00 0 00 000224 24098 003645'03 320 14 0 00 003646' 24099 003646'03 endif. 24100 24101 003646'03 336 00 0 00 000000* ifmn. vsoct 24102 003647'03 254 00 0 00 003700' 24103 txmsg < 24104 003650'03 200 01 0 00 000000# SOUTR%'s Issued: > 24105 003651'03 104 00 0 00 000076 24106 003652'03 320 12 0 00 003653' 24107 000422'02 000000000000# 24108 001657'04 015 012 040 040 123 24109 003653'03 201 01 0 00 000101 numout vsoct ; Virtual Terminal SOUTR% Count 24110 003654'03 200 02 0 00 003646* 24111 003655'03 201 03 0 00 000012 24112 003656'03 104 00 0 00 000224 24113 003657'03 320 14 0 00 003660' 24114 txmsg < 24115 003660'03 200 01 0 00 000000# SOUTR% Bytes: > 24116 003661'03 104 00 0 00 000076 24117 003662'03 320 12 0 00 003663' 24118 000423'02 000000000000# 24119 001664'04 015 012 040 040 123 24120 003663'03 201 01 0 00 000101 numout vsotc ; Virtual Terminal SOUTR% Bytes Total 24121 003664'03 200 02 0 00 000000* 24122 003665'03 201 03 0 00 000012 24123 003666'03 104 00 0 00 000224 24124 003667'03 320 14 0 00 003670' 24125 txmsg < 24126 003670'03 200 01 0 00 000000# Max SOUTR% Len: > 24127 003671'03 104 00 0 00 000076 24128 003672'03 320 12 0 00 003673' 24129 000424'02 000000000000# 24130 001671'04 015 012 040 040 115 24131 003673'03 201 01 0 00 000101 numout vsomx ; Virtual Terminal SOUTR% Maximum length 24132 003674'03 200 02 0 00 000000* 24133 003675'03 201 03 0 00 000012 24134 003676'03 104 00 0 00 000224 24135 003677'03 320 14 0 00 003700' 24136 003700'03 endif. 24137 24138 remark ; Network input fork updates these 24139 003700'03 336 00 0 00 002017* ifmn. nbict ; Did any network input? 24140 003701'03 254 00 0 00 003742' 24141 txmsg < 24142 003702'03 200 01 0 00 000000# Network BIN%'s: > 24143 003703'03 104 00 0 00 000076 24144 003704'03 320 12 0 00 003705' 24145 000425'02 000000000000# 24146 001676'04 015 012 040 040 116 24147 003705'03 201 01 0 00 000101 numout nbict ; Network BIN% count 24148 003706'03 200 02 0 00 003700* 24149 003707'03 201 03 0 00 000012 24150 003710'03 104 00 0 00 000224 24151 003711'03 320 14 0 00 003712' k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 36-3 K20DSP MAC 9-Nov-23 18:22 Display information concerning line performance 24152 txmsg < 24153 003712'03 200 01 0 00 000000# Network SIN%'s: > 24154 003713'03 104 00 0 00 000076 24155 003714'03 320 12 0 00 003715' 24156 000426'02 000000000000# 24157 001703'04 015 012 040 040 116 24158 003715'03 201 01 0 00 000101 numout nsici ; Network SIN%'s Issued 24159 003716'03 200 02 0 00 000000* 24160 003717'03 201 03 0 00 000012 24161 003720'03 104 00 0 00 000224 24162 003721'03 320 14 0 00 003722' 24163 txmsg < 24164 003722'03 200 01 0 00 000000# Network SIN% Cnt: > 24165 003723'03 104 00 0 00 000076 24166 003724'03 320 12 0 00 003725' 24167 000427'02 000000000000# 24168 001710'04 015 012 040 040 116 24169 003725'03 201 01 0 00 000101 numout nsitc ; Network SIN% total characters 24170 003726'03 200 02 0 00 000000* 24171 003727'03 201 03 0 00 000012 24172 003730'03 104 00 0 00 000224 24173 003731'03 320 14 0 00 003732' 24174 txmsg < 24175 003732'03 200 01 0 00 000000# Network SIN% Max: > 24176 003733'03 104 00 0 00 000076 24177 003734'03 320 12 0 00 003735' 24178 000430'02 000000000000# 24179 001715'04 015 012 040 040 116 24180 003735'03 201 01 0 00 000101 numout nsimx ; Network SIN% maximum length 24181 003736'03 200 02 0 00 000000* 24182 003737'03 201 03 0 00 000012 24183 003740'03 104 00 0 00 000224 24184 003741'03 320 14 0 00 003742' 24185 003742'03 endif. 24186 24187 003742'03 263 17 0 00 000000 ret 24188 k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 37 K20DSP MAC 9-Nov-23 18:22 ifcrlf -- maybe type a carriage return line feed 24189 subttl ifcrlf -- maybe type a carriage return line feed 24190 24191 ; Call: t1/ Updated point of PSOUT%'ed macro body 24192 ; 24193 ; [194] fixed a case of a macro not being terminated with a carriage 24194 ; return. This is unlikely, but could happen. That being the 24195 ; the case, when displaying the macros, we now have to check to 24196 ; see if we need to print a crlf. 24197 24198 003743'03 ifcrlf: entry ifcrlf ; Inform LINK of our location 24199 remark t1, t2 ; Smashes these 24200 003743'03 265 16 0 00 004550' saveac ; Holds counter and pointers!! 24201 ; Last three characters should be 24202 remark .chcrt, .chlfd, .chnul 24203 003744'03 211 02 0 00 000003 movni t2, ^d3 ; Check the end of the macro string 24204 003745'03 133 02 0 00 000001 adjbp t2, t1 ; May not have a CRLF ... 24205 003746'03 134 03 0 00 000002 ildb t3, t2 ; Pick up penultimate character 24206 003747'03 134 04 0 00 000002 ildb t4, t2 ; Pick up last character 24207 24208 003750'03 306 03 0 00 000015 cain t3, .chcrt ; Did they tie off the line? 24209 003751'03 254 00 0 00 003756' ifskp. ; Apparently not 24210 003752'03 306 04 0 00 000015 cain t4, .chcrt ; Unless they did it backwards 24211 003753'03 254 00 0 00 003756' anskp. ; Odd, but be happy... 24212 003754'03 201 01 0 00 000015 movei t1, .chcrt ; Otherwise, do the carriage return 24213 003755'03 104 00 0 00 000074 PBOUT% 24214 003756'03 endif. 24215 24216 003756'03 306 04 0 00 000012 cain t4, .chlfd ; Did they scroll the carriage? 24217 003757'03 254 00 0 00 003764' ifskp. ; Perhaps not 24218 003760'03 306 03 0 00 000012 cain t3, .chlfd ; Unless they did it backwards 24219 003761'03 254 00 0 00 003764' anskp. ; Odd, but be happy ... 24220 003762'03 201 01 0 00 000012 movei t1, .chlfd ; Otherwise, do the line feed 24221 003763'03 104 00 0 00 000074 PBOUT% 24222 003764'03 endif. 24223 24224 003764'03 263 17 0 00 000000 ret 24225 k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 38 K20DSP MAC 9-Nov-23 18:22 PUTC -- Print a single character, using ^X notation, DEL, etc. 24226 subttl PUTC -- Print a single character, using ^X notation, DEL, etc. 24227 24228 ; Call with t1/ character to print. 24229 ; 24230 ;[223] Modifies no registers 24231 24232 003765'03 putc: entry putc ;[194] Inform LINK of our location 24233 003765'03 261 17 0 00 000001 push p, t1 ;[223] Save the character 24234 003766'03 405 01 0 00 000177 andi t1, ^o177 ;[223] Stomp the parity 24235 24236 003767'03 302 01 0 00 000177 caie t1, .chdel ;[194] A rubout? 24237 003770'03 254 00 0 00 004000' ifskp. ;[194] It is 24238 003771'03 261 17 0 00 000002 push p, t2 ;[194] Don't bump into anything 24239 003772'03 200 01 0 00 000000# txmsg ;[194] type this 24240 003773'03 104 00 0 00 000076 24241 003774'03 320 12 0 00 003775' 24242 000431'02 000000000000# 24243 001722'04 104 105 114 000 000 24244 003775'03 262 17 0 00 000002 pop p, t2 ;[194] Restore in case somebody cared 24245 003776'03 262 17 0 00 000001 pop p, t1 ;[223] Restore the original character 24246 003777'03 263 17 0 00 000000 ret 24247 004000'03 endif. ;[194] 24248 24249 004000'03 301 01 0 00 000040 cail t1, .chspc ;[194] Is it a control char? 24250 004001'03 254 00 0 00 004007' ifskp. ;[194] It is 24251 004002'03 261 17 0 00 000001 push p, t1 ; Save the char. 24252 004003'03 201 01 0 00 000136 movei t1, "^" ; Get the control quote. 24253 004004'03 104 00 0 00 000074 PBOUT% 24254 004005'03 262 17 0 00 000001 pop p, t1 24255 004006'03 435 01 0 00 000100 ori t1, ^o100 ; Turn on the non-control bit. 24256 004007'03 endif. ;[194] 24257 24258 004007'03 104 00 0 00 000074 PBOUT% 24259 004010'03 262 17 0 00 000001 pop p, t1 ;[223] Restore the original character 24260 004011'03 263 17 0 00 000000 ret 24261 k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 39 K20DSP MAC 9-Nov-23 18:22 show a line's characteristics 24262 subttl show a line's characteristics 24263 24264 ; Says some interesting things about the line that is passed in t1 24265 ; 24266 ; Such information does not effect the protocol, per se. It is rather 24267 ; used for debugging and as part of a heuristic as to what kind of 24268 ; performance could be expected. As there are a rather large number 24269 ; of other factors that can impact performance, what is displayed can 24270 ; in no way be assumed to be determinative. 24271 ; 24272 ; All part of 186, plus some 223 flavoring 24273 24274 ;[223] Line type names 24275 24276 chgsec(code,const) ;[223] Table goes in const psect 24277 000432'02 000000000000# ltname: cascii() ;[223] NW%UND Undefined 24278 001723'04 125 156 144 145 146 24279 000433'02 000000000000# cascii() ;[223] NW%FW Front end (RSX-20F) 24280 001725'04 106 105 000 000 000 24281 000434'02 000000000000# cascii() ;[223] NW%PT Pseudo-terminal 24282 001726'04 120 124 131 000 000 24283 000435'02 000000000000# cascii() ;[223] NW%MC Network Remote Terminal (MCB) 24284 001727'04 116 122 124 000 000 24285 000436'02 000000000000# Cascii() ;[223] NW%TV Telnet Virtual Terminal 24286 001730'04 124 126 124 000 000 24287 000437'02 000000000000# cascii() ;[223] NW%CH CTERM 24288 001731'04 103 124 105 122 115 24289 000440'02 000000000000# cascii() ;[223] NW%LH Local Area Terminal 24290 001733'04 114 101 124 000 000 24291 000441'02 ltneot: remark ;[223] Mark end of table 24292 000007 nw%mx== ;[223] Maximum type 24293 retsec ;[223] Back into code 24294 cleans() ;[223] 24295 24296 ; Call: 24297 ; 24298 ; t1/ Network Type 24299 ; t2/ Line Type 24300 ; t3/ Line number 24301 24302 extern lclpar ;[223] Whether local line will do parity 24303 extern opnpar ;[223] Whether open device will do parity 24304 24305 004012'03 265 16 0 00 004560' linchr: saveac 24306 ;[223] Does not overwrite any register 24307 004013'03 200 05 0 00 000003 move q1, t3 ;[223] Save line number 24308 004014'03 301 02 0 00 000000 cail t2, 0 ;[223] Negative line type? 24309 004015'03 301 02 0 00 000007 cail t2, nw%mx ;[223] or over the maximum? 24310 004016'03 400 02 0 00 000000 setz t2, ;[223] Yes to either, reset to NW%UND 24311 004017'03 120 06 0 00 000001 dmove q2, t1 ;[223] Store network and line type 24312 24313 004020'03 326 07 0 00 004031' ife. q3 ;[223] Undefined line type? (NW%UND) 24314 txmsg < 24315 004021'03 200 01 0 00 000000# Unknown Line: > ; So do error blat 24316 004022'03 104 00 0 00 000076 k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 39-1 K20DSP MAC 9-Nov-23 18:22 show a line's characteristics 24317 004023'03 320 12 0 00 004024' 24318 000441'02 000000000000# 24319 001734'04 015 012 040 125 156 24320 004024'03 201 01 0 00 000101 numout q1, ^d8 ; Type whatever we did get passed 24321 004025'03 200 02 0 00 000005 24322 004026'03 201 03 0 00 000010 24323 004027'03 104 00 0 00 000224 24324 004030'03 320 14 0 00 004031' 24325 004031'03 endif. ;[223] Try the rest of it 24326 24327 txmsg < 24328 004031'03 200 01 0 00 000000# Controlling Type: > 24329 004032'03 104 00 0 00 000076 24330 004033'03 320 12 0 00 004034' 24331 000442'02 000000000000# 24332 001741'04 015 012 040 040 103 24333 004034'03 200 01 0 07 000000# move t1, ltname(q3) ;[223] Pick up address of the correct string 24334 004035'03 104 00 0 00 000076 PSOUT% ;[223] And type it 24335 004036'03 320 12 0 00 004037' erjmpr .+1 24336 24337 004037'03 200 04 0 00 000000* move t4, lclpar ;[223] Assume we're doing the controlling terminal 24338 004040'03 312 05 0 00 001521* came q1, mytty ;[223] BUT!! Is this the controlling terminal? 24339 004041'03 200 04 0 00 000000* move t4, opnpar ;[223] Parity tolerated will be set by k20net 24340 004042'03 322 04 0 00 004046' ifn. t4 ;[223] So, does the thing do parity? 24341 004043'03 200 01 0 00 000000# txmsg < [Parity]> ;[223] Yes, somebody will generate it, if asked 24342 004044'03 104 00 0 00 000076 24343 004045'03 320 12 0 00 004046' 24344 000443'02 000000000000# 24345 001746'04 040 133 120 141 162 24346 004046'03 endif. ;[223] Otherwise, nothing to say 24347 24348 004046'03 260 17 0 00 001052' call prntbd ;[210] Print some kind of baud rate maybe 24349 24350 004047'03 302 07 0 00 000004 caie q3, nw%tv ;[223] A TCP Virtual Terminal (TVT)? 24351 004050'03 254 00 0 00 004101' ifskp. ;[223] Yes, then let's display those specifics 24352 txmsg < 24353 004051'03 200 01 0 00 000000# TVT Binary: > ;[129] ARPAnet TVT binary mode. 24354 004052'03 104 00 0 00 000076 24355 004053'03 320 12 0 00 004054' 24356 000444'02 000000000000# 24357 001750'04 015 012 040 040 124 24358 004054'03 332 00 0 00 000000* ifme. tvtflg 24359 004055'03 254 00 0 00 004062' 24360 004056'03 200 01 0 00 000000# txmsg 24361 004057'03 104 00 0 00 000076 24362 004060'03 320 12 0 00 004061' 24363 000445'02 000000000000# 24364 001755'04 117 146 146 000 000 24365 004061'03 254 00 0 00 004065' else. 24366 004062'03 200 01 0 00 000000# txmsg 24367 004063'03 104 00 0 00 000076 24368 004064'03 320 12 0 00 004065' 24369 000446'02 000000000000# 24370 001756'04 117 156 000 000 000 24371 004065'03 endif. k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 39-2 K20DSP MAC 9-Nov-23 18:22 show a line's characteristics 24372 txmsg < 24373 004065'03 200 01 0 00 000000# TVT Negotiate: > ;[182] ARPAnet TVT discovery 24374 004066'03 104 00 0 00 000076 24375 004067'03 320 12 0 00 004070' 24376 000447'02 000000000000# 24377 001757'04 015 012 040 040 124 24378 004070'03 332 00 0 00 000000* ifme. tvtchk 24379 004071'03 254 00 0 00 004076' 24380 004072'03 200 01 0 00 000000# txmsg 24381 004073'03 104 00 0 00 000076 24382 004074'03 320 12 0 00 004075' 24383 000450'02 000000000000# 24384 001764'04 117 166 145 162 162 24385 004075'03 254 00 0 00 004101' else. 24386 004076'03 200 01 0 00 000000# txmsg 24387 004077'03 104 00 0 00 000076 24388 004100'03 320 12 0 00 004101' 24389 000451'02 000000000000# 24390 001766'04 101 165 164 157 155 24391 004101'03 endif. 24392 004101'03 endif. ;[223] End case TCP Virtual Terminal? 24393 24394 004101'03 200 01 0 00 000005 move t1, q1 ; Load line number 24395 004102'03 660 01 0 00 400000 txo t1, .ttdes ; Turn into a terminal designator (if not already one) 24396 004103'03 104 00 0 00 000303 GTTYP% ; Odd that buffers are returned here... 24397 004104'03 320 12 0 00 004106' %jsErr (,r) 24398 004105'03 254 00 0 00 004111' 24399 004106'03 265 01 0 00 002423* 24400 004107'03 000000000000# 24401 004110'03 254 00 0 00 003443* 24402 001770'04 125 156 141 142 154 24403 004111'03 200 04 0 00 000003 move t4, t3 ; Get the buffer counts out of the way 24404 24405 txmsg < 24406 004112'03 200 01 0 00 000000# Input Buffers: > ; Present the input buffer count 24407 004113'03 104 00 0 00 000076 24408 004114'03 320 12 0 00 004115' 24409 000452'02 000000000000# 24410 002000'04 015 012 040 040 111 24411 004115'03 201 01 0 00 000101 movei t1, .priou ; On the terminal 24412 004116'03 554 02 0 00 000004 hlrz t2, t4 ; Load input buffer count 24413 004117'03 201 03 0 00 000012 movei t3, ^d10 ; Is in base ten 24414 004120'03 104 00 0 00 000224 NOUT% 24415 004121'03 320 12 0 00 004123' %jsErr (,) 24416 004122'03 254 00 0 00 004126' 24417 004123'03 265 01 0 00 004106* 24418 004124'03 000000000000# 24419 004125'03 254 00 0 00 004126' 24420 002005'04 125 156 141 142 154 24421 24422 txmsg < 24423 004126'03 200 01 0 00 000000# Output Buffers: > ; Present the output buffer count 24424 004127'03 104 00 0 00 000076 24425 004130'03 320 12 0 00 004131' 24426 000453'02 000000000000# k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 39-3 K20DSP MAC 9-Nov-23 18:22 show a line's characteristics 24427 002017'04 015 012 040 040 117 24428 004131'03 201 01 0 00 000101 movei t1, .priou ; On the terminal 24429 004132'03 550 02 0 00 000004 hrrz t2,t4 ; Load output buffer count 24430 004133'03 201 03 0 00 000012 movei t3, ^d10 ; Is in base ten 24431 004134'03 104 00 0 00 000224 NOUT% 24432 004135'03 320 12 0 00 004137' %jsErr (,) 24433 004136'03 254 00 0 00 004142' 24434 004137'03 265 01 0 00 004123* 24435 004140'03 000000000000# 24436 004141'03 254 00 0 00 004142' 24437 002024'04 125 156 141 142 154 24438 24439 004142'03 263 17 0 00 000000 ret 24440 24441 cleans() 24442 k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 40 K20DSP MAC 9-Nov-23 18:22 Print Efficiency Factor 24443 subttl Print Efficiency Factor 24444 24445 ; Overhead calculations 24446 ; 24447 ; T1/ Output JFN or pointer, sacred 24448 ; T2/ Total characters in file(s) 24449 ; T3/ Total characters transferred, every single one 24450 ; 24451 ; In other words, t3 has what was necessary to communicate t2 24452 ; 24453 ; A factor over 1, how much compression is winning you 24454 ; under 1, how much the prefixing is costing you 24455 ; 24456 ; Describe various totals kept for $stat 24457 ; 24458 ; stot - total characters sent, including everything 24459 ; stchr - total characters all files 24460 ; rtot - total characters received, every single one of them 24461 ; rtchr - total characters all files 24462 ; 24463 ; Question, do we really need DOUBLE floating point? fltr will 'only' 24464 ; lose precision for a communications or combined file character total 24465 ; that is greater than 134,217,728 (2**27). 24466 ; 24467 ; This would be a file in excess of 52,429 pages, which is over 2/3's 24468 ; of an RP06. Even if some transfers happened over weekends, it is 24469 ; doubtful that this much data could have been sent--it was more 24470 ; common to just send a magnetic tape. Besides, disk space was 24471 ; EXPENSIVE. If you could afford the platters, you could certainly 24472 ; afford the cost of a tape, the tape mount, the mount time and the 24473 ; postage. 24474 ; 24475 ; Disk space is now effectively free, most structures being double 24476 ; RP07's, having a (then) gargantuan storage capability of over a 24477 ; gigabyte of ASCII text. However, since Kermit speeds are now in 24478 ; the megabyte range, a transfer of multiple large files could 24479 ; exceed 35 bit integer precision. This is certainly possibly if 24480 ; you are using your 20 to store .jpeg's or digital audio. 24481 24482 extern dfloat ; In k20sub (originally from eftpsa) 24483 24484 004143'03 265 16 0 00 004470' peffif: saveac ; Don't touch other temporaries 24485 ; First handle some simple cases 24486 004144'03 327 02 0 00 004150' ifle. t2 ; Is this a zero length file (or balony?) 24487 004145'03 120 02 0 00 000000# smsg <[100% Overhead]> ;Make it stand out 24488 004146'03 260 17 0 00 001050* 24489 000454'02 000000000000# 24490 000455'02 777777 777761 24491 002036'04 133 061 060 060 045 24492 004147'03 263 17 0 00 000000 ret ; That was easy ... 24493 004150'03 endif. 24494 ; Have a non-zero length file here? 24495 004150'03 326 03 0 00 004154' ife. t3 ; Zero length file (like NUL:)? 24496 004151'03 120 02 0 00 000000# smsg <[ZERO]> ; Make it stand out 24497 004152'03 260 17 0 00 004146* k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 40-1 K20DSP MAC 9-Nov-23 18:22 Print Efficiency Factor 24498 000456'02 000000000000# 24499 000457'02 777777 777772 24500 002042'04 133 132 105 122 117 24501 004153'03 263 17 0 00 000000 ret ; That was easy ... 24502 004154'03 endif. 24503 24504 004154'03 325 03 0 00 004160' ifl. t3 ; Impossible communications count? 24505 004155'03 120 02 0 00 000000# smsg <[ERROR]> ; Make it stand out 24506 004156'03 260 17 0 00 004152* 24507 000460'02 000000000000# 24508 000461'02 777777 777771 24509 002044'04 133 105 122 122 117 24510 004157'03 263 17 0 00 000000 ret ; That was easy ... 24511 004160'03 endif. 24512 ; Guess we have some real work to do 24513 004160'03 415 16 0 00 004202' block. ; Set up a stack frame for easier return 24514 004161'03 261 17 0 00 000016 24515 004162'03 265 16 0 00 004576' saveac ; Preserve some more registers 24516 remark t1,t2,t3,t4,t5 ; Can use these for this block 24517 004163'03 200 05 0 00 000002 move t5, t2 ; Save total characters in files 24518 004164'03 400 01 0 00 000000 setz t1, ; No integer high order 24519 004165'03 200 02 0 00 000003 move t2, t3 ; Load total characters communicated 24520 004166'03 260 17 0 00 001027* call dfloat ; Double float the double integer 24521 004167'03 263 17 0 00 000000 ret ; But couldn't 24522 004170'03 250 02 0 00 000005 exch t2, t5 ; Store floating low order and restore 24523 004171'03 200 04 0 00 000001 move t4, t1 ; Store floating high order 24524 004172'03 400 01 0 00 000000 setz t1, ; No integer high order 24525 004173'03 260 17 0 00 004166* call dfloat ; Double float the double integer 24526 004174'03 263 17 0 00 000000 ret ; But couldn't 24527 004175'03 200 03 0 00 000002 move t3, t2 ; Reposition low order 24528 004176'03 200 02 0 00 000001 move t2, t1 ; Reposition high order 24529 004177'03 113 02 0 00 000004 dfdv t2,t4 ; Divide extremely slowly 24530 004200'03 254 00 0 00 001434* retskp ; Win 24531 004201'03 263 17 0 00 000000 endbk. ; End block context, restore registers 24532 004202'03 263 17 0 00 000000 ret ; Passing any error up 24533 24534 004203'03 200 04 0 00 000000# peffi0: move t4,fmcntl ; Load format control 24535 004204'03 104 00 0 00 000235 DFOUT% ; Show us a nice number 24536 004205'03 320 14 0 00 004206' erjmps .+1 ; Don't touch precious t1!! 24537 24538 004206'03 316 04 0 00 000000# camn t4,fmcntl ; Overwritten with error? 24539 004207'03 263 17 0 00 000000 ret ; Nope, we're fine 24540 004210'03 334 00 0 00 000000 %ermsg (,r) 24541 004211'03 254 00 0 00 004215' 24542 004212'03 265 01 0 00 004137* 24543 004213'03 000000000000# 24544 004214'03 254 00 0 00 004110* 24545 002046'04 125 156 141 142 154 24546 004215'03 263 17 0 00 000000 ret ; Finally done 24547 k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 41 K20DSP MAC 9-Nov-23 18:22 Define hairy DFOUT% control word 24548 subttl Define hairy DFOUT% control word 24549 24550 000000 fmcntw==0 ; Initialize format control word 24551 24552 define blcntl (value,field,format) < 24553 ifnb , 24554 ifb , 24555 > 24556 24557 blcntl(.fldig,fl%sgn) ;;Sign control is start with a digit 24558 blcntl(.fllsp,fl%jus) ;;Justification is leading spaces 24559 blcntl(fl%one) ;;Output at least one digit, even if zero 24560 blcntl(fl%pnt) ;;Always print a decimal point 24561 blcntl(.flexn,fl%exp) ;;No exponent (too confusing) 24562 blcntl(fl%ovl) ;;Output any overflow 24563 blcntl(-1,fl%rnd) ;;Don't do any rounding 24564 blcntl(^d4,fl%fst) ;;Allow 9,999 improvement 24565 blcntl(^d4,fl%snd) ;;Allow .0001 degradation 24566 24567 chgsec(code,const) ;;This is a constant 24568 000462'02 024137 040400 fmcntl: fmcntw ; Final control word 24569 retsec ;;Back to previous .PSECT 24570 24571 if2 < purge blcntl > ;;Not needed after pass 2 24572 k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 42 K20DSP MAC 9-Nov-23 18:22 Calculate Giga, Mega, Kilo character rate 24573 subttl Calculate Giga, Mega, Kilo character rate 24574 24575 ; Uses double floating point to print a more readable, accurate byte rate. 24576 ; 24577 ; t3/ Total characters sent or received 24578 ; 24579 ; +1 - Some odd thing happened 24580 ; +2 - The math worked, at least 24581 24582 004216'03 gmkcps: extern dblcal ; Found with other math routines in k20tim 24583 004216'03 265 16 0 00 004610' saveac ; Need some more scratch 24584 24585 004217'03 415 16 0 00 004230' block. ;[207] Enter block context for better control flow 24586 004220'03 261 17 0 00 000016 24587 004221'03 265 16 0 00 004371' saveac ;[207] Used for DK10 double word 24588 004222'03 201 05 0 00 000471* movei q1, ewallt ;[207] Construct pointer to elapsed wall time 24589 004223'03 201 02 0 05 000017 movei t2, .datus(q1) ;[207] Load pointer to DK10 double word 24590 004224'03 120 03 0 02 000000 dmove t3, (t2) ;[207] Load DK10 tick wall time 24591 004225'03 327 03 0 00 004200* jumpg t3, RSKP ;[207] Non-zero high order is OK 24592 004226'03 327 04 0 00 004225* jumpg t4, RSKP ;[207] Ditto low order 24593 004227'03 263 17 0 00 000000 endbk. ;[207] End block context, restore registers 24594 004230'03 263 17 0 00 000000 ret ;[207] Zero ticks?? Uh, forget it 24595 004231'03 260 17 0 00 000000* call dblcal ; Calculate double floating character rate 24596 004232'03 263 17 0 00 000000 ret ; Failed 24597 004233'03 260 17 0 00 004264' call ranger ; Put result into kilo, mega or giga range 24598 004234'03 260 17 0 00 004203' call peffi0 ; Type it 24599 004235'03 260 17 0 00 004320' call chrsfx ; Puts in the right character suffix 24600 24601 004236'03 254 00 0 00 004226* retskp ; Worked!! 24602 k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 43 K20DSP MAC 9-Nov-23 18:22 Calculate Giga, Mega, Kilo baud rate 24603 subttl Calculate Giga, Mega, Kilo baud rate 24604 24605 ; Uses double floating point to print a more readable, accurate byte rate. 24606 ; 24607 ; t3/ Total characters sent or received 24608 24609 ; t4/ High order floating point bit rate (unranged) 24610 ; t5/ Low order, ditto 24611 24612 004237'03 204500 000000 baud: exp 10. ; Assume ten bits per character 24613 004240'03 000000 000000 0 ; Which is not valid for 110 baud 24614 24615 004241'03 gmkbps: extern dblcal ; Found with math routines in k20sub 24616 004241'03 265 16 0 00 004610' saveac ; Need some more scratch 24617 24618 004242'03 415 16 0 00 004252' block. ;[207] Enter block context for better control flow 24619 004243'03 261 17 0 00 000016 24620 004244'03 265 16 0 00 004550' saveac ;[207] Used for DK10 double word 24621 004245'03 201 02 0 00 000000# movei t2,.datus+ewallt;[207] Construct pointer to elapsed DK10 tick wall time 24622 004246'03 120 03 0 02 000000 dmove t3, (t2) ;[207] Load DK10 tick wall time 24623 004247'03 327 03 0 00 004236* jumpg t3, RSKP ;[207] Non-zero high order is OK 24624 004250'03 327 04 0 00 004247* jumpg t4, RSKP ;[207] Ditto low order 24625 004251'03 263 17 0 00 000000 endbk. ;[207] End block context, restore registers 24626 004252'03 263 17 0 00 000000 ret ;[207] Zero ticks?? Uh, forget it 24627 24628 004253'03 260 17 0 00 004231* call dblcal ; Calculate double floating character rate 24629 004254'03 263 17 0 00 000000 ret ; Failed 24630 004255'03 112 04 0 00 004237' dfmp t4, baud ; Scale to baud rate 24631 24632 004256'03 gmkbp1: remark ; Common exit epilogue 24633 004256'03 260 17 0 00 004264' call ranger ; Put result into kilo, mega or giga range 24634 004257'03 260 17 0 00 004203' call peffi0 ; Type it 24635 004260'03 260 17 0 00 004330' call baudsf ; Puts in the right suffix 24636 24637 004261'03 263 17 0 00 000000 ret 24638 k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 44 K20DSP MAC 9-Nov-23 18:22 Put result into kilo, mega, giga or tera range 24639 subttl Put result into kilo, mega, giga or tera range 24640 24641 ; Call: 24642 ; 24643 ; t1/ Output designator, unused, but preserved, anyway 24644 ; t4/ High order floating point bit rate (unranged) 24645 ; t5/ Low order, ditto 24646 ; 24647 ; Returns: +1, always 24648 ; 24649 ; t1/ Unmodified output designator 24650 ; t2/ High order, possibly ranged 24651 ; t3/ Low order, ditto 24652 ; t5/ Rate prefix (K, M, G, T), if any 24653 ; 24654 ; N.B., Since we are checking for less than 1,024 in the high 24655 ; order. It is unnecessary to compare the low order word, 24656 ; so we can bum a DCAM. 24657 ; 24658 ; A 'T' prefix means terabaud and is probably either wrong or 24659 ; otherwise delusional in some way. It should be doubted. 24660 24661 004262'03 213400 000000 kilo: 1024. ; Used for ranging (floating!!!) 24662 004263'03 000000 000000 0 ; Also used as double floating divisor 24663 24664 004264'03 265 16 0 00 004457' ranger: saveac ; Let's just leave that alone 24665 004265'03 311 04 0 00 004262' caml t4,kilo ; Into kilobaud already?? 24666 004266'03 254 00 0 00 004272' ifskp. ; Nope, not even, so not much to do, then 24667 004267'03 120 02 0 00 000004 dmove t2,t4 ; Load puny hundreds of baud rate (yech) 24668 004270'03 400 05 0 00 000000 setz t5, ; Not even a prefix character, sniff 24669 004271'03 263 17 0 00 000000 ret ; Well, that was easy 24670 004272'03 endif. ; Otherwise, at least in kilobaud 24671 24672 004272'03 113 04 0 00 004262' dfdv t4,kilo ; Reduce by ten orders of binary magnitude 24673 004273'03 311 04 0 00 004262' caml t4,kilo ; Into Megabaud? 24674 004274'03 254 00 0 00 004300' ifskp. ; No, but respectable anyway (or used to be) 24675 004275'03 120 02 0 00 000004 dmove t2,t4 ; Load kilobaud rate 24676 004276'03 201 05 0 00 000113 movei t5,"K" ; Load the Kilobaud prefix 24677 004277'03 263 17 0 00 000000 ret ; Return kilo or greater, but less than mega 24678 004300'03 endif. ; Otherwise, at least in megabaud 24679 24680 004300'03 113 04 0 00 004262' dfdv t4,kilo ; Reduce by ten orders of binary magnitude 24681 004301'03 311 04 0 00 004262' caml t4,kilo ; Into Gigabaud? 24682 004302'03 254 00 0 00 004306' ifskp. ; No, but at NI/CI speeds! 24683 004303'03 120 02 0 00 000004 dmove t2,t4 ; Load Megabaud rate 24684 004304'03 201 05 0 00 000115 movei t5,"M" ; Load the Megabaud prefix 24685 004305'03 263 17 0 00 000000 ret ; Return mega or greater, but less than giga 24686 004306'03 endif. ; Otherwise, at least in Gigabaud 24687 24688 004306'03 113 04 0 00 004262' dfdv t4,kilo ; Reduce by ten orders of binary magnitude 24689 004307'03 311 04 0 00 004262' caml t4,kilo ; Into Terabaud?? 24690 004310'03 254 00 0 00 004314' ifskp. ; No, but 1000BaseT is nothing to sneeze at! 24691 004311'03 120 02 0 00 000004 dmove t2,t4 ; Load Gigabaud rate 24692 004312'03 201 05 0 00 000107 movei t5,"G" ; Load the Gigabaud prefix 24693 004313'03 263 17 0 00 000000 ret ; Return giga or greater, but less that tera k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 44-1 K20DSP MAC 9-Nov-23 18:22 Put result into kilo, mega, giga or tera range 24694 004314'03 endif. ; Otherwise, some kind of incredible rate 24695 24696 remark Dude!! ; What kind of com gear are you using? 24697 004314'03 113 04 0 00 004262' dfdv t4,kilo ; Reduce by ten orders of binary magnitude 24698 004315'03 120 02 0 00 000004 dmove t2,t4 ; Load Terabaud rate 24699 004316'03 201 05 0 00 000124 movei t5,"T" ; Load Terabaud prefix 24700 004317'03 263 17 0 00 000000 ret ; Return from ...Fantasy Island... 24701 k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 45 K20DSP MAC 9-Nov-23 18:22 Print correct character suffix 24702 subttle Print correct character suffix 24703 24704 ; Call: 24705 ; 24706 ; t1/ Output designator (updated, if string) 24707 ; t5/ character prefix character (if any) 24708 24709 004320'03 201 02 0 00 000040 chrsfx: movei t2,.chspc ; Load a space 24710 004321'03 260 17 0 00 000000* call BOUTI% ;[216] Properly emit 24711 24712 004322'03 336 02 0 00 000005 skipn t2,t5 ; Load prefix character 24713 004323'03 254 00 0 00 004325' ifskp. ; If there is one, then type it 24714 004324'03 260 17 0 00 004321* call BOUTI% ;[216] Properly emit it 24715 004325'03 endif. 24716 24717 004325'03 120 02 0 00 000000# smsg 24718 004326'03 260 17 0 00 004156* 24719 000463'02 000000000000# 24720 000464'02 777777 777775 24721 002057'04 103 057 163 000 000 24722 004327'03 263 17 0 00 000000 ret 24723 k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 46 K20DSP MAC 9-Nov-23 18:22 Print correct baud suffix 24724 subttle Print correct baud suffix 24725 24726 ; Call: 24727 ; 24728 ; t1/ Output designator (updated, if string) 24729 ; t5/ character prefix character (if any) 24730 24731 004330'03 201 02 0 00 000040 baudsf: movei t2,.chspc ; Load a space 24732 004331'03 260 17 0 00 004324* call BOUTI% ;[216] Seperate number from text 24733 004332'03 336 02 0 00 000005 skipn t2,t5 ; Load prefix character 24734 004333'03 254 00 0 00 004335' ifskp. ; If there is one, then type it 24735 004334'03 260 17 0 00 004331* call BOUTI% ;[216] 24736 004335'03 endif. 24737 24738 004335'03 120 02 0 00 000000# smsg ; Accepted abbreviation for Baud 24739 004336'03 260 17 0 00 004326* 24740 000465'02 000000000000# 24741 000466'02 777777 777776 24742 002060'04 102 144 000 000 000 24743 004337'03 263 17 0 00 000000 ret 24744 24745 k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 47 K20DSP MAC 9-Nov-23 18:22 Determine the console's line number 24746 subttl Determine the console's line number 24747 24748 ;[223] Begin code insertion 24749 24750 ; Want to know this because the CTY is not a good line to use as you 24751 ; can't control what a front end might type as well as Tops-20's own 24752 ; needs. Using it can cause messages to never get seen, being simply 24753 ; thrown away as a packet resend. 24754 ; 24755 ; It is for this reason that the PANDA access control job (ACJ) will 24756 ; not allow the CTY to be assigned (either explicitly with ASND% or 24757 ; implicitly with an OPENF%) by anything else than an enabled WHEEL or 24758 ; OPERATOR. 24759 24760 chgsec(code,data) ; Need to store the data... 24761 000004'05 ctyerr: block 1 ; Any STDEV% error 24762 000005'05 ctydev: block 1 ;** DO NOT ; Console in 'device' format 24763 000006'05 ctynum: block 1 ; REORDER ** ; Bare line number of console 24764 retsec ; Restore psect assumptions 24765 24766 chgsec(code,const) ; The device name of the console is eternal 24767 000467'02 103 124 131 000 000 ctynam: asciz /CTY/ ; Note, NO device punctuation! 24768 retsec ; Restore psect assumptions 24769 24770 004340'03 inicty: entry inicty ; Called at program start up 24771 004340'03 265 16 0 00 004357' saveac ; Let's not touch anything 24772 24773 004341'03 561 01 0 00 000000# hrroi t1, ctynam ; Tops-20 pointer to CTY device name 24774 004342'03 104 00 0 00 000120 STDEV% ; Turn the string into a device 24775 004343'03 320 12 0 00 004345' ifje. r ; This is REALLY supposed to be defined... 24776 004344'03 254 00 0 00 004351' 24777 004345'03 202 01 0 00 000000# movem t1, ctyerr ; Store error for the curious 24778 004346'03 477 02 0 00 000003 setob t2, t3 ; Cons up a pair bogus talismen 24779 004347'03 124 02 0 00 000000# dmovem t2, ctydev ; Flag that they are useless 24780 004350'03 263 17 0 00 000000 ret ; Go no further 24781 004351'03 endif. ; End STDEV% error handling 24782 24783 remark ; Otherwise, worked!! 24784 004351'03 202 02 0 00 000000# movem t2, ctydev ; Save in device format for ASND% check 24785 004352'03 620 02 0 00 400000 txz t2, .ttdes ; Shut off terminal designator if half word 24786 004353'03 552 02 0 00 000000# hrrzm t2, ctynum ; Save just the line number 24787 004354'03 201 04 0 00 601405 movx t4, lstrx1 ; Say it worked fine 24788 004355'03 202 04 0 00 000000# movem t4, ctyerr ; Store (lack of) error for the curious 24789 24790 004356'03 263 17 0 00 000000 ret ; Finally done 24791 24792 ;[223] End code insertion 24793 k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 48 K20DSP MAC 9-Nov-23 18:22 Finishing items 24794 subttl Finishing items 24795 24796 xlist ; Save the trees!! 24797 list ; Resume listing 24798 24799 .endps code ; Close the code .psect 24800 k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 49 K20DSP MAC 9-Nov-23 18:22 Extended Text for Display 24801 subttl Extended Text for Display 24802 24803 .psect etext ;[209] Need to put some things in extended text 24804 24805 remark Various types of parity 24806 24807 002061'04 116 157 156 145 000 enone: asciz/None/ 24808 002062'04 123 160 141 143 145 espac: asciz/Space/ 24809 002064'04 115 141 162 153 000 emark: asciz/Mark/ 24810 002065'04 117 144 144 000 000 eodd: asciz/Odd/ 24811 002066'04 105 166 145 156 000 eeven: asciz/Even/ 24812 24813 remark Various states of debugging 24814 24815 002067'04 117 146 146 000 000 deboff: asciz/Off/ 24816 002070'04 123 164 141 164 145 debsts: asciz/States/ 24817 002072'04 120 141 143 153 145 debpks: asciz/Packets/ 24818 24819 .endps etext ; Close out section 1 text 24820 24821 remark Pointers to extended text which MUST be in section zero 24822 24823 .psect const ; Constants 24824 24825 000470'02 000000000000# debtab: .px7!deboff 24826 000471'02 000000000000# .px7!debsts 24827 000472'02 000000000000# .px7!debpks 24828 24829 .endps const 24830 k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 50 K20DSP MAC 9-Nov-23 18:22 Display Module local storage 24831 subttl Display Module local storage 24832 24833 .psect data ; Writable storage 24834 000007'05 000000 000000 pvbaud:: exp 0,0 ; PTY: virtual baud rate 24835 000011'05 000000 000000 pibaud:: exp 0,0 ; PIP: virtual baud rate 24836 000013'05 000000 000000 nlbaud:: exp 0,0 ; NUL: virtual baud rate 24837 000015'05 000000 000000 dnbaud:: exp 0,0 ; DECnet virtual baud rate 24838 24839 .endps data ; End of data psect 24840 24841 .xcmsy ;[194] Ditch MACSYM junk 24842 end NO ERRORS DETECTED PROGRAM BREAK IS 000000 PSECT 1 BREAK IS 000025 FOR TEXT PSECT 2 BREAK IS 000473 FOR CONST PSECT 3 BREAK IS 004620 FOR CODE PSECT 4 BREAK IS 002074 FOR ETEXT PSECT 5 BREAK IS 000017 FOR DATA CPU TIME USED 00:01.884 137P CORE USED k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 19:42 30-Mar-24 Page S-1 K20DSP MAC 9-Nov-23 18:22 SYMBOL TABLE BLIP 000005 NO%OOV 020000 000000 sin T2 000002 spd .XTRST 000000 ext BOUT 104000 000051 int NO%RDX 777777 sin T3 000003 spd BOUT% 104000 000051 int NOUT% 104000 000224 int T4 000004 spd BOUTI% 000000 ext NTLINE 777777 spd T5 000005 spd CALL 260740 000000 NTTYPE 000777 000000 spd TEXT 000000 ext CALLRE 254000 000000 spd NW%MC 000003 sin TT%OSP 400000 000000 sin CCOFF 000000 ext NW%NNT 000000 sin TTYJFN 000000 ext CCON 000000 ext NW%PT 000002 sin XMOVEI 415000 000000 int CODE 000000 ext NW%TV 000004 sin $PRIOU 000000 ext CONST 000000 ext ODCNV% 104000 000222 int %%JSER 000000 ext CRLF 000000 ext ODTIM% 104000 000220 int %%SMSG 000000 ext CRLFLF 000000 ext OF%BSZ 770000 000000 sin ..MSK 777777 777777 spd CX 000016 OF%RD 200000 sin .A16 000016 spd DATA 000000 ext OPENF% 104000 000021 int .CHCRT 000015 sin DEBUG 000014 spd OT%4YR 010000 000000 sin .CHDBQ 000042 spd DEVST% 104000 000121 int OT%DAM 004000 000000 sin .CHDEL 000177 sin DFOUT% 104000 000235 int OT%DAY 200000 000000 sin .CHLFD 000012 sin DV%TYP 000777 000000 sin OT%FDY 100000 000000 sin .CHNUL 000000 sin DVCHR% 104000 000117 int OT%FMN 020000 000000 sin .CHSPC 000040 sin DXFULL 000000 spd OT%SCL 000001 000000 sin .DATUS 000017 spd ERJMP 320700 000000 int OT%SPA 002000 000000 sin .DVADS 000025 sin ERJMPR 320500 000000 int P 000017 .DVCDP 000021 sin ERJMPS 320600 000000 int P1 000011 spd .DVCDR 000010 sin ERRPTR 000000 ext P2 000012 spd .DVDCN 000022 sin ERSTR 104000 000011 int P3 000013 spd .DVDES 600000 sin ESOUT% 104000 000313 int P4 000014 spd .DVDSK 000000 sin ETEXT 000000 ext P5 000015 spd .DVDSP 000006 sin FILJFN 000000 ext PARS1 000000 ext .DVDTA 000003 sin FL%EXP 003000 000000 sin PARS2 000000 ext .DVFE 000011 sin FL%FST 770000 sin PARS3 000000 ext .DVLPT 000007 sin FL%JUS 140000 000000 sin PARS4 000000 ext .DVMTA 000002 sin FL%ONE 020000 000000 sin PARS5 000000 ext .DVNUL 000015 sin FL%OVL 000100 000000 sin PBOUT 104000 000074 int .DVPIP 000403 sin FL%PNT 004000 000000 sin PBOUT% 104000 000074 int .DVPLT 000017 sin FL%RND 000037 000000 sin PM%RD 100000 000000 sin .DVPTP 000005 sin FL%SGN 600000 000000 sin PMAP% 104000 000056 int .DVPTR 000004 sin FL%SND 007700 sin PSOUT 104000 000076 int .DVPTY 000013 sin FLOUT 104000 000233 int PSOUT% 104000 000076 int .DVSRV 000023 sin FLOUT% 104000 000233 int Q1 000005 spd .DVTTY 000012 sin GETNTI 000000 ext Q2 000006 spd .FHSLF 400000 sin GS%NAM 000200 000000 sin Q3 000007 spd .FLDIG 000000 sin GS%OPN 400000 000000 sin Q4 000010 spd .FLEXN 000000 sin GTSTS% 104000 000024 int Q5 000011 spd .FLLSP 000000 sin GTTYP% 104000 000303 int QLOG 000000 ext .FLSPC 000001 sin IDCNV% 104000 000223 int R 000000 ext .FP 000015 spd JFNS 104000 000030 int RET 263740 000000 .FPAC 000005 spd JFNS% 104000 000030 int RFMOD% 104000 000107 int .NULIO 377777 sin LSTRX1 601405 int RFPTR% 104000 000043 int .NWTTF 000004 sin MAPORG 007000 spd RSKP 000000 ext .PRIOU 000101 sin MAPPAG 000007 spd SFMOD% 104000 000110 int .PX7 610001 000000 spd MAXTIM 267460 SIZEF% 104000 000036 int .SAC 000016 N%AREA 176000 spd SOUT% 104000 000053 int .SAV1 000000 ext N%NODE 001777 spd STDEV% 104000 000120 int .SAV2 000000 ext NO%COL 000177 000000 sin STRBLW 001000 spd .SAV3 000000 ext NO%LFL 100000 000000 sin T1 000001 spd .TTDES 400000 sin k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 19:42 30-Mar-24 Page S-2 K20DSP MAC 9-Nov-23 18:22 SYMBOL TABLE FOR PSECT TEXT ASTNUL 000002' DVPUNC 000006' NULNAM 000000' UNKTXT 000004' k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 19:42 30-Mar-24 Page S-3 K20DSP MAC 9-Nov-23 18:22 SYMBOL TABLE FOR PSECT CONST CTYNAM 000467' DEBTAB 000470' FMCNTL 000462' GENTAB 000136' LTNAME 000432' NEWMN 000403' NUL5 000002' NULPTR 000000' PER 000035 422752 spd PERCNT 000100' PERIO4 000405' PERIO8 000406' PERIOD 000404' TABLE 000407' k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 19:42 30-Mar-24 Page S-4 K20DSP MAC 9-Nov-23 18:22 SYMBOL TABLE FOR PSECT CODE ABTFIL 002212' ext INDEFW 003303' ext R 004214' ext VCHRCN 003564' ext ASCDEV 001262' int INICTY 004340' ent RANGER 004264' VSICT 003622' ext AUTBYT 002132' ext INPCBF 003576' ext REOLCH 002530' ext VSIMX 003642' ext BAUD 004237' INTIMA 003267' ext ROSNPT 001464' ext VSITC 003632' ext BAUDSF 004330' ITSFLG 002176' ext RPADCH 002516' ext VSOCT 003654' ext BCTR 002634' ext KILO 004262' RPADN 002477' ext VSOMX 003674' ext BCTU 002642' ext LCLPAR 004037' ext RPAUSE 003022' ext VSOTC 003664' ext BOUTI% 004334' ext LINCHR 004012' RPAUSF 002766' ext VTERMF 001766' ext BRK 001753' ext LOCAL 003200' ext RPSIZ 002454' ext WHAKFP 000427' ent CARIER 002004' ext LOGBSZ 002435' ext RPTFLG 002621' ext XFNFLG 002162' ext CHKLIN 002003' ext LOGJFN 002357' ext RPTQ 002623' ext $DFCHR 000015 000003 spd CHRSFX 004320' MACTAB 003424' ext RQUOTE 002542' ext $DFETI 000015 000007 spd CLRCNO 000000' ent MARK 001641' ext RSKP 004250' ext $DFSPE 000015 000013 spd CRLF 003431' ext MAXTRY 003122' ext RSTHDR 002561' ext $DICHR 000015 000001 spd CRLFLF 004403' ext MDMLIN 001557' ext RTCHR 000762' ext $DIETI 000015 000005 spd DBLCAL 004253' ext MHPTOD 002342' ext RTIMOU 002720' ext $DISPE 000015 000011 spd DBLSCL 001024' ext MOON 003434' RTOT 000534' ext $EDNO 000000 ext DELAY 003107' ext MYNAME 001546' ext SEC 000000 ext $MCHRS 003372' ext DELAYF 003063' ext MYNODE 001437' ext SEOLCH 002535' ext $MNVER 000000 ext DEVUNT 001310' MYTTY 004040' ext SESFLG 002024' ext $PRIOU 000016' ext DFLOAT 004173' ext NBICT 003706' ext SESJFN 002022' ext $SHDAY 001401' ent DISPER 003543' NDVFXP 001423' ext SPACE 001637' ext $SHDEB 002317' ent DNULBD 001176' ext NETJFN 002001' ext SPADCH 002523' ext $SHFIL 002127' ent DPIPBD 001216' ext NNAK 000656' ext SPADN 002507' ext $SHINP 003220' ent DPTYBD 001156' ext NODNAM 001430' ext SPAUSE 003036' ext $SHLIN 001411' ent DSRVBD 001240' ext NODNUM 001441' ext SPAUSF 003000' ext $SHMAC 003336' ent DUPLEX 001717' ext NONE 001651' ext SPEED 001745' ext $SHMAX 003433' DURTIM 000500' ext NRTFLG 002115' ext SPSIZ 002464' ext $SHO4A 001714' EBQ 002603' ext NSICI 003716' ext SQUOTE 002547' ext $SHO4E 002022' EBQFLG 002601' ext NSIMX 003736' ext SRVTIM 003163' ext $SHO4F 002115' EBQR 002566' ext NSITC 003726' ext SSTHDR 002554' ext $SHO4H 002124' EBTFLG 002136' ext NTIBLK 000000 ext STATXT 004446' ext $SHO4X 002124' ECHO 000317' ent NTIMOU 000650' ext STCHR 000761' ext $SHOW3 001575' ECHO1 000354' ODD 001643' ext STIMOU 002735' ext $SHOW4 001632' ECHO2 000402' OPNPAR 004041' ext STOT 000535' ext $SHPKT 002450' ent ERRPTR 000631' ext PARITY 001635' ext STRBUF 000300' ext $SHTIM 002651' ent ESCAPE 001630' ext PARPKO 001653' ext STRC 000000 ext $SHTOP 001334' ent EVEN 001645' ext PARRCK 000000 ext STRPTR 000000 ext $SHVER 001334' ent EWALLT 004222' ext PARS2 001323' ext TBTFLG 002134' ext $SRVT 000446' ent EXPUNG 002226' ext PARS3 001145' ext TIMDEV 001151' ext $STAT 000447' ent FLOW 001612' ext PARS4 001147' ext TIMERX 000674' ext $STAT4 000625' FMCNTW 024137 040400 spd PAUSE 000642' ext TLGJFN 002236' ext $STATJ 000663' GENPAR 000302' ext PDCODF 002326' ext TTIBIN 000621' ext $STATX 000640' GETNTI 002120' ext PEFFI0 004203' TTILDB 000577' ext $STATZ 000700' GMKBP1 004256' PEFFIF 004143' TTIMAX 000613' ext $TIME 001125' int GMKBPS 004241' PRNTBD 001052' TTIPAR 001702' ext $TIME1 001323' GMKCPS 004216' PRNTBS 001064' TTISIN 000605' ext $VERNO 000000 ext HANDSH 001600' ext PRNTBV 001107' TTYJFN 002002' ext $WHO 000000 ext IFCRLF 003743' ent PRNTCM 001114' TTYNUM 002122' ext %%JSER 004212' ext IMXTRY 003132' ext PRNTNV 001101' TVTCHK 004070' ext %%SMSG 004336' ext INCASE 003223' ext PSPEEF 000703' TVTFLG 004054' ext ....Z 224100 060400 INDEFC 003317' ext PTYFLG 001770' ext TYPFIL 000054' ent ...X 000002 spd INDEFF 003237' ext PTYNAM 001537' ext TYPNAM 000020' ent ..0005 000005' spd INDEFS 003316' ext PUTC 003765' ent VBICT 003552' ext ..0006 000010' spd INDEFT 003251' ext QLOG 000425' ext VBOCT 003610' ext ..0014 000015' spd k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 19:42 30-Mar-24 Page S-5 K20DSP MAC 9-Nov-23 18:22 SYMBOL TABLE FOR PSECT CODE ..0015 000017' spd ..0533 001004' spd ..1257 001714' spd ..1764 002525' spd ..0023 000035' spd ..0534 001007' spd ..1271 001726' spd ..2020 002576' spd ..0024 000053' spd ..0541 001034' spd ..1272 001731' spd ..2025 002601' spd ..0031 000031' spd ..0542 001017' spd ..1303 001742' spd ..2032 002606' spd ..0032 000034' spd ..0554 001040' spd ..1311 001763' spd ..2037 002611' spd ..0040 000041' spd ..0555 001043' spd ..1316 001766' spd ..2046 002626' spd ..0041 000044' spd ..0570 001100' spd ..1325 001776' spd ..2053 002631' spd ..0047 000050' spd ..0604 001151' spd ..1332 002001' spd ..2064 002667' spd ..0050 000053' spd ..0616 001172' spd ..1337 002012' spd ..2071 002672' spd ..0052 000066' spd ..0624 001165' spd ..1344 002015' spd ..2076 002701' spd ..0057 000106' spd ..0625 001170' spd ..1351 002022' spd ..2103 002704' spd ..0066 000077' spd ..0626 001164' spd ..1363 002115' spd ..2106 002756' spd ..0067 000103' spd ..0644 001212' spd ..1365 002032' spd ..2113 002761' spd ..0077 000111' spd ..0652 001205' spd ..1372 002035' spd ..2124 002732' spd ..0100 000131' spd ..0653 001210' spd ..1403 002051' spd ..2125 002735' spd ..0110 000122' spd ..0654 001204' spd ..1404 002115' spd ..2136 002747' spd ..0111 000126' spd ..0672 001232' spd ..1422 002074' spd ..2137 002752' spd ..0115 000154' spd ..0700 001225' spd ..1423 002076' spd ..2156 002775' spd ..0122 000155' spd ..0701 001230' spd ..1425 002115' spd ..2157 003000' spd ..0131 000144' spd ..0702 001224' spd ..1442 002124' spd ..2166 003012' spd ..0132 000150' spd ..0720 001254' spd ..1452 002154' spd ..2167 003015' spd ..0142 000160' spd ..0726 001247' spd ..1457 002157' spd ..2174 003052' spd ..0143 000162' spd ..0727 001252' spd ..1460 002150' spd ..2210 003033' spd ..0151 000207' spd ..0730 001246' spd ..1465 002153' spd ..2211 003036' spd ..0152 000210' spd ..0750 001277' spd ..1466 002144' spd ..2222 003044' spd ..0161 000177' spd ..0751 001302' spd ..1473 002147' spd ..2223 003047' spd ..0162 000203' spd ..0752 001307' spd ..1506 002170' spd ..2232 003063' spd ..0172 000213' spd ..0775 001314' spd ..1513 002173' spd ..2237 003116' spd ..0173 000216' spd ..0776 001321' spd ..1522 002204' spd ..2246 003071' spd ..0175 000233' spd ..1005 001353' spd ..1527 002207' spd ..2247 003116' spd ..0212 000242' spd ..1013 001366' spd ..1536 002220' spd ..2256 003103' spd ..0213 000244' spd ..1021 001376' spd ..1543 002223' spd ..2257 003106' spd ..0221 000245' spd ..1023 001502' spd ..1552 002233' spd ..2272 003173' spd ..0222 000316' spd ..1035 001441' spd ..1570 002311' spd ..2277 003176' spd ..0232 000304' spd ..1044 001436' spd ..1571 002314' spd ..2306 003157' spd ..0235 000304' spd ..1051 001441' spd ..1576 002254' spd ..2307 003162' spd ..0245 000346' spd ..1057 001464' spd ..1577 002310' spd ..2320 003215' spd ..0253 000352' spd ..1063 001457' spd ..1612 002267' spd ..2334 003231' spd ..0264 000401' spd ..1075 001476' spd ..1613 002271' spd ..2341 003234' spd ..0300 000426' spd ..1111 001517' spd ..1615 002310' spd ..2354 003261' spd ..0311 000432' spd ..1115 001534' spd ..1642 002353' spd ..2355 003264' spd ..0312 000435' spd ..1122 001554' spd ..1644 002342' spd ..2366 003275' spd ..0313 000445' spd ..1127 001530' spd ..1651 002353' spd ..2373 003300' spd ..0331 000504' spd ..1130 001533' spd ..1652 002336' spd ..2402 003311' spd ..0332 000503' spd ..1143 001575' spd ..1657 002341' spd ..2407 003333' spd ..0377 000557' spd ..1153 001572' spd ..1664 002350' spd ..2416 003324' spd ..0400 000561' spd ..1160 001575' spd ..1671 002353' spd ..2417 003331' spd ..0407 000570' spd ..1173 001606' spd ..1676 002445' spd ..2423 003344' spd ..0414 000572' spd ..1174 001607' spd ..1712 002442' spd ..2452 003414' spd ..0461 000737' spd ..1201 001620' spd ..1713 002445' spd ..2453 003431' spd ..0466 000761' spd ..1206 001623' spd ..1720 002375' spd ..2466 003461' spd ..0476 000732' spd ..1213 001632' spd ..1721 002431' spd ..2475 003470' spd ..0503 000752' spd ..1225 001671' spd ..1734 002410' spd ..2476 003500' spd ..0514 000767' spd ..1235 001674' spd ..1735 002412' spd ..2504 003501' spd ..0526 001001' spd ..1243 001700' spd ..1737 002431' spd ..2505 003542' spd k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 19:42 30-Mar-24 Page S-6 K20DSP MAC 9-Nov-23 18:22 SYMBOL TABLE FOR PSECT CODE ..2512 003520' spd ..2514 003556' spd ..2524 003570' spd ..2534 003602' spd ..2544 003614' spd ..2554 003646' spd ..2570 003700' spd ..2604 003742' spd ..2626 003756' spd ..2634 003764' spd ..2642 004000' spd ..2652 004007' spd ..2663 004031' spd ..2675 004046' spd ..2711 004101' spd ..2715 004062' spd ..2722 004065' spd ..2731 004076' spd ..2736 004101' spd ..2760 004150' spd ..2771 004154' spd ..3002 004160' spd ..3014 004202' spd ..3020 004230' spd ..3022 004252' spd ..3027 004272' spd ..3035 004300' spd ..3043 004306' spd ..3051 004314' spd ..3057 004325' spd ..3070 004335' spd ..3101 004345' spd ..3102 004351' spd ..CSC 000004 spd ..CSN 000003 spd ..IFT 000000 spd ..JX1 400000 000000 spd ..MX1 601405 spd ..MX2 000001 spd ..NV 000015 spd ..PST 000003 spd ..TRR 000010 spd ..TX1 400000 spd ..TX2 000001 spd .XTRST 000704' ext k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 19:42 30-Mar-24 Page S-7 K20DSP MAC 9-Nov-23 18:22 SYMBOL TABLE FOR PSECT ETEXT DEBOFF 002067' DEBPKS 002072' DEBSTS 002070' EEVEN 002066' EMARK 002064' ENONE 002061' EODD 002065' ESPAC 002062' k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 19:42 30-Mar-24 Page S-8 K20DSP MAC 9-Nov-23 18:22 SYMBOL TABLE FOR PSECT DATA CTYDEV 000005' CTYERR 000004' CTYNUM 000006' DEVTXT 000000' DNBAUD 000015' int NLBAUD 000013' int PIBAUD 000011' int PVBAUD 000007' int k20pdc - Kermit (Visual) Packet Decoding MACRO %53B(1254)-4 19:42 30-Mar-24 Page 1 K20PDC MAC 27-Mar-24 20:17 24843 title k20pdc - Kermit (Visual) Packet Decoding 24844 24845 ; All display code was removed from k20mit and moved to the k20dsp 24846 ; module as part of Edit 194 to address the issue of a very large 24847 ; single source file that unexpectedly began generating MCRNEC errors. 24848 ; 24849 ; With the exception the 'main' k20mit module, any time a module gets 24850 ; near 50 pages, a code split happens. Thus far, this has happened 24851 ; with: 24852 ; 24853 ; k20ioc - Kermit INPUT/OUTPUT/TRANSMIT support 24854 ; k20mac - Kermit Macros (DEFINE command) 24855 ; k20srv - Kermit Server Commands 24856 k20pdc - Kermit (Visual) Packet Decoding MACRO %53B(1254)-4 19:42 30-Mar-24 Page 2 K20PDC MAC 27-Mar-24 20:17 Preliminaries 24857 subttl Preliminaries 24858 24859 search monsym,macsym,cmd,k20unv ;[194] 24860 cmdacs ^ ;Clean up p1-p4 definitions 24861 24862 sall ; Tidy listing 24863 .directive flblst ; We don't need to see all the ASCIZ bytes... 24864 24865 extern rquote ; Receive quote character 24866 extern squote ; Send quote character 24867 24868 extern $closd ; Close debugging log 24869 extern logjfn ; Debugging log JFN 24870 extern BOUTI% ; Byte output to JFN or append to string 24871 extern %%smsg ; smsg macro support 24872 remark ; N.B., %%smsg *ONLY* handles OWGP's!!!!! 24873 24874 repeat 0,< remark ;;;; ; Put these in later to bum a BOUT% 24875 extern s8ccv7 ; String eight controlified convert to seven 24876 extern trnbuf ; Where it leaves this 24877 > 24878 .psect code/ronly ; Pure code. Pure Heaven 24879 k20pdc - Kermit (Visual) Packet Decoding MACRO %53B(1254)-4 19:42 30-Mar-24 Page 3 K20PDC MAC 27-Mar-24 20:17 DIAMSG Print packet type and number if debugging "states" 24880 subttl DIAMSG Print packet type and number if debugging "states" 24881 24882 ;[114] DIAMSG 24883 ; 24884 ; Enter with: 24885 ; t1/ packet type 24886 ; t2/ packet number 24887 ; t4/ pointer to data 24888 ; logjfn/ debugging log file jfn 24889 ; Returns +1 always, with all ACs unchanged. 24890 24891 000000'01 diamsg: entry diamsg ;[221] Moved here from k20mit 24892 000000'01 306 14 0 00 000001 cain debug, 1 ; Only for protocol debugging. 24893 000001'01 336 00 0 00 000000* skipn logjfn ; Got a log JFN? 24894 000002'01 263 17 0 00 000000 ret ; Nope, forget it. 24895 24896 000003'01 265 16 0 00 001012' saveac ; Save these. 24897 000004'01 405 01 0 00 000177 andi t1, 177 ;[235] Strip off any parity 24898 000005'01 261 17 0 00 000001 push p, t1 ; Save packet type for sec. 24899 000006'01 200 01 0 00 000001* move t1, logjfn ; Get debugging log file JFN. 24900 000007'01 201 03 0 00 000010 movei t3, ^d8 ;[194] Tops-20 displays ASCII numeric as Octal 24901 000010'01 104 00 0 00 000224 NOUT% 24902 000011'01 320 12 0 00 000013' ifje. r ;[194] Catch and ignore error 24903 000012'01 254 00 0 00 000016' 24904 000013'01 262 17 0 00 000002 pop p, t2 ;[194] Keep the stack straight!!!!! 24905 000014'01 254 00 0 00 000031' jrst deberr ;[174] 24906 000015'01 254 00 0 00 000017' else. ;[194] Otherwise, worked 24907 000016'01 262 17 0 00 000002 pop p, t2 ; Pop packet type 24908 000017'01 endif. ;[194] 24909 000017'01 260 17 0 00 000000* call BOUTI% 24910 000020'01 302 02 0 00 000107 caie t2, "G" ; Generic command? 24911 000021'01 254 00 0 00 000026' ifskp. ;[194] Yes, first character of one 24912 000022'01 200 03 0 00 000004 move t3, t4 ; Log the first character of the data packet. 24913 000023'01 134 02 0 00 000003 ildb t2, t3 24914 000024'01 405 02 0 00 000177 andi t2, 177 ;[235] Strip off any parity 24915 000025'01 260 17 0 00 000017* call BOUTI% ;[174] 24916 000026'01 endif. ;[194] 24917 24918 000026'01 201 02 0 00 000040 diamsz: movei t2, " " ; A space for delimitation. 24919 000027'01 260 17 0 00 000025* call BOUTI% ;[174] 24920 000030'01 263 17 0 00 000000 ret 24921 24922 k20pdc - Kermit (Visual) Packet Decoding MACRO %53B(1254)-4 19:42 30-Mar-24 Page 4 K20PDC MAC 27-Mar-24 20:17 Handle I/O errors writing to debugging log file. 24923 subttl Handle I/O errors writing to debugging log file. 24924 24925 ;[174] 24926 24927 000031'01 deberr: entry deberr ;[221] Moved here from k20mit 24928 txmsg < 24929 000031'01 200 01 0 00 000000# %KERMIT-20: Error writing debug log file - > 24930 000032'01 104 00 0 00 000076 24931 000033'01 320 12 0 00 000034' 24932 000000'02 000000000000# 24933 000000'03 015 012 045 113 105 24934 000034'01 201 01 0 00 000101 movei t1, .priou 24935 000035'01 525 02 0 00 400000 hrloi t2, .fhslf 24936 000036'01 400 03 0 00 000000 setz t3, 24937 000037'01 104 00 0 00 000011 ERSTR% 24938 000040'01 320 14 0 00 000042' erjmps .+2 ; Ignore its strange return 24939 000041'01 320 14 0 00 000042' erjmps .+1 ; Ignore its stranger return 24940 txmsg < 24941 000042'01 200 01 0 00 000000# > 24942 000043'01 104 00 0 00 000076 24943 000044'01 320 12 0 00 000045' 24944 000001'02 000000000000# 24945 000012'03 015 012 000 000 000 24946 000045'01 400 01 0 00 000000 setz t1, ; Close the log file if possible 24947 000046'01 260 17 0 00 000000* call $closd ;[194] ; and turn off debug log. 24948 000047'01 263 17 0 00 000000 ret 24949 k20pdc - Kermit (Visual) Packet Decoding MACRO %53B(1254)-4 19:42 30-Mar-24 Page 5 K20PDC MAC 27-Mar-24 20:17 Packet Decode 24950 subttl Packet Decode 24951 24952 ; t1/ LH, "S" or "R" (Sending or Receiving 24953 ; RH, Debugging log JFN or terminal device id 24954 ; t2/ Point 8, packet to send or packet we got 24955 24956 000050'01 pdecod: entry pdecod ; Called by k10mit packet routines 24957 remark ; *MUST* be saved by caller!!!! 24958 000050'01 265 16 0 00 001024' saveac ; Needs some more registers 24959 24960 000051'01 337 13 0 00 000006* skipg p3, logjfn ; Do we have a logging JFN? (can be .priou) 24961 000052'01 263 17 0 00 000000 ret ; No, so don't log anything 24962 000053'01 554 11 0 00 000001 hlrz p1, t1 ; Load the packet context 24963 000054'01 621 01 0 00 777777 tlz t1, -1 ; And stomp it out of the register 24964 000055'01 120 05 0 00 000001 dmove q1, t1 ; Let's save these for a moment 24965 000056'01 120 07 0 00 000003 dmove q3, t3 ; all of the temporaries 24966 24967 000057'01 415 16 0 00 000067' block. ; Carefully review the context character 24968 000060'01 261 17 0 00 000016 24969 000061'01 306 11 0 00 000122 cain p1, "R" ; Receiving? 24970 000062'01 254 00 0 00 000000* retskp ; Yes, this is valid 24971 000063'01 306 11 0 00 000123 cain p1, "S" ; Sending? 24972 000064'01 254 00 0 00 000062* retskp ; Yes, that's valid, too 24973 000065'01 263 17 0 00 000000 ret ; Otherwise, some kind of bad 24974 000066'01 263 17 0 00 000000 endbk. ; End of block context 24975 000067'01 254 00 0 00 000076' ifskp. ; +2 means we thought it was fine 24976 000070'01 306 11 0 00 000122 cain p1, "R" ; Receiving? 24977 000071'01 254 00 0 00 000107' callret rpdecd ; Yes, go do something about that 24978 000072'01 306 11 0 00 000123 cain p1, "S" ; Receiving? 24979 000073'01 254 00 0 00 000152' callret spdecd ; Yes, go do something about that, too 24980 000074'01 254 00 0 00 000076' anskp. ; ??? Shouldn't happen--we just checked 24981 000075'01 254 00 0 00 000106' else. ; Otherwise, unknown context 24982 000076'01 200 01 0 00 000013 move t1, p3 ; Pick up the log JFN 24983 000077'01 120 02 0 00 000000# smsg <% "> ; Begin confusion blat 24984 000100'01 260 17 0 00 000000* 24985 000002'02 000000000000# 24986 000003'02 777777 777775 24987 000013'03 045 040 042 000 000 24988 000101'01 200 11 0 00 000011 move p1, p1 ; Pick up the unknown context character 24989 000102'01 260 17 0 00 000027* call BOUTI% ; Put it into the log file 24990 smsg <" is not a known transmission context 24991 000103'01 120 02 0 00 000000# > ; Finish the blat and close off the line 24992 000104'01 260 17 0 00 000100* 24993 000004'02 000000000000# 24994 000005'02 777777 777731 24995 000014'03 042 040 151 163 040 24996 24997 000105'01 263 17 0 00 000000 ret ; Get out of here and don't risk bogosity 24998 000106'01 endif. ; End case context character scrub 24999 25000 000106'01 263 17 0 00 000000 ret ; Superstition... 25001 k20pdc - Kermit (Visual) Packet Decoding MACRO %53B(1254)-4 19:42 30-Mar-24 Page 6 K20PDC MAC 27-Mar-24 20:17 Receive Context 25002 subttl Receive Context 25003 25004 ; Invoked at the end of the receive 25005 ; 25006 ; AC's: 25007 ; 25008 ; t1/ Packet type 25009 ; t2/ Packet number 25010 ; t3/ Length of data field 25011 ; t4/ 8-bit byte pointer to data field 25012 25013 extern rsthdr ; Start of Packet 25014 extern num ; Packet Number 25015 extern type ; Message Type 25016 extern datlen ; Data length 25017 extern pktlen ; Packet length 25018 extern islong ; Set if a long packet 25019 extern datptr ; Pointer to data area of packet 25020 extern pktbct ; Block check type for this packet on receive 25021 extern blkchk ; Final computed block check 25022 extern fintim ; Fine grained time of day (in K20TIM) 25023 k20pdc - Kermit (Visual) Packet Decoding MACRO %53B(1254)-4 19:42 30-Mar-24 Page 7 K20PDC MAC 27-Mar-24 20:17 Decode a received packet 25024 subttl Decode a received packet 25025 25026 000107'01 rpdecd: remark ; Saved by original external caller 25027 remark ; Saved by internal control linkage 25028 repeat 0,< 25029 setzb t1, t2 ; Cons up some .CHNUL's 25030 dmovem t1, sop8st ; Start of Packet character as an 8 bit ASCII string 25031 dmovem t1, trnbuf ; Same character as expanded 7 bit ASCIZ 25032 > 25033 000107'01 200 01 0 00 000013 move t1, p3 ; Load the log file JFN 25034 000110'01 120 02 0 00 000000# smsg () ; "R" for Receive 25035 000111'01 260 17 0 00 000104* 25036 000006'02 000000000000# 25037 000007'02 777777 777776 25038 000024'03 122 054 000 000 000 25039 000112'01 260 17 0 00 000000* call fintim ; Print Time of Day down to HP ticks 25040 000113'01 254 00 0 00 000031' jrst deberr ; Something went wrong, stop doing this 25041 000114'01 201 04 0 00 000122 movei t4, "R" ; Flag that we're receiving 25042 000115'01 260 17 0 00 000734' call pkthdr ; Display packet head 25043 000116'01 254 00 0 00 000031' jrst deberr ; Failed somehow 25044 25045 000117'01 200 02 0 00 000000* move t2, datptr ; Load what receieve sets up 25046 000120'01 202 02 0 00 000000* movem t2, sdatpt ; Pretend we're sending it for code re-use 25047 25048 000121'01 200 04 0 00 000000* move t4, type ; Reload the type 25049 000122'01 405 04 0 00 000177 andi t4, 177 ;[235] Strip off any parity 25050 000123'01 301 04 0 00 000101 cail t4, "A" ; Before "A"? 25051 000124'01 303 04 0 00 000132 caile t4, "Z" ; or after "Z"? 25052 000125'01 254 00 0 00 000213' jrst invsnd ; Can't do the jump table 25053 25054 000126'01 415 16 0 00 000136' block. ; Enter block context for better control flow 25055 000127'01 261 17 0 00 000016 25056 000130'01 306 04 0 00 000131 cain t4, "Y" ; An acknowledge? 25057 000131'01 263 17 0 00 000000 ret ; Don't overwrite what ACK is ack'ing 25058 000132'01 306 04 0 00 000116 cain t4, "N" ; A negative acknowledge? 25059 000133'01 263 17 0 00 000000 ret ; Don't overwrite what NAK is nak'ing 25060 000134'01 254 00 0 00 000064* retskp ; Otherwise, OK to update context 25061 000135'01 263 17 0 00 000000 endbk. ; End of block context 25062 000136'01 254 00 0 00 000140' ifskp. ; +2 means OK to overwrite 25063 000137'01 202 04 0 00 000000# movem t4, lstpkt ; Remember last packet type 25064 000140'01 endif. 25065 25066 000140'01 265 16 0 00 001042' saveac ; Needs some scratch 25067 000141'01 200 05 0 00 000120* move q1, sdatpt ; Load the pointer to the packet's data field 25068 000142'01 200 07 0 00 000000* move q3, datlen ; Number of initialization bytes 25069 25070 000143'01 200 03 0 00 000004 move t3, t4 ; Save a working copy 25071 000144'01 275 03 0 00 000101 subi t3, "A" ; Bring into offset range 25072 000145'01 260 17 1 03 000000# call @sndpkt(t3) ; Call the right routine 25073 000146'01 263 17 0 00 000000 ret ; Pass the error back up 25074 25075 smsg < 25076 000147'01 120 02 0 00 000000# > ; Tie off the log file line 25077 000150'01 260 17 0 00 000111* 25078 000010'02 000000000000# k20pdc - Kermit (Visual) Packet Decoding MACRO %53B(1254)-4 19:42 30-Mar-24 Page 7-1 K20PDC MAC 27-Mar-24 20:17 Decode a received packet 25079 000011'02 777777 777776 25080 000025'03 015 012 000 000 000 25081 000151'01 263 17 0 00 000000 ret ; +1, always 25082 k20pdc - Kermit (Visual) Packet Decoding MACRO %53B(1254)-4 19:42 30-Mar-24 Page 8 K20PDC MAC 27-Mar-24 20:17 Decode a sent packet 25083 subttl Decode a sent packet 25084 25085 extern sseqn ; Sending Sequence Number 25086 extern sdatpt ; Sending Data Pointer (points inside the packet) 25087 extern spakpt ; Sending packet pointer 25088 25089 000152'01 spdecd: remark ; Saved by original external caller 25090 remark ; Saved by internal control linkage 25091 repeat 0,< 25092 setzb t1, t2 ; Cons up some .CHNUL's 25093 dmovem t1, sop8st ; Start of Packet character as an 8 bit ASCII string 25094 dmovem t1, trnbuf ; Same character as expanded 7 bit ASCIZ 25095 > 25096 000152'01 200 01 0 00 000013 move t1, p3 ; Load the log file JFN 25097 000153'01 120 02 0 00 000000# smsg () ; "S" for Send 25098 000154'01 260 17 0 00 000150* 25099 000012'02 000000000000# 25100 000013'02 777777 777776 25101 000026'03 123 054 000 000 000 25102 000155'01 260 17 0 00 000112* call fintim ; Print Time of Day down to HP ticks 25103 000156'01 254 00 0 00 000031' jrst deberr ; Something went wrong, stop doing this 25104 000157'01 201 04 0 00 000123 movei t4, "S" ; Flag that we're sending 25105 000160'01 260 17 0 00 000734' call pkthdr ; Dump basic packet headers 25106 000161'01 254 00 0 00 000031' jrst deberr ; Failed somehow 25107 25108 000162'01 200 04 0 00 000121* move t4, type ; Reload the type 25109 000163'01 405 04 0 00 000177 andi t4, 177 ;[235] Strip off any parity 25110 000164'01 301 04 0 00 000101 cail t4, "A" ; Before "A"? 25111 000165'01 303 04 0 00 000132 caile t4, "Z" ; or after "Z"? 25112 000166'01 254 00 0 00 000213' jrst invsnd ; Can't do the jump table 25113 25114 000167'01 415 16 0 00 000177' block. ; Enter block context for better control flow 25115 000170'01 261 17 0 00 000016 25116 000171'01 306 04 0 00 000131 cain t4, "Y" ; An acknowledge? 25117 000172'01 263 17 0 00 000000 ret ; Don't overwrite what ACK is ack'ing 25118 000173'01 306 04 0 00 000116 cain t4, "N" ; A negative acknowledge? 25119 000174'01 263 17 0 00 000000 ret ; Don't overwrite what NAK is nak'ing 25120 000175'01 254 00 0 00 000134* retskp ; Otherwise, OK to update context 25121 000176'01 263 17 0 00 000000 endbk. ; End of block context 25122 000177'01 254 00 0 00 000201' ifskp. ; +2 means OK to overwrite 25123 000200'01 202 04 0 00 000000# movem t4, lstpkt ; Remember last packet type 25124 000201'01 endif. 25125 25126 000201'01 265 16 0 00 001042' saveac ; Needs some scratch 25127 000202'01 200 05 0 00 000141* move q1, sdatpt ; Load the pointer to the packet's data field 25128 000203'01 200 07 0 00 000142* move q3, datlen ; Number of initialization bytes 25129 25130 000204'01 200 03 0 00 000004 move t3, t4 ; Save a working copy 25131 000205'01 275 03 0 00 000101 subi t3, "A" ; Bring into offset range 25132 000206'01 260 17 1 03 000000# call @sndpkt(t3) ; Call the right routine 25133 000207'01 263 17 0 00 000000 ret ; Pass the error back up 25134 smsg < 25135 000210'01 120 02 0 00 000000# > ; Otherwise, tie off the log file line 25136 000211'01 260 17 0 00 000154* 25137 000014'02 000000000000# k20pdc - Kermit (Visual) Packet Decoding MACRO %53B(1254)-4 19:42 30-Mar-24 Page 8-1 K20PDC MAC 27-Mar-24 20:17 Decode a sent packet 25138 000015'02 777777 777776 25139 000027'03 015 012 000 000 000 25140 000212'01 263 17 0 00 000000 ret ; Returns +1, always 25141 k20pdc - Kermit (Visual) Packet Decoding MACRO %53B(1254)-4 19:42 30-Mar-24 Page 9 K20PDC MAC 27-Mar-24 20:17 Jump table for sent packet types 25142 subttl Jump table for sent packet types 25143 25144 .endps code ; Constant tables don't go in code 25145 .psect const ; they go into the constants psect 25146 25147 000016'02 000000000000# sndpkt: INVSND ; "A" - Attributes 25148 000017'02 000000000000# sndeot ; "B" - EOT 25149 000020'02 000000000000# INVSND ; "C" - Largely unimplemented host command 25150 000021'02 000000000000# sndata ; "D" - Data 25151 000022'02 000000000000# snderr ; "E" - Error packet 25152 000023'02 000000000000# sndfil ; "F" - File Header 25153 000024'02 000000000000# sndgen ; "G" - Sending a generic command 25154 000025'02 000000000000# INVSND ; "H" - Undefined 25155 000026'02 000000000000# sndinz ; "I" - Info Packet 25156 000027'02 000000000000# INVSND ; "J" - Undefined 25157 000030'02 000000000000# INVSND ; "K" - Undefined 25158 000031'02 000000000000# INVSND ; "L" - Undefined 25159 000032'02 000000000000# INVSND ; "M" - Undefined 25160 000033'02 000000000000# sndnak ; "N" - Negative Acknowledge (NAK) 25161 000034'02 000000000000# INVSND ; "O" - Undefined 25162 000035'02 000000000000# INVSND ; "P" - Undefined 25163 000036'02 000000000000# INVSND ; "Q" - Undefined 25164 000037'02 000000000000# sndrec ; "R" - Receive (GET) 25165 000040'02 000000000000# sndini ; "S" - Send 25166 000041'02 000000000000# INVSND ; "T" - Specially handled, somehow 25167 000042'02 000000000000# INVSND ; "U" - Undefined 25168 000043'02 000000000000# INVSND ; "V" - Undefined 25169 000044'02 000000000000# INVSND ; "W" - Undefined 25170 000045'02 000000000000# sndtxt ; "X" - Text Header 25171 000046'02 000000000000# sndack ; "Y" - Acknowledge (ACK) 25172 000047'02 000000000000# sndeof ; "Z" - EOF 25173 25174 .endps const ; Done with constants 25175 .psect code ; Back to generating code 25176 k20pdc - Kermit (Visual) Packet Decoding MACRO %53B(1254)-4 19:42 30-Mar-24 Page 10 K20PDC MAC 27-Mar-24 20:17 Invalid Send Packet 25177 subttl Invalid Send Packet 25178 25179 000213'01 200 01 0 00 000013 INVSND: move t1, p3 ; Load log file 25180 000214'01 120 02 0 00 000000# smsg (<, Invalid packet type: ">) ;" Fool font crock mode 25181 000215'01 260 17 0 00 000211* 25182 000050'02 000000000000# 25183 000051'02 777777 777750 25184 000030'03 054 040 111 156 166 25185 000216'01 200 02 0 00 000004 invsn1: move t2, t4 ; Load it 25186 000217'01 260 17 0 00 000102* call BOUTI% ; Put it in the log 25187 000220'01 201 02 0 00 000042 invsn2: movei t2, .chdbq ; Load closing double quote 25188 000221'01 260 17 0 00 000217* call BOUTI% ; Put it in the log 25189 000222'01 361 07 0 00 000175* sojl q3, RSKP ; Nothing here? That's fine 25190 000223'01 254 00 0 00 000233' callret sndata ; Dump any data that came along with it 25191 000224'01 254 00 0 00 000222* retskp ; Successfully whined ... 25192 25193 k20pdc - Kermit (Visual) Packet Decoding MACRO %53B(1254)-4 19:42 30-Mar-24 Page 11 K20PDC MAC 27-Mar-24 20:17 Various Commands, many mostly dinky 25194 subttl Various Commands, many mostly dinky 25195 25196 000225'01 sndeot: remark Sending a "B" - End of Transmission 25197 000225'01 120 02 0 00 000000# smsg (<, End of Transmission>) 25198 000226'01 260 17 0 00 000215* 25199 000052'02 000000000000# 25200 000053'02 777777 777753 25201 000035'03 054 040 105 156 144 25202 000227'01 361 07 0 00 000224* sojl q3, RSKP ; Nothing here? That's fine 25203 000230'01 120 02 0 00 000000# smsg <: > ; Shouldn't have anything in it, but... 25204 000231'01 260 17 0 00 000226* 25205 000054'02 000000000000# 25206 000055'02 777777 777776 25207 000042'03 072 040 000 000 000 25208 000232'01 254 00 0 00 000250' callret sndat1 ; Dump it 25209 25210 25211 000233'01 sndata: remark Sending a "D" - Data Packet 25212 000233'01 120 02 0 00 000000# smsg <, Data: > ; The packet data 25213 000234'01 260 17 0 00 000231* 25214 000056'02 000000000000# 25215 000057'02 777777 777770 25216 000043'03 054 040 104 141 164 25217 000235'01 337 02 0 00 000203* skipg t2,datlen ;[241] ; typing anything? 25218 000236'01 254 00 0 00 000250' ifskp. ;[241] ; Yes, say how long 25219 000237'01 201 03 0 00 000012 movx t3,fld(^d10,no%rdx) ;[241] 25220 000240'01 104 00 0 00 000224 NOUT% ;[241] ; Length is in decimal 25221 000241'01 320 14 0 00 000243' ifje. s ;[241] ; Catch and suppress error 25222 000242'01 254 00 0 00 000246' 25223 000243'01 120 02 0 00 000000# smsg ();[241] ; Flag an error 25224 000244'01 260 17 0 00 000234* 25225 000060'02 000000000000# 25226 000061'02 777777 777775 25227 000045'03 077 054 040 000 000 25228 000245'01 254 00 0 00 000250' else. ;[241] ; Otherwise, worked fine 25229 000246'01 120 02 0 00 000000# smsg (<, >) ;[241] ; space over 25230 000247'01 260 17 0 00 000244* 25231 000062'02 000000000000# 25232 000063'02 777777 777776 25233 000046'03 054 040 000 000 000 25234 000250'01 endif. ;[241] ; End case NOUT% result handling 25235 000250'01 endif. ;[241] ; End case data packet 25236 25237 000250'01 200 02 0 00 000202* sndat1: move t2, sdatpt ; Load pointer to data area of packet 25238 000251'01 210 03 0 00 000235* movn t3, datlen ; Length of same 25239 000252'01 322 03 0 00 000256' ifn. t3 ; Ditch the SOUT% if nothing there 25240 000253'01 104 00 0 00 000053 SOUT% ; Spew that 25241 000254'01 320 12 0 00 000031' erjmpr deberr ; Or didn't 25242 000255'01 254 00 0 00 000260' else. ; That's odd 25243 000256'01 120 02 0 00 000000# smsg (<(null)>) ; Blat about it 25244 000257'01 260 17 0 00 000247* 25245 000064'02 000000000000# 25246 000065'02 777777 777772 25247 000047'03 050 156 165 154 154 25248 000260'01 endif. ; End case non-zero data k20pdc - Kermit (Visual) Packet Decoding MACRO %53B(1254)-4 19:42 30-Mar-24 Page 11-1 K20PDC MAC 27-Mar-24 20:17 Various Commands, many mostly dinky 25249 000260'01 254 00 0 00 000227* retskp 25250 25251 25252 000261'01 snderr: remark Sending an "E" - Error (Fatal) 25253 000261'01 120 02 0 00 000000# smsg (<, Error>) 25254 000262'01 260 17 0 00 000257* 25255 000066'02 000000000000# 25256 000067'02 777777 777771 25257 000051'03 054 040 105 162 162 25258 000263'01 361 07 0 00 000260* sojl q3, RSKP ; Nothing here? That's fine 25259 000264'01 254 00 0 00 000233' callret sndata ; Dump it 25260 25261 25262 000265'01 sndfil: remark Sending a "F" - (Fetch or Name this File) 25263 000265'01 120 02 0 00 000000# smsg <, File: > ; The packet name 25264 000266'01 260 17 0 00 000262* 25265 000070'02 000000000000# 25266 000071'02 777777 777770 25267 000053'03 054 040 106 151 154 25268 000267'01 254 00 0 00 000250' callret sndat1 ; Dump it 25269 25270 25271 000270'01 sndinz: remark Sending an "I" - Initialization (here are my parameters) 25272 smsg (<, Initialization 25273 000270'01 120 02 0 00 000000# >) 25274 000271'01 260 17 0 00 000266* 25275 000072'02 000000000000# 25276 000073'02 777777 777752 25277 000055'03 054 040 111 156 151 25278 25279 000272'01 254 00 0 00 000527' callret params ; Break out the parameters 25280 25281 000273'01 sndnak: remark Sending an "N" - Negative acknowledgement 25282 000273'01 120 02 0 00 000000# smsg (<, Negative Acknowledge>) 25283 000274'01 260 17 0 00 000271* 25284 000074'02 000000000000# 25285 000075'02 777777 777752 25286 000062'03 054 040 116 145 147 25287 000275'01 254 00 0 00 000263* retskp 25288 25289 000276'01 sndrec: remark Sending an "R" - Receive (this file) 25290 000276'01 120 02 0 00 000000# smsg <, Receive: > ; The packet name 25291 000277'01 260 17 0 00 000274* 25292 000076'02 000000000000# 25293 000077'02 777777 777765 25294 000067'03 054 040 122 145 143 25295 000300'01 254 00 0 00 000250' callret sndat1 ; Dump it 25296 25297 25298 000301'01 sndini: remark Sending an "S" - Send Initiation 25299 smsg (<, Send Initiation 25300 000301'01 120 02 0 00 000000# >) 25301 000302'01 260 17 0 00 000277* 25302 000100'02 000000000000# 25303 000101'02 777777 777751 k20pdc - Kermit (Visual) Packet Decoding MACRO %53B(1254)-4 19:42 30-Mar-24 Page 11-2 K20PDC MAC 27-Mar-24 20:17 Various Commands, many mostly dinky 25304 000072'03 054 040 123 145 156 25305 25306 000303'01 254 00 0 00 000527' callret params ; Break out the parameters 25307 25308 000304'01 sndtxt: remark Sending an "X" - Display this data on terminal 25309 000304'01 120 02 0 00 000000# smsg <, Text: > ; ; The packet name 25310 000305'01 260 17 0 00 000302* 25311 000102'02 000000000000# 25312 000103'02 777777 777770 25313 000077'03 054 040 124 145 170 25314 000306'01 254 00 0 00 000250' callret sndat1 ; Dump it 25315 25316 k20pdc - Kermit (Visual) Packet Decoding MACRO %53B(1254)-4 19:42 30-Mar-24 Page 12 K20PDC MAC 27-Mar-24 20:17 Sending Acknowledgement table 25317 subttl Sending Acknowledgement table 25318 25319 .endps code ; Constant tables don't go in code 25320 .psect const ; they go into the constants psect 25321 25322 000104'02 000000000000# acktab: defack ; "A" - Attributes 25323 000105'02 000000000000# defack ; "B" - EOT 25324 000106'02 000000000000# defack ; "C" - Largely unimplemented host command 25325 000107'02 000000000000# defack ; "D" - Data 25326 000110'02 000000000000# errack ; "E" - Error packet 25327 000111'02 000000000000# defack ; "F" - File Header 25328 000112'02 000000000000# defack ; "G" - Sending a generic command 25329 000113'02 000000000000# defack ; "H" - Undefined 25330 000114'02 000000000000# inzack ; "I" - Info Packet 25331 000115'02 000000000000# UNDACK ; "J" - Undefined 25332 000116'02 000000000000# UNDACK ; "K" - Undefined 25333 000117'02 000000000000# UNDACK ; "L" - Undefined 25334 000120'02 000000000000# UNDACK ; "M" - Undefined 25335 000121'02 000000000000# errack ; "N" - Negative Acknowledge (NAK) 25336 000122'02 000000000000# UNDACK ; "O" - Undefined 25337 000123'02 000000000000# UNDACK ; "P" - Undefined 25338 000124'02 000000000000# UNDACK ; "Q" - Undefined 25339 000125'02 000000000000# defack ; "R" - Receive (GET) 25340 000126'02 000000000000# iniack ; "S" - Send 25341 000127'02 000000000000# defack ; "T" - Specially handled, somehow 25342 000130'02 000000000000# UNDACK ; "U" - Undefined 25343 000131'02 000000000000# UNDACK ; "V" - Undefined 25344 000132'02 000000000000# UNDACK ; "W" - Undefined 25345 000133'02 000000000000# defack ; "X" - Text Header 25346 000134'02 000000000000# errack ; "Y" - Acknowledge (ACK) 25347 000135'02 000000000000# defack ; "Z" - EOF 25348 25349 .endps const ; Done with constants 25350 .psect code ; Back to generating code 25351 k20pdc - Kermit (Visual) Packet Decoding MACRO %53B(1254)-4 19:42 30-Mar-24 Page 13 K20PDC MAC 27-Mar-24 20:17 Acknowledgement dispatch 25352 subttl Acknowledgement dispatch 25353 25354 000307'01 265 16 0 00 001042' sndack: saveac ; Needs some scratch 25355 000310'01 200 05 0 00 000250* move q1, sdatpt ; Load the pointer to the packet's data field 25356 000311'01 200 07 0 00 000251* move q3, datlen ; Number of initialization bytes 25357 25358 000312'01 200 04 0 00 000000# move t4, lstpkt ; Load what we should be acknowledging 25359 000313'01 405 04 0 00 000177 andi t4, 177 ;[235] Strip off any parity 25360 000314'01 200 03 0 00 000004 move t3, t4 ; Save a working copy 25361 000315'01 275 03 0 00 000101 subi t3, "A" ; Bring into offset range 25362 000316'01 254 00 1 03 000000# callret @acktab(t3) ; Continue the right routine 25363 25364 25365 000317'01 UNDACK: remark ; Packet type the Kermit-20 does not do 25366 000317'01 120 02 0 00 000000# smsg (<, Undefined Acknowlege for packet type: ">) ;" Fool font crock mode 25367 000320'01 260 17 0 00 000305* 25368 000136'02 000000000000# 25369 000137'02 777777 777727 25370 000101'03 054 040 125 156 144 25371 000321'01 254 00 0 00 000216' callret invsn1 ; Finish logging it 25372 25373 000322'01 errack: remark ; Shouldn't acknowledge "Y", "N" or "E" 25374 000322'01 120 02 0 00 000000# smsg (<, ERROR: should not be acknowledging a packet type: ">) ;" Fool 25375 000323'01 260 17 0 00 000320* 25376 000140'02 000000000000# 25377 000141'02 777777 777713 25378 000112'03 054 040 105 122 122 25379 000324'01 254 00 0 00 000216' callret invsn1 ; Finish logging it 25380 25381 000325'01 iniack: remark ; Response to "S" 25382 smsg (<, Send Initiation Acknowledgement 25383 000325'01 120 02 0 00 000000# >) 25384 000326'01 260 17 0 00 000323* 25385 000142'02 000000000000# 25386 000143'02 777777 777731 25387 000125'03 054 040 123 145 156 25388 25389 000327'01 254 00 0 00 000527' callret params ; Break out the parameters 25390 25391 000330'01 inzack: remark ; Response to "I" 25392 smsg (<, Initialization Acknowledgement 25393 000330'01 120 02 0 00 000000# >) 25394 000331'01 260 17 0 00 000326* 25395 000144'02 000000000000# 25396 000145'02 777777 777732 25397 000135'03 054 040 111 156 151 25398 25399 000332'01 254 00 0 00 000527' callret params ; Break out the parameters 25400 25401 000333'01 defack: remark ; All others is to print any contents 25402 000333'01 326 07 0 00 000351' ife. q3 ; If none, then nothing further to do 25403 000334'01 120 02 0 00 000000# smsg (<, Acknowledged packet type ">) ;" Fool font crock mode 25404 000335'01 260 17 0 00 000331* 25405 000146'02 000000000000# 25406 000147'02 777777 777744 k20pdc - Kermit (Visual) Packet Decoding MACRO %53B(1254)-4 19:42 30-Mar-24 Page 13-1 K20PDC MAC 27-Mar-24 20:17 Acknowledgement dispatch 25407 000145'03 054 040 101 143 153 25408 000336'01 200 02 0 00 000004 move t2, t4 ; Load what we're acknowledging 25409 000337'01 405 02 0 00 000177 andi t2, 177 ;[235] Strip off any parity 25410 000340'01 260 17 0 00 000221* call BOUTI% ; Append to log 25411 000341'01 302 02 0 00 000107 caie t2, "G" ; Was this a generic command? 25412 000342'01 254 00 0 00 000346' ifskp. ; It was, so provide a little more clarity 25413 000343'01 200 02 0 00 000000# move t2, lstgen ; Load the kind of last generic 25414 000344'01 405 02 0 00 000177 andi t2, 177 ;[235] Strip off any parity 25415 000345'01 260 17 0 00 000340* call BOUTI% ; Append to log 25416 000346'01 endif. 25417 000346'01 201 02 0 00 000042 movei t2, .chdbq ; Closing double quote 25418 000347'01 260 17 0 00 000345* call BOUTI% ; Append that, too 25419 000350'01 254 00 0 00 000275* retskp ; Worked, wonderfully... 25420 000351'01 endif. 25421 25422 000351'01 120 02 0 00 000000# smsg (<, Ack(>) ; Short acknowledgement 25423 000352'01 260 17 0 00 000335* 25424 000150'02 000000000000# 25425 000151'02 777777 777772 25426 000153'03 054 040 101 143 153 25427 000353'01 200 02 0 00 000004 move t2, t4 ; Load what we're acknowledging 25428 000354'01 405 02 0 00 000177 andi t2, 177 ;[235] Strip off any parity 25429 000355'01 260 17 0 00 000347* call BOUTI% ; Append to log 25430 000356'01 302 02 0 00 000107 caie t2, "G" ; Was this a generic command? 25431 000357'01 254 00 0 00 000363' ifskp. ; It was, so provide a little more clarity 25432 000360'01 200 02 0 00 000000# move t2, lstgen ; By getting the last generic command 25433 000361'01 405 02 0 00 000177 andi t2, 177 ;[235] Strip off any parity 25434 000362'01 260 17 0 00 000355* call BOUTI% ; Append to log 25435 000363'01 endif. 25436 000363'01 120 02 0 00 000000# smsg (<), >) ; Close and space over 25437 000364'01 260 17 0 00 000352* 25438 000152'02 000000000000# 25439 000153'02 777777 777775 25440 000155'03 051 054 040 000 000 25441 25442 000365'01 200 02 0 00 000005 move t2, q1 ; Load the pointer to the data area 25443 000366'01 210 03 0 00 000007 movn t3, q3 ; Negative length of data area 25444 000367'01 104 00 0 00 000053 SOUT% ; Get the response into the log 25445 000370'01 320 12 0 00 000031' erjmpr deberr ; Or didn't... 25446 000371'01 254 00 0 00 000350* retskp ; Worked!! 25447 k20pdc - Kermit (Visual) Packet Decoding MACRO %53B(1254)-4 19:42 30-Mar-24 Page 14 K20PDC MAC 27-Mar-24 20:17 Sending a "Z" - End of File 25448 subttl Sending a "Z" - End of File 25449 25450 000372'01 120 02 0 00 000000# sndeof: smsg (<, End of File>) 25451 000373'01 260 17 0 00 000364* 25452 000154'02 000000000000# 25453 000155'02 777777 777763 25454 000156'03 054 040 105 156 144 25455 000374'01 200 05 0 00 000310* move q1, sdatpt ; Load the pointer the packet's data field 25456 000375'01 200 07 0 00 000311* move q3, datlen ; Number of initialization bytes 25457 ; See if being told to discard file 25458 000376'01 361 07 0 00 000371* sojl q3, RSKP ; But only if there is a character 25459 000377'01 134 06 0 00 000005 ildb q2, q1 ; Load the action character 25460 000400'01 405 06 0 00 000177 andi q2, 177 ;[235] Strip off any parity 25461 000401'01 302 06 0 00 000104 caie q2, "D" ; Got told to discard? 25462 000402'01 254 00 0 00 000406' ifskp. ; We did 25463 000403'01 120 02 0 00 000000# smsg (<, Discarding>) ; Blat about it 25464 000404'01 260 17 0 00 000373* 25465 000156'02 000000000000# 25466 000157'02 777777 777764 25467 000161'03 054 040 104 151 163 25468 000405'01 254 00 0 00 000411' else. ; Otherwise, something odd 25469 000406'01 120 02 0 00 000000# smsg (<, >) ; So blat about that 25470 000407'01 260 17 0 00 000404* 25471 000160'02 000000000000# 25472 000161'02 777777 777776 25473 000164'03 054 040 000 000 000 25474 000410'01 254 00 0 00 000250' callret sndat1 ; and put into the log 25475 000411'01 endif. ; End of Discard decision 25476 25477 000411'01 254 00 0 00 000376* retskp ; Successfully decode the packet 25478 25479 k20pdc - Kermit (Visual) Packet Decoding MACRO %53B(1254)-4 19:42 30-Mar-24 Page 15 K20PDC MAC 27-Mar-24 20:17 Generic Send Packet Types 25480 subttl Generic Send Packet Types 25481 25482 .endps code ; Constant tables don't go in code 25483 .psect const ; they go into the constants psect 25484 25485 000162'02 000000000000# sgenpt: genpwd ; A - PWD 25486 000163'02 000000000000# INVGEN ; B - Undefined 25487 000164'02 000000000000# gencwd ; C - CWD 25488 000165'02 000000000000# gendir ; D - Directory 25489 000166'02 000000000000# gendel ; E - Erase (delete) 25490 000167'02 000000000000# genfin ; F - Finish 25491 000170'02 000000000000# gencdu ;[254] ; G - CDUP 25492 000171'02 000000000000# genhlp ; H - Help 25493 000172'02 000000000000# INVGEN ; I - Login (not yet implemented) 25494 000173'02 000000000000# INVGEN ; J - Journal control (nyi) 25495 000174'02 000000000000# INVGEN ; K - Copy (nyi) 25496 000175'02 000000000000# genbye ; L - Logout, Bye 25497 000176'02 000000000000# INVGEN ; M - Undefined 25498 000177'02 000000000000# INVGEN ; N - Undefined 25499 000200'02 000000000000# INVGEN ; O - Undefined 25500 000201'02 000000000000# INVGEN ; P - Program invocation (nyi) 25501 000202'02 000000000000# gensta ; Q - Server status query 25502 000203'02 000000000000# INVGEN ; R - Rename (nyi) 25503 000204'02 000000000000# INVGEN ; S - Undefined 25504 000205'02 000000000000# INVGEN ; T - Type 25505 000206'02 000000000000# gendsk ; U - Disk Usage 25506 000207'02 000000000000# INVGEN ; V - Variable Set/Query 25507 000210'02 000000000000# INVGEN ; W - Who (Finger) 25508 000211'02 000000000000# INVGEN ; X - Undefined 25509 000212'02 000000000000# INVGEN ; Y - Undefined 25510 000213'02 000000000000# INVGEN ; Z - Undefined 25511 25512 .endps const ; Done with constants 25513 .psect code ; Back to generating code 25514 k20pdc - Kermit (Visual) Packet Decoding MACRO %53B(1254)-4 19:42 30-Mar-24 Page 16 K20PDC MAC 27-Mar-24 20:17 Send Generic Command 25515 subttl Send Generic Command 25516 25517 000412'01 sndgen: remark t1, p3 ; Already loaded with JFN 25518 000412'01 120 02 0 00 000000# smsg <, Generic, > ; A generic packet type 25519 000413'01 260 17 0 00 000407* 25520 000214'02 000000000000# 25521 000215'02 777777 777765 25522 000165'03 054 040 107 145 156 25523 25524 000414'01 371 00 0 00 000007 sosl q3 ; Malformed? 25525 000415'01 254 00 0 00 000421' ifskp. ; It is 25526 000416'01 120 02 0 00 000000# smsg (<(% No action character)>) 25527 000417'01 260 17 0 00 000413* 25528 000216'02 000000000000# 25529 000217'02 777777 777751 25530 000170'03 050 045 040 116 157 25531 000420'01 254 00 0 00 000411* retskp ; Handled malformed character OK 25532 000421'01 endif. 25533 25534 000421'01 134 04 0 00 000005 ildb t4, q1 ; Pick up the generic command character 25535 000422'01 405 04 0 00 000177 andi t4, 177 ;[235] Strip off any parity 25536 000423'01 301 04 0 00 000101 cail t4, "A" ; Before "A"? 25537 000424'01 303 04 0 00 000132 caile t4, "Z" ; or after "Z"? 25538 000425'01 254 00 0 00 000432' jrst invgen ; Can't do the jump table 25539 000426'01 202 04 0 00 000000# movem t4, lstgen ; Set last generic 25540 25541 000427'01 200 03 0 00 000004 move t3, t4 ; Save a copy in case of error 25542 000430'01 275 03 0 00 000101 subi t3, "A" ; Bring into offset range 25543 000431'01 254 00 1 03 000000# callret @sgenpt(t3) ; Invoke the correct decoding routine 25544 25545 k20pdc - Kermit (Visual) Packet Decoding MACRO %53B(1254)-4 19:42 30-Mar-24 Page 17 K20PDC MAC 27-Mar-24 20:17 Invalid Generic message type 25546 subttl Invalid Generic message type 25547 25548 000432'01 120 02 0 00 000000# INVGEN: smsg () ;" Fool font crock mode 25549 000433'01 260 17 0 00 000417* 25550 000220'02 000000000000# 25551 000221'02 777777 777751 25552 000175'03 111 156 166 141 154 25553 000434'01 254 00 0 00 000216' callret invsn1 ; Finish logging it 25554 k20pdc - Kermit (Visual) Packet Decoding MACRO %53B(1254)-4 19:42 30-Mar-24 Page 18 K20PDC MAC 27-Mar-24 20:17 Trivial Generic Requests 25555 subttl Trivial Generic Requests 25556 25557 000435'01 genpwd: remark "A" 25558 000435'01 120 02 0 00 000000# smsg () 25559 000436'01 260 17 0 00 000433* 25560 000222'02 000000000000# 25561 000223'02 777777 777751 25562 000202'03 120 162 151 156 164 25563 000437'01 254 00 0 00 000420* retskp 25564 25565 000440'01 gencdu: remark "G" ;[254] 25566 000440'01 120 02 0 00 000000# smsg () ;;[254] 25567 000441'01 260 17 0 00 000436* 25568 000224'02 000000000000# 25569 000225'02 777777 777746 25570 000207'03 103 157 156 156 145 25571 000442'01 254 00 0 00 000437* retskp ;[254] 25572 25573 000443'01 gencwd: remark "C" 25574 000443'01 120 02 0 00 000000# smsg () 25575 000444'01 260 17 0 00 000441* 25576 000226'02 000000000000# 25577 000227'02 777777 777750 25578 000215'03 103 150 141 156 147 25579 000445'01 260 17 0 00 000475' call genarg ; Print the working directory, if any 25580 000446'01 600 00 0 00 000000 nop ; Ignore error 25581 000447'01 254 00 0 00 000442* retskp 25582 25583 000450'01 gendir: remark "D" 25584 000450'01 120 02 0 00 000000# smsg () 25585 000451'01 260 17 0 00 000444* 25586 000230'02 000000000000# 25587 000231'02 777777 777767 25588 000222'03 104 151 162 145 143 25589 000452'01 254 00 0 00 000475' callret genarg 25590 25591 000453'01 gendel: remark "E" 25592 000453'01 120 02 0 00 000000# smsg () 25593 000454'01 260 17 0 00 000451* 25594 000232'02 000000000000# 25595 000233'02 777777 777773 25596 000224'03 105 162 141 163 145 25597 000455'01 254 00 0 00 000475' callret genarg 25598 25599 000456'01 genfin: remark "F" 25600 000456'01 120 02 0 00 000000# smsg () 25601 000457'01 260 17 0 00 000454* 25602 000234'02 000000000000# 25603 000235'02 777777 777772 25604 000226'03 106 151 156 151 163 25605 000460'01 254 00 0 00 000447* retskp 25606 25607 000461'01 genhlp: remark "H" 25608 000461'01 120 02 0 00 000000# smsg () 25609 000462'01 260 17 0 00 000457* k20pdc - Kermit (Visual) Packet Decoding MACRO %53B(1254)-4 19:42 30-Mar-24 Page 18-1 K20PDC MAC 27-Mar-24 20:17 Trivial Generic Requests 25610 000236'02 000000000000# 25611 000237'02 777777 777774 25612 000230'03 110 145 154 160 000 25613 000463'01 254 00 0 00 000460* retskp 25614 25615 000464'01 genbye: remark "L" 25616 000464'01 120 02 0 00 000000# smsg () 25617 000465'01 260 17 0 00 000462* 25618 000240'02 000000000000# 25619 000241'02 777777 777772 25620 000231'03 114 157 147 157 165 25621 000466'01 254 00 0 00 000463* retskp 25622 25623 000467'01 gensta: remark "Q" 25624 000467'01 120 02 0 00 000000# smsg () 25625 000470'01 260 17 0 00 000465* 25626 000242'02 000000000000# 25627 000243'02 777777 777755 25628 000233'03 123 145 162 166 145 25629 000471'01 254 00 0 00 000466* retskp 25630 25631 000472'01 gendsk: remark "U" 25632 000472'01 120 02 0 00 000000# smsg () 25633 000473'01 260 17 0 00 000470* 25634 000244'02 000000000000# 25635 000245'02 777777 777766 25636 000237'03 104 151 163 153 040 25637 000474'01 254 00 0 00 000471* retskp 25638 25639 k20pdc - Kermit (Visual) Packet Decoding MACRO %53B(1254)-4 19:42 30-Mar-24 Page 19 K20PDC MAC 27-Mar-24 20:17 Generic Argument Decode 25640 subttl Generic Argument Decode 25641 25642 000475'01 361 07 0 00 000474* genarg: sojl q3, RSKP ; If nothing left, we're done 25643 000476'01 134 04 0 00 000005 ildb t4, q1 ; Pick up the length of the argument 25644 000477'01 405 04 0 00 000177 andi t4, 177 ;[235] Strip off any parity 25645 25646 000500'01 200 12 0 00 000000* move p2, rquote ; Let's assume we are receiving 25647 000501'01 302 11 0 00 000122 caie p1, "R" ; However, are we? 25648 000502'01 200 12 0 00 000000* move p2, squote ; Nope, we are sending 25649 25650 000503'01 do. ; Enter loop context for each argument 25651 000503'01 312 12 0 00 000004 came p2, t4 ; Is the length the same as the quote 25652 000504'01 254 00 0 00 000510' ifskp. ; They are, so then the length has to be quoted 25653 000505'01 361 07 0 00 000475* sojl q3, RSKP ; If nothing left, we're done 25654 000506'01 134 04 0 00 000005 ildb t4, q1 ; Pick up the length of this argument 25655 000507'01 405 04 0 00 000177 andi t4, 177 ;[235] Strip off any parity 25656 000510'01 endif. ; End case quoted length 25657 000510'01 275 04 0 00 000040 subi t4, .chspc ; Bring into numeric range 25658 000511'01 323 04 0 00 000505* jumple t4, RSKP ; No argument, depart 25659 000512'01 120 02 0 00 000000# smsg (<, >) ; Punctuate the argument 25660 000513'01 260 17 0 00 000473* 25661 000246'02 000000000000# 25662 000247'02 777777 777776 25663 000242'03 054 040 000 000 000 25664 000514'01 200 02 0 00 000005 move t2, q1 ; Load the properly advanced pointer 25665 000515'01 210 03 0 00 000004 movn t3, t4 ; Load the negative length 25666 000516'01 104 00 0 00 000053 SOUT% ; Put into the log 25667 000517'01 320 14 0 00 000000* erjmps r ; Shouldn't happen, JFN was fine 25668 000520'01 200 05 0 00 000002 move q1, t2 ; Update packet pointer 25669 000521'01 274 07 0 00 000004 sub q3, t4 ; Count off the characters we did 25670 000522'01 361 07 0 00 000511* sojl q3, RSKP ; See if we have another field and exit if not 25671 000523'01 134 04 0 00 000005 ildb t4, q1 ; Pick up the length of the argument 25672 000524'01 405 04 0 00 000177 andi t4, 177 ;[235] Strip off any parity 25673 000525'01 254 00 0 00 000503' loop. ; And go take care of that 25674 000526'01 enddo. ; End loop lexical context 25675 25676 000526'01 254 00 0 00 000522* retskp ; Superstition 25677 k20pdc - Kermit (Visual) Packet Decoding MACRO %53B(1254)-4 19:42 30-Mar-24 Page 20 K20PDC MAC 27-Mar-24 20:17 Break out parameters for S and I packets 25678 subttl Break out parameters for S and I packets 25679 25680 ; Call: 25681 ; 25682 ; q1/ Pointer to packet's data field 25683 ; *q2/ Used internally for packet characters 25684 ; q3/ Number of bytes in packet's data field 25685 ; 25686 ; Return: 25687 ; 25688 ; +1 Some kind of failure 25689 ; +2 Successfully decoded 25690 25691 000527'01 120 02 0 00 000000# params: smsg () 25692 000530'01 260 17 0 00 000513* 25693 000250'02 000000000000# 25694 000251'02 777777 777770 25695 000243'03 120 141 162 141 155 25696 000531'01 200 02 0 00 000375* move t2, datlen 25697 000532'01 201 03 0 00 000012 movei t3, ^d10 25698 000533'01 104 00 0 00 000224 NOUT% 25699 000534'01 320 12 0 00 000517* erjmpr r 25700 25701 000535'01 361 07 0 00 000526* sojl q3, RSKP ; Only if there 25702 000536'01 134 06 0 00 000005 ildb q2, q1 ; Load the maximum length 25703 000537'01 405 06 0 00 000177 andi q2, 177 ;[235] Strip off any parity 25704 000540'01 120 02 0 00 000000# smsg (<, MaxL: >) 25705 000541'01 260 17 0 00 000530* 25706 000252'02 000000000000# 25707 000253'02 777777 777770 25708 000245'03 054 040 115 141 170 25709 000542'01 200 02 0 00 000006 move t2, q2 25710 000543'01 275 02 0 00 000040 subi t2, .chspc 25711 000544'01 201 03 0 00 000012 movei t3, ^d10 25712 000545'01 104 00 0 00 000224 NOUT% ; 1 Packet size 25713 000546'01 320 12 0 00 000534* erjmpr r 25714 25715 000547'01 361 07 0 00 000535* sojl q3, RSKP ; Only if there 25716 000550'01 134 06 0 00 000005 ildb q2, q1 ; Load the time out 25717 000551'01 405 06 0 00 000177 andi q2, 177 ;[235] Strip off any parity 25718 000552'01 120 02 0 00 000000# smsg (<, TimO: >) 25719 000553'01 260 17 0 00 000541* 25720 000254'02 000000000000# 25721 000255'02 777777 777770 25722 000247'03 054 040 124 151 155 25723 000554'01 200 02 0 00 000006 move t2, q2 25724 000555'01 275 02 0 00 000040 subi t2, .chspc 25725 000556'01 201 03 0 00 000012 movei t3, ^d10 25726 000557'01 104 00 0 00 000224 NOUT% ; 2 Time out 25727 000560'01 320 12 0 00 000546* erjmpr r 25728 25729 000561'01 361 07 0 00 000547* sojl q3, RSKP ; Only if there 25730 000562'01 134 06 0 00 000005 ildb q2, q1 ; Load the number of padding characters 25731 000563'01 405 06 0 00 000177 andi q2, 177 ;[235] Strip off any parity 25732 000564'01 120 02 0 00 000000# smsg (<, Npad: >) k20pdc - Kermit (Visual) Packet Decoding MACRO %53B(1254)-4 19:42 30-Mar-24 Page 20-1 K20PDC MAC 27-Mar-24 20:17 Break out parameters for S and I packets 25733 000565'01 260 17 0 00 000553* 25734 000256'02 000000000000# 25735 000257'02 777777 777770 25736 000251'03 054 040 116 160 141 25737 000566'01 200 02 0 00 000006 move t2, q2 25738 000567'01 275 02 0 00 000040 subi t2, .chspc 25739 000570'01 201 03 0 00 000012 movei t3, ^d10 25740 000571'01 104 00 0 00 000224 NOUT% ; 3 Padding (character count) 25741 000572'01 320 12 0 00 000560* erjmpr r 25742 25743 000573'01 361 07 0 00 000561* sojl q3, RSKP ; Only if there 25744 000574'01 134 06 0 00 000005 ildb q2, q1 ; Load the padding character 25745 000575'01 405 06 0 00 000177 andi q2, 177 ;[235] Strip off any parity 25746 000576'01 120 02 0 00 000000# smsg (<, PadC: >) ; 4 25747 000577'01 260 17 0 00 000565* 25748 000260'02 000000000000# 25749 000261'02 777777 777770 25750 000253'03 054 040 120 141 144 25751 000600'01 200 02 0 00 000006 move t2, q2 25752 000601'01 271 02 0 00 000100 addi t2, ^o100 ; It's in excess 64 (decimal) 25753 000602'01 405 02 0 00 000177 andi t2, ^o177 ; Clip if it went to eight bits 25754 000603'01 260 17 0 00 000774' call outc ; Output as a control character 25755 25756 000604'01 361 07 0 00 000573* sojl q3, RSKP ; Only if there 25757 000605'01 134 06 0 00 000005 ildb q2, q1 ; Load the packet terminator 25758 000606'01 405 06 0 00 000177 andi q2, 177 ;[235] Strip off any parity 25759 000607'01 120 02 0 00 000000# smsg (<, EOL: >) ; 5 25760 000610'01 260 17 0 00 000577* 25761 000262'02 000000000000# 25762 000263'02 777777 777771 25763 000255'03 054 040 105 117 114 25764 000611'01 200 02 0 00 000006 move t2, q2 25765 000612'01 275 02 0 00 000040 subi t2, .chspc ; Bring into control range 25766 000613'01 260 17 0 00 000774' call outc ; Output as a control character 25767 25768 000614'01 361 07 0 00 000604* sojl q3, RSKP ; Only if there 25769 000615'01 134 06 0 00 000005 ildb q2, q1 ; Load the control prefix 25770 000616'01 405 06 0 00 000177 andi q2, 177 ;[235] Strip off any parity 25771 000617'01 120 02 0 00 000000# smsg (<, Qctl: >) ; 6 25772 000620'01 260 17 0 00 000610* 25773 000264'02 000000000000# 25774 000265'02 777777 777770 25775 000257'03 054 040 121 143 164 25776 000621'01 200 02 0 00 000006 move t2, q2 25777 000622'01 260 17 0 00 000774' call outc ; Output as a control character 25778 25779 000623'01 361 07 0 00 000614* sojl q3, RSKP ; Only if there 25780 000624'01 134 06 0 00 000005 ildb q2, q1 ; Load the eight bit quote 25781 000625'01 405 06 0 00 000177 andi q2, 177 ;[235] Strip off any parity 25782 000626'01 120 02 0 00 000000# smsg (<, Qbin: >) ; 7 25783 000627'01 260 17 0 00 000620* 25784 000266'02 000000000000# 25785 000267'02 777777 777770 25786 000261'03 054 040 121 142 151 25787 000630'01 200 02 0 00 000006 move t2, q2 k20pdc - Kermit (Visual) Packet Decoding MACRO %53B(1254)-4 19:42 30-Mar-24 Page 20-2 K20PDC MAC 27-Mar-24 20:17 Break out parameters for S and I packets 25788 000631'01 302 02 0 00 000131 caie t2, "Y" ; Am I agreeing? 25789 000632'01 254 00 0 00 000636' ifskp. ; I'm agreeable 25790 000633'01 120 02 0 00 000000# smsg 25791 000634'01 260 17 0 00 000627* 25792 000270'02 000000000000# 25793 000271'02 777777 777775 25794 000263'03 131 145 163 000 000 25795 000635'01 254 00 0 00 000644' else. ; Otherwise, could be other things 25796 000636'01 302 02 0 00 000116 caie t2, "N" ; Am I refusing 8 bit 25797 000637'01 254 00 0 00 000643' ifskp. ; I'm disagreeble 25798 000640'01 120 02 0 00 000000# smsg 25799 000641'01 260 17 0 00 000634* 25800 000272'02 000000000000# 25801 000273'02 777777 777776 25802 000264'03 116 157 000 000 000 25803 000642'01 254 00 0 00 000644' else. ; Neither one is the 8 bit quote character 25804 000643'01 260 17 0 00 000774' call outc ; Output as a possible control character 25805 000644'01 endif. ; End case No or actual character 25806 000644'01 endif. ; End case Yes or something else 25807 25808 000644'01 361 07 0 00 000623* sojl q3, RSKP ; Only if there 25809 000645'01 134 06 0 00 000005 ildb q2, q1 ; Load the block check type 25810 000646'01 405 06 0 00 000177 andi q2, 177 ;[235] Strip off any parity 25811 000647'01 120 02 0 00 000000# smsg (<, ChkT: >) ; 8 25812 000650'01 260 17 0 00 000641* 25813 000274'02 000000000000# 25814 000275'02 777777 777770 25815 000265'03 054 040 103 150 153 25816 000651'01 200 04 0 00 000006 move t4, q2 25817 000652'01 120 02 0 00 000000# dxtext (t2, ) 25818 000276'02 000000000000# 25819 000277'02 777777 777761 25820 000267'03 040 074 117 165 164 25821 000653'01 306 04 0 00 000061 cain t4, "1" 25822 000654'01 120 02 0 00 000000# dxtext (t2,<6-bit>) 25823 000300'02 000000000000# 25824 000301'02 777777 777773 25825 000273'03 066 055 142 151 164 25826 000655'01 306 04 0 00 000062 cain t4, "2" 25827 000656'01 120 02 0 00 000000# dxtext (t2,<12-bit>) 25828 000302'02 000000000000# 25829 000303'02 777777 777772 25830 000275'03 061 062 055 142 151 25831 000657'01 306 04 0 00 000063 cain t4, "3" 25832 000660'01 120 02 0 00 000000# dxtext (t2,<16-bit CRC>) 25833 000304'02 000000000000# 25834 000305'02 777777 777766 25835 000277'03 061 066 055 142 151 25836 000661'01 260 17 0 00 000650* call %%smsg ; Handle as if I did an smsg 25837 25838 000662'01 361 07 0 00 000644* sojl q3, RSKP ; Only if there 25839 000663'01 134 06 0 00 000005 ildb q2, q1 ; Load the repeat count prefix 25840 000664'01 405 06 0 00 000177 andi q2, 177 ;[235] Strip off any parity 25841 000665'01 120 02 0 00 000000# smsg (<, Rept: >) ; 9 25842 000666'01 260 17 0 00 000661* k20pdc - Kermit (Visual) Packet Decoding MACRO %53B(1254)-4 19:42 30-Mar-24 Page 20-3 K20PDC MAC 27-Mar-24 20:17 Break out parameters for S and I packets 25843 000306'02 000000000000# 25844 000307'02 777777 777770 25845 000302'03 054 040 122 145 160 25846 000667'01 200 02 0 00 000006 move t2, q2 25847 000670'01 260 17 0 00 000362* call BOUTI% 25848 25849 remark Extended capabilities 25850 25851 000671'01 361 07 0 00 000662* sojl q3, RSKP ; If nothing left, we're done 25852 000672'01 134 06 0 00 000005 ildb q2, q1 ; Otherwise, pick up first capability mask 25853 000673'01 405 06 0 00 000177 andi q2, 177 ;[235] Strip off any parity 25854 000674'01 275 06 0 00 000040 subi q2, .chspc ; Bring into numeric range 25855 000675'01 606 06 0 00 000002 trnn q2, 2 ; Is the Long Packets capability bit on? 25856 000676'01 254 00 0 00 000671* retskp ; No, we can't do anything else 25857 000677'01 120 02 0 00 000000# smsg (<, Long: >) ; 10 25858 000700'01 260 17 0 00 000666* 25859 000310'02 000000000000# 25860 000311'02 777777 777770 25861 000304'03 054 040 114 157 156 25862 25863 000701'01 415 16 0 00 000723' block. ; Enter block context for better control flow 25864 000702'01 261 17 0 00 000016 25865 000703'01 361 07 0 00 000572* sojl q3, r ; Stop if Sliding Windows isn't there 25866 000704'01 134 06 0 00 000005 ildb q2, q1 ; Yet ignore it because we don't do it 25867 000705'01 405 06 0 00 000177 andi q2, 177 ;[235] Strip off any parity 25868 000706'01 361 07 0 00 000703* sojl q3, r ; Stop if high order is not there 25869 000707'01 134 02 0 00 000005 ildb t2, q1 ; Load the high order 25870 000710'01 405 02 0 00 000177 andi t2, 177 ;[235] Strip off any parity 25871 000711'01 275 02 0 00 000040 subi t2, .chspc ; Bring into numeric range 25872 000712'01 221 02 0 00 000137 imuli t2, ^d95 ; High digit is base 94 25873 000713'01 361 07 0 00 000706* sojl q3, r ; Fail if low order is not there 25874 000714'01 134 03 0 00 000005 ildb t3, q1 ; It's there, load it 25875 000715'01 405 03 0 00 000177 andi t3, 177 ;[235] Strip off any parity 25876 000716'01 275 03 0 00 000040 subi t3, .chspc ; Bring into numeric range 25877 000717'01 270 02 0 00 000003 add t2, t3 ; Combine with high order 25878 000720'01 201 03 0 00 000012 movei t3, ^d10 ; Base 10 25879 000721'01 254 00 0 00 000676* retskp ; Flag we're actually doing long windows 25880 000722'01 263 17 0 00 000000 endbk. ; End block context 25881 000723'01 254 00 0 00 000730' ifskp. ; Have a number to type 25882 000724'01 104 00 0 00 000224 NOUT% ; Type it 25883 000725'01 320 12 0 00 000713* erjmpr r ; Or not 25884 000726'01 254 00 0 00 000721* retskp ; Succeed 25885 000727'01 254 00 0 00 000733' else. ; Otherwise, this is a request 25886 000730'01 120 02 0 00 000000# smsg () ; Say we'll accept it 25887 000731'01 260 17 0 00 000700* 25888 000312'02 000000000000# 25889 000313'02 777777 777767 25890 000306'03 101 166 141 151 154 25891 000732'01 254 00 0 00 000726* retskp ; This is OK, too 25892 000733'01 endif. 25893 25894 000733'01 254 00 0 00 000732* retskp ; This is superstition 25895 25896 k20pdc - Kermit (Visual) Packet Decoding MACRO %53B(1254)-4 19:42 30-Mar-24 Page 21 K20PDC MAC 27-Mar-24 20:17 Packet Header 25897 subttl Packet Header 25898 25899 ; t4/ "R" or "S", depending on what we're doing 25900 25901 000734'01 200 01 0 00 000013 pkthdr: move t1, p3 ; Load the logging JFN 25902 000735'01 120 02 0 00 000000# smsg <, type: > ; The packet type 25903 000736'01 260 17 0 00 000731* 25904 000314'02 000000000000# 25905 000315'02 777777 777770 25906 000310'03 054 040 164 171 160 25907 000737'01 200 02 0 00 000162* move t2, type ; Message Type 25908 000740'01 405 02 0 00 000177 andi t2, 177 ;[235] Strip off any parity 25909 000741'01 260 17 0 00 000670* call BOUTI% ; Will further expand downstream 25910 000742'01 200 04 0 00 000002 move t4, t2 ; Save a copy of the type 25911 25912 000743'01 120 02 0 00 000000# smsg <, seq: > ; The sequence number 25913 000744'01 260 17 0 00 000736* 25914 000316'02 000000000000# 25915 000317'02 777777 777771 25916 000312'03 054 040 163 145 161 25917 000745'01 200 02 0 00 000000* move t2, sseqn ; Load the Sending Packet Number 25918 000746'01 302 04 0 00 000123 caie t4, "S" ; But are we? 25919 000747'01 200 02 0 00 000000* move t2, num ; No, so load the received Packet Number 25920 000750'01 201 03 0 00 000012 movei t3, ^d10 ; It's in base 10 25921 000751'01 104 00 0 00 000224 NOUT% ; Type that 25922 000752'01 320 12 0 00 000031' erjmpr deberr ; Or not... 25923 25924 000753'01 120 02 0 00 000000# smsg <, len: > ; Total packet length 25925 000754'01 260 17 0 00 000744* 25926 000320'02 000000000000# 25927 000321'02 777777 777771 25928 000314'03 054 040 154 145 156 25929 000755'01 200 02 0 00 000000* move t2, pktlen ; Includes the checksum 25930 000756'01 201 03 0 00 000012 movei t3, ^d10 ; It's in base 10 25931 000757'01 104 00 0 00 000224 NOUT% ; Type that 25932 000760'01 320 12 0 00 000031' erjmpr deberr ; Or not... 25933 25934 000761'01 336 00 0 00 000000* ifmn. islong ; Was this a long packet? 25935 000762'01 254 00 0 00 000765' 25936 000763'01 201 02 0 00 000114 movei t2, "L" ; Load flag for long packet 25937 000764'01 260 17 0 00 000741* call BOUTI% ; Append it as a c-like suffix 25938 000765'01 endif. ; End case long packet 25939 25940 000765'01 120 02 0 00 000000# smsg <, Blk: > ; Computed block check 25941 000766'01 260 17 0 00 000754* 25942 000322'02 000000000000# 25943 000323'02 777777 777771 25944 000316'03 054 040 102 154 153 25945 000767'01 200 02 0 00 000000* move t2, blkchk ; Load it 25946 000770'01 201 03 0 00 000012 movei t3, ^d10 ; We'll just use base 10 25947 000771'01 104 00 0 00 000224 NOUT% ; Type it 25948 000772'01 320 12 0 00 000031' erjmpr deberr ; Or not 25949 25950 000773'01 254 00 0 00 000733* retskp ; Worked 25951 k20pdc - Kermit (Visual) Packet Decoding MACRO %53B(1254)-4 19:42 30-Mar-24 Page 22 K20PDC MAC 27-Mar-24 20:17 outc -- Output a single character, using ^X notation, DEL, etc. 25952 subttl outc -- Output a single character, using ^X notation, DEL, etc. 25953 25954 ; Call: 25955 ; 25956 ; t1/ JFN 25957 ; t2/ Character to frobinicate 25958 25959 extern BOUTI% ; In case this is going into a string 25960 25961 000774'01 405 02 0 00 000177 outc: andi t2, 177 ;[235] Strip off any parity 25962 000775'01 302 02 0 00 000177 caie t2, .chdel ; A rubout? 25963 000776'01 254 00 0 00 001002' ifskp. ; It is 25964 000777'01 120 02 0 00 000000# smsg ; Show it this way (^? being confusing?) 25965 001000'01 260 17 0 00 000766* 25966 000324'02 000000000000# 25967 000325'02 777777 777775 25968 000320'03 104 105 114 000 000 25969 001001'01 263 17 0 00 000000 ret ; Succeed 25970 001002'01 endif. 25971 25972 001002'01 301 02 0 00 000040 cail t2, .chspc ; Is it a control character? 25973 001003'01 254 00 0 00 001011' ifskp. ; It is 25974 001004'01 261 17 0 00 000002 push p, t2 ; Save the character 25975 001005'01 201 02 0 00 000136 movei t2, "^" ; Load the control quote 25976 001006'01 260 17 0 00 000764* call BOUTI% ; Output that 25977 001007'01 262 17 0 00 000002 pop p, t2 ; Restore original character 25978 001010'01 435 02 0 00 000100 ori t2, ^o100 ; Bring into printable range 25979 001011'01 endif. 25980 25981 001011'01 254 00 0 00 001006* callret BOUTI% ; Output possibly controlified character 25982 25983 k20pdc - Kermit (Visual) Packet Decoding MACRO %53B(1254)-4 19:42 30-Mar-24 Page 23 K20PDC MAC 27-Mar-24 20:17 Vestigial Code found to be largely uninformative 25984 subttl Vestigial Code found to be largely uninformative 25985 25986 repeat 0,< ; Mark character doesn't change 25987 move t1, p3 ; Load the logging JFN 25988 smsg < 25989 sop: > ; Indicate what should start the packet 25990 move t1, rsthdr ; Load Receive Start of Packet character 25991 rot t1, -^d8 ; Position as an eight bit ASCII string 25992 movem t1, sop8st ; And store it 25993 25994 dmove t1, [ ^d1 ; We are only doing one dinky character 25995 point 8, sop8st ] ; And the source is what we just built 25996 call s8ccv7 ; String eight controlified convert to seven 25997 ret ; Shouldn't fail, but better give up 25998 >;;repeat 0 25999 k20pdc - Kermit (Visual) Packet Decoding MACRO %53B(1254)-4 19:42 30-Mar-24 Page 24 K20PDC MAC 27-Mar-24 20:17 Code .psect close out 26000 subttl Code .psect close out 26001 26002 xlist ; Save the trees!! 26003 list ; Resume listing 26004 26005 .endps code ; Close the code .psect 26006 k20pdc - Kermit (Visual) Packet Decoding MACRO %53B(1254)-4 19:42 30-Mar-24 Page 25 K20PDC MAC 27-Mar-24 20:17 Module local working storage 26007 subttl Module local working storage 26008 26009 .psect data ; Open data storage 26010 000000'04 lstpkt: block 1 ; Last packet type 26011 000001'04 lstgen: block 1 ; Last generic type 26012 repeat 0,< 26013 sop8st: block 2 ; Start of Packet character as an 8 bit ASCII string 26014 > 26015 .endps data ; Close out the data .psect 26016 26017 .xcmsy ; Ditch any superfluous MACSYM junk 26018 end ; End of module NO ERRORS DETECTED PROGRAM BREAK IS 000000 PSECT 1 BREAK IS 001054 FOR CODE PSECT 2 BREAK IS 000326 FOR CONST PSECT 3 BREAK IS 000321 FOR ETEXT PSECT 4 BREAK IS 000002 FOR DATA CPU TIME USED 00:00.445 93P CORE USED k20pdc - Kermit (Visual) Packet Decoding MACRO %53B(1254)-4 19:42 30-Mar-24 Page S-1 K20PDC MAC 27-Mar-24 20:17 SYMBOL TABLE BOUTI% 000000 ext CALL 260740 000000 CALLRE 254000 000000 spd CODE 000000 ext CONST 000000 ext CX 000016 DATA 000000 ext DEBUG 000014 spd ERJMPR 320500 000000 int ERJMPS 320600 000000 int ERSTR% 104000 000011 int ETEXT 000000 ext LOGJFN 000000 ext NO%RDX 777777 sin NOP 600000 000000 sin NOUT% 104000 000224 int P 000017 P1 000011 spd P2 000012 spd P3 000013 spd P4 000014 spd P5 000015 spd PSOUT% 104000 000076 int Q1 000005 spd Q2 000006 spd Q3 000007 spd Q4 000010 spd Q5 000011 spd R 000000 ext RET 263740 000000 RQUOTE 000000 ext RSKP 000000 ext SOUT% 104000 000053 int SQUOTE 000000 ext T1 000001 spd T2 000002 spd T3 000003 spd T4 000004 spd XMOVEI 415000 000000 int $CLOSD 000000 ext %%SMSG 000000 ext ..MSK 777777 777777 spd .A16 000016 spd .CHDBQ 000042 spd .CHDEL 000177 sin .CHSPC 000040 sin .FHSLF 400000 sin .FP 000015 spd .FPAC 000005 spd .PRIOU 000101 sin .PX7 610001 000000 spd .SAC 000016 .SAV1 000000 ext .SAV2 000000 ext .SAV3 000000 ext k20pdc - Kermit (Visual) Packet Decoding MACRO %53B(1254)-4 19:42 30-Mar-24 Page S-2 K20PDC MAC 27-Mar-24 20:17 SYMBOL TABLE FOR PSECT CODE BLKCHK 000767' ext SPAKPT 000000 ext BOUTI% 001011' ext SPDECD 000152' DATLEN 000531' ext SQUOTE 000502' ext DATPTR 000117' ext SSEQN 000745' ext DEBERR 000031' ent TYPE 000737' ext DEFACK 000333' UNDACK 000317' DIAMSG 000000' ent $CLOSD 000046' ext DIAMSZ 000026' %%SMSG 001000' ext ERRACK 000322' ..0005 000013' spd FINTIM 000155' ext ..0006 000016' spd GENARG 000475' ..0007 000017' spd GENBYE 000464' ..0014 000026' spd GENCDU 000440' ..0023 000067' spd GENCWD 000443' ..0030 000076' spd GENDEL 000453' ..0031 000106' spd GENDIR 000450' ..0044 000136' spd GENDSK 000472' ..0051 000140' spd GENFIN 000456' ..0062 000177' spd GENHLP 000461' ..0067 000201' spd GENPWD 000435' ..0114 000250' spd GENSTA 000467' ..0122 000243' spd INIACK 000325' ..0123 000246' spd INVGEN 000432' ..0124 000250' spd INVSN1 000216' ..0133 000256' spd INVSN2 000220' ..0140 000260' spd INVSND 000213' ..0205 000351' spd INZACK 000330' ..0222 000346' spd ISLONG 000761' ext ..0233 000363' spd LOGJFN 000051' ext ..0247 000406' spd NUM 000747' ext ..0250 000411' spd OUTC 000774' ..0266 000421' spd PARAMS 000527' ..0341 000503' spd PDECOD 000050' ent ..0342 000526' spd PKTBCT 000000 ext ..0347 000510' spd PKTHDR 000734' ..0410 000636' spd PKTLEN 000755' ext ..0411 000644' spd R 000725' ext ..0421 000643' spd RPDECD 000107' ..0422 000644' spd RQUOTE 000500' ext ..0454 000723' spd RSKP 000773' ext ..0461 000730' spd RSTHDR 000000 ext ..0462 000733' spd SDATPT 000374' ext ..0477 000765' spd SNDACK 000307' ..0514 001002' spd SNDAT1 000250' ..0525 001011' spd SNDATA 000233' ..MX1 000012 spd SNDEOF 000372' ..MX2 000001 spd SNDEOT 000225' SNDERR 000261' SNDFIL 000265' SNDGEN 000412' SNDINI 000301' SNDINZ 000270' SNDNAK 000273' SNDREC 000276' SNDTXT 000304' k20pdc - Kermit (Visual) Packet Decoding MACRO %53B(1254)-4 19:42 30-Mar-24 Page S-3 K20PDC MAC 27-Mar-24 20:17 SYMBOL TABLE FOR PSECT CONST ACKTAB 000104' SGENPT 000162' SNDPKT 000016' k20pdc - Kermit (Visual) Packet Decoding MACRO %53B(1254)-4 19:42 30-Mar-24 Page S-4 K20PDC MAC 27-Mar-24 20:17 SYMBOL TABLE FOR PSECT DATA LSTGEN 000001' LSTPKT 000000' k20net - Kermit-20 Network Support MACRO %53B(1254)-4 19:42 30-Mar-24 Page 1 K20NET MAC 13-Dec-23 21:12 Preliminaries 26019 title k20net - Kermit-20 Network Support 26020 remark Moved to seperate module as part of 194 to address MCRNEC 26021 remark Originally part of [186] 26022 26023 subttl Preliminaries 26024 26025 search monsym,macsym,cmd,k20unv ;[194] 26026 cmdacs ^ ;Clean up p1-p4 definitions 26027 26028 sall ; Tidy listing 26029 .directive flblst ; We don't need to see all the ASCIZ bytes... 26030 26031 extern ttyjfn ; JFN for controlling terminal 26032 extern ttyini ; Condition local terminal for connection 26033 extern savlnw ; Save terminal length and width 26034 extern rstlnw ; Restore terminal length and width 26035 extern netjfn ; Holds any kind of communications JFN 26036 extern netflg ; Flags returned from GTJFN% (unused) 26037 extern nodnam ; Parsed node name 26038 extern nodnum ; Converted node number, if we have it 26039 extern asgflg ; Flags that we have assigned a device 26040 extern asgdev ; Device we assigned (always a PTY) 26041 extern srvflg ; If running as a server 26042 extern myjob ; My current logged in job 26043 extern mytty ; My current attached terminal 26044 extern ttynum ; Line number of current connection 26045 extern mycaps ; This process' capability vector 26046 extern crlf ; Handy way to save two bytes 26047 extern %%jser ; JSYS error handler 26048 extern errptr ; Pointer to copies of error messages 26049 extern symout ; Given an address, types an associated symbol 26050 26051 remark Common parsing external data 26052 26053 extern pars3 ; Data from third parsed item 26054 extern pars4 ; Data from fourth parsed item 26055 extern pars5 ; Data from fifth parsed item (rarely used) 26056 extern pars6 ;[218] Data from six parsed item (even more rare) 26057 extern pars7 ;[236] Whether we're doing .MOSNH 26058 extern atmbuf ; The atom buffer 26059 26060 remark External linkages for INPUT/OUTPUT 26061 26062 extern inpclr ;[209] Clear the buffer 26063 extern handsh ;[190] Handshake character 26064 26065 remark External Parity routines and working storage (all 233) 26066 26067 extern parity ; Type of parity in use 26068 extern none ; No parity being enforced 26069 extern space ; Space parity routine (0, always) 26070 extern mark ; Mark parity routine (1, always) 26071 extern even ; Even parity routine 26072 extern odd ; Odd parity routine 26073 extern parpko ; Non-zero if doing parity on packets, only k20net - Kermit-20 Network Support MACRO %53B(1254)-4 19:42 30-Mar-24 Page 1-1 K20NET MAC 13-Dec-23 21:12 Preliminaries 26074 extern parrck ; Checking parity on recieve in addition to sending 26075 extern ttipar ; Total parity errors for session 26076 extern movchr ; Translates between 7 and 8 bit 26077 extern genpar ; Use string instructions generate a new string 26078 extern chkpar ; Use string instructions to check parity 26079 extern strc ; Count of characters in temporary buffer 26080 extern strptr ; Appropriate pointer to same 26081 extern strbuf ; Global address of string buffer 26082 remark strbf2 ; Flows into this, too 26083 26084 .psect code/ronly ; Pure code, pure heaven 26085 k20net - Kermit-20 Network Support MACRO %53B(1254)-4 19:42 30-Mar-24 Page 2 K20NET MAC 13-Dec-23 21:12 Acquire information about local node 26086 subttl Acquire information about local node 26087 26088 ; Double checks if the system even has DECnet, just in case. It is 26089 ; possible to configure a system without DECnet; in fact, *all* Toad's 26090 ; are thus because they can't change the MAC address of their network 26091 ; adaptor. 26092 ; 26093 ; A remarkable oversight, if it was one, but DEC's decision to just 26094 ; snag part of the global MAC address space always seemed questionable 26095 ; to some. 26096 ; 26097 ; So we have to do this in order to not break on either a Toad, which 26098 ; can never have DECnet (see above) or a monitor built without it. 26099 ; 26100 ; Code lifted from my rewrite of SETNOD (SETND2) and properly Kermit 26101 ; cased... 26102 26103 000000'01 lclnod: entry lclnod 26104 000000'01 265 16 0 00 005273' saveac ; Wants a few extra registers 26105 remark q1, t5 ; Note, t5 aliases q1 26106 26107 000001'01 402 00 0 00 000000# setzm ndvfxp ; Assume doesn't have extended verify 26108 000002'01 201 07 0 00 000000# movei q3, cnfigd ; Resolve area to 18 bit address 26109 000003'01 201 01 0 00 000010 movx t1, .cfiln ; Length (maximum) 26110 26111 000004'01 403 02 0 00 000003 setzb t2, t3 ; Create two handy zeros 26112 000005'01 124 01 0 07 000000 dmovem t1, .cflen(q3) ; Set length, clear processor type 26113 000006'01 124 02 0 07 000002 dmovem t2, .cfise(q3) ; Clear serial number and microcode 26114 000007'01 124 02 0 07 000004 dmovem t2, .cfiho(q3) ; Clear hardware and microcode options 26115 000010'01 124 02 0 07 000006 dmovem t2, .cfiso(q3) ; Clear software options and version 26116 26117 000011'01 124 02 0 00 000000# dmovem t2, mynode ; Zero local executor and NDVFXP 26118 000012'01 124 02 0 00 000000# dmovem t2, myname ; Scrub the node name area 26119 26120 000013'01 201 01 0 00 000000 movx t1, .cfinf ; Want basic configuration 26121 000014'01 200 02 0 00 000007 move t2, q3 ; Where to put the goodies 26122 000015'01 104 00 0 00 000627 CNFIG% ; See what this monitor has 26123 000016'01 320 12 0 00 000000* erjmpr r ; Nothing, forget about the whole thing 26124 26125 000017'01 554 03 0 07 000000 load t3, cf%wdp,.cflen(q3) ;Load words returned 26126 000020'01 275 03 0 00 000001 subi t3, ^d1 ; Convert count to offset 26127 000021'01 305 03 0 00 000007 caige t3, .cfivr ; Need Tops-20 version 26128 000022'01 263 17 0 00 000000 ret ; Unable to determine Tops-20 version 26129 26130 000023'01 135 03 0 00 005305' load t3, vi%maj,.cfivr(q3) ;Load Tops-20 major release 26131 000024'01 305 03 0 00 000007 caige t3, 7 ; Needs Phase IV 26132 000025'01 254 00 0 00 000034' ifskp. ; So far, so good 26133 000026'01 302 03 0 00 000007 caie T3, 7 ; Exactly version seven? 26134 000027'01 254 00 0 00 000033' ifskp. ; Have to check minor version 26135 000030'01 135 03 0 00 005306' load t3, vi%min,.cfivr(q3) ;Load Tops-20 minor release 26136 000031'01 305 03 0 00 000001 caige t3, 1 ; Needs .NDINT 26137 000032'01 263 17 0 00 000000 ret ; Requires Tops-20 minor version one 26138 000033'01 endif. ; Otherwise, OK or after 7 (!) 26139 000033'01 254 00 0 00 000035' else. ; Otherwise, won't work 26140 000034'01 263 17 0 00 000000 ret ; Requires at least Tops-20 major version seven k20net - Kermit-20 Network Support MACRO %53B(1254)-4 19:42 30-Mar-24 Page 2-1 K20NET MAC 13-Dec-23 21:12 Acquire information about local node 26141 000035'01 endif. 26142 26143 000035'01 200 04 0 07 000006 move t4, .cfiso(q3) ; Load software options 26144 000036'01 607 04 0 00 200000 txnn t4, cf%dcn ; So, do we have DECnet? 26145 000037'01 263 17 0 00 000000 ret ; Nope, System is not configured for DECnet 26146 26147 000040'01 120 01 0 00 005307' dmove t1, [exp .ndgnm,t3] ;Get local node number 26148 000041'01 104 00 0 00 000567 NODE% ; In t3 26149 000042'01 320 12 0 00 000016* erjmpr r ; Give up, shouldn't ever fail.. 26150 000043'01 306 03 0 00 000000 cain t3, 0 ; Is DECnet running? 26151 000044'01 263 17 0 00 000000 ret ; System DECnet node number not configured 26152 000045'01 202 03 0 00 000000# movem t3, mynode ; Store away my local node number 26153 26154 000046'01 120 01 0 00 005311' dmove t1, [exp .ndgln,t3] ;Get local node name 26155 000047'01 561 03 0 00 000000# hrroi t3, myname ; Point to storage 26156 000050'01 104 00 0 00 000567 NODE% ; In t3 26157 000051'01 320 12 0 00 000053' ifje. r ; Failed?? 26158 000052'01 254 00 0 00 000055' 26159 000053'01 403 02 0 00 000003 setzb t2, t3 ; Cons up a couple of NUL's 26160 000054'01 124 02 0 00 000000# dmovem t2 ,myname ; Make sure no name 26161 000055'01 endif. 26162 26163 000055'01 332 00 0 00 000000# ifme. myname ; Get anything? 26164 000056'01 254 00 0 00 000061' 26165 000057'01 402 00 0 00 000000# setzm mynode ; Whack the executor node number 26166 000060'01 263 17 0 00 000000 ret ; System DECnet node name not configured 26167 000061'01 endif. 26168 ; At this point, we know we have DECnet 26169 remark ; See if monitor has extended verify (T79) 26170 000061'01 120 01 0 00 005313' dmove t1, [exp .ndvfx,t3] ;Node name verify, extended 26171 000062'01 561 03 0 00 000000# hrroi t3, myname ; Point to local node name 26172 000063'01 104 00 0 00 000567 NODE% ; See if .NDVFX exists 26173 000064'01 320 12 0 00 000066' ifje. r ; Oh dear, doesn't look promising 26174 000065'01 254 00 0 00 000071' 26175 000066'01 302 01 0 00 601713 caxe t1, argx02 ; Monitor doesn't have winning .NDVFX? 26176 000067'01 263 17 0 00 000000 ret ; That's fine, so don't use it 26177 000070'01 403 04 0 00 000005 setzb t4, t5 ; Zap flags and so forth 26178 000071'01 endif. ; End node processing 26179 26180 000071'01 607 04 0 00 020000 txnn t4, nd%num ; Better have gotten a number (as it is us) 26181 000072'01 263 17 0 00 000000 ret ; .NDVFX response did not get local node number 26182 000073'01 312 05 0 00 000000# came t5, mynode ; Yes, but is it in fact the local executor? 26183 000074'01 263 17 0 00 000000 ret ; Inconsistent local node number results 26184 000075'01 350 00 0 00 000000# aos ndvfxp ; Mark that it fully works 26185 000076'01 263 17 0 00 000000 ret ; We're done 26186 k20net - Kermit-20 Network Support MACRO %53B(1254)-4 19:42 30-Mar-24 Page 3 K20NET MAC 13-Dec-23 21:12 Get the 'name' of the local system 26187 subttl Get the 'name' of the local system 26188 26189 ; Because one can be going from one DECSYSTEM-20 to another, the 26190 ; message, "Returning to DEC20" might be confusing, particularly if 26191 ; one is so lucky as to have multiple parallel transfers happening to 26192 ; foreign systems. While uncommon, there is nothing preventing this 26193 ; scenario. 26194 ; 26195 ; Therefore, we pull the system name. We prefer GETAB% over NODE% 26196 ; because this should always work, whereas NODE% will give you 26197 ; something like "TOPS20" on a non-DECnet site that hasn't configured 26198 ; the name in SETSPD. 26199 ; 26200 ; If, for some reason, we can't do the GETAB% (as in some fascist ACJ 26201 ; prevents it on a truly locked down system), we will use NODE%. 26202 ; NODE% is supposed to work whether or not DECnet is in monitor (see 26203 ; STG). 26204 ; 26205 ; N.B., Since using GETAB%, we have to do a little parsing of SYSVER 26206 ; 26207 ; The problem is that SYSVER has too much blather in it and sometimes 26208 ; also includes propaganda and system version information. Since the 26209 ; first part is simply SYSTEM:MONNAM.TXT (which is supposed to be 26210 ; there), we parse the return up to the comma and use that. 26211 ; 26212 ; Code adapted from UPTIME; expects to be called AFTER lclnod in case 26213 ; SYSGT% and/or GETAB% either can't work (because no SC%GTB) or fail. 26214 ; 26215 ; Counts the string in case somebody needs it, later 26216 26217 000077'01 getnam: entry getnam 26218 000077'01 265 16 0 00 005273' saveac ; Needs some extra registers 26219 000100'01 403 01 0 00 000002 setzb t1,t2 ; Cons up a nice long zero 26220 000101'01 124 01 0 00 000000# dmovem t1,syscnt ; Stomp count and a few characters 26221 26222 000102'01 205 03 0 00 200000 movx t3,sc%gtb ; GETAB% capability? 26223 000103'01 616 03 0 00 000000# tdnn t3,mycaps+1 ; We have it, right? 26224 000104'01 254 00 0 00 000145' jrst getnod ; Most unusual! 26225 26226 000105'01 200 01 0 00 005315' movx t1,'SYSVER' ; Want system version information 26227 000106'01 104 00 0 00 000016 SYSGT% ; Pull out first word and table metadata 26228 000107'01 320 12 0 00 000145' erjmpr getnod ; Gronked?? Try something else 26229 000110'01 202 02 0 00 000000# movem t2,sysver ; Save table length and index (just in case) 26230 000111'01 550 06 0 00 000002 hrrz q2,t2 ; Cache the index in a fast place 26231 000112'01 515 05 0 00 000001 hrlzi q1,^d1 ; Put the table increment in the right place 26232 ; Now decide how long to loop 26233 000113'01 564 02 0 00 000002 hlro t2,t2 ; Turn into a fullword negative number 26234 000114'01 213 07 0 00 000002 movns q3,t2 ; Positivize it (note arcane use of self) 26235 000115'01 303 02 0 00 000011 caxle t2,syslen ; Will the table fit? 26236 000116'01 201 07 0 00 000011 movx q3,syslen ; Sadly, no. Clip it down 26237 000117'01 120 03 0 00 005316' dmove t3,[exp sysnam,0] ; Address of where to store text, nothing seen 26238 ; Fall through with first word 26239 000120'01 do. ; Enter loop context 26240 000120'01 202 01 0 03 000000 movem t1,(t3) ; Stomp the whole word into memory 26241 000121'01 334 02 0 00 000001 skipa t2,t1 ; Set up for correct shift k20net - Kermit-20 Network Support MACRO %53B(1254)-4 19:42 30-Mar-24 Page 3-1 K20NET MAC 13-Dec-23 21:12 Get the 'name' of the local system 26242 000122'01 do. ; Inner loop to check characters 26243 000122'01 322 02 0 00 000130' jumpe t2,endlp. ; Processed everything? 26244 000123'01 400 01 0 00 000000 setz t1, ; clear a 'linked' register for a shift pair 26245 000124'01 246 01 0 00 000007 lshc t1,^d7 ; Peel off a character (faster than an ILDB) 26246 000125'01 306 01 0 00 000054 cain t1,"," ; A comma? 26247 000126'01 254 00 0 00 000137' jrst postab ; Yes, we've finally gone past the name 26248 000127'01 344 04 0 00 000122' aoja t4,top. ; Otherwise, count the character and inner loop 26249 000130'01 enddo. ; End inner loop to check characters 26250 000130'01 363 07 0 00 000137' sojle q3,endlp. ; Account for a full word done, maybe terminate 26251 000131'01 270 06 0 00 000005 add q2,q1 ; Bump to next GETAB% index 26252 000132'01 200 01 0 00 000006 move t1,q2 ; Load next requested word 26253 000133'01 104 00 0 00 000010 GETAB% ; Ask for it 26254 000134'01 320 12 0 00 000137' erjmpr postab ; Failed, just use what we have 26255 000135'01 322 01 0 00 000137' jumpe t1,postab ; If end, head off for post table processing 26256 000136'01 344 03 0 00 000120' aoja t3,top. ; Otherwise, handle this word 26257 000137'01 enddo. ; End of GETAB% loop context 26258 26259 000137'01 202 04 0 00 000000# postab: movem t4,syscnt ; We know the length of the system name!! 26260 000140'01 271 04 0 00 000001 addi t4,^d1 ; Get past last character (faster than ILDB) 26261 000141'01 133 04 0 00 005320' adjbp t4,[point 7,sysnam] ; Point to where we stored everything 26262 000142'01 400 01 0 00 000000 setz t1, ; Cons up a .CHNUL 26263 000143'01 137 01 0 00 000004 dpb t1,t4 ; Tie off the string (faster than ILDB) 26264 000144'01 263 17 0 00 000000 ret ; And down 26265 k20net - Kermit-20 Network Support MACRO %53B(1254)-4 19:42 30-Mar-24 Page 4 K20NET MAC 13-Dec-23 21:12 Get the 'name' of the local system 26266 remark Handle case of no SC%GTB or SYSGT%/GETAB% failure 26267 26268 ; NODE% should always work and one assumes that DECnet is set up on 26269 ; all modern systems. However, many systems had no DECnet and only 26270 ; ran ARPA code. That is less common as Galaxy assumes DECnet and 26271 ; parts of CFS seem to. 26272 ; 26273 ; As there were also systems with no ARPA code, we use a very old- 26274 ; fashioned method for getting the name and are highly defensively 26275 ; coded. 26276 ; 26277 ; Code lifted from my rewrite of SETNOD (SETND2) and properly Kermit 26278 ; cased... 26279 26280 000145'01 120 02 0 00 000000# getnod: dmove t2,myname ; Load what DECnet thinks 26281 000146'01 322 02 0 00 000170' jumpe t2,niente ; Didn't think much! Just default it 26282 000147'01 312 02 0 00 005321' came t2,[ascii "TOPS2"] ; First five of standard default? 26283 000150'01 254 00 0 00 000153' ifskp. ; Yep, let's look at the 2nd word 26284 000151'01 316 03 0 00 005322' camn t3,[ascii "0"] ; Really standard default?? 26285 000152'01 254 00 0 00 000170' jrst niente ; Default it to something nicer 26286 000153'01 endif. ; Otherwise, fall through 26287 26288 dmove t4,[point 7,sysnam ;Point to text to spew 26289 000153'01 120 04 0 00 005323' 0 ] ; Zero counter 26290 000154'01 do. ; Enter outer loop context 26291 000154'01 do. ; Enter inner loop context 26292 000154'01 400 01 0 00 000000 setz t1, ; whack the character accumulator 26293 000155'01 246 01 0 00 000007 lshc t1,^d7 ; Peel off a character (faster than an ILDB) 26294 000156'01 322 01 0 00 000161' jumpe t1,endlp. ; End of string? Do next word 26295 000157'01 136 01 0 00 000004 idpb t1,t4 ; Deposit into target string 26296 000160'01 344 05 0 00 000154' aoja q1,top. ; Next character 26297 000161'01 enddo. ; End of inner loop context 26298 000161'01 336 02 0 00 000003 skipn t2,t3 ; Position second word 26299 000162'01 254 00 0 00 000165' exit. ; Unless we're done 26300 000163'01 400 03 0 00 000000 setz t3, ; Set a talsiman 26301 000164'01 254 00 0 00 000154' jrst top. ; Peel a few more characters off 26302 000165'01 enddo. ; End of outer loop context 26303 26304 000165'01 202 05 0 00 000000# movem q1,syscnt ; Update string length count 26305 000166'01 136 03 0 00 000004 idpb t3,t4 ; Tie off the string 26306 000167'01 263 17 0 00 000000 ret ; Done 26307 k20net - Kermit-20 Network Support MACRO %53B(1254)-4 19:42 30-Mar-24 Page 5 K20NET MAC 13-Dec-23 21:12 Get the 'name' of the local system 26308 remark Here if we are just not having any luck with the local system name 26309 26310 chgsec(code,text) 26311 000000'02 104 105 103 055 062 defnam: asciz "DEC-20" ; Clear up where we are 26312 000002'02 000 00 0 00 000000 Z ; Historically what we called ourselves 26313 retsec 26314 26315 000170'01 120 01 0 00 000000# niente: dmove t1,defnam ; Load default name 26316 000171'01 124 01 0 00 000000# dmovem t1,sysnam ; Store default name 26317 000172'01 402 00 0 00 000000# setzm sysnam+2 ; Tie of the string 26318 000173'01 201 03 0 00 000006 movei t3,^d6 ; Length of unterminated string 26319 000174'01 202 03 0 00 000000# movem t3,syscnt ; Store the count 26320 26321 000175'01 263 17 0 00 000000 ret ; And done 26322 k20net - Kermit-20 Network Support MACRO %53B(1254)-4 19:42 30-Mar-24 Page 6 K20NET MAC 13-Dec-23 21:12 Set default prompt if doing network 26323 subttl Set default prompt if doing network 26324 26325 ; Sets a default prompt to use when we are NRT'ing in case it 26326 ; it is asked for by SET PROMPT (see .setpr: in k20par) 26327 26328 000176'01 setdef: entry setdef ; Called once at startup 26329 dmove t1,[point 7,myprom ; Default prompt, if needed 26330 000176'01 120 01 0 00 005325' point 7,sysnam] ; Source is local system name 26331 000177'01 200 04 0 00 000000# move t4,syscnt ; Length 26332 26333 000200'01 201 03 0 00 000042 movei t3, .chdbq ; Load a double quote 26334 000201'01 136 03 0 00 000001 idpb t3,t1 ; Deposit it in prompt 26335 26336 000202'01 do. ; Enter loop context. 26337 000202'01 134 03 0 00 000002 ildb t3,t2 ; Load source from local system name 26338 000203'01 136 03 0 00 000001 idpb t3,t1 ; Deposit it in prompt 26339 000204'01 367 04 0 00 000202' sojg t4,top. ; All of it 26340 000205'01 enddo. ; Exit loop context. 26341 26342 dmove t3,[ .chrpt ; Load right pointy bracket 26343 000205'01 120 03 0 00 005327' .chdbq ] ; And a double quote 26344 000206'01 136 03 0 00 000001 idpb t3,t1 ; Make prompt obvious 26345 000207'01 136 04 0 00 000001 idpb t4,t1 ; Close out default for .cmqst 26346 26347 000210'01 400 03 0 00 000000 setz t3, ; Cons up a .chnul 26348 000211'01 136 03 0 00 000001 idpb t3,t1 ; Close out the string 26349 000212'01 263 17 0 00 000000 ret 26350 k20net - Kermit-20 Network Support MACRO %53B(1254)-4 19:42 30-Mar-24 Page 7 K20NET MAC 13-Dec-23 21:12 Perform network connect and initial NRT negotiation 26351 subttl Perform network connect and initial NRT negotiation 26352 26353 ; Call: 26354 ; 26355 ; nodnam has result of .CMNOD 26356 ; 26357 ; Return: 26358 ; 26359 ; +1/ Couldn't open connection 26360 ; +2/ Connection open and negotiated with a remote NRT 26361 ; t1/ Network JFN we got 26362 26363 000213'01 decnct: entry decnct ; Called by k20mit, also 26364 000213'01 402 00 0 00 000000# setzm binflg ; Assume we don't have binary 26365 000214'01 402 00 0 00 000000# setzm nrtflg ; And that we don't have an NRT, either 26366 000215'01 260 17 0 00 000236' call chknrt ; First see if node itself exists 26367 000216'01 254 00 0 00 003224' callret clscln ; Failed, scrub storage 26368 000217'01 202 01 0 00 000000* movem t1,ttynum ; Store node number as line number 26369 000220'01 260 17 0 00 000262' call openrt ; Perform initial open activities 26370 000221'01 254 00 0 00 003044' callret clsjfn ; Unless build and open fail 26371 000222'01 260 17 0 00 000330' call waitcn ; Now wait for NSP negotiation 26372 000223'01 263 17 0 00 000000 ret ; Return +1, waitcn cleans up correctly 26373 000224'01 260 17 0 00 000603' call fixnam ; Rewrite remote node name 26374 000225'01 260 17 0 00 000627' call chktop ; Ensure it suppors Tops-10/20 NRT's 26375 000226'01 263 17 0 00 000000 ret ; It does't ... chktop cleans up correctly 26376 000227'01 201 03 0 00 000022 movei t3, .dvdcn ; Opened a DECnet NRT! 26377 000230'01 202 03 0 00 000000# movem t3, opndev ; Store opened device type 26378 000231'01 476 00 0 00 000000* setom vtermf ; Set the virtual terminal flag 26379 000232'01 476 00 0 00 000000* setom local ; We're the local Kermit 26380 remark gndpar ;[223] Can't get parity from a network JFN 26381 000233'01 402 00 0 00 000000# setzm opnpar ;[223] Either way, NRT's do not support parity 26382 000234'01 550 01 0 00 000000* hrrz t1, netjfn ;[223] Return JFN, no flags 26383 000235'01 254 00 0 00 000000* retskp ; Connected and ready to go! 26384 k20net - Kermit-20 Network Support MACRO %53B(1254)-4 19:42 30-Mar-24 Page 8 K20NET MAC 13-Dec-23 21:12 Checks that the candidate node exists 26385 subttl Checks that the candidate node exists 26386 26387 ; Verifies parsed node and attempts to extract some useful 26388 ; information. This should not be necessary, because unless CM%PO 26389 ; (parse-only) is set, when doing a .CMNOD, Tops-20 itself verifies 26390 ; that whats in the atom buffer exists in the monitor's data base. 26391 ; 26392 ; However we have to do the call to get the node number, which we 26393 ; pretend is a terminal number. 26394 ; 26395 ; Call: 26396 ; 26397 ; nodnam has ... something (see above) 26398 ; 26399 ; Return: 26400 ; 26401 ; +1/ Wasn't a valid DECnet node 26402 ; +2/ Valid DECnet node, t1 has node number if monitor supports this 26403 26404 000236'01 265 16 0 00 005331' chknrt: saveac ; Alias t5 26405 000237'01 120 01 0 00 005313' dmove t1,[exp .ndvfx,t3] ;Node name verify, extended 26406 000240'01 336 00 0 00 000000# skipn ndvfxp ; Has extended verify? 26407 000241'01 201 01 0 00 000015 movx t1, .ndvfy ; Pity, but still usable 26408 000242'01 561 03 0 00 000000* hrroi t3, nodnam ; Point to whatever .CMNOD got 26409 000243'01 104 00 0 00 000567 NODE% ; Get some information 26410 000244'01 320 12 0 00 000246' ifje. r ; Catch the error 26411 000245'01 254 00 0 00 000250' 26412 000246'01 200 02 0 00 000001 move t2, t1 ; Save for debugging 26413 000247'01 403 04 0 00 000005 setzb t4, t5 ; Zap flags and so forth 26414 000250'01 endif. ; 26415 000250'01 477 01 0 00 000000* setob t1, nodnum ; Let's assume nothing works 26416 000251'01 607 04 0 00 200000 txnn t4, nd%lgl ; Double check COMND% .CMNOD, just in case 26417 000252'01 263 17 0 00 000000 ret ; Then how did it get parsed?? 26418 000253'01 607 04 0 00 400000 txnn t4, nd%exm ; Legal, but do we know it? 26419 000254'01 263 17 0 00 000000 ret ; No, we do not 26420 26421 000255'01 607 04 0 00 020000 txnn t4, nd%num ; Did we get a number? 26422 000256'01 254 00 0 00 000235* retskp ; Oh well, maybe old monitor 26423 26424 000257'01 202 05 0 00 000250* movem t5, nodnum ; Save a node number, if we have it 26425 000260'01 200 01 0 00 000005 move t1, t5 ; Return a number to caller 26426 000261'01 254 00 0 00 000256* retskp ; And we are out of here! 26427 k20net - Kermit-20 Network Support MACRO %53B(1254)-4 19:42 30-Mar-24 Page 9 K20NET MAC 13-Dec-23 21:12 Open DECnet connect to NRT object 26428 subttl Open DECnet connect to NRT object 26429 26430 ; Here to actually open the connect. Check to see if the remote 26431 ; system is Tops-10 or Tops-20, in which case we can directly use 26432 ; it as if it were a terminal. This is not possible with a CTERM 26433 ; or TVT because there would be meta-data to process. 26434 ; 26435 ; Note, current behavior is that the OPENF% will succeed whether 26436 ; or not GJ%FLG is set, but strangely, NO traffic will be possible 26437 ; if is not used! If GJ%FLG is issued, then the following flags 26438 ; are returned: 26439 ; 26440 ; Bit Name Comment 26441 ; === ====== ================================================ 26442 ; 6 GJ%UHV The file used has the highest generation number 26443 ; because a generation number of 0 was given in the 26444 ; call. This is clearly false because no generation 26445 ; number nor extension (type) is supplied. 26446 ; 26447 ; 12 GJ%GND Files marked for deletion were not considered when 26448 ; assigning JFNs. 26449 ; 26450 ; 17 GJ%GIV Invisible files were not considerd when assigning 26451 ; JFNs. 26452 ; 26453 ; Why this makes it work is anybody's guess... 26454 ; 26455 ; Call: 26456 ; 26457 ; nodnam has validated foreign node name 26458 ; 26459 ; Return: 26460 ; 26461 ; +1/ Failed to create a JFN to the remote NRT 26462 ; +2/ JFN exists for remote object and is open 26463 26464 chgsec(code,const) ; Constants 26465 000000'03 000000000000# nrtadr: nrtobj ; Where to build network file spec to MCBNRT 26466 000001'03 623075 635000 nrtdev: byte (7) "d","c","n",":",.chnul ;Device name for client connections 26467 000002'03 000003 154455 nrtnum: byte (1) 0 (7) .chnul,.chnul,"3","2",.chdas 26468 retsec 26469 26470 000262'01 402 00 0 00 000000* openrt: setzm asgflg ; Certainly will not be assigning DCN:! 26471 000263'01 402 00 0 00 000000* setzm asgdev ; So don't put it there 26472 000264'01 120 01 0 00 000000# dmove t1,nrtadr ; Load address of object and device name 26473 000265'01 202 02 0 01 000000 movem t2, (t1) ; Start with "DCN:" 26474 000266'01 505 01 0 00 100700 hrli t1,(point 7,0,27) ; Point to ":" 26475 26476 000267'01 201 03 0 00 000242* movei t3,nodnam ; Resolve address of parsed node name 26477 000270'01 505 03 0 00 440700 hrli t3,() ; Turn into a local ASCII pointer 26478 ; And append the node name 26479 000271'01 do. ; Enter loop lexical context 26480 000271'01 134 02 0 00 000003 ildb t2,t3 ; Load node name byte 26481 000272'01 322 02 0 00 000275' jumpe t2,endlp. ; Exit if at end of string 26482 000273'01 136 02 0 00 000001 idpb t2,t1 ; Append to file specification k20net - Kermit-20 Network Support MACRO %53B(1254)-4 19:42 30-Mar-24 Page 9-1 K20NET MAC 13-Dec-23 21:12 Open DECnet connect to NRT object 26483 000274'01 254 00 0 00 000271' loop. ; Go get some more 26484 000275'01 enddo. ; end loop lexical context 26485 ; Append MCBNRT's object type 26486 000275'01 200 02 0 00 000000# move t2, nrtnum ; Complete NRT number portion 26487 000276'01 136 02 0 00 000001 idpb t2,t1 ; Drop in the dash 26488 000277'01 242 02 0 00 777771 lsh t2,-^d7 ; Shift the "2" into place 26489 000300'01 136 02 0 00 000001 idpb t2,t1 ; Drop in the "2" 26490 000301'01 242 02 0 00 777771 lsh t2,-^d7 ; Shift the "3" into place 26491 000302'01 136 02 0 00 000001 idpb t2,t1 ; Drop in the "3" 26492 000303'01 400 02 0 00 000000 setz t2, ; Cons up a NUL 26493 000304'01 136 02 0 00 000001 idpb t2,t1 ; Tie off the line 26494 26495 000305'01 205 01 0 00 000021 movx t1,gj%sht!gj%flg ; Do a short form GTJFN with flags 26496 000306'01 561 02 0 00 000000# hrroi t2,nrtobj ; Using the spec just built 26497 000307'01 104 00 0 00 000020 GTJFN% ; Get DCN connection 26498 000310'01 320 12 0 00 000312' %jserr (,clscln) ; Scrub storage 26499 000311'01 254 00 0 00 000315' 26500 000312'01 265 01 0 00 000000* 26501 000313'01 000000000000# 26502 000314'01 254 00 0 00 003224' 26503 000000'04 125 156 141 142 154 26504 26505 000315'01 552 01 0 00 000234* hrrzm t1,netjfn ; Save JFN for the connection 26506 000316'01 512 01 0 00 000000* hllzm t1,netflg ; Save returned flags 26507 000317'01 621 01 0 00 777777 tlz t1,-1 ; But shut them off for downstream 26508 ; 8 bit bytes, small buffers and read/write 26509 000320'01 200 02 0 00 005337' move t2,[fld(^d8,of%bsz)!fld(.gssmb,of%mod)!of%rd!of%wr] 26510 000321'01 104 00 0 00 000021 OPENF% ; Open the network connection 26511 000322'01 320 12 0 00 000324' %jserr (,clsjfn) ; Toss the JFN 26512 000323'01 254 00 0 00 000327' 26513 000324'01 265 01 0 00 000312* 26514 000325'01 000000000000# 26515 000326'01 254 00 0 00 003044' 26516 000005'04 125 156 141 142 154 26517 000327'01 254 00 0 00 000261* retskp ; Return success 26518 k20net - Kermit-20 Network Support MACRO %53B(1254)-4 19:42 30-Mar-24 Page 10 K20NET MAC 13-Dec-23 21:12 Wait for DECnet connection completion 26519 subttl Wait for DECnet connection completion 26520 26521 ; Once we are done building the connection string and have successfully 26522 ; done the OPENF%, we must wait a bit for DECnet to complete network 26523 ; level negotiations. 26524 26525 ; This was is done by sitting in a loop, waiting a quarter second, 26526 ; checking the connection status and, if connected, returning. 26527 ; Otherwise we'd go around and do it again for the specified number of 26528 ; times. 26529 ; 26530 ; The new code sets a connection interrupt (mo%cdn) which results in a 26531 ; lot snappier response. Moral of the Story: Don't Poll. 26532 26533 ;[218] Rewritten for connection interrupts 26534 26535 extern dnchb ; DECnet channel bit, defined in k20sub 26536 extern dncfld,dndfld ; DECnet channal assignment/deassignment field 26537 extern timeon,timdel ; Force a specific time, force a timer delete 26538 extern ccon,ccoff2 ; Set up Control-C handler 26539 extern cyon, cyoff ; Set up Control-Y handler 26540 extern cyseen ; Set if Control-Y typed 26541 extern delay ; Default connect time out 26542 26543 000330'01 200 01 0 00 000315* waitcn: move t1, netjfn ; Load the network JFN 26544 dmove t2, [ .moacn ; Code to enable interrupts 26545 000331'01 120 02 0 00 005340' dncfld ] ; Channel to enable on 26546 000332'01 104 00 0 00 000077 MTOPR% ; Enable the interrupt 26547 000333'01 320 12 0 00 000335' %jserr (,clsnet) 26548 000334'01 254 00 0 00 000340' 26549 000335'01 265 01 0 00 000324* 26550 000336'01 000000000000# 26551 000337'01 254 00 0 00 003047' 26552 000013'04 104 105 103 156 145 26553 dmove t1, [ .fhslf ; This process 26554 000340'01 120 01 0 00 005342' dnchb ] ; DECnet connection channel 26555 000341'01 104 00 0 00 000131 AIC% ; Turn the channel on 26556 000342'01 320 12 0 00 000344' %jserr (,clsnet) ;?? 26557 000343'01 254 00 0 00 000347' 26558 000344'01 265 01 0 00 000335* 26559 000345'01 000000000000# 26560 000346'01 254 00 0 00 003047' 26561 000024'04 104 105 103 156 145 26562 000347'01 260 17 0 00 000000* call ccon ; Turn on Control-C interrupt 26563 000350'01 254 00 0 00 000512' jrst waitcc ; Go to the wait Control-C handler 26564 000351'01 260 17 0 00 000000* call cyon ; Fielding ^Y inquires 26565 000352'01 334 00 0 00 000000 %ermsg (,) 26566 000353'01 254 00 0 00 000357' 26567 000354'01 265 01 0 00 000344* 26568 000355'01 000000000000# 26569 000356'01 254 00 0 00 000357' 26570 000034'04 103 157 165 154 144 26571 000357'01 201 01 0 00 000522' movei t1, waitmo ; Address to go to on time out 26572 000360'01 337 02 0 00 000000* skipg t2, pars6 ; Use /timeout, if specified 26573 000361'01 200 02 0 00 000000* move t2, delay ; Otherwise use default k20net - Kermit-20 Network Support MACRO %53B(1254)-4 19:42 30-Mar-24 Page 10-1 K20NET MAC 13-Dec-23 21:12 Wait for DECnet connection completion 26574 000362'01 323 02 0 00 000364' ifg. t2 ; Have any reasonable delay? 26575 000363'01 260 17 0 00 000000* call timeon ; Yes, set connection expiration time 26576 000364'01 endif. ; Otherwise, we are truly patient... 26577 26578 000364'01 do. ; Enter loop context 26579 000364'01 104 00 0 00 000306 WAIT% ; Wait forever and ever (and ever) 26580 000365' $waitj==:. ; Location of JSYS as reported 26581 000365'01 336 00 0 00 000000* skipn cyseen ; Should only happen for ^Y 26582 000366'01 254 00 0 00 000503' jrst waitun ; But didn't! Unknown!! 26583 000367'01 260 17 0 00 000407' call waitpr ; Print something nice 26584 000370'01 254 00 0 00 000373' ifskp. ; Link is still healthy 26585 000371'01 402 00 0 00 000365* setzm cyseen ; Stomp ^Y seen 26586 000372'01 254 00 0 00 000402' else. ; Otherwise, we are ill 26587 000373'01 415 16 0 00 000400' block. ; Will need a frame 26588 000374'01 261 17 0 00 000016 26589 000375'01 265 16 0 00 005344' saveac ; Save temporaries 26590 000376'01 260 17 0 00 000441' call shutdn ; Turn off the interrupts 26591 000377'01 263 17 0 00 000000 endbk. ; Exit block, restoring temporaries 26592 000400'01 260 17 0 00 000544' call decerr ; Complain and close 26593 000401'01 254 00 0 00 003047' callret clsnet ; Toss JFN and return 26594 000402'01 endif. 26595 000402'01 603 03 0 00 400000 txne t3, mo%con ; Connected?? Must have missed the interrupt 26596 000403'01 254 00 0 00 000405' exit. ; Break out and return success 26597 000404'01 254 00 0 00 000364' loop. ; And go catatonic again 26598 000405'01 enddo. ; End loop lexical context 26599 26600 000405'01 waitdn: remark ; Forced here by connection interrupt 26601 000405'01 260 17 0 00 000441' call shutdn ; Get rid of all our interrupts 26602 000406'01 254 00 0 00 000327* retskp ; Return success 26603 k20net - Kermit-20 Network Support MACRO %53B(1254)-4 19:42 30-Mar-24 Page 11 K20NET MAC 13-Dec-23 21:12 Print Connection Information 26604 subttl Print Connection Information 26605 26606 ; Returns +1 if connection went bad, t2 having the DECnet abort code 26607 ; +2 if the connection is still good and we continue to wait 26608 26609 000407'01 200 01 0 00 000330* waitpr: move t1,netjfn ; Load the JFN 26610 000410'01 201 02 0 00 000025 movx t2,.morls ; Function to read link status 26611 000411'01 104 00 0 00 000077 MTOPR% ; Do the status read 26612 000412'01 320 12 0 00 000042* erjmpr r ; Handle error, getting it in t1 26613 000413'01 603 03 0 00 400000 txne t3, mo%con ; Connected?? 26614 000414'01 254 00 0 00 000406* retskp ; Must have missed the interrupt 26615 000415'01 603 03 0 00 010000 txne t3, mo%abt ; Link aborted?? 26616 000416'01 263 17 0 00 000000 ret ; Fail and return blat 26617 000417'01 603 03 0 00 004000 txne t3, mo%syn ; A normal close? 26618 000420'01 263 17 0 00 000000 ret ; Already? That's pecular... 26619 000421'01 607 03 0 00 100000 ifxn. t3, mo%wfc ; Still healthy and waiting? 26620 000422'01 254 00 0 00 000427' 26621 txmsg <% Waiting for connection 26622 000423'01 200 01 0 00 000000# > 26623 000424'01 104 00 0 00 000076 26624 000425'01 320 12 0 00 000426' 26625 000003'03 000000000000# 26626 000044'04 045 040 127 141 151 26627 26628 000426'01 254 00 0 00 000414* retskp 26629 000427'01 endif. 26630 000427'01 607 03 0 00 040000 ifxn. t3, mo%wcc ; Just about done, actually? 26631 000430'01 254 00 0 00 000435' 26632 txmsg <% Waiting for connection confirmation 26633 000431'01 200 01 0 00 000000# > 26634 000432'01 104 00 0 00 000076 26635 000433'01 320 12 0 00 000434' 26636 000004'03 000000000000# 26637 000052'04 045 040 127 141 151 26638 26639 000434'01 254 00 0 00 000426* retskp 26640 000435'01 endif. 26641 26642 txmsg <% Unknown status 26643 000435'01 200 01 0 00 000000# > 26644 000436'01 104 00 0 00 000076 26645 000437'01 320 12 0 00 000440' 26646 000005'03 000000000000# 26647 000062'04 045 040 125 156 153 26648 26649 000440'01 254 00 0 00 000434* retskp ; Still OK to wait 26650 k20net - Kermit-20 Network Support MACRO %53B(1254)-4 19:42 30-Mar-24 Page 12 K20NET MAC 13-Dec-23 21:12 Connection interrupt time out and shutdown 26651 subttl Connection interrupt time out and shutdown 26652 26653 000441'01 201 01 0 00 400000 shutdn: movx t1, .fhslf ; This process 26654 000442'01 104 00 0 00 000130 DIR% ; Shut off the entire interrupt system 26655 000443'01 320 12 0 00 000445' %jserr (,) 26656 000444'01 254 00 0 00 000450' 26657 000445'01 265 01 0 00 000354* 26658 000446'01 000000000000# 26659 000447'01 254 00 0 00 000450' 26660 000066'04 111 156 164 145 162 26661 000450'01 260 17 0 00 000000* call ccoff2 ; Force off Control-C handler 26662 000451'01 260 17 0 00 000000* call timdel ; Delete the timer 26663 000452'01 260 17 0 00 000000* call cyoff ; Release ^Y 26664 dmove t1, [ .fhslf ; This process 26665 000453'01 120 01 0 00 005356' dnchb ] ; DECnet connection channel 26666 000454'01 104 00 0 00 000133 DIC% ; Shut the channel off 26667 000455'01 320 12 0 00 000457' %jserr (,) ; Carry on 26668 000456'01 254 00 0 00 000462' 26669 000457'01 265 01 0 00 000445* 26670 000460'01 000000000000# 26671 000461'01 254 00 0 00 000462' 26672 000075'04 104 105 103 156 145 26673 000462'01 200 01 0 00 000407* move t1, netjfn ; Load the network JFN 26674 dmove t2, [ .moacn ; Code to enable interrupts 26675 000463'01 120 02 0 00 005360' dndfld ] ; Take the interrupt off this channel 26676 000464'01 104 00 0 00 000077 MTOPR% ; Enable the interrupt 26677 000465'01 320 12 0 00 000467' %jserr (,) ; Carry on 26678 000466'01 254 00 0 00 000472' 26679 000467'01 265 01 0 00 000457* 26680 000470'01 000000000000# 26681 000471'01 254 00 0 00 000472' 26682 000105'04 104 105 103 156 145 26683 000472'01 104 00 0 00 000141 CIS% ; Clear out any other interrupt crud 26684 000473'01 201 01 0 00 400000 movx t1, .fhslf ; This process 26685 000474'01 104 00 0 00 000126 EIR% ; Turn the interrupt back on 26686 000475'01 320 12 0 00 000477' %jserr (,) ; Uh oh... 26687 000476'01 254 00 0 00 000502' 26688 000477'01 265 01 0 00 000467* 26689 000500'01 000000000000# 26690 000501'01 254 00 0 00 000502' 26691 000116'04 111 156 164 145 162 26692 000502'01 263 17 0 00 000000 ret 26693 26694 000503'01 waitun: remark ; Here if we don't know why we broke out 26695 000503'01 260 17 0 00 000441' call shutdn ; Get rid of all our interrupts 26696 emsg ; Inform 26698 000505'01 104 00 0 00 000313 26699 000006'03 000000000000# 26700 000125'04 125 156 153 156 157 26701 26702 000506'01 505 02 0 00 000007 hrli t2, .DCX7 ; Code is unspecified error 26703 000507'01 200 03 0 00 000000# sxtext (t3,) 26704 000007'03 000000000000# 26705 000133'04 125 156 153 156 157 k20net - Kermit-20 Network Support MACRO %53B(1254)-4 19:42 30-Mar-24 Page 12-1 K20NET MAC 13-Dec-23 21:12 Connection interrupt time out and shutdown 26706 000510'01 201 04 0 00 000020 movei t4,^d16 ; Length of reject message 26707 000511'01 254 00 0 00 000530' jrst waitm1 ; Join common code 26708 26709 000512'01 waitcc: remark ; ^C event 26710 000512'01 260 17 0 00 000441' call shutdn ; Get rid of all our interrupts 26711 txmsg <% aborting connection attempt 26712 000513'01 200 01 0 00 000000# > ; Inform 26713 000514'01 104 00 0 00 000076 26714 000515'01 320 12 0 00 000516' 26715 000010'03 000000000000# 26716 000137'04 045 040 141 142 157 26717 26718 000516'01 505 02 0 00 000011 hrli t2, .DCX9 ; Code is forced explicit disconnect 26719 000517'01 200 03 0 00 000000# sxtext (t3,) 26720 000011'03 000000000000# 26721 000146'04 101 142 141 156 144 26722 000520'01 201 04 0 00 000017 movei t4,^d15 ; Length of reject message 26723 000521'01 254 00 0 00 000530' jrst waitm1 ; Join common code 26724 26725 000522'01 waitmo: remark ; Time-out event 26726 000522'01 260 17 0 00 000441' call shutdn ; Get rid of all our interrupts 26727 emsg ; Whine 26729 000524'01 104 00 0 00 000313 26730 000012'03 000000000000# 26731 000152'04 122 145 155 157 164 26732 26733 000525'01 505 02 0 00 000046 hrli t2, .DCX38 ; Code is no response 26734 000526'01 200 03 0 00 000000# sxtext (t3,) 26735 000013'03 000000000000# 26736 000160'04 101 164 164 145 155 26737 000527'01 201 04 0 00 000020 movei t4,^d16 ; Length of reject message 26738 26739 000530'01 200 01 0 00 000462* waitm1: move t1,netjfn ; Load DCN: JFN 26740 000531'01 541 02 0 00 000040 hrri t2, .moclz ; Function to close 26741 000532'01 104 00 0 00 000077 MTOPR% ; Notify NSP that we are giving up 26742 000533'01 320 12 0 00 000544' erjmpr decerr ; We can't say "No"? 26743 000534'01 254 00 0 00 003130' callret clscom ; Toss whatever is left 26744 26745 ;[218] End rewrite for connection interrupts 26746 k20net - Kermit-20 Network Support MACRO %53B(1254)-4 19:42 30-Mar-24 Page 13 K20NET MAC 13-Dec-23 21:12 Asynchronous DECnet connection event 26747 subttl Asynchronous DECnet connection event 26748 26749 ;[218] Begin code insertion 26750 26751 ; Purpose is to break us out of any jsys we might be in (probably the 26752 ; WAIT%) and redirect the path of execution to the successful return. 26753 26754 000535'01 dntrap: entry dntrap ; chntab is in k20sub 26755 000535'01 261 17 0 00 000001 push p, t1 ; Save an accumulator 26756 000536'01 201 01 0 00 000405' movei t1, waitdn ; Load the connection success address 26757 000537'01 500 01 0 00 000000* hll t1, pc3 ; Load interrupted PC's flags 26758 000540'01 661 01 0 00 010000 txo t1, pc%usr ; Force user mode to break out of any JSYS 26759 000541'01 202 01 0 00 000537* movem t1, pc3 ; Restore as if we came from there 26760 000542'01 262 17 0 00 000001 pop p, t1 ; Restore the accumulator 26761 000543'01 104 00 0 00 000136 DEBRK% ; Done with interrupt 26762 26763 ;[218] End code insertion 26764 k20net - Kermit-20 Network Support MACRO %53B(1254)-4 19:42 30-Mar-24 Page 14 K20NET MAC 13-Dec-23 21:12 Handle a DECnet connection error of some type 26765 subttl Handle a DECnet connection error of some type 26766 26767 ; Takes two kinds of errors and honks accordingly 26768 ; 26769 ; Note assumption: if t1 still has netjfn in it, then it couldn't 26770 ; possibly have gotten stomped with an erjmpr 26771 ; 26772 ; Call: 26773 ; 26774 ; t1/ JFN or error code 26775 ; 26776 ; Return: 26777 ; 26778 ; +1, always, having typed some kind of blat 26779 26780 000544'01 decerr: entry decerr ; Also hit by other modules 26781 000544'01 550 02 0 00 000001 hrrz t2,t1 ; Save a possible error 26782 000545'01 200 01 0 00 000000# emsg ;[187] 26783 000546'01 104 00 0 00 000313 26784 000014'03 000000000000# 26785 000164'04 103 157 156 156 145 26786 000547'01 316 02 0 00 000530* camn t2,netjfn ; JSYS error? 26787 000550'01 254 00 0 00 000562' ifskp. ; Yes, that's easy enough to complain about 26788 000551'01 201 01 0 00 000101 movei t1,.priou ; Continue on primary output 26789 000552'01 505 02 0 00 400000 hrli t2,.fhslf ; Wants this for explicit error 26790 000553'01 400 03 0 00 000000 setz t3, ; Don't limit length of text 26791 000554'01 104 00 0 00 000011 ERSTR% ; Type the JSYS failure reason text 26792 000555'01 320 12 0 00 000557' erjmpr .+2 ; Ignore strange error 26793 000556'01 320 12 0 00 000557' erjmpr .+1 ; Ignore stranger error 26794 000557'01 561 01 0 00 000000* hrroi t1, crlf ; Tie off the line 26795 000560'01 104 00 0 00 000076 PSOUT% 26796 000561'01 263 17 0 00 000000 ret ; And return 26797 000562'01 endif. ; End JSYS error handling 26798 26799 000562'01 400 01 0 00 000000 setz t1, ; Let's assume we never found anything 26800 000563'01 621 03 0 00 777777 tlz t3,-1 ; Scrub to just the bare error 26801 000564'01 201 04 0 00 000000# movei t4,nsptab ; Load address of error table 26802 000565'01 505 04 0 00 777744 hrli t4,-nspcnt ; Load negative number of items in table 26803 26804 000566'01 do. ; Enter loop context 26805 000566'01 554 02 0 04 000000 hlrz t2,(t4) ; Load Disconnect Code Table 26806 000567'01 312 02 0 00 000003 came t2,t3 ; Did we find the code? 26807 000570'01 254 00 0 00 000574' ifskp. ; Yes, set up the pointer 26808 000571'01 550 01 0 04 000000 hrrz t1, (t4) ; Pick up in-section case 26809 000572'01 661 01 0 00 610001 txo t1, .px7 ; Turn into a OWGP to ASCII text in ETEXT 26810 000573'01 254 00 0 00 000575' exit. ; Break out of the loop 26811 000574'01 endif. 26812 000574'01 253 04 0 00 000566' aobjn t4,top. ; Nope, try the next error code 26813 000575'01 enddo. ; End loop context 26814 26815 000575'01 326 01 0 00 000577' ife. t1 ; Did we find anything? 26816 000576'01 200 01 0 00 000000# sxtext (t1,) 26817 000015'03 000000000000# 26818 000171'04 125 156 153 156 157 26819 000577'01 endif. ; Other, can provide extra information k20net - Kermit-20 Network Support MACRO %53B(1254)-4 19:42 30-Mar-24 Page 14-1 K20NET MAC 13-Dec-23 21:12 Handle a DECnet connection error of some type 26820 000577'01 104 00 0 00 000313 ESOUT% ; Give us the bad news 26821 000600'01 561 01 0 00 000557* hrroi t1, crlf ; Tie off the line and return 26822 000601'01 104 00 0 00 000076 PSOUT% 26823 000602'01 254 00 0 00 003121' callret clsnrt ; Close the NRT object (or what's left) 26824 k20net - Kermit-20 Network Support MACRO %53B(1254)-4 19:42 30-Mar-24 Page 15 K20NET MAC 13-Dec-23 21:12 DECnet Disconnect Code Table (from MONSYM) 26825 subttl DECnet Disconnect Code Table (from MONSYM) 26826 26827 .endps code ; Pointers to extended text don't go in code 26828 26829 ; Note that the codes are stipulated by the NSP specification and 26830 ; may have meanings that are not directly implied by the comments 26831 26832 define nsperr(e,t,%et) < 26833 xwd e,%et ;;DECnet error code and in-section address 26834 chgsec(const,etext) ;;Text goes in extended section 26835 %et: asciz\'t\ ;;Drop text into extended section 26836 retsec ;;Gets back into const .psect 26837 cleans(<%et>) ;;Don't clutter listings with generated symbol 26838 >;;nsperr 26839 26840 .psect const ; Pointer table to extended text goes in const .psect 26841 26842 000016'03 000000 000000# nsptab: nsperr(.DCX0,) 26843 000201'04 122 145 152 145 143 26844 000017'03 000001 000000# nsperr(.DCX1,) 26845 000210'04 122 145 163 157 165 26846 000020'03 000002 000000# nsperr(.DCX2,) 26847 000216'04 104 145 163 164 151 26848 000021'03 000003 000000# nsperr(.DCX3,) 26849 000225'04 122 145 155 157 164 26850 000022'03 000004 000000# nsperr(.DCX4,) 26851 000233'04 104 145 163 164 151 26852 000023'03 000005 000000# nsperr(.DCX5,) 26853 000242'04 111 156 166 141 154 26854 000024'03 000006 000000# nsperr(.DCX6,) 26855 000250'04 117 142 152 145 143 26856 000025'03 000007 000000# nsperr(.DCX7,) 26857 000253'04 125 156 163 160 145 26858 000026'03 000010 000000# nsperr(.DCX8,) 26859 000257'04 101 142 157 162 164 26860 000027'03 000011 000000# nsperr(.DCX9,) 26861 000263'04 101 142 157 162 164 26862 000030'03 000012 000000# nsperr(.DCX10,) 26863 000267'04 111 156 166 141 154 26864 000031'03 000013 000000# nsperr(.DCX11,) 26865 000273'04 114 157 143 141 154 26866 000032'03 000025 000000# nsperr(.DCX21,) 26867 000277'04 103 157 156 156 145 26868 000033'03 000026 000000# nsperr(.DCX22,) 26869 000311'04 103 157 156 156 145 26870 000034'03 000027 000000# nsperr(.DCX23,) 26871 000323'04 103 157 156 156 145 26872 000035'03 000030 000000# nsperr(.DCX24,) 26873 000340'04 106 154 157 167 040 26874 000036'03 000040 000000# nsperr(.DCX32,) 26875 000345'04 124 157 157 040 155 26876 000037'03 000041 000000# nsperr(.DCX33,) 26877 000353'04 124 157 157 040 155 26878 000040'03 000042 000000# nsperr(.DCX34,) 26879 000364'04 101 143 143 145 163 k20net - Kermit-20 Network Support MACRO %53B(1254)-4 19:42 30-Mar-24 Page 15-1 K20NET MAC 13-Dec-23 21:12 DECnet Disconnect Code Table (from MONSYM) 26880 000041'03 000043 000000# nsperr(.DCX35,) 26881 000371'04 114 157 147 151 143 26882 000042'03 000044 000000# nsperr(.DCX36,) 26883 000400'04 111 156 166 141 154 26884 000043'03 000045 000000# nsperr(.DCX37,) 26885 000404'04 123 145 147 155 145 26886 000044'03 000046 000000# nsperr(.DCX38,) 26887 000411'04 116 157 040 162 145 26888 000045'03 000047 000000# nsperr(.DCX39,) 26889 000421'04 116 157 144 145 040 26890 000046'03 000050 000000# nsperr(.DCX40,) 26891 000425'04 114 151 156 153 040 26892 000047'03 000051 000000# nsperr(.DCX41,) 26893 000433'04 104 145 163 164 151 26894 000050'03 000052 000000# nsperr(.DCX42,) 26895 000442'04 103 157 156 146 151 26896 000051'03 000053 000000# nsperr(.DCX43,) 26897 000452'04 111 155 141 147 145 26898 000000000000# nspcnt==.-nsptab ; Number of items in table 26899 cleans() ; No need for symbol in listings, Etc. 26900 .psect code ; Back in code 26901 k20net - Kermit-20 Network Support MACRO %53B(1254)-4 19:42 30-Mar-24 Page 16 K20NET MAC 13-Dec-23 21:12 Canonicalize remote node name 26902 subttl Canonicalize remote node name 26903 26904 ; Rewrite the node name in case it was aliased. At least get it into 26905 ; UPPER case, which is what everybody wants. Also keeps gross CaMel 26906 ; case input from offending the sensitive 26907 26908 000603'01 337 02 0 00 000547* fixnam: skipg t2, netjfn ; Load JFN 26909 000604'01 263 17 0 00 000000 ret ; Unless there isn't one 26910 26911 000605'01 336 00 0 00 000000# ifmn. ndvfxp ; Have .ndvfx? 26912 000606'01 254 00 0 00 000611' 26913 000607'01 200 03 0 00 000257* move t3, nodnum ; Load previous node number 26914 000610'01 202 03 0 00 000000# movem t3, oldnum ; Store as old number 26915 000611'01 endif. ; Otherwise, will have to compare characters... 26916 26917 000611'01 120 03 0 00 000267* dmove t3, nodnam ; Load connected node name 26918 000612'01 124 03 0 00 000000# dmovem t3, oldnam ; Save (will hold six characters plus .chnul) 26919 000613'01 403 03 0 00 000004 setzb t3, t4 ; Cons up 10 .chnul's 26920 000614'01 124 03 0 00 000611* dmovem t3, nodnam ; Scrub storage enough 26921 26922 000615'01 561 01 0 00 000614* hrroi t1, nodnam ; Rewriting the node nam 26923 dmove t3, [ fld(.jsaof,js%nam) ; Just the file name 26924 000616'01 120 03 0 00 005362' 0 ] ; No strange prefix 26925 000617'01 104 00 0 00 000030 JFNS% ; Rewrite the node name 26926 000620'01 320 12 0 00 000412* erjmpr r ; ?? 26927 26928 000621'01 211 02 0 00 000003 movni t2,^d3 ; Getting before the dash 26929 000622'01 133 02 0 00 000001 adjbp t2,t1 ; back the pointer up 26930 000623'01 136 04 0 00 000002 idpb t4,t2 ; Stomp the dash, tying off the string 26931 000624'01 136 04 0 00 000002 idpb t4,t2 ; Also stomp the "2" and the ... 26932 000625'01 136 04 0 00 000002 idpb t4,t2 ; ... "3" to allow word compares 26933 000626'01 263 17 0 00 000000 ret ; Return everything all pretty 26934 k20net - Kermit-20 Network Support MACRO %53B(1254)-4 19:42 30-Mar-24 Page 17 K20NET MAC 13-Dec-23 21:12 Check if a connecting to a machine that supports Tops-20 NRT 26935 subttl Check if a connecting to a machine that supports Tops-20 NRT 26936 26937 ; Only these support a meta-data free NRT that we can use 26938 26939 ; N.B., These aren't just Tops-10 or Tops-20 machines! Ultrix-32 implements 26940 ; Tops-20 NRT. 26941 26942 000200 cnflen==200 ; Maximum characters allowed 26943 26944 000627'01 265 16 0 00 005364' chktop: saveac ; Fiddling with raw DECnet byte order 26945 000630'01 403 01 0 00 000002 setzb t1,t2 ; Cons up some zeros 26946 000631'01 124 01 0 00 000000# dmovem t1, nrtros ; Initialize unknown OS types 26947 000632'01 124 01 0 00 000000# dmovem t1, nrtflg ; and also NRT and network binary flags 26948 000633'01 402 00 0 00 000000# setzm nrtprt ; and also the NRT protocol 26949 26950 000634'01 337 01 0 00 000603* skipg t1, netjfn ; Load network JFN 26951 000635'01 263 17 0 00 000000 ret ; Unless there isn't one 26952 26953 000636'01 120 02 0 00 005374' dmove t2,[exp .morls,0] ; Read link status 26954 000637'01 104 00 0 00 000077 MTOPR% ; Request from the monitor 26955 000640'01 320 12 0 00 000544' erjmpr decerr ; Handle error 26956 26957 000641'01 607 03 0 00 020000 ifxn. t3,mo%eom ; Has an entire message? 26958 000642'01 254 00 0 00 000653' 26959 000643'01 400 02 0 00 000000 setz 2, ; Assume it's a lie 26960 000644'01 104 00 0 00 000102 SIBE% ; See what the deal is 26961 000645'01 334 00 0 00 000000 skipa ; Have some goodies to read, actually 26962 000646'01 254 00 0 00 000653' anskp. ; Or doesn't 26963 000647'01 303 02 0 00 000200 caile t2,cnflen ; Exceeds buffer length? 26964 000650'01 254 00 0 00 000653' anskp. ; clip it down 26965 000651'01 210 03 0 00 000002 movn t3,t2 ; Load exact length to read 26966 000652'01 254 00 0 00 000654' else. ; Otherwise use default length 26967 000653'01 211 03 0 00 000200 movni t3,cnflen ; Default maximum characters allowed 26968 000654'01 endif. 26969 26970 000654'01 200 02 0 00 005376' move t2,[point ^d8,cnfmsg] ;Note 8 bit pointer to config message 26971 000655'01 104 00 0 00 000531 SINR% ; Read Configuration message 26972 000656'01 320 12 0 00 000544' erjmpr decerr ; Gronked?? 26973 26974 remark ; Begin configuration message parsing 26975 000657'01 135 01 0 00 005377' ldb t1,[point ^D8,cnfmsg,7] 26976 000660'01 306 01 0 00 000001 cain t1,^d1 ; Is this a configuration message, actually? 26977 000661'01 254 00 0 00 000675' ifskp. ; No, so let's type it 26978 000662'01 200 01 0 00 000000# emsg 26979 000663'01 104 00 0 00 000313 26980 000052'03 000000000000# 26981 000460'04 077 040 111 154 154 26982 000664'01 201 01 0 00 000101 movei t1,.priou ; Output to primary 26983 000665'01 200 02 0 00 005400' move t2,[point ^d8,cnfmsg] ; Pointer to data from remote host 26984 000666'01 201 04 0 03 000200 movei t4,cnflen(t3) ; Get count received-1 26985 000667'01 210 03 0 00 000004 movn t3,t4 ; Now have output count 26986 000670'01 104 00 0 00 000053 SOUT% ; Type data on users terminal 26987 000671'01 320 12 0 00 000672' erjmpr .+1 ; Too bad for user, but ignore it 26988 000672'01 561 01 0 00 000600* hrroi t1, crlf ; Tie off 26989 000673'01 104 00 0 00 000076 PSOUT% ; the line k20net - Kermit-20 Network Support MACRO %53B(1254)-4 19:42 30-Mar-24 Page 17-1 K20NET MAC 13-Dec-23 21:12 Check if a connecting to a machine that supports Tops-20 NRT 26990 000674'01 254 00 0 00 003121' callret clsnrt ; Close the connection 26991 000675'01 endif. ; End case connection message 26992 repeat 0,< ;;We don't look at the next two 26993 ldb t3,[point ^d8,cnfmsg,15] ; DEC ECO 26994 ldb t3,[point ^d8,cnfmsg,23] ; Customer ECO 26995 > 26996 000675'01 135 03 0 00 005401' ldb t3,[point ^d8,cnfmsg,34] ; Operating System type, high order byte 26997 000676'01 242 03 0 00 000010 lsh t3, ^d8 ; shift over and load the low order byte 26998 000677'01 135 04 0 00 005402' ldb t4,[point ^d8,cnfmsg+1,7] 26999 000700'01 200 05 0 00 000004 move q1, t4 ; Save constructed OS type 27000 27001 000701'01 200 01 0 00 000000# txmsg <[Remote system > ; Begin connection banner 27002 000702'01 104 00 0 00 000076 27003 000703'01 320 12 0 00 000704' 27004 000053'03 000000000000# 27005 000467'04 133 122 145 155 157 27006 000704'01 561 01 0 00 000615* hrroi t1,nodnam ; Remote system 27007 000705'01 104 00 0 00 000076 PSOUT% ; Type it 27008 000706'01 200 01 0 00 000000# txmsg <:: is running > 27009 000707'01 104 00 0 00 000076 27010 000710'01 320 12 0 00 000711' 27011 000054'03 000000000000# 27012 000473'04 072 072 040 151 163 27013 27014 000711'01 415 16 0 00 000723' block. ; Enter block context for easier control flow 27015 000712'01 261 17 0 00 000016 27016 000713'01 305 04 0 00 000000 caige t4, 0 ; Negative OS number?? 27017 000714'01 263 17 0 00 000000 ret ; That will never work 27018 000715'01 303 04 0 00 000022 caile t4, hsttyn ; Out of range? 27019 000716'01 263 17 0 00 000000 ret ; Don't know that, either 27020 000717'01 336 00 0 04 000763' skipn hsttyp(t4) ; But!! Is this entry 'known'? 27021 000720'01 263 17 0 00 000000 ret ; Nope (note table has 'reserved' gaps) 27022 000721'01 254 00 0 00 000440* retskp ; Otherwise, it's fine 27023 000722'01 263 17 0 00 000000 endbk. ; Return out of block context, one way or another 27024 000723'01 254 00 0 00 000730' ifskp. ; Skip means we know the remote OS code 27025 000724'01 200 01 0 04 000763' move t1, hsttyp(t4) ; Load OWGP to OS type string 27026 000725'01 202 01 0 00 000000# movem t1, rosnpt ; Save it for k20dsp 27027 000726'01 104 00 0 00 000076 PSOUT% ; Print it 27028 000727'01 254 00 0 00 000742' else. ; Non-skip means we didn't know it 27029 000730'01 200 01 0 00 000000# sxtext (t1,) ; Give it something to type 27030 000055'03 000000000000# 27031 000476'04 125 156 153 156 157 27032 000731'01 202 01 0 00 000000# movem t1, rosnpt ; if it wants something to type 27033 000732'01 200 01 0 00 000000# txmsg < an unknown operating system type: > ; Begin the blat 27034 000733'01 104 00 0 00 000076 27035 000734'01 320 12 0 00 000735' 27036 000056'03 000000000000# 27037 000500'04 040 141 156 040 165 27038 000735'01 201 01 0 00 000101 movei t1, .priou ; Still going to the terminal 27039 000736'01 200 02 0 00 000004 move t2, t4 ; Load the code we got 27040 000737'01 201 03 0 00 000012 movei t3, ^d10 ; These are in base 10 27041 000740'01 104 00 0 00 000224 NOUT% ; Blat the code 27042 000741'01 320 12 0 00 000742' erjmpr .+1 ; Catch and ignore the error 27043 000742'01 endif. ; End OS tyoe check 27044 txmsg <] k20net - Kermit-20 Network Support MACRO %53B(1254)-4 19:42 30-Mar-24 Page 17-2 K20NET MAC 13-Dec-23 21:12 Check if a connecting to a machine that supports Tops-20 NRT 27045 000742'01 200 01 0 00 000000# > 27046 000743'01 104 00 0 00 000076 27047 000744'01 320 12 0 00 000745' 27048 000057'03 000000000000# 27049 000510'04 135 015 012 000 000 27050 000745'01 135 06 0 00 005403' ldb q2,[point ^d16,cnfmsg+1,23] ; Supported protocol types bit field 27051 000746'01 602 06 0 00 000010 ifxe. q2, TOPNRT ; Anything we understand? 27052 000747'01 254 00 0 00 000756' 27053 000750'01 561 01 0 00 000704* hrroi t1, nodnam ; Begin complaining 27054 000751'01 104 00 0 00 000313 ESOUT% ; about the node 27055 txmsg <:: does not support Tops-10/Tops-20 Network Remote Terminal protocol 27056 000752'01 200 01 0 00 000000# > 27057 000753'01 104 00 0 00 000076 27058 000754'01 320 12 0 00 000755' 27059 000060'03 000000000000# 27060 000511'04 072 072 040 144 157 27061 27062 000755'01 254 00 0 00 003121' callret clsnrt ; Close the connection 27063 000756'01 endif. 27064 27065 000756'01 202 05 0 00 000000# movem q1, nrtros ; If NRT, remote operating system type 27066 000757'01 202 06 0 00 000000# movem q2, nrtprt ; Save NRT protocols offered by remote 27067 27068 000760'01 476 00 0 00 000000# setom nrtflg ; Flag this is a valid NRT 27069 000761'01 476 00 0 00 000000# setom binflg ; Flag we will do binary 27070 000762'01 254 00 0 00 000721* retskp ; Won!! 27071 k20net - Kermit-20 Network Support MACRO %53B(1254)-4 19:42 30-Mar-24 Page 18 K20NET MAC 13-Dec-23 21:12 List of known DECnet host operating system types 27072 subttl List of known DECnet host operating system types 27073 27074 ; The base list comes from the venerable SETHOS (hence the similar 27075 ; variable names), but it has been updated with additional systems 27076 ; from the fine folks on HECnet. 27077 ; 27078 ; Be aware that these is not the same list as the DAP list!! 27079 ; (naturally...) They're not even the same between CTerm and NRT! 27080 27081 000763'01 hsttyp: intern hsttyp ; Used by k20dsp, twoo 27082 000763'01 000000000000# eascii ;^d0 27083 000530'04 122 123 124 123 000 27084 000764'01 000000000000# eascii ;^d1 27085 000531'04 122 124 055 061 061 27086 000765'01 000000000000# eascii ;^d2 27087 000533'04 122 123 124 123 057 27088 000766'01 000000000000# eascii ;^d3 27089 000535'04 122 123 130 055 061 27090 000767'01 000000000000# eascii ;^d4 27091 000537'04 122 123 130 055 061 27092 000770'01 000000000000# eascii ;^d5 27093 000541'04 122 123 130 055 061 27094 000771'01 000000000000# eascii ;^d6 27095 000543'04 111 101 123 000 000 27096 000772'01 000000000000# eascii ;^d7 27097 000544'04 126 115 123 000 000 27098 000773'01 000000000000# eascii ;^d8 (TOPS20) 27099 000545'04 124 117 120 123 055 27100 000774'01 000000000000# eascii ;^d9 (TOPS10) 27101 000547'04 124 117 120 123 055 27102 000775'01 000000000000# eascii ;^d10 27103 000551'04 122 124 123 055 070 27104 000776'01 000000000000# eascii ;^d11 (!!) 27105 000553'04 117 123 055 070 000 27106 000777'01 000000000000# eascii ;^d12 27107 000554'04 122 123 130 055 061 27108 001000'01 000000000000# eascii ;^d13 (the DN20!!) 27109 000556'04 115 103 102 000 000 27110 001001'01 000000000000# 0 ;^d14 Reserved 27111 001002'01 000000 000000 0 ;^d15 Reserved 27112 001003'01 000000 000000 0 ;^d16 Reserved 27113 001004'01 000000 000000 0 ;^d17 Reserved 27114 001005'01 000000000000# eascii ;^d18 27115 000557'04 125 114 124 122 111 27116 000000000000# hsttyn=.-hsttyp-1 ; Number of defined operating system types 27117 k20net - Kermit-20 Network Support MACRO %53B(1254)-4 19:42 30-Mar-24 Page 19 K20NET MAC 13-Dec-23 21:12 DECnet interrupt message processing (unused by Kermit) 27118 subttl DECnet interrupt message processing (unused by Kermit) 27119 27120 ; Gets an prints a DECnet interrupt message (which should never happen) 27121 ; and prints it on the user's terminal. No interrupt is enabled for 27122 ; this and the condition is checked for most irregularly. 27123 27124 001006'01 intmsg: entry intmsg 27125 001006'01 265 16 0 00 005344' saveac ; Be transparent 27126 dmove t2, [ .morim ; Read interrupt message 27127 001007'01 120 02 0 00 005404' point 7,intbuf] ; Use this area 27128 001010'01 104 00 0 00 000077 MTOPR% ; Grab the message 27129 001011'01 320 12 0 00 001013' %jserr (,r) 27130 001012'01 254 00 0 00 001016' 27131 001013'01 265 01 0 00 000477* 27132 001014'01 000000000000# 27133 001015'01 254 00 0 00 000620* 27134 000561'04 125 156 141 142 154 27135 001016'01 200 01 0 00 000000# txmsg <[KERMIT-20: DECnet Interrupt Message: > 27136 001017'01 104 00 0 00 000076 27137 001020'01 320 12 0 00 001021' 27138 000061'03 000000000000# 27139 000570'04 133 113 105 122 115 27140 dmove t1, [ .priou ; Typing on terminal 27141 001021'01 120 01 0 00 005406' point 7,intbuf] ; Point where we read this foolishness 27142 001022'01 210 03 0 00 000004 movn t3,t4 ; Doing a counted print 27143 001023'01 104 00 0 00 000053 SOUT% ; Display what we got 27144 001024'01 320 12 0 00 001026' %jserr (,r) 27145 001025'01 254 00 0 00 001031' 27146 001026'01 265 01 0 00 001013* 27147 001027'01 000000000000# 27148 001030'01 254 00 0 00 001015* 27149 000600'04 125 156 141 142 154 27150 txmsg <] 27151 001031'01 200 01 0 00 000000# > ; Close alert and tie off line 27152 001032'01 104 00 0 00 000076 27153 001033'01 320 12 0 00 001034' 27154 000062'03 000000000000# 27155 000607'04 135 015 012 000 000 27156 001034'01 263 17 0 00 000000 ret ; Return with a clean register file 27157 k20net - Kermit-20 Network Support MACRO %53B(1254)-4 19:42 30-Mar-24 Page 20 K20NET MAC 13-Dec-23 21:12 Initialize PTY parameters (adapted from BATCON) 27158 subttl Initialize PTY parameters (adapted from BATCON) 27159 27160 001035'01 inipty: entry inipty 27161 001035'01 200 01 0 00 005410' movx t1, 'TTYJOB' ; Terminal line to job number and 'hungry' 27162 001036'01 104 00 0 00 000016 SYSGT% ; Get the values 27163 001037'01 320 12 0 00 001041' ifje. r ; Fetch error for debugger 27164 001040'01 254 00 0 00 001043' 27165 001041'01 403 02 0 00 000000# setzb t2, ttygtb ; Set an impossible value 27166 001042'01 254 00 0 00 001044' else. ; Otherwise, JSYS worked 27167 001043'01 202 02 0 00 000000# movem t2, ttygtb ; So store something useful 27168 001044'01 endif. ; End case JSYS error handling 27169 27170 001044'01 200 01 0 00 005411' movx t1, 'PTYPAR' ; pseudo terminal configuration info 27171 001045'01 104 00 0 00 000016 SYSGT% ; Get the values 27172 001046'01 320 12 0 00 001050' ifje. r ; Fetch error for debugger 27173 001047'01 254 00 0 00 001052' 27174 001050'01 200 03 0 00 000001 move t3,t1 ; Save error 27175 001051'01 477 01 0 00 000002 setob t1,t2 ; Load a impossible values 27176 001052'01 endif. ; End case JSYS error handling 27177 27178 001052'01 572 01 0 00 000000# hrrem t1,pty1st ; Save TTY number of first PTY 27179 001053'01 576 01 0 00 000000# hlrem t1,ptycnt ; Save count of pseudo-terminals 27180 001054'01 202 02 0 00 000000# movem t2,ptygtb ; GETAB% index (which we'll never use) 27181 27182 001055'01 263 17 0 00 000000 ret ; Done 27183 k20net - Kermit-20 Network Support MACRO %53B(1254)-4 19:42 30-Mar-24 Page 21 K20NET MAC 13-Dec-23 21:12 PTY acquisition 27184 subttl PTY acquisition 27185 27186 ; Assign a PTY to use. This is necessary because, between the time we 27187 ; find a free PTY and the time we actually OPENF% it, somebody else may 27188 ; have already grabbed it. 27189 ; 27190 ; Another way to 'lock' the PTY for exclusive use is simply to open it. 27191 ; The approach of doing an ASND% is superior to this because the PTY 27192 ; can be opened as convenient and, if closed, can still be reused. 27193 ; Otherwise we'd have to go through this whole rigmarole again. 27194 ; 27195 ; Adapted from BATCON, which does an assign by ASND% as apposed to Phase 27196 ; II NRTSRV which assigns by OPENF%. 27197 ; 27198 ; Returns: 27199 ; 27200 ; t1/ Loopback terminal line 27201 ; t2/ Assigned PTY designator 27202 ; 27203 ; N.B., Always have to start with the first PTY and go through all of 27204 ; them because one of them may have become free. 27205 ; 27206 ; Be aware that, if you have more than one Kermit fork in a job doing 27207 ; pseudo-terminal based transfers, then this code will do the wrong 27208 ; thing because a single PTY is assumed to be used per job. There is 27209 ; no expectation of any problem as pseudo-terminals are only used for 27210 ; debugging, testing and prototyping. 27211 27212 001056'01 asipty: entry asipty ; Called by k20mit, also 27213 001056'01 265 16 0 00 005412' saveac ; Leave the registers alone 27214 27215 001057'01 402 00 0 00 000000# setzm ptyflg ; Not doing pseudo-terminals 27216 001060'01 402 00 0 00 000000# setzm binflg ; Not doing binary 27217 001061'01 336 00 0 00 000262* ifmn. asgflg ; Did we have an assigned device? 27218 001062'01 254 00 0 00 001105' 27219 001063'01 336 01 0 00 000263* skipn t1,asgdev ; That is, if we still know it 27220 001064'01 254 00 0 00 001105' anskp. ; Shouldn't happen, but... 27221 001065'01 104 00 0 00 000117 DVCHR% ; Pull the device characteristics 27222 001066'01 320 12 0 00 001070' ifje. r ; Trap error, record it 27223 001067'01 254 00 0 00 001072' 27224 001070'01 200 04 0 00 000001 move t4,t1 ; Get the error out of the way 27225 001071'01 403 01 0 00 000002 setzb t1,t2 ; Claim impossible values 27226 001072'01 endif. ; End JSYS error trap 27227 001072'01 312 01 0 00 001063* came t1,asgdev ; Double check; it's the same, right? 27228 001073'01 254 00 0 00 001105' anskp. ; Different somehow, so don't try to reuse it 27229 001074'01 135 04 0 00 005426' ldb t4,[pointr t2,dv%typ] ;Load the device type 27230 001075'01 302 04 0 00 000013 caie t4,.dvpty ; Is it a pseudo-terminal? 27231 001076'01 254 00 0 00 001105' anskp. ; No, so it is useless for loop back 27232 001077'01 574 04 0 00 000003 hlre t4,t3 ; Pick up the assigned job 27233 001100'01 312 04 0 00 000000* came t4,myjob ; Is it me? 27234 001101'01 254 00 0 00 001105' anskp. ; No, get our own, then 27235 remark t1,t2 ; Device designator and charteristics words loaded 27236 001102'01 476 00 0 00 000000# setom ptyflg ; Flag we have a pseudo-terminal 27237 001103'01 476 00 0 00 000000# setom binflg ; And that it will do binary 27238 001104'01 254 00 0 00 000762* retskp ; Return success, device string already built k20net - Kermit-20 Network Support MACRO %53B(1254)-4 19:42 30-Mar-24 Page 21-1 K20NET MAC 13-Dec-23 21:12 PTY acquisition 27239 001105'01 endif. ; End case attempting device reu-se 27240 27241 001105'01 402 00 0 00 001061* setzm asgflg ; Nothing assigned 27242 001106'01 402 00 0 00 001072* setzm asgdev ; So no assigned device 27243 001107'01 337 05 0 00 000000# skipg q1,ptycnt ; Load and check count of ptys 27244 001110'01 263 17 0 00 000000 ret ; Give up right now 27245 001111'01 335 06 0 00 000000# skipge q2,pty1st ; Load line number associated with 1st PTY 27246 001112'01 263 17 0 00 000000 ret ; Don't work with junk from SYSGT% 27247 001113'01 400 07 0 00 000000 setz q3, ; Initial pseudo-terminal is PTY0: 27248 27249 001114'01 do. ; Enter loop context 27250 001114'01 205 01 0 00 600013 movsi t1,.dvdes+.dvpty ;Load pseudo-terminal device designator 27251 001115'01 540 01 0 00 000007 hrr t1,q3 ; Load the current PTY number 27252 001116'01 104 00 0 00 000117 DVCHR% ; Get device characteristics for this PTY 27253 001117'01 320 12 0 00 001121' ifje. r ; Pick up error for debugger 27254 001120'01 254 00 0 00 001122' 27255 001121'01 400 02 0 00 000000 setz t2, ; Default to not available 27256 001122'01 endif. ; End case device 27257 001122'01 607 02 0 00 010000 ifxn. t2,dv%av ; Free? (available) 27258 001123'01 254 00 0 00 001133' 27259 001124'01 120 03 0 00 000001 dmove t3,t1 ; Save designator words 27260 001125'01 104 00 0 00 000070 ASND% ; Quick! Assign it!! 27261 001126'01 320 16 0 00 001133' annje. ; Failed, do next PTY 27262 001127'01 124 03 0 00 000000# dmovem t3, ndvchr ; Save network device characteristics 27263 001130'01 476 00 0 00 001105* setom asgflg ; Assigned it. Set this flag to remember. 27264 001131'01 202 03 0 00 001106* movem t3, asgdev ; save assigned device 27265 001132'01 254 00 0 00 001136' exit. ; Got it! We're done 27266 001133'01 endif. ; End availibility/assignment attempt 27267 001133'01 114 06 0 00 005427' dadd q2,[exp 1,1] ; Bump both PTY and TTY numbers (clever) 27268 001134'01 367 05 0 00 001114' sojg q1,top. ; Try next pty 27269 001135'01 263 17 0 00 000000 ret ; Otherwise, couldn't get anything, fail 27270 001136'01 enddo. ; Exit loop context 27271 27272 001136'01 200 07 0 00 000001 move q3,t1 ; Save assigned PTY device 27273 001137'01 200 02 0 00 000001 move t2,t1 ; Use it here, too 27274 001140'01 561 01 0 00 000000# hrroi t1,ptynam ; Point to area to write PTY specification 27275 001141'01 104 00 0 00 000121 DEVST% ; Turn device into string 27276 001142'01 320 12 0 00 001030* erjmpr r ; Fail, we just assigned the device! 27277 27278 001143'01 201 02 0 00 000072 movei t2,":" ; Load terminating device punctuation 27279 001144'01 136 02 0 00 000001 idpb t2,t1 ; Complete device syntax 27280 001145'01 400 02 0 00 000000 setz t2, ; Load .chnul 27281 001146'01 136 02 0 00 000001 idpb t2,t1 ; Tie off the string 27282 27283 001147'01 205 02 0 00 600012 movsi t2,.dvdes+.dvtty ; Load terminal device designator 27284 001150'01 540 02 0 00 000006 hrr t2,q2 ; Build complete terminal designator 27285 001151'01 202 02 0 00 000000# movem t2,ptytty ; Store in case we need to manipulate it 27286 27287 001152'01 561 01 0 00 000000# hrroi t1,ttynam ; Point to area to write TTY specification 27288 001153'01 104 00 0 00 000121 DEVST% ; Turn device into string 27289 001154'01 320 12 0 00 001142* erjmpr r ; Fail, we just assigned the device! 27290 27291 001155'01 201 02 0 00 000072 movei t2,":" ; Load terminating device punctuation 27292 001156'01 136 02 0 00 000001 idpb t2,t1 ; Complete device syntax 27293 001157'01 400 02 0 00 000000 setz t2, ; Load .chnul k20net - Kermit-20 Network Support MACRO %53B(1254)-4 19:42 30-Mar-24 Page 21-2 K20NET MAC 13-Dec-23 21:12 PTY acquisition 27294 001160'01 136 02 0 00 000001 idpb t2,t1 ; Tie off the string 27295 27296 001161'01 476 00 0 00 000000# setom ptyflg ; Flag we have a pseudo-terminal 27297 001162'01 476 00 0 00 000000# setom binflg ; And that it will do binary 27298 001163'01 120 01 0 00 000006 dmove t1,q2 ; Load terminal number and PTY designator 27299 001164'01 254 00 0 00 001104* retskp ; Done 27300 27301 k20net - Kermit-20 Network Support MACRO %53B(1254)-4 19:42 30-Mar-24 Page 22 K20NET MAC 13-Dec-23 21:12 Externals for Alternate Network Code 27302 subttl Externals for Alternate Network Code 27303 27304 extern doesc ; Label of main loop for escape character handling 27305 extern duplex ; Whether we're echoing or not 27306 extern echo ; Routine for local echoing 27307 extern escape ; Escape character for connecting (default ^\) 27308 extern vtermf ; Not running on real copper 27309 extern netlgx ; Label to continue error log handling 27310 extern ttfork ; Fork number of the connect receive fork. 27311 extern ttinch ; Label of main keyboard input loop 27312 extern tter1 ; Label for terminal error handling 27313 extern carier ; Carrier flag (also means connected) 27314 extern $connx ; Close connection for a physical line 27315 extern frkchn ; Fork channel interrupt number 27316 extern mdmlin ; -1 = modem-controlled line, 0 = not. 27317 extern sesjfn ; Session log file JFN. 27318 extern sesflg ; Whether the session log is active 27319 k20net - Kermit-20 Network Support MACRO %53B(1254)-4 19:42 30-Mar-24 Page 23 K20NET MAC 13-Dec-23 21:12 Execute the SET LINE command 27320 subttl Execute the SET LINE command 27321 27322 ; SET LINE is almost exactly like CONNECT, except that confirming a 27323 ; CONNECT with no arguments reconnects to an existing connection 27324 ; whereas confirming a SET LINE with no arguments CLOSES the 27325 ; connection. A subtle difference... 27326 ; 27327 ; $CONNE now has all the hairy connection logic, no matter the 27328 ; connection type, PTY, line, NRT, Etc. This routine is simply taking 27329 ; care of a historical special case. 27330 ; 27331 ;Call: 27332 ; 27333 ;pars3/ Parse type: .cmkey, .cmnod, .cmnum, Etc. 27334 ;pars4/ Device information: type, unit, line number, Etc. 27335 27336 001165'01 $setln: entry $setln 27337 001165'01 265 16 0 00 005273' saveac ;[218] Parse item 27338 001166'01 120 05 0 00 000000* dmove q1, pars3 ;[218] Load parse type and unit 27339 001167'01 302 05 0 00 000010 caie q1, .cmcfm ;[218] Wanted to close? 27340 001170'01 254 00 0 00 001203' ifskp. ;[218] We did, so let's do that 27341 001171'01 333 07 0 00 000634* skiple q3, netjfn ;[218] Umm, do we have a connection? 27342 001172'01 254 00 0 00 001176' ifskp. ;[218] We do not, so nothing to do 27343 001173'01 200 01 0 00 000000# emsg ;[218] 27344 001174'01 104 00 0 00 000313 27345 000063'03 000000000000# 27346 000610'04 116 157 040 157 160 27347 001175'01 263 17 0 00 000000 ret ;[218] Nothing further to do 27348 001176'01 endif. ;[218] Otherwise, something is up 27349 001176'01 260 17 0 00 003044' call clsjfn ;[218] Stomp the network connection 27350 txmsg <[Connection closed] 27351 001177'01 200 01 0 00 000000# > ;[218] Say it's all over 27352 001200'01 104 00 0 00 000076 27353 001201'01 320 12 0 00 001202' 27354 000064'03 000000000000# 27355 000616'04 133 103 157 156 156 27356 27357 001202'01 263 17 0 00 000000 ret ;[218] End we're done 27358 001203'01 endif. ;[218] End case confirming to close 27359 27360 001203'01 254 00 0 00 001204' callret $conne ;[218] The rest is just like CONNECT 27361 k20net - Kermit-20 Network Support MACRO %53B(1254)-4 19:42 30-Mar-24 Page 24 K20NET MAC 13-Dec-23 21:12 CONNECT command 27362 subttl CONNECT command 27363 27364 ;[151] CONNECT code totally rewritten as Edit 151. Formerly, CONNECT was 27365 ; accomplished by running a program TTLINK in a lower fork. Now, the 27366 ; code is integrated into this program. This was done for two reasons: 27367 ; 27368 ; 1. V6 of TOPS-20 doesn't allow multiple JFNs on the same TTY device. 27369 ; [V7 has yet to be vetted] 27370 ; 2. TTLINK was interrupt-driven and therefore did not work under batch. 27371 ; 27372 ; This method, similar to that used in Mark Crispin's TELNET program, uses 27373 ; separate input and output forks. It works under batch because the "pty" 27374 ; is always "hungry". 27375 ; 27376 ;[187] This isn't quite true. TELNET can't run well under Batch precisely 27377 ; BECAUSE of the asynchronous forks. Actually, it really doesn't work 27378 ; at all. 27379 ; 27380 ; The Batch paradigm is fundamentally line half-duplex. This means 27381 ; that a line of input is pushed into a PTY and a response is checked 27382 ; for. The PTY may, in fact, NOT be hungry because the program is 27383 ; busy performing the requested command. 27384 ; 27385 ; When running asynchronously, the PTY will ALWAYS look hungry since 27386 ; the fork that is waiting for the input may not even be on the same 27387 ; system. This means that BATCON will continuously stuff input until 27388 ; something goes wrong. If a command fails, then a number of commands 27389 ; will have been typed ahead with unpredictable (or even catastrophic) 27390 ; results. 27391 ; 27392 ; A local modification to BATCON implements a Batch WAIT command, 27393 ; which causes BATCON to ignore PTY hungry for the indicated number of 27394 ; seconds to give whatever is on the other side of the PTY time to 27395 ; type something. It is, at best, a hack. 27396 ; 27397 ; It's best to not use the fork at all and go with a CONNECT/STAY and 27398 ; from there user use the INPUT and OUTPUT commands. 27399 ; 27400 ; Parse results usage: 27401 ; 27402 ; pars3/ COMND% parse type (.cmkey, .cmcfm,.cmnod, Etc.) 27403 ; pars4/ COMND% parsed value (number, node, device or fork handle) 27404 ; pars5/ Whether connecting immediately or staying at local host 27405 ; pars6/ Value of /TIMEOUT parameter, if given 27406 ; pars7/ Whether using MTOPR% .MOSNH or handling communications in user mode 27407 27408 001204'01 $conne: entry $conne ;[186] Invoked from k20mit 27409 extern ttsfrk ;[186] Joins k20mit here 27410 27411 001204'01 335 01 0 00 001166* skipge t1, pars3 ;[186] Load the parse type 27412 001205'01 201 01 0 00 000010 movx t1, .cmcfm ;[186] If junk, use confirm 27413 27414 001206'01 302 01 0 00 000010 caie t1, .cmcfm ;[186] Confirmed (reconnect)? 27415 001207'01 254 00 0 00 001254' ifskp. ;[186] Yes, let's see if that makes sense 27416 001210'01 333 02 0 00 000000# skiple t2, opndev ;[186] Load currently connected device k20net - Kermit-20 Network Support MACRO %53B(1254)-4 19:42 30-Mar-24 Page 24-1 K20NET MAC 13-Dec-23 21:12 CONNECT command 27417 001211'01 254 00 0 00 001215' ifskp. ;[186] Junk?? 27418 emsg ;[186] Shouldn't happen. Ever 27420 001213'01 104 00 0 00 000313 27421 000065'03 000000000000# 27422 000623'04 116 157 164 150 151 27423 27424 001214'01 263 17 0 00 000000 ret ;[186] Do not continue 27425 001215'01 endif. ;[186] End case absurd open device 27426 27427 001215'01 332 00 0 00 000232* ifme. local ;[186] Remote? 27428 001216'01 254 00 0 00 001223' 27429 001217'01 201 01 0 00 000001 movei t1, .cmnum ;[186] Can't connect to ourself 27430 001220'01 200 02 0 00 000000* move t2, mytty ;[186] So pretend we tried 27431 001221'01 124 01 0 00 001204* dmovem t1, pars3 ;[186] Stomp the parse 27432 001222'01 254 00 0 00 001254' jrst $conn1 ;[186] and carry on, eventualy to fail 27433 001223'01 endif. ;[186] End case remote reconnect 27434 27435 001223'01 302 02 0 00 000013 caie t2, .dvpty ;[186] Reconnect a PTY? 27436 001224'01 254 00 0 00 001230' ifskp. ;[186] Yes, fake that out 27437 001225'01 201 01 0 00 000000 movei t1, .cmkey ;[186] Pretend we parsed a keyword 27438 001226'01 124 01 0 00 001221* dmovem t1, pars3 ;[186] Stomp that in 27439 001227'01 254 00 0 00 001254' jrst $conn1 ;[186] Continue (re)connect 27440 001230'01 endif. ;[186] End case PTY reconnection 27441 27442 001230'01 302 02 0 00 000012 caie t2, .dvtty ;[186] Reconnect a physical terminal? 27443 001231'01 254 00 0 00 001236' ifskp. ;[186] Yes, fake that out 27444 001232'01 201 01 0 00 000001 movei t1, .cmnum ;[186] Pretend we parsed a number 27445 001233'01 200 02 0 00 000217* move t2, ttynum ;[186] Which is the currently open terminal 27446 001234'01 124 01 0 00 001226* dmovem t1, pars3 ;[186] Stomp that in and continue 27447 001235'01 254 00 0 00 001254' jrst $conn1 ;[186] Continue (re)connect 27448 001236'01 endif. ;[186] End case terminal reconnection 27449 27450 001236'01 302 02 0 00 000022 caie t2, .dvdcn ;[186] Reconnect an NRT? 27451 001237'01 254 00 0 00 001247' ifskp. ;[186] Yes, fake that out 27452 001240'01 201 01 0 00 000026 movei t1, .cmnod ;[186] Pretend we parsed a node 27453 001241'01 124 01 0 00 001234* dmovem t1, pars3 ;[186] Stomp that in 27454 001242'01 332 00 0 00 000000# skipe forkls ;[236] Wasn't in a forkless connect? 27455 001243'01 476 00 0 00 000000* setom pars7 ;[236] Pretend we parsed the /FORKLESS switch 27456 001244'01 120 03 0 00 000750* dmove t3, nodnam ;[186] Load current node name 27457 001245'01 124 03 0 00 000000* dmovem t3, atmbuf ;[186] Pretend we parsed it 27458 001246'01 254 00 0 00 001254' jrst $conn1 ;[186] Continue (re)connect 27459 001247'01 endif. ;[186] End case NRT reconnection 27460 27461 001247'01 334 01 0 00 000000# ermsg% (, r) 27462 001250'01 254 00 0 00 001254' 27463 001251'01 202 01 0 00 000000* 27464 001252'01 104 00 0 00 000313 27465 001253'01 254 00 0 00 001154* 27466 000066'03 000000000000# 27467 000632'04 113 105 122 115 111 27468 27469 001254'01 endif. ;[186] End case ,cmcfm 27470 27471 001254'01 302 01 0 00 000001 $conn1: caie t1, .cmnum ;[186] Parsed a number? k20net - Kermit-20 Network Support MACRO %53B(1254)-4 19:42 30-Mar-24 Page 24-2 K20NET MAC 13-Dec-23 21:12 CONNECT command 27472 001255'01 254 00 0 00 001273' ifskp. ;[186] Yes, wants a physical line 27473 001256'01 331 02 0 00 000000* skipl t2, pars4 ;[186] Sanity check the number 27474 001257'01 254 00 0 00 001263' ifskp. ;[186] Don't let's be silly... 27475 emsg ;[186] An appropriate Vulcan response 27477 001261'01 104 00 0 00 000313 27478 000067'03 000000000000# 27479 000642'04 116 145 147 141 164 27480 27481 001262'01 263 17 0 00 000000 ret ;[186] And get out of here 27482 001263'01 endif. ;[186] End case negative number 27483 27484 001263'01 312 02 0 00 001220* came t2, mytty ;[186] Is the requested line the same as ours? 27485 001264'01 254 00 0 00 001270' ifskp. ;[186] It is silly to connect to ourselves 27486 emsg ;[187] Advise user of their confusion 27489 001266'01 104 00 0 00 000313 27490 000070'03 000000000000# 27491 000653'04 131 157 165 040 143 27492 27493 27494 001267'01 263 17 0 00 000000 ret ;[186] And get out of here 27495 001270'01 endif. ;[186] End case self-connect 27496 remark ;[186] Fine, let's try to use it 27497 001270'01 505 01 0 00 000012 hrli t1, .dvtty ;[186] Requesting a terminal 27498 001271'01 540 01 0 00 000002 hrr t1, t2 ;[186] This line 27499 001272'01 254 00 0 00 001431' jrst $conn2 ;[186] Go blat about the connection 27500 001273'01 endif. ;[186] End case physical line 27501 27502 001273'01 302 01 0 00 000000 caie t1, .cmkey ;[186] Parsed a keyword? 27503 001274'01 254 00 0 00 001346' ifskp. ;[186] Yes, let's see about that 27504 001275'01 550 01 0 00 001256* hrrz t1, pars4 ;[186] Load the requested device 27505 27506 001276'01 302 01 0 00 000015 caie t1, .dvnul ;[186] Wants to close out? 27507 001277'01 254 00 0 00 001312' ifskp. ;[186] Yes, so break the connection 27508 001300'01 332 00 0 00 001215* ifme. local ;[186] Already remote? 27509 001301'01 254 00 0 00 001305' 27510 emsg 27512 001303'01 104 00 0 00 000313 27513 000071'03 000000000000# 27514 000677'04 116 157 040 156 145 27515 27516 001304'01 263 17 0 00 000000 ret ;[186] Nothing to do, bye 27517 001305'01 endif. ;[186] End case not local 27518 001305'01 260 17 0 00 003047' call clsnet ;[186] Close whatever might be open 27519 txmsg <[Connection closed] 27520 001306'01 200 01 0 00 000000# > ;[186] Should say connection with what... 27521 001307'01 104 00 0 00 000076 27522 001310'01 320 12 0 00 001311' 27523 000072'03 000000000000# 27524 000706'04 133 103 157 156 156 27525 27526 001311'01 263 17 0 00 000000 ret ;[186] Proceed no further k20net - Kermit-20 Network Support MACRO %53B(1254)-4 19:42 30-Mar-24 Page 24-3 K20NET MAC 13-Dec-23 21:12 CONNECT command 27527 001312'01 endif. ;[186] End case closure 27528 27529 001312'01 302 01 0 00 000013 caie t1, .dvpty ;[186] Wants local loopback, differet job? 27530 001313'01 254 00 0 00 001316' ifskp. ;[186] Fine, let's try to use it 27531 001314'01 525 01 0 00 000013 hrloi t1, .dvpty ;[186] We don't specify the pseudo terminal 27532 001315'01 254 00 0 00 001431' jrst $conn2 ;[186] Go blat about the connection 27533 001316'01 endif. ;[186] 27534 27535 001316'01 302 01 0 00 000403 caie t1, .dvpip ;[186] Local connection, same job? 27536 001317'01 254 00 0 00 001323' ifskp. ;[186] Ok, handle that 27537 emsg () 27539 001321'01 104 00 0 00 000313 27540 000073'03 000000000000# 27541 000713'04 123 141 155 145 040 27542 27543 001322'01 263 17 0 00 000000 ret ;[186] Nothing to do, bye 27544 001323'01 endif. ;[186] End case doing a pipe 27545 27546 001323'01 302 01 0 00 777774 caie t1, .fhinf ;[205] Wants to get rid of the terminal fork? 27547 001324'01 254 00 0 00 001341' ifskp. ;[205] Does, so no 'network' activity 27548 001325'01 333 01 0 00 000000* skiple t1, ttfork ;[205] Load the fork handle 27549 001326'01 254 00 0 00 001332' ifskp. ;[205] Unless there isn't one 27550 emsg ;[205] Blat about it 27552 001330'01 104 00 0 00 000313 27553 000074'03 000000000000# 27554 000727'04 116 157 040 162 145 27555 27556 001331'01 254 00 0 00 001337' else. ;[205] Otherwise, get rid of it 27557 001332'01 104 00 0 00 000153 KFORK% ;[205] BYE!! 27558 001333'01 320 12 0 00 001334' erjmpr .+1 ;[205] Ignore error and carry on 27559 txmsg <[Killed remote terminal fork] 27560 001334'01 200 01 0 00 000000# > ;[205] 27561 001335'01 104 00 0 00 000076 27562 001336'01 320 12 0 00 001337' 27563 000075'03 000000000000# 27564 000736'04 133 113 151 154 154 27565 27566 001337'01 endif. ;[205] End fork determination actions 27567 001337'01 402 00 0 00 001325* setzm ttfork ;[205] Remember its demise 27568 001340'01 263 17 0 00 000000 ret ;[205] And we're done 27569 001341'01 endif. ;[205] End case terminal fork management 27570 27571 001341'01 334 01 0 00 000000# ermsg% (,r) ;[186] 27572 001342'01 254 00 0 00 001346' 27573 001343'01 202 01 0 00 001251* 27574 001344'01 104 00 0 00 000313 27575 001345'01 254 00 0 00 001253* 27576 000076'03 000000000000# 27577 000745'04 113 105 122 115 111 27578 27579 001346'01 endif. ;[186] End case .cmkey 27580 27581 001346'01 302 01 0 00 000026 caie t1, .cmnod ;[186] Parsed a node? k20net - Kermit-20 Network Support MACRO %53B(1254)-4 19:42 30-Mar-24 Page 24-4 K20NET MAC 13-Dec-23 21:12 CONNECT command 27582 001347'01 254 00 0 00 001424' ifskp. ;[186] Yes, wants to have excitement and adventure! 27583 001350'01 415 16 0 00 001374' block. ;[186] Allocate an anonymous stkvar 27584 001351'01 261 17 0 00 000016 27585 001352'01 265 16 0 00 000000* anstkv(t4,<.ndnum+1>);[186] Allocate a block for NODE% 27586 001353'01 000000 000003 27587 001354'01 415 04 0 17 777774 27588 001355'01 561 01 0 00 001245* hrroi t1, atmbuf ;[186] Point to whatever user typed 27589 001356'01 202 01 0 04 000000 movem t1, .ndnod(t4) ;[186] Store in block 27590 001357'01 403 01 0 00 000002 setzb t1, t2 ;[186] Cons up some zeros 27591 001360'01 124 01 0 04 000001 dmovem t1, .ndflg(t4) ;[186] Stomp flags and number 27592 001361'01 201 01 0 00 000023 movei t1, .ndvfx ;[186] Node name verify, extended 27593 001362'01 336 00 0 00 000000# skipn ndvfxp ;[186] Has extended verify? 27594 001363'01 201 01 0 00 000015 movx t1, .ndvfy ;[186] Unfortunate, but still doable 27595 001364'01 200 02 0 00 000004 move t2, t4 ;[186] Load base of block 27596 001365'01 104 00 0 00 000567 NODE% ;[186] Should work because .cmnod validates 27597 001366'01 320 12 0 00 001370' ifje. r ;[186] Failed?? 27598 001367'01 254 00 0 00 001372' 27599 001370'01 403 02 0 00 000003 setzb t2, t3 ;[186] Whack any supposed flags 27600 001371'01 254 00 0 00 001373' else. ;[186] Otherwise, worked 27601 001372'01 120 02 0 04 000001 dmove t2, .ndflg(t4) ;[186] Load flags and maybe number 27602 001373'01 endif. ;[186] End JSYS error processing 27603 001373'01 263 17 0 00 000000 endbk. ;[186] End block, restore stack 27604 001374'01 603 02 0 00 200000 ifxe. t2, nd%lgl ;[186] Illegal in some way? 27605 001375'01 254 00 0 00 001405' 27606 001376'01 200 01 0 00 000000# emsg ;[186] Blat about it 27607 001377'01 104 00 0 00 000313 27608 000077'03 000000000000# 27609 000756'04 111 154 154 145 147 27610 001400'01 561 01 0 00 001355* hrroi t1, atmbuf ;[186] Point to what was typed 27611 001401'01 104 00 0 00 000076 PSOUT% ;[186] Type it 27612 001402'01 561 01 0 00 000672* hrroi t1, crlf ;[186] Tie off the line 27613 001403'01 104 00 0 00 000076 PSOUT% ;[186] Type it 27614 001404'01 263 17 0 00 000000 ret ;[186] Proceed no further 27615 001405'01 endif. 27616 001405'01 321 02 0 00 001415' ifxe. t2, nd%exm ;[186] Syntax correct, but do we know about it? 27617 001406'01 200 01 0 00 000000# emsg ;[186] Blat about it 27618 001407'01 104 00 0 00 000313 27619 000100'03 000000000000# 27620 000764'04 125 156 153 156 157 27621 001410'01 561 01 0 00 001400* hrroi t1, atmbuf ;[186] Point to what was typed 27622 001411'01 104 00 0 00 000076 PSOUT% ;[186] Type it 27623 001412'01 561 01 0 00 001402* hrroi t1, crlf ;[186] Tie off the line 27624 001413'01 104 00 0 00 000076 PSOUT% ;[186] Type it 27625 001414'01 263 17 0 00 000000 ret ;[186] Proceed no further 27626 001415'01 endif. 27627 001415'01 603 02 0 00 020000 txne t2, nd%num ;[186] Did T79 give us a number? 27628 001416'01 202 03 0 00 000607* movem t3, nodnum ;[186] Yes, store it 27629 001417'01 120 01 0 00 001410* dmove t1, atmbuf ;[186] Grab the atom buffer 27630 001420'01 124 01 0 00 001244* dmovem t1, nodnam ;[186] Pass to openrt 27631 001421'01 505 01 0 00 000022 hrli t1, .dvdcn ;[186] Outgoing DECnet connection 27632 001422'01 540 01 0 00 000003 hrr t1, t3 ;[186] Use node number, if we have it 27633 001423'01 254 00 0 00 001431' jrst $conn2 ;[186] And open the connection 27634 001424'01 endif. ;[186] End case node:: typed 27635 27636 001424'01 334 01 0 00 000000# ermsg% (,r) ;[186] k20net - Kermit-20 Network Support MACRO %53B(1254)-4 19:42 30-Mar-24 Page 24-5 K20NET MAC 13-Dec-23 21:12 CONNECT command 27637 001425'01 254 00 0 00 001431' 27638 001426'01 202 01 0 00 001343* 27639 001427'01 104 00 0 00 000313 27640 001430'01 254 00 0 00 001345* 27641 000101'03 000000000000# 27642 000772'04 113 105 122 115 111 27643 27644 27645 ; Set up controlling TTY for talk mode, issue connect message. 27646 27647 001431'01 260 17 0 00 003377' $conn2: call openet ;[186] Go open (or reopen) the connection 27648 001432'01 263 17 0 00 000000 ret ;[186] Couldn't; proceed no further 27649 001433'01 202 01 0 00 001171* movem t1, netjfn ;[186] Store as network JFN 27650 001434'01 336 00 0 00 000000* skipn pars5 ;[205] Don't init terminal if staying 27651 001435'01 260 17 0 00 000000* call ttyini ;[186] Init controlling TTY. 27652 27653 001436'01 200 01 0 00 000000# txmsg <[KERMIT-20: > 27654 001437'01 104 00 0 00 000076 27655 001440'01 320 12 0 00 001441' 27656 000102'03 000000000000# 27657 001005'04 133 113 105 122 115 27658 001441'01 336 00 0 00 000000# ifmn. nrtflg ;[186] Active NRT connection? 27659 001442'01 254 00 0 00 001454' 27660 001443'01 200 01 0 00 000000# txmsg 27661 001444'01 104 00 0 00 000076 27662 001445'01 320 12 0 00 001446' 27663 000103'03 000000000000# 27664 001010'04 103 157 156 156 145 27665 001446'01 561 01 0 00 001420* hrroi t1,nodnam ;[186] and don't claim it is a terminal 27666 001447'01 104 00 0 00 000076 PSOUT% ;[186] instead, type the node name 27667 001450'01 200 01 0 00 000000# txmsg <::> ;[211] DECnet node punctuation 27668 001451'01 104 00 0 00 000076 27669 001452'01 320 12 0 00 001453' 27670 000104'03 000000000000# 27671 001016'04 072 072 000 000 000 27672 001453'01 254 00 0 00 001511' else. ;[186] Otherwise, use the physical line 27673 001454'01 336 00 0 00 000000# ifmn. ptyflg ;[186] Unless using a pseudo-terminal 27674 001455'01 254 00 0 00 001474' 27675 001456'01 200 01 0 00 000000# txmsg ;[186] 27676 001457'01 104 00 0 00 000076 27677 001460'01 320 12 0 00 001461' 27678 000105'03 000000000000# 27679 001017'04 114 157 157 160 142 27680 001461'01 561 01 0 00 000000# hrroi t1,sysnam ;[186] Load local node name 27681 001462'01 104 00 0 00 000076 PSOUT% ;[186] Remind us of where we are 27682 001463'01 200 01 0 00 000000# txmsg <:: via > ;[186] some more details 27683 001464'01 104 00 0 00 000076 27684 001465'01 320 12 0 00 001466' 27685 000106'03 000000000000# 27686 001024'04 072 072 040 166 151 27687 001466'01 561 01 0 00 000000# hrroi t1,ptynam ;[186] Give pseudo-terminal number 27688 001467'01 104 00 0 00 000076 PSOUT% ;[186] Type that 27689 001470'01 200 01 0 00 000000# txmsg < as > ;[186] load final clause 27690 001471'01 104 00 0 00 000076 27691 001472'01 320 12 0 00 001473' k20net - Kermit-20 Network Support MACRO %53B(1254)-4 19:42 30-Mar-24 Page 24-6 K20NET MAC 13-Dec-23 21:12 CONNECT command 27692 000107'03 000000000000# 27693 001026'04 040 141 163 040 000 27694 001473'01 254 00 0 00 001477' else. ;[186] Otherwise, physical line 27695 001474'01 200 01 0 00 000000# txmsg ;[186] 27696 001475'01 104 00 0 00 000076 27697 001476'01 320 12 0 00 001477' 27698 000110'03 000000000000# 27699 001027'04 103 157 156 156 145 27700 001477'01 endif. ;[186] End case pseudo-terminal 27701 001477'01 200 01 0 00 000000# txmsg ;[186] Type message. 27702 001500'01 104 00 0 00 000076 27703 001501'01 320 12 0 00 001502' 27704 000111'03 000000000000# 27705 001036'04 124 124 131 000 000 27706 001502'01 201 01 0 00 000101 numout ttynum,^d8 ;[186] 27707 001503'01 200 02 0 00 001233* 27708 001504'01 201 03 0 00 000010 27709 001505'01 104 00 0 00 000224 27710 001506'01 320 14 0 00 001507' 27711 001507'01 201 01 0 00 000072 movei t1,":" ;[186] Extra colon to punctuate 27712 001510'01 104 00 0 00 000074 PBOUT% ;[186] DECnet node name 27713 001511'01 endif. ;[186] 27714 001511'01 332 00 0 00 001434* ifme. pars5 ;[205] Staying at remote? 27715 001512'01 254 00 0 00 001534' 27716 001513'01 200 01 0 00 000000# txmsg <, type > ;[205] No, normal blat 27717 001514'01 104 00 0 00 000076 27718 001515'01 320 12 0 00 001516' 27719 000112'03 000000000000# 27720 001037'04 054 040 164 171 160 27721 001516'01 201 01 0 00 000074 movei t1, 74 ; Left pointy bracket... 27722 001517'01 104 00 0 00 000074 PBOUT 27723 001520'01 200 01 0 00 000000# txmsg 27724 001521'01 104 00 0 00 000076 27725 001522'01 320 12 0 00 001523' 27726 000113'03 000000000000# 27727 001041'04 103 124 122 114 055 27728 001523'01 200 01 0 00 000000* move t1, escape ; (tell escape character) 27729 001524'01 271 01 0 00 000100 addi t1, "A"-1 27730 001525'01 104 00 0 00 000074 PBOUT 27731 001526'01 201 01 0 00 000076 movei t1, 76 ; ...Right pointy bracket 27732 001527'01 104 00 0 00 000074 PBOUT 27733 001530'01 200 01 0 00 000000# txmsg < to return.] > ; Tell about session log, if any. 27734 001531'01 104 00 0 00 000076 27735 001532'01 320 12 0 00 001533' 27736 000114'03 000000000000# 27737 001043'04 040 164 157 040 162 27738 001533'01 254 00 0 00 001536' else. ;[205] No, staying, so different blat 27739 001534'01 201 01 0 00 000135 movei t1, "]" ;[205] Not much blat 27740 001535'01 104 00 0 00 000074 PBOUT% ;[205] But say what there is of it... 27741 001536'01 endif. ;[205] 27742 27743 001536'01 337 02 0 00 000000* skipg t2, sesjfn ;[195] Logging? 27744 001537'01 254 00 0 00 001576' ifskp. ;[186] No, just tie off the line 27745 txmsg < 27746 001540'01 200 01 0 00 000000# [KERMIT-20: Logging session to > ; Yes, tell them now. k20net - Kermit-20 Network Support MACRO %53B(1254)-4 19:42 30-Mar-24 Page 24-7 K20NET MAC 13-Dec-23 21:12 CONNECT command 27747 001541'01 104 00 0 00 000076 27748 001542'01 320 12 0 00 001543' 27749 000115'03 000000000000# 27750 001046'04 015 012 133 113 105 27751 001543'01 201 01 0 00 000101 movei t1, .priou ; Type the filename. 27752 001544'01 302 02 0 00 377777 caie t2, .nulio ;[195] Just dumping it? 27753 001545'01 254 00 0 00 001556' ifskp. ;[195] Yep that's easy 27754 001546'01 120 02 0 00 000000* dmove t2, nul4## ;[195] In k20dsp 27755 001547'01 104 00 0 00 000053 SOUT% ;[195] 27756 001550'01 320 12 0 00 001552' %jserr (,) ;[195] 27757 001551'01 254 00 0 00 001555' 27758 001552'01 265 01 0 00 001026* 27759 001553'01 000000 000000 27760 001554'01 254 00 0 00 001555' 27761 001555'01 254 00 0 00 001565' else. ;[195] Otherwise, a real file 27762 001556'01 403 03 0 00 000004 setzb t3, t4 ;[195] 27763 001557'01 104 00 0 00 000030 JFNS% 27764 001560'01 320 12 0 00 001562' %jserr (,) 27765 001561'01 254 00 0 00 001565' 27766 001562'01 265 01 0 00 001552* 27767 001563'01 000000 000000 27768 001564'01 254 00 0 00 001565' 27769 001565'01 endif. ;[195] 27770 27771 001565'01 332 00 0 00 000000* ifme. sesflg ;[195] Active? 27772 001566'01 254 00 0 00 001572' 27773 001567'01 200 01 0 00 000000# txmsg < (Disabled)> ;[195] Nyet 27774 001570'01 104 00 0 00 000076 27775 001571'01 320 12 0 00 001572' 27776 000116'03 000000000000# 27777 001055'04 040 050 104 151 163 27778 001572'01 endif. ;[195] 27779 txmsg <] 27780 001572'01 200 01 0 00 000000# > ;[195] 27781 001573'01 104 00 0 00 000076 27782 001574'01 320 12 0 00 001575' 27783 000117'03 000000000000# 27784 001060'04 135 015 012 000 000 27785 001575'01 254 00 0 00 001600' else. ;[195] Otherwise just 27786 001576'01 561 01 0 00 001412* hrroi t1,crlf ;[195] tie off the line 27787 001577'01 104 00 0 00 000076 PSOUT% 27788 001600'01 endif. ;[195] 27789 k20net - Kermit-20 Network Support MACRO %53B(1254)-4 19:42 30-Mar-24 Page 25 K20NET MAC 13-Dec-23 21:12 CONNECT command 27790 remark Connection is open, determine what else to do with the terminal 27791 27792 001600'01 402 00 0 00 000000# setzm forkls ;[236] Clear /FORKLESS connect unless explicitly set 27793 001601'01 336 00 0 00 001243* ifmn. pars7 ;[236] Wants /FORKLESS? 27794 001602'01 254 00 0 00 001616' 27795 001603'01 332 00 0 00 000000# ifme. nrtflg ;[236] Yes, BUT!! Are we an active NRT connection? 27796 001604'01 254 00 0 00 001612' 27797 001605'01 402 00 0 00 001601* setzm pars7 ;[236] Force parse of normal connect 27798 txmsg <% /FORKLESS is only valid for DECnet connections 27799 001606'01 200 01 0 00 000000# > ;[236] Gently advise that this won't work... 27800 001607'01 104 00 0 00 000076 27801 001610'01 320 12 0 00 001611' 27802 000120'03 000000000000# 27803 001061'04 045 040 057 106 117 27804 27805 001611'01 254 00 0 00 001616' jrst $conn3 ;[236] And get on with it the olde-fashioned way 27806 001612'01 endif. ;[236] End case clearing /FORKLESS for non-NRT 27807 remark ;[236] Otherwise, flag other code we're doing /FORKLESS 27808 001612'01 476 00 0 00 000000# setom forkls ;[236] Flag doing a forkless NRT connect 27809 001613'01 332 00 0 00 001511* skipe pars5 ;[236] But! Doesn't actually want to connect yet? 27810 001614'01 263 17 0 00 000000 ret ;[236] We're done 27811 001615'01 254 00 0 00 001621' callret frklsc ;[236] Falls into the below (but saves a JRST 27812 001616'01 endif. ;[236] End case handling a /FORKLESS connection 27813 27814 001616'01 332 00 0 00 001613* $conn3: skipe pars5 ;[218] Doesn't want to connect terminal yet? 27815 001617'01 263 17 0 00 000000 ret ;[218] We're done 27816 001620'01 254 00 0 00 000000* callret ttsfrk ;[218] Otherwise, set up the forks and terminal 27817 27818 k20net - Kermit-20 Network Support MACRO %53B(1254)-4 19:42 30-Mar-24 Page 26 K20NET MAC 13-Dec-23 21:12 Forkless terminal connect 27819 subttl Forkless terminal connect 27820 27821 001621'01 frklsc: entry frklsc ;[236] Invoked by K20MIT, also 27822 001621'01 415 16 0 00 001735' block. ;[236] Otherwise, connect terminal via the monitor!! 27823 001622'01 261 17 0 00 000016 27824 001623'01 265 16 0 00 001352* anstkv(t4,.shlen) ;[236] Allocate a block for the MTOPR% 27825 001624'01 000000 000003 27826 001625'01 415 04 0 17 777774 27827 27828 remark ;[236] Construct block items 27829 001626'01 201 01 0 00 000003 movx t1, .shlen ;[236] Load length of argument block 27830 001627'01 550 02 0 00 000000* hrrz t2, ttyjfn ;[236] Only connecting our controlling terminal 27831 001630'01 550 03 0 00 001523* hrrz t3, escape ;[236] Load the escape character 27832 001631'01 332 00 0 00 000000* skipe flow ;[236] Doing flow control? 27833 001632'01 661 03 0 00 400000 txo t3, sh%lpm ;[236] Yes, turn on local page mode 27834 27835 remark ;[236] Populate the block 27836 001633'01 124 01 0 04 000000 dmovem t1, .sharg(t4) ;[236] Set first two words of the argument block 27837 001634'01 202 03 0 04 000002 movem t3, .shesc(t4) ;[236] Third word is escape character and flags 27838 27839 remark ;[236] Finally do the connect!!! 27840 001635'01 550 01 0 00 001433* hrrz t1, netjfn ;[236] Load the network JFN 27841 001636'01 201 02 0 00 000044 movx t2, .mosnh ;[236] Function is monitor NRT connect 27842 001637'01 200 03 0 00 000004 move t3, t4 ;[236] Load address of argument block 27843 001640'01 104 00 0 00 000077 MTOPR% ;[236] Do the connect 27844 001641'01 320 12 0 00 001643' %jserr (,r) ;[236] 27845 001642'01 254 00 0 00 001646' 27846 001643'01 265 01 0 00 001562* 27847 001644'01 000000000000# 27848 001645'01 254 00 0 00 001430* 27849 001074'04 125 156 141 142 154 27850 27851 001646'01 550 01 0 04 000001 hrrz t1, .shtty(t4) ;[236] Load terminal identifier we used 27852 001647'01 104 00 0 00 000050 BIN% ;[236] Swallow escape character it leaves in buffer 27853 001650'01 320 12 0 00 001652' %jserr (,r) ;[236] 27854 001651'01 254 00 0 00 001655' 27855 001652'01 265 01 0 00 001643* 27856 001653'01 000000000000# 27857 001654'01 254 00 0 00 001645* 27858 001104'04 125 156 141 142 154 27859 27860 001655'01 550 01 0 00 001635* hrrz t1, netjfn ;[236] Load the network JFN 27861 001656'01 260 17 0 00 004126' call chkdcn ;[236] Returned; get link status 27862 001657'01 332 00 0 00 000000* ifme. carier ;[236] Got disconnected? 27863 001660'01 254 00 0 00 001733' 27864 001661'01 607 03 0 00 004000 ifxn. t3,mo%syn ;[236] Normal close and 27865 001662'01 254 00 0 00 001677' 27866 001663'01 603 03 0 00 010000 andxe. t3,mo%abt ;[236] not aborted? 27867 001664'01 254 00 0 00 001677' 27868 001665'01 400 04 0 00 000000 setz t4, ;[236] Flag a normal close 27869 001666'01 200 01 0 00 000000# txmsg (<[KERMIT-20: >) ;[236] Yes, begin blat ']' (emacs) 27870 001667'01 104 00 0 00 000076 27871 001670'01 320 12 0 00 001671' 27872 000121'03 000000000000# 27873 001116'04 133 113 105 122 115 k20net - Kermit-20 Network Support MACRO %53B(1254)-4 19:42 30-Mar-24 Page 26-1 K20NET MAC 13-Dec-23 21:12 Forkless terminal connect 27874 001671'01 561 01 0 00 001446* hrroi t1,nodnam ;[236] Point to the remote node 27875 001672'01 104 00 0 00 000076 PSOUT% ;[236] Type it 27876 001673'01 200 01 0 00 000000# txmsg <:: has closed> ;[236] 27877 001674'01 104 00 0 00 000076 27878 001675'01 320 12 0 00 001676' 27879 000122'03 000000000000# 27880 001121'04 072 072 040 150 141 27881 001676'01 254 00 0 00 001707' else. ;[236] Otherwise, abnormal close 27882 001677'01 474 04 0 00 000000 seto t4, ;[236] Flag an ABNORMAL close 27883 001700'01 200 01 0 00 000000# emsg () ;[236] Begin an error message 27884 001701'01 104 00 0 00 000313 27885 000123'03 000000000000# 27886 001124'04 113 105 122 115 111 27887 001702'01 561 01 0 00 001671* hrroi t1,nodnam ;[236] Point to the remote node 27888 001703'01 104 00 0 00 000076 PSOUT% ;[236] Type it 27889 001704'01 200 01 0 00 000000# txmsg <:: has aborted> ;[236] 27890 001705'01 104 00 0 00 000076 27891 001706'01 320 12 0 00 001707' 27892 000124'03 000000000000# 27893 001127'04 072 072 040 150 141 27894 001707'01 endif. ;[236] End case link closure analysis 27895 001707'01 200 01 0 00 000000# txmsg (< the NRT connection because: >) ;[236] 27896 001710'01 104 00 0 00 000076 27897 001711'01 320 12 0 00 001712' 27898 000125'03 000000000000# 27899 001132'04 040 164 150 145 040 27900 001712'01 260 17 0 00 002330' call gdscpt ;[236] Get pointer to disconnect reason 27901 001713'01 104 00 0 00 000076 PSOUT% ;[236] Type it 27902 001714'01 200 01 0 00 000000# txmsg <. Returning to > ;[236] Emphasize we're not there anymore 27903 001715'01 104 00 0 00 000076 27904 001716'01 320 12 0 00 001717' 27905 000126'03 000000000000# 27906 001140'04 056 040 122 145 164 27907 001717'01 561 01 0 00 000000# hrroi t1,sysnam ;[236] Load local node name 27908 001720'01 104 00 0 00 000076 PSOUT% ;[236] and type it 27909 001721'01 200 01 0 00 000000# txmsg <::> ;[236] Punctuate the local node name 27910 001722'01 104 00 0 00 000076 27911 001723'01 320 12 0 00 001724' 27912 000127'03 000000000000# 27913 001144'04 072 072 000 000 000 27914 001724'01 326 04 0 00 001727' ife. t4 ;[236] Did it close normally? 27915 001725'01 201 01 0 00 000135 movx t1,135 ;[236] It did, so load a closing brocket 27916 001726'01 104 00 0 00 000074 PBOUT% ;[236] Type it to close off the message 27917 001727'01 endif. ;[236] End case properly formating informative message 27918 001727'01 561 01 0 00 001576* hrroi t1, crlf ;[236] Tie off the line 27919 001730'01 104 00 0 00 000076 PSOUT% ;[236] 27920 001731'01 260 17 0 00 003121' call clsnrt ;[236] Toss the NRT connection 27921 001732'01 263 17 0 00 000000 ret ;[236] Either way, return; we're done 27922 001733'01 endif. ;[236] End case disconnected 27923 27924 001733'01 254 00 0 00 001164* retskp ;[236] Otherwise, worked and they typed the escape 27925 001734'01 263 17 0 00 000000 endbk. ;[236] End block context 27926 001735'01 254 00 0 00 001740' ifskp. ;[236] Worked? 27927 001736'01 254 00 0 00 000000* callret doesc ;[236] It did, and the user typed the escape character 27928 001737'01 254 00 0 00 001741' else. ;[236] Something failed k20net - Kermit-20 Network Support MACRO %53B(1254)-4 19:42 30-Mar-24 Page 26-2 K20NET MAC 13-Dec-23 21:12 Forkless terminal connect 27929 001740'01 263 17 0 00 000000 ret ;[236] Just get out of here 27930 001741'01 endif. ;[236] 27931 k20net - Kermit-20 Network Support MACRO %53B(1254)-4 19:42 30-Mar-24 Page 27 K20NET MAC 13-Dec-23 21:12 BOUTR% - BOUT% a Record 27932 subttl BOUTR% - BOUT% a Record 27933 27934 ; Necessary when doing DECnet to get a character pushed 27935 ; 27936 ; t1/ Network JFN 27937 ; t2/ Character to send 27938 ; 27939 ; Inefficient, you say? Clearly you haven't seen the code in the 27940 ; monitor that does a 'push'... 27941 ; 27942 ; Note use of anonymous stkvar to enable full re-entrancy while 27943 ; limiting symbol table usage. 27944 ; 27945 ; To do: Is a ROT and movem faster? Probably 27946 27947 001741'01 BOUTR%: entry BOUTR% ; Used in mainline 27948 001741'01 332 00 0 00 000231* ifme. vtermf ; Not a Virtual Terminal? 27949 001742'01 254 00 0 00 001752' 27950 001743'01 104 00 0 00 000051 BOUT% ; Just send the character out 27951 001744'01 320 12 0 00 001746' %jserr (,r) 27952 001745'01 254 00 0 00 001751' 27953 001746'01 265 01 0 00 001652* 27954 001747'01 000000000000# 27955 001750'01 254 00 0 00 001654* 27956 001145'04 102 117 125 124 122 27957 001751'01 254 00 0 00 001733* retskp ; Otherwise, worked!! 27958 001752'01 endif. ; End case regular line 27959 ; Otherwise, need to push it out the door 27960 remark t1,t2 ; t1 has JFN, t2 has character 27961 001752'01 265 16 0 00 005431' saveac ; Save a few things 27962 001753'01 265 16 0 00 001623* anstkv (t4,^d1) ; Allocate a one word anonymous stack variable 27963 001754'01 000000 000001 27964 001755'01 415 04 0 17 777776 27965 ; Now have something for SOUTR% to use 27966 001756'01 402 00 0 04 000000 setzm (t4) ; Clear memory (unnecessary for counted SOUTR%) 27967 001757'01 505 04 0 00 441000 hrli t4,(point 8,) ; Convert to an eight bit pointer 27968 001760'01 200 03 0 00 000004 move t3, t4 ; Make a copy of it 27969 001761'01 136 02 0 00 000003 idpb t2, t3 ; Pop the character at BEGINNING of word 27970 001762'01 200 02 0 00 000004 move t2, t4 ; Load pristine pointer for I/O 27971 001763'01 477 03 0 00 000004 setob t3, t4 ; Doing one character, no stop character 27972 001764'01 104 00 0 00 000532 SOUTR% ; Output, setting PSH 27973 001765'01 320 12 0 00 001767' ifje. r ; Catch error 27974 001766'01 254 00 0 00 001777' 27975 001767'01 200 04 0 00 000001 move t4, t1 ; Put this someplace for debuggers 27976 001770'01 334 00 0 00 000000 %ermsg (,) ; Whine 27977 001771'01 254 00 0 00 001775' 27978 001772'01 265 01 0 00 001746* 27979 001773'01 000000000000# 27980 001774'01 254 00 0 00 001775' 27981 001151'04 102 117 125 124 122 27982 001775'01 260 17 0 00 003244' call netvtx ; Whine some more 27983 001776'01 263 17 0 00 000000 ret ; Return failure 27984 001777'01 endif. ; End case JSYS error 27985 001777'01 254 00 0 00 001751* retskp ; Return success 27986 k20net - Kermit-20 Network Support MACRO %53B(1254)-4 19:42 30-Mar-24 Page 28 K20NET MAC 13-Dec-23 21:12 Alternate network input code (assumes upper fork context) 27987 subttl Alternate network input code (assumes upper fork context) 27988 27989 ; Special cased for NRT's in order to 'push' data on DECnet. Tested 27990 ; on PTY's, also. 27991 ; 27992 ; Characters are sent out with a 'push' by doing a record out, which 27993 ; gets them over to the remote NRT host immediately. Checks to see 27994 ; if we can bum BIN%'s with a SIN%. PTY code uses this, too. 27995 ; 27996 ; SIBE% is fine because we are looking at the local TTY 27997 ; 27998 ; N.B., We ALWAYS read 7-bit ASCII from our control terminal and may or 27999 ; may not put parity on it in for output 28000 28001 002000'01 vtmpsh: entry vtmpsh ; Jumped to by ttinch: 28002 remark q1, ; Have to validate that q1 is not in flight here 28003 28004 002000'01 do. ; Enter loop context. 28005 002000'01 200 01 0 00 001627* move t1, ttyjfn ; Wait for data on TTY 28006 002001'01 104 00 0 00 000050 BIN% ; Wakes up on anything 28007 002002'01 320 12 0 00 002004' %jserr (,tter1) ; What could happen? 28008 002003'01 254 00 0 00 002007' 28009 002004'01 265 01 0 00 001772* 28010 002005'01 000000000000# 28011 002006'01 254 00 0 00 000000* 28012 001156'04 103 141 156 047 164 28013 002007'01 350 00 0 00 000000# aos vbict ; Count a BIN% on a virtual terminal 28014 002010'01 201 04 0 00 000177 movei t4,177 ; 7 bit mask 28015 002011'01 407 02 0 00 000004 andb t2,t4 ; Stomp any foolish parity everywhere 28016 002012'01 316 02 0 00 001630* camn t2, escape ; Is it the escape character? 28017 002013'01 254 00 0 00 001736* jrst doesc ; Yes, go process single-char command. 28018 002014'01 104 00 0 00 000102 SIBE% ; Any more data to read maybe? 28019 002015'01 254 00 0 00 002043' ifskp. ; Nope, then just had this poor character 28020 002016'01 322 02 0 00 002024' ifn. t2 ; If zero, then no error and nothing to do 28021 002017'01 334 00 0 00 000000 %ermsg (,) ; But continue 28022 002020'01 254 00 0 00 002024' 28023 002021'01 265 01 0 00 002004* 28024 002022'01 000000000000# 28025 002023'01 254 00 0 00 002024' 28026 001163'04 125 156 141 142 154 28027 002024'01 endif. ; End case t2 having JSYS error code 28028 remark ; Yet contribute nothing to total 28029 002024'01 200 02 0 00 000004 move t2,t4 ; Load the character for duplex 28030 002025'01 332 00 0 00 000000* skipe duplex ; Have to echo locally? 28031 002026'01 260 17 0 00 000000* call echo ; Yes, do. 28032 002027'01 200 01 0 00 000004 move t1, t4 ;[223] Load in case parity 28033 002030'01 260 17 1 00 000000* call @parity ;[223] Do parity if asked 28034 002031'01 200 02 0 00 000001 move t2, t1 ;[223] Put whatever parity did in the right place 28035 002032'01 200 01 0 00 001655* move t1, netjfn ; Load JFN of our DCN: connection 28036 002033'01 260 17 0 00 001741' call BOUTR% ; Write and push to network 28037 002034'01 334 00 0 00 000000 %ermsg (,tter1) ; If error, go check. 28038 002035'01 254 00 0 00 002041' 28039 002036'01 265 01 0 00 002021* 28040 002037'01 000000000000# 28041 002040'01 254 00 0 00 002006* k20net - Kermit-20 Network Support MACRO %53B(1254)-4 19:42 30-Mar-24 Page 28-1 K20NET MAC 13-Dec-23 21:12 Alternate network input code (assumes upper fork context) 28042 001174'04 103 141 156 047 164 28043 002041'01 350 00 0 00 000000# aos vboct ; Count it as a BOUT% 28044 002042'01 254 00 0 00 002067' else. ; Otherwise, maybe save us a few BIN%'s 28045 002043'01 301 02 0 00 002000 cail t2,linlen ; Rolling buffer plus BIN%? 28046 002044'01 201 02 0 00 001777 movei t2, ;Clip it down to fit the character we got 28047 002045'01 200 03 0 00 000002 move t3,t2 ; Load amount to read (positive!!) 28048 002046'01 200 05 0 00 000002 move t5,t2 ; Save a handy copy 28049 002047'01 272 05 0 00 000000# addm t5,vsitc ; Number of characters slurping up 28050 002050'01 313 05 0 00 000000# camle t5,vsimx ; Larger than largest we ever saw? 28051 002051'01 202 05 0 00 000000# movem t5,vsimx ; Yes, remember that 28052 002052'01 350 00 0 00 000000# aos vsict ; Count a SIN% 28053 002053'01 200 02 0 00 005441' move t2,[point 7,nrtbuf] ;Seven bit traffic 28054 002054'01 136 04 0 00 000002 idpb t4,t2 ; Deposit the BIN%'ed character 28055 002055'01 200 04 0 00 002012* move t4,escape ; Stop reading on escape character 28056 002056'01 104 00 0 00 000052 SIN% ; Slurp in a bunch of characters from user 28057 002057'01 320 12 0 00 002061' %jserr (,tter1) ; Handle any errors. 28058 002060'01 254 00 0 00 002064' 28059 002061'01 265 01 0 00 002036* 28060 002062'01 000000000000# 28061 002063'01 254 00 0 00 002040* 28062 001200'04 103 141 156 047 164 28063 002064'01 260 17 0 00 002071' call vtmout ; Output it 28064 002065'01 254 00 0 00 002063* jrst tter1 ; Failed somehow 28065 002066'01 326 05 0 00 002013* jumpn t5,doesc ; Use talisman to handle escape 28066 002067'01 endif. ; Done handling results from SIBE% 28067 002067'01 254 00 0 00 002000' loop. ; Go back and do it some more 28068 002070'01 enddo. ; Exit loop context 28069 ; Should never get here, but... 28070 002070'01 254 00 0 00 000000* jrst ttinch ; Go back and do it again from the top 28071 k20net - Kermit-20 Network Support MACRO %53B(1254)-4 19:42 30-Mar-24 Page 29 K20NET MAC 13-Dec-23 21:12 Network fork data writer 28072 subttl Network fork data writer 28073 28074 ; Write whatever data we have to the network, type it, log it, Etc. 28075 ; 28076 ; On entry: 28077 ; 28078 ; t1/ ttyjfn 28079 ; t2/ Updated byte pointer (buffer will have at least the BIN%'ed character) 28080 ; t3/ Remaining characters in buffer 28081 ; t4/ Escape character that may have stopped us 28082 ; t5/ Original buffer length 28083 ; 28084 ; AC usage: 28085 ; 28086 ; t5/ 0, Complete buffer written 28087 ; -1, Wasn't (hit an escape) 28088 ; 28089 ; q2/ Copy of orginal t3 (remaining characters) 28090 ; q3/ Number of characters we're actually writing 28091 ; q4/ Parity (if doing parity) 28092 28093 002071'01 265 16 0 00 005442' vtmout: saveac ; Save misc. things 28094 002072'01 200 10 0 00 002030* move q4, parity ;[223] Load parity 28095 002073'01 336 00 0 00 000000* skipn parpko ;[223] Not if packets-only 28096 002074'01 306 10 0 00 000000* cain q4, none ;[223] But!! Doing anything at all, really? 28097 002075'01 400 10 0 00 000000 setz q4, ;[223] No, so make it easier to do nothing 28098 28099 002076'01 350 07 0 00 000005 aos q3,t5 ; Store original count + BIN% 28100 002077'01 400 05 0 00 000000 setz t5, ; Let's assume didn't hit the escape 28101 002100'01 332 06 0 00 000003 skipe q2,t3 ; Save and check remaining count 28102 002101'01 474 05 0 00 000000 seto t5, ; Hit an escape... 28103 002102'01 277 03 0 00 000007 subb t3,q3 ; Calculate complete buffer size 28104 002103'01 322 07 0 00 001750* jumpe q3,r ; Don't do a push of an empty buffer 28105 28106 002104'01 210 01 0 00 000007 movn t1,q3 ; Pick up POSITIVE count of characters 28107 002105'01 272 01 0 00 000000# addm t1,vsotc ; Add in total 28108 002106'01 313 01 0 00 000000# camle t1,vsomx ; Greater than max? 28109 002107'01 202 01 0 00 000000# movem t1,vsomx ; Update maximum 28110 002110'01 350 00 0 00 000000# aos vsoct ; Count a SOUTR% 28111 28112 002111'01 200 02 0 00 005454' move t2,[point 7,nrtbuf] ;Seven bit traffic 28113 002112'01 322 10 0 00 002115' ifn. q4 ;[223] Parity? 28114 002113'01 200 01 0 00 005455' move t1,[point 8,parbuf] ;[223] Eight bit traffic 28115 002114'01 260 17 0 00 000000* call genpar ;[223] Generate a new string with parity 28116 002115'01 endif. ;[223] End case generating parity 28117 28118 002115'01 200 01 0 00 002032* move t1, netjfn ; Load JFN of our DCN: connection 28119 002116'01 104 00 0 00 000532 SOUTR% ; Write and 'push' 28120 002117'01 320 12 0 00 002121' %jserr (,r) ; If error, return +1 28121 002120'01 254 00 0 00 002124' 28122 002121'01 265 01 0 00 002061* 28123 002122'01 000000000000# 28124 002123'01 254 00 0 00 002103* 28125 001205'04 103 141 156 047 164 28126 002124'01 336 00 0 00 002025* skipn duplex ; Half duplex? k20net - Kermit-20 Network Support MACRO %53B(1254)-4 19:42 30-Mar-24 Page 29-1 K20NET MAC 13-Dec-23 21:12 Network fork data writer 28127 002125'01 263 17 0 00 000000 ret ; No, nothing to echo 28128 ; Ugh... Let's get to it 28129 002126'01 265 16 0 00 005456' saveac ; Wants another register 28130 002127'01 200 06 0 00 005464' move q2,[point 7,nrtbuf] ;Load a pointer to the buffer 28131 002130'01 210 10 0 00 000007 movn q4,q3 ; Do a positive counter (unnecessary) 28132 28133 002131'01 do. ; Enter loop lexical context 28134 002131'01 134 02 0 00 000006 ildb t2,q2 ; Pick up a character from the buffer 28135 002132'01 260 17 0 00 002026* call echo ; Type it 28136 002133'01 367 10 0 00 002131' sojg q4,top. ; Do all of them 28137 002134'01 enddo. ; Exit loop lexical context 28138 28139 002134'01 263 17 0 00 000000 ret ; Done, finally 28140 28141 ; To do, this is an awful lot of instructions just to echo. 28142 ; Could temporarily restore the COC's and PSOUT%. Also could 28143 ; do a MOVST from from an eight byte buffer and overwrite it 28144 ; with a seven bit buffer with the control characters? 28145 k20net - Kermit-20 Network Support MACRO %53B(1254)-4 19:42 30-Mar-24 Page 30 K20NET MAC 13-Dec-23 21:12 Code for receive fork. 28146 subttl Code for receive fork. 28147 28148 ; Rewritten for efficiency to use less JSYI and avoid stack clash 28149 ; 28150 ; Runs forever, asynchronously, till killed. 28151 ; 28152 ; The algorithm is to wait for a character and then slurp up anything 28153 ; that might be in the monitor's input buffer for the line (or NRT). 28154 ; This can substantially cut down on BIN%/BOUT% overhead while still 28155 ; maintaining performance because the fork is effectively always waiting 28156 ; for remote output. 28157 ; 28158 ; Partially adapted from a much modified SETNOD. 28159 ; 28160 ; Be aware of a subtle Tops-20 bug! Once created, the terminal fork 28161 ; should NEVER be killed, but rather frozen. Previous Kermit behavior 28162 ; was to always kill the fork on a close, keeping the network JFN open, 28163 ; recreating the fork on every connect. While this was inefficient 28164 ; (fork creation being expensive), it was fine for a pseudo-terminal. 28165 ; 28166 ; However, killing the fork while it was waiting for NRT data caused 28167 ; Tops-20 DECnet to lose track of the buffers, the result being that 28168 ; whatever was last in the buffer was read again when the fork was 28169 ; recreated. 28170 ; 28171 ; Trying to force the monitor buffers to be correct with SINR% only 28172 ; partially worked. Output was not repeated, but a timing anomaly was 28173 ; then exposed that the result of a SIBE% was less than what was 28174 ; available, the consequence being that the SINR% would fail with 28175 ; a IOX10 error (Record is longer than user requested), the extra 28176 ; data then being dumped (into oblivion). 28177 ; 28178 ; Freezing and resuming the terminal fork prevents this situation and 28179 ; is more efficient, anyway. Therefore, make certain that the FFORK% 28180 ; at $CONX2+5 is NEVER changed back to a KFORK%! 28181 ; 28182 ; However, this does not fix the problem of output getting repeated 28183 ; into the main fork once the subfork is frozen. In particular, 28184 ; suppose the user does something very reasonable and connects to a 28185 ; remote system to sign on. Escaping back will now work fine, but if 28186 ; before this happens, the user runs a Kermit and puts it into server 28187 ; mode, the main fork will now see all the junk that the recreated 28188 ; inferior used to see plus a large pile of NUL's thrown in to boot!! 28189 ; 28190 ; Therefore, whenever we escape back, a clrbuf is done for an NRT. 28191 28192 002000 linlen==^d1024 ; Maximum characters we'll swallow at once 28193 28194 002135'01 netin: entry netin ; Jumped to by main character read loop 28195 remark q1,q2,q3,q4,p1,p2,p3 ;No need to save these in seperate fork 28196 002135'01 200 17 0 00 005465' move p,[iowd pdlsiz,frkpdl] ; Can't share stacks... 28197 002136'01 201 01 0 00 003345' movei t1, netinh ; Load Address of a halt routine 28198 002137'01 261 17 0 00 000001 push p, t1 ; Just in case we want to return over the top 28199 28200 002140'01 201 05 0 00 000000# movei q1, frkbuf ;[223] Always using the same buffer k20net - Kermit-20 Network Support MACRO %53B(1254)-4 19:42 30-Mar-24 Page 30-1 K20NET MAC 13-Dec-23 21:12 Code for receive fork. 28201 002141'01 200 01 0 00 002072* move t1, parity ;[223] Load parity setting 28202 002142'01 306 01 0 00 002074* cain t1, none ;[223] Are we doing anything? 28203 002143'01 254 00 0 00 002153' ifskp. ;[223] Some kind of parity being done, so check further 28204 002144'01 332 00 0 00 002073* skipe parpko ;[223] Only doing parity on packets? 28205 002145'01 254 00 0 00 002153' anskp. ;[223] Yes, so better leave this alone 28206 002146'01 336 00 0 00 000000* skipn parrck ;[223] Checking parity on receive and not just sending? 28207 002147'01 254 00 0 00 002153' anskp. ;[223] No, so don't pay any attention 28208 002150'01 200 13 0 00 000001 move p3, t1 ;[223] Set the flag with the parity value 28209 002151'01 505 05 0 00 441000 hrli q1,<(point 8,0)> ;[223] Do it all 7 bit ASCII with a parity bit 28210 002152'01 254 00 0 00 002155' else. ;[223] Otherwise, not doing anything special 28211 002153'01 400 13 0 00 000000 setz p3, ;[223] So clear the flag 28212 002154'01 505 05 0 00 440700 hrli q1,<(point 7,0)> ;[223] And do it all straight 7 bit ASCII 28213 002155'01 endif. ;[223] End case parity determination 28214 28215 002155'01 do. ; Enter loop context 28216 002155'01 474 06 0 00 000000 seto q2, ; Assume we get at least one chracter 28217 002156'01 550 01 0 00 002115* hrrz t1, netjfn ; Always prefer a network JFN 28218 002157'01 326 01 0 00 002161' ife. t1 ; Unless there isn't one 28219 002160'01 550 01 0 00 002000* hrrz t1, ttyjfn ; Use terminal if nothing else 28220 002161'01 endif. ; End case no network JFN 28221 002161'01 104 00 0 00 000050 BIN% ; Wait for input 28222 002162'01 320 12 0 00 002164' %jserr (,neterr) ; Handle any errors. 28223 002163'01 254 00 0 00 002167' 28224 002164'01 265 01 0 00 002121* 28225 002165'01 000000000000# 28226 002166'01 254 00 0 00 002351' 28227 001211'04 103 141 156 047 164 28228 002167'01 350 00 0 00 000000# aos nbict ; Network BIN% count 28229 002170'01 200 07 0 00 000002 move q3, t2 ; Tuck that character safely away for now 28230 002171'01 200 04 0 00 000001 move t4, t1 ; Get the PTY JFN out of the way 28231 002172'01 260 17 0 00 002625' call clrest ; Find out what awaits us 28232 002173'01 254 00 0 00 002176' ifskp. ; Worked!! 28233 002174'01 200 11 0 00 000001 move p1, t1 ; Save the count (which might be zero) 28234 002175'01 254 00 0 00 002203' else. ; Failed?? 28235 002176'01 334 00 0 00 000000 %ermsg (,neterr) 28236 002177'01 254 00 0 00 002203' 28237 002200'01 265 01 0 00 002164* 28238 002201'01 000000000000# 28239 002202'01 254 00 0 00 002351' 28240 001216'04 125 156 141 142 154 28241 002203'01 endif. 28242 002203'01 326 11 0 00 002215' ife. p1 ; Nothing but one dinky character? 28243 002204'01 322 13 0 00 002211' ifn. p3 ;[223] Are we doing parity? 28244 002205'01 200 01 0 00 000007 move t1, q3 ;[223] Yes, so load the character 28245 002206'01 260 17 0 13 000000 call (p3) ;[223] Do some kind of parity 28246 002207'01 312 01 0 00 000007 came t1, q3 ;[223] Does it check? 28247 002210'01 260 17 0 00 002342' call parier ;[223] No, go complain 28248 002211'01 endif. ;[223] End case parity checking 28249 002211'01 200 02 0 00 000005 move t2, q1 ; Load the pointer 28250 002212'01 136 07 0 00 000002 idpb q3, t2 ; Drop the character in 28251 002213'01 260 17 0 00 002250' call ntecho ; Finally echo it 28252 002214'01 254 00 0 00 002247' else. ; Otherwise, save us many BIN%'s!! 28253 002215'01 do. ; Enter read/write loop 28254 002215'01 200 02 0 00 000011 move t2, p1 ; Load the total from clrest 28255 002216'01 301 02 0 00 002000 cail t2, linlen ; Rolling buffer plus BIN%? k20net - Kermit-20 Network Support MACRO %53B(1254)-4 19:42 30-Mar-24 Page 30-2 K20NET MAC 13-Dec-23 21:12 Code for receive fork. 28256 002217'01 201 02 0 00 001777 movei t2, ;Clip it down to fit the character we got 28257 002220'01 313 02 0 00 000000# camle t2, nsimx ; Smaller than biggest? 28258 002221'01 202 02 0 00 000000# movem t2, nsimx ; Nope, update total 28259 002222'01 272 02 0 00 000000# addm t2, nsitc ; Network SIN% total characters 28260 002223'01 210 03 0 00 000002 movn t3, t2 ; Calculate amount to read 28261 002224'01 274 11 0 00 000002 sub p1, t2 ; Subtract from total known 28262 002225'01 274 06 0 00 000002 sub q2, t2 ; Account for previous byte in write total 28263 002226'01 200 02 0 00 000005 move t2, q1 ; Load the pointer 28264 002227'01 136 07 0 00 000002 idpb q3, t2 ; Drop the character in 28265 002230'01 325 03 0 00 002241' Ifl. t3 ; BUT!! Are we actualy going to do anything? 28266 002231'01 350 00 0 00 000000# aos nsici ; Network SIN%'s Issued 28267 002232'01 200 01 0 00 000004 move t1, t4 ; Load the network JFN 28268 002233'01 104 00 0 00 000052 SIN% ; Get that data! 28269 002234'01 320 12 0 00 002236' %jserr (,neterr) ;Handle any errors 28270 002235'01 254 00 0 00 002241' 28271 002236'01 265 01 0 00 002200* 28272 002237'01 000000000000# 28273 002240'01 254 00 0 00 002351' 28274 001226'04 103 141 156 047 164 28275 002241'01 endif. ; End sanity check 28276 002241'01 322 13 0 00 002245' ifn. p3 ;[223] Doing any kind of parity? 28277 002242'01 120 02 0 00 000005 dmove t2, q1 ;[223] Load what will be passed to ntecho 28278 002243'01 260 17 0 00 000000* call chkpar ;[223] Check the parity 28279 002244'01 260 17 0 00 002342' call parier ;[223] Bad, go complain 28280 002245'01 endif. ;[223] End case parity checking 28281 002245'01 260 17 0 00 002250' call ntecho ; Go echo the output 28282 002246'01 327 11 0 00 002215' jumpg p1, top. ; Still more data pending, read it 28283 002247'01 enddo. ; End inner input/output loop 28284 002247'01 endif. ; End decision to read more than one character 28285 002247'01 254 00 0 00 002155' loop. ; Otherwise, go to the top and wait for more 28286 002250'01 enddo. ; End outer loop 28287 k20net - Kermit-20 Network Support MACRO %53B(1254)-4 19:42 30-Mar-24 Page 31 K20NET MAC 13-Dec-23 21:12 echo what we read from the network 28288 subttl echo what we read from the network 28289 28290 ; Called from various places in netin lower fork code to display data 28291 ; 28292 ; Expects: 28293 ; 28294 ; ttyjfn/ Valid JFN or terminal designator 28295 ; q1/ Pointer to beginning of data read 28296 ; q2/ Negative count of data (I.E., counted SOUT% ready 28297 ; p3/ Parity scrubber flag 28298 ; 28299 ; +1, always 28300 ; 28301 ; Trashes t1, t2 and t3. 28302 ; 28303 ; If doing parity, we have a buffer with eight bit bytes in it which 28304 ; must have the parity bit stripped off. If this is not done, then 28305 ; Tops-20 is going to write in 'image' mode, which can produce funny 28306 ; output on terminal emulators. 28307 ; 28308 ; The routine simply picks up an eight bit byte and replaces it with a 28309 ; seven bit byte, overwriting the storage in place. Since the 7 bit 28310 ; ASCII stream will always trail the 8 bit stream, we will never run 28311 ; out of space nor clobber anything. 28312 28313 002250'01 322 13 0 00 002304' ntecho: jumpe p3,ntech2 ;[223] Any parity to strip off? 28314 002251'01 322 06 0 00 002123* jumpe q2, r ;[223] If nothing to do, we're done! 28315 002252'01 554 01 0 00 000005 hlrz t1, q1 ;[223] A quick sanity check of the pointer width 28316 002253'01 306 01 0 00 440700 cain t1, <(point 7,0)> ;[223] Is this a waste of time, anyway? 28317 002254'01 254 00 0 00 002304' jrst ntech2 ;[223] It is, so skip all of this 28318 28319 002255'01 315 06 0 00 005466' caxge q2,-^d4 ;[223] Characters at which movslj wins (we think) 28320 002256'01 254 00 0 00 002270' jrst ntech1 ;[223] Go win big with extended instruction! 28321 28322 002257'01 265 16 0 00 005467' ntech0: saveac ;[223] Doesn't need quite so many registers... 28323 002260'01 200 02 0 00 000005 move t2, q1 ;[223] Load 8 bit source 28324 002261'01 505 05 0 00 440700 hrli q1, <(point 7,0)> ;[223] Stomp in the right pointer width 28325 002262'01 200 03 0 00 000005 move t3, q1 ;[223] Load 7 bit destination 28326 002263'01 210 04 0 00 000006 movn t4, q2 ;[223] We get less confused by positive numbers ... 28327 28328 002264'01 do. ;[223] Enter loop context 28329 002264'01 134 01 0 00 000002 ildb t1, t2 ;[223] Pick up an 8 bit byte 28330 002265'01 136 01 0 00 000003 idpb t1, t3 ;[223] And deposit as 7 bit, stripping parity 28331 002266'01 367 04 0 00 002264' sojg t4, top. ;[223] Do the rest of them 28332 002267'01 enddo. ;[223] End loop lexical context 28333 002267'01 254 00 0 00 002304' jrst ntech2 ;[223] And go type something 28334 28335 002270'01 265 16 0 00 005477' ntech1: saveac ;[223] Convert from 8 to 7 bit ASCII 28336 002271'01 120 07 0 00 000005 dmove q3, q1 ;[223] Save original arguments 28337 002272'01 210 01 0 00 000006 movn t1, q2 ;[223] movslj wants positive counts 28338 002273'01 200 04 0 00 000001 move t4, t1 ;[223] Smaller width can never overflow 28339 002274'01 200 02 0 00 000005 move t2, q1 ;[223] Section local eight bit pointer 28340 002275'01 550 05 0 00 000002 hrrz q1, t2 ;[223] Same starting address 28341 002276'01 505 05 0 00 440700 hrli q1, <(point 7,0)> ;[223] Stomp in the right pointer 28342 002277'01 500 07 0 00 000005 hll q3, q1 ;[223] And remember that new width k20net - Kermit-20 Network Support MACRO %53B(1254)-4 19:42 30-Mar-24 Page 31-1 K20NET MAC 13-Dec-23 21:12 echo what we read from the network 28343 002300'01 403 03 0 00 000006 setzb t3, q2 ;[223] Section local pointers 28344 002301'01 123 01 0 00 000000* extend t1, movchr ;[223] Repack the string in place (which is safe) 28345 002302'01 600 00 0 00 000000 nop ;[223] Ignore any odd non-skip 28346 002303'01 120 05 0 00 000007 dmove q1, q3 ;[223] Restore updated calling arguments 28347 28348 002304'01 200 01 0 00 002160* ntech2: move t1, ttyjfn ;[223] ; Load local terminal 28349 002305'01 120 02 0 00 000005 dmove t2,q1 ; Load pointer and length 28350 002306'01 104 00 0 00 000053 SOUT% ; Display incoming characters on screen. 28351 002307'01 320 12 0 00 002311' %jserr (,) 28352 002310'01 254 00 0 00 002314' 28353 002311'01 265 01 0 00 002236* 28354 002312'01 000000000000# 28355 002313'01 254 00 0 00 002314' 28356 001233'04 103 141 156 047 164 28357 002314'01 337 01 0 00 001536* skipg t1, sesjfn ; Logging? 28358 002315'01 254 00 0 00 002327' ifskp. ;[195] Possibly doing it 28359 002316'01 336 00 0 00 001565* skipn sesflg ;[195] Unless not active 28360 002317'01 254 00 0 00 002327' anskp. ;[195] In which case, skip it 28361 002320'01 120 02 0 00 000005 dmove t2,q1 ; Load buffer pointer and length 28362 002321'01 104 00 0 00 000053 SOUT% ; Write it to the log 28363 002322'01 320 12 0 00 002324' %jserr (,netlgx) ;[195] 28364 002323'01 254 00 0 00 002327' 28365 002324'01 265 01 0 00 002311* 28366 002325'01 000000000000# 28367 002326'01 254 00 0 00 000000* 28368 001242'04 103 141 156 047 164 28369 002327'01 endif. ;[195] End case logging 28370 002327'01 263 17 0 00 000000 ret ; Done 28371 k20net - Kermit-20 Network Support MACRO %53B(1254)-4 19:42 30-Mar-24 Page 32 K20NET MAC 13-Dec-23 21:12 Table to map DECnet close reason code to text 28372 subttl Table to map DECnet close reason code to text 28373 28374 ;[238] Begin table insertion 28375 28376 ; Handle all the .psect stuff by hand. Have to be careful because we 28377 ; are going to the outermost .psect, which will have the wrong location 28378 ; counter. Also, getting this wrong will cause LINK to fail with a 28379 ; most informative message of "Illegal memory WRITE at SY.FP5+1", which 28380 ; is almost--but not quite--completely and utterly useless. 28381 28382 .endps code ; Get out of code .psect 28383 28384 000053 .dcxmx==.dcx43 ; Maximum code 28385 28386 .psect const ; Put all the constants in the const .psect 28387 000130'03 dsctab: remark ; Just create a label in .psect 28388 .endps const ; End of const .psect 28389 28390 define dsctxt (n,t,%et) < ;;Macro to put pointers to messages in the right place 28391 .psect const ;;Assume in const .psect 28392 reloc dsctab+n ;;Get to correct location in table 28393 .px7!%et ;;Emit pointer to text in extended text section 28394 .endps const ;;Get out of const .psect 28395 .psect etext ;;Get into extended text .psect 28396 %et: asciz \'t\ ;;Emit the actual text of the disconnect reason 28397 .endps etext ;;Close out extended text .psect 28398 cleans(<%et>) ;;Clean up generated symbol on second pass 28399 >;;dsctxt 28400 28401 000130'03 000000000000# dsctxt(.dcx0,) 28402 001247'04 122 145 152 145 143 28403 000131'03 000000000000# dsctxt(.dcx1,) 28404 001256'04 122 145 163 157 165 28405 000132'03 000000000000# dsctxt(.dcx2,) 28406 001264'04 104 145 163 164 151 28407 000133'03 000000000000# dsctxt(.dcx3,) 28408 001273'04 122 145 155 157 164 28409 000134'03 000000000000# dsctxt(.dcx4,) 28410 001301'04 104 145 163 164 151 28411 000135'03 000000000000# dsctxt(.dcx5,) 28412 001310'04 111 156 166 141 154 28413 000136'03 000000000000# dsctxt(.dcx6,) 28414 001316'04 117 142 152 145 143 28415 000137'03 000000000000# dsctxt(.dcx7,) 28416 001321'04 125 156 163 160 145 28417 000140'03 000000000000# dsctxt(.dcx8,) 28418 001325'04 124 150 151 162 144 28419 000141'03 000000000000# dsctxt(.dcx9,) 28420 001331'04 101 163 171 156 143 28421 000142'03 000000000000# dsctxt(.dcx10,) 28422 001336'04 111 156 166 141 154 28423 000143'03 000000000000# dsctxt(.dcx11,) 28424 001342'04 114 157 143 141 154 28425 000155'03 000000000000# dsctxt(.dcx21,) 28426 001347'04 103 157 156 156 145 k20net - Kermit-20 Network Support MACRO %53B(1254)-4 19:42 30-Mar-24 Page 32-1 K20NET MAC 13-Dec-23 21:12 Table to map DECnet close reason code to text 28427 000156'03 000000000000# dsctxt(.dcx22,) 28428 001361'04 103 157 156 156 145 28429 000157'03 000000000000# dsctxt(.dcx23,) 28430 001373'04 103 157 156 156 145 28431 000160'03 000000000000# dsctxt(.dcx24,) 28432 001406'04 106 154 157 167 040 28433 000170'03 000000000000# dsctxt(.dcx32,) 28434 001413'04 124 157 157 040 155 28435 000171'03 000000000000# dsctxt(.dcx33,) 28436 001421'04 124 157 157 040 155 28437 000172'03 000000000000# dsctxt(.dcx34,) 28438 001432'04 101 143 143 145 163 28439 000173'03 000000000000# dsctxt(.dcx35,) 28440 001437'04 114 157 147 151 143 28441 000174'03 000000000000# dsctxt(.dcx36,) 28442 001446'04 111 156 166 141 154 28443 000175'03 000000000000# dsctxt(.dcx37,) 28444 001452'04 123 145 147 155 145 28445 000176'03 000000000000# dsctxt(.dcx38,) 28446 001457'04 116 157 040 162 145 28447 000177'03 000000000000# dsctxt(.dcx39,) 28448 001467'04 116 157 040 160 141 28449 000200'03 000000000000# dsctxt(.dcx40,) 28450 001475'04 114 151 156 153 040 28451 000201'03 000000000000# dsctxt(.dcx41,) 28452 001503'04 104 145 163 164 151 28453 000202'03 000000000000# dsctxt(.dcx42,) 28454 001512'04 103 157 156 146 151 28455 000203'03 000000000000# dsctxt(.dcx43,) 28456 001522'04 111 155 141 147 145 28457 28458 .psect const ; Put all the constants in the const .psect 28459 000204'03 reloc dsctab+.dcxmx+1 ; Back to end of dsctab 28460 .endps const ; End of const .psect 28461 28462 ;[238] End table insertion 28463 k20net - Kermit-20 Network Support MACRO %53B(1254)-4 19:42 30-Mar-24 Page 33 K20NET MAC 13-Dec-23 21:12 convert DECnet close reason code to text 28464 subttl convert DECnet close reason code to text 28465 28466 remark Given a disconnect code, return a pointer to descriptive text 28467 28468 ;[238] Begin code insertion 28469 28470 ; Call: 28471 ; 28472 ; T3/ Contains result of .MORLS 28473 ; 28474 ; Return: 28475 ; 28476 ; T1/ OWGP to informative text 28477 28478 .psect etext ; Get to extended text .psect 28479 001530'04 125 156 153 156 157 unkdec: asciz "Unknown disconnect code" 28480 .endps etext ; Close out extended text .psect 28481 28482 .psect code ;;Get back into the code .psect 28483 28484 002330'01 550 02 0 00 000003 gdscpt: hrrz t2, t3 ; Pick up disconnect code 28485 002331'01 303 02 0 00 000053 caile t2, .dcxmx ; Out of range? 28486 002332'01 254 00 0 00 002337' ifskp. ; No, it's fine 28487 002333'01 336 01 0 02 000000# skipn t1, dsctab(t2) ; Load OWGP to informative text 28488 002334'01 254 00 0 00 002337' anskp. ; Unless there isn't any 28489 002335'01 263 17 0 00 000000 ret ; Otherwise, return it 28490 002336'01 254 00 0 00 002341' else. ; Otherwise, out of range or no text 28491 002337'01 200 01 0 00 005513' move t1,[.px7!unkdec] ; Say as much 28492 002340'01 263 17 0 00 000000 ret ; Return at least something 28493 002341'01 endif. ; End case range and pointer check 28494 28495 28496 ;[238] End code insertion 28497 k20net - Kermit-20 Network Support MACRO %53B(1254)-4 19:42 30-Mar-24 Page 34 K20NET MAC 13-Dec-23 21:12 Parity Error Handler 28498 subttl Parity Error Handler 28499 28500 002341'01 007 000 00000000 honk: byte (7) .chbel, .chnul ;[223] Just honk the terminal 28501 28502 002342'01 261 17 0 00 000001 parier: push p, t1 ;[223] Save the accumulator 28503 002343'01 561 01 0 00 002341' hrroi t1, honk ;[223] Point to the alert 28504 002344'01 104 00 0 00 000313 ESOUT% ;[223] Beep the terminal 28505 002345'01 320 12 0 00 002346' erjmpr .+1 ;[223] Catch and ignore error 28506 002346'01 350 00 0 00 000000* aos ttipar ;[223] Count a parity error 28507 002347'01 262 17 0 00 000001 pop p, t1 ;[223] Restore the accumulator 28508 002350'01 263 17 0 00 000000 ret ;[223] Done 28509 k20net - Kermit-20 Network Support MACRO %53B(1254)-4 19:42 30-Mar-24 Page 35 K20NET MAC 13-Dec-23 21:12 Error handler for network TTY. 28510 subttl Error handler for network TTY. 28511 28512 002351'01 336 00 0 00 001741* neterr: ifmn. vtermf ;[186] Virtual terminal? 28513 002352'01 254 00 0 00 002357' 28514 002353'01 200 01 0 00 002156* move t1, netjfn ;[186] Load network JFN 28515 002354'01 260 17 0 00 003773' call chklin ;[186] Get network status 28516 002355'01 336 00 0 00 001657* skipn carier ;[186] dropped carrier? 28517 002356'01 260 17 0 00 003244' call netvtx ;[186] Yep, we're down 28518 002357'01 endif. ;[186] End special case for non-physical line 28519 28520 002357'01 336 00 0 00 000000* skipn mdmlin ; Modem controlled line? 28521 002360'01 254 00 0 00 002135' jrst netin ; No, go back. 28522 002361'01 260 17 0 00 003773' call chklin ; Go check for carrier. 28523 002362'01 336 00 0 00 002355* skipn carier ; Still have it? 28524 002363'01 254 00 0 00 000000* jrst $connx ;[186] No, close the connection. 28525 002364'01 254 00 0 00 002135' jrst netin ; Yes, keep plugging away till they disconnect. 28526 k20net - Kermit-20 Network Support MACRO %53B(1254)-4 19:42 30-Mar-24 Page 36 K20NET MAC 13-Dec-23 21:12 Handles signal of failure of network input fork 28527 subttl Handles signal of failure of network input fork 28528 28529 002365'01 frtrap: entry frtrap 28530 extern pc3 ; Level we interrupt on 28531 28532 002365'01 261 17 0 00 000001 push p, t1 ; Save any AC we touch 28533 002366'01 261 17 0 00 000002 push p, t2 28534 002367'01 261 17 0 00 000003 push p, t3 28535 28536 002370'01 336 01 0 00 001337* skipn t1,ttfork ; Load the handle of network input fork 28537 002371'01 254 00 0 00 002375' ifskp. ; If there is one.... 28538 002372'01 104 00 0 00 000153 KFORK% ; Ditch it 28539 002373'01 320 12 0 00 002374' erjmpr .+1 ; Ignore the error 28540 002374'01 402 00 0 00 002370* setzm ttfork ; Forget about the handle; it's gone 28541 002375'01 endif. ; End case fork handler 28542 28543 002375'01 260 17 0 00 003047' call clsnet ; Whack any kind of network connection 28544 28545 002376'01 205 01 0 00 010000 movx t1,pc%usr ; Get into user mode. 28546 002377'01 436 01 0 00 000541* iorm t1,pc3 ; Resume at previous PC 28547 28548 002400'01 262 17 0 00 000003 pop p, t3 ; Restore AC's and beat it 28549 002401'01 262 17 0 00 000002 pop p, t2 28550 002402'01 262 17 0 00 000001 pop p, t1 28551 002403'01 104 00 0 00 000136 DEBRK% 28552 k20net - Kermit-20 Network Support MACRO %53B(1254)-4 19:42 30-Mar-24 Page 37 K20NET MAC 13-Dec-23 21:12 Sends a DECnet interrupt message when BREAK is requested 28553 subttl Sends a DECnet interrupt message when BREAK is requested 28554 28555 002404'01 110 145 171 041 040 nrtmsg: bldmsg () 28556 28557 002407'01 nrtbrk: entry nrtbrk ; Experimental; not really used 28558 002407'01 263 17 0 00 000000 ret ; This hangs a Tops-10 connection, don't do it 28559 28560 002410'01 265 16 0 00 005344' saveac ; Save just because we don't know 28561 002411'01 200 01 0 00 002353* move t1,netjfn ; Load network JFN 28562 002412'01 201 02 0 00 000036 movei t2,.mosim ; Function to send DECnet interrupt message 28563 dmove t3,[point 7,nrtmsg ;Point to interrupt message 28564 002413'01 120 03 0 00 005514' nrtlen ] ; Length of same 28565 002414'01 104 00 0 00 000077 MTOPR% ; Bombs away! 28566 002415'01 320 12 0 00 002417' %jserr(,r) 28567 002416'01 254 00 0 00 002422' 28568 002417'01 265 01 0 00 002324* 28569 002420'01 000000000000# 28570 002421'01 254 00 0 00 002251* 28571 001535'04 125 156 141 142 154 28572 002422'01 263 17 0 00 000000 ret 28573 k20net - Kermit-20 Network Support MACRO %53B(1254)-4 19:42 30-Mar-24 Page 38 K20NET MAC 13-Dec-23 21:12 clrbuf Clear Line Input Buffer 28574 subttl clrbuf Clear Line Input Buffer 28575 28576 ;[211] All rewritten and enhanced for non-physical terminals 28577 28578 ; Call: 28579 ; 28580 ; Nothing: appropriate thing is done based on connection context. 28581 ; 28582 ; Returns: 28583 ; 28584 ; +1/ Some problem 28585 ; +2/ Success 28586 ; t1/ Total characters chewed 28587 ; 28588 ; N.B., While SIBE% and SOBE% will work on any JFN, CFIBF% and 28589 ; CFOBF%'s will *ONLY* work with terminal lines. For PTY's 28590 ; and NRT's, we have to read the input (and toss it). 28591 28592 000310 flushc==^d200 ; Maximum characters to swallow 28593 28594 002423'01 clrbuf: entry clrbuf ; Inform link of our location 28595 002423'01 260 17 0 00 000000* call inpclr ;[209] Chuck any waiting input 28596 28597 002424'01 332 00 0 00 000000# skipe ptyflg ; Pseudo-terminal? 28598 002425'01 254 00 0 00 002527' callret ptyfls ; Yes, that has to be flushed from both sides 28599 002426'01 332 00 0 00 000000# skipe nrtflg ; DECnet NRT? 28600 002427'01 254 00 0 00 002457' callret dcnfls ; Yes, CFIBF% won't work 28601 ; Otherwise, a physical line on an FE!!!! 28602 002430'01 550 01 0 00 002411* hrrz t1, netjfn ; Although a real line, prefer network JFN 28603 002431'01 326 01 0 00 002433' ife. t1 ; Unless there isn't one 28604 002432'01 550 01 0 00 002304* hrrz t1, ttyjfn ; Use terminal if nothing else 28605 002433'01 endif. ; End case no network JFN 28606 002433'01 403 02 0 00 000003 setzb t2, t3 ; No current read, no accumulated read 28607 28608 002434'01 do. ; Enter loop context 28609 002434'01 104 00 0 00 000102 SIBE% ; Skip if input buffer empty 28610 002435'01 254 00 0 00 002445' ifskp. ; Empty? 28611 002436'01 322 02 0 00 002455' jumpe t2, endlp. ; If zero, then no error; exit loop 28612 002437'01 334 00 0 00 000000 %ermsg (,r) ;[211] 28613 002440'01 254 00 0 00 002444' 28614 002441'01 265 01 0 00 002417* 28615 002442'01 000000000000# 28616 002443'01 254 00 0 00 002421* 28617 001544'04 125 156 141 142 154 28618 002444'01 254 00 0 00 002455' else. ; Otherwise, have some junk in there 28619 002445'01 270 03 0 00 000002 add t3, t2 ; Add to total cleared 28620 002446'01 104 00 0 00 000100 CFIBF% ; Chuck the input 28621 002447'01 320 12 0 00 002451' %jserr (,r) ; Boo... 28622 002450'01 254 00 0 00 002454' 28623 002451'01 265 01 0 00 002441* 28624 002452'01 000000000000# 28625 002453'01 254 00 0 00 002443* 28626 001553'04 125 156 141 142 154 28627 002454'01 254 00 0 00 002434' loop. ; See if anything else shows up 28628 002455'01 endif. ; End of SIBE% action logic k20net - Kermit-20 Network Support MACRO %53B(1254)-4 19:42 30-Mar-24 Page 38-1 K20NET MAC 13-Dec-23 21:12 clrbuf Clear Line Input Buffer 28629 002455'01 enddo. ; End flush loop 28630 28631 002455'01 200 01 0 00 000003 move t1, t3 ; Load grand total flushed 28632 002456'01 254 00 0 00 001777* retskp ; Return success!!! 28633 k20net - Kermit-20 Network Support MACRO %53B(1254)-4 19:42 30-Mar-24 Page 39 K20NET MAC 13-Dec-23 21:12 DECnet flush 28634 subttl DECnet flush 28635 28636 ; Somewhat similar logic to physical terminal, except that 28637 ; CFIBF% won't work, so we have to read (and toss) the data. 28638 ; 28639 ; N.B., Can't use SINR% because it will discard an unknown number 28640 ; of characters. Sigh... 28641 28642 002457'01 265 16 0 00 005516' dcnfls: saveac 28643 002460'01 550 01 0 00 002430* hrrz t1, netjfn ; Pick up the network JFN 28644 002461'01 326 01 0 00 002467' ife. t1 ; Have to have this for an NRT! 28645 002462'01 334 01 0 00 000000# ermsg% (,r) 28646 002463'01 254 00 0 00 002467' 28647 002464'01 202 01 0 00 001426* 28648 002465'01 104 00 0 00 000313 28649 002466'01 254 00 0 00 002453* 28650 000204'03 000000000000# 28651 001561'04 113 105 122 115 111 28652 28653 002467'01 endif. ; End of that particular sanity check 28654 002467'01 200 05 0 00 000001 move q1, t1 ; Save whatever JFN we're using (q1 unused) 28655 002470'01 400 07 0 00 000000 setz q3, ; No initial grand tally 28656 28657 002471'01 do. ; Enter loop context 28658 002471'01 104 00 0 00 000102 SIBE% ; Skip if input buffer empty 28659 002472'01 254 00 0 00 002502' ifskp. ; Empty? 28660 002473'01 322 02 0 00 002524' jumpe t2, endlp. ; If zero, then no error; exit loop 28661 002474'01 334 00 0 00 000000 %ermsg (,r) 28662 002475'01 254 00 0 00 002501' 28663 002476'01 265 01 0 00 002451* 28664 002477'01 000000000000# 28665 002500'01 254 00 0 00 002466* 28666 001575'04 125 156 141 142 154 28667 002501'01 254 00 0 00 002523' else. ; Otherwise, have some junk in there 28668 002502'01 200 06 0 00 000002 move q2, t2 ; Load for inner loop 28669 002503'01 do. ; Enter inner loop context 28670 002503'01 336 04 0 00 000006 skipn t4, q2 ; Load remaining characters 28671 002504'01 254 00 0 00 002523' exit. ; If no more, then we're done 28672 002505'01 303 04 0 00 000310 caile t4, flushc ; More than maximum we can swallow at once? 28673 002506'01 201 04 0 00 000310 movx t4, flushc ; Yep, well just take a mouthful 28674 remark t1, q1 ; JFN is still in there 28675 002507'01 200 02 0 00 005532' move t2, [point 8,flushb] ; Load pointer to the 'flush' buffer 28676 002510'01 210 03 0 00 000004 movn t3, t4 ; Reading exactly that much 28677 002511'01 104 00 0 00 000052 SIN% ; Swallow whatever junk is in there 28678 002512'01 320 12 0 00 002514' %jserr (,r) 28679 002513'01 254 00 0 00 002517' 28680 002514'01 265 01 0 00 002476* 28681 002515'01 000000000000# 28682 002516'01 254 00 0 00 002500* 28683 001606'04 125 156 141 142 154 28684 002517'01 270 04 0 00 000003 add t4, t3 ; Keep track of what we didn't read 28685 002520'01 274 06 0 00 000004 sub q2, t4 ; Subtract from remaining 28686 002521'01 270 07 0 00 000004 add q3, t4 ; And add to total done 28687 002522'01 327 06 0 00 002503' jumpg q2, top. ; Loop if anything left to do 28688 002523'01 enddo. ; End context inner loop k20net - Kermit-20 Network Support MACRO %53B(1254)-4 19:42 30-Mar-24 Page 39-1 K20NET MAC 13-Dec-23 21:12 DECnet flush 28689 002523'01 endif. ; End SIBE% results handling 28690 002523'01 254 00 0 00 002471' loop. ; See if anything else there 28691 002524'01 enddo. ; End loop lexical context 28692 28693 002524'01 272 07 0 00 000000# addm q3, vchrcn ; Update grand total characters ever flushed 28694 002525'01 200 01 0 00 000007 move t1, q3 ; Return total characters whacked this time 28695 002526'01 254 00 0 00 002456* retskp ; Return success 28696 k20net - Kermit-20 Network Support MACRO %53B(1254)-4 19:42 30-Mar-24 Page 40 K20NET MAC 13-Dec-23 21:12 DECnet flush 28697 remark Special actions to flush a PTY 28698 28699 ; Note that while a CFIBF% will not work on the PTY JFN, a CFOBF% 28700 ; *WILL* work on the terminal side for which we have the device 28701 ; designator. Since we assigned the PTY which maps to the TTY, we 28702 ; retain certain rights to the terminal, one of which is that a CFOBF% 28703 ; will work and we don't have to read anything. 28704 ; 28705 ; None the less, we check to see if anything made it over to the PTY 28706 ; buffer so we can toss that. 28707 ; 28708 ; Does not return until *both* the SOBE% and SIBE% produce zero. 28709 28710 002527'01 ptyfls: remark ; Has to work both sides of the device 28711 002527'01 265 16 0 00 005533' saveac 28712 28713 002530'01 514 05 0 00 002460* hrlz q1, netjfn ; Pick up the network JFN 28714 002531'01 326 05 0 00 002537' ife. q1 ; Have to have this for a PTY!! 28715 002532'01 334 01 0 00 000000# ermsg% (,r) 28716 002533'01 254 00 0 00 002537' 28717 002534'01 202 01 0 00 002464* 28718 002535'01 104 00 0 00 000313 28719 002536'01 254 00 0 00 002516* 28720 000205'03 000000000000# 28721 001616'04 113 105 122 115 111 28722 28723 002537'01 endif. ; End of that particular sanity check 28724 002537'01 540 05 0 00 000000# hrr q1, ptytty ; Load this PTY's associated terminal line 28725 002540'01 660 05 0 00 400000 txo q1, .ttdes ; Force alternate form of terminal designator 28726 002541'01 403 06 0 00 000007 setzb q2, q3 ; Zero working read and grand total 28727 28728 002542'01 do. ; Enter loop context 28729 002542'01 550 01 0 00 000005 hrrz t1, q1 ; Load terminal designator 28730 002543'01 104 00 0 00 000103 SOBE% ; Skip if output buffer empty 28731 002544'01 254 00 0 00 002555' ifskp. ; Empty? 28732 002545'01 322 02 0 00 002553' ifn. t2 ; If zero, then no error and nothing to do 28733 002546'01 334 00 0 00 000000 %ermsg (,r) 28734 002547'01 254 00 0 00 002553' 28735 002550'01 265 01 0 00 002514* 28736 002551'01 000000000000# 28737 002552'01 254 00 0 00 002536* 28738 001632'04 125 156 141 142 154 28739 002553'01 endif. ; End case t2 having JSYS error code 28740 002553'01 400 10 0 00 000000 setz q4, ; Whack this round's output 28741 002554'01 254 00 0 00 002565' else. ; Otherwise, have some junk in there 28742 002555'01 270 07 0 00 000002 add q3, t2 ; Accumulate in grand tally 28743 002556'01 200 10 0 00 000002 move q4, t2 ; Flag non-zero buffer, this round 28744 002557'01 104 00 0 00 000101 CFOBF% ; Clear out any blocked up crud 28745 002560'01 320 12 0 00 002562' %jserr (,r) 28746 002561'01 254 00 0 00 002565' 28747 002562'01 265 01 0 00 002550* 28748 002563'01 000000000000# 28749 002564'01 254 00 0 00 002552* 28750 001643'04 103 157 165 154 144 28751 002565'01 endif. ; End SOBE% results handling k20net - Kermit-20 Network Support MACRO %53B(1254)-4 19:42 30-Mar-24 Page 40-1 K20NET MAC 13-Dec-23 21:12 DECnet flush 28752 002565'01 554 01 0 00 000005 hlrz t1, q1 ; Load the PTY side 28753 002566'01 104 00 0 00 000102 SIBE% ; Skip if input buffer empty 28754 002567'01 254 00 0 00 002577' ifskp. ; Empty? 28755 002570'01 322 02 0 00 002576' ifn. t2 ; If zero, then no error; carry on 28756 002571'01 334 00 0 00 000000 %ermsg (,r) 28757 002572'01 254 00 0 00 002576' 28758 002573'01 265 01 0 00 002562* 28759 002574'01 000000000000# 28760 002575'01 254 00 0 00 002564* 28761 001653'04 125 156 141 142 154 28762 002576'01 endif. ; End case empty input buffer 28763 002576'01 254 00 0 00 002621' else. ; Otherwise, have some junk in there 28764 002577'01 270 10 0 00 000002 add q4, t2 ; Add to this round's tally 28765 002600'01 200 06 0 00 000002 move q2, t2 ; Load for inner loop 28766 002601'01 do. ; Enter inner loop context 28767 002601'01 337 04 0 00 000006 skipg t4, q2 ; Load remaining characters 28768 002602'01 254 00 0 00 002621' exit. ; If no more, then we're done 28769 002603'01 303 04 0 00 000310 caile t4, flushc ; More than maximum we can swallow at once? 28770 002604'01 201 04 0 00 000310 movx t4, flushc ; Yep, well just take a mouthful 28771 remark t1, q1 ; JFN is still in there 28772 002605'01 200 02 0 00 005551' move t2, [point 8,flushb] ; Load pointer to 'flush' buffer 28773 002606'01 210 03 0 00 000004 movn t3, t4 ; Reading exactly that much 28774 002607'01 104 00 0 00 000052 SIN% ; Swallow whatever junk is in there 28775 002610'01 320 12 0 00 002612' %jsErr (,r) ;[211] 28776 002611'01 254 00 0 00 002615' 28777 002612'01 265 01 0 00 002573* 28778 002613'01 000000000000# 28779 002614'01 254 00 0 00 002575* 28780 001662'04 125 156 141 142 154 28781 002615'01 270 04 0 00 000003 add t4, t3 ; Keep track of what we didn't read 28782 002616'01 270 07 0 00 000004 add q3, t4 ; And add to total done 28783 002617'01 274 06 0 00 000004 sub q2, t4 ; Subtract from remaining 28784 002620'01 327 06 0 00 002601' jumpg q2, top. ; Loop if anything left 28785 002621'01 enddo. ; End context inner loop 28786 002621'01 endif. ; End SIBE% results handling 28787 002621'01 327 10 0 00 002542' jumpg q4, top. ; If got anything, take another look 28788 002622'01 enddo. ; End of loop lexical context 28789 28790 002622'01 272 07 0 00 000000# addm q3, vchrcn ; Update grand total characters ever flushed 28791 002623'01 200 01 0 00 000007 move t1, q3 ; Return total characters whacked this time 28792 002624'01 254 00 0 00 002526* retskp ; Return success 28793 k20net - Kermit-20 Network Support MACRO %53B(1254)-4 19:42 30-Mar-24 Page 41 K20NET MAC 13-Dec-23 21:12 clrest Give an estimate of characters in input buffer 28794 subttl clrest Give an estimate of characters in input buffer 28795 28796 ; Call: 28797 ; 28798 ; Nothing: appropriate thing is done based on connection context. 28799 ; 28800 ; Returns: 28801 ; 28802 ; +1/ Some problem 28803 ; +2/ Success 28804 ; t1/ Total characters in various buffers 28805 ; 28806 ; N.B., A pseudo terminal can have characters on 'both sides', that 28807 ; is, the character's in the PTY's input buffer *AND* the 28808 ; characters in the associated TTY's output buffer that have not be 28809 ; transferred into the PTY's input buffer, yet. 28810 ; 28811 ; Thus, the use of SOBE% for pseudo-terminals in addition to the 28812 ; expected SIBE%. 28813 28814 002625'01 clrest: entry clrest ; World callable 28815 002625'01 265 16 0 00 005552' saveac ; Needs a few accumulators 28816 002626'01 550 04 0 00 002530* hrrz t4, netjfn ; Always prefer a network JFN 28817 002627'01 326 04 0 00 002631' ife. t4 ; Unless there isn't one 28818 002630'01 550 04 0 00 002432* hrrz t4, ttyjfn ; Use terminal if nothing else 28819 002631'01 endif. ; End case no network JFN 28820 002631'01 403 02 0 00 000003 setzb t2, t3 ; Clear all totals 28821 28822 002632'01 336 00 0 00 000000# ifmn. ptyflg ; If pseudo-terminal, look at both sides 28823 002633'01 254 00 0 00 002651' 28824 002634'01 550 01 0 00 000000# hrrz t1, ptytty ; Load this PTY's associated terminal line 28825 002635'01 660 01 0 00 400000 txo t1, .ttdes ; Force alternate form of terminal designator 28826 002636'01 104 00 0 00 000103 SOBE% ; Skip if output buffer empty 28827 002637'01 254 00 0 00 002647' ifskp. ; Empty? 28828 002640'01 322 02 0 00 002646' ifn. t2 ; If zero, then no error and nothing to do 28829 002641'01 334 00 0 00 000000 %ermsg (,r) 28830 002642'01 254 00 0 00 002646' 28831 002643'01 265 01 0 00 002612* 28832 002644'01 000000000000# 28833 002645'01 254 00 0 00 002614* 28834 001672'04 125 156 141 142 154 28835 002646'01 endif. ; End case t2 having JSYS error code 28836 002646'01 254 00 0 00 002651' else. ; Otherwise, have some junk in there 28837 002647'01 200 03 0 00 000002 move t3, t2 ; Keep track of TTY's output side 28838 002650'01 400 02 0 00 000000 setz t2, ; Keep nice and tidy for SIBE% 28839 002651'01 endif. ; End SOBE% results handling 28840 002651'01 endif. ; End PTY special case 28841 28842 002651'01 200 01 0 00 000004 move t1, t4 ; Load whatever JFN we decided to use 28843 002652'01 104 00 0 00 000102 SIBE% ; Skip if input buffer empty 28844 002653'01 254 00 0 00 002663' ifskp. ; Empty? 28845 002654'01 322 02 0 00 002662' ifn. t2 ; If zero, then no error and nothing to do 28846 002655'01 334 00 0 00 000000 %ermsg (,r) 28847 002656'01 254 00 0 00 002662' 28848 002657'01 265 01 0 00 002643* k20net - Kermit-20 Network Support MACRO %53B(1254)-4 19:42 30-Mar-24 Page 41-1 K20NET MAC 13-Dec-23 21:12 clrest Give an estimate of characters in input buffer 28849 002660'01 000000000000# 28850 002661'01 254 00 0 00 002645* 28851 001703'04 125 156 141 142 154 28852 002662'01 endif. ; End case t2 having JSYS error code 28853 002662'01 254 00 0 00 002664' else. ; Otherwise, have some junk in there 28854 002663'01 270 03 0 00 000002 add t3, t2 ; Add to any running tally 28855 002664'01 endif. ; End SIBE% results handling 28856 28857 002664'01 200 01 0 00 000003 move t1, t3 ; Return grand total seen 28858 002665'01 254 00 0 00 002624* retskp ; Return success 28859 k20net - Kermit-20 Network Support MACRO %53B(1254)-4 19:42 30-Mar-24 Page 42 K20NET MAC 13-Dec-23 21:12 clread Return buffer of what we cleared 28860 subttl clread Return buffer of what we cleared 28861 28862 ; Call: 28863 ; 28864 ; Nothing: appropriate thing is done based on connection context. 28865 ; 28866 ; Returns: 28867 ; 28868 ; +1/ Some problem 28869 ; +2/ Success 28870 ; t1/ Total characters read 28871 ; t2/ (Eight bit) pointer to buffer 28872 ; 28873 ; N.B., be aware of the following: 28874 ; 28875 ; 1) clread should be repeatedly called until it returns zero as 28876 ; there may be more data than we can read. 28877 ; 28878 ; 2) Can't use SINR% because it will discard an unknown number of 28879 ; characters. Sigh... 28880 28881 002666'01 clread: entry clread ; Called from K20PAR 28882 002666'01 265 16 0 00 005564' saveac 28883 remark call ;[209] Display something 28884 002667'01 260 17 0 00 002423* call inpclr ;[209] Chuck any waiting input 28885 28886 002670'01 514 05 0 00 002626* hrlz q1, netjfn ; Prefer the network JFN 28887 002671'01 326 05 0 00 002673' ife. q1 ; But!! Do we have one? 28888 002672'01 514 05 0 00 002630* hrlz q1, ttyjfn ; Use terminal if nothing else 28889 002673'01 endif. ; End case no network JFN 28890 28891 002673'01 336 00 0 00 000000# ifmn. ptyflg ; Pseudo-terminal? 28892 002674'01 254 00 0 00 002677' 28893 002675'01 540 05 0 00 000000# hrr q1, ptytty ; Load this PTY's associated terminal line 28894 002676'01 660 05 0 00 400000 txo q1, .ttdes ; Force alternate form of terminal designator 28895 002677'01 endif. ; End case pseudo-terminal 28896 28897 dmove q4, [ flushc ; Load total remaining in buffer 28898 002677'01 120 10 0 00 005602' point 8, flushb ] ; Load pointer to 'flush' buffer 28899 28900 002700'01 do. ; Enter loop context 28901 002700'01 322 10 0 00 002757' jumpe q4, endlp. ; If buffer full, then return 28902 002701'01 550 01 0 00 000005 hrrz t1, q1 ; Load terminal designator 28903 002702'01 322 01 0 00 002717' ifn. t1 ; But did we ever have one? 28904 002703'01 104 00 0 00 000103 SOBE% ; Skip if output buffer empty 28905 002704'01 254 00 0 00 002715' ifskp. ; Empty? 28906 002705'01 322 02 0 00 002713' ifn. t2 ; If zero, then no error and nothing to do 28907 002706'01 334 00 0 00 000000 %ermsg (,r) 28908 002707'01 254 00 0 00 002713' 28909 002710'01 265 01 0 00 002657* 28910 002711'01 000000000000# 28911 002712'01 254 00 0 00 002661* 28912 001712'04 125 156 141 142 154 28913 002713'01 endif. ; End case t2 having JSYS error code 28914 002713'01 400 04 0 00 000000 setz t4, ; Whack this round's PTY portion k20net - Kermit-20 Network Support MACRO %53B(1254)-4 19:42 30-Mar-24 Page 42-1 K20NET MAC 13-Dec-23 21:12 clread Return buffer of what we cleared 28915 002714'01 254 00 0 00 002716' else. ; Otherwise, have some junk in there 28916 002715'01 200 04 0 00 000002 move t4, t2 ; Flag non-zero buffer, this round 28917 002716'01 endif. ; End SOBE% results handling 28918 002716'01 254 00 0 00 002720' else. ; Otherwise no PTY 28919 002717'01 400 04 0 00 000000 setz t4, ; So no PTY contribution 28920 002720'01 endif. ; End special case for pseudo-termina 28921 002720'01 554 01 0 00 000005 hlrz t1, q1 ; Now load whatever JFN we have 28922 002721'01 104 00 0 00 000102 SIBE% ; Skip if input buffer empty 28923 002722'01 254 00 0 00 002732' ifskp. ; Empty? 28924 002723'01 322 02 0 00 002731' ifn. t2 ; If zero, then no error; carry on 28925 002724'01 334 00 0 00 000000 %ermsg (,r) 28926 002725'01 254 00 0 00 002731' 28927 002726'01 265 01 0 00 002710* 28928 002727'01 000000000000# 28929 002730'01 254 00 0 00 002712* 28930 001723'04 125 156 141 142 154 28931 002731'01 endif. ; End case empty input buffer 28932 002731'01 254 00 0 00 002733' else. ; Otherwise, have some junk in there 28933 002732'01 270 04 0 00 000002 add t4, t2 ; Add to this round's tally 28934 002733'01 endif. ; End SOBE% results handling 28935 002733'01 322 04 0 00 002757' jumpe t4, endlp. ; If nothing there, we're done 28936 002734'01 313 04 0 00 000010 camle t4, q4 ; More than what we have left? 28937 002735'01 200 04 0 00 000010 move t4, q4 ; Yep, don't overflow the buffer 28938 002736'01 200 06 0 00 000004 move q2, t4 ; Position for inner loop 28939 002737'01 400 07 0 00 000000 setz q3, ; Zero inner loop tally 28940 002740'01 do. ; Enter inner loop context 28941 remark t1, q1 ; JFN is still in there from SIBE% 28942 002740'01 200 02 0 00 000011 move t2, q5 ; Load updated pointer 28943 002741'01 210 03 0 00 000004 movn t3, t4 ; Reading exactly that much 28944 002742'01 104 00 0 00 000052 SIN% ; Swallow whatever junk is in there 28945 002743'01 320 12 0 00 002745' %jsErr (,r) 28946 002744'01 254 00 0 00 002750' 28947 002745'01 265 01 0 00 002726* 28948 002746'01 000000000000# 28949 002747'01 254 00 0 00 002730* 28950 001732'04 125 156 141 142 154 28951 002750'01 270 04 0 00 000003 add t4, t3 ; Keep track of what we did NOT read 28952 002751'01 270 07 0 00 000004 add q3, t4 ; And add to loop total done 28953 002752'01 274 06 0 00 000004 sub q2, t4 ; Subtract from remaining 28954 002753'01 327 06 0 00 002740' jumpg q2, top. ; Loop if anything left 28955 002754'01 enddo. ; End context inner loop 28956 002754'01 274 10 0 00 000007 sub q4, q3 ; Subtract from total buffer size 28957 002755'01 200 11 0 00 000002 move q5, t2 ; Store updated pointer for next round 28958 002756'01 327 10 0 00 002700' jumpg q4, top. ; If got anything, take another look 28959 002757'01 enddo. ; End of loop lexical context 28960 28961 002757'01 201 01 0 00 000310 movx t1, flushc ; Load largest possible buffer 28962 002760'01 274 01 0 00 000010 sub t1, q4 ; Subtract total remaining 28963 002761'01 272 01 0 00 000000# addm t1, vchrcn ; Update grand total characters ever flushed 28964 002762'01 200 02 0 00 005604' move t2, [point 8,flushb] ; Return pointer to 'flush' buffer 28965 002763'01 254 00 0 00 002665* retskp ; Finally return success 28966 k20net - Kermit-20 Network Support MACRO %53B(1254)-4 19:42 30-Mar-24 Page 43 K20NET MAC 13-Dec-23 21:12 Routine to unstop an XOFF'd line, added as edit 91. 28967 subttl Routine to unstop an XOFF'd line, added as edit 91. 28968 28969 002764'01 ttxon: entry ttxon ;[211] Partly rewritten for PTY's and NRT's 28970 002764'01 265 16 0 00 005605' saveac ;[211] Needs an extra register 28971 28972 002765'01 260 17 0 00 002423' call clrbuf ;[211] Call our new friend to toss data 28973 002766'01 263 17 0 00 000000 ret ;[211] But couldn't; give up 28974 28975 002767'01 332 01 0 00 002670* skipe t1, netjfn ;[186] Load the network JFN 28976 002770'01 254 00 0 00 003005' ifskp. ;[186] Unless we don't have one... 28977 002771'01 332 00 0 00 001300* skipe local ;[186] Are we remote? 28978 002772'01 334 01 0 00 000000# ermsg% (,r) ;[186] Punt 28979 002773'01 254 00 0 00 002777' 28980 002774'01 202 01 0 00 002534* 28981 002775'01 104 00 0 00 000313 28982 002776'01 254 00 0 00 002747* 28983 000206'03 000000000000# 28984 001740'04 113 105 122 115 111 28985 28986 002777'01 336 01 0 00 002672* skipn t1, ttyjfn ;[186] Yes, so just use the terminal JFN 28987 003000'01 334 01 0 00 000000# ermsg% (,r) ;[186] 28988 003001'01 254 00 0 00 003005' 28989 003002'01 202 01 0 00 002774* 28990 003003'01 104 00 0 00 000313 28991 003004'01 254 00 0 00 002776* 28992 000207'03 000000000000# 28993 001754'04 113 105 122 115 111 28994 28995 003005'01 endif. ;[186] Hopefully have SOMETHING ... 28996 003005'01 514 05 0 00 000001 hrlz q1, t1 ;[211] Save the JFN (sans flags) for later 28997 28998 003006'01 336 00 0 00 000000# ifmn. ptyflg ;[211] A pseudo-terminal? 28999 003007'01 254 00 0 00 003012' 29000 003010'01 550 01 0 00 000000# hrrz t1, ptytty ;[211] Yes, don't do this to the PTY half 29001 003011'01 660 01 0 00 400000 txo t1, .ttdes ;[211] Do it to the TTY half 29002 003012'01 endif. ;[211] End PTY-FE/NRT decision 29003 003012'01 540 05 0 00 000001 hrr q1, t1 ;[211] Save some terminal descriptor 29004 29005 ;[157] If we're doing flow control, send a ^Q (XON) to unstick the other side. 29006 29007 003013'01 336 00 0 00 001631* skipn flow ; Doing flow control? 29008 003014'01 263 17 0 00 000000 ret ; No, done. 29009 29010 003015'01 332 00 0 00 000000# skipe nrtflg ;[211] An NRT? 29011 003016'01 254 00 0 00 003037' callret ttxon3 ;[211] Skip this terminal stuff 29012 ;[211] Will never work with a DCN: JFN 29013 003017'01 550 01 0 00 000005 ttxon2: hrrz t1, q1 ;[211] Get some terminal descriptor 29014 003020'01 104 00 0 00 000107 RFMOD ; Yes, get terminal mode. 29015 003021'01 320 16 0 00 003004* erjmp r 29016 003022'01 200 03 0 00 000002 move t3, t2 ; Save it. 29017 003023'01 622 02 0 00 000300 txze t2, tt%dam ; Data mode? 29018 003024'01 254 00 0 00 003027' ifskp. ;[211] No, so no need to change 29019 003025'01 260 17 0 00 003037' call ttxon3 ; No, binary, just send it. 29020 003026'01 254 00 0 00 003036' else. ;[211] Otherwise, tweak the mode 29021 003027'01 104 00 0 00 000110 SFMOD ; Put in binary mode. k20net - Kermit-20 Network Support MACRO %53B(1254)-4 19:42 30-Mar-24 Page 43-1 K20NET MAC 13-Dec-23 21:12 Routine to unstop an XOFF'd line, added as edit 91. 29022 003030'01 320 12 0 00 003021* erjmpr r ;[211] 29023 003031'01 260 17 0 00 003037' call ttxon3 ; Send the XON. 29024 003032'01 550 01 0 00 000005 hrrz t1, q1 ;[211] Reload the terminal descriptor 29025 003033'01 200 02 0 00 000003 move t2, t3 ; Load original settings 29026 003034'01 104 00 0 00 000110 SFMOD ; Put back in data mode. 29027 003035'01 320 12 0 00 003030* erjmpr r ;[211] 29028 003036'01 endif. ;[211] End terminal mode tweaking 29029 003036'01 263 17 0 00 000000 ret 29030 29031 003037'01 554 01 0 00 000005 ttxon3: hlrz t1, q1 ;[211] Use the real JFN 29032 003040'01 201 02 0 00 000021 movei t2, xon ; Send an XON. 29033 003041'01 104 00 0 00 000051 BOUT 29034 003042'01 320 16 0 00 003035* erjmp r 29035 003043'01 263 17 0 00 000000 ret 29036 29037 ;[211] End clrbuf rewrite for non-physical terminals 29038 k20net - Kermit-20 Network Support MACRO %53B(1254)-4 19:42 30-Mar-24 Page 44 K20NET MAC 13-Dec-23 21:12 clsnet -- Close any kind of 'network' connection 29039 subttl clsnet -- Close any kind of 'network' connection 29040 29041 remark ; Has to be before first reference!! 29042 syn clscom,clsfe ; Close the terminal 29043 syn clscom,clspty ; Close the pseudo-terminal 29044 29045 ; Ignores local setting, uses netjfn, regardless. Checks the JFN, 29046 ; regardless of it possibly being absurd. 29047 29048 003044'01 clsjfn: entry clsjfn ; Invoked by Kermit exit 29049 003044'01 265 16 0 00 005621' saveac ;Don't touch anything 29050 003045'01 200 01 0 00 002767* move t1, netjfn ; Use whatever is there, no matter what 29051 003046'01 254 00 0 00 003054' jrst chkcls ; Just get started with the JFN 29052 29053 ; Expects nothing; checks local to see if we would even have the JFN 29054 ; and sanity checks the JFN 29055 29056 003047'01 clsnet: entry clsnet ; Callable by anybody 29057 extern local ; Set if we are not using .priou for transfers 29058 29059 003047'01 336 00 0 00 002771* skipn local ; Are we not using our own terminal for packets? 29060 003050'01 263 17 0 00 000000 ret ; We are, so there is nothing to clean up 29061 003051'01 265 16 0 00 005621' saveac ;Don't touch anything 29062 003052'01 337 01 0 00 003045* skipg t1, netjfn ; If we are local, then we will have a JFN 29063 003053'01 254 00 0 00 003160' jrst clsasg ; Unless we are in some odd state 29064 remark chkcls ; falls through 29065 29066 003054'01 chkcls: remark ; Here to check if we can close it 29067 003054'01 104 00 0 00 000024 GTSTS% ; Now let's find out about the JFN 29068 003055'01 320 12 0 00 003057' ifje. r ; Catch and ignore the error 29069 003056'01 254 00 0 00 003063' 29070 003057'01 200 04 0 00 000001 move t4, t1 ; Save any error code for later 29071 003060'01 400 05 0 00 000000 setz q1, ; Whack the bits, assume nothing 29072 003061'01 550 01 0 00 003052* hrrz t1, netjfn ; Reload the JFN 29073 003062'01 254 00 0 00 003064' else. ; Otherwise, worked 29074 003063'01 200 05 0 00 000002 move q1, t2 ; Save the status bits 29075 003064'01 endif. 29076 003064'01 607 05 0 00 000200 jxe q1, gs%nam, clscln ; Nothing there? Just scrub the storage 29077 003065'01 254 00 0 00 003224' 29078 29079 003066'01 104 00 0 00 000117 DVCHR% ; JFN might work 29080 003067'01 320 12 0 00 003071' ifje. r ; But didn't 29081 003070'01 254 00 0 00 003075' 29082 003071'01 200 04 0 00 000001 move t4, t1 ; Save any error code for later 29083 003072'01 477 06 0 00 000010 setob q2, q4 ; Phoney device designator and assignment 29084 003073'01 400 07 0 00 000000 setz q3, ; No characteristics 29085 003074'01 254 00 0 00 003077' else. ; Otherwise, worked. Promising... 29086 003075'01 120 06 0 00 000001 dmove q2, t1 ; Save device designator and characteristics 29087 003076'01 200 10 0 00 000003 move q4, t3 ; And assignment word 29088 003077'01 endif. 29089 003077'01 325 05 0 00 003153' jxe q1, gs%opn, clsrlj ; If it isn't open, don't close it 29090 ; Load the device type 29091 003100'01 135 04 0 00 005637' ldb t4,[pointr q3,dv%typ] 29092 003101'01 306 04 0 00 000012 cain t4, .dvtty ; Physical (front end) terminal? 29093 003102'01 254 00 0 00 003130' jrst clsfe ; Clean that up and deassign k20net - Kermit-20 Network Support MACRO %53B(1254)-4 19:42 30-Mar-24 Page 44-1 K20NET MAC 13-Dec-23 21:12 clsnet -- Close any kind of 'network' connection 29094 003103'01 306 04 0 00 000013 cain t4, .dvpty ; Pseudo terminal? 29095 003104'01 254 00 0 00 003130' jrst clspty ; Clean that up and deassign 29096 003105'01 306 04 0 00 000022 cain t4, .dvdcn ; Outgoing NRT? 29097 003106'01 254 00 0 00 003121' jrst clsnrt ; Clean that up (no deassign) 29098 29099 003107'01 334 01 0 00 000000# ermsg% (, clscom) 29100 003110'01 254 00 0 00 003114' 29101 003111'01 202 01 0 00 003002* 29102 003112'01 104 00 0 00 000313 29103 003113'01 254 00 0 00 003130' 29104 000210'03 000000000000# 29105 001770'04 113 105 122 115 111 29106 29107 k20net - Kermit-20 Network Support MACRO %53B(1254)-4 19:42 30-Mar-24 Page 45 K20NET MAC 13-Dec-23 21:12 Various JFN closure routines 29108 subttl Various JFN closure routines 29109 29110 remark ; See required location of SYN's, above 29111 remark clsfe ; Close the terminal 29112 remark clspty ; Close the pseudo-terminal 29113 29114 003114'01 44 07 0 00 003116' nrtend: point 7, .+2 ; Point to message 29115 003115'01 000000 000014 ^d12 ; Its length 29116 003116'01 113 145 162 155 151 ASCIZ "Kermit Close" ; Informative message... 29117 29118 003121'01 550 01 0 00 003061* clsnrt: hrrz t1, netjfn ; Load the network JFN 29119 003122'01 200 02 0 00 005640' move t2, [.dcx40,,.moclz] ;Object initiated close 29120 003123'01 120 03 0 00 003114' dmove t3, nrtend ; Message for remote NRT server to ignore 29121 003124'01 104 00 0 00 000077 MTOPR% ; Try to deliver the bad news 29122 003125'01 320 12 0 00 003127' ifje. r ; Catch and ignore error 29123 003126'01 254 00 0 00 003130' 29124 003127'01 200 04 0 00 000001 move t4, t1 ; Leave around for debugger 29125 003130'01 endif. 29126 remark clscom ; And proceed ...(falls through) 29127 29128 003130'01 550 01 0 00 003121* clscom: hrrz t1, netjfn ; Common close for any kind of JFN 29129 003131'01 104 00 0 00 000022 CLOSF% ; Make our first attempt 29130 003132'01 320 12 0 00 003134' ifje. r ; Catch and ignore the error 29131 003133'01 254 00 0 00 003140' 29132 003134'01 200 04 0 00 000001 move t4, t1 ; Save error for later 29133 003135'01 302 01 0 00 600160 caie t1, clsx1 ; File not open? 29134 003136'01 254 00 0 00 003141' jrst clsabt ; No, try to abort it 29135 003137'01 254 00 0 00 003153' jrst clsrlj ; Otherwise, just try to let go of it 29136 003140'01 endif. 29137 003140'01 254 00 0 00 003160' jrst clsasg ; Go clean up assignments and storage 29138 29139 003141'01 550 01 0 00 003130* clsabt: hrrz t1, netjfn ; Load the JFN, no flags 29140 003142'01 661 01 0 00 004000 txo t1, cz%abt ; Set the abort flag 29141 003143'01 104 00 0 00 000022 CLOSF% ; Toss it with reckless abandon 29142 003144'01 320 12 0 00 003146' ifje. r ; Catch and ignore the error 29143 003145'01 254 00 0 00 003152' 29144 003146'01 200 04 0 00 000001 move t4, t1 ; Save error for later 29145 003147'01 302 01 0 00 600152 caie t1, desx3 ; JFN not assigned anymore> 29146 003150'01 254 00 0 00 003141' jrst clsabt ; No, just try to let go of it 29147 003151'01 254 00 0 00 003160' jrst clsasg ; Otherwise, release assignments 29148 003152'01 endif. 29149 003152'01 254 00 0 00 003160' jrst clsasg ; Go clean up assignments 29150 29151 003153'01 550 01 0 00 003141* clsrlj: hrrz t1, netjfn ; Just try to let go 29152 003154'01 104 00 0 00 000023 RLJFN% ; and hope for the bext 29153 003155'01 320 12 0 00 003157' ifje. r ; Catch and ignore the error 29154 003156'01 254 00 0 00 003160' 29155 003157'01 200 04 0 00 000001 move t4, t1 ; Save error for later 29156 003160'01 endif. 29157 remark clsasg ; Clean up assignments 29158 k20net - Kermit-20 Network Support MACRO %53B(1254)-4 19:42 30-Mar-24 Page 46 K20NET MAC 13-Dec-23 21:12 Release any assigned terminals, pseudo or otherwise 29159 subttl Release any assigned terminals, pseudo or otherwise 29160 29161 003160'01 336 00 0 00 001130* clsasg: ifmn. asgflg ; Do we think anything assigned? 29162 003161'01 254 00 0 00 003167' 29163 003162'01 200 01 0 00 001131* move t1, asgdev ; Grab assigned device 29164 003163'01 104 00 0 00 000071 RELD% ; Punt it 29165 003164'01 320 12 0 00 003166' ifje. r ; Sigh 29166 003165'01 254 00 0 00 003167' 29167 003166'01 200 04 0 00 000001 move t4, t1 ; What if different from q2? 29168 003167'01 endif. 29169 003167'01 endif. 29170 ; Do a consistency check 29171 003167'01 574 03 0 00 000010 hlre t3, q4 ; Load job assignment 29172 003170'01 312 03 0 00 005641' came t3, [-1] ; Not assigned? 29173 003171'01 316 03 0 00 005642' camn t3, [-2] ; Allocator has it? 29174 003172'01 254 00 0 00 003224' Jrst clscln ; Then nothing else to do 29175 003173'01 312 03 0 00 001100* came t3, myjob ; Do we have this device? 29176 003174'01 254 00 0 00 003224' jrst clscln ; No, then surely cannot release it 29177 003175'01 200 01 0 00 000006 move t1, q2 ; Load JFN's device designator 29178 003176'01 316 01 0 00 003162* camn t1, asgdev ; Did we already release it, actually? 29179 003177'01 254 00 0 00 003224' jrst clscln ; Yes, so no inconsistency 29180 ; No, something extra left lying around... 29181 003200'01 554 02 0 00 000001 hlrz t2, t1 ; Pick up the device type 29182 003201'01 550 03 0 00 000001 hrrz t3, t1 ; Pick up the unit number 29183 003202'01 326 02 0 00 003212' ife. t2 ; But!! Any device type? 29184 003203'01 626 03 0 00 400000 trzn t3, .ttdes ; Universal terminal? 29185 003204'01 254 00 0 00 003224' jrst clscln ; No, some odd thing. Leave it alone 29186 003205'01 316 03 0 00 001263* camn t3, mytty ; It's a terminal. Ourself? 29187 003206'01 254 00 0 00 003224' jrst clscln ; Yes, LOGIN% or CRJOB% gave it to us 29188 003207'01 550 01 0 00 000003 hrrz t1, t3 ; Load bare terminal number 29189 003210'01 505 01 0 00 600012 hrli t1, .dvdes!.dvtty ;Give a general device designator 29190 003211'01 254 00 0 00 003220' else. ; Otherwise, fullword 29191 003212'01 200 04 0 00 000002 move t4, t2 ; Make a copy of the device designator 29192 003213'01 620 04 0 00 600000 trz t4, .dvdes ; Shut off the device designator 29193 003214'01 302 04 0 00 000012 caie t4, .dvtty ; A terminal? 29194 003215'01 254 00 0 00 003220' anskp. ; Not a terminal, so can't be our terminal 29195 003216'01 316 03 0 00 003205* camn t3, mytty ; It's a terminal. Ourself? 29196 003217'01 254 00 0 00 003224' jrst clscln ; Yes, LOGIN% or CRJOB% gave it to us 29197 003220'01 endif. ; To RELD% 29198 29199 003220'01 104 00 0 00 000071 RELD% ; Try to punt it, anyway 29200 003221'01 320 12 0 00 003223' ifje. r ; Sigh 29201 003222'01 254 00 0 00 003224' 29202 003223'01 200 04 0 00 000001 move t4, t1 ; Save error number for debuggers 29203 003224'01 endif. 29204 remark clscln ; Fall through to storage clean up 29205 k20net - Kermit-20 Network Support MACRO %53B(1254)-4 19:42 30-Mar-24 Page 47 K20NET MAC 13-Dec-23 21:12 Finally obliterate JFN related storage 29206 subttl Finally obliterate JFN related storage 29207 29208 ; Leaves ASCII device or node names alone for possible later reporting 29209 29210 003224'01 402 00 0 00 003160* clscln: setzm asgflg ; Nothing assigned 29211 003225'01 402 00 0 00 003176* setzm asgdev ; No relec of it, either 29212 003226'01 402 00 0 00 003153* setzm netjfn ; Not no JFN, not no how 29213 29214 003227'01 403 01 0 00 000002 setzb t1, t2 ; In case we have adjacent words 29215 003230'01 124 01 0 00 000000# dmovem t1, ndvchr ; Whack the characteristics double word 29216 003231'01 402 00 0 00 002351* setzm vtermf ; No kind of virtual terminal 29217 003232'01 402 00 0 00 000000# setzm nrtflg ; Not a DECnet NRT connection 29218 003233'01 402 00 0 00 000000# setzm ptytty ; No terminal assigned via PTY, either 29219 003234'01 402 00 0 00 000000# setzm ptyflg ; No a pseudo-terminal connection 29220 003235'01 402 00 0 00 000000# setzm ttyflg ; Not using a physical terminal 29221 003236'01 402 00 0 00 000000# setzm ttydev ; So don't have a device designator 29222 29223 003237'01 200 03 0 00 003216* move t3, mytty ; Use our local terminal 29224 003240'01 202 03 0 00 001503* movem t3, ttynum ; Use that 29225 003241'01 402 00 0 00 003047* setzm local ; We are no longer local 29226 003242'01 476 00 0 00 000000# setom opndev ; No opened device 29227 003243'01 263 17 0 00 000000 ret ; One way or another, finally done 29228 k20net - Kermit-20 Network Support MACRO %53B(1254)-4 19:42 30-Mar-24 Page 48 K20NET MAC 13-Dec-23 21:12 Lost virtual terminal connection, shut everything down 29229 subttl Lost virtual terminal connection, shut everything down 29230 29231 003244'01 netvtx: entry netvtx ;[196] 29232 extern frkchb ;[218] Convert channel number to bit 29233 txmsg < 29234 003244'01 200 01 0 00 000000# [KERMIT-20: Lost > 29235 003245'01 104 00 0 00 000076 29236 003246'01 320 12 0 00 003247' 29237 000211'03 000000000000# 29238 002000'04 015 012 007 133 113 29239 29240 003247'01 336 00 0 00 000000# ifmn. ptyflg 29241 003250'01 254 00 0 00 003266' 29242 003251'01 200 01 0 00 000000# txmsg 29243 003252'01 104 00 0 00 000076 29244 003253'01 320 12 0 00 003254' 29245 000212'03 000000000000# 29246 002005'04 160 163 145 165 144 29247 003254'01 561 01 0 00 000000# hrroi t1, ptynam ; Point to pseudo-terminal device name 29248 003255'01 104 00 0 00 000076 PSOUT% ; Type that 29249 003256'01 200 01 0 00 000000# txmsg < (> 29250 003257'01 104 00 0 00 000076 29251 003260'01 320 12 0 00 003261' 29252 000213'03 000000000000# 29253 002014'04 040 050 000 000 000 29254 003261'01 561 01 0 00 000000# hrroi t1, ttynam ; Point to associated terminal device name 29255 003262'01 104 00 0 00 000076 PSOUT% ; Type that 29256 003263'01 200 01 0 00 000000# txmsg <) > 29257 003264'01 104 00 0 00 000076 29258 003265'01 320 12 0 00 003266' 29259 000214'03 000000000000# 29260 002015'04 051 040 000 000 000 29261 003266'01 endif. 29262 29263 003266'01 336 00 0 00 000000# ifmn. nrtflg 29264 003267'01 254 00 0 00 003300' 29265 003270'01 200 01 0 00 000000# txmsg 29266 003271'01 104 00 0 00 000076 29267 003272'01 320 12 0 00 003273' 29268 000215'03 000000000000# 29269 002016'04 104 105 103 156 145 29270 003273'01 561 01 0 00 001702* hrroi t1,nodnam ; Point to the remote node 29271 003274'01 104 00 0 00 000076 PSOUT% ; Type it 29272 003275'01 200 01 0 00 000000# txmsg <:: > ; Trailing punctuation 29273 003276'01 104 00 0 00 000076 29274 003277'01 320 12 0 00 003300' 29275 000216'03 000000000000# 29276 002024'04 072 072 040 000 000 29277 003300'01 endif. 29278 29279 003300'01 200 01 0 00 000000# txmsg ; Find out where this blew up 29280 003301'01 104 00 0 00 000076 29281 003302'01 320 12 0 00 003303' 29282 000217'03 000000000000# 29283 002025'04 141 164 072 040 000 k20net - Kermit-20 Network Support MACRO %53B(1254)-4 19:42 30-Mar-24 Page 48-1 K20NET MAC 13-Dec-23 21:12 Lost virtual terminal connection, shut everything down 29284 003303'01 200 01 0 17 000000 move t1, (p) ; See who called us 29285 003304'01 621 01 0 00 777700 txz t1, klflgs ; Flags aren't part of the address 29286 003305'01 260 17 0 00 000000* call symout ; Symbollically! 29287 003306'01 200 01 0 00 000000# txmsg <. Returning to > 29288 003307'01 104 00 0 00 000076 29289 003310'01 320 12 0 00 003311' 29290 000220'03 000000000000# 29291 002026'04 056 040 122 145 164 29292 003311'01 561 01 0 00 000000# hrroi t1,sysnam ; Load local node name 29293 003312'01 104 00 0 00 000076 PSOUT% ; Type it, not "DEC-20" 29294 29295 dmove t1, [ .fhsup ;[218] Signaling superior Kermit 29296 003313'01 120 01 0 00 005643' frkchb ] ;[218] Inter-fork signal 29297 003314'01 104 00 0 00 000132 IIC% ; Give it a poke 29298 003315'01 320 12 0 00 003317' ifje. r ; Failed?? 29299 003316'01 254 00 0 00 003340' 29300 003317'01 302 01 0 00 600251 caie t1, FRKHX2 ; Wait! Tried to poke the wrong guy? 29301 003320'01 334 00 0 00 000000 %ermsg (,neter2) 29302 003321'01 254 00 0 00 003325' 29303 003322'01 265 01 0 00 002745* 29304 003323'01 000000000000# 29305 003324'01 254 00 0 00 003343' 29306 002032'04 125 156 141 142 154 29307 003325'01 201 01 0 00 400000 movei t1, .fhslf ;[186] We must be the inferior 29308 003326'01 104 00 0 00 000132 IIC% ;[186] So poke ourselves 29309 003327'01 320 12 0 00 003331' %jserr (,) ;[186] 29310 003330'01 254 00 0 00 003334' 29311 003331'01 265 01 0 00 003322* 29312 003332'01 000000000000# 29313 003333'01 254 00 0 00 003334' 29314 002044'04 125 156 141 142 154 29315 txmsg <:: (Sup)] 29316 29317 003334'01 200 01 0 00 000000# > 29318 003335'01 104 00 0 00 000076 29319 003336'01 320 12 0 00 003337' 29320 000221'03 000000000000# 29321 002053'04 072 072 040 050 123 29322 29323 003337'01 254 00 0 00 002363* jrst $connx ;[186] In self-case, close some other things 29324 003340'01 endif. ;[186] End signaling analysis and recovery 29325 txmsg <:: (Inf)] 29326 29327 003340'01 200 01 0 00 000000# > 29328 003341'01 104 00 0 00 000076 29329 003342'01 320 12 0 00 003343' 29330 000222'03 000000000000# 29331 002056'04 072 072 040 050 111 29332 29333 29334 003343'01 104 00 0 00 000170 neter2: HALTF ; Halt this fork. 29335 003344'01 254 00 0 00 003343' jrst neter2 ; Should never get here... 29336 29337 003345'01 261 17 0 00 000001 netinh: push p, t1 ; Save t1, just in case useful 29338 003346'01 261 17 0 00 000002 push p, t2 ; Ditto others k20net - Kermit-20 Network Support MACRO %53B(1254)-4 19:42 30-Mar-24 Page 48-2 K20NET MAC 13-Dec-23 21:12 Lost virtual terminal connection, shut everything down 29339 003347'01 261 17 0 00 000003 push p, t3 29340 29341 003350'01 561 01 0 00 003366' hrroi t1, netinm ; Load error message 29342 003351'01 104 00 0 00 000313 ESOUT% ; Give ourselves an error 29343 003352'01 201 01 0 00 000101 movei t1,.priou ; Continue on primary output 29344 003353'01 525 02 0 00 400000 hrloi t2,.fhslf ; Wants this for explicit error 29345 003354'01 400 03 0 00 000000 setz t3, ; Don't limit length of text 29346 003355'01 104 00 0 00 000011 ERSTR% ; Type the JSYS failure reason text 29347 003356'01 320 12 0 00 003360' erjmpr .+2 ; Ignore strange error 29348 003357'01 320 12 0 00 003360' erjmpr .+1 ; Ignore stranger error 29349 003360'01 561 01 0 00 001727* hrroi t1, crlf ; Tie off the line 29350 003361'01 104 00 0 00 000076 PSOUT% 29351 29352 003362'01 262 17 0 00 000003 pop p, t3 ; Restore them 29353 003363'01 262 17 0 00 000002 pop p, t2 ; all of 29354 003364'01 262 17 0 00 000001 pop p, t1 ; them 29355 003365'01 254 00 0 00 003343' jrst neter2 ; Go drop dead and stay dead 29356 29357 003366'01 116 145 164 167 157 netinm: asciz /Network input subfork unexpectedly halted, / 29358 k20net - Kermit-20 Network Support MACRO %53B(1254)-4 19:42 30-Mar-24 Page 49 K20NET MAC 13-Dec-23 21:12 Open Net -- Opens network connection to somewhere 29359 subttl Open Net -- Opens network connection to somewhere 29360 29361 ; Call: 29362 ; 29363 ; t1/ LH: device type number - .dvpty, .dvdcn, .dvtty 29364 ; RH: unit number, if applicable (-1, otherwise) 29365 ; 29366 ; Return: 29367 ; 29368 ; +1/ t1, Gubbish 29369 ; t2, Ditto 29370 ; 29371 ; +2/ t1, JFN ready to use 29372 ; t2, Associated device designator (which may have been assigned) 29373 ; 29374 ; N.B., Assumes we are not treating a disk as a terminal 29375 29376 003377'01 openet: entry openet ; World callable 29377 extern flow ; Used for ^S/^Q processing 29378 003377'01 265 16 0 00 005564' saveac ;Save some things 29379 003400'01 200 05 0 00 000001 move q1, t1 ; Let's get that out of the way 29380 29381 003401'01 337 01 0 00 003226* skipg t1, netjfn ; Is anything maybe open? 29382 003402'01 254 00 0 00 003421' ifskp. ; Yes, let's get some information 29383 003403'01 104 00 0 00 000024 GTSTS% ; Get file status of JFN 29384 003404'01 320 16 0 00 003421' annje. ; Give up; JFN has to be ill 29385 003405'01 607 02 0 00 000200 ifxn. t2, gs%nam ; Don't go any further if nothing there 29386 003406'01 254 00 0 00 003420' 29387 003407'01 325 02 0 00 003420' andxn. t2, gs%opn ; And it has to be open 29388 003410'01 200 04 0 00 000002 move t4, t2 ; Save the status word 29389 003411'01 104 00 0 00 000117 DVCHR% ; Get the device characteristics 29390 003412'01 320 12 0 00 003414' ifje. r ; Catch and record error 29391 003413'01 254 00 0 00 003416' 29392 003414'01 661 04 0 00 000400 txo t4, gs%err ; Pretend the file is in error 29393 003415'01 254 00 0 00 003420' else. ; Otherwise, worked 29394 003416'01 200 06 0 00 000001 move q2, t1 ; Save device designator 29395 003417'01 120 07 0 00 000002 dmove q3, t2 ; Save characteristics and assignment 29396 003420'01 endif. ; End DVCHR error handling 29397 003420'01 endif. ; End case file status checking 29398 003420'01 254 00 0 00 003423' else. ; Otherwise, whack everything 29399 003421'01 403 04 0 00 000006 setzb t4, q2 ; No status or device designator 29400 003422'01 403 07 0 00 000010 setzb q3, q4 ; No device characteristics or assignment 29401 003423'01 endif. 29402 29403 remark ; See if we need to ditch the JFN 29404 003423'01 607 04 0 00 000200 ifxn. t4, gs%nam ; Is there a JFN already? 29405 003424'01 254 00 0 00 003430' 29406 003425'01 607 04 0 00 000400 andxn. t4, gs%err ; Any kind of error, phoney or otherwise? 29407 003426'01 254 00 0 00 003430' 29408 003427'01 260 17 0 00 003044' call clsjfn ; Yes, stomp it 29409 003430'01 endif. ; End case JFN status check 29410 29411 003430'01 554 01 0 00 000005 hlrz t1, q1 ; Finally have a look at the device type number 29412 003431'01 135 02 0 00 005645' ldb t2,[pointr q2,dv%typ];Load JFN's device type number 29413 k20net - Kermit-20 Network Support MACRO %53B(1254)-4 19:42 30-Mar-24 Page 49-1 K20NET MAC 13-Dec-23 21:12 Open Net -- Opens network connection to somewhere 29414 003432'01 302 01 0 00 000013 caie t1, .dvpty ; Wants a pseudo-terminal? 29415 003433'01 254 00 0 00 003443' ifskp. ; Yes, let's see if we are reconnecting 29416 003434'01 312 01 0 00 000002 came t1, t2 ; Already has one? 29417 003435'01 254 00 0 00 003440' ifskp. ; Fine, give him the same one 29418 003436'01 550 01 0 00 003401* hrrz t1, netjfn ; Reload the JFN 29419 003437'01 254 00 0 00 002763* retskp ; Return success 29420 003440'01 endif. ; Otherwise, wants to go somewhere else 29421 003440'01 603 04 0 00 400000 txne t4, gs%opn ; Anything already open? 29422 003441'01 260 17 0 00 003044' call clsjfn ; Yes, stomp it 29423 003442'01 254 00 0 00 003521' callret opnpty ; Yes, go assign and open one 29424 003443'01 endif. ; End case pseudo-terminal connection 29425 29426 003443'01 302 01 0 00 000012 caie t1, .dvtty ; Wants a physical terminal? 29427 003444'01 254 00 0 00 003463' ifskp. ; Yes, let's see if we are reconnecting 29428 003445'01 312 01 0 00 000002 came t1, t2 ; Already has one? 29429 003446'01 254 00 0 00 003460' ifskp. ; Yes, maybe reusing the current one 29430 003447'01 550 01 0 00 000005 hrrz t1, q1 ; Pick up requested unit number 29431 003450'01 135 02 0 00 005646' ldb t2,[pointr q2,dv%unt] ;Load JFN's device type number 29432 003451'01 312 01 0 00 000002 came t1, t2 ; Are they the same? 29433 003452'01 254 00 0 00 003460' anskp. ; No, release the old one and get out of here 29434 003453'01 574 01 0 00 000010 hlre t1, q4 ; Pick up assigned job 29435 003454'01 312 01 0 00 003173* came t1, myjob ; Is it me? 29436 003455'01 254 00 0 00 003460' anskp. ; Strange, don't risk reusing it 29437 003456'01 550 01 0 00 003436* hrrz t1, netjfn ; Reload the JFN 29438 003457'01 254 00 0 00 003437* retskp ; Return success 29439 003460'01 endif. 29440 003460'01 603 04 0 00 400000 txne t4, gs%opn ; Anything already open? 29441 003461'01 260 17 0 00 003044' call clsjfn ; Yes, stomp it 29442 003462'01 254 00 0 00 003625' callret opntty ; Go assign terminal and open it 29443 003463'01 endif. ; End case physical terminal 29444 29445 003463'01 302 01 0 00 000022 caie t1, .dvdcn ; Wants a DECnet NRT?? 29446 003464'01 254 00 0 00 003514' ifskp. ; Yes, maybe going to the same place 29447 003465'01 312 01 0 00 000002 came t1, t2 ; Already there someplace? 29448 003466'01 254 00 0 00 003511' ifskp. ; Fine, give him the same one 29449 003467'01 336 00 0 00 000000# ifmn. ndvfxp ; Has extended verify? 29450 003470'01 254 00 0 00 003500' 29451 003471'01 260 17 0 00 000236' call chknrt ; OK, so check the node name 29452 003472'01 254 00 0 00 003477' ifskp. ; Worked, let's compare the numbers 29453 003473'01 312 01 0 00 000000# came t1, oldnum ; Going to same node? 29454 003474'01 254 00 0 00 003477' anskp. ; No, so close up shop and go elsewhere 29455 003475'01 550 01 0 00 003456* hrrz t1, netjfn ; The same; reload the JFN 29456 003476'01 254 00 0 00 003457* retskp ; Return success 29457 003477'01 endif. ; Done 29458 remark ; Otherwise falls out and gets new connection 29459 003477'01 254 00 0 00 003511' else. ; Otherwise, have to compare characters 29460 dmove t1, [ -1,,oldnam ; Old node name 29461 003500'01 120 01 0 00 005647' -1,,nodnam ] ; Current node name 29462 003501'01 104 00 0 00 000540 STCMP% ; Compare them 29463 003502'01 320 12 0 00 003504' ifje. r ; Failed?? 29464 003503'01 254 00 0 00 003506' 29465 003504'01 200 03 0 00 000001 move t3, t1 ; Save error code 29466 003505'01 474 01 0 00 000000 seto t1, ; For sure not equal 29467 003506'01 endif. 29468 003506'01 326 01 0 00 003511' ife. t1 ; Equal? k20net - Kermit-20 Network Support MACRO %53B(1254)-4 19:42 30-Mar-24 Page 49-2 K20NET MAC 13-Dec-23 21:12 Open Net -- Opens network connection to somewhere 29469 003507'01 550 01 0 00 003475* hrrz t1, netjfn ; The same; reload the JFN 29470 003510'01 254 00 0 00 003476* retskp ; Return success 29471 003511'01 endif. 29472 003511'01 endif. ; End same destination checks 29473 003511'01 endif. 29474 003511'01 603 04 0 00 400000 txne t4, gs%opn ; Anything already open? 29475 003512'01 260 17 0 00 003044' call clsjfn ; Yes, stomp it 29476 003513'01 254 00 0 00 000213' callret decnct ; Go connect somewhere 29477 003514'01 endif. ; End case DECnet MCB terminal 29478 29479 003514'01 334 01 0 00 000000# ermsg% (,r) 29480 003515'01 254 00 0 00 003521' 29481 003516'01 202 01 0 00 003111* 29482 003517'01 104 00 0 00 000313 29483 003520'01 254 00 0 00 003042* 29484 000223'03 000000000000# 29485 002061'04 113 105 122 115 111 29486 29487 k20net - Kermit-20 Network Support MACRO %53B(1254)-4 19:42 30-Mar-24 Page 50 K20NET MAC 13-Dec-23 21:12 Open a psuedo terminal connection 29488 subttl Open a psuedo terminal connection 29489 29490 003521'01 opnpty: remark ;These are already saved 29491 003521'01 260 17 0 00 001056' call asipty ; First, assign a PTY 29492 003522'01 263 17 0 00 000000 ret ; Unless we couldn't ... 29493 003523'01 476 00 0 00 003241* setom local ; We're the local Kermit 29494 29495 003524'01 120 05 0 00 000001 dmove q1, t1 ; Load terminal line and PTY designator 29496 003525'01 202 01 0 00 003240* movem t1,ttynum ; Store associated line number 29497 003526'01 202 02 0 00 000000# movem t2,ptydev ; Store assigned PTY designator 29498 003527'01 201 03 0 00 000010 movei t3, TOPS20 ; On a pseudo-terminal (I.E., a loopback) 29499 003530'01 200 04 0 03 000763' move t4, hsttyp(t3) ; Load OWGP to OS type string 29500 003531'01 124 03 0 00 000000# dmovem t3, nrtros ; The 'remote' OS is always Tops-20... 29501 29502 remark asgflg ; asipty sets the assigned flag 29503 remark asgdev ; Ditto the assigned device 29504 remark ptyflg ; Ditto pty and bin flags 29505 003532'01 402 00 0 00 003013* setzm flow ; Don't do control flow (although works) 29506 29507 003533'01 402 00 0 00 003507* setzm netjfn ; No network JFN, yet 29508 dmove t1, [ gj%sht!gj%flg ; Want flags 29509 003534'01 120 01 0 00 005651' -1,,ptynam ] ; asipty built this for us 29510 003535'01 104 00 0 00 000020 GTJFN% ; Try to open it 29511 003536'01 320 12 0 00 003540' ifje. r ; Catch the error 29512 003537'01 254 00 0 00 003552' 29513 003540'01 200 04 0 00 000001 move t4, t1 ; Record for debugger 29514 003541'01 334 00 0 00 000000 %ermsg (,) ; Bizarre, we just got the device 29515 003542'01 254 00 0 00 003546' 29516 003543'01 265 01 0 00 003331* 29517 003544'01 000000000000# 29518 003545'01 254 00 0 00 003546' 29519 002074'04 103 141 156 047 164 29520 003546'01 200 01 0 00 000006 move t1, q2 ; Load assigned designator 29521 003547'01 260 17 0 00 003620' call deadev ; Go deasign the device 29522 003550'01 263 17 0 00 000000 ret ; Return failure 29523 003551'01 254 00 0 00 003555' else. ; Otherwise worked 29524 003552'01 552 01 0 00 003533* hrrzm t1, netjfn ; Save as network JFN 29525 003553'01 512 01 0 00 000316* hllzm t1, netflg ; Ditto the flags (just in case) 29526 003554'01 200 11 0 00 000001 move q5, t1 ; Save a copy for recovery 29527 003555'01 endif. ; End case JSYS failure 29528 29529 003555'01 621 01 0 00 777777 tlz t1,-1 ; Whack flags them so OPENF% doesn't choke 29530 003556'01 200 02 0 00 005653' movx t2, fld(8,of%bsz)!of%wr!of%rd ; 8-bit bytes, read & write access. 29531 003557'01 104 00 0 00 000021 OPENF% ; Open the device. 29532 003560'01 320 12 0 00 003562' ifje. r ; Catch the error 29533 003561'01 254 00 0 00 003572' 29534 003562'01 200 04 0 00 000001 move t4, t1 ; Record for debugger 29535 003563'01 334 00 0 00 000000 %ermsg (,) ; Bizarre, we just got the device 29536 003564'01 254 00 0 00 003570' 29537 003565'01 265 01 0 00 003543* 29538 003566'01 000000000000# 29539 003567'01 254 00 0 00 003570' 29540 002101'04 103 157 165 154 144 29541 003570'01 550 01 0 00 000011 hrrz t1, q5 ; Load the JFN, sans flags 29542 003571'01 254 00 0 00 003044' callret clsjfn ; Call JFN and device clean up and scrub k20net - Kermit-20 Network Support MACRO %53B(1254)-4 19:42 30-Mar-24 Page 50-1 K20NET MAC 13-Dec-23 21:12 Open a psuedo terminal connection 29543 003572'01 endif. ; End case JSYS results handling 29544 ;[223] Find out about the associated terminal 29545 003572'01 200 01 0 00 000005 move t1, q1 ;[223] Load the terminal line 29546 003573'01 660 01 0 00 400000 txo t1, .ttdes ;[223] Turn it into a terminal designator 29547 003574'01 260 17 0 00 004776' call gndpar ;[223] Go find out about the parity 29548 003575'01 400 02 0 00 000000 setz t2, ;[223] Failed somehow, so no parity 29549 003576'01 606 02 0 00 000001 ifxn. t2, gd%par ;[223] Will it tolerate parity?? 29550 003577'01 254 00 0 00 003602' 29551 003600'01 476 00 0 00 000000# setom opnpar ;[223] It will 29552 003601'01 254 00 0 00 003603' else. ;[223] ...Otherwise... 29553 003602'01 402 00 0 00 000000# setzm opnpar ;[223] It won't 29554 003603'01 endif. ;[223] 29555 29556 003603'01 550 01 0 00 000011 hrrz t1, q5 ;[223] Load the PTY JFN, sans flags 29557 003604'01 201 02 0 00 000003 movei t2, .chcnc ;[186] PTY *must* have a ^C to get going 29558 003605'01 260 17 0 00 001741' call BOUTR% ;[186] Push it out, either way 29559 003606'01 334 00 0 00 000000 %ermsg (,r) ;[186] 29560 003607'01 254 00 0 00 003613' 29561 003610'01 265 01 0 00 003565* 29562 003611'01 000000000000# 29563 003612'01 254 00 0 00 003520* 29564 002106'04 106 151 162 163 164 29565 29566 003613'01 200 02 0 00 000006 move t2, q2 ; Load PTY device designator 29567 003614'01 201 03 0 00 000013 movei t3, .dvpty ; Opened a pseudo-terminal 29568 003615'01 202 03 0 00 000000# movem t3, opndev ; Store opened device type 29569 003616'01 476 00 0 00 003231* setom vtermf ; Set the virtual terminal flag 29570 003617'01 254 00 0 00 003510* retskp ; Won!! 29571 k20net - Kermit-20 Network Support MACRO %53B(1254)-4 19:42 30-Mar-24 Page 51 K20NET MAC 13-Dec-23 21:12 Used to deassign anything during opening failure 29572 subttl Used to deassign anything during opening failure 29573 29574 003620'01 104 00 0 00 000117 deadev: DVCHR% ; Pull the device characteristics 29575 003621'01 320 12 0 00 003224' erjmpr clscln ; Ignore error and scrub storage 29576 003622'01 120 06 0 00 000001 dmove q2, t1 ; Position designator and characteristics 29577 003623'01 200 10 0 00 000003 move q4, t3 ; Where clsarg wants them 29578 003624'01 254 00 0 00 003160' callret clsasg ; Go hand off to release device and scrub 29579 k20net - Kermit-20 Network Support MACRO %53B(1254)-4 19:42 30-Mar-24 Page 52 K20NET MAC 13-Dec-23 21:12 Open a physical line 29580 subttl Open a physical line 29581 29582 ; Assumes q1 has an (octal) line number 29583 29584 003625'01 265 16 0 00 005654' opntty: saveac ;[223] For a copy of the JFN 29585 003626'01 550 01 0 00 000005 hrrz t1, q1 ; Load the unit number (the terminal line) 29586 003627'01 312 01 0 00 003237* came t1, mytty ; Is it us? 29587 003630'01 254 00 0 00 003640' ifskp. ; Yes, LOGIN% or CRJOB% assigned it 29588 003631'01 402 00 0 00 003224* setzm asgflg ; Not assigned 29589 003632'01 402 00 0 00 003225* setzm asgdev ; So get rid of artifacts 29590 003633'01 402 00 0 00 000000# setzm ttydev ; all of them 29591 003634'01 550 02 0 00 000005 hrrz t2, q1 ; Begin build for DEVST% 29592 003635'01 505 02 0 00 600012 hrli t2, .dvdes!.dvtty ;Turn into a device designator 29593 003636'01 200 06 0 00 000002 move q2, t2 ; Save that, just in case 29594 003637'01 254 00 0 00 003664' jrst gttyjf ; Now go get a TTY JFN 29595 003640'01 endif. 29596 29597 003640'01 505 01 0 00 600012 hrli t1, .dvdes!.dvtty ; Turn into a device designator 29598 003641'01 200 06 0 00 000001 move q2, t1 ; Save that for later 29599 003642'01 621 01 0 00 777777 tlz t1, -1 ; Shut them back off for NTINF% 29600 003643'01 311 01 0 00 000000# caml t1, pty1st ; Into virtual range? 29601 003644'01 334 01 0 00 000000# ermsg% (, clscln) 29602 003645'01 254 00 0 00 003651' 29603 003646'01 202 01 0 00 003516* 29604 003647'01 104 00 0 00 000313 29605 003650'01 254 00 0 00 003224' 29606 000224'03 000000000000# 29607 002114'04 113 105 122 115 111 29608 29609 003651'01 200 01 0 00 000006 move t1, q2 ; Load final requested device 29610 003652'01 104 00 0 00 000070 ASND% ; Assign it, so no possible login 29611 003653'01 320 12 0 00 003655' %jserr (,clscln) 29612 003654'01 254 00 0 00 003660' 29613 003655'01 265 01 0 00 003610* 29614 003656'01 000000000000# 29615 003657'01 254 00 0 00 003224' 29616 002124'04 103 157 165 154 144 29617 003660'01 350 00 0 00 003631* aos asgflg ; Flag we have a terminal assigned 29618 003661'01 202 01 0 00 003632* movem t1, asgdev ; Store global 29619 003662'01 202 01 0 00 000000# movem t1, ttydev ; Store as terminal device designator 29620 003663'01 200 02 0 00 000001 move t2, t1 ; Position for DEVST% 29621 29622 003664'01 350 00 0 00 000000# gttyjf: aos ttyflg ; At this point, commiting to the open 29623 003665'01 561 01 0 00 000000# hrroi t1,ttynam ; Point to area to write TTY specification 29624 003666'01 552 02 0 00 003525* hrrzm t2, ttynum ; Store as foreign terminal 29625 003667'01 104 00 0 00 000121 DEVST% ; Turn device into string 29626 003670'01 320 12 0 00 003672' %jserr (,deadev) 29627 003671'01 254 00 0 00 003675' 29628 003672'01 265 01 0 00 003655* 29629 003673'01 000000000000# 29630 003674'01 254 00 0 00 003620' 29631 002133'04 103 157 165 154 144 29632 003675'01 201 02 0 00 000072 movei t2,":" ; Load terminating device punctuation 29633 003676'01 136 02 0 00 000001 idpb t2,t1 ; Complete device syntax 29634 003677'01 400 02 0 00 000000 setz t2, ; Load .chnul k20net - Kermit-20 Network Support MACRO %53B(1254)-4 19:42 30-Mar-24 Page 52-1 K20NET MAC 13-Dec-23 21:12 Open a physical line 29635 003700'01 136 02 0 00 000001 idpb t2,t1 ; Tie off the string 29636 29637 003701'01 402 00 0 00 003552* setzm netjfn ; No network JFN, yet 29638 dmove t1, [ gj%sht!gj%flg ; Want flags 29639 003702'01 120 01 0 00 005662' -1,,ttynam ] ; asipty built this for us 29640 003703'01 104 00 0 00 000020 GTJFN% ; Try to open it 29641 003704'01 320 12 0 00 003706' ifje. r ; Catch the error 29642 003705'01 254 00 0 00 003720' 29643 003706'01 200 04 0 00 000001 move t4, t1 ; Record for debugger 29644 003707'01 334 00 0 00 000000 %ermsg (,) ; Bizarre, we just got the device 29645 003710'01 254 00 0 00 003714' 29646 003711'01 265 01 0 00 003672* 29647 003712'01 000000000000# 29648 003713'01 254 00 0 00 003714' 29649 002142'04 103 141 156 047 164 29650 003714'01 200 01 0 00 000006 move t1, q2 ; Load assigned designator 29651 003715'01 260 17 0 00 003620' call deadev ; Go deasign the device 29652 003716'01 263 17 0 00 000000 ret ; Return failure 29653 003717'01 254 00 0 00 003723' else. ; Otherwise, worked 29654 003720'01 552 01 0 00 003701* hrrzm t1, netjfn ; Save as network JFN 29655 003721'01 512 01 0 00 003553* hllzm t1, netflg ; Ditto the flags (just in case) 29656 003722'01 200 11 0 00 000001 move q5, t1 ;[223] Save a copy for recovery 29657 003723'01 endif. ; End case JSYS failure 29658 29659 remark 8-bit bytes, image mode, read & write access. 29660 003723'01 200 02 0 00 005664' movx t2, fld(8,of%bsz)!fld(.gsimg,of%mod)!of%wr!of%rd 29661 003724'01 621 01 0 00 777777 tlz t1,-1 ; Whack flags them so OPENF% doesn't choke 29662 003725'01 104 00 0 00 000021 OPENF% ; Open the device. 29663 003726'01 320 12 0 00 003730' ifje. r ; Catch the error 29664 003727'01 254 00 0 00 003740' 29665 003730'01 200 04 0 00 000001 move t4, t1 ; Record for debugger 29666 003731'01 334 00 0 00 000000 %ermsg (,) ; Bizarre, we just got the device 29667 003732'01 254 00 0 00 003736' 29668 003733'01 265 01 0 00 003711* 29669 003734'01 000000000000# 29670 003735'01 254 00 0 00 003736' 29671 002147'04 103 157 165 154 144 29672 003736'01 200 01 0 00 000003 move t1, t3 ; Load the JFN 29673 003737'01 254 00 0 00 003044' callret clsjfn ; Call JFN and device clean up and scrub 29674 003740'01 endif. ; End case JSYS failure 29675 29676 003740'01 200 01 0 00 000011 move t1, q5 ;[223] Load terminal JFN and flags 29677 003741'01 260 17 0 00 004776' call gndpar ;[223] Go find out about the parity 29678 003742'01 400 02 0 00 000000 setz t2, ;[223] Failed somehow, so no parity 29679 003743'01 606 02 0 00 000001 ifxn. t2, gd%par ;[223] Will it tolerate parity?? 29680 003744'01 254 00 0 00 003747' 29681 003745'01 476 00 0 00 000000# setom opnpar ;[223] It will 29682 003746'01 254 00 0 00 003750' else. ;[223] ...Otherwise... 29683 003747'01 402 00 0 00 000000# setzm opnpar ;[223] It won't 29684 003750'01 endif. ;[223] End case parity discovery 29685 29686 003750'01 550 01 0 00 000011 hrrz t1, q5 ;[223] Load just the JFN 29687 003751'01 550 04 0 00 000005 hrrz t4, q1 ; Load the unit number again 29688 003752'01 312 04 0 00 003627* came t4, mytty ; Is it us? 29689 003753'01 254 00 0 00 003756' ifskp. ; Yes, then don't do a few things k20net - Kermit-20 Network Support MACRO %53B(1254)-4 19:42 30-Mar-24 Page 52-2 K20NET MAC 13-Dec-23 21:12 Open a physical line 29690 003754'01 402 00 0 00 003523* setzm local ; Mark us as remote 29691 003755'01 254 00 0 00 003766' else. ; Otherwise, we are going places 29692 003756'01 476 00 0 00 003754* setom local ; We're the local Kermit 29693 003757'01 201 02 0 00 000015 movei t2, .chcrt ; Send a CR down the line to get things going. 29694 003760'01 260 17 0 00 001741' call BOUTR% ; Get it going 29695 003761'01 334 00 0 00 000000 %ermsg (,r) ;[186] 29696 003762'01 254 00 0 00 003766' 29697 003763'01 265 01 0 00 003733* 29698 003764'01 000000000000# 29699 003765'01 254 00 0 00 003612* 29700 002154'04 106 151 162 163 164 29701 003766'01 endif. 29702 29703 remark t1, netjfn ;[223] Still has JFN 29704 003766'01 200 02 0 00 000006 move t2, q2 ; Load TTY device designator 29705 003767'01 201 03 0 00 000012 movei t3, .dvtty ; Opened a terminal 29706 003770'01 202 03 0 00 000000# movem t3, opndev ; Store opened device type 29707 003771'01 402 00 0 00 003616* setzm vtermf ; Clear the virtual terminal flag 29708 003772'01 254 00 0 00 003617* retskp ; Won!! 29709 k20net - Kermit-20 Network Support MACRO %53B(1254)-4 19:42 30-Mar-24 Page 53 K20NET MAC 13-Dec-23 21:12 Check the line whose JFN is in t1. 29710 subttl Check the line whose JFN is in t1. 29711 29712 ; Set flags MDMLIN if line is remote, CARIER if line has carrier up. 29713 ; SPEED is set to a nonnegative number if known, -1 otherwise. 29714 ; 29715 ; Returns +1 always, with t1 unchanged, t2-t4 modified. 29716 29717 003773'01 chklin: entry chklin ;[186] Identify location for LINK 29718 extern mdmlin,speed,carier ;[186] And of everyone's necessaries 29719 29720 003773'01 265 16 0 00 005665' saveac ; Save the JFN!!! 29721 29722 003774'01 402 00 0 00 002357* setzm mdmlin ;[186] Assume line not modem-controlled. 29723 003775'01 402 00 0 00 002362* setzm carier ;[186] And no carrier 29724 003776'01 476 00 0 00 000000* setom speed ;[186] Assume speed is unknown 29725 29726 003777'01 553 04 0 00 000001 hrrzs t4, t1 ;[186] Save the JFN, sans flags 29727 004000'01 306 01 0 00 377777 cain t1, .nulio ;[186] Wants to talk with nobody? 29728 004001'01 263 17 0 00 000000 ret ;[186] That's never online 29729 004002'01 260 17 0 00 004151' call chkljf ;[186] Check basic JFN health 29730 004003'01 263 17 0 00 000000 ret ;[186] It's sick, somehow 29731 29732 004004'01 200 01 0 00 000004 move t1, t4 ;[186] restore jfn's rightful place 29733 004005'01 104 00 0 00 000117 dvchr% ;[186] get the device characteristics 29734 004006'01 320 12 0 00 004010' ifje. r ;[186] failed?? 29735 004007'01 254 00 0 00 004016' 29736 004010'01 200 04 0 00 000001 move t4, t1 ;[186] retrieve and return error code 29737 004011'01 334 00 0 00 000000 %ermsg(,r) 29738 004012'01 254 00 0 00 004016' 29739 004013'01 265 01 0 00 003763* 29740 004014'01 000000000000# 29741 004015'01 254 00 0 00 003765* 29742 002162'04 165 156 141 142 154 29743 004016'01 endif. ;[186] get out of here, nothing further to do 29744 29745 004016'01 250 01 0 00 000004 exch t1, t4 ;[186] Get the JFN back, save device 29746 004017'01 135 03 0 00 005426' ldb t3,[pointr t2,dv%typ] ;[186] Pick up a device type 29747 29748 004020'01 306 03 0 00 000022 cain t3, .dvdcn ;[186] Is this an NRT? 29749 004021'01 254 00 0 00 004126' jrst chkdcn ;[186] Then can't "Read Speed" 29750 004022'01 306 03 0 00 000013 cain t3, .dvpty ;[186] pseudo-terminal? 29751 004023'01 254 00 0 00 004140' jrst chkpty ;[186] Can't check terminal through the PTY 29752 004024'01 306 03 0 00 000012 cain t3, .dvtty ;[186] A terminal?? 29753 004025'01 254 00 0 00 004033' jrst chktty ;[186] Yes, go handle a physical line 29754 remark t3, .dvpip ;[186] A pipe? (a place holder) 29755 remark chkpip ;[186] Yes, go handle that 29756 ;[186] Otherwise, failure 29757 004026'01 334 01 0 00 000000# ermsg% (,r) 29758 004027'01 254 00 0 00 004033' 29759 004030'01 202 01 0 00 003646* 29760 004031'01 104 00 0 00 000313 29761 004032'01 254 00 0 00 004015* 29762 000225'03 000000000000# 29763 002173'04 113 105 122 115 111 29764 k20net - Kermit-20 Network Support MACRO %53B(1254)-4 19:42 30-Mar-24 Page 53-1 K20NET MAC 13-Dec-23 21:12 Check the line whose JFN is in t1. 29765 k20net - Kermit-20 Network Support MACRO %53B(1254)-4 19:42 30-Mar-24 Page 54 K20NET MAC 13-Dec-23 21:12 Case of physical line (on a DH or DL) or controlling line 29766 subttl Case of physical line (on a DH or DL) or controlling line 29767 29768 004033'01 chktty: extern setspd, monv ;[186] Physical line additional necessaries 29769 004033'01 250 04 0 00 000001 exch t4, t1 ;[208] Save the JFN, restore device 29770 remark t1, JFN ;[186] Still has terminal JFN 29771 004034'01 260 17 0 00 004176' call ntidev ;[208] Find out about it 29772 004035'01 254 00 0 00 004041' ifskp. ;[208] Worked 29773 004036'01 265 16 0 00 005364' saveac ;[208] Save for getnti results 29774 004037'01 120 05 0 00 000001 dmove q1, t1 ;[208] So save the results 29775 004040'01 254 00 0 00 004046' else. ;[208] Otherwise gronked. Sad... 29776 004041'01 334 00 0 00 000000 %ermsg (,r) 29777 004042'01 254 00 0 00 004046' 29778 004043'01 265 01 0 00 004013* 29779 004044'01 000000000000# 29780 004045'01 254 00 0 00 004032* 29781 002211'04 125 156 141 142 154 29782 004046'01 endif. ;[208] 29783 29784 004046'01 415 16 0 00 004056' block. ;[208] Enter block context for better control flow 29785 004047'01 261 17 0 00 000016 29786 004050'01 302 05 0 00 000000 caie q1, nw%nnt ;[208] Not a network terminal? 29787 004051'01 263 17 0 00 000000 ret ;[208] It is a network tty, so this makes no sense 29788 004052'01 302 06 0 00 000001 caie q2, nw%fe ;[208] DL or DH? (front end terminal) 29789 004053'01 263 17 0 00 000000 ret ;[208] No, so these won't make sense 29790 004054'01 254 00 0 00 003772* retskp ;[208] Exit block, +2; physical line 29791 004055'01 263 17 0 00 000000 endbk. ;[208] End block. lexical context 29792 004056'01 254 00 0 00 004061' ifskp. ;[208] Real hardware!! 29793 004057'01 200 01 0 00 000004 move t1, t4 ;[208] Restore the original JFN 29794 004060'01 254 00 0 00 004062' else. ;[208] Otherwise, a 'soft' terminal 29795 remark carier ;[208] Go with chkljf's GTSTS% result 29796 004061'01 263 17 0 00 000000 ret ;[208] and done 29797 004062'01 endif. 29798 29799 004062'01 201 02 0 00 000027 movei t2, .morsp ; "Read Speed" 29800 004063'01 104 00 0 00 000077 MTOPR ; Flag bits are returned in LH(T2) 29801 004064'01 320 12 0 00 004066' ifje. r ;[186] Unless it FAILS 29802 004065'01 254 00 0 00 004074' 29803 004066'01 200 04 0 00 000001 move t4, t1 ;[186] Save the error, could be useful 29804 004067'01 334 00 0 00 000000 %ermsg(,r) 29805 004070'01 254 00 0 00 004074' 29806 004071'01 265 01 0 00 004043* 29807 004072'01 000000000000# 29808 004073'01 254 00 0 00 004045* 29809 002222'04 125 156 141 142 154 29810 004074'01 endif. ;[186] Don't try to process junk--leave 29811 29812 004074'01 573 00 0 00 000003 hrres t3 ; No split speed. 29813 004075'01 321 02 0 00 004102' ifxe. t2, mo%rmt ;[194] Is carrier valid? 29814 004076'01 202 03 0 00 003776* movem t3, speed ; No, it's local, so speed is valid. 29815 004077'01 476 00 0 00 003775* setom carier ; Say local always has carrier 29816 004100'01 263 17 0 00 000000 ret ; Don't have to worry about carrier. 29817 004101'01 254 00 0 00 004103' else. ;[194] Otherwise line is a real dial up 29818 004102'01 476 00 0 00 003774* setom mdmlin ; Yes, flag for SHOW LINE, etc. 29819 004103'01 endif. ;[194] 29820 k20net - Kermit-20 Network Support MACRO %53B(1254)-4 19:42 30-Mar-24 Page 54-1 K20NET MAC 13-Dec-23 21:12 Case of physical line (on a DH or DL) or controlling line 29821 004103'01 332 00 0 00 000000* ifme. setspd ;[161] Was speed NOT explicitly SET for this line? 29822 004104'01 254 00 0 00 004114' 29823 004105'01 336 00 0 00 000000* ifmn. monv ;[194] TOPS-20 V6 or later? 29824 004106'01 254 00 0 00 004111' 29825 004107'01 202 03 0 00 004076* movem t3, speed ; Yes, so we can believe the speed. 29826 004110'01 254 00 0 00 004114' else. ;[194] Otherwise, some kind of geeser (or KS) 29827 004111'01 312 03 0 00 004107* came t3, speed ; Pre-V6. Does this agree with what was set? 29828 004112'01 474 03 0 00 000000 seto t3, ; No, so we don't really know the speed. 29829 004113'01 202 03 0 00 004111* movem t3, speed ; Save the speed or else -1 for don't know. 29830 004114'01 endif. ;[194] 29831 004114'01 endif. ;[194] 29832 29833 004114'01 403 02 0 00 004077* setzb t2, carier ; See if we have carrier. 29834 004115'01 104 00 0 00 000107 RFMOD ; Get mode word. 29835 004116'01 320 12 0 00 004120' %jserr(,r) ;[186] 29836 004117'01 254 00 0 00 004123' 29837 004120'01 265 01 0 00 004071* 29838 004121'01 000000000000# 29839 004122'01 254 00 0 00 004073* 29840 002230'04 125 156 141 142 154 29841 004123'01 602 02 0 00 000001 txne t2, tt%car ; Carrier? 29842 004124'01 476 00 0 00 004114* setom carier ; Yes. 29843 004125'01 263 17 0 00 000000 ret 29844 k20net - Kermit-20 Network Support MACRO %53B(1254)-4 19:42 30-Mar-24 Page 55 K20NET MAC 13-Dec-23 21:12 DECnet Network Remote Terminal Checking 29845 subttl DECnet Network Remote Terminal Checking 29846 29847 004126'01 chkdcn: remark t1, ; Has NRT JFN 29848 004126'01 201 02 0 00 000025 movx t2,.morls ; Function to read link status 29849 004127'01 104 00 0 00 000077 MTOPR% ; Do the status read 29850 004130'01 320 12 0 00 000544' erjmpr decerr ; Handle error, getting it in t1 29851 004131'01 325 03 0 00 004134' ifxn. t3,mo%con ; Connected? 29852 004132'01 476 00 0 00 004124* setom carier ; Yes, everything is still fine 29853 004133'01 254 00 0 00 004135' else. ; Otherwise, the party is OVER 29854 004134'01 402 00 0 00 004132* setzm carier ; So drop 'carrier' 29855 004135'01 endif. ; End case connection check 29856 004135'01 603 03 0 00 002000 txne t3,mo%int ; Any interrupt message goofyness? 29857 004136'01 260 17 0 00 001006' call intmsg ; Yes, handle this oddity 29858 004137'01 263 17 0 00 000000 ret ; Finally get out of here 29859 k20net - Kermit-20 Network Support MACRO %53B(1254)-4 19:42 30-Mar-24 Page 56 K20NET MAC 13-Dec-23 21:12 Pseudo-terminal status, a bit different 29860 subttl Pseudo-terminal status, a bit different 29861 29862 004140'01 chkpty: remark ; Case of PTY: device 29863 29864 repeat 0,< ; Apparently, this isn't true 29865 ifxe. q1, gs%eof ; On a PTY:, EOF is an error condition 29866 setzm carier ; So 'drop' carrier 29867 ret ; and get out of here 29868 else. ; Otherwise, might still be good 29869 setom carier ; So assume OK, for the moment 29870 endif. ; End case GTSTS% analysis for PTY 29871 > 29872 004140'01 336 01 0 00 000000# skipn t1, ttygtb ; Load GETAB% table length and number 29873 004141'01 263 17 0 00 000000 ret ; Unless there is none... 29874 004142'01 504 01 0 00 000000# hrl t1, ptytty ; Load PTY's associated terminal line 29875 004143'01 621 01 0 00 400000 tlz t1, .ttdes ; Just in case (shouldn't be on) 29876 004144'01 104 00 0 00 000010 GETAB% ; Get associated job and 'hunger' 29877 004145'01 320 12 0 00 004122* erjmpr r ; Get and ignore error, returning 29878 004146'01 325 01 0 00 004145* jumpge t1, r ; Still connected? Just return 29879 29880 004147'01 402 00 0 00 004134* setzm carier ; No job there anymore, so 'drop' carrier 29881 004150'01 263 17 0 00 000000 ret ; And get out of here 29882 k20net - Kermit-20 Network Support MACRO %53B(1254)-4 19:42 30-Mar-24 Page 57 K20NET MAC 13-Dec-23 21:12 Check Line JFN 29883 subttl Check Line JFN 29884 29885 ; Call t1/ JFN 29886 ; 29887 ; +1 / JFN is unhealthy in some way 29888 ; +2 / JFN works and is not in error, q1 has GTSTS result 29889 ; 29890 ; Sets 'carier' accordingly 29891 29892 004151'01 265 16 0 00 005675' chkljf: saveac ; Basic JFN health 29893 29894 004152'01 104 00 0 00 000024 GTSTS% ; Get the status of whatever it is 29895 004153'01 320 12 0 00 004155' ifje. r ; Failed?? 29896 004154'01 254 00 0 00 004165' 29897 004155'01 200 04 0 00 000001 move t4, t1 ; Save code for debuggers 29898 004156'01 403 02 0 00 000005 setzb t2, q1 ; Assume we have no carrier. 29899 004157'01 334 00 0 00 000000 %ermsg(,r) 29900 004160'01 254 00 0 00 004164' 29901 004161'01 265 01 0 00 004120* 29902 004162'01 000000000000# 29903 004163'01 254 00 0 00 004146* 29904 002236'04 125 156 141 142 154 29905 004164'01 254 00 0 00 004166' else. ; Otherwise, worked 29906 004165'01 200 05 0 00 000002 move q1, t2 ; So save the JFN's status 29907 004166'01 endif. 29908 29909 004166'01 641 02 0 00 400200 txc t2, gs%nam!gs%opn ; Complement the required bits 29910 004167'01 643 02 0 00 400200 txce t2, gs%nam!gs%opn ; Is it any good at and is it open? 29911 004170'01 263 17 0 00 000000 ret ; No, then there is certainly no carrier 29912 004171'01 603 02 0 00 000400 txne t2,gs%err ; Any kind of error? 29913 004172'01 263 17 0 00 000000 ret ; Yes, we're done 29914 004173'01 476 00 0 00 004147* setom carier ; Groovy, let's say we have 'carrier' 29915 004174'01 254 00 0 00 004054* retskp ; Finally get out of here 29916 k20net - Kermit-20 Network Support MACRO %53B(1254)-4 19:42 30-Mar-24 Page 58 K20NET MAC 13-Dec-23 21:12 Get Network Terminal Information 29917 subttl Get Network Terminal Information 29918 29919 ; NTINF%, which was introduced in 6.0 series Tops-20 and is now known 29920 ; to work in 7.0 series PANDA monitor and XKL. I believe there are 29921 ; also standard patches to the DEC monitor to make it work. 29922 ; 29923 ; Wants a terminal designator in t1 29924 ; 29925 ; Question: does this break for a PIP: JFN? Should it? 29926 ; 29927 ; +1 t1/ Last error code 29928 ; +2 t1/ Line Network Type (zero if not network) 29929 ; t2/ Line Terminal type or protocol 29930 29931 004175'01 getnti: entry getnti ;[194] Inform LINK of our location 29932 004175'01 660 01 0 00 400000 txo t1, .ttdes ;[186] Convert line to a device designator 29933 004176'01 ntidev: remark ;[208] Alternate entry if called with a device id 29934 004176'01 202 01 0 00 000000# movem t1 ,ntiblk+.NWLIN ;[182] Store requested terminal 29935 004177'01 120 01 0 00 005703' dmove t1,[exp ntblen,.NWRRH] ;[182] Requesting remote host information 29936 004200'01 124 01 0 00 000000# dmovem t1,ntiblk+.NWABC ;[182] Store length and request type 29937 004201'01 561 01 0 00 000000# hrroi t1, ntihst ;[186] Point to host area 29938 004202'01 202 01 0 00 000000# movem t1, ntiblk+.NWNNP ;[182] return remote host information 29939 29940 004203'01 403 01 0 00 000002 setzb t1, t2 ;[182] Everything else is zero 29941 004204'01 202 01 0 00 000000* movem t1, tvtflg ;[182] Assume not on a TVT 29942 004205'01 124 01 0 00 000000# dmovem t1, ntihst ;[186] Stomp 20 character DECnet node 29943 004206'01 124 01 0 00 000000# dmovem t1, ntihst+2 ;[186] name (which is impossible) 29944 004207'01 124 01 0 00 000000# dmovem t1,ntiblk+.NWTTF ;[186] Stomp terminal type and flags 29945 004210'01 402 00 0 00 000000# setzm ntiblk+.nwnu1 ;[186] and the node number 29946 29947 004211'01 201 01 0 00 000000# movei t1, ntiblk ;[182] Load the address of the argument block 29948 004212'01 104 00 0 00 000632 NTINF% ;[182] finally try to see out what's going on 29949 004213'01 320 12 0 00 004215' %jserr (,r) ;[186] Phooey, return +1 29950 004214'01 254 00 0 00 004220' 29951 004215'01 265 01 0 00 004161* 29952 004216'01 000000000000# 29953 004217'01 254 00 0 00 004163* 29954 002246'04 116 124 111 116 106 29955 ;[182] Load network type and line type 29956 004220'01 135 01 0 00 005705' ldb t1,[POINTR(,nttype)] 29957 004221'01 135 02 0 00 005706' ldb t2,[POINTR(,ntline)] 29958 004222'01 254 00 0 00 004174* retskp ;[186] Won! 29959 k20net - Kermit-20 Network Support MACRO %53B(1254)-4 19:42 30-Mar-24 Page 59 K20NET MAC 13-Dec-23 21:12 chktvt - check to see if we are using a TVT line 29960 subttl chktvt - check to see if we are using a TVT line 29961 29962 ; We use NTINF% (see above) when the user sets TVT-Binary mode to 29963 ; automatic which is an additional keyword (used to be just on or 29964 ; off). Automatic is the default, but we still allow overide. 29965 ; 29966 ; If the NTINF% fails, then we try recover by using STAT% to 29967 ; indentify whether the line is in the range of TVT's. This should 29968 ; work on any ARPAnet monitor with TCP support; MRC noted that the 29969 ; monitor "requires STAT% to be there" 29970 ; 29971 ; PANDA monitor verified to have 400000,,RSKP in NVTDOD (see [129]) 29972 ; 29973 ; Call: nothing passed 29974 ; 29975 ; Checks to see whether we are in automatic mode and if so, we 29976 ; execute the determination code in some form. Otherwise, we 29977 ; are in override mode and we skip any checks. 29978 ; 29979 ; Return: +1, always (although may complain about Jsyi errors) 29980 ; 29981 ; tvtflg may be side-effected by our (possible lack of) discovery 29982 29983 004223'01 chktvt: entry chktvt ;[194] Inform LINK of our location 29984 extern tvtchk, tvtflg ;[194] And of our necessaries 29985 004223'01 336 00 0 00 000000* skipn tvtchk ;[182] Are we supposed to figure out if TVT? 29986 004224'01 263 17 0 00 000000 ret ;[182] No, so skip all this cruft 29987 29988 004225'01 402 00 0 00 004204* setzm tvtflg ;[194] Stompt TVT flag because not known, yet 29989 004226'01 260 17 0 00 004175' call getnti ;[186] Get network terminal information 29990 004227'01 254 00 0 00 004235' jrst bbntvt ;[186] Try it the old fashioned way 29991 004230'01 306 01 0 00 000001 cain t1, NW%TCP ;[182] Is the network type NOT TCP? 29992 004231'01 302 02 0 00 000004 caie t2, NW%TV ;[182] or is this NOT a TVT? 29993 004232'01 263 17 0 00 000000 ret ;[182] Leave line set as not a TVT 29994 004233'01 350 00 0 00 004225* aos tvtflg ;[182] Okay, set TVT-BInary to ON 29995 004234'01 263 17 0 00 000000 ret ;[182] 29996 k20net - Kermit-20 Network Support MACRO %53B(1254)-4 19:42 30-Mar-24 Page 60 K20NET MAC 13-Dec-23 21:12 Check for TVT line using BBN interface 29997 subttl Check for TVT line using BBN interface 29998 29999 ; The following code is not used because a BBN TCP jsys is called. 30000 ; It is fall-back because NTINF% is preferred. However, it should 30001 ; always work, no matter the monitor version. 30002 ; 30003 ; [129] Largely adapted from MODEM.MAC 30004 30005 004235'01 bbntvt: extern ttynum ;[194] Inform LINK of our necessary 30006 004235'01 205 01 0 00 000040 movx t1, tcp%nt ;[129] Want aobjn ptr for tvts 30007 004236'01 104 00 0 00 000745 STAT% ;[129] Get it 30008 004237'01 320 12 0 00 004241' %jserr (,r) ;[182] Just give up 30009 004240'01 254 00 0 00 004244' 30010 004241'01 265 01 0 00 004215* 30011 004242'01 000000000000# 30012 004243'01 254 00 0 00 004217* 30013 002251'04 123 124 101 124 040 30014 004244'01 550 03 0 00 003666* hrrz t3, ttynum ;[129] TTY line we're useing 30015 004245'01 550 01 0 00 000002 hrrz t1, t2 ;[129] Get first TVT 30016 004246'01 315 03 0 00 000001 camge t3, t1 ;[129] Are we less than the firsT? 30017 004247'01 263 17 0 00 000000 ret ;[182] Yes 30018 004250'01 577 00 0 00 000002 hlres t2 ;[129] Calculate last TVT 30019 004251'01 274 01 0 00 000002 sub t1, t2 ;[129] ... 30020 004252'01 275 01 0 00 000001 subi t1, 1 ;[129] ... 30021 004253'01 317 03 0 00 000001 camg t3, t1 ;[129] Are we .le. last TVT? 30022 004254'01 350 00 0 00 004233* aos tvtflg ;[182] Yes, flag for later 30023 004255'01 263 17 0 00 000000 ret ;[182] 30024 k20net - Kermit-20 Network Support MACRO %53B(1254)-4 19:42 30-Mar-24 Page 61 K20NET MAC 13-Dec-23 21:12 Line routines 30025 subttl Line routines 30026 30027 ;[190] all moved from K20MIT to reduce its size 30028 30029 ; INILIN -- Initialize the communication line for file transfer. 30030 ; 30031 004256'01 inilin: entry inilin ;[220] Used in k20srv, too 30032 004256'01 332 00 0 00 000000# skipe inited ;[177] Already init'd? Don't do it again. 30033 004257'01 263 17 0 00 000000 ret ;[177] 30034 30035 ; Set all the terminal mode bits for transparent i/o. 30036 30037 004260'01 332 00 0 00 003771* inil2: ifme. vtermf ;[186] Physical line? 30038 004261'01 254 00 0 00 004265' 30039 004262'01 260 17 0 00 004271' call dobits ; Go do the bits. 30040 004263'01 263 17 0 00 000000 ret ; Pass along any failures. 30041 004264'01 260 17 0 00 004525' call doarpa ; Set up any Arpanet stuff. 30042 004265'01 endif. 30043 30044 004265'01 260 17 0 00 002423' call clrbuf ;[194] Clear any NAK's 30045 004266'01 600 00 0 00 000000 nop ;[186] Ignore any errors 30046 004267'01 476 00 0 00 000000# setom inited ;[177] Flag we've done this. 30047 004270'01 263 17 0 00 000000 ret k20net - Kermit-20 Network Support MACRO %53B(1254)-4 19:42 30-Mar-24 Page 62 K20NET MAC 13-Dec-23 21:12 Line routines 30048 30049 ; Set communication line bits for transparent i/o. 30050 ; Returns +1 on failure, +2 on success. 30051 30052 004271'01 dobits: entry dobits ;Used by k20ioc 30053 004271'01 265 16 0 00 005331' saveac ;[186] Used for device designator 30054 004272'01 332 05 0 00 003720* skipe q1, netjfn ;[186] Load the network JFN 30055 004273'01 254 00 0 00 004310' ifskp. ;[186] Unless we don't have one... 30056 004274'01 332 00 0 00 003756* skipe local ;[186] Are we remote? 30057 004275'01 334 01 0 00 000000# ermsg% (,r) ;[186] Just punt 30058 004276'01 254 00 0 00 004302' 30059 004277'01 202 01 0 00 004030* 30060 004300'01 104 00 0 00 000313 30061 004301'01 254 00 0 00 004243* 30062 000226'03 000000000000# 30063 002254'04 113 105 122 115 111 30064 30065 004302'01 336 05 0 00 002777* skipn q1, ttyjfn ;[186] Yes, so just use the terminal JFN 30066 004303'01 334 01 0 00 000000# ermsg% (,r) ;[186] 30067 004304'01 254 00 0 00 004310' 30068 004305'01 202 01 0 00 004277* 30069 004306'01 104 00 0 00 000313 30070 004307'01 254 00 0 00 004301* 30071 000227'03 000000000000# 30072 002270'04 113 105 122 115 111 30073 30074 004310'01 endif. ;[186] Hopefully have SOMETHING ... 30075 30076 004310'01 200 01 0 00 000005 move t1, q1 ;[186] ; JFN for connection to other system. 30077 004311'01 201 02 0 00 000035 movx t2, .mornt ; Read system message status. 30078 004312'01 104 00 0 00 000077 MTOPR 30079 004313'01 320 12 0 00 004315' %jserr (,dobit2) 30080 004314'01 254 00 0 00 004320' 30081 004315'01 265 01 0 00 004241* 30082 004316'01 000000 000000 30083 004317'01 254 00 0 00 004331' 30084 004320'01 202 03 0 00 000000# movem t3, sysmsg ; Save here for later restoral. 30085 004321'01 201 02 0 00 000034 movx t2, .mosnt ; Now refuse system messages. 30086 004322'01 201 03 0 00 000001 movx t3, .mosmn 30087 004323'01 104 00 0 00 000077 MTOPR 30088 004324'01 320 12 0 00 004326' %jserr (,dobit2) 30089 004325'01 254 00 0 00 004331' 30090 004326'01 265 01 0 00 004315* 30091 004327'01 000000 000000 30092 004330'01 254 00 0 00 004331' 30093 30094 004331'01 205 01 0 00 624000 dobit2: movx t1, ;[147] Clear/Refuse links, 30095 004332'01 540 01 0 00 004244* hrr t1, ttynum ;[147] on the line used for file transfer. 30096 004333'01 660 01 0 00 400000 txo t1, .ttdes ;[147] (TLINK wants a device designator.) 30097 004334'01 474 02 0 00 000000 seto t2, 30098 004335'01 104 00 0 00 000216 TLINK 30099 004336'01 320 16 0 00 004337' erjmp dobit3 ;[147] Ignore any failure. 30100 30101 004337'01 200 01 0 00 000005 dobit3: move t1, q1 ;[186] ; JFN for the file transfer line. 30102 004340'01 201 02 0 00 000044 movei t2, .morxo ; Get terminal pause end-of-page status. k20net - Kermit-20 Network Support MACRO %53B(1254)-4 19:42 30-Mar-24 Page 62-1 K20NET MAC 13-Dec-23 21:12 Line routines 30103 004341'01 104 00 0 00 000077 MTOPR% 30104 004342'01 320 12 0 00 004344' %jserr (,r) 30105 004343'01 254 00 0 00 004347' 30106 004344'01 265 01 0 00 004326* 30107 004345'01 000000 000000 30108 004346'01 254 00 0 00 004307* 30109 004347'01 202 03 0 00 000000# movem t3, oldpau ; Save the old pause mode. 30110 004350'01 201 02 0 00 000043 movei t2, .moxof ; Now set to... 30111 004351'01 201 03 0 00 000000 movei t3, .mooff ; no pause on end. 30112 004352'01 104 00 0 00 000077 MTOPR% 30113 004353'01 320 12 0 00 004355' %jserr (,r) 30114 004354'01 254 00 0 00 004360' 30115 004355'01 265 01 0 00 004344* 30116 004356'01 000000 000000 30117 004357'01 254 00 0 00 004346* 30118 004360'01 201 02 0 00 000000# movei t2, olddim ;[185] Point to line block 30119 004361'01 260 17 0 00 000000* call savlnw ;[185] Save this JFN's length and width 30120 004362'01 104 00 0 00 000107 RFMOD% ; Get current mode for this line. 30121 004363'01 320 12 0 00 004365' %jserr (,r) 30122 004364'01 254 00 0 00 004370' 30123 004365'01 265 01 0 00 004355* 30124 004366'01 000000 000000 30125 004367'01 254 00 0 00 004357* 30126 004370'01 476 00 0 00 004173* setom carier 30127 004371'01 402 00 0 00 004102* setzm mdmlin ;[130] Assume line not modem-controlled. 30128 004372'01 602 02 0 00 000001 txne t2, tt%car ;[130] Is it? 30129 004373'01 476 00 0 00 004371* setom mdmlin ;[130] Yes, flag. 30130 004374'01 202 02 0 00 000000# movem t2, oldmod ; Save the present mode. 30131 30132 ;[97] Turn off undesired bits (program echoing, links, translation). 30133 ;[97] Turn on desired bits (full duplex; TTY has form feed, tab, lowercase). 30134 ;[97] Note that any other settings are left intact, in particular TT%ECM, which 30135 ;[97] can cause a TAC to do its own echoing if turned off. 30136 30137 004375'01 dobit4: ; No echo, no links, no advice, no data mode, full duplex. 30138 004375'01 620 02 0 00 005734 txz t2, ;[129] Add TT$DUM 30139 ; No wakeup stuff, infinite width & length. 30140 004376'01 630 02 0 00 005707' txz t2, ;[127] 30141 ; No formfeed/tab/case interpretation, use XON/XOFF. 30142 004377'01 670 02 0 00 005710' txo t2, ;[129] REMOVE TT%DUM!!! 30143 30144 004400'01 336 00 0 00 000000* skipn handsh ;[155] Doing handshake? 30145 004401'01 336 00 0 00 003532* skipn flow ;[155] Doing flow control? 30146 004402'01 620 02 0 00 000002 txz t2, tt%pgm ; Handshake, or no flow - don't do XON/XOFF. 30147 004403'01 104 00 0 00 000110 SFMOD% ; Set the bits. 30148 004404'01 320 12 0 00 004406' %jserr (,) 30149 004405'01 254 00 0 00 004411' 30150 004406'01 265 01 0 00 004365* 30151 004407'01 000000 000000 30152 004410'01 254 00 0 00 004411' 30153 004411'01 104 00 0 00 000217 STPAR% 30154 004412'01 320 12 0 00 004414' %jserr (,) 30155 004413'01 254 00 0 00 004417' 30156 004414'01 265 01 0 00 004406* 30157 004415'01 000000 000000 k20net - Kermit-20 Network Support MACRO %53B(1254)-4 19:42 30-Mar-24 Page 62-2 K20NET MAC 13-Dec-23 21:12 Line routines 30158 004416'01 254 00 0 00 004417' 30159 004417'01 254 00 0 00 004222* retskp k20net - Kermit-20 Network Support MACRO %53B(1254)-4 19:42 30-Mar-24 Page 63 K20NET MAC 13-Dec-23 21:12 Line routines 30160 30161 ;[181] PANDA Network Binary Mode routines 30162 30163 panda < ;[181] Only if doing Panda 30164 30165 ;[181] Returns true if we have network binary mode MTOPR% 30166 ;[181] Preserves ACs, always returns +1, havnbm: is side-effected 30167 30168 004420'01 chknbm: entry chknbm ;[190] 30169 004420'01 265 16 0 00 005711' saveac ;[181] Save the registers that MTOPR% trashes 30170 004421'01 120 01 0 00 005723' dmove t1,[ exp .CTTRM,.MORLT ] ;[181] Read local status 30171 004422'01 104 00 0 00 000077 MTOPR% ;[181] Can the monitor process this request? 30172 004423'01 320 12 0 00 004425' ifje. r ;[194] No, assume this isn't in the monitor 30173 004424'01 254 00 0 00 004430' 30174 004425'01 402 00 0 00 000000# setzm havnbm ;[181] so don't try to use it 30175 004426'01 402 00 0 00 000000# setzm setlts ;[181] and never try to restore status 30176 004427'01 254 00 0 00 004431' else. ;[194] 30177 004430'01 476 00 0 00 000000# setom havnbm ;[181] Otherwise, we have winning 30178 004431'01 endif. ;[194] 30179 004431'01 263 17 0 00 000000 ret ;[181] Panda Network Binary Mode! 30180 30181 ;[181] Sets network binary mode 30182 ;[181] Assumes it can stomp acumulators t1 through t3 30183 ;[181] Returns to doarpa's caller on success 30184 ;[181] on failure, assumes we don't have network binary mode, 30185 ;[181] clears the flag and tries it the old way 30186 30187 004432'01 332 00 0 00 000000# setnbm: skipe setlts ;[181] Did we already sucessfully set this? 30188 004433'01 263 17 0 00 000000 ret ;[181] Yes, why bother doing it twice? 30189 30190 004434'01 332 01 0 00 004272* skipe t1, netjfn ;[186] Load the network JFN 30191 004435'01 254 00 0 00 004452' ifskp. ;[186] Unless we don't have one... 30192 004436'01 332 00 0 00 004274* skipe local ;[186] Are we remote? 30193 004437'01 334 01 0 00 000000# ermsg% (,r) ;[186] Just punt 30194 004440'01 254 00 0 00 004444' 30195 004441'01 202 01 0 00 004305* 30196 004442'01 104 00 0 00 000313 30197 004443'01 254 00 0 00 004367* 30198 000230'03 000000000000# 30199 002305'04 113 105 122 115 111 30200 30201 004444'01 336 01 0 00 004302* skipn t1, ttyjfn ;[186] Yes, so just use the terminal JFN 30202 004445'01 334 01 0 00 000000# ermsg% (,r) ;[186] 30203 004446'01 254 00 0 00 004452' 30204 004447'01 202 01 0 00 004441* 30205 004450'01 104 00 0 00 000313 30206 004451'01 254 00 0 00 004443* 30207 000231'03 000000000000# 30208 002321'04 113 105 122 115 111 30209 30210 004452'01 endif. ;[186] Hopefully have SOMETHING ... 30211 30212 004452'01 201 02 0 00 400001 movx t2,.MORLT ;[181] Read local status 30213 004453'01 104 00 0 00 000077 MTOPR% 30214 004454'01 320 16 0 00 004472' erjmp nbmerr k20net - Kermit-20 Network Support MACRO %53B(1254)-4 19:42 30-Mar-24 Page 63-1 K20NET MAC 13-Dec-23 21:12 Line routines 30215 004455'01 202 03 0 00 000000# movem t3,OLDLTS ;[181] save old terminal status 30216 004456'01 660 03 0 00 000006 txo t3,MO%NBI!MO%NBO ;[181] network binary mode (input AND output) 30217 004457'01 201 02 0 00 400002 movx t2,.MOSLT ;[181] want to set it 30218 004460'01 104 00 0 00 000077 MTOPR% 30219 004461'01 320 16 0 00 004472' erjmp nbmerr 30220 004462'01 201 02 0 00 400001 movx t2,.MORLT ;[181] now see what actually happened 30221 004463'01 104 00 0 00 000077 MTOPR% 30222 004464'01 320 16 0 00 004472' erjmp nbmerr 30223 004465'01 640 03 0 00 000006 xorx t3,MO%NBI!MO%NBO ;[181] flip binary mode status 30224 004466'01 602 03 0 00 000006 txne t3,MO%NBI!MO%NBO ;[181] they should have been BOTH set ... 30225 004467'01 254 00 0 00 004472' jrst nbmerr 30226 004470'01 350 00 0 00 000000# aos setlts ;[181] flag that we set terminal line status 30227 004471'01 263 17 0 00 000000 ret 30228 30229 004472'01 402 00 0 00 000000# nbmerr: setzm havnbm ;[181] We don't have network binary mode 30230 004473'01 254 00 0 00 004525' callret doarpa ;[181] Maybe the olde fashioned way works? 30231 30232 30233 ;[181] un-Sets network binary mode 30234 ;[181] Assumes it can stomp acumulators t1 through t3 30235 ;[181] Returns to unarpa's caller on success 30236 ;[181] on failure, assumes we don't have network binary mode, 30237 ;[181] clears the flag and tries it the old way 30238 30239 004474'01 400 01 0 00 000000 unsnbm: setz t1, ;[181] whatever the current state is, 30240 004475'01 250 01 0 00 000000# exch t1,setlts ;[181] say that it is no longer set 30241 004476'01 322 01 0 00 004451* jumpe t1,r ;[181] However: did we ever set nbm?? 30242 30243 004477'01 332 01 0 00 004434* skipe t1, netjfn ;[186] Load the network JFN 30244 004500'01 254 00 0 00 004515' ifskp. ;[186] Unless we don't have one... 30245 004501'01 332 00 0 00 004436* skipe local ;[186] Are we remote? 30246 004502'01 334 01 0 00 000000# ermsg% (,r) ;[186] Just punt 30247 004503'01 254 00 0 00 004507' 30248 004504'01 202 01 0 00 004447* 30249 004505'01 104 00 0 00 000313 30250 004506'01 254 00 0 00 004476* 30251 000232'03 000000000000# 30252 002336'04 113 105 122 115 111 30253 30254 004507'01 336 01 0 00 004444* skipn t1, ttyjfn ;[186] Yes, so just use the terminal JFN 30255 004510'01 334 01 0 00 000000# ermsg% (,r) ;[186] 30256 004511'01 254 00 0 00 004515' 30257 004512'01 202 01 0 00 004504* 30258 004513'01 104 00 0 00 000313 30259 004514'01 254 00 0 00 004506* 30260 000233'03 000000000000# 30261 002352'04 113 105 122 115 111 30262 30263 004515'01 endif. ;[186] Hopefully have SOMETHING ... 30264 30265 004515'01 201 02 0 00 400002 movx t2,.MOSLT ;[181] Read local status 30266 004516'01 200 03 0 00 000000# move t3,OLDLTS ;[181] get former status 30267 004517'01 104 00 0 00 000077 MTOPR% ;[181] try to restore it 30268 004520'01 320 12 0 00 004522' ifje. r ;[194] Failed, don't use this any longer 30269 004521'01 254 00 0 00 004524' k20net - Kermit-20 Network Support MACRO %53B(1254)-4 19:42 30-Mar-24 Page 63-2 K20NET MAC 13-Dec-23 21:12 Line routines 30270 004522'01 402 00 0 00 000000# setzm havnbm ;[181] How could this have failed? 30271 004523'01 254 00 0 00 004722' callret unarpa ;[196] Get out of here and turn some more 30272 004524'01 endif. ;[196] things off 30273 004524'01 263 17 0 00 000000 ret 30274 30275 > ;[181] End Panda conditional 30276 ;[129] Do any required ARPAnet stuff. 30277 ; 30278 ; Important Note: The ability to send binary mode telnet negotiations 30279 ; depends on the monitor NOT doubling IACs on TVT lines. Some versions of 30280 ; TOPS-20 (particularly BBN's TCP monitor) will do this. 30281 ; 30282 ;[181] Use SOUTR% instead of SOUT% to ensure that 30283 ;[181] we flush the data to the TAC 30284 ; 30285 ; Returns +1 always, but prints warning on failure. 30286 ; 30287 004525'01 doarpa: entry doarpa ;[190] 30288 004525'01 336 00 0 00 004254* skipn tvtflg ; Are we on tvt? 30289 004526'01 263 17 0 00 000000 ret 30290 30291 004527'01 332 00 0 00 000000# panda < skipe havnbm ;[181] Does the monitor support network 30292 004530'01 254 00 0 00 004432' callret setnbm > ;[181] binary mode? 30293 30294 004531'01 265 16 0 00 005331' saveac ;[186] Used for device designator 30295 004532'01 332 05 0 00 004477* skipe q1, netjfn ;[186] Load the network JFN 30296 004533'01 254 00 0 00 004550' ifskp. ;[186] Unless we don't have one... 30297 004534'01 332 00 0 00 004501* skipe local ;[186] Are we remote? 30298 004535'01 334 01 0 00 000000# ermsg% (,r) ;[186] Just punt 30299 004536'01 254 00 0 00 004542' 30300 004537'01 202 01 0 00 004512* 30301 004540'01 104 00 0 00 000313 30302 004541'01 254 00 0 00 004514* 30303 000234'03 000000000000# 30304 002367'04 113 105 122 115 111 30305 30306 004542'01 336 05 0 00 004507* skipn q1, ttyjfn ;[186] Yes, so just use the terminal JFN 30307 004543'01 334 01 0 00 000000# ermsg% (,r) ;[186] 30308 004544'01 254 00 0 00 004550' 30309 004545'01 202 01 0 00 004537* 30310 004546'01 104 00 0 00 000313 30311 004547'01 254 00 0 00 004541* 30312 000235'03 000000000000# 30313 002403'04 113 105 122 115 111 30314 30315 004550'01 endif. ;[186] Hopefully have SOMETHING ... 30316 30317 004550'01 200 01 0 00 000005 move t1, q1 ;[186] ; Yes, talk binary. 30318 004551'01 120 02 0 00 005726' dmove t2,[exp ,-3] 30319 004552'01 104 00 0 00 000532 SOUTR% ;[181] This code adapted from MODEM.MAC 30320 004553'01 320 12 0 00 004555' %jserr(,doarpx) 30321 004554'01 254 00 0 00 004560' 30322 004555'01 265 01 0 00 004414* 30323 004556'01 000000 000000 30324 004557'01 254 00 0 00 004575' k20net - Kermit-20 Network Support MACRO %53B(1254)-4 19:42 30-Mar-24 Page 63-3 K20NET MAC 13-Dec-23 21:12 Line routines 30325 004560'01 201 01 0 00 007640 movei t1,^d4000 ; Sleep four seconds. 30326 004561'01 104 00 0 00 000167 DISMS% 30327 004562'01 200 01 0 00 000005 move t1, q1 ;[186] Tell TVT "do binary". 30328 004563'01 120 02 0 00 005731' dmove t2,[exp ,-3] 30329 004564'01 104 00 0 00 000532 SOUTR% 30330 004565'01 320 12 0 00 004567' %jserr(,doarpx) 30331 004566'01 254 00 0 00 004572' 30332 004567'01 265 01 0 00 004555* 30333 004570'01 000000 000000 30334 004571'01 254 00 0 00 004575' 30335 004572'01 201 01 0 00 007640 movei t1,^d4000 30336 004573'01 104 00 0 00 000167 DISMS 30337 004574'01 263 17 0 00 000000 ret 30338 30339 doarpx: txmsg < 30340 %KERMIT-20: Warning -- Can't negotiate binary mode with TAC 30341 004575'01 200 01 0 00 000000# > 30342 004576'01 104 00 0 00 000076 30343 004577'01 320 12 0 00 004600' 30344 000236'03 000000000000# 30345 002420'04 015 012 045 113 105 30346 30347 004600'01 263 17 0 00 000000 ret k20net - Kermit-20 Network Support MACRO %53B(1254)-4 19:42 30-Mar-24 Page 64 K20NET MAC 13-Dec-23 21:12 Line routines 30348 30349 ; RESLIN -- Reset/Restore the communications line. 30350 ; 30351 ; Restore old terminal modes, links, length & width, etc. 30352 ; Turn off control-C trap. 30353 ; 30354 ; CALL RESLIN does nothing if server. 30355 ; CALL RRSLIN restores the line even if server. 30356 30357 extern filjfn ;[190] 30358 30359 004601'01 reslin: entry reslin ;[190] 30360 004601'01 332 00 0 00 000000* skipe srvflg ; Server? 30361 004602'01 263 17 0 00 000000 ret ; Yes, forget it. 30362 30363 004603'01 rrslin: entry rrslin ;[220] Used by k20srv 30364 004603'01 260 17 0 00 000450* call ccoff2 ; REALLY reset the line. 30365 004604'01 rrsl2: entry rrsl2 ;[220] Used by k20srv 30366 004604'01 337 01 0 00 000000* skipg t1, filjfn ; Were we doing something with a file? 30367 004605'01 254 00 0 00 004613' ifskp. ;[194] Maybe so 30368 004606'01 621 01 0 00 777777 tlz t1, -1 ;[193] Just carefully toss any flags 30369 004607'01 306 01 0 00 377777 cain t1, .nulio ;[193] Not needed for NUL: 30370 004610'01 254 00 0 00 004613' anskp. ;[193] So bum the CLOSF 30371 004611'01 104 00 0 00 000022 CLOSF 30372 004612'01 320 12 0 00 004613' erjmpr .+1 ;[193] Catch and ignore error 30373 004613'01 endif. ;[194] 30374 004613'01 402 00 0 00 004604* setzm filjfn ;[194] Either way, no file 30375 30376 004614'01 332 00 0 00 004260* ifme. vtermf ;[186] Physical line? 30377 004615'01 254 00 0 00 004621' 30378 004616'01 260 17 0 00 004722' call unarpa ; Undo Arpanet TAC binary mode. 30379 004617'01 260 17 0 00 004625' call unbits ; Restore terminal bits. 30380 004620'01 260 17 0 00 002764' call ttxon ; Clear up any XOFF condition. 30381 004621'01 endif. ;[186] 30382 30383 004621'01 260 17 0 00 002423' call clrbuf ;[194] Clear terminal buffers 30384 004622'01 600 00 0 00 000000 nop ;[186] Ignore any failure 30385 004623'01 402 00 0 00 000000# setzm inited ;[177] Flag we're back to normal. 30386 004624'01 263 17 0 00 000000 ret k20net - Kermit-20 Network Support MACRO %53B(1254)-4 19:42 30-Mar-24 Page 65 K20NET MAC 13-Dec-23 21:12 Line routines 30387 30388 ; Undo the effect of DOBITS -- restore all the communication line's 30389 ; old bits & modes. 30390 ; 30391 004625'01 unbits: entry unbits ;Used by K20IOC 30392 004625'01 265 16 0 00 005331' saveac ;[186] Used for device designator 30393 004626'01 332 05 0 00 004532* skipe q1, netjfn ;[186] Load the network JFN 30394 004627'01 254 00 0 00 004644' ifskp. ;[186] Unless we don't have one... 30395 004630'01 332 00 0 00 004534* skipe local ;[186] Are we remote? 30396 004631'01 334 01 0 00 000000# ermsg% (,r) ;[186] Just punt 30397 004632'01 254 00 0 00 004636' 30398 004633'01 202 01 0 00 004545* 30399 004634'01 104 00 0 00 000313 30400 004635'01 254 00 0 00 004547* 30401 000237'03 000000000000# 30402 002435'04 113 105 122 115 111 30403 30404 004636'01 336 05 0 00 004542* skipn q1, ttyjfn ;[186] Yes, so just use the terminal JFN 30405 004637'01 334 01 0 00 000000# ermsg% (,r) ;[186] 30406 004640'01 254 00 0 00 004644' 30407 004641'01 202 01 0 00 004633* 30408 004642'01 104 00 0 00 000313 30409 004643'01 254 00 0 00 004635* 30410 000240'03 000000000000# 30411 002451'04 113 105 122 115 111 30412 30413 004644'01 endif. ;[186] Hopefully have SOMETHING ... 30414 30415 004644'01 200 01 0 00 000005 move t1, q1 ;[186] ; Get the line. 30416 004645'01 201 02 0 00 000043 movei t2, .moxof ; Set the terminal pause on end mode... 30417 004646'01 200 03 0 00 000000# move t3, oldpau ; to what it was before. 30418 004647'01 104 00 0 00 000077 MTOPR% 30419 004650'01 320 12 0 00 004652' %jserr (,) 30420 004651'01 254 00 0 00 004655' 30421 004652'01 265 01 0 00 004567* 30422 004653'01 000000 000000 30423 004654'01 254 00 0 00 004655' 30424 004655'01 200 01 0 00 000005 move t1, q1 ;[186] ; Communication line JFN. 30425 004656'01 200 02 0 00 000000# move t2, oldmod ; Get the previous mode. 30426 004657'01 104 00 0 00 000110 SFMOD% 30427 004660'01 320 12 0 00 004662' %jserr (,) 30428 004661'01 254 00 0 00 004665' 30429 004662'01 265 01 0 00 004652* 30430 004663'01 000000 000000 30431 004664'01 254 00 0 00 004665' 30432 004665'01 104 00 0 00 000217 STPAR% 30433 004666'01 320 12 0 00 004670' %jserr (,) 30434 004667'01 254 00 0 00 004673' 30435 004670'01 265 01 0 00 004662* 30436 004671'01 000000 000000 30437 004672'01 254 00 0 00 004673' 30438 004673'01 201 02 0 00 000000# movei t2, olddim ;[185] Point to this JFN's dimensions 30439 004674'01 260 17 0 00 000000* call rstlnw ;[185] Restore length and width 30440 004675'01 201 02 0 00 000034 movx t2, .mosnt ; Restore system msg refuse/accept. 30441 004676'01 200 03 0 00 000000# move t3, sysmsg k20net - Kermit-20 Network Support MACRO %53B(1254)-4 19:42 30-Mar-24 Page 65-1 K20NET MAC 13-Dec-23 21:12 Line routines 30442 004677'01 104 00 0 00 000077 MTOPR 30443 004700'01 320 12 0 00 004702' %jserr (,) 30444 004701'01 254 00 0 00 004705' 30445 004702'01 265 01 0 00 004670* 30446 004703'01 000000 000000 30447 004704'01 254 00 0 00 004705' 30448 30449 ; Restore links and advice if necessary. 30450 30451 004705'01 400 01 0 00 000000 setz t1, ; Restore links & advice. 30452 004706'01 200 02 0 00 000000# move t2, oldmod ; From old tty mode word. 30453 004707'01 602 02 0 00 001000 txne t2, tt%alk ; Was receiving links before? 30454 004710'01 661 01 0 00 030000 txo t1, ; Yes, so receive links. 30455 004711'01 602 02 0 00 000400 txne t2, tt%aad ; Was receiving advice before? 30456 004712'01 661 01 0 00 006000 txo t1, ; Yes, so receive links. 30457 004713'01 322 01 0 00 004643* jumpe t1, r ; Skip to next part if no bits to set. 30458 004714'01 540 01 0 00 004332* hrr t1, ttynum ; Must set bits, form tty designator 30459 004715'01 660 01 0 00 400000 txo t1, .ttdes ; ... 30460 004716'01 400 02 0 00 000000 setz t2, ; Don't leave garbage in here... 30461 004717'01 104 00 0 00 000216 TLINK ; Restore the settings. 30462 004720'01 320 16 0 00 004721' erjmp .+1 ; Ignore any errors. 30463 004721'01 263 17 0 00 000000 ret k20net - Kermit-20 Network Support MACRO %53B(1254)-4 19:42 30-Mar-24 Page 66 K20NET MAC 13-Dec-23 21:12 Line routines 30464 30465 ; Turn off Arpanet TAC binary mode. 30466 30467 004722'01 336 00 0 00 004525* unarpa: skipn tvtflg ; Are we on a tvt? 30468 004723'01 263 17 0 00 000000 ret ; No, skip this. 30469 30470 004724'01 332 00 0 00 000000# panda < skipe havnbm ;[181] Does the monitor support network 30471 004725'01 254 00 0 00 004474' callret unsnbm > ;[181] binary mode? 30472 30473 004726'01 265 16 0 00 005331' saveac ;[186] Used for device designator 30474 004727'01 332 05 0 00 004626* skipe q1, netjfn ;[186] Load the network JFN 30475 004730'01 254 00 0 00 004745' ifskp. ;[186] Unless we don't have one... 30476 004731'01 332 00 0 00 004630* skipe local ;[186] Are we remote? 30477 004732'01 334 01 0 00 000000# ermsg% (,r) ;[186] Just punt 30478 004733'01 254 00 0 00 004737' 30479 004734'01 202 01 0 00 004641* 30480 004735'01 104 00 0 00 000313 30481 004736'01 254 00 0 00 004713* 30482 000241'03 000000000000# 30483 002466'04 113 105 122 115 111 30484 30485 004737'01 336 05 0 00 004636* skipn q1, ttyjfn ;[186] Yes, so just use the terminal JFN 30486 004740'01 334 01 0 00 000000# ermsg% (,r) ;[186] 30487 004741'01 254 00 0 00 004745' 30488 004742'01 202 01 0 00 004734* 30489 004743'01 104 00 0 00 000313 30490 004744'01 254 00 0 00 004736* 30491 000242'03 000000000000# 30492 002502'04 113 105 122 115 111 30493 30494 004745'01 endif. ;[186] Hopefully have SOMETHING ... 30495 30496 004745'01 200 01 0 00 000005 move t1, q1 ;[186] ;[181] Get the line. 30497 004746'01 120 02 0 00 005734' dmove t2, [exp ,-3] 30498 004747'01 104 00 0 00 000053 SOUT% ; Yes, turn off binary mode. 30499 004750'01 320 12 0 00 004752' %jserr(,unarpx) 30500 004751'01 254 00 0 00 004755' 30501 004752'01 265 01 0 00 004702* 30502 004753'01 000000 000000 30503 004754'01 254 00 0 00 004772' 30504 004755'01 201 01 0 00 007640 movei t1, ^d4000 ; Wait 4 secs. 30505 004756'01 104 00 0 00 000167 DISMS% 30506 004757'01 200 01 0 00 000005 move t1, q1 ;[186] ; Send the command. 30507 004760'01 120 02 0 00 005737' dmove t2, [exp ,-3] 30508 004761'01 104 00 0 00 000053 SOUT% 30509 004762'01 320 12 0 00 004764' %jserr(,unarpx) 30510 004763'01 254 00 0 00 004767' 30511 004764'01 265 01 0 00 004752* 30512 004765'01 000000 000000 30513 004766'01 254 00 0 00 004772' 30514 004767'01 201 01 0 00 007640 movei t1, ^d4000 ; Wait another 4 secs. 30515 004770'01 104 00 0 00 000167 DISMS% 30516 004771'01 263 17 0 00 000000 ret ; Done. 30517 30518 unarpx: txmsg < k20net - Kermit-20 Network Support MACRO %53B(1254)-4 19:42 30-Mar-24 Page 66-1 K20NET MAC 13-Dec-23 21:12 Line routines 30519 %KERMIT-20: Warning -- Can't clear binary mode with TAC 30520 004772'01 200 01 0 00 000000# > ;[129] Error message for any of the above. 30521 004773'01 104 00 0 00 000076 30522 004774'01 320 12 0 00 004775' 30523 000243'03 000000000000# 30524 002517'04 015 012 045 113 105 30525 30526 30527 004775'01 263 17 0 00 000000 ret ;[129] And return 30528 k20net - Kermit-20 Network Support MACRO %53B(1254)-4 19:42 30-Mar-24 Page 67 K20NET MAC 13-Dec-23 21:12 Get Network Device Status 30529 subttl Get Network Device Status 30530 30531 ;[223] Begin Code Insertion 30532 ; 30533 ; N.B., Be aware that the result of GDSTS% has to be CAREFULLY checked 30534 ; because it may not throw an error, even when followed by an 30535 ; ERJMP! In certain error scenarios, the process's last error may 30536 ; not be changed, so messing around with a before-SETER% / after- 30537 ; GETER% won't catch the problem, either. We carefully check for 30538 ; such a situation and, if detected, set the process's last error 30539 ; appropriately. Sigh... 30540 ; 30541 ; On klh10, the only line currently known to tolerate parity is the CTY. 30542 ; On a PANDA monitor, PTY's will do parity 30543 ; 30544 ; Call: 30545 ; 30546 ; t1/ JFN on device (assumed opened in 8 bit mode) 30547 ; 30548 ; *OR* 30549 ; 30550 ; t1/ .ttdes+line number 30551 ; 30552 ; Returns: 30553 ; 30554 ; +1/ Some kind of bad 30555 ; +2/ Worked 30556 ; t1/ JFN, always 30557 ; t2/ Device-dependent status bits [If device supported GDSTS%] 30558 ; t3/ Device-dependent information [If device supported GDSTS%] 30559 ; t4/ Possible GDSTS% error 30560 30561 004776'01 gndpar: entry gndpar ; Also called from k20sub 30562 004776'01 265 16 0 00 005741' saveac ; Needs some extra registers 30563 30564 004777'01 200 05 0 00 000001 move q1, t1 ; Save JFN and any flags (which we don't use) 30565 005000'01 400 11 0 00 000000 setz q5, ; Second JFN on line 30566 30567 005001'01 606 05 0 00 400000 ifxn. q1, .ttdes ; Terminal device? 30568 005002'01 254 00 0 00 005006' 30569 005003'01 260 17 0 00 005215' call gndfil ; Yep, go get the JFN 30570 005004'01 200 11 0 00 000001 move q5, t1 ; Store it for later 30571 005005'01 254 00 0 00 005037' jrst devpar ; Go find out if it 'tolerates' parity 30572 005006'01 endif. ; End case terminal device 30573 30574 005006'01 621 01 0 00 777777 tlz t1, -1 ; Stomp the flags 30575 005007'01 104 00 0 00 000024 GTSTS% ; Get file status of JFN 30576 005010'01 320 12 0 00 004744* erjmpr r ; Failed, no way to know the parity 30577 005011'01 603 02 0 00 000200 txne t2, gs%nam ; Sanity check: does this JFN exist? 30578 005012'01 607 02 0 00 400000 txnn t2, gs%opn ; And is it open? 30579 005013'01 263 17 0 00 000000 ret ; No to one is a calling error 30580 ; Pick up and save the mode 30581 005014'01 135 04 0 00 005755' ldb t4,[pointr t2,gs%mod] 30582 005015'01 200 03 0 00 000002 move t3, t2 ; Save the entire status word, too 30583 005016'01 104 00 0 00 000045 RFBSZ% ; Get the opened byte size k20net - Kermit-20 Network Support MACRO %53B(1254)-4 19:42 30-Mar-24 Page 67-1 K20NET MAC 13-Dec-23 21:12 Get Network Device Status 30584 005017'01 320 12 0 00 005010* erjmpr r ; Failed, better not go any further 30585 005020'01 415 16 0 00 005032' block. ; Build a stack frame for better control flow 30586 005021'01 261 17 0 00 000016 30587 005022'01 302 02 0 00 000007 caie t2, ^d7 ; Open in seven bit mode? 30588 005023'01 263 17 0 00 000000 ret ; Nope, have to have a new file 30589 005024'01 302 04 0 00 000000 caie t4, .gsnrm ; Opened in normal mode? 30590 005025'01 263 17 0 00 000000 ret ; No, so won't do parity 30591 005026'01 603 03 0 00 000400 txne t3, gs%err ; Nothing wrong, right? 30592 005027'01 263 17 0 00 000000 ret ; Better get our own copy 30593 005030'01 254 00 0 00 004417* retskp ; Otherwise, OK to check this JFN 30594 005031'01 263 17 0 00 000000 endbk. ; Either way, come out of the block 30595 005032'01 254 00 0 00 005035' ifskp. ; Skip means OK to check this JFN 30596 005033'01 200 11 0 00 000005 move q5, q1 ; So reuse it 30597 005034'01 254 00 0 00 005037' else. ; Otherwise, we need a copy 30598 005035'01 260 17 0 00 005215' call gndfil ; Go get a copy 30599 005036'01 200 11 0 00 000001 move q5, t1 ; Store it for later 30600 005037'01 endif. ; End of reuse determination logic 30601 30602 remark devpar ; Now check the parity (falls through) 30603 k20net - Kermit-20 Network Support MACRO %53B(1254)-4 19:42 30-Mar-24 Page 68 K20NET MAC 13-Dec-23 21:12 Get Network Device Status 30604 remark Now that we have a JFN, see if it will do parity 30605 30606 005037'01 200 11 0 00 000001 devpar: move q5, t1 ; Save terminal (copy) JFN and flags 30607 005040'01 621 01 0 00 777777 panda < tlz t1, -1 ; Stomp JFN flags so MTOPR%'s don't choke 30608 005041'01 201 02 0 00 400001 movx t2, .morlt ; PANDA can extract parity status 30609 005042'01 104 00 0 00 000077 MTOPR% ; So try to get it 30610 005043'01 320 12 0 00 005045' ifje. r ; Sigh... 30611 005044'01 254 00 0 00 005047' 30612 005045'01 474 10 0 00 000000 seto q4, ; Set a talisman and do nothing else 30613 005046'01 254 00 0 00 005062' else. ; Otherise, got something! 30614 005047'01 200 10 0 00 000003 move q4, t3 ; Save current settings, first 30615 005050'01 661 10 0 00 400000 txo q4, 1b0 ; Be optimistic and assume parity exists and is on 30616 005051'01 602 03 0 00 000010 txne t3, mo%par ; Any parity? 30617 005052'01 254 00 0 00 005062' anskp. ; Nothing further to do or undo 30618 005053'01 200 10 0 00 000003 move q4, t3 ; Try turning it on, saving current settings, first 30619 005054'01 660 03 0 00 000010 txo t3, mo%par ; Turn on (even) parity 30620 005055'01 620 03 0 00 000006 txz t3, mo%nbi!mo%nbo ; Shut network binary so that doesn't get in the way 30621 005056'01 201 02 0 00 400002 movx t2, .moslt ; Function to set PANDA mode bits 30622 005057'01 104 00 0 00 000077 MTOPR% ; Give it a whirl 30623 005060'01 254 00 0 00 005062' ifskp. ; Might not be in this monitor 30624 005061'01 474 10 0 00 000000 seto q4, ; So better leave it alone 30625 005062'01 endif. ; End .moslt analysis 30626 005062'01 endif. ; End .morlt recovery and interpretation 30627 >;panda 30628 dmove t1, [ .fhslf ; Can't believe result of GDSTS% all the time... 30629 005062'01 120 01 0 00 005756' lstrx1 ] ; So let's assume it worked 30630 005063'01 104 00 0 00 000336 SETER% ; and set no errors whatsoever 30631 005064'01 320 12 0 00 005066' %jserr(,) ; VERY strange... 30632 005065'01 254 00 0 00 005071' 30633 005066'01 265 01 0 00 004764* 30634 005067'01 000000000000# 30635 005070'01 254 00 0 00 005071' 30636 002533'04 125 156 141 142 154 30637 30638 005071'01 550 01 0 00 000011 hrrz t1, q5 ; Load the JFN we got 30639 005072'01 403 02 0 00 000003 setzb t2, t3 ; Let's assume the JSYS doesn't work 30640 005073'01 104 00 0 00 000145 GDSTS% ; Finally try a device status on it 30641 005074'01 320 12 0 00 005076' ifje. r ; Catch the error (hopefully) 30642 005075'01 254 00 0 00 005105' 30643 005076'01 200 04 0 00 000001 move t4, t1 ; Put error code someplace for debugger 30644 005077'01 334 00 0 00 000000 %ermsg(,) ;[223] Complain, but carry on 30645 005100'01 254 00 0 00 005104' 30646 005101'01 265 01 0 00 005066* 30647 005102'01 000000000000# 30648 005103'01 254 00 0 00 005104' 30649 002542'04 103 157 165 154 144 30650 005104'01 254 00 0 00 005121' else. ; Otherwise, worked. Maybe... 30651 005105'01 405 02 0 00 000001 andx t2, gd%par ; Toss everything but accepts parity 30652 005106'01 200 04 0 00 000002 move t4, t2 ; Get possible status out of the way 30653 005107'01 400 02 0 00 000000 setz t2, ; Let's assume GETER% fails (impossible) 30654 005110'01 201 01 0 00 400000 movei t1, .fhslf ; This process 30655 005111'01 104 00 0 00 000012 GETER% ; Get the last error 30656 005112'01 320 12 0 00 005114' %jserr(,) ; VERY strange... 30657 005113'01 254 00 0 00 005117' 30658 005114'01 265 01 0 00 005101* k20net - Kermit-20 Network Support MACRO %53B(1254)-4 19:42 30-Mar-24 Page 68-1 K20NET MAC 13-Dec-23 21:12 Get Network Device Status 30659 005115'01 000000000000# 30660 005116'01 254 00 0 00 005117' 30661 002550'04 125 156 141 142 154 30662 005117'01 621 02 0 00 777777 tlz t2, -1 ; Shut off idiotic fork handle... 30663 005120'01 250 02 0 00 000004 exch t2, t4 ; Put the last error in a common place 30664 005121'01 endif. ; End case JSYS handling 30665 30666 005121'01 302 04 0 00 601405 caie t4, lstrx1 ; Any error? 30667 005122'01 254 00 0 00 005135' ifskp. ; No. Supposedly; let's double check 30668 005123'01 302 02 0 00 601340 caie t2, desx9 ; No entry in device dispatch table for GDSTS%? 30669 005124'01 254 00 0 00 005135' anskp. ; No, assume it's fine... 30670 005125'01 200 04 0 00 000002 move t4, t2 ; Yep, device doesn't support it 30671 005126'01 201 01 0 00 400000 movei t1, .fhslf ; This process 30672 005127'01 104 00 0 00 000336 SETER% ; Force it to be our last error 30673 005130'01 320 12 0 00 005132' %jserr(,) ; VERY strange... 30674 005131'01 254 00 0 00 005135' 30675 005132'01 265 01 0 00 005114* 30676 005133'01 000000000000# 30677 005134'01 254 00 0 00 005135' 30678 002557'04 125 156 141 142 154 30679 005135'01 endif. ; End case silent failure 30680 30681 005135'01 306 04 0 00 601405 cain t4, lstrx1 ; So... No error, right? 30682 005136'01 254 00 0 00 005140' ifskp. ; Something happened... 30683 ;;;; remark We handle this properly; uncomment for debugging or prototyping 30684 ;;;; %ermsg(,) 30685 005137'01 403 02 0 00 000003 setzb t2, t3 ; Cons up no status whatsoever 30686 005140'01 endif. 30687 30688 005140'01 335 03 0 00 000010 panda < skipge t3, q4 ; Did we have to restore anything? 30689 005141'01 254 00 0 00 005151' ifskp. ; Ok, so a bit of cleaning up to do, then 30690 005142'01 200 04 0 00 000002 move t4, t2 ; Save the precious gd%par bit! 30691 005143'01 550 01 0 00 000011 hrrz t1, q5 ; Pick up the terminal JFN, no flags 30692 005144'01 201 02 0 00 400002 movx t2, .moslt ; Function to set PANDA mode bits 30693 005145'01 104 00 0 00 000077 MTOPR% ; Try to set it back to the way it was 30694 005146'01 320 12 0 00 005147' erjmpr .+1 ; Failed?? We just changed it! 30695 005147'01 200 02 0 00 000004 move t2, t4 ; Restore the precious (scrubbed) gd%par bit 30696 005150'01 254 00 0 00 005155' else. ; Otherwise, looked negative 30697 005151'01 316 03 0 00 005641' camn t3, [-1] ; Is it our talisman? 30698 005152'01 254 00 0 00 005155' ifskp. ; No, so carry forward the parity setting 30699 005153'01 405 03 0 00 000010 andx t3, mo%par ; Just keep the parity on bit 30700 005154'01 434 02 0 00 000003 or t2, t3 ; And carry that on with a possible gd%par 30701 005155'01 endif. ; End case parity setting 30702 005155'01 endif. ; End .morlt recovery and interpretation 30703 >;;panda 30704 30705 remark t2, gd%par ; So will the thing do parity? 30706 005155'01 316 05 0 00 000011 camn q1, q5 ; Reused the JFN? 30707 005156'01 254 00 0 00 005030* retskp ; We did, so nothing further to do 30708 30709 005157'01 200 07 0 00 000002 move q3, t2 ; Save the precious device-dependent status bits 30710 dmove t1, [ devclt ; On time-out, hit device close timeout 30711 005160'01 120 01 0 00 005760' ^d2500 ] ; Give it two and half seconds to make up its mind 30712 005161'01 260 17 0 00 000363* call timeon ; Start the timer going 30713 005162'01 550 01 0 00 000011 hrrz t1, q5 ; Load the JFN, no flags k20net - Kermit-20 Network Support MACRO %53B(1254)-4 19:42 30-Mar-24 Page 68-2 K20NET MAC 13-Dec-23 21:12 Get Network Device Status 30714 005163'01 104 00 0 00 000022 CLOSF% ; Close it 30715 005164'01 320 12 0 00 005166' %jserr(,) ; But carry on anyway 30716 005165'01 254 00 0 00 005171' 30717 005166'01 265 01 0 00 005132* 30718 005167'01 000000000000# 30719 005170'01 254 00 0 00 005171' 30720 002566'04 125 156 141 142 154 30721 005171'01 260 17 0 00 000451* call timdel ; Toss the timer, we won 30722 30723 005172'01 200 02 0 00 000007 move t2, q3 ; Restore the device-dependent status bits 30724 005173'01 254 00 0 00 005156* retskp ; Return success, anyway 30725 30726 30727 remark ; Here on device parity close timeout 30728 30729 devclt: dmove t1, [ devabt ; On time-out, hit device abort timeout 30730 005174'01 120 01 0 00 005762' ^d2500 ] ; Give it two and half seconds to make up its mind 30731 005175'01 260 17 0 00 005161* call timeon ; Start the timer going 30732 005176'01 550 01 0 00 000011 hrrz t1, q5 ; Load the JFN, no flags and set up to 30733 005177'01 621 01 0 00 004000 txz t1, cz%abt ; abort it, we mean business this time 30734 005200'01 104 00 0 00 000022 CLOSF% ; Bombs away! 30735 005201'01 320 12 0 00 005205' erjmpr devabt ; That didn't work, just try to let go of it 30736 005202'01 260 17 0 00 005171* call timdel ; Toss the timer, it's chucked 30737 005203'01 200 02 0 00 000007 move t2, q3 ; Restore the device-dependent status bits 30738 005204'01 254 00 0 00 005173* retskp ; Return some kind of success 30739 30740 devabt: dmove t1, [ devabf ; On time-out, hit device abort timeout 30741 005205'01 120 01 0 00 005764' ^d2500 ] ; Give it two and half seconds to make up its mind 30742 005206'01 260 17 0 00 005175* call timeon ; Start the timer going 30743 005207'01 550 01 0 00 000011 hrrz t1, q5 ; Load the JFN, no flags and set up to 30744 005210'01 104 00 0 00 000023 RLJFN% ; Just try to let go of it 30745 005211'01 320 12 0 00 005213' erjmpr devabf 30746 005212'01 260 17 0 00 005202* call timdel ; Toss the timer, it's chucked 30747 30748 005213'01 devabf: remark ; If hit here, just ignore what's going on, oh well.. 30749 005213'01 200 02 0 00 000007 move t2, q3 ; Restore the device-dependent status bits 30750 005214'01 254 00 0 00 005204* retskp ; Return some kind of success 30751 k20net - Kermit-20 Network Support MACRO %53B(1254)-4 19:42 30-Mar-24 Page 69 K20NET MAC 13-Dec-23 21:12 Get a seven bit handle on a (terminal) device 30752 subttl Get a seven bit handle on a (terminal) device 30753 30754 remark Constants definitions 30755 30756 000000 js%all==0 ; Has our JFNS% formatting bits 30757 .xcref js%all ; Not needed in the cross reference 30758 30759 define jsb(b) < ;;Macro to accumulate bits 30760 js%all==js%all! ;;OR in to completed word 30761 .xcref js%all ;;Keep off the cross reference!!!! 30762 >;;jsb 30763 30764 define jsf(m,v) < ; Macro to accumulate values 30765 ifb , ;;If no value, then always output 30766 ifnb , ;;If value, then use that 30767 .xcref js%all ;;Either way, keep off the cross reference 30768 >;;jsf 30769 30770 remark ; Finally cons up the formatting 30771 jsf(js%dev) ;;Device 30772 jsf(js%dir) ;;Directory 30773 jsf(js%nam) ;;Name 30774 jsf(js%typ) ;;Type 30775 jsf(js%gen) ;;Generation 30776 jsb(js%paf) ;;Punctuate all fields 30777 30778 chgsec(code,const) ; Not code, constants 30779 000244'03 allfld: intern allfld ;[252] ; Also used by K20SUB 30780 000244'03 111110 000001 js%all ; Output everything in the file name 30781 000245'03 000000 000000 0 ; No goofy prefix 30782 retsec ; Return from CONST psec 30783 k20net - Kermit-20 Network Support MACRO %53B(1254)-4 19:42 30-Mar-24 Page 70 K20NET MAC 13-Dec-23 21:12 Code to do the job 30784 subttl Code to do the job 30785 30786 ; N.B., This surely will NEVER work for a pipe or a file 30787 ; 30788 ; Call: 30789 ; 30790 ; t1/ JFN on device (assumed open) 30791 ; 30792 ; *OR* 30793 ; 30794 ; t1/ .ttdes+line number 30795 ; 30796 ; Return: 30797 ; 30798 ; +1/ Some problem 30799 ; t1/ Last JSYS' error 30800 ; t3/ Possible OPENF% error code 30801 ; t4/ Possible RLJFN% error code 30802 ; 30803 ; +2/ Worked! 30804 ; t1/ New JFN and flags 30805 30806 005215'01 265 16 0 00 005766' gndfil: saveac 30807 005216'01 265 16 0 00 001753* anstkv. (q2,mxfilw) ; Stack space for text of JFN 30808 005217'01 000000 000034 30809 005220'01 415 06 0 17 777743 30810 30811 005221'01 201 01 0 00 000033 movx t1, ; Length of storage to zero 30812 005222'01 200 02 0 00 000006 move t2, q2 ; First location to zero 30813 005223'01 201 03 0 02 000001 movei t3, 1(t2) ; Second location to zero 30814 005224'01 402 00 0 02 000000 setzm (t2) ; Whack the first location 30815 005225'01 320 12 0 00 005017* erjmpr r ; Must have bumped into a guard page or off section 30816 005226'01 123 01 0 00 006000' xblt. t1 ; And away we go! 30817 005227'01 320 12 0 00 005225* erjmpr r ; Must have bumped into a guard page or off section 30818 30819 005230'01 560 01 0 00 000006 hrro t1, q2 ; Tops-20 ASCIZ pointer to text area 30820 005231'01 550 02 0 00 000005 hrrz t2, q1 ; Load the JFN, sans flags 30821 005232'01 322 02 0 00 005227* jumpe t2, r ; Gubbish? 30822 005233'01 606 02 0 00 400000 txnn t2, .ttdes ; A terminal designator? 30823 005234'01 254 00 0 00 005243' ifskp. ; Yes, JFNS% will choke on it 30824 005235'01 104 00 0 00 000121 DEVST% ; So turn designator into a string 30825 005236'01 320 12 0 00 005232* erjmpr r ; But couldn't 30826 005237'01 120 02 0 00 006001' dmove t2, [exp ":",0] ; Load appropriate suffix 30827 005240'01 136 02 0 00 000001 idpb t2, t1 ; Punctuate the device 30828 005241'01 136 03 0 00 000001 idpb t3, t1 ; Tie off the string (does not allow append) 30829 005242'01 254 00 0 00 005246' else. ; Otherwise, a JFN which JFNS% can handle 30830 005243'01 120 03 0 00 000000# dmove t3, allfld ; Load formatting bits, no goofy prefix 30831 005244'01 104 00 0 00 000030 JFNS% ; Turn the JFN into text 30832 005245'01 320 12 0 00 005236* erjmpr r ; But couldn't 30833 005246'01 endif. 30834 30835 005246'01 205 01 0 00 100020 movx t1, gj%old!gj%flg ; Return flags 30836 005247'01 560 02 0 00 000006 hrro t2, q2 ; Load Tops-20 ASCIZ pointer to constructed text 30837 005250'01 104 00 0 00 000020 GTJFN% ; Get a duplicate JFN 30838 005251'01 320 12 0 00 005245* erjmpr r ; Failed?? k20net - Kermit-20 Network Support MACRO %53B(1254)-4 19:42 30-Mar-24 Page 70-1 K20NET MAC 13-Dec-23 21:12 Code to do the job 30839 005252'01 200 07 0 00 000001 move q3, t1 ; Save file JFN and flags 30840 30841 005253'01 621 01 0 00 777777 tlz t1, -1 ; Shut off flags so OPENF% doesn't choke 30842 005254'01 200 02 0 00 006003' movx t2, fld(7,of%bsz)!fld(.gsnrm,of%mod)!of%wr!of%rd ; Force 7 bit mode!! 30843 005255'01 403 03 0 00 000004 setzb t3, t4 ; Scrub an error returns 30844 005256'01 104 00 0 00 000021 OPENF% ; Open the file (I hope) 30845 005257'01 320 12 0 00 005261' ifje. r ; Failed... 30846 005260'01 254 00 0 00 005263' 30847 005261'01 200 03 0 00 000001 move t3, t1 ; Save the error code 30848 005262'01 254 00 0 00 005265' else. ; Otherwise, worked!! 30849 005263'01 500 01 0 00 000007 hll t1, q3 ; Return the flags, too 30850 005264'01 254 00 0 00 005214* retskp ; Return success 30851 005265'01 endif. ; End initial JSYS handling 30852 30853 005265'01 550 01 0 00 000007 hrrz t1, q3 ; Reload the new JFN 30854 005266'01 104 00 0 00 000023 RLJFN% ; Toss its miserable remains 30855 005267'01 320 12 0 00 005271' ifje. r ; Failed?? 30856 005270'01 254 00 0 00 005272' 30857 005271'01 200 04 0 00 000001 move t4, t1 ; Return error code as talisman 30858 005272'01 endif. 30859 30860 005272'01 263 17 0 00 000000 ret ; Fail the call 30861 30862 ;[223] End Code Insertion 30863 k20net - Kermit-20 Network Support MACRO %53B(1254)-4 19:42 30-Mar-24 Page 71 K20NET MAC 13-Dec-23 21:12 Final code particulars 30864 subttl Final code particulars 30865 30866 xlist ; Save the trees!! 30867 list ; Safe to look 30868 .endps code ; Close out the code area 30869 k20net - Kermit-20 Network Support MACRO %53B(1254)-4 19:42 30-Mar-24 Page 72 K20NET MAC 13-Dec-23 21:12 Misc. data storage 30870 subttl Misc. data storage 30871 30872 .psect data ; Writeable area!! 30873 30874 000000'05 cnfigd: block .cfiln ; Space for CNFIG% .CFINF data 30875 000010'05 block 1 ; And slop 30876 000011'05 mynode:: block 1 ; Number of local executor (us) 30877 000012'05 myname:: block 2 ; Local executor name 30878 000014'05 ndvfxp:: block 1 ; Whether monitor has extended node verify 30879 30880 000015'05 syscnt:: block 1 ; Count of characters in system name 30881 000016'05 sysnam:: block syslen ; Name of local system we're running on 30882 000027'05 myprom:: block 3 ; Prompt built off system name 30883 000032'05 sysver: block 1 ; GETAB% table for system name 30884 30885 000033'05 cnfmsg: block <+1> ; Space for configuration message 30886 000065'05 block 1 ; And slop ... 30887 30888 remark ;[190] ; Various line bits of interest 30889 30890 000066'05 000000 000000 inited: 0 ;[190] ;[177] inilin/reslin flag. 30891 000067'05 000000 000000 oldmod: 0 ;[190] ; Previous mode of the line. 30892 000070'05 000000 000000 olddim: 0 ;[190] ;[185] Old line dimensions 30893 000071'05 000000 000000 oldpau: 0 ;[190] ; Previous terminal pause on end mode. 30894 000072'05 000000 000000 sysmsg: 0 ;[190] ;[82] Accept/refuse system message status. 30895 30896 panda < remark ;[181] Storage for PANDA monitor TVT support 30897 000073'05 000000 000000 havnbm: 0 ;[181] Non-zero if we have network binary mode 30898 000074'05 000000 000000 setlts: 0 ;[181] set if we set terminal status 30899 000075'05 000000 000000 oldlts: 0 ;[181] Old terminal status 30900 > ;[181] 30901 30902 remark Do not reorder next two! 30903 000076'05 nrtros:: block 1 ; If NRT, remote operating system type 30904 000077'05 rosnpt:: block 1 ; Remote operating system name pointer 30905 000100'05 nrtflg:: block 1 ; Set if a valid Network Remote Terminal 30906 000101'05 binflg:: block 1 ; Set if terminal will do binary (they all do) 30907 000102'05 nrtprt: block 1 ; NRT protocol supported 30908 000103'05 forkls:: block 1 ;[236] ; NRT connection is forkless 30909 30910 000104'05 000000 000000 job: 0 ;[218] ;[7] Number of job that has TTY I want. 30911 000105'05 000000 000000 oasflg: 0 ;[218] ;[7] -1 if we assigned the previous TTY. 30912 000106'05 000000 000000 osgdev: 0 ;[218] ;[186] Old device I had assigned 30913 000107'05 000000 000000 oldjfn: 0 ;[218] ; JFN on previous line. 30914 30915 000110'05 000000 000000 oldnum: 0 ; Previous DECnet node number 30916 000111'05 000000 000000 oldnam: exp 0, 0, 0, 0 ; Previous DECnet node name 30917 000115'05 nrtobj: block <+1> ; Area to build object name for GTJFN% 30918 000151'05 block 2 ; And slop 30919 000153'05 intbuf: block ^d<<16/5>+1> ; Space for interupt message 30920 000157'05 block 3 ; And generous slop... (it is DECnet, after all) 30921 30922 000162'05 frkpdl: block pdlsiz ;[186] Fork's PDL 30923 ;[223] If a buffer is large enough for 8 bit, it will be large enough for 7 bit 30924 000472'05 frkbuf: block +1 ;[223] Buffer for fork to read into (if 8 bit) k20net - Kermit-20 Network Support MACRO %53B(1254)-4 19:42 30-Mar-24 Page 72-1 K20NET MAC 13-Dec-23 21:12 Misc. data storage 30925 001073'05 nrtbuf: block +1 ;[223] Buffer for sending loop (if 8 bit) 30926 001474'05 parbuf: block +1 ;[223] Buffer if building parity from terminal input 30927 30928 remark pseudo-terminal information 30929 30930 002075'05 ttygtb: block 1 ; Terminal line to job mapping GETAB% 30931 002076'05 pty1st: block 1 ; Terminal line number of first pseudo-terminal 30932 002077'05 ptycnt: block 1 ; Count of pseudo-terminals 30933 002100'05 ptygtb: block 1 ; PTYPAR GETAB% index (which we'll never use) 30934 30935 002101'05 ndvchr:: block 2 ; Device characterstics double word 30936 30937 002103'05 ptyflg:: block 1 ; Set if doing pseudo-terminal I/O 30938 002104'05 ptynam:: block 3 ; ASCII name of pseudo-terminal 30939 002107'05 ptydev:: block 1 ; Assigned PTY device designator 30940 002110'05 ptytty:: block 1 ; Line number associated with pseudo-terminal 30941 30942 002111'05 ttyflg: block 1 ; Flag for physical terminal 30943 002112'05 ttydev:: block 1 ; Assigned TTY device designator 30944 002113'05 ttynam:: block 3 ; ASCII name of associated terminal 30945 30946 002116'05 777777 777777 opndev: -1 ;[186] Device type we are open on 30947 002117'05 opnsts:: block 2 ;[223] GDSTS% on the open JFN 30948 002121'05 000000 000000 opnpar:: 0 ;[223] Whether device supports parity 30949 30950 002122'05 000000 000000 vbict:: 0 ;[186] Virtual Terminal BIN% Count 30951 002123'05 000000 000000 vboct:: 0 ;[186] Virtual Terminal BOUT% Count (simulated) 30952 002124'05 000000 000000 vsict:: 0 ;[186] Virtual Terminal SIN% Count (number done) 30953 002125'05 000000 000000 vsitc:: 0 ;[186] Virtual Terminal total characters SIN%'ed 30954 002126'05 000000 000000 vsimx:: 0 ;[186] Virtual Terminal SIN% Maximum length 30955 002127'05 000000 000000 vsoct:: 0 ;[186] Virtual Terminal SOUTR%'s Issued 30956 002130'05 000000 000000 vsotc:: 0 ;[186] Virtual Terminal SOUTR% Total Characters 30957 002131'05 000000 000000 vsomx:: 0 ;[186] Virtual Terminal SOUTR% Maximum length 30958 002132'05 000000 000000 nbict:: 0 ;[186] Network BIN% count 30959 002133'05 000000 000000 nsici:: 0 ;[186] Network SIN%'s Issued 30960 002134'05 000000 000000 nsitc:: 0 ;[186] Network SIN% total characters 30961 002135'05 000000 000000 nsimx:: 0 ;[186] Network SIN% maximum length 30962 30963 002136'05 000000 000000 vchrcn:: 0 ;[211] Characters flushed from virtual line 30964 002137'05 flushb: block +1 ;[211] Flush buffer in words, eight bit bytes 30965 30966 002222'05 ntiblk::block ntblen ;[210] ;[182] NTINF% block for TVT 30967 002232'05 ntihst: block ^d20 ;[186] Remote DECnet host 30968 .endps data ; Close out the data area 30969 30970 .xcmsy ;[194] Ditch MACSYM junk 30971 30972 end NO ERRORS DETECTED PROGRAM BREAK IS 000000 PSECT 1 BREAK IS 006004 FOR CODE PSECT 2 BREAK IS 000003 FOR TEXT PSECT 3 BREAK IS 000246 FOR CONST k20net - Kermit-20 Network Support MACRO %53B(1254)-4 19:42 30-Mar-24 Page 72-2 K20NET MAC 13-Dec-23 21:12 Misc. data storage PSECT 4 BREAK IS 002576 FOR ETEXT PSECT 5 BREAK IS 002256 FOR DATA CPU TIME USED 00:02.074 143P CORE USED k20net - Kermit-20 Network Support MACRO %53B(1254)-4 19:42 30-Mar-24 Page S-1 K20NET MAC 13-Dec-23 21:12 SYMBOL TABLE AIC% 104000 000131 int GJ%FLG 000020 000000 sin NTINF% 104000 000632 int SIN% 104000 000052 int ARGX02 601713 int GJ%OLD 100000 000000 sin NTLINE 777777 spd SINR% 104000 000531 int ASGDEV 000000 ext GJ%SHT 000001 000000 sin NTTYPE 000777 000000 spd SOBE% 104000 000103 int ASGFLG 000000 ext GS%ERR 000400 000000 sin NW%FE 000001 sin SOUT% 104000 000053 int ASND% 104000 000070 int GS%MOD 000017 sin NW%NNT 000000 sin SOUTR% 104000 000532 int ATMBUF 000000 ext GS%NAM 000200 000000 sin NW%TCP 000001 sin SPACE 000000 ext BIN% 104000 000050 int GS%OPN 400000 000000 sin NW%TV 000004 sin SRVFLG 000000 ext BOUT 104000 000051 int GTJFN% 104000 000020 int OBJLEN 000207 spd STAT% 104000 000745 int BOUT% 104000 000051 int GTSTS% 104000 000024 int ODD 000000 ext STCMP% 104000 000540 int CALL 260740 000000 HALTF 104000 000170 int OF%BSZ 770000 000000 sin STPAR% 104000 000217 int CALLRE 254000 000000 spd HANDSH 000000 ext OF%MOD 007400 000000 sin STRBUF 000000 ext CF%DCN 200000 000000 sin IAC 000377 spd OF%RD 200000 sin STRC 000000 ext CF%WDP 777777 000000 spd IIC% 104000 000132 int OF%WR 100000 sin STRPTR 000000 ext CFIBF% 104000 000100 int INPCLR 000000 ext OPENF% 104000 000021 int SYMOUT 000000 ext CFOBF% 104000 000101 int JFNS% 104000 000030 int P 000017 SYSGT% 104000 000016 int CHKPAR 000000 ext JS%DEV 700000 000000 sin P1 000011 spd SYSLEN 000011 spd CIS% 104000 000141 int JS%DIR 070000 000000 sin P2 000012 spd T1 000001 spd CLOSF 104000 000022 int JS%GEN 000070 000000 sin P3 000013 spd T2 000002 spd CLOSF% 104000 000022 int JS%NAM 007000 000000 sin P4 000014 spd T3 000003 spd CLSX1 600160 int JS%PAF 000001 sin P5 000015 spd T4 000004 spd CNFIG% 104000 000627 int JS%TYP 000700 000000 sin PANDAS 000001 sin T5 000005 spd CODE 000000 ext KFORK% 104000 000153 int PARITY 000000 ext TCP%NT 000040 000000 spd CONST 000000 ext KLFLGS 777700 000000 spd PARPKO 000000 ext TEXT 000000 ext CRLF 000000 ext LSTRX1 601405 int PARRCK 000000 ext TL%AAD 002000 000000 sin CX 000016 MARK 000000 ext PARS3 000000 ext TL%ABS 010000 000000 sin CZ%ABT 004000 000000 sin MO%ABT 010000 000000 sin PARS4 000000 ext TL%COR 200000 000000 sin DEBRK% 104000 000136 int MO%CON 400000 000000 sin PARS5 000000 ext TL%CRO 400000 000000 sin DESX3 600152 int MO%EOM 020000 000000 sin PARS6 000000 ext TL%SAB 020000 000000 sin DESX9 601340 int MO%INT 002000 000000 sin PARS7 000000 ext TL%STA 004000 000000 sin DEVST% 104000 000121 int MO%NBI 000004 sin PBOUT 104000 000074 int TLINK 104000 000216 int DIC% 104000 000133 int MO%NBO 000002 sin PBOUT% 104000 000074 int TOPNRT 000010 spd DIR% 104000 000130 int MO%PAR 000010 sin PC%USR 010000 000000 sin TOPS20 000010 spd DISMS 104000 000167 int MO%RMT 400000 000000 sin PDLSIZ 000310 spd TRNBIN 000000 spd DISMS% 104000 000167 int MO%SYN 004000 000000 sin PSOUT% 104000 000076 int TT%AAD 000400 sin DO 000375 spd MO%WCC 040000 000000 sin Q1 000005 spd TT%ALK 001000 sin DONT 000376 spd MO%WFC 100000 000000 sin Q2 000006 spd TT%CAR 000001 sin DV%AV 010000 000000 sin MOVCHR 000000 ext Q3 000007 spd TT%DAM 000300 sin DV%TYP 000777 000000 sin MTOPR 104000 000077 int Q4 000010 spd TT%DUM 000014 sin DV%UNT 077777 sin MTOPR% 104000 000077 int Q5 000011 spd TT%ECO 004000 sin DVCHR% 104000 000117 int MXFILW 000034 spd R 000000 ext TT%LCA 040000 000000 sin EIR% 104000 000126 int MYCAPS 000000 ext RELD% 104000 000071 int TT%LEN 037600 000000 sin ERJMP 320700 000000 int MYJOB 000000 ext RET 263740 000000 TT%LIC 000020 sin ERJMPR 320500 000000 int MYTTY 000000 ext RFBSZ% 104000 000045 int TT%MFF 200000 000000 sin ERJMPS 320600 000000 int ND%EXM 400000 000000 sin RFMOD 104000 000107 int TT%PGM 000002 sin ERRPTR 000000 ext ND%LGL 200000 000000 sin RFMOD% 104000 000107 int TT%TAB 100000 000000 sin ERSTR% 104000 000011 int ND%NUM 020000 000000 sin RLJFN% 104000 000023 int TT%UOC 000040 sin ESOUT% 104000 000313 int NETFLG 000000 ext RSKP 000000 ext TT%WID 000177 000000 sin ETEXT 000000 ext NETJFN 000000 ext RSTLNW 000000 ext TT%WKA 010000 sin EVEN 000000 ext NODE% 104000 000567 int SAVLNW 000000 ext TT%WKF 100000 sin FRKHX2 600251 int NODNAM 000000 ext SC%GTB 200000 000000 sin TT%WKN 040000 sin GD%PAR 000001 sin NODNUM 000000 ext SETER% 104000 000336 int TT%WKP 020000 sin GDSTS% 104000 000145 int NONE 000000 ext SFMOD 104000 000110 int TTIPAR 000000 ext GENPAR 000000 ext NOP 600000 000000 sin SFMOD% 104000 000110 int TTYINI 000000 ext GETAB% 104000 000010 int NOUT% 104000 000224 int SH%LPM 400000 000000 sin TTYJFN 000000 ext GETER% 104000 000012 int NTBLEN 000010 spd SIBE% 104000 000102 int TTYNUM 000000 ext k20net - Kermit-20 Network Support MACRO %53B(1254)-4 19:42 30-Mar-24 Page S-2 K20NET MAC 13-Dec-23 21:12 SYMBOL TABLE VI%MAJ 077700 000000 sin .DCX8 000010 sin .SHTTY 000001 sin VI%MIN 000077 000000 sin .DCX9 000011 sin .TTDES 400000 sin WAIT% 104000 000306 int .DVDCN 000022 sin .XSTKS 000000 ext WILL 000373 spd .DVDES 600000 sin WONT 000374 spd .DVNUL 000015 sin XMOVEI 415000 000000 int .DVPIP 000403 sin XON 000021 spd .DVPTY 000013 sin %%JSER 000000 ext .DVTTY 000012 sin ..MSK 777777 777777 spd .FHINF 777774 sin .A16 000016 spd .FHSLF 400000 sin .CFIHO 000004 sin .FHSUP 777777 sin .CFILN 000010 sin .FP 000015 spd .CFINF 000000 sin .FPAC 000005 spd .CFISE 000002 sin .GSIMG 000010 sin .CFISO 000006 sin .GSNRM 000000 sin .CFIVR 000007 sin .GSSMB 000001 sin .CFLEN 000000 sin .JSAOF 000001 sin .CHBEL 000007 sin .MOACN 000024 sin .CHCNC 000003 sin .MOCLZ 000040 sin .CHCRT 000015 sin .MOOFF 000000 sin .CHDAS 000055 sin .MORIM 000035 sin .CHDBQ 000042 spd .MORLS 000025 sin .CHNUL 000000 sin .MORLT 400001 sin .CHRPT 000076 spd .MORNT 000035 sin .CMCFM 000010 sin .MORSP 000027 sin .CMKEY 000000 sin .MORXO 000044 sin .CMNOD 000026 sin .MOSIM 000036 sin .CMNUM 000001 sin .MOSLT 400002 sin .CTTRM 777777 sin .MOSMN 000001 sin .DCX0 000000 sin .MOSNH 000044 sin .DCX1 000001 sin .MOSNT 000034 sin .DCX10 000012 sin .MOXOF 000043 sin .DCX11 000013 sin .NDFLG 000001 sin .DCX2 000002 sin .NDGLN 000001 sin .DCX21 000025 sin .NDGNM 000003 sin .DCX22 000026 sin .NDNOD 000000 sin .DCX23 000027 sin .NDNUM 000002 sin .DCX24 000030 sin .NDVFX 000023 sin .DCX3 000003 sin .NDVFY 000015 sin .DCX32 000040 sin .NULIO 377777 sin .DCX33 000041 sin .NWABC 000000 sin .DCX34 000042 sin .NWLIN 000002 sin .DCX35 000043 sin .NWNNP 000003 sin .DCX36 000044 sin .NWNU1 000006 sin .DCX37 000045 sin .NWRRH 000000 sin .DCX38 000046 sin .NWTTF 000004 sin .DCX39 000047 sin .PRIOU 000101 sin .DCX4 000004 sin .PX7 610001 000000 spd .DCX40 000050 sin .SAC 000016 .DCX41 000051 sin .SAV1 000000 ext .DCX42 000052 sin .SAV2 000000 ext .DCX43 000053 sin .SAV3 000000 ext .DCX5 000005 sin .SHARG 000000 sin .DCX6 000006 sin .SHESC 000002 sin .DCX7 000007 sin .SHLEN 000003 spd k20net - Kermit-20 Network Support MACRO %53B(1254)-4 19:42 30-Mar-24 Page S-3 K20NET MAC 13-Dec-23 21:12 SYMBOL TABLE FOR PSECT CODE ASGDEV 003661' ext DOBIT4 004375' NONE 002142' ext TTYNUM 004714' ext ASGFLG 003660' ext DOBITS 004271' ent NRTBRK 002407' ent TVTCHK 004223' ext ASIPTY 001056' ent DOESC 002066' ext NRTEND 003114' TVTFLG 004722' ext ATMBUF 001417' ext DUPLEX 002124' ext NRTLEN 000016 spd UNARPA 004722' BBNTVT 004235' ECHO 002132' ext NRTMSG 002404' UNARPX 004772' BOUTR% 001741' ent ERRPTR 004742' ext NTECH0 002257' UNBITS 004625' ent CARIER 004370' ext ESCAPE 002055' ext NTECH1 002270' UNSNBM 004474' CCOFF2 004603' ext FILJFN 004613' ext NTECH2 002304' VTERMF 004614' ext CCON 000347' ext FIXNAM 000603' NTECHO 002250' VTMOUT 002071' CHKCLS 003054' FLOW 004401' ext NTIDEV 004176' VTMPSH 002000' ent CHKDCN 004126' FLUSHC 000310 spd NUL4 001546' ext WAITCC 000512' CHKLIN 003773' ent FRKCHB 000000 ext OPENET 003377' ent WAITCN 000330' CHKLJF 004151' FRKCHN 000000 ext OPENRT 000262' WAITDN 000405' CHKNBM 004420' ent FRKLSC 001621' ent OPNPTY 003521' WAITM1 000530' CHKNRT 000236' FRTRAP 002365' ent OPNTTY 003625' WAITMO 000522' CHKPAR 002243' ext GDSCPT 002330' PARIER 002342' WAITPR 000407' CHKPTY 004140' GENPAR 002114' ext PARITY 002141' ext WAITUN 000503' CHKTOP 000627' GETNAM 000077' ent PARPKO 002144' ext $CF%WD 000000 spd CHKTTY 004033' GETNOD 000145' PARRCK 002146' ext $CONN1 001254' CHKTVT 004223' ent GETNTI 004175' ent PARS3 001241' ext $CONN2 001431' CLRBUF 002423' ent GNDFIL 005215' PARS4 001275' ext $CONN3 001616' CLREAD 002666' ent GNDPAR 004776' ent PARS5 001616' ext $CONNE 001204' ent CLREST 002625' ent GTTYJF 003664' PARS6 000360' ext $CONNX 003337' ext CLSABT 003141' HANDSH 004400' ext PARS7 001605' ext $SETLN 001165' ent CLSASG 003160' HONK 002341' PC3 002377' ext $WAITJ 000365' sin CLSCLN 003224' HSTTYN 000000000000# pol POSTAB 000137' %%JSER 005166' ext CLSCOM 003130' HSTTYP 000763' int PTYFLS 002527' ..0005 000034' spd CLSFE 003130' INIL2 004260' R 005251' ext ..0006 000035' spd CLSJFN 003044' ent INILIN 004256' ent RESLIN 004601' ent ..0013 000033' spd CLSNET 003047' ent INIPTY 001035' ent RRSL2 004604' ent ..0021 000053' spd CLSNRT 003121' INPCLR 002667' ext RRSLIN 004603' ent ..0022 000055' spd CLSPTY 003130' INTMSG 001006' ent RSKP 005264' ext ..0024 000061' spd CLSRLJ 003153' JS%ALL 111110 000001 spd RSTLNW 004674' ext ..0036 000066' spd CNFLEN 000200 spd LCLNOD 000000' ent SAVLNW 004361' ext ..0037 000071' spd CRLF 003360' ext LINLEN 002000 spd SESFLG 002316' ext ..0046 000120' spd CYOFF 000452' ext LOCAL 004731' ext SESJFN 002314' ext ..0047 000137' spd CYON 000351' ext MDMLIN 004373' ext SETDEF 000176' ent ..0055 000122' spd CYSEEN 000371' ext MONV 004105' ext SETNBM 004432' ..0056 000130' spd DCNFLS 002457' MOVCHR 002301' ext SETSPD 004103' ext ..0063 000153' spd DEADEV 003620' MYCAPS 000000 ext SHUTDN 000441' ..0072 000154' spd DECERR 000544' ent MYJOB 003454' ext SPEED 004113' ext ..0073 000165' spd DECNCT 000213' ent MYTTY 003752' ext SRVFLG 004601' ext ..0101 000154' spd DELAY 000361' ext NBMERR 004472' SYMOUT 003305' ext ..0102 000161' spd DEVABF 005213' NETER2 003343' TIMDEL 005212' ext ..0110 000202' spd DEVABT 005205' NETERR 002351' TIMEON 005206' ext ..0111 000205' spd DEVCLT 005174' NETFLG 003721' ext TTER1 002065' ext ..0116 000246' spd DEVPAR 005037' NETIN 002135' ent TTFORK 002374' ext ..0117 000250' spd DNCFLD 000000 ext NETINH 003345' TTINCH 002070' ext ..0126 000271' spd DNCHB 000000 ext NETINM 003366' TTIPAR 002346' ext ..0127 000275' spd DNDFLD 000000 ext NETJFN 004727' ext TTSFRK 001620' ext ..0146 000364' spd DNTRAP 000535' ent NETLGX 002326' ext TTXON 002764' ent ..0161 000364' spd DOARPA 004525' ent NETVTX 003244' ent TTXON2 003017' ..0162 000405' spd DOARPX 004575' NIENTE 000170' TTXON3 003037' ..0167 000373' spd DOBIT2 004331' NODNAM 005650' ext TTYINI 001435' ext ..0170 000402' spd DOBIT3 004337' NODNUM 001416' ext TTYJFN 004737' ext ..0172 000400' spd k20net - Kermit-20 Network Support MACRO %53B(1254)-4 19:42 30-Mar-24 Page S-4 K20NET MAC 13-Dec-23 21:12 SYMBOL TABLE FOR PSECT CODE ..0173 000427' spd ..1003 001511' spd ..1524 002455' spd ..2127 003146' spd ..0203 000435' spd ..1010 001474' spd ..1532 002467' spd ..2130 003152' spd ..0253 000562' spd ..1015 001477' spd ..1550 002471' spd ..2136 003157' spd ..0262 000566' spd ..1030 001534' spd ..1551 002524' spd ..2137 003160' spd ..0263 000575' spd ..1035 001536' spd ..1556 002502' spd ..2141 003167' spd ..0270 000574' spd ..1050 001576' spd ..1557 002523' spd ..2153 003166' spd ..0272 000577' spd ..1051 001600' spd ..1567 002503' spd ..2154 003167' spd ..0336 000611' spd ..1060 001556' spd ..1570 002523' spd ..2156 003212' spd ..0344 000653' spd ..1061 001565' spd ..1574 002537' spd ..2163 003220' spd ..0351 000654' spd ..1070 001572' spd ..1612 002542' spd ..2170 003223' spd ..0356 000675' spd ..1102 001616' spd ..1613 002622' spd ..2171 003224' spd ..0367 000723' spd ..1110 001612' spd ..1620 002555' spd ..2175 003266' spd ..0374 000730' spd ..1121 001735' spd ..1621 002565' spd ..2211 003300' spd ..0375 000742' spd ..1130 001733' spd ..1622 002553' spd ..2233 003317' spd ..0404 000756' spd ..1136 001677' spd ..1641 002577' spd ..2234 003340' spd ..0451 001041' spd ..1143 001707' spd ..1642 002621' spd ..2253 003421' spd ..0452 001043' spd ..1162 001727' spd ..1643 002576' spd ..2254 003423' spd ..0453 001044' spd ..1174 001740' spd ..1660 002601' spd ..2255 003420' spd ..0460 001050' spd ..1175 001741' spd ..1661 002621' spd ..2267 003414' spd ..0461 001052' spd ..1176 001752' spd ..1665 002631' spd ..2270 003416' spd ..0463 001105' spd ..1213 001767' spd ..1673 002651' spd ..2271 003420' spd ..0475 001070' spd ..1214 001777' spd ..1705 002647' spd ..2272 003430' spd ..0476 001072' spd ..1225 002000' spd ..1706 002651' spd ..2304 003443' spd ..0505 001114' spd ..1226 002070' spd ..1707 002646' spd ..2312 003440' spd ..0506 001136' spd ..1236 002043' spd ..1723 002663' spd ..2320 003463' spd ..0513 001121' spd ..1237 002067' spd ..1724 002664' spd ..2326 003460' spd ..0514 001122' spd ..1240 002024' spd ..1725 002662' spd ..2334 003514' spd ..0516 001133' spd ..1255 002115' spd ..1735 002673' spd ..2342 003511' spd ..0530 001203' spd ..1273 002131' spd ..1743 002677' spd ..2344 003500' spd ..0536 001176' spd ..1274 002134' spd ..1756 002700' spd ..2351 003511' spd ..0550 001254' spd ..1301 002153' spd ..1757 002757' spd ..2356 003477' spd ..0556 001215' spd ..1302 002155' spd ..1760 002717' spd ..2364 003504' spd ..0562 001223' spd ..1310 002155' spd ..1765 002720' spd ..2365 003506' spd ..0574 001230' spd ..1311 002250' spd ..1772 002715' spd ..2367 003511' spd ..0602 001236' spd ..1312 002161' spd ..1773 002716' spd ..2404 003540' spd ..0610 001247' spd ..1327 002176' spd ..1774 002713' spd ..2405 003552' spd ..0621 001273' spd ..1330 002203' spd ..2010 002732' spd ..2406 003555' spd ..0627 001263' spd ..1333 002215' spd ..2011 002733' spd ..2415 003562' spd ..0637 001270' spd ..1340 002247' spd ..2012 002731' spd ..2416 003572' spd ..0647 001346' spd ..1341 002211' spd ..2027 002740' spd ..2422 003602' spd ..0655 001312' spd ..1354 002215' spd ..2030 002754' spd ..2427 003603' spd ..0657 001305' spd ..1355 002247' spd ..2040 003005' spd ..2436 003640' spd ..0675 001316' spd ..1356 002241' spd ..2050 003012' spd ..2455 003706' spd ..0703 001323' spd ..1367 002245' spd ..2062 003027' spd ..2456 003720' spd ..0713 001341' spd ..1402 002264' spd ..2063 003036' spd ..2457 003723' spd ..0721 001332' spd ..1403 002267' spd ..2070 003057' spd ..2466 003730' spd ..0722 001337' spd ..1413 002327' spd ..2071 003063' spd ..2467 003740' spd ..0736 001424' spd ..1460 002337' spd ..2072 003064' spd ..2473 003747' spd ..0741 001374' spd ..1461 002341' spd ..2077 003071' spd ..2500 003750' spd ..0746 001370' spd ..1462 002357' spd ..2100 003075' spd ..2505 003756' spd ..0747 001372' spd ..1474 002375' spd ..2101 003077' spd ..2506 003766' spd ..0750 001373' spd ..1502 002433' spd ..2111 003127' spd ..2515 004010' spd ..0751 001405' spd ..1515 002434' spd ..2112 003130' spd ..2516 004016' spd ..0761 001415' spd ..1516 002455' spd ..2120 003134' spd ..2531 004041' spd ..0776 001454' spd ..1523 002445' spd ..2121 003140' spd ..2532 004046' spd k20net - Kermit-20 Network Support MACRO %53B(1254)-4 19:42 30-Mar-24 Page S-5 K20NET MAC 13-Dec-23 21:12 SYMBOL TABLE FOR PSECT CODE ..2536 004056' spd ..JX1 400000 spd ..2543 004061' spd ..MX1 070000 300000 spd ..2544 004062' spd ..MX2 000000 spd ..2551 004066' spd ..PST 000003 spd ..2552 004074' spd ..TX1 400000 spd ..2556 004102' spd ..TX2 000001 spd ..2563 004103' spd .XSTKS 005216' ext ..2564 004114' spd ..2572 004111' spd ..2577 004114' spd ..2603 004134' spd ..2610 004135' spd ..2615 004155' spd ..2616 004165' spd ..2617 004166' spd ..2630 004265' spd ..2642 004310' spd ..2703 004425' spd ..2704 004430' spd ..2705 004431' spd ..2712 004452' spd ..2726 004515' spd ..2742 004522' spd ..2743 004524' spd ..2751 004550' spd ..2775 004613' spd ..2777 004621' spd ..3011 004644' spd ..3041 004745' spd ..3061 005006' spd ..3070 005032' spd ..3075 005035' spd ..3076 005037' spd ..3103 005045' spd ..3104 005047' spd ..3105 005062' spd ..3112 005062' spd ..3123 005076' spd ..3124 005105' spd ..3125 005121' spd ..3137 005135' spd ..3150 005140' spd ..3156 005151' spd ..3157 005155' spd ..3164 005155' spd ..3175 005243' spd ..3176 005246' spd ..3203 005261' spd ..3204 005263' spd ..3205 005265' spd ..3212 005271' spd ..3213 005272' spd ..CSC 000004 spd ..CSN 000003 spd ..IFT 400001 spd k20net - Kermit-20 Network Support MACRO %53B(1254)-4 19:42 30-Mar-24 Page S-6 K20NET MAC 13-Dec-23 21:12 SYMBOL TABLE FOR PSECT TEXT DEFNAM 000000' k20net - Kermit-20 Network Support MACRO %53B(1254)-4 19:42 30-Mar-24 Page S-7 K20NET MAC 13-Dec-23 21:12 SYMBOL TABLE FOR PSECT CONST ALLFLD 000244' int DATA 000000 ext DSCTAB 000130' NRTADR 000000' NRTDEV 000001' NRTNUM 000002' NSPTAB 000016' .DCXMX 000053 spd .SAV1 000000 ext .SAV2 000000 ext .SAV3 000000 ext k20net - Kermit-20 Network Support MACRO %53B(1254)-4 19:42 30-Mar-24 Page S-8 K20NET MAC 13-Dec-23 21:12 SYMBOL TABLE FOR PSECT ETEXT UNKDEC 001530' k20net - Kermit-20 Network Support MACRO %53B(1254)-4 19:42 30-Mar-24 Page S-9 K20NET MAC 13-Dec-23 21:12 SYMBOL TABLE FOR PSECT DATA BINFLG 000101' int TTYGTB 002075' CNFIGD 000000' TTYNAM 002113' int CNFMSG 000033' VBICT 002122' int FLUSHB 002137' VBOCT 002123' int FORKLS 000103' int VCHRCN 002136' int FRKBUF 000472' VSICT 002124' int FRKPDL 000162' VSIMX 002126' int HAVNBM 000073' VSITC 002125' int INITED 000066' VSOCT 002127' int INTBUF 000153' VSOMX 002131' int JOB 000104' VSOTC 002130' int MYNAME 000012' int MYNODE 000011' int MYPROM 000027' int NBICT 002132' int NDVCHR 002101' int NDVFXP 000014' int NRTBUF 001073' NRTFLG 000100' int NRTOBJ 000115' NRTPRT 000102' NRTROS 000076' int NSICI 002133' int NSIMX 002135' int NSITC 002134' int NTIBLK 002222' int NTIHST 002232' OASFLG 000105' OLDDIM 000070' OLDJFN 000107' OLDLTS 000075' OLDMOD 000067' OLDNAM 000111' OLDNUM 000110' OLDPAU 000071' OPNDEV 002116' OPNPAR 002121' int OPNSTS 002117' int OSGDEV 000106' PARBUF 001474' PTY1ST 002076' PTYCNT 002077' PTYDEV 002107' int PTYFLG 002103' int PTYGTB 002100' PTYNAM 002104' int PTYTTY 002110' int ROSNPT 000077' int SETLTS 000074' SYSCNT 000015' int SYSMSG 000072' SYSNAM 000016' int SYSVER 000032' TTYDEV 002112' int TTYFLG 002111' K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 19:42 30-Mar-24 Page 1 K20TIM MAC 9-Dec-23 22:56 All edit 216 except for some 207 code moved 30973 title K20TIM - Kermit (Virtual) Device Timing 30974 subttl All edit 216 except for some 207 code moved 30975 30976 Comment " ; Make gnuEmacs font-rot mode happy 30977 30978 The module provides basic loopback tests on various devices, currently 30979 all virtual. These are called speed tests because the results are 30980 used to validate the calculations for the efficiency rating of the 30981 line in the statistics output. 30982 30983 Other routines concerned with timing and load average may be found 30984 here. 30985 30986 Loopback tests could be provided for a physical line, but this would 30987 require taking the line out of service and fitting it with a loopback 30988 connector. For now, it is assumed that the baud rate is both 30989 correctly reported and used. 30990 30991 Please read the following VERY carefully: 30992 30993 1) The reported speed can vary WILDLY depending on other system 30994 activity and is easily peturbed for no readily apparent 30995 reason. 30996 30997 2) The speed itself is only reporting how fast the monitor is 30998 shuttling data around and has no basis in any physical 30999 transport, media or reality. 31000 31001 3) Changing the various mode, byte sizes and record lengths of 31002 the connection can produce speed changes, but these are of 31003 little pratical use other than determining what might be the 31004 most effective connection configuration. 31005 31006 4) Be particularly wary of the byte size for essentially 31007 meaningless results. It's largely here for DECnet testing 31008 and to see what the pseudo-terminal device driver might be 31009 stripping. 31010 31011 5) While it is possible to time intervals to 100 kHz (I.E., DK10) 31012 resolution, it is fundamentally impossible to accurately 31013 correlate such intervals with the time of day. This is 31014 because Tops-20 keeps the time of day as an 18 bit fixed point 31015 fraction, which works out to a 'Time of Day' tick being 31016 approximately 329.58858646932 milliseconds. 31017 31018 However, there is no way to tell when Tops-20 will advance 31019 this because the last system set time (TADIDT) as calculated 31020 STAD% is not available nor is the millisecond uptime counter 31021 that is used to calculate it. The problem is made worse 31022 because there is thus no public correlation between HPTIM%, 31023 either. 31024 31025 The problem really can't be resolved without a change to 31026 Tops-20 to make TADIDT available and to store the elapsed 31027 millisecond clock that was used to do the calculation. K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 19:42 30-Mar-24 Page 1-1 K20TIM MAC 9-Dec-23 22:56 All edit 216 except for some 207 code moved 31028 31029 This is not a problem for commands that display elapsed time, 31030 such as CLEAR. It is a problem for logging where using HPTIM% 31031 can occasionally produce the effect of time going backwards. 31032 " 31033 K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 19:42 30-Mar-24 Page 2 K20TIM MAC 9-Dec-23 22:56 Preliminaries 31034 subttl Preliminaries 31035 31036 search monsym,macsym,cmd,k20unv 31037 search dcam ; Double compare macros 31038 cmdacs ^ ; Clean up p1-p4 definitions 31039 31040 sall ; Tidy listing 31041 .directive flblst ; We don't need to see all the ASCIZ bytes... 31042 31043 remark common parsing external data and usage 31044 31045 extern pars1 ; Contains address of .TIME 31046 extern pars2 ; Parsed device id 31047 extern pars3 ; OPENF% mode 31048 extern pars4 ; OPENF% byte size 31049 extern pars5 ; Buffer size (RECORD-LENGTH) 31050 31051 remark ; Various support routines 31052 extern ascdev ; Turns a device number into ASCII text 31053 extern %%jser ; JSYS error handler 31054 extern %%smsg ; smsg macro support 31055 extern BOUTI% ;[216] BOUT% Internal 31056 extern symout ; Get symbolic name and offset of an address 31057 remark $TIME ; Is found in k20dsp and invokes the timing routines 31058 31059 remark ; Various external variables 31060 extern crlf ; Carriage return line feed sequence 31061 31062 remark ; Some constants 31063 31064 000511 456000 msiday==^d86400000 ; Milliseconds in a day 31065 100276 770000 dkday==msiday*^d100 ; 100 DK10 ticks per millisecond 31066 000001 000000 todtic==^d262144 ; TOD ticks in a day 31067 31068 .psect code/ronly ; Don't allow stores!! 31069 K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 19:42 30-Mar-24 Page 3 K20TIM MAC 9-Dec-23 22:56 TIME command parse table 31070 subttl TIME command parse table 31071 31072 remark ; Common Names of devices we can test 31073 31074 000000'02 000000 000000 %table(timtab) ; Begin a keyword table 31075 000001'02 000000# 777777 %key2 , -1 ; Copy another device's baud 31076 000000'03 143 157 160 171 000 31077 000002'02 000000# 600015 %key2 , .dvdes!.dvnul ; Idiomatic for NUL: 31078 000001'03 144 141 164 141 055 31079 000003'02 000000# 600022 %keyf3 , .dvdes!.dvdcn, cm%inv ; Allows escape recognition 31080 000003'03 002000 000001 31081 000004'03 104 103 116 000 000 31082 000004'02 000000# 600022 %key2 , .dvdes!.dvdcn ; Means either SRV: or DCN: 31083 000005'03 104 105 103 156 145 31084 000005'02 000000# 777777 %keyf3 , -1, cm%inv ; When Tom gets sleepy 31085 000007'03 002000 000001 31086 000010'03 144 165 160 154 151 31087 000006'02 000000# 000010' %keyf3 , %NUL, cm%inv!cm%abr ; Prefer NUL over NRT 31088 000012'03 002000 000005 31089 000013'03 156 000 000 000 000 31090 000007'02 000000# 600022 %keyf3 , .dvdes!.dvdcn, cm%inv ; Sleepy Tom types this 31091 000014'03 002000 000001 31092 000015'03 116 122 124 000 000 31093 000010'02 000000# 600015 %nul: %keyf3 , .dvdes!.dvnul, cm%inv ; Allows escape recognition 31094 000016'03 002000 000001 31095 000017'03 116 125 114 000 000 31096 000011'02 000000# 000013' %keyf3 , %pipe, cm%inv!cm%abr ; Prefer pipe over PIP: 31097 000020'03 002000 000005 31098 000021'03 160 151 000 000 000 31099 000012'02 000000# 600403 %keyf3 , .dvdes!.dvpip, cm%inv ; Allows escape recognition 31100 000022'03 002000 000001 31101 000023'03 120 111 120 000 000 31102 000013'02 000000# 600403 %pipe: %key2 , .dvdes!.dvpip ; Idiomatic for PIP: 31103 000024'03 160 151 160 145 000 31104 000014'02 000000# 600013 %key2 , .dvdes!.dvpty ; Idiotmatic for PTY: 31105 000025'03 160 163 145 165 144 31106 000015'02 000000# 600013 %keyf3 , .dvdes!.dvpty, cm%inv ; Don't specify device number 31107 000031'03 002000 000001 31108 000032'03 120 124 131 000 000 31109 000016'02 000000# 000020' %keyf3 , %reus, cm%inv!cm%abr ; Prefer re-use over reuse 31110 000033'03 002000 000005 31111 000034'03 162 000 000 000 000 31112 000017'02 000000# 000020' %keyf3 , %reus, cm%inv!cm%abr ; Prefer re-use over reuse 31113 000035'03 002000 000005 31114 000036'03 162 145 000 000 000 31115 000020'02 000000# 777777 %reus: %keyf3 , -1, cm%inv ; Previous dumb name for copy 31116 000037'03 002000 000001 31117 000040'03 162 145 055 165 163 31118 000021'02 000000# 777777 %keyf3 , -1, cm%inv ; Ditto 31119 000042'03 002000 000001 31120 000043'03 162 145 165 163 145 31121 000022'02 000000# 600023 %keyf3 , .dvdes!.dvsrv, cm%inv ; Allows escape recognition 31122 000045'03 002000 000001 31123 000046'03 123 122 126 000 000 31124 000000'02 000022 000022 %tbend K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 19:42 30-Mar-24 Page 3-1 K20TIM MAC 9-Dec-23 22:56 TIME command parse table 31125 cleans(<%nul,%pipe,%reus>) ; Pitch working symbols 31126 31127 chgsec(code,const) ;;Chained FDB's go into CONST area 31128 000023'02 000004 000026' timfdb: flddb. .cmkey,,timtab,,,timfd1 31129 000024'02 000000 000000' 31130 000025'02 44 07 0 00 000351' 31131 000026'02 016004 000000 timfd1: flddb. .cmdev,,, 31132 000027'02 000000 000000 31133 000030'02 44 07 0 00 000355' 31134 retsec ;;Restore psect assumptions 31135 cleans() ;;Toss working symbol 31136 31137 K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 19:42 30-Mar-24 Page 4 K20TIM MAC 9-Dec-23 22:56 TIME (device) command parsing 31138 subttl TIME (device) command parsing 31139 31140 000000'01 .time: intern .time ; Invoked by top level parser 31141 000000'01 265 16 0 00 003446' saveac ; Just in case 31142 000001'01 200 16 0 00 000000# guide (virtual speed of) 31143 000002'01 260 17 0 00 000000* 31144 000031'02 000000000000# 31145 000000'04 166 151 162 164 165 31146 31147 000003'01 477 01 0 00 000002 setob t1, t2 ; Cons up some talisman 31148 000004'01 124 01 0 00 000000* dmovem t1, pars2 ; No device nor OPENF% mode parsed 31149 000005'01 124 01 0 00 000000* dmovem t1, pars4 ; No OPENF% byte size 31150 000006'01 202 01 0 00 000000# movem t1, timdev ; Device being timed 31151 31152 000007'01 201 01 0 00 000000# movei t1, timfdb ; Parse a device as a keyword or something real 31153 000010'01 260 17 0 00 000000* call rfield ; Try to get something 31154 000011'01 135 04 0 00 003454' ldb t4, [pointr (.cmfnp(t3),cm%fnc)] ; Get parse function taken 31155 31156 000012'01 302 04 0 00 000000 caie t4, .cmkey ; Did a nice name? 31157 000013'01 254 00 0 00 000020' ifskp. ; Yep, that's not very difficult 31158 000014'01 524 02 0 02 000000 hrlo t2, (t2) ; Turn semantic action into a device designator 31159 000015'01 316 02 0 00 003455' camn t2, [-1] ; Wants to use a device's results elsewhere? 31160 000016'01 254 00 0 00 000125' callret .copy ; Yes, do that 31161 000017'01 201 04 0 00 000016 movei t4, .cmdev ; Otherwise, say we parsed a device 31162 000020'01 endif. ; And take the device case 31163 31164 000020'01 302 04 0 00 000016 caie t4, .cmdev ; Explicitly specified the device? 31165 000021'01 254 00 0 00 000040' ifskp. ; Yes, that's not much harder 31166 000022'01 554 01 0 00 000002 hlrz t1, t2 ; Pick up bare device designator 31167 000023'01 620 01 0 00 600000 txz t1, .dvdes ; Shut off the universal device code 31168 000024'01 202 01 0 00 000004* movem t1, pars2 ; Finally save just the device type number 31169 31170 000025'01 306 01 0 00 000013 cain t1, .dvpty ; Pseudo-terminal? 31171 000026'01 254 00 0 00 000052' callret parpty ; Yes, maybe parse its switch modifiers 31172 000027'01 306 01 0 00 000403 cain t1, .dvpip ; Pipe device? 31173 000030'01 254 00 0 00 000054' callret parpip ; Yes, maybe parse its switch modifiers 31174 000031'01 306 01 0 00 000015 cain t1, .dvnul ; NULL (or NIL) device? 31175 000032'01 254 00 0 00 000056' callret parnul ; Yes, maybe parse its bytesize modifier 31176 000033'01 302 01 0 00 000023 caie t1, .dvsrv ; DECnet passive component? 31177 000034'01 306 01 0 00 000022 cain t1, .dvdcn ; or DECnet active component 31178 000035'01 254 00 0 00 000060' callret pardcn ; Yes, maybe parse its switch modifiers 31179 ; None of the above, so nothing special 31180 000036'01 260 17 0 00 000000* confrm ; Tie off the line 31181 000037'01 263 17 0 00 000000 ret ; And done 31182 000040'01 endif. ; End case .cmdev parse item 31183 31184 000040'01 broken: remark ; Otherwise, we are deeply confused 31185 000040'01 200 01 0 00 000000# emsg() ; Begin the blat 31186 000041'01 104 00 0 00 000313 31187 000032'02 000000000000# 31188 000004'04 111 156 166 141 154 31189 000042'01 201 01 0 00 000101 movei t1, .priou ; Continue blatting on the terminal 31190 000043'01 200 02 0 00 000004 move t2, t4 ; Loaded the parsed function 31191 000044'01 201 03 0 00 000010 movei t3, fld(^d8,no%rdx) ;Function codes are octal 31192 000045'01 104 00 0 00 000224 NOUT% ; Tell us that, it may be of use K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 19:42 30-Mar-24 Page 4-1 K20TIM MAC 9-Dec-23 22:56 TIME (device) command parsing 31193 000046'01 320 12 0 00 000047' erjmpr .+1 ; Ignore error, we're trying hard enough 31194 31195 000047'01 561 01 0 00 000000* hrroi t1, crlf ; Tie off the blat 31196 000050'01 104 00 0 00 000076 PSOUT% 31197 000051'01 263 17 0 00 000000 ret ; And go no further 31198 K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 19:42 30-Mar-24 Page 5 K20TIM MAC 9-Dec-23 22:56 Device secondary parse tables and function descriptor blocks 31199 subttl Device secondary parse tables and function descriptor blocks 31200 31201 remark Various switches for each device 31202 31203 000033'02 000000 000000 %table(nulswi) ; General device switch table 31204 000034'02 000000# 000000# %key2 ,parbyt ;Parse byte size 31205 000047'03 142 171 164 145 163 31206 000033'02 000001 000001 %tbend 31207 31208 000035'02 000000 000000 %table(devswi) ; General device switch table 31209 000036'02 000000# 000000# %key2 ,parbyt ;Parse byte size 31210 000051'03 142 171 164 145 163 31211 000037'02 000000# 000000# %key2 ,parmod ; Parse mode 31212 000053'03 155 157 144 145 072 31213 000035'02 000002 000002 %tbend 31214 31215 000040'02 000000 000000 %table(pipswi) ; Begin a special switch table for pipes 31216 000041'02 000000# 000000# %key2 ,parbyt ;Parse byte size 31217 000055'03 142 171 164 145 163 31218 000042'02 000000# 000000# %key2 ,parmod ; Parse mode 31219 000057'03 155 157 144 145 072 31220 000043'02 000000# 000000# %key2 ,parecl 31221 000061'03 162 145 143 157 162 31222 000040'02 000003 000003 %tbend 31223 31224 remark Switches applicable to potentiall all devices 31225 31226 000044'02 000000 000000 %table(modkey) ; N.B., Not all devices support all modes!! 31227 000045'02 000000# 000017 %keyf3 ,.GSDMP, cm%inv ;N.B., No device here supports dump mode 31228 000064'03 002000 000001 31229 000065'03 144 165 155 160 000 31230 000046'02 000000# 000047' %keyf3 , %imag, cm%abr!cm%inv 31231 000066'03 002000 000005 31232 000067'03 151 000 000 000 000 31233 000047'02 000000# 000010 %imag: %key2 , .GSIMG 31234 000070'03 151 155 141 147 145 31235 000050'02 000000# 000001 %keyf3 ,.GSSMB, cm%inv 31236 000072'03 002000 000001 31237 000073'03 151 156 164 145 162 31238 000051'02 000000# 000000 %key2 ,.GSNRM 31239 000076'03 156 157 162 155 141 31240 000052'02 000000# 000001 %key2 , .GSSMB 31241 000100'03 163 155 141 154 154 31242 000044'02 000006 000006 %tbend 31243 cleans(<%imag>) ;;Clean working symbol out of MACRO tables 31244 31245 chgsec(code,const) ;;Chained FDB's are in CONST, not code 31246 000053'02 010004 000056' parfdb: flddb. .cmcfm,,,,,parfd1 31247 000054'02 000000 000000 31248 000055'02 44 07 0 00 000365' 31249 000056'02 003000 000000 parfd1: flddb. .cmswi,,devswi, ;; or OPENF% mode modifiers 31250 000057'02 000000 000035' 31251 31252 000060'02 010004 000063' pipfdb: flddb. .cmcfm,,,,,pipfd1 31253 000061'02 000000 000000 K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 19:42 30-Mar-24 Page 5-1 K20TIM MAC 9-Dec-23 22:56 Device secondary parse tables and function descriptor blocks 31254 000062'02 44 07 0 00 000376' 31255 000063'02 003000 000000 pipfd1: flddb. .cmswi,,pipswi ;; or OPENF% mode and GTJFN% modifiers 31256 000064'02 000000 000040' 31257 31258 000065'02 010004 000070' nilfdb: flddb. .cmcfm,,,,,nilfd1 31259 000066'02 000000 000000 31260 000067'02 44 07 0 00 000405' 31261 000070'02 003000 000000 nilfd1: flddb. .cmswi,,nulswi, ;; NIL was the original TENEX name for NUL: 31262 000071'02 000000 000033' 31263 31264 000072'02 010004 000075' dcnfdb: flddb. .cmcfm,,,,,dcnfd1 31265 000073'02 000000 000000 31266 000074'02 44 07 0 00 000415' 31267 000075'02 003000 000000 dcnfd1: flddb. .cmswi,,devswi, ;; or OPENF% mode and GTJFN% modifiers 31268 000076'02 000000 000035' 31269 31270 31271 retsec ;;Back to code .psect 31272 cleans() 31273 K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 19:42 30-Mar-24 Page 6 K20TIM MAC 9-Dec-23 22:56 Device secondary (switch) parsing 31274 subttl Device secondary (switch) parsing 31275 31276 000052'01 201 05 0 00 000000# parpty: movei q1, parfdb ; Handle case of pseudo terminal 31277 000053'01 254 00 0 00 000062' callret parswi ; Now parse for PTY:'s switches 31278 31279 000054'01 201 05 0 00 000000# parpip: movei q1, pipfdb ; Handle pipe device 31280 000055'01 254 00 0 00 000062' callret parswi ; Now parse for PIP:'s switches 31281 31282 000056'01 201 05 0 00 000000# parnul: movei q1, nilfdb ; Handle NUL: (or NIL) device 31283 000057'01 254 00 0 00 000062' callret parswi ; Now parse for NUL:'s switches 31284 31285 000060'01 201 05 0 00 000000# pardcn: movei q1, dcnfdb ; Handle DECnet (SRV:/DCN:) device 31286 000061'01 254 00 0 00 000062' callret parswi ; Now parse for DCN:'s switch 31287 K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 19:42 30-Mar-24 Page 7 K20TIM MAC 9-Dec-23 22:56 Common secondary switch parsing 31288 subttl Common secondary switch parsing 31289 31290 000062'01 parswi: do. ; Enter loop logical context 31291 000062'01 200 01 0 00 000005 move t1, q1 ; Load the requested parse FDB 31292 000063'01 260 17 0 00 000010* call rfield ; Go parse something 31293 000064'01 135 04 0 00 003454' ldb t4, [pointr (.cmfnp(t3),cm%fnc)] ; Get parse function taken 31294 000065'01 306 04 0 00 000010 cain t4, .cmcfm ; Confirmed? 31295 000066'01 263 17 0 00 000000 ret ; They did, we're done 31296 000067'01 550 01 0 02 000000 hrrz t1, (t2) ; Otherwise, we have a switch to do 31297 000070'01 260 17 0 01 000000 call (t1) ; So Pick up switch parsed and call it 31298 000071'01 600 00 0 00 000000 nop ; Ignore any skip/non-skip (none currently skip) 31299 000072'01 254 00 0 00 000062' loop. ; Go get some more switches until confirmed 31300 000073'01 enddo. ; End loop lexical context 31301 31302 remark Here to handle BYTESIZE, MODE and RECORD-LENGTH switches 31303 31304 000073'01 parbyt: remark Parse file byte size 31305 000073'01 201 01 0 00 003462' movei t1, [flddb. .cmnum,,^d10,] 31306 000074'01 260 17 0 00 000063* call rfield ; Get a number 31307 000075'01 327 02 0 00 000101' ifle. t2 ; Gubbish? 31308 000076'01 200 01 0 00 000000# emsg 31309 000077'01 104 00 0 00 000313 31310 000077'02 000000000000# 31311 000013'04 111 154 154 157 147 31312 000100'01 254 00 0 00 000000* jrst cmder1 ; Complain and allow command retry. 31313 000101'01 endif. 31314 000101'01 307 02 0 00 000044 caig t2,^d36 ; Being overly bullish? 31315 000102'01 254 00 0 00 000106' ifskp. ; Then it isn't a DIGITAL computer... 31316 000103'01 200 01 0 00 000000# emsg 31317 000104'01 104 00 0 00 000313 31318 000100'02 000000000000# 31319 000025'04 124 150 145 040 120 31320 000105'01 254 00 0 00 000100* jrst cmder1 ; Complain and allow command retry. 31321 000106'01 endif. 31322 000106'01 202 02 0 00 000005* movem t2, pars4 ; Store byte size for OPENF% 31323 000107'01 263 17 0 00 000000 ret ; Get more switches 31324 31325 000110'01 parmod: remark Parse file mode 31326 000110'01 201 01 0 00 003471' movei t1, [flddb. .cmkey,,modkey,] 31327 000111'01 260 17 0 00 000074* call rfield ; Get a keyword 31328 000112'01 550 01 0 02 000000 hrrz t1, (t2) ; Turn semantic action into a mode value 31329 000113'01 202 01 0 00 000000* movem t1, pars3 ; Store OPENF% mode 31330 000114'01 263 17 0 00 000000 ret ; Get more switches 31331 31332 000115'01 parecl: remark Parse RECORD-LENGTH attrbute 31333 000115'01 201 01 0 00 003500' movei t1, [flddb. .cmnum,,^d10,] 31334 000116'01 260 17 0 00 000111* call rfield ; Get a number 31335 000117'01 327 02 0 00 000123' ifle. t2 ; Gubbish? 31336 000120'01 200 01 0 00 000000# emsg 31337 000121'01 104 00 0 00 000313 31338 000101'02 000000000000# 31339 000042'04 111 154 154 157 147 31340 000122'01 254 00 0 00 000105* jrst cmder1 ; Complain and allow command retry. 31341 000123'01 endif. 31342 000123'01 202 02 0 00 000000* movem t2, pars5 ; Store monitor buffer size (RECORD-LENGTH) K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 19:42 30-Mar-24 Page 7-1 K20TIM MAC 9-Dec-23 22:56 Common secondary switch parsing 31343 000124'01 263 17 0 00 000000 ret ; Get more switches 31344 K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 19:42 30-Mar-24 Page 8 K20TIM MAC 9-Dec-23 22:56 Copy one device's speed test over another's 31345 subttl Copy one device's speed test over another's 31346 31347 ; Useful because inter-fork pseudo-terminal speed is FAR slower than 31348 ; inter-job speed, resulting in efficiency percentages in the 31349 ; quadruple digit range. 31350 31351 remark ; Common Names of device tests we can copy 31352 31353 000102'02 000000 000000 %table(coptab) ; Begin a keyword table 31354 000103'02 000000# 600015 %key2 , .dvdes!.dvnul ; Idiomatic for NUL: 31355 000102'03 144 141 164 141 055 31356 000104'02 000000# 600022 %keyf3 , .dvdes!.dvdcn, cm%inv ; Allows escape recognition 31357 000104'03 002000 000001 31358 000105'03 104 103 116 000 000 31359 000105'02 000000# 600022 %key2 , .dvdes!.dvdcn ; Means either SRV: or DCN: 31360 000106'03 104 105 103 156 145 31361 000106'02 000000# 000110' %keyf3 , %nul1, cm%inv!cm%abr ; Prefer NUL over NRT 31362 000110'03 002000 000005 31363 000111'03 156 000 000 000 000 31364 000107'02 000000# 600022 %keyf3 , .dvdes!.dvdcn, cm%inv ; Sleepy Tom types this 31365 000112'03 002000 000001 31366 000113'03 116 122 124 000 000 31367 000110'02 000000# 600015 %nul1: %keyf3 , .dvdes!.dvnul, cm%inv ; Allows escape recognition 31368 000114'03 002000 000001 31369 000115'03 116 125 114 000 000 31370 000111'02 000000# 000113' %keyf3 , %pip1, cm%inv!cm%abr ; Prefer pipe over PIP: 31371 000116'03 002000 000005 31372 000117'03 160 151 000 000 000 31373 000112'02 000000# 600403 %keyf3 , .dvdes!.dvpip, cm%inv ; Allows escape recognition 31374 000120'03 002000 000001 31375 000121'03 120 111 120 000 000 31376 000113'02 000000# 600403 %pip1: %key2 , .dvdes!.dvpip ; Idiomatic for PIP: 31377 000122'03 160 151 160 145 000 31378 000114'02 000000# 600013 %key2 , .dvdes!.dvpty ; Idiotmatic for PTY: 31379 000123'03 160 163 145 165 144 31380 000115'02 000000# 600013 %keyf3 , .dvdes!.dvpty, cm%inv ; Allows escape recognition 31381 000127'03 002000 000001 31382 000130'03 120 124 131 000 000 31383 000116'02 000000# 600023 %keyf3 , .dvdes!.dvsrv, cm%inv ; Allows escape recognition 31384 000131'03 002000 000001 31385 000132'03 123 122 126 000 000 31386 000102'02 000014 000014 %tbend 31387 31388 cleans(<%nul1,%pip1>) ; Toss working symbols 31389 31390 chgsec(code,const) ;;Chained FDB's go into const 31391 000117'02 000004 000122' cpffdb: flddb. .cmkey,,coptab,,,cpffd1 31392 000120'02 000000 000102' 31393 000121'02 44 07 0 00 000424' 31394 000122'02 016004 000000 cpffd1: flddb. .cmdev,,, 31395 000123'02 000000 000000 31396 000124'02 44 07 0 00 000355' 31397 31398 000125'02 000004 000130' cptfdb: flddb. .cmkey,,coptab,,,cptfd1 31399 000126'02 000000 000102' K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 19:42 30-Mar-24 Page 8-1 K20TIM MAC 9-Dec-23 22:56 Copy one device's speed test over another's 31400 000127'02 44 07 0 00 000432' 31401 000130'02 016004 000000 cptfd1: flddb. .cmdev,,, 31402 000131'02 000000 000000 31403 000132'02 44 07 0 00 000355' 31404 retsec ;;Return to code .psect 31405 31406 cleans() ;;Punt the working symbols 31407 K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 19:42 30-Mar-24 Page 9 K20TIM MAC 9-Dec-23 22:56 TIME COPY command parsing 31408 subttl TIME COPY command parsing 31409 31410 000125'01 265 16 0 00 003503' .copy: saveac ; Wants another AC 31411 000126'01 200 16 0 00 000000# guide (a previous timing test result for) 31412 000127'01 260 17 0 00 000002* 31413 000133'02 000000000000# 31414 000055'04 141 040 160 162 145 31415 remark t5, q1 ; Note aliased, assumed saved 31416 31417 000130'01 201 01 0 00 000000# movei t1, cpffdb ; Copy-From FDB 31418 000131'01 260 17 0 00 000116* call rfield ; Try to get something 31419 000132'01 135 04 0 00 003454' ldb t4, [pointr (.cmfnp(t3),cm%fnc)] ; Get parse function taken 31420 31421 000133'01 302 04 0 00 000000 caie t4, .cmkey ; Did an idiomatic name? 31422 000134'01 254 00 0 00 000137' ifskp. ; Yep, that's not very difficult 31423 000135'01 524 02 0 02 000000 hrlo t2, (t2) ; Turn semantic action into a device designator 31424 000136'01 201 04 0 00 000016 movei t4, .cmdev ; Say we parsed a device 31425 000137'01 endif. ; And take the device case 31426 31427 000137'01 302 04 0 00 000016 caie t4, .cmdev ; If not a device at this point, 31428 000140'01 254 00 0 00 000040' jrst broken ; ...we are deeply broken... 31429 31430 000141'01 554 01 0 00 000002 hlrz t1, t2 ; Pick up bare device designator 31431 000142'01 620 01 0 00 600000 txz t1, .dvdes ; Shut off the universal device code 31432 000143'01 200 05 0 00 000001 move q1, t1 ; Save just the 'source' device type number 31433 31434 000144'01 200 16 0 00 000000# guide (to another device) 31435 000145'01 260 17 0 00 000127* 31436 000134'02 000000000000# 31437 000064'04 164 157 040 141 156 31438 31439 000146'01 201 01 0 00 000000# movei t1, cptfdb ; Copy-To FDB 31440 000147'01 260 17 0 00 000131* call rfield ; Try to get something 31441 000150'01 135 04 0 00 003454' ldb t4, [pointr (.cmfnp(t3),cm%fnc)] ; Get parse function taken 31442 31443 000151'01 302 04 0 00 000000 caie t4, .cmkey ; Did an idomatic name? 31444 000152'01 254 00 0 00 000155' ifskp. ; Indeed; transmorgrify 31445 000153'01 524 02 0 02 000000 hrlo t2, (t2) ; Turn semantic action into a device designator 31446 000154'01 201 04 0 00 000016 movei t4, .cmdev ; Say we parsed a device 31447 000155'01 endif. ; And take the device case 31448 31449 000155'01 302 04 0 00 000016 caie t4, .cmdev ; If not a device at this point, we are 31450 000156'01 254 00 0 00 000040' jrst broken ; deeply broken... 31451 31452 000157'01 554 06 0 00 000002 hlrz q2, t2 ; Pick up bare device designator 31453 000160'01 620 06 0 00 600000 txz q2, .dvdes ; Shut off the universal device code 31454 000161'01 312 05 0 00 000006 came q1, q2 ; Are we trying to reuse ourself? 31455 000162'01 254 00 0 00 000174' ifskp. ; Yes, don't let's be silly 31456 000163'01 200 01 0 00 000000# emsg 31457 000164'01 104 00 0 00 000313 31458 000135'02 000000000000# 31459 000070'04 122 145 144 165 156 31460 000165'01 200 01 0 00 000005 move t1, q1 ; Load device number 31461 000166'01 260 17 0 00 000000* call ascdev ; Turn into a string 31462 000167'01 104 00 0 00 000076 PSOUT% ; Type it K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 19:42 30-Mar-24 Page 9-1 K20TIM MAC 9-Dec-23 22:56 TIME COPY command parsing 31463 txmsg <'s timing test result onto itself 31464 000170'01 200 01 0 00 000000# > 31465 000171'01 104 00 0 00 000076 31466 000172'01 320 12 0 00 000173' 31467 000136'02 000000000000# 31468 000074'04 047 163 040 164 151 31469 31470 000173'01 254 00 0 00 000122* jrst cmder1 ; Complain and allow command retry. 31471 000174'01 endif. 31472 000174'01 260 17 0 00 000036* confrm ; Tie off the line 31473 remark ; Fall through to execute the code 31474 K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 19:42 30-Mar-24 Page 10 K20TIM MAC 9-Dec-23 22:56 Re-use semantic action, not called since only one keyword 31475 subttl Re-use semantic action, not called since only one keyword 31476 31477 extern pvbaud ; PTY: virtual baud rate 31478 extern pibaud ; PIP: virtual baud rate 31479 extern nlbaud ; NUL: virtual baud rate 31480 extern dnbaud ; DCN:/SRV: pair virtual baud rate 31481 31482 000175'01 $copy: remark ; Check source tests 31483 000175'01 477 03 0 00 000004 setob t3, t4 ; Assume we don't know either 31484 000176'01 306 05 0 00 000013 cain q1, .dvpty ; Pseudo-terminal? 31485 000177'01 201 03 0 00 000000* movei t3, pvbaud ; Address of test results 31486 000200'01 306 05 0 00 000403 cain q1, .dvpip ; Pipe device? 31487 000201'01 201 03 0 00 000000* movei t3, pibaud ; Address of test results 31488 000202'01 306 05 0 00 000015 cain q1, .dvnul ; NULL (or NIL) device? 31489 000203'01 201 03 0 00 000000* movei t3, nlbaud ; Address of test results 31490 000204'01 302 05 0 00 000023 caie q1, .dvsrv ; DECnet passive component? 31491 000205'01 306 05 0 00 000022 cain q1, .dvdcn ; or DECnet active component 31492 000206'01 201 03 0 00 000000* movei t3, dnbaud ; Yes, has the same test result address 31493 000207'01 321 03 0 00 000244' jumpl t3, $copys ; We don't have a test for this source 31494 31495 remark ; Check destination tests 31496 000210'01 306 06 0 00 000013 cain q2, .dvpty ; Pseudo-terminal? 31497 000211'01 201 04 0 00 000177* movei t4, pvbaud ; Address of test results 31498 000212'01 306 06 0 00 000403 cain q2, .dvpip ; Pipe device? 31499 000213'01 201 04 0 00 000201* movei t4, pibaud ; Address of test results 31500 000214'01 306 06 0 00 000015 cain q2, .dvnul ; NULL (or NIL) device? 31501 000215'01 201 04 0 00 000203* movei t4, nlbaud ; Address of test results 31502 000216'01 302 06 0 00 000023 caie q2, .dvsrv ; DECnet passive component? 31503 000217'01 306 06 0 00 000022 cain q2, .dvdcn ; or DECnet active component 31504 000220'01 201 04 0 00 000206* movei t4, dnbaud ; Yes, has the same test result address 31505 000221'01 321 04 0 00 000246' jumpl t4, $copyd ; We don't have a test for this destination 31506 31507 000222'01 120 01 0 03 000000 dmove t1, (t3) ; Pick up source test 31508 000223'01 323 01 0 00 000233' jumple t1, $copyn ; No test run 31509 000224'01 124 01 0 04 000000 dmovem t1, (t4) ; Overwrite destination results 31510 000225'01 124 01 0 00 000106* dmovem t1, pars4 ; Store for $SHOW 31511 31512 remark ; Turn device numbers back into device 31513 000226'01 524 01 0 00 000005 hrlo t1, q1 ; Reposition source device number 31514 000227'01 661 01 0 00 600000 tlo t1, .dvdes ; Now a device designator 31515 000230'01 200 02 0 00 000006 move t2, q2 ; Load destination device number 31516 000231'01 124 01 0 00 000024* dmovem t1, pars2 ; Store as device designators 31517 31518 000232'01 263 17 0 00 000000 ret ; Return into $SHOW 31519 K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 19:42 30-Mar-24 Page 11 K20TIM MAC 9-Dec-23 22:56 various error handlers 31520 subttl various error handlers 31521 31522 chgsec(code,text) ;;Text .psect for strings 31523 000133'03 116 157 040 164 151 $copym: asciz "No timing run yet for " 31524 retsec ;;Get back in code .psect 31525 31526 000233'01 $copyn: remark ; Here if no test has been run 31527 000233'01 561 01 0 00 000000# hrroi t1, $copym ; Load common preamble 31528 000234'01 104 00 0 00 000313 ESOUT% ; Begin blat 31529 31530 000235'01 200 01 0 00 000005 move t1, q1 ; Pick up source device number 31531 000236'01 260 17 0 00 000166* call ascdev ; Convert to a string 31532 000237'01 104 00 0 00 000076 PSOUT% ; Type it 31533 31534 000240'01 561 01 0 00 000047* hrroi t1, crlf ; Tie off the line 31535 000241'01 104 00 0 00 000076 PSOUT% 31536 000242'01 476 00 0 00 000231* setom pars2 ; Flag already blatted 31537 000243'01 263 17 0 00 000000 ret ; Return into $SHOW 31538 31539 000244'01 $copys: remark ; Here if source device is unknown 31540 000244'01 202 05 0 00 000242* movem q1, pars2 ; Load the device number 31541 000245'01 263 17 0 00 000000 ret ; Return into $SHOW 31542 31543 000246'01 $copyd: remark ; Here if destination device is unknown 31544 000246'01 202 06 0 00 000244* movem q2, pars2 ; Load the device number 31545 000247'01 263 17 0 00 000000 ret ; Return into $SHOW 31546 K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 19:42 30-Mar-24 Page 12 K20TIM MAC 9-Dec-23 22:56 Determine PTY Virtual Baud rate 31547 subttl Determine PTY Virtual Baud rate 31548 31549 ; N.B., this code is not intended to provide a definitive answer to 31550 ; ANYTHING because Tops-20 is not a real-time system. Even a speck 31551 ; of system load can wildly peturb the results as well as whatever the 31552 ; current monitor's pseudo-terminal implementation happens to be. 31553 ; 31554 ; Also, the speed of a PTY in an intra-job context (as is done below) 31555 ; appears to be slower than the more typical inter-job example, as 31556 ; used by BATCON and Kermit's pseudo-terminal connection code. 31557 ; 31558 ; This result is therefore best viewed as a number suitable for 31559 ; checkout of the calculations performed in the efficiency code for a 31560 ; physical baud rate, if such a thing is ever seen again. 31561 31562 000250'01 dptybd: intern dptybd ; May be invoked as a test 31563 000250'01 265 16 0 00 003511' saveac ;Holds PTY particulars 31564 remark ; N.B., q4 and p1 are aliases!! 31565 31566 000251'01 403 05 0 00 000006 setzb q1, q2 ; No PTY or terminal JFN 31567 000252'01 403 07 0 00 000010 setzb q3, q4 ; No assigned PTY or TTY device 31568 000253'01 400 12 0 00 000013 setz p2, p3 ; No fork created 31569 31570 000254'01 260 17 0 00 000702' call comput ; Get correct byte pointer and count 31571 000255'01 260 17 0 00 000260' call ptyjfn ; Set JFN's to time a PTY: 31572 000256'01 254 00 0 00 001235' jrst epicom ; If failed, hit the epilogue 31573 000257'01 254 00 0 00 000715' callret tcommn ; Otherwise, hit the common code 31574 K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 19:42 30-Mar-24 Page 13 K20TIM MAC 9-Dec-23 22:56 Set up a PTY:/TTY: pair for transfer timing 31575 subttl Set up a PTY:/TTY: pair for transfer timing 31576 31577 ; +1/ Couldn't do it 31578 ; +2/ Worked 31579 ; 31580 ; q1/ Open PTY JFN and flags 31581 ; q2/ Open TTY JFN and flags 31582 ; q3/ Assigned PTY device 31583 ; q4/ Assigned TTY device 31584 31585 extern asipty ; Assign a pseudo-terminal 31586 extern ptynam,ttynam ; ASCII names of assigned devices 31587 extern asgflg ; Flag for assigned device 31588 extern asgdev ; Device actually assigned 31589 extern ndvchr ; Double word device characteristics 31590 extern ptytty ; PTY to TTY: line mapping 31591 extern ptyflg ; Using a pseudo-terminal 31592 extern binflg ; Device is in binary (8-bit) mode 31593 31594 000260'01 ptyjfn: remark ;Expects caller to have saved these 31595 remark ; N.B., q4 and p1 are aliases!! 31596 31597 000260'01 402 00 0 00 000000* setzm asgflg ; Force an assignment 31598 000261'01 260 17 0 00 000000* call asipty ; Grab us a PTY 31599 000262'01 263 17 0 00 000000 ret ; or not... 31600 000263'01 200 07 0 00 000002 move q3, t2 ; Store the returned PTY designator 31601 000264'01 505 01 0 00 600012 hrli t1,.dvdes+.dvtty ; Turn returned line into a TTY designator 31602 000265'01 104 00 0 00 000070 ASND% ; Grab associated terminal, too 31603 000266'01 320 12 0 00 000270' %jserr (,r) ; Odd, just got the PTY... 31604 000267'01 254 00 0 00 000273' 31605 000270'01 265 01 0 00 000000* 31606 000271'01 000000000000# 31607 000272'01 254 00 0 00 000000* 31608 000104'04 103 157 165 154 144 31609 000273'01 200 10 0 00 000001 move q4, t1 ; Store assigned terminal's device designator 31610 31611 remark ; PTY takes mode of TTY:, so open that first 31612 dmove t1, [ gj%sht!gj%flg ; Want GTJFN% flags returned 31613 000274'01 120 01 0 00 003525' -1,,ttynam ] ; asipty built this for us 31614 000275'01 104 00 0 00 000020 GTJFN% ; Try to get a JFN on the PTY's associated TTY 31615 000276'01 320 12 0 00 000300' %jserr (,r) 31616 000277'01 254 00 0 00 000303' 31617 000300'01 265 01 0 00 000270* 31618 000301'01 000000000000# 31619 000302'01 254 00 0 00 000272* 31620 000112'04 103 141 156 047 164 31621 000303'01 200 06 0 00 000001 move q2, t1 ; Store TTY JFN and flags 31622 000304'01 621 01 0 00 777777 tlz t1,-1 ; Whack flags so OPENF% doesn't choke 31623 000305'01 200 02 0 00 003527' movx t2, ; 8-bit bytes 31624 000306'01 335 03 0 00 000113* skipge t3, pars3 ; Load parsed OPENF% mode 31625 000307'01 254 00 0 00 000311' ifskp. ; User specified it, let's use it 31626 000310'01 137 03 0 00 003530' dpb t3, [pointr t2, of%mod] 31627 000311'01 endif. 31628 000311'01 337 04 0 00 000225* skipg t4, pars4 ; Load parsed OPENF% byte size 31629 000312'01 254 00 0 00 000314' ifskp. ; User specified it, let's use it K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 19:42 30-Mar-24 Page 13-1 K20TIM MAC 9-Dec-23 22:56 Set up a PTY:/TTY: pair for transfer timing 31630 000313'01 137 04 0 00 003531' dpb t4, [pointr t2, of%bsz] 31631 000314'01 endif. 31632 000314'01 104 00 0 00 000021 OPENF% ; read-only 31633 000315'01 320 12 0 00 000317' %jserr (,r) 31634 000316'01 254 00 0 00 000322' 31635 000317'01 265 01 0 00 000300* 31636 000320'01 000000000000# 31637 000321'01 254 00 0 00 000302* 31638 000120'04 103 141 156 047 164 31639 31640 dmove t1, [ gj%sht!gj%flg ; Want GTJFN% flags returned 31641 000322'01 120 01 0 00 003532' -1,,ptynam ] ; asipty built this for us 31642 000323'01 104 00 0 00 000020 GTJFN% ; Try to get a JFN on the PTY 31643 000324'01 320 12 0 00 000326' %jserr (,r) 31644 000325'01 254 00 0 00 000331' 31645 000326'01 265 01 0 00 000317* 31646 000327'01 000000000000# 31647 000330'01 254 00 0 00 000321* 31648 000126'04 103 141 156 047 164 31649 000331'01 200 05 0 00 000001 move q1, t1 ; Store PTY JFN and flags 31650 000332'01 621 01 0 00 777777 tlz t1,-1 ; Whack flags so OPENF% doesn't choke 31651 000333'01 200 02 0 00 003534' movx t2, ; 8-bit bytes 31652 remark of%mod ; PTY itself *ONLY* supports normal mode 31653 000334'01 337 04 0 00 000311* skipg t4, pars4 ; Load parsed OPENF% byte size 31654 000335'01 254 00 0 00 000337' ifskp. ; User specified it, let's use it 31655 000336'01 137 04 0 00 003531' dpb t4, [pointr t2, of%bsz] 31656 000337'01 endif. 31657 000337'01 104 00 0 00 000021 OPENF% ; normal mode (only one supported), write-only 31658 000340'01 320 12 0 00 000342' %jserr (,r) 31659 000341'01 254 00 0 00 000345' 31660 000342'01 265 01 0 00 000326* 31661 000343'01 000000000000# 31662 000344'01 254 00 0 00 000330* 31663 000136'04 103 141 156 047 164 31664 31665 000345'01 254 00 0 00 000000* retskp ; Return success 31666 K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 19:42 30-Mar-24 Page 14 K20TIM MAC 9-Dec-23 22:56 Determine PIP: Virtual Baud Rate 31667 subttl Determine PIP: Virtual Baud Rate 31668 31669 ; N.B., this code is not intended to provide a definitive answer to 31670 ; ANYTHING because Tops-20 is not a real-time system. Even a speck 31671 ; of system load can wildly peturb the results as well as whatever the 31672 ; current monitor's pipe implementation happens to be. 31673 ; 31674 ; See dptybd for more extensive commentary 31675 31676 000346'01 dpipbd: intern dpipbd ; May be invoked as a test 31677 000346'01 265 16 0 00 003511' saveac ;Holds pipe particulars 31678 remark ; N.B., q4 and p1 are aliases!! 31679 31680 000347'01 403 05 0 00 000006 setzb q1, q2 ; No source or destination PIP: JFN 31681 000350'01 403 07 0 00 000010 setzb q3, q4 ; No assigned PIP: device 31682 000351'01 400 12 0 00 000013 setz p2, p3 ; No fork created 31683 31684 000352'01 260 17 0 00 000702' call comput ; Get correct byte pointer and count 31685 000353'01 260 17 0 00 000356' call pipjfn ; Set JFN's to time a PIP: device 31686 000354'01 254 00 0 00 001235' jrst epicom ; If failed, hit the epilogue 31687 000355'01 254 00 0 00 000715' callret tcommn ; Worked, hit the common code 31688 K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 19:42 30-Mar-24 Page 15 K20TIM MAC 9-Dec-23 22:56 Set up a PIP: pair for transfer timing 31689 subttl Set up a PIP: pair for transfer timing 31690 31691 ; +1/ Couldn't do it 31692 ; +2/ Worked 31693 ; 31694 ; q1/ Open write PIP: JFN and flags 31695 ; q2/ Open read PIP: JFN and flags 31696 ; q3/ Zero (no assigned write device) 31697 ; q4/ Zero (assigned read device) 31698 31699 ; N.B., Can't use ";RECORD-SIZE:500" attribute. Broken. 31700 ; Proper format is RECORD-LENGTH 31701 31702 chgsec(code,data) ;;Needs some storage 31703 000000'05 pipnam: block ^d20 ; Space to build name 31704 000024'05 pip2nd: block 4 ; Space for 19 characters, plus nul 31705 retsec ;;Get out of data psect 31706 31707 chgsec(code,text) ;;Put strings into text psect 31708 000140'03 120 111 120 072 056 pip1st: ASCIZ /PIP:.;RECORD-LENGTH:/ ; From PIPE.MAC (N.B., NOT RECORD-SIZE!) 31709 remark 12345678901234567890 ; Four words of storage 31710 retsec ;;Back in code psect 31711 31712 remark pars3 ; OPENF% mode 31713 remark pars4 ; OPENF% byte size 31714 remark pars5 ; Buffer size (RECORD-LENGTH) 31715 31716 000356'01 pipjfn: remark ;Expects caller to have saved these 31717 remark ; N.B., q4 and p1 are aliases!! 31718 31719 remark q1, q2, q3, q4 ; Assumes all zero 31720 31721 000356'01 333 02 0 00 000123* skiple t2, pars5 ; See if we have a record length 31722 000357'01 254 00 0 00 000364' ifskp. ; We don't 31723 000360'01 200 03 0 00 000000# move t3, pip1st ; Pick up first five characters (nice hack, Tom) 31724 000361'01 400 04 0 00 000000 setz t4, ; Tie off with .chnul's 31725 000362'01 124 03 0 00 000000# dmovem t3, pipnam ; Stomp into the file specification 31726 000363'01 254 00 0 00 000401' else. ; Otherwise, wants to specify it 31727 000364'01 120 03 0 00 000000# dmove t3, pip1st ; Get the first ten characters 31728 000365'01 124 03 0 00 000000# dmovem t3, pipnam ; Store them 31729 000366'01 120 03 0 00 000000# dmove t3, pip1st+2 ; Get the second ten characters 31730 000367'01 124 03 0 00 000000# dmovem t3, pipnam+2 ; Store them 31731 000370'01 402 00 0 00 000000# setzm pipnam+4 ; Tie off the string 31732 000371'01 561 01 0 00 000000# hrroi t1, ; Puts the decimal number after the colon 31733 000372'01 201 03 0 00 000012 movei t3, ^d10 ; RECORD-LENGTH number is decimal 31734 000373'01 104 00 0 00 000224 NOUT% ; Tack it on to the end 31735 000374'01 320 12 0 00 000376' %jserr (,r) 31736 000375'01 254 00 0 00 000401' 31737 000376'01 265 01 0 00 000342* 31738 000377'01 000000000000# 31739 000400'01 254 00 0 00 000344* 31740 000146'04 103 141 156 047 164 31741 000401'01 endif. 31742 31743 dmove t1,[gj%sht!gj%flg ; Want GTJFN% flags returned K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 19:42 30-Mar-24 Page 15-1 K20TIM MAC 9-Dec-23 22:56 Set up a PIP: pair for transfer timing 31744 000401'01 120 01 0 00 003535' -1,,pipnam ] ; PIP:'s odd syntax 31745 000402'01 104 00 0 00 000020 GTJFN% ; Try to get a JFN on the pipe 31746 000403'01 320 12 0 00 000405' %jserr (,r) 31747 000404'01 254 00 0 00 000410' 31748 000405'01 265 01 0 00 000376* 31749 000406'01 000000000000# 31750 000407'01 254 00 0 00 000400* 31751 000161'04 103 141 156 047 164 31752 000410'01 200 05 0 00 000001 move q1, t1 ; Store first PIP: JFN and flags 31753 31754 000411'01 403 01 0 00 000002 setzb t1, t2 ; Cons up ten .CHNUL's 31755 000412'01 124 01 0 00 000000# dmovem t1, pip2nd+0 ; Whack all the storage 31756 000413'01 124 01 0 00 000000# dmovem t1, pip2nd+2 ; where we'll write more odd syntax 31757 31758 000414'01 561 01 0 00 000000# hrroi t1, pip2nd ; Point to area for JFNS% 31759 000415'01 550 02 0 00 000005 hrrz t2, q1 ; Load our odd first PIP: JFN 31760 dmove t3, [fld(.jsaof,js%dev)!fld(.jsaof,js%nam)!js%paf 31761 000416'01 120 03 0 00 003537' 0 ] ; No strange prefix (whatever that is) 31762 000417'01 104 00 0 00 000030 JFNS% ; Build first part of strange string 31763 000420'01 320 12 0 00 000422' %jserr(,r) 31764 000421'01 254 00 0 00 000425' 31765 000422'01 265 01 0 00 000405* 31766 000423'01 000000000000# 31767 000424'01 254 00 0 00 000407* 31768 000171'04 103 157 165 154 144 31769 000425'01 201 02 0 00 000056 movx t2, "." ; Load a dot 31770 000426'01 136 02 0 00 000001 idpb t2, t1 ; Punctuate the file type 31771 000427'01 550 02 0 00 000005 hrrz t2, q1 ; Load our odd first PIP: JFN 31772 000430'01 205 03 0 00 001000 movx t3, ; File type is the same as the name 31773 000431'01 104 00 0 00 000030 JFNS% ; Build second part of strange string 31774 000432'01 320 12 0 00 000434' %jserr(,r) 31775 000433'01 254 00 0 00 000437' 31776 000434'01 265 01 0 00 000422* 31777 000435'01 000000000000# 31778 000436'01 254 00 0 00 000424* 31779 000205'04 103 157 165 154 144 31780 31781 dmove t1, [ gj%sht!gj%flg ; Want GTJFN% flags returned 31782 000437'01 120 01 0 00 003541' -1,,pip2nd ] ; PIP:'s odd syntax 31783 000440'01 104 00 0 00 000020 GTJFN% ; Try to get a JFN on the PTY 31784 000441'01 320 12 0 00 000443' %jserr (,r) 31785 000442'01 254 00 0 00 000446' 31786 000443'01 265 01 0 00 000434* 31787 000444'01 000000000000# 31788 000445'01 254 00 0 00 000436* 31789 000221'04 103 141 156 047 164 31790 000446'01 200 06 0 00 000001 move q2, t1 ; Store 2nd PIP: JFN and flags 31791 31792 000447'01 550 01 0 00 000005 hrrz t1, q1 ; Load write JFN without flags 31793 000450'01 200 02 0 00 003534' movx t2, ; 8-bit bytes 31794 000451'01 335 03 0 00 000306* skipge t3, pars3 ; Load parsed OPENF% mode 31795 000452'01 254 00 0 00 000454' ifskp. ; User specified it, let's use it 31796 000453'01 137 03 0 00 003530' dpb t3, [pointr t2, of%mod] 31797 000454'01 endif. 31798 000454'01 337 04 0 00 000334* skipg t4, pars4 ; Load parsed OPENF% byte size K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 19:42 30-Mar-24 Page 15-2 K20TIM MAC 9-Dec-23 22:56 Set up a PIP: pair for transfer timing 31799 000455'01 254 00 0 00 000457' ifskp. ; User specified it, let's use it 31800 000456'01 137 04 0 00 003531' dpb t4, [pointr t2, of%bsz] 31801 000457'01 endif. 31802 000457'01 104 00 0 00 000021 OPENF% ; N.B., source JFN is write-only 31803 000460'01 320 12 0 00 000462' %jserr (,r) 31804 000461'01 254 00 0 00 000465' 31805 000462'01 265 01 0 00 000443* 31806 000463'01 000000000000# 31807 000464'01 254 00 0 00 000445* 31808 000231'04 103 141 156 047 164 31809 000465'01 550 01 0 00 000006 hrrz t1, q2 ; Load read JFN without flags 31810 000466'01 200 02 0 00 003543' movx t2, ; 8-bit bytes 31811 000467'01 335 03 0 00 000451* skipge t3, pars3 ; Load parsed OPENF% mode 31812 000470'01 254 00 0 00 000472' ifskp. ; User specified it, let's use it 31813 000471'01 137 03 0 00 003530' dpb t3, [pointr t2, of%mod] 31814 000472'01 endif. 31815 000472'01 337 04 0 00 000454* skipg t4, pars4 ; Load parsed OPENF% byte size 31816 000473'01 254 00 0 00 000475' ifskp. ; User specified it, let's use it 31817 000474'01 137 04 0 00 003531' dpb t4, [pointr t2, of%bsz] 31818 000475'01 endif. 31819 000475'01 104 00 0 00 000021 OPENF% ; Normal mode, read-only 31820 000476'01 320 12 0 00 000500' %jserr (,r) 31821 000477'01 254 00 0 00 000503' 31822 000500'01 265 01 0 00 000462* 31823 000501'01 000000000000# 31824 000502'01 254 00 0 00 000464* 31825 000240'04 103 141 156 047 164 31826 31827 000503'01 254 00 0 00 000345* retskp ; Return success 31828 K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 19:42 30-Mar-24 Page 16 K20TIM MAC 9-Dec-23 22:56 Determine SRV: Virtual Baud Rate 31829 subttl Determine SRV: Virtual Baud Rate 31830 31831 ; N.B., this code is not intended to provide a definitive answer to 31832 ; ANYTHING because Tops-20 is not a real-time system. Even a speck 31833 ; of system load can wildly peturb the results as well as whatever the 31834 ; current monitor's DECnet implementation happens to be. 31835 ; 31836 ; It is not going over ANY hardware network interface; traffic is 31837 ; purely inside of Tops-20. 31838 ; 31839 ; See dptybd for more extensive commentary 31840 31841 000504'01 dsrvbd: intern dsrvbd ; May be invoked as a test 31842 000504'01 265 16 0 00 003511' saveac ;Holds DECnet particulars 31843 remark ; N.B., q4 and p1 are aliases!! 31844 31845 000505'01 403 05 0 00 000006 setzb q1, q2 ; No DCN: or SRV: JFN 31846 000506'01 403 07 0 00 000010 setzb q3, q4 ; No assigned DCN: or SRV: device 31847 000507'01 400 12 0 00 000013 setz p2, p3 ; No fork created 31848 31849 000510'01 260 17 0 00 000702' call comput ; Get correct byte pointer and count 31850 000511'01 260 17 0 00 000514' call srvdcn ; Set JFN's to time a DCN:-SRV: device pair 31851 000512'01 254 00 0 00 001235' jrst epicom ; If failed, hit the epilogue 31852 000513'01 254 00 0 00 000715' callret tcommn ; Worked, hit the common code 31853 K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 19:42 30-Mar-24 Page 17 K20TIM MAC 9-Dec-23 22:56 Acquire a JFN on a DCN:/SRV: pair 31854 subttl Acquire a JFN on a DCN:/SRV: pair 31855 31856 remark Storage area and string components 31857 31858 chgsec(code,text) ;;Put these in program text strings 31859 000145'03 123 122 126 072 056 srvnam: asciz "SRV:.KERMIT-TIMING" ; Task is Kermit Timing service 31860 000151'03 113 145 162 155 151 srvmsg: asciz "Kermit-20: Ready" 31861 000155'03 055 124 101 123 113 dcntsk: asciz "-TASK-KERMIT-TIMING;USER:" 31862 000163'03 073 104 101 124 101 dcndat: asciz ";DATA:" ; Gets HPTIM% ticks as ASCII 31863 retsec ;;Done with read-only text strings 31864 31865 chgsec(code,const) ;;Read-Only pointers are constant data 31866 000137'02 44 07 0 00 000000# srvacc: point 7, srvmsg ; Acknowledgement message 31867 000140'02 000000 000020 srvlen: ^d16 ;;And its length 31868 retsec 31869 31870 chgsec(code,data) ;;Need some writable storage 31871 000030'05 whoami: block 1 ; Currently signed in user number 31872 intern whoami ; START: in k20mit populates this 31873 000031'05 tsktim: block 1 ; HPTIM% value (max 27487790694) 31874 000032'05 dcname: Block ^d20 ; Space for 100 characters 31875 retsec ;;Back to generating executable code 31876 K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 19:42 30-Mar-24 Page 18 K20TIM MAC 9-Dec-23 22:56 Acquire a JFN on a DCN:/SRV: pair 31877 remark Code to get and open the JFN's 31878 31879 000514'01 srvdcn: remark ; First, must get SRV: JFN 31880 dmove t1, [ gj%sht!gj%flg ; Want GTJFN% flags returned 31881 000514'01 120 01 0 00 003544' -1,,srvnam ] ; 31882 000515'01 104 00 0 00 000020 GTJFN% ; Try to get a JFN on the passive component 31883 000516'01 320 12 0 00 000520' %jserr (,r) 31884 000517'01 254 00 0 00 000523' 31885 000520'01 265 01 0 00 000500* 31886 000521'01 000000000000# 31887 000522'01 254 00 0 00 000502* 31888 000247'04 103 157 165 154 144 31889 000523'01 200 06 0 00 000001 move q2, t1 ; Store SRV: JFN and flags 31890 000524'01 621 01 0 00 777777 tlz t1,-1 ; Whack flags so OPENF% doesn't choke 31891 000525'01 200 02 0 00 003543' movx t2, ; 8-bit bytes 31892 000526'01 335 03 0 00 000467* skipge t3, pars3 ; Load parsed OPENF% mode 31893 000527'01 254 00 0 00 000531' ifskp. ; User specified it, let's use it 31894 000530'01 137 03 0 00 003530' dpb t3, [pointr t2, of%mod] 31895 000531'01 endif. 31896 000531'01 337 04 0 00 000472* skipg t4, pars4 ; Load parsed OPENF% byte size 31897 000532'01 254 00 0 00 000534' ifskp. ; User specified it, let's use it 31898 000533'01 137 04 0 00 003531' dpb t4, [pointr t2, of%bsz] 31899 000534'01 endif. 31900 000534'01 104 00 0 00 000021 OPENF% ; normal mode, read-only 31901 000535'01 320 12 0 00 000537' %jserr (,r) 31902 000536'01 254 00 0 00 000542' 31903 000537'01 265 01 0 00 000520* 31904 000540'01 000000000000# 31905 000541'01 254 00 0 00 000522* 31906 000263'04 103 157 165 154 144 31907 31908 000542'01 260 17 0 00 000604' call bldcnt ; Build the (hairy) DCN: task name to SRV: 31909 000543'01 263 17 0 00 000000 ret ; But falled?? 31910 31911 dmove t1, [ gj%sht!gj%flg ; Want GTJFN% flags returned 31912 000544'01 120 01 0 00 003546' -1,,dcname ] ; 31913 000545'01 104 00 0 00 000020 GTJFN% ; Try to get a JFN on the PTY 31914 000546'01 320 12 0 00 000550' %jserr (,r) 31915 000547'01 254 00 0 00 000553' 31916 000550'01 265 01 0 00 000537* 31917 000551'01 000000000000# 31918 000552'01 254 00 0 00 000541* 31919 000275'04 103 157 165 154 144 31920 000553'01 200 05 0 00 000001 move q1, t1 ; Store DCN: JFN and flags 31921 000554'01 621 01 0 00 777777 tlz t1,-1 ; Whack flags so OPENF% doesn't choke 31922 000555'01 200 02 0 00 003534' movx t2, ; 8-bit bytes 31923 000556'01 335 03 0 00 000526* skipge t3, pars3 ; Load parsed OPENF% mode 31924 000557'01 254 00 0 00 000561' ifskp. ; User specified it, let's use it 31925 000560'01 137 03 0 00 003530' dpb t3, [pointr t2, of%mod] 31926 000561'01 endif. 31927 000561'01 337 04 0 00 000531* skipg t4, pars4 ; Load parsed OPENF% byte size 31928 000562'01 254 00 0 00 000564' ifskp. ; User specified it, let's use it 31929 000563'01 137 04 0 00 003531' dpb t4, [pointr t2, of%bsz] 31930 000564'01 endif. 31931 000564'01 104 00 0 00 000021 OPENF% ; normal mode, write-only K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 19:42 30-Mar-24 Page 18-1 K20TIM MAC 9-Dec-23 22:56 Acquire a JFN on a DCN:/SRV: pair 31932 000565'01 320 12 0 00 000567' %jserr (,r) 31933 000566'01 254 00 0 00 000572' 31934 000567'01 265 01 0 00 000550* 31935 000570'01 000000000000# 31936 000571'01 254 00 0 00 000552* 31937 000311'04 103 157 165 154 144 31938 31939 000572'01 550 01 0 00 000006 hrrz t1, q2 ; Load server JFN 31940 000573'01 201 02 0 00 000041 movx t2, .mocc ; Explicitly accept the DCN: 31941 000574'01 120 03 0 00 000000# dmove t3, srvacc ; And the acknowledgement message 31942 000575'01 104 00 0 00 000077 MTOPR% ; Finish the connection negotiation 31943 000576'01 320 12 0 00 000600' %jserr (,r) 31944 000577'01 254 00 0 00 000603' 31945 000600'01 265 01 0 00 000567* 31946 000601'01 000000000000# 31947 000602'01 254 00 0 00 000571* 31948 000323'04 103 157 165 154 144 31949 31950 000603'01 254 00 0 00 000503* retskp 31951 K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 19:42 30-Mar-24 Page 19 K20TIM MAC 9-Dec-23 22:56 Build cooresponding DCN: task name to SRV: 31952 subttl Build cooresponding DCN: task name to SRV: 31953 31954 ; N.B., the DCN string is a little convoluted, but it is generalized 31955 ; enough so that we could run tests between Tops-20 nodes, should we 31956 ; want to try that. 31957 31958 extern myname ; Name of local executor 31959 31960 000604'01 bldcnt: remark Means: BuiLd DCN Text 31961 000604'01 200 01 0 00 003550' move t1, [ BYTE (7) "D", "C", "N", ":", .chnul] 31962 000605'01 202 01 0 00 000000# movem t1, dcname ; Start device portion immediately 31963 000606'01 200 01 0 00 003551' move t1, [ point 7, dcname, 27 ] ; point before the .chnul 31964 31965 remark ; Could drop in /REMOTE:NODE here 31966 000607'01 336 00 0 00 000000* ifmn. myname ; Did we ever figure our local node name out? 31967 000610'01 254 00 0 00 000616' 31968 000611'01 200 02 0 00 003552' move t2, [ point 7,myname ] ; We did, so drop that in 31969 000612'01 do. ; Enter loop context 31970 000612'01 134 03 0 00 000002 ildb t3, t2 ; Pick a byte of the node name 31971 000613'01 322 03 0 00 000616' jumpe t3, endlp. ; Unless we've done all of it 31972 000614'01 136 03 0 00 000001 idpb t3, t1 ; Append to active component device 31973 000615'01 254 00 0 00 000612' loop. ; Get some more, wee!! 31974 000616'01 enddo. ; Exit loop context 31975 000616'01 endif. 31976 31977 000616'01 200 02 0 00 003553' move t2, [ point 7, dcntsk ] 31978 000617'01 do. ; Append the rest of the DECnet task gibberish 31979 000617'01 134 03 0 00 000002 ildb t3, t2 ; Pick a byte of the node name 31980 000620'01 322 03 0 00 000623' jumpe t3, endlp. ; Unless we've done all of it 31981 000621'01 136 03 0 00 000001 idpb t3, t1 ; Append to active component device 31982 000622'01 254 00 0 00 000617' loop. ; Get some more, wee!! 31983 000623'01 enddo. 31984 31985 000623'01 200 02 0 00 000000# move t2, whoami ; Load my user number 31986 000624'01 104 00 0 00 000041 DIRST% ; Tack that on after 31987 000625'01 320 12 0 00 000627' %jserr (,r) 31988 000626'01 254 00 0 00 000632' 31989 000627'01 265 01 0 00 000600* 31990 000630'01 000000000000# 31991 000631'01 254 00 0 00 000602* 31992 000337'04 106 141 151 154 145 31993 31994 000632'01 200 02 0 00 003554' move t2, [ point 7, dcndat ] 31995 000633'01 do. ; Append the ;DATA: attribute 31996 000633'01 134 03 0 00 000002 ildb t3, t2 ; Pick a byte of the node name 31997 000634'01 322 03 0 00 000637' jumpe t3, endlp. ; Unless we've done all of it 31998 000635'01 136 03 0 00 000001 idpb t3, t1 ; Append to active component device 31999 000636'01 254 00 0 00 000633' loop. ; Get some more, wee!! 32000 000637'01 enddo. 32001 32002 000637'01 200 04 0 00 000001 move t4, t1 ; Save output pointer 32003 000640'01 201 01 0 00 000000 movei t1, .HPELP ; Elapsed DK10 ticks since start 32004 000641'01 104 00 0 00 000501 HPTIM% ; Grab it 32005 000642'01 320 12 0 00 000644' %jserr (,r) 32006 000643'01 254 00 0 00 000647' K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 19:42 30-Mar-24 Page 19-1 K20TIM MAC 9-Dec-23 22:56 Build cooresponding DCN: task name to SRV: 32007 000644'01 265 01 0 00 000627* 32008 000645'01 000000000000# 32009 000646'01 254 00 0 00 000631* 32010 000351'04 125 156 141 142 154 32011 000647'01 202 01 0 00 000000# movem t1, tsktim ; Store as task time (for ;DATA:) 32012 32013 000650'01 200 02 0 00 000001 move t2, t1 ; Position uptime ticks 32014 000651'01 200 01 0 00 000004 move t1, t4 ; Reload output pointer 32015 000652'01 201 03 0 00 000012 movx t3, fld(^d10,no%rdx) ; 32016 000653'01 104 00 0 00 000224 NOUT% ; Tack that on 32017 000654'01 320 12 0 00 000656' %jserr (,r) 32018 000655'01 254 00 0 00 000661' 32019 000656'01 265 01 0 00 000644* 32020 000657'01 000000000000# 32021 000660'01 254 00 0 00 000646* 32022 000363'04 125 156 141 142 154 32023 32024 000661'01 254 00 0 00 000603* retskp ; Finally won 32025 K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 19:42 30-Mar-24 Page 20 K20TIM MAC 9-Dec-23 22:56 Device speed determination storage 32026 subttl Device speed determination storage 32027 32028 .endps code ; Get out of the code .psect 32029 .psect devtim/ronly,devorg; psect for reading and writing for timing 32030 32031 000000'06 devwrt: remark ; Where data will be written from 32032 000000' nulwrt==:devwrt ; Ditto for special case NUL: 32033 000000 $d$=.chnul ; Generated data starts at NUL 32034 000000 $c$=0 ; Rotating check digit starts at zero 32035 xlist ; Don't need silly listing 32036 list ; Turn listing back on 32037 001000 devwrd==.-devwrt ; Device words to write 32038 004000 devchr==devwrd*4 ; Corresponding 8 bit character count 32039 cleans(<$d$,$c$>) ; Chuck worker symbols 32040 32041 ; N.B., The below is a bit of a hack because the page won't exist, which 32042 ; means we can then create it and write it. Heh... 32043 32044 001000'06 devred: block ^d512 ; Where data will be read into 32045 002000'06 devdat: block ^d512 ; Additional data for NUL: timing 32046 003000'06 devda2: block ^d512 ; 2nd part of it 32047 .endps devtim ; End of timing .psect 32048 32049 .psect code ; Get back into code .psect 32050 K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 19:42 30-Mar-24 Page 21 K20TIM MAC 9-Dec-23 22:56 Device inferior fork timing code and storage 32051 subttl Device inferior fork timing code and storage 32052 32053 chgsec(code,data) ;;Inferior's storage 32054 000056'05 000000 000011 devpdl: devhlt ; Return to our HALTF% 32055 000057'05 block ^d19 ; Rest of inferior's stack 32056 000024 devstg==.-devpdl ; Length of inferior's storage 32057 retsec ; Back in code segment 32058 32059 ; Inferior code is in the AC's because I thought I was going to have a 32060 ; very restricted address space there. This is not possible because 32061 ; of the need to call the timing ending routine and catch its errors. 32062 ; 32063 ; Note, superior does a SOUTR% to force a 'push'; the inferior also 32064 ; does a SINR% because it appears to be SLIGHTLY faster. 32065 32066 000662' devcod=: . ; Inferior's code 32067 000000 phase 0 ; Inferior's program 32068 000000 44 10 0 00 000000# point 8,devred ; ac0/ Where we're reading to 32069 000001 000000 400000 .fhslf ; 1 t1/ This fork 32070 000002 000000 601405 lstrx1 ; 2 t2/ "Process has not encountered any errors" 32071 000003 777777 774000 - ; 3 t3/ length of data being read 32072 000004 000000 000000 0 ; 4 t4/ Stop on .chnul (ignored) 32073 000005 104 00 0 00 000147 devinf: RESET% ; 5 q1/ Inferior start up 32074 000006 320 12 0 00 000011 erjmpr devhlt ; 6 q2/ Handle any error by just stopping 32075 000007 104 00 0 00 000336 SETER% ; 7 q3/ Otherwise flag everything worked 32076 000010 320 12 0 00 000011 erjmpr devhlt ; 10 q4/ Shouldn't ever break ... 32077 000011 104 00 0 00 000170 devhlt: HALTF% ; 11 p2/ Completed initialization 32078 000012 201 01 0 00 000100 movei t1, .priin ; 12 p3/ Set by superior 32079 000013 200 02 0 00 000000 move t2, 0 ; 13 p4/ Load pointer 32080 000014 104 00 0 00 000052 SIN% ; 14 p5/ Do a counted read 32081 000015 320 12 0 00 000011 erjmpr devhlt ; 15 .fp/ Handle the error 32082 000016 254 00 0 00 002050' callret endtim ; 16 cx/ Finish the timing 32083 000017 777755 000000# -^d19,,devpdl ; p/ stack (17) 32084 32085 000702'01 dephase ; Restore normal location counter 32086 K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 19:42 30-Mar-24 Page 22 K20TIM MAC 9-Dec-23 22:56 Timing common storage 32087 subttl Timing common storage 32088 32089 chgsec(code,data) ;;Writeable storage for data transfer 32090 000102'05 timdev:: block 1 ; Device being timed 32091 000103'05 devacs: block ^d16 ; Timing fork AC's 32092 000123'05 chrptr: block 1 ;*** DO NOT ; Left halfword of section local pointer 32093 000124'05 chrcnt: block 1 ;REORDER ** ; Character count in current byte size 32094 retsec 32095 K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 19:42 30-Mar-24 Page 23 K20TIM MAC 9-Dec-23 22:56 Computer character pointer and counter construction 32096 subttl Computer character pointer and counter construction 32097 32098 ; Note, PTYLEN is the number of words in a single page and is common 32099 ; for all devices. 32100 32101 000702'01 333 04 0 00 000561* comput: skiple t4, pars4 ; Pick up byte size for SOUTR% 32102 000703'01 254 00 0 00 000706' ifskp. ; Was anything specifed? 32103 dmove t2,[ ; No, use defaults 32104 point 8,0 ; Using 8 bit bits 32105 000704'01 120 02 0 00 003555' - ] ; Number of characters in the single page 32106 000705'01 254 00 0 00 000713' else. ; Otherwise, need to do some coversions 32107 000706'01 120 02 0 00 003557' dmove t2,[exp -1,-^d36] ;Load double negative integer 36 32108 000707'01 234 02 0 00 000004 div t2, t4 ; Calculate bytes per word 32109 000710'01 225 02 0 00 001000 muli t2, ptylen ; Now have total bytes we'll do in t3 32110 000711'01 205 02 0 00 440000 movx t2, ; Set up for an ILDB at bit '36' 32111 000712'01 137 04 0 00 003561' dpb t4, [ pointr t2, sbyte ] ; Drop in the byte size 32112 000713'01 endif. ; End non-standard byte size 32113 32114 000713'01 124 02 0 00 000000# dmovem t2, chrptr ; Store pointer prototype and count 32115 000714'01 263 17 0 00 000000 ret 32116 K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 19:42 30-Mar-24 Page 24 K20TIM MAC 9-Dec-23 22:56 Multi-fork timing common code 32117 subttl Multi-fork timing common code 32118 32119 ; See commentary on timing PTY virtual baud rate. These numbers are 32120 ; only used to validate the granularity of regular transfers 32121 32122 extern frclose ; Force a JFN closed 32123 extern cmprmn ; cmpse in k20ioc 32124 32125 000715'01 tcommn: remark ; Assumes these are saved 32126 remark ; N.B., q4 and p1 are aliases!! 32127 32128 000715'01 400 12 0 00 000000 setz p2, ;[223] No inferior fork yet 32129 000716'01 260 17 0 00 001601' call parset ;[223] Set up parity, if doing parity 32130 000717'01 254 00 0 00 001235' jrst epicom ;[223] Beat it, we've got to fix our tables 32131 32132 000720'01 201 01 0 00 000020 movx t1, ^d16 ; Transferring 16 accumulators 32133 dmove t2, [ devcod ; Source is device code 32134 000721'01 120 02 0 00 003562' devacs ] ; Destination is writable storage 32135 000722'01 123 01 0 00 003564' xblt. t1 ; Transfer so we can modify it 32136 32137 000723'01 201 03 0 00 000000# movei t3, devacs ; Resolve address of writable AC's 32138 000724'01 120 01 0 00 000000# dmove t1, chrptr ; Load byte pointer prototype and count 32139 000725'01 502 01 0 03 000000 hllm t1, 0(t3) ; Tweak byte size and pointer 32140 000726'01 202 02 0 03 000003 movem t2, t3(t3) ; Put the correct count in 32141 32142 remark ; N.B., cr%map makes a real gross page map, sigh. 32143 dmove t1, [ cr%map!cr%acs!cr%st!fld(devinf,cr%pcv) 32144 000727'01 120 01 0 00 003565' devacs ] ; Set AC's to have device inferior code 32145 000730'01 104 00 0 00 000152 CFORK% ; Make me a fork (poof! You're a fork) 32146 000731'01 320 12 0 00 000733' %jserr (,epicom) 32147 000732'01 254 00 0 00 000736' 32148 000733'01 265 01 0 00 000656* 32149 000734'01 000000000000# 32150 000735'01 254 00 0 00 001235' 32151 000375'04 103 157 165 154 144 32152 000736'01 200 12 0 00 000001 move p2, t1 ; store inferior handle 32153 32154 000737'01 200 01 0 00 000012 move t1, p2 ; Load inferior's handle 32155 000740'01 104 00 0 00 000163 WFORK% ; Wait for inferior initialization completion 32156 000741'01 320 12 0 00 000743' %jserr(, epicom) 32157 000742'01 254 00 0 00 000746' 32158 000743'01 265 01 0 00 000733* 32159 000744'01 000000000000# 32160 000745'01 254 00 0 00 001235' 32161 000403'04 125 156 141 142 154 32162 000746'01 104 00 0 00 000012 GETER% ; Find out inferior's last error 32163 000747'01 320 12 0 00 000751' %jserr(, epicom) 32164 000750'01 254 00 0 00 000754' 32165 000751'01 265 01 0 00 000743* 32166 000752'01 000000000000# 32167 000753'01 254 00 0 00 001235' 32168 000416'04 125 156 141 142 154 32169 000754'01 621 02 0 00 777777 tlz t2, -1 ; Stomp silly fork handle 32170 000755'01 306 02 0 00 601405 cain t2, lstrx1 ; Everything's Archie, right? 32171 000756'01 254 00 0 00 000766' ifskp. ; It isn't, so complain K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 19:42 30-Mar-24 Page 24-1 K20TIM MAC 9-Dec-23 22:56 Multi-fork timing common code 32172 000757'01 201 01 0 00 400000 movei t1, .fhslf ; Set our last error to inferior's 32173 000760'01 104 00 0 00 000336 SETER% ; So diagnostic message is more meaningful 32174 000761'01 334 00 0 00 000000 %ermsg(,epicom) 32175 000762'01 254 00 0 00 000766' 32176 000763'01 265 01 0 00 000751* 32177 000764'01 000000000000# 32178 000765'01 254 00 0 00 001235' 32179 000430'04 111 156 146 145 162 32180 000766'01 endif. 32181 32182 remark t1, .fhinf ; Still has the fork handle 32183 000766'01 514 02 0 00 000006 hrlz t2, q2 ; Load PTY's TTY JFN as inferior's primary input 32184 000767'01 541 02 0 00 777777 hrri t2, .cttrm ; But it can still write to our terminal 32185 000770'01 104 00 0 00 000207 SPJFN% ; Set it so SINR% doesn't break 32186 000771'01 320 12 0 00 000773' %jserr(, epicom) 32187 000772'01 254 00 0 00 000776' 32188 000773'01 265 01 0 00 000763* 32189 000774'01 000000000000# 32190 000775'01 254 00 0 00 001235' 32191 000441'04 125 156 141 142 154 32192 000776'01 416 00 0 00 000000# setmm devred ; Create reading page, so not creation time charge 32193 000777'01 661 01 0 00 400000 txo t1, sf%con ; Continuing inferior 32194 001000'01 104 00 0 00 000157 SFORK% ; Get it started in its read 32195 001001'01 320 12 0 00 001003' %jserr(, epicom) 32196 001002'01 254 00 0 00 001006' 32197 001003'01 265 01 0 00 000773* 32198 001004'01 000000000000# 32199 001005'01 254 00 0 00 001235' 32200 000451'04 125 156 141 142 154 32201 32202 001006'01 621 01 0 00 400000 txz t1, sf%con ; Get a clean fork handle 32203 001007'01 201 02 0 00 000000# movei t2, devacs ; Load address of inferior AC block 32204 dmove t3, [ lstrx1 ; What indicates it isn't in SINR%, yet 32205 001010'01 120 03 0 00 003567' ^d20 ] ; Only wait 5 seconds (.25 * 20) 32206 32207 001011'01 do. ; Enter inferior fork check loop context 32208 001011'01 104 00 0 00 000154 FFORK% ; Freeze inferor (so we can read its AC's) 32209 001012'01 320 12 0 00 001014' %jserr (,epicom) 32210 001013'01 254 00 0 00 001017' 32211 001014'01 265 01 0 00 001003* 32212 001015'01 000000000000# 32213 001016'01 254 00 0 00 001235' 32214 000461'04 125 156 141 142 154 32215 001017'01 104 00 0 00 000161 RFACS% ; Read inferior's accumulators 32216 001020'01 320 12 0 00 001022' %jserr (,epicom) 32217 001021'01 254 00 0 00 001025' 32218 001022'01 265 01 0 00 001014* 32219 001023'01 000000000000# 32220 001024'01 254 00 0 00 001235' 32221 000467'04 125 156 141 142 154 32222 001025'01 104 00 0 00 000155 RFORK% ; And resume the fork 32223 001026'01 320 12 0 00 001030' %jserr (,epicom) 32224 001027'01 254 00 0 00 001033' 32225 001030'01 265 01 0 00 001022* 32226 001031'01 000000000000# K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 19:42 30-Mar-24 Page 24-2 K20TIM MAC 9-Dec-23 22:56 Multi-fork timing common code 32227 001032'01 254 00 0 00 001235' 32228 000477'04 125 156 141 142 154 32229 001033'01 312 03 0 02 000002 came t3, t2(t2) ; Not in the SINR% yet? 32230 001034'01 254 00 0 00 001041' exit. ; Finally in the SINR% (or real close!!) 32231 001035'01 201 01 0 00 000372 movei t1, ^d250 ; Wait a bit for it to turn back on 32232 001036'01 104 00 0 00 000167 DISMS% ; And chill out for a bit 32233 001037'01 200 01 0 00 000012 move t1, p2 ; Reload the fork handle 32234 001040'01 367 04 0 00 001011' sojg t4, top. ; Try again (but only so long) 32235 001041'01 enddo. ; Exit loop context 32236 32237 001041'01 326 04 0 00 001047' ife. t4 ; Exhausted the count? 32238 001042'01 334 00 0 00 000000 %ermsg (,epicom) 32239 001043'01 254 00 0 00 001047' 32240 001044'01 265 01 0 00 001030* 32241 001045'01 000000000000# 32242 001046'01 254 00 0 00 001235' 32243 000505'04 124 151 155 145 144 32244 001047'01 endif. ; piffle.... 32245 32246 remark ; Loop appears to be unnecessary for inter-job... 32247 001047'01 260 17 0 00 002033' call statim ; Start timing the transfer 32248 001050'01 120 02 0 00 000000# dmove t2, chrptr ; Load pointer prototype and count 32249 001051'01 541 02 0 00 000000# hrri t2, devwrt ; Where we're writing from 32250 001052'01 332 00 0 00 000000# skipe timpar ;[223] Unless doing parity 32251 001053'01 541 02 0 00 000000# hrri t2, devdat ;[223] OK, so we're doing it with parity bits set 32252 001054'01 201 13 0 00 000031 movei p3, ^d25 ; Only wait so long for buffers to drain 32253 ; Loop is because of limited monitor buffers 32254 001055'01 do. ; Enter loop context 32255 001055'01 550 01 0 00 000005 hrrz t1, q1 ; Load the source JFN (no flags) 32256 001056'01 200 04 0 00 000003 move t4, t3 ; Save a copy of remaining character count 32257 001057'01 104 00 0 00 000532 SOUTR% ; Blammo!! 32258 001060'01 320 12 0 00 001062' ifje. r ; Uh oh, investigate the failure 32259 001061'01 254 00 0 00 001071' 32260 001062'01 306 01 0 00 602423 cain t1, IOX33 ; Inferior couldn't swallow all of it at once? 32261 001063'01 254 00 0 00 001071' anskp. ; Nope; however, we can recover from this 32262 001064'01 334 00 0 00 000000 %ermsg(, epicom) 32263 001065'01 254 00 0 00 001071' 32264 001066'01 265 01 0 00 001044* 32265 001067'01 000000000000# 32266 001070'01 254 00 0 00 001235' 32267 000515'04 125 156 141 142 154 32268 001071'01 endif. ; Carry on if worked or IOX33 32269 001071'01 322 03 0 00 001101' jumpe t3, endlp. ; If done, then leave 32270 001072'01 312 03 0 00 000004 came t3, t4 ; Did it do anything, actually? 32271 001073'01 254 00 0 00 001055' loop. ; Yes, so ready to do some more 32272 001074'01 260 17 0 00 001327' call ckdtwr ; Otherwise, check device write status 32273 001075'01 254 00 0 00 001235' jrst epicom ; Something went wrong or is bad 32274 001076'01 201 01 0 00 000144 movei t1, ^d100 ; Give inferior a chance to run 32275 001077'01 104 00 0 00 000167 DISMS% ; So it can catch its breath 32276 001100'01 367 13 0 00 001055' sojg p3, top. ; And try another drop 32277 001101'01 enddo. ; Exit loop context 32278 32279 001101'01 326 13 0 00 001107' ife. p3 ; Exhausted the count? 32280 001102'01 334 00 0 00 000000 %ermsg (,epicom) 32281 001103'01 254 00 0 00 001107' K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 19:42 30-Mar-24 Page 24-3 K20TIM MAC 9-Dec-23 22:56 Multi-fork timing common code 32282 001104'01 265 01 0 00 001066* 32283 001105'01 000000000000# 32284 001106'01 254 00 0 00 001235' 32285 000526'04 124 151 155 145 144 32286 001107'01 endif. ; piffle.... 32287 32288 remark ; Repeating previous code for better error messages 32289 001107'01 200 01 0 00 000012 move t1, p2 ; Load inferior's handle 32290 001110'01 104 00 0 00 000163 WFORK% ; Wait for inferior SINR% to complete 32291 001111'01 320 12 0 00 001113' %jserr(,epicom) 32292 001112'01 254 00 0 00 001116' 32293 001113'01 265 01 0 00 001104* 32294 001114'01 000000000000# 32295 001115'01 254 00 0 00 001235' 32296 000535'04 125 156 141 142 154 32297 001116'01 104 00 0 00 000012 GETER% ; Find out inferior's last error 32298 001117'01 320 12 0 00 001121' %jserr(,epicom) 32299 001120'01 254 00 0 00 001124' 32300 001121'01 265 01 0 00 001113* 32301 001122'01 000000000000# 32302 001123'01 254 00 0 00 001235' 32303 000547'04 125 156 141 142 154 32304 001124'01 621 02 0 00 777777 tlz t2, -1 ; Stomp silly fork handle 32305 001125'01 306 02 0 00 601405 cain t2, lstrx1 ; Everything's Archie, right? 32306 001126'01 254 00 0 00 001136' ifskp. ; It isn't, so complain 32307 001127'01 201 01 0 00 400000 movei t1, .fhslf ; Set our last error to inferior's 32308 001130'01 104 00 0 00 000336 SETER% ; So diagnostic message is more meaningful 32309 001131'01 334 00 0 00 000000 %ermsg(,epicom) 32310 001132'01 254 00 0 00 001136' 32311 001133'01 265 01 0 00 001121* 32312 001134'01 000000000000# 32313 001135'01 254 00 0 00 001235' 32314 000561'04 111 156 146 145 162 32315 001136'01 endif. 32316 32317 001136'01 260 17 0 00 002133' call elptim ; Compute elapsed transfer time 32318 32319 001137'01 260 17 0 00 001750' call parchk ;[223] Check parity, if doing parity 32320 001140'01 254 00 0 00 001235' jrst epicom ;[223] Skip the rest of it 32321 32322 remark ; Check the data made it over correctly 32323 001141'01 415 16 0 00 001161' block. ; Build a stack frame to preserve registers 32324 001142'01 261 17 0 00 000016 32325 001143'01 332 00 0 00 000000# skipe timpar ;[223] Did we already check the parity? 32326 001144'01 254 00 0 00 000661* retskp ;[223] We did, so if made it here, everything is fine 32327 001145'01 265 16 0 00 003571' saveac ; Need to save these 32328 001146'01 210 01 0 00 000000# movn t1, chrcnt ; Load length of string sent 32329 001147'01 200 04 0 00 000001 move t4, t1 ; Strings are the same length 32330 001150'01 403 03 0 00 000006 setzb t3, q2 ; Section local string pointers 32331 001151'01 200 02 0 00 000000# move t2, chrptr ; Load correct character pointer and size 32332 001152'01 510 05 0 00 000002 hllz q1, t2 ; Both sources are equivalent here 32333 001153'01 541 02 0 00 000000# hrri t2, devwrt ; What we wrote 32334 001154'01 541 05 0 00 000000# hrri q1, devred ; What we read 32335 001155'01 123 01 0 00 000000* extend t1, cmprmn ; See if everything made it through OK 32336 001156'01 263 17 0 00 000000 ret ; Not equal, phooey! K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 19:42 30-Mar-24 Page 24-4 K20TIM MAC 9-Dec-23 22:56 Multi-fork timing common code 32337 001157'01 254 00 0 00 001144* retskp ; Equal!! 32338 001160'01 263 17 0 00 000000 endbk. ; End block 32339 001161'01 254 00 0 00 001164' ifskp. ; Worked 32340 001162'01 600 00 0 00 000000 nop ; No special action, carry on 32341 001163'01 254 00 0 00 001202' else. ; Failed??? 32342 001164'01 200 03 0 00 000001 move t3, t1 ; Save source character count 32343 001165'01 200 06 0 00 000002 move q2, t2 ; Save source character pointer 32344 001166'01 200 01 0 00 000000# emsg () 32345 001167'01 104 00 0 00 000313 32346 000141'02 000000000000# 32347 000571'04 124 151 155 151 156 32348 001170'01 201 01 0 00 000101 movei t1, .priou ; Continue blatting 32349 001171'01 210 02 0 00 000000# movn t2, chrcnt ; Load length of string sent 32350 001172'01 274 02 0 00 000003 sub t2, t3 ; Subtract remaining characters 32351 001173'01 201 03 0 00 000012 movei t3, fld(^d10,no%rdx) 32352 001174'01 104 00 0 00 000224 NOUT% ; Shows what character we croaked on 32353 001175'01 320 12 0 00 001176' erjmpr .+1 32354 001176'01 561 01 0 00 000240* hrroi t1, crlf 32355 001177'01 104 00 0 00 000076 PSOUT% 32356 001200'01 320 12 0 00 001201' erjmpr .+1 32357 001201'01 254 00 0 00 001235' jrst epicom 32358 001202'01 endif. 32359 32360 remark ; Finally get to do some arithmatic!! 32361 001202'01 400 01 0 00 000000 setz t1, ; Load integer high order of character count 32362 001203'01 210 02 0 00 000000# movn t2, chrcnt ; Load load order character count 32363 001204'01 116 01 0 00 003601' dmul t1, [exp 0, ^d100000*^d10 ] ; Scale to bits in microsecond time 32364 001205'01 120 01 0 00 000003 dmove t1, t3 ; Load low order double word 32365 001206'01 260 17 0 00 003301' call dfloat ; Convert to double floating point 32366 001207'01 334 00 0 00 000000 %ermsg (, epicom) 32367 001210'01 254 00 0 00 001214' 32368 001211'01 265 01 0 00 001133* 32369 001212'01 000000000000# 32370 001213'01 254 00 0 00 001235' 32371 000603'04 125 156 141 142 154 32372 001214'01 120 03 0 00 000001 dmove t3, t1 ; Save double floating bit count 32373 32374 001215'01 120 01 0 00 000000# dmove t1, ewallt+.datus ; Load tens of nanoseconds used 32375 001216'01 260 17 0 00 003301' call dfloat ; Convert to double floating point 32376 001217'01 334 00 0 00 000000 %ermsg (, epicom) 32377 001220'01 254 00 0 00 001224' 32378 001221'01 265 01 0 00 001211* 32379 001222'01 000000000000# 32380 001223'01 254 00 0 00 001235' 32381 000612'04 125 156 141 142 154 32382 001224'01 113 03 0 00 000001 dfdv t3, t1 ; Divide bits by ticks 32383 32384 001225'01 415 16 0 00 001232' block. ; Enter block context for another frame 32385 001226'01 261 17 0 00 000016 32386 001227'01 265 16 0 00 003603' saveac ; Save result before the call 32387 001230'01 260 17 0 00 001235' call epicom ; Stomp everything 32388 001231'01 263 17 0 00 000000 endbk. ; Exit block context 32389 32390 001232'01 200 05 0 00 000004 move t5, t4 ; Return virtual baud rate for some device 32391 001233'01 200 04 0 00 000003 move t4, t3 ; Return the high order, too K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 19:42 30-Mar-24 Page 24-5 K20TIM MAC 9-Dec-23 22:56 Multi-fork timing common code 32392 001234'01 254 00 0 00 001157* retskp ; Return success 32393 K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 19:42 30-Mar-24 Page 25 K20TIM MAC 9-Dec-23 22:56 Common timing test epilogue code 32394 subttl Common timing test epilogue code 32395 32396 ; N.B., Do not change the order of resource release, below! 32397 ; 32398 ; 1) An open JFN that is in active use via an SPJFN% can not be 32399 ; closed or even force closed, the error being an arcane CLSX2, 32400 ; "File cannot be closed by this process". 32401 ; 32402 ; This is why the SPJFN% is done before any close attempts. 32403 ; (Learned that the hard way...) 32404 ; 32405 ; 2) The SPJFN% is also done before the KFORK% as a caution to the 32406 ; JFN being left in an odd way or the KFORK% failing. 32407 32408 001235'01 336 01 0 00 000012 epicom: skipn t1, p2 ; Did we have a fork? 32409 001236'01 254 00 0 00 001257' ifskp. ; We did, chuck it 32410 001237'01 200 02 0 00 003613' movx t2, <.nulio,,.nulio> ; Truely shut it up 32411 001240'01 104 00 0 00 000207 SPJFN% ; Attempt the muzzling 32412 001241'01 320 12 0 00 001243' ifje. r ; Catch and store error 32413 001242'01 254 00 0 00 001245' 32414 001243'01 200 04 0 00 000001 move t4, t1 ; Store error for debuggers 32415 001244'01 200 01 0 00 000012 move t1, p2 ; Reload the fork handle 32416 001245'01 endif. ; But carry on in either case 32417 001245'01 403 03 0 00 000004 setzb t3, t4 ; Whack JSYS error talismen 32418 001246'01 104 00 0 00 000153 KFORK% ; Try to clobber the inferior 32419 001247'01 320 12 0 00 001251' ifje. r ; Catch and store error 32420 001250'01 254 00 0 00 001256' 32421 001251'01 200 04 0 00 000001 move t4, t1 ; Store error for debuggers 32422 001252'01 200 01 0 00 000012 move t1, p2 ; Reload the fork handle again 32423 001253'01 104 00 0 00 000165 RFRKH% ; At least try to release that 32424 001254'01 254 00 0 00 001256' ifskp. ; There is no joy in mudville 32425 001255'01 200 03 0 00 000001 move t3, t1 ; Store for debuggders 32426 001256'01 endif. ; End case RFRKH% failure handling 32427 001256'01 endif. ; Continue and clean up storage 32428 001256'01 400 12 0 00 000000 setz p2, ; Either way, no more fork 32429 001257'01 endif. 32430 32431 001257'01 336 01 0 00 000006 skipn t1, q2 ; Did we ever have a destination JFN? 32432 001260'01 254 00 0 00 001264' ifskp. ; We did 32433 001261'01 260 17 0 00 000000* call frclose ; Force it closed (see k20sub) 32434 001262'01 600 00 0 00 000000 nop ; Failed somehow 32435 001263'01 400 06 0 00 000000 setz q2, ; Either way, no destination JFN 32436 001264'01 endif. 32437 32438 001264'01 336 01 0 00 000005 skipn t1, q1 ; Did we ever have a source JFN? 32439 001265'01 254 00 0 00 001271' ifskp. ; We did 32440 001266'01 260 17 0 00 001261* call frclose ; Force it closed (see k20sub) 32441 001267'01 600 00 0 00 000000 nop ; Failed somehow 32442 001270'01 400 05 0 00 000000 setz q1, ; Either way, no source JFN 32443 001271'01 endif. 32444 32445 001271'01 474 01 0 00 000000 seto t1, ; Removing pages 32446 dmove t2,[.fhslf,,nulpag+1 ;Whacking dirty pages from address space 32447 001272'01 120 02 0 00 003614' pm%cnt!pm%abt!fld(,pm%cnt) ] 32448 001273'01 104 00 0 00 000056 PMAP% ; Reduce our working set size K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 19:42 30-Mar-24 Page 25-1 K20TIM MAC 9-Dec-23 22:56 Common timing test epilogue code 32449 001274'01 320 12 0 00 001276' ifje. r ; Should never happen... 32450 001275'01 254 00 0 00 001277' 32451 001276'01 200 04 0 00 000001 move t4, t1 ; Store error for debuggers 32452 001277'01 endif. 32453 32454 001277'01 336 01 0 00 000010 skipn t1, q4 ; Did we assign the PTY's associated terminal? 32455 001300'01 254 00 0 00 001306' ifskp. ; We did, release it 32456 001301'01 104 00 0 00 000071 RELD% ; Try to punt the TTY 32457 001302'01 320 12 0 00 001304' ifje. r ; Catch and store error 32458 001303'01 254 00 0 00 001305' 32459 001304'01 200 04 0 00 000001 move t4, t1 ; Store error for debuggers 32460 001305'01 endif. ; Carry on! 32461 001305'01 400 10 0 00 000000 setz q4, ; Either way, no assigned terminal 32462 001306'01 endif. 32463 32464 001306'01 336 01 0 00 000007 skipn t1, q3 ; Did we assign a PTY? 32465 001307'01 254 00 0 00 001326' ifskp. ; We did, release it 32466 001310'01 104 00 0 00 000071 RELD% ; Try to punt the PTY 32467 001311'01 320 12 0 00 001313' ifje. r ; Catch and store error 32468 001312'01 254 00 0 00 001314' 32469 001313'01 200 04 0 00 000001 move t4, t1 ; Store error for debuggers 32470 001314'01 endif. ; Continue and clean up storage 32471 001314'01 400 07 0 00 000000 setz q3, ; Either way, no assigned PTY 32472 001315'01 402 00 0 00 000260* setzm asgflg ; Clear device assignment flag 32473 001316'01 402 00 0 00 000000* setzm asgdev ; Clear stored assigned device 32474 001317'01 402 00 0 00 000000* setzm ptytty ; Clear PTY's associated TTY line number 32475 001320'01 402 00 0 00 000000* setzm ptyflg ; Clear pseudo-terminal I/O flag 32476 001321'01 402 00 0 00 000000* setzm binflg ; Clear binary I/O flag 32477 001322'01 403 01 0 00 000002 setzb t1, t2 ; Cons up a zero double word 32478 001323'01 124 01 0 00 000000* dmovem t1, ndvchr ; Whack characteristics double word 32479 001324'01 124 01 0 00 000000* dmovem t1, ttynam ; No ASCII terminal device name 32480 001325'01 124 01 0 00 000000* dmovem t1, ptynam ; No pseudo-terminal device name 32481 001326'01 endif. 32482 32483 001326'01 263 17 0 00 000000 ret ; Phew!! 32484 K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 19:42 30-Mar-24 Page 26 K20TIM MAC 9-Dec-23 22:56 Device lower fork checking code 32485 subttl Device lower fork checking code 32486 32487 ; Here if the upper fork SOUTR% fails and the byte count is unchanged 32488 32489 define errtxt (t,%t,%et) < ;;Macro to put a string in text section 32490 move t1,%t ;;Local pointer to text 32491 32492 chgsec(code,const) ;;Put pointer to extended text in const section 32493 %t: .px7!%et ;;OWGP to extended section 32494 retsec ;;Restore .PSECT assumptions 32495 32496 chgsec(code,etext) ;;Open non-section zero text 32497 %et: asciz |'t| ;;Deposit text and label text with generated symbol 32498 retsec ;;Restore .PSECT assumptions 32499 cleans(<%t,%et>) ;;Punt generated symbols 32500 >;;errtxt 32501 32502 001327'01 265 16 0 00 003616' ckdtwr: saveac ; Modifies no registers 32503 32504 remark ; First, pull fork information 32505 001330'01 200 01 0 00 000012 move t1, p2 ; Load inferior's handle 32506 001331'01 104 00 0 00 000012 GETER% ; Get its last error 32507 001332'01 320 12 0 00 001334' %jserr(, r) 32508 001333'01 254 00 0 00 001337' 32509 001334'01 265 01 0 00 001221* 32510 001335'01 000000000000# 32511 001336'01 254 00 0 00 000660* 32512 000621'04 125 156 141 142 154 32513 001337'01 621 02 0 00 777777 tlz t2, -1 ; Stomp silly fork handle 32514 001340'01 200 07 0 00 000002 move q3, t2 ; And save the last error 32515 001341'01 200 01 0 00 000012 move t1, p2 ; Load inferior's handle 32516 001342'01 104 00 0 00 000156 RFSTS% ; Return fork status 32517 001343'01 320 12 0 00 001345' %jserr(, r) 32518 001344'01 254 00 0 00 001350' 32519 001345'01 265 01 0 00 001334* 32520 001346'01 000000000000# 32521 001347'01 254 00 0 00 001336* 32522 000630'04 125 156 141 142 154 32523 001350'01 621 02 0 00 777777 tlz t2, -1 ; Stomp any flags 32524 001351'01 120 05 0 00 000001 dmove q1, t1 ; Save the inferior's status and PC 32525 32526 001352'01 135 04 0 00 003634' ldb t4, [pointr. q1, rf%sts] 32527 001353'01 305 04 0 00 000011 caige t4, .rfmax ; Out of range? 32528 001354'01 254 00 0 00 001366' ifskp. ; Must be a new monitor 32529 001355'01 201 01 0 00 400000 movei t1, .fhslf ; Set our last error 32530 001356'01 200 02 0 00 000007 move t2, q3 ; To inferior's for better 32531 001357'01 104 00 0 00 000336 SETER% ; Diagnostic messages 32532 001360'01 320 12 0 00 001361' erjmpr .+1 ; Catch and ignore error 32533 001361'01 334 00 0 00 000000 %ermsg(,r) 32534 001362'01 254 00 0 00 001366' 32535 001363'01 265 01 0 00 001345* 32536 001364'01 000000000000# 32537 001365'01 254 00 0 00 001347* 32538 000640'04 111 156 146 145 162 32539 001366'01 endif. ; But regular handler won't work K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 19:42 30-Mar-24 Page 26-1 K20TIM MAC 9-Dec-23 22:56 Device lower fork checking code 32540 32541 001366'01 306 07 0 00 601405 cain q3, lstrx1 ; Everything's Archie, right? 32542 001367'01 254 00 0 00 001372' ifskp. ; It isn't, so complain 32543 001370'01 200 01 0 00 000000# errtxt() 32544 000142'02 000000000000# 32545 000650'04 111 156 146 145 162 32546 001371'01 254 00 0 00 001414' callret ckderr ; Return from error type out 32547 001372'01 endif. 32548 32549 001372'01 325 05 0 00 001375' ifxn. q1, rf%frz ; Did it get frozen somehow? 32550 001373'01 200 01 0 00 000000# errtxt() 32551 000143'02 000000000000# 32552 000662'04 111 156 146 145 162 32553 001374'01 254 00 0 00 001414' callret ckderr ; Return from error type out 32554 001375'01 endif. ; Should never happen in the push loop 32555 ; Otherwise, load its status 32556 001375'01 306 04 0 00 000000 cain t4, .rfrun ; Running? 32557 001376'01 254 00 0 00 001234* retskp ; That's OK. I guess... 32558 001377'01 306 04 0 00 000001 cain t4, .rfio ; Doing I/O? 32559 001400'01 254 00 0 00 001376* retskp ; This is expected (what its supposed to be doing) 32560 001401'01 302 04 0 00 000002 caie t4, .rfhlt ; Halted?? 32561 001402'01 254 00 0 00 001413' ifskp. ; That might be OK, actually 32562 001403'01 302 06 0 00 000012 caie q2, devhlt+1 ; Normal halt? 32563 001404'01 254 00 0 00 001411' ifskp. ; Yes, so need to wait for buffers to drain 32564 txmsg <% Inferior timing fork normal termination, waiting on buffers 32565 001405'01 200 01 0 00 000000# > 32566 001406'01 104 00 0 00 000076 32567 001407'01 320 12 0 00 001410' 32568 000144'02 000000000000# 32569 000673'04 045 040 111 156 146 32570 32571 001410'01 254 00 0 00 001400* retskp ; And try again 32572 001411'01 endif. ; Otherwise, a real error 32573 001411'01 200 01 0 00 000000# errtxt() 32574 000145'02 000000000000# 32575 000710'04 111 156 146 145 162 32576 001412'01 254 00 0 00 001414' callret ckderr ; Return from error type out 32577 001413'01 endif. 32578 32579 remark ; Any other status is bad 32580 001413'01 200 01 0 00 000000# errtxt () 32581 000146'02 000000000000# 32582 000720'04 111 156 146 145 162 32583 remark ckderr ; Fall through to error type out 32584 K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 19:42 30-Mar-24 Page 27 K20TIM MAC 9-Dec-23 22:56 Handle print out of inferior error 32585 subttl Handle print out of inferior error 32586 32587 ; Expects ckptwr register environment except t1 has an error message 32588 32589 001414'01 104 00 0 00 000313 ckderr: ESOUT% ; First, do the blat 32590 001415'01 320 12 0 00 001416' erjmpr .+1 ; Catch and ignore error 32591 001416'01 201 01 0 00 000054 movei t1, "," ; Punctuate first part of error message 32592 001417'01 104 00 0 00 000074 PBOUT% 32593 001420'01 320 12 0 00 001421' erjmpr .+1 ; Catch and ignore error 32594 001421'01 201 01 0 00 000040 movei t1, .chspc ; And space over 32595 001422'01 104 00 0 00 000074 PBOUT% 32596 001423'01 320 12 0 00 001424' erjmpr .+1 ; Catch and ignore error 32597 32598 001424'01 200 01 0 04 001475' move t1,rfstst(t4) ; Load appropriate status text 32599 001425'01 104 00 0 00 000076 PSOUT% ; Type it 32600 001426'01 320 12 0 00 001427' erjmpr .+1 ; Catch and ignore error 32601 32602 001427'01 302 04 0 00 000003 caie t4, .rffpt ; Forced? 32603 001430'01 254 00 0 00 001445' ifskp. ; Then we have some more information 32604 001431'01 200 01 0 00 000000# errtxt (<, channel: >) ;Meaning, the channel number 32605 000147'02 000000000000# 32606 000730'04 054 040 143 150 141 32607 001432'01 104 00 0 00 000076 PSOUT% ; Type that 32608 001433'01 320 12 0 00 001434' erjmpr .+1 ; Catch and ignore error 32609 001434'01 201 01 0 00 000101 movei t1, .priou ; Output to our terminal 32610 001435'01 135 02 0 00 003635' ldb t2, [pointr. q1, rf%sic] ; Load forcing channel 32611 001436'01 201 03 0 00 000012 movei t3, ^d10 ; Which is in base 10 32612 001437'01 104 00 0 00 000224 NOUT% ; Type it 32613 001440'01 334 00 0 00 000000 %ermsg(,r) 32614 001441'01 254 00 0 00 001445' 32615 001442'01 265 01 0 00 001363* 32616 001443'01 000000000000# 32617 001444'01 254 00 0 00 001365* 32618 000733'04 111 156 146 145 162 32619 001445'01 endif. 32620 32621 001445'01 201 01 0 00 000054 movei t1, "," ; Punctuate first part of error message 32622 001446'01 104 00 0 00 000074 PBOUT% 32623 001447'01 320 12 0 00 001450' erjmpr .+1 ; Catch and ignore error 32624 001450'01 201 01 0 00 000040 movei t1, .chspc ; And space over 32625 001451'01 104 00 0 00 000074 PBOUT% 32626 001452'01 320 12 0 00 001453' erjmpr .+1 ; Catch and ignore error 32627 32628 001453'01 200 01 0 00 000101 move t1, .priou ; Going to primary output 32629 001454'01 505 02 0 00 400000 hrli t2, .fhslf ; Have to use ourself for explicit error 32630 001455'01 540 02 0 00 000007 hrr t2, q3 ; Pick up inferior handle 32631 001456'01 400 03 0 00 000000 setz t3, ; No limit to blat 32632 001457'01 104 00 0 00 000011 ERSTR% ; Blat away! 32633 001460'01 320 12 0 00 001462' erjmpr .+2 ; Ignore its strange return 32634 001461'01 320 12 0 00 001462' erjmpr .+1 ; Ignore its stranger return 32635 32636 001462'01 201 01 0 00 000054 movei t1, "," ; Punctuate first part of error message 32637 001463'01 104 00 0 00 000074 PBOUT% 32638 001464'01 320 12 0 00 001465' erjmpr .+1 ; Catch and ignore error 32639 001465'01 201 01 0 00 000040 movei t1, .chspc ; And space over K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 19:42 30-Mar-24 Page 27-1 K20TIM MAC 9-Dec-23 22:56 Handle print out of inferior error 32640 001466'01 104 00 0 00 000074 PBOUT% 32641 001467'01 320 12 0 00 001470' erjmpr .+1 ; Catch and ignore error 32642 32643 001470'01 200 01 0 00 000006 move t1, q2 ; Load inferior's captured PC 32644 001471'01 260 17 0 00 000000* call symout ; Symbolic type out of failed location 32645 32646 001472'01 561 01 0 00 001176* hrroi t1, crlf ; Tie off the line 32647 001473'01 104 00 0 00 000076 PSOUT% 32648 32649 001474'01 263 17 0 00 000000 ret ; Always return +1 to superior 32650 K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 19:42 30-Mar-24 Page 28 K20TIM MAC 9-Dec-23 22:56 Text for fork status codes 32651 subttl Text for fork status codes 32652 32653 remark ; RF%STS (Process Status Code) 32654 001475'01 000000000000# rfstst: eascii (< Runnable>) ; .RFRUN 32655 000741'04 040 122 165 156 156 32656 001476'01 000000000000# eascii (< I/O>) ; .RFIO (Dismissed for I/O) 32657 000743'04 040 111 057 117 000 32658 001477'01 000000000000# eascii (< Halted>) ; .RFHLT 32659 000744'04 040 110 141 154 164 32660 001500'01 000000000000# eascii (< Forced>) ; .RFFPT (Forced process termination) 32661 000746'04 040 106 157 162 143 32662 001501'01 000000000000# eascii (< Waiting>) ; .RFWAT (Waiting for inferior process) 32663 000750'04 040 127 141 151 164 32664 001502'01 000000000000# eascii (< Sleep>) ; .RFSLP 32665 000752'04 040 123 154 145 145 32666 001503'01 000000000000# eascii (< Trapped>) ; .RFTRP (JSYS Trapped) 32667 000754'04 040 124 162 141 160 32668 001504'01 000000000000# eascii (< Address>) ; .RFABK (Address break freeze) 32669 000756'04 040 101 144 144 162 32670 001505'01 000000000000# eascii (< Signal>) ; .RFSIG (Signal JFN freeze) 32671 000760'04 040 123 151 147 156 32672 000011 .rfmax==.rfsig+1 32673 K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 19:42 30-Mar-24 Page 29 K20TIM MAC 9-Dec-23 22:56 Discover NUL: baud rate 32674 subttl Discover NUL: baud rate 32675 32676 ; Written to merely check calculations code before writing other timers 32677 ; 32678 ; As above, NUL:'s virtual baud rate means very little. 32679 ; 32680 ; Unlike the above, NOTHING reads the SOUTR% because this is 32681 ; (onviously) impossible to do as the data just got dumped. The 32682 ; reason four times the data is written is to work the rate 32683 ; calculations in a different way, stressing them to look for edge 32684 ; cases 32685 ; 32686 ; Therefore, doing parity on NUL: is relatively to moderately...useless. 32687 32688 remark pars4 ; SOUTR% byte size 32689 32690 770000 000000 pbyte==maskb(0,5) ; Position of a byte in a section local pointer 32691 007700 000000 sbyte==maskb(6,11) ; Size of a byte in a section local pointer 32692 32693 001506'01 dnulbd: intern dnulbd ; Invoked by k20dsp 32694 001506'01 477 04 0 00 000005 setob t4, t5 ; Let's assume we can't do anything 32695 dmove t1,[.fhslf,,nulpag ; Source is NUL: page 32696 001507'01 120 01 0 00 003636' .fhslf,,nulpag+1 ] ; Destination is the second page 32697 001510'01 200 03 0 00 003640' movx t3, pm%cnt!pm%rd!fld(nulpgs,pm%rpt) ; Read only 32698 001511'01 104 00 0 00 000056 PMAP% ; Case III, process to process PMAP% 32699 001512'01 320 12 0 00 001514' %jserr (, nulepi) 32700 001513'01 254 00 0 00 001517' 32701 001514'01 265 01 0 00 001442* 32702 001515'01 000000000000# 32703 001516'01 254 00 0 00 001572' 32704 000762'04 125 156 141 142 154 32705 32706 remark ; NUL counts are different 32707 001517'01 333 04 0 00 000702* skiple t4, pars4 ; Pick up byte size for SOUTR% 32708 001520'01 254 00 0 00 001523' ifskp. ; Was anything specifed? 32709 dmove t2,[ ; No, use defaults 32710 point 8,nulwrt ; Where we're writing from 32711 001521'01 120 02 0 00 003641' - ] ; Number of characters in the pages 32712 001522'01 254 00 0 00 001531' else. ; Otherwise, need to do some coversions 32713 001523'01 120 02 0 00 003557' dmove t2,[exp -1,-^d36] ;Load double negative integer 36 32714 001524'01 234 02 0 00 000004 div t2, t4 ; Calculate bytes per word 32715 001525'01 225 02 0 00 004000 muli t2, nullen ; Now have total bytes we'll do in t3 32716 001526'01 205 02 0 00 440000 movx t2, ; Set up for an ILDB at bit '36' 32717 001527'01 137 04 0 00 003561' dpb t4, [ pointr t2, sbyte ] ; Drop in the byte size 32718 001530'01 541 02 0 00 000000# hrri t2, nulwrt ; Finally drop in the address 32719 001531'01 endif. ; End non-standard byte size 32720 32721 001531'01 201 01 0 00 377777 movx t1, .nulio ; Just dumping, maybe really fast 32722 001532'01 210 04 0 00 000003 movn t4, t3 ; Save count used 32723 001533'01 260 17 0 00 002033' call statim ; Start timing the transfer 32724 001534'01 104 00 0 00 000532 SOUTR% ; Bombs away!!! 32725 001535'01 320 12 0 00 001537' %jserr (, nulepi) 32726 001536'01 254 00 0 00 001542' 32727 001537'01 265 01 0 00 001514* 32728 001540'01 000000000000# K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 19:42 30-Mar-24 Page 29-1 K20TIM MAC 9-Dec-23 22:56 Discover NUL: baud rate 32729 001541'01 254 00 0 00 001572' 32730 000770'04 125 156 141 142 154 32731 001542'01 260 17 0 00 002050' call endtim ; Finish the timing 32732 32733 001543'01 260 17 0 00 002133' call elptim ; Compute elapsed transfer time 32734 001544'01 400 01 0 00 000000 setz t1, ; Zero high order of characters transferred 32735 001545'01 200 02 0 00 000004 move t2, t4 ; Load low order of characters transferred 32736 001546'01 116 01 0 00 003601' dmul t1, [exp 0, ^d100000*^d10 ] ; Scale to bits in microsecond time 32737 001547'01 120 01 0 00 000003 dmove t1, t3 ; Load low order double word 32738 001550'01 260 17 0 00 003301' call dfloat ; Convert to double floating point 32739 001551'01 334 00 0 00 000000 %ermsg (, nulepi) 32740 001552'01 254 00 0 00 001556' 32741 001553'01 265 01 0 00 001537* 32742 001554'01 000000000000# 32743 001555'01 254 00 0 00 001572' 32744 000775'04 125 156 141 142 154 32745 001556'01 120 03 0 00 000001 dmove t3, t1 ; Save double floating bit count 32746 32747 001557'01 120 01 0 00 000000# dmove t1, ewallt+.datus ; Load tens of nanoseconds used 32748 001560'01 260 17 0 00 003301' call dfloat ; Convert to double floating point 32749 001561'01 334 00 0 00 000000 %ermsg (, nulepi) 32750 001562'01 254 00 0 00 001566' 32751 001563'01 265 01 0 00 001553* 32752 001564'01 000000000000# 32753 001565'01 254 00 0 00 001572' 32754 001003'04 125 156 141 142 154 32755 001566'01 113 03 0 00 000001 dfdv t3, t1 ; Divide bits by ticks 32756 001567'01 120 04 0 00 000003 dmove t4, t3 ; Return in the expected place 32757 001570'01 260 17 0 00 001572' call nulepi ; Call the epilogue 32758 001571'01 254 00 0 00 001410* retskp ; Return success 32759 32760 001572'01 nulepi: remark NUL test epilogue 32761 001572'01 474 01 0 00 000000 seto t1, ; Removing pages 32762 dmove t2,[.fhslf,,nulpag+1 ;Whacking dirty pages from address space 32763 001573'01 120 02 0 00 003643' pm%cnt!pm%abt!fld(nulpgs,pm%rpt) ] ; Read only 32764 001574'01 104 00 0 00 000056 PMAP% ; Reduce our working set size 32765 001575'01 320 12 0 00 001577' ifje. r ; Should never happen... 32766 001576'01 254 00 0 00 001600' 32767 001577'01 200 03 0 00 000001 move t3, t1 ; Store error for debuggers 32768 001600'01 endif. 32769 32770 001600'01 263 17 0 00 000000 ret 32771 K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 19:42 30-Mar-24 Page 30 K20TIM MAC 9-Dec-23 22:56 Set up for parity checking (if we're doing parity) 32772 subttl Set up for parity checking (if we're doing parity) 32773 32774 ;[223] Begin code insertion 32775 32776 ;N.B., Assumes we're ALWAYS doing 8 bit transfers, which is what 32777 ; Kermit would be sending over the line. However, due to the last 32778 ; four bits of the data being transferred having rotating values, 32779 ; it may be possible to get into the situation here where the byte 32780 ; parity is reported as being fine, but the word comparison can fail. 32781 32782 extern parity, none ; If we're doing any kind of parity 32783 extern genint ; Constructed instruction if generating parity 32784 remark ; If doing parity, ALWAYS sending AND checking it 32785 32786 chgsec(code,data) ;;Needs some writable storage 32787 000125'05 000000 000000 timpar: 0 ; Set if was doing parity 32788 retsec ;;Back in code 32789 32790 001601'01 402 00 0 00 000000# parset: setzm timpar ; Don't assume doing parity 32791 001602'01 200 01 0 00 000000* move t1, parity ; Load parity setting 32792 001603'01 302 01 0 00 000000* caie t1, none ; Not doing any parity? 32793 001604'01 254 00 0 00 001607' ifskp. ; Nope, nothing further to do 32794 001605'01 254 00 0 00 001571* retskp ; so get out of here 32795 001606'01 254 00 0 00 001614' else. ; Otherwise, doing some real work 32796 001607'01 335 01 0 00 000000# skipge t1, timdev ; Load timing device 32797 001610'01 254 00 0 00 001605* retskp ; Unless never got one 32798 001611'01 306 01 0 00 000015 cain t1, .dvnul ; NUL:? 32799 001612'01 254 00 0 00 001610* retskp ; Yeah, no way to read from that, so forget parity 32800 001613'01 476 00 0 00 000000# setom timpar ; Flag we're doing parity 32801 001614'01 endif. 32802 32803 remark ; OK to trash these temporaries 32804 001614'01 265 16 0 00 003645' saveac ; But needs many piggy registers 32805 32806 001615'01 201 01 0 00 004000 movei t1, devchr ; Load number of characters 32807 001616'01 200 04 0 00 000001 move t4, t1 ; destination string is same length 32808 001617'01 201 02 0 00 000000# movei t2, devwrt ; Load address of what will be written 32809 001620'01 201 05 0 00 000000# movei q1, devdat ; Where we'll write the converted data 32810 001621'01 505 02 0 00 441000 hrli t2, (point 8,0) ; Turn source address into a section local point 32811 001622'01 500 05 0 00 000002 hll q1, t2 ; Ditto destination pointer, both being 8 bits 32812 001623'01 403 03 0 00 000006 setzb t3, q2 ; Force pointer to remain section local 32813 001624'01 200 07 0 00 000000* move q3, genint ; Load parity generation instruction 32814 001625'01 400 10 0 00 000000 setz q4, ; Unused fill character will be NUL 32815 001626'01 661 01 0 00 400000 txo t1, S ; Start significance immediately 32816 001627'01 123 01 0 00 000007 extend t1, q3 ; Finally do the conversion 32817 001630'01 600 00 0 00 000000 nop ; Ignore non-skip (which should never happen) 32818 001631'01 254 00 0 00 001632' callret chkleg ; Check generated parity against legacy parity 32819 K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 19:42 30-Mar-24 Page 31 K20TIM MAC 9-Dec-23 22:56 Routine to check parity we generated against legacy routines 32820 subttl Routine to check parity we generated against legacy routines 32821 32822 ; +1 If disagreement someplace 32823 ; +2 If complete agreement 32824 32825 extern putc ; Does a small amount of formating 32826 32827 001632'01 chkleg: dmove t2, [ ; Will run legacy routines 32828 point 8, devwrt ; over same string 32829 001632'01 120 02 0 00 003657' point 8, devdat ] ; and compare the results 32830 001633'01 200 07 0 00 000002 move q3, t2 ; Save original string pointer 32831 001634'01 201 06 0 00 004000 movei q2, devchr ; Load number of characters 32832 32833 001635'01 do. ; Enter loop context 32834 001635'01 361 06 0 00 001644' sojl q2, endlp. ; Account for a character pair consumed 32835 001636'01 134 01 0 00 000002 ildb t1, t2 ; Pick up byte from original string 32836 001637'01 260 17 1 00 001602* call @parity ; Compute the correct parity 32837 001640'01 134 04 0 00 000003 ildb t4, t3 ; Pick up byte from MOVST generated string 32838 001641'01 312 01 0 00 000004 came t1, t4 ; The same? 32839 001642'01 254 00 0 00 001644' exit. ; They are not, give up right now 32840 001643'01 254 00 0 00 001635' loop. ; Nose through the rest 32841 001644'01 enddo. ; End loop lexical context 32842 32843 001644'01 321 06 0 00 001612* jumpl q2, RSKP ; Did them all? That's dandy!! 32844 ; Sigh... 32845 001645'01 200 05 0 00 000001 move q1, t1 ; Save legacy parity 32846 001646'01 200 10 0 00 000004 move q4, t4 ; Save MOVST generated parity 32847 001647'01 201 01 0 00 004000 movei t1, devchr ; Load original number of characters 32848 001650'01 274 01 0 00 000006 sub t1, q2 ; Calculate bad byte position 32849 001651'01 200 06 0 00 000001 move q2, t1 ; Save result 32850 001652'01 133 01 0 00 000007 adjbp t1, q3 ; Position to the correct character 32851 001653'01 135 07 0 00 000001 ldb q3, t1 ; And load the character 32852 ; Finally start complaining 32853 001654'01 200 01 0 00 000000# emsg () 32854 001655'01 104 00 0 00 000313 32855 000150'02 000000000000# 32856 001011'04 107 145 156 145 162 32857 001656'01 201 01 0 00 000101 movei t1, .priou ; Still typing on terminal 32858 001657'01 200 02 0 00 000006 move t2, q2 ; Load byte position 32859 001660'01 201 03 0 00 000010 movei t3, ^d8 ; k20ioc table is documented in octal 32860 001661'01 104 00 0 00 000224 NOUT% ; Type it 32861 001662'01 320 12 0 00 001664' %jserr (,) 32862 001663'01 254 00 0 00 001667' 32863 001664'01 265 01 0 00 001563* 32864 001665'01 000000000000# 32865 001666'01 254 00 0 00 001667' 32866 001017'04 125 156 141 142 154 32867 32868 001667'01 200 01 0 00 000000# txmsg (<, legacy: >) 32869 001670'01 104 00 0 00 000076 32870 001671'01 320 12 0 00 001672' 32871 000151'02 000000000000# 32872 001026'04 054 040 154 145 147 32873 001672'01 200 04 0 00 000005 move t4, q1 ; Load what arithmatic calculated 32874 001673'01 201 01 0 00 000060 movei t1, "0" ; Let's assume it was zero K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 19:42 30-Mar-24 Page 31-1 K20TIM MAC 9-Dec-23 22:56 Routine to check parity we generated against legacy routines 32875 001674'01 622 04 0 00 000200 txze t4, 200 ; Check and strip the parity 32876 001675'01 201 01 0 00 000061 movei t1, "1" ; It's set! 32877 001676'01 104 00 0 00 000074 PBOUT% ; Either way, type it 32878 001677'01 201 01 0 00 000101 movei t1, .priou ; Still typing on terminal 32879 001700'01 200 02 0 00 000004 move t2, t4 ; Load the value, itself 32880 001701'01 200 03 0 00 003661' movx t3, 32881 001702'01 104 00 0 00 000224 NOUT% ; Type it 32882 001703'01 320 12 0 00 001705' %jserr (,) 32883 001704'01 254 00 0 00 001710' 32884 001705'01 265 01 0 00 001664* 32885 001706'01 000000000000# 32886 001707'01 254 00 0 00 001710' 32887 001031'04 125 156 141 142 154 32888 32889 001710'01 200 01 0 00 000000# txmsg (<, table: >) 32890 001711'01 104 00 0 00 000076 32891 001712'01 320 12 0 00 001713' 32892 000152'02 000000000000# 32893 001040'04 054 040 164 141 142 32894 001713'01 200 04 0 00 000010 move t4, q4 ; Load what MOVST looked up 32895 001714'01 201 01 0 00 000060 movei t1, "0" ; Let's assume it was zero 32896 001715'01 622 04 0 00 000200 txze t4, 200 ; Check and strip the parity 32897 001716'01 201 01 0 00 000061 movei t1, "1" ; It's set! 32898 001717'01 104 00 0 00 000074 PBOUT% ; Either way, type it 32899 001720'01 201 01 0 00 000101 movei t1, .priou ; Still typing on terminal 32900 001721'01 200 02 0 00 000004 move t2, t4 ; Load the value, itself 32901 001722'01 200 03 0 00 003661' movx t3, 32902 001723'01 104 00 0 00 000224 NOUT% ; Type it 32903 001724'01 320 12 0 00 001726' %jserr (,) 32904 001725'01 254 00 0 00 001731' 32905 001726'01 265 01 0 00 001705* 32906 001727'01 000000000000# 32907 001730'01 254 00 0 00 001731' 32908 001042'04 125 156 141 142 154 32909 32910 001731'01 200 01 0 00 000000# txmsg (<, character: >) 32911 001732'01 104 00 0 00 000076 32912 001733'01 320 12 0 00 001734' 32913 000153'02 000000000000# 32914 001050'04 054 040 143 150 141 32915 001734'01 400 04 0 00 000000 setz t4, ; Let's assume bit 8 is not up 32916 001735'01 200 01 0 00 000007 move t1, q3 ; Load the character 32917 001736'01 622 01 0 00 000200 txze t1, 200 ; Zero bit 8 and skip if wasn't set 32918 001737'01 474 04 0 00 000000 seto t4, ; Was set... 32919 001740'01 260 17 0 00 000000* call putc ; Type our poor character 32920 001741'01 322 04 0 00 001745' ifn. t4 ; Did it have bit eight up? 32921 001742'01 200 01 0 00 000000# txmsg (<(M)>) ; List that as 'Mark' 32922 001743'01 104 00 0 00 000076 32923 001744'01 320 12 0 00 001745' 32924 000154'02 000000000000# 32925 001053'04 050 115 051 000 000 32926 001745'01 endif. 32927 001745'01 561 01 0 00 001472* hrroi t1, crlf 32928 001746'01 104 00 0 00 000076 PSOUT% 32929 001747'01 263 17 0 00 000000 ret K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 19:42 30-Mar-24 Page 31-2 K20TIM MAC 9-Dec-23 22:56 Routine to check parity we generated against legacy routines 32930 32931 K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 19:42 30-Mar-24 Page 32 K20TIM MAC 9-Dec-23 22:56 Check parity (if we're doing parity) 32932 subttl Check parity (if we're doing parity) 32933 32934 ;N.B., Assumes parset has been called and will almost surly *BREAK* otherwise 32935 32936 extern chkint ; Constructed instruction if checking parity 32937 32938 001750'01 336 00 0 00 000000# parchk: skipn timpar ; Did we actually do any parity? 32939 001751'01 254 00 0 00 001644* retskp ; Nope, then say all is well 32940 001752'01 335 01 0 00 000000# skipge t1, timdev ; Load timing device 32941 001753'01 254 00 0 00 001751* retskp ; Unless never got one 32942 001754'01 306 01 0 00 000015 cain t1, .dvnul ; NUL:? 32943 001755'01 254 00 0 00 001753* retskp ; Yeah, no way to read from that, so forget parity 32944 32945 remark ; OK to trash these temporaries 32946 001756'01 265 16 0 00 003645' saveac ; But needs many piggy registers 32947 32948 001757'01 201 01 0 00 004000 movei t1, devchr ; Load number of characters 32949 001760'01 200 04 0 00 000001 move t4, t1 ; destination string is same length 32950 001761'01 201 02 0 00 000000# movei t2, devred ; Source is what the subfork read 32951 001762'01 201 05 0 00 000000# movei q1, devda2 ; destination is seperate; do not update in place 32952 001763'01 505 02 0 00 441000 hrli t2, (point 8,0) ; Turn source address into a section local point 32953 001764'01 500 05 0 00 000002 hll q1, t2 ; Ditto destination pointer, both being 8 bits 32954 001765'01 403 03 0 00 000006 setzb t3, q2 ; Force pointer to remain section local 32955 001766'01 200 07 0 00 000000* move q3, chkint ; Load parity checking instruction 32956 001767'01 400 10 0 00 000000 setz q4, ; Fill character is NUL (yet unused...) 32957 remark t1, N!M ; Shut off Negative and Mark (movei cleared them) 32958 001770'01 661 01 0 00 400000 txo t1, S ; Have to dink the foolish significance bit... 32959 001771'01 123 01 0 00 000007 extend t1, q3 ; Get down to some serious string translating 32960 001772'01 600 00 0 00 000000 nop ; Can't happen 32961 001773'01 627 01 0 00 200000 txzn t1, N ; Bump into any bad parity? 32962 001774'01 254 00 0 00 001755* retskp ; Nope, everything's fin 32963 32964 001775'01 120 07 0 00 000001 dmove q3, t1 ; Save failing character position 32965 001776'01 200 01 0 00 000000# emsg 32966 001777'01 104 00 0 00 000313 32967 000155'02 000000000000# 32968 001054'04 120 141 162 151 164 32969 002000'01 201 01 0 00 000101 movei t1, .priou ; Primary output 32970 dmove t2, [ devchr ; Load number of characters 32971 002001'01 120 02 0 00 003662' ^d10 ] ; Positions are in decimal 32972 002002'01 274 02 0 00 000007 sub t2, q3 ; Subtract remaining to get position 32973 002003'01 104 00 0 00 000224 NOUT% ; Type it 32974 002004'01 320 12 0 00 002006' %jserr(,) 32975 002005'01 254 00 0 00 002011' 32976 002006'01 265 01 0 00 001726* 32977 002007'01 000000000000# 32978 002010'01 254 00 0 00 002011' 32979 001063'04 103 157 165 154 144 32980 32981 002011'01 201 06 0 00 004000 movei q2, devchr ; Load original 32982 002012'01 274 06 0 00 000004 sub q2, t4 ; Calculate amount done 32983 002013'01 323 06 0 00 002032' ifg. q2 ; Did we do anything (or gubbish)? 32984 002014'01 200 01 0 00 000000# txmsg (<, translated: ">) 32985 002015'01 104 00 0 00 000076 32986 002016'01 320 12 0 00 002017' K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 19:42 30-Mar-24 Page 32-1 K20TIM MAC 9-Dec-23 22:56 Check parity (if we're doing parity) 32987 000156'02 000000000000# 32988 001074'04 054 040 164 162 141 32989 dmove t1, [ .priou ; Still going to primary output 32990 002017'01 120 01 0 00 003664' point 8, devda2 ] ; From beginning of translation buffer 32991 002020'01 210 03 0 00 000006 movn t3, q2 ; Counted transfer 32992 002021'01 104 00 0 00 000053 SOUT% ; and type what we did 32993 002022'01 320 12 0 00 002024' %jserr(,) 32994 002023'01 254 00 0 00 002027' 32995 002024'01 265 01 0 00 002006* 32996 002025'01 000000000000# 32997 002026'01 254 00 0 00 002027' 32998 001100'04 103 157 165 154 144 32999 txmsg (<" 33000 002027'01 200 01 0 00 000000# >) ; Shutting off font-crock mode 33001 002030'01 104 00 0 00 000076 33002 002031'01 320 12 0 00 002032' 33003 000157'02 000000000000# 33004 001110'04 042 015 012 000 000 33005 002032'01 endif. 33006 002032'01 263 17 0 00 000000 ret ; Failure return 33007 33008 ;[223] End code insertion 33009 K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 19:42 30-Mar-24 Page 33 K20TIM MAC 9-Dec-23 22:56 Transfer timing routines 33010 subttl Transfer timing routines 33011 33012 ;[207] Begin code insertion 33013 33014 ; Historically, Kermit timed transfers using the time of day clock 33015 ; which has approximately 1/3 of second resolution. That's probably 33016 ; fine for dial up or even local terminals where the DH11 would limit 33017 ; you to 9600 baud. The most we could get in 1988 was 19.2Kbd on a 33018 ; local Microvax connecting to CU20B. 33019 ; 33020 ; The pseudo-terminal code can do a megabaud and TCP/IP uploads to 33021 ; ckermit are clearing 500 kilobaud. A short file can get sent in FAR 33022 ; less then a time of day tick. So we read some timers here that have 33023 ; greater resolution. 33024 ; 33025 ; Although it is not currently (2023) necessary to exceed DK10 33026 ; internal clock resolution (10 microseconds, see HPTIM%), a 33027 ; certain amount of anticipatory code has been written to do this, 33028 ; particularly in the area of extended uptimes. 33029 ; 33030 ; For example, Kermit can handle the display of terabaud speeds (see 33031 ; ranger in k20dsp). It should be noted that, with faster hosts, a 33032 ; transfer may get done in less time then the scheduling interval, so 33033 ; such times should be carefully reviewed. 33034 ; 33035 ; Another matter is such resolution with the extended uptimes 33036 ; apparently available with certain version of Tops-20. DEC and PANDA 33037 ; Tops-20 7.x can not handle a millisecond uptime which exceeds a 33038 ; signed 35 bit number. It will crash with an UP2LNG BUGHLT (see 33039 ; APRSRV) after 1 Year, 4 Weeks, 5 Days, 16 Hours, 22 Minutes, 18 33040 ; Seconds and 367 Milliseconds. 33041 33042 ; Given the user load on systems and the hardware technology of the 33043 ; early 1980's, this was about 5 times the maximum uptime (a little 33044 ; over two months) that was ever seen on CU20B. It is easily 33045 ; exceeded on systems with commodity hardware and one or two active 33046 ; users. 33047 ; 33048 ; The XKL (and possibly other) version(s) of Tops-20 return the uptime 33049 ; in a signed double word. The full 70 bit millisecond number will be 33050 ; reported as 37,539,161 Millennia, 7 Centuries, 2 Decades, 9 Years, 8 33051 ; Weeks, 2 Days, 11 Hours, 35 Minutes, 3 Seconds and 423 Milliseconds. 33052 ; 33053 ; Since the current estimate of the age of the universe is 13.7 33054 ; billion years, a thirty seven and a half billion year uptime is 33055 ; probably fine. 33056 ; 33057 ; This code handles running on an XKL monitor (which does not have 33058 ; DECnet support). 33059 ; 33060 ; In 2023, doing a get "NUL:" NUL: when connected to a pseudo- 33061 ; terminal gets an elapsed transfer time of 1.6 milliseconds, so we 33062 ; are already getting pretty close to the microsecond realm. 33063 33064 chgsec(code,data) ;;Declare writable storage K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 19:42 30-Mar-24 Page 33-1 K20TIM MAC 9-Dec-23 22:56 Transfer timing routines 33065 33066 remark stdat,etdat,ewallt 33067 33068 xlist ; Save a few trees 33069 list ; Turn the listing back on 33070 33071 retsec 33072 33073 remark Set variables at the beginning of a transfer transfer 33074 33075 002033'01 statim: entry statim ; Allow global use 33076 002033'01 265 16 0 00 003666' saveac ; Don't side effect any accumulators 33077 33078 remark ; Set up initial states of timing blocks 33079 002034'01 415 04 0 00 000000# xmovei t4, etdat ; Resolve address of end time data block 33080 002035'01 260 17 0 00 002042' call zeroit ; Go zero it out 33081 33082 002036'01 415 04 0 00 000000# xmovei t4, ewallt ; Load address of elapsed wall time 33083 002037'01 260 17 0 00 002042' call zeroit ; Go whack that, too 33084 33085 002040'01 415 04 0 00 000000# xmovei t4, stdat ; Resolve address of timing data block 33086 002041'01 254 00 0 00 002052' callret timwrk ; Hit the time worker and return through it 33087 33088 002042'01 zeroit: remark t4,address ; Routine to stomp a time block 33089 002042'01 201 01 0 00 000020 movx t1, dtilen-1 ; Length of remaining structure to whack 33090 002043'01 200 02 0 00 000004 move t2, t4 ; First location to whack 33091 002044'01 201 03 0 02 000001 movei t3, 1(t2) ; Cascading whackage 33092 002045'01 402 00 0 02 000000 setzm (t2) ; Stomp the first word 33093 002046'01 123 01 0 00 003564' xblt. t1 ; Stomp the rest of them 33094 002047'01 263 17 0 00 000000 ret ; Done 33095 33096 remark Set variables at end of transfer 33097 33098 002050'01 endtim: entry endtim ; Allow global use 33099 002050'01 265 16 0 00 003666' saveac ; Don't side effect any accumulator 33100 002051'01 415 04 0 00 000000# xmovei t4, etdat ; Resolve address of timing data block 33101 remark timwrk ; fall through to the time worker 33102 ; (and return through it) 33103 K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 19:42 30-Mar-24 Page 34 K20TIM MAC 9-Dec-23 22:56 Time storage worker 33104 subttl Time storage worker 33105 33106 ; Call: Expects t4 to have the block address 33107 ; 33108 ; Be aware that all timing variables have gone from a single word to 33109 ; three words and resolution is stored in increasing resolution in 33110 ; order to not break any overlooked older code. 33111 ; 33112 ; The reads are done in the reverse order to keep HPTIM% as accurate 33113 ; as possible. "Accurate" may be debatable; the point of going to 33114 ; microsecond level reads was not accuracy so much as the timings had 33115 ; gone under a TOD tick (approximately 329.58858646932 milliseconds). 33116 ; 33117 ; It was subsequently discovered that some transfers are happening so 33118 ; quickly that they are approaching sub-millisecond levels (I.E., 33119 ; single digit milliseconds), bringing Kermit into the microsecond 33120 ; realm. 33121 ; 33122 ; Negative numbers will flag errors for uptime because these currently 33123 ; will not go negative. Since the time of day is actually unsigned 33124 ; (mostly), this isn't possible, so that is flagged as zero as Tops-20 33125 ; didn't exist in 1858. 33126 ; 33127 ; Note the compatible use of the strange XKL arguments to the TIME% 33128 ; JSYS, lifted from my rewrite of OS/2 UPTIME.MAC. Documentation of 33129 ; arcane TIME% changes from Ralph Gorin of XKL. The full text is 33130 ; STAR:TOPS-20-UPTIME.TXT. 33131 ; 33132 ; Date: Sat, 07 Mar 2009 14:35:18 -0800 33133 ; From: Ralph Gorin 33134 ; To: Thomas DeBellis 33135 ; CC: Tops-20 Wizards 33136 ; Subject: Re: Another Uptime Record 33137 ; In-Reply-To: <49B29F35.4010402@acedsl.com> 33138 ; Message-ID: <49B2F6A6.3040602@xkl.com> 33139 ; 33140 ; ... 33141 ; 33142 ; If AC 1 contains 'TODSEC' then return the uptime in seconds 33143 ; in AC 1, the residue in milliseconds in LH of AC 2 33144 ; and the divisor to convert to seconds (the number 1) 33145 ; in the RH of AC 2. 33146 ; 33147 ; If AC 1 contains 'MSTIME' then return the uptime in milliseconds 33148 ; as a double word in AC 1 and AC 2. 33149 ; 33150 ; For other values of AC 1, the old behavior is preserved. 33151 ; 33152 ; If the uptime has exceeded 2^35 milliseonds, the program gets the 33153 ; TIMEX3 error. This is an encouragement to fix old programs. 33154 ; 33155 ; Note, the code below is not 'perfect' because it will do the wrong 33156 ; thing on an XKL monitor that is up for 1000 milliseconds in the low 33157 ; order register, no matter is what in the high order. As this will 33158 ; 'only' happen for a single millisecond once every 56 Weeks, 5 Days, K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 19:42 30-Mar-24 Page 34-1 K20TIM MAC 9-Dec-23 22:56 Time storage worker 33159 ; 16 Hours, 22 Minutes, 18 Seconds and 367 Milliseconds, it is 33160 ; expected to be 'relatively' uncommon. 33161 ; 33162 ; It also assumes that the millisecond uptime is stored as a 36 bit 33163 ; unsigned number. This isn't true in 'vanilla' Tops-20; it's a 35 33164 ; bit signed value and should never be negative. A bit of defensive 33165 ; coding for intermediate implementations. 33166 33167 002052'01 timwrk: remark t1,t2,t3 ; Previously saved and available 33168 002052'01 265 16 0 00 003700' saveac ; Will need t1-t4 for the double math 33169 002053'01 200 05 0 00 000004 move q1, t4 ; Save the address so have block of four accumulators 33170 33171 002054'01 403 01 0 00 000002 setzb t1, t2 ; A handy pair of zeros for .HPELP 33172 ; dmove t1, [ .HPELP ; Elapsed DK10 ticks since start 33173 ; 0 ] ; A handy zero 33174 002055'01 104 00 0 00 000501 HPTIM% ; Grab it 33175 002056'01 320 12 0 00 002060' ifje. r ; Failed?? 33176 002057'01 254 00 0 00 002063' 33177 002060'01 560 02 0 00 000001 hrro t2, t1 ; Turn negative to flag error 33178 002061'01 474 01 0 00 000000 seto t1, ; Ditto low order 33179 002062'01 254 00 0 00 002064' else. ; Otherwise worked, 33180 002063'01 250 02 0 00 000001 exch t2, t1 ; so put in low order 33181 002064'01 endif. ; and just use it 33182 002064'01 124 01 0 05 000017 dmovem t1, .datus(q1) ; Store amount or error (and possible flag) 33183 33184 002065'01 120 01 0 00 000000# dmove t1, mstime ; XKL's arcane 'magic' argument (if Toad) 33185 002066'01 104 00 0 00 000014 TIME% ; Get uptime in milliseconds (maybe long) 33186 002067'01 320 12 0 00 002071' ifje. r ; Failed?? 33187 002070'01 254 00 0 00 002074' 33188 002071'01 560 02 0 00 000001 hrro t2, t1 ; Turn negative to flag error 33189 002072'01 474 01 0 00 000000 seto t1, ; Ditto low order 33190 002073'01 254 00 0 00 002102' else. ; Otherwise, some kind of success 33191 002074'01 302 02 0 00 001750 caie t2, ^d1000 ; XKL monitor? 33192 002075'01 254 00 0 00 002102' ifskp. ; No, plain old 'vanilla' 33193 002076'01 200 02 0 00 000001 move t2, t1 ; Put low order in proper place 33194 002077'01 627 02 0 00 400000 tlzn t2,(1b0) ; Test if Negative, fix low order and skip 33195 002100'01 634 01 0 00 000001 tdza t1, t1 ; Positive, zero high order and skip 33196 002101'01 201 01 0 00 000001 movei t1, ^d1 ; Negative, put sign bit in the high order 33197 002102'01 endif. ; Otherwise XKL, so can stay up a lot longer!! 33198 002102'01 endif. ; End TIME% result handling 33199 002102'01 124 01 0 05 000015 dmovem t1, .datms(q1) ; Store error (and possible flag) 33200 33201 002103'01 325 01 0 00 002120' ifl. t1 ; TIME% gronked somehow? 33202 002104'01 104 00 0 00 000227 GTAD% ; Oh well, get time of day 33203 002105'01 320 12 0 00 002107' ifje. r ; Failed?? 33204 002106'01 254 00 0 00 002111' 33205 002107'01 552 01 0 05 000000 hrrzm t1, .dattd(q1) ;Store error and flag it (not 1858!!) 33206 002110'01 254 00 0 00 002117' else. ;Otherwise worked, 33207 002111'01 202 01 0 05 000000 movem t1, .dattd(q1) ; so just use it 33208 002112'01 200 02 0 00 000001 move t2, t1 ; Put low order in proper place 33209 002113'01 627 02 0 00 400000 tlzn t2,(1b0) ; Test if Negative, fix low order and skip 33210 002114'01 634 01 0 00 000001 tdza t1, t1 ; Positive, zero high order and skip 33211 002115'01 201 01 0 00 000001 movei t1, ^d1 ; Negative, put sign bit in the high order 33212 002116'01 124 01 0 05 000001 dmovem t1, .dattl(q1) ;Store signed double word result 33213 002117'01 endif. ; End JSYS result handling K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 19:42 30-Mar-24 Page 34-2 K20TIM MAC 9-Dec-23 22:56 Time storage worker 33214 002117'01 263 17 0 00 000000 ret ; Either way, we're done 33215 002120'01 endif. 33216 33217 002120'01 260 17 0 00 002753' call miltod ; Convert millisecond uptime to TOD ticks 33218 002121'01 124 03 0 05 000013 dmovem t3, .datmr(q1) ; Store millisecond remainder 33219 002122'01 124 01 0 05 000001 dmovem t1, .dattl(q1) ; Time of Date (TOD) as signed double 33220 002123'01 322 01 0 00 002125' ifn. t1 ; Any high order? 33221 002124'01 661 02 0 00 400000 tlo t2,(1b0) ; Yes, coerce to low order 33222 002125'01 endif. 33223 002125'01 202 02 0 05 000000 movem t2, .dattd(q1) ; Time of Date (TOD) in unsigned ticks 33224 002126'01 263 17 0 00 000000 ret ; Done, finally 33225 K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 19:42 30-Mar-24 Page 35 K20TIM MAC 9-Dec-23 22:56 Compute Elapsed Wall Times 33226 subttl Compute Elapsed Wall Times 33227 33228 ; Populates a block with elapsed TOD ticks, milliseconds and HPTIM% 33229 ; ticks (10 ms resolution). 33230 ; 33231 ; Note that the HPTIM% elapsed wall time will wrap at a value of 3 33232 ; Days, 4 Hours, 21 Minutes, 17 Seconds, 906 Milliseconds and 940 33233 ; Microseconds (76:21:17.906.940). This is the basis for the comment 33234 ; of 76 hours in the monitor. Therefore, the greatest possible 33235 ; elapsed high precision time that can be measured is the above. 33236 ; 33237 ; The value for maxhpt is gotten by running the monitor code (MTIME:: 33238 ; in APRSRV.MAC with the maximum value that RDTIME could theoretically 33239 ; return, a double word of .infin (377777,,-1). No known processor 33240 ; would do this and other uptime counters would have wrapped far 33241 ; before we got anywhere near this value. 33242 ; 33243 ; Be aware that the value for maxhpt is in HPTIM% ticks or DK10 units 33244 ; when running on the 100 kHz internal clock. Should you wish to double 33245 ; check this value (say by putting it into UPTIME), then you need to 33246 ; multiply it by 10 decimal to scale it to microseconds. That value 33247 ; will be the double word value 7::377777,,777774. 33248 ; 33249 ; If that situation is detected, then we punt and simulate with an 33250 ; appropriately scaled millisecond value. However, the maximum amount 33251 ; of DK10 time that can be held in a single word is .infin, which 33252 ; works out to 95:26:37.383.670. If that situation is hit, then we 33253 ; stop faking DK10 ticks and just pretend we don't have any more of 33254 ; them. 33255 ; 33256 ; maxmil is the value of maxhpt scaled (from DK10 ticks) to milli- 33257 ; seconds, meaning the value is divided by 100 decimal. I didn't see 33258 ; how to compute these values symbolically as there are some 33259 ; intermediate results which are double words, so I just did 33260 ; everything in DDT and documented here. 33261 ; 33262 ; Note that the order of the calculations matters here because Tops-20 33263 ; rounds up TOD ticks, but we can't because, at a minimum, we are 33264 ; timing at millisecond resolution, which is two decimal orders of 33265 ; magnitude less than a TOD tick. The more common case of DK10 (or 33266 ; microsecond) resolution, is five orders of magnitude less. If we 33267 ; don't handle things ourselves, you can have the case where time 33268 ; appears to be going backwards in a high resolution log file. 33269 ; 33270 ; HPTIM% ticks are stored as signed doubles to allow for future code 33271 ; which can read finer times (see documentation for RDTIME instruction) 33272 33273 002127'01 000000 000000 maxhpt: 0 ; See MTIME in APRSRV 33274 002130'01 314631 463146 314631,,463146 ; N.B., DK10 units (10 us), not usecs! 33275 002131'01 000000 000000 maxmil: 0 ; Maximum HPTIM% in milliseconds 33276 002132'01 002030 446722 2030,,446722 ; maxmil is maxhpt divided by 100 decimal 33277 33278 002133'01 elptim: entry elptim ; Called from K20MIT, results used in K20DSP 33279 002133'01 265 16 0 00 003710' saveac ;Don't side-effect any registers!! 33280 002134'01 415 14 0 00 000000# xmovei p4, ewallt ; Load address of elapsed wall time block K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 19:42 30-Mar-24 Page 35-1 K20TIM MAC 9-Dec-23 22:56 Compute Elapsed Wall Times 33281 002135'01 415 13 0 00 000000# xmovei p3, etdat ; Load address of ending time and date block 33282 002136'01 415 12 0 00 000000# xmovei p2, stdat ; Load address of starting time and date block 33283 33284 002137'01 201 01 0 00 000020 movx t1, dtilen-1 ; Length of remaining structure to whack 33285 002140'01 200 02 0 00 000014 move t2, p4 ; First location to whack 33286 002141'01 201 03 0 02 000001 movei t3, 1(t2) ; Cascading whackage 33287 002142'01 476 00 0 02 000000 setom (t2) ; Set first word to ERROR value 33288 002143'01 123 01 0 00 003564' xblt. t1 ; Stomp the rest of them 33289 ; Do milliseconds in case we must fix up 33290 002144'01 415 16 0 00 002166' block. ; Enter block context for better control flow 33291 002145'01 261 17 0 00 000016 33292 002146'01 120 01 0 13 000015 dmove t1, .datms(p3) ; Load ending milliseconds double word 33293 002147'01 120 03 0 12 000015 dmove t3, .datms(p2) ; Load starting milliseconds double word 33294 002150'01 321 01 0 00 001444* jumpl t1, R ; Negative means some kind of failure on TIME% 33295 002151'01 321 03 0 00 002150* jumpl t3, R ; Ditto 33296 002152'01 316 03 0 00 000001 dcamg t3, t1 ; We didn't get anything backwards, did we? 33297 002153'01 254 00 0 00 002157' 33298 002154'01 317 03 0 00 000001 33299 002155'01 254 00 0 00 002160' 33300 002156'01 254 00 0 00 002161' 33301 002157'01 317 04 0 00 000002 33302 002160'01 254 00 0 00 002163' ifskp. ; Well, that's peculiar ... 33303 002161'01 250 01 0 00 000003 exch t1, t3 ; Swap high orders 33304 002162'01 250 02 0 00 000004 exch t2, t4 ; Swap low orders 33305 002163'01 endif. 33306 002163'01 115 01 0 00 000003 dsub t1, t3 ; Calculate elapsed milliseconds (should never wrap) 33307 002164'01 254 00 0 00 001774* retskp ; Success! 33308 002165'01 263 17 0 00 000000 endbk. ; End block context 33309 002166'01 254 00 0 00 002174' ifskp. ; Successful calculation block exit 33310 002167'01 124 01 0 14 000015 dmovem t1, .datms(p4) ; Store millisecond resolution 33311 002170'01 260 17 0 00 002753' call miltod ; Convert to elapsed TOD and remainder milliseconds 33312 002171'01 124 01 0 14 000011 dmovem t1, .datem(p4) ; Save elapsed TOD 33313 002172'01 124 03 0 14 000013 dmovem t3, .datmr(p4) ; Save remainder milliseconds 33314 002173'01 254 00 0 00 002175' else. ; Otherwise, some kind of odd input arguments 33315 002174'01 254 00 0 00 003014' jrst ovrflw ; Complain and punt 33316 002175'01 endif. ; Done elapsed milliseconds 33317 ; Do elapsed HPTIM% ticks 33318 002175'01 415 16 0 00 002236' block. ; Enter block context for better control flow 33319 002176'01 261 17 0 00 000016 33320 002177'01 120 01 0 14 000015 dmove t1, .datms(p4) ; Load millisecond resolution 33321 002200'01 316 01 0 00 002131' dcamg t1, maxmil ; Duration exceeds HPTIM% maximum? 33322 002201'01 254 00 0 00 002205' 33323 002202'01 317 01 0 00 002131' 33324 002203'01 254 00 0 00 002206' 33325 002204'01 254 00 0 00 002207' 33326 002205'01 317 02 0 00 002132' 33327 002206'01 254 00 0 00 002211' ifskp. ; Yes, then fake the HP ticks 33328 002207'01 260 17 0 00 002260' call ms2hp ; Convert milliseconds to equivalent DK10 units 33329 002210'01 254 00 0 00 002164* retskp ; Break out of the block 33330 002211'01 endif. ; End case handling HPTIM% overflow 33331 remark ; Otherwise, can still do DK10 resolution 33332 002211'01 120 01 0 13 000017 dmove t1, .datus(p3) ; Load ending HPTIM% ticks double word 33333 002212'01 120 03 0 12 000017 dmove t3, .datus(p2) ; Load beginning HPTIM% ticks double word 33334 002213'01 321 01 0 00 002151* jumpl t1, R ; Negative means some kind of failure on HPTIM% 33335 002214'01 321 03 0 00 002213* jumpl t3, R ; Ditto K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 19:42 30-Mar-24 Page 35-2 K20TIM MAC 9-Dec-23 22:56 Compute Elapsed Wall Times 33336 002215'01 316 03 0 00 000001 dcaml t3, t1 ; Did the HPTIM% count wrap around? 33337 002216'01 254 00 0 00 002222' 33338 002217'01 311 03 0 00 000001 33339 002220'01 254 00 0 00 002223' 33340 002221'01 254 00 0 00 002224' 33341 002222'01 311 04 0 00 000002 33342 002223'01 254 00 0 00 002227' ifskp. ; No, so safe to subtract 33343 002224'01 115 01 0 00 000003 dsub t1, t3 ; Compute elapsed ticks 33344 002225'01 254 00 0 00 002210* retskp ; Get out of here, we're done 33345 002226'01 254 00 0 00 002235' else. ; Otherwise, calculate the wrap gap 33346 002227'01 261 17 0 00 000012 push p, p2 ; Preserve pointer to starting ticks 33347 002230'01 120 11 0 00 002127' dmove p1, maxhpt ; Load MTIME's odd wrap value 33348 002231'01 115 11 0 00 000003 dsub p1, t3 ; Calculate ticks to wrap point 33349 002232'01 114 01 0 00 000011 dadd t1, p1 ; Calculate total elapsed ticks 33350 002233'01 262 17 0 00 000012 pop p, p2 ; Restore pointer to starting ticks 33351 002234'01 254 00 0 00 002225* retskp ; As per non-wrapped case, result is in t2 33352 002235'01 endif. ; End calculating HP tick difference 33353 002235'01 263 17 0 00 000000 endbk. ; End block context 33354 002236'01 254 00 0 00 002244' ifskp. ; Successful calculation block exit 33355 002237'01 124 01 0 14 000017 dmovem t1, .datus(p4) ; Store elapsed HPTIM% ticks 33356 002240'01 260 17 0 00 002302' call etodhp ; Extract the elapsed TOD and HP ticks 33357 002241'01 124 01 0 14 000005 dmovem t1, .dateh(p4) ; Store elapsed TOD ticks, DK10 base 33358 002242'01 124 03 0 14 000007 dmovem t3, .datdk(p4) ; Store remaining DK10 ticks 33359 002243'01 254 00 0 00 002245' else. ; Otherwise, some kind of odd input arguments 33360 002244'01 254 00 0 00 003014' jrst ovrflw ; Complain and punt 33361 002245'01 endif. ; Done elapsed HPTIM% ticks 33362 33363 remark ; Calculate ending TOD 33364 002245'01 120 01 0 12 000015 dmove t1, .datms(p2) ; Load starting uptime 33365 002246'01 114 01 0 14 000015 dadd t1, .datms(p4) ; Add elapsed milliseconds 33366 002247'01 114 01 0 00 000000# dadd t1, bootrm ; Also original boot millisecond remainder 33367 002250'01 260 17 0 00 002753' call miltod ; Calculate proper elapsed TOD 33368 002251'01 124 03 0 14 000003 dmovem t3, .dattr(p4) ; Store remainder milliseconds 33369 002252'01 114 01 0 00 000000# dadd t1, bootdd ; Bring into range of current date and time 33370 002253'01 124 01 0 14 000001 dmovem t1, .dattl(p4) ; Store as unrounded ending time 33371 002254'01 322 01 0 00 002256' ifn. t1 ; Total is 36 bits, signed double? 33372 002255'01 661 02 0 00 400000 tlo t2, (1b0) ; Coerce to 36 bits unsigned single 33373 002256'01 endif. ; End of date far in the future 33374 002256'01 202 02 0 14 000000 movem t2, .dattd(p4) ; Store as unrounded ending time 33375 002257'01 263 17 0 00 000000 ret ; Done, restoring dirty registers 33376 K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 19:42 30-Mar-24 Page 36 K20TIM MAC 9-Dec-23 22:56 Convert Milliseconds to equivalent DK10 internal clock units 33377 subttl Convert Milliseconds to equivalent DK10 internal clock units 33378 33379 ; Used when HPTIM% result exceeds 95:26:37.383.670 (TOD: 1042499) 33380 ; 33381 ; Call: 33382 ; 33383 ;T1,T2/ millisecond signed double word 33384 ; 33385 ; Return: 33386 ; 33387 ;T1,T2/ Equivalent HP ticks (call value times 100 decimal) 33388 ; 33389 ; N.B., Currently does not do anything useful on overflow, +1 always 33390 33391 002260'01 326 01 0 00 002263' ms2hp: ife. t1 ; Maybe bum the math 33392 002261'01 326 02 0 00 002263' ife. t2 ; Got called with a zero double word? 33393 002262'01 263 17 0 00 000000 ret ; Get out of here, we're done 33394 002263'01 endif. 33395 002263'01 endif. 33396 33397 002263'01 265 16 0 00 003603' saveac ; Maybe somebody might be using these 33398 002264'01 255 17 0 00 002265' jfcl 17,.+1 ; Clear all flags 33399 002265'01 116 01 0 00 003726' dmul t1, [exp 0, ^d100] ; Scale milliseconds up to DK10 units 33400 002266'01 415 16 0 00 002275' block. ; Enter block context for easier control flow 33401 002267'01 261 17 0 00 000016 33402 002270'01 255 17 0 00 002214* jfcl 17, R ; Punt if any kind of oddity 33403 002271'01 326 01 0 00 002270* jumpn t1, R ; Upper high order of 140 bit result? 33404 002272'01 326 02 0 00 002271* jumpn t2, R ; Lower high order of 140 bit result? 33405 002273'01 254 00 0 00 002234* retskp ; No to both, return 70 bit result 33406 002274'01 263 17 0 00 000000 endbk. ; End block contxt 33407 002275'01 254 00 0 00 002300' ifskp. ; In range uptime? 33408 002276'01 120 01 0 00 000003 dmove t1, t3 ; Yes, return that 33409 002277'01 254 00 0 00 002301' else. ; Wow... Big uptime 33410 002300'01 254 00 0 00 003014' callret ovrflw ; Go clip down to 'reasonable' maximum 33411 002301'01 endif. ; End case HPTIM% overflow handling 33412 002301'01 263 17 0 00 000000 ret ; Done HPTIM% fixup 33413 33414 ;[207] End code insertion 33415 K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 19:42 30-Mar-24 Page 37 K20TIM MAC 9-Dec-23 22:56 Extract TOD ticks from HPTIM% ticks 33416 subttl Extract TOD ticks from HPTIM% ticks 33417 33418 ;[221] Begin code insertion 33419 33420 ; Call: 33421 ; 33422 ; t1/ Elapsed HPTIM% ticks high order 33423 ; t2/ Elapsed HPTIM% ticks low order 33424 ; Return: 33425 ; 33426 ; t1/ Elapsed TOD ticks, high order 33427 ; t2/ Elapsed TOD ticks, low order 33428 ; t3/ Remaining HPTIM% ticks after TOD's are extracted, high order 33429 ; t4/ Remaining HPTIM% ticks after TOD's are extracted, low order 33430 ; 33431 ; Proportion to extract TOD X given DK10 Y is Y:DK10=X:TOD, where TOD 33432 ; is equal to 262,144 and DK10 is equal to 8,640,000,000 (that's eight 33433 ; million, six hundred and fourty thousand). Solving for X gives: 33434 ; 33435 ; X*DK10 = Y*TOD or X = (Y*TOD)/DK10 33436 ; 33437 ; To convert input X TOD ticks to the equivalent Y DK10 ticks, the 33438 ; proportion remains the same, but we solve for Y, instead, viz: 33439 ; 33440 ; X*DK10 = Y*TOD or Y = (X*DK10)/TOD 33441 ; 33442 ; Recall that these fractions are not exact and that there are 33443 ; 32958.98438 DK10 ticks per TOD tick. This can be found by the 33444 ; following code: 33445 ; 33446 ; movx t1, <86400.> ; Numerator is seconds in a day 33447 ; movx t2, <262144.> ; Denominator is TOD tics in a day 33448 ; movx t3, <100000.> ; DK10 ticks in a second 33449 ; fdv t1, t2 ; Gets .3295898438 seconds per TOD tick 33450 ; fmp t1, t3 ; Gets 32958.98438 DK10 ticks per TOD tick 33451 ; 33452 ; Again, this kind of precision is necessary for short messages when 33453 ; doing megabaud communications, a TOD tick being wholly insufficient. 33454 ; It is unknown whether it would be sufficient for the case of short 33455 ; messages when doing gigabaud communications. Time marches on... 33456 ; 33457 ; Assumes signed 72 bit number is ALWAYS positive!! 33458 33459 002302'01 326 01 0 00 002306' etodhp: ife. t1 ; Maybe bum the math 33460 002303'01 326 02 0 00 002306' ife. t2 ; Got called with a zero double word? 33461 002304'01 403 03 0 00 000004 setzb t3, t4 ; Yes, so zero the remainder 33462 002305'01 263 17 0 00 000000 ret ; Get out of here, we're done 33463 002306'01 endif. 33464 002306'01 endif. 33465 33466 002306'01 265 16 0 00 003645' saveac ; Will need some temporary storage 33467 002307'01 120 07 0 00 000001 dmove q3, t1 ; Save the original dividend 33468 33469 002310'01 255 17 0 00 002311' jfcl 17, .+1 ; Clear the flags 33470 002311'01 116 01 0 00 000000# dmul t1, tticdw ; Scale DK10 ticks up by TOD ticks K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 19:42 30-Mar-24 Page 37-1 K20TIM MAC 9-Dec-23 22:56 Extract TOD ticks from HPTIM% ticks 33471 002312'01 255 17 0 00 003014' jfcl 17, ovrflw ; Over 140 bits??? 33472 002313'01 326 01 0 00 003014' jumpn t1, ovrflw ; Over 105 bits?? 33473 002314'01 326 02 0 00 003014' jumpn t2, ovrflw ; Over 70 bits? 33474 002315'01 117 01 0 00 000000# ddiv t1, dkdayd ; Strip off remaining DK10 ticks 33475 002316'01 255 17 0 00 003014' jfcl 17, ovrflw ; Catch any odd math strangeness 33476 33477 remark ; Remember, returning remainder; NOT ROUNDING 33478 002317'01 120 03 0 00 000001 dmove t3, t1 ; Load quotient 33479 002320'01 116 03 0 00 000000# dmul t3, dkdayd ; Scale TOD ticks by DK10 ticks 33480 002321'01 255 17 0 00 003014' jfcl 17, ovrflw ; Over 140 bits??? 33481 002322'01 326 03 0 00 003014' jumpn t3, ovrflw ; Over 105 bits?? 33482 002323'01 326 04 0 00 003014' jumpn t4, ovrflw ; Over 70 bits? 33483 002324'01 117 03 0 00 000000# ddiv t3, tticdw ; Strip off remaining TOD ticks 33484 002325'01 255 17 0 00 003014' jfcl 17, ovrflw ; Catch any odd math strangeness 33485 33486 remark q1:q2 ; Should we round? For now, don't 33487 002326'01 316 03 0 00 000007 dcamg t3, q3 ; We didn't get anything backwards, did we? 33488 002327'01 254 00 0 00 002333' 33489 002330'01 317 03 0 00 000007 33490 002331'01 254 00 0 00 002334' 33491 002332'01 254 00 0 00 002335' 33492 002333'01 317 04 0 00 000010 33493 002334'01 254 00 0 00 002337' ifskp. ; That's odd; fix it 33494 002335'01 250 07 0 00 000003 exch q3, t3 ; Swap high order 33495 002336'01 250 10 0 00 000004 exch q4, t4 ; Swap low order 33496 002337'01 endif. 33497 002337'01 115 07 0 00 000003 dsub q3, t3 ; Calculate remaining DK10 ticks 33498 ; remark ; This DSUB should not set flags, but does 33499 ; jfcl 17, ovrflw ; Catch any odd math strangeness 33500 33501 ; dcamle q3,[exp 0,^d32958] ;Remainder should never exceed this 33502 ; jrst ovrflw ; But did 33503 002340'01 120 03 0 00 000007 dmove t3, q3 ; Return remaining DK10 ticks 33504 33505 002341'01 263 17 0 00 000000 ret ; Done 33506 33507 ;[221] End code insertion 33508 K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 19:42 30-Mar-24 Page 38 K20TIM MAC 9-Dec-23 22:56 Expresses a duration in DK10 units (tens of microseconds) 33509 subttl Expresses a duration in DK10 units (tens of microseconds) 33510 33511 ;[207] Begin code insertion 33512 33513 ; t1/ Output pointer or JFN 33514 ; t2/ Pointer to time structure 33515 33516 002342'01 durtim: entry durtim ; Also called by k20dsp 33517 002342'01 265 16 0 00 003446' saveac ; Used to save a pointer 33518 33519 002343'01 200 05 0 00 000002 move q1, t2 ; Save pointer to structure 33520 002344'01 201 02 0 05 000017 movei t2, .datus(q1) ; Resolve pointer to elapsed DK10 ticks 33521 002345'01 400 03 0 00 000000 setz t3, ;[221] Do not suppress leading seconds 33522 002346'01 260 17 0 00 002370' call ehptim ; Display elapsed HP ticks 33523 002347'01 600 00 0 00 000000 nop ;[221] Ignore +1, it isn't fatal 33524 33525 002350'01 120 03 0 05 000005 dmove t3, .dateh(q1) ;[221] Load elapsed TOD ticks 33526 002351'01 326 03 0 00 002354' ife. t3 ;[221] No high order 33527 002352'01 326 04 0 00 002354' ife. t4 ;[221] and no low order? 33528 002353'01 263 17 0 00 000000 ret ;[221] None; suppress the whole thing 33529 002354'01 endif. ;[221] 33530 002354'01 endif. ;[221] 33531 33532 002354'01 322 03 0 00 002356' ifn. t3 ; Any high order? 33533 002355'01 661 04 0 00 400000 tlo t4,(1b0) ; Yes, coerce to low order 33534 002356'01 endif. 33535 002356'01 322 04 0 00 002367' ifn. t4 ; Got any TOD ticks? 33536 002357'01 120 02 0 00 000000# smsg < (TOD: > 33537 002360'01 260 17 0 00 000000* 33538 000160'02 000000000000# 33539 000161'02 777777 777771 33540 001111'04 040 050 124 117 104 33541 002361'01 200 02 0 00 000004 move t2, t4 ; Load elapsed TOD ticks 33542 002362'01 200 03 0 00 003730' movx t3, ;N.B., Unsigned!! 33543 002363'01 104 00 0 00 000224 NOUT% 33544 002364'01 320 14 0 00 002272* erjmps r 33545 002365'01 120 02 0 00 000000# smsg <)> ; Close off and return 33546 002366'01 260 17 0 00 002360* 33547 000162'02 000000000000# 33548 000163'02 777777 777777 33549 001113'04 051 000 000 000 000 33550 002367'01 endif. 33551 33552 002367'01 263 17 0 00 000000 ret ; Done, restore registers, destroy frame 33553 K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 19:42 30-Mar-24 Page 39 K20TIM MAC 9-Dec-23 22:56 Display elapsed HP ticks 33554 subttl Display elapsed HP ticks 33555 33556 ; Call: 33557 ; 33558 ; t1/ Output pointer (or .PRIOU) 33559 ; t2/ Pointer to double word of duration in HPTIM% ticks 33560 ; [DK10 Internal 100 Khz resolution, tens of microseconds] 33561 ; t3/ Leading second suppression flag 33562 ; 33563 ; +1/ Something untoward happened ... 33564 ; +2/ Everything's Archie 33565 ; t1/ Updated, if string pointer 33566 33567 002370'01 ehptim: entry ehptim ; Also called by k20par 33568 remark t1 ; It is deadly to touch t1!! 33569 remark ; Assumes these may be smashed 33570 002370'01 265 16 0 00 000000* trvar <,hrs,mins,secs,mils,dk10,lsflag> ;[221] 33571 002371'01 000000 000010 33572 33573 002372'01 202 03 0 15 000010 movem t3, lsflag ;[221] Save leading second flag 33574 002373'01 120 03 0 02 000000 dmove t3, (t2) ;[221] Load the duration (don't overwrite t2, yet) 33575 002374'01 124 03 0 15 000001 dmovem t3, dur ;[221] Save for internal debugging 33576 002375'01 403 03 0 00 000004 setzb t3, t4 ; Cons up some zeros 33577 002376'01 124 03 0 15 000003 dmovem t3, hrs ; Stomp hours and minutes 33578 002377'01 124 03 0 15 000005 dmovem t3, secs ; Stomp seconds and milliseconds 33579 002400'01 402 00 0 15 000007 setzm dk10 ; Stomp tens of microseconds 33580 002401'01 120 02 0 15 000001 dmove t2,dur ;[221] Load the duration double word 33581 ; Let's get down to some arithmatic 33582 002402'01 415 16 0 00 002430' ehpti1: block. ; Enter block context for easier control flow 33583 002403'01 261 17 0 00 000016 33584 002404'01 255 17 0 00 002405' jfcl 17,.+1 ; Clear any flags, just in case 33585 002405'01 235 02 0 00 000144 divi t2, ^d100 ; Strip out DK10 ticks 33586 002406'01 255 10 0 00 002364* jov r ; Stop on overflow 33587 002407'01 250 03 0 15 000007 exch t3, dk10 ; Store DK10 ticks and rezero remainder 33588 002410'01 322 02 0 00 002406* jumpe t2, r ; If no more quotient, then done 33589 002411'01 250 02 0 00 000003 exch t2, t3 ; Zero in high order, quotient in low order 33590 002412'01 235 02 0 00 001750 divi t2, ^d1000 ; Strip out milliseconds 33591 002413'01 255 10 0 00 002410* jov r ; Stop on overflow 33592 002414'01 250 03 0 15 000006 exch t3, mils ; Store milliseconds and rezero quotient 33593 002415'01 322 02 0 00 002413* jumpe t2, r ; If no more quotient, then done 33594 002416'01 250 02 0 00 000003 exch t2, t3 ; Zero in high order, quotient in low order 33595 002417'01 235 02 0 00 000074 divi t2, ^d60 ; Strip out seconds 33596 002420'01 255 10 0 00 002415* jov r ; Stop on overflow 33597 002421'01 250 03 0 15 000005 exch t3, secs ; Store seconds and rezero quotient 33598 002422'01 322 02 0 00 002420* jumpe t2, r ; If no more quotient, then done 33599 002423'01 250 02 0 00 000003 exch t2, t3 ; Zero in high order, quotient in low order 33600 002424'01 235 02 0 00 000074 divi t2, ^d60 ; Strip out minutes 33601 002425'01 202 03 0 15 000004 movem t3, mins ; Store minutes 33602 002426'01 202 02 0 15 000003 movem t2, hrs ; Store hours 33603 002427'01 263 17 0 00 000000 endbk. ; Exit block context 33604 33605 002430'01 337 02 0 15 000003 ehpti2: skipg t2, hrs ; Have any hours? 33606 002431'01 254 00 0 00 002441' ifskp. ; Yes, print as many as there are 33607 002432'01 201 03 0 00 000012 movx t3, fld(^d10,no%rdx) 33608 002433'01 104 00 0 00 000224 NOUT% K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 19:42 30-Mar-24 Page 39-1 K20TIM MAC 9-Dec-23 22:56 Display elapsed HP ticks 33609 002434'01 320 14 0 00 002422* erjmps r 33610 002435'01 201 02 0 00 000072 movei t2, ":" ; Puctuate hours 33611 002436'01 260 17 0 00 000000* call BOUTI% ;[216] 33612 002437'01 474 04 0 00 000000 seto t4, ; Mark hours were printed 33613 002440'01 254 00 0 00 002442' else. ; Otherwise, no hours 33614 002441'01 400 04 0 00 000000 setz t4, ; Mark no hours printed 33615 002442'01 endif. 33616 33617 002442'01 322 04 0 00 002446' ehpti3: ifn. t4 ; Previous? 33618 002443'01 200 02 0 15 000004 move t2, mins ; Yes, MUST print minutes 33619 002444'01 200 03 0 00 003731' movx t3, no%lfl!no%zro!no%ast!fld(^d2,no%col)!fld(^d10,no%rdx) ; In 2 columns 33620 002445'01 254 00 0 00 002451' else. ; Otherwise, nothing previous 33621 002446'01 201 03 0 00 000012 movx t3, fld(^d10,no%rdx) ; So no leading digits 33622 002447'01 332 02 0 15 000004 skipe t2, mins ; Have any minutes? 33623 002450'01 474 04 0 00 000000 seto t4, ; Yes, force a print 33624 002451'01 endif. 33625 33626 002451'01 322 04 0 00 002464' ifn. t4 ; Have to print minutes 33627 002452'01 322 02 0 00 002456' ifn. t2 ; Do we have a number? 33628 002453'01 104 00 0 00 000224 NOUT% ; We do, so print it 33629 002454'01 320 14 0 00 002434* erjmps r ; Catch and suppress error 33630 002455'01 254 00 0 00 002462' else. ; It's zero, so let's bum the NOUT% 33631 002456'01 201 02 0 00 000060 movei t2, "0" ; Load the zero 33632 002457'01 260 17 0 00 002436* call BOUTI% ; Type it 33633 002460'01 603 03 0 00 100000 txne t3,no%lfl ; Not fixed columns? 33634 002461'01 260 17 0 00 002457* call BOUTI% ; No, so type it twice to make "00" 33635 002462'01 endif. ; End case NOUT% execution determination 33636 002462'01 201 02 0 00 000072 movei t2, ":" ; Punctuate minutes 33637 002463'01 260 17 0 00 002461* call BOUTI% ;[216] 33638 002464'01 endif. 33639 33640 002464'01 322 04 0 00 002467' ehpti4: ifn. t4 ; Columnar if did minutes 33641 002465'01 200 03 0 00 003731' movx t3, no%lfl!no%zro!no%ast!fld(^d2,no%col)!fld(^d10,no%rdx) 33642 002466'01 254 00 0 00 002470' else. ; No, so somewhat more free form 33643 002467'01 201 03 0 00 000012 movx t3, fld(^d10,no%rdx) 33644 002470'01 endif. 33645 33646 002470'01 415 16 0 00 002501' block. ;[221] Enter control block for better flow 33647 002471'01 261 17 0 00 000016 33648 002472'01 326 04 0 00 002273* jumpn t4, RSKP ;[221] If printed minutes, MUST print seconds 33649 002473'01 332 00 0 15 000005 skipe secs ;[221] No seconds? 33650 002474'01 254 00 0 00 002472* retskp ;[221] No, if non-zero, must print them 33651 002475'01 336 00 0 15 000010 skipn lsflag ;[221] Got told to suppress the seconds 33652 002476'01 254 00 0 00 002474* retskp ;[221] No, so print them 33653 002477'01 263 17 0 00 000000 ret ;[221] Otherwise, don't 33654 002500'01 263 17 0 00 000000 endbk. ;[221] End control block context 33655 002501'01 254 00 0 00 002513' ifskp. ;[221] +1 means we must print seconds 33656 002502'01 336 02 0 15 000005 skipn t2, secs ; Load and always print seconds 33657 002503'01 254 00 0 00 002507' ifskp. ; Non-zero, so print it 33658 002504'01 104 00 0 00 000224 NOUT% 33659 002505'01 320 14 0 00 002454* erjmps r 33660 002506'01 254 00 0 00 002513' else. ; Otherwise, was zero 33661 002507'01 201 02 0 00 000060 movei t2, "0" ; So bum the NOUT% 33662 002510'01 260 17 0 00 002463* call BOUTI% ;[216] 33663 002511'01 603 03 0 00 150002 txne t3, no%lfl!no%zro!no%ast!fld(^d2,no%col) K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 19:42 30-Mar-24 Page 39-2 K20TIM MAC 9-Dec-23 22:56 Display elapsed HP ticks 33664 002512'01 260 17 0 00 002510* call BOUTI% ;[216] Have to print another zero if minutes 33665 002513'01 endif. 33666 002513'01 endif. ;[221] End case forced print of seconds 33667 33668 ; N.B., Didn't know how or if to punctuate (tens of) microseconds, so 33669 ; broke them out seperately. It still looked funny, so I simply 33670 ; alide them until I find out what the right thing to do is. 33671 33672 002513'01 200 04 0 15 000006 ehpti5: move t4, mils ; Load milliseconds 33673 002514'01 434 04 0 15 000007 or t4, dk10 ; Or in any dk10 total 33674 002515'01 322 04 0 00 002540' ifn. t4 ; If either is set, then display 33675 002516'01 201 02 0 00 000056 movei t2, "." ; Punctuate milliseconds 33676 002517'01 260 17 0 00 002512* call BOUTI% ;[216] 33677 002520'01 336 02 0 15 000006 skipn t2, mils ; Mils can go up to 999 33678 002521'01 254 00 0 00 002526' ifskp. ; Have a real value, so print it 33679 002522'01 200 03 0 00 003732' movx t3, no%lfl!no%zro!no%ast!fld(^d3,no%col)!fld(^d10,no%rdx) 33680 002523'01 104 00 0 00 000224 NOUT% 33681 002524'01 320 14 0 00 002505* erjmps r 33682 ;;;; movei t2, "." ; Punctuate tens of microseconds 33683 ;;;; call BOUTI% ;[216] 33684 002525'01 254 00 0 00 002530' else. ; Otherwise, was zero 33685 ;;;; smsg <000.> ; So bum the NOUT% and the BOUT% 33686 002526'01 120 02 0 00 000000# smsg <000> ; So bum the NOUT% and the BOUT% 33687 002527'01 260 17 0 00 002366* 33688 000164'02 000000000000# 33689 000165'02 777777 777775 33690 001114'04 060 060 060 000 000 33691 002530'01 endif. 33692 002530'01 336 02 0 15 000007 skipn t2, dk10 ; DK10 can go up to 99 33693 002531'01 254 00 0 00 002536' ifskp. ; Have a real value, so print it 33694 002532'01 200 03 0 00 003731' movx t3, no%lfl!no%zro!no%ast!fld(^d2,no%col)!fld(^d10,no%rdx) 33695 002533'01 104 00 0 00 000224 NOUT% 33696 002534'01 320 14 0 00 002524* erjmps r 33697 ;;;; remark ; Don't fool ourselves into thinking we have true mHz 33698 ;;;; movei t2, "0" ; Show it as hundreds of microseconds 33699 ;;;; call BOUTI% ;[216] 33700 002535'01 254 00 0 00 002540' else. ; Otherwise, was zero 33701 ;;;; smsg <000> ; So bum the NOUT% and the BOUT% 33702 002536'01 120 02 0 00 000000# smsg <00> ; So bum the NOUT% and the BOUT% 33703 002537'01 260 17 0 00 002527* 33704 000166'02 000000000000# 33705 000167'02 777777 777776 33706 001115'04 060 060 000 000 000 33707 002540'01 endif. 33708 002540'01 endif. 33709 002540'01 263 17 0 00 000000 ret ; Don't forget to return!!! 33710 33711 endtv. ; End lexical context transient variables 33712 33713 ;[207] End code insertion 33714 K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 19:42 30-Mar-24 Page 40 K20TIM MAC 9-Dec-23 22:56 Initialize time variables 33715 subttl Initialize time variables 33716 33717 ; Tops-20 takes the time of day and rounds it to the nearest TOD tick, 33718 ; which is .3295898438, which can easily cause messages to appear to 33719 ; have happened at the same time at high kilobaud and above speeds. 33720 ; 33721 ; Therefore, we never use GTAD% for timing because we can't tell where 33722 ; Tops-20 might have rounded. We use GTAD% precisely once to get the 33723 ; current date and time in internal format. We then use TIME% to get 33724 ; the elapsed milliseconds since system boot and subtract that from 33725 ; from the previous. 33726 ; 33727 ; Note that the math to do this is NOT rounded. The reason for this 33728 ; is to make sure that time doesn't go backwards for higher precision 33729 ; logging. 33730 ; 33731 ; N.B., HPTIM% can not be used because the current interface rounds it 33732 ; every 76 hours. 33733 33734 chgsec(code,const) ; Monitor symbol names are constants 33735 000170'02 55 63 64 51 55 45 mstime: sixbit "MSTIME" ; XKL's arcane 'magic' argument 33736 000171'02 000000 000000 0 ; Used to side-effect T2 33737 retsec ; Return back to original .PSECT 33738 33739 chgsec(code,data) ; Values go in writable storage 33740 000211'05 prgsdt: block 1 ; Program start date and time (unsigned!) 33741 000212'05 prgsdd: block 2 ; Same thing as a signed double word 33742 000214'05 sysums: block 2 ; System uptime in milliseconds on startup 33743 000216'05 bootdt: block 1 ; System boot as unsigned GTAD% word 33744 000217'05 bootdd: block 2 ; Same thing as a signed double word 33745 000221'05 bootrm: block 2 ; Remainder milliseconds in calculation 33746 000223'05 mhptod::block 1 ;[239] ; Set if monitor has high precision time of day 33747 000224'05 ehptod: block 1 ;[239] ; JSYS error when first tried 33748 000225'05 ihptod: block 2 ;[239] ; High precision time of day when started 33749 retsec ; Return back to original .PSECT 33750 33751 002541'01 initim: entry initim ; Called once by START in K20MIT 33752 002541'01 265 16 0 00 003571' saveac ; Used as index and capability word 33753 33754 002542'01 104 00 0 00 000227 GTAD% ; Get current date and time 33755 002543'01 320 12 0 00 002545' ifje. r ; Failed?? 33756 002544'01 254 00 0 00 002560' 33757 002545'01 552 01 0 00 000000# hrrzm t1, prgsdt ; Store error and flag it (not 1858!!) 33758 002546'01 550 01 0 00 000000# hrrz t1, bootdt ; Save single word format (not 1858!!) 33759 002547'01 334 00 0 00 000000 %ermsg (,) 33760 002550'01 254 00 0 00 002554' 33761 002551'01 265 01 0 00 002024* 33762 002552'01 000000000000# 33763 002553'01 254 00 0 00 002554' 33764 001116'04 105 162 162 157 162 33765 002554'01 477 05 0 00 000006 setob q1, q2 ; Flag date and time not set 33766 002555'01 124 05 0 00 000000# dmovem q1, bootdd ; Store boot date and time double word 33767 002556'01 263 17 0 00 000000 ret ; Can't go any further 33768 002557'01 254 00 0 00 002567' else. ; Otherwise worked, 33769 002560'01 202 01 0 00 000000# movem t1, prgsdt ; so just use it K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 19:42 30-Mar-24 Page 40-1 K20TIM MAC 9-Dec-23 22:56 Initialize time variables 33770 002561'01 200 02 0 00 000001 move t2, t1 ; Cast to signed long 33771 002562'01 627 02 0 00 400000 tlzn t2,(1b0) ; Test if Negative, fix low order and skip 33772 002563'01 634 01 0 00 000001 tdza t1, t1 ; Positive, zero high order and skip 33773 002564'01 201 01 0 00 000001 movei t1, ^d1 ; Negative, put sign bit in the high order 33774 002565'01 124 01 0 00 000000# dmovem t1, prgsdd ; Store for later inspection 33775 002566'01 120 05 0 00 000001 dmove q1, t1 ; Cache as we are soon to use it 33776 002567'01 endif. 33777 33778 002567'01 120 01 0 00 000000# dmove t1, mstime ; XKL's arcane 'magic' argument (if Toad) 33779 002570'01 104 00 0 00 000014 TIME% ; Get uptime in milliseconds (maybe long) 33780 002571'01 320 12 0 00 002573' ifje. r ; Failed?? 33781 002572'01 254 00 0 00 002603' 33782 002573'01 560 02 0 00 000001 hrro t2, t1 ; Turn negative to flag error 33783 002574'01 474 01 0 00 000000 seto t1, ; Ditto high order 33784 002575'01 334 00 0 00 000000 %ermsg (,) 33785 002576'01 254 00 0 00 002602' 33786 002577'01 265 01 0 00 002551* 33787 002600'01 000000000000# 33788 002601'01 254 00 0 00 002602' 33789 001125'04 105 162 162 157 162 33790 002602'01 254 00 0 00 002611' else. ; Otherwise, some kind of success 33791 002603'01 302 02 0 00 001750 caie t2, ^d1000 ; XKL monitor? 33792 002604'01 254 00 0 00 002611' ifskp. ; No, plain old 'vanilla' 33793 002605'01 200 02 0 00 000001 move t2, t1 ; Put low order in proper place 33794 002606'01 627 02 0 00 400000 tlzn t2,(1b0) ; Test if Negative, fix low order and skip 33795 002607'01 634 01 0 00 000001 tdza t1, t1 ; Positive, zero high order and skip 33796 002610'01 201 01 0 00 000001 movei t1, ^d1 ; Negative, put sign bit in the high order 33797 002611'01 endif. ; And case casting vanilla Tops-20 to double word 33798 002611'01 endif. ; End TIME% result handling 33799 002611'01 124 01 0 00 000000# dmovem t1, sysums ; Either way, store double word millisecond uptime 33800 33801 002612'01 415 16 0 00 002625' block. ; Enter block for better control flow 33802 002613'01 261 17 0 00 000016 33803 002614'01 321 01 0 00 002534* jumpl t1, R ; Only do this if 33804 002615'01 321 02 0 00 002614* jumpl t2, R ; current time is reasonable 33805 002616'01 321 05 0 00 002615* jumpl q1, R ; Only do this if 33806 002617'01 321 06 0 00 002616* jumpl q2, R ; uptime is reasonable 33807 002620'01 260 17 0 00 002655' call initod ; Convert uptime to elapsed TOD uptime 33808 002621'01 115 05 0 00 000001 dsub q1, t1 ; Subtract from current time of day 33809 002622'01 321 05 0 00 002617* jumpl q1, R ; Wrapped?? 33810 002623'01 254 00 0 00 002476* retskp ; Succeed with boot TOD in a signed double word 33811 002624'01 263 17 0 00 000000 endbk. ; Block exit 33812 002625'01 254 00 0 00 002632' ifskp. ; Worked 33813 002626'01 200 01 0 00 000006 move t1, q2 ; Load low order of result 33814 002627'01 322 05 0 00 002631' ifn. q1 ; Any high order? 33815 002630'01 661 01 0 00 400000 tlo t1,(1b0) ; Yes, coerce to low order 33816 002631'01 endif. 33817 002631'01 254 00 0 00 002634' else. ; Something didn't work 33818 002632'01 474 01 0 00 000000 seto t1, ; And no valid time of day 33819 002633'01 477 05 0 00 000006 setob q1, q2 ; Ditto double word 33820 002634'01 endif. 33821 33822 002634'01 124 05 0 00 000000# dmovem q1, bootdd ; Store boot date and time double word 33823 002635'01 202 01 0 00 000000# movem t1, bootdt ; Save single word format 33824 002636'01 124 03 0 00 000000# dmovem t3, bootrm ; And remainder milliseconds K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 19:42 30-Mar-24 Page 40-2 K20TIM MAC 9-Dec-23 22:56 Initialize time variables 33825 33826 remark ;[239] Finally see if we can do microsecond TOD 33827 002637'01 201 01 0 00 000004 movei t1,.hptod ;[239] Request high precision time of day 33828 002640'01 104 00 0 00 000501 HPTIM% ;[239] Issue the JSYS to see if it's there 33829 002641'01 320 12 0 00 002643' ifje. r ;[239] Didn't work ... 33830 002642'01 254 00 0 00 002650' 33831 002643'01 202 01 0 00 000000# movem t1, ehptod ;[239] Store the error code, but don't whine about it 33832 002644'01 403 01 0 00 000002 setzb t1, t2 ;[239] Cons up a set of double zeros 33833 002645'01 202 01 0 00 000000# movem t1, mhptod ;[239] Flag that it's not there 33834 002646'01 124 01 0 00 000000# dmovem t1, ihptod ;[239] No high precision time of day 33835 002647'01 254 00 0 00 002654' else. ;[239] Otherwise, monitor has the code and worked! 33836 002650'01 124 01 0 00 000000# dmovem t1, ihptod ;[239] Store initial high precision time of day 33837 002651'01 201 01 0 00 601405 movx t1, LSTRX1 ;[239] "Process has not encountered any errors" 33838 002652'01 202 01 0 00 000000# movem t1,ehptod ;[239] Phoney it up that this worked 33839 002653'01 476 00 0 00 000000# setom mhptod ;[239] Flag that functionality is there 33840 002654'01 endif. ;[239] End case testing for JSYS support 33841 33842 002654'01 263 17 0 00 000000 ret ; Finally done 33843 K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 19:42 30-Mar-24 Page 41 K20TIM MAC 9-Dec-23 22:56 Initialize Time of Day offset from current uptime 33844 subttl Initialize Time of Day offset from current uptime 33845 33846 ; Like miltod, but doesn't peel off a subsecond first, but rather 33847 ; Returns a remainder if not rounding 33848 ; 33849 ; Calling arguments are the same as are the return values 33850 33851 002655'01 initod: remark ; Almost impossible for this to happen, but... 33852 002655'01 321 01 0 00 003014' jumpl t1, ovrflw ; Sanity check calling arguments 33853 002656'01 321 02 0 00 003014' jumpl t2, ovrflw 33854 002657'01 326 01 0 00 002663' ife. t1 ; Maybe bum the math 33855 002660'01 326 02 0 00 002663' ife. t2 ; Got called with a zero double word? 33856 002661'01 403 03 0 00 000004 setzb t3, t4 ; Yes, so there can't be any remainder 33857 002662'01 263 17 0 00 000000 ret ; Yes, we're done 33858 002663'01 endif. 33859 002663'01 endif. 33860 33861 002663'01 265 16 0 00 003645' saveac ; Intermediate double word results 33862 002664'01 120 07 0 00 000001 dmove q3, t1 ; Save calling milliseconds to extract remainder 33863 002665'01 255 17 0 00 002666' jfcl 17,.+1 ; Clear flags 33864 33865 remark ; Calculate T = (M*262144)/86400000 33866 002666'01 116 01 0 00 000000# dmul t1, tticdw ; Scale milliseconds up by time of day ticks 33867 002667'01 255 17 0 00 003014' jfcl 17, ovrflw ; Over 140 bits??? 33868 002670'01 326 01 0 00 003014' jumpn t1, ovrflw ; Over 105 bits?? 33869 002671'01 326 02 0 00 003014' jumpn t2, ovrflw ; Over 70 bits? 33870 002672'01 117 01 0 00 000000# ddiv t1, msidad ; Then strip off partial TOD 33871 002673'01 255 17 0 00 003014' jfcl 17, ovrflw ; Punt if any kind of funny business 33872 remark ; Don't round because extracting milliseconds 33873 33874 remark ; Now convert TOD quotient back to ms 33875 002674'01 120 03 0 00 000001 dmove t3, t1 ; Load TOD quotient as input 33876 remark 17,ovlflw ; Flags are still clear 33877 33878 remark ; Calculate M = (86400000*T)/262144. 33879 002675'01 116 03 0 00 000000# dmul t3, msidad ; Scale TOD ticks by milliseconds 33880 002676'01 255 17 0 00 003014' jfcl 17, ovrflw ; Over 140 bits??? 33881 002677'01 326 03 0 00 003014' jumpn t3, ovrflw ; Over 105 bits?? 33882 002700'01 326 04 0 00 003014' jumpn t4, ovrflw ; Over 70 bits? 33883 002701'01 117 03 0 00 000000# ddiv t3, tticdw ; Strip off partial milliseconds 33884 002702'01 255 17 0 00 003014' jfcl 17, ovrflw ; Punt if any kind of funny business 33885 33886 002703'01 115 07 0 00 000003 dsub q3, t3 ; Calculate remaining milliseconds 33887 002704'01 321 07 0 00 003014' jumpl q3, ovrflw ; Sanity check arithmatic 33888 002705'01 120 03 0 00 000007 dmove t3, q3 ; Return millisecond remainder 33889 002706'01 263 17 0 00 000000 ret ; Finally done 33890 K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 19:42 30-Mar-24 Page 42 K20TIM MAC 9-Dec-23 22:56 Fine Grained Time of Day 33891 subttl Fine Grained Time of Day 33892 33893 ; At megabaud (and even high kilobaud) speeds, messages can easily 33894 ; transfer in under the TOD resolution (a single TOD tick being 33895 ; 329.5898438 ms), so a simple subtraction of before and after GTAD%'s 33896 ; really won't work as it will seem as if no time elapsed. 33897 ; 33898 ; Kermit-20 therefore does not use GTAD% difference, but rather uptime 33899 ; (I.E., TIME% a.k.a milliseconds). Can't make DK10 ticks work for 33900 ; elapsed TOD on an unmodified Tops-20 (see above). 33901 ; 33902 ; Expects to smash t1 - t3, others preserved 33903 ; 33904 ; +1/ Unrecoverable error 33905 ; +2/ Worked 33906 33907 002707'01 fintim: entry fintim ; Used in K20PDC, but coded here 33908 002707'01 265 16 0 00 003645' saveac ;[239] Set up a pointer register 33909 33910 002710'01 336 00 0 00 000000# ifmn. mhptod ;[239] Have we got high precision time of day? 33911 002711'01 254 00 0 00 002722' 33912 002712'01 201 01 0 00 000004 movx t1, .hptod ;[239] Yes, let's do DK10 units 33913 002713'01 104 00 0 00 000501 HPTIM% ;[239] Get the data 33914 002714'01 320 16 0 00 002722' annje. ;[239] If failed, then silently don't use it 33915 002715'01 303 01 0 00 303237 caile t1, ^d99999 ;[239] We didn't get gubbish, did we? 33916 002716'01 320 16 0 00 002722' annje. ;[239] A subsecond is never more than 99,999 DK10 ticks! 33917 002717'01 120 06 0 00 000001 dmove q2, t1 ;[239] Store TOD and DK10 subseconds 33918 002720'01 200 10 0 00 003733' movx q4, no%lfl!no%zro!no%ast!fld(^d5,no%col)!fld(^d10,no%rdx) ;[239] 33919 002721'01 254 00 0 00 002740' else. ;[239] Otherwise, don't have it, failed or gubbish 33920 002722'01 260 17 0 00 002050' call endtim ; Get current time of day into ending variables 33921 002723'01 260 17 0 00 002133' call elptim ; Calculated elapsed time in various formats 33922 002724'01 201 05 0 00 000000# movei q1, ewallt ; Pointer to elapsed time structure 33923 002725'01 200 06 0 05 000000 move q2, .dattd(q1) ;[239] Load ending signed time of day (unrounded) 33924 002726'01 120 02 0 05 000003 dmove t2, .dattr(q1) ;[239] Load remainder milliseconds, if any 33925 002727'01 326 02 0 00 002735' ife. t2 ;[239] Zero high order ... 33926 002730'01 326 03 0 00 002733' ife. t3 ;[239] ... and zero low order? 33927 002731'01 400 07 0 00 000000 setz q3, ;[239] None there, so note that 33928 002732'01 254 00 0 00 002734' else. ;[239] Otherwise, nothing to cast 33929 002733'01 200 07 0 00 000003 move q3, t3 ;[239] Can just use signed low order 33930 002734'01 endif. ;[239] End case zero double word 33931 002734'01 254 00 0 00 002737' else. ;[239] Non-zero high order 33932 002735'01 661 03 0 00 400000 tlo t3, (1b0) ;[239] Cast low order to unsigned 33933 002736'01 200 07 0 00 000003 move q3, t3 ;[239] Store unsigned word 33934 002737'01 endif. ;[239] End case remainder checking 33935 002737'01 200 10 0 00 003732' movx q4, no%lfl!no%zro!no%ast!fld(^d3,no%col)!fld(^d10,no%rdx) ;[239] 33936 002740'01 endif. ;[239] End case ms or dk10 units? 33937 33938 002740'01 550 01 0 00 000013 hrrz t1, p3 ; Load the logging file JFN 33939 002741'01 200 02 0 00 000006 move t2, q2 ;[239] Load some kind of time of day 33940 002742'01 400 03 0 00 000000 setz t3, 33941 002743'01 104 00 0 00 000220 ODTIM% ; Put into the log file 33942 002744'01 320 12 0 00 002622* erjmpr r ; Unless couldn't... 33943 33944 002745'01 201 02 0 00 000056 movei t2, "." ; Otherwise, punctuate milliseconds 33945 002746'01 260 17 0 00 002517* call BOUTI% ;[216] K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 19:42 30-Mar-24 Page 42-1 K20TIM MAC 9-Dec-23 22:56 Fine Grained Time of Day 33946 33947 002747'01 120 02 0 00 000007 dmove t2, q3 ;[239] Load the remainder milliseconds or DK10 units 33948 002750'01 104 00 0 00 000224 NOUT% ; Gives ".012" or ".012345" 33949 002751'01 320 14 0 00 002744* erjmps r 33950 33951 002752'01 254 00 0 00 002623* retskp ; Done 33952 K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 19:42 30-Mar-24 Page 43 K20TIM MAC 9-Dec-23 22:56 Convert Milliseconds to Time of Day Ticks 33953 subttl Convert Milliseconds to Time of Day Ticks 33954 33955 ; We have two fixed point fractions, one in TOD ticks in a day and the 33956 ; other in milliseconds in a day. The denominator for the former is 33957 ; 262,144 (2^18) whilst the denominator for the later is 86,400,000 33958 ; (24*60*60*1000). 33959 ; 33960 ; If M is the number of milliseconds (input), and T is the number of 33961 ; TOD ticks (output), then the proportion is M:86400000 = T:262144. 33962 ; Solving for T yields M*262144 = T*86400000 (intermediate) or T = 33963 ; (M*262144)/86400000. 33964 ; 33965 ; To extract the remainder, we simply solve the same equation for a 33966 ; different variable, that is, the input is now TOD or T, thus we 33967 ; have T:262144 = M:86400000, or 262144*M = 86400000*T intermediate, 33968 ; or M = (86400000*T)/262144. We then subtract this new M from the 33969 ; input arguments to yield the integer remainder. 33970 ; 33971 ; Call: 33972 ; 33973 ;t1:t2/ Milliseconds as a signed double word 33974 ; 33975 ; Return: 33976 ; 33977 ;t1:t2/ Cooresponding quantity in Time of Day ticks 33978 ; as a signed double word. 33979 ;t3:t4/ Remainder milliseconds as a signed double. 33980 ; The double is used to speed downstream calculations 33981 ; by avoiding conversions. 33982 ; 33983 ; Caution! 33984 ; 33985 ; Be aware that a Time of Day tick equals 329.5898438 milliseconds. 33986 ; So, this conversion is going to cause a REDUCTION in precision 33987 ; between two and three decimal orders of magnitude (!!) 33988 ; 33989 ; Therefore, all intermediate results should be kept in milliseconds 33990 ; and not TOD ticks. 33991 ; 33992 ; We also do not round because the display is printing the milli- 33993 ; seconds and we don't want time to appear to be going backwards. 33994 ; The remainder milliseconds are returned for possible later use. 33995 33996 chgsec(code,const) ;;Constants do not go in the code .PSECT 33997 000172'02 000000 000000 msidad: ^d0 ; Milliseconds in a day, high order 33998 000173'02 000511 456000 msiday ; Milliseconds in a day, low order 33999 000174'02 000000 000000 ms1000: ^d0 ; High order milliseconds in a second 34000 000175'02 000000 001750 ^d1000 ; Low order millisecond in a second 34001 000176'02 000000 000000 lione: ^d0 ; Long integer one, high order 34002 000177'02 000000 000001 ^d1 ; Long integer one, low order 34003 000200'02 000000 000000 dkdayd: ^d0 ; DK10 ticks in a day, high order 34004 000201'02 100276 770000 dkday ; DK10 ticks in a day, low order 34005 000202'02 000000 000000 tticdw: ^d0 ; TOD ticks in a day as a double word, high order 34006 000203'02 000001 000000 todtic ; TOD ticks in a day as a single word, low order 34007 000204'02 000000 000000 tticd2: ^d0 ; Half previous, high order K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 19:42 30-Mar-24 Page 43-1 K20TIM MAC 9-Dec-23 22:56 Convert Milliseconds to Time of Day Ticks 34008 000205'02 000000 400000 ; Half previous, low order 34009 000206'02 377777 777777 clipmx: exp .infin,.infin ; Maximum if we go over 70 bits 34010 retsec ;;Restore .PSECT assumptions 34011 34012 002753'01 321 01 0 00 003014' miltod: jumpl t1, ovrflw ; Sanity check calling arguments 34013 002754'01 321 02 0 00 003014' jumpl t2, ovrflw 34014 002755'01 326 01 0 00 002761' ife. t1 ; Maybe bum the math 34015 002756'01 326 02 0 00 002761' ife. t2 ; Got called with a zero double word? 34016 002757'01 403 03 0 00 000004 setzb t3, t4 ; Yes, so there can't be any remainder 34017 002760'01 263 17 0 00 000000 ret ; Yes, we're done 34018 002761'01 endif. 34019 002761'01 endif. 34020 34021 002761'01 265 16 0 00 003571' saveac ; Intermediate double word results 34022 002762'01 120 05 0 00 000001 dmove q1, t1 ; Save calling milliseconds 34023 002763'01 255 17 0 00 002764' jfcl 17,.+1 ; Clear flags 34024 34025 remark ; First strip off the milliseconds 34026 002764'01 120 03 0 00 000001 dmove t3, t1 ; Cast to a 140 bit intermediate quantity 34027 002765'01 403 01 0 00 000002 setzb t1, t2 ; Nothing in high 70 bits 34028 002766'01 117 01 0 00 000000# ddiv t1, ms1000 ; Strip off anything less than a second 34029 002767'01 255 17 0 00 003014' jfcl 17, ovrflw ; Shouldn't be strange ... 34030 002770'01 120 01 0 00 000005 dmove t1, q1 ; Restore original dividend 34031 002771'01 115 01 0 00 000003 dsub t1, t3 ; Subtract remainder to get to greatest second 34032 002772'01 255 17 0 00 002773' jfcl 17,.+1 ; Clear dsub's strange flags 34033 002773'01 321 01 0 00 003014' jumpl t1, ovrflw ; But double check for any funny business 34034 002774'01 120 05 0 00 000003 dmove q1, t3 ; Save remainder for return 34035 34036 remark ; Calculate T = (M*262144)/86400000 34037 002775'01 116 01 0 00 000000# dmul t1, tticdw ; Scale milliseconds up by time of day ticks 34038 002776'01 255 17 0 00 003014' jfcl 17, ovrflw ; Over 140 bits??? 34039 002777'01 326 01 0 00 003014' jumpn t1, ovrflw ; Over 105 bits?? 34040 003000'01 326 02 0 00 003014' jumpn t2, ovrflw ; Over 70 bits? 34041 003001'01 117 01 0 00 000000# ddiv t1, msidad ; Then strip off partial TOD 34042 003002'01 255 17 0 00 003014' jfcl 17, ovrflw ; Punt if any kind of funny business 34043 003003'01 316 03 0 00 000000# dcaml t3, tticd2 ; Should we round? 34044 003004'01 254 00 0 00 003010' 34045 003005'01 311 03 0 00 000000# 34046 003006'01 254 00 0 00 003011' 34047 003007'01 254 00 0 00 003012' 34048 003010'01 311 04 0 00 000000# 34049 003011'01 114 01 0 00 000000# dadd t1, lione ; Give us an extra tick 34050 34051 remark t1, t2 ; Has TOD ticks 34052 003012'01 120 03 0 00 000005 dmove t3, q1 ; Return millisecond remainder 34053 003013'01 263 17 0 00 000000 ret ; Finally done 34054 34055 003014'01 200 01 0 00 000000# ovrflw: emsg 34056 003015'01 104 00 0 00 000313 34057 000210'02 000000000000# 34058 001133'04 101 162 151 164 150 34059 003016'01 120 01 0 00 000000# dmove t1, clipmx ; Clip down to 'reasonable' maximum 34060 003017'01 263 17 0 00 000000 ret ; Get out of here 34061 K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 19:42 30-Mar-24 Page 44 K20TIM MAC 9-Dec-23 22:56 Convert Time of Day Ticks to Seconds 34062 subttl Convert Time of Day Ticks to Seconds 34063 34064 ; Do the math right. We have two fixed point fractions, one in TOD 34065 ; ticks in a day and the other in seconds in a day. The denominator 34066 ; for the former is 262,144 (2^18) whilst the denominator for the 34067 ; later is 86,400 (24*60*60). 34068 ; 34069 ; If T is the number of ticks (input) and S is the number seconds 34070 ; (output), then the proportion is T:262144 = S:86400. Solving for 34071 ; S yields S*262144=T*86400 intermediate or S=(T*86400)/262144. 34072 ; 34073 ; It will be noted that a second is a little more than three TOD ticks 34074 ; (3.034074074). So dividing by 3 will get an increasingly wrong 34075 ; answer, the longer a transfer goes. 34076 ; 34077 ; For example, consider 2,560 time of day ticks. Dividing by three 34078 ; yields a quotient of 853 seconds whereas the actual value is closer 34079 ; to 844 seconds, a difference of nine seconds. For a transfer taking 34080 ; over a day and a half, the difference is over 10,000 seconds 34081 ; 34082 ; Note intermediate double word result which is designed to handle 34083 ; dial up transfers that go on over a weekend (some did) 34084 ; 34085 ; Ticks are in t2, t1 is *** SACRED *** 34086 ; 34087 ; The below is about as fast as we can make this because the only 34088 ; math that is being done is the muli. The lsh with halfword moves 34089 ; and the or are faster than the ashc and whatever else we'd have 34090 ; to do. Div works too, but is blindingly slow. 34091 34092 003020'01 todsec: entry todsec ; Keep LINK informed of our location 34093 003020'01 265 16 0 00 003603' saveac ; Intermediate double word results 34094 003021'01 225 02 0 00 250600 muli t2,^d86400 ; Convert to base 86400 34095 003022'01 514 04 0 00 000002 hrlz t4,t2 ; Pick up high order 34096 003023'01 242 04 0 00 777777 lsh t4,-1 ; Strip off the extra sign bit 34097 003024'01 554 02 0 00 000003 hlrz t2,t3 ; Pick up low order of quotient 34098 003025'01 434 02 0 00 000004 or t2,t4 ; Build final quotient 34099 003026'01 621 03 0 00 777777 tlz t3,-1 ; Clear out from the remainder 34100 003027'01 303 03 0 00 124300 caile t3,^d<86400/2> ; Greater than a half second? 34101 003030'01 340 02 0 00 000000 aoj t2, ; Round up a second, then 34102 003031'01 263 17 0 00 000000 ret ; All done! 34103 K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 19:42 30-Mar-24 Page 45 K20TIM MAC 9-Dec-23 22:56 Previous todsec attempts, both good and bad 34104 subttl Previous todsec attempts, both good and bad 34105 34106 repeat 0,< ; First part works 34107 muli t2,^d86400 ; Convert to base 86400, double word result t2,t3 34108 ashc t2,-^d18 ; Strip out TOD ticks 34109 caile t3,^d<86400/2> ; Greater than a half second? 34110 aoj t2, ; Yes, round up a tick, then 34111 ret 34112 > 34113 repeat 0,< ; This works, but is slow 34114 muli t2,^d86400 ; Convert to base 86400 34115 div t2,[^d262144] ; Strip of TOD ticks 34116 caile t3,^d<86400/2> ; Greater than a half second? 34117 aoj t2, ; Round up a second, then 34118 ret ; All done! 34119 > 34120 34121 repeat 0,< ; This won't work for double length results 34122 hrl t2,t2 ; 'Divide' by 2^18 34123 hlr t2,t3 ; Pick up low order of quotient 34124 tlz t3,-1 ; Clear out from the remainder 34125 > 34126 34127 repeat 0,< ; Won't handle over a day 34128 imuli t2,^d86400 ; Convert to base 86400 34129 hrrz t3,t2 ; Pick up the remainder 34130 hlrz t2,t2 ; Properly position quotient 34131 caile t3,^d<86400/2> ; Greater than a half second? 34132 aoj t2, ; Round up a second, then 34133 ret ; All done! 34134 > K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 19:42 30-Mar-24 Page 46 K20TIM MAC 9-Dec-23 22:56 subtract two (unsigned) times of day 34135 subttl subtract two (unsigned) times of day 34136 34137 ; Time of Day in TOD ticks is an ***UNSIGNED*** 36 bit number 34138 ; 34139 ; Therefore, a simple signed 35 bit subtract will eventually not 34140 ; work. Avoid the problem by using signed 70 bit math 34141 ; 34142 ; Returns result in t2, t1 is sacred 34143 34144 003032'01 elapst: entry elapst ; Keep LINK informed of our location 34145 34146 003032'01 265 16 0 00 003734' saveac 34147 003033'01 474 02 0 00 000000 seto t2, ; Assume unlikely case of something wrong 34148 003034'01 200 03 0 00 000000# move t3, etdat ; Load ending TOD 34149 003035'01 603 03 0 00 777777 tlne t3, -1 ; Any kind 34150 003036'01 316 03 0 00 003455' camn t3, [-1] ; of phonkey? 34151 003037'01 263 17 0 00 000000 ret ; Bad, return talisman 34152 003040'01 200 12 0 00 000000# move p2, stdat ; Load starting TOD 34153 003041'01 603 12 0 00 777777 tlne p2, -1 ; Any kind 34154 003042'01 316 12 0 00 003455' camn p2, [-1] ; of phonkey? 34155 003043'01 263 17 0 00 000000 ret ; Bad, return talisman 34156 34157 remark ; TOD is a 36 bit unsigned number!! 34158 003044'01 403 02 0 00 000011 setzb t2, p1 ; Zero high orders 34159 003045'01 623 03 0 00 400000 tlze t3, (1b0) ; Cast unsigned to signed long 34160 003046'01 201 02 0 00 000001 movei t2, ^d1 ; Propagate to high order 34161 003047'01 623 12 0 00 400000 tlze p2, (1b0) ; Cast unsigned to signed long 34162 003050'01 201 11 0 00 000001 movei p1, ^d1 ; Propagate to high order 34163 ; Make sure beginning is before last 34164 003051'01 316 02 0 00 000011 camn t2, p1 ; Compare high order 34165 003052'01 254 00 0 00 003060' ifskp. ; Not equal so just compare high order 34166 003053'01 311 02 0 00 000011 caml t2, p1 ; Is beginning before end? 34167 003054'01 254 00 0 00 003057' ifskp. ; Yep, swap them 34168 003055'01 250 02 0 00 000011 exch t2, p1 ; Swap high order 34169 003056'01 250 03 0 00 000012 exch t3, p2 ; Swap low order 34170 003057'01 endif. 34171 003057'01 254 00 0 00 003064' else. ; Equal, so compare low order 34172 003060'01 311 03 0 00 000012 caml t3, p2 ; Is beginning before end? 34173 003061'01 254 00 0 00 003064' ifskp. ; Yep, swap them 34174 003062'01 250 02 0 00 000011 exch t2, p1 ; Swap high order 34175 003063'01 250 03 0 00 000012 exch t3, p2 ; Swap low order 34176 003064'01 endif. 34177 003064'01 endif. 34178 ; Finally ok to subtract 34179 003064'01 115 02 0 00 000011 dsub t2, p1 ; Do a signed subtract 34180 003065'01 332 00 0 00 000002 skipe t2 ; Signed result of 36 bits? 34181 003066'01 661 03 0 00 400000 tlo t3,(1b0) ; Cast to unsigned 36 bits 34182 34183 003067'01 200 02 0 00 000003 move t2, t3 ; Load low order into return AC 34184 003070'01 263 17 0 00 000000 ret 34185 K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 19:42 30-Mar-24 Page 47 K20TIM MAC 9-Dec-23 22:56 Calculates character rate with double floating point arithmatic 34186 subttl Calculates character rate with double floating point arithmatic 34187 34188 ; Call: 34189 ; 34190 ; t2/ Pointer to elapsed HPTIM% (DK10) ticks for transfer (double word) 34191 ; t3/ Total characters sent or received 34192 ; 34193 ; Characters are handled as if they were unsigned int's, but currently, 34194 ; they never will be. This is done for future expansion. 34195 ; 34196 ; Returns: 34197 ; 34198 ; +1 - Failed 34199 ; +2 - Success!! 34200 ; t4/ Double floating raw baud rate, high order mantissa 34201 ; t5/ Ditto, low order mantissa 34202 ; 34203 ; Maintains precision by keeping numerator and denominator in fixed 34204 ; point as long as possible with the assumption that a dmul is faster 34205 ; than a dfmp and a ddiv is WAY faster than a dfdv. 34206 ; 34207 ; Since t5 is a lexical alias for q1, assumes q1 has been saved 34208 ; by caller. DON'T BREAK THIS ASSUMPTION! 34209 ; 34210 ; The odd calling conventions are because this used to be passed an 34211 ; unsigned int which did not have enough precision for certain extreme 34212 ; cases. However, because of agressive register scheduling, only a 34213 ; single register was available, so this was changed to a pointer, 34214 ; to a long int, instead. 34215 34216 chgsec(code,const) ;;Constants do not go in the code .PSECT 34217 000211'02 dblscl: intern dblscl ; Also used in k20dsp 34218 000211'02 000000 000000 0 ; Scaling factor between DK10 ticks and seconds 34219 000212'02 000000 303240 ^d100000 ; Low order of same (100000 ticks per second) 34220 retsec ;;Return to regular .PSECT assumptions 34221 34222 chgsec(code,data) ;;Intermediate results, largely used for debugging 34223 000227'05 tickpt: block 1 ; Pointer to HP tick double word (not always .datus!) 34224 000230'05 dbltic: block 2 ; Double INTEGER value that tickpt points to 34225 000232'05 dfltic: block 2 ; Double floating version of same 34226 000234'05 dblchr: block 2 ; Double INTEGER value of unsigned characters (exact) 34227 000236'05 dflchr: block 2 ; Double floating version of same 34228 retsec ;;Return to regular .PSECT assumptions 34229 34230 003071'01 dblcal: entry dblcal ; Used by k20dsp 34231 remark q1, t5 ; Recall this alias 34232 003071'01 265 16 0 00 003746' saveac ; Don't touch output pointer 34233 34234 003072'01 202 02 0 00 000000# movem t2, tickptr ; Save pointer to calling double word DK10 count 34235 34236 remark t3,chars ; Treated as unsigned 36; I.E., never negative 34237 003073'01 400 01 0 00 000000 setz t1, ; Form high order in t1 34238 003074'01 623 03 0 00 400000 tlze t3, (1b0) ; Cast unsigned to signed long 34239 003075'01 201 01 0 00 000001 movei t1, ^d1 ; Propagate to high order 34240 003076'01 200 02 0 00 000003 move t2, t3 ; Position to have double word in t1::t2 K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 19:42 30-Mar-24 Page 47-1 K20TIM MAC 9-Dec-23 22:56 Calculates character rate with double floating point arithmatic 34241 003077'01 124 01 0 00 000000# dmovem t1, dblchr ; Store interim long (double) signed integer 34242 34243 003100'01 200 03 0 00 000000# move t3, tickptr ; Load pointer to DK10 double word 34244 003101'01 120 01 0 03 000000 dmove t1, (t3) ; and then load said double word 34245 003102'01 124 01 0 00 000000# dmovem t1, dbltic ; Store long integer ticks 34246 003103'01 260 17 0 00 003301' call dfloat ; Convert to KL10 double floating point 34247 003104'01 263 17 0 00 000000 ret ; But failed for some reason 34248 003105'01 124 01 0 00 000000# dmovem t1, dfltic ; Store double floating ticks 34249 34250 003106'01 120 01 0 00 000000# dmove t1, dblchr ; Load interim long integer characters 34251 003107'01 403 03 0 00 000004 setzb t3, t4 ; Clear low order 34252 003110'01 116 01 0 00 000000# dmul t1, dblscl ; Scale to DK10 resolution 34253 003111'01 124 03 0 00 000000# dmovem t3, dblchr ; Store final long integer characters 34254 003112'01 120 01 0 00 000003 dmove t1, t3 ; Load scaled double integer for double float 34255 003113'01 260 17 0 00 003301' call dfloat ; Convert to double floating form 34256 003114'01 263 17 0 00 000000 ret ; Failed 34257 003115'01 124 01 0 00 000000# dmovem t1, dflchr ; Store interim double floating characters 34258 34259 003116'01 120 04 0 00 000001 dmove t4, t1 ; Position characters for return 34260 003117'01 113 04 0 00 000000# dfdv t4, dfltic ; Calculate character rate 34261 003120'01 254 00 0 00 002752* retskp ; Finally return successful result 34262 34263 K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 19:42 30-Mar-24 Page 48 K20TIM MAC 9-Dec-23 22:56 Single word to double integer and double float 34264 subttl Single word to double integer and double float 34265 34266 ; Call: 34267 ; 34268 ; t2/ Unsigned 36 bit integer to be converted to long and double float 34269 ; 34270 ; Result: 34271 ; 34272 ; +1/ Failed 34273 ; +2/ 34274 ; t2/ double floating high order 34275 ; t3/ double floating low order 34276 ; t4/ long integer high order 34277 ; t5/ long integer low order 34278 34279 003121'01 singdf: entry singdf ; Called by display 34280 003121'01 265 16 0 00 003746' saveac ; Save because dfloat will trash it 34281 34282 003122'01 400 01 0 00 000000 setz t1, ; Assume not more than 35 bits 34283 003123'01 623 02 0 00 400000 tlze t2, (1b0) ; Cast unsigned to signed long 34284 003124'01 201 01 0 00 000001 movei t1, ^d1 ; Propagate to high order 34285 003125'01 120 04 0 00 000001 dmove t4, t1 ; Now save the signed long 34286 34287 003126'01 260 17 0 00 003301' call dfloat ; Float signed long 34288 003127'01 263 17 0 00 000000 ret ; Or not... 34289 34290 003130'01 200 03 0 00 000002 move t3, t2 ; Reposition double floating low order 34291 003131'01 200 02 0 00 000001 move t2, t1 ; Reposition double floating high order 34292 003132'01 254 00 0 00 003120* retskp ; Succeed 34293 34294 K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 19:42 30-Mar-24 Page 49 K20TIM MAC 9-Dec-23 22:56 Schedule, Class and Load storage declarations 34295 subttl Schedule, Class and Load storage declarations 34296 34297 chgsec(code,data) ;;Declare non-global writable storage 34298 000240'05 000000 000000 class: 0 ;[130] My scheduler class. 34299 000241'05 000000 000000 skdflg: 0 ;[130] Nonzero if class scheduler on. 34300 000242'05 skdblk: block .saclu+1 ; Argument block for SKED% jsys. 34301 000251'05 000000 000000 skedx: 0 ;[194] SKED% error count 34302 000252'05 000000 601405 lgetbe: lstrx1 ;[194] Last GETAB% error 34303 000253'05 000000 000000 getabx: 0 ;[194] GETAB% error count 34304 000254'05 000000 601405 lskede: lstrx1 ;[194] Last error from SKED% (none) 34305 000255'05 000000 000000 ksajus: 0 ;[194] Kermit's (floating) job utilization 34306 retsec ;;Back into code 34307 K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 19:42 30-Mar-24 Page 50 K20TIM MAC 9-Dec-23 22:56 Get Scheduler Class information. 34308 subttl Get Scheduler Class information. 34309 34310 003133'01 gtclas: entry gtclas ; Identfy ourselves for LINK 34311 34312 003133'01 402 00 0 00 000000# setzm class ; Assume we ain't got no class ... (boo) 34313 003134'01 201 01 0 00 000014 movei t1, .skrcv ; Read scheduler status 34314 003135'01 120 02 0 00 003754' dmove t2, [exp t3 , 2] ; Two words, starting at t3 34315 003136'01 201 03 0 00 000002 movei t3, 2 ; Just want 2 words. 34316 003137'01 104 00 0 00 000577 SKED% 34317 003140'01 320 12 0 00 003142' ifje. r ; Catch and ignore error 34318 003141'01 254 00 0 00 003146' 34319 003142'01 202 01 0 00 000000# movem t1, lskede ; Save as last SKED% error 34320 003143'01 350 00 0 00 000000# aos skedx ; Count the error (should be only one) 34321 003144'01 402 00 0 00 000000# setzm skdflg ; Flag that the class scheduler is off 34322 003145'01 263 17 0 00 000000 ret ; Nothing else we can do 34323 003146'01 endif. ; End JSYS error handling 34324 34325 003146'01 603 04 0 00 100000 txne t4, sk%stp ; Class scheduler on? (bit means "stopped") 34326 003147'01 400 04 0 00 000000 setz t4, ; No, then whack all the bits we got back 34327 003150'01 202 04 0 00 000000# movem t4, skdflg ; And save some interesting bits 34328 003151'01 322 04 0 00 002751* jumpe t4, r ; If no scheduler, we're basically done here 34329 34330 ;[130] Scheduler is on, get my scheduler class. 34331 34332 003152'01 104 00 0 00 000013 GJINF% ; Get my job information 34333 003153'01 200 04 0 00 000003 move t4, t3 ; Put my job number in the right place 34334 34335 003154'01 265 16 0 00 000000* anstkv (t2,<.saclu+1>) ; Allocate an anonymous stack variable 34336 003155'01 000000 000007 34337 003156'01 415 02 0 17 777770 34338 remark ; Now fill out the argument block 34339 003157'01 124 03 0 02 000000 dmovem t3, .sacnt(t2) ; Pop them into the block 34340 003160'01 403 03 0 00 000004 setzb t3, t4 ; Cons up a pair of zeros 34341 003161'01 124 03 0 02 000002 dmovem t3, .sajcl(t2) ; Whack job class and job share 34342 003162'01 124 03 0 02 000004 dmovem t3, .sajus(t2) ; Whack job utilization and class share 34343 003163'01 402 00 0 02 000006 setzm .saclu(t2) ; Whack class utilization 34344 34345 003164'01 201 01 0 00 000007 movx t1, .skrjp ; Function code for getting job's class info. 34346 003165'01 104 00 0 00 000577 SKED% ; Cross our fingers 34347 003166'01 320 12 0 00 003170' ifje. r ; Failed?? 34348 003167'01 254 00 0 00 003174' 34349 003170'01 202 01 0 00 000000# movem t1, lskede ; Save as last SKED% error 34350 003171'01 350 00 0 00 000000# aos skedx ; Count the error (should be only one) 34351 003172'01 477 01 0 02 000002 setob t1, .sajcl(t2) ; Set class to -1 as a talisman 34352 003173'01 254 00 0 00 003175' else. ; Otherwise, worked! 34353 003174'01 200 01 0 02 000002 move t1, .sajcl(t2) ; So get a legitimate class 34354 003175'01 endif. ; End JSYS error 'recovery' 34355 34356 003175'01 202 01 0 00 000000# movem t1, class ; Who says I ain't got no class? 34357 003176'01 200 01 0 02 000004 move t1, .sajus(t2) ; Load job utilization because it's cool 34358 003177'01 202 01 0 00 000000# movem t1, ksajus ; Save it in case somebody ever cares 34359 003200'01 263 17 0 00 000000 ret 34360 K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 19:42 30-Mar-24 Page 51 K20TIM MAC 9-Dec-23 22:56 LDAV -- Get the current load average. 34361 subttl LDAV -- Get the current load average. 34362 34363 ;[130] This routine added as part of edit 130. 34364 ; 34365 ; Takes class scheduling into account. 34366 ; 34367 ; Call with 34368 ; 34369 ; t1/ 0 for 1 minute load average 34370 ; 1 for 5 minute load average 34371 ; 2 for 15 minute load average 34372 ; 34373 ; SKDFLG/ -1 if class scheduler running, 34374 ; 0 if no class scheduler or class scheduler stopped 34375 ; 34376 ; CLASS/ This job's scheduler class. 34377 ; 34378 ; Returns +1 always, with requested load average in t1. 34379 34380 003201'01 ldav: entry ldav ; Inform LINK of our location 34381 003201'01 265 16 0 00 003446' saveac ; Copy of deglitched calling argument 34382 003202'01 301 01 0 00 000000 cail t1, 0 ; Argument in range? 34383 003203'01 303 01 0 00 000002 caile t1, 2 34384 003204'01 400 01 0 00 000000 setz t1, ; Gubbish, silently force to 0. 34385 003205'01 200 05 0 00 000001 move q1, t1 ; Save a copy of it 34386 003206'01 332 00 0 00 000000# skipe skdflg ; Class scheduler on? 34387 003207'01 254 00 0 00 003221' jrst cldav ; Yes, go get class load average 34388 34389 ; No class scheduler or it's off, so use GETAB for system-wide load average 34390 34391 003210'01 514 01 0 00 000005 gldav: hrlz t1, q1 ; Desired load average. 34392 003211'01 270 01 0 00 003756' add t1, [14,,.systa] ; Goes from offset 14 to 16 (see 2.3.2) 34393 003212'01 104 00 0 00 000010 GETAB ; use load avg from SYSTAT monitor table. 34394 003213'01 320 12 0 00 003215' ifje. r ;[194] Catch and ignore error 34395 003214'01 254 00 0 00 003220' 34396 003215'01 202 01 0 00 000000# movem t1, lgetbe ;[194] Save last error 34397 003216'01 350 00 0 00 000000# aos getabx ;[194] Bump GETAB error count 34398 003217'01 205 01 0 00 203400 movx t1, ; Return minimum load in case of any error. 34399 003220'01 endif. ;[194] 34400 003220'01 263 17 0 00 000000 ret ; Otherwise, got some useful 34401 34402 ; Class scheduler on, get load avg for this class from SKED%. 34403 34404 003221'01 335 04 0 00 000000# cldav: skipge t4, class ; This job's scheduler class. 34405 003222'01 254 00 0 00 003210' jrst gldav ; We're in an odd way, fall back to GETAB 34406 34407 003223'01 265 16 0 00 003154* anstkv (t2,<.sa15l+1>) ; Allocate an anonymous stack variable 34408 003224'01 000000 000007 34409 003225'01 415 02 0 17 777770 34410 003226'01 124 03 0 02 000000 dmovem t3, .sacnt(t2) ; Store length and requested class 34411 003227'01 403 03 0 00 000004 setzb t3, t4 ; Cons up a pair of zeros 34412 003230'01 124 03 0 02 000002 dmovem t3, .sashr(t2) ; Whack returned share and use 34413 003231'01 124 03 0 02 000004 dmovem t3, .sa1ml(t2) ; Whack one and five minute load averages 34414 003232'01 402 00 0 02 000006 setzm .sa15l(t2) ; Whack 15 minute load average 34415 K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 19:42 30-Mar-24 Page 51-1 K20TIM MAC 9-Dec-23 22:56 LDAV -- Get the current load average. 34416 003233'01 201 01 0 00 000003 movei t1, .skrcs ; Function is read class parameters. 34417 003234'01 104 00 0 00 000577 SKED% 34418 003235'01 320 12 0 00 003237' ifje. r ; Catch and ignore error 34419 003236'01 254 00 0 00 003243' 34420 003237'01 202 01 0 00 000000# movem t1, lskede ; Save as last SKED% error 34421 003240'01 350 00 0 00 000000# aos skedx ; Count the error (should be only one) 34422 003241'01 402 00 0 00 000000# setzm skdflg ; Flag that the class scheduler went off 34423 003242'01 254 00 0 00 003210' jrst gldav ; Fall back to GETAB 34424 003243'01 endif. ; End JSYS error handling 34425 34426 003243'01 201 03 0 02 000004 movei t3,.sa1ml(t2) ; Resolve base of load average block 34427 003244'01 270 03 0 00 000005 add t3, q1 ; Add offset to get to the one we want 34428 003245'01 200 01 0 03 000000 move t1, (t3) ; Finally load whatever it is 34429 003246'01 263 17 0 00 000000 ret ; Done 34430 K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 19:42 30-Mar-24 Page 52 K20TIM MAC 9-Dec-23 22:56 Increase wait time, depending on system load (very clever) 34431 subttl Increase wait time, depending on system load (very clever) 34432 34433 ;[128] Make this a separate routine. 34434 ; 34435 ; ADJTIM -- Adjust timeout interval based on load average (ldav). 34436 ; 34437 ; Timeout = mintim + (ldav-MINLOD)*((MAXTIM-mintim)/MAXLOD) 34438 ; 34439 ; 1) If the load is low, gives the minimum acceptable timeout, mintim. 34440 ; 2) If the load is very high, gives the maximum timeout, MAXTIM. 34441 ; 34442 ; In between, the timeout goes up linearly with given load average. 34443 ; 34444 ; MINLOD, MAXLOD, and MAXTIM are defined as global symbols. 34445 ; 34446 ; Call with: 34447 ; 34448 ; t1/ 1, 5, or 15 minute ldav, 34449 ; (floating point number as returned by ldav) 34450 ; t2/ minimum acceptable timeout (mintim), milliseconds (integer). 34451 ; 34452 ; Returns +1 always, with 34453 ; 34454 ; t2/ adjusted timeout interval, in milliseconds (integer). 34455 ; 34456 ; N.B., 34457 ; 34458 ; Will never return a number larger than MAXTIM. 34459 ; Zero means no time out and is always returned as zero 34460 34461 003247'01 adjtim: entry adjtim ; Inform LINK of our location 34462 003247'01 327 02 0 00 003252' ifle. t2 ;[212] Zero or goofy? 34463 003250'01 400 02 0 00 000000 setz t2, ;[212] Load zero (to never time out) 34464 003251'01 263 17 0 00 000000 ret ;[212] And return that 34465 003252'01 endif. 34466 34467 remark ;[212] Otherwise, have some math to do 34468 003252'01 265 16 0 00 000000* acvar ; Local storage for second argument. 34469 003253'01 202 02 0 00 000005 movem t2, mintim ; Save the minimum for later. 34470 34471 remark (ldav-MINLOD) ;[212] Normalize load to trigger after minlod 34472 003254'01 155 01 0 00 203400 fsbrx t1, ;[194] Adjust load by subtracting the minimum. 34473 003255'01 327 01 0 00 003261' ifle. t1 ;[212] Zero or negative load? 34474 003256'01 200 02 0 00 000005 move t2, mintim ;[212] Then second term has no effect 34475 003257'01 263 17 0 00 000000 ret ;[212] So just return the number, unaltered 34476 003260'01 254 00 0 00 003263' else. ;[212] Otherwise, range check the result 34477 003261'01 311 01 0 00 003757' caxl t1, ;[194] If too big, clamp to maximum 34478 003262'01 205 01 0 00 206620 movx t1, ;[194] It was, so load the maximum 34479 003263'01 endif. 34480 34481 remark (MAXTIM-mintim) ;[212] Range check and correct timeout 34482 003263'01 201 02 0 00 267460 movx t2, maxtim ;[212] Maximum timeout, milliseconds. 34483 003264'01 274 02 0 00 000005 sub t2, mintim ; Less specified timeout interval. 34484 003265'01 327 02 0 00 003271' ifle. t2 ;[212] Efficiency hack, is this not positive? 34485 003266'01 201 02 0 00 267460 movx t2, maxtim ;[212] Clamp result to maximum K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 19:42 30-Mar-24 Page 52-1 K20TIM MAC 9-Dec-23 22:56 Increase wait time, depending on system load (very clever) 34486 003267'01 263 17 0 00 000000 ret ;[212] And done 34487 003270'01 254 00 0 00 003272' else. ;[212] Otherwise, 34488 003271'01 127 02 0 00 000002 fltr t2, t2 ;[212] float the result 34489 003272'01 endif. ;[212] End term check 34490 34491 003272'01 175 02 0 00 206620 fdvrx t2, ;[194] Divided by maximum load. 34492 003273'01 164 01 0 00 000002 fmpr t1, t2 ; Multiplied by actual (adjusted) load. 34493 003274'01 126 02 0 00 000001 fixr t2, t1 ; Fixed & rounded. 34494 003275'01 270 02 0 00 000005 add t2, mintim ; Add in requested minimum timeout. 34495 003276'01 303 02 0 00 267460 caile t2, maxtim ;[212] Larger than largest? 34496 003277'01 201 02 0 00 267460 movx t2, maxtim ;[212] Clamp to maximum 34497 34498 003300'01 263 17 0 00 000000 ret ; Return with result in t2. 34499 34500 endav. ;[194] End scope mintim acvar 34501 34502 K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 19:42 30-Mar-24 Page 53 K20TIM MAC 9-Dec-23 22:56 Tables to support integer to double floating conversion 34503 SUBTTL Tables to support integer to double floating conversion 34504 34505 ;[206] Begin code insertion, selflessly donated from my very 34506 ; own Tops-20 Extended mode FTP Server. "Share and Enjoy" 34507 34508 REMARK Table to see if we can do a simple shift 34509 34510 ; When converting a single word integer to double floating point 34511 ; format, there is no case where we are ever going to have to round. 34512 ; However, in certain instances where the lower part of the word is 34513 ; clear, we can bum the combined (double accumulator) arithmetic shift 34514 ; and get by with a faster single accumulator logical shift. 34515 ; 34516 ; This is accomplished by checking to see if any bits would go from 34517 ; the lower high order word to the upper lower order word with these 34518 ; masks whose indices correspond to the amount of bits we'd need to 34519 ; shift over. 34520 34521 chgsec(code,const) ;;Constants go into CONST area 34522 34523 000213'02 000000 000000 SLSHMK: 0 ; Always positive means we'll skip the first entry 34524 000214'02 000000 000377 ^B11111111 ; 8 ; and will always be at least one 34525 000215'02 000000 000177 ^B1111111 ; 7 ; Means we have to have entire field free 34526 000216'02 000000 000077 ^B111111 ; 6 34527 000217'02 000000 000037 ^B11111 ; 5 34528 000220'02 000000 000017 ^B1111 ; 4 34529 000221'02 000000 000007 ^B111 ; 3 34530 000222'02 000000 000003 ^B11 ; 2 34531 000223'02 000000 000001 ^B1 ; 1 34532 000224'02 000 00 0 00 000000 Z ; 0 ; Should never happen because should have 34533 ; been caught by the rounding logic 34534 34535 REMARK Binary exponent increment 34536 34537 ; The table cooresponds to the simple shift hack, above. In this 34538 ; case, we already have the correct magnitude and simply need to 34539 ; change it based on the amount of the shift. 34540 34541 000225'02 000000 000000 BXPINC: 0 ; Always positive means we'll skip the first entry 34542 000226'02 010000 000000 FLD(^D8,EXPMSK) ; and will always be at least one bit because JFFO 34543 000227'02 007000 000000 FLD(^D7,EXPMSK) ; is always going to count the sign. Thus, having 34544 000230'02 006000 000000 FLD(^D6,EXPMSK) ; one bit set means we would have shifted out an 34545 000231'02 005000 000000 FLD(^D5,EXPMSK) ; entire exponent field 34546 000232'02 004000 000000 FLD(^D4,EXPMSK) 34547 000233'02 003000 000000 FLD(^D3,EXPMSK) 34548 000234'02 002000 000000 FLD(^D2,EXPMSK) 34549 000235'02 001000 000000 FLD(^D1,EXPMSK) 34550 000236'02 000 00 0 00 000000 Z ; Should never happen because should have caught 34551 ; by the rounding decision logic 34552 K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 19:42 30-Mar-24 Page 54 K20TIM MAC 9-Dec-23 22:56 Tables to support integer to double floating conversion 34553 REMARK Double word binary exponent 34554 34555 ; In this case, the table contains all of the possible exponent values 34556 ; for corresponding shifts when normalizing an integer in the high 34557 ; order word. 34558 34559 000237'02 000000 000000 DWBEXP: 0 ; Ignore the sign bit 34560 000240'02 306000 000000 FLD(^D<35+35+128>,EXPMSK) 34561 000241'02 305000 000000 FLD(^D<34+35+128>,EXPMSK) 34562 000242'02 304000 000000 FLD(^D<33+35+128>,EXPMSK) 34563 000243'02 303000 000000 FLD(^D<32+35+128>,EXPMSK) 34564 000244'02 302000 000000 FLD(^D<31+35+128>,EXPMSK) 34565 000245'02 301000 000000 FLD(^D<30+35+128>,EXPMSK) 34566 000246'02 300000 000000 FLD(^D<29+35+128>,EXPMSK) 34567 000247'02 277000 000000 FLD(^D<28+35+128>,EXPMSK) 34568 000250'02 000 00 0 00 000000 Z ; Should be caught by non-shifting case!!! 34569 000251'02 275000 000000 FLD(^D<26+35+128>,EXPMSK) 34570 000252'02 274000 000000 FLD(^D<25+35+128>,EXPMSK) 34571 000253'02 273000 000000 FLD(^D<24+35+128>,EXPMSK) 34572 000254'02 272000 000000 FLD(^D<23+35+128>,EXPMSK) 34573 000255'02 271000 000000 FLD(^D<22+35+128>,EXPMSK) 34574 000256'02 270000 000000 FLD(^D<21+35+128>,EXPMSK) 34575 000257'02 267000 000000 FLD(^D<20+35+128>,EXPMSK) 34576 000260'02 266000 000000 FLD(^D<19+35+128>,EXPMSK) 34577 000261'02 265000 000000 FLD(^D<18+35+128>,EXPMSK) 34578 000262'02 264000 000000 FLD(^D<17+35+128>,EXPMSK) 34579 000263'02 263000 000000 FLD(^D<16+35+128>,EXPMSK) 34580 000264'02 262000 000000 FLD(^D<15+35+128>,EXPMSK) 34581 000265'02 261000 000000 FLD(^D<14+35+128>,EXPMSK) 34582 000266'02 260000 000000 FLD(^D<13+35+128>,EXPMSK) 34583 000267'02 257000 000000 FLD(^D<12+35+128>,EXPMSK) 34584 000270'02 256000 000000 FLD(^D<11+35+128>,EXPMSK) 34585 000271'02 255000 000000 FLD(^D<10+35+128>,EXPMSK) 34586 000272'02 254000 000000 FLD(^D<09+35+128>,EXPMSK) 34587 000273'02 253000 000000 FLD(^D<08+35+128>,EXPMSK) 34588 000274'02 252000 000000 FLD(^D<07+35+128>,EXPMSK) 34589 000275'02 251000 000000 FLD(^D<06+35+128>,EXPMSK) 34590 000276'02 250000 000000 FLD(^D<05+35+128>,EXPMSK) 34591 000277'02 247000 000000 FLD(^D<04+35+128>,EXPMSK) 34592 000300'02 246000 000000 FLD(^D<03+35+128>,EXPMSK) 34593 000301'02 245000 000000 FLD(^D<02+35+128>,EXPMSK) 34594 000302'02 244000 000000 FLD(^D<01+35+128>,EXPMSK) 34595 000303'02 000 00 0 00 000000 Z ; Indicates a zero upper word which should 34596 ; have already been accounted for 34597 K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 19:42 30-Mar-24 Page 55 K20TIM MAC 9-Dec-23 22:56 Tables to support integer to double floating conversion 34598 REMARK Double word arithmetic shift normalization 34599 34600 RADIX ^D10 34601 34602 ; N.B., negative shift is the only case where a round operation would be needed 34603 34604 000304'02 000000 000000 DWASHN: 0 ; Ignore the sign bit 34605 000305'02 777777 777770 EXP -8,-7,-6,-5,-4,-3,-2,-1 ; Cases of opening up exponent field 34606 000315'02 000 00 0 00 000000 Z ; Should be caught by non-shifting case!! 34607 000316'02 000000 000001 EXP 1, 2, 3, 4, 5, 6, 7, 8, 9 ; Cases of shifting significance towards 34608 000327'02 000000 000012 EXP 10,11,12,13,14,15,16,17,18,19 ; the exponent field--never any rounding 34609 000341'02 000000 000024 EXP 20,21,22,23,24,25,26 ; Should never exceed 26 shifts 34610 000350'02 000 00 0 00 000000 Z ; Indicates a zero upper word which 34611 ; should have already been accounted for 34612 RADIX ^D8 34613 34614 retsec ;;Restore psect assumptions 34615 K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 19:42 30-Mar-24 Page 56 K20TIM MAC 9-Dec-23 22:56 Routine to implement double float 34616 SUBTTL Routine to implement double float 34617 34618 ; The routine assumes that the exponent will always be positive (I.E., 34619 ; greater than 128 decimal, 200 octal). This is--by definition-- 34620 ; always true for integers: there will NEVER be fractions, much less 34621 ; values less than 1 other than zero (0) or a negative. 34622 ; 34623 ; It assumes that the number will be positive. If this is not the 34624 ; case, it takes the magitude of the integer and multiplies the 34625 ; eventual result by double floating negative 1. This will slow down 34626 ; the double floatation of negative numbers, but in this program we 34627 ; never produce those. 34628 ; 34629 ; It also doesn't do any rounding. However, rounding would only occur 34630 ; for values that are in excess of 4,611,686,018,427,387,903 34631 ; (approximately 4.5 million trillion). Since the numbers in question 34632 ; are not going to be THAT large, this is not a problem in this 34633 ; program. 34634 ; 34635 ; We're just looking to keep the original number in the fraction (or 34636 ; mantissa) and hence need the additional word of dynamic range 34637 ; 34638 ; N.B., Toad doesn't have dfltr yet it has dgfltr... Why?? 34639 ; 34640 ; Call: 34641 ; 34642 ; T1/ High order double integer 34643 ; T2/ Low order double integer 34644 ; 34645 ; Return: 34646 ; 34647 ; +1 Something failed, T1 and T2 indeterminate 34648 ; +2 Success 34649 ; T1/ High order double floating point (most significant bits of mantissa) 34650 ; T2/ Low order double floating point number 34651 34652 377000 000000 EXPMSK==MASKB(1,8) ; Exponent field mask 34653 34654 003301'01 DFLOAT: ENTRY DFLOAT ; Make available to the world 34655 003301'01 326 01 0 00 003304' IFE. T1 ; No high order. Might be zero ... 34656 003302'01 326 02 0 00 003304' IFE. T2 ; Any low order? 34657 003303'01 263 17 0 00 000000 RET ; No, got passed a zero, so nothing to do 34658 003304'01 ENDIF. ; End case of zero low order 34659 003304'01 ENDIF. ; End case of zero high order 34660 34661 003304'01 265 16 0 00 003760' SAVEAC ; Real work! Will need some scratch storage 34662 003305'01 321 01 0 00 003311' IFGE. T1 ; Something positivishly flavored? 34663 003306'01 120 03 0 00 000001 DMOVE T3,T1 ; Yes, save a copy of the number 34664 003307'01 400 06 0 00 000000 SETZ Q2, ; flag positivity 34665 003310'01 254 00 0 00 003314' ELSE. ; Otherwise make positive and fix later 34666 REMARK DMOVN ; Don't use; floating only, will break on ints 34667 003311'01 403 03 0 00 000004 SETZB T3,T4 ; Make a big fat zero 34668 003312'01 115 03 0 00 000001 DSUB T3,T1 ; Make negative a positive in T3:T4 34669 003313'01 474 06 0 00 000000 SETO Q2, ; Flag negativity 34670 003314'01 ENDIF. ; End case of negative signed double K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 19:42 30-Mar-24 Page 56-1 K20TIM MAC 9-Dec-23 22:56 Routine to implement double float 34671 34672 003314'01 326 03 0 00 003347' IFE. T3 ; Not really a HUGE number after all? 34673 003315'01 603 04 0 00 377000 TXNE T4,EXPMSK ; Would we have to round???? 34674 003316'01 254 00 0 00 003327' IFSKP. ; No, maybe we can bum the FLTR ... 34675 003317'01 607 04 0 00 000400 TXNN T4,1B9 ; In the range of 67,108,864 to 134,217,727? 34676 003320'01 254 00 0 00 003324' IFSKP. ; Yes, already normalized! 34677 003321'01 205 01 0 00 233000 MOVX T1,FLD(^D<128+27>,EXPMSK) 34678 003322'01 434 01 0 00 000004 IOR T1,T4 ; Cons the exponent and mantissa 34679 003323'01 254 00 0 00 003325' ELSE. ; Otherwise, can use plain old reliable ... 34680 003324'01 127 01 0 00 000004 FLTR T1,T4 ; and float it (slowly) 34681 003325'01 ENDIF. ; Either way, T1 is complete 34682 003325'01 400 02 0 00 000000 SETZ T2, ; There is no low order mantissa 34683 003326'01 254 00 0 00 003346' ELSE. ; Otherwise more than 27 bit mantissa 34684 003327'01 200 01 0 00 000004 MOVE T1,T4 ; Load the integer 34685 003330'01 260 17 0 00 003431' CALL EXPSFT ; Compute shift amount to clear field 34686 003331'01 263 17 0 00 000000 RET ; Oh dear, we're ill, beat it 34687 003332'01 205 01 0 00 233000 MOVX T1,FLD(^D<128+27>,EXPMSK) 34688 003333'01 270 01 0 02 000000# ADD T1,BXPINC(T2) ; Load maximum unrounded and calculate shift 34689 003334'01 612 04 0 02 000000# TDNE T4,SLSHMK(T2) ; Is there enough space for a single shift 34690 003335'01 254 00 0 00 003342' IFSKP. ; Yes, use logical since FASTER than a combined 34691 003336'01 242 04 0 05 000000 LSH T4,(Q1) ; Finally get the bits out of the way 34692 003337'01 434 01 0 00 000004 IOR T1,T4 ; Cons the exponent and mantissa 34693 003340'01 400 02 0 00 000000 SETZ T2, ; And nothing in the low order 34694 003341'01 254 00 0 00 003346' ELSE. ; Otherwise part of mantissa will be in low word 34695 003342'01 250 03 0 00 000004 EXCH T3,T4 ; Bum a word's worth of shifting 34696 003343'01 244 03 0 05 000000 ASHC T3,(Q1) ; Split the fraction across two words 34697 003344'01 434 01 0 00 000003 IOR T1,T3 ; Cons the exponent and high mantissa 34698 003345'01 200 02 0 00 000004 MOVE T2,T4 ; And return the low mantissa 34699 003346'01 ENDIF. ; End case of combined shift decision 34700 003346'01 ENDIF. ; End case of 27 bit (non-rounded) mantissa 34701 003346'01 254 00 0 00 003424' JRST DFLRET ; And return the value 34702 003347'01 ENDIF. ; End case of no high order mantissa 34703 ; Some kind of large number ... 34704 003347'01 326 04 0 00 003402' IFE. T4 ; Maybe no low order mantissa? 34705 003350'01 603 03 0 00 377000 TXNE T3,EXPMSK ; Would we round the high order? 34706 003351'01 254 00 0 00 003363' IFSKP. ; No, maybe we can bum the FLTR ... 34707 003352'01 607 03 0 00 000400 TXNN T3,1B9 ; If between 2,305,843,009,213,693,952 and 34708 003353'01 254 00 0 00 003357' IFSKP. ; 4,611,685,984,067,649,536, already normalized! 34709 003354'01 205 01 0 00 276000 MOVX T1,FLD(^D<128+27+35>,EXPMSK) 34710 003355'01 434 01 0 00 000003 IOR T1,T3 ; Cons the exponent and mantissa 34711 003356'01 254 00 0 00 003361' ELSE. ; Otherwise, can use plain old reliable ... 34712 003357'01 127 01 0 00 000003 FLTR T1,T3 ; and float it (slowly) 34713 003360'01 270 01 0 00 003772' ADDX T1,FLD(^D35,EXPMSK) ; However, it is a lot larger 34714 003361'01 ENDIF. ; Either way, T1 is complete 34715 003361'01 400 02 0 00 000000 SETZ T2, ; There is no low order mantissa 34716 003362'01 254 00 0 00 003401' ELSE. ; Must get some bits out of the exponent field 34717 003363'01 200 01 0 00 000003 MOVE T1,T3 ; Load the (large) integer 34718 003364'01 260 17 0 00 003431' CALL EXPSFT ; Compute shift amount to clear field 34719 003365'01 263 17 0 00 000000 RET ; Oh dear, we're ill, beat it 34720 003366'01 205 01 0 00 276000 MOVX T1,FLD(^D<128+27+35>,EXPMSK) 34721 003367'01 270 01 0 02 000000# ADD T1,BXPINC(T2) ; Load maximum unrounded and calculate shift 34722 003370'01 612 03 0 02 000000# TDNE T3,SLSHMK(T2) ; Is there enough space for a single shift 34723 003371'01 254 00 0 00 003376' IFSKP. ; Yes, use logical since FASTER than a combined 34724 003372'01 242 03 0 05 000000 LSH T3,(Q1) ; Finally get the bits out of the way 34725 003373'01 434 01 0 00 000003 IOR T1,T3 ; Cons the exponent and mantissa K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 19:42 30-Mar-24 Page 56-2 K20TIM MAC 9-Dec-23 22:56 Routine to implement double float 34726 003374'01 400 02 0 00 000000 SETZ T2, ; And nothing in the low order 34727 003375'01 254 00 0 00 003401' ELSE. ; Otherwise part of mantissa will be in low word 34728 003376'01 244 03 0 05 000000 ASHC T3,(Q1) ; Split the fraction across two words 34729 003377'01 434 01 0 00 000003 IOR T1,T3 ; Cons the exponent and high mantissa 34730 003400'01 200 02 0 00 000004 MOVE T2,T4 ; And return the low mantissa 34731 003401'01 ENDIF. ; End case of combined shift decision 34732 003401'01 ENDIF. ; End case of 27 or less bit high order mantissa 34733 003401'01 254 00 0 00 003424' JRST DFLRET ; and return the value 34734 003402'01 ENDIF. ; End case of no low order mantissa 34735 ; Here if more than 35 significant bits 34736 003402'01 603 03 0 00 377000 TXNE T3,EXPMSK ; If we are between 2,305,843,009,213,693,952 34737 003403'01 254 00 0 00 003412' IFSKP. ; and 4,611,686,018,427,387,903 then the double 34738 003404'01 607 03 0 00 000400 TXNN T3,1B9 ; float will be trivial as the mantissa is already 34739 003405'01 254 00 0 00 003412' ANSKP. ; in the right place, 'normalized' so to speak 34740 003406'01 205 01 0 00 276000 MOVX T1,FLD(^D<128+27+35>,EXPMSK) 34741 003407'01 434 01 0 00 000003 IOR T1,T3 ; Cons the exponent and mantissa 34742 003410'01 200 02 0 00 000004 MOVE T2,T4 ; lower order fraction will not move, either 34743 003411'01 254 00 0 00 003424' JRST DFLRET ; and return the value 34744 003412'01 ENDIF. ; End case of exactly perfect double mantissa 34745 ; Finally have to do some honest work ... 34746 003412'01 332 01 0 00 000003 SKIPE T1,T3 ; Load (and check) the high order of the mantissa 34747 003413'01 243 01 0 00 003415' JFFO T1,.+2 ; Find the first significant bit 34748 003414'01 263 17 0 00 000000 RET ; Broken JFFO, we just checked T3! 34749 003415'01 337 01 0 02 000000# SKIPG T1,DWBEXP(T2) ; Load the appropriate double word binary exponent 34750 003416'01 263 17 0 00 000000 RET ; Probably an errorneous table ... 34751 003417'01 336 05 0 02 000000# SKIPN Q1,DWASHN(T2) ; Load and check the normalization shift 34752 003420'01 263 17 0 00 000000 RET ; Probably an errorneous table ... 34753 003421'01 244 03 0 05 000000 ASHC T3,(Q1) ; Otherwise normalize the double integer 34754 003422'01 434 01 0 00 000003 IOR T1,T3 ; Cons up the exponent and high order mantissa 34755 003423'01 200 02 0 00 000004 MOVE T2,T4 ; Return the properly normalized low order 34756 REMARK DFLRET ; And hit the exit code 34757 K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 19:42 30-Mar-24 Page 57 K20TIM MAC 9-Dec-23 22:56 Double floating integer conversion support 34758 SUBTTL Double floating integer conversion support 34759 34760 REMARK Common exit, converts number to negative, if necessary 34761 34762 003424'01 305 06 0 00 000000 DFLRET: CAIGE Q2,0 ; If the original was positive, then we're through 34763 003425'01 112 01 0 00 003427' DFMP T1,DFLM1 ; No, (re)negativize our result (slowly) 34764 003426'01 254 00 0 00 003132* RETSKP ; Done 34765 34766 003427'01 576400 000000 DFLM1: EXP <576400,,0>,0 ; -1 DFMP multiplicand is what DFIN% gave us 34767 34768 34769 REMARK Here to compute number of bits to shift out of exponent field 34770 34771 ; Call: 34772 ; 34773 ; T1/ Has a number with bits in the exponent field 34774 ; 34775 ; Return: 34776 ; 34777 ; +1 Something failed, T2 and Q1 indeterminate 34778 ; +2 Success 34779 ; T2/ JFFO results (first set bit) 34780 ; Q1/ Number of bits to shift to clear the field 34781 34782 003431'01 307 01 0 00 000000 EXPSFT: CAIG T1,0 ; Zero or negative? 34783 003432'01 263 17 0 00 000000 RET ; Gronk, got called with junk 34784 003433'01 607 01 0 00 377000 TXNN T1,EXPMSK ; But is there anything to be shifted out? 34785 003434'01 263 17 0 00 000000 RET ; No, we should never have been invoked 34786 003435'01 243 01 0 00 003437' JFFO T1,.+2 ; Now find out how many leading bits 34787 003436'01 263 17 0 00 000000 RET ; Broken JFFO ... 34788 003437'01 301 02 0 00 000011 CAXL T2,1+WID(EXPMSK) ; More bits than the exponent field? 34789 003440'01 263 17 0 00 000000 RET ; Already clear and we shouldn't be here 34790 003441'01 307 02 0 00 000000 CAIG T2,0 ; However, there better be at least the sign bit! 34791 003442'01 263 17 0 00 000000 RET ; Broken JFFO (negative number check) 34792 003443'01 561 05 0 00 777767 MOVX Q1,-<1+WID(EXPMSK)> ;Load maximum possible shift 34793 003444'01 270 05 0 00 000002 ADD Q1,T2 ; And calculate the shift 34794 003445'01 254 00 0 00 003426* RETSKP ; Done! 34795 34796 ;[206] End code insertion. Or transfer. Or graft. Or something... 34797 K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 19:42 30-Mar-24 Page 58 K20TIM MAC 9-Dec-23 22:56 Calculates rate assuming input mantissas of less tnen 2^27 34798 subttl Calculates rate assuming input mantissas of less tnen 2^27 34799 34800 repeat 0,< ; Vestigial, unused 34801 34802 ; Call: 34803 ; 34804 ; t2/ Elapsed TOD ticks for transfer 34805 ; t3/ Total characters sent or received 34806 ; 34807 ; Returns: 34808 ; 34809 ; t4/ Double floating raw baud rate, high order mantissa 34810 ; t5/ Ditto, low order mantissa 34811 ; 34812 ; N.B., assumes input arguments (t3 and elapsed TOD ticks) 34813 ; do not have more than a 27 bit mantissa. 34814 ; 34815 ; Note refactoring of mathmatical operations to maintain better 34816 ; precision, Also bums a double floating divide (see below), the 34817 ; slowest instruction going. Thanks to Professor Anne for the 34818 ; multiplicative identities. 34819 34820 34821 calr27: fltr t4,t3 ; Float the count 34822 setz t5, ; Whack low order 34823 dfmp t4,[exp 2621440.,0] ;Intermediate bit ticks 34824 fltr t2,t2 ; Float those, too 34825 setz t3, ; Double float, almost (see peffif, sigh) 34826 dfmp t2,[exp 86400.,0] ; Intermediate seconds 34827 dfdv t4,t2 ; Calculates bits per second 34828 ret ; Returns rate in t4,t5 34829 34830 >;;End repeat 0 34831 K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 19:42 30-Mar-24 Page 59 K20TIM MAC 9-Dec-23 22:56 Calculates rate assuming input mantissas of less then 2^27 34832 subttl Calculates rate assuming input mantissas of less then 2^27 34833 34834 repeat 0,< ; See numerical analysis, above 34835 34836 ; Call: 34837 ; 34838 ; t2/ Elapsed TOD ticks for transfer 34839 ; t3/ Total characters sent or received 34840 ; 34841 ; Returns: 34842 ; 34843 ; t4/ Double floating raw baud rate, high order mantissa 34844 ; t5/ Ditto, low order mantissa 34845 ; 34846 ; N.B., Assumes input arguments (t3 and elapsed TOD ticks) 34847 ; do not have more than a 27 bit mantissa. 34848 34849 calr27: fltr t4,t3 ; Float the count 34850 setz t5, ; Whack low order 34851 fltr t2,t2 ; Float elapsed ticks 34852 setz t3, ; Double float, almost (see peffif, sigh) 34853 dfmp t2,[exp 86400.,0] ; Convert to characters per second 34854 dfdv t2,[exp 262144.,0] ; Strip off TOD ticks 34855 dfdv t4,t2 ; Calculates characters per second 34856 dfmp t4,[exp 10.,0] ; Convert cps to bps 34857 ret ; Returns rate in t4,t5 34858 34859 >;;End repeat 0 34860 34861 .xcmsy ; Ditch any MACSYM junk 34862 34863 end NO ERRORS DETECTED PROGRAM BREAK IS 000000 PSECT 1 BREAK IS 003774 FOR CODE PSECT 2 BREAK IS 000440 FOR CONST PSECT 3 BREAK IS 000165 FOR TEXT PSECT 4 BREAK IS 001145 FOR ETEXT PSECT 5 BREAK IS 000256 FOR DATA PSECT 6 BREAK IS 004000 FOR DEVTIM CPU TIME USED 00:01.581 123P CORE USED K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 19:42 30-Mar-24 Page S-1 K20TIM MAC 9-Dec-23 22:56 SYMBOL TABLE ASCDEV 000000 ext MTOPR% 104000 000077 int RFRKH% 104000 000165 int .FPAC 000005 spd ASND% 104000 000070 int N 200000 000000 spd RFSTS% 104000 000156 int .GSDMP 000017 sin BOUTI% 000000 ext NO%AST 010000 000000 sin RSKP 000000 ext .GSIMG 000010 sin CALL 260740 000000 NO%COL 000177 000000 sin S 400000 000000 spd .GSNRM 000000 sin CALLRE 254000 000000 spd NO%LFL 100000 000000 sin SETER% 104000 000336 int .GSSMB 000001 sin CFMRTN 000000 ext NO%MAG 400000 000000 sin SF%CON 400000 000000 sin .HPELP 000000 sin CFORK% 104000 000152 int NO%OOV 020000 000000 sin SFORK% 104000 000157 int .HPTOD 000004 sin CM%ABR 000004 sin NO%RDX 777777 sin SIN% 104000 000052 int .INFIN 377777 777777 sin CM%FNC 777000 000000 sin NO%ZRO 040000 000000 sin SK%STP 100000 000000 sin .JSAOF 000001 sin CM%FW 002000 000000 sin NOIRTN 000000 ext SKED% 104000 000577 int .MOCC 000041 sin CM%HPP 000004 000000 sin NOP 600000 000000 sin SOUT% 104000 000053 int .NPAC 000010 spd CM%INV 000001 sin NOUT% 104000 000224 int SOUTR% 104000 000532 int .NULIO 377777 sin CMDER1 000000 ext NULLEN 004000 spd SPJFN% 104000 000207 int .PRIIN 000100 sin CODE 000000 ext NULPAG 000002 spd SYMOUT 000000 ext .PRIOU 000101 sin CONST 000000 ext NULPGS 000003 spd T1 000001 spd .PX7 610001 000000 spd CR%ACS 040000 000000 sin ODTIM% 104000 000220 int T2 000002 spd .RFFPT 000003 sin CR%MAP 400000 000000 sin OF%BSZ 770000 000000 sin T3 000003 spd .RFHLT 000002 sin CR%PCV 777777 sin OF%MOD 007400 000000 sin T4 000004 spd .RFIO 000001 sin CR%ST 020000 000000 sin OF%RD 200000 sin T5 000005 spd .RFRUN 000000 sin CRLF 000000 ext OF%WR 100000 sin TEXT 000000 ext .RFSIG 000010 sin CX 000016 OPENF% 104000 000021 int TIME% 104000 000014 int .SA15L 000006 sin DATA 000000 ext P 000017 TODTIC 000001 000000 spd .SA1ML 000004 sin DEVORG 002000 spd P1 000011 spd WFORK% 104000 000163 int .SAC 000016 DEVTIM 000000 ext P2 000012 spd XMOVEI 415000 000000 int .SACLU 000006 sin DIRST% 104000 000041 int P3 000013 spd %%JSER 000000 ext .SACNT 000000 sin DISMS% 104000 000167 int P4 000014 spd %%SMSG 000000 ext .SAJCL 000002 sin DKDAY 100276 770000 spd P5 000015 spd ..MSK 777777 777777 spd .SAJUS 000004 sin DTILEN 000021 spd PARS1 000000 ext .A16 000016 spd .SASHR 000002 sin ERJMP 320700 000000 int PARS2 000000 ext .CHNUL 000000 sin .SAV1 000000 ext ERJMPR 320500 000000 int PARS3 000000 ext .CHSPC 000040 sin .SAV2 000000 ext ERJMPS 320600 000000 int PARS4 000000 ext .CMCFM 000010 sin .SAV3 000000 ext ERSTR% 104000 000011 int PARS5 000000 ext .CMDEV 000016 sin .SKRCS 000003 sin ESOUT% 104000 000313 int PBOUT% 104000 000074 int .CMFNP 000000 sin .SKRCV 000014 sin ETEXT 000000 ext PM%ABT 000100 000000 sin .CMKEY 000000 sin .SKRJP 000007 sin FFORK% 104000 000154 int PM%CNT 400000 000000 sin .CMNUM 000001 sin .SYSTA 000014 sin GETAB 104000 000010 int PM%RD 100000 000000 sin .CMSWI 000003 sin .XSTKS 000000 ext GETER% 104000 000012 int PM%RPT 777777 sin .CTTRM 777777 sin .XTRST 000000 ext GJ%FLG 000020 000000 sin PMAP% 104000 000056 int .DATDK 000007 spd GJ%SHT 000001 000000 sin PSOUT% 104000 000076 int .DATEH 000005 spd GJINF% 104000 000013 int PTYLEN 001000 spd .DATEM 000011 spd GTAD% 104000 000227 int Q1 000005 spd .DATMR 000013 spd GTJFN% 104000 000020 int Q2 000006 spd .DATMS 000015 spd HALTF% 104000 000170 int Q3 000007 spd .DATTD 000000 spd HPTIM% 104000 000501 int Q4 000010 spd .DATTL 000001 spd IOX33 602423 int Q5 000011 spd .DATTR 000003 spd JFNS% 104000 000030 int R 000000 ext .DATUS 000017 spd JS%DEV 700000 000000 sin RELD% 104000 000071 int .DVDCN 000022 sin JS%NAM 007000 000000 sin RESET% 104000 000147 int .DVDES 600000 sin JS%PAF 000001 sin RET 263740 000000 .DVNUL 000015 sin KFORK% 104000 000153 int RF%FRZ 400000 000000 sin .DVPIP 000403 sin LSTRX1 601405 int RF%SIC 777777 sin .DVPTY 000013 sin MAXLOD 206620 000000 RF%STS 377777 000000 sin .DVSRV 000023 sin MAXTIM 267460 RFACS% 104000 000161 int .DVTTY 000012 sin MINLOD 203400 000000 RFIELD 000000 ext .FHSLF 400000 sin MSIDAY 000511 456000 spd RFORK% 104000 000155 int .FP 000015 spd K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 19:42 30-Mar-24 Page S-2 K20TIM MAC 9-Dec-23 22:56 SYMBOL TABLE FOR PSECT CODE ADJTIM 003247' ent MILTOD 002753' $MILS 000015 000006 spd ..0633 001245' spd ASCDEV 000236' ext MS2HP 002260' $MINS 000015 000004 spd ..0641 001251' spd ASGDEV 001316' ext MYNAME 003552' ext $MINTI 000005 spd ..0642 001256' spd ASGFLG 001315' ext NDVCHR 001323' ext $SECS 000015 000005 spd ..0650 001256' spd ASIPTY 000261' ext NLBAUD 000215' ext %%JSER 002577' ext ..0656 001264' spd BINFLG 001321' ext NOIRTN 000145' ext %%SMSG 002537' ext ..0664 001271' spd BLDCNT 000604' NONE 001603' ext ...X 000002 spd ..0672 001276' spd BOUTI% 002746' ext NULEPI 001572' ..0034 000020' spd ..0673 001277' spd BROKEN 000040' OVRFLW 003014' ..0042 000040' spd ..0701 001306' spd CFMRTN 000174' ext PARBYT 000073' ..0103 000062' spd ..0707 001304' spd CHKINT 001766' ext PARCHK 001750' ..0104 000073' spd ..0710 001305' spd CHKLEG 001632' PARDCN 000060' ..0105 000101' spd ..0716 001326' spd CKDERR 001414' PARECL 000115' ..0121 000106' spd ..0724 001313' spd CKDTWR 001327' PARITY 001637' ext ..0125 000123' spd ..0725 001314' spd CLDAV 003221' PARMOD 000110' ..0162 000137' spd ..0741 001366' spd CMDER1 000173' ext PARNUL 000056' ..0172 000155' spd ..0751 001372' spd CMPRMN 001155' ext PARPIP 000054' ..0200 000174' spd ..0755 001375' spd COMPUT 000702' PARPTY 000052' ..0220 000311' spd ..0771 001413' spd CRLF 001745' ext PARS2 000246' ext ..0226 000314' spd ..0777 001411' spd DBLCAL 003071' ent PARS3 000556' ext ..0242 000337' spd ..1013 001445' spd DEVCOD 000662' int PARS4 001517' ext ..0253 000364' spd ..1041 001523' spd DEVHLT 000011 PARS5 000356' ext ..0254 000401' spd ..1042 001531' spd DEVINF 000005 PARSET 001601' ..0300 000454' spd ..1056 001577' spd DFLM1 003427' PARSWI 000062' ..0306 000457' spd ..1057 001600' spd DFLOAT 003301' ent PBYTE 770000 000000 spd ..0317 000472' spd ..1065 001607' spd DFLRET 003424' PIBAUD 000213' ext ..0325 000475' spd ..1066 001614' spd DNBAUD 000220' ext PIPJFN 000356' ..0341 000531' spd ..1074 001635' spd DNULBD 001506' int PTYFLG 001320' ext ..0347 000534' spd ..1075 001644' spd DPIPBD 000346' int PTYJFN 000260' ..0363 000561' spd ..1117 001745' spd DPTYBD 000250' int PTYNAM 003533' ext ..0371 000564' spd ..1134 002032' spd DSRVBD 000504' int PTYTTY 001317' ext ..0401 000616' spd ..1155 002060' spd DURTIM 002342' ent PUTC 001740' ext ..0414 000612' spd ..1156 002063' spd EHPTI1 002402' PVBAUD 000211' ext ..0415 000616' spd ..1157 002064' spd EHPTI2 002430' R 003151' ext ..0423 000617' spd ..1164 002071' spd EHPTI3 002442' RFIELD 000147' ext ..0424 000623' spd ..1165 002074' spd EHPTI4 002464' RFSTST 001475' ..0435 000633' spd ..1166 002102' spd EHPTI5 002513' RSKP 003445' ext ..0436 000637' spd ..1173 002102' spd EHPTIM 002370' ent SBYTE 007700 000000 spd ..0451 000706' spd ..1175 002120' spd ELAPST 003032' ent SINGDF 003121' ent ..0452 000713' spd ..1207 002107' spd ELPTIM 002133' ent SRVDCN 000514' ..0470 000766' spd ..1210 002111' spd ENDTIM 002050' ent STATIM 002033' ent ..0507 001011' spd ..1211 002117' spd EPICOM 001235' SYMOUT 001471' ext ..0510 001041' spd ..1212 002125' spd ETODHP 002302' TCOMMN 000715' ..0522 001047' spd ..1221 002166' spd EXPMSK 377000 000000 spd TIMWRK 002052' ..0537 001055' spd ..1222 002157' spd EXPSFT 003431' TODSEC 003020' ent ..0540 001101' spd ..1223 002160' spd FINTIM 002707' ent TTYNAM 003526' ext ..0545 001062' spd ..1224 002161' spd FRCLOS 001266' ext ZEROIT 002042' ..0546 001071' spd ..1231 002163' spd GENINT 001624' ext $COPY 000175' ..0552 001107' spd ..1237 002174' spd GLDAV 003210' $COPYD 000246' ..0574 001136' spd ..1240 002175' spd GTCLAS 003133' ent $COPYN 000233' ..0601 001161' spd ..1242 002236' spd INITIM 002541' ent $COPYS 000244' ..0606 001164' spd ..1243 002205' spd INITOD 002655' $DK10 000015 000007 spd ..0607 001202' spd ..1244 002206' spd LDAV 003201' ent $DUR 000015 000001 spd ..0617 001232' spd ..1245 002207' spd MAXHPT 002127' $HRS 000015 000003 spd ..0624 001257' spd ..1252 002211' spd MAXMIL 002131' $LSFLA 000015 000010 spd ..0632 001243' spd ..1254 002222' spd K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 19:42 30-Mar-24 Page S-3 K20TIM MAC 9-Dec-23 22:56 SYMBOL TABLE FOR PSECT CODE ..1255 002223' spd ..1573 002663' spd ..TRR 000010 spd ..1256 002224' spd ..1601 002663' spd ..TX1 377000 000000 spd ..1263 002227' spd ..1607 002722' spd ..TX2 000001 spd ..1264 002235' spd ..1614 002740' spd .COPY 000125' ..1271 002244' spd ..1615 002735' spd .RFMAX 000011 spd ..1272 002245' spd ..1622 002737' spd .SAV1 003252' ext ..1273 002256' spd ..1623 002733' spd .SAV2 000000 ext ..1301 002263' spd ..1630 002734' spd .SAV3 000000 ext ..1307 002263' spd ..1631 002761' spd .TIME 000000' int ..1316 002275' spd ..1637 002761' spd .XSTKS 003223' ext ..1323 002300' spd ..1645 003010' spd .XTRST 002370' ext ..1324 002301' spd ..1646 003011' spd ..1325 002306' spd ..1647 003012' spd ..1333 002306' spd ..1656 003060' spd ..1341 002333' spd ..1657 003064' spd ..1342 002334' spd ..1664 003057' spd ..1343 002335' spd ..1672 003064' spd ..1350 002337' spd ..1700 003142' spd ..1352 002354' spd ..1701 003146' spd ..1360 002354' spd ..1707 003170' spd ..1366 002356' spd ..1710 003174' spd ..1374 002367' spd ..1711 003175' spd ..1411 002430' spd ..1716 003215' spd ..1416 002441' spd ..1717 003220' spd ..1417 002442' spd ..1725 003237' spd ..1420 002446' spd ..1726 003243' spd ..1425 002451' spd ..1730 003252' spd ..1426 002464' spd ..1736 003261' spd ..1434 002456' spd ..1743 003263' spd ..1441 002462' spd ..1744 003271' spd ..1442 002467' spd ..1751 003272' spd ..1447 002470' spd ..1752 003304' spd ..1451 002501' spd ..1760 003304' spd ..1456 002513' spd ..1766 003311' spd ..1464 002507' spd ..1773 003314' spd ..1465 002513' spd ..1774 003347' spd ..1466 002540' spd ..2006 003327' spd ..1500 002526' spd ..2007 003346' spd ..1501 002530' spd ..2014 003324' spd ..1511 002536' spd ..2015 003325' spd ..1512 002540' spd ..2022 003342' spd ..1522 002545' spd ..2023 003346' spd ..1523 002560' spd ..2024 003402' spd ..1524 002567' spd ..2036 003363' spd ..1533 002573' spd ..2037 003401' spd ..1534 002603' spd ..2044 003357' spd ..1535 002611' spd ..2045 003361' spd ..1544 002611' spd ..2052 003376' spd ..1547 002625' spd ..2053 003401' spd ..1554 002632' spd ..2060 003412' spd ..1555 002634' spd ..IFT 000000 spd ..1556 002631' spd ..JX1 400000 000000 spd ..1570 002643' spd ..MX1 777777 777767 spd ..1571 002650' spd ..MX2 000001 spd ..1572 002654' spd ..NV 000011 spd K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 19:42 30-Mar-24 Page S-4 K20TIM MAC 9-Dec-23 22:56 SYMBOL TABLE FOR PSECT CONST BXPINC 000225' CLIPMX 000206' COPTAB 000102' CPFFDB 000117' CPTFDB 000125' DBLSCL 000211' int DCNFD1 000075' DCNFDB 000072' DEVSWI 000035' DKDAYD 000200' DWASHN 000304' DWBEXP 000237' LIONE 000176' MODKEY 000044' MS1000 000174' MSIDAD 000172' MSTIME 000170' NILFDB 000065' NULSWI 000033' PARFDB 000053' PIPFDB 000060' PIPSWI 000040' SLSHMK 000213' SRVACC 000137' SRVLEN 000140' TIMFDB 000023' TIMTAB 000000' TTICD2 000204' TTICDW 000202' ..XX 016004 000000 spd K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 19:42 30-Mar-24 Page S-5 K20TIM MAC 9-Dec-23 22:56 SYMBOL TABLE FOR PSECT TEXT DCNDAT 000163' DCNTSK 000155' PIP1ST 000140' SRVMSG 000151' SRVNAM 000145' $COPYM 000133' K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 19:42 30-Mar-24 Page S-6 K20TIM MAC 9-Dec-23 22:56 SYMBOL TABLE FOR PSECT DATA BOOTDD 000217' BOOTDT 000216' BOOTRM 000221' CHRCNT 000124' CHRPTR 000123' CLASS 000240' DBLCHR 000234' DBLTIC 000230' DCNAME 000032' DEVACS 000103' DEVPDL 000056' DEVSTG 000024 spd DFLCHR 000236' DFLTIC 000232' EHPTOD 000224' ETDAT 000147' EWALLT 000170' int GETABX 000253' IHPTOD 000225' KSAJUS 000255' LGETBE 000252' LSKEDE 000254' MHPTOD 000223' int PIP2ND 000024' PIPNAM 000000' PRGSDD 000212' PRGSDT 000211' SKDBLK 000242' SKDFLG 000241' SKEDX 000251' STDAT 000126' int SYSUMS 000214' TICKPT 000227' TIMDEV 000102' int TIMPAR 000125' TSKTIM 000031' WHOAMI 000030' int K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 19:42 30-Mar-24 Page S-7 K20TIM MAC 9-Dec-23 22:56 SYMBOL TABLE FOR PSECT DEVTIM DEVCHR 004000 spd DEVDA2 003000' DEVDAT 002000' DEVRED 001000' DEVWRD 001000 spd DEVWRT 000000' NULWRT 000000' sin k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 19:42 30-Mar-24 Page 1 K20SRV MAC 30-Mar-24 15:37 Preliminaries 34864 title k20srv - Kermit-20 High Level Server and Associated Local Commands 34865 34866 ; Much of the server code was moved from k20mit to this module as part 34867 ; of Edit 194 to address the issue of a very large single source file 34868 ; that unexpectedly began generating MCRNEC errors. 34869 ; 34870 ; Another goal was to make the server code more robust, easier to 34871 ; maintain and add new features. If an efficiency gain was obvious, 34872 ; then it was taken. 34873 ; 34874 ; One example of robustness was an attempt to combine the semanic 34875 ; action routines of the LOCAL commands with those of the REMOTE 34876 ; commands. This allowed for easier debugging with the understanding 34877 ; that, if something works as a LOCAL command, some amount of 34878 ; confidence could be assumed for at least that part would work as a 34879 ; server command. 34880 ; 34881 ; Thus, the supporting code for the LOCAL and remote commands is also 34882 ; here. One example would be the file deleting and directory code. 34883 34884 subttl Preliminaries 34885 34886 search monsym,macsym,cmd,k20unv ;[194] 34887 cmdacs ^ ;Clean up p1-p4 definitions 34888 34889 sall ; Tidy listing 34890 .directive flblst ; We don't need to see all the ASCIZ bytes... 34891 34892 remark common parsing external data 34893 extern pars1 ; Data from first parse. 34894 extern pars2 ; Data from second parse. 34895 extern pars3 ; Data from third parse. 34896 extern pars4 ; Data from fourth parse. 34897 extern pars5 ;[41] ... 34898 extern pars6 ;[218] 34899 34900 remark ; COMND% storage from CMD 34901 extern cjfnbk ; COMND% GTJFN block (long form) 34902 extern atmbuf ; The ubiquitous atom buffer 34903 extern atmbln ; Its length 34904 34905 remark ; Packet level storage and routines 34906 extern xflg ; Sending with X header (probably will be displayed) 34907 extern gotx ; Flag for "already got an X-packet". 34908 extern gots ; Flag for "already got an S-packet". 34909 extern sinit ; Sends an "S" or "I" (initialize parameters) 34910 extern iflg ; Sending an "I" packet 34911 extern spack ; Send a packet 34912 extern spsiz ; Maximimum size packet to send 34913 extern spar ; Get the arguments from a Send-Init packet. 34914 extern sptot ; Total of sent packets 34915 extern rpack ; Receive a packet 34916 extern rpsiz ; Maximimum size packet to receive 34917 extern $sends ; Entry point of $send for server 34918 extern rpar ; Set arguments we'd like honored k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 19:42 30-Mar-24 Page 1-1 K20SRV MAC 30-Mar-24 15:37 Preliminaries 34919 extern rptot ; Total of recieved packets 34920 extern rrinit ; Set up various variables for receiving 34921 extern $recvs ; Entry point of $recv for server 34922 extern $recvb ; Alternate entry point in $recv for server 34923 34924 extern nak ; Negative acknowledgde; bounce a packet 34925 extern nnak ; Number of NACK's sent 34926 extern pktnum ; Current packet number 34927 extern strbuf ; String buffer, used to decode data 34928 extern strptr ; Pointer into the above (also used by k20ioc) 34929 extern strbz ; Last address of combined string areas (used to zero) 34930 extern bctone ; Set if doing single character checksum 34931 extern maxdat ; Maximum length of data field 34932 extern pktacs ; Place to save RPACK/SPACK ACs. 34933 34934 remark ; Data flow routines that feed and drain packets 34935 extern source ; Routine that GETCH calls to get data 34936 extern dest ; Routine that PUTCH calls to put data 34937 remark ch ; Current character 34938 extern next ; Next character in stream 34939 34940 remark ; JFN related storage 34941 extern filjfn ; JFN of open file 34942 extern nxtjfn ; Next JFN in wildcarding 34943 extern ndxjfn ; Stepping JFN 34944 extern logjfn ; Log file JFN (if logging) 34945 extern netjfn ; Network or non-controlling TTY JFN 34946 extern ttyjfn ; JFN of local terminal (never the same as TTYJFN) 34947 34948 remark ; File related routines and storage 34949 extern decodf ; Decode a file name 34950 extern typfil ; Display a file's contents on the terminal 34951 extern typnam ; Type a file's name (special casing .nulio) 34952 extern whakfp ; Whack a mapped file page from our address space 34953 extern frclos ; Force a JFN to close 34954 extern isnulj ; Is this JFN some flavor of NUL:? 34955 extern putbuf ; Put a buffer full of data from a packet in a file 34956 extern getbuf ; Get a buffer full of data from a file for a packet 34957 extern datbuf ; Data field of the packet 34958 extern subbp ; 'subtract' two byte pointers 34959 extern filbuf ; Buffer to build a file listing entry in 34960 extern filbfz ; End of buffer marker (address) 34961 extern mxascz ; Crazy long length for moving strings 34962 extern movasc ; Routine to move ASCII bytes quickly (hopefully) 34963 34964 remark ; N.B., the next three must be in order! 34965 extern pagcnt ; .FBBYV, Number of pages in the file and byte size 34966 extern bytcnt ; .FBSIZ and byte count 34967 extern crdate ; .FBCRV and creation date (these 3 must be adjacent!) 34968 34969 remark ; Various interrupt routines and storage 34970 extern ccon ; Enable Control-C handling 34971 extern ccoff ; Shut Control-C handling off 34972 extern caxzof ; Turn file processing interrupts off 34973 extern timeit ; Begin timing an activity k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 19:42 30-Mar-24 Page 1-2 K20SRV MAC 30-Mar-24 15:37 Preliminaries 34974 extern timoff ; Shut off an asynchronous timer 34975 extern clrcno ; Clear Control-O 34976 extern czseen ; Control-Z seen 34977 34978 remark ; Variables for local/non-local communications 34979 extern ptyflg ; Set if the 'network' is a pseudo-terminal 34980 extern ptytty ; Mapping from PTY number to TTY number 34981 extern ttynum ; Number of controlling terminal 34982 extern speed ; Speed of physical line (if we have one) 34983 extern carier ; Carrier signal if dial up, otherwise, connection status 34984 extern mdmlin ; Set if modem-controlled line (I.E., dialup) 34985 34986 remark ; Low level communications routines and variables 34987 extern inilin ; Initialize the line 34988 extern rrslin ; Reset/Restore the communications line. 34989 extern rrsl2 ; Really reset (don't allow ^C) 34990 extern ttxon ; ^Q a line, if flow control 34991 extern statim ; Start timing (a generic command) 34992 extern delay ; Time to wait in milliseconds before first send 34993 extern odelay ; What it used to be (for saving and restoring) 34994 extern ntimou ; Number of timeouts 34995 extern stimou ; Send timeout interval 34996 extern otimou ; Its previous value, if overriden by transfer 34997 extern numtry ; Number of times we'vre tried sending this packet 34998 extern maxtry ; Maximum number of times to try 34999 extern seolch ; Remote host's End of Line character 35000 35001 remark ; Low level Top-20 monitor buffer management 35002 extern clrbuf ; Clear all characters in Tops-20 buffers 35003 extern clread ; As clrbuf, but lets us see what was in there 35004 35005 remark ; Low level I/O counters 35006 extern vchrcn ;[211] Virtual characters cleared 35007 extern nsici ;[211] Network SIN% count (SIN%'s issued) 35008 extern nsitc ;[211] Network SIN% total characters 35009 extern nsimx ;[211] Network SIN% maximum length 35010 35011 remark ; Server specific routines storage 35012 extern srvflg ; If running as a server 35013 extern local ; Set if we are not remote 35014 extern srvtim ; Server command time out 35015 35016 remark ;[189] Timing routines in K20TIM 35017 extern statim ;[189] Start timing an interval 35018 extern endtim ;[189] Stop timing an interval 35019 extern elptim ;[189] Compute elapsed HPTIM% ticks 35020 35021 remark ; Error and string macro support 35022 extern errptr ; Pointer to error text 35023 extern %%jser ; Handler for %jsErr macro 35024 extern %%krms ; Same as above, but sends to remote Kermit, too 35025 extern %%smsg ; Used to get text from non-zero section 35026 extern %kerms ; Addition messages when in protocol 35027 extern %wtlog ; Write to transaction log 35028 extern scrlft ;[233] Set to -1 to suppress trailing crlf k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 19:42 30-Mar-24 Page 1-3 K20SRV MAC 30-Mar-24 15:37 Preliminaries 35029 extern tlgjfn ;[233] Transaction log JFN 35030 extern setlog ; Open debugging log 35031 35032 remark ; Other external variables of interest 35033 extern jobtab ;[220] Our job's GETJI% 35034 extern expung ; Set if expunging files on delete 35035 extern crlf ; Carriage Return/Line Feed 35036 extern mycaps ; Capability vector double word 35037 extern capas ; Enabled process capabilities 35038 extern f$exit ; The exit flag which tells main loop to stop 35039 extern allfld ;[252] ; Punctuated all fields for JFNS% 35040 35041 .psect code/ronly ; Pure code, pure Heaven 35042 k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 19:42 30-Mar-24 Page 2 K20SRV MAC 30-Mar-24 15:37 Parse tables, used as a kind of table of contents 35043 subttl Parse tables, used as a kind of table of contents 35044 35045 ;N.B., When parsing for .cmtxt and .cmcfm, .cmcfm must come first!!!! 35046 35047 remark Parse table for LOCAL commands 35048 35049 000000'02 000000 000000 %table(loctab,G) ;[220] Used as a kind of table of contents 35050 000001'02 000000# 000004' %keyf3 , %cwd, 35051 000000'03 002000 000005 35052 000001'03 143 000 000 000 000 35053 000002'02 000000# 000000# %keyf4 , .ycwd, $ycwd, cm%inv 35054 000002'03 002000 000001 35055 000003'03 143 144 000 000 000 35056 000004'03 000000# 000000# 35057 000003'02 000000# 000000# %key3 , .ycdup, $ycdup ;[254] 35058 000005'03 143 144 165 160 000 35059 000006'03 000000# 000000# 35060 000004'02 000000# 000000# %cwd: %key3 , .ycwd, $ycwd 35061 000007'03 143 167 144 000 000 35062 000010'03 000000# 000000# 35063 000005'02 000000# 000000# %key3 , .ydele, $ydele 35064 000011'03 144 145 154 145 164 35065 000013'03 000000# 000000# 35066 000006'02 000000# 000000# %key3 , .ydire, $ydire 35067 000014'03 144 151 162 145 143 35068 000016'03 000000# 000000# 35069 000007'02 000000# 000000# %key3 , .ypwd, $ypwd ;[188] ;[194] 35070 000017'03 160 167 144 000 000 35071 000020'03 000000# 000000# 35072 000010'02 000000# 000000# %key3 , .yrun, $yrun 35073 000021'03 162 165 156 000 000 35074 000022'03 000000# 000000# 35075 000011'02 000000# 000000# %key3 , .ydisk, $ydisk ;[194] 35076 000023'03 163 160 141 143 145 35077 000025'03 000000# 000000# 35078 000012'02 000000# 000016' %keyf3 , %lst, 35079 000026'03 002000 000005 35080 000027'03 163 164 000 000 000 35081 000013'02 000000# 000016' %keyf3 , %lst, 35082 000030'03 002000 000005 35083 000031'03 163 164 141 000 000 35084 000014'02 000000# 000016' %keyf3 , %lst, 35085 000032'03 002000 000005 35086 000033'03 163 164 141 164 000 35087 000015'02 000000# 000000# %keyf4 , .stat, $ysrvt, cm%inv 35088 000034'03 002000 000001 35089 000035'03 163 164 141 164 151 35090 000040'03 000000# 000000# 35091 000016'02 000000# 000000# %lst: %key3 , .stat, $ysrvt ;[189] ;[194] 35092 000041'03 163 164 141 164 165 35093 000043'03 000000# 000000# 35094 000017'02 000000# 000000# %key3 , .ytype, $ytype 35095 000044'03 164 171 160 145 000 35096 000045'03 000000# 000000# 35097 000000'02 000017 000017 %tbend k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 19:42 30-Mar-24 Page 2-1 K20SRV MAC 30-Mar-24 15:37 Parse tables, used as a kind of table of contents 35098 35099 cleans(<%cwd,%lst>) 35100 35101 remark Parse table for REMOTE commands 35102 35103 000020'02 000000 000000 %table(remtab,G) ;[220] Moved here as a kind of table of contents 35104 000021'02 000000# 000000# %keyf4 , .bye, $bye, cm%inv ;[186] Tom can't remember.. 35105 000046'03 002000 000001 35106 000047'03 142 171 145 000 000 35107 000050'03 000000# 000000# 35108 000022'02 000000# 000000# %key3 , .xcdup, $xcdup ;[254] 35109 000051'03 143 144 165 160 000 35110 000052'03 000000# 000000# 35111 000023'02 000000# 000000# %key3 , .xcwd, $xcwd ;[194] 35112 000053'03 143 167 144 000 000 35113 000054'03 000000# 000000# 35114 000024'02 000000# 000000# %key3 , .rmfil, $xdele ;[194] 35115 000055'03 144 145 154 145 164 35116 000057'03 000000# 000000# 35117 000025'02 000000# 000000# %key3 , .rmfil, $xdire ;[194] 35118 000060'03 144 151 162 145 143 35119 000062'03 000000# 000000# 35120 000026'02 000000# 000000# %keyf4 , .xerr, $xerr, cm%inv ;[194] 35121 000063'03 002000 000001 35122 000064'03 145 162 162 157 162 35123 000066'03 000000# 000000# 35124 000027'02 000000# 000000# %keyf4 , .finis, $finis, cm%inv ;[186] Tom can't remember.. 35125 000067'03 002000 000001 35126 000070'03 146 151 156 151 163 35127 000072'03 000000# 000000# 35128 000030'02 000000# 000000# %key3 , .xhelp, $xhelp ;[120] ;[194] 35129 000073'03 150 145 154 160 000 35130 000074'03 000000# 000000# 35131 000031'02 000000# 000000# %key3 , .xhost, $xhost ;[105] 35132 000075'03 150 157 163 164 000 35133 000076'03 000000# 000000# 35134 000032'02 000000# 000000# %key3 , .xpwd, $xpwd ;[188] ;[194] 35135 000077'03 160 167 144 000 000 35136 000100'03 000000# 000000# 35137 ;;;* %key3 , .???, $??? 35138 000033'02 000000# 000000# %key3 , .xdisk, $xdisk ;[194] 35139 000101'03 163 160 141 143 145 35140 000103'03 000000# 000000# 35141 000034'02 000000# 000040' %keyf3 , %rst, 35142 000104'03 002000 000005 35143 000105'03 163 164 000 000 000 35144 000035'02 000000# 000040' %keyf3 , %rst, 35145 000106'03 002000 000005 35146 000107'03 163 164 141 000 000 35147 000036'02 000000# 000040' %keyf3 , %rst, 35148 000110'03 002000 000005 35149 000111'03 163 164 141 164 000 35150 000037'02 000000# 000000# %keyf4 , .xstat, $xstat, cm%inv 35151 000112'03 002000 000001 35152 000113'03 163 164 141 164 151 k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 19:42 30-Mar-24 Page 2-2 K20SRV MAC 30-Mar-24 15:37 Parse tables, used as a kind of table of contents 35153 000116'03 000000# 000000# 35154 000040'02 000000# 000000# %rst: %key3 , .xstat, $xstat ;[189] ;[194] 35155 000117'03 163 164 141 164 165 35156 000121'03 000000# 000000# 35157 000041'02 000000# 000000# %key3 , .rmfil, $xtype 35158 000122'03 164 171 160 145 000 35159 000123'03 000000# 000000# 35160 000020'02 000021 000021 %tbend 35161 35162 cleans(<%rst>) 35163 k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 19:42 30-Mar-24 Page 3 K20SRV MAC 30-Mar-24 15:37 BYE command 35164 subttl BYE command 35165 35166 remark Parse the BYE command. 35167 35168 000000'01 .bye: entry .bye ; Can be invoked as top-level by k20par 35169 000000'01 200 16 0 00 000000# guide (to remote server) ; Parse rest of BYE command. 35170 000001'01 260 17 0 00 000000* 35171 000042'02 000000000000# 35172 000000'04 164 157 040 162 145 35173 000002'01 260 17 0 00 000000* confrm 35174 000003'01 263 17 0 00 000000 ret 35175 35176 remark Execute the BYE command. 35177 35178 ; N.B., Uses clread to drain the terminal buffer. However, we are 35179 ; SOUT%'ing raw eight bit data, no parity. Maybe this should be 35180 ; fixed? However, the previous code didn't do parity, either 35181 ; Maybe controlify? 35182 35183 000004'01 $bye: entry $bye ; Can be invoked as top-level by k20par 35184 000004'01 265 16 0 00 006254' saveac ;[211] Needs some additional storage 35185 000005'01 260 17 0 00 000000* call statim ;[189] Start timing so k20pdc doesn't choke 35186 dmove t1, [ ;[220] 35187 point 7, [asciz/L/] ; An "L" for the data field. 35188 000006'01 120 01 0 00 006263' "G" ] ; Packet type is G. 35189 000007'01 260 17 0 00 005134' call srvcmd ;[121] Send the command. 35190 000010'01 254 00 0 00 000050' jrst $byez ; Some error, don't exit. 35191 35192 ;[16] From here to end is part of edit 16. 35193 35194 000011'01 201 05 0 00 000005 movei q1, ^d5 ;[211] ; Waiting a total of 1.25 seconds 35195 000012'01 201 01 0 00 001750 movei t1, ^d1000 ;[211] ; Wait a second right now 35196 000013'01 104 00 0 00 000167 DISMS% 35197 35198 000014'01 do. ;[211] Enter loop context 35199 000014'01 260 17 0 00 000000* call clread ;[211] Get and clear data 35200 000015'01 254 00 0 00 000040' exit. ;[211] Unless there was an error 35201 000016'01 323 01 0 00 000034' ifg. t1 ;[211] Any goodies? 35202 000017'01 350 00 0 00 000000* aos nsici ;[211] Network SIN%'s Issued 35203 000020'01 210 03 0 00 000001 movn t3, t1 ;[211] Set up for counted SOUT% 35204 000021'01 272 03 0 00 000000* addm t3, vchrcn ;[211] Subtract from cleared 35205 000022'01 272 01 0 00 000000* addm t1, nsitc ;[211] And give them to Network SIN% 35206 000023'01 313 01 0 00 000000* camle t1, nsimx ;[211] Smaller than largest? 35207 000024'01 202 01 0 00 000023* movem t1, nsimx ;[211] Nope, have a new largest! 35208 000025'01 201 01 0 00 000101 movei t1, .priou ;[211] This terminal 35209 remark t2, ;[211] Raw 8 bit pointer! 35210 000026'01 104 00 0 00 000053 SOUT% ;[211] Type it 35211 000027'01 320 12 0 00 000031' %jserr (,) ;[211] ?? 35212 000030'01 254 00 0 00 000034' 35213 000031'01 265 01 0 00 000000* 35214 000032'01 000000 000000 35215 000033'01 254 00 0 00 000034' 35216 000034'01 endif. ;[211] End case got some data 35217 000034'01 363 05 0 00 000040' sojle q1, endlp. ;[211] Stop looking if done waiting 35218 000035'01 201 01 0 00 000372 movei t1, ^d250 ; Sleep a little bit k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 19:42 30-Mar-24 Page 3-1 K20SRV MAC 30-Mar-24 15:37 BYE command 35219 000036'01 104 00 0 00 000167 DISMS% 35220 000037'01 254 00 0 00 000014' loop. ;[211] Try again 35221 000040'01 enddo. ;[211] Exit loop lexical context 35222 35223 txmsg < 35224 000040'01 200 01 0 00 000000# ...> ; Maybe there's more, but... 35225 000041'01 104 00 0 00 000076 35226 000042'01 320 12 0 00 000043' 35227 000043'02 000000000000# 35228 000004'04 015 012 056 056 056 35229 000043'01 260 17 0 00 000000* call clrbuf ;[194] can't wait forever for it, 35230 000044'01 600 00 0 00 000000 nop ;[186] ; throw the rest away. 35231 000045'01 476 00 0 00 000000* setom f$exit ;[38] Set exit flag. 35232 000046'01 260 17 0 00 000000* call endtim ;[189] Stop timing 35233 000047'01 260 17 0 00 000000* call elptim ;[189] Compute elapsed time 35234 35235 ; Error exit 35236 35237 000050'01 402 00 0 00 000045* $byez: setzm f$exit ;[70] Don't exit. 35238 000051'01 263 17 0 00 000000 ret ;[70] 35239 35240 k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 19:42 30-Mar-24 Page 4 K20SRV MAC 30-Mar-24 15:37 CWD command 35241 subttl CWD command 35242 35243 remark [137] LOCAL CWD command parsing. 35244 35245 ; Changed to only parse for a password if it is determined that we 35246 ; can't connect without one. Trying the ACESS% more than once can get 35247 ; the ACJ or monitor delay code involved. 35248 ; 35249 ; N.B., The following COMND% oddity. If you are parsing for .cmdir 35250 ; and .cmdev (as is done below) and if you are connected to one 35251 ; structure and you type only the device name of another structure 35252 ; with the same named directory, then COMND% will actually parse a 35253 ; .cmdir of that directory on the other structure! 35254 35255 define token (c) < ;;[255] Define token 35256 ;;[255] All these literals, yuck... 35257 >;;token ;;[255] 35258 35259 chgsec(code,const) ;;Chained FDB's are not in code, they're in const 35260 000044'02 011004 000047' ycwfdb: flddb. .cmdir,,,,,ycwfd1 35261 000045'02 000000 000000 35262 000046'02 44 07 0 00 000370' 35263 000047'02 016004 000052' ycwfd1: flddb. .cmdev,,,,,ycwfd2 35264 000050'02 000000 000000 35265 000051'02 44 07 0 00 000377' 35266 000052'02 023004 000055' ycwfd2: flddb. .cmtok,,token(<..>),,,ycwfd3 35267 000053'02 440700 000407' 35268 000054'02 44 07 0 00 000410' 35269 000055'02 010004 000000 ycwfd3: flddb. .cmcfm,,,,, ;[220] 35270 000056'02 000000 000000 35271 000057'02 44 07 0 00 000417' 35272 35273 000060'02 010004 000063' ypwfdb: flddb. .cmcfm,,,,,ypwfd1 35274 000061'02 000000 000000 35275 000062'02 44 07 0 00 000427' 35276 000063'02 021004 000066' ypwfd1: flddb. .cmqst,,,,,ypwfd2 35277 000064'02 000000 000000 35278 000065'02 44 07 0 00 000436' 35279 000066'02 017004 000000 ypwfd2: flddb. .cmtxt,,,,, ;[220] 35280 000067'02 000000 000000 35281 000070'02 44 07 0 00 000436' 35282 retsec ;;Get back to wherever we came from 35283 cleans() 35284 35285 000052'01 .ycwd: entry .ycwd ; Invoked from k20par 35286 000052'01 265 16 0 00 006265' saveac ; Save some accumulators for interim parse results 35287 35288 000053'01 200 16 0 00 000000# guide ; Issue guide words. 35289 000054'01 260 17 0 00 000001* 35290 000071'02 000000000000# 35291 000006'04 164 157 040 144 151 35292 000055'01 201 01 0 00 000000# movei t1, ycwfdb ;[220] 35293 000056'01 260 17 0 00 000000* call rfield ; Parse a directory specification. 35294 000057'01 135 03 0 00 006275' ldb t3, [pointr (.cmfnp(t3),cm%fnc)] ; Get function code. 35295 000060'01 120 06 0 00 000002 dmove q2, t2 ;[220] Save these for downstream parsing k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 19:42 30-Mar-24 Page 4-1 K20SRV MAC 30-Mar-24 15:37 CWD command 35296 35297 000061'01 302 07 0 00 000010 caie q3, .cmcfm ; Confirmation? 35298 000062'01 254 00 0 00 000070' ifskp. ; Yes, then use our own logged-in directory 35299 000063'01 200 02 0 00 000000# move t2, .jilno+jobtab ; number, which always works without a password 35300 000064'01 201 03 0 00 000011 movei t3, .cmdir ;[220] Lie and say we parsed a directory 35301 000065'01 124 02 0 00 000000* dmovem t2, pars3 ;[220] Pass to semantic action 35302 000066'01 402 00 0 00 000000* setzm pars5 ;[220] No password string being passed 35303 000067'01 263 17 0 00 000000 ret ; We're done 35304 000070'01 endif. 35305 35306 000070'01 302 07 0 00 000023 caie q3, .cmtok ;[255] Hokey CDUP talisman? 35307 000071'01 254 00 0 00 000101' ifskp. ;[255] Yes, transmogrify into a cdup 35308 000072'01 201 03 0 00 000000# movei t3, cdhack ;[255] Used to tweak different parse stream 35309 000073'01 200 02 0 00 000000* move t2, pars1 ;[255] Load first level parse block address 35310 000074'01 200 01 0 02 000000 move t1, (t2) ;[255] Load the syntax and semantic 35311 000075'01 541 01 0 00 001111' hrri t1, $ycdup ;[255] Override semantic action 35312 000076'01 202 01 0 03 000000 movem t1, (t3) ;[255] Store as a seperate parse block 35313 000077'01 202 03 0 00 000073* movem t3, pars1 ;[255] Override original parse block 35314 000100'01 254 00 0 00 001066' jrst .ycdp1 ;[255] And switch parsing over to cdup 35315 000101'01 endif. ;[255] End case ".." hack 35316 35317 000101'01 302 07 0 00 000016 caie q3, .cmdev ;[220] Parsed a device?? 35318 000102'01 254 00 0 00 000114' ifskp. ;[193] Yes (can't connect to DECtape) 35319 000103'01 200 01 0 00 000006 move t1, q2 ;[220] Let's check it 35320 000104'01 260 17 0 00 000000* call isnulj ;[193] Is it NUL:? 35321 000105'01 254 00 0 00 000114' anskp. ;[193] It isn't, must be some other odd thing 35322 000106'01 200 06 0 00 000001 move q2, t1 ;[220] It is, so remember that 35323 000107'01 260 17 0 00 000002* confrm ;[220] Confirm the line, do not allow .cmqst 35324 000110'01 124 06 0 00 000065* dmovem q2, pars3 ;[220] Pass both to semantic action 35325 000111'01 402 00 0 00 000066* setzm pars5 ;[220] No password string being passed 35326 000112'01 263 17 0 00 000000 ret ;[220] Done, skipping the .cmqst 35327 000113'01 254 00 0 00 000147' else. ;[220] Here if some other device 35328 000114'01 302 07 0 00 000016 caie q3, .cmdev ;[220] Are we here because of phonkey .cmdev? 35329 000115'01 254 00 0 00 000147' anskp. ;[220] No, it's a .cmdir, so that's fine 35330 000116'01 200 01 0 00 000006 move t1, q2 ;[220] Let's see if it can do files 35331 000117'01 260 17 0 00 005474' call isdird ;[220] See if this is a directory device 35332 000120'01 254 00 0 00 000125' ifskp. ;[220] It is, see what kind 35333 000121'01 135 03 0 00 006276' ldb t3,[pointr(t2,dv%typ)] ;[220] Load type 35334 000122'01 302 03 0 00 000000 caie t3, .dvdsk ;[220] Structure? 35335 000123'01 254 00 0 00 000125' anskp. ;[220] Can't connect to DECtape... 35336 000124'01 254 00 0 00 000144' else. ;[220] Not a disk based directory structure 35337 000125'01 200 01 0 00 000000# sxtext(t1,) ;[220] Initial part of error message 35338 000072'02 000000000000# 35339 000011'04 115 141 171 040 156 35340 000126'01 104 00 0 00 000313 ESOUT% ;[220] Begin whining 35341 000127'01 403 03 0 00 000004 setzb t3, t4 ;[220] Clear up some storage 35342 000130'01 561 01 0 00 000003 hrroi t1, t3 ;[220] Writing device name into registers 35343 000131'01 200 02 0 00 000006 move t2, q2 ;[220] Load device 35344 000132'01 104 00 0 00 000121 DEVST% ;[220] Write it 35345 000133'01 320 12 0 00 000135' ifje. r ;[220] Failed?? We just parsed it! 35346 000134'01 254 00 0 00 000137' 35347 000135'01 120 03 0 00 006277' dmove t3, [asciz /(error)/] ;[220] Stomp in something 35348 000136'01 254 00 0 00 000141' else. ;[220] Otherwise, worked 35349 000137'01 201 02 0 00 000072 movei t2, ":" ;[220] Load terminating device punctuation 35350 000140'01 136 02 0 00 000001 idpb t2, t1 ;[220] Take on the end, rest of word is .chnul's k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 19:42 30-Mar-24 Page 4-2 K20SRV MAC 30-Mar-24 15:37 CWD command 35351 000141'01 endif. ;[220] End case DEVST% handling 35352 000141'01 561 01 0 00 000003 hrroi t1, t3 ;[220] Point to t3 again 35353 000142'01 104 00 0 00 000076 PSOUT% ;[220] Blat that out, too 35354 000143'01 254 00 0 00 000000* callret cmder1 ;[220] Allow a reparse, however 35355 000144'01 endif. ;[220] End case acceptable directory analysis 35356 000144'01 260 17 0 00 000174' call defdir ;[220] Try to default the directory on the structure 35357 000145'01 254 00 0 00 000143* callret cmder1 ;[220] Couldn't... Allow reparse 35358 000146'01 201 07 0 00 000011 movei q3, .cmdir ;[220] Pretend they typed the directory 35359 000147'01 endif. ;[193] End case parsed a device 35360 35361 remark .cmdir ;[220] At this point, we know the directory exists 35362 000147'01 200 01 0 00 000006 move t1, q2 ;[220] Load the directory in question 35363 000150'01 260 17 0 00 000653' call pwconp ;[220] Do we need a password to get to this? 35364 000151'01 254 00 0 00 000156' ifskp. ;[220] No, so do not parse for a quoted string 35365 000152'01 260 17 0 00 000107* confrm ;[220] Just confirm the command 35366 000153'01 124 06 0 00 000110* dmovem q2, pars3 ;[220] Pass directory and parse type to semantic action 35367 000154'01 402 00 0 00 000111* setzm pars5 ;[220] No password string being passed 35368 000155'01 263 17 0 00 000000 ret ;[220] And we're done 35369 000156'01 endif. ;[220] 35370 35371 remark ;[220] May need a password, so allow a parse for that 35372 000156'01 201 01 0 00 000000# movei t1, ypwfdb ;[220] Allow a password on the same line 35373 000157'01 260 17 0 00 000056* call rfield ;[220] See if they want the password right now 35374 000160'01 135 03 0 00 006275' ldb t3, [pointr (.cmfnp(t3),cm%fnc)] ; Get function code. 35375 35376 000161'01 302 03 0 00 000010 caie t3, .cmcfm ;[220] Didn't specify anything? 35377 000162'01 254 00 0 00 000166' ifskp. ;[220] Nope, so we're done with the parse 35378 000163'01 124 06 0 00 000153* dmovem q2, pars3 ;[220] Pass directory and parse type to semantic action 35379 000164'01 402 00 0 00 000154* setzm pars5 ;[220] No password string being passed 35380 000165'01 263 17 0 00 000000 ret ;[220] And get out of here 35381 000166'01 endif. ;[220] End case no string parsed 35382 35383 000166'01 260 17 0 00 000152* confrm ; Get confirmation. 35384 000167'01 124 06 0 00 000163* dmovem q2, pars3 ;[220] Pass directory and parse type to semantic action 35385 000170'01 201 01 0 00 000000* movei t1, atmbuf ;[220] Load address of the atom buffer 35386 000171'01 505 01 0 00 440700 hrli t1, () ;[220] Turn into a local pointer 35387 000172'01 202 01 0 00 000164* movem t1, pars5 ;[220] Flag that we are passing in a password 35388 000173'01 263 17 0 00 000000 ret 35389 k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 19:42 30-Mar-24 Page 5 K20SRV MAC 30-Mar-24 15:37 Vestigial Echoing code 35390 subttl Vestigial Echoing code 35391 35392 comment " ;[220] Removed because it got too hairy on a reparse 35393 ifmn. takdep ;[220] Are we in a take file? 35394 setz q5, ;[220] We are, flag that 35395 else. ;[220] Aren't; so monkey with terminal mode 35396 seto q5, ;[220] Let's assume not in a take file 35397 remark cm%wkf ;[220] Maybe tweak this? 35398 endif. 35399 35400 remark ... 35401 35402 ifn. q5 ;[220] Not in a take file? 35403 skipg t1, ttyjfn ;[220] This terminal 35404 anskp. ;[220] We don't have one, don't do this 35405 RFMOD% ;[220] Pull its mode word 35406 annje. ;[220] Punt the rest if this fails 35407 txz t2, tt%osp ;[220] Clear control-O so prompt comes out 35408 move q5, t2 ;[220] And save it 35409 txz t2, tt%eco ;[220] Turn off echoing. 35410 SFMOD% ;[220] Try doing it ... 35411 annje. ;[220] Punt the rest if this fails 35412 remark ;[220] At this point, echo is off 35413 else. ;[220] Otherwise, q5 is zero or should be 35414 setz q5, ;[220] If here because of error, disallow 35415 endif. ;[220] 35416 35417 remark ... 35418 35419 ifn. q5 ;[220] Hacking terminal modes? 35420 push p, t1 ;[220] Save temporaries around SFMOD% 35421 push p, t2 ;[220] it wants t1 and t2 35422 move t1, ttyjfn ;[220] Load terminal JFN 35423 move t2, q5 ;[220] and whatever we saved 35424 SFMOD% ;[220] Restore TTY to normal echoing. 35425 %jserr (,) ;[220] Carry on 35426 pop p, t2 ;[220] Restore temporaries SFMOD% used 35427 pop p, t1 ;[220] it wanted t1 and t2 35428 endif. ;[220] End case mode detweak 35429 35430 ";;comment k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 19:42 30-Mar-24 Page 6 K20SRV MAC 30-Mar-24 15:37 Default a directory on a structure 35431 subttl Default a directory on a structure 35432 35433 ;[220] Begin code insertion 35434 35435 ; Largely unnecessary, as Tops-20 will do this for domestic structures. 35436 35437 000174'01 265 16 0 00 006301' defdir: saveac ; Needs two index registers 35438 000175'01 265 16 0 00 000000* anstkv (q3,dirmxw) ; Place to build the default directory 35439 000176'01 000000 000012 35440 000177'01 415 07 0 17 777765 35441 000200'01 265 16 0 00 000175* anstkv (q4,dirmxw) ; Place to put currently connected directory 35442 000201'01 000000 000012 35443 000202'01 415 10 0 17 777765 35444 35445 000203'01 201 01 0 00 000011 movx t1, ; Length of area in words 35446 000204'01 200 02 0 00 000007 move t2, q3 ; First address in area 35447 000205'01 201 03 0 02 000001 movei t3, 1(t2) ; Doing a cascade xblt 35448 000206'01 402 00 0 02 000000 setzm (t2) ; Zero first word 35449 000207'01 123 01 0 00 006313' xblt. t1 ; Clear the rest of the area 35450 35451 000210'01 560 01 0 00 000007 hrro t1, q3 ; Build Tops-20 pointer to area 35452 000211'01 200 02 0 00 000006 move t2, q2 ; Load device 35453 000212'01 104 00 0 00 000121 DEVST% ; Construct first part of defaulted directory 35454 000213'01 320 12 0 00 000215' %jserr (,r) 35455 000214'01 254 00 0 00 000220' 35456 000215'01 265 01 0 00 000031* 35457 000216'01 000000000000# 35458 000217'01 254 00 0 00 000000* 35459 000015'04 125 156 141 142 154 35460 000220'01 200 11 0 00 000001 move q5, t1 ; Save the final pointer for appending 35461 35462 000221'01 201 01 0 00 000011 movx t1, ; Length of area in words 35463 000222'01 200 02 0 00 000010 move t2, q4 ; First address in area 35464 000223'01 201 03 0 02 000001 movei t3, 1(t2) ; Doing a cascade xblt 35465 000224'01 402 00 0 02 000000 setzm (t2) ; Zero first word 35466 000225'01 123 01 0 00 006313' xblt. t1 ; Clear the rest of the area 35467 35468 000226'01 560 01 0 00 000010 hrro t1, q4 ; Build Tops-20 pointer to area 35469 000227'01 200 02 0 00 000000# move t2, .jidno+jobtab ; Load currently connected directory 35470 000230'01 104 00 0 00 000041 DIRST% ; Render as a string 35471 000231'01 320 12 0 00 000233' %jserr (,r) 35472 000232'01 254 00 0 00 000236' 35473 000233'01 265 01 0 00 000215* 35474 000234'01 000000000000# 35475 000235'01 254 00 0 00 000217* 35476 000027'04 125 156 141 142 154 35477 35478 000236'01 200 02 0 00 000010 move t2, q4 ; Load address of connected directory string 35479 000237'01 505 02 0 00 440700 hrli t2, () ; Turn into a local pointer 35480 35481 000240'01 do. ; Enter loop context to find end of device 35482 000240'01 134 03 0 00 000002 ildb t3, t2 ; Pick up a byte 35483 000241'01 306 03 0 00 000072 cain t3, ":" ; Hit the colon? 35484 000242'01 254 00 0 00 000252' exit. ; We did, break out of the loop 35485 000243'01 326 03 0 00 000251' ife. t3 ; Sanity check k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 19:42 30-Mar-24 Page 6-1 K20SRV MAC 30-Mar-24 15:37 Default a directory on a structure 35486 000244'01 334 01 0 00 000000# ermsg% (,r) 35487 000245'01 254 00 0 00 000251' 35488 000246'01 202 01 0 00 000000* 35489 000247'01 104 00 0 00 000313 35490 000250'01 254 00 0 00 000235* 35491 000073'02 000000000000# 35492 000041'04 113 105 122 115 111 35493 35494 000251'01 endif. ; End check 35495 000251'01 254 00 0 00 000240' loop. ; Try next character 35496 000252'01 enddo. ; End loop lexical context 35497 35498 000252'01 200 01 0 00 000011 move t1, q5 ; Load end of device 35499 35500 000253'01 do. ; Enter loop context to copy over the directory 35501 000253'01 136 03 0 00 000001 idpb t3, t1 ; Deposit into new device string 35502 000254'01 306 03 0 00 000076 cain t3, .chrpt ; Hit the right pointy bracket? 35503 000255'01 254 00 0 00 000260' exit. ; We did, so we're done 35504 000256'01 134 03 0 00 000002 ildb t3, t2 ; Pick next byte of source connected directory 35505 000257'01 254 00 0 00 000253' loop. ; Deposit it and get next byte 35506 000260'01 enddo. ; End loop lexical context 35507 35508 000260'01 400 03 0 00 000000 setz t3, ; Cons up a .chnul 35509 000261'01 136 03 0 00 000001 idpb t3, t1 ; Tie off the proposed default directory 35510 ; Now see if it exists.. 35511 000262'01 205 01 0 00 000001 movx t1, rc%emo ; Therefore, exact-match, only 35512 000263'01 560 02 0 00 000007 hrro t2, q3 ; Build Tops-20 pointer to candidate 35513 000264'01 400 03 0 00 000000 setz t3, ; Not doing any stepping, but... 35514 000265'01 104 00 0 00 000553 RCDIR% ; See if it exists 35515 000266'01 320 12 0 00 000270' %jserr (,r) 35516 000267'01 254 00 0 00 000273' 35517 000270'01 265 01 0 00 000233* 35518 000271'01 000000000000# 35519 000272'01 254 00 0 00 000250* 35520 000053'04 106 141 151 154 165 35521 000273'01 607 01 0 00 040000 ifxn. t1, rc%nom ; Doesn't exist? We surely can't connect... 35522 000274'01 254 00 0 00 000303' 35523 000275'01 560 01 0 00 000007 hrro t1, q3 ; Load pointer to our created directory 35524 000276'01 104 00 0 00 000313 ESOUT% ; Begin complaining 35525 000277'01 200 01 0 00 000000# txmsg (< does not exist, so can't be used as a default>) 35526 000300'01 104 00 0 00 000076 35527 000301'01 320 12 0 00 000302' 35528 000074'02 000000000000# 35529 000064'04 040 144 157 145 163 35530 000302'01 263 17 0 00 000000 ret ; Return +1 35531 000303'01 endif. 35532 35533 000303'01 200 06 0 00 000003 move q2, t3 ; Pretend they asked for this 35534 000304'01 254 00 0 00 000000* retskp ; Have a default 35535 35536 ;[220] End code insertion 35537 k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 19:42 30-Mar-24 Page 7 K20SRV MAC 30-Mar-24 15:37 Update GETJI% information from GJINV% 35538 subttl Update GETJI% information from GJINV% 35539 35540 ;[220] Begin code insertion 35541 35542 000305'01 udjinf: entry udjinf ; Also used by k20mit 35543 000305'01 265 16 0 00 006314' saveac ; Only side-effect storage, not accumulators 35544 35545 000306'01 104 00 0 00 000013 GJINF% ; Faster than GETJI% and always works 35546 remark t1,.jiuno+jobtab ; User number will NEVER change; no SETUID. 35547 000307'01 202 02 0 00 000000# movem t2, .jidno+jobtab ; Connected directory, which CWD changes 35548 remark t3,.jijno+jobtab ; Job number will NEVER change during execution 35549 000310'01 202 04 0 00 000000# movem t4, .jitno+jobtab ; Update current controlling terminal 35550 000311'01 263 17 0 00 000000 ret ; Always works, so return +1, always 35551 35552 ;[220] End code insertion 35553 k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 19:42 30-Mar-24 Page 8 K20SRV MAC 30-Mar-24 15:37 GETPAS -- Get a password from the terminal or file 35554 subttl GETPAS -- Get a password from the terminal or file 35555 35556 ; Call: 35557 ; 35558 ; t1/ Length of password buffer (in characters) 35559 ; t2/ Pointer to password buffer 35560 ; 35561 ; Return: 35562 ; 35563 ; +1, Some kind of failure 35564 ; +2, Got some text: 35565 ; 35566 ; t1/ Password length (in characters) 35567 ; t2/ Updated to end of password 35568 ; 35569 ; Other accumulators are unmodified 35570 ; 35571 ; Performs the following: 35572 ; 35573 ; If invoked from a TAKE file, reads the password from the file, 35574 ; using end of line as the ending delimiter. 35575 ; 35576 ; Otherwise: 35577 ; 35578 ; 1) Prompts for password, 35579 ; 2) Turns off echoing during typein, 35580 ; 3) Restores echoing 35581 ; 4) Returns with result in buffer 35582 ; 35583 ; smashes t1-t4, others preserved 35584 ; 35585 ; Partially rewritten as part of [194] for better security 35586 35587 ; In TEXT, not ETEXT because brain damaged RDTTY% can not handle the 35588 ; OWGP that PSOUT% has just typed. The RDCBP routine in COMND% only 35589 ; allows OWGP's from a non-zero section. Bogus... 35590 35591 chgsec(code,text) ;[220] Section zero text, sigh... 35592 000124'03 040 120 141 163 163 pwdprm: asciz / Password: / ;[220] Prompt for when requesting passwords 35593 retsec ;[220] Back into mainline code 35594 35595 000312'01 getpas: extern takdep, takjfn ;[194] and of our necessaries 35596 000312'01 327 01 0 00 000320' ifle. t1 ;[194] You're kidding, right? 35597 000313'01 334 01 0 00 000000# ermsg% (,r) ;[194] 35598 000314'01 254 00 0 00 000320' 35599 000315'01 202 01 0 00 000246* 35600 000316'01 104 00 0 00 000313 35601 000317'01 254 00 0 00 000272* 35602 000075'02 000000000000# 35603 000076'04 113 105 122 115 111 35604 35605 000320'01 endif. ;[194] Useless to go further 35606 ;[194] Otherwise, got a positive length 35607 000320'01 265 16 0 00 006326' saveac ;[194] 35608 000321'01 303 01 0 00 000047 caile t1, mxpwlc ;[194] Maximum than Tops-20 will do? k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 19:42 30-Mar-24 Page 8-1 K20SRV MAC 30-Mar-24 15:37 GETPAS -- Get a password from the terminal or file 35609 000322'01 201 01 0 00 000047 movx t1, mxpwlc ;[194] Yes, clip it down 35610 000323'01 120 05 0 00 000001 dmove q1, t1 ;[194] Save the calling parameters 35611 000324'01 231 01 0 00 000005 idivi t1, ^d5 ;[194] Convert from characters to words 35612 000325'01 322 02 0 00 000327' ifn. t2 ;[194] Any remainder? 35613 000326'01 271 01 0 00 000001 addi t1, ^d1 ;[194] Yes, round up a word 35614 000327'01 endif. ;[194] 35615 000327'01 200 07 0 00 000001 move q3, t1 ;[194] Store final length 35616 000330'01 550 02 0 00 000006 hrrz t2, q2 ;[194] Load word address of password buffer 35617 000331'01 260 17 0 00 000500' call scrubp ;[194] Clobber it, first 35618 35619 000332'01 336 00 0 00 000000* ifmn. takdep ;[194] ;[178] Do specially for TAKE files 35620 000333'01 254 00 0 00 000362' 35621 000334'01 200 01 0 00 000000* move t1, takjfn ; Read line from the TAKE file 35622 000335'01 120 02 0 00 000006 dmove t2, q2 ;[194] Into buffer, clipping maximum 35623 000336'01 201 04 0 00 000012 movei t4, .CHLFD ; terminate on linefeed. 35624 000337'01 104 00 0 00 000052 SIN 35625 000340'01 320 12 0 00 000342' %jserr (,r) ;[194] 35626 000341'01 254 00 0 00 000345' 35627 000342'01 265 01 0 00 000270* 35628 000343'01 000000000000# 35629 000344'01 254 00 0 00 000317* 35630 000113'04 107 145 164 040 160 35631 000345'01 474 01 0 00 000000 seto t1, ;[194] Let's investigate the read 35632 000346'01 133 01 0 00 000002 adjbp t1, t2 ;[194] Decrement the returned byte pointer. 35633 000347'01 135 04 0 00 000001 ldb t4, t1 ;[194] Load the previous character 35634 000350'01 302 04 0 00 000015 caie t4, .chcrt ;[194] Better have been a carriage return 35635 000351'01 263 17 0 00 000000 ret ;[194] It wasn't, so fail the call 35636 000352'01 400 04 0 00 000000 setz t4, ; Write a zero over the terminating CR. 35637 000353'01 137 04 0 00 000001 dpb t4, t1 35638 000354'01 136 04 0 00 000001 idpb t4, t1 ; And linefeed. 35639 000355'01 200 01 0 00 000005 move t1, q1 ;[194] Load original length 35640 000356'01 271 03 0 00 000002 addi t3, ^d2 ;[194] Account for .chcrt and .chlfd we pitched 35641 000357'01 274 01 0 00 000003 sub t1, t3 ;[194] Subtract what we didn't read, yielding length 35642 000360'01 200 02 0 00 000006 move t2, q2 ;[194] ; Return pointer to password. 35643 000361'01 254 00 0 00 000304* retskp ;[194] ;[178] Won!! 35644 000362'01 endif. ;[194] 35645 35646 remark ;[194] Otherwise, user has to type something 35647 000362'01 201 01 0 00 000100 movei t1, .priin ; Get TTY mode word 35648 000363'01 104 00 0 00 000107 RFMOD 35649 000364'01 320 12 0 00 000366' %jserr (,r) ;[194] 35650 000365'01 254 00 0 00 000371' 35651 000366'01 265 01 0 00 000342* 35652 000367'01 000000000000# 35653 000370'01 254 00 0 00 000344* 35654 000124'04 107 145 164 040 160 35655 000371'01 621 02 0 00 400000 txz t2, tt%osp ;[194] Clear control-O so prompt comes out 35656 000372'01 202 02 0 00 000010 movem t2, q4 ;[194] And save it 35657 000373'01 620 02 0 00 004000 txz t2, tt%eco ; Turn off echoing. 35658 000374'01 104 00 0 00 000110 SFMOD 35659 000375'01 320 12 0 00 000377' %jserr (,r) ;[194] 35660 000376'01 254 00 0 00 000402' 35661 000377'01 265 01 0 00 000366* 35662 000400'01 000000000000# 35663 000401'01 254 00 0 00 000370* k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 19:42 30-Mar-24 Page 8-2 K20SRV MAC 30-Mar-24 15:37 GETPAS -- Get a password from the terminal or file 35664 000136'04 107 145 164 040 160 35665 35666 000402'01 561 01 0 00 000000# hrroi t1, pwdprm ;[194] Issue first prompt. 35667 000403'01 104 00 0 00 000076 PSOUT 35668 000404'01 200 01 0 00 000006 move t1, q2 ;[194] Load pointer to password buffer 35669 000405'01 550 02 0 00 000005 hrrz t2, q1 ;[194] Load length of buffer 35670 000406'01 661 02 0 00 060100 txo t2, rd%bel!rd%crf!rd%sui ;[194] Break on .chcrt or .chlfd, suppress .chcrt 35671 000407'01 561 03 0 00 000000# hrroi t3, pwdprm ;[194] Prompt if ^R typed 35672 000410'01 104 00 0 00 000523 RDTTY 35673 000411'01 320 12 0 00 000413' ifje. r ;[194] Failed?? 35674 000412'01 254 00 0 00 000435' 35675 000413'01 200 04 0 00 000001 move t4, t1 ;[194] Save the error 35676 000414'01 200 01 0 00 000007 move t1, q3 ;[220] Load word length of buffer 35677 000415'01 550 02 0 00 000006 hrrz t2, q2 ;[220] Load word address of password buffer 35678 000416'01 260 17 0 00 000500' call scrubp ;[220] Ditch anything that we might have gotten 35679 000417'01 334 00 0 00 000000 %ermsg (,) ;[194] Begin complaining 35680 000420'01 254 00 0 00 000424' 35681 000421'01 265 01 0 00 000377* 35682 000422'01 000000000000# 35683 000423'01 254 00 0 00 000424' 35684 000146'04 107 145 164 040 160 35685 000424'01 201 01 0 00 000100 movei t1, .priin ;[194] Diddle primary input 35686 000425'01 200 02 0 00 000010 move t2, q4 ;[194] Load original mode word 35687 000426'01 104 00 0 00 000110 SFMOD% ;[194] Restore terminal to original mode 35688 000427'01 320 12 0 00 000431' %jserr (,) ;[194] 35689 000430'01 254 00 0 00 000434' 35690 000431'01 265 01 0 00 000421* 35691 000432'01 000000000000# 35692 000433'01 254 00 0 00 000434' 35693 000155'04 107 145 164 040 160 35694 000434'01 263 17 0 00 000000 ret ;[220] Fail the call 35695 000435'01 endif. ;[194] 35696 35697 000435'01 415 16 0 00 000452' block. ;[194] Get a stack frame 35698 000436'01 261 17 0 00 000016 35699 000437'01 265 16 0 00 006342' saveac ;[194] Preserve these over SFMOD% 35700 000440'01 201 01 0 00 000100 movei t1, .priin ;[194] Diddle primary input 35701 000441'01 200 02 0 00 000010 move t2, q4 ;[194] Load original mode word 35702 000442'01 104 00 0 00 000110 SFMOD ; Restore TTY to normal echoing. 35703 000443'01 320 12 0 00 000445' %jserr (,r) ;[194] 35704 000444'01 254 00 0 00 000450' 35705 000445'01 265 01 0 00 000431* 35706 000446'01 000000000000# 35707 000447'01 254 00 0 00 000401* 35708 000170'04 107 145 164 040 160 35709 000450'01 254 00 0 00 000361* retskp ;[194] Otherwise, worked 35710 000451'01 263 17 0 00 000000 endbk. ;[194] End of block context 35711 000452'01 600 00 0 00 000000 nop ;[220] Ignore error and carry on 35712 35713 000453'01 400 03 0 00 000000 setz t3, ;[194] Cons up a .chnul 35714 000454'01 137 03 0 00 000001 dpb t3, t1 ;[194] ; Write a zero over the terminating linefeed. 35715 000455'01 550 04 0 00 000002 hrrz t4, t2 ;[194] Pick up the remaining length 35716 000456'01 271 04 0 00 000001 addi t4, ^d1 ;[194] Account for linefeed we'll toss 35717 000457'01 274 05 0 00 000004 sub q1, t4 ;[194] Calculate length of password 35718 000460'01 200 06 0 00 000001 move q2, t1 ;[194] Save updated pointer k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 19:42 30-Mar-24 Page 8-3 K20SRV MAC 30-Mar-24 15:37 GETPAS -- Get a password from the terminal or file 35719 000461'01 510 04 0 00 000002 hllz t4, t2 ;[169] Remember flag bits that were returned. 35720 000462'01 561 01 0 00 000000* hrroi t1, crlf ;[194] Point to carriage return line feed 35721 000463'01 104 00 0 00 000076 PSOUT% ;[194] ; Echo the crlf that wasn't echoed. 35722 35723 000464'01 603 04 0 00 000040 ifxe. t4, rd%btm ;[194] Too long? 35724 000465'01 254 00 0 00 000476' 35725 000466'01 334 01 0 00 000000# ermsg% (,) ;[194] Complain 35726 000467'01 254 00 0 00 000472' 35727 000470'01 202 01 0 00 000315* 35728 000471'01 104 00 0 00 000313 35729 000076'02 000000000000# 35730 000202'04 113 105 122 115 111 35731 35732 000472'01 200 01 0 00 000007 move t1, q3 ;[220] Load word length of buffer 35733 000473'01 550 02 0 00 000006 hrrz t2, q2 ;[220] Load word address of password buffer 35734 000474'01 260 17 0 00 000500' call scrubp ;[220] Ditch anything that we might have gotten 35735 000475'01 263 17 0 00 000000 ret ;[220] Fail the call 35736 000476'01 endif. ;[194] 35737 35738 000476'01 120 01 0 00 000005 dmove t1, q1 ;[194] Load updated results 35739 000477'01 254 00 0 00 000450* retskp ;[194] And return them 35740 k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 19:42 30-Mar-24 Page 9 K20SRV MAC 30-Mar-24 15:37 Scrub the password buffer 35741 subttl Scrub the password buffer 35742 35743 ;[194] Begin code insertion 35744 35745 ; Call: 35746 ; 35747 ; t1/ Length of password buffer (in WORDS) 35748 ; t2/ Pointer to password buffer 35749 ; 35750 ; Returns: 35751 ; 35752 ; +1, always 35753 ; Stomps the buffer to all zeros, all AC's preserved 35754 35755 000500'01 323 01 0 00 000447* scrubp: jumple t1, r ; You're kidding, right? 35756 000501'01 265 16 0 00 006314' saveac ; Don't touch anything 35757 000502'01 200 04 0 02 000000 move t4, (t2) ; First of all, does the memory even exist? 35758 000503'01 320 12 0 00 000500* erjmpr r ; Nope, so nothing to scrub 35759 35760 000504'01 302 01 0 00 000001 caie t1, ^d1 ; Is the password really short? 35761 000505'01 254 00 0 00 000510' ifskp. ; Not a great idea, but easy enough to do 35762 000506'01 402 00 0 02 000000 setzm (t2) ; Scrub the buffer 35763 000507'01 263 17 0 00 000000 ret ; And we're done 35764 000510'01 endif. 35765 35766 remark ; Otherwise, doing two or more words 35767 000510'01 403 03 0 00 000004 setzb t3, t4 ; Cons up 10 .chnul's 35768 000511'01 124 03 0 02 000000 dmovem t3, (t2) ; Stomp at least that much 35769 000512'01 307 01 0 00 000002 caig t1, ^d2 ; Wanted to clear more than two words? 35770 000513'01 263 17 0 00 000000 ret ; No, then we're done 35771 35772 000514'01 275 01 0 00 000002 subi t1, ^d2 ; Account for two words cleared 35773 000515'01 415 03 0 02 000002 xmovei t3, 2(t2) ; Skip already cleared words 35774 000516'01 123 01 0 00 006313' xblt. t1 ; Clear the rest of the block 35775 000517'01 263 17 0 00 000000 ret ; Return all nice and tidy 35776 35777 ;[194] End code insertion 35778 k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 19:42 30-Mar-24 Page 10 K20SRV MAC 30-Mar-24 15:37 Execute the LOCAL CWD command. 35779 subttl Execute the LOCAL CWD command. 35780 35781 ;[171] Rewritten to only prompt for the password when necessary, as 35782 ; the Exec CONNECT command does, and to print the name of the 35783 ; directory connected to. 35784 ; 35785 ; First try to connect with no password. This returns immediately on 35786 ; error. 35787 ; 35788 ; [194] The previous sentence is no longer true; a connection attempt 35789 ; that fails will put the process to sleep so that it can not stay in 35790 ; a loop, trying passwords. Eventually, alerts will come out on the 35791 ; CTY. 35792 ; 35793 ; Thus, we try to guess whether we'll need a password with CHKAC% 35794 35795 000003 acabl==<.acjob+1> ; ACCES% argument block length 35796 35797 000520'01 $ycwd: entry $ycwd ;Invoked from k20par 35798 000520'01 265 16 0 00 006265' saveac ;[194] Used for anonymous stkvars 35799 000521'01 265 16 0 00 000200* anstkv (q1, ) ;[194] Argument block and password 35800 000522'01 000000 000013 35801 000523'01 415 05 0 17 777764 35802 000524'01 415 06 0 05 000003 xmovei q2, (q1) ;[194] Base of password buffer 35803 35804 000525'01 336 01 0 00 000167* skipn t1, pars3 ;[194] Load the directory (if there is one) 35805 000526'01 334 01 0 00 000000# ermsg% (,r) ;[194] 35806 000527'01 254 00 0 00 000533' 35807 000530'01 202 01 0 00 000470* 35808 000531'01 104 00 0 00 000313 35809 000532'01 254 00 0 00 000503* 35810 000077'02 000000000000# 35811 000211'04 113 105 122 115 111 35812 35813 000533'01 302 01 0 00 377777 caie t1, .nulio ;[193] Connecting to NUL:? 35814 000534'01 254 00 0 00 000537' ifskp. ;]193] We are, so do nothing 35815 000535'01 476 00 0 05 000000 setom .acdir(q1) ;[194] And impossible connected directory 35816 000536'01 254 00 0 00 000605' jrst $ycwdz ;[193] Continue as if we did something... 35817 000537'01 endif. ;[193] End NUL: special case 35818 000537'01 200 02 0 00 000000* move t2, pars4 ;[193] Load the parse type 35819 000540'01 306 02 0 00 000016 cain t2, .cmdev ;[193] Not a device, was it?? 35820 000541'01 254 00 0 00 000635' jrst cwdeve ;[193] Go handle a bogus connect device 35821 000542'01 400 02 0 00 000000 setz t2, ;[220] assume no password 35822 000543'01 124 01 0 05 000000 dmovem t1, .acdir(q1) ;[194] Store in block 35823 000544'01 476 00 0 05 000002 setom .acjob(q1) ;[194] Do the connect for this job 35824 35825 000545'01 336 00 0 00 000172* ifmn. pars5 ;[220] Did they already give us a password 35826 000546'01 254 00 0 00 000561' 35827 000547'01 201 01 0 00 000010 movx t1, mxpwlw ;[220] Load length of password buffer 35828 000550'01 550 02 0 00 000545* hrrz t2, pars5 ;[220] Load section local address of where it was parsed 35829 000551'01 200 03 0 00 000006 move t3, q2 ;[220] and the address of the password buffer 35830 000552'01 123 01 0 00 006313' xblt. t1 ;[220] Transfer it 35831 remark ;[220] This is wrong if the password isn't in atmbuf 35832 dmove t1, [ atmbln ;[220] Load length of atom buffer again 35833 000553'01 120 01 0 00 006352' atmbuf ] ;[220] and the address of atom buffer k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 19:42 30-Mar-24 Page 10-1 K20SRV MAC 30-Mar-24 15:37 Execute the LOCAL CWD command. 35834 000554'01 260 17 0 00 000500' call scrubp ;[220] Scrub any password text out of it 35835 000555'01 550 02 0 00 000006 hrrz t2, q2 ;[220] Load address of password buffer 35836 000556'01 505 02 0 00 440700 hrli t2,() ;[220] Turn into a local pointer 35837 000557'01 202 02 0 05 000001 movem t2, .acpsw(q1) ;[220] Store in access argument block 35838 000560'01 254 00 0 00 000575' jrst $ycwdy ;[220] Skip access check and first attempt 35839 000561'01 endif. ;[220] End case password already specified 35840 35841 000561'01 260 17 0 00 000653' call pwconp ;[194] Can we connect without a password? 35842 000562'01 254 00 0 00 000570' jrst $ycwdx ;[194] No, go get one 35843 000563'01 200 01 0 00 006354' movx t1, ac%con!acabl ;[194] Ask for connect function,,arg block length 35844 000564'01 200 02 0 00 000005 move t2, q1 ;[194] Load address of argument block 35845 000565'01 104 00 0 00 000552 ACCES ; Try to connect. 35846 000566'01 320 12 0 00 000570' erjmpr $ycwdx ; If error, go prompt for password. 35847 000567'01 254 00 0 00 000605' jrst $ycwdz ; Connected OK, exit. 35848 35849 ; Handle error by prompting for password and then trying to connect again. 35850 35851 000570'01 120 01 0 00 006355' $ycwdx: dmove t1, [ exp mxpwlc,] ;[194] Load length and byte size 35852 000571'01 540 02 0 00 000006 hrr t2, q2 ;[194] Now have an ASCII pointer to password buffer 35853 000572'01 202 02 0 05 000001 movem t2, .acpsw(q1) ;[194] Store in access argument block 35854 000573'01 260 17 0 00 000312' call getpas ; Ask for password. 35855 000574'01 263 17 0 00 000000 ret ;[194] Return failure 35856 000575'01 200 01 0 00 006354' $ycwdy: movx t1, ac%con!acabl ;[194] Ask for connect function,,arg block length 35857 000576'01 200 02 0 00 000005 move t2, q1 ;[194] Load address of argument block 35858 000577'01 104 00 0 00 000552 ACCES ;[194] Failure here will trigger a wait 35859 000600'01 320 12 0 00 000602' %jserr (,) ;[194] On failure, whine and continue 35860 000601'01 254 00 0 00 000605' 35861 000602'01 265 01 0 00 000445* 35862 000603'01 000000000000# 35863 000604'01 254 00 0 00 000605' 35864 000225'04 103 127 104 040 146 35865 35866 ; At this point, done either way, whether succeeded or not 35867 35868 000605'01 201 01 0 00 000010 $ycwdz: movx t1, mxpwlw ;[194] Load maximum password length, words 35869 000606'01 200 02 0 00 000006 move t2, q2 ;[194] Load address of password buffer 35870 000607'01 260 17 0 00 000500' call scrubp ;[194] Scrub any password text out of it 35871 35872 000610'01 201 01 0 00 000133 movei t1, "[" ;[194] Begin message 35873 000611'01 104 00 0 00 000074 PBOUT ;[194] 35874 000612'01 104 00 0 00 000013 GJINF% ;[194] Get job information 35875 000613'01 202 02 0 00 000000# movem t2, jobtab+.jidno ;[194] Remember for future reference. 35876 000614'01 312 02 0 05 000000 came t2, .acdir(q1) ;[194] Did we go where we wanted? 35877 000615'01 254 00 0 00 000622' ifskp. ;[194] Yes, advise of such 35878 000616'01 200 01 0 00 000000# txmsg ;[194] Print what we're connected to. 35879 000617'01 104 00 0 00 000076 35880 000620'01 320 12 0 00 000621' 35881 000100'02 000000000000# 35882 000232'04 103 157 156 156 145 35883 000621'01 254 00 0 00 000625' else. ;[194] Otherwise, say nothing happened 35884 000622'01 200 01 0 00 000000# txmsg ;[194] 35885 000623'01 104 00 0 00 000076 35886 000624'01 320 12 0 00 000625' 35887 000101'02 000000000000# 35888 000235'04 122 145 155 141 151 k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 19:42 30-Mar-24 Page 10-2 K20SRV MAC 30-Mar-24 15:37 Execute the LOCAL CWD command. 35889 000625'01 endif. ;[194] 35890 000625'01 201 01 0 00 000101 movei t1, .priou 35891 000626'01 104 00 0 00 000041 DIRST 35892 000627'01 320 12 0 00 000630' erjmpr .+1 ;[194] 35893 000630'01 201 01 0 00 000135 movei t1, "]" 35894 000631'01 104 00 0 00 000074 PBOUT 35895 000632'01 561 01 0 00 000462* hrroi t1, crlf ;[194] Tie off the line 35896 000633'01 104 00 0 00 000076 PSOUT% ;[194] 35897 000634'01 263 17 0 00 000000 ret 35898 k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 19:42 30-Mar-24 Page 11 K20SRV MAC 30-Mar-24 15:37 Here to handle some bogus connect device 35899 subttl Here to handle some bogus connect device 35900 35901 ; t1/ device designator 35902 ; t2/ parsed function code 35903 35904 000635'01 200 02 0 00 000001 cwdeve: move t2, t1 ;[193] Save device designator 35905 000636'01 403 03 0 00 000004 setzb t3, t4 ;[193] Cons up ten nulls 35906 000637'01 124 03 0 06 000000 dmovem t3, (q2) ;[193] Scrub the buffer 35907 000640'01 561 01 0 06 000000 hrroi t1, (q2) ;[193] Point to buffer 35908 000641'01 104 00 0 00 000121 DEVST% ;[193] Convert devie to a string 35909 000642'01 320 14 0 00 000643' erjmps .+1 ;[193] Catch and suppress error 35910 000643'01 561 01 0 06 000000 hrroi t1, (q2) ;[193] Point to buffer 35911 000644'01 104 00 0 00 000313 ESOUT% ;[194] Begin blatting at user 35912 000645'01 320 12 0 00 000646' erjmpr .+1 ;[194] Catch and ignore error 35913 txmsg <: is not a file structure, so can't connect to it. 35914 000646'01 200 01 0 00 000000# > ;[193] Rest of the blat 35915 000647'01 104 00 0 00 000076 35916 000650'01 320 12 0 00 000651' 35917 000102'02 000000000000# 35918 000242'04 072 040 151 163 040 35919 35920 000651'01 124 03 0 06 000000 dmovem t3,(q2) ;[193] Scrub again 35921 000652'01 263 17 0 00 000000 ret ;[193] Return from failure 35922 k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 19:42 30-Mar-24 Page 12 K20SRV MAC 30-Mar-24 15:37 Can we do a passwordless connect to a directory? 35923 subttl Can we do a passwordless connect to a directory? 35924 35925 ;[194] Begin code insertion 35926 ; 35927 ; Call: 35928 ; 35929 ; t1/ Directory (number) to connect to 35930 ; 35931 ; Return: 35932 ; 35933 ; +1, t1/ Has a zero if can't connect 35934 ; t2/ Zero if CHKAC% succeed or last error 35935 ; t1/ Has last error code if we failed the CHKAC% 35936 ; 35937 ; +2, t1/ Negative one 35938 ; t2/ Zero 35939 ; 35940 ; Smashes t1-t4 35941 35942 000653'01 265 16 0 00 000521* pwconp: anstkv(t4,<.ckapr+1>) ; Allocate an argument block 35943 000654'01 000000 000006 35944 000655'01 415 04 0 17 777771 35945 35946 000656'01 474 02 0 00 000000 seto t2, ; Request complete file access (everything) 35947 000657'01 124 01 0 04 000004 dmovem t1, .ckaud(t4) ; Store with directory number in argument block 35948 000660'01 200 01 0 00 000000# move t1, jobtab+.jidno ; Load currently connected directory 35949 000661'01 200 02 0 00 000000# move t2, mycaps+1 ; Load my enabled capabilities 35950 000662'01 124 01 0 04 000002 dmovem t1, .ckacd(t4) ; Store in argument block 35951 000663'01 201 01 0 00 000010 movx t1, .ckacn ; Checking for connect access 35952 000664'01 200 02 0 00 000000# move t2, jobtab+.jiuno ; Load my login user number 35953 000665'01 124 01 0 04 000000 dmovem t1, .ckaac(t4) ; Store in argument block 35954 35955 000666'01 201 01 0 00 000006 movx t1, <.ckapr+1> ; Load length of block 35956 000667'01 200 02 0 00 000004 move t2, t4 ; Load address of block 35957 000670'01 104 00 0 00 000521 CHKAC% ; See if we can do anything 35958 000671'01 320 12 0 00 000673' ifje. r ; Failed?? 35959 000672'01 254 00 0 00 000676' 35960 000673'01 200 02 0 00 000001 move t2, t1 ; Return the error 35961 000674'01 400 01 0 00 000000 setz t1, ; Say we can't access it 35962 000675'01 254 00 0 00 000677' else. ; Otherwise, JSYS worked 35963 000676'01 400 02 0 00 000000 setz t2, ; In which case there is no error code 35964 000677'01 endif. 35965 35966 000677'01 322 01 0 00 000532* jumpe t1, r ; If zero, then return +1 35967 000700'01 254 00 0 00 000477* retskp ; Otherwise, won!! 35968 35969 ;[194] End code insertion 35970 k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 19:42 30-Mar-24 Page 13 K20SRV MAC 30-Mar-24 15:37 REMOTE CWD Parsing 35971 subttl REMOTE CWD Parsing 35972 35973 ;[106] Parsing and execution all for Edit 106 35974 35975 ;N.B., all the extra scrubbing being done here is to try to enhance 35976 ; security by getting rid of any password remnants. 35977 35978 chgsec(code,const) ;;Chained FDB's are not in code, they're in const 35979 000103'02 010004 000106' xcwfdb: flddb. .cmcfm,,,,,xcwfd1 35980 000104'02 000000 000000 35981 000105'02 44 07 0 00 000445' 35982 000106'02 021004 000111' xcwfd1: flddb. .cmqst,,,,,xcwfd2 35983 000107'02 000000 000000 35984 000110'02 44 07 0 00 000455' 35985 000111'02 017004 000000 xcwfd2: flddb. .cmtxt,,,,, 35986 000112'02 000000 000000 35987 000113'02 44 07 0 00 000455' 35988 000114'02 010004 000117' xpwfdb: flddb. .cmcfm,,,,,xpwfd1 35989 000115'02 000000 000000 35990 000116'02 44 07 0 00 000463' 35991 000117'02 021004 000122' xpwfd1: flddb. .cmqst,,,,,xpwfd2 35992 000120'02 000000 000000 35993 000121'02 44 07 0 00 000472' 35994 000122'02 017004 000000 xpwfd2: flddb. .cmtxt,,,,, 35995 000123'02 000000 000000 35996 000124'02 44 07 0 00 000472' 35997 retsec ;;Get back to wherever we came from 35998 cleans() 35999 36000 000701'01 265 16 0 00 006357' .xcwd: saveac ;[220] Necessary for intermediate parse results 36001 36002 remark ;[220] Note, these lengths are for foreign directories 36003 000702'01 120 01 0 00 006371' dmove t1, [exp fdrmxw,dirbuf] 36004 000703'01 260 17 0 00 000500' call scrubp ;[194] Scrub the directory buffer 36005 000704'01 120 01 0 00 006373' dmove t1, [exp fpwmxw,pasbuf] 36006 000705'01 260 17 0 00 000500' call scrubp ;[194] Scrub the password buffer 36007 36008 remark ;[220] First get directory, if specified 36009 000706'01 200 16 0 00 000000# guide ; Issue guide words. 36010 000707'01 260 17 0 00 000054* 36011 000125'02 000000000000# 36012 000255'04 164 157 040 144 151 36013 000710'01 201 01 0 00 000000# movei t1, xcwfdb ;[220] Allow a quote of the remote directory 36014 000711'01 260 17 0 00 000157* call rfield ;[220] Parse something 36015 000712'01 120 05 0 00 000001 dmove q1, t1 ;[220] Store parse results 36016 000713'01 135 07 0 00 006275' ldb q3, [pointr (.cmfnp(t3),cm%fnc)] ;[220] Get function code 36017 000714'01 302 07 0 00 000010 caie q3, .cmcfm ;[241] Was it a bare confirm? 36018 000715'01 254 00 0 00 000721' ifskp. ;[241] Yes, let's not return gubbish 36019 000716'01 120 01 0 00 006375' dmove t1, [exp atmbln,atmbuf] 36020 000717'01 260 17 0 00 000500' call scrubp ;[241] Don't send anything to remote system!! 36021 000720'01 263 17 0 00 000000 ret ;[241] Return, taking default (with no password) 36022 000721'01 endif. ;[241] End case bare confirm 36023 36024 remark ;[220] BUT!! Did they actually type anything?? 36025 000721'01 200 02 0 00 006377' move t2, [point 7, atmbuf] ;[220] Let's see what they did k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 19:42 30-Mar-24 Page 13-1 K20SRV MAC 30-Mar-24 15:37 REMOTE CWD Parsing 36026 000722'01 134 01 0 00 000002 ildb t1, t2 ;[220] Pick up the first byte 36027 000723'01 306 01 0 00 000015 cain t1, .chcrt ;[241] Bare carriage return? 36028 000724'01 400 01 0 00 000000 setz t1, ;[241] Turn into .CHNUL 36029 000725'01 306 01 0 00 000012 cain t1, .chlfd ;[241] Bare linefeed? 36030 000726'01 400 01 0 00 000000 setz t1, ;[241] Turn into .CHNUL 36031 000727'01 326 01 0 00 000734' ife. t1 ;[220] They didn't, so still using default area 36032 000730'01 260 17 0 00 000166* confrm ;[220] Line needs to be confirmed, however 36033 000731'01 120 01 0 00 006400' dmove t1, [exp atmbln,atmbuf] 36034 000732'01 260 17 0 00 000500' call scrubp ;[241] Don't send anything to remote system!! 36035 000733'01 263 17 0 00 000000 ret ;[220] We're done; not sending a directory 36036 000734'01 endif. ;[220] or its related password 36037 36038 000734'01 201 01 0 00 000141 movx t1, fdrmxw ;[220] Load maximum length of foreign directory 36039 dmove t2, [ atmbuf ;[220] Source is atom buffer 36040 000735'01 120 02 0 00 006402' dirbuf ] ;[220] Destination is foreign 36041 000736'01 123 01 0 00 006313' xblt. t1 ;[220] Store for semantic action 36042 000737'01 201 01 0 00 000000# movei t1, dirbuf ;[220] Load address of foreign directory 36043 000740'01 505 01 0 00 440700 hrli t1,() ;[220] Turn into a local pointer 36044 000741'01 202 01 0 00 000525* movem t1, pars3 ;[220] Store for semantic action 36045 36046 remark ;[220] Second, get password, one way or another 36047 ;;;; remark shut off echoing here like exec? 36048 000742'01 201 01 0 00 000000# movei t1, xpwfdb ;[220] Allow a quote of the remote directory 36049 000743'01 260 17 0 00 000711* call rfield ;[220] Parse something 36050 000744'01 120 05 0 00 000001 dmove q1, t1 ;[220] Store parse results 36051 000745'01 135 07 0 00 006275' ldb q3, [pointr (.cmfnp(t3),cm%fnc)] ;[220] Get function code 36052 ;;;; remark turn back on, but only if not in take file 36053 36054 000746'01 306 07 0 00 000010 cain q3, .cmcfm ;[220] Was it a confirm? 36055 000747'01 254 00 0 00 000773' jrst .xcwd1 ;[220] It was, so specifying password on next line 36056 36057 remark ;[220] BUT!! Did they type anything?? 36058 000750'01 200 02 0 00 006377' move t2, [point 7, atmbuf] ;[220] Let's see what they did 36059 000751'01 134 01 0 00 000002 ildb t1, t2 ;[220] Pick up the first byte 36060 000752'01 306 01 0 00 000015 cain t1, .chcrt ;[241] Bare carriage return? 36061 000753'01 400 01 0 00 000000 setz t1, ;[241] Turn into .CHNUL 36062 000754'01 306 01 0 00 000012 cain t1, .chlfd ;[241] Bare linefeed? 36063 000755'01 400 01 0 00 000000 setz t1, ;[241] Turn into .CHNUL 36064 000756'01 326 01 0 00 000763' ife. t1 ;[220] Did they do a "" for no password? 36065 000757'01 260 17 0 00 000730* confrm ;[220] They did; still needs to be confirmed 36066 000760'01 120 01 0 00 006404' dmove t1, [exp atmbln,atmbuf] 36067 000761'01 260 17 0 00 000500' call scrubp ;[241] Don't send anything to remote system!! 36068 000762'01 263 17 0 00 000000 ret ;[220] Leave, explicitly not sending a password 36069 000763'01 endif. 36070 36071 remark ;[220] Otherwise, nearly done 36072 000763'01 260 17 0 00 000757* confrm ;[220] Confirm before copying sensitive data 36073 000764'01 201 01 0 00 000141 movx t1, fpwmxw ;[220] Load maximum length of foreign password 36074 dmove t2, [ atmbuf ;[220] Source is atom buffer 36075 000765'01 120 02 0 00 006406' pasbuf ] ;[220] Destination is foreign password 36076 000766'01 123 01 0 00 006313' xblt. t1 ;[220] Store for semantic action 36077 000767'01 201 01 0 00 000000# movei t1, pasbuf ;[220] Load address of foreign password 36078 000770'01 505 01 0 00 440700 hrli t1,() ;[220] Turn into a local pointer 36079 000771'01 202 01 0 00 000537* movem t1, pars4 ;[220] Store for semantic action 36080 000772'01 263 17 0 00 000000 ret ;[220] Successfully completed parse k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 19:42 30-Mar-24 Page 13-2 K20SRV MAC 30-Mar-24 15:37 REMOTE CWD Parsing 36081 36082 000773'01 .xcwd1: dmove t1, [ ;[220] No, they did not 36083 mxpwlc ;[220] Maximum password length in characters 36084 000773'01 120 01 0 00 006410' point 7,pasbuf ] ;[220] Point to password buffer 36085 000774'01 260 17 0 00 000312' call getpas ;[220] Ask for a password. 36086 000775'01 254 00 0 00 000145* jrst cmder1 ;[220] Handle like a parse error, do not do semantics 36087 36088 000776'01 200 01 0 00 006412' move t1,[point 7,pasbuf];[241] Point to password buffer 36089 000777'01 134 01 0 00 000002 ildb t1, t2 ;[241] Pick up the first byte 36090 001000'01 306 01 0 00 000015 cain t1, .chcrt ;[241] Bare carriage return? 36091 001001'01 400 01 0 00 000000 setz t1, ;[241] Turn into .CHNUL 36092 001002'01 306 01 0 00 000012 cain t1, .chlfd ;[241] Bare linefeed? 36093 001003'01 400 01 0 00 000000 setz t1, ;[241] Turn into .CHNUL 36094 001004'01 326 01 0 00 001012' ife. t1 ;[241] They didn't, so chuck remnants 36095 001005'01 120 01 0 00 006413' dmove t1, [exp fpwmxw,pasbuf] 36096 001006'01 260 17 0 00 000500' call scrubp ;[241] Chuck any gubbish in password buffer 36097 001007'01 120 01 0 00 006415' dmove t1, [exp atmbln,atmbuf] 36098 001010'01 260 17 0 00 000500' call scrubp ;[241] Sanitize the atom buffer, also 36099 001011'01 263 17 0 00 000000 ret ;[241] We're done; sending a directory 36100 001012'01 endif. ;[220] but not its related password 36101 36102 001012'01 200 01 0 00 006417' move t1,[point 7,pasbuf];[220] Point to password buffer 36103 001013'01 202 01 0 00 000771* movem t1, pars4 ;[220] Save pointer to it. 36104 001014'01 263 17 0 00 000000 ret ;[220] Done 36105 k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 19:42 30-Mar-24 Page 14 K20SRV MAC 30-Mar-24 15:37 REMOTE CWD Execution 36106 subttl REMOTE CWD Execution 36107 36108 001015'01 $xcwd: extern strbuf, strptr ; Defined in k20mit 36109 001015'01 260 17 0 00 000005* call statim ;[189] Start timing so k20pdc doesn't choke 36110 36111 001016'01 403 01 0 00 000002 setzb t1, t2 ;[220] Cons up some .chnul's 36112 001017'01 124 01 0 00 000000* dmovem t1, strbuf ;[220] Zero out old stuff 36113 001020'01 124 01 0 00 000000# dmovem t1, strbuf+2 ;[220] and a bit more of it 36114 001021'01 200 02 0 00 006420' move t2, [ point 7, strbuf ] ;[220] Point to string buffer 36115 001022'01 202 02 0 00 000000* movem t2, strptr ;[220] Save current location 36116 36117 001023'01 201 04 0 00 000103 movei t4, "C" ; CWD generic command letter 36118 001024'01 136 04 0 00 000002 idpb t4, t2 ;[220] First character of data 36119 001025'01 133 00 0 00 000002 ibp t2 ; Leave room for length. 36120 36121 001026'01 332 01 0 00 000741* skipe t1, pars3 ;[220] But!! Did they specify a directory? 36122 001027'01 254 00 0 00 001036' ifskp. ;[220] They did not, we're done 36123 dmove t3, [ ;[220] Force zero length data area 36124 .chspc ;[220] Space is ASCII for zero length 36125 001030'01 120 03 0 00 006421' point 7,strbuf,13 ] ;[220] Point to second character in packet 36126 001031'01 137 03 0 00 000004 dpb t3, t4 ;[220] Deposit count at head of field. 36127 001032'01 200 01 0 00 001022* move t1, strptr ;[220] Point to beginning of packet (before "C") 36128 001033'01 201 02 0 00 000107 movei t2, "G" ;[220] Packet type is generic 36129 001034'01 254 00 0 00 005406' callret dosrv ;[220] Go send it, handle the reply and return 36130 001035'01 254 00 0 00 001037' else. ;[220] Otherwise, have a directory to copy 36131 001036'01 400 03 0 00 000000 setz t3, ;[220] Initialize counter 36132 001037'01 endif. ;[220] End case default area 36133 36134 001037'01 do. ; Enter loop context to copy directory 36135 001037'01 134 04 0 00 000001 ildb t4, t1 ; Pick up a byte of the directory 36136 001040'01 322 04 0 00 001043' jumpe t4, endlp. ; Stop at the end of the string 36137 001041'01 136 04 0 00 000002 idpb t4, t2 ; Deposit it in string buffer 36138 001042'01 344 03 0 00 001037' aoja t3, top. ; Get some more bytes, weee!! 36139 001043'01 enddo. ; End of loop context 36140 36141 ; Note that lengths here apply to UNPREFIXED values. If a length 36142 ; turns out to be the same as a prefix character, it will be quoted 36143 ; itself. 36144 36145 001043'01 200 04 0 00 006422' move t4, [point 7, strbuf, 13] ; Deposit count at head of field. 36146 001044'01 271 03 0 00 000040 addi t3, 40 ; Make it printable. 36147 001045'01 137 03 0 00 000004 dpb t3, t4 36148 36149 001046'01 336 00 0 00 001013* ifmn. pars4 ; Got a password too? 36150 001047'01 254 00 0 00 001063' 36151 001050'01 202 02 0 00 001032* movem t2, strptr ; Yes. Save current pointer. 36152 001051'01 133 00 0 00 000002 ibp t2 ; Save a place for length of this field. 36153 001052'01 400 03 0 00 000000 setz t3, ; Reset counter for new field. 36154 001053'01 200 01 0 00 001046* move t1, pars4 ; Load pointer to password 36155 001054'01 do. ; Enter loop context to copy that over 36156 001054'01 134 04 0 00 000001 ildb t4, t1 ; Get a character from the password 36157 001055'01 322 04 0 00 001060' jumpe t4, endlp. ; If zero, done. 36158 001056'01 136 04 0 00 000002 idpb t4, t2 ; Append it 36159 001057'01 344 03 0 00 001054' aoja t3, top. ; Count it & loop. 36160 001060'01 enddo. ; End loop context k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 19:42 30-Mar-24 Page 14-1 K20SRV MAC 30-Mar-24 15:37 REMOTE CWD Execution 36161 001060'01 136 04 0 00 000002 idpb t4, t2 ; Make it asciz. 36162 001061'01 271 03 0 00 000040 addi t3, 40 ; Make count printable. 36163 001062'01 136 03 0 00 001050* idpb t3, strptr ; Deposit it at head of field. 36164 001063'01 endif. ; End case password supplied 36165 ; Point to completed buffer 36166 dmove t1, [ point 7, strbuf 36167 001063'01 120 01 0 00 006423' "G" ] ; Packet type is H. 36168 001064'01 254 00 0 00 005406' jrst dosrv ; Go send it and handle the reply. 36169 36170 k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 19:42 30-Mar-24 Page 15 K20SRV MAC 30-Mar-24 15:37 LOCAL CDUP Parsing 36171 subttl LOCAL CDUP Parsing 36172 36173 ;[254] Begin code insertion for Parsing and execution for CDUP 36174 36175 chgsec(code,const) ;;Chained FDB's are not in code, they're in const 36176 000126'02 010004 000000 ycufdb: flddb. .cmcfm,,,,, 36177 000127'02 000000 000000 36178 000130'02 44 07 0 00 000476' 36179 retsec ;;Get back to wherever we came from 36180 36181 001065'01 .ycdup: entry .ycdup ; Invoked by k20par 36182 001065'01 265 16 0 00 006357' saveac ; Necessary for intermediate parse results 36183 36184 001066'01 200 16 0 00 000000# .ycdp1: guide ;[255] parse linkage from CWD 36185 001067'01 260 17 0 00 000707* 36186 000131'02 000000000000# 36187 000260'04 164 157 040 165 160 36188 001070'01 201 01 0 00 000000# movei t1, ycufdb ; Parsing isn't going to be particularly complex .. 36189 001071'01 260 17 0 00 000743* call rfield ; Go parse the confirm 36190 001072'01 120 05 0 00 000001 dmove q1, t1 ; Store the parse results 36191 001073'01 135 07 0 00 006275' ldb q3, [pointr (.cmfnp(t3),cm%fnc)] ; Get function code 36192 36193 001074'01 306 07 0 00 000010 cain q3, .cmcfm ; Was it NOT a bare confirm? 36194 001075'01 254 00 0 00 001105' ifskp. ; It wasn't! How did we get that?? 36195 001076'01 561 01 0 00 000170* hrroi t1, atmbuf ; Point to the atom buffer 36196 001077'01 104 00 0 00 000313 ESOUT% ; Start complaining 36197 001100'01 320 12 0 00 000775* erjmpr cmder1 ; Catch a bogon and allow reparse 36198 txmsg < is not a valid CDUP parameter 36199 001101'01 200 01 0 00 000000# > ; Finish up the blat 36200 001102'01 104 00 0 00 000076 36201 001103'01 320 12 0 00 001104' 36202 000132'02 000000000000# 36203 000267'04 040 151 163 040 156 36204 36205 001104'01 254 00 0 00 001100* callret cmder1 ; Allow a reparse, however 36206 001105'01 endif. ; End case highly bogus non-confirm 36207 36208 remark ; Side-effect internal storage in case ^C 36209 001105'01 260 17 0 00 000305' call udjinf ; Get currently connected directory 36210 001106'01 200 02 0 00 000000# move t2, .jidno+jobtab ; Load from side-effected main storage 36211 001107'01 202 02 0 00 001026* movem t2, pars3 ; Pass in to semantic action 36212 001110'01 263 17 0 00 000000 ret ; Otherwise, done 36213 k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 19:42 30-Mar-24 Page 16 K20SRV MAC 30-Mar-24 15:37 LOCAL CDUP Execution 36214 subttl LOCAL CDUP Execution 36215 36216 001111'01 $ycdup: entry $ycdup ; Invoked by k20par 36217 001111'01 265 16 0 00 006357' saveac ; Need some local fast scratch 36218 001112'01 403 01 0 00 000002 setzb t1, t2 ; Cons up ten NUL's 36219 001113'01 124 01 0 00 000000# dmovem t1, dirbuf ; Give the directory buffer a tiny scrub a dub 36220 001114'01 561 01 0 00 000000# hrroi t1, dirbuf ; Load Tops-20 pointer to directory buffer 36221 001115'01 200 02 0 00 001107* move t2,pars3 ; Load the currently connected directory 36222 001116'01 104 00 0 00 000041 DIRST% ; Translate into a string, checking for oddness 36223 001117'01 320 12 0 00 001121' %jserr (,r) 36224 001120'01 254 00 0 00 001124' 36225 001121'01 265 01 0 00 000602* 36226 001122'01 000000000000# 36227 001123'01 254 00 0 00 000677* 36228 000276'04 103 104 125 120 040 36229 36230 001124'01 200 06 0 00 006425' move q2, [point 7,dirbuf] ;Hardware pointer to directory buffer 36231 001125'01 200 01 0 00 000006 move t1, q2 ; Copy for local usage 36232 001126'01 400 03 0 00 000000 setz t3, ; Last dot we saw 36233 36234 001127'01 do. ; Enter loop context 36235 001127'01 134 02 0 00 000001 ildb t2, t1 ; Pick up a byte 36236 001130'01 322 02 0 00 001136' jumpe t2, endlp. ; Stop if off the end of the string (wierd...) 36237 001131'01 306 02 0 00 000076 cain t2, .chrpt ; At end of directory specification? 36238 001132'01 254 00 0 00 001136' exit. ; Yes, so done with the loop 36239 001133'01 306 02 0 00 000056 cain t2, "." ; Hit a dot?? 36240 001134'01 200 03 0 00 000001 move t3, t1 ; Yes, remember pointer to the last one seen 36241 001135'01 254 00 0 00 001127' loop. ; Grovel to the end of the string 36242 001136'01 enddo. ; Exit loop context 36243 36244 001136'01 326 03 0 00 001150' ife. t3 ; If never saw a dot, at top-level 36245 001137'01 200 01 0 00 000000# txmsg <[Remaining connected to top-level directory > 36246 001140'01 104 00 0 00 000076 36247 001141'01 320 12 0 00 001142' 36248 000133'02 000000000000# 36249 000312'04 133 122 145 155 141 36250 001142'01 200 01 0 00 000006 move t1, q2 ; Load pointer to string 36251 001143'01 104 00 0 00 000076 PSOUT% ; Type it 36252 txmsg <] 36253 001144'01 200 01 0 00 000000# > ; Tie off the line 36254 001145'01 104 00 0 00 000076 36255 001146'01 320 12 0 00 001147' 36256 000134'02 000000000000# 36257 000323'04 135 015 012 000 000 36258 001147'01 263 17 0 00 000000 ret ; Done doing plenty of nothing much... 36259 001150'01 endif. ; End case at top-level 36260 ; Otherwise, change directory specification 36261 001150'01 120 01 0 00 006426' dmove t1, [exp .chrpt,0] ;Load closing punctuation 36262 001151'01 137 01 0 00 000003 dpb t1, t3 ; Stomp the dot with closing punctuation 36263 001152'01 136 02 0 00 000003 idpb t2, t3 ; Close off the string 36264 ; Convert our masterpiece to internal format 36265 001153'01 205 01 0 00 000001 movx t1, rc%emo ; Must match this and only this directory 36266 001154'01 200 02 0 00 000006 move t2, q2 ; Load pointer to munged directory 36267 001155'01 400 03 0 00 000000 setz t3, ; Not doing any stepping 36268 001156'01 104 00 0 00 000553 RCDIR% ; See if we can recognize it k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 19:42 30-Mar-24 Page 16-1 K20SRV MAC 30-Mar-24 15:37 LOCAL CDUP Execution 36269 001157'01 607 01 0 00 070000 ifxn. t1, rc%nom!rc%amb!rc%nmd 36270 001160'01 254 00 0 00 001177' 36271 001161'01 200 01 0 00 000006 move t1, q2 ; Load pointer to constructed directory 36272 001162'01 104 00 0 00 000313 ESOUT% ; Start whining 36273 001163'01 320 12 0 00 001123* erjmpr r ; Ignore error and return 36274 001164'01 200 01 0 00 000000# txmsg < was not recognized as a valid directory, > 36275 001165'01 104 00 0 00 000076 36276 001166'01 320 12 0 00 001167' 36277 000135'02 000000000000# 36278 000324'04 040 167 141 163 040 36279 dmove t1, [ .priou ; Continue to type on terminal 36280 001167'01 120 01 0 00 006430' .fhslf,,-1 ] ; This process, last error 36281 001170'01 400 03 0 00 000000 setz t3, ; Let it blat as much as it wants 36282 001171'01 104 00 0 00 000011 ERSTR% ; Display last Tops-20 error 36283 001172'01 320 14 0 00 001174' erjmps .+2 ; Ignore strange return 36284 001173'01 320 14 0 00 001174' erjmps .+1 ; Ignore stranger return 36285 001174'01 561 01 0 00 000632* hrroi t1,crlf ; Tie off the line 36286 001175'01 104 00 0 00 000076 PSOUT% 36287 001176'01 263 17 0 00 000000 ret ; Done, can't connect to it 36288 001177'01 endif. ; End case couldn't recognize the directory 36289 36290 001177'01 200 07 0 00 000003 move q3, t3 ; Store the directory number, just in case 36291 001200'01 200 01 0 00 006354' movx t1, ac%con!3 ; Doing a connect, block is three words long 36292 001201'01 201 02 0 00 000003 movei t2, t3 ; Argument block begins in AC3 36293 001202'01 120 04 0 00 006432' dmove t4, [ exp 0, -1 ] ; No password, this job 36294 001203'01 104 00 0 00 000552 ACCES% ; Try the connect 36295 001204'01 320 12 0 00 001206' %jserr (,r) 36296 001205'01 254 00 0 00 001211' 36297 001206'01 265 01 0 00 001121* 36298 001207'01 000000000000# 36299 001210'01 254 00 0 00 001163* 36300 000335'04 125 156 141 142 154 36301 36302 001211'01 260 17 0 00 000305' call udjinf ; Update currently connected directory 36303 001212'01 200 01 0 00 000000# txmsg <[Connected to > ; Inform us of new location 36304 001213'01 104 00 0 00 000076 36305 001214'01 320 12 0 00 001215' 36306 000136'02 000000000000# 36307 000345'04 133 103 157 156 156 36308 001215'01 200 01 0 00 000006 move t1, q2 ; Point to what we constructed 36309 001216'01 104 00 0 00 000076 PSOUT% ; Type it 36310 txmsg <] 36311 001217'01 200 01 0 00 000000# > ; Tie off the line 36312 001220'01 104 00 0 00 000076 36313 001221'01 320 12 0 00 001222' 36314 000137'02 000000000000# 36315 000350'04 135 015 012 000 000 36316 001222'01 263 17 0 00 000000 ret ; Done 36317 k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 19:42 30-Mar-24 Page 17 K20SRV MAC 30-Mar-24 15:37 REMOTE CDUP Execution 36318 subttl REMOTE CDUP Execution 36319 36320 remark REMOTE CDUP parsing 36321 36322 001223'01 200 16 0 00 000000# .xcdup: guide 36323 001224'01 260 17 0 00 001067* 36324 000140'02 000000000000# 36325 000351'04 164 157 040 165 160 36326 001225'01 260 17 0 00 000763* confrm ; Very complicated parsing ... 36327 001226'01 263 17 0 00 000000 ret 36328 36329 remark REMOTE PWD execution 36330 36331 001227'01 260 17 0 00 001015* $xcdup: call statim ; Start timing so k20pdc doesn't choke 36332 dmove t1, [ ; ;G command is for CDUP 36333 point 7, [asciz/G/] ; 'G' command for data field. 36334 001230'01 120 01 0 00 006435' "G" ] ; Packet type is G. 36335 001231'01 254 00 0 00 005406' jrst dosrv 36336 36337 ;[254] End code Insertion for Parsing and execution for CDUP 36338 k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 19:42 30-Mar-24 Page 18 K20SRV MAC 30-Mar-24 15:37 LOCAL DELETE parsing 36339 subttl LOCAL DELETE parsing 36340 36341 chgsec(code,const) ;;Parsing and tables go in constants 36342 000141'02 100120 777775 delbk: gj%old!gj%ifg!gj%flg!.gjall ; Flag bits,,generation number. 36343 000142'02 000100 000101 .priin,,.priou ; COMND i/o. 36344 repeat 6,<0> ; No defaults, except all generations. 36345 000143'02 000000 000000 36346 000144'02 000000 000000 36347 000145'02 000000 000000 36348 000146'02 000000 000000 36349 000147'02 000000 000000 36350 000150'02 000000 000000 36351 000010 delbkl==<.-delbk> ; Length of this GTJFN argument block. 36352 36353 000151'02 006000 000000 ydefdb: flddb. .cmfil 36354 000152'02 000000 000000 36355 retsec 36356 36357 001232'01 .ydele: entry .ydele ; Invoked from k20par 36358 001232'01 200 01 0 00 006437' movx t1, cz%ncl!.fhslf ; Close any nonopen JFNs. 36359 001233'01 104 00 0 00 000034 CLZFF 36360 001234'01 200 16 0 00 000000# guide ; Issue guide words. 36361 001235'01 260 17 0 00 001224* 36362 000153'02 000000000000# 36363 000360'04 146 151 154 145 163 36364 001236'01 200 01 0 00 006440' move t1, [delbk,,cjfnbk] ; Insert our file parsing defaults. 36365 001237'01 251 01 0 00 000000# blt t1, cjfnbk+delbkl 36366 001240'01 201 01 0 00 000000# movei t1, ydefdb 36367 001241'01 260 17 0 00 000000* call cfield 36368 001242'01 202 02 0 00 001115* movem t2, pars3 ; Here's the JFN just parsed. 36369 001243'01 550 01 0 00 000002 hrrz t1,t2 ;[193] Load the JFN, sans flags 36370 001244'01 260 17 0 00 000104* call isnulj ;[193] Is this NUL:? 36371 001245'01 254 00 0 00 001250' ifskp. ;[193] Yes, so let's fix up the parse 36372 001246'01 202 01 0 00 001242* movem t1, pars3 ;[193] Store the .nulio in there 36373 001247'01 200 02 0 00 000001 move t2,t1 ;[193] Leave for anybody downstream 36374 001250'01 endif. ;[193] 36375 001250'01 263 17 0 00 000000 ret 36376 k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 19:42 30-Mar-24 Page 19 K20SRV MAC 30-Mar-24 15:37 [113] LOCAL DELETE execution 36377 subttl [113] LOCAL DELETE execution 36378 36379 001251'01 $ydele: entry $ydele ; Invoked from k20par 36380 36381 extern ffunc ; File function being performed 36382 001251'01 550 01 0 00 001246* hrrz t1, pars3 ; Load parsed JFN 36383 001252'01 260 17 0 00 005474' call isdird ;[193] Is this a directory device? 36384 001253'01 254 00 0 00 001266' ifskp. ;[193] If worked, proceed 36385 001254'01 201 02 0 00 006004' movei t2, delfil ; Address of delete-file code. 36386 001255'01 202 02 0 00 000000* movem t2, ffunc ; Make it the file function. 36387 001256'01 332 00 0 00 000000* ifme. expung ;[199] Can only speed up the non-expunge case 36388 001257'01 254 00 0 00 001264' 36389 001260'01 200 01 0 00 001251* move t1, pars3 ;[199] Reload the parsed JFN with flags 36390 001261'01 260 17 0 00 005725' call ffjfgd ;[199] Fix file JFN for fast generational delete 36391 001262'01 254 00 0 00 001752' callret $ydir1 ;[199] Failed or exact generation; do each file by hand 36392 001263'01 202 01 0 00 001260* movem t1, pars3 ;[199] Store the updated JFN with flags 36393 001264'01 endif. ;[199] End case not expunging 36394 001264'01 254 00 0 00 001752' callret $ydir1 ; Go do it like a directory. 36395 001265'01 254 00 0 00 001322' else. ;[193] Otherwise, not a directory device (or failed) 36396 001266'01 265 16 0 00 000653* anstkv (t4,^d4) ;[193] Allocate an anonymous stack variable 36397 001267'01 000000 000004 36398 001270'01 415 04 0 17 777773 36399 001271'01 200 02 0 00 000001 move t2, t1 ;[193] Save the device designator 36400 001272'01 560 01 0 00 000004 hrro t1, t4 ;[193] Create pointer to stack space 36401 001273'01 104 00 0 00 000121 DEVST% ;[193] Convert to a string 36402 001274'01 320 12 0 00 001276' ifje. r ;[193] Failed?? 36403 001275'01 254 00 0 00 001301' 36404 001276'01 200 03 0 00 000001 move t3, t1 ;[193] Save error for debugger 36405 001277'01 561 04 0 00 001322' hrroi t4, badevc ;[193] Load a default 36406 001300'01 254 00 0 00 001305' else. ;[193] Otherwise, we have a good device 36407 001301'01 120 02 0 00 006441' dmove t2, [exp ":", .chnul] ;[193] 36408 001302'01 136 02 0 00 000001 idpb t2, t1 ;[193] Punctuate device 36409 001303'01 136 03 0 00 000001 idpb t3, t1 ;[193] Tie off the string 36410 001304'01 661 04 0 00 777777 tlo t4, -1 ;[193] So turn it into a pointer 36411 001305'01 endif. ;[193] End case DEVST% error handling 36412 001305'01 200 01 0 00 000004 move t1, t4 ;[193] Load pointer to something 36413 001306'01 104 00 0 00 000313 ESOUT% ;[193] Start complaining 36414 001307'01 200 01 0 00 000000# txmsg < has no directory to delete files from> ;[193] 36415 001310'01 104 00 0 00 000076 36416 001311'01 320 12 0 00 001312' 36417 000154'02 000000000000# 36418 000362'04 040 150 141 163 040 36419 001312'01 561 01 0 00 001174* hrroi t1, crlf ;[193] Newline 36420 001313'01 104 00 0 00 000076 PSOUT% ;[193] 36421 001314'01 400 01 0 00 000000 setz t1, ;[193] Cons up a zero 36422 001315'01 250 01 0 00 001263* exch t1, pars3 ;[193] Get and clear parsed JFN 36423 001316'01 621 01 0 00 777777 tlz t1, -1 ;[193] Clear any goofy flags 36424 001317'01 104 00 0 00 000023 RLJFN% ;[193] Punt it 36425 001320'01 320 12 0 00 001321' erjmpr .+1 ;[193] Catch and ignore error 36426 001321'01 263 17 0 00 000000 ret ;[193] And get out of here 36427 001322'01 endif. ;[193] End case device check 36428 36429 001322'01 125 156 153 156 157 badevc: asciz "Unknown device" 36430 k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 19:42 30-Mar-24 Page 20 K20SRV MAC 30-Mar-24 15:37 REMOTE DELETE, DIRECTORY, TYPE parsing 36431 subttl REMOTE DELETE, DIRECTORY, TYPE parsing 36432 36433 chgsec(code,const) ;;Chained FDB's are not in code, they're in const 36434 000155'02 021004 000160' rmffdb: flddb. .cmqst,,,,,rmffd1 36435 000156'02 000000 000000 36436 000157'02 44 07 0 00 000507' 36437 000160'02 017004 000000 rmffd1: flddb. .cmtxt,,,,, 36438 000161'02 000000 000000 36439 000162'02 44 07 0 00 000507' 36440 retsec 36441 cleans() 36442 36443 001325'01 200 16 0 00 000000# .rmfil: guide ; Parse the rest of the command. 36444 001326'01 260 17 0 00 001235* 36445 000163'02 000000000000# 36446 000372'04 162 145 155 157 164 36447 001327'01 201 01 0 00 000000# movei t1, rmffdb ;[220] Allow a quote of the remote file specification 36448 001330'01 260 17 0 00 001241* call cfield 36449 001331'01 263 17 0 00 000000 ret 36450 k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 19:42 30-Mar-24 Page 21 K20SRV MAC 30-Mar-24 15:37 REMOTE DELETE (Erase) execution 36451 subttl REMOTE DELETE (Erase) execution 36452 36453 001332'01 336 00 0 00 000000* $xdele: ifmn. tlgjfn ;[233] Doing transaction logging? 36454 001333'01 254 00 0 00 001355' 36455 001334'01 415 16 0 00 001355' block. ;[233] Get a stack frame 36456 001335'01 261 17 0 00 000016 36457 001336'01 265 16 0 00 006314' saveac ;[233] Save even the temporaries 36458 001337'01 476 00 0 00 000000* setom scrlft ;[233] Suppress the trailing line feed 36459 001340'01 265 01 0 00 000000* wtlog(,) ;[233] 36460 001341'01 000000000000# 36461 001342'01 777777 777743 36462 001343'01 000000 000000 36463 000375'04 122 145 161 165 145 36464 001344'01 200 01 0 00 001332* move t1, tlgjfn ;[233] Put the file name name in the log 36465 001345'01 561 02 0 00 001076* hrroi t2,atmbuf ;[233] It's in the atom buffer 36466 001346'01 403 03 0 00 000004 setzb t3,t4 ;[233] Don't know how long, stop on a NUL 36467 001347'01 104 00 0 00 000053 SOUT% ;[233] Out it goes! 36468 001350'01 320 14 0 00 001351' erjmps .+1 ;[233] Catch and suppress error 36469 dmove t2,[ -1,,crlf ;[233] Tops-20 pointer to carriage return line feed 36470 001351'01 120 02 0 00 006443' -2 ] ;[233] Counted SOUT%'s are faster 36471 001352'01 104 00 0 00 000053 SOUT% ;[233] Out it goes! 36472 001353'01 320 14 0 00 001354' erjmps .+1 ;[233] Catch and suppress error 36473 001354'01 263 17 0 00 000000 endbk. ;[233] Release stack frame, restoring AC's 36474 001355'01 endif. ;[233] 36475 36476 001355'01 260 17 0 00 001227* call statim ;[189] Start timing so k20pdc doesn't choke 36477 001356'01 201 04 0 00 000105 movei t4, "E" ; Generic command is E. 36478 001357'01 254 00 0 00 005362' jrst srvfil 36479 k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 19:42 30-Mar-24 Page 22 K20SRV MAC 30-Mar-24 15:37 DIRECTORY command 36480 subttl DIRECTORY command 36481 36482 ; Default wildcard filespec fields for .CMFIL: 36483 36484 chgsec(code,const) ;;Tables and fdb's go in const 36485 000164'02 100120 777775 dirbk: gj%old!gj%ifg!gj%flg!.gjall ; Flag bits,,generation number. 36486 000165'02 000100 000101 .priin,,.priou ; COMND i/o. 36487 repeat 2,<0> ; Normal defaults for dev: and gen. 36488 000166'02 000000 000000 36489 000167'02 000000 000000 36490 repeat 2,)> ; *.* for name and type. 36491 000170'02 000000000000# 36492 000403'04 052 000 000 000 000 36493 000171'02 000000000000# 36494 000404'04 052 000 000 000 000 36495 36496 000172'02 000000000000# 0 ; Default protection, 36497 000173'02 000000 000000 0 ; and account. 36498 000010 dirbkl==<.-dirbk> ; Length of this GTJFN argument block. 36499 36500 000174'02 wldfil: remark ;[252] Wild card specification for all files 36501 000174'02 000000 000052 byte (1) 0 (7) .chnul,.chnul,.chnul,.chnul,"*" 36502 000175'02 134522 712472 byte (1) 0 (7) ".","*",".","*",":" 36503 000013 wldmax==^d<<<6+1+1+39+6>/5>+1> ;[252] Maximum size file specific from above 36504 36505 000176'02 010004 000201' ydifdb: flddb. .cmcfm,,,,,ydifd1 36506 000177'02 000000 000000 36507 000200'02 44 07 0 00 000515' 36508 000201'02 011004 000204' ydifd1: flddb. .cmdir,,,,,ydifd2 36509 000202'02 000000 000000 36510 000203'02 44 07 0 00 000526' 36511 000204'02 016004 000207' ydifd2: flddb. .cmdev,,,,,ydifd3 36512 000205'02 000000 000000 36513 000206'02 44 07 0 00 000534' 36514 000207'02 006004 000000 ydifd3: flddb. .cmfil,,,,, 36515 000210'02 000000 000000 36516 000211'02 44 07 0 00 000541' 36517 retsec 36518 cleans() 36519 36520 001360'01 .ydire: entry .ydire ; Invoked from k20par 36521 001360'01 265 16 0 00 006357' saveac ;[252] Needs some registers for things... 36522 001361'01 403 05 0 00 000006 setzb q1, q2 ;[252] Initialize to known values 36523 001362'01 403 07 0 00 000010 setzb q3, q4 ;[252] 36524 36525 001363'01 200 01 0 00 006445' move t1, [dirbk,,cjfnbk] ; Insert our file parsing defaults. 36526 001364'01 251 01 0 00 000000# blt t1, cjfnbk+dirbkl 36527 001365'01 200 01 0 00 006437' movx t1, cz%ncl!.fhslf ; Close any nonopen JFNs. 36528 001366'01 104 00 0 00 000034 CLZFF 36529 001367'01 320 12 0 00 001370' erjmpr .+1 36530 36531 dmove t1, [ .fhslf ;[252] This process 36532 001370'01 120 01 0 00 006446' LSTRX1 ] ;[252] "Process has not encountered any errors" 36533 001371'01 104 00 0 00 000336 SETER% ;[252] Clear last error, if any 36534 001372'01 320 12 0 00 001647' erjmpr ydirer ;[252] System is very ill, go drop dead k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 19:42 30-Mar-24 Page 22-1 K20SRV MAC 30-Mar-24 15:37 DIRECTORY command 36535 36536 001373'01 200 16 0 00 000000# guide ; Issue guide words. 36537 001374'01 260 17 0 00 001326* 36538 000212'02 000000000000# 36539 000405'04 157 146 040 146 151 36540 001375'01 201 01 0 00 000000# movei t1, ydifdb ;[193] 36541 001376'01 260 17 0 00 001071* call rfield ;[193] Parse for a file, really 36542 001377'01 200 05 0 00 000002 move q1, t2 ;[193] Store whatever we got 36543 001400'01 135 07 0 00 006275' ldb q3, [pointr (.cmfnp(t3),cm%fnc)] ;[193] Get function code. 36544 36545 001401'01 302 07 0 00 000010 caie q3, .cmcfm ;[252] Just confirmed? 36546 001402'01 254 00 0 00 001456' ifskp. ;[252] He did 36547 001403'01 265 16 0 00 001266* anstkv(q4,wldmax) ;[252] Enough space to build the complete specification 36548 001404'01 000000 000013 36549 001405'01 415 10 0 17 777764 36550 001406'01 201 01 0 00 000013 movx t1, wldmax ;[252] Load size of space to zero 36551 001407'01 200 02 0 00 000010 move t2, q4 ;[252] Load address to zero 36552 001410'01 201 03 0 02 000001 movei t3, 1(t2) ;[252] Cascading zero 36553 001411'01 402 00 0 02 000000 setzm (t2) ;[252] Whack the first location 36554 001412'01 373 00 0 00 000001 sosle t1 ;[252] Account for zapped location 36555 001413'01 123 01 0 00 006313' extend t1,[xblt] ;[252] Whack the rest if any left to do 36556 001414'01 104 00 0 00 000013 GJINF% ;[252] Get our current job particulars 36557 001415'01 320 12 0 00 001647' erjmpr ydirer ;[252] Should never fail, but ... 36558 001416'01 560 01 0 00 000010 hrro t1, q4 ;[252] Build a Tops-20 pointer to the stack 36559 001417'01 104 00 0 00 000041 DIRST% ;[252] Turn it into a string 36560 001420'01 320 12 0 00 001647' erjmpr ydirer ;[252] Failed on a valid parse item?? 36561 001421'01 120 02 0 00 000000# dmove t2, wldfil ;[252] Load the file specification 36562 001422'01 242 03 0 00 777771 lsh t3, -^d7 ;[252] Skip the colon as DIRST% already put it there 36563 repeat ^d4,< ;[252] Unroll the loop (easier logic) 36564 idpb t3, t1 ;[252] Deposit a byte of the file specification 36565 lsh t3, -^d7 ;[252] Get the next byte in 36566 >;; repeat ^d4 ;[252] End of first word 36567 001423'01 136 03 0 00 000001 36568 001424'01 242 03 0 00 777771 36569 001425'01 136 03 0 00 000001 36570 001426'01 242 03 0 00 777771 36571 001427'01 136 03 0 00 000001 36572 001430'01 242 03 0 00 777771 36573 001431'01 136 03 0 00 000001 36574 001432'01 242 03 0 00 777771 36575 36576 repeat ^d2,< ;[252] Unroll the loop (easier logic) 36577 idpb t2, t1 ;[252] Deposit a byte of the file specification 36578 lsh t2, -^d7 ;[252] Get the next byte in 36579 >;; repeat ^d2 ;[252] End of second word 36580 001433'01 136 02 0 00 000001 36581 001434'01 242 02 0 00 777771 36582 001435'01 136 02 0 00 000001 36583 001436'01 242 02 0 00 777771 36584 36585 001437'01 200 01 0 00 000000# move t1, dirbk ;[252] Load GTJFN flags 36586 001440'01 560 02 0 00 000010 hrro t2, q4 ;[252] Make a Tops-20 pointer to completed specification 36587 001441'01 104 00 0 00 000020 GTJFN% ;[252] See if Tops-20 will default something nice 36588 001442'01 320 12 0 00 001647' erjmpr ydirer ;[252] Nope, fail the parse 36589 001443'01 200 05 0 00 000001 move q1, t1 ;[252] Replace previously parsed item k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 19:42 30-Mar-24 Page 22-2 K20SRV MAC 30-Mar-24 15:37 DIRECTORY command 36590 001444'01 603 05 0 00 200000 txne q1, gj%unt ;[251] Compensate for misdocumentation ... 36591 001445'01 661 05 0 00 400000 txo q1, gj%dev ;[251] ... in JSYS_REFERENCE 36592 001446'01 621 01 0 00 777777 tlz t1, -1 ;[252] Stomp the flags so DVCHR% doesn't choke 36593 001447'01 104 00 0 00 000117 DVCHR% ;[252] Find out all about it 36594 001450'01 320 12 0 00 001647' erjmpr ydirer ;[252] How is that possible? We have a valid JFN!! 36595 001451'01 200 06 0 00 000002 move q2, t2 ;[252] Save device characteristics 36596 001452'01 124 05 0 00 001315* dmovem q1, pars3 ;[252] Pass parsed item and characteristics 36597 001453'01 201 07 0 00 000006 movx q3, .cmfil ;[252] Pretend we parsed a file specification 36598 001454'01 202 07 0 00 000550* movem q3, pars5 ;[252] Pass parse type 36599 001455'01 263 17 0 00 000000 ret ;[252] All done! 36600 001456'01 endif. ;[252] End case simple confirm 36601 36602 001456'01 306 07 0 00 000011 cain q3, .cmdir ;[252] A directory will never be NUL: ... 36603 001457'01 254 00 0 00 001474' ifskp. ;[252] Not a directory, go figure it out 36604 001460'01 200 01 0 00 000002 move t1, t2 ;[252] Position for investigation 36605 001461'01 306 07 0 00 000006 cain q3, .cmfil ;[252] A file? (I.E., a JFN?) 36606 001462'01 621 01 0 00 777777 tlz t1, -1 ;[252] Yes, toss the flags 36607 001463'01 260 17 0 00 001244* call isnulj ;[252] Is this some flavor of NUL:? 36608 001464'01 254 00 0 00 001474' ifskp. ;[252] It is, so use the special moniker (.nulio) 36609 001465'01 200 05 0 00 000001 move q1, t1 ;[252] Replace what we got 36610 001466'01 260 17 0 00 001225* confrm ;[252] Tie off the line 36611 001467'01 200 06 0 00 006450' move q2, [dv%out!dv%in!dv%av!fld(.dvnul,dv%typ)!dv%psd!fld(-1,dv%mod)] ;[252] 36612 001470'01 124 05 0 00 001452* dmovem q1, pars3 ;[252] Pass parsed item and characteristics 36613 001471'01 201 07 0 00 000016 movx q3, .cmdev ;[252] Pretend we parsed the raw device 36614 001472'01 202 07 0 00 001454* movem q3, pars5 ;[252] Pass parse type 36615 001473'01 263 17 0 00 000000 ret ;[252] Done 36616 001474'01 endif. ;[252] End case some flavor of NUL: 36617 001474'01 endif. ;[252] End case checking non-directory case of NUL: 36618 36619 001474'01 302 07 0 00 000016 caie q3, .cmdev ;[193] Picked up a device? 36620 001475'01 254 00 0 00 001552' ifskp. ;[193] Yes, let's see if we can work with it 36621 001476'01 200 01 0 00 000005 move t1, q1 ;[252] Load for DVCHR% 36622 001477'01 104 00 0 00 000117 DVCHR% ;[252] Find out all about it 36623 001500'01 320 12 0 00 001647' erjmpr ydirer ;[252] How is that possible? We just parsed it! 36624 001501'01 607 02 0 00 120000 txnn t2,dv%dir!dv%mdd ;[252] File structure (or DECtape)? 36625 001502'01 254 00 0 00 001647' jrst ydirer ;[252] No, then surely can't list it 36626 001503'01 200 06 0 00 000002 move q2, t2 ;[252] Save device characteristics 36627 001504'01 265 16 0 00 001403* anstkv(q4,^d6) ;[252] 29 characters of device name and files 36628 001505'01 000000 000006 36629 001506'01 415 10 0 17 777771 36630 001507'01 403 01 0 00 000002 setzb t1, t2 ;[252] Cons up some zeros 36631 001510'01 124 01 0 10 000000 dmovem t1, ^d0(q4) ;[252] Let's scrub a bit of it 36632 001511'01 124 01 0 10 000002 dmovem t1, ^d2(q4) ;[252] and a bit more 36633 001512'01 124 01 0 10 000004 dmovem t1, ^d4(q4) ;[252] and the rest of it 36634 001513'01 560 01 0 00 000010 hrro t1, q4 ;[193] Create a Tops-20 ASCII pointer 36635 001514'01 200 02 0 00 000005 move t2, q1 ;[252] Load the 36636 001515'01 104 00 0 00 000121 DEVST% ;[193] Turn it into a string (I hope) 36637 001516'01 320 12 0 00 001647' erjmpr ydirer ;[252] Failed on a valid parse item?? 36638 001517'01 120 02 0 00 000000# dmove t2, wldfil ;[252] Load the file specification 36639 repeat ^d5,< ;[252] Unroll the loop (easier logic) 36640 idpb t3, t1 ;[252] Deposit a byte of the file specification 36641 lsh t3, -^d7 ;[252] Get the next byte in 36642 >;; repeat ^d5 ;[252] End of first word 36643 001520'01 136 03 0 00 000001 36644 001521'01 242 03 0 00 777771 k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 19:42 30-Mar-24 Page 22-3 K20SRV MAC 30-Mar-24 15:37 DIRECTORY command 36645 001522'01 136 03 0 00 000001 36646 001523'01 242 03 0 00 777771 36647 001524'01 136 03 0 00 000001 36648 001525'01 242 03 0 00 777771 36649 001526'01 136 03 0 00 000001 36650 001527'01 242 03 0 00 777771 36651 001530'01 136 03 0 00 000001 36652 001531'01 242 03 0 00 777771 36653 36654 repeat ^d2,< ;[252] Unroll the loop (easier logic) 36655 idpb t2, t1 ;[252] Deposit a byte of the file specification 36656 lsh t2, -^d7 ;[252] Get the next byte in 36657 >;; repeat ^d2 ;[252] End of second word 36658 001532'01 136 02 0 00 000001 36659 001533'01 242 02 0 00 777771 36660 001534'01 136 02 0 00 000001 36661 001535'01 242 02 0 00 777771 36662 36663 001536'01 200 01 0 00 000000# move t1, dirbk ;[252] Load GTJFN flags 36664 001537'01 560 02 0 00 000010 hrro t2, q4 ;[252] Make a Tops-20 pointer to completed specification 36665 001540'01 104 00 0 00 000020 GTJFN% ;[252] See if Tops-20 will default something nice 36666 001541'01 320 12 0 00 001647' erjmpr ydirer ;[252] Nope, fail the parse 36667 001542'01 200 05 0 00 000001 move q1, t1 ;[252] Replace previously parsed item 36668 001543'01 603 05 0 00 200000 txne q1, gj%unt ;[251] Compensate for misdocumentation ... 36669 001544'01 661 05 0 00 400000 txo q1, gj%dev ;[251] ... in JSYS_REFERENCE 36670 001545'01 260 17 0 00 001466* confrm ;[252] Tie off the line 36671 001546'01 124 05 0 00 001470* dmovem q1, pars3 ;[252] Pass parsed item and characteristics 36672 001547'01 201 07 0 00 000006 movx q3, .cmfil ;[252] Pretend we parsed a file specification 36673 001550'01 202 07 0 00 001472* movem q3, pars5 ;[252] Pass parse type 36674 001551'01 263 17 0 00 000000 ret ;[252] Done 36675 001552'01 endif. ;[252] End case .cmdev 36676 36677 001552'01 302 07 0 00 000011 caie q3, .cmdir ;[252] Picked up a directory? 36678 001553'01 254 00 0 00 001627' ifskp. ;[252] Yes, let's see if we can work with it 36679 001554'01 265 16 0 00 001504* anstkv(q4,wldmax) ;[252] Enough space to build the complete specification 36680 001555'01 000000 000013 36681 001556'01 415 10 0 17 777764 36682 001557'01 201 01 0 00 000013 movx t1, wldmax ;[252] Load size of space to zero 36683 001560'01 200 02 0 00 000010 move t2, q4 ;[252] Load address to zero 36684 001561'01 201 03 0 02 000001 movei t3, 1(t2) ;[252] Cascading zero 36685 001562'01 402 00 0 02 000000 setzm (t2) ;[252] Whack the first location 36686 001563'01 373 00 0 00 000001 sosle t1 ;[252] Account for zapped location 36687 001564'01 123 01 0 00 006313' extend t1,[xblt] ;[252] Whack the rest if any left to do 36688 001565'01 560 01 0 00 000010 hrro t1, q4 ;[252] Build a Tops-20 pointer to the stack 36689 001566'01 200 02 0 00 000005 move t2, q1 ;[252] Load parsed directory 36690 001567'01 104 00 0 00 000041 DIRST% ;[252] Turn it into a string 36691 001570'01 320 12 0 00 001647' erjmpr ydirer ;[252] Failed on a valid parse item?? 36692 001571'01 120 02 0 00 000000# dmove t2, wldfil ;[252] Load the file specification 36693 001572'01 242 03 0 00 777771 lsh t3, -^d7 ;[252] Skip the colon as DIRST% already put it there 36694 repeat ^d4,< ;[252] Unroll the loop (easier logic) 36695 idpb t3, t1 ;[252] Deposit a byte of the file specification 36696 lsh t3, -^d7 ;[252] Get the next byte in 36697 >;; repeat ^d4 ;[252] End of first word 36698 001573'01 136 03 0 00 000001 36699 001574'01 242 03 0 00 777771 k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 19:42 30-Mar-24 Page 22-4 K20SRV MAC 30-Mar-24 15:37 DIRECTORY command 36700 001575'01 136 03 0 00 000001 36701 001576'01 242 03 0 00 777771 36702 001577'01 136 03 0 00 000001 36703 001600'01 242 03 0 00 777771 36704 001601'01 136 03 0 00 000001 36705 001602'01 242 03 0 00 777771 36706 36707 repeat ^d2,< ;[252] Unroll the loop (easier logic) 36708 idpb t2, t1 ;[252] Deposit a byte of the file specification 36709 lsh t2, -^d7 ;[252] Get the next byte in 36710 >;; repeat ^d2 ;[252] End of second word 36711 001603'01 136 02 0 00 000001 36712 001604'01 242 02 0 00 777771 36713 001605'01 136 02 0 00 000001 36714 001606'01 242 02 0 00 777771 36715 36716 001607'01 200 01 0 00 000000# move t1, dirbk ;[252] Load GTJFN flags 36717 001610'01 560 02 0 00 000010 hrro t2, q4 ;[252] Make a Tops-20 pointer to completed specification 36718 001611'01 104 00 0 00 000020 GTJFN% ;[252] See if Tops-20 will default something nice 36719 001612'01 320 12 0 00 001647' erjmpr ydirer ;[252] Nope, fail the parse 36720 001613'01 200 05 0 00 000001 move q1, t1 ;[252] Replace previously parsed item 36721 001614'01 603 05 0 00 200000 txne q1, gj%unt ;[251] Compensate for misdocumentation ... 36722 001615'01 661 05 0 00 400000 txo q1, gj%dev ;[251] ... in JSYS_REFERENCE 36723 001616'01 621 01 0 00 777777 tlz t1, -1 ;[252] Stomp the flags so DVCHR% doesn't choke 36724 001617'01 104 00 0 00 000117 DVCHR% ;[252] Find out all about it 36725 001620'01 320 12 0 00 001647' erjmpr ydirer ;[252] How is that possible? We have a valid JFN!! 36726 001621'01 200 06 0 00 000002 move q2, t2 ;[252] Save device characteristics 36727 001622'01 260 17 0 00 001545* confrm ;[252] Tie off the line 36728 001623'01 124 05 0 00 001546* dmovem q1, pars3 ;[252] Pass parsed item and characteristics 36729 001624'01 201 07 0 00 000006 movx q3, .cmfil ;[252] Pretend we parsed a file specification 36730 001625'01 202 07 0 00 001550* movem q3, pars5 ;[252] Pass parse type 36731 001626'01 263 17 0 00 000000 ret ;[252] Done 36732 001627'01 endif. ;[252] End case .cmdev 36733 36734 001627'01 302 07 0 00 000006 caie q3, .cmfil ;[252] Picked up a general file specification 36735 001630'01 254 00 0 00 001643' ifskp. ;[252] Yes, so let's get a bit more information 36736 001631'01 603 05 0 00 200000 txne q1, gj%unt ;[251] Compensate for misdocumentation ... 36737 001632'01 661 05 0 00 400000 txo q1, gj%dev ;[251] ... in JSYS_REFERENCE 36738 001633'01 550 01 0 00 000005 hrrz t1, q1 ;[252] Load the JFN, no flags 36739 001634'01 104 00 0 00 000117 DVCHR% ;[252] Find out all about it 36740 001635'01 320 12 0 00 001647' erjmpr ydirer ;[252] How is that possible? We have a valid JFN!! 36741 001636'01 200 06 0 00 000002 move q2, t2 ;[252] Save device characteristics 36742 001637'01 260 17 0 00 001622* confrm ;[252] Tie off the line 36743 001640'01 124 05 0 00 001623* dmovem q1, pars3 ;[252] Pass parsed item and characteristics 36744 001641'01 202 07 0 00 001625* movem q3, pars5 ;[252] Pass parse type 36745 001642'01 263 17 0 00 000000 ret ;[252] Done 36746 001643'01 endif. ;[252] End case general file 36747 36748 remark ;[252] Parsed something we don't know about... 36749 dmove t1, [ .fhslf ;[252] This process 36750 001643'01 120 01 0 00 006451' COMNX1 ] ;[252] "Invalid COMND function code" 36751 001644'01 104 00 0 00 000336 SETER% ;[252] Phoney up a parse error 36752 001645'01 320 12 0 00 001647' erjmpr ydirer ;[252] Handle an extremely unlikely error 36753 001646'01 254 00 0 00 001647' jrst ydirer ;[252] Otherwise, go lie about internal inconsistency 36754 k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 19:42 30-Mar-24 Page 23 K20SRV MAC 30-Mar-24 15:37 here on any kind of parse error 36755 subttl here on any kind of parse error 36756 36757 001647'01 561 01 0 00 001345* ydirer: hrroi t1, atmbuf ;[252] Point to unmodified atom buffer 36758 001650'01 104 00 0 00 000313 ESOUT% ;[252] Start complaining 36759 001651'01 320 12 0 00 001652' erjmpr .+1 ;[252] Ignore any error it throws 36760 001652'01 200 01 0 00 000000# txmsg < can not have its directory listed> ;[252] Explanatory blat 36761 001653'01 104 00 0 00 000076 36762 001654'01 320 12 0 00 001655' 36763 000213'02 000000000000# 36764 000407'04 040 143 141 156 040 36765 001655'01 201 01 0 00 400000 movx t1, .fhslf ;[252] This process 36766 001656'01 104 00 0 00 000012 GETER% ;[252] Get the last error 36767 001657'01 320 12 0 00 001661' ifje. r ;[252] Should NEVER fail, but ... 36768 001660'01 254 00 0 00 001664' 36769 001661'01 200 04 0 00 000001 move t4, t1 ;[252] Save error for debuggers 36770 001662'01 201 02 0 00 601405 movx t2, LSTRX1 ;[252] "Process has not encountered any errors" 36771 001663'01 254 00 0 00 001666' else. ;[252] Otherwise, worked 36772 001664'01 400 04 0 00 000000 setz t4, ;[252] Flag no last error 36773 001665'01 621 02 0 00 777777 tlz t2, -1 ;[252] Get rid of silly handle that we already know... 36774 001666'01 endif. ;[252] Must get resolved? 36775 001666'01 306 02 0 00 601405 cain t2, LSTRX1 ;[252] Nothing went wrong, actually? 36776 001667'01 254 00 0 00 001701' ifskp. ;[252] No, so display the last Tops-20 error 36777 001670'01 200 01 0 00 000000# txmsg <: > ;[252] Introduce the Tops-20 error string 36778 001671'01 104 00 0 00 000076 36779 001672'01 320 12 0 00 001673' 36780 000214'02 000000000000# 36781 000416'04 072 040 000 000 000 36782 001673'01 201 01 0 00 000101 movx t1, .priou ;[252] Continue to type on terminal 36783 001674'01 505 02 0 00 400000 hrli t2, .fhslf ;[252] This process 36784 001675'01 400 03 0 00 000000 setz t3, ;[252] Let it blat as much as it wants 36785 001676'01 104 00 0 00 000011 ERSTR% ;[252] Display last Tops-20 error 36786 001677'01 320 14 0 00 001701' erjmps .+2 ;[252] Ignore strange return 36787 001700'01 320 14 0 00 001701' erjmps .+1 ;[252] Ignore stranger return 36788 001701'01 endif. ;[252] End case displaying last Tops-20 error 36789 001701'01 561 01 0 00 001312* hrroi t1, crlf ;[252] Tops-20 pointer to carriage return line feed 36790 001702'01 104 00 0 00 000076 PSOUT% ;[252] Type it 36791 001703'01 320 12 0 00 001704' erjmpr .+1 ;[252] Ignore error, we're trying hard enough... 36792 001704'01 200 01 0 00 006437' movx t1, cz%ncl!.fhslf ;[252] Function is to close any JFN's which are not open 36793 001705'01 104 00 0 00 000034 CLZFF% ;[252] For this fork, only 36794 001706'01 320 12 0 00 001707' erjmpr .+1 ;[252] Ignore the error 36795 001707'01 254 00 0 00 001104* callret cmder1 ;[252] Allow a reparse 36796 k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 19:42 30-Mar-24 Page 24 K20SRV MAC 30-Mar-24 15:37 LOCAL DIRECTORY command execution [111] 36797 subttl LOCAL DIRECTORY command execution [111] 36798 36799 001710'01 $ydire: entry $ydire ; Invoked from k20par 36800 001710'01 550 01 0 00 001640* hrrz t1, pars3 ; Load parsed JFN 36801 001711'01 260 17 0 00 005474' call isdird ;[193] Is this a directory device? 36802 001712'01 254 00 0 00 001716' ifskp. ;[193] If worked, proceed 36803 001713'01 402 00 0 00 001255* setzm ffunc ; Function is "directory". 36804 001714'01 254 00 0 00 001752' jrst $ydir1 ; Go do the directory 36805 001715'01 254 00 0 00 001752' else. ;[193] Otherwise, not a directory device (or failed) 36806 001716'01 265 16 0 00 001554* anstkv (t4,^d4) ;[193] Allocate an anonymous stack variable 36807 001717'01 000000 000004 36808 001720'01 415 04 0 17 777773 36809 001721'01 200 02 0 00 000001 move t2, t1 ;[193] Reposition the device designator 36810 001722'01 560 01 0 00 000004 hrro t1, t4 ;[193] Create pointer to stack space 36811 001723'01 104 00 0 00 000121 DEVST% ;[193] Convert to a string 36812 001724'01 320 12 0 00 001726' ifje. r ;[193] Failed?? 36813 001725'01 254 00 0 00 001731' 36814 001726'01 200 03 0 00 000001 move t3, t1 ;[193] Save error for debugger 36815 001727'01 561 04 0 00 001322' hrroi t4, badevc ;[193] Load a default 36816 001730'01 254 00 0 00 001735' else. ;[193] Otherwise, we have a good device 36817 001731'01 120 02 0 00 006441' dmove t2, [exp ":", .chnul] ;[193] 36818 001732'01 136 02 0 00 000001 idpb t2, t1 ;[193] Punctuate device 36819 001733'01 136 03 0 00 000001 idpb t3, t1 ;[193] Tie off the string 36820 001734'01 661 04 0 00 777777 tlo t4, -1 ;[193] So turn it into a pointer 36821 001735'01 endif. ;[193] 36822 001735'01 200 01 0 00 000004 move t1, t4 ;[193] Device name 36823 001736'01 104 00 0 00 000313 ESOUT% ;[193] Begin complaining 36824 001737'01 200 01 0 00 000000# txmsg < does not have a directory to list files> ;[193] 36825 001740'01 104 00 0 00 000076 36826 001741'01 320 12 0 00 001742' 36827 000215'02 000000000000# 36828 000417'04 040 144 157 145 163 36829 001742'01 561 01 0 00 001701* hrroi t1, crlf ;[193] Newline 36830 001743'01 104 00 0 00 000076 PSOUT% ;[193] 36831 001744'01 400 01 0 00 000000 setz t1, ;[193] Cons up a zero 36832 001745'01 250 01 0 00 001710* exch t1, pars3 ;[193] Get and clear parsed JFN 36833 001746'01 621 01 0 00 777777 tlz t1, -1 ;[193] Clear any goofy flags 36834 001747'01 104 00 0 00 000023 RLJFN% ;[193] Punt it 36835 001750'01 320 12 0 00 001751' erjmpr .+1 ;[193] Catch and ignore error 36836 001751'01 263 17 0 00 000000 ret ;[193] And get out of here 36837 001752'01 endif. ;[193] End case device check 36838 36839 001752'01 200 02 0 00 001745* $ydir1: move t2, pars3 ; Here's the JFN. 36840 001753'01 402 00 0 00 000000* setzm filjfn ; Make sure no one thinks this is in use. 36841 001754'01 260 17 0 00 001766' call dirhdr ; Do the header first. 36842 36843 ; File-listing loop 36844 36845 001755'01 do. ;[194] Enter loop lexical context 36846 001755'01 260 17 0 00 006144' call dmpbuf ; Get some directory listing. 36847 001756'01 260 17 0 00 002033' call dirlst ; Print it. 36848 001757'01 326 01 0 00 001755' jumpn t1, top. ;[194] Go back for more. 36849 001760'01 enddo. ;[194] Exit loop lexical context 36850 36851 001760'01 263 17 0 00 000000 ret ; Till done. k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 19:42 30-Mar-24 Page 24-1 K20SRV MAC 30-Mar-24 15:37 LOCAL DIRECTORY command execution [111] 36852 k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 19:42 30-Mar-24 Page 25 K20SRV MAC 30-Mar-24 15:37 Directory Header Set Up 36853 subttl Directory Header Set Up 36854 36855 ; Call: 36856 ; 36857 ; t2/ JFN of files to list. 36858 ; 36859 ; Returns: 36860 ; 36861 ; +1, always. 36862 ; 36863 ; Puts the directory listing header into the server buffer. 36864 ; Initializes buffer pointers, counters, etc. 36865 36866 repeat 0,< ;[250] Don't have this in section zero 36867 hdrtxt: asciz / 36868 Name Pages Bytes(Size) Creation Date 36869 / ;[193] Directory listing header 36870 hdrptr: point 7, hdrtxt ;[193] Pointer to heading text 36871 -^d62 ;[193] Length of text 36872 >;repeat 0 ;[250] 36873 36874 001761'01 472531 435000 nuldev: byte (7) "N","U","L",":",.chnul ;[193] 36875 001762'01 44 07 0 00 001761' nul4:: point 7, nuldev ; Pointer to fixed "NUL:" string 36876 001763'01 777777 777774 -^d4 ; Length 36877 36878 001764'01 000000 000015 crlfch: .chcrt ;[251] Carriage Return 36879 001765'01 000000 000012 .chlfd ;[251] Line Feed 36880 36881 001766'01 202 02 0 00 000000* dirhdr: movem t2, ndxjfn ; Save wildcard bits. 36882 001767'01 552 02 0 00 000000* hrrzm t2, nxtjfn ; Initialize lookahead 36883 001770'01 402 00 0 00 000000# setzm filcnt ; File counter 36884 001771'01 476 00 0 00 000000# setom dirfin ; Initialize directory finished flag to assume error 36885 ; Put the listing in the server buffer. 36886 001772'01 332 00 0 00 001713* ifme. ffunc ; Directory listing? 36887 001773'01 254 00 0 00 002027' 36888 001774'01 550 03 0 00 000002 hrrz t3,t2 ;[193] Pick up just the JFN, no flags 36889 001775'01 302 03 0 00 377777 caie t3, .nulio ;[193] Data sink? 36890 001776'01 254 00 0 00 002005' ifskp. ;[193] Yep, that's easy enough 36891 001777'01 200 01 0 00 006453' move t1, [point 7, srvbuf, 27] ;[193] Points to ":" 36892 002000'01 621 02 0 00 777777 tlz t2, -1 ;[193] Shut off the flags (shouldn't be any) 36893 002001'01 211 03 0 00 000004 movni t3, ^d4 ;[193] What counted SOUT% would have wanted 36894 002002'01 200 04 0 00 001761' move t4, nuldev ;[193] Load device name in ASCII 36895 002003'01 202 04 0 00 000000# movem t4, srvbuf ;[193] Drop right into the buffer 36896 remark SOUT% ;[193] Bum the JSYS 36897 002004'01 254 00 0 00 002026' else. ;[193] Otherwise, put real file name in buffer 36898 002005'01 200 01 0 00 006454' move t1, [point 7, srvbuf] 36899 002006'01 120 03 0 00 000000* dmove t3, allfld ;[252] Everything, no goofy prefix 36900 002007'01 104 00 0 00 000030 JFNS 36901 002010'01 320 14 0 00 002011' erjmps .+1 ;[193] Catch and suppress error 36902 36903 smsg (< 36904 Name Pages Bytes(Size) Creation Date 36905 002011'01 120 02 0 00 000000# >) ;;[250] 36906 002012'01 260 17 0 00 000000* 36907 000216'02 000000000000# k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 19:42 30-Mar-24 Page 25-1 K20SRV MAC 30-Mar-24 15:37 Directory Header Set Up 36908 000217'02 777777 777702 36909 000430'04 015 012 116 141 155 36910 36911 36912 repeat 0,< ;[250] 36913 dmove t2, hdrptr ;[193] The standard header 36914 call %%smsg ;[216] Print heading. 36915 ;[216] erjmps +1 ;[194] Catch and suppress error 36916 >;repeat 0 ;[250] 36917 36918 002013'01 200 02 0 00 001766* move t2, ndxjfn ;[251] Load the JFN and bits 36919 002014'01 205 03 0 00 700000 movx t3,gj%dev!gj%unt!gj%dir ;[251] Will resolve if any were wildcarded 36920 002015'01 404 03 0 00 000002 and t3, t2 ;[251] Determine initial wildcard position 36921 002016'01 322 03 0 00 002026' ifn. t3 ;[251] If any set, then emit first position 36922 002017'01 630 02 0 00 000003 tdz t2, t3 ;[251] Stomp those specific wildcard flags 36923 002020'01 120 03 0 00 001764' dmove t3, crlfch ;[251] Seperation sequence 36924 002021'01 136 03 0 00 000001 idpb t3, t1 ;[251] Carriage return 36925 002022'01 136 04 0 00 000001 idpb t4, t1 ;[251] Line feed 36926 dmove t3, [fld(.jsaof,js%dev)!fld(.jsaof,js%dir)!js%paf ;[251] 36927 002023'01 120 03 0 00 006455' 0 ] ;[251] Just punctuated device and directory 36928 002024'01 104 00 0 00 000030 JFNS% ;[251] Indicate resolved location in listing 36929 002025'01 320 14 0 00 002026' erjmps .+1 ;[251] Catch and suppress error 36930 002026'01 endif. ;[251] End case wildcarded directory 36931 002026'01 endif. ;[193] End special case .nulio 36932 002026'01 254 00 0 00 002030' else. ;[193] Otherwise, just reset the buffer pointer 36933 002027'01 200 01 0 00 006457' move t1, [point 7, srvbuf] 36934 002030'01 endif. ;[194] End case file function decision 36935 36936 002030'01 402 00 0 00 000000# setzm dirfin ; No error, so not finished. 36937 002031'01 202 01 0 00 000000# movem t1, srvptr ; Preserve string buffer pointer. 36938 002032'01 263 17 0 00 000000 ret 36939 k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 19:42 30-Mar-24 Page 26 K20SRV MAC 30-Mar-24 15:37 Directory Listing Display Logic 36940 subttl Directory Listing Display Logic 36941 36942 ; Constructs directory listing text in a chunk of memory starting at 36943 ; SRVBUF and ending at (or slightly after) SRVBZ. Updates SRVPTR. 36944 ; 36945 ; Returns +1 always, with t1/ -1 if we got some data, t1/ 0 if done. 36946 ; 36947 ; Keeps global file counter in FILCNT. 36948 ; 36949 ; Be aware that the routine is doing double duty for ANY file function 36950 ; that might need to be executed over a set of files. 36951 36952 002033'01 400 01 0 00 000000 dirlst: setz t1, 36953 002034'01 332 00 0 00 000000# skipe dirfin ; Finished? 36954 002035'01 263 17 0 00 000000 ret ; Yes. 36955 002036'01 200 01 0 00 000000# move t1, srvptr ; No, there's more to do. 36956 002037'01 120 02 0 00 001764' dmove t2, crlfch ;[251] Load the line break 36957 002040'01 136 02 0 00 000001 idpb t2, t1 ;[194] And issue 36958 002041'01 136 03 0 00 000001 idpb t3, t1 ;[194] it 36959 002042'01 202 01 0 00 000000# movem t1, srvptr ; Save the buffer pointer. 36960 002043'01 260 17 0 00 005525' call gtnfil ; Get next file. 36961 002044'01 254 00 0 00 002165' jrst dirlsz ; If none, done. 36962 002045'01 350 00 0 00 000000# aos filcnt ; Got one, count it. 36963 36964 ;[133] Get detailed size info from FDB. 36965 36966 002046'01 550 02 0 00 000001 hrrz t2, t1 ;[251] Load JFN with no flags 36967 002047'01 200 01 0 00 006460' move t1, [byte (7) .chspc,.chspc,.chspc,.chspc,.chspc] ;[193] 36968 002050'01 202 01 0 00 000000* movem t1, filbuf ;[194] Fill the filename buffer with blanks. 36969 002051'01 200 01 0 00 006461' move t1, [filbuf,,filbuf+1] 36970 002052'01 251 01 0 00 000000# blt t1, filbfz-1 36971 36972 remark ;[193] Always put the file name in 36973 002053'01 302 02 0 00 377777 caie t2, .nulio ;[193] Data sink? 36974 002054'01 254 00 0 00 002061' ifskp. ;[193] Yes, don't do any of the file stuff 36975 002055'01 200 03 0 00 001761' move t3, nuldev ;[193] Just the device name 36976 002056'01 202 03 0 00 002050* movem t3, filbuf ;[193] Store a hardwired name 36977 002057'01 200 01 0 00 006462' move t1, [ point 7, filbuf, 27] ;[193] Where SOUT% would leave it 36978 002060'01 254 00 0 00 002066' else. ;[193] Otherwise, an honest file 36979 002061'01 200 01 0 00 006463' move t1, [point 7, filbuf] ; Now start filling in the fields. 36980 002062'01 200 03 0 00 006464' movx t3, fld(.jsaof,js%nam)!fld(.jsaof,js%typ)!fld(.jsaof,js%gen)!js%tmp!js%paf 36981 002063'01 400 04 0 00 000000 setz t4, ;[193] No goofy prefix 36982 002064'01 104 00 0 00 000030 JFNS 36983 002065'01 320 14 0 00 002165' erjmps dirlsz ;[193] Failed, get out of here 36984 002066'01 endif. ;[193] End special case NUL: 36985 002066'01 202 01 0 00 000000# movem t1, filptr ;[193] Store updated pointer 36986 36987 002067'01 332 00 0 00 001772* ifme. ffunc ; What was the file function? 36988 002070'01 254 00 0 00 002133' 36989 002071'01 260 17 0 00 005632' call filinf ;[200] Pull the file information 36990 002072'01 254 00 0 00 002165' jrst dirlsz ;[200] Or fail the loop 36991 002073'01 302 02 0 00 377777 caie t2, .nulio ;[193] Was it a directory of NUL:? 36992 002074'01 254 00 0 00 002100' ifskp. ;[193] Yes, so go make that up 36993 002075'01 260 17 0 00 002220' call nulist ;[193] Just make up our own entry 36994 002076'01 254 00 0 00 002165' jrst dirlsz ;[193] Failed, get out of here k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 19:42 30-Mar-24 Page 26-1 K20SRV MAC 30-Mar-24 15:37 Directory Listing Display Logic 36995 002077'01 254 00 0 00 002133' else. ;[193] Otherwise, this is a real file 36996 002100'01 260 17 0 00 002235' call filist ;[193] Construct text for this file 36997 002101'01 254 00 0 00 002165' jrst dirlsz ;[193] Failed, get out of here 36998 002102'01 510 03 0 00 001767* hllz t3, nxtjfn ;[251] Load current file's stepping flags 36999 002103'01 630 03 0 00 006465' andx t3,gn%str!gn%dir ;[251] Trigger on structure or device change 37000 002104'01 322 03 0 00 002133' ifn. t3 ;[251] If either changed, then emit current position 37001 002105'01 120 03 0 00 001764' dmove t3, crlfch ;[251] Seperation sequence 37002 002106'01 136 03 0 00 000001 idpb t3, t1 ;[251] Carriage return 37003 002107'01 136 04 0 00 000001 idpb t4, t1 ;[251] Line feed 37004 002110'01 200 03 0 00 000001 move t3, t1 ;[251] Get a copy of the pointer 37005 002111'01 400 04 0 00 000000 setz t4, ;[251] Cons up a NUL 37006 002112'01 136 04 0 00 000003 idpb t4, t3 ;[251] Tie off string, allowing append 37007 002113'01 415 16 0 00 002126' block. ;[251] Get another stack context for control flow 37008 002114'01 261 17 0 00 000016 37009 002115'01 265 16 0 00 006466' saveac ;[251] Leave whatever JFN is in t2, alone 37010 002116'01 550 02 0 00 002013* hrrz t2, ndxjfn ;[251] Load next JFN in sequence, no flags 37011 002117'01 120 03 0 00 001764' dmove t3, crlfch ;[251] Seperation sequence 37012 002120'01 136 03 0 00 000001 idpb t3, t1 ;[251] Carriage return 37013 002121'01 136 04 0 00 000001 idpb t4, t1 ;[251] Line feed 37014 dmove t3, [fld(.jsaof,js%dev)!fld(.jsaof,js%dir)!js%paf ;[251] 37015 002122'01 120 03 0 00 006455' 0 ] ;[251] Just punctuated device and directory 37016 002123'01 104 00 0 00 000030 JFNS% ;[251] Indicate change in listing 37017 002124'01 320 14 0 00 000700* erjmps rskp ;[251] +2 return, failed 37018 remark ;[251] +1 return, WORKED!! 37019 002125'01 263 17 0 00 000000 endbk. ;[251] End block context, restoring t2 37020 002126'01 254 00 0 00 002133' ifskp. ;[251] +2 failed? 37021 002127'01 200 03 0 00 000001 move t3, t1 ;[251] Get a copy of the pointer 37022 002130'01 400 04 0 00 000000 setz t4, ;[251] Cons up a NUL 37023 002131'01 136 04 0 00 000003 idpb t4, t3 ;[251] Tie off anything we wrote, allowing append 37024 002132'01 254 00 0 00 002165' jrst dirlsz ;[251] Failed the JFNS%, beat it 37025 002133'01 endif. ;[251] End case JFNS% error handling 37026 002133'01 endif. ;[251] End case printing directory on change 37027 002133'01 endif. ;[193] End .nulio special casing 37028 002133'01 endif. ;[193] End case doing a directory 37029 37030 002133'01 202 01 0 00 000000# movem t1, filptr ;[193] Store updated pointer 37031 002134'01 400 03 0 00 000000 setz t3, ; Done with this line, make it asciz. 37032 002135'01 136 03 0 00 000001 idpb t3, t1 37033 37034 ; Copy the result into the server sending buffer. 37035 37036 002136'01 415 16 0 00 002152' block. ;[202] Set up a stack frame 37037 002137'01 261 17 0 00 000016 37038 002140'01 265 16 0 00 006474' saveac ;[202] movst gorges on registers 37039 002141'01 200 05 0 00 000000# move q1, srvptr ;[202] Load server buffer pointer 37040 002142'01 200 02 0 00 006463' move t2, [point 7, filbuf] ;[202] Load source pointer 37041 002143'01 403 03 0 00 000006 setzb t3, q2 ;[202] Force section local pointers 37042 002144'01 200 01 0 00 006506' move t1, [S!mxascz] ;[202] Limit source length, start significance 37043 002145'01 200 04 0 00 006511' movx t4, [mxascz] ;[202] Limit destination length 37044 002146'01 123 01 0 00 000000* extend t1, movasc ;[202] Move characters, doing useless translating 37045 002147'01 600 00 0 00 000000 nop ;[202] Will never +1 because t1 and t4 are equal 37046 002150'01 202 05 0 00 000000# movem q1, srvptr ;[202] Save updated destination pointer 37047 002151'01 263 17 0 00 000000 endbk. ;[202] End of stack frame 37048 37049 ; Still expect to have file jfn in t2 when we get here. k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 19:42 30-Mar-24 Page 26-2 K20SRV MAC 30-Mar-24 15:37 Directory Listing Display Logic 37050 37051 002152'01 336 01 0 00 002067* skipn t1, ffunc ;[199] What is the function? 37052 002153'01 254 00 0 00 002156' ifskp. ;[200] Not doing a directory 37053 remark t2, ;[200] Already has the right JFN 37054 002154'01 500 02 0 00 002116* hll t2, ndxjfn ;[200] Put in the global stepping flags 37055 002155'01 260 17 0 01 000000 call (t1) ;[200] and go do selected function. 37056 002156'01 endif. ;[200] 37057 37058 002156'01 200 01 0 00 000000# move t1, srvptr 37059 002157'01 550 02 0 00 000001 hrrz t2, t1 ; See if buffer full. 37060 002160'01 305 02 0 00 000000# caige t2, srvbz ;[194] Full? 37061 002161'01 254 00 0 00 002164' ifskp. ;[194] It is 37062 002162'01 474 01 0 00 000000 seto t1, ; Return indicating we have data. 37063 002163'01 263 17 0 00 000000 ret 37064 002164'01 endif. ;[194] 37065 002164'01 254 00 0 00 002033' jrst dirlst ; Loop for another file 37066 37067 ; Done, print summary. 37068 37069 002165'01 200 01 0 00 000000# dirlsz: move t1, srvptr ; Get the buffer pointer. 37070 002166'01 201 02 0 00 000040 movei t2, .chspc ;[194] Summary. First a space. 37071 002167'01 104 00 0 00 000051 BOUT 37072 002170'01 200 02 0 00 000000# move t2, filcnt ; Then the number of files. 37073 002171'01 201 03 0 00 000012 movei t3, ^d10 37074 002172'01 104 00 0 00 000224 NOUT 37075 002173'01 320 16 0 00 002174' erjmp .+1 37076 002174'01 376 00 0 00 000000# sosn filcnt ; Do singular or plural right. 37077 002175'01 254 00 0 00 002201' ifskp. ; Was more than one 37078 smsg < files 37079 002176'01 120 02 0 00 000000# > 37080 002177'01 260 17 0 00 002012* 37081 000220'02 000000000000# 37082 000221'02 777777 777770 37083 000445'04 040 146 151 154 145 37084 37085 002200'01 254 00 0 00 002203' else. ; Otherwise, unary case 37086 smsg < file 37087 002201'01 120 02 0 00 000000# > 37088 002202'01 260 17 0 00 002177* 37089 000222'02 000000000000# 37090 000223'02 777777 777771 37091 000447'04 040 146 151 154 145 37092 37093 002203'01 endif. 37094 37095 002203'01 202 01 0 00 000000# movem t1, srvptr ; Save pointer. 37096 002204'01 477 01 0 00 000000# setob t1, dirfin ; Say we're returning data. 37097 remark dirfin ; Set finished flag for next time through. 37098 002205'01 263 17 0 00 000000 ret 37099 k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 19:42 30-Mar-24 Page 27 K20SRV MAC 30-Mar-24 15:37 NUL: device directory listing 37100 subttl NUL: device directory listing 37101 37102 ;[193] Begin Code Insertion 37103 37104 ; Expects t1 to point to a buffer area to write text 37105 37106 002206'01 011 011 040 040 040 nuldir: asciz / 0 0(7) Now/ 37107 002214'01 000000 000031 nulfil: ^d25 ; Length of phoney directory entry 37108 002215'01 44 07 0 00 002206' point 7, nuldir ; Pointer to our phoney directory entry 37109 37110 002216'01 movchr: intern movchr ; Extended opcode is also used elsewhere 37111 002216'01 016 00 0 00 000000 movslj 0, 0 ; No accumulator; E1 unused 37112 002217'01 000000 000040 .chspc ; Fill with spaces 37113 37114 002220'01 261 17 0 00 000005 nulist: push p, q1 ; Extend gorges on registers 37115 002221'01 261 17 0 00 000006 push p, q2 37116 37117 002222'01 200 05 0 00 000001 move q1, t1 ; Reposition destination 37118 002223'01 120 01 0 00 002214' dmove t1, nulfil ; Load source length and pointer 37119 002224'01 200 04 0 00 000001 move t4, t1 ; Source and destination are the same length 37120 002225'01 400 03 0 00 000006 setz t3, q2 ; Force section local pointers 37121 002226'01 123 01 0 00 002216' extend t1, movchr ; Copy the listing over 37122 002227'01 600 00 0 00 000000 nop ; Will never +1 since t1 == t4 37123 002230'01 200 01 0 00 000005 move t1, q1 ; Return final destination pointer 37124 remark t4, ; t4 is still zero 37125 002231'01 136 04 0 00 000005 idpb t4, q1 ; Tie of the string, allowing append 37126 37127 002232'01 262 17 0 00 000006 pop p, q2 ; Restore registers 37128 002233'01 262 17 0 00 000005 pop p, q1 37129 002234'01 254 00 0 00 002124* retskp ; Return success, pointing to .chnul 37130 37131 ;[193] End Code Insertion 37132 k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 19:42 30-Mar-24 Page 28 K20SRV MAC 30-Mar-24 15:37 Real directory listing, including file size and creation date. 37133 subttl Real directory listing, including file size and creation date. 37134 37135 ; Call: 37136 ; 37137 ; t1/ Pointer to buffer area 37138 ; 37139 ; Assumes the following are valid: 37140 ; 37141 ; pagcnt/ Number of pages (or blocks) in the file 37142 ; bytcnt/ Count of bytes in the file and byte size 37143 ; crdate/ Creation date and time 37144 ; 37145 ; In other words that filinf has been called. Note that it is a 37146 ; mistake to use this when doing .nulio, even though filinf will 37147 ; put reasonable (yet false) data in. The resulting string will 37148 ; always be the same, so this is special cased. 37149 37150 ;[122] The rest of this routine rewritten to provide nice columnar listing. 37151 37152 002235'01 200 01 0 00 000000# filist: move t1, filptr ;[193] Load current buffer pointer 37153 002236'01 201 03 0 00 000040 movei t3, .chspc ; Put a blank over the null left by JFNS. 37154 002237'01 136 03 0 00 000001 idpb t3, t1 37155 37156 002240'01 550 02 0 00 000001 hrrz t2, t1 ; Get address from updated pointer. 37157 002241'01 301 02 0 00 000000# cail t2, filbuf+4 ; Name stayed within its field? 37158 002242'01 254 00 0 00 002246' ifskp. ;[194] It did 37159 002243'01 200 01 0 00 006512' move t1, [point 7, filbuf+4] ; Yes, advance to next field. 37160 002244'01 200 03 0 00 006513' movx t3, 37161 002245'01 254 00 0 00 002251' else. ;[194] Otherwise, blew through it 37162 002246'01 201 02 0 00 000040 movei t2, .chspc ; No, do free format. 37163 002247'01 136 02 0 00 000001 idpb t2, t1 ; Deposit a blank, advance pointer. 37164 002250'01 201 03 0 00 000012 movei t3, ^d10 ; No fixed-field stuff on page count. 37165 002251'01 endif. ;[194] 37166 37167 ;[133] More detailed info about size: pages, byte count, byte size. 37168 37169 002251'01 550 02 0 00 000000* hrrz t2, pagcnt ; Number of pages in file. 37170 002252'01 104 00 0 00 000224 NOUT 37171 002253'01 320 14 0 00 001210* erjmps r ; Catch and suppress error, returning +1 37172 002254'01 201 03 0 00 000040 movei t3, .chspc ; A blank 37173 002255'01 136 03 0 00 000001 idpb t3, t1 37174 002256'01 200 02 0 00 000000* move t2, bytcnt ; Byte count, free format. 37175 002257'01 201 03 0 00 000012 movei t3, ^d10 37176 002260'01 104 00 0 00 000224 NOUT 37177 002261'01 320 14 0 00 002253* erjmps r ; Catch and suppress error, returning +1 37178 37179 002262'01 135 02 0 00 006514' ldb t2, [pointr (pagcnt,fb%bsz)] ;[200] Load the byte size 37180 002263'01 322 02 0 00 002274' ifn. t2 ;[200] Device may not do byte sizes 37181 002264'01 201 03 0 00 000050 movei t3, "(" ; Byte size, in parens. 37182 002265'01 136 03 0 00 000001 idpb t3, t1 37183 002266'01 201 03 0 00 000012 movei t3, ^d10 37184 002267'01 104 00 0 00 000224 NOUT 37185 002270'01 320 14 0 00 002261* erjmps r ; Catch and suppress error, returning +1 37186 002271'01 201 03 0 00 000051 movei t3, ")" 37187 002272'01 136 03 0 00 000001 idpb t3, t1 ;[133](end) Closing parens. k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 19:42 30-Mar-24 Page 28-1 K20SRV MAC 30-Mar-24 15:37 Real directory listing, including file size and creation date. 37188 002273'01 254 00 0 00 002277' else. ;[200] Fix string contiguity 37189 002274'01 200 02 0 00 000001 move t2, t1 ;[200] Get a copy of the pointer 37190 002275'01 201 03 0 00 000040 movei t3, .chspc ;[200] Load a space 37191 002276'01 136 03 0 00 000002 idpb t3, t2 ;[200] Overwrite the .chnul 37192 002277'01 endif. ;[200] 37193 37194 002277'01 301 03 0 00 000000# cail t3, filbuf+11 ;[194] Out of the field? 37195 002300'01 254 00 0 00 002303' ifskp. ;[194] No, that's great! 37196 002301'01 200 01 0 00 006515' move t1, [point 7, filbuf+11] 37197 002302'01 254 00 0 00 002305' else. ;[194] Otherwise, overflowed field 37198 002303'01 201 02 0 00 000040 movei t2, .chspc ; Put in a blank to separate. 37199 002304'01 136 02 0 00 000001 idpb t2, t1 37200 002305'01 endif. 37201 37202 002305'01 336 02 0 00 000000* skipn t2, crdate ;[200] Pick up creation date, if there is one 37203 002306'01 254 00 0 00 002312' ifskp. ;[200] There was, let's type it 37204 002307'01 205 03 0 00 010000 movx t3, ot%4yr ;[200] We're waaaaay past the millenium 37205 002310'01 104 00 0 00 000220 ODTIM% ;[200] Finally display something 37206 002311'01 320 14 0 00 002270* erjmps r ;[200] Catch and suppress error, returning +1 37207 002312'01 endif. ;[200] 37208 002312'01 254 00 0 00 002234* retskp ;[193] Won 37209 k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 19:42 30-Mar-24 Page 29 K20SRV MAC 30-Mar-24 15:37 REMOTE DIRECTORY execution 37210 subttl REMOTE DIRECTORY execution 37211 37212 002313'01 336 00 0 00 001344* $xdire: ifmn. tlgjfn ;[233] Doing transaction logging? 37213 002314'01 254 00 0 00 002336' 37214 002315'01 415 16 0 00 002336' block. ;[233] Get a stack frame 37215 002316'01 261 17 0 00 000016 37216 002317'01 265 16 0 00 006314' saveac ;[233] Save even the temporaries 37217 002320'01 476 00 0 00 001337* setom scrlft ;[233] Don't append the crlf! 37218 002321'01 265 01 0 00 001340* wtlog(,) ;[233] 37219 002322'01 000000000000# 37220 002323'01 777777 777734 37221 002324'01 000000 000000 37222 000451'04 122 145 161 165 145 37223 002325'01 200 01 0 00 002313* move t1, tlgjfn ;[233] Put the directory name in the log 37224 002326'01 561 02 0 00 001647* hrroi t2,atmbuf ;[233] It's in the atom buffer 37225 002327'01 403 03 0 00 000004 setzb t3,t4 ;[233] Don't know how long, stop on a NUL 37226 002330'01 104 00 0 00 000053 SOUT% ;[233] Out it goes! 37227 002331'01 320 14 0 00 002332' erjmps .+1 ;[233] Catch and suppress error 37228 dmove t2,[ -1,,crlf ;[233] Tops-20 pointer to carriage return line feed 37229 002332'01 120 02 0 00 006443' -2 ] ;[233] Counted SOUT%'s are faster 37230 002333'01 104 00 0 00 000053 SOUT% ;[233] Out it goes! 37231 002334'01 320 14 0 00 002335' erjmps .+1 ;[233] Catch and suppress error 37232 002335'01 263 17 0 00 000000 endbk. ;[233] Release stack frame, restoring AC's 37233 002336'01 endif. ;[233] 37234 37235 002336'01 260 17 0 00 001355* call statim ;[189] Start timing so k20pdc doesn't choke 37236 002337'01 201 04 0 00 000104 movei t4, "D" ; Generic command is D. 37237 002340'01 254 00 0 00 005362' jrst srvfil 37238 37239 k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 19:42 30-Mar-24 Page 30 K20SRV MAC 30-Mar-24 15:37 REMOTE ERROR parsing 37240 subttl REMOTE ERROR parsing 37241 37242 ; This is a SECRET command to send an (optionally) null error packet. Shh!! 37243 37244 chgsec(code,const) ;;Chained fdb's go in const 37245 000224'02 010004 000227' xerfdb: flddb. .cmcfm,,,,,xerfd1 37246 000225'02 000000 000000 37247 000226'02 44 07 0 00 000553' 37248 000227'02 021004 000232' xerfd1: flddb. .cmqst,,,,,xerfd2 37249 000230'02 000000 000000 37250 000231'02 44 07 0 00 000561' 37251 000232'02 017004 000000 xerfd2: flddb. .cmtxt,,,,, 37252 000233'02 000000 000000 37253 000234'02 44 07 0 00 000561' 37254 retsec 37255 cleans() 37256 37257 002341'01 201 01 0 00 000000# .xerr: movei t1, xerfdb ;[220] Allow a quote of the remote file specification 37258 002342'01 260 17 0 00 001376* call rfield ;[220] Try to parse something 37259 002343'01 135 03 0 00 006275' ldb t3, [pointr (.cmfnp(t3),cm%fnc)] ;[220] Get function code. 37260 37261 002344'01 306 03 0 00 000010 cain t3, .cmcfm ;[220] Confirm? 37262 002345'01 263 17 0 00 000000 ret ;[220] We're done 37263 37264 002346'01 260 17 0 00 001637* confrm ;[220] Otherwise tie off the line 37265 002347'01 200 01 0 00 006377' move t1,[point 7,atmbuf];[220] Load pointer to complaint department 37266 002350'01 202 01 0 00 001752* movem t1, pars3 ;[220] and ask to ship that off 37267 37268 002351'01 263 17 0 00 000000 ret 37269 k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 19:42 30-Mar-24 Page 31 K20SRV MAC 30-Mar-24 15:37 REMOTE ERROR semantic action 37270 subttl REMOTE ERROR semantic action 37271 37272 002352'01 265 16 0 00 006254' $xerr: saveac ;[220] Extra register for possible pointer 37273 002353'01 260 17 0 00 002336* call statim ;[189] Start timing so k20pdc doesn't choke 37274 002354'01 336 05 0 00 002350* skipn q1, pars3 ;[220] Wants to send accompanying text 37275 002355'01 254 00 0 00 002365' ifskp. ;[220] Must be really annoyed... 37276 002356'01 400 03 0 00 000000 setz t3, ;[220] Let's assume a bogus parse 37277 002357'01 200 02 0 00 000005 move t2, q1 ;[220] Load the pointer we were passed 37278 002360'01 134 03 0 00 000002 ildb t3, t2 ;[220] Try to get a character 37279 002361'01 320 12 0 00 002362' erjmpr .+1 ;[220] Catch and store error for debuggers 37280 002362'01 306 03 0 00 000000 cain t3, 0 ;[220] Anything there? 37281 002363'01 254 00 0 00 002365' anskp. ;[220] No, so still sending a null packet 37282 002364'01 254 00 0 00 002373' else. ;[220] No pointer, or bad pointer or no data 37283 002365'01 201 01 0 00 000105 movei t1, "E" ; Send an error packet. 37284 002366'01 200 02 0 00 000000* move t2, pktnum ;[220] Packet number must match 37285 002367'01 403 03 0 00 000004 setzb t3, t4 ;[220] Yet no data 37286 002370'01 260 17 0 00 000000* call spack ;[220] Send the packet... 37287 002371'01 600 00 0 00 000000 nop ;[220] ... and ignore the response 37288 002372'01 263 17 0 00 000000 ret ;[220] Done with this trivial case 37289 002373'01 endif. ;[220] End argument check 37290 37291 remark ;[220] Otherwise, stuff some text in 37292 002373'01 403 01 0 00 000002 setzb t1, t2 ;[220] Cons up some .chnul's 37293 002374'01 124 01 0 00 001017* dmovem t1, strbuf ;[220] Zero out old stuff 37294 002375'01 124 01 0 00 000000# dmovem t1, strbuf+2 ;[220] and a bit more of it 37295 002376'01 200 02 0 00 006420' move t2, [ point 7, strbuf ] ;[220] Point to string buffer 37296 002377'01 202 02 0 00 001062* movem t2, strptr ;[220] Save current location 37297 37298 002400'01 200 01 0 00 000005 move t1, q1 ;[220] Load pointer to error text 37299 002401'01 400 03 0 00 000000 setz t3, ;[220] Zero the count 37300 37301 002402'01 do. ; Enter loop context to copy the complaint 37302 002402'01 134 04 0 00 000001 ildb t4, t1 ; Pick up a byte of the wahhh 37303 002403'01 322 04 0 00 002406' jumpe t4, endlp. ; Stop at the end of the string 37304 002404'01 136 04 0 00 000002 idpb t4, t2 ; Deposit it in string buffer 37305 002405'01 344 03 0 00 002402' aoja t3, top. ; Get some more bytes, weee!! 37306 002406'01 enddo. ; End of loop context 37307 37308 002406'01 400 04 0 00 000000 setz t4, ;[220] Cons up a NUL 37309 002407'01 136 04 0 00 000002 idpb t4, t2 ;[220] Tie off string but don't count it 37310 37311 002410'01 201 01 0 00 000105 movei t1, "E" ;[220] Sending an error packet with extra flavoring 37312 002411'01 200 02 0 00 002366* move t2, pktnum ;[220] Packet number must match 37313 remark t3, data count ;[220] Unchanged from do. loop 37314 002412'01 200 04 0 00 002377* move t4, strptr ;[220] Load beginning of data area 37315 002413'01 260 17 0 00 002370* call spack ;[220] Send the packet... 37316 002414'01 600 00 0 00 000000 nop ;[220] ... and ignore the response 37317 002415'01 263 17 0 00 000000 ret ;[220] Done with the semantic action for ERROR 37318 37319 k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 19:42 30-Mar-24 Page 32 K20SRV MAC 30-Mar-24 15:37 FINISH command 37320 subttl FINISH command 37321 37322 ;[28] The FINISH command is edit 28. 37323 37324 ; Invoked by K20PAR 37325 37326 002416'01 .finis: entry .finis ;[220] 37327 002416'01 200 16 0 00 000000# guide (remote server operation) ; Parse rest of FINISH command. 37328 002417'01 260 17 0 00 001374* 37329 000235'02 000000000000# 37330 000461'04 162 145 155 157 164 37331 002420'01 260 17 0 00 002346* confrm 37332 002421'01 263 17 0 00 000000 ret 37333 37334 remark Execute FINISH command. 37335 37336 002422'01 $finis: entry $finis ;[220] 37337 002422'01 260 17 0 00 002353* call statim ;[189] Start timing so k20pdc doesn't choke 37338 002423'01 200 01 0 00 006517' move t1, [point 7, [asciz/F/]] ; An "F" for the data field. 37339 002424'01 201 02 0 00 000107 movei t2, "G" ; Packet type is G. 37340 002425'01 260 17 0 00 005134' call srvcmd ; Go send the command. 37341 002426'01 600 00 0 00 000000 nop ; Ignore any failure. 37342 002427'01 263 17 0 00 000000 ret ; Done. 37343 k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 19:42 30-Mar-24 Page 33 K20SRV MAC 30-Mar-24 15:37 REMOTE HELP 37344 subttl REMOTE HELP 37345 37346 remark REMOTE HELP parsing 37347 37348 002430'01 200 16 0 00 000000# .xhelp: guide 37349 002431'01 260 17 0 00 002417* 37350 000236'02 000000000000# 37351 000466'04 146 162 157 155 040 37352 002432'01 260 17 0 00 002420* confrm 37353 002433'01 263 17 0 00 000000 ret 37354 37355 remark REMOTE HELP execution 37356 37357 002434'01 336 00 0 00 002325* $xhelp: ifmn. tlgjfn ;[233] Doing transaction logging? 37358 002435'01 254 00 0 00 002446' 37359 002436'01 415 16 0 00 002446' block. ;[233] Get a stack frame 37360 002437'01 261 17 0 00 000016 37361 002440'01 265 16 0 00 006314' saveac ;[233] Save even the temporaries 37362 002441'01 265 01 0 00 002321* wtlog(,) ;[233] 37363 002442'01 000000000000# 37364 002443'01 777777 777741 37365 002444'01 000000 000000 37366 000472'04 122 145 161 165 145 37367 002445'01 263 17 0 00 000000 endbk. ;[233] Release stack frame, restoring AC's 37368 002446'01 endif. ;[233] 37369 37370 002446'01 260 17 0 00 002422* call statim ;[189] Start timing so k20pdc doesn't choke 37371 002447'01 260 17 0 00 005331' call sinfo ; Exchange parameters. 37372 002450'01 263 17 0 00 000000 ret ;[133] Failed, give up. 37373 dmove t1, [point 7, [asciz/H/] ; H command for data field. 37374 002451'01 120 01 0 00 006521' "G" ] ; Packet type is G. 37375 002452'01 254 00 0 00 005406' jrst dosrv 37376 37377 k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 19:42 30-Mar-24 Page 34 K20SRV MAC 30-Mar-24 15:37 REMOTE HOST parsing 37378 subttl REMOTE HOST parsing 37379 37380 chgsec(code,const) ;;Chained fdb's go in const 37381 000237'02 021004 000242' xhofdb: flddb. .cmqst,,,,,xhofd1 37382 000240'02 000000 000000 37383 000241'02 44 07 0 00 000566' 37384 000242'02 017004 000000 xhofd1: flddb. .cmtxt,,,,, 37385 000243'02 000000 000000 37386 000244'02 44 07 0 00 000566' 37387 retsec 37388 cleans() 37389 37390 002453'01 200 16 0 00 000000# .xhost: guide 37391 002454'01 260 17 0 00 002431* 37392 000245'02 000000000000# 37393 000501'04 143 157 155 155 141 37394 002455'01 201 01 0 00 000000# movei t1, xhofdb ;[220] Allow a quote of the remote command 37395 002456'01 260 17 0 00 001330* call cfield 37396 002457'01 263 17 0 00 000000 ret 37397 k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 19:42 30-Mar-24 Page 35 K20SRV MAC 30-Mar-24 15:37 REMOTE HOST command [105] 37398 subttl REMOTE HOST command [105] 37399 37400 002460'01 336 00 0 00 000332* $xhost: ifmn. takdep ;[176] Allow commands to servers from TAKE file 37401 002461'01 254 00 0 00 002471' 37402 002462'01 336 00 0 00 000000* ifmn. local ; This only works if local Kermit. 37403 002463'01 254 00 0 00 002471' 37404 002464'01 334 01 0 00 000000# ermsg% (,r) 37405 002465'01 254 00 0 00 002471' 37406 002466'01 202 01 0 00 000530* 37407 002467'01 104 00 0 00 000313 37408 002470'01 254 00 0 00 002311* 37409 000246'02 000000000000# 37410 000503'04 113 105 122 115 111 37411 37412 002471'01 endif. ;[194] End case not remote 37413 002471'01 endif. ;[194] End case allowing from take file 37414 37415 002471'01 260 17 0 00 002446* call statim ;[189] Start timing so k20pdc doesn't choke 37416 dmove t1, [point 7, atmbuf ; And move them from here 37417 002472'01 120 01 0 00 006523' point 7, strbuf] ; to here. 37418 37419 002473'01 do. ;[194] Enter loop context 37420 002473'01 134 04 0 00 000001 ildb t4, t1 ; Copy the string. 37421 002474'01 322 04 0 00 002477' jumpe t4, endlp. ;[194] 37422 002475'01 136 04 0 00 000002 idpb t4, t2 37423 002476'01 254 00 0 00 002473' loop. ;[194] 37424 002477'01 enddo. ;[194] 37425 37426 002477'01 200 03 0 00 000000* move t3, seolch ; Terminate it with the host's eol character. 37427 002500'01 136 03 0 00 000002 idpb t3, t2 37428 002501'01 136 04 0 00 000002 idpb t4, t2 ; And a null. 37429 37430 002502'01 260 17 0 00 000000* call ccon ;[169] Enable ^C during this bit. 37431 002503'01 254 00 0 00 000000* jrst ccoff ;[169] Where to go if ^C happens. 37432 002504'01 260 17 0 00 005331' call sinfo ; Exchange params. 37433 002505'01 254 00 0 00 002503* jrst ccoff ;[169] Failed, give up, turn off ^C trap. 37434 002506'01 260 17 0 00 002505* call ccoff ;[169] 37435 002507'01 200 01 0 00 006420' move t1, [point 7, strbuf] ; Point to command. 37436 002510'01 201 02 0 00 000103 movei t2, "C" ; Packet type is C. 37437 002511'01 254 00 0 00 005406' jrst dosrv ; Go send it and handle the reply. 37438 37439 k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 19:42 30-Mar-24 Page 36 K20SRV MAC 30-Mar-24 15:37 PWD command 37440 subttl PWD command 37441 37442 remark LOCAL PWD (trivial) parsing 37443 37444 002512'01 .ypwd: entry .ypwd 37445 002512'01 200 16 0 00 000000# guide 37446 002513'01 260 17 0 00 002454* 37447 000247'02 000000000000# 37448 000520'04 160 162 151 156 164 37449 002514'01 260 17 0 00 002432* confrm 37450 002515'01 263 17 0 00 000000 ret 37451 37452 remark LOCAL PWD semanic action 37453 37454 002516'01 $ypwd: entry $ypwd 37455 002516'01 561 01 0 00 001742* hrroi t1, crlf ; Offset from prompt 37456 002517'01 104 00 0 00 000076 PSOUT% 37457 002520'01 104 00 0 00 000013 GJINF% ; Get current job information. 37458 002521'01 201 01 0 00 000101 movei t1, .priou ; Type on terminal 37459 remark t2, ; Already has the connected directory 37460 002522'01 104 00 0 00 000041 DIRST% ; Translate into a string 37461 002523'01 320 12 0 00 002525' %jserr (,r) 37462 002524'01 254 00 0 00 002530' 37463 002525'01 265 01 0 00 001206* 37464 002526'01 000000 000000 37465 002527'01 254 00 0 00 002470* 37466 002530'01 561 01 0 00 002516* hrroi t1,crlf ; Tie off the line 37467 002531'01 104 00 0 00 000076 PSOUT% 37468 002532'01 263 17 0 00 000000 ret 37469 k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 19:42 30-Mar-24 Page 37 K20SRV MAC 30-Mar-24 15:37 REMOTE PWD 37470 subttl REMOTE PWD 37471 37472 ;[188] Begin Code Insertion 37473 37474 remark REMOTE PWD parsing 37475 37476 002533'01 200 16 0 00 000000# .xpwd: guide 37477 002534'01 260 17 0 00 002513* 37478 000250'02 000000000000# 37479 000526'04 160 162 151 156 164 37480 002535'01 260 17 0 00 002514* confrm 37481 002536'01 263 17 0 00 000000 ret 37482 37483 remark REMOTE PWD execution 37484 37485 002537'01 260 17 0 00 002471* $xpwd: call statim ;[189] Start timing so k20pdc doesn't choke 37486 dmove t1, [ 37487 point 7, [asciz/A/] ; 'A' command for data field. 37488 002540'01 120 01 0 00 006526' "G" ] ; Packet type is G. 37489 002541'01 254 00 0 00 005406' jrst dosrv 37490 37491 37492 ;[188] End Code Insertion 37493 37494 k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 19:42 30-Mar-24 Page 38 K20SRV MAC 30-Mar-24 15:37 LOCAL SPACE 37495 subttl LOCAL SPACE 37496 37497 remark LOCAL SPACE (trivial) parsing 37498 37499 002542'01 .ydisk: entry .ydisk 37500 002542'01 200 16 0 00 000000# guide 37501 002543'01 260 17 0 00 002534* 37502 000251'02 000000000000# 37503 000534'04 165 163 141 147 145 37504 002544'01 260 17 0 00 002535* confrm 37505 002545'01 263 17 0 00 000000 ret 37506 37507 remark LOCAL SPACE semanic action 37508 37509 002546'01 $ydisk: entry $ydisk 37510 002546'01 474 01 0 00 000000 seto t1, ; local disk usage query. 37511 002547'01 104 00 0 00 000305 GTDAL% 37512 002550'01 320 12 0 00 002552' %jserr (,r) 37513 002551'01 254 00 0 00 002555' 37514 002552'01 265 01 0 00 002525* 37515 002553'01 000000 000000 37516 002554'01 254 00 0 00 002527* 37517 002555'01 120 05 0 00 000001 dmove q1, t1 37518 txmsg < 37519 002556'01 200 01 0 00 000000# Quota: > ;[194] 37520 002557'01 104 00 0 00 000076 37521 002560'01 320 12 0 00 002561' 37522 000252'02 000000000000# 37523 000537'04 015 012 040 121 165 37524 37525 002561'01 305 05 0 00 006530' caige q1, [^d100000000] ;[194] Where did this number come from? 37526 002562'01 254 00 0 00 002567' ifskp. ;[194] Really big ... 37527 002563'01 200 01 0 00 000000# txmsg <+Inf> ;[194] 37528 002564'01 104 00 0 00 000076 37529 002565'01 320 12 0 00 002566' 37530 000253'02 000000000000# 37531 000542'04 053 111 156 146 000 37532 002566'01 254 00 0 00 002574' else. ;[194] 37533 002567'01 201 01 0 00 000101 numout q1 37534 002570'01 200 02 0 00 000005 37535 002571'01 201 03 0 00 000012 37536 002572'01 104 00 0 00 000224 37537 002573'01 320 14 0 00 002574' 37538 002574'01 endif. 37539 37540 002574'01 200 01 0 00 000000# txmsg <, used: > 37541 002575'01 104 00 0 00 000076 37542 002576'01 320 12 0 00 002577' 37543 000254'02 000000000000# 37544 000543'04 054 040 165 163 145 37545 002577'01 201 01 0 00 000101 numout q2 37546 002600'01 200 02 0 00 000006 37547 002601'01 201 03 0 00 000012 37548 002602'01 104 00 0 00 000224 37549 002603'01 320 14 0 00 002604' k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 19:42 30-Mar-24 Page 38-1 K20SRV MAC 30-Mar-24 15:37 LOCAL SPACE 37550 002604'01 200 01 0 00 000000# txmsg < (pages)> 37551 002605'01 104 00 0 00 000076 37552 002606'01 320 12 0 00 002607' 37553 000255'02 000000000000# 37554 000545'04 040 050 160 141 147 37555 002607'01 263 17 0 00 000000 ret 37556 37557 k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 19:42 30-Mar-24 Page 39 K20SRV MAC 30-Mar-24 15:37 REMOTE SPACE 37558 subttl REMOTE SPACE 37559 37560 remark REMOTE SPACE parsing 37561 37562 002610'01 200 16 0 00 000000# .xdisk: guide 37563 002611'01 260 17 0 00 002543* 37564 000256'02 000000000000# 37565 000547'04 165 163 141 147 145 37566 002612'01 260 17 0 00 002544* confrm 37567 002613'01 263 17 0 00 000000 ret 37568 37569 remark REMOTE SPACE execution 37570 37571 002614'01 260 17 0 00 002537* $xdisk: call statim ;[189] Start timing so k20pdc doesn't choke 37572 dmove t1, [ 37573 point 7, [asciz/U/] ; U command for data field. 37574 002615'01 120 01 0 00 006532' "G" ] ; Packet type is G. 37575 002616'01 254 00 0 00 005406' jrst dosrv 37576 37577 k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 19:42 30-Mar-24 Page 40 K20SRV MAC 30-Mar-24 15:37 LOCAL STATISTICS 37578 subttl LOCAL STATISTICS 37579 37580 ; Parse rest of STATISTICS command. 37581 37582 002617'01 .stat: entry .stat 37583 002617'01 200 16 0 00 000000# guide 37584 002620'01 260 17 0 00 002611* 37585 000257'02 000000000000# 37586 000552'04 141 142 157 165 164 37587 002621'01 260 17 0 00 002612* confrm 37588 002622'01 263 17 0 00 000000 ret 37589 37590 remark LOCAL STATUS execution 37591 37592 ;[189] All part of edit [189] 37593 37594 002623'01 $ysrvt: entry $ysrvt 37595 extern $srvt,statxt ;[194] Our necessary 37596 002623'01 260 17 0 00 000000* call $srvt ; Format the stuff 37597 002624'01 561 01 0 00 000000* hrroi t1,statxt ; Point to text it built 37598 002625'01 104 00 0 00 000076 PSOUT% ; Print it 37599 002626'01 320 12 0 00 002554* erjmpr r ; Get error, get out of here 37600 002627'01 263 17 0 00 000000 ret ; Get out of here 37601 k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 19:42 30-Mar-24 Page 41 K20SRV MAC 30-Mar-24 15:37 REMOTE STATUS 37602 subttl REMOTE STATUS 37603 37604 ;[189] Begin Code Insertion 37605 37606 remark REMOTE STATUS parsing 37607 37608 002630'01 200 16 0 00 000000# .xstat: guide 37609 002631'01 260 17 0 00 002620* 37610 000260'02 000000000000# 37611 000557'04 157 146 040 154 141 37612 002632'01 260 17 0 00 002621* confrm 37613 002633'01 263 17 0 00 000000 ret 37614 37615 remark REMOTE STATUS execution 37616 37617 002634'01 336 00 0 00 002434* $xstat: ifmn. tlgjfn ;[233] Doing transaction logging? 37618 002635'01 254 00 0 00 002646' 37619 002636'01 415 16 0 00 002646' block. ;[233] Get a stack frame 37620 002637'01 261 17 0 00 000016 37621 002640'01 265 16 0 00 006314' saveac ;[233] Save even the temporaries 37622 002641'01 265 01 0 00 002441* wtlog(,) ;[233] 37623 002642'01 000000000000# 37624 002643'01 777777 777732 37625 002644'01 000000 000000 37626 000563'04 122 145 161 165 145 37627 002645'01 263 17 0 00 000000 endbk. ;[233] Release stack frame, restoring AC's 37628 002646'01 endif. ;[233] 37629 37630 002646'01 260 17 0 00 002614* call statim ;[189] Start timing so k20pdc doesn't choke 37631 dmove t1, [ 37632 point 7, [asciz/Q/] ; 'Q' command for data field. 37633 002647'01 120 01 0 00 006535' "G" ] ; Packet type is G. 37634 002650'01 254 00 0 00 005406' jrst dosrv 37635 37636 ;[198] End Code Insertion 37637 37638 k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 19:42 30-Mar-24 Page 42 K20SRV MAC 30-Mar-24 15:37 LOCAL TYPE [143] 37639 subttl LOCAL TYPE [143] 37640 37641 chgsec(code,const) ;;Tables and fdb's go in const 37642 000261'02 100120 000000 typbk: gj%old!gj%ifg!gj%flg ; Flag bits,,most recent generation. 37643 000262'02 000100 000101 .priin,,.priou ; COMND i/o. 37644 repeat 6,<0> ; No defaults, except all generations. 37645 000263'02 000000 000000 37646 000264'02 000000 000000 37647 000265'02 000000 000000 37648 000266'02 000000 000000 37649 000267'02 000000 000000 37650 000270'02 000000 000000 37651 000010 typbkl==<.-typbk> ; Length of this GTJFN argument block. 37652 37653 000271'02 006000 000273' typfdb: flddb. .cmfil,,,,,typfd1 37654 000272'02 000000 000000 37655 000273'02 016001 000000 typfd1: flddb. .cmdev,cm%sdh ;[193] 37656 000274'02 000000 000000 37657 retsec 37658 cleans() 37659 37660 002651'01 .ytype: entry .ytype 37661 002651'01 200 01 0 00 006437' movx t1, cz%ncl!.fhslf ; Close any nonopen JFNs. 37662 002652'01 104 00 0 00 000034 CLZFF 37663 002653'01 320 12 0 00 002654' erjmpr .+1 ;[194] Catch and ignore any odd error 37664 002654'01 200 16 0 00 000000# guide ; Issue guide words. 37665 002655'01 260 17 0 00 002631* 37666 000275'02 000000000000# 37667 000573'04 146 151 154 145 163 37668 37669 002656'01 200 01 0 00 006537' move t1, [typbk,,cjfnbk] ; Insert our file parsing defaults. 37670 002657'01 251 01 0 00 000000# blt t1, cjfnbk+typbkl ; Same as for DELETE. 37671 002660'01 201 01 0 00 000000# movei t1, typfdb ;[193] 37672 002661'01 260 17 0 00 002342* call rfield ;[193] Parse something 37673 002662'01 200 05 0 00 000002 move q1, t2 ;[193] Store whatever we got 37674 002663'01 135 07 0 00 006275' ldb q3, [pointr (.cmfnp(t3),cm%fnc)] ;[193] Get function code. 37675 37676 002664'01 302 07 0 00 000016 caie q3, .cmdev ;[193] Picked up a device? 37677 002665'01 254 00 0 00 002716' ifskp. ;[193] Yes, let's see if we can work with it 37678 002666'01 265 16 0 00 001716* anstkv(t4,^d4) ;[193] 20 characters of device name 37679 002667'01 000000 000004 37680 002670'01 415 04 0 17 777773 37681 002671'01 402 00 0 04 000000 setzm (t4) ;[193] Let's scrub a bit of it 37682 002672'01 560 01 0 00 000004 hrro t1, t4 ;[193] Create a Tops-20 ASCII pointer 37683 002673'01 104 00 0 00 000121 DEVST% ;[193] Turn it into a string (I hope) 37684 002674'01 320 12 0 00 002676' ifje. r ;[193] Failed?? 37685 002675'01 254 00 0 00 002701' 37686 002676'01 200 03 0 00 000001 move t3, t1 ;[193] Save error code for debuggers 37687 002677'01 474 06 0 00 000000 seto q2, ;[193] Cons up an impossible JFN 37688 002700'01 254 00 0 00 002715' else. ;[193] Otherwise, have a string we can maybe use 37689 002701'01 120 02 0 00 006441' dmove t2, [ exp ":", 0] ;[193] Load final characters 37690 002702'01 136 02 0 00 000001 idpb t2, t1 ;[193] Punctuate the device 37691 002703'01 136 03 0 00 000001 idpb t3, t1 ;[193] Tie off the device string 37692 002704'01 205 01 0 00 000021 movx t1, ;[193] Short form, want flags 37693 002705'01 560 02 0 00 000004 hrro t2, t4 ;[193] Recreate a Tops-20 ASCII pointer k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 19:42 30-Mar-24 Page 42-1 K20SRV MAC 30-Mar-24 15:37 LOCAL TYPE [143] 37694 002706'01 104 00 0 00 000020 GTJFN% ;[193] Try to get a handle 37695 002707'01 320 12 0 00 002711' ifje. r ;[193] Sigh... 37696 002710'01 254 00 0 00 002714' 37697 002711'01 200 03 0 00 000001 move t3, t1 ;[193] Save error code for debuggers 37698 002712'01 474 06 0 00 000000 seto q2, ;[193] Cons up an impossible JFN 37699 002713'01 254 00 0 00 002715' else. ;[193] Otherwise, worked 37700 002714'01 200 06 0 00 000001 move q2, t1 ;[193] Put JFN in a COMND% kind of place 37701 002715'01 endif. ;[193] 37702 002715'01 endif. ;[193] End case of DEVST% handling 37703 002715'01 254 00 0 00 002717' else. ;[193] Otherwise, got a JFN 37704 002716'01 200 06 0 00 000005 move q2, q1 ;[193] Put JFN in a COMND% kind of place 37705 002717'01 endif. ;[193] End case .cmdev transmogrification 37706 37707 002717'01 337 01 0 00 000006 skipg t1, q2 ;[193] Load the JFN, unless we couldn't get one 37708 002720'01 200 01 0 00 000005 move t1, q1 ;[193] Otherwise, load the device 37709 002721'01 200 04 0 00 000001 move t4, t1 ;[193] Save a handy copy 37710 002722'01 260 17 0 00 001463* call isnulj ;[193] Is this NUL:? 37711 002723'01 254 00 0 00 002726' ifskp. ;[193] Yes, so let's fix up the parse 37712 002724'01 200 06 0 00 000001 move q2, t1 ;[193] Store the .nulio in there 37713 002725'01 254 00 0 00 002770' else. ;[193] Otherwise, isn't NUL: 37714 002726'01 200 01 0 00 000004 move t1, t4 ;[193] Load whatever we parsed 37715 002727'01 302 07 0 00 000016 caie q3, .cmdev ;[193] Did we parse a device? 37716 002730'01 254 00 0 00 002733' ifskp. ;[193] We did 37717 002731'01 200 01 0 00 000005 move t1, q1 ;[193] so use that 37718 002732'01 254 00 0 00 002734' else. ;[193] Otherwise, got a JFN 37719 002733'01 621 01 0 00 777777 tlz t1, -1 ;[193] So use that 37720 002734'01 endif. 37721 002734'01 104 00 0 00 000117 DVCHR% ;[198] Let's find out about the device 37722 002735'01 320 12 0 00 002737' %jserr (,r) ;[193] 37723 002736'01 254 00 0 00 002742' 37724 002737'01 265 01 0 00 002552* 37725 002740'01 000000000000# 37726 002741'01 254 00 0 00 002626* 37727 000575'04 124 171 160 145 040 37728 002742'01 135 03 0 00 006276' ldb t3,[pointr t2, dv%typ] ;[193] Pick up the device type 37729 002743'01 306 03 0 00 000000 cain t3, .dvdsk ;[193] Isn't a disk? 37730 002744'01 254 00 0 00 002770' anskp. ;[193] It is, so we're fine 37731 002745'01 200 02 0 00 000001 move t2, t1 ;[193] Load device designator for DEVST% 37732 002746'01 561 01 0 00 000003 hrroi t1, t3 ;[193] String is going in the registers 37733 002747'01 403 03 0 00 000004 setzb t3, t4 ;[193] Get 9 characters of device (only need 6) 37734 002750'01 104 00 0 00 000121 DEVST% ;[193] Get a string representation 37735 002751'01 320 12 0 00 002753' ifje. r ;[193] Pick up and ignore error 37736 002752'01 254 00 0 00 002755' 37737 002753'01 200 02 0 00 000001 move t2, t1 ;[193] Save error code for debuggers 37738 002754'01 120 03 0 00 006540' dmove t3, [asciz /Unknown/] ;[193] Phoney up something 37739 002755'01 endif. ;[193] 37740 002755'01 337 01 0 00 000006 skipg t1, q2 ;[193] Load the JFN 37741 002756'01 254 00 0 00 002762' ifskp. ;[193] If it was a JFN... 37742 002757'01 621 01 0 00 777777 tlz t1, -1 ;[193] Stomp any flags 37743 002760'01 104 00 0 00 000023 RLJFN% ;[193] Toss it 37744 002761'01 320 12 0 00 002762' erjmpr .+1 ;[193] Catch and ignore error 37745 002762'01 endif. ;[193] 37746 002762'01 561 01 0 00 000003 hrroi t1, t3 ;[193] String is coming from registers 37747 002763'01 104 00 0 00 000313 ESOUT% ;[193] Begin complaining 37748 txmsg <: is not a directory structured device k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 19:42 30-Mar-24 Page 42-2 K20SRV MAC 30-Mar-24 15:37 LOCAL TYPE [143] 37749 002764'01 200 01 0 00 000000# > ;[193] Complete the blat 37750 002765'01 104 00 0 00 000076 37751 002766'01 320 12 0 00 002767' 37752 000276'02 000000000000# 37753 000607'04 072 040 151 163 040 37754 37755 002767'01 254 00 0 00 001707* callret cmder1 ;[193] Allow a reparse 37756 002770'01 endif. ;[193] 37757 37758 002770'01 260 17 0 00 002632* confrm ;[193] Tie off the line 37759 002771'01 202 06 0 00 002354* movem q2, pars3 ; Here's the JFN just parsed. 37760 002772'01 263 17 0 00 000000 ret 37761 k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 19:42 30-Mar-24 Page 43 K20SRV MAC 30-Mar-24 15:37 LOCAL TYPE command execution. 37762 subttl LOCAL TYPE command execution. 37763 37764 002773'01 $ytype: entry $ytype ;[194] Maybe move this? 37765 002773'01 337 01 0 00 002771* skipg t1, pars3 ; Get the JFN. 37766 002774'01 263 17 0 00 000000 ret ; Junk, just don't do anything ... 37767 37768 002775'01 265 16 0 00 006265' saveac ; Save for fast copy of current JFN 37769 002776'01 200 05 0 00 000001 move q1, t1 ; Save the JFN (and its flags) 37770 002777'01 260 17 0 00 002722* call isnulj ; BUT!! Is this JFN open on NUL:? 37771 003000'01 254 00 0 00 003007' ifskp. ; It is, so fix some things up 37772 003001'01 202 01 0 00 001753* movem t1, filjfn ; Let's say .nulio is 'open' 37773 003002'01 202 01 0 00 002102* movem t1, nxtjfn ; And that it is our next JFN 37774 003003'01 202 01 0 00 002154* movem t1, ndxjfn ; Store as our pseudo-stepping JFN 37775 003004'01 502 05 0 00 003003* hllm q1, ndxjfn ; Also store original flags on NUL: 37776 003005'01 550 05 0 00 000001 hrrz q1, t1 ; And over the previous JFN and flags 37777 003006'01 254 00 0 00 003043' else. ; Otherwise, set up for real file stepping. 37778 003007'01 550 01 0 00 000005 hrrz t1, q1 ;[220] Load just the JFN, no flags 37779 003010'01 260 17 0 00 005474' call isdird ;[193] But! Did somebody slip something phonkey in? 37780 003011'01 254 00 0 00 003016' ifskp. ;[193] Nope, this is a directory device 37781 003012'01 202 05 0 00 003004* movem q1, ndxjfn ; Store JFN and flags 37782 003013'01 552 05 0 00 003002* hrrzm q1, nxtjfn ; Just the JFN, no flags 37783 003014'01 402 00 0 00 003001* setzm filjfn ; No file currently open 37784 003015'01 254 00 0 00 003043' else. ;[193] Otherwise, not NUL:, so we can't use this 37785 003016'01 265 16 0 00 002666* anstkv(q2,^d4) ;[193] 20 characters of device name 37786 003017'01 000000 000004 37787 003020'01 415 06 0 17 777773 37788 003021'01 403 03 0 00 000004 setzb t3, t4 ;[193] Cons up some NUL's 37789 003022'01 124 03 0 06 000000 dmovem t3, 0(q2) ;[193] Let's scrub 37790 003023'01 124 03 0 06 000002 dmovem t3, 2(q2) ;[193] a dub dub 37791 003024'01 561 01 0 06 000000 hrroi t1, 0(q2) ;[193] Tops-20 pointer to beginning of buffer 37792 003025'01 550 02 0 00 000005 hrrz t2, q1 ;[193] Load the JFN, sans flags 37793 dmove t3, [fld(.jsaof,js%dev)!js%paf 37794 003026'01 120 03 0 00 006542' 0 ] ;[193] Just the punctuated device, no prefix 37795 003027'01 104 00 0 00 000030 JFNS% ;[193] Convert it 37796 003030'01 320 12 0 00 003032' ifje. r ;[193] Failed?? 37797 003031'01 254 00 0 00 003035' 37798 003032'01 200 02 0 00 000001 move t2, t1 ;[193] Save the error for debuggers 37799 003033'01 120 03 0 00 006544' dmove t3, [ asciz /Unknown:/ ] ;[193] 37800 003034'01 124 03 0 06 000000 dmovem t3, 0(q2) ;[193] Store some kind of message... 37801 003035'01 endif. 37802 003035'01 561 01 0 06 000000 hrroi t1, 0(q2) ;[193] Tops-20 pointer to beginning of buffer 37803 003036'01 104 00 0 00 000313 ESOUT% ;[193] Begin whining 37804 txmsg < is not a directory structured device 37805 003037'01 200 01 0 00 000000# > 37806 003040'01 104 00 0 00 000076 37807 003041'01 320 12 0 00 003042' 37808 000277'02 000000000000# 37809 000620'04 040 151 163 040 156 37810 37811 003042'01 254 00 0 00 003125' jrst $ytypz ;[193] Finally get out of here 37812 003043'01 endif. ;[193] End directory device double check 37813 003043'01 endif. ;[193] End NUL: 'directory' special check 37814 37815 003043'01 260 17 0 00 002502* call ccon ;[169] Allow ^C out of this. 37816 003044'01 254 00 0 00 003122' jrst $ytypy ;[169] Upon ^C, get out of here k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 19:42 30-Mar-24 Page 43-1 K20SRV MAC 30-Mar-24 15:37 LOCAL TYPE command execution. 37817 37818 003045'01 do. ; Enter loop context 37819 003045'01 260 17 0 00 005525' call gtnfil ; Any more files? 37820 003046'01 254 00 0 00 003122' exit. ; Nope, beat it 37821 003047'01 550 05 0 00 000001 hrrz q1, t1 ; OK, so save what we're doing now 37822 003050'01 260 17 0 00 000000* call clrcno ; Clear Control-O, if set 37823 003051'01 561 01 0 00 002530* hrroi t1, crlf ; Tie off the line 37824 003052'01 104 00 0 00 000076 PSOUT% 37825 003053'01 201 01 0 00 000101 movei t1, .priou ; Going to primary output 37826 003054'01 200 02 0 00 000005 move t2, q1 ; Load the current JFN to do 37827 003055'01 260 17 0 00 000000* call typnam ; Type the file name 37828 003056'01 254 00 0 00 003122' exit. ; Stop processing files on error 37829 003057'01 200 01 0 00 000005 move t1, q1 ; Load JFN 37830 003060'01 302 01 0 00 377777 caie t1, .nulio ;[193] Not actually typing anything? 37831 003061'01 254 00 0 00 003064' ifskp. ;[193] No, so that's easy to set up 37832 003062'01 201 03 0 00 000010 movx t3, ^d8 ;[193] Assume NUL: is always eight bit 37833 003063'01 254 00 0 00 003106' else. ;[193] Otherwise, a real JFN, maybe? 37834 003064'01 200 02 0 00 006546' move t2, [1,,.fbbyv] ;Get bytesize. 37835 003065'01 201 03 0 00 000004 movei t3, t4 37836 003066'01 104 00 0 00 000063 GTFDB 37837 003067'01 320 12 0 00 003071' ifje. r ;[194] Might fail if not disk 37838 003070'01 254 00 0 00 003074' 37839 003071'01 200 03 0 00 000001 move t3, t1 ;[194] Save error code for debugger 37840 003072'01 400 04 0 00 000000 setz t4, ;[194] If failed, say no byte size 37841 003073'01 200 01 0 00 000005 move t1, q1 ;[194] Reload JFN 37842 003074'01 endif. ;[194] 37843 003074'01 200 02 0 00 006547' movx t2, of%rd+fld(7,of%bsz) ; Assume 7-bit mode. 37844 003075'01 135 03 0 00 006550' ldb t3, [pointr (t4,fb%bsz)] ; Extract the bytesize. 37845 003076'01 306 03 0 00 000010 cain t3, ^d8 ; 8 bit? 37846 003077'01 200 02 0 00 006551' movx t2, of%rd+fld(^d8,of%bsz) ; Yes, 8-bit. 37847 003100'01 104 00 0 00 000021 OPENF ; Open the file in appropriate mode. 37848 003101'01 320 12 0 00 003103' %jserr (,endlp.) 37849 003102'01 254 00 0 00 003106' 37850 003103'01 265 01 0 00 002737* 37851 003104'01 000000000000# 37852 003105'01 254 00 0 00 003122' 37853 000630'04 103 157 165 154 144 37854 003106'01 endif. ;[193] End .nulio special casing 37855 003106'01 260 17 0 00 000000* call typfil ; Type the file 37856 003107'01 254 00 0 00 003122' exit. ; If failed, go no further 37857 003110'01 200 01 0 00 000005 move t1, q1 ; Close the file. 37858 003111'01 302 01 0 00 377777 caie t1, .nulio ; Unless there is no need 37859 003112'01 104 00 0 00 000022 CLOSF 37860 003113'01 320 12 0 00 003115' %jserr (,endlp.) 37861 003114'01 254 00 0 00 003120' 37862 003115'01 265 01 0 00 003103* 37863 003116'01 000000000000# 37864 003117'01 254 00 0 00 003122' 37865 000636'04 103 157 165 154 144 37866 003120'01 400 05 0 00 000000 setz q1, ;[194] Done with this file 37867 003121'01 254 00 0 00 003045' loop. ;[194] Do the next file 37868 003122'01 enddo. ;[193] End loop context 37869 37870 003122'01 260 17 0 00 002506* $ytypy: call ccoff ; Turn off ^C 37871 003123'01 260 17 0 00 000000* call whakfp ; Whack any left over pages k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 19:42 30-Mar-24 Page 43-2 K20SRV MAC 30-Mar-24 15:37 LOCAL TYPE command execution. 37872 003124'01 600 00 0 00 000000 nop ; Ignore any error 37873 37874 003125'01 322 05 0 00 003130' $ytypz: ifn. q1 ; Any JFN left lying around maybe? 37875 003126'01 200 01 0 00 000005 move t1, q1 ; OK, so load it 37876 003127'01 260 17 0 00 000000* call frclos ; Force it to close 37877 003130'01 endif. 37878 003130'01 263 17 0 00 000000 ret ; No more, done. 37879 k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 19:42 30-Mar-24 Page 44 K20SRV MAC 30-Mar-24 15:37 REMOTE TYPE command execution. 37880 subttl REMOTE TYPE command execution. 37881 37882 003131'01 $xtype:; entry $xtype 37883 003131'01 336 00 0 00 002634* ifmn. tlgjfn ;[233] Doing transaction logging? 37884 003132'01 254 00 0 00 003154' 37885 003133'01 415 16 0 00 003154' block. ;[233] Get a stack frame 37886 003134'01 261 17 0 00 000016 37887 003135'01 265 16 0 00 006314' saveac ;[233] Save even the temporaries 37888 003136'01 476 00 0 00 002320* setom scrlft ;[233] Don't append the crlf! 37889 003137'01 265 01 0 00 002641* wtlog(,) ;[233] 37890 003140'01 000000000000# 37891 003141'01 777777 777744 37892 003142'01 000000 000000 37893 000644'04 122 145 161 165 145 37894 003143'01 200 01 0 00 003131* move t1, tlgjfn ;[233] Put the directory name in the log 37895 003144'01 561 02 0 00 002326* hrroi t2,atmbuf ;[233] It's in the atom buffer 37896 003145'01 403 03 0 00 000004 setzb t3,t4 ;[233] Don't know how long, stop on a NUL 37897 003146'01 104 00 0 00 000053 SOUT% ;[233] Out it goes! 37898 003147'01 320 14 0 00 003150' erjmps .+1 ;[233] Catch and suppress error 37899 dmove t2,[ -1,,crlf ;[233] Tops-20 pointer to carriage return line feed 37900 003150'01 120 02 0 00 006443' -2 ] ;[233] Counted SOUT%'s are faster 37901 003151'01 104 00 0 00 000053 SOUT% ;[233] Out it goes! 37902 003152'01 320 14 0 00 003153' erjmps .+1 ;[233] Catch and suppress error 37903 003153'01 263 17 0 00 000000 endbk. ;[233] Release stack frame, restoring AC's 37904 003154'01 endif. ;[233] 37905 37906 003154'01 260 17 0 00 002646* call statim ;[189] Start timing so k20pdc doesn't choke 37907 003155'01 201 04 0 00 000124 movei t4, "T" ; Generic command is T. 37908 003156'01 254 00 0 00 005362' jrst srvfil 37909 37910 k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 19:42 30-Mar-24 Page 45 K20SRV MAC 30-Mar-24 15:37 Server Operation 37911 subttl Server Operation 37912 37913 ; GETCOM 37914 ; 37915 ; We come here if we are in server mode. We just wait for a packet of one of 37916 ; the following types: 37917 ; 37918 ; S Send init - just follow the normal path from here 37919 ; R Receive init - like a local "send filespec" 37920 ; I Init (all-purpose exchange of parameters) 37921 ; G Generic command: 37922 ; L Logout - the other side is done, log out this job 37923 ; F Finish - exit from Kermit 37924 ; U Disk Usage query 37925 ; T Type a file 37926 ; etc 37927 ; 37928 ; First, issue a message telling the user what to do. 37929 ; 37930 003157'01 getcom: entry getcom ;[194] Also invoked from k20par 37931 movei t1, [ ;[157] In case line gets XOFF'd while 37932 call ttxon ;[157] typing the message, unstick it, 37933 003157'01 201 01 0 00 006552' jrst getcm2 ] ;[157] and proceed. 37934 003160'01 260 17 0 00 000000* call timeit ;[157] Set the timer. 37935 003161'01 336 00 0 00 002462* ifmn. local ;[174] Local mode? 37936 003162'01 254 00 0 00 003207' 37937 txmsg < 37938 003163'01 200 01 0 00 000000# Entering server mode on TTY> ;[174] Yes, give appropriate message. 37939 003164'01 104 00 0 00 000076 37940 003165'01 320 12 0 00 003166' 37941 000300'02 000000000000# 37942 000652'04 015 012 040 105 156 37943 003166'01 201 01 0 00 000101 numout ttynum, 8 37944 003167'01 200 02 0 00 000000* 37945 003170'01 201 03 0 00 000010 37946 003171'01 104 00 0 00 000224 37947 003172'01 320 14 0 00 003173' 37948 003173'01 337 02 0 00 000000* skipg t2, speed ;[194] Load speed 37949 003174'01 254 00 0 00 003206' ifskp. ;[194] If we have one .. 37950 003175'01 200 01 0 00 000000# txmsg <, > 37951 003176'01 104 00 0 00 000076 37952 003177'01 320 12 0 00 003200' 37953 000301'02 000000000000# 37954 000661'04 054 040 000 000 000 37955 003200'01 201 01 0 00 000101 movei t1, .priou ;[194] 37956 003201'01 201 03 0 00 000012 movei t3, ^d10 ;[194] 37957 003202'01 104 00 0 00 000224 NOUT% 37958 003203'01 200 01 0 00 000000# txmsg < baud> 37959 003204'01 104 00 0 00 000076 37960 003205'01 320 12 0 00 003206' 37961 000302'02 000000000000# 37962 000662'04 040 142 141 165 144 37963 003206'01 endif. ;[194] 37964 003206'01 254 00 0 00 003217' jrst getcmm ;[174] 37965 003207'01 endif. ;[194] k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 19:42 30-Mar-24 Page 45-1 K20SRV MAC 30-Mar-24 15:37 Server Operation 37966 37967 txmsg < 37968 003207'01 200 01 0 00 000000# Kermit Server running on > ;[186] 37969 003210'01 104 00 0 00 000076 37970 003211'01 320 12 0 00 003212' 37971 000303'02 000000000000# 37972 000664'04 015 012 040 113 145 37973 003212'01 561 01 0 00 000000* hrroi t1,sysnam## ;[186] Load local node name 37974 003213'01 104 00 0 00 000076 PSOUT% ;[186] Type it, not "DEC-20" 37975 txmsg < host. Please type your escape 37976 sequence to return to your local machine. Shut down the server by 37977 003214'01 200 01 0 00 000000# typing the BYE command to KERMIT on your local machine.> ;[186] 37978 003215'01 104 00 0 00 000076 37979 003216'01 320 12 0 00 003217' 37980 000304'02 000000000000# 37981 000672'04 040 150 157 163 164 37982 37983 37984 37985 getcmm: txmsg < 37986 003217'01 200 01 0 00 000000# > 37987 003220'01 104 00 0 00 000076 37988 003221'01 320 12 0 00 003222' 37989 000305'02 000000000000# 37990 000732'04 015 012 000 000 000 37991 003222'01 260 17 0 00 000000* getcm2: call timoff ;[157] Turn off timer. 37992 003223'01 260 17 0 00 003154* call statim ;[189] Give k20pdc something to not choke on 37993 003224'01 476 00 0 00 000000* setom srvflg ; Flag that we are serving. 37994 003225'01 260 17 0 00 000000* call inilin ; Initialize the line. 37995 003226'01 260 17 0 00 003043* call ccon ; Don't let someone ^C without reseting line. 37996 003227'01 254 00 0 00 003546' jrst xgfin2 ; On control-C, go "finish". 37997 003230'01 403 03 0 00 000004 setzb t3, t4 ; Set default parameters in case we get some 37998 003231'01 124 03 0 00 000000* dmovem t3, delay ;[212] No delay in server mode (gets floating value) 37999 003232'01 260 17 0 00 000000* call spar ; command before first Send-Init or Info. 38000 003233'01 254 00 0 00 003234' jrst xxwait ; Go wait for a command packet. 38001 k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 19:42 30-Mar-24 Page 46 K20SRV MAC 30-Mar-24 15:37 Server command loop 38002 subttl Server command loop 38003 38004 ; Server commands should always jrst back to here, even upon error, 38005 ; except for those that specify exit from server mode. 38006 38007 003234'01 332 00 0 00 000000* xxwait: skipe mdmlin ;[130] Modem line? 38008 003235'01 332 00 0 00 000000* skipe carier ;[130] Did carrier drop? 38009 003236'01 334 00 0 00 000000 skipa ;[130] No. 38010 003237'01 254 00 0 00 003546' jrst xgfin2 ;[130] Yes, go clean up. 38011 38012 003240'01 476 00 0 00 000000* setom sptot ;[134] Clear packet statistics counters 38013 003241'01 476 00 0 00 000000* setom rptot ;[134] ... 38014 003242'01 402 00 0 00 000000* setzm xflg ; Clear the server "type" flag. 38015 003243'01 402 00 0 00 000000* setzm source ; Ditto for GETCH source. 38016 003244'01 402 00 0 00 000000* setzm dest ; Ditto for PUTCH destination. 38017 003245'01 402 00 0 00 002152* setzm ffunc ; And for file function. 38018 003246'01 120 01 0 00 000000* dmove t1, srvtim ;[212] ; Get the default server packet time out. 38019 003247'01 124 01 0 00 000000* dmovem t1, stimou ;[212] ; Set it so we don't time out as often. 38020 38021 003250'01 do. ;[194] Enter loop context 38022 003250'01 476 00 0 00 000000* setom bctone ;[98] Set this so we use type 1 checksum. 38023 003251'01 402 00 0 00 002411* setzm pktnum ; Initial packet sequence number. 38024 003252'01 260 17 0 00 000000* call rpack ; Get a packet. 38025 003253'01 254 00 0 00 003270' ifskp. ;[194] Worked 38026 003254'01 306 01 0 00 000124 cain t1, "T" ;[194] But!! A TIMER interrupt pseudo packet? 38027 003255'01 254 00 0 00 003270' anskp. ; On timeout, NAK what we're looking for. 38028 003256'01 301 01 0 00 000101 cail t1, "A" ;[150] Packet type in range? 38029 003257'01 303 01 0 00 000132 caile t1, "Z" ;[150] 38030 003260'01 334 00 0 00 000000 kermsg (,xxwait) ;[150] No. 38031 003261'01 254 00 0 00 003266' 38032 003262'01 265 01 0 00 000000* 38033 003263'01 000000 000043 38034 003264'01 000000000000# 38035 003265'01 254 00 0 00 003234' 38036 000733'04 120 141 143 153 145 38037 003266'01 254 00 0 00 003274' exit. ;[194] Otherwise, goo so break out of the loop 38038 003267'01 254 00 0 00 003274' else. ;[194] Some kind of error 38039 003270'01 200 02 0 00 003251* move t2, pktnum ; Load current packet number 38040 003271'01 260 17 0 00 000000* call nak ; NAK that "packet". 38041 003272'01 254 00 0 00 003250' loop. ;[194] Go round again. 38042 003273'01 254 00 0 00 003250' loop. ; (no matter what) 38043 003274'01 endif. ;[194] End packet reception analysis 38044 003274'01 enddo. ;[194] End loop lexical context 38045 38046 ; Got a real command. Restore the normal timeout interval and do the command. 38047 38048 003274'01 202 02 0 00 003270* movem t2, pktnum ; Save packet number. 38049 003275'01 261 17 0 00 000001 push p, t1 ; We can't use any normal AC's here... 38050 003276'01 261 17 0 00 000002 push p, t2 ;[212] Ditto floating display value 38051 003277'01 120 01 0 00 000000* dmove t1, otimou ;[212] Put normal timeout back. 38052 003300'01 124 01 0 00 003247* dmovem t1, stimou ;[212] 38053 003301'01 262 17 0 00 000002 pop p, t2 ;[212] Restore this, too 38054 003302'01 262 17 0 00 000001 pop p, t1 38055 003303'01 275 01 0 00 000101 subi t1, "A" ;[194] Get into range (easier to debug) 38056 003304'01 254 00 1 01 003305' jrst @xxcmd(t1) ;[150] Go do the indicated command. k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 19:42 30-Mar-24 Page 46-1 K20SRV MAC 30-Mar-24 15:37 Server command loop 38057 k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 19:42 30-Mar-24 Page 47 K20SRV MAC 30-Mar-24 15:37 Server command loop 38058 38059 ;[150] Server command dispatch table and error message routines. 38060 38061 38062 003305'01 000000 003343' xxcmd: xxinv ; A - Attributes, shouldn't come now 38063 003306'01 000000 003343' xxinv ; B - EOT, shouldn't come now 38064 003307'01 000000 003430' xhost ; C - Host Command 38065 003310'01 000000 003343' xxinv ; D - Data, shouldn't come now 38066 003311'01 000000 003234' xxwait ; E - Error, just ignore 38067 003312'01 000000 003343' xxinv ; F - File header, shouldn't come now 38068 003313'01 000000 003436' xgen ; G - Generic Command 38069 003314'01 000000 003340' xxunk ; H - Undefined 38070 003315'01 000000 003672' xinfo ; I - Info Packet 38071 003316'01 000000 003340' xxunk ; J - Undefined 38072 003317'01 000000 003340' xxunk ; K - Undefined 38073 003320'01 000000 003340' xxunk ; L - Undefined 38074 003321'01 000000 003340' xxunk ; M - Undefined 38075 003322'01 000000 003234' xxwait ; N - NAK, ignore 38076 003323'01 000000 003340' xxunk ; O - Undefined 38077 003324'01 000000 003340' xxunk ; P - Undefined 38078 003325'01 000000 003340' xxunk ; Q - Undefined 38079 003326'01 000000 003374' xrecv ; R - Receive (GET), server sends 38080 003327'01 000000 003356' xsend ; S - Send, server receives 38081 003330'01 000000 003234' xxwait ; T - (Already handled specially above) 38082 003331'01 000000 003340' xxunk ; U - Undefined 38083 003332'01 000000 003340' xxunk ; V - Undefined 38084 003333'01 000000 003340' xxunk ; W - Undefined 38085 003334'01 000000 003343' xxinv ; X - Text Header, shouldn't come now 38086 003335'01 000000 003234' xxwait ; Y - ACK, ignore 38087 003336'01 000000 003343' xxinv ; Z - EOF, shouldn't come now 38088 003337'01 000000 000000 0 ; (superstition) 38089 38090 ; Routine to issue informative error messages. 38091 38092 003340'01 200 04 0 00 006554' xxunk: move t4, [point 7, xxumsg] ; Get "unknown command" message. 38093 003341'01 201 03 0 00 000034 movei t3, xxulen ; And its length 38094 003342'01 254 00 0 00 003345' jrst xxmsg 38095 38096 003343'01 200 04 0 00 006555' xxinv: move t4, [point 7, xxbmsg] ; Get "invalid use of..." message. 38097 003344'01 201 03 0 00 000041 movei t3, xxblen ; And its lentgh. 38098 38099 003345'01 261 17 0 00 000004 xxmsg: push p, t4 ; Save msg pointer. 38100 003346'01 133 00 0 00 000004 ibp t4 ; Point past opening quote. 38101 003347'01 136 01 0 00 000004 idpb t1, t4 ; Deposit the packet type. 38102 003350'01 201 01 0 00 000105 movei t1, "E" ; Send an Error packet. 38103 003351'01 200 02 0 00 003274* move t2, pktnum ; This is the packet number. 38104 003352'01 262 17 0 00 000004 pop p, t4 ; Get original pointer back. 38105 003353'01 260 17 0 00 002413* call spack ; Send the error packet. 38106 003354'01 600 00 0 00 000000 nop 38107 003355'01 254 00 0 00 003234' jrst xxwait ; Go back to command wait. k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 19:42 30-Mar-24 Page 48 K20SRV MAC 30-Mar-24 15:37 Server command loop 38108 38109 subttl Server commands. 38110 38111 ; Server SEND command (i.e. send to me, I'm the server, I receive the files.) 38112 ; 38113 ; We've just received a Send-Init. 38114 ; 38115 003356'01 402 00 0 00 000000* xsend: setzm numtry ; Packet retry counter. 38116 003357'01 202 02 0 00 003351* movem t2, pktnum ; Synchronize packet numbers. 38117 003360'01 260 17 0 00 003232* call spar ; Get the Send-Init parameters. 38118 003361'01 200 04 0 00 006556' move t4, [point 8, datbuf] ;[190] ;[50] Now send back our own, 38119 003362'01 260 17 0 00 000000* call rpar ; which we put in the data field of our ACK. 38120 003363'01 201 01 0 00 000131 movei t1, "Y" ; Set up the ACK. 38121 003364'01 200 02 0 00 003357* move t2, pktnum ; Packet number. 38122 003365'01 260 17 0 00 003353* call spack ; Send the packet. 38123 003366'01 254 00 0 00 003234' jrst xxwait ;* Give up if we can't.(?) 38124 003367'01 260 17 0 00 000000* call rrinit ;[126] Set things up for receiving. 38125 003370'01 201 11 0 00 000106 movei state, "F" ; Set the state to file send. 38126 003371'01 260 17 0 00 000000* call $recvs ;[42] Go look like we're receiving. 38127 003372'01 600 00 0 00 000000 nop ; 38128 003373'01 254 00 0 00 003234' jrst xxwait ; Get another command when done. 38129 38130 38131 ; Server RECEIVE (or GET) command -- Server sends files. 38132 ; 38133 ; We've just received a Receive-Init packet, containing a filename. 38134 ; (Or a remote TYPE command). T1-T4 contain packet parameters returned 38135 ; by RPACK. 38136 ; 38137 003374'01 200 01 0 00 000004 xrecv: move t1, t4 ;[141] Pointer to encoded filespec. 38138 003375'01 200 02 0 00 000003 move t2, t3 ;[141] Number of characters. 38139 003376'01 260 17 0 00 000000* call decodf ;[141] Decode it. 38140 003377'01 334 00 0 00 000000 kermsg (, xxwait) ;[141] Can't? Give message. 38141 003400'01 254 00 0 00 003405' 38142 003401'01 265 01 0 00 003262* 38143 003402'01 000000 000040 38144 003403'01 000000000000# 38145 003404'01 254 00 0 00 003234' 38146 000740'04 103 141 156 047 164 38147 003405'01 200 02 0 00 000001 move t2, t1 ;[141] Decoded OK, point to decoded filespec. 38148 38149 ; Entry point when filespec already decoded. 38150 38151 003406'01 205 01 0 00 100101 xrecv2: movx t1, gj%sht!gj%old!gj%ifg ; Old file and allow wildcarding. 38152 003407'01 104 00 0 00 000020 GTJFN% ; Get a JFN. 38153 003410'01 320 14 0 00 003412' %jsker (,xxwait) ; Can't, send error packet and loop. 38154 003411'01 254 00 0 00 003415' 38155 003412'01 265 01 0 00 000000* 38156 003413'01 000000 000000 38157 003414'01 254 00 0 00 003234' 38158 003415'01 202 01 0 00 003012* movem t1, ndxjfn ;[111] Got JFN, save wildcard bits here. 38159 003416'01 552 01 0 00 003013* hrrzm t1, nxtjfn ;[111] Initialize file lookahead. 38160 003417'01 260 17 0 00 002777* call isnulj ;[193] Is this the NUL: device? 38161 003420'01 254 00 0 00 003423' ifskp. ;[193] It is, propagate our talisman 38162 003421'01 552 01 0 00 003416* hrrzm t1, nxtjfn ;[193] Re-initialize file lookahead k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 19:42 30-Mar-24 Page 48-1 K20SRV MAC 30-Mar-24 15:37 Server commands. 38163 003422'01 552 01 0 00 003415* hrrzm t1, ndxjfn ;[193] Save JFN with whacked wildcard bits 38164 003423'01 endif. ;[193] 38165 38166 003423'01 260 17 0 00 005525' call gtnfil ;[111] Get next (in this case, first) file. 38167 003424'01 600 00 0 00 000000 nop ;[111] Could never fail, right? 38168 003425'01 260 17 0 00 000000* call $sends ; Go send the file(s). 38169 003426'01 600 00 0 00 000000 nop ; (in case it skips for some reason...) 38170 003427'01 254 00 0 00 003234' jrst xxwait ; Go back & get another command. 38171 38172 38173 ; HOST command. 38174 38175 003430'01 334 00 0 00 000000 xhost: kermsg (, xxwait) 38176 003431'01 254 00 0 00 003436' 38177 003432'01 265 01 0 00 003401* 38178 003433'01 000000 000050 38179 003434'01 000000000000# 38180 003435'01 254 00 0 00 003234' 38181 000745'04 110 157 163 164 040 38182 k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 19:42 30-Mar-24 Page 49 K20SRV MAC 30-Mar-24 15:37 Server commands. 38183 38184 ;[150] Server GENERIC command. Get the subcommand and execute it. 38185 38186 003436'01 134 01 0 00 000004 xgen: ildb t1, t4 ; Get the first character of the data field. 38187 003437'01 301 01 0 00 000101 cail t1, "A" ; Validate. 38188 003440'01 303 01 0 00 000132 caile t1, "Z" 38189 003441'01 334 00 0 00 000000 kermsg (, xxwait) ; Bad. 38190 003442'01 254 00 0 00 003447' 38191 003443'01 265 01 0 00 003432* 38192 003444'01 000000 000047 38193 003445'01 000000000000# 38194 003446'01 254 00 0 00 003234' 38195 000753'04 107 145 156 145 162 38196 38197 003447'01 370 00 0 00 000003 sos t3 ; Command in range, account for it. 38198 003450'01 275 01 0 00 000101 subi t1, "A" ;[194] Command in range, change to table offset 38199 003451'01 306 01 0 00 000121 cain t1, "Q" ;[189] Don't overwrite times on status query!! 38200 003452'01 254 00 1 01 003457' jrst @xxgcmd(t1) ;[194] Dispatch to it. 38201 38202 003453'01 260 17 1 01 003457' call @xxgcmd(t1) ;[189] Go do whatever we're supposed to be doing 38203 003454'01 260 17 0 00 000046* call endtim ;[189] Stop timing 38204 003455'01 260 17 0 00 000047* call elptim ;[189] Compute elapsed time 38205 003456'01 263 17 0 00 000000 ret ;[189] 38206 38207 38208 38209 ;[150] Server generic command dispatch table. 38210 38211 003457'01 000000 004353' xxgcmd: xgpwd ;[188] ; A - PWD 38212 003460'01 000000 003512' xgundf ; B - Undefined 38213 003461'01 000000 003757' xgcwd ; C - CWD 38214 003462'01 000000 004525' xgdir ; D - Directory 38215 003463'01 000000 004656' xgdel ; E - Erase (delete) 38216 003464'01 000000 003520' xgfin ; F - Finish 38217 003465'01 000000 004267' xgcdup ;[254] ; G - CDUP 38218 003466'01 000000 004447' xghelp ; H - Help 38219 003467'01 000000 003515' xgnyi ; I - Login (not yet implemented) 38220 003470'01 000000 003515' xgnyi ; J - Journal control (nyi) 38221 003471'01 000000 003515' xgnyi ; K - Copy (nyi) 38222 003472'01 000000 003562' xglogo ; L - Logout, Bye 38223 003473'01 000000 003515' xgnyi ; M - Short message 38224 003474'01 000000 003512' xgundf ; N - Undef 38225 003475'01 000000 003512' xgundf ; O - Undef 38226 003476'01 000000 003515' xgnyi ; P - Program invocation (nyi) 38227 003477'01 000000 004426' xgstat ; Q - Server status query 38228 003500'01 000000 003515' xgnyi ; R - Rename (nyi) 38229 003501'01 000000 003512' xgundf ; S - Undef 38230 003502'01 000000 003632' xgtype ; T - Type 38231 003503'01 000000 004175' xgdisk ; U - Disk Usage 38232 003504'01 000000 003515' xgnyi ; V - Variable Set/Query 38233 003505'01 000000 003515' xgnyi ; W - Who (Finger) 38234 003506'01 000000 003512' xgundf ; X - Undef 38235 003507'01 000000 003512' xgundf ; Y - Undef 38236 003510'01 000000 003512' xgundf ; Z - Undef 38237 003511'01 000000 000000 0 k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 19:42 30-Mar-24 Page 49-1 K20SRV MAC 30-Mar-24 15:37 Server commands. 38238 38239 003512'01 200 04 0 00 006557' xgundf: move t4, [point 7, xxgums] ; Issue message for undefined command. 38240 003513'01 201 03 0 00 000037 movei t3, xxguln 38241 003514'01 254 00 0 00 003345' jrst xxmsg 38242 38243 003515'01 200 04 0 00 006560' xgnyi: move t4, [point 7, xxgnms] ; Issue msg for unimplemented command. 38244 003516'01 201 03 0 00 000043 movei t3, xxgnln 38245 003517'01 254 00 0 00 003345' jrst xxmsg k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 19:42 30-Mar-24 Page 50 K20SRV MAC 30-Mar-24 15:37 Server commands. 38246 38247 ; Generic commands... 38248 38249 38250 ; FINISH. Shut down the server, but don't log out. 38251 38252 003520'01 201 01 0 00 000131 xgfin: movei t1, "Y" ; Acknowledge packet. 38253 003521'01 403 03 0 00 000004 setzb t3, t4 ; No data. 38254 003522'01 260 17 0 00 003365* call spack ; Send the packet. 38255 003523'01 600 00 0 00 000000 nop ;[56] 38256 003524'01 201 01 0 00 003546' movei t1,xgfin2 ;[186] Where to go on a time out 38257 003525'01 260 17 0 00 003160* call timeit ;[186] Start a timer 38258 003526'01 337 01 0 00 000000* skipg t1, netjfn ;[186] Wait until the packet 38259 003527'01 200 01 0 00 000000* move t1, ttyjfn ;[186] Unless using local terminal 38260 003530'01 336 00 0 00 000000* ifmn. ptyflg ;[186] On a pseudo-terminal? 38261 003531'01 254 00 0 00 003542' 38262 003532'01 200 01 0 00 000000* move t1,ptytty ;[186] Load PTY's associated TTY 38263 003533'01 104 00 0 00 000212 DIBE% ;[186] Wait for it to swallow everything 38264 003534'01 320 12 0 00 003536' %jsErr (,) ;[186] 38265 003535'01 254 00 0 00 003541' 38266 003536'01 265 01 0 00 003115* 38267 003537'01 000000000000# 38268 003540'01 254 00 0 00 003541' 38269 000761'04 103 157 165 154 144 38270 003541'01 254 00 0 00 003544' else. ;[186] Otherwise, do it the ordinary way 38271 003542'01 104 00 0 00 000104 DOBE ;[158] gets all the way out. 38272 003543'01 320 12 0 00 003544' erjmpr .+1 ;[186] Catch and ignore error 38273 003544'01 endif. ;[186] End case waiting for output done 38274 003544'01 260 17 0 00 003222* call timoff ;[186] Shut off the timer 38275 003545'01 476 00 0 00 000050* setom f$exit ;[137] Say we want to go back to command level. 38276 38277 003546'01 260 17 0 00 000000* xgfin2: call rrslin ;[121] Put line back in interactive state. 38278 003547'01 120 01 0 00 000000* dmove t1, odelay ;[194] ;[27] Restore normal delay 38279 003550'01 124 01 0 00 003231* dmovem t1, delay ;[194] ;[27] 38280 003551'01 120 01 0 00 003277* dmove t1, otimou ;[212] ;[27] and timout interval 38281 003552'01 124 01 0 00 003300* dmovem t1, stimou ;[212] ;[27] 38282 003553'01 402 00 0 00 003224* setzm srvflg ;[27] and reset the server flag 38283 003554'01 265 01 0 00 003137* wtlog (,) ;[244] Log the FINISH. 38284 003555'01 000000000000# 38285 003556'01 777777 777761 38286 003557'01 000000 000000 38287 000770'04 106 111 116 111 123 38288 003560'01 260 17 0 00 000000* call clenup## ;[244] Close all logs. 38289 003561'01 263 17 0 00 000000 ret ; Done 38290 38291 ; LOGOUT (or BYE) -- Shut down the server and log out. 38292 38293 003562'01 201 01 0 00 000131 xglogo: movei t1, "Y" ; Acknowledge the command. 38294 003563'01 403 03 0 00 000004 setzb t3, t4 ; No data. 38295 003564'01 260 17 0 00 003522* call spack ; Send the packet. 38296 003565'01 600 00 0 00 000000 nop ; 38297 003566'01 201 01 0 00 003607' movei t1,xglog1 ;[186] Where to go on a time out 38298 003567'01 260 17 0 00 003525* call timeit ;[186] Start a timer 38299 003570'01 337 01 0 00 003526* skipg t1, netjfn ;[186] Wait until the packet 38300 003571'01 200 01 0 00 003527* move t1, ttyjfn ;[186] Unless using local terminal k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 19:42 30-Mar-24 Page 50-1 K20SRV MAC 30-Mar-24 15:37 Server commands. 38301 003572'01 336 00 0 00 003530* ifmn. ptyflg ;[186] On a pseudo-terminal? 38302 003573'01 254 00 0 00 003604' 38303 003574'01 200 01 0 00 003532* move t1,ptytty ;[186] Load PTY's associated TTY 38304 003575'01 104 00 0 00 000212 DIBE% ;[186] Wait for it to swallow everything 38305 003576'01 320 12 0 00 003600' %jsErr (,) ;[186] 38306 003577'01 254 00 0 00 003603' 38307 003600'01 265 01 0 00 003536* 38308 003601'01 000000000000# 38309 003602'01 254 00 0 00 003603' 38310 000774'04 103 157 165 154 144 38311 003603'01 254 00 0 00 003606' else. ;[186] Otherwise, do it the ordinary way 38312 003604'01 104 00 0 00 000104 DOBE ;[158] gets all the way out. 38313 003605'01 320 12 0 00 003606' erjmpr .+1 ;[186] Catch and ignore error 38314 003606'01 endif. ;[186] End case waiting for output done 38315 003606'01 260 17 0 00 003544* call timoff ;[186] Shut off the timer 38316 003607'01 260 17 0 00 003546* xglog1: call rrslin ;[186] Restore the line for interactive use. 38317 003610'01 120 01 0 00 003547* dmove t1, odelay ;[194] Restore normal delay 38318 003611'01 124 01 0 00 003550* dmovem t1, delay ;[194] 38319 003612'01 120 01 0 00 003551* dmove t1, otimou ;[212] and timout interval 38320 003613'01 124 01 0 00 003552* dmovem t1, stimou ;[212] 38321 003614'01 402 00 0 00 003553* setzm srvflg ; and reset the server flag. 38322 003615'01 265 01 0 00 003554* wtlog (,) ;[126] Log the BYE. 38323 003616'01 000000000000# 38324 003617'01 777777 777764 38325 003620'01 000000 000000 38326 001003'04 102 131 105 040 122 38327 003621'01 260 17 0 00 003560* call clenup## ;[126] Close all logs. 38328 003622'01 476 00 0 00 003545* setom f$exit ; Just in case we can't logout, set exit flag. 38329 003623'01 474 01 0 00 000000 seto t1, ; -1 = Myself. 38330 003624'01 104 00 0 00 000003 LGOUT% ; Log me out. 38331 003625'01 320 14 0 00 003627' %jsker (,r) ; If this fails, print msg & go back. 38332 003626'01 254 00 0 00 003632' 38333 003627'01 265 01 0 00 003412* 38334 003630'01 000000 000000 38335 003631'01 254 00 0 00 002741* 38336 k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 19:42 30-Mar-24 Page 51 K20SRV MAC 30-Mar-24 15:37 Server commands. 38337 38338 ; Command to TYPE a file. Just like sending a file, except must send "X" 38339 ; packet instead of file header. 38340 38341 003632'01 260 17 0 00 003725' xgtype: call getarg ; Get the argument. 38342 003633'01 476 00 0 00 003242* setom xflg ; Send file with X header. 38343 003634'01 336 00 0 00 003143* ifmn. tlgjfn ;[233] Doing transaction logging? 38344 003635'01 254 00 0 00 003670' 38345 003636'01 415 16 0 00 003670' block. ;[233] Get a stack frame 38346 003637'01 261 17 0 00 000016 38347 003640'01 265 16 0 00 006314' saveac ;[233] Save even the temporaries 38348 003641'01 202 04 0 00 000000# movem t4,tmpjfn ;[233] Save the pointer 38349 003642'01 476 00 0 00 003136* setom scrlft ;[233] Don't append the crlf! 38350 003643'01 265 01 0 00 003615* wtlog(,) ;[233] 38351 003644'01 000000000000# 38352 003645'01 777777 777770 38353 003646'01 000000 000000 38354 001006'04 123 145 156 144 151 38355 003647'01 200 01 0 00 003634* move t1, tlgjfn ;[233] Put the directory name in the log 38356 003650'01 200 02 0 00 000000# move t2,tmpjfn ;[233] Reload the pointer 38357 003651'01 403 03 0 00 000004 setzb t3,t4 ;[233] Don't know how long, stop on a NUL 38358 003652'01 104 00 0 00 000053 SOUT% ;[233] Out it goes! 38359 003653'01 320 14 0 00 003654' erjmps .+1 ;[233] Catch and suppress error 38360 003654'01 402 00 0 00 000000# setzm tmpjfn ;[233] Scrub it, not a JFN anyway 38361 003655'01 120 02 0 00 000000# dxtext (t2,< for local display >) ;[233] 38362 000306'02 000000000000# 38363 000307'02 777777 777755 38364 001010'04 040 146 157 162 040 38365 003656'01 415 16 0 00 003667' block. ;[233] Set up ANOTHER stack context 38366 003657'01 261 17 0 00 000016 38367 003660'01 265 16 0 00 006301' saveac ;[233] Needs plenty registers for intersection jumps 38368 003661'01 254 14 0 00 000007 xsfm q3 ;[233] Get and store current processor flags 38369 003662'01 200 10 0 00 000000* move q4, bigsou## ;[233] Load up inter-section transfer address 38370 003663'01 201 11 0 00 003665' movei q5, .+2 ;[233] And the inter-section return adress 38371 003664'01 254 05 0 00 000007 xjrstf q3 ;[233] and take a giant step! 38372 003665'01 263 17 0 00 000000 ret ;[232] Get out of the block, restoring registers 38373 003666'01 263 17 0 00 000000 endbk. ;[232] End lexical SOUT% block 38374 003667'01 263 17 0 00 000000 endbk. ;[233] Release stack frame, restoring AC's 38375 003670'01 endif. ;[233] End case transaction logging 38376 003670'01 200 02 0 00 000004 move t2, t4 ;[141] Point to filespec. 38377 003671'01 254 00 0 00 003406' jrst xrecv2 ;[141] Do like when we get an R packet. k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 19:42 30-Mar-24 Page 52 K20SRV MAC 30-Mar-24 15:37 Server commands. 38378 38379 ;[58] Init-Info mechanism added as edit 58. 38380 ; 38381 ; Get an "I" parameters packet from the user, record the parameters, and send 38382 ; our own back in return. This exchange is optional, but should take place 38383 ; before any server/user transaction except file transfer, where it is required 38384 ; and always takes place via the Send-Init mechanism. 38385 ; 38386 003672'01 202 02 0 00 003364* xinfo: movem t2, pktnum ; Set the parameters we just got. 38387 003673'01 260 17 0 00 003360* call spar 38388 003674'01 402 00 0 00 003356* setzm numtry 38389 003675'01 200 04 0 00 006556' move t4, [point 8, datbuf] ;[190] Respond with ours. 38390 003676'01 260 17 0 00 003362* call rpar 38391 003677'01 201 01 0 00 000131 movei t1, "Y" 38392 003700'01 200 02 0 00 003672* move t2, pktnum 38393 003701'01 260 17 0 00 003564* call spack 38394 003702'01 600 00 0 00 000000 nop ; If they don't get it, they'll ask again... 38395 003703'01 254 00 0 00 003234' jrst xxwait k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 19:42 30-Mar-24 Page 53 K20SRV MAC 30-Mar-24 15:37 Server commands. 38396 38397 ; GTSCH -- Get String Character 38398 ; 38399 ; Alternate GETCH routine for getting a character from an ASCIZ string in 38400 ; memory. Uses global STRPTR for input string. 38401 ; 38402 ; Returns: 38403 ; +1 if no more characters left in string. 38404 ; +2 always, with NEXT containing next character, -1 if no more. 38405 ; 38406 003704'01 gtsch: entry gtsch ;[220] 38407 003704'01 134 01 0 00 002412* ildb t1, strptr ; Get next character. 38408 003705'01 322 01 0 00 003710' jumpe t1, gtschz ; If zero, must be done. 38409 38410 ; Return with character like GETCH. 38411 38412 003706'01 202 01 0 00 000000* gtschx: movem t1, next ; Put result in NEXT, as GETCH does. 38413 003707'01 254 00 0 00 002312* retskp ; Done. 38414 38415 ; "EOF" return, like GETCH 38416 38417 003710'01 400 01 0 00 000000 gtschz: setz t1, 38418 003711'01 476 00 0 00 003706* setom next 38419 003712'01 263 17 0 00 000000 ret k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 19:42 30-Mar-24 Page 54 K20SRV MAC 30-Mar-24 15:37 Server commands. 38420 38421 ; PUTSCH 38422 ; 38423 ; Alternate PUTCH routine. Just writes the character to a string in memory. 38424 ; Call with t2/ character to write. 38425 ; 38426 003713'01 putsch: entry putsch ;[220] 38427 003713'01 136 02 0 00 003704* idpb t2, strptr ; Here's the alternate PUTCH routine. 38428 003714'01 254 00 0 00 003707* retskp ; It always succeeds. 38429 38430 38431 ; PUTTCH 38432 ; 38433 ; Another alternate PUTCH routine. Writes the character to the terminal. 38434 ; Call like PUTCH and PUTSCH. 38435 ; 38436 38437 003715'01 puttch: entry puttch ;[220] 38438 003715'01 336 00 0 00 003161* skipn local ;[186] ;[177] But only if local. 38439 003716'01 254 00 0 00 003714* retskp ;[177] ... 38440 003717'01 261 17 0 00 000001 push p, t1 38441 003720'01 201 01 0 00 000101 movei t1, .priou 38442 003721'01 104 00 0 00 000051 BOUT 38443 003722'01 320 16 0 00 003723' erjmp .+1 38444 003723'01 262 17 0 00 000001 pop p, t1 38445 003724'01 254 00 0 00 003716* retskp 38446 38447 k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 19:42 30-Mar-24 Page 55 K20SRV MAC 30-Mar-24 15:37 Get Argument 38448 subttl Get Argument 38449 38450 ; Does the following: 38451 ; 38452 ; 1) Decodes server command packet 38453 ; 2) Sets up pointers to packet 38454 ; 3) Gets first argument 38455 ; 38456 ; Returns +1 always with: 38457 ; 38458 ; t3/ Length of first argument 38459 ; t4/ pointer to first argument 38460 38461 003725'01 201 01 0 00 003713' getarg: movei t1, putsch ; Address of alternate PUTCH routine. 38462 003726'01 202 01 0 00 003244* movem t1, dest 38463 003727'01 402 00 0 00 002374* setzm strbuf ; Clear decoding area. 38464 003730'01 200 01 0 00 006561' move t1, [strbuf,,strbuf+1] 38465 003731'01 251 01 0 00 000000* blt t1, strbz 38466 003732'01 200 01 0 00 006420' move t1, [point 7, strbuf] ; Where to put the decoded string. 38467 003733'01 202 01 0 00 003713* movem t1, strptr 38468 003734'01 200 01 0 00 000004 move t1, t4 ; Pointer to data to decode. 38469 003735'01 200 02 0 00 000003 move t2, t3 ; Length. 38470 003736'01 260 17 0 00 000000* call putbuf ; Go decode the packet. 38471 003737'01 254 00 0 00 003742' ifskp. ;[194] Worked, that's promising 38472 003740'01 402 00 0 00 003726* setzm dest ; Put PUTCH back to normal. 38473 003741'01 254 00 0 00 003751' else. ;[194] Failed somehow 38474 003742'01 402 00 0 00 003740* setzm dest ;[194] Stomp whatever's driving PUTCH 38475 003743'01 334 00 0 00 000000 kermsg (, xxwait) ;[194] 38476 003744'01 254 00 0 00 003751' 38477 003745'01 265 01 0 00 003443* 38478 003746'01 000000 000046 38479 003747'01 000000000000# 38480 003750'01 254 00 0 00 003234' 38481 001014'04 103 141 156 047 164 38482 003751'01 endif. ;[194] 38483 003751'01 200 04 0 00 006420' move t4, [point 7, strbuf] ; Point to decoded string. 38484 003752'01 134 03 0 00 000004 ildb t3, t4 ; Get CHAR(length) of directory string. 38485 003753'01 305 03 0 00 000040 caige t3, 40 ;[128] If null, no need to convert. 38486 003754'01 201 03 0 00 000040 movei t3, 40 ;[128] This also catches funny cases. 38487 003755'01 275 03 0 00 000040 subi t3, 40 ; UNCHAR of that to make a number. 38488 003756'01 263 17 0 00 000000 ret k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 19:42 30-Mar-24 Page 56 K20SRV MAC 30-Mar-24 15:37 Get Argument 38489 38490 ;[107] CWD server command (Connect to directory in DEC-20 parlance). 38491 ; 38492 ; Changes Working Directory, sends new directory name back in ACK, or else 38493 ; error packet if there's a problem. 38494 ; 38495 ; Arrive here with t4 containing pointer to argument string of form 38496 ; 38497 ; where is a single character (offset by CHAR), 38498 ; and t3 containing the length of the string. 38499 ; 38500 38501 003757'01 260 17 0 00 003725' xgcwd: call getarg ; Get the first argument. 38502 003760'01 327 03 0 00 003770' jumpg t3, xgcwd2 ; If positive, go handle string. 38503 003761'01 322 03 0 00 004133' jumpe t3, xgcwd5 ; If null, go connect back to own directory. 38504 38505 003762'01 334 00 0 00 000000 kermsg (,xxwait) ; Negative length??? 38506 003763'01 254 00 0 00 003770' 38507 003764'01 265 01 0 00 003745* 38508 003765'01 000000 000051 38509 003766'01 000000000000# 38510 003767'01 254 00 0 00 003234' 38511 001022'04 102 141 144 040 154 38512 38513 ; Set up argument block for ACCES 38514 38515 003770'01 200 05 0 00 000004 xgcwd2: move q1, t4 ; Byte pointer to directory string. 38516 003771'01 133 03 0 00 000004 adjbp t3, t4 ; Now point to password. 38517 003772'01 134 04 0 00 000003 ildb t4, t3 ; Get its length. 38518 003773'01 200 06 0 00 000003 move q2, t3 ; Put pointer in ACCES arg block. 38519 003774'01 275 04 0 00 000040 subi t4, 40 ; UNCHAR to make it a number. 38520 003775'01 335 00 0 00 000004 skipge t4 ; Normal kind of number? 38521 003776'01 400 04 0 00 000000 setz t4, ; No, must have fallen off end, so no pswd. 38522 003777'01 400 02 0 00 000000 setz t2, ; Zero the length to make directory asciz. 38523 004000'01 137 02 0 00 000003 dpb t2, t3 ; ... 38524 004001'01 133 04 0 00 000003 adjbp t4, t3 ; Make sure password is asciz. 38525 004002'01 136 02 0 00 000004 idpb t2, t4 38526 38527 ;[255] See if the belief is that Tops-20 is really Unix, Windows, DOS or OS/2 ... 38528 38529 004003'01 415 16 0 00 004017' block. ;[255] Enter block context for better control flow 38530 004004'01 261 17 0 00 000016 38531 004005'01 200 02 0 00 000005 move t2, q1 ;[255] Pick up the pointer 38532 004006'01 134 01 0 00 000002 ildb t1, t2 ;[255] Pick up first byte (might not be on a word) 38533 004007'01 302 01 0 00 000056 caie t1, "." ;[255] First part of talisman? 38534 004010'01 263 17 0 00 000000 ret ;[255] No, so go do it the old fashioned way 38535 004011'01 134 01 0 00 000002 ildb t1, t2 ;[255] Pick up second byte 38536 004012'01 302 01 0 00 000056 caie t1, "." ;[255] Second part of talisman? 38537 004013'01 263 17 0 00 000000 ret ;[255] No, so some kind of gubbish ... 38538 004014'01 134 01 0 00 000002 ildb t1, t2 ;[255] Pick up third byte 38539 004015'01 322 01 0 00 003724* jumpe t1, RSKP ;[255] Should be end of string 38540 004016'01 263 17 0 00 000000 endbk. ;[255] Close out control block 38541 004017'01 254 00 0 00 004021' ifskp. ;[255] Was it ".."? 38542 004020'01 254 00 0 00 004267' jrst xgcdup ;[255] Go pretend we got a CDUP 38543 004021'01 endif. ;[255] Otherwise, proceed 'normally' k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 19:42 30-Mar-24 Page 56-1 K20SRV MAC 30-Mar-24 15:37 Get Argument 38544 38545 ;[193] Check to see what we might be connecting to 38546 38547 004021'01 205 01 0 00 000001 xgcwd3: movx t1, rc%emo ;[193] Exact match only 38548 004022'01 200 02 0 00 000005 move t2, q1 ;[193] Load pointer to the string that got sent 38549 004023'01 400 03 0 00 000000 setz t3, ;[193] Not doing any directory stepping 38550 004024'01 104 00 0 00 000553 RCDIR% ;[193] See if it exists 38551 004025'01 320 12 0 00 004027' ifje. r ;[193] Catch and ignore error 38552 004026'01 254 00 0 00 004064' 38553 004027'01 200 04 0 00 000001 move t4, t1 ;[249] May be of interest to debuggers 38554 004030'01 415 16 0 00 004060' block. ;[249] Enter block context for ease of flow 38555 004031'01 261 17 0 00 000016 38556 004032'01 104 00 0 00 000013 GJINF% ;[249] Get our connected directory 38557 004033'01 320 12 0 00 003631* erjmpr r ;[249] Should be impossible, BUT ... 38558 004034'01 561 01 0 00 000000# hrroi t1, cwdbuf ;[249] Write current connected directory here 38559 remark t2, ;[249] Now has current connected directory 38560 004035'01 104 00 0 00 000041 DIRST% ;[249] Turn into a string 38561 004036'01 320 12 0 00 004033* erjmpr r ;[249] If didn't work, can't do relative 38562 004037'01 135 04 0 00 000001 ldb t4, t1 ;[249] Load closing punctuation 38563 004040'01 201 03 0 00 000056 movx t3, "." ;[249] Load the subdirectory punctuation 38564 004041'01 137 03 0 00 000001 dpb t3, t1 ;[249] Overwrite closing punctuation 38565 004042'01 200 02 0 00 000005 move t2, q1 ;[249] Load pointer to possible relative directory 38566 004043'01 do. ;[249] Enter loop context 38567 004043'01 134 03 0 00 000002 ildb t3, t2 ;[249] Pick up a byte from source (the packet) 38568 004044'01 322 03 0 00 004047' jumpe t3, endlp. ;[249] If NUL, we're done 38569 004045'01 136 03 0 00 000001 idpb t3, t1 ;[249] Append it to punctuated directory 38570 004046'01 254 00 0 00 004043' loop. ;[249] Get some more bytes 38571 004047'01 enddo. ;[249] Exit loop lexical context 38572 004047'01 136 04 0 00 000001 idpb t4, t1 ;[249] Append closing punctuation 38573 004050'01 136 03 0 00 000001 idpb t3, t1 ;[249] Tie off the string 38574 004051'01 205 01 0 00 000001 movx t1, rc%emo ;[249] Exact match only 38575 004052'01 561 02 0 00 000000# hrroi t2, cwdbuf ;[249] Load pointer to new candidate 38576 004053'01 400 03 0 00 000000 setz t3, ;[249] Not doing any directory stepping 38577 004054'01 104 00 0 00 000553 RCDIR% ;[249] See if that exists 38578 004055'01 320 12 0 00 004036* erjmpr r ;[249] No luck... 38579 004056'01 254 00 0 00 004015* retskp ;[249] Won something 38580 004057'01 263 17 0 00 000000 endbk. ;[249] End block context 38581 004060'01 254 00 0 00 004062' ifskp. ;[249] Successful recovery 38582 remark ;[249] Nothing special to do, carry on 38583 004061'01 254 00 0 00 004064' else. ;[249] Otherwise, wasn't a valid relative directory 38584 004062'01 200 03 0 00 000001 move t3, t1 ;[249] Save any other error 38585 004063'01 205 01 0 00 040000 movx t1, rc%nom ;[193] On any failure, say no match 38586 004064'01 endif. ;[249] End of absolute RCDIR% recovery attempt 38587 004064'01 endif. ;[193] End RCDIR% error handling 38588 38589 004064'01 603 01 0 00 040000 ifxe. t1, rc%nom ;[249] If no match is off, then directory exists 38590 004065'01 254 00 0 00 004070' 38591 004066'01 202 03 0 00 000005 movem t3, q1 ;[249] Stomp in resolved directory number 38592 004067'01 254 00 0 00 004121' jrst xgcwd4 ;[249] Carry on and connect 38593 004070'01 endif. ;[249] End case successful match 38594 38595 004070'01 200 01 0 00 000005 move t1, q1 ;[193] Load pointer to the string that got sent 38596 004071'01 104 00 0 00 000120 STDEV% ;[193] Translate to a device 38597 004072'01 320 14 0 00 004074' %jsker (,xxwait) ;[193] Ship error message back in an error packet. 38598 004073'01 254 00 0 00 004077' k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 19:42 30-Mar-24 Page 56-2 K20SRV MAC 30-Mar-24 15:37 Get Argument 38599 004074'01 265 01 0 00 003627* 38600 004075'01 000000 000000 38601 004076'01 254 00 0 00 003234' 38602 004077'01 200 01 0 00 000002 move t1, t2 ;[193] Load the device designator 38603 004100'01 104 00 0 00 000117 DVCHR% ;[193] Get its characteristics 38604 004101'01 320 14 0 00 004103' %jsker (,xxwait) ;[193] STDEV% just handed it to us... 38605 004102'01 254 00 0 00 004106' 38606 004103'01 265 01 0 00 004074* 38607 004104'01 000000 000000 38608 004105'01 254 00 0 00 003234' 38609 004106'01 135 03 0 00 006276' ldb t3, [pointr t2, dv%typ] ;[193] Pick up the device type 38610 004107'01 306 03 0 00 000015 cain t3, .dvnul ;[193] Want's to do absolutely nothing? 38611 004110'01 254 00 0 00 004146' jrst xgcwdz ;[193] Fine, then don't do anything 38612 dmove t1, [ .fhslf ;[193] Get ready to complain about ourself 38613 004111'01 120 01 0 00 006562' RCDIX3 ] ;[193] Force "Invalid structure name" 38614 004112'01 104 00 0 00 000336 SETER% ;[193] Set last error for this process 38615 004113'01 320 12 0 00 004114' erjmpr .+1 ;[193] Catch and ignore error 38616 004114'01 254 00 0 00 004116' %erker (,xxwait) ;[193] Go blat and leave 38617 004115'01 254 00 0 00 004121' 38618 004116'01 265 01 0 00 004103* 38619 004117'01 000000000000# 38620 004120'01 254 00 0 00 003234' 38621 001031'04 116 157 164 040 141 38622 38623 ; Access the directory. ** Maybe should also mount structure if necessary? 38624 38625 004121'01 200 01 0 00 006354' xgcwd4: move t1, [ac%con!<3>] ; Function is Connect, arg block has 2 words. 38626 004122'01 201 02 0 00 000005 movei t2, q1 ; Address of argument block. 38627 004123'01 474 07 0 00 000000 seto q3, ; Own job. 38628 004124'01 104 00 0 00 000552 ACCES 38629 004125'01 320 14 0 00 004127' %jsker (,xxwait) ; Send any error message in error packet. 38630 004126'01 254 00 0 00 004132' 38631 004127'01 265 01 0 00 004116* 38632 004130'01 000000 000000 38633 004131'01 254 00 0 00 003234' 38634 004132'01 254 00 0 00 004146' jrst xgcwdz ; Done connecting, go send ACK. k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 19:42 30-Mar-24 Page 57 K20SRV MAC 30-Mar-24 15:37 Get Argument 38635 38636 ;...XGCWD, cont'd 38637 38638 38639 ; Come here to connect to own directory. 38640 38641 004133'01 200 05 0 00 000000# xgcwd5: move q1, .jilno+jobtab ;[220] Logged-in directory number. 38642 004134'01 400 06 0 00 000000 setz q2, ; No password needed 38643 004135'01 474 07 0 00 000000 seto q3, ; Own job. 38644 004136'01 201 02 0 00 000005 movei t2, q1 ; Address of arg block. 38645 004137'01 200 01 0 00 006354' move t1, [ac%con!<3>] ; Function is connect. 38646 004140'01 104 00 0 00 000552 ACCES ; Connect to own directory. 38647 004141'01 320 14 0 00 004143' %jsker (,xxwait) 38648 004142'01 254 00 0 00 004146' 38649 004143'01 265 01 0 00 004127* 38650 004144'01 000000 000000 38651 004145'01 254 00 0 00 003234' 38652 ;... k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 19:42 30-Mar-24 Page 58 K20SRV MAC 30-Mar-24 15:37 Get Argument 38653 38654 ;...XGCWD, cont'd 38655 38656 38657 ; Done, send back ACK with directory string in it. 38658 38659 004146'01 104 00 0 00 000013 xgcwdz: GJINF 38660 004147'01 200 01 0 00 006420' move t1, [point 7, strbuf] 38661 004150'01 202 01 0 00 003733* movem t1, strptr 38662 004151'01 104 00 0 00 000041 DIRST 38663 004152'01 320 14 0 00 004154' %jsker (,xxwait) 38664 004153'01 254 00 0 00 004157' 38665 004154'01 265 01 0 00 004143* 38666 004155'01 000000 000000 38667 004156'01 254 00 0 00 003234' 38668 38669 004157'01 201 01 0 00 003704' movei t1, gtsch ; Indicate routine to be used for getting 38670 004160'01 202 01 0 00 003243* movem t1, source ; characters. 38671 004161'01 476 00 0 00 003711* setom next ; Set initial condition. 38672 004162'01 200 01 0 00 000000* move t1, maxdat ; Get a buffer full of data. 38673 004163'01 260 17 0 00 000000* call getbuf ; ... 38674 004164'01 326 01 0 00 003234' jumpn t1, xxwait ; 38675 004165'01 402 00 0 00 004160* setzm source ; Put GETCH back to normal. 38676 004166'01 200 03 0 00 000001 move t3, t1 ; Length 38677 004167'01 201 01 0 00 000131 movei t1, "Y" ; Y for Yes (ACK) 38678 004170'01 400 02 0 00 000000 setz t2, ; Packet number 0. 38679 004171'01 200 04 0 00 006556' move t4, [point 8, datbuf] ;[190] Point to string built by getbuf. 38680 004172'01 260 17 0 00 003701* call spack ; Send the ACK. 38681 004173'01 600 00 0 00 000000 nop ; Nothing much we can do here... 38682 004174'01 254 00 0 00 003234' jrst xxwait ; Done. k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 19:42 30-Mar-24 Page 59 K20SRV MAC 30-Mar-24 15:37 Get Argument 38683 38684 ;[56] Disk USAGE server query added in edit 56. 38685 ; 38686 ; Assumes reply will fit in data field of ACK packet; does not use 38687 ; text header ("X") protocol. Sends as much of reply as will fit. 38688 ; 38689 004175'01 474 01 0 00 000000 xgdisk: seto t1, ; Get disk usage of connected directory. 38690 004176'01 104 00 0 00 000305 GTDAL% 38691 004177'01 320 14 0 00 004201' %jsker ,r 38692 004200'01 254 00 0 00 004204' 38693 004201'01 265 01 0 00 004154* 38694 004202'01 000000000000# 38695 004203'01 254 00 0 00 004055* 38696 001036'04 103 141 156 047 164 38697 004204'01 120 05 0 00 000001 dmove q1, t1 ; Save the numbers in q1,q2. 38698 38699 004205'01 200 01 0 00 006420' move t1, [point 7, strbuf] ;[188] String pointer to data field. 38700 004206'01 202 01 0 00 004150* movem t1, strptr ;[103] 38701 004207'01 120 02 0 00 000000# smsg () ;[188] Inital part of response 38702 004210'01 260 17 0 00 002202* 38703 000310'02 000000000000# 38704 000311'02 777777 777771 38705 001043'04 121 165 157 164 141 38706 38707 004211'01 200 02 0 00 000005 move t2, q1 ; Quota, or "+Inf" 38708 004212'01 305 02 0 00 006530' caige t2, [^d100000000] ;[194] Big? 38709 004213'01 254 00 0 00 004217' ifskp. ;[194] Yep, really big 38710 004214'01 120 02 0 00 000000# smsg (<+Inf>) ;[194] So say that differently 38711 004215'01 260 17 0 00 004210* 38712 000312'02 000000000000# 38713 000313'02 777777 777774 38714 001045'04 053 111 156 146 000 38715 004216'01 254 00 0 00 004222' else. ;[194] Otherwise, comprehensible limit 38716 004217'01 201 03 0 00 000012 movei t3, ^d10 ; in decimal 38717 004220'01 104 00 0 00 000224 NOUT% 38718 004221'01 320 14 0 00 004232' erjmps xgdis2 ;[194] Catch and suppress errpr 38719 004222'01 endif. ;[194] 38720 38721 004222'01 120 02 0 00 000000# smsg (<, used: >) ;[194] How much we're using of it 38722 004223'01 260 17 0 00 004215* 38723 000314'02 000000000000# 38724 000315'02 777777 777770 38725 001046'04 054 040 165 163 145 38726 38727 004224'01 200 02 0 00 000006 move t2, q2 ; Pages used, 38728 004225'01 201 03 0 00 000012 movei t3, ^d10 ; in decimal 38729 004226'01 104 00 0 00 000224 NOUT% 38730 004227'01 320 14 0 00 004232' erjmps xgdis2 ;[194] Catch and suppress error 38731 38732 004230'01 120 02 0 00 000000# smsg (< (pages)>) ; Specify units 38733 004231'01 260 17 0 00 004223* 38734 000316'02 000000000000# 38735 000317'02 777777 777770 38736 001050'04 040 050 160 141 147 38737 k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 19:42 30-Mar-24 Page 59-1 K20SRV MAC 30-Mar-24 15:37 Get Argument 38738 004232'01 200 02 0 00 004206* xgdis2: move t2, strptr ;[103] Check length 38739 004233'01 250 01 0 00 000002 exch t1, t2 38740 004234'01 260 17 0 00 000000* call subbp 38741 004235'01 334 00 0 00 000000 kermsg (,r) ;[188] 38742 004236'01 254 00 0 00 004243' 38743 004237'01 265 01 0 00 003764* 38744 004240'01 000000 000027 38745 004241'01 000000000000# 38746 004242'01 254 00 0 00 004203* 38747 001052'04 163 165 142 142 160 38748 004243'01 400 04 0 00 000000 setz t4, ;[188] Cons up a .CHNUL 38749 004244'01 136 04 0 00 000002 idpb t4, t2 ; Done constructing string, make it asciz 38750 004245'01 200 05 0 00 000000* move q1, spsiz ; Is the string bigger than max size to send? 38751 004246'01 275 05 0 00 000005 subi q1, 5 38752 004247'01 307 05 0 03 000000 caig q1, (t3) ; (it should always fit). 38753 004250'01 200 03 0 00 000005 move t3, q1 ; Yes, so cut it off at the limit. 38754 ;.. k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 19:42 30-Mar-24 Page 60 K20SRV MAC 30-Mar-24 15:37 Get Argument 38755 38756 ;...XGDISK, cont'd 38757 38758 38759 ;[103] Begin Change: Use standard packet filling technique to send this. 38760 38761 004251'01 201 01 0 00 003704' movei t1, gtsch ; Indicate routine to be used for getting 38762 004252'01 202 01 0 00 004165* movem t1, source ; characters. 38763 004253'01 476 00 0 00 004161* setom next ; Set initial condition. 38764 004254'01 200 01 0 00 004162* move t1, maxdat ; Get a buffer full of data. 38765 004255'01 260 17 0 00 004163* call getbuf ; ... 38766 004256'01 326 01 0 00 003234' jumpn t1, xxwait ; 38767 004257'01 200 03 0 00 000001 move t3, t1 ; Set up length. 38768 004260'01 402 00 0 00 004252* setzm source ; Put GETCH back to normal. 38769 38770 ;[103] End Change. Now send the packet. 38771 38772 004261'01 201 01 0 00 000131 xgdisz: movei t1, "Y" ; Formulate the ACK 38773 004262'01 400 02 0 00 000000 setz t2, ; (Packet number should be 0, right?) 38774 004263'01 200 04 0 00 006556' move t4, [point 8, datbuf] ;[190] The data itself 38775 004264'01 260 17 0 00 004172* call spack ; Send it off. 38776 004265'01 600 00 0 00 000000 nop ;* What if it fails? 38777 004266'01 254 00 0 00 003234' jrst xxwait k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 19:42 30-Mar-24 Page 61 K20SRV MAC 30-Mar-24 15:37 Get Argument 38778 38779 ; 38780 ;[254] CDUP connects to upper (or superior) directory, responds like PWD 38781 ; 38782 ; N.B., For Unix fans and Windows heros, be aware that the so-called 38783 ; working directory is NOT the same thing on Tops-20! It is the 38784 ; connected directory, which changes your access rights to that 38785 ; directory and possible group memberships. A connected directory 38786 ; is also job wide, not process wide. 38787 ; 38788 ; Uses xgpwd for response 38789 38790 004267'01 265 16 0 00 006357' xgcdup: saveac ; Need some local fast scratch 38791 004270'01 104 00 0 00 000013 GJINF% ; Get current job information. 38792 004271'01 320 14 0 00 004273' %jsker ,r 38793 004272'01 254 00 0 00 004276' 38794 004273'01 265 01 0 00 004201* 38795 004274'01 000000000000# 38796 004275'01 254 00 0 00 004242* 38797 001055'04 103 141 156 047 164 38798 004276'01 200 10 0 00 000002 move q4, t2 ; Save currently connected directory 38799 38800 004277'01 200 06 0 00 006564' move q2, [point 7,dirbuf] ;Hardware pointer to directory buffer 38801 004300'01 200 01 0 00 000006 move t1, q2 ; Copy for local usage 38802 remark t2, ; Already has the connected directory 38803 004301'01 104 00 0 00 000041 DIRST% ; Translate into a string 38804 004302'01 320 14 0 00 004304' %jsker ,r 38805 004303'01 254 00 0 00 004307' 38806 004304'01 265 01 0 00 004273* 38807 004305'01 000000000000# 38808 004306'01 254 00 0 00 004275* 38809 001064'04 103 157 165 154 144 38810 38811 004307'01 200 01 0 00 000006 move t1, q2 ; Copy for local usage 38812 004310'01 400 03 0 00 000000 setz t3, ; Last dot we saw 38813 38814 004311'01 do. ; Enter loop context 38815 004311'01 134 02 0 00 000001 ildb t2, t1 ; Pick up a byte 38816 004312'01 322 02 0 00 004320' jumpe t2, endlp. ; Stop if off the end of the string (wierd...) 38817 004313'01 306 02 0 00 000076 cain t2, .chrpt ; At end of directory specification? 38818 004314'01 254 00 0 00 004320' exit. ; Yes, so done with the loop 38819 004315'01 306 02 0 00 000056 cain t2, "." ; Hit a dot?? 38820 004316'01 200 03 0 00 000001 move t3, t1 ; Yes, remember pointer to the last one seen 38821 004317'01 254 00 0 00 004311' loop. ; Grovel to the end of the string 38822 004320'01 enddo. ; Exit loop context 38823 38824 004320'01 322 03 0 00 004353' jumpe t3, xgpwd ; If never saw a dot, nothing to do 38825 38826 004321'01 120 01 0 00 006426' dmove t1, [exp .chrpt,0] ;Load closing punctuation 38827 004322'01 137 01 0 00 000003 dpb t1, t3 ; Stomp the dot with closing punctuation 38828 004323'01 136 02 0 00 000003 idpb t2, t3 ; Close off the string 38829 ; Convert our masterpiece to internal format 38830 004324'01 205 01 0 00 000001 movx t1, rc%emo ; Must match this and only this directory 38831 004325'01 200 02 0 00 000006 move t2, q2 ; Load pointer to munged directory 38832 004326'01 400 03 0 00 000000 setz t3, ; Not doing any stepping k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 19:42 30-Mar-24 Page 61-1 K20SRV MAC 30-Mar-24 15:37 Get Argument 38833 004327'01 104 00 0 00 000553 RCDIR% ; See if we can recognize it 38834 004330'01 607 01 0 00 070000 ifxn. t1, rc%nom!rc%amb!rc%nmd 38835 004331'01 254 00 0 00 004337' 38836 004332'01 254 00 0 00 004334' %erker (,r) 38837 004333'01 254 00 0 00 004337' 38838 004334'01 265 01 0 00 004304* 38839 004335'01 000000000000# 38840 004336'01 254 00 0 00 004306* 38841 001077'04 125 156 141 142 154 38842 004337'01 endif. ; End case couldn't find it 38843 38844 004337'01 200 07 0 00 000003 move q3, t3 ; Store the directory number, just in case 38845 004340'01 200 01 0 00 006354' movx t1, ac%con!3 ; Doing a connect, block is three words long 38846 004341'01 201 02 0 00 000003 movei t2, t3 ; Argument block begins in AC3 38847 004342'01 120 04 0 00 006432' dmove t4, [ exp 0, -1 ] ; No password, this job 38848 004343'01 104 00 0 00 000552 ACCES% ; Try the connect 38849 004344'01 320 14 0 00 004346' %jsker (,r) 38850 004345'01 254 00 0 00 004351' 38851 004346'01 265 01 0 00 004334* 38852 004347'01 000000000000# 38853 004350'01 254 00 0 00 004336* 38854 001114'04 125 156 141 142 154 38855 38856 004351'01 260 17 0 00 000305' call udjinf ; Update currently connected directory 38857 004352'01 254 00 0 00 004353' callret xgpwd ; Respond exactly like xgpwd 38858 38859 ;[254] End Code Insertion k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 19:42 30-Mar-24 Page 62 K20SRV MAC 30-Mar-24 15:37 Get Argument 38860 38861 ; 38862 ;[188] PWD server query; prints working directory. 38863 ; 38864 ; Assumes reply will fit in data field of ACK packet; does not use 38865 ; text header ("X") protocol. Sends as much of reply as will fit. 38866 ; 38867 ; N.B., For Unix fans and Windows heros, be aware that the so-called 38868 ; working directory is NOT the same thing on Tops-20! It is the 38869 ; connected directory, which changes your access rights to that 38870 ; directory and possible group memberships. A connected directory 38871 ; is also job wide, not process wide. 38872 ; 38873 ; Looks remarkably like xgdisk... 38874 38875 004353'01 104 00 0 00 000013 xgpwd: GJINF% ; Get current job information. 38876 004354'01 320 14 0 00 004356' %jsker ,r 38877 004355'01 254 00 0 00 004361' 38878 004356'01 265 01 0 00 004346* 38879 004357'01 000000000000# 38880 004360'01 254 00 0 00 004350* 38881 001124'04 103 141 156 047 164 38882 004361'01 200 01 0 00 006420' move t1, [point 7, strbuf] ; String pointer to data field. 38883 004362'01 202 01 0 00 004232* movem t1, strptr ; Also for packetizer 38884 remark t2, ; Already has the connected directory 38885 004363'01 104 00 0 00 000041 DIRST% ; Translate into a string 38886 004364'01 320 14 0 00 004366' %jsker ,r 38887 004365'01 254 00 0 00 004371' 38888 004366'01 265 01 0 00 004356* 38889 004367'01 000000000000# 38890 004370'01 254 00 0 00 004360* 38891 001133'04 103 157 165 154 144 38892 38893 remark ^D<6+1+1+39+1=48> ;Maximum directory string length 38894 38895 004371'01 200 02 0 00 004362* move t2, strptr ; Check the length in case of 'micropacket' 38896 004372'01 250 01 0 00 000002 exch t1, t2 ; Beginning pointer in t1, final in t2 38897 004373'01 260 17 0 00 004234* call subbp ; Subtract to get length 38898 004374'01 334 00 0 00 000000 kermsg (,r) ;Really unlikely, see above 38899 004375'01 254 00 0 00 004402' 38900 004376'01 265 01 0 00 004237* 38901 004377'01 000000 000027 38902 004400'01 000000000000# 38903 004401'01 254 00 0 00 004370* 38904 001146'04 163 165 142 142 160 38905 38906 004402'01 400 04 0 00 000000 setz t4, ; Cons up a .CHNUL 38907 004403'01 136 04 0 00 000002 idpb t4, t2 ; Tie off the string 38908 004404'01 200 05 0 00 004245* move q1, spsiz ; Is the string bigger than max size to send? 38909 004405'01 275 05 0 00 000005 subi q1, 5 38910 004406'01 307 05 0 03 000000 caig q1, (t3) ; (it should always fit). 38911 004407'01 200 03 0 00 000005 move t3, q1 ; Yes, so cut it off at the limit. 38912 38913 004410'01 201 01 0 00 003704' movei t1, gtsch ; Indicate routine to be used for getting 38914 004411'01 202 01 0 00 004260* movem t1, source ; characters. k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 19:42 30-Mar-24 Page 62-1 K20SRV MAC 30-Mar-24 15:37 Get Argument 38915 004412'01 476 00 0 00 004253* setom next ; Set initial condition. 38916 004413'01 200 01 0 00 004254* move t1, maxdat ; Get a buffer full of data. 38917 004414'01 260 17 0 00 004255* call getbuf ; ... 38918 004415'01 326 01 0 00 003234' jumpn t1, xxwait ; 38919 004416'01 200 03 0 00 000001 move t3, t1 ; Set up length. 38920 004417'01 402 00 0 00 004411* setzm source ; Put GETCH back to normal. 38921 ; Now send the packet. 38922 004420'01 201 01 0 00 000131 movei t1, "Y" ; Formulate the ACK 38923 004421'01 400 02 0 00 000000 setz t2, ; (Packet number should be 0, right?) 38924 004422'01 200 04 0 00 006556' move t4, [point 8, datbuf] ;[190] The data itself 38925 004423'01 260 17 0 00 004264* call spack ; Send it off. 38926 004424'01 600 00 0 00 000000 nop ;* What if it fails? 38927 004425'01 254 00 0 00 003234' jrst xxwait 38928 38929 ;[188] End Code Insertion k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 19:42 30-Mar-24 Page 63 K20SRV MAC 30-Mar-24 15:37 Get Argument 38930 38931 ; Define 30 bit one word global ASCII pointer to another section 38932 38933 extern hlpntr ;[194] One word global ASCII pointer 38934 extern srvhlp ;[194] In k20hlp in section one 38935 38936 000000000000# xhlptr==hlpntr!srvhlp ;[194] Forces LINK to do a polish fix up 38937 38938 004426'01 336 00 0 00 003647* xgstat:ifmn. tlgjfn ;[233] Doing transaction logging? 38939 004427'01 254 00 0 00 004441' 38940 004430'01 415 16 0 00 004441' block. ;[233] Get a stack frame 38941 004431'01 261 17 0 00 000016 38942 004432'01 265 16 0 00 006314' saveac ;[233] Save even the temporaries 38943 004433'01 476 00 0 00 003642* setom scrlft ;[233] Suppress the trailing carriage return 38944 004434'01 265 01 0 00 003643* wtlog(,) ;[233] 38945 004435'01 000000000000# 38946 004436'01 777777 777735 38947 004437'01 000000 000000 38948 001151'04 123 145 156 144 151 38949 004440'01 263 17 0 00 000000 endbk. ;[233] Release stack frame, restoring AC's 38950 004441'01 endif. ;[233] 38951 38952 004441'01 260 17 0 00 002623* call $srvt ;[189] Build the text in a buffer 38953 004442'01 400 02 0 00 000000 setz t2, ;[189] Cons up a .chnul 38954 004443'01 136 02 0 00 000001 idpb t2,t1 ;[189] Tied off the 'string' 38955 004444'01 136 02 0 00 000001 idpb t2,t1 ;[189] Tie it off some more ... 38956 004445'01 200 01 0 00 006565' move t1,[point 7,statxt];[233] Load pointer to constructed text 38957 004446'01 254 00 0 00 004463' jrst xghel1 ;[233] Join common code 38958 38959 004447'01 336 00 0 00 004426* xghelp: ifmn. tlgjfn ;[233] Doing transaction logging? 38960 004450'01 254 00 0 00 004462' 38961 004451'01 415 16 0 00 004462' block. ;[233] Get a stack frame 38962 004452'01 261 17 0 00 000016 38963 004453'01 265 16 0 00 006314' saveac ;[233] Save even the temporaries 38964 004454'01 476 00 0 00 004433* setom scrlft ;[233] Suppress the trailing carriage return 38965 004455'01 265 01 0 00 004434* wtlog(,) ;[233] 38966 004456'01 000000000000# 38967 004457'01 777777 777744 38968 004460'01 000000 000000 38969 001161'04 123 145 156 144 151 38970 004461'01 263 17 0 00 000000 endbk. ;[233] Release stack frame, restoring AC's 38971 004462'01 endif. ;[233] 38972 004462'01 200 01 0 00 006566' move t1, [ xhlptr ] ;[194] Load pointer to general remote help text 38973 38974 004463'01 xghel1: remark ;[233] Common link 38975 004463'01 202 01 0 00 004371* movem t1, strptr ; Put pointer here, where 38976 004464'01 201 01 0 00 003704' movei t1, gtsch ; routine for getting chars from a string 38977 004465'01 202 01 0 00 004417* movem t1, source ; can find it. 38978 004466'01 476 00 0 00 004412* setom next ; Init char lookahead 38979 004467'01 476 00 0 00 003633* setom xflg ; Send with X rather than F header. 38980 004470'01 260 17 0 00 003425* call $sends ; Go send the text like a file 38981 004471'01 600 00 0 00 000000 nop 38982 004472'01 402 00 0 00 004465* setzm source ;[121] Put send source back to normal. 38983 004473'01 254 00 0 00 003234' jrst xxwait k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 19:42 30-Mar-24 Page 64 K20SRV MAC 30-Mar-24 15:37 Get Argument 38984 38985 ;[116] DIRECTORY server command. 38986 38987 ; DIRCH 38988 ; 38989 ; Alternate GETCH routine for getting characters from a directory listing 38990 ; in a memory buffer, and for refilling the buffer when it gets empty. 38991 ; 38992 004474'01 dirch: entry dirch ;[186] 38993 004474'01 134 01 0 00 000000# ildb t1, getptr ; Get character. 38994 004475'01 332 00 0 00 000001 skipe t1 ; Null? 38995 004476'01 254 00 0 00 004506' jrst dirchx ; No, return the character. 38996 38997 ; No characters in buffer, try to refill. 38998 38999 004477'01 260 17 0 00 006144' dirch2: call dmpbuf ; If so, reset the buffer pointers, etc. 39000 004500'01 260 17 0 00 002033' call dirlst ; And try to fill the listing buffer again. 39001 004501'01 322 01 0 00 004510' jumpe t1, dirchz ; No more, done. 39002 004502'01 200 01 0 00 006567' move t1, [point 7, srvbuf] ; Get new listing buffer pointer. 39003 004503'01 202 01 0 00 000000# movem t1, getptr ; Save it for getting characters. 39004 004504'01 134 01 0 00 000000# ildb t1, getptr ; Get first character of new buffer. 39005 004505'01 322 01 0 00 004510' jumpe t1, dirchz ; This shouldn't happen... 39006 39007 ; Return with character like GETCH. 39008 39009 004506'01 202 01 0 00 004466* dirchx: movem t1, next 39010 004507'01 254 00 0 00 004056* retskp 39011 39012 ; "EOF" return, like GETCH. 39013 39014 004510'01 400 01 0 00 000000 dirchz: setz t1, 39015 004511'01 476 00 0 00 004506* setom next 39016 004512'01 263 17 0 00 000000 ret 39017 k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 19:42 30-Mar-24 Page 65 K20SRV MAC 30-Mar-24 15:37 XGDIR - Server provides directory listing. 39018 subttl XGDIR - Server provides directory listing. 39019 39020 004513'01 100100 777775 sdirb2: gj%old!gj%ifg!.gjall ;[191] Flags,,All generations. 39021 004514'01 377777 377777 .nulio,,.nulio ;[191] No i/o. 39022 repeat <^d8>,<0> ;[191] No defaults; nothing 39023 004515'01 000000 000000 39024 004516'01 000000 000000 39025 004517'01 000000 000000 39026 004520'01 000000 000000 39027 004521'01 000000 000000 39028 004522'01 000000 000000 39029 004523'01 000000 000000 39030 004524'01 000000 000000 39031 39032 ;[190] Prologue rewritten to not store in (write-protected!) code .psect 39033 39034 004525'01 260 17 0 00 003725' xgdir: call getarg ; Get the first (& only) argument 39035 004526'01 327 03 0 00 004550' jumpg t3, xgdir2 ; Got something, go do it. 39036 004527'01 326 03 0 00 004542' ife. t3 ;[190] Got nothing, default the directory 39037 004530'01 265 16 0 00 003016* anstkv(t4,^d4) ;[190] Create an anonymous stkvar 39038 004531'01 000000 000004 39039 004532'01 415 04 0 17 777773 39040 004533'01 120 01 0 00 006570' dmove t1,[ exp ascii "*.*.*", 0 ] ;[190] Load default file spec 39041 004534'01 124 01 0 04 000000 dmovem t1,0(t4) ;[190] Stomp into buffer 39042 004535'01 403 01 0 00 000002 setzb t1,t2 ;[190] Cons up ten .CHNUL's 39043 004536'01 124 01 0 04 000002 dmovem t1,2(t4) ;[190] Stomp rest of buffer 39044 004537'01 201 03 0 00 000005 movei t3,^d5 ;[190] Five characters long 39045 004540'01 505 04 0 00 440700 hrli t4,(point 7,) ;[190] Now have an ASCII pointer 39046 004541'01 254 00 0 00 004550' jrst xgdir2 ;[190] Go get a file specification 39047 004542'01 endif. ;[190] End case defaulting directory 39048 39049 004542'01 334 00 0 00 000000 kermsg (,xxwait) ; Got junk. 39050 004543'01 254 00 0 00 004550' 39051 004544'01 265 01 0 00 004376* 39052 004545'01 000000 000060 39053 004546'01 000000000000# 39054 004547'01 254 00 0 00 003234' 39055 001167'04 102 141 144 040 154 39056 39057 ; Get JFN on the string we got, supply normal defaults like Exec does. 39058 39059 004550'01 200 02 0 00 000004 xgdir2: move t2, t4 ; Point to filespec 39060 004551'01 133 03 0 00 000004 adjbp t3, t4 ; Make it asciz 39061 004552'01 400 04 0 00 000000 setz t4, 39062 004553'01 136 04 0 00 000003 idpb t4, t3 39063 004554'01 200 04 0 00 000002 move t4, t2 ;[191] Save the string pointer 39064 004555'01 201 01 0 00 004632' movei t1, sdirbk ; JFN block containing flags & defaults. 39065 004556'01 104 00 0 00 000020 GTJFN ; Do long form GTJFN. 39066 004557'01 320 12 0 00 004561' ifje. r ;[191] Catch error 39067 004560'01 254 00 0 00 004577' 39068 004561'01 302 01 0 00 600114 caie t1, GJFX32 ;[191] No files matched? 39069 004562'01 254 00 0 00 004564' %erker (,xxwait) ;[191] No, just send the error 39070 004563'01 254 00 0 00 004567' 39071 004564'01 265 01 0 00 004366* 39072 004565'01 000000 000000 k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 19:42 30-Mar-24 Page 65-1 K20SRV MAC 30-Mar-24 15:37 XGDIR - Server provides directory listing. 39073 004566'01 254 00 0 00 003234' 39074 004567'01 201 01 0 00 004513' movei t1, sdirb2 ;[191] Try not defaulting anything 39075 004570'01 200 02 0 00 000004 move t2, t4 ;[191] Restore the string pointer 39076 004571'01 104 00 0 00 000020 GTJFN% ;[191] Attempt another long form GTJFN. 39077 004572'01 320 14 0 00 004574' %jsker (,xxwait) ;[191] No such luck, just give up 39078 004573'01 254 00 0 00 004577' 39079 004574'01 265 01 0 00 004564* 39080 004575'01 000000 000000 39081 004576'01 254 00 0 00 003234' 39082 004577'01 endif. ;[191] End GTJFN% recovery 39083 004577'01 260 17 0 00 003417* call isnulj ;[191] Gave us NUL:? 39084 004600'01 600 00 0 00 000000 nop ;[191] Didn't, that's fine. 39085 remark t1, .nulio ;[191] Did, that's fine, too. 39086 39087 004601'01 336 00 0 00 004447* ifmn. tlgjfn ;[233] Doing transaction logging? 39088 004602'01 254 00 0 00 004616' 39089 004603'01 415 16 0 00 004616' block. ;[233] Get a stack frame 39090 004604'01 261 17 0 00 000016 39091 004605'01 265 16 0 00 006314' saveac ;[233] Save even the temporaries 39092 004606'01 552 01 0 00 000000# hrrzm t1,tmpjfn ;[233] Give it how %wtlog wants it .. 39093 004607'01 476 00 0 00 004454* setom scrlft ;[233] Suppress the trailing carriage return 39094 004610'01 265 01 0 00 004455* wtlog(,tmpjfn) ;[233] Sigh... 39095 004611'01 000000000000# 39096 004612'01 777777 777736 39097 004613'01 000000000000# 39098 001177'04 123 145 156 144 151 39099 004614'01 402 00 0 00 000000# setzm tmpjfn ;[233] Stomp it, done. 39100 004615'01 263 17 0 00 000000 endbk. ;[233] Release stack frame, restoring AC's 39101 004616'01 endif. ;[233] 39102 39103 004616'01 200 02 0 00 000001 move t2, t1 ; Construct heading in string buffer. 39104 004617'01 402 00 0 00 003245* setzm ffunc ; Function is "directory". 39105 004620'01 260 17 0 00 001766' call dirhdr 39106 004621'01 200 01 0 00 006572' move t1, [point 7, srvbuf] ; Point to beginning of text buffer. 39107 004622'01 202 01 0 00 000000# movem t1, getptr ; This is where we'll get characters from. 39108 004623'01 201 01 0 00 004474' movei t1, dirch ; And this routine will do the getting. 39109 004624'01 202 01 0 00 004472* movem t1, source ; ... 39110 004625'01 476 00 0 00 004511* setom next ; Initialize character lookahead. 39111 004626'01 476 00 0 00 004467* setom xflg ; This produces some desired effects... 39112 004627'01 260 17 0 00 004470* call $sends ; Go send the listing like it's a file. 39113 004630'01 600 00 0 00 000000 nop ; Ignore any skipping... 39114 004631'01 254 00 0 00 003234' jrst xxwait 39115 39116 004632'01 100100 777775 sdirbk: gj%old!gj%ifg!.gjall ; Flags,,All generations. 39117 004633'01 377777 377777 .nulio,,.nulio ; No i/o. 39118 repeat <2>,<0> ; Default device and directory. 39119 004634'01 000000 000000 39120 004635'01 000000 000000 39121 repeat <2>,)> ;Default name is "*.*" 39122 004636'01 000000000000# 39123 001206'04 052 000 000 000 000 39124 004637'01 000000000000# 39125 001207'04 052 000 000 000 000 39126 39127 repeat <4>,<0> ; Nothing special for the rest. k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 19:42 30-Mar-24 Page 65-2 K20SRV MAC 30-Mar-24 15:37 XGDIR - Server provides directory listing. 39128 004640'01 000000 000000 39129 004641'01 000000 000000 39130 004642'01 000000 000000 39131 004643'01 000000 000000 39132 k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 19:42 30-Mar-24 Page 66 K20SRV MAC 30-Mar-24 15:37 XGDEL - Server provides file deletion [118] 39133 subttl XGDEL - Server provides file deletion [118] 39134 39135 004644'01 100100 777775 sdelbk: gj%old!gj%ifg!.gjall ; Flags,,All generations. 39136 004645'01 377777 377777 .nulio,,.nulio ; No i/o. 39137 repeat <^d8>,<0> ; No other defaults. 39138 004646'01 000000 000000 39139 004647'01 000000 000000 39140 004650'01 000000 000000 39141 004651'01 000000 000000 39142 004652'01 000000 000000 39143 004653'01 000000 000000 39144 004654'01 000000 000000 39145 004655'01 000000 000000 39146 39147 39148 004656'01 260 17 0 00 003725' xgdel: call getarg ; Get the first (& only) argument 39149 004657'01 327 03 0 00 004666' jumpg t3, xgdel2 ; Got something, go do it. 39150 39151 004660'01 334 00 0 00 000000 kermsg (,xxwait) 39152 004661'01 254 00 0 00 004666' 39153 004662'01 265 01 0 00 004544* 39154 004663'01 000000 000051 39155 004664'01 000000000000# 39156 004665'01 254 00 0 00 003234' 39157 001210'04 116 157 040 146 151 39158 39159 ; Get JFN on the string we got, supply normal defaults like Exec does. 39160 39161 004666'01 200 02 0 00 000004 xgdel2: move t2, t4 ; Point to filespec 39162 004667'01 133 03 0 00 000004 adjbp t3, t4 ; Make it asciz 39163 004670'01 400 04 0 00 000000 setz t4, 39164 004671'01 136 04 0 00 000003 idpb t4, t3 39165 004672'01 201 01 0 00 004644' movei t1, sdelbk ; JFN block containing flags & defaults. 39166 004673'01 104 00 0 00 000020 GTJFN ; Do long form GTJFN. 39167 004674'01 320 14 0 00 004676' %jsker (,xxwait) ; Send error packet if we can't. 39168 004675'01 254 00 0 00 004701' 39169 004676'01 265 01 0 00 004574* 39170 004677'01 000000 000000 39171 004700'01 254 00 0 00 003234' 39172 004701'01 260 17 0 00 004577* call isnulj ;[191] Gave us NUL: 39173 004702'01 600 00 0 00 000000 nop ;[191] Didn't, that's fine. 39174 39175 004703'01 336 00 0 00 004601* ifmn. tlgjfn ;[233] Doing transaction logging? 39176 004704'01 254 00 0 00 004720' 39177 004705'01 415 16 0 00 004720' block. ;[233] Get a stack frame 39178 004706'01 261 17 0 00 000016 39179 004707'01 265 16 0 00 006314' saveac ;[233] Save even the temporaries 39180 004710'01 552 01 0 00 000000# hrrzm t1,tmpjfn ;[233] Give it how %wtlog wants it .. 39181 004711'01 476 00 0 00 004607* setom scrlft ;[233] Suppress the trailing carriage return 39182 004712'01 265 01 0 00 004610* wtlog(,tmpjfn) ;[233] Sigh... 39183 004713'01 000000000000# 39184 004714'01 777777 777767 39185 004715'01 000000000000# 39186 001217'04 104 145 154 145 164 39187 004716'01 402 00 0 00 000000# setzm tmpjfn ;[233] Stomp it, done. k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 19:42 30-Mar-24 Page 66-1 K20SRV MAC 30-Mar-24 15:37 XGDEL - Server provides file deletion [118] 39188 004717'01 263 17 0 00 000000 endbk. ;[233] Release stack frame, restoring AC's 39189 004720'01 endif. ;[233] 39190 39191 remark t1, .nulio ;[191] Is, that's fine, too. 39192 004720'01 200 02 0 00 000001 move t2, t1 ; Construct heading in string buffer. 39193 004721'01 201 01 0 00 006004' movei t1, delfil ;[194] ; Routine for deleting a file. 39194 004722'01 202 01 0 00 004617* movem t1, ffunc ; Make it the file function. 39195 004723'01 260 17 0 00 001766' call dirhdr ; Start things off. 39196 004724'01 200 01 0 00 006573' move t1, [point 7, srvbuf] ; Point to beginning of text buffer. 39197 004725'01 202 01 0 00 000000# movem t1, getptr ; This is where we'll get characters from. 39198 004726'01 201 01 0 00 004474' movei t1, dirch ; And this routine will do the getting. 39199 004727'01 202 01 0 00 004624* movem t1, source ; ... 39200 004730'01 476 00 0 00 004625* setom next ; Initialize character lookahead. 39201 004731'01 476 00 0 00 004626* setom xflg ; This produces some desired effects... 39202 004732'01 260 17 0 00 004627* call $sends ; Go send the listing like it's a file. 39203 004733'01 600 00 0 00 000000 nop ; Ignore any skipping... 39204 004734'01 254 00 0 00 003234' jrst xxwait 39205 k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 19:42 30-Mar-24 Page 67 K20SRV MAC 30-Mar-24 15:37 LOCAL RUN command parsing 39206 subttl LOCAL RUN command parsing 39207 39208 ; JFN block for RUN command. 39209 39210 chgsec(code,const) ;;Tables and chained fdb's go in const 39211 000320'02 100120 000000 runbk: gj%old!gj%ifg!gj%flg ; Flag bits,,most recent generation. 39212 000321'02 000100 000101 .priin,,.priou ; COMND i/o. 39213 repeat 3,<0> ; No defaults, except 39214 000322'02 000000 000000 39215 000323'02 000000 000000 39216 000324'02 000000 000000 39217 000325'02 000000000000# cascii() ; file type. 39218 001221'04 105 130 105 000 000 39219 repeat 2,<0> ; No defaults, except 39220 000326'02 000000 000000 39221 000327'02 000000 000000 39222 000010 runbkl==<.-runbk> ; Length of this GTJFN argument block. 39223 39224 000330'02 006000 000000 yrufdb: flddb. .cmfil 39225 000331'02 000000 000000 39226 000332'02 006004 000335' yrrfdb: flddb. .cmfil,,,,,yrrfd1 39227 000333'02 000000 000000 39228 000334'02 44 07 0 00 000577' 39229 000335'02 010004 000000 yrrfd1: flddb. .cmcfm,,,,, 39230 000336'02 000000 000000 39231 000337'02 44 07 0 00 000604' 39232 retsec 39233 cleans() 39234 39235 ; Parse local RUN command. 39236 39237 004735'01 .yrun: entry .yrun ; Can be invoked as top-level by k20par 39238 004735'01 200 01 0 00 006437' movx t1, cz%ncl!.fhslf ; Close any nonopen JFNs. 39239 004736'01 104 00 0 00 000034 CLZFF 39240 004737'01 200 16 0 00 000000# guide ; Issue guide word. 39241 004740'01 260 17 0 00 002655* 39242 000340'02 000000000000# 39243 001222'04 146 151 154 145 000 39244 004741'01 200 01 0 00 006574' move t1, [runbk,,cjfnbk] ; Insert our file parsing defaults. 39245 004742'01 251 01 0 00 000000# blt t1, cjfnbk+runbkl ; Same as for DELETE. 39246 004743'01 201 01 0 00 000000# movei t1, yrufdb 39247 004744'01 332 00 0 00 000000# skipe rufork ; Already have a fork? 39248 004745'01 201 01 0 00 000000# movei t1, yrrfdb ; Yes, let them rerun it. 39249 004746'01 260 17 0 00 002661* call rfield ; Parse an existing file specification. 39250 004747'01 135 03 0 00 006275' ldb t3, [pointr (.cmfnp(t3),cm%fnc)] ; Get function code. 39251 004750'01 302 03 0 00 000010 caie t3, .cmcfm ;[194] Confirmation? 39252 004751'01 254 00 0 00 004754' ifskp. ;[194] It is 39253 004752'01 476 00 0 00 002773* setom pars3 ; Yes, set "jfn" to -1. 39254 004753'01 263 17 0 00 000000 ret 39255 004754'01 endif. ;[194] 39256 39257 004754'01 265 16 0 00 006357' saveac ;[220] Will need some extra registers 39258 004755'01 550 05 0 00 000002 hrrz q1, t2 ;[220] Save the JFN 39259 004756'01 510 06 0 00 000002 hllz q2, t2 ;[220] Save the flags 39260 004757'01 550 01 0 00 000002 hrrz t1, t2 ;[220] Load the JFN without the flags k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 19:42 30-Mar-24 Page 67-1 K20SRV MAC 30-Mar-24 15:37 LOCAL RUN command parsing 39261 004760'01 260 17 0 00 005474' call isdird ;[220] Only run files from structures 39262 004761'01 254 00 0 00 004772' ifskp. ;[220] It is 39263 004762'01 120 07 0 00 000001 dmove q3, t1 ;[220] Save device information 39264 004763'01 260 17 0 00 002770* confrm ; Get confirmation 39265 004764'01 135 03 0 00 006276' ldb t3,[pointr(t2,dv%typ)] ;[220] Pick up device type 39266 004765'01 306 03 0 00 000015 cain t3, .dvnul ;[220] NUL:? 39267 004766'01 201 05 0 00 377777 movei q1, .nulio ;[220] Yes, JFN has already been tossed 39268 004767'01 202 05 0 00 004752* movem q1, pars3 ;[220] Save some kind of JFN 39269 004770'01 124 07 0 00 001053* dmovem q3, pars4 ;[220] Also device information, if useful 39270 004771'01 263 17 0 00 000000 ret ;[220] Done 39271 004772'01 endif. ;[220] 39272 ;[220] Otherwise, start whining 39273 004772'01 200 01 0 00 000000# emsg 39274 004773'01 104 00 0 00 000313 39275 000341'02 000000000000# 39276 001223'04 103 141 156 047 164 39277 004774'01 201 01 0 00 000101 movei t1, .priou ;[220] Contine on terminal 39278 004775'01 200 02 0 00 000005 move t2, q1 ;[220] Load the JFN, no flags 39279 004776'01 403 03 0 00 000004 setzb t3, t4 ;[220] Standard formating, no goofy prefix 39280 004777'01 104 00 0 00 000030 JFNS% ;[220] Type it 39281 005000'01 320 12 0 00 005002' %jserr(,) ;[220] Odd, but carry on 39282 005001'01 254 00 0 00 005005' 39283 005002'01 265 01 0 00 003600* 39284 005003'01 000000000000# 39285 005004'01 254 00 0 00 005005' 39286 001230'04 125 156 141 142 154 39287 005005'01 200 01 0 00 000005 move t1, q1 ;[220] Get the JFN 39288 005006'01 104 00 0 00 000023 RLJFN% ;[220] Toss it 39289 005007'01 320 12 0 00 005011' %jserr(,) ;[220] Odd, but carry on 39290 005010'01 254 00 0 00 005014' 39291 005011'01 265 01 0 00 005002* 39292 005012'01 000000000000# 39293 005013'01 254 00 0 00 005014' 39294 001237'04 125 156 141 142 154 39295 005014'01 254 00 0 00 002767* callret cmder1 ;[220] Allow a reparse (^H) 39296 39297 k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 19:42 30-Mar-24 Page 68 K20SRV MAC 30-Mar-24 15:37 LOCAL RUN command executon 39298 subttl LOCAL RUN command executon 39299 39300 ; Execute local RUN command. 39301 39302 ;[220] Begin code insertion 39303 chgsec(code,const) ; Code to run from registers 39304 000342'02 nulprg: remark ; Pretend we did a GET% into just the AC's 39305 000000 phase 0 ; Runs in accumulators 39306 000000 000000 601405 LSTRX1 ;ac0 No last error 39307 000001 000000 000000 0 ;t1 Argument to PSOUT% 39308 000002 000000 000000 0 ;t2 Argument to SETER% 39309 000003 104 00 0 00 000147 nulent: RESET% ;t3 Reset the world 39310 000004 320 12 0 00 000014 erjmpr nulend ;t4 It *CAN* fail, actually.. 39311 000005 201 01 0 00 400000 movei t1,.fhslf ;q1 This process 39312 000006 200 02 0 00 000000 move t2, f ;q2 No last error (RESET% leaves it in an odd way) 39313 000007 104 00 0 00 000336 SETER% ;q3 Set it 39314 000010 320 12 0 00 000014 erjmpr nulend ;p1 Or not 39315 000011 561 01 0 00 000016 hrroi t1,nulmsg ;p2 Load Tops-20 pointer to text message 39316 000012 104 00 0 00 000076 PSOUT% ;p3 Type it 39317 000013 320 12 0 00 000014 erjmpr nulend ;p4 Or not 39318 000014 104 00 0 00 000170 nulend: HALTF% ;p5 Stop 39319 000015 254 00 0 00 000003 jrst nulent ;p6 Or do it again 39320 000016 472531 435100 nulmsg: BYTE (7) "N","U","L",":",.chspc ;cx 39321 000017 476261 505000 BYTE (7) "O","K",.chcrt,.chlfd,.chnul ;p 39322 000362'02 dephase ; Done with our little NUL: program 39323 retsec ; Restore .psect's 39324 ;[220] End code insertion 39325 39326 005015'01 $yrun: entry $yrun ;[194] 39327 005015'01 337 00 0 00 004767* skipg pars3 ; Re-run current fork? 39328 005016'01 254 00 0 00 005110' jrst $yrun2 ; Yes, do do that. 39329 39330 005017'01 333 01 0 00 000000# skiple t1, rufork ; No, do we have a current fork to kill? 39331 005020'01 104 00 0 00 000153 KFORK ; Yes, try to kill it. 39332 005021'01 320 12 0 00 005023' %jserr (,r) ;[194] 39333 005022'01 254 00 0 00 005026' 39334 005023'01 265 01 0 00 005011* 39335 005024'01 000000000000# 39336 005025'01 254 00 0 00 004401* 39337 001247'04 103 141 156 047 164 39338 005026'01 403 01 0 00 000002 setzb t1, t2 ; Take care of capabilities below. 39339 005027'01 104 00 0 00 000152 CFORK ; Make a fork. 39340 005030'01 320 12 0 00 005032' %jserr (,r); 39341 005031'01 254 00 0 00 005035' 39342 005032'01 265 01 0 00 005023* 39343 005033'01 000000000000# 39344 005034'01 254 00 0 00 005025* 39345 001256'04 103 141 156 047 164 39346 005035'01 202 01 0 00 000000# movem t1, rufork ; Remember the fork handle. 39347 005036'01 200 04 0 00 000001 move t4, t1 ;[220] Keep the handle handy 39348 005037'01 336 02 0 00 000000* skipn t2, capas ;[169] Get our capabilities. 39349 005040'01 200 02 0 00 000000# move t2, mycaps+1 ;[187] Use start up enabled caps, instead 39350 005041'01 630 02 0 00 006575' andx t2,badmsk ;[186] Don't turn on unsafe bits 39351 005042'01 621 02 0 00 040000 txz t2, sc%log ;[169] Do not allow inferior to log us out 39352 005043'01 661 02 0 00 200000 txo t2, sc%gtb ;[169] but with GETAB capability (for Exec), k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 19:42 30-Mar-24 Page 68-1 K20SRV MAC 30-Mar-24 15:37 LOCAL RUN command executon 39353 005044'01 200 03 0 00 000002 move t3, t2 ;[169] Enable what we've set 39354 005045'01 104 00 0 00 000151 EPCAP ;[169] ... 39355 005046'01 320 14 0 00 005047' erjmps .+1 ;[194] ... 39356 005047'01 517 00 0 00 000001 hrlzs t1 ; Move handle into left half. 39357 005050'01 540 01 0 00 005015* hrr t1, pars3 ; JFN in right half. 39358 005051'01 550 03 0 00 000001 hrrz t3, t1 ;[220] Save a copy of the JFN 39359 005052'01 400 02 0 00 000000 setz t2, ;[220] Nothing special. 39360 005053'01 302 03 0 00 377777 caie t3, .nulio ;[220] NUL:? 39361 005054'01 254 00 0 00 005077' ifskp. ;[220] Just give up here 39362 005055'01 200 01 0 00 000004 move t1, t4 ;[220] Inferior fork handle 39363 005056'01 201 02 0 00 000000# movei t2, nulprg ;[220] NUL: program 39364 005057'01 104 00 0 00 000160 SFACS% ;[220] Set the registers 39365 005060'01 320 12 0 00 005062' %jserr (,r) ;[220] ?? 39366 005061'01 254 00 0 00 005065' 39367 005062'01 265 01 0 00 005032* 39368 005063'01 000000000000# 39369 005064'01 254 00 0 00 005034* 39370 001263'04 103 157 165 154 144 39371 005065'01 200 02 0 00 006576' move t2, [1,,nulent] ;[220] Load NUL:'s 'start address' 39372 005066'01 104 00 0 00 000204 SEVEC% ;[220] Set the entry vector 39373 005067'01 477 02 0 00 000003 setob t2, t3 ;[220] Don't fault in PA1050 39374 005070'01 104 00 0 00 000301 SCVEC% ;[220] Shut off UUO simulation 39375 005071'01 320 12 0 00 005073' %jserr (,) ;[220] Odd, but continue 39376 005072'01 254 00 0 00 005076' 39377 005073'01 265 01 0 00 005062* 39378 005074'01 000000000000# 39379 005075'01 254 00 0 00 005076' 39380 001272'04 103 157 165 154 144 39381 remark ;[220] Fall through to $yrun2 39382 005076'01 254 00 0 00 005110' else. ;[220] Otherwise, it's a real file 39383 005077'01 104 00 0 00 000200 GET ; Get the file to run. 39384 005100'01 320 12 0 00 005102' %jserr (,r) 39385 005101'01 254 00 0 00 005105' 39386 005102'01 265 01 0 00 005073* 39387 005103'01 000000000000# 39388 005104'01 254 00 0 00 005064* 39389 001301'04 103 141 156 047 164 39390 005105'01 550 01 0 00 005050* hrrz t1, pars3 ; Got the file, now can release its JFN. 39391 005106'01 104 00 0 00 000023 RLJFN 39392 005107'01 320 12 0 00 005110' erjmpr .+1 ;[220] Catch and ignore error 39393 005110'01 endif. ;[220] 39394 39395 ; Can come straight here to re-run current fork. 39396 39397 005110'01 337 01 0 00 000000# $yrun2: skipg t1, rufork ; Get fork handle. 39398 005111'01 334 01 0 00 000000# ermsg% (,r) ; Make sure it's ok. 39399 005112'01 254 00 0 00 005116' 39400 005113'01 202 01 0 00 002466* 39401 005114'01 104 00 0 00 000313 39402 005115'01 254 00 0 00 005104* 39403 000362'02 000000000000# 39404 001306'04 113 105 122 115 111 39405 39406 005116'01 400 02 0 00 000000 setz t2, ; Primary start address. 39407 005117'01 104 00 0 00 000201 SFRKV ; Start it up. k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 19:42 30-Mar-24 Page 68-2 K20SRV MAC 30-Mar-24 15:37 LOCAL RUN command executon 39408 005120'01 320 12 0 00 005122' %jserr (,r) 39409 005121'01 254 00 0 00 005125' 39410 005122'01 265 01 0 00 005102* 39411 005123'01 000000000000# 39412 005124'01 254 00 0 00 005115* 39413 001314'04 103 141 156 047 164 39414 005125'01 104 00 0 00 000163 WFORK ; wait for the fork to halt. 39415 005126'01 320 12 0 00 005130' %jserr (,r) 39416 005127'01 254 00 0 00 005133' 39417 005130'01 265 01 0 00 005122* 39418 005131'01 000000000000# 39419 005132'01 254 00 0 00 005124* 39420 001321'04 103 141 156 047 164 39421 39422 005133'01 263 17 0 00 000000 ret 39423 k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 19:42 30-Mar-24 Page 69 K20SRV MAC 30-Mar-24 15:37 SRVCMD - Routine to send a command to a server. 39424 subttl SRVCMD - Routine to send a command to a server. 39425 ; 39426 ; Call with: 39427 ; 39428 ; t1/ Byte pointer to string. 39429 ; First character is Generic Command, subsequent chars are arguments. 39430 ; t2/ Packet type, e.g. "G" for Generic, "C" for Host Command. 39431 ; 39432 ; Returns: 39433 ; 39434 ; +1 if reply was not received successfully. 39435 ; +2 If we got a good response, with 39436 ; t1/ packet type of response, "Y", "X", or "S". 39437 ; PKTACS/ Block of 4 words containing the data returned by RPACK. 39438 ; 39439 ; If packet was ACK containing data, this routine prints it. 39440 39441 005134'01 332 00 0 00 002460* srvcmd: skipe takdep ;[176] Allow commands to servers from TAKE file 39442 005135'01 254 00 0 00 005136' jrst srvxx 39443 005136'01 265 16 0 00 006265' srvxx: saveac ; Preserve these work registers. 39444 005137'01 120 05 0 00 000001 dmove q1, t1 ; Copy arguments into them. 39445 005140'01 336 00 0 00 003715* skipn local ;[177] Local Kermit? 39446 005141'01 260 17 0 00 003225* call inilin ;[177] No, set TTY: up for packets. 39447 005142'01 402 00 0 00 003674* setzm numtry ; Reset retry counter. 39448 005143'01 402 00 0 00 000000* setzm nnak ; Init some statistics counters 39449 005144'01 402 00 0 00 000000* setzm ntimou ; ... 39450 005145'01 476 00 0 00 003250* setom bctone ; Force 1-char checksum. 39451 005146'01 260 17 0 00 000043* call clrbuf ;[194] Clear out any stacked-up NAKs 39452 005147'01 600 00 0 00 000000 nop ;[186] Ignore any errors 39453 005150'01 260 17 0 00 003223* call statim ; Start timing (so k20pdc works) 39454 005151'01 260 17 0 00 003226* call ccon ; Let them ^C out gracefully 39455 005152'01 254 00 0 00 005267' jrst srvcmx ; and go here if they do. 39456 39457 005153'01 260 17 0 00 000000* call setlog ; Set up any debugging log. 39458 005154'01 600 00 0 00 000000 nop 39459 39460 ; Put the command into the data field of the packet, using the normal 39461 ; packet-filling technique, prefixing, etc. 39462 39463 005155'01 402 00 0 00 000000* setzm datbuf ;[190] ; Zero the buffer. 39464 39465 005156'01 201 01 0 00 003704' srvcma: movei t1, gtsch ; Indicate routine to be used for getting 39466 005157'01 202 01 0 00 004727* movem t1, source ; characters. 39467 005160'01 202 05 0 00 004463* movem q1, strptr ; And where it should get them from. 39468 005161'01 476 00 0 00 004730* setom next ; Set initial condition. 39469 005162'01 200 01 0 00 004413* move t1, maxdat ; Get a buffer full of data. 39470 005163'01 260 17 0 00 004414* call getbuf ; ... 39471 005164'01 326 01 0 00 005267' jumpn t1, srvcmx ; Clean up if this fails. 39472 005165'01 402 00 0 00 005157* setzm source ; Got it, so put GETCH back to normal. 39473 39474 005166'01 202 01 0 00 000000# movem t1, gclen ; Save length. 39475 005167'01 326 01 0 00 005175' jumpn t1, srvcm2 ; Proceed if we got any. 39476 39477 005170'01 334 01 0 00 000000# ermsg% (, srvcmx) ; Do this otherwise. 39478 005171'01 254 00 0 00 005175' k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 19:42 30-Mar-24 Page 69-1 K20SRV MAC 30-Mar-24 15:37 SRVCMD - Routine to send a command to a server. 39479 005172'01 202 01 0 00 005113* 39480 005173'01 104 00 0 00 000313 39481 005174'01 254 00 0 00 005267' 39482 000363'02 000000000000# 39483 001326'04 113 105 122 115 111 39484 39485 39486 ; Top of try-again loop. 39487 39488 005175'01 200 05 0 00 005142* srvcm2: move q1, numtry ; Too many tries? 39489 005176'01 311 05 0 00 000000* caml q1, maxtry 39490 005177'01 334 01 0 00 000000# ermsg% (,srvcmx) 39491 005200'01 254 00 0 00 005204' 39492 005201'01 202 01 0 00 005172* 39493 005202'01 104 00 0 00 000313 39494 005203'01 254 00 0 00 005267' 39495 000364'02 000000000000# 39496 001337'04 113 105 122 115 111 39497 39498 005204'01 350 00 0 00 005175* aos numtry ; Not too many, count this try. 39499 005205'01 200 01 0 00 000006 move t1, q2 ; Packet type. 39500 005206'01 400 02 0 00 000000 setz t2, ; Make the packet number zero. 39501 005207'01 200 03 0 00 000000# move t3, gclen ; Length of data. 39502 005210'01 200 04 0 00 006556' move t4, [point 8, datbuf] ;[190] Point to data buffer. 39503 005211'01 260 17 0 00 004423* call spack ; Send it off. 39504 005212'01 254 00 1 01 006577' jrst @[exp srvcm2, srvcmx](t1) ; Handle nonfatal & fatal failures. 39505 005213'01 402 00 0 00 000000* setzm gotx ; Assume it'll be an ACK. 39506 005214'01 260 17 0 00 003252* call rpack ; Look for response. 39507 005215'01 334 01 0 00 000000# ermsg% (,srvcm2) 39508 005216'01 254 00 0 00 005222' 39509 005217'01 202 01 0 00 005201* 39510 005220'01 104 00 0 00 000313 39511 005221'01 254 00 0 00 005175' 39512 000365'02 000000000000# 39513 001353'04 113 105 122 115 111 39514 39515 39516 005222'01 302 01 0 00 000130 caie t1, "X" ; X or Y? 39517 005223'01 306 01 0 00 000131 cain t1, "Y" 39518 005224'01 254 00 0 00 005307' jrst srvcmz ; Good. 39519 39520 005225'01 302 01 0 00 000123 caie t1, "S" ; S or I? 39521 005226'01 306 01 0 00 000111 cain t1, "I" 39522 005227'01 254 00 0 00 005307' jrst srvcmz ; That's ok too. 39523 39524 005230'01 302 01 0 00 000105 caie t1, "E" ; Error packet? 39525 005231'01 254 00 0 00 005241' ifskp. ;[186] Yes, let's see about squawking 39526 005232'01 336 00 0 00 005140* skipn local ;[186] Local? 39527 005233'01 254 00 0 00 005267' jrst srvcmx ;[186] No, this will always mess up 39528 005234'01 200 01 0 00 000000# emsg ;[186] Yes, print it. 39529 005235'01 104 00 0 00 000313 39530 000366'02 000000000000# 39531 001361'04 122 145 155 157 164 39532 005236'01 200 01 0 00 000004 move t1, t4 ; Get pointer to it, 39533 005237'01 104 00 0 00 000076 PSOUT% ; and print it. k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 19:42 30-Mar-24 Page 69-2 K20SRV MAC 30-Mar-24 15:37 SRVCMD - Routine to send a command to a server. 39534 005240'01 254 00 0 00 005267' jrst srvcmx ;[70] 39535 005241'01 endif. ;[186] End error pack 39536 39537 005241'01 302 01 0 00 000116 caie t1, "N" ; NAK? 39538 005242'01 306 01 0 00 000124 cain t1, "T" ; Or Timeout? 39539 005243'01 254 00 0 00 005175' jrst srvcm2 ; One of those, go try again. 39540 39541 005244'01 336 00 0 00 005232* skipn local ;[233] Local? 39542 005245'01 254 00 0 00 005267' jrst srvcmx ;[235] Nothing to display on 39543 remark ;[235] Tell us the offending packet and punt 39544 005246'01 200 02 0 00 000001 move t2,t1 ;[235] Save the offending character 39545 005247'01 561 01 0 00 006601' hrroi t1,[ asciz /Invalid response from server: '/] ;[235] 39546 005250'01 104 00 0 00 000313 ESOUT% ;[235] Begin blat 39547 005251'01 320 12 0 00 005252' erjmpr .+1 ;[235] Catch and ignore any error 39548 005252'01 200 01 0 00 000002 move t1,t2 ;[235] Get the character back 39549 005253'01 104 00 0 00 000074 PBOUT% ;[235] Type it 39550 005254'01 320 12 0 00 005255' erjmpr .+1 ;[235] Catch and ignore any error 39551 005255'01 561 01 0 00 006610' hrroi t1,[asciz /' (/] ;[235] And seperate the rest 39552 005256'01 104 00 0 00 000076 PSOUT% ;[235] Type that 39553 005257'01 320 12 0 00 005260' erjmpr .+1 ;[235] Catch and ignore any error 39554 005260'01 201 01 0 00 000101 movei t1,.priou ;[235] Still going to primary output 39555 005261'01 201 03 0 00 000010 movei t3,^d8 ;[235] ASCII characters are base 8 here 39556 005262'01 104 00 0 00 000224 NOUT% ;[235] Type it 39557 005263'01 320 12 0 00 005264' erjmpr .+1 ;[235] Catch and ignore any error 39558 hrroi t1,[asciz /) 39559 005264'01 561 01 0 00 006611' /] ;[235] Close off the line 39560 005265'01 104 00 0 00 000076 PSOUT% ;[235] Type that 39561 005266'01 320 12 0 00 005267' erjmpr .+1 ;[235] Catch and ignore any error 39562 remark srvcmx ;[235] Falls through 39563 39564 ; Exit point for any kind of error, failure, or interruption 39565 39566 005267'01 260 17 0 00 003122* srvcmx: call ccoff ; Turn off ^C trap. 39567 005270'01 260 17 0 00 000000* call caxzof ; Turn these interrupts off too. 39568 005271'01 260 17 0 00 003454* call endtim ;[189] Stop timing 39569 005272'01 260 17 0 00 003455* call elptim ;[189] Compute elapsed time 39570 005273'01 337 01 0 00 003014* skipg t1, filjfn ;[193] Any file left open? 39571 005274'01 254 00 0 00 005302' ifskp. ;[193] Apparently, try to close it. 39572 005275'01 621 01 0 00 777777 tlz t1,-1 ;[193] Ditch any flags 39573 005276'01 302 01 0 00 377777 caie t1, .nulio ;[193] No need to close since never opened 39574 005277'01 104 00 0 00 000022 CLOSF 39575 005300'01 320 12 0 00 005301' erjmpr .+1 ;[193] Catch and ignore error 39576 005301'01 402 00 0 00 005273* setzm filjfn ;[193] Whatever it was, it's closed now! 39577 005302'01 endif. ;[193](end) 39578 005302'01 336 00 0 00 005244* skipn local ;[177] Put controlling TTY back to normal 39579 005303'01 260 17 0 00 000000* call rrsl2 ;[177] ... (entry point to reslin) 39580 005304'01 402 00 0 00 005165* setzm source ; Put things back to normal. 39581 005305'01 474 01 0 00 000000 seto t1, ; Indicate no good response was received. 39582 005306'01 263 17 0 00 000000 ret ; Return +1. 39583 39584 39585 ; Exit here when response received successfully. 39586 39587 005307'01 124 01 0 00 000000* srvcmz: dmovem t1, pktacs ;[112] Save the ACs returned in RPACK 39588 005310'01 124 03 0 00 000000# dmovem t3, pktacs+2 ;[112] ... k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 19:42 30-Mar-24 Page 69-3 K20SRV MAC 30-Mar-24 15:37 SRVCMD - Routine to send a command to a server. 39589 005311'01 202 02 0 00 003700* movem t2, pktnum ; Synchronize packet numbers. 39590 005312'01 302 01 0 00 000131 caie t1, "Y" ;[194] Was the reply an ACK? 39591 005313'01 254 00 0 00 005324' ifskp. ;[194] It was 39592 005314'01 337 02 0 00 000003 skipg t2, t3 ;[144] Yes, any characters? 39593 005315'01 254 00 0 00 005324' anskp. ;[194] No. 39594 005316'01 201 01 0 00 003715' movei t1, puttch ;[144] Routine to display decoded characters. 39595 005317'01 202 01 0 00 003742* movem t1, dest ;[144] ... 39596 005320'01 200 01 0 00 000004 move t1, t4 ;[144] Pointer to data buffer. 39597 005321'01 260 17 0 00 003736* call putbuf ;[144] Go decode it. 39598 005322'01 600 00 0 00 000000 nop ;[144] 39599 005323'01 402 00 0 00 005317* setzm dest ;[144] 39600 005324'01 endif. ;[194] 39601 005324'01 200 01 0 00 005307* move t1, pktacs ;[112] Get packet type back. 39602 005325'01 260 17 0 00 005267* call ccoff ; Turn off ^C trap. 39603 005326'01 336 00 0 00 005302* skipn local ;[177] Put controlling TTY back to normal 39604 005327'01 260 17 0 00 005303* call rrsl2 ;[177] ... (entry point to reslin) 39605 005330'01 254 00 0 00 004507* retskp ; Done. 39606 k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 19:42 30-Mar-24 Page 70 K20SRV MAC 30-Mar-24 15:37 SINFO Sends Iniatialization Packet 39607 subttl SINFO Sends Iniatialization Packet 39608 39609 ;[58] SINFO added as part of edit 58. 39610 ; 39611 ; Call this routine before sending any server command which has a 39612 ; nontrivial response. For instance, it should be called before 39613 ; requesting a remote directory listing, but need not be called before 39614 ; sending a CWD command, which normally responds with a simple ACK. 39615 ; 39616 ; Action: Sends an info packet with our own parameters, waits for 39617 ; ACK with other side's. Uses packet number 0, does not increment the 39618 ; packet number. If other side doesn't know about I packets, this 39619 ; routine returns as if a an ACK was received containing all default 39620 ; values. 39621 ; 39622 ; Returns: 39623 ; +1 on failure, maximum tries exceeded. 39624 ; +2 on "success" getting a reply, even if it was an error packet, 39625 ; with other sides parameters set. 39626 39627 005331'01 sinfo: entry sinfo 39628 005331'01 265 16 0 00 006612' saveac ;[128] Save these. 39629 005332'01 402 00 0 00 005204* setzm numtry ; Give it a try, 39630 005333'01 402 00 0 00 005311* setzm pktnum ; starting out with a clean slate. 39631 005334'01 476 00 0 00 005145* setom bctone ;[98] Use 1-char checksum. 39632 39633 005335'01 260 17 0 00 005146* call clrbuf ;[194] Clear out any piled up NAKs. 39634 005336'01 600 00 0 00 000000 nop ;[186] Ignore any errors 39635 005337'01 260 17 0 00 005153* call setlog ; Set up any debugging log. 39636 005340'01 600 00 0 00 000000 nop 39637 005341'01 201 11 0 00 000123 movei state, "S" ;[133] This will be a little state switcher. 39638 39639 005342'01 201 01 0 00 000111 sinfo2: movei t1, "I" ;[100][133] Packet type. 39640 005343'01 476 00 0 00 000000* setom iflg ;[100] Say we're doing I, not S. 39641 005344'01 260 17 0 00 000000* call sinit ;[100] Let SINIT send it & get reply. 39642 005345'01 302 01 0 00 000105 caie t1, "E" ;[194] Other side doesn't know I packet? 39643 005346'01 254 00 0 00 005352' ifskp. ;[194] Strangely, no 39644 005347'01 403 03 0 00 000004 setzb t3, t4 ;[133] Then set defaults this way. 39645 005350'01 260 17 0 00 003673* call spar ;[133] Sets our parameters 39646 005351'01 254 00 0 00 005360' jrst sinfoz ;[133] And return successfully. 39647 005352'01 endif. ;[194] 39648 39649 ;[133] Keep going if it doesn't get thru the first time. 39650 39651 005352'01 306 11 0 00 000106 cain state, "F" ; Switched into F state? 39652 005353'01 254 00 0 00 005360' jrst sinfoz ; Yes, so I was ACK'd, done. 39653 005354'01 306 11 0 00 000123 cain state, "S" ; Still in S state? 39654 005355'01 254 00 0 00 005342' jrst sinfo2 ; So go round again. 39655 39656 005356'01 402 00 0 00 005343* sinfox: setzm iflg ; Must have exceeded retry limit. 39657 005357'01 263 17 0 00 000000 ret ; Fail. 39658 39659 005360'01 402 00 0 00 005356* sinfoz: setzm iflg ;[100] Done with sending I packet. 39660 005361'01 254 00 0 00 005330* retskp 39661 k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 19:42 30-Mar-24 Page 70-1 K20SRV MAC 30-Mar-24 15:37 SINFO Sends Iniatialization Packet 39662 k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 19:42 30-Mar-24 Page 71 K20SRV MAC 30-Mar-24 15:37 SRVFIL 39663 subttl SRVFIL 39664 ; 39665 ; Common code to construct a generic one-field command. 39666 ; Generic command is single character in t4. Argument is in ATMBUF. 39667 ; Puts a 1-character length field at the beginning. 39668 ; 39669 005362'01 260 17 0 00 005331' srvfil: call sinfo ;[128] Exchange parameters with I packet. 39670 005363'01 263 17 0 00 000000 ret ;[133] Failed, give up. 39671 39672 005364'01 402 00 0 00 000000# setzm srvbuf ;[194] Zero out old stuff 39673 005365'01 200 01 0 00 006622' move t1, [srvbuf,,srvbuf+1] ;[194] The whole buffer 39674 005366'01 251 01 0 00 000000# blt t1, srvbzz ;[194] Not just two words ... 39675 dmove t1, [ point 7, atmbuf ;[194] Copy directory name from here 39676 005367'01 120 01 0 00 006523' point 7, strbuf ] ;[194] to there 39677 39678 005370'01 136 04 0 00 000002 idpb t4, t2 ; Deposit generic command. 39679 005371'01 133 00 0 00 000002 ibp t2 ; Leave a space 39680 005372'01 400 03 0 00 000000 setz t3, ; Initialize counter 39681 39682 005373'01 do. ;[194] Enter loop context 39683 005373'01 134 04 0 00 000001 ildb t4, t1 ; Get next one. 39684 005374'01 136 04 0 00 000002 idpb t4, t2 ; Deposit this one. 39685 005375'01 322 04 0 00 005377' jumpe t4, endlp. ;[194] Stop on a .chnul 39686 005376'01 344 03 0 00 005373' aoja t3, top. ;[194] Otherwise, count it & loop. 39687 005377'01 enddo. ;[194] Exit loop context 39688 39689 ;* jumpe t3, [ ; Make sure there was at least one character. 39690 ;* txmsg 39691 ;* ret ] 39692 39693 005377'01 200 01 0 00 000003 srvfi3: move t1, t3 ; Length 39694 005400'01 271 01 0 00 000040 addi t1, 40 ; CHAR of that. 39695 005401'01 200 02 0 00 006422' move t2, [point 7, strbuf, 13] ; Deposit count at head of field. 39696 005402'01 137 01 0 00 000002 dpb t1, t2 39697 005403'01 200 01 0 00 006420' move t1, [point 7, strbuf] ; Point to generic command. 39698 005404'01 201 02 0 00 000107 movei t2, "G" ; Packet type is G. 39699 005405'01 254 00 0 00 005406' jrst dosrv ; Go do it. 39700 39701 k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 19:42 30-Mar-24 Page 72 K20SRV MAC 30-Mar-24 15:37 DOSRV - Wrapper for SRVCMD 39702 subttl DOSRV - Wrapper for SRVCMD 39703 39704 ; Call this exactly like SRVCMD. 39705 ; 39706 ; Send a command to a server and dispatch appropriately depending on the reply. 39707 ; 39708 005406'01 dosrv: entry dosrv ;[220] 39709 005406'01 402 00 0 00 005213* setzm gotx ; Clear flags: "got X packet", 39710 005407'01 402 00 0 00 000000* setzm gots ; "got S packet". 39711 005410'01 260 17 0 00 005134' call srvcmd ; Send a generic command. 39712 005411'01 263 17 0 00 000000 ret ; Didn't get good response. 39713 005412'01 306 01 0 00 000131 cain t1, "Y" ; Was it an ACK? 39714 005413'01 263 17 0 00 000000 ret ; Yes, so we're done. 39715 39716 ; Come here if we're about to receive a multipacket reply. 39717 39718 005414'01 302 01 0 00 000130 caie t1, "X" ; Text header? 39719 005415'01 254 00 0 00 005462' jrst dosrv3 ; No 39720 39721 005416'01 476 00 0 00 005406* setom gotx ; Yup, flag that we already got it. 39722 005417'01 201 11 0 00 000106 movei state, "F" ; State state to file receive. 39723 005420'01 336 00 0 00 000003 skipn t3 ;[173](begin) Any contents? 39724 005421'01 254 00 0 00 000000* jrst $recvb ; No. 39725 39726 remark ;[220] Squeeze out leading and trailing CRLF's 39727 005422'01 415 16 0 00 005461' block. ;[220] Yes, create a frame to print them 39728 005423'01 261 17 0 00 000016 39729 005424'01 265 16 0 00 006314' saveac ;[220] Save in flight temporaries (particularly t1) 39730 005425'01 200 04 0 00 000000# move t4, pktacs+3 ;[220] Load pointer text 39731 005426'01 200 03 0 00 000004 move t3, t4 ;[220] Keep a copy handy 39732 39733 005427'01 134 01 0 00 000004 ildb t1, t4 ;[220] Pick up a character 39734 005430'01 302 01 0 00 000015 caie t1, .chcrt ;[220] A carriage return? 39735 005431'01 254 00 0 00 005436' ifskp. ;[220] It is, let's see if followed by a line feed 39736 005432'01 134 01 0 00 000004 ildb t1, t4 ;[220] Pick up another character 39737 005433'01 302 01 0 00 000012 caie t1, .chlfd ;[220] A line feed?? 39738 005434'01 254 00 0 00 005436' anskp. ;[220] No, so must advance the carriage 39739 remark ;[220] Fall out and skip the crlf 39740 005435'01 254 00 0 00 005441' else. ;[220] Need to get to a clean line 39741 005436'01 561 01 0 00 003051* hrroi t1, crlf 39742 005437'01 104 00 0 00 000076 PSOUT% 39743 005440'01 320 12 0 00 005132* erjmpr r ;[220] If fails, break out of the block, +1 39744 005441'01 endif. ;[220] Either way, ready to see something 39745 39746 005441'01 200 01 0 00 000003 move t1, t3 ;[220] Load original pointer 39747 005442'01 104 00 0 00 000076 PSOUT% ;[220] Type whatever we got handed 39748 005443'01 320 12 0 00 005440* erjmpr r ;[220] Or not... 39749 39750 005444'01 211 04 0 00 777776 movni t4, -2 ;[220] Done printing, so back the 39751 005445'01 133 04 0 00 000001 adjbp t4, t1 ;[220] pointer up so we can have a look 39752 005446'01 134 01 0 00 000004 ildb t1, t4 ;[220] Pick up a character 39753 005447'01 302 01 0 00 000015 caie t1, .chcrt ;[220] A carriage return? 39754 005450'01 254 00 0 00 005455' ifskp. ;[220] It is, let's see if followed by a line feed 39755 005451'01 134 01 0 00 000004 ildb t1, t4 ;[220] Pick up another character 39756 005452'01 302 01 0 00 000012 caie t1, .chlfd ;[220] A line feed?? k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 19:42 30-Mar-24 Page 72-1 K20SRV MAC 30-Mar-24 15:37 DOSRV - Wrapper for SRVCMD 39757 005453'01 254 00 0 00 005455' anskp. ;[220] No, so must advance the carriage 39758 remark ;[220] Fall out and skip the crlf 39759 005454'01 254 00 0 00 005460' else. ;[220] Need to get to a clean line 39760 005455'01 561 01 0 00 005436* hrroi t1, crlf 39761 005456'01 104 00 0 00 000076 PSOUT% 39762 005457'01 320 12 0 00 005443* erjmpr r ;[220] If fails, break out of the block, +1 39763 005460'01 endif. ;[220] Either way, ready to see something 39764 remark ;[220] Fall out of the block 39765 005460'01 263 17 0 00 000000 endbk. ;[220] End block context 39766 005461'01 254 00 0 00 005421* jrst $recvb ; Go receive whatever is coming. 39767 39768 005462'01 302 01 0 00 000123 dosrv3: caie t1, "S" ;[194] Or Send-Init? 39769 005463'01 254 00 0 00 005467' ifskp. ;[194] Got it 39770 005464'01 476 00 0 00 005407* setom gots ; Yes, flag that we already got it. 39771 005465'01 201 11 0 00 000122 movei state, "R" ; Set state to receive init. 39772 005466'01 254 00 0 00 005461* jrst $recvb ; Go receive what's coming. 39773 005467'01 endif. ;[194] 39774 39775 005467'01 334 01 0 00 000000# ermsg% (,r) 39776 005470'01 254 00 0 00 005474' 39777 005471'01 202 01 0 00 005217* 39778 005472'01 104 00 0 00 000313 39779 005473'01 254 00 0 00 005457* 39780 000367'02 000000000000# 39781 001365'04 113 105 122 115 111 39782 39783 k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 19:42 30-Mar-24 Page 73 K20SRV MAC 30-Mar-24 15:37 Is this a directory device? 39784 subttl Is this a directory device? 39785 39786 ;[193] Begin code insertion 39787 ; 39788 ; Call: 39789 ; 39790 ; t1/ JFN to test, NO FLAGS! 39791 ; 39792 ; Returns: 39793 ; 39794 ; +1, Not a directory based device 39795 ; N.B., t1 and t2 may be invalid if DVCHR% failed! 39796 ; 39797 ; +2, Something we can use as a directory 39798 ; 39799 ; t1/ device designator 39800 ; t2/ device characteristics word 39801 ; 39802 ; All other accumulators are preserved 39803 ; 39804 ; NUL: and .nulio directories are expected to be simulated by calling routine 39805 39806 005474'01 isdird: entry isdird ; Called by k20par and maybe k20dsp 39807 005474'01 260 17 0 00 004701* call isnulj ; Is this some kind of NUL: or .nulio? 39808 005475'01 254 00 0 00 005500' ifskp. ; It is, so just say yes 39809 dmove t1, [ .dvdes!.dvnul,,-1 ; NUL: has no units 39810 005476'01 120 01 0 00 006623' dv%out!dv%in!dv%av!fld(.dvnul,dv%typ)!dv%psd!fld(-1,dv%mod) ] 39811 005477'01 254 00 0 00 005361* retskp ; Insist that it is a directory device 39812 005500'01 endif. ; Done with the easy case 39813 ; Have to do some work... 39814 005500'01 265 16 0 00 006612' saveac ; Don't touch the other accumulators 39815 005501'01 104 00 0 00 000117 DVCHR% ; Get device characteristics 39816 005502'01 320 12 0 00 005504' ifje. r ; Fail and retrieve error 39817 005503'01 254 00 0 00 005510' 39818 005504'01 200 04 0 00 000001 move t4, t1 ; Store the error 39819 005505'01 477 01 0 00 000002 setob t1, t2 ; Cons up some real junk 39820 005506'01 400 03 0 00 000000 setz t3, ; This value should never happen 39821 005507'01 254 00 0 00 005511' else. ; Otherwise, worked 39822 005510'01 400 04 0 00 000000 setz t4, ; Flag that DVCHR% worked 39823 005511'01 endif. ; End case DVCHR% failure recovery 39824 ; Finally pick up the device type 39825 005511'01 135 03 0 00 006276' ldb t3,[pointr(t2,dv%typ)] 39826 005512'01 306 03 0 00 000015 cain t3, .dvnul ; NUL:? 39827 005513'01 254 00 0 00 005477* retskp ; Can always delete or list that (simulated) 39828 005514'01 306 03 0 00 000000 cain t3, .dvdsk ; Structure? 39829 005515'01 254 00 0 00 005513* retskp ; Yes, that has directories and files 39830 005516'01 306 03 0 00 000003 cain t3, .dvdta ; Eh? DECtape?? 39831 005517'01 254 00 0 00 005515* retskp ; Who put that back in? 39832 ; None of the above, try general case 39833 005520'01 326 04 0 00 005524' ife. t4 ; Did the DVCHR% work? 39834 005521'01 607 02 0 00 100000 txnn t2, dv%dir ; It did, so does the device have directories? 39835 005522'01 254 00 0 00 005524' anskp. ; No, so can't return true 39836 005523'01 254 00 0 00 005517* retskp ; Something new with a directory should work 39837 005524'01 endif. ; Otherwise, they are out of luck 39838 k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 19:42 30-Mar-24 Page 73-1 K20SRV MAC 30-Mar-24 15:37 Is this a directory device? 39839 005524'01 263 17 0 00 000000 ret ; Return doesn't have directories 39840 39841 ;[194] End code insertion 39842 k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 19:42 30-Mar-24 Page 74 K20SRV MAC 30-Mar-24 15:37 GTNFIL - Get next file from wild file specification. 39843 subttl GTNFIL - Get next file from wild file specification. 39844 39845 ; Call: 39846 ; 39847 ; filjfn/ Current JFN, possibly one of many 39848 ; nxtjfn/ Next JFN in sequence (1-file lookahead) 39849 ; ndxjfn/ Flags associated with stepping to next specification 39850 ; 39851 ; Returns: 39852 ; 39853 ; +1 t1/ 0 (indicating no more) 39854 ; +2 t1/ JFN of next file 39855 ; 39856 ;[111] Rewritten to do 1-file lookahead as part of edit 111. 39857 ; 39858 ;[194] Partial rewrite to simulate NUL: stepping and also to always 39859 ; return zero on plus 1 return, as per specification 39860 39861 005525'01 gtnfil: entry gtnfil ; Also used by k20mit 39862 005525'01 337 01 0 00 005301* skipg t1, filjfn ;[193] Release the JFN of the previous file. 39863 005526'01 254 00 0 00 005534' ifskp. ;[193] If we have one ... 39864 005527'01 621 01 0 00 777777 tlz t1, -1 ;[252] Stomp any flags, just in case 39865 005530'01 306 01 0 00 377777 cain t1, .nulio ;[193] But!! Is this the sink? 39866 005531'01 254 00 0 00 005534' anskp. ;[193] Yes, no need to release it 39867 005532'01 104 00 0 00 000023 RLJFN 39868 005533'01 320 12 0 00 005534' erjmpr .+1 ;[193] Catch and ignore error 39869 005534'01 endif. ;[193] End case releasing JFN 39870 005534'01 402 00 0 00 005525* setzm filjfn 39871 39872 ; Check to see if we really want to or can get the next file. 39873 39874 005535'01 400 01 0 00 000000 setz t1, ; Assume no more files. 39875 005536'01 336 00 0 00 000000* skipn czseen ;[59] If CTRL-Z seen, then get no more files. 39876 005537'01 336 01 0 00 003421* skipn t1, nxtjfn ; No CTRL-Z. Get next JFN. 39877 005540'01 263 17 0 00 000000 ret ; None, so we're done. 39878 39879 ; Make a separate JFN for the file so that wildcard stepping won't be 39880 ; wiped out by anything we do to it, like deleting it, renaming it, etc. 39881 39882 005541'01 550 02 0 00 000001 hrrz t2, t1 ; Get the filename string. 39883 005542'01 561 01 0 00 003727* hrroi t1, strbuf 39884 005543'01 306 02 0 00 377777 cain t2, .nulio ;[193] Data sink? 39885 005544'01 254 00 0 00 005555' ifskp. ;[193] No, do it the regular way 39886 005545'01 120 03 0 00 002006* dmove t3, allfld ;[252] dev:name.typ.gen 39887 005546'01 104 00 0 00 000030 JFNS 39888 005547'01 320 12 0 00 005603' erjmpr gtnerr ;[194] Bag the whole thing if failed 39889 005550'01 205 01 0 00 100001 movx t1, gj%old!gj%sht ;Get a new JFN on it. 39890 005551'01 561 02 0 00 005542* hrroi t2, strbuf 39891 005552'01 104 00 0 00 000020 GTJFN 39892 005553'01 320 12 0 00 005603' erjmpr gtnerr ;[194] Bag the whole thing if failed 39893 005554'01 254 00 0 00 005561' else. ;[193] Otherwise, NUL: 39894 dmove t2 , [ BYTE (7) "N","U","L",":", 0 39895 005555'01 120 02 0 00 006625' 0 ] ;[193] 39896 005556'01 124 02 0 00 005551* dmovem t2, strbuf ;[193] Put the file name into the buffer 39897 005557'01 400 04 0 00 000000 setz t4, ;[193] Keep t4 whacked like JFNS k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 19:42 30-Mar-24 Page 74-1 K20SRV MAC 30-Mar-24 15:37 GTNFIL - Get next file from wild file specification. 39898 005560'01 201 01 0 00 377777 movei t1, .nulio ;[193] Load sink 39899 005561'01 endif. ;[193] End special case NUL: 39900 39901 005561'01 552 01 0 00 005534* hrrzm t1, filjfn ; Save it here, sans flags, if any 39902 005562'01 402 00 0 00 005556* setzm strbuf ; Scrub the buffer 39903 005563'01 402 00 0 00 000000# setzm strbuf+1 ; Give it a little more scrubby, just in case 39904 39905 ; Get new next JFN. 39906 39907 005564'01 550 01 0 00 005537* hrrz t1, nxtjfn ;[193] Get the JFN again. 39908 005565'01 302 01 0 00 377777 caie t1, .nulio ;[193] Data sink? 39909 005566'01 254 00 0 00 005572' ifskp. ;[193] Yes, so nothing to step 39910 005567'01 402 00 0 00 005564* setzm nxtjfn ;[193] So flag nothing left 39911 005570'01 402 00 0 00 003422* setzm ndxjfn ;[193] Nothing to step to 39912 remark t1, .nulio ;[193] Fall through with .nulio as JFN 39913 005571'01 254 00 0 00 005601' else. ;[193] Otherwise, have something to sep 39914 005572'01 500 01 0 00 005570* hll t1, ndxjfn ; Get wildcard flags into left half. 39915 repeat 0,< ;[252] Unnecessary now that debugging is comeplete 39916 move t2, t1 ;[252] Save the pair 39917 hrroi t1, crlf ;[252] 39918 PSOUT% ;[252] 39919 move t1, t2 ;[252] Restore the pair 39920 call jfnflg## ;[252] Show the flags 39921 txmsg <, > ;[252] Space over 39922 move t1, t2 ;[252] Restore the pair 39923 > ;repeat 0 ;[252] 39924 005573'01 104 00 0 00 000017 GNJFN ; Get the next JFN. 39925 005574'01 320 12 0 00 005576' ifje. r ;[194] Failed 39926 005575'01 254 00 0 00 005600' 39927 005576'01 200 04 0 00 000001 move t4, t1 ;[194] Save error for interested parties 39928 remark t1, ;[194] If no more, then no JFN 39929 005577'01 403 01 0 00 005572* setzb t1, ndxjfn ;[194] Nothing more to step 39930 005600'01 endif. ;[193] End GNJFN% failure handling 39931 005600'01 202 01 0 00 005567* movem t1, nxtjfn ; Save result for next time. 39932 repeat 0,< ;[252] Unnecessary now that debugging is comeplete 39933 txc t1, GJ%GND!GJ%GIV ;[252] GNJFN% clears these, which is fine 39934 call jfnflg## ;[252] Show this one 39935 move t1, nxtjfn ;[252] Restore for downstream 39936 > ;repeat 0 ;[252] 39937 005601'01 endif. ;[193] End .nulio special case 39938 39939 ; Return with current JFN 39940 39941 005601'01 200 01 0 00 005561* move t1, filjfn ; Return JFN of current file in t1. 39942 005602'01 254 00 0 00 005523* retskp ; Return +2 indicating another file was found. 39943 39944 005603'01 200 04 0 00 000001 gtnerr: move t4, t1 ;[194] Save error for debuggers 39945 39946 005604'01 336 00 0 00 005601* ifmn. filjfn ;[194] Any file? 39947 005605'01 254 00 0 00 005612' 39948 005606'01 550 01 0 00 005604* hrrz t1, filjfn ;[194] Load JFN, sans flags 39949 005607'01 260 17 0 00 003127* call frclos ;[194] Force it to close 39950 005610'01 600 00 0 00 000000 nop ;[194] Ignore any error 39951 005611'01 402 00 0 00 005606* setzm filjfn ;[194] Whack the remnants 39952 005612'01 endif. ;[194] k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 19:42 30-Mar-24 Page 74-2 K20SRV MAC 30-Mar-24 15:37 GTNFIL - Get next file from wild file specification. 39953 39954 005612'01 336 00 0 00 005600* ifmn. nxtjfn ;[194] Any 'next' JFN left? 39955 005613'01 254 00 0 00 005620' 39956 005614'01 550 01 0 00 005612* hrrz t1, nxtjfn ;[194] Yes, load JFN, sans flags 39957 005615'01 260 17 0 00 005607* call frclos ;[194] Force it to close 39958 005616'01 600 00 0 00 000000 nop ;[194] Ignore any error 39959 005617'01 402 00 0 00 005614* setzm nxtjfn ;[194] Whack the remnants 39960 005620'01 endif. ;[194] 39961 39962 005620'01 336 00 0 00 005577* ifmn. ndxjfn ;[194] Any stepping JFN? 39963 005621'01 254 00 0 00 005626' 39964 005622'01 550 01 0 00 005620* hrrz t1, ndxjfn ;[194] Yes, load the JFN, sans flags 39965 005623'01 260 17 0 00 005615* call frclos ;[194] Force it to close 39966 005624'01 600 00 0 00 000000 nop ;[194] Ignore any error 39967 005625'01 402 00 0 00 005622* setzm ndxjfn ;[194] Nothing to step any more 39968 005626'01 endif. ;[194] 39969 39970 005626'01 400 01 0 00 000000 setz t1, ;[194] No JFN anywhere, anyhow 39971 005627'01 263 17 0 00 000000 ret ;[194] Returns plus one 39972 39973 k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 19:42 30-Mar-24 Page 75 K20SRV MAC 30-Mar-24 15:37 Fetch File Information 39974 subttl Fetch File Information 39975 39976 ;[200] Begin Code Insertion 39977 ; 39978 ; Call: 39979 ; 39980 ; t2/ JFN of file to get information for 39981 ; 39982 ; Returns: 39983 ; 39984 ; +1/ Failure, the below are not dependable 39985 ; +2/ Succeed, the below contain 'reasonable' values 39986 ; 39987 ; pagcnt/ Number of pages (or blocks) in the file 39988 ; bytcnt/ Count of bytes in the file and byte size 39989 ; crdate/ Creation date and time 39990 ; 39991 ; N.B., Assumes both that the above variables are contiguous 39992 ; and that they are in the above order! 39993 ; 39994 ; To Do: See if can be coupled with isdird 39995 39996 005630'01 000700 000000 nulfdb: fld(^d7,fb%bsz) ; Pretend ASCII file with no pages 39997 005631'01 000000 000000 0 ; And no bytes 39998 39999 005632'01 filinf: extern pagcnt,crdate ; Size and date storage 40000 005632'01 265 16 0 00 006314' saveac ; Don't destroy calling context 40001 005633'01 553 04 0 00 000002 hrrzs t4, t2 ; Save and strip and flags 40002 005634'01 306 04 0 00 377777 cain t4, .nulio ; OK, is this going to be easy? 40003 005635'01 254 00 0 00 005720' jrst nulinf ; Special cased NUL: is trivial 40004 40005 005636'01 200 01 0 00 000004 move t1, t4 ; Load the JFN 40006 005637'01 104 00 0 00 000117 DVCHR% ; Get the device characteristics 40007 005640'01 320 12 0 00 005642' %jsErr (,r) 40008 005641'01 254 00 0 00 005645' 40009 005642'01 265 01 0 00 005130* 40010 005643'01 000000000000# 40011 005644'01 254 00 0 00 005473* 40012 001400'04 106 151 154 145 040 40013 40014 005645'01 135 03 0 00 006276' ldb t3,[pointr(t2,dv%typ)] ; Load the device type 40015 005646'01 306 03 0 00 000015 cain t3, .dvnul ; An unconverted NUL: device? 40016 005647'01 254 00 0 00 005720' jrst nulinf ; Odd, but handle it 40017 005650'01 302 03 0 00 000000 caie t3, .dvdsk ; Structure? 40018 005651'01 254 00 0 00 005660' ifskp. ; Of course it is 40019 005652'01 200 01 0 00 000004 move t1, t4 ; Restore the JFN 40020 dmove t2, [3,,.fbbyv ; Get size info from FDB (3 words) 40021 005653'01 120 02 0 00 006627' pagcnt] ; Put info in PAGCNT,BYTCNT,CRDATE 40022 005654'01 104 00 0 00 000063 GTFDB% ; which are adjacent in the data area. 40023 005655'01 320 16 0 00 005660' annje. ; Failed, try alternate way 40024 005656'01 254 00 0 00 005602* retskp ; Succeeded 40025 005657'01 254 00 0 00 005720' else. ; Otherwise, use older slower mechanisms 40026 005660'01 200 01 0 00 000004 move t1, t4 ; Restore the JFN 40027 005661'01 104 00 0 00 000036 SIZEF% ; Will work on any directory device 40028 005662'01 320 12 0 00 005664' %jsErr (,r) k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 19:42 30-Mar-24 Page 75-1 K20SRV MAC 30-Mar-24 15:37 Fetch File Information 40029 005663'01 254 00 0 00 005667' 40030 005664'01 265 01 0 00 005642* 40031 005665'01 000000000000# 40032 005666'01 254 00 0 00 005644* 40033 001411'04 106 151 154 145 040 40034 005667'01 250 02 0 00 000003 exch t2,t3 ; Reorder as per above 40035 005670'01 124 02 0 00 002251* dmovem t2, pagcnt ; Store as per GTFDB% 40036 005671'01 265 16 0 00 004530* anstkv (t4,<.rsfet+1>) ;Allocate an anonymous stack variable 40037 005672'01 000000 000007 40038 005673'01 415 04 0 17 777770 40039 005674'01 200 02 0 00 000004 move t2, t4 ; Point to block 40040 005675'01 201 03 0 00 000007 movx t3, <.rsfet+1> ; Length of same 40041 005676'01 104 00 0 00 000533 RFTAD% ; Try it this way 40042 005677'01 320 12 0 00 005701' %jsErr (,r) 40043 005700'01 254 00 0 00 005704' 40044 005701'01 265 01 0 00 005664* 40045 005702'01 000000000000# 40046 005703'01 254 00 0 00 005666* 40047 001423'04 106 151 154 145 040 40048 005704'01 415 16 0 00 005715' block. ; Enter block context for better control flow 40049 005705'01 261 17 0 00 000016 40050 005706'01 332 03 0 04 000001 skipe t3,.rscrv(t4) ; Can we use the obvious file creation date? 40051 005707'01 254 00 0 00 005656* retskp ; Yes, go with that 40052 005710'01 332 03 0 04 000000 skipe t3,.rswrt(t4) ; OK, maybe the last time it was written? 40053 005711'01 254 00 0 00 005707* retskp ; Good enough... 40054 005712'01 332 03 0 04 000003 skipe t3,.rscre(t4) ; No, how about this odd word? 40055 005713'01 254 00 0 00 005711* retskp ; About as good as the previous 40056 remark ; Fall through, +1 40057 005714'01 263 17 0 00 000000 endbk. ; End of block context 40058 005715'01 263 17 0 00 000000 ret ; Failed 40059 005716'01 202 03 0 00 002305* movem t3, crdate ; Store what we decided to use 40060 005717'01 254 00 0 00 005713* retskp ; Return success 40061 005720'01 endif. 40062 40063 remark ; Special case .nulio (and NUL:) 40064 40065 005720'01 120 01 0 00 005630' nulinf: dmove t1,nulfdb ; Phoney up some FDB entries 40066 005721'01 124 01 0 00 005670* dmovem t1, pagcnt ; Store like GTFDB% would 40067 005722'01 104 00 0 00 000227 GTAD% ; Get current time of day 40068 005723'01 202 01 0 00 005716* movem t1, crdate ; NUL: is always created right now 40069 005724'01 254 00 0 00 005717* retskp ; Succeed 40070 40071 ;[200] End Code Insertion 40072 k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 19:42 30-Mar-24 Page 76 K20SRV MAC 30-Mar-24 15:37 Fix up a file JFN for fast generational delete 40073 subttl Fix up a file JFN for fast generational delete 40074 40075 ;[199] Begin code insertion 40076 40077 ; The following is necessary to leverage the DELNF% JSYS, which will 40078 ; result in far faster deletion of a file with multiple generations. 40079 ; Otherwise, each and every generation must be handled seperately in a 40080 ; loop doing GTJFN%, GNJFN% and DELF%'s 40081 ; 40082 ; Call: 40083 ; 40084 ; t1/ flags,,JFN as returned by .cmfil 40085 ; 40086 ; Assumes the following are true: 40087 ; 40088 ; 1) That the NUL: device has already been special cased to .nulio 40089 ; 2) That we are not being called with resulting .nulio 40090 ; 3) That the device in question supports directories 40091 ; 40092 ; To do: Was this necessary? If doing highest generation, does a 40093 ; negative value for generations to keep work? 40094 40095 111100 000001 fjfnsf==> ; Want everything but the generation 40096 40097 005725'01 607 01 0 00 010000 ffjfgd: jxe t1, gj%ver, r ; Nothing to do if didn't wildcard the version 40098 005726'01 254 00 0 00 005703* 40099 005727'01 607 01 0 00 004000 ifxn. t1, gj%uhv ; Already doing highest generation? 40100 005730'01 254 00 0 00 005733' 40101 005731'01 621 01 0 00 010000 txz t1, gj%ver ; Don't step generations 40102 005732'01 254 00 0 00 005724* retskp ; Succeed 40103 005733'01 endif. 40104 40105 005733'01 265 16 0 00 006265' saveac ; Candidate JFN and storage for file name 40106 005734'01 200 05 0 00 000001 move q1, t1 ; Save the JFN and flags 40107 005735'01 265 16 0 00 005671* anstkv (q2,mxfilw) ; Storage to build a new name 40108 005736'01 000000 000034 40109 005737'01 415 06 0 17 777743 40110 40111 005740'01 560 01 0 00 000006 hrro t1, q2 ; Construct Tops-20 ASCII pointer to stack 40112 005741'01 550 02 0 00 000005 hrrz t2, q1 ; Load JFN, sans flags 40113 005742'01 120 03 0 00 006631' dmove t3, [exp fjfnsf,0] ;Fast delete JFNS Flags and no prefix 40114 005743'01 104 00 0 00 000030 JFNS% ; Reconstruct on the stack 40115 005744'01 320 12 0 00 005746' %jsErr (,r) 40116 005745'01 254 00 0 00 005751' 40117 005746'01 265 01 0 00 005701* 40118 005747'01 000000000000# 40119 005750'01 254 00 0 00 005726* 40120 001435'04 125 156 141 142 154 40121 005751'01 120 02 0 00 006633' dmove t2, [exp ".","0"] ; Highest generation and punctuation 40122 005752'01 136 02 0 00 000001 idpb t2, t1 ; Append the generation punctionation 40123 005753'01 136 03 0 00 000001 idpb t3, t1 ; Append the highest generation moniker 40124 005754'01 136 04 0 00 000001 idpb t4, t1 ; Tie off the string 40125 ; Load GTJFN% flag bits,,generation number. 40126 005755'01 205 01 0 00 100120 movx t1, gj%old!gj%ifg!gj%flg!fld(.rhalf,.gjdef) 40127 005756'01 560 02 0 00 000006 hrro t2, q2 ; Construct Tops-20 ASCII pointer to stack k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 19:42 30-Mar-24 Page 76-1 K20SRV MAC 30-Mar-24 15:37 Fix up a file JFN for fast generational delete 40128 005757'01 104 00 0 00 000020 GTJFN% ; Get a brand new JFN on file group 40129 005760'01 320 12 0 00 005762' %jsErr (,r) 40130 005761'01 254 00 0 00 005765' 40131 005762'01 265 01 0 00 005746* 40132 005763'01 000000000000# 40133 005764'01 254 00 0 00 005750* 40134 001445'04 125 156 141 142 154 40135 40136 005765'01 500 01 0 00 000005 hll t1, q1 ; Load just the calling flags 40137 005766'01 621 01 0 00 013000 txz t1, gj%ver!gj%nhv!gj%ulv ; Shut off wildcarded lowest and next highest 40138 005767'01 661 01 0 00 004000 txo t1, gj%uhv ; Force highest generation, always 40139 005770'01 250 01 0 00 000005 exch t1, q1 ; Swap with old flags,,JFN 40140 40141 005771'01 621 01 0 00 777777 tlz t1, -1 ; Toss its flags 40142 005772'01 104 00 0 00 000023 RLJFN% ; Toss the JFN 40143 005773'01 320 12 0 00 005775' ifje. r ; Failed?? 40144 005774'01 254 00 0 00 006001' 40145 005775'01 306 01 0 00 600152 cain t1, desx3 ; Wait, did it disappear?? 40146 005776'01 254 00 0 00 006001' anskp. ; Odd, but that's really fine 40147 005777'01 200 02 0 00 000001 move t2, t1 ; Otherwise, save the error carry on 40148 006000'01 254 00 0 00 006002' else. ; Otherwise, worked!! 40149 006001'01 400 02 0 00 000000 setz t2, ; Signal no error 40150 006002'01 endif. ; Worst case, we drag an extra JFN around 40151 40152 006002'01 200 01 0 00 000005 move t1, q1 ; Load updated flags and new JFN 40153 006003'01 254 00 0 00 005732* retskp ; Finally return success 40154 40155 ;[199] End code insertion 40156 k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 19:42 30-Mar-24 Page 77 K20SRV MAC 30-Mar-24 15:37 Routine to delete a file [118] 40157 subttl Routine to delete a file [118] 40158 40159 extern expung ; Auto expunge flag 40160 40161 ; [199] Partially adapted from EFTPST. 40162 40163 ; Call: 40164 ; 40165 ; t2/ flags,,JFN 40166 ; 40167 ; The flags are the stepping flags for a wildcarded JFN and may 40168 ; NOT be associated with the JFN in question. gj%uhv is checked 40169 ; to see if the original file specification wildcarded the 40170 ; version number. If this is the case and expunge is not on, 40171 ; then DELNF% will be used for a substantial performance increase. 40172 ; 40173 ; Returns: +1, always 40174 ; 40175 ; The JFN is not released (see below) in order to allow the driving 40176 ; loop to release it. Otherwise, in a multi-forking environment, you 40177 ; can get into the situation that the JFN is released here and another 40178 ; fork is then picked to run which issues a GTJFN%. If the same JFN 40179 ; is given, then when driver code resumes, it may wind up releasing 40180 ; somebody else's JFN!! 40181 ; 40182 ; N.B., The "remark t1, df%nrj" is used to acknowledge a documentation 40183 ; 'bug' that claims that the DELNF% JSYS will release the JFN unless 40184 ; this bit is set. No, it doesn't. 40185 ; 40186 ; DELNF% does not handle the bit: it NEVER releases JFNs because 40187 ; there is no code to do this. So, we pretend to set it even though 40188 ; DELNF% does not look at it, never has looked at it and never will 40189 ; look at it. 40190 ; 40191 ; This behavior has been consistent from TENEX days. The problem is 40192 ; a Tops-20 Monitor Calls Manual documentation defect which has 40193 ; existed since version 3A. 40194 40195 006004'01 550 01 0 00 000002 delfil: hrrz t1, t2 ;[193] Load the JFN, sans flags 40196 40197 006005'01 302 01 0 00 377777 caie t1, .nulio ;[193] Data sink? 40198 006006'01 254 00 0 00 006011' ifskp. ;[193] Yep, that's pretty easy 40199 006007'01 474 04 0 00 000000 seto t4, ;[199] Flag a phoney delete 40200 006010'01 254 00 0 00 006031' jrst delepi ;[199] And hit the epilogue 40201 006011'01 endif. ;[199] End .nulio special case 40202 40203 remark ;[199] Otherwise, deleting something for real 40204 006011'01 332 00 0 00 001256* ifme. expung ;[143] Not expunging automatically? 40205 006012'01 254 00 0 00 006025' 40206 006013'01 607 02 0 00 004000 txnn t2, gj%uhv ;[199] Yes. Doing all of them? 40207 006014'01 254 00 0 00 006025' anskp. ;[199] No, then don't whack all of them 40208 remark t1, df%nrj ;[199] No flags being used (see above) 40209 006015'01 400 02 0 00 000000 setz t2, ;[199] Don't keep ANY generations 40210 006016'01 104 00 0 00 000317 DELNF% ;[199] Chuck all of them; boom! 40211 006017'01 320 12 0 00 006067' erjmpr delerr ;[199] But didn't ... k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 19:42 30-Mar-24 Page 77-1 K20SRV MAC 30-Mar-24 15:37 Routine to delete a file [118] 40212 006020'01 553 04 0 00 000002 hrrzs t4, t2 ;[199] Remember number deleted 40213 006021'01 275 02 0 00 000001 subi t2, ^d1 ;[199] Account for assumed single file 40214 006022'01 323 02 0 00 006024' ifg. t2 ;[199] Two or more? 40215 006023'01 272 02 0 00 000000# addm t2, filcnt ;[199] Bump the file count with remainder 40216 006024'01 endif. ;[199] 40217 006024'01 254 00 0 00 006031' else. ;[199] Otherwise, just do this single file 40218 006025'01 505 01 0 00 600000 hrli t1, (df%nrj!df%exp) ;[143] Yes, set the bit 40219 006026'01 104 00 0 00 000026 DELF ; Try to delete it. 40220 006027'01 320 12 0 00 006067' erjmpr delerr ;[199] But couldn't 40221 006030'01 400 04 0 00 000000 setz t4, ;[199] Flag special singular case 40222 006031'01 endif. ;[199] End case expunge optimization 40223 remark t4, delepi ;[199] Falls through to epilogue with t4 set 40224 k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 19:42 30-Mar-24 Page 78 K20SRV MAC 30-Mar-24 15:37 Delete epilogue code comments on file operation 40225 subttl Delete epilogue code comments on file operation 40226 40227 ; Expects t4 to have a file count or a negative talisman 40228 40229 006031'01 200 01 0 00 000000# delepi: move t1, srvptr ;[199] Build confirmation message. 40230 006032'01 303 04 0 00 000001 caile t4, ^d1 ;[193] A single file or something odd 40231 006033'01 254 00 0 00 006047' ifskp. ;[193] Yes, that's easy enough 40232 006034'01 200 02 0 00 000000# move t2, delfa ;[199] Load singular file delete acknowledge 40233 006035'01 136 02 0 00 000001 idpb t2, t1 ;[199] Append first character 40234 repeat ^d4, < ;[199] And the other four 40235 lsh t2, -^d7 ;[199] Shift next character into place 40236 idpb t2, t1 ;[199] Append it 40237 > ;[199] End loop unroll 40238 006036'01 242 02 0 00 777771 40239 006037'01 136 02 0 00 000001 40240 006040'01 242 02 0 00 777771 40241 006041'01 136 02 0 00 000001 40242 006042'01 242 02 0 00 777771 40243 006043'01 136 02 0 00 000001 40244 006044'01 242 02 0 00 777771 40245 006045'01 136 02 0 00 000001 40246 40247 006046'01 254 00 0 00 006063' else. ;[199] Otherwise, DELNF% cleaned up a bunch 40248 006047'01 120 02 0 00 006635' dmove t2, [ exp ",", .chspc ] ;[199] Comma space over 40249 006050'01 136 02 0 00 000001 idpb t2, t1 ;[199] append the comma 40250 006051'01 136 03 0 00 000001 idpb t3, t1 ;[199] and the space 40251 006052'01 200 02 0 00 000004 move t2, t4 ;[199] Pick up the number done 40252 006053'01 201 03 0 00 000012 movei t3, ^d10 ;[199] Generations are base 10 40253 006054'01 104 00 0 00 000224 NOUT% ;[199] Convert and append 40254 006055'01 320 12 0 00 006057' %jsErr (,) ;[199] 40255 006056'01 254 00 0 00 006062' 40256 006057'01 265 01 0 00 005762* 40257 006060'01 000000000000# 40258 006061'01 254 00 0 00 006062' 40259 001460'04 103 157 165 154 144 40260 006062'01 260 17 0 00 006113' call apptxt ;[199] Append clarifying text 40261 006063'01 endif. ;[199] 40262 40263 006063'01 202 01 0 00 000000# movem t1, srvptr ; Update the string pointer. 40264 006064'01 400 02 0 00 000000 setz t2, ;[199] Cons up a .chnul 40265 006065'01 136 02 0 00 000001 idpb t2, t1 ;[199] Keep it ASCIZ 40266 006066'01 263 17 0 00 000000 ret ; Done 40267 k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 19:42 30-Mar-24 Page 79 K20SRV MAC 30-Mar-24 15:37 Handle some kind of delete error 40268 subttl Handle some kind of delete error 40269 40270 ; Expects to be called with an erjmpr or similar (NOT ercalr or pushj!) 40271 40272 006067'01 370 00 0 00 000000# delerr: sos filcnt ; "Uncount" this file, it wasn't deleted. 40273 006070'01 200 04 0 00 000001 move t4, t1 ;[199] Pass error back, if wanted 40274 006071'01 661 04 0 00 777777 tlo t4, -1 ;[199] And flag it was an error 40275 006072'01 200 01 0 00 000000# move t1, srvptr ;[199] Error, record the message 40276 006073'01 120 02 0 00 006637' dmove t2, [ exp ":", .chspc] ;[199] Load punctuation 40277 006074'01 136 02 0 00 000001 idpb t2, t1 ;[199] Append it 40278 006075'01 136 03 0 00 000001 idpb t3, t1 ;[199] 40279 006076'01 505 02 0 00 400000 hrli t2,.fhslf ;[199] This fork (LH) 40280 006077'01 540 02 0 00 000004 hrr t2, t4 ;[199] Load 'calling' error 40281 006100'01 400 03 0 00 000000 setz t3, ;[199] No limit (maybe bad idea?) 40282 006101'01 104 00 0 00 000011 ERSTR 40283 006102'01 320 14 0 00 006104' erjmps .+2 ;[199] Ignore strange return 40284 006103'01 320 14 0 00 006104' erjmps .+1 ;[199] Ignore stranger return 40285 006104'01 120 02 0 00 001764' dmove t2, crlfch ;[251] Load line terminators 40286 006105'01 136 02 0 00 000001 idpb t2, t1 ;[199] Tie off 40287 006106'01 136 03 0 00 000001 idpb t3, t1 ;[199] the line ... 40288 006107'01 202 01 0 00 000000# movem t1, srvptr ;[199] Update the pointer 40289 006110'01 400 02 0 00 000000 setz t2, ;[199] Cons up a .chnul 40290 006111'01 136 02 0 00 000001 idpb t2, t1 ;[199] Keep it ASCIZ 40291 006112'01 263 17 0 00 000000 ret ;[199] Done with blat 40292 k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 19:42 30-Mar-24 Page 80 K20SRV MAC 30-Mar-24 15:37 ASCII text to efficiently append in arcane ways 40293 subttl ASCII text to efficiently append in arcane ways 40294 40295 ;[199] Begin code insertion 40296 40297 chgsec(code,text) ;;Text goes in section zero text 40298 000127'03 delfa: remark " [OK] " ; delete file acknowlege 40299 000127'03 273134 766640 byte (1) 0 (7) "]", "K", "O", "[", .chspc 40300 40301 000130'03 gentxt: remark " generations" ; Inflection will always be plural 40302 000130'03 313566 271640 byte (1) 0 (7) "e", "n", "e", "g", .chspc 40303 000131'03 337517 230362 byte (1) 0 (7) "o", "i", "t", "a", "r" 40304 000132'03 000000 034756 byte (1) 0 (7) .chnul, .chnul, .chnul, "s", "n" 40305 retsec ;;Back to generating code 40306 40307 ; To do: The unrolled right justified ASCIZ ", generations" text can 40308 ; be stored with 24 instructions. At what point would the MOVSLJ 40309 ; begin to outperform this? I dislike using SOUT% to shuttle 40310 ; characters. Ditto NOUT% for numbers... 40311 40312 006113'01 apptxt: remark t1, ; Expects a valid pointer in t1 40313 006113'01 200 02 0 00 000000# move t2, gentxt ; Load first part of explanatory text 40314 006114'01 136 02 0 00 000001 idpb t2, t1 ; Append first character 40315 repeat ^d4, < ; And the other four 40316 lsh t2, -^d7 ; Shift the next character into place 40317 idpb t2, t1 ; Append it 40318 > ; End loop unroll 40319 006115'01 242 02 0 00 777771 40320 006116'01 136 02 0 00 000001 40321 006117'01 242 02 0 00 777771 40322 006120'01 136 02 0 00 000001 40323 006121'01 242 02 0 00 777771 40324 006122'01 136 02 0 00 000001 40325 006123'01 242 02 0 00 777771 40326 006124'01 136 02 0 00 000001 40327 40328 006125'01 200 02 0 00 000000# move t2, gentxt+1 ; Load next part of explanatory text 40329 006126'01 136 02 0 00 000001 idpb t2, t1 ; Append first character 40330 repeat ^d4, < ; And the other four 40331 lsh t2, -^d7 ; Shift next next character into place 40332 idpb t2, t1 ; Append it 40333 > ; End loop unroll 40334 006127'01 242 02 0 00 777771 40335 006130'01 136 02 0 00 000001 40336 006131'01 242 02 0 00 777771 40337 006132'01 136 02 0 00 000001 40338 006133'01 242 02 0 00 777771 40339 006134'01 136 02 0 00 000001 40340 006135'01 242 02 0 00 777771 40341 006136'01 136 02 0 00 000001 40342 40343 006137'01 200 02 0 00 000000# move t2, gentxt+2 ; Load final part of explanatory text 40344 006140'01 136 02 0 00 000001 idpb t2, t1 ; Append first character 40345 006141'01 242 02 0 00 777771 lsh t2, -^d7 ; Shift the final character into place 40346 006142'01 136 02 0 00 000001 idpb t2, t1 ; Append it 40347 006143'01 263 17 0 00 000000 ret ; Done k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 19:42 30-Mar-24 Page 80-1 K20SRV MAC 30-Mar-24 15:37 ASCII text to efficiently append in arcane ways 40348 40349 ;[199] End code insertion 40350 k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 19:42 30-Mar-24 Page 81 K20SRV MAC 30-Mar-24 15:37 DMPBUF - Dump the buffer [115] 40351 subttl DMPBUF - Dump the buffer [115] 40352 40353 ;[215] Begin code insertion (moved from k20mit) 40354 ; 40355 ; 40356 ; Call with SRVPTR/ current pointer (to end of string to be dumped) 40357 ; Returns +1 with t1/ new pointer. Uses t2. 40358 ; 40359 ; Dumps the buffer starting from SRVBUF thru present position, 40360 ; resets pointer SRVPTR to beginning of SRVBUF. 40361 ; 40362 ; Certain headers are hardcoded and need no termination. These are all 40363 ; up in section 1 and are referenced by one word global ASCII pointers. 40364 40365 006144'01 dmpbuf: entry dmpbuf ;[194] Also used from k20dsp 40366 006144'01 200 01 0 00 000000# move t1, srvptr ; Get current pointer. 40367 006145'01 200 03 0 00 000001 move t3, t1 ;[215] Save a copy here, just in case 40368 006146'01 200 04 0 00 000001 move t4, t1 ;[215] And another copy over here 40369 40370 006147'01 474 02 0 00 000000 seto t2, ;[215] Just in case first fetch fails 40371 006150'01 135 02 0 00 000004 ldb t2, t4 ;[215] Pick up current byte 40372 006151'01 320 12 0 00 006176' erjmpr dmpbfe ;[215] Handle an addressing error 40373 006152'01 322 02 0 00 006162' jumpe t2, dmpbf2 ;[215] Already tied off, nothing to do 40374 006153'01 474 02 0 00 000000 seto t2, ;[215] Just in case 2nd fetch fails 40375 006154'01 134 02 0 00 000004 ildb t2, t4 ;[215] No, how about the NEXT byte, then? 40376 006155'01 320 12 0 00 006176' erjmpr dmpbfe ;[215] Handle an addressing error 40377 006156'01 322 02 0 00 006162' jumpe t2, dmpbf2 ;[215] Already tied off, nothing to do 40378 40379 006157'01 403 02 0 00 000004 dmpbf1: setzb t2, t4 ;[215] Have to tie it off, then 40380 006160'01 136 04 0 00 000003 idpb t4, t3 ;[215] Make sure string is asciz. 40381 006161'01 320 12 0 00 006176' erjmpr dmpbfe ;[215] Failed?? 40382 40383 006162'01 200 01 0 00 006641' dmpbf2: move t1, [point 7, srvbuf] ; Point to buffer 40384 006163'01 202 01 0 00 000000# movem t1, srvptr ; Save new pointer. 40385 40386 006164'01 332 00 0 00 003614* ifme. srvflg ;[194] Am I not a server? 40387 006165'01 254 00 0 00 006171' 40388 006166'01 336 00 0 00 000000# skipn srvbuf ;[194] No, but is there anything to type? 40389 006167'01 254 00 0 00 006171' anskp. ;[194] No, so bum the JSYS 40390 006170'01 104 00 0 00 000076 PSOUT ; If not, print it. 40391 006171'01 endif. ;[194] 40392 40393 006171'01 402 00 0 00 000000# dmpbf3: setzm srvbuf ; Clear it. 40394 006172'01 200 01 0 00 006642' move t1, [srvbuf,,srvbuf+1] 40395 006173'01 251 01 0 00 000000# blt t1, srvbzz 40396 006174'01 200 01 0 00 000000# move t1, srvptr ; Return pointer in t1. 40397 006175'01 263 17 0 00 000000 ret 40398 40399 ; Here on some addressing error. If t2 is negative, then we failed 40400 ; on the read. If it is zero, then we failed on the write. 40401 40402 006176'01 dmpbfe: remark ;[215] Here if an addressing error 40403 006176'01 305 02 0 00 000000 caige t2, 0 ;[215] Failed the read? 40404 006177'01 334 00 0 00 000000 %ermsg (,dmpbe3) ;[215] 40405 006200'01 254 00 0 00 006204' k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 19:42 30-Mar-24 Page 81-1 K20SRV MAC 30-Mar-24 15:37 DMPBUF - Dump the buffer [115] 40406 006201'01 265 01 0 00 006057* 40407 006202'01 000000000000# 40408 006203'01 254 00 0 00 006251' 40409 001471'04 144 155 160 142 165 40410 40411 006204'01 200 04 0 00 000001 move t4, t1 ;[215] Get error number out of the way 40412 006205'01 302 04 0 00 601775 caie t4, ILLX02 ;[215] Write-protected page, then? 40413 006206'01 334 00 0 00 000000 %ermsg (,dmpbe3) ;[215] 40414 006207'01 254 00 0 00 006213' 40415 006210'01 265 01 0 00 006201* 40416 006211'01 000000000000# 40417 006212'01 254 00 0 00 006251' 40418 001504'04 144 155 160 142 165 40419 006213'01 554 01 0 00 000003 hlrz t1, t3 ;[215] Pick up the pointer position portion 40420 006214'01 200 02 0 00 000001 move t2, t1 ;[215] Make a copy so can examine both parts 40421 006215'01 405 01 0 00 770000 andi t1, 770000 ;[215] Shut off the section 40422 006216'01 405 02 0 00 007777 andi t2, 007777 ;[215] Keep just the section 40423 ;[215] First check just the pointer 40424 remark ;[215] There will be only six possible positions 40425 006217'01 306 01 0 00 610000 cain t1, (.p0736) ;[215] Starting position? 40426 006220'01 254 00 0 00 006240' jrst dmpbe1 ;[215] Yep, OK 40427 006221'01 306 01 0 00 620000 cain t1, (.p0706) ;[215] First byte? 40428 006222'01 254 00 0 00 006240' jrst dmpbe1 ;[215] Yep, OK 40429 006223'01 306 01 0 00 630000 cain t1, (.p0713) ;[215] Second byte? 40430 006224'01 254 00 0 00 006240' jrst dmpbe1 ;[215] Yep, OK 40431 006225'01 306 01 0 00 640000 cain t1, (.p0720) ;[215] Third byte? 40432 006226'01 254 00 0 00 006240' jrst dmpbe1 ;[215] Yep, OK 40433 006227'01 306 01 0 00 650000 cain t1, (.p0727) ;[215] Fourth byte? 40434 006230'01 254 00 0 00 006240' jrst dmpbe1 ;[215] Yep, OK 40435 006231'01 306 01 0 00 660000 cain t1, (.p0734) ;[215] Fifth byte? 40436 006232'01 254 00 0 00 006240' jrst dmpbe1 ;[215] Yep, OK 40437 40438 006233'01 334 00 0 00 000000 %ermsg (,dmpbe3) ;[215] 40439 006234'01 254 00 0 00 006240' 40440 006235'01 265 01 0 00 006210* 40441 006236'01 000000000000# 40442 006237'01 254 00 0 00 006251' 40443 001516'04 144 155 160 142 165 40444 40445 006240'01 dmpbe1: remark ;[215] Here if thought to be a valid OWG ASCII ptr 40446 006240'01 302 02 0 00 000001 caie t2, extsec ;[215] In extended text psect? 40447 006241'01 334 00 0 00 000000 %ermsg (,dmpbe3) ;[215] 40448 006242'01 254 00 0 00 006246' 40449 006243'01 265 01 0 00 006235* 40450 006244'01 000000000000# 40451 006245'01 254 00 0 00 006251' 40452 001527'04 144 155 160 142 165 40453 40454 006246'01 dmpbe2: remark ;[215] Terminated string or a write error we can handle 40455 006246'01 200 01 0 00 000003 move t1, t3 ;[215] Reload original pointer 40456 006247'01 133 00 0 00 000001 ibp t1 ;[215] Pretend the idpb worked 40457 006250'01 254 00 0 00 006162' jrst dmpbf2 ;[215] Carry on 40458 40459 006251'01 dmpbe3: remark ;[215] Here on error recovery failure 40460 006251'01 200 01 0 00 006643' move t1, [point 7, srvbuf] ;[215] Just reset k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 19:42 30-Mar-24 Page 81-2 K20SRV MAC 30-Mar-24 15:37 DMPBUF - Dump the buffer [115] 40461 006252'01 202 01 0 00 000000# movem t1, srvptr ;[215] the bufer pointer 40462 006253'01 254 00 0 00 006171' jrst dmpbf3 ;[215] And stomp the buffer 40463 40464 40465 ;[215] End code insertion 40466 40467 k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 19:42 30-Mar-24 Page 82 K20SRV MAC 30-Mar-24 15:37 Close out Code 40468 subttl Close out Code 40469 40470 xlist ; Shut off the listing 40471 list ; Turn the listing back on 40472 40473 .endps code 40474 k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 19:42 30-Mar-24 Page 83 K20SRV MAC 30-Mar-24 15:37 Impure data area 40475 subttl Impure data area 40476 40477 .psect data 40478 40479 000000'05 cdhack: block 1 ;[255] Used to transmogrify ".." into CDUP 40480 000001'05 tmpjfn: block 1 ;[233] Used for directory/name logging 40481 000002'05 dirbuf: block fdrmxw ;[220] Maximum size foreign directory 40482 000143'05 pasbuf: block fpwmxw ;[220] Maximum size foreign password 40483 000304'05 44 07 0 00 000000* filptr: point 7, filbuf ; Pointer to file buffer text 40484 40485 000305'05 000000 000000 filcnt: 0 ;[194] ; File counter for directory listings. 40486 000306'05 000000 000000 dirfin: 0 ;[194] ; Flag for directory listing finished. 40487 40488 000307'05 000000 000000 gclen: 0 ; Generic command data field length. 40489 000310'05 000000 000000 rufork: 0 ; Fork number for LOCAL RUN program fork. 40490 40491 ;[220] These all get the "x" overwritten 40492 40493 ;To do, they get the X overwritten sometimes... 40494 40495 000311'05 042 170 042 040 055 xxbmsg: asciz/"x" - Not valid as server command/ ; Another. 40496 000041 xxblen==^d33 ;[220] ; Number of characters in xxbmsg. 40497 000320'05 042 170 042 040 055 xxgnms: asciz/"x" - Unimplemented generic command/ 40498 000043 xxgnln==^d35 ;[220] 40499 000330'05 042 170 042 040 055 xxgums: asciz/"x" - Undefined generic command/ 40500 000037 xxguln==^d31 ;[220] 40501 000337'05 042 170 042 040 055 xxumsg: asciz/"x" - Unknown server command/ ; Server message (fill in the x) 40502 000034 xxulen==^d28 ;[220] ; Number of characters in xxumsg. 40503 40504 remark Buffer space 40505 40506 000345'05 000000 000000 getptr: 0 ;[220] ; Pointer for emptying... 40507 000346'05 000000 000000 srvptr: 0 ;[194] ; And pointer for filling... 40508 000347'05 srvbuf: xlist ;[194] ;[187] Save the trees!! 40509 list ;[187] 40510 40511 001347'05 srvbz: xlist ;[194] ;[187] 40512 list ;[187] 40513 001447'05 000000 000000 srvbzz: 0 ;[220] ;[215] Where the padding ends. 40514 001450'05 cwdbuf: block dirmxw ;[249] ; Area to construct a directory in 40515 .endps data 40516 40517 end NO ERRORS DETECTED PROGRAM BREAK IS 000000 PSECT 1 BREAK IS 006644 FOR CODE PSECT 2 BREAK IS 000615 FOR CONST PSECT 3 BREAK IS 000133 FOR TEXT PSECT 4 BREAK IS 001542 FOR ETEXT PSECT 5 BREAK IS 001462 FOR DATA CPU TIME USED 00:01.904 135P CORE USED k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 19:42 30-Mar-24 Page S-1 K20SRV MAC 30-Mar-24 15:37 SYMBOL TABLE AC%CON 400000 000000 sin DIRMXW 000012 spd GNJFN 104000 000017 int NSITC 000000 ext ACCES 104000 000552 int DIRST 104000 000041 int GOTS 000000 ext NTIMOU 000000 ext ACCES% 104000 000552 int DIRST% 104000 000041 int GOTX 000000 ext NUMTRY 000000 ext ALLFLD 000000 ext DISMS% 104000 000167 int GTAD% 104000 000227 int NXTJFN 000000 ext ATMBLN 000000 ext DOBE 104000 000104 int GTDAL% 104000 000305 int ODELAY 000000 ext ATMBUF 000000 ext DV%AV 010000 000000 sin GTFDB 104000 000063 int ODTIM% 104000 000220 int BADMSK 113777 176377 spd DV%DIR 100000 000000 sin GTFDB% 104000 000063 int OF%BSZ 770000 000000 sin BCTONE 000000 ext DV%IN 200000 000000 sin GTJFN 104000 000020 int OF%RD 200000 sin BOUT 104000 000051 int DV%MDD 020000 000000 sin GTJFN% 104000 000020 int OPENF 104000 000021 int BYTCNT 000000 ext DV%MOD 177777 sin HALTF% 104000 000170 int OT%4YR 010000 000000 sin CALL 260740 000000 DV%OUT 400000 000000 sin IFLG 000000 ext OTIMOU 000000 ext CALLRE 254000 000000 spd DV%PSD 400000 sin ILLX02 601775 int P 000017 CAPAS 000000 ext DV%TYP 000777 000000 sin INILIN 000000 ext P1 000011 spd CARIER 000000 ext DVCHR% 104000 000117 int ISNULJ 000000 ext P2 000012 spd CAXZOF 000000 ext ELPTIM 000000 ext JFNS 104000 000030 int P3 000013 spd CCOFF 000000 ext ENDTIM 000000 ext JFNS% 104000 000030 int P4 000014 spd CCON 000000 ext EPCAP 104000 000151 int JOBTAB 000000 ext P5 000015 spd CFIELD 000000 ext ERJMP 320700 000000 int JS%DEV 700000 000000 sin PAGCNT 000000 ext CFMRTN 000000 ext ERJMPR 320500 000000 int JS%DIR 070000 000000 sin PARS1 000000 ext CFORK 104000 000152 int ERJMPS 320600 000000 int JS%GEN 000070 000000 sin PARS2 000000 ext CHKAC% 104000 000521 int ERRPTR 000000 ext JS%NAM 007000 000000 sin PARS3 000000 ext CJFNBK 000000 ext ERSTR 104000 000011 int JS%PAF 000001 sin PARS4 000000 ext CLOSF 104000 000022 int ERSTR% 104000 000011 int JS%SPC 111110 000001 sin PARS5 000000 ext CLRBUF 000000 ext ESOUT% 104000 000313 int JS%TMP 040000 sin PARS6 000000 ext CLRCNO 000000 ext ETEXT 000000 ext JS%TYP 000700 000000 sin PBOUT 104000 000074 int CLREAD 000000 ext EXPUNG 000000 ext KFORK 104000 000153 int PBOUT% 104000 000074 int CLZFF 104000 000034 int EXTSEC 000001 spd LGOUT% 104000 000003 int PKTACS 000000 ext CLZFF% 104000 000034 int F 000000 spd LOCAL 000000 ext PKTNUM 000000 ext CM%ABR 000004 sin F$EXIT 000000 ext LOGJFN 000000 ext PSOUT 104000 000076 int CM%FNC 777000 000000 sin FB%BSZ 007700 000000 sin LSTRX1 601405 int PSOUT% 104000 000076 int CM%FW 002000 000000 sin FDRMXW 000141 spd MAXDAT 000000 ext PTYFLG 000000 ext CM%HPP 000004 000000 sin FILBFZ 000000 ext MAXTRY 000000 ext PTYTTY 000000 ext CM%INV 000001 sin FILBUF 000000 ext MDMLIN 000000 ext PUTBUF 000000 ext CM%SDH 000001 000000 sin FILJFN 000000 ext MOVASC 000000 ext Q1 000005 spd CMDER1 000000 ext FPWMXW 000141 spd MOVSLJ 016000 000000 Q2 000006 spd CODE 000000 ext FRCLOS 000000 ext MXASCZ 000000 ext Q3 000007 spd COMNX1 601257 int GET 104000 000200 int MXFILW 000034 spd Q4 000010 spd CONST 000000 ext GETBUF 000000 ext MXPWLC 000047 spd Q5 000011 spd CRDATE 000000 ext GETER% 104000 000012 int MXPWLW 000010 spd R 000000 ext CRLF 000000 ext GJ%DEV 400000 000000 sin MYCAPS 000000 ext RC%AMB 020000 000000 sin CX 000016 GJ%DIR 100000 000000 sin NAK 000000 ext RC%EMO 000001 000000 sin CZ%NCL 040000 000000 sin GJ%FLG 000020 000000 sin NDXJFN 000000 ext RC%NMD 010000 000000 sin CZSEEN 000000 ext GJ%IFG 000100 000000 sin NETJFN 000000 ext RC%NOM 040000 000000 sin DATA 000000 ext GJ%NHV 002000 000000 sin NEXT 000000 ext RCDIR% 104000 000553 int DATBUF 000000 ext GJ%OLD 100000 000000 sin NNAK 000000 ext RCDIX3 601400 int DECODF 000000 ext GJ%SHT 000001 000000 sin NO%AST 010000 000000 sin RD%BEL 040000 000000 sin DELAY 000000 ext GJ%UHV 004000 000000 sin NO%COL 000177 000000 sin RD%BTM 000040 000000 sin DELF 104000 000026 int GJ%ULV 001000 000000 sin NO%LFL 100000 000000 sin RD%CRF 020000 000000 sin DELNF% 104000 000317 int GJ%UNT 200000 000000 sin NO%RDX 777777 sin RD%SUI 000100 000000 sin DEST 000000 ext GJ%VER 010000 000000 sin NOIRTN 000000 ext RDTTY 104000 000523 int DESX3 600152 int GJFX32 600114 int NOP 600000 000000 sin RESET% 104000 000147 int DEVST% 104000 000121 int GJINF 104000 000013 int NOUT 104000 000224 int RET 263740 000000 DF%EXP 200000 000000 sin GJINF% 104000 000013 int NOUT% 104000 000224 int RFIELD 000000 ext DF%NRJ 400000 000000 sin GN%DIR 000010 000000 sin NSICI 000000 ext RFMOD 104000 000107 int DIBE% 104000 000212 int GN%STR 000020 000000 sin NSIMX 000000 ext RFTAD% 104000 000533 int k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 19:42 30-Mar-24 Page S-2 K20SRV MAC 30-Mar-24 15:37 SYMBOL TABLE RLJFN 104000 000023 int TTYNUM 000000 ext .P0713 630000 000000 sin RLJFN% 104000 000023 int TYPFIL 000000 ext .P0720 640000 000000 sin RPACK 000000 ext TYPNAM 000000 ext .P0727 650000 000000 sin RPAR 000000 ext VCHRCN 000000 ext .P0734 660000 000000 sin RPSIZ 000000 ext WFORK 104000 000163 int .P0736 610000 000000 sin RPTOT 000000 ext WHAKFP 000000 ext .PRIIN 000100 sin RRINIT 000000 ext XFLG 000000 ext .PRIOU 000101 sin RRSL2 000000 ext XJRSTF 254240 000000 int .PX7 610001 000000 spd RRSLIN 000000 ext XMOVEI 415000 000000 int .RHALF 777777 sin RSKP 000000 ext XSFM 254600 000000 int .RSCRE 000003 sin S 400000 000000 spd $RECVB 000000 ext .RSCRV 000001 sin SC%GTB 200000 000000 sin $RECVS 000000 ext .RSFET 000006 sin SC%LOG 040000 000000 sin $SENDS 000000 ext .RSWRT 000000 sin SCRLFT 000000 ext %%JSER 000000 ext .SAC 000016 SCVEC% 104000 000301 int %%KRMS 000000 ext .XSTKS 000000 ext SEOLCH 000000 ext %%SMSG 000000 ext SETER% 104000 000336 int %KERMS 000000 ext SETLOG 000000 ext %WTLOG 000000 ext SEVEC% 104000 000204 int .A16 000016 spd SFACS% 104000 000160 int .ACDIR 000000 sin SFMOD 104000 000110 int .ACJOB 000002 sin SFMOD% 104000 000110 int .ACPSW 000001 sin SFRKV 104000 000201 int .CHCRT 000015 sin SIN 104000 000052 int .CHLFD 000012 sin SINIT 000000 ext .CHNUL 000000 sin SIZEF% 104000 000036 int .CHRPT 000076 spd SOURCE 000000 ext .CHSPC 000040 sin SOUT% 104000 000053 int .CKAAC 000000 sin SPACK 000000 ext .CKACD 000002 sin SPAR 000000 ext .CKACN 000010 sin SPEED 000000 ext .CKAPR 000005 sin SPSIZ 000000 ext .CKAUD 000004 sin SPTOT 000000 ext .CMCFM 000010 sin SRVFLG 000000 ext .CMDEV 000016 sin SRVTIM 000000 ext .CMDIR 000011 sin STATE 000011 spd .CMFIL 000006 sin STATIM 000000 ext .CMFNP 000000 sin STDEV% 104000 000120 int .CMQST 000021 sin STIMOU 000000 ext .CMTOK 000023 sin STRBUF 000000 ext .CMTXT 000017 sin STRBZ 000000 ext .DVDES 600000 sin STRPTR 000000 ext .DVDSK 000000 sin SUBBP 000000 ext .DVDTA 000003 sin T1 000001 spd .DVNUL 000015 sin T2 000002 spd .FBBYV 000011 sin T3 000003 spd .FHSLF 400000 sin T4 000004 spd .GJALL 777775 sin TEXT 000000 ext .GJDEF 000000 sin TIMEIT 000000 ext .JIDNO 000003 sin TIMOFF 000000 ext .JILNO 000017 sin TLGJFN 000000 ext .JITNO 000001 sin TT%ECO 004000 sin .JIUNO 000002 sin TT%OSP 400000 000000 sin .JSAOF 000001 sin TTXON 000000 ext .NULIO 377777 sin TTYJFN 000000 ext .P0706 620000 000000 sin k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 19:42 30-Mar-24 Page S-3 K20SRV MAC 30-Mar-24 15:37 SYMBOL TABLE FOR PSECT CODE ACABL 000003 spd EXPUNG 006011' ext NUMTRY 005332' ext STATIM 005150' ext ALLFLD 005545' ext F$EXIT 003622' ext NXTJFN 005617' ext STATXT 006565' ext APPTXT 006113' FFJFGD 005725' ODELAY 003610' ext STIMOU 003613' ext ATMBLN 000000 ext FFUNC 004722' ext OTIMOU 003612' ext STRBUF 006524' ext ATMBUF 006523' ext FILBFZ 000000 ext PAGCNT 005721' ext STRBZ 003731' ext BADEVC 001322' FILBUF 006463' ext PARS1 000077' ext STRPTR 005160' ext BCTONE 005334' ext FILINF 005632' PARS3 005105' ext SUBBP 004373' ext BIGSOU 003662' ext FILIST 002235' PARS4 004770' ext SYSNAM 003212' ext BYTCNT 002256' ext FILJFN 005611' ext PARS5 001641' ext TAKDEP 005134' ext CAPAS 005037' ext FJFNSF 111100 000001 spd PKTACS 005324' ext TAKJFN 000334' ext CARIER 003235' ext FRCLOS 005623' ext PKTNUM 005333' ext TIMEIT 003567' ext CAXZOF 005270' ext GETARG 003725' PTYFLG 003572' ext TIMOFF 003606' ext CCOFF 005325' ext GETBUF 005163' ext PTYTTY 003574' ext TLGJFN 004703' ext CCON 005151' ext GETCM2 003222' PUTBUF 005321' ext TTXON 006552' ext CFIELD 002456' ext GETCMM 003217' PUTSCH 003713' ent TTYJFN 003571' ext CFMRTN 004763' ext GETCOM 003157' ent PUTTCH 003715' ent TTYNUM 003167' ext CJFNBK 006574' ext GETPAS 000312' PWCONP 000653' TYPFIL 003106' ext CLENUP 003621' ext GOTS 005464' ext R 005764' ext TYPNAM 003055' ext CLRBUF 005335' ext GOTX 005416' ext RFIELD 004746' ext UDJINF 000305' ent CLRCNO 003050' ext GTNERR 005603' RPACK 005214' ext VCHRCN 000021' ext CLREAD 000014' ext GTNFIL 005525' ent RPAR 003676' ext WHAKFP 003123' ext CMDER1 005014' ext GTSCH 003704' ent RPTOT 003241' ext XFLG 004731' ext CRDATE 005723' ext GTSCHX 003706' RRINIT 003367' ext XGCDUP 004267' CRLF 006443' ext GTSCHZ 003710' RRSL2 005327' ext XGCWD 003757' CRLFCH 001764' HLPNTR 000000 ext RRSLIN 003607' ext XGCWD2 003770' CWDEVE 000635' IFLG 005360' ext RSKP 006003' ext XGCWD3 004021' CZSEEN 005536' ext INILIN 005141' ext SCRLFT 004711' ext XGCWD4 004121' DATBUF 006556' ext ISDIRD 005474' ent SCRUBP 000500' XGCWD5 004133' DECODF 003376' ext ISNULJ 005474' ext SDELBK 004644' XGCWDZ 004146' DEFDIR 000174' JOBTAB 000000 ext SDIRB2 004513' XGDEL 004656' DELAY 003611' ext LOCAL 005326' ext SDIRBK 004632' XGDEL2 004666' DELEPI 006031' MAXDAT 005162' ext SEOLCH 002477' ext XGDIR 004525' DELERR 006067' MAXTRY 005176' ext SETLOG 005337' ext XGDIR2 004550' DELFIL 006004' MDMLIN 003234' ext SINFO 005331' ent XGDIS2 004232' DEST 005323' ext MOVASC 002146' ext SINFO2 005342' XGDISK 004175' DIRCH 004474' ent MOVCHR 002216' int SINFOX 005356' XGDISZ 004261' DIRCH2 004477' MXASCZ 000000 ext SINFOZ 005360' XGEN 003436' DIRCHX 004506' MYCAPS 000000 ext SINIT 005344' ext XGFIN 003520' DIRCHZ 004510' NAK 003271' ext SOURCE 005304' ext XGFIN2 003546' DIRHDR 001766' NDXJFN 005625' ext SPACK 005211' ext XGHEL1 004463' DIRLST 002033' NETJFN 003570' ext SPAR 005350' ext XGHELP 004447' DIRLSZ 002165' NEXT 005161' ext SPEED 003173' ext XGLOG1 003607' DMPBE1 006240' NNAK 005143' ext SPSIZ 004404' ext XGLOGO 003562' DMPBE2 006246' NOIRTN 004740' ext SPTOT 003240' ext XGNYI 003515' DMPBE3 006251' NSICI 000017' ext SRVCM2 005175' XGPWD 004353' DMPBF1 006157' NSIMX 000024' ext SRVCMA 005156' XGSTAT 004426' DMPBF2 006162' NSITC 000022' ext SRVCMD 005134' XGTYPE 003632' DMPBF3 006171' NTIMOU 005144' ext SRVCMX 005267' XGUNDF 003512' DMPBFE 006176' NUL4 001762' int SRVCMZ 005307' XHLPTR 000000000000# pol DMPBUF 006144' ent NULDEV 001761' SRVFI3 005377' XHOST 003430' DOSRV 005406' ent NULDIR 002206' SRVFIL 005362' XINFO 003672' DOSRV3 005462' NULFDB 005630' SRVFLG 006164' ext XRECV 003374' ELPTIM 005272' ext NULFIL 002214' SRVHLP 000000 ext XRECV2 003406' ENDTIM 005271' ext NULINF 005720' SRVTIM 003246' ext XSEND 003356' ERRPTR 005471' ext NULIST 002220' SRVXX 005136' XXCMD 003305' k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 19:42 30-Mar-24 Page S-4 K20SRV MAC 30-Mar-24 15:37 SYMBOL TABLE FOR PSECT CODE XXGCMD 003457' ..0165 000137' spd ..0700 001643' spd ..1303 002676' spd XXINV 003343' ..0166 000141' spd ..0710 001661' spd ..1304 002701' spd XXMSG 003345' ..0173 000156' spd ..0711 001664' spd ..1305 002715' spd XXUNK 003340' ..0201 000166' spd ..0712 001666' spd ..1312 002711' spd XXWAIT 003234' ..0216 000240' spd ..0717 001701' spd ..1313 002714' spd YDIRER 001647' ..0217 000252' spd ..0727 001716' spd ..1314 002715' spd $BYE 000004' ent ..0220 000251' spd ..0730 001752' spd ..1321 002726' spd $BYEZ 000050' ..0236 000253' spd ..0735 001726' spd ..1322 002770' spd $FINIS 002422' ent ..0237 000260' spd ..0736 001731' spd ..1327 002733' spd $RECVB 005466' ext ..0243 000303' spd ..0737 001735' spd ..1330 002734' spd $RECVS 003371' ext ..0253 000320' spd ..0747 001755' spd ..1340 002753' spd $SENDS 004732' ext ..0264 000327' spd ..0750 001760' spd ..1341 002755' spd $SRVT 004441' ext ..0272 000362' spd ..0751 002027' spd ..1347 002762' spd $XCDUP 001227' ..0315 000413' spd ..0756 002030' spd ..1357 003007' spd $XCWD 001015' ..0316 000435' spd ..0763 002005' spd ..1360 003043' spd $XDELE 001332' ..0326 000452' spd ..0764 002026' spd ..1365 003016' spd $XDIRE 002313' ..0332 000476' spd ..0770 002026' spd ..1366 003043' spd $XDISK 002614' ..0347 000510' spd ..1002 002061' spd ..1373 003032' spd $XERR 002352' ..0360 000537' spd ..1003 002066' spd ..1374 003035' spd $XHELP 002434' ..0362 000561' spd ..1004 002133' spd ..1405 003045' spd $XHOST 002460' ..0377 000622' spd ..1016 002100' spd ..1406 003122' spd $XPWD 002537' ..0400 000625' spd ..1017 002133' spd ..1413 003064' spd $XSTAT 002634' ..0413 000673' spd ..1020 002133' spd ..1414 003106' spd $XTYPE 003131' ..0414 000676' spd ..1027 002126' spd ..1421 003071' spd $YCDUP 001111' ent ..0415 000677' spd ..1034 002133' spd ..1422 003074' spd $YCWD 000520' ent ..0424 000721' spd ..1037 002152' spd ..1432 003130' spd $YCWDX 000570' ..0426 000734' spd ..1044 002156' spd ..1440 003154' spd $YCWDY 000575' ..0434 000763' spd ..1052 002164' spd ..1447 003154' spd $YCWDZ 000605' ..0442 001012' spd ..1060 002201' spd ..1452 003207' spd $YDELE 001251' ent ..0454 001036' spd ..1061 002203' spd ..1466 003206' spd $YDIR1 001752' ..0455 001037' spd ..1074 002246' spd ..1507 003250' spd $YDIRE 001710' ent ..0463 001037' spd ..1075 002251' spd ..1510 003274' spd $YDISK 002546' ent ..0464 001043' spd ..1076 002274' spd ..1515 003270' spd $YPWD 002516' ent ..0465 001063' spd ..1103 002277' spd ..1516 003274' spd $YRUN 005015' ent ..0500 001054' spd ..1110 002303' spd ..1534 003423' spd $YRUN2 005110' ..0501 001060' spd ..1111 002305' spd ..1544 003542' spd $YSRVT 002623' ent ..0510 001105' spd ..1116 002312' spd ..1551 003544' spd $YTYPE 002773' ent ..0524 001127' spd ..1120 002336' spd ..1557 003604' spd $YTYPY 003122' ..0525 001136' spd ..1127 002336' spd ..1564 003606' spd $YTYPZ 003125' ..0526 001150' spd ..1136 002365' spd ..1575 003670' spd %%JSER 006243' ext ..0540 001177' spd ..1137 002373' spd ..1604 003670' spd %%KRMS 004676' ext ..0567 001250' spd ..1145 002402' spd ..1613 003667' spd %%SMSG 004231' ext ..0575 001266' spd ..1146 002406' spd ..1620 003742' spd %KERMS 004662' ext ..0576 001322' spd ..1153 002446' spd ..1621 003751' spd %WTLOG 004712' ext ..0577 001264' spd ..1162 002446' spd ..1631 004017' spd ..0107 000014' spd ..0611 001276' spd ..1167 002471' spd ..1636 004021' spd ..0110 000040' spd ..0612 001301' spd ..1175 002471' spd ..1644 004027' spd ..0111 000034' spd ..0613 001305' spd ..1213 002473' spd ..1645 004064' spd ..0132 000070' spd ..0620 001355' spd ..1214 002477' spd ..1650 004060' spd ..0140 000101' spd ..0627 001355' spd ..1237 002567' spd ..1656 004043' spd ..0146 000114' spd ..0642 001456' spd ..1240 002574' spd ..1657 004047' spd ..0147 000147' spd ..0650 001474' spd ..1255 002646' spd ..1664 004062' spd ..0154 000125' spd ..0656 001474' spd ..1264 002646' spd ..1665 004064' spd ..0155 000144' spd ..0664 001552' spd ..1275 002716' spd ..1666 004070' spd ..0164 000135' spd ..0672 001627' spd ..1276 002717' spd ..1730 004217' spd k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 19:42 30-Mar-24 Page S-5 K20SRV MAC 30-Mar-24 15:37 SYMBOL TABLE FOR PSECT CODE ..1731 004222' spd ..2461 006031' spd ..1761 004311' spd ..2462 006024' spd ..1762 004320' spd ..2474 006047' spd ..1763 004337' spd ..2475 006063' spd ..2010 004441' spd ..2501 006171' spd ..2017 004441' spd ..IFT 004000 000001 spd ..2022 004462' spd ..JX1 004000 000000 spd ..2031 004462' spd ..MX1 100120 000000 spd ..2034 004542' spd ..MX2 000001 spd ..2051 004561' spd ..TX1 004000 000000 spd ..2052 004577' spd ..TX2 000001 spd ..2062 004616' spd .BYE 000000' ent ..2071 004616' spd .FINIS 002416' ent ..2104 004720' spd .RMFIL 001325' ..2113 004720' spd .STAT 002617' ent ..2125 004754' spd .XCDUP 001223' ..2133 004772' spd .XCWD 000701' ..2157 005077' spd .XCWD1 000773' ..2160 005110' spd .XDISK 002610' ..2220 005241' spd .XERR 002341' ..2230 005302' spd .XHELP 002430' ..2236 005324' spd .XHOST 002453' ..2244 005352' spd .XPWD 002533' ..2253 005373' spd .XSTAT 002630' ..2254 005377' spd .XSTKS 005735' ext ..2256 005461' spd .YCDP1 001066' ..2263 005436' spd .YCDUP 001065' ent ..2264 005441' spd .YCWD 000052' ent ..2271 005455' spd .YDELE 001232' ent ..2272 005460' spd .YDIRE 001360' ent ..2277 005467' spd .YDISK 002542' ent ..2310 005500' spd .YPWD 002512' ent ..2316 005504' spd .YRUN 004735' ent ..2317 005510' spd .YTYPE 002651' ent ..2320 005511' spd ..2321 005524' spd ..2333 005534' spd ..2341 005555' spd ..2342 005561' spd ..2347 005572' spd ..2350 005601' spd ..2355 005576' spd ..2356 005600' spd ..2360 005612' spd ..2366 005620' spd ..2374 005626' spd ..2411 005660' spd ..2412 005720' spd ..2422 005715' spd ..2423 005733' spd ..2443 005775' spd ..2444 006001' spd ..2445 006002' spd ..2452 006011' spd ..2454 006025' spd k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 19:42 30-Mar-24 Page S-6 K20SRV MAC 30-Mar-24 15:37 SYMBOL TABLE FOR PSECT CONST DELBK 000141' DELBKL 000010 spd DIRBK 000164' DIRBKL 000010 spd LOCTAB 000000' int NULEND 000014 NULENT 000003 NULMSG 000016 NULPRG 000342' REMTAB 000020' int RMFFDB 000155' RUNBK 000320' RUNBKL 000010 spd TYPBK 000261' TYPBKL 000010 spd TYPFDB 000271' WLDFIL 000174' WLDMAX 000013 spd XCWFDB 000103' XERFDB 000224' XHOFDB 000237' XPWFDB 000114' YCUFDB 000126' YCWFDB 000044' YDEFDB 000151' YDIFDB 000176' YPWFDB 000060' YRRFDB 000332' YRUFDB 000330' ..XX 010004 000000 spd k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 19:42 30-Mar-24 Page S-7 K20SRV MAC 30-Mar-24 15:37 SYMBOL TABLE FOR PSECT TEXT DELFA 000127' GENTXT 000130' PWDPRM 000124' k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 19:42 30-Mar-24 Page S-8 K20SRV MAC 30-Mar-24 15:37 SYMBOL TABLE FOR PSECT DATA CDHACK 000000' CWDBUF 001450' DIRBUF 000002' DIRFIN 000306' FILBUF 000304' ext FILCNT 000305' FILPTR 000304' GCLEN 000307' GETPTR 000345' PASBUF 000143' RUFORK 000310' SRVBUF 000347' SRVBZ 001347' SRVBZZ 001447' SRVPTR 000346' TMPJFN 000001' XXBLEN 000041 spd XXBMSG 000311' XXGNLN 000043 spd XXGNMS 000320' XXGULN 000037 spd XXGUMS 000330' XXULEN 000034 spd XXUMSG 000337' k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 1 K20SUB MAC 19-Jan-24 16:52 Preliminaries 40518 title k20sub - Kermit-20 Semantic Action and Support Subroutines 40519 remark Moved to seperate module as part of 194 to address MCRNEC 40520 40521 subttl Preliminaries 40522 40523 search monsym,macsym,k20unv 40524 cmdacs ^ ;Clean up p1-p4 definitions 40525 .xcmsy ^ ;Ditch MACSYM nonsense 40526 40527 sall ; Tidy listing 40528 .directive flblst ; We don't need to see all the ASCIZ bytes... 40529 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 2 K20SUB MAC 19-Jan-24 16:52 common parsing external data 40530 subttl common parsing external data 40531 40532 extern pars1 ; Data from first parse. 40533 extern pars2 ; Data from second parse. 40534 extern pars3 ; Data from third parse. 40535 extern pars4 ; Data from fourth parse. 40536 extern pars5 ;[41] ... 40537 40538 remark cmd storage 40539 40540 extern cjfnbk ; Actually in CMD.MAC 40541 extern atmbuf ; Atom buffer, in CMD.MAC 40542 extern sbk ; State Block 40543 40544 remark file related storage 40545 40546 extern filjfn ; Current file 40547 extern nxtjfn ; Next file in sequence 40548 extern ndxjfn ; Stepping JFN (with flags) 40549 extern strbuf ; String buffer (to build things in, Etc.) 40550 40551 remark Terminal and other JFN's 40552 40553 extern ttyjfn ; JFN on local terminal 40554 extern $PRIOU ;[220] Whatever we think primary output should be 40555 extern udjinf ;[220] Updates jobtab for use by this routine 40556 extern tlgjfn ; Transaction log JFN 40557 40558 remark other stuff 40559 40560 extern czseen ; ^Z seen (typed) 40561 extern crlf ; Carriage Return, Linefeed string 40562 extern nul4 ; Pointer to NUL: string and length 40563 extern allfld ;[252] ; Punctuated all fields for JFNS% 40564 extern scrlft ;[233] ; Set to -1 to suppress trailing CRLF in transaction log 40565 extern jobtab ; My job information 40566 40567 extern errptr ; Error message pointer 40568 extern pktnum ;[234] ; Packet number 40569 extern spack ;[234] ; Send a packet 40570 extern spsiz ;[234] ; Sending packet size 40571 extern subbp ;[234] ; 'Subtract' two byte pointers 40572 extern %%krbf ;[234] ; Buffer to construct an error pack 40573 40574 .psect code/ronly ;[190] Don't allow stores 40575 40576 ; To do: Needs a double float (dfltr) 40577 ; 40578 ; Could do the fltr, then extract the exponent and use it to do 40579 ; an ashc on the double word. 40580 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 3 K20SUB MAC 19-Jan-24 16:52 Support routines for error handling macros. 40581 subttl Support routines for error handling macros. 40582 40583 ;[234] Moved here from K20MIT.MAC 40584 40585 ; KERMSG -- Send an error message to the KERMIT on the other side in an 40586 ; error packet. Invoked from %JSKER, with T1 pointing at the user-provided 40587 ; prefix (if any), to which the JSYS error message is appended. 40588 ; 40589 ; As part of [194], rewritten to offload most the macro expansion and 40590 ; do more of the work here. Saves some memory by not always duplicating 40591 ; the KERMIT-20: prefix 40592 ; 40593 ; Called 40594 ; 40595 ; jsp t1,%%krms 40596 ; 40597 ; t1 offsets: 40598 ; 40599 ; +0: Address of ASCII text or zero 40600 ; +1: Jump address or zero 40601 ; +2: Return address (implied) 40602 40603 000000'01 blanks: xlist ; We don't need to see all the .chspc's... 40604 list 40605 000030 blankl==<.-blanks> ; Length of blank array 40606 40607 000030'01 000000 000000' krxblt: blanks ; Source block of memory 40608 000031'01 000000000000# %%krbf ; Destination block 40609 000032'01 44 07 0 00 000000* krxptr: point 7, %%krbf ; Pointer to (scrubbed) buffer 40610 40611 000033'01 44 07 0 00 000254' k20ptr: point 7, k20hdr ; Point to header text 40612 000034'01 000000 000013 ^d11 ; Length of header 40613 40614 000035'01 %%krms: entry %%krms ;[213] Declare for the world 40615 000035'01 415 16 0 00 000130' block. ; Enter block context for a stack frame 40616 000036'01 261 17 0 00 000016 40617 000037'01 265 16 0 00 004110' saveac ;Get some registers to enjoy ourselves with 40618 000040'01 200 05 0 00 000001 move q1, t1 ; Save argument/return pointer 40619 40620 000041'01 201 01 0 00 000030 movei t1, blankl ; Set up XBLT block 40621 000042'01 120 02 0 00 000030' dmove t2, krxblt 40622 000043'01 123 01 0 00 004124' xblt. t1 ; Scrub the buffer with blanks 40623 40624 000044'01 200 01 0 00 000032' move t1, krxptr ; Load pointer to scrubbed buffer 40625 000045'01 120 03 0 00 000033' dmove t3,k20ptr ; Load pointer to header text 40626 remark t4,count ; Length of same 40627 000046'01 200 06 0 00 000004 move q2, t4 ; Begin length of message 40628 40629 000047'01 do. ; Enter loop lexical context 40630 000047'01 134 02 0 00 000003 ildb t2, t3 ; Pick up a byte 40631 000050'01 136 02 0 00 000001 idpb t2, t1 ; Deposit it 40632 000051'01 367 04 0 00 000047' sojg t4, top. ; Do all of them 40633 000052'01 enddo. ; Fall out of loop lexical context 40634 40635 000052'01 337 03 0 05 000000 skipg t3,0(q1) ; Load and double check string address k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 3-1 K20SUB MAC 19-Jan-24 16:52 Support routines for error handling macros. 40636 000053'01 254 00 0 00 000065' ifskp. ; Got passed something 40637 000054'01 do. ; and copy the characters over 40638 000054'01 134 02 0 00 000003 ildb t2, t3 ; Get the byte. 40639 000055'01 322 02 0 00 000060' jumpe t2, endlp. ; Exit if a null 40640 000056'01 136 02 0 00 000001 idpb t2, t1 ; Deposit the byte. 40641 000057'01 344 06 0 00 000054' aoja q2, top. ; Loop and increment tally 40642 000060'01 enddo. ; Never falls out; explicit exit 40643 ; Tack on " - " 40644 000060'01 120 02 0 00 004125' dmove t2, [exp .chspc, .chdas] 40645 000061'01 136 02 0 00 000001 idpb t2, t1 ; Append the space 40646 000062'01 136 03 0 00 000001 idpb t3, t1 ; Append the dash 40647 000063'01 136 02 0 00 000001 idpb t2, t1 ; Append the space after that 40648 000064'01 271 06 0 00 000003 addi q2, ^d3 ; Account for three more characters 40649 000065'01 endif. 40650 40651 remark t1, ; Put the Tops-20 error string into the buffer. 40652 000065'01 525 02 0 00 400000 hrloi t2, .fhslf ; Say: this fork ,, last error. 40653 000066'01 210 03 0 00 000000* movn t3, spsiz ; Specify the maximum to send as a negative 40654 000067'01 270 03 0 00 000006 add t3, q2 ; number (don't overflow the buffer) 40655 000070'01 517 00 0 00 000003 hrlzs t3 ;[74] (ERSTR wants -n,,0) 40656 000071'01 325 03 0 00 000102' ifl. t3 ;[50] (don't bother if not negative). 40657 000072'01 104 00 0 00 000011 ERSTR% 40658 000073'01 320 14 0 00 000075' erjmps .+2 ; Ignore its strange return 40659 000074'01 320 14 0 00 000075' erjmps .+1 ; Ignore its stranger return 40660 000075'01 200 02 0 00 000001 move t2, t1 ; Set up to get the new length. 40661 000076'01 200 01 0 00 000032' move t1, krxptr ; Load pointer to partially filled buffer 40662 000077'01 260 17 0 00 000000* call subbp ; Subtract byte pointers. 40663 000100'01 254 00 0 00 000102' anskp. ;[40] If there is an error assume this count. 40664 remark ; Worked, so don't hit the else. 40665 000101'01 254 00 0 00 000103' else. ; Otherwise... 40666 000102'01 200 03 0 00 000006 move t3, q2 ; Don't trust ERSTR% 40667 000103'01 endif. ; End case fence post checking 40668 40669 000103'01 313 03 0 00 000066* camle t3, spsiz ;[40] Longer than we're supposed to send? 40670 000104'01 200 03 0 00 000103* move t3, spsiz ;[40] If so, truncate it. 40671 000105'01 200 06 0 00 000003 move q2, t3 ; Save whatever the length is 40672 000106'01 201 01 0 00 000105 movei t1, "E" ; An error packet. 40673 000107'01 200 02 0 00 000000* move t2, pktnum ; Packet number. 40674 000110'01 200 04 0 00 000032' move t4, krxptr ; Load pointer to finished buffer 40675 000111'01 260 17 0 00 000000* call spack ; Send the error packet. 40676 000112'01 600 00 0 00 000000 nop 40677 40678 000113'01 332 00 0 00 000000* ifme. srvflg ;[234] ; If a server, NOT safe to type 40679 000114'01 254 00 0 00 000126' 40680 000115'01 200 01 0 00 000032' move t1, krxptr ; Load pointer to finished buffer 40681 000116'01 200 02 0 00 000006 move t2, q2 ; Load final character count 40682 000117'01 133 02 0 00 000001 adjbp t2, t1 ; Go to end of character string 40683 000120'01 120 03 0 00 004127' dmove t3, [ exp .chcrt, .chlfd ] 40684 000121'01 136 03 0 00 000002 idpb t3, t2 ; Drop in a CR-LF 40685 000122'01 136 04 0 00 000002 idpb t4, t2 40686 000123'01 400 03 0 00 000000 setz t3, ; Cons up a NUL 40687 000124'01 136 03 0 00 000002 idpb t3, t2 ; Tie off the string 40688 000125'01 104 00 0 00 000313 ESOUT% ; Finally whine about our problems 40689 000126'01 endif. ;[234] ; End case local output 40690 000126'01 200 01 0 05 000001 move t1, 1(q1) ; Now handle some kind of a return k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 3-2 K20SUB MAC 19-Jan-24 16:52 Support routines for error handling macros. 40691 000127'01 263 17 0 00 000000 endbk. ; Restore registers, tear down the stack 40692 40693 000130'01 326 01 0 01 000000 jumpn t1, (t1) ; Go somewhere, if told to 40694 000131'01 104 00 0 00 000170 HALTF% ; Cease execution 40695 000132'01 263 17 0 00 000000 ret ; Try to return to caller if continued k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 4 K20SUB MAC 19-Jan-24 16:52 Support routines for error handling macros. 40696 40697 ; Support for kermsg. Written for maximum reduction of kermsg() macro 40698 ; 40699 ; All part of [194] 40700 40701 000133'01 %kerms: entry %kerms ; Globally available 40702 000133'01 261 17 0 00 000012 push p, p2 ; Save p2 (not aliased) 40703 000134'01 200 12 0 00 000001 move p2, t1 ; Save return and argument address 40704 000135'01 201 01 0 00 000105 movei t1, "E" ; Send an error packet to the other side. 40705 000136'01 200 02 0 00 000107* move t2, pktnum ; Packet number. 40706 000137'01 120 03 0 12 000000 dmove t3, (p2) ; Pick up count and text address 40707 000140'01 202 04 0 00 000000* movem t4, errptr ; Save pointer to error msg for status. 40708 000141'01 260 17 0 00 000111* call spack ; Send the error packet. 40709 000142'01 600 00 0 00 000000 nop 40710 000143'01 336 00 0 00 000113* ifmn. srvflg ;[234] ; If local, safe to type 40711 000144'01 254 00 0 00 000153' 40712 000145'01 561 01 0 00 000254' hrroi t1, k20hdr ; Load start of message 40713 000146'01 104 00 0 00 000313 ESOUT% ;[187] ; Begin whining 40714 000147'01 200 01 0 12 000001 move t1, 1(p2);[202] ; Same message 40715 000150'01 104 00 0 00 000076 PSOUT% ; Type that, too 40716 000151'01 561 01 0 00 000000* hrroi t1, crlf ; Tie off the line 40717 000152'01 104 00 0 00 000076 PSOUT% 40718 000153'01 endif. ;[234] ; End case local output 40719 000153'01 200 01 0 00 000012 move t1, p2 ; Restore calling t1 40720 000154'01 262 17 0 00 000012 pop p, p2 ; Restore p2 40721 000155'01 271 01 0 00 000002 addi t1,^d2 ; Skip past both arguments 40722 000156'01 254 00 0 01 000000 jrst (t1) ; Finally done 40723 40724 ;[234] End move from K20MIT.MAC 40725 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 5 K20SUB MAC 19-Jan-24 16:52 Macro support routines 40726 subttl Macro support routines 40727 40728 ; JSERR0 synchronizes with terminal i/o in progress before typing the 40729 ; JSYS error message. 40730 ; 40731 ; JSMSG0 just types the JSYS error message. 40732 ; 40733 ; These names where changed in order to not conflict with routines of the 40734 ; same name in MACSYM (MACREL). Also removed CFIBF% and DOBE% as part of 40735 ; edit 187 as ESOUT% does this. 40736 ; 40737 ; No macro should EVER invoke these directly 40738 40739 000157'01 561 01 0 00 004131' kserr0: tmsg < - > ; Type a dash. 40740 000160'01 104 00 0 00 000076 40741 40742 000161'01 ksmsg0: remark ; Alternate entry 40743 000161'01 201 01 0 00 000101 movei t1,.priou 40744 000162'01 525 02 0 00 400000 hrloi t2,.fhslf ; This fork ,, last error. 40745 000163'01 400 03 0 00 000000 setz t3, 40746 000164'01 104 00 0 00 000011 ERSTR% 40747 000165'01 320 12 0 00 000167' erjmpr .+2 40748 000166'01 320 12 0 00 000167' erjmpr .+1 40749 000167'01 263 17 0 00 000000 ret 40750 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 6 K20SUB MAC 19-Jan-24 16:52 Support for wtlog 40751 subttl Support for wtlog 40752 40753 ;[194] Begin Code Insertion 40754 40755 ; Rewritten for maximum reduction of expansion wtlog() macro 40756 40757 000170'01 %wtlog: entry %wtlog ; Globally available 40758 000170'01 260 17 0 00 000173' call %wtlgf ; Set up a logging frame 40759 000171'01 271 01 0 00 000003 addi t1, ^d3 ; Skip past the three arguments 40760 000172'01 254 00 0 01 000000 jrst (t1) ; Finally done 40761 ;[233] Needs plenty registers for intersection transfers 40762 000173'01 265 16 0 00 004132' %wtlgf: saveac ;[233] 40763 000174'01 621 01 0 00 777700 txz t1, klflgs ; Don't mess up addressing 40764 000175'01 200 05 0 00 000001 move q1, t1 ;[233] Save arguments accumulator 40765 000176'01 337 01 0 00 000000* skipg t1, tlgjfn ; Is the transaction log open? 40766 000177'01 263 17 0 00 000000 ret ; Nope, so nothing to do 40767 40768 ;;;; 40769 ;;;; cain t1, .nulio ;[193] Not really going to do anything? 40770 ;;;; ret ;[193] Fine, then don't really do anything 40771 40772 000200'01 474 02 0 00 000000 seto t2, ; Start with time stamp, current date/time. 40773 000201'01 205 03 0 00 400000 movx t3, ot%nda ; No date in stream 40774 000202'01 104 00 0 00 000220 ODTIM% 40775 000203'01 320 14 0 00 000204' erjmps .+1 ; Catch and suppress errors 40776 000204'01 201 02 0 00 000072 movei t2, ":" 40777 000205'01 104 00 0 00 000051 BOUT% 40778 000206'01 320 14 0 00 000207' erjmps .+1 40779 000207'01 201 02 0 00 000040 movei t2, .chspc 40780 000210'01 104 00 0 00 000051 BOUT% 40781 000211'01 320 14 0 00 000212' erjmps .+1 40782 40783 000212'01 120 02 0 05 000000 dmove t2, 0(t5) ; Load string pointer and length 40784 000213'01 322 02 0 00 000225' ifn. t2 ;[216] Load string and (negative) count 40785 000214'01 301 03 0 00 000000 cail t3,0 ;[216] Better be a negative number 40786 000215'01 254 00 0 00 000225' anskp. ;[216] But wasn't 40787 000216'01 254 14 0 00 000007 xsfm q3 ;[233] Get and store current processor flags 40788 000217'01 200 10 0 00 000000# move q4, bigsou ;[233] Load up inter-section transfer address 40789 000220'01 201 11 0 00 000222' movei q5, .+2 ;[233] And the inter-section return adress 40790 000221'01 254 05 0 00 000007 xjrstf q3 ;[233] and take a giant step! 40791 000222'01 201 02 0 00 000040 movei t2, .chspc 40792 000223'01 104 00 0 00 000051 BOUT% 40793 000224'01 320 14 0 00 000225' erjmps .+1 40794 000225'01 endif. 40795 40796 000225'01 337 03 0 05 000002 skipg t3, 2(t5) ;[216] Load a JFN, maybe 40797 000226'01 254 00 0 00 000245' ifskp. ; Some kind of an address 40798 000227'01 337 02 0 03 000000 skipg t2, (t3) ; Pick up the actual JFN 40799 000230'01 254 00 0 00 000245' anskp. ; Unless not holding one 40800 000231'01 302 02 0 00 377777 caie t2, .nulio ; Dumping it? 40801 000232'01 254 00 0 00 000237' ifskp. ; That's easy! 40802 000233'01 120 02 0 00 000000* dmove t2, nul4 ; Constant string and length 40803 000234'01 104 00 0 00 000053 SOUT% 40804 000235'01 320 14 0 00 000236' erjmps .+1 40805 000236'01 254 00 0 00 000242' else. ; Otherwise, it's a real file k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 6-1 K20SUB MAC 19-Jan-24 16:52 Support for wtlog 40806 000237'01 120 03 0 00 000000* dmove t3, allfld ; Type the entire specification 40807 000240'01 104 00 0 00 000030 JFNS% 40808 000241'01 320 14 0 00 000242' erjmps .+1 ; Catch and suppress error 40809 000242'01 endif. ; End NUL: special case 40810 000242'01 201 02 0 00 000040 movei t2, .chspc ;[233] 40811 000243'01 104 00 0 00 000051 BOUT% ;[233] 40812 000244'01 320 14 0 00 000245' erjmps .+1 ;[233] 40813 000245'01 endif. ; End case JFN handling 40814 40815 000245'01 356 00 0 00 000000* aosn scrlft ;[233] ; Wants to suppress trailing CRLF in transaction log? 40816 000246'01 263 17 0 00 000000 ret ;[233] ; Yes, so we're done 40817 40818 000247'01 561 02 0 00 000151* hrroi t2, crlf 40819 000250'01 120 03 0 00 004152' dmove t3,[ exp -2, 0] 40820 000251'01 104 00 0 00 000053 SOUT% 40821 000252'01 320 14 0 00 000253' erjmps .+1 40822 000253'01 263 17 0 00 000000 ret 40823 40824 ;[194] End Code Insertion 40825 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 7 K20SUB MAC 19-Jan-24 16:52 Support for %jserr. 40826 subttl Support for %jserr. 40827 40828 ;[194] Begin Code Insertion 40829 40830 ; Rewritten for maximum reduction of %jserr() macro 40831 ; 40832 ; N.B., If not given a label, the previous version of the macro would 40833 ; do a HALTF% allowing a continue. However, no code existed any 40834 ; longer which leveraged this functionality. It has been 40835 ; removed an replaced with returning +1 if no label is given as 40836 ; passing a +1 to the current macro will do the wrong thing 40837 40838 000254'01 k20hdr: intern k20hdr ; Used by other error routines in k20mit 40839 000254'01 113 105 122 115 111 asciz |KERMIT-20: | ; Start of any error message 40840 40841 000257'01 %%jser: entry %%jser ; Used in other parts of Kermit Planet 40842 000257'01 415 16 0 00 000310' block. ; Enter block context (build stack frame) 40843 000260'01 261 17 0 00 000016 40844 000261'01 265 16 0 00 004154' saveac ; Save a bunch of accumulators 40845 000262'01 621 01 0 00 777700 txz t1, klflgs ; Don't mess up addressing 40846 000263'01 200 12 0 00 000001 move p2,t1 ; Save return accumulator 40847 000264'01 561 01 0 00 000254' hrroi t1, k20hdr ; Load pointer to first part of error 40848 000265'01 104 00 0 00 000313 ESOUT% ;[187] Begin whining, compliantly 40849 000266'01 320 12 0 00 000267' erjmpr .+1 ; Catch and ignore error 40850 000267'01 336 01 0 12 000000 skipn t1, 0(p2) ; Pick up the text pointer 40851 000270'01 254 00 0 00 000275' ifskp. ; That is, if there is one 40852 000271'01 104 00 0 00 000076 PSOUT% ; Give us that bit of news... 40853 000272'01 320 12 0 00 000273' erjmpr .+1 ; Catch and ignore error 40854 000273'01 260 17 0 00 000157' call kserr0 ; Put JSYS error after dash, 40855 000274'01 254 00 0 00 000276' else. ; Otherwise, no need for the dash 40856 000275'01 260 17 0 00 000161' call ksmsg0 ; so right after "?KERMIT-20: " 40857 000276'01 endif. ; End case, auxiliary message 40858 000276'01 561 01 0 00 004170' tmsg < at: > ; Say where it happened. 40859 000277'01 104 00 0 00 000076 40860 000300'01 201 01 0 12 777775 movei t1, -3(p2) ; Calculate address of failing JSYS 40861 000301'01 621 01 0 00 777700 txz t1, klflgs ; Flags aren't part of the address 40862 000302'01 260 17 0 00 004050' call symout ; Type it symbolically 40863 000303'01 561 01 0 00 000247* hrroi t1,crlf ; And a trailing CR-LF. 40864 000304'01 104 00 0 00 000076 PSOUT% 40865 000305'01 320 12 0 00 000306' erjmpr .+1 ; Catch and ignore error 40866 000306'01 200 01 0 12 000001 move t1, 1(p2) ; Load a jump (or return) address 40867 000307'01 263 17 0 00 000000 endbk. ; Exit block context 40868 ; Tears down the stack frame 40869 000310'01 254 00 0 01 000000 jrst (t1) ; Go someplace and do something 40870 40871 .endps code ; Get out of section zero 40872 40873 ;[194] End Code Insertion 40874 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 8 K20SUB MAC 19-Jan-24 16:52 %%smsg documentation and extended section code 40875 subttl %%smsg documentation and extended section code 40876 40877 ;[216] Begin code insertion 40878 ; 40879 ; SOUT% has a bug in certain cases when being passed OWGP's. Like other 40880 ; JSYi, OWGP's work fine for I/O. However, if you use SOUT% to move a 40881 ; string, then SOUT% will occasionally do the wrong thing. Fix by 40882 ; checking here if we have a JFN and, if so, doing the I/O. Otherwise 40883 ; we use MOVSLJ (which is faster than using SOUT% to move data, 40884 ; anyway) 40885 ; 40886 ; Read that last sentence again: incredibly, ALL of the hair with an 40887 ; inter-section call to do the MOVSLJ is FAR faster than the SOUT%! 40888 ; Read it again, it's whaaay faster. 40889 ; 40890 ; Of course, MOVSLJ has its own quirks... You would think that you 40891 ; could use a OWGP that references section zero while executing in any 40892 ; section (such as section zero). I mean it works for IPB, ADJBP, 40893 ; ILDB and IDPB, so what's the problem? MOVSLJ will *NOT* honor a 40894 ; section zero OWGP when executed in section zero! The non-section 40895 ; OWGP increments just fine and both counts decrement, but the section 40896 ; zero pointer is untouched... 40897 ; 40898 ; So we stick with local section zero pointers as the destination, 40899 ; always, hand cast to double pointers and then do an inter-section 40900 ; transfer so that the MOVSLJ will execute in a non-zero section. 40901 ; This is necessary because double word pointers are not honored by 40902 ; ANY code executing in section zero. 40903 ; 40904 ; Actually, SOUT% only works with non-section OWGP's when the output is 40905 ; the terminal. Output to the disk is garbled, but not consistently. 40906 ; So it has to do an inter-section call, too. Bug appears to be BYTBLT 40907 ; in the monitor that is not considering OWGP's from section zero. 40908 ; 40909 ; And, of course, BOUT% doesn't honor *ANY* kind of a OWGP in section 40910 ; zero. EVER... 40911 ; 40912 ; Entry: 40913 ; 40914 ; t1/ String pointer or I/O designator 40915 ; Any string pointer in t1 is expected to be a 40916 ; LOCAL string pointer in section zero space. 40917 ; t2/ ASCII OWGP to Extended Text .PSECT, always 40918 ; t3/ Negative length of string for faster SOUT%'s 40919 ; (If used) 40920 ; 40921 ; Returns: 40922 ; 40923 ; +1 always 40924 ; 40925 ; t1/ Updated, if local pointer 40926 ; t2/ Updated 40927 ; t3/ 0 40928 ; 40929 ; Strings are NUL terminated and ready for append k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 8-1 K20SUB MAC 19-Jan-24 16:52 %%smsg documentation and extended section code 40930 40931 .psect ecode/ronly,ecdorg ;movslj MUST be executed in a non-zero section!!! 40932 000000'02 016 00 0 00 000000 movmsg: movslj 0,0 ; Extended opcode 40933 000001'02 000000 000000 .chnul ; Fill character (never used) 40934 40935 000002'02 123 01 0 00 000000' extmov: extend t1, movmsg ; Copy the data 40936 000003'02 600 00 0 00 000000 nop ; Ignore non-skip (should never happen) 40937 000004'02 200 10 0 00 000011 move q4, q5 ; Load return address 40938 000005'02 254 05 0 00 000007 xjrstf q3 ; Return back downstairs, restore flags 40939 40940 000006'02 104 00 0 00 000053 extsou: SOUT% ; SOUT% from section 1 40941 000007'02 320 14 0 00 000010' erjmps .+1 ; Catch and suppress error 40942 000010'02 200 10 0 00 000011 move q4, q5 ; Load return address 40943 000011'02 254 05 0 00 000007 xjrstf q3 ; Return back downstairs, restoring flags 40944 .endps ecode ; Out of extended code 40945 40946 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 9 K20SUB MAC 19-Jan-24 16:52 %%smsg documentation and extended section code 40947 subttl %%smsg documentation and extended section code 40948 40949 ; See above; arguments are expected to be suitable for a counted SOUT% 40950 40951 .psect const ; Constant pointers go in const 40952 000000'03 000001 000000# giant: extsec,,extmov ; 30 bit address of movslj 40953 000001'03 bigsou: entry bigsou ;[233] Allows k20mit to use 40954 000001'03 000001 000000# extsec,,extsou ; 30 bit address of SOUT% 40955 .endps const ; Close off constants 40956 40957 .psect code ; Back in section zero code 40958 40959 000311'01 %%smsg: entry %%smsg ; World callable 40960 40961 remark ; A minor efficiency hack 40962 000311'01 312 03 0 00 004172' came t3, [-1] ; Is this one dinky byte? 40963 000312'01 254 00 0 00 000321' ifskp. ; Then don't need all the baloney below 40964 000313'01 200 03 0 00 000002 move t3, t2 ; Get a copy of the source pointer 40965 000314'01 134 02 0 00 000003 ildb t2, t3 ; Load that single byte for BOUT% 40966 000315'01 260 17 0 00 000357' call BOUTI% ; Go put it somewhere 40967 000316'01 200 02 0 00 000003 move t2, t3 ; Restore updated source pointer 40968 000317'01 400 03 0 00 000000 setz t3, ; Stomp so looks like a return from SOUT% 40969 000320'01 263 17 0 00 000000 ret ; We're done 40970 000321'01 endif. 40971 40972 remark ; Otherwise, a multi-byte call 40973 000321'01 603 01 0 00 777777 tlne t1, -1 ; JFN will never have any flags 40974 000322'01 254 00 0 00 000331' ifskp. ; It's a JFN 40975 000323'01 265 16 0 00 004173' saveac ; Save linkage registers 40976 000324'01 254 14 0 00 000007 xsfm q3 ; Get and store the flags 40977 000325'01 200 10 0 00 000000# move q4, bigsou ; Load up inter-section transfer address 40978 000326'01 201 11 0 00 000330' movei q5, .+2 ; And the inter-section return adress 40979 000327'01 254 05 0 00 000007 xjrstf q3 ; Take a giant step 40980 000330'01 263 17 0 00 000000 ret ; Return, restoring registers 40981 000331'01 endif. ; End I/O case 40982 40983 remark ; See above; all this hair is faster than a SOUT% 40984 000331'01 265 16 0 00 004205' saveac ; Needs oinky registers 40985 000332'01 210 04 0 00 000003 movn t4, t3 ; movslj wants a positive length 40986 remark ; Cast local section zero to global long 40987 000333'01 510 05 0 00 000001 hllz q1, t1 ; Load destination pointer portion 40988 000334'01 661 05 0 00 000040 txo q1, GP%2WB ; Set the double word pointer bit 40989 000335'01 550 06 0 00 000001 hrrz q2, t1 ; Load address portion (section zero!!!) 40990 000336'01 200 01 0 00 000004 move t1, t4 ; Source length is the same 40991 remark t2, 0 ; Load source pointer (already there) 40992 000337'01 400 03 0 00 000000 setz t3, ; Single word source (OWGP) 40993 40994 000340'01 254 14 0 00 000007 xsfm q3 ; Get and store the flags 40995 000341'01 200 10 0 00 000000# move q4, giant ; Load up inter-section transfer address 40996 000342'01 201 11 0 00 000344' movei q5, %%sms1 ; And the inter-section return adress 40997 000343'01 254 05 0 00 000007 xjrstf q3 ; Take a giant step 40998 40999 000344'01 %%sms1: remark ; Our return address 41000 000344'01 260 17 0 00 003665' call d2sgpc ; Convert double source to single 41001 000345'01 600 00 0 00 000000 nop ; Ignore error; it will never happen here k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 9-1 K20SUB MAC 19-Jan-24 16:52 %%smsg documentation and extended section code 41002 000346'01 200 10 0 00 000001 move q4, t1 ; Store source single pointer 41003 remark ; Hand cast destination to section zero local 41004 000347'01 510 01 0 00 000005 hllz t1, q1 ; Pick up source pointer portion 41005 000350'01 621 01 0 00 000040 txz t1, GP%2WB ; Stomp the source double word pointer bit 41006 000351'01 540 01 0 00 000006 hrr t1, q2 ; Put in the section zero address and that's that 41007 000352'01 200 02 0 00 000010 move t2, q4 ; Load single source pointer 41008 41009 000353'01 200 04 0 00 000001 move t4, t1 ; Load a copy of the final destination 41010 000354'01 400 03 0 00 000000 setz t3, ; Return a zero count 41011 000355'01 136 03 0 00 000004 idpb t3, t4 ; Tie off the string, allow append 41012 41013 000356'01 263 17 0 00 000000 ret ; Phew!! Finally done 41014 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 10 K20SUB MAC 19-Jan-24 16:52 BOUT Internal 41015 subttl BOUT Internal 41016 41017 ; Just like BOUT% except doesn't die on a OWGP to a non-zero section. 41018 ; Doing the ildb bums a JSYS, anyway, so that's not the end of the world 41019 ; 41020 ; t1/ Destination designator 41021 ; t2/ Byte to be output, right-justified 41022 41023 000357'01 BOUTI%: entry BOUTI% ; World callible 41024 000357'01 603 01 0 00 777777 tlne t1, -1 ; Writing to a JFN, per chance? 41025 000360'01 254 00 0 00 000364' ifskp. ; Yes, BOUT% is safe 41026 000361'01 104 00 0 00 000051 BOUT% ; So do it 41027 000362'01 320 14 0 00 000000* erjmps r ; Failed?? Catch and suppress error 41028 000363'01 254 00 0 00 000375' else. ; Otherwise, assume some kind of pointer 41029 000364'01 136 02 0 00 000001 idpb t2, t1 ; So just deposit it 41030 000365'01 320 14 0 00 000366' erjmps .+1 ; Failed?? Catch and suppress error 41031 000366'01 261 17 0 00 000001 push p, t1 ; Save the byte pointer 41032 000367'01 261 17 0 00 000002 push p, t2 ; Save the byte 41033 000370'01 400 02 0 00 000000 setz t2, ; Cons up a NUL 41034 000371'01 136 02 0 00 000001 idpb t2, t1 ; Tie off string, allowing append 41035 000372'01 320 12 0 00 000373' erjmpr .+1 ; Failed?? Catch and ignore error (for debugging) 41036 000373'01 262 17 0 00 000002 pop p, t2 ; Restore the byte 41037 000374'01 262 17 0 00 000001 pop p, t1 ; Restore the byte pointer 41038 000375'01 endif. ; End JSYS/ilpb decision 41039 000375'01 263 17 0 00 000000 ret 41040 41041 ;[216] End code insertion 41042 41043 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 11 K20SUB MAC 19-Jan-24 16:52 Is this a JFN on NUL: or its equivalent? 41044 subttl Is this a JFN on NUL: or its equivalent? 41045 41046 ; Determines whether JFN is actually NUL:, and, if so replaces it 41047 ; with .NULIO, a special pseudo-JFN that is both recognized by 41048 ; Tops-20 and used internally as a talisman. 41049 ; 41050 ; Call: 41051 ; 41052 ; t1/ Candidate JFN (or device) 41053 ; 41054 ; Returns, 41055 ; 41056 ; +1/ t1 unmodified 41057 ; +2/ t1 contains .nulio, JFN released (if JFN given) 41058 41059 000376'01 isnulj: entry isnulj ; Keep LINK informed of our location 41060 41061 000376'01 312 01 0 00 004221' came t1, [.dvdes!.dvnul,,-1] ; Typed device directly? 41062 000377'01 254 00 0 00 000403' ifskp. ; We did, so just go with that 41063 000400'01 201 01 0 00 377777 movei t1, .nulio ; Stomp into .nulio, no flags 41064 000401'01 254 00 0 00 000000* retskp ; We're done 41065 000402'01 254 00 0 00 000405' else. ; Otherwise, have to figure it out 41066 000403'01 265 16 0 00 004110' saveac ; Don't trash anything except maybe t1 41067 000404'01 200 05 0 00 000001 move q1, t1 ; Save the JFN with any flags 41068 000405'01 endif. ; .nulio might have flags, actually 41069 41070 000405'01 550 02 0 00 000001 hrrz t2, t1 ; Let's just look at the JFN alone 41071 000406'01 322 02 0 00 000522' jumpe t2, notnul ; Ignore any gubbish 41072 000407'01 306 02 0 00 377777 cain t2, .nulio ; Is some joker trying to get cute? 41073 000410'01 254 00 0 00 000517' jrst yesnul ; It's already NUL: ... 41074 ; Try to weed out some wise guys... 41075 000411'01 306 01 0 00 000100 cain t1, .priin ; Primary Input? 41076 000412'01 254 00 0 00 000522' jrst notnul ; It isn't the NUL: device 41077 000413'01 306 01 0 00 000101 cain t1, .priou ; Primary Output? 41078 000414'01 254 00 0 00 000522' jrst notnul ; It isn't the NUL: device 41079 000415'01 306 01 0 00 777777 cain t1, .cttrm ; Controlling terminal? 41080 000416'01 254 00 0 00 000522' jrst notnul ; It isn't the NUL: device 41081 000417'01 306 01 0 00 677777 cain t1, .sigio ; Signal JFN? 41082 000420'01 254 00 0 00 000522' jrst notnul ; It isn't the NUL: device 41083 ; First see if the argument is a device 41084 000421'01 104 00 0 00 000117 DVCHR% ; Get the characteristics of device 41085 000422'01 320 12 0 00 000424' ifje. r ; Broke on JFN with flags 41086 000423'01 254 00 0 00 000427' 41087 000424'01 200 04 0 00 000001 move t4, t1 ; Save for the curious 41088 000425'01 474 06 0 00 000000 seto q2, ; Flag failed (bogus characteristics) 41089 000426'01 254 00 0 00 000430' else. ; Otherwise, it did work 41090 000427'01 200 06 0 00 000002 move q2, t2 ; Save device characteristics word 41091 000430'01 endif. 41092 ; Now see if a file 41093 000430'01 550 01 0 00 000005 hrrz t1, q1 ; Load JFN, sans flags 41094 000431'01 104 00 0 00 000024 GTSTS% ; Get JFN status 41095 000432'01 320 12 0 00 000434' ifje. r ; Failed?? 41096 000433'01 254 00 0 00 000436' 41097 000434'01 474 04 0 00 000000 seto t4, ; Say it sure isn't a JFN 41098 000435'01 254 00 0 00 000437' else. ; Worked, save the status bits k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 11-1 K20SUB MAC 19-Jan-24 16:52 Is this a JFN on NUL: or its equivalent? 41099 000436'01 200 04 0 00 000002 move t4, t2 ; Save the status bits for the moment 41100 000437'01 endif. 41101 41102 000437'01 415 16 0 00 000446' block. ; Enter block context for better control flow 41103 000440'01 261 17 0 00 000016 41104 000441'01 316 04 0 00 004172' camn t4, [-1] ; GTSTS% blow up? 41105 000442'01 254 00 0 00 000401* retskp ; It did, so no JFN 41106 000443'01 607 04 0 00 000200 txnn t4, gs%nam ; Is this bound to anything? 41107 000444'01 254 00 0 00 000442* retskp ; No, so no JFN 41108 000445'01 263 17 0 00 000000 endbk. ; Fall out of block context 41109 000446'01 254 00 0 00 000455' ifskp. ; Skips if no apparent JFN 41110 000447'01 316 06 0 00 004172' camn q2,[-1] ; Did DVCHR% not work, either? 41111 000450'01 254 00 0 00 000522' jrst notnul ; Didn't, so assume not NUL: 41112 000451'01 135 03 0 00 004222' ldb t3, [pointr q2, dv%typ] ; Pick up the device type 41113 000452'01 302 03 0 00 000015 caie t3, .dvnul ; Wants to just lose data? 41114 000453'01 254 00 0 00 000522' jrst notnul ; Not NUL:, so don't touch it 41115 000454'01 254 00 0 00 000517' jrst yesnul ; It is the NUL: device, but not a JFN 41116 000455'01 endif. 41117 ; Looks like a live JFN 41118 000455'01 550 01 0 00 000005 hrrz t1, q1 ; Try looking at it 41119 000456'01 104 00 0 00 000117 DVCHR% ; Get the characteristics of device 41120 000457'01 320 12 0 00 000522' erjmpr notnul ; GTSTS% just told us it was good... 41121 ; Now see if a file 41122 000460'01 135 03 0 00 004223' ldb t3, [pointr t2, dv%typ] ; Pick up the device type 41123 000461'01 316 06 0 00 004172' camn q2, [-1] ; Did the first DVCHR% fail? 41124 000462'01 254 00 0 00 000470' ifskp. ; No, it worked 41125 000463'01 135 01 0 00 004223' ldb t1, [pointr t2, dv%typ] ; Pick up the device type 41126 000464'01 316 01 0 00 000003 camn t1, t3 ; Are these NOT the same? 41127 000465'01 254 00 0 00 000470' anskp. ; They are, proceed 41128 000466'01 200 03 0 00 000001 move t3, t1 ; They aren't, prefer device 41129 000467'01 400 04 0 00 000000 setz t4, ; Say not open nor bound 41130 000470'01 endif. 41131 41132 000470'01 302 03 0 00 000015 caie t3, .dvnul ; Wants to just lose data? 41133 000471'01 254 00 0 00 000522' jrst notnul ; Not NUL:, so don't touch it 41134 ; It is, so replace the JFN 41135 000472'01 325 04 0 00 000512' ifxn. t4, gs%opn ; Is this thing open? 41136 000473'01 550 01 0 00 000005 hrrz t1, q1 ; Reload JFN, sans flags 41137 000474'01 400 02 0 00 000000 setz t2, ; Let's assume this works... 41138 000475'01 104 00 0 00 000022 CLOSF% ; Politely try to close it 41139 000476'01 320 12 0 00 000500' ifje. r ; Catch and ignore JSYS error 41140 000477'01 254 00 0 00 000501' 41141 000500'01 474 02 0 00 000000 seto t2, ; Flag it didn't want to go away 41142 000501'01 endif. ; End case trying a normal close 41143 000501'01 322 02 0 00 000517' jumpe t2, yesnul ; If it worked, then it's time to leave 41144 000502'01 550 01 0 00 000005 hrrz t1, q1 ; Reload JFN, sans flags 41145 000503'01 661 01 0 00 004000 txo t1, cz%abt ; In this case, try to clobber it 41146 000504'01 400 02 0 00 000000 setz t2, ; Let's assume that works... 41147 000505'01 104 00 0 00 000022 CLOSF% ; Try to close it, rudely 41148 000506'01 320 12 0 00 000510' ifje. r ; Catch and ignore JSYS error 41149 000507'01 254 00 0 00 000511' 41150 000510'01 474 02 0 00 000000 seto t2, ; I guess we must have sticky JFN syndrome 41151 000511'01 endif. ; End case trying a normal close 41152 000511'01 322 02 0 00 000517' jumpe t2, yesnul ; If it worked, then it's time to leave 41153 000512'01 endif. ; Otherwise, fall through and try something else k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 11-2 K20SUB MAC 19-Jan-24 16:52 Is this a JFN on NUL: or its equivalent? 41154 ; Here if not open or we are desperate 41155 000512'01 607 04 0 00 000200 ifxn. t4, gs%nam ; Was it ever bound? 41156 000513'01 254 00 0 00 000517' 41157 000514'01 550 01 0 00 000005 hrrz t1, q1 ; Reload JFN, sans flags 41158 000515'01 104 00 0 00 000023 RLJFN% ; Just toss it 41159 000516'01 320 12 0 00 000517' erjmpr .+1 ; Retrieve and ignore the error 41160 remark yesnul ; Falls through 41161 000517'01 endif. 41162 41163 000517'01 yesnul: remark ; Here if NUL; (JFN already released) 41164 000517'01 201 01 0 00 377777 movei t1, .nulio ; Load our talisman 41165 000520'01 500 01 0 00 000005 hll t1, q1 ; Load any flags, although now phoney 41166 000521'01 254 00 0 00 000444* retskp ; Won!! 41167 41168 000522'01 notnul: remark ; Here if not NUL: or some kooky error 41169 000522'01 200 01 0 00 000005 move t1, q1 ; Restore the calling argument 41170 000523'01 263 17 0 00 000000 ret ; Return +1 41171 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 12 K20SUB MAC 19-Jan-24 16:52 Set up Command State Block to parse from JFN in t1. 41172 subttl Set up Command State Block to parse from JFN in t1. 41173 41174 000524'01 setcsb: entry setcsb 41175 000524'01 337 00 0 00 000001 skipg t1 ; Make sure there's a real JFN. 41176 000525'01 201 01 0 00 000100 movei t1, .priin ; If not, revert. 41177 000526'01 506 01 0 00 000000# hrlm t1, sbk+.cmioj ; Put the input JFN into the CSB. 41178 000527'01 201 02 0 00 000101 movei t2, .priou ; Assume JFN is primary input. 41179 000530'01 302 01 0 00 000100 caie t1, .priin ; Is it? 41180 000531'01 201 02 0 00 377777 movx t2, .nulio ; No, it's a file, so nullify COMND output. 41181 000532'01 542 02 0 00 000000# hrrm t2, sbk+.cmioj ; Put output JFN in CSB. 41182 000533'01 263 17 0 00 000000 ret 41183 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 13 K20SUB MAC 19-Jan-24 16:52 Initialize Fork Capability vector 41184 subttl Initialize Fork Capability vector 41185 41186 ; Can't just blanket enable capabilities, an ACJ might get grumpy... 41187 ; 41188 ; Adapted from SETND2 (SETNOD rewrite) 41189 ; 41190 ; Note: checking for SC%GTB is almost certainly unnecessary as it is 41191 ; unheard of for it NOT to be on and we don't even have to enable it 41192 ; as merely having it is enough. That's good because the EXEC does 41193 ; not enable it. 41194 ; 41195 ; However, the code was fun to write and you never know when you're 41196 ; going to get hit with some fascist system manager's idea of security. 41197 ; 41198 ; Note, historically, Kermit did not change the top-level fork's 41199 ; capability vector. In particular, if something 'dangerous' (like 41200 ; Wheel or Operator) was on, it was left on. This tries to follow 41201 ; that. 41202 41203 ; Trashes t1-t4 41204 41205 000534'01 inicap: entry inicap ; Inform Link of our location 41206 extern mycaps,capas,bigboy ;and of our necessaries 41207 000534'01 265 16 0 00 004224' saveac ;[252] Needed to propagate sc%whl/sc%opr 41208 41209 000535'01 403 02 0 00 000003 setzb t2, t3 ; Cons up a null capability vector 41210 000536'01 124 02 0 00 000000* dmovem t2, mycaps ; Assume we have nothing and that we are nobody 41211 000537'01 124 02 0 00 000000* dmovem t2, capas ; special (also intentionally whacks BIGBOY) 41212 000540'01 201 01 0 00 400000 movei t1, .fhslf ; This fork 41213 000541'01 104 00 0 00 000150 RPCAP% ; Get our capabilities 41214 000542'01 320 12 0 00 000362* erjmpr r ; Give up right now; can't do anything more 41215 41216 remark t2, capas ;[187] Let other code handle this 41217 000543'01 200 04 0 00 000003 move t4, t3 ; Save a copy of what's on 41218 000544'01 200 05 0 00 000003 move q1, t3 ;[252] Another copy here, too 41219 remark t2, badmsk ; t2 is ignored by EPCAP% for .fhslf 41220 000545'01 630 03 0 00 004232' tdz t3, [badmsk] ; Shut off some things that get us into trouble 41221 ; Turn on a few things 41222 000546'01 602 02 0 00 001000 txne t2, sc%dna ; Do we have DECnet access? 41223 000547'01 660 03 0 00 001000 txo t3, sc%dna ; Yes, turn it on in case ACJ desires it 41224 000550'01 603 02 0 00 200000 txne t2, sc%gtb ; Do we have GETAB%? 41225 000551'01 661 03 0 00 200000 txo t3, sc%gtb ; Yes, flag other code 41226 000552'01 603 02 0 00 400000 txne t2, sc%ctc ; Do we have ^C? 41227 000553'01 661 03 0 00 400000 txo t3, sc%ctc ; Yes, flag other code 41228 41229 000554'01 405 05 0 00 600000 andx q1, sc%whl!sc%opr ;[252] Isolate some dangerous bits 41230 000555'01 322 05 0 00 000560' ifn. q1 ;[252] Could we hurt anybody? 41231 000556'01 476 00 0 00 000000* setom bigboy ;[252] Yep, flag that we are one of the BIG BOYS 41232 000557'01 434 03 0 00 000005 or t3, q1 ;[252] And keep them turned on 41233 000560'01 endif. ;[252] 41234 41235 000560'01 124 02 0 00 000536* dmovem t2, mycaps ; Store current capability vector 41236 000561'01 316 03 0 00 000004 camn t3, t4 ; Anything to change, actually? 41237 000562'01 263 17 0 00 000000 ret ; Nope, bum a few JSYi 41238 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 13-1 K20SUB MAC 19-Jan-24 16:52 Initialize Fork Capability vector 41239 000563'01 104 00 0 00 000151 EPCAP% ; Diddle the capabiliy vector 41240 000564'01 320 12 0 00 000566' ifje. r ; Failed?? 41241 000565'01 254 00 0 00 000570' 41242 000566'01 200 04 0 00 000001 move t4, t1 ; Save error code for debuggers, otherwise ignore 41243 000567'01 201 01 0 00 400000 movei t1, .fhslf ; Reload fork handle 41244 000570'01 endif. ; End case error handling 41245 ; See if fascist ACJ changed anything 41246 000570'01 104 00 0 00 000150 RPCAP% ; Get the resulting capability vector 41247 000571'01 320 12 0 00 000542* erjmpr r ; Sigh... 41248 000572'01 202 03 0 00 000000# movem t3, mycaps+1 ; Update final capability vector 41249 41250 repeat 0,< ;[252] Remove now that debugging is done 41251 txmsg (Avl: ) ;[252] Showing available 41252 move t1, t2 ;[252] Load them 41253 call infcap ;[252] Show them 41254 hrroi t1, crlf ;[252] 41255 PSOUT% ;[252] 41256 txmsg (On: ) ;[252] Showing what's on 41257 move t1, t3 ;[252] Load those 41258 call infcap ;[252] Show them 41259 hrroi t1, crlf ;[252] 41260 PSOUT% ;[252] 41261 > ;repeat 0 ;[252] 41262 000573'01 263 17 0 00 000000 ret ; Finally done 41263 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 14 K20SUB MAC 19-Jan-24 16:52 Determine what kind of argument we have 41264 subttl Determine what kind of argument we have 41265 41266 ; Call: 41267 ; 41268 ; t1/ The handle we're trying to puzzle out 41269 ; 41270 ; Return: 41271 ; 41272 ; +1, Couldn't fathom it 41273 ; +2, Figured it out 41274 ; 41275 ; t1/ Appropriate flag set 41276 41277 000574'01 302 01 0 00 777777 argtyp: caie t1, .cttrm ; Called with controlling terminal? 41278 000575'01 254 00 0 00 000600' ifskp. ; That's easy enough 41279 000576'01 205 01 0 00 200000 movx t1, ts%ctm ; Set the controlling terminal flag 41280 000577'01 254 00 0 00 000521* retskp ; Success 41281 000600'01 endif. 41282 41283 000600'01 302 01 0 00 000101 caie t1, .priou ; Called with primary output? 41284 000601'01 254 00 0 00 000604' ifskp. ; That's easy enough 41285 000602'01 205 01 0 00 100000 movx t1, ts%pro ; Set the primary output flag 41286 000603'01 254 00 0 00 000577* retskp ; Success 41287 000604'01 endif. 41288 41289 000604'01 265 16 0 00 004233' saveac ; For calling argument and stack variable 41290 000605'01 200 05 0 00 000001 move q1, t1 ; Save the calling argument 41291 41292 000606'01 620 01 0 00 200000 txz t1, fh%epn ; Shut off extended page number flag 41293 000607'01 302 01 0 00 400000 caie t1, .fhslf ; Called with this fork? 41294 000610'01 254 00 0 00 000613' ifskp. ; That's easy, too 41295 000611'01 205 01 0 00 042000 movx t1, ts%frk!ts%efh ;Set the fork handle flag, explicitly supplied 41296 000612'01 254 00 0 00 000603* retskp ; Success 41297 000613'01 endif. 41298 ; Let's try a little harder 41299 000613'01 265 16 0 00 000000* anstkv (q2, <.rfsfl+1>) ; Allocate stack space for call 41300 000614'01 000000 000005 41301 000615'01 415 06 0 17 777772 41302 000616'01 201 03 0 00 000005 movx t3, <.rfsfl+1> ; Length of RFSTS% block 41303 000617'01 202 03 0 06 000000 movem t3, .rfcnt(q2) ; Store it in block 41304 41305 000620'01 515 01 0 00 400000 hrlzi t1, (rf%lng) ; Using long form 41306 000621'01 540 01 0 00 000005 hrr t1, q1 ; Load original argument (whatever it was) 41307 000622'01 200 02 0 00 000006 move t2, q2 ; Load pointer to block 41308 000623'01 200 03 0 00 000001 move t3, t1 ; Save a copy of JSYS argument 41309 000624'01 104 00 0 00 000156 RFSTS% ; Try to find out status 41310 000625'01 320 12 0 00 000626' erjmpr .+1 ; Side effect t1 with error code 41311 000626'01 312 01 0 00 000003 came t1, t3 ; But!! Did t1 change?? 41312 000627'01 254 00 0 00 000632' ifskp. ; No, so the call succeeded 41313 000630'01 205 01 0 00 042000 movx t1, ts%frk!ts%efh ;Set the fork handle flag, explicitly supplied 41314 000631'01 254 00 0 00 000612* retskp ; Success 41315 000632'01 endif. 41316 41317 000632'01 550 01 0 00 000005 hrrz t1, q1 ; Reload the calling argument 41318 000633'01 104 00 0 00 000024 GTSTS% ; Get the JFN's status k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 14-1 K20SUB MAC 19-Jan-24 16:52 Determine what kind of argument we have 41319 000634'01 320 12 0 00 000636' ifje. r ; If it was a JFN... 41320 000635'01 254 00 0 00 000641' 41321 000636'01 200 03 0 00 000001 move t3, t1 ; Save error for debuggers 41322 000637'01 400 02 0 00 000000 setz t2, ; Clear gs%nam 41323 remark ; Fall out to try device 41324 000640'01 254 00 0 00 000645' else. ; Otherwise, worked 41325 000641'01 607 02 0 00 000200 ifxn. t2, gs%nam ; A bound JFN? 41326 000642'01 254 00 0 00 000645' 41327 000643'01 205 01 0 00 020000 movx t1, ts%jfn ; Yes, set the JFN flag 41328 000644'01 254 00 0 00 000631* retskp ; Success 41329 000645'01 endif. ; End case a real JFN 41330 remark ; Otherwise, fall through to try device 41331 000645'01 endif. 41332 41333 000645'01 200 01 0 00 000005 move t1, q1 ; Reload the calling argument 41334 000646'01 104 00 0 00 000117 DVCHR% ; See if we got a device handle, maybe 41335 000647'01 320 12 0 00 000651' ifje. r ; Failed?? 41336 000650'01 254 00 0 00 000654' 41337 000651'01 200 02 0 00 000001 move t2, t1 ; Save error code for debuggers 41338 000652'01 400 01 0 00 000000 setz t1, ; Return no flags at all 41339 remark ; Fall out to try something else (like what??) 41340 000653'01 254 00 0 00 000656' else. ; Otherwise, worked 41341 000654'01 205 01 0 00 010000 movx t1, ts%dev ; Set the device handle flag 41342 000655'01 254 00 0 00 000644* retskp ; Success 41343 000656'01 endif. 41344 41345 000656'01 263 17 0 00 000000 ret ; Can't figure out what else to try, so fail 41346 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 15 K20SUB MAC 19-Jan-24 16:52 set and unset terminal for binary output 41347 subttl set and unset terminal for binary output 41348 41349 ; Put TTY in binary mode for output only. Still allows normal input, 41350 ; ^C trapping, etc. 41351 41352 000657'01 ttyob: entry ttyob ; Used by k20ioc 41353 000657'01 201 01 0 00 000101 movei t1, .priou ; Get CCOC words 41354 000660'01 104 00 0 00 000112 RFCOC 41355 000661'01 124 02 0 00 000000# dmovem t2, myccoc ; Save em. 41356 dmove t2,[525252525252 ;[194] Make all characters output 41357 000662'01 120 02 0 00 004243' 525252525000] ;[194] with no translation. 41358 000663'01 104 00 0 00 000113 SFCOC 41359 000664'01 201 02 0 00 000044 movei t2, .morxo ; Get tty pause-end-of-page status. 41360 000665'01 104 00 0 00 000077 MTOPR% 41361 000666'01 320 12 0 00 000670' %jserr (,) 41362 000667'01 254 00 0 00 000673' 41363 000670'01 265 01 0 00 000257' 41364 000671'01 000000 000000 41365 000672'01 254 00 0 00 000673' 41366 000673'01 202 03 0 00 000000# movem t3, ttpau ; Save it. 41367 dmove t2, [ .moxof ; Set the terminal pause on command 41368 000674'01 120 02 0 00 004245' .mooff ] ; to no pause on command 41369 000675'01 104 00 0 00 000077 MTOPR% 41370 000676'01 320 12 0 00 000700' %jserr (,) 41371 000677'01 254 00 0 00 000703' 41372 000700'01 265 01 0 00 000257' 41373 000701'01 000000 000000 41374 000702'01 254 00 0 00 000703' 41375 000703'01 263 17 0 00 000000 ret 41376 41377 41378 ; Restore TTY output to condition before TTYOB was called. 41379 41380 000704'01 ttyou: entry ttyou ; Used by k20ioc 41381 000704'01 201 01 0 00 000101 movei t1, .priou ; Restore normal tty output. 41382 000705'01 120 02 0 00 000000# dmove t2, myccoc 41383 000706'01 104 00 0 00 000113 SFCOC 41384 000707'01 320 12 0 00 000711' %jserr (,) 41385 000710'01 254 00 0 00 000714' 41386 000711'01 265 01 0 00 000257' 41387 000712'01 000000 000000 41388 000713'01 254 00 0 00 000714' 41389 000714'01 201 02 0 00 000043 movei t2, .moxof ; Set terminal pause on command 41390 000715'01 200 03 0 00 000000# move t3, ttpau ; to what it used to be. 41391 000716'01 104 00 0 00 000077 MTOPR% 41392 000717'01 320 12 0 00 000721' %jserr (,) 41393 000720'01 254 00 0 00 000724' 41394 000721'01 265 01 0 00 000257' 41395 000722'01 000000 000000 41396 000723'01 254 00 0 00 000724' 41397 000724'01 263 17 0 00 000000 ret 41398 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 16 K20SUB MAC 19-Jan-24 16:52 Save Terminal Characteristics (see following) 41399 subttl Save Terminal Characteristics (see following) 41400 41401 ; Call: 41402 ; 41403 ; t1/ JFN or device or fork handle 41404 ; t2/ Pointer to storage area 41405 ; 41406 ; Return: 41407 ; 41408 ; +1, Not a terminal device or some other significant error 41409 ; +2, Complete Success 41410 ; t3/ Interesting discovery flags 41411 ; 41412 ; Storage will contain as much terminal information as could be 41413 ; reasonably captured. 41414 ; 41415 ; Partially inspired by routines in PA1050 (PAT) which handle setting 41416 ; 'free' CRLF. Called at program startup and also when using another 41417 ; terminal line when running in 'local' mode. 41418 ; 41419 ; 41420 ; N.B., *MUST* be called after INICAP so we can see if we have SC%CTC!! 41421 ; 41422 ; To Do: Maybe check if .priou is .dvpip and don't do this? 41423 41424 000725'01 savtty: entry savtty ; Called from k20mit 41425 000725'01 265 16 0 00 004247' saveac ; Used for loop control and terminal references 41426 000726'01 120 07 0 00 000001 dmove q3, t1 ; Save calling arguments 41427 41428 000727'01 205 03 0 00 400000 movx t3, ts%err ; Assume some kind of failure 41429 000730'01 202 03 0 10 000000 movem t3, $tsflg(q4) ; Store in block 41430 000731'01 202 01 0 10 000001 movem t1, $tsarg(q4) ; Saving calling argument 41431 000732'01 201 03 0 00 601405 movx t3, lstrx1 ; However, we don't have any errors, YET 41432 000733'01 202 03 0 10 000002 movem t3, $tserr(q4) ; So don't assume 41433 000734'01 260 17 0 00 000574' call argtyp ; Determine argument type 41434 000735'01 263 17 0 00 000000 ret ; Failed, don't know what it is 41435 41436 000736'01 437 01 0 10 000000 orb t1, $tsflg(q4) ; Save and use the determined type 41437 000737'01 200 05 0 00 000001 move q1, t1 ; Also keep current flags in a fast place 41438 41439 000740'01 607 05 0 00 100000 ifxn. q1, ts%pro ; Was this primary output? 41440 000741'01 254 00 0 00 000744' 41441 000742'01 661 05 0 00 040000 txo q1, ts%frk ; Yes, so turn it into a fork handle 41442 000743'01 201 07 0 00 400000 movei q3, .fhslf ; Stomp argument to this process 41443 000744'01 endif. 41444 41445 000744'01 607 05 0 00 040000 ifxn. q1, ts%frk ; Fork (or implied fork)? 41446 000745'01 254 00 0 00 000760' 41447 000746'01 200 01 0 00 000007 move t1, q3 ; Yes, load it 41448 000747'01 104 00 0 00 000206 GPJFN% ; Find out primary JFN's 41449 000750'01 320 12 0 00 000752' ifje. r ; Failed?? 41450 000751'01 254 00 0 00 000756' 41451 000752'01 202 01 0 10 000002 movem t1, $tserr(q4) ;Store the error number 41452 000753'01 474 02 0 00 000000 seto t2, ; Force .cttrm 41453 000754'01 200 03 0 00 000001 move t3, t1 ; Reposition the error k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 16-1 K20SUB MAC 19-Jan-24 16:52 Save Terminal Characteristics (see following) 41454 000755'01 254 00 0 00 000757' else. ; Otherwise, there is no error 41455 000756'01 400 03 0 00 000000 setz t3, ; So state as much 41456 000757'01 endif. ; and carry on 41457 000757'01 254 00 0 00 000762' else. ; Otherwise, not using .priou 41458 000760'01 200 02 0 00 000007 move t2, q3 ; Pretend this is .priou 41459 000761'01 201 03 0 00 601405 movx t3, lstrx1 ; And flag no error differently 41460 000762'01 endif. 41461 000762'01 124 02 0 10 000003 dmovem t2, $gpjfn(q4) ; Store appropriately 41462 41463 000763'01 607 05 0 00 010000 ifxn. q1, ts%dev ; Already had a device designator 41464 000764'01 254 00 0 00 000767' 41465 000765'01 200 01 0 00 000007 move t1, q3 ; Yes, use it 41466 000766'01 254 00 0 00 000770' else. ; Otherwise, maybe GPJFN% got something 41467 000767'01 550 01 0 00 000002 hrrz t1, t2 ; Have a look at whatever the primary is 41468 000770'01 endif. 41469 000770'01 104 00 0 00 000117 DVCHR% ; Get the device characteristics 41470 000771'01 320 12 0 00 000773' ifje. r ; Failed?? 41471 000772'01 254 00 0 00 001000' 41472 000773'01 202 01 0 10 000002 movem t1, $tserr(q4) ; Store the error number 41473 000774'01 200 04 0 00 000001 move t4, t1 ; And also for failure specifics 41474 000775'01 400 01 0 00 000000 setz t1, ; Phoney up an impossible designator 41475 000776'01 477 02 0 00 000003 setob t2, t3 ; Yield impossible results 41476 000777'01 254 00 0 00 001001' else. ; Otherwise, worked 41477 001000'01 400 04 0 00 000000 setz t4, ; Therefore, flag this 41478 001001'01 endif. 41479 001001'01 124 01 0 10 000005 dmovem t1, $dvchr(q4) ; Save results 41480 001002'01 124 03 0 10 000007 dmovem t3, $dvchr+2(q4) ; All of them and error (if any) 41481 001003'01 326 04 0 00 000571* jumpn t4, r ; Can't go any further if failed 41482 ; Otherwise, investigate results 41483 001004'01 135 04 0 00 004223' ldb t4,[pointr t2, dv%typ] ; Pick up the device type 41484 001005'01 302 04 0 00 000012 caie t4, .dvtty ; Ok, is this a terminal? 41485 001006'01 263 17 0 00 000000 ret ; No, the rest makes no sense 41486 001007'01 302 01 0 00 777777 caie t1, .cttrm ; Controlling terminal? 41487 001010'01 254 00 0 00 001014' ifskp. ; Yes, let's fix that up 41488 001011'01 200 01 0 00 000003 move t1, t3 ; Load the device type and line number 41489 001012'01 661 01 0 00 600000 txo t1, (.dvdes) ; Turn on the designator bit 41490 001013'01 202 01 0 10 000005 movem t1, $dvchr(q4) ; Replace saved device designator 41491 001014'01 endif. 41492 001014'01 200 06 0 00 000001 move q2, t1 ; Save device in a fast place 41493 41494 remark t1, ; Finally has terminal device 41495 001015'01 104 00 0 00 000112 RFCOC% ; Get the control word 41496 001016'01 320 12 0 00 001020' ifje. r ; Catch and ignore error 41497 001017'01 254 00 0 00 001025' 41498 001020'01 202 01 0 10 000013 movem t1, $ctcoc+2(q4) ;Save the error 41499 001021'01 202 01 0 10 000002 movem t1, $tserr(q4) ; Store the error here, too 41500 001022'01 477 02 0 00 000003 setob t2, t3 ; Fine, no control character output control 41501 001023'01 200 01 0 00 000006 move t1, q2 ; Reload designator 41502 001024'01 254 00 0 00 001026' else. ; Otherwise worked, which is good 41503 001025'01 402 00 0 10 000013 setzm $ctcoc+2(q4) ; Flag no error 41504 001026'01 endif. 41505 001026'01 124 02 0 10 000011 dmovem t2, $ctcoc(q4) ; Store controlling terminal's COC's 41506 41507 001027'01 104 00 0 00 000107 RFMOD% ; Get the JFN mode word 41508 001030'01 320 12 0 00 001032' ifje. r ; Catch and ignore error k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 16-2 K20SUB MAC 19-Jan-24 16:52 Save Terminal Characteristics (see following) 41509 001031'01 254 00 0 00 001037' 41510 001032'01 202 01 0 10 000002 movem t1, $tserr(q4) ; Store the error number 41511 001033'01 474 02 0 00 000000 seto t2, ; Fine, no mode word 41512 001034'01 200 03 0 00 000001 move t3, t1 ; Reposition error 41513 001035'01 200 01 0 00 000006 move t1, q2 ; Reload designator 41514 001036'01 254 00 0 00 001041' else. ; Otherwise, worked 41515 001037'01 621 02 0 00 400000 txz t2, tt%osp ; Clear Control-O 41516 001040'01 400 03 0 00 000000 setz t3, ; Flag no error 41517 001041'01 endif. 41518 001041'01 124 02 0 10 000014 dmovem t2, $ctmod(q4) ; Store controlling terminal's mode word and error 41519 41520 001042'01 201 05 0 00 000006 movei q1, mtoprl ; Load MTOPR% table length 41521 41522 001043'01 do. ; Enter loop context 41523 001043'01 554 02 0 05 001164' hlrz t2, mtoprt(q1) ; Load function to perform 41524 001044'01 104 00 0 00 000077 MTOPR% ; Read the value 41525 001045'01 320 12 0 00 001047' ifje. r ; Catch and ignore error 41526 001046'01 254 00 0 00 001054' 41527 001047'01 202 01 0 10 000002 movem t1, $tserr(q4) ;Store the error number 41528 001050'01 474 03 0 00 000000 seto t3, ; Fine, no value 41529 001051'01 200 04 0 00 000001 move t4, t1 ; Save for debugger 41530 001052'01 200 01 0 00 000006 move t1, q2 ; Reload designator 41531 001053'01 254 00 0 00 001055' else. ; Otherwise, worked 41532 001054'01 400 04 0 00 000000 setz t4, ; Flag no error 41533 001055'01 endif. 41534 001055'01 550 02 0 05 001164' hrrz t2, mtoprt(q1) ; Load location to store 41535 001056'01 270 02 0 00 000010 add t2, q4 ; Calculate correct address in structure 41536 001057'01 124 03 0 02 000000 dmovem t3, (t2) ; store it somewhere 41537 001060'01 365 05 0 00 001043' sojge q1, top. ; Get the next one 41538 001061'01 enddo. ; Exit loop context 41539 41540 001061'01 201 04 0 00 000004 movx t4, <0,,4> ; Load block header word 41541 001062'01 202 04 0 10 000034 movem t4, $morbm(q4) ; Initialize block 41542 remark t1, ; Still has correct designator 41543 001063'01 201 02 0 00 000037 movx t2, .morbm ; Function is to read break mask 41544 001064'01 201 03 0 10 000034 movei t3, $morbm(q4) ; Resolve address of break mask block 41545 001065'01 104 00 0 00 000077 MTOPR% ; Read the value 41546 001066'01 320 12 0 00 001070' ifje. r ; Catch and ignore error 41547 001067'01 254 00 0 00 001100' 41548 001070'01 200 04 0 00 000001 move t4, t1 ; Save for debugger 41549 001071'01 202 01 0 10 000002 movem t1, $tserr(q4) ; Store the error number 41550 001072'01 477 02 0 00 000003 setob t2, t3 ; Fine, no break mask.. 41551 001073'01 124 02 0 10 000034 dmovem t2, $morbm(q4) ; Stomp header and first break word 41552 001074'01 124 02 0 10 000036 dmovem t2, $morbm+2(q4) ;Stomp second and third break word 41553 001075'01 124 03 0 10 000040 dmovem t3, $morbm+4(q4) ;Stomp fourth break word, store error 41554 001076'01 200 01 0 00 000006 move t1, q2 ; Reload designator 41555 001077'01 254 00 0 00 001101' else. ; Otherwise, worked 41556 001100'01 402 00 0 10 000041 setzm $morbm+5(q4) ; Flag no error 41557 001101'01 endif. 41558 ; Finally set large dimension flags 41559 001101'01 120 02 0 10 000016 dmove t2, $morlw(q4) ; Load the terminal width 41560 001102'01 326 03 0 00 001107' ife. t3 ; Was there any error? 41561 001103'01 307 02 0 00 000177 caig t2, ^d127 ; Exceeded seven bits? 41562 001104'01 254 00 0 00 001107' anskp. ; No, STPAR% will work 41563 001105'01 205 03 0 00 000400 movx t3, ts%lgw ; Load large width flag k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 16-3 K20SUB MAC 19-Jan-24 16:52 Save Terminal Characteristics (see following) 41564 001106'01 436 03 0 10 000000 orm t3, $tsflg(q4) ; Record in the flags word 41565 001107'01 endif. 41566 41567 001107'01 120 02 0 10 000020 dmove t2, $morll(q4) ; Load terminal length 41568 001110'01 326 03 0 00 001115' ife. t3 ; Was there any error? 41569 001111'01 307 02 0 00 000177 caig t2, ^d127 ; Exceeded seven bits? 41570 001112'01 254 00 0 00 001115' anskp. ; No, STPAR% will work 41571 001113'01 205 03 0 00 000200 movx t3, ts%lgl ; Load large length flag 41572 001114'01 436 03 0 10 000000 orm t3, $tsflg(q4) ; Record in the flags word 41573 001115'01 endif. 41574 41575 001115'01 200 04 0 10 000000 move t4, $tsflg(q4) ; Load the current flags so far 41576 001116'01 607 04 0 00 002000 ifxn. t4, ts%efh ; Did we have an explicit fork handle? 41577 001117'01 254 00 0 00 001122' 41578 001120'01 200 05 0 10 000001 move q1, $tsarg(q4) ; Yes, let's use it 41579 001121'01 254 00 0 00 001123' else. ; Otherwise, assume job wide teriminal interrupts 41580 001122'01 201 05 0 00 777773 movei q1, .fhjob ; And use this magic handle 41581 001123'01 endif. 41582 41583 001123'01 200 03 0 00 000000# move t3, mycaps+1 ; Load ENABLED capabilities 41584 001124'01 325 03 0 00 001130' ifxn. t3, sc%ctc ; Did we have ^C? 41585 001125'01 205 03 0 00 001000 movx t3, ts%ctc ; Load that we had sc%ctc 41586 001126'01 437 03 0 10 000000 orb t3, $tsflg(q4) ; Record in the flags word and keep handy 41587 001127'01 254 00 0 00 001131' else. ; Otherwise, don't have it 41588 001130'01 200 03 0 10 000000 move t3, $tsflg(q4) ; So load what we do have 41589 001131'01 endif. 41590 41591 001131'01 302 05 0 00 777773 caie q1, .fhjob ; Are we doing job wide? 41592 001132'01 254 00 0 00 001136' ifskp. ; Yes, so let's see if that is possible 41593 001133'01 603 03 0 00 001000 txne t3, ts%ctc ; Did we have ^C? 41594 001134'01 254 00 0 00 001136' anskp. ; Yes, so STIW% on this will work 41595 001135'01 201 05 0 00 400000 movei q1, .fhslf ; No; just this fork's terminal interrupt word 41596 001136'01 endif. ; End case .fhjob specified (or assumed) 41597 41598 001136'01 200 01 0 00 000005 move t1, q1 ; Load terminal interrupt word context 41599 001137'01 202 01 0 10 000042 movem t1, $tif(q4) ; Store what we are using 41600 001140'01 302 01 0 00 777773 caie t1, .fhjob ; Entire job? 41601 001141'01 254 00 0 00 001144' ifskp. ; It is, so won't be getting differed word 41602 001142'01 400 03 0 00 000000 setz t3, ; So stomp it 41603 001143'01 254 00 0 00 001145' else. ; Otherwise, this is a specific process 41604 001144'01 661 01 0 00 400000 txo t1, rt%dim ; So get differed word, just for fun 41605 001145'01 endif. 41606 41607 001145'01 104 00 0 00 000173 RTIW% ; Finally read the terminal interrupt word 41608 001146'01 320 12 0 00 001150' ifje. r ; Catch and handle the error 41609 001147'01 254 00 0 00 001154' 41610 001150'01 202 01 0 10 000045 movem t1, $tiw+2(q4) ; Save the error 41611 001151'01 202 01 0 10 000002 movem t1, $tserr(q4) ; Store the error here, too 41612 001152'01 403 02 0 00 000003 setzb t2, t3 ; Let's say nothing is set 41613 001153'01 254 00 0 00 001155' else. ; Otherwise worked, which is good 41614 001154'01 402 00 0 10 000045 setzm $tiw+2(q4) ; Flag no error 41615 001155'01 endif. 41616 001155'01 124 02 0 10 000043 dmovem t2, $tiw(q4) ; Store terminal interrupt word (and maybe diferred) 41617 41618 001156'01 200 01 0 10 000002 move t1, $tserr(q4) ; Load last error encountered k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 16-4 K20SUB MAC 19-Jan-24 16:52 Save Terminal Characteristics (see following) 41619 001157'01 302 01 0 00 601405 caie t1, lstrx1 ; Never had any? 41620 001160'01 263 17 0 00 000000 ret ; Fail the call 41621 41622 001161'01 525 03 0 00 377777 movx t3, ^-ts%err ; Load failure bit complement 41623 001162'01 407 03 0 10 000000 andb t3, $tsflg(q4) ; Shut off in flag word 41624 001163'01 254 00 0 00 000655* retskp ; Complete success 41625 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 17 K20SUB MAC 19-Jan-24 16:52 MTOPR% index to structure offset mapping tables 41626 subttl MTOPR% index to structure offset mapping tables 41627 41628 ; Be aware that each pointer is pointing to a double word which 41629 ; holds the value and any error. This is to keep us from restoring 41630 ; a value which was never properly read in the first place and 41631 ; really messing up a possibly already ill terminal. 41632 ; 41633 ; As these are offsets, they are added to an address, which means 41634 ; that the structure can be in any section. 41635 41636 001164'01 000030 000016 mtoprt: .morlw,,$morlw ; Read line width 41637 001165'01 000032 000020 .morll,,$morll ; Read line length 41638 001166'01 000035 000022 .mornt,,$mornt ; Receive system blat 41639 001167'01 000044 000024 .morxo,,$morxo ; Pause end of page 41640 001170'01 000053 000026 .mopcr,,$mopcr ; Read terminal pause and unpause 41641 001171'01 000054 000030 .mortf,,$mortf ; Read other kinds of blat 41642 001172'01 400001 000032 panda < .morlt,,$morlt > ;;Read TVT bits 41643 000006 mtoprl==.-mtoprt-1 ; Calculate table length 41644 41645 001173'01 000031 000016 mtopst: .moslw,,$morlw ; Set line width 41646 001174'01 000033 000020 .mosll,,$morll ; Set line length 41647 001175'01 000034 000022 .mosnt,,$mornt ; Set system blat acceptance 41648 001176'01 000043 000024 .moxof,,$morxo ; Set pause end of page 41649 001177'01 000052 000026 .mopcs,,$mopcr ; Set terminal pause and unpause 41650 001200'01 000055 000030 .mostf,,$mortf ; Set other kinds of blat 41651 001201'01 400002 000032 panda < .moslt,,$morlt > ;;Set TVT bits 41652 000006 mtopsl==.-mtopst-1 ; Calculate table length 41653 41654 ifn , 41655 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 18 K20SUB MAC 19-Jan-24 16:52 Restore Terminal Characteristics 41656 subttl Restore Terminal Characteristics 41657 41658 ; Call: 41659 ; 41660 ; t1/ Takes a pointer to a storage area that was set up by SAVTTY. 41661 ; 41662 ; Restores every parameter that was successfully saved, ignores 41663 ; those that weren't. 41664 ; 41665 ; Return: 41666 ; 41667 ; +1, always 41668 ; 41669 ; t3 has last error, zero if everything restored 41670 ; 41671 ; Terminal characteristics restored or restored mostly. 41672 ; 41673 ; Trashes t1, t2, t3 and t4 41674 ; 41675 ; See above. Do NOT change order of restore because SFMOD%/STPAR% 41676 ; will overwrite the length and width with the wrong things 41677 41678 001202'01 restty: entry restty ; Called from k20mit 41679 001202'01 265 16 0 00 004261' saveac ; Uses plenty more registers... 41680 41681 001203'01 200 05 0 00 000001 move q1, t1 ; Save structure base 41682 001204'01 474 03 0 00 000000 seto t3, ; Assume complete junk 41683 001205'01 332 00 0 05 000010 skipe $dvchr+3(q1) ; Did we ever get a device? 41684 001206'01 263 17 0 00 000000 ret ; No, no way we can restore anything 41685 001207'01 200 06 0 05 000005 move q2, $dvchr(q1) ; Yes, use the device for everything 41686 001210'01 200 01 0 00 000006 move t1, q2 ; Load for JSYi 41687 001211'01 400 07 0 00 000000 setz q3, ; Let's assume everything works 41688 41689 001212'01 332 00 0 05 000013 ifme. $ctcoc+2(q1) ; Did the RFCOC% work 41690 001213'01 254 00 0 00 001222' 41691 001214'01 120 02 0 05 000011 dmove t2, $ctcoc(q1) ; Yes, load controlling terminal's COC's 41692 001215'01 104 00 0 00 000113 SFCOC% ; Put them back 41693 001216'01 320 12 0 00 001220' ifje. r ; Failed?? 41694 001217'01 254 00 0 00 001222' 41695 001220'01 200 07 0 00 000001 move q3, t1 ; Remember that something failed 41696 001221'01 200 01 0 00 000006 move t1, q2 ; Reload designator 41697 001222'01 endif. ; End case SFCOC% failure handling 41698 001222'01 endif. ; End case SFCOC% restore decision 41699 41700 001222'01 332 00 0 05 000015 ifme. $ctmod+1(q1) ; Did RFMOD% work? 41701 001223'01 254 00 0 00 001237' 41702 001224'01 200 02 0 05 000014 move t2, $ctmod(q1) ; Yes, load those bits 41703 001225'01 104 00 0 00 000110 SFMOD% ; Set 'program related' bits 41704 001226'01 320 12 0 00 001230' ifje. r ; Failed?? 41705 001227'01 254 00 0 00 001232' 41706 001230'01 200 07 0 00 000001 move q3, t1 ; Remember that something failed 41707 001231'01 200 01 0 00 000006 move t1, q2 ; Reload designator 41708 001232'01 endif. ; End SFMOD% error handling 41709 001232'01 104 00 0 00 000217 STPAR% ; Set 'mechanical' bits 41710 001233'01 320 12 0 00 001235' ifje. r ; Failed?? k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 18-1 K20SUB MAC 19-Jan-24 16:52 Restore Terminal Characteristics 41711 001234'01 254 00 0 00 001237' 41712 001235'01 200 07 0 00 000001 move q3, t1 ; Remember that something failed 41713 001236'01 200 01 0 00 000006 move t1, q2 ; Reload designator 41714 001237'01 endif. ; End STPAR% error handling 41715 001237'01 endif. ; End mode word restore decision 41716 41717 001237'01 201 10 0 00 000006 movei q4, mtopsl ; Load MTOPR% table length 41718 41719 001240'01 do. ; Enter loop context 41720 001240'01 550 11 0 10 001173' hrrz p1, mtopst(q4) ; Load pointer to stored value offset 41721 001241'01 270 11 0 00 000005 add p1, q1 ; Add in base of table 41722 001242'01 120 03 0 11 000000 dmove t3, (p1) ; Load value and error condition 41723 001243'01 326 04 0 00 001252' ife. t4 ; If no error, then try setting 41724 001244'01 554 02 0 10 001173' hlrz t2, mtopst(q4) ; Load this value's MTOPR% set index 41725 001245'01 104 00 0 00 000077 MTOPR% ; Try setting the value 41726 001246'01 320 12 0 00 001250' ifje. r ; Failed?? 41727 001247'01 254 00 0 00 001252' 41728 001250'01 200 07 0 00 000001 move q3, t1 ; Remember that something failed 41729 001251'01 200 01 0 00 000006 move t1, q2 ; Reload designator 41730 001252'01 endif. ; End MTOPR% error handling 41731 001252'01 endif. ; End MTOPR% restore decision 41732 001252'01 365 10 0 00 001240' sojge q4, top. ; Get the next one 41733 001253'01 enddo. ; Exit loop context 41734 41735 001253'01 332 00 0 05 000041 ifme. $morbm+5(q1) ; Did the read mask work? 41736 001254'01 254 00 0 00 001264' 41737 001255'01 201 02 0 00 000040 movx t2, .mosbm ; Function to set break mask 41738 001256'01 201 03 0 05 000034 movei t3, $morbm(q1) ; Address of four word block to load from 41739 001257'01 104 00 0 00 000077 MTOPR% ; Set the value 41740 001260'01 320 12 0 00 001262' ifje. r ; Failed?? 41741 001261'01 254 00 0 00 001264' 41742 001262'01 200 07 0 00 000001 move q3, t1 ; Remember that something failed 41743 001263'01 200 01 0 00 000006 move t1, q2 ; Reload designator 41744 001264'01 endif. ; End case MTOPR% failure handling 41745 001264'01 endif. ; End case break mask restore decision 41746 41747 001264'01 332 00 0 05 000045 ifme. $tiw+2(q1) ; Were we able to get the terminal interrupt word? 41748 001265'01 254 00 0 00 001274' 41749 001266'01 120 01 0 05 000042 dmove t1, $tif(q1) ; Yes, load context and mask 41750 001267'01 104 00 0 00 000174 STIW% ; Restore somebody's terminal interrupt word 41751 001270'01 320 12 0 00 001272' ifje. r ; Failed?? 41752 001271'01 254 00 0 00 001274' 41753 001272'01 200 07 0 00 000001 move q3, t1 ; Remember that something failed 41754 001273'01 200 01 0 00 000006 move t1, q2 ; Reload designator 41755 001274'01 endif. ; End case STIW% failure handling 41756 001274'01 endif. ; End case STIW% decision 41757 41758 001274'01 200 03 0 00 000007 move t3, q3 ; Has any errors 41759 001275'01 263 17 0 00 000000 ret ; Finally get out of here 41760 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 19 K20SUB MAC 19-Jan-24 16:52 Set Up Local Terminal for Kermit usage 41761 subttl Set Up Local Terminal for Kermit usage 41762 41763 001276'01 setty: entry setty ;[220] Invoked by k20mit 41764 001276'01 260 17 0 00 000000* call udjinf ;[220] Get and update current job information 41765 001277'01 335 04 0 00 000000# skipge t4,jobtab+.jitno ;[220] Load and check current terminal number 41766 001300'01 334 01 0 00 000000# ermsg% (,halt) ;[220] 41767 001301'01 254 00 0 00 001305' 41768 001302'01 202 01 0 00 000140* 41769 001303'01 104 00 0 00 000313 41770 001304'01 254 00 0 00 000000* 41771 000002'03 000000000000# 41772 000000'04 113 105 122 115 111 41773 41774 001305'01 202 04 0 00 000000* movem t4, mytty ;[184] stomp in a possible new line 41775 41776 001306'01 200 01 0 00 000004 move t1, t4 ;[186] Pass in possible new terminal line 41777 001307'01 505 01 0 00 600012 hrli t1,.dvdes!.dvtty ;[186] Turn into a device designator 41778 001310'01 201 02 0 00 000000* movei t2, svstt ;[186] Point to saved start up terminal area 41779 001311'01 260 17 0 00 000725' call savtty ;[186] Save terminal characteristics again 41780 001312'01 334 01 0 00 000000# ermsg% (,halt) ;[186] 41781 001313'01 254 00 0 00 001317' 41782 001314'01 202 01 0 00 001302* 41783 001315'01 104 00 0 00 000313 41784 001316'01 254 00 0 00 001304* 41785 000003'03 000000000000# 41786 000016'04 113 105 122 115 111 41787 41788 41789 001317'01 201 02 0 00 001310* movei t2, svstt ;[194] Point to populated structure 41790 001320'01 332 00 0 02 000010 ifme. $dvchr+3(t2) ;[194] Any error? 41791 001321'01 254 00 0 00 001324' 41792 001322'01 200 03 0 02 000005 move t3, $dvchr(t2) ;[194] None, use what DVCHR% got 41793 001323'01 254 00 0 00 001325' else. ;[194] Otherwise, have to use something 41794 001324'01 201 03 0 00 000101 movei t3, .priou ;[194] Maybe old reliable will work 41795 001325'01 endif. ;[194] End case determining controlling device 41796 001325'01 202 03 0 00 000000* movem t3, $PRIOU ;[194] Store and hope for the best 41797 41798 001326'01 260 17 0 00 001336' call lcltty ;[194] Get a JFN on local terminal 41799 001327'01 334 00 0 00 000000 %ermsg (,halt) ;[186] 41800 001330'01 254 00 0 00 001334' 41801 001331'01 265 01 0 00 000257' 41802 001332'01 000000000000# 41803 001333'01 254 00 0 00 001316* 41804 000032'04 125 156 141 142 154 41805 001334'01 202 01 0 00 000000* movem t1, ttyjfn ;[194] Store for downstream use 41806 001335'01 263 17 0 00 000000 ret 41807 41808 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 20 K20SUB MAC 19-Jan-24 16:52 Acquire JFN on local terminal 41809 subttl Acquire JFN on local terminal 41810 41811 ; Although has a +1/+2 return, it always returns 41812 ; something, even if it is only .priou or .cttrm 41813 ; 41814 ; t1/ JFN open and ready to use 41815 ; 41816 ; To do: if a pipe, maybe change this and just use it? 41817 ; 41818 ; Also: if we are running as local, then we should close the 41819 ; ttyjfn and replace it with .sigio because we shouldn't 41820 ; be diddling the local terminal. 41821 41822 001336'01 lcltty: extern ttyjfn ; In k20mit 41823 001336'01 265 16 0 00 004224' saveac ; Copy of possible open JFN 41824 41825 001337'01 476 00 0 00 000000# setom lcltte ; Whack the error block to detached job 41826 001340'01 200 01 0 00 004275' move t1, [lcltte,,lcltte+1] 41827 001341'01 251 01 0 00 000000# blt t1, lcltef ; The entire block 41828 41829 001342'01 337 05 0 00 001334* skipg q1, ttyjfn ; First, is there something already available? 41830 001343'01 254 00 0 00 001374' jrst getlcl ; Evidently not; let's get a JFN 41831 41832 001344'01 200 01 0 00 000005 move t1, q1 ; Load it for the JSYS to investigate 41833 001345'01 104 00 0 00 000024 GTSTS% ; Let's have a look see 41834 001346'01 320 12 0 00 001350' ifje. r ; Looks like it's defunct, somehow 41835 001347'01 254 00 0 00 001353' 41836 001350'01 202 01 0 00 000000# movem t1, lcltte ; Store the error 41837 001351'01 200 01 0 00 000005 move t1, q1 ; Reload the JFN (or whatever it was) 41838 001352'01 400 02 0 00 000000 setz t2, ; Whack the status 41839 001353'01 endif. 41840 41841 001353'01 641 02 0 00 400200 txc t2,gs%nam!gs%opn ; Complement the required bits 41842 001354'01 643 02 0 00 400200 txce t2,gs%nam!gs%opn ; Is it any good at and is it open? 41843 001355'01 254 00 0 00 001374' jrst getlcl ; No, then go get a JFN 41844 001356'01 607 02 0 00 000400 ifxn. t2,gs%err ; Any kind of error? 41845 001357'01 254 00 0 00 001373' 41846 001360'01 505 01 0 00 004000 hrli t1, (cz%abt) ; Abort the JFN 41847 001361'01 104 00 0 00 000022 CLOSF% ; Try to junk it 41848 001362'01 320 12 0 00 001364' ifje. r ; Failied?? 41849 001363'01 254 00 0 00 001372' 41850 001364'01 202 01 0 00 000000# movem t1, lcltte+1 ; Store the error 41851 001365'01 200 01 0 00 000005 move t1, q1 ; Reload the JFN (or whatever it was) 41852 001366'01 104 00 0 00 000023 RLJFN% ; Just try to let go of it 41853 001367'01 320 12 0 00 001371' ifje. r ; Failied?? 41854 001370'01 254 00 0 00 001372' 41855 001371'01 202 01 0 00 000000# movem t1, lcltte+2 ;Store the error 41856 001372'01 endif. 41857 001372'01 endif. 41858 001372'01 254 00 0 00 001374' jrst getlcl ; Go get a new JFN 41859 001373'01 endif. 41860 001373'01 254 00 0 00 001163* retskp ; Otherwise, get out of here with a JFN 41861 41862 001374'01 getlcl: extern mytty ; Here to get a JFN on the local line 41863 001374'01 402 00 0 00 001342* setzm ttyjfn ; At this point, no JFN anyhow k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 20-1 K20SUB MAC 19-Jan-24 16:52 Acquire JFN on local terminal 41864 001375'01 200 03 0 00 001305* move t3, mytty ; Load my terminal number 41865 001376'01 316 03 0 00 004172' camn t3, [-1] ; Detached?? 41866 001377'01 254 00 0 00 001455' jrst lclerr ; Yes, that will never do.. 41867 001400'01 620 03 0 00 400000 txz t3, .ttdes ; Stomp in case somebody left it on 41868 dmove t1, [-1,,lclnam ; HRROI pointer to place to build name 41869 001401'01 120 01 0 00 004276' .dvdes!.dvtty,,0 ] ; Device designator prototype 41870 001402'01 540 02 0 00 000003 hrr t2, t3 ; My current attached terminal 41871 001403'01 202 02 0 00 000000# movem t2, lcldev ; Store it for later 41872 001404'01 104 00 0 00 000121 DEVST% ; Build the device string 41873 001405'01 320 12 0 00 001407' ifje. r ; Failed?? 41874 001406'01 254 00 0 00 001412' 41875 001407'01 202 01 0 00 000000# movem t1, lcltte+3 ; Save the error 41876 001410'01 254 00 0 00 001455' jrst lclerr ; And give error return 41877 001411'01 254 00 0 00 001415' else. ; Otherwise, worked 41878 001412'01 120 02 0 00 004300' dmove t2, [ exp ":", 0] ; Load final characters 41879 001413'01 136 02 0 00 000001 idpb t2, t1 ; Punctuate the device 41880 001414'01 136 03 0 00 000001 idpb t3, t1 ; Tie off the device string 41881 001415'01 endif. 41882 41883 dmove t1, [ gj%sht!gj%flg ; Want flags 41884 001415'01 120 01 0 00 004302' -1,,lclnam ] ; Point to constructed device name 41885 001416'01 104 00 0 00 000020 GTJFN% ; Try to get a handle 41886 001417'01 320 12 0 00 001421' ifje. r ; Can't on our own silly TTY?? 41887 001420'01 254 00 0 00 001432' 41888 001421'01 202 01 0 00 000000# movem t1, lcltte+4 ; Sigh ... 41889 dmove t1, [ASCIZ /TTY:/ ; Try generic case 41890 001422'01 120 01 0 00 004304' 0 ] ; Certainly null terminated 41891 001423'01 124 01 0 00 000000# dmovem t1, lclnam ; Drop that in 41892 dmove t1, [ gj%sht!gj%flg ; Want flags 41893 001424'01 120 01 0 00 004306' -1,,lclnam ] ; Point to constructed device name 41894 001425'01 104 00 0 00 000020 GTJFN% ; Try to get a handle 41895 001426'01 320 12 0 00 001430' ifje. r ; Failed?? 41896 001427'01 254 00 0 00 001432' 41897 001430'01 202 01 0 00 000000# movem t1, lcltte+5 ; Sigh ... 41898 001431'01 254 00 0 00 001455' jrst lclerr ; Go do general error exit 41899 001432'01 endif. ; End failure recovery failing .. 41900 001432'01 endif. ; End GTJFN% failure analysis and recovery 41901 41902 001432'01 552 01 0 00 000000# hrrzm t1, lcljfn ; Store the JFN 41903 001433'01 512 01 0 00 000000# hllzm t1, lclflg ; And the flags 41904 001434'01 621 01 0 00 777777 tlz t1, -1 ; Don't confuse foolish OPENF% with our flags 41905 remark ; See what fld(.gsimg,of%mod) does here 41906 ; movx t2, fld(8,of%bsz)!of%wr!of%rd ; 8-bit bytes, read & write access. 41907 001435'01 200 02 0 00 004310' movx t2, fld(8,of%bsz)!fld(.gsimg,of%mod)!of%wr!of%rd 41908 001436'01 104 00 0 00 000021 OPENF% ; Finally try to open the silly thing 41909 001437'01 320 12 0 00 001441' ifje. r ; Failed?? 41910 001440'01 254 00 0 00 001452' 41911 001441'01 306 01 0 00 600120 cain t1, opnx1 ; But!! Was error "File already open"? 41912 001442'01 254 00 0 00 001452' anskp. ; That's fine, we can live with that 41913 001443'01 202 01 0 00 000000# movem t1, lcltte+6 ; Otherwise, store the error 41914 001444'01 550 01 0 00 000000# hrrz t1, lcljfn ; Load the JFN 41915 001445'01 104 00 0 00 000023 RLJFN% ; Let go of it 41916 001446'01 320 12 0 00 001450' ifje. r ; Failed?? We just got it! 41917 001447'01 254 00 0 00 001451' 41918 001450'01 202 01 0 00 000000# movem t1, lcltte+7 ; Store that on the way out k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 20-2 K20SUB MAC 19-Jan-24 16:52 Acquire JFN on local terminal 41919 001451'01 endif. ; And carry on with OPENF% error 41920 001451'01 254 00 0 00 001455' jrst lclerr ; And give error return 41921 001452'01 endif. ; End OPENF% failure handling 41922 41923 001452'01 260 17 0 00 001460' call gdswrp ;[223] Call Get Device Status Wrapper 41924 001453'01 550 01 0 00 000000# hrrz t1, lcljfn ;[223] Load the JFN 41925 001454'01 254 00 0 00 001373* retskp ; Won!! 41926 41927 001455'01 lclerr: remark ; Here if something broke 41928 001455'01 403 01 0 00 000000# setzb t1, lcljfn ; No JFN 41929 001456'01 402 00 0 00 000000# setzm lclflg ; No flags 41930 001457'01 263 17 0 00 000000 ret ; Nothing further we can do... 41931 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 21 K20SUB MAC 19-Jan-24 16:52 Wrapper for Get Device Status 41932 subttl Wrapper for Get Device Status 41933 41934 ;[223] Begin code insertion 41935 41936 ; Assumes lcljfn is set 41937 41938 remark ; These externals are in k20net and k20ioc 41939 extern gndpar ; Get Network Device Parity 41940 extern none ; No parity being done 41941 extern even ; Doing even parity 41942 extern parpko ; Doing parity only on packets 41943 extern parrck ; Checking parity on receive 41944 41945 001460'01 550 01 0 00 000000# gdswrp: hrrz t1, lcljfn ; Load local terminal JFN in t1 41946 001461'01 500 01 0 00 000000# hll t1, lclflg ; and its flags 41947 001462'01 260 17 0 00 000000* call gndpar ; Get 'Network' Device Status 41948 001463'01 400 02 0 00 000000 setz t2, ; Falled, assume refuses parity, then 41949 001464'01 606 02 0 00 000001 ifxn. t2, gd%par ; 'Tolerates' parity? 41950 001465'01 254 00 0 00 001475' 41951 001466'01 476 00 0 00 000000# setom lclpar ; Yes, normalize that 41952 001467'01 606 02 0 00 000010 ifxn. t2, mo%par ; Was the thing doing parity anyway 41953 001470'01 254 00 0 00 001473' 41954 001471'01 201 03 0 00 000000* movei t3, even ; Tops-20 itself only generates even parity 41955 001472'01 254 00 0 00 001474' else. ; Otherwise, we're not doing parity 41956 001473'01 201 03 0 00 000000* movei t3, none ; so set it to 'none' 41957 001474'01 endif. ; End case propagating parity 41958 001474'01 254 00 0 00 001477' else. ; Otherwise, doesn't do parity 41959 001475'01 402 00 0 00 000000# setzm lclpar ; So whack the variable 41960 001476'01 201 03 0 00 001473* movei t3, none ; And flag elsewhere to 'none' 41961 001477'01 endif. 41962 41963 001477'01 202 03 0 00 000000* movem t3, parity ; So make sure we're following local terminal parity 41964 001500'01 402 00 0 00 000000* setzm parpko ; Doing parity for terminal and packets 41965 001501'01 402 00 0 00 000000* setzm parrck ; But we're not checking it on receive 41966 41967 001502'01 263 17 0 00 000000 ret ; Done 41968 41969 ;[223] End code insertion 41970 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 22 K20SUB MAC 19-Jan-24 16:52 Restore start up terminal parameters 41971 subttl Restore start up terminal parameters 41972 41973 ; Assumes correct terminal parameters to restore are the start up ones 41974 41975 001503'01 fixtty: entry fixtty ; World callable 41976 extern svstt, tiword ; Found in K20MIT 41977 41978 001503'01 201 01 0 00 001317* movei t1, svstt ; Load pointer to start up terminal parameter block 41979 001504'01 260 17 0 00 001202' call restty ; Restore the whole kit and kaboodle 41980 001505'01 322 03 0 00 001512' ifn. t3 ; Anything not restore properly? 41981 001506'01 334 01 0 00 000000# ermsg% 41982 001507'01 254 00 0 00 001512' 41983 001510'01 202 01 0 00 001314* 41984 001511'01 104 00 0 00 000313 41985 000004'03 000000000000# 41986 000042'04 113 105 122 115 111 41987 41988 001512'01 endif. ; End case double checking 41989 001512'01 200 03 0 00 000000# move t3, mycaps+1 ; Load enabled capabilities 41990 001513'01 325 03 0 00 001516' ifxn. t3, sc%ctc ; Do we have control-C capapbility? 41991 001514'01 201 01 0 00 777773 movx t1, .fhjob ; Yes, then can grab ^C job wide 41992 001515'01 254 00 0 00 001517' else. ; Otherwise, can only do it for our fork 41993 001516'01 201 01 0 00 400000 movei t1, .fhslf ; So make it process wide, instead 41994 001517'01 endif. ; What about the inferior? 41995 41996 001517'01 200 02 0 00 000000* move t2, tiword ; Load the terminal interrupt word 41997 001520'01 104 00 0 00 000174 STIW ; and set it 41998 001521'01 320 12 0 00 001523' %jserr (,) 41999 001522'01 254 00 0 00 001526' 42000 001523'01 265 01 0 00 000257' 42001 001524'01 000000000000# 42002 001525'01 254 00 0 00 001526' 42003 000060'04 146 151 170 164 164 42004 001526'01 263 17 0 00 000000 ret 42005 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 23 K20SUB MAC 19-Jan-24 16:52 Condition local terminal for use as remote 42006 subttl Condition local terminal for use as remote 42007 42008 ;[151] Set up TTY for linking, and open any logging file. 42009 ; 42010 ;[129] Add TT%DUM 42011 42012 000000 $modof==0 ;[194] Bits we want off 42013 004000 $modof==$modof!tt%eco ;[194] Shutting off echoing 42014 004300 $modof==$modof!tt%dam ;[194] Force binary data mode (whacks field flags) 42015 004314 $modof==$modof!tt%dum ;[194] Force full duplex (whacks field flags) 42016 004334 $modof==$modof!tt%lic ;[194] Do not raise lower case on input 42017 104334 $modof==$modof!tt%wkf ;[194] Don't wakeup on formating control chars 42018 144334 $modof==$modof!tt%wkn ;[194] Don't wakeup on non-formatting control chars 42019 164334 $modof==$modof!tt%wkp ;[194] Don't wakeup on punctuation 42020 174334 $modof==$modof!tt%wka ;[194] Don't wakeup on alphanumerics 42021 000177 174334 $modof==$modof!tt%wid ;[194] Infinite width (0) 42022 037777 174334 $modof==$modof!tt%len ;[194] Infinite length (0) 42023 037777 174374 $modof==$modof!tt%uoc ;[194] Do not indicate upper case 42024 42025 001527'01 037777 174374 modoff: $modof ;[194] Store in code psect 42026 .xcref $modof ;[194] Don't need in cross reference 42027 42028 remark ;[194] Don't translate certain control characters 42029 000000 $modon==0 ;[194] Bits we want on 42030 200000 000000 $modon==$modon!tt%mff ;[194] Mechanical formfeed present 42031 300000 000000 $modon==$modon!tt%tab ;[194] Mechanical tab present 42032 340000 000000 $modon==$modon!tt%lca ;[194] Lower case capabilities present 42033 340000 000002 $modon==$modon!tt%pgm ;[194] Assume doing ^S/^Q 42034 42035 001530'01 340000 000002 modon: $modon ;[194] Store in code psect 42036 .xcref $modon ;[194] Don't need in cross reference 42037 42038 001531'01 ttyini: entry ttyini ;[194] Called from main 42039 extern handsh, flow, halt ;[186] Defined in k20mit 42040 001531'01 336 01 0 00 001374* skipn t1, ttyjfn ;[186] If have a terminal JFN, use it 42041 001532'01 334 00 0 00 000000 %ermsg (,halt) ;[186] 42042 001533'01 254 00 0 00 001537' 42043 001534'01 265 01 0 00 000257' 42044 001535'01 000000000000# 42045 001536'01 254 00 0 00 001333* 42046 000072'04 164 164 171 151 156 42047 001537'01 201 04 0 00 001503* movei t4, svstt ;[186] Point to start up terminal parameter block 42048 001540'01 120 02 0 04 000014 dmove t2, $ctmod(t4) ;[186] Load controlling terminal's mode word and error 42049 001541'01 326 03 0 00 001552' ife. t3 ;[186] Don't have it? 42050 001542'01 104 00 0 00 000107 RFMOD% ;[186] See if we can get it now 42051 001543'01 320 12 0 00 001545' %jserr (,r) ;[186] 42052 001544'01 254 00 0 00 001550' 42053 001545'01 265 01 0 00 000257' 42054 001546'01 000000000000# 42055 001547'01 254 00 0 00 001003* 42056 000104'04 164 164 171 151 156 42057 001550'01 400 03 0 00 000000 setz t3, ;[186] Worked?? Oh well, that's strange, but OK 42058 001551'01 124 02 0 04 000014 dmovem t2, $ctmod(t4) ;[186] Store what SAVTTY should have done 42059 001552'01 endif. ;[186] End case loading mode word 42060 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 23-1 K20SUB MAC 19-Jan-24 16:52 Condition local terminal for use as remote 42061 001552'01 420 02 0 00 001527' andcm t2, modoff ;[194] Shut off what we don't want 42062 001553'01 434 02 0 00 001530' or t2, modon ;[194] Or in what we want on 42063 001554'01 336 00 0 00 000000* skipn handsh ;[155] Doing handshake? 42064 001555'01 336 00 0 00 000000* skipn flow ;[155] Doing flow control? 42065 001556'01 620 02 0 00 000002 txz t2, tt%pgm ; Handshake, or no flow - don't do XON/XOFF. 42066 42067 001557'01 104 00 0 00 000110 SFMOD ; Set the bits 42068 001560'01 320 12 0 00 001562' %jserr (,r) 42069 001561'01 254 00 0 00 001565' 42070 001562'01 265 01 0 00 000257' 42071 001563'01 000000000000# 42072 001564'01 254 00 0 00 001547* 42073 000114'04 164 164 171 151 156 42074 001565'01 104 00 0 00 000217 STPAR ; ...and the other bits... 42075 001566'01 320 12 0 00 001570' %jserr (,r) 42076 001567'01 254 00 0 00 001573' 42077 001570'01 265 01 0 00 000257' 42078 001571'01 000000000000# 42079 001572'01 254 00 0 00 001564* 42080 000124'04 164 164 171 151 156 42081 42082 001573'01 201 01 0 00 777773 movx t1, .fhjob ; Turn off ^C, ^O, ^T interrupts for whole job. 42083 001574'01 200 03 0 00 000000# move t3, mycaps+1 ;[185] Load enabled capabilities 42084 001575'01 607 03 0 00 400000 txnn t3, sc%ctc ; Can only do job wide STIW if we do... 42085 001576'01 201 01 0 00 400000 movei t1, .fhslf ;[185] We don't, so process wide 42086 001577'01 104 00 0 00 000173 RTIW 42087 001600'01 320 12 0 00 001602' %jserr (,r) 42088 001601'01 254 00 0 00 001605' 42089 001602'01 265 01 0 00 000257' 42090 001603'01 000000000000# 42091 001604'01 254 00 0 00 001572* 42092 000135'04 164 164 171 151 156 42093 001605'01 202 02 0 00 001517* movem t2, tiword 42094 42095 001606'01 200 04 0 00 004311' movx t4, <1b<.ticcc>!1b<.ticco>!1b<.ticct>> 42096 001607'01 607 03 0 00 400000 txnn t3, sc%ctc 42097 001610'01 200 04 0 00 004312' movx t4, <1b<.ticco>!1b<.ticct>> 42098 001611'01 630 02 0 00 000004 tdz t2, t4 42099 001612'01 104 00 0 00 000174 STIW 42100 001613'01 320 12 0 00 001615' %jserr (,r) 42101 001614'01 254 00 0 00 001620' 42102 001615'01 265 01 0 00 000257' 42103 001616'01 000000000000# 42104 001617'01 254 00 0 00 001604* 42105 000147'04 164 164 171 151 156 42106 001620'01 263 17 0 00 000000 ret 42107 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 24 K20SUB MAC 19-Jan-24 16:52 Force a JFN to close (or try real hard to) 42108 subttl Force a JFN to close (or try real hard to) 42109 42110 ; Call: 42111 ; 42112 ; t1/ JFN to get rid of 42113 ; 42114 ; +1, JFN could not be released 42115 ; t1, t2, t3 have various errors 42116 ; 42117 ; +2, JFN no longer valid 42118 ; 42119 ; This will force just about any kind of JFN to be gotten rid 42120 ; of except for the case of a file that is still mapped. 42121 42122 extern delayf, delay ; Whether we are waiting for anything 42123 42124 001621'01 frclos: entry frclos ; Called from everywhere 42125 001621'01 265 16 0 00 004224' saveac ; Used for a copy of the JFN 42126 001622'01 553 05 0 00 000001 hrrzs q1, t1 ; Save a copy without flags 42127 001623'01 403 02 0 00 000003 setzb t2, t3 ; Let's assume everything is dandy 42128 ; Let's check a few silly cases 42129 001624'01 322 01 0 00 001454* jumpe t1, rskp ; If no JFN, then nothing to do, anyhow 42130 001625'01 306 01 0 00 377777 cain t1, .nulio ; BUT!! Never opened? 42131 001626'01 254 00 0 00 001624* retskp ; That's fine, we're done already 42132 001627'01 306 01 0 00 000101 cain t1, .priou ; How about primary output? 42133 001630'01 254 00 0 00 001626* retskp ; Don't bother closing it as it was never opened 42134 001631'01 306 01 0 00 000100 cain t1, .priin ; Somebody get mixed up? 42135 001632'01 254 00 0 00 001630* retskp ; That's OK, same deal as .priou 42136 001633'01 306 01 0 00 777777 cain t1, .cttrm ; Controlling terminal? 42137 001634'01 254 00 0 00 001632* retskp ; That won't work, either, but it's fine 42138 ; At this point, have to assume a real JFN 42139 001635'01 336 00 0 00 000000* ifmn. delayf ; Use basic delay (if we have one) 42140 001636'01 254 00 0 00 001644' 42141 001637'01 337 02 0 00 000000* skipg t2, delay ; Load and double check milliseconds 42142 001640'01 254 00 0 00 001644' anskp. ; Some kind of gubbish, don't risk it 42143 001641'01 201 01 0 00 001661' movei t1, frclo1 ; If time out, then hit the abort code 42144 001642'01 260 17 0 00 002307' call timeon ; Set the timer 42145 001643'01 550 01 0 00 000005 hrrz t1, q1 ; And reload the JFN 42146 001644'01 endif. ; Either way, hit the CLOSF% 42147 42148 001644'01 104 00 0 00 000022 CLOSF% ; Politely try to close it 42149 001645'01 320 12 0 00 001647' ifje. r ; Catch and store the error 42150 001646'01 254 00 0 00 001655' 42151 001647'01 306 01 0 00 600150 cain t1, desx1 ; Trying to close complete junk? 42152 001650'01 254 00 0 00 001655' anskp. ; Fine, pretend it's closed .. 42153 001651'01 306 01 0 00 600152 cain t1, desx3 ; No JFN anyway? 42154 001652'01 254 00 0 00 001655' anskp. ; That's fine, too; never had anything to do 42155 001653'01 200 02 0 00 000001 move t2, t1 ; Save the error for downstream processing 42156 001654'01 254 00 0 00 001657' else. ; Otherwise it worked 42157 001655'01 260 17 0 00 001677' call frclot ; Clean up any extent timers 42158 001656'01 254 00 0 00 001634* retskp ; and get out of here 42159 001657'01 endif. ; End CLOSF% interpretation 42160 42161 001657'01 306 03 0 00 600160 cain t3, clsx1 ; If error is NOT "File is not open" 42162 001660'01 254 00 0 00 001672' ifskp. ; Then try harder to close it k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 24-1 K20SUB MAC 19-Jan-24 16:52 Force a JFN to close (or try real hard to) 42163 001661'01 550 01 0 00 000005 frclo1: hrrz t1, q1 ; Reload the JFN 42164 001662'01 505 01 0 00 004000 hrli t1,(cz%abt) ; Set the abort bit, clear others 42165 001663'01 104 00 0 00 000022 CLOSF% ; Try to close it, and be rude about it 42166 001664'01 320 12 0 00 001666' ifje. r ; Catch and store error 42167 001665'01 254 00 0 00 001670' 42168 001666'01 200 03 0 00 000001 move t3, t1 ; Move error to 2nd attempt AC 42169 001667'01 254 00 0 00 001672' else. ; Otherwise, being distictly rude about it worked 42170 001670'01 260 17 0 00 001677' call frclot ; Clean up any extent timers 42171 001671'01 254 00 0 00 001656* retskp ; and give a good return 42172 001672'01 endif. ; End case cz%abt analysis 42173 001672'01 endif. ; End case, other than "File is not open" 42174 42175 remark t3, clsx1 ; Might just need to release it 42176 001672'01 550 01 0 00 000005 hrrz t1, q1 ; Load the JFN 42177 001673'01 104 00 0 00 000023 RLJFN% ; So try that 42178 001674'01 320 12 0 00 001677' erjmpr frclot ; Catch error in t1, return +1 from frclot 42179 42180 001675'01 260 17 0 00 001677' call frclot ; Clean up any extent timers 42181 001676'01 254 00 0 00 001671* retskp ; Otherwise, finally won 42182 42183 001677'01 frclot: remark ; Force close timer clean up 42184 001677'01 336 00 0 00 001635* ifmn. delayf ; Did we set a timer? 42185 001700'01 254 00 0 00 001704' 42186 001701'01 337 00 0 00 001637* skipg delay ; Did we *REALLY* set a timer? 42187 001702'01 254 00 0 00 001704' anskp. ; Nope, so that's easy 42188 001703'01 260 17 0 00 002345' call timdel ; Otherwise, whack the timer 42189 001704'01 endif. ; End timer removal decisioning 42190 001704'01 263 17 0 00 000000 ret ; Returns +1, always 42191 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 25 K20SUB MAC 19-Jan-24 16:52 file transfer error post processing 42192 subttl file transfer error post processing 42193 42194 ; Come here to close a partially received file. It will be discarded 42195 ; or kept, depending on setting of ABTFIL, i.e. SET INCOMPLETE (FILE 42196 ; DISPOSTION). 42197 42198 001705'01 giveup: entry giveup ;[213] Moved from K20MIT to fix 42199 extern abtfil ;[213] Whether to discard a partial file 42200 extern local ;[213] Set if talking to a Kermit server 42201 42202 001705'01 336 00 0 00 000000* ifmn. abtfil ;[134] Do we discard or keep? ;[194] 42203 001706'01 254 00 0 00 001723' 42204 001707'01 265 01 0 00 000170' wtlog (, filjfn) ;[233] Keep. 42205 001710'01 000000000000# 42206 001711'01 777777 777753 42207 001712'01 000000000000# 42208 000160'04 111 156 143 157 155 42209 001713'01 336 00 0 00 000000* ifmn. local ;[194] If local, safe to type 42210 001714'01 254 00 0 00 001720' 42211 001715'01 200 01 0 00 000000# txmsg <[keeping partial file]> ;[194] 42212 001716'01 104 00 0 00 000076 42213 001717'01 320 12 0 00 001720' 42214 000005'03 000000000000# 42215 000165'04 133 153 145 145 160 42216 001720'01 endif. 42217 001720'01 260 17 0 00 001754' call rdclos ; Go close as much of it as we have. 42218 ; fails through to wtlog, below 42219 001721'01 254 00 0 00 001723' anskp. ;[194] Discard it if we have some problem. 42220 001722'01 263 17 0 00 000000 ret ; Closed partial file OK. 42221 001723'01 endif. ;[194] 42222 42223 001723'01 265 01 0 00 000170' wtlog (,filjfn) ;[233] Discard. 42224 001724'01 000000000000# 42225 001725'01 777777 777746 42226 001726'01 000000000000# 42227 000172'04 111 156 143 157 155 42228 001727'01 336 00 0 00 001713* ifmn. local ;[194] If local, safe to type 42229 001730'01 254 00 0 00 001734' 42230 001731'01 200 01 0 00 000000# txmsg <[discarding]> ;[194] Say what we're up to. 42231 001732'01 104 00 0 00 000076 42232 001733'01 320 12 0 00 001734' 42233 000006'03 000000000000# 42234 000200'04 133 144 151 163 143 42235 001734'01 endif. ;[194] 42236 001734'01 337 00 0 00 000000* ifmg. filjfn ; Real file? 42237 001735'01 254 00 0 00 001752' 42238 001736'01 260 17 0 00 002066' call unmapo ; Go unmap the file 42239 001737'01 600 00 0 00 000000 nop ; Don't worry if we can't. 42240 001740'01 550 01 0 00 001734* hrrz t1, filjfn ; Clear out any junk from left half. 42241 001741'01 306 01 0 00 377777 cain t1, .nulio ;[193] Just tossing it anyway? 42242 001742'01 254 00 0 00 001752' anskp. ;[193] Yes, so nothing to ditch 42243 001743'01 661 01 0 00 004000 txo t1, cz%abt ; Discarding, so cancel the file. 42244 001744'01 104 00 0 00 000022 CLOSF% ; Close it. 42245 001745'01 320 12 0 00 001747' ifje. r ;[194] 42246 001746'01 254 00 0 00 001752' k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 25-1 K20SUB MAC 19-Jan-24 16:52 file transfer error post processing 42247 001747'01 550 01 0 00 001740* hrrz t1, filjfn ;[194] On any error, 42248 001750'01 104 00 0 00 000023 RLJFN ; at least try to release the JFN. 42249 001751'01 320 12 0 00 001752' erjmpr .+1 ;[194] Catch and ignore error 42250 001752'01 endif. ;[194] End case CLOSF% recovery (we hope) 42251 001752'01 endif. ;[193] End case actual JFN to close 42252 42253 001752'01 402 00 0 00 001747* setzm filjfn ; Say we have no file. 42254 001753'01 263 17 0 00 000000 ret 42255 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 26 K20SUB MAC 19-Jan-24 16:52 Close the output file, update the FDB, etc... 42256 subttl Close the output file, update the FDB, etc... 42257 42258 ; Return +1 on error, +2 on success. 42259 42260 001754'01 rdclos: entry rdclos ;[213] Moved from k20mit 42261 001754'01 265 16 0 00 004233' saveac ;[232] Needs a few extra registers 42262 extern ebtflg ;[213] Set if doing an 8 bit file 42263 extern tbtflg ;[232] Set if forcing a 36 bit file 42264 extern itsfil ;[213] ITS binary format file 42265 42266 001755'01 337 00 0 00 001752* skipg filjfn ;[103] Output was to a real file? 42267 001756'01 254 00 0 00 002064' jrst rdclsz ;[103] No, skip all this. 42268 001757'01 260 17 0 00 002066' call unmapo ; First, clean out the PMAPing page. 42269 001760'01 263 17 0 00 000000 ret ; Oops, failed, pass it along... 42270 42271 ;[232] Calculate values FIRST 42272 42273 001761'01 120 05 0 00 004313' rdclsv: dmove q1,[exp ^d7,^d5] ;[232] Assume ASCII and its packing factor 42274 001762'01 336 00 0 00 000000* skipn itsfil ;[75] ITS binary file? 42275 001763'01 332 00 0 00 000000* skipe ebtflg ; Or eight-bit mode? 42276 001764'01 120 05 0 00 004315' dmove q1,[exp ^d8,^d4];[232] Then load that value 42277 001765'01 332 00 0 00 000000* skipe tbtflg ;[232] Forcing 36 bit mode? 42278 001766'01 120 05 0 00 004317' dmove q1,[exp ^d36,^d5];[232] Assume words and decode factor 42279 42280 001767'01 302 05 0 00 000044 caie q1, ^d36 ;[232] Forcing 36 bit bytes? 42281 001770'01 254 00 0 00 002000' ifskp. ;[232] Yes, tweak that 42282 001771'01 200 03 0 00 000012 move t3, rchr ;[232] Load number of file bytes 42283 001772'01 400 02 0 00 000000 setz t2, ;[232] No high order!!! 42284 001773'01 234 02 0 00 000006 div t2, q2 ;[232] Compute WORDS used 42285 001774'01 302 03 0 00 000000 caie t3, 0 ;[232] Evenly divided? 42286 001775'01 354 06 0 00 000002 aosa q2, t2 ;[232] No, so bump up a word, store and skip 42287 001776'01 200 06 0 00 000002 move q2, t2 ;[232] Otherwise, just store words 42288 001777'01 254 00 0 00 002001' else. ;[232] Otherwise, no calculations needed 42289 002000'01 200 06 0 00 000012 move q2, rchr ;[232] Just load the number of file bytes 42290 002001'01 endif. ;[232] End case 36 bit fix up 42291 42292 ; Now close the file. 42293 42294 002001'01 550 01 0 00 001755* rdclsa: hrrz t1, filjfn ;[193] Get the JFN. 42295 002002'01 306 01 0 00 377777 cain t1, .nulio ;[193] Tossing? 42296 002003'01 254 00 0 00 002031' jrst rdclsc ;[232] Skip all this fdb stuff 42297 002004'01 661 01 0 00 400000 txo t1, co%nrj ;[193] Set flag for not releasing JFN. 42298 002005'01 104 00 0 00 000022 CLOSF% ; Close it. 42299 002006'01 320 14 0 00 002010' %jsker ,r ; Return error. 42300 002007'01 254 00 0 00 002013' 42301 002010'01 265 01 0 00 000035' 42302 002011'01 000000000000# 42303 002012'01 254 00 0 00 001617* 42304 000203'04 103 141 156 047 164 42305 42306 ; Update FDB information with correct byte size and (word) count 42307 42308 002013'01 505 01 0 00 000011 hrli t1, .fbbyv ;[232] Set the byte size, first. 42309 002014'01 540 01 0 00 002001* hrr t1, filjfn 42310 002015'01 660 00 0 00 000001 txo, t1, k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 26-1 K20SUB MAC 19-Jan-24 16:52 Close the output file, update the FDB, etc... 42311 002016'01 400000 000000 cf%nud ;[232] Don't update disk yet. 42312 002017'01 205 02 0 00 007700 movx t2, fb%bsz ; Byte size field mask. 42313 002020'01 137 05 0 00 004321' dpb q1,[pointr(t3,fb%bsz)] ;[232] Put in proper place 42314 002021'01 104 00 0 00 000064 CHFDB% 42315 002022'01 320 14 0 00 002023' erjmps .+1 ; Keep going if we get an error. 42316 42317 002023'01 505 01 0 00 000012 hrli t1, .fbsiz ; OK, now fix FDB. Set the number of bytes 42318 002024'01 540 01 0 00 002014* hrr t1, filjfn ; Move in the JFN. 42319 002025'01 474 02 0 00 000000 seto t2, ; Change all bits in the word. 42320 002026'01 200 03 0 00 000006 move t3, q2 ;[232] The number of bytes (or words) in the file. 42321 002027'01 104 00 0 00 000064 CHFDB% ;[232] This time, update the FDB 42322 002030'01 320 14 0 00 002031' erjmps .+1 ; Keep going if we get an error. 42323 42324 ;[126] Take care of any transaction logging. 42325 42326 002031'01 333 00 0 00 002024* rdclsc: skiple filjfn ;[193] Real file? 42327 002032'01 337 01 0 00 000176* skipg t1, tlgjfn ; Transaction log? 42328 002033'01 254 00 0 00 002052' jrst rdclsd ;[232] No, skip this. 42329 42330 002034'01 120 02 0 00 000000# smsg (< Written: >) ; Yes, log this info. 42331 002035'01 260 17 0 00 000311' 42332 000007'03 000000000000# 42333 000010'03 777777 777764 42334 000207'04 040 040 040 127 162 42335 002036'01 200 02 0 00 000006 move t2, q2 ;[232] Load the byte count 42336 002037'01 201 03 0 00 000012 movei t3, ^d10 42337 002040'01 104 00 0 00 000224 NOUT 42338 002041'01 320 14 0 00 002042' erjmps .+1 42339 002042'01 201 02 0 00 000040 movei t2, .chspc ;[194] A space 42340 002043'01 104 00 0 00 000051 BOUT 42341 002044'01 320 14 0 00 002045' erjmps .+1 42342 002045'01 200 02 0 00 000005 move t2, q1 ;[232] Load byte size 42343 002046'01 104 00 0 00 000224 NOUT 42344 002047'01 320 14 0 00 002050' erjmps .+1 42345 smsg (<-bit bytes 42346 002050'01 120 02 0 00 000000# >) 42347 002051'01 260 17 0 00 000311' 42348 000011'03 000000000000# 42349 000012'03 777777 777764 42350 000212'04 055 142 151 164 040 42351 42352 42353 ; Finish closing the output file by releasing its JFN. 42354 42355 002052'01 337 00 0 00 002031* rdclsd: skipg filjfn ;[126] ;[194] 42356 002053'01 254 00 0 00 002060' ifskp. ;[194] File was open 42357 002054'01 265 01 0 00 000170' wtlog (,filjfn) ;[233] Transaction log message. 42358 002055'01 000000000000# 42359 002056'01 777777 777771 42360 002057'01 000000000000# 42361 000215'04 103 154 157 163 145 42362 002060'01 endif. ;[194] 42363 002060'01 550 01 0 00 002052* hrrz t1, filjfn ; Release the JFN. 42364 002061'01 302 01 0 00 377777 caie t1, .nulio ;[193] Nothing to release 42365 002062'01 104 00 0 00 000023 RLJFN% k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 26-2 K20SUB MAC 19-Jan-24 16:52 Close the output file, update the FDB, etc... 42366 002063'01 600 00 0 00 000000 nop 42367 42368 002064'01 402 00 0 00 002060* rdclsz: setzm filjfn ; Say we have no more file. 42369 002065'01 254 00 0 00 001676* retskp 42370 42371 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 27 K20SUB MAC 19-Jan-24 16:52 Clean up the file mapping page for an output file. 42372 subttl Clean up the file mapping page for an output file. 42373 42374 ; Returns +1 on failure, +2 on success. 42375 ; On failure, an error packet is sent, which cancels the transfer. 42376 ; 42377 ; Uses t1,t2,t3. 42378 ; 42379 ; Note that unmapping the memory page also makes it disappear. The 42380 ; next write to the page will create a fresh page with all 0's. 42381 ; 42382 ; The trick at the beginning catches the case where the page has 42383 ; already been unmapped because we just filled in the last byte. 42384 ; Since this routine is called both by the page filler (PUTCH) and by 42385 ; the file closer (RDCLOS, to catch a final partial page), we must 42386 ; worry about files that end on a page boundary. 42387 ; 42388 ; Putting an ERJMP after any instruction that references memory will 42389 ; catch "illegal memory read" errors, and will thus prevent us from 42390 ; attempting to unmap a page that has already been unmapped and still 42391 ; has not been written into. 42392 42393 002066'01 unmapo: entry unmapo ;[213] Moved from k20mit 42394 extern pagno ;[213] Present page number in file 42395 42396 002066'01 200 01 0 00 007000 move t1, maporg ;[190] Has the page been used at all? 42397 002067'01 320 14 0 00 002065* erjmps rskp ;[213] No, done. 42398 42399 002070'01 200 01 0 00 004322' movx t1, <.fhslf,,mappag> ; Yes, map them out, our fork,,mapping page 42400 002071'01 514 02 0 00 002064* hrlz t2, filjfn ;[193] file JFN,,... 42401 002072'01 312 02 0 00 004323' came t2,[ (.nulio) ] ;[193] Just dumping it? 42402 002073'01 254 00 0 00 002076' ifskp. ;[193] Yes, so just pitch the memory 42403 002074'01 260 17 0 00 002116' call unmapa ;[213] Unmap and abort 42404 002075'01 254 00 0 00 002067* retskp ;[193] Nothing further to do 42405 002076'01 endif. ;[193] End case cleaning up a NUL: transfer 42406 42407 remark ;[193] Otherwise, had a real file mapped 42408 002076'01 326 12 0 00 002101' ife. rchr ;[213] But!! Did we ever get any data? 42409 002077'01 260 17 0 00 002116' call unmapa ;[213] Unmap and abort 42410 002100'01 254 00 0 00 002075* retskp ;[213] That was easy enough; we're done 42411 002101'01 endif. ;[213] Otherwise, non-zero file 42412 42413 002101'01 540 02 0 00 000000* hrr t2, pagno ; ...page file page number. 42414 002102'01 205 03 0 00 140000 movx t3, pm%rd!pm%wr ; Read and write access. 42415 002103'01 104 00 0 00 000056 PMAP% ; Map it out. 42416 002104'01 320 14 0 00 002106' %jsker (,r) ; Can't - fail. 42417 002105'01 254 00 0 00 002111' 42418 002106'01 265 01 0 00 000035' 42419 002107'01 000000 000000 42420 002110'01 254 00 0 00 002012* 42421 42422 remark ;[193] This isn't really necessary, but.. 42423 002111'01 550 01 0 00 002071* hrrz t1,filjfn ;[193] Load file JFN 42424 002112'01 200 02 0 00 000012 move t2, rchr ;[193] Load current character count 42425 002113'01 104 00 0 00 000027 SFPTR% ;[193] Show for nosey people on SYSDPY 42426 002114'01 320 12 0 00 002115' erjmpr .+1 ;[193] Ignore any error k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 27-1 K20SUB MAC 19-Jan-24 16:52 Clean up the file mapping page for an output file. 42427 002115'01 254 00 0 00 002100* retskp 42428 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 28 K20SUB MAC 19-Jan-24 16:52 Abort an output page 42429 subttl Abort an output page 42430 42431 ; Used to punt a page instead mapping out to disk 42432 ; 42433 ; t1/ fork handle,,page number 42434 ; 42435 ; Typically .fhslf,,file mapping page 42436 ; 42437 ; Returns +1, always 42438 42439 002116'01 unmapa: remark t1, <.fhslf,,mappag> ;[213] Our expectations 42440 002116'01 200 02 0 00 000001 move t2, t1 ;[213] For Case IV, destination is process memory 42441 002117'01 474 01 0 00 000000 seto t1, ;[213] Which we will be whacking 42442 002120'01 400 03 0 00 000000 setz t3, ;[213] No flags, no count 42443 002121'01 104 00 0 00 000056 PMAP% ;[213] Kick the page into oblivion 42444 002122'01 320 14 0 00 002124' %jsker (,r) ;[193] Not promising, but ignore 42445 002123'01 254 00 0 00 002127' 42446 002124'01 265 01 0 00 000035' 42447 002125'01 000000000000# 42448 002126'01 254 00 0 00 002110* 42449 000217'04 103 157 165 154 144 42450 002127'01 263 17 0 00 000000 ret ;[213] And return 42451 42452 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 29 K20SUB MAC 19-Jan-24 16:52 Save and restore terminal lengths (a.k.a., heights) and widths. 42453 subttl Save and restore terminal lengths (a.k.a., heights) and widths. 42454 42455 ;[185] Begin code insertion 42456 ;[185] 42457 ;[185] This is necessary because linear dimensions in excess of seven 42458 ;[185] bits (127) can not be stored in the JFN mode word as saved by 42459 ;[185] SFMOD% and restored by STPAR% 42460 ;[185] 42461 ;[185] As these are stored in halfwords, this allows for a maximum of 42462 ;[185] 262,143 for either a width or a length. As this is two decimal 42463 ;[185] orders of magnitude larger than the highest resolution graphics 42464 ;[185] cards (4096 in 2006), we probably don't have to worry about 42465 ;[185] overflowing the field for the next decade or so. None the 42466 ;[185] less, the MTOPR% does return a FULL 36 bit word; so if we ever 42467 ;[185] overflow 18 bits, then we should change this code. 42468 ;[185] 42469 ;[185] Assumes: 42470 ;[185] 42471 ;[185] t1/ Valid terminal JFN (possibly .PRIOU) 42472 ;[185] t2/ Pointer to block to save length and width 42473 ;[185] 42474 ;[185] Preserves the register file and is completely silent about errors. 42475 42476 002130'01 savlnw: entry savlnw ;[183] Globally available 42477 002130'01 265 16 0 00 004324' saveac ;[185] Do not side-effect the register file! 42478 002131'01 120 04 0 00 000001 dmove t4, t1 ;[185] Preserve JFN, dimension block address 42479 ;[185] 42480 002132'01 104 00 0 00 000117 DVCHR% ;[185] What kind of device is this? 42481 002133'01 320 12 0 00 002126* erjmpr r ;[185] it's a bogus device! 42482 002134'01 135 03 0 00 004223' load t3, dv%typ, t2 ;[185] Get device type field 42483 002135'01 302 03 0 00 000012 caie t3, .dvtty ;[185] Is this a terminal? 42484 002136'01 263 17 0 00 000000 ret ;[185] No, better leave it alone 42485 002137'01 200 01 0 00 000004 move t1, t4 ;[185] Restore the JFN 42486 ;[185] Assume infinite (and therefore useless) 42487 002140'01 403 03 0 05 000000 setzb t3, (q1) ;[185] defaults for width and length 42488 002141'01 201 02 0 00 000032 movx t2, .morll ;[185] Return the terminal page length 42489 002142'01 104 00 0 00 000077 MTOPR% ;[185] Which may be over 127 ... 42490 002143'01 320 14 0 00 002145' erjmps .+2 ;[185] Must be a bogus JFN 42491 002144'01 506 03 0 05 000000 hrlm t3, (q1) ;[185] Save length 42492 002145'01 120 02 0 00 004340' dmove t2,[exp .morlw,0] ;[185] Return the terminal page width. 42493 002146'01 104 00 0 00 000077 MTOPR% ;[185] Which may be over 127 ... 42494 002147'01 320 14 0 00 002151' erjmps .+2 ;[185] Must be a bogus JFN 42495 002150'01 542 03 0 05 000000 hrrm t3, (q1) ;[185] Save length 42496 002151'01 263 17 0 00 000000 ret ;[185] Done, restore register file 42497 42498 002152'01 rstlnw: entry rstlnw ;[194] Globally available 42499 002152'01 265 16 0 00 004324' saveac ;[185] Do not side-effect the register file! 42500 002153'01 120 04 0 00 000001 dmove t4, t1 ;[185] Preserve JFN, dimension block address 42501 ;[185] 42502 002154'01 104 00 0 00 000117 DVCHR% ;[185] What kind of device is this? 42503 002155'01 320 12 0 00 002133* erjmpr r ;[185] it's a bogus device! 42504 002156'01 135 03 0 00 004223' load t3, dv%typ, t2 ;[185] Get device type field 42505 002157'01 302 03 0 00 000012 caie t3, .dvtty ;[185] Is this a terminal? 42506 002160'01 263 17 0 00 000000 ret ;[185] No, better leave it alone 42507 002161'01 200 01 0 00 000004 move t1, t4 ;[185] Restore the JFN k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 29-1 K20SUB MAC 19-Jan-24 16:52 Save and restore terminal lengths (a.k.a., heights) and widths. 42508 ;[185] 42509 002162'01 201 02 0 00 000033 movx t2, .mosll ;[185] Set the terminal page length. 42510 002163'01 554 03 0 05 000000 hlrz t3, (q1) ;[185] Load old width 42511 002164'01 302 03 0 00 000000 caie t3, 0 ;[185] Ever get anything? If not, leave 42512 002165'01 104 00 0 00 000077 MTOPR% ;[185] it alone; otherwise restore it 42513 002166'01 320 14 0 00 002167' erjmps .+1 ;[185] Ignore errors, preserve JFN 42514 002167'01 201 02 0 00 000031 movx t2, .moslw ;[185] Set the terminal page width. 42515 002170'01 550 03 0 05 000000 hrrz t3, (q1) ;[185] Load old width 42516 002171'01 302 03 0 00 000000 caie t3, 0 ;[185] Ever get anything? If not, leave 42517 002172'01 104 00 0 00 000077 MTOPR% ;[185] it alone; otherwise restore it 42518 002173'01 320 14 0 00 002174' erjmps .+1 ;[185] Ignore errors, preserve JFN 42519 002174'01 263 17 0 00 000000 ret ;[185] Done, restore register file 42520 42521 ;[185] End code insertion 42522 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 30 K20SUB MAC 19-Jan-24 16:52 interrupt storage (pure) 42523 subttl interrupt storage (pure) 42524 42525 extern frtrap ;[186] Is in K20NET 42526 emacro < 42527 extern sitrap ;[203] .sigio check is in K20MAC 42528 > 42529 42530 002175'01 000000000000# levtab: pc1 42531 002176'01 000000000000# pc2 42532 002177'01 000000000000# pc3 42533 42534 000000 chntab: phase 0 42535 000000 000001 002363' tmchan: 1,,tmtrap ;[194] ; Timer trap on channel 0, priority 1. 42536 000001 000001 002730' ccchan: 1,,cctrap ; ^C trap on channel 1, same priority. 42537 000002 000002 002745' cachan: 2,,catrap ; ^A trap on channel 2, lower priority. 42538 000003 000002 003201' cxchan: 2,,cxtrap ; ^X trap on channel 3... 42539 000004 000002 003215' czchan: 2,,cztrap ; ^Z trap .... 4 42540 000005 000002 003226' cmchan: 2,,cmtrap ; ^M trap .... 5 42541 000006 block 1 ; .ICAOV==:6, not trapping arithmetic overflow 42542 000007 block 1 ; .ICFOV==:7, not trapping floating overflow 42543 000010 block 1 ; ^d8, Reserved for Digital 42544 000011 block 1 ; .ICPOV==:9, not trapping PDL overflow 42545 000012 block 1 ; .ICEOF==:10, not trapping End-of-File 42546 000013 block 1 ; .ICDAE==:11, not trapping, Data Error 42547 000014 block 1 ; .ICQTA==:12, not trapping Quota/Disk Exceeded 42548 000015 block 1 ; ^d13, Reserved for Digital 42549 000016 block 1 ; .ICTOD==:14, not trapping Time of Day (not implemented) 42550 000017 block 1 ; .ICILI==:15, not trapping Illegal Instruction 42551 000020 block 1 ; .ICIRD==:16, not trapping Illegal Read 42552 000021 block 1 ; .ICIWR==:17, not trapping Illegal Write 42553 000022 block 1 ; .ICIEX==:18, not trapping Illegal Execute (TENEX only) 42554 emacro < 42555 sigchn: 3,,sitrap ;[203] .ICIFT==:19, multiplexed with .SIGIO 42556 >;;emacro 42557 nmacro < block 1 ; .ICIFT==:19, Inferior Fork Termination 42558 000023 >;;nmacro 42559 000024 block 1 ; .ICMSE==:20, not trapping machine resources exhausted 42560 000025 block 1 ; .ICTRU==:21, not trapping to user (?) 42561 000026 block 1 ; .ICNXP==:22, not trapping nonexistent page referenced 42562 000027 000002 003236' cpchan: 2,,cptrap ; ^P trap on channel 23 42563 000030 000003 000000* frkchn: 3,,frtrap ;[186] Fork interrupt on channel 24 42564 000031 000003 003252' cychan: 3,,cytrap ;[187] ^Y trap on channel 25, level 3 42565 000032 000003 000000* dnchan: 3,,dntrap ;[218] For DECnet connection trap 42566 000033 block ^d36-. 42567 002244'01 dephase 42568 42569 ifn <<.-^d36>-chntab>,< ;;Did we get this right? 42570 printx Channel definitions are wrong 42571 end ;;Just stop and get this fixed 42572 > 42573 intern frkchn ;[186] Used by K20NET 42574 42575 remark bits for certain channels 42576 42577 004000 frkchb==:1b ;[186] Bit for fork channel k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 30-1 K20SUB MAC 19-Jan-24 16:52 interrupt storage (pure) 42578 400000 000000 timchb==:1b ;[186] Bit for TIMER% channel 42579 emacro < 42580 sigchb==:1b ;[203] Bit for macro reparse issues channel 42581 >;;emacro 42582 42583 001000 dnchb==:1b ;[218] Bit for DECnet connection channel 42584 extern dntrap ;[218] DECnet connection handler is in k20net 42585 42586 ;[218] DECnet connect interrupt field (ALL OTHERS MUST BE OFF!!!) 42587 032776 776000 dncfld==:fld(dnchan,mo%cdn)!fld(.mocia,mo%ina)!fld(.mocia,mo%dav) 42588 42589 ;[218] DECnet disconnect interrupt field (EVERYTHING MUST BE OFF!!!) 42590 776776 776000 dndfld==:fld(.mocia,mo%cdn)!fld(.mocia,mo%ina)!fld(.mocia,mo%dav) 42591 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 31 K20SUB MAC 19-Jan-24 16:52 timeit -- Creates a TIMER% to pop after an elapsed time 42592 subttl timeit -- Creates a TIMER% to pop after an elapsed time 42593 42594 ; Set a timer. Call with t1/ Address of where to go upon timout. 42595 ; 42596 ;[212] All timeouts are pre-computed to milliseconds; bums the imuli 42597 ; and allows more granular control which is good for testing 42598 ; 42599 ;[218] Can not pass .infin in t2 (with a hrloi t2, 377777, for 42600 ; example) because the math in .TIMBF (just after TIMDL2: in 42601 ; TIMER.MAC) doesn't come out correctly. Use .TIMAL, instead as 42602 ; this will remove all timers. 42603 ; 42604 ; The fact that it removes a job run time limit need not bother 42605 ; Kermit as Kermit never sets this, it is fork unique and is set 42606 ; directly by BATCON on job creation before Kermit is anywhere 42607 ; near in user memory. 42608 ; 42609 ; N.B., Note the order of the TIMER% and AIC% calls 42610 42611 002244'01 400000 000005 alltim: xwd .fhslf, .timal ;[218] Remove ALL timers for this fork 42612 002245'01 000000 000000 0 ;[219] Just in case it wants this 42613 42614 extern adjtim, ldav ; Moved to K20TIM 42615 42616 002246'01 timeit: entry timeit ; Inform LINK of our location and necessaries 42617 extern stimou, intstk, intpc, timerx, curtim 42618 002246'01 337 00 0 00 000000* skipg stimou ;[43] Doing timeouts? 42619 002247'01 263 17 0 00 000000 ret ;[43] No, skip this. 42620 002250'01 262 17 0 00 000002 pop p, t2 ; Get the return address off the stack. 42621 002251'01 202 17 0 00 000000* movem p, intstk ; Save the stack pointer 42622 002252'01 261 17 0 00 000002 push p, t2 ; Put the return address back 42623 002253'01 540 02 0 00 000001 hrr t2, t1 ; Make interrupt PC point to time out addr. 42624 002254'01 202 02 0 00 000000* movem t2, intpc ; Save the PC. 42625 002255'01 120 01 0 00 002244' dmove t1, alltim ;[218] Remove any previous TIMER%'s, FIRST 42626 002256'01 104 00 0 00 000522 TIMER 42627 002257'01 320 12 0 00 002261' ifje. r ;[194] Catch and ignore error 42628 002260'01 254 00 0 00 002263' 42629 002261'01 202 01 0 00 000000# movem t1, ltimde ;[194] Store last timer delete error 42630 002262'01 350 00 0 00 000000* aos timerx ; Count any error. 42631 002263'01 endif. ;[194] 42632 42633 remark ;[218] THEN set the new timer 42634 002263'01 400 01 0 00 000000 setz t1, ;[130] Get 1-minute load average. 42635 002264'01 260 17 0 00 000000* call ldav ;[130] 42636 002265'01 200 02 0 00 002246* move t2, stimou ;[130] Minimum acceptable. 42637 002266'01 260 17 0 00 000000* call adjtim ;[128] Adjust based on load average. 42638 002267'01 202 02 0 00 000000* movem t2, curtim ;[131] Remember this for reporting. 42639 002270'01 200 01 0 00 004342' move t1, [ .fhslf,,.timel ] ; Our process and time from now. 42640 002271'01 201 03 0 00 000000 movx t3, tmchan ;[218] Load timer channel 42641 002272'01 104 00 0 00 000522 TIMER 42642 002273'01 320 12 0 00 002275' ifje. r ;[194] Catch and ignore error 42643 002274'01 254 00 0 00 002300' 42644 002275'01 202 01 0 00 000000# movem t1, ltimcr ;[194] Store last timer creation error 42645 002276'01 350 00 0 00 002262* aos timerx ; If we get an error, count it. 42646 002277'01 254 00 0 00 002306' else. ;[218] Otherwise, worked k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 31-1 K20SUB MAC 19-Jan-24 16:52 timeit -- Creates a TIMER% to pop after an elapsed time 42647 remark ;[218] So safe to turn on the channel 42648 dmove t1, [ .fhslf ;[218] This fork 42649 002300'01 120 01 0 00 004343' timchb ] ;[218] TIMER% channel 42650 002301'01 104 00 0 00 000131 AIC ; Turn the channel on 42651 002302'01 320 12 0 00 002304' ifje. r ;[194] Catch and ignore error 42652 002303'01 254 00 0 00 002306' 42653 002304'01 202 01 0 00 000000# movem t1, laicer ;[194] However, remember it 42654 002305'01 350 00 0 00 000000# aos aicx ;[194] and count it 42655 002306'01 endif. ;[218] 42656 002306'01 endif. ;[194] 42657 42658 002306'01 263 17 0 00 000000 ret 42659 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 32 K20SUB MAC 19-Jan-24 16:52 timeon - Create a TIMER% to pop after an elapsed time 42660 subttl timeon - Create a TIMER% to pop after an elapsed time 42661 42662 ; Set a timer based in input parameter 42663 ; 42664 ; Call: 42665 ; 42666 ; t1/ Address of where to go upon timout. 42667 ; t2/ Time in milliseconds to wait 42668 ; 42669 ; N.B., All timeouts are pre-computed to milliseconds and these are 42670 ; not load average adjusted because that is the responsibility of 42671 ; the caller. The reason for this is, if you are waiting on a 42672 ; network interupt, then the remote system is the major source of 42673 ; delay, not the local one. 42674 ; 42675 ; Note the order of the TIMER% and AIC% calls 42676 42677 002307'01 timeon: entry timeon ; Inform LINK of our location and necessaries 42678 002307'01 200 04 0 00 000002 move t4, t2 ;[218] Let's just get the wait out of the way 42679 002310'01 262 17 0 00 000002 pop p, t2 ; Get the return address off the stack. 42680 002311'01 202 17 0 00 002251* movem p, intstk ; Save the stack pointer 42681 002312'01 261 17 0 00 000002 push p, t2 ; Put the return address back 42682 002313'01 540 02 0 00 000001 hrr t2, t1 ; Make interrupt PC point to time out addr. 42683 002314'01 202 02 0 00 002254* movem t2, intpc ; Save the PC. 42684 002315'01 120 01 0 00 002244' dmove t1, alltim ;[218] Remove any pending timers, FIRST 42685 002316'01 104 00 0 00 000522 TIMER 42686 002317'01 320 12 0 00 002321' ifje. r ;[194] Catch and ignore error 42687 002320'01 254 00 0 00 002323' 42688 002321'01 202 01 0 00 000000# movem t1, ltimde ;[194] Store last timer delete error 42689 002322'01 350 00 0 00 002276* aos timerx ; Count any error. 42690 002323'01 endif. ;[194] 42691 42692 remark ;[218] THEN set the new timer 42693 002323'01 200 01 0 00 004342' move t1, [.fhslf,,.timel] ; Our process and time from now. 42694 002324'01 200 02 0 00 000004 move t2, t4 ;[218] Load hard wall time 42695 002325'01 201 03 0 00 000000 movx t3, tmchan ;[218] Load timer channel 42696 002326'01 104 00 0 00 000522 TIMER% 42697 002327'01 320 12 0 00 002331' ifje. r ;[194] Catch and ignore error 42698 002330'01 254 00 0 00 002334' 42699 002331'01 202 01 0 00 000000# movem t1, ltimcr ;[194] Store last timer creation error 42700 002332'01 350 00 0 00 002322* aos timerx ; If we get an error, count it. 42701 002333'01 254 00 0 00 002342' else. ;[218] Otherwise, worked 42702 remark ;[218] So safe to turn on the channel 42703 dmove t1, [ .fhslf ;[218] This fork 42704 002334'01 120 01 0 00 004343' timchb ] ;[218] TIMER% channel 42705 002335'01 104 00 0 00 000131 AIC% ; Turn the channel on 42706 002336'01 320 12 0 00 002340' ifje. r ;[194] Catch and ignore error 42707 002337'01 254 00 0 00 002342' 42708 002340'01 202 01 0 00 000000# movem t1, laicer ;[194] However, remember it 42709 002341'01 350 00 0 00 000000# aos aicx ;[194] and count it 42710 002342'01 endif. ;[194] 42711 002342'01 endif. ;[194] 42712 42713 002342'01 263 17 0 00 000000 ret 42714 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 33 K20SUB MAC 19-Jan-24 16:52 TIMOFF - Shut off TIMER channel, clear all timers 42715 subttl TIMOFF - Shut off TIMER channel, clear all timers 42716 42717 ; N.B., Note order of DIC% and TIMER%!! 42718 42719 002343'01 timoff: entry timoff ;[194] Identify our location to LINK 42720 002343'01 337 00 0 00 002265* skipg stimou ;[43] Doing timeouts? 42721 002344'01 263 17 0 00 000000 ret ;[43] No, skip this. 42722 42723 002345'01 timdel: entry timdel ;[218] Force a timer delete 42724 002345'01 265 16 0 00 004345' saveac ; Yes, save these ACs. 42725 dmove t1, [ .fhslf ;[218] This fork 42726 002346'01 120 01 0 00 004343' timchb ] ;[218] TIMER% channel 42727 002347'01 104 00 0 00 000133 DIC% ;[194] Shut off before timer can pop! 42728 002350'01 320 12 0 00 002352' ifje. r ;[194] Catch and ignore error 42729 002351'01 254 00 0 00 002354' 42730 002352'01 202 01 0 00 000000# movem t1, ldicer ;[194] However, remember it 42731 002353'01 350 00 0 00 000000# aos dicx ;[194] and count it 42732 002354'01 endif. ;[194] 42733 002354'01 120 01 0 00 002244' dmove t1, alltim ;[218] Whack any and all pending timers 42734 002355'01 104 00 0 00 000522 TIMER 42735 002356'01 320 12 0 00 002360' ifje. r ;[194] Catch and ignore error 42736 002357'01 254 00 0 00 002362' 42737 002360'01 202 01 0 00 000000# movem t1, ltimde ;[194] Store last timer delete error 42738 002361'01 350 00 0 00 002332* aos timerx ; Count any error. 42739 002362'01 endif. ;[194] 42740 42741 002362'01 263 17 0 00 000000 ret 42742 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 34 K20SUB MAC 19-Jan-24 16:52 caltcb -- Calculate TIMER% channel bit 42743 subttl caltcb -- Calculate TIMER% channel bit 42744 42745 repeat 0,< ;[218] 42746 42747 ; Returns the right bit for the timer channel based on the channel 42748 ; number (which is filled in by LINK) in t2, ready for AIC%/DIC% 42749 42750 Replaced: 42751 42752 skipn t2, tmcbit ; Load the TIMER channel bit 42753 call caltcb ; Unless we don't know it, yet 42754 42755 With: 42756 dmove t1, [ .fhslf ;[218] This fork 42757 timchb ] ;[218] TIMER% channel 42758 42759 caltcb: skipe t2, tmcbit ; Did we already do this? 42760 ret ; Yes, get out of here 42761 42762 saveac ; Save any fork handle 42763 move t1, tmcnum ; Pick up TIMER% channel number 42764 move t2, bitnum(t1) ; Convert to a bit, quickly 42765 movem t2, tmcbit ; Save for later reuse 42766 ret ; Finally done 42767 42768 tmcnum: tmchan ; Timer channel number 42769 42770 thisbt==1b0 ; Start out at bit zero for channel 0 42771 42772 bitnum: intern bitnum ; Also used in k20net 42773 xlist ; No need to see all that blat 42774 repeat ^d36, < ;;Iterate through every possible channel 42775 thisbt ;;Drop in this channel's bit 42776 thisbt== ;;Shift over a bit position 42777 > 42778 list ; Turn listing back on 42779 >;[218] 42780 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 35 K20SUB MAC 19-Jan-24 16:52 TMTRAP -- Timer interrupt handler. 42781 subttl TMTRAP -- Timer interrupt handler. 42782 42783 ; N.B., Using a hrli to break out of a JSYS may not a good idea as it 42784 ; blows away all the flags which somebody might want 42785 42786 002363'01 tmtrap: entry tmtrap ; Identify our location for LINK 42787 extern ntimou ; And our additional necessaries 42788 002363'01 261 17 0 00 000001 push p, t1 ; Get a work AC. 42789 002364'01 200 01 0 00 002314* move t1, intpc ; Get the PC we want. 42790 002365'01 661 01 0 00 010000 txo t1, pc%usr ;[194] ;[132] Set user mode to escape from any jsys. 42791 002366'01 202 01 0 00 000000# movem t1, pc1 ; Restore as if we came from there. 42792 002367'01 262 17 0 00 000001 pop p, t1 42793 002370'01 200 17 0 00 002311* move p, intstk ; Pop any junk off the stack. 42794 002371'01 350 00 0 00 000000* aos ntimou ; Count the timeout. 42795 002372'01 104 00 0 00 000136 DEBRK 42796 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 36 K20SUB MAC 19-Jan-24 16:52 Initialize the Priority Interrupt system. 42797 subttl Initialize the Priority Interrupt system. 42798 42799 002373'01 pinit: entry pinit ;[186] Called at start up 42800 dmove t1, [ .fhslf ; This fork. 42801 002373'01 120 01 0 00 004355' levtab,,chntab] ; Say where our tables are. 42802 002374'01 104 00 0 00 000125 SIR% ;[186] Set Interrupt routines 42803 002375'01 320 12 0 00 002377' %jserr(,) ;[186] Or not 42804 002376'01 254 00 0 00 002402' 42805 002377'01 265 01 0 00 000257' 42806 002400'01 000000 000000 42807 002401'01 254 00 0 00 002402' 42808 002402'01 104 00 0 00 000126 EIR% ; Enable the interrupt system. 42809 002403'01 320 12 0 00 002405' %jserr(,) ;[186] Or not 42810 002404'01 254 00 0 00 002410' 42811 002405'01 265 01 0 00 000257' 42812 002406'01 000000 000000 42813 002407'01 254 00 0 00 002410' 42814 002410'01 263 17 0 00 000000 ret 42815 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 37 K20SUB MAC 19-Jan-24 16:52 Enable for Control-C trapping 42816 subttl Enable for Control-C trapping 42817 42818 ; Turn Control-C trap on. Sets things up so that ^C will return control 42819 ; to the instruction FOLLOWING the the call to this routine, with the 42820 ; stack fixed up appropriately, e.g. 42821 ; 42822 ; call ccon ; Turn on ^C trap 42823 ; jrst foo ; What to do if ^C is typed. 42824 ; move x, y ; Execute this after the call to CCON. 42825 ; 42826 ; Returns +2 always. 42827 ; 42828 ;[187] Rewritten to work under batch and not do so many RPCAP%'s and EPCAP%'s 42829 42830 000002 $ccn==2 ; Number of ^C's to get out of ^C trap. 42831 42832 002411'01 ccon: entry ccon 42833 extern ccfail ;[187] 42834 42835 002411'01 335 00 0 00 000000* ifmge. ccfail ;[187] Ever tried this? 42836 002412'01 254 00 0 00 002415' 42837 002413'01 200 03 0 00 000537* move t3, capas ;[187] We have, so load what we got 42838 002414'01 254 00 0 00 002454' jrst ccon2 ;[187] And just go use it 42839 002415'01 endif. ;[187] End case first time through 42840 42841 002415'01 332 03 0 00 002413* skipe t3, capas ;[187] Did we ever look? 42842 002416'01 254 00 0 00 002454' jrst ccon2 ;[187] We did, use what we got 42843 42844 002417'01 201 01 0 00 400000 movei t1, .fhslf ; Read current process capabilities. 42845 002420'01 104 00 0 00 000150 RPCAP% ;[187] Let's have a peek at what we have 42846 002421'01 320 14 0 00 002423' ifje. s ;[187] Catch and suppress error 42847 002422'01 254 00 0 00 002424' 42848 002423'01 120 02 0 00 000560* dmove t2, mycaps ;[187] Use what we first got 42849 002424'01 endif. ;[187] And carry on! 42850 42851 002424'01 336 00 0 00 000000# ifmn. ;[187] Batch frob? 42852 002425'01 254 00 0 00 002433' 42853 002426'01 621 03 0 00 400000 txz t3, sc%ctc ;[187] Say we don't have ^C turned on 42854 002427'01 621 02 0 00 400000 txz t2, sc%ctc ;[187] And that we can't get it, either 42855 002430'01 350 00 0 00 002411* aos ccfail ;[187] Flag other code to not try again 42856 002431'01 202 03 0 00 002415* movem t3, capas ;[187] Stomp the process enabled capas 42857 002432'01 254 00 0 00 002454' jrst ccon2 ;[187] Skip the rest of this cruft 42858 002433'01 endif. ;[187] End batch job case 42859 ;[187] Normal timesharing job from here 42860 002433'01 325 02 0 00 002445' ifxn. t2, sc%ctc ;[187] OK, so can we turn it on? 42861 002434'01 321 03 0 00 002445' andxe. t3, sc%ctc ;[187] And is it currently *NOT* on? 42862 002435'01 661 03 0 00 400000 txo t3, sc%ctc ;[187] So try to turn it on 42863 002436'01 104 00 0 00 000151 EPCAP% ;[187] and do the request 42864 002437'01 320 14 0 00 002440' erjmps .+1 ;[187] Catch and suppress error 42865 002440'01 104 00 0 00 000150 RPCAP% ;[187] Read back; monitor may silently ignore 42866 002441'01 320 14 0 00 002443' ifje. s ;[187] Catch and suppress error 42867 002442'01 254 00 0 00 002445' 42868 002443'01 120 02 0 00 002423* dmove t2, mycaps ;[187] Use what we first got 42869 002444'01 621 03 0 00 400000 txz t3, sc%ctc ;[187] Don't chance it being on 42870 002445'01 endif. ;[187] And get on with it k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 37-1 K20SUB MAC 19-Jan-24 16:52 Enable for Control-C trapping 42871 002445'01 endif. ;[187] End case possible enabling attempt 42872 42873 002445'01 202 03 0 00 002431* movem t3, capas ; Save them. 42874 002446'01 321 03 0 00 002454' ifxe. t3, sc%ctc ;[187] Did it NOT come on?? 42875 002447'01 352 00 0 00 002430* aose ccfail ;[187] Only complain one single time 42876 002450'01 254 00 0 00 002454' anskp. ;[187] Already tried 42877 txmsg <% Kermit-20: Can't enable ^C capability--use ^G instead 42878 002451'01 200 01 0 00 000000# > ;[187] Complain and advise 42879 002452'01 104 00 0 00 000076 42880 002453'01 320 12 0 00 002454' 42881 000013'03 000000000000# 42882 000225'04 045 040 113 145 162 42883 42884 002454'01 endif. ;[187] End case post enable analysis 42885 42886 002454'01 201 01 0 00 000002 ccon2: movei t1, $ccn ; Initialize ^C count to this. 42887 002455'01 202 01 0 00 000000# movem t1, ccn 42888 002456'01 202 17 0 00 000000# movem p, psave ;[27] Save stack pointer. 42889 002457'01 200 01 0 17 000000 move t1, (p) ;[27] And what it points to... 42890 002460'01 202 01 0 00 000000# movem t1, psave2 ;[27] 42891 dmove t1, [ .fhslf ;[187] Now, for this fork, 42892 002461'01 120 01 0 00 004357' 1b ] ;[187] activate channel 1 (^C channel) 42893 002462'01 104 00 0 00 000131 AIC ; ... 42894 002463'01 320 12 0 00 002465' %jserr (,) ;[187] 42895 002464'01 254 00 0 00 002470' 42896 002465'01 265 01 0 00 000257' 42897 002466'01 000000000000# 42898 002467'01 254 00 0 00 002470' 42899 000241'04 125 156 141 142 154 42900 002470'01 200 01 0 00 004361' move t1, [.ticcc,,1] ;[187] Let's assume we have ^C. 42901 002471'01 607 03 0 00 400000 txnn t3, sc%ctc ;[187] Unless we don't... 42902 002472'01 505 01 0 00 000007 hrli t1,.ticcg ;[187] Something familiar, ding! 42903 002473'01 556 01 0 00 000000# hlrzm t1, ccichr ;[219] Store whatever we picked 42904 002474'01 104 00 0 00 000137 ATI 42905 002475'01 320 12 0 00 002477' %jserr (,) ;[187] 42906 002476'01 254 00 0 00 002502' 42907 002477'01 265 01 0 00 000257' 42908 002500'01 000000000000# 42909 002501'01 254 00 0 00 002502' 42910 000253'04 125 156 141 142 154 42911 002502'01 254 00 0 00 002115* retskp 42912 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 38 K20SUB MAC 19-Jan-24 16:52 Turn Control-C trap off 42913 subttl Turn Control-C trap off 42914 42915 002503'01 ccoff: entry ccoff ;[186] 42916 extern srvflg ;[186] 42917 42918 002503'01 332 00 0 00 000143* skipe srvflg ;[81] Being a server? 42919 002504'01 263 17 0 00 000000 ret ;[81] Yes, so don't turn off the ^C trap. 42920 42921 ; Entry point for REALLY turning it off, even if server. 42922 42923 002505'01 ccoff2: entry ccoff2 ;[186] 42924 002505'01 265 16 0 00 004362' saveac ; Save these. 42925 002506'01 402 00 0 00 000000# setzm ccn ; Put ^C count back to 0. 42926 dmove t1, [ .fhslf ;[186] This fork. 42927 002507'01 120 01 0 00 004357' 1b ] ;[186] Deactivate channel 1. 42928 002510'01 104 00 0 00 000133 DIC 42929 002511'01 320 12 0 00 002513' %jserr (,) ;[187] 42930 002512'01 254 00 0 00 002516' 42931 002513'01 265 01 0 00 000257' 42932 002514'01 000000000000# 42933 002515'01 254 00 0 00 002516' 42934 000265'04 125 156 141 142 154 42935 42936 remark ;[219] Take the character off the channel 42937 002516'01 200 01 0 00 000000# move t1, ccichr ;[219] Load the interrupt character we used 42938 002517'01 104 00 0 00 000140 DTI ;[219] Pull it 42939 002520'01 320 12 0 00 002522' %jserr (,) ;[187] 42940 002521'01 254 00 0 00 002525' 42941 002522'01 265 01 0 00 000257' 42942 002523'01 000000000000# 42943 002524'01 254 00 0 00 002525' 42944 000277'04 125 156 141 142 154 42945 42946 002525'01 200 04 0 00 002445* ccoff3: move t4, capas ; Get capabilities. 42947 002526'01 200 01 0 00 004374' move t1, [rt%dim!.fhjob] ;[219] This job, both masks 42948 002527'01 607 04 0 00 400000 txnn t4, sc%ctc ;[219] But!! Could we have set job wide? 42949 002530'01 200 01 0 00 004375' move t1, [rt%dim!.fhslf] ;[219] This process, both masks 42950 002531'01 104 00 0 00 000173 RTIW% ;[187] Get the current interrupt mask 42951 002532'01 320 12 0 00 002534' %jserr (, r) ;[187] 42952 002533'01 254 00 0 00 002537' 42953 002534'01 265 01 0 00 000257' 42954 002535'01 000000000000# 42955 002536'01 254 00 0 00 002155* 42956 000311'04 125 156 141 142 154 42957 42958 002537'01 325 04 0 00 002543' ifxn. t4, sc%ctc ;[187] Did we have ^C? 42959 002540'01 621 02 0 00 040000 txz t2, 1b<.chcnc> ; for ^C... (^C = ASCII 3 = bit 3) 42960 002541'01 621 03 0 00 040000 txz t3, 1b<.chcnc> ;[219] Differed ^C 42961 002542'01 254 00 0 00 002545' else. ;[187] No, so must be on ^G 42962 002543'01 621 02 0 00 002000 txz t2, 1b<.chbel> ;[187] for ^G... (^G = ASCII 7 = bit 7) 42963 002544'01 621 03 0 00 002000 txz t3, 1b<.chbel> ;[219] Differed ^G 42964 002545'01 endif. ;[187] Finally have something to set 42965 002545'01 104 00 0 00 000174 STIW% ;[187] Finally fix up the interrupt mask 42966 002546'01 320 12 0 00 002550' %jserr (, r) ;[187] 42967 002547'01 254 00 0 00 002553' k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 38-1 K20SUB MAC 19-Jan-24 16:52 Turn Control-C trap off 42968 002550'01 265 01 0 00 000257' 42969 002551'01 000000000000# 42970 002552'01 254 00 0 00 002536* 42971 000322'04 125 156 141 142 154 42972 002553'01 263 17 0 00 000000 ret 42973 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 39 K20SUB MAC 19-Jan-24 16:52 Turn on ^A, ^X, and ^Z interrupts 42974 subttl Turn on ^A, ^X, and ^Z interrupts 42975 42976 ;[59] ^A, ^X, and ^Z interrupt control added as part of edit 59. 42977 42978 002554'01 caxzon: entry caxzon ;[186] 42979 extern caseen, cxseen ;[186] 42980 42981 002554'01 402 00 0 00 000000* setzm cxseen ; Say we haven't seen a ^X yet, 42982 002555'01 402 00 0 00 000000* setzm czseen ; nor a ^Z. 42983 002556'01 402 00 0 00 000000* setzm caseen ; ... 42984 002557'01 336 00 0 00 001727* skipn local ; Only do this if local! 42985 002560'01 263 17 0 00 000000 ret 42986 dmove t1, [ .fhslf ;[194] This fork. 42987 002561'01 120 01 0 00 004376' 1b!1b!1b] ;[194] Turn on the channels. 42988 002562'01 104 00 0 00 000131 AIC% 42989 002563'01 200 01 0 00 004400' move t1, [.ticca,,cachan] ; Put ^A on its channel. 42990 002564'01 104 00 0 00 000137 ATI% 42991 002565'01 200 01 0 00 004401' move t1, [.ticcx,,cxchan] ; Put ^X on its channel. 42992 002566'01 104 00 0 00 000137 ATI% 42993 002567'01 200 01 0 00 004402' move t1, [.ticcz,,czchan] ; And ^Z on its. 42994 002570'01 104 00 0 00 000137 ATI% 42995 002571'01 263 17 0 00 000000 ret 42996 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 40 K20SUB MAC 19-Jan-24 16:52 Turn ^M, ^P interrupts on 42997 subttl Turn ^M, ^P interrupts on 42998 42999 002572'01 cmpon: entry cmpon ;[186] 43000 extern cmseen ;[186] 43001 extern cpseen ;[186] 43002 43003 dmove t1, [ .fhslf ;[194] This fork. 43004 002572'01 120 01 0 00 004403' 1b!1b ] ;[194] These channels. 43005 002573'01 104 00 0 00 000131 AIC ; Activate interrupt system. 43006 002574'01 200 01 0 00 004405' move t1, [.ticcm,,cmchan] ; Assign ^M to this channel. 43007 002575'01 104 00 0 00 000137 ATI 43008 002576'01 402 00 0 00 000000* setzm cmseen 43009 002577'01 200 01 0 00 004406' move t1, [.ticcp,,cpchan] ; Assign ^P to this one. 43010 002600'01 104 00 0 00 000137 ATI 43011 002601'01 402 00 0 00 000000* setzm cpseen 43012 002602'01 263 17 0 00 000000 ret 43013 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 41 K20SUB MAC 19-Jan-24 16:52 Turn ^Y interrupts on 43014 subttl Turn ^Y interrupts on 43015 43016 ;[211] All clrbuf enhancements 43017 43018 002603'01 cyon: entry cyon ; World callable 43019 43020 002603'01 402 00 0 00 000000# setzm cyseen ; Haven't seen a Control-Y, yet 43021 dmove t1, [ .fhslf ; This fork and 43022 002604'01 120 01 0 00 004407' 1b ] ; this channel 43023 002605'01 104 00 0 00 000131 AIC% ; Activate interrupt channel 43024 002606'01 320 12 0 00 002610' %jserr (,r) ; Failed it 43025 002607'01 254 00 0 00 002613' 43026 002610'01 265 01 0 00 000257' 43027 002611'01 000000 000000 43028 002612'01 254 00 0 00 002552* 43029 002613'01 200 01 0 00 004411' move t1, [.ticcy,,cychan] 43030 002614'01 104 00 0 00 000137 ATI% ; Assign ^Y to this channel. 43031 002615'01 320 12 0 00 002617' %jserr (,r) ; Failed that 43032 002616'01 254 00 0 00 002622' 43033 002617'01 265 01 0 00 000257' 43034 002620'01 000000 000000 43035 002621'01 254 00 0 00 002612* 43036 43037 002622'01 254 00 0 00 002502* retskp ; Return success 43038 43039 ;[211] End clrbuf enhancement 43040 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 42 K20SUB MAC 19-Jan-24 16:52 Turn off ^A,^X,^Z interrupts 43041 subttl Turn off ^A,^X,^Z interrupts 43042 43043 002623'01 caxzof: entry caxzof ;[186] 43044 43045 002623'01 402 00 0 00 002554* setzm cxseen ; Turn off the flags 43046 002624'01 402 00 0 00 002555* setzm czseen ; ... 43047 002625'01 402 00 0 00 002556* setzm caseen ; ... 43048 002626'01 336 00 0 00 002557* skipn local ; Nothing to do if remote, the interrupts 43049 002627'01 263 17 0 00 000000 ret ; weren't on anyway. 43050 43051 dmove t1, [ .fhslf ;[186] Turn off ^A,^X,^Z traps. 43052 002630'01 120 01 0 00 004376' 1b!1b!1b ] ;[186] Turn off these channels. 43053 002631'01 104 00 0 00 000133 DIC% ; ... 43054 43055 002632'01 201 01 0 00 000001 movx t1, .ticca ;[219] Pull ^A 43056 002633'01 104 00 0 00 000140 DTI% 43057 002634'01 201 01 0 00 000030 movx t1, .ticcx ;[219] Pull ^X 43058 002635'01 104 00 0 00 000140 DTI% 43059 002636'01 201 01 0 00 000032 movx t1, .ticcz ;[219] Pull ^Z 43060 002637'01 104 00 0 00 000140 DTI% 43061 43062 002640'01 200 01 0 00 004375' move t1, [rt%dim!.fhslf] ;[219] This process, both masks 43063 002641'01 104 00 0 00 000173 RTIW% ; Fix up the interrupt mask for ^A,^X,^Z 43064 002642'01 630 02 0 00 004412' txz t2, <1b<.chcna>!1b<.chcnx>!1b<.chcnz>> ;[194] 43065 002643'01 630 03 0 00 004412' txz t3, <1b<.chcna>!1b<.chcnx>!1b<.chcnz>> ;[194] 43066 002644'01 104 00 0 00 000174 STIW% ; ... 43067 002645'01 320 12 0 00 002647' %jserr (,) 43068 002646'01 254 00 0 00 002652' 43069 002647'01 265 01 0 00 000257' 43070 002650'01 000000 000000 43071 002651'01 254 00 0 00 002652' 43072 002652'01 263 17 0 00 000000 ret 43073 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 43 K20SUB MAC 19-Jan-24 16:52 Turn ^M, ^P interrupts off 43074 subttl Turn ^M, ^P interrupts off 43075 43076 002653'01 cmpoff: entry cmpoff ;[186] 43077 43078 dmove t1, [ .fhslf ; Turn off ^M trap. 43079 002653'01 120 01 0 00 004403' 1b!1b ] ; Turn off channels. 43080 002654'01 104 00 0 00 000133 DIC ; ... 43081 43082 002655'01 402 00 0 00 002576* setzm cmseen ;[219] Indicate that there will 43083 002656'01 402 00 0 00 002601* setzm cpseen ;[219] be no more of these 43084 43085 002657'01 201 01 0 00 000015 movx t1, .ticcm ;[219] Pull ^M 43086 002660'01 104 00 0 00 000140 DTI 43087 002661'01 201 01 0 00 000020 movx t1, .ticcp ;[219] Pull ^P 43088 002662'01 104 00 0 00 000140 DTI 43089 43090 002663'01 200 01 0 00 004375' move t1, [rt%dim!.fhslf] ;[219] This process, both masks 43091 002664'01 104 00 0 00 000173 RTIW ; Fix up the terminal interrupt mask 43092 002665'01 621 02 0 00 000022 txz t2, <1b<.chcrt>!1b<.chcnp>> ;[194] for ^M, ^P 43093 002666'01 621 03 0 00 000022 txz t3, <1b<.chcrt>!1b<.chcnp>> ;[219] Differed ^M, ^P 43094 002667'01 104 00 0 00 000174 STIW 43095 002670'01 320 12 0 00 002672' %jserr (,) 43096 002671'01 254 00 0 00 002675' 43097 002672'01 265 01 0 00 000257' 43098 002673'01 000000 000000 43099 002674'01 254 00 0 00 002675' 43100 002675'01 263 17 0 00 000000 ret 43101 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 44 K20SUB MAC 19-Jan-24 16:52 Turn ^Y interrupt off 43102 subttl Turn ^Y interrupt off 43103 43104 ;[211] Begin clrbuf enhancement 43105 43106 002676'01 cyoff: entry cyoff ; Make globally available (to k20par) 43107 43108 dmove t1, [ .fhslf ; This process 43109 002676'01 120 01 0 00 004407' 1b ] ; The Control-Y channel 43110 002677'01 104 00 0 00 000133 DIC% ; Disable its interrupt channel 43111 002700'01 320 12 0 00 002702' %jserr(,) ; Or not, but carry on 43112 002701'01 254 00 0 00 002705' 43113 002702'01 265 01 0 00 000257' 43114 002703'01 000000 000000 43115 002704'01 254 00 0 00 002705' 43116 43117 002705'01 402 00 0 00 000000# setzm cyseen ; Indicate that there will be no more ^Y's 43118 43119 002706'01 201 01 0 00 000031 movx t1, .ticcy ;[219] Pull ^Y 43120 002707'01 104 00 0 00 000140 DTI% ;[219] Deactivate Terminal Interrupt 43121 43122 002710'01 200 01 0 00 004375' move t1, [rt%dim!.fhslf] ;This process, both masks 43123 002711'01 104 00 0 00 000173 RTIW% ; Read our entire terminal interrupt word 43124 002712'01 320 12 0 00 002714' %jserr(,r) ; Or not... Go no further 43125 002713'01 254 00 0 00 002717' 43126 002714'01 265 01 0 00 000257' 43127 002715'01 000000 000000 43128 002716'01 254 00 0 00 002621* 43129 002717'01 620 02 0 00 002000 txz t2, 1b<.chcny> ; Turn off control-Y from immediate mask 43130 002720'01 620 03 0 00 002000 txz t3, 1b<.chcny> ; Turn off control-Y from differred mask 43131 43132 002721'01 104 00 0 00 000174 STIW% ; Finally get the mask cleared up 43133 002722'01 320 12 0 00 002724' %jserr (,) ; Or not... 43134 002723'01 254 00 0 00 002727' 43135 002724'01 265 01 0 00 000257' 43136 002725'01 000000 000000 43137 002726'01 254 00 0 00 002727' 43138 002727'01 263 17 0 00 000000 ret 43139 43140 ;[211] End clrbuf enhancement 43141 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 45 K20SUB MAC 19-Jan-24 16:52 Control-C trap handler 43142 subttl Control-C trap handler 43143 43144 002730'01 373 00 0 00 000000# cctrap: sosle ccn ; Count the ^C's. 43145 002731'01 104 00 0 00 000136 DEBRK% ; If they haven't typed enough, just resume. 43146 002732'01 260 17 0 00 002343' call timoff ; Turn off any timer. 43147 txmsg <^C 43148 002733'01 200 01 0 00 000000# > ;[186] 43149 002734'01 104 00 0 00 000076 43150 002735'01 320 12 0 00 002736' 43151 000014'03 000000000000# 43152 000333'04 136 103 015 012 000 43153 002736'01 200 17 0 00 000000# move p, psave ;[27] Make sure stack pointer is right. 43154 002737'01 200 01 0 00 000000# move t1, psave2 ;[27] And stack top. 43155 002740'01 202 01 0 17 000000 movem t1, (p) ;[27] 43156 002741'01 661 01 0 00 010000 txo t1, pc%usr ;[187] Don't whack the other flags 43157 002742'01 202 01 0 00 000000# movem t1, pc1 ; Put this place into our PC. 43158 002743'01 262 17 0 00 000001 pop p, t1 ;[80] Don't need it on the stack any more. 43159 002744'01 104 00 0 00 000136 DEBRK% ; Resume where stack pointer points. 43160 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 46 K20SUB MAC 19-Jan-24 16:52 Control-A trap handler 43161 subttl Control-A trap handler 43162 43163 ;[61] Give brief progress report at terminal. 43164 43165 002745'01 catrap: remark ;[186] Lots of status variables in k20mit 43166 extern bctu, bytsiz, rcving, ebqflg 43167 extern rptflg, rptot, rtchr, sptot, stchr 43168 extern pagcnt, files, nnak 43169 43170 002745'01 261 17 0 00 000001 push p, t1 ; Save all ACs we might use. 43171 002746'01 261 17 0 00 000002 push p, t2 43172 002747'01 261 17 0 00 000003 push p, t3 43173 002750'01 336 00 0 00 000000* skipn rcving ; Sending or receiving a file? 43174 002751'01 254 00 0 00 003104' jrst catrp1 ; No. 43175 002752'01 201 01 0 00 000101 movei t1, .priou ; Say the filename 43176 002753'01 337 00 0 00 002750* ifmg. rcving 43177 002754'01 254 00 0 00 002760' 43178 smsg (<^A 43179 002755'01 120 02 0 00 000000# Sending >) ; Yes, one... 43180 002756'01 260 17 0 00 000311' 43181 000015'03 000000000000# 43182 000016'03 777777 777763 43183 000334'04 136 101 015 012 040 43184 002757'01 254 00 0 00 002762' else. 43185 smsg (<^A 43186 002760'01 120 02 0 00 000000# Receiving >) ; ...or the other. 43187 002761'01 260 17 0 00 000311' 43188 000017'03 000000000000# 43189 000020'03 777777 777761 43190 000337'04 136 101 015 012 040 43191 002762'01 endif. 43192 002762'01 201 01 0 00 000101 movei t1, .priou ; Say the filename 43193 002763'01 337 02 0 00 002111* skipg t2, filjfn ;[193] Have file JFN? 43194 002764'01 254 00 0 00 002776' ifskp. ;[193] Yeah, try to say something about it 43195 002765'01 302 02 0 00 377777 caie t2, .nulio ;[193] Dumping it? 43196 002766'01 254 00 0 00 002773' ifskp. ;[193] That's easy! 43197 002767'01 120 02 0 00 000233* dmove t2, nul4 ;[252] Always same name 43198 002770'01 104 00 0 00 000053 SOUT% ;[193] Counted SOUT% is faster 43199 002771'01 320 14 0 00 002772' erjmps .+1 ;[193] 43200 002772'01 254 00 0 00 002776' else. ;[193] Otherwise, do it for real 43201 002773'01 400 03 0 00 000004 setz t3, t4 ;[194] 43202 002774'01 104 00 0 00 000030 JFNS% 43203 002775'01 320 14 0 00 002776' erjmps .+1 ;[193] 43204 002776'01 endif. ;[193] End NUL: special case 43205 002776'01 endif. ;[193] End case file JFN handling 43206 002776'01 200 01 0 00 000000# txmsg <, file bytesize > ; File bytesize 43207 002777'01 104 00 0 00 000076 43208 003000'01 320 12 0 00 003001' 43209 000021'03 000000000000# 43210 000343'04 054 040 146 151 154 43211 003001'01 201 01 0 00 000101 numout bytsiz ;[194] Sets t1 to .priou 43212 003002'01 200 02 0 00 000000* 43213 003003'01 201 03 0 00 000012 43214 003004'01 104 00 0 00 000224 43215 003005'01 320 14 0 00 003006' k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 46-1 K20SUB MAC 19-Jan-24 16:52 Control-A trap handler 43216 003006'01 335 00 0 00 002753* ifmge. rcving ; I/O bytesize, only if sending 43217 003007'01 254 00 0 00 003022' 43218 003010'01 120 02 0 00 000000# dxtext (t2,<, i/o bytesize >) ;[194] 43219 000022'03 000000000000# 43220 000023'03 777777 777761 43221 000347'04 054 040 151 057 157 43222 003011'01 104 00 0 00 000053 SOUT% ;[193] Counted SOUT% is faster 43223 003012'01 320 14 0 00 003013' erjmps .+1 ;[193] 43224 003013'01 201 02 0 00 000007 movei t2, ^d7 ;[194] 43225 003014'01 336 00 0 00 001762* skipn itsfil ;[75] 43226 003015'01 332 00 0 00 001763* skipe ebtflg 43227 003016'01 201 02 0 00 000010 movei t2, ^d8 ;[194] (!!) 43228 003017'01 201 03 0 00 000012 movei t3, ^d10 ;[194] 43229 003020'01 104 00 0 00 000224 NOUT% ;[194] 43230 003021'01 320 14 0 00 003022' erjmps .+1 ;[194] 43231 003022'01 endif. ;[194] 43232 003022'01 561 01 0 00 000303* hrroi t1,crlf ;[194] 43233 003023'01 104 00 0 00 000076 PSOUT% ;[194] 43234 003024'01 336 00 0 00 003014* ifmn. itsfil ;[75] 43235 003025'01 254 00 0 00 003031' 43236 003026'01 200 01 0 00 000000# txmsg < (ITS binary)> ;[75] 43237 003027'01 104 00 0 00 000076 43238 003030'01 320 12 0 00 003031' 43239 000024'03 000000000000# 43240 000353'04 040 050 111 124 123 43241 003031'01 endif. 43242 003031'01 336 00 0 00 000000* ifmn. ebqflg ;[88] 43243 003032'01 254 00 0 00 003036' 43244 003033'01 200 01 0 00 000000# txmsg < (8th-bit prefixing)> ;[88] 43245 003034'01 104 00 0 00 000076 43246 003035'01 320 12 0 00 003036' 43247 000025'03 000000000000# 43248 000356'04 040 050 070 164 150 43249 003036'01 endif. 43250 003036'01 336 00 0 00 000000* ifmn. rptflg ;[92] 43251 003037'01 254 00 0 00 003043' 43252 003040'01 200 01 0 00 000000# txmsg < (compression)> ;[92] 43253 003041'01 104 00 0 00 000076 43254 003042'01 320 12 0 00 003043' 43255 000026'03 000000000000# 43256 000363'04 040 050 143 157 155 43257 003043'01 endif. 43258 43259 003043'01 200 01 0 00 000000# txmsg < (block check type > ;[98] 43260 003044'01 104 00 0 00 000076 43261 003045'01 320 12 0 00 003046' 43262 000027'03 000000000000# 43263 000366'04 040 050 142 154 157 43264 003046'01 201 01 0 00 000101 numout bctu ;[98] 43265 003047'01 200 02 0 00 000000* 43266 003050'01 201 03 0 00 000012 43267 003051'01 104 00 0 00 000224 43268 003052'01 320 14 0 00 003053' 43269 003053'01 201 01 0 00 000051 movei t1, ")" ;[98] 43270 003054'01 104 00 0 00 000074 PBOUT ;[98] k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 46-2 K20SUB MAC 19-Jan-24 16:52 Control-A trap handler 43271 003055'01 337 02 0 00 002763* skipg t2, filjfn ;[193] Have file JFN? 43272 003056'01 254 00 0 00 003104' ifskp. ;[193] Yeah, don't lets say something silly 43273 003057'01 306 02 0 00 377777 cain t2, .nulio ;[193] Are we dumping it? 43274 003060'01 254 00 0 00 003104' anskp. ;[193] We are, so bag this because not PMAP%ing anything 43275 txmsg < 43276 003061'01 200 01 0 00 000000# At page > ; What page we're at. 43277 003062'01 104 00 0 00 000076 43278 003063'01 320 12 0 00 003064' 43279 000030'03 000000000000# 43280 000372'04 015 012 040 101 164 43281 003064'01 200 02 0 00 002101* move t2, pagno 43282 003065'01 350 00 0 00 000002 aos t2 43283 003066'01 201 01 0 00 000101 movei t1, .priou ;[194] 43284 003067'01 201 03 0 00 000012 movei T3, ^d10 ;[194] 43285 003070'01 104 00 0 00 000224 NOUT% 43286 003071'01 320 14 0 00 003072' erjmps .+1 ;[253] Ignore the error so we don't skip 43287 003072'01 335 00 0 00 003006* ifmge. rcving ;[194] Out of how many 43288 003073'01 254 00 0 00 003104' 43289 003074'01 200 01 0 00 000000# txmsg < of > ; (which we know only if we're sending) 43290 003075'01 104 00 0 00 000076 43291 003076'01 320 12 0 00 003077' 43292 000031'03 000000000000# 43293 000375'04 040 157 146 040 000 43294 003077'01 201 01 0 00 000101 numout pagcnt 43295 003100'01 200 02 0 00 000000* 43296 003101'01 201 03 0 00 000012 43297 003102'01 104 00 0 00 000224 43298 003103'01 320 14 0 00 003104' 43299 003104'01 endif. ;[194] 43300 003104'01 endif. ;[194] End case of a file that isn't NUL: 43301 43302 catrp1: txmsg < 43303 003104'01 200 01 0 00 000000# Files: > ; Say how many files, 43304 003105'01 104 00 0 00 000076 43305 003106'01 320 12 0 00 003107' 43306 000032'03 000000000000# 43307 000376'04 015 012 040 106 151 43308 003107'01 201 01 0 00 000101 numout files 43309 003110'01 200 02 0 00 000000* 43310 003111'01 201 03 0 00 000012 43311 003112'01 104 00 0 00 000224 43312 003113'01 320 14 0 00 003114' 43313 003114'01 200 01 0 00 000000# txmsg <, packets: > ; packets, 43314 003115'01 104 00 0 00 000076 43315 003116'01 320 12 0 00 003117' 43316 000033'03 000000000000# 43317 000401'04 054 040 160 141 143 43318 003117'01 337 00 0 00 003072* ifmg. rcving ;[194] Positive means sending ... 43319 003120'01 254 00 0 00 003127' 43320 003121'01 201 01 0 00 000101 numout sptot ;[194] 43321 003122'01 200 02 0 00 000000* 43322 003123'01 201 03 0 00 000012 43323 003124'01 104 00 0 00 000224 43324 003125'01 320 14 0 00 003126' 43325 003126'01 254 00 0 00 003134' else. ;[194] k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 46-3 K20SUB MAC 19-Jan-24 16:52 Control-A trap handler 43326 003127'01 201 01 0 00 000101 numout rptot ;[194] 43327 003130'01 200 02 0 00 000000* 43328 003131'01 201 03 0 00 000012 43329 003132'01 104 00 0 00 000224 43330 003133'01 320 14 0 00 003134' 43331 003134'01 endif. ;[194] 43332 003134'01 200 01 0 00 000000# txmsg <, chars: > ; characters, 43333 003135'01 104 00 0 00 000076 43334 003136'01 320 12 0 00 003137' 43335 000034'03 000000000000# 43336 000404'04 054 040 143 150 141 43337 43338 003137'01 337 00 0 00 003117* ifmg. rcving ;[194] Positive means sending .... 43339 003140'01 254 00 0 00 003144' 43340 003141'01 200 02 0 00 000000* move t2, stchr 43341 003142'01 270 02 0 00 000013 add t2, schr 43342 003143'01 254 00 0 00 003146' else. ;[194] Otherwise, receiving 43343 003144'01 200 02 0 00 000000* move t2, rtchr 43344 003145'01 270 02 0 00 000012 add t2, rchr 43345 003146'01 endif. ;[194] 43346 003146'01 201 01 0 00 000101 movei t1, .priou ;[194] 43347 003147'01 201 03 0 00 000012 movei t3, ^d10 ;[194] 43348 003150'01 104 00 0 00 000224 NOUT% ;[194] 43349 003151'01 320 14 0 00 003152' erjmps .+1 ;[253] Catch and suppress error so we can skip 43350 txmsg < 43351 003152'01 200 01 0 00 000000# NAKs: > ; NAKS & timeouts. 43352 003153'01 104 00 0 00 000076 43353 003154'01 320 12 0 00 003155' 43354 000035'03 000000000000# 43355 000406'04 015 012 040 116 101 43356 003155'01 201 01 0 00 000101 numout nnak 43357 003156'01 200 02 0 00 000000* 43358 003157'01 201 03 0 00 000012 43359 003160'01 104 00 0 00 000224 43360 003161'01 320 14 0 00 003162' 43361 003162'01 200 01 0 00 000000# txmsg <, timeouts: > 43362 003163'01 104 00 0 00 000076 43363 003164'01 320 12 0 00 003165' 43364 000036'03 000000000000# 43365 000410'04 054 040 164 151 155 43366 003165'01 201 01 0 00 000101 numout ntimou 43367 003166'01 200 02 0 00 002371* 43368 003167'01 201 03 0 00 000012 43369 003170'01 104 00 0 00 000224 43370 003171'01 320 14 0 00 003172' 43371 txmsg < 43372 003172'01 200 01 0 00 000000# > ; End up with a CRLF 43373 003173'01 104 00 0 00 000076 43374 003174'01 320 12 0 00 003175' 43375 000037'03 000000000000# 43376 000413'04 015 012 000 000 000 43377 43378 003175'01 262 17 0 00 000003 pop p, t3 ; Restore ACs. 43379 003176'01 262 17 0 00 000002 pop p, t2 43380 003177'01 262 17 0 00 000001 pop p, t1 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 46-4 K20SUB MAC 19-Jan-24 16:52 Control-A trap handler 43381 43382 003200'01 104 00 0 00 000136 DEBRK% ; Resume. 43383 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 47 K20SUB MAC 19-Jan-24 16:52 Control-X trap handler 43384 subttl Control-X trap handler 43385 43386 ;[59] 43387 43388 003201'01 cxtrap: extern source, dirch ;[186] 43389 43390 003201'01 476 00 0 00 002623* setom cxseen ; Just set the flag & echo the character. 43391 003202'01 261 17 0 00 000001 push p, t1 43392 003203'01 261 17 0 00 000002 push p, t2 43393 003204'01 200 01 0 00 000000* move t1, source ;[140] What's the source of our data? 43394 003205'01 306 01 0 00 000000* cain t1, dirch ;[140] Is it a directory listing? 43395 003206'01 476 00 0 00 002624* setom czseen ;[140] If so, set C-Z flag, too. 43396 003207'01 200 01 0 00 000000# txmsg <^X// > 43397 003210'01 104 00 0 00 000076 43398 003211'01 320 12 0 00 003212' 43399 000040'03 000000000000# 43400 000414'04 136 130 057 057 040 43401 003212'01 262 17 0 00 000002 pop p, t2 43402 003213'01 262 17 0 00 000001 pop p, t1 43403 003214'01 104 00 0 00 000136 DEBRK% 43404 43405 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 48 K20SUB MAC 19-Jan-24 16:52 Control-Z trap handler 43406 subttl Control-Z trap handler 43407 43408 ;[59] 43409 43410 003215'01 476 00 0 00 003206* cztrap: setom czseen ; Just set the flag & echo the character. 43411 003216'01 261 17 0 00 000001 push p, t1 43412 003217'01 261 17 0 00 000002 push p, t2 43413 003220'01 200 01 0 00 000000# txmsg <^Z// > 43414 003221'01 104 00 0 00 000076 43415 003222'01 320 12 0 00 003223' 43416 000041'03 000000000000# 43417 000416'04 136 132 057 057 040 43418 003223'01 262 17 0 00 000002 pop p, t2 43419 003224'01 262 17 0 00 000001 pop p, t1 43420 003225'01 104 00 0 00 000136 DEBRK 43421 43422 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 49 K20SUB MAC 19-Jan-24 16:52 Control-M and -P trap handlers 43423 subttl Control-M and -P trap handlers 43424 43425 ;[165] 43426 43427 003226'01 cmtrap: extern cmseen, cmloc ;[186] 43428 43429 003226'01 476 00 0 00 002655* setom cmseen ; Set ^M flag 43430 003227'01 261 17 0 00 000001 push p, t1 ; Echo CRLF 43431 003230'01 261 17 0 00 000002 push p, t2 43432 txmsg < 43433 003231'01 200 01 0 00 000000# > 43434 003232'01 104 00 0 00 000076 43435 003233'01 320 12 0 00 003234' 43436 000042'03 000000000000# 43437 000420'04 015 012 000 000 000 43438 003234'01 200 01 0 00 000000* move t1, cmloc ; Get place to resume. 43439 003235'01 254 00 0 00 003245' jrst cmptr2 43440 43441 43442 003236'01 cptrap: extern cpseen ;[186] 43443 extern cploc 43444 43445 003236'01 476 00 0 00 002656* setom cpseen ; Set ^P flag 43446 003237'01 261 17 0 00 000001 push p, t1 ; Echo ^P 43447 003240'01 261 17 0 00 000002 push p, t2 43448 txmsg < 43449 003241'01 200 01 0 00 000000# ^P> 43450 003242'01 104 00 0 00 000076 43451 003243'01 320 12 0 00 003244' 43452 000043'03 000000000000# 43453 000421'04 015 012 136 120 000 43454 003244'01 200 01 0 00 000000* move t1, cploc ; Get place to resume. 43455 43456 003245'01 661 01 0 00 010000 cmptr2: txo t1, pc%usr ;[187] Get into user mode 43457 003246'01 202 01 0 00 000000# movem t1, pc2 ; Resume at desired PC. 43458 003247'01 262 17 0 00 000002 pop p, t2 43459 003250'01 262 17 0 00 000001 pop p, t1 43460 003251'01 104 00 0 00 000136 DEBRK 43461 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 50 K20SUB MAC 19-Jan-24 16:52 Control-Y interrupt handler 43462 subttl Control-Y interrupt handler 43463 43464 ;[211] All part of clrbuf changes 43465 ;[218] Not anymore!! 43466 43467 chgsec(code,data) ; Need some storage 43468 000000'05 cyseen: intern cyseen ; Global for k20par and k20net 43469 retsec ; Back to generating code 43470 43471 extern $clrbs ; Reported location of loop sleep (DISMS%) 43472 extern $waitj ;[218] Reported location of DECnet connection wait 43473 43474 003252'01 261 17 0 00 000001 cytrap: push p, t1 ; Save an accumulator 43475 003253'01 261 17 0 00 000016 push p, cx ; Save for frame building 43476 003254'01 550 01 0 00 000000# hrrz t1, pc3 ; Pick up our interrupted location (no flags) 43477 43478 003255'01 415 16 0 00 003264' block. ; Enter block context for better control flow 43479 003256'01 261 17 0 00 000016 43480 003257'01 306 01 0 00 000000* cain t1, $clrbs ; In the buffer clear sleep? 43481 003260'01 254 00 0 00 002622* retskp ; Yes, go dink his PC 43482 003261'01 306 01 0 00 000000* cain t1, $waitj ;[218] In the DECnet connection wait? 43483 003262'01 254 00 0 00 003260* retskp ;[218] Yes, dink that PC, too 43484 003263'01 263 17 0 00 000000 endbk. ; End of block context 43485 003264'01 254 00 0 00 003270' ifskp. ;[218] A known break location!! 43486 003265'01 500 01 0 00 000000# hll t1, pc3 ; Pick up interrupted flags 43487 003266'01 661 01 0 00 010000 txo t1, pc%usr ; Get into user mode 43488 003267'01 202 01 0 00 000000# movem t1, pc3 ; Change DEBRK% action 43489 003270'01 endif. ; That's all, really 43490 43491 003270'01 262 17 0 00 000016 pop p, cx ; Restore frame pointer 43492 003271'01 262 17 0 00 000001 pop p, t1 ; Restore temporary 43493 003272'01 350 00 0 00 000000# aos cyseen ; Set ^Y flag 43494 003273'01 104 00 0 00 000136 DEBRK% 43495 43496 ;[211] End clrbuf changes 43497 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 51 K20SUB MAC 19-Jan-24 16:52 String convert from eight bit to controlified 7 bit 43498 subttl String convert from eight bit to controlified 7 bit 43499 43500 ;[209] Begin code insertion 43501 43502 ; Like echo, except uses VASTLY less JSYS calls and CPU time. 43503 ; However, because we're doing eight bit bytes, the table driven MOVST 43504 ; approach uses vastly more memory. That's fine for modern usage, 43505 ; which has over 30 times the memory for a few hobbiest users. 43506 ; 43507 ; Parity bits are completely stripped, if you want parity, you must 43508 ; check this, beforehand. 43509 43510 ; Define a macro to do random character substitutions 43511 43512 define cncsub(chr1,sub1,chr2,sub2,tab,%org) < 43513 ifb ,< ;;Don't put things in bad places 43514 printx ?Must have a table to store character pair 43515 end ;;Switch to pass 2 43516 > 43517 %org==. ;;Remember where we are 43518 .xcref %org ;;Don't want in CREF, yuck! 43519 suppress %org ;;Generate symbol value largely useless 43520 reloc tab+<<&177>_-1> ;;Gets us to the correct halfword pair 43521 xwd sub1,sub2 ;;Emit the appropriate pair 43522 reloc %org ;;Get back to where we were 43523 .xcref %org ;;Stay out of my cross reference! 43524 if2 < purge %org > ;;Don't need after pass two, either 43525 >;;cncsub 43526 43527 chgsec(code,const) ; Put translate table in the constants psect 43528 43529 remark ; And on to define our piggy tables 43530 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 52 K20SUB MAC 19-Jan-24 16:52 String convert from eight bit to controlified 7 bit 43531 remark Control Character stop table, first half 43532 43533 000000 %cncha==.chnul ; Control character; starts out at .CHNUL 43534 suppress %cncha ; Don't need in symbol table listing 43535 .xcref %cncha ; Nor in cross reference 43536 43537 000044'03 cnrtab: remark ; Appropriately trigger on control chars 43538 000044' %tborg==. ; Mark beginning of table 43539 suppress %tborg ; Don't need in symbol table listing 43540 .xcref %tborg ; Nor in cross reference 43541 43542 xlist ; Don't need to see this blat 43543 list ; Restart the blather 43544 43545 000144' %eocnr==. ; Remember end of control table 43546 suppress %eocnr ; Don't need in symbol table listing 43547 .xcref %eocnr ; Nor in cross reference 43548 43549 000044'03 reloc %tborg ; Get back to the beginning of the table 43550 .xcref %tborg ; Keep off cross reference 43551 43552 xlist ; Any control character will stop us 43553 list ; Restart the blather 43554 43555 remark ; Have to special case rubout 43556 000143'03 000176 500177 cncsub("~","~",.chdel,,cnrtab) 43557 43558 000144'03 reloc %eocnr ; Get to end of first part 43559 .xcref %eocnr ; Nor in cross reference 43560 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 53 K20SUB MAC 19-Jan-24 16:52 String convert from eight bit to controlified 7 bit 43561 remark Control Character stop table, second half 43562 43563 000144'03 cnrt2:! remark ; Have to repeat for the eight bit part... 43564 .xcref cnrt2 ; Not used, so don't cross reference it 43565 suppress cnrt2 ; Surely not needed on the symbol table 43566 000144' %tborg==. ; Mark beginning of table 43567 .xcref %tborg ; Nor in cross reference 43568 43569 xlist ; Don't need to see this blat 43570 list ; Restart the blather 43571 43572 000244' %eocnr==. ; Remember end of second part of control table 43573 .xcref %eocnr ; Nor in cross reference 43574 43575 000144'03 reloc %tborg ; Get back to the beginning of the table 43576 xlist ; Save the trees!!! 43577 list ;;Turn listing back on 43578 43579 remark ; Have to special case rubout 43580 000243'03 000176 500177 cncsub("~","~",.chdel,,cnrt2) 43581 43582 000244'03 reloc %eocnr ; Get to back to end of table 43583 .xcref %eocnr ; Keep temporary off the cross-reference 43584 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 54 K20SUB MAC 19-Jan-24 16:52 String convert from eight bit to controlified 7 bit 43585 remark Control Character substitution table, first half 43586 43587 ; The translate table assumes that exactly a SINGLE character is 43588 ; to be translated and that this is only a control character. 43589 43590 000244'03 crsubt: remark ; Control character substitution table 43591 000244' %tborg==. ; Mark beginning of table 43592 .xcref %tborg ; Keep off cross reference 43593 43594 xlist ; Don't need to see this blat 43595 list ; Restart the blather 43596 43597 000344' %eocnr==. ; Remember end of control table 43598 .xcref %eocnr ; Nor in cross reference 43599 000244'03 reloc %tborg ; Get back to the beginning of the table 43600 .xcref %eocnr ; Keep off cross reference 43601 43602 000244'03 000100 000101 xwd "@","A" ; .chnul goes to ^@, .chcna goes to ^A 43603 xlist ; End of string on .CHNUL, expand others 43604 list 43605 43606 remark ; A few conventions 43607 000261'03 000132 000044 cncsub(.chcnz,"Z",.chesc,"$",crsubt) 43608 000343'03 500176 000077 cncsub("~",,.chdel,"?",crsubt) 43609 43610 000344'03 reloc %eocnr ; Get to end of first part 43611 .xcref %eocnr ; Nor in cross reference 43612 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 55 K20SUB MAC 19-Jan-24 16:52 String convert from eight bit to controlified 7 bit 43613 remark Control Character expansion table, second half 43614 43615 000344'03 crsu2:! remark ; Used for eight bits, ignores parity 43616 .xcref crsu2 ; Not used, so don't cross reference it 43617 suppress crsu2 ; Surely not needed on the symbol table 43618 000344' %tborg==. ; Mark beginning of table 43619 .xcref %tborg ; Nor in cross reference 43620 43621 xlist ; Don't need to see this blat 43622 list ; Restart the blather 43623 43624 000444' %eocnr==. ; Remember end of control table 43625 .xcref %eocnr ; Nor in cross reference 43626 000344'03 reloc %tborg ; Get back to the beginning of the table 43627 .xcref %eocnr ; Keep off cross reference 43628 43629 000344'03 000100 000101 xwd "@","A" ; .chnul goes to ^@, .chcna goes to ^A 43630 xlist ; End of string on .CHNUL, expand others 43631 list 43632 43633 remark ; A few conventions 43634 000361'03 000132 000044 cncsub(.chcnz,"Z",.chesc,"$",crsu2) 43635 000443'03 500176 000077 cncsub("~",,.chdel,"?",crsu2) 43636 43637 000444'03 reloc %eocnr ; Get to back to end of table 43638 .xcref %eocnr ; Keep temporary off the cross-reference 43639 43640 remark After 2nd pass, purge tempories 43641 if2 < purge %cncha,%eocnr, %tborg 43642 purge cnrt2, crsu2> 43643 retsec ; Get out of the constants section 43644 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 56 K20SUB MAC 19-Jan-24 16:52 String convert from eight bit to controlified 7 bit 43645 remark Actual code to convert the string 43646 43647 ; Call: 43648 ; 43649 ; t1/ length of string to convert 43650 ; t2/ point 8, somewhere ; String of eight bit characters to convert 43651 ; 43652 ; Return: 43653 ; 43654 ; +1/ Something got ill 43655 ; +2/ Success! String completely converted (or as much of it as we could) 43656 ; 43657 ; t1/ Remaining length ; How much is left of source string 43658 ; t2/ point 7, somewhere else ; Converted controlified string 43659 ; t3/ negative length ; Ready for SOUT% 43660 ; t4/ point 8, updated ; Where we stopped in the source string 43661 43662 000454 trnchr==^d300 ; Can handle this many characters at once 43663 43664 chgsec(code,data) ; Need some storage for buffers, etc. 43665 000000'05 trnbuf: intern trnbuf ;[221] Let k20pdc see it, too 43666 000000'05 block +1 ; Space for 7 bit characters 43667 retsec ; Re-open executable code 43668 43669 003274'01 015 00 0 00 000000# c87mov: movst 0,cnrtab ; Actual extend instruction being executed 43670 003275'01 000000 000000 .chnul ; Fill character is end of string 43671 43672 003276'01 s8ccv7: entry s8ccv7 ; String eight controlified convert to seven 43673 003276'01 327 01 0 00 003302' ifle. t1 ; Gubbish? 43674 003277'01 200 04 0 00 000002 move t4 ,t2 ; Return whatever they gave us 43675 003300'01 403 02 0 00 000003 setzb t2, t3 ; Then say there is nothing to SOUT% 43676 003301'01 263 17 0 00 000000 ret ; Fail the call 43677 003302'01 endif. 43678 43679 003302'01 265 16 0 00 004233' saveac ; Save more piggy registers 43680 remark q2 aliases t5 ; So t5 must be saved 43681 43682 remark t1, t2 ; Already have source length and pointer 43683 dmove t4, [ trnchr ; Load maximum length of destination 43684 003303'01 120 04 0 00 004413' point 7, trnbuf ] ; Point to destination 43685 003304'01 403 03 0 00 000006 setzb t3, q2 ; Force section local pointers 43686 003305'01 621 01 0 00 700000 txz t1, S!N!M ; Whack translation flags 43687 43688 003306'01 do. ; Enter loop context 43689 003306'01 661 01 0 00 400000 txo t1, S ; Set significance flag (start translating) 43690 003307'01 123 01 0 00 003274' extend t1, c87mov ; Move the string, testing for control chars 43691 003310'01 320 12 0 00 003312' %jserr (, r) ; Pass any machine error back up 43692 003311'01 254 00 0 00 003315' 43693 003312'01 265 01 0 00 000257' 43694 003313'01 000000000000# 43695 003314'01 254 00 0 00 002716* 43696 000422'04 115 117 126 123 124 43697 003315'01 623 01 0 00 200000 txze t1, N ; Bumped into a control character? 43698 003316'01 254 00 0 00 003326' ifskp. ; We did not; exhausted source? 43699 003317'01 621 01 0 00 700000 txz t1, S!N!M ; Clear all the flags k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 56-1 K20SUB MAC 19-Jan-24 16:52 String convert from eight bit to controlified 7 bit 43700 003320'01 323 01 0 00 003334' jumple t1, endlp. ; No more source? We're done 43701 003321'01 334 00 0 00 000000 %ermsg (,r) 43702 003322'01 254 00 0 00 003326' 43703 003323'01 265 01 0 00 000257' 43704 003324'01 000000000000# 43705 003325'01 254 00 0 00 003314* 43706 000425'04 103 157 156 164 162 43707 003326'01 endif. ; Otherwise, we DID hit a control character 43708 003326'01 323 04 0 00 003334' jumple t4, endlp. ; Done if no more destination 43709 003327'01 621 01 0 00 700000 txz t1, S!N!M ; Clear all the flags 43710 003330'01 260 17 0 00 003343' call cnchar ; Otherwise, process a control character 43711 003331'01 263 17 0 00 000000 ret ; Failed, just stop right now 43712 003332'01 323 04 0 00 003334' jumple t4, endlp. ; Done if no more destination space 43713 003333'01 327 01 0 00 003306' jumpg t1, top. ; Keep translating characters until no more 43714 003334'01 enddo. ; Exit loop lexical context 43715 43716 remark t1, ; Still has remaining source length 43717 003334'01 200 03 0 00 000004 move t3, t4 ; Load remaining destination 43718 003335'01 275 03 0 00 000454 subi t3, trnchr ; Calculate negative destination length 43719 003336'01 200 04 0 00 000002 move t4, t2 ; Updated source pointer is here 43720 003337'01 200 02 0 00 004415' move t2, [ point 7, trnbuf ] ; Point to destination 43721 003340'01 254 00 0 00 003262* retskp ; Successful return 43722 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 57 K20SUB MAC 19-Jan-24 16:52 String convert from eight bit to controlified 7 bit 43723 remark Convert control character to ASCII equivalent 43724 43725 ; Assumes s8ccv7 register context and is intmately linked with it 43726 ; 43727 ; t1/ Remaining length of source string 43728 ; t2/ point 8, to current location in source string 43729 ; t3/ Address portion of 30 double word pointer, MUST be zero 43730 ; t4/ Remaining length of destination string 43731 ; q1/ point 7, to current location in destination string 43732 ; q2/ Address portion of 30 double word pointer, MUST be zero 43733 ; 43734 ; Note a subtle difference between this and the escchr routine, which 43735 ; is used to implement C backslash expansion and translation. In that 43736 ; case, the backslash is skipped and the character afterwards is 43737 ; translated (or converted into a number). 43738 ; 43739 ; The enclosing MOVST is now pointing AFTER the control character and 43740 ; has updated the source remaining total to account for the fact that 43741 ; it has been consumed. However, no such thing happens to the 43742 ; destination pointer and count because nothing was ever deposited. 43743 ; 43744 ; Thus some fix-up is necessary prior to excuting the MOVST below so 43745 ; that the correct character is fetched. Similarly, the source 43746 ; counter should NOT be fixed while the destination counter MUST be 43747 ; fixed. 43748 ; 43749 ; It's the kind of edge case that you really have to single step 43750 ; through to see what the machine is actually doing... 43751 ; 43752 ; For the two cases which involve an expansion, no fix up is 43753 ; necessary, because we're skipping the control character and 43754 ; depositing fixed strings. 43755 43756 003341'01 015 00 0 00 000000# chngch: movst 0,crsubt ; Actual extend instruction being executed 43757 003342'01 000000 000000 .chnul ; Fill character is end of string 43758 43759 003343'01 265 16 0 00 004416' cnchar: saveac ; Some extra scratch for calculations 43760 003344'01 135 07 0 00 000002 ldb q3, t2 ; Load character that stopped us 43761 003345'01 306 07 0 00 000015 cain q3, .chcrt ; Carriage return? 43762 003346'01 254 00 0 00 003421' callret schcrt ; Hit special carriage return expansion 43763 003347'01 306 07 0 00 000012 cain q3, .chlfd ; Line feed? 43764 003350'01 254 00 0 00 003456' callret schlfd ; Hit special line feed expansion 43765 43766 003351'01 201 07 0 00 000136 movei q3, "^" ; Load circumflex character 43767 003352'01 136 07 0 00 000005 idpb q3, q1 ; Deposit in destination 43768 003353'01 363 04 0 00 003325* sojle t4, r ; Account for it and return if full 43769 43770 003354'01 621 01 0 00 700000 txz t1, N!M!S ; Stomp flags so math and EXTEND work 43771 003355'01 200 07 0 00 000001 move q3, t1 ; Save source length over extend 43772 003356'01 200 10 0 00 000004 move q4, t4 ; Ditto destination length 43773 43774 003357'01 474 01 0 00 000000 seto t1, ; Have to back up the source pointer to 43775 003360'01 133 01 0 00 000002 adjbp t1, t2 ; BEFORE the offending control character 43776 003361'01 200 02 0 00 000001 move t2, t1 ; Use updated pointer as new source pointer 43777 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 57-1 K20SUB MAC 19-Jan-24 16:52 String convert from eight bit to controlified 7 bit 43778 003362'01 200 01 0 00 004342' move t1,[ S!<^d1> ] ; Only looking at a SINGLE character of source 43779 003363'01 201 04 0 00 000001 movei t4,^d1 ; Don't allow any foolish filling... 43780 003364'01 123 01 0 00 003341' extend t1, chngch ; Change this SINGLE character 43781 003365'01 320 12 0 00 003367' %jserr (, r) ; Pass error up 43782 003366'01 254 00 0 00 003372' 43783 003367'01 265 01 0 00 000257' 43784 003370'01 000000000000# 43785 003371'01 254 00 0 00 003353* 43786 000440'04 103 157 156 164 162 43787 43788 003372'01 607 01 0 00 200000 ifxn. t1, N ; Invalid control character?? 43789 003373'01 254 00 0 00 003405' 43790 003374'01 200 01 0 00 000000# emsg 43791 003375'01 104 00 0 00 000313 43792 000444'03 000000000000# 43793 000447'04 111 154 154 145 147 43794 003376'01 135 01 0 00 000002 ldb t1, t2 ; Pick up what didn't work 43795 003377'01 104 00 0 00 000074 PBOUT% ; Show us 43796 003400'01 561 01 0 00 003022* hrroi t1, crlf ; Load end of line 43797 003401'01 104 00 0 00 000076 PSOUT% ; Print it 43798 003402'01 200 01 0 00 000007 move t1, q3 ; Restore unaltered source length 43799 003403'01 200 04 0 00 000010 move t4, q4 ; Restore unaltered destination length 43800 003404'01 263 17 0 00 000000 ret ; Failure return 43801 003405'01 endif. 43802 43803 003405'01 200 01 0 00 000007 move t1, q3 ; Restore source count, which is already correct 43804 003406'01 375 04 0 00 000010 sosge t4, q4 ; Fix destination count for character deposited 43805 003407'01 263 17 0 00 000000 ret ; Ran out of buffer space 43806 003410'01 254 00 0 00 003340* retskp ; Won!! 43807 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 58 K20SUB MAC 19-Jan-24 16:52 Special Control Character logic 43808 subttl Special Control Character logic 43809 43810 ; Expands carriage return and line feed so we 43811 ; don't overprint or get yucky wrap arounds 43812 ; 43813 ; Both assume: 43814 ; 43815 ; cnchar working context 43816 ; 43817 ; t1/ Remaining length of source string 43818 ; t2/ point 8, to current location in source string 43819 ; t3/ Address portion of 30 double word pointer, MUST be zero 43820 ; t4/ Remaining length of destination string 43821 ; q1/ point 7, to current location in destination string 43822 ; q2/ Address portion of 30 double word pointer, MUST be zero 43823 ; 43824 ; The idea is that the user sees something like ^M 43825 ; ^J splitting lines. Repeated Control-J's are not 43826 ; as graceful, but this is just for buffer review 43827 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 59 K20SUB MAC 19-Jan-24 16:52 Carriage expansion 43828 subttl Carriage expansion 43829 43830 ; Carriage Return puts the control character at END of expansion 43831 43832 003411'01 572321 500000 crtexp: byte (7) "^", "M", .chcrt, .chnul, .chnul 43833 003412'01 572321 505000 byte (7) "^", "M", .chcrt, .chlfd, .chnul 43834 43835 003413'01 000000 000003 crtptr: ^d3 ; String is three bytes long 43836 003414'01 44 07 0 00 003411' point 7, crtexp ; Point to expansion text 43837 003415'01 000000 000004 crtptl: ^d4 ; String is four bytes long 43838 003416'01 44 07 0 00 003412' point 7, crtexp+1 ; Point to text with line feed 43839 43840 003417'01 016 00 0 00 000000 movcrt: movslj 0, 0 ; No accumulator; E1 unused 43841 003420'01 000000 000000 .chnul ; Fill with nul's 43842 43843 003421'01 schcrt: remark q3, q4 ; Already saved by cnchar 43844 003421'01 265 16 0 00 004426' saveac ; Needs another register 43845 43846 003422'01 120 07 0 00 000001 dmove q3, t1 ; Save current source 43847 003423'01 323 07 0 00 003433' ifg. q3 ; Any remaining input? 43848 003424'01 134 01 0 00 000002 ildb t1, t2 ; Yes, pick up the next character 43849 003425'01 302 01 0 00 000012 caie t1, .chlfd ; A line feed?? 43850 003426'01 254 00 0 00 003431' ifskp. ; It is, so will be handled by schlfd 43851 003427'01 120 01 0 00 003413' dmove t1, crtptr ; Load expansion length and pointer 43852 003430'01 254 00 0 00 003432' else. ; Otherwise, drop in a line feed, too 43853 003431'01 120 01 0 00 003415' dmove t1, crtptl ; Load expansion length and pointer 43854 003432'01 endif. ; End case overwrite checking 43855 003432'01 254 00 0 00 003434' else. ; Otherwise, Carriage Return was last character 43856 003433'01 120 01 0 00 003415' dmove t1, crtptl ; So assume no line feed 43857 003434'01 endif. ; End case input buffer checking 43858 43859 003434'01 274 04 0 00 000001 sub t4, t1 ; Subtract from remaining 43860 003435'01 323 04 0 00 003371* jumple t4, r ; Fail if overflowed the beffer 43861 ; Otherwise, safe to move 43862 003436'01 200 11 0 00 000004 move q5, t4 ; Preserve the new length 43863 003437'01 200 04 0 00 000001 move t4, t1 ; Same as source, so no fill 43864 003440'01 123 01 0 00 003417' extend t1, movcrt ; Copy it all over, wee!! 43865 003441'01 320 12 0 00 003443' %jserr (,r) ;?? 43866 003442'01 254 00 0 00 003446' 43867 003443'01 265 01 0 00 000257' 43868 003444'01 000000000000# 43869 003445'01 254 00 0 00 003435* 43870 000455'04 125 156 141 142 154 43871 003446'01 120 01 0 00 000007 dmove t1, q3 ; Restore source 43872 003447'01 200 04 0 00 000011 move t4, q5 ; Restore fixed length 43873 003450'01 254 00 0 00 003410* retskp ; Return, successfully expanded 43874 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 60 K20SUB MAC 19-Jan-24 16:52 Line feed expansion 43875 subttl Line feed expansion 43876 43877 ; Line feed expansion puts the control character BEFORE expansion 43878 43879 003451'01 052751 200000 lfdexp: byte (7) .chlfd, "^", "J", .chnul, .chnul 43880 003452'01 000000 000003 lfdptr: ^d3 ; String is three bytes long 43881 003453'01 44 07 0 00 003451' point 7, lfdexp ; Point to expansion text 43882 003454'01 016 00 0 00 000000 movlfd: movslj 0, 0 ; No accumulator; E1 unused 43883 003455'01 000000 000040 .chspc ; Fill with spaces 43884 43885 003456'01 schlfd: remark q3, q4 ; Already saved by cnchar 43886 003456'01 265 16 0 00 004426' saveac ; Needs another register 43887 43888 003457'01 120 07 0 00 000001 dmove q3, t1 ; Save current source 43889 003460'01 120 01 0 00 003452' dmove t1, lfdptr ; Load expansion length and pointer 43890 003461'01 274 04 0 00 000001 sub t4, t1 ; Subtract from remaining 43891 003462'01 323 04 0 00 003445* jumple t4, r ; Fail if overflowed the beffer 43892 ; Otherwise, safe to move 43893 003463'01 200 11 0 00 000004 move q5, t4 ; Preserve the new length 43894 003464'01 200 04 0 00 000001 move t4, t1 ; Same as source, so no fill 43895 003465'01 123 01 0 00 003454' extend t1, movlfd ; Copy it all over, wee!! 43896 003466'01 320 12 0 00 003470' %jserr (,r) ;?? 43897 003467'01 254 00 0 00 003473' 43898 003470'01 265 01 0 00 000257' 43899 003471'01 000000000000# 43900 003472'01 254 00 0 00 003462* 43901 000464'04 125 156 141 142 154 43902 003473'01 120 01 0 00 000007 dmove t1, q3 ; Restore source 43903 003474'01 200 04 0 00 000011 move t4, q5 ; Restore fixed length 43904 003475'01 254 00 0 00 003450* retskp ; Success 43905 43906 ;[209] End code insertion 43907 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 61 K20SUB MAC 19-Jan-24 16:52 String copy measurement, 9:10pm Thursday, 21 July 2022 43908 subttl String copy measurement, 9:10pm Thursday, 21 July 2022 43909 43910 remark Delimma: What is the fastest way to copy strings? 43911 43912 ; A question had sometimes come up for debate as to whether the string 43913 ; instructions gave any real speed up, the concern being whether the 43914 ; set up cost of conditioning the register file and restoring it was 43915 ; worth using them. 43916 ; 43917 ; Three cases were set up, the first being a typical ildb/idpb loop 43918 ; with the second being a use of movst to move the string until a nul 43919 ; was detected. The third was a mixture; the keywords being moved 43920 ; with a loop and the macro expansions being moved with the movst. 43921 ; This was expected to be have the best performance as macro names 43922 ; (I.E., keywords) are typically not very long. 43923 ; 43924 ; 11 macros were defined, using a total of 80 characters of macro name 43925 ; space and 1365 characters of macro text space. The results are 43926 ; suprising: 43927 ; 43928 ; Case Elapsed CPU All 43929 ; 1 1.360 1.320 times 43930 ; *2 .340 .320 are in 43931 ; 3 1.020 .980 milliseconds 43932 ; 43933 ; By a considerable margin, using solely the movst won. This is why 43934 ; it is used exclusively in the macro garbage collector. Going 43935 ; forward, other cases may be identified in Kermit where it can be 43936 ; used. 43937 ; 43938 ; Older programs which use SOUT% to transfer strings would no doubt 43939 ; benefit substantially. 43940 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 62 K20SUB MAC 19-Jan-24 16:52 Table to move an ASCIZ string 43941 subttl Table to move an ASCIZ string 43942 43943 chgsec(code,const) ; Get into the constants segment 43944 43945 000002 %azchr==.chcnb ; Table starts at Control-B 43946 suppress %azchr ; Don't need in symbol table listing 43947 .xcref %azchr ; Nor in cross reference 43948 43949 000445'03 100000 000001 asztab: xwd eoscod!.chnul, .chcna ; Only stops on a NUL 43950 xlist ; Don't need to see this blat 43951 list ; Restart the blather 43952 43953 if2 < purge %azchr > ; Temporary not needed after 2nd pass 43954 retsec ; Get out of the constants section, into code 43955 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 63 K20SUB MAC 19-Jan-24 16:52 Move an ASCIZ string 43956 subttl Move an ASCIZ string 43957 43958 ; Call: 43959 ; 43960 ; t1/ Source BP (assumed section local) 43961 ; t2/ Destination BP (assumed section local) 43962 ; 43963 ; Return: 43964 ; 43965 ; +1/ Always, but may complain 43966 ; 43967 ; t1/ Updated source pointer 43968 ; t2/ Updated destination pointer 43969 ; t3/ Length of string 43970 ; 43971 ; CAUTION: 43972 ; 43973 ; Like an ildb/idpb loop, this will overwrite all memory if you let it. 43974 ; Make CERTAIN that your strings are NUL terminated!!! 43975 43976 003476'01 movasc: intern movasc ; Also used by k20srv 43977 003476'01 015 00 0 00 000000# movst 0,asztab ; Move characters until hit a NUL 43978 003477'01 000000 000000 .chnul ; Fill character 43979 43980 024000 mxascz==:MAXBUF ; A bizarre length (or ... ?) 43981 43982 003500'01 asczcp: entry asczcp ; Called by everybody 43983 remark ; Assumes can use these 43984 003500'01 261 17 0 00 000005 push p, q1 ; Piggy MOVST gorges on registers 43985 003501'01 261 17 0 00 000006 push p, q2 43986 43987 003502'01 200 05 0 00 000002 move q1, t2 ; Reposition destination for movst 43988 003503'01 200 02 0 00 000001 move t2, t1 ; Reposition source for movst 43989 003504'01 403 03 0 00 000006 setzb t3, q2 ; Force section local pointers 43990 003505'01 200 01 0 00 004434' movx t1, ; Limit source length, start significance 43991 003506'01 201 04 0 00 024000 movx t4, mxascz ; Limit destination length 43992 003507'01 123 01 0 00 003476' extend t1, movasc ; Move characters, doing useless translating 43993 003510'01 600 00 0 00 000000 nop ; Will never +1 because t1 and t4 are equal 43994 003511'01 133 00 0 00 000002 ibp t2 ; Account for .CHNUL in source 43995 003512'01 200 01 0 00 000002 move t1, t2 ; Return updated source pointer 43996 003513'01 136 06 0 00 000005 idpb q2, q1 ; Deposit a NUL at the end 43997 003514'01 200 02 0 00 000005 move t2, q1 ; Return updated destination pointer 43998 003515'01 201 03 0 00 024001 movx t3, ; Account for extra NUL byte 43999 003516'01 274 03 0 00 000004 sub t3, t4 ; Calculate length 44000 44001 003517'01 262 17 0 00 000006 pop p, q2 ; Restore registers and beat it 44002 003520'01 262 17 0 00 000005 pop p, q1 44003 003521'01 263 17 0 00 000000 ret 44004 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 64 K20SUB MAC 19-Jan-24 16:52 Historic MOVSTU Move string, uppercasing any lowercase letters. 44005 subttl Historic MOVSTU Move string, uppercasing any lowercase letters. 44006 44007 ;[245] Begin code removal 44008 44009 ; Eats any leading whitespace. 44010 ; Call with t1/ source pointer 44011 ; t2/ destination pointer 44012 ; Returns with t1, t2 updated, t3/ character count, t4/ 0. 44013 44014 repeat 0,< 44015 remark ; Replaced with an EXTEND instruction 44016 movstu: entry movstu 44017 seto t3, ; Counter, started at -1. 44018 44019 movstx: ildb t4, t1 ; Get a character. 44020 jumpn t3, movsty ; Have we got at least one nonwhitespace? 44021 caie t4, 40 ; No, is this a blank? 44022 cain t4, 11 ; or a tab? 44023 jrst movstx ; One of those, skip it. 44024 movsty: cail t4, "a" ; Convert to upper case if necessary. 44025 caile t4, "z" 44026 skipa 44027 trz t4, 40 44028 idpb t4, t2 ; Copy it. 44029 aos t3 ; Count it. 44030 jumpn t4, movstx ; Everything up to & including the first null. 44031 ret 44032 >;;repeat 0 44033 44034 ;[245] End code removal 44035 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 65 K20SUB MAC 19-Jan-24 16:52 Translation table for MOVST to UPPERcase 44036 subttl Translation table for MOVST to UPPERcase 44037 44038 ;[245] Begin table insertion 44039 44040 chgsec(code,const) ; Translate tables go in constants area 44041 44042 ; Just skips whitespace. Also, can handle 8 bit pointers, but doesn't 44043 ; do anything with a character past .chdel (177). 44044 44045 500002 %ascuh=trmcod!.chcnb ; ASCII values start at Control-B 44046 44047 000545'03 100000 500001 chrshs: xwd eoscod,trmcod!.chcna ; NUL is end of string, ^A is allowed 44048 remark ; Everything terminates, except space and tab 44049 xlist ; Don't need to see all this junk 44050 list ; Restart the blather 44051 000745' %eotuh=. ; Remember end of table 44052 44053 000551'03 reloc chrshs+<<.chbsp>_-1> ; Get to backspace, horizontal tab pair 44054 000551'03 500010 000011 xwd trmcod!.chbsp,.chtab ; Tab does NOT terminate (nor set 'N') 44055 000565'03 reloc chrshs+<<.chspc>_-1> ; Get to space, exclamation point pair 44056 000565'03 000040 500041 xwd .chspc,trmcod!"!" ; Space does NOT terminate (nor set 'N') 44057 44058 000745'03 reloc %eotuh ; Get back to end of table 44059 cleans(<%ascuh,%eotuh>) ; Don't need these temporary symbols 44060 44061 remark Character table just UPPERcases characters, stopping on EOS 44062 44063 000002 %ascus=.chcnb ; ASCII values start at Control-B 44064 44065 000745'03 100000 000001 chrmut: xwd eoscod,.chcna ; NUL is end of string, ^A is allowed 44066 xlist ; Don't need to see all this junk 44067 list ; Restart the blather 44068 001145' %eotup==. ; Remember end of table 44069 44070 remark ; Get to lower case section 44071 001025'03 reloc chrmut+<<"`">_-1> ; Gets us to the corrct halfword pair 44072 001025'03 000140 000101 xwd "`","A" ; Convert lowercase a to UPPERcase A 44073 000102 %ascus="B" ; Starting at lowercase b 44074 xlist ; Don't need to see all this junk 44075 list ; Restart the blather 44076 001042'03 000132 000173 xwd "Z",173 ; Last letter and Left brace 44077 44078 001145'03 reloc %eotup ; Get back to end of table 44079 44080 001145'03 015 00 0 00 000545' chrshe: movst 0, chrshs ; Skip white, but stop on NUL 44081 001146'03 000000 000000 .chnul ; Fill character is end of string 44082 44083 001147'03 015 00 0 00 000745' chrmup: movst 0, chrmut ; Translate table to UPPERcase 44084 001150'03 000000 000000 .chnul ; Fill character is end of string 44085 44086 cleans(<%ascus,%eotup>) ; Don't need these temporary symbols 44087 retsec ; Return to code section 44088 44089 ;[245] End table insertion 44090 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 66 K20SUB MAC 19-Jan-24 16:52 Move string, UPPERcasing any lowercase letters 44091 subttl Move string, UPPERcasing any lowercase letters 44092 44093 ;[245] Begin code insertion 44094 44095 ; Call: 44096 ; 44097 ; t1/ Source ASCII pointer 44098 ; t2/ Destination ASCII pointer 44099 ; 44100 ; Return: +1, always 44101 ; 44102 ; t1/ Updated source ASCII pointer 44103 ; t2/ Updated destination ASCII pointer 44104 ; t3/ Length of destination string, minus any initial whitespace 44105 ; t4/ Zero 44106 ; 44107 ; N.B., Munches initial horizontal white space (.chtab, .chspc) 44108 ; Stops on end of string, a .chnul 44109 44110 003522'01 movstu: entry movstu ; Used in K20MIT, checked in K20PAR 44111 003522'01 265 16 0 00 004247' saveac ; Piggy MOVST wants plenty registers 44112 003523'01 201 07 0 00 024000 movx q3, MAXBUF ; Load maximum length we'll do 44113 003524'01 200 05 0 00 000002 move q1, t2 ; Load destination pointer 44114 003525'01 200 02 0 00 000001 move t2, t1 ; Load source pointer 44115 003526'01 403 03 0 00 000006 setzb t3, q2 ; No non-section zero pointers 44116 003527'01 200 01 0 00 000007 move t1, q3 ; String length 44117 003530'01 200 04 0 00 000001 move t4, t1 ; Assume equal length strings 44118 44119 remark ^-S ; Do NOT set 'S'--NOT translating!! 44120 003531'01 123 01 0 00 000000# extend t1, chrshe ; Use auto-magic and skip horizontal space until EOS 44121 003532'01 600 00 0 00 000000 nop ; Don't need to know about skip/non-skip 44122 44123 003533'01 603 01 0 00 200000 ifxe. t1, N ; Didn't terminate with a non-whitespace? 44124 003534'01 254 00 0 00 003542' 44125 003535'01 621 01 0 00 700000 txz t1, S!N!M ; Nope, so stomp the flags 44126 remark N.B., It doesn't matter if t1 is non-zero, string was all whitespace 44127 003536'01 200 01 0 00 000002 move t1, t2 ; Return updated source 44128 003537'01 200 02 0 00 000005 move t2, q1 ; Return destination, which did not change 44129 003540'01 403 03 0 00 000004 setzb t3, t4 ; No length 44130 003541'01 263 17 0 00 000000 ret ; Done squeezing entire string dry 44131 003542'01 endif. ; End case entire string was white space 44132 44133 003542'01 621 01 0 00 700000 txz t1, S!N!M ; Shut off all flags 44134 003543'01 350 10 0 00 000001 aos q4, t1 ; Store character count BEFORE terminator 44135 003544'01 200 03 0 00 000002 move t3, t2 ; Make a copy of the source pointer 44136 003545'01 474 02 0 00 000000 seto t2, ; Direction is backwards 44137 003546'01 133 02 0 00 000003 adjbp t2, t3 ; Back it up by one BEFORE terminator 44138 003547'01 400 03 0 00 000000 setz t3, ; Maintain in-section local pointer 44139 44140 003550'01 661 01 0 00 400000 txo t1, S ; Start translating 44141 003551'01 123 01 0 00 000000# extend t1, chrmup ; Use auto-magic to munch and UPPERcase! 44142 003552'01 600 00 0 00 000000 nop ; Should always skip, since no TRMCOD 44143 44144 003553'01 200 01 0 00 000002 move t1, t2 ; Load final source pointer 44145 003554'01 200 02 0 00 000005 move t2, q1 ; Load final destination pointer k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 66-1 K20SUB MAC 19-Jan-24 16:52 Move string, UPPERcasing any lowercase letters 44146 003555'01 200 03 0 00 000007 move t3, q3 ; Load original length 44147 003556'01 274 03 0 00 000004 sub t3, t4 ; Subtract stopping destination length 44148 003557'01 400 04 0 00 000000 setz t4, ; Returns zero in t4 44149 003560'01 136 04 0 00 000002 idpb t4, t2 ; Deposit NUL in destination string 44150 003561'01 271 03 0 00 000001 addi t3, ^d1 ; Account for it in length 44151 003562'01 263 17 0 00 000000 ret ; Done 44152 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 67 K20SUB MAC 19-Jan-24 16:52 Translation tables for Counted MOVST to UPPERcase 44153 subttl Translation tables for Counted MOVST to UPPERcase 44154 44155 ;[245] Begin table insertion 44156 44157 chgsec(code,const) ; Translate tables go in constants area 44158 44159 remark First table just skips the horizontal space 44160 44161 ; Similar to chrmut, but does not munch NUL's, it just skips 44162 ; whitespace. Also, expects 8 bit pointers, but doesn't do anything 44163 ; with a character past .chdel (177) 44164 44165 500000 %ascuw=trmcod!.chnul ; ASCII values start at NUL 44166 44167 001151'03 chrsws: remark ; Everything terminates, except space and tab 44168 xlist ; Don't need to see all this junk 44169 list ; Restart the blather 44170 001351' %eotuw=. ; Remember end of table 44171 44172 001155'03 reloc chrsws+<<.chbsp>_-1> ; Get to backspace, horizontal tab pair 44173 001155'03 500010 000011 xwd trmcod!.chbsp,.chtab ; Tab does NOT terminate (nor set 'N') 44174 001171'03 reloc chrsws+<<.chspc>_-1> ; Get to space, exclamation point pair 44175 001171'03 000040 500041 xwd .chspc,trmcod!"!" ; Space does NOT terminate (nor set 'N') 44176 44177 001351'03 reloc %eotuw ; Get back to end of table 44178 cleans(<%ascuw,%eotuw>) ; Don't need these temporary symbols 44179 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 68 K20SUB MAC 19-Jan-24 16:52 Translation tables for Counted MOVST to UPPERcase 44180 remark Second table does the UPPERcasing, but does not munch NUL's 44181 44182 ; Only uppercases the 26 lowercase letters: a, b, c, d, e, f, g, h, i, 44183 ; j, k, l, m, n, o, p, q, r, s, t, u, v, w, x, y and z. Other 44184 ; characters are left strictly alone. 44185 44186 000000 %ascuc=.chnul ; ASCII values start at NUL (nothing stops it) 44187 44188 001351'03 chrcut: remark ; Table to only uppercase, not NUL's 44189 xlist ; Don't need to see all this junk 44190 list ; Restart the blather 44191 001551' %eotuc==. ; Remember end of table 44192 44193 remark ; Get to lower case section 44194 001431'03 reloc chrcut+<<"`">_-1> ; Gets us to the corrct halfword pair 44195 001431'03 000140 000101 xwd "`","A" ; Convert lowercase a to UPPERcase A 44196 000102 %ascuc="B" ; Starting at lowercase b 44197 xlist ; Don't need to see all this junk 44198 list ; Restart the blather 44199 001446'03 000132 000173 xwd "Z",173 ; Last letter and Left brace 44200 44201 001551'03 reloc %eotuc ; Get back to end of table 44202 cleans(<%ascuc,%eotuc>) ; Don't need these temporary symbols 44203 44204 001551'03 015 00 0 00 001151' chrcsw: movst 0,chrsws ; Translate table to skip initial white space 44205 001552'03 000000 000000 .chnul ; Fill character is end of string 44206 44207 001553'03 015 00 0 00 001351' chrcup: movst 0,chrcut ; Translate table to UPPERcase 44208 001554'03 000000 000000 .chnul ; Fill character is end of string 44209 44210 retsec ; Return to code section 44211 44212 ;[245] End table insertion 44213 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 69 K20SUB MAC 19-Jan-24 16:52 Counted Move string, uppercasing any lowercase letters. 44214 subttl Counted Move string, uppercasing any lowercase letters. 44215 44216 ;[245] Begin code insertion 44217 44218 ; Call: 44219 ; 44220 ; t1/ Source ASCII pointer 44221 ; t2/ Destination ASCII pointer 44222 ; t3/ Count of source string bytes (not including trailing NUL) 44223 ; 44224 ; Return: +1, always 44225 ; 44226 ; t1/ Updated source ASCII pointer 44227 ; t2/ Updated destination ASCII pointer 44228 ; t3/ Length of final string, minus any initial whitespace 44229 ; t4/ Length of source string (which can be used as an internal check) 44230 ; 44231 ; N.B., Munches initial horizontal white space (.chtab, .chspc) 44232 ; Stops when source string count goes to zero and does NOT 44233 ; squeeze out NUL's. Do not include a trailing NUL in the 44234 ; count unless you want it there! 44235 ; 44236 ; After reviewing the tables above, understand that it is a TERRIBLE 44237 ; idea to call this routine after you have put parity on a string. 44238 44239 003563'01 movsuc: entry movsuc ; Used in K20PAR (to check out K20MIT) 44240 003563'01 265 16 0 00 004247' saveac ; Piggy MOVST wants plenty registers 44241 003564'01 200 07 0 00 000003 move q3, t3 ; Preserve length of source string 44242 003565'01 200 05 0 00 000002 move q1, t2 ; Load destination pointer 44243 003566'01 200 02 0 00 000001 move t2, t1 ; Load source pointer 44244 003567'01 403 03 0 00 000006 setzb t3, q2 ; No non-section zero pointers 44245 003570'01 200 01 0 00 000007 move t1, q3 ; Load source length 44246 003571'01 200 04 0 00 000001 move t4, t1 ; Destination will never be longer 44247 44248 remark ^-S ; Do NOT set 'S'--NOT translating!! 44249 003572'01 123 01 0 00 000000# extend t1, chrcsw ; First, skip all the whitespace 44250 003573'01 600 00 0 00 000000 nop ; May never skip since should always trmcod 44251 44252 003574'01 603 01 0 00 200000 ifxe. t1, N ; BUT!! Wasn't it force terminate?? 44253 003575'01 254 00 0 00 003603' 44254 003576'01 200 01 0 00 000002 move t1, t2 ; Return (updated) source string pointer 44255 003577'01 200 02 0 00 000005 move t2, q1 ; Return (unmodified) destination string pointer 44256 003600'01 400 03 0 00 000000 setz t3, ; Final string has no length 44257 003601'01 200 04 0 00 000007 move t4, q3 ; Return (unchanged) original length 44258 003602'01 263 17 0 00 000000 ret ; That was easy enough 44259 003603'01 endif. ; Otherwise, hit non-whitespace 44260 44261 003603'01 621 01 0 00 700000 txz t1, S!N!M ; Shut off all flags 44262 003604'01 350 10 0 00 000001 aos q4, t1 ; Store character count BEFORE terminator 44263 003605'01 200 03 0 00 000002 move t3, t2 ; Make a copy of the source pointer 44264 003606'01 474 02 0 00 000000 seto t2, ; Direction is backwards 44265 003607'01 133 02 0 00 000003 adjbp t2, t3 ; Back it up by one BEFORE terminator 44266 003610'01 400 03 0 00 000000 setz t3, ; Maintain in-section local pointer 44267 44268 003611'01 661 01 0 00 400000 txo t1, S ; Start translating k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 69-1 K20SUB MAC 19-Jan-24 16:52 Counted Move string, uppercasing any lowercase letters. 44269 003612'01 123 01 0 00 000000# extend t1, chrcup ; Use auto-magic to munch and uppercase! 44270 003613'01 600 00 0 00 000000 nop ; Should always skip, since no TRMCOD 44271 44272 003614'01 200 01 0 00 000002 move t1, t2 ; Load final source pointer 44273 003615'01 200 06 0 00 000007 move q2, q3 ; Load original length 44274 003616'01 274 06 0 00 000010 sub q2, q4 ; Calculate how many we skipped 44275 003617'01 200 03 0 00 000007 move t3, q3 ; Load original length 44276 003620'01 274 03 0 00 000006 sub t3, q2 ; Calculate final length of destination string 44277 44278 003621'01 210 02 0 00 000006 movn t2, q2 ; Load characters we skipped (but going backwards) 44279 003622'01 133 02 0 00 000005 adjbp t2, q1 ; Back up to the end of that (shrunken) string) 44280 003623'01 200 04 0 00 000007 move t4, q3 ; Source string length didn't change 44281 003624'01 263 17 0 00 000000 ret ; Done 44282 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 70 K20SUB MAC 19-Jan-24 16:52 Historic IAC code removed from k20mit 44283 subttl Historic IAC code removed from k20mit 44284 44285 ;[247] Begin code removal 44286 44287 repeat 0,< ;;Copied here out of k20mit 44288 move t2, [point 8, sndpkt] ; Yes, must double any IACs. 44289 move t3, [point 8, tvtbuf] ; Copy data field to this place. 44290 spak6a: ildb t1, t2 ; Byte loop. Get one. 44291 jumpe t1, spak6b ; Done? 44292 idpb t1, t3 ; No, copy it. 44293 cain t1, iac ; IAC? 44294 idpb t1, t3 ; Yes, copy it again. 44295 jrst spak6a ; Till done. 44296 spak6b: setz t1, ; Done, make result asciz. 44297 idpb t1, t3 ; ... 44298 move q1, t3 ;[223] Save last pointer 44299 move t2, [point 8, tvtbuf] ; Point to result. 44300 >;;repeat 0 44301 44302 ;[247] End code removal 44303 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 71 K20SUB MAC 19-Jan-24 16:52 iaciac Translation tables 44304 subttl iaciac Translation tables 44305 44306 ;[247] Begin table insertion 44307 44308 ; Background: 44309 ; 44310 ; Telnet uses a special 8-bit character to indicate that the next byte 44311 ; in the terminal stream should be interpreted as a command. This 44312 ; character is known as the IAC character and is octal 377, hex FF and 44313 ; decimal 256. 44314 ; 44315 ; When Kermit-20 is sending binary data, it is possible that a 44316 ; legitimate 377 can be seen in the data stream. Further, a delete or 44317 ; rubout character (octal 177) sent with even parity will also occur. 44318 ; This latter case is perhaps unlikely as TVT transport does not 44319 ; support parity. 44320 ; 44321 ; In either case, the IAC must quoted (meaning doubled) in order to be 44322 ; transmitted properly. This cannot happen with a DECnet NRT 44323 ; transport as signaling is done out-of-band. 44324 ; 44325 ; Kermit-20 previously looped through each packet to determine whether 44326 ; IAC doubling was necessary. Rewriting it to use the EXTEND MOVST 44327 ; instruction is part of ongoing loop elimination and replacement, 44328 ; another example being found [245], above. 44329 44330 chgsec(code,const) ; Translate tables go in constants area 44331 44332 000000 %iachr==.chnul ; 8 bit values start at NUL 44333 44334 001555'03 iactab: xlist ; Save some trees 44335 list ; Turn the blather back on 44336 44337 001755' %eotia==. ; Mark end of table 44338 44339 000177 %eotio==>_-1 ; Calculate offset of IAC pair 44340 001754'03 reloc iactab+%eotio ; Get there in translate table 44341 001754'03 000376 500377 xwd 376,trmcod!iac ; Stop if we hit an IAC 44342 44343 001755'03 reloc %eotia ; Get back to end of table 44344 44345 001755'03 015 00 0 00 001555' chriac: movst 0,iactab ; Stop on an IAC 44346 001756'03 000000 000000 .chnul ; Fill character is end of string 44347 44348 cleans(<%iachr,%eotia,%eotio>) ; Don't need these temporary symbols 44349 retsec ; Return to code section 44350 44351 ;[247] End table insertion 44352 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 72 K20SUB MAC 19-Jan-24 16:52 iaciac Double Interprete As a Command character 44353 subttl iaciac Double Interprete As a Command character 44354 44355 ;[247] Begin code insertion 44356 44357 ; Call: 44358 ; 44359 ; t1/ Source length 44360 ; t2/ Source 8 bit pointer 44361 ; t3/ Destination 8 bit pointer 44362 ; 44363 ; Return: 44364 ; 44365 ; +1, some error 44366 ; 44367 ; T1/ -1 indicates that t2 and t3 pointed to the same string 44368 ; 44369 ; +2, Following registers updated 44370 ; 44371 ; t1/ Length of source string 44372 ; t2/ Updated 44373 ; t3/ Updated 44374 ; t4/ Length of destination string 44375 ; 44376 ; N.B., Because an IAC will be doubled, if T2 and T3 point to the same 44377 ; string, the following character will be TRASHED wth the second 44378 ; IAC. Therefore, DO NOT DO THIS. iaciac will give a fail return 44379 ; with a -1 if it detects this situation. 44380 44381 003625'01 iaciac: entry iaciac ; Called by spak in k20mit and $echo in k20par 44382 003625'01 312 02 0 00 000003 came t2, t3 ; We're not going to overwrite, are we? 44383 003626'01 254 00 0 00 003632' ifskp. ; That's not any good ... 44384 003627'01 474 01 0 00 000000 seto t1, ; Flag the problem 44385 003630'01 263 17 0 00 000000 ret ; Give error return 44386 003631'01 254 00 0 00 003635' else. ; Otherwise, let's get started 44387 003632'01 265 16 0 00 004435' saveac 44388 003633'01 200 11 0 00 000001 move p1, t1 ; Save original source length 44389 003634'01 400 12 0 00 000000 setz p2, ; Zero count of doubles 44390 003635'01 endif. ; End case initial check 44391 44392 remark t2, ; Already has proper source pointer 44393 003635'01 200 05 0 00 000003 move q1, t3 ; Set up destination pointer 44394 003636'01 403 03 0 00 000006 setzb t3, q2 ; Section local pointers 44395 003637'01 200 04 0 00 000001 move t4, t1 ; Load source length 44396 003640'01 242 04 0 00 000001 lsh t4, ^d1 ; Maximum is double the entire string of IAC's... 44397 003641'01 201 07 0 00 000377 movx q3, IAC ; Handy IAC for doubling 44398 003642'01 621 01 0 00 300000 txz t1, N!M ; Turn off status bits 44399 44400 003643'01 do. ; Enter loop lexical context 44401 003643'01 661 01 0 00 400000 txo t1, S ; Start translating immediately 44402 003644'01 123 01 0 00 000000# extend t1, chriac ; Start looking for an IAC 44403 003645'01 600 00 0 00 000000 nop ; Don't care about premature ending 44404 003646'01 607 01 0 00 200000 ifxn. t1, N ; Hit an IAC?? 44405 003647'01 254 00 0 00 003654' 44406 003650'01 136 07 0 00 000005 idpb q3, q1 ; Yes, drop it in 44407 003651'01 136 07 0 00 000005 idpb q3, q1 ; ...Twice... k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 72-1 K20SUB MAC 19-Jan-24 16:52 iaciac Double Interprete As a Command character 44408 003652'01 271 12 0 00 000001 addi p2, ^d1 ; And count an extra character 44409 003653'01 275 04 0 00 000002 subi t4, ^d2 ; Account for two bytes used 44410 003654'01 endif. ; End case of premature termination 44411 003654'01 621 01 0 00 700000 txz t1, S!N!M ; Shut off all MOVST bits for length check 44412 003655'01 323 01 0 00 003660' jumple t1, endlp. ; Break out of loop if source exhausted 44413 003656'01 323 04 0 00 003660' jumple t4, endlp. ; Break out of loop if destination exhausted 44414 003657'01 254 00 0 00 003643' loop. ; Otherwise, more to do 44415 003660'01 enddo. ; End of loop lexical context 44416 44417 003660'01 200 01 0 00 000011 move t1, p1 ; Load source length 44418 remark t2, ; Return updated source pointer 44419 003661'01 200 03 0 00 000005 move t3, q1 ; Return updated destination pointer 44420 003662'01 200 04 0 00 000011 move t4, p1 ; Load source length 44421 003663'01 270 04 0 00 000012 add t4, p2 ; Add in doubled IAC's to get destination 44422 003664'01 254 00 0 00 003475* retskp ; Finally done 44423 44424 ;[247] End code insertion 44425 44426 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 73 K20SUB MAC 19-Jan-24 16:52 Various extended addressing bits 44427 SUBTTL Various extended addressing bits 44428 44429 ;[216] This is all lifted from the Extended Mode FTP Server I wrote --Tom 44430 44431 REMARK Some other stuff which perhaps should have it into MACSYM? 44432 44433 777700 000000 GP%2PF==MASKB(0,11) ; Double word pointer field 44434 770000 000000 GP%2PB==MASKB(0,5) ; Double word pointer position of byte 44435 007700 000000 GP%2SB==MASKB(6,11) ; Double word pointer size of byte 44436 000040 000000 GP%2WB==1B12 ; Double word pointer signal bit 44437 000037 777777 GP%2RS==MASKB(13,35) ; Double word reserved field 44438 377777 777777 GP%2AD==MASKB(1,35) ; Double word 30 bit address, including 44439 ; Indirect bit, index fields 44440 770000 000000 GP%1PF==MASKB(0,5) ; Single word pointer field 44441 007777 777777 GP%1AD==MASKB(6,35) ; Single word FLAT 30 bit address 44442 44443 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 74 K20SUB MAC 19-Jan-24 16:52 Double word to single word routine 44444 subttl Double word to single word routine 44445 44446 ; T2/ Double word pointer to convert 44447 ; T3/ 44448 ; 44449 ; +1 Bogus double word P&S fields 44450 ; +2 Success, coverted single word pointer in T1 44451 ; 44452 ; To do: What happends to the XMOVEI if the address pointer is bogus? 44453 ; (Bits 1 and 2 not [1|0] or [0|1] or non-zero data in reserved 44454 ; bits 2 through 12 in local indirect words) 44455 ; Is there a faster way to do this translation? 44456 44457 003665'01 627 02 0 00 000040 D2SGPC: TXZN T2,GP%2WB ; First things first, check and stomp 44458 003666'01 263 17 0 00 000000 RET ; the double word pointer bit. 44459 003667'01 630 02 0 00 004451' ANDX T2,GP%2PF ; Mask off any reserved or user sillyness 44460 003670'01 201 01 0 00 000031 MOVX T1,%OWMAX-1 ; Start at the end of the table 44461 003671'01 DO. ; Check to see if these are valid P&S 44462 003671'01 316 02 0 01 000000# CAMN T2,OW2DW(T1) ; fields for a one word global pointer 44463 003672'01 254 00 0 00 003674' EXIT. ; Found it! 44464 003673'01 365 01 0 00 003671' SOJGE T1,TOP. ; Get to next table entry 44465 003674'01 ENDDO. ; Until checked beginning 44466 003674'01 305 01 0 00 000000 CAIGE T1,0 ; Did we find a valid entry? 44467 003675'01 263 17 0 00 000000 RET ; Nope, can't do the conversion 44468 003676'01 271 01 0 00 000045 ADDI T1,^D37 ; Offset into proper single word P&S field 44469 003677'01 241 01 0 00 000036 ROT T1,<^D35-POS(GP%1PF)> ;Position to single word P&S field, saving 44470 003700'01 612 01 0 00 004452' TXNE T1,GP%1AD ; possible field overflow. And any junk? 44471 003701'01 263 17 0 00 000000 RET ; Yes, probably a bogus table offset 44472 remark ; Resolve any local or global indirection (impossible) 44473 003702'01 434 01 0 00 000003 IOR T1,T3 ; Load the 30 bit address into the one word 44474 003703'01 254 00 0 00 003664* RETSKP ; global pointer 44475 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 75 K20SUB MAC 19-Jan-24 16:52 One Word to Double word byte pointer translation table 44476 SUBTTL One Word to Double word byte pointer translation table 44477 44478 ; The table is copied from Page 2-85 in the User Operations section of 44479 ; the PDP-10 1982 Processor Reference Manual. Note that there is a 44480 ; documentation error for entry 40; it is listed as 28 and should be 18. 44481 44482 chgsec(code,const) ; Pointer table is considered constant data 44483 44484 001757'03 440600 000000 OW2DW: ; 37 Legal P&S ; 6 Bit Pointers 44485 001760'03 360600 000000 ; 38 Legal P&S 44486 001761'03 300600 000000 ; 39 Legal P&S 44487 001762'03 220600 000000 ; 40 Legal P&S 44488 001763'03 140600 000000 ; 41 Legal P&S 44489 001764'03 060600 000000 ; 42 Legal P&S 44490 001765'03 000600 000000 ; 43 Legal P&S 44491 001766'03 441000 000000 ; 44 Legal P&S ; 8 Bit Pointers 44492 001767'03 341000 000000 ; 45 Legal P&S 44493 001770'03 241000 000000 ; 46 Legal P&S 44494 001771'03 141000 000000 ; 47 Legal P&S 44495 001772'03 041000 000000 ; 48 Legal P&S 44496 001773'03 440700 000000 ; 49 Legal P&S ; 7 Bit Pointers 44497 001774'03 350700 000000 ; 50 Legal P&S 44498 001775'03 260700 000000 ; 51 Legal P&S 44499 001776'03 170700 000000 ; 52 Legal P&S 44500 001777'03 100700 000000 ; 53 Legal P&S 44501 002000'03 010700 000000 ; 54 Legal P&S 44502 002001'03 441100 000000 ; 55 Legal P&S ; 9 Bit Pointers 44503 002002'03 331100 000000 ; 56 Legal P&S 44504 002003'03 221100 000000 ; 57 Legal P&S 44505 002004'03 111100 000000 ; 58 Legal P&S 44506 002005'03 001100 000000 ; 59 Legal P&S 44507 002006'03 442200 000000 ; 60 Legal P&S ; 18 Bit Pointers 44508 002007'03 222200 000000 ; 61 Legal P&S 44509 002010'03 002200 000000 ; 62 Legal P&S 44510 000032 %OWMAX==.-OW2DW ; One Word Maximum byte pointer magic number 44511 .xcref %OWMAX ; Don't need this temporary in the cross reference 44512 suppress %OWMAX ; Don't need this temporary in the symbol listing 44513 44514 IFN <%OWMAX-<^D62-^D37+1>>,^_ 44515 <.fatal Illegal number of one word to double word pointer fields> 44516 44517 if2 < purge %OWMAX > ; Not needed after pass two 44518 retsec ; Restore .psect's 44519 44520 ;[216] End code insertion 44521 44522 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 76 K20SUB MAC 19-Jan-24 16:52 CRC Routines 44523 subttl CRC Routines 44524 44525 ;[66] CRC calculation 44526 ; 44527 ; This routine will calculate the CRC for a string, using the 44528 ; CRC-CCITT polynomial. 44529 ; 44530 ; The string should be the fields of the packet between but not including 44531 ; the and the block check, which is treated as a string of bits with 44532 ; the low order bit of the first character first and the high order bit of the 44533 ; last character last -- this is how the bits arrive on the transmission line. 44534 ; The bit string is divided by the polynomial 44535 ; 44536 ; x^16+x^12+x^5+1 44537 ; 44538 ; The initial value of the CRC is 0. The result is the remainder of this 44539 ; division, used as-is (i.e. not complemented). 44540 ; 44541 ; Contributed by Nick Bush, Stevens Institute of Technology. 44542 ; 44543 ; Call with 44544 ; t1/ length of string 44545 ; t2/ 8-bit byte pointer to string 44546 ; Returns +1 always, with t1/ 16-bit CRC, t2 unchanged. 44547 ; 44548 ; AC usage: 44549 ; t1/ Accumulated CRC 44550 ; q4/ Remaining length 44551 ; q3/ Byte pointer to string 44552 ; q2/ temp 44553 ; q1/ temp 44554 44555 003704'01 crcclc: entry crcclc ; Identify our location for LINK 44556 extern parity,none ; Inform of our necessary 44557 003704'01 265 16 0 00 004453' saveac ; Save q1-q4, and t2. 44558 003705'01 120 07 0 00 000001 dmove q3,t1 ; Get arguments. 44559 003706'01 400 01 0 00 000000 setz t1, ; Initial CRC is 0. 44560 003707'01 200 02 0 00 001477* move t2, parity ;[136] Get parity. 44561 44562 003710'01 do. ;[194] Enter loop context 44563 003710'01 134 05 0 00 000010 ildb q1, q4 ; Get a character. 44564 003711'01 302 02 0 00 001476* caie t2, none ;[136] Parity = NONE? 44565 003712'01 405 05 0 00 000177 andi q1, ^o177 ;[136] No, doing parity, strip parity bit. 44566 003713'01 431 05 0 01 000000 xori q1, (t1) ; Add in with current CRC. 44567 003714'01 135 06 0 00 004467' ldb q2, [point 4,q1,31] ;Get high 4 bits. 44568 003715'01 405 05 0 00 000017 andi q1, ^o17 ; AND low 4 bits. 44569 003716'01 200 05 0 05 000000# move q1, crctb2(q1) ; Get low portion of CRC factor. 44570 003717'01 430 05 0 06 000000# xor q1, crctab(q2) ; Plus high portion. 44571 003720'01 242 01 0 00 777770 lsh t1, -^d8 ; Shift off a byte from previous CRC. 44572 003721'01 430 01 0 00 000005 xor t1, q1 ; Add in new value. 44573 003722'01 367 07 0 00 003710' sojg q3, top. ; Loop for all characters. 44574 003723'01 enddo. ;[194] Fall out of loop context 44575 44576 003723'01 263 17 0 00 000000 ret ; Done, return +1 with CRC in t1. 44577 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 77 K20SUB MAC 19-Jan-24 16:52 Data tables for CRC-CCITT generation 44578 subttl Data tables for CRC-CCITT generation 44579 44580 chgsec(code,const) ;[208] Table goes in constants section 44581 44582 002011'03 000000 000000 crctab: oct 0 44583 002012'03 000000 010201 oct 10201 44584 002013'03 000000 020402 oct 20402 44585 002014'03 000000 030603 oct 30603 44586 002015'03 000000 041004 oct 41004 44587 002016'03 000000 051205 oct 51205 44588 002017'03 000000 061406 oct 61406 44589 002020'03 000000 071607 oct 71607 44590 002021'03 000000 102010 oct 102010 44591 002022'03 000000 112211 oct 112211 44592 002023'03 000000 122412 oct 122412 44593 002024'03 000000 132613 oct 132613 44594 002025'03 000000 143014 oct 143014 44595 002026'03 000000 153215 oct 153215 44596 002027'03 000000 163416 oct 163416 44597 002030'03 000000 173617 oct 173617 44598 44599 002031'03 000000 000000 crctb2: oct 0 44600 002032'03 000000 010611 oct 10611 44601 002033'03 000000 021422 oct 21422 44602 002034'03 000000 031233 oct 31233 44603 002035'03 000000 043044 oct 43044 44604 002036'03 000000 053655 oct 53655 44605 002037'03 000000 062466 oct 62466 44606 002040'03 000000 072277 oct 72277 44607 002041'03 000000 106110 oct 106110 44608 002042'03 000000 116701 oct 116701 44609 002043'03 000000 127532 oct 127532 44610 002044'03 000000 137323 oct 137323 44611 002045'03 000000 145154 oct 145154 44612 002046'03 000000 155745 oct 155745 44613 002047'03 000000 164576 oct 164576 44614 002050'03 000000 174367 oct 174367 44615 retsec ;[208] Re-open executable code 44616 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 78 K20SUB MAC 19-Jan-24 16:52 setgrd - set up guard pages for stacks, etc. 44617 subttl setgrd - set up guard pages for stacks, etc. 44618 44619 ; Lifted from Extended Mode FTP server I wrote, EFTPSA. 44620 ; 44621 ; A guard page is a no-access page, call it 'explode-on-use'. 44622 44623 .endps code ; End code psect 44624 .psect data ; Need some local storage 44625 44626 000075'05 000000 000000 myccoc: 0 ;[161] CCOC words for my tty. 44627 000076'05 000000 000000 0 ;[161] (two of them) 44628 000077'05 000000 000000 ttpau: 0 ;[161] Controlling TTY's pause chars. 44629 44630 000100'05 000000 000000 grdpg2: 0 ; Guard page in memory 44631 000101'05 000000 000000 grdadr: 0 ; Address of same 44632 000102'05 000000 000000 grdhan: 0 ; File handle of guard page 44633 000103'05 000000 000000 grdmap: 0 ; Process handle of guard page 44634 .endps data ; Done with writable storage 44635 44636 .psect datend/ronly,111000 ; Mark the end of the data .psect 44637 000000'06 datgrd: block ^d512 ; So we can drop in a guard page 44638 .endps datend ; Yet doesn't store anything 44639 44640 .psect const ; Table of addresses goes in constants 44641 002051'03 000000 006000 guardp: macgp1 ; Macro guard page 1 (before mapping window) 44642 002052'03 000000 010000 macgp2 ; Second guard page is after file mapping window 44643 002053'03 000000 020000 macgp3 ; Third guard page is after macro storage 44644 002054'03 000000 030000 macgp4 ; Fourth guard page is after garbage collection 44645 emacro < ; Only if I've finished the macro editor ... 44646 macgp5 ; Fifth guard page is after macro editing 44647 >;;emacro 44648 002055'03 000000000000# datgrd ; Put a guard page here, too 44649 002056'03 777777 777777 -1 ; Note list MUST end in -1!! 44650 .endps const ; End of constants 44651 .psect code ; Reopen code psect 44652 44653 003724'01 setgrd: entry setgrd ; Called at start up 44654 003724'01 265 16 0 00 004233' saveac ; Save some scratch registers 44655 003725'01 260 17 0 00 003746' call fepage ; Go find an illegal page 44656 003726'01 263 17 0 00 000000 ret ; But couldn't ... 44657 003727'01 124 01 0 00 000000# dmovem t1, grdpg2 ; Record as guard page double word 44658 003730'01 202 03 0 00 000000# movem t3, grdhan ; Save the file page handle, also 44659 003731'01 550 05 0 00 000001 hrrz q1, t1 ; Load the in-memory guard page 44660 003732'01 505 05 0 00 600000 hrli q1, .fhslf!fh%epn ; Convert to extended page handle in this fork 44661 003733'01 202 05 0 00 000000# movem q1, grdmap ; Save as a guard page mapping 44662 003734'01 415 06 0 00 000000# xmovei q2, guardp ; Load the address of guard page list 44663 44664 003735'01 do. ; Loop, setting up guard pages 44665 003735'01 335 02 0 06 000000 skipge t2, (q2) ; Pick up the guard page address 44666 003736'01 263 17 0 00 000000 ret ; Done, leave 44667 remark Case III: ; Mapping One Process's Pages to Another Process 44668 003737'01 242 02 0 00 777767 adr2pg t2, ; Convert address to page 44669 003740'01 505 02 0 00 600000 hrli t2, .fhslf!fh%epn ; page handle for this process 44670 003741'01 200 01 0 00 000005 move t1, q1 ; Load our base guard page handle 44671 003742'01 205 03 0 00 000200 movx t3, pm%epn ; Going into a non-zero section k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 78-1 K20SUB MAC 19-Jan-24 16:52 setgrd - set up guard pages for stacks, etc. 44672 003743'01 104 00 0 00 000056 PMAP% ; Finally map in a bogus page 44673 003744'01 320 12 0 00 003745' erjmpr .+1 ; Catch and ignore error 44674 003745'01 344 06 0 00 003735' aoja q2, top. ; Loop for another guard page 44675 003746'01 enddo. ; End of loop lexical context 44676 44677 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 79 K20SUB MAC 19-Jan-24 16:52 FEPAGE - Find an illegal page to map 44678 SUBTTL FEPAGE - Find an illegal page to map 44679 44680 ; Original code lifted from Tops-20 Extended Mode FTP server. 44681 ; 44682 ; Creates a page in the page map that is illegal to reference in *ANY* 44683 ; way, including reading. Does this by first finding a page in our 44684 ; address space that contains a page from our executable and then 44685 ; mapping in a page that file that is known not to exist and cannot be 44686 ; created. 44687 ; 44688 ; I call it an 'Explode-on-Use' page. 44689 ; 44690 44691 ; A guard page is created by mapping in a non-existant page that is 44692 ; past the end of our executable file. The executable file has the 44693 ; following properties: it is not extendable while mapped nor is it 44694 ; copy-on-write. Thus, a write to this file page will fail because 44695 ; the .EXE is locked. A read will fail because the page must be 44696 ; created in order to be read. Since it isn't writable to begin with, 44697 ; it can't be created. 44698 ; 44699 ; See R.E. Gorin, "Introduction to DECSYSTEM-20 Assembly Language 44700 ; Programming", page 443, footnote 3 for further details. Thanks to 44701 ; MRC for suggesting this approach. 44702 ; 44703 ; Returns: 44704 ; 44705 ; T1/ Page number of guard page 44706 ; T2/ 30 bit address of guard page 44707 ; T3/ File window handle of guard page (JFN,,Page number) 44708 ; 44709 ; Note: Maybe I ought to use XRMAP% below in case I have to shuttle 44710 ; through a lot of pages. In practice, however, I rarely have to 44711 ; process more than one page, so it didn't seem worth it and therefore 44712 ; I used a simple RMAP% instead. 44713 ; 44714 ; To do: MRC said that for certain size executable, this code won't 44715 ; work. Check for that size here and do something intelligent 44716 ; if so. Or gronk. 44717 44718 003746'01 265 16 0 00 004470' fepage: saveac ; Needs some registers 44719 003747'01 201 14 0 00 000031 movx p4, ^d25 ; Don't look through more than this many pages 44720 003750'01 415 13 0 00 003750' xmovei p3, . ; Load current executable address 44721 003751'01 242 13 0 00 777767 adr2pg p3, ; Convert address to page which we don't 44722 ; look at because DDT is probably there 44723 003752'01 fndpag: do. ; Now find a page with our JFN in it 44724 003752'01 363 14 0 00 003472* sojle p4, R ; Did this too many times? Return +1 44725 003753'01 350 01 0 00 000013 aos t1, p3 ; Increment and load page number 44726 003754'01 505 01 0 00 600000 hrli t1,.fhslf!fh%epn ; Looking at this fork 44727 003755'01 104 00 0 00 000057 RPACS% ; Find out the access 44728 003756'01 320 12 0 00 003752' erjmpr top. ; Couldn't, go to next page 44729 003757'01 607 02 0 00 010000 txnn t2, pa%pex ; Does the page exist? 44730 003760'01 254 00 0 00 003752' loop. ; No, go look for another one 44731 003761'01 603 02 0 00 000200 txne t2, pa%prv ; Is the page private? 44732 003762'01 254 00 0 00 003752' loop. ; Yes, we need one with a JFN in it k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 79-1 K20SUB MAC 19-Jan-24 16:52 FEPAGE - Find an illegal page to map 44733 003763'01 104 00 0 00 000061 rmap% ; Get a handle on the page 44734 003764'01 320 12 0 00 003752' erjmpr top. ; Gronked, go on to next page 44735 003765'01 607 02 0 00 010000 txnn t2, pa%pex ; Sanity Check: does the page still exist? 44736 003766'01 254 00 0 00 003752' loop. ; No, go look for another one 44737 003767'01 554 01 0 00 000001 hlrz t1, t1 ; Load just the process/file designator 44738 003770'01 306 01 0 00 400000 cain t1, .fhslf ; Quick check, this isn't our own process, is it? 44739 003771'01 254 00 0 00 003752' loop. ; Yah, it is, so worthless; bum the GTSTS% 44740 003772'01 104 00 0 00 000024 GTSTS% ; Otherwise, see if we can use this? 44741 003773'01 320 12 0 00 003752' erjmpr top. ; No JFN, so just go to the next page 44742 003774'01 607 02 0 00 000200 txnn t2, gs%nam ; Is anything in there a JFN? 44743 003775'01 254 00 0 00 003752' loop. ; No, not safe to use 44744 003776'01 607 02 0 00 400000 txnn t2, gs%opn ; Is the file open? 44745 003777'01 254 00 0 00 003752' loop. ; No, won't be able to PMAP% it 44746 004000'01 603 02 0 00 100000 txne t2, gs%wrf ; Better not be for write 44747 004001'01 254 00 0 00 003752' loop. ; It is, will self-create, then 44748 004002'01 607 02 0 00 020000 txnn t2, gs%rnd ; Open for non-append access? 44749 004003'01 254 00 0 00 003752' loop. ; No, will extend then 44750 remark ; If we get here, we fall out of the loop 44751 004004'01 enddo. ; End of loop context 44752 ; Otherwise, we have a safe page to use 44753 004004'01 553 13 0 00 000001 hrrzs p3, t1 ; Save a nice JFN 44754 004005'01 104 00 0 00 000036 SIZEF% ; Get the number of pages in the file 44755 004006'01 320 12 0 00 003752' erjmpr fndpag ; Can't, so keep looking 44756 004007'01 540 01 0 00 000013 hrr t1, p3 ; Load our executable JFN 44757 004010'01 504 01 0 00 000003 hrl t1, t3 ; Start REAL NEAR the end of the file 44758 004011'01 104 00 0 00 000031 FFFFP% ; Find the first unused (free) file page 44759 004012'01 320 12 0 00 003752' erjmpr fndpag ; Can't, so keep looking 44760 004013'01 316 01 0 00 004172' camn t1, [-1] ; None?? 44761 004014'01 254 00 0 00 003752' jrst fndpag ; No, continue the journey 44762 44763 remark ; Otherwise, have a guard page from the file!! 44764 004015'01 200 12 0 00 000001 move p2, t1 ; Save as source designator 44765 44766 remark Case I: ; Mapping File Pages to a Process 44767 004016'01 514 01 0 00 000013 hrlz t1, p3 ; JFN of executable file in the left half 44768 004017'01 540 01 0 00 000012 hrr t1, p2 ; Page number of executable file 44769 dmove t2,[.fhslf!fh%epn,,grdpag ; Fork and page handle 44770 004020'01 120 02 0 00 004502' pm%epn] ; going into any section 44771 004021'01 104 00 0 00 000056 PMAP% ; Finally map in a bogus page 44772 004022'01 320 12 0 00 003752' erjmpr fndpag ; Gronked, try the old way 44773 004023'01 550 04 0 00 000002 hrrz t4, t2 ; Load the page we mapped 44774 004024'01 242 04 0 00 000011 pg2adr t4, ; Convert to address 44775 004025'01 200 01 1 00 000004 move t1, @t4 ; The moment of truth, this should fail 44776 004026'01 320 12 0 00 004030' ifje. r ; Well, did it? 44777 004027'01 254 00 0 00 004036' 44778 remark ; All is well, return the data 44779 004030'01 514 03 0 00 000013 hrlz t3, p3 ; Load executable file JFN 44780 004031'01 540 03 0 00 000012 hrr t3, p2 ; Load the file page number of the guard page 44781 004032'01 550 01 0 00 000002 hrrz t1, t2 ; Load page number of guard page in memory 44782 004033'01 200 02 0 00 000004 move t2, t4 ; Load the address of the guard page in memory 44783 004034'01 254 00 0 00 003703* retskp ; And return success 44784 004035'01 254 00 0 00 004037' else. ; ?? 44785 004036'01 254 00 0 00 003752' jrst fndpag ; Try some more 44786 004037'01 endif. 44787 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 80 K20SUB MAC 19-Jan-24 16:52 Break out various flags from JFN flags 44788 subttl Break out various flags from JFN flags 44789 44790 ;[252] Begin code insertion 44791 ; 44792 ; Used when debugging results of COMND% functions .CMINI, .CMOFI, and 44793 ; .CMFIL, GTJFN% (with GJ%FLG) and GNJFN%. Written to help debug 44794 ; directory listing logic when doing a wildarded (DSK*:) listing. 44795 ; 44796 repeat 0,< ;[252] Unnecessary now that debugging is done 44797 ; 44798 ; Call: 44799 ; 44800 ; t1/ JFN and flags 44801 ; 44802 ; From monsym.mac: 44803 ; 44804 ;Flags returned by GTJFN% and GNJFN% 44805 ; 44806 ;GTJFN% flags returned 44807 remark GJ%DEV 1B0 Asterisk was given for device 44808 remark GJ%UNT 1B1 Asterisk was given for unit 44809 remark GJ%DIR 1B2 Asterisk was given for directory 44810 remark GJ%NAM 1B3 Asterisk was given for name 44811 remark GJ%EXT 1B4 Asterisk was given for extension 44812 remark GJ%VER 1B5 Asterisk was given for generation 44813 remark GJ%UHV 1B6 Use highest generation 44814 remark GJ%NHV 1B7 Use next higher generation 44815 remark GJ%ULV 1B8 Use lowest generation 44816 remark GJ%PRO 1B9 Protection attribute (;P) given 44817 remark GJ%ACT 1B10 Account attribute (;A) given 44818 remark GJ%TFS 1B11 Temporary file attribute (;T) given 44819 remark GJ%GND 1B12 Complement of GJ%DEL on call 44820 remark GJ%NOD 1B13 Node name was given 44821 ;GNJFN% flags returned 44822 remark GN%STR 1B13 Structure changed 44823 remark GN%DIR 1B14 Directory changed 44824 remark GN%NAM 1B15 Name changed 44825 remark GN%EXT 1B16 Extension changed 44826 ;GTJFN 44827 remark GJ%GIV 1B17 Complement of G1%IIV 44828 44829 ; Note that the bit conflict between GJ%NOD and GN%STR is ignored as 44830 ; Kermit does not use GTJFN% to parse for a node name, but rather 44831 ; COMND%'s .CMNOD function. 44832 44833 jfnflg: entry jfnflg ; Globalize entry 44834 jumpe t1, r ; Ignore if nothing there ... 44835 skipe local ; Only if NOT local 44836 ret ; Don't junk up the remote connection... 44837 saveac 44838 44839 hrrz q2, t1 ; Load just the new JFN 44840 hllz q1, t1 ; Looking at just the stepping flags 44841 caie q2, .nulio ; Just dumping it? 44842 ifskp. ; Yes, set up other flags k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 80-1 K20SUB MAC 19-Jan-24 16:52 Break out various flags from JFN flags 44843 movx q3, GS%NAM ; Just say that it's bound 44844 else. ; Otherwise, have a look at the JFN's health 44845 tlz t1, -1 ; Stomp any flags so GTSTS% doesn't choke 44846 GTSTS% ; Now see if we can use this. 44847 ifje. r ; Might fail... 44848 move t3, t1 ; Save the error 44849 setz q3, ; Force gs%nam off 44850 else. ; Otherwise, it worked 44851 move q3, t2 ; Save those flags 44852 endif. ; End case GTSTS% handling 44853 endif. ; End case .nulio special handling 44854 44855 ifxe. q3, GS%NAM ; Is this a valid JFN? 44856 txmsg <(Invalid) > ; Yes, say so 44857 ret ; Nothing else to do 44858 endif. 44859 ; Otherwise, start breaking out bits 44860 ifxn. q1, GJ%DEV ; Device wildcarded? 44861 txmsg ; Yes, say so 44862 endif. 44863 ifxn. q1, GJ%UNT ; Unit wildcarded? 44864 txmsg ; Yes, say so 44865 endif. 44866 ifxn. q1, GJ%DIR ; Directory wildcarded? 44867 txmsg ; Yes, say so 44868 endif. 44869 ifxn. q1, GJ%NAM ; File name wildcarded? 44870 txmsg ; Yes, say so 44871 endif. 44872 ifxn. q1, GJ%EXT ; Extension wildcarded? 44873 txmsg ; Yes, say so 44874 endif. 44875 ifxn. q1, GJ%VER ; Version wildcarded? 44876 txmsg ; Yes, say so 44877 endif. 44878 ; Generation specification 44879 ifxn. q1, GJ%UHV ; Use highest generation? 44880 txmsg ; Yes, say so 44881 endif. 44882 ifxn. q1, GJ%NHV ; Next highest generation? 44883 txmsg ; Yes, say so 44884 endif. 44885 ifxn. q1, GJ%ULV ; Lowest generation? 44886 txmsg ; Yes, say so 44887 endif. 44888 ; Other attributes 44889 ifxn. q1, GJ%PRO ; Protection attribute given? 44890 txmsg <;P > ; Yes, say so 44891 endif. 44892 ifxn. q1, GJ%ACT ; Account attribute given? 44893 txmsg <;A > ; Yes, say so 44894 endif. 44895 ifxn. q1, GJ%TFS ; Temporary attribute given? 44896 txmsg <;T > ; Yes, say so 44897 endif. k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 80-2 K20SUB MAC 19-Jan-24 16:52 Break out various flags from JFN flags 44898 ifxE. q1, GJ%GND ; Got a deleted file? (Complement of GJ%DEL) 44899 txmsg ; Yes, say so 44900 endif. 44901 ifxE. q1, GJ%GIV ; Got an Invisible file? (complement of GN%IIN) 44902 txmsg ; Yes, say so 44903 endif. 44904 ; GNJFN%'s stepping flags 44905 ifxn. q1, GN%STR ; Structure changed? 44906 txmsg ; Yes, say so 44907 endif. 44908 ifxn. q1, GN%DIR ; Directory changed? 44909 txmsg ; Yes, say so 44910 endif. 44911 ifxn. q1, GN%NAM ; Name changed? 44912 txmsg ; Yes, say so 44913 endif. 44914 ifxn. q1, GN%EXT ; Extension changed? 44915 txmsg ; Yes, say so 44916 endif. 44917 ; GTSTS% flags 44918 ifxn. q3, GS%OPN ; Is the file open? 44919 txmsg ; Yes, say so 44920 endif. 44921 ifxn. q3, GS%WRF ; Open for write? 44922 txmsg ; Yes, say so 44923 endif. 44924 44925 movei t1, .priou ; Always typing on terminal 44926 caie q2, .nulio ; Dumping it? 44927 ifskp. ; That's easy! 44928 dmove t2, nul4 ; Constant string and length 44929 setz t4, ; In case anybody looks ... 44930 SOUT% ; Type it 44931 erjmpr .+1 ; Catch and ignore error 44932 else. ; Otherwise, an actual JFN to type 44933 move t2, q2 ; Load the JFN 44934 dmove t3, allfld ; dev:name.typ.gen 44935 JFNS% ; Let's see what the complete file is 44936 ifje. r ; Catch the error 44937 move t4, t1 ; Save error for debuggers 44938 move t2, t1 ; Store the error 44939 hrli t2, .fhslf ; This process 44940 setz t3, ; Indefinite blating 44941 movei t1, .priou ; Type on terminal 44942 ERSTR% ; Blat 44943 erjmpr .+2 ; Ignore strange return 44944 erjmpr .+1 ; Ignore stranger return 44945 endif. ; End case JFNS% error handling 44946 endif. ; End case NUL: special casing 44947 ret ; Done 44948 44949 > ;repeat 0 ;[252] 44950 44951 ;[252] End code insertion 44952 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 81 K20SUB MAC 19-Jan-24 16:52 ASCII capability list 44953 subttl ASCII capability list 44954 44955 ;[252] Begin code insertion 44956 ; 44957 ; Lifted and adapted from eftpss.mac (Extended Mode FTP server Site Specific code) 44958 ; 44959 ; N.B. Depends on three character capabilities! 44960 44961 repeat 0,< ;[252] Unnecessary now that debugging is done 44962 44963 remark Table of Capabilities and their abbreviations 44964 44965 captab: asciz /ctc/ ; SC%CTC==:1B0 Control-C 44966 asciz /gtb/ ; SC%GTB==:1B1 GETAB% 44967 asciz /mmn/ ; SC%MMN==:1B2 Map monitor 44968 asciz /log/ ; SC%LOG==:1B3 Logging functions 44969 asciz /mpp/ ; SC%MPP==:1B4 Map privileged pages 44970 asciz /sdv/ ; SC%SDV==:1B5 Special devices 44971 asciz /sct/ ; SC%SCT==:1B6 Assign TTY as controlling for fork (SCTTY%) 44972 0 ; Unknown 1B7 Capability 44973 0 ; Unknown 1B8 Capability 44974 asciz /sup/ ; SC%SUP==:1B9 Superior access 44975 0 ; Unknown 1B10 Capability 44976 0 ; Unknown 1B11 Capability 44977 0 ; Unknown 1B12 Capability 44978 0 ; Unknown 1B13 Capability 44979 0 ; Unknown 1B14 Capability 44980 0 ; Unknown 1B15 Capability 44981 0 ; Unknown 1B16 Capability 44982 asciz /frz/ ; SC%FRZ==:1B17 Freeze on terminating conditions 44983 asciz /whl/ ; SC%WHL==:1B18 Wheel 44984 asciz /opr/ ; SC%OPR==:1B19 Operator 44985 asciz /cnf/ ; SC%CNF==:1B20 Confidential Information Access 44986 asciz /mnt/ ; SC%MNT==:1B21 Maintenance 44987 asciz /ipc/ ; SC%IPC==:1B22 IPCF 44988 asciz /enq/ ; SC%ENQ==:1B23 ENQ/DEQ 44989 asciz /nwz/ ; SC%NWZ==:1B24 NET wizard (ASNSQ%, ETC.) 44990 asciz /nas/ ; SC%NAS==:1B25 Network Absolute Socket Privilege 44991 asciz /dna/ ; SC%DNA==:1B26 DECnet access allowed 44992 asciz /ana/ ; SC%ANA==:1B27 ARPAnet access allowed (Internet) 44993 asciz /sem/ ; SC%SEM==:1B28 Semi-Opr 44994 asciz /mea/ ; SC%MEA==:1B29 Mini-Exec Access Allowed ;[T198] 44995 0 ; Unknown 1B30 Capability 44996 0 ; Unknown 1B31 Capability 44997 0 ; Unknown 1B32 Capability 44998 0 ; Unknown 1B33 Capability 44999 0 ; Unknown 1B34 Capability 45000 asciz /adm/ ; SC%ADM==:1B35 PANDA Administrator 45001 capend:! 45002 45003 ifn , 45004 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 82 K20SUB MAC 19-Jan-24 16:52 ASCII capability list 45005 subttl Capability display code 45006 45007 ; t1/ 36 bit capability word 45008 45009 infcap: entry infcap ; Used in k20srv 45010 saveac 45011 skipe q1, t1 ; Save and check 45012 ifskp. ; None? 45013 txmsg <(None) > ; That's easy! 45014 ret ; All done! 45015 endif. 45016 ; Allocate some anonymous stack space 45017 anstkv (q4, <^D<<<2*80>/5>+1>>) 45018 move t1, q4 ; Load the address of the scratch stack space 45019 txo t1, .p07 ; Turn into ASCII OWGP in case non-zero section 45020 setzb t2, t3 ; Zero capability name registers 45021 setz t4, q3 ; Zero the bit holder and loop counter 45022 45023 do. 45024 jumpe q1, endlp. ; Anything left to do? 45025 lshc t4,^d1 ; Pick off a capability bit from q1 45026 ifxn. t4, 1b35 ; If it was set, display it if known 45027 move t3, captab(q3) ; Pick up the capability abbreviation 45028 cain t3, 0 ; Is it defined? 45029 call capcon ; No, phoney something up 45030 call depcap ; Display it 45031 endif. ; Otherwise, remember that it wasn't 45032 caige q3, ^d36 ; Are we still playing with a full DEC? 45033 aoja q3, top. ; Go get another bit 45034 enddo. 45035 45036 setz t4, ; Cons up a NUL 45037 move t3, t1 ; Get a copy of the point 45038 idpb q1, t3 ; Terminate the string, allowing append 45039 45040 move t1, q4 ; Load the address of the scratch stack space again 45041 txo t1, .p07 ; Turn into ASCII OWGP in case non-zero section 45042 PSOUT% ; Finally type something 45043 ret 45044 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 83 K20SUB MAC 19-Jan-24 16:52 ASCII capability list 45045 subttl Capability display support code 45046 45047 REMARK Cons up a capability abbreviation 45048 45049 capcon: skipge t2, q3 ; Load the current capability counter 45050 ret ; Better just not do anything 45051 caile t2, ^D35 ; Should NEVER be a capability larger than 35!! 45052 ret ; Just don't proceed 45053 idivi t2, ^d10 ; Extract the ones digit to T3 45054 lsh t2, <1+<^d3*^d7>> ; Shift tens digit over to second byte of word 45055 lsh t3, <1+<^d2*^D7>> ; Shift ones digit over to third byte of word 45056 add t3, [asciz /u00/] ; Unknown capability base 45057 add t3, t2 ; Don't forget the one's digit! 45058 RET ; Return the ASCII capability abbreviation 45059 45060 REMARK Special purpose routine to drop in the capability abbreviation 45061 45062 depcap: lshc t2, ^d7 ; Shift in and deposit three bytes 45063 idpb t2, t1 45064 lshc t2, ^d7 45065 idpb t2, t1 45066 lshc t2, ^D7 45067 idpb t2, t1 45068 movx t2, .chspc ; Space delimiter 45069 idpb t2, t1 45070 ret 45071 45072 > ;repeat 0 ;[252] 45073 45074 ;[252] End code insertion 45075 45076 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 84 K20SUB MAC 19-Jan-24 16:52 fndvec Find and record the symbol table vector 45077 subttl fndvec Find and record the symbol table vector 45078 45079 ; The EXEC shouldn't need this for things like ^T, yet it does... 45080 ; 45081 ; We don't need to do a PDVOP% to find our program data vector 45082 ; address because we are giving it its own .PSECT and therefore 45083 ; are setting the address ourselves 45084 ; 45085 ; We can't have LINK do this because LINK won't write .JBSYM when 45086 ; doing PDV's. 45087 ; 45088 ; Adapted from SETNOD rewrite (SETND2) 45089 ; 45090 ; N.B., While the code will properly find a symbol table in any 45091 ; section, it won't work unless it is run in a non-zero section. 45092 ; Since Kermit is effectively a section zero program with some ASCII 45093 ; data being accessed via one word global pointers, the symbol table 45094 ; and the symbol table vector must also be in section zero. 45095 45096 remark [233] 11:47am Saturday, 31 December 2022 45097 45098 ; The above isn't true, of course, we could use two 18 one word global 45099 ; pointers to fetch and OR two half words or jump into a non-zero 45100 ; section to get the data (see fetch and efetch, below). The problem 45101 ; is that this would have involved some non-obvious modifications to 45102 ; the below and the symbol table lookup routine which I didn't see 45103 ; the value of doing as opposed to finishing the NRT functionality. 45104 ; 45105 ; At the time, I didn't realize that although LINK isn't going to do 45106 ; what we want, there is nothing stopping us from using MACRO itself 45107 ; to deposit values in fixed locations in the 'low segement' area. 45108 ; See the end of this module for a bunch of loc statements, not all of 45109 ; which may be absolutely necessary, strictly speaking. 45110 ; 45111 ; The point was to maintain reverse compatibility with any PA1050 45112 ; based programs or other archaic Tops-20 oddities that hadn't been 45113 ; been upgraded to PDV's (as in, just about all of them), one in 45114 ; particular being the EXEC. 45115 ; 45116 ; The EXEC was modified in edit [T255] to the EXECP.MAC module to 45117 ; handle a 'modern' symbol table vector, which could be in a non-zero 45118 ; section. 45119 45120 ; See commentary below for new version of EXEC [T255] which can handle 45121 ; a modern symbol table vector. This gets the parts of it we want for 45122 ; later. 45123 45124 ifndef .jbsym, <.jbsym==116> ; Low segment symbol table pointer (old style) 45125 ifndef .jbsa , <.jbsa==120> ; Program start address 45126 ifndef .jbff , <.jbff==121> ; Program first free location 45127 ifndef .jbren, <.jbren==124> ; Low segment reenter word 45128 ifndef .jbver, <.jbver==137> ; Low segment version word 45129 45130 004037'01 fndvec: entry fndvec ; Called on start up 45131 remark ; Expects full run of temporaries k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 84-1 K20SUB MAC 19-Jan-24 16:52 fndvec Find and record the symbol table vector 45132 004037'01 265 16 0 00 004233' saveac ; But follow the rules, anyway 45133 004040'01 402 00 0 00 000000# setzm glbsym ; Clear global symbol table flag 45134 004041'01 403 01 0 00 000002 setzb t1, t2 ; Cons up some more zeros 45135 004042'01 124 01 0 00 000000# dmovem t1, symvec ; Stomp symbol vector and defined symbol table 45136 45137 remark ; N.B., DEPENDs on 'low segment' hand crafting, below 45138 004043'01 336 05 0 00 000116 skipn q1,.jbsym ; Nothing there? 45139 004044'01 263 17 0 00 000000 ret ; Nope, that's easy! (but useless) 45140 45141 004045'01 254 05 0 00 004046' xjrstf .+1 ; Go 'upstairs' to grab the value 45142 004046'01 010000 000000 pc%usr ; Don't try to break out of user mode 45143 004047'01 000001 000000# extsec,,fndve1 ; 'long jump' to extended mode operation 45144 .endps code ; Finish execution of section zero code 45145 45146 .psect ecode ; Resuming execution in extended code section 45147 45148 remark Caution ; The stack is ONLY valid in section zero!! 45149 45150 000012'02 fndve1: remark ; N.B., All the indirect addressing is a little slower 45151 000012'02 476 00 1 00 000130' setom @[0,,glbsym] ; Let's assume it's global (which it should be) 45152 000013'02 627 05 0 00 400000 txzn q1, 1b0 ; Just check if it's local (which it shouldn't be) 45153 000014'02 254 00 0 00 000016' ifskp. ; That's strange, but we can fix that up 45154 000015'02 501 05 0 00 000015' xhlli q1,. ; Stomp in the section number 45155 remark @[0,,glbsym] ; So it's still global (heh...) 45156 000016'02 endif. ; 45157 000016'02 202 05 1 00 000131' movem q1, @[0,,symvec] ; Store as symbol table VECTOR 45158 45159 000017'02 336 06 1 00 000005 skipn q2, @q1 ; Pull the vector length (first location) 45160 000020'02 254 00 0 00 000050' jrst fndver ; If we have one... 45161 45162 remark ; Otherwise, there is SOMETHING in there 45163 000021'02 325 06 0 00 000026' ifl. q2 ; Old style symbol table? (shouldn't be up here..) 45164 000022'02 202 06 1 00 000132' movem q2, @[0,,kjbsym] ;That's easy; just use it 45165 000023'02 254 05 0 00 000024' xjrstf .+1 ; And go 'downstairs' to return to caller 45166 000024'02 010000 000000 pc%usr ; Don't try to break out of user mode 45167 000025'02 000000000000# rskp ; Give +2 return 45168 000026'02 endif. ; End case old symbol table pointer in a strange place 45169 45170 remark ; New style symbol table vector! Grovel through it 45171 000026'02 363 06 0 00 000050' sojle q2, fndver ; But!! If nothing is in there, it's all over 45172 000027'02 415 05 0 05 000001 xmovei q1, 1(q1) ; Load address of first subtable 45173 000030'02 do. ; Enter loop context 45174 000030'02 120 01 0 05 000000 dmove t1, .stdat(q1) ; Load ST%TYP and ST%LEN and .STPTR 45175 000031'02 135 03 0 00 000133' ldb t3,[pointr (t1,st%typ)] ; Load table type 45176 000032'02 135 04 0 00 000134' ldb t4,[pointr (t1,st%len)] ; Load table length 45177 000033'02 302 03 0 00 000001 caie t3, .r50d ; Is the type a defined symbol table?? 45178 000034'02 254 00 0 00 000045' ifskp. ; Yes! It is!! 45179 000035'02 323 04 0 00 000045' andg. t4 ; But!! Does it contain any symbols? 45180 000036'02 210 03 0 00 000004 movn t3, t4 ; Load negative of length 45181 000037'02 514 01 0 00 000003 hrlz t1, t3 ; Assumes table is not greater than a section 45182 000040'02 540 01 0 00 000002 hrr t1, t2 ; Now have base of subtable 45183 000041'02 202 01 1 00 000135' movem t1,@[0,,kjbsym] ;Save for symbol table routine 45184 000042'02 254 05 0 00 000043' xjrstf .+1 ; And go 'downstairs' to return to caller 45185 000043'02 010000 000000 pc%usr ; Don't try to break out of user mode 45186 000044'02 000000000000# rskp ; Give +2 return k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 84-2 K20SUB MAC 19-Jan-24 16:52 fndvec Find and record the symbol table vector 45187 000045'02 endif. ; End case defined symbol table 45188 000045'02 415 05 0 05 000003 xmovei q1, .stsiz(q1) ; Load address of next subtable 45189 000046'02 275 06 0 00 000003 subi q2, .stsiz ; Account for words used in symbol block 45190 000047'02 327 06 0 00 000030' jumpg q2, top. ; Look some more, if anything left 45191 000050'02 enddo. ; End of loop context 45192 45193 remark ; If fell through, then never found symbol table 45194 ; Which is an error 45195 45196 000050'02 fndver: remark ; Here on any kind of error 45197 000050'02 402 00 1 00 000136' setzm @[0,,.jbsym] ; .jbsym is gubbish, so stop paying attention 45198 000051'02 402 00 1 00 000137' setzm @[0,,symvec] ; Stomp the symbol table vector too, it's bogus 45199 000052'02 254 05 0 00 000053' xjrstf .+1 ; And go 'downstairs' to return to caller 45200 000053'02 010000 000000 pc%usr ; Don't try to break out of user mode 45201 000054'02 000000000000# r ; Give +1 return 45202 45203 .endps ecode ; Get out of extended code 45204 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 85 K20SUB MAC 19-Jan-24 16:52 Magical symbol table lookup routine 45205 SUBTTL Magical symbol table lookup routine 45206 45207 ; For details, read "Introduction to DECSYSTEM-20 Assembly Language 45208 ; Programming", by Ralph Gorin, published by Digital Press, 1981. 45209 ; 45210 ; Called with desired symbol in T1 45211 45212 .psect code ; Starts out in section zero 45213 45214 004050'01 symout: entry symout ; Declare to the world 45215 004050'01 265 16 0 00 004504' saveac 45216 45217 004051'01 200 06 0 00 000001 move q2, t1 ; Save the desired symbol 45218 004052'01 403 03 0 00 000005 setzb t3 ,q1 ; no current program name or best symbol 45219 004053'01 200 04 0 00 000000# move t4, kjbsym ; Load (fixed to old style symbol table pointer 45220 004054'01 254 05 0 00 004055' xjrstf .+1 ; Go 'upstairs' to symbolically print the value 45221 004055'01 010000 000000 pc%usr ; Don't try to break out of user mode 45222 004056'01 000001 000000# extsec,,symou1 ; 'long jump' to extended mode operation 45223 .endps code ; Finish execution of section zero code 45224 45225 .psect ecode ; Resuming execution in extended code section 45226 45227 remark Caution ; The stack is ONLY valid in section zero!! 45228 45229 000055'02 322 04 0 00 000120' symou1: jumpe t4, plsoff ; Unless we don't have a symbol table 45230 000056'02 574 01 0 00 000004 hlre t1, t4 ; Convert halfword length to fullword 45231 000057'02 274 04 0 00 000001 sub t4, t1 ; -count,,ending address +1 45232 ; And hit search loop 45233 000060'02 do. ; Load this symbol's type 45234 000060'02 135 01 0 00 000140' ldb t1,[point 4,-2(t4),3] 45235 000061'02 322 01 0 00 000076' ifn. t1 ; program names are not relevant 45236 000062'02 303 01 0 00 000002 caile t1, ^o2 ; 0=prog name, 1=global, 2=local 45237 000063'02 254 00 0 00 000076' anskp. ; So skip this symbol 45238 000064'02 200 01 0 04 777777 move t1, -1(t4) ; Load value associated with the symbol 45239 000065'02 312 01 0 00 000006 came t1, q2 ; Is this an exact match, per chance? 45240 000066'02 254 00 0 00 000071' ifskp. ; It is, so no need for an offset 45241 000067'02 200 05 0 00 000004 move q1, t4 ; Just select it 45242 000070'02 254 00 0 00 000100' exit. ; And get out of the loop 45243 000071'02 endif. 45244 000071'02 311 01 0 00 000006 caml t1, q2 ; Is the value before the value sought? 45245 000072'02 254 00 0 00 000076' anskp. ; No, so can't use (would be a negative offset) 45246 000073'02 332 02 0 00 000005 skipe t2, q1 ; Otherwise get the best one so far (if there is one) 45247 000074'02 311 01 0 02 777777 caml t1, -1(t2) ; compare to previous best 45248 000075'02 200 05 0 00 000004 move q1, t4 ; current symbol is best match so far 45249 000076'02 endif. ; End case symbol selection 45250 000076'02 270 04 0 00 000141' add t4, [2000000-2] ; Add 2 in the left, sub 2 in the right 45251 000077'02 321 04 0 00 000060' jumpl t4,top. ; Loop unless control count is exhausted 45252 000100'02 enddo. 45253 45254 000100'02 322 05 0 00 000120' ifn. q1 ; Did we have anything that could help? 45255 000101'02 200 02 0 00 000006 move t2, q2 ; Yes, get desired value 45256 000102'02 274 02 0 05 777777 sub t2, -1(q1) ; Less symbol's value = offset 45257 000103'02 301 02 0 00 000200 cail t2, 200 ; Is the offset small enough to be conceptually useful? 45258 000104'02 254 00 0 00 000120' anskp. ; No, we can't count that high in our head 45259 000105'02 200 01 0 05 777776 move t1, -2(q1) ; Load RADIX50 symbol name k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 85-1 K20SUB MAC 19-Jan-24 16:52 Magical symbol table lookup routine 45260 000106'02 621 01 0 00 740000 txz t1, ; Clear the symbols' flags 45261 000107'02 do. ; Build us a return address 45262 000107'02 254 14 0 00 000007 xsfm q3 ; Save processor flags 45263 000110'02 415 10 0 00 000114' xmovei q4,endlp. ; Load end of this pseudo-loop (return address) 45264 000111'02 254 05 0 00 000112' xjrstf .+1 ; Go 'downstairs' to use the stack 45265 000112'02 010000 000000 pc%usr ; Don't try to break out of user mode 45266 000113'02 000000 000000# 0,,sqztyo ; 'long jump' to section zero to print symbol name 45267 000114'02 enddo. ; End of this strange call linkage 45268 000114'02 274 06 0 05 777777 sub q2, -1(q1) ; Value we wanted less this symbol's value 45269 000115'02 322 06 0 00 000125' jumpe q2, plsof1 ; If no offset, don't print "+0" 45270 000116'02 201 01 0 00 000053 movei t1, "+" ; Append a plus sign to the output line 45271 000117'02 104 00 0 00 000074 pbout% 45272 000120'02 endif. 45273 45274 000120'02 201 01 0 00 000101 plsoff: movei t1, .priou ; and copy numeric offset to output 45275 000121'02 200 02 0 00 000006 move t2, Q2 ; Load offset from symbol 45276 000122'02 201 03 0 00 000010 movei t3, ^d8 ; Addresses are in octal... 45277 000123'02 104 00 0 00 000224 NOUT% 45278 000124'02 320 12 0 00 000125' erjmpr plsof1 ; Catch and ignore error 45279 000125'02 254 05 0 00 000126' plsof1: xjrstf .+1 ; And go 'downstairs' to return to caller 45280 000126'02 010000 000000 pc%usr ; Don't try to break out of user mode 45281 000127'02 000000000000# r ; Give +1 return 45282 45283 .endps ecode ; Done with non-zero section execution 45284 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 86 K20SUB MAC 19-Jan-24 16:52 recursively convert a 32-bit quantity in T1 from squoze to ASCII 45285 subttl recursively convert a 32-bit quantity in T1 from squoze to ASCII 45286 45287 .psect code ; Needs to be in section zero to use the stack 45288 45289 remark Caution ; Called with inter-section hand crafted JSP-type linkage 45290 45291 ; Call: 45292 ; 45293 ; t1/ SQUOZE word 45294 ; q3/ Processor flags to restore 45295 ; q4/ 30 bit return address 45296 45297 004057'01 261 17 0 00 004072' sqztyo: push p,sqztyr ; Push inter-section return address 45298 004060'01 265 16 0 00 004522' saveac ; Save t2, just in case 45299 45300 004061'01 231 01 0 00 000050 sqzty1: idivi t1, 50 ; divide by 50 to extract a Radix-50 'digit' 45301 004062'01 261 17 0 00 000002 push p, t2 ; save remainder, a Radix-50 character 45302 004063'01 332 00 0 00 000001 skipe t1 ; if T1 is now zero, unwind the stack 45303 004064'01 260 17 0 00 004061' call sqzty1 ; call self again, reducing t1 by an another 'digit' 45304 45305 remark ; If we fall through, then it's type to unwind 45306 004065'01 262 17 0 00 000001 pop p, t1 ; Get characters back in reverse order 45307 004066'01 133 01 0 00 004074' adjbp t1, rdx50c ; Index to the correct character 45308 004067'01 135 01 0 00 000001 ldb t1, t1 ; convert squoze code to ASCII 45309 004070'01 104 00 0 00 000074 pbout% ; Type it 45310 004071'01 263 17 0 00 000000 ret ; Continue unwinding, finally 'returning' below 45311 45312 004072'01 254 00 0 00 004073' sqztyr: jrst .+1 ; This pushed jrst goes to the xjrstf 45313 004073'01 254 05 0 00 000007 xjrstf q3 ; Transfer back to non-section zero caller 45314 45315 004074'01 35 07 0 00 004075' rdx50c: point 7,.+1,6 ; Points to the first character in the string (the space) 45316 004075'01 040 060 061 062 063 ascii " 0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ.$%" 45317 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 87 K20SUB MAC 19-Jan-24 16:52 fetch a word from extended address space 45318 subttl fetch a word from extended address space 45319 45320 ;[223] Begin code insertion 45321 45322 ; Call: 45323 ; 45324 ; t1/ Extended address to fetch 45325 ; 45326 ; Return: 45327 ; 45328 ; t1/ Updated in all cases 45329 ; 45330 ; +1/ Possible error code 45331 ; +2/ Value at specified location 45332 45333 repeat 0,< ; Actually turned out to be unnecessary ... 45334 fetch: saveac ; Save a scratch register 45335 xjrstf .+1 ; Go 'upstairs' to grab the value 45336 pc%usr ; Don't try to break out of user mode 45337 extsec,,efetch ; 'long jump' to extended mode operation 45338 45339 .endps code ; Get out of section zero 45340 .psect ecode ; and into non-zero section 45341 45342 efetch: move t2, @t1 ; Grab whatever we've been pointed at 45343 erjmpr fetche ; Unless it was gubbish 45344 45345 move t1, t2 ; Return value in t1 45346 xjrstf .+1 ; Go 'downstairs' to return to caller 45347 pc%usr ; Don't try to break out of user mode 45348 rskp ; Give +2 return 45349 45350 fetche: remark ; Here on addressing error from move 45351 xjrstf .+1 ; Go 'downstairs' to return to caller 45352 pc%usr ; Don't try to break out of user mode 45353 r ; Give +1 return 45354 45355 .endps ecode ; Get out of extended code 45356 .psect code ; And back into section zero code 45357 >;repeat 0 ; End removal 45358 45359 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 88 K20SUB MAC 19-Jan-24 16:52 Kermit Entry Vector and Version 45360 subttl Kermit Entry Vector and Version 45361 45362 ;[197] Moved here to support symbol table fix up, yet some still in k20mit 45363 45364 ; Used to help LINK build version word 45365 45366 extern $verno ; Major version number. 45367 extern $mnver ; Minor version number (minimum: 1). 45368 extern $edno ; Edit number increases independent of version. 45369 extern $who ; Who edited, 0=Columbia. 45370 45371 ; Used to help LINK to build entry vector 45372 45373 extern start ; Regular entry 45374 extern reen ; 'Re-enter' address 45375 45376 ; 'Modern' Tops-20 entry vector 45377 45378 004105'01 254 00 0 00 000000* kermit: jrst start ; Start entry. 45379 004106'01 254 00 0 00 000000* jrst reen ; Re-entry. 45380 k20ver==:FLD($who,VI%WHO)!FLD($verno,VI%MAJ)!FLD($mnver,VI%MIN)!^_ 45381 000000000000# FLD($edno,VI%EDN)!VI%DEC ;;[184] Want decimal version numbers 45382 004107'01 000000000000# k20ver ;[190] 45383 000003 evlen==.-kermit ; Mark for k20mit end statement 45384 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 89 K20SUB MAC 19-Jan-24 16:52 Closing Code particulars 45385 subttl Closing Code particulars 45386 45387 xlist ; Save the trees!! 45388 list ; Resume listing 45389 45390 .endps code ; Close the code .psect 45391 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 90 K20SUB MAC 19-Jan-24 16:52 Data storage, not in global scope 45392 subttl Data storage, not in global scope 45393 45394 .psect data ; Writable 45395 repeat 0,< ;[218] 45396 tmcbit: 0 ;[194] Time channel bit 45397 > ;[218] 45398 000104'05 000000 000000 ccichr: 0 ;[219] Control-C Interrupt Character (we used) 45399 45400 000105'05 000000 000000 aicx: 0 ;[194] Count of AIC% failures 45401 000106'05 000000 601405 laicer: lstrx1 ;[194] Last AIC% error (no error) 45402 000107'05 000000 601405 ltimcr: lstrx1 ;[194] Last TIMER% creation (.timel) error 45403 000110'05 000000 000000 dicx: 0 ;[194] Count of DIC% errors 45404 000111'05 000000 601405 ldicer: lstrx1 ;[194] Last DIC% error (no error) 45405 000112'05 000000 601405 ltimde: lstrx1 ;[194] Last .TIMBF (delete) error 45406 45407 000113'05 000000 000000 glbsym: 0 ;[197] If global (should never be) 45408 000114'05 000000 000000 symvec: 0 ;[197] Address of symbol table vector 45409 000115'05 000000 000000 kjbsym: 0 ;[197] Kermit's defined symbol table 45410 45411 000116'05 000000 000000 ddtf:: 0 ;[197] Debugger present flag 45412 000117'05 lcltte: block 10 ; Last errors encounter by LCLTTY 45413 000127'05 lcltef: remark ; Final location to whack 45414 000127'05 lcldev: block 1 ; Device we're going to try 45415 000130'05 lclnam: block 4 ; Space for constructed terminal 45416 000134'05 lcljfn: block 1 ; JFN we got 45417 000135'05 lclflg: block 1 ; Associated flags (which we don't use) 45418 000136'05 lclpar::block 1 ;[223] Local terminal parity 'toleration' 45419 45420 000137'05 000000 000000 ccn: 0 ;[187] Number of ^C's typed. 45421 000140'05 000000 000000 psave: 0 ; Stack pointer for ^C interrupt. 45422 000141'05 000000 000000 psave2: 0 ; Stack top for ^C interrupt. 45423 000142'05 000000 000000 tsave: 0 ;[132] Same as above, but for timer interrupts. 45424 000143'05 000000 000000 tsave2: 0 ;[132] ... 45425 000144'05 000000 000000 pc1: 0 ;[196] Interrupt PC storage, levels 1, 45426 000145'05 000000 000000 pc2: 0 ; 2, 45427 000146'05 000000 000000 pc3:: 0 ; and 3. 45428 45429 000147'05 605457 664562 'plover' ; Talsiman to see if stomped 45430 .endps data 45431 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 91 K20SUB MAC 19-Jan-24 16:52 Misc. utility .PSECT's 45432 subttl Misc. utility .PSECT's 45433 45434 remark File Mapping Page 45435 .psect filepg,maporg ; File mapping window 45436 000000'07 block maplen ; Reserves a page 45437 .endps ; Allows LINK time checking 45438 45439 remark Guard pages for files and macros 45440 45441 .psect guard/ronly,grdorg ; Declare detonate-on-use page 45442 .endps ; Nothing in it until runtime 45443 45444 .psect guard1/ronly,macgp1 45445 000000'11 007071 727271 'xyzzy' ; Force a magic page... 45446 000001'11 block ^d511 ; Keep LINK up to date on size 45447 .endps guard1 45448 45449 .psect guard2/ronly,macgp2 45450 000000'12 006054 654750 'plugh' ; Force another magic page... 45451 000001'12 block ^d511 ; Keep LINK up to date on size 45452 .endps guard2 45453 45454 .psect guard3/ronly,macgp3 45455 000000'13 605457 664562 'plover' ; Force another magic page... 45456 000001'13 block ^d511 ; Keep LINK up to date on size 45457 .endps guard3 45458 45459 .psect guard4/ronly,macgp4 45460 000000'14 005465 555763 'lumos' ; Force another magic page... 45461 000001'14 block ^d511 ; Keep LINK up to date on size 45462 .endps guard4 45463 45464 emacro < 45465 .psect guard5/ronly,macgp5 45466 'nox' ; Force another magic page... 45467 block ^d511 ; Keep LINK up to date on size 45468 .endps guard5 45469 >;;emacro 45470 45471 remark Symbol table .PSECT 45472 .text "/symseg:psect:symbol" ; Tell LINK where to put the goodies 45473 .psect symbol/ronly,symorg ; Write-Protected symbols 45474 .endps symbol ; Close out the PSECT 45475 45476 remark Seperate patch area .PSECT, otherwise it will be read-only 45477 .text "/patchsize:0" ; Tell LINK not to allocate a patch area 45478 .psect patch,patorg ; Patch area 45479 000000'16 PAT..:: block patlen ; Override LINK 45480 .endps patch ; Close out the PSECT 45481 45482 remark Reserve pages for in-section DDT so code doesn't bump into it 45483 .psect ddt/ronly,700000 ; If DDT is in section 0 45484 000000'17 block 777777-700000+1 ; Reserve last 64 pages 45485 .endps ddt 45486 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 92 K20SUB MAC 19-Jan-24 16:52 PDV setup and location 45487 subttl PDV setup and location 45488 45489 ; This is the Program Data Vector .PSECT. We don't write anything 45490 ; directly in there; we pass switchs to have LINK fill it in for us 45491 45492 .text "/pvblock:psect:pdv" ; Put program PDV's in the PDV .PSECT 45493 .psect pdv/ronly,pdvorg ; Write-Protected PDV! 45494 .endps pdv ; Close out the PSECT 45495 45496 ; Macro to resolve symbols into values for stupid LINK. 45497 ; Note, this must be last or the macro will produce X errors 45498 ; because the symbols haven't been seen yet. Maybe see 45499 ; what IF2 would do if we want to move this around. 45500 45501 define defpdv (name,data) < 45502 .text "/pvdata:'name':#'data" 45503 >;define defpdv 45504 45505 ; Note, although the monitor knows about the reenter address 45506 ; (the PDV offset is .PVREE), LINK doesn't. Sigh... 45507 45508 .text '/pvdata:name:"K20MIT"' ;;Different from save name 45509 defpdv start,\kermit ; Kermit start address 45510 ; defpdv reentr,\reen ; Kermit reenter address (obsolete) 45511 ; remark ; Have to set this in LINK 45512 ; defpdv version,\k20ver ; Kermit version word 45513 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 93 K20SUB MAC 19-Jan-24 16:52 'Low segment' fix ups 45514 SUBTTL 'Low segment' fix ups 45515 45516 ;[227] Begin code insertion 45517 45518 ;[T255] Build page zero by hand since EXEC can now handle a symbol 45519 ; table in a non-zero section, but LINK doesn't quite set everything 45520 ; up correctly. 45521 ; 45522 ; A multi-section program can get complicated enough so that LINK 45523 ; can't fill in values in the 'low segment' with the 'appropriate' 45524 ; values. The problem is certain programs which don't use PDV's to 45525 ; find this stuff out, the first being an enhanced GLXLIB and the 45526 ; other being the EXEC, which may not be able to tell which PDV to 45527 ; use. 45528 ; 45529 ; Therefore, we issue the /NOINITIAL /NOJOBDAT switches *first* to 45530 ; keep LINK from getting it wrong and poke the values in ourselves, 45531 ; here. See JOBDAT for additional information. 45532 45533 033000 kjbffl== ; Kermit's first free location is after the patch area 45534 45535 ; N.B., This LOC/RELOC Hackery *MUST* take place in the outer-most .PSECT!!!! 45536 45537 000116 loc .jbsym ; Get to symbol table pointer 45538 000116 000001 400000 symorg ; The EXEC can now handle a symbol table vector!! 45539 000120 loc .jbsa ; Get to job start address 45540 000120 033000 000000# xwd kjbffl,kermit ; Note, odd left half 45541 000121 loc .jbff ; Get to first free location 45542 000121 000000 033000 kjbffl ; End defined writable storage 45543 000124 loc .jbren ; The Reenter address 45544 000124 000000000000# reen ; This is all in Kermit's entry vector, actually... 45545 000137 loc .jbver ; Get to the version word 45546 000137 000000000000# k20ver ; Drop Kermit's version in 45547 45548 000000'00 reloc ; Get back ... someplace ... 45549 45550 ;[227] End code insertion 45551 45552 000003 004105' end evlen,,kermit ;[197] Had to get moved here, sigh... NO ERRORS DETECTED PROGRAM BREAK IS 000000 PSECT 1 BREAK IS 004533 FOR CODE PSECT 2 BREAK IS 000142 FOR ECODE PSECT 3 BREAK IS 002057 FOR CONST PSECT 4 BREAK IS 000472 FOR ETEXT PSECT 5 BREAK IS 000150 FOR DATA PSECT 6 BREAK IS 001000 FOR DATEND PSECT 7 BREAK IS 001000 FOR FILEPG PSECT 10 BREAK IS 000000 FOR GUARD PSECT 11 BREAK IS 001000 FOR GUARD1 PSECT 12 BREAK IS 001000 FOR GUARD2 PSECT 13 BREAK IS 001000 FOR GUARD3 PSECT 14 BREAK IS 001000 FOR GUARD4 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 19:42 30-Mar-24 Page 93-1 K20SUB MAC 19-Jan-24 16:52 'Low segment' fix ups PSECT 15 BREAK IS 000000 FOR SYMBOL PSECT 16 BREAK IS 002000 FOR PATCH PSECT 17 BREAK IS 100000 FOR DDT PSECT 20 BREAK IS 000000 FOR PDV CPU TIME USED 00:02.001 125P CORE USED k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 19:42 30-Mar-24 Page S-1 K20SUB MAC 19-Jan-24 16:52 SYMBOL TABLE AIC 104000 000131 int GJ%FLG 000020 000000 sin OT%NDA 400000 000000 sin SBK 000000 ext AIC% 104000 000131 int GJ%SHT 000001 000000 sin P 000017 SC%CTC 400000 000000 sin ALLFLD 000000 ext GPJFN% 104000 000206 int P1 000011 spd SC%DNA 001000 sin ATI 104000 000137 int GRDORG 033000 spd P2 000012 spd SC%GTB 200000 000000 sin ATI% 104000 000137 int GRDPAG 000033 spd P3 000013 spd SC%OPR 200000 sin ATMBUF 000000 ext GS%ERR 000400 000000 sin P4 000014 spd SC%WHL 400000 sin BADMSK 113777 176377 spd GS%NAM 000200 000000 sin P5 000015 spd SCHR 000013 spd BOUT 104000 000051 int GS%OPN 400000 000000 sin PA%PEX 010000 000000 sin SCRLFT 000000 ext BOUT% 104000 000051 int GS%RND 020000 000000 sin PA%PRV 000200 000000 sin SFCOC 104000 000113 int CALL 260740 000000 GS%WRF 100000 000000 sin PANDAS 000001 sin SFCOC% 104000 000113 int CALLRE 254000 000000 spd GTJFN% 104000 000020 int PARS1 000000 ext SFMOD 104000 000110 int CF%NUD 400000 000000 sin GTSTS% 104000 000024 int PARS2 000000 ext SFMOD% 104000 000110 int CHFDB% 104000 000064 int GUARD 000000 ext PARS3 000000 ext SFPTR% 104000 000027 int CJFNBK 000000 ext GUARD1 000000 ext PARS4 000000 ext SIR% 104000 000125 int CLOSF% 104000 000022 int GUARD2 000000 ext PARS5 000000 ext SIZEF% 104000 000036 int CLSX1 600160 int GUARD3 000000 ext PATCH 000000 ext SOUT% 104000 000053 int CO%NRJ 400000 000000 sin GUARD4 000000 ext PATLEN 002000 spd SPACK 000000 ext CODE 000000 ext HALTF% 104000 000170 int PATORG 031000 spd SPSIZ 000000 ext CONST 000000 ext IAC 000377 spd PBOUT 104000 000074 int ST%LEN 007777 777777 spd CRLF 000000 ext JFNS% 104000 000030 int PBOUT% 104000 000074 int ST%TYP 770000 000000 spd CX 000016 JOBTAB 000000 ext PC%USR 010000 000000 sin STIW 104000 000174 int CZ%ABT 004000 000000 sin KJBFFL 033000 spd PDV 000000 ext STIW% 104000 000174 int CZSEEN 000000 ext KLFLGS 777700 000000 spd PDVORG 575000 spd STPAR 104000 000217 int DATA 000000 ext LSTRX1 601405 int PGSHFT 000011 sin STPAR% 104000 000217 int DATEND 000000 ext M 100000 000000 spd PKTNUM 000000 ext STRBUF 000000 ext DDT 000000 ext MACGP1 006000 spd PM%EPN 000200 000000 sin SUBBP 000000 ext DEBRK 104000 000136 int MACGP2 010000 spd PM%RD 100000 000000 sin SYMBOL 000000 ext DEBRK% 104000 000136 int MACGP3 020000 spd PM%WR 040000 000000 sin SYMORG 000001 400000 spd DESX1 600150 int MACGP4 030000 spd PMAP% 104000 000056 int T1 000001 spd DESX3 600152 int MAPLEN 001000 spd PSOUT 104000 000076 int T2 000002 spd DEVST% 104000 000121 int MAPORG 007000 spd PSOUT% 104000 000076 int T3 000003 spd DIC 104000 000133 int MAPPAG 000007 spd Q1 000005 spd T4 000004 spd DIC% 104000 000133 int MAXBUF 024000 spd Q2 000006 spd T5 000005 spd DTI 104000 000140 int MAXPKT 000140 spd Q3 000007 spd TIMER 104000 000522 int DTI% 104000 000140 int MO%CDN 777000 000000 sin Q4 000010 spd TIMER% 104000 000522 int DV%TYP 000777 000000 sin MO%DAV 777000 sin Q5 000011 spd TLGJFN 000000 ext DVCHR% 104000 000117 int MO%INA 000777 000000 sin R 000000 ext TRMCOD 500000 spd ECDORG 000001 575000 spd MO%PAR 000010 sin RCHR 000012 spd TS%CTC 001000 000000 spd ECODE 000000 ext MOVSLJ 016000 000000 REEN 000000 ext TS%CTM 200000 000000 spd EIR% 104000 000126 int MOVST 015000 000000 RET 263740 000000 TS%DEV 010000 000000 spd EOSCOD 100000 spd MTOPR% 104000 000077 int RF%LNG 400000 000000 sin TS%EFH 002000 000000 spd EPCAP% 104000 000151 int N 200000 000000 spd RFCOC 104000 000112 int TS%ERR 400000 000000 spd ERJMPR 320500 000000 int NDXJFN 000000 ext RFCOC% 104000 000112 int TS%FRK 040000 000000 spd ERJMPS 320600 000000 int NOP 600000 000000 sin RFMOD% 104000 000107 int TS%JFN 020000 000000 spd ERRPTR 000000 ext NOUT 104000 000224 int RFSTS% 104000 000156 int TS%LGL 000200 000000 spd ERSTR% 104000 000011 int NOUT% 104000 000224 int RLJFN 104000 000023 int TS%LGW 000400 000000 spd ESOUT% 104000 000313 int NUL4 000000 ext RLJFN% 104000 000023 int TS%PRO 100000 000000 spd ETEXT 000000 ext NXTJFN 000000 ext RMAP% 104000 000061 int TT%DAM 000300 sin EXTSEC 000001 spd ODTIM% 104000 000220 int RPACS% 104000 000057 int TT%DUM 000014 sin FB%BSZ 007700 000000 sin OF%BSZ 770000 000000 sin RPCAP% 104000 000150 int TT%ECO 004000 sin FFFFP% 104000 000031 int OF%MOD 007400 000000 sin RSKP 000000 ext TT%LCA 040000 000000 sin FH%EPN 200000 sin OF%RD 200000 sin RT%DIM 400000 000000 sin TT%LEN 037600 000000 sin FILEPG 000000 ext OF%WR 100000 sin RTIW 104000 000173 int TT%LIC 000020 sin FILJFN 000000 ext OPENF% 104000 000021 int RTIW% 104000 000173 int TT%MFF 200000 000000 sin GD%PAR 000001 sin OPNX1 600120 int S 400000 000000 spd TT%OSP 400000 000000 sin k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 19:42 30-Mar-24 Page S-2 K20SUB MAC 19-Jan-24 16:52 SYMBOL TABLE TT%PGM 000002 sin .CHSPC 000040 sin .TICCX 000030 sin TT%TAB 100000 000000 sin .CHTAB 000011 sin .TICCY 000031 sin TT%UOC 000040 sin .CMIOJ 000001 sin .TICCZ 000032 sin TT%WID 000177 000000 sin .CTTRM 777777 sin .TIMAL 000005 sin TT%WKA 010000 sin .DVDES 600000 sin .TIMEL 000001 sin TT%WKF 100000 sin .DVNUL 000015 sin .TTDES 400000 sin TT%WKN 040000 sin .DVTTY 000012 sin .XSTKS 000000 ext TT%WKP 020000 sin .FBBYV 000011 sin TTYJFN 000000 ext .FBSIZ 000012 sin UDJINF 000000 ext .FHJOB 777773 sin VI%DEC 400000 sin .FHSLF 400000 sin VI%EDN 377777 sin .FP 000015 spd VI%MAJ 077700 000000 sin .FPAC 000005 spd VI%MIN 000077 000000 sin .GSIMG 000010 sin VI%WHO 700000 000000 sin .JIBAT 000011 sin XHLLI 501000 000000 int .JITNO 000001 sin XJRSTF 254240 000000 int .MOCIA 000776 sin XMOVEI 415000 000000 int .MOOFF 000000 sin XSFM 254600 000000 int .MOPCR 000053 sin $CTCOC 000011 .MOPCS 000052 sin $CTMOD 000014 .MORBM 000037 sin $DVCHR 000005 .MORLL 000032 sin $GPJFN 000003 .MORLT 400001 sin $MOPCR 000026 .MORLW 000030 sin $MORBM 000034 .MORNT 000035 sin $MORLL 000020 .MORTF 000054 sin $MORLT 000032 .MORXO 000044 sin $MORLW 000016 .MOSBM 000040 sin $MORNT 000022 .MOSLL 000033 sin $MORTF 000030 .MOSLT 400002 sin $MORXO 000024 .MOSLW 000031 sin $PRIOU 000000 ext .MOSNT 000034 sin $TIF 000042 .MOSTF 000055 sin $TIW 000043 .MOXOF 000043 sin $TSARG 000001 .NULIO 377777 sin $TSERR 000002 .PRIIN 000100 sin $TSFLG 000000 .PRIOU 000101 sin %%KRBF 000000 ext .PX7 610001 000000 spd ..MSK 777777 777777 spd .R50D 000001 spd .A16 000016 spd .RFCNT 000000 sin .AC1 000001 spd .RFSFL 000004 sin .CHBEL 000007 sin .SAC 000016 .CHBSP 000010 sin .SAV1 000000 ext .CHCNA 000001 sin .SAV2 000000 ext .CHCNB 000002 sin .SAV3 000000 ext .CHCNC 000003 sin .SIGIO 677777 sin .CHCNP 000020 sin .STDAT 000000 spd .CHCNX 000030 sin .STSIZ 000003 spd .CHCNY 000031 sin .TICCA 000001 sin .CHCNZ 000032 sin .TICCC 000003 sin .CHCRT 000015 sin .TICCG 000007 sin .CHDAS 000055 sin .TICCM 000015 sin .CHDEL 000177 sin .TICCO 000017 sin .CHLFD 000012 sin .TICCP 000020 sin .CHNUL 000000 sin .TICCT 000024 sin k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 19:42 30-Mar-24 Page S-3 K20SUB MAC 19-Jan-24 16:52 SYMBOL TABLE FOR PSECT CODE ABTFIL 001705' ext CZCHAN 000004 KRXBLT 000030' SAVTTY 000725' ent ADJTIM 002266' ext CZSEEN 003215' ext KRXPTR 000032' SBK 000000 ext ALLFLD 000237' ext CZTRAP 003215' KSERR0 000157' SCHCRT 003421' ALLTIM 002244' D2SGPC 003665' KSMSG0 000161' SCHLFD 003456' ARGTYP 000574' DELAY 001701' ext LCLERR 001455' SCRLFT 000245' ext ASCZCP 003500' ent DELAYF 001677' ext LCLTTY 001336' SETCSB 000524' ent BCTU 003047' ext DIRCH 003205' ext LDAV 002264' ext SETGRD 003724' ent BIGBOY 000556' ext DNCFLD 032776 776000 sin LEVTAB 002175' SETTY 001276' ent BLANKL 000030 spd DNCHAN 000032 LFDEXP 003451' SOURCE 003204' ext BLANKS 000000' DNCHB 001000 sin LFDPTR 003452' SPACK 000141' ext BOUTI% 000357' ent DNDFLD 776776 776000 sin LOCAL 002626' ext SPSIZ 000104' ext BYTSIZ 003002' ext DNTRAP 002232' ext MODOFF 001527' SPTOT 003122' ext C87MOV 003274' EBQFLG 003031' ext MODON 001530' SQZTY1 004061' CACHAN 000002 EBTFLG 003015' ext MOVASC 003476' int SQZTYO 004057' CAPAS 002525' ext ERRPTR 001510' ext MOVCRT 003417' SQZTYR 004072' CASEEN 002625' ext EVEN 001471' ext MOVLFD 003454' SRVFLG 002503' ext CATRAP 002745' EVLEN 000003 spd MOVSTU 003522' ent START 004105' ext CATRP1 003104' FEPAGE 003746' MOVSUC 003563' ent STCHR 003141' ext CAXZOF 002623' ent FILES 003110' ext MTOPRL 000006 spd STIMOU 002343' ext CAXZON 002554' ent FILJFN 003055' ext MTOPRT 001164' SUBBP 000077' ext CCCHAN 000001 FIXTTY 001503' ent MTOPSL 000006 spd SVSTT 001537' ext CCFAIL 002447' ext FLOW 001555' ext MTOPST 001173' SYMOUT 004050' ent CCOFF 002503' ent FNDPAG 003752' MXASCZ 024000 sin TBTFLG 001765' ext CCOFF2 002505' ent FNDVEC 004037' ent MYCAPS 002443' ext TIMCHB 400000 000000 sin CCOFF3 002525' FRCLO1 001661' MYTTY 001375' ext TIMDEL 002345' ent CCON 002411' ent FRCLOS 001621' ent NNAK 003156' ext TIMEIT 002246' ent CCON2 002454' FRCLOT 001677' NONE 003711' ext TIMEON 002307' ent CCTRAP 002730' FRKCHB 004000 sin NOTNUL 000522' TIMERX 002361' ext CHNGCH 003341' FRKCHN 000030 int NTIMOU 003166' ext TIMOFF 002343' ent CHNTAB 002200' FRTRAP 002230' ext NUL4 002767' ext TIWORD 001605' ext CMCHAN 000005 GDSWRP 001460' PAGCNT 003100' ext TLGJFN 002032' ext CMLOC 003234' ext GETLCL 001374' PAGNO 003064' ext TMCHAN 000000 CMPOFF 002653' ent GIVEUP 001705' ent PARITY 003707' ext TMTRAP 002363' ent CMPON 002572' ent GNDPAR 001462' ext PARPKO 001500' ext TRNCHR 000454 spd CMPTR2 003245' GP%1AD 007777 777777 spd PARRCK 001501' ext TTYINI 001531' ent CMSEEN 003226' ext GP%1PF 770000 000000 spd PINIT 002373' ent TTYJFN 001531' ext CMTRAP 003226' GP%2AD 377777 777777 spd PKTNUM 000136' ext TTYOB 000657' ent CNCHAR 003343' GP%2PB 770000 000000 spd R 003752' ext TTYOU 000704' ent CPCHAN 000027 GP%2PF 777700 000000 spd RCVING 003137' ext UDJINF 001276' ext CPLOC 003244' ext GP%2RS 000037 777777 spd RDCLOS 001754' ent UNMAPA 002116' CPSEEN 003236' ext GP%2SB 007700 000000 spd RDCLSA 002001' UNMAPO 002066' ent CPTRAP 003236' GP%2WB 000040 000000 spd RDCLSC 002031' YESNUL 000517' CRCCLC 003704' ent HALT 001536' ext RDCLSD 002052' $CCN 000002 spd CRLF 003400' ext HANDSH 001554' ext RDCLSV 001761' $CLRBS 003257' ext CRTEXP 003411' IACIAC 003625' ent RDCLSZ 002064' $EDNO 000000 ext CRTPTL 003415' INICAP 000534' ent RDX50C 004074' $MNVER 000000 ext CRTPTR 003413' INTPC 002364' ext REEN 004106' ext $MODOF 037777 174374 spd CURTIM 002267' ext INTSTK 002370' ext RESTTY 001202' ent $MODON 340000 000002 spd CXCHAN 000003 ISNULJ 000376' ent RPTFLG 003036' ext $PRIOU 001325' ext CXSEEN 003201' ext ITSFIL 003024' ext RPTOT 003130' ext $VERNO 000000 ext CXTRAP 003201' JOBTAB 000000 ext RSKP 004034' ext $WAITJ 003261' ext CYCHAN 000031 K20HDR 000254' int RSTLNW 002152' ent $WHO 000000 ext CYOFF 002676' ent K20PTR 000033' RTCHR 003144' ext %%JSER 000257' ent CYON 002603' ent K20VER 000000000000# pol S8CCV7 003276' ent %%KRBF 000032' ext CYTRAP 003252' KERMIT 004105' SAVLNW 002130' ent %%KRMS 000035' ent k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 19:42 30-Mar-24 Page S-4 K20SUB MAC 19-Jan-24 16:52 SYMBOL TABLE FOR PSECT CODE %%SMS1 000344' ..0310 000654' spd ..0612 001264' spd ..1226 002300' spd %%SMSG 000311' ent ..0311 000656' spd ..0614 001274' spd ..1227 002306' spd %KERMS 000133' ent ..0326 000744' spd ..0626 001272' spd ..1234 002304' spd %WTLGF 000173' ..0334 000760' spd ..0627 001274' spd ..1235 002306' spd %WTLOG 000170' ent ..0341 000762' spd ..0637 001324' spd ..1243 002321' spd ..0002 000130' spd ..0346 000752' spd ..0644 001325' spd ..1244 002323' spd ..0010 000047' spd ..0347 000756' spd ..0653 001350' spd ..1252 002331' spd ..0011 000052' spd ..0350 000757' spd ..0654 001353' spd ..1253 002334' spd ..0016 000065' spd ..0351 000767' spd ..0656 001373' spd ..1254 002342' spd ..0025 000054' spd ..0356 000770' spd ..0670 001364' spd ..1261 002340' spd ..0026 000060' spd ..0363 000773' spd ..0671 001372' spd ..1262 002342' spd ..0027 000102' spd ..0364 001000' spd ..0677 001371' spd ..1270 002352' spd ..0034 000103' spd ..0365 001001' spd ..0700 001372' spd ..1271 002354' spd ..0035 000126' spd ..0372 001014' spd ..0706 001407' spd ..1277 002360' spd ..0043 000153' spd ..0400 001020' spd ..0707 001412' spd ..1300 002362' spd ..0051 000225' spd ..0401 001025' spd ..0710 001415' spd ..1310 002415' spd ..0063 000245' spd ..0402 001026' spd ..0715 001421' spd ..1322 002423' spd ..0071 000237' spd ..0407 001032' spd ..0716 001432' spd ..1323 002424' spd ..0072 000242' spd ..0410 001037' spd ..0724 001430' spd ..1325 002433' spd ..0074 000310' spd ..0411 001041' spd ..0725 001432' spd ..1333 002445' spd ..0101 000275' spd ..0417 001043' spd ..0733 001441' spd ..1345 002443' spd ..0102 000276' spd ..0420 001061' spd ..0734 001452' spd ..1346 002445' spd ..0107 000321' spd ..0425 001047' spd ..0742 001450' spd ..1350 002454' spd ..0115 000331' spd ..0426 001054' spd ..0743 001451' spd ..1377 002543' spd ..0123 000364' spd ..0427 001055' spd ..0745 001475' spd ..1404 002545' spd ..0124 000375' spd ..0434 001070' spd ..0752 001477' spd ..1437 002760' spd ..0131 000403' spd ..0435 001100' spd ..0753 001473' spd ..1444 002762' spd ..0132 000405' spd ..0436 001101' spd ..0760 001474' spd ..1457 002776' spd ..0137 000424' spd ..0437 001107' spd ..0761 001512' spd ..1465 002773' spd ..0140 000427' spd ..0445 001115' spd ..0772 001516' spd ..1466 002776' spd ..0141 000430' spd ..0453 001122' spd ..0777 001517' spd ..1471 003022' spd ..0146 000434' spd ..0460 001123' spd ..1005 001552' spd ..1502 003031' spd ..0147 000436' spd ..0461 001130' spd ..1032 001644' spd ..1512 003036' spd ..0150 000437' spd ..0466 001131' spd ..1044 001647' spd ..1522 003043' spd ..0152 000446' spd ..0473 001136' spd ..1045 001655' spd ..1540 003104' spd ..0157 000455' spd ..0501 001144' spd ..1046 001657' spd ..1544 003104' spd ..0165 000470' spd ..0502 001145' spd ..1053 001672' spd ..1560 003127' spd ..0167 000512' spd ..0507 001150' spd ..1061 001666' spd ..1565 003134' spd ..0201 000500' spd ..0510 001154' spd ..1062 001670' spd ..1570 003144' spd ..0202 000501' spd ..0511 001155' spd ..1063 001672' spd ..1575 003146' spd ..0210 000510' spd ..0512 001222' spd ..1064 001704' spd ..1615 003264' spd ..0211 000511' spd ..0524 001220' spd ..1072 001723' spd ..1622 003270' spd ..0213 000517' spd ..0525 001222' spd ..1102 001720' spd ..1632 003302' spd ..0221 000560' spd ..0527 001237' spd ..1114 001734' spd ..1645 003306' spd ..0233 000566' spd ..0541 001230' spd ..1124 001752' spd ..1646 003334' spd ..0234 000570' spd ..0542 001232' spd ..1136 001747' spd ..1656 003326' spd ..0242 000600' spd ..0550 001235' spd ..1137 001752' spd ..1665 003405' spd ..0250 000604' spd ..0551 001237' spd ..1145 002000' spd ..1675 003433' spd ..0256 000613' spd ..0560 001240' spd ..1146 002001' spd ..1702 003434' spd ..0264 000632' spd ..0561 001253' spd ..1164 002060' spd ..1707 003431' spd ..0272 000636' spd ..0562 001252' spd ..1174 002076' spd ..1710 003432' spd ..0273 000641' spd ..0574 001250' spd ..1176 002101' spd ..1717 003542' spd ..0274 000645' spd ..0575 001252' spd ..1216 002261' spd ..1725 003603' spd ..0275 000645' spd ..0577 001264' spd ..1217 002263' spd ..1737 003632' spd ..0307 000651' spd ..0611 001262' spd ..1225 002275' spd ..1740 003635' spd k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 19:42 30-Mar-24 Page S-5 K20SUB MAC 19-Jan-24 16:52 SYMBOL TABLE FOR PSECT CODE ..1746 003643' spd ..1747 003660' spd ..1750 003654' spd ..1763 003671' spd ..1764 003674' spd ..1772 003710' spd ..1773 003723' spd ..2001 003735' spd ..2002 003746' spd ..2010 003752' spd ..2011 004004' spd ..2016 004030' spd ..2017 004036' spd ..2020 004037' spd ..CSC 000004 spd ..CSN 000003 spd ..IFT 200000 000001 spd ..JX1 200000 000000 spd ..MX1 000031 spd ..MX2 000001 spd ..PST 000003 spd .JBFF 000121 spd .JBREN 000124 spd .JBSA 000120 spd .JBSYM 000116 spd .JBVER 000137 spd .XSTKS 000613' ext k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 19:42 30-Mar-24 Page S-6 K20SUB MAC 19-Jan-24 16:52 SYMBOL TABLE FOR PSECT ECODE EXTMOV 000002' EXTSOU 000006' FNDVE1 000012' FNDVER 000050' MOVMSG 000000' PLSOF1 000125' PLSOFF 000120' R 000000 ext RSKP 000000 ext SYMOU1 000055' ..2025 000016' spd ..2027 000026' spd ..2042 000030' spd ..2043 000050' spd ..2050 000045' spd ..2057 000060' spd ..2060 000100' spd ..2061 000076' spd ..2073 000071' spd ..2075 000120' spd ..2110 000107' spd ..2111 000114' spd ..TX1 740000 000000 spd ..TX2 000001 spd k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 19:42 30-Mar-24 Page S-7 K20SUB MAC 19-Jan-24 16:52 SYMBOL TABLE FOR PSECT CONST ASZTAB 000445' BIGSOU 000001' ent CHRCSW 001551' CHRCUP 001553' CHRCUT 001351' CHRIAC 001755' CHRMUP 001147' CHRMUT 000745' CHRSHE 001145' CHRSHS 000545' CHRSWS 001151' CNRTAB 000044' CRCTAB 002011' CRCTB2 002031' CRSUBT 000244' GIANT 000000' GUARDP 002051' IACTAB 001555' OW2DW 001757' k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 19:42 30-Mar-24 Page S-8 K20SUB MAC 19-Jan-24 16:52 SYMBOL TABLE FOR PSECT DATA AICX 000105' CCICHR 000104' CCN 000137' CYSEEN 000000' int DDTF 000116' int DICX 000110' GLBSYM 000113' GRDADR 000101' GRDHAN 000102' GRDMAP 000103' GRDPG2 000100' KJBSYM 000115' LAICER 000106' LCLDEV 000127' LCLFLG 000135' LCLJFN 000134' LCLNAM 000130' LCLPAR 000136' int LCLTEF 000127' LCLTTE 000117' LDICER 000111' LTIMCR 000107' LTIMDE 000112' MYCCOC 000075' PC1 000144' PC2 000145' PC3 000146' int PSAVE 000140' PSAVE2 000141' SYMVEC 000114' TRNBUF 000000' int TSAVE 000142' TSAVE2 000143' TTPAU 000077' k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 19:42 30-Mar-24 Page S-9 K20SUB MAC 19-Jan-24 16:52 SYMBOL TABLE FOR PSECT DATEND DATGRD 000000' k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 19:42 30-Mar-24 Page S-10 K20SUB MAC 19-Jan-24 16:52 SYMBOL TABLE FOR PSECT PATCH PAT.. 000000' int k20hlp - Kermit-20 Help Text MACRO %53B(1254)-4 19:41 30-Mar-24 Page 1 K20HLP MAC 30-Mar-24 15:37 Help Text. ;[18] Lengthy help messages added in edit [18]. 45553 title k20hlp - Kermit-20 Help Text 45554 subttl Help Text. ;[18] Lengthy help messages added in edit [18]. 45555 45556 search monsym,k20unv ; Wants parsing and Kermit .PSECT definitions 45557 cmdacs ^ ; Clean up p1-p4 definitions 45558 45559 sall ; Tidy listing 45560 .directive flblst ; We don't need to see all the ASCIZ bytes... 45561 k20hlp - Kermit-20 Help Text MACRO %53B(1254)-4 19:41 30-Mar-24 Page 2 K20HLP MAC 30-Mar-24 15:37 Notes and Cautions 45562 subttl Notes and Cautions 45563 45564 remark Virtual address space decisions 45565 45566 ; The vast majority of the help text (over 32 pages of ASCII data) has 45567 ; been moved out of section 0 into section 1. This is to free up some 45568 ; virtual address space in section 0. 45569 ; 45570 ; However, it also has the benefit of a smaller working set size as 45571 ; the help text is typically seldom referenced. This will make Kermit 45572 ; more likely to be selected to run and cause less impact to Tops-20. 45573 ; 45574 ; Perhaps more significant is the fact that such a layout uses less 45575 ; cache space. This will result in faster performance on both the 45576 ; MCA25 and other implementations with cache memories, including the 45577 ; cache on systems hosting simulators. 45578 45579 remark Virtual address space cautions 45580 45581 ; Be aware that the help semantic action routine ($help in k20par) 45582 ; uses an address calculation to determine whether the result of the 45583 ; parse is either a macro whose text needs displaying or a simple text 45584 ; to just type. 45585 ; 45586 ; This is almost a hack in a single section program where there can be 45587 ; no issue of in-section address aliasing. It can get you into real 45588 ; trouble if you are using multiple sections. Thus, care must be 45589 ; taken to ensure that the in-section addresses of the macro table and 45590 ; help text do NOT conflict. 45591 ; 45592 ; See the calculations for hlporg in k20unv.mac for further details. 45593 k20hlp - Kermit-20 Help Text MACRO %53B(1254)-4 19:41 30-Mar-24 Page 3 K20HLP MAC 30-Mar-24 15:37 Table of help commands 45594 subttl Table of help commands 45595 45596 .psect code/ronly ; %key macros will put text in the text .psect 45597 45598 000000'02 000000 000000 %table(hlptab,G) ;[194] ;[18] 45599 000001'02 000000# 000000# %key2 <36-bit-bytes>,h36bb ;[232] 45600 000000'03 063 066 055 142 151 45601 000002'02 000000# 000000# %key2 ,hbye 45602 000003'03 142 171 145 000 000 45603 000003'02 000000# 000000# %key2 ,hcescp 45604 000004'03 103 055 145 163 143 45605 000004'02 000000# 000000# %key2 ,hcaptu ;[230] 45606 000010'03 143 141 160 164 165 45607 000005'02 000000# 000000# %key2 ,hcdup ;[254] 45608 000012'03 143 144 165 160 000 45609 000006'02 000000# 000000# %key2 ,hclear 45610 000013'03 143 154 145 141 162 45611 000007'02 000000# 000000# %key2 ,hclose 45612 000015'03 143 154 157 163 145 45613 000010'02 000000# 000000# %key2 ,hconne 45614 000017'03 143 157 156 156 145 45615 000011'02 000000# 000000# %key2 ,hcchar 45616 000021'03 143 157 156 164 162 45617 000012'02 000000# 000000# %key2 ,hcwd 45618 000025'03 143 167 144 000 000 45619 000013'02 000000# 000000# %key2 ,hdebug ;[239] 45620 000026'03 144 145 142 165 147 45621 000014'02 000000# 000000# %key2 ,hdefin 45622 000030'03 144 145 146 151 156 45623 000015'02 000000# 000000# %key2 ,hdele 45624 000032'03 144 145 154 145 164 45625 000016'02 000000# 000000# %key2 ,hdire 45626 000034'03 144 151 162 145 143 45627 000017'02 000000# 000000# %key2 ,hecho 45628 000036'03 145 143 150 157 000 45629 000020'02 000000# 000000# %key2 ,hexit 45630 000037'03 145 170 151 164 000 45631 000021'02 000000# 000000# %key2 ,hfinis 45632 000040'03 146 151 156 151 163 45633 000022'02 000000# 000000# %key2 ,hget 45634 000042'03 147 145 164 000 000 45635 000023'02 000000# 000000# %key2 ,hhelp 45636 000043'03 150 145 154 160 000 45637 000024'02 000000# 000000# %key2 ,hinput 45638 000044'03 151 156 160 165 164 45639 000025'02 000000# 000000# %key2 ,hkermi 45640 000046'03 153 145 162 155 151 45641 000026'02 000000# 000000# %key2 ,hline 45642 000050'03 154 151 156 145 000 45643 000027'02 000000# 000000# %key2 ,hlocal 45644 000051'03 154 157 143 141 154 45645 000030'02 000000# 000000# %key2 ,hlog 45646 000053'03 154 157 147 000 000 45647 000031'02 000000# 000000# %key2 ,houtpu 45648 000054'03 157 165 164 160 165 k20hlp - Kermit-20 Help Text MACRO %53B(1254)-4 19:41 30-Mar-24 Page 3-1 K20HLP MAC 30-Mar-24 15:37 Table of help commands 45649 000032'02 000000# 000000# %key2 ,hpause 45650 000056'03 160 141 165 163 145 45651 000033'02 000000# 000000# %key2 ,hpromp 45652 000060'03 160 162 157 155 160 45653 000034'02 000000# 000000# %key2 ,hpush 45654 000062'03 160 165 163 150 000 45655 000035'02 000000# 000000# %key2 ,hpwd 45656 000063'03 160 167 144 000 000 45657 000036'02 000000# 000000# %key2 ,hquit 45658 000064'03 161 165 151 164 000 45659 000037'02 000000# 000000# %key2 , hsquo 45660 000065'03 161 165 157 164 145 45661 000040'02 000000# 000000# %key2 ,hrecei 45662 000071'03 162 145 143 145 151 45663 000041'02 000000# 000000# %key2 ,hremot 45664 000073'03 162 145 155 157 164 45665 000042'02 000000# 000000# %key2 ,hretur ;[237] 45666 000075'03 162 145 164 165 162 45667 000043'02 000000# 000000# %key2 ,hrun 45668 000077'03 162 165 156 000 000 45669 000044'02 000000# 000000# %key2 ,hsend 45670 000100'03 163 145 156 144 000 45671 000045'02 000000# 000000# %key2 ,hserve 45672 000101'03 163 145 162 166 145 45673 000046'02 000000# 000000# %key2 ,hset 45674 000103'03 163 145 164 000 000 45675 000047'02 000000# 000000# %key2 ,hshow 45676 000104'03 163 150 157 167 000 45677 000050'02 000000# 000000# %key2 ,hspace 45678 000105'03 163 160 141 143 145 45679 000051'02 000000# 000000# %key2 ,hstatu 45680 000107'03 163 164 141 164 151 45681 000052'02 000000# 000000# %key2 ,hstatl 45682 000112'03 163 164 141 164 165 45683 000053'02 000000# 000000# %key2 ,htake 45684 000114'03 164 141 153 145 000 45685 000054'02 000000# 000000# %key2